Post by PeterMaria on Apr 17, 2016 12:16:36 GMT -5
Hello,
SokoMouse by PeterMaria Wirbelauer 17.o4/2o16
How do I play!
Move every box on the rotating circle. Use your arrow keys for this action.
if you want to choose a level, click on the rotating arrows.
SPACEBAR restart a level.
It's a Sokoban clone.
Use the old Basic4gl, version v2.6 makes a bit trouble.
SokoMouse by PeterMaria Wirbelauer 17.o4/2o16
How do I play!
Move every box on the rotating circle. Use your arrow keys for this action.
if you want to choose a level, click on the rotating arrows.
SPACEBAR restart a level.
It's a Sokoban clone.
Use the old Basic4gl, version v2.6 makes a bit trouble.
Textmode(TEXT_BUFFERED)
ResizeSpriteArea(640, 480)
dim fo(95),px,icx,idx,ibx,lev,RasReg,xHead,yHead,zHead,rHead,pHead,s8(3),s9(3),zA,vA,mDC
dim p1,s1(4),s2(3),s3(3),s4(3),s5,s6(63),s7(63),w1,w2,w3,w4,sText,BoxRas,cR,cV,zR,vR,Ready,Steps
dim KeyR, KeyL, KeyU, KeyD, ButtonC, xPos, yPos, Turn, xTurn, yTurn, zTurn, rTurn
Dim Map1(300)
Dim Map2(300)
Dim Map3(300)
Dim xBox(300)
Dim yBox(300)
Dim rBox(300)
Dim zBox(300)
Dim iBox(300)
Dim Nums$(10)
fo = LoadImageStrip( "SokoMedia/FontStrip.png" )
s1 = LoadImageStrip( "SokoMedia/SokoStrip.png" )
s2 = LoadImageStrip( "SokoMedia/RundStrip.png" )
s3 = LoadImageStrip( "SokoMedia/HeadStrip.png" )
s4 = LoadImageStrip( "SokoMedia/BoxsStrip.png" )
s8 = LoadImageStrip( "SokoMedia/ArroStripL.png")
s9 = LoadImageStrip( "SokoMedia/ArroStripR.png")
p1 = LoadTex( "SokoMedia/Phantasie.png" )
w1 = LoadSound( "SokoMedia/move.wav" )
w2 = LoadSound( "SokoMedia/push.wav" )
w3 = LoadSound( "SokoMedia/done.wav" )
w4 = LoadSound( "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"
Declare Sub Initialize()
Declare Sub LoadMaps()
Declare Sub ShowMaps()
Declare Sub ShowLevel()
Declare Sub ShowBoxes()
Declare Sub ShowHead()
Declare Sub FlashBox()
Declare Sub Text(id(), x1, y1, txt$, w1, h1)
Declare Sub Sprite(no(), x, y, w, h, frame)
Declare Sub DrawImage(n, x, y, w, h)
Declare Sub AllDone()
Declare Sub TurnHead()
Declare Sub ScanBoxes()
Declare Sub ScanHead()
Declare Sub MousePos()
Declare Sub FindHead()
Declare Function Rand(min, max)
lev =1
Initialize()
LoadMaps()
FindHead()
while scankeydown(27)=0
DrawImage(p1, 0, 0, 640, 480)
ShowMaps()
ShowLevel()
ScanBoxes()
ScanHead()
ShowBoxes()
ShowHead()
FlashBox()
AllDone()
MousePos()
TurnHead()
if scankeydown(32) then
Text(fo, 64, 420, "Wait...", 24, 24)
Initialize()
LoadMaps()
FindHead()
endiF
Text(fo,200,8,"SokoMouse",24,24)
if Ready = 2 then Text(fo,64, 420, Str$(Steps) + " moves!",24,24): endif
BoxRas = BoxRas +2
if BoxRas = 32 then BoxRas = 0: endif
DrawText()
waittimer(20)
if scankeydown(vk_right)= 0 then KeyR =1: endif
if scankeydown(vk_right) then KeyR =0: endif
if scankeydown(vk_left) = 0 then KeyL =1: endif
if scankeydown(vk_left) then KeyL =0: endif
if scankeydown(vk_up) = 0 then KeyU =1: endif
if scankeydown(vk_up) then KeyU =0: endif
if scankeydown(vk_down) = 0 then KeyD =1: endif
if scankeydown(vk_down) then KeyD =0: endif
ClearSprites()
wend
End
Sub Sprite(no(), x, y, w, h, frame)
NewSprite (no)
SprSetxCentre(0)
SprSetyCentre(0)
SprSetZOrder (1)
SprSetSize (w,h)
SprSetPos (x,y)
SprSetFrame (frame)
End Sub
Sub DrawImage(n, x, y, w, h)
NewSprite (n)
SprSetxCentre(0)
SprSetyCentre(0)
SprSetZOrder (1)
SprSetSize (w,h)
SprSetPos (x,y)
End Sub
Sub Text(id(),x1,y1,txt$,w1,h1)
dim sx, jx, px
sx = Len(txt$)
for jx=1 to sx
px = Asc(Mid$(txt$,jx,1))
if px >=32 and px <=127 then
px = px-32
NewSprite(id)
SprSetxCentre(0)
SprSetyCentre(0)
SprSetZOrder (1)
SprSetSize (w1,h1)
SprSetPos (x1,y1)
SprSetFrame (px)
x1 = x1 + w1
endif
next
End Sub
Sub ShowMaps()
for icx=0 To 14
for idx=0 To 19
ibx = icx*20 + idx
if Map1(ibx) = 3 then Sprite(s1, idx*32, icx*32, 32, 32, 3): endif
if Map3(ibx) = 2 then Sprite(s1, idx*32, icx*32, 32, 32, 2): endif
if Map2(ibx) = 5 then Sprite(s2, idx*32, icx*32, 32, 32,zR): endif
next
next
vR = vR + 1
if vR = 10 then
vR = 0
zR = zR + 1
endiF
if zR = 4 then zR = 0: endif
End Sub
Sub AllDone()
if Ready >=1 then return: endif
for icx =0 To 14
for idx =0 To 19
ibx = icx *20 + idx
if Map2(ibx)=5 And Map3(ibx) <> 4 then return: endif
next
next
PlaySound(w3)
Ready = 2: RasReg = 1: Turn = 0: pHead = 0
xTurn = xHead
yTurn = yHead
End Sub
Sub TurnHead()
if Turn >0 then return: endif
if zTurn = 1 then
Sprite(s3,xTurn,yTurn,32,32,3)
elseif zTurn =2 then
Sprite(s3,xTurn,yTurn,32,32,1)
elseif zTurn =3 then
Sprite(s3,xTurn,yTurn,32,32,0)
elseif zTurn =4 then
Sprite(s3,xTurn,yTurn,32,32,2)
endif
End Sub
Sub FlashBox()
for icx =0 To 14
for idx =0 To 19
ibx = icx *20 + idx
if Map2(ibx) = 5 And Map3(ibx) = 4 then
Sprite(s4,idx*32,icx*32,32,32,cR)
endif
next
next
cV = cV +1
if cV = 10 then
cV = 0
cR = cR +1
endif
if cR = 4 then cR = 0: endif
End Sub
Sub ScanBoxes()
if BoxRas > 0 then return: endif
for icx =0 To 14
for idx =0 To 19
ibx = icx *20 + idx
if Map3(ibx) =4 then
iBox(ibx) = 1
xBox(ibx) = idx *32
yBox(ibx) = icx *32
rBox(ibx) = 0
endif
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),32,32,4)
elseif iBox(ibx) =1 And rBox(ibx) = 1 then
xBox(ibx) = xBox(ibx) +2
Sprite(s1,xBox(ibx),yBox(ibx),32,32,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) = 4
endif
elseif iBox(ibx) = 1 And rBox(ibx) = 2 then
xBox(ibx) = xBox(ibx) -2
Sprite(s1,xBox(ibx),yBox(ibx),32,32,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) = 4
endif
elseif iBox(ibx) = 1 And rBox(ibx) = 3 then
yBox(ibx) = yBox(ibx) -2
Sprite(s1,xBox(ibx),yBox(ibx),32,32,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) =4
endif
elseif iBox(ibx) = 1 And rBox(ibx) = 4 then
yBox(ibx) = yBox(ibx) +2
Sprite(s1,xBox(ibx),yBox(ibx),32,32,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) = 4
endif
endif
next
End Sub
Sub ScanHead()
if RasReg >0 then return: endif
idx = xHead /32
icx = yHead /32
ibx = icx*20 + idx
if Map3(ibx) = 6 And scankeydown(vk_right) And Map3(ibx+1) = 4 And Map3(ibx+2) =0 And KeyR =0 then
Map3(ibx) = 0: Map3(ibx+1) =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 = Steps + 1
PlaySound(w2)
zTurn = rHead
elseif Map3(ibx) =6 And scankeydown(vk_left) And Map3(ibx-1) =4 And Map3(ibx-2) =0 And KeyL =0 then
Map3(ibx) = 0: Map3(ibx-1) =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 = Steps +1
PlaySound(w2)
zTurn = rHead
elseif Map3(ibx) =6 And scankeydown(vk_up) And Map3(ibx-20) =4 And Map3(ibx-40) =0 And KeyU =0 then
Map3(ibx) =0: Map3(ibx-20) =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 = Steps +1
PlaySound(w2)
zTurn = rHead
elseif Map3(ibx) =6 And scankeydown(vk_down) And Map3(ibx+20) =4 And Map3(ibx+40) =0 And KeyD =0 then
Map3(ibx) =0: Map3(ibx+20) =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 = Steps +1
PlaySound(w2)
zTurn = rHead
elseif Map3(ibx) =6 And scankeydown(vk_right) And Map3(ibx+1) =0 And KeyR =0 then
rHead =1 : pHead =1
Map3(ibx) =0: Map3(ibx+1) =6
PlaySound(w1)
zTurn = rHead
elseIf Map3(ibx) =6 And scankeydown(vk_left) And Map3(ibx-1) =0 And KeyL =0 then
rHead =2 : pHead =2
Map3(ibx) =0 : Map3(ibx-1) =6
PlaySound(w1)
zTurn = rHead
elseif Map3(ibx) =6 And scankeydown(vk_up) And Map3(ibx-20) =0 And KeyU =0 then
rHead =3 : pHead =3
Map3(ibx) =0 : Map3(ibx-20) =6
PlaySound(w1)
zTurn = rHead
elseif Map3(ibx) =6 And scankeydown(vk_down) And Map3(ibx+20) =0 And KeyD =0 then
rHead =4 : pHead =4
Map3(ibx) =0 : Map3(ibx+20) =6
PlaySound(w1)
zTurn = rHead
else
rHead = 0
endif
End Sub
Sub ShowHead()
if rHead =0 And pHead =1 then
Sprite(s3,xHead,yHead,32,32,3)
elseif rHead =0 And pHead =2 then
Sprite(s3,xHead,yHead,32,32,1)
elseif rHead =0 And pHead =3 then
Sprite(s3,xHead,yHead,32,32,0)
elseif rHead =0 And pHead =4 then
Sprite(s3,xHead,yHead,32,32,2)
elseif rHead =1 then
xHead = xHead +2
Sprite(s3,xHead,yHead,32,32,3)
RasReg = RasReg +2
if RasReg =32 then
RasReg =0
rHead =0
endif
elseif rHead =2 then
xHead = xHead -2
Sprite(s3,xHead,yHead,32,32,1)
RasReg = RasReg +2
if RasReg =32 then
RasReg =0 : rHead =0
endif
elseif rHead =3 then
yHead = yHead -2
Sprite(s3,xHead,yHead,32,32,0)
RasReg = RasReg +2
if RasReg =32 then
RasReg =0 : rHead =0
endif
elseif rHead =4 then
yHead = yHead +2
Sprite(s3,xHead,yHead,32,32,2)
RasReg = RasReg +2
if RasReg =32 then
RasReg =0: rHead=0
endif
endif
End Sub
Sub MousePos()
xPos = Mouse_X()*TextCols()
yPos = Mouse_Y()*TextRows()
if Mouse_Button(0) then
iF xPos >=30 And xPos <=31 and yPos >=21 And yPos <=23 and lev >1 and ButtonC=0 then
lev = lev-1: ButtonC=1
PlaySound(w4)
Initialize()
LoadMaps()
FindHead()
return
endif
endif
if Mouse_Button(0) then
if xPos >=36 And xPos <=37 and yPos >=21 and yPos <=23 and lev <30 and ButtonC=0 then
lev = lev+1: ButtonC =1
PlaySound(w4)
Initialize()
LoadMaps()
FindHead()
endif
endif
if Mouse_Button(0)=false then ButtonC = 0: endif
End Sub
Sub ShowLevel()
Sprite(s8,480,420,32,32,zA)
Sprite(s9,576,420,32,32,zA)
if lev < 10 then
Text(fo,520,420,Nums$(lev),24,24)
else
Text(fo,520,420,Str$(lev),24,24)
endif
vA = vA +1
if va =8 then
vA =0
zA = zA +1
if zA = 4 then zA = 0: endif
endif
End Sub
Sub Initialize()
dim bc
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:pHead = 3:Ready = 0
cV =0:cR = 0:Steps = 0:RasReg= 0
KeyR =0:KeyL =0: KeyU=0:KeyD = 0
BoxRas =0:Turn =1
End Sub
Sub FindHead()
for icx=0 To 14
for idx=0 To 19
ibx = icx*20 + idx
if Map3(ibx) = 6 then
xHead = idx *32
yHead = icx *32
rHead = 0
zHead = 0
return
endif
next
next
End Sub
Sub LoadMaps()
Dim f1, f2, f3, px
f1 = OpenFileRead("Maps\Map" + Lev + "-1.bin")
f2 = OpenFileRead("Maps\Map" + Lev + "-2.bin")
f3 = OpenFileRead("Maps\Map" + Lev + "-3.bin")
for px=0 To 299
Map1(px) = ReadByte(f1)
Map2(px) = ReadByte(f2)
Map3(px) = ReadByte(f3)
next
CloseFile(f1)
CloseFile(f2)
CloseFile(f3)
End Sub
Function Rand(min,max)
Return rnd()% (max - min + 1) + min
End Function