first commit

egonSchiele · May 4, 2014 · cae090e · cae090e
1 parent ecd98b1
commit cae090e
Show file tree

Hide file tree

Showing 73 changed files with 204 additions and 40 deletions.
diff --git a/.gitignore b/.gitignore
@@ -1,3 +1,4 @@
 .*
 dist/*
 tags
+cabal.sandbox.config*
diff --git a/Chips.cabal b/Chips.cabal
@@ -13,23 +13,11 @@ build-type:          Simple
 cabal-version:       >=1.8
 
 executable chips
-  build-depends:       base ==4.6.*
+  build-depends:       base ==4.6.*, gloss, lens, mtl, template-haskell, ActionKid
   hs-source-dirs:      src
   main-is: Main.hs
 
 -- Note: if you see an error message like:
 -- unknown symbol `dominionzm0zi1zi0zi3_DominionziCardsziIntrigue_intrigueCards_closure'
 -- ghc: unable to load package `dominion-0.1.0.3'
 -- It means that you haven't added a module to your exposed-modules list.
-
-Test-Suite test-chips
-  type:       exitcode-stdio-1.0
-  build-depends:       base ==4.6.*, hspec, Chips
-  hs-source-dirs:      spec, src
-  main-is:             Main.hs
-
-library
-  build-depends:       base ==4.6.*
-  exposed-modules:     Chips, Chips.Types, Chips.Core
-  hs-source-dirs:      src
-  Other-modules:       Chips.Utils
diff --git a/cabal.sandbox.config b/cabal.sandbox.config
diff --git a/images/amoeba.png b/images/amoeba.png
diff --git a/images/bee_down.png b/images/bee_down.png
diff --git a/images/bee_left.png b/images/bee_left.png
diff --git a/images/bee_right.png b/images/bee_right.png
diff --git a/images/bee_up.png b/images/bee_up.png
diff --git a/images/bomb.png b/images/bomb.png
diff --git a/images/button_blue.png b/images/button_blue.png
diff --git a/images/button_blue_big.png b/images/button_blue_big.png
diff --git a/images/button_brown.png b/images/button_brown.png
diff --git a/images/button_brown_big.png b/images/button_brown_big.png
diff --git a/images/button_green.png b/images/button_green.png
diff --git a/images/button_grey_big.png b/images/button_grey_big.png
diff --git a/images/button_red.png b/images/button_red.png
diff --git a/images/chip.png b/images/chip.png
diff --git a/images/empty.png b/images/empty.png
diff --git a/images/ff_down.png b/images/ff_down.png
diff --git a/images/ff_left.png b/images/ff_left.png
diff --git a/images/ff_random.png b/images/ff_random.png
diff --git a/images/ff_right.png b/images/ff_right.png
diff --git a/images/ff_shoes.png b/images/ff_shoes.png
diff --git a/images/ff_up.png b/images/ff_up.png
diff --git a/images/fire.png b/images/fire.png
diff --git a/images/fire_boots.png b/images/fire_boots.png
diff --git a/images/flippers.png b/images/flippers.png
diff --git a/images/frog_down.png b/images/frog_down.png
diff --git a/images/frog_left.png b/images/frog_left.png
diff --git a/images/frog_right.png b/images/frog_right.png
diff --git a/images/frog_up.png b/images/frog_up.png
diff --git a/images/gate.png b/images/gate.png
diff --git a/images/gate_final1.png b/images/gate_final1.png
diff --git a/images/gate_final2.png b/images/gate_final2.png
diff --git a/images/gate_final3.png b/images/gate_final3.png
diff --git a/images/gate_final_player.png b/images/gate_final_player.png
diff --git a/images/help.png b/images/help.png
diff --git a/images/ice.png b/images/ice.png
diff --git a/images/ice_bottom_left.png b/images/ice_bottom_left.png
diff --git a/images/ice_bottom_right.png b/images/ice_bottom_right.png
diff --git a/images/ice_skates.png b/images/ice_skates.png
diff --git a/images/ice_top_left.png b/images/ice_top_left.png
diff --git a/images/ice_top_right.png b/images/ice_top_right.png
diff --git a/images/key_blue.png b/images/key_blue.png
diff --git a/images/key_green.png b/images/key_green.png
diff --git a/images/key_red.png b/images/key_red.png
diff --git a/images/key_yellow.png b/images/key_yellow.png
diff --git a/images/lock_blue.png b/images/lock_blue.png
diff --git a/images/lock_green.png b/images/lock_green.png
diff --git a/images/lock_red.png b/images/lock_red.png
diff --git a/images/lock_yellow.png b/images/lock_yellow.png
diff --git a/images/player_burned.png b/images/player_burned.png
diff --git a/images/player_burned2.png b/images/player_burned2.png
diff --git a/images/player_down.png b/images/player_down.png
diff --git a/images/player_left.png b/images/player_left.png
diff --git a/images/player_right.png b/images/player_right.png
diff --git a/images/player_swim_down.png b/images/player_swim_down.png
diff --git a/images/player_swim_left.png b/images/player_swim_left.png
diff --git a/images/player_swim_right.png b/images/player_swim_right.png
diff --git a/images/player_swim_up.png b/images/player_swim_up.png
diff --git a/images/player_up.png b/images/player_up.png
diff --git a/images/sand.png b/images/sand.png
diff --git a/images/spy.png b/images/spy.png
diff --git a/images/tank_down.png b/images/tank_down.png
diff --git a/images/tank_left.png b/images/tank_left.png
diff --git a/images/tank_right.png b/images/tank_right.png
diff --git a/images/tank_up.png b/images/tank_up.png
diff --git a/images/wall.png b/images/wall.png
diff --git a/images/water.png b/images/water.png
diff --git a/images/water_splash.png b/images/water_splash.png
diff --git a/images/worm_up.png b/images/worm_up.png
diff --git a/src/Chips/Utils.hs b/src/Chips/Utils.hs
@@ -11,3 +11,6 @@ count x list = length $ filter (==x) list
 
 indices :: [a] -> [Int]
 indices arr = [0..(length arr - 1)]
+
+(//) :: Integral a => a -> a -> a
+a // b = floor $ (fromIntegral a) / (fromIntegral b)
diff --git a/src/Main.hs b/src/Main.hs
@@ -1,4 +1,201 @@
+{-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction #-}
+{-# OPTIONS_GHC -fno-full-laziness -fno-cse #-}
+import ActionKid
+import Data.Monoid ((<>), mconcat)
 import Chips
-import Chips.Common
+import Control.Lens
+import Graphics.Gloss hiding (display)
+import qualified Debug.Trace as D
+import Data.Maybe
 import Chips.Utils
-main = putStrLn "hello world!"
+
+tileSize = 32
+
+data Tile = Empty Attributes
+          | Wall  Attributes
+          | Chip  Attributes
+          | KeyYellow Attributes
+          | KeyRed Attributes
+          | KeyGreen Attributes
+          | KeyBlue Attributes
+          | LockYellow Attributes
+          | LockRed Attributes
+          | LockGreen Attributes
+          | LockBlue Attributes
+          | Gate Attributes
+          | GateFinal Attributes
+          | Help Attributes
+          deriving (Show, Eq)
+
+deriveMC ''Tile
+
+instance Renderable Tile where
+    render (Empty _)      = image "images/empty.png"
+    render (Wall _)       = image "images/wall.png"
+    render (Chip _)       = image "images/chip.png"
+    render (KeyYellow _)  = image "images/key_yellow.png"
+    render (KeyRed _)     = image "images/key_red.png"
+    render (KeyGreen _)   = image "images/key_green.png"
+    render (KeyBlue _)    = image "images/key_blue.png"
+    render (LockYellow _) = image "images/lock_yellow.png"
+    render (LockRed _)    = image "images/lock_red.png"
+    render (LockGreen _)  = image "images/lock_green.png"
+    render (LockBlue _)   = image "images/lock_blue.png"
+    render (Gate _)       = image "images/gate.png"
+    render (GateFinal _)  = image "images/gate_final1.png"
+    render (Help _)       = image "images/help.png"
+
+data Direction = DirUp | DirDown | DirLeft | DirRight
+
+data Player = Player {
+                _direction :: Direction,
+                _ar :: Attributes
+}
+
+makeLenses ''Player
+deriveMC ''Player
+
+instance Renderable Player where
+    render p = case p ^. direction of
+                 DirUp    -> image "images/player_up.png"
+                 DirDown  -> image "images/player_down.png"
+                 DirLeft  -> image "images/player_left.png"
+                 DirRight -> image "images/player_right.png"
+
+data GameState = GameState {
+                    _tiles :: [Tile],
+                    _player :: Player,
+                    _redKeyCount :: Int,
+                    _blueKeyCount :: Int,
+                    _yellowKeyCount :: Int,
+                    _hasGreenKey :: Bool,
+                    _ga :: Attributes
+}
+
+makeLenses ''GameState
+deriveMC ''GameState
+
+instance Renderable GameState where
+    render gs = displayAll (_tiles gs) <> display (_player gs)
+
+tileMap = 
+    [[1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1],
+     [1, 1, 1, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 1, 1, 1],
+     [1, 1, 1, 2, 1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 1, 1, 1],
+     [1, 1, 1, 2, 1, 3, 1, 2, 13, 2, 1, 3, 1, 2, 1, 1, 1],
+     [1, 2, 2, 2, 2, 2, 10, 2, 12, 2, 10, 2, 2, 2, 2, 2, 1],
+     [1, 2, 1, 4, 1, 11, 1, 1, 1, 1, 1, 9, 1, 4, 1, 2, 1],
+     [1, 2, 1, 3, 1, 2, 7, 1, 14, 1, 5, 2, 1, 3, 1, 2, 1],
+     [1, 2, 2, 2, 2, 2, 3, 1, 1, 1, 3, 2, 2, 2, 2, 2, 1],
+     [1, 2, 1, 3, 1, 2, 7, 1, 1, 1, 5, 2, 1, 3, 1, 2, 1],
+     [1, 2, 1, 1, 1, 9, 1, 1, 3, 1, 1, 11, 1, 1, 1, 2, 1],
+     [1, 2, 2, 2, 2, 2, 2, 8, 2, 8, 2, 2, 2, 2, 2, 2, 1],
+     [1, 1, 1, 1, 1, 2, 1, 1, 2, 1, 1, 2, 1, 1, 1, 1, 1],
+     [1, 1, 1, 1, 1, 2, 1, 3, 2, 3, 1, 2, 1, 1, 1, 1, 1],
+     [1, 1, 1, 1, 1, 2, 1, 1, 2, 6, 1, 2, 1, 1, 1, 1, 1],
+     [1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1],
+     [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]]
+
+boardW = length . head $ tileMap
+boardH = length tileMap
+
+playerCoords :: GameState -> (Int, Int)
+playerCoords gs = ((floor (p ^. x)) // tileSize, (((boardH * tileSize) - (floor (p ^. y))) // tileSize)-1)
+    where p = gs ^. player
+          ts = gs ^. tiles
+
+currentIdx :: GameState -> Int
+currentIdx gs = y_ * boardW + x_
+    where (x_,y_) = playerCoords gs
+
+currentTile gs = (_tiles gs) !! (currentIdx gs)
+leftTile gs    = (_tiles gs) !! (currentIdx gs - 1)
+rightTile gs   = (_tiles gs) !! (currentIdx gs + 1)
+upTile gs      = (_tiles gs) !! (currentIdx gs - boardW)
+downTile gs    = (_tiles gs) !! (currentIdx gs + boardW)
+
+renderedTiles = renderTileMap tileMap f (tileSize, tileSize)
+    where f 1  = Empty def
+          f 2  = Wall def
+          f 3  = Chip def
+          f 4  = KeyYellow def
+          f 5  = KeyRed def
+          f 6  = KeyGreen def
+          f 7  = KeyBlue def
+          f 8  = LockYellow def
+          f 9  = LockRed def
+          f 10 = LockGreen def
+          f 11 = LockBlue def
+          f 12 = Gate def
+          f 13 = GateFinal def
+          f 14 = Help def
+
+gameState = GameState renderedTiles (x .~ (8*tileSize) $ y .~ (8*tileSize) $ player_) 0 0 0 False def
+        where player_ = (Player DirDown def)
+
+main = run "chips challenge" (9 * tileSize, 9 * tileSize) (x -~ (4*tileSize) $ y -~ (4*tileSize) $ gameState) on stepGame
+
+chipsLeft gs = length $ filter isChip (_tiles gs)
+  where isChip (Chip _) = True
+        isChip _        = False
+
+maybeMove :: (GameState -> Tile) -> GameState -> GameState -> GameState
+maybeMove func gs newGs =
+    case func gs of
+      Wall _ -> gs
+      LockRed _    -> if _redKeyCount gs > 0 then newGs else gs
+      LockBlue _   -> if _blueKeyCount gs > 0 then newGs else gs
+      LockGreen _  -> if _hasGreenKey gs then newGs else gs
+      LockYellow _ -> if _yellowKeyCount gs > 0 then newGs else gs
+      Gate _       -> if chipsLeft gs == 0 then newGs else gs
+      _ -> newGs
+
+on (EventKey (SpecialKey KeyLeft) Down _ _) gs =
+    return $ maybeMove leftTile gs $ 
+      player.direction .~ DirLeft
+      $ player.x -~ tileSize
+      $ x +~ tileSize
+      $ gs
+
+on (EventKey (SpecialKey KeyRight) Down _ _) gs =
+    return $ maybeMove rightTile gs $
+      player.direction .~ DirRight
+      $ player.x +~ tileSize
+      $ x -~ tileSize
+      $ gs
+
+on (EventKey (SpecialKey KeyUp) Down _ _) gs =
+    return $ maybeMove upTile gs $
+      player.direction .~ DirUp
+      $ player.y +~ tileSize
+      $ y -~ tileSize
+      $ gs
+
+on (EventKey (SpecialKey KeyDown) Down _ _) gs =
+    return $ maybeMove downTile gs $
+      player.direction .~ DirDown
+      $ player.y -~ tileSize
+      $ y +~ tileSize
+      $ gs
+
+on (EventKey (SpecialKey KeySpace) Down _ _) gs =
+    return gameState
+on _ gs =
+    return $ player.direction .~ DirDown $ gs
+
+stepGame _ gs = do
+    let playerIx = currentIdx gs
+    let attrs_ = ((gs ^. tiles) !! playerIx) ^. attrs
+    let resetTile i = tiles.(ix i) .~ (Empty attrs_) $ gs
+    case currentTile gs of
+      Chip _ -> return $ resetTile playerIx
+      Gate _ -> return $ resetTile playerIx
+      KeyYellow _ -> return $ yellowKeyCount +~ 1 $ resetTile playerIx
+      KeyBlue _ -> return $ blueKeyCount +~ 1 $ resetTile playerIx
+      KeyGreen _ -> return $ hasGreenKey .~ True $ resetTile playerIx
+      KeyRed _ -> return $ redKeyCount +~ 1 $ resetTile playerIx
+      LockYellow _ -> return $ yellowKeyCount -~ 1 $ resetTile playerIx
+      LockBlue _ -> return $ blueKeyCount -~ 1 $ resetTile playerIx
+      LockGreen _ -> return $ resetTile playerIx
+      LockRed _ -> return $ redKeyCount -~ 1 $ resetTile playerIx
+      _ -> return gs