diff -w -B -a -d -u -b --new-file 01_web_ui/src/Entities.hs 03_tiles/src/Entities.hs

--- 01_web_ui/src/Entities.hs

+++ 03_tiles/src/Entities.hs

@@ -0,0 +1,58 @@

+{-# LANGUAGE NoImplicitPrelude #-}

+

+module Entities where

+

+import Protolude hiding (Map)

+import           Data.Map.Strict (Map)

+import qualified Data.Map.Strict as Map

+

+import           GameCore

+import qualified EntityType as E

+

+

+tiles :: Map E.EntityType Tile

+entities :: Map E.EntityType Entity

+

+

+

+(tiles, entities) =

+

+  let is = [ (E.Blank     , (41, 13))

+           , (E.Door      , (26, 15))

+           , (E.DoorClosed, (21, 15))

+           , (E.Wall      , ( 9, 14))

+           ]

+

+  in

+  let mkData (typ, pos@(x, y)) (tiles', entities') =

+        let (entity, tile) = mkEntityAndTile (x * 100 + y) typ pos in

+        ( Map.insert typ tile tiles'

+        , Map.insert typ entity entities'

+        )

+  in

+  foldr

+    mkData

+    ( Map.fromList [(E.Unknown, tileUnknown)]

+    , Map.fromList [(E.Unknown, entityUnknown)]

+    )

+    is

+

+

+getEntity :: E.EntityType -> Entity

+getEntity e = Map.findWithDefault entityUnknown e entities

+

+getTile :: E.EntityType -> Tile

+getTile e = Map.findWithDefault tileUnknown e tiles

+

+

+mkEntityAndTile :: Int -> E.EntityType -> (Int, Int) -> (Entity, Tile)

+mkEntityAndTile id typ pic =

+  let t = Tile { _tlId = id, _tlName = show typ, _tlPic = pic } in

+  let a = Entity { _enType = typ, _enTile = t, _enProps = Map.empty} in

+  (a, t)

+    

+

+tileUnknown :: Tile

+entityUnknown :: Entity

+(entityUnknown, tileUnknown) = mkEntityAndTile 201 E.Unknown (2, 1)

+

diff -w -B -a -d -u -b --new-file 01_web_ui/src/EntityType.hs 03_tiles/src/EntityType.hs

--- 01_web_ui/src/EntityType.hs

+++ 03_tiles/src/EntityType.hs

@@ -0,0 +1,14 @@

+{-# LANGUAGE NoImplicitPrelude #-}

+

+module EntityType where

+

+import Protolude

+

+

+data EntityType = Blank

+                | Door

+                | DoorClosed

+                | Wall

+                | Unknown

+                deriving (Show, Eq, Ord)

+

diff -w -B -a -d -u -b --new-file 01_web_ui/src/GameCore.hs 03_tiles/src/GameCore.hs

--- 01_web_ui/src/GameCore.hs

+++ 03_tiles/src/GameCore.hs

@@ -14,7 +14,7 @@

 import           Control.Lens.TH (makeLenses)

 import qualified GameHost as Host

-

+import qualified EntityType as E

 data Player = Player { _plConn :: !Host.Connection

                      , _plScreenSize :: !(Int, Int)

@@ -28,6 +28,16 @@

                         }

+data Tile = Tile { _tlName :: !Text

+                 , _tlPic :: !(Int, Int)

+                 , _tlId :: !Int

+                 } deriving (Show, Eq, Ord)

+

+data Entity = Entity { _enType :: !E.EntityType

+                     , _enTile :: !Tile

+                     , _enProps :: !(Map Text Text)

+                     } deriving (Show, Eq, Ord)

+

 data UiMessage = UiMessage { umCmd :: !Text

@@ -35,12 +45,14 @@

                            }

                            deriving (Generic)

+

 data UiConfig = UiConfig { ucCmd :: !Text

                          , ucData :: !UiConfigData

                          }

                          deriving (Generic)

-newtype UiConfigData = UiConfigData { udKeys :: [UiKey]

+data UiConfigData = UiConfigData { udKeys :: ![UiKey]

+                                 , udBlankId :: !Int

                                     }

                                     deriving (Generic)

@@ -44,12 +56,21 @@

                                     }

                                     deriving (Generic)

+

 data UiKey = UiKey { ukShortcut :: !Text

                    , ukAction :: !Text

                    }

                    deriving (Generic)

+

+data UiDrawCommand = UiDrawCommand

+                     { drCmd :: !Text

+                     , drScreenWidth :: !Int

+                     } deriving (Generic)

+

+

+

 instance Ae.ToJSON UiMessage where

   toJSON = Ae.genericToJSON Ae.defaultOptions { Ae.fieldLabelModifier = renField 2 True }

@@ -62,6 +83,9 @@

 instance Ae.ToJSON UiKey where

   toJSON = Ae.genericToJSON Ae.defaultOptions { Ae.fieldLabelModifier = renField 2 True }

+instance Ae.ToJSON UiDrawCommand where

+  toJSON = Ae.genericToJSON Ae.defaultOptions { Ae.fieldLabelModifier = renField 2 True }

+

 -- | drop prefix, and then lower case

 -- | renField 3 "tskBla" == "bla"

@@ -72,9 +96,8 @@

     mkLower t = Txt.toLower (Txt.take 1 t) <> Txt.drop 1 t

-

-

 makeLenses ''World

 makeLenses ''Config

 makeLenses ''Player

-

+makeLenses ''Entity

+makeLenses ''Tile

diff -w -B -a -d -u -b --new-file 01_web_ui/src/GameEngine.hs 03_tiles/src/GameEngine.hs

--- 01_web_ui/src/GameEngine.hs

+++ 03_tiles/src/GameEngine.hs

@@ -11,12 +11,14 @@

 import qualified Data.Aeson.Text.Extended as Ae

 import qualified Data.ByteString.Lazy as BSL

 import qualified Codec.Compression.BZip as Bz

-import           Control.Lens ((^.), (.~), (%~))

-import           Control.Concurrent.STM (atomically, newTVar, modifyTVar', TVar)

+import           Control.Lens (_1, (^.), (.~), (%~))

+import           Control.Concurrent.STM (atomically, readTVar, newTVar, modifyTVar', TVar)

 import           GameCore

 import qualified GameHost as Host

 import           GameHost (conSendData, conReceiveText)

+import qualified Entities as E

+import qualified EntityType as E

 runGame :: IO ()

@@ -95,7 +90,10 @@

         Nothing -> sendError conn "missing / invalid screen size"

         Just (sx, sy) -> do

           updatePlayer (plScreenSize .~ (sx, sy))

-          sendLog conn $ "TODO: " <> cmd

+          w <- atomically $ readTVar worldV

+          drawAndSend w

+          sendLog conn "draw"

+

     "key" ->

       sendLog conn $ "TODO: " <> cmd <> ": " <> show cmdData

@@ -124,9 +120,12 @@

   sendData conn . Ae.encodeText $ UiConfig "config" (buildConfig config)

+

 buildConfig :: Config -> UiConfigData

 buildConfig cfg =

-  UiConfigData $ buildKeys (cfg ^. cfgKeys)

+  UiConfigData { udKeys = buildKeys (cfg ^. cfgKeys)

+               , udBlankId = E.getTile E.Blank ^. tlId

+               }

   where

     buildKeys ks = buildKey <$> Map.toList ks

@@ -153,3 +150,11 @@

   pure (x, y)

+

+drawAndSend :: World -> IO ()

+drawAndSend world = do

+  let cmd = Ae.encodeText UiDrawCommand { drCmd = "draw"

+                                        , drScreenWidth = world ^. wdPlayer ^. plScreenSize ^. _1

+                                        }

+  sendData (world ^. wdPlayer ^. plConn) cmd

+

diff -w -B -a -d -u -b --new-file 01_web_ui/src/GameHost.hs 03_tiles/src/GameHost.hs

--- 01_web_ui/src/GameHost.hs

+++ 03_tiles/src/GameHost.hs

@@ -49,6 +42,11 @@

     Sc.get "/ping" $

       Sc.text "pong"

+

+    Sc.get "/tiles.png" $

+      Sc.file "html/DungeonCrawl_ProjectUtumnoTileset_0.png"

+

+

     Sc.get "/:res" $ do

       res <- Sc.param "res"

       Sc.file $ "html/" <> res

--- 01_web_ui/html/rogue.html

+++ 03_tiles/html/rogue.html

@@ -42,6 +41,11 @@

       <!-- layer for mouse clicks etc, on top of all drawing layers -->

       <div id="topInteractionLayer" style="display:block; position: absolute; left: 0; top: 0; z-index: 1000;"></div>

     </div>

+

+    

+    <!-- load the tiles as an image-->

+    <img src="tiles.png" style="display:none" id="tilesMain"/>

+    

   </body>

 </html>

--- 01_web_ui/html/rogue.js

+++ 03_tiles/html/rogue.js

@@ -1,9 +1,9 @@

 var sendCmd = ( c, d ) => {}

 var tilesMain = null;

-

 var config = { "drawId": 0,

                "help": "",

+               "blank": null,

                "tileWidth": 32,

                "tileHeight": 32,

                "gridWidth": 0,

@@ -11,6 +11,52 @@

              };

+function drawTile( ctx, img, twidth, theight, dx, dy, trow, tcol ){

+  ctx.drawImage(

+    img,             //img

+    trow * twidth,   //sx

+    tcol * theight,  //sy

+    twidth,          //sWidth

+    theight,         //sHeight

+    dx * twidth,     //dx

+    dy * theight,    //dy

+    twidth,          //dWidth

+    theight          //dHeight

+  );

+}

+

+

+

+

+function tileFromTileId( id ){

+  const x = Math.trunc( id / 100 );

+  const y = id - (x * 100);

+  return [x, y];

+}

+

+function getCachedBlankCanvas(){

+  if( !config.blank ){

+    const ctxMain = document.getElementById("tilesCanvas");

+

+    //Create a grid of blank cells for the background

+    var cbg = document.createElement('canvas');

+    cbg.width = ctxMain.width;

+    cbg.height = ctxMain.height;

+    var ctxbg = cbg.getContext('2d');

+    var [blankX, blankY] = tileFromTileId( config.blankId );

+

+    for( x = 0; x < config.gridWidth; ++x ){

+      for( y = 0; y < config.gridHeight; ++y ){

+        drawTile( ctxbg, tilesMain, config.tileWidth, config.tileHeight, x, y, blankX, blankY );

+      }

+    }

+

+    config.blank = cbg;

+  }

+

+  return config.blank;

+}

+

 function sendKey(k){

@@ -42,17 +83,18 @@

     sendCmd("init", gridSizeStr());

   };

-  

-

   ws.onmessage = function (evt) { 

     var bytes = new Uint8Array(evt.data);

     var m = bzip2.simple(bzip2.array(bytes));

     cmd = JSON.parse(m);

+    switch( cmd.cmd ){

+

+      case "config": {

+        config.tiles = {};

+        config.blankId = cmd.data.blankId;

-    switch( cmd.cmd ){

-      case "config":

         //Load keys

         config.help = "";

         for( var i in cmd.data.keys ){

@@ -64,17 +106,33 @@

         sendCmd("redraw", gridSizeStr());

         break;

+      }

-      case "log":

+      case "log": {

         console.log( cmd.message );

         break;

+      }

-      case "error":

+      case "error": {

         alert( cmd.message );

         break;

     }

+      case "draw": {

+        config.drawId = Math.random();

+        

+        const colWidth = cmd.screenWidth;

+        const ctx = document.getElementById("tilesCanvas").getContext("2d");

+

+        //Draw background image of blank tiles

+        ctx.drawImage( getCachedBlankCanvas(), 0, 0 );

+

+        break;

+      }

+

+    }

+    

     Mousetrap.unpause();

   };

@@ -144,10 +196,6 @@

   };

 }

-window.addEventListener('resize', debounce(resizeCanvas, 250), false);

-

-

-

+window.addEventListener('resize', debounce(resizeCanvas, 250), false);

 Mousetrap.bind( "?", () => alert( config.help ) ); 

-