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
type Name = [Char]
type Groupname = [Char]
type Color = (Float, Float, Float)
type Font = [Char]
type Relative = Bool
data Graphical = Draw GObject Groupname
| MoveGroup Groupname Pos Relative
| MoveElement Name Pos Relative
| RemoveGroup Groupname
| RemoveElement Name
| ClearAll
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))]
toJsonMessage (ClearAll) = JSONObject [JSONMember modeS (JSONString clearallS)]
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)))]
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
, dimensions :: Dimension
}
| Arc { edgeColor :: Color
, edgeThickness :: Float
, color :: Color
, position :: Pos
, radius :: Float
, startAng :: Float
, endAng :: Float
}
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))]
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))]