;;;; s9fes-char-graphics-test.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18

(import test)
(import (test-utils gloss) (only (chicken format) format))
(import (test-utils test))

(import (only (chicken port) with-output-to-string))
(import (chicken fixnum))
(import (s9fes char-canvas rect) (s9fes char-canvas))
(import (s9fes char-canvas shape box)
        (s9fes char-canvas shape oval)
        (s9fes char-canvas shape cross))

;;;

(define CD-TEST-RESULT-1 (apply string-append '(
  "##      **\n"
  "  ##  **  \n"
  "    **    \n"
  "  **  ##  \n"
  "**      ##\n")))

(define CD-TEST-RESULT-2 (apply string-append '(
  "          \n"
  "          \n"
  "          \n"
  "          \n"
  "          \n")))

(define CD-TEST-RESULT-3 (apply string-append '(
  "##      **\n"
  "  ##  **  \n"
  "    **    \n"
  "  Hello, W\n"
  "**      ##\n")))

(define CD-TEST-RESULT-4 (apply string-append '(
  "    221   \n"
  "   2   1  \n"
  "  3 221 0 \n"
  " 3 3   0 0\n"
  " 4 4   7 7\n"
  " 4 4   7 7\n"
  "  4 566 7 \n"
  "   5   6  \n"
  "    566   \n"
  "          \n")))

(define CD-TEST-RESULT-5 (apply string-append '(
  "    *     \n"
  "    *     \n"
  "####*#####\n"
  "    *     \n"
  "    *     \n")))

(define CD-TEST-RESULT-6 (apply string-append '(
  "    22    \n"
  "   2      \n"
  "    22  0 \n"
  "       0 0\n"
  " 4 4   0 0\n"
  " 4 4      \n"
  "  4  66   \n"
  "       6  \n"
  "     66   \n"
  "          \n")))

(define CD-TEST-RESULT-7 (apply string-append '(
  "        22\n"
  "      22  \n"
  "    12    \n"
  " 011      \n"
  "0         \n")))

(define CD-TEST-RESULT-8 (apply string-append '(
  "  ******  \n"
  " *      * \n"
  "*        *\n"
  "*        *\n"
  "*        *\n"
  "*        *\n"
  "*        *\n"
  "*        *\n"
  " *      * \n"
  "  ******  \n")))

(define CD-TEST-RESULT-9 (apply string-append '(
  "        22\n"
  "       2  \n"
  "          \n"
  " 01       \n"
  "0         \n")))

(define CD-TEST-RESULT-10 (apply string-append '(
  "        22\n"
  "   ####2  \n"
  "   ####   \n"
  " 01####   \n"
  "0         \n")))

(define CD-TEST-RESULT-11 (apply string-append '(
  "        22\n"
  "      22  \n"
  "   12     \n"
  "011       \n"
  "          \n")))

(define CD-TEST-RESULT-12 (apply string-append '(
  "        22\n"
  "      22  \n"
  "  12      \n"
  "11        \n"
  "          \n")))

(define CD-TEST-RESULT-13 (apply string-append '(
  "        22\n"
  "      22  \n"
  "          \n"
  "          \n"
  "          \n")))

(define CD-TEST-RESULT-14 (apply string-append '(
  "        22\n"
  "      22  \n"
  "011       \n"
  "          \n"
  "          \n")))

(define CD-TEST-RESULT-15 (apply string-append '(
  "        22\n"
  "      22  \n"
  "11        \n"
  "          \n"
  "          \n")))

#|
  "        22\n"
  "      22  \n"
  "    12    \n"
  " 011      \n"
  "0         \n")))
|#

(define CD-TEST-RESULT-16 (apply string-append '(
  "        22\n"
  "      22  \n"
  "    12    \n"
  "          \n"
  "          \n")))

(define CD-TEST-RESULT-17 (apply string-append '(
  "   \n"
  " 12\n"
  "1  \n")))

(define CD-TEST-RESULT-18 (apply string-append '(
  "          \n"
  "          \n"
  "    12    \n"
  "   1      \n"
  "          \n")))

;;;

(test-begin "S9fES Char Graphics")

(test-group "canvas props"
  (let ((cv (make-canvas 10 5 10 10)))
    (test-assert (canvas? cv))
    (test-assert (not (canvas? 2)))

    (test 10 (canvas-columns cv))
    (test 5 (canvas-rows cv))
    (test 10 (canvas-width cv))
    (test 10 (canvas-height cv)) )
)

(test-group "canvas line"
  (let ((cv (make-canvas 10 5 10 10)))
    (canvas-plot-lines cv '(0 0 2 3 5 5 9 9) '(#\0 #\1 #\2))
    (test "polyline" CD-TEST-RESULT-7 (canvas->string cv))

#| ;thin/thick vert & corners don't `print`
(newline)
(canvas-print cv)
(newline)
(canvas-print cv #t)
(newline)
(canvas-print cv THIN-FRAME-CHARS)
(newline)
(canvas-print cv THICK-FRAME-CHARS)
(newline)
|#

    (canvas-clear cv)
    (test "clears" CD-TEST-RESULT-2 (canvas->string cv)) )
)

(test-group "rect"
  (let ((rt1 (rect 10 30 20 20))
        (rt2 (rect 20 20 30 30))
        (rt3 (rect 70 70 20 20)) )

    (test-assert (rect-overlaps? rt1 rt1))
    (test-assert (rect-overlaps? rt1 rt2))
    (test-assert (not (rect-overlaps? rt1 rt3)))

    (test (rect 20 30 10 20) (rect-intersection rt1 rt2))
    (test (rect-null) (rect-intersection rt1 rt3))

    (test (rect 10 20 40 30) (rect-union rt1 rt2))
    (test (rect 10 30 80 60) (rect-union rt1 rt3))
  )
)

(test-group "copy"
  (let ((cv (make-canvas 10 5 10 10)))
    (canvas-plot-lines cv '(0 0 2 3 5 5 9 9) '(#\0 #\1 #\2)) ;CD-TEST-RESULT-7

    (test "copies whole" CD-TEST-RESULT-7 (canvas->string (canvas-copy cv)))
    (test "copies part" CD-TEST-RESULT-17 (canvas->string (canvas-copy cv (rect 3 2 3 6)))) )
)

(test-group "paste"
  (let ((scv (make-canvas 10 5 10 10))
        (cv (make-canvas 10 5 10 10)))
    (canvas-plot-lines scv '(0 0 2 3 5 5 9 9) '(#\0 #\1 #\2)) ;CD-TEST-RESULT-7

    (canvas-paste cv scv)
    (test "pastes whole" CD-TEST-RESULT-7 (canvas->string cv))

    (canvas-clear cv)
    (canvas-paste cv (canvas-copy scv (rect 3 2 3 6)) 3 2)
    (test "pastes part" CD-TEST-RESULT-18 (canvas->string cv)) )
)

(test-group "basic clear flood scroll (ar)"
  (let ((cv (make-canvas 10 5 10 10)))
    (canvas-plot-lines cv '(0 0 2 3 5 5 9 9) '(#\0 #\1 #\2)) ;CD-TEST-RESULT-7

    (canvas-clear cv (rect 3 2 4 6))
    (test "clears region" CD-TEST-RESULT-9 (canvas->string cv))

    (canvas-flood cv #\# (rect 3 2 4 6))
    (test "floods region" CD-TEST-RESULT-10 (canvas->string cv))

    (canvas-scroll cv 10 5)
    (test "scrolls whole" CD-TEST-RESULT-2 (canvas->string cv)) )
)

(test-group "scroll"
  (let ((cv (make-canvas 10 5 10 10)))

    (define (starting-slate)
      (canvas-clear cv)
      (canvas-plot-lines cv '(0 0 2 3 5 5 9 9) '(#\0 #\1 #\2)) ) ;CD-TEST-RESULT-7

    (test-group "left"

      ;whole
      (test-each "whole"
        `(,CD-TEST-RESULT-11 ,CD-TEST-RESULT-12 ,CD-TEST-RESULT-13)
        (dx)
        (begin
         (starting-slate)
         (canvas-scroll cv dx 0 (rect 0 0 10 6))
         (canvas->string cv) )
        '(-1 -2 -10))

      ;top
      (test-each "top"
        `(,CD-TEST-RESULT-14 ,CD-TEST-RESULT-15 ,CD-TEST-RESULT-16)
        (dx)
        (begin
         (starting-slate)
         (canvas-scroll cv dx 2 (rect 0 0 10 6))
         (canvas->string cv) )
        '(-1 -2 -10))

      ;bottom
      ;left
      ;right
      ;center
    )
  )
)

(test-group "shapes - cross draw"

  (define draw-x
    (let ((pltr (shape-cross-x 10 5 '(#\# #\*))))
      (lambda (#!optional cv)
        (if (not cv) (pltr)
            (begin
              (pltr cv)
              (canvas->string cv))) ) ) )

  (define draw-+
    (let ((pltr (shape-cross-+ 10 5 '(#\# #\*))))
      (lambda (#!optional cv)
        (if (not cv) (pltr)
            (begin
              (pltr cv)
              (canvas->string cv))) ) ) )

  (let ((cv (make-canvas 10 5)))
    (test "draw X args" '(10 5 (#\# #\*)) (draw-x))
    (test "draw X example" CD-TEST-RESULT-1 (draw-x cv))
    (canvas-clear cv)

    (test "draw + args" '(10 5 (#\# #\*)) (draw-+))
    (test "draw + example" CD-TEST-RESULT-5 (draw-+ cv))
    (canvas-clear cv) )
)

(test-group "shapes - cross plot"

  (define plot-x
    (let ((pltr (virtual-shape-cross-x 10 10 '(#\# #\*))))
      (lambda (#!optional cv)
        (if (not cv) (pltr)
            (begin
              (pltr cv)
              (canvas->string cv))) ) ) )

  (define plot-+
    (let ((pltr (virtual-shape-cross-+ 10 10 '(#\# #\*))))
      (lambda (#!optional cv)
        (if (not cv) (pltr)
            (begin
              (pltr cv)
              (canvas->string cv))) ) ) )

  (let ((cv (make-canvas 10 5 10 10)))
    (test "plot + args" '(10 10 (#\# #\*)) (plot-x))
    (test "plot X example" CD-TEST-RESULT-1 (plot-x cv))
    (canvas-clear cv)

    (test "plot + args" '(10 10 (#\# #\*)) (plot-+))
    (test "plot + example" CD-TEST-RESULT-5 (plot-+ cv))
    (canvas-clear cv) )
)

(define CD-TEST-RESULT-19 (apply string-append '(
  "          \n"
  "  +--+    \n"
  "  |  |    \n"
  "  +--+    \n"
  "          \n")))

(test-group "shapes - box"
  (define cv (make-canvas 10 5 200 500))

  (test-group "phys"
    (draw-box cv (rect 2 1 4 3))
    (test "box draw" CD-TEST-RESULT-19 (canvas->string cv))

    (let ((pltr (shape-box 4 3)))
      (test "box args" `(4 3 ,ASCII-FRAME-CHARS) (pltr))
      (canvas-clear cv)
      ;default position is 1/2 size: 2 1
      (test "center default" CD-TEST-RESULT-19 (canvas->string (pltr cv))) )
  )

  (test-group "virt"
    (canvas-clear cv)
    (plot-box cv (rect 40 150 80 300))
    (test "box plot" CD-TEST-RESULT-19 (canvas->string cv))

    (let ((pltr (virtual-shape-box 80 300)))
      (test "box args" `(80 300 ,ASCII-FRAME-CHARS) (pltr))
      (canvas-clear cv)
      ;default position is 1/2 size: 40 150
      (test "center default" CD-TEST-RESULT-19 (canvas->string (pltr cv))) )
  )
)

(test-group "shapes - oval"

  (define numd-octant-cfg '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7))
  (define even-octant-cfg '(#\0 #f  #\2 #f  #\4 #f  #\6 #f))

  (define octant-plotter      (circle-octant-plotter numd-octant-cfg))
  (define even-octant-plotter (circle-octant-plotter even-octant-cfg))

  (test-group "circle () - default vc"
    (let ((cv (make-canvas 10 10))
          (vc (circle-octant-visitor 5 5 octant-plotter)) )
      (generate-circle-octant cv 2 vc)
      (generate-circle-octant cv 4 vc)
      (test "circles" CD-TEST-RESULT-4 (canvas->string cv)) )
  )

  (test-group "circle (_)"
    (let ((cv (make-canvas 10 10 200 500))
          (vc (virtual-circle-octant-visitor 100 250 octant-plotter)) )
      (generate-virtual-circle-octant cv 100 vc)
      (generate-virtual-circle-octant cv 200 vc)
      (test "circles" CD-TEST-RESULT-4 (canvas->string cv)) )
  )

  (test-group "circle octants () - default vc"
    (let ((cv (make-canvas 10 10))
          (vc (circle-octant-visitor 5 5 even-octant-plotter)) )
      (generate-circle-octant cv 2 vc)
      (generate-circle-octant cv 4 vc)
      (test "circles" CD-TEST-RESULT-6 (canvas->string cv)) )
  )

  (test-group "circle (_) plot"
    (let ((cv (make-canvas 10 10 200 500)))
      (plot-circle cv 100 250 100 numd-octant-cfg)
      (plot-circle cv 100 250 200 numd-octant-cfg)
      (test "circles" CD-TEST-RESULT-4 (canvas->string cv)) )
  )

  (test-group "circle octants () draw - default vc"
    (let ((cv (make-canvas 10 10)))
      (draw-circle cv 5 5 2 even-octant-cfg)
      (draw-circle cv 5 5 4 even-octant-cfg)
      (test "circles" CD-TEST-RESULT-6 (canvas->string cv)) )
  )

  (test-group "circle (_) virtual-shape"
    (let ((cv (make-canvas 10 10 200 500))
          (s1 (virtual-shape-oval 100 numd-octant-cfg))
          (s2 (virtual-shape-oval 200 numd-octant-cfg)) )
      (test "circles args" '((100 (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7)) (200 (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7)))
                           (list (s1) (s2)))
      (s1 cv 100 250)
      (s2 cv 100 250)
      (test "circles" CD-TEST-RESULT-4 (canvas->string cv)) )
  )

  (test-group "circle octants () shape - default vc"
    (let ((cv (make-canvas 10 10))
          (s1 (shape-oval 2 even-octant-cfg))
          (s2 (shape-oval 4 even-octant-cfg)) )
      (test "circles args" '((2 (#\0 #f #\2 #f #\4 #f #\6 #f)) (4 (#\0 #f #\2 #f #\4 #f #\6 #f)))
                           (list (s1) (s2)))
      (s1 cv 5 5)
      (s2 cv 5 5)
      (test "circles" CD-TEST-RESULT-6 (canvas->string cv)) )
  )

  (test-group "polygon"
    (let ((cv (make-canvas 10 10 100 100)))
      (canvas-plot-lines cv (circle-polygon-lines 50 50 50 50))
      (test "circle poly 1" CD-TEST-RESULT-8 (canvas->string cv)) )
  )
)

;;

(import (s9fes char-plot))

(define CP-TEST-DATA-1 '(0 1 2 3 4 5 6 7 8 9))
;NOTE editors can trim trailing so don't give them the chance
#; ;FIXME Example Output
(define CP-TEST-RESULT-1 (apply string-append '(
  "----------- foo --> -----------------\n"
  "|                                 --|\n"
  "|                             --X-  |\n"
  "|                     --X---X-      |\n"
  "|                 --X-              |\n"
  "|         --X---X-                  |\n"
  "|     --X-                          |\n"
  "|X--X-                              |\n"
  "----------- foo --> -----------------\n")))
;FIXME Actual Output
(define CP-TEST-RESULT-1 (apply string-append '(
  "----------- foo --> -----------------\n"
  "|                              -X   |\n"
  "|                          --X-     |\n"
  "|                   --X--X-         |\n"
  "|                -X-                |\n"
  "|         -X---X-                   |\n"
  "|     --X-                          |\n"
  "|X--X-                              |\n"
  "----------- foo --> -----------------\n")))

(test-group "char-plot"
  (define tplot (lambda () (char-plot CP-TEST-DATA-1 'foo 7 35 #f)))

  (test CP-TEST-RESULT-1 (with-output-to-string tplot))

  (test "string->canvas"
        CP-TEST-RESULT-1 (canvas->string (string->canvas (with-output-to-string tplot))))

  (test "with-output-to-canvas"
        CP-TEST-RESULT-1 (canvas->string (with-output-to-canvas tplot)))
)

;;

(import (s9fes draw-tree))

(define DT-TEST-FORM-1 '((a) (b . c) (d e)))
;NOTE editors can trim trailing so don't give them the chance
(define DT-TEST-RESULT-1 (apply string-append '(
  "[o|o]---[o|o]---[o|/]\n"
  "  |       |       |     \n"
  "[o|/]     |     [o|o]---[o|/]\n"
  "  |       |       |       |     \n"
  "  a       |       d       e     \n"
  "          |     \n"
  "        [o|o]---  c     \n"
  "          |     \n"
  "          b     \n")))

(test-group "draw-tree"
  (test DT-TEST-RESULT-1
        (with-output-to-string (lambda () (draw-tree DT-TEST-FORM-1))))
)

;;;

(test-end "S9fES Char Graphics")

(test-exit)