#lang scheme/base
(require scheme/match
scheme/string
scheme/file
scheme/system)
(provide
gnuplot?
(rename-out (data? gnuplot-data?) (gnuplot-in gnuplot-input-port))
gnuplot-data
gnuplot-data/file
gnuplot-item
gnuplot-plot
gnuplot-splot
gnuplot-replot
gnuplot-multiplot
gnuplot-hardcopy
gnuplot-set
gnuplot-set*
gnuplot-unset
gnuplot-reset
gnuplot-spawn
gnuplot-kill
gnuplot-program
gnuplot-set-program!
gnuplot-writeln)
(define-struct data (source temp? bin?))
(define-struct gnuplot (pid out in ctl))
(define (gnuplot-data data
#:file (fname #f)
#:comments (comments #f)
#:tmpdir (tmpdir #f)
#:binary (bin? #f))
(let ((temp? (not fname))
(fname (or fname (make-temporary-file "plot.~a" #f tmpdir))))
(call-with-output-file fname
(lambda (port)
(when (and (not bin?) comments)
(for ((x comments)) (fprintf port "# ~a~n" x)))
(let-values
(((writev nextln)
(if bin?
(values
(lambda (x) (write-bytes (real->floating-point-bytes x 4)
port))
void)
(values
(lambda (x) (fprintf port "~a " (exact->inexact x)))
(lambda () (fprintf port "~n"))))))
(for ((row data))
(for ((x row)) (writev x))
(nextln)))
(flush-output port)
(make-data* fname temp? bin?))
#:exists 'truncate)))
(define (make-data* source temp? bin?)
(let ((data (make-data source temp? bin?)))
(when temp? (will-register *gc* data gc-data))
data))
(define (gnuplot-data/file fname (bin? #f))
(make-data fname #f bin?))
(define (gnuplot-item data (opts null))
`(item ,data . ,opts))
(define (gnuplot-plot gplot
#:range (range #f)
. items)
(gnuplot-plot* gplot 'plot range items))
(define (gnuplot-splot gplot
#:range (range #f)
. items)
(gnuplot-plot* gplot 'splot range items))
(define (gnuplot-replot gplot . items)
(gnuplot-plot* gplot 'replot #f items))
(define (gnuplot-plot* gplot cmd range items)
(gnuplot-writeln gplot
"~a ~a ~a"
cmd
(if range (/string `(seq* . ,(map make-range range))) "")
(/string `(seq . ,items))))
(define (gnuplot-multiplot gplot
#:layout (layout null)
. plots)
(gnuplot-set gplot `(multiplot . ,layout))
(for ((doplot plots)) (doplot gplot))
(gnuplot-unset gplot 'multiplot))
(define (gnuplot-hardcopy gplot outp (plot gnuplot-replot)
#:term (term '(postscript color)))
(gnuplot-set gplot '(terminal push))
(gnuplot-set gplot `(terminal . ,term))
(gnuplot-set gplot `(output (path ,outp)))
(plot gplot)
(gnuplot-unset gplot 'output)
(gnuplot-set gplot '(terminal pop)))
(define (gnuplot-set gplot opt)
(gnuplot-writeln gplot "set ~a" (make-option opt)))
(define (gnuplot-set* gplot opts)
(for ((x opts)) (gnuplot-set gplot x)))
(define (gnuplot-unset gplot opt)
(gnuplot-writeln gplot "unset ~a" opt))
(define (gnuplot-reset gplot)
(gnuplot-writeln gplot "reset"))
(define (/string x)
(match x
(`(seq . ,vs) (string-join (map /string vs) ","))
(`(seq: . ,vs) (string-join (map /string vs) ":"))
(`(seq* . ,vs) (string-join (map /string vs) " "))
(`(range . ,rg) (make-range rg))
(`(= ,x ,v) (format "~a = ~a" x (/string v)))
(`(path ,v) (format "'~a'" (if (path? v) (path->string v) v)))
(`(str ,v) (format "\"~a\"" v))
(`(item ,data . ,opts)
(string-join
(cons
(/string (if (data? data) `(path ,(data-source data)) data))
(map /string
(if (and (data? data) (data-bin? data) (not (memq 'binary opts)))
(cons 'binary opts)
opts)))
" "))
(#f "")
(else (format "~a" x))))
(define (make-option opt)
(/string `(seq* . ,opt)))
(define (make-range range)
(match range
('() "[]")
(`(,min ,max) (format "[~a:~a]" (or min "") (or max "")))
(`(,dummy ,min ,max)
(format "[~a = ~a:~a]" dummy (or min "") (or max "")))
((? string?) range)))
(define *gnuplot*
(case (system-type)
((unix macosx) "gnuplot")
((windows) "pgnuplot.exe")))
(define (gnuplot-set-program! prog)
(set! *gnuplot* prog))
(define (gnuplot-program) *gnuplot*)
(define (gnuplot-spawn (read? #f))
(match (process *gnuplot*)
((list out in pid err ctl)
(close-input-port out)
(unless read?
(close-input-port err))
(let ((gplot (make-gnuplot pid in (if read? err #f) ctl)))
(will-register *gc* gplot gnuplot-kill)
gplot))))
(define (gnuplot-kill gplot)
((gnuplot-ctl gplot) 'kill)
(when (gnuplot-in gplot)
(close-input-port (gnuplot-in gplot)))
(close-output-port (gnuplot-out gplot)))
(define (gnuplot-writeln gplot fmt . args)
(let ((port (gnuplot-out gplot)))
(apply fprintf port fmt args)
(newline port)
(flush-output port)))
(define *gc* (make-will-executor))
(define *gc-thread*
(thread
(lambda ()
(let lp () (will-execute *gc*) (lp)))))
(define (gc-data data)
(delete-file (data-source data)))