#lang racket (require ffi/unsafe "base.rkt") (define libiup-pplot (case (system-type 'os) [(windows) (ffi-lib "iup_pplot")] [else (ffi-lib "libiup_pplot")])) ;; PPlot control (define pplot (make-constructor-procedure (get-ffi-obj "IupPPlot" libiup-pplot (_fun -> [handle : _ihandle])))) ;; Plotting functions (define call-with-pplot (letrec ([pplot-begin (get-ffi-obj "IupPPlotBegin" libiup-pplot (_fun [handle : _ihandle] [xdata-string? : _bool] -> _void))] [pplot-end (get-ffi-obj "IupPPlotEnd" libiup-pplot (_fun [handle : _ihandle] -> _void))]) (λ (handle proc #:x-string? [x-string? #f]) (dynamic-wind (λ () (pplot-begin handle x-string?)) (λ () (proc handle)) (λ () (pplot-end handle)))))) (define pplot-add! (letrec ([append/real (get-ffi-obj "IupPPlotAdd" libiup-pplot (_fun [handle : _ihandle] [x : _float] [y : _float] -> _void))] [append/string (get-ffi-obj "IupPPlotAddStr" libiup-pplot (_fun [handle : _ihandle] [x : _string/utf-8] [y : _float] -> _void))] [insert/real (get-ffi-obj "IupPPlotInsert" libiup-pplot (_fun [handle : _ihandle] [index : _int] [sample-index : _int] [x : _float] [y : _float] -> _void))] [insert/string (get-ffi-obj "IupPPlotInsertStr" libiup-pplot (_fun [handle : _ihandle] [index : _int] [sample-index : _int] [x : _string/utf-8] [y : _float] -> _void))] [current-index (λ (handle) (string->number (attribute handle 'current)))]) (λ (handle x y [sample-index #f] [index #f]) (if (string? x) (if sample-index (insert/string handle (or index (current-index handle)) sample-index x (exact->inexact y)) (append/string handle x (exact->inexact y))) (if sample-index (insert/real handle (or index (current-index handle)) sample-index (exact->inexact x) (exact->inexact y)) (append/real handle (exact->inexact x) (exact->inexact y))))))) (define pplot-x/y->pixel-x/y (get-ffi-obj "IupPPlotTransform" libiup-pplot (_fun (handle x y) :: [handle : _ihandle] [pplot-x : _float = (exact->inexact x)] [pplot-y : _float = (exact->inexact y)] [pixel-x : (_ptr o _int)] [pixel-y : (_ptr o _int)] -> _void -> (values pixel-x pixel-y)))) (define pplot-paint-to (get-ffi-obj "IupPPlotPaintTo" libiup-pplot (_fun [handle : _ihandle] [canvas : _pointer] -> _void))) ;; Library setup (letrec ([open (get-ffi-obj "IupPPlotOpen" libiup-pplot (_fun -> _void))]) (open)) (provide pplot call-with-pplot pplot-add! pplot-x/y->pixel-x/y pplot-paint-to)