scheme/export-gnugraph.scm

   1 ;
   2 ; module providing gwave support for plot/export using GNU graph
   3 ; as the backend.
   4 ;
   5
   6 (define-module (app gwave export-gnugraph)
   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   :use-module (app gwave gwave-config)
  16 )
  17 (read-set! keywords 'prefix)
  18 (debug-enable 'backtrace)
  19 (debug-enable 'debug)
  20
  21 ; Build a sub-dialog for gnu GRAPH plot options
  22 ; Returns a list of two items:
  23 ; - A GtkWidget for the notebook pannel of the dialog.
  24 ; - A procedure, which when called, will return
  25 ; a plot options list.  The plot options list will be
  26 ; passed unchanged to the export procedure.
  27 (define (build-gnugraph-panel)
  28   (let* ((frame (gtk-frame-new "GNU Graph"))
  29 ;        (hbox (gtk-hbox-new #f 5))
  30          (vbox (gtk-vbox-new #f 5))
  31          (opt-format "ps")
  32          (format-optmenu (build-option-menu
  33                           (lambda (f) (set! opt-format f))
  34                           (list '("Postscript" . "ps")
  35                                 '("Portable Network Graphics" . "png")
  36                                 '("Portable Anymap" . "pnm")
  37                                 '("Scalable Vector Graphics" . "svg")
  38                                 '("Fig" . "fig")
  39                                 '("Gnu Graphics Metafile" . "meta"))))
  40
  41          (landscape-hbox (gtk-hbox-new #f 0))
  42          (opt-landscape #f)
  43          (landscape-rbtns (build-radiobutton-box
  44                            landscape-hbox
  45                            (lambda (v) (set! opt-landscape v))
  46                            (list '("Portrait" . #f)
  47                                  '("Landscape" . #t))))
  48          (opt-color #f)
  49          (color-rbtns (build-radiobutton-box
  50                        (gtk-hbox-new #f 0)
  51                        (lambda (v) (set! opt-color v))
  52                        (list '("Greyscale" . #f)
  53                              '("Color" . #t) )))
  54          )
  55
  56     (gtk-container-set-border-width frame 10)
  57 ;    (gtk-widget-set-usize frame 200 150)
  58     (gtk-widget-show frame)
  59     (gtk-container-add frame vbox)
  60     (gtk-box-pack-start vbox format-optmenu #f #f 0)
  61     (gtk-widget-show vbox)
  62
  63     (gtk-box-pack-start vbox landscape-rbtns #f #f 0)
  64     (gtk-widget-show landscape-rbtns)
  65     (gtk-box-pack-start vbox color-rbtns #f #f 0)
  66     (gtk-widget-show color-rbtns)
  67
  68     (list frame
  69           (lambda ()
  70 ;           (format #t "opt-landscape=~s\n" opt-landscape)
  71             (append (list "-T" opt-format)
  72                     (if opt-landscape
  73                         (list "--rotation" "90")
  74                         '())
  75                     (if opt-color
  76                         (list "-C")
  77                         '())
  78                     )))
  79 ))
  80
  81 ; export a wavepanel's data in the format needed by gnu graph's
  82 ; "a" input format.
  83 (define (export-wavepanel-to-ggfile f wp)
  84   (let ((p (open f (logior O_WRONLY O_CREAT O_TRUNC) #o0777))
  85         (minx (wtable-start-xval))
  86         (maxx (wtable-end-xval)))
  87     (for-each (lambda (vw)
  88                 (export-variables (cons vw '()) p minx maxx)
  89                 (display "\n" p))
  90               (wavepanel-visiblewaves wp))
  91     (close-port p)
  92   ))
  93
  94 ; export-wavepanels-gnugraph -
  95 ;
  96 ; generate hardcopy or documentary representation of the displayed
  97 ; waveforms on one or more wavepanels, using gnu graph as
  98 ; the formatting backend.
  99 ;
 100 (define (export-wavepanels-gnugraph fname panellist options keeptmp)
 101   (let* ((args (append (list-copy options)
 102                        (list "--input-format" "a"
 103                              "--width-of-plot" "0.9")))
 104          (shfile (format #f "~a.sh" (filter-metachars fname)))
 105          (tmpbase (filter-metachars fname))
 106          (tmpfilelist (list shfile))
 107          (ngraphs (length panellist))
 108          (idx 0))
 109
 110     (set! args (append args (list "--height-of-plot"
 111                     (format #f "~f" (- (/ 0.9 ngraphs) 0.05)))))
 112     (set! args (append args '("--toggle-round-to-next-tick" "X"
 113                     "--font-size" "0.03"
 114                     "--grid-style" "3")))
 115     (if (wtable-xlogscale?)
 116         (append! args '("-l" "X")))
 117     (for-each (lambda (wp)
 118 ;               (format #t "\nwavepanel: ~s args: ~s\n" wp args)
 119
 120                  (if (> idx 0)
 121                        (set! args (append args (list "--reposition" "0"
 122                            (format #f "~f" (* idx (/ 0.9 ngraphs)))
 123                            "1"))))
 124                  (if (wavepanel-ylogscale? wp)
 125                      (set! args (append args '("-l" "Y"))))
 126                  (let ((fname (format #f "~a.~s" tmpbase idx)))
 127 ;                (let ((fname (string-append tmpbase (number->string idx))))
 128                    (export-wavepanel-to-ggfile fname wp)
 129                    (set! args (append args (list fname)))
 130                    (set! tmpfilelist (cons fname tmpfilelist))
 131                  (if (wavepanel-ylogscale? wp)
 132                      (set! args (append args '("-l" "Y"))))
 133
 134                  (set! idx (+ 1 idx))
 135                  ))
 136               panellist)
 137     ; finally we have the arglist and tmpfilelist
 138 ;    (format #t "export-graph shfile=~s args=~s\ntmpfilelist=~s\n"
 139 ;           shfile args tmpfilelist)
 140     (with-output-to-file shfile
 141       (lambda ()
 142         (display "#!/bin/sh\n")
 143         (format #t "~a ~a\n" gnugraph-pathname (join " " args))
 144         (if (not keeptmp)
 145             (format #t "rm -f ~a\n" (join " " tmpfilelist)))))
 146 ; (format #t "running sh -C ~a\n" shfile)
 147     (subprocess-to-file fname "/bin/sh" (list "sh" shfile))
 148 ))
 149
 150 (register-plotfilter "GNU Graph"
 151                      build-gnugraph-panel export-wavepanels-gnugraph)
 152