module EventLoop.Output.Graphical.Graphical( Graphical(..), GObject(..), Primitive(..), Name, Groupname, Color, Font, Relative ) where import EventLoop.Json import EventLoop.Config import EventLoop.CommonTypes import FPPrac -- Options type Name = [Char] type Groupname = [Char] type Color = (Float, Float, Float) -- (r, g, b) type Font = [Char] 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 instance JSONAble Graphical where toJsonMessage (Draw gObject gName) = JSONObject [(JSONMember modeS (JSONString drawS)), (JSONMember gobjectS (toJsonMessage gObject)), (JSONMember groupnameS (JSONString gName))] toJsonMessage (MoveGroup gName pos rel) = JSONObject [(JSONMember modeS (JSONString movegroupS)), (JSONMember groupnameS (JSONString gName)), (JSONMember positionS (positionToJsonMessage pos)), (JSONMember relativeS (JSONBool rel))] toJsonMessage (MoveElement name pos rel) = JSONObject [(JSONMember modeS (JSONString moveelementS)), (JSONMember nameS (JSONString name)), (JSONMember positionS (positionToJsonMessage pos)), (JSONMember relativeS (JSONBool rel))] toJsonMessage (RemoveGroup gName) = JSONObject [(JSONMember modeS (JSONString removegroupS)), (JSONMember groupnameS (JSONString gName))] toJsonMessage (RemoveElement name) = JSONObject [(JSONMember modeS (JSONString removeelementS)), (JSONMember nameS (JSONString name))] -- Graphical Object Wrapper data GObject = GObject { name :: Name , prim :: Primitive , children :: [GObject] } | Container { children :: [GObject] } deriving (Show) instance JSONAble GObject where toJsonMessage (GObject name prim children) = JSONObject [(JSONMember typeS (JSONString gobjectS)), (JSONMember primS (toJsonMessage prim)), (JSONMember nameS (JSONString name)), (JSONMember childrenS (JSONArray (map toJsonMessage children)))] 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 } deriving (Show, Eq) instance JSONAble Primitive where toJsonMessage (Text ec et color position size font text fromcenter) = JSONObject [(JSONMember typeS (JSONString textS)), (JSONMember edgecolorS (colorToJsonMessage ec)), (JSONMember edgethicknessS (JSONFloat et)), (JSONMember colorS (colorToJsonMessage color)), (JSONMember positionS (positionToJsonMessage position)), (JSONMember sizeS (JSONFloat size)), (JSONMember fontS (JSONString font)), (JSONMember textS (JSONString text)), (JSONMember fromcenterS (JSONBool fromcenter))] toJsonMessage (Line ec et positions) = JSONObject [(JSONMember typeS (JSONString lineS)), (JSONMember edgecolorS (colorToJsonMessage ec)), (JSONMember edgethicknessS (JSONFloat et)), (JSONMember positionsS (JSONArray (map positionToJsonMessage positions)))] toJsonMessage (Rect ec et color position dim) = JSONObject [(JSONMember typeS (JSONString rectS)), (JSONMember edgecolorS (colorToJsonMessage ec)), (JSONMember edgethicknessS (JSONFloat et)), (JSONMember colorS (colorToJsonMessage color)), (JSONMember positionS (positionToJsonMessage position)), (JSONMember dimensionS (dimensionToJsonMessage dim))] toJsonMessage (Arc ec et color position radius startAng endAng) = JSONObject [(JSONMember typeS (JSONString arcS)), (JSONMember edgecolorS (colorToJsonMessage ec)), (JSONMember edgethicknessS (JSONFloat et)), (JSONMember colorS (colorToJsonMessage color)), (JSONMember positionS (positionToJsonMessage position)), (JSONMember radiusS (JSONFloat radius)), (JSONMember startangS (JSONFloat startAng)), (JSONMember endangS (JSONFloat endAng))] -- Support Functions colorToJsonMessage :: Color -> JSONMessage colorToJsonMessage (r, g, b) = JSONObject [(JSONMember rS (JSONFloat r)), (JSONMember gS (JSONFloat g)), (JSONMember bS (JSONFloat b))] positionToJsonMessage :: Pos -> JSONMessage positionToJsonMessage (x, y) = JSONObject [(JSONMember xS (JSONFloat x)), (JSONMember yS (JSONFloat y))] dimensionToJsonMessage :: Dimension -> JSONMessage dimensionToJsonMessage (w, h) = JSONObject [(JSONMember heightS (JSONFloat h)), (JSONMember widthS (JSONFloat w))]