;; @module canvas.lsp
;; @description Routines for creating HTML canvas tag graphics
;; @version 1.0 initial release
;; @version 1.1 doc changes only
;; @version 1.21 doc changes only
;; @version 1.3 compatibility pre and post 10.2.0 for new extend
;; @version 1.32 doc formatting, spelling
;; @version 1.33 took out license
;; @version 1.4 cv:petal was broken (JavaScript change?)
;; @version 1.44 doc corrections
;; @version 1.45 cv:render works on Emscripten newLISP
;; @version 1.52 changed Win32 to Windows and spelling
;; @version 1.6 sign error in shape caused incompatibility with postscript.lsp
;; @version 1.61 eliminated canvas-15.tgz link
;; @version 1.7 fixed ellipse, petal, pie, polygon, shape fill first the stroke
;; @version 1.71 fixed documentation for cv:clip
;; @author Lutz Mueller, March 2009, June 2012, January 2014, 2015
;;
Turtle graphics for the HTML-5 canvas tag
;; This module generates HTML pages suited for browsers which recognize
;; the HTML-5 canvas tag.
;; Example program
;; The following is a simple example how to create an HTML page
;; with one or more embedded graphics.
;;
;; @example
;; (module "canvas.lsp") ; does a load from standard location
;;
;; (cv:html "<h2>First canvas</h2>") ; optional mixed in HTML
;; (cv:canvas "FirstCanvas" 300 100) ; required canvas creation
;; (cv:fill-color 1.0 0.0 0.0)
;; (cv:rectangle 100 80 true) ; one or more drawing statements
;; (cv:html "<h2>Second canvas</h2>")
;;
;; (cv:canvas "SecondCanvas" 300 100)
;; (cv:fill-color 0.0 1.0 0.0)
;; (cv:rectangle 200 80 true)
;; (cv:render "page.html") ; required rendering of the page
;; (exit)
;; All canvas functions are prefixed with 'cv' and emit the JavaScript
;; code necessary to the <script></script> section in the
;; header section of the HTML page. Only the function 'html' is not
;; prefixed and outputs strings directoy to the <body></body>
;; tagged section of the HTML page.
;;
;; @example
;; (html "<p>This is a parapgraph of text.</p>")
;; Sometimes it is necessary to output JavaScript explicity to the
;; script section of the page, e.g. to use canvas features not implemented
;; in this module. This can be done via the 'cv' default functor:
;;
;; @example
;; (cv "document.write('this is a test');")
;; Most functions in the canvas 'cv' module work the same as in the older
;; postscript 'ps' modul, and some functions in the postscript module
;; have been changed to achieve more compatibility between both modules.
;; The following example shows how name-space prefix switching can be used to
;; to run a postscript.lsp based program with canvas:
;;
;; @example
;; (module "canvas.lsp")
;;
;; (html "")
;; (cv:canvas "TheCanvas" 200 200)
;; ; reuse postrcipt.lsp code
;; (set 'ps cv) ; switch prefix
;;
;; (ps:goto 120 132)
;; (ps:line-color 1 0 0.6)
;; (ps:line-width 3.0)
;; (ps:angle 15)
;; (dotimes (i 12)
;; (cv:turn 30)
;; (cv:bezier -20 75 40 75 20 0))
;; ; end postscript snippet
;;
;; (html "")
;; (cv:render "rose.html")
;; (exit)
;; A package with more demo files can be downloaded from
;; @link http://www.newlisp.org/canvas/canvas-15.tgz www.newlisp.org/canvas/canvas-15.tgz .
;; The demo files assume the Safari (4.0 beta) browser on Mac OS X and Windows or
;; The Firefox browser (3.1. beta 3) on Linux and start the browser automatically.
;; Change the last 'cv:render' line in each of the demo file to manually load
;; the generated page-file spciefied in the 'cv:render' statement.
;; Using JavaScript directly
;; Complex graphics with many looping statements can generate huge HTML files which
;; may be slow to load over an internet connection. The newLISP program itself
;; may be small, but the JavaScript it generates may fill hundreds of kilobytes
;; because of repeated output of JavaScript statements. The cv function
;; can be used to to emit JavaScript directly. For most cv:xxx (but not all)
;; -functions a similar named JavaScript function exists in canvas.lsp.
;; The following example generates the same graphic twice, first as a looping
;; newLISP script, then as an explicitly written JavaScript script:
;;
;; @example
;; (module "canvas.lsp")
;;
;; (html "Indirect draw
")
;;
;; (cv:canvas "CanvasOne" 400 200)
;; (cv:line-color 0 0.5 0.5)
;;
;; (cv:angle -90)
;; (dotimes (i 180)
;; (cv:goto 200 0)
;; (cv:draw 300)
;; (cv:turn 1))
;;
;; (html "Direct draw
")
;;
;; (cv:canvas "CanvasTwo" 400 200)
;; (cv:line-color 0 0.5 0.5)
;;
;; (cv [text]
;; Angle(-90);
;; for(var i = 0; i < 180; i++) {
;; Goto(200, 0);
;; Draw(300);
;; Turn(1);
;; }
;; [/text])
;;
;; (cv:render) ; render page automatically in browser on OS X (Safari 4.0)
;; ; as an alternative specify the HTML filename
;; (cv:render "direct.html") ; renders to file specified
;; (exit)
;; Differences to the postscript module
;; Differences between the canvas.lsp and postscript.lsp modules
;; are mainly in the treatment of text colors and fonts.
;;
;; - The text color for 'cv:text' is set by 'cv:fill-color' with 'canvas.lsp', but
;; with 'ps:line-color' when using 'postscript.lsp' and 'ps:text', except for outlined
;; text, which is drawn with 'line-color' in both modules.
;; - The 'cv:font' parameters are different from the 'ps:font'
;; parameters. See the function reference for details.
;; - Canvas graphics need the 'cv:canvas' statement at the beginning
;; to specify the canvas size. In Postscript the drawing area depends
;; on the printer driver settings. To port 'postscript.lsp' graphics
;; to 'canvas.lsp' use a width of 612 and height of 792 in the 'cv:canvas'
;; statement. The numbers correspond to a 8 1/2 by 11 inch US paper page
;; with translation of points to pixels.
;; - Cipping with outlined text is not available yet in 'canvas.lsp'.
;; Current implementations are browser-specific and not part of the HTML-5
;; canvas tag specification.
;; - Text drawn with 'cv:textoutline' or 'cv:textarcoutline' cannot be filled
;; with color as possible with 'ps:textoutline' and 'ps:textarcoutline' in the postscript
;; module.
;;
- 'canvas.lsp' has a 'cv:header' function to specify tags in the
;; HTML header section.
;;
;; Summary of functions
;; Return values from functions are not used when programming with canvas functions
;; and are not mentioned in the documentation.
;; Turtle coordinate positioning and turning
;;
;; cv:goto - move turtle to position x, y
;; cv:move - move turtle a distance s forward from the current position
;; cv:turn - turn the turtle degress dg left (negative) or right (positive)
;; cv:angle - set the turtle orientation to dg degrees
;;
;; Line drawing
;;
;; cv:draw - draw distance s forward from current position
;; cv:drawto - draw to the absolute position x,y from the current position
;; cv:line - draw a multipart line consisting of line and bezier curve segments
;; cv:bezier - draw a Bezier curve
;;
;; Closed shapes, filling and clipping
;;
;; cv:rectangle - draw a rectangle
;; cv:polygon - draw a polygon with radius rad and n number of sides
;; cv:circle - draw a circle
;; cv:ellipse - draw an open or closed ellipse with x-rad and y-rad radius
;; cv:pie - draw a pie piece with radius rad and width
;; cv:petal - draw a petal shape from Bezier curves
;; cv:shape - draw a shape defined by a list of line and bezier segments
;; cv:clip - define a clipping path using line and Bezier segments
;;
;; Text output and clipping
;;
;; cv:text - draw a solid text string
;; cv:textoutline - draw text in outline shape
;; cv:textarc - draw text around an arc
;; cv:textarcoutline - draw text in outline shape around an arc
;;
;; Global settings
;;
;; cv:translate - move coordinate origin
;; cv:scale - scale output
;; cv:rotate - rotate output
;; cv:gsave - save current graphics state (translation, scale, rotation)
;; cv:grestore - restore current graphics state
;; cv:font - set font specifications
;; cv:line-witdh - set line width in pixels
;; cv:line-cap - set line termination shape
;; cv:line-join - set line join mode
;; cv:line-color - set line color
;; cv:fill-color - set fill color
;;
;; Rendering and output
;;
;; cv:render - render HTML output to CGI or a file
;;
;; @syntax (cv:angle )
;; @param Angle degrees from 0 to 360.
;;
;; Set the turtle angle to degrees.
;; Upwards is 0, right 90, downwards 180 and left 270 degrees.
;; The turtle position is saved on the graphics state stack when using
;; '(cv:gsave)'.
;; @syntax (cv:bezier )
;; @param Bezier coordinates of relative to = 0,0
;; @param Bezier coordinates of relative to = 0,0
;; @param Bezier coordinates of relative to = 0,0
;;
;; Draw a Bezier curve.
;; The Bezier curve starts at point which is the current
;; turtle position and stops at point which is at offset
;; and relative to starting point. The turtle orientation
;; after the drawing the Bezier curve is perpendicular
;; to the Bezier curve baseline to and the position is .
;; @syntax (cv:circle [])
;; @param Radius of the circle.
;; @param Optional fill flag.
;;
;; Draw a circle with radius . The optional flag
;; with either 'true' or 'nil' (default) indicates if the circle
;; is filled with the fill color specified by 'cv:fill-color'.
;; The circle is drawn around the current turtle position.
;; The turtle position or orientation is not changed.
;; @syntax (cv:clip )
;; @param A list of turtle movements and/or Bezier curves.
;;
;; Define a clipping path using turtle movements ( ) and
;; Bezier curves ( ) starting from the
;; last turtle coordinates , and finishing at , .
;; All Bezier coordinates are relative to the previous turtle position and
;; orientation.
;;
;; Before redefining the clipping area '(cv:gsave)' should
;; be used to save the old graphics state parameters, after
;; clipping and drawing in the clipped area the graphics
;; state should be restored using '(cv:grestore)'.
;; The turtle position or orientation is not changed.
;; @syntax (cv:draw )
;; @param Distance to draw.
;;
;; Draw going forward distance . Moves the turtle forward by
;; the amount of pixels specified in and draws with the current
;; line color set by 'cv:line-color'.
;;
;; @syntax (cv:drawto )
;; @param The x coordinate to draw to.
;; @param The y coordinate to draw to.
;;
;; Draw a line to point , . Moves the turtle to point
;; , like '(cv:goto x y)', but also draws a line from
;; the old to the new position. The turtle position is changed to the
;; new point , and the orientation is changed to the orientaion of
;; the line drawn.
;; @syntax (cv:ellipse [])
;; @param The x axis radius.
;; @param The y axis radius.
;; @param The start angle in 0 to 360 degrees.
;; @param The end angle in 0 to 360 degrees.
;;
;; Draw an ellipse with optional either 'true' or 'nil' (default).
;; The ellipse is drawn around the current turtle position
;; with the Y axis oriented like the turtle.
;; For , set to 0, 360 an ellipse is drawn.
;; For a partial radius the opening is closed by a line
;; resulting in segment shape, i.e. -90, 90 would result
;; in a half circle from the left to the right of the turtle.
;; When and are of equal size a full circle
;; can be drawn. The turtle position or orientation is not changed.
;; @syntax (cv:fill-color )
;; @param The red color value.
;; @param The green color value.
;; @param The blue color value.
;;
;; Set color for shape filling.
;; Color values assume the following value:
;;
;;
;; R - value for red 0.0 to 1.0
;; B - value for green 0.0 to 1.0
;; G - value for blue 0.0 to 1.0
;;
;;
;; @syntax (cv:fill-color )
;; @param A hex string specifying the line color.
;;
;; In an alternative syntax color values can be specified in a
;; hex string:
;;
;; is a hex string constant '"000000"' to '"FFFFFF"'
;; Colors are specified as usual in HTML coding.
;; Each two hex digits define a color: 'rrggbb'.
;; @syntax (cv:font )
;; @param The font name.
;;
;; The current font is set for all subsequent text operations.
;; Depending on the browser and OS installed, different fonts are available.
;;
;; @example
;; (cv:font "normal 14px sans-serif") ; Helvetica
;; (cv:font "bold 20px serif") ; Times
;; (cv:font "italic 32px sans-serif") ; Cursive
;; @syntax (cv:goto )
;; @param The new x coordinate.
;; @param The new y coordinate.
;;
;; Moves to position , .
;; The turtle position can be
;; saved on the graphics state stack when using '(cv:gsave)'.
;; @syntax (cv:grestore)
;; Restores the graphics state from the stack.
;; @syntax (cv:gsave)
;; Saves the current graphics state. The function pushes the
;; current graphics state on a special stack, from where it
;; can be resored using '(cv:grestore)'. States saved are:
;; The turtle position X, Y and orientation, the transformation
;; scaling and rotation factors, the line cap and join value and
;; the colors set.
;; @syntax (cv:line )
;; @param A list of turtle movements or Bezier curves.
;;
;; Draw a multipart line. are turtle movements ( ),
;; or Bezier curves ( ) starting
;; from the last turtle coordinates , and
;; finishing at , . All Bezier coordinates are
;; relative to the previous turtle position and
;; orientation.
;;
;; The turtle position and orientation are changed after
;; drawing the line.
;; @syntax (cv:line-cap )
;; @param The line termination shape mode as a string or number
;;
;; Sets the line termination shape as either a number or string:
;;
;; 0 or "butt"
;; 1 or "round"
;; 2 or "square"
;;
;; @syntax (cv:line-color )
;; @param The red color value.
;; @param The green color value.
;; @param The blue color value.
;;
;; Set color for line drawing.
;; Color values assume the following value:
;;
;; R - value for red 0.0 to 1.0
;; G - value for green 0.0 to 1.0
;; B - value for blue 0.0 to 1.0
;;
;;
;; @syntax (cv:line-color )
;; @param A hex string specifying the line color.
;;
;; In an alternative syntax color values can be specified in a
;; hex string:
;;
;; is a hex string constant '"000000"' to '"FFFFFF"'
;; Colors are specified as usual in HTML coding.
;; Each to two hex digits define a color: 'rrggbb'.
;; @syntax (cv:line-join | )
;; @param The line join mode.
;;
;; Sets the line join mode as either a number or string:
;;
;; 0 or "miter"
;; 1 or "round"
;; 2 or "bevel"
;;
;; @syntax (cv:line-width )
;; @param The line width in pixels.
;;
;; Sets the line width in pixels for line drawing and the
;; outlines drawn by shapes and text outlines.
;; @syntax (cv:move )
;; @param The distance to move the pen.
;;
;; Move turtle the forward distance without drawing.
;; @syntax (cv:petal [])
;; @param The 'x1' coordinate of the underlying Bezier curve to .
;; @param The 'y1' coordinate of the underlying Bezier curve to .
;; @param An optional fill flag for color fill.
;;
;; Draws a petal using a Bezier curve with optional either 'true' or 'nil' (default).
;; The and parameters are relative to to the current position.
;; The petal is drawn with the tip at the current turtle
;; position and oriented in the direction of the turtle.
;; The turtle position or orientation is not changed.
;; @syntax (cv:pie [])
;; @param The radius of the pie.
;; @param The width of the pie slice as an angle.
;; @param An optional fill flag for color fill, 'true' or 'nil' (default).
;;
;; Draw a pie slice with optional either 'true' or 'nil' (default).
;; The left edge of the pie is in turtle orientation.
;; The width angle spreads clockwise. The pie is drawn around the current
;; turtle position. The turtle position or orientation is not changed.
;; @syntax (cv:polygon [])
;; @param Radius.
;; @param Number of sides.
;; @param Optional fill flag.
;;
;; Draw a polygon with radius and sides.
;; is 'true' or 'nil' (default) for optional color fill
;; The polygon is drawn around the current turtle position.
;; The turtle position or orientation is not changed.
;; @syntax (cv:rectangle [])
;; @param The width of the rectangle.
;; @param The height of the rectangle.
;; @param An optional flag to draw a filled rectangle.
;;
;; A rectangle is drawn at the current turtle position.
;; The width of the rectangle will be perpendicular to
;; the turtle orientation. If the turtle never turned or
;; the turtle angle never was set then the width of the
;; rectangle will lie horizontally.
;;
;; The position or orientation of the turtle will not change.
;; @syntax (cv:render [])
;; @param Optionam HTML file-name to save to.
;;
;; On Mac OX X system when using the function without a file-name,
;; the default HTML browser is opened automatically and a temporary
;; file /tmp/noname.html is shown. This is the best mode for
;; interactive development.
;;
;; On Windows 'cv:render' tries to open 'c:\Program Files\Safari\Safari.exe'.
;; The function 'cv:render' at the end of the source in 'canvas.lsp'
;; can be modified for a different browser.
;;
;; When a file-name is supplied, then 'cv:render' generates a HTML
;; file. When the file-name is specified as "cgi", then
;; output is directed to standard out. This is useful for writing CGI
;; programs. The CGI program must take care to emit a content-type header
;; first using:
;;
;; (print "Content-Type: text/html\r\n\r\n")
;; @syntax (cv:rotate )
;; @param The degrees of rotation: -360 to 0 to 360.
;;
;; Rotate the coordinate space.
;; The coordinate space is rotated to the right for
;; positive angles and to the left for negative angles.
;; The current rotation angle is 0 (upwards) by default.
;; The rotation angle is part of the graphics state saved by
;; the 'cv:gsave' function and restored by 'cv:grestore'.
;; @syntax (cv:scale )
;; @param The new x scale factor.
;; @param The new y scale factor.
;;
;; Scale the coordinate space.
;; Scaling factors are 1.0 by default and compress for
;; factors less 1.0 or expand for factors bigger than 1.0.
;; With a scaling factor for x = 2.0 each point position
;; specified would cover the double of horizontal distance
;; on the page. Previou scaling factors can be saved on the graphics
;; state stack using the function 'cv:gsave' and restored using 'cv:grestore'.
;; @syntax (cv:shape [])
;; @param A list of turtle movements and/or Bezier curves.
;; @param An optional fill flag for color fill.
;;
;; Draws a shape with optional or eiher 'true' or 'nil' (default).
;; is either a turtle movement ( ) or a Bezier curve
;; ( ) starting from the last turtle coordinates
;; , and finishing at , . All Bezier coordinates
;; are relative to the previous turtle position and orientation
;; The turtle position or orientation is not changed.
;; @syntax (cv:text )
;; @param The text to draw.
;;
;; Draws text. Before drawing, a font can be specified, the default font after loading
;; the 'canvas.lsp' modules is the default font of the canvas tag. The text color
;; is the current 'cv:fill-color'.
;;
;; The turtle position is changed to the baseline after the last character.
;; The turtle orientation stays the same.
;; @syntax (cv:textarc )
;; @param The text to draw.
;; @param The radius of an imaginary circle path for .
;;
;; Draw text around a circle.
;; The text is drawn out side of an imaginary circle starting at
;; turtle position and orientation and drawing at the current tangent.
;; For a positive radius text goes outside
;; the circle and clockwise. For a negative radius text goes inside the
;; circle and counter lock wise. The turtle position and orientation
;; move along the radius.
;; @syntax (cv:textarcoutline )
;; @param The text to draw.
;; @param The radius of imaginary circle path for text.
;;
;; Draw text around a circle.
;; Same as 'cv:textarc' but the text is drawn as ane outline.
;; The color of the text outline is the current 'cv:line-color'.
;; The turtle position and orientation move along the radius.
;; @syntax (cv:textoutline )
;; @param The text to draw.
;;
;; Draw a text outline
;; Before drawing a font can be specified
;; the default font after loading 'canvas.lsp' is the font
;; of the HTML canvas tag.
;;
;; The turtle position is changed to the baseline after the last character.
;; The turtle orientation stays the same.
;; @syntax (cv:translate )
;; @syntax (cv:translate)
;; @param Move the current x-origin by 'dx'.
;; @param Move the current y-origin by 'dy'.
;;
;; Move the coordinate origin.
;; By default the origin 0,0 is in the bottom left corner
;; of the page. The and values extend to the right and top.
;; When no , values are specified, the coordinate origin
;; is moved to the current position of the turtle. Previous translation
;; offsets can be saved on the graphics state stack using the
;; function 'cv:gsave' and restored using 'cv:grestore'.
;; @syntax (cv:turn )
;; @param The degrees to turn: -360 to 0 to 360.
;;
;; Turn the turtle pen by degrees. The degrees are specified in angles
;; from -380 to 0 to 360. For turning clockwise specifiy positive values.
;; Negative degrees turn the turtle pen counter clockwise. The turtle
;; position is aved on the graphics state stack when using '(cv:gsave)'.
(when (< (sys-info -2) 10110)
(constant (global 'extend) write-buffer))
(define (html:html str) (extend cv:body-html str))
(context 'cv)
; global values and constants
(set 'pi (mul 2 (acos 0)))
(set 'pi/2 (acos 0))
(set 'line-feed (if (> (& 0xF (sys-info -1)) 5) "\r\n" "\n"))
(set 'header-tags "") ; header tags from cv:header go here
(set 'canvas-script "") ; graphics statements go here
(set 'body-html "") ; body html written with cv:html goes here
(set 'canvas-width 1000) ; current canvas
(set 'canvas-height 1000) ; current canvas
(set 'turtle-x 0)
(set 'turtle-y canvas-height)
(set 'turtle-orient (add pi 0.0000001))
(set 'line-color "#000000") ; for strokeStyle()
(set 'line-width 1) ;
(set 'fill-color '(0xff 0 0 0)) ; for fillStyle()
(set 'template-header [text]
%s[/text])
(set 'script-header [text]
[/text])
; same definition as html:html
(define (cv:html str) (write-line body-html str))
(set 'canvas-template [text][/text])
(set 'body-close "\n")
; user functions
(define (cv:header tags )
(set 'header-tags tags)
)
(define (cv:canvas canvas-name (width 300) (height 200))
(cv (format script-template canvas-name width height))
(html (format canvas-template canvas-name width height))
)
(define (cv:goto x y)
(cv (format "Goto(%g, %g);" x y))
)
(define (cv:move s)
(cv (format "Move(%g);" s))
)
(define (cv:turn dg)
(cv (format "Turn(%g);" dg))
)
(define (cv:angle dg)
(cv (format "Angle(%g);" dg))
)
(define (cv:draw s)
(cv (format "Draw(%g);" s))
)
(define (cv:drawto x y)
(cv (format "Drawto(%g, %g);" x y))
)
(define (cv:line lst)
(cv (format "Line(new Array(%s));" (list-path lst)))
)
(define (list-path lst)
(let ( (buff "") (rec nil))
(while (set 'rec (pop lst))
(if (= (length rec) 6)
(extend buff (string ",'B'," (join (map string rec) ","))))
(if (= (length rec) 2)
(extend buff (string ",'L'," (rec 0) "," (rec 1)))))
(1 buff)
) )
(define (cv:bezier x1 y1 x2 y2 x3 y3)
(cv (format "Bezier(%g, %g, %g, %g, %g, %g); ctx.stroke();"
x1 y1 x2 y2 x3 y3))
)
(define (cv:polygon rad n flag)
(cv (format "Polygon(%g, %g, %s);"
rad n (if flag "true" "false")))
)
(define (cv:circle rad flag)
(cv (format "Circle(%g, %s);" rad (if flag "true" "false")))
)
(define (cv:ellipse xr yr start end mode)
(cv (format "Ellipse(%g, %g, %g, %g, %s);"
xr yr start end (if mode "true" "false")))
)
(define (cv:rectangle width height flag)
(shape (list (list 0 height) (list 90 width) (list 90 height) (list 90 width)) flag)
)
(define (cv:pie rad width flag)
(cv (format "Pie(%g, %g, %s);" rad width (if flag "true" "false")))
)
(define (cv:petal width height flag)
; x3 (offset from x1) cannot be 0 or the Bezier does not get drawn
(bezier (sub width) height width height 0.001 0 flag)
(cv (format "Bezier(%g, %g, %g, %g, %g, %g);"
(sub width) height width height 0.001 0))
(cv "ctx.closPath")
(if flag (cv "ctx.fill();"))
(cv "ctx.stroke();")
)
(define (cv:shape lst flag)
(cv (format "Shape(new Array(%s), %s);"
(list-path lst)
(if flag "true" "false")))
)
(define (cv:clip lst flag)
(cv (format "Clip(new Array(%s), %s);"
(list-path lst) (if flag "true" "false")))
)
(define (cv:text str)
(cv (format {Text("%s");} str))
)
(define (textoutline str)
(cv (format {TextOutline("%s");} str))
)
(define (cv:textarc str radius)
(cv (format {TextArc("%s", %g);} str radius))
)
(define (cv:textarcoutline str radius)
(cv (format {TextArcOutline("%s", %g);} str radius))
)
(define (cv:translate x y)
(if (and x y)
(cv (format "ctx.translate(%g, -%g);" x y))
(cv "ctx.translate(xpos, - (canvasHeight - ypos));")
)
)
(define (cv:scale x y)
(cv (format "Scale(%g, %g);" x y))
)
(define (cv:rotate dg)
(cv (format "ctx.rotate(%g);" (mul pi/2 (div dg 90))))
)
(define (cv:gsave) (cv "Gsave();"))
(define (cv:grestore) (cv "Grestore();"))
(define (cv:font spec) (cv (format {ctx.font = "%s";} spec)))
(define (cv:line-cap mode)
(if (number? mode) (set 'mode (nth mode '("but" "round" "square"))))
(cv (format "ctx.lineCap = '%s';" mode)))
(define (cv:line-join mode)
(if (number? mode) (set 'mode (nth mode '("miter" "round" "bevel"))))
(cv (format "ctx.lineJoin = '%s';" mode)))
(define (line-color red green blue alpha)
(if (string? red)
(let (color red)
(set 'red (div (int (append "0x" (0 2 color)) 0 16) 255))
(set 'green (div (int (append "0x" (2 2 color)) 0) 255))
(set 'blue (div (int (append "0x" (4 2 color)) 0) 255))))
(if alpha
(cv (format "ctx.strokeStyle = 'rgba(%d, %d, %d, %g)';"
(mul red 255) (mul green 255) (mul blue 255) alpha))
(cv (format "ctx.strokeStyle = 'rgb(%d, %d, %d)';"
(mul red 255) (mul green 255) (mul blue 255) )))
)
(define (cv:line-width width)
(cv (format "ctx.lineWidth = %g;" width))
)
(define (fill-color red green blue alpha)
(if (string? red)
(let (color red)
(set 'red (div (int (append "0x" (0 2 color)) 0 16) 255))
(set 'green (div (int (append "0x" (2 2 color)) 0) 255))
(set 'blue (div (int (append "0x" (4 2 color)) 0) 255))))
(if alpha
(cv (format "ctx.fillStyle = 'rgba(%d, %d, %d, %g)';"
(mul red 255) (mul green 255) (mul blue 255) alpha))
(cv (format "ctx.fillStyle = 'rgb(%d, %d, %d)';"
(mul red 255) (mul green 255) (mul blue 255) )))
)
(define (cv:render mode)
(let (page (append (format template-header header-tags)
script-header
canvas-script
script-close
body-html
body-close))
(cond
( (nil? mode)
; on Emscripten open tab
(if eval-string-js
(display-html page true)
(show-in-browser)))
( (= (upper-case mode) "CGI")
(println page))
( true
(write-file mode page))
)
)
)
(define cv:save cv:render) ; compatibility with older postscript.lsp code
(define (show-in-browser)
(write-file "/tmp/noname.html" page)
(cond
( (= ostype "OSX")
(exec "open /tmp/noname.html"))
( (= ostype "Windows")
(set 'prog (string "cmd /c \"" (env "PROGRAMFILES")
; Use either Firefox or Safari 4.0
; "/Mozilla Firefox 3.1 Beta 2/firefox.exe\""))
"/Safari/Safari.exe\""))
; (println "->" prog "<-")
(exec (string prog " file://c:/tmp/noname.html")))
( true // all Linux and other unix
(set 'files '(
"/usr/bin/sensible-browser"
"/usr/bin/x-www-browser"
"/usr/bin/mozilla"
"/usr/bin/firefox"
"/usr/bin/konqueror"
))
(set 'prog (find true (map file? files)))
(if prog
(exec (string (files prog) " file:///tmp/noname.html"))
(println "Cannot find browser to display documentation" "warning")) )
) ; cond
) ; define
(context MAIN)
; eof