processing 1.0.1.0 → 1.1.0.0

raw patch · 13 files changed

+240/−163 lines, 13 filesdep +directorydep +filepathdep ~blaze-htmldep ~containersdep ~mainland-prettyPVP ok

version bump matches the API change (PVP)

Dependencies added: directory, filepath

Dependency ranges changed: blaze-html, containers, mainland-pretty, multiset, text, transformers

API changes (from Hackage documentation)

Files

• Graphics/Web/Processing/Core/Interface.hs +36/−17
• Graphics/Web/Processing/Core/Monad.hs +31/−0
• Graphics/Web/Processing/Core/Primal.hs +22/−16
• Graphics/Web/Processing/Core/Types.hs +1/−0
• Graphics/Web/Processing/Core/Var.hs +3/−39
• Graphics/Web/Processing/Html.hs +19/−7
• Graphics/Web/Processing/Mid.hs +34/−51
• Graphics/Web/Processing/Mid/CustomVar.hs +9/−9
• Graphics/Web/Processing/Optimize.hs +5/−1
• Graphics/Web/Processing/Simple.hs +12/−7
• examples/keys.hs +15/−9
• examples/random.hs +42/−0
• processing.cabal +11/−7

@@ -9,6 +9,7 @@      screenWidth, screenHeight    -- * Commands    -- ** General+   , random    , noise    -- ** Drawing    , Drawing@@ -48,7 +49,7 @@    , SpecialKey (..)    , matchKey    -- * Conditionals-   , iff+   , ifM    -- * Others    , frameCount    , getFrameRate@@ -59,8 +60,17 @@  -- Internal import Graphics.Web.Processing.Core.Primal+  ( Proc_Key (..)+  , Proc_KeyCode (..)+  , varFromText+  , Proc_Float (..)+  , noisef+  , ProcType (..)+  , ProcArg+    )+import Graphics.Web.Processing.Core.Types import Graphics.Web.Processing.Core.Monad-import Graphics.Web.Processing.Core.Var (writeVar,readVar)+import Graphics.Web.Processing.Core.Var -- import Control.Arrow (first) @@ -78,11 +88,11 @@  -- | Frames since the beginning of the script execution. frameCount :: (ProcMonad m, Monad (m c)) => m c Proc_Int-frameCount = readVar $ varFromText "frameCount"+frameCount = liftProc $ readVar $ varFromText "frameCount"  -- | Approximate number of frames per second. getFrameRate :: (ProcMonad m, Monad (m c)) => m c Proc_Int-getFrameRate = readVar $ varFromText "frameRate"+getFrameRate = liftProc $ readVar $ varFromText "frameRate"  -- COMMANDS @@ -92,18 +102,18 @@ noise :: (ProcMonad m, Monad (m c)) => Proc_Point -> m c Proc_Float noise (x,y) = return $ noisef x y +-- | Write a variable with a random number within an interval.+random :: ProcMonad m+       => Var Proc_Float -- ^ Target variable.+       -> Proc_Float -- ^ Left endpoint of the interval.+       -> Proc_Float -- ^ Right endpoint of the interval.+       -> m c ()+random v a b = writeVar v $ Float_Random a b+ ---- DRAWING  -- | Class of contexts where the user can draw pictures---   in the screen. Instances:------ * 'Setup'------ * 'Draw'------ * 'MouseClicked'------ * 'MouseReleased'+--   in the screen. class Drawing a where  instance Drawing Setup where@@ -289,13 +299,22 @@             => m c () resetMatrix = commandM "resetMatrix" [] +---- CONDITIONAL++-- | Conditional execution. When the boolean value is 'true',+--   it executes the first monadic argument. Otherwise, it+--   executes the other one. In any case, the result is discarded.+--   See also 'if_'.+ifM :: ProcMonad m => Proc_Bool -> m c a -> m c b -> m c ()+ifM = iff+ ---- 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"+ x <- liftProc $ readVar $ varFromText "mouseX"+ y <- liftProc $ readVar $ varFromText "mouseY"  return (x,y)  ---- KEYBOARD@@ -346,11 +365,11 @@ matchKey v k = do   let (codedKeys,uncodedKey) = keySplit k   if null codedKeys-     then return ()+     then writeVar v true      else iff (Key_Var #== Key_CODED)               (writeVar v $ foldr1 (#&&) $ fmap (KeyCode_Var #==) codedKeys)               (writeVar v false)-  b <- readVar v+  b <- liftProc $ readVar v   case uncodedKey of     Nothing -> return ()     Just (Left  pk) -> writeVar v $ Key_Var     #== pk #&& b

@@ -17,6 +17,8 @@ import Graphics.Web.Processing.Core.Primal import Control.Applicative (Applicative (..)) import Data.Text (Text)+import Data.Monoid ((<>))+import Data.String (fromString)  -- | Processing script producer monad. The context @c@ indicates the context --   of the underlying 'ProcCode'. This context restricts the use of certain@@ -70,6 +72,9 @@ setVarNumber :: Int -> ProcM c () setVarNumber = ProcM . put +intVarName :: Int -> Text+intVarName n = "v_" <> fromString (show n)+ -- Processing Monad class  -- | Types in this instance form a monad when they are applied@@ -91,7 +96,26 @@      -> m c ()  -- | Lift a 'ProcM' computation.  liftProc :: ProcM c a -> m c a+ -- | 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 () +-- | When using this instance, please, be aware of the+--   behavior of 'readVar'.+--+--   /It does not matter when read the variable/.+--   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). instance ProcMonad ProcM where  commandM n as = ProcM $ lift $ tell $ command n as  assignM = ProcM . lift . tell . assignment@@ -104,3 +128,10 @@    put i2    lift $ tell $ conditional b c1 c2  liftProc = id+ newVar x = do+   n <- newVarNumber+   let v = intVarName n+   createVarM (proc_asign v x)+   return $ varFromText v+ readVar = return . proc_read+ writeVar v x = assignM $ proc_asign (varName v) x

@@ -18,7 +18,7 @@   , pnot, (#||), (#&&)   -- *** Int   , Proc_Int, fromInt-  , pfloor+  , pfloor, pround   -- *** Float   , Proc_Float (..), fromFloat   , recFloat@@ -263,6 +263,7 @@    -- Functions  | Int_Abs Proc_Int  | Int_Floor Proc_Float+ | Int_Round Proc_Float    -- Conditional  | Int_Cond Proc_Bool Proc_Int Proc_Int    deriving Eq@@ -282,17 +283,23 @@  ppr (Int_Var t) = fromText t  ppr (Int_Abs n) = pfunction "abs" [ppr n]  ppr (Int_Floor x) = pfunction "floor" [ppr x]+ ppr (Int_Round x) = pfunction "round" [ppr x]  ppr (Int_Cond b x y) = parens $ docCond (ppr b) (ppr x) (ppr y)  -- | Cast an 'Int' value. fromInt :: Int -> Proc_Int fromInt = extend --- | Calculates the 'floor' of a 'Proc_Float'.+-- | Calculate the 'floor' of a 'Proc_Float'. pfloor :: Proc_Float -> Proc_Int pfloor (Proc_Float x) = Proc_Int $ floor x pfloor x = Int_Floor x +-- | Round a number to the closest integer.+pround :: Proc_Float -> Proc_Int+pround (Proc_Float x) = Proc_Int $ round x+pround x = Int_Round x+ instance Ord Proc_Int where  n <= m = case liftA2 (<=) (patmatch n) (patmatch m) of    Nothing -> error "Proc_Int: (<=) applied to a variable."@@ -353,7 +360,9 @@  | Float_Arctangent Proc_Float  | Float_Floor Proc_Float -- Applies floor but it treats the result                           -- as a float. Only internal.+ | Float_Round Proc_Float -- Same observation for Float_Floor.  | Float_Noise Proc_Float Proc_Float+ | Float_Random Proc_Float Proc_Float    -- Conditional  | Float_Cond Proc_Bool Proc_Float Proc_Float    deriving (Eq,Ord)@@ -381,8 +390,10 @@ 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_Round x) = Float_Round $ f x recFloat f (Float_Noise x y) = Float_Noise (f x) (f y) recFloat f (Float_Cond b x y) = Float_Cond b (f x) (f y)+recFloat f (Float_Random x y) = Float_Random (f x) (f y) recFloat _ x = x  instance Pretty Proc_Float where @@ -403,8 +414,10 @@  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_Round x) = pfunction "found" [ppr x]  ppr (Float_Noise x y) = pfunction "noise" [ppr x,ppr y]  ppr (Float_Cond b x y) = parens $ docCond (ppr b) (ppr x) (ppr y)+ ppr (Float_Random x y) = pfunction "random" [ppr x,ppr y]  -- | Cast a 'Float' value. fromFloat :: Float -> Proc_Float@@ -425,6 +438,7 @@ intToFloat (Int_Var t) = Float_Var t intToFloat (Int_Abs n) = Float_Abs $ intToFloat n intToFloat (Int_Floor x) = Float_Floor x+intToFloat (Int_Round x) = Float_Round x intToFloat (Int_Cond b x y) = Float_Cond b (intToFloat x) (intToFloat y)  -- | WARNING: 'signum' method is undefined.@@ -701,12 +715,12 @@ --   Some of them are similar to Haskell types, like 'Proc_Bool' --   and 'Bool'. However, they are not equal. @Proc_*@ types --   are instance of 'Eq'. However, you should instead use methods from---   analog 'Proc_Eq' class. @Proc_*@ types contain expressions instead+--   the analog 'Proc_Eq' class. @Proc_*@ types contain expressions instead --   of values. Think of @2+2@ instead of @4@. Under this situation, --   @2+2 /= 3+1@, since they are different expressions, even if they --   evaluate to the same value. Actually, you will get 'True' --   from the evaluation of @2+2 == 3+1@, since the library is smart---   enough to figure out they are the same value. But, please, don't+--   enough to figure out they have the same value. But, please, don't --   rely on this. Use the 'Proc_Eq' and 'Proc_Ord' classes instead. --   They return Processing boolean expressions instead of 'Bool' values. --   Anyway, the types of the library will try to force you to use @Proc_*@@@ -904,22 +918,14 @@ -- -- 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.+--+-- More abstract functions generate 'ProcScript' values as well.+-- See modules "Graphics.Web.Processing.Mid" and "Graphics.Web.Processing.Simple"+-- for two alternative ways. data ProcScript = ProcScript  { proc_preamble :: ProcCode Preamble  , proc_setup :: ProcCode Setup

@@ -30,6 +30,7 @@   , Proc_Float   , fromFloat   , pfloor+  , pround   -- ** Char   , Proc_Char   , fromChar

@@ -1,24 +1,19 @@ --- | 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 exporting 'Var' type and functions. module Graphics.Web.Processing.Core.Var (   -- * Variables    -- $vars -  -- ** Functions     Var++  -- ** Functions   , 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@@ -28,37 +23,6 @@ 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

@@ -35,6 +35,9 @@ import Text.Blaze.Html.Renderer.Text (renderHtml) import Data.Text (Text) import Data.Text.Lazy.IO (writeFile)+-- System+import System.FilePath+import System.Directory  -- | Create a canvas element which contain a Processing animation. --   The output is of the following form:@@ -64,16 +67,25 @@   head $ do title $ toHtml tit             importScript pfp             style ! type_ "text/css" $-              preEscapedToHtml ("body {margin: 0 ;} canvas {width: 100% ;}" :: Text)+              preEscapedToHtml defaultCSS   body $ procCanvas sfp +defaultCSS :: Text+defaultCSS = "body {margin: 0 ; overflow:hidden ;} canvas {width: 100% ; outline:none ;}"+ -- | 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).+--   All the 'FilePath's must be relative to where the HTML file is written.+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)+writeHtml pfp sfp tit hfp ps = do+  d0 <- getCurrentDirectory+  setCurrentDirectory $ takeDirectory hfp+  renderFile sfp ps+  let fn = takeFileName hfp+  Data.Text.Lazy.IO.writeFile fn (renderHtml $ defaultHtml pfp sfp tit)+  setCurrentDirectory d0

@@ -51,9 +51,7 @@   , on   , execScriptM     -- * Variables-  , Var-  , varName-  , ProcVarMonad (..)+  , module Graphics.Web.Processing.Core.Var     -- * Interface   , module Graphics.Web.Processing.Core.Interface   ) where@@ -62,8 +60,7 @@ 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+import Graphics.Web.Processing.Core.Var -- optimization import Graphics.Web.Processing.Optimize -- transformers@@ -72,7 +69,6 @@ import Control.Monad.Trans.State.Strict -- monoids import Data.Monoid-import Data.Foldable (foldMap) -- unsafe! import Unsafe.Coerce @@ -131,6 +127,17 @@    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."+ writeVar v x = liftProc $ writeVar v x+ readVar v = do+  x <- liftProc $ readVar v+  addPCode $ void $ liftProc $ newVar x+  n <- switchContextE $ liftProc getVarNumber+  let v' = fst $ runProcMWith n $ liftProc $ newVar x+  liftProc $ setVarNumber $ n + 1+  writeVar v' x+  liftProc $ 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."  data ScriptState c =   ScriptState@@ -161,27 +168,35 @@  return = pure  (ScriptM s) >>= f = ScriptM $ s >>= unScriptM . f +-- | Events created inside a conditional will be automatically deleted.+--   They must be /unconditional/. 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+   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)-                     (f script_keyPressed)+ iff b (ScriptM e1) (ScriptM e2) = do+   c0 <- script_code <$> ScriptM get+   let n  = fst $ runProcM $ c0 >> getVarNumber+       s1 = execState e1 $ emptyScriptState { script_code = setVarNumber n  }+       c1 = script_code s1+       n1 = fst $ runProcM $ c1 >> getVarNumber+       s2 = execState e2 $ emptyScriptState { script_code = setVarNumber n1 }+       c2 = script_code s2+       n2 = fst $ runProcM $ c2 >> getVarNumber+   liftProc $ setVarNumber n2+   liftProc $ iff b c1 c2+ newVar = liftProc . newVar+ writeVar v x = liftProc $ writeVar v x+ readVar v = do+   x  <- liftProc $ readVar v+   v' <- switchContext $ newVar x+   liftProc $ readVar v'  -- | Context of an event. The context determines which functions can be used. --   'Preamble' is not an instance of 'Context' to avoid using 'Preamble' as@@ -236,19 +251,7 @@     , proc_keyPressed = fmap execProcM $ script_keyPressed 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 ()+-- Coercions  -- | Magic! Keep it private, it's our secret! switchContext :: ScriptM c a -> ScriptM d a@@ -258,23 +261,3 @@ 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."

@@ -62,18 +62,18 @@ -- | 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))+ newVarC :: (Monad (m Preamble), ProcMonad m) => a -> m Preamble (CustomVar a)+ default newVarC :: (Monad (m Preamble), ProcMonad 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))+ readVarC :: (Monad (m c), ProcMonad m) => CustomVar a -> m c a+ default readVarC :: (Monad (m c), ProcMonad 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 :: (Monad (m c), ProcMonad m) => CustomVar a -> a -> m c ()+ default writeVarC :: (Monad (m c), ProcMonad m, Generic a, GCustomValue (Rep a)) => CustomVar a -> a -> m c ()  writeVarC v x = gwriteVarC (castCVar v) (from x)  fromVar :: Var a -> CustomVar a@@ -157,9 +157,9 @@ 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 ()+ gnewVarC :: (Monad (m Preamble), ProcMonad m) => f a -> m Preamble (CustomVar (f a))+ greadVarC :: (Monad (m c), ProcMonad m) => CustomVar (f a) -> m c (f a)+ gwriteVarC :: (Monad (m c), ProcMonad m) => CustomVar (f a) -> f a -> m c ()  instance (GVarLength a, GCustomValue a, GCustomValue b) => GCustomValue (a :*: b) where  gnewVarC (a :*: b) = do

@@ -43,7 +43,6 @@ 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@@ -54,8 +53,12 @@ numOps (Float_Arccosine x) = 1 + numOps x numOps (Float_Arctangent x) = 1 + numOps x numOps (Float_Floor x) = 1 + numOps x+numOps (Float_Round x) = 1 + numOps x numOps (Float_Noise x y) = 1 + numOps x + numOps y numOps (Float_Cond b x y) = boolops b + max (numOps x) (numOps y)+-- Variable things are worth zero.+numOps (Float_Var _) = 0+numOps (Float_Random _ _) = 0  ----------------------------------------------------- -----------------------------------------------------@@ -112,6 +115,7 @@ 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_Round x) = addFloat f >> browseFloat x browseFloat f@(Float_Noise x y) = addFloat f >> browseFloat x >> browseFloat y browseFloat f@(Float_Cond _ x y) = addFloat f >> browseFloat x >> browseFloat y browseFloat _ = return ()

@@ -1,4 +1,6 @@ +{-# LANGUAGE OverloadedStrings #-}+ -- | A 'Monoid' models figures in the plane. --   Then, figures are displayed or animated using --   a Processing script.@@ -71,11 +73,13 @@    ) where  import Data.Monoid+import Data.String import Graphics.Web.Processing.Core.Types import Graphics.Web.Processing.Mid import Graphics.Web.Processing.Mid.CustomVar -- state import Control.Applicative ((<$>))+import Control.Monad (when) import Control.Monad.Trans.State import Control.Monad.Trans.Class @@ -263,13 +267,14 @@   -> (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'.+                    --   'Key'. File @examples/keys.hs@ contains an example of+                    --   usage.   -> 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+  keyv <- newVar false   on Setup $ do      setFrameRate $ fromInt framerate   on Draw $ do@@ -290,13 +295,13 @@      writeComment "Mouse event"      p <- getMousePoint      writeVarC v $ onclick p s-  on KeyPressed $ mapM_ (keyEvent v keyv) keyevents+  when (not $ null keyevents) $ on KeyPressed $ mapM_ (keyEvent v keyv) $ zip keyevents [1..]  keyEvent :: CustomValue w-         => CustomVar w -> Var Proc_Bool -> (Key,w -> w) -> EventM KeyPressed ()-keyEvent v keyv (k,f) = do+         => CustomVar w -> Var Proc_Bool -> ((Key,w -> w),Int) -> EventM KeyPressed ()+keyEvent v keyv ((k,f),n) = do+  writeComment $ "Key event " <> fromString (show n)   matchKey keyv k   b <- readVar keyv-  iff b (readVarC v >>= writeVarC v . f)+  ifM b (readVarC v >>= writeVarC v . f)         (return ())-  writeVar keyv true

@@ -25,22 +25,24 @@ theScript :: ProcScript theScript =   interactiveFigure-    Nothing-    Nothing-    30-    4-    cubes-    (const $ Color 255 255 255 255)-    (const id)-    (const id)-    keyEvents+    Nothing -- Maximum width+    Nothing -- Maximum height+    30      -- Frames per second+    4       -- Initial position+    cubes   -- Drawing function+    (const $ Color 255 255 255 255) -- Constant background+    (const id) -- No step function+    (const id) -- No mouse event+    keyEvents  -- Key events +-- | Width of each cube. cubew :: Proc_Float cubew = 40  cubew2 :: Proc_Float cubew2 = cubew/2 +-- | Top-left corner of the 3x3 square. corner :: Proc_Point corner = let w = cubew + cubew2          in  (negate w,w)@@ -49,6 +51,8 @@ (<+>) :: Proc_Point -> Proc_Point -> Proc_Point (a,b) <+> (c,d) = (a+c,b+d) +-- | Draw the cube at a certain position.+--   The boolean indicates if it is black or white. cubeUnit :: Proc_Bool -> Proc_Int -> Figure cubeUnit b n =   let q = if_ b 0 255@@ -57,9 +61,11 @@      p = corner <+> (cubew * intToFloat m, negate $ cubew * intToFloat d)  in  FillColor c $ Rectangle p cubew cubew +-- | Draw all the cubes. cubes :: State -> Figure cubes n = mconcat $ fmap (\i -> cubeUnit (n #== i) i) [0 .. 8] +-- | WASD keys to move the black box. keyEvents :: [(Key,State -> State)] keyEvents = [    ( CharKey 'w'

@@ -0,0 +1,42 @@++{-# LANGUAGE OverloadedStrings #-}++import Graphics.Web.Processing.Mid+import Graphics.Web.Processing.Html+import Control.Applicative ((<$>))++main :: IO ()+main = writeHtml "processing.js" "random.pde" "Random demo" "random.html" randomDemo++randomDemo :: ProcScript+randomDemo = execScriptM $ do+  vi <- newVar 0+  vj <- newVar 0+  rv <- newVar 0+  gv <- newVar 0+  bv <- newVar 0+  on Setup $ do+     size screenWidth screenHeight+     background $ Color 255 255 255 255+     setFrameRate 30+  on Draw $ do+     strokeWeight $ div screenWidth 40+     -- Random color+     random rv 0 50+     r <- pround <$> readVar rv+     random gv 0 255+     g <- pround <$> readVar gv+     random bv 0 255+     b <- pround <$> readVar bv+     stroke $ Color r g b 100+     -- Top position+     i <- readVar vi+     -- Bottom position+     random vj 0 (intToFloat screenWidth)+     j <- readVar vj+     -- Line+     line (intToFloat i,0) (j,intToFloat screenHeight)+     -- Update top position+     ifM (i #>= screenWidth)+         (writeVar vi 0)+         (writeVar vi $ i + div screenWidth 250)

@@ -1,5 +1,5 @@ Name: processing-Version: 1.0.1.0+Version: 1.1.0.0 Author: Daniel Díaz Category: Graphics Build-type: Simple@@ -9,6 +9,7 @@ Bug-reports: https://github.com/Daniel-Diaz/processing/issues Synopsis: Web graphic applications with Processing. Stability: In development+Tested-with: GHC == 7.6.3 Description:   /Processing/ is a visual design programming language.   /Processing.js/ is the sister project of Processing designed@@ -57,6 +58,7 @@   examples/twist.hs   examples/mill.hs   examples/keys.hs+  examples/random.hs  Source-repository head   type: git@@ -65,12 +67,14 @@ Library   Build-depends:       base == 4.*-    , text-    , containers-    , transformers-    , mainland-pretty-    , blaze-html-    , multiset+    , text >= 0.11.2.3 && < 0.12+    , containers >= 0.5 && < 0.6+    , transformers >= 0.3 && < 0.4+    , mainland-pretty >= 0.2 && < 0.3+    , blaze-html >= 0.5.1 && < 0.7+    , multiset >= 0.2.2 && < 0.3+    , directory+    , filepath   -- Compatibility with previous GHC versions.   if impl(ghc < 7.6)      Build-depends: ghc-prim