blank-canvas-0.6: HTML5 Canvas Graphics Library

Copyright(C) 2014-2015, The University of Kansas
LicenseBSD-style (see the file LICENSE)
MaintainerAndy Gill
StabilityBeta
PortabilityGHC
Safe HaskellNone
LanguageHaskell2010

Graphics.Blank

Contents

Description

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.

Synopsis

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()

data Options Source

Additional blank-canvas settings. The defaults can be used by creating Options as a Num. For example, blankCanvas 3000 uses the default Options on port 3000.

Constructors

Options 

Fields

port :: Int

On which port do we issue blank-canvas?

events :: [EventName]

To which events does the canvas listen? Default: []

debug :: Bool

Turn on debugging. Default: False

root :: String

Location of the static files. Default: "."

middleware :: [Middleware]

Extra middleware(s) to be executed. Default: [local_only]

weak :: Bool

use a weak monad, which may help debugging (default False)

Instances

sending to the Graphics DeviceContext

data DeviceContext Source

DeviceContext is the abstract handle into a specific 2D context inside a browser. Note that the JavaScript API concepts of CanvasRenderingContext2D and HTMLCanvasElement 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 https://developer.mozilla.org/en-US/docs/Web/API/Canvas_API for the JavaScript version of this API.

Canvas element

height :: (Image image, Num a) => image -> a Source

The height of an Image in pixels.

width :: (Image image, Num a) => image -> a Source

The width of an Image in pixels.

toDataURL :: () -> Canvas Text Source

Turn the canvas into a PNG data stream / data URL.

"data:image/png;base64,iVBORw0KGgo.."

2D Context

save :: () -> Canvas () Source

Saves the entire canvas by pushing the current state onto a stack.

restore :: () -> Canvas () Source

Restores the most recently saved canvas by popping the top entry off of the drawing state stack. If there is no state, do nothing.

Transformation

scale :: (Interval, Interval) -> Canvas () Source

Applies a scaling transformation to the canvas units, where the first argument is the percent to scale horizontally, and the second argument is the percent to scale vertically. By default, one canvas unit is one pixel.

Examples

scale(0.5, 0.5)        -- Halve the canvas units
fillRect(0, 0, 20, 20) -- Draw a 10x10 square
scale(-1, 1)           -- Flip the context horizontally

rotate :: Radians -> Canvas () Source

Applies a rotation transformation to the canvas. When you call functions such as fillRect after rotate, the drawings will be rotated clockwise by the angle given to rotate (in radians).

Example

rotate (pi/2)        -- Rotate the canvas 90°
fillRect(0, 0, 20, 10) -- Draw a 10x20 rectangle

translate :: (Double, Double) -> Canvas () Source

Applies a translation transformation by remapping the origin (i.e., the (0,0) position) on the canvas. When you call functions such as fillRect after translate, the values passed to translate are added to the x- and y-coordinate values.

Example

translate(20, 20)
fillRect(0, 0, 40, 40) -- Draw a 40x40 square, starting in position (20, 20)

transform :: (Double, Double, Double, Double, Double, Double) -> Canvas () Source

Applies a transformation by multiplying a matrix to the canvas's current transformation. If transform(a, b, c, d, e, f) is called, the matrix

( a c e )
( b d f )
( 0 0 1 )

is multiplied by the current transformation. The parameters are:

  • a is the horizontal scaling
  • b is the horizontal skewing
  • c is the vertical skewing
  • d is the vertical scaling
  • e is the horizontal movement
  • f is the vertical movement

setTransform :: (Double, Double, Double, Double, Double, Double) -> Canvas () Source

Resets the canvas's transformation matrix to the identity matrix, then calls transform with the given arguments.

Image drawing

class Image a Source

Class for JavaScript objects that represent images (including the canvas itself).

Minimal complete definition

jsImage, width, height

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 :: Alpha -> Canvas () Source

Set the alpha value that is applied to shapes before they are drawn onto the canvas.

globalCompositeOperation :: Text -> Canvas () Source

Sets how new shapes should be drawn over existing shapes.

Examples

globalCompositeOperation "source-over"
globalCompositeOperation "destination-atop"

Line styles

lineWidth :: Double -> Canvas () Source

Sets the thickness of lines in pixels (1.0 by default).

lineCap :: LineEndCap -> Canvas () Source

Sets the LineEndCap to use when drawing the endpoints of lines.

lineJoin :: LineJoinCorner -> Canvas () Source

Sets the LineJoinCorner to use when drawing two connected lines.

miterLimit :: Double -> Canvas () Source

Sets the maximum miter length (10.0 by default) to use when the lineWidth is miter.

butt :: LineEndCap Source

Shorthand for ButtCap.

data LineJoinCorner Source

The style of corner that is created when two lines join.

Constructors

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 (default).

Colors, styles and shadows

strokeStyle :: Text -> Canvas () Source

Sets the color used for strokes ("black" by default).

Examples

strokeStyle "red"
strokeStyle "#00FF00"

fillStyle :: Text -> Canvas () Source

Sets the color used to fill a drawing ("black" by default).

Examples

fillStyle "red"
fillStyle "#00FF00"

shadowOffsetX :: Double -> Canvas () Source

Sets the horizontal distance that a shadow will be offset (0.0 by default).

shadowOffsetY :: Double -> Canvas () Source

Sets the vertical distance that a shadow will be offset (0.0 by default).

shadowBlur :: Double -> Canvas () Source

Sets the blur level for shadows (0.0 by default).

shadowColor :: Text -> Canvas () Source

Sets the color used for shadows.

Examples

shadowColor "red"
shadowColor "#00FF00"

createLinearGradient :: (Double, Double, Double, Double) -> Canvas CanvasGradient Source

createLinearGradient(x0, y0, x1, y1) creates a linear gradient along a line, which can be used to fill other shapes.

  • x0 is the starting x-coordinate of the gradient
  • y0 is the starting y-coordinate of the gradient
  • x1 is the ending y-coordinate of the gradient
  • y1 is the ending y-coordinate of the gradient

Example

grd <- createLinearGradient(0, 0, 10, 10)
grd # addColorStop(0, "blue")
grd # addColorStop(1, "red")
fillStyle grd

createRadialGradient :: (Double, Double, Double, Double, Double, Double) -> Canvas CanvasGradient Source

createRadialGradient(x0, y0, r0, x1, y1, r1) creates a radial gradient given by the coordinates of two circles, which can be used to fill other shapes.

  • x0 is the x-axis of the coordinate of the start circle
  • y0 is the y-axis of the coordinate of the start circle
  • r0 is the radius of the start circle
  • x1 is the x-axis of the coordinate of the end circle
  • y1 is the y-axis of the coordinate of the end circle
  • r1 is the radius of the end circle

Example

grd <- createRadialGradient(100,100,100,100,100,0)
grd # addColorStop(0, "blue")
grd # addColorStop(1, "red")
fillStyle grd

createPattern :: (CanvasImage, RepeatDirection) -> Canvas CanvasPattern Source

Creates a pattern using a CanvasImage and a RepeatDirection.

Example

img <- newImage "cat.jpg"
pat <- createPattern(img, repeatX)
fillStyle pat

addColorStop :: (Interval, Text) -> CanvasGradient -> Canvas () Source

Adds a color and stop position in a CanvasGradient. A stop position is a number between 0.0 and 1.0 that represents the position between start and stop in a gradient.

Example

grd <- createLinearGradient(0, 0, 10, 10)
grd # addColorStop(0, "red")

data RepeatDirection Source

The direction in which a CanvasPattern repeats.

Constructors

Repeat

The pattern repeats both horizontally and vertically (default).

RepeatX

The pattern repeats only horizontally.

RepeatY

The pattern repeats only vertically.

NoRepeat

The pattern displays only once and does not repeat.

repeat_ :: RepeatDirection Source

Shorthand for Repeat, with an underscore to distinguish it from repeat.

Paths

beginPath :: () -> Canvas () Source

Begins drawing a new path. This will empty the current list of subpaths.

Example

beginPath()
moveTo(20, 20)
lineTo(200, 20)
stroke()

closePath :: () -> Canvas () Source

Creates a path from the current point back to the start, to close it.

Example

beginPath()
moveTo(20, 20)
lineTo(200, 20)
lineTo(120, 120)
closePath()
stroke()

fill :: () -> Canvas () Source

Fills the current path with the current fillStyle.

Example

rect(10, 10, 100, 100)
fill()

stroke :: () -> Canvas () Source

Draws the current path's strokes with the current strokeStyle (black by default).

Example

rect(10, 10, 100, 100)
stroke()

clip :: () -> Canvas () Source

Turns the path currently being built into the current clipping path. Anything drawn after clip is called will only be visible if inside the new clipping path.

Example

rect(50, 20, 200, 120)
stroke()
clip()
fillStyle "red"
fillRect(0, 0, 150, 100)

moveTo :: (Double, Double) -> Canvas () Source

moveTo(x, y) moves the starting point of a new subpath to the given (x, y) coordinates.

Example

beginPath()
moveTo(50, 50)
lineTo(200, 50)
stroke()

lineTo :: (Double, Double) -> Canvas () Source

lineTo(x, y) connects the last point in the subpath to the given (x, y) coordinates (without actually drawing it).

Example

beginPath()
moveTo(50, 50)
lineTo(200, 50)
stroke()

quadraticCurveTo :: (Double, Double, Double, Double) -> Canvas () Source

quadraticCurveTo(cpx, cpy, x, y) adds a quadratic Bézier curve to the path (whereas bezierCurveTo adds a cubic Bézier curve).

  • cpx is the x-coordinate of the control point
  • cpy is the y-coordinate of the control point
  • x is the x-coordinate of the end point
  • y is the y-coordinate of the end point

bezierCurveTo :: (Double, Double, Double, Double, Double, Double) -> Canvas () Source

bezierCurveTo(cp1x, cp1y, cp2x, cp2y x, y) adds a cubic Bézier curve to the path (whereas quadraticCurveTo adds a quadratic Bézier curve).

  • cp1x is the x-coordinate of the first control point
  • cp1y is the y-coordinate of the first control point
  • cp2x is the x-coordinate of the second control point
  • cp2y is the y-coordinate of the second control point
  • x is the x-coordinate of the end point
  • y is the y-coordinate of the end point

arcTo :: (Double, Double, Double, Double, Double) -> Canvas () Source

arcTo(x1, y1, x2, y2, r) creates an arc between two tangents, specified by two control points and a radius.

  • x1 is the x-coordinate of the first control point
  • y1 is the y-coordinate of the first control point
  • x2 is the x-coordinate of the second control point
  • y2 is the y-coordinate of the second control point
  • r is the arc's radius

arc :: (Double, Double, Double, Radians, Radians, Bool) -> Canvas () Source

arc(x, y, r, sAngle, eAngle, cc) creates a circular arc, where

  • x is the x-coordinate of the center of the circle
  • y is the y-coordinate of the center of the circle
  • r is the radius of the circle on which the arc is drawn
  • sAngle is the starting angle (where 0 at the 3 o'clock position of the circle)
  • eAngle is the ending angle
  • cc is the arc direction, where True indicates counterclockwise and False indicates clockwise.

rect :: (Double, Double, Double, Double) -> Canvas () Source

rect(x, y, w, h) creates a rectangle with an upper-left corner at position (x, y), width w, and height h (where width and height are in pixels).

Example

rect(10, 10, 100, 100)
fill()

isPointInPath :: (Double, Double) -> Canvas Bool Source

isPointInPath(x, y) queries whether point (x, y) is within the current path.

Example

rect(10, 10, 100, 100)
stroke()
b <- isPointInPath(10, 10) -- b == True

Text

font :: Text -> Canvas () Source

Sets the text context's font properties.

Examples

font "40pt 'Gill Sans Extrabold'"
font "80% sans-serif"
font "bold italic large serif"

textAlign :: TextAnchorAlignment -> Canvas () Source

Sets the TextAnchorAlignment to use when drawing text.

textBaseline :: TextBaselineAlignment -> Canvas () Source

Sets the TextBaselineAlignment to use when drawing text.

fillText :: (Text, Double, Double) -> Canvas () Source

fillText(t, x, y) fills the text t at position (x, y) using the current fillStyle.

Example

font "48px serif"
fillText("Hello, World!", 50, 100)

strokeText :: (Text, Double, Double) -> Canvas () Source

strokeText(t, x, y) draws text t (with no fill) at position (x, y) using the current strokeStyle.

Example

font "48px serif"
strokeText("Hello, World!", 50, 100)

measureText :: Text -> Canvas TextMetrics Source

Queries the measured width of the text argument.

Example

TextMetrics w <- measureText "Hello, World!"

data TextAnchorAlignment Source

The anchor point for text in the current DeviceContext.

Constructors

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 TextMetrics Source

The width argument of TextMetrics can trivially be projected out.

Constructors

TextMetrics Double 

Rectangles

clearRect :: (Double, Double, Double, Double) -> Canvas () Source

clearRect(x, y, w, h) clears all pixels within the rectangle with upper-left corner (x, y), width w, and height h (i.e., sets the pixels to transparent black).

Example

fillStyle "red"
fillRect(0, 0, 300, 150)
clearRect(20, 20, 100, 50)

fillRect :: (Double, Double, Double, Double) -> Canvas () Source

fillRect(x, y, w, h) draws a filled rectangle with upper-left corner (x, y), width w, and height h using the current fillStyle.

Example

fillStyle "red"
fillRect(0, 0, 300, 150)

strokeRect :: (Double, Double, Double, Double) -> Canvas () Source

strokeRect(x, y, w, h) draws a rectangle (no fill) with upper-left corner (x, y), width w, and height h using the current strokeStyle.

Example

strokeStyle "red"
strokeRect(0, 0, 300, 150)

Pixel manipulation

getImageData :: (Double, Double, Double, Double) -> Canvas ImageData Source

getImageData(x, y, w, h) capture ImageData from the rectangle with upper-left corner (x, y), width w, and height h.

putImageData :: (ImageData, [Double]) -> Canvas () Source

putImageData takes 2 or 6 Double arguments. See putImageDataAt and putImageDataDirty for variants with exact numbers of arguments.

data ImageData Source

ImageData is a transliteration of JavaScript's ImageData. ImageData consists of two Ints and one (unboxed) Vector of Word8s. width, height, and data can be projected from ImageData, length can be used to find the data length.

Note: ImageData lives on the server, not the client.

Constructors

ImageData !Int !Int !(Vector Word8) 

Type information

type Alpha = Interval Source

An interval representing a color's translucency. A color with an alpha value of 0.0 is transparent, and a color with an alpha value of 1.0 is opaque.

type Degrees = Double Source

An angle type in which 360° represents one complete rotation.

type Interval = Double Source

A normalized percentage value (e.g., 0.0 represent 0%, 1.0 represents 100%, etc.).

type Percentage = Double Source

A value representing a percentage (e.g., 0.0 represents 0%, 100.0 represents 100%, etc.).

type Radians = Double Source

An angle type in which 2π radians represents one complete rotation.

class RoundProperty a where Source

Class for round CSS property values.

Methods

round_ :: a Source

Shorthand for RoundCap or RoundCorner, with an underscore to distinguish it from round.

blank-canvas Extensions

Reading from Canvas

newImage :: Text -> Canvas CanvasImage Source

newImage takes a URL (perhaps a data URL), and returns the CanvasImage handle after loading. If you are using local images, loading should be near instant.

newAudio :: Text -> Canvas CanvasAudio Source

newAudio takes an URL to an audio file and returs the CanvasAudio handle after loading. If you are using local audio files, loading should be near instant.

DeviceContext attributes

devicePixelRatio :: DeviceContext -> Double Source

devicePixelRatio returns the device's pixel ratio as used. Typically, the browser ignores devicePixelRatio in the canvas, which can make fine details and text look fuzzy. Using the query ?hd on the URL, blank-canvas attempts to use the native devicePixelRatio, and if successful, devicePixelRatio will return a number other than 1. You can think of devicePixelRatio as the line width to use to make lines look one pixel wide.

CanvasContext, and off-screen Canvas.

newCanvas :: (Int, Int) -> Canvas CanvasContext Source

Create a new, off-screen canvas buffer. Takes width and height as arguments.

with :: CanvasContext -> Canvas a -> Canvas a Source

with runs a set of canvas commands in the context of a specific canvas buffer.

Syncing

sync :: Canvas () Source

Send all commands to the browser, wait for the browser to act, then continue.

Debugging

console_log :: JSArg msg => msg -> Canvas () Source

console_log aids debugging by sending the argument to the browser console.log.

eval :: Text -> Canvas () Source

eval executes the argument in JavaScript directly.

Drawing Utilities

clearCanvas :: Canvas () Source

Clear the screen. Restores the default transformation matrix.

saveRestore :: Canvas a -> Canvas a Source

Wrap a canvas computation in save / restore.

(#) :: a -> (a -> b) -> 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 Doubles 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 Doubles specify the x- and y-coordinates at which the image begins to crop. The third and fourth Doubles 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 putImageDataAt, but with four extra Double arguments that specify which region of the ImageData (the dirty rectangle) should be drawn. The third and fourth Doubles specify the dirty rectangle's x- and y- coordinates, and the fifth and sixth Doubles 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

trigger :: Event -> Canvas () Source

Triggers a specific named event.

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.

type EventName = Text Source

EventName mirrors event names from jQuery, and uses lowercase. Possible named events

  • keypress, keydown, keyup
  • mouseDown, mouseenter, mousemove, mouseout, mouseover, mouseup

type EventQueue = TChan Event Source

EventQueue is an STM channel (TChan) of Events. Intentionally, EventQueue is not abstract.

Cursor manipulation

cursor :: Text -> Canvas () Source

Change the canvas cursor to the specified URL or keyword.

Examples

cursor "url(image.png), default"
cursor "crosshair"

Middleware