;; @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. ;; ;;

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