;;
;; Chicken interface to the libploticus API.
;;
;; Copyright 2011-2012 Ivan Raikov.
;;
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; A full copy of the GPL license can be found at
;; .
;;
(module ploticus
(init arg execline execscript execprefab end getvar setvar proc procdebug)
(import scheme chicken foreign )
(require-library srfi-13 data-structures)
(import (only srfi-13 string-index)
(only data-structures ->string))
#>
int ploticus_init( char *device, char *outfilename );
int ploticus_arg( char *name, char *value );
int ploticus_execline( char *line );
int ploticus_execscript( char *scriptfile, int prefabflag );
int ploticus_end();
int ploticus_getvar( char *name, char *value );
int ploticus_setvar( char *name, char *value );
<#
(define procdebug (make-parameter #f))
(define cinit (foreign-lambda int "ploticus_init" nonnull-c-string nonnull-c-string))
(define (init devicesym pathname)
(let ((device
(case devicesym
((png gif x11 svg jpeg eps swf)
(symbol->string devicesym))
(else (error 'init "unknown device symbol" devicesym)))))
(cinit device pathname)))
(define carg (foreign-lambda int "ploticus_arg" nonnull-c-string nonnull-c-string))
(define (arg name . rest)
(let-optionals rest ((value ""))
(carg name value)))
(define execline (foreign-lambda int "ploticus_execline" nonnull-c-string))
(define cexecscript (foreign-lambda int "ploticus_execscript" nonnull-c-string int))
(define (execscript filename)
(cexecscript filename 0))
(define (execprefab prefab)
(cexecscript prefab 1))
(define end (foreign-lambda int "ploticus_end" ))
(define cgetvar
(foreign-safe-lambda* int ((nonnull-c-string name) (scheme-object value))
#<string name) ))))
(for-each
(lambda (x)
(if (pair? (cdr x))
(let ((line (string-append (car x) ": " (->string (cadr x)))))
(if (procdebug) (print line))
(assert (zero? (execline line)))
(if (procdebug)
(for-each (lambda (ln) (print ln) (assert (zero? (execline ln)))) (cddr x))
(for-each (lambda (ln) (assert (zero? (execline ln)))) (cddr x)))
)
(let ((line (string-append (car x) ": " (->string (cdr x)))))
(if (procdebug) (print line))
(assert (zero? (execline line)))
)))
fields)
(execline "#endproc")
(execline "")
)
)