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