← Back to contents
ISO-8859 text
— 8K bytes
— 1991-02-24
— PP20 compressed
REM $OPTION Y+,k150
'
' Gribit by Alan Mead
'
' Copyright © 1990 Amiga Computing
'
Gribit:
SCREEN 2,320,200,4,1
WINDOW 2,"GRIBIT, © 1990 Amiga Computing ",(0,0)-(311,185),16+128,2
DEFINT a-z
DEFLNG s,h
buffs = 198
buffc = 134
hiscore=0
life=3
FOR cl=1 TO 4
MENU cl,0,0,""
NEXT
i$ = ".info"
vol = 127
DIM temp%(66)
DIM anim%(14,66)
DIM y%(9)
DIM x%(17)
DIM array%(17,10)
DIM ctemp%(30)
DIM cur%(15,30)
DIM cy%(15)
DIM cx%(15)
d=0
FOR y=23 TO 143 STEP 8
cy%(d)=y
d=d+1
NEXT
d=0
FOR x=126 TO 246 STEP 8
cx%(d)=x
d=d+1
NEXT
FOR y=0 TO 9
y%(y)=(y*17)+17
NEXT
FOR x=0 TO 17
x%(x)=x*17
NEXT
GOSUB cols
GOSUB aload
ob=7
options:
REM $EVENT OFF
GOSUB nopoint
score = 0
scrn = 0
WINDOW CLOSE 3
WINDOW 2
FOR cl=1 TO 4
MENU cl,0,0,""
NEXT
op2:
CLS
n$="t1":GOSUB fetch
LOCATE 1,12
PRINT "OPTIONS"
LOCATE 6,7
PRINT "Press key"
LOCATE 8,7
PRINT "G to play Game"
LOCATE 10,7
PRINT "S to edit Screens"
LOCATE 12,7
PRINT "C to edit Characters"
LOCATE 14,7
PRINT "I for Instructions"
LOCATE 16,7
PRINT "Q to Quit"
kloop:
a$=INKEY$
a$=UCASE$(a$)
IF a$="G" THEN GOTO game
IF a$="S" THEN GOTO screened
IF a$="C" THEN GOTO spriteed
IF a$="I" THEN GOTO ins
IF a$="Q" THEN CLS:GOSUB apoint:MENU RESET:WINDOW CLOSE 2:END
GOTO kloop
ins:
CLS
n$="border":GOSUB fetch
LOCATE 1,10
PRINT "INSTRUCTIONS"
LOCATE 6,5
PRINT "Controls"
LOCATE 7,5
PRINT "Mouse 1 for Editors"
LOCATE 8,5
PRINT "Joy 2 for game"
LOCATE 10,5
PRINT "Collect all Mushrooms"
LOCATE 11,5
PRINT "to complete screens "
LOCATE 13,5
PRINT "Fire to blow bubbles"
LOCATE 15,5
PRINT "Keys open doors"
LOCATE 18,5
PRINT "Spacebar to continue"
wm:
a$ = INKEY$
IF a$ <>" " THEN GOTO wm
GOTO op2
screened:
REM $EVENT ON
GOSUB apoint
IF ob >7 THEN ob =7
GOSUB wipe
MENU 1,0,1,"Project "
MENU 1,1,1,"Clear Screen"
MENU 1,2,1,"Options "
MENU 2,0,1," Load "
mn = 2:GOSUB menset
MENU 3,0,1," Save "
mn = 3:GOSUB menset
ON MENU GOSUB choice
MENU ON
x=0:y=0:x1=0:y1=0:f=10:frog=0
dslop:
m=MOUSE(0)
IF m<>0 THEN GOTO dslop
move:
a$ = INKEY$
w=MOUSE(0)
x=INT(MOUSE(1)/17)
y=INT(MOUSE(2)/17)-1
IF y < 0 THEN y=0:GOSUB supdate
IF x < 0 THEN x = 0
IF x > 17 THEN x = 17
IF y > 9 THEN y = 9
IF (w <> 0) OR (a$=" ") THEN
IF y=0 THEN GOTO move
IF x=0 THEN GOTO move
IF y=9 THEN GOTO move
IF x=17 THEN GOTO move
IF x%(x)=frogx THEN
IF y%(y)=frogy THEN frog=0
END IF
IF ob = 8 THEN
IF frog = 1 THEN GOSUB warn
IF frog = 0 THEN
fob=array%(x,y)
PUT (x%(x),y%(y)),anim%(ob,0),PSET:frog =1
frogx =x%(x):frogy =y%(y)
array%(x,y)=ob
END IF
END IF
IF ob <> 8 THEN
array%(x,y)=ob
PUT (x%(x),y%(y)),anim%(ob,0),PSET
END IF
END IF
GOTO move
supdate:
w = MOUSE(0)
IF (w <>0) OR (a$ = " ") THEN
obx=INT(MOUSE(1)/20)
IF obx <0 THEN RETURN
IF obx >8 THEN RETURN
ob=obx
END IF
PUT (x%(17),y%(0)-17),anim%(ob,0),PSET
RETURN
warn:
WINDOW 3,"Warning",(0,0)-(311,24),8+128,2
LOCATE 2,1
PRINT "One Frog completes each screen."
winch:
win=WINDOW(7)
IF win <>0 then GOTO winch
WINDOW OUTPUT 2
RETURN
menset:
s$="Screen "
FOR men = 1 TO 18
sn$=CHR$(64+men)
sc$=s$+sn$
MENU mn,men,1,sc$
NEXT
RETURN
choice:
id=MENU(0)
IF id = 2 THEN GOTO m2
IF id = 3 THEN GOTO m3
IF MENU(1)=1 THEN GOSUB wipe:RETURN
IF MENU(1)=2 THEN MENU STOP:GOTO options
m2:
scc=(MENU(1)+9)
x$=STR$(scc)
n$=RIGHT$(x$,2)
GOSUB fetch
LOCATE 1,21
PRINT "Screen ";CHR$(scc+55);
RETURN
m3:
scc=(MENU(1)+9)
x$=STR$(scc)
n$=RIGHT$(x$,2)
GOSUB store
LOCATE 1,21
PRINT "Screen ";CHR$(scc+55);
RETURN
wipe:
frog=0
CLS
n$="border"
GOSUB fetch
LOCATE 1,21
PRINT "Screen ";
pob:
FOR pz = 0 TO 8
PUT (x%(pz)+(pz*3),y%(0)-17),anim%(pz,0),PSET
NEXT
PUT (x%(17),y%(0)-17),anim%(ob,0),PSET
RETURN
store:
IF frog=0 THEN
GOSUB warn
RETURN
END IF
GOSUB black
OPEN n$ FOR OUTPUT AS 1 LEN=buffs
FOR dx=0 TO 17
FOR dy=0 TO 9
d=array%(dx,dy)
PRINT #1,MKI$ (d);
NEXT
NEXT
CLOSE 1
d$ = n$+i$
KILL d$
GOSUB cols
RETURN
fetch:
GOSUB black
dime = 0
OPEN n$ FOR INPUT AS 1 LEN=buffs
FOR dx=0 TO 17
FOR dy=0 TO 9
array%(dx,dy)=CVI(INPUT$(2,1))
IF array%(dx,dy)=8 THEN
frogx=x%(dx)
frogy=y%(dy)
x=dx
y=dy
frog=1
END IF
IF array%(dx,dy)=2 THEN dime = dime +1
NEXT
NEXT
CLOSE 1
GOSUB refresh
GOSUB cols
RETURN
refresh:
FOR dx=1 TO 16
d=array%(dx,0)
PUT (x%(dx),y%(0)),anim%(d,0),PSET
NEXT
FOR dy=0 TO 9 STEP 1
d=array%(17,dy)
PUT (x%(17),y%(dy)),anim%(d,0),PSET
NEXT
FOR dx=16 TO 1 STEP -1
d=array%(dx,0)
PUT (x%(dx),y%(9)),anim%(d,0),PSET
NEXT
FOR dy=9 TO 0 STEP -1
d=array%(0,dy)
PUT (x%(0),y%(dy)),anim%(d,0),PSET
NEXT
dy=8
rloop:
FOR dx=1 TO 16
d=array%(dx,dy)
PUT (x%(dx),y%(dy)),anim%(d,0),PSET
NEXT
dy=dy-1
FOR dx=16 TO 1 STEP -1
d=array%(dx,dy)
PUT (x%(dx),y%(dy)),anim%(d,0),PSET
NEXT
dy=dy-1
IF dy = 0 THEN RETURN
GOTO rloop
ok:
FOR d= 1 TO 10
SOUND d*50,1,vol,1
for del = 1 to 1000:NEXT
NEXT
RETURN
aload:
LOCATE 2,2
PRINT "Loading Sprites"
s1$="sp"
FOR i = 1 to 14
si$=STR$(i)
ls=LEN(si$)-1
s2$=RIGHT$(si$,ls)
n$=s1$+s2$
n=i-1
GOSUB nload
NEXT
LOCATE 2,2
PRINT " "
RETURN
nload:
OPEN n$ FOR INPUT AS 1 LEN=buffc
FOR d=0 TO 66
anim%(n,d)=CVI(INPUT$(2,1))
NEXT d
CLOSE 1
RETURN
black:
FOR col = 2 TO 15
PALETTE col,0,0,0
NEXT
RETURN
cols:
PALETTE 0,0,0,0 :REM black
PALETTE 1,1,.5,0 :REM brown
PALETTE 2,0,1,0 :REM green
PALETTE 3,1,.73,0 :REM yellow
PALETTE 4,1,1,.13 :REM yellow
PALETTE 5,1,.13,.93 :REM violet
PALETTE 6,.8,0,.9 :REM purple
PALETTE 7,.25,.25,1 :REM blue
PALETTE 8,.2,.2,.75 :REM blue
PALETTE 9,.15,.15,.5 :REM blue
PALETTE 10,1,0,0 :REM red
PALETTE 11,.6,0,0 :REM red
PALETTE 12,.4,0,0 :REM red
PALETTE 13,.4,.4,.4 :REM white
PALETTE 14,.6,.6,.6 :REM white
PALETTE 15,1,1,1 :REM white
GOSUB ok
RETURN
spriteed:
REM $EVENT ON
GOSUB apoint
GOSUB black
c=7:e=1:s=0:del=500:sy=0:sx=0:y1=95:x1=18
sh0=0:mx=126:mxt=mx:fl=1
GOSUB curser
CLS
GOSUB grid
c=1:i=2
FOR y=31 TO 135 STEP 8
PUT (270,y),cur%(i,0),PSET
i=i+1
NEXT y
i=6
PUT (270,151),cur%(i,0),PSET
x=126:y=23:yn=115:xn=18:sh0=4
MENU 1,0,1,"Project "
MENU 1,1,1,"Restore "
MENU 1,2,1,"Save All"
MENU 1,3,1,"Options"
MENU 2,0,1,"Change"
MENU 2,1,1,"Fill "
MENU 2,2,1,"Erase "
MENU 2,3,1,"X Flip"
MENU 2,4,1,"Y Flip"
MENU 2,5,1,"Rotate"
MENU 3,0,1,"Scroll"
MENU 3,1,1,"Up "
MENU 3,2,1,"Down "
MENU 3,3,1,"Left "
MENU 3,4,1,"Right "
MENU 4,0,1,"Copy"
MENU 4,1,1,"Copy To"
ON MENU GOSUB cselect
MENU ON
GOSUB place
GOSUB cols
ob = 0
nob = ob:cb = 1:GOSUB obox
GOSUB update
mslop:
m=MOUSE(0)
IF m<>0 THEN GOTO mslop
cmove:
a$=INKEY$
m=MOUSE(0)
xm=MOUSE(1)-7
ym=MOUSE(2)-7
IF (ym+7) > y%(9) THEN GOSUB gupdate
IF xm>260 THEN GOSUB colour
L=0
IF xm<121 THEN xm=121:L=1
IF xm>247 THEN xm=247:L=1
IF ym<16 THEN ym=16:L=1
IF ym>143 THEN ym=143:L=1
IF L=1 THEN GOTO cmove
xd=INT(xm/8)
yd=INT(ym/8)
x=cx%(xd-15)
y=cy%(yd-2)
px=(x%(ob)+(xd+4)+(ob*3)-16):py=(y%(9)+(yd-2))
IF (m <> 0) OR (a$=" ") THEN GOSUB set
GOTO cmove
set:
PSET (px,py),i
PSET (50+xd,50+yd),i
PUT (x,y),cur%(i,0),PSET
RETURN
colour:
IF MOUSE(1)>279 THEN RETURN
IF ( m <> 0 ) OR ( a$ = " " ) THEN i=POINT(MOUSE(1)-2,MOUSE(2))
IF i<0 THEN RETURN
IF i>15 THEN RETURN
PUT (270,151),cur%(i,0),PSET
RETURN
gupdate:
olob = ob
IF ( m = 1 ) OR ( a$ = " " ) THEN
ob = INT(MOUSE(1)/20)
IF ob <0 THEN ob = olob:RETURN
IF ob >13 THEN ob = olob:RETURN
nob = olob:cb = 0:GOSUB obox
nob = ob:cb = 1:GOSUB obox
GOSUB update
END IF
RETURN
ccopy:
GOSUB tpoint
copl:
a$=INKEY$
mc=MOUSE(0)
cxm=MOUSE(1)-7
cym=MOUSE(2)-7
IF ( mc = 1 ) OR ( a$ = " " ) THEN GOTO copy
GOTO ccopy
copy:
olob = ob
IF (cym+7) > y%(9) THEN
ob = INT(MOUSE(1)/20)
IF ob <0 THEN ob = olob:GOTO apoint
IF ob >13 THEN ob = olob:GOTO apoint
GOSUB downdate
END IF
GOTO apoint
downdate:
nob = olob:cb = 0:GOSUB obox
nob = ob:cb = 1:GOSUB obox
GET (65,52)-(80,67),anim%(ob,0)
PUT (x%(ob)+(ob*3)+3,y%(9)),anim%(ob,0),PSET
GOSUB ok
RETURN
obox:
tx = x%(nob)+(nob*3)+1
ty = y%(9)-2
bx = tx + 19
by = ty + 19
LINE (tx,ty)-(bx,by),cb,b
RETURN
lay:
FOR n=0 TO 13
GET (x%(n)+(n*3)+3,y%(9))-(x%(n)+(n*3)+18,y%(9)+15),anim%(n,0)
NEXT
RETURN
place:
FOR pz = 0 TO 13
PUT (x%(pz)+(pz*3)+3,y%(9)),anim%(pz,0),PSET
NEXT
RETURN
cselect:
me=MENU(0)
IF me=2 THEN GOTO two
IF me=3 THEN GOTO three
IF me=4 THEN GOTO four
IF MENU(1)=1 THEN GOTO creset
IF MENU(1)=2 THEN GOTO csave
IF MENU(1)=3 THEN GOSUB lay:GOTO options
IF MENU(1)=4 THEN CLS:MENU RESET:END
two:
IF MENU(1)=1 THEN GOTO fill
IF MENU(1)=2 THEN GOTO empty
IF MENU(1)=3 THEN s=2:GOTO crefresh:REM xflip
IF MENU(1)=4 THEN s=3:GOTO crefresh:REM yflip
IF MENU(1)=5 THEN s=4:GOTO crefresh:REM rotate
three:
IF MENU(1)=1 THEN s=1:sy=+1:GOTO crefresh:REM scroll up
IF MENU(1)=2 THEN s=1:sy=-1:GOTO crefresh:REM scroll down
IF MENU(1)=3 THEN s=1:sx=+1:GOTO crefresh:REM scroll left
IF MENU(1)=4 THEN s=1:sx=-1:GOTO crefresh:REM scroll right
four:
IF MENU(1)=1 THEN GOTO ccopy
update:
GET (x%(ob)+(ob*3)+3,y%(9))-(x%(ob)+(ob*3)+18,y%(9)+15),temp%
PUT (65,52),temp%,PSET
s=1
GOSUB crefresh
RETURN
swop:
GET (65,52)-(80,67),temp%
PUT (x%(ob)+(ob*3)+3,y%(9)),temp%,PSET
RETURN
fill:
FOR y=23 TO 143 STEP 8
FOR x=126 TO 246 STEP 8
px=(50+INT(x/8)):py=(50+INT(y/8))
PSET (px,py),i
PUT (x,y),cur%(i,0),PSET
NEXT x,y
GOSUB swop
GOSUB ok
RETURN
empty:
FOR y=23 TO 143 STEP 8
FOR x=126 TO 246 STEP 8
px=(50+INT(x/8)):py=(50+INT(y/8))
PSET (px,py),0
PUT (x,y),cur%(0,0),PSET
NEXT
NEXT
GOSUB swop
GOSUB ok
RETURN
grid:
FOR x=0 TO 128 STEP 8
LINE(125,22+x)-(253,22+x),e
LINE(125+x,22)-(125+x,150),e
NEXT
RETURN
curser:
FOR ci=0 TO 15
LINE (0,0)-(6,6),ci,bf
GET (0,0)-(6,6),cur% (ci,0)
NEXT
RETURN
csave:
s1$="sp"
FOR i = 1 TO 14
si$=STR$(i)
ls=LEN(si$)-1
s2$=RIGHT$(si$,ls)
n$=s1$+s2$
n=i-1
GOSUB cstore
NEXT
LOCATE 2,2
PRINT " "
GOSUB ok
RETURN
cstore:
GET (x%(n)+(n*3)+3,y%(9))-(x%(n)+(n*3)+18,y%(9)+15),temp%
LOCATE 2,2
PRINT "Saving Sprite";n;
OPEN n$ FOR OUTPUT AS 1 LEN=buffc
FOR d=0 TO 66
PRINT #1,MKI$(temp%(d));
NEXT
CLOSE 1
d$ = n$+i$
KILL d$
RETURN
crefresh:
it=i
FOR y=23 TO 143 STEP 8
FOR x=126 TO 246 STEP 8
px=(50+INT(x/8)):py=(50+INT(y/8))
i=POINT (px+sx,py+sy)
IF s=1 THEN PUT (x,y),cur%(i,0),PSET
IF s=2 THEN PUT (372-x,y),cur%(i,0),PSET
IF s=3 THEN PUT (x,166-y),cur%(i,0),PSET
IF s=4 THEN PUT (103+y,269-x),cur%(i,0),PSET
NEXT
NEXT
GET (x,y)-(x+6,y+6),ctemp%
z=x:q=y
IF s >1 THEN GOSUB drawsprite
IF sx <> 0 THEN GOSUB drawsprite
IF sy <> 0 THEN GOSUB drawsprite
sx=0:sy=0
i=it
GOSUB ok
RETURN
drawsprite:
FOR y=23 TO 143 STEP 8
FOR x=126 TO 246 STEP 8
i=POINT (x,y)
px=(50+INT(x/8)):py=(50+INT(y/8))
PSET(px,py),i
NEXT
NEXT
GOSUB swop
RETURN
creset:
GOSUB aload
FOR pz = 0 TO 13
PUT (x%(pz)+(pz*3)+3,y%(9)),anim%(pz,0),PSET
NEXT
PUT (65,52),anim%(ob,0),PSET
GOSUB update
RETURN
game:
gf=12
scrn=0:life = 3:kgot = 2:kp = 13:ip = 4:e = 90
score = -10
PUT (0,0),anim%(9,0),PSET
PUT (0,0),anim%(3,0),OR
GET (0,0)-(15,15),anim%(14,0)
game2:
CLS
gst =0
gd=0
scrn = scrn +1
score = score + scrn * 10
IF scrn >18 THEN scrn =1
scno = scrn+9
IF score >10 THEN
LOCATE 1,5
PRINT "Screen ";CHR$(scrn + 64);" Score";score;
END IF
scc=scno
x$=STR$(scc)
n$=RIGHT$(x$,2)
dime = 0
OPEN n$ FOR INPUT AS 1 LEN=buffs
FOR dx=0 TO 17
FOR dy=0 TO 9
array%(dx,dy)=CVI(INPUT$(2,1))
IF array%(dx,dy)=8 THEN
frogx=x%(dx)
frogy=y%(dy)
x=dx
y=dy
frog=1
END IF
IF array%(dx,dy)=2 THEN dime = dime +1
NEXT
NEXT
CLOSE 1
IF score >10 THEN
WINDOW CLOSE 3
WINDOW 2
END IF
GOSUB refresh
f=10:x1=x:y1=y:xg1=x:yg1=y:xg=x:yg=y:gst=0
gdl=10:gc=0:ibx=8:bori=0
LOCATE 1,2
PRINT " "
GOSUB trow
GOSUB lives
GOSUB ice
GOSUB keys
GOSUB energy
GOSUB ok
gmove:
a$=INKEY$
a$ = UCASE$(a$)
w=STRIG(3)
x=x+STICK(2)
y=y+STICK(3)
IF x < 0 THEN x = 0
IF x > 17 THEN x = 17
IF y < 0 THEN y = 0
IF y > 9 THEN y = 9
zob=array%(x,y)
IF zob =9 THEN GOSUB iceg
IF zob =7 THEN x=x1:y=y1:cq=0
IF zob =20 THEN e = e-10:GOSUB energy
IF zob =4 THEN
SOUND 164.81,1,vol,0
IF kgot =0 THEN
FOR d = 1 TO 10000:NEXT
x=x1:y=y1
GOTO gm2
END IF
kgot = kgot-1
IF kgot <0 THEN kgot =0
PUT (x%(kp+kgot+1),0),anim%(0,0),PSET
END IF
gm2:
IF a$= "P" THEN GOSUB pause
IF a$ = CHR$(27) THEN GOTO options
IF a$ = "~" THEN GOTO game2
IF zob = 1 THEN GOSUB plus
IF zob = 2 THEN
dime=dime-1
SOUND 523.25,1,vol,0
FOR d = 1 TO 1000:next
score = score +10
END IF
IF dime <1 THEN goto game2
IF zob = 5 THEN GOSUB plus
IF zob = 6 THEN
SOUND 1760,1,40,0
SOUND 880,1,40,1
FOR d = 1 TO 1000:NEXT
END IF
IF zob = 20 THEN GOSUB plus
ct=ct+1
IF ct >3 THEN
ct=0
IF f=10 THEN f=11:GOTO ctj
IF f=11 THEN f=10
END IF
ctj:
IF zob = 14 THEN
SOUND 1000,1,vol,0
kgot = kgot +1
IF kgot >4 THEN kgot = 4
PUT (x%(kp+kgot),0),anim%(3,0),PSET
END IF
cq=0
IF x<>x1 THEN cq=cq+1
IF y<>y1 THEN cq=cq+1
IF cq >0 THEN
IF w = -1 THEN GOSUB icel
PUT (x%(x),y%(y)),anim%(f,0),PSET:' * put frog
array%(x,y)=15
blc = array%(x1,y1)
IF (blc=15) OR (blc=8) OR (blc=9) then
PUT (x%(x1),y%(y1)),anim%(bori,0),PSET:' * put blank
array%(x1,y1)=bori
END IF
bori = 0
END IF
IF cq = 0 THEN
PUT (x%(x),y%(y)),anim%(f,0),PSET:' * put frog
array%(x,y)=15
END IF
IF dime <1 THEN goto game2
IF gst =1 THEN
GOSUB gho
IF x=xg THEN
IF y=yg THEN GOSUB minus
END IF
END IF
IF life <0 THEN GOTO Over
x1=x:y1=y
gx=INT(RND*17)
gy=INT(RND*9)
pu%=array%(gx,gy)
IF pu% = 0 THEN GOSUB sob
FOR acx = 1 TO 16
FOR acy = 1 TO 8
fall = array%(acx,acy)
IF (fall=1) OR (fall=2) OR (fall=5) OR (fall=14) THEN
fto = array%(acx,acy+1)
IF fto = 0 THEN
array%(acx,acy)=0
array%(acx,acy+1)=fall
PUT (x%(acx),y%(acy+1)),anim%(fall,0),PSET
PUT (x%(acx),y%(acy)),anim%(0,0),PSET
hb=array%(acx,acy+2)
IF hb=15 THEN GOSUB bonce
GOTO gcc
END IF
ftl = array%(acx-1,acy+1)
flc = array%(acx-1,acy)
IF (ftl = 0) AND (flc = 0) THEN
array%(acx,acy)=0
array%(acx-1,acy+1)=fall
PUT (x%(acx-1),y%(acy+1)),anim%(fall,0),PSET
PUT (x%(acx),y%(acy)),anim%(0,0),PSET
hb=array%(acx-1,acy+2)
IF hb=15 THEN GOSUB bonce
GOTO gcc
END IF
ftr = array%(acx+1,acy+1)
frc = array%(acx+1,acy)
IF (ftr = 0) AND (frc = 0) THEN
array%(acx,acy)=0
array%(acx+1,acy+1)=fall
PUT (x%(acx+1),y%(acy+1)),anim%(fall,0),PSET
PUT (x%(acx),y%(acy)),anim%(0,0),PSET
hb=array%(acx+1,acy+2)
IF hb=15 THEN GOSUB bonce
GOTO gcc
END IF
END IF
gcc:
NEXT
NEXT
GOTO gmove
gho:
gc = gc +1
IF gc = 3 THEN
IF y < yg THEN gd=3
IF y > yg THEN gd=1
END IF
IF gc = 6 THEN
IF x < xg THEN gd=2
IF x > xg THEN gd=0
gc=0
END IF
IF gd =0 THEN xg=xg +1
IF gd =1 THEN yg=yg +1
IF gd =2 THEN xg=xg -1
IF gd =3 THEN yg=yg -1
gob=array%(xg,yg)
IF (gob =9) OR ((gob=15) AND (w=-1) AND (ibx>0)) THEN
gst =0
PUT (x%(xg),y%(yg)),anim%(14,0),PSET
array%(xg,yg)=14
gbc =array%(xg1,yg1)
if (gbc=16) then
PUT (x%(xg1),y%(yg1)),anim%(0,0),PSET
array%(xg1,yg1)=0
END IF
xg1=xg:yg1=yg
FOR s = 1 TO 5
SOUND s*100,1,255,0
NEXT
RETURN
END IF
IF (gob =4) OR (gob =7) OR (gob =6) THEN
xg=xg1:yg=yg1
gd=INT(RND*4)
END IF
gdl=gdl-1
IF gdl =0 THEN
gd=INT(RND*4)
gdl=INT(RND*7)+10
END IF
cz=0
IF xg<>xg1 THEN cz=cz+1
IF yg<>yg1 THEN cz=cz+1
PUT (x%(xg),y%(yg)),anim%(f+2,0),PSET
array%(xg,yg)=16
IF cz >0 THEN
if array%(xg1,yg1)=16 then
PUT (x%(xg1),y%(yg1)),anim%(0,0),PSET
array%(xg1,yg1)=0
end if
END IF
IF gob =2 THEN dime =dime -1
xg1=xg:yg1=yg
RETURN
sob:
IF (gx = x1) AND (gy = y1) THEN RETURN
IF (gx = xg1) AND (gy = yg1) THEN RETURN
IF gst =0 THEN
sn = sn +1
IF sn <10 THEN GOTO sob2
sn = 0
xg=gx:yg=gy:xg1=xg:yg1=yg
gst = 1
RETURN
END IF
sob2:
s%=INT(RND*5)+1
IF (s% =4) OR (s% =2) OR (s% =3) THEN RETURN
sound 600,1,vol,0
array%(gx,gy)=s%
PUT (x%(gx),y%(gy)),anim%(s%,0),PSET
RETURN
minus:
kgot = kgot-1
IF kgot <0 THEN kgot =0
PUT (x%(kp+kgot+1),0),anim%(0,0),PSET
e=e+8
SOUND 131,1,255,0
SOUND 147,1,255,1
GOSUB energy
RETURN
bonce:
IF cq <> 0 THEN RETURN
GOSUB effectl
e=186
GOSUB energy
RETURN
plus:
score = score + 10
e=e-4
SOUND 392,1,vol,0
GOSUB energy
RETURN
trow:
FOR bl = 0 TO 17
PUT (x%(bl),0),anim%(0,0),PSET
NEXT
RETURN
lives:
FOR li = 0 TO 3
PUT (x%(li),0),anim%(0,0),PSET
NEXT
IF life<1 THEN RETURN
FOR li = 0 TO life-1
PUT (x%(li),0),anim%(8,0),PSET
NEXT
RETURN
ice:
FOR ki = 4 TO 4+ibx
PUT (x%(ki),0),anim%(9,0),PSET
NEXT
RETURN
keys:
IF kgot <1 THEN RETURN
kn = kp+1
FOR ky = kn TO kn+kgot-1
PUT (x%(ky),0),anim%(3,0),PSET
NEXT
RETURN
iceg:
ibx = ibx +1
IF ibx >8 THEN ibx =8 :RETURN
FOR ic = ip TO ip+ibx-1
PUT (x%(ic),0),anim%(9,0),PSET
NEXT
SOUND 220,1,vol,0
FOR d = 1 TO 1000:NEXT
array%(x,y)=0
RETURN
icel:
ibx = ibx -1
IF ibx <0 THEN ibx =0 :RETURN
FOR ic = ip+ibx TO ip+ibx+1
PUT (x%(ic),0),anim%(0,0),PSET
NEXT
SOUND 440,1,vol,0
FOR d = 1 TO 1000:NEXT
bori=9
RETURN
energy:
IF e < 0 THEN
IF life =3 THEN
score = score + 10
e=0
END IF
IF life <3 THEN
GOSUB effectg
life = life +1
GOSUB lives
e = 90
END IF
END IF
IF e > 185 THEN
GOSUB effectl
life = life -1
GOSUB lives
e = 90
END IF
LINE (307,0)-(314,e),0,bf
LINE (307,185)-(314,e),2,bf
RETURN
effectg:
for d = 1 to 10
SOUND 200*d,1,255,0
PALETTE 2,RND,RND,RND
gosub holdit
next
PALETTE 2,0,1,0 :REM green
RETURN
effectl:
FOR d = 1 TO 10
SOUND 2000/d,1,255,0
PALETTE 2,RND,RND,RND
GOSUB holdit
NEXT
PALETTE 2,0,1,0 :REM green
RETURN
holdit:
FOR i = 1 TO 2000
NEXT
RETURN
Over:
CLS
GOSUB ok
IF score > hiscore THEN hiscore = score
n$="t1":GOSUB fetch
LOCATE 7,9
PRINT "GAME OVER"
LOCATE 9,9
PRINT "Screen ";CHR$(scrn + 64)
LOCATE 11,9
PRINT "Score";score
LOCATE 13,9
PRINT "Hi Score";hiscore
LOCATE 15,9
PRINT "Press a Key"
GOSUB ok
oloop:
a$=INKEY$
IF a$ = "" THEN GOTO oloop
GOTO options
pause:
FOR del = 1 TO 100:PALETTE 1,.7,RND,0:NEXT
a$=INKEY$
PALETTE 1,.7,RND,0
w=STRIG(3)
IF w <0 THEN GOTO x
IF a$ = "" THEN GOTO pause
x:
PALETTE 1,1,.5,0 :REM brown
RETURN
nopoint:
FOR pc = 20212 TO 20275
POKE pc,0
NEXT
RETURN
apoint:
RESTORE frog
FOR pc = 0 TO 63
READ da
POKE 20212+pc,da
NEXT
RETURN
frog:
DATA 0,0,60,60,60,60,66,66,78,78
DATA 185,185,78,78,189,189,126,126,189,189
DATA 126,126,153,153,61,188,66,66,3,192
DATA 60,60,15,240,16,8,29,184,34,68
DATA 23,232,40,20,24,24,39,228,44,52
DATA 83,202,119,238,136,17,115,206,140,49
DATA 0,0,255,255
tpoint:
RESTORE tofrog
FOR pc = 0 TO 31
READ da
POKE 20244+pc,da
NEXT
RETURN
tofrog:
DATA 0,0,255,255,127,254,255,255
DATA 64,134,255,255,115,50,255,255,115,50
DATA 255,255,115,134,255,255,127,254,255,255
DATA 0,0,255,255
END