Garmelon/forest
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[server] Add very simple animation module

Browse source 
I mostly used this module for testing the partial tree updates.
This commit is contained in:
Joscha 2020-02-12 11:07:12 +00:00
parent b2b34d551a
commit 3656483bc8
2 changed files with 43 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

17
server/Main.hs
View file

@ -7,6 +7,7 @@ import qualified Network.WebSockets as WS
import Forest.Server
import Forest.Node
import Forest.TreeModule.ConstModule
import Forest.TreeModule.AnimateModule
import Forest.TreeModule.ForkModule
pingDelay :: Int
@ -25,5 +26,21 @@ main = do
putStrLn "Starting server"
WS.runServerWithOptions options $ serverApp pingDelay $ forkModule "Forest"
[ ProngConstructor $ constModule $ newNode "" "Test" [txtNode "" "Bla"]
, ProngConstructor $ animateModule 200000
[ newNode "" "Animate" [txtNode "" "|> |", txtNode "" "Ping!"]
, newNode "" "Animate" [txtNode "" "|-> |", txtNode "" "Ping!"]
, newNode "" "Animate" [txtNode "" "| -> |", txtNode "" "Ping!"]
, newNode "" "Animate" [txtNode "" "| -> |", txtNode "" "Ping!"]
, newNode "" "Animate" [txtNode "" "| ->|", txtNode "" "Ping!"]
, newNode "" "Animate" [txtNode "" "| -|", txtNode "" "Ping!"]
, newNode "" "Animate" [txtNode "" "| |", txtNode "" "Ping!"]
, newNode "" "Animate" [txtNode "" "| <|", txtNode "" "Pong!"]
, newNode "" "Animate" [txtNode "" "| <-|", txtNode "" "Pong!"]
, newNode "" "Animate" [txtNode "" "| <- |", txtNode "" "Pong!"]
, newNode "" "Animate" [txtNode "" "| <- |", txtNode "" "Pong!"]
, newNode "" "Animate" [txtNode "" "|<- |", txtNode "" "Pong!"]
, newNode "" "Animate" [txtNode "" "|- |", txtNode "" "Pong!"]
, newNode "" "Animate" [txtNode "" "| |", txtNode "" "Pong!"]
]
, ProngConstructor $ constModule projectDescriptionNode
]

26
src/Forest/TreeModule/AnimateModule.hs Normal file
View file

@ -0,0 +1,26 @@
{-# LANGUAGE OverloadedStrings #-}
module Forest.TreeModule.AnimateModule
( AnimateModule
, animateModule
) where
import Control.Concurrent
import Forest.TreeModule
import Forest.Node
import Forest.Util
data AnimateModule = AnimateModule
instance TreeModule AnimateModule where
animateModule :: Int -> [Node] -> ModuleConstructor AnimateModule
animateModule delay frames sendNode continue =
withThread (animateThread frames) $ continue AnimateModule
where
animateThread [] = sendNode $ txtNode "" "Invalid animation: No frames provided"
animateThread (x:xs) = do
sendNode x
threadDelay delay
animateThread $ xs ++ [x]