diff --git a/src/Floorplan.hs b/src/Floorplan.hs index af4deb6..96005b5 100644 --- a/src/Floorplan.hs +++ b/src/Floorplan.hs @@ -9,42 +9,10 @@ import Control.Monad (foldM) import System.Random +import Types.Map + import Debug.Trace -data TileState - = Wall - -- | Wind - | Door - | Hall - | Offi - | Toil - | Kitc - | Elev - | Unde - deriving (Eq) - -instance Show TileState where - show Wall = "#" - -- show Wind = "~" - show Door = "+" - show Hall = "_" - show Offi = "." - show Toil = "o" - show Kitc = "k" - show Elev = "x" - show Unde = " " - -data FloorConfig = FloorConfig - { elevator :: (Int, Int) - , facilities :: [(Int, Int)] - , size :: (Int, Int) - } deriving (Show) - -data Boundaries = Boundaries - { matmin :: (Int, Int) - , matmax :: (Int, Int) - } deriving (Show, Eq) - buildHallFloorIO :: FloorConfig -> IO (Matrix TileState) buildHallFloorIO fc = do rand <- newStdGen @@ -390,19 +358,6 @@ buildDoorsGraph mat = buildGraph amat root (br, maxCol br (bc + 1)) in buildGraph mat [GHall []] (2, 2) -data GraphDirection = North | South | East | West - deriving (Show, Eq) - -data Graph - = GHall - { connects :: [Graph] - } - | GRoom - { neighbs :: [(GraphDirection, TileState)] - , bounds :: Boundaries - } - deriving (Show, Eq) - buildDoors :: Matrix TileState -> [Graph] -> IO (Matrix TileState) buildDoors input graph = do traceIO ("graph: " ++ show (tail graph)) diff --git a/src/Init.hs b/src/Init.hs index c4f7a31..2db36ea 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -50,4 +50,5 @@ load = do , nano = nvg , uuid = [] , world = w + , stateData = None } diff --git a/src/StateMachine.hs b/src/StateMachine.hs index 85a1c00..a8dab31 100644 --- a/src/StateMachine.hs +++ b/src/StateMachine.hs @@ -6,12 +6,14 @@ import Affection import Types +import Test + instance StateMachine State UserData where - smLoad Menu = return () + smLoad Menu = loadMap smUpdate Menu = const $ return () - smDraw Menu = return () + smDraw Menu = drawMap smEvent _ evs = do Subsystems w m <- subsystems <$> getAffection diff --git a/src/Test.hs b/src/Test.hs new file mode 100644 index 0000000..51cffc9 --- /dev/null +++ b/src/Test.hs @@ -0,0 +1,66 @@ +module Test where + +import Affection as A + +import Control.Monad.IO.Class (liftIO) + +import Data.Matrix (toLists) + +import NanoVG + +import Types + +import Floorplan + +import Foreign.C.Types (CFloat(..)) + + +loadMap :: Affection UserData () +loadMap = do + ud <- getAffection + let fc = FloorConfig (10, 10) [] (50,50) + matrix <- liftIO $ buildHallFloorIO fc + putAffection ud + { stateData = MenuData + { mapMat = matrix + , initCoords = (50, 250) + } + } + +drawMap :: Affection UserData () +drawMap = do + ud <- getAffection + let matrix = mapMat (stateData ud) + mapM_ (\(i, ls) -> mapM_ (uncurry $ drawTile i) (reverse $ zip [1..] ls)) + (zip [1..] (toLists matrix)) + +drawTile :: Int -> Int -> TileState -> Affection UserData () +drawTile row col tile = do + ctx <- nano <$> getAffection + (xinit, yinit) <- initCoords <$> stateData <$> getAffection + let tileWidth = 20 :: CFloat + tileHeight = 10 :: CFloat + liftIO $ do + save ctx + beginPath ctx + let x = fromIntegral xinit + (fromIntegral col * tileWidth / 2) + + (fromIntegral row * tileWidth / 2) + y = fromIntegral yinit + (fromIntegral row * tileHeight / 2) - + (fromIntegral col * tileHeight / 2) + fillColor ctx (case tile of + Wall -> rgba 128 128 128 255 + Door -> rgba 255 128 128 255 + Hall -> rgba 255 255 255 255 + Offi -> rgba 0 255 0 255 + Toil -> rgba 0 0 255 255 + Kitc -> rgba 255 0 0 255 + Elev -> rgba 0 0 0 255 + _ -> rgba 255 255 0 255 + ) + moveTo ctx x y + lineTo ctx (x + tileWidth / 2) (y + tileHeight / 2) + lineTo ctx (x + tileWidth) y + lineTo ctx (x + tileWidth / 2) (y - tileHeight / 2) + closePath ctx + fill ctx + restore ctx diff --git a/src/Types.hs b/src/Types.hs index 270937c..b39b783 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -1,5 +1,6 @@ module Types - ( module Types.UserData + ( module T ) where -import Types.UserData +import Types.UserData as T +import Types.Map as T diff --git a/src/Types/Map.hs b/src/Types/Map.hs new file mode 100644 index 0000000..8a01c4b --- /dev/null +++ b/src/Types/Map.hs @@ -0,0 +1,48 @@ +module Types.Map where + +data TileState + = Wall + -- | Wind + | Door + | Hall + | Offi + | Toil + | Kitc + | Elev + | Unde + deriving (Eq) + +instance Show TileState where + show Wall = "#" + -- show Wind = "~" + show Door = "+" + show Hall = "_" + show Offi = "." + show Toil = "o" + show Kitc = "k" + show Elev = "x" + show Unde = " " + +data FloorConfig = FloorConfig + { elevator :: (Int, Int) + , facilities :: [(Int, Int)] + , size :: (Int, Int) + } deriving (Show) + +data Boundaries = Boundaries + { matmin :: (Int, Int) + , matmax :: (Int, Int) + } deriving (Show, Eq) + +data GraphDirection = North | South | East | West + deriving (Show, Eq) + +data Graph + = GHall + { connects :: [Graph] + } + | GRoom + { neighbs :: [(GraphDirection, TileState)] + , bounds :: Boundaries + } + deriving (Show, Eq) diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index ebdbcd2..d03a3ef 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -13,10 +13,13 @@ import NanoVG hiding (V2(..), V3(..)) import qualified Data.Map.Strict as M import Data.Text (Text(..)) +import Data.Matrix import Data.Ecstasy import Linear +import Types.Map + data UserData = UserData { state :: State , subsystems :: Subsystems @@ -24,12 +27,20 @@ data UserData = UserData , nano :: Context , uuid :: [UUID] , world :: Entity 'WorldOf + , stateData :: StateData } data State = Menu | Test +data StateData + = None + | MenuData + { mapMat :: Matrix TileState + , initCoords :: (Int, Int) + } + data ImgId = ImgFloor diff --git a/tracer-game.cabal b/tracer-game.cabal index 3f80546..a460e84 100644 --- a/tracer-game.cabal +++ b/tracer-game.cabal @@ -19,9 +19,11 @@ executable tracer-game main-is: Main.hs other-modules: Types , Types.UserData + , Types.Map , StateMachine , Floorplan , Init + , Test default-extensions: OverloadedStrings , DeriveGeneric , DataKinds