about summary refs log tree commit diff stats
path: root/Main.hs
diff options
context:
space:
mode:
authorKelly Rauchenberger <fefferburbia@gmail.com>2013-04-01 23:01:59 -0400
committerKelly Rauchenberger <fefferburbia@gmail.com>2013-04-01 23:01:59 -0400
commite77c8b23c148ffaa5991da18c981e61db2a5e55c (patch)
tree23cb193169eaf72587fc20085754d7818b117407 /Main.hs
parent0bdac482014e4bffb04005fbc09c16aa5f612b8f (diff)
downloadfallen-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.hs48
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 @@
1module 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