; Scheme 9 from Empty Space, Function Library
; By Nils M Holm, 2010,2012
; Placed in the Public Domain
;
; (canvas-draw canvas integer-X integer-Y char)       ==>  unspecific
; (canvas-draw-string canvas int-X int-Y string)      ==>  unspecific
; (canvas-dump canvas)                                ==>  vector
; (canvas-plot canvas integer-X integer-Y char)       ==>  unspecific
; (canvas-plot-line canvas X Y DX DY char)            ==>  unspecific
; (make-canvas int-X int-Y int-W int-H)               ==>  canvas
;
; (load-from-library "char-canvas.scm")
;
; This is a set of routines for drawing characters and lines on
; a scaled, character-based (a.k.a. "ASCII Art") canvas.
;
; MAKE-CANVAS creates a char canvas with a physical size of
; x=INT-X times y=INT-Y characters. The virtual size of the
; canvas is INT-W (width) times INT-H (height) "pixels". "Real
; coordinates" relate to the physical size of the canvas.
; "Virtual coordinates" are translated to real coordinates by
; scaling. Both types of coordinates are specified in X/Y
; notation. The origin 0/0 is at the lower left corner of the
; canvas. The new canvas will be filled with blanks initially.
;
; CANVAS-DRAW draws character CHAR at position INTEGER-X/INTEGER-Y.
; It uses real coordinates. CANVAS-DRAWSTRING draws a string
; instead of a single character. When the X or Y coordinate is
; outside of the canvas, C will not be drawn. When STRING extends
; beyond the limits of the canvas, it will be clipped.
;
; CANVAS-PLOT draws the character CHAR at the virtual position
; INTEGER-X/INTEGER-Y. CANVAS-PLOT-LINE draws a line from the
; virtual position X/Y to DX/DY using the character CHAR. All
; arguments must be integers. Lines originating or extending
; outside of the canvas will be clipped.
;
; CANVAS-DUMP returns a vector of strings that contain the
; characters written to the canvas. The vector indexes are the
; Y-coordinates, the string offsets the X-coordinates.
;
; Example:   (let ((c (make-canvas 10 5 10 10)))
;              (canvas-plot-line c 0 9 9 0 #\#)
;              (canvas-plot-line c 0 0 9 9 #\*)
;              (canvas-dump c))                   ==>  #("##      **"
;                                                        "  ##  **  "
;                                                        "    **    "
;                                                        "  **  ##  "
;                                                        "**      ##")

(declare (bound-to-procedure ##sys#signal-hook))
(cond-expand
  ((or chicken-5.0 chicken-5.1)
    (declare (bound-to-procedure ##sys#register-record-printer)) )
  (else) )

(module (s9fes char-canvas)

(;export
  ;NOTE cannot export from `s9fes.char-canvas' since char-canvas uses .rect
  ;char-canvas
  ;canvas
  ;
  char-canvas:check-argtyp
  check-virtual-coords check-real-coords
  ;
  make-canvas new-canvas
  canvas-duplicate
  canvas? check-canvas
  canvas-columns canvas-rows
  canvas-width canvas-height
  canvas-aspect canvas-square?
  ;
  canvas-real canvas-virtual
  canvas-rect
  rect-real rect-virtual
  ;
  canvas->list canvas->vector canvas->string
  ;
  canvas-print
  make-frame-chars frame-chars?
  ASCII-FRAME-CHARS THIN-FRAME-CHARS THICK-FRAME-CHARS
  ;
  string->char-canvas
  string->canvas
  with-output-to-canvas
  ;
  current-plotter-char current-plotter-bkgd-char
  plot-config
  ;
  canvas-draw
  canvas-draw-string
  canvas-draw-line
  canvas-draw-lines
  ;
  canvas-plot
  canvas-plot-string
  canvas-plot-line
  canvas-plot-lines
  ;internal
  validate-plotter-configuration
  *canvas-draw-string
  ;deprecated
  canvas-dump)

(cond-expand
  (chicken-5
    (import utf8)
    (import (except scheme make-vector))
    (import (rename scheme (make-vector scheme:make-vector)))
    (import (only (chicken base)
      unless when error make-parameter fixnum? assert receive include-relative
      define-inline define-constant set-record-printer!
      void cut))
    (import (only utf8-srfi-13 string-pad-right)) )
  (chicken-6
    (import (scheme base))
    (import (only (srfi 13) string-pad-right)) )
  (else
    ;FIXME error available?
    (error "unknown CHICKEN") ) )

(import (chicken type))
(import (chicken fixnum))
(import (only (chicken port) with-output-to-string with-input-from-string))
(import (only (chicken io) read-lines))
(import (only (chicken string) string-split))
(import (only (chicken format) format))
(import (only (srfi 1) make-list cons* reverse!))
(import (only utf8-srfi-13 string-pad-right))
(import record-variants)
(import (s9fes char-canvas rect))

;NOTE works w/o recourse to `define-record' for tag, so ok for tag "defining" module
(cond-expand
  ((or chicken-5.0 chicken-5.1)
    (define (set-record-printer! tag proc)
      (##sys#register-record-printer tag proc) ) )
  (else) )

(include-relative "s9fes.char-canvas.types")
(include-relative "s9fes.char-canvas.inlines")

(: char-canvas:check-argtyp ((or false symbol) 'a (* -> boolean) symbol -> 'a))

; Virtual Canvas

(: check-virtual-coords ((or false symbol) * * -> void))

(: make-canvas (fixnum fixnum #!optional integer integer -> canvas))
(: new-canvas ((or char-canvas canvas) integer integer -> canvas))
(: canvas-duplicate (canvas -> canvas))

(: canvas? (* -> boolean : canvas))
(: check-canvas ((or false symbol) * -> canvas))

(: canvas-columns (canvas -> fixnum))
(: canvas-rows (canvas -> fixnum))
(: canvas-width (canvas -> integer))
(: canvas-height (canvas -> integer))
(: canvas-chars (canvas -> char-canvas))

(: canvas-aspect (canvas -> real))
(: canvas-square? (canvas -> boolean))

(: canvas-real (canvas integer integer -> fixnum fixnum))
(: canvas-virtual (canvas fixnum fixnum -> integer integer))

(: canvas-rect (canvas -> rect))

(: rect-real (canvas rect -> rect))
(: rect-virtual (canvas rect -> rect))

(: canvas->list (canvas -> (list-of string)))
(: canvas->vector (canvas -> (vector-of string)))
(: canvas->string (canvas -> string))

(: current-plotter-char (#!optional char -> char))
(: current-plotter-bkgd-char (#!optional char -> char))

(: make-frame-chars (char char char char char char char char -> box-frame-chars))
(: frame-chars? (* -> boolean : box-frame-chars))
(: canvas-print (canvas #!optional (or true box-frame-chars) -> void))

(: string->char-canvas (string -> char-canvas))

(: string->canvas (string -> canvas))
(: with-output-to-canvas (procedure -> canvas))

#; ;config char is kinda brush? config is currently oval config, w/ 1st char overload
(: current-plotter-configuration (#!optional plotter-configuration -> plotter-configuration))
(: validate-plotter-configuration ((or false symbol) * fixnum #!optional (or false char) -> plotter-configuration))

(: plot-config (#!rest (or false char) -> plotter-configuration))

; Real Coords

(: check-real-coords ((or false symbol) * * -> void))

(: canvas-draw (canvas fixnum fixnum #!optional char -> void))
(: canvas-draw-string (canvas fixnum fixnum string -> void))
(: canvas-draw-line (canvas fixnum fixnum fixnum fixnum #!optional char -> void))
(: canvas-draw-lines (canvas (list-of fixnum) #!optional (or false char plotter-configuration) -> void))

; Virtual Coords

(: canvas-plot (canvas integer integer #!optional char -> void))
(: canvas-plot-string (canvas integer integer string -> void))
(: canvas-plot-line (canvas integer integer integer integer #!optional char -> void))
(: canvas-plot-lines (canvas (list-of integer) #!optional (or false char plotter-configuration) -> void))

;;

;srfi-133 sort'a

(cond-expand
  (chicken-5
    (define (make-vector n #!optional (v (void)))
      (let ((tv (scheme:make-vector n)))
        (do ((i 0 (fx+ i 1)))
            ((fx>= i n) tv)
          (set! (vector-ref tv i) v) ) ) )

    (define (vector-copy! trg tdx src sdx edx)
      (do ((i tdx (fx+ i 1)) (j sdx (fx+ j 1)))
          ((fx>= j edx))
        (vector-set! trg i (vector-ref src j)) ) )

    (define (vector-copy sv)
      (let* ((vlen (vector-length sv))
             (tv (make-vector vlen)) )
        (vector-copy! tv 0 sv 0 vlen)
        tv ) )

    (define (vector->string v #!optional (st 0) (ed (vector-length v)))
      (let ((s (make-string (fx- ed st))))
        (do ((vi st (fx+ vi 1))
             (si 0 (fx+ si 1)) )
            ((fx= ed vi) s)
          (string-set! s si (vector-ref v vi)) ) ) )

    (define (string->vector s #!optional (st 0) (ed (string-length s)))
      (let ((v (make-vector (fx- ed st))))
        (do ((vi 0 (fx+ vi 1))
             (si st (fx+ si 1)) )
            ((fx= ed si) v)
          (vector-set! v vi (string-ref s si)) ) ) ) )
  (else) )

;fx-utils inlines
(define-inline (fxpositive? n) (fx< 0 n))
(define-inline (fxnegative? n) (fx> 0 n))
(define-inline (fxabs n) (if (fxnegative? n) (fxneg n) n))

;moremacros
(define-syntax swap!
  (syntax-rules ()
    ((swap! ?a ?b)
      (let ((_tmp ?a))
        (set! ?a ?b)
        (set! ?b _tmp)) ) ) )

;;

; Physical Canvas

;NOTE not .inlines until `vector-copy' available everywhere
(define-inline (%char-canvas-duplicate ccv)
  (%make-char-canvas (%char-canvas-columns ccv) (%char-canvas-rows ccv)
                     (vector-copy (%char-canvas-cmap ccv))) )

; Virtual Canvas

(define (virtuals->reals cv ls)
  (let loop ((ls ls) (os '()))
    ;empty or just 1?
    (if (or (null? ls) (null? (cdr ls)))
        ;then quit & deal w/ it later
        (reverse! os)
        ;else next pair
        (loop (cddr ls) (cons* (%real-y cv (cadr ls)) ;x y ... -> y x ...
                               (%real-x cv (car ls))
                               os)) ) ) )

;;

(define (char-canvas:check-argtyp loc obj pred kind)
  (unless (pred obj)
    (##sys#signal-hook #:type-error loc obj kind) )
  obj )

(define (check-real-coords loc x y)
  (assert (and (fixnum? x) (fixnum? y))
          loc "real (physical) value must be fixnum" x y)
  (void) )

(define (check-real-coords/noclip loc x y)
  (check-real-coords loc x y)
  (assert (and (not (fxnegative? x)) (not (fxnegative? y)))
          loc "real (physical) value must be natural" x y)
  (void) )

(define (check-virtual-coords loc x y)
  (assert (and (integer? x) (integer? y))
          loc "virtual value must be integer" x y)
  (void) )

(define (check-virtual-coords/noclip loc x y)
  (check-virtual-coords loc x y)
  (assert (and (not (negative? x)) (not (negative? y)))
          loc "virtual value must be natural" x y)
  (void) )

(define (check-char-canvas loc obj)
  (char-canvas:check-argtyp loc obj
                                (lambda (obj) (%char-canvas? obj))
                                'char-canvas)
  obj )

(define (check-canvas loc obj)
  (char-canvas:check-argtyp loc obj (lambda (obj) (%canvas? obj)) 'canvas)
  obj )

(define-inline (canvas-of obj)
  (cond ((%canvas? obj)  obj)
        #; ;until windows
        ((*wndw? obj)   (*wndw-canvas obj))
        (else           #f)) )

(define-inline (char-canvas-of obj)
  (cond ((%char-canvas? obj)  obj)
        ((canvas-of obj)      => canvas-chars)
        (else                 #f)) )

(define (check-char-canvas-of loc obj)
  (char-canvas:check-argtyp loc (char-canvas-of obj)
                                (cut %char-canvas? <>)
                                'canvas) )

(define (check-canvas-of loc obj) (check-canvas loc (canvas-of obj)))

;;

(: *canvas-draw (canvas fixnum fixnum char -> void))
(: *canvas-draw-string (canvas fixnum fixnum string -> void))
(: *canvas-draw-line (canvas fixnum fixnum fixnum fixnum char -> void))
(: *canvas-draw-lines (canvas (list-of fixnum) plotter-configuration -> void))

(define (*canvas-draw cv x y c)
  (let ((ht (%canvas-rows cv)) (wd (%canvas-columns cv)) (cmap (%canvas-cmap cv)))
    (when (and (fx<= 0 y) (fx< y ht)
               (fx<= 0 x) (fx< x wd))
      (vector-set! cmap (fx+ (fx* y wd) x) c)) ) )

(define (*canvas-draw-string cv x y s)
  (let ((ht (%canvas-rows cv)) (wd (%canvas-columns cv)) (cmap (%canvas-cmap cv))
        (len (string-length s)) )
    (when (and (fx<= 0 y) (fx<= y (fx- ht 1))
               (fx<= 0 x) (fx<= x (fx- wd 1)))
      (let ((lno (fx* y wd)))
        (do ((x x (fx+ x 1))
             (i 0 (fx+ 1 i)) )
            ((or (fx>= i len)
                 (fx>= x wd)) )
          (vector-set! cmap (fx+ lno x) (string-ref s i)))) ) ) )

(define (*canvas-draw-line cv x0 y0 xn yn c)
  (let ((steep (fx> (fxabs (fx- yn y0)) (fxabs (fx- xn x0)))))
    (when steep
      (swap! x0 y0)
      (swap! xn yn))
    (when (fx> x0 xn)
      (swap! x0 xn)
      (swap! y0 yn))
    (let* ((dx (fx- xn x0))
           (dy (fxabs (fx- yn y0)))
           (de (if (fx= 0 dx) 0 (/ dy dx)))
           (ys (if (fx< y0 yn) 1 -1)) )
      (let plot ((x x0) (y y0) (e 0))
        (when (fx<= x xn)
          (if steep
              (*canvas-draw cv y x c)
              (*canvas-draw cv x y c))
          (let ((e (+ e de))
                (x (fx+ x 1)) )
            (if (<= 1/2 e)
                (plot x (fx+ y ys) (- e 1))
                (plot x y          e) ) ) ) ) ) ) )

(: **canvas-draw-lines (canvas fixnum fixnum (list-of fixnum) plotter-configuration -> void))
;
(define (**canvas-draw-lines cv x0 y0 ls cfg)
  ;(assert (<= (fx/ (length ls) 2) (length cfg)))
  (let loop ((x0 x0) (y0 y0) (ls ls) (rem 0))
    (unless (null? ls)
      (let ((xn (car ls)) (yn (cadr ls)))
        ;conditional draw
        (let ((c (%plt-cfg-c rem cfg))) (when c (*canvas-draw-line cv x0 y0 xn yn c)))
        ;next coords
        (loop xn yn (cddr ls) (fx+ rem 1)) ) ) ) )

(define (*canvas-draw-lines cv ls cfg)
  ;(assert (<= (fx/ (length ls) 2) (length cfg)))
  (let ((x0 (car ls)) (y0 (cadr ls)))
    (if (null? (cddr ls))
        ;then single point
        (*canvas-draw cv x0 y0 (%plt-cfg-c 0 cfg))
        ;else at least one line
        (**canvas-draw-lines cv x0 y0 (cddr ls) cfg) ) ) )

;NOTE might make public or something like
;
(: canvas-fold-lines (canvas (fixnum 'a string -> 'a) 'a -> 'a))
;
;folds the canvas rows in low to high order
(define (canvas-fold-lines cv func seed)
  (let ((wd (%canvas-columns cv)) (ht (%canvas-rows cv)) (cmap (%canvas-cmap cv)))
    (let loop ((y (fx- ht 1)) (st 0) (acc seed))
      (if (fx< y 0) acc
          (let ((ed (fx+ st wd)))
            (loop (fx- y 1) ed (func y acc (vector->string cmap st ed))) ) ) ) ) )

;;

(define current-plotter-char (make-parameter #\*
  (lambda (x)
    (if (char? x) x
        (error 'current-plotter-char "invalid char" x)))))

(define current-plotter-bkgd-char (make-parameter #\space
  (lambda (x)
    (if (char? x) x
        (error 'current-plotter-bkgd-char "invalid char" x)))))

;;

(define (rect-real cv rgn) (%rect-real (check-canvas 'rect-real cv) rgn))
(define (rect-virtual cv rgn) (%rect-virtual (check-canvas 'rect-virtual cv) rgn))

;;

(define (new-canvas acv v-wd v-ht)
  (check-virtual-coords/noclip 'new-canvas v-wd v-ht)
  (%new-canvas acv v-wd v-ht) )

(define (make-canvas wd ht #!optional (v-wd wd) (v-ht ht))
  (check-real-coords/noclip 'make-canvas wd ht)
  (check-virtual-coords/noclip 'make-canvas v-wd v-ht)
  (%new-canvas (%make-char-canvas* wd ht (current-plotter-bkgd-char)) v-wd v-ht) )

(define (canvas? obj) (%canvas? obj))

(define (canvas-chars cv) (%canvas-chars (check-canvas 'canvas-chars cv)))
(define (canvas-x-scale cv) (%canvas-x-scale (check-canvas 'canvas-x-scale cv)))
(define (canvas-y-scale cv) (%canvas-y-scale (check-canvas 'canvas-y-scale cv)))

(define (canvas-aspect cv) (%canvas-aspect (check-canvas 'canvas-aspect cv)))
(define (canvas-square? cv) (= 1 (canvas-aspect cv)))

(define (canvas-duplicate cv)
  (check-canvas 'canvas-duplicate cv)
  (new-canvas (%char-canvas-duplicate (%canvas-chars cv))
              (%canvas-width cv) (%canvas-height cv)) )

(define (canvas-width cv) (%canvas-width (check-canvas 'canvas-width cv)))
(define (canvas-height cv) (%canvas-height (check-canvas 'canvas-height cv)))

(define (canvas-columns cv) (%canvas-columns (check-canvas 'canvas-columns cv)))
(define (canvas-rows cv) (%canvas-rows (check-canvas 'canvas-rows cv)))

(define (canvas-real cv x y) (%canvas-real (check-canvas 'canvas-real cv) x y))
(define (canvas-virtual cv x y) (%canvas-virtual (check-canvas 'canvas-virtual cv) x y))

(define (canvas-rect cv) (%canvas-rect (check-canvas 'canvas-rect cv)))

(define (canvas->list cv)
  (canvas-fold-lines (check-canvas 'canvas->list cv)
                     (lambda (y l s) (cons s l))
                     '()) )

(define (canvas->vector cv)
  (canvas-fold-lines (check-canvas 'canvas->vector cv)
                     (lambda (y v s) (vector-set! v y s) v)
                     (make-vector (canvas-rows cv))) )

(define (canvas->string cv)
  (apply string-append (canvas-fold-lines (check-canvas 'canvas->string cv)
                                          (lambda (y l s) (cons* s "\n" l))
                                          '())) )

(define canvas-dump canvas->vector)

;@lines list-of string, where all s in lines same length
(define (list->char-canvas lines)
  (if (null? lines)
      (%make-char-canvas 0 0 (%make-cmap 0 0 #\nul))
      (%make-char-canvas (string-length (car lines)) (length lines)
                         (string->vector (apply string-append lines))) ) )

(define (lines-chars-info lines)
  (let* ((wd (apply max (map string-length lines)))
         (ht (length lines))
         (c (current-plotter-bkgd-char))
         (lines (map (lambda (ln)
                       (if (< (string-length ln) wd)
                           (string-pad-right ln (- wd (string-length ln)) c)
                           ln))
                     lines)) )
    (values wd ht (reverse! lines)) ) )

(define (string-chars-info str)
  (lines-chars-info (with-input-from-string str read-lines)) )

(define (string->char-canvas str)
  (receive (w h lines) (string-chars-info str)
    (list->char-canvas lines) ) )

(define (string->canvas str)
  (receive (w h lines) (string-chars-info str)
    (new-canvas (list->char-canvas lines) w h) ) )

(define (with-output-to-canvas thunk)
  (string->canvas (with-output-to-string thunk)) )

;FIXME should frame chars be a string?

(define (make-frame-chars thc bhc lvc rvc tlc trc blc brc)
  (%make-frame-chars thc bhc lvc rvc tlc trc blc brc) )

(define (frame-chars? obj) (%frame-chars? obj))

;                     #(thc bhc lvc rvc tlc trc blc brc)
(define ASCII-FRAME-CHARS (%make-frame-chars #\- #\- #\| #\| #\+ #\+ #\+ #\+))
(define THIN-FRAME-CHARS  (%make-frame-chars #\─ #\─ #\│ #\│ #\┌ #\┐ #\└ #\┘))
(define THICK-FRAME-CHARS (%make-frame-chars #\━ #\━ #\┃ #\┃ #\┏ #\┓ #\┗ #\┛))

(define (canvas-print cv #!optional frm)
  (check-canvas 'canvas-print cv)
  (if (not frm)
      ;then dump
      (for-each print (canvas->list cv))
      ;else surround
      (let ((frm (if (boolean? frm) ASCII-FRAME-CHARS frm))
            (lns (canvas->list cv)) )
        (unless (null? lns)
          (let* ((wd (string-length (car lns)))
                 (hd (make-string wd (%frame-th frm)))
                 (tl (make-string wd (%frame-bh frm))) )
            (print (%frame-tl frm) hd (%frame-tr frm))
            (for-each (lambda (ln) (print (%frame-lv frm) ln (%frame-rv frm))) lns)
            (print (%frame-bl frm) tl (%frame-br frm))) ) ) ) )

;;

(define (norm-plot-config loc cfg n d)
  (cond ((char? cfg)
          (%make-plt-cfg n cfg) )
        ((vector? cfg)
          (let ((l (%plt-cfg-cnt cfg)))
            (cond ((fx= l n)
                    cfg )
                  ((fx< l n)
                    (let ((ncfg (%make-plt-cfg n d)))
                      (vector-copy! ncfg 0 cfg 0 l)
                      ncfg) )
                  (else
                    (error loc "invalid configuration, too many elements" cfg n d)) ) ) )
        (else
          (error loc "invalid configuration, unrecognized form" cfg n d))) )

(define (validate-plotter-configuration loc cfg n #!optional (d (current-plotter-char)))
  (let ((ncfg (norm-plot-config loc cfg n d)) )
    (let check ((i 0))
      (cond ((fx>= i n)
              ncfg )
            ((%plt-cfg-char? (%plt-cfg-c i ncfg))
              (check (fx+ i 1)) )
            (else
              (error loc "invalid configuration, invalid element" n ncfg)) ) ) ) )

(define (plot-config . args)
  (validate-plotter-configuration 'plot-config
                                  (%plt-cfg args) (length args)) )

;;

(define (canvas-draw cv x y #!optional (c (current-plotter-char)))
  (*canvas-draw (check-canvas 'canvas-draw cv) x y c) )

(define (canvas-draw-string cv x y s)
  (*canvas-draw-string (check-canvas 'canvas-draw-string cv) x y s) )

(define (canvas-draw-line cv x0 y0 xn yn #!optional (c (current-plotter-char)))
  (*canvas-draw-line (check-canvas 'canvas-draw-line cv) x0 y0 xn yn c) )

(define (canvas-draw-lines cv ls #!optional (cfg (current-plotter-char)))
  (let ((len (length ls)))
    (unless (zero? len)
      (assert (even? len) 'canvas-draw-lines "must be list-of x y ..." ls)
      (let ((cfg (validate-plotter-configuration 'canvas-draw-lines cfg (fx/ len 2))))
        (*canvas-draw-lines cv ls cfg) ) ) ) )

;;

(define (canvas-plot cv x y #!optional (c (current-plotter-char)))
  (check-canvas 'canvas-plot cv)
  (*canvas-draw cv (%real-x cv x) (%real-y cv y) c) )

(define (canvas-plot-string cv x y s)
  (check-canvas 'canvas-plot-string cv)
  (*canvas-draw-string cv (%real-x cv x) (%real-y cv y) s) )

(define (canvas-plot-line cv x0 y0 xn yn #!optional (c (current-plotter-char)))
  (check-canvas 'canvas-plot-line cv)
  (*canvas-draw-line cv
                     (%real-x cv x0) (%real-y cv y0)
                     (%real-x cv xn) (%real-y cv yn)
                     c) )

(define (canvas-plot-lines cv ls #!optional (cfg (current-plotter-char)))
  (check-canvas 'canvas-plot-lines cv)
  (let ((len (length ls)))
    (unless (zero? len)
      (assert (even? len) 'canvas-plot-lines "must be list-of x y ..." ls)
      (let ((cfg (validate-plotter-configuration 'canvas-plot-lines cfg (fx/ len 2))))
        (*canvas-draw-lines cv (virtuals->reals cv ls) cfg) ) ) ) )

;; Record Printing

(define (char-canvas-record-print ccv #!optional (port (current-output-port)))
  (format port "#<~S ~S X ~S>" char-canvas
                               (%char-canvas-columns ccv) (%char-canvas-rows ccv)) )

(define (canvas-record-print cv #!optional (port (current-output-port)))
  (format port "#<~S ~S X ~S (~S X ~S)>" canvas
                                         (canvas-width cv) (canvas-height cv)
                                         (canvas-columns cv) (canvas-rows cv)) )

(set-record-printer! char-canvas char-canvas-record-print)
(set-record-printer! canvas canvas-record-print)

) ;module (s9fes char-canvas)