processing-1.0.1.0: Graphics/Web/Processing/Simple.hs
-- | A 'Monoid' models figures in the plane.
-- Then, figures are displayed or animated using
-- a Processing script.
--
-- For example, this expression represents a circle
-- of radius 10 centered at the origin:
--
-- > Circle (0,0) 10
--
-- The origin will be represented at the center of
-- the screen. As opposed to the other modules,
-- /y/-coordinates increase to the top, while /x/-coordinates
-- still increase to the right.
--
-- This is a red rectangle with top-left corner at the origin,
-- 10 points height and 10 points width:
--
-- > FillColor (Color 255 0 0 255) $ Rectangle (0,0) 10 10
--
-- To display several figures together, use the 'Monoid' instance:
--
-- > Circle (0,0) 10 <> Circle (0,20) 10
--
-- If you just want to display this figure in the target canvas,
-- use 'displayFigure'. If you want to animate it, use 'animateFigure'.
-- Animations depend on the number of frames since the beginning of
-- the execution, instead of in the time spent.
--
-- Once you have created a processing script (a value of type
-- 'ProcScript'), use 'renderFile' to write it to a file. See
-- also the "Graphics.Web.Processing.Html" module.
--
-- The default filling color and line color are white and black
-- respectively. Use 'FillColor' and 'LineColor' to change these
-- colors. 'Color's are in RGBA format, meaning that they may be
-- transparent (with an alpha value of 0), opaque (with an alpha
-- value of 255) or something in between. Use a fully transparent
-- color to indicate that a Figure should not be filled.
--
-- You can apply transformations like translation, rotation and
-- scaling. If @p@ is a point and @f@ a figure, @Translate p f@
-- will draw @f@ with @p@ as the origin of coordinates. Rotations
-- and scalings are always done in respect to the origin, but note
-- that you can modify where the origin is using 'Translate'.
module Graphics.Web.Processing.Simple (
-- * Types
module Graphics.Web.Processing.Core.Types
, Color (..)
, Proc_Point
, Path
-- * Figure type
, Figure (..)
-- * Monoids
-- | A re-export of the "Data.Monoid" module is provided.
-- You may be using it to join different 'Figure's into one.
, module Data.Monoid
-- * Script
, displayFigure
, animateFigure
-- ** Interactive
, interactiveFigure
-- *** Keyboard
, Key (..)
, ArrowKey (..)
, KeyModifier (..)
, SpecialKey (..)
-- *** Custom values
-- | Module re-export for convenience.
, module Graphics.Web.Processing.Mid.CustomVar
) where
import Data.Monoid
import Graphics.Web.Processing.Core.Types
import Graphics.Web.Processing.Mid
import Graphics.Web.Processing.Mid.CustomVar
-- state
import Control.Applicative ((<$>))
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
-- | A path is just a list of points.
type Path = [Proc_Point]
-- | The monoid of plane figures.
data Figure =
Line Path
-- ^ Line joining a list of points.
| Polygon Path
-- ^ Polygon given a list of vertex.
| Ellipse Proc_Point Proc_Float Proc_Float
-- ^ Ellipse centered at the given point,
-- with width and height also specified.
| Circle Proc_Point Proc_Float
-- ^ Circle centered at the given point and with
-- the specified radius.
| Arc Proc_Point Proc_Float Proc_Float
Proc_Float Proc_Float
-- ^ Arc. The arc is drawn following the line of
-- an ellipse between two angles.
-- The first argument is the center of the ellipse.
-- The next two arguments are the width and height of
-- the ellipse.
-- The last two arguments are the initial and end
-- angles of the arc.
| Rectangle Proc_Point Proc_Float Proc_Float
-- ^ Rectangle such that the top-left corner is
-- at the specified point, and its width and
-- height are specified by the other two arguments.
| Bezier Proc_Point Proc_Point Proc_Point Proc_Point
-- ^ Bezier curve. First and last arguments are the initial
-- and end points of the curve. The other points are
-- control points.
| Text Proc_Point Proc_Text
-- ^ Text.
| LineColor Color Figure
-- ^ Set the line color of a figure.
| FillColor Color Figure
-- ^ Set the filling color of a figure.
| Translate Proc_Point Figure
-- ^ Translate a figure in the direction of a vector.
| Rotate Proc_Float Figure
-- ^ Rotate a figure by the given angle in radians.
| Scale Proc_Float Proc_Float Figure
-- ^ Scale a figure by the given x and y factors.
| Figures [Figure]
-- ^ List of figures.
instance Monoid Figure where
mempty = Figures []
mappend (Figures []) x = x
mappend x (Figures []) = x
mappend (Figures xs) (Figures ys) = Figures $ xs ++ ys
mappend (Figures xs) x = Figures $ xs ++ [x]
mappend x (Figures xs) = Figures $ x : xs
mappend x y = Figures [x,y]
pairList :: [a] -> [(a,a)]
pairList (x:y:zs) = (x,y) : pairList (y:zs)
pairList _ = []
-- | Adjust a point so x coordinates increase
-- to the right and y coordinates to the top.
adjustPoint :: Proc_Point -> Proc_Point
adjustPoint (x,y) = (x,-y)
-- | SimpleEventM monad: EventM with a state attached.
type SimpleEventM c = StateT Settings (EventM c)
data Settings = Settings {
currentLineColor :: Color
, currentFillColor :: Color
}
defaultSettings :: Settings
defaultSettings = Settings {
currentLineColor = Color 0 0 0 255 -- black
, currentFillColor = Color 255 255 255 255 -- white
}
setLineColor :: Color -> SimpleEventM c ()
setLineColor c = modify $ \s -> s { currentLineColor = c }
getLineColor :: SimpleEventM c Color
getLineColor = currentLineColor <$> get
setFillColor :: Color -> SimpleEventM c ()
setFillColor c = modify $ \s -> s { currentFillColor = c }
getFillColor :: SimpleEventM c Color
getFillColor = currentFillColor <$> get
figureSEvent :: Drawing c => Figure -> SimpleEventM c ()
-- Pictures
figureSEvent (Line ps) = lift $ mapM_ (uncurry line) $ pairList $ fmap adjustPoint ps
figureSEvent (Polygon ps) = lift $ polygon $ fmap adjustPoint ps
figureSEvent (Ellipse p w h) = lift $ ellipse (adjustPoint p) w h
figureSEvent (Circle p r) = lift $ circle (adjustPoint p) r
figureSEvent (Arc p w h start end) = lift $ arc (adjustPoint p) w h start end
figureSEvent (Rectangle p w h) = lift $ rect (adjustPoint p) w h
figureSEvent (Bezier start p1 p2 end) =
lift $ bezier (adjustPoint start)
(adjustPoint p1)
(adjustPoint p2)
(adjustPoint end)
figureSEvent (Text p t) = lift $ drawtext t (adjustPoint p) 0 0 -- font size doesn't work anyway (?)
-- Settings
figureSEvent (LineColor c f) = do
c0 <- getLineColor
setLineColor c
lift $ stroke c
figureSEvent f
setLineColor c0
lift $ stroke c0
figureSEvent (FillColor c f) = do
c0 <- getFillColor
setFillColor c
lift $ fill c
figureSEvent f
setFillColor c0
lift $ fill c0
-- Transformations
figureSEvent (Translate (x,y) f) = lift (translate x (-y)) >> figureSEvent f >> lift (translate (-x) y)
figureSEvent (Rotate a f) = lift (rotate a) >> figureSEvent f >> lift (rotate (-a))
figureSEvent (Scale x y f) = lift (scale x y) >> figureSEvent f >> lift (scale (recip x) (recip y))
-- Appending
figureSEvent (Figures fs) = mapM_ figureSEvent fs
figureEvent :: Drawing c => Figure -> EventM c ()
figureEvent f = do
stroke $ currentLineColor defaultSettings
fill $ currentFillColor defaultSettings
evalStateT (figureSEvent f) defaultSettings
-- | Display a figure using a Processing script.
displayFigure ::
Maybe Int -- ^ Width (if none, takes as much as is available).
-> Maybe Int -- ^ Height (if none, takes as much as is available).
-> Color -- ^ Background color.
-> Figure -- ^ Figure to display.
-> ProcScript
displayFigure w h bgc f = execScriptM $ on Draw $ do
size (maybe screenWidth fromInt w) (maybe screenHeight fromInt h)
background bgc
translate (intToFloat screenWidth/2) (intToFloat screenHeight/2)
figureEvent f
-- | Create a Processing animation from a 'Figure'-valued function.
animateFigure ::
Maybe Int -- ^ Width (if none, takes as much as is available).
-> Maybe Int -- ^ Height (if none, takes as much as is available).
-> Int -- ^ Frame rate.
-> Color -- ^ Background color.
-> (Proc_Int -> Figure) -- ^ Function to produce the next frame of animation,
-- given the current frame number.
-> ProcScript
animateFigure mw mh fr bgc f = execScriptM $ do
on Setup $ do
setFrameRate $ fromInt fr
on Draw $ do
let w = maybe screenWidth fromInt mw
h = maybe screenHeight fromInt mh
size w h
background bgc
translate (intToFloat w/2) (intToFloat h/2)
frameCount >>= figureEvent . f
-- | Framework to create interactive scripts.
--
-- Note that is required for the state to be an instance of 'CustomValue'.
-- More info on how to instantiate a type in the 'CustomValue' class in the
-- "Graphics.Web.Processing.Mid.CustomVar" module.
interactiveFigure :: CustomValue w
=> Maybe Int -- ^ Width (if none, takes as much as is available).
-> Maybe Int -- ^ Height (if none, takes as much as is available).
-> Int -- ^ Frame rate.
-> w -- ^ Initial state.
-> (w -> Figure) -- ^ How to print the state.
-> (w -> Color) -- ^ Background color, depending on the current state.
-> (Proc_Int -> w -> w) -- ^ Function to step the world one iteration.
-- It is passed the number of frames from the
-- beginning.
-> (Proc_Point -> w -> w) -- ^ Function called each time the mouse is clicked.
-> [(Key,w -> w)] -- ^ Key events. List of pairs, where the first component is
-- a 'Key' and the second component is the reaction to that
-- 'Key'.
-> ProcScript
interactiveFigure mw mh framerate s0 _print bg step onclick keyevents = execScriptM $ do
let w = maybe screenWidth fromInt mw
h = maybe screenHeight fromInt mh
v <- newVarC s0
keyv <- newVar true
on Setup $ do
setFrameRate $ fromInt framerate
on Draw $ do
size w h
translate (intToFloat w/2) (intToFloat h/2)
writeComment "Read state"
s <- readVarC v
writeComment "Background color"
background $ bg s
writeComment "Draw state"
figureEvent $ _print s
writeComment $ "Update state"
n <- frameCount
writeVarC v $ step n s
on MouseClicked $ do
writeComment "Read state"
s <- readVarC v
writeComment "Mouse event"
p <- getMousePoint
writeVarC v $ onclick p s
on KeyPressed $ mapM_ (keyEvent v keyv) keyevents
keyEvent :: CustomValue w
=> CustomVar w -> Var Proc_Bool -> (Key,w -> w) -> EventM KeyPressed ()
keyEvent v keyv (k,f) = do
matchKey keyv k
b <- readVar keyv
iff b (readVarC v >>= writeVarC v . f)
(return ())
writeVar keyv true