packages feed

processing (empty) → 1.0.0.0

raw patch · 18 files changed

+2738/−0 lines, 18 filesdep +basedep +blaze-htmldep +containerssetup-changed

Dependencies added: base, blaze-html, containers, mainland-pretty, multiset, text, transformers

Files

+ Graphics/Web/Processing.hs view
@@ -0,0 +1,9 @@++-- | This module re-exports the /mid/ interface+--   to /processing/. +module Graphics.Web.Processing (+  -- * Mid interface+  module Graphics.Web.Processing.Mid+  ) where++import Graphics.Web.Processing.Mid
+ Graphics/Web/Processing/Basic.hs view
@@ -0,0 +1,25 @@++-- | The /basic/ interface is the closest to the original.+--   Although it contains some variations too.+--+--   For several reasons, it is recommended to use the /mid/+--   interface instead, which can be found in the+--   "Graphics.Web.Processing.Mid" module.+module Graphics.Web.Processing.Basic (+    -- * Types+    module Graphics.Web.Processing.Core.Types+    -- * Monad+  , ProcM , runProcM, execProcM+    -- * Variables+  , module Graphics.Web.Processing.Core.Var+    -- * Interface+  , module Graphics.Web.Processing.Core.Interface+  ) where++-- Internal+import Graphics.Web.Processing.Core.Types+import Graphics.Web.Processing.Core.Monad+import Graphics.Web.Processing.Core.Var+import Graphics.Web.Processing.Core.Interface++
+ Graphics/Web/Processing/Core/Interface.hs view
@@ -0,0 +1,302 @@++{-# LANGUAGE OverloadedStrings #-}++-- | Variables, commands and functions. The /interface/ to+--   the processing.js API (<http://processingjs.org/reference>),+--   with some additions, deletions and modifications.+module Graphics.Web.Processing.Core.Interface (+   -- * Predefined values+     screenWidth, screenHeight+   -- * Commands+   -- ** General+   , noise+   -- ** Drawing+   , Drawing+   -- *** Colors+   , Color (..)+   , stroke, fill, background+   -- *** Stroke settings+   , strokeWeight+   -- *** Figures+   , Proc_Point+   , ellipse+   , circle+   , arc+   , line+   , point+   , quad+   , rect+   , triangle+   , bezier+   , polygon+   -- *** Text+   , drawtext+   -- ** Setup+   , size+   , setFrameRate+   -- * Transformations+   , translate+   , rotate+   , scale+   , resetMatrix+   -- * Mouse+   , getMousePoint+   -- * Conditionals+   , iff+   -- * Others+   , frameCount+   , getFrameRate+   , writeComment+   -- * Processing monads+   , ProcMonad+   ) where++-- Internal+import Graphics.Web.Processing.Core.Primal+import Graphics.Web.Processing.Core.Monad+import Graphics.Web.Processing.Core.Var (readVar)++---- PREDEFINED VALUES++-- | Width of the canvas.+screenWidth :: Proc_Int+screenWidth = proc_read $ varFromText "screenWidth"++-- | Height of the canvas.+screenHeight :: Proc_Int+screenHeight = proc_read $ varFromText "screenHeight"++---- PREDEFINED VARIABLES++-- | Frames since the beginning of the script execution.+frameCount :: (ProcMonad m, Monad (m c)) => m c Proc_Int+frameCount = readVar $ varFromText "frameCount"++-- | Approximate number of frames per second.+getFrameRate :: (ProcMonad m, Monad (m c)) => m c Proc_Int+getFrameRate = readVar $ varFromText "frameRate"++-- COMMANDS++---- GENERAL++-- | Noise random function.+noise :: (ProcMonad m, Monad (m c)) => Proc_Point -> m c Proc_Float+noise (x,y) = return $ noisef x y++---- DRAWING++-- | Class of contexts where the user can draw pictures+--   in the screen. Instances:+--+-- * 'Setup'+--+-- * 'Draw'+--+-- * 'MouseClicked'+--+-- * 'MouseReleased'+class Drawing a where++instance Drawing Setup where+instance Drawing Draw where+instance Drawing MouseClicked where+instance Drawing MouseReleased where++------ COLORS++-- | RGBA colors. Values must be between+--   0 and 255, including in the alpha channel.+data Color = Color {+    -- | Red channel.+    redc   :: Proc_Int+    -- | Blue channel.+  , bluec  :: Proc_Int+    -- | Green channel.+  , greenc :: Proc_Int+    -- | Alpha channel (opacity).+    -- 0 means transparent, and 255 opaque.+  , alphac :: Proc_Int+    }++colorArgs :: Color -> [ProcArg]+colorArgs (Color r g b a) = fmap proc_arg [r,g,b,a]++-- | Set the drawing color.+stroke :: (ProcMonad m, Drawing c) => Color -> m c ()+stroke = commandM "stroke" . colorArgs++-- | Set the filling color.+fill :: (ProcMonad m, Drawing c) => Color -> m c ()+fill = commandM "fill" . colorArgs++-- | Fill the screen with a given color.+background :: (ProcMonad m, Drawing c) => Color -> m c ()+background = commandM "background" . colorArgs++-- | Set the weight of the lines.+strokeWeight :: (ProcMonad m, Drawing c) => Proc_Int -> m c ()+strokeWeight n = commandM "strokeWeight" [proc_arg n]++------ FIGURES++-- | A point as a pair of floating point numbers.+type Proc_Point = (Proc_Float,Proc_Float)++-- | Draw a ellipse.+ellipse :: (ProcMonad m, Drawing c)+        => Proc_Point -- ^ Center of the ellipse.+        -> Proc_Float -- ^ Width of the ellipse.+        -> Proc_Float -- ^ Height of the ellipse.+        -> m c ()+ellipse (x,y) w h = commandM "ellipse" $ fmap proc_arg [x,y,w,h]++-- | Draw a circle.+circle :: (ProcMonad m, Drawing c)+       => Proc_Point -- ^ Center of the circle.+       -> Proc_Float -- ^ Radius.+       -> m c ()+circle p r = ellipse p (2*r) (2*r)++-- | Draw an arc.+--+--   The arc is drawn following the line of an ellipse+--   between two angles.+arc :: (ProcMonad m, Drawing c)+    => Proc_Point -- ^ Center of the ellipse.+    -> Proc_Float -- ^ Width of the ellipse.+    -> Proc_Float -- ^ Height of the ellipse.+    -> Proc_Float -- ^ Initial angle (in radians).+    -> Proc_Float -- ^ End angle (in radians).+    -> m c ()+arc (x,y) w h a0 a1 = commandM "arc" $ fmap proc_arg [x,y,w,h,a0,a1]++-- | Draw a line.+line :: (ProcMonad m, Drawing c)+     => Proc_Point -- ^ Starting point.+     -> Proc_Point -- ^ End point.+     -> m c ()+line (x0,y0) (x1,y1) = commandM "line" $ fmap proc_arg [x0,y0,x1,y1]++-- | Prints a dot.+point :: (ProcMonad m, Drawing c)+      => Proc_Point -- ^ Location of the point.+      -> m c ()+point (x,y) = commandM "point" $ fmap proc_arg [x,y]++-- | A quad is a quadrilateral, a four sided polygon.+--   The first parameter is the first vertex and the+--   subsequent parameters should proceed clockwise or+--   counter-clockwise around the defined shape.+quad :: (ProcMonad m, Drawing c)+     => Proc_Point -> Proc_Point -> Proc_Point -> Proc_Point+     -> m c ()+quad (x0,y0) (x1,y1) (x2,y2) (x3,y3) =+  commandM "quad" $ fmap proc_arg [x0,y0,x1,y1,x2,y2,x3,y3]++-- | Draws a rectangle to the screen. A rectangle is a+--   four-sided shape with every angle at ninety degrees.+--   The first parameter set the location, the+--   second sets the width, and the third sets the height.+rect :: (ProcMonad m, Drawing c)+     => Proc_Point -- ^ Location of the rectangle.+     -> Proc_Float -- ^ Width of the rectangle.+     -> Proc_Float -- ^ Height of the rectangle.+     -> m c ()+rect (x,y) w h = commandM "rect" $ fmap proc_arg [x,y,w,h]++-- | A triangle is a plane created by connecting three points.+triangle :: (ProcMonad m, Drawing c)+         => Proc_Point -> Proc_Point -> Proc_Point+         -> m c ()+triangle (x0,y0) (x1,y1) (x2,y2) =+  commandM "triangle" $ fmap proc_arg [x0,y0,x1,y1,x2,y2]++-- | Bézier curve.+bezier :: (ProcMonad m, Drawing c)+       => Proc_Point -- ^ Initial point.+       -> Proc_Point -- ^ First control point.+       -> Proc_Point -- ^ Second control point.+       -> Proc_Point -- ^ End point.+       -> m c ()+bezier (x0,y0) (x1,y1) (x2,y2) (x3,y3) =+  commandM "bezier" $ fmap proc_arg [x0,y0,x1,y1,x2,y2,x3,y3]++-- | Begin shape command. Not exported.+beginShape :: (ProcMonad m, Drawing c) => m c ()+beginShape = commandM "beginShape" []++-- | End shape command. Not exported.+endShape :: (ProcMonad m, Drawing c) => m c ()+endShape = commandM "endShape" []++-- | Vertex command. Not exported.+vertex :: (ProcMonad m, Drawing c) => Proc_Point -> m c ()+vertex (x,y) = commandM "vertex" [proc_arg x,proc_arg y]++-- | Polygon drawer.+polygon :: (ProcMonad m, Monad (m c), Drawing c) => [Proc_Point] -> m c ()+polygon ps = beginShape >> mapM_ vertex ps >> endShape++---- TEXT++-- | Display a text in the screen.+--   The color is specified by 'fill'.+drawtext :: (ProcMonad m, Drawing c)+         => Proc_Text  -- ^ Text to draw.+         -> Proc_Point -- ^ Position.+         -> Proc_Float -- ^ Width.+         -> Proc_Float -- ^ Height.+         -> m c ()+drawtext t (x,y) w h =+  commandM "text" $ [ proc_arg t+                    , proc_arg x, proc_arg y+                    , proc_arg w, proc_arg h+                      ]++---- TRANSFORMATIONS++-- | Apply a rotation to the following pictures, centered+--   at the current position.+rotate :: (ProcMonad m, Drawing c) => Proc_Float -> m c ()+rotate a = commandM "rotate" [ proc_arg a ]++-- | Apply a scaling to the following pictures, centered+--   at the current position.+scale :: (ProcMonad m, Drawing c)+      => Proc_Float -- ^ Horizontal scaling.+      -> Proc_Float -- ^ Vertical scaling.+      -> m c ()+scale x y = commandM "scale" [ proc_arg x, proc_arg y ]++-- | Move the current position.+translate :: (ProcMonad m, Drawing c)+          => Proc_Float -- ^ Horizontal displacement.+          -> Proc_Float -- ^ Vertical displacement.+          -> m c ()+translate x y = commandM "translate" [ proc_arg x, proc_arg y ]++-- | Reset the transformation matrix.+resetMatrix :: (ProcMonad m, Drawing c)+            => m c ()+resetMatrix = commandM "resetMatrix" []++---- MOUSE++-- | Get the current position of the mouse pointer.+getMousePoint :: (ProcMonad m, Monad (m c)) => m c Proc_Point+getMousePoint = do+ x <- readVar $ varFromText "mouseX"+ y <- readVar $ varFromText "mouseY"+ return (x,y)++---- SETUP++-- | Set the size of the canvas.+size :: ProcMonad m => Proc_Int -> Proc_Int -> m c ()+size w h = commandM "size" [proc_arg w, proc_arg h]++-- | Specify the number of frames to be displayed every second.+--   The default rate is 60 frames per second.+setFrameRate :: ProcMonad m => Proc_Int -> m Setup ()+setFrameRate r = commandM "frameRate" [proc_arg r]
+ Graphics/Web/Processing/Core/Monad.hs view
@@ -0,0 +1,106 @@++-- | Processing code writer monad.+module Graphics.Web.Processing.Core.Monad (+    ProcM+  , runProcM, execProcM+  , runProcMWith+  , ProcMonad (..)+  , newVarNumber+  , getVarNumber+  , setVarNumber+  ) where++import Control.Arrow (second)+import Control.Monad.Trans.Class+import Control.Monad.Trans.Writer.Strict+import Control.Monad.Trans.State.Strict+import Graphics.Web.Processing.Core.Primal+import Control.Applicative (Applicative (..))+import Data.Text (Text)++-- | Processing script producer monad. The context @c@ indicates the context+--   of the underlying 'ProcCode'. This context restricts the use of certain+--   commands only to places where they are expected.+--+--   The commands that you can run under this monad are mostly defined in+--   "Graphics.Web.Processing.Interface".+--+--   Once you have all the commands you want, use 'runProcM' or 'execProcM'+--   to generate the corresponding Processing code under the 'ProcCode' type.+newtype ProcM c a = ProcM { unProcM :: StateT Int (Writer (ProcCode c)) a }++-- | Generate Processing code using the 'ProcM' monad.+--   The code output is reduced.+runProcM :: ProcM c a -> (a,ProcCode c)+runProcM = runProcMWith 0++-- | Run a 'ProcM' computation with an initial var number.+--   It also applies a reduction to the output Processing code.+runProcMWith :: Int -> ProcM c a -> (a,ProcCode c)+runProcMWith n = second reduce . runWriter . (\sw -> evalStateT sw n) . unProcM++-- | Generate Processing code using the 'ProcM' monad, discarding the final+--   value.+--+-- > execProcM = snd . runProcM+--+execProcM :: ProcM c a -> ProcCode c+execProcM = snd . runProcM++instance Functor (ProcM c) where+ fmap f (ProcM w) = ProcM $ fmap f w+ +instance Applicative (ProcM c) where+ pure x = ProcM $ pure x+ pf <*> p = ProcM $ unProcM pf <*> unProcM p++instance Monad (ProcM c) where+ return = pure+ (ProcM w) >>= f = ProcM $ w >>= unProcM . f++-- | Adds @1@ to the variable counter and returns the result.+newVarNumber :: ProcM c Int+newVarNumber = ProcM $ modify (+1) >> get++-- | Get the current variable number.+getVarNumber :: ProcM c Int+getVarNumber = ProcM get++-- | Set the current variable number.+setVarNumber :: Int -> ProcM c ()+setVarNumber = ProcM . put++-- Processing Monad class++-- | Types in this instance form a monad when they are applied+--   to a context @c@. Then, they are used to write Processing+--   code.+class ProcMonad m where+ -- | Internal function to process commands in the target monad.+ commandM :: Text -> [ProcArg] -> m c ()+ -- | Internal function to process asignments in the target monad.+ assignM :: ProcAsign -> m c ()+ -- | Internal function to process variable creations in the target monad.+ createVarM :: ProcAsign -> m c ()+ -- | Write a comment in the code.+ writeComment :: Text -> m c ()+ -- | Conditional execution.+ iff :: Proc_Bool -- ^ Condition.+     -> m c a -- ^ Execution when the condition is 'true'.+     -> m c b -- ^ Execution when the condition is 'false'.+     -> m c ()+ -- | Lift a 'ProcM' computation.+ liftProc :: ProcM c a -> m c a++instance ProcMonad ProcM where+ commandM n as = ProcM $ lift $ tell $ command n as+ assignM = ProcM . lift . tell . assignment+ createVarM = ProcM . lift . tell . createVar+ writeComment = ProcM . lift . tell . comment+ iff b (ProcM e1) (ProcM e2) = ProcM $ do+   i0 <- get+   let (i1,c1) = runWriter $ execStateT e1 i0+       (i2,c2) = runWriter $ execStateT e2 i1+   put i2+   lift $ tell $ conditional b c1 c2+ liftProc = id
+ Graphics/Web/Processing/Core/Primal.hs view
@@ -0,0 +1,837 @@++{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses, FunctionalDependencies #-}++-- | Internal module. Mostly for type definitions+--   and class instances.+module Graphics.Web.Processing.Core.Primal (+  -- * Types+  -- ** Singleton types+  -- | A list of singleton types, used to restrict the+  --   use of certain commands to specific contexts.+    Preamble (..), Setup (..), Draw (..)+  , MouseClicked (..), MouseReleased (..)+  -- ** Processing types+  -- *** Boolean+  , Proc_Bool, fromBool+  , true, false+  , pnot, (#||), (#&&)+  -- *** Int+  , Proc_Int, fromInt+  , pfloor+  -- *** Float+  , Proc_Float (..), fromFloat+  , recFloat+  , intToFloat+  , noisef+  -- *** Image+  , Proc_Image+  -- *** Char+  , Proc_Char , fromChar+  -- *** Text+  , Proc_Text, fromStText+  -- ** Type class of proc types+  , ProcType (..)+  -- ** Conditionals+  , Proc_Eq (..)+  , Proc_Ord (..)+  -- ** Reductions+  , Reducible (..)+  -- ** Variables+  , Var, varName, varFromText+  -- ** Script+  , ProcCode (..), ProcArg (..), ProcAsign (..)+  , emptyCode+  , command , assignment, createVar, comment+  , conditional+  , (>>.)+  , ProcScript (..)+  , emptyScript+  ) where++{- Notes on this module++This module needs some work to be refactored, probably+in different submodules. Currently, it's getting too long+and is potentially going to grow even more. Also, it has+code for unrelated tasks: types, code reduction, variables,+events, etc. I think 'Reducible' deserves a module by itself.++-}++import Prelude hiding (foldr)+import Data.Text (Text,lines)+import qualified Data.Sequence as Seq+import Data.Monoid+import Data.String+import Data.Foldable (foldMap,foldr)+import Control.Applicative (liftA2)+-- Pretty+import Text.PrettyPrint.Mainland++-- | The /preamble/ is the code that is executed+--   at the beginning of the script.+data Preamble = Preamble++-- | In the /setup/ part, settings like /size/ or+--   /frame rate/ are supplied.+data Setup = Setup++-- | The drawing loop.+data Draw = Draw++-- | Code that is executed when the mouse is clicked.+data MouseClicked = MouseClicked++-- | Code that is executed when the mouse is released.+data MouseReleased = MouseReleased++-- PRETTY-HELPERS++pfunction :: Text -> [Doc] -> Doc+pfunction n as = fromText n <> parens (commasep as)++-- TYPES++class Extended from to | to -> from where+ extend :: from -> to+ patmatch :: to -> Maybe from++extendf :: Extended from to+        => (from -> from) -> (to -> to) -> (to -> to)+extendf f g x =+  case patmatch x of+    Nothing -> g x+    Just a  -> extend $ f a++extendop :: Extended from to+         => (from -> from -> from)+         -> (to   -> to   -> to)+         -> (to   -> to   -> to)+extendop f g x y =+  case (patmatch x, patmatch y) of+    (Just a, Just b) -> extend $ f a b+    _ -> g x y++-- | Boolean values.+data Proc_Bool =+   Proc_True+ | Proc_False+   -- Operations+ | Proc_Neg Proc_Bool+ | Proc_Or Proc_Bool Proc_Bool+ | Proc_And Proc_Bool Proc_Bool+   -- Variables+ | Bool_Var Text+   -- Comparisons+     -- Bool+   | Bool_Eq Proc_Bool Proc_Bool+   | Bool_NEq Proc_Bool Proc_Bool+     -- Int (with order)+   | Int_Eq Proc_Int Proc_Int+   | Int_NEq Proc_Int Proc_Int+   | Int_LE Proc_Int Proc_Int+   | Int_L Proc_Int Proc_Int+   | Int_GE Proc_Int Proc_Int+   | Int_G Proc_Int Proc_Int+     -- Float (with order)+   | Float_Eq Proc_Float Proc_Float+   | Float_NEq Proc_Float Proc_Float+   | Float_LE Proc_Float Proc_Float+   | Float_L Proc_Float Proc_Float+   | Float_GE Proc_Float Proc_Float+   | Float_G Proc_Float Proc_Float+     -- Char+   | Char_Eq Proc_Char Proc_Char+   | Char_NEq Proc_Char Proc_Char+     -- Text+   | Text_Eq Proc_Text Proc_Text+     deriving Eq++instance Extended Bool Proc_Bool where+ extend True  = Proc_True + extend False = Proc_False+ patmatch Proc_True = Just True+ patmatch Proc_False = Just False+ patmatch _ = Nothing++-- Doc helpers++docEq :: Doc+docEq = fromText "=="++docNEq :: Doc+docNEq = fromText "!="++docLE :: Doc+docLE = fromText "<="++docL :: Doc+docL = fromText "<"++docGE :: Doc+docGE = fromText ">="++docG :: Doc+docG = fromText ">"++indentLevel :: Int+indentLevel = 3++instance Pretty Proc_Bool where+ ppr Proc_True = fromText "true"+ ppr Proc_False = fromText "false"+ ppr (Proc_Neg b) = fromText "!" <> ppr b+ ppr (Proc_Or b1 b2)  = parens $ ppr b1 <+> fromText "||" <+> ppr b2+ ppr (Proc_And b1 b2) = parens $ ppr b1 <+> fromText "&&" <+> ppr b2+ ppr (Bool_Var t) = fromText t+ -- Comparisons+ ppr (Bool_Eq x y) = parens $ ppr x <+> docEq <+> ppr y+ ppr (Bool_NEq x y) = parens $ ppr x <+> docNEq <+> ppr y+ ppr (Int_Eq x y) = parens $ ppr x <+> docEq <+> ppr y+ ppr (Int_NEq x y) = parens $ ppr x <+> docNEq <+> ppr y+ ppr (Int_LE x y) = parens $ ppr x <+> docLE <+> ppr y+ ppr (Int_L x y) = parens $ ppr x <+> docL <+> ppr y+ ppr (Int_GE x y) = parens $ ppr x <+> docGE <+> ppr y+ ppr (Int_G x y) = parens $ ppr x <+> docG <+> ppr y+ ppr (Float_Eq x y) = parens $ ppr x <+> docEq <+> ppr y+ ppr (Float_NEq x y) = parens $ ppr x <+> docNEq <+> ppr y+ ppr (Float_LE x y) = parens $ ppr x <+> docLE <+> ppr y+ ppr (Float_L x y) = parens $ ppr x <+> docL <+> ppr y+ ppr (Float_GE x y) = parens $ ppr x <+> docGE <+> ppr y+ ppr (Float_G x y) = parens $ ppr x <+> docG <+> ppr y+ ppr (Char_Eq x y) = parens $ ppr x <+> docEq <+> ppr y+ ppr (Char_NEq x y) = parens $ ppr x <+> docNEq <+> ppr y+ ppr (Text_Eq x y) = ppr x <> fromText "." <> pfunction "equals" [ppr y]++-- | Value of 'True'.+true :: Proc_Bool+true = Proc_True++-- | Value of 'False'.+false :: Proc_Bool+false = Proc_False++-- | Negation.+pnot :: Proc_Bool -> Proc_Bool+pnot = extendf not Proc_Neg++infixr 2 #||++-- | Disjunction.+(#||) :: Proc_Bool -> Proc_Bool -> Proc_Bool+(#||) = extendop (||) Proc_Or++infixr 3 #&&++-- | Conjunction.+(#&&) :: Proc_Bool -> Proc_Bool -> Proc_Bool+(#&&) = extendop (&&) Proc_And++-- | Cast a 'Bool' value.+fromBool :: Bool -> Proc_Bool+fromBool = extend++-- | Integer numbers.+data Proc_Int =+   Proc_Int Int+   -- Operations+ | Int_Sum Proc_Int Proc_Int+ | Int_Substract Proc_Int Proc_Int+ | Int_Divide Proc_Int Proc_Int+ | Int_Mult Proc_Int Proc_Int+ | Int_Mod Proc_Int Proc_Int+   -- Variables+ | Int_Var Text+   -- Functions+ | Int_Abs Proc_Int+ | Int_Floor Proc_Float+   deriving Eq++instance Extended Int Proc_Int where+ extend = Proc_Int+ patmatch (Proc_Int a) = Just a+ patmatch _ = Nothing++instance Pretty Proc_Int where+ ppr (Proc_Int i) = ppr i+ ppr (Int_Sum n m) = parens $ ppr n <> fromText "+" <> ppr m+ ppr (Int_Substract n m) = parens $ ppr n <> fromText "-" <> ppr m+ ppr (Int_Divide n m) = parens $ ppr n <> fromText "/" <> ppr m+ ppr (Int_Mult n m) = parens $ ppr n <> fromText "*" <> ppr m+ ppr (Int_Mod n m) = parens $ ppr n <> fromText "%" <> ppr m+ ppr (Int_Var t) = fromText t+ ppr (Int_Abs n) = pfunction "abs" [ppr n]+ ppr (Int_Floor x) = pfunction "floor" [ppr x]++-- | Cast an 'Int' value.+fromInt :: Int -> Proc_Int+fromInt = extend++-- | Calculates the 'floor' of a 'Proc_Float'.+pfloor :: Proc_Float -> Proc_Int+pfloor (Proc_Float x) = Proc_Int $ floor x+pfloor x = Int_Floor x++instance Ord Proc_Int where+ n <= m = case liftA2 (<=) (patmatch n) (patmatch m) of+   Nothing -> error "Proc_Int: (<=) applied to a variable."+   Just b -> b++instance Enum Proc_Int where+ toEnum = fromInt+ fromEnum n = case patmatch n of+  Nothing -> error "Proc_Int: fromEnum applied to a variable."+  Just i -> i+ succ n = n + 1+ pred n = n - 1++-- | WARNING: 'signum' method is undefined.+instance Num Proc_Int where+ fromInteger = fromInt . fromInteger+ (+) = extendop (+) Int_Sum+ (-) = extendop (-) Int_Substract+ (*) = extendop (*) Int_Mult+ abs = extendf abs Int_Abs+ signum = error "Proc_Int: signum method is undefined."++instance Real Proc_Int where+ toRational n = case patmatch n of+   Nothing -> error "Proc_Int: toRational applied to a variable."+   Just i -> toRational i++instance Integral Proc_Int where+ div = extendop div Int_Divide+ mod = extendop mod Int_Mod+ divMod n d = (div n d, mod n d)+ toInteger n = case patmatch n of+   Nothing -> error "Proc_Int: toInteger applied to a variable."+   Just i  -> toInteger i++-- | Floating point numbers.+--   The provided 'Eq' instance checks the equality of the+--   internal expression, not the value.+data Proc_Float =+   Proc_Float Float+   -- Operations+ | Float_Sum Proc_Float Proc_Float+ | Float_Substract Proc_Float Proc_Float+ | Float_Divide Proc_Float Proc_Float+ | Float_Mult Proc_Float Proc_Float+ | Float_Mod Proc_Float Proc_Float+   -- Variables+ | Float_Var Text+   -- Functions+ | Float_Abs Proc_Float+ | Float_Exp Proc_Float+ | Float_Sqrt Proc_Float+ | Float_Log Proc_Float+ | Float_Sine Proc_Float+ | Float_Cosine Proc_Float+ | Float_Arcsine Proc_Float+ | Float_Arccosine Proc_Float+ | Float_Arctangent Proc_Float+ | Float_Floor Proc_Float -- Applies floor but it treats the result+                          -- as a float. Only internal.+ | Float_Noise Proc_Float Proc_Float+   deriving (Eq,Ord)++instance Extended Float Proc_Float where+ extend = Proc_Float+ patmatch (Proc_Float x) = Just x+ patmatch _ = Nothing++-- | /Float recursion/. Applies a function to the subexpressions+--   of a 'Proc_Float'.+recFloat :: (Proc_Float -> Proc_Float) -> Proc_Float -> Proc_Float+recFloat f (Float_Sum x y) = Float_Sum (f x) (f y)+recFloat f (Float_Substract x y) = Float_Substract (f x) (f y)+recFloat f (Float_Divide x y) = Float_Divide (f x) (f y)+recFloat f (Float_Mult x y) = Float_Mult (f x) (f y)+recFloat f (Float_Mod x y) = Float_Mod (f x) (f y)+recFloat f (Float_Abs x) = Float_Abs $ f x+recFloat f (Float_Exp x) = Float_Exp $ f x+recFloat f (Float_Sqrt x) = Float_Sqrt $ f x+recFloat f (Float_Log x) = Float_Log $ f x+recFloat f (Float_Sine x) = Float_Sine $ f x+recFloat f (Float_Cosine x) = Float_Cosine $ f x+recFloat f (Float_Arcsine x) = Float_Arcsine $ f x+recFloat f (Float_Arccosine x) = Float_Arccosine $ f x+recFloat f (Float_Arctangent x) = Float_Arctangent $ f x+recFloat f (Float_Floor x) = Float_Floor $ f x+recFloat f (Float_Noise x y) = Float_Noise (f x) (f y)+recFloat _ x = x++instance Pretty Proc_Float where + ppr (Proc_Float f) = ppr f+ ppr (Float_Sum x y) = parens $ ppr x <> fromText "+" <> ppr y+ ppr (Float_Substract x y) = parens $ ppr x <> fromText "-" <> ppr y+ ppr (Float_Divide x y) = parens $ ppr x <> fromText "/" <> ppr y+ ppr (Float_Mult x y) = parens $ ppr x <> fromText "*" <> ppr y+ ppr (Float_Mod x y) = parens $ ppr x <> fromText "%" <> ppr y+ ppr (Float_Var t) = fromText t+ ppr (Float_Abs x) = pfunction "abs" [ppr x]+ ppr (Float_Exp x) = pfunction "exp" [ppr x]+ ppr (Float_Sqrt x) = pfunction "sqrt" [ppr x]+ ppr (Float_Log x) = pfunction "log" [ppr x]+ ppr (Float_Sine x) = pfunction "sin" [ppr x]+ ppr (Float_Cosine x) = pfunction "cos" [ppr x]+ ppr (Float_Arcsine x) = pfunction "asin" [ppr x]+ ppr (Float_Arccosine x) = pfunction "acos" [ppr x]+ ppr (Float_Arctangent x) = pfunction "atan" [ppr x]+ ppr (Float_Floor x) = pfunction "floor" [ppr x]+ ppr (Float_Noise x y) = pfunction "noise" [ppr x,ppr y]++-- | Cast a 'Float' value.+fromFloat :: Float -> Proc_Float+fromFloat = extend++-- | Noise random function.+noisef :: Proc_Float -> Proc_Float -> Proc_Float+noisef = Float_Noise++-- | Cast a 'Proc_Int' to a 'Proc_Float'.+intToFloat :: Proc_Int -> Proc_Float+intToFloat (Proc_Int i) = Proc_Float $ fromIntegral i+intToFloat (Int_Sum n m) = Float_Sum (intToFloat n) (intToFloat m)+intToFloat (Int_Substract n m) = Float_Substract (intToFloat n) (intToFloat m)+intToFloat (Int_Divide n m) = Float_Divide (intToFloat n) (intToFloat m)+intToFloat (Int_Mult n m) = Float_Mult (intToFloat n) (intToFloat m)+intToFloat (Int_Mod n m) = Float_Mod (intToFloat n) (intToFloat m)+intToFloat (Int_Var t) = Float_Var t+intToFloat (Int_Abs n) = Float_Abs $ intToFloat n+intToFloat (Int_Floor x) = Float_Floor x++-- | WARNING: 'signum' method is undefined.+instance Num Proc_Float where+ fromInteger = fromFloat . fromInteger+ (+) = extendop (+) Float_Sum+ (-) = extendop (-) Float_Substract+ (*) = extendop (*) Float_Mult+ abs = extendf abs Float_Abs+ signum = error "Proc_Float: signum method is undefined."++instance Fractional Proc_Float where+ (/) = extendop (/) Float_Divide+ fromRational = fromFloat . fromRational++-- | WARNING: 'sinh', 'cosh', 'asinh', 'acosh' and 'atanh'+--   methods are undefined.+instance Floating Proc_Float where+ pi = extend pi+ exp = extendf exp Float_Exp+ sqrt = extendf sqrt Float_Sqrt+ log = extendf log Float_Log+ sin = extendf sin Float_Sine+ cos = extendf cos Float_Cosine+ asin = extendf asin Float_Arcsine+ acos = extendf acos Float_Arccosine+ atan = extendf atan Float_Arctangent+ -- UNDEFINED+ sinh = error "Proc_Float: sinh method is undefined."+ cosh = error "Proc_Float: cosh method is undefined."+ asinh = error "Proc_Float: asinh method is undefined."+ acosh = error "Proc_Float: acosh method is undefined."+ atanh = error "Proc_Float: atanh method is undefined."++-- | Type of images.+data Proc_Image = Image_Var Text deriving Eq++instance Pretty Proc_Image where+ ppr (Image_Var t) = fromText t++-- | Type of characters.+data Proc_Char =+   Proc_Char Char+ | Char_Var Text+   deriving Eq++instance Extended Char Proc_Char where+ extend = Proc_Char+ patmatch (Proc_Char c) = Just c+ patmatch _ = Nothing++-- | Cast a 'Char' value.+fromChar :: Char -> Proc_Char+fromChar = extend++instance Pretty Proc_Char where+ ppr (Proc_Char c) = enclose squote squote (char c)+ ppr (Char_Var n) = fromText n++-- | Type of textual values.+data Proc_Text =+   Proc_Text Text+ | Text_Var Text+   deriving Eq++instance Extended Text Proc_Text where+ extend = Proc_Text+ patmatch (Proc_Text t) = Just t+ patmatch _ = Nothing++instance Pretty Proc_Text where+ ppr (Proc_Text t) = enclose dquote dquote (fromText t)+ ppr (Text_Var n) = fromText n++-- | Cast a strict 'Text' value.+fromStText :: Text -> Proc_Text+fromStText = extend++instance IsString Proc_Text where+ fromString = fromStText . fromString++-- CODE++-- | A piece of Processing code.+--   The type parameter indicates what the+--   context of the code is.+--   This context will allow or disallow+--   the use of certain commands.+data ProcCode c = +   Command Text [ProcArg] + | CreateVar ProcAsign+ | Assignment ProcAsign+ | Conditional Proc_Bool   -- IF+              (ProcCode c) -- THEN+              (ProcCode c) -- ELSE+ | Comment Text+ | Sequence (Seq.Seq (ProcCode c))+   deriving Eq++instance Pretty (ProcCode c) where+ ppr (Command n as) = pfunction n (fmap ppr as) <+> fromText ";"+ ppr (CreateVar a) = ptype a <+> ppr a <+> fromText ";"+ ppr (Assignment a) = ppr a <+> fromText ";"+ ppr (Conditional b e1 e2) =+   let c1 = indent indentLevel $ ppr e1+       c2 = indent indentLevel $ ppr e2+   in  pfunction "if" [ppr b]+   <+> enclose lbrace rbrace (line <> c1)+   <+> fromText "else" <+> enclose lbrace rbrace (line <> c2)+ ppr (Comment t) = stack $ fmap (fromText . ("// " <>)) $ Data.Text.lines t+ ppr (Sequence sq) =+   if Seq.null sq then Text.PrettyPrint.Mainland.empty+                  else foldMap ((<> line) . ppr) sq++-- | Code for commands.+command :: Text -- ^ Name of the command.+        -> [ProcArg] -- ^ Arguments.+        -> ProcCode c -- ^ Code result.+command = Command++-- | Code for assignments.+assignment :: ProcAsign -- ^ Assignment.+           -> ProcCode c -- ^ Code result.+assignment = Assignment++-- | Code for variable creation.+createVar :: ProcAsign -- ^ Initial assignment.+          -> ProcCode c -- ^ Code result.+createVar = CreateVar++-- | Code for comments.+comment :: Text -> ProcCode c+comment = Comment++-- | Code for conditionals.+conditional :: Proc_Bool -> ProcCode c -> ProcCode c -> ProcCode c+conditional = Conditional++-- | Sequence to pieces of code with the same+--   context type. This way, code that belongs+--   to different parts of the program will+--   never get mixed.+(>>.) :: ProcCode c -> ProcCode c -> ProcCode c+(Sequence xs) >>. (Sequence ys) = Sequence $ xs Seq.>< ys+(Sequence xs) >>. p = Sequence $ xs Seq.|> p+p >>. (Sequence xs) = Sequence $ p Seq.<| xs+p >>. q = Sequence $ Seq.fromList [p,q]++-- | An empty piece of code.+emptyCode :: ProcCode a+emptyCode = Sequence $ Seq.empty++instance Monoid (ProcCode a) where+ mempty = emptyCode+ mappend = (>>.)++-- | A command argument.+data ProcArg =+   BoolArg  Proc_Bool+ | IntArg   Proc_Int+ | FloatArg Proc_Float+ | ImageArg Proc_Image+ | TextArg  Proc_Text+ | CharArg  Proc_Char+   deriving Eq++instance Pretty ProcArg where+ ppr (BoolArg  b) = ppr b+ ppr (IntArg   i) = ppr i+ ppr (FloatArg f) = ppr f+ ppr (ImageArg i) = ppr i+ ppr (TextArg  t) = ppr t+ ppr (CharArg  c) = ppr c++-- | Assigments.+data ProcAsign =+   BoolAsign  Text Proc_Bool+ | IntAsign   Text Proc_Int+ | FloatAsign Text Proc_Float+ | ImageAsign Text Proc_Image+ | TextAsign  Text Proc_Text+ | CharAsign  Text Proc_Char+   deriving Eq++instance Pretty ProcAsign where+ ppr (BoolAsign  n b) = fromText n <+> fromText "=" <+> ppr b+ ppr (IntAsign   n i) = fromText n <+> fromText "=" <+> ppr i+ ppr (FloatAsign n f) = fromText n <+> fromText "=" <+> ppr f+ ppr (ImageAsign n i) = fromText n <+> fromText "=" <+> ppr i+ ppr (TextAsign  n t) = fromText n <+> fromText "=" <+> ppr t+ ppr (CharAsign  n c) = fromText n <+> fromText "=" <+> ppr c++-- | Returns the name of the type (processing version) in an assignment.+ptype :: ProcAsign -> Doc+ptype (BoolAsign  _ _) = fromText "boolean"+ptype (IntAsign   _ _) = fromText "int"+ptype (FloatAsign _ _) = fromText "float"+ptype (ImageAsign _ _) = fromText "PImage"+ptype (TextAsign  _ _) = fromText "String"+ptype (CharAsign  _ _) = fromText "char"++---- ProcType class and instances++-- | Type of variables.+data Var a = Var { -- | Get the name of a variable.+                   varName :: Text }++-- | Internal function to create variables.+varFromText :: Text -> Var a+varFromText = Var++----- CLASSES++-- | Class of Processing value types.+class ProcType a where+ -- | Create a variable assignment, provided+ --   the name of the variable and the value to asign.+ proc_asign :: Text -> a -> ProcAsign+ -- | Create an argument for a command.+ proc_arg :: a -> ProcArg+ -- | Variable reading.+ proc_read :: Var a -> a++instance ProcType Proc_Bool where+ proc_asign = BoolAsign+ proc_arg = BoolArg+ proc_read (Var v) = Bool_Var v++instance ProcType Proc_Int where+ proc_asign = IntAsign+ proc_arg = IntArg+ proc_read (Var v) = Int_Var v++instance ProcType Proc_Float where+ proc_asign = FloatAsign+ proc_arg = FloatArg+ proc_read (Var v) = Float_Var v++instance ProcType Proc_Image where+ proc_asign = ImageAsign+ proc_arg = ImageArg+ proc_read (Var v) = Image_Var v++instance ProcType Proc_Char where+ proc_asign = CharAsign+ proc_arg = CharArg+ proc_read (Var v) = Char_Var v++instance ProcType Proc_Text where+ proc_asign =  TextAsign+ proc_arg = TextArg+ proc_read (Var v) = Text_Var v++infix 4 #==, #/=++-- | 'Eq' class for @Proc_*@ values.+class Proc_Eq a where+ (#==) :: a -> a -> Proc_Bool+ (#/=) :: a -> a -> Proc_Bool+ -- Minimal default instance: (#==) or (#/=).+ x #== y = pnot $ x #/= y+ x #/= y = pnot $ x #== y++instance Proc_Eq Proc_Bool where+ (#==) = Bool_Eq+ (#/=) = Bool_NEq++instance Proc_Eq Proc_Int where+ (#==) = Int_Eq+ (#/=) = Int_NEq++instance Proc_Eq Proc_Float where+ (#==) = Float_Eq+ (#/=) = Float_NEq++instance Proc_Eq Proc_Char where+ (#==) = Char_Eq+ (#/=) = Char_NEq++instance Proc_Eq Proc_Text where+ (#==) = Text_Eq++infix 4 #<=, #<, #>=, #>++-- | 'Ord' class for @Proc_*@ values.+class Proc_Ord a where+ (#<=) :: a -> a -> Proc_Bool+ (#<)  :: a -> a -> Proc_Bool+ (#>=) :: a -> a -> Proc_Bool+ (#>)  :: a -> a -> Proc_Bool++instance Proc_Ord Proc_Int where+ (#<=) = Int_LE+ (#<)  = Int_L+ (#>=) = Int_GE+ (#>)  = Int_G++instance Proc_Ord Proc_Float where+ (#<=) = Float_LE+ (#<)  = Float_L+ (#>=) = Float_GE+ (#>)  = Float_G++-- | Class of reducible types. Values of these+--   types contain expressions that can be+--   reducible.+class Eq a => Reducible a where+ reduce :: a -> a++iteratedReduce :: Reducible a => a -> a+iteratedReduce = fst . firstWith (uncurry (==)) . pairing . iterate reduce+ where+  pairing (x:y:xs) = (x,y) : pairing (y:xs)+  pairing _ = []+  firstWith f (x:xs) = if f x then x else firstWith f xs+  firstWith _ _ = error "Error in iterated reduction. Report this as a bug."++{-++FLOAT REDUCTION++Float is probably the most common argument type.+Below a case-by-case analysis try to reduce a+float expression to its minimal extension.+The more we reduce, the more effective+will be the Processing output code, since we save+operations.++-}++instance Reducible Proc_Float where+ reduce (Float_Sum x y) =+   if x == y then 2 * reduce x+             else reduce x + reduce y+ reduce (Float_Substract x y) =+   if x == y then 0+             else reduce x - reduce y+ reduce (Float_Mult x y) =+   if x == y+      -- x*x = x^2+      then reduce x ** 2+      else reduce x * reduce y+ -- (x*y)/z = y*(x/z)+ reduce (Float_Divide (Float_Mult (Proc_Float x) y) (Proc_Float z)) =+   reduce $ (y*) $ Proc_Float $ x / z+ -- (x*y)/z = x*(y/z)+ reduce (Float_Divide (Float_Mult x (Proc_Float y)) (Proc_Float z)) =+   reduce $ (x*) $ Proc_Float $ y / z+ reduce x = recFloat reduce x++instance Reducible ProcArg where+ reduce (FloatArg x) = FloatArg $ iteratedReduce x+ reduce x = x++instance Reducible (ProcCode c) where+ reduce (Sequence sq) = Sequence $ fmap reduce $ foldr (+   \x xs -> +     case Seq.viewl xs of+      y Seq.:< ys -> case reduceProcPair x y of+                       Nothing -> x Seq.<| xs+                       Just z  -> z Seq.<| ys+      Seq.EmptyL -> Seq.singleton x+        ) Seq.empty sq+ reduce (Command n xs) = Command n $ fmap reduce xs+ reduce x = x++reduceProcPair :: ProcCode c -> ProcCode c -> Maybe (ProcCode c)+-- Translations+reduceProcPair (Command "translate" [FloatArg 0,FloatArg 0]) x = Just x+reduceProcPair x (Command "translate" [FloatArg 0,FloatArg 0]) = Just x+reduceProcPair (Command "translate" [FloatArg x,FloatArg y])+               (Command "translate" [FloatArg x',FloatArg y'])+                 = Just $ Command "translate" [ FloatArg $ x+x'+                                              , FloatArg $ y+y']+-- Rotations+reduceProcPair (Command "rotate" [FloatArg 0]) x = Just x+reduceProcPair x (Command "rotate" [FloatArg 0]) = Just x+reduceProcPair (Command "rotate" [FloatArg x])+               (Command "rotate" [FloatArg x'])+                 = Just $ Command "rotate" [FloatArg $ x+x']+reduceProcPair _ _ = Nothing++----++-- | A complete Processing script.+--+-- It consists in several parts, most of them optional.+--+-- * 'Preamble': Usually the place where variables are+--   initialized.+--+-- * 'Setup': After running the code in the preamble,+--   the code in this part is executed once.+--+-- * 'Draw': After the setup, this part of the code is+--   executed in loops over and over again.+--+-- * 'MouseClicked': Each time the user clicks, the code+--   here is executed once.+--+-- To generate each part of the code, use the 'ProcM' monad+-- and the functions from the "Graphics.Web.Processing.Interface"+-- module. Then, run 'runProcM' or 'execProcM' to get the+-- code result.+data ProcScript = ProcScript+ { proc_preamble :: ProcCode Preamble+ , proc_setup :: ProcCode Setup+ , proc_draw  :: Maybe (ProcCode Draw)+ , proc_mouseClicked :: Maybe (ProcCode MouseClicked)+ , proc_mouseReleased :: Maybe (ProcCode MouseReleased)+   }++-- | Empty script.+emptyScript :: ProcScript+emptyScript = ProcScript {+   proc_preamble = emptyCode+ , proc_setup = emptyCode+ , proc_draw = Nothing+ , proc_mouseClicked = Nothing+ , proc_mouseReleased = Nothing+   }++pvoid :: Pretty a => Text -> Maybe a -> Doc+pvoid _ Nothing = Text.PrettyPrint.Mainland.empty+pvoid n (Just c) = fromText "void" <+> fromText n <> fromText "()" <+> enclose lbrace rbrace inside+ where+  inside = line <> indent indentLevel (ppr c) <> line++instance Pretty ProcScript where+ ppr ps = stack [ +     ppr $ proc_preamble ps+   , pvoid "setup" $ Just $ proc_setup ps+   , pvoid "draw" $ proc_draw ps+   , pvoid "mouseClicked" $ proc_mouseClicked ps+   , pvoid "mouseReleased" $ proc_mouseReleased ps+     ]
+ Graphics/Web/Processing/Core/Types.hs view
@@ -0,0 +1,60 @@++-- | Collection of types.+module Graphics.Web.Processing.Core.Types (+  -- * Processing Script+    ProcScript (..)+  , emptyScript+  -- ** Script rendering+  , renderScript+  , renderFile+  -- ** Processing Code+  , ProcCode+  -- * Contexts+  , Preamble (..)+  , Setup (..)+  , Draw (..)+  , MouseClicked (..)+  , MouseReleased (..)+  -- * Processing types+  , ProcType+  -- ** Bool+  , Proc_Bool, true, false+  , fromBool+  , pnot, (#||), (#&&)+  -- ** Int+  , Proc_Int+  , fromInt+  , intToFloat+  -- ** Float+  , Proc_Float+  , fromFloat+  , pfloor+  -- ** Char+  , Proc_Char+  , fromChar+  -- ** Text+  , Proc_Text+  , fromStText+  -- ** Image+  , Proc_Image+  -- * Processing classes+  , Proc_Eq (..)+  , Proc_Ord (..)+  ) where++import Graphics.Web.Processing.Core.Primal+import Text.PrettyPrint.Mainland+import Data.Text.Lazy (Text)+import qualified Data.Text.Lazy.IO as T++charsPerLine :: Int+charsPerLine = 80++-- | Render a script as a lazy 'Text'.+renderScript :: ProcScript -> Text+renderScript = prettyLazyText charsPerLine . ppr++-- | Render a script using 'renderScript' and+--   write it directly in a file.+renderFile :: FilePath -> ProcScript -> IO ()+renderFile fp = T.writeFile fp . renderScript
+ Graphics/Web/Processing/Core/Var.hs view
@@ -0,0 +1,64 @@++-- | Internal module defining 'Var' type and functions.+--   The /basic/ interface uses these variable functions.+--   However, they introduce a not-really-coherent+--   behavior (see 'readVar').+module Graphics.Web.Processing.Core.Var (+  -- * Variables++  -- $vars++  -- ** Functions+    Var+  , varName+  , newVar, readVar, writeVar+    ) where++import Graphics.Web.Processing.Core.Primal+import Graphics.Web.Processing.Core.Monad+import Data.Text (Text)+import Data.Monoid+import Data.String++{-$vars+The variable system presented here is actually an artifact to make explicit+which values may change over time and which don't. It also guides the user+to create variables before use them and do so in a more natural way. Somehow,+it tries to be similar to 'IORef's, while they aren't. Strictly speaking, they+do not contain any value, but it /will/ contain a value when processing.js executes+the resulting code. To make sure you are doing the right thing, variables are+typed, thus forcing you to feed the correct functions with the correct values.+However, this also leads to weird things like the one described in 'readVar'.+-}++intVarName :: Int -> Text+intVarName n = "v_" <> fromString (show n)++-- | Create a new variable with a starting value.+--   The creation of variables is restricted to the+--   'Preamble'.+newVar :: (Monad (m Preamble), ProcMonad m, ProcType a) => a -> m Preamble (Var a)+newVar x = do+  n <- liftProc newVarNumber+  let v = intVarName n+  createVarM (proc_asign v x)+  return $ varFromText v++-- | Read a variable.+--+--   Funny fact: /it does not matter when you execute this function/.+--   The result will /always/ hold the last value asigned to the variable.+--   For example, this code+--+-- > v <- newVar 10+-- > ten <- readVar v+-- > writeVar v 20+-- > point (10,ten)+--+--   will draw a point at (10,20).+readVar :: (Monad (m c), ProcMonad m, ProcType a) => Var a -> m c a+readVar = return . proc_read++-- | Write a value to a variable.+writeVar :: (ProcMonad m, ProcType a) => Var a -> a -> m c ()+writeVar v x = assignM $ proc_asign (varName v) x
+ Graphics/Web/Processing/Html.hs view
@@ -0,0 +1,79 @@++{-# LANGUAGE OverloadedStrings #-}++-- | Once created, processing scripts can be included in HTML canvas.+--   To be able to reproduce the animation, you must import the /processing.js/+--   library, downloadable from <http://processingjs.org/download> (do not import+--   it from the original link, download it and use your own copy).+--   To import /processing.js/, use a @script@ tag.+--+-- > <script src="processing.js"></script>+--+--   See 'importScript'.+--+--   /Note from the author: I didn't manage to run a processing animation locally,/+--   /so you may have the same issue. Once I uploaded them to my server, they worked/+--   /just fine./+module Graphics.Web.Processing.Html (+    procCanvas+  , importScript+  , defaultHtml, writeHtml+  ) where++import Graphics.Web.Processing.Core.Types+-- HTML+import Prelude hiding (head)+import Data.Monoid (Monoid (..))+import Data.String+import Text.Blaze.Html5+  ( Html, docTypeHtml, preEscapedToHtml+  , toHtml+  , head, body, title+  , canvas, (!), customAttribute ,script+  , style)+import Text.Blaze.Html5.Attributes (src,type_)+import Text.Blaze.Html.Renderer.Text (renderHtml)+import Data.Text (Text)+import Data.Text.Lazy.IO (writeFile)++-- | Create a canvas element which contain a Processing animation.+--   The output is of the following form:+--+-- > <canvas data-processing-sources="specified path"></canvas>+--+procCanvas :: FilePath -- ^ File path to the script.+           -> Html+procCanvas fp = canvas ! customAttribute "data-processing-sources" (fromString fp) $ mempty++-- | Create the following HTML element:+--+-- > <script src="specified path"></script>+--+--   Use it to import the /processing.js/ script,+--   inside the @head@ tag.+importScript :: FilePath -- ^ Location of the /processing.js/ script.+             -> Html+importScript fp = script ! src (fromString fp) $ mempty++-- | Default template for visualizing Processing scripts in HTML.+defaultHtml :: FilePath   -- ^ Where to find the /processing.js/ module.+            -> FilePath   -- ^ File name for the Processing script (with @.pde@ extension).+            -> Text       -- ^ Html title.+            -> Html       -- ^ Html output.+defaultHtml pfp sfp tit = docTypeHtml $ do+  head $ do title $ toHtml tit+            importScript pfp+            style ! type_ "text/css" $+              preEscapedToHtml ("body {margin: 0 ;} canvas {width: 100% ;}" :: Text)+  body $ procCanvas sfp++-- | Write a Processing script and the HTML default template for it+--   to files, using 'renderFile' and 'defaultHtml'.+writeHtml :: FilePath -- ^ Where to find the /processing.js/ module.+          -> FilePath -- ^ Where to write the Processing script (with @.pde@ extension).+          -> Text     -- ^ Html title.+          -> FilePath -- ^ Where to write the HTML file (with @.html@ extension).+          -> ProcScript -- ^ Processing script.+          -> IO ()+writeHtml pfp sfp tit hfp ps =+  renderFile sfp ps >> Data.Text.Lazy.IO.writeFile hfp (renderHtml $ defaultHtml pfp sfp tit)
+ Graphics/Web/Processing/Mid.hs view
@@ -0,0 +1,272 @@++-- | Processing scripting, /mid/ interface.+--   Unlike the /basic/ interface (see "Graphics.Web.Processing.Basic")+--   the script is more guided by the types. However, the output is+--   less predictable, since it does some tricks in order to obtain+--   semantics that are more coherent with Haskell. The difference is+--   small, but let's say that this module has more freedom writing+--   the output code. It also applies code optimizations, so the output+--   code may look different (see 'execScriptM' and+--   "Graphics.Web.Processing.Optimize").+--+--   /How to work with it?/+--+--   Everything is done within+--   the 'ScriptM' monad, a state monad that controls the entire script,+--   including the preamble, draw loop, setup, etc.+--   The interaction with the different parts of the script is done+--   via /events/ (see 'EventM'). For example, the 'Draw' event controls the draw+--   loop.+--+-- > mouse :: ScriptM Preamble ()+-- > mouse = do+-- >   on Setup $ do+-- >      size screenWidth screenHeight+-- >      fill $ Color 255 255 255 255+-- >   on Draw  $ do+-- >      background $ Color 0 0 0 255+-- >      p <- getMousePoint+-- >      circle p 10+--+--   Note that to make it work, the context of the script /must/ be+--   'Preamble'.+--+--   Interaction with variables is done via the 'ProcVarMonad' class.+--   This class defines methods to interact with variables in both the+--   'ScriptM' monad and the 'EventM' monad.+--   To store custom types in variables, see the+--   "Graphics.Web.Processing.Mid.CustomVar" module.+--+--   Once your script is complete, use 'execScriptM' to get the result+--   code.+module Graphics.Web.Processing.Mid (+    -- * Types+    module Graphics.Web.Processing.Core.Types+    -- * Contexts+  , Context+    -- * Events+  , EventM+    -- * Script+  , ScriptM+  , on+  , execScriptM+    -- * Variables+  , Var+  , varName+  , ProcVarMonad (..)+    -- * Interface+  , module Graphics.Web.Processing.Core.Interface+  ) where++import Graphics.Web.Processing.Core.Monad+import Graphics.Web.Processing.Core.Types+import Graphics.Web.Processing.Core.Interface+-- variables+import Graphics.Web.Processing.Core.Var (Var,varName)+import qualified Graphics.Web.Processing.Core.Var as Var+-- optimization+import Graphics.Web.Processing.Optimize+-- transformers+import Control.Monad (void)+import Control.Applicative+import Control.Monad.Trans.State.Strict+-- monoids+import Data.Monoid+import Data.Foldable (foldMap)+-- unsafe!+import Unsafe.Coerce++data EventState c =+  EventState+    { -- This field allows to append preamble code+      -- during an event. Only to be used for internal+      -- functions.+      event_preamble :: ProcM Preamble ()+    , event_code :: ProcM c ()+      }++-- | Plain empty event state.+emptyEventState :: EventState c+emptyEventState = EventState (return ()) (return ())++-- | Monad of events. Use 'on' to insert an event in a script ('ScriptM').+--   To write the event code, use the functions in+--   "Graphics.Web.Processing.Core.Interface", since 'EventM' is an instance+--   of 'ProcMonad'.+newtype EventM c a = EventM { unEventM :: State (EventState c) a }++instance Functor (EventM c) where+ fmap f (EventM s) = EventM $ fmap f s++instance Applicative (EventM c) where+ pure x = EventM $ pure x+ ef <*> e = EventM $ unEventM ef <*> unEventM e++instance Monad (EventM c) where+ return = pure+ (EventM s) >>= f = EventM $ s >>= unEventM . f++addCode :: ProcM c () -> EventM c ()+addCode = liftProc++addPCode :: ProcM Preamble () -> EventM c ()+addPCode p = EventM $ modify $ \es -> es { event_preamble = event_preamble es >> p }++instance ProcMonad EventM where+ liftProc p = EventM $ do+   es <- get+   let c = event_code es >> p+   put $ es { event_code = void c }+   return $ fst $ runProcM c+ commandM t as = addCode $ commandM t as+ assignM = addCode . assignM+ writeComment = addCode . writeComment+ iff b (EventM e1) (EventM e2) = do+   let s1 = execState e1 emptyEventState+       s2 = execState e2 emptyEventState+   addPCode $ event_preamble s1+   addPCode $ event_preamble s2+   addCode $ iff b (event_code s1) (event_code s2)+ -- Create variables in an event? That should never happen, really.+ createVarM = fail "EventM(createVarM): This error should never be called. Report this as an issue."++data ScriptState c =+  ScriptState+    { script_code :: ProcM c () -- This code should actually be the preamble+    , script_setup :: Maybe (ProcM Setup ())+    , script_draw :: Maybe (ProcM Draw ())+    , script_mouseClicked :: Maybe (ProcM MouseClicked ())+    , script_mouseReleased :: Maybe (ProcM MouseReleased ())+      }++emptyScriptState :: ScriptState c+emptyScriptState = ScriptState (return ()) Nothing Nothing Nothing Nothing++-- | Scripter monad. This monad is where Processing code is written.+--   Because of some implementation details, 'ScriptM' has a context @c@.+--   However, this context is /always/ 'Preamble'.+newtype ScriptM c a = ScriptM { unScriptM :: State (ScriptState c) a }++instance Functor (ScriptM c) where+ fmap f (ScriptM s) = ScriptM $ fmap f s++instance Applicative (ScriptM c) where+ pure x = ScriptM $ pure x+ ef <*> e = ScriptM $ unScriptM ef <*> unScriptM e++instance Monad (ScriptM c) where+ return = pure+ (ScriptM s) >>= f = ScriptM $ s >>= unScriptM . f++instance ProcMonad ScriptM where+ liftProc p = ScriptM $ do+   ss <- get+   let c = script_code ss >> p+   put $ ss { script_code = void c }+   return $ fst $ runProcM $ c+ commandM t as = liftProc $ commandM t as+ assignM = liftProc . assignM+ createVarM = liftProc . createVarM+ writeComment = liftProc . writeComment+ iff b (ScriptM e1) (ScriptM e2) = ScriptM $ do+   s0 <- get+   let s1  = execState e1 emptyScriptState+       s2  = execState e2 emptyScriptState+       f g = getLast $ foldMap (Last . g) [s0,s1,s2]+   put $ ScriptState (script_code s0 >> iff b (script_code s1) (script_code s2))+                     (f script_setup)+                     (f script_draw)+                     (f script_mouseClicked)+                     (f script_mouseReleased)++-- | Context of an event. The context determines which functions can be used.+--   'Preamble' is not an instance of 'Context' to avoid using 'Preamble' as+--   an event (see 'on').+class Context c where+ addEvent :: c -> ProcM c () -> ScriptState d -> ScriptState d++instance Context Setup where+ addEvent _ c s = s { script_setup = Just c }++instance Context Draw where+ addEvent _ c s = s { script_draw = Just c }++instance Context MouseClicked where+ addEvent _ c s = s { script_mouseClicked = Just c }++instance Context MouseReleased where+ addEvent _ c s = s { script_mouseReleased = Just c }++-- | Set an event. Different events are specified by the instances of the+--   'Context' class.+--+--   For example, the following code sets the 'fill' pattern in the setup event (the event+--   that is called once at the beginning of the execution).+--+-- > on Setup $ fill $ Color 0 0 0 255+--+on :: Context c => c -> EventM c () -> ScriptM Preamble ()+on c (EventM e) = ScriptM $ modify $ \ss -> + let n = fst $ runProcM $ script_code ss >> getVarNumber+     es = execState e $ EventState (return ()) $ setVarNumber n+     f  = addEvent c $ event_code es+ in  f $ ss { script_code = script_code ss >> event_preamble es }++-- | Execute the scripter monad to get the full Processing script.+--   Use 'renderScript' or 'renderFile' to render it.+--+--   After generating the script, the output code is optimized+--   using 'optimizeBySubstitution'.+execScriptM :: ScriptM Preamble () -> ProcScript+execScriptM (ScriptM s0) =+  let s = execState s0 emptyScriptState+  in  optimizeBySubstitution $ ProcScript+    { proc_preamble = execProcM $ script_code s+    , proc_setup = maybe mempty execProcM $ script_setup s+    , proc_draw = fmap execProcM $ script_draw s+    , proc_mouseClicked = fmap execProcM $ script_mouseClicked s+    , proc_mouseReleased = fmap execProcM $ script_mouseReleased s+      }++-- Variables++-- | Class of monads where variables can be set in a natural+--   way (similar to 'IORef'). Instances of this class behave+--   in a proper way, without the weird behavior of the original+--   'Var.readVar'.+class ProcMonad m => ProcVarMonad m where+ -- | Create a new variable with a starting value.+ newVar :: ProcType a => a -> m Preamble (Var a)+ -- | Read a variable.+ readVar :: ProcType a => Var a -> m c a+ -- | Write a new value to a variable.+ writeVar :: ProcType a => Var a -> a -> m c ()++-- | Magic! Keep it private, it's our secret!+switchContext :: ScriptM c a -> ScriptM d a+switchContext = unsafeCoerce++-- | Magic! Keep it private, it's our secret!+switchContextE :: EventM c a -> EventM d a+switchContextE = unsafeCoerce++instance ProcVarMonad ScriptM where+ newVar = Var.newVar+ writeVar = Var.writeVar+ readVar v = do+  x  <- Var.readVar v+  v' <- switchContext $ Var.newVar x+  Var.readVar v'++instance ProcVarMonad EventM where+ writeVar = Var.writeVar+ readVar v = do+  x <- Var.readVar v+  addPCode $ void $ Var.newVar x+  n <- switchContextE $ liftProc getVarNumber+  let v' = fst $ runProcMWith n $ Var.newVar x+  liftProc $ setVarNumber $ n + 1+  writeVar v' x+  Var.readVar v'+ -- New variable in an event? That should not happen, really.+ newVar = fail "EventM(newVar): This error should never be called. Report this as an issue."
+ Graphics/Web/Processing/Mid/CustomVar.hs view
@@ -0,0 +1,198 @@++{-# LANGUAGE DeriveGeneric, TypeOperators, DefaultSignatures, FlexibleContexts #-}++-- | This module implements variables which may contain values from+--   types different from the native types (@Proc_*@ types).+--+--   To make a type available to custom variables, it needs to be+--   instantiated in the 'CustomValue' class, which is subclass+--   of the 'VarLength' class. These instances are derivables using+--   the @DeriveGeneric@ extension. Things you need are: enable the+--   @DeriveGeneric@ language extension, import "GHC.Generics", derive+--   a 'Generic' instance of your type and then write the following+--   instances (where @Foo@ is any type of interest):+--+-- > instance VarLength Foo+-- > instance CustomValue Foo+--+--   Note that @Foo@ must be made from other types that are instances+--   of 'CustomValue'. Also, note that instances of 'VarLength' or+--   'CustomValue' can /not/ be recursive or sum types.+--   An example:+--+-- > {-# LANGUAGE DeriveGeneric #-}+-- >+-- > import Graphics.Web.Processing.Mid+-- > import Graphics.Web.Processing.Mid.CustomVar+-- > import GHC.Generics+-- >+-- > data Point = Point Proc_Float Proc_Float+-- >                deriving Generic+-- >+-- > instance VarLength Point+-- > instance CustomValue Point+--+--   Types instance of the 'CustomValue' class can be contained by+--   a special type of variables, called 'CustomVar' (Custom Variable).+--   Functions for custom variables are equal to the function for regular+--   variables, except that they all end in @C@. For example, 'newVar' is+--   called 'newVarC' for custom variables.+--+--   The dependency of this module in several language extensions was+--   the reason to make it separate from the rest of the /mid/ interface+--   where it belongs to. Somehow, it forces the user to use @DeriveGeneric@+--   and import "GHC.Generics" to do something useful with it (more than use+--   custom variables for tuples).+module Graphics.Web.Processing.Mid.CustomVar (+    CustomVar+  , VarLength (..)+  , CustomValue (..)+    ) where++import Data.Text (Text)+import Graphics.Web.Processing.Mid+import Graphics.Web.Processing.Core.Primal (varFromText)+import Control.Monad (liftM)+-- generics+import GHC.Generics++-- | Variable with custom values.+data CustomVar a = CustomVar [Text] deriving Generic++-- | Typeclass of custom values, which can be stored in custom variables ('CustomVar').+class VarLength a => CustomValue a where+ -- | Version of 'newVar' for custom variables.+ newVarC :: (Monad (m Preamble), ProcVarMonad m) => a -> m Preamble (CustomVar a)+ default newVarC :: (Monad (m Preamble), ProcVarMonad m, Generic a, GCustomValue (Rep a))+                 => a -> m Preamble (CustomVar a)+ newVarC x = liftM castCVar $ gnewVarC (from x)+ -- | Version of 'readVar' for custom variables.+ readVarC :: (Monad (m c), ProcVarMonad m) => CustomVar a -> m c a+ default readVarC :: (Monad (m c), ProcVarMonad m, Generic a, GCustomValue (Rep a))+                  => CustomVar a -> m c a+ readVarC v = liftM to $ greadVarC (castCVar v)+ -- | Version of 'writeVar' for custom variables.+ writeVarC :: (Monad (m c), ProcVarMonad m) => CustomVar a -> a -> m c ()+ default writeVarC :: (Monad (m c), ProcVarMonad m, Generic a, GCustomValue (Rep a)) => CustomVar a -> a -> m c ()+ writeVarC v x = gwriteVarC (castCVar v) (from x)++fromVar :: Var a -> CustomVar a+fromVar = CustomVar . (:[]) . varName++fromCustomVar :: CustomVar a -> [Var a]+fromCustomVar (CustomVar xs) = fmap varFromText xs++-- This instances are really boring (they are all equal).++instance CustomValue Proc_Bool where+ newVarC = liftM fromVar . newVar+ readVarC = readVar . head . fromCustomVar+ writeVarC v x = writeVar (head $ fromCustomVar v) x++instance CustomValue Proc_Int where+ newVarC = liftM fromVar . newVar+ readVarC = readVar . head . fromCustomVar+ writeVarC v x = writeVar (head $ fromCustomVar v) x++instance CustomValue Proc_Float where+ newVarC = liftM fromVar . newVar+ readVarC = readVar . head . fromCustomVar+ writeVarC v x = writeVar (head $ fromCustomVar v) x++instance CustomValue Proc_Text where+ newVarC = liftM fromVar . newVar+ readVarC = readVar . head . fromCustomVar+ writeVarC v x = writeVar (head $ fromCustomVar v) x++instance CustomValue Proc_Image where+ newVarC = liftM fromVar . newVar+ readVarC = readVar . head . fromCustomVar+ writeVarC v x = writeVar (head $ fromCustomVar v) x++instance CustomValue Proc_Char where+ newVarC = liftM fromVar . newVar+ readVarC = readVar . head . fromCustomVar+ writeVarC v x = writeVar (head $ fromCustomVar v) x++-- GENERICS++-- | Typeclass of values that can be stored in several+--   native variables ('Var').+class VarLength a where+ -- | Calculate how many native variables are needed+ --   to store a value.+ varLength :: a -> Int+ --+ varLength _ = 1++instance VarLength Proc_Bool where+instance VarLength Proc_Int where+instance VarLength Proc_Float where+instance VarLength Proc_Text where+instance VarLength Proc_Image where+instance VarLength Proc_Char where++class GVarLength f where+ gvarLength :: f a -> Int++instance GVarLength U1 where+ gvarLength _ = 1++instance (GVarLength a, GVarLength b) => GVarLength (a :*: b) where+ gvarLength (a :*: b) = gvarLength a + gvarLength b++instance GVarLength (a :+: b) where+ gvarLength _ = error "gvarLength: Custom variables cannot be sum types."++instance GVarLength a => GVarLength (M1 i c a) where+ gvarLength (M1 x) = gvarLength x++instance VarLength a => GVarLength (K1 i a) where+ gvarLength (K1 x) = varLength x++varDrop :: Int -> CustomVar a -> CustomVar a+varDrop n (CustomVar xs) = CustomVar $ drop n xs++castCVar :: CustomVar a -> CustomVar b+castCVar (CustomVar xs) = CustomVar xs++class GCustomValue f where+ gnewVarC :: (Monad (m Preamble), ProcVarMonad m) => f a -> m Preamble (CustomVar (f a))+ greadVarC :: (Monad (m c), ProcVarMonad m) => CustomVar (f a) -> m c (f a)+ gwriteVarC :: (Monad (m c), ProcVarMonad m) => CustomVar (f a) -> f a -> m c ()++instance (GVarLength a, GCustomValue a, GCustomValue b) => GCustomValue (a :*: b) where+ gnewVarC (a :*: b) = do+   CustomVar xs <- gnewVarC a+   CustomVar ys <- gnewVarC b+   return $ CustomVar $ xs ++ ys+ greadVarC v = do+   a <- greadVarC $ castCVar v+   let n = gvarLength a+   b <- greadVarC $ varDrop n $ castCVar v+   return $ a :*: b+ gwriteVarC (CustomVar v) (a :*: b) = do+   let (xs,ys) = splitAt (gvarLength a) v+   gwriteVarC (CustomVar xs) a+   gwriteVarC (CustomVar ys) b++instance GCustomValue (a :+: b) where+ gnewVarC = error "gnewVarC: Custom variables cannot be sum types."+ greadVarC = error "greadVarC: Custom variables cannot be sum types."+ gwriteVarC = error "gwriteVarC: Custom variables cannot be sum types."++instance GCustomValue a => GCustomValue (M1 i c a) where+ gnewVarC (M1 x) = liftM castCVar $ gnewVarC x+ greadVarC v = liftM M1 $ greadVarC $ castCVar v+ gwriteVarC v (M1 x) = gwriteVarC (castCVar v) x++instance CustomValue a => GCustomValue (K1 i a) where+ gnewVarC (K1 x) = liftM castCVar $ newVarC x+ greadVarC v = liftM K1 $ readVarC $ castCVar v+ gwriteVarC v (K1 x) = writeVarC (castCVar v) x++instance (VarLength a, VarLength b) => VarLength (a,b)+instance (CustomValue a, CustomValue b) => CustomValue (a,b)++instance (VarLength a, VarLength b, VarLength c) => VarLength (a,b,c)+instance (CustomValue a, CustomValue b, CustomValue c) => CustomValue (a,b,c)
+ Graphics/Web/Processing/Optimize.hs view
@@ -0,0 +1,284 @@++{-# LANGUAGE OverloadedStrings #-}++-- | Code optimization module.+module Graphics.Web.Processing.Optimize (+   -- * Optimizations+   optimizeBySubstitution+   ) where++import Graphics.Web.Processing.Core.Primal+import Data.MultiSet (MultiSet, insert, empty+                     , occur, union, filter)+import Control.Monad (when)+import Control.Monad.Trans.State+import qualified Data.Foldable as F+import Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import Data.Monoid+import Data.String+import Data.Text (Text)+import Control.Applicative ((<$>))+import Control.Arrow (second)++-- | Number of operations needed to calculate the+--   value of a given 'Proc_Float' value.+numOps :: Proc_Float -> Int+-- Really boring function!+numOps (Proc_Float _) = 0+numOps (Float_Sum x y) = 1 + numOps x + numOps y+numOps (Float_Substract x y) = 1 + numOps x + numOps y+numOps (Float_Divide x y) = 1 + numOps x + numOps y+numOps (Float_Mult x y) = 1 + numOps x + numOps y+numOps (Float_Mod x y) = 1 + numOps x + numOps y+numOps (Float_Var _) = 0+numOps (Float_Abs x) = 1 + numOps x+numOps (Float_Exp x) = 1 + numOps x+numOps (Float_Sqrt x) = 1 + numOps x+numOps (Float_Log x) = 1 + numOps x+numOps (Float_Sine x) = 1 + numOps x+numOps (Float_Cosine x) = 1 + numOps x+numOps (Float_Arcsine x) = 1 + numOps x+numOps (Float_Arccosine x) = 1 + numOps x+numOps (Float_Arctangent x) = 1 + numOps x+numOps (Float_Floor x) = 1 + numOps x+numOps (Float_Noise x y) = 1 + numOps x + numOps y++-----------------------------------------------------+-----------------------------------------------------+---- SUBSTITUTION OPTIMIZATION SETTINGS++-- | Number that indicates the maximum number of+--   operations allowed for a 'Proc_Float' calculation+--   to consider it cheap.+limitNumber :: Int+limitNumber = 0++-- | Number of times an expression is considered+--   repeated enough to be substituted.+occurNumber :: Int+occurNumber = 3++-----------------------------------------------------+-----------------------------------------------------++-- | Check if a 'Proc_Float' calculation is expensive,+--   depending on 'limitNumber'.+isExpensive :: Proc_Float -> Bool+isExpensive = (> limitNumber) . numOps++-- | Check if a 'Proc_Float' calculation is cheap,+--   depending on 'limitNumber'.+isCheap :: Proc_Float -> Bool+isCheap = not . isExpensive++type FloatSet = MultiSet Proc_Float++type FloatCounter = State FloatSet++-- | Add a 'Proc_Float' to the /float counter/.+addFloat :: Proc_Float -> FloatCounter ()+addFloat x = when (isExpensive x) $ modify $ insert x++-- | Add each expression contained in a 'Proc_Float' to the+--   /float counter/.+browseFloat :: Proc_Float -> FloatCounter ()+-- Really boring function!+browseFloat f@(Float_Sum x y) = addFloat f >> browseFloat x >> browseFloat y+browseFloat f@(Float_Substract x y) = addFloat f >> browseFloat x >> browseFloat y+browseFloat f@(Float_Divide x y) = addFloat f >> browseFloat x >> browseFloat y+browseFloat f@(Float_Mult x y) = addFloat f >> browseFloat x >> browseFloat y+browseFloat f@(Float_Mod x y) = addFloat f >> browseFloat x >> browseFloat y+browseFloat f@(Float_Abs x) = addFloat f >> browseFloat x+browseFloat f@(Float_Exp x) = addFloat f >> browseFloat x+browseFloat f@(Float_Sqrt x) = addFloat f >> browseFloat x+browseFloat f@(Float_Log x) = addFloat f >> browseFloat x+browseFloat f@(Float_Sine x) = addFloat f >> browseFloat x+browseFloat f@(Float_Cosine x) = addFloat f >> browseFloat x+browseFloat f@(Float_Arcsine x) = addFloat f >> browseFloat x+browseFloat f@(Float_Arccosine x) = addFloat f >> browseFloat x+browseFloat f@(Float_Arctangent x) = addFloat f >> browseFloat x+browseFloat f@(Float_Floor x) = addFloat f >> browseFloat x+browseFloat f@(Float_Noise x y) = addFloat f >> browseFloat x >> browseFloat y+browseFloat _ = return ()++execCounter :: FloatCounter a -> FloatSet+execCounter c = execState c empty++-- | Most frequent expensive expression within a list+--   of expressions.+--   It returns 'Nothing' when no expensive expression+--   was found, or they are not repeated enough (see 'occurNumber').+--   If there are more than one most frequent expression,+--   it returns one of them.+mostFreq :: Seq Proc_Float -> Maybe Proc_Float+mostFreq xs = maxOccur mset+  where+    mset_ = F.foldr (\x y -> union y $ execCounter $ browseFloat x) empty xs+    mset  = Data.MultiSet.filter (\x -> occur x mset_ >= occurNumber) mset_+    maxOccur = F.foldr f Nothing+    f a (Just b) =+       if occur a mset >= occur b mset+          then Just a+          else Just b+    f a Nothing = Just a++-- | Apply a substitution.+floatsubs :: Proc_Float -- ^ Origin.+          -> Proc_Float -- ^ Target.+          -> Proc_Float -- ^ Expression.+          -> Proc_Float -- ^ Result.+floatsubs o t x = if x == o then t else recFloat (floatsubs o t) x++-- | From a list of arguments, create a sequence of the+--   arguments of type 'Proc_Float' (which may be empty).+getFloatArgs :: [ProcArg] -> Seq Proc_Float+getFloatArgs = F.foldr (+  \x xs -> case x of+    FloatArg a -> a Seq.<| xs+    _ -> xs) mempty++-- | Gather all the float expressions in a piece of code.+floatsInCode :: ProcCode c -> Seq Proc_Float+floatsInCode (Command _ xs) = getFloatArgs xs+floatsInCode (Conditional _ c1 c2) = floatsInCode c1 <> floatsInCode c2+floatsInCode (Sequence xs) = F.foldMap floatsInCode xs+floatsInCode (Assignment (FloatAsign _ x)) = Seq.singleton x+floatsInCode _ = mempty++-- | Like 'mostFreq', but applied to a piece of code.+mostFreqCode :: ProcCode c -> Maybe Proc_Float+mostFreqCode = mostFreq . floatsInCode++optVarName :: Int -- ^ Index.+           -> Text -- ^ Optimization variable name.+optVarName n = "subs_" <> fromString (show n)++-- | Assign a /substitution variable/ a expression,+--   and use that variable in the rest of the code.+varForExp :: Int -- ^ Substitution variable index.+          -> Proc_Float -- ^ Expressions to be substituted.+          -> ProcCode c -- ^ Original code.+          -> (ProcCode c, ProcCode c) -- ^ Assignment and result code.+varForExp n e c =+ ( Assignment (FloatAsign v e) , codesubs e (Float_Var v) c )+   where+     v = optVarName n++-- | Apply a substitution to a floating argument.+--   To other arguments, it does nothing.+argsubs :: Proc_Float -- ^ Origin.+        -> Proc_Float -- ^ Target.+        -> ProcArg    -- ^ Original argument.+        -> ProcArg    -- ^ Result argument.+argsubs o t (FloatArg x) = FloatArg $ floatsubs o t x+argsubs _ _ x = x++-- | Apply a substitution to a piece of code.+codesubs :: Proc_Float -- ^ Origin.+         -> Proc_Float -- ^ Target.+         -> ProcCode c -- ^ Original code.+         -> ProcCode c -- ^ Result code.+codesubs o t (Command n xs) = Command n $ fmap (argsubs o t) xs+codesubs o t (Conditional b c1 c2) = Conditional b (codesubs o t c1) (codesubs o t c2)+codesubs o t (Sequence xs) = Sequence $ fmap (codesubs o t) xs+codesubs o t (Assignment (FloatAsign n x)) = Assignment $ FloatAsign n $ floatsubs o t x+codesubs _ _ c = c++substitutionOver :: Int -> ProcCode c -> (ProcCode c, Int)+substitutionOver = substitutionOverAux mempty++substitutionOverAux :: Seq (ProcCode c) -> Int -> ProcCode c -> (ProcCode c, Int)+substitutionOverAux as n c =+  case mostFreqCode c of+    Nothing -> (addSubsComments (F.fold as) <> c,n)+    Just e  -> let (a,c') = varForExp n e c+               in  substitutionOverAux (as Seq.|> a) (n+1) c'++addSubsComments :: ProcCode c -> ProcCode c+addSubsComments c =+  if c == mempty then mempty+                 else subsPrevComment <> c <> subsPostComment++subsPrevComment :: ProcCode c+subsPrevComment = Comment "Substitution Optimization settings."++subsPostComment :: ProcCode c+subsPostComment = Comment " "++-- Substitution optimization monad.++data SubsState c = SubsState { codeWritten :: ProcCode c+                             , codeStack :: ProcCode c+                             , substitutionIndex :: Int }++type SubsM c = State (SubsState c)++addToStack :: ProcCode c -> SubsM c ()+addToStack c = modify $ \s -> s { codeStack = codeStack s <> c }++addToWritten :: ProcCode c -> SubsM c ()+addToWritten c = modify $ \s -> s { codeWritten = codeWritten s <> c }++setIndex :: Int -> SubsM c ()+setIndex n = modify $ \s -> s { substitutionIndex = n }++resetStack :: SubsM c ()+resetStack = modify $ \s -> s { codeStack = mempty }++applySubstitution :: SubsM c ()+applySubstitution = do+  stack <- codeStack <$> get+  n <- substitutionIndex <$> get+  let (c,m) = substitutionOver n stack+  addToWritten c+  setIndex m+  resetStack++codeSubstitution :: ProcCode c -> SubsM c ()+codeSubstitution a@(Assignment _) = addToStack a >> applySubstitution+codeSubstitution (Conditional b c1 c2) = do+  applySubstitution+  n0 <- substitutionIndex <$> get+  let (n1,c1') = runSubstitution n0 $ codeSubstitution c1+      (n2,c2') = runSubstitution n1 $ codeSubstitution c2+  setIndex n2+  addToWritten $ Conditional b c1' c2'+codeSubstitution (Sequence xs) = F.mapM_ codeSubstitution xs+codeSubstitution x = addToStack x++runSubstitution :: Int -> SubsM c a -> (Int,ProcCode c)+runSubstitution n m = (substitutionIndex s, codeWritten s)+  where+    (_,s) = runState m $ SubsState mempty mempty n++subsOptimize :: Int -> ProcCode c -> (Int,ProcCode c)+subsOptimize n c = runSubstitution n $ codeSubstitution c >> applySubstitution++-- | Optimization by substitution. It looks for commonly repeated operations and+--   create variables for them so they are only calculated once.+--+--   This optimization is applied automatically when using 'execScriptM'.+optimizeBySubstitution :: ProcScript -> ProcScript+optimizeBySubstitution+  (ProcScript _preamble+              _setup+              _draw+              _mouseClicked+              _mouseReleased+               )+  = let (n1,_setup')         = subsOptimize 1 _setup+        (n2,_draw')          = maybe (n1,Nothing) (second Just . subsOptimize n1) _draw+        (n3,_mouseClicked')  = maybe (n2,Nothing) (second Just . subsOptimize n2) _mouseClicked+        (n4,_mouseReleased') = maybe (n3,Nothing) (second Just . subsOptimize n3) _mouseReleased+        vs = fmap (\n -> CreateVar $ FloatAsign (optVarName n) 0) [1 .. n4 - 1]+    in ProcScript (_preamble <> subsComment (mconcat vs))+                   _setup'+                   _draw'+                   _mouseClicked'+                   _mouseReleased'++subsComment :: ProcCode Preamble -> ProcCode Preamble+subsComment c =+ if c == mempty then mempty+                else Comment "Variables from the Substitution Optimization." <> c
+ Graphics/Web/Processing/Simple.hs view
@@ -0,0 +1,281 @@++-- | 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+     -- | 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.+  -> ProcScript+interactiveFigure mw mh framerate s0 _print bg step onclick = execScriptM $ do+  let w = maybe screenWidth  fromInt mw+      h = maybe screenHeight fromInt mh+  v <- newVarC s0+  on Setup $ do+     setFrameRate $ fromInt framerate+  on Draw $ do+     size w h+     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
+ Setup.hs view
@@ -0,0 +1,5 @@++import Distribution.Simple++main :: IO ()+main = defaultMain
+ examples/mill.hs view
@@ -0,0 +1,55 @@++{-# LANGUAGE OverloadedStrings #-}++-- Recursive picture animation.+--+-- Inspired by a similar animation (not equal)+-- to be found in the examples of the gloss library.++import Graphics.Web.Processing.Simple+import Graphics.Web.Processing.Html++main :: IO ()+main = writeHtml "processing.js" "mill.pde" "Mill demo" "mill.html" mill++mill :: ProcScript+mill = animateFigure Nothing Nothing 50 (Color 0 0 0 255) millf++speed :: Proc_Float+speed = 0.02++millf :: Proc_Int -> Figure+millf n =+ let t = intToFloat n * speed+ in  FillColor (Color 0 0 0 0)+   $ LineColor (Color 255 255 255 255)+   $ millUnit 0 250 t++millUnit :: Int -- ^ Recursive level.+         -> Proc_Float -- ^ Radius.+         -> Proc_Float -- ^ Angle.+         -> Figure+-- Recursion stop level.+millUnit 5 _ _ = mempty+-- Recursive call.+millUnit n r alpha =+ let parity = even n+     r2  = r/2+     f a = (r2 * sin a, r2 * cos a)+     p0  = (0,0)+     p1  = f 0+     p2  = f $ 2*pi/3+     p3  = f $ 4*pi/3+     r'  = dist p1 p2 / 2+ in Rotate (if parity then alpha else (-2) * alpha)+     $ mconcat [+         Line [p0,p1] , Line [p0,p2] , Line [p0,p3]+       , Circle p1 r' , Circle p2 r' , Circle p3 r'+       , Translate p1 $ millUnit (n+1) r' alpha+       , Translate p2 $ millUnit (n+1) r' alpha+       , Translate p3 $ millUnit (n+1) r' alpha+         ]++-- | Distance between two points.+dist :: Proc_Point -> Proc_Point -> Proc_Float+dist (a,b) (c,d) = sqrt $ (a - c)^2 + (b - d)^2
+ examples/twist.hs view
@@ -0,0 +1,16 @@++{-# LANGUAGE OverloadedStrings #-}++import Graphics.Web.Processing.Simple++main :: IO ()+main = renderFile "twist.pde" theScript++theScript :: ProcScript+theScript = animateFigure Nothing Nothing 50 (Color 0 0 0 255) drawFunction++drawFunction :: Proc_Int -> Figure+drawFunction n =+  let t = intToFloat n * 0.03+      r = 100+  in  Circle (r * sin t, r * cos t) 20
+ license view
@@ -0,0 +1,30 @@+Copyright (c)2013, Daniel Díaz
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Daniel Díaz nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ processing.cabal view
@@ -0,0 +1,102 @@+Name: processing+Version: 1.0.0.0+Author: Daniel Díaz+Category: Graphics+Build-type: Simple+License: BSD3+License-file: license+Maintainer: Daniel Díaz (dhelta.diaz `at` gmail.com)+Bug-reports: https://github.com/Daniel-Diaz/processing/issues+Synopsis: Web graphic applications with Processing.+Stability: In development+Description:+  /Processing/ is a visual design programming language.+  /Processing.js/ is the sister project of Processing designed+  for the web.+  The Haskell /processing/ package is a web animation library+  with /Processing.js/ as backend.+  .+  /What is this for?/+  .+  With this library you are able to write scripts that, once+  executed in a browser, will execute interactive visual programs.+  .+  /Where can I see a running example?/+  .+  An example output can be reached at <http://liibe.com/experimental/rocket.html>.+  Also, take a look at <http://liibe.com/experimental/mill.html>.+  The code of the latter is included in the source distribution (\/examples\/mill.hs).+  .+  /How do I learn to use it?/+  .+  The API reference of the library includes guidance and is complemented with+  code examples. Look also to the /examples/ directory included in the source+  distribution. It contains some fully working examples.+  .+  The library provides different APIs (interfaces). Each one with a different+  philosophy.+  .+  * /Simple/ ("Graphics.Web.Processing.Simple"): An abstract interface, focusing+  in what you want to be displayed, but not how. The library will know how to+  write the processing code you need. However, you may lack some features that+  you can find in other interfaces.+  .+  * /Mid/ ("Graphics.Web.Processing.Mid"): More imperative feeling, with variables+  and commands. But also convenient and complete. This is the default interface,+  re-exported by "Graphics.Web.Processing".+  .+  * /Basic/ ("Graphics.Web.Processing.Basic"): For people that like to do things+  by hand. The output processing code is predictable and you have great+  control over it.+  .+  The module "Graphics.Web.Processing.Html" helps you to create the HTML document+  where you will display the animation.+Cabal-version: >= 1.6+Extra-source-files:+  readme.md+  examples/twist.hs+  examples/mill.hs++Source-repository head+  type: git+  location: git@github.com:Daniel-Diaz/processing.git++Library+  Build-depends:+      base == 4.*+    , text+    , containers+    , transformers+    , mainland-pretty+    , blaze-html+    , multiset+  Exposed-modules:+    -- Core modules+    Graphics.Web.Processing.Core.Types+    Graphics.Web.Processing.Core.Interface+    Graphics.Web.Processing.Core.Var+    -- Basic interface+    Graphics.Web.Processing.Basic+    -- Mid interface+    Graphics.Web.Processing.Mid+    Graphics.Web.Processing.Mid.CustomVar+    -- Simple interface+    Graphics.Web.Processing.Simple+    -- Default interface+    Graphics.Web.Processing+    -- Optimizations+    Graphics.Web.Processing.Optimize+    -- HTML+    Graphics.Web.Processing.Html+  Other-modules:+    Graphics.Web.Processing.Core.Primal+    Graphics.Web.Processing.Core.Monad+  Extensions: OverloadedStrings+            , EmptyDataDecls+            -- , DeriveGeneric+            , MultiParamTypeClasses+            , FunctionalDependencies+            , TypeOperators+            -- , DefaultSignatures+            , FlexibleContexts+  GHC-Options: -Wall
+ readme.md view
@@ -0,0 +1,13 @@+# Processing library++Web graphic applications with +[processing.js](http://processingjs.org)+as backend.++**Still in development!**++# Examples++Find examples of usage at the [examples](/examples)+directory. The [mill](/examples/mill.hs) example looks like+[this](http://liibe.com/experimental/mill.html).