~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

Open Mash Cross Reference
mash/tcl/vd/test/lights.tcl

Component: ~ [ mash ] ~ [ apps ] ~ [ gsm ] ~ [ lib ] ~ [ otcl ] ~ [ srm ] ~ [ tcl8.3 ] ~ [ tclcl ] ~ [ tk8.3 ] ~ [ tutorials ] ~

  1 # lights.tcl --
  2 #
  3 #       Allows you to control lights settings in 405
  4 #
  5 # Copyright (c) 2000-2002 The Regents of the University of California.
  6 # All rights reserved.
  7 #
  8 # Redistribution and use in source and binary forms, with or without
  9 # modification, are permitted provided that the following conditions are met:
 10 #
 11 # A. Redistributions of source code must retain the above copyright notice,
 12 #    this list of conditions and the following disclaimer.
 13 # B. Redistributions in binary form must reproduce the above copyright notice,
 14 #    this list of conditions and the following disclaimer in the documentation
 15 #    and/or other materials provided with the distribution.
 16 # C. Neither the names of the copyright holders nor the names of its
 17 #    contributors may be used to endorse or promote products derived from this
 18 #    software without specific prior written permission.
 19 #
 20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
 21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 23 # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
 24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
 26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 30 
 31 Import enable
 32 
 33 source ../lib/tcl/sleep.tcl
 34 
 35 import Application 405Client
 36 
 37 Class LightsApp -superclass {Application}
 38 
 39 global g_app
 40 
 41 LightsApp instproc init {} {
 42     $self instvar amx_
 43 
 44     set amx_ [new 405Client]
 45 
 46     $self initUI
 47 }
 48 
 49 LightsApp instproc initUI {} {
 50     global g_onOff
 51     global g_outputSource
 52 
 53     wm title . "405 Lights"
 54     wm minsize . 150 0
 55 
 56     frame .controls -borderwidth 3
 57     pack .controls -side top -fill x
 58 
 59     # this initializes the manual switching part
 60     $self initManualUI .controls
 61 
 62     # exit button
 63     button .exit -text "Exit" -command exit
 64     pack .exit -side bottom -pady 10
 65 }
 66 
 67 # send a "" if the parent is the root window
 68 LightsApp private initManualUI { parent } {
 69     global g_setting
 70 
 71     lappend inputs [list "full" "Full On"]
 72     lappend inputs [list "overlay" "Overlay"]
 73 #    lappend inputs [list "theater" "Theater"]
 74     lappend inputs [list "slide" "Slide"]
 75     lappend inputs [list "off" "Off"]
 76 
 77     frame $parent.manual -borderwidth 3 -relief sunken
 78     pack $parent.manual -side top -fill x
 79 
 80     frame $parent.manual.labelFrame
 81     pack $parent.manual.labelFrame -side top -fill x
 82     label $parent.manual.labelFrame.outputLabel -text "Setting"
 83     pack $parent.manual.labelFrame.outputLabel -side left
 84 
 85     foreach item $inputs {
 86         set name [lindex $item 0]
 87         set desc [lindex $item 1]
 88         frame $parent.manual.but$name
 89         pack $parent.manual.but$name -side top -fill x
 90         radiobutton $parent.manual.but$name.but -text "$desc" -variable g_setting -value "$name"
 91         pack $parent.manual.but$name.but -side left
 92     }
 93 
 94     set g_setting full
 95 
 96     button $parent.manual.switch -text "Set" -command "$self setLights"
 97     pack $parent.manual.switch -side top
 98 }
 99 
100 LightsApp public setLights {} {
101     global g_setting
102     $self instvar amx_
103 
104     #puts stdout "g_setting is $g_setting"
105     $amx_ lights_set $g_setting
106 }
107 
108 # this is the main engine
109 
110 set g_app [new LightsApp]
111 
112 vwait forever
113 

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

This page was automatically generated by the LXR engine.
Visit the LXR main site for more information.