processing 1.0.0.1 → 1.0.1.0

raw patch · 8 files changed

+332/−15 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Graphics/Web/Processing/Core/Interface.hs +67/−1
• Graphics/Web/Processing/Core/Primal.hs +127/−7
• Graphics/Web/Processing/Core/Types.hs +8/−1
• Graphics/Web/Processing/Mid.hs +11/−3
• Graphics/Web/Processing/Optimize.hs +18/−1
• Graphics/Web/Processing/Simple.hs +22/−1
• examples/keys.hs +77/−0
• processing.cabal +2/−1

@@ -41,6 +41,12 @@    , resetMatrix    -- * Mouse    , getMousePoint+   -- * Keyboard+   , Key (..)+   , ArrowKey (..)+   , KeyModifier (..)+   , SpecialKey (..)+   , matchKey    -- * Conditionals    , iff    -- * Others@@ -54,7 +60,9 @@ -- Internal import Graphics.Web.Processing.Core.Primal import Graphics.Web.Processing.Core.Monad-import Graphics.Web.Processing.Core.Var (readVar)+import Graphics.Web.Processing.Core.Var (writeVar,readVar)+--+import Control.Arrow (first)  ---- PREDEFINED VALUES @@ -289,6 +297,64 @@  x <- readVar $ varFromText "mouseX"  y <- readVar $ varFromText "mouseY"  return (x,y)++---- KEYBOARD++-- | Keyboard keys recognized by Processing.+data Key =+    CharKey Char+  | SpecialKey SpecialKey+  | ArrowKey ArrowKey+  | ModKey KeyModifier Key++-- | Arrow keys.+data ArrowKey = UP | DOWN | LEFT | RIGHT++-- | Key modifiers.+data KeyModifier = ALT | CONTROL | SHIFT++-- | Special keys.+data SpecialKey =+    BACKSPACE+  | TAB+  | ENTER+  | RETURN+  | ESC++--                      CODED                   UNCODED+keySplit :: Key -> ([Proc_KeyCode],Maybe (Either Proc_Key Proc_KeyCode))+keySplit (CharKey c) = ([],Just $ Left $ Key_Char c)+keySplit (SpecialKey BACKSPACE) = ([],Just $ Right $ KeyCode_BACKSPACE)+keySplit (SpecialKey TAB) = ([],Just $ Right $ KeyCode_TAB)+keySplit (SpecialKey ENTER) = ([],Just $ Right $ KeyCode_ENTER)+keySplit (SpecialKey RETURN) = ([],Just $ Right $ KeyCode_RETURN)+keySplit (SpecialKey ESC) = ([],Just $ Right $ KeyCode_ESC)+keySplit (ArrowKey UP) = ([KeyCode_UP], Nothing)+keySplit (ArrowKey DOWN) = ([KeyCode_DOWN], Nothing)+keySplit (ArrowKey LEFT) = ([KeyCode_LEFT], Nothing)+keySplit (ArrowKey RIGHT) = ([KeyCode_RIGHT], Nothing)+keySplit (ModKey m k) =+  let modToKeyCode :: KeyModifier -> Proc_KeyCode+      modToKeyCode ALT = KeyCode_ALT+      modToKeyCode CONTROL = KeyCode_CONTROL+      modToKeyCode SHIFT = KeyCode_SHIFT+  in  first (modToKeyCode m:) $ keySplit k++-- | This function takes a variable of type 'Proc_Bool' and a 'Key', and sets the variable to+--   'true' if the key pressed is the given 'Key'. Otherwise, the variable is set to 'false'.+matchKey :: (ProcMonad m, Monad (m KeyPressed)) => Var Proc_Bool -> Key -> m KeyPressed ()+matchKey v k = do+  let (codedKeys,uncodedKey) = keySplit k+  if null codedKeys+     then return ()+     else iff (Key_Var #== Key_CODED)+              (writeVar v $ foldr1 (#&&) $ fmap (KeyCode_Var #==) codedKeys)+              (writeVar v false)+  b <- readVar v+  case uncodedKey of+    Nothing -> return ()+    Just (Left  pk) -> writeVar v $ Key_Var     #== pk #&& b+    Just (Right ck) -> writeVar v $ KeyCode_Var #== ck #&& b  ---- SETUP 

@@ -10,9 +10,10 @@   --   use of certain commands to specific contexts.     Preamble (..), Setup (..), Draw (..)   , MouseClicked (..), MouseReleased (..)-  -- ** Processing types+  , KeyPressed (..)+  -- ** @Proc_*@ types   -- *** Boolean-  , Proc_Bool, fromBool+  , Proc_Bool (..), fromBool   , true, false   , pnot, (#||), (#&&)   -- *** Int@@ -29,6 +30,9 @@   , Proc_Char , fromChar   -- *** Text   , Proc_Text, fromStText+  -- *** Keys+  , Proc_Key (..)+  , Proc_KeyCode (..)   -- ** Type class of proc types   , ProcType (..)   -- ** Conditionals@@ -85,6 +89,9 @@ -- | Code that is executed when the mouse is released. data MouseReleased = MouseReleased +-- | Code executed when a key is pressed.+data KeyPressed = KeyPressed+ -- PRETTY-HELPERS  pfunction :: Text -> [Doc] -> Doc@@ -145,7 +152,12 @@    | Char_NEq Proc_Char Proc_Char      -- Text    | Text_Eq Proc_Text Proc_Text-     deriving Eq+     -- Key+   | Key_Eq Proc_Key Proc_Key+   | KeyCode_Eq Proc_KeyCode Proc_KeyCode+   -- Conditional+ | Bool_Cond Proc_Bool Proc_Bool Proc_Bool+     deriving (Eq,Ord)  instance Extended Bool Proc_Bool where  extend True  = Proc_True @@ -174,6 +186,9 @@ docG :: Doc docG = fromText ">" +docCond :: Doc -> Doc -> Doc -> Doc+docCond _if _then _else = _if <+> fromText "?" <+> _then <+> fromText ":" <+> _else+ indentLevel :: Int indentLevel = 3 @@ -202,6 +217,9 @@  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]+ ppr (Key_Eq x y) = parens $ ppr x <+> docEq <+> ppr y+ ppr (KeyCode_Eq x y) = parens $ ppr x <+> docEq <+> ppr y+ ppr (Bool_Cond b x y) = parens $ docCond (ppr b) (ppr x) (ppr y)  -- | Value of 'True'. true :: Proc_Bool@@ -245,6 +263,8 @@    -- Functions  | Int_Abs Proc_Int  | Int_Floor Proc_Float+   -- Conditional+ | Int_Cond Proc_Bool Proc_Int Proc_Int    deriving Eq  instance Extended Int Proc_Int where@@ -262,6 +282,7 @@  ppr (Int_Var t) = fromText t  ppr (Int_Abs n) = pfunction "abs" [ppr n]  ppr (Int_Floor x) = pfunction "floor" [ppr x]+ ppr (Int_Cond b x y) = parens $ docCond (ppr b) (ppr x) (ppr y)  -- | Cast an 'Int' value. fromInt :: Int -> Proc_Int@@ -333,6 +354,8 @@  | Float_Floor Proc_Float -- Applies floor but it treats the result                           -- as a float. Only internal.  | Float_Noise Proc_Float Proc_Float+   -- Conditional+ | Float_Cond Proc_Bool Proc_Float Proc_Float    deriving (Eq,Ord)  instance Extended Float Proc_Float where@@ -359,6 +382,7 @@ 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 f (Float_Cond b x y) = Float_Cond b (f x) (f y) recFloat _ x = x  instance Pretty Proc_Float where @@ -380,6 +404,7 @@  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]+ ppr (Float_Cond b x y) = parens $ docCond (ppr b) (ppr x) (ppr y)  -- | Cast a 'Float' value. fromFloat :: Float -> Proc_Float@@ -400,6 +425,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_Cond b x y) = Float_Cond b (intToFloat x) (intToFloat y)  -- | WARNING: 'signum' method is undefined. instance Num Proc_Float where@@ -434,16 +460,21 @@  atanh = error "Proc_Float: atanh method is undefined."  -- | Type of images.-data Proc_Image = Image_Var Text deriving Eq+data Proc_Image =+   Image_Var Text+ | Image_Cond Proc_Bool Proc_Image Proc_Image+   deriving Eq  instance Pretty Proc_Image where  ppr (Image_Var t) = fromText t+ ppr (Image_Cond b x y) = parens $ docCond (ppr b) (ppr x) (ppr y)  -- | Type of characters. data Proc_Char =    Proc_Char Char  | Char_Var Text-   deriving Eq+ | Char_Cond Proc_Bool Proc_Char Proc_Char+   deriving (Eq,Ord)  instance Extended Char Proc_Char where  extend = Proc_Char@@ -457,12 +488,15 @@ instance Pretty Proc_Char where  ppr (Proc_Char c) = enclose squote squote (char c)  ppr (Char_Var n) = fromText n+ ppr (Char_Cond b x y) = parens $ docCond (ppr b) (ppr x) (ppr y)  -- | Type of textual values. data Proc_Text =    Proc_Text Text  | Text_Var Text-   deriving Eq+   -- Conditional+ | Text_Cond Proc_Bool Proc_Text Proc_Text+   deriving (Eq,Ord)  instance Extended Text Proc_Text where  extend = Proc_Text@@ -470,8 +504,11 @@  patmatch _ = Nothing  instance Pretty Proc_Text where+ -- Wrong pretty-printer for text values. Fix it to+ -- escape characters.  ppr (Proc_Text t) = enclose dquote dquote (fromText t)  ppr (Text_Var n) = fromText n+ ppr (Text_Cond b x y) = parens $ docCond (ppr b) (ppr x) (ppr y)  -- | Cast a strict 'Text' value. fromStText :: Text -> Proc_Text@@ -480,6 +517,52 @@ instance IsString Proc_Text where  fromString = fromStText . fromString +-- | Type of keyboard keys.+data Proc_Key =+   Key_Var+ | Key_CODED+ | Key_Char Char+   deriving (Eq,Ord)++instance Pretty Proc_Key where+ ppr Key_Var = fromText "key"+ ppr Key_CODED = fromText "CODED"+ ppr (Key_Char c) = ppr $ fromChar c++-- | Type of keyboard key codes.+data Proc_KeyCode =+   KeyCode_Var+ | KeyCode_UP+ | KeyCode_DOWN+ | KeyCode_LEFT+ | KeyCode_RIGHT+ | KeyCode_ALT+ | KeyCode_CONTROL+ | KeyCode_SHIFT+ | KeyCode_BACKSPACE+ | KeyCode_TAB+ | KeyCode_ENTER+ | KeyCode_RETURN+ | KeyCode_ESC+ | KeyCode_DELETE+   deriving (Eq,Ord)++instance Pretty Proc_KeyCode where+ ppr KeyCode_Var = fromText "keyCode"+ ppr KeyCode_UP = fromText "UP"+ ppr KeyCode_DOWN = fromText "DOWN"+ ppr KeyCode_LEFT = fromText "LEFT"+ ppr KeyCode_RIGHT = fromText "RIGHT"+ ppr KeyCode_ALT = fromText "ALT"+ ppr KeyCode_CONTROL = fromText "CONTROL"+ ppr KeyCode_SHIFT = fromText "SHIFT"+ ppr KeyCode_BACKSPACE = fromText "BACKSPACE"+ ppr KeyCode_TAB = fromText "TAB"+ ppr KeyCode_ENTER = fromText "ENTER"+ ppr KeyCode_RETURN = fromText "RETURN"+ ppr KeyCode_ESC = fromText "ESC"+ ppr KeyCode_DELETE = fromText "DELETE"+ -- CODE  -- | A piece of Processing code.@@ -612,7 +695,27 @@  ----- CLASSES --- | Class of Processing value types.+-- | Class of Processing value types (@Proc_*@ types).+--+--   @Proc_*@ types are types from the world of Processing.+--   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+--   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+--   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_*@+--   types everywhere.+--+--   The reason this library stores expressions instead of values is that+--   it needs to handle things like @2+x@, where @x@ is an unknown value.+--   However, an effort is done to ensure that each expression is reduced+--   to its minimum extension. class ProcType a where  -- | Create a variable assignment, provided  --   the name of the variable and the value to asign.@@ -621,36 +724,44 @@  proc_arg :: a -> ProcArg  -- | Variable reading.  proc_read :: Var a -> a+ -- | Conditional value.+ proc_cond :: Proc_Bool -> a -> a -> a  instance ProcType Proc_Bool where  proc_asign = BoolAsign  proc_arg = BoolArg  proc_read (Var v) = Bool_Var v+ proc_cond = Bool_Cond  instance ProcType Proc_Int where  proc_asign = IntAsign  proc_arg = IntArg  proc_read (Var v) = Int_Var v+ proc_cond = Int_Cond  instance ProcType Proc_Float where  proc_asign = FloatAsign  proc_arg = FloatArg  proc_read (Var v) = Float_Var v+ proc_cond = Float_Cond  instance ProcType Proc_Image where  proc_asign = ImageAsign  proc_arg = ImageArg  proc_read (Var v) = Image_Var v+ proc_cond = Image_Cond  instance ProcType Proc_Char where  proc_asign = CharAsign  proc_arg = CharArg  proc_read (Var v) = Char_Var v+ proc_cond = Char_Cond  instance ProcType Proc_Text where  proc_asign =  TextAsign  proc_arg = TextArg  proc_read (Var v) = Text_Var v+ proc_cond = Text_Cond  infix 4 #==, #/= @@ -681,6 +792,12 @@ instance Proc_Eq Proc_Text where  (#==) = Text_Eq +instance Proc_Eq Proc_Key where+ (#==) = Key_Eq++instance Proc_Eq Proc_KeyCode where+ (#==) = KeyCode_Eq+ infix 4 #<=, #<, #>=, #>  -- | 'Ord' class for @Proc_*@ values.@@ -809,6 +926,7 @@  , proc_draw  :: Maybe (ProcCode Draw)  , proc_mouseClicked :: Maybe (ProcCode MouseClicked)  , proc_mouseReleased :: Maybe (ProcCode MouseReleased)+ , proc_keyPressed :: Maybe (ProcCode KeyPressed)    }  -- | Empty script.@@ -819,6 +937,7 @@  , proc_draw = Nothing  , proc_mouseClicked = Nothing  , proc_mouseReleased = Nothing+ , proc_keyPressed = Nothing    }  pvoid :: Pretty a => Text -> Maybe a -> Doc@@ -834,4 +953,5 @@    , pvoid "draw" $ proc_draw ps    , pvoid "mouseClicked" $ proc_mouseClicked ps    , pvoid "mouseReleased" $ proc_mouseReleased ps+   , pvoid "keyPressed" $ proc_keyPressed ps      ]

@@ -15,7 +15,8 @@   , Draw (..)   , MouseClicked (..)   , MouseReleased (..)-  -- * Processing types+  , KeyPressed (..)+  -- * @Proc_*@ types   , ProcType   -- ** Bool   , Proc_Bool, true, false@@ -40,6 +41,8 @@   -- * Processing classes   , Proc_Eq (..)   , Proc_Ord (..)+  -- * Conditional values+  , if_   ) where  import Graphics.Web.Processing.Core.Primal@@ -58,3 +61,7 @@ --   write it directly in a file. renderFile :: FilePath -> ProcScript -> IO () renderFile fp = T.writeFile fp . renderScript++-- | Conditional value.+if_ :: ProcType a => Proc_Bool -> a -> a -> a+if_ = proc_cond

@@ -122,8 +122,10 @@  assignM = addCode . assignM  writeComment = addCode . writeComment  iff b (EventM e1) (EventM e2) = do-   let s1 = execState e1 emptyEventState-       s2 = execState e2 emptyEventState+   n0 <- liftProc getVarNumber+   let s1 = execState e1 $ emptyEventState { event_code = setVarNumber n0 }+       n1 = fst $ runProcMWith n0 $ event_code s1 >> getVarNumber+       s2 = execState e2 $ EventState { event_preamble = return () , event_code = setVarNumber n1 }    addPCode $ event_preamble s1    addPCode $ event_preamble s2    addCode $ iff b (event_code s1) (event_code s2)@@ -137,10 +139,11 @@     , script_draw :: Maybe (ProcM Draw ())     , script_mouseClicked :: Maybe (ProcM MouseClicked ())     , script_mouseReleased :: Maybe (ProcM MouseReleased ())+    , script_keyPressed :: Maybe (ProcM KeyPressed ())       }  emptyScriptState :: ScriptState c-emptyScriptState = ScriptState (return ()) Nothing Nothing Nothing Nothing+emptyScriptState = ScriptState (return ()) Nothing Nothing Nothing Nothing Nothing  -- | Scripter monad. This monad is where Processing code is written. --   Because of some implementation details, 'ScriptM' has a context @c@.@@ -178,6 +181,7 @@                      (f script_draw)                      (f script_mouseClicked)                      (f script_mouseReleased)+                     (f script_keyPressed)  -- | Context of an event. The context determines which functions can be used. --   'Preamble' is not an instance of 'Context' to avoid using 'Preamble' as@@ -197,6 +201,9 @@ instance Context MouseReleased where  addEvent _ c s = s { script_mouseReleased = Just c } +instance Context KeyPressed where+ addEvent _ c s = s { script_keyPressed = Just c }+ -- | Set an event. Different events are specified by the instances of the --   'Context' class. --@@ -226,6 +233,7 @@     , proc_draw = fmap execProcM $ script_draw s     , proc_mouseClicked = fmap execProcM $ script_mouseClicked s     , proc_mouseReleased = fmap execProcM $ script_mouseReleased s+    , proc_keyPressed = fmap execProcM $ script_keyPressed s       }  -- Variables

@@ -21,6 +21,18 @@ import Control.Applicative ((<$>)) import Control.Arrow (second) +boolops :: Proc_Bool -> Int+boolops (Proc_Neg x) = 1 + boolops x+boolops (Proc_Or x y) = 1 + boolops x + boolops y+boolops (Proc_And x y) = 1 + boolops x + boolops y+boolops (Float_Eq x y) = 1 + numOps x + numOps y+boolops (Float_NEq x y) = 1 + numOps x + numOps y+boolops (Float_LE x y) = 1 + numOps x + numOps y+boolops (Float_L x y) = 1 + numOps x + numOps y+boolops (Float_GE x y) = 1 + numOps x + numOps y+boolops (Float_G x y) = 1 + numOps x + numOps y+boolops _ = 0+ -- | Number of operations needed to calculate the --   value of a given 'Proc_Float' value. numOps :: Proc_Float -> Int@@ -43,6 +55,7 @@ numOps (Float_Arctangent x) = 1 + numOps x numOps (Float_Floor 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)  ----------------------------------------------------- -----------------------------------------------------@@ -100,6 +113,7 @@ 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 f@(Float_Cond _ x y) = addFloat f >> browseFloat x >> browseFloat y browseFloat _ = return ()  execCounter :: FloatCounter a -> FloatSet@@ -266,17 +280,20 @@               _draw               _mouseClicked               _mouseReleased+              _keyPressed                )   = 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]+        (n5,_keyPressed')    = maybe (n4,Nothing) (second Just . subsOptimize n4) _keyPressed+        vs = fmap (\n -> CreateVar $ FloatAsign (optVarName n) 0) [1 .. n5 - 1]     in ProcScript (_preamble <> subsComment (mconcat vs))                    _setup'                    _draw'                    _mouseClicked'                    _mouseReleased'+                   _keyPressed'  subsComment :: ProcCode Preamble -> ProcCode Preamble subsComment c =

@@ -60,6 +60,12 @@    , animateFigure      -- ** Interactive    , interactiveFigure+     -- *** Keyboard+   , Key (..)+   , ArrowKey (..)+   , KeyModifier (..)+   , SpecialKey (..)+     -- *** Custom values      -- | Module re-export for convenience.    , module Graphics.Web.Processing.Mid.CustomVar    ) where@@ -255,15 +261,20 @@                           --   It is passed the number of frames from the                           --   beginning.   -> (Proc_Point -> w -> w) -- ^ Function called each time the mouse is clicked.+  -> [(Key,w -> w)] -- ^ Key events. List of pairs, where the first component is+                    --   a 'Key' and the second component is the reaction to that+                    --   'Key'.   -> ProcScript-interactiveFigure mw mh framerate s0 _print bg step onclick = execScriptM $ do+interactiveFigure mw mh framerate s0 _print bg step onclick keyevents = execScriptM $ do   let w = maybe screenWidth  fromInt mw       h = maybe screenHeight fromInt mh   v <- newVarC s0+  keyv <- newVar true   on Setup $ do      setFrameRate $ fromInt framerate   on Draw $ do      size w h+     translate (intToFloat w/2) (intToFloat h/2)      writeComment "Read state"      s <- readVarC v      writeComment "Background color"@@ -279,3 +290,13 @@      writeComment "Mouse event"      p <- getMousePoint      writeVarC v $ onclick p s+  on KeyPressed $ mapM_ (keyEvent v keyv) keyevents++keyEvent :: CustomValue w+         => CustomVar w -> Var Proc_Bool -> (Key,w -> w) -> EventM KeyPressed ()+keyEvent v keyv (k,f) = do+  matchKey keyv k+  b <- readVar keyv+  iff b (readVarC v >>= writeVarC v . f)+        (return ())+  writeVar keyv true

@@ -0,0 +1,77 @@++{- Keyboard interaction demo++One of the squares in a 3x3 matrix of squares+is black and the rest is white. Use WASD keys+to change the position of the black square.++-}++import Graphics.Web.Processing.Simple+import Graphics.Web.Processing.Html++main :: IO ()+main = writeHtml "processing.js" "keydemo.pde" "Keyboard demo" "keydemo.html" theScript++---------------+-- 0 | 1 | 2 --+-- 3 | 4 | 5 --+-- 6 | 7 | 8 --+---------------++-- | State indicates the current position.+type State = Proc_Int++theScript :: ProcScript+theScript =+  interactiveFigure+    Nothing+    Nothing+    30+    4+    cubes+    (const $ Color 255 255 255 255)+    (const id)+    (const id)+    keyEvents++cubew :: Proc_Float+cubew = 40++cubew2 :: Proc_Float+cubew2 = cubew/2++corner :: Proc_Point+corner = let w = cubew + cubew2+         in  (negate w,w)++-- | Addition of points.+(<+>) :: Proc_Point -> Proc_Point -> Proc_Point+(a,b) <+> (c,d) = (a+c,b+d)++cubeUnit :: Proc_Bool -> Proc_Int -> Figure+cubeUnit b n = + let q = if_ b 0 255+     c = Color q q q 255+     (d,m) = divMod n 3+     p = corner <+> (cubew * intToFloat m, negate $ cubew * intToFloat d)+ in  FillColor c $ Rectangle p cubew cubew++cubes :: State -> Figure+cubes n = mconcat $ fmap (\i -> cubeUnit (n #== i) i) [0 .. 8]++keyEvents :: [(Key,State -> State)]+keyEvents = [+   ( CharKey 'w'+   , (\n -> if_ (n #< 3) n (n - 3))+     )+ , ( CharKey 'a'+   , (\n -> if_ (mod n 3 #== 0) n (n - 1))+     )+ , ( CharKey 's'+   , (\n -> if_ (n #> 5) n (n + 3))+     )+ , ( CharKey 'd'+   , (\n -> if_ (mod n 3 #== 2) n (n + 1))+     )+ ]

@@ -1,5 +1,5 @@ Name: processing-Version: 1.0.0.1+Version: 1.0.1.0 Author: Daniel Díaz Category: Graphics Build-type: Simple@@ -56,6 +56,7 @@   readme.md   examples/twist.hs   examples/mill.hs+  examples/keys.hs  Source-repository head   type: git