This page (revision-3) was last changed on 03-Feb-2023 15:21 by Carsten Strotmann 

This page was created on 09-Mar-2010 07:51 by Carsten Strotmann

Only authorized users are allowed to rename pages.

Only authorized users are allowed to delete pages.

Page revision history

Version Date Modified Size Author Changes ... Change note
3 03-Feb-2023 15:21 8 KB Carsten Strotmann to previous
2 09-Mar-2010 07:53 1 KB Carsten Strotmann to previous | to last
1 09-Mar-2010 07:51 1 KB Carsten Strotmann to last

Page References

Incoming links Outgoing links
Catepill
Catepill

Version management

Difference between version and

At line 33 added 504 lines
{{{
;********************************
;** **
;** Phoenix SoftCrew ACTION! **
;** Programme und Tips f. 8Bit **
;** **
;** Carsten Strotmann **
;** An der Kreutzbrede 20 **
;** **
;** D- 4410 Warendorf 1 **
;** (02581) 8920 **
;** **
;********************************
; Programmname:CATAPILL The Game
; Programmierer:PSC/Carsten Strotmann
; Filename:TG.ACT
; erste Version:02.07.90
; letzte Aenderung:19.03.93
; Zweck:
; Bemerkung:
;
;
INCLUDE "D:SYSTEM.ACT"
MODULE
BYTE sflg=$03C6,
phase,
direc, ; Richtung Joystick
px=$3DA,py=$3DB, ; Playerposition
ax=$3DC,ay=$3DD, ; Absolute Position
dx=$3DE,dy=$3DF, ; Richtungen
hx=$3E0,hy=$3E1, ; Abweichung zum Zentr.
pp,sti,str,player,
consol=$D01F
CARD hpixz=$3CA,vpixz=$3CC,
svscrol=$3C0, shscrol=$3C1,
plf=[$2003], rtclok=$12,
points,copadr=$3C2
BYTE ARRAY raupe ($100),
raupe1($100),
raupe2($100),
boom ($100),
cols(3),
color(3)=$3CE,
save1($21),
save2($21)
INCLUDE "D:TGINC.ACT"
PROC Count (BYTE xx,yy)
BYTE c
c=Look (xx,yy)
IF c#0 THEN
FOR c=1 TO 20
DO
Sound (0,192-c,14,14-(C/2))
Pause (1)
OD
SndRst ()
FI
Restaur (xx,yy,9)
RETURN
BYTE FUNC ChkLS (BYTE xx,yy,u)
BYTE res,z
res=0
z=Look (xx+1,yy)
IF z+u=222 THEN
res=1
FI
z=Look (xx-1,yy)
IF z+u=222 THEN
res=1
FI
z=Look (xx,yy+1)
IF z+u=222 THEN
res=1
FI
z=Look (xx,yy-1)
IF z+u=222 THEN
res=1
FI
RETURN (res)
PROC BoomK (BYTE xx,yy)
Sound (0,6,4,10)
Restaur (xx,yy,93)
Restaur (xx+1,yy,93)
Restaur (xx+1,yy+1,93)
Restaur (xx+1,yy-1,93)
Restaur (xx-1,yy,93)
Restaur (xx-1,yy+1,93)
Restaur (xx-1,yy-1,93)
Restaur (xx,yy+1,93)
Restaur (xx,yy-1,93)
Pause (100)
SndRst ()
ClearK (xx+1,yy)
ClearK (xx+1,yy+1)
ClearK (xx+1,yy-1)
ClearK (xx-1,yy)
ClearK (xx-1,yy+1)
ClearK (xx-1,yy-1)
ClearK (xx,yy+1)
ClearK (xx,yy-1)
ClearK (xx,yy)
RETURN
PROC MoveBox (BYTE xx,yy)
BYTE z,u,sx,sy,sc
z=-1
DO
z==+1
u=Look (xx,yy)
xx==+dx
yy==+dy
UNTIL u=0 OR u=1 OR u=9 OR u=21 OR u=13 OR u=17 OR u=25 OR z>3
OD
sc=u
sx=xx-dx
sy=yy-dy
xx==-dx
yy==-dy
IF z<4 AND u=0 OR u=9 AND z>0 THEN
Sound (0,50,12,9)
FOR u=1 TO z
DO
xx==-dx
yy==-dy
MoveK (xx,yy,xx+dx,yy+dy)
OD
ClearK (xx,yy)
SndRst ()
u=Look (xx+dx,yy+dy)
IF u=113 OR u=109 THEN
u=ChkLS (xx+dx,yy+dy,u)
IF u=1 THEN
BoomK (xx+dx,yy+dy)
FI
FI
FI
IF z>0 THEN
IF sc=9 THEN
Count (sx,sy)
FI
IF sc=21 AND dx=0 THEN
BLft (sx,sy-dy)
FI
IF sc=13 AND dy=0 THEN
BUp (sx-dx,sy)
FI
IF sc=17 AND dy=0 THEN
BDwn (sx-dx,sy)
FI
IF sc=25 AND dx=0 THEN
BRht (sx,sy-dy)
FI
FI
RETURN
PROC PosR ()
BYTE U
CARD xx,yy
ax=0
ay=0
xx=0
yy=0
DO
DO
u=Look(xx,yy)
xx==+1
UNTIL xx=40 OR u=29
OD
IF xx=40 THEN xx=0 FI
yy==+1
UNTIL yy=24 OR u=29
OD
ax=xx-1
ay=yy-1
xx==*8-hx
yy==*16-hy
IF xx>152 THEN
px==+xx-152
xx=152
FI
IF yy>160 THEN
py==+yy-160+1
yy=160
FI
DO
IF xx>0 THEN
sflg==%4
xx==-1
vpixz==+1
FI
IF yy>0 THEN
sflg==%1
yy==-1
hpixz==+1
FI
DO
UNTIL sflg=0
OD
UNTIL xx=0 AND yy=0
OD
RETURN
PROC Blend ()
BYTE u,c
color(0)=cols(0)&$F0
color(1)=cols(1)&$F0
color(2)=cols(2)&$F0
FOR u=0 TO $F
DO
FOR c=0 to 3
DO
IF color(c)<cols(c) THEN
color(c)==+1
FI
OD
Pause (3)
OD
RETURN
PROC Change ()
BYTE c
P_Clear(2)
P_Clear(3)
FOR c=1 TO 20
DO
Sound (0,100+c,12,C/2)
Pause (1)
OD
Restaur (ax,ay,29)
IF player = 0 THEN
MoveBlock (save1,$3C0,$21)
MoveBlock ($3C0,save2,$21)
ELSE
MoveBlock (save2,$3C0,$21)
MoveBlock ($3C0,save1,$21)
FI
ClearK (ax,ay)
player == ! 1
ARaupe ()
SndRst ()
Pause (2)
RETURN
PROC ShowTime ()
BYTE hpos1=$3D7, hpos=$D000,
t1=$12, t2=$13, xv, yv
CARD pmadr=$2D5, adr
IF t2>$1 OR hpos1=0 THEN
t2=0
t1==+1
IF t1>19 THEN
t1=0
Change ()
FI
IF t1=10 THEN Change () FI
IF t1<5 OR t1>14 THEN
yv=0
ELSE
yv=$B
FI
IF t1<10 THEN
xv=7
ELSE
xv=0
FI
adr=pmadr+$11D+yv
Zero (pmadr+$11D,$18)
sflg=$10
DO UNTIL sflg=0 OD
hpos1=$BE+xv
hpos=hpos1
sflg=$10
DO UNTIL sflg=0 OD
MoveBlock (adr,timpl+$C*t1,$C)
FI
RETURN
PROC BoomBox (BYTE xx,yy)
BYTE u,x,z
BYTE ARRAY hpos=$3D2
z=0
FOR u=0 TO 7
DO
FOR x=0 TO 10
DO
Sound (0,z,0,15)
z==+1
OD
Animate (0,px+(dx*8),py+(dy*16),u,boom)
IF u=4 THEN ClearK (xx,yy) FI
Pause (2)
OD
SndRst ()
RETURN
PROC MainInit ()
BYTE chsalt=$26B,
chbas =$2F4,
dmactl=$22F,
nmien=$D40E,chr,
crsinh=$2F0
CARD savmsc=$58
BYTE ARRAY file (20),scolor=$2C4
hx=$20
hy=$40
px=47+hx
py=61+hy
PM_Init ()
MPA_Set ()
chsalt=Set_Ramtop (8)
dmactl=0
Font_Load ("D1:CATAPILL.FNT",chsalt)
nmien==%$C0
chbas=chsalt+4
Font_Load ("D1:TOPLINE.FNT",chbas)
Close (1)
Open (1,"D1:TOPLINE.SCR")
BGet (1,savmsc,160)
Close (1)
SCopy (file,"D1:LEVELDAT.SCR")
Screen_Load (file)
MPA_Load (raupe1,"D:RAUPE.MPA")
MPA_Load (raupe2,"D:RAUPE2.MPA")
MPA_Load (boom,"D:BOOM.MPA")
MoveBlock (raupe,raupe1,$100)
dmactl=34
PM_Set ()
PM_Col (2,0,6)
PM_Col (3,2,10)
PM_Col (0,0,7)
PM_Col (1,0,12)
crsinh=1
Dspl ()
Init ()
scolor(0)=$C4
scolor(1)=$1A
scolor(2)=$86
scolor(4)=$0
points=0
sflg=$F0
DO
UNTIL sflg=0
OD
dx=1
dy=0
direc=2
phase=0
Blend ()
PosR ()
ClearK (ax,ay)
Dreh(0)
player=0
MoveBlock (save2,$3C0,$21)
RETURN
PROC Main ()
BYTE st,chr
MainInit ()
ARaupe ()
rtclok=18
DO
ShowTime ()
st=Stick(player)!$F
str=Strig(player)
dx=0
dy=0
IF st=1 THEN sti=0 dy=-1 ; OBEN
ELSEIF st=2 THEN sti=1 dy=1 ; UNTEN
ELSEIF st=4 THEN sti=2 dx=-1 ; LINKS
ELSEIF st=8 THEN sti=3 dx=1 ; RECHTS
FI
chr=Look (ax+dx,ay+dy)
; PRINTB(CHR)
IF sti=direc THEN
IF chr=0 OR (chr>12 AND chr<26) THEN
IF st=1 THEN
Up ()
FI
IF st=2 THEN
Down ()
FI
IF st=4 THEN
Left ()
FI
IF st=8 THEN
Right ()
FI
ELSEIF chr#29 THEN
IF str THEN
MoveBox (ax+dx,ay+dy)
ELSEIF chr>25 THEN
BoomBox (ax+dx,ay+dy)
FI
FI
ELSEIF st#0 THEN
Dreh (sti)
Pause (5)
FI
OD
RETURN
}}}
This page (revision-3) was last changed on 03-Feb-2023 15:21 by Carsten Strotmann  Top