diff options
author | Kelly Rauchenberger <fefferburbia@gmail.com> | 2013-04-01 23:01:59 -0400 |
---|---|---|
committer | Kelly Rauchenberger <fefferburbia@gmail.com> | 2013-04-01 23:01:59 -0400 |
commit | e77c8b23c148ffaa5991da18c981e61db2a5e55c (patch) | |
tree | 23cb193169eaf72587fc20085754d7818b117407 /Main.hs | |
parent | 0bdac482014e4bffb04005fbc09c16aa5f612b8f (diff) | |
download | fallen-hs-e77c8b23c148ffaa5991da18c981e61db2a5e55c.tar.gz fallen-hs-e77c8b23c148ffaa5991da18c981e61db2a5e55c.tar.bz2 fallen-hs-e77c8b23c148ffaa5991da18c981e61db2a5e55c.zip |
Initial commit
Haskell version now has most of the functionality from the C++ version, except for color, and overworld generation is REALLY slow.
Diffstat (limited to 'Main.hs')
-rw-r--r-- | Main.hs | 48 |
1 files changed, 48 insertions, 0 deletions
diff --git a/Main.hs b/Main.hs new file mode 100644 index 0000000..4908c59 --- /dev/null +++ b/Main.hs | |||
@@ -0,0 +1,48 @@ | |||
1 | module Main where | ||
2 | import Fallen.Point | ||
3 | import Fallen.Tiles | ||
4 | import Fallen.Map | ||
5 | import Fallen.Map.Overworld | ||
6 | import System.Random | ||
7 | import UI.HSCurses.Curses | ||
8 | |||
9 | -- main :: () | ||
10 | main = do | ||
11 | rg <- getStdGen | ||
12 | let (m,rg') = initOverworld rg | ||
13 | initCurses | ||
14 | keypad stdScr True | ||
15 | echo False | ||
16 | cursSet CursorInvisible | ||
17 | startColor | ||
18 | mainLoop (75,75) m rg' | ||
19 | endWin | ||
20 | |||
21 | mainLoop player m rg = do | ||
22 | render player m | ||
23 | input <- getCh | ||
24 | case input of | ||
25 | KeyLeft -> moveIfPassable player m rg West | ||
26 | KeyRight -> moveIfPassable player m rg East | ||
27 | KeyUp -> moveIfPassable player m rg North | ||
28 | KeyDown -> moveIfPassable player m rg South | ||
29 | _ -> putStrLn "endgame" | ||
30 | |||
31 | moveIfPassable player m rg dir = do | ||
32 | let p' = stepInDirection player dir | ||
33 | let t' = getTileAtPos m p' | ||
34 | if t' `elem` passableTiles | ||
35 | then mainLoop p' m rg | ||
36 | else mainLoop player m rg | ||
37 | |||
38 | -- render :: Point -> Map -> Window -> () | ||
39 | render (px,py) m = do | ||
40 | (h,w) <- scrSize | ||
41 | let viewportX = px - quot w 2 | ||
42 | let viewportY = py - quot h 2 | ||
43 | let viewport = [(x,y) | y <- [viewportY..viewportY+h-1], x <- [viewportX..viewportX+w-1]] | ||
44 | let drawch = drawTile . getTileAtPos m | ||
45 | let viewport_ = map (\p@(x,y) -> (p, drawch p)) viewport | ||
46 | mapM_ (\((x,y),ch) -> mvAddCh (y-viewportY) (x-viewportX) ch) viewport_ | ||
47 | mvAddCh (py-viewportY) (px-viewportX) (toEnum $ fromEnum '@') | ||
48 | refresh \ No newline at end of file | ||