packages feed

Gleam 0.1.0.0 → 0.1.0.1

raw patch · 10 files changed

+754/−2 lines, 10 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

- Color: Aquamarine :: Color
- Color: Azure :: Color
- Color: Black :: Color
- Color: Blue :: Color
- Color: Chartreuse :: Color
- Color: Cyan :: Color
- Color: Green :: Color
- Color: Magenta :: Color
- Color: Orange :: Color
- Color: RGBA :: String -> Color
- Color: Red :: Color
- Color: Rose :: Color
- Color: Transparent :: Color
- Color: Violet :: Color
- Color: White :: Color
- Color: Yellow :: Color
- Color: convertColor :: Color -> String
- Color: data Color
- Color: instance GHC.Classes.Eq Color.Color
- Color: instance GHC.Show.Show Color.Color
- InputEvent: Char :: Char -> Key
- InputEvent: Down :: KeyState
- InputEvent: EventKey :: Key -> KeyState -> Point -> InputEvent
- InputEvent: EventMotion :: Point -> Point -> InputEvent
- InputEvent: KeyAlt :: SpecialKey
- InputEvent: KeyBackspace :: SpecialKey
- InputEvent: KeyCaps :: SpecialKey
- InputEvent: KeyCtrl :: SpecialKey
- InputEvent: KeyDown :: SpecialKey
- InputEvent: KeyEnter :: SpecialKey
- InputEvent: KeyEsc :: SpecialKey
- InputEvent: KeyLeft :: SpecialKey
- InputEvent: KeyRight :: SpecialKey
- InputEvent: KeyShift :: SpecialKey
- InputEvent: KeySpace :: SpecialKey
- InputEvent: KeyTab :: SpecialKey
- InputEvent: KeyUnknown :: SpecialKey
- InputEvent: KeyUp :: SpecialKey
- InputEvent: Mouse :: Key
- InputEvent: SpecialKey :: SpecialKey -> Key
- InputEvent: Up :: KeyState
- InputEvent: data InputEvent
- InputEvent: data Key
- InputEvent: data KeyState
- InputEvent: data SpecialKey
- InputEvent: instance GHC.Classes.Eq InputEvent.InputEvent
- InputEvent: instance GHC.Classes.Eq InputEvent.Key
- InputEvent: instance GHC.Classes.Eq InputEvent.KeyState
- InputEvent: instance GHC.Classes.Eq InputEvent.SpecialKey
- InputEvent: instance GHC.Classes.Ord InputEvent.Key
- InputEvent: instance GHC.Classes.Ord InputEvent.KeyState
- InputEvent: instance GHC.Classes.Ord InputEvent.SpecialKey
- InputEvent: instance GHC.Show.Show InputEvent.InputEvent
- InputEvent: instance GHC.Show.Show InputEvent.Key
- InputEvent: instance GHC.Show.Show InputEvent.KeyState
- InputEvent: instance GHC.Show.Show InputEvent.SpecialKey
- Picture: Arc :: Double -> Double -> Double -> Picture
- Picture: Blank :: Picture
- Picture: Circle :: Double -> Picture
- Picture: File :: String -> Location
- Picture: FillColor :: Color -> Picture -> Picture
- Picture: Image :: Location -> Double -> Double -> Picture
- Picture: Line :: Path -> Picture
- Picture: Pictures :: [Picture] -> Picture
- Picture: Polygon :: Path -> Picture
- Picture: Rectangle :: Double -> Double -> Picture
- Picture: Rotate :: Double -> Picture -> Picture
- Picture: Scale :: Double -> Double -> Picture -> Picture
- Picture: Stroke :: Color -> Double -> Picture -> Picture
- Picture: Text :: String -> Font -> FontSize -> Picture
- Picture: Translate :: Double -> Double -> Picture -> Picture
- Picture: Url :: String -> Location
- Picture: data Location
- Picture: data Picture
- Picture: instance Data.Semigroup.Semigroup Picture.Picture
- Picture: instance GHC.Base.Monoid Picture.Picture
- Picture: instance GHC.Classes.Eq Picture.Location
- Picture: instance GHC.Classes.Eq Picture.Picture
- Picture: instance GHC.Show.Show Picture.Location
- Picture: instance GHC.Show.Show Picture.Picture
- Picture: lineLoop :: Path -> Picture
- Picture: rectanglePath :: Double -> Double -> Path
- Picture: rectangleSolid :: Double -> Double -> Picture
- Picture: rectangleWire :: Double -> Double -> Picture
- Picture: sectorWire :: Double -> Double -> Double -> Picture
- Picture: type Path = [Point]
- Picture: type Point = (Double, Double)
- Picture: type Vector = Point
- Settings: GleamConfig :: Int -> Int -> GleamConfig
- Settings: Simulation :: GleamConfig -> model -> (model -> Picture) -> (model -> model) -> (InputEvent -> model -> model) -> String -> Simulation
- Settings: [height] :: GleamConfig -> Int
- Settings: [simConfig] :: Simulation -> GleamConfig
- Settings: [simDraw] :: Simulation -> (model -> Picture)
- Settings: [simHandler] :: Simulation -> (InputEvent -> model -> model)
- Settings: [simInitialModel] :: Simulation -> model
- Settings: [simTitle] :: Simulation -> String
- Settings: [simUpdate] :: Simulation -> (model -> model)
- Settings: [width] :: GleamConfig -> Int
- Settings: data GleamConfig
- Settings: data Simulation
- Settings: defaultGleamConfig :: GleamConfig
- Text: Arial :: Font
- Text: CourierNew :: Font
- Text: Font :: String -> Font
- Text: SansSerif :: Font
- Text: Serif :: Font
- Text: Size :: Int -> FontSize
- Text: TimesNewRoman :: Font
- Text: Verdana :: Font
- Text: data Font
- Text: data FontSize
- Text: getCombinedFont :: Font -> FontSize -> String
- Text: instance GHC.Classes.Eq Text.Font
- Text: instance GHC.Classes.Eq Text.FontSize
- Text: instance GHC.Show.Show Text.Font
- Text: instance GHC.Show.Show Text.FontSize
+ Gleam: Arc :: Double -> Double -> Double -> Picture
+ Gleam: Blank :: Picture
+ Gleam: Char :: Char -> Key
+ Gleam: Circle :: Double -> Picture
+ Gleam: Color :: Color -> Picture -> Picture
+ Gleam: Down :: KeyState
+ Gleam: EventKey :: Key -> KeyState -> InputEvent
+ Gleam: EventMotion :: Point -> Point -> InputEvent
+ Gleam: File :: String -> Source
+ Gleam: Image :: Source -> Double -> Double -> Picture
+ Gleam: KeyAlt :: SpecialKey
+ Gleam: KeyBackspace :: SpecialKey
+ Gleam: KeyCaps :: SpecialKey
+ Gleam: KeyCtrl :: SpecialKey
+ Gleam: KeyDown :: SpecialKey
+ Gleam: KeyEnter :: SpecialKey
+ Gleam: KeyEsc :: SpecialKey
+ Gleam: KeyLeft :: SpecialKey
+ Gleam: KeyRight :: SpecialKey
+ Gleam: KeyShift :: SpecialKey
+ Gleam: KeySpace :: SpecialKey
+ Gleam: KeyTab :: SpecialKey
+ Gleam: KeyUnknown :: SpecialKey
+ Gleam: KeyUp :: SpecialKey
+ Gleam: Line :: Path -> Picture
+ Gleam: Mouse :: Point -> Key
+ Gleam: Pictures :: [Picture] -> Picture
+ Gleam: Polygon :: Path -> Picture
+ Gleam: Rectangle :: Double -> Double -> Picture
+ Gleam: Scale :: Double -> Double -> Picture -> Picture
+ Gleam: SpecialKey :: SpecialKey -> Key
+ Gleam: Stroke :: Color -> Double -> Picture -> Picture
+ Gleam: Text :: String -> Font -> FontSize -> Picture
+ Gleam: Translate :: Double -> Double -> Picture -> Picture
+ Gleam: Up :: KeyState
+ Gleam: Url :: String -> Source
+ Gleam: convertColor :: Color -> String
+ Gleam: data InputEvent
+ Gleam: data Key
+ Gleam: data KeyState
+ Gleam: data Picture
+ Gleam: data Source
+ Gleam: data SpecialKey
+ Gleam: defaultGleamConfig :: GleamConfig
+ Gleam: lineLoop :: Path -> Picture
+ Gleam: rectanglePath :: Double -> Double -> Path
+ Gleam: rectangleSolid :: Double -> Double -> Picture
+ Gleam: rectangleWire :: Double -> Double -> Picture
+ Gleam: sectorWire :: Double -> Double -> Double -> Picture
+ Gleam: type Path = [Point]
+ Gleam: type Point = (Double, Double)
+ Gleam: type Vector = Point

Files

Gleam.cabal view
@@ -1,5 +1,5 @@ name:                Gleam-version:             0.1.0.0+version:             0.1.0.1 cabal-version:       >=1.10 license:             BSD3 license-file:        LICENSE@@ -21,8 +21,18 @@ library   exposed-modules:    Gleam +  other-modules:      Animate,+                      Color,+                      Handler,+                      InputEvent,+                      Picture,+                      Render,+                      Settings,+                      Text,+                      Utility+   -- Other library packages from which modules are imported.-  build-depends:       base             >=4.9 && <4.10+  build-depends:       base             >=4.9 && <= 5                        ,mtl             >= 2.2.2 && < 2.3                        ,split           >= 0.2.3 && < 0.3                        ,threepenny-gui  >= 0.8.3 && < 0.9
+ src/Animate.hs view
@@ -0,0 +1,53 @@+{-# OPTIONS_HADDOCK hide #-}++module Animate+  ( animateMultiple+  , animate+  )+where++import           Picture+import qualified Graphics.UI.Threepenny        as UI+import           Graphics.UI.Threepenny.Core+import           Graphics.UI.Threepenny.Timer+import           Data.IORef+import           Render++-- | Animates the simulation for multiple canvases.+animateMultiple+  :: IORef model          -- ^ Current state of the simulation.+  -> IORef Bool           -- ^ Whether the current simulation is paused.+  -> (model -> model)     -- ^ Function to update the state of the simulation.+  -> (model -> Picture)   -- ^ Function to generate a picture from a model.+  -> UI.Element           -- ^ The canvas element.+  -> UI Timer+animateMultiple currentState currentPause update draw canvas = do+  t <- timer+  on (\canvas -> (tick t)) canvas $ \_ -> do+    pause <- liftIO $ readIORef currentPause+    case (pause) of+      False -> do+        current <- liftIO $ readIORef currentState+        let updatedState = update current+        liftIO $ writeIORef currentState updatedState+        renderPicture (draw updatedState) canvas+      True -> do+        current <- liftIO $ readIORef currentState+        renderPicture (draw current) canvas+  return t # set interval 16 # set running True++-- | Animates the simulation for a single canvas.+animate+  :: IORef model        -- ^ Current state of the simulation.+  -> (model -> model)   -- ^ Function to update the state of the simulation.+  -> (model -> Picture) -- ^ Function to generate a picture from a model.+  -> UI.Element         -- ^ The canvas element.+  -> UI Timer+animate currentState update draw canvas = do+  t <- timer+  on (\canvas -> (tick t)) canvas $ \_ -> do+    current <- liftIO $ readIORef currentState+    let updatedState = update current+    liftIO $ writeIORef currentState updatedState+    renderPicture (draw updatedState) canvas+  return t # set interval 16 # set running True
+ src/Color.hs view
@@ -0,0 +1,45 @@+module Color+  ( Color(..)+  , convertColor+  )+where++data Color+        = White+        | Black+        | Transparent+        | Red+        | Green+        | Blue+        | Yellow+        | Cyan+        | Magenta+        | Rose+        | Violet+        | Azure+        | Aquamarine+        | Chartreuse+        | Orange+        -- | A hex color string.+        | RGBA String+        deriving (Show, Eq)+++-- | Converts a color to a html color string.+convertColor :: Color -> String+convertColor color = case (color) of+  White         -> "white"+  Black         -> "black"+  Transparent   -> "#00000000"+  Red           -> "red"+  Green         -> "green"+  Blue          -> "blue"+  Yellow        -> "yellow"+  Cyan          -> "cyan"+  Magenta       -> "magenta"+  Rose          -> "rose"+  Violet        -> "violet"+  Azure         -> "azure"+  Chartreuse    -> "chartreuse"+  Orange        -> "orange"+  (RGBA string) -> string
+ src/Handler.hs view
@@ -0,0 +1,177 @@+{-# OPTIONS_HADDOCK hide #-}++module Handler+  ( handleEventsMultiple+  , handleEvents+  )+where++import qualified Graphics.UI.Threepenny        as UI+import           Graphics.UI.Threepenny.Core+import           Data.Char+import           Data.IORef+import           InputEvent+import           Picture+import           Settings++-- | Handles events for multiple canvases.+handleEventsMultiple+  :: GleamConfig                    -- ^ Canvas size.+  -> IORef model                    -- ^ Current state of the simulation.+  -> IORef (Double, Double)         -- ^ Current mouse position.+  -> IORef Bool                     -- ^ Whether the current simulation is paused.+  -> (InputEvent -> model -> model) -- ^ Function to handle input events.+  -> UI.Element                     -- ^ The canvas element.+  -> UI ()+handleEventsMultiple gleamconfig currentState currentMousePos currentPause handler canvas+  = do+    on UI.keydown canvas $ \c -> do+      pause <- liftIO $ readIORef currentPause+      case (pause) of+        False -> do+          current <- liftIO $ readIORef currentState+          let updatedState = handler (convertKeyCode c Down) current+          liftIO $ writeIORef currentState updatedState+        True -> return ()++    on UI.keyup canvas $ \c -> do+      pause <- liftIO $ readIORef currentPause+      case (pause) of+        False -> do+          current <- liftIO $ readIORef currentState+          let updatedState = handler (convertKeyCode c Up) current+          liftIO $ writeIORef currentState updatedState+        True -> return ()++    on UI.mouseup canvas $ \pos -> do+      pause <- liftIO $ readIORef currentPause+      case (pause) of+        False -> do+          current <- liftIO $ readIORef currentState+          let updatedState = handler+                (convertMouse (convertMousePos gleamconfig pos) Up)+                current+          liftIO $ writeIORef currentState updatedState+        True -> return ()++    on UI.mousedown canvas $ \pos -> do+      pause <- liftIO $ readIORef currentPause+      case (pause) of+        False -> do+          current <- liftIO $ readIORef currentState+          let updatedState = handler+                (convertMouse (convertMousePos gleamconfig pos) Down)+                current+          liftIO $ writeIORef currentState updatedState+        True -> return ()++    on UI.mousemove canvas $ \pos -> do+      pause <- liftIO $ readIORef currentPause+      case (pause) of+        False -> do+          current  <- liftIO $ readIORef currentState+          mousePos <- liftIO $ readIORef currentMousePos+          let updatedState = handler+                (convertMouseMove mousePos (convertMousePos gleamconfig pos))+                current+          liftIO $ writeIORef currentState updatedState+          liftIO $ writeIORef currentMousePos $ convertMousePos gleamconfig pos+        True -> return ()++    return ()++-- | Handles events for a single canvas.+handleEvents+  :: GleamConfig                    -- ^ Canvas size.+  -> IORef model                    -- ^ Current state of the simulation.+  -> IORef (Double, Double)         -- ^ Current mouse position.+  -> (InputEvent -> model -> model) -- ^ Function to handle input events.+  -> UI.Element                     -- ^ The canvas element.+  -> UI ()+handleEvents gleamconfig currentState currentMousePos handler canvas = do++  on UI.keydown canvas $ \c -> do+    current <- liftIO $ readIORef currentState+    let updatedState = handler (convertKeyCode c Down) current+    liftIO $ writeIORef currentState updatedState++  on UI.keyup canvas $ \c -> do+    current <- liftIO $ readIORef currentState+    let updatedState = handler (convertKeyCode c Up) current+    liftIO $ writeIORef currentState updatedState++  on UI.mouseup canvas $ \pos -> do+    current <- liftIO $ readIORef currentState+    let updatedState =+          handler (convertMouse (convertMousePos gleamconfig pos) Up) current+    liftIO $ writeIORef currentState updatedState++  on UI.mousedown canvas $ \pos -> do+    current <- liftIO $ readIORef currentState+    let updatedState =+          handler (convertMouse (convertMousePos gleamconfig pos) Down) current+    liftIO $ writeIORef currentState updatedState++  on UI.mousemove canvas $ \pos -> do+    current  <- liftIO $ readIORef currentState+    mousePos <- liftIO $ readIORef currentMousePos+    let updatedState = handler+          (convertMouseMove mousePos (convertMousePos gleamconfig pos))+          current+    liftIO $ writeIORef currentState updatedState+    liftIO $ writeIORef currentMousePos $ convertMousePos gleamconfig pos++  return ()++convertMousePos :: GleamConfig -> (Int, Int) -> Point+convertMousePos gleamconfig (x, y) =+  ( ((fromIntegral x) - (fromIntegral (width gleamconfig) / 2))+  , ((fromIntegral y) - (fromIntegral (height gleamconfig) / 2))+  )++convertMouse :: Point -> KeyState -> InputEvent+convertMouse pos state = (EventKey (Mouse pos) state)++convertMouseMove :: Point -> Point -> InputEvent+convertMouseMove (x, y) (nx, ny) = (EventMotion ((x - nx), (y - ny)) (nx, ny))++convertKeyCode :: UI.KeyCode -> KeyState -> InputEvent+convertKeyCode code state+  | charCodes code = (EventKey (Char (keyCodeToChar code)) state)+  | code == 8      = (EventKey (SpecialKey KeyBackspace) state)+  | code == 9      = (EventKey (SpecialKey KeyTab) state)+  | code == 13     = (EventKey (SpecialKey KeyEnter) state)+  | code == 16     = (EventKey (SpecialKey KeyShift) state)+  | code == 17     = (EventKey (SpecialKey KeyCtrl) state)+  | code == 18     = (EventKey (SpecialKey KeyAlt) state)+  | code == 20     = (EventKey (SpecialKey KeyCaps) state)+  | code == 27     = (EventKey (SpecialKey KeyEsc) state)+  | code == 37     = (EventKey (SpecialKey KeyLeft) state)+  | code == 38     = (EventKey (SpecialKey KeyUp) state)+  | code == 39     = (EventKey (SpecialKey KeyRight) state)+  | code == 40     = (EventKey (SpecialKey KeyDown) state)+  | otherwise      = (EventKey (SpecialKey KeyUnknown) state)++keyCodeToChar :: UI.KeyCode -> Char+keyCodeToChar code | (code >= 65 && code <= 90) = chr $ (ord 'z') - (90 - code)+                   | (code >= 48 && code <= 57) = chr $ (ord '9') - (57 - code)+                   | (code == 186)              = ';'+                   | (code == 187)              = '='+                   | (code == 188)              = ','+                   | (code == 189)              = '-'+                   | (code == 190)              = '.'+                   | (code == 191)              = '/'+                   | (code == 192)              = '`'+                   | (code == 219)              = '['+                   | (code == 220)              = '\\'+                   | (code == 221)              = ']'+                   | (code == 222)              = '\''+                   | otherwise                  = '?'++charCodes :: UI.KeyCode -> Bool+charCodes code | (code >= 65 && code <= 90)   = True+               | (code >= 48 && code <= 61)   = True+               | (code >= 48 && code <= 57)   = True+               | (code >= 186 && code <= 192) = True+               | (code >= 219 && code <= 222) = True+               | otherwise                    = False
+ src/InputEvent.hs view
@@ -0,0 +1,42 @@+module InputEvent+  ( InputEvent(..)+  , Key(..)+  , KeyState(..)+  , SpecialKey(..)+  )+where++import           Picture++data InputEvent+        = EventKey Key KeyState+        | EventMotion Point Point+        deriving (Eq, Show)++data Key+        = Char          Char+        | SpecialKey    SpecialKey+        | Mouse         Point+        deriving (Show, Eq, Ord)++data KeyState+        = Down+        | Up+        deriving (Show, Eq, Ord)++data SpecialKey+        = KeyUnknown+        | KeySpace+        | KeyEsc+        | KeyUp+        | KeyDown+        | KeyLeft+        | KeyRight+        | KeyTab+        | KeyEnter+        | KeyBackspace+        | KeyShift+        | KeyCtrl+        | KeyAlt+        | KeyCaps+        deriving (Show, Eq, Ord)
+ src/Picture.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Picture+  ( Picture(..)+  , Point+  , Vector+  , Path+  , Source(..)+        -- * Compound shapes+  , lineLoop+  , sectorWire+  , rectanglePath+  , rectangleWire+  , rectangleSolid+  )+where++import           Data.Monoid+import           Data.Semigroup+import           Data.Foldable+import           Color+import           Text++-- | A point on the x-y plane.+type Point = (Double, Double)++-- | A vector can be treated as a point, and vis-versa.+type Vector = Point++-- | A path through the x-y plane.+type Path = [Point]++-- | An image location+data Source =+  -- | Path to an image inside ./images. +  File String+  -- | An image url.+  | Url String+  deriving (Show, Eq)++-- | A 2D picture+data Picture+        -- | A blank picture, with nothing in it.+        = Blank+        -- | A line along an arbitrary path.+        | Line          Path+        -- | A polygon filled with a solid color.+        | Polygon       Path+        -- | A circle with the given radius.+        | Circle        Double+        -- | A circular arc drawn counter-clockwise between two angles+        --  (in degrees) at the given radius.+        | Arc           Double Double Double+        -- | A rectangle drawn with given width and height.+        | Rectangle     Double Double+        -- | Image to draw from a certain with given width and height.+        | Image         Source Double Double+        -- | Some text to draw with a vector font.+        | Text          String Font FontSize+        -- | A picture drawn with this color.+        | Color     Color Picture+        -- | A picture drawn with this stroke, given a color and size.+        | Stroke        Color Double Picture+        -- | A picture translated by the given x and y coordinates.+        | Translate     Double Double Picture+        -- | A picture scaled by the given x and y factors.+        | Scale         Double Double Picture+        -- | A picture consisting of several others.+        | Pictures      [Picture]+        deriving (Show, Eq)+++-- Instances ------------------------------------------------------------------+instance Monoid Picture where+  mempty = Blank+  mappend a b = Pictures [a, b]+  mconcat = Pictures++instance Semigroup Picture where+  a <> b = Pictures [a, b]+  sconcat = Pictures . toList+  stimes  = stimesIdempotent++-- Other Shapes ---------------------------------------------------------------+-- | A closed loop along a path.+lineLoop :: Path -> Picture+lineLoop []       = Line []+lineLoop (x : xs) = Line ((x : xs) ++ [x])+++-- | A wireframe sector of a circle.+--   An arc is draw counter-clockwise from the first to the second angle at+--   the given radius.+sectorWire :: Double -> Double -> Double -> Picture+sectorWire a1 a2 r_ =+  let r = abs r_+  in  Pictures+        [ Arc a1 a2 r+        , Line [(0, 0), (r * cos (degToRad a1), r * sin (degToRad a1))]+        , Line [(0, 0), (r * cos (degToRad a2), r * sin (degToRad a2))]+        ]+++-- Rectangles -----------------------------------------------------------------++-- | A path representing a rectangle centered about the origin+rectanglePath+  :: Double        -- ^ width of rectangle+  -> Double        -- ^ height of rectangle+  -> Path+rectanglePath sizeX sizeY =+  let sx = sizeX / 2+      sy = sizeY / 2+  in  [(-sx, -sy), (-sx, sy), (sx, sy), (sx, -sy)]+++-- | A wireframe rectangle centered about the origin.+rectangleWire :: Double -> Double -> Picture+rectangleWire sizeX sizeY = lineLoop $ rectanglePath sizeX sizeY+++-- | A solid rectangle centered about the origin.+rectangleSolid+  :: Double         -- ^ width of rectangle+  -> Double         -- ^ height of rectangle+  -> Picture+rectangleSolid sizeX sizeY = Polygon $ rectanglePath sizeX sizeY++-- | Convert degrees to radians+degToRad :: Double -> Double+degToRad d = d * pi / 180+{-# INLINE degToRad #-}+++-- | Convert radians to degrees+radToDeg :: Double -> Double+radToDeg r = r * 180 / pi+{-# INLINE radToDeg #-}+++-- | Normalize an angle to be between 0 and 2*pi radians+normalizeAngle :: Double -> Double+normalizeAngle f = f - 2 * pi * floor' (f / (2 * pi))+ where+  floor' :: Double -> Double+  floor' x = fromIntegral (floor x :: Int)
+ src/Render.hs view
@@ -0,0 +1,183 @@+{-# OPTIONS_HADDOCK hide #-}++module Render+  ( renderPicture+  )+where++import qualified Graphics.UI.Threepenny        as UI+import           Graphics.UI.Threepenny.Core+import           Foreign.JavaScript+import           Control.Monad+import           Data.List+import           Data.List.Split+import           Picture+import           Color+import           Text++renderPicture :: Picture -> Element -> UI ()+renderPicture picture canvas = do+  canvas # saveDrawState+  canvas # translateMiddle+  canvas # drawPicture picture+  canvas # restoreDrawState+  return ()++drawPicture :: Picture -> Element -> UI ()++drawPicture (Blank) canvas = do+  return ()++drawPicture (Circle radius) canvas = do+  canvas # UI.beginPath+  canvas # UI.arc (0, 0) (radius) (-pi) pi+  canvas # UI.closePath+  canvas # UI.fill+  return ()++drawPicture (Arc startAngle endAngle radius) canvas = do+  canvas # UI.beginPath+  canvas # UI.moveTo (0, 0)+  canvas+    # UI.arc (0, 0) (radius) (startAngle * (pi / 180)) (endAngle * (pi / 180))+  canvas # UI.closePath+  canvas # UI.fill+  return ()++drawPicture (Rectangle width height) canvas = do+  canvas # UI.fillRect (0 - (width / 2), 0 - (height / 2)) width height+  return ()++drawPicture (Stroke color size picture) canvas = do+  canvas # saveDrawState+  canvas # set' UI.strokeStyle (convertColor color)+  canvas # set' UI.lineWidth size+  canvas # drawPicture picture+  canvas # restoreDrawState+  return ()++drawPicture (Text string font fontSize) canvas = do+  canvas # set' UI.textAlign (UI.Center)+  canvas # set' UI.textFont (getCombinedFont font fontSize)+  canvas # UI.fillText string (0, 0)+  return ()++drawPicture (Image (Url url) width height) canvas = do+  img <- UI.img # set UI.src url+  canvas # drawImage img (0 - (width / 2), 0 - (height / 2)) width height+  return ()++drawPicture (Image (File file) width height) canvas = do+  img <- UI.img # set+    UI.src+    ("http://127.0.0.1:8023/static/" ++ file)+  canvas # drawImage img (0 - (width / 2), 0 - (height / 2)) width height+  return ()++drawPicture (Scale x y picture) canvas = do+  canvas # saveDrawState+  canvas # scalePicture (x, y)+  canvas # drawPicture picture+  canvas # restoreDrawState+  return ()++drawPicture (Translate x y picture) canvas = do+  canvas # saveDrawState+  canvas # translatePicture (x, y)+  canvas # drawPicture picture+  canvas # restoreDrawState+  return ()++drawPicture (Pictures (picture : pictures)) canvas = do+  canvas # drawPicture picture+  canvas # drawPicture (Pictures pictures)+  return ()++drawPicture (Line (_ : [])) _ = do+  return ()++drawPicture (Line ([])) _ = do+  return ()++drawPicture (Line ((x, y) : rest)) canvas = do+  canvas # UI.beginPath+  canvas # UI.moveTo (x, y)+  forM_ rest (\(x', y') -> canvas # UI.lineTo (x', y'))+  canvas # UI.stroke+  return ()++drawPicture (Polygon (_ : [])) _ = do+  return ()++drawPicture (Polygon ([])) _ = do+  return ()++drawPicture (Polygon ((x, y) : rest)) canvas = do+  canvas # UI.beginPath+  canvas # UI.moveTo (x, y)+  forM_ rest (\(x', y') -> canvas # UI.lineTo (x', y'))+  canvas # UI.closePath+  canvas # UI.fill+  return ()++drawPicture (Color color picture) canvas = do+  canvas # saveDrawState+  canvas # set' UI.fillStyle (UI.htmlColor $ convertColor color)+  canvas # drawPicture picture+  canvas # restoreDrawState+  return ()++drawPicture _ _ = do+  return ()++scalePicture :: Point -> UI.Canvas -> UI ()+scalePicture (sx, sy) canvas =+  UI.runFunction $ ffi "%1.getContext('2d').scale(%2, %3)" canvas sx sy++saveDrawState :: UI.Canvas -> UI ()+saveDrawState canvas = UI.runFunction $ ffi "%1.getContext('2d').save()" canvas++restoreDrawState :: UI.Canvas -> UI ()+restoreDrawState canvas =+  UI.runFunction $ ffi "%1.getContext('2d').restore()" canvas++resetTransform :: UI.Canvas -> UI ()+resetTransform canvas = UI.runFunction+  $ ffi "%1.getContext('2d').setTransform(1, 0, 0, 1, 0, 0)" canvas++translatePicture :: Point -> UI.Canvas -> UI ()+translatePicture (tx, ty) canvas =+  UI.runFunction $ ffi "%1.getContext('2d').translate(%2, %3)" canvas tx ty++translateMiddle :: UI.Canvas -> UI ()+translateMiddle canvas = UI.runFunction+  $ ffi "%1.getContext('2d').translate(%1.width/2, %1.height/2)" canvas++drawImage :: UI.Element -> Vector -> Double -> Double -> UI.Canvas -> UI ()+drawImage image (x, y) width height canvas = UI.runFunction $ ffi+  "%1.getContext('2d').drawImage(%2,%3,%4,%5,%6)"+  canvas+  image+  x+  y+  width+  height++getMimeType :: String -> String+getMimeType fileName = case (last (splitOn "." fileName)) of+  "apng"  -> "image/apng"+  "bmp"   -> "image/bmp"+  "gif"   -> "image/gif"+  "ico"   -> "image/x-icon"+  "cur"   -> "image/x-icon"+  "jpg"   -> "image/jpeg"+  "jpeg"  -> "image/jpeg"+  "jfif"  -> "image/jpeg"+  "pjpeg" -> "image/jpeg"+  "pjp"   -> "image/jpeg"+  "png"   -> "image/png"+  "svg"   -> "image/svg+xml"+  "tif"   -> "image/tiff"+  "tiff"  -> "image/tiff"+  "webp"  -> "image/webp"+  _       -> "image"
+ src/Settings.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE ExistentialQuantification #-}++module Settings+  ( Simulation(..)+  , GleamConfig(..)+  , defaultGleamConfig+  )+where++import           Picture+import           InputEvent++data Simulation = forall model . Simulation {+  -- | Config for the canvas.+  simConfig :: GleamConfig,+  -- | Initial model for a simulation.+  simInitialModel :: model,+  -- | Function to generate a picture from a model.+  simDraw :: (model -> Picture),+  -- | Function to update the state of the simulation.+  simUpdate :: (model -> model),+  -- | Function to handle input events.+  simHandler :: (InputEvent -> model -> model),+  -- | Title of the simulation.+  simTitle :: String+}++data GleamConfig = GleamConfig {+  -- | Width of the canvas.+  width :: Int,+  -- | Height of the canvas.+  height :: Int+}++-- | The default config for Gleam+defaultGleamConfig :: GleamConfig+defaultGleamConfig = GleamConfig 400 400
+ src/Text.hs view
@@ -0,0 +1,46 @@+module Text+  ( Font(..)+  , FontSize(..)+  , getCombinedFont+  )+where++import           Data.List++-- | A font.+data Font+  = Arial+  | Verdana+  | TimesNewRoman+  | CourierNew+  | Serif+  | SansSerif+  -- | A html font family+  | Font String deriving (Show, Eq)++-- | A font size, given in points.+data FontSize = Size Int deriving (Show, Eq)++-- | Converts a `Font` to a html font family.+convertFont :: Font -> String+convertFont font = case (font) of+  Arial         -> "Arial"+  Verdana       -> "Verdana"+  TimesNewRoman -> "Times New Roman"+  CourierNew    -> "Courier New"+  Serif         -> "serif"+  SansSerif     -> "sans-serif"+  Font family   -> family++-- | Converts a `FontSize` to a html font size.+convertFontSize :: FontSize -> String+convertFontSize (Size size) = (show size) ++ "pt"++-- | Combines a `Font` and `FontSize` to return a html string representing them.+getCombinedFont :: Font -> FontSize -> String+getCombinedFont font fontSize =+  intercalate " " [(convertFontSize fontSize), (convertFont font)]++++
+ src/Utility.hs view
@@ -0,0 +1,13 @@+{-# OPTIONS_HADDOCK hide #-}++module Utility+  ( setAttribute+  )+where++import qualified Graphics.UI.Threepenny        as UI+import           Graphics.UI.Threepenny.Core++setAttribute :: String -> String -> UI.Canvas -> UI ()+setAttribute key value canvas =+  UI.runFunction $ ffi "%1.setAttribute(%2, %3)" canvas key value