594 lines
24 KiB
Tcl
Executable File
594 lines
24 KiB
Tcl
Executable File
#!/usr/bin/env tclsh
|
|
# BOXcl: a simple and self-contained Sokoban clone that can load any custom levelset
|
|
# Depends upon Tcllib and Tk
|
|
# Compatible with *plaintext* levels downloaded from https://www.sourcecode.se/sokoban/levels.php
|
|
# Press h or F1 to get in-game help
|
|
# Controls: WASD or arrow keys to move, u to undo, r to restart,
|
|
# Ctrl+N / Ctrl+P to switch levels in the set, Ctrl+O to open a new set, Ctrl+Q to quit
|
|
# Created by Luxferre in 2024, released into public domain
|
|
|
|
package require textutil
|
|
package require Tk
|
|
|
|
set scriptpath [ file normalize [ info script ] ]
|
|
set appdir [ file dirname $scriptpath ]
|
|
# check if we're running from a starpack
|
|
if [string match *app-boxcl $appdir] {
|
|
set appdir [ file normalize [ file join $appdir ".." ".." ".." ] ]
|
|
}
|
|
set leveldir [ file join $appdir "levelsets" ]
|
|
|
|
# hardcoded tile sizes
|
|
set tilew 64
|
|
set tileh 64
|
|
|
|
# check if the line contains only valid Sokoban format characters
|
|
proc islevelline {line} {
|
|
return [regexp {^[ #pPbB._*$+@-]+$} $line]
|
|
}
|
|
|
|
# convert a level data line into the internal format
|
|
proc levelconvert {datalist} {
|
|
set convdata ""
|
|
foreach dataline $datalist {
|
|
set outlist ""
|
|
foreach chr [split $dataline ""] {
|
|
switch $chr {
|
|
{#} {lappend outlist 8}
|
|
p -
|
|
@ {lappend outlist 2}
|
|
P -
|
|
+ {lappend outlist 3}
|
|
b -
|
|
$ {lappend outlist 4}
|
|
B -
|
|
* {lappend outlist 5}
|
|
. {lappend outlist 1}
|
|
" " -
|
|
"-" -
|
|
_ {lappend outlist 0}
|
|
default {}
|
|
}
|
|
}
|
|
lappend convdata $outlist
|
|
}
|
|
return $convdata
|
|
}
|
|
|
|
# load and parse a levelset file
|
|
proc loadlevels {fname} {
|
|
set fp [open $fname r]
|
|
fconfigure $fp -encoding utf-8 -translation auto
|
|
set fdata [read $fp]
|
|
close $fp
|
|
set levelblocks [::textutil::splitx $fdata {\n\n}]
|
|
set levelsettitle ""
|
|
set levelsetauthor ""
|
|
set outlevels ""
|
|
foreach lblock $levelblocks {
|
|
set leveldata ""
|
|
set leveltitle ""
|
|
foreach line [split $lblock "\n"] {
|
|
set line [string trimright $line]
|
|
if {[islevelline $line]} { # the line contains valid level characters
|
|
lappend leveldata $line
|
|
} else {
|
|
if {[regexp {^Title:(.*)$} $line _ title]} {
|
|
set leveltitle [string trim $title]
|
|
} elseif {[regexp {^Author:(.*)$} $line _ author]} {
|
|
set levelsettitle $leveltitle
|
|
set leveltitle ""
|
|
set levelsetauthor [string trim $author]
|
|
}
|
|
}
|
|
}
|
|
if {$leveldata ne ""} {
|
|
set lobj ""
|
|
dict set lobj settitle $levelsettitle
|
|
dict set lobj author $levelsetauthor
|
|
dict set lobj title $leveltitle
|
|
dict set lobj data [levelconvert $leveldata]
|
|
lappend outlevels $lobj
|
|
}
|
|
}
|
|
return $outlevels
|
|
}
|
|
|
|
# render the level state
|
|
proc renderfield {leveldata} {
|
|
global tilew tileh fieldw
|
|
global tile_0 tile_1 tile_2 tile_3 tile_4 tile_5 tile_8
|
|
.c delete anytile
|
|
set rownum 0
|
|
foreach line $leveldata {
|
|
set tiley [expr {$rownum * $tileh}]
|
|
for {set colnum 0} {$colnum < $fieldw} {incr colnum} {
|
|
set colval [lindex $line $colnum]
|
|
if {$colval eq ""} {set colval 0}
|
|
set curtile "tile_$colval"
|
|
set tilex [expr {$colnum * $tilew}]
|
|
.c create image $tilex $tiley -image $curtile -anchor nw -tag anytile
|
|
}
|
|
incr rownum
|
|
}
|
|
}
|
|
|
|
# move logic
|
|
# dir: 0 up, 1 left, 2 down, 3 right
|
|
# return 1 if won
|
|
proc domove {dir} {
|
|
global leveldata fieldw fieldh pushcount
|
|
# detect horizontal and vertical direction factors
|
|
if {$dir % 2} {
|
|
set hd [expr {$dir - 2}]
|
|
set vd 0
|
|
} else {
|
|
set vd [expr {$dir - 1}]
|
|
set hd 0
|
|
}
|
|
# find the player position into cx and cy
|
|
for {set cy 0; set outbreak 0} {($outbreak < 1) && ($cy < $fieldh)} {incr cy} {
|
|
for {set cx 0} {($outbreak < 1) && ($cx < $fieldw)} {incr cx} {
|
|
if {[lindex $leveldata $cy $cx] & 2} { # found it
|
|
set outbreak 1
|
|
incr cx -1
|
|
incr cy -1
|
|
}
|
|
}
|
|
}
|
|
# calculate the new target player position
|
|
set tx [expr {$cx + $hd}]
|
|
set ty [expr {$cy + $vd}]
|
|
# start by checking if it is within the field boundaries
|
|
if {($tx >= 0) && ($tx < $fieldw) && ($ty >= 0) && ($ty < $fieldh)} {
|
|
# get the target object value
|
|
set tov [lindex $leveldata $ty $tx]
|
|
if {$tov < 6} { # we're not pushing a wall
|
|
if {$tov & 4} { # we've hit a box
|
|
# get next-to-target positions
|
|
set ntx [expr {$tx + $hd}]
|
|
set nty [expr {$ty + $vd}]
|
|
# calculate the condition under which we can push
|
|
if {($ntx >= 0) && ($ntx < $fieldw) && ($nty >= 0) && ($nty < $fieldh)} {
|
|
set ntov [lindex $leveldata $nty $ntx]
|
|
if {$ntov < 4} { # now we can push
|
|
# remove the box from the target field
|
|
lset leveldata $ty $tx [expr {$tov & 11}]
|
|
# push the box further
|
|
lset leveldata $nty $ntx [expr {$ntov | 4}]
|
|
# increment the push counter
|
|
incr pushcount
|
|
} else {return 0}
|
|
} else { # otherwise don't perform the move
|
|
return 0
|
|
}
|
|
}
|
|
# now, remove player from the current field
|
|
lset leveldata $cy $cx [expr {[lindex $leveldata $cy $cx] & 13}]
|
|
# add player to the target field
|
|
lset leveldata $ty $tx [expr {[lindex $leveldata $ty $tx] | 2}]
|
|
# check for victory by counting boxes not on goals
|
|
set bcount 0
|
|
for {set cy 0} {$cy < $fieldh} {incr cy} {
|
|
for {set cx 0} {$cx < $fieldw} {incr cx} {
|
|
if {int([lindex $leveldata $cy $cx]) == 4} { # non-goal box
|
|
incr bcount
|
|
}
|
|
}
|
|
}
|
|
if {$bcount > 0} {return 0} else {return 1}
|
|
}
|
|
}
|
|
return 0
|
|
}
|
|
|
|
# perform a move and render it
|
|
proc rendermove {dir} {
|
|
global leveldata pushcount undobuffer
|
|
lappend undobuffer $leveldata
|
|
set res [domove $dir]
|
|
# remove the last undobuffer entry if the field is the same
|
|
if {[lindex $undobuffer end] eq $leveldata} {
|
|
set undobuffer [lreplace $undobuffer end end]
|
|
}
|
|
renderfield $leveldata
|
|
# check for victory flag
|
|
if {$res eq 1} {
|
|
tk_messageBox -title {Victory!} -type ok -message "Level complete!\nPushes: $pushcount"
|
|
nextlevel 1
|
|
}
|
|
}
|
|
|
|
# undo the last move and render the result
|
|
# Tcl 8.6 compatible (no lpop)
|
|
proc renderundo {} {
|
|
global leveldata undobuffer
|
|
if {[llength $undobuffer] > 0} {
|
|
set leveldata [lindex $undobuffer end]
|
|
set undobuffer [lreplace $undobuffer end end]
|
|
renderfield $leveldata
|
|
}
|
|
}
|
|
|
|
# start a loaded level
|
|
proc startlevel {level} {
|
|
global tilew tileh fieldw fieldh leveldata pushcount
|
|
global undobuffer
|
|
set undobuffer ""
|
|
set leveltitle [dict get $level title]
|
|
set leveldata [dict get $level data]
|
|
set settitle [dict get $level settitle]
|
|
set pushcount 0
|
|
# determine field width and field height (in tiles)
|
|
set fieldh [llength $leveldata]
|
|
set fieldw 0
|
|
foreach l $leveldata {
|
|
set lw [llength $l]
|
|
if {$lw > $fieldw} {set fieldw $lw}
|
|
}
|
|
# align level data
|
|
set idx 0
|
|
foreach l $leveldata {
|
|
set lw [llength $l]
|
|
if {$lw < $fieldw} {
|
|
set diff [expr {$fieldw - $lw}]
|
|
for {set i 0} {$i < $diff} {incr i} {
|
|
lset leveldata $idx end+1 0
|
|
}
|
|
}
|
|
incr idx
|
|
}
|
|
|
|
.c configure -width [expr {$fieldw * $tilew}] -height [expr {$fieldh * $tileh}]
|
|
wm title . "BOXcl - $settitle - $leveltitle"
|
|
renderfield $leveldata
|
|
}
|
|
|
|
# move to the next level in the set
|
|
proc nextlevel {natural} {
|
|
global sublevel levels levelcount
|
|
incr sublevel
|
|
if {$sublevel == $levelcount} {
|
|
if {$natural eq 1} {
|
|
tk_messageBox -title {All clear!} -type ok -message "Congratulations!\nYou have beaten the last level in the set!"
|
|
exit 0
|
|
} else {
|
|
set sublevel 0
|
|
startlevel [lindex $levels $sublevel]
|
|
}
|
|
} else {
|
|
startlevel [lindex $levels $sublevel]
|
|
}
|
|
}
|
|
|
|
# move to the previous level in the set
|
|
proc prevlevel {} {
|
|
global sublevel levels levelcount
|
|
incr sublevel -1
|
|
if {$sublevel == -1} {
|
|
set sublevel [expr {$levelcount - 1}]
|
|
}
|
|
startlevel [lindex $levels $sublevel]
|
|
}
|
|
|
|
# open a levelsetfile
|
|
proc openlevel {} {
|
|
global leveldir
|
|
set types {
|
|
{{Plain text levelset} {.txt} TEXT}
|
|
{{Sokoban YASC levelset} {.sok} TEXT}
|
|
}
|
|
return [tk_getOpenFile -initialdir $leveldir -filetypes $types -title {Choose a Sokoban levelset file}]
|
|
}
|
|
|
|
# define the tiles
|
|
|
|
set imgdata(wall) {
|
|
iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAAAAACPAi4CAAADQ0lEQVRYw8VX23bqIBDtD9mLra1a
|
|
q9Vj6wq5nIRkBcKa//+OQ4AQGIjV+nDmpXZDdsjMZjPc3d8YdzcTzB4eTbzIeFvJeHtxQiELF1n0
|
|
U+b6mfvZ3Wy+lLH9k6ggDICTxIlUADQukBAOAH+Pu5V87sEQHMZRgNSbnpQAxEcKgE7++X63BHtn
|
|
VLAEBYSIXtNpZQjW7iC7iICqv3tD4C4g6To0O4UQgVb9+DYEX85gDpD70ylA4SM1gNCJWmsCl1xm
|
|
mHtZzGUVRIkYh0mbnuD1I7dRgwoaIIza4BoRtfy9f+wJPuGKEGzgapmA05MkeF5TKtRYlZvFk7xo
|
|
9VvybPgSvZbO/by0VQR9DkjPUARyK3DuUILTr4EgyYbSjgwCKVhWOFDEpyVIWqxX+cIiQNBLku1I
|
|
QAHLjWJBSOQsAdpDSRNZQYuQ3UjAIzlA00mHdyo5WgK5Z6HyBjlGSNMLMIuXUevNWUOmdAAN8UTe
|
|
S6OxkmyMkBZbxpkKPgrOIN05RIpSfcLifVxlqcZrp6KkjSOisJvJ241SLCh3JIqY9EQIypgnhojx
|
|
mAjBhZ5IpwnYjQQELvLEJjmTg9ATQ0SQCYK0i3liiBiJaU/cXOCJIcJL+Xt7vSf6YaQ8/EuxJ0Iz
|
|
emLBFFLnQ0KyvBZ2M1G0l4xL+ju8Z6j9U9YSSPfADljYVDuHFkKSw2goXeCJHL0uhjiWVgeeeLWp
|
|
/saVHU9soAxOgfBc4AjZWwKZdJEhUwbwkSrwzdxWQRueI3lSqaqXiNGvVTkcrnklzCFuo/Od0EE6
|
|
i3CjxNfdYLP1MEs0hdZ9SesphNPK7IWXJeo+/H6kiiLGZCJ+wACXo4khk34g9XqjIyXdrabKbyRI
|
|
Y51xiLSTBDTodVgMMaJTBM9L1Ei5Z7Lq/2OIrqw21d3YRDJ77g4BU4iS5NH3RKtT7p3h3mOj4MVg
|
|
qn0OSjXX3UwUkAIN4npEwT1PRP4RbzR9TWam0Twqs6iClupnQzGOdJjwxB/7xNNaE2x+22geDEH/
|
|
DU2k0SwDpEELeDcEq5O8HYaNJgsQ/2DZLo2tS4beFMugCmVgs84Sjpvlh+rW+6vv03wu77P4futf
|
|
edUdeLwWz9VT8ur732/v/wB3P44Wbg6kBQAAAC10RVh0U29mdHdhcmUAYnkuYmxvb2RkeS5jcnlw
|
|
dG8uaW1hZ2UuUE5HMjRFbmNvZGVyqAZ/7gAAAABJRU5ErkJggg==
|
|
}
|
|
|
|
set imgdata(boxongoal) {
|
|
iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAQAAAAAYLlVAAACy0lEQVRo3sWZvW7bMBDHObWZmqKR
|
|
KAcGmjiI69RorEqWfYEQoFq7d+/SvY+QpXseoY+ixXsfoUMfIQ9wHSgpTnj8kklGt9Ew/z+Rx9Px
|
|
jrHh4Xlyl7RJm7Qcw1jSJu3Jr3c/Xl+y5w/Pw8kqUKo9+en3pz9Pg9npI8LD8bfh7cVQhue4wGVw
|
|
u8BJh8BzxhhjWcuR4yleRRAXdtWtRNIO759FlBcImdiKnKX3HDnOosovcYnnYg3umfB++f1LrLHA
|
|
mrAKgRgttCOlNP+i3wSx/xQjYIUNYTd4S4xWmhEg5xeuyMSxo5dp5QUAFLNPzQBLhIMBQDk3CVBa
|
|
ILgAALGqWoCa+AuMBpDn2mJtAmiMCLYAhTTPJ2xsAEwIdgBAHOzKFkCPYANAyTcuADoEMwAt7wig
|
|
RjABqOSdASg3AiOAbvOcASoyLugA9O47AqAhED4rAUwHeBQAhbAlAcwhbCRAYxWgV2TY8QRgRlCF
|
|
HW8ADW41COqw4xFA7WK6sOMVoCG/bvqw4xngOcKcSGbBkCEcCLCPoJcPBtBgZSUfEOAGcwv5oAC3
|
|
Vhl0QIC1JD/HWbwVqCT5y25DoviAfO5ne/4Q/BTo5YPHASoY58rTEO1boPpSegbQpRv0l9IrADjn
|
|
A+ATACwyomvL0DQCACxzwjJMTijLXyuz4tJ/VkylG7p7Qen3XlCQ2Y7+ZlT6uxmpki33uyGMAVDn
|
|
emNux+AKIE+xPrA+AC4AYSokYAsQrka0sgHwWSWjTkQdt05YEq4cuVJaulVKQ9SKN2MBQlfLe4C/
|
|
HLli8X0B0AhduV40LD5Ii7/BDea4IazANTGaG0ZWZMMi3bHkjiPH9y/Xsjk6E02rRVT5vmn16iNj
|
|
3Sa8RNsu3T1pXE7wIgrEvO8aPgw95JOhdZsFbNsKmwzN26F1yxhjb78kf6I2r/+9+Sp10I/O0t8i
|
|
KoS1dJf+ZMe96n+qpZFsvgDj+QAAAC10RVh0U29mdHdhcmUAYnkuYmxvb2RkeS5jcnlwdG8uaW1h
|
|
Z2UuUE5HMjRFbmNvZGVyqAZ/7gAAAABJRU5ErkJggg==
|
|
}
|
|
|
|
set imgdata(box) {
|
|
iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAQAAAAAYLlVAAACvklEQVRo3sWZW07jMBSGs4PRPFaC
|
|
OFGFeBlRiqhGFaqAKpoEGoGRIp4isYRZQpfAEmYpWcIsgSWwhH8enKYdfHwLtonfXNX/F9vn5FyS
|
|
ZHjyWbplHetYlyHMYB3r0m36MmHJxyefhZOlUfLZgXz68v/Pp8HGyR7h/fhxeHsxleMMS6yCjwtM
|
|
e4R+F8Tmn+AqgrgYV/1OsG54/zyivEDIxa7PkvQ1Q4bzqPIrrHCGDBnS1/4A5Pev0KBEQ4wanJgt
|
|
tTOVtP5ydwji/ClGjg1aYjzhmZjdaGY4ub64iokwO3qbCi8AXLH6qRlgBf5pAK5cmwSoLBBcAGT5
|
|
tR6gIf7CRwPIaz2gMQG0RgRbAHk3b9DaAJgQ7AA4YdgbWwA9gg0AJd+6AOgQzAC0vCOAGsEEoJJ3
|
|
BmhRkgh6AN3hOQNsSL+gA9Bf3xEAlDH9UgKYDHgUAIXwSAKYXdhIgNbKQRek2/EEYEZQuR1vAC0e
|
|
NAhqt+MRQH3FdG7HK0BLft30bsczwEeEBeYGt+Md4BBBLx8MoEVtJR8Q4AmFhXxQgGcixFxbRole
|
|
AO4l+QXm8XagluQv+wOJcgdku58f3IfgVqCXD+4HKGdcKK0h2rdA9aX0DKALN+gvpVcA7hwPcJ8A
|
|
3CIiurVI7kcCcMuYsAoTE8ryt8qouPIfFVPhhi4vqPzmBRUZ7egzo8pfZqQKttxzQz4GQB3rjcmO
|
|
uSuAvMT9J+sD3AUgTIWE2wL4qhGVpGtqYlbJKIto4tYJKUOOXCmt3CqlIWrF9ViA0NXyHoC9ZcgU
|
|
m+8LgEboy/WiYfFTSjNq1ChQE6PEHTFbGGbWqoZFus2Q4cfXtWwmTDStllHld02rCfv6tt2+cTnF
|
|
RRSIxU7+fegh71u3ecC2rRjToXk7tG6TJEmOrtnfqM3rt6NrqYM+Yekf4RVCd87T39+/7VT/AZaV
|
|
3OsTnXjsAAAALXRFWHRTb2Z0d2FyZQBieS5ibG9vZGR5LmNyeXB0by5pbWFnZS5QTkcyNEVuY29k
|
|
ZXKoBn/uAAAAAElFTkSuQmCC
|
|
}
|
|
|
|
set imgdata(player) {
|
|
iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAYAAACqaXHeAAAAGXRFWHRTb2Z0d2FyZQBBZG9iZSBJ
|
|
bWFnZVJlYWR5ccllPAAAAyZpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADw/eHBhY2tldCBiZWdp
|
|
bj0i77u/IiBpZD0iVzVNME1wQ2VoaUh6cmVTek5UY3prYzlkIj8+IDx4OnhtcG1ldGEgeG1sbnM6
|
|
eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IkFkb2JlIFhNUCBDb3JlIDUuNi1jMTM4IDc5LjE1
|
|
OTgyNCwgMjAxNi8wOS8xNC0wMTowOTowMSAgICAgICAgIj4gPHJkZjpSREYgeG1sbnM6cmRmPSJo
|
|
dHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1zeW50YXgtbnMjIj4gPHJkZjpEZXNjcmlw
|
|
dGlvbiByZGY6YWJvdXQ9IiIgeG1sbnM6eG1wPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAv
|
|
IiB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wL21tLyIgeG1sbnM6c3RS
|
|
ZWY9Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC9zVHlwZS9SZXNvdXJjZVJlZiMiIHhtcDpD
|
|
cmVhdG9yVG9vbD0iQWRvYmUgUGhvdG9zaG9wIENDIDIwMTcgKFdpbmRvd3MpIiB4bXBNTTpJbnN0
|
|
YW5jZUlEPSJ4bXAuaWlkOjJCQzQyNTY5RTI1NTExRTZCNUJFOEM2QkJDQzA1OUQ1IiB4bXBNTTpE
|
|
b2N1bWVudElEPSJ4bXAuZGlkOjJCQzcyN0ZCRTI1NTExRTZCNUJFOEM2QkJDQzA1OUQ1Ij4gPHht
|
|
cE1NOkRlcml2ZWRGcm9tIHN0UmVmOmluc3RhbmNlSUQ9InhtcC5paWQ6MkJDNDI1NjdFMjU1MTFF
|
|
NkI1QkU4QzZCQkNDMDU5RDUiIHN0UmVmOmRvY3VtZW50SUQ9InhtcC5kaWQ6MkJDNDI1NjhFMjU1
|
|
MTFFNkI1QkU4QzZCQkNDMDU5RDUiLz4gPC9yZGY6RGVzY3JpcHRpb24+IDwvcmRmOlJERj4gPC94
|
|
OnhtcG1ldGE+IDw/eHBhY2tldCBlbmQ9InIiPz6SouJPAAAGb0lEQVR42u1ba08cVRjmH/gT/GrV
|
|
eMnCXgoK4SKwu7VooGBdKTbQLWJDEFtrbcVG+SJorY02tqRUrbYlqYSEYiLWfkESDZe2Rog2FNGm
|
|
GtFSjPiBtHmdZzpnPDtzdvfsMmfY4k7yJJudc973eZ9z5p1zmZNDRDn/Z+RkBcgKkBUgK0DSQpJX
|
|
NOx9sHlDoHB72N/B4fxK0BwKHGC2okHfRtiX5aNcgG2lnruaQ/4t20P+Xp1sOEBuQBdH8wnf4LAq
|
|
AqA1NBKzPLGGukeprqmEKl7dYKLgYA35D9emDd5WdUsZReqLYsXQOICLqwJAeT7o8O6gHuhDJyJ0
|
|
z8BWpbi/b4spDHybYmicXBGgJbj+buYUgYOQ6qATiQEhGB9wUy6A/uxpzqraKlYtcCvAxXgcetUL
|
|
YCQ7N7q7LMCFJUflAmiOFhqfzM+Y4BnYY+CGALqjdEjmnW2h3RM9NHxtnL6Zn44B/sO9NSsAgru6
|
|
NE/Jrqkbc1R1vmNtCYCAFpeXSPaCUKmKkLECFH+xM6Xg+Z6AR+aOF+CzuRFK90LdO16AdFqfXaib
|
|
8QKsG2qkdZ83xeC+r5qV4N7haKwvzfeqCfDAWFtGIStAVgCXBcj78rmMCR5c3BMgFJiEo00vBjNG
|
|
AHC5vSYQmHRjNtghWqb6Y/wjop8GXMOHr2+zL5eFAgf4JTLHBWBrAVb0de9wNXgAggvXC0P+WSUC
|
|
sOC7Wmto8INdNHx8r+6wM7qRlqZOx5D7eeQIvd1WqwO/0w2St/PD8CHb/cH3d+ocwAWcwI1fGHFM
|
|
ALYGuO/ZSrpw9i2aPndIxyv1FcIAQZi1CH6nK4CMHTQA4wNu4MjWCB0U4Hbig9LMGWBteQZrt0xX
|
|
ABk74MBzYj0TnJ0TwCDAOwJWQtwpAQArL7P8agmAbsnq4LeozG9jx2nu6yM6rn17jG7O9KdlB/WU
|
|
C8A2QKyPwPLlM3GT1ws1RTpEOeLGpU9spCFIPDvwLUqC+iMwLX4EwNk5AYx3vzUJwnmqr65zvXtt
|
|
wTPgXqpvDV4APgmCs6OvQZYId20uNXsCWlKW6IWBLrNrftrVYgserzF2H2Vl7f71/Umz5cGNHxE6
|
|
KoC+ERoO9PNJCe9hGZLovqlugI6eekPKNhsLcOhno0HHR4IwrD8ORm+QfcdjvJCqAHj2UxFAz1OW
|
|
rXNlm6NGb4ibma1giUyFAKa4bm6O8t8CyCQtJD+0FD+yiweUQVmZyRV8811f+eao/gVIOLAAh5uf
|
|
L6fSnghF3ovQTZdngvr7X/P50skWnQO4GCIsgKPK2eAsC56fj3/cWUt/tj0lxDsD7bT14v60gLrx
|
|
7MInz4GJoGw2GA37WuGgqbqAHh7ZYVuUeLN7E/0aLrBhMlJMAUH5ZEAd1BXZhC9reXACN3AEV+en
|
|
w8Zzjy7HO2atVTHxMrX3PEOXqwuFIlQNRqWDR1lR8LANH/DF/PL1wI3fJnd2IGQkG9b6rZc6afGK
|
|
fSh8fewYzUefELbcSGMZRU80CHsE/sM9lBHVhU3YtvoDB3BhvYBfG1QiAAs+WYISBbESJEu0TAR1
|
|
AhiDH6h8dSb5HMBpAZL5AyezB6gYCrNh8P6+dqnXVLxAfgnm04/lfvquzBsD/Id76QoAgBsbE6hI
|
|
gh2y4//lkaPCIBDkeEleQqCMqC5sSg+LNa7KXoOH99QnJfJ37z5bADMVgaTBM6CstT5sJvMLbspe
|
|
g5hoyIz/b02dpt/rg7ZuPyEZPICy1scBNm9NJc495gqSMSlyVAD+A8lE4/TrexpsrXex1CsdPAPq
|
|
WO3Atsw+AZsTKNsYwYRFtCL8z6lOG+krlf91/VENZ7SEd7TcJwTujXIioK7VHnyIVobZRIv/WNJx
|
|
AYxesMBEwMrN5NBBmh56lxa7W4XJa+oxnx7Ma/m5VOn1JJ0NogzKog7qimzCF3zCNzhws8wFfkao
|
|
ZDqM2Rb/lbjH40kJT5f5zESl5xUNLMHiXqr2Yr4a52aCriyIrEQAfvWGJdiVCCA6N6D0vAB7FB4v
|
|
9EqTLVmfS01Bv+3LbmOdQf//EV+utL3qYq/wG2F3BODODNRrCQxCFAVyKeCNJenN9VB5QZ5Jlm1j
|
|
W+3xO891pT69DuxZg4Z9+IJP016cYzTKj8zoZ3iMniALNkgRXfG+PUiAhURniFw7NMXODcUTA10U
|
|
gSc632Ozxw5NiQPvFy2CKhMge24wK0BWgKwAaxX/AvBZf/1O5gkeAAAAAElFTkSuQmCC
|
|
}
|
|
|
|
set imgdata(floor) {
|
|
iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAIAAAAlC+aJAAAAGXRFWHRTb2Z0d2FyZQBBZG9iZSBJ
|
|
bWFnZVJlYWR5ccllPAAAAyZpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADw/eHBhY2tldCBiZWdp
|
|
bj0i77u/IiBpZD0iVzVNME1wQ2VoaUh6cmVTek5UY3prYzlkIj8+IDx4OnhtcG1ldGEgeG1sbnM6
|
|
eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IkFkb2JlIFhNUCBDb3JlIDUuNi1jMTM4IDc5LjE1
|
|
OTgyNCwgMjAxNi8wOS8xNC0wMTowOTowMSAgICAgICAgIj4gPHJkZjpSREYgeG1sbnM6cmRmPSJo
|
|
dHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1zeW50YXgtbnMjIj4gPHJkZjpEZXNjcmlw
|
|
dGlvbiByZGY6YWJvdXQ9IiIgeG1sbnM6eG1wPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAv
|
|
IiB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wL21tLyIgeG1sbnM6c3RS
|
|
ZWY9Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC9zVHlwZS9SZXNvdXJjZVJlZiMiIHhtcDpD
|
|
cmVhdG9yVG9vbD0iQWRvYmUgUGhvdG9zaG9wIENDIDIwMTcgKFdpbmRvd3MpIiB4bXBNTTpJbnN0
|
|
YW5jZUlEPSJ4bXAuaWlkOjJCRThGOUE2RTI1NTExRTZCNUJFOEM2QkJDQzA1OUQ1IiB4bXBNTTpE
|
|
b2N1bWVudElEPSJ4bXAuZGlkOjJCRThGOUE3RTI1NTExRTZCNUJFOEM2QkJDQzA1OUQ1Ij4gPHht
|
|
cE1NOkRlcml2ZWRGcm9tIHN0UmVmOmluc3RhbmNlSUQ9InhtcC5paWQ6MkJFOEY5QTRFMjU1MTFF
|
|
NkI1QkU4QzZCQkNDMDU5RDUiIHN0UmVmOmRvY3VtZW50SUQ9InhtcC5kaWQ6MkJFOEY5QTVFMjU1
|
|
MTFFNkI1QkU4QzZCQkNDMDU5RDUiLz4gPC9yZGY6RGVzY3JpcHRpb24+IDwvcmRmOlJERj4gPC94
|
|
OnhtcG1ldGE+IDw/eHBhY2tldCBlbmQ9InIiPz4wOW0fAAAE4UlEQVRo3rVa2XbbQAjlp2MnttOm
|
|
y2NtWfKapenpnxZ5YoJnYYBRz6F9yLEkLgOXbeDu1ybI6nD6+f43lW8vv+/WXfjNfLN9PJynkoft
|
|
jr6+6PfKp5a7Iz2FAvhvttmillntg3x/fScMq/1pKgCz6zsRienBxbBnANadrP3nObg+VjTkcAgv
|
|
RBgOo8w3/QcAjfZB0McmPAT0xvC2+25wPE6HAErtg9xvh0kiAT2efMB3pOEA0fo2AGMwfJitb3ce
|
|
ciHHS1CBxXBAlWwAUIgEHvpdu/a+VwUdnp7fPAAoEkzcF2mPxsPPfzk9B59EQZ2UL1ntjoG+8PGm
|
|
E7CGIIVd+DAJIkEmVHIR/obIF8F7AMyu7MEw9Pqo/Xp+LeWZEYN4Dqg9sSe9DfBhvfaLnAdfeKkX
|
|
7EcZN7J9fA6XgC750kX72HYIG+Zd36i9nI/wfORShQThleKBe04kEEJKfvWPtz9IFIL2nE8IBid7
|
|
dDyTjTg9LK9Ri//j35EJgmD4fQAIoAXtU7+3ivKcOcWhuugzcr2ExoKIldLwIu1HBx0OAp3LEmjb
|
|
yhDVRAHcwx6PZ7T3jVMSZyV0yT1E6V0mglZmG4gZat0hv1J+kQ3AC3qNCMHGnef2kUquhGqkyzky
|
|
ImYfBjx5h+1jAFkM1US7Kpx7iBk8oiCcwiMMLdrHAFIMFLVyYZjJCcm5ERsGn8QkilJiZ32VBXK9
|
|
UXXBqMELlUUpK3MMkptZakSQHUNTrHMA1W8LOdXXoEG19JXfuGRQNf5WrGq8Uw/QtK0lIiLbVwtJ
|
|
JQalCbQAKFVlCzVKAlbtS77k6y1B2f5xLfHvc1ZfuIcUEQX7ZgWgp5fwDW62Fu2zNpoYQErwpiSt
|
|
HTCyVOBwRVCOINtHCRq2wMJkGgBVtvYdt8ZY1kkH+Eo03zxQWRSaPBMcrj/hiLdUmesxQKL9oKmK
|
|
p3WhbGuhDGhwN1mTUFClpFVwNFRtHzXXjXnH1FQIY6IYQMnveTmN74oOeiomnYtTDxkDpPM6mdHQ
|
|
Wvx7jvLLwRlCWwIlvpd5hvytsZpIjxTbtKfnN5SxzWe65a25P4G7LqcSAH/swxD1k9gr86EODa5v
|
|
QuJ64PjFAB70U06h3nYsbCLGK01c+JK3OBtt6SrIiiYMqe0rC9IyBmivEYgDNGUMnm0UtdXRsowh
|
|
BuDwZv3KcZVMJTTayxigvUTLjFVyzJ2m+eq0tLRsLwLwlWhZIufMjapnyHrdmZZDpQEwWLdd+tGi
|
|
e9CrWVQXY8Baos29u4/qxqkkChpVY1DunfIt0WVJapWwC6wAUGJYep3HtLPJXtaoA6iOddu1d8Qx
|
|
/+hssx3BrDsQlqel7W+15TdhiOofzQrn8Ximv4OwYsi2FLL2mEloDaqMELRlFQPXMFpGQrRkLqjV
|
|
hwVtOqurZnENTc27XsDAdUtXqZD9nVXkAlbTspTu7XG/zy6CQbMqrNhPvChh2Gcmt/d4fJbyBsgs
|
|
W6dzdfJWjjzGywqH02j420grcW4TAGvpYd2NmwGYXMh3bc6Noe5CpiBu6eU1MZ0VKYitFNS416hy
|
|
6811m+FAmSdPo9a6oH0WhPhNe2KuIU/DI4CF8eLMVIP1Uk4sWYe3o7yXgLTKxWOi0VJ6gWc13Uw3
|
|
LUmWtUt/n49cbtWMxVzEwVFK5/fW/+v1e+W1htT3/gHO9EIyge+NWAAAAABJRU5ErkJggg==
|
|
}
|
|
|
|
set imgdata(goal) {
|
|
iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAIAAAAlC+aJAAAAGXRFWHRTb2Z0d2FyZQBBZG9iZSBJ
|
|
bWFnZVJlYWR5ccllPAAAAyZpVFh0WE1MOmNvbS5hZG9iZS54bXAAAAAAADw/eHBhY2tldCBiZWdp
|
|
bj0i77u/IiBpZD0iVzVNME1wQ2VoaUh6cmVTek5UY3prYzlkIj8+IDx4OnhtcG1ldGEgeG1sbnM6
|
|
eD0iYWRvYmU6bnM6bWV0YS8iIHg6eG1wdGs9IkFkb2JlIFhNUCBDb3JlIDUuNi1jMTM4IDc5LjE1
|
|
OTgyNCwgMjAxNi8wOS8xNC0wMTowOTowMSAgICAgICAgIj4gPHJkZjpSREYgeG1sbnM6cmRmPSJo
|
|
dHRwOi8vd3d3LnczLm9yZy8xOTk5LzAyLzIyLXJkZi1zeW50YXgtbnMjIj4gPHJkZjpEZXNjcmlw
|
|
dGlvbiByZGY6YWJvdXQ9IiIgeG1sbnM6eG1wPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAv
|
|
IiB4bWxuczp4bXBNTT0iaHR0cDovL25zLmFkb2JlLmNvbS94YXAvMS4wL21tLyIgeG1sbnM6c3RS
|
|
ZWY9Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC9zVHlwZS9SZXNvdXJjZVJlZiMiIHhtcDpD
|
|
cmVhdG9yVG9vbD0iQWRvYmUgUGhvdG9zaG9wIENDIDIwMTcgKFdpbmRvd3MpIiB4bXBNTTpJbnN0
|
|
YW5jZUlEPSJ4bXAuaWlkOjJCRkVFQTNFRTI1NTExRTZCNUJFOEM2QkJDQzA1OUQ1IiB4bXBNTTpE
|
|
b2N1bWVudElEPSJ4bXAuZGlkOjJCRkVFQTNGRTI1NTExRTZCNUJFOEM2QkJDQzA1OUQ1Ij4gPHht
|
|
cE1NOkRlcml2ZWRGcm9tIHN0UmVmOmluc3RhbmNlSUQ9InhtcC5paWQ6MkJGRUVBM0NFMjU1MTFF
|
|
NkI1QkU4QzZCQkNDMDU5RDUiIHN0UmVmOmRvY3VtZW50SUQ9InhtcC5kaWQ6MkJGRUVBM0RFMjU1
|
|
MTFFNkI1QkU4QzZCQkNDMDU5RDUiLz4gPC9yZGY6RGVzY3JpcHRpb24+IDwvcmRmOlJERj4gPC94
|
|
OnhtcG1ldGE+IDw/eHBhY2tldCBlbmQ9InIiPz6L30xAAAAFYUlEQVRo3s1a224jNwzVtxbFAkWL
|
|
olsgmcRxNnHcXBatPbbja2zHm2Tb7+yZ0ObKunA4mrF3ASYvHkk8FEUeUjIn//RJ2pPZX88vvnSe
|
|
1ie9nL7J+oPLybwpOR888uqt4Vg56uJxyqMgBn+n/QG0DGpPcrN8Zgzt8awpAKe7OYGk0sDWaGwB
|
|
6OWy9t/2IWmxqCFHE5oQMBKMkvWHWwAa7UngYw1uAryRZjvLRwnDeRNMTN27L2/3r19JPn/9Tyma
|
|
tfWz3X15hdxuCh/+NF34GwjrBwDcvbzp1zgoAEe6qw1PcpYPW6MJtDUx7a/mT3/cPfx6fQP56SRT
|
|
isb19bPR6lADymwxrDcciK4XKxfA7eaVvsMY/TJ6ALTvaTNDpa1lZ08Uvj7NFi6A+5fC3XE+0taQ
|
|
AfCxS54cM0C9znIbD88GIxfAw9u/+OKXy6vGASBP0apX82Xy5FCsONkvb5wEMJvBAWcAtEf2GHwE
|
|
h+MPWrvg7QiishBbOePSpgcFDk05AcvZme7j/WdbH9Lw29K93GT5UABgrxHTXs5HCBcyVWEBPPrS
|
|
xgCRABCVoHgkAED8Oh8+Ctqz4DOGwW5DbEWTK9lGNjXyASAYQJABtwDYT4IAoP3pLmsmi73PmmRP
|
|
W4psjf8+AMYGY5n245Sjkg8AJ4S1Lxx0NHGYjF4obMsStJQAAGIIB2EIHOIdYfQZi+0hSu+StXd4
|
|
cgUAhAGRJBiFaO1SQq8RPmyy8+wPGasAEIZYGNXQ2joYLqfz8MfvR1kLgGmWPaCU67Yj+05nBltE
|
|
klnO7WCQta8LgE+tIBzp93KCt28Xu2hBPokkColFZzmMVgAAF6xU4L0f92hWtjFIbrZfH9cCgPUq
|
|
ASitzTnixcR32loASks+jn12lijFkEUyY7DrUReAEIjY9kGnT8AQNEEDAIJEjZNAVe1jvhRz1wYA
|
|
OFrCTpnFL5KbFE4IjnXNKgCQwwutYZutjvY+p9IEDF9MpQDvumx1zwnwESsVJLiiUbYgg+SsqR4j
|
|
OySISTMASqN12nZrjKXv8koASilaWj9QSQoreaZJcP0GW7wxZq7HYDztRxpW3KwLBUsL5YE2yUVW
|
|
IyGohNIqYrQptT0X1xre0khGs5cuNZOR/d6m05jL2eimImkmdj1kDIaqYQ0vZ2vZ6ykZaJ106djR
|
|
BRCL93KcYX+rySb8LUWZdr1YQYoy39ItbM3xzNjjfTKnoQDYkDQMTj2JWrm72rgN00hjCysS+HQA
|
|
dtSCG1S+5NqPeLGOS+dpXd4bTQZgW7ESBt/2QsPrsABsFqChMdh659TK2h8DgO0M8tFve12JUu2P
|
|
AsBvq4Qit5/mS7ulRwIQDOR25IbqgWDdy+3Loe8GoF1W9yQ0eo8KIEu9+yi9cToGAOW9U7gker8k
|
|
/Z4ALlKdp9KdzaEA1Ndef46DAE77A+xhcc1qX576AIIkp7Tkr4TB4T8aAJfTOf9q7CuGYHfaoeOy
|
|
9mCpdAcKUZ4Q2FLG4AOwfzX2JXOstVi8bRmOoZPfq9sLLKHt0oSpLB8KGFQACAP9/HN2zgN+63SV
|
|
Nb7AqDUlS+zd3p8Pf7MyUEwCULxWeX+c9Xv3tvHHHnbhkjw5FIN6UDIKgF47IcUc5LnNsO5zGyhG
|
|
r1WiAG5Wm4M+eCIMNR88OT5mnNvm68WSvsPB+tBqNwuAMFSdE2pAme0zwH3zu4eYtrizXP+Yj/5u
|
|
N4EYZRztmQzfrJ5/HADd9YYiuP9kygivLKKdptq9IMRc/T2xw1zsNFwAaFV8ONNUYz2WE2PWsctR
|
|
u5YwPsvFNnFryX/A026up+tTErmLuMdievmWzDlFqpPS7XfrB31+L/cPBd/7HwDmw8MEUb41AAAA
|
|
AElFTkSuQmCC
|
|
}
|
|
|
|
# load the tiles
|
|
|
|
# load the player tile separately
|
|
image create photo tile_player -data $imgdata(player)
|
|
# floor is coded as 0
|
|
image create photo tile_0 -data $imgdata(floor)
|
|
# goal is coded as 1
|
|
image create photo tile_1 -data $imgdata(goal)
|
|
# player on the floor is coded as 2
|
|
image create photo tile_2
|
|
tile_2 copy tile_0
|
|
tile_2 copy tile_player
|
|
# player on the goal is coded as 3
|
|
image create photo tile_3
|
|
tile_3 copy tile_1
|
|
tile_3 copy tile_player
|
|
# box is coded as 4
|
|
image create photo tile_box -data $imgdata(box)
|
|
image create photo tile_4
|
|
tile_4 copy tile_0
|
|
tile_4 copy tile_box
|
|
# box on goal is coded as 5
|
|
image create photo tile_goalbox -data $imgdata(boxongoal)
|
|
image create photo tile_5
|
|
tile_5 copy tile_1
|
|
tile_5 copy tile_goalbox
|
|
# wall is coded as 8
|
|
image create photo tile_8 -data $imgdata(wall)
|
|
|
|
# create the UI and canvas
|
|
|
|
canvas .c
|
|
grid .c -column 0 -row 0
|
|
grid rowconfigure . 0 -weight 1
|
|
grid columnconfigure . 0 -weight 1
|
|
|
|
wm title . "BOXcl"
|
|
|
|
# define the help message
|
|
|
|
set helpmsg {Welcome to BOXcl!
|
|
|
|
Controls:
|
|
|
|
Move: WASD or arrow keys
|
|
Undo: u
|
|
Restart: r
|
|
Open a levelset: Ctrl+O
|
|
Next level in the set: Ctrl+N
|
|
Previous level in the set: Ctrl+P
|
|
Quit: Ctrl+Q
|
|
This help: h or F1
|
|
|
|
You can also pass the levelset as the command line parameter to the boxcl.tcl script.
|
|
|
|
Created by Luxferre in 2024
|
|
Released into public domain
|
|
}
|
|
|
|
# entry point
|
|
|
|
set levelsetfile ""
|
|
if {$argc > 0} { # get the level set file name
|
|
set levelsetfile [lindex $argv 0]
|
|
} else { # open the file dialog
|
|
set levelsetfile [openlevel]
|
|
}
|
|
set sublevel 0
|
|
if {$argc > 1} { # get the optional level number
|
|
set sublevel [expr {int([lindex $argv 1]) - 1}]
|
|
if {$sublevel < 0} {
|
|
puts "Invalid level number!"
|
|
exit 1
|
|
}
|
|
}
|
|
if {$levelsetfile eq ""} {
|
|
tk_messageBox -type ok -title "Missing levelset" -icon error -message "Please open a levelset file to start the game!"
|
|
exit 1
|
|
}
|
|
|
|
set levels [loadlevels $levelsetfile]
|
|
set levelcount [llength $levels]
|
|
startlevel [lindex $levels $sublevel]
|
|
|
|
# bind keys to move logic
|
|
|
|
bind . <Key> {
|
|
switch "%K" {
|
|
r {startlevel [lindex $levels $sublevel]}
|
|
u -
|
|
BackSpace {renderundo}
|
|
w -
|
|
Up {rendermove 0}
|
|
a -
|
|
Left {rendermove 1}
|
|
s -
|
|
Down {rendermove 2}
|
|
d -
|
|
Right {rendermove 3}
|
|
h -
|
|
F1 {
|
|
tk_messageBox -type ok -icon question -title "BOXcl help" -message $helpmsg
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
bind . <Control-n> {nextlevel 0}
|
|
bind . <Control-p> {prevlevel}
|
|
bind . <Control-o> {
|
|
set levelsetfile [openlevel]
|
|
if {$levelsetfile ne ""} {
|
|
set sublevel 0
|
|
set levels [loadlevels $levelsetfile]
|
|
set levelcount [llength $levels]
|
|
startlevel [lindex $levels $sublevel]
|
|
}
|
|
}
|
|
bind . <Control-q> {exit}
|