-
Notifications
You must be signed in to change notification settings - Fork 4
Expand file tree
/
Copy path1346.bas
More file actions
189 lines (173 loc) · 3.98 KB
/
Copy path1346.bas
File metadata and controls
189 lines (173 loc) · 3.98 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
'Classic sliding block puzzle.bas 2015-12-04 SmallBASIC 0.12.1 [B+=MGA]
' modified from Sliding Blocks Puzzle Game programmed by Hermang H. M. M.
' copied from BP.org 2015-07-05 in YABasic.
' updated to work in an Android NOOK from On-line samples
if xmax> ymax then ssq=ymax else ssq=xmax
MaxSize = 10
th=txth("By")+4 'text height
label start
myline=0
color 0,11:cls 'sets all print fore and back color, squares have to match
at 0,th*1:? " SLIDING BLOCKS PUZZLE"
for i=3 to MaxSize
at 0,th*i:? "Tap/click this line for board size ";i;"x";i
next
at 0,th*(MaxSize+1):? "Tap/click this line to quit"
pen on
repeat
if pen(3) then myline=int(pen(5)/th): delay 60
until myline> 2 and myline< MaxSize+2
pen off
if myline=MaxSize+1 then cls:end else size=myline
'============================================ and we are off to play a game
dim board(size+1,size+1)
tlx=40 'top left x for board
tly=3*th 'top left y for board
sq=int((ssq-4*th)/size) 'board sq size
cls
rect 0,0,2*tlx+sq*size,ssq,9 filled 'set board on blue left side
for i=0 to 3
rect 0,0,2*tlx+sq*size-i,ssq-i,0
next
initBoard()
mixBlocks()
showBoard()
s=" SLIDING BLOCKS PUZZLE: r resets, q quits "
at (ssq-txtw(s))/2,0*th+2:? s
s=" tap block or arrow key to move block "
at (ssq-txtw(s))/2,1*th+2:? s
pen on
repeat
if pen(3) then
mx=bx(pen(4))
my=by(pen(5))
if emptyRow+1=mx and emptyCol=my then doleft
if emptyRow-1=mx and emptyCol=my then doright
if emptyRow=mx and emptyCol+1=my then doup
if emptyRow=mx and emptyCol-1=my then dodown
endif
k=inkey
if len(k)=2 then
ak=asc(right(k,1))
if ak=4 then:doleft
elseif ak=5:doright
elseif ak=9:doup
elseif ak=10:dodown:endif
elseif len(k)=1
if k="r" then mixBlocks
endif
if update=1 then showBoard
if TFsolved then k="q"
until(k="q")
pen off
if TFsolved then
for i=1 to 20
if i mod 2 then
s=" Congratulations, Puzzle Solved! "
else
s=space(32)
end if
at (ssq-txtw(s))/2,2*th+2:? s
delay 200
next
goto start
end if
'==========procedures
sub initBoard()
count=0
for j=0 to size+1
for i=0 to size+1
if i=0 or j=0 or i=(size+1) or j=(size+1) then
board(i,j)=-1
else
count=count+1
board(i,j)=count
endif
next
next
board(size,size)=0
emptyRow=size
emptyCol=size
end
sub showBoard()
local x,y,c
rect tlx-1,tly-1,tlx+sq*size+2,tly+sq*size+2,0 filled
for y=1 to size
for x=1 to size
if board(x,y) then c=11 else c=0
rect tlx+sq*(x-1),tly+sq*(y-1),tlx+sq*(x-1)+sq-2,tly+sq*(y-1)+sq-2,c filled
if board(x,y) then
s=str$(board(x,y))
at tlx+sq*(x-1)+sq/2-txtw(s)/2,tly+sq*(y-1)+sq/2-txth(s)/2
print s;
endif
next
next
update=0
end
sub mixBlocks()
repeat
for i=1 to 7*size*size
dir=1+int(rnd*4)
if dir=1 then:doleft
elseif dir=2:doright
elseif dir=3:doup
else:dodown:endif
next
until TFsolved=0
update=1
end
sub swapp()
board(emptyRow,emptyCol)=tag
board(tr,tc)=0
emptyRow=tr
emptyCol=tc
update=1
end
sub doleft()
tr=emptyRow+1
tc=emptyCol
tag=board(tr,tc)
if tag=-1 then exit
swapp
end
sub doright()
tr=emptyRow-1
tc=emptyCol
tag=board(tr,tc)
if tag=-1 then exit
swapp
end
sub dodown()
tr = emptyRow
tc = emptyCol-1
tag = board(tr,tc)
if tag=-1 then exit
swapp
end
sub doup()
tr=emptyRow
tc=emptyCol+1
tag=board(tr,tc)
if tag=-1 then exit
swapp
end
func TFsolved()
TFsolved=0:test=1
for j=1 to size
for i=1 to size
if board(i,j)<> 0 then
if test=board(i,j) then test=test+1 else exit sub
endif
next
next
TFsolved=1
end
func bx(mx)
rtn=int((mx-tlx)/sq+1)
if rtn< size+1 and rtn> 0 then bx=rtn else bx=0
end
func by(my)
rtn=int((my-tly)/sq+1)
if rtn< size+1 and rtn> 0 then by=rtn else by=0
end