packages feed

twentefp-eventloop-graphics 0.1.0.2 → 0.1.0.3

raw patch · 17 files changed

+406/−173 lines, 17 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- FPPrac.Graphics.MakePrimitives: createArcPrimitive :: Color -> Pos -> Radius -> Angle -> Angle -> Primitive
- FPPrac.Graphics.MakePrimitives: createColor :: (NormalizeNumber r, NormalizeNumber g, NormalizeNumber b) => r -> g -> b -> (NormalizedNum, NormalizedNum, NormalizedNum)
- FPPrac.Graphics.MakePrimitives: createDimension :: (NormalizeNumber w, NormalizeNumber h) => w -> h -> (NormalizedNum, NormalizedNum)
- FPPrac.Graphics.MakePrimitives: createDrawCommand :: GObject -> String -> Graphical
- FPPrac.Graphics.MakePrimitives: createGraphicalContainer :: [GObject] -> GObject
- FPPrac.Graphics.MakePrimitives: createGraphicalObject :: String -> Primitive -> [GObject] -> GObject
- FPPrac.Graphics.MakePrimitives: createLinePrimitive :: Color -> [Pos] -> Primitive
- FPPrac.Graphics.MakePrimitives: createMoveElementCommand :: String -> Pos -> Relative -> Graphical
- FPPrac.Graphics.MakePrimitives: createMoveGroupCommand :: String -> Pos -> Relative -> Graphical
- FPPrac.Graphics.MakePrimitives: createNormalizedNum :: NormalizeNumber i => i -> NormalizedNum
- FPPrac.Graphics.MakePrimitives: createPosition :: (NormalizeNumber x, NormalizeNumber y) => x -> y -> (NormalizedNum, NormalizedNum)
- FPPrac.Graphics.MakePrimitives: createRectPrimitive :: Color -> Pos -> Dimension -> Primitive
- FPPrac.Graphics.MakePrimitives: createRemoveElementCommand :: String -> Graphical
- FPPrac.Graphics.MakePrimitives: createRemoveGroupCommand :: String -> Graphical
- FPPrac.Graphics.MakePrimitives: createTextPrimitive :: Color -> Pos -> TextSize -> Font -> String -> Bool -> Primitive
- FPPrac.Graphics.MakePrimitives: type Angle = NormalizedNum
- FPPrac.Graphics.MakePrimitives: type NormalizedNum = Float
- FPPrac.Graphics.MakePrimitives: type Radius = NormalizedNum
- FPPrac.Graphics.MakePrimitives: type TextSize = NormalizedNum
+ FPPrac.Graphics.NormalizeNumber: class Num a => NormalizeNumber a
+ FPPrac.Graphics.NormalizeNumber: instance NormalizeNumber Double
+ FPPrac.Graphics.NormalizeNumber: instance NormalizeNumber Float
+ FPPrac.Graphics.NormalizeNumber: instance NormalizeNumber Int
+ FPPrac.Graphics.NormalizeNumber: instance NormalizeNumber Integer
+ FPPrac.Graphics.NormalizeNumber: instance NormalizeNumber Number
+ FPPrac.Graphics.NormalizeNumber: normalize :: NormalizeNumber a => a -> Float

Files

src/EventLoop.hs view
@@ -1,3 +1,19 @@+{-|
+Module      : EventLoop
+Description : Complete import of all the exposed features of this library.
+Copyright   : (c) Sebastiaan la Fleur, 2014
+License     : BSD3
+Maintainer  : sebastiaan.la.fleur@gmail.com
+Stability   : experimental
+Portability : All
+
+Complete import of all the exposed features of this library. 
+The Eventloop package is used to express the communication between a Haskell server and a program modelling an \'IO Device'.
+This package contains an example implementation of how such a server would like when a browser is used as a graphical IO device also containing a mouse and keyboard.
+The 'EventLoop.Input.InputEvents.InputEvent' models the possible mouse and keyboard events. The 'EventLoop.Output.OutputEvents.OutputEvent' models the possible graphical
+output events. There are also input and output systemmessages to communicate metadata between the Haskell server and the graphical IO browser.
+The starting point for this example implementation is 'EventLoop.Main.start'.
+-}
 module EventLoop(
     start,
     Pos,
src/EventLoop/CommonTypes.hs view
@@ -1,11 +1,29 @@+{-|
+Module      : EventLoop.CommonTypes
+Description : All common types throughout the "EventLoop" module
+Copyright   : (c) Sebastiaan la Fleur, 2014
+License     : BSD3
+Maintainer  : sebastiaan.la.fleur@gmail.com
+Stability   : experimental
+Portability : All
+
+All common types throughout the "EventLoop" module
+-}
 module EventLoop.CommonTypes
     ( Pos
     , Dimension
     , Element
     ) where
 
-import FPPrac
+{-| 
+ Type to express a position on the screen. 
+ It uses the format (x,y). 
+ As Canvas is used in the example implementation, remember that the lefttop corner is (0,0) and the leftbottom corner is (0, height of screen).
+-}
+type Pos = (Float,Float)
 
-type Pos = (Float,Float) -- (x, y)
-type Dimension = (Float, Float) -- (w, h)
+-- | Type to express the dimension of an element. It uses the format (w,h).
+type Dimension = (Float, Float)
+
+-- | The name of a graphical element.  It is used for 'EventLoop.Input.Mouse' to express the name of which element is clicked on.
 type Element = [Char]
src/EventLoop/Config.hs view
@@ -1,11 +1,23 @@+{-|
+Module      : EventLoop.Config
+Description : All string literals used through the "EventLoop" module
+Copyright   : (c) Sebastiaan la Fleur, 2014
+License     : BSD3
+Maintainer  : sebastiaan.la.fleur@gmail.com
+Stability   : experimental
+Portability : All
+
+All string literals used through the "EventLoop" module
+-}
 module EventLoop.Config where
 
 import FPPrac
 
 ------------------
--- Server Settings
+-- | The server listening address used. It is set to localhost (127.0.0.1).
 ipadres = "127.0.0.1"
-port = 9161 :: Number
+-- | The server port number used. It is set to 9161.
+port = 9161 :: Int
 
 -----------
 -- Response modes
src/EventLoop/EventProcessor.hs view
@@ -1,3 +1,20 @@+{-|
+Module      : EventLoop.EventProcessor
+Description : Low-level eventloop framework. Uses 'IOMessage's to communicate.
+Copyright   : (c) Sebastiaan la Fleur, 2014
+License     : BSD3
+Maintainer  : sebastiaan.la.fleur@gmail.com
+Stability   : experimental
+Portability : All
+
+Low-level eventloop framework. Uses 'IOMessage's to communicate.
+This module can be used to express your own 'EventLoop.Input.InputEvent's and 'EventLoop.Output.OutputEvent's.
+For instance, we have a keyboard and mouse 'EventLoop.Input.InputEvent' example included in this module\'s implementation.
+But it might be that you want to define your own 'EventLoop.Input.InputEvent' structure. In that case, you can define your own
+'FromJSON' class to express how the literal 'IOMessage' should be parsed into your own 'EventLoop.Input.InputEvent' datatype.
+The same goes for 'EventLoop.Output.OutputEvent' of course. An 'IOMessage' is a 'String' literal that the client sends. The accompanied
+standard webpage uses JSON as a protocol to express these 'String' literals. 
+-}
 module EventLoop.EventProcessor(eventloop, IOMessage, readRequest, sendResponse) where
 
 import qualified Network.WebSockets as WS
@@ -9,14 +26,31 @@ import EventLoop.Json
 import EventLoop.Config
 
+-- | Type of the message that is used to communicate with the IO device. In this example implementation a webbrowser is used and the messages use JSON encoding.
 type IOMessage = JSONMessage
 
--- Start connection
-eventloop :: (a -> IOMessage -> ([IOMessage], a)) -> a -> IO ()
-eventloop eh beginState = WS.server ipadres (fromIntegral port) $ doEvents eh beginState 
+{- |
+ Low-level function to call when dealing with IOMessages directly. 
+ If you want to use the example implementation using the 'EventLoop.Input.InputEvent' and 'EventLoop.Output.OutputEvent'
+ , you should use the 'EventLoop.Main.start' function.
+-}
+eventloop :: (a -> IOMessage -> ([IOMessage], a)) -- ^ The eventhandler eh that maps incoming 'IOMessage's to outgoing 'IOMessage's. It uses a variable of type a to store information in between calls to the event handler.
+          -> a                                    -- ^ The begin store. It should be changed in the eventhandler function.
+          -> IO ()
+eventloop eh beginState = WS.server ipadres port $ doEvents eh beginState 
 
--- Event Loop
-doEvents :: (a -> IOMessage -> ([IOMessage], a)) -> a -> WS.Connection -> WS.StdOutMutex -> WS.ConnectionSendMutex -> IO ()
+{- |
+ This function maps all incoming messages over the eventhandler and sends off the resulting output messages.
+ Uses the connection to communicate with the IO device. Uses the Standard Output Mutex to print information
+ to stdout in a safe multi-threaded way as each connection starts a thread that uses the 'doEvents' 
+ function.
+-}
+doEvents :: (a -> IOMessage -> ([IOMessage], a)) -- ^ The eventhandler eh that maps incoming 'IOMessage's to outgoing 'IOMessage's. It uses a variable of type a to store information in between calls to the event handler.
+         -> a                                    -- ^ The begin store. It should be changed in the eventhandler function.
+         -> WS.Connection                        -- ^ Connection to the IO device.
+         -> WS.StdOutMutex                       -- ^ Standard Output Mutex for printing information in a safe multi-threaded way to the standard out.
+         -> WS.ConnectionSendMutex               -- ^ Connection Send Mutex for sending 'IOMessage's to the IO device in a safe multi-threaded way.
+         -> IO ()
 doEvents eh state conn stdoutM connSendM = do
                     request <- readRequest conn stdoutM
                     let
@@ -24,7 +58,10 @@                         sendActions = map (sendResponse connSendM conn stdoutM)  resp
                     sequence sendActions
                     doEvents eh state' conn stdoutM connSendM
-                
+
+{- |
+ This functions reads a request from the 'WS.Connection' and parses it into an 'IOMessage'.
+-}                    
 readRequest :: WS.Connection -> WS.StdOutMutex -> IO IOMessage                
 readRequest conn stdoutM = do
                             msg <- WS.receiveData conn :: IO T.Text
@@ -33,7 +70,10 @@                                 request = stringToJsonObject string
                             --WS.safePutStr stdoutM string
                             return request
-                    
+
+{- |
+ This function takes an 'IOMessage' and parses it into a response. Then it sends the response to the 'WS.Connection'. 
+-}                            
 sendResponse :: WS.ConnectionSendMutex -> WS.Connection -> WS.StdOutMutex -> IOMessage -> IO ()
 sendResponse mu conn stdoutM response = do
                                         let
src/EventLoop/Input/InputEvent.hs view
@@ -1,3 +1,15 @@+{-|
+Module      : EventLoop.Input.InputEvent
+Description : Library of all the possible 'InputEvent's in the example implementation.
+Copyright   : (c) Sebastiaan la Fleur, 2014
+License     : BSD3
+Maintainer  : sebastiaan.la.fleur@gmail.com
+Stability   : experimental
+Portability : All
+
+All different 'InputEvent's are combined to a single 'InputEvent' type. 
+In this example implementation, the 'EventLoop.Input.Keyboard', 'EventLoop.Input.Mouse' and 'EventLoop.Input.SystemMessage' are modeled.
+-}
 module EventLoop.Input.InputEvent where
 
 import EventLoop.Config
@@ -6,10 +18,16 @@ import EventLoop.Input.Mouse
 import EventLoop.Input.SystemMessage
 
-data InputEvent = InMouse Mouse       
-                | InKeyboard Keyboard
-                | InSysMessage SystemMessageIn
+{-|
+ The central 'InputEvent' type.
+-}
+data InputEvent = InMouse Mouse                -- ^ A 'EventLoop.Input.Mouse' event.
+                | InKeyboard Keyboard          -- ^ A 'EventLoop.Input.Keyboard' event.
+                | InSysMessage SystemMessageIn -- ^ A 'EventLoop.Input.SystemMessage' event.
              
+{-|
+ Instance to express how a JSON formatted message can be parsed into an 'InputEvent'.
+-}
 instance FromJSON InputEvent where
     fromJsonMessage obj@(JSONObject ms) | keyboardS == type'      = InKeyboard (fromJsonMessage obj)
                                         | mouseS == type'         = InMouse (fromJsonMessage obj)
src/EventLoop/Input/Keyboard.hs view
@@ -1,3 +1,14 @@+{-|
+Module      : EventLoop.Input.Keyboard
+Description : Library of all the possible 'Keyboard' events in the example implementation.
+Copyright   : (c) Sebastiaan la Fleur, 2014
+License     : BSD3
+Maintainer  : sebastiaan.la.fleur@gmail.com
+Stability   : experimental
+Portability : All
+
+This module expresses how the 'Keyboard' IO device is modelled in the example implementation. 
+-}
 module EventLoop.Input.Keyboard(
     Keyboard(..),
     KeyboardButton
@@ -6,14 +17,13 @@ import EventLoop.Json
 import EventLoop.Config
 
--- Possible messages:
--- {"type": "keyboard", "button": "<kkey>"}
--- <kkey> = a | b | c .. | z | shift | caps ..
-
--- Keyboard Messages In
+-- | Datatype to express the different 'Keyboard' events.
 data Keyboard = KeyPress KeyboardButton
+
+-- | Type to express how a 'KeyboardButton' is modelled.
 type KeyboardButton = [Char]
 
+-- | Instance to express how a JSON formatted 'String' can be parsed into a 'Keyboard' event.
 instance FromJSON Keyboard where
     fromJsonMessage (JSONObject ms) = KeyPress button
                                     where
src/EventLoop/Input/Mouse.hs view
@@ -1,3 +1,14 @@+{-|
+Module      : EventLoop.Input.Mouse
+Description : Library of all the possible 'Mouse' events in the example implementation.
+Copyright   : (c) Sebastiaan la Fleur, 2014
+License     : BSD3
+Maintainer  : sebastiaan.la.fleur@gmail.com
+Stability   : experimental
+Portability : All
+
+This module expresses how the 'Mouse' IO device is modelled in the example implementation. 
+-}
 module EventLoop.Input.Mouse(
     Mouse(..),
     MouseButton(..)
@@ -7,22 +18,21 @@ import EventLoop.Config
 import EventLoop.CommonTypes
 
-
--- Possible messages:
--- {"type":"mouse","button":"<mkey>","x":<number>,"y":<number>,"element":"<name>"}
--- <mkey> = left | right | middle
--- <name> = (a | b | c | ... | z | A | B | C ...)+
--- <numbers> = (1 | 2 | 3 | ... | 0)+
-
--- Mouse Messages In
-data Mouse = MouseClick MouseButton Pos Element
-           | MouseUp MouseButton Pos Element
-           | MouseDown MouseButton Pos Element
+{-|
+ Datatype to express the different 'Mouse' events. 
+ The 'EventLoop.CommonTypes.Pos' expresses where on the screen the event happened.
+ The 'Element' expresses on which top element on screen the event happened. The 'Element' value is the name of the 'EventLoop.Output.Graphical.GObject'.
+-}
+data Mouse = MouseClick MouseButton Pos Element -- ^ Expresses a complete 'MouseClick' consisting of a 'MouseUp' and a 'MouseDown'.
+           | MouseUp MouseButton Pos Element    -- ^ Expresses when a 'MouseButton' moves upward.
+           | MouseDown MouseButton Pos Element  -- ^ Expresses when a 'MouseButton' is pushed down.
            deriving Show
-           
+
+-- | The 'MouseButton' on the mouse.           
 data MouseButton = MLeft | MRight | MMiddle
                     deriving Show
 
+-- | How to parse a 'Mouse'event from a JSON formatted 'String'. 
 instance FromJSON Mouse where
     fromJsonMessage (JSONObject ms) | mouseType == mouseclickS = MouseClick button pos element
                                     | mouseType == mouseupS    = MouseUp button pos element
@@ -35,7 +45,8 @@                                         JSONString element = retrieveError elementS ms
                                         jsonButton = retrieveError buttonS ms
                                         button = fromJsonMessage jsonButton
-       
+
+-- | How to parse a 'MouseButton' from a JSON formatted 'String'.                                         
 instance FromJSON MouseButton where
     fromJsonMessage (JSONString but) | leftS   == but = MLeft
                                      | middleS == but = MMiddle
src/EventLoop/Input/SystemMessage.hs view
@@ -1,3 +1,14 @@+{-|
+Module      : EventLoop.Input.SystemMessage
+Description : Library of all the possible input 'SystemMessage' events in the example implementation.
+Copyright   : (c) Sebastiaan la Fleur, 2014
+License     : BSD3
+Maintainer  : sebastiaan.la.fleur@gmail.com
+Stability   : experimental
+Portability : All
+
+This module expresses how the incoming 'SystemMessage's are modelled in the example implementation. 
+-}
 module EventLoop.Input.SystemMessage(
     SystemMessageIn(..)
 ) where
@@ -5,11 +16,16 @@ import EventLoop.Json
 import EventLoop.Config
 
--- System Messages In
-data SystemMessageIn = Setup
-                     | Background
-                     | Time
+{-|
+ The different possible 'SystemMessageIn's.
+-}
+data SystemMessageIn = Setup      -- ^ A request for the 'Setup'. This should be generated when the connection to a client is made. The answer should be a 'EventLoop.Output.CanvasSetup' message.
+                     | Background -- ^ A request for the 'Background'. This should be generated when the connection to a client is made. The answer could be the background of the graphical application.
+                     | Time       -- ^ When a timer has been spawn, each \'tick\' a 'Time' is generated by the client to let the server know it is time.
                      
+{-|
+ Instance to express how to parse a 'SystemMessageIn' from a JSON formatted 'String'.
+-}
 instance FromJSON SystemMessageIn where
     fromJsonMessage (JSONObject ms) | message == setupS      = Setup
                                     | message == backgroundS = Background
src/EventLoop/Json.hs view
@@ -1,30 +1,48 @@+{-|
+Module      : EventLoop.Json
+Description : JSON library to parse and show JSON messages.
+Copyright   : (c) Sebastiaan la Fleur, 2014
+License     : BSD3
+Maintainer  : sebastiaan.la.fleur@gmail.com
+Stability   : experimental
+Portability : All
+
+This JSON library can parse JSON formatted 'String's into 'JSONMessage's. 
+-}
 module EventLoop.Json(JSONMember(..), JSONMessage(..), retrieve, retrieveError, FromJSON(..), JSONAble(..), stringToJsonObject)  where
 
 import Data.Char (isDigit, isLower, isUpper)
 import FPPrac
 
+-- | A row within a 'JSONObject' consisting of a field name ('[Char]'/'String') and field content ('JSONMessage').
 data JSONMember = JSONMember [Char] JSONMessage
 
-data JSONMessage = JSONFloat Float
-                | JSONString [Char]
-                | JSONBool Bool
-                | JSONObject [JSONMember]
-                | JSONArray [JSONMessage]
+-- | A 'JSONMessage'.
+data JSONMessage = JSONFloat Float        -- ^ A 'JSONFloat'
+                | JSONString [Char]       -- ^ A 'JSONString'
+                | JSONBool Bool           -- ^ A 'JSONBool'
+                | JSONObject [JSONMember] -- ^ A 'JSONObject'. Consists of 'JSONMembers' which express the rows within the object.
+                | JSONArray [JSONMessage] -- ^ A 'JSONArray'. Consists of 'JSONMessage's which expresses the different elements in the array.
                 
-
+-- | Retrieves the field content ('JSONMessage') associated with the field name ('[Char]') from a list of 'JSONMember's.
 retrieve :: [Char] -> [JSONMember] -> Maybe JSONMessage
 retrieve search [] = Nothing
 retrieve search ((JSONMember name member):list) | search == name = Just member
                                                | otherwise = retrieve search list                
-                
+            
+-- | Same as 'retrieve' but instead of returning a 'Maybe', it raises an error when the field name could not be found.
+--   Usable in situations where you know for sure the field name is in the list of 'JSONMember's.            
 retrieveError :: [Char] -> [JSONMember] -> JSONMessage
 retrieveError search members = case (retrieve search members) of
                                 Nothing -> error ("Could not find " ++ search ++ " in JSON members")
                                 Just result -> result
 
+-- | Class expressing that type a is parsable from a 'JSONMessage'.
 class FromJSON a where
+    -- | Function to call to parse a 'JSONMessage' to type a.
     fromJsonMessage :: JSONMessage -> a
     
+-- | Instance expressing how to 'Show' a 'JSONMessage'    
 instance Show JSONMessage where    
     show (JSONFloat f)       = show f
     show (JSONString s)      = "\"" ++ escapeStringJson s ++ "\""
@@ -38,12 +56,15 @@                                     where
                                         list = foldl insertComma (show x) (map show xs)
 
+-- | Private support function
 insertComma :: [Char] -> [Char] -> [Char]
 insertComma a b = a ++ "," ++ b                
 
+-- | Instance expressing how to 'Show' a 'JSONMember'.
 instance Show JSONMember where
     show (JSONMember name m) = "\"" ++ name ++ "\": " ++ (show m)
 
+-- | Function expressing which characters need to be escaped in a JSON formatted 'String'.
 escapeStringJson :: [Char] -> [Char]
 escapeStringJson [] = ""
 escapeStringJson (c:cs) | c == '"' || c == '\\' = '\\':c:rest
@@ -51,10 +72,14 @@                         where
                             rest = escapeStringJson cs
 
-
+-- | Class expressing that type a can be parsed into a 'JSONMessage'.
 class JSONAble a where
     toJsonMessage :: a -> JSONMessage
   
+-- | Function to parse a 'JSONMessage' from a 'String'.
+stringToJsonObject :: [Char] -> JSONMessage
+stringToJsonObject string = snd $ parse O string (JSONObject []) 
+  
 -- JSON Grammar for 1 object
 -- Grammar returns (Rest, JSONObject [JSONRow])
 -- O: '{' R+ '}'
@@ -63,15 +88,16 @@ -- N: ('1' | '2' | '3' | ... | '0')+
 -- W: ('a' | 'b' | 'c' | ... | 'z') (N | W | -)
 
+-- | Private
 data Grammer = O | R
+-- | Private
 type Rest = [Char]
 
-stringToJsonObject :: [Char] -> JSONMessage
-stringToJsonObject string = snd $ parse O string (JSONObject [])
-
+-- | Private
 errorMsg :: [Char] -> [Char] -> [Char]
 errorMsg exp act = "Fault at parsing, expected '" ++ exp ++ "' but found '" ++ act ++ "'"
 
+-- | Private
 parse :: Grammer -> Rest -> JSONMessage -> (Rest, JSONMessage)
 parse O [] _ = error (errorMsg "something" "premature end (start of message)")
 parse O (c1:cs) (JSONObject rows)     | c1 == '{' = result
@@ -95,7 +121,8 @@                                                 | otherwise = error (errorMsg "',' or '}'" [r''])                                    
 
 -- Possibilities:
--- "\"string123value\"" -> JSONString "string123value" or "12345" -> JSONInt 12345                                    
+-- "\"string123value\"" -> JSONString "string123value" or "12345" -> JSONInt 12345 
+-- | Private                                   
 parseVariable :: Rest -> (Rest, JSONMessage)                                        
 parseVariable [] = error (errorMsg "something" "premature end")
 parseVariable [c1] = error (errorMsg "longer variable" (c1:" and premature end"))                
@@ -106,6 +133,7 @@                                 (r1, word)   = parseWord (cs)
                                 (r2, number) = parseNumber (c1:cs)
 
+-- | Private
 parseWord :: Rest -> (Rest, [Char])
 parseWord [] = error (errorMsg "something" "premature end")
 parseWord (c1:cs)   | c1 == '"' = (cs, [])
@@ -113,6 +141,7 @@                     where
                         (r1, result') = parseWord cs
 
+-- | Private
 parseNumber :: Rest -> (Rest, [Char])                         
 parseNumber [] = error (errorMsg "something" "premature end")                         
 parseNumber (c1:cs) | isDigit c1 || c1 == '.' = (r1, c1:result')
src/EventLoop/Main.hs view
@@ -1,3 +1,15 @@+{-|
+Module      : EventLoop.Main
+Description : High-level starting point for the eventloop. Uses the example implementation.
+Copyright   : (c) Sebastiaan la Fleur, 2014
+License     : BSD3
+Maintainer  : sebastiaan.la.fleur@gmail.com
+Stability   : experimental
+Portability : All
+
+High-level starting point for the eventloop. Uses the example implementation of 'EventLoop.Input.InputEvent' and 'EventLoop.Output.OutputEvent'
+to model the keyboard, mouse and webbrowser. Assumes that the server connects to webbrowser which sends information in a JSON formatted String('EventLoop.EventProcessor.IOMessage').
+-}
 module EventLoop.Main(start) where
 
 import EventLoop.EventProcessor
@@ -5,12 +17,16 @@ import EventLoop.Output.OutputEvent
 import EventLoop.Json
          
-start :: (a -> InputEvent -> ([OutputEvent], a)) -> a -> IO()
+-- | High-level function to start an eventloop. The eventloop takes an 'EventLoop.Input.InputEvent' and outputs an 'EventLoop.Output.OutputEvent'.
+--   Starting place for the example implementation of the eventloop. It takes a variable of type a to hold information in between handler calls.
+start :: (a -> InputEvent -> ([OutputEvent], a)) -- ^ Eventhandler from 'EventLoop.Input.InputEvent' to a list of 'EventLoop.Output.OutputEvent'. Also takes a variable of type a that holds the current state of information. Returns a changed variable of type a that will be called with next handler call.
+      -> a                                       -- ^ The begin state of variable a.
+      -> IO()
 start handler beginstate = eventloop handler' beginstate
                         where
                             handler' = changeTypes handler
 
-
+-- | Low-level eventloop to High-Level eventloop converter. Changes 'IOMessage's to 'InputEvent's and 'OutputEvent's.
 changeTypes :: (a -> InputEvent -> ([OutputEvent], a)) -> a -> IOMessage -> ([IOMessage], a)
 changeTypes f state message = (map toJsonMessage oEvents, state')
                     where
src/EventLoop/Output/Graphical/Graphical.hs view
@@ -1,3 +1,17 @@+{-|
+Module      : EventLoop.Output.Graphical.Graphical
+Description : Library of all the possible output 'Graphical' events in the example implementation.
+Copyright   : (c) Sebastiaan la Fleur, 2014
+License     : BSD3
+Maintainer  : sebastiaan.la.fleur@gmail.com
+Stability   : experimental
+Portability : All
+
+This module expresses how the outgoing 'Graphical' events are modelled in the example implementation.
+Possible graphical events are 'Draw', 'MoveGroup', 'MoveElement', 'RemoveGroup' and 'RemoveElement'.
+Respectively drawing a graphical object, moving an entire group, moving a single element, removing an entire group and removing a single element.
+An element is a graphical object expressed through the name.
+-}
 module EventLoop.Output.Graphical.Graphical(
         Graphical(..),
         GObject(..),
@@ -14,20 +28,31 @@ import EventLoop.CommonTypes
 import FPPrac
 
--- Options
+-- | The name of a graphical object. Another synonym in the package used for this is 'EventLoop.CommonTypes.Element'.
 type Name = [Char]
+
+-- | The groupname of a set of graphical objects.
 type Groupname = [Char]
+
+-- | The color expressed in (red, green, blue) code where each value is between 0 <= 255.
 type Color = (Float, Float, Float) -- (r, g, b)
+
+-- | The font associated with a 'Text' primitive.
 type Font = [Char]
+
+-- | A boolean expressing if an event should be carried out relative to the old situation or to the absolute situation
+--   Example of this is when moving an element. Should the move be relative to the old 'EventLoop.CommonTypes.Pos' or to the
+--   absolute 'EventLoop.CommonTypes.Pos' on the screen.
 type Relative = Bool -- Move relative to old spot or not
 
--- Graphical Responses Out
-data Graphical = Draw GObject Groupname
-                | MoveGroup Groupname Pos Relative
-                | MoveElement Name Pos Relative
-                | RemoveGroup Groupname
-                | RemoveElement Name        
-                
+-- | Graphical Responses Out
+data Graphical = Draw GObject Groupname            -- ^ Draw the graphical object with the given groupname.
+                | MoveGroup Groupname Pos Relative -- ^ Move an entire group to a new position possibly relative to the old position.
+                | MoveElement Name Pos Relative    -- ^ Move a single element to a new position possibly relative to the old position.
+                | RemoveGroup Groupname            -- ^ Remove a group
+                | RemoveElement Name               -- ^ Remove an element.
+
+-- | Instance to express how a 'Graphical' event can be parsed to a JSON formatted 'String'.                
 instance JSONAble Graphical where
     toJsonMessage (Draw gObject gName)              = JSONObject [(JSONMember modeS      (JSONString drawS)),
                                                                (JSONMember gobjectS   (toJsonMessage gObject)),     
@@ -51,15 +76,16 @@                 
 
 
--- Graphical Object Wrapper
-data GObject = GObject    { name :: Name
-                        , prim :: Primitive
-                        , children :: [GObject]
-                        }
-             | Container { children :: [GObject]
-                         }
+-- | A general graphical object containing the common attributes of each 'Primitive'.
+data GObject = GObject  { name :: Name           -- ^ Name of the graphical object/element
+                        , prim :: Primitive      -- ^ The graphical primitive that should be drawn
+                        , children :: [GObject]  -- ^ Children of the graphical primitive. Can be used to create composited graphical components containing multiple 'GObject's.
+                        } -- ^ Graphical Object
+             | Container { children :: [GObject] -- ^ A set of 'GObject's. Can be used to create composited graphical components containing multiple 'GObject's with no real top 'GObject'.
+                         } -- ^ A container for Graphical Objects
                         deriving (Show)
 
+-- | Instance to express how a 'GObject' can be parsed to a JSON formatted 'String'. 
 instance JSONAble GObject where
     toJsonMessage (GObject name prim children) = JSONObject [(JSONMember typeS     (JSONString gobjectS)), 
                                                              (JSONMember primS     (toJsonMessage prim)), 
@@ -68,37 +94,38 @@                                                              
     toJsonMessage (Container children)         = JSONObject [(JSONMember childrenS (JSONArray (map toJsonMessage children)))]
                         
--- Primitive graphical structures                        
-data Primitive = Text    { edgeColor :: Color
-                        , edgeThickness :: Float
-                        , color :: Color
-                        , position :: Pos
-                        , size :: Float
-                        , font :: Font
-                        , text :: [Char]
-                        , fromCenter :: Bool
-                        }
-                | Line     { edgeColor :: Color
-                        , edgeThickness :: Float
-                        , positions :: [Pos]
-                        }
-                | Rect    { edgeColor :: Color
-                        , edgeThickness :: Float
-                        , color :: Color
-                        , position :: Pos -- Topleft corner
-                        , dimensions :: Dimension
-                        }
-                | Arc     { edgeColor :: Color
-                        , edgeThickness :: Float
-                        , color :: Color
-                        , position :: Pos
-                        , radius :: Float
-                        , startAng :: Float -- In degrees
-                        , endAng :: Float -- In degrees
-                        }
+-- | Primitive graphical structures                        
+data Primitive = Text   { -- | 'EventLoop.CommonTypes.Color' of the edges of the text
+                          edgeColor :: Color     
+                        , edgeThickness :: Float -- ^ The edge thickness of the text (Should be 1 most of the time)
+                        , color :: Color         -- ^ The 'EventLoop.CommonTypes.Color' of the fill of the text
+                        , position :: Pos        -- ^ The position on the screen of the text
+                        , size :: Float          -- ^ The height of the text in pixels
+                        , font :: Font           -- ^ Which font to be used
+                        , text :: [Char]         -- ^ The actual text to be displayed
+                        , fromCenter :: Bool     -- ^ Is the position the topleft corner of the text or the center of the text
+                        } -- ^ The text graphical primitive
+                | Line  { edgeColor :: Color     -- ^ 'EventLoop.CommonTypes.Color' of the line
+                        , edgeThickness :: Float -- ^ The thickness of the line
+                        , positions :: [Pos]     -- ^ The list of positions the line should go through. A line will be drawn from point 1 to point 2 to point...
+                        } -- ^ The line graphical primitive
+                | Rect  { edgeColor :: Color      -- ^ 'EventLoop.CommonTypes.Color' of the edges of the rectangle
+                        , edgeThickness :: Float  -- ^ The edge thickness of the rectangle
+                        , color :: Color          -- ^ The 'EventLoop.CommonTypes.Color' of the fill of the rectangle
+                        , position :: Pos         -- ^ The topleft corner of the rectangle on the screen
+                        , dimensions :: Dimension -- ^ The dimensions of the rectangle
+                        } -- ^ The rectangle graphical primitive
+                | Arc   { edgeColor :: Color      -- ^ 'EventLoop.CommonTypes.Color' of the edges of the arc
+                        , edgeThickness :: Float  -- ^ The edge thickness of the arc
+                        , color :: Color          -- ^ The 'EventLoop.CommonTypes.Color' of the fill of the arc
+                        , position :: Pos         -- ^ The position of the center of the arc
+                        , radius :: Float         -- ^ The radius of the arc
+                        , startAng :: Float       -- ^ The starting angle of the arc in degrees.
+                        , endAng :: Float         -- ^ The ending angle of the arc in degrees.
+                        } -- ^ The arc graphical primitive. This is the part of a circle. When startAng=0 and endAng=360 you get a full circle.
                     deriving (Show, Eq)
 
-
+-- | Instance to express how a 'Primtive' can be parsed to a JSON formatted 'String'.
 instance JSONAble Primitive where
     toJsonMessage (Text ec et color position size font text fromcenter) = JSONObject [(JSONMember typeS           (JSONString textS)), 
                                                                                       (JSONMember edgecolorS      (colorToJsonMessage ec)), 
@@ -131,16 +158,18 @@                                                                                   (JSONMember startangS      (JSONFloat startAng)), 
                                                                                   (JSONMember endangS        (JSONFloat endAng))]
 
--- Support Functions                                                                                
+-- | Private                                                                                
 colorToJsonMessage :: Color -> JSONMessage
 colorToJsonMessage (r, g, b) = JSONObject [(JSONMember rS (JSONFloat r)), 
                                            (JSONMember gS (JSONFloat g)), 
                                            (JSONMember bS (JSONFloat b))]
 
+-- | Private
 positionToJsonMessage :: Pos -> JSONMessage
 positionToJsonMessage (x, y) = JSONObject [(JSONMember xS (JSONFloat x)), 
                                            (JSONMember yS (JSONFloat y))] 
 
+-- | Private
 dimensionToJsonMessage :: Dimension -> JSONMessage                                           
 dimensionToJsonMessage (w, h) = JSONObject [(JSONMember heightS (JSONFloat h)), 
                                             (JSONMember widthS  (JSONFloat w))]
src/EventLoop/Output/OutputEvent.hs view
@@ -1,3 +1,15 @@+{-|
+Module      : EventLoop.Output.OutputEvent
+Description : Library of all the possible 'OutputEvent's in the example implementation.
+Copyright   : (c) Sebastiaan la Fleur, 2014
+License     : BSD3
+Maintainer  : sebastiaan.la.fleur@gmail.com
+Stability   : experimental
+Portability : All
+
+All different 'OutputEvent's are combined to a single 'OutputEvent' type. 
+In this example implementation, the 'EventLoop.Output.Graphical.Graphical' and 'EventLoop.Output.SystemMessage.SystemMessageOut' are modeled.
+-}
 module EventLoop.Output.OutputEvent where
 
 import EventLoop.Output.Graphical.Graphical
@@ -5,10 +17,15 @@ import EventLoop.Config
 import EventLoop.Json
 
+{-|
+ The central 'OutputEvent' type.
+-}
 data OutputEvent = OutGraphical Graphical
                  | OutSysMessage [SystemMessageOut]
                 
-                
+{-|
+ Instance to express how an 'OutputEvent' can be parsed into a JSON formatted message.
+-}                
 instance JSONAble OutputEvent where
     toJsonMessage (OutGraphical graph)   = JSONObject [(JSONMember modeS (JSONString graphicalS)), (JSONMember commandS (toJsonMessage graph))]
     toJsonMessage (OutSysMessage ms)  = JSONObject [(JSONMember modeS (JSONString sysmessageanswersS)), (JSONMember answersS (JSONArray (map toJsonMessage ms)))]
src/EventLoop/Output/Single.hs view
@@ -1,3 +1,14 @@+{-|
+Module      : EventLoop.Output.Single
+Description : Makeshift server to output a single 'EventLoop.Output.OutputEvent' to the client.
+Copyright   : (c) Sebastiaan la Fleur, 2014
+License     : BSD3
+Maintainer  : sebastiaan.la.fleur@gmail.com
+Stability   : experimental
+Portability : All
+
+Makeshift server to output a single 'EventLoop.Output.OutputEvent' to the client. The function 'outSingle' is the heart of this module.
+-}
 module EventLoop.Output.Single (outSingle) where
 
 import qualified Network.Socket     as S
@@ -13,6 +24,10 @@ import EventLoop.Json
 import EventLoop.CommonTypes
 
+{-|
+ Outputs a single 'EventLoop.Output.OutputEvent'. Right now only 'EventLoop.Output.Draw' events are implemented.
+ The server automatically determines the maximum 'EventLoop.CommonTypes.Dimension's of the picture and sends a 'EventLoop.Output.Setup' containing those 'EventLoop.CommonTypes.Dimension's.
+-}
 outSingle :: OutputEvent -> IO ()
 outSingle out = S.withSocketsDo $ do
                                     sock <- WS.makeSocket ipadres (fromIntegral port)
@@ -31,25 +46,30 @@                     setup = toIOMessage (setupMessage out)
                     out' = toIOMessage out 
                     closeMsg = toIOMessage closeMessage
- 
+
+-- | Private                    
 catched :: S.Socket -> WS.Connection -> SomeException -> IO ()
 catched sock conn e = do
                         WS.sendClose conn (T.pack "")
                         WS.closeSocket sock
                         throw e
- 
+
+-- | Private  
 setupMessage :: OutputEvent -> OutputEvent
 setupMessage (OutGraphical (Draw g _)) = OutSysMessage [CanvasSetup dim]
                                     where
                                         dim = maxDimensions g
 setupMessage _ = OutSysMessage [CanvasSetup (512, 512)]                                        
 
+-- | Private 
 closeMessage :: OutputEvent
 closeMessage = OutSysMessage [Close]
-    
+
+-- | Private     
 toIOMessage :: OutputEvent -> IOMessage
 toIOMessage = toJsonMessage
 
+-- | Private 
 sendResponse :: WS.Connection -> IOMessage -> IO ()
 sendResponse conn response = do
                                 let
@@ -57,7 +77,7 @@                                     text = T.pack string
                                 WS.sendTextData conn text 
 
-
+-- | Private 
 maxDimensions :: GObject -> Dimension
 maxDimensions (GObject _ prim [])     = maxDimensionsPrim prim
 maxDimensions (GObject n prim (c:cs)) = (max w w', max h h')
@@ -70,6 +90,7 @@                                             (w, h) = maxDimensions c
                                             (w', h') = maxDimensions (Container cs)
 
+-- | Private 
 maxDimensionsPrim :: Primitive -> Dimension
 maxDimensionsPrim (Text _ _ _ (x, y) size _ str fromCenter) | fromCenter = (x + (fromIntegral $ length str * 10) / 2, y + size / 2)
                                                             | otherwise  = (x + (fromIntegral $ length str * 10), y + size)
src/EventLoop/Output/SystemMessage.hs view
@@ -1,19 +1,35 @@+{-|
+Module      : EventLoop.Output.SystemMessage
+Description : Library of all the possible output 'SystemMessage' events in the example implementation.
+Copyright   : (c) Sebastiaan la Fleur, 2014
+License     : BSD3
+Maintainer  : sebastiaan.la.fleur@gmail.com
+Stability   : experimental
+Portability : All
+
+This module expresses how the outgoing 'SystemMessage's are modelled in the example implementation. 
+-}
 module EventLoop.Output.SystemMessage(SystemMessageOut(..)) where
 
 import EventLoop.Json
 import EventLoop.Config
 import EventLoop.CommonTypes
 
--- System Messages Out
-data SystemMessageOut = CanvasSetup Dimension
-                      | Timer Bool
-                      | Close
-                               
+{-|
+ The different possible 'SystemMessageOut's.
+-}
+data SystemMessageOut = CanvasSetup Dimension -- ^ Answer to the 'EventLoop.Input.SystemMessage.Setup' containing the dimensions of the canvas that will be used.
+                      | Timer Bool            -- ^ Request to create a timer at the clientside that will generate a 'EventLoop.Input.SystemMessage.Time' message each \'tick\'.
+                      | Close                 -- ^ A request for the client to completely close the connection to the server.
+
+{-|
+ Instance to express how to parse a 'SystemMessageIn' from a JSON formatted 'String'.
+-}                      
 instance JSONAble SystemMessageOut where
     toJsonMessage (CanvasSetup dim) = JSONObject [(JSONMember sysmessageanswerS (JSONString canvassetupS)), (JSONMember dimensionS (dimensionToJsonMessage dim))]
     toJsonMessage (Timer bool)      = JSONObject [(JSONMember sysmessageanswerS (JSONString timerS)), (JSONMember useS (JSONBool bool))]
     toJsonMessage (Close)           = JSONObject [(JSONMember sysmessageanswerS (JSONString closeS))]
     
--- Support Function
+-- | Private
 dimensionToJsonMessage :: Dimension -> JSONMessage
 dimensionToJsonMessage (w, h) = JSONObject [(JSONMember hS (JSONFloat h)), (JSONMember wS (JSONFloat w))]
− src/FPPrac/Graphics/MakePrimitives.hs
@@ -1,59 +0,0 @@-module FPPrac.Graphics.MakePrimitives where
-
-import EventLoop.Output
-import EventLoop.CommonTypes
-import FPPrac.Graphics.NormalizeNumber
-
-type NormalizedNum = Float
-type TextSize = NormalizedNum
-type Radius = NormalizedNum
-type Angle  = NormalizedNum
-
-createDrawCommand :: GObject -> String -> Graphical
-createDrawCommand g groupname = Draw g groupname
-
-createMoveGroupCommand :: String -> Pos -> Relative -> Graphical
-createMoveGroupCommand groupname pos rel = MoveGroup groupname pos rel
-
-createMoveElementCommand :: String -> Pos -> Relative -> Graphical
-createMoveElementCommand name pos rel = MoveElement name pos rel
-
-createRemoveGroupCommand :: String -> Graphical
-createRemoveGroupCommand groupname = RemoveGroup groupname
-
-createRemoveElementCommand :: String -> Graphical
-createRemoveElementCommand name = RemoveElement name
-
-
-createGraphicalObject :: String -> Primitive -> [GObject] -> GObject
-createGraphicalObject name prim children = GObject name prim children
-
-createGraphicalContainer :: [GObject] -> GObject
-createGraphicalContainer contents = Container contents
-
-
-createTextPrimitive :: Color -> Pos -> TextSize -> Font -> String -> Bool -> Primitive
-createTextPrimitive col pos size font str fromCenter = Text (0,0,0) 1 col pos size font str fromCenter
-
-createLinePrimitive :: Color -> [Pos] -> Primitive
-createLinePrimitive col positions = Line col 1 positions
-
-createRectPrimitive :: Color -> Pos -> Dimension -> Primitive
-createRectPrimitive col pos dim = Rect (0,0,0) 0 col pos dim
-
-createArcPrimitive :: Color -> Pos -> Radius -> Angle -> Angle -> Primitive
-createArcPrimitive col pos rad startAngle endAngle = Arc (0,0,0) 0 col pos rad startAngle endAngle
-
--- (x,y)
-createPosition :: (NormalizeNumber x, NormalizeNumber y) => x -> y -> (NormalizedNum ,NormalizedNum)
-createPosition x y = (normalize x, normalize y)
-
--- (w,h)
-createDimension :: (NormalizeNumber w, NormalizeNumber h) => w -> h -> (NormalizedNum, NormalizedNum)
-createDimension w h = (normalize w, normalize h)
-
-createColor :: (NormalizeNumber r, NormalizeNumber g, NormalizeNumber b) => r -> g -> b -> (NormalizedNum, NormalizedNum, NormalizedNum)
-createColor r g b = (normalize r, normalize g, normalize b)
-
-createNormalizedNum :: (NormalizeNumber i) => i -> NormalizedNum
-createNormalizedNum i = normalize i
src/FPPrac/Graphics/NormalizeNumber.hs view
@@ -1,25 +1,49 @@-module FPPrac.Graphics.NormalizeNumber where
+{-|
+Module      : FPPrac.Graphics.NormalizeNumber
+Description : Used in the FPPrac module to normalize any instance of a Num type to float.
+              It is used for the "EventLoop" module.
+Copyright   : (c) Sebastiaan la Fleur, 2014
+License     : BSD3
+Maintainer  : sebastiaan.la.fleur@gmail.com
+Stability   : experimental
+Portability : All
 
+In the "EventLoop" module, 'Float's are used to express positions and other characteristics. As that package is also used
+in the functional programming lab at the University of Twente, compatibility with the "FPPrac" module is needed.
+That module expresses a 'Number' type which abstracts from 'Int' and 'Double' types. This module is used to normalize
+both the 'Number' type and the original 'Num' class instances defined in Haskell.
+-}
+module FPPrac.Graphics.NormalizeNumber where
 
 import GHC.Float
 import FPPrac.Prelude.Number
 
+{-|
+ Class to express that the instance 'a' is able to be normalized to a 'Float'.
+-}
 class (Num a) => NormalizeNumber a where
+    -- | The function that can be used to normalize 'a' to a 'Float'.
     normalize :: a -> Float
     
+    {-# MINIMAL normalize #-}
+
+-- | How to normalize a 'Float'
 instance NormalizeNumber Float where
     normalize f = f
     
+-- | How to normalize an 'Int'
 instance NormalizeNumber Int where
     normalize = fromIntegral
     
+-- | How to normalize an 'Integer'
 instance NormalizeNumber Integer where
     normalize = fromIntegral
 
-
+-- | How to normalize a 'Double'
 instance NormalizeNumber Double where    
     normalize = double2Float
 
+-- | How to normalize a 'Number'. This is definied in "FPPrac.Prelude.Number" in the twentefp-number package     
 instance NormalizeNumber Number where
     normalize (I i) = fromIntegral i
     normalize (F d) = double2Float d   
twentefp-eventloop-graphics.cabal view
@@ -1,6 +1,6 @@ name:                twentefp-eventloop-graphics
-version:             0.1.0.2
-synopsis:            An eventloop based graphical IO system. Used as Lab Assignments Environment at Univeriteit Twente
+version:             0.1.0.3
+synopsis:            Used as Lab Assignments Environment at Univeriteit Twente
 description:         An eventloop based graphical IO system. It uses websockets as a way to communicate with IO devices; a browser in this case. This system is used in the Graphical submodule to be able to express graphical output using the eventloop system for a browser. 
 license:             BSD3
 license-file:        LICENSE
@@ -19,7 +19,7 @@     EventLoop.Output.Graphical,
     EventLoop.Output.Single,
     EventLoop.CommonTypes,
-    FPPrac.Graphics.MakePrimitives
+    FPPrac.Graphics.NormalizeNumber
     
   other-modules:
     EventLoop.Main, 
@@ -32,8 +32,7 @@     EventLoop.Input.SystemMessage, 
     EventLoop.Input.Mouse, 
     EventLoop.Input.Keyboard, 
-    EventLoop.Input.InputEvent,
-    FPPrac.Graphics.NormalizeNumber
+    EventLoop.Input.InputEvent
     
   build-depends:
     base                >= 4.6.0.0   && < 5,