-
Notifications
You must be signed in to change notification settings - Fork 4
/
Main.hs
75 lines (65 loc) · 3.08 KB
/
Main.hs
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
74
{-# LANGUAGE QuasiQuotes, ScopedTypeVariables #-}
-- Repa
import Data.Array.Repa (Z (..), (:.) (..))
import qualified Data.Array.Repa as R
-- Gloss
import Graphics.Gloss
import Graphics.Gloss.Raster.Array
import Graphics.Gloss.Interface.Pure.Game
-- base
import Control.Monad
import System.Random
-- friends
import World
import Step
import Draw
main :: IO ()
main = playArrayIO
(InWindow "Falling Turnip" (resX * round factor, resY * round factor) (pos, pos))
(round factor, round factor)
frameRate
(World { array = R.computeS $ R.fromFunction (Z :. resY :. resX) bareWorld
, currentElem = nothing
, currGravityMask = margMaskEven
, nextGravityMask = margMaskOdd
, mouseDown = False
, mousePos = (0,0)
, mousePrevPos = (0,0) })
( return . render)
((return .) . handleInput)
stepWorld
where frameRate = 30
pos = 300
bareWorld = const nothing
handleInput :: Event -> World -> World
handleInput e w = handleInput' (w {mousePrevPos = mousePos w})
where handleInput' world = case e of
EventKey (MouseButton LeftButton) Down _ (x,y) -> world { mouseDown = True, mousePos = (x/factor, y/factor) }
EventKey (MouseButton LeftButton) Up _ (x,y) -> world { mouseDown = False, mousePos = (x/factor, y/factor) }
EventKey (Char 'e') Down _ _ -> world { currentElem = steam_water }
EventKey (Char 'f') Down _ _ -> world { currentElem = fire }
EventKey (Char 'o') Down _ _ -> world { currentElem = oil }
EventKey (Char 'w') Down _ _ -> world { currentElem = water }
EventKey (Char 'l') Down _ _ -> world { currentElem = salt_water }
EventKey (Char 's') Down _ _ -> world { currentElem = sand }
EventKey (Char 'n') Down _ _ -> world { currentElem = salt }
EventKey (Char 't') Down _ _ -> world { currentElem = stone }
EventKey (Char 'r') Down _ _ -> world { currentElem = torch }
EventKey (Char 'a') Down _ _ -> world { currentElem = wall }
EventKey (Char 'p') Down _ _ -> world { currentElem = plant }
EventKey (Char 'u') Down _ _ -> world { currentElem = spout }
EventKey (Char 'm') Down _ _ -> world { currentElem = metal }
EventMotion (x,y) -> world { mousePos = (x/factor, y/factor) }
_ -> world
stepWorld :: Float -> World -> IO World
stepWorld time world
= do int <- randomRIO (0,100)
stepped <- if mouseDown world
then liftM (step int $ currGravityMask world)
$ drawLine (mousePrevPos world) (mousePos world)
(currentElem world) (array world)
else return $ step int (currGravityMask world) $ array world
array' <- R.computeP stepped
return $ world { array = array'
, currGravityMask = nextGravityMask world
, nextGravityMask = currGravityMask world }