null-canvas 0.2.4 → 0.2.5

raw patch · 4 files changed

+34/−17 lines, 4 filesdep ~stm

Dependency ranges changed: stm

Files

Graphics/Blank.hs +14/−3
Graphics/Blank/Canvas.hs +1/−0
Graphics/Blank/Generated.hs +17/−12
null-canvas.cabal +2/−2

Graphics/Blank.hs view

@@ -29,11 +29,13 @@ import Network.Wai.Handler.Warp (run) import Web.Scotty as S import Network.Wai.Middleware.RequestLogger+import Network.Wai.Middleware.Rewrite  import qualified Data.Text.Lazy as T import qualified Data.Text as TS  import qualified Data.Map as Map import Data.Maybe (fromMaybe)+import Data.List (stripPrefix)  import Graphics.Blank.Events import Graphics.Blank.Context@@ -61,10 +63,14 @@ blankCanvas :: Int -> (Context -> IO ()) -> IO () blankCanvas port actions = do    dataDir <- getDataDir-   blankCanvasParams port actions dataDir False+   blankCanvasParams port actions dataDir False Nothing -blankCanvasParams :: Int -> (Context -> IO ()) -> FilePath -> Bool -> IO ()-blankCanvasParams port actions dataDir performLogging = do+-- | similar to blankCanvas but takes extra dataDir, performLogging, extraPathElements (to be stripped) args+blankCanvasParams :: Int -> (Context -> IO ()) -> FilePath -> Bool -> Maybe [TS.Text] -> IO ()+blankCanvasParams port actions dataDir performLogging extraPathElements = do+   let performRewrite = extraPathElements /= Nothing+       extraPath = fromMaybe [] extraPathElements+    uVar <- newMVar 0    let getUniq :: IO Int        getUniq = do@@ -86,6 +92,11 @@             return uq     app <- scottyApp $ do+        when performRewrite (middleware (rewrite (\ pathOrig headers -> do+                                                    print (pathOrig, headers, extraPath)+                                                    let fixed = stripPrefix extraPath pathOrig+                                                    print fixed+                                                    return (fromMaybe pathOrig fixed))))         when performLogging (middleware logStdoutDev)  --        middleware $ staticRoot $ TS.pack $ (dataDir ++ "/static")

Graphics/Blank/Canvas.hs view

@@ -34,6 +34,7 @@         | BezierCurveTo (Float,Float,Float,Float,Float,Float)         | ClearRect (Float,Float,Float,Float)         | ClosePath+        | Custom String         | Fill         | FillRect (Float,Float,Float,Float)         | FillStyle String

Graphics/Blank/Generated.hs view

@@ -9,6 +9,7 @@   show (BezierCurveTo (a1,a2,a3,a4,a5,a6)) = "c.bezierCurveTo(" ++ showJ a1 ++ "," ++ showJ a2 ++ "," ++ showJ a3 ++ "," ++ showJ a4 ++ "," ++ showJ a5 ++ "," ++ showJ a6 ++ ");"   show (ClearRect (a1,a2,a3,a4)) = "c.clearRect(" ++ showJ a1 ++ "," ++ showJ a2 ++ "," ++ showJ a3 ++ "," ++ showJ a4 ++ ");"   show ClosePath = "c.closePath();"+  show (Custom str) = str   show Fill = "c.fill();"   show (FillRect (a1,a2,a3,a4)) = "c.fillRect(" ++ showJ a1 ++ "," ++ showJ a2 ++ "," ++ showJ a3 ++ "," ++ showJ a4 ++ ");"   show (FillStyle (a1)) = "c.fillStyle = (" ++ show a1 ++ ");"@@ -39,8 +40,8 @@ arc :: (Float,Float,Float,Float,Float,Bool) -> Canvas () arc = Command . Arc -beginPath :: () -> Canvas ()-beginPath () = Command BeginPath+beginPath :: Canvas ()+beginPath = Command BeginPath  bezierCurveTo :: (Float,Float,Float,Float,Float,Float) -> Canvas () bezierCurveTo = Command . BezierCurveTo@@ -48,12 +49,16 @@ clearRect :: (Float,Float,Float,Float) -> Canvas () clearRect = Command . ClearRect -closePath :: () -> Canvas ()-closePath () = Command ClosePath+closePath :: Canvas ()+closePath = Command ClosePath -fill :: () -> Canvas ()-fill () = Command Fill+-- | sends command (JS) unchanged +custom :: String -> Canvas ()+custom = Command . Custom +fill :: Canvas ()+fill = Command Fill+ fillRect :: (Float,Float,Float,Float) -> Canvas () fillRect = Command . FillRect @@ -87,8 +92,8 @@ moveTo :: (Float,Float) -> Canvas () moveTo = Command . MoveTo -restore :: () -> Canvas ()-restore () = Command Restore+restore :: Canvas ()+restore = Command Restore  rotate :: Float -> Canvas () rotate = Command . Rotate@@ -96,11 +101,11 @@ scale :: (Float,Float) -> Canvas () scale = Command . Scale -save :: () -> Canvas ()-save () = Command Save+save :: Canvas ()+save = Command Save -stroke :: () -> Canvas ()-stroke () = Command Stroke+stroke :: Canvas ()+stroke = Command Stroke  strokeRect :: (Float,Float,Float,Float) -> Canvas () strokeRect = Command . StrokeRect

null-canvas.cabal view

@@ -1,5 +1,5 @@ Name:                null-canvas-Version:             0.2.4+Version:             0.2.5 Synopsis:            HTML5 Canvas Graphics Library - forked Blank Canvas Description:         A Haskell port of the HTML5 Canvas API.                      blank-canvas works by providing a web service that@@ -48,7 +48,7 @@                        transformers     >= 0.2.2,                        wai-extra        == 1.3.*,                        warp             >= 1.3.1        && < 1.4,-                       stm              == 2.2.*+                       stm              == 2.*    GHC-options:  -Wall -fno-warn-orphans