;;;; 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 (only (chicken file) delete-file))
(import (chicken fixnum))
(import (s9fes char-canvas rect) (s9fes char-canvas) (s9fes char-canvas block))

;;;

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

(define CD-TEST-RESULT-7 (apply string-append '(
  "        22\n"
  "      22  \n"
  "    12    \n"
  " 011      \n"
  "0         \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")))

(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")))

(define CD-TEST-RESULT-21 (apply string-append '(
  "          \n"
  "          \n"
  "          \n"
  " 00       \n"
  "0         \n")))

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

;;;

(test-begin "S9fES Char Graphics")

#| ;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)
|#

(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 "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 point (not square)"
  (let ((cv (make-canvas 10 5 10 10)))
    (canvas-plot cv 5 4 #\@)
    (test "plot-line" CD-TEST-RESULT-22 (canvas->string cv)) )
)

(test-group "canvas line (not square)"
  (let ((cv (make-canvas 10 5 10 10)))
    (canvas-plot-line cv 0 0 2 3 #\0)
    (test "plot-line" CD-TEST-RESULT-21 (canvas->string cv)) )
)

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

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

(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
    )
  )
)

(define (sort-symbols ls)
  (import (chicken sort))
  (sort ls (lambda (a b) (string<? (symbol->string a) (symbol->string b)))) )

;until layout coded
(define FAKE-BB (rect 0 0 0 0))

;;

(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)