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 {}
- 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 :: (Float, Float) -> Canvas ()
- rotate :: Float -> Canvas ()
- translate :: (Float, Float) -> Canvas ()
- transform :: (Float, Float, Float, Float, Float, Float) -> Canvas ()
- setTransform :: (Float, Float, Float, Float, Float, Float) -> Canvas ()
- class Image a
- drawImage :: Image image => (image, [Float]) -> Canvas ()
- globalAlpha :: Float -> Canvas ()
- globalCompositeOperation :: Text -> Canvas ()
- lineWidth :: Float -> Canvas ()
- lineCap :: Text -> Canvas ()
- lineJoin :: Text -> Canvas ()
- miterLimit :: Float -> Canvas ()
- strokeStyle :: Text -> Canvas ()
- fillStyle :: Text -> Canvas ()
- shadowOffsetX :: Float -> Canvas ()
- shadowOffsetY :: Float -> Canvas ()
- shadowBlur :: Float -> Canvas ()
- shadowColor :: Text -> Canvas ()
- createLinearGradient :: (Float, Float, Float, Float) -> Canvas CanvasGradient
- createRadialGradient :: (Float, Float, Float, Float, Float, Float) -> Canvas CanvasGradient
- createPattern :: (CanvasImage, Text) -> Canvas CanvasPattern
- addColorStop :: (Float, Text) -> CanvasGradient -> Canvas ()
- data CanvasGradient
- data CanvasPattern
- beginPath :: () -> Canvas ()
- closePath :: () -> Canvas ()
- fill :: () -> Canvas ()
- stroke :: () -> Canvas ()
- clip :: () -> Canvas ()
- moveTo :: (Float, Float) -> Canvas ()
- lineTo :: (Float, Float) -> Canvas ()
- quadraticCurveTo :: (Float, Float, Float, Float) -> Canvas ()
- bezierCurveTo :: (Float, Float, Float, Float, Float, Float) -> Canvas ()
- arcTo :: (Float, Float, Float, Float, Float) -> Canvas ()
- arc :: (Float, Float, Float, Float, Float, Bool) -> Canvas ()
- rect :: (Float, Float, Float, Float) -> Canvas ()
- isPointInPath :: (Float, Float) -> Canvas Bool
- font :: Text -> Canvas ()
- textAlign :: Text -> Canvas ()
- textBaseline :: Text -> Canvas ()
- fillText :: (Text, Float, Float) -> Canvas ()
- strokeText :: (Text, Float, Float) -> Canvas ()
- measureText :: Text -> Canvas TextMetrics
- data TextMetrics = TextMetrics Float
- clearRect :: (Float, Float, Float, Float) -> Canvas ()
- fillRect :: (Float, Float, Float, Float) -> Canvas ()
- strokeRect :: (Float, Float, Float, Float) -> Canvas ()
- getImageData :: (Float, Float, Float, Float) -> Canvas ImageData
- putImageData :: (ImageData, [Float]) -> Canvas ()
- data ImageData = ImageData !Int !Int !(Vector Word8)
- newImage :: Text -> Canvas CanvasImage
- data CanvasImage
- devicePixelRatio :: DeviceContext -> Float
- data CanvasContext
- newCanvas :: (Int, Int) -> Canvas CanvasContext
- with :: CanvasContext -> Canvas a -> Canvas a
- myCanvasContext :: Canvas CanvasContext
- deviceCanvasContext :: DeviceContext -> CanvasContext
- console_log :: JSArg msg => msg -> Canvas ()
- eval :: Text -> Canvas ()
- class JSArg a where
- clearCanvas :: Canvas ()
- saveRestore :: Canvas () -> Canvas ()
- (#) :: a -> (a -> Canvas b) -> Canvas b
- 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, [Float]) -> Canvas () Source
drawImage
takes 2, 4 or 8 floats arguments
Compositing
globalAlpha :: Float -> Canvas () Source
globalCompositeOperation :: Text -> Canvas () Source
Line styles
miterLimit :: Float -> Canvas () Source
Colors, styles and shadows
strokeStyle :: Text -> Canvas () Source
shadowOffsetX :: Float -> Canvas () Source
shadowOffsetY :: Float -> Canvas () Source
shadowBlur :: Float -> Canvas () Source
shadowColor :: Text -> Canvas () Source
createLinearGradient :: (Float, Float, Float, Float) -> Canvas CanvasGradient Source
createRadialGradient :: (Float, Float, Float, Float, Float, Float) -> Canvas CanvasGradient Source
createPattern :: (CanvasImage, Text) -> Canvas CanvasPattern Source
addColorStop :: (Float, Text) -> CanvasGradient -> Canvas () Source
add a Color stop to a Canvas Gradient.
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
textBaseline :: Text -> Canvas () Source
measureText :: Text -> Canvas TextMetrics Source
data TextMetrics Source
The width
argument of TextMetrics
can trivially be projected out.
Rectangles
Pixel manipulation
getImageData :: (Float, Float, Float, Float) -> Canvas ImageData Source
Capture ImageDate from the Canvas.
putImageData :: (ImageData, [Float]) -> Canvas () Source
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
.
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 document.addColorStop(0, "#8ED6FF")
.
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/event-object/ 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.