@L}5 _$% l0$)$$Hȱ$ UhL" `e$$%`$%`  R@W!( L(1   Y I`  d  Ld M * @  $ % CC$$)%1 Udߥ$9%: !0 S$% DD˙`  }J)Lr MODULE ;RELGEN.ACT ;COPYRIGHT 1984, QMI, JS DeMar ;REV. 1.1, March 20, 1984 ;OBJECT CODE RELOCATION GENERATOR for ;AC}TION! compiled binary-load files. ;WARNING!!! This program requires ;four OPEN files simultaneously. ;Be sure that DOS i}s configured for ;this. With DOS 2.0, set $709 equal ;to at least 4, rewrite DOS and ;reboot. ;Requires the second file} compiled ;at any even page increment higher ;than the first file, for example: ;$3000 and $3100. ;Generates a table of} the locations ;that require relocating and saves ;it in a ".GEN" file in ACTION!. ; The ".REL" file is the original ;ob }ject code with an origin of "0". ;The actual relocator is compiled ;from the generic relocator source ;called "RELOC.ACT" } merged with the ;".GEN" file generated here. Append ;".REL" file to that code and it ;will load and relocate to MEMLO. } DEFINE in1="1", in2="2", out1="3", out2="4" BYTE abrt ;--------------------------------- PR }OC MyError(BYTE a,x,y) IF y=170 THEN PrintE("ERROR File not found!") ELSE Print("ERROR! ") PrintBE(y) FI abrt= }1 RETURN ;--------------------------------- PROC Ferror() BYTE t,clock=$14 PrintE("ERROR in Output filespec!") t=}clock-$80 DO UNTIL t=clock OD RETURN ;--------------------------------- PROC Main() CARD start1,start2,end1,end2 }CARD offsets,offsete,i,count,hits CARD test1,test2,old1,old2,old3,old0 BYTE x,z,j,wnum,d1,d2, sthigh BYTE ARRAY fn}ame1(18),fname2(18), fnameout1(18),fnameout2(18) DO Put(125) PrintE(" Relocation Code Generator ") Prin}tE(" JS DeMar 3/84 ") PutE() PrintE(" Requires two code files compiled") PrintE(" with an offset of $0100.}") PutE() Print("Filespec for code A >") InputMD(device,fname1,18) PutE() Print("Filespec for code B >") InputMD(de}vice,fname2,18) PutE() Scopy(fnameout1,fname1) SCopy(fnameout2,fnameout1) j=1 IF fnameout1(1)#'D OR fnameout1(}0)<4 THEN Ferror() ELSEIF fnameout1(2)=': THEN z=0 ELSEIF fnameout1(3)=': THEN z=1 FI DO x=fnameout1(j) j}==+1 IF x=$20 THEN EXIT ELSEIF x='. THEN EXIT ELSEIF j>fnameout1(0) THEN j==+1 EXIT ELSEIF j>}11+z THEN Ferror() FI OD fnameout1(j-1)='. fnameout1(j)='G fnameout1(j+1)='E fnameout1(j+2)='N fnameout1(0)=j}+2 j=1 IF fnameout2(1)#'D OR fnameout2(0)<4 THEN Ferror() ELSEIF fnameout2(2)=': THEN z=0 EXIT ELSEIF }fnameout2(3)=': THEN z=1 EXIT FI OD DO x=fnameout2(j) j==+1 IF x=$20 THEN EXIT ELSEIF x='. THEN } EXIT ELSEIF j>fnameout2(0) THEN j==+1 EXIT ELSEIF j>11+z THEN Ferror() EXIT FI OD fnameou}t2(j-1)='. fnameout2(j)='R fnameout2(j+1)='E fnameout2(j+2)='L fnameout2(0)=j+2 Print("Generation file = ") PrintE(fn}ameout1) Print("Relocation file = ") PrintE(fnameout2) Error=MyError abrt=0 Close(in1) Close(in2) Close(out1) Close}(out2) Open(in1,fname1,4) Open(in2,fname2,4) IF abrt=1 THEN Close(1) Close(2) RETURN FI Open(out1,fnameout1,8)} Open(out2,fnameout2,8) x=GetD(in1) ;throw away two $FF's. x=GetD(in1) PutD(out2,$FF) PutD(out2,$FF) x=GetD(in1) Put}D(out2,x) start1=x ;start addr of file1. x=GetD(in1) PutD(out2,x) start1==+(x*256) x=GetD(in1) PutD(out2,x) end1=x } x=GetD(in1) PutD(out2,x) end1==+(x*256) ;end addr of file1. x=GetD(in2) ;throw away two $FF's. x=GetD(in2) x=GetD(in2 }) start2=x ;start addr of file2. x=GetD(in2) start2==+(x*256) x=GetD(in2) end2=x x=GetD(in2) end2==+(x*256) ;end ad!}dr of file2. offsets=start2-start1 sthigh=start1/256 offsete=end2-end1 PrintDE(out1,"MODULE") PrintD(out1,";For fi"}le ") PrintDE(out1,fnameout2) PrintDE(out1,"") Print("Code starts at ") PrintD(out1,"CARD start=[") PrintCE(start1) Pri#}ntCD(out1,start1) PrintDE(out1,"]") Print(" and ends at ") PrintD(out1,"CARD finish=[") PrintCE(end1) PrintCD(out1,end$}1) PrintDE(out1,"]") Print("Compile offset was ") PrintCE(offsets) IF offsete#offsets THEN PrintE("Diferrent size fi%}les!") PrintE("ABORTED!") ELSE PrintDE(out1,"") PrintD(out1,"CARD ARRAY otable=[") wnum=0 hits=0 count=0 &} WHILE EOF(in1)=0 DO d1=GetD(in1) d2=GetD(in2) IF d1#d2 THEN IF count<(end1-start1)-5 THEN '} hits==+1 IF wnum=0 THEN PrintD(out1," ") Print(" ") ElSE PrintD(out1,"(} ") Print(" ") FI PrintCD(out1,count) Print(" ") PrintC(count) wnum==)}+1 IF wnum>4 THEN PrintDE(out1,"") PrintE("") wnum=0 FI FI o*}ld0=d1 test1=old0*256 test1==+old1 test2=old2*256 test2==+old3 IF test1>=start1 AND test1<+}=end1 THEN IF test2=$02E3 OR test2=$02E1 THEN PrintDE(out1,"]") PrintE("]") PrintD(,}out1,"CARD hits=[") PrintCD(out1,hits) PrintDE(out1,"]") PrintDE(out1,"") Print("-}CARD hits=[") PrintC(hits) PrintE("]") PrintE("") PrintD(out1,"CARD runaddr=[") .} Print("CARD runaddr=[") test1==-start1 PrintCD(out1,test1) PrintC(test1) /} PrintDE(out1,"]") PrintE("]") wnum=0 FI FI old3=old2 old2=old1 o0}ld1=d1 d1==-sthigh ELSE old3=old2 old2=old1 old1=d1 FI PutD(out2,d1) count==1}+1 OD FI PrintE("") PrintDE(out1,"") Close(in1) Close(in2) Close(out1) Close(out2) PrintE("Finished!") RETURN 2} xxxxxxxx## # # .#Ƚ# # 𩛙## 1,#PD#ELJ- <.BJD#E ;sdos.act ;bill aycock, 9/89 ;support for sparta parameter passing ;also: see the SDCS manual pp.108-111 module ;--------4}------------------------------ ;dummy routine for crunching args ;set to correct address in _setup() ;this routine gets one p5}arameter from ; the cmd line and inserts a drive ; spec ("Dn:") in front ;returns the parameter in comfname ; proc _zcr() 6};-------------------------------------- ;setup routine ;returns zero if sparta not installed ;else returns 1 and sets up _zcr7}() addr ; byte func _setup() byte sparta=$700 card dosvec=10 if sparta#'S then return(0) fi _zcr=dosvec+3 return(1) 8};-------------------------------------- ;find command line length ;returns length of command line ; byte func _cmdlen() car9}d dosvec=10 byte pointer _cmdline byte i _cmdline=dosvec+63 for i=0 to 63 do if _cmdline^=155 then exit fi _cmdlin:}e==+1 od return(i) ;-------------------------------------- ;get entire command line ;pass addr of a 65-byte-long string ;r;}eturns entire cmd line in the string ; proc _getcmds(byte array cmds) card dosvec=10 byte pointer _cmdline byte i,j _cm<}dline=dosvec+63 i=_cmdlen() cmds^=i for j=1 to i do cmds(j)=_cmdline^ _cmdline==+1 od return ;-------------------=}------------------- ;find how many parameters on cmd line ;returns number of parameters... ; ; INCLUDING PROGRAM NAME! ; >} byte func _howmany() card dosvec=10 byte pointer _argbuf byte pointer _bufoff byte i,j _argbuf=dosvec+33 _bufoff=dosv?}ec+10 _bufoff^=0 i=_cmdlen() j=0 while _bufoff^ < i do _zcr() j==+1 od return(j) ;-----------------------------@}--------- ;get default drive number ;returns ASCII VALUE of default drive ; byte func _ddrive() card dosvec=10 byte pointeA}r _argbuf2 byte pointer _bufoff byte i _argbuf2=dosvec+34 ;2nd char of buffer _bufoff=dosvec+10 _bufoff^=0 for i=1 toB} _howmany() do ;skip _all_! _zcr() od _zcr() return(_argbuf2^) ;-------------------------------------- ;get a specificC} parameter ;pass param number to get, and ; addr of a 29-byte-long string ;returns desired param in the string ;NOTE: param D}#0 is program name! ; proc _getparm(byte which byte array parm) card dosvec=10 byte pointer _argbuf byte poE}inter _bufoff byte i parm^=0 if which>(_howmany()-1) then return fi _argbuf=dosvec+33 _bufoff=dosvec+10 _bufoff^=0 F}for i=1 to which do ;skip to desired _zcr() ; parameter od _zcr() for i=1 to 28 do if _argbuf^=155 thenG} exit fi parm(i)=_argbuf^ _argbuf==+1 od parm^=i-1 return ;-------------------------------------- ;demo routine ;thH}is demonstrates the above routines ; ;NOTE: you MUST call _setup() and get ; a positive result before calling ; any of the I}other routines here... ; otherwise, it's crash city! ; proc demo() byte array parameter(29) byte array command(65) byteJ} i,j pute() if _setup()=0 then printe("SpartaDOS not installed!") return fi i=_cmdlen() printf("command line is K}%B chars long%E%E",i) _getcmds(command) printe("command line:") printe(command) pute() i=_ddrive() printf("default drL}ive is D%C:%E%E",i) i=_howmany() printf("%B parameters were passed%E",i) printf("(including parameter #0!)%E%E") printeM}("parameter number, value:") for j=0 to i-1 do _getparm(j,parameter) printf(" %B %S%E",j,parameter) od return ;---N}- end of sdos.act ----------------- ɛ+,' 20*.. өr2 1``2TOO MANY DIGITSINVALID HEXA$MODULE ; SECTIO.ACT ; The following routines perform ; direct sector access to a disk ; drive. PROC SIO=$E459() MODULE TYPP}E DCBREC = [ BYTE devID, driveNum, driveCmd, stat CARD buf, timeOut, cQ}ount, sect ] DCBREC POINTER DCB SET DCB = $300 ; SectIO - Call SIO to perform a read ; or write of a single R}sector ; parameters: drive drive # ; sector sector # ; buffer address of buffer ;S} density 1,2 = sgl,dbl ; returns: SIO error code BYTE FUNC SectIO( BYTE drive, CARD sector, buffer, BT}YTE density ) DCB.devID = '1 DCB.driveNum = drive DCB.buf = buffer DCB.timeOut = 15 DCB.sect U} = sector ; Set byte count for proper density IF (density = 1) OR (sector <= 3) THEN DCB.count = 128 ELSV}E DCB.count = 256 FI SIO() ; Call SIO to perform operation RETURN( DCB.stat ) ; ReadSector - Call SIO to W}read a ; sector from a disk drive. ; parameters: drive drive # ; sector sector # ; X}buffer address of buffer ; density 1,2 = sgl,dbl ; returns: SIO error code BYTE FUNC ReadSector( Y}BYTE drive, CARD sector, buffer, BYTE density ) DCB.driveCmd = 'R DCB.stat = $40 SectIO( drive, sector, buffeZ}r, density ) [ $60 ] ; WriteSector - Call SIO to read a ; sector from a disk drive. ; parameters: drive drive # [}; sector sector # ; buffer address of buffer ; density 1,2 = sgl,dbl ; \} returns: SIO error code BYTE FUNC WriteSector( BYTE drive, CARD sector, buffer, BYTE density ) DCB.driveCmd = 'W ]} DCB.stat = $80 SectIO( drive, sector, buffer, density ) [ $60 ] MODULE ; For user B(}NA h@]; SNEAK ATTACKMODULEBYTE CHRBASE=756,MAX,BKGRND=710,FATE=53770,LEVEL=[1],CURSIN=752,STICK=632,PS,LOUD=[0],INDX=[0],DOW _}NL=[0],DOWNR=[0],LOUD1=[0], SND1=$D208,SND2=$D20F,FREQ=[169],WSYNC=$D40A,COLBK=$D018,NMIEN=$D40E,HARD=[15],CONSOL=53279C `}ARD SCRN=88,RAMSET,HIMEM=$2E5,SCORE=[0],COMP=[300],SDLST=560,VDSLST=512CARD ARRAY LINEPT(24)BYTE ARRAY CHARSET,CHOPP a}ERSTATUS(30),CHOPPERX(30),CHOPPERY(30),EXPX(60),EXPY(60),EXPSTATUS(60),TRSTATUS(30),TRX(30),TRY(30),MISSTATUS(30), MISX(30) b},MISY(30),LL(20),RR(20),DLIST, SHAPETABLE(0)= [254 16 124 71 127 12 62 0 127 8 62 226 254 24 126 0 c} 96 96 48 48 24 60 231 255 24 24 24 24 24 60 231 255 6 6 12 12 24 60 231 255 128 85 17 d} 66 24 170 91 131 60 126 255 255 195 66 36 24 60 36 24 255 60 24 36 102 0 0 0 0 0 0 e}0 0 60 36 24 255 60 24 36 102 60 36 219 255 60 24 36 102 60 60 24 60 60 24 24 28 f}60 60 24 60 60 60 102 195]PROC DOWNLOAD()CARD INDEXBYTE VAL RAMSET=(HIMEM-$400)&$FC00 CHRBASE=RAMSET RSH 8 HI g}MEM=RAMSET FOR INDEX=0 TO 1023 DO VAL=PEEK(57344+INDEX) POKE(RAMSET+INDEX,VAL) OD CHARSET=RAMSETRETURNPROC h}DLINT() [$48 $8A $48 $98 $48] WSYNC=1 COLBK=50 [$68 $A8 $68 $AA $68 $40] PROC SCORELINE() DLIST=SDLST VDSLST i}=DLINT DLIST(27)=130 NMIEN=$C0RETURNPROC UPDATE() POSITION(1,23) PRINT("SCORE: ") POSITION(8,23) PRINTC(SCORE j}) POSITION(18,23) PRINT("LEVEL: ") POSITION(25,23) PRINTB(LEVEL)RETURNPROC TITLE()BYTE COLPF0=53270,COLPF1=53271 k},COLPF2=53273,COLPF3=53273,RTCLOCK=20,VCOUNT=54283 GRAPHICS(18) POSITION(3,4) PRINTD(6,"SNEAK ATTACK") POSITION (8,5) l} PRINTD(6,"BY") POSITION(3,7) PRINTD(6,"DAVID PLOTKIN") POSITION(3,9) PRINTD(6," ") WHILE CONSOL<>6 DO m} COLPF3=FATE WSYNC=0 COLPF0=128-VCOUNT+RTCLOCK RSH 2 COLPF1=VCOUNT+RTCLOCK RSH 2 ODRETURNPROC GR0INIT() n}CARD XX GRAPHICS(0) CURSIN=1 PRINT(" ") FOR XX=0 TO 23 DO LINEPT(XX)=SCRN+(40*XX) OD FOR XX=0 TO 29 DO C o}HOPPERSTATUS(XX)=0 CHOPPERX(XX)=0 CHOPPERY(XX)=0 MISX(XX)=0 MISY(XX)=0 MISSTATUS(XX)=0 TRSTATUS(XX)=0 p} OD FOR XX=0 TO 59 DO EXPSTATUS(XX)=0 OD FOR XX=0 TO 19 DO LL(XX)=0 RR(XX)=0 OD BKGRND=0 UPDATE()R q}ETURNPROC PLOT0(BYTE X,Y,CH)BYTE ARRAY LINE LINE=LINEPT(Y) LINE(X)=CHRETURNBYTE FUNC LOCATE0(BYTE X,Y)BYTE ARR r}AY LINE LINE=LINEPT(Y)RETURN(LINE(X))PROC NOISE() IF LOUD=0 AND LOUD1=0 AND FREQ=169 THEN RETURN FI IF LOUD s}THEN LOUD==-2 SOUND(0,90,8,LOUD) FI IF LOUD1 THEN LOUD1==-2 SOUND(1,150,8,LOUD1) FI IF FREQ<168 THEN t} FREQ==+8 SOUND(2,FREQ,10,4) ELSE FREQ=169 SOUND(2,0,0,0) FIRETURNPROC HITCHUTE(BYTE WH)BYTE LP FO u}R LP=0 TO 29 DO IF MISX(WH)=TRX(LP) AND (MISY(WH)=TRY(LP) OR MISY(WH)=TRY(LP)+1) THEN TRSTATUS(LP)=2 PLOT0(TRX(LP), v}TRY(LP),0) PLOT0(TRX(LP),TRY(LP)+1,10) PLOT0(TRX(LP),TRY(LP)+2,0) EXIT FI OD IF TRY(LP) LSH 3 < FRE w}Q THEN FREQ=TRY(LP) LSH 3 FIRETURNPROC HITMAN(BYTE WH)BYTE LP FOR LP=0 TO 29 DO IF MISX(WH)=TRX(LP) AND (MISY(W x}H)=TRY(LP)+1 OR MISY(WH)=TRY(LP)+2) THEN TRSTATUS(LP)=3 PLOT0(TRX(LP),TRY(LP)+1,6) PLOT0(TRX(LP),TRY(LP),0) y} PLOT0(TRX(LP),TRY(LP)+2,0) FI OD LOUD1=12RETURN PROC EXPLODECHOPPER(BYTE LP)BYTE LQ FOR LQ=0 TO 59 S z}TEP 2 DO IF EXPSTATUS(LQ)=0 THEN EXPSTATUS(LQ)=1 EXPSTATUS(LQ+1)=1 EXPX(LQ)=CHOPPERX(LP) EXPX(LQ+ {}1)=CHOPPERX(LP)+1 EXPY(LQ)=CHOPPERY(LP) EXPY(LQ+1)=CHOPPERY(LP) CHOPPERSTATUS(LP)=0 PLOT0(EXPX(LQ),EX |}PY(LQ),6) PLOT0(EXPX(LQ+1),EXPY(LQ+1),6) EXIT FI ODRETURN PROC HITCHOPPER(BYTE WH)BYTE LP FOR LP=0 T }}O 29 DO IF MISY(WH)=CHOPPERY(LP) AND (MISX(WH)=CHOPPERX(LP) OR MISX(WH)=CHOPPERX(LP)+1) THEN EXPLODECHOPPER(LP) ~} EXIT FI OD LOUD=12RETURNPROC MISSILEHIT(BYTE WH)BYTE DUM DUM=LOCATE0(MISX(WH),MISY(WH)) IF DUM=0 THEN } PLOT0(MISX(WH),MISY(WH),84) RETURN FI MISSTATUS(WH)=0 IF DUM=1 OR DUM=2 THEN HITCHOPPER(WH) SCORE==+1 EL }SEIF (DUM=7 AND INDX<6 OR DUM=8 AND INDX>3) THEN HITCHUTE(WH) SCORE==+2 ELSEIF (DUM=8 AND INDX<4 OR DUM=9 AND INDX> }1) THEN HITMAN(WH) SCORE==+1 FIRETURNPROC MODIFY()CARD XX FOR XX=0 TO 103 DO CHARSET(XX+8)=SHAPETABLE(XX }) ODRETURNPROC LAUNCHTROOPER(BYTE WH)BYTE LP IF FATE>240-(LEVEL LSH 1) THEN FOR LP=0 TO 29 DO IF TRSTATUS( }LP)=0 THEN TRSTATUS(LP)=1 TRX(LP)=CHOPPERX(WH) IF TRX(LP)=0 THEN TRX(LP)=1 FI TRY(L }P)=CHOPPERY(WH)+1 PLOT0(TRX(LP),TRY(LP),7) PLOT0(TRX(LP),TRY(LP)+1,8) PLOT0(TRX(LP),TRY(LP)+2,9) } EXIT FI OD FIRETURNPROC ERASECHOPPER(BYTE WH) PLOT0(CHOPPERX(WH),CHOPPERY(WH),0) PLOT0(CHOPPERX(WH)+1 },CHOPPERY(WH),0) CHOPPERSTATUS(WH)=0 CHOPPERX(WH)=0 CHOPPERY(WH)=0RETURNPROC DRAWCHOPPER(BYTE WH) PLOT0(CHOPPERX( }WH),CHOPPERY(WH),1) PLOT0(CHOPPERX(WH)+1,CHOPPERY(WH),2)RETURNPROC CLEARSCREEN()BYTE LP FOR LP=0 TO 29 DO IF C }HOPPERSTATUS(LP) THEN ERASECHOPPER(LP) FI IF TRSTATUS(LP) THEN TRSTATUS(LP)=0 PLOT0(TRX(LP),TRY(LP),0) } PLOT0(TRX(LP),TRY(LP)+1,0) PLOT0(TRX(LP),TRY(LP)+2,0) FI IF MISSTATUS(LP)=1 THEN MISSTATUS(LP)=0 PLOT }0(MISX(LP),MISY(LP),0) FI OD FOR LP=0 TO 59 STEP 2 DO IF EXPSTATUS(LP)=1 THEN EXPSTATUS(LP)=0 EXPSTATUS(LP+ }1)=0 PLOT0(EXPX(LP),EXPY(LP),0) PLOT0(EXPX(LP+1),EXPY(LP+1),0) FI ODRETURNPROC MOVECHOPPER()BYTE LP,PS }=[0] FOR LP=0 TO 29 DO IF CHOPPERSTATUS(LP)=1 THEN IF CHOPPERX(LP)=38 THEN ERASECHOPPER(LP) ELSE PLOT0( }CHOPPERX(LP),CHOPPERY(LP),0) CHOPPERX(LP)==+1 DRAWCHOPPER(LP) LAUNCHTROOPER(LP) FI FI I }F CHOPPERSTATUS(LP)=2 THEN IF CHOPPERX(LP)=0 THEN ERASECHOPPER(LP) ELSE PLOT0(CHOPPERX(LP)+1,CHOPPERY(LP),0) } CHOPPERX(LP)==-1 DRAWCHOPPER(LP) LAUNCHTROOPER(LP) FI FI OD IF PS=0 THEN CHARSET(8)=56 } CHARSET(16)=28 PS=1 ELSE PS=0 CHARSET(8)=254 CHARSET(16)=127 FIRETURNPROC LAUNCHCHOPPER()BYTE LP } IF FATE>230-(LEVEL LSH 1) THEN FOR LP=0 TO 29 DO IF CHOPPERSTATUS(LP)=0 THEN CHOPPERY(LP)=RAND(HARD) IF FATE>1 }28 THEN CHOPPERX(LP)=38 CHOPPERSTATUS(LP)=2 ELSE CHOPPERX(LP)=0 CHOPPERSTATUS(LP)=1 } FI DRAWCHOPPER(LP) EXIT FI OD FIRETURNPROC DRAWBASE()BYTE LP FOR LP=19 TO 21 DO P }LOT0(LP,22,128) OD PLOT0(20,21,4)RETURNPROC AIMGUN() IF STICK=11 THEN PS=3 ELSEIF STICK=7 THEN PS=5 ELSE PS }=4 FI PLOT0(20,21,PS)RETURNPROC SHOOT()BYTE TRIG=644,LP,FLG=[0] IF TRIG=1 OR FLG=0 THEN FLG=1 RETURN FI FO }R LP=0 TO 29 DO IF MISSTATUS(LP)=0 THEN MISSTATUS(LP)=1 MISY(LP)=20 IF PS=3 THEN MISX(LP)=19 ELSEIF PS= }5 THEN MISX(LP)=21 ELSE MISX(LP)=20 FI MISSILEHIT(LP) EXIT FI OD FLG=0RETURNPROC }MOVESHOTS()BYTE LP FOR LP=0 TO 29 DO IF MISSTATUS(LP)=1 THEN PLOT0(MISX(LP),MISY(LP),0) IF STICK=11 THEN MISX(LP })==-1 ELSEIF STICK=7 THEN MISX(LP)==+1 ELSE MISY(LP)==-1 FI IF (MISX(LP)<>39 AND MISY(LP)<>255 AND MI }SX(LP)<>0) THEN MISSILEHIT(LP) ELSE MISSTATUS(LP)=0 FI FI ODRETURNPROC MOVEEXPLOSIONS()BYTE LP FOR L }P=0 TO 59 STEP 2 DO IF EXPSTATUS(LP)=1 THEN PLOT0(EXPX(LP),EXPY(LP),0) PLOT0(EXPX(LP+1),EXPY(LP+1),0) EXPY(LP })==+1 EXPY(LP+1)==+1 EXPX(LP)==-1 EXPX(LP+1)==+1 IF EXPY(LP)<>22 AND EXPX(LP)<>0 AND EXPX(LP+1)<>39 T }HEN PLOT0(EXPX(LP),EXPY(LP),6) PLOT0(EXPX(LP+1),EXPY(LP+1),6) ELSE EXPSTATUS(LP)=0 EXP }STATUS(LP+1)=0 FI FI ODRETURNPROC BASEEXPLODE()BYTE ARRAY ENDX(0)=[16 24 17 23 20],ENDY(0)=[22 22 19 19 17] }BYTE LP,TIME=20 COLOR=38 FOR LP=0 TO 4 DO PLOT(20,22) DRAWTO(ENDX(LP),ENDY(LP)) OD FOR LP=0 TO 16 DO SOUN }D(0,FATE,8,16-LP) SOUND(1,FATE,8,16-LP) TIME=0 DO UNTIL TIME=15 OD OD SNDRST() COLOR=32 FOR LP= }0 TO 4 DO PLOT(20,22) DRAWTO(ENDX(LP),ENDY(LP)) ODRETURNPROC ENDRIGHT()BYTE LP,LQ,NN,TIME=20 FOR LP=0 TO 19 }DO IF RR(LP)=1 THEN LQ=21+LP WHILE LQ>20 DO IF NN=12 THEN NN=13 ELSE NN=12 FI PLOT0 }(LQ,22,NN) TIME=0 DO UNTIL TIME=10 OD PLOT0(LQ,22,0) LQ==-1 OD }PLOT0(21,22,11) FI OD FOR LP=0 TO 3 DO PLOT0(21,22-LP,11) TIME=0 DO UNTIL TIME=10 OD OD BAS }EEXPLODE()RETURNPROC ENDLEFT()BYTE LP,LQ,LC,NN,TIME=20 FOR LP=0 TO 19 DO LQ=19-LP IF LL(LQ)=1 THEN FOR LC=LQ }TO 19 DO IF NN=12 THEN NN=13 ELSE NN=12 FI PLOT0(LC,22,NN) TIME=0 DO } UNTIL TIME=10 OD PLOT0(LC,22,0) OD PLOT0(19,22,11) FI OD FOR LP=0 TO 3 DO PLOT0(19, }22-LP,11) TIME=0 DO UNTIL TIME=10 OD OD BASEEXPLODE()RETURNPROC ENDPRINT()BYTE TRIG=644,LP POSIT }ION(10,7) PRINT("GAME OVER...FINAL SCORE:") POSITION(15,8) PRINTC(SCORE) POSITION(15,9) PRINT("FINAL LEVEL :") PR }INTB(LEVEL) POSITION(10,20) PRINT("PRESS TO PLAY AGAIN") DO UNTIL TRIG=0 OD DOWNL=0 DOWNR=0 PUT(125) } FOR LP=0 TO 19 DO LL(LP)=0 RR(LP)=0 OD SCORE=0 LEVEL=1 DRAWBASE() UPDATE() HARD=15RETURNPROC GAMEOVE }RTWO()BYTE LP SNDRST() CLEARSCREEN() LOUD=0 LOUD1=0 FREQ=169 FOR LP=0 TO 19 DO IF LL(LP)=1 THEN PLOT0(LP,22, }11) FI IF RR(LP)=1 THEN PLOT0(LP+21,22,11) FI OD IF DOWNL=4 THEN ENDLEFT() ELSE ENDRIGHT() FI ENDPR }INT()RETURNPROC GAMEOVERONE()BYTE LP SNDRST() CLEARSCREEN() LOUD=0 LOUD1=0 FREQ=169 FOR LP=0 TO 19 DO IF } LL(LP)=1 THEN PLOT0(LP,22,11) FI IF RR(LP)=1 THEN PLOT0(LP+21,22,11) FI OD BASEEXPLODE() ENDPRINT()RETURN }PROC TROOPERDOWN(BYTE WH)BYTE CC TRSTATUS(WH)=0 CC=TRX(WH) PLOT0(TRX(WH),TRY(WH),0) PLOT0(TRX(WH),TRY(WH)+1,11) } IF TRX(WH)<20 AND LL(CC)=0 THEN LL(CC)=1 DOWNL==+1 ELSEIF TRX(WH)>20 AND RR(CC-21)=0 THEN RR(CC-21)=1 DOWNR==+1 }ELSEIF TRX(WH)=20 THEN GAMEOVERONE() FI IF DOWNL=4 OR DOWNR=4 THEN GAMEOVERTWO() FIRETURNPROC TROOPERFALL()BYTE LP },QQ,CC FOR LP=0 TO 29 DO IF TRSTATUS(LP)=2 THEN PLOT0(TRX(LP),TRY(LP)+1,0) TRY(LP)==+1 IF TRY(LP)=21 THEN C }C=TRX(LP) IF TRX(LP)<20 AND LL(CC)=1 THEN DOWNL==-1 LL(CC)=0 ELSEIF TRX(LP)>20 AND RR(CC-21)=1 THEN } RR(CC-21)=0 DOWNR==-1 FI FI IF (TRY(LP)<22 AND TRX(LP)<>20) OR (TRY(LP)<20 AND TRX(LP)=20) THE }N PLOT0(TRX(LP),TRY(LP)+1,10) ELSE TRSTATUS(LP)=0 FI FI OD RETURNPROC MOVETROOPERS()BYTE LP,QQ }BYTE ARRAY TROOPER(0)=[60 126 255 255 195 66 36 24 60 36 24 255 60 24 } 36 102 0 0 0 0 0 0 0 0] FOR LP=0 TO INDX DO CHARSET(56+LP)=0 OD MOVEBLOCK(C }HARSET+56+INDX+1,TROOPER,16) INDX==+1 IF INDX<8 THEN RETURN FI INDX=0 FOR LP=0 TO 29 DO IF TRSTATUS(LP)=1 THEN }PLOT0(TRX(LP),TRY(LP),0) TRY(LP)==+1 IF TRY(LP)=21 THEN TROOPERDOWN(LP) FI FI IF TRSTATUS(LP)=3 THE }N TRSTATUS(LP)=0 PLOT0(TRX(LP),TRY(LP)+1,0) FI OD MOVEBLOCK(CHARSET+56,TROOPER,24) FOR LP=0 TO 29 DO IF T }RSTATUS(LP)=1 THEN PLOT0(TRX(LP),TRY(LP),7) PLOT0(TRX(LP),TRY(LP)+1,8) PLOT0(TRX(LP),TRY(LP)+2,9) FI } ODRETURNPROC NEWLEVEL()BYTE LP,TIME=20 LEVEL==+1 IF LEVEL>100 THEN LEVEL=100 FI SNDRST() LOUD=0 LOUD1=0 F }REQ=169 COMP==+300 FOR LP=10 TO 150 STEP 10 DO SOUND(0,LP,10,4) SOUND(1,LP+10,10,4) TIME=0 DO UNTIL } TIME=2 OD OD POSITION(25,23) PRINTB(LEVEL) IF LEVEL>8 THEN HARD=19 FI SNDRST()RETURNPROC MAIN()BYTE TIM }E=20,LP,CH=764 TITLE() GR0INIT() SND1=0 SND2=3 DOWNLOAD() MODIFY() DRAWBASE() SCORELINE() DO LAUNCHCHOP }PER() MOVECHOPPER() MOVEEXPLOSIONS() NOISE() TROOPERFALL() MOVETROOPERS() POSITION(8,23) PRINTC(S }CORE) IF SCORE>COMP THEN NEWLEVEL() FI TIME=0 FOR LP=2 TO 6 STEP 2 DO AIMGUN() SHOOT() MOVE }SHOTS() DO UNTIL TIME=LP OD OD ODRETURN }SSOLVE.CREA0 (;;24,20,10,20,40,40,80,80,160,192,192,192,20,10 2MODULE; SQUEEZE by David Plotkin; CHECKSUM DATA;[9D B7 4C F7 52 58 31 F9; 40 38 55 8D C3 54 96 2B; 04 40 20 7F 1B 2}A 55 57; 0A 61 51 8F 9F 58 F4 4B; B6 B4 B5 E9 ]BYTE ChrBase=756,Max,Bkgrnd=710, Fate=53770,Level=[1],CursIn=752, } Gunx=[19],Guny=[12],Ps=[1], Loud=[0],Dly=[3],Hard=[1]CARD Scrn=88,RamSet,HiMem=$2E5, Score=[0],TargetCARD ARR}AY Linept(24),Ll(30)BYTE ARRAY Charset,Shotstatus(30), Shotx(30),Shoty(30),EndL(24), EndR(24), ShapeTable(0})= [104 208 208 213 213 208 208 104 10 8 7 87 87 7 7 10 255 255 255 255 255 255 255 255 170 170} 170 170 170 170 170 170 85 85 85 85 85 85 85 85 87 87 87 87 87 87 87 87 175 175 175 175 175 175} 175 175 170 255 170 255 170 255 170 255 85 255 85 255 85 255 85 255 85 170 85 170 85 170 85 170]PRO}C Download();Step back HiMem and move the;character set into RAMRamSet=(HiMem-$400)&$FC00;1K boundaryChrBase=RamSet RSH 8}HiMem=RamSetMOVEBLOCK(RamSet,57344,1024)Charset=RamSetRETURNPROC Gr0Init();Set up address of each screen;line and ini}tializeCARD xxGRAPHICS(0) CursIn=1 PRINT(" ")FOR xx=0 TO 23DO Linept(xx)=Scrn+(40*xx) EndL(xx)=0 EndR(xx)=39ODFOR x}x=0 TO 29DO Shotstatus(xx)=0 Shotx(xx)=0 Shoty(xx)=0 Ll(xx)=xx*1000OD Bkgrnd=0RETURNPROC Plot0(BYTE x,y,ch);Plot a ch}ar at location x,yBYTE ARRAY lineline=Linept(y) line(x)=chRETURNPROC Modify();Modify the RAM character setCARD xxFOR }xx=0 TO 79DO Charset(xx+8)=ShapeTable(xx)ODRETURNPROC UpdateScore();Print the score and LevelPOSITION(1,23) PRINT("}ź")POSITION(8,23) PRINTC(Score)POSITION(16,23) PRINT("̺")POSITION(23,23) PRINTB(Level)POSITION(27,23) PRINT("Ta}rg: ")POSITION(33,23) PRINTC(Target)RETURNPROC Noise();the explosions when a block is hitIF Loud=0 THEN RETURN FILoud=}=-2 SOUND(1,90,8,Loud)RETURNPROC NewLevel();set up a more difficult levelBYTE time=20,lpSOUND(1,0,0,0) PUT(125) Level==}+1POSITION(9,12)PRINT("New ") POSITION(20,12)PRINTB(Level) time=0 DO SOUND(0,time,10,4) UNTIL time>100 ODPU}T(125) SOUND(0,0,0,0)UpdateScore()FOR lp=0 TO 29DO Shotstatus(lp)=0 ODFOR lp=0 TO 23DO EndL(lp)=0 EndR(lp)=39 ODIF Leve}l>8 THEN Dly=1 ELSEIF Level>3 THEN Dly=2 ELSE Dly=3FI Loud=0RETURNPROC Choice();choose the difficulty levelBYTE lp=[1}],time=20,trig=644,stick=632POSITION(2,13)PRINT("Select Difficulty with Jojstick")POSITION(2,14)PRINT("Then press "})POSITION(7,16)PRINT("1. - Goal 8000 points")POSITION(7,17)PRINT("2. - Goal 12000 points")POSITION(7,18)PRI}NT("3. - Goal 14000 points")DO Plot0(5,lp+15,0) IF stick=14 AND lp>1 THEN lp==-1 ELSEIF stick=13 AND lp<3 THEN } lp==+1 FI Plot0(5,lp+15,84) time=0 DO UNTIL time=20 OD UNTIL trig=0OD Hard=lpIF lp=1 THEN Target=8000 ELSEIF lp=2} THEN Target=12000 ELSE Target=14000FIRETURNPROC Intro();The introductionBYTE time=20,lp,xxBYTE ARRAY hello(0)=[51 4}9 53 37 3737 37 58 37 1 1 1]POSITION(7,5)PRINT("Ǡ")FOR lp=0 TO 11DO Plot0(lp+9,8,hello(lp)) SOUND(0,hell}o(lp) LSH 1,10,4) time=0 DO UNTIL time=9 ODOD SOUND(0,0,0,0) POSITION(7,9)PRINT("written in ACTION")POSITION(7,10)PRINT}("by David Plotkin")Choice()FOR lp=0 TO 11DO xx=lp+9 DO Plot0(xx,8,0) xx==-1 IF xx<1 THEN EXIT FI Plot0(xx,8,hel}lo(lp)) SOUND(0,xx LSH 3,10,4) time=0 DO UNTIL time=1 OD ODOD SOUND(0,0,0,0) PUT(125)RETURNPROC EndGame();the }game over routinesBYTE time=20,lp,trig=644,xx,yyBYTE ARRAY gameover(0)=[39 97 109 1010 47 118 101 114]PUT(125) SOUND(1,0,}0,0)FOR lp=0 TO 8DO Plot0(lp+7,12,gameover(lp)) ODIF Score>=Target THEN POSITION(5,7) PRINT("You met your !!!")FI U}pdatescore()time=0DO SOUND(0,time,10,8)UNTIL time=60 ODSOUND(0,0,0,0) Choice() Level=0FOR lp=0 TO 8DO xx=lp+7 yy=12 DO} Plot0(xx,yy,0) xx==+1 yy==-1 IF (xx>39 or yy<1) THEN EXIT FI Plot0(xx,yy,gameover(lp)) SOUND(0,xx LSH 3,10,4) } time=0 DO UNTIL time=1 OD ODOD Score=0 NewLevel()RETURNPROC Movegun();Read joystick and move the gunBYTE stick=632}Plot0(Gunx,Guny,0);erase the gunIF stick=14 THEN;this is a stick up Guny==-1 ELSEIF stick=13;stick down THEN Guny==+1FI}IF stick=7 THEN Ps=1 ELSEIF stick=11 THEN Ps=2;stick right(1) or left(2)FIIF Guny<1 THEN Guny=1 ELSEIF;out of Guny>21 }THEN Guny=21; BoundsFIPlot0(Gunx,Guny,Ps);redraw the gunRETURNPROC Testcol(BYTE wh);see if bullet wh hit anything}BYTE qqqq=Shoty(wh)IF Shotstatus(wh)=1 THEN IF EndR(qq)<=Shotx(wh) THEN Plot0(Shotx(wh),Shoty(wh),0) Shotstatus(w}h)=0 EndR(qq)==+1 Loud=6 Score==+2 FI ELSE IF EndL(qq)>=Shotx(wh) THEN Plot0(Shotx(wh),Shoty(wh),0) Shotstatu}s(wh)=0 EndL(qq)==-1 Loud=6 Score==+2 FIFIIF Score>Ll(Level) THEN NewLevel() FIRETURNPROC Shoot();check the tigge}r and fire if pushedBYTE trig=644,lpIF trig=1 THEN RETURN FIFOR lp=0 to 29;find an empty shotDO IF Shotstatus(lp)=0 THE}N;got one IF Ps=1 THEN;gun facing right Shotstatus(lp)=1 Shotx(lp)=Gunx+1 ELSE Shotstatus(lp)=2 S}hotx(lp)=Gunx-1 FI Shoty(lp)=Guny Plot0(Shotx(lp),Shoty(lp),84) Testcol(lp) EXIT FIODRETURNPROC MoveShots(});move the fired bulletsBYTE lpFOR lp=0 TO 29;for each shotDO IF Shotstatus(lp)=1 THEN;going right Plot0(Shotx(lp),}Shoty(lp),0) Shotx(lp)==+1 IF Shotx(lp)=39 THEN Shotstatus(lp)=0 ELSE Plot0(Shotx(lp),Shoty(lp),84) } Testcol(lp) FI FI IF Shotstatus(lp)=2 THEN;going left Plot0(Shotx(lp),Shoty(lp),0) Shotx(lp)==-1 IF Shot}x(lp)=0 THEN Shotstatus(lp)=0 ELSE Plot0(Shotx(lp),Shoty(lp),84) Testcol(lp) FI FIODRETURNPROC Gr}owWalls();grow squares from both sidesBYTE lvl,lp,dum,yBYTE ARRAY lmore(24),rmore(24)FOR lp=0 TO 23DO lmore(lp)=0 rmore(}lp)=0 ODIF Level>10 THEN lvl=10 ELSE lvl=LevelFIFOR lp=1 to lvl+HardDOIF Fate>210-lvl LSH 2 THEN;grow dum=RAND(8)+3 }y=RAND(21)+1 IF Fate>128 AND EndR(y)>20 AND rmore(y)=0 THEN rmore(y)=1 EndR(y)==-1 Plot0(EndR(y),y,dum) ELSEIF }EndL(y)<18 AND lmore(y)=0 THEN lmore(y)=1 EndL(y)==+1 Plot0(EndL(y),y,dum) FIFIODFOR lp=1 to 22DO IF EndL(lp)=1}8 AND EndR(lp)=20 THEN EndGame() EXIT FIODIF Score>=Target THEN EndGame() FIRETURNPROC Main()BYTE time=20Gr0Init() I}ntro()Download()Modify() UpdateScore()DO Movegun() GrowWalls()Shoot() MoveShots() Noise()time=0 POSITION(8,23) PRINTC(Sc}ore)DO UNTIL time=Dly OD ODRETURN } p( NX,NY = ,r( INPUT  At!  @!6-@v !;************************************ ;* * ;*(C)Copyright 1986 by Paul B. Loux * ;* } * ;* These routines are in the public * ;* domain, and are not to be sold * ;* for a profit. They }may be freely * ;* distributed, provided that this * ;* header remains in place. Use and * ;* enjoy! PBL, CIS 72337,2073. } * ;* * ;************************************ ; ; FILE: TIMERS.ACT ; ; This file contains }a MODULE which ; provides the declarations needed ; to access the Atari OS timers. It ; includes the real-time clock (or ;} "jiffy counter") starting at $12, ; plus the counters and interrupt ; vectors for countdown timers 2-5. ; In addition, a }short demo program ; is provided to demonstrate how to ; install a timer-driven interrupt, ; and "multi-task" on your Atari. }; ; System timer 1 vectors are not in ; here, as they are used by the OS, ; to time I/O and other things. It ; can be used i}n certain cases, but ; I try to get along without it. ; ;************************************ ; ; SIO system timer variab}les ; MODULE ; BYTE RTCLOK1=$12, ; Real time clock RTCLOK2=$13, RTCLOK3=$14 CARD CDTMV2=$21A ; SIO timer 2 CA}RD CDTMV3=$21C ; SIO timer 3 CARD CDTMV4=$21E ; SIO timer 4 CARD CDTMV5=$220 ; SIO timer 5 CARD CDTMA2=$228 ; t}imer 2 vector BYTE CDTMF3=$22A ; timer 3 flag BYTE CDTMF4=$22C ; timer 4 flag BYTE CDTMF5=$22E ; timer 5 flag ; ;**}********************************** MODULE CARD ctr,ctr2,limit PROC SETCLOCK() ; zero real- RTCLOK1=0 } ; time clock RTCLOK2=0 RTCLOK3=0 RETURN PROC READCLOCK() ; show elapsed- ; time in jif }fies BYTE rt1,rt2,rt3 rt1=RTCLOK1 rt2=RTCLOK2 rt3=RTCLOK3 POSITION(10,20) PRINTB(rt1) PRINT(" ") PRINTB(rt2 }) PRINT(" ") PRINTB(rt3) PRINT(" ") RETURN PROC INTRPT() ; timer IRQ routine CDTMV2=limit ; rese }t timer ctr==+1 ; # times here RETURN PROC TEST() BYTE CH=764 ; keystroke pending CARD save  } ctr=0 ctr2=0 limit=60 ; 60 jiffy wait save=CDTMA2 ; save old vector SETCLOCK() ; zero } clock CDTMA2=INTRPT ; point vector CDTMV2=limit ; start countdown DO ctr2==+1 POSITION(10,1}0) PRINTC(ctr) ; # of timer IRQ's POSITION(10,15) PRINTC(ctr2) ; # of times here READCLOCK() } ; elapsed time UNTIL CH#255 ; press any OD ; key to stop limit=0 CDTMA2=save ;} restore vector CH=255 ; clear keystroke RETURN 2-RIGHT&6-F:Ad,&"AUA dAD;*********************************** ;* THREE LETTER GAME * ;* * ;* ada}pted for ACTION! * ;* by * ;* Gary Lee Evans * ;* San Jose, }CA * ;*********************************** BYTE y1,y2,y3,c1,c2,c3,d1,d2,d3, a,h,hits,flag,eflag,guess}es, time,time1,x CARD j,l,s,t,a1,numwords BYTE ARRAY words=[00 65 67 69 65 67 84 65 68 69 65 68 79 65 68 83 65 70 8}4 65 71 69 65 71 79 65 73 68 65 73 76 65 73 77 65 73 82 65 76 69 65 76 80 65 78 68 65 78 84 65 78 89 65 80 69 65 80 84 65} 82 67 65 82 69 65 82 75 65 82 77 65 82 84 65 83 72 65 83 75 65 83 80 65 84 69 65 87 69 65 87 76 65 88 69 65 89 69 66 65 }68 66 65 71 66 65 78 66 65 82 66 65 84 66 65 89 66 69 68 66 69 71 66 69 84 66 73 68 66 73 71 66 73 78 66 73 84 66 79 65 6}6 79 71 66 79 87 66 79 88 66 79 89 66 85 68 66 85 71 66 85 77 66 85 78 66 85 83 66 85 84 66 85 89 66 89 69 67 65 66 67 65} 68 67 65 77 67 65 78 67 65 80 67 65 82 67 65 84 67 79 66 67 79 68 67 79 71 67 79 78 67 79 80 67 79 84 67 79 87 67 79 89 }67 82 89 67 85 66 67 85 68 67 85 69 67 85 80 67 85 82 67 85 84 68 65 66 68 65 77 68 65 89 68 69 78 68 69 87 68 73 69 68 7}3 71 68 73 77 68 73 78 68 73 80 68 79 69 68 79 71 68 79 78 68 79 84 68 82 89 68 85 66 68 85 69 68 85 71 68 89 69 68 85 79} 69 65 82 69 65 84 69 71 79 69 76 75 69 76 77 69 78 68 69 76 70 69 82 65 70 65 68 70 65 71 70 65 78 70 65 82 70 65 84 70 }69 68 70 69 87 70 73 71 70 73 78 70 73 82 70 73 84 70 73 88 70 76 89 70 79 69 70 79 71 70 79 82 70 79 88 70 82 89 70 85 7}8 70 85 82 71 65 80 71 65 83 71 65 89 71 69 77 71 69 84 71 73 78 71 78 85 71 79 66 71 79 68 71 79 84 71 85 77 71 85 78 71} 85 84 71 85 89 71 89 80 72 65 68 72 65 71 72 65 77 72 65 83 72 65 84 72 65 89 72 69 78 72 69 88 72 73 68 72 73 77 72 73 80 } 72 73 83 72 73 84 72 69 82 72 69 77 72 79 69 72 79 71 72 79 80 72 79 84 72 79 87 72 85 66 72 85 69 72 85 71 72 85 77 72 !}85 84 73 67 69 73 67 89 73 76 75 73 78 75 73 77 80 73 79 78 73 82 69 73 82 75 73 84 83 73 86 89 74 65 66 74 65 82 74 65 8"}7 74 65 89 74 79 66 74 79 71 74 79 84 74 79 89 74 85 71 74 65 71 74 65 77 74 69 84 74 73 66 74 73 71 74 85 84 75 69 71 75#} 69 89 75 73 68 75 73 78 75 73 84 76 65 66 76 65 68 76 65 71 76 65 80 76 65 87 76 65 89 76 65 88 76 69 68 76 69 71 76 69 $}84 76 73 68 76 73 69 76 73 80 76 73 84 76 79 66 76 79 71 76 79 80 76 79 84 76 79 87 76 89 69 77 65 68 77 65 78 77 65 80 7%}7 65 82 77 65 84 77 65 89 77 69 78 77 69 84 77 73 68 77 79 66 77 79 80 77 79 87 77 85 68 77 73 88 77 85 71 78 65 66 78 65&} 71 78 65 80 78 65 89 78 69 84 78 69 87 78 73 76 78 73 80 78 79 68 78 79 84 78 79 82 78 79 87 78 85 84 79 65 70 79 65 75 '}79 65 82 79 65 84 79 68 69 79 73 76 79 76 68 79 78 69 79 80 84 79 82 69 79 85 82 79 85 84 79 86 65 79 87 69 79 87 76 79 8(}7 78 80 65 68 80 65 76 80 65 78 80 65 82 80 65 84 80 65 87 80 65 89 80 69 65 80 69 71 80 69 78 80 69 84 80 69 87 80 73 69)} 80 73 71 80 73 84 80 76 89 80 79 68 80 79 84 80 79 88 80 69 82 80 73 78 80 82 79 80 82 89 80 85 66 80 85 78 80 85 83 80 *}85 84 82 65 71 82 65 77 82 65 78 82 65 80 82 65 84 82 65 87 82 65 89 82 69 68 82 73 66 82 73 68 82 69 86 82 73 71 82 73 7+}7 82 73 80 82 79 66 82 79 68 82 79 69 82 79 84 82 79 87 82 85 66 82 85 69 82 85 71 82 85 77 82 85 78 82 85 84 82 89 69 83,} 65 68 83 65 71 83 65 80 83 65 84 83 65 87 83 65 89 83 69 84 83 69 87 83 69 88 83 72 89 83 69 65 83 73 78 83 72 69 83 73 80-} 83 73 82 83 73 84 83 73 88 83 75 73 83 75 89 83 76 89 83 79 66 83 79 68 83 79 78 83 79 87 83 79 89 83 80 65 83 80 89 83 .}84 89 83 85 69 83 85 77 83 85 78 84 65 66 84 65 68 84 65 71 84 65 78 84 65 80 84 65 88 84 65 82 84 69 65 84 73 78 84 72 6/}9 84 72 89 84 73 67 84 73 69 84 73 78 84 73 80 84 79 69 84 79 78 84 79 80 84 79 87 84 79 89 84 82 89 84 85 66 84 85 71 840} 87 79 85 82 78 85 83 69 85 80 83 86 65 78 86 65 84 86 69 88 86 73 65 86 73 69 86 73 77 86 79 87 89 65 75 89 65 77 89 69 1}78 89 69 83 89 69 84 89 79 85 87 65 68 87 65 71 87 65 78 87 65 82 87 65 83 87 65 88 87 65 89 87 69 66 87 69 68 87 69 84 82}7 72 79 87 72 89 87 73 71 87 73 78 87 73 84 87 79 69 87 79 78 87 82 89 90 73 80 70 73 66 83 69 69 69 89 69 65 76 76] 3} CARD FUNC Delay(BYTE time) BYTE time2 FOR time1=1 TO time DO FOR time2=1 TO 150 DO OD 4} Sound(0,time1,10,4) OD Sound(0,0,0,0) RETURN (0) BYTE FUNC Getkey() DO a=GetD(7) I5}F a>64 AND a<91 THEN EXIT FI OD RETURN(a) PROC Guess() ; Allows you to enter a three ; letter word 6} DO Position(x,23) y1=Getkey() Put(y1) y2=Getkey() Put(y2) y3=Getkey() Put(y3) a=GetD(7) IF a=7}155 THEN EXIT FI OD RETURN BYTE FUNC Checkit() ; Checks your input to make sure ; that you entere8}d a legal word flag=0 FOR a1=0 TO numwords*3 STEP 3 DO IF words(a1+1)=y1 AND words(a1+2)=9}y2 AND words(a1+3)=y3 THEN flag=1 FI OD RETURN (flag) BYTE FUNC Fighits() ; C:}hecks to see how many letters ; match your word and computers ; word h=0 IF y1=c1 AND y2=c2 AND y3=;}c3 THEN RETURN (4) FI IF y1=c1 OR y1=c2 OR y1=c3 THEN h==+1 FI IF y2<}=c1 OR y2=c2 OR y2=c3 THEN h==+1 FI IF y3=c1 OR y3=c2 OR y3==}c3 THEN h==+1 FI RETURN (h) PROC Error() eflag=1 FOR a=1 TO 6 DO Position(2,23) Print("SOMET>}HINGS WRONG !! ") Delay(100) Position(2,23) Print("SOMETHINGS WRONG !! ") Delay(50) OD ?}Position(2,23) Print("What's your secret word: ") x=27 Guess() a=Checkit() IF a=0 THEN Position(2,23) P@}rint("Illegal word - I had no chance") Delay(250) Delay(250) FI IF a=1 THEN Position(2,23) Print("YouA} gave a bad answer somewhere?") Delay(250) Delay(250) FI RETURN CARD FUNC Moveword(CARD s,CARD t) BYTE c4,cB}5,c6 c1=words((t)*3+1) c2=words((t)*3+2) c3=words((t)*3+3) c4=words((s-1)*3+1) c5=words((s-1)*3+2) c6=words((s-1)*3C}+3) words((s-1)*3+1)=c1 words((s-1)*3+2)=c2 words((s-1)*3+3)=c3 words((t)*3+1)=c4 words((t)*3+2)=c5 words((t)*3+3)=c6 D}RETURN (0) PROC Think() j=0 l==-1 IF l<1 THEN Error() FI DO IF eflag=1 THEN EXIT FI DO E} j==+1 IF j-1=l THEN RETURN FI c1=words((j-1)*3+1) c2=words((j-1)*3+2) c3=words((j-1)*3+F}3) h=Fighits() IF hits<>h THEN EXIT FI OD s=j t=l-1 Moveword(s,t) l==-1 IF l<1G} THEN Error() FI IF eflag=1 THEN EXIT FI flag=0 IF l>j-1 THEN flag=1 j==-1 FI UNTIH}L flag=0 OD RETURN PROC Getword() s=numwords WHILE s>2 DO t=Rand(s)+1 Moveword(s,t) I} s==-2 OD t=Rand(numwords)+1 d1=words(t*3+1) d2=words(t*3+2) d3=words(t*3+3) RETURN BYTE FUNC Main()J} l=numwords Getword() guesses=0 DO guesses==+1 DO Position(2,23) Print("Enter yourK} guess: ") x=20 Guess() c1=d1 c2=d2 c3=d3 a=Checkit() L}IF a=1 THEN EXIT FI FOR a=1 TO 5 DO Position(2,23) Put(y1) Put(y2)M} Put(y3) Print(" isn't a legal word") Delay(100) Position(2,23) N} Put(y1+128) Put(y2+128) Put(y3+128) Delay(50) OD OD Position(4,O}guesses+5) Put(y1) Put(y2) Put(y3) Print(" ") hits=Fighits() PrintB(hits) IF hits=4 THEN REP}TURN(2) FI Position(2,23) Print("Okay.. ") Delay(250) y1=words((l-1)*3+1) y2=woQ}rds((l-1)*3+2) y3=words((l-1)*3+3) Position(2,23) Print("My guess is: ") Put(y1) Put(y2) Put(y3) R} Position(26,guesses+5) Put(y1) Put(y2) Put(y3) Delay(250) Position(2,23) Print("How did I do (0-S}3 or R)?") DO hits=Getd(7) Position(32,guesses+5) Put(hits) IF hits='R THEN RETURN (T}1) FI hits==-48 IF hits>=0 and hits<4 THEN EXIT FI OD Think() IF eflag THEN EXIT FI U}OD RETURN (0) PROC Initialize() Poke(752,1) numwords=409 eflag=0 Print("} V}") PutE() Print(" ") PrintE("THREE LETTER GAME ") Print("| ") PrinW}tE(" |") Print("| Yours ") PrintE(" Mine |") Print("|word hit GUES") PX}rintE("S word hit|") Print("") PrintE("") FOR a=6 TO 21 DO Y} Position(18,a) PrintB(a-5) OD RETURN PROC Newgame() Position(2,23) Print("WantZ} to play another?") Print(" ") Position(23,23) a=GetD(7) IF a='N THEN Position(2,23) [} Print("Okay, come back soon.") Delay(250) Break() FI RETURN PROC Game() DO Initia\}lize() a=Main() IF eflag=1 THEN Newgame() FI IF eflag=1 THEN Game() FI IF a=1 THEN Po]}sition(26,guesses+7) Print(" I WIN ") Position(2,23) Position(4,guesses+6) Put(d1^}) Put(d2) Put(d3) FOR a=1 TO 10 DO Position(7,guesses+6) Print(" mine"_}) Delay(30) Position(7,guesses+6) Print(" mine") Delay(20) `} OD FI IF a=2 THEN Position(3,guesses+6) Print(" YOU WIN ") FI Newga}ame() OD RETURN ,* 4VV6-?:<@2<@CC6-?:<@(<@2=+;:*-^L P,-@,( 1234567890\/?]|[{_QK-@( !-@'( 3-@9  1}}E-@K( R A SAR@TBT:," 2-@@@6 B  V!1~}"@4 }!6-Z=6-%@6-%@3"A@= @5[ @5c2@@'1}@@82%D:MENU|-;2$@@@O-@@q21}u y |$|-;2$@@@O-@@q21}u y |$0ui;AP,!6-C:,%APD6-+P:'A$,%@,$A$X;&,;A$,i6-C:,'AV1}urr6.he  ̍?o   |u 6.1}urr6.hpp08 v< {>  N|P<88p@u67B:1},%@,.urr6.hv<`0 ??p?88 z Dfff~ff<<f<flxlff`````~cwkccfv~~nf:AU,uMM6.C  ;<| 80~acgcu67B:,%@,.u1}rr6.hpp088 83>u67B:,%1}@,.urr6.h;W y З l1}u67B:,%@,.urr6.h00><8<0p` 80`p?>1} ? u67B:,%@,.ubb6.X 0|88~l01}u67B:,%@,.uAV$D:HORSE8~l00?'(q MAINPICMALHSSLHSLSHCC5} LLϠҠŠҢà5}宠ӪЪêŠ &&;AB,;@,;@U,AA6.7h01DZ)ʊXiYi5}`@@6.6hBDEHI  <(OO67@U,.<   5} ĩ2OO67A,.:AU,FQQ67A),.>`RɥPee`/5}eePGG67A,.4(eeЕeeZ%-A6AV"!5}% dGG162,16,169,1,157,72,3,169,0,157,73,3,32,86,228,48,1,96,104,104,96ns+@%@$6-F:A`,36-F:A5}a,B6-F:@,Q6-F:@,]6-?:C:,,sàŢxA&@!+3AR@EA5} AHT6-F:A`,c6-F:Aa,r6-F:@,6-F:@,c-(%+ϠҠŠҠ+H(5}c(->5 (or5($ to return to loaded pictureg)(!When viewing the 5}picture, press:Q(# to return to this screen.g( Ԡ to quit.'AAH'A A65}@-@@K66.D:A@ -@$@2AR7(A A (>:,5} 6-B:,AdAUDF:B2y,"@$A 0A: AD A@ F:Ad,"AUA5}$)@$"AUAp[ @=!@d* @)+*!@E* @Y,Q67%@,.>:,[ A5}'"A&67,.' A AAR@(,* Ap*@@5}6 A@E A`6-?:C:,,$@E䠦J!6-F:A ,!6-F:A,T9F:5}B2y,"@,A%@26+9^ F:B2y,@A@hu@@--@&@5}@( LA`XAab A`ul@@'A`3Aa65}$làà堢ŢD:MILOADl@@'A`3Aa64Hq./TEMPNSPITCSCNCCNSUSCXPONTYPOYPRNTWTTEMMOVCLRESTYPNTIDOSNDESCCHSELECKEYCHOR9}SRSCHRBASPMBASFIRSTTIMNSCALECCFOSOSICIDLDHDLDH9} 9} !"#$%&9}'()*+,-./01234569}7 KKŠΠᬠà糷à堵qqź9}報婠򮠛 AP2F:@ , @P<6-F:9}Ad,$c$$d> -&6-@:7,,%"AT+17; >$n["AU9}@:7%,,+@:7%,,?@:7%@,,M6-%@Q [ Ax;6-!A(#6-&A(/"A%;69}-A(" @ "(Ap!@ AP{6.BBT6-@:7,,+6-!A1/=6-&A9}(O67@,.PT[!@ri6-&@r{67@,.bTK6.7&,A6-?:C:,:%A(,/9}67@,.>:,E @)A@J67@,.`%67@,.1!@ B67@ ,.`S67@ ,._9}"@2p67@,.`67@,.T)67@,.)67@,.L^)67@,.)67@,.s9}hI6-@&@ $767@,.>:%A(,I67@,.>:,r%67@,.%67@,.|6.7%+(,9},HH6-?:C:,:AT%,"6.+67,.467,.7$!-&@ ( !$*@A9}'B7tA*$9@K-A@d9AAdAU$Q6-@69}-6-!6-'6-66. quarterB6-@Q:6.BBT76.:$L#9}6-C:.9/5 >Z#( -?!6*,7%@@4L좠!!ΠТ" 6-R:,""@9})A07"@!@#6-&- A7 A7"@ @#6-%- A7 A9}O6-F:Ad,AU0AdAUE6-?:<<@"<,O A`(T:,A & A9}0(A:AAAA A0A@APA`ApAAA9}AA0AAAAAAAA CD! 6-6. whole! A9}MNa 6-6- A%6-%7-@@"M(chord off W A a A%X 9}Aab 6-6. half Akl(6-@6. quarter( Au۸9}v'6-@6. eighth' A۶囀)6-@6. sixteenth) A۳ݲ囊*9}6-@2 6. thirty sec* Aۮݧ囔 6-( A回6-+(*(, A9}ۣݠ 6- Aݠ 6-6 A웼 6- A  6-9}6- Ac 6-6.#@A/6-@A6-%+"@,G6-M6-S6-Y6-c A 9} AI)6-?::,67,.>:,*67,.6"@ B6-@;67,.>:,;67,.>:@:7,,%A(%@r$+",,9} 6-%(6- A 6.7%+(,, A'6-%%+,!@' AP A9} AK۪LN A (*( enter chord D( then press returnN A%VS A9}PA6-+6. G6-C: *~abcdefgmj+-#67,SAU`i )-6-?:<<@%@$+!,<,[%9}A APA`A`Api"A j;!@6./6-@:7&@,,;t=67<9},.>:,!-&%@ +(>:,36-%= A ~!A% 6- A  A0%㛒> !67&,.9} '-&@ .(66-&> A V6-@:,&@"6.%#! 06-%@:7,,<6-@H6-@9}V"A> -&%7<,46)7<,47>6-@ %+7<,47,M  6-6-@:7,,56-+"@,&+"@59},=6-%AM6-@7<,46-@(7<,4d6-@(6-@7<,46-@9}7<,0mA,7%<%,4  6-@,6-@,B:,!% 7%<%,4aj,6-@ ,7%<9}%,4 6-@,6-@,7%<%,4 6-@,6-@ G 6- A!67%,.7,167%,.7&,9}G67%@,.7&,(!6-%@6-!67,.2QA@dQ6-?:46-@6-@h% )"AU% ArS"A&!@#6-&1-%@9};( I-%@S A@|C#!@) @e)!@C%+"@',A@A@467,.>:,"(9}>:%A(,*6-%4 A@ 4D:6.C:L A@ &@,"@3:B6-%L A9} 6-&((?6-?:<<-@PB 1 6- Ap AP' A1 A 9}W-@"&(press to exit0 AP7)C@M AW A6-?:B, 9}J-@-2@@@5-9 C2G J$ , A%-@ ) A,$ 9} / +@AY%AV/ A@ 4Ap(%6-F:A`,46-F:Aa, A6-6+9},((} the musician ll:-@@"A( i)6-?: 1>lx 1>lx9}xI6-$AV6.(67A%,.167,.I6-?:}5/<5yQ@@yfD@DUQUHHl`[HHrLHL`[`lQyff[̭lfUHl[}-}}    ԏ  >}   ԋ  ԏ  <5VDATMOVPMBASSPABARBhdBh@@$ KKӢB}󬠠à묠àH;A,H6-C:.hhhhhhh`,"B }AF:A@,"+@(s=6.3h ! ԍЌнн н#LU67@4,.>:@4,s6-?:',A@P'/A0F+}@P@9/A0@`'/A@`9/A@PD$F @H',@P@U'/A@UF,}J$P-@R-@T0@U!!2@ @@&V X w$xF-} +@.-@@.(HOW ABOUT THIS...$ +@0@0F.}@@-@A@@#,@ #/@$A@ -@0@F/}"-@ , .-@0-@@20@&3-@ 4 6F0} ;0@?$@J +@O 0T#-@@#(SOUND!Y-@P F1}^-@c2@@%@h 0m-@ r |-@62@ F2}-@  $ +@(-@((YOU HAVE A CHOICE%-@%(F3}OF 8 DIFFERENT-@('VOICES'-A (-@((HIT IT MAESTRO...$F4}Š 6-@ A   6- A   6- A -@P  6-Q:,2@&F5}(S:,)(T:,A0 Ab 2k$lv +@" -"(YOU CAN EVEN HAVE+F6}-@@+(UP TO 4 VOICES(-@((AT THE SAME TIME!-A 2AP@F7}-A 2@@@@-A 2@@@-A F8}%%2@A@@-A -@ %%2AP%@%'@!!2@@F9}&@@!!2@@ %@//2@A%@$@@(S:,)(T:,AF:}  AR 2 22@2@$+-F;}@( ( THANK YOU( ( ((,)(! ANOTHER WRIGHT-ON PRODUCTION,(-@6 F<}2@ @-@@   "-@@6$ 0& * 6-3$ D:F=}SLIDSHOW@-@@   "-@@6$ 0& * 6-3$ D:D DISK CONTENTS - Front Side of Disk1. DISSOLVER CRE. Creates BASIC sub-routines for spiral or sweep dissolvesof any graJ?}phics mode screen. Excellent!Refer to magazine for "how to use".(Fred Pinho, ANTIC 1/86, p18)2. DISSOLVER DEM. A clever J@}demo of the"Dandy Dissolver". (Fred Pinho, ANTIC,1/86, S*P*A*C*E mods)3. FACE. "Face of the Galaxy" - Musicwith graphicJA}s. (Gary Gilbertson)4. FADER II. An enhanced ML Hi-Res picloader with dot-by-dot "lapse-dissolve"effects. To use: TransfJB}er to a picturedisk & rename AUTORUN.SYS. Compressedpictures (ie, KoalaPad, Micro Illustr.)must use a ".PIC" fn extender. JC}Normalpictures (ie, Micro Painter, any 62sector pic) use ".*IC" fn extenders.Reboot with this pic disk to view your"slideJD} show". Press OPTION to hold apicture on the screen; START to skipthe pause between pics; or SELECT to goto DOS. (PatrickJE} Dell'Era, ANTIC 5/85)5. FADER MOD. Use to change FADER II'spausing rate. Self prompting. BASIC.(Patrick Dell'Era, ANTICJF} 5/85)6. 3D GRAPHICS. A 3-D graphics editor.(Paul Chabot, ANTIC 10/85, JC mods)7. G.U.P. The Graphics Utility PackageJG}is a ML program which will speedup yourBASIC graphic commands & adds ten newones: circles, squares, patterned fills& more!JH} Read the magazine article forfull tutorial/instructions. For bestresults rename to AUTORUN.SYS & rebootto load. If loadedJI} from this menu, youmust press RESET upon load completion.(Darek Mihocka, ANTIC, 6/85, p45)8. G.U.P. DMO. A demonstratioJJ}n of someof G.U.P.'s capabilities. Load G.U.P.(per above) prior to running this demo.(Darek Mihocka, ANTIC, 6/85)9. HORSJK}E. A galloping horse demo usingcharacter graphics. (B.R.A.C.E.)10. MILOADER. Loads/displays Micro-Illustrator (KoalaPadJL}) pics. (ANTIC&JC)11. MUSICIAN. A "Music construction"program. Integral command list. Allowsediting of last note only! TJM}his versionis not compatable with the original!(A.Giambra, ANTIC, 6/85, pg37, JC mods)12. LAURA. Demo tune for The MusicJN}ianabove. Load "LAURA" to hear it play orto edit. (ANTIC disk, 6/85, JC mods)13. PENCILS. A sharp GTIA demo! (GreggTravJO}ares, ANTIC disk, 6/85, JC mods)14. SLIDE SHOW. A BASIC demo using theAtari to present computer "slides".(Steve Wright, JP}from B.R.A.C.E. disk) DISK CONTENTS - Back Side of Disk(NOTE: These programs should be loadedw/o BASIC to insure propeJQ}r operation.)1. FUJIBOINK. Famous Atari demo with abouncing multi-color "Fuji" logo.(Park '86)2. MCP. Multi-Colored PJR}layers demo.Brilliant colors. ML. (ANTIC 2/86)3. SPLASH. Splash colors on a Gr.7+screen. ACTION. (ANTIC, 4/85)4. SWAN.JS} Another sharp Atari demo withflying swan & twirling Fuji. (Park '86)5. VIEW 3D. Create 3-D wire frame picsin Gr 8/7+. JT}Magnify, shrink, rotate, &shift viewing position fairly fast. Seemagazine article for details. ACTION.(Paul Chabot, ANTIC JU}6/85, p37)6. HOUSE.V3D. A sample VIEW 3D image.(Paul Chabot, ANTIC 6/85)rticle for details. ACTION.(Paul Chabot, ANTIC HM