' ScriptBasic SokoMouse
INCLUDE "sw.inc"
SUB Initialize
DrawBmp p1, 0, 0, 640, 480, 0
CALL ShowLevel
FOR bc = 0 TO 299
xBox[bc] = 0
yBox[bc] = 0
rBox[bc] = 0
zBox[bc] = 0
iBox[bc] = 0
NEXT
zR = 0
vR = 0
zA = 0
pHead = 3
Ready = 0
sl = 0
cV = 0
cR = 0
Steps = 0
RasReg = 0
KeyR = 0
KeyL = 0
KeyU = 0
KeyD = 0
BoxRas = 0
Turn = 1
zTurn = 0
END SUB
SUB LoadMaps
LoadBytes "Maps/Map" & lev & "-1.bin", Map1
LoadBytes "Maps/Map" & lev & "-2.bin", Map2
LoadBytes "Maps/Map" & lev & "-3.bin", Map3
END SUB
SUB ShowLevel
Sprite s8, 480, 420, zA
Sprite s9, 576, 420, zA
IF lev < 10 THEN
BmpText fo, 520, 420, Nums[lev], 24, 24
ELSE
BmpText fo, 520, 420, STR(lev), 24, 24
END IF
vA += 1
IF vA = 8 THEN
vA = 0
zA = zA + 1
IF zA = 4 THEN zA = 0
END IF
END SUB
SUB ShowMaps
FOR icx = 0 TO 14
FOR idx = 0 TO 19
ibx = icx * 20 + idx
IF ASC(Map1[ibx]) = 3 THEN Sprite s1, idx * 32, icx * 32, 3
IF ASC(Map3[ibx]) = 2 THEN Sprite s1, idx * 32, icx * 32, 2
IF ASC(Map2[ibx]) = 5 THEN Sprite s2, idx * 32, icx * 32, zR
NEXT
NEXT
vR += 1
IF vR = 10 THEN
vR = 0
zR += 1
END IF
IF zR = 4 THEN zR = 0
END SUB
SUB FindHead
FOR icx = 0 TO 14
FOR idx = 0 TO 19
ibx = icx * 20 + idx
IF ASC(Map3[ibx]) = 6 THEN
xHead = idx * 32
yHead = icx * 32
rHead = 0
zHead = 0
EXIT SUB
END IF
NEXT
NEXT
END SUB
SUB AllDone
IF Ready >= 1 THEN EXIT SUB
FOR icx = 0 TO 14
FOR idx = 0 TO 19
ibx = icx * 20 + idx
IF ASC(Map2[ibx]) = 5 AND ASC(Map3[ibx]) <> 4 THEN
EXIT SUB
END IF
NEXT
NEXT
PlaySound w3
Ready = 2
RasReg = 1
Turn = 0
pHead = 0
rTurn = Rand(1, 2)
xTurn = xHead
yTurn = yHead
END SUB
SUB TurnHead
IF Turn > 0 THEN EXIT SUB
IF rTurn = 1 THEN
Sprite s6, xTurn, yTurn, zTurn
ELSE IF rTurn = 2 THEN
Sprite s7, xTurn, yTurn, zTurn
END IF
zTurn = zTurn + 1
IF zTurn = 64 THEN zTurn = 0
END SUB
SUB FlashBox
FOR icx = 0 TO 14
FOR idx = 0 TO 19
ibx = icx * 20 + idx
IF ASC(Map2[ibx]) = 5 AND ASC(Map3[ibx]) = 4 THEN
Sprite s4, idx * 32, icx * 32, cR
END IF
NEXT
NEXT
cV += 1
IF cV = 10 THEN
cV = 0
cR += 1
END IF
IF cR = 4 THEN cR = 0
END SUB
SUB ScanBoxes
IF BoxRas > 0 THEN EXIT SUB
FOR icx = 0 TO 14
FOR idx = 0 TO 19
ibx = icx * 20 + idx
IF ASC(Map3[ibx]) = 4 THEN
iBox[ibx] = 1
xBox[ibx] = idx * 32
yBox[ibx] = icx * 32
rBox[ibx] = 0
END IF
NEXT
NEXT
END SUB
SUB ShowBoxes
FOR ibx = 20 TO 280
IF iBox[ibx] = 1 AND rBox[ibx] = 0 THEN
Sprite s1, xBox[ibx], yBox[ibx], 4
ELSE IF iBox[ibx] = 1 AND rBox[ibx] = 1 THEN
xBox[ibx] = xBox[ibx] + 2
Sprite s1, xBox[ibx], yBox[ibx], 4
zBox[ibx] = zBox[ibx] + 2
IF zBox[ibx] = 32 THEN
zBox[ibx] = 0
iBox[ibx] = 0
icx = (yBox[ibx] * 20 + xBox[ibx]) / 32
Map3[icx] = CHR(4)
END IF
ELSE IF iBox[ibx] = 1 AND rBox[ibx] = 2 THEN
xBox[ibx] = xBox[ibx] - 2
Sprite s1, xBox[ibx], yBox[ibx], 4
zBox[ibx] = zBox[ibx] + 2
IF zBox[ibx] = 32 THEN
zBox[ibx] = 0
iBox[ibx] = 0
icx = (yBox[ibx] * 20 + xBox[ibx]) / 32
Map3[icx] = CHR(4)
END IF
ELSE IF iBox[ibx] = 1 AND rBox[ibx] = 3 THEN
yBox[ibx] = yBox[ibx] - 2
Sprite s1, xBox[ibx], yBox[ibx], 4
zBox[ibx] = zBox[ibx] + 2
IF zBox[ibx] = 32 THEN
zBox[ibx] = 0
iBox[ibx] = 0
icx = (yBox[ibx] * 20 + xBox[ibx]) / 32
Map3[icx] = CHR(4)
END IF
ELSE IF iBox[ibx] = 1 AND rBox[ibx] = 4 THEN
yBox[ibx] = yBox[ibx] + 2
Sprite s1, xBox[ibx], yBox[ibx], 4
zBox[ibx] = zBox[ibx] + 2
IF zBox[ibx] = 32 THEN
zBox[ibx] = 0
iBox[ibx] = 0
icx = (yBox[ibx] * 20 + xBox[ibx]) / 32
Map3[icx] = CHR(4)
END IF
END IF
NEXT
END SUB
SUB ScanHead
IF RasReg > 0 THEN EXIT SUB
idx = xHead / 32
icx = yHead / 32
ibx = icx * 20 + idx
IF ASC(Map3[ibx]) = 6 AND Key(vk_right) AND ASC(Map3[ibx + 1]) = 4 AND ASC(Map3[ibx + 2]) = 0 AND KeyR = 0 THEN
Map3[ibx] = CHR(0)
Map3[ibx + 1] = CHR(6)
rHead = 1
pHead = 1
BoxRas = 0
xBox[ibx + 1] = xHead + 32
yBox[ibx + 1] = yHead
rBox[ibx + 1] = 1
iBox[ibx + 1] = 1
Steps += 1
PlaySound w2
ELSE IF ASC(Map3[ibx]) = 6 AND Key(vk_left) AND ASC(Map3[ibx - 1]) = 4 AND ASC(Map3[ibx - 2]) = 0 AND KeyL = 0 THEN
Map3[ibx] = CHR(0)
Map3[ibx - 1] = CHR(6)
rHead = 2
pHead = 2
BoxRas = 0
xBox[ibx - 1] = xHead - 32
yBox[ibx - 1] = yHead
rBox[ibx - 1] = 2
iBox[ibx - 1] = 1
Steps += 1
PlaySound w2
ELSE IF ASC(Map3[ibx]) = 6 AND Key(vk_up) AND ASC(Map3[ibx - 20]) = 4 AND ASC(Map3[ibx - 40]) = 0 AND KeyU = 0 THEN
Map3[ibx] = CHR(0)
Map3[ibx - 20] = CHR(6)
rHead = 3
pHead = 3
BoxRas = 0
xBox[ibx - 20] = xHead
yBox[ibx - 20] = yHead - 32
rBox[ibx - 20] = 3
iBox[ibx - 20] = 1
Steps += 1
PlaySound w2
ELSE IF ASC(Map3[ibx]) = 6 AND Key(vk_down) AND ASC(Map3[ibx + 20]) = 4 AND ASC(Map3[ibx + 40]) = 0 AND KeyD = 0 THEN
Map3[ibx] = CHR(0)
Map3[ibx + 20] = CHR(6)
rHead = 4
pHead = 4
BoxRas = 0
xBox[ibx + 20] = xHead
yBox[ibx + 20] = yHead + 32
rBox[ibx + 20] = 4
iBox[ibx + 20] = 1
Steps += 1
PlaySound w2
ELSE IF ASC(Map3[ibx]) = 6 AND Key(vk_right) AND ASC(Map3[ibx + 1]) = 0 AND KeyR = 0 THEN
rHead = 1
pHead = 1
Map3[ibx] = CHR(0)
Map3[ibx + 1] = CHR(6)
Steps += 1
PlaySound w1
ELSE IF ASC(Map3[ibx]) = 6 AND Key(vk_left) AND ASC(Map3[ibx - 1]) = 0 AND KeyL = 0 THEN
rHead = 2
pHead = 2
Map3[ibx] = CHR(0)
Map3[ibx - 1] = CHR(6)
Steps += 1
PlaySound w1
ELSE IF ASC(Map3[ibx]) = 6 AND Key(vk_up) AND ASC(Map3[ibx - 20]) = 0 AND KeyU = 0 THEN
rHead = 3
pHead = 3
Map3[ibx] = CHR(0)
Map3[ibx - 20] = CHR(6)
Steps += 1
PlaySound w1
ELSE IF ASC(Map3[ibx]) = 6 AND Key(vk_down) AND ASC(Map3[ibx + 20]) = 0 AND KeyD = 0 THEN
rHead = 4
pHead = 4
Map3[ibx] = CHR(0)
Map3[ibx + 20] = CHR(6)
Steps += 1
PlaySound w1
ELSE
rHead = 0
END IF
END SUB
SUB ShowHead
IF rHead = 0 AND pHead = 1 THEN
Sprite s3, xHead, yHead, 3
ELSE IF rHead = 0 AND pHead = 2 THEN
Sprite s3, xHead, yHead, 1
ELSE IF rHead = 0 AND pHead = 3 THEN
Sprite s3, xHead, yHead, 0
ELSE IF rHead = 0 AND pHead = 4 THEN
Sprite s3, xHead, yHead, 2
ELSE IF rHead = 1 THEN
xHead += 2
Sprite s3, xHead, yHead, 3
RasReg += 2
IF RasReg = 32 THEN
RasReg = 0
rHead = 0
END IF
ELSE IF rHead = 2 THEN
xHead -= 2
Sprite s3, xHead, yHead, 1
RasReg += 2
IF RasReg = 32 THEN
RasReg = 0
rHead = 0
END IF
ELSE IF rHead = 3 THEN
yHead -= 2
Sprite s3, xHead, yHead, 0
RasReg += 2
IF RasReg = 32 THEN
RasReg = 0
rHead = 0
END IF
ELSE IF rHead = 4 THEN
yHead += 2
Sprite s3, xHead, yHead, 2
RasReg += 2
IF RasReg = 32 THEN
RasReg = 0
rHead = 0
END IF
END IF
END SUB
SUB MousePos
xPos = FIX(xMouse() / 32)
yPos = FIX(yMouse() / 32)
IF MouseButton() = 1 THEN
IF xPos = 15 AND yPos = 13 AND lev > 1 AND ButtonC = 0 THEN
lev -= 1
ButtonC = 1
PlaySound w4
Initialize
LoadMaps
FindHead
EXIT SUB
END IF
END IF
IF MouseButton() = 1 THEN
IF xPos = 18 AND yPos = 13 AND lev < 9 AND ButtonC = 0 THEN
lev += 1
ButtonC = 1
PlaySound w4
' Sync
Initialize
LoadMaps
FindHead
END IF
END IF
IF MouseButton() = 0 THEN ButtonC = 0
END SUB
' MAIN
Window 640, 480, 1
SetCaption "ScriptBasic SokoMouse"
SetFps(60)
Q = LoadBmp("SokoMedia/sokomouse.bmp", 1)
p1 = LoadBmp("SokoMedia/Phantasie.bmp", 1)
Fo = LoadBmp("SokoMedia/FontStrip.bmp", 96)
s1 = LoadBmp("SokoMedia/SokoStrip.bmp", 5)
s2 = LoadBmp("SokoMedia/RundStrip.bmp", 4)
s3 = LoadBmp("SokoMedia/HeadStrip.bmp", 4)
s4 = LoadBmp("SokoMedia/BoxsStrip.bmp", 4)
s6 = LoadBmp("SokoMedia/HeadStripR.bmp", 64)
s7 = LoadBmp("SokoMedia/HeadStripL.bmp", 64)
s8 = LoadBmp("SokoMedia/ArroStripL.bmp", 4)
s9 = LoadBmp("SokoMedia/ArroStripR.bmp", 4)
w1 = "SokoMedia/move.wav"
w2 = "SokoMedia/push.wav"
w3 = "SokoMedia/done.wav"
w4 = "SokoMedia/clic.wav"
Nums[1] = "01"
Nums[2] = "02"
Nums[3] = "03"
Nums[4] = "04"
Nums[5] = "05"
Nums[6] = "06"
Nums[7] = "07"
Nums[8] = "08"
Nums[9] = "09"
Cls 0xCCCCCC
Sprite Q, 180, 60, 0
BmpText fo, 205, 32, "SOKOMOUSE", 24, 24
BmpText fo, 170, 428, "PRESS ANY KEY", 24, 24
WaitKey
lev = 1
Initialize
LoadMaps
ShowLevel
FindHead
WHILE Key(27) = 0
ShowMaps
IF sl THEN ShowLevel
ScanBoxes
ScanHead
ShowBoxes
ShowHead
FlashBox
AllDone
MousePos
TurnHead
IF Key(vk_space) THEN
BmpText fo, 64, 420, "Wait...", 24, 24
Initialize
LoadMaps
FindHead
END IF
BmpText fo, 200, 8, "SokoMouse", 24, 24
IF Ready = 2 THEN
BmpText fo, 64, 420, "Advance to the next level ...", 16, 16
sl = 1
END IF
BoxRas += 2
IF BoxRas = 32 THEN BoxRas = 0
IF Key(vk_right) = 0 THEN KeyR = 1
IF Key(vk_right)THEN KeyR = 0
IF Key(vk_left) = 0 THEN KeyL = 1
IF Key(vk_left) THEN KeyL = 0
IF Key(vk_up) = 0 THEN KeyU = 1
IF Key(vk_up) THEN KeyU = 0
IF Key(vk_down) = 0 THEN KeyD = 1
IF Key(vk_down) THEN KeyD = 0
Sync
WEND
CloseWindow