chribben · May 10, 2014 20:56 · May 10, 2014
diff --git a/Robot.elm b/Robot.elm
@@ -0,0 +1,129 @@
+import Keyboard
+import Window
+import Graphics.Input (Input, input, button, dropDown)
+import Graphics.Input.Field (Content, noContent, field, defaultStyle, Forward, Backward)
+
+-- MODEL
+data Direction = North | East | South | West
+type Robot = {x:Int, y:Int, dir:Direction}
+type Board = [(Int,Int)]
+type Game = {robot:Robot, board:Board}
+data Language = Swedish | English
+data BoardInput = Circle (Int) | Rectangle (Int,Int)
+data Command = GoForward | TurnLeft | TurnRight | StandStill | Move(Int, Int, Direction)
+type Inp = {boardInput: BoardInput, robotInput: Command}
+defaultGame = {robot={x=0, y=0, dir = North}, board=[]}
+
+-- UPDATE
+stepRobot cmd {robot, board} = 
+          {robot | x   <- case cmd of 
+                            Move(x,y,_) -> if onBoard (x,y) board then x else 0 
+                            _           -> let xx = next robot.x robot.dir cmd East West
+                                           in if onBoard (xx,robot.y) board then xx else robot.x,
+                   y   <- case cmd of 
+                            Move(x,y,_) -> if onBoard (x,y) board then y else 0
+                            _           -> let yy = next robot.y robot.dir cmd North South
+                                           in if onBoard (robot.x,yy) board then yy else robot.y,
+                   dir <- case cmd of 
+                            Move(_,_,dir) -> dir
+                            _             -> nextDir robot.dir cmd }
+
+stepBoard boardInput = case boardInput of
+                              Circle(radius)       -> filter (\(x,y) -> x^2+y^2 < radius^2) <|
+                                                        coords [-radius..radius] [-radius..radius]
+                              Rectangle(rows,cols) -> coords [0..cols-1] [0..rows-1]
+                              _                    -> []
+
+stepGame : Inp -> Game -> Game
+stepGame {boardInput, robotInput} game =
+          {board=stepBoard boardInput, robot=(stepRobot robotInput game)}
+game = foldp stepGame defaultGame inp 
+
+-- INPUT
+colInp = input noContent
+rowInp = input noContent
+radInp = input noContent
+startxInp = input noContent
+startyInp = input noContent
+click = input ()
+
+inp = Inp <~ boardInput ~ robotInput
+boardInput = toShape <~ (sampleOn click.signal <| lift4 (,,,) (contentToInt <~ radInp.signal) (contentToInt <~ rowInp.signal) (contentToInt <~ colInp.signal) shape.signal)
+robotInput = merge initMoves moves
+
+initMoves = Move <~ (sampleOn click.signal <| lift3 (,,) (contentToInt <~ startxInp.signal) (contentToInt <~ startyInp.signal) (constant North))  
+moves = toMoveCmd <~ Keyboard.lastPressed ~ (sampleOn click.signal lang.signal)
+main = display <~ Window.dimensions ~ colField ~ rowField ~ radField ~ startXField ~ startYField ~ game
+
+-- DISPLAY
+colField = makeField colInp "No of columns"
+rowField = makeField rowInp "No of rows"
+radField = makeField radInp "Radius"
+startXField = makeField startxInp "x start"
+startYField = makeField startyInp "y start"
+startBtn = button click.handle () "Start!"
+
+lang = input English
+langDropDown =
+     dropDown lang.handle
+        [ ("English - Keys: f, r, l", English)
+        , ("Swedish - Keys: g, h, v", Swedish)
+        ]
+
+shape = input <| Rectangle (0,0)
+shapeDropDown =
+     dropDown shape.handle
+        [ ("Rectangle", Rectangle (0,0))
+        , ("Circle" , Circle 0)
+        ]
+
+display (w,h) colField rowField radField startXField startYField {robot,board} = 
+          flow down [[markdown|**Controls**|] `above` (container 250 30 midLeft langDropDown),
+                     [markdown|**Board shape**|] `above` (container 250 50 midLeft shapeDropDown),
+                     [markdown|**Board config**|] `above` (flow right [container 250 50 midRight colField, container 250 50 midLeft rowField]), 
+                     (container 250 50 midRight radField),
+                     (flow right [container 250 50 midRight startXField, container 250 50 midLeft startYField]), 
+                     (container 250 50 midLeft startBtn),
+                     asText robot,
+                     collage w h
+                      (
+                        [move (toFloat(robot.x*20),toFloat(robot.y*20)+100) (filled red (rect 20 20))] ++ 
+                        map (\(x,y) -> move (toFloat x*20,toFloat y*20+100) (outlined (solid blue) (rect 20 20))) board
+                      )  
+                    ]
+
+-- Utils
+contentToInt cont = case (String.toInt cont.string) of {Just x -> x; _ -> 0}
+makeField inp txt = field defaultStyle inp.handle id txt <~ inp.signal
+
+coords l1 l2 =
+  if length l1 == 0 then [] else (map (\x -> (head l1, x)) l2) ++ (coords (tail l1) l2)
+onBoard (x,y) board = any (\e -> e == (x,y)) board
+next x dir cmd incrDir decDir = 
+     if | dir == incrDir && cmd == GoForward -> x + 1
+        | dir == decDir  && cmd == GoForward -> x - 1
+        | otherwise                      -> x
+nextDir dir cmd = case (dir,cmd) of
+                    (North,TurnLeft)  -> West
+                    (North,TurnRight) -> East
+                    (South,TurnLeft)  -> East
+                    (South,TurnRight) -> West
+                    (East,TurnLeft)   -> North
+                    (East,TurnRight)  -> South
+                    (West,TurnLeft)   -> South
+                    (West,TurnRight)  -> North
+                    _                 -> dir
+
+toShape (r,w,h,shape) = case shape of
+                          Circle _ -> Circle(r)
+                          _      -> Rectangle(w,h)
+
+toMoveCmd key lang = case (key,lang) of
+                        (71,Swedish) -> GoForward
+                        (86,Swedish) -> TurnLeft
+                        (72,Swedish) -> TurnRight
+                        (70,English) -> GoForward
+                        (76,English) -> TurnLeft
+                        (82,English) -> TurnRight
+                        _            -> StandStill
+
No results found