@L}5 _$% l0$)$$Hȱ$ UhL" `e$$%`$%`  R@W!( L(1   Y I`  d  Ld M * @  $ % CC$$)%1 Udߥ$9%: !0 S$% DD˙`  }J)Lr ;************************************ ;* * ;*(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. } * ;* * ;************************************ ;* * ;* Fi}le "ENTRYS.LIB" * ;* * ;* Description: Universal string * ;* input routi }ne, offering full * ;* control over keyboard input * ;* and screen display. Allows * ;* program to limit respo }nses * ;* to acceptable parameters. * ;* * ;* Calling parameters: * ; }* * ;* FIELD The field buffer. * ;* * ;* MIN } Minimum number of * ;* characters for * ;* valid response, 0-MAX.* ;* } * ;* MAX Maximum number of * ;* characters, 1-36. * ;* } * ;* TYPEC Type Code: * ;* 1 Alphanumeric * ;* 2 Force Upper Case * ;* } 3 Signed integer * ;* 4 Signed real (float) * ;* 5 Unsigned integer * ;* 6 Un}signed real * ;* 7 Yes/No check * ;* (Note: no range check * ;* is provided on }the * ;* numeric response) * ;* * ;* XIT Exit record if the * ;*} first character in * ;* FIELD is ESC. * ;* * ;* COL } Screen display * ;* horizontal position * ;* for input echo, 2-37. * ;* } * ;* ROW Screen display * ;* vertical position * ;* for input echo, 1-22.} * ;* * ;* ERRPTR Pointer variable to * ;* pass error code on * ;* } record aborts (Ctrl-Z)* ;* or XIT's (above). * ;* * ;* Note: User }entry of ESC will* ;* restart field entry, * ;* or exit (see above). * ;* Entry of Ctrl-Z }aborts* ;* record. The routine * ;* uses the BYTE FUNC * ;* Fetch() to obtain the * ;* } keystokes, allowing * ;* timeout control. * ;* * ;*************}*********************** ; ; Atari OS Variables for sound ; control and PROC Sound_reset. ; MODULE BYTE AudCtl=$D208, SKC}tl=$D20F, AudC1 =$D201, AudC2=$D203, AudC3 =$D205, AudC4=$D207 PROC Sound_reset() AudCtl=0 SKCtl=3 AudC1 =0 AudC}2=0 AudC3=0 AudC4=0 RETURN ; ;************************************ ; ; BYTE FUNC FetchD ; (BYTE ioch,Time_out) ; } ; This function is an enhancement ; to the library routine GetD(). ; Basically it is a GetD() with a ; tim}eout spec. The routine uses ; the Atari System Timer 4, whose ; counter is located at $21E,$21F ; and whose zero-flag} is located ; at $22C. Normally, the function ; RETURNs the same ATASCII code ; that a GetD() would. However, ; i }f no key is pressed prior to ; time-out, the function RETURNs ; an ATASCII value of 255. Should ; a user actually try!} to enter a ; character-255, the key sequence ; is ignored. ; ; Through use of the OS variable ; POKMSK, FetchD() "} disables the ; Break key upon each call. ; ; The value in the BYTE Time_Out ; represents the time limit in ; se#}conds. A value of zero means ; that there is no time limit. ; The maximum value for Time_out, ; 255, represents 4$} minutes and ; fifteen seconds. If more time ; is required, try using a short ; Time_out but use a loop to make ; %} the call to FetchD(), or modify ; the routine to use a CARD. ; ; The BYTE ioch represents the ; IOCB channel from &} which input ; is to be obtained. The routine ; assumes the channel has already ; been opened for input from K:. ; '} ; BYTE FUNC FetchD(BYTE ioch,Time_Out) BYTE POKMSK=$10 ; IRQ nabl bits CARD CDTMV3=$21E ; timer 4 value BYTE C(}DTMF3=$22C ; timer 4 flag BYTE CH=$2FC ; key pressed BYTE IRQEN=$D20E ; Pokey IRQ CARD jiffies BYTE respo)}nse POKMSK==&127 ; disable Break IRQEN==&127 jiffies=Time_Out*60 CH=255 CDTMF3=255 CDTMV3=jiffies DO *}IF CH#255 THEN response=GETD(ioch) IF response#255 THEN RETURN(response) FI FI UNTIL CDTMF3=0 OD ;POKMSK==%128 +} ; uncomment to ;IRQEN==%128 ; restore BRKKEY RETURN(255) ; ;************************************ ; ; This ro,}utine places a message ; at the bottom of the screen. ; PROC MSG(BYTE code) BYTE ARRAY mesag CARD ARRAY index(10) CARD c-}tr BYTE ROWCRS=$54,row CARD COLCRS=$55,col index(0)=" " index(1)="Too short-- continue" .}index(2)="Too long-- press RETURN or Edit" index(3)="Record aborted-- press ESC to clear" index(4)="Numeric input only-- cont/}inue" index(5)="Positive numbers only-- continue" index(6)="Integers only-- continue" index(7)="Value out of range-- press ES0}C" index(8)="Invalid date-- press ESC" index(9)="PROGRAM ERROR-- press ESC to bypass" IF code>9 THEN code=9 FI mesag=1}index(code) IF code>0 THEN Sound_reset() SOUND(0,20,10,10) FOR ctr=1 TO 2000 2}DO ; OD Sound_reset() FI row=ROWCRS col=COLCRS POSITION(1,23) PUT(156) 3} ; delete line PRINT(mesag) IF code=9 THEN PUT(253) FI IF code=3 OR code=7 OR code=8 OR code=9 THEN DO ctr=FET4}CHD(7,10) ; 10 second UNTIL ctr=27 OR ctr=255 ; timeout OD FI COLCRS=col+1 ROWCRS=row PUT(30) RETURN ;**********5}************************** ; ; This is the actual Entry routine. ; PROC ENTRYS (BYTE ARRAY field BYTE min,max,6}typec,xit, col,row BYTE POINTER errptr) BYTE dotflg,code,ctr,chr,intrpt,accept BYTE ROWCRS=$54 CA7}RD COLCRS=$55 DEFINE FILLCHR="46" ; "." BYTE INVFLG=$2B6 BYTE SHFLOK=$2BE BYTE SHFTMP IF col+max> 38 OR row>22 OR col<8}2 OR max1 THEN ctr==-1 IF (typec=5 OR t>}ypec=6) AND field(ctr)=46 THEN dotflg=0 FI field(ctr)=32 PUT(30) ?} PUT(FILLCHR) PUT(30) MSG(0) FI ELSEIF chr=26 THEN ; Ctrl-Z FOR ctr=1 T@}O max DO field(ctr)=32 OD ctr=0 MSG(3) errptr^=2 intrpt=1 A} EXIT ELSEIF chr=27 THEN ; ESC IF ctr>1 THEN COLCRS=col-1 ROWCRS=row FORB} ctr=1 TO max DO PUT(FILLCHR) field(ctr)=32 OD ctr=1 dotflgC}=0 COLCRS=col ROWCRS=row PUT(30) ELSE IF xit=1 THEN errptr^=1 D} intrpt=1 EXIT FI FI ELSEIF ctr>max THEN MSG(2) ELSEIF (chr<32 E} OR chr>122 OR chr=96) ; Goofy Keys THEN SHFLOK=0 INVFLG=0 ELSEIF typec=7 THEN ;yeF}s/no IF chr=110 OR ;'n chr=121 THEN;'y chr==-32 FI IF chr=89 OR ;'Y G} chr=78 THEN;'N accept=1 FI ELSEIF typec=2 THEN ; FORCE UC IF chr>96 AND chr<123 H}THEN chr==-32 FI accept=1 ELSEIF chr=45 THEN ; "-" code=4 IF ctr=1 THEN cI}ode=5 FI IF typec>4 THEN MSG(code) ELSEIF typec>2 THEN IF ctr>1 THEN MSG(4) J} ELSE accept=1 FI ELSE accept=1 FI ELSEIF chr=46 THEN ; "." IF typec=4 ORK} typec=6 THEN IF dotflg=0 THEN dotflg=1 accept=1 ELSE MSG(4) FI L}ELSEIF typec=3 OR typec=5 THEN MSG(6) ELSE accept=1 FI ELSEIF typec>2 THEN ; digitM}s only IF chr<48 OR chr>57 THEN MSG(4) ELSE accept=1 FI ELSE accept=1 FI UNN}TIL accept OD IF intrpt=1 THEN IF chr=155 THEN ; RTN MSG(0) COLCRS=col-1 ROWCRS=row field(0)=ctr-1O} PRINT(field) errptr^=0 FI EXIT ; ESC,^Z,time ELSE PUT(chr) ; accept chr field(ctP}r)=chr MSG(0) FI OD SHFLOK=SHFTMP RETURN MODULE ; continue ; ;***********************************Q}* ; ; END OF FILE. ; ;************************************ ;************************************ ; ; Example of usage of EnR}tryS(). PROC Test() BYTE x,y,min,max,typec,xit BYTE ARRAY name="xxxxxxxxxxxxxxx", id_no="xxxx", S}state="xx", price="xxxxxxxx" BYTE errcde BYTE POINTER errptr errcde=0 errptr=@errcde PUT(125) POSITION(5,5) PRT}INT("Enter Full Name: ") x=22 y=5 min=0 max=15 typec=1 xit=1 EntryS(name,min,max,typec, xit,x,y,errptr) POSITIONU}(5,7) PRINT("Enter I.D. Number: ") x=24 y=7 min=4 max=4 typec=5 xit=0 EntryS(id_no,min,max,typec, xit,x,y,errptr)V} POSITION(5,9) PRINT("Enter State: ") x=18 y=9 min=2 max=2 typec=2 EntryS(state,min,max,typec, xit,x,y,errptW}r) POSITION(5,11) PRINT("Enter Price: ") x=18 y=11 min=0 max=8 typec=6 EntryS(price,min,max,typec, xit,x,y,eX}rrptr) POSITION(5,14) PUTE() PRINTE(name) PRINTE(id_no) PRINTE(state) PRINTE(price) PUTE() PRINTE("Done...") RETURN z ;++++++++++++++++++++++++++++++++++++ ; EPSON/ATASCII PRINT FORMATTER ; Prints listed BASIC programs and ; text using EZ}pson bit mode graphics ; to print non-ASCII characters ; ; With suitable changes to the Epson ; specific variables immediatel[}y ; below, this program will work with ; a number of other graphic printers. ; ; (c)1983 Leo G. Laporte ; BOX 21248\} ; San Jose, CA 95151 ; CIS PPN # 70215,1022 ; Placed in public domain 12/8/83. ;++++++++++++++++++++++++++++]}++++++++ BYTE rts = [$60], ; OSA+ bug fix bank = $D500 ; Atari DOS bug fix MODULE DEFINE TR^}UE="1", FALSE="0", BOOL="BYTE", KEY = "0", FILE = "1", EPSON = "2", _} MAXLINE = "55" ; max # of lines per page ; Epson specific stuff CHAR ARRAY grmode = [4 27 75 8 0], ; i`}nitializes bit-mode graphics (ESC K 8 0) ; and tells printer that eight graphic ; data bytes will folloa}w. italics_on = [2 27 '4], ; if you have an older Epson w/o italics italics_off = [2 27 '5] ; change b}these strings to another suitable font CHAR formfeed = [12] ;----------------------------------c}-- ; PROCEDURE DECLARATIONS ;------------------------------------ PROC grprint(CHAR chr) ; does a graphic print of non-ASd}CII ; characters BYTE ARRAY mask =[128 64 32 16 8 4 2 1], ; bit values D7 to D0 CHARSET = $E000, ; location e}of character set in ROM grdata(8) ; character data array BYTE offset, ; current character data byte bf}it, ; current bit in byte byt ; graphic data byte BOOL bit_set, ; is bit set? flag inv_flag ; inversg}e char? CARD charloc ; location of character data ; check for inverse character IF (chr & 128) THEN inv_flag h}= TRUE chr ==& 127 ; strip off inverse bit ELSE inv_flag = FALSE FI ; find character data in ROM IF ci}hr < 32 THEN charloc = (chr + 64) * 8 ELSEIF chr > 31 AND chr < 96 THEN charloc = (chr - 32) * 8 ELSE chaj}rloc = chr * 8 FI ; rotate char data for Epson Zero(grdata, 8) ; clear character graphics data FOR offset = 0 k}TO 7 ; step through char data DO FOR bit = 0 TO 7 DO bit_set = CHARSET(charloc + offset) & maskl}(bit) IF inv_flag THEN IF bit_set = FALSE THEN grdata(bit) ==+ mask(offset) m} FI ELSEIF bit_set THEN grdata(bit) ==+ mask(offset) FI OD OD n}; dump character data PrintD(EPSON, grmode) FOR byt = 0 TO 7 DO IF grdata(byt) = 155 THEN ;prevent sendio}ng CR and thereby grdata(byt) = 151 ;cancelling graphics mode (only FI ; occurs dup}ring printing of inverse A) PutD(EPSON, grdata(byt)) OD RETURN ;----------------------------------- PROC feedq}(BYTE lines) ; feeds "lines" lines BYTE i FOR i = 1 TO lines DO PutDE(EPSON) OD RETURN ;-------r}----------------------------- PROC indent(BYTE col) ; tabs to col BYTE space = [32], i FOR i = 1 TO col DO PutD(s}EPSON, space) OD RETURN ;------------------------------------ BYTE FUNC PrintTEXT(CHAR ARRAY line) ; prints TEXT inpt}ut line CHAR eol = [155], chr BYTE cnt, col CARD linecnt ; number of lines output cnt = 1 ; current character u}in line col = 0 ; current printer column linecnt = 0 ; lines printed chr = line(cnt) IF chr = eol THEN PutDE(EPv}SON) RETURN (1) FI WHILE chr <> eol DO IF ; printable character (chr > 31 AND chw}r < 123 AND chr <> 96) THEN PutD(EPSON, chr) col ==+ 1 ELSE grprint(chr) col ==+ 2 FIx} IF (col > 80) THEN PutDE(EPSON) linecnt ==+ 1 col = 0 FI cnt ==+ 1 chr = line(cnt)y} ; get next char OD PutDE(EPSON) linecnt ==+ 1 RETURN (linecnt) ;------------------------------------ BYTE FUNC Priz}ntBASIC(CHAR ARRAY line) ; prints BASIC input line CHAR space = [32], invsp = [160], colon = [58],{} semic = [59], eol = [155], quote = [34], comma = [44], chr BYTE cnt, col, tab BOOL inqu|}otes CARD linecnt ; number of lines output cnt = 1 ; current character in line col = 0 ; current printer column li}}necnt = 0 ; lines printed inquotes = FALSE chr = line(cnt) IF chr = eol THEN RETURN (0) FI ; drop leading spaces...~} WHILE chr = space DO cnt ==+ 1 chr = line(cnt) OD ; print line number... WHILE (chr >= '0 A}ND chr <= '9) DO PutD(EPSON, chr) col ==+ 1 cnt ==+ 1 chr = line(cnt) OD ; outp}ut a space... IF chr = space THEN PutD(EPSON, chr) cnt ==+ 1 chr = line(cnt) ELSE PutD(EPSON, space) FI } col ==+ 1 ; set tab... tab = col ; now print rest of line... WHILE chr <> eol DO } IF chr = quote THEN IF inquotes THEN inquotes = FALSE ELSE inquotes = TRUE FI FI} IF ; printable character (chr > 31 AND chr < 123 AND chr <> 96) THEN PutD(EPSON, chr) col ==+ 1 } ELSE grprint(chr) col ==+ 2 FI ; should we break line?... IF } (col > 65 AND ; close to R margin (chr = space OR ; break line chr = invsp OR ; at a logical c}hr = comma OR ; spot if chr = semic)) ; possible OR (chr = colon AND inquotes = }FALSE) ; separate BASIC commands OR (col > 80) ; unconditional line break ; yes... THEN PutDE(EP}SON) linecnt ==+ 1 indent(tab) col = tab ; no... FI cnt ==+ 1 chr = line(cn}t) ; get next char OD feed(2) ; end of input line linecnt ==+ 2 RETURN (linecnt) ;-----------------------------------}-- PROC main() CHAR ARRAY source(20), title1(75), title2(75), choice(10), } line(255) BYTE consol = $D01F, ; start key invflg = $2B6, ; inverse off shflok = $2BE, ; shift} lock crsinh = $2F0, ; cursor off linecnt, linetot CARD page = [1] ; pages printed BOOL basic Bank} = 0 Put(125) ; clear screen Setcolor(2,12,2) PutE() PrintE(" EPSON/ATASCII PRETTY PRINTER") PrintE(" (c})1983 Leo G. Laporte") PutE() PrintE(" File must be LISTed BASIC or TEXT") PutE() Print("Enter source file > ") }invflg = 0 ; inverse off shflok = 64 ; caps lock InputS(source) PutE() PrintE("Enter header line #1 (max 75 char}s)") Print(">") InputMD(KEY, title1, 75) PutE() PrintE("Enter header line #2") Print(">") InputMD(KEY, title2, }75) PutE() Print("Is this a (B)ASIC or (T)ext file? ") invflg = 0 ; inverse off shflok = 64 ; caps lock Inpu}tMD(KEY, choice, 10) IF choice(1) = 'T THEN basic = FALSE ELSE basic = TRUE FI Position(2,22) crsinh =} 1 Print(" PRESS -START- TO BEGIN PRINTING") Position(2, 17) consol = 8 WHILE consol <> 6 ; wait for start D}O consol = 0 OD Close(FILE) Close(EPSON) Open(FILE, source, 4) Open(EPSON, "P:", 8) } PutDE(EPSON) PrintD(EPSON, italics_on) PrintDE(EPSON, title1) PrintDE(EPSON, title2) PrintD(EPS}ON,"Page ") PrintCDE(EPSON, page) PrintD(EPSON, italics_off) feed(2) linetot = 6 InputMD(FILE, lin}e, 255) WHILE EOF(FILE) = FALSE DO IF basic THEN linecnt = PrintBASIC(line) ELS}E linecnt = PrintTEXT(line) FI linetot ==+ linecnt IF linetot >= MAXLINE THEN ; n}ext page PutD(EPSON, formfeed) page ==+ 1 PrintD(EPSON, italics_on) PrintDE(E}PSON, title1) PrintDE(EPSON, title2) PrintD(EPSON,"Page ") PrintCDE(EPSON, page) PrintD(}EPSON, italics_off) feed(2) linetot = 6 FI Print(".") InputMD(FILE, lin}e, 255) OD PutDE(EPSON) ;flush buffer Close(FILE) Close(EPSON) crsinh = 0 Graphics(0) RETURN } R MODES(0-2,12,13)(((@32030 DIM SPCHDIS$(413)II(@32035 SPCHDIS$=>:@4,7@<@ Fix for PrintF on Action! Toolkit --------------------------------- The PrintF routine on the Action! Toolkit works great un}less you try to print a CARD value greater than 32767, or try to print the INT value -32768. The reason these problems occur} is that the PROC PF_NBase in the PRINTF.ACT file uses the "/" and "MOD" operators, which call the cartridge divide routine. } The divide routine is a SIGNED divide, so it doesn't work for large card values. The solution is to insert an UNSIGED divide} routine into the PRINTF.ACT file and use it, instead. First, insert the following code at the beginning of PRINTF.ACT: C}ARD Quotient, Remainder PROC UDiv( CARD a, divisor ) DEFINE GETCARRY="[$2E carry]" BYTE carry, i CARD te}mp Remainder = 0 FOR i = 1 TO 16 DO Remainder ==LSH 1 Quotient ==LSH 1 IF }(a&$8000)#0 THEN Remainder ==% 1 FI a ==LSH 1 temp = Remainder - divisor } GETCARRY IF (carry&1)#0 THEN Remainder = temp Quotient ==+ 1 FI OD } RETURN Some code in the PROCedure PF_NBase must also be changed. Find the section of code that reads as follows: WH}ILE n>0 DO d=n MOD base <- IF d<10 THEN d==+'0 ELSE d==+55 FI s(ptr)}=d ptr==-1 length==+1 n=n/base <- OD And change the two lines indicated so the code reads l}ike this: WHILE n>0 DO UDiv( n, base ) <- d=Remainder <- IF d<10 THEN d==+'0 } ELSE d==+55 FI s(ptr)=d ptr==-1 length==+1 n=Quotient <- OD The resul}ting PrintF routine will work properly for all CARD and INTeger numbers. vvvvvvvvvvhhhhh*h)h,h+آ S bytE DCOMMD=770,DNUM=769 card SIO=$E453,DBUFF=772,DSECNO=778 ;********************************** PROC JREAD(CARD S }ECNUM) DNUM =1 DCOMMD='R DBUFF =$600 DSECNO=SECNUM [32 SIO] RETURN PROC MAIN() BYTE NOISY=65,A1 } CARD A A1=NOISY NOISY=0 FOR A=1 TO 702 STEP 18 DO JREAD(A) OD FOR A=1 TO 702 STEP 18 DO } JREAD(703-A) JREAD(703-A) OD NOISY=A1 JREAD(1) NOISY=0 FOR A=360 TO 368 DO JREAD(A) OD } FOR A=1 TO 3 DO JREAD(A) OD NOISY=A1 RETURN hhآυб͑˩Ϡi˥hh67@ K; Atari LOGO ; Translated from the BASIC ; by Leo Laporte, 10/19/83 PROC fuji() BYTE top, bottom, xpos, cntr = [0}] BYTE ARRAY data = [ 37 41 43 45 46 29 48 35 49 37 50 39 51 41 52 43 53 44 54 45 55 46 55 47 56 48 57 48} 57 49 58 49 58 50 59 50 59 51 59 51 59 52 60 52 60 52 60 52 60 52 60 52 60 52 60 ] CARD x color = 1 } top = 5 bottom = 61 FOR xpos = 80 TO 84 DO Plot(xpos, top) Drawto(xpos, bottom) Plot(160-x}pos, top) Drawto(160-xpos, bottom) OD FOR xpos = 86 TO 115 DO IF xpos} > 90 THEN top = data(cntr) cntr ==+ 1 FI bottom = data(cntr) cntr ==+ 1 Plot(xpos, to}p) Drawto(xpos, bottom) Plot(160-xpos, top) Drawto(160-xpos, bottom) OD RETURN PROC letters()} BYTE x,y,i CARD cntr=[0] BYTE ARRAY atari = [ 49 55 61 76 81 87 93 104 0 48 56 61 76 80 88 93 }105 0 47 57 61 76 79 89 93 106 0 46 58 61 76 78 90 93 107 0 45 50 54 59 67 70 77 82 86 91 93 96 103 108 0 } 45 49 55 59 67 70 77 81 87 91 93 96 104 108 0 45 48 56 59 67 70 77 80 88 91 93 96 104 108 0 45 48 56 59 67 7}0 77 80 88 91 93 96 104 108 0 45 48 56 59 67 70 77 80 88 91 93 96 104 108 0 45 48 56 59 67 70 77 80 88 91 93 96 1}03 108 0 45 59 67 70 77 91 93 107 0 45 59 67 70 77 91 93 106 0 45 59 67 70 77 91 93 105 0 45 59 67 70} 77 91 93 104 0 45 48 56 59 67 70 77 80 88 91 93 96 100 105 0 45 48 56 59 67 70 77 80 88 91 93 96 101 106 0 } 45 48 56 59 67 70 77 80 88 91 93 96 102 107 0 45 48 56 59 67 70 77 80 88 91 93 96 103 108 0 45 48 56 59 67 70 77} 80 88 91 93 96 104 109 0 45 48 56 59 67 70 77 80 88 91 93 96 105 109 0 1 1 ] i = 66 color = 1 DO} x = atari(cntr) cntr ==+ 1 IF x = 0 THEN x = 112 y = 115 Plot(x,i) Drawto(}y,i) i ==+ 1 ELSE y = atari(cntr) cntr ==+ 1 IF x = 1 AND y = 1 THEN EXIT FI Plot(x,i) } Drawto(y,i) IF x = 112 THEN i ==+ 1 FI FI OD RETURN PROC delay(BYTE time) BYTE jifs = 20 } jifs = 0 DO UNTIL (jifs >= time) OD RETURN PROC jingle() BYTE ARRAY music= [ 121 121 121} 121 91 96 108 121 0 ] BYTE note, cntr = [0] DO note = music(cntr) cntr ==+ 1 IF note = 0 }THEN EXIT FI SndRst() Delay(2) Sound(0, note, 10, 8) Delay(8) OD Delay(12) SndRst() RETURN } PROC scroll() BYTE wsync = 54282, vcount = 54283, clr = 53270, ch = 764, cntr, chgclr =} [0], incclr, delay DO FOR cntr = 1 TO 4 DO incclr = chgclr FOR delay = 1 TO 9} DO OD DO wsync = 0 clr = incclr incclr ==+ 1 UNTIL vcount & 128 } OD OD chgclr ==+ 1 UNTIL ch <> 255 OD RETURN PROC main() Graphics(23) fuji(}) letters() jingle() scroll() RETURN  .  ˩I C  ?JK '? YBP6 ; ; TODOS.ACT ; ; This little PROCedure allows you to exit any ACTION! program to the ; ATARI DOS 2.0S DUP.SYS Menu}. ; ; WARNING: This PROC will work properly ONLY if you have WARM booted ; your system with an ATARI 2.0S DOS}.SYS file on the diskette ; in Drive #1. Furthermore, you must have a diskette with ; with DUP.SYS o}n it in Drive #1 before calling this PROC. ; ; You may return to the ACTION! environment by selecting option "B" ; (Run }Cartridge) from the DUP.SYS Menu, but your ACTION! program will ; have been wiped out by the exit to DUP.SYS! ; ; ; Enj}oy! ; ; Brad Paulsen [CIS PPN 70035,1050] PROC ToDOS() [ $6C$0A$00 ] RETURN (+ u; *** Graphics 9 Picture Printer ; *** for Prowriter printers. ; ; Files MUST be uncompressed (most are) ; resulting in }7680 bytes or 62 SD sectors long. ; ; written by Joe McFarland 8/31/86. ; address questions to CIS #74666,601 ; ; Action! l}anguage is (c) 1983 Action Computer Services ; MODULE BYTE x,y,dat,half,v,ty CARD screen=88 BYTE POINTER sloc CHAR ARRAY prin}tfile(15) PROC GetScreen() PutE() PrintE("Graphic 9 Screen to print") PrintE(">Dn:FILENAME.EXT") Print(">") InputS(printfile}) Close(1) Open(1,printfile,4,0) Graphics(9) FOR sloc=screen TO screen+7679 DO sloc^=GetD(1) OD Close(1) RETURN PROC Dump}() ;These are the color masks, 4 per Gr.9 color. BYTE ARRAY template=[255 255 255 255 255 255 247 255 255 223 255 251 255 }238 255 187 255 85 255 170 221 119 221 119 170 85 170 85 204 51 204 51 }102 51 102 51 34 136 34 136 0 85 0 85 0 51 0 51 0 17 0 68 0 32 0 4 0 0 8 0 0 0 0 0] GetScreen() C}lose(2) Open(2,"P:",8) PrintDE(2," T16 Q >") FOR x=0 TO 79 DO PrintD(2," ") PrintD(2," S0768") FOR t}y=0 TO 191 DO y=191-ty sloc=screen+40*y+x/2 half=x MOD 2 ;which half? v=sloc^ IF half THEN v=v&$0}F ELSE v=v RSH 4 FI ;shift color if odd FOR dat=0 TO 3 DO PutD(2,template(v*4+dat})) OD OD ;done printing line PutDE(2) OD PrintDE(2," [ A N <") ;restore normal operation Close(2) Graphics(0) PutE}() PrintF(" * Done printing %S%E",printfile) RETURN  D:FADERMODVL( Error #F:A, a6PROC pauz(CARD n) CARD i FOR i=0 TO N+N DO OD RETURN PROC TITLE() GRAPHICS(0) POKE(710,0) POKE(752,1) PR}INT(" ") POSITION(12,9) PRINT("ACTION! DEMO") POSITION(09,11) PRINT("BY MICHAEL MITCHELL") PAUZ(20900) RETURN } PROC DEMO2() CARD A,B,C,D,X,Y,J,K,I,COL GRAPHICS (11) POKE(710,0) COLOR=1 A=1 B=1 C=1 D=1 X=R}AND(319)+1 Y=RAND(191)+1 J=RAND(319)+1 K=RAND(191)+1 FOR I=1 TO 800 DO PLOT(X,Y) DRAWTO(J,K) X==+A Y==+B J==}+C K==+D COLOR=COL COL=COL+1 IF COL>14 THEN COL=1 FI IF X>=70 THEN A=-A X==+A FI IF J>=70 THEN C=-C J==+C FI }IF J<=0 THEN C=-C J==+C FI IF X<=0 THEN A=-A X==+A FI IF Y>=191 THEN B=-B Y==+B FI IF K>=191 THEN D=-D K==+D FI IF K<=0} THEN D=-D K==+D FI IF Y<=0 THEN B=-B Y==+B FI OD RETURN PROC HI() TITLE() DEMO2() RETURN àmBYTE XMAIN,YMAIN,LIVECOL=708, DEATHCOL=709,BIRTHCOL=710, CONSOL=53279 CARD ARRAY LINEPT(40) PROC GR5IN }IT() ;INITIALIZE A GR. 5 SCREEN. WE MUST ;DO THIS TO UTILIZE THE SPECIAL PLOT ;ROUTINES WHICH I STOLE FROM AN ;OLD }ANALOG MAGAZINE. CARD SCRN=88 BYTE LINE GRAPHICS(5) FOR LINE=0 TO 39 DO LINEPT(LINE)=SCRN+20*LINE } OD LIVECOL=8 RETURN PROC PLOT5(BYTE X,Y,COL) ;HERE IS THE STOLEN PLOT ROUTINE. IT ;IS MUCH FASTER THAN THE OS R }OUTINES, ;BUT IT DOES NO CHECKING FOR ILLEGAL ;VALUES. IT IS EASILY ADAPTABLE FOR ;GR. 7 USE. BYTE POINTER PIXEL B }YTE ARRAY COLFIL=[0 85 170 255], MASK=[63 207 243 252], MASK2=[192 48 12 3] PIXEL=LINEPT( }Y)+(X RSH 2) PIXEL^=PIXEL^&MASK(X&3) % (COLFIL(COL) & MASK2(X & 3)) RETURN BYTE FU }NC LOCATE5(BYTE X,Y) ;HERE'S ANOTHER STOLEN ROUTINE. AGAIN ;IT IS MUCH FASTER THAN OS ROUTINES, ;BUT DOES NO TESTS FOR ILL }EGAL VALUES. BYTE POINTER PIXEL BYTE ARRAY MASK=[192 48 12 3] PIXEL=LINEPT(Y)+(X RSH 2) RETURN ((PIXEL^ & MASK }(X & 3)) RSH (((X & 3) XOR 3) LSH 1)) PROC PAUZ(CARD X) ;A SIMPLE ROUTINE TO DO NOTHING FOR A ;GIVEN PERIOD OF }TIME. CARD LOOP FOR LOOP=1 TO X DO OD RETURN PROC PUTDOTS() ;THIS ROUTINE READS THE JOYSTICK AND ;MOVES A } BLINKING CURSOR AROUND THE ;SCREEN. A CELL IS ACTIVATED IF ;ONE ISN'T THERE, AND DEACTIVATED IF ;IT IS THERE. BYTE X }POS=[39],YPOS=[18],STIK=632, STRIG=644,HOLD,NEXTX,NEXTY, XLP,YLP BYTE ARRAY DELTAX = [0 0 0 0 } 0 1 1 1 0 255 255 255 0 0 0 0], DELTAY = [0 0 0 0 0 1 } 255 0 0 1 255 0 0 1 255 0] DEATHCOL=14 HOLD=LOCATE5(XPOS,YPOS) PR }INTE("JOYSTICK BUTTON TO PLACE OR ERASE") PRINTE("PUSH OPTION & SELECT TO CLEAR SCREEN") PRINTE("PUSH START TO START" }) DO PLOT5(XPOS,YPOS,2) PAUZ(2000) IF STRIG=0 AND HOLD=1 THEN HOLD=0 S }OUND(0,121,10,8) PAUZ(4000) SNDRST() ELSEIF STRIG=0 AND HOLD=0 THEN HOLD=1 } SOUND(0,29,10,8) PAUZ(2000) SNDRST() FI NEXTX=XPOS+DELTAX(STIK) NE }XTY=YPOS+DELTAY(STIK) IF NEXTX<>XPOS OR NEXTY<>YPOS THEN PLOT5(XPOS,YPOS,HOLD) XPOS=NEXTX } IF XPOS>75 THEN XPOS=4 ELSEIF XPOS<4 THEN XPOS=75 FI } YPOS=NEXTY IF YPOS>38 THEN YPOS=1 ELSEIF YPOS<1 T }HEN YPOS=38 FI SOUND(0,60,10,8) PAUZ(2000) SNDRST() } HOLD=LOCATE(XPOS,YPOS) FI PAUZ(2000) IF CONSOL=1 THEN HOLD=0 FOR YLP=1 TO 38 DO } FOR XLP=1 TO 18 DO POKE(LINEPT(YLP)+XLP,0) OD OD FI }UNTIL CONSOL=6 OD PLOT5(XPOS,YPOS,HOLD) RETURN PROC PIXELCHEK(BYTE XB,Y) ;THIS ROUTINE CHECKS ALL THE PIXELS ;I!}N THE BYTE OF SCREEN MEMORY PASSED ;TO IT FOR BIRTH OR DEATH. IF A ;PIXEL IS EMPTY AND HAS THREE LIVE ;NEIGHBORS A B!}IRTH WILL OCCUR IN THE ;NEXT GENERATION. IF A PIXEL IS LIVE ;AND HAS MORE THAN THREE LIVE ;NEIGHBORS IT WILL DIE IN THE !}NEXT ;GENERATION. BYTE LPX,LPY,LP,X,COUNT=[0],HOLD ;CONVERT X BYTE VALUE TO A PIXEL AND ;CHECK ITS EIGHT NEIGHBO!}RS. ;MULTIPLY BY FOUR FOR PIXEL VALUE. X=XB LSH 2 ;CHECK FIRST PIXEL AND THE THREE ;WHICH FOLLOW IT. !} FOR LP=X TO X+3 DO ;CHECK THE EIGHT SURROUNDING PIXELS. FOR LPY=Y-1 TO Y+1 DO FOR LPX=LP-1 TO LP+1 DO !} HOLD=LOCATE5(LPX,LPY) IF HOLD=1 OR HOLD=2 THEN COUNT==+1 FI OD OD ;!}THESE ARE THE POSSIBLE CASES OF ;BIRTH AND DEATH. WE ADD ONE IF HOLD ;IS ONE BECAUSE WE COUNTED IT IN THE ;SEARCH OF THE!} SURROUNDING PIXELS. ; ;IF A DEATH IS TO OCCUR WE RESET THE ;PIXEL COLOR TO COLOR 2. IT IS ;VISIBLE, BUT MARKED FOR DEA!}TH IN THE ;NEXT GENERATION. ; ;IF A BIRTH IS TO OCCUR WE RESET THE ;PIXEL COLOR TO THREE. IT IS ;INVISIBLE, BUT MARKE! }D FOR BIRTH IN ;THE NEXT GENERATION. HOLD=LOCATE5(LP,Y) IF HOLD=1 AND (COUNT<3 OR COUN! }T>4) THEN PLOT5(LP,Y,2) ELSEIF HOLD=0 AND COUNT=3 THEN PLOT5(LP,Y,3) FI ! } COUNT=0 OD RETURN PROC CHEKBYTE() ;THIS ROUTINE DOES A CHECK ON EACH ;SCREEN BYTE AND ITS FOUR ORTHOGONAL ;NEIG! }HBORS. IF ANY OF THESE ARE ;GREATER THAN ZERO IT CALLS PIXELCHEK ;TO CHECK THE INDIVIDUAL PIXELS OF ;THE BYTE. THIS SAV! }ES TIME FOR EACH ;PASS, SINCE BYTE OPERATIONS ARE SO ;MUCH FASTER THAN PIXEL OPERATIONS. ;THERE COULD BE ROOM FOR IMPROVEM!}ENT ;IN THIS ROUTINE. BYTE XLP,YLP BYTE POINTER XBYTE,XPLUS,XMINUS, YPLUS,YMINUS ;YLP=NUMBER OF !}ROWS IN A GR.5 SCREEN. ;XLP=NUMBER OF BYTES IN EACH ROW ; (FOUR PIXELS TO THE BYTE). ;XBYTE=POINTER TO BYTE BEING CHECK!}ED ;XPLUS=BYTE BEING CHECKED + 1 ;XMINUS=BYTE BEING CHECKED - 1 ;YPLUS=BYTE BELOW CURRENT BYTE ;YMINUS=BYTE ABOVE CURRENT!} BYTE ; I'M SO CONFUSED !!! FOR YLP=1 TO 38 DO FOR XLP=1 TO 18 DO XBYTE=LINEPT(YLP)+XLP XPLUS=XB!}YTE+1 XMINUS=XBYTE-1 YPLUS=XBYTE+20 YMINUS=XBYTE-20 IF YPLUS^>0 THEN PIXELCHEK(!}XLP,YLP) ELSEIF (XPLUS^&$C0)>0 THEN PIXELCHEK(XLP,YLP) ELSEIF XBYTE^ >0 THEN PIXELC!}HEK(XLP,YLP) ELSEIF (XMINUS^&$03)>0 THEN PIXELCHEK(XLP,YLP) ELSEIF YMINUS^ >0 THEN PIX!}ELCHEK(XLP,YLP) FI OD OD RETURN PROC RESETSCRN() ;THIS ROUTINE MASKS ALL THE !}BYTES OF ;SCREEN MEMORY WITH A HEX $55. THIS ;SETS ALL THE DEATH PIXELS TO 00 AND ;ALL THE BIRTH PIXELS TO 01, WHILE ;L!}EAVING THE STATIC CELLS UNHARMED. BYTE X,Y,MASK=[$55],HOLD BYTE POINTER BPOINT FOR Y=1 TO 38 DO BPOINT=!}LINEPT(Y) FOR X=1 TO 18 DO BPOINT^==&MASK BPOINT==+1 OD OD RETURN PROC PRI!}NTINST() PRINTE("PRESS SELECT TO DRAW") PRINTE("PRESS OPTION TO QUIT") PRINTE(" ") RETURN PROC MAIN() ;THIS !}IS THE MAIN ROUTINE. IT ;INITIALIZES THE SCREEN AND STARTS ;CYCLING THROUGH THE GENERATIONS. ;AFTER CHEKBYTE IS EXECUTED !}IT ;CHANGES COLOR REGISTER VALUES TO ;MAKE THE BIRTHS APPEAR AND THE ;DEATHS DISAPPEAR. IT THEN CALLS ;RESETSCRN TO CL!}EAR OUT BIRTHS AND ;DEATHS. ALL THE WHILE IT LOOKS FOR ;THE FUNCTION KEYS TO BE PRESSED TO ;INVOKE THE CELL EDITOR OR TO !}END ;THE PROGRAM. ; ; ROBERT ROSENBACH ; DECEMBER, 1986 GR5INIT() PRINTINST() !} DO IF CONSOL=5 THEN PUTDOTS() PRINTINST() FI DEATHCOL=8 BIRTHCOL=0 CH!}EKBYTE() DEATHCOL=0 BIRTHCOL=8 SOUND(0,20,10,10) PAUZ(3000) SNDRST() RESETSCRN() IF! } CONSOL=3 THEN EXIT FI POKE(77,0) OD RETURN Aa0@@2]A  I; This fragment loads an Action! ; program and executes it ; (thru INITAD). This fragment can be ; easily modified to %"}support any type ; of binary load file by checking the ; status of INITAD and RUNAD after ; each block of code has been%#} loaded. ; If you want this fragment to remain ; resident, you must compile to a ; specific location (outside your own %$}; program, obviously) using either the ; SET $E/SET $491 method or using ; SET $B5 to set a compilation offset ; (Note%%}: due to a bug in the Action! ; compiler offset routine, you can ; only specify a positive offset) ; Once the program is%&} compiled, type: ; ?Load ; from the monitor to obtain the ; runtime address. In your own source ; that calls Loa%'}d, you must insert the ; following line before its use: ; PROC Load=$xxxx(CHAR ARRAY str) ; where "$xxxx" is the ad%(}dress you ; found above, and where the CHAR ; ARRAY "str" is the complete filespec ; of the program you want to load. %)} MODULE ;LOAD.ACT BYTE CIO_status CARD start, len ; NOTE: CIO and ReadBlock are ; copyrighted routines%*} of ; Action! computer services ; Credit such as this of their origin ; must be given if used in your own ; program s%+}ource CHAR FUNC CIO=*(BYTE dev, CARD addr,size, BYTE cmd,aux1,aux2) [$29$F$85$A0$86$A1$A$A$A$A$AA$A5$A5$9D$342$A5$A3$9D$34%,}8$A5$A4$9D$349$A5$A6$F0$8$9D$34A$A5$A7$9D$34B$98$9D$345 $A5$A1$9D$344$20$E456$8C CIO_status$C0$88$D0$6$98$A4$A0$99 EOF$60]%-} CARD FUNC ReadBlock=*(BYTE dev, CARD addr, size) [$48$A9$7$85$A5$A9$0$85$A6$A5$A3$5$A4$D0$6$85$A0$85$A1$68$60$68$20 CIO$B%.}D$348$85$A0$BD$349$85$A1$60] ; MAINLINE **************************** CARD FUNC GetOne() BYTE cLow CARD cHigh %/} DO cLow=GetD(1) cHigh=GetD(1) cHigh== LSH 8 % cLow UNTIL cHigh#$FFFF OD RETURN(cHigh) PROC GetAddrs=*%0}() start=GetOne() len=GetOne()-start+1 RETURN PROC Load(CHAR ARRAY filespec) CARD INITAD=$2E2 Close(1) %1} Open(1,filespec,4,0) WHILE start#$2E2 DO GetAddrs() ReadBlock(1,start,len) OD Close(1) [$6C INITAD]%2} 9<,9<,9<,11;@x,;@,;@,;@ ,&&;@x,;@x,;@,;A$; LOaDPT 9/84-4/28/85, A. B. Langdon ; Read executable file to see where ; its segments load and its entry point(s) are. SE)4}T $491=$4000 SET 14=$491^ BYTE rts=[$60] ; ;INCLUDE "D:SYSLIB.ACT" ;INCLUDE "D:SYSIO.ACT" ; Using channel 1, Close caused "s)5}ystem error" with DOS 2.1 but not DOS XL. ; ACS bbs has a block read (BLKIO.ACT) in machine code segments that is ; smaller a)6}nd has a general purpose call to CIO. Here, I'll leave mine ; as it illustrates use of the language and is just as fast. ; F)7}irst global ARRAY, other than BYTE ARRAY of length less than 257, ; is placed AFTER rest of program (undocumented?). BYTE ARR)8}AY buffer(257) ; locate the buffer. CARD FLen, ; File length up to 64K i, CSum BYTE OpOK, CSum0=CSum, CSum1=CSum+1 B)9}YTE CIO_status ; global for CIO return value (per ACS convention) CARD FUNC GetAD(BYTE chan CARD addr, len) ; Block read T):}YPE IOCB=[BYTE hid,dno,com,sta CARD badr,put,blen BYTE aux1,aux2,aux3,aux4,aux5,aux6] IOCB POINTE);}R ic BYTE chan16 BYTE POINTER b chan16 = (chan&$07) LSH 4 ic = $340+chan16 ic.com = 7 ; read ic.blen = len ic.b)<}adr = addr [$AE chan16 $20 $E456 $8C CIO_status] ; LDX chan, JSR CIO; STY CIO_status IF CIO_status = $88 THEN EOF(chan)=1)=} FI FLen ==+ ic.blen ; this to RETURN is special to this application. b = addr FOR i = 1 TO ic.blen DO CSum0 ==+ b)>}^ CSum1 ==+ CSum0 b ==+ 1 OD RETURN (ic.blen) CARD FUNC GetCD(BYTE chan) ; Read a word CARD c GetAD(chan,@c,2))?} RETURN (c) PROC FixFlSp(BYTE ARRAY FileSpec) IF FileSpec(2)<>': AND FileSpec(3)<>': THEN ; prefix "D:" to file name F)@}ileSpec^==+2 i=FileSpec^ WHILE i>2 DO FileSpec(i)=FileSpec(i-2) i==-1 OD FileSpec(1)='D FileSpec)A}(2)=': FI ; Could also convert to upper case: if >$60 then subtract $20. RETURN PROC SysErr(BYTE errno) PROC MyError(BYTE)B} errno) IF errno=$80 THEN Error=SysErr Error(errno) FI PrintF("error %I. Try again%E",errno) OpOK=0 RETURN PROC End=*()C}) [$68$AA$68$CD$2E8$90$5$CD$2E6$90$F3 $48$8A$48$60] ; entry: PLA; TAX; PLA; CMP MEMLO+1; BCC lab; CMP MEMTOP+1; BCC entry; ; )D}lab: PHA; TXA; PHA; RTS ; Trace back thru RTS's and return to cartridge or DOS. ; From ACS bulletin board. PROC LoadPt() C)E}HAR ARRAY FileSpec(20) BYTE b, SHFLOK=$2BE CARD fwa, lwa, BufLen, MEMTOP=$2E5, MEMLO=$2E7 BufLen=MEMTOP-$80-buffer Sy)F}sErr=Error DO Print("File Spec=") SHFLOK=$40 ; upper case InputS(FileSpec) IF FileSpec^=0 THEN END() FI )G} FixFlSp(FileSpec) Close(2) OpOK=1 Error=MyError Open(2,FileSpec,4,0) UNTIL OpOK OD Error=SysErr FLen=0 CSum0=0)H} CSum1=0 i=GetCD(2) IF i<>$FFFF THEN ; is it a LOAD file? PrintF("Bad load file header=%H%E",i) Close(2) RET)I}URN FI DO; Code block DO fwa=GetCD(2) IF fwa=0 THEN ; may get 0 before EOF in DOS 4. FLen==-2 C)J}Sum1==-CSum0-CSum0 ; ignore these 2 bytes EOF(2)=1 FI IF EOF(2)<>0 THEN PrintF("End of file. %H b)K}ytes%E",FLen) PrintF(" checksum=%H%E",CSum) Close(2) RETURN FI UNTIL fwa<>$FFFF OD; Skip em)L}bedded $FFFF lwa=GetCD(2) IF (fwa=$2E2 OR fwa=$2E0) AND lwa=fwa+1 THEN IF fwa=$2E0 THEN Print("INIT") )M} ELSE Print("RUN") FI i=GetCD(2) fwa==+2 PrintF(" at %H%E",i) ELSE PrintF("fwa, lwa %H %H)N}%E",fwa,lwa) IF fwa$700 THEN PrintF("ACHTUNG! This loads into%Eyour DOS (MEMLO=%H)%E",MEMLO) )O} FI FI WHILE lwa>=fwa DO ; just pass over these bytes i=lwa-fwa+1 IF i>BufLen THEN i=BufLen FI i=GetAD()P}2,buffer,i) fwa==+i OD OD Close(2) RETURN PROC Main() device=0 ; in case MAC/65 has been here DO LoadP)Q}t() PrintE(" (RETURN to end)") OD RETURN iiiiiiiiiiiiiiiiiiiiiiithe pixels in half the time...",,($How about some mu(F; CIS Notice: ; I am providing the program for you ; to look at and maybe help you get ; started with ACTION!. I-S}t was ; written 'quick and dirty' and as ; such does not have many comments ; and is not the best of code in many ; place-T}s. Feel free to show it to ; anyone you like as long as you keep ; the copyright notice. ; In case you are interested, -U}this is ; the company logo for Action ; Computer Services (ACS). ; - Clinton Parker 70435,625 ; PS: Hit ESC to e-V}xit program ; Copyright 1983 by Action Computer Services ; last modified April 13, 1983 MODULE ; LOGO.ACT DEFIN-W}E RTI = "$40", PHA = "$48", PLA = "$68", TXA = "$8A", TAX = "$AA", TYA = "$98", -X} TAY = "$A8" BYTE start BYTE ARRAY display CARD ARRAY yLoc(96) PROC NMI() BYTE color, cnt BYTE COLPF1=$D017-Y}, WSYNC=$D40A, VCOUNT=$D40B, COLPF2=$D018, COLPF0=$D016 BYTE ARRAY col(0)=[$68 $C $96 $38] [PHA TXA P-Z}HA TYA PHA] IF VCOUNT=7 THEN color = start start = start - 1 IF (start&$1F)=0 THEN cnt = cnt + 1 FI FI-[} color = color - 2 WSYNC = 1 COLPF0 = color COLPF1 = color COLPF2 = col((cnt + VCOUNT) & 3) [PLA TAY PLA TA-\}X PLA RTI] PROC Background() BYTE COLBK=$D01A, VCOUNT=$D40B, WSYNC=$D40A [PHA TXA PHA TYA PHA] WSYNC = 0 I-]}F VCOUNT>50 THEN COLBK = 0 ELSE COLBK = $D6 FI [PLA TAY PLA TAX PLA RTI] PROC Init7() BYTE i CARD-^} screen, scrloc=88 Graphics(23) SetColor(0,2,10) SetColor(1,0,12) SetColor(2,0,12) display = scrloc sc-_}reen = scrloc i = 0 WHILE i<96 DO yLoc(i) = screen screen = screen + 40 i = i + 1 OD RETURN PRO-`}C Plot7(BYTE x, y) BYTE ARRAY pos, bm(0)=[$C0$30$C$3], cm(0)=[$0 $55 $AA $FF] pos = yLoc(y) pos(x RSH 2) ==-a}% (bm(x&3)&cm(color)) RETURN PROC VLine(BYTE x, y1, y2) WHILE y1#y2 DO Plot7(x, y1) y1 = y1 + 1 OD RET-b}URN PROC HLine(BYTE x1, x2, y) WHILE x1#x2 DO Plot7(x1, y) x1 = x1 + 1 OD RETURN PROC DLine(BYTE x-c}1, x2, y1) BYTE incr incr = 1 IF x2 should be a1}t least max+2 in size since and additional byte is needed for the size (first byte) and for the EOL that CIO puts at the e1}nd of the string but which is not included in the size of the string by ACTION!. I know that there are more typos, but I1} gave my list of them along with my marked up manual to OSS. These are ones I found since then and I hope that they will1} be correct in the next printing. - Clint * Reply: 60765 * RR 60714 + (UA RE T): rr #: 60765 1} Sec. 5 - Beyond BASIC... Sb: #60763-ACTION 17-Jul-84 02:50:37 Fm: RICHARD E. ERNEST 73506,1720 To: Clinton Par1}ker 70435,625 CLINT, THANKS FOR POINTING OUT ALL THOSE ERRORS. I WOULD HAVE GONE MADD IF I USED THOSE AND THEY NOT WORK1}. EDDIE ERNEST * RR 60714 (UA RE T): I67@,.>:,r%67@,.%67@,.|6.7%+(,06;More Fun With BOUNCE ;by Joel Gluck ;for ANALOG COMPUTING BYTE ARRAY xx(256),yy(256), xd(256),yd(256) BYTE5} xc,yc,hidden,cmode,TIME=20, RANDOM=53770,CONSOL=53279, CURSC=708,CH=764,NEWCOL=710, dist=[0],audball=[0] 5}CARD num=[0],curspeed=[1500], ballspeed=[900] CARD ARRAY linept(48) PROC gr5init() CARD scrn=88 BYTE line,BALLC5}OL=709,WALLCOL=710 Graphics(5) FOR line=0 TO 47 DO linept(line)=scrn+20*line OD BALLCOL=$0C WALLCOL=$94 RETURN 5} PROC plot5(BYTE x,y,col) BYTE POINTER pixel BYTE ARRAY colfil= [0 85 170 255], mask= [63 207 243 252], 5} mask2= [192 48 12 3] pixel = linept(y)+(x RSH 2) pixel^ = pixel^ & mask(x & 3) % (colfil(col) 5} & mask2(x & 3)) RETURN BYTE FUNC locate5(BYTE x,y) BYTE POINTER pixel BYTE ARRAY mask= [192 48 12 3] pixel = 5}linept(y)+(x RSH 2) RETURN((pixel^ & mask(x & 3)) RSH (((x & 3) XOR 3) LSH 1)) PROC hline(BYTE y,c) BYTE i 5}FOR i = 0 TO 79 DO plot5(i,y,c) OD RETURN PROC vline(BYTE x,c) BYTE i FOR i = 0 TO 47 DO plot5(x,i,c) OD R5}ETURN PROC pauz(CARD p) CARD i FOR i=1 TO p DO OD RETURN PROC f16(BYTE x,y) BYTE g,a,b g=Locate(x,y) IF 5}g=32 THEN RETURN FI g==+128 NEWCOL=15 b=y DO color=0 Plot(x,b) b==-1 color=g Plot(x,b) IF b=2 THEN 5} EXIT FI Sound(0,b,8,8) pauz(700+x*50) OD a=x DO color=0 Plot(a,b) a==+1 color=g Plot(a,b) 5}IF a=19 THEN EXIT FI Sound(0,a,8,8) pauz(700+x*50) OD color=0 Plot(a,b) SndRst() RETURN PROC colburst5}(BYTE x,y) BYTE g,c,a g=Locate(x,y) IF g=32 THEN RETURN FI g=g+128 NEWCOL=(Rand(16) LSH 4) % 10 color=g a=x-1 I5}F a>13 THEN a=0 FI Plot(x,a) DrawTo(x,y) FOR c=0 TO 15 DO Sound(0,0,4,15-c) pauz(400) OD color=0 Plot(x,0) D5}rawTo(x,y) SndRst() RETURN PROC dropkick(BYTE x,y) BYTE g,h,a,b g=Locate(x,y) IF g=32 THEN RETURN FI g==+1285} NEWCOL=152 b=y DO color=0 Plot(x,b) b==+1 color=g Plot(x,b) IF b=23 THEN EXIT FI Sound(0,b+15}0+(x LSH 1),10,8) Sound(1,b+20+(x LSH 1),10,8) pauz(400) OD SndRst() h=0 NEWCOL=159 a=x DO color=h Plot(a,b5}) h=Locate(a+1,b-1) a==+1 b==-1 color=g Plot(a,b) IF a=18 OR b=1 THEN EXIT FI Sound(0,a-x,8,(b R5}SH 1)) pauz(800) OD color=0 Plot(a,b) SndRst() RETURN PROC foo() BYTE v FOR v=0 TO 15 DO Sound(0,255,10,15}5-v) Sound(1,0,8,8-(v RSH 1)) pauz(500) OD SndRst() RETURN PROC intro() BYTE x Graphics(17) CURSC=$08 Pos5}ition(0,10) PrintD(6,"MORE FUN WITH") Position(0,12) PrintD(6,"B O U N C E !") Position(0,14) PrintD(6,"BY JOEL GLUCK") 5} pauz(65000) pauz(65000) pauz(65000) FOR x=0 TO 12 DO f16(12-x,10) OD FOR x=0 TO 12 DO colburst(x,12) OD FOR x=05} TO 12 DO dropkick(12-x,14) OD CURSC=$48 Position(14,1) PrintD(6,"ANALOG") foo() Position(11,3) PrintD(6,"COMPUTING5}") foo() Position(12,5) PrintD(6,"FEBRUARY") foo() Position(16,7) PrintD(6,"1985") foo() pauz(65000) pauz(65000) pa5}uz(65000) RETURN PROC drawdoc() BYTE CURS=752 CURS=1 PutE() Print("Use joystick and ") PrintE("SPACE to draw/era5}se.") Print("Hit B for balls, ") PrintE("0-9 for brush speed.") Print("ESC clrs balls; ") PrintE("ctrl-ESC clrs screen.")5} Print("Press START to Bounce!") RETURN PROC clearscrn() BYTE a,b,g FOR b=1 TO 19 DO FOR a=1 TO 78 DO g=lo5}cate5(a,b) IF (g=2 OR CH>28) AND g>1 THEN plot5(a,b,0) Sound(0,b,6,4) IF CH=28 THEN pauz(35}00) FI FI g=locate5(a,39-b) IF (g=2 OR CH>28) AND g>1 THEN plot5(a,39-b,0) Sound(0,b,6,4)5} IF CH=28 THEN pauz(300) FI FI OD Sound(0,0,0,0) OD IF CH>28 OR hidden=2 THEN hidden=05} FI RETURN PROC movecursor(BYTE bflag) BYTE g,STIK=632,TRIG=644,vol BYTE ARRAY v=[2 2 2 0 2 1 1 1 0 2 0 5} 0 0 1 1 1 1 2 1 0 1 1] INT cxd,cyd IF STIK<15 OR bflag=1 THEN cxd=v((STIK-5) LSH 1)-1 cyd=v(((STIK-5) LSH 1) % 15})-1 IF bflag=1 THEN cxd=2 FI g=hidden IF TRIG THEN vol=4 ELSE vol=10 g=cmode*3 FI So5}und(0,(xc+yc)*cmode, 8+(cmode LSH 1), vol-(cmode LSH 1)) plot5(xc,yc,g) xc==+cxd yc==+cyd IF xc5}<1 THEN xc=78 FI IF xc>78 THEN xc=1 FI IF yc<1 THEN yc=38 FI IF yc>38 THEN yc=1 FI 5} hidden=locate5(xc,yc) plot5(xc,yc,1) FI RETURN PROC audlayball() BYTE i,j,k FOR j=0 TO 2 DO FOR i=j*50 TO5} j*50+20 DO Sound(0,i,10,15-j*6) pauz(100) OD OD Sound(0,0,0,0) RETURN BYTE FUNC number() BYTE n,v v5}=CH Open(2,"K:",4,1) n=GetD(2) Close(2) CH=v IF n>47 AND n<58 THEN RETURN(57-n) ELSE RETURN(99) FI PROC aud5}cmode() BYTE n FOR n=1 TO 5 DO IF cmode THEN Sound(0,100-n*10,10,4) ELSE Sound(1,150-n*10,10,4) Soun5}d(0,5-n,8,6) FI pauz(2000) SndRst() pauz(1000) OD RETURN PROC cursor() BYTE n IF CH<>255 THEN IF CH5}=33 THEN cmode==XOR 1 audcmode() ELSEIF CH=28 OR CH=156 THEN clearscrn() ELSEIF CH=21 THEN hidden=25} plot5(xc,yc,2) movecursor(1) audlayball() ELSE n=number() IF n<99 THEN curspeed=n*500 5} FI FI CH=255 FI movecursor(0) RETURN PROC bouncedoc() CARD n PutE() n=num IF n=1 THEN PrintE("1 ball5} is bouncing.") ELSE PrintC(n) PrintE(" balls are bouncing.") FI PrintE("Hit digits 0-9 for speed.") Print("S chang5}es sound focus, ") PrintE("N nudges ball.") Print("Press SELECT to Draw again.") RETURN PROC process(BYTE a,b) BYTE 5}g g=locate5(a,b) IF g=2 THEN IF num<200 THEN xx(num)=a yy(num)=b num==+1 ELSE plot5(a,b,0) F5}I ELSEIF g=0 THEN plot5(a,b,1) FI RETURN PROC ballinit() BYTE a,b CURSC=$44 num=0 FOR b=1 TO 19 DO FOR a=5}1 TO 78 DO process(a,b) process(a,39-b) OD OD FOR a=0 TO num DO xd(a)=Rand(2) LSH 1 yd(a)=Rand(2) LSH 1 5} OD RETURN PROC moveball(BYTE n) BYTE g,pa,pb g=locate5(xx(n)+xd(n)-1,yy(n)+yd(n)-1) IF g<2 THEN plot5(xx(n),yy5}(n),0) xx(n)=xx(n)+xd(n)-1 yy(n)=yy(n)+yd(n)-1 plot5(xx(n),yy(n),2) IF n=audball THEN dist==+1 FI RETU5}RN ELSE pb=locate5(xx(n),yy(n)+yd(n)-1) pa=locate5(xx(n)+xd(n)-1,yy(n)) IF n=audball THEN IF dist THEN 5} Sound(0,170-((38-dist) LSH 2), 10,8) Sound(1,((38-dist) LSH 2), 10,8) FI dist=0 5} TIME=0 FI IF pa>1 THEN xd(n)=2-xd(n) IF pb>1 THEN yd(n)=2-yd(n) RETURN ELSE plo5}t5(xx(n),yy(n),0) yy(n)=yy(n)+yd(n)-1 plot5(xx(n),yy(n),2) RETURN FI ELSEIF pb>1 THEN yd(n)5}=2-yd(n) plot5(xx(n),yy(n),0) xx(n)=xx(n)+xd(n)-1 plot5(xx(n),yy(n),2) RETURN ELSEIF Rand(2) THEN 5} xd(n)=2-xd(n) ELSE yd(n)=2-yd(n) RETURN FI FI RETURN PROC cleanup() BYTE a,b FOR b=1 TO 19 DO 5}FOR a=1 TO 78 DO IF locate5(a,b)=1 THEN plot5(a,b,0) FI IF locate5(a,39-b)=1 THEN plot5(a,39-b,05}) FI OD OD RETURN PROC bounce() CARD i BYTE n ballinit() bouncedoc() audball=0 dist=0 IF num THEN 5}DO FOR i=0 TO num-1 DO moveball(i) IF CH<>255 THEN IF CH=62 THEN audball==+1 5} IF audball=num THEN audball=0 FI dist=0 ELSEIF CH=35 THEN xd(audball5})=2-xd(audball) ELSE n=number() IF n<99 THEN ballspeed=n*n*100 FI 5} FI CH=255 FI IF CONSOL=5 THEN EXIT FI OD pauz(ballspeed) IF TIME T5}HEN SndRst() FI UNTIL CONSOL=5 OD SndRst() FI cleanup() RETURN PROC MFWB() intro() gr5init5}() hline(0,3) hline(39,3) vline(0,3) vline(79,3) DO drawdoc() xc=39 yc=19 hidden=locate5(xc,yc) cmode=1 5} plot5(xc,yc,1) DO cursor() CURSC=TIME pauz(curspeed) Sound(0,0,0,0) pauz(curspeed) UNTIL C5}ONSOL=6 OD plot5(xc,yc,hidden) CH=255 bounce() OD RETURN otted ustainedP(( est Sharp Flat at4J;MIDAS MAZE. MODULE; CHECKSUM DATA;[61 4F 6D B9 C9 38 9B 37; 98 6A D4 94 37 3C E1 CC; 66 F4 71 86 25 4D C2 DA; C89} DD 8E 0C F2 7E 60 C4; B0 C6 A0 DB EB 75 E1 2E; CD BA 0D 76 60 2A 9B CE; AC ];Your car's shape table.; This holds the 49} direction ; positions and each of them has 3; animation shapes to themBYTE ARRAY P0=[ 16 186 186 40 56 186 186 0 16 56 9}186 40 56 186 56 0 16 186 56 40 56 56 186 0 0 186 186 56 40 186 186 16 0 56 186 56 40 186 56 16 0 186 56 56 40 56 186 169} 102 0 126 238 126 0 102 0 36 0 126 238 126 0 36 0 66 0 126 238 126 0 66 0 102 0 126 119 126 0 102 0 36 0 126 119 126 0 39}6 0 66 0 126 119 126 0 66 0 ],; 宛; Has the same as your car but; different shape style EP=[ 189 9}189 36 60 60 165 189 36 60 189 36 60 60 165 60 36 189 60 36 60 60 36 189 36 36 189 165 60 60 36 189 189 36 60 165 60 9}60 36 189 60 36 189 36 60 60 36 60 189 198 0 255 218 218 255 0 130 68 0 255 218 218 255 0 68 130 0 255 218 218 255 0 9}130 99 0 255 91 91 255 0 99 34 0 255 91 91 255 0 34 65 0 255 91 91 255 0 99],; ᮛ CHST=[ 0 0 3 15:} 15 3 0 0 0 0 0 192 192 0 0 0 15 48 192 192 192 48 15 0 192 48 12 12 12 48 192 0 48 48 204 204 204 48 48 0 255 0 0 :}0 0 0 255 0 204 204 204 204 204 48 48 0 48 48 204 204 204 204 204 204 204 204 204 204 204 204 204 204 192 192 192 192:} 192 192 192 192 12 12 12 12 12 12 12 12 0 0 0 0 0 0 255 0 255 0 0 0 0 0 0 0 192 192 192 192 192 48 15 0 12 12 12 :}12 12 48 192 0 192 48 12 12 12 12 12 12 15 48 192 192 192 192 192 192 0 51 0 63 51 63 0 51 0 0 0 85 0 0 0 0 0 0 0 8:}4 0 0 0 0 16 16 16 16 16 16 16 0 3 12 8 15 15 15 15 15 192 240 240 240 240 240 240 240 0 5 21 42 41 37 41 42 0 80 8:}4 168 104 88 104 168 0 0 63 63 63 0 0 0 0 0 240 245 240 0 0 0 0 107 106 106 106 106 106 0 0 253 253 253 189 189 173 0:} 10 42 1 1 1 1 1 1 128 144 0 0 0 0 0 0 0 48 204 205 204 48 0 0 0 0 0 84 16 0 0 0 0 0 0 0 0 0 0 0 51 15 12 60 252 :}255 60 15 48 252 48 252 63 63 60 240],; ؠ٠ for different; screen objects.; PRL=[ 3 1 :}18 1 3 23 18 23 0 11 3 11 0 13 3 13 9 4 18 4 9 11 15 11 12 7 15 7 18 7 21 7 9 13 15 13 12 15 15 15 40],; : } PUD=[ 3 1 3 11 3 13 3 23 6 3 6 11 6 13 6 21 9 6 9 11 15 7 15 11 18 7 18 11 9 13 9 21 12 15 12 21 18 13 18 15 18 : }17 18 21 15 17 15 21 40],; DOOR=[ 3 12 15 14 10 7 19 1 10 21 16 17 16 21 19 23 19 11],; Ӯ EN: }ER=[ 10 14 16 19 4 7 28 14 22 19 34 7], KEYS=[7 4 19 4 31 4 16 9 22 9 7 17 31 17 19 14], SPNA=[0 3 1 2],SCR,DLIST,T8M(1: }2), T3M(6),ST=632,PCOLR=704,HPOSP=53248, HPOSM=53252,SIZEP=53256,MPL=53256, AUDFC=53760,PARY,SH,SCOR(8),SC, STX(5),STY(5): },ODR(5),OSX(5),OSY(5), CSX(5),CSY(5),CDX(5),CDY(5),SAX(5), SAY(5),BRPO(5),DIR(5),DDU(5),DDD(5), DDL(5),DDR(5),EH(5),EDF(4):},PDF(5), SPT(5),SPIN(5),SPN(5),ECT(4)CARD ARRAY Y40(24),PAD(5)CARD CHSET,DL,CLP0,PMTEMP,M0,PL0,PL1,PL2,PL3,SHAD,GC,GG,POW:}ER=[0],DELAY,MBTBYTE P106,LP0,LP1,R,PLX,PLY,DRX,DRY,P0X,P0Y,P1X,P1Y,TALL,IC,S,S0,S1,PMTL,SP=[2],PMNO,DI,TS0,TS1,TS2,TS3,S:}TIK,DCD,DCD0BYTE DDM,PMM,TM,SP1,PO,LB,SP0,ST0,ST1, ST2,ST3,COL=[0],PT=[0],PD=[0],SSC, XTRA=[3],OSCOR=[0],ESC=[2],ELP,SES:}, MEM,INE=[0],THO=[1]; ӠŠBYTE RTCLOK=18,ATRACT=77,RAMTOP=106, SDMCTL=559,GRPRIOR=623,STRIG0=644,:} CHBAS=756,CH=764,PFCOLR2=53272, P0C=53260,GRACTL=53277,HITCLR=53278, CONSOL=53279,AUDCTL=53768, PMBASE=54279,WSYNC=54282,:} VCOUNT=54283; PROC PRSCOR() FOR SP0=0 TO 7 DO SCR(10+SP0)=SCOR(SP0)+16 ODRETURN; :}PROC SCLP() LB=8 FOR SP1=0 TO 7 DO LB==-1 PO=SCOR(LB) IF PO>9 THEN SCOR(LB)=SCOR(LB)-10 SCOR(LB-1)=SCOR(LB-1):}+1 FI ODRETURN; Ġ; 宛PROC SCORE(BYTE ADD) IF ADD>0 THEN ADD==-1 FOR:} SP0=0 TO ADD DO SCOR(7)=SCOR(7)+1 SCLP() ;up data score OD FI PRSCOR() ;Print it.RETURN; Ƞ:}PROC THOUS(BYTE TH) SCOR(4)==+TH SCLP() PRSCOR()RETURN; ĠPROC HUND(BYTE HD) SCOR(:}5)==+HD SCLP() PRSCOR()RETURN; ΠPROC PL(BYTE PX,PY) PLX=PX PLY=PY SCR(PLX+Y40(PLY))=IC; Access scre:}en.RETURN; ; PROC DR(BYTE DX,DY) DRX=DX DRY=DY ;Find out whic:}h is greater ; the plot or the drawto x position. IF PLX<>DRX THEN IF PLX>DRX THEN S0=DRX S1=PLX ELSE S0=PLX S1=D:}RX FI IF IC=70 THEN SCR(S0+Y40(DRY))=67 SCR(S1+Y40(DRY))=68 S0==+1 S1==-1 FI FOR S=S0 TO S1 DO SCR(S+Y40(:}DRY))=IC OD FI ;Find out the greater y position. IF PLY<>DRY THEN IF PLY>DRY THEN S0=DRY S1=PLY ELSE S0=PLY S1:}=DRY FI IF IC=73 THEN SCR(PLX+Y40(S0))=72 SCR(PLX+Y40(S1))=71 TS0=SCR(DRX+1+Y40(S0)) TS2=SCR(DRX-1+Y40(S0)) :} ;Check for intersecting line and ;add corners when needed. IF TS0=70 THEN SCR(DRX+Y40(S0))=80 FI IF TS2=70 :}THEN SCR(DRX+Y40(S0))=80 FI TS1=SCR(DRX+1+Y40(S1)) TS2=SCR(DRX-1+Y40(S1)) IF TS1= 70 THEN SCR(DRX+Y40(S1): })=78 FI IF TS2=70 THEN SCR(DRX+Y40(S1))=79 FI S0==+1 S1==-1 FI FOR S=S0 TO S1 DO SCR(DRX+Y40(S))=IC ;P:!}lot character OD ;on screen. FI ;Save drawto's values in plx and ; ply variable for next drawto. PLX=DR:"}X PLY=DRYRETURN;;Ϡ.PROC PMST(CARD PMADR,SHADR,D) ;Mak:#}e array pray point to the ;players ram area. PARY=PMADR TM=T3M(D) SHAD=SHADR DI=T8M(TM) ;Check to see if player is player:$} or ;missle shaps. IF PMADR>M0 THEN PMNO=((PMADR-PMTEMP-1024)) RSH 8 ELSE PMNO=4 FIRETURN;:%};Я͠;;.PROC PM_GO(BYTE PMX,PMY,FR) IF P:&}MNO<4 THEN HPOSP(PMNO)=PMX ELSEIF PMNO=4 THEN HPOSP(PMNO)=PMX+6 HPOSP(PMNO+1)=PMX+4 HPOSP(PMNO+2)=PMX+2 HPOSP(PMNO:'}+3)=PMX FI SH=SHAD+((T8M(FR))+DI) FOR TALL=0 TO SP DO PARY((PMY-SP)+TALL)=0 PARY((PMY+7)+TALL)=0 OD FOR TALL=0 TO 7 :(}DO PARY(PMY+TALL)=SH(TALL) ODRETURNPROC VARSET(BYTE VN) OSX(VN)=STX(VN) OSY(VN)=STY(VN) ODR(VN)=DIR(VN) CSX(VN)=STX:)}(VN)-48 CSY(VN)=STY(VN)-32 SAX(VN)=CSX(VN)&3 SAY(VN)=CSY(VN)&7 CDX(VN)=CSX(VN)/4 CDY(VN)=CSY(VN)/8RETURNPROC LOOK() :*}BYTE K0,K1,KP IF STX(4)>52 AND STX(4)<192 THEN DCD=SCR(CDX(4)+Y40(CDY(4))) DCD0=SCR(CDX(4)+1+Y40(CDY(4))) IF DCD=193 T:+}HEN SCR(CDX(4)+Y40(CDY(4)))=0 SCR(CDX(4)+1+Y40(CDY(4)))=0 GG==+1 ST0=10 SCORE(5) FI IF DCD=86+INE THEN FOR:,} LP0=0 TO 12 STEP 2 DO K0=ENER(LP0) K1=ENER(LP0+1) IF K0=CDX(4) AND K1=CDY(4) THEN IC=98 PL(CDX(4),CDY(4):-}) PL(CDX(4)+1,CDY(4)) FI OD KP=LP0 HUND((INE RSH 1)+1) POWER=100 ST3=60 PT=60 PD=5 FOR LP0=0 TO 3 DO ECT(:.}LP0)=80 OD FI IF DCD=96 THEN FOR LP0=0 TO 16 STEP 2 DO K0=KEYS(LP0) K1=KEYS(LP0+1) IF K0=CDX(4) AND K1=CDY(4) :/}THEN IC=98 PL(CDX(4),CDY(4)) PL(CDX(4)+1,CDY(4)) KP=LP0 HUND(1) ST2=20 FI OD IF KP<4 THEN:0} IC=98 PL(DOOR(KP),DOOR(KP+1)) PL(39-DOOR(KP),DOOR(KP+1)) ELSE IC=98 PL(DOOR(KP),DOOR(KP+1)) PL(DOOR(KP)+1:1},DOOR(KP+1)) PL(38-DOOR(KP),DOOR(KP+1)) PL(38-DOOR(KP)+1,DOOR(KP+1)) FI FI FI IF DCD=99 THEN IC=98 PL(CDX(4):2},CDY(4)) THOUS(THO) PL(CDX(4)+1,CDY(4)) ST2=30 FIRETURNPROC CHCH(BYTE CN) BYTE BPAS,BPAS2 IF SAY(CN)=0 AND SAX(CN)=:3}0 THEN DDU(CN)=0 DDD(CN)=0 DDL(CN)=0 DDR(CN)=0 DDM=0 EH(CN)=0 DCD=SCR(CDX(CN)+Y40(CDY(CN)-1)) DCD0=SCR(CDX(CN)+1+Y4:4}0(CDY(CN)-1)) IF DCD>66 AND DCD<86 OR DCD0>66 AND DCD0<86 THEN DDU(CN)=1 FI DCD=SCR(CDX(CN)+Y40(CDY(CN)+1)) DCD0:5}=SCR(CDX(CN)+1+Y40(CDY(CN)+1)) IF DCD>66 AND DCD<86 OR DCD0>66 AND DCD0<86 THEN DDD(CN)=1 FI DCD=SCR(CDX(CN)-1+Y4:6}0(CDY(CN))) IF DCD>66 AND DCD<86 THEN DDL(CN)=1 FI DCD=SCR(CDX(CN)+2+Y40(CDY(CN))) IF DCD>66 AND DCD<86 THEN DD:7}R(CN)=1 FI IF CN=4 THEN DCD=SCR(CDX(4)+Y40(CDY(4))) DCD0=SCR(CDX(4)+1+Y40(CDY(4))) IF DCD>0 AND DCD0>0 THEN DD:8}M=1 FI FI FI IF STX(CN)<30 THEN STX(CN)=220 FI IF STX(CN)>220 THEN STX(CN)=30 FI IF STX(CN)<56 OR STX(CN)>192 :9}THEN DDU(CN)=1 DDD(CN)=1 DDL(CN)=0 DDR(CN)=0 FI IF STY(CN)<48 OR STY(CN)>208 THEN DDL(CN)=1 DDR(CN)=1 FI IF DIR(CN::})=0 AND DDU(CN)=1 THEN DIR(CN)=ODR(CN) EH(CN)=1 FI IF DIR(CN)=1 AND DDD(CN)=1 THEN DIR(CN)=ODR(CN) EH(CN)=1 FI :;}IF DIR(CN)=2 AND DDL(CN)=1 THEN DIR(CN)=ODR(CN) EH(CN)=1 FI IF DIR(CN)=3 AND DDR(CN)=1 THEN DIR(CN)=ODR(CN) EH(CN)=:<}1 FI IF DIR(CN)=0 AND DDU(CN)=0 THEN STY(CN)==-SP FI IF DIR(CN)=1 AND DDD(CN)=0 THEN STY(CN)=STY(CN)+SP FI :=}IF DIR(CN)=2 AND DDL(CN)=0 THEN STX(CN)=STX(CN)-SP FI IF DIR(CN)=3 AND DDR(CN)=0 THEN STX(CN)=STX(CN)+SP FIRETURNP:>}ROC EMBR(BYTE EN) BYTE R,D,FL,D0,D1 FL=0 D=ODR(EN) D0=OSY(EN) D1=OSX(EN) VARSET(EN) IF SAX(EN)=0 AND SAY(EN)=0 THEN IF :?}POWER=0 AND STX(EN)>STX(4) AND STX(EN)STX(4)-48 THEN :@}DIR(EN)=3 ELSEIF STY(EN)>STX(4) AND STY(EN)STY(4)-48 T:A}HEN DIR(EN)=1 ELSE R=RAND(4) DIR(EN)=R FI DO IF D=0 AND DIR(EN)=1 THEN FL=1 ELSEIF D=1 AND DIR(EN)=0 THEN :B} FL=1 ELSEIF D=2 AND DIR(EN)=3 THEN FL=1 ELSEIF D=3 AND DIR(EN)=2 THEN FL=1 ELSE FL=0 FI IF FL=1 :C}THEN R=RAND(4) DIR(EN)=R FI UNTIL FL=0 OD IF STX(EN)=D1 AND STY(EN)=D0 THEN R=RAND(4) DIR(EN)=R FI FI CHC:D}H(EN)RETURNINCLUDE "D:MIDAS2.ACT"?????????????????????????????????????????????????????????????????to goto DOS. (Patrick8g; CHECKSUM DATA;[EC 61 1B 36 B8 1C C8 1E; 4C 34 CD 5E 3C 82 2A 56; DF 77 62 ED 61 C7 5A 14; 20 C1 6C 4F E9 2C D1 EB>F}; 6C 95 E1 84 AF 0B 1A 88; 3B EE ]PROC STICK(BYTE PN) VARSET(4) IF ST(0)<>15 THEN ATRACT=0 IF SAX(4)=0 THEN STIK>G}=ST(0) & 1 IF STIK = 0 THEN DIR(4)=0 FI STIK=ST(0) & 2 IF STIK=0 THEN DIR(4)=1 FI FI IF SAY(4)=0 T>H}HEN STIK=ST(0) & 8 IF STIK=0 THEN DIR(4)=3 FI STIK=ST(0) & 4 IF STIK=0 THEN DIR(4)=2 FI FI FI C>I}HCH(4) IF DDM=1 AND PN=4 THEN LOOK() FIRETURNPROC CHCOL() BYTE COP COL=0 FOR COP=0 TO 3 DO IF MPL(COP)>0 THEN CO>J}L=MPL(COP) FI OD HITCLR=0RETURNPROC GR4() GRAPHICS(0) DLIST=PEEKC(560) POKE(752,1) PRINT(" ") DLIST(3)=66 FOR LP0=6 >K}TO 28 DO DLIST(LP0)=4 OD FOR LP0=0 TO 40 DO Y40(LP0)=LP0*40 OD FOR LP0=0 TO 12 DO T8M(LP0)=LP0*8 OD FOR LP0=0 TO >L}4 DO T3M(LP0)=LP0*3 ODRETURNPROC CHSETUP() P106=PEEK(106)-12 CHSET=P106*256 RAMTOP=P106 GR4() CHBAS=P106 MOVEBLOCK(>M}CHSET,57344,1024) FOR CLP0=0 TO 288-1 DO POKE((CHSET+520)+CLP0,CHST(CLP0)) OD SCR=PEEKC(88)RETURNPROC PM_SET() SDMC>N}TL=62 GRPRIOR=1+16 GRACTL=3 FOR LP0=0 TO 3 DO SIZEP(LP0)=0 OD PMBASE=P106+4 PMTEMP=(P106+4)*256 M0=PMTEMP+768 PL0=M0+>O}256 PL1=PL0+256 PL2=PL1+256 PL3=PL2+256 PAD(0)=PL0 PAD(1)=PL1 PAD(2)=PL2 PAD(3)=PL3 PCOLR(0)=0*16+10 PCOLR(1)=12*16+5 P>P}COLR(2)=8*16+4 PCOLR(3)=4*16+4 ZERO(PMTEMP,2048)RETURNPROC PAUSE() POSITION(33,0) PRINT("PAUSED") FOR LP0=0TO 7 DO >Q}AUDFC(LP0)=0 OD CH=255 DO UNTIL CH<255 OD CH=255 POSITION(33,0) PRINT(" ")RETURNPROC MIRROR() BYTE SC FOR LP0>R}=0 TO 19 DO FOR LP1=0 TO 23 DO SC=SCR(LP0+Y40(LP1)) IF SC=78 OR SC=80 THEN SC==+1 ELSEIF SC=79 OR SC=81 THEN SC>S}==-1 FI IF SC=67 THEN SC==+1 ELSEIF SC=68 THEN SC==-1 FI IF SC=83 THEN SC==+1 ELSEIF SC=84 THEN SC==-1 F>T}I SCR((39-LP0)+Y40(LP1))=SC OD ODRETURNPROC BOARDS() IC=70 LP0=0 P0X=PRL(LP0) WHILE P0X<40 DO P0Y=PRL(LP0+1) >U}P1X=PRL(LP0+2) P1Y=PRL(LP0+3) PL(P0X,P0Y) DR(P1X,P1Y) LP0==+4 P0X=PRL(LP0) OD IC=73 LP0=0 P0X=PUD(LP0) WHILE P0X<40 DO>V} P0Y=PUD(LP0+1) P1X=PUD(LP0+2) P1Y=PUD(LP0+3) PL(P0X,P0Y) DR(P1X,P1Y) LP0==+4 P0X=PUD(LP0) OD IC=69 PL(12,9) IC=>W}98 FOR LP0=0 TO 2 DO PL(LP0,1) DR(LP0,10) PL(LP0,14) DR(LP0,23) OD PL(0,12) DR(2,12) PL(19,8) DR(19,10) PL(10,8>X}) PL(10,10) PL(12,14) IC=85 FOR LP0=0 TO 4 STEP 2 DO P0X=DOOR(LP0) P0Y=DOOR(LP0+1) PL(P0X,P0Y) OD IC=84 FOR LP0>Y}=4 TO 15 STEP 2 DO P0X=DOOR(LP0) P0Y=DOOR(LP0+1) IC=83 PL(P0X,P0Y) IC=84 PL(P0X+1,P0Y) OD MIRROR() FOR LP0=0 TO >Z}10 DO R=RAND(15) PCOLR(6)=R*16+8 FOR CLP0=0 TO 3500 DO OD OD FOR LP0=0 TO 11 STEP 2 DO P0X=ENER(LP0) P0Y=ENER(LP0+1>[}) IC=86+INE PL(P0X,P0Y) IC=87+INE PL(P0X+1,P0Y) OD FOR LP0=0 TO 15 STEP 2 DO P0X=KEYS(LP0) P0Y=KEYS(LP0+1) IC=96 PL>\}(P0X,P0Y) IC=97 PL(P0X+1,P0Y) OD FOR CLP0=40 TO 959 DO TS0=SCR(CLP0) TS1=SCR(CLP0+1) IF TS0=0 AND TS1=0 THEN SCR(C>]}LP0)=193 SCR(CLP0+1)=194 GC==+1 FI ODRETURNPROC TITLE() XTRA=3 OSCOR=0 SSC=5 COL=0 INE=0 FOR LP0=0 TO 7 DO HPOS>^}P(LP0)=0 OD DELAY=700 RAMTOP=MEM GRAPHICS(1) SETCOLOR(4,0,0) SETCOLOR(0,8,3) SETCOLOR(1,2,8) DLIST=PEEKC(560) DLIST(10>_})=7 DLIST(11)=7 POKE(752,1) SCR=PEEKC(88) PRSCOR() POSITION(5,5) PRINTD (6,"") POSITION(9,6) PRINTD(6,"") POS>`}ITION(2,14) PRINTDE(6," pressŠor") PRINTD(6," Ԡto") PUTE() PRINT(" by Ken Miller") SNDRST() DO>a} FOR LP0=0 TO 1 DO TS0=COL DO WSYNC=0 PFCOLR2=TS0 TS0==+1 UNTIL VCOUNT=128 OD OD COL==-1 UNTIL CONSOL=6 O>b}R STRIG0=0 OD COL=0 TS0=0 ZERO(SCOR,8) PRSCOR() CHSETUP() PM_SET() HITCLR=0RETURNPROC START() BYTE R DO SNDRST()>c} GC=0 GG=0 FOR LP0=0 TO 3 DO STX(LP0)=124 STY(LP0)=96 OD STX(4)=124 STY(4)=160 BRPO(1)=0 ZERO(SCR,959) BOARDS() >d} FOR LP0=0 TO XTRA-1 DO SCR(21+LP0)=82 OD ZERO(M0,1279) SETCOLOR(0,0,14) SETCOLOR(1,8,10) SETCOLOR(2,3,5) SETCOLOR>e}(3,2,8) SETCOLOR(4,0,0) DIR(4)=2 SP=2 FOR LP0=0 TO 4 DO SPIN(LP0)=0 EDF(LP0)=0 PDF(LP0)=0 SPT(LP0)=0 SPN(LP0)=0 >f} OD DO IF CH<255 THEN PAUSE() FI IF SCOR(3)>OSCOR THEN OSCOR=SCOR(3) XTRA==+1 SCR(21+(XTRA-1))=82 FI IF>g} SCOR(3)=0 THEN OSCOR=0 FI IF ST0>0 THEN AUDFC(0)=ST0 AUDFC(1)=32+1 ST0==-1 ELSE AUDFC(1)=0 FI IF ST2>0 T>h}HEN AUDFC(2)=10+ST2 AUDFC(3)=128+64+2 ST2==-1 ELSE AUDFC(3)=0 FI IF ST3>0 THEN AUDFC(4)=12+ST3 AUDFC>i}(5)=64+32+2 ST3==-1 ELSE AUDFC(5)=0 FI IF GC=GG THEN DELAY==-25 IF DELAY<10 OR DELAY>700 THEN DELAY=10 >j} FI INE==+2 IF INE>8 THEN INE=0 FI THO==+1 IF THO>5 THEN THO=1 FI START() FI IF GG=75 THEN IC>k}=99 PL(19,10) IC=100 PL(20,10) MBT=350 FI IF MBT>0 THEN MBT==-1 FI IF MBT=1 THEN IC=98 PL(19,10) PL(>l}20,10) FI CHCOL() IF PT=0 THEN ESC=2 FI IF COL>0 THEN IF COL=8 THEN COL=3 ELSE COL== RSH 1 FI >m} IF DIR(4)>1 THEN PDF(4)=1 ELSE PDF(4)=0 FI IF DIR(COL)>1 THEN PDF(COL)=1 ELSE PDF(COL)=0 FI IF>n} POWER>0 OR PT>0 THEN IF EDF(COL)=0 THEN EDF(COL)=80 IF EDF(COL)=80 THEN FOR ELP=1 TO ESC DO HUND(1>o}) OD ESC==+1 FI IF ESC>16 THEN ESC=8 FI FI ELSEIF PDF(4)=PDF(COL) AND EDF(COL)=0 THEN>p} ZERO(M0,1279) PMM=0 FOR LP0=0 TO 3 DO STX(LP0)=124 STY(LP0)=96 OD SNDRST() FOR CLP0=0 TO 500 D>q}O SPT(4)==+1 IF SPT(4)>SPN(4) RSH 3 THEN SPT(4)=0 SPN(4)==+6 IF SPN(4)>250 THEN SPN(4)=0 FI >r}SPIN(4)==+1 IF SPIN(4)>3 THEN SPIN(4)=0 FI FI PMST(M0,P0,SPIN(4)) PM_GO(STX(4),STY(4),PMM) AUD>s}FC(6)=SPIN(4) LSH 4 AUDFC(7)=2 FOR LP0=0 TO 200 DO OD OD AUDFC(6)=0 AUDFC(7)=0 SPT(4)=0 SPN(4)=0 Z>t}ERO(M0,255) DIR(4)=2 STX(4)=124 STY(4)=160 COL=0 PMST(M0,P0,DIR(4)) PM_GO(STX(4),STY(4),PMM) FOR CLP0=0 T>u}O 40000 DO OD SCR(21+(XTRA-1))=0 XTRA==-1 IF XTRA=0 THEN TITLE() START() FI FI FI COL=0 IF POWER>>v}0 THEN POWER==-1 FOR LP0=0 TO 3 DO PCOLR(LP0)=2*16+6 OD ELSEIF PT>0 THEN PT==-1 PD==-1 FOR LP0=0 TO 3 D>w}O PCOLR(LP0)=2*16+6 OD IF PD>200 THEN PD=5 PCOLR(0)=0*16+10 PCOLR(1)=12*16+5 PCOLR(2)=8*16+>x}4 PCOLR(3)=4*16+4 FI FI FOR LP0=0 TO 3 DO IF EDF(LP0)=0 THEN EMBR(LP0) PMST(PAD(LP0),EP,DIR(LP0>y})) PM_GO(STX(LP0),STY(LP0),PMM) ELSE EDF(LP0)==-1 SPT(LP0)==+1 IF EDF(LP0)>2 THEN IF SPT(LP0)>S>z}PN(LP0) THEN SPT(LP0)=0 SPN(LP0)==+1 IF SPN(LP0)>15 THEN SPN(LP0)=0 FI SPIN(LP0)==+1>{} IF SPIN(LP0)>3 THEN SPIN(LP0)=0 FI SES=SPNA(SPIN(LP0)) PMST(PAD(LP0),EP,SES) >|} PM_GO(STX(LP0),STY(LP0),PMM) AUDFC(4)=SPIN(LP0) AUDFC(5)=4 ELSEIF EDF(LP0)>2 AND EDF(LP0)<5 THEN>}} AUDFC(6)=0 AUDFC(7)=0 SPT(LP0)=0 SPN(LP0)=0 ZERO(PAD(LP0),255) DIR(LP0)=1 STX(LP0)=124 S>~}TY(LP0)=96 EMBR(LP0) PMST(PAD(LP0),EP,DIR(LP0)) PM_GO(STX(LP0),STY(LP0),PMM) EDF(LP0)=0 >} FI FI FI OD STICK(4) PMST(M0,P0,DIR(4)) PM_GO(STX(4),STY(4),PMM) PMM==+1 IF>} PMM>2 THEN PMM=0 FI FOR CLP0=0 TO DELAY DO OD UNTIL CONSOL=6 OD TITLE() ODRETURNPROC MAIN() ZERO(SCOR,8)>} MEM=RAMTOP TITLE() START()RETURNrrrrrrrrrrrrrr<4;puLse - joeL gLuck - anaLog 26 BYTE ARRAY X(192),Y(192),C(192) BYTE NUM=[10] INT ARRAY XD(192) CARD ARRAY LINEPT(192) B} PROC PAUZ(CARD N) CARD I FOR I=0 TO N+N DO OD RETURN PROC INTRO() BYTE I ,COLOR1=709 Graphics(0) PB}oke(710,0) Poke(752,1) Print(" ") PAUZ(30000) Position(17,9) Print("puLse") PAUZ(30000) POSITION(13,11) PRINT("by joeB}L gLuck") PAUZ(30000) Position(9,13) Print("from ANALOG COMPUTING") PAUZ(60000) FOR I=0 TO 15 DO COLOR1=15-I PAUZ(B}2000) OD RETURN PROC GR10INIT() CARD LINE,REG,COL,LUM,SCRN=88 BYTE ARRAY GTIACOL(8)=705 GRAPHICSB}(10) POKE(704,0) FOR REG=0 TO 7 DO COL=Rand(16) LUM=Rand(9)+4 GTIACOL(REG)=COL*16+LUM OD FOR LINE=0 B}TO 191 DO LINEPT(LINE)=SCRN+40*LINE OD RETURN PROC PLOT10(BYTE X,Y,COL) BYTE POINTER PIXEL BYTE ARRAY CB}OLFIL=[0 17 34 51 68 85 102 119 136 0 0 0 0 0 0 0], MASK=[15 240], MASK2=[240 15] PIXEL=LINEPT(YB})+(X RSH 1) PIXEL^=PIXEL^ & MASK(X & 1) % (COLFIL(COL) & MASK2(X & 1)) RETURN BYTE FUNC B}LOCATE10(BYTE X,Y) BYTE POINTER PIXEL BYTE ARRAY MASK= [240 15 ] PIXEL= LINEPT(Y)+(X RSH 1) RETURN((PIXEL^ & MASK(X & 1B})) RSH (((X & 1) XOR 1) LSH 2)) PROC DRAWLINE(BYTE A,B,C) BYTE I FOR I=A TO 79-A DO PLOT10(I,B,C) PLOB}T10(I,191-B,C) OD RETURN PROC INIT() BYTE I,J,S GR10INIT() FOR I=0 TO NUM-1 DO X(I)=RAND(40) DO YB}(I)=Rand(96) S=0 IF I=0 THEN EXIT FI FOR J=0 TO I-1 DO IF Y(I)=Y(J) THEN S=1 EXB}IT FI OD UNTIL S=0 OD C(I)=(I MOD 8)+1 DRAWLINE(X(I),Y(I),C(I)) XD(I)=(RAND(2)*2-1)*(Rand(3)+1) OD B} RETURN PROC SQUEEZE(BYTE N) BYTE A,I INT D D=XD(N) IF D<0 THEN D=-1 ELSE D=1 FI FOR I=1 TO (XD(N)/D) B}DO A=X(N)+D IF A>39 THEN XD(N)=-XD(N) EXIT FI IF D>0 THEN PLOT10(X(N),Y(N),0) PLOT10(79-X(N),Y(N),0) B} PLOT10(X(N),191-Y(N),0) PLOT10(79-X(N),191-Y(N),0) ELSE PLOT10(X(N),Y(N),C(N)) PLOT10(79-X(N),Y(N),C(N)) PLOT10B}(X(N),191-Y(N),C(N)) PLOT10(79-X(N),191-Y(N),C(N)) FI X(N)=A PLOT10(X(N),Y(N),C(N)) PLOT10(79-X(N),Y(N),C(N)) PLOT1B}0(X(N),191-Y(N),C(N)) PLOT10(79-X(N),191-Y(N),C(N)) OD RETURN PROC PULSE() BYTE I,CH=764,AT=77,MS=19,LS=20 B}INTRO() DO NUM=Rand(6)+5 INIT() CH=255 AT=77 LS=0 MS=0 DO FOR I=0 TO NUM-1 DO SQUEEZE(I) OD UNTILB} CH<>255 OR MS=4 OD UNTIL CH=12 OD CH=255 GRAPHICS(0) RETURN @VInstructions for: RELGEN.ACT:== Relocation Generator & REOCAT.ACT:== Run-time Relocator These programs were intended toF} create a self-relocating object file from either an ACTION! compiled program or an Assembled program. The original object fiF}le must be a single-stage boot with only one origin except for the trailing run or init address. The following instructions dF}etail the steps to make the target object file. This file may be appended to other binary load files and may have other binarF}y files appended to it. The program will load at the next possible page boundary (increment of 256) after MEMLO. Because RELGF}EN compares two versions of you object file, you may want to init all variables to zero to keep the relocation table at a minF}imum. Stray data in the uninitialized variables may be interpreted as machine code that needs relocating. 1) Compile (or AssF}emble) your code at a convenient area but not conflicting with DOS. In ACTION!, use the following commands to force tF}he program's origin to a specified value ($3000 for example): SET 14=$3000 SET $491=$3000 2) Re-Compile your code F}at $100 higher than the first. For the above example, this would be at $3100. 3) From the ACTION! monitor, RUN the proF}gram RELGEN.ACT. It will prompt you for the filenames for the two object code files that you compiled above. Remember to giveF} the Dn: prefix to the filenames. The program will compare the two object files and note their differences as offsets into thF}e file. This information is saved in ACTION! form in a file with the original name and a ".GEN" extention. This will be used F}in the next step. Also, the program creates an object file image of the original but with an origin of zero. This is done to F}make the relocation process easier and this file, with a ".REL" extention will be used in step 5. Note: RELGEN.ACT requireF}s four open DOS files simultaneously. By default, DOS usually has buffers for only 3. You must use the command: SET $709=4F} in the ACTION! monitor and type D for DOS. Rewrite DOS to the disk and reboot. Now, DOS will allow the four files to be opeF}ned. 4) Now, Read the program RELOC.ACT into the ACTION! Editor. This is a "generic" run-time relocator. The file generated F}with the RELGEN.ACT program (with the ".GEN" extention) must be merged into this program with the editor Read function. PositF}ion the cursor where instructed and read in the file. Compile this code but be sure that it is SET to compile above the expecF}ted end of YOUR program's target location. Save this object code to disk and go to DOS. 5) Using the DOS Copy command, appenF}d the ".REL" file generated in RELGEN.ACT, to the merged relocator file saved in step 4. For example: C Copy from,to: TEST.RF}EL,AUTORUN.SYS/A This assumes that you saved the file in Step 4 as AUTORUN.SYS. 6) Finally, the appended file can be loadedF} from DOS or named AUTORUN.SYS as above for permanent applications. If you have question, send E-Mail to: John DeMar 71066F},337 on Compuserve or leave a message on the ACE-BASE BBS at (315)451-7747. Good Luck! F}D[MODULE ;RELOCATE.ACT ;Run-time Relocator Code. ;For use with RELGEN.ACT ;COPYRIGHT 1984, JS DeMar ;Rev. 1.1, March 20,1J}984 ;--------------------------------- SET 14=$6000 SET $0491=$6000 ;--------------------------------- ;The beginning J}of the relocator ;table and code should be higher ;than the expected end of the final ;relocated program. But, there must J} ;be enough space left for the table ;and the relocator code itself! ;--------------------------------- ;-------------J}-------------------- ;Read the ".GEN" file above here. ;--------------------------------- ;Compile this after reading in tJ}he ;".GEN" file above. Then append the ;".REL" file to this code using the ;DOS COPY command with "/A". ;----------------J}----------------- PROC Error(BYTE err)[$6C$A] PROC Break=*() [$BA$8E$4C1$80A0$98$4C Error] PROC ChkErr=*(BYTE r,b,eJ}C)[$1610$88C0$8F0 $98$80C0$11F0 $4C Error$8A$4A4A$4A4A$98AA$9D EOF$60] PROC Break1=*(BYTE err) [$1A2$1186$48$20 Break$6J}8$A8$60] CHAR FUNC GetD=*(BYTE d)[$7A2] PROC CCIO=*() [$A486$A0A$A0A$AA$A4A5$9D$342$A9$0$9D$348$9D$349 $98$20$E456$A085J}$4C ChkErr] ;--------------------------------- PROC BootIt=*() ;--------------------------------- PROC Relocate() J} BYTE offset,memlohi=$02E8,x CARD memlo=$02E7,i,j,top,entry BYTE ARRAY newplace newplace=memlo newplace==&$FF00 offseJ}t=memlohi i=memlo&$00FF IF i#0 THEN newplace==+$0100 offset==+1 FI FOR i=1 TO 6 DO x=GetD(1) OD j=0 FOR iJ}=start TO finish+7 DO x=GetD(1) newplace(j)=x j==+1 OD FOR i=0 TO hits-1 DO entry=otable(i) newplace(enJ}try)==+offset OD runaddr==+newplace [$6C runaddr] H6MODULE ;RELOCATE.ACT ;Run-time Relocator Code. ;For use with RELGEN.ACT ;COPYRIGHT 1984, JS DeMar ;Rev. 1.1, March 20,1N}984 ;--------------------------------- SET 14=$6000 SET $0491=$6000 ;--------------------------------- ;The beginning N}of the relocator ;table and code should be higher ;than the expected end of the final ;relocated program. But, there must N} ;be enough space left for the table ;and the relocator code itself! ;--------------------------------- ;-------------N}-------------------- ;Read the ".GEN" file above here. ;--------------------------------- ;Compile this after reading in tN}he ;".GEN" file above. Then append the ;".REL" file to this code using the ;DOS COPY command with "/A". ;----------------N}----------------- PROC Error(BYTE err)[$6C$A] PROC ChkErr=*(BYTE r,b,eC)[$1610$88C0$8F0 $98$80C0$11F0 $4C Error$8A$4AN}4A$4A4A$98AA$9D EOF$60] CHAR FUNC GetD=*(BYTE d)[$7A2] PROC CCIO=*() [$A486$A0A$A0A$AA$A4A5$9D$342$A9$0$9D$348$9D$349 $N}98$20$E456$A085$4C ChkErr] ;--------------------------------- PROC BootIt=*() ;--------------------------------- PRN}OC Relocate() BYTE offset,memlohi=$02E8,x CARD memlo=$02E7,i,j,top,entry BYTE ARRAY newplace newplace=memlo newplaceN}==&$FF00 offset=memlohi i=memlo&$00FF IF i#0 THEN newplace==+$0100 offset==+1 FI FOR i=1 TO 6 DO x=GetD(1) ON}D j=0 FOR i=start TO finish+7 DO x=GetD(1) newplace(j)=x j==+1 OD FOR i=0 TO hits-1 DO entry=otable(i) N} newplace(entry)==+offset OD runaddr==+newplace [$6C runaddr] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%N}%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%L'