Copyright | (C) 2014-2015 The University of Kansas |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | Andy Gill |
Stability | Beta |
Portability | GHC |
Safe Haskell | Safe-Inferred |
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.
Synopsis
- blankCanvas :: Options -> (DeviceContext -> IO ()) -> IO ()
- data Options = Options {}
- 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 :: (Interval, Interval) -> Canvas ()
- rotate :: Radians -> 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 :: Alpha -> Canvas ()
- globalCompositeOperation :: Text -> Canvas ()
- lineWidth :: Double -> Canvas ()
- lineCap :: LineEndCap -> Canvas ()
- lineJoin :: LineJoinCorner -> Canvas ()
- miterLimit :: Double -> Canvas ()
- data LineEndCap
- butt :: LineEndCap
- square :: LineEndCap
- data LineJoinCorner
- bevel :: LineJoinCorner
- miter :: 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 :: (Interval, Text) -> CanvasGradient -> Canvas ()
- data RepeatDirection
- repeat_ :: RepeatDirection
- repeatX :: RepeatDirection
- repeatY :: RepeatDirection
- noRepeat :: 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, Radians, Radians, 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
- start :: TextAnchorAlignment
- end :: TextAnchorAlignment
- center :: TextAnchorAlignment
- left :: TextAnchorAlignment
- right :: TextAnchorAlignment
- data TextBaselineAlignment
- top :: TextBaselineAlignment
- hanging :: TextBaselineAlignment
- middle :: TextBaselineAlignment
- alphabetic :: TextBaselineAlignment
- ideographic :: TextBaselineAlignment
- bottom :: 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)
- type Alpha = Interval
- type Degrees = Double
- type Interval = Double
- type Percentage = Double
- type Radians = Double
- class RoundProperty a where
- round_ :: a
- newImage :: Text -> Canvas CanvasImage
- data CanvasImage
- newAudio :: Text -> Canvas CanvasAudio
- data CanvasAudio
- 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 -> b) -> 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
- cursor :: Text -> Canvas ()
- 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()
Additional blank-canvas
settings. The defaults can be used by creating
Options
as a Num
. For example,
uses the default blankCanvas
3000Options
on port 3000.
Options | |
|
send
ing 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
).
Instances
Image DeviceContext Source # | |
Defined in Graphics.Blank.DeviceContext jsImage :: DeviceContext -> Builder width :: Num b => DeviceContext -> b height :: Num b => DeviceContext -> b |
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
toDataURL :: () -> Canvas Text Source #
Turn the canvas into a PNG data stream / data URL.
"data:image/png;base64,iVBORw0KGgo.."
2D Context
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
transform :: (Double, Double, Double, Double, Double, Double) -> Canvas () Source #
Applies a transformation by multiplying a matrix to the canvas's
current transformation. If
is called, the matrixtransform
(a, b, c, d, e, f)
( a c e ) ( b d f ) ( 0 0 1 )
is multiplied by the current transformation. The parameters are:
a
is the horizontal scalingb
is the horizontal skewingc
is the vertical skewingd
is the vertical scalinge
is the horizontal movementf
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 for JavaScript objects that represent images (including the canvas itself).
jsImage, width, height
Instances
Image DeviceContext Source # | |
Defined in Graphics.Blank.DeviceContext jsImage :: DeviceContext -> Builder width :: Num b => DeviceContext -> b height :: Num b => DeviceContext -> b | |
Image CanvasContext Source # | |
Defined in Graphics.Blank.JavaScript jsImage :: CanvasContext -> Builder width :: Num b => CanvasContext -> b height :: Num b => CanvasContext -> b | |
Image CanvasImage Source # | |
Defined in Graphics.Blank.JavaScript jsImage :: CanvasImage -> Builder width :: Num b => CanvasImage -> b height :: Num b => CanvasImage -> b |
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
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 #
data LineEndCap Source #
The style of the caps on the endpoints of a line.
Instances
butt :: LineEndCap Source #
Shorthand for ButtCap
.
square :: LineEndCap Source #
Shorthand for SquareCap
.
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 (default). |
Instances
bevel :: LineJoinCorner Source #
Shorthand for BevelCorner
.
miter :: LineJoinCorner Source #
Shorthand for MiterCorner
.
Colors, styles and shadows
strokeStyle :: Text -> Canvas () Source #
Sets the color used for strokes ("black"
by default).
Examples
strokeStyle
"red"strokeStyle
"#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 #
createLinearGradient :: (Double, Double, Double, Double) -> Canvas CanvasGradient Source #
creates a linear gradient along a line,
which can be used to fill other shapes.createLinearGradient
(x0, y0, x1, y1)
x0
is the starting x-coordinate of the gradienty0
is the starting y-coordinate of the gradientx1
is the ending y-coordinate of the gradienty1
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 #
creates a radial gradient given
by the coordinates of two circles, which can be used to fill other shapes.createRadialGradient
(x0, y0, r0, x1, y1, r1)
x0
is the x-axis of the coordinate of the start circley0
is the y-axis of the coordinate of the start circler0
is the radius of the start circlex1
is the x-axis of the coordinate of the end circley1
is the y-axis of the coordinate of the end circler1
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.
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. |
Instances
repeatX :: RepeatDirection Source #
Shorthand for RepeatX
.
repeatY :: RepeatDirection Source #
Shorthand for RepeatY
.
noRepeat :: RepeatDirection Source #
Shorthand for NoRepeat
.
data CanvasGradient Source #
A handle to the a canvas gradient. CanvasGradient
s cannot be destroyed.
Instances
data CanvasPattern Source #
A handle to a canvas pattern. CanvasPattern
s cannot be destroyed.
Instances
Paths
stroke :: () -> Canvas () Source #
Draws the current path's strokes with the current strokeStyle
(black
by default).
Example
quadraticCurveTo :: (Double, Double, Double, Double) -> Canvas () Source #
adds a quadratic Bézier curve to the path
(whereas quadraticCurveTo
(cpx, cpy, x, y)bezierCurveTo
adds a cubic Bézier curve).
cpx
is the x-coordinate of the control pointcpy
is the y-coordinate of the control pointx
is the x-coordinate of the end pointy
is the y-coordinate of the end point
bezierCurveTo :: (Double, Double, Double, Double, Double, Double) -> Canvas () Source #
adds a cubic Bézier curve to the path
(whereas bezierCurveTo
(cp1x, cp1y, cp2x, cp2y x, y)quadraticCurveTo
adds a quadratic Bézier curve).
cp1x
is the x-coordinate of the first control pointcp1y
is the y-coordinate of the first control pointcp2x
is the x-coordinate of the second control pointcp2y
is the y-coordinate of the second control pointx
is the x-coordinate of the end pointy
is the y-coordinate of the end point
arcTo :: (Double, Double, Double, Double, Double) -> Canvas () Source #
creates an arc between two tangents,
specified by two control points and a radius.arcTo
(x1, y1, x2, y2, r)
x1
is the x-coordinate of the first control pointy1
is the y-coordinate of the first control pointx2
is the x-coordinate of the second control pointy2
is the y-coordinate of the second control pointr
is the arc's radius
arc :: (Double, Double, Double, Radians, Radians, Bool) -> Canvas () Source #
creates a circular arc, wherearc
(x, y, r, sAngle, eAngle, cc)
x
is the x-coordinate of the center of the circley
is the y-coordinate of the center of the circler
is the radius of the circle on which the arc is drawnsAngle
is the starting angle (where0
at the 3 o'clock position of the circle)eAngle
is the ending anglecc
is the arc direction, whereTrue
indicates counterclockwise andFalse
indicates clockwise.
isPointInPath :: (Double, Double) -> Canvas Bool Source #
queries whether point isPointInPath
(x, y)(x, y)
is within the current path.
Example
rect
(10, 10, 100, 100)stroke
() b <-isPointInPath
(10, 10) -- b == True
Text
textAlign :: TextAnchorAlignment -> Canvas () Source #
Sets the TextAnchorAlignment
to use when drawing text.
textBaseline :: TextBaselineAlignment -> Canvas () Source #
Sets the TextBaselineAlignment
to use when drawing text.
strokeText :: (Text, Double, Double) -> Canvas () Source #
draws text strokeText
(t, x, y)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 #
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. |
Instances
start :: TextAnchorAlignment Source #
Shorthand for StartAnchor
.
end :: TextAnchorAlignment Source #
Shorthand for EndAnchor
.
center :: TextAnchorAlignment Source #
Shorthand for CenterAnchor
.
left :: TextAnchorAlignment Source #
Shorthand for LeftAnchor
.
right :: TextAnchorAlignment Source #
Shorthand for RightAnchor
.
data TextBaselineAlignment Source #
The baseline alignment used when drawing text in the current DeviceContext
.
The baselines are ordered from highest (Top
) to lowest (Bottom
).
Instances
top :: TextBaselineAlignment Source #
Shorthand for TopBaseline
.
hanging :: TextBaselineAlignment Source #
Shorthand for HangingBaseline
.
middle :: TextBaselineAlignment Source #
Shorthand for MiddleBaseline
.
alphabetic :: TextBaselineAlignment Source #
Shorthand for AlphabeticBaseline
.
ideographic :: TextBaselineAlignment Source #
Shorthand for IdeographicBaseline
.
bottom :: TextBaselineAlignment Source #
Shorthand for BottomBaseline
.
data TextMetrics Source #
The width
argument of TextMetrics
can trivially be projected out.
Instances
Show TextMetrics Source # | |
Defined in Graphics.Blank.Canvas showsPrec :: Int -> TextMetrics -> ShowS # show :: TextMetrics -> String # showList :: [TextMetrics] -> ShowS # | |
TextShow TextMetrics Source # | |
Defined in Graphics.Blank.Canvas showbPrec :: Int -> TextMetrics -> Builder # showb :: TextMetrics -> Builder # showbList :: [TextMetrics] -> Builder # showtPrec :: Int -> TextMetrics -> Text # showt :: TextMetrics -> Text # showtList :: [TextMetrics] -> Text # showtlPrec :: Int -> TextMetrics -> Text # showtl :: TextMetrics -> Text # showtlList :: [TextMetrics] -> Text # |
Rectangles
strokeRect :: (Double, Double, Double, Double) -> Canvas () Source #
draws a rectangle (no fill) with upper-left
corner strokeRect
(x, y, w, h)(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 #
capture getImageData
(x, y, w, h)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.
ImageData
is a transliteration of JavaScript's
ImageData
.
ImageData
consists of two Int
s and one (unboxed) Vector
of Word8
s.
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.
Instances
Show ImageData Source # | |
JSArg ImageData Source # | |
Eq ImageData Source # | |
Ord ImageData Source # | |
Defined in Graphics.Blank.JavaScript | |
TextShow ImageData Source # | |
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 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.).
class RoundProperty a where Source #
Class for round
CSS property values.
Shorthand for RoundCap
or RoundCorner
, with an underscore to
distinguish it from round
.
Instances
RoundProperty LineEndCap Source # | |
Defined in Graphics.Blank.JavaScript round_ :: LineEndCap Source # | |
RoundProperty LineJoinCorner Source # | |
Defined in Graphics.Blank.JavaScript |
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.
data CanvasImage Source #
A handle to a canvas image. CanvasImage
s cannot be destroyed.
Instances
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.
data CanvasAudio Source #
A handle to a canvas audio. CanvasAudio
s cannot be destroyed.
Instances
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.
data CanvasContext Source #
A handle to an offscreen canvas. CanvasContext
cannot be destroyed.
Instances
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.
myCanvasContext :: Canvas CanvasContext Source #
myCanvasContext
returns the current CanvasContext
.
Syncing
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
.
Class for Haskell data types which represent JavaScript data.
Instances
Drawing Utilities
clearCanvas :: Canvas () Source #
Clear the screen. Restores the default transformation matrix.
(#) :: 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"
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 putImageDataAt
, 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
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.
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 Event
s.
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"