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