(in-package "X-GRAPH")

(export '(graph-init graph-show graph-clear graph-dims graph-dot graph-box
          graph-line graph-exit
)        )

(defvar *tek-stream* nil)

(defun graph-init (&optional width height colors)
  (setq *tek-stream*
    (xterm:open "tek" :xterm-args '("-wf" "-t") :title "CLISP graphics")
  )
  (write-char #\Code28 *tek-stream*)
  '((:WHITE . 0) (:BLACK . 1))
)

(defun graph-show ()
  (values)
)

(defun graph-clear ()
  (write-string (load-time-value (coerce '(#\Escape #\Code12) 'string))
                *tek-stream*
  )
  (values)
)

(defun write-x-y (x y stream)
  (cond ((< x 0) (setq x 0))
        ((>= x 1024) (setq x 1023))
  )
  (cond ((< y 0) (setq y 0))
        ((>= y 768) (setq y 767))
  )
  (setq y (- 767 y))
  (write-char (code-char (+ 32 (ldb (byte 5 5) y))) stream)
  (write-char (code-char (+ 96 (ldb (byte 5 0) y))) stream)
  (write-char (code-char (+ 32 (ldb (byte 5 5) x))) stream)
  (write-char (code-char (+ 64 (ldb (byte 5 0) x))) stream)
)

(defun graph-dims ()
  (values 1024 768)
)

(defun graph-dot (x y &optional (color 1))
  (unless (zerop color)
    (write-char #\Code28 *tek-stream*)
    (write-x-y x y *tek-stream*)
  )
  (values)
)

(defun graph-box (x1 y1 x2 y2 color)
  (unless (zerop color)
    (when (> x1 x2) (rotatef x1 x2))
    (when (> y1 y2) (rotatef y1 x2))
    (do ((y y1 (1+ y))) ((> y y2))
      (write-char #\Code29 *tek-stream*)
      (write-x-y x1 y *tek-stream*)
      (write-char #\Code7 *tek-stream*)
      (write-x-y x2 y *tek-stream*)
  ) )
  (values)
)

(defun graph-line (x1 y1 x2 y2 color)
  (unless (zerop color)
    (write-char #\Code29 *tek-stream*)
    (write-x-y x1 y1 *tek-stream*)
    (write-char #\Code7 *tek-stream*)
    (write-x-y x2 y2 *tek-stream*)
  )
  (values)
)

(defun graph-exit ()
  (when *tek-stream*
    (close *tek-stream*)
    (xterm:kill *tek-stream*)
    (setq *tek-stream* nil)
) )
