' Klotski_puzzle.bas
' 11/06/2005
' Ported by Jorge Hernandez

WINDOW 1, 290, 290, 1

PEN ON
DIM C(20)
dim a(10,10)
c(0)=-val("&h000000")
c(1)=-val("&h00FF00")
c(2)=-val("&hFF0000")
c(3)=-val("&h0000FF")
c(4)=-val("&hC0FF00")
c(5)=-val("&hF6A500")
c(6)=-val("&h808080")
c(7)=-val("&hFF00FF")
c(8)=-val("&h800000")
c(9)=-val("&h808000")
c(10)=-val("&h00FFFF")
c(15)=-val("&hFFFFFF")

5 '
M=5:N=4
a(1,1)=1:a(1,2)=2:a(1,3)=2:a(1,4)=3
a(2,1)=1:a(2,2)=2:a(2,3)=2:a(2,4)=3
a(3,1)=4:a(3,2)=5:a(3,3)=5:a(3,4)=6
a(4,1)=4:a(4,2)=7:a(4,3)=11:a(4,4)=6
a(5,1)=9:a(5,2)=15:a(5,3)=15:a(5,4)=10

10 'clsk
rect 36,36,203,244 COLOR 1
rect 35,256,80,277 COLOR 1
rect 150,256,202,277 COLOR 1
AT 42,256

print "Quit"
AT 156,256
print "Reset"
AT 35,5
print "Klotski Puzzle"
AT 230,30
print "Move"
AT 230,50
print "Red"
AT 230,70
print "Block"
AT 230,120
print "To"
AT 230,170
print "Lower"
AT 230,190
print "Center"
f1=0:f2=1
for I=1 to M:for J=1 to N
y=I*40:x=J*40
RECT x,y,x+40,y+40,c(a(I,J)) FILLED
next J:next I

15'
while pen(0)=0:wend
CX=PEN(4):CY=PEN(5)
if CX>35 and CX<80 and CY>256 and CY<277 then END
if CX>152 and CX<202 and CY>260 and CY<280 then goto 5
TX=CX:TY=CY
J=INT(CX/40):I=INT(CY/40)
p=a(I,J):if p=15 then 15

'while pen(0) =0:wend
while pen(0)
CX=PEN(4):CY=PEN(5)
wend
DX=ABS(CX-TX):DY=ABS(CY-TY)
IF (DX>DY) THEN
    IF (CX>TX) THEN
    de$="r"
    else
    de$="l"
    ENDIF
ENDIF
IF (DY>DX) THEN
    IF (CY>TY) THEN
    de$="d"
    else
    de$="u"
    ENDIF
ENDIF
'while pen(3):wend
IF de$="r" THEN GOSUB 200:IF (f1*f2) = 1 THEN GOSUB 300
IF de$="l" THEN GOSUB 400:IF (f1*f2) = 1 THEN GOSUB 500
IF de$="d" THEN GOSUB 600:IF (f1*f2) = 1 THEN GOSUB 700
IF de$="u" THEN GOSUB 800:IF (f1*f2) = 1 THEN GOSUB 900
GOTO 10

200 ' Empty to the right ?
     O=N-1
    FOR I = 1 TO M
    FOR J = 1 TO O
    if (a(I,J)= P) AND (a(I,J+1)=15)THEN
     f1 = 1
    endif
    if (a(I,J)= P) AND (a(I,J+1)<>15) AND (a(I,J+1)<>P )THEN
    f2 = 0
     endif
if a(I,N)=P then  f2 = 0     
    NEXT J
    NEXT I
RETURN

300 ' Movement to the right
O = N-1
        FOR I= 1 TO M:FOR J=O TO 1 STEP -1
        IF a(I,J)=P THEN
        a(I,J+1)=P
        IF a(I,J-1)=P THEN a(I,J)=P ELSE a(I,J)=15
     endif
    NEXT J
    NEXT I
RETURN

400 ' Empty to the left ?
    FOR I=1 TO M:FOR J=2 TO N
    IF (a(I,J)= P) AND (a(I,J-1)=15) THEN f1 = 1
    IF (a(I,J)= P) AND (a(I,J-1)<>15) AND (a(I,J-1)<>P) THEN f2 = 0
    IF a(I,1)=P then f2 = 0
    NEXT J
    NEXT I
RETURN

500 ' Movement to left
      FOR I= 1 TO M:FOR J=1 TO N
      IF a(I,J)=P AND J>1 THEN
      a(I,J-1)=P
      IF a(I,J+1)=P THEN a(I,J)=P ELSE a(I,J)=15
      ENDIF 
    NEXT J
    NEXT I
RETURN

600 ' Empy below ?
    O = M-1
    FOR I=1 TO O:FOR J=1 TO N
    IF (a(I,J)= P) AND (a(I+1,J)=15) THEN f1 = 1
    IF (a(I,J)= P) AND (a(I+1,J)<>15) AND (a(I+1,J)<>P) THEN f2 = 0
    IF a(M,J)=P then f2 = 0
    NEXT J
    NEXT I
RETURN

700 '  Movement down
O = M-1
    FOR I = O TO 1 STEP -1:FOR J=1 TO N
      IF a(I,J)=P THEN
      a(I+1,J)=P
      IF a(I-1,J)=P THEN a(I,J)=P ELSE a(I,J)=15
      ENDIF
    NEXT J
    NEXT I
RETURN

800 '  Empty up ?
    FOR I=2 TO M:FOR J=1 TO N
    IF (a(I,J)= P) AND (a(I-1,J)=15) THEN f1 = 1
    IF (a(I,J)= P) AND (a(I-1,J)<>15) AND (a(I-1,J)<>P) THEN f2 = 0
    IF a(1,J)=P then f2 = 0
    NEXT J
    NEXT I
RETURN

900 '  Movement up
    FOR I = 2 TO M:FOR J=1 TO N
      IF a(I,J)=P THEN
      a(I-1,J)=P
      IF a(I+1,J)=P THEN a(I,J)=P ELSE a(I,J)=15
    ENDIF
    NEXT J
    NEXT I
RETURN