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
|
;;
;; Simple example, ported from the one in Gtk+2.0 tutorial.
;;
;; $Id: spinbutton.scm,v 1.2 2007/01/13 01:36:30 maruska Exp $
(use gtk)
(define *spinner1* #f)
(define (toggle-snap button spin)
(gtk-spin-button-set-snap-to-ticks spin
(not (zero? (ref button 'active)))))
(define (toggle-numeric button spin)
(gtk-spin-button-set-numeric spin (not (zero? (ref button 'active)))))
(define (change-digits spin)
(gtk-spin-button-set-digits *spinner1*
(gtk-spin-button-get-value-as-int spin)))
(define (get-value widget data)
(let ((spin *spinner1*)
(label (g-object-get-data widget 'user_data)))
(gtk-label-set-text label
(if (= data 1)
(number->string
(gtk-spin-button-get-value-as-int spin))
(number->string
(gtk-spin-button-get-value spin))))))
(define (main args)
(gtk-init args)
(let1 window (gtk-window-new GTK_WINDOW_TOPLEVEL)
(g-signal-connect window "destroy"
(lambda _ (gtk-main-quit) #f))
(gtk-window-set-title window "Spin Button")
(let1 main-vbox (gtk-vbox-new #f 5)
(gtk-container-set-border-width main-vbox 10)
(gtk-container-add window main-vbox)
(let1 frame (gtk-frame-new "Not accelerated")
(gtk-box-pack-start main-vbox frame #t #t 0)
(let1 vbox (gtk-vbox-new #f 0)
(gtk-container-set-border-width vbox 5)
(gtk-container-add frame vbox)
(let1 hbox (gtk-hbox-new #f 0)
(gtk-box-pack-start vbox hbox #t #t 5)
(let1 vbox2 (gtk-vbox-new #f 0)
(gtk-box-pack-start hbox vbox2 #t #t 5)
(let1 label (gtk-label-new "Day :")
(gtk-misc-set-alignment label 0 0.5)
(gtk-box-pack-start vbox2 label #f #t 0))
(let* ((adj (gtk-adjustment-new 1.0 1.0 31.0 1.0 5.0 0.0))
(spinner (gtk-spin-button-new adj 0 0)))
(gtk-spin-button-set-wrap spinner #t)
(gtk-box-pack-start vbox2 spinner #f #t 0)))
(let1 vbox2 (gtk-vbox-new #f 0)
(gtk-box-pack-start hbox vbox2 #t #t 5)
(let1 label (gtk-label-new "Month :")
(gtk-misc-set-alignment label 0 0.5)
(gtk-box-pack-start vbox2 label #f #t 0))
(let* ((adj (gtk-adjustment-new 1.0 1.0 12.0 1.0 5.0 0.0))
(spinner (gtk-spin-button-new adj 0 0)))
(gtk-spin-button-set-wrap spinner #t)
(gtk-box-pack-start vbox2 spinner #f #t 0)))
(let1 vbox2 (gtk-vbox-new #f 0)
(gtk-box-pack-start hbox vbox2 #t #t 5)
(let1 label (gtk-label-new "Year :")
(gtk-misc-set-alignment label 0 0.5)
(gtk-box-pack-start vbox2 label #f #t 0))
(let* ((adj (gtk-adjustment-new 1998.0 0.0 2100.0 1.0 100.0 0.0))
(spinner (gtk-spin-button-new adj 0 0)))
(gtk-spin-button-set-wrap spinner #f)
(gtk-widget-set-size-request spinner 55 -1)
(gtk-box-pack-start vbox2 spinner #f #t 0)))
) ;hbox
) ;vbox
) ;frame
(let1 frame (gtk-frame-new "Accelerated")
(gtk-box-pack-start main-vbox frame #t #t 0)
(let1 vbox (gtk-vbox-new #f 0)
(gtk-container-set-border-width vbox 5)
(gtk-container-add frame vbox)
(let1 hbox (gtk-hbox-new #f 0)
(gtk-box-pack-start vbox hbox #f #t 5)
(let1 vbox2 (gtk-vbox-new #f 0)
(gtk-box-pack-start hbox vbox2 #t #t 5)
(let1 label (gtk-label-new "Value :")
(gtk-misc-set-alignment label 0 0.5)
(gtk-box-pack-start vbox2 label #f #t 0))
(let ((adj (gtk-adjustment-new 0.0 -10000.0 10000.0 0.5
100.0 0.0)))
(set! *spinner1* (gtk-spin-button-new adj 1.0 2)))
(gtk-spin-button-set-wrap *spinner1* #t)
(gtk-widget-set-size-request *spinner1* 100 -1)
(gtk-box-pack-start vbox2 *spinner1* #f #t 0))
(let1 vbox2 (gtk-vbox-new #f 0)
(gtk-box-pack-start hbox vbox2 #t #t 0)
(let1 label (gtk-label-new "Digits :")
(gtk-misc-set-alignment label 0 0.5)
(gtk-box-pack-start vbox2 label #f #t 0)
(let* ((adj (gtk-adjustment-new 2 1 5 1 1 0))
(spinner2 (gtk-spin-button-new adj 0.0 0)))
(gtk-spin-button-set-wrap spinner2 #t)
(g-signal-connect adj "value_changed"
(lambda _ (change-digits spinner2)))
(gtk-box-pack-start vbox2 spinner2 #f #t 0))))
) ; hbox
(let1 hbox (gtk-hbox-new #f 0)
(gtk-box-pack-start vbox hbox #f #t 5)
(let1 button (gtk-check-button-new-with-label "Snap to 0.5-ticks")
(g-signal-connect button "clicked"
(lambda _ (toggle-snap button *spinner1*)))
(gtk-box-pack-start vbox button #t #t 0)
(gtk-toggle-button-set-active button #t))
(let1 button (gtk-check-button-new-with-label "Numeric only input mode")
(g-signal-connect button "clicked"
(lambda _ (toggle-numeric button *spinner1*)))
(gtk-box-pack-start vbox button #t #t 0)
(gtk-toggle-button-set-active button #t)))
(let ((val-label (gtk-label-new ""))
(hbox (gtk-hbox-new #f 0)))
(gtk-box-pack-start vbox hbox #f #t 5)
(let1 button (gtk-button-new-with-label "Value as Int")
(g-object-set-data button 'user_data val-label)
(g-signal-connect button "clicked"
(lambda _ (get-value button 1)))
(gtk-box-pack-start hbox button #t #t 5))
(let1 button (gtk-button-new-with-label "Value as Float")
(g-object-set-data button 'user_data val-label)
(g-signal-connect button "clicked"
(lambda _ (get-value button 2)))
(gtk-box-pack-start hbox button #t #t 5))
(gtk-box-pack-start vbox val-label #t #t 0)
(gtk-label-set-text val-label "0"))
) ; vbox
) ; frame
(let1 hbox (gtk-hbox-new #f 0)
(gtk-box-pack-start main-vbox hbox #f #t 0)
(let1 button (gtk-button-new-with-label "Close")
(g-signal-connect button "clicked"
(lambda _ (gtk-widget-destroy window)))
(gtk-box-pack-start hbox button #t #t 5)))
) ; main-vbox
(gtk-widget-show-all window))
(gtk-main)
0)
|
