wip

app/frontend/packs/App/App.purs

@@ -6,6 +6,8 @@ import App.Channel.GameChannel as GameChannel
 import App.Command.Command as Command
 import App.Command.CommandGroup as CommandGroup
 import App.Command.CommandManager as CommandManager
+import App.EaselJS.Rectangle as Rectangle
+import App.EaselJS.Ticker as Ticker
 import App.Game (Game)
 import App.Game as Game
 import App.Interactor.BrowserInteractor as BrowserInteractor
@@ -14,23 +16,24 @@ import App.Interactor.GuideInteractor as GuideInteractor
 import App.Interactor.MouseInteractor as MouseInteractor
 import App.Interactor.TouchInteractor as TouchInteractor
 import App.Logger as Logger
-import App.Ticker as Ticker
-import App.Utils (throwOnNothing)
+import App.Model.Puzzle (Puzzle)
+import App.Model.Puzzle as Puzzle
+import App.Utils (bool, throwOnLeft, throwOnNothing)
 import App.Utils as Utils
+import Data.Argonaut (decodeJson, jsonParser)
 import Data.Array as Array
 import Data.Int as Int
 import Data.Maybe (Maybe(..))
 import Data.String (Pattern(..))
 import Data.String as String
 import Data.Time.Duration (Milliseconds(..))
 import Data.Traversable (traverse_)
+import Debug.Trace (traceM)
 import Effect (Effect)
-import Effect.Aff (launchAff_)
-import Effect.Aff as Aff
+import Effect.Aff (Aff, error, launchAff_, parallel, sequential, throwError)
 import Effect.Class (liftEffect)
 import Effect.Class.Console (log)
-import Web.DOM (DOMTokenList, Element)
-import Web.DOM.DOMTokenList as DOMTokenList
+import Web.DOM (Element)
 import Web.DOM.Document as Document
 import Web.DOM.Element as Element
 import Web.DOM.Node as Node
@@ -45,7 +48,8 @@ import Web.HTML.Window as Window
 
 type App =
   { playboard :: Element
-  , field :: Element
+  , baseCanvas :: Element
+  , activeCanvas :: Element
   , picture :: Element
   , sounds :: Element
   , log :: Element
@@ -57,11 +61,12 @@ init = do
 
   doc <- Window.document =<< HTML.window
   playboard <- query "#playboard"
-  field <- query "#field"
+  baseCanvas <- query "#field"
+  activeCanvas <- query "#active-canvas"
   picture <- query "#picture"
   sounds <- query "#sounds"
   log <- query "#log"
-  play { playboard, field, picture, sounds, log }
+  play { playboard, baseCanvas, activeCanvas, picture, sounds, log }
 
 
 getGameId :: Element -> Effect Int
@@ -78,50 +83,62 @@ play app = do
 
   gameId <- getGameId app.playboard
   Logger.info $ "game id: " <> show gameId
-  game <- Game.create gameId app.field
-  Game.onReady game do
-    Logger.info "game ready"
-    setupUi game app
-    setupSound app
 
-    gi <- GameInteractor.create game
-    BrowserInteractor.attach gi
-    GuideInteractor.attach gi
-    Utils.isTouchScreen >>= if _
-      then TouchInteractor.attach gi
-      else MouseInteractor.attach gi
-
-    dataset "initial-view" app.playboard
-      >>= traverse_ (GameInteractor.contain gi)
-
-    Utils.fadeOutSlow app.picture
-
-    Game.onUpdated game do
+  pictureUrl <- dataset' "picture" app.playboard
+  launchAff_ do
+    obj <- sequential $
+      { image: _, puzzle: _ }
+      <$> parallel (Utils.loadImage pictureUrl)
+      <*> parallel (setupPuzzle gameId app)
+    gi <- liftEffect do
+      Logger.info "game ready"
+      game <- Game.create gameId obj.puzzle obj.image
+      setupUi game app
+      setupSound app
+
+      gi <- GameInteractor.create game app.baseCanvas app.activeCanvas
+      BrowserInteractor.attach gi
+      GuideInteractor.attach gi
+      -- isTouchScreen <- Utils.isTouchScreen
+      -- bool MouseInteractor.attach TouchInteractor.attach isTouchScreen gi
+
+      dataset "initial-view" app.playboard
+        >>= traverse_ \str -> do
+          rect <- jsonParser str >>= Rectangle.decode # throwOnLeft
+          GameInteractor.contain rect gi
+
+      Utils.fadeOutSlow app.picture
+      pure gi
+
+    updateGame gi.game
+    liftEffect do
       Logger.info "game updated"
       query "#game-progress .loading"
         >>= Utils.fadeOutSlow
       GameInteractor.fit gi
+    pure unit
 
-    when game.isStandalone do
-      Game.shuffle game
-      launchAff_ do
-        Aff.delay $ Milliseconds 100.0
-        liftEffect $ Game.setUpdated game
-
-  if game.isStandalone
-    then do
-    Logger.info $ "standalone: " <> show game.isStandalone
-    dataset' "puzzle-content" app.playboard
-      >>= query
-      >>= Element.toNode
-      >>> Node.textContent
-      >>= Game.loadContent game
-    else
-    connectGameChannel game
 
-  dataset' "picture" app.playboard
-    >>= Game.loadImage game
+setupPuzzle :: Int -> App -> Aff Puzzle
+setupPuzzle gameId app = do
+  bool setupStandalonePuzzle setupOnlinePuzzle (0 < gameId) app
+
+setupStandalonePuzzle :: App -> Aff Puzzle
+setupStandalonePuzzle app = liftEffect do
+  Logger.info $ "standalone: " <> show true
+  dataset' "puzzle-content" app.playboard
+    >>= query
+    >>= Element.toNode >>> Node.textContent
+    >>= Puzzle.parse
+
+setupOnlinePuzzle :: App -> Aff Puzzle
+setupOnlinePuzzle app = throwError (error "Not implemented")
 
+updateGame :: Game -> Aff Unit
+updateGame game =
+  liftEffect
+  $ when game.isStandalone do
+    Game.shuffle game
 
 setupLogger :: App -> Effect Unit
 setupLogger app = do
@@ -139,7 +156,7 @@ setupUi game app = do
       >>= Element.toNode
       >>> Node.setTextContent (show $ Int.round fps)
 
-  Utils.fadeInSlow app.field
+  Utils.fadeInSlow app.baseCanvas
 
   query "#log-button" >>= \btn -> do
     listener <- eventListener \e -> do

app/frontend/packs/App/Drawer/PieceActor.purs

@@ -0,0 +1,45 @@
+module App.Drawer.PieceActor where
+
+import Prelude
+
+import App.EaselJS.Point (Point)
+import App.EaselJS.Point as Point
+import App.EaselJS.Rectangle (Rectangle)
+import App.EaselJS.Rectangle as Rectangle
+import App.EaselJS.Shape (Shape)
+import App.EaselJS.Shape as Shape
+import App.Model.Piece (Piece)
+import App.Model.Piece as Piece
+import Data.Array as Array
+import Data.Maybe (Maybe(..))
+import Effect (Effect)
+import Effect.Ref (Ref)
+import Effect.Ref as Ref
+
+type Transform =
+  { position :: Point
+  , rotation :: Number
+  }
+
+type PieceActor =
+  { body :: Piece
+  , shape :: Shape
+  , transform :: Ref Transform
+  , loops :: Ref (Array Piece.Loop)
+  , merger :: Ref (Maybe Int)
+  , localBoundary :: Ref Rectangle
+  , boundary :: Ref Rectangle
+  }
+
+create :: Piece -> Effect PieceActor
+create body = do
+  shape <- Shape.create
+  transform <- Ref.new { position: Point.zero, rotation: 0.0 }
+  loops <- Ref.new body.loops
+  merger <- Ref.new Nothing
+  let boundary' =
+        Array.foldr Rectangle.addPoint Rectangle.empty
+        $ Array.catMaybes $ Array.concat body.loops
+  localBoundary <- Ref.new boundary'
+  boundary <- Ref.new boundary'
+  pure { body, shape, transform, loops, merger, localBoundary, boundary }

app/frontend/packs/App/Drawer/PieceDrawer.purs

@@ -0,0 +1,109 @@
+module App.Drawer.PieceDrawer where
+
+import Prelude
+
+import App.Drawer.PieceActor (PieceActor)
+import App.EaselJS.Graphics (Graphics)
+import App.EaselJS.Graphics as G
+import App.EaselJS.Point (Point)
+import App.EaselJS.Rectangle as Rectangle
+import App.Model.Piece (Loop)
+import App.Utils (bool)
+import Data.Array as Array
+import Data.Maybe (Maybe(..), maybe)
+import Data.Traversable (traverse_)
+import Effect (Effect)
+import Effect.Ref as Ref
+import Web.DOM (Element)
+
+type PieceDrawer =
+  { image :: Maybe Element
+  , drawsImage :: Boolean
+  , drawsStroke :: Boolean
+  , drawsControlLine :: Boolean
+  , drawsBoundary :: Boolean
+  , drawsCenter :: Boolean
+  }
+
+withImage :: Element -> PieceDrawer
+withImage image =
+  { image: pure image
+  , drawsImage: true
+  , drawsStroke: false
+  , drawsControlLine: false
+  , drawsBoundary: false
+  , drawsCenter: false
+  }
+
+draw :: PieceActor -> PieceDrawer -> Effect Unit
+draw actor drawer = do
+  let g = actor.shape.graphics
+  G.clear g
+
+  bool
+    (G.beginFill "rgba(127, 191, 255, 0.5)")
+    (maybe (G.beginFill "#f33") G.beginBitmapFill drawer.image)
+    drawer.drawsImage g
+
+  when drawer.drawsStroke do
+    G.setStrokeStyle 2.0 g
+    G.beginStroke "#faf" g
+
+  traverse_ (\loop -> drawCurve loop g) actor.body.loops
+
+  G.endFill g
+  G.endStroke g
+
+  when drawer.drawsBoundary do
+    rect <- Ref.read actor.localBoundary
+    G.setStrokeStyle 2.0 g
+    G.beginStroke "#0f0" g
+    G.drawRect rect g
+    G.endStroke g
+
+  when drawer.drawsControlLine do
+    G.setStrokeStyle 1.0 g
+    G.beginStroke "#663" g
+    traverse_ (\loop -> drawPolyline loop g) actor.body.loops
+    G.endStroke g
+
+  when drawer.drawsCenter do
+    pt <- Rectangle.center <$> Ref.read actor.localBoundary
+    G.setStrokeStyle 2.0 g
+    G.beginFill "#3f9" g
+    G.drawCircle pt 8.0 g
+    G.endFill g
+
+
+drawCurve :: Loop -> Graphics -> Effect Unit
+drawCurve loop g = do
+  Array.uncons loop # traverse_ \({ head, tail }) -> do
+    head # traverse_ \pt ->
+      G.moveTo pt g
+    f tail
+  where
+    f :: Array (Maybe Point) -> Effect Unit
+    f pts = case Array.take 3 pts of
+      [Just pt1, Just pt2, Just pt3] -> do
+        G.bezierCurveTo pt1 pt2 pt3 g
+        f $ Array.drop 3 pts
+      [_, _, Just pt3] -> do
+        G.lineTo pt3 g
+        f $ Array.drop 3 pts
+      _ ->
+        pure unit
+
+drawPolyline :: Loop -> Graphics -> Effect Unit
+drawPolyline loop g = do
+    Array.uncons loop # traverse_ \({ head, tail }) -> do
+      head # traverse_ \pt ->
+        G.moveTo pt g
+      f tail
+  where
+    f :: Array (Maybe Point) -> Effect Unit
+    f pts = case Array.uncons pts of
+      Just { head, tail } -> do
+        head # traverse_ \pt -> G.lineTo pt g
+        f tail
+      _ ->
+        pure unit

app/frontend/packs/App/Drawer/PuzzleActor.purs

@@ -17,8 +17,8 @@ type PuzzleActor =
   }
 
 create :: Puzzle -> Effect PuzzleActor
-create puzzle = do
+create body = do
   shape <- Shape.create
   container <- Container.create
-  Container.addChild shape container
-  pure { body: puzzle, shape, container }
+  Container.addShape shape container
+  pure { body, shape, container }

app/frontend/packs/App/Drawer/PuzzleDrawer.purs

@@ -2,37 +2,37 @@ module App.Drawer.PuzzleDrawer where
 
 import Prelude
 
+import App.Drawer.PuzzleActor (PuzzleActor)
 import App.EaselJS.Graphics (Graphics)
 import App.EaselJS.Graphics as G
-import App.Model.Puzzle (Puzzle)
+import App.EaselJS.Point as Point
 import Data.Array as Array
 import Data.Int as Int
 import Data.Traversable (for_)
 import Effect (Effect)
-import Web.DOM (Element)
 
 type PuzzleDrawer =
-  { image :: Element
-  , drawsGuide :: Boolean
+  { drawsGuide :: Boolean
   }
 
+draw :: PuzzleActor -> PuzzleDrawer -> Effect Unit
+draw actor drawer = do
+  let g = actor.shape.graphics
+  G.clear g
+  when drawer.drawsGuide $ drawGuide g
+
 drawGuide :: Graphics -> Effect Unit
 drawGuide g = do
   G.setStrokeStyle 1.0 g
   G.beginStroke "rgba(127,255,255,0.7)" g
   G.beginFill "rgba(127,255,255,0.5)" g
-  G.drawCircle 0.0 0.0 5.0 g
+  G.drawCircle Point.zero 5.0 g
 
   G.setStrokeStyle 1.0 g
   G.beginStroke "rgba(127,255,255,0.7)" g
   for_ (Array.range (-5) 5) \i -> do
     let f = Int.toNumber i
-    G.moveTo (-500.0) (f * 100.0) g
-    G.lineTo 500.0 (f * 100.0) g
-    G.moveTo (f * 100.0) (-500.0) g
-    G.lineTo (f * 100.0) 500.0 g
-
-draw :: Puzzle -> Graphics -> PuzzleDrawer -> Effect Unit
-draw puzzle g drawer = do
-  G.clear g
-  when drawer.drawsGuide $ drawGuide g
+    G.moveTo (Point.create (-500.0) (f * 100.0)) g
+    G.lineTo (Point.create 500.0 (f * 100.0)) g
+    G.moveTo (Point.create (f * 100.0) (-500.0)) g
+    G.lineTo (Point.create (f * 100.0) 500.0) g