Set Buffer 600 Dim CH$(255),OB$(10) CH$(Asc("-"))="-" Def Fn OTH$(PQ$)=CH$(Asc(Left$(PQ$,1)))+Right$(PQ$,Len(PQ$)-1) Def Fn MY$(PQ)=(Str$(PQ)-" ") MXP=600 : MZ=256 Reserve As Work 10,32*33*2 Bload "ab3:includes/256pal",Start(10) Dim PALR(255),PALG(255),PALB(255) For A=0 To 255 PALR(A)=Deek(Start(10)+A*6)/(16) PALG(A)=Deek(Start(10)+A*6+2)/(16) PALB(A)=Deek(Start(10)+A*6+4)/(16) Next Dim LEVELTEXT$(15) For A=0 To 9 LEVELTEXT$(A)=Space$(160) Next TEAM=-1 Dim ECHO(MZ) Dim ALNAME$(19),OBNAME$(29) Dim ALHITPTS(19),OPS(20,6),LOPS(20,6) Dim OBTOROOF(30),LOCKTOWALL(30) Dim TELZO(MZ),TELX(MZ),TELZ(MZ),CPTUL(99) Dim USED(MZ),WB(MZ,10),UWB(MZ,10) Dim BUT$(59),PX(MXP),PY(MXP),ZO(MZ,10),ZP(MZ),WT(MZ,10),ZW(MZ,10,1) Dim ZH(MZ,3),ZC(MZ,10),ZB(MZ),UZB(MZ),OBX(200),OBZ(200),ZZ(MZ,10) Dim UZH(MZ,3),ZPBR(MZ,10,3) ',PBR(MXP),UPBR(MXP) Dim ZRG(MZ,2),ZFG(MZ,2),ZWG(MZ,10,3),WD(MZ,10),ZD(MZ),DC(20) Dim UZRG(MZ,2),UZFG(MZ,2),UZWG(MZ,10,3) Dim VECT$(20),CPTX(99),CPTY(99),CPTZ(99),ZCPT(MZ),UZCPT(MZ),RB(MZ),FB(MZ) Dim VCPL(MZ),VCPR(MZ),LP(MZ,100),RP(MZ,100),ZU(MZ),PU(MXP) Dim PN(MXP),X(4),Y(4),D(MXP,3),SOW(20),PW(MXP),CORD(MZ),LIFTC(20) Dim PMCOM(30,2),PFCOM(30,2),WLI(MZ,10),ZLI(MZ) Dim DMX(30),DMZ(30),DMY(30),HILITE(10,1),PCW(MXP,1) Dim SWWL(7,1),SWP(7),KEYGRAPH(3),ZDPT(MZ),ZGPT(MZ),SGO(7) Dim DWPT(MZ,10),ZLIPT(20),ZDOPT(20) Dim DRT(20),DLT(20),LRT(20),LLT(20) Dim WATH(20),WABH(20),ZWA(MZ),WASP(20),WAPT(MZ) Dim FFT(16),SWITCHTYPE(20) Dim DR$(10),DL$(10) Dim LR$(10),LL$(10),BSFX(MZ) Dim LSP(20),WCHUNK$(20),WCY(20),WCSV(20) Dim BIGGUNGRAPH(9) Dim BIGGUNDIM(9,1) LWCHUNK=-200 WGW=64 ' plasmagun BIGGUNGRAPH(0)=1 BIGGUNDIM(0,0)=32 BIGGUNDIM(0,1)=16 ' rocket launcher BIGGUNGRAPH(1)=20 BIGGUNDIM(1,0)=16 BIGGUNDIM(1,1)=32 ' shotgun BIGGUNGRAPH(6)=25 BIGGUNDIM(6,0)=32 BIGGUNDIM(6,1)=16 ' grenade launcher BIGGUNGRAPH(3)=26 BIGGUNDIM(3,0)=32 BIGGUNDIM(3,1)=16 FFT(0)=0 FFT(1)=2 FFT(2)=2 FFT(3)=1 FFT(4)=1 FFT(5)=2 FFT(6)=1 FFT(7)=2 FFT(8)=1 FFT(9)=1 FFT(10)=2 FFT(11)=2 FFT(12)=0 FFT(13)=0 FFT(14)=2 FFT(15)=1 For A=0 To MZ : TELZO(A)=-1 : Next WCHUNK$(0)="GreenMechanic" WCY(0)=64 : WCSV(0)=6 WCHUNK$(1)="BlueGreyMetal" WCY(1)=64 : WCSV(1)=6 WCHUNK$(2)="TechnoDetail" WCY(2)=128 : WCSV(2)=7 WCHUNK$(3)="BlueStone" WCY(3)=64 : WCSV(3)=6 WCHUNK$(4)="RedAlert" WCY(4)=64 : WCSV(4)=6 WCHUNK$(5)="Rock" WCY(5)=64 : WCSV(5)=6 WCHUNK$(6)="scummy" WCY(6)=128 : WCSV(6)=7 WCHUNK$(7)="stairfronts" WCY(7)=16 : WCSV(7)=4 WCHUNK$(8)="bigdoor" WCY(8)=128 : WCSV(8)=7 WCHUNK$(9)="redrock" WCY(9)=64 : WCSV(9)=6 WCHUNK$(10)="dirt" WCY(10)=128 : WCSV(10)=7 WCHUNK$(11)="SWITCHES" WCY(11)=64 : WCSV(11)=6 WCHUNK$(12)="SHINYMETAL" WCY(12)=128 : WCSV(12)=7 WCHUNK$(13)="bluemechanic" WCY(13)=64 : WCSV(13)=6 DR$(0)="Plr Touch+SPC" DR$(1)="Plr Touch " DR$(2)="Bullet Touch " DR$(3)="Alien Touch " DR$(4)="On Timeout " DR$(5)="Never " DL$(0)="On Timeout " DL$(1)="Never " LR$(0)="Plr Touch+SPC" LR$(1)="Plr Touch " LR$(2)="On Timeout " LR$(3)="Never " LL$(0)="Plr Touch+SPC" LL$(1)="Plr Touch " LL$(2)="On Timeout " LL$(3)="Never " TXT=-1 For A=0 To 7 : SWWL(A,0)=-1 : SWWL(A,1)=-1 : Next Dim SWT(10),BWT(10) SWT(0)=0 : BWT(0)=1 SWT(1)=1 : BWT(1)=0 SWT(2)=1 : BWT(2)=1 SWT(3)=1 : BWT(3)=1 SWT(4)=1 : BWT(4)=1 SWT(5)=1 : BWT(5)=1 For A=0 To 30 : PMCOM(A,0)=-1 : PFCOM(A,0)=-1 : Next PCOM=0 MP=Start(10) 'For A=0 To 12 ' F$= Fn MY$(A+1) ' Load Iff "ab3:graphics/walls/wall."+F$,0 ' Get Icon A+1,0,0 To 64,64 ' For B=0 To 31 : Doke MP,Colour(B) : Add MP,2 : Next 'Next MP=Start(10)+64*16 For A=0 To 15 F$= Fn MY$(A+1) Load Iff "ab3:graphics/floors/floor."+F$,0 Get Icon A+17,0,0 To 64,64 For B=0 To 31 : Doke MP,Colour(B) : Add MP,2 : Next Next Bsave "ab3:includes/editorblocks.pal",Start(10) To Start(10)+Length(10) 'Else ' Bload "ab3:includes/editorblocks.pal",Start(10) 'End If For A=0 To MZ For B=0 To 10 ZWG(A,B,3)=64 Next UZH(A,0)=5000 : UZH(A,1)=5000 : UZH(A,2)=5000 ZH(A,2)=256 : ZH(A,1)=-128 : Next EBX=0 NCPT=-1 Screen Open 3,320,16,2,Lowres Screen Hide 3 Screen Open 4,320,64,4,Lowres Curs Off : Flash Off : Cls 0 Screen Display 4,,40+200,, Screen Hide 4 LG=-1 Reserve As Work 12,200*64 Reserve As Work 14,MZ*64*6 For A=Start(14) To Start(14)+Length(14)-4 Step 4 Loke A,-1 Next Reserve As Work 15,200000 Bload "ab3:includes/test.lnk",Start(15) S=Start(15)+$34D8 For A=0 To 19 For B=0 To 19 C=Peek(S) If C<>0 Then ALNAME$(A)=ALNAME$(A)+Chr$(C) Add S,1 Next Next S=Start(15)+$57B0 For A=0 To 29 For B=0 To 19 C=Peek(S) If C<>0 Then OBNAME$(A)=OBNAME$(A)+Chr$(C) Add S,1 Next Next S=Start(15)+$5A08 For A=0 To 29 OBTOROOF(A)=Deek(S+18) LOCKTOWALL(A)=Deek(S+20) S=S+40 Next S=Start(15)+$3668 For A=0 To 19 ALHITPTS(A)=Deek(S+32) S=S+21*2 Next S=Start(15)+$14760 For A=0 To 15 WCHUNK$(A)="" For B=0 To 63 If Peek(S)<>0 WCHUNK$(A)=WCHUNK$(A)+Chr$(Peek(S)) End If Add S,1 Next Next For A=0 To 15 WCY(A)=Deek(S) : Add S,2 WCSV(A)=0 Repeat WCSV(A)=WCSV(A)+1 Until 2^WCSV(A)>=WCY(A) Next Reserve As Work 11,100*100 Reserve As Work 9,2000 Pload "ab3:includes/BETPTS",9 NP=-1 : CP=NP TXP=6*4+1 ' For A=0 To 10 OB$(A)="Undefined " Next OB$(0)="Alien " OB$(1)="Object" 'OB$(0)="Enemy " 'OB$(1)="MediPac " 'OB$(2)="Ammo Clip " 'OB$(3)="Big Gun " 'OB$(4)="Key " 'OB$(5)="Vector Object" 'OB$(6)="Marine " 'OB$(7)="Glass Ball " 'OB$(8)="Barrel " 'OB$(9)="Decoration " ' For A=0 To 20 VECT$(A)="Undefined " Next VECT$(0)="ROBOT " VECT$(1)="reserved " VECT$(2)="Lamp " VECT$(3)="crate " VECT$(4)="terminal " VECT$(5)="Blue key Indicator " VECT$(6)="Green key Indicator " VECT$(7)="Red key Indicator " VECT$(8)="Yellow key Indicator" VECT$(9)="Gas Pipe " VECT$(10)="Torch " ' BUT$(0)="Add Point " BUT$(3)="Delete Point " BUT$(6)="Move Point " BUT$(1)="Define New Zone " BUT$(4)="Toggle Wall/Delete Zone " BUT$(7)="Define Viewing Order " BUT$(9)="Upper Roof Height " BUT$(12)="Upper Floor Height " BUT$(15)="Define Roof Height " BUT$(18)="Define Floor Height " BUT$(10)="Upper Roof Point Brightness " BUT$(13)="Upper Floor Point Brightness" BUT$(16)="Lower Roof Point Brightness " BUT$(19)="Lower Floor Point Brightness" BUT$(21)="Define Roof Graphic " BUT$(22)="Define Wall Graphic " BUT$(23)="Define Floor Graphic " BUT$(24)="UPPER Roof Graphic " BUT$(25)="UPPER Wall Graphic " BUT$(26)="UPPER Floor Graphic " BUT$(2)="Add Object " BUT$(5)="Move Object " BUT$(8)="Delete Object " BUT$(11)="Set Player Start / End Zone " BUT$(14)="Define Door Zone " BUT$(17)="Define Lift Zone " BUT$(20)="Define Teleporter " BUT$(27)="Water Height " BUT$(30)="Water Height Anim " BUT$(33)="Upper Wall Bright " BUT$(34)="Lower Wall Bright " BUT$(28)="Add Control Point " BUT$(31)="Link Control Points " BUT$(29)="Link Zone to Cpt " BUT$(32)="Link Upper Zone to Cpt " BUT$(35)="Move Control Point " BUT$(36)="Set Background SFX for zone:" BUT$(37)="Set Echo Level of zone " Screen Open 0,640,256,16,Hires Load Iff "ab3:graphics/editorbuttons" Pen 1 : Paper 0 Screen Display 0,,42+200,, Screen Open 2,320,200,4,Lowres Curs Off : Cls 0 Ink 2 Draw 0,0 To 10,10 Draw 1,0 To 11,10 Draw 0,1 To 10,11 Draw 0,0 To 5,0 Draw 0,0 To 0,5 Draw 0,1 To 5,1 Draw 1,0 To 1,5 Get Sprite 1,0,0 To 16,16 Cls 0 Draw 0,0 To 2,0 Draw 0,0 To 0,2 Draw 2,0 To 2,2 Draw 2,2 To 0,2 Get Bob 2,0,0 To 16,3 Cls 0 Ink 2 Draw 0,0 To 4,0 Draw 0,0 To 0,4 Draw 0,4 To 4,4 Draw 4,0 To 4,4 Plot 2,2,1 Get Sprite 3,0,0 To 16,5 Cls 0 Draw 0,0 To 6,0 Draw 0,0 To 0,6 Draw 0,6 To 6,6 Draw 6,0 To 6,6 Plot 3,3,1 Get Sprite 4,0,0 To 16,7 Cls 0 Locate 0,0 : Print "B" Get Sprite 20,0,0 To 16,16 Cls 0 Locate 0,0 : Print "L+" Get Sprite 30,0,0 To 16,16 Cls 0 Locate 0,0 : Print "L-" Get Sprite 31,0,0 To 16,16 Cls 0 Draw 0,0 To 2,2 Draw 6,0 To 4,2 Draw 0,6 To 2,4 Draw 6,6 To 4,4 Get Sprite 21,0,0 To 16,16 Screen Open 2,320,256,2,Lowres Curs Off : Flash Off : Cls 0 For A=0 To 100 : Plot Rnd(15),Rnd(15),1 : Next Get Sprite 5,0,0 To 16,16 Screen Open 2,320,200,16,Lowres Curs Off : Cls 0 Screen Display 2,,41,, 'Menu$(1)="File " 'Menu$(1,1)="Load Game Link File" 'Menu$(1,2)=" " 'Menu$(1,3)="Load Level ->" 'For A=1 To 16 ' Menu$(1,3,A)=" "+(Str$(A)-" ")+" " 'Next Menu$(2)="Edit " Menu$(2,1)="Text Strings" Menu$(2,2)="Show ->" Menu$(2,2,1)="No Control Point Links " Menu$(2,2,2)="Physical Links Only " Menu$(2,2,3)="Visual Links Only " Menu$(2,2,4)="All Control Point Links" HILITE(0,0)=-1 : HILITE(0,1)=-1 HILITE(1,0)=2 : HILITE(1,1)=-1 HILITE(2,0)=5 : HILITE(2,1)=-1 HILITE(3,0)=3 : HILITE(3,1)=4 Screen Open 1,320,200,2,Lowres Screen Display 1,,41,, Curs Off : Cls 0 Wait Vbl Screen To Front 2 Screen 2 Colour 1,$333 Colour 2,$FFF Colour 4,$888 Colour 5,$FFF Colour 6,$CF Colour 7,$F00 Colour 8,$F8F Flash 10,"(888,1)(000,1)" Flash 11,"(fff,1)(444,1)" Flash 12,"(0cf,1)(048,1)" Flash 13,"(f88,1)(600,1)" Flash 14,"(ff0,1)(440,1)" Flash 15,"(f0f,1)(404,1)" Colour 14,$F0F 'Dual Playfield 2,1 Wait Vbl SC=$FFFFFFF8 Limit Mouse X Hard(2,0),Y Hard(2,0) To X Hard(2,320),Y Hard(2,256) XO=-(128*10) : YO=-(128*6) MU=4 : NZ=0 : CZ=0 : ZE=0 : PZ=-1 OP=6 : SHINEBOX[OP,3] Hide On ' REDCPT=3 Global XO,YO,PX(),PY(),ZO(),ZP(),WT(),WLI(),ZLI(),LIFTC(),ZC(),NP,CP,NZ,CZ,ZE,MU,EBX,NCPT Global NO,OT,OB$(),OBX(),OBZ(),TXP,LG,ZFG(),ZRG(),ZWG(),ZD(),WD(),DC(),CPTX(),CPTY() Global CPTZ(),HILITE,HILITE(),SWWL(),SWP(),SWN,MP,MPX,DR$(),DL$(),LL$(),LR$(),DLT(),DRT(),LLT(),LRT() Global VECT$(),LSP(),WGW,SWITCHTYPE(),NWA,ZWA(),WATH(),WASP(),REDCPT,OPS(),LOPS() Global TXT,EZONE Show On Hot Spot 3,2,2 MPTR=1 Screen Open 3,320,64,64,Lowres Curs Off : Flash Off : Cls 0 Screen To Front 2 ' MOS=0 : Menu Off Screen Copy 0,EBX*32,128,EBX*32+192,176 To 0,0,0 : SHINEBOX[OP,3] Repeat Screen 0 : Locate 70,0 : Print CZ;" " If Choice HED=Choice(1) If HED=1 'HILITE=Choice(2)-1 Gosub REDRAW End If If HED=2 If Choice(2)=1 Gosub SETLEVELTEXT End If If Choice(2)=2 REDCPT=Choice(3)-1 : Gosub REDRAW End If End If End If A$=Inkey$ If A$="]" Then SC=SC*2 If A$="[" : SC=SC/2 If SC=0 : SC=-1 End If End If VT=MU*32 If A$="(" and EBX>0 Then Add EBX,-1 : Screen Copy 0,EBX*32,128,EBX*32+192,176 To 0,0,0 : SHINEBOX[OP,3] If A$=")" and EBX<14 Then Add EBX,1 : Screen Copy 0,EBX*32,128,EBX*32+192,176 To 0,0,0 : SHINEBOX[OP,3] If A$=Chr$(29) Then XO=XO-VT : Gosub REDRAW If A$=Chr$(28) Then XO=XO+VT : Gosub REDRAW If A$=Chr$(30) Then YO=YO-VT : Gosub REDRAW If A$=Chr$(31) Then YO=YO+VT : Gosub REDRAW If A$="E" For A=0 To NZ-1 ECHO(A)=0 Next End If If A$="B" For A=0 To NZ-1 BSFX(A)=0 Next End If If A$="I" Then Gosub PICSAVE If A$="D" Then Gosub SHODEF If A$="P" Then Gosub SCRNSAVE If A$="s" Then Screen Hide 3 : Gosub LEVELSAVE If A$="l" Then Screen Hide 3 : Gosub LEVELLOAD If A$="#" Then MU=MU*2 : VT=VT*2 : XO=(XO/VT)*VT : YO=(YO/VT)*VT : GRID : Gosub REDRAW If A$=";" and MU>1 Then MU=MU/2 : VT=VT/2 : XO=(XO/VT)*VT : YO=(YO/VT)*VT : GRID : Gosub REDRAW XM=X Mouse : YM=Y Mouse X=X Screen(2,XM) : Y=Y Screen(2,YM) If Y<200 and Y>8 If MOS=1 Menu Off MOS=0 End If If MPTR<>2 Change Mouse 2 MPTR=2 End If Gosub MAPEDIT Else If Y>=200 If MPTR<>4 Change Mouse 4 MPTR=4 End If : Screen Hide 3 Gosub PICKBUTTON Else If Y<8 If MOS=0 Menu On MOS=1 End If If MPTR<>1 Change Mouse 1 MPTR=1 End If End If End If End If Until 0 End ' PICSAVE: 'Screen Open 7,640,256,16,Hires 'Curs Off : Flash Off : Cls 0 'Get Palette 0 'Screen Copy 0,0,0,640,48 To 7,0,(256-48) ' 'Zoom 2,0,0,320,200 To 7,0,0,640,200 'Wait Key 'Screen Close 7 Screen 2 F$=Fsel$("","","") Save Iff F$ Return SHODEF: For A=0 To NZ-1 For B=0 To ZP(A)-1 ZZ(A,B)=-1 Next Next If NZ>0 If NZ>1 For A=0 To NZ-2 For B=0 To ZP(A)-1 F=ZO(A,B) : S=ZO(A,B+1) For C=A+1 To NZ-1 For D=0 To ZP(C)-1 If ZO(C,D)=S and ZO(C,D+1)=F ZZ(A,B)=C : ZZ(C,D)=A End If Next Next Next Next End If For A=0 To NZ-1 For B=0 To ZP(A)-1 If ZWG(A,B,3)=64 and ZWG(A,B,0)=0 and ZWG(A,B,1)=0 and ZWG(A,B,2)=0 Z=ZZ(A,B) If Z=-1 JOIN[ZO(A,B),ZO(A,B+1),10] Else If ZH(A,0)>ZH(Z,0) or ZH(A,1)0 If M=1 Y=Y Screen(3,Y Mouse)/24 Locate 0,Y*3+1 : Print Space$(160) Locate 0,Y*3+1 TXTGET[Y*3+1] : LEVELTEXT$(Y)=Param$ If Len(LEVELTEXT$(Y))<160 LEVELTEXT$(Y)=LEVELTEXT$(Y)+Space$(160-Len(LEVELTEXT$(Y))) End If End If Until M<>1 Screen Close 5 Menu On Return Procedure TXTGET[Y] P$="" Repeat Repeat A$=Inkey$ Until A$<>"" If A$=Chr$(8) If P$<>"" P$=Left$(P$,Len(P$)-1) End If Else If A$<>Chr$(13) P$=P$+A$ End If End If Locate 0,Y : Wait Vbl : Print P$;" " Until A$=Chr$(13) End Proc[P$] LEVELTEXTSHOW: For A=0 To 9 Locate 0,A*3 Pen 1 : Paper 0 Print A; Pen 2 : Paper 0 Print "----------------------------------------------------------------------------" Pen 1 : Paper 0 Print LEVELTEXT$(A); Locate 0,A*3+2 Next Return ' Procedure LK[V] Loke MP,V : Add MP,4 End Proc Procedure DK[V] Doke MP,V : Add MP,2 End Proc Procedure PK[V] Poke MP,V : Add MP,1 End Proc ' LEVELSAVE: Screen 0 Ink 0 : Bar TXP*8,8*4 To 640,80 Curs Off Locate TXP,4 : Print "Enter file name to save level:" Locate TXP,5 : Input "Filename: ";F$ Curs Off Bar TXP*8,8*4 To 640,80 Locate TXP,4 : Print "Calculating level data..." MP=Start(15) ' '* START *********************************** For A=0 To 9 For B=1 To 160 PK[Asc(Mid$(LEVELTEXT$(A),B,1))] Next Next DK[PLX] DK[-PLY] DK[PLZ] DK[PLX2] DK[-PLY2] DK[PLZ2] 'MYPRINT[" "] 'MYPRINT["NumCPts: dc.w "+ Fn MY$(NCPT+1)] DK[NCPT+1] DK[NP+16] DK[NZ-1] DK[0] DK[NO+62] '22 BASE=MP LK[0] : LK[0] : LK[0] : LK[0] : LK[0] : LK[0] : LK[0] : LK[0] '54 '* CONTROLPOINTS *************************** 'MYPRINT["CPtPos:"] If NCPT>=0 For A=0 To NCPT 'MYPRINT[" dc.w "+ Fn MY$(CPTX(A))+","+ Fn MY$(-CPTY(A))] DK[CPTX(A)] DK[-CPTY(A)] If CPTUL(A)=0 DK[(ZH(CPTZ(A),CPTUL(A))+ZH(CPTZ(A),1))/2] Else DK[(UZH(CPTZ(A),CPTUL(A))+UZH(CPTZ(A),1))/2] End If DK[CPTUL(A)] Next End If 'MYPRINT[" "] 'MYPRINT["NumObjectPoints:"] 'MYPRINT[" dc.w "+ Fn MY$(NO+41)] 'MYPRINT["ObjectPoints:"] Loke BASE+20,MP-Start(15) If NO>0 For A=0 To NO-1 'MYPRINT[" dc.l "+ Fn MY$(OBX(A)*65536)+","+ Fn MY$(-OBZ(A)*65536)] LK[OBX(A)*65536] LK[-OBZ(A)*65536] Next End If 'MYPRINT[" ds.l 62*2"] For A=0 To 62 LK[0] : LK[0] Next 'MYPRINT[" "] 'MYPRINT["ObjectData:"] Loke BASE+8,MP-Start(15) If NO>0 S=Start(12) For A=0 To NO-1 'M$=" dc.w "+ Fn MY$(A)+",0," ST=MP DK[A] DK[0] WATT=Peek(S+11) : If WATT<>0 : WATT=128 : End If If Peek(S)=0 : Gosub ALIENSAVE : End If If Peek(S)=1 : Gosub THINGSAVE : End If ' If Peek(S)=0 : Gosub ENEMYSAVE : End If ' If Peek(S)=1 : Gosub MEDISAVE : End If ' If Peek(S)=3 : Gosub BIGGUNSAVE : End If ' If Peek(S)=4 : Gosub KEYSAVE : End If ' If Peek(S)=5 : Gosub FLHASAVE : End If ' If Peek(S)=6 : Gosub MARINESAVE : End If ' If Peek(S)=7 : Gosub GLASSSAVE : End If ' If Peek(S)=2 : Gosub AMMOSAVE : End If ' If Peek(S)=8 : Gosub BBARRELSAVE : End If ' If Peek(S)=9 : Gosub DDECOSAVE : End If Add S,32 Next End If 'MYPRINT["PlayerShotData:"] Loke BASE+12,MP-Start(15) For A=NO To NO+19 ' MYPRINT[" dc.w "+ Fn MY$(A)+",-10,0"] DK[A] : DK[-10] : DK[0] ' MYPRINT[" dc.b 20,20"] PK[20] : PK[20] ' MYPRINT[" dc.l 0"] LK[0] ' MYPRINT[" dc.w -1"] DK[-1] ' MYPRINT[" dc.b 16,16,2,0"] PK[16] : PK[16] : PK[2] : PK[0] ' MYPRINT[" dc.w 0,0,0,0,0,0,0"] ' MYPRINT[" ds.w 16"] For QQ=1 To 23 : DK[0] : Next Next Loke BASE+16,MP-Start(15) 'MYPRINT["NastyShotData:"] For A=NO+20 To NO+39 ' MYPRINT[" dc.w "+ Fn MY$(A)+",-10,0"] DK[A] : DK[-10] : DK[0] ' MYPRINT[" dc.b 20,20"] PK[20] : PK[20] ' MYPRINT[" dc.l 0"] LK[0] ' MYPRINT[" dc.w -1"] DK[-1] ' MYPRINT[" dc.b 16,16,2,0"] PK[16] : PK[16] : PK[2] : PK[0] ' MYPRINT[" dc.w 0,0,0,0,0,0,0"] ' MYPRINT[" ds.w 16"] For QQ=1 To 23 : DK[0] : Next Next ' Other nasty data.... For A=NO+40 To NO+59 ' MYPRINT[" dc.w "+ Fn MY$(A)+",-10,0"] DK[A] : DK[-10] : DK[0] ' MYPRINT[" dc.b 20,20"] PK[20] : PK[20] ' MYPRINT[" dc.l 0"] LK[0] ' MYPRINT[" dc.w -1"] DK[-1] ' MYPRINT[" dc.b 16,16,2,0"] PK[16] : PK[16] : PK[2] : PK[0] ' MYPRINT[" dc.w 0,0,0,0,0,0,0"] ' MYPRINT[" ds.w 16"] For QQ=1 To 23 : DK[0] : Next Next ' 'MYPRINT["PLR1_Obj:"] Loke BASE+24,MP-Start(15) DK[NO+60] : DK[0] : DK[0] PK[64] : PK[64] LK[0] DK[-1] PK[32] : PK[32] PK[-1] : PK[-1] For QQ=1 To 7 : DK[0] : Next DK[10] For QQ=1 To 15 : DK[0] : Next Loke BASE+28,MP-Start(15) DK[NO+61] : DK[0] : DK[0] PK[64] : PK[64] LK[0] DK[-1] PK[32] : PK[32] PK[-1] : PK[-1] FLH=0 : RFH=-100 For QQ=1 To 23 : DK[0] : Next ' DK[NO+62] : DK[0] : DK[0] PK[64] : PK[32] LK[9*65536] DK[-1] PK[32] : PK[16] PK[-1] : PK[-1] For QQ=1 To 23 : DK[0] : Next 'MYPRINT[" dc.w -1"] DK[-1] 'MYPRINT["Points:"] Loke BASE,MP-Start(15) For S=0 To 7 If SWWL(S,0)>-1 and SWWL(S,1)>-1 A=SWWL(S,0) : B=SWWL(S,1) LX=PX(ZO(A,B)) : LY=PY(ZO(A,B)) RX=PX(ZO(A,B+1)) : RY=PY(ZO(A,B+1)) MX=(LX+RX)/2 : MY=(LY+RY)/2 RX=RX-LX : RY=RY-LY L=Sqr(RX^2+RY^2) LX=MX-(32*RX)/L : LY=MY-(32*RY)/L RX=MX+(32*RX)/L : RY=MY+(32*RY)/L PX(NP+S+S+1)=LX : PY(NP+S+S+1)=LY PX(NP+S+S+2)=RX : PY(NP+S+S+2)=RY End If Next If NP=-1 Then Goto 11 For A=0 To NP+16 ' MYPRINT[" dc.w "+ Fn MY$(PX(A))+","+ Fn MY$(-PY(A))] DK[PX(A)] : DK[-PY(A)] Next For A=0 To NZ-1 For B=0 To 9 For C=0 To 3 DK[ZPBR(A,B,C)] Next Next Next SPLIB=MP For A=0 To NZ-1 For B=0 To ZP(A)-1 DK[ZO(A,B)] Next If ZP(A)<10 For B=ZP(A) To 9 DK[-1] Next End If Next 11 'MYPRINT[" "] 'MYPRINT["Walls:"] 'If NZ=-1 Then Goto 22 'T=0 'For A=0 To NZ ' If ZP(A)>0 ' For B=0 To ZP(A)-1 ' If SWT(WT(A,B))=1 ' LL=B-1 : If LL<0 : LL=ZP(A)-1 : End If ' NL=B+1 : If LL>ZP(A)-1 : NL=0 : End If ' X1=PX(ZO(A,B)) : Y1=-PY(ZO(A,B)) ' X2=PX(ZO(A,B+1)) : Y2=-PY(ZO(A,B+1)) ' X2=X2-X1 : Y2=Y2-Y1 ' L=Sqr(X2*X2+Y2*Y2) ' X1=X1+(Y2*32)/L ' Y1=Y1-(X2*32)/L : XD=X2 : YD=Y2 ' X1=X1-(X2*2)/L ' Y1=Y1-(Y2*2)/L ' X2=X2+2*(X2*2)/L ' Y2=Y2+2*(Y2*2)/L ' MYPRINT[" dc.w "+ Fn MY$(X1)+","+ Fn MY$(Y1)+","+ Fn MY$(X2)+","+ Fn MY$(Y2)] ' MYPRINT[" dc.w "+ Fn MY$(L)+",0,0,0"] ' ZW(A,B,0)=T : Add T,1 ' End If ' Next ' End If 'Next 22 'MYPRINT[" "] 'MYPRINT["FloorLines:"] DK[EZONE] Loke BASE+4,MP-Start(15) If NZ=-1 Then Goto 13 T=0 For A=0 To NZ If ZP(A)>0 For B=0 To ZP(A)-1 If ZO(A,B)>ZO(A,B+1) X1=PX(ZO(A,B)) : Y1=-PY(ZO(A,B)) X2=PX(ZO(A,B+1)) : Y2=-PY(ZO(A,B+1)) DK[X1] : DK[Y1] : DK[X2-X1] : DK[Y2-Y1] X2#=X2-X1 : Y2#=Y2-Y1 L#=Sqr(X2#*X2#+Y2#*Y2#) L=L# XA#=(X2#*20.0)/L# YA#=(Y2#*20.0)/L# XA=YA#-XA# YA=-(XA#+YA#) 'JOINCOORDS[X1+XA,-(Y1+YA),X2-YA,-(Y2+XA),3] ' JOINCOORDS[X1,-Y1,X2,-Y2,3] ' Wait Key Else X1=PX(ZO(A,B+1)) : Y1=-PY(ZO(A,B+1)) X2=PX(ZO(A,B)) : Y2=-PY(ZO(A,B)) X2#=X2-X1 : Y2#=Y2-Y1 L#=Sqr(X2#*X2#+Y2#*Y2#) L=L# XA#=(X2#*20.0)/L# YA#=(Y2#*20.0)/L# XA=-(YA#-XA#) YA=(XA#+YA#) 'JOINCOORDS[X2+XA,-(Y2+YA),X1-YA,-(Y1+XA),3] 'JOINCOORDS[X2,-Y2,X1,-Y1,3] 'Wait Key DK[X2] : DK[Y2] : DK[X1-X2] : DK[Y1-Y2] End If If BWT(WT(A,B))=1 For C=0 To NZ For D=0 To ZP(C)-1 If ZO(A,B)=ZO(C,D+1) and ZO(A,B+1)=ZO(C,D) 'MYPRINT[" dc.l ZoneDat"+ Fn MY$(C)+",ZoneDat"+ Fn MY$(A)] ZZ(A,B)=C D=ZP(C) : C=NZ End If Next Next If WT(A,B)<>3 and WT(A,B)<>4 H1=ZH(ZZ(A,B),0) H2=ZH(ZZ(A,B),1) DK[ZZ(A,B)] Else H1=900 : H2=900 DK[-1] End If 'MYPRINT[" dc.l "+ Fn MY$(H1*256)+","+ Fn MY$(H2*256)] Else DK[-1] 'MYPRINT[" dc.l 0,0"] 'MYPRINT[" dc.l 900*256,900*256"] End If 'MYPRINT[" dc.w "+ Fn MY$(L)+","+ Fn MY$(XA)+","+ Fn MY$(YA)+",0"] DK[L] : PK[XA] : PK[YA] : DK[0] ZW(A,B,0)=T : ZW(A,B,1)=T : Add T,1 Next End If Next 'MYPRINT[" "] 13 T=0 For A=0 To NP : PW(A)=-1 : Next For A=0 To NZ-1 For B=0 To ZP(A)-1 If WT(A,B)=1 PW(ZO(A,B))=T PCW(ZO(A,B),1)=ZO(A,B+1) PCW(ZO(A,B+1),0)=ZO(A,B) End If Add T,1 Next Next DK[NZ] For A=0 To NZ-1 BT=0 : UT=0 For B=0 To ZP(A)-1 For C=0 To 1 PB=ZPBR(A,B,C) and $FF If PB>127 Then PB=PB-256 BT=BT+PB Next For C=0 To 1 PB=ZPBR(A,B,C+2) and $FF If PB>127 Then PB=PB-256 UT=UT+PB Next Next BT=BT/(ZP(A)*2) UT=UT/(ZP(A)*2) ZB(A)=BT : UZB(A)=UT Next For A=0 To NZ-1 If ZP(A)>0 'MYPRINT["ZoneBorders"+ Fn MY$(A)+":"] 'M$="" 'B$="" ZBPT=MP For B=0 To ZP(A)-1 'M$=M$+ Fn MY$(ZW(A,B,1))+"," DK[ZW(A,B,1)] Next 'MYPRINT[" dc.w "+M$+"-1"] DK[-1] ' L=ZP(A)-1 For B=0 To ZP(A)-1 If PW(ZO(A,B))<>-1 If ZO(A,L)<>PCW(ZO(A,B),0) DK[PW(PCW(ZO(A,B),0))] End If If ZO(A,B+1)<>PCW(ZO(A,B),1) DK[PW(ZO(A,B))] End If End If L=(L+1) mod ZP(A) Next DK[-2] 'MYPRINT["ZoneDat"+ Fn MY$(A)+":"] 'MYPRINT[" dc.w "+ Fn MY$(A)] ZDPT(A)=MP DK[A] '2 'If ZLI(A)>0 ' MYPRINT["ZoneFloor"+ Fn MY$(A)+":"] 'End If 'MYPRINT[" dc.l "+ Fn MY$(ZH(A,0)*256)] LK[ZH(A,0)*256] '6 'If ZD(A)>0 ' MYPRINT["ZoneRoof"+ Fn MY$(A)+":"] 'End If 'MYPRINT[" dc.l "+ Fn MY$(ZH(A,1)*256)] LK[ZH(A,1)*256] '10 LK[UZH(A,0)*256] '14 LK[UZH(A,1)*256] '18 LK[ZH(A,2)*256] '22 'MYPRINT[" dc.w "+ Fn MY$(ZB(A))] DK[ZB(A)] '24 DK[UZB(A)] '26 'MYPRINT[" dc.w "+ Fn MY$(ZCPT(A))] PK[ZCPT(A)] : PK[UZCPT(A)] '28 'MYPRINT[" dc.l 0"] LK[BSFX(A)] '32 'MYPRINT[" dc.l ZoneBorders"+ Fn MY$(A)] DK[ZBPT-ZDPT(A)] '34 'MYPRINT[" dc.l ZPTS"+ Fn MY$(A)] ZPPT=MP DK[0] '36 S=Start(14)+(A*64*6) BACK=0 For QQ=0 To NZ : ZU(QQ)=0 : Next For B=0 To 63 C=Deek(S) If C<>65535 ZU(C)=1 If ZRG(C,0)=16 BACK=1 End If End If Add S,6 Next ZU(A)=1 If BACK=1 or ZRG(A,0)=16 'MYPRINT[" dc.l BackGraph"] PK[-1] 'MYPRINT[" dc.l NullClip,0"] Else PK[0] End If PK[ECHO(A)] '38 DK[TELZO(A)] : DK[TELX(A)] : DK[-TELZ(A)] '44 DK[ZFG(A,0)] : DK[UZFG(A,0)] '48 S=Start(14)+(A*64*6) For B=0 To NP+16 : PU(B)=0 : Next For K=0 To ZP(A)-1 PU(ZO(A,K))=1 Next For K=0 To 7 If SWWL(K,0)=A PU(NP+K+K+1)=1 PU(NP+K+K+2)=1 End If Next VAT=0 'MYPRINT[" dc.l ZoneGraph"+ Fn MY$(A)] DK[A] ' MYPRINT[" dc.l NullClip"] DK[-1] CORD=0 BTS=0 For QQ=0 To ZP(A)-1 If WT(A,QQ)<>1 Bset BTS,CORD Bset BTS+1,CORD Bset BTS+2,CORD Add BTS,3 End If Next 'MYPRINT[" dc.l "+Bin$(CORD)] LK[CORD] For B=0 To 63 If Deek(S)<>65535 L=Deek(S) CORD=Leek(S+2) BTS=0 For K=0 To ZP(L)-1 PU(ZO(L,K))=1 If WT(L,K)<>1 If ZU(ZZ(L,K))=1 Bset BTS,CORD End If End If Add BTS,3 Next For K=0 To 7 If SWWL(K,0)=L PU(NP+K+K+1)=1 PU(NP+K+K+2)=1 End If Next 'MYPRINT[" dc.l ZoneGraph"+ Fn MY$(Deek(S))] DK[Deek(S)] 'MYPRINT[" dc.l ZoneClip"+ Fn MY$(A)+"to"+ Fn MY$(VAT)] DK[0] 'MYPRINT[" dc.l "+Bin$(CORD)] LK[CORD] Add VAT,1 ' B$=" dc.w " ' If Deek(S+2)<>65535 ' B$=B$+ Fn MY$(Deek(S+2))+"," ' Else ' B$=B$+"-1," ' End If ' If Deek(S+4)<>65535 ' B$=B$+ Fn MY$(Deek(S+4))+"," ' Else ' B$=B$+"-1," ' End If ' If Deek(S+6)<>65535 ' B$=B$+ Fn MY$(Deek(S+6)) ' Else ' B$=B$+"-1" ' End If ' MYPRINT[B$] End If Add S,6 Next 'MYPRINT[" dc.l -1"] LK[-1] 'MYPRINT[" "] 'MYPRINT["ZPTS"+ Fn MY$(A)+":"] TMPT=MP Doke ZPPT,TMPT-ZDPT(A) T=0 M$="" For B=0 To NP+16 If PU(B)=1 'If T mod 10=9 ' M$=M$+ Fn MY$(B) : MYPRINT[" dc.w "+M$] : M$="" 'Else ' M$=M$+ Fn MY$(B)+"," 'End If 'Add T,1 DK[B] End If Next DK[-1] 'If M$="" ' MYPRINT[" dc.w -1"] 'Else ' MYPRINT[" dc.w "+M$+"-1"] 'End If End If Next 12 'If NP>-1 ' MYPRINT["AllPoints:"] ' M$="" ' For A=0 To NP+16 ' If A mod 10=9 ' M$=M$+ Fn MY$(A) : MYPRINT[" dc.w "+M$] : M$="" ' Else ' M$=M$+ Fn MY$(A)+"," ' End If ' Next ' If NP mod 10<>9 ' M$=Left$(M$,Len(M$)-1) ' MYPRINT[" dc.w "+M$] ' End If ' MYPRINT[" dc.w -1"] 'End If ' Bsave "ab3:levels/level_"+F$+"/twolev.bin",Start(15) To MP Bar TXP*8,8*4 To 640,80 Locate TXP,4 : Print "Calculating graphics file..." ' MP=Start(15) ' Pointer to door/Lift/switch/Graphiclist data LK[0] : LK[0] : LK[0] : LK[0] If NZ>0 'MYPRINT["ZoneAdds:"] For A=0 To NZ-1 'MYPRINT[" dc.l ZoneDat"+ Fn MY$(A)] LK[ZDPT(A)-Start(15)] Next Loke Start(15)+12,MP-Start(15) 'MYPRINT["ZoneGraphAdds:"] ZGAPT=MP For A=0 To NZ-1 'MYPRINT[" dc.l ZoneGraph"+ Fn MY$(A)] LK[0] : LK[0] Next For A=0 To NZ-1 'MYPRINT["ZoneGraph"+ Fn MY$(A)+": dc.w "+ Fn MY$(A)] B=MP-Start(15) Loke ZGAPT+(A*8),B DK[A] If ZP(A)>0 For B=0 To ZP(A)-1 X1=PX(ZO(A,B)) : Y1=PY(ZO(A,B)) X2=PX(ZO(A,B+1)) : Y2=PY(ZO(A,B+1)) L=Sqr((X2-X1)^2+(Y2-Y1)^2) L=L/2 GW=ZWG(A,B,3) If ZWG(A,B,1)=1 L=(L and(-GW)) L=L+GW End If If ZWG(A,B,1)=2 L=(L and(-GW)) If L=0 L=L+GW End If End If 'W$=" dc.l "+ Fn MY$(ZWG(A,B,0))+"*4096" W=ZWG(A,B,0)*65536 : CH=WCY(ZWG(A,B,2))-1 : CSV=WCSV(ZWG(A,B,2)) GW=GW-1 NB=(B+1) mod ZP(A) If WT(A,B)=0 H2=ZH(A,0) : H1=ZH(A,1) OH1=UZH(ZZ(A,B),1) OH2=UZH(ZZ(A,B),0) OH3=ZH(ZZ(A,B),1) OH4=ZH(ZZ(A,B),0) If OH1>OH3 OH1=-5000 : OH2=-5000 End If If H1OH2 'If H2OH2 TBV=0+1 'Else ' TBV=8+2 'End If VO=-Min(OH3,H2) and 255 'MYPRINT[" dc.w wall,"+ Fn MY$(ZO(A,B))+","+ Fn MY$(ZO(A,B+1))+",0,"+ Fn MY$(L)] PK[-1] : PK[0] : DK[ZO(A,B)] : DK[ZO(A,B+1)] : PK[B] : PK[NB] : DK[L] 'MYPRINT[W$] LK[W+VO] 'MYPRINT[" dc.w 0,0,0"] DK[ZWG(A,B,2)] : PK[CH] : PK[CSV] : PK[GW] : PK[TBV*16+BBV] 'MYPRINT[" dc.l "+ Fn MY$(H1)+"*256,"+ Fn MY$(H2)+"*256"] LK[Max(OH2,H1)*256] : LK[Min(H2,OH3)*256] PK[WB(A,B)] : PK[ZZ(A,B)] 'MYPRINT[" "] End If If H2>OH4 'If H1>OH4 TBV=1 'Else ' TBV=8+0 'End If BBV=0+0 VO=(-H2) and 255 'MYPRINT[" dc.w wall,"+ Fn MY$(ZO(A,B))+","+ Fn MY$(ZO(A,B+1))+",0,"+ Fn MY$(L)] PK[B+16] : PK[0] : DK[ZO(A,B)] : DK[ZO(A,B+1)] : PK[B] : PK[NB] : DK[L] 'MYPRINT[W$] LK[W+VO] 'MYPRINT[" dc.w 0,0,0"] DK[ZWG(A,B,2)] : PK[CH] : PK[CSV] : PK[GW] : PK[TBV*16+BBV] 'MYPRINT[" dc.l "+ Fn MY$(H1)+"*256,"+ Fn MY$(H2)+"*256"] LK[Max(OH4,H1)*256] : LK[H2*256] PK[WB(A,B)] : PK[ZZ(A,B)] 'MYPRINT[" "] End If For S=0 To 7 If SWWL(S,0)=A and SWWL(S,1)=B 'MYPRINT[" dc.w wall,"+ Fn MY$(NP+S+S+1)+","+ Fn MY$(NP+S+S+2)+",0,31"] DK[0] : DK[NP+S+S+1] : DK[NP+S+S+2] : DK[0] : DK[31] SGO(S)=MP-Start(15) 'MYPRINT["SWITCHGRAPH"+ Fn MY$(S)+":"] SW=(-ZH(A,0)) and 31 'MYPRINT[" dc.l 13*4096+"+ Fn MY$(SW)] LK[SW] 'MYPRINT[" dc.w 0,0,0"] DK[11] : PK[31] : PK[5] : DK[31] 'MYPRINT[" dc.l "+ Fn MY$(ZH(A,0)-64)+"*256,"+ Fn MY$(ZH(A,0)-32)+"*256"] LK[(ZH(A,0)-64)*256] : LK[(ZH(A,0)-32)*256] PK[WB(A,B)] : PK[ZZ(A,B)] 'MYPRINT[" "] End If Next End If If WT(A,B)=1 TBV=1 : BBV=0 VO=(-ZH(A,0)) and 255 'MYPRINT[" dc.w wall,"+ Fn MY$(ZO(A,B))+","+ Fn MY$(ZO(A,B+1))+",0,"+ Fn MY$(L)] PK[B] : PK[0] : DK[ZO(A,B)] : DK[ZO(A,B+1)] : PK[B] : PK[NB] : DK[L] 'MYPRINT[W$] LK[W+VO] 'MYPRINT[" dc.w 0,0,0"] DK[ZWG(A,B,2)] : PK[CH] : PK[CSV] : PK[GW] : PK[TBV*16+BBV] 'MYPRINT[" dc.l "+ Fn MY$(ZH(A,1))+"*256,"+ Fn MY$(ZH(A,0))+"*256"] LK[ZH(A,1)*256] : LK[ZH(A,0)*256] PK[WB(A,B)] : PK[ZZ(A,B)] 'MYPRINT[" "] For S=0 To 7 If SWWL(S,0)=A and SWWL(S,1)=B 'MYPRINT[" dc.w wall,"+ Fn MY$(NP+S+S+1)+","+ Fn MY$(NP+S+S+2)+",0,31"] DK[0] : DK[NP+S+S+1] : DK[NP+S+S+2] : DK[0] : DK[31] SGO(S)=MP-Start(15) 'MYPRINT["SWITCHGRAPH"+ Fn MY$(S)+":"] SW=(-ZH(A,0)) and 31 'MYPRINT[" dc.l 13*4096+"+ Fn MY$(SW)] LK[SW] 'MYPRINT[" dc.w 0,0,0"] DK[11] : PK[31] : PK[5] : DK[31] 'MYPRINT[" dc.l "+ Fn MY$(ZH(A,0)-64)+"*256,"+ Fn MY$(ZH(A,0)-32)+"*256"] LK[(ZH(A,0)-64)*256] : LK[(ZH(A,0)-32)*256] DK[WB(A,B)] 'MYPRINT[" "] End If Next End If If WT(A,B)=3 VO=(-ZH(A,0)) and 255 'MYPRINT[" dc.w seethruwall,"+ Fn MY$(ZO(A,B))+","+ Fn MY$(ZO(A,B+1))+",0,"+ Fn MY$(L)] DK[13] : DK[ZO(A,B)] : DK[ZO(A,B+1)] : PK[B] : PK[NB] : DK[L] 'MYPRINT[W$] LK[W+VO] 'MYPRINT[" dc.w 0,0,0"] DK[ZWG(A,B,2)] : PK[CH] : PK[CSV] : PK[GW] : PK[TBV*16+BBV] 'MYPRINT[" dc.l "+ Fn MY$(ZH(A,1))+"*256,"+ Fn MY$(ZH(A,0))+"*256"] LK[ZH(A,1)*256] : LK[ZH(A,0)*256] PK[WB(A,B)] : PK[ZZ(A,B)] 'MYPRINT[" "] End If If WT(A,B)=4 VO=(-ZH(A,0)) and 255 'MYPRINT[" dc.w seethruwall,"+ Fn MY$(ZO(A,B))+","+ Fn MY$(ZO(A,B+1))+","+ Fn MY$(-L)+",0"] DK[13] : DK[ZO(A,B)] : DK[ZO(A,B+1)] : PK[B] : PK[NB] : DK[L] 'MYPRINT[W$] LK[W+VO] 'MYPRINT[" dc.w 0,0,0"] DK[ZWG(A,B,2)] : PK[CH] : PK[CSV] : PK[GW] : PK[TBV*16+BBV] 'MYPRINT[" dc.l "+ Fn MY$(ZH(A,1))+"*256,"+ Fn MY$(ZH(A,0))+"*256"] LK[ZH(A,1)*256] : LK[ZH(A,0)*256] PK[WB(A,B)] : PK[ZZ(A,B)] 'MYPRINT[" "] End If If WT(A,B)=2 TBV=8 : BBV=0 H1=ZH(A,0) : H2=ZH(ZZ(A,B),0) If H2

H1 VO=(-H2) and 255 DWPT(A,B)=MP-Start(15) 'MYPRINT["DW_"+ Fn MY$(A)+"_"+ Fn MY$(B)+":"] 'MYPRINT[" dc.w wall,"+ Fn MY$(ZO(A,B))+","+ Fn MY$(ZO(A,B+1))+",0,"+ Fn MY$(L)] PK[B+16] : PK[0] : DK[ZO(A,B)] : DK[ZO(A,B+1)] : PK[B] : PK[NB] : DK[L] 'MYPRINT[W$] LK[W+VO] 'MYPRINT[" dc.w 0,0,0"] DK[ZWG(A,B,2)] : PK[CH] : PK[CSV] : PK[GW] : PK[TBV*16+BBV] 'MYPRINT[" dc.l "+ Fn MY$(H1)+"*256,"+ Fn MY$(H2)+"*256"] LK[H1*256] : LK[H2*256] PK[WB(A,B)] : PK[ZZ(A,B)] 'MYPRINT[" "] End If End If If WT(A,B)=5 TBV=8+0 : BBV=0 H1=ZH(A,0) : H2=ZH(A,3) DWPT(A,B)=MP-Start(15) 'MYPRINT["LW_"+ Fn MY$(A)+"_"+ Fn MY$(B)+":"] 'MYPRINT[" dc.w wall,"+ Fn MY$(ZO(A,B))+","+ Fn MY$(ZO(A,B+1))+",0,"+ Fn MY$(L)] PK[B+16] : PK[0] : DK[ZO(A,B)] : DK[ZO(A,B+1)] : PK[B] : PK[NB] : DK[L] 'MYPRINT[W$] LK[W] 'MYPRINT[" dc.w 0,0,0"] DK[ZWG(A,B,2)] : PK[CH] : PK[CSV] : PK[GW] : PK[TBV*16+BBV] 'MYPRINT[" dc.l "+ Fn MY$(H2)+"*256,"+ Fn MY$(H1)+"*256"] LK[H2*256] : LK[H1*256] PK[WB(A,B)] : PK[ZZ(A,B)] 'MYPRINT[" "] TBV=1 : BBV=8+1 H1=ZH(A,1) : H2=ZH(ZZ(A,B),1) If H2>H1 VO=(-H2) and 255 'MYPRINT[" dc.w wall,"+ Fn MY$(ZO(A,B))+","+ Fn MY$(ZO(A,B+1))+",0,"+ Fn MY$(L)] PK[-1] : PK[0] : DK[ZO(A,B)] : DK[ZO(A,B+1)] : PK[B] : PK[NB] : DK[L] 'MYPRINT[W$] LK[W+VO] 'MYPRINT[" dc.w 0,0,0"] DK[ZWG(A,B,2)] : PK[CH] : PK[CSV] : PK[GW] : PK[TBV*16+BBV] 'MYPRINT[" dc.l "+ Fn MY$(H1)+"*256,"+ Fn MY$(H2)+"*256"] LK[H1*256] : LK[H2*256] PK[WB(A,B)] : PK[ZZ(A,B)] 'MYPRINT[" "] End If End If Next FL=1 : RO=2 K$="" If FB(A)=1 FL=8 End If If ZLI(A)>0 ZLIPT(ZLI(A)-1)=MP-Start(15) 'MYPRINT["LF_"+ Fn MY$(A)+":"] End If 'MYPRINT[" dc.w "+K$+"floor,"+ Fn MY$(ZH(A,0))+"*4,"+ Fn MY$(ZP(A)-1)] DK[FL] : DK[ZH(A,0)*4] : DK[ZP(A)-1] 'M$=" dc.w "+ Fn MY$(ZO(A,0)) For B=0 To ZP(A)-1 'M$=M$+","+ Fn MY$(ZO(A,B)) DK[ZO(A,B)+(B*16*256)] Next DK[ZO(A,0)] 'MYPRINT[M$] R=ZFG(A,0) : R=(R/4)*256+(R mod 4) 'MYPRINT[" dc.w -1,"+ Fn MY$(R)+",0"] DK[ZFG(A,1)] : DK[R] : DK[0] 'MYPRINT[" "] ' If ZD(A)>0 'MYPRINT["DR_"+ Fn MY$(A)+":"] ZDOPT(ZD(A)-1)=MP-Start(15) End If If RB(A)=1 RO=9 End If If ZRG(A,0)<16 'MYPRINT[" dc.w "+K$+"roof,"+ Fn MY$(ZH(A,1))+"*4,"+ Fn MY$(ZP(A)-1)] DK[RO] : DK[ZH(A,1)*4] : DK[ZP(A)-1] 'M$=" dc.w "+ Fn MY$(ZO(A,0)) For B=0 To ZP(A)-1 'M$=M$+","+ Fn MY$(ZO(A,B)) DK[ZO(A,B)+(B*16*256)] Next DK[ZO(A,0)] 'MYPRINT[M$] R=ZRG(A,0) : R=(R/4)*256+(R mod 4) 'MYPRINT[" dc.w -1,"+ Fn MY$(R)+",0"] DK[ZRG(A,1)] : DK[R] : DK[0] End If If(ZH(A,2)0 'MYPRINT[" dc.w object"] DK[4] 'MYPRINT[" dc.l "+ Fn MY$(ZH(A,0)+4)+"*256,"+ Fn MY$(ZH(A,2))+"*256"] 'LK[(ZH(A,0)+4)*256] : LK[ZH(A,2)*256] DK[0] WAPT(A)=MP-Start(15) 'MYPRINT[" dc.w water,"+ Fn MY$(ZH(A,2))+"*4,"+ Fn MY$(ZP(A)-1)] DK[7] : DK[ZH(A,2)*4] : DK[ZP(A)-1] 'M$=" dc.w "+ Fn MY$(ZO(A,0)) For B=0 To ZP(A)-1 'M$=M$+","+ Fn MY$(ZO(A,B)) DK[ZO(A,B)+(B*16*256)] Next DK[ZO(A,0)] 'MYPRINT[M$] R=ZRG(A,0) : R=(R/4)*256+(R mod 4) 'MYPRINT[" dc.w 0,"+ Fn MY$(R)+",0"] DK[-1] : DK[R] : DK[0] 'MYPRINT[" dc.w object"] DK[4] 'MYPRINT[" dc.l "+ Fn MY$(ZH(A,2))+"*256,"+ Fn MY$(ZH(A,1))+"*256"] 'LK[ZH(A,2)*256] : LK[ZH(A,1)*256] DK[1] Else 'MYPRINT[" dc.w object"] DK[4] 'MYPRINT[" dc.l "+ Fn MY$(ZH(A,0)+4)+"*256,"+ Fn MY$(ZH(A,1))+"*256"] 'LK[(ZH(A,0)+4)*256] : LK[ZH(A,1)*256] DK[2] End If 'MYPRINT[" dc.w setclip,-1,-1,-1"] 'MYPRINT[" "] 'MYPRINT[" dc.l -1"] LK[-1] 'MYPRINT[" "] End If 'MYPRINT["ZoneGraph"+ Fn MY$(A)+": dc.w "+ Fn MY$(A)] If UZH(A,0)0 For B=0 To ZP(A)-1 NB=(B+1) mod ZP(A) X1=PX(ZO(A,B)) : Y1=PY(ZO(A,B)) X2=PX(ZO(A,B+1)) : Y2=PY(ZO(A,B+1)) L=Sqr((X2-X1)^2+(Y2-Y1)^2) L=L/2 GW=UZWG(A,B,3) If UZWG(A,B,1)=1 L=(L and(-GW)) L=L+GW End If If UZWG(A,B,1)=2 L=(L and(-GW)) If L=0 L=L+GW End If End If 'W$=" dc.l "+ Fn MY$(ZWG(A,B,0))+"*4096" W=UZWG(A,B,0)*65536 : CH=WCY(ZWG(A,B,2))-1 : CSV=WCSV(ZWG(A,B,2)) GW=GW-1 If WT(A,B)=0 H2=UZH(A,0) : H1=UZH(A,1) OH1=UZH(ZZ(A,B),1) OH2=UZH(ZZ(A,B),0) OH3=ZH(ZZ(A,B),1) OH4=ZH(ZZ(A,B),0) If OH1>OH3 OH1=-5000 : OH2=-5000 End If If H1OH2 TBV=1 : BBV=0 'MYPRINT[" dc.w wall,"+ Fn MY$(ZO(A,B))+","+ Fn MY$(ZO(A,B+1))+",0,"+ Fn MY$(L)] PK[-1] : PK[0] : DK[ZO(A,B)] : DK[ZO(A,B+1)] : PK[B] : PK[NB] : DK[L] 'MYPRINT[W$] LK[W] 'MYPRINT[" dc.w 0,0,0"] DK[UZWG(A,B,2)] : PK[CH] : PK[CSV] : PK[GW] : PK[TBV*16+BBV] 'MYPRINT[" dc.l "+ Fn MY$(H1)+"*256,"+ Fn MY$(H2)+"*256"] LK[Max(OH2,H1)*256] : LK[Min(H2,OH3)*256] PK[UWB(A,B)] : PK[ZZ(A,B)] 'MYPRINT[" "] End If If H2>OH4 TBV=1 : BBV=0 'MYPRINT[" dc.w wall,"+ Fn MY$(ZO(A,B))+","+ Fn MY$(ZO(A,B+1))+",0,"+ Fn MY$(L)] PK[B+16] : PK[0] : DK[ZO(A,B)] : DK[ZO(A,B+1)] : PK[B] : PK[NB] : DK[L] 'MYPRINT[W$] LK[W] 'MYPRINT[" dc.w 0,0,0"] DK[UZWG(A,B,2)] : PK[CH] : PK[CSV] : PK[GW] : PK[TBV*16+BBV] 'MYPRINT[" dc.l "+ Fn MY$(H1)+"*256,"+ Fn MY$(H2)+"*256"] LK[Max(OH4,H1)*256] : LK[H2*256] PK[UWB(A,B)] : PK[ZZ(A,B)] 'MYPRINT[" "] End If End If If WT(A,B)=1 TBV=1 : BBV=0 'MYPRINT[" dc.w wall,"+ Fn MY$(ZO(A,B))+","+ Fn MY$(ZO(A,B+1))+",0,"+ Fn MY$(L)] PK[B] : PK[0] : DK[ZO(A,B)] : DK[ZO(A,B+1)] : PK[B] : PK[NB] : DK[L] 'MYPRINT[W$] LK[W] 'MYPRINT[" dc.w 0,0,0"] DK[UZWG(A,B,2)] : PK[CH] : PK[CSV] : PK[GW] : PK[TBV*16+BBV] 'MYPRINT[" dc.l "+ Fn MY$(ZH(A,1))+"*256,"+ Fn MY$(ZH(A,0))+"*256"] LK[UZH(A,1)*256] : LK[UZH(A,0)*256] PK[UWB(A,B)] : PK[ZZ(A,B)] 'MYPRINT[" "] End If If WT(A,B)=3 'MYPRINT[" dc.w seethruwall,"+ Fn MY$(ZO(A,B))+","+ Fn MY$(ZO(A,B+1))+",0,"+ Fn MY$(L)] DK[13] : DK[ZO(A,B)] : DK[ZO(A,B+1)] : PK[B] : PK[NB] : DK[L] 'MYPRINT[W$] LK[W] 'MYPRINT[" dc.w 0,0,0"] DK[UZWG(A,B,2)] : PK[CH] : PK[CSV] : PK[GW] : PK[TBV*16+BBV] 'MYPRINT[" dc.l "+ Fn MY$(ZH(A,1))+"*256,"+ Fn MY$(ZH(A,0))+"*256"] LK[UZH(A,1)*256] : LK[UZH(A,0)*256] PK[UWB(A,B)] : PK[ZZ(A,B)] 'MYPRINT[" "] End If If WT(A,B)=4 'MYPRINT[" dc.w seethruwall,"+ Fn MY$(ZO(A,B))+","+ Fn MY$(ZO(A,B+1))+","+ Fn MY$(-L)+",0"] DK[13] : DK[ZO(A,B)] : DK[ZO(A,B+1)] : PK[B] : PK[NB] : DK[L] 'MYPRINT[W$] LK[W] 'MYPRINT[" dc.w 0,0,0"] DK[UZWG(A,B,2)] : PK[CH] : PK[CSV] : PK[GW] : PK[TBV*16+BBV] 'MYPRINT[" dc.l "+ Fn MY$(ZH(A,1))+"*256,"+ Fn MY$(ZH(A,0))+"*256"] LK[UZH(A,1)*256] : LK[UZH(A,0)*256] PK[UWB(A,B)] : PK[ZZ(A,B)] 'MYPRINT[" "] End If Next FL=1 : RO=2 K$="" If FB(A)=1 FL=8 End If If ZLI(A)>0 ZLIPT(ZLI(A)-1)=MP-Start(15) 'MYPRINT["LF_"+ Fn MY$(A)+":"] End If 'MYPRINT[" dc.w "+K$+"floor,"+ Fn MY$(ZH(A,0))+"*4,"+ Fn MY$(ZP(A)-1)] DK[FL] : DK[UZH(A,0)*4] : DK[ZP(A)-1] 'M$=" dc.w "+ Fn MY$(ZO(A,0)) For B=0 To ZP(A)-1 'M$=M$+","+ Fn MY$(ZO(A,B)) DK[ZO(A,B)+(B*16*256)] Next DK[ZO(A,0)] 'MYPRINT[M$] R=UZFG(A,0) : R=(R/4)*256+(R mod 4) 'MYPRINT[" dc.w -1,"+ Fn MY$(R)+",0"] DK[ZFG(A,1)] : DK[R] : DK[0] 'MYPRINT[" "] ' If ZD(A)>0 'MYPRINT["DR_"+ Fn MY$(A)+":"] ZDOPT(ZD(A)-1)=MP-Start(15) End If If RB(A)=1 RO=9 End If If UZRG(A,0)<16 'MYPRINT[" dc.w "+K$+"roof,"+ Fn MY$(ZH(A,1))+"*4,"+ Fn MY$(ZP(A)-1)] DK[RO] : DK[UZH(A,1)*4] : DK[ZP(A)-1] 'M$=" dc.w "+ Fn MY$(ZO(A,0)) For B=0 To ZP(A)-1 'M$=M$+","+ Fn MY$(ZO(A,B)) DK[ZO(A,B)+(B*16*256)] Next DK[ZO(A,0)] 'MYPRINT[M$] R=UZRG(A,0) : R=(R/4)*256+(R mod 4) 'MYPRINT[" dc.w -1,"+ Fn MY$(R)+",0"] DK[ZRG(A,1)] : DK[R] : DK[0] End If If UZH(A,2)-1 'MYPRINT[" dc.l SWITCHGRAPH"+ Fn MY$(S)] LK[SGO(S)] Else 'MYPRINT[" dc.l 0"] LK[0] End If 'MYPRINT[" dc.l 0"] LK[0] Next Bsave "ab3:levels/level_"+F$+"/twolev.graph.bin",Start(15) To MP End If ' Bar TXP*8,8*4 To 640,80 Locate TXP,4 : Print "Saving level as AB3:Includes/"+F$ ' MP=Start(15) Loke MP,NCPT Add MP,4 If NCPT>=0 For A=0 To NCPT Loke MP,CPTX(A) : Loke MP+4,CPTY(A) Doke MP+8,CPTZ(A) : Doke MP+10,CPTUL(A) Add MP,12 Next End If For A=0 To 20 Doke MP,DC(A) Doke MP+2,DRT(A) Doke MP+4,DLT(A) For Q=0 To 6 Doke MP+6+Q*2,OPS(A,Q) Next Add MP,20 Next For A=0 To 20 Doke MP,LIFTC(A) Doke MP+2,LSP(A) Doke MP+4,LRT(A) Doke MP+6,LLT(A) For Q=0 To 6 Doke MP+8+Q*2,LOPS(A,Q) Next Add MP,22 Next For A=0 To 7 Doke MP,SWWL(A,0) Doke MP+2,SWWL(A,1) Add MP,4 Next Doke MP,NO : Add MP,2 If NO>0 For A=0 To NO-1 : Loke MP,OBX(A) : Loke MP+4,OBZ(A) : Add MP,8 : Next End If Doke MP,NP : Add MP,2 If NP>-1 For A=0 To NP Loke MP,PX(A) Loke MP+4,PY(A) ' Loke MP+8,PBR(A) ' Loke MP+12,UPBR(A) Add MP,8 Next End If Doke MP,NZ : Add MP,2 If NZ>-1 For A=0 To NZ Loke MP,TELZO(A) : Add MP,4 Loke MP,TELX(A) : Add MP,4 Loke MP,TELZ(A) : Add MP,4 Doke MP,ZB(A) : Add MP,2 Doke MP,UZB(A) : Add MP,2 Doke MP,ZCPT(A) : Add MP,2 Doke MP,UZCPT(A) : Add MP,2 Doke MP,ZP(A) : Add MP,2 For B=0 To ZP(A) Doke MP,ZO(A,B) Doke MP+2,WT(A,B) Doke MP+4,ZC(A,B) Doke MP+6,ZWG(A,B,0) Doke MP+8,ZWG(A,B,1) Doke MP+10,ZWG(A,B,2) Doke MP+12,ZWG(A,B,3) Doke MP+14,UZWG(A,B,0) Doke MP+16,UZWG(A,B,1) Doke MP+18,UZWG(A,B,2) Doke MP+20,UZWG(A,B,3) Doke MP+22,WD(A,B) Doke MP+24,WLI(A,B) Doke MP+26,WB(A,B) Doke MP+28,UWB(A,B) Doke MP+30,ZPBR(A,B,0) Doke MP+32,ZPBR(A,B,1) Doke MP+34,ZPBR(A,B,2) Doke MP+36,ZPBR(A,B,3) Add MP,38 Next Loke MP,ZH(A,0) : Add MP,4 Loke MP,ZH(A,1) : Add MP,4 Loke MP,ZH(A,2) : Add MP,4 Loke MP,ZH(A,3) : Add MP,4 Loke MP,UZH(A,0) : Add MP,4 Loke MP,UZH(A,1) : Add MP,4 Loke MP,UZH(A,2) : Add MP,4 Loke MP,UZH(A,3) : Add MP,4 Poke MP,ZRG(A,0) : Poke MP+1,ZFG(A,0) : Add MP,2 Poke MP,ZRG(A,1)+10 : Poke MP+1,ZFG(A,1)+10 : Add MP,2 Poke MP,UZRG(A,0) : Poke MP+1,UZFG(A,0) : Add MP,2 Poke MP,UZRG(A,1)+10 : Poke MP+1,UZFG(A,1)+10 : Add MP,2 Doke MP,ZD(A) : Add MP,2 Doke MP,ZLI(A) : Add MP,2 Poke MP,RB(A) : Add MP,1 Poke MP,FB(A) : Add MP,1 S=Start(14)+(A*64*6) For B=0 To 63 Doke MP,Deek(S) : Doke MP+2,Deek(S+2) : Doke MP+4,Deek(S+4) Add MP,6 : Add S,6 Next Next End If Loke MP,PLX Loke MP+4,PLY Doke MP+8,PLZ Add MP,10 Loke MP,PLX2 Loke MP+4,PLY2 Doke MP+8,PLZ2 Add MP,10 For A=0 To 9 For B=1 To 160 PK[Asc(Mid$(LEVELTEXT$(A),B,1))] Next Next DK[EZONE] For A=0 To NZ-1 LK[BSFX(A)] Next For A=0 To NZ-1 LK[ECHO(A)] Next Bsave "ab3:levels/level_"+F$+"/twolev.dat",Start(15) To MP Bsave "ab3:levels/level_"+F$+"/twolev.obj",Start(12) To Start(12)+200*32 Bsave "ab3:levels/level_"+F$+"/twolev.links",Start(11) To Start(11)+100*100 ' Bar TXP*8,8*4 To 640,80 Return ' BBARRELSAVE: TP=Peek(S+10) If TP=0 Then H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) H=H*2+48 H=H-120*4 T=7*65536+0 DK[H] PK[60] : PK[60] LK[T] DK[Deek(S+6)] PK[32] : PK[32] PK[10] : PK[0] : PK[Deek(S+2)] : PK[0] For QQ=1 To 21 : DK[0] : Next PK[WATT] : PK[TP] Return ' ALIENSAVE: ' First put in the dummy effort: For RT=1 To 15 LK[0] : Next Poke ST+16,3 Doke ST+12,-1 ST=MP DK[A] DK[0] For RT=1 To 15 LK[0] : Next TP=Peek(S+10) If TP=0 H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) End If H=(H-8)*2 Poke ST+63,TP Poke ST+62,WATT Poke ST+16,0 Poke ST+54,Peek(S+2) Doke ST+50,Deek(S+4) Doke ST+12,Deek(S+6) Doke ST+52,Deek(S+8) Poke ST+18,ALHITPTS(Peek(S+2)) Poke ST+19,0 Doke ST+28,ZCPT(Deek(S+6)) Poke ST+21,Peek(S+12) Doke ST+24,Deek(S+14) Doke ST+32,Deek(S+16) Return THINGSAVE: For RT=1 To 15 LK[0] : Next TP=Peek(S+10) If TP=0 H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) End If H=(H-8)*2 Poke ST+63,TP Poke ST+62,WATT Poke ST+16,1 Poke ST+54,Peek(S+2) Doke ST+50,Deek(S+4) Doke ST+12,Deek(S+6) Doke ST+52,Deek(S+8) Doke ST+24,Deek(S+14) Doke ST+34,Deek(S+18) ANQ=Deek(S+12) ANQ=(ANQ*8192)/360 ANQ=ANQ and 8190 Doke ST+30,ANQ Return ENEMYSAVE: If Peek(S+1)=0 ' calculate start height TP=Peek(S+10) If TP=0 H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) End If H=(H-8)*2 ' M$=M$+ Fn MY$(H) ' MYPRINT[M$] DK[H] ' MYPRINT[" dc.b 64,64"] PK[64] : PK[64] ' 8 ' MYPRINT[" dc.l 0"] LK[0] ' 12 ' MYPRINT[" dc.w "+ Fn MY$(Deek(S+6))] DK[Deek(S+6)] ' 14 ' MYPRINT[" dc.b 32,32"] PK[32] : PK[32] ' 16 ' MYPRINT[" dc.b 0,0,"+ Fn MY$(Deek(S+2))+",0"] PK[0] : PK[0] : PK[Deek(S+2)] : PK[0] ' 20 ' MYPRINT[" dc.w "+ Fn MY$(Deek(S+4))+",0,0"] PK[0] : PK[Deek(S+4) and 255] : DK[0] : DK[0] ' 26 FINDCONT[OBX(A),OBZ(A)] P=Param ' MYPRINT[" dc.w "+ Fn MY$(P)+","+ Fn MY$(P)+",0"] DK[0] : DK[P] : DK[0] : DK[P] ' MYPRINT[" ds.w 16"] For QQ=0 To 13 : DK[0] : Next ' MYPRINT[" "] PK[WATT] : PK[TP] End If If Peek(S+1)=1 ' calculate start height TP=Peek(S+10) If TP=0 H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) End If H=(H-8)*2 ' M$=M$+ Fn MY$(H) ' MYPRINT[M$] DK[H] ' MYPRINT[" dc.b 64,64"] PK[64] : PK[64] ' 8 ' MYPRINT[" dc.l 0"] LK[0] ' 12 ' MYPRINT[" dc.w "+ Fn MY$(Deek(S+6))] DK[Deek(S+6)] ' 14 ' MYPRINT[" dc.b 32,32"] PK[32] : PK[32] ' 16 ' MYPRINT[" dc.b 0,0,"+ Fn MY$(Deek(S+2))+",0"] PK[14] : PK[0] : PK[Deek(S+2)] : PK[0] ' 20 ' MYPRINT[" dc.w "+ Fn MY$(Deek(S+4))+",0,0"] DK[Deek(S+4)] : DK[0] : DK[0] ' 26 FINDCONT[OBX(A),OBZ(A)] P=Param ' MYPRINT[" dc.w "+ Fn MY$(P)+","+ Fn MY$(P)+",0"] DK[P] : DK[P] : DK[0] ' MYPRINT[" ds.w 16"] For QQ=0 To 14 : DK[0] : Next ' MYPRINT[" "] PK[WATT] : PK[TP] End If If Peek(S+1)=2 TP=Peek(S+10) If TP=0 H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) End If ' calculate start height H=(ZH(Deek(S+6),0)-8)*2 ' M$=M$+ Fn MY$(H) ' MYPRINT[M$] DK[H] ' MYPRINT[" dc.b 64,64"] PK[64] : PK[64] ' 8 ' MYPRINT[" dc.l 0"] LK[0] ' 12 ' MYPRINT[" dc.w "+ Fn MY$(Deek(S+6))] DK[Deek(S+6)] ' 14 ' MYPRINT[" dc.b 32,32"] PK[32] : PK[32] ' 16 ' MYPRINT[" dc.b 8,0,"+ Fn MY$(Deek(S+2))+",0"] PK[8] : PK[0] : PK[Deek(S+2)] : PK[0] ' 20 ' MYPRINT[" dc.w "+ Fn MY$(Deek(S+4))+",0,0"] DK[Deek(S+4)] : DK[0] : DK[0] ' 26 FINDCONT[OBX(A),OBZ(A)] P=Param ' MYPRINT[" dc.w "+ Fn MY$(P)+","+ Fn MY$(P)+",0"] DK[P] : DK[P] : DK[0] ' MYPRINT[" ds.w 16"] For QQ=0 To 14 : DK[0] : Next PK[WATT] : PK[TP] ' MYPRINT[" "] End If If Peek(S+1)=3 ' calculate start height TP=Peek(S+10) If TP=0 H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) End If H=(H-8)*2 ' M$=M$+ Fn MY$(H) ' MYPRINT[M$] DK[H] ' MYPRINT[" dc.b 64,64"] PK[64] : PK[64] ' 8 ' MYPRINT[" dc.l 0"] LK[0] ' 12 ' MYPRINT[" dc.w "+ Fn MY$(Deek(S+6))] DK[Deek(S+6)] ' 14 ' MYPRINT[" dc.b 32,32"] PK[32] : PK[32] ' 16 ' MYPRINT[" dc.b 0,0,"+ Fn MY$(Deek(S+2))+",0"] PK[12] : PK[0] : PK[Deek(S+2)] : PK[0] ' 20 ' MYPRINT[" dc.w "+ Fn MY$(Deek(S+4))+",0,0"] DK[Deek(S+4)] : DK[0] : DK[0] ' 26 FINDCONT[OBX(A),OBZ(A)] P=Param ' MYPRINT[" dc.w "+ Fn MY$(P)+","+ Fn MY$(P)+",0"] DK[P] : DK[P] : DK[0] ' MYPRINT[" ds.w 16"] For QQ=0 To 14 : DK[0] : Next ' MYPRINT[" "] PK[WATT] : PK[TP] End If If Peek(S+1)=4 ' calculate start height TP=Peek(S+10) If TP=0 H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) End If H=(H-8)*2 ' M$=M$+ Fn MY$(H) ' MYPRINT[M$] DK[H] ' MYPRINT[" dc.b 64,64"] PK[64] : PK[64] ' 8 ' MYPRINT[" dc.l 0"] LK[0] ' 12 ' MYPRINT[" dc.w "+ Fn MY$(Deek(S+6))] DK[Deek(S+6)] ' 14 ' MYPRINT[" dc.b 32,32"] PK[32] : PK[32] ' 16 ' MYPRINT[" dc.b 0,0,"+ Fn MY$(Deek(S+2))+",0"] PK[13] : PK[0] : PK[Deek(S+2)] : PK[0] ' 20 ' MYPRINT[" dc.w "+ Fn MY$(Deek(S+4))+",0,0"] DK[Deek(S+4)] : DK[0] : DK[0] ' 26 FINDCONT[OBX(A),OBZ(A)] P=Param ' MYPRINT[" dc.w "+ Fn MY$(P)+","+ Fn MY$(P)+",0"] DK[P] : DK[P] : DK[0] ' MYPRINT[" ds.w 16"] For QQ=0 To 14 : DK[0] : Next ' MYPRINT[" "] PK[WATT] : PK[TP] End If If Peek(S+1)=5 ' calculate start height TP=Peek(S+10) If TP=0 H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) End If H=(H-8)*2 ' M$=M$+ Fn MY$(H) ' MYPRINT[M$] DK[H] ' MYPRINT[" dc.b 64,64"] PK[64] : PK[64] ' 8 ' MYPRINT[" dc.l 0"] LK[0] ' 12 ' MYPRINT[" dc.w "+ Fn MY$(Deek(S+6))] DK[Deek(S+6)] ' 14 ' MYPRINT[" dc.b 32,32"] PK[32] : PK[32] ' 16 ' MYPRINT[" dc.b 0,0,"+ Fn MY$(Deek(S+2))+",0"] PK[16] : PK[0] : PK[Deek(S+2)] : PK[0] ' 20 ' MYPRINT[" dc.w "+ Fn MY$(Deek(S+4))+",0,0"] DK[Deek(S+4)] : DK[0] : DK[0] ' 26 FINDCONT[OBX(A),OBZ(A)] P=Param ' MYPRINT[" dc.w "+ Fn MY$(P)+","+ Fn MY$(P)+",0"] DK[P] : DK[P] : DK[0] ' MYPRINT[" ds.w 16"] For QQ=0 To 14 : DK[0] : Next ' MYPRINT[" "] PK[WATT] : PK[TP] End If If Peek(S+1)=6 ' calculate start height TP=Peek(S+10) If TP=0 H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) End If H=(H-8)*2 ' M$=M$+ Fn MY$(H) ' MYPRINT[M$] DK[H] ' MYPRINT[" dc.b 64,64"] PK[64] : PK[64] ' 8 ' MYPRINT[" dc.l 0"] LK[0] ' 12 ' MYPRINT[" dc.w "+ Fn MY$(Deek(S+6))] DK[Deek(S+6)] ' 14 ' MYPRINT[" dc.b 32,32"] PK[32] : PK[32] ' 16 ' MYPRINT[" dc.b 0,0,"+ Fn MY$(Deek(S+2))+",0"] PK[18] : PK[0] : PK[Deek(S+2)] : PK[0] ' 20 ' MYPRINT[" dc.w "+ Fn MY$(Deek(S+4))+",0,0"] DK[Deek(S+4)] : DK[0] : DK[0] ' 26 FINDCONT[OBX(A),OBZ(A)] P=Param ' MYPRINT[" dc.w "+ Fn MY$(P)+","+ Fn MY$(P)+",0"] DK[P] : DK[P] : DK[0] ' MYPRINT[" ds.w 16"] For QQ=0 To 14 : DK[0] : Next ' MYPRINT[" "] PK[WATT] : PK[TP] End If If Peek(S+1)=7 ' calculate start height TP=Peek(S+10) If TP=0 H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) End If H=(H-8)*2 ' M$=M$+ Fn MY$(H) ' MYPRINT[M$] DK[H] ' MYPRINT[" dc.b 64,64"] PK[64] : PK[64] ' 8 ' MYPRINT[" dc.l 0"] LK[0] ' 12 ' MYPRINT[" dc.w "+ Fn MY$(Deek(S+6))] DK[Deek(S+6)] ' 14 ' MYPRINT[" dc.b 32,32"] PK[32] : PK[32] ' 16 ' MYPRINT[" dc.b 0,0,"+ Fn MY$(Deek(S+2))+",0"] PK[19] : PK[0] : PK[Deek(S+2)] : PK[0] ' 20 ' MYPRINT[" dc.w "+ Fn MY$(Deek(S+4))+",0,0"] DK[Deek(S+4)] : DK[0] : DK[0] ' 26 FINDCONT[OBX(A),OBZ(A)] P=Param ' MYPRINT[" dc.w "+ Fn MY$(P)+","+ Fn MY$(P)+",0"] DK[P] : DK[P] : DK[0] ' MYPRINT[" ds.w 16"] For QQ=0 To 14 : DK[0] : Next ' MYPRINT[" "] PK[WATT] : PK[TP] End If Return ' MARINESAVE: ' calculate start height H=(ZH(Deek(S+6),0)-8)*2 'M$=M$+ Fn MY$(H) 'MYPRINT[M$] DK[H] 'MYPRINT[" dc.b 64,64"] PK[64] : PK[64] ' 8 'MYPRINT[" dc.l 0"] LK[0] ' 12 'MYPRINT[" dc.w "+ Fn MY$(Deek(S+6))] DK[Deek(S+6)] ' 14 'MYPRINT[" dc.b 32,32"] PK[32] : PK[32] ' 16 'MYPRINT[" dc.b 5,0,"+ Fn MY$(Deek(S+2))+",0"] PK[5] : PK[0] : PK[Deek(S+2)] : PK[0] ' 20 'MYPRINT[" dc.w "+ Fn MY$(Deek(S+4))+",0,0"] DK[Deek(S+4)] : DK[0] : DK[0] ' 26 FINDCONT[OBX(A),OBZ(A)] P=Param 'MYPRINT[" dc.w "+ Fn MY$(P)+","+ Fn MY$(P)+",0"] DK[P] : DK[P] : DK[0] 'MYPRINT[" dc.w "+ Fn MY$(Deek(S+8))] DK[Deek(S+8)] 'MYPRINT[" ds.w 15"] For QQ=0 To 14 : DK[0] : Next 'MYPRINT[" "] Return ' GLASSSAVE: ' calculate start height H=(ZH(Deek(S+6),0)-8)*2-80 'M$=M$+ Fn MY$(H) 'MYPRINT[M$] DK[H] 'MYPRINT[" dc.b 64,64"] PK[64] : PK[64] ' 8 'MYPRINT[" dc.l -1"] LK[-1] ' 12 'MYPRINT[" dc.w "+ Fn MY$(Deek(S+6))] DK[Deek(S+6)] ' 14 'MYPRINT[" dc.b 32,32"] PK[32] : PK[32] ' 16 'MYPRINT[" dc.b -1,-1,"+ Fn MY$(Deek(S+2))+",0"] PK[-1] : PK[-1] : PK[Deek(S+2)] : PK[0] ' 20 'MYPRINT[" dc.w "+ Fn MY$(Deek(S+4))+",0,0"] DK[Deek(S+4)] : DK[0] : DK[0] ' 26 FINDCONT[OBX(A),OBZ(A)] P=Param 'MYPRINT[" dc.w "+ Fn MY$(P)+","+ Fn MY$(P)+",0"] DK[P] : DK[P] : DK[0] 'MYPRINT[" dc.w "+ Fn MY$(Deek(S+8))] DK[Deek(S+8)] 'MYPRINT[" ds.w 15"] For QQ=0 To 14 : DK[0] : Next 'MYPRINT[" "] Return ' MEDISAVE: ' MED_GRAPH=1*65536 ' TP=Peek(S+10) If TP=0 H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) End If H=H*2-16 'M$=M$+ Fn MY$(H) 'MYPRINT[M$] DK[H] 'MYPRINT[" dc.b 32,32"] PK[32] : PK[32] 'MYPRINT[" dc.l MediKit_Graph"] LK[MED_GRAPH] 'MYPRINT[" dc.w "+ Fn MY$(Deek(S+6))] DK[Deek(S+6)] 'MYPRINT[" dc.b 16,16"] PK[16] : PK[16] 'MYPRINT[" dc.b 1,"+ Fn MY$(Peek(S+1))] PK[1] : PK[Peek(S+1)] 'MYPRINT[" dc.w "+ Fn MY$(Deek(S+2))] DK[Deek(S+2)] 'MYPRINT[" dc.w 0,0,0,0,0,0"] 'MYPRINT[" ds.w 16"] For QQ=1 To 21 : DK[0] : Next PK[WATT] : PK[TP] Return AMMOSAVE: ' AMMO_GRAPH=1*65536+3 ' TP=Peek(S+10) If TP=0 H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) End If H=H*2-16 'M$=M$+ Fn MY$(H) 'MYPRINT[M$] DK[H] 'MYPRINT[" dc.b 32,32"] PK[32] : PK[32] 'MYPRINT[" dc.l MediKit_Graph"] LK[AMMO_GRAPH+Deek(S+2)] 'MYPRINT[" dc.w "+ Fn MY$(Deek(S+6))] DK[Deek(S+6)] 'MYPRINT[" dc.b 16,16"] PK[16] : PK[16] 'MYPRINT[" dc.b 1,"+ Fn MY$(Peek(S+1))] PK[9] : PK[Peek(S+1)] 'MYPRINT[" dc.w "+ Fn MY$(Deek(S+2))] DK[Deek(S+2)] 'MYPRINT[" dc.w 0,0,0,0,0,0"] 'MYPRINT[" ds.w 16"] For QQ=1 To 21 : DK[0] : Next PK[WATT] : PK[TP] Return ' KEYSAVE: KEYGRAPH(0)=5*65536 KEYGRAPH(1)=5*65536+1 KEYGRAPH(2)=5*65536+2 KEYGRAPH(3)=5*65536+3 TP=Peek(S+10) If TP=0 H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) End If H=(H-32)*2+48 'M$=M$+ Fn MY$(H) 'MYPRINT[M$] DK[H] 'MYPRINT[" dc.b 32,32"] PK[32] : PK[32] CO=Peek(S+1) 'MYPRINT[" dc.l KeyGraph"+ Fn MY$(CO)] LK[KEYGRAPH(CO)] 'MYPRINT[" dc.w "+ Fn MY$(Deek(S+6))] DK[Deek(S+6)] 'MYPRINT[" dc.b 16,16"] PK[16] : PK[16] 'MYPRINT[" dc.b 4,"+ Fn MY$(2^CO)] PK[4] : PK[2^CO] 'MYPRINT[" dc.w 0,0,0,0,0,0,0"] 'MYPRINT[" ds.w 16"] For QQ=1 To 22 : DK[0] : Next PK[WATT] : PK[TP] Return ' DDECOSAVE: TP=Peek(S+10) DT=Deek(S+2) ' LAMP If DT=0 If TP=0 H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) End If H=H*2 H=H-30*2 T=12*65536 DK[H] PK[15] : PK[60] LK[T] DK[Deek(S+6)] PK[7] : PK[31] End If 'EXIT SIGN If DT=1 If TP=0 H=ZH(Deek(S+6),1) Else H=UZH(Deek(S+6),1) End If H=H*2 T=$20000 DK[H] PK[-1] : PK[-1] LK[T] DK[Deek(S+6)] PK[8] : PK[32] End If If DT=2 If TP=0 H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) End If H=H*2 H=H-(30+32)*2 T=-18 DK[H] PK[31] : PK[63] DK[T] : DK[0] DK[Deek(S+6)] PK[15] : PK[31] End If PK[-1] : PK[0] : PK[Deek(S+2)] : PK[0] For QQ=1 To 5 : DK[0] : Next DK[Deek(S+8)] For QQ=7 To 21 DK[0] : Next PK[WATT] : PK[TP] Return ' FLHASAVE: TP=Peek(S+10) If TP=0 H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) End If H=H*2 M$=M$+ Fn MY$(H) 'MYPRINT[M$] DK[H] 'MYPRINT[" dc.b -1,-1"] PK[-1] : PK[-1] K=Peek(S+1) 'MYPRINT[" dc.l "+VECT$(K)+"_des"] DK[K] : DK[0] 'MYPRINT[" dc.w "+ Fn MY$(Deek(S+6))] DK[Deek(S+6)] 'MYPRINT[" dc.b 16,16"] PK[16] : PK[16] 'MYPRINT[" dc.b 255,255"] If Peek(S+1)=0 PK[6] : PK[-1] Else If Peek(S+1)=9 PK[20] : PK[-1] Else PK[-1] : PK[-1] End If End If PK[100] : PK[0] 'MYPRINT[" dc.w 0,0,0,0,0"] 'MYPRINT[" ds.w 16"] For QQ=1 To 5 : DK[0] : Next ANG=Deek(S+8) : ANG=(ANG*8192)/360 ANG=ANG and 8190 DK[ANG] For QQ=1 To 15 : DK[0] : Next PK[WATT] : PK[TP] Doke ST+34,Deek(S+12) Return ' BIGGUNSAVE: ' BIGGUN_GRAPH=65536 ' GT=Peek(S+1) TP=Peek(S+10) If TP=0 H=ZH(Deek(S+6),0) Else H=UZH(Deek(S+6),0) End If H=H*2+48 H=H-BIGGUNDIM(GT,1)*4 T=BIGGUNGRAPH(GT) 'M$=M$+ Fn MY$(H) 'MYPRINT[M$] DK[H] 'MYPRINT[" dc.b 64,32"] PK[BIGGUNDIM(GT,0)*2] : PK[BIGGUNDIM(GT,1)*2] 'MYPRINT[" dc.l BigGun_Graph"] LK[BIGGUN_GRAPH+T] 'MYPRINT[" dc.w "+ Fn MY$(Deek(S+6))] DK[Deek(S+6)] 'MYPRINT[" dc.b 32,16"] PK[BIGGUNDIM(GT,0)] : PK[BIGGUNDIM(GT,1)] 'MYPRINT[" dc.b 3,0"] PK[3] : PK[GT] 'MYPRINT[" dc.w 0,0,0,0,0,0,0"] 'MYPRINT[" ds.w 16"] For QQ=1 To 22 : DK[0] : Next PK[WATT] : PK[TP] Return ' LEVELLOAD: Screen 0 Ink 0 : Bar TXP*8,8*4 To 640,80 Curs Off Locate TXP,4 : Print "Enter file name to load level:" Locate TXP,5 : Input "Filename: ";F$ If F$="" Then Return Curs Off Bar TXP*8,8*4 To 640,80 Locate TXP,4 : Print "Loading level data..." Bload "ab3:levels/level_"+F$+"/twolev.dat",Start(15) MP=Start(15) NCPT=Leek(MP) Add MP,4 If NCPT>=0 For A=0 To NCPT CPTX(A)=Leek(MP) : CPTY(A)=Leek(MP+4) CPTZ(A)=Deek(MP+8) : CPTUL(A)=Deek(MP+10) Add MP,12 Next End If For A=0 To 20 DC(A)=Deek(MP) DRT(A)=Deek(MP+2) DLT(A)=Deek(MP+4) For Q=0 To 6 OPS(A,Q)=Deek(MP+6+Q*2) Next Add MP,20 Next For A=0 To 20 LIFTC(A)=Deek(MP) and %111111111111 LSP(A)=Deek(MP+2) LRT(A)=Deek(MP+4) LLT(A)=Deek(MP+6) For Q=0 To 6 LOPS(A,Q)=Deek(MP+8+Q*2) Next Add MP,22 Next '********************************************** '* TAKE OUT FOR OTHER LEVEL '********************************************** For A=0 To 7 SWWL(A,0)=Deek(MP) SWWL(A,1)=Deek(MP+2) If SWWL(A,0)=65535 Then SWWL(A,0)=-1 If SWWL(A,1)=65535 Then SWWL(A,1)=-1 Add MP,4 Next '**************************** NO=Deek(MP) : Add MP,2 If NO>0 For A=0 To NO-1 OBX(A)=Leek(MP) : OBZ(A)=Leek(MP+4) : Add MP,8 Next End If NP=Deek(MP) : Add MP,2 If NP>-1 For A=0 To NP PX(A)=Leek(MP) PY(A)=Leek(MP+4) 'PBR(A)=Leek(MP+8) 'UPBR(A)=Leek(MP+12) Add MP,8 Next End If NZ=Deek(MP) : Add MP,2 If NZ>-1 For A=0 To NZ TELZO(A)=Leek(MP) : Add MP,4 TELX(A)=Leek(MP) : Add MP,4 TELZ(A)=Leek(MP) : Add MP,4 ZB(A)=Deek(MP) : Add MP,2 UZB(A)=Deek(MP) : Add MP,2 ZCPT(A)=Deek(MP) : Add MP,2 UZCPT(A)=Deek(MP) : Add MP,2 If ZB(A)>32767 ZB(A)=ZB(A)-65536 End If ZP(A)=Deek(MP) : Add MP,2 If ZP(A)>0 USED(A)=1 End If For B=0 To ZP(A) ZO(A,B)=Deek(MP) WT(A,B)=Deek(MP+2) ZC(A,B)=Deek(MP+4) ZWG(A,B,0)=Deek(MP+6) ZWG(A,B,1)=Deek(MP+8) ZWG(A,B,2)=Deek(MP+10) ZWG(A,B,3)=Deek(MP+12) If ZWG(A,B,3)=0 ZWG(A,B,3)=64 End If UZWG(A,B,0)=Deek(MP+14) UZWG(A,B,1)=Deek(MP+16) UZWG(A,B,2)=Deek(MP+18) UZWG(A,B,3)=Deek(MP+20) If UZWG(A,B,3)=0 UZWG(A,B,3)=64 End If WD(A,B)=Deek(MP+22) WLI(A,B)=Deek(MP+24) WB(A,B)=Deek(MP+26) If WB(A,B)>32767 WB(A,B)=WB(A,B)-65536 End If UWB(A,B)=Deek(MP+28) If UWB(A,B)>32767 UWB(A,B)=UWB(A,B)-65536 End If For C=0 To 3 ZPBR(A,B,C)=Deek(MP+30+C+C) If ZPBR(A,B,C)>32767 ZPBR(A,B,C)=ZPBR(A,B,C)-65536 End If Next Add MP,38 Next ZH(A,0)=Leek(MP) : Add MP,4 ZH(A,1)=Leek(MP) : Add MP,4 ZH(A,2)=Leek(MP) : Add MP,4 ZH(A,3)=Leek(MP) : Add MP,4 UZH(A,0)=Leek(MP) : Add MP,4 UZH(A,1)=Leek(MP) : Add MP,4 UZH(A,2)=Leek(MP) : Add MP,4 UZH(A,3)=Leek(MP) : Add MP,4 ZRG(A,0)=Peek(MP) : ZFG(A,0)=Peek(MP+1) : Add MP,2 ZRG(A,1)=Peek(MP)-10 : ZFG(A,1)=Peek(MP+1)-10 : Add MP,2 UZRG(A,0)=Peek(MP) : UZFG(A,0)=Peek(MP+1) : Add MP,2 UZRG(A,1)=Peek(MP)-10 : UZFG(A,1)=Peek(MP+1)-10 : Add MP,2 ZD(A)=Deek(MP) : Add MP,2 ZLI(A)=Deek(MP) : Add MP,2 RB(A)=Peek(MP) : Add MP,1 FB(A)=Peek(MP) : Add MP,1 S=Start(14)+(A*64*6) For B=0 To 63 Doke S,Deek(MP) Doke S+2,Deek(MP+2) Doke S+4,Deek(MP+4) Add MP,6 : Add S,6 Next Next End If PLX=Leek(MP) PLY=Leek(MP+4) PLZ=Deek(MP+8) Add MP,10 PLX2=Leek(MP) PLY2=Leek(MP+4) PLZ2=Deek(MP+8) Add MP,10 For A=0 To 9 LEVELTEXT$(A)="" For B=1 To 160 LEVELTEXT$(A)=LEVELTEXT$(A)+Chr$(Peek(MP)) : Add MP,1 Next Next EZONE=Deek(MP) : Add MP,2 For A=0 To NZ-1 BSFX(A)=Leek(MP) : Add MP,4 Next For A=0 To NZ-1 ECHO(A)=Leek(MP) : Add MP,4 Next Bload "ab3:levels/level_"+F$+"/twolev.obj",Start(12) Bload "ab3:levels/level_"+F$+"/twolev.links",Start(11) For A=0 To 99 For B=0 To 99 Q=Peek(Start(11)+A*100+B) W=Peek(Start(11)+B*100+A) If Q=1 and W=0 Poke Start(11)+A*100+B,0 End If If Q=0 and W=1 Poke Start(11)+B*100+A,0 End If Next Next Bar TXP*8,8*4 To 640,80 Gosub REDRAW Return ' Procedure MYPRINT[M$] End Proc ' REDRAW: Screen 2 : Extension -1 If NP=-1 Then Return For QA=0 To NP : PTSHOW[PX(QA),PY(QA),2] : Next If NZ=-1 Then Return For QA=0 To NZ-1 If USED(QA) Then ZOSHO[QA,4] Next If USED(CZ) Then ZOSHO[CZ,10] OUTLINE[CP] If NO>0 For QA=0 To NO-1 OBJPUT[OBX(QA),OBZ(QA),2] Next End If If NCPT>=0 For QA=0 To NCPT CPTPUT[CPTX(QA),CPTY(QA),8-CPTUL(QA)*2] Next End If If NCPT>0 For QA=0 To NCPT-1 For QB=QA+1 To NCPT CONNECTED[QA,QB,P1] Next Next End If PTSHOW[PLX,PLY,-1] Return ' PICKBUTTON: M=Mouse Click If X>=16*6 Then Gosub MENCLICK : Return If M=0 Then Return ' Screen 0 : Ink 0 : Bar 32*6,0 To 640,48 If OP=4 Then Gosub TIDYDEFWALL If OP=1 Then Gosub TIDYDEFZONE If OP=9 or OP=12 or OP=15 or OP=18 Then Gosub TIDYDEFHEIGHT If OP=11 Then Gosub TIDYPLACEPLAYER If OP=7 Then Gosub TIDYDEFORDER If OP=2 Then Gosub TIDYOBJ If OP=14 Then Gosub TIDYDEFDOOR If OP=17 Then Gosub TIDYDEFLIFT If OP>=21 and OP<27 Then Gosub TIDYDEFGRAPH 'If OP=21 Then Gosub TIDYPATHDEF 'If OP=22 Then Gosub TIDYPATHDEF ' If OP=36 Then Gosub TIDYDEFDOOR 'If OP=37 Then Gosub TIDYDEFDOOR X=X/16 : Y=(Y-200)/16 X=X If Y<0 Then Return If Y>47 Then Return SHINEBOX[OP,0] OP=((EBX+X)*3)+Y : SHINEBOX[OP,3] If OP=1 Then Gosub INITDEFZONE If OP=7 Then Gosub INITDEFORDER If OP=2 Then Gosub INITOBJ If OP=14 Then Gosub INITDEFDOOR If OP=17 Then Gosub INITDEFLIFT If OP>20 and OP<27 Then Gosub INITDEFGRAPH If OP=10 or OP=13 or OP=16 or OP=19 Then PBR=0 : PAN=0 : PDTA=0 : Gosub BRIGHTSLIDE 'If OP=21 Then Gosub INITPATHDEF If OP=23 Then ZFG=0 : ZFGS=0 : OZFG=1 : ZFGS=1 If OP=22 Then ZWG=0 : LZWG=1 : ZWGC=0 : LWCHUNK=1 If OP=21 Then ZRG=0 : ZRGS=0 : OZRG=1 : ZRGS=1 If OP=24 Then ZRG=0 : ZRGS=0 : OZRG=1 : ZRGS=1 If OP=25 Then ZWG=0 : LZWG=1 : ZWGC=0 : LWCHUNK=1 If OP=26 Then ZFG=0 : ZFGS=0 : OZFG=1 : ZFGS=1 If OP=31 Then P1=-1 : P2=-1 If OP=36 Then Gosub INITDEFBACKSFX 'If OP=37 Then Gosub ECHOSLIDE Paper 0 : Pen 1 S=Screen : Screen 0 Paper 0 : Pen 1 Locate TXP,0 : Print BUT$(OP) Screen S Return ' MENCLICK: If OP=2 Then Gosub SETOBJPARAM If OP=14 Then Gosub DEFDOORCOND If OP=17 Then Gosub DEFLIFTCOND If OP=36 Then Gosub SFXTOGGLE 'If OP=21 Then Gosub PATHCOMPICK If OP=10 or OP=13 or OP=16 or OP=19 Then Gosub SETPOINTBRIGHT 'If OP=37 Then Gosub SETECHOLEN Return ' INITDEFBACKSFX: S=Screen Screen 0 Locate 40,1 Pen 1 Print "0123456789ABCDEF" Locate 40,2 For B=0 To 15 If Btst(B,BSFX) Print "*"; Else Print " "; End If Next Locate 40,3 Pen 1 Print "0123456789ABCDEF" Locate 40,4 For B=0 To 15 If Btst(B+16,BSFX) Print "*"; Else Print " "; End If Next Screen S Return DEFBACKSFX: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Click : If M=0 Then Return X=(X*MU)+XO : Y=(Y*MU)+YO ZOSHO[CZ,4] ZOGET[X,Y] : P=Param : If P>=0 Then CZ=P ZOSHO[CZ,10] If CZ<0 Then Return If M=1 BSFX(CZ)=BSFX End If If M=2 BSFX=BSFX(CZ) Gosub INITDEFBACKSFX End If Return DEFECHO: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Click : If M=0 Then Return X=(X*MU)+XO : Y=(Y*MU)+YO ZOSHO[CZ,4] ZOGET[X,Y] : P=Param : If P>=0 Then CZ=P ZOSHO[CZ,10] If CZ<0 Then Return If M=1 ECHO(CZ)=ECHOLEN End If If M=2 ECHOLEN=ECHO(CZ) Gosub ECHOSLIDE End If Return SFXTOGGLE: X=X-160 CX=X/4 : CY=(Y-200)/8 If M<>0 If CX<16 and CX>=0 If CY>2 Add CX,16 End If Bchg CX,BSFX Gosub INITDEFBACKSFX End If End If Return SETOBJPARAM: X=X-100 If X<0 Then Return If M=0 Then Return Gosub PARSET Return PARSET: CX=X/4 : CY=(Y-200)/8 If CY=1 OT=1-OT Gosub INITOBJ End If If CY=2 If M=1 If OT=0 ALTO=(ALTO+1) mod 20 Else OBTO=(OBTO+1) mod 30 End If Else If OT=0 ALTO=(ALTO+19) mod 20 Else OBTO=(OBTO+29) mod 30 End If End If End If If CY=3 CX=CX-12 If CX>=0 and CX<16 Bchg CX,DLOCKED Else Locate TXP+30,3 : Input "Text: ";TXT End If End If If CY=4 CX=CX-12 If CX>=0 and CX<16 Bchg CX,LLOCKED Else If OT=0 Locate TXP+30,4 : Input "Team: ";TEAM Else Locate TXP+30,4 : Input "Start Frame: ";STRTANIM End If End If End If If CY=5 If CX<27 PERMCALC=255-PERMCALC Else UPORLO=255-UPORLO End If End If Gosub OBJPARAMSHOW Return OBJPARAMSET: Return OBJPARAMSHOW: 'If OT=0 Then Gosub ALIENPARAM 'If OT=1 Then Gosub OBJPARAMPUT ' 'Return 'ALIENPARAM: Screen 0 Paper 0 : Pen 1 Ink 0 Bar TXP*8,16 To 640,48 Locate TXP,2 : Print "Type: "; If OT=0 Print ALNAME$(ALTO);" " Else Print OBNAME$(OBTO);" " End If Locate TXP,3 : Print "DOORS HELD: "; For A=0 To 15 If Btst(A,DLOCKED) Then Pen 1 Else Pen 2 Print Chr$(A+65); Next Pen 1 Locate TXP,4 : Print "LIFTS HELD: "; For A=0 To 15 If Btst(A,LLOCKED) Then Pen 1 Else Pen 2 Print Chr$(A+65); Next Locate TXP,5 : Pen 1 Print "Permanent Calculation: "; Pen 4 If PERMCALC=0 Then Print "No " Else Print "Yes" Locate TXP+27,5 : Pen 1 Print "Start in Up/Lo Rooms: "; Pen 4 If UPORLO=0 Then Print "Lower" Else Print "Upper" Locate TXP+30,4 : Pen 1 If OT=0 Print "Team: "; Pen 4 Print TEAM;" "; Else Print "Start Frame: "; Pen 4 Print STRTANIM;" "; End If Locate TXP+30,2 : Pen 1 If OT=0 Print "Init Targ Cpt: "; Pen 4 Print CONTPT;" " Else Print " "; End If Locate TXP+30,3 : Pen 1 Print "Text:"; Pen 4 Print TXT; Return OBJPARAMPUT: Return ' SETPOINTBRIGHT: X=X-160 If X<0 Then Return Y=Y-200 Y=Y/8 If X>81 Then Return If Y mod 2=0 Then Return If Mouse Key=0 Then Return If Y=1 PBR=(X*40)/80 Add PBR,-20 End If If Y=3 PAN=(X*15)/80 End If If Y=5 PDTA=(X*15)/80 End If Gosub BRIGHTSLIDE Return ' SETECHOLEN: X=X-160 If X<0 Then Return Y=Y-200 Y=Y/8 If X>81 Then Return If Y mod 2=0 Then Return If Mouse Key=0 Then Return If Y=1 ECHOLEN=(X*50)/80 Add PBR,-20 End If If Y=3 ECHOVOL=(X*255)/80 End If 'If Y=5 ' PDTA=(X*15)/80 'End If Gosub ECHOSLIDE Return ' BRIGHTSLIDE: Screen 0 Hslider 320,8 To 480,15,40,PBR+20,1 Hslider 320,24 To 480,31,15,PAN,1 Hslider 320,40 To 480,47,15,PDTA,1 Locate 60,1 : Print "Bright ";PBR;" " Locate 60,3 : Print "Anim ";PAN;" " Locate 60,5 : Print "Dist ";PDTA;" " Return ' ECHOSLIDE: Screen 0 Hslider 320,8 To 480,15,50,ECHOLEN,1 Hslider 320,24 To 480,31,255,ECHOVOL,1 'Hslider 320,40 To 480,47,15,PDTA,1 Locate 60,1 : Print "Echo Time ";ECHOLEN;" " Locate 60,3 : Print "Echo Volume ";ECHOVOL;" " 'Locate 60,5 : Print "Dist ";PDTA;" " Return ' INITSWITCHDEF: PSN Return ' Procedure PSN Screen 0 Locate 40,0 : Print "Switch Number:";SWN Locate 40,1 If SWITCHTYPE(SWN)=0 Print "Switch" End If If SWITCHTYPE(SWN)=1 Print "Button" End If End Proc ' PATHCOMPICK: X=X/16 X=X-10 If X<0 Then Return Y=(Y-200)/16 If A$="z" and PCOM>0 Then Add PCOM,-1 : Gosub PMCOMSHOW : Gosub PFCOMSHOW If A$="x" and PCOM<30 Then Add PCOM,1 : Gosub PMCOMSHOW : Gosub PFCOMSHOW If M<>0 If Y=0 Goto SETPMCOM End If If Y=3 Goto SETPFCOM End If End If Return ' SETPMCOM: PMCOM(PCOM,0)=X Gosub PMCOMSHOW Return ' SETPFCOM: PFCOM(PCOM,0)=X Gosub PFCOMSHOW Return ' PMCOMSHOW: S=PCOM-3 X=320 For A=0 To 6 If S<0 or S>30 Screen 0 Ink 0 : Bar X+1,17 To X+30,30 Ink 1 : Bar X+8,20 To X+24,28 Else F=320+PMCOM(S,0)*32 Screen Copy 0,F+1,256-63,F+31,256-49 To 0,X+1,17 End If Add X,32 Add S,1 Next Return ' PFCOMSHOW: S=PCOM-3 X=320 For A=0 To 6 If S<0 or S>30 Screen 0 Ink 0 : Bar X+1,33 To X+30,46 Ink 1 : Bar X+8,36 To X+24,44 Else F=320+PFCOM(S,0)*32 Screen Copy 0,F+1,256-15,F+31,255 To 0,X+1,33 End If Add X,32 Add S,1 Next Return ' INITPATHDEF: Screen Copy 0,0,256-64,320,256 To 0,320,0 Ink 3 Box 320+32*3,16 To 320+32*3+31,47 Return ' TIDYPATHDEF: Screen 0 Ink 0 Bar 320,0 To 640,64 Return ' DEFDOORCOND: If M=0 Then Return X=X-16*6 If X<0 Then Return Y=Y-200 Y=Y/8 Y=Y-2 'If Y>=0 and Y<2 ' X=X/8 ' Bchg X,DC(NDO) ' PDC[NDO] 'End If If Y>=2 If X>0 and X<80 Add DRT(NDO),1 If DR$(DRT(NDO))="" : DRT(NDO)=0 : End If PDC[NDO] Else Add DLT(NDO),1 If DL$(DLT(NDO))="" : DLT(NDO)=0 : End If PDC[NDO] End If Else If Y=-1 Locate 40,1 : Input "Stays open for (50=1sec):";OPS(NDO,2) Else If Y=0 If X<72 Locate 24,2 : Input "Opening Speed:";OPS(NDO,0) PDC[NDO] Else If X<144 Locate 42,2 : Input "Opening SFX:";OPS(NDO,3) PDC[NDO] Else Locate 60,2 : Input "Open SFX:";OPS(NDO,5) PDC[NDO] End If End If Else If X<72 Locate 24,3 : Input "Closing Speed:";OPS(NDO,1) PDC[NDO] Else If X<144 Locate 42,3 : Input "Closing SFX:";OPS(NDO,4) PDC[NDO] Else Locate 60,3 : Input "Closed SFX:";OPS(NDO,6) PDC[NDO] End If End If End If End If End If Return ' DEFLIFTCOND: If M=0 Then Return X=X-16*6 If X<0 Then Return Y=Y-200 Y=Y/8 Y=Y-2 'If Y>=0 and Y<2 ' X=X/8 ' Bchg X,LIFTC(NL) ' PLC[NL] 'End If If Y=0 If X<72 Locate 24,2 : Input "Raise Speed:";LOPS(NL,0) PLC[NL] Else If X<144 Locate 42,2 : Input "Raise SFX:";LOPS(NL,3) PLC[NL] Else Locate 60,2 : Input "At Top SFX:";LOPS(NL,5) PLC[NL] End If End If Else If Y=1 If X<72 Locate 24,3 : Input "Lower Speed:";LOPS(NL,1) PLC[NL] Else If X<144 Locate 42,3 : Input "Lower SFX:";LOPS(NL,4) PLC[NL] Else Locate 60,3 : Input "At Bot. SFX:";LOPS(NL,6) PLC[NL] End If End If End If End If If Y>=2 If X>64 and X<144 Add LRT(NL),1 If LR$(LRT(NL))="" : LRT(NL)=0 : End If PLC[NL] Else Add LLT(NL),1 If LL$(LLT(NL))="" : LLT(NL)=0 : End If PLC[NL] End If End If Return ' INITOBJ: TYPEOBJ[OT] Gosub OBJPARAMSHOW Return ' TIDYOBJ: Screen 0 : Locate TXP,1 : Print " " Return ' INITDEFDOOR: ZOSHO[CZ,10] Screen 0 : Locate TXP,1 : PND[ND] Locate TXP,2 PDC[ND] Return ' INITDEFLIFT: ZOSHO[CZ,10] Screen 0 : Locate TXP,1 : PNL[NL] Locate TXP,2 PLC[NL] Return ' TIDYDEFDOOR: ZOSHO[CZ,4] Screen 0 : Ink 0 : Bar TXP*8,8 To 640,80 Return TIDYDEFLIFT: ZOSHO[CZ,4] Screen 0 : Ink 0 : Bar TXP*8,8 To 640,80 Return ' DEFORDER: Return ' TIDYDEFORDER: Return ' INITDEFGRAPH: ZOSHO[CZ,10] Return ' TIDYDEFGRAPH: ZOSHO[CZ,4] Screen Hide 3 Screen Hide 4 Return ' TIDYDEFZONE: ZOSHO[CZ,0] ZP(CZ)=0 Return ' TIDYPLACEPLAYER: ZOSHO[PZ,4] Screen 0 Ink 0 Bar TXP*8,2*8 To 640,3*8 Return ' TIDYDEFHEIGHT: ZOSHO[CZ,4] Screen 0 Ink 0 Bar TXP*8,2*8 To 640,3*8 Return ' TIDYDEFBRIGHT: ZOSHO[CZ,4] Screen 0 Ink 0 Bar TXP*8,2*8 To 640,3*8 Return ' INITCONNECTCONT: P1=-1 : P2=-1 Return ' TIDYDEFWALL: ZOSHO[CZ,4] Return ' TIDYDEFCORNER: ZOSHO[CZ,4] Return ' INITDEFZONE: 6 CZ=-1 For A=0 To NZ-1 If USED(A)=0 Then CZ=A : A=NZ Next If CZ<0 CZ=NZ : ZP(CZ)=0 End If Return ' MAPEDIT: If OP=0 Then Gosub PTADD If OP=6 Then Gosub PTMOVE If OP=1 Then Gosub DEFZONE If OP=4 Then Gosub DEFWALL If OP=7 Then Gosub DEFORDER If OP=15 Then Gosub DEFROOFHEIGHT If OP=18 Then Gosub DEFHEIGHT If OP=9 Then Gosub DEFUPPERROOFHEIGHT If OP=12 Then Gosub DEFUPPERFLOORHEIGHT 'If OP=8 Then Gosub DEFBRIGHT If OP=21 Then Gosub DEFROOFGRAPH If OP=22 Then Gosub DEFWALLGRAPH If OP=23 Then Gosub DEFFLOORGRAPH If OP=24 Then Gosub DEFUPPERROOFGRAPH If OP=25 Then Gosub DEFUPPERWALLGRAPH If OP=26 Then Gosub DEFUPPERFLOORGRAPH If OP=2 Then Gosub OBJADD If OP=5 Then Gosub OBJMOVE If OP=8 Then Gosub OBJDEL If OP=11 Then Gosub PLACEPLAYER If OP=14 Then Gosub DEFDOOR If OP=17 Then Gosub DEFLIFT If OP=20 Then Gosub DEFTELEPORT If OP=10 Then Gosub DEFUPPERROOFBRIGHT If OP=13 Then Gosub DEFUPPERFLOORBRIGHT If OP=16 Then Gosub DEFLOWERROOFBRIGHT If OP=19 Then Gosub DEFLOWERFLOORBRIGHT If OP=27 Then Gosub DEFWATERHEIGHT If OP=30 Then Gosub DEFWATERANIM If OP=33 Then Gosub DEFUPPERWALLBRIGHT If OP=34 Then Gosub DEFLOWERWALLBRIGHT If OP=28 Then Gosub PLACECONTPT If OP=31 Then Gosub CONNECTCONT If OP=29 Then Gosub CPTNEARTOZONE If OP=32 Then Gosub CPTNEARTOUPPERZONE If OP=35 Then Gosub CPTMOVE If OP=36 Then Gosub DEFBACKSFX 'If OP=37 Then Gosub DEFECHO Return ' DEFUPPERWALLBRIGHT: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 If A$="c" REQUEST["New wall brightness offset"] : P=Param UWB(CZ,CPP)=P End If M=Mouse Click If M=0 Then Return X=(X*MU)+XO : Y=(Y*MU)+YO If M=2 ZOGET[X,Y] : P=Param If P>-1 If P<>CZ ZOSHO[CZ,4] CZ=P ZOSHO[CZ,10] End If End If End If If M=1 FINDNEARZONE[CZ,X,Y] P=Param For A=0 To ZP(CZ)-1 If ZO(CZ,A)=P Screen 0 Locate 40,1 : Print "Brightness Offset";UWB(CZ,A) : CPP=A End If Next End If Return ' DEFLOWERWALLBRIGHT: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 If A$="c" REQUEST["New wall brightness offset"] : P=Param WB(CZ,CPP)=P End If M=Mouse Click If M=0 Then Return X=(X*MU)+XO : Y=(Y*MU)+YO If M=2 ZOGET[X,Y] : P=Param If P>-1 If P<>CZ ZOSHO[CZ,4] CZ=P ZOSHO[CZ,10] End If End If End If If M=1 FINDNEARZONE[CZ,X,Y] P=Param For A=0 To ZP(CZ)-1 If ZO(CZ,A)=P Screen 0 Locate 40,1 : Print "Brightness Offset";WB(CZ,A) : CPP=A End If Next End If Return ' Procedure PNWA[NWA] End Proc ' Procedure PWAC[NWA] End Proc ' DEFWATERANIM: If A$="," and NWA>0 Then NWA=NWA-1 : PNWA[NWA] : PWAC[NWA] If A$="." and NWA<20 Then NWA=NWA+1 : PNWA[NWA] : PWAC[NWA] If A$="h" and ZWA(CZ)<>0 ' Gosub TIDYDEFWA REQUEST["Height of water at top of motion: "] P=Param : WATH(NWA)=P ' Gosub INITDEFWA End If If A$="t" WASP(NWA)=1 : PWAC[NWA] End If If A$="b" WASP(NWA)=0 : PLC[NWA] End If If A$="w" and CZ>-1 If ZWA(CZ)=0 ZWA(CZ)=NWA+1 WABH(NWA)=ZH(CZ,2) Else ZWA(CZ)=0 End If Gosub REDRAW End If Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Click If M=0 Then Return X=(X*MU)+XO : Y=(Y*MU)+YO If M=2 ZOGET[X,Y] : P=Param If P>-1 If P<>CZ ZOSHO[CZ,4] CZ=P ZOSHO[CZ,10] End If End If End If Return ' DEFSWITCH: If A$="z" and SWN>0 Then Add SWN,-1 : PSN If A$="x" and SWN<7 Then Add SWN,1 : PSN If A$="t" Then SWITCHTYPE(SWN)=1-SWITCHTYPE(SWN) : PSN If A$="d" Then SWWL(SWN,0)=-1 : SWWL(SWN,1)=-1 M=Mouse Click X=(X*MU)+XO : Y=(Y*MU)+YO If M=2 ZOSHO[CZ,4] ZOGET[X,Y] CZ=Param ZOSHO[CZ,10] End If If M=1 and CZ>=0 FINDNEARZONE[CZ,X,Y] P=Param For A=0 To ZP(CZ) If ZO(CZ,A)=P SWWL(SWN,0)=CZ : SWWL(SWN,1)=A : A=100 End If Next Gosub REDRAW End If Return ' DEFTELEPORT: M=Mouse Click X=(X*MU)+XO : Y=(Y*MU)+YO If M=2 ZOSHO[CZ,4] ZOGET[X,Y] CZ=Param ZOSHO[CZ,10] End If If M=1 and CZ>=0 ZOGET[X,Y] : P=Param If P>=0 TELZO(CZ)=P : TELX(CZ)=X : TELZ(CZ)=Y Else TELZO(CZ)=-1 End If End If Return Return ' Procedure WALLGET[Z,X,Y] P=-1 D=650000 If ZP(Z)>0 For A=0 To ZP(Z)-1 FX=PX(ZO(Z,A)) : FY=PY(ZO(Z,A)) TX=PX(ZO(Z,A+1)) : TY=PY(ZO(Z,A+1)) TX=TX-FX : TY=TY-FY PX=X-FX : PY=Y-FY TD=Abs(TY*PX-PY*TX) If TD0 Then Add PCOM,-1 : Gosub PMCOMSHOW : Gosub PFCOMSHOW If A$="x" and PCOM<30 Then Add PCOM,1 : Gosub PMCOMSHOW : Gosub PFCOMSHOW If A$="p" Then Gosub MAKEPATH HIGHCOORDS[PMCOM(PCOM,1),PMCOM(PCOM,2),2,4] HIGHCOORDS[PFCOM(PCOM,1),PFCOM(PCOM,2),3,21] Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Click X=(X*MU)+XO : Y=(Y*MU)+YO If M=1 PMCOM(PCOM,1)=X PMCOM(PCOM,2)=Y End If If M=2 PFCOM(PCOM,1)=X PFCOM(PCOM,2)=Y End If Return ' MAKEPATH: MP=Start(15) PC=0 LX=PMCOM(0,1) : LZ=PMCOM(0,2) While PMCOM(PC,0)<>-1 NPC=PMCOM(PC+1,0) If PMCOM(PC,0)=0 DMX(PC)=0 DMZ(PC)=0 End If If PMCOM(PC,0)=1 DMX(PC)=PMCOM(PC,1)-LX DMZ(PC)=PMCOM(PC,2)-LZ End If If PMCOM(PC,0)=2 If NPC=-1 or NPC=0 or NPC=3 DMX(PC)=0 DMZ(PC)=0 End If If NPC=1 DMX(PC)=PMCOM(PC+1,1)-PMCOM(PC,1) DMZ(PC)=PMCOM(PC+1,2)-PMCOM(PC,2) End If If NPC=2 DMX(PC)=PMCOM(PC+1,1)-PMCOM(PC-1,1) DMZ(PC)=PMCOM(PC+1,2)-PMCOM(PC-1,2) End If End If If PMCOM(PC,0)=3 DMX(PC)=0 : DMZ(PC)=0 PMCOM(PC,1)=PMCOM(PC-1,1) PMCOM(PC,2)=PMCOM(PC-1,2) End If LX=PMCOM(PC,1) LZ=PMCOM(PC,2) Add PC,1 Wend PC=0 XP=0 : ZP=0 : YP=0 : ANG=0 While PMCOM(PC,0)<>-1 DX#=PFCOM(PC,1)-PMCOM(PC,1) DY#=PFCOM(PC,2)-PMCOM(PC,2) L#=Sqr(DX#^2+DY#^2) Degree If Abs(DX#)0 NANG#=360.0-NANG# End If NANG#=NANG#+90.0 End If NANG=(4096.0*(NANG#+90))/360.0 NANG=(NANG) and 4095 If PMCOM(PC,0)=0 ' Place player here XP=PMCOM(PC,1) ZP=PMCOM(PC,2) If PFCOM(PC,0)=0 or PFCOM(PC,0)=1 ANG=NANG End If If PFCOM(PC,0)=2 or PFCOM(PC,0)=3 End If Doke MP,XP Doke MP+2,-ZP Doke MP+4,NANG Add MP,8 End If If PMCOM(PC,0)=1 DX=PMCOM(PC,1)-XP DZ=PMCOM(PC,2)-ZP DANG=NANG-ANG If DANG>2048 DANG=DANG-4096 End If If DANG<-2048 DANG=4096-DANG End If For A=0 To 63 X=XP+(DX*A)/64 Z=ZP+(DZ*A)/64 Doke MP,X Doke MP+2,-Z Doke MP+4,ANG+(DANG*A)/64 Add MP,8 Next ANG=NANG XP=PMCOM(PC,1) ZP=PMCOM(PC,2) End If If PMCOM(PC,0)=2 DANG=NANG-ANG If DANG>2048 DANG=DANG-4096 End If If DANG<-2048 DANG=DANG+4096 End If FX=DMX(PC-1) : FZ=DMZ(PC-1) DX=PMCOM(PC,1)-PMCOM(PC-1,1) DZ=PMCOM(PC,2)-PMCOM(PC-1,2) L=Sqr(DX^2+DZ^2) TX=DMX(PC) TZ=DMZ(PC) D=Sqr(TX^2+TZ^2) If D<>0 TX=(TX*L)/D TZ=(TZ*L)/D End If Degree STX=PMCOM(PC-1,1) STZ=PMCOM(PC-1,2) ENX=PMCOM(PC,1) ENZ=PMCOM(PC,2) For A=0 To 63 AN=(A*90)/64 Wait Vbl B=90-AN X1#=STX+(FX*Cos(B))/2.0 Z1#=STZ+(FZ*Cos(B))/2.0 X2#=ENX-(TX*Cos(AN))/2.0 Z2#=ENZ-(TZ*Cos(AN))/2.0 XM#=(X1#+X2#)/2 ZM#=(Z1#+Z2#)/2 C=(AN-45)*2 X2#=X2#-XM# Z2#=Z2#-ZM# X=X1#+X2#*(1+Sin(C)) Z=Z1#+Z2#*(1+Sin(C)) Doke MP,X Doke MP+2,-Z Doke MP+4,ANG+DANG*(1.0+Sin(AN*2-90))/2 Add MP,8 Next ANG=NANG End If If PMCOM(PC,0)=3 DANG=NANG-ANG If DANG>2048 DANG=DANG-4096 End If If DANG<-2048 DANG=4096-DANG End If For A=0 To 63 AN=(A*180)/64 Doke MP,XP Doke MP+2,-ZP Doke MP+4,ANG+DANG*(1.0+Sin(AN-90))/2 Add MP,8 Next ANG=NANG End If Add PC,1 Wend Bsave "ab3:includes/testpath",Start(15) To MP Return FX=TX : FY=TY DX=X(N+1)-X(N) DY=Y(N+1)-Y(N) L=Sqr(DX^2+DY^2) TX=X(N+2)-X(N) TY=Y(N+2)-Y(N) D=Sqr(TX^2+TY^2) TX=(TX*L)/D TY=(TY*L)/D Degree For A=0 To 90 Wait Vbl B=90-A X1#=X(N)+(FX*Cos(90-A))/2.0 Y1#=Y(N)+(FY*Cos(90-A))/2.0 X2#=X(N+1)-(TX*Cos(A))/2.0 Y2#=Y(N+1)-(TY*Cos(A))/2.0 XM#=(X1#+X2#)/2 YM#=(Y1#+Y2#)/2 C=(A-45)*2 X2#=X2#-XM# Y2#=Y2#-YM# X=X1#+X2#*(1+Sin(C)) Y=Y1#+Y2#*(1+Sin(C)) Plot X,Y,1 X Mouse=X Hard(0,X) Y Mouse=Y Hard(0,Y) Next Return ' CPTNEARTOZONE: M=Mouse Click X=(X*MU)+XO : Y=(Y*MU)+YO If A$="A" N=Start(11) For A=0 To NZ-1 For B=0 To ZP(A)-1 ZZ(A,B)=-1 For C=0 To NZ-1 For D=0 To ZP(C)-1 If ZO(A,B)=ZO(C,D+1) and ZO(A,B+1)=ZO(C,D) 'MYPRINT[" dc.l ZoneDat"+ Fn MY$(C)+",ZoneDat"+ Fn MY$(A)] ZZ(A,B)=C D=ZP(C) : C=NZ End If Next Next Next Next Screen 2 For AZ=0 To NZ-1 TX=0 : TY=0 For B=0 To ZP(AZ)-1 TX=TX+PX(ZO(AZ,B)) TY=TY+PY(ZO(AZ,B)) Next TX=TX/ZP(AZ) TY=TY/ZP(AZ) VX=(TX-XO)/MU : VY=(TY-YO)/MU Extension VX,VY,10 DDD=100000000 For A=0 To NCPT X1=CPTX(A) : X2=TX Y1=CPTY(A) : Y2=TY DX=X2-X1 : DY=Y2-Y1 ND=DX^2+DY^2 If NDZ2 Repeat DL=DX*(PY(ZO(Z1,0))-Y1)-DY*(PX(ZO(Z1,0))-X1) For C=1 To ZP(Z1) ' find exit from this zone... DR=DX*(PY(ZO(Z1,C))-Y1)-DY*(PX(ZO(Z1,C))-X1) If DL<0 and DR>=0 T=C C=100 End If DL=DR Next JOINCOORDS[PX(ZO(Z1,T)),PY(ZO(Z1,T)),PX(ZO(Z1,T-1)),PY(ZO(Z1,T-1)),15] Z1=ZZ(Z1,T-1) Until Z1=Z2 or Z1<0 End If If Z1=Z2 PQ=A DDD=ND End If End If Next ZCPT(AZ)=PQ Next End If If M=0 Then Return If M=2 ZOGET[X,Y] P=Param If P>=0 ZOSHO[CZ,4] CZ=P ZOSHO[CZ,10] End If If ZCPT(CZ)>-1 and ZCPT(CZ)<=NCPT HIGHCONT[ZCPT(CZ)] End If End If If M=1 FINDCONT[X,Y] P=Param If P>-1 ZCPT(CZ)=P HIGHCONT[ZCPT(CZ)] End If End If Return ' CPTNEARTOUPPERZONE: M=Mouse Click If M=0 Then Return X=(X*MU)+XO : Y=(Y*MU)+YO If M=2 ZOGET[X,Y] P=Param If P>=0 ZOSHO[CZ,4] CZ=P ZOSHO[CZ,10] End If If UZCPT(CZ)>-1 and UZCPT(CZ)<=NCPT HIGHCONT[UZCPT(CZ)] End If End If If M=1 FINDCONT[X,Y] P=Param If P>-1 UZCPT(CZ)=P HIGHCONT[UZCPT(CZ)] End If End If Return ' PLACECONTPT: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Click If M=0 Then Return X=(X*MU)+XO : Y=(Y*MU)+YO ZOGET[X,Y] Z=Param If Z<0 Then Return Add NCPT,1 CPTX(NCPT)=X CPTY(NCPT)=Y CPTZ(NCPT)=Z If M=1 Then CPTUL(NCPT)=0 Else CPTUL(NCPT)=1 CPTPUT[X,Y,8-CPTUL(NCPT)*2] Return ' CPTMOVE: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Click X=(X*MU)+XO : Y=(Y*MU)+YO If A$="g" FINDCONT[X,Y] : P1=Param End If If M=0 Then Return ZOGET[X,Y] Z=Param If Z<0 Then Return CPTX(P1)=X CPTY(P1)=Y CPTZ(P1)=Z If M=1 Then CPTUL(P1)=0 Else CPTUL(P1)=1 Gosub REDRAW Return ' CONNECTCONT: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Click If A$="V" Gosub AUTOLINK End If If M=0 Then Return X=(X*MU)+XO : Y=(Y*MU)+YO FINDCONT[X,Y] If P1>=0 Then Goto 2345 P1=Param For B=0 To NCPT-1 If B<>P1 Then CONNECTED[P1,B,P1] Next Return 2345 P2=Param If P2=-1 Then Return If P1=P2 Then Return N=Start(11) Q=Peek(N+P1*100+P2) W=Peek(N+P2*100+P1) 'Poke N+P2*100+P1,A If Q or W If Q=1 and W=1 JOINCOORDS[CPTX(P1),CPTY(P1),CPTX(P2),CPTY(P2),0] End If If Q=2 and W=2 JOINCOORDS[CPTX(P1),CPTY(P1),CPTX(P2),CPTY(P2),0] End If If Q=1 and W=2 JOINCOORDS[CPTX(P1),CPTY(P1),CPTX(P2),CPTY(P2),0] XD=CPTX(P2)-CPTX(P1) YD=CPTY(P2)-CPTY(P1) LD=Sqr(XD^2+YD^2) XD=(XD*30)/LD YD=(YD*30)/LD JOINCOORDS[CPTX(P2)-XD,CPTY(P2)-YD,CPTX(P2)-XD*2-YD/2,CPTY(P2)-YD*2+XD/2,0] JOINCOORDS[CPTX(P2)-XD,CPTY(P2)-YD,CPTX(P2)-XD*2+YD/2,CPTY(P2)-YD*2-XD/2,0] End If If Q=2 and W=1 XD=CPTX(P2)-CPTX(P1) YD=CPTY(P2)-CPTY(P1) LD=Sqr(XD^2+YD^2) XD=(XD*30)/LD YD=(YD*30)/LD JOINCOORDS[CPTX(P1),CPTY(P1),CPTX(P2),CPTY(P2),0] JOINCOORDS[CPTX(P1)+XD,CPTY(P1)+YD,CPTX(P1)+XD*2-YD/2,CPTY(P1)+YD*2+XD/2,0] JOINCOORDS[CPTX(P1)+XD,CPTY(P1)+YD,CPTX(P1)+XD*2+YD/2,CPTY(P1)+YD*2-XD/2,0] End If End If If M=1 If Peek(N+P1*100+P2)<>1 Poke N+P1*100+P2,1 If Peek(N+P2*100+P1)=0 Poke N+P2*100+P1,2 End If Else Poke N+P1*100+P2,0 If Peek(N+P2*100+P1)=1 Poke N+P1*100+P2,2 Else Poke N+P2*100+P1,0 End If End If Else If Peek(N+P1*100+P2)=2 Poke N+P1*100+P2,0 Poke N+P2*100+P1,0 Else Poke N+P1*100+P2,2 Poke N+P2*100+P1,2 End If End If Q=Peek(N+P1*100+P2) W=Peek(N+P2*100+P1) 'Poke N+P2*100+P1,A If Q or W If Q=1 and W=1 JOINCOORDS[CPTX(P1),CPTY(P1),CPTX(P2),CPTY(P2),12] End If If Q=2 and W=2 JOINCOORDS[CPTX(P1),CPTY(P1),CPTX(P2),CPTY(P2),15] End If If Q=1 and W=2 JOINCOORDS[CPTX(P1),CPTY(P1),CPTX(P2),CPTY(P2),13] XD=CPTX(P2)-CPTX(P1) YD=CPTY(P2)-CPTY(P1) LD=Sqr(XD^2+YD^2) XD=(XD*30)/LD YD=(YD*30)/LD JOINCOORDS[CPTX(P2)-XD,CPTY(P2)-YD,CPTX(P2)-XD*2-YD/2,CPTY(P2)-YD*2+XD/2,13] JOINCOORDS[CPTX(P2)-XD,CPTY(P2)-YD,CPTX(P2)-XD*2+YD/2,CPTY(P2)-YD*2-XD/2,13] End If If Q=2 and W=1 XD=CPTX(P2)-CPTX(P1) YD=CPTY(P2)-CPTY(P1) LD=Sqr(XD^2+YD^2) XD=(XD*30)/LD YD=(YD*30)/LD JOINCOORDS[CPTX(P1),CPTY(P1),CPTX(P2),CPTY(P2),13] JOINCOORDS[CPTX(P1)+XD,CPTY(P1)+YD,CPTX(P1)+XD*2-YD/2,CPTY(P1)+YD*2+XD/2,13] JOINCOORDS[CPTX(P1)+XD,CPTY(P1)+YD,CPTX(P1)+XD*2+YD/2,CPTY(P1)+YD*2-XD/2,13] End If End If P1=-1 P2=-1 Return ' AUTOLINK: ' link up all control points visually N=Start(11) If NCPT>0 For A=0 To NZ-1 For B=0 To ZP(A)-1 ZZ(A,B)=-1 For C=0 To NZ-1 For D=0 To ZP(C)-1 If ZO(A,B)=ZO(C,D+1) and ZO(A,B+1)=ZO(C,D) 'MYPRINT[" dc.l ZoneDat"+ Fn MY$(C)+",ZoneDat"+ Fn MY$(A)] ZZ(A,B)=C D=ZP(C) : C=NZ End If Next Next Next Next For A=0 To NCPT-1 For B=A+1 To NCPT If Peek(N+A*100+B)<>1 and Peek(N+B*100+A)<>1 Poke N+A*100+B,0 Poke N+B*100+A,0 ' check for link... PHYS=1 X1=CPTX(A) : X2=CPTX(B) Y1=CPTY(A) : Y2=CPTY(B) DX=X2-X1 : DY=Y2-Y1 Z1=CPTZ(A) : Z2=CPTZ(B) Repeat DL=DX*(PY(ZO(Z1,0))-Y1)-DY*(PX(ZO(Z1,0))-X1) For C=1 To ZP(Z1) ' find exit from this zone... DR=DX*(PY(ZO(Z1,C))-Y1)-DY*(PX(ZO(Z1,C))-X1) If DL<=0 and DR>=0 T=C C=100 End If DL=DR Next JOINCOORDS[PX(ZO(Z1,T)),PY(ZO(Z1,T)),PX(ZO(Z1,T-1)),PY(ZO(Z1,T-1)),15] Z1=ZZ(Z1,T-1) Until Z1=Z2 or Z1<0 If Z1=Z2 Poke N+A*100+B,2 : Poke(N+B*100+A),2 End If End If Next Next Gosub REDRAW End If Return ' Procedure FINDCONT[X,Y] P=-1 If NCPT<0 Then Goto 342 SD=100000000 For A=0 To NCPT D=(CPTX(A)-X)^2+(CPTY(A)-Y)^2 If D=0 If P<=(NO-1) S=Start(12)+P*32 D=Start(12)+NO*32-32 For A=0 To 31 : Poke S+A,Peek(D+A) : Next OBJPUT[OBX(P),OBZ(P),0] OBX(P)=OBX(NO-1) : OBZ(P)=OBZ(NO-1) End If NO=NO-1 For A=0 To 31 Poke Start(12)+NO*32+A,0 Next End If Return ' OBJMOVE: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Click If M=0 Then Return X=(X*MU)+XO : Y=(Y*MU)+YO If M=2 FINDOBJ[X,Y] COBJ=Param End If If M=1 If COBJ>=0 ZOGET[X,Y] : P=Param OBX(COBJ)=X : OBZ(COBJ)=Y S=Start(12)+COBJ*32 Doke S+6,P Gosub REDRAW ZOSHO[P,10] End If End If Return Procedure PND[ND] Screen 0 Locate TXP,1 : Print "Door Num: ";Chr$(ND+65) End Proc ' Procedure PNL[NL] Screen 0 Locate TXP,1 : Print "Lift Num: ";Chr$(NL+65) End Proc ' Procedure PDC[ND] Screen 0 ' Screen Copy 0,0,16*6,320,16*7+2 To 0,320,8 ' Ink 0 : Bar 320,26 To 640,32 ' For A=0 To 11 ' X=320+A*16 ' Ink 1 ' If Btst(A,DC(ND)) ' Bar X+1,27 To X+14,30 ' Else ' Box X+1,27 To X+14,30 ' End If ' Next Locate 40,4 : Print "Raise Conditions" Locate 60,4 : Print "Lower Conditions" Locate 40,5 : Print DR$(DRT(ND)) Locate 60,5 : Print DL$(DLT(ND)) Locate 40,1 : Print "Stays open for (50=1sec):";OPS(ND,2) Locate 24,2 : Print "Opening Speed:";OPS(ND,0) Locate 42,2 : Print "Opening SFX:";OPS(ND,3) Locate 60,2 : Print "Open SFX:";OPS(ND,5) Locate 24,3 : Print "Closing Speed:";OPS(ND,1) Locate 42,3 : Print "Closing SFX:";OPS(ND,4) Locate 60,3 : Print "Closed SFX:";OPS(ND,6) End Proc Procedure PLC[NL] Screen 0 ' Screen Copy 0,0,16*6,320,16*7+2 To 0,320,8 ' Ink 0 : Bar 320,26 To 640,32 ' For A=0 To 11 ' X=320+A*16 ' Ink 1 ' If Btst(A,LIFTC(NL)) ' Bar X+1,27 To X+14,30 ' Else ' Box X+1,27 To X+14,30 ' End If ' Next Locate 40,4 : Print "Raise Conditions" Locate 60,4 : Print "Lower Conditions" Locate 40,5 : Print LR$(LRT(NL)) Locate 60,5 : Print LL$(LLT(NL)) Locate 24,2 : Print "Raise Speed:";LOPS(NL,0) Locate 42,2 : Print "Raise SFX:";LOPS(NL,3) Locate 60,2 : Print "At Top SFX:";LOPS(NL,5) Locate 24,3 : Print "Lower Speed:";LOPS(NL,1) Locate 42,3 : Print "Lower SFX:";LOPS(NL,4) Locate 60,3 : Print "At Bot. SFX:";LOPS(NL,6) Locate 65,1 : Print "Start Pos" Locate 65,3 If LSP(NL)=0 Print "Bottom" Else Print "Top " End If End Proc ' DEFDOOR: If A$="," and NDO>0 Then NDO=NDO-1 : PND[NDO] : PDC[NDO] If A$="." and NDO<16 Then NDO=NDO+1 : PND[NDO] : PDC[NDO] If A$="<" and NDO>0 NDO=NDO-1 DRT(NDO)=DRT(NDO+1) DLT(NDO)=DLT(NDO+1) OPS(NDO,2)=OPS(NDO+1,2) OPS(NDO,0)=OPS(NDO+1,0) OPS(NDO,3)=OPS(NDO+1,3) OPS(NDO,5)=OPS(NDO+1,5) OPS(NDO,1)=OPS(NDO+1,1) OPS(NDO,4)=OPS(NDO+1,4) OPS(NDO,6)=OPS(NDO+1,6) PND[NDO] : PDC[NDO] End If If A$=">" and NDO<16 NDO=NDO+1 DRT(NDO)=DRT(NDO-1) DLT(NDO)=DLT(NDO-1) OPS(NDO,2)=OPS(NDO-1,2) OPS(NDO,0)=OPS(NDO-1,0) OPS(NDO,3)=OPS(NDO-1,3) OPS(NDO,5)=OPS(NDO-1,5) OPS(NDO,1)=OPS(NDO-1,1) OPS(NDO,4)=OPS(NDO-1,4) OPS(NDO,6)=OPS(NDO-1,6) PND[NDO] : PDC[NDO] End If If A$="r" and CZ>-1 If ZD(CZ)=0 ZD(CZ)=NDO+1 Else ZD(CZ)=0 End If Gosub REDRAW End If Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Click If M=0 Then Return X=(X*MU)+XO : Y=(Y*MU)+YO If M=2 ZOGET[X,Y] : P=Param If P>-1 If P<>CZ ZOSHO[CZ,4] CZ=P ZOSHO[CZ,10] End If End If End If If M=1 FINDNEARZONE[CZ,X,Y] : P=Param For A=0 To ZP(CZ)-1 If ZO(CZ,A)=P If WT(CZ,A)=0 WT(CZ,A)=2 WD(CZ,A)=NDO+1 Else WT(CZ,A)=0 WD(CZ,A)=0 End If ZOSHO[CZ,10] End If Next End If Return DEFLIFT: If A$="," and NL>0 Then NL=NL-1 : PNL[NL] : PLC[NL] If A$="." and NL<16 Then NL=NL+1 : PNL[NL] : PLC[NL] If A$=">" and NL<16 NL=NL+1 LRT(NL)=LRT(NL-1) LLT(NL)=LLT(NL-1) For AA=0 To 6 : LOPS(NL,AA)=LOPS(NL-1,AA) Next LSP(NL)=LSP(NL-1) PNL[NL] : PLC[NL] End If If A$="<" and NL>0 NL=NL-1 LRT(NL)=LRT(NL+1) LLT(NL)=LLT(NL+1) For AA=0 To 6 : LOPS(NL,AA)=LOPS(NL+1,AA) Next LSP(NL)=LSP(NL+1) PNL[NL] : PLC[NL] End If If A$="h" and ZLI(CZ)<>0 Gosub TIDYDEFLIFT REQUEST["Height of lift at top: "] P=Param : ZH(CZ,3)=P Gosub INITDEFLIFT End If If A$="t" LSP(NL)=1 : PLC[NL] End If If A$="b" LSP(NL)=0 : PLC[NL] End If If A$="f" and CZ>-1 If ZLI(CZ)=0 ZLI(CZ)=NL+1 Else ZLI(CZ)=0 End If Gosub REDRAW End If Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Click If M=0 Then Return X=(X*MU)+XO : Y=(Y*MU)+YO If M=2 ZOGET[X,Y] : P=Param If P>-1 If P<>CZ ZOSHO[CZ,4] CZ=P ZOSHO[CZ,10] End If End If End If If M=1 FINDNEARZONE[CZ,X,Y] : P=Param For A=0 To ZP(CZ)-1 If ZO(CZ,A)=P If WT(CZ,A)=0 WT(CZ,A)=5 WLI(CZ,A)=NL+1 Else WT(CZ,A)=0 WLI(CZ,A)=0 End If ZOSHO[CZ,10] End If Next End If Return ' DEFWALLGRAPH: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Key Gosub WGPUT X=(X*MU)+XO : Y=(Y*MU)+YO If M=2 ZOGET[X,Y] : P=Param If P>-1 If P<>CZ ZOSHO[CZ,4] CZ=P ZOSHO[CZ,10] End If End If End If If M=1 FINDNEARZONE[CZ,X,Y] : P=Param For A=0 To ZP(CZ)-1 If ZO(CZ,A)=P ZWG(CZ,A,3)=WGW ZWG(CZ,A,0)=ZWG : ZWG(CZ,A,1)=ZWGL : ZWG(CZ,A,2)=ZWGC : A=200 End If Next End If If A$="f" For A=0 To ZP(CZ)-1 ZWG(CZ,A,3)=WGW ZWG(CZ,A,0)=ZWG : ZWG(CZ,A,1)=ZWGL : ZWG(CZ,A,2)=ZWGC Next End If If A$="g" FINDNEARZONE[CZ,X,Y] : P=Param For A=0 To ZP(CZ)-1 If ZO(CZ,A)=P WGW=ZWG(CZ,A,3) ZWG=ZWG(CZ,A,0) : ZWGL=ZWG(CZ,A,1) : ZWGC=ZWG(CZ,A,2) A=200 End If Next End If Return ' WGPUT: If A$="q" and WGW>2 Then WGW=WGW/2 If A$="w" and WGW<256 Then WGW=WGW*2 If A$="," and ZWG>0 Then Add ZWG,-1 If A$="." Then Add ZWG,1 If A$="<" and ZWGC>0 Add ZWGC,-1 ZWG=0 End If If A$=">" Add ZWGC,1 ZWG=0 End If If A$="+" If ZWGL=0 ZWGL=1 Else ZWGL=0 End If End If If A$="-" If ZWGL=0 ZWGL=2 Else ZWGL=0 End If End If If ZWGL=1 : Sprite 6,X Hard(0,0),Y Hard(0,0),30 : End If If ZWGL=2 : Sprite 6,X Hard(0,0),Y Hard(0,0),31 : End If If ZWGL=0 : Sprite 6,0,0,31 : End If If ZWGC<>LWCHUNK-200 LWCHUNK=ZWGC+200 Bload WCHUNK$(ZWGC),Start(15) Screen 3 : LG=-200 For A=0 To 31 C=Peek(Start(15)+A*2) C=PALR(C)*256+PALG(C)*16+PALB(C) Colour A,C Next End If If ZWG<>(LG-100) or(LWGW-100)<>WGW or(A$="v") If A$="v" STQ=1 Else STQ=2 End If LG=ZWG+100 LS=ZWG LWGW=WGW+100 WGH=WCY(ZGWC) XL=LS S=Screen Screen 3 : Cls 0 ' Screen Copy 6,XL*16,YL*WGH,XL*16+WGW-1,YL*WGH+WGH-1 To 3,0,0 TW=Start(15)+64*32 ZIP=XL*16 For A=ZIP To ZIP+WGW-1 Step STQ F=TW+(A/3)*WCY(ZWGC)*2 If A mod 3=0 For B=0 To Min(64,WCY(ZWGC))-1 Step STQ C=Deek(F+B+B) Extension A-ZIP,B,C and 31 Next End If If A mod 3=1 For B=0 To Min(64,WCY(ZWGC))-1 Step STQ C=Deek(F+B+B)/32 Extension A-ZIP,B,C and 31 Next End If If A mod 3=2 For B=0 To Min(64,WCY(ZWGC))-1 Step STQ C=Deek(F+B+B)/1024 Extension A-ZIP,B,C and 31 Next End If Next Screen S End If Screen To Front 3 Screen Display 3,,200+40,,64 Screen Show 3 Return ' DEFFLOORGRAPH: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Key X=(X*MU)+XO : Y=(Y*MU)+YO Gosub FGPUT OZFG=ZFG : FBO=FB If M=1 ZOGET[X,Y] : P=Param If P>-1 ZOSHO[CZ,4] CZ=P ZOSHO[CZ,10] ZFG(CZ,0)=ZFG : FB(CZ)=FB ZFG(CZ,1)=ZFGS End If End If If M=2 ZOGET[X,Y] : P=Param If P>-1 ZOSHO[CZ,4] CZ=P ZOSHO[CZ,10] ZFG=ZFG(CZ,0) : FB=FB(CZ) ZFGS=ZFG(CZ,1) End If End If Return ' DEFROOFGRAPH: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Key X=(X*MU)+XO : Y=(Y*MU)+YO Gosub RGPUT OZRG=ZRG : RBO=RB If M=1 ZOGET[X,Y] : P=Param If P>-1 ZOSHO[CZ,4] CZ=P ZOSHO[CZ,10] ZRG(CZ,0)=ZRG : RB(CZ)=RB ZRG(CZ,1)=ZRGS End If End If If M=2 ZOGET[X,Y] : P=Param If P>-1 ZOSHO[CZ,4] CZ=P ZOSHO[CZ,10] ZRG=ZRG(CZ,0) : RB=RB(CZ) ZRGS=ZRG(CZ,1) End If End If Return ' DEFUPPERWALLGRAPH: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Key Gosub UWGPUT If M=0 and A$<>"g" Then Return X=(X*MU)+XO : Y=(Y*MU)+YO If M=2 ZOGET[X,Y] : P=Param If P>-1 If P<>CZ ZOSHO[CZ,4] CZ=P ZOSHO[CZ,10] End If End If End If If M=1 FINDNEARZONE[CZ,X,Y] : P=Param For A=0 To ZP(CZ)-1 If ZO(CZ,A)=P UZWG(CZ,A,3)=WGW UZWG(CZ,A,0)=ZWG : UZWG(CZ,A,1)=ZWGL : UZWG(CZ,A,2)=ZWGC : A=200 End If Next End If If A$="g" FINDNEARZONE[CZ,X,Y] : P=Param For A=0 To ZP(CZ)-1 If ZO(CZ,A)=P WGW=UZWG(CZ,A,3) ZWG=UZWG(CZ,A,0) : ZWGL=UZWG(CZ,A,1) : ZWGC=UZWG(CZ,A,2) : A=200 End If Next End If Return ' UWGPUT: If A$="q" and WGW>2 Then WGW=WGW/2 If A$="w" and WGW<256 Then WGW=WGW*2 If A$="," and ZWG>0 Then Add ZWG,-1 If A$="." Then Add ZWG,1 If A$="<" and ZWGC>0 Add ZWGC,-1 ZWG=0 End If If A$=">" Add ZWGC,1 ZWG=0 End If If A$="+" If ZWGL=0 ZWGL=1 Else ZWGL=0 End If End If If A$="-" If ZWGL=0 ZWGL=2 Else ZWGL=0 End If End If If ZWGL=1 : Sprite 6,X Hard(0,0),Y Hard(0,0),30 : End If If ZWGL=2 : Sprite 6,X Hard(0,0),Y Hard(0,0),31 : End If If ZWGL=0 : Sprite 6,0,0,31 : End If If ZWGC<>LWCHUNK-200 LWCHUNK=ZWGC+200 Bload WCHUNK$(ZWGC),Start(15) Screen 3 : LG=-200 For A=0 To 31 C=Peek(Start(15)+A*2) C=PALR(C)*256+PALG(C)*16+PALB(C) Colour A,C Next End If If ZWG<>(LG-100) or(LWGW-100)<>WGW or(A$="v") If A$="v" STQ=1 Else STQ=2 End If LG=ZWG+100 LS=ZWG LWGW=WGW+100 WGH=WCY(ZGWC) XL=LS YL=LS/20 S=Screen Screen 3 : Cls 0 ' Screen Copy 6,XL*16,YL*WGH,XL*16+WGW-1,YL*WGH+WGH-1 To 3,0,0 TW=Start(15)+64*32 ZIP=XL*16 For A=ZIP To ZIP+WGW-1 Step STQ F=TW+(A/3)*WCY(ZWGC)*2 If A mod 3=0 For B=0 To Min(64,WCY(ZWGC))-1 Step STQ C=Deek(F+B+B) Extension A-ZIP,B,C and 31 Next End If If A mod 3=1 For B=0 To Min(64,WCY(ZWGC))-1 Step STQ C=Deek(F+B+B)/32 Extension A-ZIP,B,C and 31 Next End If If A mod 3=2 For B=0 To Min(64,WCY(ZWGC))-1 Step STQ C=Deek(F+B+B)/1024 Extension A-ZIP,B,C and 31 Next End If Next Screen S End If Screen To Front 3 Screen Display 3,,200+40,,64 Screen Show 3 Return ' ' DEFUPPERFLOORGRAPH: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Key X=(X*MU)+XO : Y=(Y*MU)+YO Gosub FGPUT OZFG=ZFG : FBO=FB If M=1 ZOGET[X,Y] : P=Param If P>-1 ZOSHO[CZ,4] CZ=P ZOSHO[CZ,10] UZFG(CZ,0)=ZFG : FB(CZ)=FB UZFG(CZ,1)=ZFGS End If End If If M=2 ZOGET[X,Y] : P=Param If P>-1 ZOSHO[CZ,4] CZ=P ZOSHO[CZ,10] ZFG=UZFG(CZ,0) : FB=FB(CZ) ZFGS=UZFG(CZ,1) End If End If Return ' DEFUPPERROOFGRAPH: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Key X=(X*MU)+XO : Y=(Y*MU)+YO Gosub RGPUT OZRG=ZRG : RBO=RB If M=1 ZOGET[X,Y] : P=Param If P>-1 ZOSHO[CZ,4] CZ=P ZOSHO[CZ,10] UZRG(CZ,0)=ZRG : RB(CZ)=RB UZRG(CZ,1)=ZRGS End If End If If M=2 ZOGET[X,Y] : P=Param If P>-1 ZOSHO[CZ,4] CZ=P ZOSHO[CZ,10] ZRG=UZRG(CZ,0) : RB=RB(CZ) ZRGS=UZRG(CZ,1) End If End If Return ' RGDAT: Screen Hide 3 Screen Show 4 : Screen To Front 4 Return ' RGPUT: If A$="," Then ZRG=(ZRG+16) mod 17 If A$="." Then ZRG=(ZRG+1) mod 17 If A$="q" and ZRGS>-5 Then ZRGS=ZRGS-1 If A$="w" and ZRGS<2 Then ZRGS=ZRGS+1 If A$="b" Then RB=1-RB If RB Then Sprite 6,X Hard(2,0),Y Hard(2,0),20 Else Sprite Off 6 If(OZRG<>ZRG) or RB<>RBO or(OZRGS<>ZRGS) OZRG=ZRG : RBO=RB : OZRGS=ZRGS If ZRG=16 Screen Open 3,320,64,32,Lowres Locate 0,3 : Print "NONE (SKY)" Else If RB=0 Screen Open 3,320,64,64,Lowres Curs Off : Flash Off : Cls 0 Paste Icon 0,0,ZRG+17 MP=Start(10)+1024+ZRG*64 For BQ=0 To 31 : Colour BQ,Deek(MP) : Add MP,2 : Next Sprite Off 6 Else F$="ab3:graphics/floors/bump."+ Fn MY$(ZRG+1) Load Iff F$,3 Sprite 6,X Hard(2,0),Y Hard(2,0),20 End If End If Screen 3 : Locate 8,0 : Print ZRGS;" " End If Screen To Front 3 Screen Display 3,,200+40,,64 Screen Show 3 Return ' FGPUT: If A$="," Then ZFG=(ZFG-1) and 15 If A$="." Then ZFG=(ZFG+1) and 15 If A$="b" Then FB=1-FB If A$="q" and ZFGS>-5 Then ZFGS=ZFGS-1 If A$="w" and ZFGS<2 Then ZFGS=ZFGS+1 If(ZFG<>OZFG) or OFB<>FB or(OZFGS<>ZFGS) OZFG=ZFG : OFB=FB : OZFGS=ZFGS If FB(CZ)=0 Screen Open 3,320,64,64,Lowres Curs Off : Flash Off : Cls 0 Paste Icon 0,0,ZFG+17 MP=Start(10)+1024+ZFG*64 For BQ=0 To 31 : Colour BQ,Deek(MP) : Add MP,2 : Next Sprite Off 6 Else F$="ab3:graphics/floors/bump."+ Fn MY$(ZFG+1) Load Iff F$,3 Sprite 6,X Hard(2,0),Y Hard(2,0),20 End If Screen 3 : Locate 8,0 : Print ZFGS;" " End If Screen To Front 3 Screen Display 3,,200+40,,64 Screen Show 3 Return ' OBJADD: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 If A$="," and OT>0 Then OT=OT-1 : TYPEOBJ[OT] : Gosub OBJPARAMSHOW If A$="." and OT<1 Then OT=OT+1 : TYPEOBJ[OT] : Gosub OBJPARAMSHOW If A$="g" X=(X*MU)+XO : Y=(Y*MU)+YO DI=100000000 For A=0 To NO-1 DX=OBX(A)-X DY=OBZ(A)-Y D=DX^2+DY^2 If D32767 TEAM=TEAM-65536 End If TXT=Deek(S+14) If TXT>32767 TXT=TXT-65536 End If CONTPT=Deek(S+16) Gosub OBJPARAMSHOW Else OBTO=Peek(S+2) DLOCKED=Deek(S+4) LLOCKED=Deek(S+8) UPORLO=Peek(S+10) PERMCALC=Peek(S+11) TXT=Deek(S+14) If TXT>32767 TXT=TXT-65536 End If STRTANIM=Deek(S+18) Gosub OBJPARAMSHOW End If End If If A$="p" X=(X*MU)+XO : Y=(Y*MU)+YO DI=100000000 For A=0 To NO-1 DX=OBX(A)-X DY=OBZ(A)-Y D=DX^2+DY^2 If D0 D=100000000 : T=-1 For A=0 To ZP(CZ)-1 FX=PX(ZO(CZ,A)) : FY=PY(ZO(CZ,A)) TX=PX(ZO(CZ,A+1)) : TY=PY(ZO(CZ,A+1)) TX=TX-FX : TY=TY-FY PX=X-FX : PY=Y-FY NDDD=PX*TY-PY*TX If Abs(NDDD)L# TX#=L#*Sgn(TX#) End If If Abs(TY#)>L# TY#=L#*Sgn(TY#) End If ANC=Acos(-TX#/L#) ANG=ANC If TY>0 : ANG=360-ANG : End If ANG=(ANG+360) mod 360 Screen 2 : Locate 0,0 Print ANG End If Doke S+12,ANG OBX(NO)=X : OBZ(NO)=Y Add NO,1 Return ' DDECOPUT: S=Start(12)+NO*32 Poke S,9 REQUEST["Decoration Item :"] : P=Param Doke S+2,P Doke S+6,CZ REQUEST["Facing Angle :"] : P=Param P=(P*8192)/360 P=P and $FFFE Doke S+8,P OBX(NO)=X : OBZ(NO)=Y Add NO,1 Return ' Procedure SHVCT[VCT] Screen 0 For A=0 To 3 Locate 40,2+A B=A+VCT If B<=20 Print VECT$(B) Else Print " " End If Next End Proc ' FLHAPUT: S=Start(12)+NO*32 VCT=0 SHVCT[VCT] Repeat A$=Inkey$ Wait Vbl Wait Vbl Wait Vbl If Key State($4C) and VCT>0 Then Add VCT,-1 : SHVCT[VCT] If Key State($4D) and VCT<20 Then Add VCT,1 : SHVCT[VCT] Until A$=" " P=VCT Poke S+1,P ANG=0 If(P>=4 and P<=10) D=100000000 : T=-1 For A=0 To ZP(CZ)-1 FX=PX(ZO(CZ,A)) : FY=PY(ZO(CZ,A)) TX=PX(ZO(CZ,A+1)) : TY=PY(ZO(CZ,A+1)) TX=TX-FX : TY=TY-FY PX=X-FX : PY=Y-FY NDDD=PX*TY-PY*TX If Abs(NDDD)L# TX#=L#*Sgn(TX#) End If If Abs(TY#)>L# TY#=L#*Sgn(TY#) End If ANC=Acos(-TX#/L#) ANG=ANC If TY>0 : ANG=360-ANG : End If ANG=ANG+360 Screen 2 : Locate 0,0 Print ANG End If Poke S,5 Doke S+6,CZ Doke S+8,ANG If P=9 REQUEST["Time between flames"] : P=Param Doke S+12,P End If OBX(NO)=X : OBZ(NO)=Y Add NO,1 Return ' ENEMYPUT: S=Start(12)+NO*32 Poke S,0 ' For nasties need to store: which zone they're in, ' how many lives they have, how fast they can move ' and so on. REQUEST["Enter enemy type:"] P=Param : Poke S+1,P REQUEST["Enter number of hits to kill:"] P=Param : Doke S+2,P REQUEST["Team number (-1=solo):"] P=Param : Doke S+4,P Doke S+6,CZ OBX(NO)=X : OBZ(NO)=Y Add NO,1 Return ' MARINEPUT: S=Start(12)+NO*32 Poke S,6 ' For nasties need to store: which zone they're in, ' how many lives they have, how fast they can move ' and so on. Poke S+1,0 REQUEST["Enter number of hits to kill:"] P=Param : Doke S+2,P REQUEST["Enter MAX movement speed:"] P=Param : Doke S+4,P REQUEST["Enter Leadership value:"] P=Param : Doke S+8,P Doke S+6,CZ OBX(NO)=X : OBZ(NO)=Y Add NO,1 Return ' BIGGUNPUT: REQUEST["Which gun? "] P=Param S=Start(12)+NO*32 Poke S,3 Poke S+1,P Doke S+6,CZ OBX(NO)=X : OBZ(NO)=Y Add NO,1 Return ' GLASSPUT: S=Start(12)+NO*32 Poke S,7 Poke S+1,0 Doke S+6,CZ OBX(NO)=X : OBZ(NO)=Y Add NO,1 Return ' MEDIPUT: S=Start(12)+NO*32 Poke S,1 Poke S+1,0 REQUEST["Enter healing factor:"] P=Param : Doke S+2,P Doke S+6,CZ OBX(NO)=X : OBZ(NO)=Y Add NO,1 Return ' BBARRELPUT: S=Start(12)+NO*32 Poke S,8 Poke S+1,0 REQUEST["Enter Hits to Explode:"] P=Param : Doke S+2,P Doke S+6,CZ OBX(NO)=X : OBZ(NO)=Y Add NO,1 Return ' AMMOPUT: S=Start(12)+NO*32 Poke S,2 Poke S+1,0 REQUEST["Enter gun type:"] P=Param : Doke S+2,P Doke S+6,CZ OBX(NO)=X : OBZ(NO)=Y Add NO,1 Return ' KEYPUT: S=Start(12)+NO*32 Poke S,4 REQUEST["Enter Colour (0=Green 1=Red 2=Yellow 3=Blue):"] P=Param : Poke S+1,P Doke S+6,CZ OBX(NO)=X : OBZ(NO)=Y Add NO,1 Return ' Procedure REQUEST[R$] Screen 0 : Locate TXP,3 : Print R$ Locate TXP,4 : Input V Curs Off Locate TXP,3 : Print Space$(Len(R$)) Locate TXP,4 : Print Space$(40) End Proc[V] ' Procedure MESSAGE[R$] Screen 0 : Locate TXP,4 : Print R$; End Proc ' Procedure OBJPUT[X,Y,C] Screen 2 X=(X-XO)/MU : Y=(Y-YO)/MU If Y>0 Extension X,Y,3,C Ink C Extension X-2,Y To X+2,Y Extension X,Y-2 To X,Y+2 End If End Proc ' Procedure TYPEOBJ[O] Screen 0 : Pen 1 Locate TXP,1 : Print "Object Type: ";OB$(OT) End Proc ' DEFCORNER: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 If A$="," and CZ>0 Then ZOSHO[CZ,4] : CZ=CZ-1 : ZOSHO[CZ,10] If A$="." and CZ=0 CZ=P End If ZOSHO[CZ,10] Goto 19 End If FINDNEAR[X,Y] : P=Param For A=0 To ZP(CZ)-1 If ZO(CZ,A)=P Then ZC(CZ,A)=1-ZC(CZ,A) : CORNER[P,ZC(CZ,A)*3] Next 19 Return ' Procedure CORNER[P,C] X=PX(P) : Y=PY(P) X=(X-XO)/MU : Y=(Y-YO)/MU Screen 2 Extension X,Y,3,C End Proc ' ' INITDEFORDER: Extension COUNTER=0 ' Make a list of which zones are connected to which. Screen 0 : Locate 40,1 : Print "Name for clip file" Locate 40,2 : Input ">:";F$ F$="ab3:levels/level_"+F$+"/twolev.clips" 'Screen Open 4,640,256,2,Hires 'Colour 1,$FFF For A=0 To NP : PW(A)=0 : PCW(A,0)=-1 : PCW(A,1)=-1 : Next For A=0 To NZ-1 If ZP(A)>0 For B=0 To ZP(A)-1 If WT(A,B)=1 PCW(ZO(A,B),1)=ZO(A,B+1) PCW(ZO(A,B+1),0)=ZO(A,B) End If If BWT(WT(A,B))=1 For C=0 To NZ-1 For D=0 To ZP(C)-1 If ZO(A,B)=ZO(C,D+1) and ZO(A,B+1)=ZO(C,D) ZZ(A,B)=C D=ZP(C) : C=NZ End If Next Next Else PW(ZO(A,B))=1 End If Next End If Next MP=Start(15) ' Need to go through every zone to see what we can see! If NZ=0 Then Extension : Return For F=0 To NZ-1 ' N$=Str$((F*100)/(NZ))-" " Screen 2 : Locate 0,0 : Print "Done: ";N$;"%" ' ZOFILL[F,2,3] ' Clear visible list For A=0 To NZ-1 ZU(A)=0 'For B=0 To 30 ' LP(A,B)=-1 : RP(A,B)=-1 'Next VCPL(A)=0 : VCPR(A)=0 Next T=Start(14)+F*64*6 ZU(F)=1 ' Flag to see if we have added any new zones this time round. NZU=1 P=1 NZIL=0 While NZU=1 NZU=0 TMPNZIL=NZIL For A=0 To NZ-1 If ZU(A)=P For C=0 To ZP(A)-1 NWT=WT(A,(C+1) mod ZP(A)) If WT(A,C)<>1 Z=ZZ(A,C) If ZU(Z)=0 ' We are not going back on ourselves here so ' maybe add this zone on end of list. ' Now check to see if this new zone we have ' added is visible. If P+1>1 ' Gosub REDRAW Gosub LRBORD ' Wait Key FLB=FL : TLB=TL : FRB=FR : TRB=TR FL=ZO(F,FL) TL=ZO(Z,TL) FR=ZO(F,FR) TR=ZO(Z,TR) X(0)=PX(FL) : Y(0)=PY(FL) X(1)=PX(TL) : Y(1)=PY(TL) X(2)=PX(TR) : Y(2)=PY(TR) X(3)=PX(FR) : Y(3)=PY(FR) X(4)=PX(FL) : Y(4)=PY(FL) ' the above now hold the pts between which we have to check. 'Now see what zones are inbetween! Gosub BETPTS B=0 INVIS=0 NWALLS=1 While B<=NP and INVIS=0 CP=B If CP<>FL and CP<>FR If PU(CP)=-3 'PU(CP)=NWALLS CCP=PCW(CP,0) OFL=0 : OFR=0 CHA=1 If TL=TR and PW(TR)<>0 : PU(TL)=-2 : End If If FL=FR and PW(FR)<>0 : PU(FL)=-4 : End If While CHA=1 CHA=0 If PU(CCP)=-3 or PU(CCP)=0 PU(CCP)=NWALLS : CHA=1 End If If PU(CCP)<-3 OFL=-1 End If If PU(CCP)>-3 and PU(CCP)<0 OFL=1 End If CCP=PCW(CCP,0) Wend 'Print OFL;OFR CCP=CP If TL=TR and PW(TR)<>0 : PU(TL)=-4 : End If If FL=FR and PW(FR)<>0 : PU(FL)=-2 : End If CHA=1 'Print "blah" While CHA=1 'Print CCP CHA=0 If PU(CCP)=-3 or PU(CCP)=0 PU(CCP)=NWALLS : CHA=1 End If If PU(CCP)<-3 OFR=-1 End If If PU(CCP)>-3 and PU(CCP)<0 OFR=1 End If CCP=PCW(CCP,1) Wend ' CHA=1 ' While CHA=1 ' CHA=0 ' For PP=0 To NZ-1 ' L=ZP(PP)-1 ' For Q=0 To ZP(PP)-1 ' If TL=TR : PU(TL)=-2 : End If ' If FL=FR : PU(FL)=-4 : End If ' If PU(ZO(PP,Q))=NWALLS ' If WT(PP,L)=1 ' If PU(ZO(PP,L))=-3 or PU(ZO(PP,L))=0 ' PU(ZO(PP,L))=NWALLS ' CHA=1 ' End If ' If PU(ZO(PP,L))<-3 ' OFL=-1 ' End If ' If(PU(ZO(PP,L))>-3 and PU(ZO(PP,L))<0) ' OFL=1 ' End If ' End If ' If TL=TR : PU(TL)=-4 : End If ' If FL=FR : PU(FL)=-2 : End If ' If WT(PP,Q)=1 ' If PU(ZO(PP,Q+1))=-3 or PU(ZO(PP,Q+1))=0 ' PU(ZO(PP,Q+1))=NWALLS ' CHA=1 ' End If ' If PU(ZO(PP,Q+1))<-3 ' OFR=-1 ' End If ' If(PU(ZO(PP,Q+1))>-3 and PU(ZO(PP,Q+1))<0) ' OFR=1 ' End If ' End If ' End If ' L=(L+1) mod ZP(PP) ' Next ' Next ' Wend If(OFL=-1 and OFR=1) or(OFL=1 and OFR=-1) INVIS=1 End If SOW(NWALLS)=0 If OFL=-1 and OFR=-1 SOW(NWALLS)=-1 End If If OFL=1 and OFR=1 SOW(NWALLS)=1 End If Add NWALLS,1 End If End If If FL=FR and PW(FR)<>0 : PU(FL)=-3 : End If If TL=TR and PW(TR)<>0 : PU(TL)=-3 : End If If PW(B)=1 If PU(B)=-4 and PU(PCW(B,1))=-2 If FR=FL or TR=TL OL=0 : RO=0 FX=PX(B) FY=PY(B) TX=PX(PCW(B,1)) TY=PY(PCW(B,1)) TX=TX-FX TY=TY-FY For ZEB=0 To ZP(F)-1 PX=PX(ZO(F,ZEB))-FX PY=PY(ZO(F,ZEB))-FX D=PX*TY-TX*PY If D>0 : OL=1 : End If If D<0 : RO=1 : End If Next If RO=0 or OL=0 For ZEB=0 To ZP(F)-1 PX=PX(ZO(F,ZEB))-FX PY=PY(ZO(F,ZEB))-FX D=PX*TY-TX*PY If D>0 : OL=1 : End If If D<0 : RO=1 : End If Next End If If RO=1 and OL=1 INVIS=1 End If Else INVIS=1 End If End If If PU(B)=-2 and PU(PCW(B,1))=-4 If FL=FR or TR=TL OL=0 : RO=0 FX=PX(B) FY=PY(B) TX=PX(PCW(B,1)) TY=PY(PCW(B,1)) TX=TX-FX TY=TY-FY For ZEB=0 To ZP(F)-1 PX=PX(ZO(F,ZEB))-FX PY=PY(ZO(F,ZEB))-FX D=PX*TY-TX*PY If D>0 : OL=1 : End If If D<0 : RO=1 : End If Next If RO=0 or OL=0 For ZEB=0 To ZP(F)-1 PX=PX(ZO(F,ZEB))-FX PY=PY(ZO(F,ZEB))-FX D=PX*TY-TX*PY If D>0 : OL=1 : End If If D<0 : RO=1 : End If Next End If If RO=1 and OL=1 INVIS=1 End If Else INVIS=1 End If End If End If Add B,1 Wend If INVIS=0 VCPL(Z)=0 : VCPR(Z)=0 If NWALLS>1 For BQ=1 To NWALLS-1 If SOW(BQ)=-1 ' all leftclip points For W=0 To NP If PU(W)=BQ PU(W)=-10 LP(Z,VCPL(Z))=W : Add VCPL(Z),1 End If Next End If If SOW(BQ)=1 ' all rightclip points For W=0 To NP If PU(W)=BQ PU(W)=-20 RP(Z,VCPR(Z))=W : Add VCPR(Z),1 End If Next End If Next ' Now process left and right clip points to ' exclude unnecessary ones. ' First eliminate all but most clockwise r clip ' pt on target zone. Gosub RIGHTONEONLY Gosub LEFTONEONLY If LCPOTZ>0 and RCPOTZ>0 and TL<>TR ' get rid of any clips farther away. FX=PX(LCPOTZ) : FY=PY(LCPOTZ) TX=PX(RCPOTZ)-FX : TY=PY(RCPOTZ)-FY If VCPL(Z)>1 For BQ=0 To VCPL(Z)-1 PPP=LP(Z,BQ) If PPP<>LCPOTZ and PPP<>RCPOTZ PX=PX(PPP)-FY : PY=PY(PPP)-FY D=PY*TX-PX*TY If D<=0 LP(Z,BQ)=-1 End If End If Next TPT=0 For BQ=0 To VCPL(Z)-1 If LP(Z,BQ)<>-1 LP(Z,TPT)=LP(Z,BQ) Add TPT,1 End If Next VCPL(Z)=TPT End If If VCPR(Z)>1 For BQ=0 To VCPR(Z)-1 PPP=RP(Z,BQ) If PPP<>LCPOTZ and PPP<>RCPOTZ PX=PX(PPP)-FY : PY=PY(PPP)-FY D=PY*TX-PX*TY If D<=0 RP(Z,BQ)=-1 End If End If Next TPT=0 For BQ=0 To VCPR(Z)-1 If RP(Z,BQ)<>-1 RP(Z,TPT)=RP(Z,BQ) Add TPT,1 End If Next VCPR(Z)=TPT End If End If If VCPL(Z)>0 BLFL=-1 FX=PX(FL) : FY=PY(FL) TX=PX(TL)-FX : TY=PY(TL)-FY For BQ=0 To VCPL(Z)-1 PX=PX(LP(Z,BQ))-FX : PY=PY(LP(Z,BQ))-FY D=PY*TX-PX*TY If D>0 or(TX=0 and TY=0) BLFL=BQ TX=PX : TY=PY End If Next BLFR=-1 FX=PX(FR) : FY=PY(FR) TX=PX(FL)-FX : TY=PY(FL)-FY For BQ=0 To VCPL(Z)-1 PX=PX(LP(Z,BQ))-FX : PY=PY(LP(Z,BQ))-FY D=PY*TX-PX*TY If D>0 or(TX=0 and TY=0) BLFR=BQ TX=PX : TY=PY End If Next If BLFL=BLFR ' only one clip point needed. LP(Z,0)=LP(Z,BLFL) VCPL(Z)=1 End If End If ' Wait Key If VCPR(Z)>0 BRFL=-1 FX=PX(FL) : FY=PY(FL) TX=PX(FR)-FX : TY=PY(FR)-FY For BQ=0 To VCPR(Z)-1 PX=PX(RP(Z,BQ))-FX : PY=PY(RP(Z,BQ))-FY D=PY*TX-PX*TY If D<0 BRFL=BQ TX=PX : TY=PY End If Next BRFR=-1 FX=PX(FR) : FY=PY(FR) TX=PX(TR)-FX : TY=PY(TR)-FY For BQ=0 To VCPR(Z)-1 PX=PX(RP(Z,BQ))-FX : PY=PY(RP(Z,BQ))-FY D=PY*TX-PX*TY If D<=0 BRFR=BQ TX=PX : TY=PY End If Next If BRFL=BRFR ' only one clip point needed. RP(Z,0)=RP(Z,BRFL) VCPR(Z)=1 End If End If ' ***************************************************** ' Another waste of time bug fix. ' Picking pairs of leftclips, is ' the target zone completely on one ' side of the line joining them? Gosub ELIMINLEFT Gosub ELIMINRIGHT If VCPL(Z)>0 and VCPR(Z)>0 Doke Start(9)+50,ZP(F)-1 Doke Start(9)+52,ZP(Z)-1 Loke Start(9)+12,Varptr(LP(Z,0)) Loke Start(9)+16,Varptr(RP(Z,0)) Doke Start(9)+20,VCPL(Z)-1 Doke Start(9)+22,VCPR(Z)-1 Loke Start(9)+42,Varptr(ZO(F,0)) Loke Start(9)+46,Varptr(ZO(Z,0)) Doke Start(9)+40,2 Call Start(9)+54 INVIS=Deek(Start(9)+40) 'For LPQ=0 To VCPL(Z)-1 ' For RPQ=0 To VCPR(Z)-1 ' FX=PX(LP(Z,LPQ)) : FY=PY(LP(Z,LPQ)) ' TX=PX(RP(Z,RPQ)) : TY=PY(RP(Z,RPQ)) ' TX=TX-FX : TY=TY-FY ' ' Is the source zone completely on ' ' the left side of the line? ' OL=1 ' For BQ=0 To ZP(F)-1 ' PX=PX(ZO(F,BQ)) : PY=PY(ZO(F,BQ)) ' PX=PX-FX : PY=PY-FY ' D=PY*TX-PX*TY ' If D>0 ' OL=0 ' End If ' Next ' If OL=1 ' INVIS=1 ' End If ' ' Is the target zone completely on ' ' the right side of the line? ' RO=1 ' For BQ=0 To ZP(Z)-1 ' PX=PX(ZO(Z,BQ)) : PY=PY(ZO(Z,BQ)) ' PX=PX-FX : PY=PY-FY ' D=PY*TX-PX*TY ' If D<0 ' RO=0 ' End If ' Next ' If RO=1 ' INVIS=1 ' End If ' Next 'Next If INVIS=0 ZU(Z)=P+1 : NZU=1 Gosub CALCORDER End If Else ZU(Z)=P+1 : NZU=1 Gosub CALCORDER End If ' ******************************************************************* Else Gosub CALCORDER ZU(Z)=P+1 : NZU=1 End If End If Else ZU(Z)=P+1 : NZU=1 End If End If End If Next End If Next Add P,1 Wend 'Locate 0,1 : Print COUNTER ' For A=0 To 63 Loke T+A*6,$FFFFFFFF Doke T+A*6+2,$FFFF Next TMP=P ' For A=0 To NZ-1 If ZU(A)>0 'ZOFILL[A,4,5] For B=0 To ZP(A)-1 PU(ZO(A,B))=-100 Next End If Next 'Wait Key : Gosub REDRAW For A=0 To NZ-1 If ZU(A)>0 If VCPL(A)>0 For B=0 To VCPL(A)-1 If LP(A,B)>0 If PU(LP(A,B))<>-100 LP(A,B)=-1 End If End If Next End If If VCPR(A)>0 For B=0 To VCPR(A)-1 If RP(A,B)>0 If PU(RP(A,B))<>-100 RP(A,B)=-1 End If End If Next End If End If Next ' CV=0 ' Gosub REDRAW For P=2 To TMP For A=0 To NZ-1 If ZU(A)=P 'zOFILL[A,3,3] Doke T,A Loke T+2,CORD(A) 'MYPRINT["ZoneClip"+ Fn MY$(F)+"to"+ Fn MY$(CV)] Add CV,1 D=0 While D-1 'M$=M$+ Fn MY$(LP(A,D))+","+ Fn MY$(PCW(LP(A,D),1))+"," DK[LP(A,D)] End If 'MYPRINT[M$] Add D,1 Wend DK[-1] D=0 While D-1) 'M$=M$+ Fn MY$(RP(A,D))+","+ Fn MY$(PCW(RP(A,D),0)) DK[RP(A,D)] End If 'MYPRINT[M$] Add D,1 Wend DK[-2] 'MYPRINT[" dc.l 0,0"] Add T,6 End If Next Next If T-Start(14)>Length(14) Print F : Wait Key Bell End End If ' Next For A=0 To NP DK[PCW(A,0)] : DK[PCW(A,1)] Next Bsave F$,Start(15) To MP Print MP-Start(15) 'Screen Close 4 Extension Return ' ELIMINLEFT: 'Inc COUNTER If VCPL(Z)>1 Loke Start(9)+46,Varptr(ZO(Z,0)) Doke Start(9)+52,ZP(Z)-1 Doke Start(9)+20,VCPL(Z) Loke Start(9)+12,Varptr(LP(Z,0)) Doke Start(9)+40,3 Call Start(9)+54 'For SS=0 To VCPL(Z)-1 'Print LP(Z,SS) : Next 'For SLP=0 To VCPL(Z)-2 ' FP=LP(Z,SLP) ' If FP<>-1 ' For ELP=SLP+1 To VCPL(Z)-1 ' TP=LP(Z,ELP) ' If TP<>-1 ' FX=PX(FP) : FY=PY(FP) : TX=PX(TP) : TY=PY(TP) ' TX=TX-FX : TY=TY-FY ' POL=0 : POR=0 ' For TZC=0 To ZP(Z)-1 ' TZP=ZO(Z,TZC) ' PX=PX(TZP)-FX ' PY=PY(TZP)-FY ' D=PY*TX-PX*TY ' If D>0 ' POR=1 ' Else ' If D<0 ' POL=1 ' End If ' End If ' Next ' If POL=1 and POR=0 ' LP(Z,SLP)=-1 ' End If ' If POL=0 and POR=1 ' LP(Z,ELP)=-1 ' End If ' End If ' Next ' End If 'Next 'PIB=0 'For TT=0 To VCPL(Z)-1 ' If LP(Z,TT)<>-1 ' LP(Z,PIB)=LP(Z,TT) ' Add PIB,1 ' End If 'Next 'VCPL(Z)=PIB VCPL(Z)=Deek(Start(9)+40) End If Return ' ELIMINRIGHT: If VCPR(Z)>1 Loke Start(9)+46,Varptr(ZO(Z,0)) Doke Start(9)+52,ZP(Z)-1 Doke Start(9)+20,VCPR(Z)-1 Loke Start(9)+12,Varptr(RP(Z,0)) Doke Start(9)+40,4 Call Start(9)+54 'For SRP=0 To VCPR(Z)-2 ' FP=RP(Z,SRP) ' If FP<>-1 ' For ERP=SRP+1 To VCPR(Z)-1 ' TP=RP(Z,ERP) ' If TP<>-1 ' FX=PX(FP) : FY=PY(FP) : TX=PX(TP) : TY=PY(TP) ' TX=TX-FX : TY=TY-FY ' POL=0 : POR=0 ' For TZC=0 To ZP(Z)-1 ' TZP=ZO(Z,TZC) ' PX=PX(TZP)-FX ' PY=PY(TZP)-FY ' D=PY*TX-PX*TY ' If D>0 ' POR=1 ' Else ' If D<0 ' POL=1 ' End If ' End If ' Next ' If POL=1 and POR=0 ' RP(Z,ERP)=-1 ' End If ' If POL=0 and POR=1 ' RP(Z,SRP)=-1 ' End If ' End If ' Next ' End If 'Next 'PIB=0 'For TT=0 To VCPR(Z)-1 ' If RP(Z,TT)<>-1 ' RP(Z,PIB)=RP(Z,TT) ' Add PIB,1 ' End If 'Next VCPR(Z)=Deek(Start(9)+40) End If Return ' CALCORDER: Doke Start(9)+40,1 Loke Start(9)+42,Varptr(ZO(F,0)) Loke Start(9)+46,Varptr(ZO(Z,0)) Loke Start(9)+12,Varptr(WT(Z,0)) Doke Start(9)+50,ZP(F)-1 Doke Start(9)+52,ZP(Z)-1 Call Start(9)+54 CORD(Z)=Leek(Start(9)+50) 'Print CORD 'CORD=0 'BTS=1 'For QQ=0 To ZP(Z)-1 ' If WT(Z,QQ)<>1 ' FX=PX(ZO(Z,QQ)) ' FY=PY(ZO(Z,QQ)) ' TX=PX(ZO(Z,QQ+1))-FX ' TY=PY(ZO(Z,QQ+1))-FY : SOL=0 : SOR=0 ' For QQQ=0 To ZP(F)-1 ' PX=PX(ZO(F,QQQ))-FX : PY=PY(ZO(F,QQQ))-FY ' D=PY*TX-PX*TY ' If D<0 ' SOL=1 ' End If ' If D>0 ' SOR=1 ' End If ' Next ' ' Wait Key ' If SOL=1 and SOR=0 ' Bset BTS,CORD ' ' ZOFILL[ZZ(Z,QQ),11,12] ' End If ' If SOL=0 and SOR=1 ' Bset BTS,CORD ' Bset BTS+1,CORD ' ' ZOFILL[ZZ(Z,QQ),3,4] ' End If ' End If ' Add BTS,3 ' CORD(Z)=CORD 'Next 'Print CORD : End Return ' CHKBET: Return ' RIGHTONEONLY: RCPOTZ=-1 If VCPR(Z)>0 BQ=TLB PU(FR)=-20 If PU(ZO(Z,BQ))<>-20 BQ=(BQ+ZP(Z)-1) mod ZP(Z) While PU(ZO(Z,BQ))<>-20 and BQ<>TRB BQ=(BQ+ZP(Z)-1) mod ZP(Z) Wend End If If PU(ZO(Z,BQ))=-20 RCPOTZ=ZO(Z,BQ) BQW=(BQ+1) mod ZP(Z) While BQW<>BQ If PU(ZO(Z,BQW))=-20 For AAA=0 To VCPR(Z)-1 If RP(Z,AAA)=ZO(Z,BQW) RP(Z,AAA)=-1 End If Next End If BQW=(BQW+1) mod ZP(Z) Wend TPT=0 For BQ=0 To VCPR(Z)-1 If RP(Z,BQ)<>-1 RP(Z,TPT)=RP(Z,BQ) Add TPT,1 End If Next VCPR(Z)=TPT End If End If Return ' LEFTONEONLY: LCPOTZ=-1 If VCPL(Z)>0 BQ=TRB PU(FL)=-10 If PU(ZO(Z,BQ))<>-10 BQ=(BQ+1) mod ZP(Z) While(PU(ZO(Z,BQ))<>-10) and(BQ<>TLB) BQ=(BQ+1) mod ZP(Z) Wend End If If PU(ZO(Z,BQ))=-10 LCPOTZ=ZO(Z,BQ) BQW=(BQ+1) mod ZP(Z) While BQW<>BQ If PU(ZO(Z,BQW))=-10 For AAA=0 To VCPL(Z)-1 If LP(Z,AAA)=ZO(Z,BQW) LP(Z,AAA)=-1 End If Next End If BQW=(BQW+1) mod ZP(Z) Wend TPT=0 For BQ=0 To VCPL(Z)-1 If LP(Z,BQ)<>-1 LP(Z,TPT)=LP(Z,BQ) Add TPT,1 End If Next VCPL(Z)=TPT End If End If Return ' BETPTS: Loke Start(9),Varptr(D(0,0)) Loke Start(9)+4,Varptr(PX(0)) Loke Start(9)+8,Varptr(PY(0)) Doke Start(9)+12,X(0) Doke Start(9)+14,Y(0) Doke Start(9)+16,X(1) Doke Start(9)+18,Y(1) Doke Start(9)+20,X(2) Doke Start(9)+22,Y(2) Doke Start(9)+24,X(3) Doke Start(9)+26,Y(3) Doke Start(9)+28,NP Loke Start(9)+30,Varptr(PW(0)) Loke Start(9)+34,Varptr(PU(0)) If FL<>FR and TL<>TR Doke Start(9)+38,0 End If If FL=FR and TL<>TR Doke Start(9)+38,1 End If If FL<>FR and TL=TR Doke Start(9)+38,2 End If Doke Start(9)+40,0 Call Start(9)+54 'For B=0 To NP ' If PW(B)=1 ' 'For J=0 To 3 ' ' DX=X(J+1)-X(J) : DY=Y(J+1)-Y(J) ' ' PX=PX(B)-X(J) : PY=PY(B)-Y(J) ' ' D(B,J)=DX*PY-DY*PX ' 'Next ' PU(B)=0 ' If FL<>FR and TL<>TR ' If D(B,0)>0 and D(B,1)>0 and D(B,2)>0 and D(B,3)>0 ' PU(B)=-3 ' End If ' If D(B,0)<=0 ' PU(B)=-4 ' If D(B,1)<=0 or D(B,3)<=0 ' PU(B)=-5 ' End If ' End If ' If D(B,2)<=0 ' PU(B)=-2 ' If D(B,1)<=0 or D(B,3)<=0 ' PU(B)=-1 ' End If ' End If ' End If ' If FL=FR and TL<>TR ' If D(B,0)>0 and D(B,1)>0 and D(B,2)>0 ' PU(B)=-3 ' End If ' If D(B,0)<=0 ' PU(B)=-4 ' If D(B,1)<=0 or D(B,2)<=0 ' PU(B)=0 ' End If ' End If ' If D(B,2)<=0 ' PU(B)=-2 ' If D(B,1)<=0 or D(B,0)<=0 ' PU(B)=0 ' End If ' End If ' End If ' If FL<>FR and TL=TR ' If D(B,0)>0 and D(B,3)>0 and D(B,2)>0 ' PU(B)=-3 ' End If ' If D(B,0)<=0 ' PU(B)=-4 ' If D(B,3)<=0 or D(B,2)<=0 ' PU(B)=0 ' End If ' End If ' If D(B,2)<=0 ' PU(B)=-2 ' If D(B,3)<=0 or D(B,0)<=0 ' PU(B)=0 ' End If ' End If ' End If ' End If ' ' OUTLINE[B] 'Next 'For B=0 To NP : Print PU(B) : Next 'End 'BQ=(FLB+1) mod ZP(F) 'While BQ<>FRB ' If PW(ZO(F,BQ))=1 ' PU(ZO(F,BQ))=-3 ' End If ' BQ=(BQ+1) mod ZP(F) 'Wend 'BQ=(TRB+1) mod ZP(Z) 'While BQ<>TLB ' If PW(ZO(Z,BQ))=1 ' PU(ZO(Z,BQ))=-3 ' End If ' BQ=(BQ+1) mod ZP(Z) 'Wend PU(FL)=-5 : PU(TL)=-5 : PU(TR)=-1 : PU(FR)=-1 Return ' LRBORD: ' Find the two bordering lines joining the two zones. FL=0 : TL=0 : FR=0 : TR=0 If ZO(F,FL)=ZO(Z,TL) Then FL=FL+1 If ZO(F,FR)=ZO(Z,TR) Then FR=FR+1 CHANGED=1 While CHANGED=1 CHANGED=0 NL=(TL+ZP(Z)-1) mod ZP(Z) D=0 X=PX(ZO(F,FL)) : Y=PY(ZO(F,FL)) DX=PX(ZO(Z,TL)) : DY=PY(ZO(Z,TL)) DX=DX-X : DY=DY-Y : TMPTL=TL While NL<>TMPTL PX=PX(ZO(Z,NL))-X : PY=PY(ZO(Z,NL))-Y ND=DY*PX-DX*PY If ND>0 DX=PX : DY=PY : TL=NL : CHANGED=1 End If NL=(NL+ZP(Z)-1) mod ZP(Z) Wend ' NL=(FL+1) mod ZP(F) D=0 X=PX(ZO(F,FL)) : Y=PY(ZO(F,FL)) DX=PX(ZO(Z,TL)) : DY=PY(ZO(Z,TL)) X=X-DX : Y=Y-DY : TMPFL=FL While NL<>TMPFL PX=PX(ZO(F,NL))-DX : PY=PY(ZO(F,NL))-DY ND=X*PY-Y*PX If ND>0 X=PX : Y=PY : FL=NL : CHANGED=1 End If NL=(NL+1) mod ZP(F) Wend Wend 'JOINCOORDS[PX(ZO(F,FL)),PY(ZO(F,FL)),PX(ZO(Z,TL)),PY(ZO(Z,TL)),7] ' CHANGED=1 While CHANGED=1 CHANGED=0 NR=(TR+1) mod ZP(Z) D=0 X=PX(ZO(F,FR)) : Y=PY(ZO(F,FR)) DX=PX(ZO(Z,TR)) : DY=PY(ZO(Z,TR)) DX=DX-X : DY=DY-Y : TMPTR=TR While NR<>TMPTR PX=PX(ZO(Z,NR))-X : PY=PY(ZO(Z,NR))-Y ND=DY*PX-DX*PY If ND<0 DX=PX : DY=PY : TR=NR : CHANGED=1 End If NR=(NR+1) mod ZP(Z) Wend ' NR=(FR+ZP(F)-1) mod ZP(F) D=0 X=PX(ZO(F,FR)) : Y=PY(ZO(F,FR)) DX=PX(ZO(Z,TR)) : DY=PY(ZO(Z,TR)) X=X-DX : Y=Y-DY : TMPFR=FR While NR<>TMPFR PX=PX(ZO(F,NR))-DX : PY=PY(ZO(F,NR))-DY ND=X*PY-Y*PX If ND<0 X=PX : Y=PY : FR=NR : CHANGED=1 End If NR=(NR+ZP(F)-1) mod ZP(F) Wend Wend 'JOINCOORDS[PX(ZO(F,FR)),PY(ZO(F,FR)),PX(ZO(Z,TR)),PY(ZO(Z,TR)),7] Return ' LISTORDER: Screen 0 Ink 0 Bar TXP*8,7 To 640,64 For A=0 To 27 : ZOPR[A] : Next ZOUT[ZOP,3] Return ' Procedure ZOPR[A] X=A mod 11 : Y=A/11 X=X*5+TXP : Y=Y+2 Screen 0 Locate X,Y P=Start(14)+(CZ*32+A)*4 If Peek(P)<>255 Then M$="Z" Else M$=" " If Peek(P+1)<>255 Then M$=M$+"L" Else M$=M$+" " If Peek(P+2)<>255 Then M$=M$+"R" Else M$=M$+" " If Peek(P+3)<>255 Then M$=M$+"V" Else M$=M$+" " Print M$; End Proc ' PLACEPLAYER: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Click X=(X*MU)+XO : Y=(Y*MU)+YO If A$="e" ZOSHO[PLZ,4] ZOGET[X,Y] : P=Param : If P>=0 : EZONE=P : End If Gosub REDRAW ZOSHO[PLZ,10] End If If M=0 Then Return If M=1 ZOSHO[PLZ,4] ZOGET[X,Y] : P=Param : If P>=0 : PLZ=P : End If PLX=X : PLY=Y : Gosub REDRAW ZOSHO[PLZ,10] End If If M=2 ZOSHO[PLZ2,4] ZOGET[X,Y] : P=Param : If P>=0 : PLZ2=P : End If PLX2=X : PLY2=Y : Gosub REDRAW ZOSHO[PLZ2,10] End If Return ' DEFGRAPH: Return ' DEFHEIGHT: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Click X=(X*MU)+XO : Y=(Y*MU)+YO If CZ<0 Then Return D=1 : If Key State($60) or Key State($61) Then D=8 If A$="-" Add FLH,-D Screen 0 : Locate TXP,2 : Print "Floor Height: ";FLH;" " End If If A$="+" Add FLH,D Screen 0 : Locate TXP,2 : Print "Floor Height: ";FLH;" " End If If A$="w" Curs Off Screen 0 : Locate TXP,2 : Print "Enter water height:" Locate TXP,4 : Input ":> ";WH ZH(CZ,2)=WH : ZOFILL[CZ,4,5] If NZ>1 For A=0 To NZ-2 For B=0 To ZP(A)-1 If WT(A,B)<>1 O=ZO(A,B) : P=ZO(A,B+1) For C=A+1 To NZ-1 For D=0 To ZP(C)-1 If O=ZO(C,D+1) and P=ZO(C,D) ZZ(A,B)=C : ZZ(C,D)=A End If Next Next End If Next Next CHA=1 While CHA=1 CHA=0 For A=0 To NZ If ZH(A,2)=WH For B=0 To ZP(A)-1 Z=ZZ(A,B) If ZH(Z,2)<>WH and ZH(Z,0)>WH ZH(Z,2)=WH : CHA=1 : ZOFILL[Z,4,5] End If Next End If Next Wend End If End If If M=0 Then Return ZOSHO[CZ,4] ZOGET[X,Y] : P=Param : If P>=0 Then CZ=P ZOSHO[CZ,10] If M=1 Screen 0 : Curs Off ZH(CZ,0)=FLH Locate TXP,3 : Print "Water Height: ";ZH(CZ,2);" " End If If M=2 Screen 0 : Curs Off : FLH=ZH(CZ,0) Locate TXP,2 : Print "Floor Height: ";ZH(CZ,0);" " Locate TXP,3 : Print "Water Height: ";ZH(CZ,2);" " End If Return DEFWATERHEIGHT: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Click X=(X*MU)+XO : Y=(Y*MU)+YO If CZ<0 Then Return D=1 : If Key State($60) or Key State($61) Then D=8 If A$="-" Add WAH,-D Screen 0 Locate TXP,2 : Print "Floor Height: ";ZH(CZ,0);" " Locate TXP,3 : Print "Water Height: ";WAH;" " End If If A$="+" Add WAH,D Screen 0 Locate TXP,2 : Print "Floor Height: ";ZH(CZ,0);" " Locate TXP,3 : Print "Water Height: ";WAH;" " End If If A$="w" Curs Off Screen 0 : Locate TXP,2 : Print "Enter water height:" Locate TXP,3 : Input ": ";WAH Locate TXP,2 : Print "Floor Height: ";ZH(CZ,0);" " Locate TXP,3 : Print "Water Height: ";WAH;" " End If If M=0 Then Return ZOSHO[CZ,4] ZOGET[X,Y] : P=Param : If P>=0 Then CZ=P ZOSHO[CZ,10] If M=1 Screen 0 : Curs Off ZH(CZ,2)=WAH Locate TXP,2 : Print "Floor Height: ";ZH(CZ,0);" " Locate TXP,3 : Print "Water Height: ";ZH(CZ,2);" " End If If M=2 Screen 0 : Curs Off : WAH=ZH(CZ,2) Locate TXP,2 : Print "Floor Height: ";ZH(CZ,0);" " Locate TXP,3 : Print "Water Height: ";ZH(CZ,2);" " End If Return ' DEFROOFHEIGHT: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 D=1 : If Key State($60) or Key State($61) Then D=8 If A$="-" Add RFH,-D Screen 0 : Locate TXP,2 : Print "Roof Height: ";RFH;" " End If If A$="+" Add RFH,D Screen 0 : Locate TXP,2 : Print "Roof Height: ";RFH;" " End If M=Mouse Click : If M=0 Then Return X=(X*MU)+XO : Y=(Y*MU)+YO ZOSHO[CZ,4] ZOGET[X,Y] : P=Param : If P>=0 Then CZ=P ZOSHO[CZ,10] If CZ<0 Then Return If M=1 ZH(CZ,1)=RFH End If If M=2 RFH=ZH(CZ,1) Screen 0 : Curs Off Locate TXP,2 : Print "Roof Height: ";ZH(CZ,1);" " End If Return DEFUPPERROOFHEIGHT: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 D=1 : If Key State($60) or Key State($61) Then D=8 If A$="-" Add RFH,-D Screen 0 : Locate TXP,2 : Print "Roof Height: ";RFH;" " End If If A$="+" Add RFH,D Screen 0 : Locate TXP,2 : Print "Roof Height: ";RFH;" " End If M=Mouse Click : If M=0 Then Return X=(X*MU)+XO : Y=(Y*MU)+YO ZOSHO[CZ,4] ZOGET[X,Y] : P=Param : If P>=0 Then CZ=P ZOSHO[CZ,10] If CZ<0 Then Return If M=1 UZH(CZ,1)=RFH End If If M=2 RFH=UZH(CZ,1) Screen 0 : Curs Off Locate TXP,2 : Print "Roof Height: ";UZH(CZ,1);" " End If Return DEFUPPERFLOORHEIGHT: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 D=1 : If Key State($60) or Key State($61) Then D=8 If A$="-" Add FLH,-D Screen 0 : Locate TXP,2 : Print "Floor Height: ";FLH;" " End If If A$="+" Add FLH,D Screen 0 : Locate TXP,2 : Print "Floor Height: ";FLH;" " End If M=Mouse Click : If M=0 Then Return X=(X*MU)+XO : Y=(Y*MU)+YO ZOSHO[CZ,4] ZOGET[X,Y] : P=Param : If P>=0 Then CZ=P ZOSHO[CZ,10] If CZ<0 Then Return If M=1 UZH(CZ,0)=FLH End If If M=2 FLH=UZH(CZ,0) Screen 0 : Curs Off Locate TXP,2 : Print "Floor Height: ";UZH(CZ,0);" " End If Return ' DEFBRIGHT: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Click : If M=0 Then Return X=(X*MU)+XO : Y=(Y*MU)+YO ZOSHO[CZ,4] ZOGET[X,Y] : P=Param : If P>=0 Then CZ=P ZOSHO[CZ,10] If CZ<0 Then Return If M=1 Screen 0 : Locate TXP,2 : Print "Zone Brightness: ";ZB(CZ);" " End If If M=2 Curs Off Screen 0 : Locate TXP,2 : Print "Enter brightness for this zone:" Locate TXP,3 : Print "Current brightness: ";ZB(CZ) Locate TXP,4 : Input "New brightness: ";ZB(CZ) Curs Off Ink 0 : Bar TXP*8,8*2 To 640,80 Locate TXP,2 : Print "Zone Brightness: ";ZB(CZ);" " End If Return DEFUPPERBRIGHT: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Click : If M=0 Then Return X=(X*MU)+XO : Y=(Y*MU)+YO ZOSHO[CZ,4] ZOGET[X,Y] : P=Param : If P>=0 Then CZ=P ZOSHO[CZ,10] If CZ<0 Then Return If M=1 Screen 0 : Locate TXP,2 : Print "UPPER Zone Brightness: ";UZB(CZ);" " End If If M=2 Curs Off Screen 0 : Locate TXP,2 : Print "Enter upper zone brightness:" Locate TXP,3 : Print "Current brightness: ";UZB(CZ) Locate TXP,4 : Input "New brightness: ";UZB(CZ) Curs Off Ink 0 : Bar TXP*8,8*2 To 640,80 Locate TXP,2 : Print "UPPER Zone Brightness: ";UZB(CZ);" " End If Return DEFPOINTBRIGHT: 'Sprite 1,X Hard(2,X),Y Hard(2,Y),3 'M=Mouse Click : If M=0 Then Return 'X=(X*MU)+XO : Y=(Y*MU)+YO 'FINDNEAR[X,Y] 'CP=Param : OUTLINE[CP] : PTNUM[CP] 'If M=1 ' PBR(CP)=(PDTA*$1000)+(PAN*$100)+(PBR and $FF) 'End If ' 'If M=2 ' C=PBR(CP) : PDTA=(C/$1000) and $F : PAN=(C/$100) and $F : PBR=C and $FF ' PBR=PBR+20 ' PBR=PBR and $FF ' PBR=PBR-20 ' Gosub BRIGHTSLIDE 'End If Return UPPERPRESETS: If A$="1" For A=0 To ZP(CZ)-1 ZPBR(CZ,A,3)=1 ZPBR(CZ,A,2)=-1 and $FF Next MESSAGE["Upper Zone bright; lit from above "] Else If A$="2" For A=0 To ZP(CZ)-1 ZPBR(CZ,A,3)=-1 and $FF ZPBR(CZ,A,2)=1 Next MESSAGE["Upper Zone bright; lit from below "] Else If A$="3" For A=0 To ZP(CZ)-1 ZPBR(CZ,A,3)=-15 and $FF ZPBR(CZ,A,2)=1 Next MESSAGE["Upper Zone bright bottom, dark top"] Else If A$="4" For A=0 To ZP(CZ)-1 ZPBR(CZ,A,3)=1 ZPBR(CZ,A,2)=-15 and $FF Next MESSAGE["Upper Zone bright top, dark bottom"] Else If A$="5" For A=0 To ZP(CZ)-1 ZPBR(CZ,A,3)=15 ZPBR(CZ,A,2)=-15 and $FF Next MESSAGE["Upper Zone dark, lit from above "] Else If A$="6" For A=0 To ZP(CZ)-1 ZPBR(CZ,A,3)=-15 and $FF ZPBR(CZ,A,2)=15 Next MESSAGE["Upper Zone dark, lit from below "] Else If A$="7" For A=0 To ZP(CZ)-1 C=ZO(CZ,A) ZPBR(CZ,A,3)=((C mod 5)+1)*$100+$F000 ZPBR(CZ,A,2)=-15 and $FF Next MESSAGE["Upper Zone Roof Glowing "] Else If A$="8" For A=0 To ZP(CZ)-1 C=ZO(CZ,A) ZPBR(CZ,A,2)=((C mod 5)+1)*$100+$F000 ZPBR(CZ,A,3)=-15 and $FF Next MESSAGE["Upper Zone Floor Glowing "] Else If A$="9" For A=0 To ZP(CZ)-1 C=ZO(CZ,A) ZPBR(CZ,A,3)=((C mod 5)+1)*$100+$F000 ZPBR(CZ,A,2)=((C mod 5)+1)*$100+$F000 Next MESSAGE["Upper Zone Glowing in sync "] Else If A$="0" For A=0 To ZP(CZ)-1 C=ZO(CZ,A) ZPBR(CZ,A,3)=((C mod 5)+1)*$100+$F000 C=1000-ZO(CZ,A) ZPBR(CZ,A,2)=((C mod 5)+1)*$100+$F000 Next MESSAGE["Upper Zone Glowing out of sync "] End If Return PRESETS: If A$="1" For A=0 To ZP(CZ)-1 ZPBR(CZ,A,1)=1 ZPBR(CZ,A,0)=-1 and $FF Next MESSAGE["Zone bright; lit from above "] Else If A$="2" For A=0 To ZP(CZ)-1 ZPBR(CZ,A,1)=-1 and $FF ZPBR(CZ,A,0)=1 Next MESSAGE["Zone bright; lit from below "] Else If A$="3" For A=0 To ZP(CZ)-1 ZPBR(CZ,A,1)=-15 and $FF ZPBR(CZ,A,0)=1 Next MESSAGE["Zone bright bottom, dark top"] Else If A$="4" For A=0 To ZP(CZ)-1 ZPBR(CZ,A,1)=1 ZPBR(CZ,A,0)=-15 and $FF Next MESSAGE["Zone bright top, dark bottom"] Else If A$="5" For A=0 To ZP(CZ)-1 ZPBR(CZ,A,1)=15 ZPBR(CZ,A,0)=-15 and $FF Next MESSAGE["Zone dark, lit from above "] Else If A$="6" For A=0 To ZP(CZ)-1 ZPBR(CZ,A,1)=-15 and $FF ZPBR(CZ,A,0)=15 Next MESSAGE["Zone dark, lit from below "] Else If A$="7" For A=0 To ZP(CZ)-1 C=ZO(CZ,A) ZPBR(CZ,A,1)=((C mod 5)+1)*$100+$F000 ZPBR(CZ,A,0)=-15 and $FF Next MESSAGE["Zone Roof Glowing "] Else If A$="8" For A=0 To ZP(CZ)-1 C=ZO(CZ,A) ZPBR(CZ,A,0)=((C mod 5)+1)*$100+$F000 ZPBR(CZ,A,1)=-15 and $FF Next MESSAGE["Zone Floor Glowing "] Else If A$="9" For A=0 To ZP(CZ)-1 C=ZO(CZ,A) ZPBR(CZ,A,1)=((C mod 5)+1)*$100+$F000 ZPBR(CZ,A,0)=((C mod 5)+1)*$100+$F000 Next MESSAGE["Zone Glowing in sync "] Else If A$="0" For A=0 To ZP(CZ)-1 C=ZO(CZ,A) ZPBR(CZ,A,1)=((C mod 5)+1)*$100+$F000 C=1000-ZO(CZ,A) ZPBR(CZ,A,0)=((C mod 5)+1)*$100+$F000 Next MESSAGE["Zone Glowing out of sync "] End If Return DEFUPPERROOFBRIGHT: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 X=(X*MU)+XO : Y=(Y*MU)+YO Gosub UPPERPRESETS If A$="g" FINDNEARZONE[CZ,X,Y] CP=Param OUTLINE[CP] : PTNUM[CP] For A=0 To ZP(CZ)-1 If ZO(CZ,A)=CP C=ZPBR(CZ,A,3) : PDTA=(C/$1000) and $F : PAN=(C/$100) and $F : PBR=C and $FF End If Next PBR=PBR+20 PBR=PBR and $FF PBR=PBR-20 Gosub BRIGHTSLIDE End If M=Mouse Click : If M=0 Then Return If M=2 ZOSHO[CZ,4] ZOGET[X,Y] P=Param If P>=0 CZ=P End If ZOSHO[CZ,10] End If If M=1 FINDNEARZONE[CZ,X,Y] CP=Param OUTLINE[CP] : PTNUM[CP] For A=0 To ZP(CZ)-1 If ZO(CZ,A)=CP ZPBR(CZ,A,3)=(PDTA*$1000)+(PAN*$100)+(PBR and $FF) End If Next End If Return DEFUPPERFLOORBRIGHT: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 X=(X*MU)+XO : Y=(Y*MU)+YO Gosub UPPERPRESETS If A$="g" FINDNEARZONE[CZ,X,Y] CP=Param OUTLINE[CP] : PTNUM[CP] For A=0 To ZP(CZ)-1 If ZO(CZ,A)=CP C=ZPBR(CZ,A,2) : PDTA=(C/$1000) and $F : PAN=(C/$100) and $F : PBR=C and $FF End If Next PBR=PBR+20 PBR=PBR and $FF PBR=PBR-20 Gosub BRIGHTSLIDE End If M=Mouse Click : If M=0 Then Return If M=2 ZOSHO[CZ,4] ZOGET[X,Y] P=Param If P>=0 CZ=P End If ZOSHO[CZ,10] End If If M=1 FINDNEARZONE[CZ,X,Y] CP=Param OUTLINE[CP] : PTNUM[CP] For A=0 To ZP(CZ)-1 If ZO(CZ,A)=CP ZPBR(CZ,A,2)=(PDTA*$1000)+(PAN*$100)+(PBR and $FF) End If Next End If Return DEFLOWERROOFBRIGHT: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 X=(X*MU)+XO : Y=(Y*MU)+YO Gosub PRESETS If A$="g" FINDNEARZONE[CZ,X,Y] CP=Param OUTLINE[CP] : PTNUM[CP] For A=0 To ZP(CZ)-1 If ZO(CZ,A)=CP C=ZPBR(CZ,A,1) : PDTA=(C/$1000) and $F : PAN=(C/$100) and $F : PBR=C and $FF End If Next PBR=PBR+20 PBR=PBR and $FF PBR=PBR-20 Gosub BRIGHTSLIDE End If M=Mouse Click : If M=0 Then Return If M=2 ZOSHO[CZ,4] ZOGET[X,Y] P=Param If P>=0 CZ=P End If ZOSHO[CZ,10] End If If M=1 FINDNEARZONE[CZ,X,Y] CP=Param OUTLINE[CP] : PTNUM[CP] For A=0 To ZP(CZ)-1 If ZO(CZ,A)=CP ZPBR(CZ,A,1)=(PDTA*$1000)+(PAN*$100)+(PBR and $FF) End If Next End If Return DEFLOWERFLOORBRIGHT: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 X=(X*MU)+XO : Y=(Y*MU)+YO Gosub PRESETS If A$="g" FINDNEARZONE[CZ,X,Y] CP=Param OUTLINE[CP] : PTNUM[CP] For A=0 To ZP(CZ)-1 If ZO(CZ,A)=CP C=ZPBR(CZ,A,0) : PDTA=(C/$1000) and $F : PAN=(C/$100) and $F : PBR=C and $FF End If Next PBR=PBR+20 PBR=PBR and $FF PBR=PBR-20 Gosub BRIGHTSLIDE End If M=Mouse Click : If M=0 Then Return If M=2 ZOSHO[CZ,4] ZOGET[X,Y] P=Param If P>=0 CZ=P End If ZOSHO[CZ,10] End If If M=1 FINDNEARZONE[CZ,X,Y] CP=Param OUTLINE[CP] : PTNUM[CP] For A=0 To ZP(CZ)-1 If ZO(CZ,A)=CP ZPBR(CZ,A,0)=(PDTA*$1000)+(PAN*$100)+(PBR and $FF) End If Next End If Return ' Procedure ZOGET[X,Y] P=-1 If NZ=-1 Then Goto 7 For A=0 To NZ If ZP(A)=0 Then Goto 3 B=0 Repeat X1=PX(ZO(A,B)) X2=PX(ZO(A,B+1)) Y1=PY(ZO(A,B)) Y2=PY(ZO(A,B+1)) Y2=Y2-Y1 : X2=X2-X1 X1=X-X1 : Y1=Y-Y1 D=(X1*Y2)-(Y1*X2) If D>0 Then Goto 3 Add B,1 Until B=ZP(A) P=A : A=NZ+1 3 Next A 7 End Proc[P] ' PTMOVE: X=X and SC : Y=Y and SC Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Click : If M=0 Then Return X=(X*MU)+XO : Y=(Y*MU)+YO If M=2 Then FINDNEAR[X,Y] : CP=Param : OUTLINE[CP] : PTNUM[CP] If CP=-1 Then Return If M=1 Then PX(CP)=X : PY(CP)=Y : Gosub REDRAW Return ' Procedure PTNUM[P] S=Screen Screen 0 Locate TXP+27,0 : Print "Point: ";P;" "; Screen S End Proc ' DEFWALL: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 If A$="," and CZ>0 Then ZOSHO[CZ,4] : CZ=CZ-1 : ZOSHO[CZ,10] If A$="." and CZ=0 and ZD(CZ)=0 and ZLI(CZ)=0 T=1 For A=0 To ZP(CZ)-1 If WD(CZ,A)>0 or WLI(CZ,A)>0 T=0 : A=100 End If Next If T<>0 USED(CZ)=0 : ZP(CZ)=0 : Gosub REDRAW End If End If If A$="b" FINDNEARZONE[CZ,X,Y] : P=Param For A=0 To ZP(CZ)-1 If ZO(CZ,A)=P and(WT(CZ,A)=0 or WT(CZ,A)=3) WT(CZ,A)=3-WT(CZ,A) : JOIN[ZO(CZ,A),ZO(CZ,A+1),10+WT(CZ,A)] End If Next End If If A$="v" FINDNEARZONE[CZ,X,Y] : P=Param For A=0 To ZP(CZ)-1 If ZO(CZ,A)=P and(WT(CZ,A)=0 or WT(CZ,A)=4) WT(CZ,A)=4-WT(CZ,A) : JOIN[ZO(CZ,A),ZO(CZ,A+1),10+WT(CZ,A)] End If Next End If M=Mouse Click : If M=0 Then Return If M=2 : ZOSHO[CZ,4] ZOGET[X,Y] P=Param If P>=0 CZ=P End If ZOSHO[CZ,10] Goto 9 End If FINDNEARZONE[CZ,X,Y] : P=Param For A=0 To ZP(CZ)-1 If WT(CZ,A)<2 If ZO(CZ,A)=P WT(CZ,A)=1-WT(CZ,A) : JOIN[ZO(CZ,A),ZO(CZ,A+1),10+WT(CZ,A)] End If End If Next 9 Return ' DEFZONE: Sprite 1,X Hard(2,X),Y Hard(2,Y),3 M=Mouse Click : If M=0 Then Return If ZP(CZ)=0 Then Gosub NEWZONE : Return X=X*MU+XO : Y=Y*MU+YO If NP=-1 Then Return FINDNEAR[X,Y] : CP=Param If ZP(CZ)<3 and CP=ZO(CZ,0) Then Return If ZP(CZ)>1 T=1 For A=1 To ZP(CZ)-1 If CP=ZO(CZ,A) T=0 End If Next If T=0 Return End If End If OUTLINE[CP] ZO(CZ,ZP(CZ))=CP F=ZO(CZ,ZP(CZ)-1) : T=ZO(CZ,ZP(CZ)) WT(CZ,ZP(CZ)-1)=1 For Q=0 To NZ-1 If USED(Q) For B=0 To ZP(Q)-1 If ZO(Q,B)=T and ZO(Q,B+1)=F WT(CZ,ZP(CZ)-1)=0 WT(Q,B)=0 Q=NZ+1 : B=100 End If Next End If Next If ZP(CZ)>0 Then JOIN[ZO(CZ,ZP(CZ)-1),ZO(CZ,ZP(CZ)),3] If ZO(CZ,0)=ZO(CZ,ZP(CZ)) Gosub REDRAW : ZOSHO[CZ,4] : USED(CZ)=1 If CZ=NZ Add NZ,1 End If Gosub INITDEFZONE Else Add ZP(CZ),1 End If Return ' Procedure ZOSHO[Z,C] If Z<0 Then Pop Proc If ZP(Z)=0 Then Pop Proc X=0 : Y=0 HI1=HILITE(HILITE,0) : HI2=HILITE(HILITE,1) For A=0 To ZP(Z)-1 X=X+PX(ZO(Z,A)) : Y=Y+PY(ZO(Z,A)) CC=2 CC=WT(Z,A)+C If WT(Z,A)>1 Then CC=C+2 If WT(Z,A)=HI1 Then CC=C+3 If WT(Z,A)=HI2 Then CC=C+4 If C=0 Then CC=0 JOIN[ZO(Z,A),ZO(Z,A+1),CC] Next If ZD(Z)>0 Ink 2,0 X=X/ZP(Z) : Y=Y/ZP(Z) : X=(X-XO)/MU : Y=(Y-YO)/MU : M$="D"+Chr$(ZD(Z)+64) : Text X-8,Y+4,M$ Else If ZLI(Z)>0 Ink 2,0 X=X/ZP(Z) : Y=Y/ZP(Z) : X=(X-XO)/MU : Y=(Y-YO)/MU : M$="L"+Chr$(ZLI(Z)+64) : Text X-8,Y+4,M$ End If If Z=EZONE Ink 3,0 X=X/ZP(Z) : Y=Y/ZP(Z) : X=(X-XO)/MU : Y=(Y-YO)/MU : M$="END" : Text X-12,Y+4,M$ End If For A=0 To 7 If SWWL(A,0)=Z B=SWWL(A,1) LX=PX(ZO(Z,B)) : LY=PY(ZO(Z,B)) RX=PX(ZO(Z,B+1)) : RY=PY(ZO(Z,B+1)) MX=(LX+RX)/2 MY=(LY+RY)/2 MX=(MX-XO)/MU MY=(MY-YO)/MU Ink 1,0 M$="S"+(Str$(A)-" ") : Text MX-8,MY,M$ If HILITE=4 JOIN[ZO(Z,B),ZO(Z,B+1),C+3] End If End If Next 'JOIN[ZO(Z,ZP(Z)),ZO(Z,0),C] End Proc ' Procedure ZOFILL[Z,C,F] Screen 2 If Z<0 Then Pop Proc If ZP(Z)<3 Then Pop Proc Ink F X1=PX(ZO(Z,0)) : Y1=PY(ZO(Z,0)) X2=PX(ZO(Z,1)) : Y2=PY(ZO(Z,1)) X1=(X1-XO)/MU : Y1=(Y1-YO)/MU X2=(X2-XO)/MU : Y2=(Y2-YO)/MU For A=1 To ZP(Z)-2 X3=PX(ZO(Z,A+1)) : Y3=PY(ZO(Z,A+1)) X3=(X3-XO)/MU : Y3=(Y3-YO)/MU Polygon X1,Y1 To X2,Y2 To X3,Y3 X2=X3 : Y2=Y3 Next ZOSHO[Z,C] End Proc ' Procedure CONNECTED[A,B,P] If A=P or B=P Then C1=12 : C2=15 : C3=13 Else C1=6 : C2=8 : C3=7 If REDCPT=0 Then Goto 320 N=Start(11) Q=Peek(N+A*100+B) : W=Peek(N+B*100+A) If Q or W If Q=1 and W=1 and REDCPT<>2 JOINCOORDS[CPTX(A),CPTY(A),CPTX(B),CPTY(B),C1] End If If Q=2 and W=2 and REDCPT<>1 JOINCOORDS[CPTX(A),CPTY(A),CPTX(B),CPTY(B),C2] End If If Q=1 and W=2 and REDCPT<>2 JOINCOORDS[CPTX(A),CPTY(A),CPTX(B),CPTY(B),C3] XD=CPTX(B)-CPTX(A) YD=CPTY(B)-CPTY(A) LD=Sqr(XD^2+YD^2) XD=(XD*30)/LD YD=(YD*30)/LD JOINCOORDS[CPTX(B)-XD,CPTY(B)-YD,CPTX(B)-XD*2-YD/2,CPTY(B)-YD*2+XD/2,C3] JOINCOORDS[CPTX(B)-XD,CPTY(B)-YD,CPTX(B)-XD*2+YD/2,CPTY(B)-YD*2-XD/2,C3] End If If Q=2 and W=1 XD=CPTX(B)-CPTX(A) YD=CPTY(B)-CPTY(A) LD=Sqr(XD^2+YD^2) XD=(XD*30)/LD YD=(YD*30)/LD JOINCOORDS[CPTX(A),CPTY(A),CPTX(B),CPTY(B),C3] JOINCOORDS[CPTX(A)+XD,CPTY(A)+YD,CPTX(A)+XD*2-YD/2,CPTY(A)+YD*2+XD/2,C3] JOINCOORDS[CPTX(A)+XD,CPTY(A)+YD,CPTX(A)+XD*2+YD/2,CPTY(A)+YD*2-XD/2,C3] End If End If 320 End Proc ' NEWZONE: X=X*MU+XO : Y=Y*MU+YO If NP=-1 Then Return FINDNEAR[X,Y] : CP=Param OUTLINE[CP] ZO(CZ,0)=CP ZP(CZ)=1 Return ' Procedure JOIN[SP,EP,C] Screen 2 Ink C X1=(PX(SP)-XO)/MU : Y1=(PY(SP)-YO)/MU X2=(PX(EP)-XO)/MU : Y2=(PY(EP)-YO)/MU If Y1>Y2 X1=X1+1 : X2=X2+1 Swap X1,X2 : Swap Y1,Y2 End If If X2>X1 Y1=Y1+1 : Y2=Y2+1 End If Extension X1,Y1 To X2,Y2 End Proc ' Procedure JOINCOORDS[X1,Y1,X2,Y2,C] Screen 2 Ink C X1=(X1-XO)/MU X2=(X2-XO)/MU Y1=(Y1-YO)/MU Y2=(Y2-YO)/MU If Y1>Y2 Swap X1,X2 : Swap Y1,Y2 End If Extension X1,Y1 To X2,Y2 End Proc ' Procedure FINDNEAR[X,Y] MD=10000000 P=-1 If NP=-1 Then Goto 22 For A=0 To NP D=(X-PX(A))^2+(Y-PY(A))^2 If D-1 Screen 2 Paste Bob(X-XO)/MU-1,(Y-YO)/MU-1,2 Else X=(X-XO)/MU : Y=(Y-YO)/MU Ink 3 : Text X-8,Y+4,"P1" End If End Proc ' Procedure CPTPUT[X,Y,C] Screen 2 X=(X-XO)/MU Y=(Y-YO)/MU Ink C Box X-2,Y-2 To X+2,Y+2 Draw X,Y-4 To X,Y+4 Draw X-4,Y To X+4,Y End Proc ' Procedure PTCLR[X,Y] Screen 2 X=(X-XO)/MU-1 Y=(Y-YO)/MU-1 Ink 0 : Box X,Y To X+2,Y+2 End Proc ' MOVEPT: If NP=-1 Then Return X=MU*MU : Y=MU*MU : X=X+XO : Y=Y+YO PTCLR[PX(NP),PY(NP)] PX(NP)=X : PY(NP)=Y PTSHOW[X,Y,1] Return ' Procedure GRID S=Screen Screen 1 Cls 0 Ink 1 For A=0 To 304 Step 128/MU Extension 0,A To 320,A Extension A,0 To A,200 Next Screen S End Proc ' Procedure SHINEBOX[OP,C] X=(OP/3)-EBX : Y=OP mod 3 If X<6 S=Screen Screen 0 : Ink C : Box X*32,Y*16 To X*32+31,Y*16+15 Screen S End If End Proc ' Procedure ZOUT[P,C] X=(P mod 11)*40+TXP*8-4 Y=(P/11)*8+15 S=Screen Screen 0 : Ink C : Box X,Y To X+39,Y+8 Screen S End Proc