;;;; slib-charplot.scm
;;;; Kon Lovett, Mar '20

;; Issues
;;
;; - synthesize label(s) from data is problematic.

(module slib-charplot

(;export
  plot-labels
  plot-dimensions
  plot-left-margin
  xborder-char
  yborder-char
  xaxis-char
  yaxis-char
  xtick-char
  bar-char
  curves-chars
  histograph
  plot)

(import scheme
  (chicken module)
  (only (chicken base)
    unless
    include include-relative
    let-values let-optionals
    error identity
    warning make-parameter)
  (chicken type)
  (only (chicken platform) features)
  (only (chicken keyword) string->keyword)
  (only (srfi 1) last-pair)
  (srfi 63)
  slib-arraymap)
;FIXME chicken-install has the feature but after that ...
(cond-expand (utf8 (import utf8) (warning "Using utf8 Extension")) (else))

;; Types

;SRFI 63
(define-type array-strict (struct array))
;(define-type array (or string vector array-strict))

(define-type maybe-string (or false string))

(define-type plotdims (list fixnum fixnum))                   ;(H W)
(define-type plotdata (or vector list array-strict))          ;Nd elms
(define-type histdata (or (vector number) (list number)))     ;1d elms

(define-type plotdata-labeler (plotdata --> string string))

(: plot-labels (#!optional (or false plotdata-labeler) -> plotdata-labeler))

(: plot-dimensions (#!optional (or boolean plotdims) -> (or boolean plotdims)))
(: plot-left-margin (#!optional (or boolean fixnum) -> fixnum))

(: xborder-char (#!optional (or boolean char) -> char))
(: yborder-char (#!optional (or boolean char) -> char))
(: xaxis-char (#!optional (or boolean char) -> char))
(: yaxis-char (#!optional (or boolean char) -> char))
(: xtick-char (#!optional (or boolean char) -> char))
(: bar-char (#!optional (or boolean char) -> char))

(: curves-chars (#!optional (or boolean string) -> string))

;only works due to slib plot . args (?)
(: plot (or (plotdata #!optional string string boolean -> void)
            ((number -> float) #!optional number number fixnum -> void)))

(: histograph (histdata #!optional string -> void))

;;

(include-relative "slib-compat")

(include-relative "charplot")

;; Default Plot Labeling

(define (default-plot-labels data) (values "" ""))

(define plot-labels (make-parameter default-plot-labels (lambda (x)
  (cond ((not x) default-plot-labels)
        ((procedure? x) x)
        (else
          (warning 'plot-labels "not a procedure or #f" x)
          (plot-labels) ) ) ) ) )

(define (plotdata-labels data xaxis yaxis)
  (if (and xaxis yaxis) (values xaxis yaxis)
      (let-values (((xlabel ylabel) ((plot-labels) data)))
        (values (or xaxis xlabel) (or yaxis ylabel)) ) ) )

;; Plot Operations (w/ optional arguments)

;optional axis labels
(let ((slib-plot plot))
  (set! plot
    (lambda (data . args)
      (if (procedure? data)
          (let-optionals args ((lo 0) (hi 1) (npts 64))
            (slib-plot data lo hi npts))
          (let-optionals args ((xaxis #f) (yaxis #f) (histogram? #f))
            (let-values (((xlabel ylabel) (plotdata-labels data xaxis yaxis)))
              (slib-plot data xlabel ylabel histogram?)))))) )

;optional label
(let ((slib-histograph histograph))
  (set! histograph
        (lambda (data #!optional (label #f))
          (let-values (((xlabel ylabel) (plotdata-labels data label "")))
            (slib-histograph data xlabel)))) )

;; Parameters (replacements for SLIB graph part globals)

(define plot-dimensions (make-parameter charplot:dimensions (lambda (x)
  (cond ((not x) x)
        ((and (list? x) (<= (length x) 2)) x)
        (else
          (warning 'plot-dimensions "not a list (H W)" x)
          (plot-dimensions) ) ) ) ) )

(define plot-left-margin (make-parameter charplot:left-margin (lambda (x)
  (cond ((not x) 2)
        ((and (exact? x) (integer? x) (<= 2 x)) x)
        (else
          (warning 'plot-left-margin "not an exact-integer of at least 2" x)
          (plot-left-margin) ) ) ) ) )

(define-syntax char-warning-predicate
  (syntax-rules ()
    ((char-warning-predicate ?loc ?def)
      (lambda (x)
        (cond ((not x) ?def)
              ((char? x) x)
              (else
                (warning '?loc "not a character")
                (?loc) ) ) ) ) ) )

(define xborder-char (make-parameter #f (char-warning-predicate xborder-char char:xborder)))
(define yborder-char (make-parameter #f (char-warning-predicate yborder-char char:yborder)))
(define xaxis-char (make-parameter #f (char-warning-predicate xaxis-char char:xaxis)))
(define yaxis-char (make-parameter #f (char-warning-predicate yaxis-char char:yaxis)))
(define xtick-char (make-parameter #f (char-warning-predicate xtick-char char:xtick)))
(define bar-char (make-parameter #f (char-warning-predicate bar-char char:bar)))

(define curves-chars (make-parameter #f (lambda (x)
  (cond ((not x) char:curves)
        ((and (string? x) (<= 1 (string-length x))) x)
        (else
          (warning 'curves-chars "not a string of at least length 1" x)
          (curves-chars) ) ) ) ) )

) ;module slib-charplot