;;;; 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 utf8
        (only (chicken base)
              unless include include-relative let-values let-optionals error
              identity make-parameter define-constant fixnum? define-inline
              cut sub1 optional and-let* foldl when)
        (chicken type)
        (only (chicken format) sprintf)
        (srfi 63) slib-arraymap slib-compat)

;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)
;(list-of number)                             ;Y
;(list-of (pair-of number number))            ;(X . Y)
;(list-of (list-of number))                   ;(X Y1 ... Yn)
;(list-of (list-of number (list-of number)))  ;(X (Y1 ... Yn))
(define-type plotdata (or vector list array-strict))                ;Nd elms
(define-type histdata (or (vector-of number) (list-of number)))     ;1d elms

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

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

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

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

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

#; ;invalid but accurate, just accept no optionals typing
(: plot (or (plotdata #!optional string string boolean -> void)
            ((number -> float) #!optional number number fixnum -> void)))
(: plot ((or plotdata (number -> float)) #!rest -> void))

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

;;

(include-relative "charplot")

(define-constant LEFT-MARGIN-MINIMUM 2)

;; 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
          (error 'plot-labels "not a procedure or #f" x) ) ) ) ) )

(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 _) (plotdata-labels data label "")))
            (slib-histograph data xlabel)))) )

;; Parameters (replacements for SLIB graph part globals)

(define-inline (list-plot-dimensions? x)
  (and (list? x) (<= (length x) 2) (fixnum? (car x)) (fixnum? (cadr x))) )

(define-inline (pair-plot-dimensions? x)
  (and (pair? x) (fixnum? (car x)) (fixnum? (cdr x))) )

(define-inline (plot-left-margin? x)
  (and (fixnum? x) (<= LEFT-MARGIN-MINIMUM x)) )

(define plot-dimensions (make-parameter charplot:dimensions (lambda (x)
  (cond ((not x)                    charplot:dimensions)
        ((list-plot-dimensions? x)  x)
        ((pair-plot-dimensions? x)  (list (car x) (cdr x)))
        (else
          (error 'plot-dimensions "not a list (H W)" x) ) ) ) ) )

(define plot-left-margin (make-parameter charplot:left-margin (lambda (x)
  (cond ((not x)                charplot:left-margin)
        ((plot-left-margin? x)  x)
        (else
          (error 'plot-left-margin (sprintf "not an fixnum of at least ~A" LEFT-MARGIN-MINIMUM) x) ) ) ) ) )

(define (check-plotting-char loc x def)
  (cond ((not x)    def)
        ((char? x)  x)
        (else
          (error loc "not a character" x) ) ) )

(define-syntax plotting-char-parameter
  (syntax-rules ()
    ((plotting-char-parameter ?loc ?def)
      (make-parameter ?def (cut check-plotting-char '?loc <> ?def) ) ) ) )

(define xborder-char  (plotting-char-parameter xborder-char char:xborder))
(define yborder-char  (plotting-char-parameter yborder-char char:yborder))
(define xaxis-char    (plotting-char-parameter xaxis-char char:xaxis))
(define yaxis-char    (plotting-char-parameter yaxis-char char:yaxis))
(define xtick-char    (plotting-char-parameter xtick-char char:xtick))
(define bar-char      (plotting-char-parameter 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
          (error 'curves-chars "not a string of at least length 1" x) ) ) ) ) )

) ;module slib-charplot