;;
;; box-drawing.scm
;;
;; Unicode box drawing combiners.
;;
;; ISC License
;;
;; Copyright 2023 Dominik Pantůček <dominik.pantucek@trustica.cz>
;;
;; Permission to use, copy, modify, and/or distribute this software
;; for any purpose with or without fee is hereby granted, provided
;; that the above copyright notice and this permission notice appear
;; in all copies.
;; 
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;;

(declare (unit box-drawing))

(module
 box-drawing
 (
  combine-line-cells

  line-cell-somewhat-heavy?

  line-cell->unicode-char
  line-cell->utf8-string

  line-cell->ascii-char

  char->line-cell

  combine-line-char
 
  line-style-none

  combine-line-style

  line-cell-north
  line-cell-east
  line-cell-west
  line-cell-south

  spec->line-style
  line-style-spec?

  make-line-cell
  make-straight-horizontal-line-cell
  make-straight-vertical-line-cell
  make-straight-horizontal-line-cell*
  make-straight-vertical-line-cell*

  line-cell-none

  set-line-cell-north
  set-line-cell-west
  set-line-cell-east
  set-line-cell-south

  spec->horizontal-line-cell
  spec->vertical-line-cell

  spec->top-left-corner-line-cell
  spec->top-right-corner-line-cell
  spec->bottom-left-corner-line-cell
  spec->bottom-right-corner-line-cell

  extract-line-cell-top-left
  extract-line-cell-top-right
  extract-line-cell-bottom-left
  extract-line-cell-bottom-right

  box-drawing-tests!
  )

 (import scheme
	 (chicken base)
	 (chicken bitwise)
	 util-utf8
	 racket-kwargs
	 testing)

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Bit manipulators

 (define-syntax define-bit-predicate
   (syntax-rules ()
     ((_ name mask value)
      (define (name bits)
	(= (bitwise-and bits mask) value)))))

 (define-syntax define-bit-setter
   (syntax-rules ()
     ((_ name andmask ormask)
      (define (name bits)
	(bitwise-ior (bitwise-and bits andmask) ormask)))))

 (define-syntax define-bit-combiner
   (syntax-rules ()
     ((_ name mask)
      (define (name a b)
	(bitwise-ior
	 (bitwise-and a mask)
	 (bitwise-and b mask))))))

 (define-syntax define-bit-accessor
   (syntax-rules ()
     ((_ name shift mask)
      (define (name bits)
	(bitwise-and
	 (arithmetic-shift bits (- shift)) mask)))))

 (define-syntax define-bit-accessor-setter
   (syntax-rules ()
     ((_ name shift mask)
      (define (name bits ormask)
	(bitwise-ior (bitwise-and (bitwise-not (arithmetic-shift mask shift))
				  bits)
		     (arithmetic-shift (bitwise-and ormask mask)
				       shift))))))

 (define-syntax define-inverted-bit-predicate
   (syntax-rules ()
     ((_ name mask value)
      (define (name bits)
	(not (= (bitwise-and bits mask) 0))))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Line thickness
 ;; * none
 ;; * light
 ;; * heavy
 ;; Bit indices: 10
 ;;              ||_ lower bit: light thickness
 ;;              |_ higher bit: heavy thickness
 ;; Values:
 ;;   00 - none
 ;;   01 - light
 ;;   10 - heavy
 ;;   11 - heavy

 (define line-thickness-none 0)
 (define line-thickness-light 1)
 (define line-thickness-heavy 2)

 (define-bit-predicate line-thickness-light? 3 1)
 (define-bit-predicate line-thickness-heavy? 2 2)
 (define-bit-predicate line-thickness-none? 3 0)

 (define-bit-setter set-line-thickness-light 3 1)
 (define-bit-setter set-line-thickness-heavy 3 2)
 (define-bit-setter set-line-thickness-none 0 0)

 (define-bit-combiner combine-line-thickness 3)

 (define-inverted-bit-predicate line-thickness-some? 3 0)

 (define (line-thickness-normalize thickness)
   (if (line-thickness-heavy? thickness)
       line-thickness-heavy
       thickness))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Line type
 ;; * none
 ;; * dashed
 ;; * solid
 ;; Bit indices: 10
 ;;              ||_ lower bit: dashed type
 ;;              |_ higher bit: solid type
 ;; Values:
 ;;   * 00 - none
 ;;   * 01 - dashed
 ;;   * 10 - solid
 ;;   * 11 - solid

 (define line-type-none 0)
 (define line-type-dashed 1)
 (define line-type-solid 2)

 (define-bit-predicate line-type-dashed? 3 1)
 (define-bit-predicate line-type-solid? 2 2)
 (define-bit-predicate line-type-none? 3 0)

 (define-bit-setter set-line-type-dashed 3 1)
 (define-bit-setter set-line-type-solid 3 2)
 (define-bit-setter set-line-type-none 0 0)

 (define-bit-combiner combine-line-type 3)

 (define-inverted-bit-predicate line-type-some? 3 0)

 (define (line-type-normalize type)
   (if (line-type-solid? type)
       line-type-solid
       type))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Line style
 ;; * thickness
 ;; * type
 ;; Double-bit indices: 10
 ;;                     ||_ lower nibble: thickness
 ;;                     |_ higher nibble: type
 ;; Bit indices: 3210
 ;;              ||||_ light thickness
 ;;              |||_ heavy thickness
 ;;              ||_ dashed type
 ;;              |_ solid type

 (define line-style-none 0)

 ;; Creates line style from specific thickness and type
 (define (make-line-style thickness type)
   (bitwise-ior
    (arithmetic-shift (bitwise-and type 3) 2)
    (bitwise-and (bitwise-and thickness 3))))

 (define-bit-accessor line-style-thickness 0 3)
 (define-bit-accessor line-style-type 2 3)

 (define-bit-predicate line-style-thickness-light? 3 1)
 (define-bit-predicate line-style-thickness-heavy? 2 2)
 (define-bit-predicate line-style-thickness-none? 3 0)
 (define-bit-predicate line-style-type-dashed? 12 4)
 (define-bit-predicate line-style-type-solid? 8 8)
 (define-bit-predicate line-style-type-none? 12 0)

 (define-bit-setter set-line-style-thickness-light 15 1)
 (define-bit-setter set-line-style-thickness-heavy 15 2)
 (define-bit-setter set-line-style-thickness-none 12 0)
 (define-bit-setter set-line-style-type-dashed 15 4)
 (define-bit-setter set-line-style-type-solid 15 8)
 (define-bit-setter set-line-style-type-none 3 0)

 (define-bit-combiner combine-line-style 15)

 (define-inverted-bit-predicate line-style-thickness-some? 3 0)
 (define-inverted-bit-predicate line-style-type-some? 12 0)

 (define (line-style-some? style)
   (and (line-style-thickness-some? style)
	(line-style-type-some? style)))

 (define (line-style-none? style)
   (or (line-style-thickness-none? style)
       (line-style-type-none? style)))

 (define (line-style-normalize style)
   (make-line-style
    (line-thickness-normalize (line-style-thickness style))
    (line-type-normalize (line-style-type style))))

 (define (line-style-heavy? style)
   (and (line-style-type-some? style)
	(line-style-thickness-heavy? style)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Line cell
 ;; * north
 ;; * west
 ;; * east
 ;; * south
 ;; Nibble indices: 3210
 ;;                 ||||_ north style
 ;;                 |||_ west style
 ;;                 ||_ east style
 ;;                 |_ south style
 ;; Bit indices: fedcba9876543210
 ;;              ||||||||||||||||_ north light thickness
 ;;              |||||||||||||||_ north heavy thickness
 ;;              ||||||||||||||_ north dashed type
 ;;              |||||||||||||_ north solid type
 ;;              ||||||||||||_ west light thickness
 ;;              |||||||||||_ west heavy thickness
 ;;              ||||||||||_ west dashed type
 ;;              |||||||||_ west solid type
 ;;              ||||||||_ east light thickness
 ;;              |||||||_ east heavy thickness
 ;;              ||||||_ east dashed type
 ;;              |||||_ east solid type
 ;;              ||||_ south light thickness
 ;;              |||_ south heavy thickness
 ;;              ||_ south dashed type
 ;;              |_ south solid type

 (define line-cell-none 0)

 (define (make-line-cell n w e s)
   (bitwise-ior
    (bitwise-and n 15)
    (arithmetic-shift (bitwise-and w 15) 4)
    (arithmetic-shift (bitwise-and e 15) 8)
    (arithmetic-shift (bitwise-and s 15) 12)))

 (define-bit-accessor line-cell-north 0 15)
 (define-bit-accessor line-cell-west 4 15)
 (define-bit-accessor line-cell-east 8 15)
 (define-bit-accessor line-cell-south 12 15)

 (define-bit-accessor-setter set-line-cell-north 0 15)
 (define-bit-accessor-setter set-line-cell-west 4 15)
 (define-bit-accessor-setter set-line-cell-east 8 15)
 (define-bit-accessor-setter set-line-cell-south 12 15)

 (define-bit-combiner combine-line-cells 65535)

 (define (make-straight-horizontal-line-cell thickness type)
   (let ((style (make-line-style thickness type)))
     (make-line-cell 0 style style 0)))

 (define (make-straight-vertical-line-cell thickness type)
   (let ((style (make-line-style thickness type)))
     (make-line-cell style 0 0 style)))

 (define (make-straight-horizontal-line-cell* style)
   (make-line-cell 0 style style 0))

 (define (make-straight-vertical-line-cell* style)
   (make-line-cell style 0 0 style))

 (define (make-cross-line-cell thickness type)
   (let ((style (make-line-style thickness type)))
     (make-line-cell style style style style)))

 (define (line-cell-straight-horizontal? cell)
   (and (line-style-none? (line-cell-north cell))
	(line-style-none? (line-cell-south cell))
	(line-style-some? (line-cell-west cell))
	(line-style-some? (line-cell-east cell))
	(= (line-style-normalize (line-cell-west cell))
	   (line-style-normalize (line-cell-east cell)))))

 (define (line-cell-straight-vertical? cell)
   (and (line-style-some? (line-cell-north cell))
	(line-style-none? (line-cell-west cell))
	(line-style-none? (line-cell-east cell))
	(line-style-some? (line-cell-south cell))
	(= (line-style-normalize (line-cell-north cell))
	   (line-style-normalize (line-cell-south cell)))))

 (define (line-cell-mostly-horizontal? cell)
   (and (line-style-none? (line-cell-north cell))
	(line-style-none? (line-cell-south cell))
	(line-style-some? (line-cell-west cell))
	(line-style-some? (line-cell-east cell))))

 (define (line-cell-mostly-vertical? cell)
   (and (line-style-some? (line-cell-north cell))
	(line-style-none? (line-cell-west cell))
	(line-style-none? (line-cell-east cell))
	(line-style-some? (line-cell-south cell))))

 (define (line-cell-none? cell)
   (and (line-style-none? (line-cell-north cell))
	(line-style-none? (line-cell-west cell))
	(line-style-none? (line-cell-east cell))
	(line-style-none? (line-cell-south cell))))

 (define (line-cell-somewhat-heavy? cell)
   (or (line-style-heavy? (line-cell-north cell))
       (line-style-heavy? (line-cell-west cell))
       (line-style-heavy? (line-cell-east cell))
       (line-style-heavy? (line-cell-south cell))))

 (define (line-cell-straight-horizontal-type cell)
   (line-style-type
    (line-cell-west cell)))

 (define (line-cell-straight-vertical-type cell)
   (line-style-type
    (line-cell-north cell)))

 (define (line-cell-straight-horizontal-dashed? cell)
   (and (line-cell-straight-horizontal? cell)
	(line-type-dashed?
	 (line-cell-straight-horizontal-type cell))))

 (define (line-cell-straight-vertical-dashed? cell)
   (and (line-cell-straight-vertical? cell)
	(line-type-dashed?
	 (line-cell-straight-vertical-type cell))))

 (define (line-cell-straight-horizontal-thickness cell)
   (line-style-thickness
    (line-cell-west cell)))

 (define (line-cell-straight-vertical-thickness cell)
   (line-style-thickness
    (line-cell-north cell)))

 (define (line-cell-junction-compress cell)
   (let ((n (line-thickness-normalize (line-style-thickness (line-cell-north cell))))
	 (w (line-thickness-normalize (line-style-thickness (line-cell-west cell))))
	 (e (line-thickness-normalize (line-style-thickness (line-cell-east cell))))
	 (s (line-thickness-normalize (line-style-thickness (line-cell-south cell)))))
     (+ n
	(* w 3)
	(* e 9)
	(* s 27))))

 (define line-cell-char-junctions
   (vector  ;; SEWN (base-3 representation)
    #\space ;; 0000
    #\x2575 ;; 0001
    #\x2579 ;; 0002
    #\x2574 ;; 0010
    #\x2518 ;; 0011
    #\x251a ;; 0012
    #\x2578 ;; 0020
    #\x2519 ;; 0021
    #\x251b ;; 0022

    #\x2576 ;; 0100
    #\x2514 ;; 0101
    #\x2516 ;; 0102
    #\x2500 ;; 0110
    #\x2534 ;; 0111
    #\x2538 ;; 0112
    #\x257e ;; 0120
    #\x2535 ;; 0121
    #\x2539 ;; 0122

    #\x257a ;; 0200
    #\x2515 ;; 0201
    #\x2517 ;; 0202
    #\x257c ;; 0210
    #\x2536 ;; 0211
    #\x253a ;; 0212
    #\x2501 ;; 0220
    #\x2537 ;; 0221
    #\x253b ;; 0222

    #\x2577 ;; 1000
    #\x2502 ;; 1001
    #\x257f ;; 1002
    #\x2510 ;; 1010
    #\x2524 ;; 1011
    #\x2526 ;; 1012
    #\x2511 ;; 1020
    #\x2525 ;; 1021
    #\x2529 ;; 1022

    #\x250c ;; 1100
    #\x251c ;; 1101
    #\x251e ;; 1102
    #\x252c ;; 1110
    #\x253c ;; 1111
    #\x2540 ;; 1112
    #\x252d ;; 1120
    #\x253d ;; 1121
    #\x2543 ;; 1122

    #\x250d ;; 1200
    #\x251d ;; 1201
    #\x2521 ;; 1202
    #\x252e ;; 1210
    #\x253e ;; 1211
    #\x2544 ;; 1212
    #\x252f ;; 1220
    #\x253f ;; 1221
    #\x2547 ;; 1222

    #\x257b ;; 2000
    #\x257d ;; 2001
    #\x2503 ;; 2002
    #\x2512 ;; 2010
    #\x2527 ;; 2011
    #\x2528 ;; 2012
    #\x2513 ;; 2020
    #\x252a ;; 2021
    #\x252b ;; 2022

    #\x250e ;; 2100
    #\x251f ;; 2101
    #\x2520 ;; 2102
    #\x2530 ;; 2110
    #\x2541 ;; 2111
    #\x2542 ;; 2112
    #\x2531 ;; 2120
    #\x2545 ;; 2121
    #\x2549 ;; 2122

    #\x250f ;; 2200
    #\x2522 ;; 2201
    #\x2523 ;; 2202
    #\x2532 ;; 2210
    #\x2546 ;; 2211
    #\x254a ;; 2212
    #\x2533 ;; 2220
    #\x2548 ;; 2221
    #\x254b ;; 2222
    ))

 (define line-cell-char-horizontal-light-dashed #\x254c)
 (define line-cell-char-horizontal-heavy-dashed #\x254d)
 (define line-cell-char-vertical-light-dashed #\x254e)
 (define line-cell-char-vertical-heavy-dashed #\x254f)

 (define (line-cell->unicode-char cell)
   (cond ((line-cell-straight-horizontal-dashed? cell)
	  (let ((thickness (line-cell-straight-horizontal-thickness cell)))
	    (if (line-thickness-light? thickness)
		line-cell-char-horizontal-light-dashed
		line-cell-char-horizontal-heavy-dashed)))
	 ((line-cell-straight-vertical-dashed? cell)
	  (let ((thickness (line-cell-straight-vertical-thickness cell)))
	    (if (line-thickness-light? thickness)
		line-cell-char-vertical-light-dashed
		line-cell-char-vertical-heavy-dashed)))
	 (else
	  (let ((compressed (line-cell-junction-compress cell)))
	    (vector-ref line-cell-char-junctions compressed)))))

 (define line-cell-string-junctions
   (apply
    vector
    (map utf8-char->string
	 (vector->list line-cell-char-junctions))))

 (define line-cell-string-horizontal-light-dashed
   (utf8-char->string line-cell-char-horizontal-light-dashed))
 (define line-cell-string-horizontal-heavy-dashed
   (utf8-char->string line-cell-char-horizontal-heavy-dashed))
 (define line-cell-string-vertical-light-dashed
   (utf8-char->string line-cell-char-vertical-light-dashed))
 (define line-cell-string-vertical-heavy-dashed
   (utf8-char->string line-cell-char-vertical-heavy-dashed))

 (define (line-cell->utf8-string cell)
   (cond ((line-cell-straight-horizontal-dashed? cell)
	  (let ((thickness (line-cell-straight-horizontal-thickness cell)))
	    (if (line-thickness-light? thickness)
		line-cell-string-horizontal-light-dashed
		line-cell-string-horizontal-heavy-dashed)))
	 ((line-cell-straight-vertical-dashed? cell)
	  (let ((thickness (line-cell-straight-vertical-thickness cell)))
	    (if (line-thickness-light? thickness)
		line-cell-string-vertical-light-dashed
		line-cell-string-vertical-heavy-dashed)))
	 (else
	  (let ((compressed (line-cell-junction-compress cell)))
	    (vector-ref line-cell-string-junctions compressed)))))

 (define (line-cell->ascii-char cell)
   (cond ((line-cell-mostly-horizontal? cell)
	  #\-)
	 ((line-cell-mostly-vertical? cell)
	  #\|)
	 ((line-cell-none? cell)
	  #\space)
	 (else
	  #\+)))

 (define line-cell-reverse-lookup (make-vector 128 line-cell-none))
 (let loop ((idx 1))
   (when (< idx 81)
     (let* ((ch (vector-ref line-cell-char-junctions idx))
	    (cp (char->integer ch))
	    (ridx (- cp #x2500))
	    (n (modulo idx 3))
	    (w (modulo (quotient idx 3) 3))
	    (e (modulo (quotient idx 9) 3))
	    (s (modulo (quotient idx 27) 3)))
       (vector-set! line-cell-reverse-lookup
		    ridx
		    (make-line-cell (make-line-style n line-type-solid)
				    (make-line-style w line-type-solid)
				    (make-line-style e line-type-solid)
				    (make-line-style s line-type-solid)))
       (loop (add1 idx)))))

 (define* (char->line-cell char #:bold (bold? #f))
   (case char
     ((#\-) (make-straight-horizontal-line-cell bold? 'solid))
     ((#\|) (make-straight-vertical-line-cell bold? 'solid))
     ((#\+) (make-cross-line-cell bold? 'solid))
     ((#\space) line-cell-none)
     (else
      (let ((cp (char->integer char)))
	(cond ((or (< cp #x2500)
		   (> cp #x257f))
	       line-cell-none)
	      (else
	       (vector-ref line-cell-reverse-lookup (- cp #x2500))))))))

 (define (combine-line-char ch1 ch2)
   (line-cell->unicode-char
    (combine-line-cells
     (char->line-cell ch1)
     (char->line-cell ch2))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Style specifications

 (define (spec->line-thickness spec)
   (case spec
     ((light) line-thickness-light)
     ((heavy) line-thickness-heavy)
     (else line-thickness-none)))

 (define (spec->line-type spec)
   (case spec
     ((dashed) line-type-dashed)
     ((solid) line-type-solid)
     (else line-type-none)))

 (define (spec->line-style spec)
   (cond ((symbol? spec)
	  (case spec
	    ((light heavy)
	     (make-line-style (spec->line-thickness spec)
			      line-type-solid))
	    ((dashed solid)
	     (make-line-style line-thickness-light
			      (spec->line-type spec)))
	    (else 0)))
	 ((list? spec)
	  (let ((res (foldl
		      (lambda (acc spec1)
			(combine-line-style
			 acc
			 (case spec1
			   ((light heavy)
			    (make-line-style (spec->line-thickness spec1)
					     line-type-none))
			   ((dashed solid)
			    (make-line-style line-thickness-none
					     (spec->line-type spec1)))
			   (else line-style-none))))
		      line-style-none
		      spec)))
	    (cond ((and (line-style-thickness-some? res)
			(line-style-type-none? res))
		   (set-line-style-type-solid res))
		  ((and (line-style-thickness-none? res)
			(line-style-type-some? res))
		   (set-line-style-thickness-light res))
		  (else
		   res))))
	 (else line-style-none)))

 (define (line-style-spec? spec)
   (or (memq spec '(none light heavy dashed solid))
       (and (list? spec)
	    (let loop ((lst spec))
	      (if (null? lst)
		  #t
		  (if (line-style-spec? (car spec))
		      (loop (cdr lst))
		      #f))))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Cell makers

 (define-syntax define-spec->line-cell
   (syntax-rules ()
     ((_ name spec style a b c d)
      (define (name spec)
	(let ((style (spec->line-style spec)))
	  (make-line-cell a b c d))))))

 (define-spec->line-cell spec->horizontal-line-cell spec style 0 style style 0)
 (define-spec->line-cell spec->vertical-line-cell spec style style 0 0 style)

 (define-spec->line-cell spec->north-west-line-cell spec style style style 0 0)
 (define-spec->line-cell spec->north-east-line-cell spec style style 0 style 0)
 (define-spec->line-cell spec->south-west-line-cell spec style 0 style 0 style)
 (define-spec->line-cell spec->south-east-line-cell spec style 0 0 style style)

 (define spec->top-left-corner-line-cell spec->south-east-line-cell)
 (define spec->top-right-corner-line-cell spec->south-west-line-cell)
 (define spec->bottom-left-corner-line-cell spec->north-east-line-cell)
 (define spec->bottom-right-corner-line-cell spec->north-west-line-cell)

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Cell extractors

 (define ((make-line-cell-extractor n w e s) c)
   (let ((sm (if s 15 0))
	 (em (if e 240 0))
	 (wm (if w 3840 0))
	 (nm (if n 61440 0)))
     (bitwise-and c (bitwise-ior sm em wm nm))))

 (define extract-line-cell-north-west
   (make-line-cell-extractor #t #t #f #f))

 (define extract-line-cell-north-east
   (make-line-cell-extractor #t #f #t #f))

 (define extract-line-cell-south-west
   (make-line-cell-extractor #f #t #f #t))

 (define extract-line-cell-south-east
   (make-line-cell-extractor #f #f #t #t))

 (define extract-line-cell-top-left extract-line-cell-south-east)
 (define extract-line-cell-top-right extract-line-cell-south-west)
 (define extract-line-cell-bottom-left extract-line-cell-south-east)
 (define extract-line-cell-bottom-right extract-line-cell-south-west)

 ;; Self-tests
 (define (box-drawing-tests!)
   (run-tests
    box-drawing
    (test-equal? spec->line-thickness
		 (spec->line-thickness 'none)
		 0)
    (test-equal? spec->line-thickness
		 (spec->line-thickness 'light)
		 1)
    (test-equal? spec->line-thickness
		 (spec->line-thickness 'heavy)
		 2)
    (test-equal? spec->line-type
		 (spec->line-type 'none)
		 0)
    (test-equal? spec->line-type
		 (spec->line-type 'dashed)
		 1)
    (test-equal? spec->line-type
		 (spec->line-type 'solid)
		 2)
    (test-equal? spec->line-style
		 (spec->line-style 'solid) ;; light implied
		 #b1001)
    (test-equal? spec->line-style
		 (spec->line-style 'dashed) ;; light implied
		 #b101)
    (test-equal? spec->line-style
		 (spec->line-style 'light) ;; solid implied
		 #b1001)
    (test-equal? spec->line-style
		 (spec->line-style 'heavy) ;; solid implied
		 #b1010)
    (test-equal? combine-line-style
		 (combine-line-style #b1001 #b110)
		 #b1111)
    (test-equal? spec->line-style
		 (spec->line-style '(solid light))
		 #b1001)
    (test-equal? spec->line-style
		 (spec->line-style '(solid)) ;; light implied
		 #b1001)
    (test-equal? spec->line-style
		 (spec->line-style '(dashed)) ;; light implied
		 #b101)
    (test-equal? spec->line-style
		 (spec->line-style '(light)) ;; solid implied
		 #b1001)
    (test-equal? spec->line-style
		 (spec->line-style '(heavy)) ;; solid implied
		 #b1010)
    ))
 
 )