1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
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
|
