diff options
| -rw-r--r-- | elm/day2.elm | 73 |
1 files changed, 73 insertions, 0 deletions
diff --git a/elm/day2.elm b/elm/day2.elm new file mode 100644 index 0000000..b4ae200 --- /dev/null +++ b/elm/day2.elm @@ -0,0 +1,73 @@ +import Window +import Mouse + +-- Easy +mousePosPressed = lift2 (\p d -> show p ++ " -- " ++ show d) + Mouse.position Mouse.isDown + + +mouseYIfPressed = lift2 (\(_,y) d -> if d then show y else "") + Mouse.position Mouse.isDown + + +-- Medium +meat = RGBA 200 130 130 1 +pict1 (x, y) = let body = filled meat (rect 30 100) + ball = filled meat (circle 15) + in [ body |> move (x, y) + , ball |> move (x, y+50) + , ball |> move (x-15, y-50) + , ball |> move (x+15, y-50) ] +pict2 (x, y) = let pee = filled yellow (rect 10 50) + in pict1 (x, y) ++ [ pee |> move (x, y+100) ] + +display (w, h) (x, y) down = + let pos = (toFloat x - toFloat w/2, toFloat h/2 - toFloat y) + in collage w h (if down then pict2 pos else pict1 pos) + +drawPenis = lift3 display Window.dimensions Mouse.position Mouse.isDown + + +countFromZero = foldp (\_ acc -> acc+1) 0 (every second) + + +-- Hard +data Dir = Left | Right +type State = ((Int, Int), (Int, Int), Dir) + +carBottom = filled black (rect 160 50) +carTop = filled black (rect 100 50) +tire = filled red (circle 24) + +renderCar : State -> Element +renderCar ((w, h), (x0, y0), _) = + let x = toFloat x0 - toFloat w / 2 + y = toFloat y0 + in collage w h [ carBottom |> moveX x + , carTop |> move (x, y+30) + , tire |> move (x-40, y-30) + , tire |> move (x+40, y-30) ] + +s0 : State +s0 = ((300, 300), (0,0), Right) + +update : (Int, Int) -> (Int, Int) -> Dir -> Int -> State +update (w, h) (x, y) dir mx = + let mx_rel = toFloat mx / toFloat w + step = if | mx_rel > 0.75 -> 3 + | mx_rel > 0.50 -> 2 + | mx_rel > 0.25 -> 1 + | otherwise -> 0 + in case dir of + Left -> if x-80 <= 0 + then ((w, h), (x+step,y), Right) + else ((w, h), (x-step,y), Left) + Right -> if x+80 >= w + then ((w, h), (x-step,y), Left) + else ((w, h), (x+step,y), Right) + +carStates : Signal State +carStates = foldp (\ (env, mx) (_, pos, dir) -> update env pos dir mx) s0 + (sampleOn (fps 60) (lift2 (,) Window.dimensions Mouse.x)) + +main = lift renderCar carStates
\ No newline at end of file |