Added menu tcl script.
[crow/jumpnbump.git] / jbmenu.tcl
1 #!/usr/bin/wish8.0
2 #############################################################################
3 # Visual Tcl v1.20 Project
4 # Author : Philippe Brochard
5
6 #################################
7 # GLOBAL VARIABLES
8 #
9 global fireworks; 
10 global fullscreen; 
11 global nogore; 
12 global nosound; 
13 global widget; 
14
15 #################################
16 # USER DEFINED PROCEDURES
17 #
18 proc init {argc argv} {
19
20 }
21
22 init $argc $argv
23
24
25 proc {exec_file} {} {
26 global fullscreen
27         global nosound
28         global nogore
29         global fireworks
30         
31         set str_fullscreen ""
32         if { $fullscreen == 1 } { set str_fullscreen "-fullscreen" }
33         set str_nosound ""
34         if { $nosound == 1 } { set str_nosound "-nosound" }
35         set str_nogore ""
36         if { $nogore == 1 } { set str_nogore "-nogore" }
37         set str_fireworks ""
38         if { $fireworks == 1 } { set str_fireworks "-fireworks" }
39
40         set file ""
41         if { [ .top17.lis26 curselection ] != "" } then {
42                 set file "data/[ .top17.lis26 get [.top17.lis26 curselection] ].dat"
43         }
44         
45         exec ./jnb $str_fullscreen $str_nosound $str_nogore $str_fireworks -dat $file &
46 }
47
48 proc {fill_list_box} {} {
49 if [ catch { exec ls ./data } data ] {
50                 puts stderr "Error"
51         }
52
53         foreach p $data {
54                 .top17.lis26 insert end [ find_name $p ]
55         }
56 }
57
58 proc {find_name} {path} {
59 set alast [ string last "/" $path ];
60
61         incr alast;
62         if { $alast != [ string length $path ] } {
63                 set name [ string range $path $alast end ];
64         } else {
65                 incr alast -2;
66                 set tmp [ string range $path 0 $alast ];
67                 set alast [ string last "/" $tmp ];
68                 incr alast;
69                 set name [ string range $tmp $alast end ];
70         }
71
72         set fname [ split $name . ]
73         set firstname [ lindex $fname 0 ]
74
75         return $firstname;
76 }
77
78 proc {main} {argc argv} {
79 fill_list_box
80
81         bind .top17.lis26 <Double-Button-1> { exec_file }
82 }
83
84 proc {Window} {args} {
85 global vTcl
86     set cmd [lindex $args 0]
87     set name [lindex $args 1]
88     set newname [lindex $args 2]
89     set rest [lrange $args 3 end]
90     if {$name == "" || $cmd == ""} {return}
91     if {$newname == ""} {
92         set newname $name
93     }
94     set exists [winfo exists $newname]
95     switch $cmd {
96         show {
97             if {$exists == "1" && $name != "."} {wm deiconify $name; return}
98             if {[info procs vTclWindow(pre)$name] != ""} {
99                 eval "vTclWindow(pre)$name $newname $rest"
100             }
101             if {[info procs vTclWindow$name] != ""} {
102                 eval "vTclWindow$name $newname $rest"
103             }
104             if {[info procs vTclWindow(post)$name] != ""} {
105                 eval "vTclWindow(post)$name $newname $rest"
106             }
107         }
108         hide    { if $exists {wm withdraw $newname; return} }
109         iconify { if $exists {wm iconify $newname; return} }
110         destroy { if $exists {destroy $newname; return} }
111     }
112 }
113
114 #################################
115 # VTCL GENERATED GUI PROCEDURES
116 #
117
118 proc vTclWindow. {base} {
119     if {$base == ""} {
120         set base .
121     }
122     ###################
123     # CREATING WIDGETS
124     ###################
125     wm focusmodel $base passive
126     wm geometry $base 1x1+0+0
127     wm maxsize $base 1009 738
128     wm minsize $base 1 1
129     wm overrideredirect $base 0
130     wm resizable $base 1 1
131     wm withdraw $base
132     wm title $base "vt.tcl"
133     ###################
134     # SETTING GEOMETRY
135     ###################
136 }
137
138 proc vTclWindow.top17 {base} {
139     if {$base == ""} {
140         set base .top17
141     }
142     if {[winfo exists $base]} {
143         wm deiconify $base; return
144     }
145     ###################
146     # CREATING WIDGETS
147     ###################
148     toplevel $base -class Toplevel
149     wm focusmodel $base passive
150     wm geometry $base 416x314+246+193
151     wm maxsize $base 1009 738
152     wm minsize $base 1 1
153     wm overrideredirect $base 0
154     wm resizable $base 1 1
155     wm deiconify $base
156     wm title $base "Jump 'n Bump"
157     label $base.lab18 \
158         -borderwidth 1 -relief raised -text {Run Jump 'n Bump} 
159     label $base.lab20 \
160         -borderwidth 1 -relief sunken 
161     checkbutton $base.che22 \
162         -text {Full screen} -variable fullscreen 
163     checkbutton $base.che23 \
164         -text {no sound} -variable nosound 
165     checkbutton $base.che24 \
166         -text {no gore} -variable nogore 
167     checkbutton $base.che25 \
168         -text fireworks -variable fireworks 
169     listbox $base.lis26 \
170         -yscrollcommand {.top17.scr27 set} 
171     bind $base.lis26 <Double-Button-1> {
172         exec_file
173     }
174     scrollbar $base.scr27 \
175         -command {.top17.lis26 yview} 
176     button $base.but28 \
177         -command { exec_file } -text Run 
178     button $base.but29 \
179         -command { exit } -text Quit 
180     ###################
181     # SETTING GEOMETRY
182     ###################
183     place $base.lab18 \
184         -x 25 -y 10 -width 366 -height 17 -anchor nw -bordermode ignore 
185     place $base.lab20 \
186         -x 190 -y 40 -width 196 -height 257 -anchor nw -bordermode ignore 
187     place $base.che22 \
188         -x 220 -y 55 -anchor nw -bordermode ignore 
189     place $base.che23 \
190         -x 220 -y 85 -anchor nw -bordermode ignore 
191     place $base.che24 \
192         -x 220 -y 115 -anchor nw -bordermode ignore 
193     place $base.che25 \
194         -x 220 -y 145 -anchor nw -bordermode ignore 
195     place $base.lis26 \
196         -x 30 -y 40 -width 103 -height 261 -anchor nw -bordermode ignore 
197     place $base.scr27 \
198         -x 145 -y 40 -width 21 -height 262 -anchor nw -bordermode ignore 
199     place $base.but28 \
200         -x 240 -y 190 -width 117 -height 25 -anchor nw -bordermode ignore 
201     place $base.but29 \
202         -x 240 -y 245 -width 117 -height 25 -anchor nw -bordermode ignore 
203 }
204
205 Window show .
206 Window show .top17
207
208 main $argc $argv