Safe Haskell | None |
---|---|
Language | Haskell2010 |
blank-canvas is a Haskell binding to the complete HTML5 Canvas API. blank-canvas allows Haskell users to write, in Haskell, interactive images onto their web browsers. blank-canvas gives the users a single full-window canvas, and provides many well-documented functions for rendering images.
- blankCanvas :: Options -> (DeviceContext -> IO ()) -> IO ()
- data Options = Options {
- port :: Int
- events :: [EventName]
- debug :: Bool
- root :: String
- middleware :: [Middleware]
- data DeviceContext
- send :: DeviceContext -> Canvas a -> IO a
- data Canvas :: * -> *
- height :: (Image image, Num a) => image -> a
- width :: (Image image, Num a) => image -> a
- toDataURL :: () -> Canvas Text
- save :: () -> Canvas ()
- restore :: () -> Canvas ()
- scale :: (Double, Double) -> Canvas ()
- rotate :: Double -> Canvas ()
- translate :: (Double, Double) -> Canvas ()
- transform :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
- setTransform :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
- class Image a
- drawImage :: Image image => (image, [Double]) -> Canvas ()
- globalAlpha :: Double -> Canvas ()
- globalCompositeOperation :: Text -> Canvas ()
- lineWidth :: Double -> Canvas ()
- lineCap :: LineEndCap -> Canvas ()
- lineJoin :: LineJoinCorner -> Canvas ()
- miterLimit :: Double -> Canvas ()
- data LineEndCap
- data LineJoinCorner
- strokeStyle :: Text -> Canvas ()
- fillStyle :: Text -> Canvas ()
- shadowOffsetX :: Double -> Canvas ()
- shadowOffsetY :: Double -> Canvas ()
- shadowBlur :: Double -> Canvas ()
- shadowColor :: Text -> Canvas ()
- createLinearGradient :: (Double, Double, Double, Double) -> Canvas CanvasGradient
- createRadialGradient :: (Double, Double, Double, Double, Double, Double) -> Canvas CanvasGradient
- createPattern :: (CanvasImage, RepeatDirection) -> Canvas CanvasPattern
- addColorStop :: (Double, Text) -> CanvasGradient -> Canvas ()
- data RepeatDirection
- data CanvasGradient
- data CanvasPattern
- beginPath :: () -> Canvas ()
- closePath :: () -> Canvas ()
- fill :: () -> Canvas ()
- stroke :: () -> Canvas ()
- clip :: () -> Canvas ()
- moveTo :: (Double, Double) -> Canvas ()
- lineTo :: (Double, Double) -> Canvas ()
- quadraticCurveTo :: (Double, Double, Double, Double) -> Canvas ()
- bezierCurveTo :: (Double, Double, Double, Double, Double, Double) -> Canvas ()
- arcTo :: (Double, Double, Double, Double, Double) -> Canvas ()
- arc :: (Double, Double, Double, Double, Double, Bool) -> Canvas ()
- rect :: (Double, Double, Double, Double) -> Canvas ()
- isPointInPath :: (Double, Double) -> Canvas Bool
- font :: Text -> Canvas ()
- textAlign :: TextAnchorAlignment -> Canvas ()
- textBaseline :: TextBaselineAlignment -> Canvas ()
- fillText :: (Text, Double, Double) -> Canvas ()
- strokeText :: (Text, Double, Double) -> Canvas ()
- measureText :: Text -> Canvas TextMetrics
- data TextAnchorAlignment
- data TextBaselineAlignment
- data TextMetrics = TextMetrics Double
- clearRect :: (Double, Double, Double, Double) -> Canvas ()
- fillRect :: (Double, Double, Double, Double) -> Canvas ()
- strokeRect :: (Double, Double, Double, Double) -> Canvas ()
- getImageData :: (Double, Double, Double, Double) -> Canvas ImageData
- putImageData :: (ImageData, [Double]) -> Canvas ()
- data ImageData = ImageData !Int !Int !(Vector Word8)
- newImage :: Text -> Canvas CanvasImage
- data CanvasImage
- devicePixelRatio :: DeviceContext -> Double
- data CanvasContext
- newCanvas :: (Int, Int) -> Canvas CanvasContext
- with :: CanvasContext -> Canvas a -> Canvas a
- myCanvasContext :: Canvas CanvasContext
- deviceCanvasContext :: DeviceContext -> CanvasContext
- sync :: Canvas ()
- console_log :: JSArg msg => msg -> Canvas ()
- eval :: Text -> Canvas ()
- class JSArg a where
- clearCanvas :: Canvas ()
- saveRestore :: Canvas a -> Canvas a
- (#) :: a -> (a -> Canvas b) -> Canvas b
- readDataURL :: Text -> FilePath -> IO Text
- dataURLMimeType :: Text -> Text
- writeDataURL :: FilePath -> Text -> IO ()
- drawImageAt :: Image image => (image, Double, Double) -> Canvas ()
- drawImageSize :: Image image => (image, Double, Double, Double, Double) -> Canvas ()
- drawImageCrop :: Image image => (image, Double, Double, Double, Double, Double, Double, Double, Double) -> Canvas ()
- putImageDataAt :: (ImageData, Double, Double) -> Canvas ()
- putImageDataDirty :: (ImageData, Double, Double, Double, Double, Double, Double) -> Canvas ()
- trigger :: Event -> Canvas ()
- eventQueue :: DeviceContext -> EventQueue
- wait :: DeviceContext -> IO Event
- flush :: DeviceContext -> IO [Event]
- data Event = Event {}
- type EventName = Text
- type EventQueue = TChan Event
- local_only :: Middleware
Starting blank-canvas
blankCanvas :: Options -> (DeviceContext -> IO ()) -> IO () Source
blankCanvas is the main entry point into blank-canvas. A typical invocation would be
{-# LANGUAGE OverloadedStrings #-} module Main where import Graphics.Blank main = blankCanvas 3000 $ \ context -> do send context $ do moveTo(50,50) lineTo(200,100) lineWidth 10 strokeStyle "red" stroke()
Options | |
|
send
ing to the Graphics DeviceContext
data DeviceContext Source
Context
is our abstact handle into a specific 2d-context inside a browser.
Note that the JavaScript API concepts of 2D-Context and Canvas
are conflated in blank-canvas. Therefore, there is no getContext
method,
rather getContext
is implied (when using send
).
send :: DeviceContext -> Canvas a -> IO a Source
Sends a set of Canvas commands to the canvas. Attempts to common up as many commands as possible. Should not crash.
HTML5 Canvas API
See http://www.nihilogic.dk/labs/canvas_sheet/HTML5_Canvas_Cheat_Sheet.pdf for the JavaScript version of this API.
Canvas element
toDataURL :: () -> Canvas Text Source
Turn the canvas into a png data stream / data URL.
"data:image/png;base64,iVBORw0KGgo.."
2D Context
Transformation
Image drawing
drawImage :: Image image => (image, [Double]) -> Canvas () Source
drawImage' takes 2, 4, or 8 Double
arguments. See drawImageAt
, drawImageSize
, and drawImageCrop
for variants with exact numbers of arguments.
Compositing
globalAlpha :: Double -> Canvas () Source
globalCompositeOperation :: Text -> Canvas () Source
Line styles
lineCap :: LineEndCap -> Canvas () Source
lineJoin :: LineJoinCorner -> Canvas () Source
miterLimit :: Double -> Canvas () Source
data LineEndCap Source
The style of the caps on the endpoints of a line.
data LineJoinCorner Source
The style of corner that is created when two lines join.
BevelCorner | A filled triangle with a beveled edge connects two lines. |
RoundCorner | A filled arc connects two lines. |
MiterCorner | A filled triangle with a sharp edge connects two lines. |
Colors, styles and shadows
strokeStyle :: Text -> Canvas () Source
shadowOffsetX :: Double -> Canvas () Source
shadowOffsetY :: Double -> Canvas () Source
shadowBlur :: Double -> Canvas () Source
shadowColor :: Text -> Canvas () Source
createLinearGradient :: (Double, Double, Double, Double) -> Canvas CanvasGradient Source
createRadialGradient :: (Double, Double, Double, Double, Double, Double) -> Canvas CanvasGradient Source
addColorStop :: (Double, Text) -> CanvasGradient -> Canvas () Source
data RepeatDirection Source
The direction in which a CanvasPattern
repeats.
data CanvasGradient Source
A handle to the CanvasGradient. CanvasGradients can not be destroyed.
data CanvasPattern Source
A handle to the CanvasPattern. CanvasPatterns can not be destroyed.
Paths
Text
textAlign :: TextAnchorAlignment -> Canvas () Source
textBaseline :: TextBaselineAlignment -> Canvas () Source
measureText :: Text -> Canvas TextMetrics Source
data TextAnchorAlignment Source
The anchor point for text in the current DeviceContext
.
StartAnchor | The text is anchored at either its left edge (if the canvas is left-to-right) or its right edge (if the canvas is right-to-left). |
EndAnchor | The text is anchored at either its right edge (if the canvas is left-to-right) or its left edge (if the canvas is right-to-left). |
CenterAnchor | The text is anchored in its center. |
LeftAnchor | The text is anchored at its left edge. |
RightAnchor | the text is anchored at its right edge. |
data TextBaselineAlignment Source
The baseline alignment used when drawing text in the current DeviceContext
.
The baselines are ordered from highest (Top
) to lowest (Bottom
).
data TextMetrics Source
The width
argument of TextMetrics
can trivially be projected out.
Rectangles
Pixel manipulation
getImageData :: (Double, Double, Double, Double) -> Canvas ImageData Source
Capture ImageDate from the Canvas.
putImageData :: (ImageData, [Double]) -> Canvas () Source
putImageData
takes 2 or 6 Double
arguments. See putImageDataAt
and putImageDataDirty
for variants with exact numbers of arguments.
blank-canvas Extensions
Reading from Canvas
newImage :: Text -> Canvas CanvasImage Source
image
takes a URL (perhaps a data URL), and returns the CanvasImage
handle,
_after_ loading.
The assumption is you are using local images, so loading should be near instant.
data CanvasImage Source
A handle to the Image. CanvasImages can not be destroyed.
DeviceContext
attributes
CanvasContext
, and off-screen Canvas.
data CanvasContext Source
A handle to an offscreen canvas. CanvasContext can not be destroyed.
newCanvas :: (Int, Int) -> Canvas CanvasContext Source
Create a new, off-screen canvas buffer. Takes width and height.
with :: CanvasContext -> Canvas a -> Canvas a Source
with
runs a set of canvas commands in the context
of a specific canvas buffer.
myCanvasContext :: Canvas CanvasContext Source
myCanvasContext
returns the current CanvasContent
.
Syncing
Send all commands to the browser, wait for the browser to ack, then continue.
Debugging
console_log :: JSArg msg => msg -> Canvas () Source
console_log
aids debugging by sending the argument to the browser console.log.
Drawing Utilities
clearCanvas :: Canvas () Source
Clear the screen. Restores the default transformation matrix.
(#) :: a -> (a -> Canvas b) -> Canvas b infixr 0 Source
The #
-operator is the Haskell analog to the .
-operator
in Javascript. Example:
grd # addColorStop(0, "#8ED6FF");
This can be seen as equivalent of grd.addColorStop(0, "#8ED6FF")
.
readDataURL :: Text -> FilePath -> IO Text Source
Read a file, and generate a data URL.
url <- readDataURL "image/png" "image/foo.png"
dataURLMimeType :: Text -> Text Source
Find the mime type for a data URL.
> dataURLMimeType "data:image/png;base64,iVBORw..." "image/png"
writeDataURL :: FilePath -> Text -> IO () Source
Write a data URL to a given file.
drawImageAt :: Image image => (image, Double, Double) -> Canvas () Source
Draws an image onto the canvas at the given x- and y-coordinates.
drawImageSize :: Image image => (image, Double, Double, Double, Double) -> Canvas () Source
Acts like drawImageAt
, but with two extra Double
arguments. The third and fourth
Double
s specify the width and height of the image, respectively.
drawImageCrop :: Image image => (image, Double, Double, Double, Double, Double, Double, Double, Double) -> Canvas () Source
Acts like drawImageSize
, but with four extra Double
arguments before the arguments
of drawImageSize
. The first and second Double
s specify the x- and y-coordinates at
which the image begins to crop. The third and fourth Double
s specify the width and
height of the cropped image.
drawImageCrop
img 0 0 dw dh dx dy dw dh =drawImageSize
= dx dy dw dh
putImageDataAt :: (ImageData, Double, Double) -> Canvas () Source
Writes ImageData
to the canvas at the given x- and y-coordinates.
putImageDataDirty :: (ImageData, Double, Double, Double, Double, Double, Double) -> Canvas () Source
Acts like putImageDataDirty
, but with four extra Double
arguments that specify
which region of the ImageData
(the dirty rectangle) should be drawn. The third
and fourth Double
s specify the dirty rectangle's x- and y- coordinates, and the
fifth and sixth Double
s specify the dirty rectangle's width and height.
putImageDataDirty
imgData dx dy 0 0 w h =putImageDataAt
imgData dx dy where (w, h) = case imgData of ImageData w' h' _ -> (w', h')
Events
eventQueue :: DeviceContext -> EventQueue Source
A single (typed) event queue
wait :: DeviceContext -> IO Event Source
wait for any event. blocks.
flush :: DeviceContext -> IO [Event] Source
flush
all the current events, returning them all to the user. Never blocks.
Basic Event from Browser; see http://api.jquery.com/category/events/ for details.
EventName
mirrors event names from jquery, and use lower case.
Possible named events
- keypress, keydown, keyup
- mouseDown, mouseenter, mousemove, mouseout, mouseover, mouseup
type EventQueue = TChan Event Source
EventQueue is a STM channel (TChan
) of Event
s.
Intentionally, EventQueue
is not abstract.