Skip to content

Instantly share code, notes, and snippets.

@ColonelJ
Last active August 29, 2015 14:02
Show Gist options
  • Save ColonelJ/f3ee6f836f256ee2109f to your computer and use it in GitHub Desktop.
Save ColonelJ/f3ee6f836f256ee2109f to your computer and use it in GitHub Desktop.
Elm Example: basic multitabbed text entry form
import Graphics.Input (input, button, Input)
import Graphics.Input.Field (input, button, defaultStyle, noContent, Content)
import Graphics.Input.Field
import Graphics.Element
import List
import Dict (Dict)
import Dict
import Maybe (maybe)
data DDict k v = DDict v (Dict k v)
data RDict k v = RDict (DDict k (RDict k v -> v))
data RInputDict k v = RInputDict (DDict k (Input (RDict k v -> v)))
makeDict : (() -> v) -> [comparable] -> DDict comparable v
makeDict f keys =
DDict (f()) <| List.foldl (\k dict -> Dict.insert k (f()) dict) Dict.empty keys
getDict : comparable -> DDict comparable v -> v
getDict k (DDict v dict) = Dict.getOrElse v k dict
getRDict : comparable -> RDict comparable v -> (RDict comparable v -> v)
getRDict k (RDict dict) = getDict k dict
getRInputDict : comparable -> RInputDict comparable v ->
Input (RDict comparable v -> v)
getRInputDict k (RInputDict dict) = getDict k dict
liftDict : DDict comparable (Input v) -> Signal (DDict comparable v)
liftDict (DDict v dict) = DDict <~ v.signal ~
List.foldl liftValue (constant Dict.empty) (Dict.toList dict)
liftValue (k,v) dict = Dict.insert k <~ v.signal ~ dict
liftRDict : RInputDict comparable v -> Signal (RDict comparable v)
liftRDict (RInputDict dict) = RDict <~ liftDict dict
fields : DDict String (Input Content)
fields = makeDict (\_ -> input noContent)
["Name", "Address Line 1", "Address Line 2", "Address Line 3", "Postcode",
"Question 1", "Question 2", "Question 3"]
screens : RInputDict String (DDict String Content -> Element)
screens = RInputDict <|
makeDict (\_ -> input (\_ _ -> Graphics.Element.empty))
["Main", "Text", "Shapes"]
type Screen = RDict String (DDict String Content -> Element)
-> DDict String Content -> Element
getScreenInput : String -> Input Screen
getScreenInput k = getRInputDict k screens
field name info = plainText (name ++ ": ") `beside`
Graphics.Input.Field.field defaultStyle
(getDict name fields).handle id "" (getDict name info)
main = mainmenu <~ liftRDict screens ~ liftDict fields
mainmenu contents info =
let screen = getScreenInput "Main" in
flow down [
flow right [ button screen.handle menu "Text",
button screen.handle shapes "Shapes",
button screen.handle address "Address",
button screen.handle pentagon "Pentagon"],
(getRDict "Main" contents) contents info
]
menu contents info =
let screen = getScreenInput "Text" in
flow down [
flow right [ button screen.handle address "Address screen",
button screen.handle quiz "Quiz screen" ],
(getRDict "Text" contents) contents info
]
address contents info =
flow down [
field "Name" info,
field "Address Line 1" info,
field "Address Line 2" info,
field "Address Line 3" info,
field "Postcode" info
]
quiz contents info =
flow down [
field "Question 1" info,
field "Question 2" info,
field "Question 3" info
]
shapes contents info =
let screen = getScreenInput "Shapes" in
flow down [
flow right [ button screen.handle square "Square screen",
button screen.handle pentagon "Pentagon screen" ],
(getRDict "Shapes" contents) contents info
]
square contents info = collage 200 200 [filled blue <| ngon 4 100]
pentagon contents info = collage 200 200 [filled purple <| ngon 5 100]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment