{-----------------------------------------------------------------------------
reactive-banana-threepenny
Example: An animated picture follows the mouse pointer.
------------------------------------------------------------------------------}
{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t"
-- import System.Random
import Paths (getDataFile)
import qualified Graphics.UI.Threepenny as UI
import Graphics.UI.Threepenny.Core hiding (Event)
import Reactive.Banana
import Reactive.Banana.Threepenny
{-----------------------------------------------------------------------------
Constants
------------------------------------------------------------------------------}
height, width :: Double
height = 500
width = 500
dt :: Double
dt = 20 * ms where ms = 1e-3
spriteFile :: IO FilePath
spriteFile = getDataFile "banana.png"
bitmapWidth, bitmapHeight :: Double
bitmapWidth = 128
bitmapHeight = 128
{-----------------------------------------------------------------------------
Main
------------------------------------------------------------------------------}
main :: IO ()
main = do
startGUI Config
{ tpPort = 10000
, tpCustomHTML = Nothing
, tpStatic = ""
} setup
setup :: Window -> IO ()
setup window = do
return window # set title "It's functional programming time!"
spriteURL <- loadFile window "image/png" =<< spriteFile
sprite <- UI.img # set UI.src spriteURL
wrap <- UI.div #. "wrap"
# set style [("width",double2px width),("height",double2px height)
,("border","solid black 1px")]
#+ [element sprite]
getBody window #+ [element wrap]
timer <- UI.timer # set UI.interval (ceiling $ dt * 1e3)
-- event network
let networkDescription :: forall t. Frameworks t => Moment t ()
networkDescription = do
etick <- event UI.tick timer -- frame timer
emouse <- event UI.mousemove wrap -- mouse events
let
-- mouse pointer position
bmouse = stepper (vec 0 0) (readMouse <$> emouse)
-- sprite velocity
bvelocity :: Behavior t Vector
bvelocity =
(\pos mouse -> speedup $ mouse `vecSub` pos `vecSub` vec 0 45)
<$> bposition <*> bmouse
where
speedup v = v `vecScale` (vecLength v / 20)
-- sprite position
bposition :: Behavior t Vector
bposition = accumB (vec 0 0) $
(\v pos -> clipToFrame $ (v `vecScale` dt) `vecAdd` pos)
<$> bvelocity <@ etick
clipToFrame v = vec
(clip 0 x (width - bitmapWidth ))
(clip 0 y (height - bitmapHeight))
where
x = vecX v; y = vecY v
clip a x b = max a (min x b)
-- animate the sprite
return sprite # sink position bposition
network <- compile networkDescription
actuate network
UI.start timer
{-----------------------------------------------------------------------------
2D Geometry
------------------------------------------------------------------------------}
data Vector = Vec !Double !Double deriving (Show)
vecX (Vec x _) = x
vecY (Vec _ y) = y
vec x y = Vec x y
vecScale (Vec x y) s = Vec (s*x) (s*y)
vecAdd (Vec x1 y1) (Vec x2 y2) = Vec (x1+x2) (y1+y2)
vecSub (Vec x1 y1) (Vec x2 y2) = Vec (x1-x2) (y1-y2)
vecLength :: Vector -> Double
vecLength (Vec x y) = sqrt (x*x + y*y)
{-----------------------------------------------------------------------------
Threepenny stuff
------------------------------------------------------------------------------}
position :: WriteAttr Element Vector
position = mkWriteAttr $ \(Vec x y) el ->
set' style [("position","absolute")
,("left", double2px x) ,("top", double2px y)] el
double2px x = show (ceiling x) ++ "px"
readMouse :: (Int,Int) -> Vector
readMouse (x,y) = vec (fromIntegral x) (fromIntegral y)