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