REM ICE & FIRE BY CCLX33 v1.1

GLOBAL MAN,DIRX,fall,FIRE,LICE,MICE,RICE,ICE,BICE,FIRES
DIM GLOBAL MAP(10,10), LVL$(90)


REM CONST
FIRE=1
MAN=2
BOTTLE=3
WALL=4
LICE=5
MICE=6
RICE=7
ICE=8
BICE=9
FBOTTLE=10
VTUBE=11
HTUBE=12
LUTUBE=13
LDTUBE=14
RUTUBE=15
RDTUBE=16

MAPH=9
MAPW=9

GAMEPAD 1
PAUSE OFF



INTRO:
TEXT 0,13,"BTN  :MAKE/BREAK ICE"
TEXT 0,14,"PAUSE:SELECT LEVEL"
TEXT 0,15,"INPUT A,N OR NUMBER"


GOSUB READLEVEL
LEVEL=1


RESTART:
IF LEVEL<1 THEN LEVEL=1
IF LEVEL>MAXLEVEL THEN LEVEL=MAXLEVEL
GOSUB DRAWLEVEL
WAIT 10

DO
  IF PAUSE THEN GOTO SELECTLVL
  IF BUTTON TAP(0,1) THEN 
    XA=1
    DIRX=XA
    CALL DRAW(MANX,MANY,MAN)
    GOSUB CHANGE
  ELSE IF BUTTON TAP(0,0) THEN
    XA=-1
    DIRX=XA
    CALL DRAW(MANX,MANY,MAN)
    GOSUB CHANGE
  END IF
  IF LEFT TAP(0) THEN
    XA=-1
    DIRX=XA
    GOSUB WALK
  ELSE IF RIGHT TAP(0) THEN
    XA=1
    DIRX=XA
    GOSUB WALK
  ELSE IF UP TAP(0) THEN
    TUBEDIR=1
    GOSUB UPTUBE
  ELSE IF DOWN TAP(0) THEN
    TUBEDIR=3
    GOSUB DOWNTUBE
  END IF
  IF FALL=1 THEN GOSUB FALL
  IF FIRES=0 THEN GOTO WIN
  IF DEAD=1 THEN GOTO DEAD
  WAIT 1
LOOP



LEVELUP:
LEVEL=LEVEL+1
GOTO RESTART



SELECTLVL:
PAUSE OFF
LOCATE 9,0
INPUT A$
KEYBOARD OFF
IF A$="A" OR A$="" THEN GOTO RESTART
IF A$="N" or a$=" " THEN GOTO LEVELUP
LEVEL=VAL(A$)
GOTO RESTART



CHANGE:
X=MANX+XA
Y=MANY+1
V1=MAP(x,y)
IF V1=0 THEN GOTO MAKEICE
' cut ice if link
IF V1>=LICE AND V1<=ICE THEN call sep(x,y)
RETURN


MAKEICE:
' make ice at (x,y)
' on firejar can't make ice
IF MAP(X,Y+1)=FBOTTLE THEN RETURN
VL=MAP(X-1,Y)
VR=MAP(X+1,Y)
' decide ice shape
PIC=MICE+(VR>2)-(VL>2)
CALL DRAW(X,Y,PIC)
' change left right ice shape
IF VL=RICE THEN CALL DRAW(X-1,Y,MICE)
IF VL=ICE THEN CALL DRAW(X-1,Y,LICE)
IF VR=LICE THEN CALL DRAW(X+1,Y,MICE)
IF VR=ICE THEN CALL DRAW(X+1,Y,RICE)
RETURN


sub sep(x,y)
 CALL DRAW(X,Y,0)
 VL=MAP(X-1,Y)
 VR=MAP(X+1,Y)
 ' change left right ice shape
 IF VL=MICE THEN CALL DRAW(X-1,Y,RICE)
 IF VL=LICE THEN CALL DRAW(X-1,Y,ICE)
 IF VR=MICE THEN CALL DRAW(X+1,Y,LICE)
 IF VR=RICE THEN CALL DRAW(X+1,Y,ICE)
 FALL=1
end sub


FALL:
FALL=0
FOR YD=MAPH-1 TO 1 STEP -1
  FOR XD=1 TO MAPW
    V=MAP(XD,YD)
    IF V>0 THEN
      X=XD
      Y=YD
      IF V=FIRE THEN GOSUB FIREFALL
      IF V=ICE THEN GOSUB ICEFALL
      IF V=BICE THEN GOSUB BLACKFALL
      IF V=LICE THEN GOSUB BLOCKSFALL
      IF V=MAN THEN GOSUB MANFALL
    END IF
  NEXT XD
NEXT YD
IF FALL=1 THEN GOTO FALL
RETURN


FIREFALL:
DO
  BELOW=MAP(X,Y+1)
  IF BELOW=BOTTLE THEN
    CALL DRAW(X,Y+1,FBOTTLE)
    RETURN
  END IF
  IF BELOW>0 THEN RETURN
  CALL DRAW(X,Y,0)
  Y=Y+1
  CALL DRAW(X,Y,FIRE)
  WAIT 3
LOOP


BLACKFALL:
VR=MAP(XD+1,YD)
' if link
IF VR=MICE OR VR=RICE THEN GOTO BLOCKSFALL


ICEFALL:
BELOW=MAP(X,Y+1)
IF BELOW=FBOTTLE AND V=ICE THEN
  CALL DRAW(X,Y,0)
  RETURN
END IF
IF BELOW>FIRE THEN RETURN
CALL DRAW(X,Y,0)
Y=Y+1
IF BELOW=FIRE THEN
  call FLASHF(x,y)
  IF V=ICE THEN RETURN
END IF
CALL DRAW(X,Y,V)
WAIT 3
GOTO ICEFALL


sub flashf(x,y)
 FIRES=FIRES-1
 FOR F=1 TO 2
   CALL DRAW(X,Y,FIRE)
   WAIT 2
   CALL DRAW(X,Y,ICE)
   WAIT 2
 NEXT F
 CALL DRAW(X,Y,0)
end sub



BLOCKSFALL:
' conut length
N=1
REPEAT
  VN=MAP(XD+N,YD)
  if vn=RICE then goto ending
  if vn<>Mice AND vn<>bice then return
  if vn=bice then
    VN1=MAP(XD+N+1,YD)
    if vn1<>RICE AND VN1<>MICE then GOTO ENDING
  end if
  N=N+1
UNTIL XD+N>MAPW
XD=MAPW
RETURN

ENDING:
FOR I=0 TO N
  IF MAP(XD+I,YD+1)=FBOTTLE AND MAP(XD+I,YD)<>BICE THEN call sep(xd+i,yd)
NEXT I

for i=0 to n
  IF MAP(XD+I,YD+1)>FIRE THEN
    XD=XD+N
    RETURN
  END IF
next i

FALL=1

FOR I=0 TO N
  IF MAP(XD+I,YD+1)=FIRE THEN
    IF MAP(XD+I,YD)<>BICE THEN call sep(xd+i,yd)
    call FLASHF(XD+I,YD+1)
  END IF
NEXT I

FOR I=0 TO N
  X=XD+I
  VI=MAP(X,YD)
  IF VI<>0 THEN
    CALL DRAW(X,YD,0)
    CALL DRAW(X,YD+1,VI)
  END IF
NEXT I
XD=XD+N
WAIT 3
RETURN



DEAD:
LOCATE 6,8
PRINT "DEAD"
WAIT 60
GOTO RESTART



WALK:
V1=MAP(MANX+XA,MANY)
VU=MAP(MANX,MANY-1)
U1=MAP(MANX+XA,MANY-1)
IF V1=0 THEN GOTO MOVE
IF V1=HTUBE THEN GOTO TUBE
IF XA=1 AND (V1=LUTUBE OR V1=LDTUBE) THEN GOTO TUBE
IF XA=-1 AND (V1=RUTUBE OR V1=RDTUBE) THEN GOTO TUBE
'IF V1=HTUBE or V1=LUTUBE+1-XA OR V1=LDTUBE+1-XA THEN GOTO TUBE
IF V1=ICE OR V1=BICE THEN
  V2=MAP(MANX+XA+XA,MANY)
  IF V2=0 OR V2=FIRE THEN GOTO PUSH
END IF
IF V1=FIRE THEN RETURN
'IF VU=0 AND (u1=HTUBE or u1=LUTUBE+1-XA OR u1=LDTUBE+1-XA) THEN
IF VU=0 AND (u1=HTUBE or u1=LUTUBE+1-XA) THEN
  CALL DRAW(MANX,MANY,0)
  X=MANX+XA
  IF XA=1 THEN TUBEDIR=2 ELSE TUBEDIR=4
  y=many-1
  v1=u1
  GOTO TUBE1
end if
IF VU=0 AND U1=0 and V1<>FBOTTLE THEN GOTO UP1
RETURN


UP1:
  CALL DRAW(MANX,MANY,0)
  MANX=MANX+XA
  MANY=MANY-1
  CALL DRAW(MANX,MANY,MAN)
'  IF U1=FIRE OR V1=FBOTTLE THEN DEAD=1
'  IF V1=FBOTTLE THEN DEAD=1
RETURN



MOVE:
CALL DRAW(MANX,MANY,0)
MANX=MANX+XA
CALL DRAW(MANX,MANY,MAN)


THRUEND:
VD=MAP(MANX,MANY+1)
IF V1=FIRE OR VD=FBOTTLE or vd=fire THEN DEAD=1
IF VD=0 THEN GOSUB MANFALL
IF (VU>=LICE AND VU<=BICE) or vu=fire THEN FALL=1
RETURN


PUSH:
CALL DRAW(MANX,MANY,MAN)
FALL=1
X=MANX+XA
Y=MANY

DO
  IF V2>FIRE THEN
    CALL DRAW(X,Y,V1)
    RETURN
  END IF
  CALL DRAW(X,Y,0)
  X=X+XA
  IF V2=FIRE THEN
    call FLASHF(x,y)
    IF V1=ICE THEN RETURN
  END IF
  CALL DRAW(X,Y,V1)
  WAIT 3
  D1=MAP(X,Y+1)
  IF D1=0 OR D1=FIRE or D1=FBOTTLE THEN RETURN
  IF V1=BICE AND (D1<LICE OR D1>ICE) THEN RETURN
'  IF D1=FBOTTLE AND V1=ICE THEN
'    CALL DRAW(X,Y,0)
'    RETURN
'  END IF
  V2=MAP(X+XA,Y)
LOOP



MANFALL:
VD=MAP(MANX,MANY+1)
IF VD=FIRE OR VD=FBOTTLE THEN DEAD=1
IF VD>FIRE THEN RETURN
CALL DRAW(MANX,MANY,0)
MANY=MANY+1
CALL DRAW(MANX,MANY,MAN)
wait 4
GOTO MANFALL



WIN:
TEXT 6,8," GOOD "
WAIT 60
GOTO LEVELUP




UPTUBE:
VU=MAP(MANX,MANY-1)
IF VU=VTUBE OR VU=LDTUBE OR VU=RDTUBE THEN GOTO MOVEV
RETURN


DOWNTUBE:
VD=MAP(MANX,MANY+1)
IF VD=VTUBE OR VD=LUTUBE OR VD=RUTUBE THEN GOTO MOVEV
RETURN


MOVEV:
CALL DRAW(MANX,MANY,0)
X=MANX
Y=MANY+(TUBEDIR-2)
V1=MAP(X,Y)
GOTO TUBE1



TUBE:
CALL DRAW(MANX,MANY,0)
Y=MANY
X=MANX+XA
IF XA=1 THEN TUBEDIR=2 ELSE TUBEDIR=4


TUBE1:
IF V1=0 THEN
' out tube
  MANX=X
  MANY=Y
  CALL DRAW(MANX,MANY,MAN)
  GOTO THRUEND
END IF
' tube end 
IF V1<VTUBE THEN
  CALL DRAW(MANX,MANY,MAN)
  if xa<>0 then
    IF VU=0 AND U1=0 THEN GOTO UP1
  end if
  RETURN
END IF

V1=MAP(X,Y)
IF TUBEDIR=2 THEN
  TUBEDIR=-(V1=LUTUBE)-(V1=HTUBE)*2-(V1=LDTUBE)*3
ELSE IF TUBEDIR=3 THEN
  TUBEDIR=-(V1=VTUBE)*3-(V1=LUTUBE)*4-(V1=RUTUBE)*2
ELSE IF TUBEDIR=4 THEN
  TUBEDIR=-(V1=HTUBE)*4-(V1=RUTUBE)-(V1=RDTUBE)*3
ELSE
  TUBEDIR=-(V1=VTUBE)-(V1=LDTUBE)*4-(V1=RDTUBE)*2
END IF
IF TUBEDIR=0 THEN
  V1=SGN(V1)
ELSE
  X=X+(TUBEDIR=4)-(TUBEDIR=2)
  Y=Y+(TUBEDIR=1)-(TUBEDIR=3)
END IF
GOTO TUBE1



DRAWLEVEL:
'CLS
LOCATE 3,0
PRINT "LEVEL=";LEVEL
FIRES=0
WIN=0
DEAD=0
FALL=1
DIRX=1
XA=1

L$=LVL$(LEVEL)
I=1
FOR Y=1 TO MAPH
  FOR X=1 TO MAPW
    B$=MID$(L$,I,1)
    V=INSTR("123456789ABCDEFG",B$)
    MAP(X,Y)=V
    IF V=FIRE THEN FIRES=FIRES+1
    IF Y>0 THEN CALL DRAW(X,Y,V)
    IF V=MAN THEN
      MANX=X
      MANY=Y
      MAP(X,Y)=0
    END IF
    IF B$<>"\" AND B$<>"#" THEN I=I+1
  NEXT X
  IF B$<>"#" THEN I=I+1
NEXT Y

BORDER:
FOR Y=1 TO MAPH
  CALL DRAW(0,Y,WALL)
  CALL DRAW(MAPW+1,Y,WALL)
NEXT Y
FOR X=0 TO MAPW+1
  CALL DRAW(X,0,WALL)
  CALL DRAW(X,MAPH+1,WALL)
NEXT X
RETURN




SUB DRAW(X,Y,A)
  MAP(X,Y)=A
  C=VAL(MID$("03431000003222222",A+1,1))
  IF A=MAN AND DIRX=-1 THEN ATTR(,1)
  ATTR(C,)
  CELL X+3,Y+1,A
  ATTR(0,0)
END  SUB


READLEVEL:
MAXLEVEL=90
FOR I=1 TO 90
  READ LVL$(I)
  IF LVL$(I)="" THEN
    MAXLEVEL=I-1
    I=90
  END IF
NEXT I
RETURN



' test
'data "\0008\0d0g\24440081\444444444#"
'data "\10008\b000b\fc20d\44444\\18\#"
'data "\00008\b0c0b\fc20d\44444\\18\#"
'data "\\\0092819\4a4444a\44#"
'data "\\\0082818\4a4444a\44#"
'data "\\\2818\444a#"
'data "\\b000b\f020d\44444\\18\#"
'data "\\b000b\d020f\44444\\18\#"
'data "\\\g020e\b444b\\18\#"
'data "\\\d020f\44444\\18\#"
'DATA "\2566678\7000004\4\00010011\40040044\#"
'DATA "\2569678\7000004\4\00010011\40040044\#"
'DATA "\2566678\7000004\4\004A0011\40040044\#"
'DATA "\2569678\7000004\4\000A0011\40040044\#"


DATA "\\0010802\044444444\\08\0801\0801\444441\"
DATA "\\\\\2\467\\001\"
DATA "\\\\\000445667\00004081\20404081\444000811\"
DATA "\0118\05664\000040044\111044\4444444\090000004\28110004\66670814\"
DATA "\\\\00000GC\0000CD666\4400014\204004\8000041\"
DATA "\\\\00004\00004\00041\0046702\0000004\"
REM -----LEVEL 6-------
DATA "\\\\0208\0447044\08001\44644\0414\"
DATA "\\\\\2\4644\00040044\18040001\"
DATA "\\\\\\2004\4404\0014\"
DATA "\\\\\004\204\4\40111\"
DATA "0004\8204\440100044\4404004\440004\440004\44444\0\0\"
REM -----LEVEL 11-------
DATA "0\0\0\0\0\0\402414\0040804\00008\"
DATA "0\0\0\0\0\04244\008004444\444704\4441081\"
DATA "0\0\0\0\028\054\7\044040444\08001\"
DATA "0\0\0\0\0\0\0402444\00081\00144\"
DATA "0\0\0\0\0\204\4\4104\4414\"
REM -----LEVEL 16-------
DATA "0\0\0\0\0028\0044004\B40000104\FC04004B\004110CD\"
DATA "0\0\0\0\0\0\0\42404\1808\"
DATA "0\0\4024\00564\B4004\B00104\B666B\B100B\FC0CD\"
DATA "0\0\0\0\0\004204\0108004\04440444\000001\"
DATA "0\0\0004\00041\20005B\44000B\40040B\0040004\0000004\"
REM -----LEVEL 21-------
DATA "0\0\0\0\0\0\04002441\0040C667\08144\"
DATA "0\0\0\00001\21047\47\0\03043\003\"
DATA "0\000001\000057\00057\00081\105667\5672\05671\005671\"
DATA "0\0\0\0121\0547\0\0\0\0343\"
DATA "0\0\0\0\0\021\B470A\B008004\003644\"
REM -----LEVEL 26-------
DATA "0\0\0\20A57\B4667\0\44\0000A\00AA01\"
DATA "0\0\0\GCCCCCCCE\B0000000B\B01004A1\204400054\4\4444444A\"
DATA "0\0\0\0\211\B666B\B\B630B\FCCCD\"
DATA "0\0\0\0\0004\000024A\00044\0\A44411\"
DATA "0\0\0\0\0\4\44201\444048444\0010081\"
REM -----LEVEL 31-------
DATA "0\0\0\0\0012\04664B\04004B\05667B\0444\"
DATA "0\0\0\0\0\402\004404\000004\144104\"
DATA "0\0\0\0\092\054004\10004\40014\0A44\"
DATA "0\0\1001\5667\1021\5667\1881\5667\1881\"
DATA "0\0\0\0\0\0\200440444\6964\41418\"
REM -----LEVEL 36-------
DATA "0\0\0\0\0\0002A\0047\1000901\4400444\"
DATA "0\0\0\29154\4664\1\400A\0A\00A\"
DATA "0\0\0\0\0\4440001\0004004\7090192\4666666AA\"
DATA "0\0\0\0\0\42\4666664\019101\144A44\"
DATA "0\0\0\4402\1004\A0014\400A\414\0A\"
REM -----LEVEL 41-------
DATA "0\0\0\0\0\00404\4666672\4004444\4104\"
DATA "0\0\0\0\0\0\0\20444404\40570571\"
DATA "0\0\0\0\0\420444\04100014\0041014\000414\"
DATA "0\0\0\0\440004\440024005\4104647\410004005\41040004\"
DATA "0\0\0\0\2\6666664\0111904\66AA44\1\"
REM -----LEVEL 46-------
DATA "0\009\009\009\029\46644004\0004004\040004\000001\"
DATA "0\0\1004\440124\0405B\0400B\1400B\110004\44434\"
DATA "0\0\0\0\0004\2054\7\664440404\00141\"
DATA "0\0\000024\05664\0004\4014\404\1004\404\"
DATA "0\0\0\111204\66664\0004\0004\404\1004\"

DATA ""


#1:MAIN PALETTES
053F2F000038340000280C00003C3830
003D0301003F2A15003F2A15003F2A15

#2:MAIN CHARACTERS
00000000000000000000000000000000
12483E2A7F5D633E00083E3663637F3E
3C7E7E5E2030003600000A205E4E7E36
000000000000000081428181818181FF
FF6060FFFF0606FF20BFBFFF02FBFBFF
003F6F5F7F7F3F007FC090A08080C07F
00FFEFDFFFFFFF00FF001020000000FF
00FCEEDEFEFEFC00FE031121010103FE
003C6E5E7E7E3C007EC391A18181C37E
003C6E5E7E7E3C007EFFFFFFFFFFFF7E
1428183C3C241800814A99A5A5BD99FF
C3C3C3C3C3C3C3C3BDBDBDBDBDBDBDBD
FFFF00000000FFFFFF00FFFFFFFF00FF
C3C30307071FFFFEBD3DFDFDFDF903FE
FEFF1F070703C3C3FE03F9FDFDFD3DBD
C3C3C0E0E0F8FF7FBDBCBFBFBF9FC07F
7FFFF8E0E0C0C3C37FC09FBFBFBFBCBD