scheme/export-gnuplot.scm

   1 ;
   2 ; module providing gwave support for plot/export using GNUPlot
   3 ; as the backend.
   4 ;
   5
   6 (define-module (app gwave export-gnuplot)
   7   :use-module (gnome-2)
   8   :use-module (gnome gtk)
   9   :use-module (ice-9 optargs)
  10   :use-module (ice-9 format)
  11   :use-module (app gwave cmds)
  12   :use-module (app gwave export)
  13   :use-module (app gwave utils)
  14   :use-module (app gwave gtk-helpers)
  15 )
  16 (read-set! keywords 'prefix)
  17 (debug-enable 'backtrace)
  18 (debug-enable 'debug)
  19
  20 ; Build a sub-dialog for gnu GRAPH plot options
  21 ; Returns a list of two items:
  22 ; - A GtkWidget for the notebook pannel of the dialog.
  23 ; - A procedure, which when called, will return
  24 ; a plot options list.  The plot options list will be
  25 ; passed unchanged to the export procedure.
  26 (define (build-plot-panel)
  27   (let* ((frame (gtk-frame-new "GNUPlot"))
  28          (vbox (gtk-vbox-new #f 5))
  29          (opt-format "postscript")
  30          (format-optmenu (build-option-menu
  31                           (lambda (f) (set! opt-format f))
  32                           (list
  33                                 '("Postscript" . "postscript")
  34                                 '("Computer Graphics Metafile" . "cgm")
  35                                 '("Drawing Exchange Format" . "dxf")
  36                                 '("Fig" . "fig")
  37                                 '("GPIC" . "gpic")
  38                                 '("HPGL" . "hpgl")
  39                                 '("LaTeX" . "latex")
  40                                 '("LaTeX Picture \\Specials" . "pslatex")
  41                                 '("LaTeX Picture PSTricks" . "pstricks")
  42                                 '("LaTeX TPic \\Specials" . "tpic")
  43                                 '("Maker Interchange Format" . "mif")
  44                                 '("Metafont" . "mf")
  45                                 '("Plain TeX Picture \\Specials" . "pstex")
  46                                 '("Portable Anymap" . "pbm")
  47                                 '("Portable Network Graphics" . "png")
  48                                 '("Postscript EPS" . "postscript eps")
  49                                 '("Scalable Vector Graphics" . "svg")
  50 ;                               '("X11" . "x11")
  51                                 )))
  52
  53          (landscape-hbox (gtk-hbox-new #f 0))
  54          (opt-landscape #f)
  55 ; landscape option to gnuplot doesn't seem to do anything
  56 ;        (landscape-rbtns (build-radiobutton-box
  57 ;                          landscape-hbox
  58 ;                          (lambda (v) (set! opt-landscape v))
  59 ;                          (list '("Portrait" . #f)
  60 ;                                '("Landscape" . #t))))
  61          (opt-color #f)
  62          (color-rbtns (build-radiobutton-box
  63                        (gtk-hbox-new #f 0)
  64                        (lambda (v) (set! opt-color v))
  65                        (list '("Greyscale" . #f)
  66                              '("Color" . #t) )))
  67
  68          (multiplot-check (gtk-check-button-new-with-label "Multiplot"))
  69          )
  70
  71     (gtk-container-set-border-width frame 10)
  72 ;    (gtk-widget-set-usize frame 200 150)
  73     (gtk-widget-show frame)
  74     (gtk-container-add frame vbox)
  75     (gtk-box-pack-start vbox format-optmenu #f #f 0)
  76
  77 ;    (gtk-box-pack-start vbox landscape-rbtns #f #f 0)
  78 ;    (gtk-widget-show landscape-rbtns)
  79     (gtk-box-pack-start vbox color-rbtns #f #f 0)
  80     (gtk-widget-show color-rbtns)
  81     (gtk-box-pack-start vbox multiplot-check #f #f 0)
  82     (gtk-widget-show multiplot-check)
  83     (gtk-toggle-button-set-active multiplot-check #t)
  84     (gtk-widget-show vbox)
  85
  86     ; return list containing top-level frame and procedure
  87     (list frame
  88           ; options-procedure returns a list consisting of a fixed-length
  89           ; set of booleans followed by any number of strings that become
  90           ; the preamble for the gnuplot script
  91           (lambda ()
  92             (append (list
  93                      (gtk-toggle-button-get-active multiplot-check)
  94                      (format #f "set terminal ~a~a" opt-format
  95                                   (if opt-color " color" "")
  96 ;                                 (if opt-landscape " landscape" "")
  97                                   )))))
  98 ))
  99
 100 ; export a wavepanel's data in the format needed by gnu graph's
 101 ; "a" input format.
 102 (define (export-wavepanel-to-ggfile f wp)
 103   (let ((p (open f (logior O_WRONLY O_CREAT O_TRUNC) #o0777))
 104         (minx (wtable-start-xval))
 105         (maxx (wtable-end-xval)))
 106     (for-each (lambda (vw)
 107                 (export-variables (cons vw '()) p minx maxx)
 108                 (display "\n" p))
 109               (wavepanel-visiblewaves wp))
 110     (close-port p)
 111   ))
 112
 113 ;
 114 ; generate hardcopy or documentary representation of the displayed
 115 ; waveforms on one or more wavepanels, using gnuplot as
 116 ; the formatting backend.
 117 ;
 118 (define (plot-wavepanels fname panellist options keeptmp)
 119   (let* ((multiplot (car options))
 120          (preamble (append (list-copy (cdr options)) ))
 121          (shfile (format #f "~a.gnuplot" (filter-metachars fname)))
 122          (tmpbase (filter-metachars fname))
 123          (tmpfilelist (list shfile))
 124          (npanels (length panellist))
 125          (minx (wtable-start-xval))
 126          (maxx (wtable-end-xval))
 127          (pidx 0)
 128          (widx 0))
 129
 130     (with-output-to-file shfile
 131       (lambda ()
 132         (format #t "~a\n" (join "\n" preamble))
 133         (format #t "set output \"~a\"\n" fname)
 134         (if multiplot
 135             (format #t "set multiplot\nset size 1,~f\n" (exact->inexact (/ 1 npanels))))
 136
 137         (if (wtable-xlogscale?)
 138             (display "set logscale x"))
 139         (display "\n")
 140         (for-each
 141          (lambda (wp)
 142            (let ((plotlines '())
 143                  (wavelist (wavepanel-visiblewaves wp)))
 144              (if (< 0 (length wavelist))
 145                  (begin
 146                    (if multiplot
 147                        (format #t "set origin 0,~f\n" (* (- (- npanels 1) pidx) (exact->inexact (/ 1 npanels)))))
 148                    (if (wavepanel-ylogscale? wp)
 149                        (display "set logscale y\n")
 150                        (display "set nologscale y\n"))
 151                    (for-each
 152                     (lambda (vw)
 153                       (let* ((f (format #f "~a.~s" tmpbase widx))
 154                              (p (open f (logior O_WRONLY O_CREAT O_TRUNC) #o0777)))
 155                         (export-variables (cons vw '()) p minx maxx)
 156                         (set! plotlines (append plotlines (list
 157                                                            (format #f " \"~a\" using 1:2 title \"~a\" with lines"
 158                                                                    f  (visiblewave-varname vw) ))))
 159                         (set! tmpfilelist (cons f tmpfilelist))
 160                         (close-port p)
 161                         (set! widx (+ 1 widx))))
 162                     wavelist)
 163                    (format #t "plot ~a\n\n" (join ", \\\n" plotlines))
 164              )))
 165            (set! pidx (+ 1 pidx))
 166            )
 167          panellist)
 168         (if (not keeptmp)
 169             (format #t "! rm -f ~a\n" (join " " tmpfilelist)))
 170         ))
 171 ;   (format #t "plot-gnuplot cmdfile=~s tmpfilelist=~s\n" shfile tmpfilelist)
 172     (subprocess-to-file #f "gnuplot" (list "gnuplot" shfile))
 173 ))
 174
 175 (register-plotfilter "GNUPlot"
 176                      build-plot-panel plot-wavepanels)
 177