diff --git a/src/Swarm/Game/Scenario/Topography/Center.hs b/src/Swarm/Game/Scenario/Topography/Center.hs index 2c4ff4f5bb..bee014eb11 100644 --- a/src/Swarm/Game/Scenario/Topography/Center.hs +++ b/src/Swarm/Game/Scenario/Topography/Center.hs @@ -15,11 +15,14 @@ import Swarm.Game.Scenario (Scenario) import Swarm.Game.State (SubworldDescription, genRobotTemplates) import Swarm.Game.Universe (Cosmic (..), SubworldName (DefaultRootSubworld)) -determineViewCenter :: +-- | Determine view center for a static map +-- without reference to a 'GameState' +-- (i.e. outside the context of an active game) +determineStaticViewCenter :: Scenario -> NonEmpty SubworldDescription -> Cosmic Location -determineViewCenter s worldTuples = +determineStaticViewCenter s worldTuples = fromMaybe defaultVC baseRobotLoc where theRobots = genRobotTemplates s worldTuples diff --git a/src/Swarm/Game/World/Render.hs b/src/Swarm/Game/World/Render.hs index 11849b4122..07c3019d6e 100644 --- a/src/Swarm/Game/World/Render.hs +++ b/src/Swarm/Game/World/Render.hs @@ -19,7 +19,7 @@ import Swarm.Game.Display (defaultChar) import Swarm.Game.Entity.Cosmetic import Swarm.Game.Location import Swarm.Game.ResourceLoading (initNameGenerator, readAppData) -import Swarm.Game.Scenario (Scenario, area, loadStandaloneScenario, scenarioCosmetics, scenarioWorlds, ul, worldName) +import Swarm.Game.Scenario (PWorldDescription, Scenario, area, loadStandaloneScenario, scenarioCosmetics, scenarioWorlds, ul, worldName) import Swarm.Game.Scenario.Status (seedLaunchParams) import Swarm.Game.Scenario.Topography.Area import Swarm.Game.Scenario.Topography.Cell @@ -85,43 +85,49 @@ fromHiFi = fmap $ \case -- those triples are not inputs to the VTY attribute creation. AnsiColor x -> namedToTriple x --- | When output size is not explicitly provided on command line, +-- | When output size is not explicitly provided, -- uses natural map bounds (if a map exists). +getBoundingBox :: + Location -> + PWorldDescription e -> + Maybe AreaDimensions -> + W.BoundsRectangle +getBoundingBox vc scenarioWorld maybeSize = + mkBoundingBox areaDims upperLeftLocation + where + upperLeftLocation = + if null maybeSize && not (isEmpty mapAreaDims) + then ul scenarioWorld + else vc .+^ ((`div` 2) <$> V2 (negate w) h) + + mkBoundingBox areaDimens upperLeftLoc = + both W.locToCoords locationBounds + where + lowerRightLocation = upperLeftToBottomRight areaDimens upperLeftLoc + locationBounds = (upperLeftLoc, lowerRightLocation) + + worldArea = area scenarioWorld + mapAreaDims = getAreaDimensions worldArea + areaDims@(AreaDimensions w h) = + fromMaybe (AreaDimensions 20 10) $ + maybeSize <|> surfaceEmpty isEmpty mapAreaDims + getDisplayGrid :: + Location -> Scenario -> GameState -> Maybe AreaDimensions -> - Grid (PCell EntityFacade) -getDisplayGrid myScenario gs maybeSize = + Grid CellPaintDisplay +getDisplayGrid vc myScenario gs maybeSize = getMapRectangle mkFacade (getContentAt worlds . mkCosmic) - (mkBoundingBox areaDims upperLeftLocation) + (getBoundingBox vc firstScenarioWorld maybeSize) where mkCosmic = Cosmic $ worldName firstScenarioWorld - worlds = view (landscape . multiWorld) gs - worldTuples = buildWorldTuples myScenario - vc = determineViewCenter myScenario worldTuples - firstScenarioWorld = NE.head $ view scenarioWorlds myScenario - worldArea = area firstScenarioWorld - mapAreaDims = getAreaDimensions worldArea - areaDims@(AreaDimensions w h) = - fromMaybe (AreaDimensions 20 10) $ - maybeSize <|> surfaceEmpty isEmpty mapAreaDims - - upperLeftLocation = - if null maybeSize && not (isEmpty mapAreaDims) - then ul firstScenarioWorld - else view planar vc .+^ ((`div` 2) <$> V2 (negate w) h) - - mkBoundingBox areaDimens upperLeftLoc = - both W.locToCoords locationBounds - where - lowerRightLocation = upperLeftToBottomRight areaDimens upperLeftLoc - locationBounds = (upperLeftLoc, lowerRightLocation) getRenderableGrid :: RenderOpts -> @@ -138,7 +144,11 @@ getRenderableGrid (RenderOpts maybeSeed _ _ maybeSize) fp = simpleErrorHandle $ myScenario (seedLaunchParams maybeSeed) gsc - return (getDisplayGrid myScenario gs maybeSize, myScenario ^. scenarioCosmetics) + let vc = + view planar $ + determineStaticViewCenter myScenario $ + buildWorldTuples myScenario + return (getDisplayGrid vc myScenario gs maybeSize, myScenario ^. scenarioCosmetics) doRenderCmd :: RenderOpts -> FilePath -> IO () doRenderCmd opts@(RenderOpts _ asPng _ _) mapPath = diff --git a/src/Swarm/TUI/View.hs b/src/Swarm/TUI/View.hs index 32fb588ffc..6421c4f208 100644 --- a/src/Swarm/TUI/View.hs +++ b/src/Swarm/TUI/View.hs @@ -243,7 +243,7 @@ drawNewGameMenuUI (l :| ls) launchOptions = case displayedFor of , padTop (Pad 1) table ] where - vc = determineViewCenter s worldTuples + vc = determineStaticViewCenter s worldTuples worldTuples = buildWorldTuples s theWorlds = genMultiWorld worldTuples $ fromMaybe 0 $ s ^. scenarioSeed diff --git a/src/Swarm/Web.hs b/src/Swarm/Web.hs index 2b9dfe82f1..12fe522c84 100644 --- a/src/Swarm/Web.hs +++ b/src/Swarm/Web.hs @@ -67,6 +67,7 @@ import Swarm.Game.Robot import Swarm.Game.Scenario.Objective import Swarm.Game.Scenario.Objective.Graph import Swarm.Game.Scenario.Objective.WinCheck +import Swarm.Game.Scenario.Topography.Area (AreaDimensions (..)) import Swarm.Game.Scenario.Topography.Structure.Recognition import Swarm.Game.Scenario.Topography.Structure.Recognition.Log import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry @@ -83,6 +84,7 @@ import Swarm.TUI.Model import Swarm.TUI.Model.Goal import Swarm.TUI.Model.UI import Swarm.Util.RingBuffer +import Swarm.Web.Worldview import System.Timeout (timeout) import Text.Read (readEither) import WaiAppStatic.Types (unsafeToPiece) @@ -108,6 +110,7 @@ type SwarmAPI = :<|> "code" :> "run" :> ReqBody '[PlainText] T.Text :> Post '[PlainText] T.Text :<|> "paths" :> "log" :> Get '[JSON] (RingBuffer CacheLogEntry) :<|> "repl" :> "history" :> "full" :> Get '[JSON] [REPLHistItem] + :<|> "map" :> Capture "size" AreaDimensions :> Get '[JSON] GridResponse swarmApi :: Proxy SwarmAPI swarmApi = Proxy @@ -162,6 +165,7 @@ mkApp state events = :<|> codeRunHandler events :<|> pathsLogHandler state :<|> replHandler state + :<|> mapViewHandler state robotsHandler :: ReadableIORef AppState -> Handler [Robot] robotsHandler appStateRef = do @@ -244,6 +248,18 @@ replHandler appStateRef = do items = toList replHistorySeq pure items +mapViewHandler :: ReadableIORef AppState -> AreaDimensions -> Handler GridResponse +mapViewHandler appStateRef areaSize = do + appState <- liftIO (readIORef appStateRef) + let maybeScenario = fst <$> appState ^. uiState . scenarioRef + pure $ case maybeScenario of + Just s -> + GridResponse True + . Just + . getCellGrid s (appState ^. gameState) + $ areaSize + Nothing -> GridResponse False Nothing + -- ------------------------------------------------------------------ -- Main app (used by service and for development) -- ------------------------------------------------------------------ @@ -338,3 +354,19 @@ instance ToCapture (Capture "id" RobotID) where SD.DocCapture "id" -- name "(integer) robot ID" -- description + +instance FromHttpApiData AreaDimensions where + parseUrlPiece x = left T.pack $ do + pieces <- mapM (readEither . T.unpack) $ T.splitOn "x" x + case pieces of + [w, h] -> return $ AreaDimensions w h + _ -> Left "Need two dimensions" + +instance SD.ToSample AreaDimensions where + toSamples _ = SD.samples [AreaDimensions 20 30] + +instance ToCapture (Capture "size" AreaDimensions) where + toCapture _ = + SD.DocCapture + "size" -- name + "(integer, integer) dimensions of area" -- description diff --git a/src/Swarm/Web/Worldview.hs b/src/Swarm/Web/Worldview.hs new file mode 100644 index 0000000000..ceb5ef9ad8 --- /dev/null +++ b/src/Swarm/Web/Worldview.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- SPDX-License-Identifier: BSD-3-Clause +module Swarm.Web.Worldview where + +import Control.Lens ((^.)) +import Control.Monad.Trans.State +import Data.Aeson (ToJSON) +import Data.Colour.Palette.BrewerSet (Kolor) +import Data.Colour.SRGB (RGB (..), sRGB24, sRGB24show) +import Data.IntMap qualified as IM +import Data.Text qualified as T +import GHC.Generics (Generic) +import Servant.Docs qualified as SD +import Swarm.Game.Entity.Cosmetic (RGBColor, flattenBg) +import Swarm.Game.Scenario (Scenario, scenarioCosmetics) +import Swarm.Game.Scenario.Style +import Swarm.Game.Scenario.Topography.Area (AreaDimensions (..), Grid) +import Swarm.Game.State (GameState, robotInfo) +import Swarm.Game.State.Robot (viewCenter) +import Swarm.Game.Universe (planar) +import Swarm.Game.World.Render +import Swarm.TUI.View.CellDisplay (getTerrainEntityColor) +import Swarm.Util.OccurrenceEncoder + +data GridResponse = GridResponse + { isPlaying :: Bool + , grid :: Maybe CellGrid + } + deriving (Generic, ToJSON) + +getCellGrid :: + Scenario -> + GameState -> + AreaDimensions -> + CellGrid +getCellGrid myScenario gs requestedSize = + CellGrid indexGrid $ getIndices encoding + where + vc = gs ^. robotInfo . viewCenter + dg = getDisplayGrid (vc ^. planar) myScenario gs (Just requestedSize) + aMap = myScenario ^. scenarioCosmetics + + asColour :: RGBColor -> Kolor + asColour (RGB r g b) = sRGB24 r g b + asHex = HexColor . T.pack . sRGB24show . asColour + + f = asHex . maybe (RGB 0 0 0) (flattenBg . fromHiFi) . getTerrainEntityColor aMap + (indexGrid, encoding) = runState (mapM (encodeOccurrence . f) dg) emptyEncoder + +data CellGrid = CellGrid + { coords :: Grid IM.Key + , colors :: [HexColor] + } + deriving (Generic, ToJSON) + +instance SD.ToSample GridResponse where + toSamples _ = SD.noSamples diff --git a/src/swarm-util/Swarm/Util/OccurrenceEncoder.hs b/src/swarm-util/Swarm/Util/OccurrenceEncoder.hs new file mode 100644 index 0000000000..4ada5c3dc7 --- /dev/null +++ b/src/swarm-util/Swarm/Util/OccurrenceEncoder.hs @@ -0,0 +1,41 @@ +-- | +-- SPDX-License-Identifier: BSD-3-Clause +module Swarm.Util.OccurrenceEncoder ( + Encoder, + encodeOccurrence, + getIndices, + emptyEncoder, +) where + +import Control.Monad.Trans.State +import Data.List (sortOn) +import Data.Map (Map) +import Data.Map qualified as M + +type OccurrenceEncoder a = State (Encoder a) + +newtype Encoder a = Encoder (Map a Int) + +emptyEncoder :: Ord a => Encoder a +emptyEncoder = Encoder mempty + +-- | Map indices are guaranteed to be contiguous +-- from @[0..N]@, so we may convert to a list +-- with no loss of information. +getIndices :: Encoder a -> [a] +getIndices (Encoder m) = map fst $ sortOn snd $ M.toList m + +-- | Translate each the first occurrence in the structure +-- to a new integer as it is encountered. +-- Subsequent encounters re-use the allocated integer. +encodeOccurrence :: Ord a => a -> OccurrenceEncoder a Int +encodeOccurrence c = do + Encoder currentMap <- get + maybe (cacheNewIndex currentMap) return $ + M.lookup c currentMap + where + cacheNewIndex currentMap = do + put $ Encoder $ M.insert c newIdx currentMap + return newIdx + where + newIdx = M.size currentMap diff --git a/swarm.cabal b/swarm.cabal index b738aeb69c..636af0b94b 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -103,6 +103,7 @@ library swarm-util Swarm.Util Swarm.Util.Erasable Swarm.Util.Lens + Swarm.Util.OccurrenceEncoder Swarm.Util.Parse Swarm.Util.RingBuffer Swarm.Util.UnitInterval @@ -288,18 +289,19 @@ library Swarm.Util.Effect Swarm.Version Swarm.Web + Swarm.Web.Worldview reexported-modules: Control.Carrier.Accum.FixedStrict , Data.BoolExpr.Simplify , Swarm.Util , Swarm.Util.Erasable , Swarm.Util.Lens + , Swarm.Util.OccurrenceEncoder , Swarm.Util.Parse , Swarm.Util.RingBuffer , Swarm.Util.UnitInterval , Swarm.Util.WindowedCounter , Swarm.Util.Yaml - other-modules: Paths_swarm autogen-modules: Paths_swarm diff --git a/web/handwritten-logo.png b/web/handwritten-logo.png new file mode 100644 index 0000000000..1b77c9a1a7 Binary files /dev/null and b/web/handwritten-logo.png differ diff --git a/web/index.html b/web/index.html index 3293ce3d84..34bbb0a472 100644 --- a/web/index.html +++ b/web/index.html @@ -4,7 +4,9 @@ Swarm server +

Hello Swarm player!

Looking for the Web API docs?

+

Or an experimental web frontend for the game?

\ No newline at end of file diff --git a/web/play.html b/web/play.html new file mode 100644 index 0000000000..3864ee2f2f --- /dev/null +++ b/web/play.html @@ -0,0 +1,32 @@ + + + + Web frontend + + + + + + + + + + + \ No newline at end of file diff --git a/web/script/display.js b/web/script/display.js new file mode 100644 index 0000000000..c90253277a --- /dev/null +++ b/web/script/display.js @@ -0,0 +1,15 @@ +function setupGraphics(button, displayWidth, displayHeight) { + + // Create the application helper and add its render target to the page + let app = new PIXI.Application({ + width: displayWidth, + height: displayHeight, + backgroundColor: 0xFFFFFF + }); + + document.body.insertBefore(app.view, button); + + const graphics = new PIXI.Graphics(); + app.stage.addChild(graphics); + return [app.view, graphics]; +} \ No newline at end of file diff --git a/web/script/fetch.js b/web/script/fetch.js new file mode 100644 index 0000000000..33efea1a1d --- /dev/null +++ b/web/script/fetch.js @@ -0,0 +1,62 @@ +var globalRefetchCount = 0; +var lastPrintTime = Date.now(); + +let cellSize = 8; + +function drawGraphics(graphics, colorMap, grid) { + + graphics.clear(); + + for (let rowIdx=0; rowIdx < grid.length; rowIdx++) { + let row = grid[rowIdx]; + for (let colIdx=0; colIdx <= row.length; colIdx++) { + + let colorIdx = row[colIdx]; + let color = colorMap[colorIdx]; + + graphics.beginFill(color); + let xPos = colIdx * cellSize; + let yPos = rowIdx * cellSize; + graphics.drawRect(xPos, yPos, xPos + cellSize, yPos + cellSize); + graphics.endFill(); + } + } +} + +function doFetch(appView, button, gfx, renderWidth, renderHeight) { + + globalRefetchCount += 1; + + const newPrintTime = Date.now(); + const millis = newPrintTime - lastPrintTime; + + if (millis > 3000) { + console.log("Fetch count: " + globalRefetchCount); + lastPrintTime = newPrintTime; + } + + let hCellCount = Math.floor(renderWidth / cellSize); + let vCellCount = Math.floor(renderHeight / cellSize); + let areaSpec = hCellCount + "x" + vCellCount; + fetch("map/" + areaSpec) + .then((response) => { + if (!response.ok) { + throw new Error(`HTTP error, status = ${response.status}`); + } + return response.json(); + }) + .then((data) => { + if (data.isPlaying) { + drawGraphics(gfx, data.grid.colors, data.grid.coords); + } + + setTimeout(() => doFetch(appView, button, gfx, renderWidth, renderHeight), 30); + }) + .catch((error) => { + const p = document.createElement("p"); + p.appendChild(document.createTextNode(`Error: ${error.message}`)); + document.body.appendChild(p); + + button.style.display = 'block'; + }); +}