From e77c8b23c148ffaa5991da18c981e61db2a5e55c Mon Sep 17 00:00:00 2001
From: Kelly Rauchenberger <fefferburbia@gmail.com>
Date: Mon, 1 Apr 2013 23:01:59 -0400
Subject: Initial commit

Haskell version now has most of the functionality from the C++ version, except for color, and
overworld generation is REALLY slow.
---
 Main.hs | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 48 insertions(+)
 create mode 100644 Main.hs

(limited to 'Main.hs')

diff --git a/Main.hs b/Main.hs
new file mode 100644
index 0000000..4908c59
--- /dev/null
+++ b/Main.hs
@@ -0,0 +1,48 @@
+module Main where
+  import Fallen.Point
+  import Fallen.Tiles
+  import Fallen.Map
+  import Fallen.Map.Overworld
+  import System.Random
+  import UI.HSCurses.Curses
+  
+  -- main :: ()
+  main = do
+    rg <- getStdGen
+    let (m,rg') = initOverworld rg
+    initCurses
+    keypad stdScr True
+    echo False
+    cursSet CursorInvisible
+    startColor
+    mainLoop (75,75) m rg'
+    endWin
+  
+  mainLoop player m rg = do
+    render player m
+    input <- getCh
+    case input of
+      KeyLeft -> moveIfPassable player m rg West
+      KeyRight -> moveIfPassable player m rg East
+      KeyUp -> moveIfPassable player m rg North
+      KeyDown -> moveIfPassable player m rg South
+      _ -> putStrLn "endgame"
+  
+  moveIfPassable player m rg dir = do
+    let p' = stepInDirection player dir
+    let t' = getTileAtPos m p'
+    if t' `elem` passableTiles
+      then mainLoop p' m rg
+      else mainLoop player m rg
+  
+  -- render :: Point -> Map -> Window -> ()
+  render (px,py) m = do
+    (h,w) <- scrSize
+    let viewportX = px - quot w 2
+    let viewportY = py - quot h 2
+    let viewport = [(x,y) | y <- [viewportY..viewportY+h-1], x <- [viewportX..viewportX+w-1]]
+    let drawch = drawTile . getTileAtPos m
+    let viewport_ = map (\p@(x,y) -> (p, drawch p)) viewport
+    mapM_ (\((x,y),ch) -> mvAddCh (y-viewportY) (x-viewportX) ch) viewport_
+    mvAddCh (py-viewportY) (px-viewportX) (toEnum $ fromEnum '@')
+    refresh
\ No newline at end of file
-- 
cgit 1.4.1