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