Rewrite App

app/frontend/packs/App/App.purs

@@ -2,37 +2,229 @@ module App.App where
 
 import Prelude
 
-import Data.Maybe (maybe)
+import App.Channel.GameChannel as GameChannel
+import App.Command.Command as Command
+import App.Command.Manager as CommandManager
+import App.Game (Game)
+import App.Game as Game
+import App.Interactor.BrowserInteractor as BrowserInteractor
+import App.Interactor.GameInteractor as GameInteractor
+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 as Utils
+import Data.Array as Array
+import Data.Int as Int
+import Data.Maybe (Maybe(..), maybe)
+import Data.String (Pattern(..))
+import Data.String as String
+import Data.Time.Duration (Milliseconds(..))
+import Data.Traversable (traverse_)
 import Effect (Effect)
+import Effect.Aff (launchAff_)
+import Effect.Aff as Aff
+import Effect.Class (liftEffect)
 import Effect.Class.Console (log)
 import Effect.Exception (throw)
-import Web.DOM.Element (Element)
-import Web.DOM.ParentNode (QuerySelector(..), querySelector)
+import Web.DOM (DOMTokenList, Element)
+import Web.DOM.DOMTokenList as DOMTokenList
+import Web.DOM.Document as Document
+import Web.DOM.Element as Element
+import Web.DOM.Node as Node
+import Web.DOM.NodeList as NodeList
+import Web.DOM.ParentNode (QuerySelector(..), querySelector, querySelectorAll)
+import Web.Event.Event (EventType(..))
+import Web.Event.EventTarget (addEventListener, eventListener)
 import Web.HTML as HTML
-import Web.HTML.HTMLDocument (toParentNode)
+import Web.HTML.HTMLDocument (toDocument, toParentNode)
+import Web.HTML.HTMLMediaElement as HTMLMediaElement
 import Web.HTML.Window as Window
 
 type App =
   { playboard :: Element
   , field :: Element
+  , picture :: Element
   , sounds :: Element
   , log :: Element
   }
 
-foreign import play :: App -> Effect Unit
-
-query :: String -> Effect Element
-query q = do
-  doc <- Window.document =<< HTML.window
-  elm <- querySelector (QuerySelector q) (toParentNode doc)
-  maybe (throw $ "Element not found: " <> q) pure elm
-
-
 init :: Effect Unit
 init = do
+  Logger.append(log)
+
   doc <- Window.document =<< HTML.window
   playboard <- query "#playboard"
   field <- query "#field"
+  picture <- query "#picture"
   sounds <- query "#sounds"
   log <- query "#log"
-  play { playboard, field, sounds, log }
+  play { playboard, field, picture, sounds, log }
+
+
+getGameId :: Element -> Effect Int
+getGameId elm = do
+  x <- dataset "game-id" elm
+  case Int.fromString =<< x of
+    Nothing -> pure 0
+    Just x' -> pure x'
+
+
+play :: App -> Effect Unit
+play app = do
+  setupLogger app
+
+  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
+      Logger.info "game updated"
+      query "#game-progress .loading"
+        >>= Utils.fadeOutSlow
+      GameInteractor.fit gi
+
+    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
+
+
+setupLogger :: App -> Effect Unit
+setupLogger app = do
+  Logger.append \msg -> do
+    doc <- Window.document =<< HTML.window
+    p <- Document.createElement "p" $ toDocument doc
+    Node.setTextContent msg $ Element.toNode p
+    void $ Node.appendChild (Element.toNode p) (Element.toNode app.log)
+
+setupUi :: Game -> App -> Effect Unit
+setupUi game app = do
+  Ticker.onTick do
+    fps <- Ticker.getMeasuredFPS
+    query "#info .fps"
+      >>= Element.toNode
+      >>> Node.setTextContent (show $ Int.round fps)
+
+  Utils.fadeInSlow app.field
+
+  query "#log-button" >>= \btn -> do
+    listener <- eventListener \e -> do
+      Utils.fadeToggle app.log
+      void $ withClassList DOMTokenList.toggle "rotate-180" btn
+    addEventListener (EventType "click") listener false (Element.toEventTarget btn)
+
+  Utils.isFullscreenAvailable >>= if _
+    then
+    query "[data-action=fullscreen]"
+    >>= \btn -> do
+      listener <- eventListener \_ -> do
+        Utils.toggleFullscreen app.playboard
+      addEventListener (EventType "click") listener false (Element.toEventTarget btn)
+    else
+    query "[data-action=fullscreen]"
+    >>= withClassList DOMTokenList.add "disabled"
+
+  queryMany "[data-action=playboard-background]"
+    >>= traverse_ \btn -> do
+      listener <- eventListener \_ -> do
+        xs <- Element.classList app.playboard
+        Array.filter (String.contains (Pattern "bg-")) (Utils.toArray xs)
+          # traverse_ (\x -> withClassList DOMTokenList.remove x app.playboard)
+        ys <- Element.classList btn
+        Array.find (String.contains (Pattern "bg-")) (Utils.toArray ys)
+          # traverse_ (\x -> withClassList DOMTokenList.add x app.playboard)
+
+      addEventListener (EventType "click") listener false (Element.toEventTarget btn)
+
+  CommandManager.onCommit \cmds -> do
+    progress <- Game.progress game
+    when (Array.any Command.isMerge cmds.commands) $
+      query "#progressbar"
+      >>= Element.setAttribute "style" ("width:" <> show (progress * 100.0) <> "%")
+
+
+setupSound :: App -> Effect Unit
+setupSound app = do
+  merge <- querySelector (QuerySelector ".merge") (Element.toParentNode app.sounds)
+  merge
+    >>= HTMLMediaElement.fromElement
+    # traverse_ \elm ->
+    CommandManager.onPost \cmd -> do
+      when (Command.isMerge cmd) $
+        HTMLMediaElement.play elm
+
+connectGameChannel :: Game -> Effect Unit
+connectGameChannel game = do
+  sub <- GameChannel.subscribe game
+  CommandManager.onCommit(GameChannel.commit sub)
+  CommandManager.onCommit \cmds -> do
+    when (not cmds.extrinsic && Array.any Command.isMerge cmds.commands) $
+      Game.progress game
+      >>= GameChannel.report_progress sub
+
+
+-- * Helper functions
+
+withClassList :: forall a. (DOMTokenList -> String -> Effect a) -> String -> Element -> Effect a
+withClassList action key elm = do
+  xs <- Element.classList elm
+  action xs key
+
+throwOnNothing :: forall a. String -> Maybe a -> Effect a
+throwOnNothing msg x = do
+  maybe (throw msg) pure x
+
+query :: String -> Effect Element
+query q = do
+  doc <- Window.document =<< HTML.window
+  querySelector (QuerySelector q) (toParentNode doc)
+    >>= throwOnNothing ("Element not found: " <> q)
+
+queryMany :: String -> Effect (Array Element)
+queryMany q = do
+  doc <- Window.document =<< HTML.window
+  querySelectorAll (QuerySelector q) (toParentNode doc)
+    >>= NodeList.toArray
+    >>> map (map Element.fromNode >>> Array.catMaybes)
+
+dataset :: String -> Element -> Effect (Maybe String)
+dataset key elm =
+  Element.getAttribute ("data-" <> key) elm
+
+dataset' :: String -> Element -> Effect String
+dataset' key elm =
+  dataset key elm
+  >>= throwOnNothing ("Data not found: " <> key)

app/frontend/packs/App/Channel/GameChannel.js

@@ -0,0 +1,10 @@
+const GameChannel = require("../../channel/GameChannel.bs");
+
+exports.subscribe = game => () =>
+  GameChannel.subscribe(game);
+
+exports.commit = subscriber => game => () =>
+  GameChannel.commit(subscriber, game);
+
+exports.report_progress = subscriber => x => () =>
+  GameChannel.report_progress(subscriber, x);

app/frontend/packs/App/Channel/GameChannel.purs

@@ -0,0 +1,13 @@
+module App.Channel.GameChannel where
+
+import Prelude
+
+import App.Command.Manager (CommandGroup)
+import App.Game (Game)
+import Effect (Effect)
+
+foreign import data Subscriber :: Type
+
+foreign import subscribe :: Game -> Effect Subscriber
+foreign import commit :: Subscriber -> CommandGroup -> Effect Unit
+foreign import report_progress :: Subscriber -> Number -> Effect Unit

app/frontend/packs/App/Command/Command.js

@@ -0,0 +1,10 @@
+exports.isMerge = cmd => {
+  switch (cmd.tag | 0) {
+  case /* Merge */0 :
+    return true;
+  case /* Translate */1 :
+    return false;
+  case /* Rotate */2 :
+    return false;
+  };
+};

app/frontend/packs/App/Command/Command.purs

@@ -0,0 +1,5 @@
+module App.Command.Command where
+
+foreign import data Command :: Type
+
+foreign import isMerge :: Command -> Boolean

app/frontend/packs/App/Command/Manager.js

@@ -0,0 +1,8 @@
+const CommandManager = require("../../playboard/command/CommandManager.bs");
+
+exports.onPost = action => () => CommandManager.onPost(cmd => action(cmd)());
+exports.onCommit = action => () =>
+  CommandManager.onCommit(cmds => {
+    Object.assign(cmds, { commands: cmds[0], extrinsic: cmds[1] });
+    action(cmds)();
+  });

app/frontend/packs/App/Command/Manager.purs

@@ -0,0 +1,14 @@
+module App.Command.Manager where
+
+import Prelude
+
+import App.Command.Command (Command)
+import Effect (Effect)
+
+type CommandGroup =
+  { extrinsic :: Boolean
+  , commands :: Array Command
+  }
+
+foreign import onPost :: (Command -> Effect Unit) -> Effect Unit
+foreign import onCommit :: (CommandGroup -> Effect Unit) -> Effect Unit

app/frontend/packs/App/Game.js

@@ -0,0 +1,43 @@
+const Game = require("../playboard/Game.bs");
+
+
+exports.create = (id) => (field) => () => {
+  const obj = Game.create(id, field);
+  obj.id = obj[0];
+  obj.isStandalone = obj[1];
+  obj.puzzleActor = obj[2];
+  obj.pieceActors = obj[3];
+  obj.image = obj[4];
+  obj.isImageLoaded = obj[5];
+  obj.isUpdated = obj[6];
+  obj.readyHandlers = obj[7];
+  obj.updatedHandlers = obj[8];
+  return obj;
+};
+
+exports.progress = game => () =>
+  Game.progress(game);
+
+exports.loadImage = game => url => () => {
+  Game.loadImage(url, game);
+};
+
+exports.loadContent = game => content => () => {
+  Game.loadContent(content, game);
+};
+
+exports.setUpdated = game => () => {
+  Game.setUpdated(game);
+};
+
+exports.shuffle = game => () => {
+  Game.shuffle(game);
+};
+
+exports.onReady = game => action => () => {
+  Game.onReady(action, game);
+};
+
+exports.onUpdated = game => action => () => {
+  Game.onUpdated(action, game);
+};

app/frontend/packs/App/Game.purs

@@ -0,0 +1,27 @@
+module App.Game where
+
+import Prelude
+
+import Effect (Effect)
+import Web.DOM (Element)
+
+foreign import create :: Int -> Element -> Effect Game
+foreign import progress :: Game -> Effect Number
+foreign import loadImage :: Game -> String -> Effect Unit
+foreign import loadContent :: Game -> String -> Effect Unit
+foreign import setUpdated :: Game -> Effect Unit
+foreign import shuffle :: Game -> Effect Unit
+foreign import onReady :: Game -> Effect Unit -> Effect Unit
+foreign import onUpdated :: Game -> Effect Unit -> Effect Unit
+
+type Game =
+  { id :: Int
+  , isStandalone :: Boolean
+  , isImageLoaded :: Boolean
+  , isUpdated :: Boolean
+  -- , puzzleActor
+  -- , pieceActors
+  -- , image
+  -- , readyHandlers
+  -- , updatedHandlers
+  }

app/frontend/packs/App/Interactor/BrowserInteractor.js

@@ -0,0 +1,4 @@
+const BrowserInteractor = require("../../playboard/interactor/BrowserInteractor.bs");
+
+exports.attach = gi => () =>
+  BrowserInteractor.attach(gi);

app/frontend/packs/App/Interactor/BrowserInteractor.purs

@@ -0,0 +1,8 @@
+module App.Interactor.BrowserInteractor where
+
+import Prelude
+
+import App.Interactor.GameInteractor (GameInteractor)
+import Effect (Effect)
+
+foreign import attach :: GameInteractor -> Effect Unit