boxcl.tcl (24130B)
1 #!/usr/bin/env tclsh 2 # BOXcl: a simple and self-contained Sokoban clone that can load any custom levelset 3 # Depends upon Tcllib and Tk 4 # Compatible with *plaintext* levels downloaded from https://www.sourcecode.se/sokoban/levels.php 5 # Press h or F1 to get in-game help 6 # Controls: WASD or arrow keys to move, u to undo, r to restart, 7 # Ctrl+N / Ctrl+P to switch levels in the set, Ctrl+O to open a new set, Ctrl+Q to quit 8 # Created by Luxferre in 2024, released into public domain 9 10 package require textutil 11 package require Tk 12 13 set scriptpath [ file normalize [ info script ] ] 14 set appdir [ file dirname $scriptpath ] 15 # check if we're running from a starpack 16 if [string match *app-boxcl $appdir] { 17 set appdir [ file normalize [ file join $appdir ".." ".." ".." ] ] 18 } 19 set leveldir [ file join $appdir "levelsets" ] 20 21 # hardcoded tile sizes 22 set tilew 64 23 set tileh 64 24 25 # check if the line contains only valid Sokoban format characters 26 proc islevelline {line} { 27 return [regexp {^[ #pPbB._*$+@-]+$} $line] 28 } 29 30 # convert a level data line into the internal format 31 proc levelconvert {datalist} { 32 set convdata "" 33 foreach dataline $datalist { 34 set outlist "" 35 foreach chr [split $dataline ""] { 36 switch $chr { 37 {#} {lappend outlist 8} 38 p - 39 @ {lappend outlist 2} 40 P - 41 + {lappend outlist 3} 42 b - 43 $ {lappend outlist 4} 44 B - 45 * {lappend outlist 5} 46 . {lappend outlist 1} 47 " " - 48 "-" - 49 _ {lappend outlist 0} 50 default {} 51 } 52 } 53 lappend convdata $outlist 54 } 55 return $convdata 56 } 57 58 # load and parse a levelset file 59 proc loadlevels {fname} { 60 set fp [open $fname r] 61 fconfigure $fp -encoding utf-8 -translation auto 62 set fdata [read $fp] 63 close $fp 64 set levelblocks [::textutil::splitx $fdata {\n\n}] 65 set levelsettitle "" 66 set levelsetauthor "" 67 set outlevels "" 68 foreach lblock $levelblocks { 69 set leveldata "" 70 set leveltitle "" 71 foreach line [split $lblock "\n"] { 72 set line [string trimright $line] 73 if {[islevelline $line]} { # the line contains valid level characters 74 lappend leveldata $line 75 } else { 76 if {[regexp {^Title:(.*)$} $line _ title]} { 77 set leveltitle [string trim $title] 78 } elseif {[regexp {^Author:(.*)$} $line _ author]} { 79 set levelsettitle $leveltitle 80 set leveltitle "" 81 set levelsetauthor [string trim $author] 82 } 83 } 84 } 85 if {$leveldata ne ""} { 86 set lobj "" 87 dict set lobj settitle $levelsettitle 88 dict set lobj author $levelsetauthor 89 dict set lobj title $leveltitle 90 dict set lobj data [levelconvert $leveldata] 91 lappend outlevels $lobj 92 } 93 } 94 return $outlevels 95 } 96 97 # render the level state 98 proc renderfield {leveldata} { 99 global tilew tileh fieldw 100 global tile_0 tile_1 tile_2 tile_3 tile_4 tile_5 tile_8 101 .c delete anytile 102 set rownum 0 103 foreach line $leveldata { 104 set tiley [expr {$rownum * $tileh}] 105 for {set colnum 0} {$colnum < $fieldw} {incr colnum} { 106 set colval [lindex $line $colnum] 107 if {$colval eq ""} {set colval 0} 108 set curtile "tile_$colval" 109 set tilex [expr {$colnum * $tilew}] 110 .c create image $tilex $tiley -image $curtile -anchor nw -tag anytile 111 } 112 incr rownum 113 } 114 } 115 116 # move logic 117 # dir: 0 up, 1 left, 2 down, 3 right 118 # return 1 if won 119 proc domove {dir} { 120 global leveldata fieldw fieldh pushcount 121 # detect horizontal and vertical direction factors 122 if {$dir % 2} { 123 set hd [expr {$dir - 2}] 124 set vd 0 125 } else { 126 set vd [expr {$dir - 1}] 127 set hd 0 128 } 129 # find the player position into cx and cy 130 for {set cy 0; set outbreak 0} {($outbreak < 1) && ($cy < $fieldh)} {incr cy} { 131 for {set cx 0} {($outbreak < 1) && ($cx < $fieldw)} {incr cx} { 132 if {[lindex $leveldata $cy $cx] & 2} { # found it 133 set outbreak 1 134 incr cx -1 135 incr cy -1 136 } 137 } 138 } 139 # calculate the new target player position 140 set tx [expr {$cx + $hd}] 141 set ty [expr {$cy + $vd}] 142 # start by checking if it is within the field boundaries 143 if {($tx >= 0) && ($tx < $fieldw) && ($ty >= 0) && ($ty < $fieldh)} { 144 # get the target object value 145 set tov [lindex $leveldata $ty $tx] 146 if {$tov < 6} { # we're not pushing a wall 147 if {$tov & 4} { # we've hit a box 148 # get next-to-target positions 149 set ntx [expr {$tx + $hd}] 150 set nty [expr {$ty + $vd}] 151 # calculate the condition under which we can push 152 if {($ntx >= 0) && ($ntx < $fieldw) && ($nty >= 0) && ($nty < $fieldh)} { 153 set ntov [lindex $leveldata $nty $ntx] 154 if {$ntov < 4} { # now we can push 155 # remove the box from the target field 156 lset leveldata $ty $tx [expr {$tov & 11}] 157 # push the box further 158 lset leveldata $nty $ntx [expr {$ntov | 4}] 159 # increment the push counter 160 incr pushcount 161 } else {return 0} 162 } else { # otherwise don't perform the move 163 return 0 164 } 165 } 166 # now, remove player from the current field 167 lset leveldata $cy $cx [expr {[lindex $leveldata $cy $cx] & 13}] 168 # add player to the target field 169 lset leveldata $ty $tx [expr {[lindex $leveldata $ty $tx] | 2}] 170 # check for victory by counting boxes not on goals 171 set bcount 0 172 for {set cy 0} {$cy < $fieldh} {incr cy} { 173 for {set cx 0} {$cx < $fieldw} {incr cx} { 174 if {int([lindex $leveldata $cy $cx]) == 4} { # non-goal box 175 incr bcount 176 } 177 } 178 } 179 if {$bcount > 0} {return 0} else {return 1} 180 } 181 } 182 return 0 183 } 184 185 # perform a move and render it 186 proc rendermove {dir} { 187 global leveldata pushcount undobuffer 188 lappend undobuffer $leveldata 189 set res [domove $dir] 190 # remove the last undobuffer entry if the field is the same 191 if {[lindex $undobuffer end] eq $leveldata} { 192 set undobuffer [lreplace $undobuffer end end] 193 } 194 renderfield $leveldata 195 # check for victory flag 196 if {$res eq 1} { 197 tk_messageBox -title {Victory!} -type ok -message "Level complete!\nPushes: $pushcount" 198 nextlevel 1 199 } 200 } 201 202 # undo the last move and render the result 203 # Tcl 8.6 compatible (no lpop) 204 proc renderundo {} { 205 global leveldata undobuffer 206 if {[llength $undobuffer] > 0} { 207 set leveldata [lindex $undobuffer end] 208 set undobuffer [lreplace $undobuffer end end] 209 renderfield $leveldata 210 } 211 } 212 213 # start a loaded level 214 proc startlevel {level} { 215 global tilew tileh fieldw fieldh leveldata pushcount 216 global undobuffer 217 set undobuffer "" 218 set leveltitle [dict get $level title] 219 set leveldata [dict get $level data] 220 set settitle [dict get $level settitle] 221 set pushcount 0 222 # determine field width and field height (in tiles) 223 set fieldh [llength $leveldata] 224 set fieldw 0 225 foreach l $leveldata { 226 set lw [llength $l] 227 if {$lw > $fieldw} {set fieldw $lw} 228 } 229 # align level data 230 set idx 0 231 foreach l $leveldata { 232 set lw [llength $l] 233 if {$lw < $fieldw} { 234 set diff [expr {$fieldw - $lw}] 235 for {set i 0} {$i < $diff} {incr i} { 236 lset leveldata $idx end+1 0 237 } 238 } 239 incr idx 240 } 241 242 .c configure -width [expr {$fieldw * $tilew}] -height [expr {$fieldh * $tileh}] 243 wm title . "BOXcl - $settitle - $leveltitle" 244 renderfield $leveldata 245 } 246 247 # move to the next level in the set 248 proc nextlevel {natural} { 249 global sublevel levels levelcount 250 incr sublevel 251 if {$sublevel == $levelcount} { 252 if {$natural eq 1} { 253 tk_messageBox -title {All clear!} -type ok -message "Congratulations!\nYou have beaten the last level in the set!" 254 exit 0 255 } else { 256 set sublevel 0 257 startlevel [lindex $levels $sublevel] 258 } 259 } else { 260 startlevel [lindex $levels $sublevel] 261 } 262 } 263 264 # move to the previous level in the set 265 proc prevlevel {} { 266 global sublevel levels levelcount 267 incr sublevel -1 268 if {$sublevel == -1} { 269 set sublevel [expr {$levelcount - 1}] 270 } 271 startlevel [lindex $levels $sublevel] 272 } 273 274 # open a levelsetfile 275 proc openlevel {} { 276 global leveldir 277 set types { 278 {{Plain text levelset} {.txt} TEXT} 279 {{Sokoban YASC levelset} {.sok} TEXT} 280 } 281 return [tk_getOpenFile -initialdir $leveldir -filetypes $types -title {Choose a Sokoban levelset file}] 282 } 283 284 # define the tiles 285 286 set imgdata(wall) { 287 iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAAAAACPAi4CAAADQ0lEQVRYw8VX23bqIBDtD9mLra1a 288 q9Vj6wq5nIRkBcKa//+OQ4AQGIjV+nDmpXZDdsjMZjPc3d8YdzcTzB4eTbzIeFvJeHtxQiELF1n0 289 U+b6mfvZ3Wy+lLH9k6ggDICTxIlUADQukBAOAH+Pu5V87sEQHMZRgNSbnpQAxEcKgE7++X63BHtn 290 VLAEBYSIXtNpZQjW7iC7iICqv3tD4C4g6To0O4UQgVb9+DYEX85gDpD70ylA4SM1gNCJWmsCl1xm 291 mHtZzGUVRIkYh0mbnuD1I7dRgwoaIIza4BoRtfy9f+wJPuGKEGzgapmA05MkeF5TKtRYlZvFk7xo 292 9VvybPgSvZbO/by0VQR9DkjPUARyK3DuUILTr4EgyYbSjgwCKVhWOFDEpyVIWqxX+cIiQNBLku1I 293 QAHLjWJBSOQsAdpDSRNZQYuQ3UjAIzlA00mHdyo5WgK5Z6HyBjlGSNMLMIuXUevNWUOmdAAN8UTe 294 S6OxkmyMkBZbxpkKPgrOIN05RIpSfcLifVxlqcZrp6KkjSOisJvJ241SLCh3JIqY9EQIypgnhojx 295 mAjBhZ5IpwnYjQQELvLEJjmTg9ATQ0SQCYK0i3liiBiJaU/cXOCJIcJL+Xt7vSf6YaQ8/EuxJ0Iz 296 emLBFFLnQ0KyvBZ2M1G0l4xL+ju8Z6j9U9YSSPfADljYVDuHFkKSw2goXeCJHL0uhjiWVgeeeLWp 297 /saVHU9soAxOgfBc4AjZWwKZdJEhUwbwkSrwzdxWQRueI3lSqaqXiNGvVTkcrnklzCFuo/Od0EE6 298 i3CjxNfdYLP1MEs0hdZ9SesphNPK7IWXJeo+/H6kiiLGZCJ+wACXo4khk34g9XqjIyXdrabKbyRI 299 Y51xiLSTBDTodVgMMaJTBM9L1Ei5Z7Lq/2OIrqw21d3YRDJ77g4BU4iS5NH3RKtT7p3h3mOj4MVg 300 qn0OSjXX3UwUkAIN4npEwT1PRP4RbzR9TWam0Twqs6iClupnQzGOdJjwxB/7xNNaE2x+22geDEH/ 301 DU2k0SwDpEELeDcEq5O8HYaNJgsQ/2DZLo2tS4beFMugCmVgs84Sjpvlh+rW+6vv03wu77P4futf 302 edUdeLwWz9VT8ur732/v/wB3P44Wbg6kBQAAAC10RVh0U29mdHdhcmUAYnkuYmxvb2RkeS5jcnlw 303 dG8uaW1hZ2UuUE5HMjRFbmNvZGVyqAZ/7gAAAABJRU5ErkJggg== 304 } 305 306 set imgdata(boxongoal) { 307 iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAQAAAAAYLlVAAACy0lEQVRo3sWZvW7bMBDHObWZmqKR 308 KAcGmjiI69RorEqWfYEQoFq7d+/SvY+QpXseoY+ixXsfoUMfIQ9wHSgpTnj8kklGt9Ew/z+Rx9Px 309 jrHh4Xlyl7RJm7Qcw1jSJu3Jr3c/Xl+y5w/Pw8kqUKo9+en3pz9Pg9npI8LD8bfh7cVQhue4wGVw 310 u8BJh8BzxhhjWcuR4yleRRAXdtWtRNIO759FlBcImdiKnKX3HDnOosovcYnnYg3umfB++f1LrLHA 311 mrAKgRgttCOlNP+i3wSx/xQjYIUNYTd4S4xWmhEg5xeuyMSxo5dp5QUAFLNPzQBLhIMBQDk3CVBa 312 ILgAALGqWoCa+AuMBpDn2mJtAmiMCLYAhTTPJ2xsAEwIdgBAHOzKFkCPYANAyTcuADoEMwAt7wig 313 RjABqOSdASg3AiOAbvOcASoyLugA9O47AqAhED4rAUwHeBQAhbAlAcwhbCRAYxWgV2TY8QRgRlCF 314 HW8ADW41COqw4xFA7WK6sOMVoCG/bvqw4xngOcKcSGbBkCEcCLCPoJcPBtBgZSUfEOAGcwv5oAC3 315 Vhl0QIC1JD/HWbwVqCT5y25DoviAfO5ne/4Q/BTo5YPHASoY58rTEO1boPpSegbQpRv0l9IrADjn 316 A+ATACwyomvL0DQCACxzwjJMTijLXyuz4tJ/VkylG7p7Qen3XlCQ2Y7+ZlT6uxmpki33uyGMAVDn 317 emNux+AKIE+xPrA+AC4AYSokYAsQrka0sgHwWSWjTkQdt05YEq4cuVJaulVKQ9SKN2MBQlfLe4C/ 318 HLli8X0B0AhduV40LD5Ii7/BDea4IazANTGaG0ZWZMMi3bHkjiPH9y/Xsjk6E02rRVT5vmn16iNj 319 3Sa8RNsu3T1pXE7wIgrEvO8aPgw95JOhdZsFbNsKmwzN26F1yxhjb78kf6I2r/+9+Sp10I/O0t8i 320 KoS1dJf+ZMe96n+qpZFsvgDj+QAAAC10RVh0U29mdHdhcmUAYnkuYmxvb2RkeS5jcnlwdG8uaW1h 321 Z2UuUE5HMjRFbmNvZGVyqAZ/7gAAAABJRU5ErkJggg== 322 } 323 324 set imgdata(box) { 325 iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAQAAAAAYLlVAAACvklEQVRo3sWZW07jMBSGs4PRPFaC 326 OFGFeBlRiqhGFaqAKpoEGoGRIp4isYRZQpfAEmYpWcIsgSWwhH8enKYdfHwLtonfXNX/F9vn5FyS 327 ZHjyWbplHetYlyHMYB3r0m36MmHJxyefhZOlUfLZgXz68v/Pp8HGyR7h/fhxeHsxleMMS6yCjwtM 328 e4R+F8Tmn+AqgrgYV/1OsG54/zyivEDIxa7PkvQ1Q4bzqPIrrHCGDBnS1/4A5Pev0KBEQ4wanJgt 329 tTOVtP5ydwji/ClGjg1aYjzhmZjdaGY4ub64iokwO3qbCi8AXLH6qRlgBf5pAK5cmwSoLBBcAGT5 330 tR6gIf7CRwPIaz2gMQG0RgRbAHk3b9DaAJgQ7AA4YdgbWwA9gg0AJd+6AOgQzAC0vCOAGsEEoJJ3 331 BmhRkgh6AN3hOQNsSL+gA9Bf3xEAlDH9UgKYDHgUAIXwSAKYXdhIgNbKQRek2/EEYEZQuR1vAC0e 332 NAhqt+MRQH3FdG7HK0BLft30bsczwEeEBeYGt+Md4BBBLx8MoEVtJR8Q4AmFhXxQgGcixFxbRole 333 AO4l+QXm8XagluQv+wOJcgdku58f3IfgVqCXD+4HKGdcKK0h2rdA9aX0DKALN+gvpVcA7hwPcJ8A 334 3CIiurVI7kcCcMuYsAoTE8ryt8qouPIfFVPhhi4vqPzmBRUZ7egzo8pfZqQKttxzQz4GQB3rjcmO 335 uSuAvMT9J+sD3AUgTIWE2wL4qhGVpGtqYlbJKIto4tYJKUOOXCmt3CqlIWrF9ViA0NXyHoC9ZcgU 336 m+8LgEboy/WiYfFTSjNq1ChQE6PEHTFbGGbWqoZFus2Q4cfXtWwmTDStllHld02rCfv6tt2+cTnF 337 RRSIxU7+fegh71u3ecC2rRjToXk7tG6TJEmOrtnfqM3rt6NrqYM+Yekf4RVCd87T39+/7VT/AZaV 338 3OsTnXjsAAAALXRFWHRTb2Z0d2FyZQBieS5ibG9vZGR5LmNyeXB0by5pbWFnZS5QTkcyNEVuY29k 339 ZXKoBn/uAAAAAElFTkSuQmCC 340 } 341 342 set imgdata(player) { 343 iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAYAAACqaXHeAAAAGXRFWHRTb2Z0d2FyZQBBZG9iZSBJ 344 bWFnZVJlYWR5ccllPAAAAyZpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADw/eHBhY2tldCBiZWdp 345 bj0i77u/IiBpZD0iVzVNME1wQ2VoaUh6cmVTek5UY3prYzlkIj8+IDx4OnhtcG1ldGEgeG1sbnM6 346 eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IkFkb2JlIFhNUCBDb3JlIDUuNi1jMTM4IDc5LjE1 347 OTgyNCwgMjAxNi8wOS8xNC0wMTowOTowMSAgICAgICAgIj4gPHJkZjpSREYgeG1sbnM6cmRmPSJo 348 dHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1zeW50YXgtbnMjIj4gPHJkZjpEZXNjcmlw 349 dGlvbiByZGY6YWJvdXQ9IiIgeG1sbnM6eG1wPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAv 350 IiB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wL21tLyIgeG1sbnM6c3RS 351 ZWY9Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC9zVHlwZS9SZXNvdXJjZVJlZiMiIHhtcDpD 352 cmVhdG9yVG9vbD0iQWRvYmUgUGhvdG9zaG9wIENDIDIwMTcgKFdpbmRvd3MpIiB4bXBNTTpJbnN0 353 YW5jZUlEPSJ4bXAuaWlkOjJCQzQyNTY5RTI1NTExRTZCNUJFOEM2QkJDQzA1OUQ1IiB4bXBNTTpE 354 b2N1bWVudElEPSJ4bXAuZGlkOjJCQzcyN0ZCRTI1NTExRTZCNUJFOEM2QkJDQzA1OUQ1Ij4gPHht 355 cE1NOkRlcml2ZWRGcm9tIHN0UmVmOmluc3RhbmNlSUQ9InhtcC5paWQ6MkJDNDI1NjdFMjU1MTFF 356 NkI1QkU4QzZCQkNDMDU5RDUiIHN0UmVmOmRvY3VtZW50SUQ9InhtcC5kaWQ6MkJDNDI1NjhFMjU1 357 MTFFNkI1QkU4QzZCQkNDMDU5RDUiLz4gPC9yZGY6RGVzY3JpcHRpb24+IDwvcmRmOlJERj4gPC94 358 OnhtcG1ldGE+IDw/eHBhY2tldCBlbmQ9InIiPz6SouJPAAAGb0lEQVR42u1ba08cVRjmH/gT/GrV 359 eMnCXgoK4SKwu7VooGBdKTbQLWJDEFtrbcVG+SJorY02tqRUrbYlqYSEYiLWfkESDZe2Rog2FNGm 360 GtFSjPiBtHmdZzpnPDtzdvfsMmfY4k7yJJudc973eZ9z5p1zmZNDRDn/Z+RkBcgKkBUgK0DSQpJX 361 NOx9sHlDoHB72N/B4fxK0BwKHGC2okHfRtiX5aNcgG2lnruaQ/4t20P+Xp1sOEBuQBdH8wnf4LAq 362 AqA1NBKzPLGGukeprqmEKl7dYKLgYA35D9emDd5WdUsZReqLYsXQOICLqwJAeT7o8O6gHuhDJyJ0 363 z8BWpbi/b4spDHybYmicXBGgJbj+buYUgYOQ6qATiQEhGB9wUy6A/uxpzqraKlYtcCvAxXgcetUL 364 YCQ7N7q7LMCFJUflAmiOFhqfzM+Y4BnYY+CGALqjdEjmnW2h3RM9NHxtnL6Zn44B/sO9NSsAgru6 365 NE/Jrqkbc1R1vmNtCYCAFpeXSPaCUKmKkLECFH+xM6Xg+Z6AR+aOF+CzuRFK90LdO16AdFqfXaib 366 8QKsG2qkdZ83xeC+r5qV4N7haKwvzfeqCfDAWFtGIStAVgCXBcj78rmMCR5c3BMgFJiEo00vBjNG 367 AHC5vSYQmHRjNtghWqb6Y/wjop8GXMOHr2+zL5eFAgf4JTLHBWBrAVb0de9wNXgAggvXC0P+WSUC 368 sOC7Wmto8INdNHx8r+6wM7qRlqZOx5D7eeQIvd1WqwO/0w2St/PD8CHb/cH3d+ocwAWcwI1fGHFM 369 ALYGuO/ZSrpw9i2aPndIxyv1FcIAQZi1CH6nK4CMHTQA4wNu4MjWCB0U4Hbig9LMGWBteQZrt0xX 370 ABk74MBzYj0TnJ0TwCDAOwJWQtwpAQArL7P8agmAbsnq4LeozG9jx2nu6yM6rn17jG7O9KdlB/WU 371 C8A2QKyPwPLlM3GT1ws1RTpEOeLGpU9spCFIPDvwLUqC+iMwLX4EwNk5AYx3vzUJwnmqr65zvXtt 372 wTPgXqpvDV4APgmCs6OvQZYId20uNXsCWlKW6IWBLrNrftrVYgserzF2H2Vl7f71/Umz5cGNHxE6 373 KoC+ERoO9PNJCe9hGZLovqlugI6eekPKNhsLcOhno0HHR4IwrD8ORm+QfcdjvJCqAHj2UxFAz1OW 374 rXNlm6NGb4ibma1giUyFAKa4bm6O8t8CyCQtJD+0FD+yiweUQVmZyRV8811f+eao/gVIOLAAh5uf 375 L6fSnghF3ovQTZdngvr7X/P50skWnQO4GCIsgKPK2eAsC56fj3/cWUt/tj0lxDsD7bT14v60gLrx 376 7MInz4GJoGw2GA37WuGgqbqAHh7ZYVuUeLN7E/0aLrBhMlJMAUH5ZEAd1BXZhC9reXACN3AEV+en 377 w8Zzjy7HO2atVTHxMrX3PEOXqwuFIlQNRqWDR1lR8LANH/DF/PL1wI3fJnd2IGQkG9b6rZc6afGK 378 fSh8fewYzUefELbcSGMZRU80CHsE/sM9lBHVhU3YtvoDB3BhvYBfG1QiAAs+WYISBbESJEu0TAR1 379 AhiDH6h8dSb5HMBpAZL5AyezB6gYCrNh8P6+dqnXVLxAfgnm04/lfvquzBsD/Id76QoAgBsbE6hI 380 gh2y4//lkaPCIBDkeEleQqCMqC5sSg+LNa7KXoOH99QnJfJ37z5bADMVgaTBM6CstT5sJvMLbspe 381 g5hoyIz/b02dpt/rg7ZuPyEZPICy1scBNm9NJc495gqSMSlyVAD+A8lE4/TrexpsrXex1CsdPAPq 382 WO3Atsw+AZsTKNsYwYRFtCL8z6lOG+krlf91/VENZ7SEd7TcJwTujXIioK7VHnyIVobZRIv/WNJx 383 AYxesMBEwMrN5NBBmh56lxa7W4XJa+oxnx7Ma/m5VOn1JJ0NogzKog7qimzCF3zCNzhws8wFfkao 384 ZDqM2Rb/lbjH40kJT5f5zESl5xUNLMHiXqr2Yr4a52aCriyIrEQAfvWGJdiVCCA6N6D0vAB7FB4v 385 9EqTLVmfS01Bv+3LbmOdQf//EV+utL3qYq/wG2F3BODODNRrCQxCFAVyKeCNJenN9VB5QZ5Jlm1j 386 W+3xO891pT69DuxZg4Z9+IJP016cYzTKj8zoZ3iMniALNkgRXfG+PUiAhURniFw7NMXODcUTA10U 387 gSc632Ozxw5NiQPvFy2CKhMge24wK0BWgKwAaxX/AvBZf/1O5gkeAAAAAElFTkSuQmCC 388 } 389 390 set imgdata(floor) { 391 iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAIAAAAlC+aJAAAAGXRFWHRTb2Z0d2FyZQBBZG9iZSBJ 392 bWFnZVJlYWR5ccllPAAAAyZpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADw/eHBhY2tldCBiZWdp 393 bj0i77u/IiBpZD0iVzVNME1wQ2VoaUh6cmVTek5UY3prYzlkIj8+IDx4OnhtcG1ldGEgeG1sbnM6 394 eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IkFkb2JlIFhNUCBDb3JlIDUuNi1jMTM4IDc5LjE1 395 OTgyNCwgMjAxNi8wOS8xNC0wMTowOTowMSAgICAgICAgIj4gPHJkZjpSREYgeG1sbnM6cmRmPSJo 396 dHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1zeW50YXgtbnMjIj4gPHJkZjpEZXNjcmlw 397 dGlvbiByZGY6YWJvdXQ9IiIgeG1sbnM6eG1wPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAv 398 IiB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wL21tLyIgeG1sbnM6c3RS 399 ZWY9Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC9zVHlwZS9SZXNvdXJjZVJlZiMiIHhtcDpD 400 cmVhdG9yVG9vbD0iQWRvYmUgUGhvdG9zaG9wIENDIDIwMTcgKFdpbmRvd3MpIiB4bXBNTTpJbnN0 401 YW5jZUlEPSJ4bXAuaWlkOjJCRThGOUE2RTI1NTExRTZCNUJFOEM2QkJDQzA1OUQ1IiB4bXBNTTpE 402 b2N1bWVudElEPSJ4bXAuZGlkOjJCRThGOUE3RTI1NTExRTZCNUJFOEM2QkJDQzA1OUQ1Ij4gPHht 403 cE1NOkRlcml2ZWRGcm9tIHN0UmVmOmluc3RhbmNlSUQ9InhtcC5paWQ6MkJFOEY5QTRFMjU1MTFF 404 NkI1QkU4QzZCQkNDMDU5RDUiIHN0UmVmOmRvY3VtZW50SUQ9InhtcC5kaWQ6MkJFOEY5QTVFMjU1 405 MTFFNkI1QkU4QzZCQkNDMDU5RDUiLz4gPC9yZGY6RGVzY3JpcHRpb24+IDwvcmRmOlJERj4gPC94 406 OnhtcG1ldGE+IDw/eHBhY2tldCBlbmQ9InIiPz4wOW0fAAAE4UlEQVRo3rVa2XbbQAjlp2MnttOm 407 y2NtWfKapenpnxZ5YoJnYYBRz6F9yLEkLgOXbeDu1ybI6nD6+f43lW8vv+/WXfjNfLN9PJynkoft 408 jr6+6PfKp5a7Iz2FAvhvttmillntg3x/fScMq/1pKgCz6zsRienBxbBnANadrP3nObg+VjTkcAgv 409 RBgOo8w3/QcAjfZB0McmPAT0xvC2+25wPE6HAErtg9xvh0kiAT2efMB3pOEA0fo2AGMwfJitb3ce 410 ciHHS1CBxXBAlWwAUIgEHvpdu/a+VwUdnp7fPAAoEkzcF2mPxsPPfzk9B59EQZ2UL1ntjoG+8PGm 411 E7CGIIVd+DAJIkEmVHIR/obIF8F7AMyu7MEw9Pqo/Xp+LeWZEYN4Dqg9sSe9DfBhvfaLnAdfeKkX 412 7EcZN7J9fA6XgC750kX72HYIG+Zd36i9nI/wfORShQThleKBe04kEEJKfvWPtz9IFIL2nE8IBid7 413 dDyTjTg9LK9Ri//j35EJgmD4fQAIoAXtU7+3ivKcOcWhuugzcr2ExoKIldLwIu1HBx0OAp3LEmjb 414 yhDVRAHcwx6PZ7T3jVMSZyV0yT1E6V0mglZmG4gZat0hv1J+kQ3AC3qNCMHGnef2kUquhGqkyzky 415 ImYfBjx5h+1jAFkM1US7Kpx7iBk8oiCcwiMMLdrHAFIMFLVyYZjJCcm5ERsGn8QkilJiZ32VBXK9 416 UXXBqMELlUUpK3MMkptZakSQHUNTrHMA1W8LOdXXoEG19JXfuGRQNf5WrGq8Uw/QtK0lIiLbVwtJ 417 JQalCbQAKFVlCzVKAlbtS77k6y1B2f5xLfHvc1ZfuIcUEQX7ZgWgp5fwDW62Fu2zNpoYQErwpiSt 418 HTCyVOBwRVCOINtHCRq2wMJkGgBVtvYdt8ZY1kkH+Eo03zxQWRSaPBMcrj/hiLdUmesxQKL9oKmK 419 p3WhbGuhDGhwN1mTUFClpFVwNFRtHzXXjXnH1FQIY6IYQMnveTmN74oOeiomnYtTDxkDpPM6mdHQ 420 Wvx7jvLLwRlCWwIlvpd5hvytsZpIjxTbtKfnN5SxzWe65a25P4G7LqcSAH/swxD1k9gr86EODa5v 421 QuJ64PjFAB70U06h3nYsbCLGK01c+JK3OBtt6SrIiiYMqe0rC9IyBmivEYgDNGUMnm0UtdXRsowh 422 BuDwZv3KcZVMJTTayxigvUTLjFVyzJ2m+eq0tLRsLwLwlWhZIufMjapnyHrdmZZDpQEwWLdd+tGi 423 e9CrWVQXY8Baos29u4/qxqkkChpVY1DunfIt0WVJapWwC6wAUGJYep3HtLPJXtaoA6iOddu1d8Qx 424 /+hssx3BrDsQlqel7W+15TdhiOofzQrn8Ximv4OwYsi2FLL2mEloDaqMELRlFQPXMFpGQrRkLqjV 425 hwVtOqurZnENTc27XsDAdUtXqZD9nVXkAlbTspTu7XG/zy6CQbMqrNhPvChh2Gcmt/d4fJbyBsgs 426 W6dzdfJWjjzGywqH02j420grcW4TAGvpYd2NmwGYXMh3bc6Noe5CpiBu6eU1MZ0VKYitFNS416hy 427 6811m+FAmSdPo9a6oH0WhPhNe2KuIU/DI4CF8eLMVIP1Uk4sWYe3o7yXgLTKxWOi0VJ6gWc13Uw3 428 LUmWtUt/n49cbtWMxVzEwVFK5/fW/+v1e+W1htT3/gHO9EIyge+NWAAAAABJRU5ErkJggg== 429 } 430 431 set imgdata(goal) { 432 iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAIAAAAlC+aJAAAAGXRFWHRTb2Z0d2FyZQBBZG9iZSBJ 433 bWFnZVJlYWR5ccllPAAAAyZpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADw/eHBhY2tldCBiZWdp 434 bj0i77u/IiBpZD0iVzVNME1wQ2VoaUh6cmVTek5UY3prYzlkIj8+IDx4OnhtcG1ldGEgeG1sbnM6 435 eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IkFkb2JlIFhNUCBDb3JlIDUuNi1jMTM4IDc5LjE1 436 OTgyNCwgMjAxNi8wOS8xNC0wMTowOTowMSAgICAgICAgIj4gPHJkZjpSREYgeG1sbnM6cmRmPSJo 437 dHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1zeW50YXgtbnMjIj4gPHJkZjpEZXNjcmlw 438 dGlvbiByZGY6YWJvdXQ9IiIgeG1sbnM6eG1wPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAv 439 IiB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wL21tLyIgeG1sbnM6c3RS 440 ZWY9Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC9zVHlwZS9SZXNvdXJjZVJlZiMiIHhtcDpD 441 cmVhdG9yVG9vbD0iQWRvYmUgUGhvdG9zaG9wIENDIDIwMTcgKFdpbmRvd3MpIiB4bXBNTTpJbnN0 442 YW5jZUlEPSJ4bXAuaWlkOjJCRkVFQTNFRTI1NTExRTZCNUJFOEM2QkJDQzA1OUQ1IiB4bXBNTTpE 443 b2N1bWVudElEPSJ4bXAuZGlkOjJCRkVFQTNGRTI1NTExRTZCNUJFOEM2QkJDQzA1OUQ1Ij4gPHht 444 cE1NOkRlcml2ZWRGcm9tIHN0UmVmOmluc3RhbmNlSUQ9InhtcC5paWQ6MkJGRUVBM0NFMjU1MTFF 445 NkI1QkU4QzZCQkNDMDU5RDUiIHN0UmVmOmRvY3VtZW50SUQ9InhtcC5kaWQ6MkJGRUVBM0RFMjU1 446 MTFFNkI1QkU4QzZCQkNDMDU5RDUiLz4gPC9yZGY6RGVzY3JpcHRpb24+IDwvcmRmOlJERj4gPC94 447 OnhtcG1ldGE+IDw/eHBhY2tldCBlbmQ9InIiPz6L30xAAAAFYUlEQVRo3s1a224jNwzVtxbFAkWL 448 olsgmcRxNnHcXBatPbbja2zHm2Tb7+yZ0ObKunA4mrF3ASYvHkk8FEUeUjIn//RJ2pPZX88vvnSe 449 1ie9nL7J+oPLybwpOR888uqt4Vg56uJxyqMgBn+n/QG0DGpPcrN8Zgzt8awpAKe7OYGk0sDWaGwB 450 6OWy9t/2IWmxqCFHE5oQMBKMkvWHWwAa7UngYw1uAryRZjvLRwnDeRNMTN27L2/3r19JPn/9Tyma 451 tfWz3X15hdxuCh/+NF34GwjrBwDcvbzp1zgoAEe6qw1PcpYPW6MJtDUx7a/mT3/cPfx6fQP56SRT 452 isb19bPR6lADymwxrDcciK4XKxfA7eaVvsMY/TJ6ALTvaTNDpa1lZ08Uvj7NFi6A+5fC3XE+0taQ 453 AfCxS54cM0C9znIbD88GIxfAw9u/+OKXy6vGASBP0apX82Xy5FCsONkvb5wEMJvBAWcAtEf2GHwE 454 h+MPWrvg7QiishBbOePSpgcFDk05AcvZme7j/WdbH9Lw29K93GT5UABgrxHTXs5HCBcyVWEBPPrS 455 xgCRABCVoHgkAED8Oh8+Ctqz4DOGwW5DbEWTK9lGNjXyASAYQJABtwDYT4IAoP3pLmsmi73PmmRP 456 W4psjf8+AMYGY5n245Sjkg8AJ4S1Lxx0NHGYjF4obMsStJQAAGIIB2EIHOIdYfQZi+0hSu+StXd4 457 cgUAhAGRJBiFaO1SQq8RPmyy8+wPGasAEIZYGNXQ2joYLqfz8MfvR1kLgGmWPaCU67Yj+05nBltE 458 klnO7WCQta8LgE+tIBzp93KCt28Xu2hBPokkColFZzmMVgAAF6xU4L0f92hWtjFIbrZfH9cCgPUq 459 ASitzTnixcR32loASks+jn12lijFkEUyY7DrUReAEIjY9kGnT8AQNEEDAIJEjZNAVe1jvhRz1wYA 460 OFrCTpnFL5KbFE4IjnXNKgCQwwutYZutjvY+p9IEDF9MpQDvumx1zwnwESsVJLiiUbYgg+SsqR4j 461 OySISTMASqN12nZrjKXv8koASilaWj9QSQoreaZJcP0GW7wxZq7HYDztRxpW3KwLBUsL5YE2yUVW 462 IyGohNIqYrQptT0X1xre0khGs5cuNZOR/d6m05jL2eimImkmdj1kDIaqYQ0vZ2vZ6ykZaJ106djR 463 BRCL93KcYX+rySb8LUWZdr1YQYoy39ItbM3xzNjjfTKnoQDYkDQMTj2JWrm72rgN00hjCysS+HQA 464 dtSCG1S+5NqPeLGOS+dpXd4bTQZgW7ESBt/2QsPrsABsFqChMdh659TK2h8DgO0M8tFve12JUu2P 465 AsBvq4Qit5/mS7ulRwIQDOR25IbqgWDdy+3Loe8GoF1W9yQ0eo8KIEu9+yi9cToGAOW9U7gker8k 466 /Z4ALlKdp9KdzaEA1Ndef46DAE77A+xhcc1qX576AIIkp7Tkr4TB4T8aAJfTOf9q7CuGYHfaoeOy 467 9mCpdAcKUZ4Q2FLG4AOwfzX2JXOstVi8bRmOoZPfq9sLLKHt0oSpLB8KGFQACAP9/HN2zgN+63SV 468 Nb7AqDUlS+zd3p8Pf7MyUEwCULxWeX+c9Xv3tvHHHnbhkjw5FIN6UDIKgF47IcUc5LnNsO5zGyhG 469 r1WiAG5Wm4M+eCIMNR88OT5mnNvm68WSvsPB+tBqNwuAMFSdE2pAme0zwH3zu4eYtrizXP+Yj/5u 470 N4EYZRztmQzfrJ5/HADd9YYiuP9kygivLKKdptq9IMRc/T2xw1zsNFwAaFV8ONNUYz2WE2PWsctR 471 u5YwPsvFNnFryX/A026up+tTErmLuMdievmWzDlFqpPS7XfrB31+L/cPBd/7HwDmw8MEUb41AAAA 472 AElFTkSuQmCC 473 } 474 475 # load the tiles 476 477 # load the player tile separately 478 image create photo tile_player -data $imgdata(player) 479 # floor is coded as 0 480 image create photo tile_0 -data $imgdata(floor) 481 # goal is coded as 1 482 image create photo tile_1 -data $imgdata(goal) 483 # player on the floor is coded as 2 484 image create photo tile_2 485 tile_2 copy tile_0 486 tile_2 copy tile_player 487 # player on the goal is coded as 3 488 image create photo tile_3 489 tile_3 copy tile_1 490 tile_3 copy tile_player 491 # box is coded as 4 492 image create photo tile_box -data $imgdata(box) 493 image create photo tile_4 494 tile_4 copy tile_0 495 tile_4 copy tile_box 496 # box on goal is coded as 5 497 image create photo tile_goalbox -data $imgdata(boxongoal) 498 image create photo tile_5 499 tile_5 copy tile_1 500 tile_5 copy tile_goalbox 501 # wall is coded as 8 502 image create photo tile_8 -data $imgdata(wall) 503 504 # create the UI and canvas 505 506 canvas .c 507 grid .c -column 0 -row 0 508 grid rowconfigure . 0 -weight 1 509 grid columnconfigure . 0 -weight 1 510 511 wm title . "BOXcl" 512 513 # define the help message 514 515 set helpmsg {Welcome to BOXcl! 516 517 Controls: 518 519 Move: WASD or arrow keys 520 Undo: u 521 Restart: r 522 Open a levelset: Ctrl+O 523 Next level in the set: Ctrl+N 524 Previous level in the set: Ctrl+P 525 Quit: Ctrl+Q 526 This help: h or F1 527 528 You can also pass the levelset as the command line parameter to the boxcl.tcl script. 529 530 Created by Luxferre in 2024 531 Released into public domain 532 } 533 534 # entry point 535 536 set levelsetfile "" 537 if {$argc > 0} { # get the level set file name 538 set levelsetfile [lindex $argv 0] 539 } else { # open the file dialog 540 set levelsetfile [openlevel] 541 } 542 set sublevel 0 543 if {$argc > 1} { # get the optional level number 544 set sublevel [expr {int([lindex $argv 1]) - 1}] 545 if {$sublevel < 0} { 546 puts "Invalid level number!" 547 exit 1 548 } 549 } 550 if {$levelsetfile eq ""} { 551 tk_messageBox -type ok -title "Missing levelset" -icon error -message "Please open a levelset file to start the game!" 552 exit 1 553 } 554 555 set levels [loadlevels $levelsetfile] 556 set levelcount [llength $levels] 557 startlevel [lindex $levels $sublevel] 558 559 # bind keys to move logic 560 561 bind . <Key> { 562 switch "%K" { 563 r {startlevel [lindex $levels $sublevel]} 564 u - 565 BackSpace {renderundo} 566 w - 567 Up {rendermove 0} 568 a - 569 Left {rendermove 1} 570 s - 571 Down {rendermove 2} 572 d - 573 Right {rendermove 3} 574 h - 575 F1 { 576 tk_messageBox -type ok -icon question -title "BOXcl help" -message $helpmsg 577 } 578 } 579 } 580 581 582 bind . <Control-n> {nextlevel 0} 583 bind . <Control-p> {prevlevel} 584 bind . <Control-o> { 585 set levelsetfile [openlevel] 586 if {$levelsetfile ne ""} { 587 set sublevel 0 588 set levels [loadlevels $levelsetfile] 589 set levelcount [llength $levels] 590 startlevel [lindex $levels $sublevel] 591 } 592 } 593 bind . <Control-q> {exit}