← Back to branch summary

~ubuntu-branches/ubuntu/gutsy/amsn/gutsy

« back to all changes in this revision

Viewing changes to utils/linux/capture/test.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Theodore Karkoulis
  • Date: 2006-01-04 15:26:02 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20060104152602-ipe1yg00rl3nlklv
Tags: 0.95-1
http://bugs.debian.org/345052
http://bugs.debian.org/278575
New Upstream Release (closes: #345052, #278575).

Show diffs side-by-side

added added

removed removed

Lines of Context:
utils/linux/capture/test.tcl
 
1
#!/usr/bin/wish
 
2
lappend auto_path [pwd]
 
3
lappend auto_path "utils/linux/capture/"
 
4
 
 
5
package require capture
 
6
 
 
7
#puts "Device list : [::Capture::ListDevices]"
 
8
#puts "[::Capture::ListChannels /dev/video]"
 
9
#set grabber [::Capture::Open /dev/video 0]
 
10
#puts "[::Capture::GetGrabber /dev/video 0]"
 
11
 
 
12
set devices [::Capture::ListDevices]
 
13
set ::grabber ""
 
14
set ::preview ""
 
15
set ::res "HIGH"
 
16
 
 
17
wm protocol . WM_DELETE_WINDOW {
 
18
        if { [::Capture::IsValid $::grabber] } { ::Capture::Close $::grabber }
 
19
        if { [::Capture::IsValid $::preview] } { ::Capture::Close $::preview }
 
20
        exit
 
21
}
 
22
 
 
23
 
 
24
set img [image create photo]
 
25
label .l -image $img
 
26
button .r -text "Switch resolution" -command "SwitchResolution"
 
27
button .s -text "Camera Settings" -command "ShowPropertiesPage $::grabber $img"
 
28
button .c -text "Choose device" -command "ChooseDevice; .s configure -command \"ShowPropertiesPage \$::grabber $img\"; StartGrab \$::grabber $img"
 
29
 
 
30
pack .l .r .s .c -side top
 
31
 
 
32
 
 
33
proc SwitchResolution { } {
 
34
 
 
35
        if { $::res == "HIGH" } {
 
36
                set ::res "LOW"
 
37
        } elseif { $::res == "LOW" } {
 
38
                set ::res "HIGH"
 
39
        } else { 
 
40
                set ::res "HIGH"
 
41
        }
 
42
}
 
43
 
 
44
proc ChooseDevice { } {
 
45
 
 
46
        set window .chooser
 
47
        set lists $window.lists
 
48
        set devs $lists.devices
 
49
        set chans $lists.channels
 
50
        set buttons $window.buttons
 
51
        set status $window.status
 
52
        set preview $window.preview
 
53
        set settings $window.settings
 
54
 
 
55
        destroy $window
 
56
        toplevel $window
 
57
 
 
58
 
 
59
        frame $lists
 
60
 
 
61
 
 
62
        frame $devs -relief sunken -borderwidth 3
 
63
        label $devs.label -text "Devices"
 
64
        listbox $devs.list -yscrollcommand "$devs.ys set" -background \
 
65
            white -relief flat -highlightthickness 0 -height 5
 
66
        scrollbar $devs.ys -command "$devs.list yview" -highlightthickness 0 \
 
67
         -borderwidth 1 -elementborderwidth 2
 
68
        pack $devs.label $devs.list -side top -expand false -fill x
 
69
        pack $devs.ys -side right -fill y
 
70
        pack $devs.list -side left -expand true -fill both
 
71
 
 
72
 
 
73
        frame $chans -relief sunken -borderwidth 3
 
74
        label $chans.label -text "Channels"
 
75
        listbox $chans.list -yscrollcommand "$chans.ys set"  -background \
 
76
            white -relief flat -highlightthickness 0 -height 5 -selectmode extended
 
77
        scrollbar $chans.ys -command "$chans.list yview" -highlightthickness 0 \
 
78
         -borderwidth 1 -elementborderwidth 2
 
79
        pack $chans.label $chans.list -side top -expand false -fill x
 
80
        pack $chans.ys -side right -fill y
 
81
        pack $chans.list -side left -expand true -fill both
 
82
 
 
83
        pack $devs $chans -side left
 
84
 
 
85
        label $status -text "Please choose a device"
 
86
 
 
87
        set img [image create photo]
 
88
        label $preview -image $img
 
89
        button $settings -text "Camera Settings" -command "ShowPropertiesPage $::preview $img"
 
90
 
 
91
        frame $buttons -relief sunken -borderwidth 3
 
92
        button $buttons.ok -text "Ok" -command "Choose_Ok $window $devs.list $chans.list $img"
 
93
        button $buttons.cancel -text "Cancel" -command "destroy $window"
 
94
        wm protocol $window WM_DELETE_WINDOW "Choose_Cancel $window $img"
 
95
        pack $buttons.ok $buttons.cancel -side left
 
96
 
 
97
        pack $lists $status $preview $settings $buttons -side top
 
98
 
 
99
        bind $devs.list <Button1-ButtonRelease> "FillChannels $devs.list $chans.list $status"
 
100
        bind $chans.list <Button1-ButtonRelease> "StartPreview $devs.list $chans.list $status $preview $settings"
 
101
 
 
102
        foreach device $::devices {
 
103
                set dev [lindex $device 0]
 
104
                set name [lindex $device 1]
 
105
 
 
106
                if {$name == "" } {
 
107
                        set name "Device $dev is busy"
 
108
                }
 
109
 
 
110
                $devs.list insert end $name
 
111
        }
 
112
 
 
113
        tkwait window $window
 
114
}
 
115
 
 
116
proc FillChannels { device_w chan_w status } {
 
117
 
 
118
        $chan_w delete 0 end
 
119
 
 
120
        if { [$device_w curselection] == "" } {
 
121
                $status configure -text "Please choose a device"
 
122
                return
 
123
        }
 
124
        set dev [$device_w curselection]
 
125
 
 
126
        set device [lindex $::devices $dev]
 
127
        set ::device [lindex $device 0]
 
128
 
 
129
        if { [catch {set channels [::Capture::ListChannels $::device]} res] } {
 
130
                $status configure -text $res
 
131
                return
 
132
        }
 
133
 
 
134
        foreach chan $channels {
 
135
                $chan_w insert end [lindex $chan 1]
 
136
        }
 
137
 
 
138
        $status configure -text "Please choose a Channel"
 
139
}
 
140
 
 
141
proc StartPreview { device_w chan_w status preview_w settings } {
 
142
 
 
143
#       if { [$device_w curselection] == "" } {
 
144
#               $status configure -text "Please choose a device"
 
145
#               return
 
146
#       }
 
147
 
 
148
        if { [$chan_w curselection] == "" } {
 
149
                $status configure -text "Please choose a Channel"
 
150
                return
 
151
        }
 
152
 
 
153
        set img [$preview_w cget -image]
 
154
        if {$img == "" } {
 
155
                return
 
156
        }
 
157
 
 
158
        set dev [$device_w curselection]
 
159
        set chan [$chan_w curselection]
 
160
 
 
161
#       set device [lindex $::devices $dev]
 
162
#       set device [lindex $device 0]
 
163
 
 
164
 
 
165
        if { [catch {set channels [::Capture::ListChannels $::device]} res] } {
 
166
                $status configure -text $res
 
167
                return
 
168
        }
 
169
 
 
170
        set channel [lindex $channels $chan]
 
171
        set channel [lindex $channel 0]
 
172
 
 
173
        if { [::Capture::IsValid $::preview] } {
 
174
                ::Capture::Close $::preview
 
175
        }
 
176
 
 
177
        if { [catch {set ::preview [::Capture::Open $::device $channel]} res] } {
 
178
                $status configure -text $res
 
179
                return
 
180
        }
 
181
 
 
182
        $settings configure -command "ShowPropertiesPage $::preview $img"
 
183
        after 0 "StartGrab $::preview $img"
 
184
 
 
185
}
 
186
 
 
187
proc Choose_Ok { w device_w chan_w img} {
 
188
 
 
189
        if { [::Capture::IsValid $::preview] } {
 
190
                ::Capture::Close $::preview
 
191
        }
 
192
 
 
193
        image delete $img
 
194
 
 
195
#       if { [$device_w curselection] == "" } {
 
196
#               destroy $w
 
197
#               return
 
198
#       }
 
199
 
 
200
        if { [$chan_w curselection] == "" } {
 
201
                destroy $w
 
202
                return
 
203
        }
 
204
 
 
205
        set dev [$device_w curselection]
 
206
        set chan [$chan_w curselection]
 
207
 
 
208
#       set device [lindex $::devices $dev]
 
209
#       set device [lindex $device 0]
 
210
 
 
211
 
 
212
        if { [catch {set channels [::Capture::ListChannels $::device]} res] } {
 
213
                destroy $w
 
214
                return
 
215
        }
 
216
 
 
217
        set channel [lindex $channels $chan]
 
218
        set channel [lindex $channel 0]
 
219
 
 
220
 
 
221
        if { [catch {set temp [::Capture::Open $::device $channel]} res] } {
 
222
                destroy $w
 
223
                return
 
224
        }
 
225
 
 
226
        if { [::Capture::IsValid $::grabber] } {
 
227
                ::Capture::Close $::grabber
 
228
        }
 
229
        set ::grabber $temp
 
230
 
 
231
        if { [winfo exists .properties_$::preview] } {
 
232
                destroy .properties_$::preview
 
233
        }
 
234
 
 
235
 
 
236
        destroy $w
 
237
}
 
238
 
 
239
proc Choose_Cancel { w  img} {
 
240
 
 
241
        if { [::Capture::IsValid $::preview] } {
 
242
                ::Capture::Close $::preview
 
243
        }
 
244
 
 
245
        image delete $img
 
246
 
 
247
        if { [winfo exists .properties_$::preview] } {
 
248
                destroy .properties_$::preview
 
249
        }
 
250
 
 
251
        destroy $w
 
252
}
 
253
 
 
254
proc ShowPropertiesPage { capture_fd {img ""}} {
 
255
 
 
256
        if { ![::Capture::IsValid $capture_fd] } {
 
257
                return
 
258
        }
 
259
 
 
260
        set window .properties_$capture_fd
 
261
        set slides $window.slides
 
262
        set preview $window.preview
 
263
        set buttons $window.buttons
 
264
 
 
265
        set init_b [::Capture::GetBrightness $capture_fd]
 
266
        set init_c [::Capture::GetContrast $capture_fd]
 
267
        set init_h [::Capture::GetHue $capture_fd]
 
268
        set init_co [::Capture::GetColour $capture_fd]
 
269
 
 
270
        destroy $window
 
271
        toplevel $window
 
272
 
 
273
        frame $slides
 
274
        scale $slides.b -from 0 -to 65535 -resolution 1 -showvalue 1 -label "Brightness" -command "Properties_Set $slides.b b $capture_fd" -orient horizontal
 
275
        scale $slides.c -from 0 -to 65535 -resolution 1 -showvalue 1 -label "Contrast" -command "Properties_Set $slides.c c $capture_fd" -orient horizontal
 
276
        scale $slides.h -from 0 -to 65535 -resolution 1 -showvalue 1 -label "Hue" -command "Properties_Set $slides.h h $capture_fd" -orient horizontal
 
277
        scale $slides.co -from 0 -to 65535 -resolution 1 -showvalue 1 -label "Colour" -command "Properties_Set $slides.co co $capture_fd" -orient horizontal
 
278
 
 
279
        pack $slides.b $slides.c $slides.h $slides.co -side top -expand true -fill x
 
280
 
 
281
        frame $buttons -relief sunken -borderwidth 3
 
282
        button $buttons.ok -text "Ok" -command "destroy $window"
 
283
        button $buttons.cancel -text "Cancel" -command "Properties_Cancel $window $capture_fd $init_b $init_c $init_h $init_co"
 
284
        wm protocol $window WM_DELETE_WINDOW "Properties_Cancel $window $capture_fd $init_b $init_c $init_h $init_co"
 
285
 
 
286
 
 
287
        pack $buttons.ok $buttons.cancel -side left
 
288
 
 
289
        if { $img == "" } {
 
290
                set img [image create photo]
 
291
        }
 
292
        label $preview -image $img
 
293
 
 
294
        after 0 "StartGrab $capture_fd $img"
 
295
 
 
296
 
 
297
        pack $slides $preview $buttons -side top
 
298
 
 
299
 
 
300
        $slides.b set $init_b
 
301
        $slides.c set $init_c
 
302
        $slides.h set $init_h
 
303
        $slides.co set $init_co
 
304
 
 
305
        return $window
 
306
 
 
307
}
 
308
 
 
309
proc Properties_Set { w property capture_fd new_value } {
 
310
 
 
311
        switch $property {
 
312
                b {
 
313
                        ::Capture::SetBrightness $capture_fd $new_value
 
314
                        set val [::Capture::GetBrightness $capture_fd]
 
315
                        $w set $val
 
316
                }
 
317
                c {
 
318
                        ::Capture::SetContrast $capture_fd $new_value
 
319
                        set val [::Capture::GetContrast $capture_fd]
 
320
                        $w set $val
 
321
                }
 
322
                h
 
323
                {
 
324
                        ::Capture::SetHue $capture_fd $new_value
 
325
                        set val [::Capture::GetHue $capture_fd]
 
326
                        $w set $val
 
327
                }
 
328
                co
 
329
                {
 
330
                        ::Capture::SetColour $capture_fd $new_value
 
331
                        set val [::Capture::GetColour $capture_fd]
 
332
                        $w set $val
 
333
                }
 
334
        }
 
335
 
 
336
}
 
337
proc Properties_Cancel { window capture_fd init_b init_c init_h init_co } {
 
338
 
 
339
        ::Capture::SetBrightness $capture_fd $init_b
 
340
        ::Capture::SetContrast $capture_fd $init_c
 
341
        ::Capture::SetHue $capture_fd $init_h
 
342
        ::Capture::SetColour $capture_fd $init_co
 
343
        destroy $window
 
344
}
 
345
 
 
346
proc StartGrab { grabber img } {
 
347
        set semaphore ::sem_$grabber
 
348
        set $semaphore 0
 
349
 
 
350
        while { [::Capture::IsValid $grabber] && [lsearch [image names] $img] != -1 } {
 
351
                ::Capture::Grab $grabber $img $::res
 
352
                after 10 "incr $semaphore"
 
353
                tkwait variable $semaphore
 
354
        }
 
355
}