This area is for the puzzle game called "Entrap" written by Harmonv as the prize winning entry in the LB summer 2006 contest.
In August, 2006, I added a "wizard" to the game which changes the cursor to a cross-hairs style when the player points at a cell which is an efficient move. It solves the puzzle for you, in other words. This is optional so the player can try without the "training wheels" of the cross-hair cursor. Other changes may be needed.
Please give feedback on the "discussion" page (tab above).
' Program Entrap
' The first version of this program was written in machine
' language and used to demonstrate Digital Group equipment.
' MAXI-BASIC version by Hal Knippenberg, April 1979
' Liberty Basic version by Harmonv, July 2006
' Wizard added by Grahame King, August 2006
nomainwin
global w$, cr$, move, blu, yelo
blu = 1 : yelo = 0 : gwin = 0
cr$ = chr$(13)
dim dist(511,9) ' array to store information about game positions
' the 1st index represents the postion as sum bit(i)*2^cell(i) over 9 cells
' where bit(i) is set for blue and off for yellow
' the value of an element of this array is,
' when 2nd dim = 0 :-
' 0 - no information
' n - positive integer represents the least number of moves to win+1
' so the won game postion has value 1
' -1 - for the lost position (all yellow) - not implimented
' when 2nd dim, k = 1 to 9, representing the cell clicked :-
' the position code of the position where that click in the kth cell takes you
onerrorgoto [educateWizard]
open"wiz.txt"forinputas #wiz
onerrorgoto [quit]
' read in wizardry
for i = 1 to 511
for j = 0 to 9
input #wiz, dist(i,j)
next j
next i
close #wiz
goto [newgame]
[educateWizard]
' start at won postion and trace back to earlier positions
' storing the number of moves in dist()
for i = 1 to 9
if i<>5 then
b(i) = 1
else
b(i) = 0
endifnext i
dist(posnCode(),0) = 1
moves = 1
notice "Wizard text not found - the wizard will rewrite it. This takes time!"
textbox #mainWiz.stxt 20,20,WindowWidth/2,WindowHeight/4
stylebits #mainWiz, 0 ,0, _WS_EX_TOPMOST, 0
open"Wizard at work!"for window_popup as #mainWiz
#mainWiz "trapclose [done]"
#mainWiz.stxt "Wizard at work!"+chr$(13)+chr$(10)+_
"This is a one-off operation."+chr$(13)+chr$(10)+_
"Please wait."
cursor hourglass
call trainWiz moves
[done]
open"wiz.txt"foroutputas #wiz
for i = 1 to 511
for j = 0 to 9
print #wiz, dist(i,j);
if j<>9 thenprint #wiz, ","; elseprint #wiz,""next j
next i
playwave "yeehaw.wav", async
close #wiz
close #mainWiz
cursor normal
[newgame]
if gwin=1 thenclose #g
tm = 0 ' total moves
call boardsetup
UpperLeftX = 40 : UpperLeftY = 20
WindowWidth = 500 : WindowHeight = 350
menu #g, "File", "New Game", [newgame],_
"Options", [options],_
|, "Exit", [quit]
menu #g, "Help", "Entrap Rules", showrules, "About Entrap", about
button #g.b, "Done", [quit], UL, 340, 240 ' {, width, height}
statictext #g.s1, "Entrap", 320, 40, 160, 60
statictext #g.s2, "Want the rules?"+cr$+"Check Help menu.", 300, 120, 190, 80
open"Entrap"for graphics_nsb as #g
gwin=1 ' set window flag to active
print #g, "color black ; down"print #g.s1, "!font Arial 14"print #g.s2, "!font Arial 14"print #g, "flush"print #g, "trapclose [quit]"print #g, "when leftButtonDown [clicked]"
#g "when mouseMove [mouseOver]"gosub [showgboard]
wait
' start of main loop
[clicked]
gosub [getmousemove]
if b(move)=yelo then
#g.s2, " Illegal move."+cr$+" Try Again."
wait
else
#g.s2, ""endif
tm = tm + 1
call updateboard move
gosub [showgboard]
call winorlose
if w$<>""then [endgame]
viewcell = 0 : move = 0 ' so mouseover will be activated for cell clicked on
wait
[showgboard]
#g.s1, "Total Moves"+cr$+" ";tm
for i = 1 to 9
x = 10+90*((i-1) mod 3)
y = 10+90*int((i-1)/3)
#g, "place ";x;" ";y
if b(i)=yelo then
#g, "backcolor yellow"else
#g, "backcolor blue"endif
#g, "boxfilled ";x+80;" ";y+80
#g, "flush"next i
return
[getmousemove]
move = 0
if abs(MouseX-50)<40 and abs(MouseY-50)<40 then move = 1
if abs(MouseX-140)<40 and abs(MouseY-50)<40 then move = 2
if abs(MouseX-230)<40 and abs(MouseY-50)<40 then move = 3
if abs(MouseX-50)<40 and abs(MouseY-140)<40 then move = 4
if abs(MouseX-140)<40 and abs(MouseY-140)<40 then move = 5
if abs(MouseX-230)<40 and abs(MouseY-140)<40 then move = 6
if abs(MouseX-50)<40 and abs(MouseY-230)<40 then move = 7
if abs(MouseX-140)<40 and abs(MouseY-230)<40 then move = 8
if abs(MouseX-230)<40 and abs(MouseY-230)<40 then move = 9
return
[mouseOver]
gosub [getmousemove]
if move = viewcell then wait ' no need to check same move twice
if move then
viewcell = move
if b(move) then' if legal move
if winningMove() then
cursor crosshair
else
cursor normal
endifelse
cursor normal
endifelse
cursor normal
viewcell = 0
endif
wait
[endgame]
if w$="won"then
playwave "yeehaw.wav", async
#g.s2, " ** You WON!! **"+cr$+"Congratulations!!"endifif w$="lost"then
playwave "wlaugh.wav", async
#g.s2, " -- You lost --"+cr$+"Better luck next time."endif
wait
[options]
'#optionsDialog "!show"
wait
[quit]
if gwin=1 thenclose #g
end' ----- end of main routine -----
sub boardsetup
ok = 0
dofor i = 1 to 9
t = rnd(1)
if t<0.666 then
b(i) = yelo
else
b(i) = blu
ok = 1
endifnext i
loopuntil ok=1
endsubsub winorlose
sum = 0
w$ = ""for i = 1 to 9
sum = sum + b(i)
next i
if sum=0 then w$="lost"if (sum=8) and (b(5)=yelo) then w$="won"endsubsub updateboard move
selectcase move
case 1: s=1245
case 2: s=123
case 3: s=2356
case 4: s=147
case 5: s=24568
case 6: s=369
case 7: s=4578
case 8: s=789
case 9: s=5689
endselectfor i = 1 to len(str$(s))
t = s mod 10 : b(t) = 1 - b(t)
s = int(s/10)
next i
endsubsub showrules
playwave "help.wav", async
n$ = space$(10)+"Entrap Instructions"+cr$+cr$
n$=n$+ "This game is played on a 3-by-3 grid. "+cr$
n$=n$+ "When the game starts the board will be "+cr$
n$=n$+ "filled with yellow and blue squares. "+cr$+cr$
n$=n$+ "To change the board, click on any of the "+cr$
n$=n$+ "blue squares. "+cr$+cr$
n$=n$+ "To win, make the center square yellow "+cr$
n$=n$+ "and all the other squares blue."+cr$+cr$
n$=n$+ "If all the squares turn yellow, you lose. "+cr$+cr$
n$=n$+ "As you pick squares, the board will change "+cr$
n$=n$+ "based on these rule(s): "+cr$+cr$
n$=n$+ "If you pick a corner square, the 4 squares "+cr$
n$=n$+ "in the area will change."+cr$+cr$
n$=n$+ "Pick one in the middle of an edge and all "+cr$
n$=n$+ "three squares along the edge will change. "+cr$+cr$
n$=n$+ "Pick the center square and the center plus "+cr$
n$=n$+ "the 4 middle edge squares will change. "+cr$+cr$
n$=n$+ "To end the game, click the [Done] button. "+cr$+cr$
n$=n$+ "Good Luck !"+cr$
notice n$
endsubsub about
n$="About Entrap"+cr$
n$=n$+ "The first version of this program was "+cr$
n$=n$+ "written in machine language and was used "+cr$
n$=n$+ "to demonstrate Digital Group equipment. "+cr$+cr$
n$=n$+ "MAXI-BASIC version by Hal Knippenberg, Apr 1979 "+cr$+cr$
n$=n$+ "Liberty Basic version by HarmonV, July 2006 "+cr$
n$=n$+ "Wizard by Grahame King, August 2006 "+cr$
notice n$
endsubfunction winningMove()
' returns 1 plus number of moves to win for the selected move (global) in current posn
' returns 0 if move is poor
pc = posnCode()
if move then
posnext = dist(pc,move)
valnext = dist(posnext,0) ' value of posn one move ahead
' compare to other legal moves if any
test = valnext
asgoodasanyother = test
for i = 1 to 9
if b(i) and i<>move then
test = dist(dist(pc,i),0)
if test>0 then asgoodasanyother = min(asgoodasanyother,test)
endifnext i
if valnext>asgoodasanyother then
winningMove = 0
else
winningMove = valnext
endifendifendfunctionfunction losingMove()
' stub - you have to protect yourself from wiping out
losingMove = 0
endfunctionsub trainWiz moves
' recursive subroutine
' exhaustively searches for all winnable positions by regressive moves
' working back from the target position
tpc = posnCode()
'print tpc, posnUncode$(tpc)
for i = 1 to 9
' if cell is yellow it was a possible legal move (i.e. it was blue)
if b(i)=yelo thencall updateboard i ' regressive move
moves = moves+1
pc = posnCode()
if dist(pc,0)=0 then
dist(pc,0) = moves
dist(pc,i) = tpc
call trainWiz moves ' delve further
else' position has already been found and recorded
if moves<dist(pc,0) then' store the shorter route
dist(pc,0) = moves
dist(pc,i) = tpc
call trainWiz moves ' delve further
endifif moves=dist(pc,0) then
dist(pc,i) = tpc ' store possibly new equally good move
endifendifcall updateboard i ' take move back
moves = moves-1
endifnext i
endsubfunction posnCode()
' "binary" encoding function to find index of position for storing info
for i = 1 to 9
posnCode = posnCode+b(i)*2^(i-1)
next i
endfunctionfunction posnUncode$(pc)
' converts the position code to a string of 9 bits representing the blue/yellow cells
' may be useful in debugging
cell = 0
for cell = 1 to 9
b= pc mod 2
pc = (pc-b)/2
if cell>1 then posnUncode$ = posnUncode$+","
posnUncode$ = posnUncode$+str$(b)
next cell
endfunction
GrahameKing
Aug 18, 2006
In August, 2006, I added a "wizard" to the game which changes the cursor to a cross-hairs style when the player points at a cell which is an efficient move. It solves the puzzle for you, in other words. This is optional so the player can try without the "training wheels" of the cross-hair cursor. Other changes may be needed.
Please give feedback on the "discussion" page (tab above).