├── .gitignore ├── CHANGES.md ├── LICENSE ├── README.md ├── Setup.hs ├── examples ├── Bench.hs ├── Dash.hs ├── Ellipse.hs ├── Image.hs ├── Image.html ├── Line.hs ├── Line.html ├── LinearGradient.hs ├── LinearGradient.html ├── MiterLimit.hs ├── MiterLimit.html ├── Pattern.hs ├── Pattern.html ├── Rectangle.hs ├── Rectangle.html ├── Shape.hs ├── Shape.html ├── Text.hs ├── Text.html ├── arrows.png └── tile.png ├── src └── Graphics │ ├── Static.hs │ └── Static │ ├── ColorNames.hs │ ├── Interpreter.hs │ ├── Javascript.hs │ └── Types.hs └── static-canvas.cabal /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | .virthualenv 8 | .hpc 9 | .hsenv_* 10 | dist_* 11 | history 12 | TAGS 13 | /cabal.sandbox.config 14 | /.cabal-sandbox/ 15 | *.prof 16 | *.hp 17 | *.aux 18 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | 0.3.0 (19 May 2017) 2 | --------------------- 3 | 4 | - Refactor to use `MonadFree` and `improve`. 5 | - Add `elipse` 6 | - Add `lineDash` 7 | 8 | 0.2.0.3 (17 June 2016) 9 | --------------------- 10 | 11 | - Allow `base-4.9` 12 | 13 | 0.2.0.2 (9 July 2015) 14 | --------------------- 15 | 16 | - Allow `free-4.12.1` 17 | 18 | 0.2 (13 Feb 2015) 19 | ----------------- 20 | 21 | - Lower bounds on `mtl` and `free`. 22 | - Add functions to provide a unique identifier to avoid name 23 | clashes between multiple canvas elements. 24 | 25 | 0.1 (12 Feb 2015) 26 | ----------------- 27 | 28 | - Initial release. 29 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, Jeffrey Rosenbluth 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Jeffrey Rosenbluth nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # static-canvas [![Hackage](https://img.shields.io/hackage/v/static-canvas.svg?style=flat)](https://hackage.haskell.org/package/static-canvas) 2 | A simple DSL for writing HTML5 Canvas in haskell and converting it 3 | to Javascript. By static we mean non-interactive, so the parts of 4 | the Canvas API that need to query the browser for run time information 5 | like `isPointInPath(x, y)` are not included. This turns out to be 6 | a surprisingly small part of HTML5 Canvas. 7 | 8 | Here is Hello static-canvas with fancy text. 9 | 10 | ![Text](http://i.imgur.com/HGjSpJ6.png) 11 | 12 | ```haskell 13 | {-# LANGUAGE OverloadedStrings #-} 14 | 15 | module Main where 16 | 17 | import Graphics.Static 18 | import Graphics.Static.ColorNames 19 | 20 | text :: CanvasFree () 21 | text = do 22 | font "italic 60pt Calibri" 23 | lineWidth 6 24 | strokeStyle blue 25 | fillStyle goldenrod 26 | textBaseline TextBaselineMiddle 27 | strokeText "Hello" 150 100 28 | fillText "Hello World!" 150 100 29 | 30 | main :: IO () 31 | main = writeCanvasDoc "Text.html" 600 400 text 32 | ``` 33 | There are plenty of examples in [Examples](https://github.com/jeffreyrosenbluth/static-canvas/tree/master/examples). 34 | Here is one more showing how to use pattern to fill a rectangle. 35 | 36 | ![line](http://i.imgur.com/RRvyXyv.png) 37 | ```haskell 38 | {-# LANGUAGE OverloadedStrings #-} 39 | 40 | module Main where 41 | 42 | import Graphics.Static 43 | 44 | pattern :: CanvasFree () 45 | pattern = do 46 | img <- newImage "tile.png" 47 | onImageLoad img $ do 48 | ptn <- createPattern img Repeat 49 | rect 0 0 400 400 50 | fillStyle ptn 51 | fill 52 | 53 | main :: IO () 54 | main = writeCanvasDoc "Pattern.html" 400 400 pattern 55 | ``` 56 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /examples/Bench.hs: -------------------------------------------------------------------------------- 1 | 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE RankNTypes #-} 5 | 6 | module Main where 7 | 8 | import Data.Foldable (for_) 9 | import Graphics.Static 10 | 11 | square :: MFC () 12 | square = do 13 | beginPath 14 | for_ [1..1000000] $ 15 | \n -> do 16 | let m = n / 1000.0 17 | rect m m m m 18 | fillStyle (ColorStyle (Hex ("#FFD700"))) 19 | strokeStyle (ColorStyle (Hex ("#8B008B"))) 20 | fill 21 | stroke 22 | 23 | main :: IO () 24 | main = writeCanvasDoc "Bench.html" 750 750 square 25 | -------------------------------------------------------------------------------- /examples/Dash.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE RankNTypes #-} 4 | 5 | module Main where 6 | 7 | import Graphics.Static 8 | 9 | drawDashedLine :: ([Double], Double) -> MFC () 10 | drawDashedLine (ds, y) = do 11 | beginPath 12 | lineDash ds 13 | moveTo 0 y 14 | lineTo 300 y 15 | stroke 16 | 17 | dash :: MFC () 18 | dash = mapM_ drawDashedLine $ zip ds ys 19 | where 20 | ds = [[], [1, 1], [10, 10], [20, 5], [15, 3, 3, 3]] 21 | ys = [15, 35..95] 22 | 23 | main :: IO () 24 | main = writeCanvasDoc "Dash.html" 400 400 dash 25 | -------------------------------------------------------------------------------- /examples/Ellipse.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | 4 | module Main where 5 | 6 | import Graphics.Static 7 | 8 | ellipse' :: MFC () 9 | ellipse' = do 10 | beginPath 11 | ellipse 100 100 50 75 (pi / 4) 0 (2 * pi) False 12 | fillStyle (ColorStyle (Hex ("#FFD700"))) 13 | stroke 14 | fill 15 | lineWidth 7 16 | strokeStyle (ColorStyle (Hex ("#8B008B"))) 17 | stroke 18 | 19 | main :: IO () 20 | main = writeCanvasDoc "Ellipse.html" 400 400 ellipse' 21 | -------------------------------------------------------------------------------- /examples/Image.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | 5 | import Graphics.Static 6 | 7 | image :: CanvasFree () 8 | image = do 9 | img <- newImage "arrows.png" 10 | onImageLoad img (drawImageAt img 0 0) 11 | 12 | main :: IO () 13 | main = writeCanvasDoc "Image.html" 625 325 image 14 | -------------------------------------------------------------------------------- /examples/Image.html: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /examples/Line.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | 5 | import Graphics.Static 6 | import Graphics.Static.ColorNames 7 | 8 | line :: CanvasFree () 9 | line = do 10 | beginPath 11 | moveTo 100 150 12 | lineTo 450 50 13 | lineWidth 10 14 | strokeStyle indigo 15 | lineCap LineCapRound 16 | stroke 17 | 18 | main :: IO () 19 | main = writeCanvasDoc "Line.html" 500 200 line 20 | -------------------------------------------------------------------------------- /examples/Line.html: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /examples/LinearGradient.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | 5 | import Graphics.Static 6 | 7 | gradient :: CanvasFree () 8 | gradient = do 9 | rect 0 0 400 400 10 | grd <- createLinearGradient 0 0 400 400 11 | addColorStop 0 (Hex "#8ed6ff") $ grd 12 | addColorStop 1 (Hex "#004cb3") $ grd 13 | fillStyle grd 14 | fill 15 | 16 | main :: IO () 17 | main = writeCanvasDoc "LinearGradient.html" 400 400 gradient 18 | -------------------------------------------------------------------------------- /examples/LinearGradient.html: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /examples/MiterLimit.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | 5 | import Graphics.Static 6 | 7 | miterlimit :: CanvasFree () 8 | miterlimit = do 9 | 10 | clearRect 0 0 150 150 11 | -- Draw guides 12 | strokeStyle (ColorStyle (Hex "#09f")) 13 | lineWidth 2 14 | strokeRect (-5) 50 160 50 15 | 16 | -- Set line styles 17 | strokeStyle (ColorStyle (Hex "#000")) 18 | lineWidth 10 19 | 20 | -- check input 21 | miterLimit 5 22 | 23 | -- Draw lines 24 | beginPath 25 | moveTo 0 100 26 | sequence_ [ lineTo ((fromIntegral i ** 1.5)*2) (75+(if i `mod` 2 == 0 then 25 else -25)) 27 | | i <- [0..20] :: [Int] 28 | ] 29 | stroke 30 | 31 | main :: IO () 32 | main = writeCanvasDoc "MiterLimit.html" 400 400 miterlimit 33 | -------------------------------------------------------------------------------- /examples/MiterLimit.html: -------------------------------------------------------------------------------- 1 | ```html 2 | 3 | ``` 4 | -------------------------------------------------------------------------------- /examples/Pattern.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | 5 | import Graphics.Static 6 | 7 | pattern :: CanvasFree () 8 | pattern = do 9 | img <- newImage "tile.png" 10 | onImageLoad img $ do 11 | ptn <- createPattern img Repeat 12 | rect 0 0 400 400 13 | fillStyle ptn 14 | fill 15 | 16 | main :: IO () 17 | main = writeCanvasDoc "Pattern.html" 400 400 pattern 18 | -------------------------------------------------------------------------------- /examples/Pattern.html: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /examples/Rectangle.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | 5 | import Graphics.Static 6 | 7 | rectangle :: CanvasFree () 8 | rectangle = do 9 | beginPath 10 | rect 188 50 200 100 11 | fillStyle (ColorStyle (Hex ("#FFD700"))) 12 | fill 13 | lineWidth 7 14 | strokeStyle (ColorStyle (Hex ("#8B008B"))) 15 | stroke 16 | 17 | main :: IO () 18 | main = writeCanvasDoc "Rectangle.html" 400 400 rectangle 19 | -------------------------------------------------------------------------------- /examples/Rectangle.html: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /examples/Shape.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | 5 | import Graphics.Static 6 | import Graphics.Static.ColorNames 7 | 8 | shape :: CanvasFree () 9 | shape = do 10 | beginPath 11 | moveTo 170 80 12 | bezierCurveTo 130 100 30 150 230 150 13 | bezierCurveTo 250 180 320 180 340 150 14 | bezierCurveTo 420 150 420 120 390 100 15 | bezierCurveTo 430 40 370 30 340 50 16 | bezierCurveTo 320 5 250 20 200 50 17 | bezierCurveTo 200 5 100 20 170 80 18 | 19 | closePath 20 | lineWidth 5 21 | fillStyle goldenrod 22 | fill 23 | strokeStyle blue 24 | stroke 25 | 26 | main :: IO () 27 | main = writeCanvasDoc "Shape.html" 500 200 shape 28 | -------------------------------------------------------------------------------- /examples/Shape.html: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /examples/Text.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main where 4 | 5 | import Graphics.Static 6 | import Graphics.Static.ColorNames 7 | 8 | text :: CanvasFree () 9 | text = do 10 | font "italic 57pt Calibri" 11 | lineWidth 6 12 | strokeStyle blue 13 | fillStyle goldenrod 14 | textBaseline TextBaselineMiddle 15 | strokeText "Hello" 25 100 16 | fillText "Hello static-canvas!" 25 100 17 | 18 | main :: IO () 19 | main = writeCanvasDoc "Text.html" 650 300 text 20 | -------------------------------------------------------------------------------- /examples/Text.html: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /examples/arrows.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jeffreyrosenbluth/static-canvas/1aad0f192828ded72dced14e42ac4e6baa6dab6f/examples/arrows.png -------------------------------------------------------------------------------- /examples/tile.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jeffreyrosenbluth/static-canvas/1aad0f192828ded72dced14e42ac4e6baa6dab6f/examples/tile.png -------------------------------------------------------------------------------- /src/Graphics/Static.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RankNTypes #-} 4 | ------------------------------------------------------------------------------- 5 | -- | 6 | -- Module : Graphics.Static 7 | -- Copyright : (c) 2015 Jeffrey Rosenbluth 8 | -- License : BSD-style (see LICENSE) 9 | -- Maintainer : jeffrey.rosenbluth@gmail.com 10 | -- 11 | -- A small DSL for creating HTML5 Canvas with haskell. 12 | -- 13 | -- <> 14 | -- 15 | -- > module Main where 16 | -- > 17 | -- > import Graphics.Static 18 | -- > import Graphics.Static.ColorNames 19 | -- > 20 | -- > text :: CanvasFree () 21 | -- > text = do 22 | -- > font "italic 60pt Calibri" 23 | -- > lineWidth 6 24 | -- > strokeStyle blue 25 | -- > fillStyle goldenrod 26 | -- > textBaseline TextBaselineMiddle 27 | -- > strokeText "Hello" 25 100 28 | -- > fillText "Hello static-canvas!" 25 100 29 | -- > 30 | -- > main :: IO () 31 | -- > main = writeCanvasDoc "example.html" 650 300 text 32 | -- 33 | -- The static-canvas API shadows the actual Javascript API, and thus the 34 | -- best place to look for a more detailed definition of the canvas functions 35 | -- including the definitions of it's aruments see . 36 | ------------------------------------------------------------------------------- 37 | 38 | module Graphics.Static 39 | ( 40 | -- * Building and Writing 41 | evalScript 42 | , buildScript 43 | , buildScript' 44 | , buildDoc 45 | , writeCanvasScript 46 | , writeCanvasScript' 47 | , writeCanvasDoc 48 | -- * HTML5 Canvas API 49 | , MFC 50 | -- ** Paths 51 | , beginPath 52 | , closePath 53 | , fill 54 | , stroke 55 | , clip 56 | , moveTo 57 | , lineTo 58 | , quadraticCurveTo 59 | , bezierCurveTo 60 | , arcTo 61 | , arc 62 | , rect 63 | , ellipse 64 | -- ** Line styles 65 | , lineWidth 66 | , lineCap 67 | , lineJoin 68 | , lineDash 69 | , miterLimit 70 | , LineCapStyle(..) 71 | , LineJoinStyle(..) 72 | -- ** Colors, styles and shadows 73 | , strokeStyle 74 | , fillStyle 75 | , shadowOffsetX 76 | , shadowOffsetY 77 | , shadowBlur 78 | , shadowColor 79 | , createLinearGradient 80 | , createRadialGradient 81 | , addColorStop 82 | , Gradient(..) 83 | , createPattern 84 | , RepeatStyle(..) 85 | , Color(..) 86 | , Style(..) 87 | -- ** Color utilities 88 | , rgb 89 | , rgba 90 | -- ** Text 91 | , font 92 | , textAlign 93 | , textBaseline 94 | , fillText 95 | , strokeText 96 | , TextAlignStyle(..) 97 | , TextBaselineStyle(..) 98 | -- ** Rectangles 99 | , clearRect 100 | , fillRect 101 | , strokeRect 102 | -- ** Context 103 | , save 104 | , restore 105 | -- ** Transformations 106 | , scale 107 | , rotate 108 | , translate 109 | , transform 110 | , setTransform 111 | -- ** Images 112 | , drawImageAt 113 | , drawImageSize 114 | , drawImageCrop 115 | , newImage 116 | , onImageLoad 117 | -- ** Compositing 118 | , globalAlpha 119 | , globalCompositeOperation 120 | , CompositeOperation(..) 121 | ) where 122 | 123 | import Control.Monad.Free.Class 124 | import Data.Monoid 125 | import Prelude hiding (writeFile) 126 | import Data.Text (Text) 127 | import Data.Text.Lazy.Builder (Builder, toLazyText, fromText) 128 | import Data.Text.Lazy.IO (writeFile) 129 | import Graphics.Static.Interpreter 130 | import Graphics.Static.Javascript 131 | import Graphics.Static.Types 132 | 133 | ------------------------------------------------------------------------------- 134 | -- Building and writing 135 | ------------------------------------------------------------------------------- 136 | 137 | -- | Write a canvas document to a file. 138 | writeCanvasDoc :: FilePath -> Int -> Int -> MFC () -> IO () 139 | writeCanvasDoc path w h canvas = 140 | writeFile path (toLazyText $ buildDoc w h canvas) 141 | 142 | -- | Write a canvas script element to a file. 143 | writeCanvasScript :: FilePath -> Int -> Int -> MFC () -> IO () 144 | writeCanvasScript path w h = writeCanvasScript' path w h "" 145 | 146 | -- | More general version of 'writeCanvasScript', that takes a unique identifier 147 | -- as an additional parameter so that multiple canvas elements can be included 148 | -- in the same html document. 149 | writeCanvasScript' :: FilePath -> Int -> Int -> Text -> MFC () -> IO () 150 | writeCanvasScript' path w h uniqId canvas = 151 | writeFile path (toLazyText $ buildScript' w h uniqId canvas) 152 | 153 | -- | Create a 'Builder' representing a canvas document. 154 | buildDoc :: Int -> Int -> MFC () -> Builder 155 | buildDoc w h canvas 156 | = "" 157 | <> (buildScript w h canvas) 158 | <> "" 159 | 160 | -- | Create a 'Builder' representing a canvas script. 161 | buildScript :: Int -> Int -> MFC () -> Builder 162 | buildScript w h = buildScript' w h "" 163 | 164 | -- | More general version of 'buildScript', that takes a unique identifier 165 | -- as an additional parameter so that multiple canvas elements can be included 166 | -- in the same html document. 167 | buildScript' :: Int -> Int -> Text -> MFC () -> Builder 168 | buildScript' w h uniqId canvas 169 | = " uId <> "StaticCanvas\" width=\"" <> jsInt w 170 | <> "\" height=\"" <> jsInt h <> "\">" 171 | <> "" 178 | where 179 | uId = fromText uniqId 180 | 181 | ------------------------------------------------------------------------------- 182 | -- Color utilities 183 | ------------------------------------------------------------------------------- 184 | 185 | rgb :: Int -> Int -> Int -> Style 186 | rgb r g b = ColorStyle (RGB r g b) 187 | 188 | rgba :: Int -> Int -> Int -> Double -> Style 189 | rgba r g b a = ColorStyle (RGBA r g b a) 190 | 191 | ------------------------------------------------------------------------------- 192 | -- The DSL 193 | ------------------------------------------------------------------------------- 194 | addColorStop :: Double -> Color -> Style -> MFC () 195 | addColorStop a1 a2 a3 = liftF $ AddColorStop a1 a2 a3 () 196 | 197 | arc :: Double -> Double -> Double -> Double -> Double -> Bool -> MFC () 198 | arc a1 a2 a3 a4 a5 a6 = liftF $ Arc a1 a2 a3 a4 a5 a6 () 199 | 200 | arcTo :: Double -> Double -> Double -> Double -> Double -> MFC () 201 | arcTo a1 a2 a3 a4 a5 = liftF $ ArcTo a1 a2 a3 a4 a5 () 202 | 203 | beginPath :: MFC () 204 | beginPath = liftF $ BeginPath () 205 | 206 | -- | Cubic Bezier curve. 207 | bezierCurveTo :: Double -> Double -> Double -> Double -> Double -> Double -> MFC () 208 | bezierCurveTo a1 a2 a3 a4 a5 a6 = liftF $ BezierCurveTo a1 a2 a3 a4 a5 a6 () 209 | 210 | clearRect :: Double -> Double -> Double -> Double -> MFC () 211 | clearRect a1 a2 a3 a4 = liftF $ ClearRect a1 a2 a3 a4 () 212 | 213 | clip :: MFC () 214 | clip = liftF $ Clip () 215 | 216 | closePath :: MFC () 217 | closePath = liftF $ ClosePath () 218 | 219 | createLinearGradient :: Double -> Double -> Double -> Double -> MFC Style 220 | createLinearGradient a1 a2 a3 a4 = liftF $ CreateLinearGradient a1 a2 a3 a4 id 221 | 222 | createPattern :: Int -> RepeatStyle -> MFC Style 223 | createPattern a1 a2 = liftF $ CreatePattern a1 a2 id 224 | 225 | createRadialGradient :: Double -> Double -> Double -> Double -> Double -> Double -> MFC Style 226 | createRadialGradient a1 a2 a3 a4 a5 a6 = liftF $ CreateRadialGradient a1 a2 a3 a4 a5 a6 id 227 | 228 | drawImageAt :: Int -> Double -> Double -> MFC () 229 | drawImageAt a1 a2 a3 = liftF $ DrawImageAt a1 a2 a3 () 230 | 231 | drawImageSize :: Int -> Double -> Double -> Double -> Double -> MFC () 232 | drawImageSize a1 a2 a3 a4 a5 = liftF $ DrawImageSize a1 a2 a3 a4 a5 () 233 | 234 | drawImageCrop :: Int -> Double -> Double -> Double -> Double -> Double 235 | -> Double -> Double -> Double -> MFC () 236 | drawImageCrop a1 a2 a3 a4 a5 a6 a7 a8 a9 237 | = liftF $ DrawImageCrop a1 a2 a3 a4 a5 a6 a7 a8 a9 () 238 | 239 | ellipse :: Double -> Double -> Double -> Double -> Double -> Double -> Double 240 | -> Bool -> MFC () 241 | ellipse a1 a2 a3 a4 a5 a6 a7 a8 = liftF $ Ellipse a1 a2 a3 a4 a5 a6 a7 a8 () 242 | 243 | fill :: MFC () 244 | fill = liftF $ Fill () 245 | 246 | fillRect :: Double -> Double -> Double -> Double -> MFC () 247 | fillRect a1 a2 a3 a4 = liftF $ FillRect a1 a2 a3 a4 () 248 | 249 | fillStyle :: Style -> MFC () 250 | fillStyle a1 = liftF $ FillStyle a1 () 251 | 252 | fillText :: Text -> Double -> Double -> MFC () 253 | fillText a1 a2 a3 = liftF $ FillText a1 a2 a3 () 254 | 255 | font :: Text -> MFC () 256 | font a1 = liftF $ Font a1 () 257 | 258 | globalAlpha :: Double -> MFC () 259 | globalAlpha a1 = liftF $ GlobalAlpha a1 () 260 | 261 | globalCompositeOperation :: CompositeOperation -> MFC () 262 | globalCompositeOperation a1 = liftF $ GlobalCompositeOperation a1 () 263 | 264 | lineCap :: LineCapStyle -> MFC () 265 | lineCap a1 = liftF $ LineCap a1 () 266 | 267 | lineDash :: [Double] -> MFC () 268 | lineDash ds = liftF $ LineDash ds () 269 | 270 | lineJoin :: LineJoinStyle -> MFC () 271 | lineJoin a1 = liftF $ LineJoin a1 () 272 | 273 | lineTo :: Double -> Double -> MFC () 274 | lineTo a1 a2 = liftF $ LineTo a1 a2 () 275 | 276 | -- | Set the line width. 277 | lineWidth :: Double -> MFC () 278 | lineWidth a1 = liftF $ LineWidth a1 () 279 | 280 | miterLimit :: Double -> MFC () 281 | miterLimit a1 = liftF $ MiterLimit a1 () 282 | 283 | moveTo :: Double -> Double -> MFC () 284 | moveTo a1 a2 = liftF $ MoveTo a1 a2 () 285 | 286 | newImage :: Text -> MFC Int 287 | newImage a1 = liftF $ NewImage a1 id 288 | 289 | -- | Useful for commands that need to wait for an image to load before 290 | -- being called. For example 291 | -- 292 | -- > image = do 293 | -- > img <- newImage "http://www.staticcanvas.com/picture.png" 294 | -- > onImageLoad img (drawImageAt img 0 0) 295 | onImageLoad :: Int -> MFC () -> MFC () 296 | onImageLoad a1 a2 = liftF $ OnImageLoad a1 a2 () 297 | 298 | -- | A quadratic bezier curve. 299 | quadraticCurveTo :: Double -> Double -> Double -> Double -> MFC () 300 | quadraticCurveTo a1 a2 a3 a4 = liftF $ QuadraticCurveTo a1 a2 a3 a4 () 301 | 302 | rect :: Double -> Double -> Double -> Double -> MFC () 303 | rect a1 a2 a3 a4 = liftF $ Rect a1 a2 a3 a4 () 304 | 305 | -- | Pop the top state of the stack. 306 | restore :: MFC () 307 | restore = liftF $ Restore () 308 | 309 | rotate :: Double -> MFC () 310 | rotate a1 = liftF $ Rotate a1 () 311 | 312 | -- | Push the current state onto the stack. 313 | save :: MFC () 314 | save = liftF $ Save () 315 | 316 | scale :: Double -> Double -> MFC () 317 | scale a1 a2 = liftF $ Scale a1 a2 () 318 | 319 | setTransform :: Double -> Double -> Double -> Double -> Double -> Double -> MFC () 320 | setTransform a1 a2 a3 a4 a5 a6 = liftF $ SetTransform a1 a2 a3 a4 a5 a6 () 321 | 322 | shadowBlur :: Double -> MFC () 323 | shadowBlur a1 = liftF $ ShadowBlur a1 () 324 | 325 | shadowColor :: Color -> MFC () 326 | shadowColor a1 = liftF $ ShadowColor a1 () 327 | 328 | shadowOffsetX :: Double -> MFC () 329 | shadowOffsetX a1 = liftF $ ShadowOffsetX a1 () 330 | 331 | shadowOffsetY :: Double -> MFC () 332 | shadowOffsetY a1 = liftF $ ShadowOffsetY a1 () 333 | 334 | stroke :: MFC () 335 | stroke = liftF $ Stroke () 336 | 337 | strokeRect :: Double -> Double -> Double -> Double -> MFC () 338 | strokeRect a1 a2 a3 a4 = liftF $ StrokeRect a1 a2 a3 a4 () 339 | 340 | strokeStyle :: Style -> MFC () 341 | strokeStyle a1 = liftF $ StrokeStyle a1 () 342 | 343 | strokeText :: Text -> Double -> Double -> MFC () 344 | strokeText a1 a2 a3 = liftF $ StrokeText a1 a2 a3 () 345 | 346 | textAlign :: TextAlignStyle -> MFC () 347 | textAlign a1 = liftF $ TextAlign a1 () 348 | 349 | textBaseline :: TextBaselineStyle -> MFC () 350 | textBaseline a1 = liftF $ TextBaseline a1 () 351 | 352 | transform :: Double -> Double -> Double -> Double -> Double -> Double -> MFC () 353 | transform a1 a2 a3 a4 a5 a6 = liftF $ Transform a1 a2 a3 a4 a5 a6 () 354 | 355 | translate :: Double -> Double -> MFC () 356 | translate a1 a2 = liftF $ Translate a1 a2 () 357 | -------------------------------------------------------------------------------- /src/Graphics/Static/ColorNames.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | ------------------------------------------------------------------------------- 4 | -- | 5 | -- Module : Graphics.Static.ColorNames 6 | -- Copyright : (c) 2015 Jeffrey Rosenbluth 7 | -- License : BSD-style (see LICENSE) 8 | -- Maintainer : jeffrey.rosenbluth@gmail.com 9 | -- 10 | -- Functions to create color styles. 11 | -- 12 | ------------------------------------------------------------------------------- 13 | 14 | module Graphics.Static.ColorNames 15 | ( 16 | aliceblue 17 | , antiquewhite 18 | , aqua 19 | , aquamarine 20 | , azure 21 | , beige 22 | , bisque 23 | , black 24 | , blanchedalmond 25 | , blue 26 | , blueviolet 27 | , brown 28 | , burlywood 29 | , cadetblue 30 | , chartreuse 31 | , chocolate 32 | , coral 33 | , cornflowerblue 34 | , cornsilk 35 | , crimson 36 | , cyan 37 | , darkblue 38 | , darkcyan 39 | , darkgoldenrod 40 | , darkgray 41 | , darkgreen 42 | , darkgrey 43 | , darkkhaki 44 | , darkmagenta 45 | , darkolivegreen 46 | , darkorange 47 | , darkorchid 48 | , darkred 49 | , darksalmon 50 | , darkseagreen 51 | , darkslateblue 52 | , darkslategray 53 | , darkslategrey 54 | , darkturquoise 55 | , darkviolet 56 | , deeppink 57 | , deepskyblue 58 | , dimgray 59 | , dimgrey 60 | , dodgerblue 61 | , firebrick 62 | , floralwhite 63 | , forestgreen 64 | , fuchsia 65 | , gainsboro 66 | , ghostwhite 67 | , gold 68 | , goldenrod 69 | , gray 70 | , grey 71 | , green 72 | , greenyellow 73 | , honeydew 74 | , hotpink 75 | , indianred 76 | , indigo 77 | , ivory 78 | , khaki 79 | , lavender 80 | , lavenderblush 81 | , lawngreen 82 | , lemonchiffon 83 | , lightblue 84 | , lightcoral 85 | , lightcyan 86 | , lightgoldenrodyellow 87 | , lightgray 88 | , lightgreen 89 | , lightgrey 90 | , lightpink 91 | , lightsalmon 92 | , lightseagreen 93 | , lightskyblue 94 | , lightslategray 95 | , lightslategrey 96 | , lightsteelblue 97 | , lightyellow 98 | , lime 99 | , limegreen 100 | , linen 101 | , magenta 102 | , maroon 103 | , mediumaquamarine 104 | , mediumblue 105 | , mediumorchid 106 | , mediumpurple 107 | , mediumseagreen 108 | , mediumslateblue 109 | , mediumspringgreen 110 | , mediumturquoise 111 | , mediumvioletred 112 | , midnightblue 113 | , mintcream 114 | , mistyrose 115 | , moccasin 116 | , navajowhite 117 | , navy 118 | , oldlace 119 | , olive 120 | , olivedrab 121 | , orange 122 | , orangered 123 | , orchid 124 | , palegoldenrod 125 | , palegreen 126 | , paleturquoise 127 | , palevioletred 128 | , papayawhip 129 | , peachpuff 130 | , peru 131 | , pink 132 | , plum 133 | , powderblue 134 | , purple 135 | , red 136 | , rosybrown 137 | , royalblue 138 | , saddlebrown 139 | , salmon 140 | , sandybrown 141 | , seagreen 142 | , seashell 143 | , sienna 144 | , silver 145 | , skyblue 146 | , slateblue 147 | , slategray 148 | , slategrey 149 | , snow 150 | , springgreen 151 | , steelblue 152 | , tan 153 | , teal 154 | , thistle 155 | , tomato 156 | , turquoise 157 | , violet 158 | , wheat 159 | , white 160 | , whitesmoke 161 | , yellow 162 | , yellowgreen 163 | ) 164 | where 165 | 166 | import Graphics.Static.Types 167 | import Prelude hiding (tan) 168 | 169 | aliceblue :: Style 170 | aliceblue = ColorStyle $ RGB 240 248 255 171 | 172 | antiquewhite :: Style 173 | antiquewhite = ColorStyle $ RGB 250 235 215 174 | 175 | aqua :: Style 176 | aqua = ColorStyle $ RGB 0 255 255 177 | 178 | aquamarine :: Style 179 | aquamarine = ColorStyle $ RGB 127 255 212 180 | 181 | azure :: Style 182 | azure = ColorStyle $ RGB 240 255 255 183 | 184 | beige :: Style 185 | beige = ColorStyle $ RGB 245 245 220 186 | 187 | bisque :: Style 188 | bisque = ColorStyle $ RGB 255 228 196 189 | 190 | black :: Style 191 | black = ColorStyle $ RGB 0 0 0 192 | 193 | blanchedalmond :: Style 194 | blanchedalmond = ColorStyle $ RGB 255 235 205 195 | 196 | blue :: Style 197 | blue = ColorStyle $ RGB 0 0 255 198 | 199 | blueviolet :: Style 200 | blueviolet = ColorStyle $ RGB 138 43 226 201 | 202 | brown :: Style 203 | brown = ColorStyle $ RGB 165 42 42 204 | 205 | burlywood :: Style 206 | burlywood = ColorStyle $ RGB 222 184 135 207 | 208 | cadetblue :: Style 209 | cadetblue = ColorStyle $ RGB 95 158 160 210 | 211 | chartreuse :: Style 212 | chartreuse = ColorStyle $ RGB 127 255 0 213 | 214 | chocolate :: Style 215 | chocolate = ColorStyle $ RGB 210 105 30 216 | 217 | coral :: Style 218 | coral = ColorStyle $ RGB 255 127 80 219 | 220 | cornflowerblue :: Style 221 | cornflowerblue = ColorStyle $ RGB 100 149 237 222 | 223 | cornsilk :: Style 224 | cornsilk = ColorStyle $ RGB 255 248 220 225 | 226 | crimson :: Style 227 | crimson = ColorStyle $ RGB 220 20 60 228 | 229 | cyan :: Style 230 | cyan = ColorStyle $ RGB 0 255 255 231 | 232 | darkblue :: Style 233 | darkblue = ColorStyle $ RGB 0 0 139 234 | 235 | darkcyan :: Style 236 | darkcyan = ColorStyle $ RGB 0 139 139 237 | 238 | darkgoldenrod :: Style 239 | darkgoldenrod = ColorStyle $ RGB 184 134 11 240 | 241 | darkgray :: Style 242 | darkgray = ColorStyle $ RGB 169 169 169 243 | 244 | darkgreen :: Style 245 | darkgreen = ColorStyle $ RGB 0 100 0 246 | 247 | darkgrey :: Style 248 | darkgrey = ColorStyle $ RGB 169 169 169 249 | 250 | darkkhaki :: Style 251 | darkkhaki = ColorStyle $ RGB 189 183 107 252 | 253 | darkmagenta :: Style 254 | darkmagenta = ColorStyle $ RGB 139 0 139 255 | 256 | darkolivegreen :: Style 257 | darkolivegreen = ColorStyle $ RGB 85 107 47 258 | 259 | darkorange :: Style 260 | darkorange = ColorStyle $ RGB 255 140 0 261 | 262 | darkorchid :: Style 263 | darkorchid = ColorStyle $ RGB 153 50 204 264 | 265 | darkred :: Style 266 | darkred = ColorStyle $ RGB 139 0 0 267 | 268 | darksalmon :: Style 269 | darksalmon = ColorStyle $ RGB 233 150 122 270 | 271 | darkseagreen :: Style 272 | darkseagreen = ColorStyle $ RGB 143 188 143 273 | 274 | darkslateblue :: Style 275 | darkslateblue = ColorStyle $ RGB 72 61 139 276 | 277 | darkslategray :: Style 278 | darkslategray = ColorStyle $ RGB 47 79 79 279 | 280 | darkslategrey :: Style 281 | darkslategrey = ColorStyle $ RGB 47 79 79 282 | 283 | darkturquoise :: Style 284 | darkturquoise = ColorStyle $ RGB 0 206 209 285 | 286 | darkviolet :: Style 287 | darkviolet = ColorStyle $ RGB 148 0 211 288 | 289 | deeppink :: Style 290 | deeppink = ColorStyle $ RGB 255 20 147 291 | 292 | deepskyblue :: Style 293 | deepskyblue = ColorStyle $ RGB 0 191 255 294 | 295 | dimgray :: Style 296 | dimgray = ColorStyle $ RGB 105 105 105 297 | 298 | dimgrey :: Style 299 | dimgrey = ColorStyle $ RGB 105 105 105 300 | 301 | dodgerblue :: Style 302 | dodgerblue = ColorStyle $ RGB 30 144 255 303 | 304 | firebrick :: Style 305 | firebrick = ColorStyle $ RGB 178 34 34 306 | 307 | floralwhite :: Style 308 | floralwhite = ColorStyle $ RGB 255 250 240 309 | 310 | forestgreen :: Style 311 | forestgreen = ColorStyle $ RGB 34 139 34 312 | 313 | fuchsia :: Style 314 | fuchsia = ColorStyle $ RGB 255 0 255 315 | 316 | gainsboro :: Style 317 | gainsboro = ColorStyle $ RGB 220 220 220 318 | 319 | ghostwhite :: Style 320 | ghostwhite = ColorStyle $ RGB 248 248 255 321 | 322 | gold :: Style 323 | gold = ColorStyle $ RGB 255 215 0 324 | 325 | goldenrod :: Style 326 | goldenrod = ColorStyle $ RGB 218 165 32 327 | 328 | gray :: Style 329 | gray = ColorStyle $ RGB 128 128 128 330 | 331 | grey :: Style 332 | grey = ColorStyle $ RGB 128 128 128 333 | 334 | green :: Style 335 | green = ColorStyle $ RGB 0 128 0 336 | 337 | greenyellow :: Style 338 | greenyellow = ColorStyle $ RGB 173 255 47 339 | 340 | honeydew :: Style 341 | honeydew = ColorStyle $ RGB 240 255 240 342 | 343 | hotpink :: Style 344 | hotpink = ColorStyle $ RGB 255 105 180 345 | 346 | indianred :: Style 347 | indianred = ColorStyle $ RGB 205 92 92 348 | 349 | indigo :: Style 350 | indigo = ColorStyle $ RGB 75 0 130 351 | 352 | ivory :: Style 353 | ivory = ColorStyle $ RGB 255 255 240 354 | 355 | khaki :: Style 356 | khaki = ColorStyle $ RGB 240 230 140 357 | 358 | lavender :: Style 359 | lavender = ColorStyle $ RGB 230 230 250 360 | 361 | lavenderblush :: Style 362 | lavenderblush = ColorStyle $ RGB 255 240 245 363 | 364 | lawngreen :: Style 365 | lawngreen = ColorStyle $ RGB 124 252 0 366 | 367 | lemonchiffon :: Style 368 | lemonchiffon = ColorStyle $ RGB 255 250 205 369 | 370 | lightblue :: Style 371 | lightblue = ColorStyle $ RGB 173 216 230 372 | 373 | lightcoral :: Style 374 | lightcoral = ColorStyle $ RGB 240 128 128 375 | 376 | lightcyan :: Style 377 | lightcyan = ColorStyle $ RGB 224 255 255 378 | 379 | lightgoldenrodyellow :: Style 380 | lightgoldenrodyellow = ColorStyle $ RGB 250 250 210 381 | 382 | lightgray :: Style 383 | lightgray = ColorStyle $ RGB 211 211 211 384 | 385 | lightgreen :: Style 386 | lightgreen = ColorStyle $ RGB 144 238 144 387 | 388 | lightgrey :: Style 389 | lightgrey = ColorStyle $ RGB 211 211 211 390 | 391 | lightpink :: Style 392 | lightpink = ColorStyle $ RGB 255 182 193 393 | 394 | lightsalmon :: Style 395 | lightsalmon = ColorStyle $ RGB 255 160 122 396 | 397 | lightseagreen :: Style 398 | lightseagreen = ColorStyle $ RGB 32 178 170 399 | 400 | lightskyblue :: Style 401 | lightskyblue = ColorStyle $ RGB 135 206 250 402 | 403 | lightslategray :: Style 404 | lightslategray = ColorStyle $ RGB 119 136 153 405 | 406 | lightslategrey :: Style 407 | lightslategrey = ColorStyle $ RGB 119 136 153 408 | 409 | lightsteelblue :: Style 410 | lightsteelblue = ColorStyle $ RGB 176 196 222 411 | 412 | lightyellow :: Style 413 | lightyellow = ColorStyle $ RGB 255 255 224 414 | 415 | lime :: Style 416 | lime = ColorStyle $ RGB 0 255 0 417 | 418 | limegreen :: Style 419 | limegreen = ColorStyle $ RGB 50 205 50 420 | 421 | linen :: Style 422 | linen = ColorStyle $ RGB 250 240 230 423 | 424 | magenta :: Style 425 | magenta = ColorStyle $ RGB 255 0 255 426 | 427 | maroon :: Style 428 | maroon = ColorStyle $ RGB 128 0 0 429 | 430 | mediumaquamarine :: Style 431 | mediumaquamarine = ColorStyle $ RGB 102 205 170 432 | 433 | mediumblue :: Style 434 | mediumblue = ColorStyle $ RGB 0 0 205 435 | 436 | mediumorchid :: Style 437 | mediumorchid = ColorStyle $ RGB 186 85 211 438 | 439 | mediumpurple :: Style 440 | mediumpurple = ColorStyle $ RGB 147 112 219 441 | 442 | mediumseagreen :: Style 443 | mediumseagreen = ColorStyle $ RGB 60 179 113 444 | 445 | mediumslateblue :: Style 446 | mediumslateblue = ColorStyle $ RGB 123 104 238 447 | 448 | mediumspringgreen :: Style 449 | mediumspringgreen = ColorStyle $ RGB 0 250 154 450 | 451 | mediumturquoise :: Style 452 | mediumturquoise = ColorStyle $ RGB 72 209 204 453 | 454 | mediumvioletred :: Style 455 | mediumvioletred = ColorStyle $ RGB 199 21 133 456 | 457 | midnightblue :: Style 458 | midnightblue = ColorStyle $ RGB 25 25 112 459 | 460 | mintcream :: Style 461 | mintcream = ColorStyle $ RGB 245 255 250 462 | 463 | mistyrose :: Style 464 | mistyrose = ColorStyle $ RGB 255 228 225 465 | 466 | moccasin :: Style 467 | moccasin = ColorStyle $ RGB 255 228 181 468 | 469 | navajowhite :: Style 470 | navajowhite = ColorStyle $ RGB 255 222 173 471 | 472 | navy :: Style 473 | navy = ColorStyle $ RGB 0 0 128 474 | 475 | oldlace :: Style 476 | oldlace = ColorStyle $ RGB 253 245 230 477 | 478 | olive :: Style 479 | olive = ColorStyle $ RGB 128 128 0 480 | 481 | olivedrab :: Style 482 | olivedrab = ColorStyle $ RGB 107 142 35 483 | 484 | orange :: Style 485 | orange = ColorStyle $ RGB 255 165 0 486 | 487 | orangered :: Style 488 | orangered = ColorStyle $ RGB 255 69 0 489 | 490 | orchid :: Style 491 | orchid = ColorStyle $ RGB 218 112 214 492 | 493 | palegoldenrod :: Style 494 | palegoldenrod = ColorStyle $ RGB 238 232 170 495 | 496 | palegreen :: Style 497 | palegreen = ColorStyle $ RGB 152 251 152 498 | 499 | paleturquoise :: Style 500 | paleturquoise = ColorStyle $ RGB 175 238 238 501 | 502 | palevioletred :: Style 503 | palevioletred = ColorStyle $ RGB 219 112 147 504 | 505 | papayawhip :: Style 506 | papayawhip = ColorStyle $ RGB 255 239 213 507 | 508 | peachpuff :: Style 509 | peachpuff = ColorStyle $ RGB 255 218 185 510 | 511 | peru :: Style 512 | peru = ColorStyle $ RGB 205 133 63 513 | 514 | pink :: Style 515 | pink = ColorStyle $ RGB 255 192 203 516 | 517 | plum :: Style 518 | plum = ColorStyle $ RGB 221 160 221 519 | 520 | powderblue :: Style 521 | powderblue = ColorStyle $ RGB 176 224 230 522 | 523 | purple :: Style 524 | purple = ColorStyle $ RGB 128 0 128 525 | 526 | red :: Style 527 | red = ColorStyle $ RGB 255 0 0 528 | 529 | rosybrown :: Style 530 | rosybrown = ColorStyle $ RGB 188 143 143 531 | 532 | royalblue :: Style 533 | royalblue = ColorStyle $ RGB 65 105 225 534 | 535 | saddlebrown :: Style 536 | saddlebrown = ColorStyle $ RGB 139 69 19 537 | 538 | salmon :: Style 539 | salmon = ColorStyle $ RGB 250 128 114 540 | 541 | sandybrown :: Style 542 | sandybrown = ColorStyle $ RGB 244 164 96 543 | 544 | seagreen :: Style 545 | seagreen = ColorStyle $ RGB 46 139 87 546 | 547 | seashell :: Style 548 | seashell = ColorStyle $ RGB 255 245 238 549 | 550 | sienna :: Style 551 | sienna = ColorStyle $ RGB 160 82 45 552 | 553 | silver :: Style 554 | silver = ColorStyle $ RGB 192 192 192 555 | 556 | skyblue :: Style 557 | skyblue = ColorStyle $ RGB 135 206 235 558 | 559 | slateblue :: Style 560 | slateblue = ColorStyle $ RGB 106 90 205 561 | 562 | slategray :: Style 563 | slategray = ColorStyle $ RGB 112 128 144 564 | 565 | slategrey :: Style 566 | slategrey = ColorStyle $ RGB 112 128 144 567 | 568 | snow :: Style 569 | snow = ColorStyle $ RGB 255 250 250 570 | 571 | springgreen :: Style 572 | springgreen = ColorStyle $ RGB 0 255 127 573 | 574 | steelblue :: Style 575 | steelblue = ColorStyle $ RGB 70 130 180 576 | 577 | tan :: Style 578 | tan = ColorStyle $ RGB 210 180 140 579 | 580 | teal :: Style 581 | teal = ColorStyle $ RGB 0 128 128 582 | 583 | thistle :: Style 584 | thistle = ColorStyle $ RGB 216 191 216 585 | 586 | tomato :: Style 587 | tomato = ColorStyle $ RGB 255 99 71 588 | 589 | turquoise :: Style 590 | turquoise = ColorStyle $ RGB 64 224 208 591 | 592 | violet :: Style 593 | violet = ColorStyle $ RGB 238 130 238 594 | 595 | wheat :: Style 596 | wheat = ColorStyle $ RGB 245 222 179 597 | 598 | white :: Style 599 | white = ColorStyle $ RGB 255 255 255 600 | 601 | whitesmoke :: Style 602 | whitesmoke = ColorStyle $ RGB 245 245 245 603 | 604 | yellow :: Style 605 | yellow = ColorStyle $ RGB 255 255 0 606 | 607 | yellowgreen :: Style 608 | yellowgreen = ColorStyle $ RGB 154 205 50 609 | -------------------------------------------------------------------------------- /src/Graphics/Static/Interpreter.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE RankNTypes #-} 5 | ------------------------------------------------------------------------------- 6 | -- | 7 | -- Module : Graphics.Static.Interpreter 8 | -- Copyright : (c) 2015 Jeffrey Rosenbluth 9 | -- License : BSD-style (see LICENSE) 10 | -- Maintainer : jeffrey.rosenbluth@gmail.com 11 | -- 12 | -- Interpreter to convert a static-canvas representation to js. 13 | -- 14 | ------------------------------------------------------------------------------- 15 | 16 | module Graphics.Static.Interpreter 17 | ( evalScript 18 | ) where 19 | 20 | import Control.Monad.Free (Free(..)) 21 | import Control.Monad.Free.Church 22 | import Control.Monad.State 23 | import Control.Monad.Writer 24 | import Data.Text (Text) 25 | import Data.Text.Lazy.Builder (Builder, fromText, singleton) 26 | import Graphics.Static.Javascript 27 | import Graphics.Static.Types 28 | 29 | -- | Evaluate a static-canvas program and return the javascript code in a 'Builder'. 30 | -- The first parameter should be a unique identifier to avoid name clashes with 31 | -- other canvas elements in the html document. 32 | evalScript :: Text -> MFC a -> Builder 33 | evalScript t mfc = (evalState . execWriterT . runScript . eval t) fc 0 34 | where 35 | fc = improve mfc 36 | 37 | record :: [Builder] -> Script () 38 | record = tell . mconcat 39 | 40 | inc :: Script Int 41 | inc = do 42 | n <- get 43 | put (n + 1) 44 | return n 45 | 46 | -------------------------------------------------------------------------------- 47 | 48 | eval :: Text -> Free Canvas a -> Script a 49 | eval uniqId freeCanvas = go freeCanvas 50 | where 51 | go :: Free Canvas a -> Script a 52 | go = \case 53 | Free (AddColorStop a1 a2 a3 c) -> do 54 | record [ jsStyle a3, ".addColorStop(" 55 | , jsDouble a1, comma, jsColor a2, ");"] 56 | go c 57 | 58 | Free (Arc a1 a2 a3 a4 a5 a6 c) -> do 59 | record [ fromText uniqId, "Ctx.arc(" 60 | , jsDouble a1, comma, jsDouble a2, comma 61 | , jsDouble a3, comma, jsDouble a4, comma 62 | , jsDouble a5, comma, jsBool a6 , ");"] 63 | go c 64 | 65 | Free (ArcTo a1 a2 a3 a4 a5 c) -> do 66 | record [ fromText uniqId, "Ctx.arcTo(" 67 | , jsDouble a1, comma, jsDouble a2, comma 68 | , jsDouble a3, comma, jsDouble a4, comma 69 | , jsDouble a5, comma, ");"] 70 | go c 71 | 72 | Free (BeginPath c) -> do 73 | record [fromText uniqId, "Ctx.beginPath();"] 74 | go c 75 | 76 | Free (BezierCurveTo a1 a2 a3 a4 a5 a6 c) -> do 77 | record [ fromText uniqId, "Ctx.bezierCurveTo(" 78 | , jsDouble a1, comma, jsDouble a2, comma 79 | , jsDouble a3, comma, jsDouble a4, comma 80 | , jsDouble a5, comma, jsDouble a6, ");"] 81 | go c 82 | 83 | Free (ClearRect a1 a2 a3 a4 c) -> do 84 | record [ fromText uniqId, "Ctx.clearRect(" 85 | , jsDouble a1, comma, jsDouble a2, comma 86 | , jsDouble a3, comma, jsDouble a4, ");"] 87 | go c 88 | 89 | Free (Clip c) -> do 90 | record [fromText uniqId, "Ctx.clip();"] 91 | go c 92 | 93 | Free (ClosePath c) -> do 94 | record [fromText uniqId, "Ctx.closePath();"] 95 | go c 96 | 97 | Free (CreateLinearGradient a1 a2 a3 a4 k) -> do 98 | i <- inc 99 | record [ "var gradient_", jsInt i, " = ", fromText uniqId 100 | , "Ctx.createLinearGradient(" 101 | , jsDouble a1, comma, jsDouble a2, comma 102 | , jsDouble a3, comma, jsDouble a4, ");"] 103 | go $ k (GradientStyle (LG i)) 104 | 105 | Free (CreatePattern a1 a2 k) -> do 106 | i <- inc 107 | record [ "var pattern_", jsInt i, " = ", fromText uniqId 108 | , "Ctx.createPattern(image_" 109 | , jsInt a1, comma, jsRepeat a2, ");"] 110 | go $ k (PatternStyle i) 111 | 112 | Free (CreateRadialGradient a1 a2 a3 a4 a5 a6 k) -> do 113 | i <- inc 114 | record [ "var gradient_", jsInt i, " = ", fromText uniqId 115 | , "Ctx.createRadialGradient(" 116 | , jsDouble a1, comma, jsDouble a2, comma 117 | , jsDouble a3, comma, jsDouble a4, comma 118 | , jsDouble a5, comma, jsDouble a6, ");"] 119 | go $ k (GradientStyle (RG i)) 120 | 121 | Free (DrawImageAt a1 a2 a3 c) -> do 122 | record [ fromText uniqId, "Ctx.drawImage(image_", jsInt a1, comma 123 | , jsDouble a2, comma, jsDouble a3, ");"] 124 | go c 125 | 126 | Free (DrawImageSize a1 a2 a3 a4 a5 c) -> do 127 | record [ fromText uniqId, "Ctx.drawImage(image_", jsInt a1, comma 128 | , jsDouble a2, comma, jsDouble a3, comma 129 | , jsDouble a4, comma, jsDouble a5, ");"] 130 | go c 131 | 132 | Free (DrawImageCrop a1 a2 a3 a4 a5 a6 a7 a8 a9 c) -> do 133 | record [ fromText uniqId, "Ctx.drawImage(image_", jsInt a1, comma 134 | , jsDouble a2, comma, jsDouble a3, comma 135 | , jsDouble a4, comma, jsDouble a5, comma 136 | , jsDouble a6, comma, jsDouble a7, comma 137 | , jsDouble a8, comma, jsDouble a9, ");"] 138 | go c 139 | 140 | Free (Ellipse a1 a2 a3 a4 a5 a6 a7 a8 c) -> do 141 | record [ fromText uniqId, "Ctx.ellipse(", jsDouble a1, comma 142 | , jsDouble a2, comma, jsDouble a3, comma 143 | , jsDouble a4, comma, jsDouble a5, comma 144 | , jsDouble a6, comma, jsDouble a7, comma 145 | , jsBool a8, ");"] 146 | go c 147 | 148 | Free (Fill c) -> do 149 | record [ fromText uniqId, "Ctx.fill();"] 150 | go c 151 | 152 | Free (FillRect a1 a2 a3 a4 c) -> do 153 | record [ fromText uniqId, "Ctx.fillRect(" 154 | , jsDouble a1, comma, jsDouble a2, comma 155 | , jsDouble a3, comma, jsDouble a4, ");"] 156 | go c 157 | 158 | Free (FillStyle a1 c) -> do 159 | record [fromText uniqId, "Ctx.fillStyle = (", jsStyle a1, ");"] 160 | go c 161 | 162 | Free (FillText a1 a2 a3 c) -> do 163 | record [ fromText uniqId, "Ctx.fillText('", fromText a1 164 | , singleton '\'', comma , jsDouble a2, comma 165 | , jsDouble a3, ");"] 166 | go c 167 | 168 | Free (Font a1 c) -> do 169 | record [fromText uniqId, "Ctx.font = ('", fromText a1, "');"] 170 | go c 171 | 172 | Free (GlobalAlpha a1 c) -> do 173 | record [fromText uniqId, "Ctx.globalAlpha = (", jsDouble a1, ");"] 174 | go c 175 | 176 | Free (GlobalCompositeOperation a1 c) -> do 177 | record [ fromText uniqId, "Ctx.globalCompositeOperation = ('" 178 | , jsComposite a1, "');"] 179 | go c 180 | 181 | Free (LineCap a1 c) -> do 182 | record [fromText uniqId, "Ctx.lineCap = ('", jsLineCap a1, "');"] 183 | go c 184 | 185 | Free (LineDash as c) -> do 186 | record [fromText uniqId, "Ctx.setLineDash(", jsListDouble as, ");"] 187 | go c 188 | 189 | Free (LineJoin a1 c) -> do 190 | record [fromText uniqId, "Ctx.lineJoin = ('", jsLineJoin a1, "');"] 191 | go c 192 | 193 | Free (LineTo a1 a2 c) -> do 194 | record [ fromText uniqId, "Ctx.lineTo(", jsDouble a1, comma 195 | , jsDouble a2, ");"] 196 | go c 197 | 198 | Free (LineWidth a1 c) -> do 199 | record [fromText uniqId, "Ctx.lineWidth = (", jsDouble a1, ");"] 200 | go c 201 | 202 | Free (MiterLimit a1 c) -> do 203 | record [fromText uniqId, "Ctx.miterLimit = (", jsDouble a1, ");"] 204 | go c 205 | 206 | Free (MoveTo a1 a2 c) -> do 207 | record [ fromText uniqId, "Ctx.moveTo(", jsDouble a1, comma 208 | , jsDouble a2, ");"] 209 | go c 210 | 211 | Free (NewImage a1 k) -> do 212 | i <- inc 213 | record [ "var image_", jsInt i, " = new Image(); image_" 214 | , jsInt i, ".src = ('", fromText a1, "');"] 215 | go (k i) 216 | 217 | Free (OnImageLoad a1 a2 c) -> do 218 | record [ "image_", jsInt a1, ".onload = function() {" 219 | , evalScript uniqId a2, "};"] 220 | go c 221 | 222 | Free (QuadraticCurveTo a1 a2 a3 a4 c) -> do 223 | record [ fromText uniqId, "Ctx.quadraticCurveTo(" 224 | , jsDouble a1, comma, jsDouble a2, comma 225 | , jsDouble a3, comma, jsDouble a4, ");"] 226 | go c 227 | 228 | Free (Rect a1 a2 a3 a4 c) -> do 229 | record [ fromText uniqId, "Ctx.rect(", jsDouble a1, comma 230 | , jsDouble a2, comma 231 | , jsDouble a3, comma 232 | , jsDouble a4, ");"] 233 | go c 234 | 235 | Free (Restore c) -> do 236 | record [fromText uniqId, "Ctx.restore();"] 237 | go c 238 | 239 | Free (Rotate a1 c) -> do 240 | record [fromText uniqId, "Ctx.rotate(", jsDouble a1, ");"] 241 | go c 242 | 243 | Free (Save c) -> do 244 | record [fromText uniqId, "Ctx.save();"] 245 | go c 246 | 247 | Free (Scale a1 a2 c) -> do 248 | record [fromText uniqId, "Ctx.scale(", jsDouble a1, comma 249 | , jsDouble a2, ");"] 250 | go c 251 | 252 | Free (SetTransform a1 a2 a3 a4 a5 a6 c) -> do 253 | record [ fromText uniqId, "Ctx.setTransform(" 254 | , jsDouble a1, comma, jsDouble a2, comma 255 | , jsDouble a3, comma, jsDouble a4, comma 256 | , jsDouble a5, comma, jsDouble a6, ");"] 257 | go c 258 | 259 | Free (ShadowColor a1 c) -> do 260 | record [fromText uniqId, "Ctx.shadowColor = ('", jsColor a1, "');"] 261 | go c 262 | 263 | Free (ShadowBlur a1 c) -> do 264 | record [fromText uniqId, "Ctx.shadowBlur = (", jsDouble a1, ");"] 265 | go c 266 | 267 | Free (ShadowOffsetX a1 c) -> do 268 | record [fromText uniqId, "Ctx.shadowOffsetX = (", jsDouble a1, ");"] 269 | go c 270 | 271 | Free (ShadowOffsetY a1 c) -> do 272 | record [fromText uniqId, "Ctx.shadowOffsetY = (", jsDouble a1, ");"] 273 | go c 274 | 275 | Free (Stroke c) -> do 276 | record [fromText uniqId, "Ctx.stroke();"] 277 | go c 278 | 279 | Free (StrokeRect a1 a2 a3 a4 c) -> do 280 | record [ fromText uniqId, "Ctx.strokeRect(" 281 | , jsDouble a1, comma, jsDouble a2, comma 282 | , jsDouble a3, comma, jsDouble a4, ");"] 283 | go c 284 | 285 | Free (StrokeStyle a1 c) -> do 286 | record [fromText uniqId, "Ctx.strokeStyle = (", jsStyle a1, ");"] 287 | go c 288 | 289 | Free (StrokeText a1 a2 a3 c) -> do 290 | record [ fromText uniqId, "Ctx.strokeText('", fromText a1 291 | , singleton '\'' , comma, jsDouble a2, comma 292 | , jsDouble a3, ");"] 293 | go c 294 | 295 | Free (TextAlign a1 c) -> do 296 | record [fromText uniqId, "Ctx.textAlign = ('", jsTextAlign a1, "');"] 297 | go c 298 | 299 | Free (TextBaseline a1 c) -> do 300 | record [ fromText uniqId, "Ctx.textBaseline = ('" 301 | , jsTextBaseline a1, "');"] 302 | go c 303 | 304 | Free (Transform a1 a2 a3 a4 a5 a6 c) -> do 305 | record [ fromText uniqId, "Ctx.transform(" 306 | , jsDouble a1, comma, jsDouble a2, comma 307 | , jsDouble a3, comma, jsDouble a4, comma 308 | , jsDouble a5, comma, jsDouble a6, ");"] 309 | go c 310 | 311 | Free (Translate a1 a2 c) -> do 312 | record [ fromText uniqId, "Ctx.translate(", jsDouble a1, comma 313 | , jsDouble a2, ");"] 314 | go c 315 | 316 | Pure x -> return x 317 | -------------------------------------------------------------------------------- /src/Graphics/Static/Javascript.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | ------------------------------------------------------------------------------- 4 | -- | 5 | -- Module : Graphics.Static.Javascript 6 | -- Copyright : (c) 2015 Jeffrey Rosenbluth 7 | -- License : BSD-style (see LICENSE) 8 | -- Maintainer : jeffrey.rosenbluth@gmail.com 9 | -- 10 | -- DSL for creating HTML5 Canvas. 11 | -- 12 | ------------------------------------------------------------------------------- 13 | 14 | module Graphics.Static.Javascript 15 | ( 16 | jsBool 17 | , jsInt 18 | , jsDouble 19 | , jsColor 20 | , jsStyle 21 | , jsLineCap 22 | , jsLineJoin 23 | , jsListDouble 24 | , jsTextAlign 25 | , jsTextBaseline 26 | , jsRepeat 27 | , jsComposite 28 | , comma 29 | ) where 30 | 31 | import Data.Double.Conversion.Text (toFixed) 32 | import Data.List (foldl1') 33 | import Data.Text (pack) 34 | import Data.Text.Lazy.Builder (Builder, fromText, singleton) 35 | import Graphics.Static.Types 36 | 37 | build :: Show a => a -> Builder 38 | build = fromText . pack . show 39 | 40 | comma :: Builder 41 | comma = singleton ',' 42 | 43 | quote :: Builder -> Builder 44 | quote b = singleton '\'' <> b <> singleton '\'' 45 | 46 | jsBool :: Bool -> Builder 47 | jsBool True = "true" 48 | jsBool False = "false" 49 | 50 | jsInt :: Int -> Builder 51 | jsInt = fromText . pack . show 52 | 53 | jsDouble :: Double -> Builder 54 | jsDouble = fromText . toFixed 4 55 | 56 | jsListDouble :: [Double] -> Builder 57 | jsListDouble [] = "[]" 58 | jsListDouble ds = "[" <> foldl1' combine (jsDouble <$> ds) <> "]" 59 | where 60 | combine a b = a <> ", " <> b 61 | 62 | jsColor :: Color -> Builder 63 | jsColor (Hex t) = quote . fromText $ t 64 | jsColor (RGB r g b) = quote $ "rgb(" <> (build r) 65 | <> comma <> (build g) 66 | <> comma <> (build b) <> singleton ')' 67 | jsColor (RGBA r g b a) = quote $ "rgba(" <> (build r) 68 | <> comma <> (build g) 69 | <> comma <> (build b) 70 | <> comma <> (jsDouble a) <> singleton ')' 71 | 72 | jsStyle :: Style -> Builder 73 | jsStyle (ColorStyle c) = jsColor c 74 | jsStyle (GradientStyle (LG n)) = "gradient_" <> (build n) 75 | jsStyle (GradientStyle (RG n)) = "gradient_" <> (build n) 76 | jsStyle (PatternStyle n) = "pattern_" <> (build n) 77 | 78 | jsLineCap :: LineCapStyle -> Builder 79 | jsLineCap LineCapButt = "butt" 80 | jsLineCap LineCapRound = "round" 81 | jsLineCap LineCapSquare = "square" 82 | 83 | jsLineJoin :: LineJoinStyle -> Builder 84 | jsLineJoin LineJoinMiter = "miter" 85 | jsLineJoin LineJoinRound = "round" 86 | jsLineJoin LineJoinBevel = "bevel" 87 | 88 | jsTextAlign :: TextAlignStyle -> Builder 89 | jsTextAlign TextAlignStart = "start" 90 | jsTextAlign TextAlignEnd = "end" 91 | jsTextAlign TextAlignCenter = "center" 92 | jsTextAlign TextAlignLeft = "left" 93 | jsTextAlign TextAlignRight = "right" 94 | 95 | jsTextBaseline :: TextBaselineStyle -> Builder 96 | jsTextBaseline TextBaselineTop = "top" 97 | jsTextBaseline TextBaselineHanging = "hanging" 98 | jsTextBaseline TextBaselineMiddle = "middle" 99 | jsTextBaseline TextBaselineIdeographic = "ideographic" 100 | jsTextBaseline TextBaselineBottom = "bottom" 101 | 102 | jsRepeat :: RepeatStyle -> Builder 103 | jsRepeat Repeat = quote "repeat" 104 | jsRepeat RepeatX = quote "repeat-x" 105 | jsRepeat RepeatY = quote "repeat-y" 106 | jsRepeat NoRepeat = quote "no-repeat" 107 | 108 | jsComposite :: CompositeOperation -> Builder 109 | jsComposite SourceAtop = "source-atop" 110 | jsComposite SourceIn = "source-in" 111 | jsComposite SourceOut = "source-out" 112 | jsComposite SourceOver = "source-over" 113 | jsComposite DestinationAtop = "destination-atop" 114 | jsComposite DestinationIn = "destination-in" 115 | jsComposite DestinationOut = "destination-out" 116 | jsComposite DestinationOver = "destination-over" 117 | jsComposite Darker = "darker" 118 | jsComposite Xor = "xor" 119 | jsComposite Copy = "copy" 120 | -------------------------------------------------------------------------------- /src/Graphics/Static/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE RankNTypes #-} 6 | {-# LANGUAGE StrictData #-} 7 | 8 | ------------------------------------------------------------------------------- 9 | -- | 10 | -- Module : Graphics.Static.Types 11 | -- Copyright : (c) 2015 Jeffrey Rosenbluth 12 | -- License : BSD-style (see LICENSE) 13 | -- Maintainer : jeffrey.rosenbluth@gmail.com 14 | -- 15 | -- A small DSL for creating HTML5 Canvas. 16 | -- 17 | ------------------------------------------------------------------------------- 18 | 19 | module Graphics.Static.Types where 20 | 21 | import Control.Monad.Free.Class 22 | import Control.Monad.State 23 | import Control.Monad.Writer 24 | import Data.Text (Text) 25 | import Data.Text.Lazy.Builder (Builder) 26 | 27 | newtype Script a = Script {runScript :: (WriterT Builder (State Int) a)} 28 | deriving (Functor, Applicative, Monad, MonadWriter Builder, MonadState Int) 29 | 30 | -- | MonadFree Canvas 31 | type MFC a = (forall m. MonadFree Canvas m => m a) 32 | 33 | data Canvas r 34 | = AddColorStop Double Color Style r 35 | | Arc Double Double Double Double Double Bool r 36 | | ArcTo Double Double Double Double Double r 37 | | BeginPath r 38 | | BezierCurveTo Double Double Double Double Double Double r 39 | | ClearRect Double Double Double Double r 40 | | Clip r 41 | | ClosePath r 42 | | CreateLinearGradient Double Double Double Double (Style -> r) 43 | | CreatePattern Int RepeatStyle (Style -> r) 44 | | CreateRadialGradient Double Double Double Double Double Double (Style -> r) 45 | | DrawImageAt Int Double Double r 46 | | DrawImageSize Int Double Double Double Double r 47 | | DrawImageCrop Int Double Double Double Double Double Double Double Double r 48 | | Ellipse Double Double Double Double Double Double Double Bool r 49 | | Fill r 50 | | FillRect Double Double Double Double r 51 | | FillStyle Style r 52 | | FillText Text Double Double r 53 | | Font Text r 54 | | GlobalAlpha Double r 55 | | GlobalCompositeOperation CompositeOperation r 56 | | LineCap LineCapStyle r 57 | | LineDash [Double] r 58 | | LineJoin LineJoinStyle r 59 | | LineTo Double Double r 60 | | LineWidth Double r 61 | | MiterLimit Double r 62 | | MoveTo Double Double r 63 | | NewImage Text (Int -> r) 64 | | OnImageLoad Int (MFC ()) r 65 | | QuadraticCurveTo Double Double Double Double r 66 | | Rect Double Double Double Double r 67 | | Restore r 68 | | Rotate Double r 69 | | Save r 70 | | Scale Double Double r 71 | | SetTransform Double Double Double Double Double Double r 72 | | ShadowBlur Double r 73 | | ShadowColor Color r 74 | | ShadowOffsetX Double r 75 | | ShadowOffsetY Double r 76 | | Stroke r 77 | | StrokeRect Double Double Double Double r 78 | | StrokeStyle Style r 79 | | StrokeText Text Double Double r 80 | | TextAlign TextAlignStyle r 81 | | TextBaseline TextBaselineStyle r 82 | | Transform Double Double Double Double Double Double r 83 | | Translate Double Double r 84 | deriving Functor 85 | 86 | data Color 87 | = Hex Text 88 | | RGB Int Int Int 89 | | RGBA Int Int Int Double 90 | 91 | data Gradient 92 | = LG Int 93 | | RG Int 94 | 95 | data Style 96 | = ColorStyle Color 97 | | GradientStyle Gradient 98 | | PatternStyle Int 99 | 100 | data LineCapStyle 101 | = LineCapButt 102 | | LineCapRound 103 | | LineCapSquare 104 | 105 | data LineJoinStyle 106 | = LineJoinMiter 107 | | LineJoinRound 108 | | LineJoinBevel 109 | 110 | data TextAlignStyle 111 | = TextAlignStart 112 | | TextAlignEnd 113 | | TextAlignCenter 114 | | TextAlignLeft 115 | | TextAlignRight 116 | 117 | data TextBaselineStyle 118 | = TextBaselineTop 119 | | TextBaselineHanging 120 | | TextBaselineMiddle 121 | | TextBaselineIdeographic 122 | | TextBaselineBottom 123 | 124 | -- | For use with @createPattern@ 125 | data RepeatStyle 126 | = Repeat 127 | | RepeatX 128 | | RepeatY 129 | | NoRepeat 130 | 131 | data CompositeOperation 132 | = SourceAtop 133 | | SourceIn 134 | | SourceOut 135 | | SourceOver 136 | | DestinationAtop 137 | | DestinationIn 138 | | DestinationOut 139 | | DestinationOver 140 | | Darker 141 | | Xor 142 | | Copy 143 | -------------------------------------------------------------------------------- /static-canvas.cabal: -------------------------------------------------------------------------------- 1 | name: static-canvas 2 | version: 0.3.0 3 | synopsis: DSL to generate HTML5 Canvas javascript. 4 | description: 5 | A simple DSL for writing HTML5 Canvas in haskell and converting it 6 | to Javascript. By static we mean non-interactive, so the parts of 7 | the Canvas API that need to query the browser for run time information 8 | like `isPointInPath(x, y)` are not included. This turns out to be 9 | a surprisingly small part of HTML5 Canvas. 10 | 11 | homepage: https://github.com/jeffreyrosenbluth/static-canvas 12 | bug-reports: https://github.com/jeffreyrosenbluth/static-canvas/issues 13 | license: BSD3 14 | license-file: LICENSE 15 | author: Jeffrey Rosenbluth 16 | maintainer: jeffrey.rosenbluth@gmail.com 17 | copyright: 2015 Jeffrey Rosenbluth 18 | category: Graphics 19 | stability: Experimental 20 | build-type: Simple 21 | extra-source-files: README.md 22 | cabal-version: >=1.10 23 | 24 | library 25 | ghc-options: -Wall -O2 26 | exposed-modules: Graphics.Static 27 | Graphics.Static.ColorNames 28 | other-modules: Graphics.Static.Types 29 | Graphics.Static.Interpreter 30 | Graphics.Static.Javascript 31 | build-depends: base >=4.5 && < 5, 32 | mtl >= 2.1 && < 2.3, 33 | free >= 4.9 && < 5.2, 34 | text >=0.11 && < 1.3, 35 | double-conversion >= 2.0 && < 2.1 36 | hs-source-dirs: src 37 | default-language: Haskell2010 38 | --------------------------------------------------------------------------------