scheme/visiblewave-ops.scm

   1 ;
   2 ; module providing GUI operations on VisibleWave objects
   3 ;   popup menu on right button in VisibleWave-button
   4 ;   multi-paneled dialog box accessible from the menu
   5 ;
   6
   7 (dbprint "visiblewave-ops.scm running\n")
   8
   9 (define-module (app gwave visiblewave-ops)
  10   :use-module (ice-9 format)
  11   :use-module (gnome-2)
  12   :use-module (gnome gtk)
  13   :use-module (gnome gtk gdk-event)
  14   :use-module (app gwave utils)
  15   :use-module (app gwave gtk-helpers)
  16   :use-module (app gwave std-menus)
  17   :use-module (app gwave export)
  18   :use-module (app gwave cmds)
  19   :use-module (app gwave globals)
  20 )
  21 (read-set! keywords 'prefix)
  22
  23 (debug-enable 'debug)
  24 (read-enable 'positions)
  25
  26 ; hook called when new VisibleWave is added.
  27 (add-hook!
  28  new-visiblewave-hook
  29  (lambda (vw)
  30    (dbprint "in exp new-visiblewave-hook " vw
  31              "\n        file=" (visiblewave-file vw)
  32              "\n     varname=" (visiblewave-varname vw)
  33              "\n       panel=" (visiblewave-panel vw)
  34              "\n      button=" (visiblewave-button vw) "\n")
  35
  36    (set-visiblewave-measure! vw 1 default-measure1-function)
  37
  38    ; make this panel the only selected one when a wave is added to it
  39    (unselect-all-wavepanels!)
  40    (set-wavepanel-selected! (visiblewave-panel vw) #t)
  41
  42    (gtk-signal-connect (visiblewave-button vw) "clicked"
  43                         (lambda (b)
  44                           ;(format #t "clicked ~s ~s\n" vw (gtk-toggle-button-get-active (visiblewave-button vw)))
  45                           ; TODO: redraw only the one panel affected
  46                           (wtable-redraw!) ))
  47    (gtk-signal-connect (visiblewave-button vw) "button-press-event"
  48                         (lambda (b event)
  49 ;                         (display "press-signal")
  50 ;                         (display event)
  51 ;                         (display (gdk-event:type event))
  52 ;                         (display "\n ")
  53 ;                         (display (gdk-event-button:button event))
  54 ;                         (newline)
  55                           (if (= (gdk-event-button:button event) 3)
  56                               (begin
  57                                 (gtk-menu-popup (make-vwb3-menu vw)
  58                                                 #f #f #f
  59                                                 (gdk-event-button:button event)
  60                                                 (gdk-event-button:time event))
  61                                 #t)
  62                               #f)))
  63
  64    (gtk-tooltips-set-tip gwave-tooltips (visiblewave-button vw)
  65                          (string-append
  66                           (shorten-filename (wavefile-file-name (visiblewave-file vw)))
  67                           ":\n"
  68                           (visiblewave-varname vw)
  69                           "\nVisibleWave Button:\nClick button 1 to select wave.\nPress button 3 for options menu.") "")
  70 ))
  71
  72 (wavepanel-bind-mouse 1
  73  (lambda (wp event)
  74 ; (format #t "wavepanel ~s event=~s modifiers=~s\n" wp event
  75 ;        (gdk-event-button:modifiers event))
  76
  77  (if (not (member 'shift-mask (gdk-event-button:modifiers event)))
  78      (unselect-all-wavepanels!))
  79  (set-wavepanel-selected! wp #t)
  80 ))
  81
  82 ; create dynamic menu to be popped up with mousebutton 3 on the
  83 ; visible-wave button.  Returns the menu.
  84 (define (make-vwb3-menu vw)
  85   (let ((menu (gtk-menu-new)))
  86     (gtk-widget-show menu)
  87     (add-menuitem menu "Move to Top"
  88                   (lambda () (visiblewave-on-top! vw)))
  89     (add-menuitem menu "Options..."
  90                   (lambda () (popup-vw-options vw)))
  91     (add-menuitem menu "Export..."
  92                   (lambda () (popup-export-dialog (cons vw '()))))
  93     (add-menuitem menu #f #f)
  94     (add-menuitem menu "Delete"
  95                   (lambda () (visiblewave-delete! vw)))
  96     menu))
  97
  98 ; build and return wave-color color menu.
  99 ; this is an optionmenu on a button; we return the button.
 100 ; call proc with new value on menu selection.
 101 ;
 102 ; TODO: redo using general GtkOptionMenu and a ListStore
 103 ;       so we can hold labels or buttons whose color matches the color-numbers
 104 ;
 105 (define (build-wavecolor-menu vw proc)
 106   (let ((combobox (gtk-combo-box-new-text)))
 107
 108     (do ((i 0 (1+ i))
 109          (j 0 (1+ j)))
 110         ((= i 6))
 111
 112 ;       (let* ((label (gtk-label-new
 113 ;                    (string-append "color " (number->string j))))
 114 ;       (gtk-widget-set-name label
 115 ;                            (string-append "wavecolor" (number->string j)))
 116 ;       (gtk-container-add menuitem eventbox)
 117 ;       (gtk-container-add eventbox label))
 118
 119       (append-text combobox (string-append "color " (number->string j))))
 120
 121     (if (procedure? proc)
 122         (connect combobox 'changed
 123                  (lambda (x)
 124                    (proc (get-active combobox)))))
 125     (set-active combobox  (visiblewave-color vw))
 126     (show combobox)
 127     combobox))
 128
 129 ; build and attach frame for Style page of the VisibleWave options notebook
 130 ; style items include color, drawing algorithm, and drawing-alg parameters
 131 ; Returns a procedure that when will apply any changed style items
 132 ; to the VisibleWave.
 133 (define (add-vw-opts-style-frame notebook vw)
 134   (let ((stcolor (visiblewave-color vw)))
 135     (let* ((frame (gtk-frame-new "Style"))
 136            (label (gtk-label-new "Style"))
 137            (hbox (gtk-hbox-new #f 5))
 138            (vbox (gtk-vbox-new #f 5))
 139            (wcmenu-box (build-wavecolor-menu vw
 140                                              (lambda (col)
 141                                                (set! stcolor col)))))
 142          (gtk-container-set-border-width frame 10)
 143 ;        (gtk-widget-set-usize frame 200 150)
 144          (gtk-widget-show frame)
 145          (gtk-container-add frame hbox)
 146          (gtk-box-pack-start hbox wcmenu-box #f #f 0)
 147          (gtk-widget-show hbox)
 148          (gtk-notebook-append-page notebook frame label)
 149          )
 150     (lambda ()
 151       (set-visiblewave-color! vw stcolor)
 152       (dbprint "apply color " stcolor "\n"))
 153 ))
 154
 155 ; build and attach frame for Stats page of the VisibleWave options notebook.
 156 (define (add-vw-opts-stats-frame notebook vw)
 157     (let* ((frame (gtk-frame-new "Stats"))
 158            (label (gtk-label-new "Stats"))
 159            (vbox (gtk-vbox-new #f 5))
 160            (file-label (gtk-label-new
 161                         (string-append "file: "
 162                                (wavefile-file-name (visiblewave-file vw)))))
 163            (varname-label (gtk-label-new
 164                         (string-append "variable: " (visiblewave-varname vw))))
 165            (min-label (gtk-label-new
 166                         (string-append "minimum: " (number->string (wavevar-min vw)))))
 167            (max-label (gtk-label-new
 168                         (string-append "maximum: " (number->string (wavevar-max vw))))))
 169       (gtk-container-set-border-width frame 10)
 170 ;      (gtk-widget-set-usize frame 200 150)
 171       (gtk-widget-show frame)
 172       (gtk-container-add frame vbox)
 173       (gtk-box-pack-start vbox file-label #f #f 0)
 174       (gtk-widget-show file-label)
 175       (gtk-box-pack-start vbox varname-label #f #f 0)
 176       (gtk-widget-show varname-label)
 177       (gtk-box-pack-start vbox min-label #f #f 0)
 178       (gtk-widget-show min-label)
 179       (gtk-box-pack-start vbox max-label #f #f 0)
 180       (gtk-widget-show max-label)
 181       (gtk-widget-show vbox)
 182       (gtk-notebook-append-page notebook frame label)
 183 ))
 184
 185 (define (popup-vw-options vw)
 186  (let* ((window (gtk-window-new 'toplevel))
 187        (vbox (gtk-vbox-new #f 0))
 188        (hbox (gtk-hbox-new #f 10))
 189        (vboxi (gtk-vbox-new #f 10))
 190        (separator (gtk-hseparator-new))
 191        (close (gtk-button-new-with-label "close"))
 192        (cancel (gtk-button-new-with-label "cancel"))
 193        (apply (gtk-button-new-with-label "apply"))
 194        (notebook (gtk-notebook-new))
 195        (styleproc (add-vw-opts-style-frame notebook vw)))
 196
 197      (gtk-window-set-title window
 198                            (string-append
 199                             (wavefile-tag (visiblewave-file vw)) ":"
 200                             (visiblewave-varname vw) " Options"))
 201      (gtk-container-set-border-width window 0)
 202      (gtk-container-add window vbox)
 203      (gtk-widget-show vbox)
 204
 205      (gtk-box-pack-start vbox vboxi #t #t 0)
 206      (gtk-container-set-border-width vboxi 10)
 207      (gtk-widget-show vboxi)
 208
 209      (gtk-notebook-set-tab-pos notebook 'top)
 210      (gtk-box-pack-start vboxi notebook #t #t 0)
 211      (gtk-widget-show notebook)
 212
 213      (add-vw-opts-stats-frame notebook vw)
 214
 215      (gtk-box-pack-start vbox separator #f #t 0)
 216      (gtk-widget-show separator)
 217      (gtk-container-set-border-width hbox 10)
 218      (gtk-box-pack-start vbox hbox #f #t 0)
 219      (gtk-widget-show hbox)
 220
 221      (gtk-signal-connect close "clicked"
 222                          (lambda (x)
 223                            (styleproc)
 224                            (gtk-widget-destroy window)))
 225      (gtk-box-pack-start hbox close #t #t 0)
 226      (gtk-widget-show close)
 227      (gtk-tooltips-set-tip gwave-tooltips close
 228                            "Apply changes and close options window" "")
 229
 230      (gtk-box-pack-start hbox apply #t #t 0)
 231      (gtk-signal-connect apply "clicked"
 232                          (lambda (x) (styleproc)))
 233      (gtk-widget-show apply)
 234      (gtk-tooltips-set-tip gwave-tooltips apply
 235                            "Apply changes to VisibleWave" "")
 236
 237      (gtk-box-pack-start hbox cancel #t #t 0)
 238      (gtk-signal-connect cancel "clicked"
 239                          (lambda (x)
 240                            (gtk-widget-destroy window)))
 241      (gtk-widget-show cancel)
 242      (gtk-tooltips-set-tip gwave-tooltips cancel
 243                            "Close options window, discarding changes" "")
 244
 245 ;     (gtk-widget-set-flags close '(can-default))
 246 ;     (gtk-widget-grab-default close)
 247      (gtk-widget-show window)
 248 ))
 249
 250 (dbprint "visiblewave-ops.scm done\n")