; ; PILOT PROGRAM EQUATE FILE ; ; EDIT #99 -- 07-JUN-83 ; DEBUG = 0 ; INCLUDE DEBUG CODE IF 1, DON'T IF 0. LITPEN = 0 ; INCLUDE LIGHTPEN CODE IF 1, DON'T IF 0. LOGGRP = 0 ; INCLUDE LOGICAL OPERATORS IF 1, DON'T IF 0. DOS = 0 ; INCLUDE 'DOS' COMMAND IF 1, DON'T IF 0. FALSE = 0 ; COLLEEN SYSTEM I/O CIO = $E456 IOVBAS = $E400 ; COLLEEN VECTOR BASE ADDRESS. EPUTC = $E406 ; "E:" PUT CHARACTER. SGETC = $E414 ; "S:" GET CHARACTER. SPUTC = $E416 ; "S:" PUT CHARACTER. SSPEC = $E41A ; "S:" SPECIAL. KGETC = $E424 ; "E:" GET CHARACTER. IOCBSZ = 16 ; # OF BYTES PER IOCB. IOCB0 = $00 ; CONSOLE INPUT/OUTPUT. IOCB1 = IOCB0+IOCBSZ ; (UNUSED). IOCB2 = IOCB1+IOCBSZ ; GRAPHICS INPUT & OUTPUT. IOCB3 = IOCB2+IOCBSZ ; LOAD & SAVE I/O. IOCB4 = IOCB3+IOCBSZ ; IN: & OUT: USE IOCB4 THRU IOCB7. IOCB7 = 3*IOCBSZ+IOCB4 ICHID = $0340 ; IOCB HANDLER I.D. ICDNO = ICHID+1 ; DEVICE #. ICCOM = ICDNO+1 ; COMMAND BYTE. ICSTA = ICCOM+1 ; STATUS BYTE. ICBAL = ICSTA+1 ; BUFFER ADDRESS (LO). ICBAH = ICBAL+1 ; BUFFER ADDRESS (HI). ICRLL = ICBAH+1 ; RECORD LENGTH (LO). ICRLH = ICRLL+1 ; RECORD LENGTH (HI). ICBLL = ICRLH+1 ; BUFFER LENGTH (LO). ICBLH = ICBLL+1 ; BUFFER LENGTH (HI). ICAUX1 = ICBLH+1 ; AUX1. ICAUX2 = ICAUX1+1 ; AUX2. ICCOMZ = $0022 ; ZERO PAGE IOCB COMMAND BYTE. OPEN = $03 ; OPEN COMMAND. CLOSE = $0C ; CLOSE COMMAND. GETC = $07 ; GET CHARACTER COMMAND. PUTC = $0B ; PUT CHARACTER COMMAND. GETR = $05 ; GET RECORD COMMAND. PUTR = $09 ; PUT RECORD COMMAND. OREAD = $04 ; OPEN DIRECTION. OWRIT = $08 ; OPEN DIRECTION. SPLIT = $10 ; SPLIT SCREEN NOCLR = $20 ; INHIBIT SCREEN CLEAR OPTION. CR = $0D ; INTERNAL CODE CUP = $1C ; CURSOR UP. CDOWN = $1D ; CURSOR DOWN. CLEFT = $1E ; CURSOR LEFT. CRIGHT = $1F ; CURSOR RIGHT. EOL = $9B ; ATASCII END OF LINE. CLEAR = $7D ; MONITOR CLEAR SCREEN. BELL = $FD ; BELL CODE. BSLASH = $5C ; BACKSL SLASH VBAR = $7C ; VERTICAL BAR SBRACK = $5B ; SQUARE BRACKET SQUOTE = $27 ; SINGLE QUOTE TAB = $7F ; TAB. ; O.S. ROM VECTORS XITVBV = $E462 ; EXIT VBLANK VECTOR. SETVBV = $E45C ; SET VECTOR ROUTINE. ; O.S. DATA BASE COLDST = $0244 ; SYSTEM COLDSTART FLAG. DOSINI = $000C RAMTOP = $006A ; TOP OF SCREEN ADDRESS (MSB). COLRSH = $004F ; ATTRACT HUE SHIFT. DRKMSK = $004E ; ATTRACT LUM LIMIT. MEMLO = $02E7 ; LOWEST AVAILABLE RAM [WORD]. MEMHI = $02E5 ; HIGHEST AVAILABLE PAM [WORD]. APPMHI = $000E ; APPLICATION MEM HI [WORD]. BREAK = $0011 ; BREAK KEY FLAG. CH = $02FC ; KEYBOARD MATRIX CODE INPUT. CRSINH = $02F0 ; CURSOR INHIBIT FLAG. DSPFLG = $02FE ; CONTROL BYTE DISPLAY FLAG. SDLSTL = $0230 ; DISPLAY LIST ADDRESS. SSKCTL = $0232 RTCLOK = $0012 ; 60 HZ CLOCK. LMARGN = $0052 ; SCREEN LEFT MARGIN. RMARGN = $0053 ; SCREEN RIGHT MARGIN. COLCRS = $0055 ; SCREEN COLUMN [WORD) ROWCRS = $0054 ; SCREEN ROW [BYTE) DINDEX = $0057 ; S: SCREEN MODE. SAVMSC = $0058 ; SCREEN START ADDR. BOTSCR = $02BF ; TEXT SCREEN SIZE. WARMST = $0008 ; WARMSTART FLAG (0 IF POWERUP). DOSVEC = $000A ; DOS START VECTOR. FINE = $026E ; SCROLL SELECT. GPRIOR = $026F ; PLAYER/PLAYFIELD PRIORITY. DMACT = $022F ; DMA CONTROL BYTE. PCOLR0 = $02C0 ; PLAYER/MISSILE COLOR. COLOR0 = $02C4 ; COLOR REGISTER 0 VALUE. PADDL0 = $0270 ; PADDLE CONTROLLER 0. STICK0 = $0278 ; JOYSTICK 0. PTRIG0 = $027C ; PADDLE TRIGGER 0. STRIG0 = $0284 ; JOYSTICK TRIGGER 0. LPENH = $0234 ; LIGHTPEN HORIZONTAL POSITION. LPENV = $0235 ; LIGHTPEN VERTICAL POSITION. TXTCOL = $0291 ; SPLIT SCREEN TEXT COLUMN. TXTROW = $0290 ; SPLIT SCREEN TEXT ROW. INVFLG = $02B6 ; INVERSE VIDEO FLAG FOR KEYBOARD. VDSLST = $0200 ; DISPLAY LIST INTERPRUPT. CDTMV5 = $0220 ; SYSTEM TIMER VALUE. VVBLKD = $0224 ; DEFERRED VBLANK ROUTINE. SSFLAG = $02FF ; START/STOP FLAG. ; PILOT ERROR CODES NS = $80 ; "NOT A SYNTAX ERROR" FLAG. RDYTXT = 1 ; READY. EOPERR = 1+NS ; END OF PROGRAM STORAGE REACHED DURING RUN. AUTOXT = 1+NS ; EXIT AUTO-INPUT MODE. CNDERR = 2 ; CONDITION FIELD ERROR (':' EXPECTED). NSTERR = 2 ; GRAPHICS SUB-COMMAND NESTING ERROR. ENDERR = 1+NS ; USE STACK EMPTY ON END COMMAND. JNKERR = 2 ; JUNK AT END OF STATEMENT. IOERR = 6+NS ; I/O ERROR. IVCERR = 2 ; INVALID COMMAND. ATMERR = 2 ; INVALID ATOM SYNTAX. IMPERR = 2 ; IMPROPER COMMAND PARAMETER. INSERR = 9+NS ; INSUFFICIENT STORAGE FOR OPERATION. ABTERR = 7+NS ; OPERATOR ABORT. UNDERR = 10 ; UNDEFINED LABEL OPERAND. USOERR = 11+NS ; USE STACK OVERFLOW. EXPERR = 2 ; EXPRESSION ERROR. INTERR = 12+NS ; INTERNAL BUG ERROR. LNOERR = 13+NS ; LINE # OUT OF RANGE. ; 14 IS RESERVED. OLLERR = 15 ; OVERLENGTH INPUT LINE. ; 16-21 ARE RESERVED. FILERR = 22+NS ; TOO MANY IN/OUTS. SIGNON = 23 ; POWEP-UP SIGN-ON MESSAGE. TRCMES = 24 ; TRACE PREAMBLE. ASTMES = 8 ; ASTERISKS. NRCERR = 3+NS ; NOT CORRECT COMMAND MODE. DIVERR = 4+NS ; DIVIDE BY ZERO. SCNERR = 5+NS ; SCREEN MODE CONFLICT. CNTERR = 25+NS ; CAN'T CONTINUE. STPMES = 26+NS ; STOP. RENERR = 27+NS ; CAN'T RENUMBER OVLPER = 28+NS ; OVERLAPPING RANGE. TOMES = 29+NS ; " TO ". NCHGMS = 30+NS ; PROGRAM IS UNCHANGED. DELMES = 31+NS ; "YOU ARE ABOUT TO DELETE ". DL2MES = DELMES+1 ; LINES.ARE YOU SURE?". SPTERR = 33 ; NO SPLIT SCREEN. MODERR = 34 ; INVALID GRAPHICS MODE. FSOFER = 36+NS ; FLOOD STACK OVERFLOW. NMCERR = 37 ; NO MORE COLORS. DCAERR = 38 ; DOUBLE COLOR ASSIGN. ; ATOM IDENTIFIER CODES (PRODUCED BY 'ATOM') NULL = 1 ; NULL ATOM. NUM = 2 ; NUMERIC CONSTANT. NVAR = 4 ; NUMERIC VARIABLE OR POINTER TO WORD. SVAR = 8 ; STRING VARIABLE. USVAR = 16 ; UNDEFINED STRING VARIABLE. TEXT = 32 ; TEXT. OPR = 64 ; OPERATOR. BPTR = 128 ; POINTER TO BYTE. ; GRAPHICS OPERATORS FILL = $11 FILLTO = $12 DRAW = $09 DRAWTO = $0A GO = $05 GOTO = $06 ; EDGE DETECT STATUS BITS ELEFT = 8 ; LEFT EDGE. ERIGHT = 4 ; RIGHT EDGE. EBOTOM = 2 ; BOTTOM EDGE. ETOP = 1 ; TOP EDGE. ; PILOT CONFIGURATION PARAMETERS. USTKSZ = 48 ; 24 LEVELS IN USE STACK. ELEVEL = 2 ; # OF EXPRESSION STACK () LEVELS. ESTKSZ = 4*ELEVEL+6 ; EXPRESSION STACK SIZE. ACCLNG = 254 ; ACCEPT BUFFER LENGTH. TEXLNG = 254 ; TEXT EXPRESSION BUFFER LENGTH. LINLNG = 122 ; COMMAND/ACCEPT INPUT LINE LENGTH. MAXLN = 9999 ; MAXIMUM PROGRAM LINE NUMBER. AUREGS = 4 ; 4 AUDIO REGISTERS. SCNMOD = 7 ; 4 COLOR, 160 * 96. DNSIZE = 15 ; DEVICE/FILENAME MAXIMUM LENGTH. TCOL = 40 ; TEXT SCREEN # OF COLUMNS. TROW = 24 ; TEXT SCREEN # OF ROWS. INBFSZ = 10 ; MAXIMUM SUBCOMMAND LENGTH. ; HARDWARE EQUATES AUDF1 = $D200 ; AUDIO #1 FREQUENCY DIVIDER. AUDC1 = AUDF1+1 ; AUDIO #1 TYPE/VOLUME. SKCTL = $D20F ; SERIAL PORT CONTROL. SKSTAT = $D20F ; SERIAL PORT STATUS. AUDCTL = $D208 ; AUDIO CONTROL REGISTER. PACTL = $D302 ; PIA CASSETTE CONTROL. CASSON = $34 ; CASSETTE ON. CASSOF = $3C ; CASSETTE OFF. PKYRND = $D20A ; POKEY RANDOM NUMBER. CONSOL = $D01F ; START/SELECT/OPTION KEY READ. DMACTL = $D400 ; DMA CONTROL REG. PMBASE = $D407 ; PLAYER/MISSILE BASE ADDRESS REGISTER. GRAFP3 = $D010 ; PLAYER 3 DATA. GRACTL = $D01D ; GRAPHICS CONTROL REG. SIZEP3 = $D00B ; PLAYER 3 SIZE. HPOS0 = $D000 ; PLAYER POSITIONS. COLPF1 = $D017 ; PLAYFIELD 1 COLOR. COLPF2 = $D018 ; PLAYFIELD 2 COLOR. WSYNC = $D40A ; WAIT FOR SYNC. NMIEN = $D40E ; NMI ENABLE. ; COLOR EQUATES CRED = $42 CBLUE = $84 CYELLO = $1A CBLACK = $01 ; MISCELLANEOUS PCUP = 128 ; PEN = 'UP'. PCDN = 64 ; PEN = 'DOWN'. LSMLL = 0 ; LETTERS = 'SMALL'. LMED = 1 ; LETTERS = 'MEDIUM'. LLRG = 2 ; LETTERS = 'LARGE'. EWRAP = 1 ; EDGE = 'WRAP'. EHALT = 2 ; EDGE = 'HALT'. EBNC = 4 ; EDGE = 'BOUNCE'. EFREE = 8 ; EDGE = 'FREE'. ; ALGORITHMS REQUIRE KOFF=0, KON=1. KOFF = 0 ; 'OFF'. KON = 1 ; 'ON'. EONMLS = $FFFF ; END OF 'NMSBUF' LIST. UC = $DF ; LOWER -> UPPER CASE. LC = $20 ; UPPER -> LOWER CASE. UP = $FF ; FLOOD DIRECTIONS. DOWN = 1 STRTKY = 1 ; CONSOLE KEY DEFS. SELKEY = 2 OPTKEY = 4 ANYKEY = STRTKY+SELKEY+OPTKEY TXSL = 1 ; SCREEN MODE = TEXT, SMALL LETTERS. TXML = 2 ; SCREEN MODE = TEXT, MEDIUM OR LARGE LETTERS. GRSS = 4 ; SCREEN MODE = GRAPHICS, SPLIT. GRFS = 8 ; SCREEN MODE = GRAPHICS, FULL. ; 'NAME' TYPES. ATRSTR = $80 ; 'STRING' VARIABLE. ATRNUM = $40 ; 'NUMERIC' VARIABLE. ATRIO = $20 ; 'I/O' DEVICE. ATRLIN = 0 ; STATEMENT 'LINE'. ; RESERVED COMMAND 'TOKENS' AND 'USRTAB' SIZE. TKNCNT = $FE ; COMMAND CONTINUATION. TKNNUL = $FF ; NULL COMMAND. ; ROBOT TURTLE DRIVER COMMANDS. RBOFF = 0 ; 'ROBOT OFF'. RBON = $20 ; 'ROBOT ON'. RBEYES = 1 ; 'EYES'. RBPEN = 2 ; 'RPEN'. RBHORN = 3 ; 'HORN'. RBFWD = $80 ; 'GO +'. RBBACK = $81 ; 'GO -'. RBLEFT = $40 ; 'TURN +'. RBRGHT = $41 ; 'TURN -'. ; LOAD TYPES. KLOAD = 1 KMERGE = 2 KAPPND = 3 ; ; PILOT DATA BASE. ; ORG $0080 DTAB = * ; BASE ADDRESS FOR DXXXI UTILITIES & OTHERS. INLN .DS 4 ; INPUT LINE POINTER. NXTLN .DS 2 ; NEXT LINE POINTER (RUN MODE). ACOLR2 .DS 1 ; AUTO-NUMBER COLOR REGISTER 2. ACOLR1 .DS 1 ; AUTO-NUMBER COLOR REGISTER 1. ACLN .DS 4 ; ACCEPT LINE POINTER. TELN .DS 4 ; TEXT EXPRESSION RESULT POINTEP. TABADR TBLBAS .DS 2 ; COMMAND TABLE POINTER. EXEC .DS 1 ; 0 = SYNTAX CHECK, ELSE EXECUTE (FOR X-ROUTINES). EXPSTK .DS ESTKSZ ; EXPRESSION STACK. TEMP .DS 6 ; TEMPORARY STORAGE FOR BOTTOM LEVEL ROUTINES. TEMP2 .DS 4 ; MORE TEMPORARY STORAGE. XTEMP .DS 3 ; TEMPORARY STORAGE FOR X-ROUTINES. S1L .DS 2 ; DYNAMIC STORAGE AREA LIMITS. S1H .DS 2 S2L .DS 2 S2H .DS 2 POINT .DS 2 ; 'ATOM' RETURN PARAMETER & 'PSF' WORK POINTER. NUMBER .DS 2 ; 'ATOM' RETURN PARAMETER & 'PSTOP' ERROR # SAVE. LP .DS 4 ; STRING PACKAGE LIST POINTER. NP .DS 4 ; NAME POINTER. DP .DS 4 ; DATA POINTER. MP .DS 4 ; PATTERN MATCH POINTER. SP .DS 4 ; SOURCE POINTER (BOTTOM LEVEL). PP .DS 4 ; PATTERN POINTER (BOTTOM LEVEL). MEMA .DS 2 ; MEMORY MANAGEMENT ADDRESS PARAMETER. MEMB .DS 2 ; BYTE COUNT PARAMETER. MSP .DS 2 ; SOURCE POINTER. MDP .DS 2 ; DESTINATION POINTER. MBC .DS 2 ; WORKING BYTE COUNT. LINENO .DS 2 ; STATEMENT LINE # (MUST BE IN ZERO PAGE). LS .DS 2 ; 'XLIST' START LINE #, 'XGRAPH' ITERATION COUNT & 'SCNDEV '. LEND .DS 2 ; 'XLIST' END LINE 'GMOVE' REGISTER SAVE & 'SCNDEV'. MFDEL ; MATCH FIELD DELIMITER (',' OR '|'. ACC .DS 2 ; WORKING NUMERIC ACCUMULATOR. IOSTAT .DS 2 ; COLLEEN I/O ERROR STATUS [WORD]. GXNEW .DS 3 ; GRAPHICS NEXT POSITION (LSB,MSB,FRACTION). GYNEW .DS 3 ; GX .DS 3 ; GRAPHICS X POSITION (LSB,MSB,FRACTION). GY .DS 3 ; GRAPHICS Y POSITION (LSB,MSB,FRACTION). THETA .DS 2 ; POLAR ANGLE. FSTACK .DS 2 ; FLOOD STACK POINTER, & 'SETCLR' TEMP. ADRESS .DS 2 ; FLOOD SCREEN POINTER 'SSAVE', 'SLOAD' & 'NEWDRW' TEMP. TRADDR .DS 2 ; TURTLE REP. ADDRESS FOR VBLANK PROCESS. ALINE .DS 2 ; AUTO-INPUT & RENUMBER LINE NUMBER & TEMP. AINC .DS 2 ; AUTO-INPUT & RENUMBER LINE INCREMENT. MATCHF .DS 1 ; MATCH RESULT (0 = FALSE, ELSE MATCH FIELD #). RUN .DS 1 ; 0 = IMMEDIATE MODE, ELSE RUN MODE. ; REDEFINES OF VARIABLES FOR GRAPHICS USE GX1 = NP ; END X [3 BYTES]. GY1 = GX1+3 ; END Y [3 BYTES]. GX2 = GY1+3 ; START X [3 BYTES]. GY2 = GX2+3 ; START Y [3 BYTES]. DELX = GY2+3 ; DELTA X [2 BYTES]. DELY = DELX+2 ; Y [2 BYTES]. GACC = DELY+2 ; WORKING ACCUMULATOR [4 BYTES]. GTEMP = GACC+4 ; TEMP [4 BYTES). GTEMP2 = GTEMP+4 ; TEMP [4 BYTES]. DELTAR = EXPSTK ; DRAW DELTA Y[2]. DELTAC = DELTAR+2 ; DRAW DELTA X[2]. ROWINC = DELTAC+2 ; FILL Y INC. [1]. ROWAC = ROWINC+1 ; DRAW Y ACC. [2]. COLAC = ROWAC+2 ; DRAW X ACC. [2]. COUNTR = COLAC+2 ; DRAW COUNTER [2]. ENDPT = COUNTR+2 ; DRAW E [2]. ; REDEFINES OF 'EXPSTK' FOR EDIT COMMANDS. BLOW = EXPSTK ; LOW BRACKET ADDRESS. BHIGH = EXPSTK+2 ; HIGH. BNUM = EXPSTK+4 ; # OF LINES IN RANGE. RTMP = EXPSTK+6 ; RENUMBER TEMP. R2TMP = EXPSTK+8 ; ". ORG $0500 USRTAB .WORD 0 ; USER EXTENDABLE COMMAND TABLE. ; (MSBYTE = 0 IF UNUSED). RBVECT .WORD 0 ; ADDRESS OF ROBOT TURTLE DRIVER. ; (MSBYTE = 0 IF UNUSED). IOEDIS .DS 2 ; I/O ERROR STOP DISABLE. ; EXTRA BYTE TO PROTECT AGAINST WORD POKE. EXECF .DS 1 ; CONDITION RESULT (0 = NO EXECUTE, ELSE EXECUTE). XJUMP .DS 3 ; FIRST BYTE = JMP COMMAND (X-ROUTINES). GJUMP .DS 3 ; FIRST BYTE = JMP COMMAND (G-ROUTINES). SJUMP .DS 3 ; FIRST BYTE = JMP COMMAND ('SOP'). CTABAT .DS 1 ; 'ATTMBYTE' BYTE FROM 'CMATCH'. DIGIT .DS 1 SAVYR .DS 1 ; 'MLOOP' SAVE Y REGISTER. PEN .DS 1 ; GRAPHICS PEN SELECT. GRFLAG .DS 1 ; GRAPHICS MODE FLAG (0=NOT GRAPHICS, ELSE GRAPHICS). AUDIOR .DS AUREGS+AUREGS ; AUDIO VARIABLE POINTERS. AUX1 .DS 1 ; I/O AUX1 OVERRIDE BYTE. AUX2 .DS 1 ; I/O AUX2 OVERRIDE BYTE. .DS 1 ; 'OPNBUF'-1 USED BY 'SCNDEV'. OPNBUF .DS DNSIZE+1 ; DEVICE NAME BUFFER FOR OPEN. CDEST .DS 2 ; 'CHOT' DESTINATION IDENTIFIER & SAVE BYTE. LOADFG .DS 1 ; 0 IF NOT LOADING, ELSE LOADING. MATCHX .DS 2 ; 'XMATCH' FIELD INDEX VALUES. TRACE .DS 1 ; RUN-TIME TRACE FLAG (TRACE IF <> 0). AUTOIN .DS 1 ; AUTO-INPUT FLAG (ACTIVE IF <> 0). GSMODE .DS 1 ; GRAPHICS SCREEN MODE. INLNBF .DS INBFSZ ; TEMP STORAGE FOR SOURCE TO MATCH. NAMLNG .DS 1 ; 'SAVIT' & 'RESIT'. NOCONT .DS 1 ; 0 IF CONTINUE O.K. CONKEY .DS 1 ; 1=START, 2=SELECT, 4=OPTION. SGLSTP .DS 1 ; SINGLE STEP IF .NE. 0. AXFLAG .DS 1 ; 1 IF ACCEPT LITERAL. AKFLAG .DS 1 ; 1 IF ACCEPT KEY. XXXX .DS 1 ; 'SCNDEV' & 'PSTOP' USE. GNUMB .DS 4 ; GRAPHICS WORKING STORAGE & "XACCPT' TEMPORARY. USTKP .DS 1 ; USE STACK POINTER (0 - N*2). ESTKP .DS 1 ; EXPRESSION STACK POINTER. TRTLON .DS 1 ; DIVISIBLE TURTLE OFF, ELSE ON. TRTSNS .DS 1 ; VISIBLE TURTLE SENSOR STATE. LETTRSZ .DS 1 ; TEXT LETTER SIZE: 0,1 OR 2. SPLTSC .DS 1 ; 0=FULL GRAPHICS, $10 = SPLIT SCREEN. NMBFSZ = 5*2 ; 'MNYNMS' BUFFER SIZE. NMSBF .DS NMBFSZ SPEED .DS 1 ; SPEED CONTROL. EDGRUL .DS 1 ; TURTLE EDGE RULE. TRYPOS .DS 1 ; VISIBLE TURTLE Y POSITION. ORIENT .DS 1 ; VISIBLE TURTLE ORIENTATION. XC .DS 2 ; SCREEN CENTER X. YC .DS 2 ; SCREEN CENTER Y. CSTATE .DS 1 ; CONSOLE KEY READ STATE. ATRTYP .DS 1 ; 'NAME' ATTRIBUTE FOR 'IFIND'. DMPTYP .DS 1 ; ATTRIBUTE FOR DUMP CODE. TKNTYP .DS 1 ; TOKENIZED COMMAND LSTKN .DS 1 ; TOKEN FROM PREVIOUS STATEMENT FOR ': CONTINUATION'. TKNOFF .DS 1 ; OFFSET PAST COMMAND. USESTK .DS USTKSZ ; USE STACK. FCOLOR .DS 1 ; 'FLOOD' COLOR FLDCLR .DS 1 ; FIELD COLOR TO BE FLOODED. MSKTMP .DS 1 ; TEMP MASKED DATA. ROWFLG .DS 1 ; ROW FLAG. COLFLG .DS 1 ; COLUMN FLAG. SAVROW .DS 1 ; SAVED STARTING ROW. SAVCOL .DS 2 ; SAVED STARTING COLUMN. LFTCOL .DS 2 ; LEFT COLUMN VALUE. NEWLC .DS 2 ; NEW LEFT COLUMN. RGTCOL .DS 2 ; RIGHT COLUMN VALUE. NEWRC .DS 2 ; RIGHT COLUMN. MAXROW .DS 1 ; MAXIMUM ROW VALUE. MAXCOL .DS 2 ; MAXIMUM COLUMN VALUE. MLTTMP .DS 2 ; MULTIPLY TEMP. SHFAMT .DS 1 ; SHIFT AMOUNT. DMASK .DS 1 FINEFG .DS 1 ; 0 = COARSE SCROLL, -1 = FINE. CETEMP .DS 2 ; 'COMPRS'/'EXPAND' TEMPORARY. LFCOL .DS 1 ; T: LEFT MOST COLUMN. RGCOL .DS 1 ; T: RIGHT MOST COLUMN. PENNUM .DS 1 ; PEN NUMBER. PENCOL .DS 1 ; PEN COLOR. NCOLRS .DS 1 ; NUMBER OF COLORS ALLOWED. NXTCLR .DS 1 ; NEXT AVAILA8LE COLOR SLOT. PNCLRS ; PEN COLORS. BAKCLR .DS 1 ; BACKGROUND COLOR. .DS 8 ; FOREGROUND COLORS. TRTCOL .DS 1 ; TURTLE COLOR. RBTON .DS 1 ; 0=ROBOT TURTLE OFF, ELSE ON. RBTSNS .DS 1 ; ROBOT SENSOR STATE. RBTCMD .DS 1 ; INTERNAL ROBOT COMMAND. RBTPRM .DS 2 ; INTERNAL ROBOT PARAMETER. INDENT .DS 1 ; AUTO INDENT. SCTEMP .DS 1 ; 'SETCLR' TEMP. PRTEMP .DS 1 ; 'PRCLNM' TEMP. WALLS .DS 2 ; WALL SELECTION DATA. GCOL .DS 2 ; TURTLE COLUMN POSITION. GROW .DS 1 ; TURTLE ROW POSITION. GANGLE .DS 2 ; TURTLE THETA. GROPR .DS 1 ; GRAPHICS OPERATION TYPE. HITWLL .DS 1 ; 0 = NO WALL HIT, ELSE WALL HIT. HITEDG .DS 1 ; 0 = NO EDGE HIT, ELSE EDGE HIT. HALTFG .DS 1 ; NON-ZERO = HALT AT EDGE. GRTEMP .DS 1 ; 'GREAD' TEMP. TUFLAG .DS 1 ; TURTLE PARAMETER UPDATE INTERLOCK. LITMAT .DS 1 ; NON-ZERO = LITERAL MATCH. NOPLOT .DS 1 ; NON-ZERO = DON'T PUT POINT. DSISAV .DS 2 ; VALUE OF ORIGINAL 'DOSINI'. DSVSAV .DS 2 ; VALUE OF ORIGINAL 'DOSVEC. DMASAV .DS 1 ; 'DMACT' SAVE VALUE FOB TV ON/OFF. SPARES = $700-* ; *** THIS HAD BETTER BE POSITIVE *** ORG $BC00 TEXBUF .DS TEXLNG+1 ; TEXT EXPRESSION BUFFER. .DS 1 ; ONE EXTRA LEADING BLANK FOR AUTO-IN. COMBUF .DS LINLNG+1 ; COMMAND INPUT BUFFER. ACCBUF .DS 256 ; ACCEPT BUFFER. NAMBUF .DS 257 ; STRING NAME BUFFER. ; ; NOTE: THE USE OF THE TERM '(BRA)' IN A COMMENT INDICATES THAT THE ; PARTICULAR BRANCH INSTRUCTIONS USED WILL ALWAYS BRANCH IN THE ; PARTICULAR CIRCUMSTANCES, THE BRANCH IS SUPPOSED TO BE A TWO BYTE ; JUMP. ; ; POWER-UP ROUTINE AND INITIALIZATION ORG $7700 PILLOW ; PILOT LOW ADDRESS TPBUFF ; TVBUFF = TPBUFF+12 ; VISIBLE REGION. TRBUFF = TVBUFF-7 ; INCLUDES UNDERFLOW. ORG TPBUFF+256 ; TURTLE REP. BUFFER. .IF DOS LDA #0 ; CLEAR COLDSTART FLAG (SEE 'XDOS'). STA COLDST JMP MLE ; RETURN FROM DOS. .ENDIF ; PROC PILINI LDA WARMST ; WARM START? BNE L1_PI020 ; YES. LDA DOSINI ; SAVE ORIGINAL 'DOSINI'. STA DSISAV LDA DOSINI+1 STA DSISAV+1 LDA #PILINI STA DOSINI+1 .IF DOS LDA DOSVEC ; SAVE ORIGINAL 'DOSVEC'. STA DSVSAV LDA DOSVEC+1 STA DSVSAV+1 .ENDIF JMP L1_PI030 L1_PI020 JSR GODOS ; PERFORM DOS INIT. L1_PI030 LDA #MLE STA DOSVEC+1 RTS GODOS JMP (DSISAV) ; 2ND HALF OF JSR (DSISAV). ; PROC INIT LDA #EPUTC-IOVBAS ; ESTABLISH 'CHOT' DESTINATION AS 'E:' STA CDEST LDA WARMST ; WARM START? BNE L2_INI15 ; YES? LDX #$80 ; CLEAR UPPER HALF OF PAGE ZERO. LDA #0 L2_INI10 STA 0,X INX BNE L2_INI10 ; CONTINUE TILL PAGE WRAP POINT. LDA #$4C ; PUT JMP OP-CODE IN JUMP VECTORS. STA XJUMP+0 STA GJUMP+0 STA SJUMP+0 LDA #$16 ; AUTO-NUMBER SCREEN = DARK YELLOW STA ACOLR2 LDA #$00 ; AUTO-NUMBER LETTERS = BLACK. STA ACOLR1 .IF FALSE LDA #PRGEND STA MEMLO+1 .ENDIF LDA MEMLO ; ESTABLISH MEMORY LIMITS FOR ALLOCATION. STA S1L ; ... & PROGRAM STORAGE AREA. LDA MEMLO+1 STA S1L+1 JSR CLRPRG LDA MEMHI ; ALSO FOR STRING STORAGE AREA. STA S2H STA S2L LDA MEMHI+1 STA S2H+1 STA S2L+1 L2_INI15 LDX #>PILVBL ; INTERCEPT VBLANKS. LDY #ACCBUF STA ACLN+1 JSR NULACC ; SET ACCEPT BUFFER TO NULL. LDA #TEXBUF STA TELN+1 LDA #' ' ; LEADING BLANK FOR AUTO-IN. STA COMBUF-1 JSR TRTINI ; INITIALIZE VISIBLE TURTLE STUFF. JSR PBINIT ; ... ROBOT TURTLE ('OFF' IN 'MLE'). JSR REMDEV ; REMOVE DEVICE ASSIGNMENTS FROM STRING LIST. JSR TXOPEN ; OPEN E: & RECAPTURE GRAPHICS REGION IF NECESSARY. LDA WARMST ; WARMSTART? BNE L2_INI30 ; YES. LDA #SIGNON ; GENERATE SIGN-ON MESSAGE. JSR MESSOT L2_INI30 JMP RDYMES ; GENERATE "READY" MESSAGE & RETURN. ; PROC ; ; MAIN LOOP FOR PILOT INTERPRETER. ; ; ; POWER-UP ANO RESET ENTRY. ; MLE LDX #$FF ; INITIALIZE STACK POINTER. TXS LDA #>$7000 ; NEW TOP OF MEMORY. STA RAMTOP LDA #0 ; CLEAR ESSENTIALS FOR EOPEN CALL. STA AUX1 STA AUX2 STA GRFLAG STA LETTRSZ STA FINEFG JSR EOPEN ; MOVE SCREEN DOWN. STX NOCONT ; NO CONTINUATION. JSR INIT ; INITIALIZE REST OF ENVIRONMENT ; *** EXTERNAL ENTRY POINT *** MLRES LDA #CASSOF ; CASSETTE MOTOR OFF STA PACTL JSR AUDCLR ; CLEAR AUDIO REGISTERS MLRES2 LDA #0 ; RESET ... STA RUN ; ... RUN FLAG ... STA SGLSTP ; ... SINGLE STEP ... STA DSPFLG ; ... DISPLAY FLAG ... STA INVFLG ; ... INVERT VIDEO FLAG ... STA IOEDIS ; ... & ERROR STOP DISABLE FLAG. LDA #XTYPE STA XJUMP+2 STA EXECF ; CONDITION FLAG = TRUE. ; *** EXTERNAL ENTRY POINT *** MLLOAD LDA #COMBUF STA INLN+1 MLOOP JSR GETCOM ; GET A COMMAND INPUT. BNE L3_ML090 ; ERROR (SKIP BRANCH). ; NOTE: THE Y REGISTER IS ASSUMED TO CONTAIN THE INDEX TO 'INLN' ; THROUGHOUT THIS ROUTINE. ALL CALLED ROUTINES WILL BE ; RESPONSIBLE POR MAINTAINING ITS INTEGRITY. LDA LOADFG ; LOADING? BNE L3_ML020 ; YES. LDA RUN ; RUN MODE? BNE L3_ML070 ; YES. LDA AUTOIN ; AUTO-INPUT MODE? BEQ L3_ML020 ; NO. JMP L3_ML100 ; YES. L3_ML020 LDA CONKEY AND #STRTKY ; START KEY? BEQ L3_ML030 ; NO. LDA CONKEY ; RESET THE KEY FLAG. AND #$FF-STRTKY STA CONKEY LDA NOCONT ; CAN WE CONTINUE? BEQ L3_ML025 ; YES. JSR XRN010 ; NO -- START AT BEGINNING. L3_ML025 DEC SGLSTP ; YES -- SET FLAG. DEC RUN ; SET TO RUN MODE. BNE MLOOP ; (BRA). L3_ML030 JSR SCNLBL ; SCAN OVER LABEL IF PRESENT BEQ L3_ML040 ; YES -- SAW A VALID LABEL. LDA (INLN),Y ; CHECK FOR LINE NUMBER. JSR CNUMBR ; NUMBERED LINE? BCC L3_ML110 ; YES -- EDIT MODE. ; UN-NUMBERED LINE -- IMMEDIATE EXECUTION L3_ML040 LDX #CTIMM ; SETUP FOR IMMEDIATE MODE COMMANDS. JSR SYCMND ; IMMEDIATE MODE -- SYNTAX CHECK CODE. BNE L3_ML090 ; ERROR -- DON'T EXECUTE THE COMMAND BEQ L3_ML085 ; (BRA). ; LINE FROM STORAGE -- 'RUN' MODE L3_ML070 LDA CONKEY ; CONSOLE KEY PRESSED? AND #OPTKEY ; OPTION KEY? BEQ L3_ML080 ; NO. LDA TRACE ; YES -- TOGGLE THE TRACE. EOR #KON STA TRACE LDA CONKEY ; RESET THE KEY FLAG. AND #$FF-OPTKEY STA CONKEY L3_ML080 LDA TRACE ; TRACE EXECUTION? ORA SGLSTP BEQ L3_ML085 ; NO. JSR TSTMOD ; CHECK SCREEN MODE. AND #TXSL+GRSS ; TEXT OUPUT O.K.? BNE L3_ML082 ; YES. JSR TXOPEN ; NO -- OPEN TEXT SCREEN. L3_ML082 LDA #TRCMES ; PRINT TRACE LINE HEADER. JSR MESSOT LDY #INLN-DTAB ; PRINT SOURCE STATEMENT. JSR PSF ; COMMON CODE 'IMMEDIATE' AND 'RUN' L3_ML085 JSR EXCMND ; EXECUTE THE COMMAND. L3_ML090 BNE L3_ML155 ; RUN-TIME ERROR (SKIP BRANCH POINT). LDA SGLSTP ; SINGLE STEP? BEQ L3_ML095 ; NO. JMP MLRES2 ; YES -- RETURN TO IMMEDIATE MODE. L3_ML095 JMP MLOOP ; GET NEXT COMMAND. ; AUTO-INPUT MODE -- SUPPLY THE LINE NUMBER AND ONE EXTRA LEADING BLANK. L3_ML100 LDA ALINE ; SUPPLY THE LINE NUMBER. STA NUMBER LDA ALINE+1 STA NUMBER+1 LDX #INLN-DTAB JSR DDCRI ; ONE EXTRA LEADING BLANK. INC INLN+3 JMP L3_ML112 ; NUMBERED LINE INPUT -- EDIT MODE. L3_ML110 JSR ATOM ; CONVERT LINE NUMBER TO BINARY IN 'NUMBER'. L3_ML112 STY INLN+2 ; SAVE INPUT LINE POINTER. LDX #NUMBER-DTAB LDA LOADFG ; SUPPLY LINE NUMBER IF 'APPEND'. CMP #KAPPND BNE L3_ML120 LDY #ALINE-DTAB JSR DMOVI L3_ML120 JSR CHKLN ; CHECK LINE # FOR RANGE. BCS L3_ML200 ; OUT OF RANGE. LDA #0 ; CLEAR USE STACK ON INSERT/DELETE. STA USTKP LDA #$FF ; ALTER PROGRAM -- NO CONTINUATION. STA NOCONT LDA NUMBER+1 ; SAVE LINE NUMBER ... STA LINENO ; ... IN INVERTED FORM (STRING NAME). LDA NUMBER STA LINENO+1 LDY INLN+2 ; RESTORE INPUT LINE INDEX. JSR SCNLBL ; SKIP OVER LABEL IF PRESENT. BEQ L3_ML150 ; LABEL FOUND. LDA (INLN),Y ; CHECK FOR NULL STATEMENT. CMP #EOL BNE L3_ML150 ; NON-NULL -- STATEMENT IS TO BE ENTERED. LDA AUTOIN ; AUTO-INPUT MODE? BEQ L3_ML140 ; NO. JSR LVAUTO ; LEAVE AUTO-INPUT MODE. LDA #AUTOXT ; GENERATE MESSAGE AS WE LEAVE. JMP L3_ML985 L3_ML140 JSR LDELET ; YES -- DELETE NUMBERED LINE. L3_ML145 JMP MLOOP L3_ML150 LDY INLN+2 ; RESTORE INPUT LINE POINTER. LDX #CTRUN ; SETUP FOR RUN MODE COMMANDS. JSR SYCMND ; SYNTAX CHECK THE STATEMENT. L3_ML155 BNE L3_ML900 ; SYNTAX ERROR (SKIP BRANCH POINT). JSR LINSRT ; INSERT THE NEW LINE (COMMAND 'TOKENIZED'). BNE L3_ML200 ; NO ROOM FOR NEW LINE. LDX #ALINE-DTAB ; INCREMENT AUTO-INPUT LINE #. LDY #AINC-DTAB ; (EVEN IF NOT IN AUTO-INPUT MODE). JSR DADDI LDA AUTOIN ; AUTO-INPUT MODE? BEQ L3_ML145 ; NO -- GET NEXT COMMAND. JMP MLLOAD ; YES -- ADJUST 'INLN' FOR 'LEADING BLANK'. LVAUTO LDX #0 ; RESET AUTO-INPUT MODE. STX AUTOIN LDX #CBLUE ; RESTORE NORMAL SCREEN COLOR. STX COLOR0+2 LDX #CYELLO STX COLOR0+1 RTS ; NO ROOM FOR LINE OR LINE # OUT OF RANGE. L3_ML200 PHA ; SAVE ERROR CODE. LDA LOADFG ; LOAD IN PROGRESS? BEQ L3_ML210 ; NO. LDA #0 ; ABORT LOAD. STA LOADFG LDX #IOCB3 ; CLOSE FILE. JSR DCLOSE L3_ML210 PLA ; RESTORE ERROR CODE. JSR LVAUTO ; LEAVE AUTO-INPUT MODE & FALL INTO 'PSTOP'. ; SYNTAX/RUN-TIME ERROR PROCESSOR ; *** EXTERNAL ENTRY POINT *** ; A = ERROR CODE ; Y = INDEX TO ERROR IN STATEMENT. L3_ML900 PSTOP LDX #$FF ; RE-INIT STACK POINTER. TXS STX DSPFLG ; SET DISPLAY FLAG. STY SAVYR ; SAVE INDEX TO ERROR. STA NUMBER ; SAVE ERROR NUMBER. JSR TSTMOD ; CHECK SCREEN MODE. AND #TXSL+GRSS ; TEXT OUTPUT O.K.? BNE L3_ML920 ; YES. JSR TXOPEN ; NO -- OPEN TEXT SCREEN. L3_ML920 LDA #EPUTC-IOVBAS ; RE-ESTABLISH 'E:' AS 'CHOT' OUTPUT. STA CDEST JSR NEWLIN LDA RUN ; IF IMMEDIATE ... ORA INLN+3 ; ... & EMPTY INPUT LINE ... BEQ L3_ML990 ; ... THEN IGNORE ERROR (BREAK). LDA NUMBER CMP #EOPERR ; SEE IF ERROR IS END OF PROGRAM. BEQ L3_ML985 ; YES -- NO STATEMENT TO PRINT. TAY ; (SET CC). BMI L3_ML947 ; YES -- NO HIGHLIGHTED CHARACTER. LDY SAVYR ; HIGHLIGHT THE ERROR CHARACTER. LDA (INLN),Y STA XXXX ; SAVE FOR LATER RESTORATION. CMP #EOL BNE L3_ML945 LDA #' ' ; REPLACE EOL WITH BLANK. L3_ML945 EOR #$80 ; INVERT COLOR. STA (INLN),Y L3_ML947 LDA RUN ; SEE IF RUN OR IMMEDIATE MODE. BEQ L3_ML950 ; IMMEDIATE. LDY #INLN-DTAB JSR PSF ; RUN -- PRINT STORAGE FORMAT. JMP L3_ML960 L3_ML950 LDA #0 ; *** OR DON'T USE 'INLN'+2 AS TEMP STORE *** STA INLN+2 LDX #INLN-DTAB ; IMMEDIATE -- PRINT INPUT LINE. JSR PRTSTG L3_ML960 LDA NUMBER ; WAS THERE A HIGHLIGHTED CHARACTER? BMI L3_ML963 ; NO. LDY SAVYR ; RESTORE ORIGINAL CHARACTER. LDA XXXX STA (INLN),Y CMP #EOL ; WAS IT THE EOL? BNE L3_ML963 ; NO. JSR CHOT ; YES -- DO IT NOW. L3_ML963 LDA #ASTMES ; PREFIX MESSAGE WITH '***'. JSR MESSOT LDA NUMBER CMP #IOERR ; I/O ERROR? BNE L3_ML981 ; NO. LDY IOSTAT ; YES -- BREAK? CPY #128 BNE L3_ML981 ; NO. LDA #ABTERR ; YES -- CHANGE ERROR CODE. STA NUMBER L3_ML981 JSR MESSOT ; GENERATE ERROR MESSAGE. LDA NUMBER CMP #IOERR ; I/O ERROR? BNE L3_ML982 ; NO. LDX #IOSTAT-DTAB ; YES -- PRINT ERROR STATUS. JSR DECASC L3_ML982 LDA #ASTMES ; APPEND '***' TO END OF MESSAGE. ; *** EXTERNAL ENTRY POINT FROM 'MLOOP' *** L3_ML985 JSR MESSOT JSR NEWLIN L3_ML990 JMP MLRES ; GET NEXT COMMAND. ; LINE INSERT AND DELETE ROUTINES ; PROC ; ; LINSRT -- INSERT NUMBERED LINE TO STATEMENT LIST ; ; CALLING SEQUENCE: ; ; 'LINENO' = LINE # (BINARY) ; 'INLN' POINTS TO STATEMENT TO INSERT ; 'TKNTYP' = TOKEN ; 'TKNOFF' = OFFSET PAST COMMAND IN SOURCE STATEMENT. ; ; JSR LINSRT ; BNE NO ROOM IN MEMORY OR OTHER PROBLEM ; LINSRT JSR NUMNAM ; SETUP 'LINENO' AS STRING NAME. LDX #DP-DTAB ; SETUP STRING AT A POINTER. LDY #INLN-DTAB JSR PMOVE SEC ; OFFSET PAST COMMAND = LDA TKNOFF ; ... 'TKNOFF'. SBC INLN+2 ; ... - 'INLN+2'. CLC ADC #6 ; ... + 6. STA TKNOFF JMP SINSRT ; INSERT LINE & RETURN WITH CC SET. ; PROC ; ; LDELET -- NUMBERED LINE DELETE FROM STATEMENT LIST ; ; CALLING SEQUENCE: ; ; 'LINENO' = LINE * (BINARY) ; ; JSR LDELET ; BNE LINE NOT FOUND OR OTHER PROBLEM ; LDELET JSR NUMNAM ; SETUP 'LINENO' AS STRING NAME. JMP SDELET ; DELETE LINE & RETURN WITH CC SET. ; PROC ; ; NUMNAM -- SETUP 'LINENO' AS STRING NAME & SETUP ACCESS TO STATEMENT LIST. ; ; CALLING SEQUENCE: ; ; JSR NUMNAM ; ; 'ATRTYP' SET FOR LINE # ; NUMNAM LDA #LINENO STA NP+1 LDA #0 STA NP+2 LDA #2 STA NP+3 JMP STMLST ; SETUP TO ACCESS STATEMENT LIST & RETURN. ; PROC ; ; GETCOM -- GET A COMMAND LINE FOR THE MAIN LOOP ; ; CALLING SEQUENCE: ; ; 'LOADFG' = 0 IF NOT LOADING FROM DEVICE, ELSE LOADING. ; 'RUN' = 0 IF IMMEDIATE MODE, ELSE RUN MODE. ; 'NXTLN' POINTS TO NEXT RUN MODE LINE. ; ; JSR GETCOM ; BNE ERROR (A = ERROR NUMBER) ; ; 'INLN' POINTS TO NEW COMMAND LINE. ; Y = INDEX TO START OF STATEMENT. ; 'NXTLN' POINTS TO NEXT RUN MODE LINE. ; ; IF 'RUN', THEN ; ; 'TKNTYP' = TOKENIZED COMMAND ; 'TKNOFF' = OFFSET PAST COMMAND IN STATEMENT STORAGE. ; GETCOM LDA LOADFG ; LOADING FROM DEVICE? BNE L7_GC200 ; YES. LDA RUN ; RUN MODE? BEQ L7_GC100 ; NO -- IMMEDIATE. L7_GC010 JSR ABRTCK ; YES -- CHECK FOR OPERATOR ABORT. LDX #INLN-DTAB ; GET NEXT STATEMENT ADDRESS. LDY #NXTLN-DTAB JSR DMOVI LDY #0 ; GET & SAVE LINE END INDEX. LDA (INLN),Y STA INLN+3 LDY #S1H-DTAB ; END OF PROGRAM? JSR DCMPI BNE L7_GC020 ; NO -- KEEP TRUCKIN'. LDA #EOPERR ; RETURN WITH INDICATOR. STA NOCONT ; NO CONTINUATION. RTS L7_GC020 ; *S* LDX #INLN-DTAB JSR SATTR ; 'ATTRIBUTE' STA TKNTYP ; AS ADVERTISED. INY LDA (TEMP),Y STA TKNOFF ; AS ADVERTISED. LDX #NXTLN-DTAB ; POINT TO NEXT LINE. JSR SNXTI LDA #0 ; SET CC FOR RETURN. RTS ; GET A LINE FROM THE CONSOLE. L7_GC100 LDA #0 ; CLEAR LINE LENGTH FOR "BREAK". STA INLN+3 LDX #INLN-DTAB ; GET AN INPUT LINE FROM CONSOLE. JSR GETLIN LDY #0 ; SET INDEX TO START OF STATEMENT (CC TOO). RTS ; GET DATA FROM DEVICE ASSIGNED TO IOCB 3. L7_GC200 STX TEMP ; SAVE REGISTERS. L7_GC205 LDA INLN ; SETUP BUFFER ADDRESS. STA IOCB3+ICBAL LDA INLN+1 STA IOCB3+ICBAH LDA #GETR ; GET RECORD COMMAND. STA IOCB3+ICCOM LDA #LINLNG-1 STA IOCB3+ICBLH LDX #IOCB3 ; GET RECORD. JSR CIO LDA IOCB3+ICBLL ; PUT START/END INDICES IN POINTER. STA INLN+3 LDA #0 STA INLN+2 CPY #0 ; ERROR? BPL L7_GC250 ; NO. LDA #0 ; THAT OR END-OF-FILE. STA LOADFG ; STOP LOADING IN EITHER CASE. CPY #$88 ; END OF FILE? BNE L7_GC220 ; NO. JSR DCLOSE ; YES -- CLOSE DEVICE. LDA RUN ; IS THE USER PROGRAM RUNNING? BEQ L7_GC210 ; NO -- IMMEDIATE LOAD OR LOAO ERROR. LDA #0 ; CONTINUE O.K. STA NOCONT LDA S1L ; SETUP TO RUN PROGRAM LOADED. STA NXTLN LDA S1L+1 STA NXTLN+1 JMP L7_GC010 ; (TOO FAR FOR 'RELATIVE'). L7_GC210 JSR RDYMES ; GENERATE "READY" MESSAGE. JMP MLRES ; GRACEFUL TERMINATION OF LOAD. L7_GC220 JMP DOP005 ; ABORT LOAD OPERATION. L7_GC250 LDY #0 ; ACCEPT ONLY NUMBERED LINES. JSR SLB JSR CNUMBR BCS L7_GC205 ; NOT NUMBERED--IGNORE. LDX TEMP ; RESTORE REGISTER. LDY #0 ; SETUP INDEX TO START OF STATEMENT (=0). RTS ; RETURN WITH CC SET. ; PROC ; ; SYCMND -- SYNTAX CHECK THE COMMAND ; ; CALLING SEQUENCE: ; ; X = VALID CCMNAND MODE. ; 'INLN' POINTS TO THE STATEMENT ; Y = INDEX TO START OP STATEMENT ; ; JSR SYCMND ; BNE SYNTAX ERROR (A = ERROR CODE) ; ; 'TKNTYP' = TOKENIZED COMMAND. ; 0/#USROFF-1 = COMMAND IS IN 'CDTAB' ; #USROFF/#USROFF+#USRMAX-1 = COMMAND IS IN 'USRTAB' ; 'TKNCNT' = RESERVED FOR ': CONTINUATION' ; 'TKNNUL' = RESERVED FOR 'NULL' COMMAND ; 'TKNOFF' = OFFSET PAST COMMAND FROM BEGINNING OF STATEMENT. ; SYCMND JSR SCNLBL ; SCAN PAST LABEL IF PRESENT. JSR SLB CMP #':' ; COMMAND CONTINUATION? BEQ L8_SC010 ; YES. JSR CHKTRM ; 'NULL' COMMAND? BEQ L8_SC020 ; YES. LDA #0 ; RESET EXECUTE FLAG. STA EXEC JSR CMATCH ; FIND COMMAND. BEQ L8_SC005 ; VALID. CMP #IVCERR ; IF NOT IN TABLE, ASSUME 'GR:'. BNE L8_SC099 ; ERROR. LDX #CDG-CDTAB ; CASE: 10 360(HOME;DRAW 10;TURN 1). L8_SC005 STX TKNTYP ; TOKENIZE COMMAND. STY TKNOFF ; OFFSET PAST COMMAND. JMP EXC100 L8_SC010 INY ; MOVE PAST LDA #TKNCNT ; COMMAND CONTINUATION. BNE L8_SC050 ; (BRA). L8_SC020 LDA #TKNNUL ; NULL COMMAND. L8_SC050 STA TKNTYP STY TKNOFF LDA #0 ; SET CC FOR EXIT. L8_SC099 RTS ; PROC ; ; EXCMND -- EXECUTE THE COMMAND ; ; CALLING SEQUENCE: ; ; 'TKNTYP' = TOKENIZED COMMAND. ; 'TKNOFF' = OFFSET PAST COMMAND. ; ; JSR EXCMND ; BNE SYNTAX OR RUN-TIME ERROR (A = ERROR CODE). ; EXCMND LDY TKNOFF ; OFFSET PAST COMMAND. LDA #$FF ; SET EXECUTE FLAG. STA EXEC LDX TKNTYP ; TRAP FOR 'RESERVED' TOKENS. CPX #TKNCNT BCC EXC100 ; NOT 'RESERVED'. BNE L9_EC020 ; 'NULL' COMMAND. ; COMMAND CONTINUATION LDX LSTKN ; USE TOKEN FROM 'LAST' COMMAND. STX TKNTYP CPX #CLNCNT ; NO -- CHECK 'CDTAB' SEGMENT. ; ('USRTAB' NOT ALLOWED). BCC L9_EC010 ; O.K. DEY ; POINT TO '!'. LDA #IVCERR ; INVALID CONTINUATION. RTS ; COMMAND CONTINUATION IS VALID. L9_EC010 LDA EXECF ; USE PRIOR 'EXECF'. BNE L9_EC500 ; EXECUTE COMMAND USING PRIOR 'XJUMP'. ; EXIT FOR 'NULL' COMMAND. L9_EC020 LDA #0 ; SET CC FOR EXIT. RTS ; *** ENTRY FROM 'SYCMND' *** EXC100 JSR COND ; PROCESS CONDITION IF PRESENT. LDA EXEC ; EXECUTE MODE? BEQ L9_EC300 ; NO -- SYNTAX SCAN ONLY. LDA EXECF ; EXECUTE COMMAND? BEQ L9_EC900 ; NO -- NORMAL EXIT. L9_EC300 STY XTEMP ; SAVE Y. LDY TKNTYP ; 'USRTAB' OR 'CDTAB'? STY LSTKN ; SAVE TOKEN IN CASE NEXT COMMAND USES ; ':-CONTINUATION'. CPY #USROFF BCC L9_EC400 ; 'CDTAB'. TYA ; 'NORMALIZE' RELATIVE TO 'USRTAB'. SEC SBC #USROFF TAY LDA USRTAB STA TEMP LDA USRTAB+1 BNE L9_EC410 ; (BRA). L9_EC400 LDA #CDTAB L9_EC410 STA TEMP+1 LDA (TEMP),Y ; MOVE ADDRESS TO JUMP INSTRUCTION. STA XJUMP+1 INY LDA (TEMP),Y STA XJUMP+2 LDY XTEMP ; RESTORE INDEX. L9_EC500 LDA EXEC ; SET CC FOR X-ROUTINES. JSR XJUMP ; YES -- EXECUTE (OR SCAN). BNE L9_EC900 ; ERROR -- RETURN WITH CC SET. JSR SLB ; SKIP ANY BLANKS. JSR CHKTRM ; STATEMENT TERMINATOR? BEQ L9_EC900 ; YES -- O.K. LDA #JNKERR ; JUNK -- ERROR. L9_EC900 RTS ; RETURN WITH CC SET. ; PROC ; ; CMATCH -- COMMAND MATCH ROUTINE ; ; ORDER OF SEARCHING: ; ; 1. THE USER EXTENDABLE COMMAND TABLE ; 2. THE GRAPHICS SUBCOMMANDS ; 3. THE INTERNAL COMMAND TABLE ; ; ; CALLING SEQUENCE: ; ; 'USRTAB' = ADDRESS OF USER EXTENDABLE COMMAND TABLE (0=NONE). ; (OFFSETS ARE RELATIVE TO 'USRTAB'). ; X = IMMEDIATE AND/OR RUN COMMAND' VALID ; 'INLN' POINTS TO SOURCE STATEMENT. ; Y = INDEX TO START OF COMMAND NAME. ; ; JSR CMATCH ; BNE NO MATCH IN TABLE (A = ERROR CODE, Y UNCHANGED) ; ; X = VALUE OF 'CTAB' DATA BYTE FOR ENTRY ('TOKENIZED' COMMAND). ; X < 'USROFF' (OFFSET IN 'CDTAB'). ; X >= 'USROFF' ('USROFF' + OFFSET IN 'USRTAB'). ; Y = INDEX TO START OF FIELD AFTER COMMAND NAME. ; 'CTABAT' = ATTRIBUTE BITS OF COMMAND. ; ; NOTE: NAME MATCH MUST BE EXACT FOR THE REST OF THE ; STATEMENT TO BE PROCESSED CORRECTLY. FOR EXAMPLE: ; "TYPEN:" WILL BE SCANNED AS TY:, NOT ; TN:. ; CMATCH STX CTABAT ; SAVE VALID COMMAND TYPES. STY XTEMP ; SAVE Y REG. LDA USRTAB ; SELECT 'USRTAB' IF ADDR>255. STA TABADR LDA USRTAB+1 BEQ L10_CMA10 ; NO USER EXTENDED COMMAND TABLE. STA TABADR+1 JSR CMACOM ; SEARCH 'USRTAB' BNE L10_CMA10 ; NOT IN 'USRTAB' CPX #USRMAX ; IS 'USRTAB' TOO LARGE? BCS L10_CMA10 ; YES -- PRETEND COMMAND WAS NOT THERE. TYA ; CHECK 'ATTRIBUTE' BIT CTABAT BEQ L10_CMA90 ; WRONG COMMAND TYPE. ; COMMAND IS IN 'USRTAB' TXA ; SET 'TOKEN' FOR 'USRTAB' CLC ADC #USROFF ; SET OFFSET TO IDENTIFY TOKEN IN 'USRTAB'. TAX BNE L10_CMA50 ; (BRA). ; SEARCH GRAPHICS SUBCOMMANDS L10_CMA10 LDY XTEMP ; RESTORE INDEX. LDX #GTABX JSR SBCMAT ; GRAPHICS SUBCOMMAND? BNE L10_CMA20 ; NO. LDY XTEMP ; RESTORE INDEX FOR SYNTAX CHECK. LDX #CDG-CDTAB ; TOKENIZE AS 'GR:'. LDA #0 ; SET CC FOR EXIT. RTS ; SEARCH INTERNAL COMMAND TABLE L10_CMA20 LDA #CTAB STA TABADR+1 JSR CMACOM ; SEARCH 'CTAB' BNE L10_CMA99 ; NOT IN 'CTAB' -- INVALID. TYA BIT CTABAT BEQ L10_CMA90 ; WRONG COMMAND TYPE. ; COMMAND IS IN 'CTAB' L10_CMA50 STY CTABAT ; STORE 'ATTRIBUTE'. LDA #0 ; SET CC FOR EXIT. BEQ L10_CMA99 ; (BRA). L10_CMA90 LDA #NRCERR ; WRONG COMMAND TYPE. BNE L10_CMA99 ; (BRA). ; ; SBCMAT -- SUBCOMMAND MATCH ROUTINE ; ; CALLING SEQUENCE: ; ; X = INDEX TO THE SUBCOMMAND TABLE FROM 'SBCTAB' ; 'JNLN' POINTS TO SOURCE STATEMENT. ; Y = INDEX TO START OF SUBCOMMAND NAME. ; ; JSR SBCMAT ; BNE NO MATCH IN TABLE (A = ERROR CODE, Y UNCHANGED) ; ; X = VALUE OF 'SBCTAB' DATA BYTE FOR ENTRY ('OFFSET' OR 'VALUE') ; Y = INDEX TO START OF FIELD AFTER COMMAND NAME. ; SBCMAT LDA SBCTAB,X ; SELECT SUBCOMMAND TABLE. STA TABADR LDA SBCTAB+1,X STA TABADR+1 JSR CMACOM ; COMMON CODE. ; *** OPTIONAL ENTRY FROM 'CMATCH' *** L10_CMA99 PHP ; SAVE CC. LDY TEMP ; RESTORE INDEX IN 'INLN'. PLP ; RESTORE CC FOR CALLER. RTS ; PROC ; ; CMACOM -- COMMON CODE FOR 'CMATCH' AND 'SBCMAT' ; ; CALLING SEQUENCE: ; ; 'TABADR' = BASE ADDRESS OF MATCH TABLE. ; 'INLN' POINTS TO SOURCE STATEMENT. ; Y = CURRENT INDEX IN 'INLN' ; ; JSR CMACOM ; BNE NO MATCH IN TABLE (A = ERROR CODE) ; ; X = 'OFFSET' BYTE ; Y = 'ATTRIBUTE' BYTE ; TEMP = INDEX TO START OF FIELD AFTER COMMAND NAME. ; ; ; ALAS THE INDIRECT INDEXING OF THE 6502. ; MOVE '(INLN),Y' THROUGH '(INLN),Y + INBFSZ-1 TO ; A FIXED BUFFER, 'INLNBF', SO THAT 'X' CAN INDEX 'INLN' ; WHILE 'Y' INDEXES THE TABLE. ; ; CONVERT LC -> UC IN 'INLNBF'. CMACOM JSR SLB ; SKIP LOADING BLANKS STY TEMP ; SAVE INDEX IN 'INLN' JSR MVINLN ; MOVE 'PART' OF 'INLN' LDY #$FF ; SEARCH FROM THE BEGINNING OF '(TABADR)' ; (PRE-DECREMENT). LDX #$FF ; START AT TWO BEGINNING OF THE SOURCE. ; (PRE-DECREMENT). L11_CMA05 INY ; NEXT TABLE CHARACTER. INX ; NEXT SOURCE CHARACTER. LDA (TBLBAS),Y ; SEE IF END OF NAME IN TABLE. L11_CMA10 BMI L11_CMA70 ; YES -- MATCH FOUND. CMP INLNBF,X ; MATCH NEXT SOUPCE CHAR? BEQ L11_CMA05 ; YES -- CONTINUE COMPARISON. L11_CMA20 INY ; SCAN TO END OF NANE ENTRY. LDA (TBLBAS),Y BPL L11_CMA20 INY ; SCAN PAST 'ATTRIBUTE' BYTE. INY ; SCAN PAST 'OFFSET' BYTE. CPY #$FF-INBFSZ-3 ; WILL INDEX WRAP? BCC L11_CMA30 ; NO. TYA ; YES -- ADJUST BASE POINTER. LDX #TBLBAS-DTAB JSR DADDP LDY #0 ; ... AND RESET INDEX. L11_CMA30 LDX #0 ; RESTORE SOURCE INDEX. LDA (TBLBAS),Y ; CHECK FOR END OF TABLE. BNE L11_CMA10 ; NO -- KEEP CHECKING. LDA #IVCERR ; TABLE END -- INVALID COMMAND. BNE L11_CMA90 ; (BRA). L11_CMA70 PHA ; VALUE OF 'ATTRIBUTE' BYTE. TXA ; OFFSET IN 'INLNBF'. CLC ADC TEMP ; + INITIAL OFFSET IN 'INLN'. STA TEMP ; INDEX TO START OF FIELD AFTER NAME. INY LDA (TBLBAS),Y ; 'OFFSET' BYTE. TAX PLA ; VALUE OF 'ATTRIBUTE' BYTE. TAY LDA #0 ; SET CC FOR EXIT. L11_CMA90 RTS ; PROC ; ; 'USRTAB' -- USFR EXTENDABLE COMMAND TABLE ; ; SAVE STRUCTURE AS 'CTAB' ; ; THE EQUIVALENT 'CDTAB' IS APPENDED TO 'USRTAB' SO THAT ; THE OFFSETS ARE ACTUALLY FROM THE BEGINNING OF 'USRTAB'. ; ; THE TOTAL LENGTH CF 'USRTAB' MAY NOT EXCEED 'USRMAX'. ; ; COMMAND TABLE ; ; CONSISTS OF N ENTRIES, EACH OF THE FOLLOWING FORMAT: ; ; DB " ". ; $80+ [IMMEDIATE]+[RUN]+[: REQUIRED]. ; INDEX TO COMMAND DATA TABLE. ; ; THE TABLE IS ENDED BY "" = 0. ; ORDER OF ENTRIES IS ONLY RESTRICTED BY FIRST FOUND - FIRST MATCHED, NOT BEST FIT. ; SB = $80 ; SIGN BIT. CTIMM = $40 ; IMMEDIATE COMMAND. CTRUN = $20 ; RUN COMMAND. CTCLN = $10 ; : REQUIRED. CTBOTH = CTIMM+CTRUN ; IMMEDIATE OR RUN COMMAND. CTNORM = CTBOTH+CTCLN-CTCLN ; IMMEDIATE OR RUN COMMAND, : REQUIRED. CTAB = * ; INTERNAL COMMAND TABLE BASE ADDRESS. .BYTE 'DELAY',SB+CTNORM,L12_CDSPD-CDTAB ; DELAY. .BYTE 'LIST',SB+CTIMM,L12_CDLST-CDTAB ; LIST STORED PROGRAM. .BYTE 'DEL',SB+CTIMM,L12_CDDEL-CDTAB ; DELETE RANGE OF LINES. .BYTE 'RUN',SB+CTIMM,L12_CDRUN-CDTAB ; RUN STORED PROGRAM. .IF DOS .BYTE 'DOS',SB+CTIMM,L12_CDDOS-CDTAB ; GO TO DOS UTILITY. .ENDIF .BYTE 'SAVE',SB+CTIMM,L12_CDSAV-CDTAB ; SAVE STORED PROGRAM. .BYTE 'NEW',SB+CTIMM,L12_CDNEW-CDTAB ; CLEAR PROGRAM & VARS. .BYTE 'AUTO',SB+CTIMM,L12_CDAUT-CDTAB ; AUTO-INPUT. .BYTE 'REN',SB+CTIMM,L12_CDREN-CDTAB ; RENUMBER PROGRAM. .BYTE 'CONT',SB+CTIMM,L12_CDCON-CDTAB ; CONTINUE. .BYTE 'PS',SB+CTIMM,L12_CDCOL-CDTAB ; TURTLE PEN STATUS. .BYTE 'ES',SB+CTIMM,L12_CDENS-CDTAB ; TURTLE ENVIRONMENT STATUS. .BYTE 'COLORS',SB+CTIMM,L12_CDPAL-CDTAB ; PALETTE OF COLORS. .BYTE 'DIR', SB+CTIMM,L12_CDDIR-CDTAB ; DISK DIRECTORY. .BYTE 'HELP',SB+CTIMM,L12_CDCOM-CDTAB ; COMMAND LIST. .BYTE 'DUMP',SB+CTBOTH,L12_CDDMP-CDTAB ; DUMP. .BYTE 'LOAD',SB+CTBOTH,L12_CDLOD-CDTAB ; LOAD. .BYTE 'MERGE',SB+CTIMM,L12_CDMRG-CDTAB ; MERGE. .BYTE 'APPEND',SB+CTIMM,L12_CDAPP-CDTAB ; APPEND. .BYTE 'TRACE',SB+CTBOTH,L12_CDTRC-CDTAB ; TRACE. .BYTE 'VNEW',SB+CTBOTH,L12_CDNWV-CDTAB ; VNEW. .BYTE 'TV',SB+CTBOTH,L12_CDTV-CDTAB ; TV. .BYTE 'CALL',SB+CTNORM,L12_CDCAL-CDTAB ; CALL. .BYTE 'TAPE',SB+CTNORM,L12_CDCSS-CDTAB ; CASSETTE ON/OFF. .BYTE 'TSYNC',SB+CTNORM,L12_CDSNC-CDTAB ; CASSETTE SYNC. .BYTE 'READ' ,SB+CTNORM,L12_CDIN-CDTAB ; READ RECORD. .BYTE 'WRITE',SB+CTNORM,L12_CDOUT-CDTAB ; WRITE RECORD. .BYTE 'CLOSE',SB+CTNORM,L12_CDDON-CDTAB ; CLOSE FILE. .BYTE 'T',SB+CTNORM,L12_CDT-CDTAB ; TYPE. .BYTE 'LETTERS',SB+CTRUN,L12_CDLTR-CDTAB ; LETTERS .BYTE 'AK',SB+CTNORM,L12_CDAK-CDTAB ; ACCEPT KEYSTROKE. .BYTE 'AX',SB+CTNORM,L12_CDAX-CDTAB ; ACCEPT LITERAL. .BYTE 'A',SB+CTNORM,L12_CDA-CDTAB ; ACCEPT. .BYTE 'C',SB+CTNORM,L12_CDC-CDTAB ; COMPUTE. .BYTE 'U',SB+CTNORM,L12_CDU-CDTAB ; USE. .BYTE 'E',SB+CTNORM,L12_CDE-CDTAB ; END. .BYTE 'JM',SB+CTNORM,L12_CDJM-CDTAB ; JUMP ON MATCH. .BYTE 'J',SB+CTNORM,L12_CDJ-CDTAB ; JUMP. .BYTE 'GR',SB+CTNORM,CDG-CDTAB ; GRAPHICS. .BYTE 'MSX',SB+CTNORM,L12_CDMSX-CDTAB .BYTE 'MS',SB+CTNORM,L12_CDMS-CDTAB ; MATCH (PRODUCING) .BYTE 'MX',SB+CTNORM,L12_CDMX-CDTAB .BYTE 'M',SB+CTNORM,L12_CDM-CDTAB ; MATCH. .BYTE 'SO',SB+CTNORM,L12_CDS-CDTAB ; SOUNDS. .BYTE 'R',SB+CTNORM,L12_CDR-CDTAB ; REMARK. .BYTE 'PA',SB+CTNORM,L12_CDW-CDTAB ; PAUSE. .BYTE 'Y',SB+CTNORM,L12_CDY-CDTAB ; TYPE IF YES. .BYTE 'N',SB+CTNORM,L12_CDN-CDTAB ; TYPE IF NO. .BYTE 'POS',SB+CTNORM,L12_CDPOS-CDTAB ; POSITION. .BYTE 'STOP',SB+CTRUN,L12_CDSTP-CDTAB ; STOP. .BYTE 'SETPEN',SB+CTNORM,L12_CDSTC-CDTAB ; SET COLOR. .BYTE 'SETLET',SB+CTNORM,L12_CDSTL-CDTAB ; SET LETTERS .BYTE 'SCROLL',SB+CTBOTH,L12_CDSCR-CDTAB ; SCROLL SELECT. .BYTE 'SSAVE',SB+CTNORM,L12_CDSSA-CDTAB ; SCREEN SAVE. .BYTE 'SLOAD',SB+CTNORM,L12_CDSLO-CDTAB ; SCREEN LOAD. .BYTE 0 ; END OF TABLE. ; ; SUBCOMMAND TABLES ; ; THERE CAN BE UP TO 128 SUBCOMMAND TABLES. ; THE STRUCTURE OF EACH IS IDENTICAL TO THE COMMAND TABLE EXCEPT: ; THE 'OFFSET' BYTE CAN REPRESENT A 'VALUE', WITH THE ; CALLER DECIDING WHICH. ; ; THE CALLER SELECTS WHICH SUBCOMMAND TABLE BY SETTING ON INDEX ; TO THE TABLE ADDRESS FROM 'SBCTAB'. ; SBCTAB = * ; BASE ADDRESS OF SUBCOMMAND TABLE ADDRESSES OPTABX = *-SBCTAB ; NUMERICAL/RELATONAL OPERATIONS (BINARY). .WORD OPTAB UNTABX = *-SBCTAB ; UNARY OPERATORS. .WORD UNTAB GTABX = *-SBCTAB ; GRAPHICS SUBCOMMAND TABLE. .WORD GTAB PCTABX = *-SBCTAB ; PEN COLOR TABLE. .WORD PCTAB UPDWNX = *-SBCTAB ; UP/DOWN TABLE. .WORD UPDTAB ONOFFX = *-SBCTAB ; ON/OFF COMMAND TABLE. .WORD ONFTAB LTTABX = *-SBCTAB ; LETTERS COMMAND TABLE. .WORD LTRTAB EDTABX = *-SBCTAB ; EDGE COMMAND TABLE. .WORD EDGTAB SCTABX = *-SBCTAB ; SCROLL OPTION TABLE. .WORD SCRLTB WLTABX = *-SBCTAB ; WALL OPTION TABLE. .WORD WALLTB OPTAB = * ; NUMERIC/RELATIONAL OPERATORS (BINARY). .BYTE '+',SB,L12_CDPLS-SBDTAB .BYTE '-',SB,L12_CDSUB-SBDTAB .BYTE '/',SB,L12_CDDIV-SBDTAB .BYTE '*',SB,L12_CDMUL-SBDTAB .BYTE '<>',SB,L12_CDNE-SBDTAB .BYTE '>=',SB,L12_CDGE-SBDTAB .BYTE '<=',SB,L12_CDLE-SBDTAB .BYTE '=',SB,L12_CDEQ-SBDTAB .BYTE '>',SB,L12_CDGT-SBDTAB .BYTE '<',SB,L12_CDLT-SBDTAB .BYTE BSLASH,SB,L12_CDMOD-SBDTAB .BYTE 'AND',SB,L12_CDAND-SBDTAB .BYTE 'OR',SB,L12_CDOR-SBDTAB .BYTE 'XOR',SB,L12_CDXOR-SBDTAB .IF LOGGRP .BYTE 'LAND',SB,L12_CDLAN-SBDTAB .BYTE 'LOR',SB,L12_CDLOR-SBDTAB .ENDIF .BYTE 0 ; END OF TABLE. UNTAB = * ; UNARY OPERATORS .BYTE '-',SB,L12_CDUMI-SBDTAB .BYTE 'NOT',SB,L12_CDNOT-SBDTAB .BYTE 'LNOT',SB,L12_CDLNO-SBDTAB .BYTE 0 ; END OF TABLE. GTAB = * ; GRAPHIC SUB-COMMAND TABLE. .BYTE 'DRAWTO',SB,L12_CDDRT-SBDTAB .BYTE 'DRAW',SB,L12_CDDRW-SBDTAB .BYTE 'TURNTO',SB,L12_CDTNT-SBDTAB .BYTE 'TURN',SB,L12_CDTRN-SBDTAB .BYTE 'GOTO',SB,L12_CDGOT-SBDTAB .BYTE 'FILLTO',SB,L12_CDFIT-SBDTAB .BYTE 'FILL',SB,L12_CDFIL-SBDTAB .BYTE 'GO',SB,L12_CDGO-SBDTAB .BYTE 'CHANGE',SB,L12_CDCHG-SBDTAB .BYTE 'PEN',SB,L12_CDPEN-SBDTAB .BYTE 'CLEARPENS',SB,L12_CDCLP-SBDTAB .BYTE 'CLEAR',SB,L12_CDCLR-SBDTAB .BYTE 'QUIT',SB,L12_CDEXI-SBDTAB .BYTE 'FULL',SB,L12_CDFUL-SBDTAB .BYTE 'SPLIT',SB,L12_CDSPT-SBDTAB .BYTE 'WALL',SB,L12_CDWAL-SBDTAB .BYTE 'EDGE',SB,L12_CDEDG-SBDTAB .BYTE 'HOME',SB,L12_CDHOM-SBDTAB .BYTE 'NORTH',SB,L12_CDNRT-SBDTAB .BYTE 'TURTLE',SB,L12_CDTRT-SBDTAB .BYTE 'SHADE',SB,L12_CDSHD-SBDTAB .BYTE 'MODE',SB,L12_CDMDE-SBDTAB .BYTE 'BACKGROUND',SB,L12_CDBCK-SBDTAB .BYTE 'SETH',SB,L12_CDTNT-SBDTAB .BYTE 'SETBG',SB,L12_CDBCK-SBDTAB .BYTE 'CLEAN',SB,L12_CDCLR-SBDTAB .BYTE 'FD',SB,L12_CDDRW-SBDTAB .BYTE 'BK',SB,L12_CDBK-SBDTAB .BYTE 'RT',SB,L12_CDTRN-SBDTAB .BYTE 'LT',SB,L12_CDLTU-SBDTAB .BYTE 'SETPOS',SB,L12_CDDRT-SBDTAB .BYTE 'REPEAT',SB,L12_CDRPT-SBDTAB .BYTE 'ROBOT',SB,L12_CDRBT-SBDTAB .BYTE 'EYES',SB,L12_CDEYS-SBDTAB .BYTE 'RPEN',SB,L12_CDRPN-SBDTAB .BYTE 'HORN',SB,L12_CDHRN-SBDTAB .BYTE 'PD',SB,L12_CDPD-SBDTAB .BYTE 'PU',SB,L12_CDPU-SBDTAB .BYTE 'PE',SB,L12_CDPE-SBDTAB .BYTE 0 ; END OF TABLE. PCTAB = * ; PEN COLOR TABLE. .BYTE 'RED',SB,CRED .BYTE 'YELLOW',SB,CYELLO .BYTE 'GREEN',SB,$C6 .BYTE 'BLUE',SB,CBLUE .BYTE 'BLACK',SB,CBLACK .BYTE 'WHITE',SB,$0E .BYTE 'ORANGE',SB,$F4 .BYTE 'PURPLE',SB,$52 .BYTE 'GRAY',SB,$04 .BYTE 'SILVER',SB,$06 .BYTE 'GOLD',SB,$28 .BYTE 'PINK',SB,$46 .BYTE 'LAVENDER',SB,$64 .BYTE 'BROWN',SB,$E0 .BYTE 'BEIGE',SB,$FE .BYTE 'ERASE',SB,0 UPDTAB = * ; UP/DOWN TABLE. PCTUP .BYTE 'UP',SB,PCUP PCTDN .BYTE 'DOWN',SB,PCDN .BYTE 0 ; END OF TABLE. ONFTAB = * ; ON/OFF COMMAND TABLE. .BYTE 'ON',SB,KON .BYTE 'OFF',SB,KOFF .BYTE 0 ; END OF TABLE. LTRTAB = * ; LETTERS COMMAND TABLE. .BYTE 'SMALL',SB,LSMLL .BYTE 'MEDIUM',SB,LMED .BYTE 'LARGE',SB,LLRG .BYTE 0 ; END OF TABLE. EDGTAB = * ; EDGE COMMAND TABLE. .BYTE 'WRAP',SB,EWRAP .BYTE 'HALT',SB,EHALT .BYTE 'BOUNCE',SB,EBNC .BYTE 'FREE',SB,EFREE .BYTE 0 ; END OF TABLE. SCRLTB = * ; SCROLL OPTION COMMAND. .BYTE 'COARSE',SB,0 .BYTE 'FINE',SB,$FF .BYTE 0 WALLTB = * ; WALL OPTION .BYTE 'NONE',SB,0 .BYTE 0 ; END OF TABLE. ; ; COMMAND DATA TABLE ; ; CONSISTS OF N WORDS, THE INDICES TO THIS TABLE ARE ; CONTAINED IN 'CTAB'. THE TOTAL NUMBER OF BYTES IN THE TABLE MAY NOT ; EXCEED 128. ; ; NOTE: THIS OFFSET IS USED TO 'TOKENIZE' THE COMMAND. ; THE 'MSB' FLAGS THAT THE COMMAND IS IN 'USRTAB', ; THE USER EXTENDABLE COMMAND TABLE. ; ($FE AND $FF ARE RESERVED.) ; ; 'CDTAB' IS SEGMENTED FOR ': CONTINUATION' IN RUN MODE. ; ENTRIES BEFORE 'CLNCNT' ALLOW ': CONTINUATION'? ; OTHER ENTRIES DO NOT. ; CDTAB = * ; COMMAND DATA TABLE BASE ADDRESS. ; ': CONTINUATION' IS VALID IN RUN MODE. L12_CDT .WORD XTYPE L12_CDY .WORD XTYPE2 L12_CDN .WORD XTYPE3 L12_CDR .WORD XREM ; ': CONTINUATION' IS NOT VALID IN RUN MODE. CLNCNT = *-CDTAB L12_CDLST .WORD XLIST L12_CDDEL .WORD XDELET L12_CDDMP .WORD XDUMP L12_CDRUN .WORD XRUN .IF DOS L12_CDDOS .WORD XDOS .ENDIF L12_CDLOD .WORD XLOAD L12_CDMRG .WORD XMERGE L12_CDAPP .WORD XAPPND L12_CDSAV .WORD XSAVE L12_CDAUT .WORD XAUTO L12_CDREN .WORD XREN L12_CDCOL .WORD XCOLRS L12_CDENS .WORD XENVIR L12_CDPAL .WORD XPALET L12_CDDIR .WORD XDIR L12_CDCOM .WORD XCOMM L12_CDCAL .WORD XCALL L12_CDTRC .WORD XTRACE L12_CDCSS .WORD XCASS L12_CDSNC .WORD XCSYNC L12_CDA .WORD XACCPT L12_CDC .WORD XCMPUT L12_CDU .WORD XUSE L12_CDE .WORD XEND L12_CDJM .WORD XJMPM L12_CDJ .WORD XJMP CDG .WORD XGRAPH L12_CDMSX .WORD XMATSX L12_CDMS .WORD XMWSP L12_CDMX .WORD XMATX L12_CDM .WORD XMATCH L12_CDS .WORD XSOUND L12_CDW .WORD XWAIT L12_CDNEW .WORD XNEW L12_CDNWV .WORD XNEWV L12_CDTV .WORD XTV L12_CDIN .WORD XIN L12_CDOUT .WORD XOUT L12_CDDON .WORD XDONE L12_CDPOS .WORD XPOS L12_CDSTC .WORD XSETP L12_CDSTL .WORD XSETL L12_CDLTR .WORD XLETTR L12_CDSPD .WORD XSPEED L12_CDCON .WORD XCONT L12_CDSTP .WORD XSTOP L12_CDAX .WORD XACCX L12_CDAK .WORD XACCK L12_CDSCR .WORD XSCROLL L12_CDSSA .WORD XSSAV L12_CDSLO .WORD XSLOD TABLEN SET *-CDTAB USROFF EQU TABLEN ; USER TOKENS START AT THIS NUMBER. USRMAX EQU TKNCNT-USROFF ; USER TABLE OFFSET MAY NOT EXCEED USRMAX. ; SUBCOMMAND DATA TABLE ; ; CORRESPONDING DATA TABLE ; SBDTAB = * L12_CDPLS .WORD DADDI L12_CDSUB .WORD DSUBI L12_CDDIV .WORD DDIVI L12_CDMUL .WORD DMULI L12_CDNE .WORD DNETI L12_CDGE .WORD DGETI L12_CDLE .WORD DLETI L12_CDEQ .WORD DEQTI L12_CDLT .WORD DLTTI L12_CDGT .WORD DGTTI L12_CDMOD .WORD DMODI L12_CDAND .WORD DANDI L12_CDOR .WORD DORI L12_CDXOR .WORD DXORI .IF LOGGRP L12_CDLAN .WORD DLANDI L12_CDLOR .WORD DLORI .ENDIF L12_CDUMI .WORD DNEGI L12_CDNOT .WORD DNOTI L12_CDLNO .WORD DLNOTI L12_CDDRT .WORD GDRWTO L12_CDDRW .WORD GDRW L12_CDTNT .WORD GTRNTO L12_CDTRN .WORD GTRN L12_CDGOT .WORD GGOTO L12_CDGO .WORD GGO L12_CDFIT .WORD GFILTO L12_CDFIL .WORD GFIL L12_CDPEN .WORD GPEN L12_CDCHG .WORD GCHNGE L12_CDCLP .WORD GCLRPN L12_CDCLR .WORD GCLEAR L12_CDEXI .WORD GEXIT L12_CDFUL .WORD GFULL L12_CDSPT .WORD GSPLIT L12_CDWAL .WORD GWALL L12_CDEDG .WORD GEDGE L12_CDHOM .WORD GHOME L12_CDNRT .WORD GNORTH L12_CDTRT .WORD GTURTL L12_CDSHD .WORD GSHADE L12_CDMDE .WORD GMODE L12_CDBCK .WORD GBACK L12_CDBK .WORD GBK L12_CDLTU .WORD GLT L12_CDRPT .WORD GREPT L12_CDPE .WORD GPE L12_CDPU .WORD GPU L12_CDPD .WORD GPD L12_CDRBT .WORD RONOFF L12_CDEYS .WORD REYES L12_CDRPN .WORD RPEN L12_CDHRN .WORD RHORN TABLEN SET *-SBDTAB ; THIS MUST NOT EXCEED 0100 HEX. ;ASSERT TABLEN<$100 ; PROC ; ; COND -- CONDITIONAL EXECUTION PROCESSOR ; ; CALLING SEQUENCE: ; ; 'INLN' POINTS TO STATEMENT TO BE PROCESSED ; Y = INDEX TO START OF CONDITION. ; 'MATCHF' = 0 (FALSE) OR $FF (TRUE) , RESULT OF PRIOR 'M' COMMAND ; ; JSR COND ; ; Y = INDEX TO ':' IN STATEMENT + 1. ; 'EXECF' = 0 IF STATEMENT IS NOT TO BE EXECUTED. ; ; NOTE: GOES TO 'PSTOP' ON ERROR. ; ; NOTE: 'LOOK AHEAD' CODE FOR GRAPHICS SUBCOMMANDS BEGINNING ; WITH 'Y' OR 'N' ; COND LDA #$FF ; PRESET EXECUTE FLAG. STA EXECF JSR SLB ; GET FIRST CHAR OF CONDITION FIELD. ; VALID CHARACTERS ARE Y,N,(,: ORA #LC ; FORCE LOWER CASE. CMP #'Y'+$20 ; CHECK FOR 'Y' OR 'N' FIRST. BNE L13_CN010 LDA MATCHF ; 'Y' -- IF 'MATCHF' IS TRUE, RESULT IS TRUE. JMP L13_CN015 L13_CN010 CMP #'N'+$20 BNE L13_CN030 ; NOT 'Y' OR 'N'. ; SPECIAL CASE '(IMPLIED GR:) NORTH' INY LDA (INLN),Y DEY ; POINT INDEX TO 'N'. ORA #LC ; FORCE LOWER CASE. CMP #'O'+$20 ; LOWER CASE 'O'? BEQ L13_CN070 ; YES -- TRY 'NORTH'. LDA MATCHF ; 'N' -- IF 'MATCHF' IS FALSE, RESULT IS TRUE. BEQ L13_CN017 LDA #0 L13_CN015 STA EXECF L13_CN017 INY JSR SLB ; GET NEXT NON-BLANK CHARACTER. L13_CN030 LDA (INLN),Y CMP #'(' ; SEE IF ARITHMETIC EXPRESSION. BNE L13_CN050 ; NO -- ALL DONE. JSR EXPP ; EVALUATE EXPRESSION IN PARENS. LDA EXPSTK+1 ; SEE IF RESULT > ZERO. BMI L13_CN032 ; NO -- NEGATIVE. BNE L13_CN040 ; YES -- POSITIVE & NON-ZERO. LDA EXPSTK ; NOT SURE -- TEST LSB. BNE L13_CN040 ; POSITIVE & NON-ZERO. L13_CN032 LDA #0 ; NO -- CONDITION FALSE. STA EXECF L13_CN040 JSR SLB ; GET NEXT NON-BLANK CHARACTER. L13_CN050 CMP #':' ; COLON? BNE L13_CN080 ; NO. INY ; SKIP OVER ':'. L13_CN070 RTS ; ':-REQUIRED' ATTRIBUTE ONLY AVAILABLE DURING SYNTAX CHECK. L13_CN080 LDA EXEC ; CHECK ': REQUIRED'? BNE L13_CN070 ; NO. LDA #CTCLN ; ':' REQUIRED FOR THIS COMMAND? BIT CTABAT BEQ L13_CN070 ; NO. DEY LDA #CNDERR ; YES -- ERROR. JMP PSTOP ; PROC ; ; ATOM -- FIND, IDENTIFY & EVALUATE THE NEXT ATOM IN THE STATEMENT LINE. ; ; CALLING SEQUENCE: ; ; 'INLN' POINTS TO THE STATEMENT LINE. ; Y = INDEX TO END OF PRIOR ATOM + 1. ; ; JSR ATOM ; BNE SYNTAX ERROR ; ; A = ATOM IDENTIFIER CODE ; Y = INDEX TO END OF ATOM 1 (OR BEGINNING OF ATOM FOR TEXT TYPE). ; 'NUMBER' = VALUE OF NUMERIC CONSTANT OR NUMERIC VARIABLE IF 'EXEC'. ; 'POINT' = ADDRESS OF NUMERIC VARIABLE OR OPERATOR ROUTINE IF 'EXEC'. ; 'NP' POINTS TO STRING VARIABLE NAME. ; 'DP' POINTS TO STRING VARIABLE VALUE (IF DEFINED). ; ATOM JSR SLB ; SKIP LEADING BLANKS, IF PRESENT. ; *** INTERNAL RE-ENTRY POINT *** ATOM2 JSR CHKTRM ; NULL ATOM (STATEMENT TERMINATOR)? BEQ L14_AT100 ; YES. CMP #'#' ; NUMERIC VARIABLE? BEQ L14_AT200 ; YES. CMP #'@' ; POINTER? BNE L14_AT002 ; NO. JMP L14_AT250 ; YES. L14_AT002 CMP #'$' ; STRING VARIABLE? BNE L14_AT003 ; NO. JMP L14_AT300 ; YES. L14_AT003 CMP #'%' ; JOYSTICK/PADDLE/LIGHTPEN? BNE L14_AT005 ; NO. JMP L14_AT700 ; YES. L14_AT005 JSR CNUMBR ; NUMERIC LITERAL? BCS L14_AT010 ; NO JMP L14_AT400 ; YES. L14_AT010 LDX #OPTABX ; SPECIAL OPERATOR? JSR SBCMAT BNE L14_AT020 ; NO. JMP L14_AT600 ; YES. L14_AT020 LDA (INLN),Y ; RESTORE CHAR. JSR CLETTR ; CONTEXT DEPENDENT TEXT? BCS L14_AT099 ; NO. JMP L14_AT500 ; YES. L14_AT099 LDA #ATMERR ; NONE OF THE ABOVE -- ERROR. RTS ; RETURN WITH CC SET. ; NULL ATOM -- L14_AT100 LDA #NULL JMP ATMRET ; NUMERIC VARIABLE -- #. L14_AT200 INY LDA (INLN),Y ; CHECK CHARACTER AFTER '#'. JSR CKEOA BEQ L14_AT099 LDA INLN ; SET NAME POINTER TO NAME. STA NP LDA INLN+1 STA NP+1 STY NP+2 JSR SCEOA ; SCAN TO END OF ATOM. ; SKIP NUMBERIC VARIABLE LOCKUP IF NOT (EXEC). LDA EXEC BEQ L14_AT220 STY NP+3 ; SAVE LINE INDEX ; ENTRY TO 'FIND' A "JUST - DEFINED" VARIABLE. L14_AT205 JSR SETSVL ; SET LIST POINTER TO VARIABLES. LDA #ATRNUM ; 'NUMERIC' ATTRIBUTE. STA ATRTYP JSR SFIND ; FIND VARIABLF IF DEFINED. BEQ L14_AT210 ; DEFINED. LDA #0 ; DATA = 00. STA NUMBER STA NUMBER+1 STA DP+2 ; *S* LDA # HIGH NUMBER STA DP+1 LDA # L14_AT250 INY ; EXAMINE CHARACTER AFTER '@'. LDA (INLN),Y ORA #LC ; FORCE LOWER CASE. CMP #'B'+$20 ; POINTER TO BYTE? PHP ; SAVE ANSWER. BNE L14_AT255 ; NO -- POINTER TO WORD. INY ; YES -- SKIP OVER 'B'. L14_AT255 LDA (INLN),Y ; GET CHARACTER FOR RECURSIVE CALL. JSR ATOM2 ; SEE WHAT FOLLOWS *** RECURSIVE CALL ***. BNE L14_AT290 ; ERROR. AND #NVAR+NUM ; MUST BE NUMERIC. BEQ L14_AT290 ; ERROR. LDA NUMBER ; RESULT IS ADDRESS OF DATA. STA POINT LDA NUMBER+1 STA POINT+1 STY TEMP ; SAVE LINE INDEX. LDY #0 ; GET DATA VALUE NOW. LDA (POINT),Y STA NUMBER PLP ; POINTER TO BYTE? BNE L14_AT260 ; NO -- POINTER TO WORD. STY NUMBER+1 ; YES MSB = 0. LDA #BPTR ; TYPE = POINTER TO BYTE. BNE L14_AT270 ; (BRA). L14_AT260 INY LDA (POINT),Y ; GET MSB OF DATA WORD. STA NUMBER+1 LDA #NVAR ; TYPE = POINTER TO WORD. L14_AT270 LDY TEMP ; RESTORE LINE INDEX. BNE L14_AT340 ; (BRA) SKIP TO NORMAL RETURN. L14_AT290 PLP ; CLEANUP STACK BEFORE RETURN. L14_AT299 JMP L14_AT099 ; ERROR RETURN (EXTENDED BRANCH) ; STRING VARIABLE -- $ L14_AT300 INY ; EXAMINE CHARACTER AFTER 'S'. LDA (INLN),Y CMP #'$' ; STRING INDIRECTION? BEQ L14_AT350 ; YES. JSR CKEOA ; NO -- STRING NAME ERROR? BEQ L14_AT299 ; YES. LDA INLN ; NO -- SET NAME POINTER TO NAME STA NP LDA INLN+1 STA NP+1 STY NP+2 JSR SCEOA ; SCAN TO END OF ATOM. STY NP+3 ; SAVE END INDEX. L14_AT320 TYA ; SAVE LINE INDEX. PHA JSR SETSVL ; SET LIST POINTER TO STRING VARIABLES. LDA #ATRSTR ; 'STRING' ATTRIBUTE. STA ATRTYP JSR SFIND ; FIND VARIABLE IF DEFINED. BNE L14_AT330 ; UNDEFINED. PLA ; RESTORE LINE INDEX. TAY LDA #SVAR ; DEFINED STRING VARIABLE. BNE L14_AT340 ; (BRA) TO 'ATMRET'. L14_AT330 PLA ; RESTORE LINE INDEX. TAY LDA #USVAR ; UNDEFINED STRING VARIABLE. L14_AT340 JMP ATMRET ; *** SKIP BRANCH POINT *** L14_AT350 JSR L14_AT300 ; INDIRECTION -- GET NAME *** RECURSIVE CALL ***. BNE L14_AT360 ; ERROR. CMP #USVAR ; UNDEFINED STRING? BEQ L14_AT340 ; YES -- ALL DONE. STY TEMP ; DEFINED -- USE DATA AS NAME FOR TARGET LDX #NP-DTAB LDY #DP-DTAB JSR PMOVE LDY TEMP BNE L14_AT320 ; (BRA) NOW GET STRING. L14_AT360 RTS ; NUMERIC LITERAL -- L14_AT400 LDX #INLN-DTAB ; POINT TO POINTER. JSR ASCDEC ; CONVERT TO BINARY, RESULT TO 'NUMBER'. LDA #NUM BNE L14_AT340 ; (BRA) TO 'ATMRET'. ; TEXT -- L14_AT500 LDA #TEXT BNE L14_AT340 ; (BRA) TO 'ATMRET' ; OPERATOR -- L14_AT600 LDA SBDTAB,X ; GET OPERATE ROUTINE ADDRESS. STA POINT LDA SBDTAB+1,X STA POINT+1 LDA #OPR BNE L14_AT340 ; (BRA) TO 'ATMRET'. ; EVALUATE EXPRESSION -- %() L14_AT620 JSR EXPP ; EVALUATE NEXP IN PARENS. LDA EXPSTK ; PASS BACK RESULT. LDX EXPSTK+1 JMP L14_AT781 ; CONTROLLERS -- % OR % OR % L14_AT720 JMP L14_AT099 ; ERROR. L14_AT700 INY ; SKIP OVER '%'. LDA (INLN),Y ; GET NEXT CHARACTER. CMP #'(' ; EVAL? BEQ L14_AT620 ; YES. ORA #LC ; FORCE LOWER CASE. CMP #'P'+$20 ; PADDLE CONTROLLER? BEQ L14_AT730 ; YES. CMP #'N'+$20 ; PEN NUMBER? BNE L14_AT703 ; NO. JMP L14_AT960 ; YES. L14_AT703 CMP #'K'+$20 ; KEY PRESS READ? BEQ L14_AT735 ; YES. CMP #'F'+$20 ; FREE MEMORY? BEQ L14_AT740 ; YES. CMP #'J'+$20 ; JOYSTICK? BEQ L14_AT760 ; YES. CMP #'T'+$20 ; TRIGGER? BEQ L14_AT770 ; YES. CMP #'S'+$20 ; TURTLE SENSORS? BNE L14_AT705 ; NO. JMP L14_AT950 ; YES. L14_AT705 CMP #'X'+$20 ; GRAPHICS X? BEQ L14_AT782 ; YES. CMP #'Y'+$20 ; GRAPHICS Y? BEQ L14_AT784 ; YES. CMP #'Z'+$20 ; GRAPHICS PIXEL VALUE. BEQ L14_AT788 ; YES. CMP #'A'+$20 ; GRAPHICS THETA ANGLE? BEQ L14_AT786 ; YES. .IF LITPEN CMP #'H'+$20 ; LIGHTPEN HORIZONTAL? BEQ L14_AT790 ; YES. CMP #'V'+$20 ; LIGHTPEN VERTICAL? BEQ L14_AT795 ; YES. CMP #'L'+$20 ; LIGHTPEN TRIGGER? BEQ L14_AT796 ; YES. .ENDIF CMP #'M'+$20 ; MATCH RESULT? BNE L14_AT720 ; NO. JMP L14_AT798 ; YES. ; READ PADDLE CONTROLLER L14_AT730 JSR L14_AT800 ; GET VALUE THAT FOLLOWS 'R'. BNE L14_AT761 ; ERROR. AND #$07 ; PADDLE # MODULO 8. TAX SEC ; (CLEAR BORROW). LDA #228 ; RESULT = 228 - VALUE READ. SBC PADDL0,X JMP L14_AT780 L14_AT735 INY ; SKIP OVER 'K'. LDA CH ; KEYCODE READY? SEC SBC #$FF BEQ L14_AT737 ; NO. LDA #1 ; YES. L14_AT737 JMP L14_AT780 ; CALCULATE FREE MEMORY L14_AT740 INY ; SKIP OVER 'F'. SEC LDA S2L ; 'NUMBER' = 'S2L' - 'S1H' + 1. SBC S1H STA NUMBER LDA S2L+1 SBC S1H+1 STA NUMBER+1 INC NUMBER BNE L14_AT745 INC NUMBER+1 L14_AT745 LDA #NUM ; TYPE = NUMBER. JMP ATMRET ; READ JOYSTICK L14_AT760 JSR L14_AT800 ; GET VALUE THAT FOLLOWS 'J'. L14_AT761 BNE L14_AT890 ; ERROR *** SKIP BRANCH POINT *** AND #$03 ; JOYSTICK # MODULO 4. TAX LDA STICK0,X ; GET JOYSTICK DATA FROM DATA BASE. EOR #$0F ; INVERT DATA READ. JMP L14_AT780 ; READ TRIGGER L14_AT770 JSR L14_AT800 ; GET VALUE THAT FOLLOWS 'T'. BNE L14_AT890 ; ERROR. AND #$0F ; TRIGGER # MODULO 16. TAX LDA PTRIG0,X ; RESULT = SINGLE BIT. EOR #$FF AND #$01 ; *** ENTRY FOR TURTLE SENSORS ***. L14_AT780 LDX #0 ; M.S.B. = 0. L14_AT781 STA NUMBER ; STORE RESULT. STX NUMBER+1 LDA #NUM ; NUMERIC RESULT. BNE ATMRET ; (BRA). ; GRAPHICS PARAMETERS L14_AT782 LDX #GX-DTAB ; GRAPHICS X COORDINATE. BCS L14_AT900 ; (BRA). L14_AT784 LDX #GY-DTAB ; GRAPHICS Y COORDINATE. BCS L14_AT900 ; (BRA). L14_AT786 LDA THETA ; GRAPHICS THETA ANGLE. LDX THETA+1 INY BNE L14_AT781 ; (BRA). L14_AT788 INY JSR GREAD ; READ GRAPHICS DATA. JMP L14_AT780 .IF LITPEN ; READ LIGHTPEN L14_AT790 LDA LPENH ; LIGHTPEN HORIZONTAL VALUE. BCS L14_AT797 ; (BRA). L14_AT795 LDA LPENV ; LIGHTPEN VERTICAL VALUE. BCS L14_AT797 ; (BRA). L14_AT796 LDA STICK0 ; GET LIGHTPEN TRIGGER. EOR #$01 ; INVERT BIT OF INTEREST. AND #$01 L14_AT797 LDX EXEC ; EXECUTE MODE? BEQ L14_AT79B ; NO. LDX #$0A ; BACKGROUND = LIGHT GPAY. STX COLOR0+4 L14_AT79B INY BNE L14_AT780 ; (BRA). .ENDIF ; READ MATCH FLAG L14_AT798 LDA MATCHF ; MATCH RESULT FLAG. INY BNE L14_AT780 ; (BRA). ; SUBROUTINE TO PROCESS NUMBER FOLLOWING %P, %J & %T. L14_AT800 INY ; SKIP OVER 'P' OR 'J' OR 'T'. JSR ATOM ; *** RECURSIVE CALL ***. BNE L14_AT895 ; ERROR. AND #NVAR+NUM ; NUMERIC RESULT? BEQ L14_AT895 ; NO -- ERROR. LDA NUMBER ; YES. CMP NUMBER ; SET CC FOR NORMAL EXIT. L14_AT890 RTS ; RETURN WITH CC SET. L14_AT895 LDA #ATMERR ; INVALID # AFTER LETTER. RTS ; RETURN WITH CC SET. ; SUBROUTINE TO ROUND & STORE THE GRAPHICS COORDINATES L14_AT900 INY LDA DTAB+2,X ; GET FRACTIONAL PORTION. ROL ; MSB OF FRACTION TO CARRY BIT. LDA DTAB+0,X ; ROUND LSB. ADC #0 STA NUMBER LDA DTAB+1,X ; CARRY TO MSB. ADC #0 STA NUMBER+1 LDA #NUM ; NUMERIC RESULT. ATMRET STA TEMP ; SET CC FOR EXIT. CMP TEMP RTS ; TURTLE SENSORS ; ; %S = ROBOT IF ON, ELSE VISIBLE TURTLE. ; %SR = ROBOT. ; %ST = VISIBLE TURTLE. L14_AT950 INY ; SKIP OVER 'S'. LDA (INLN),Y ; GET NEXT CHARACTER. INY ; SKIP OVER NEXT CHARACTER. ORA #LC ; FORCE LOWER CASE. CMP #'R'+$20 ; %SR? BEQ L14_AT952 ; YES. CMP #'T'+$20 ; %ST? BEQ L14_AT954 ; YES. DEY ; %S. LDA RBTON ; ROBOT OR VISIBLE? BEQ L14_AT954 ; VISIBLE. L14_AT952 LDA RBTON ; SENSORS = 0 IF ROBOT OFF. BEQ L14_AT780 ; OFF. JSR RRDSNS ; ROBOT. JMP L14_AT780 L14_AT954 LDA EXEC ; EXECUTE MODE? BEQ L14_AT956 ; NO. JSR VTSENS LDA TRTSNS ; VISIBLE. L14_AT956 JMP L14_AT780 ; %N = TURTLE PEN NUMBER L14_AT960 INY ; SKIP OVER 'N'. LDA PEN ; GET PEN #. JMP L14_AT780 ; PROC ; ; XTYPE -- TYPE COMMAND PROCESSOR ; XTYPE JSR TEXP ; PROCESS TEXT EXPRESSION. LDA EXEC ; EXECUTE MODE? BEQ L15_XT090 ; NO. JSR TSTMOD ; CHECK SCREEN MODE. CMP #GRFS ; FULL SCREEN GRAPHICS. BNE L15_XT005 ; NO. LDA #NRCERR ; YES -- ERROR. RTS L15_XT005 LDX TELN+3 ; CHECK FOR NULL TEXT. BEQ L15_XT010 ; NULL. LDA TEXBUF-1,X ; NON-NULL -- CHECK FINAL CHARACTER. CMP #BSLASH ; IS IT EOL SUPPRESS? BNE L15_XT010 ; NO. DEC TELN+3 ; YES -- SUPPRESS ALSO. JMP L15_XT020 L15_XT010 LDA #EOL ; INSERT EOL. STA TEXBUF,X INC TELN+3 ; TYPE WITH WORD SPLIT AVOIDANCE. L15_XT020 STY XTEMP+1 ; SAVE STATEMENT INDEX. LDY TELN+2 ; STARTING INDEX. CPY TELN+3 BEQ L15_XT080 ; NULL OUTPUT -- ALL DONE. L15_XT022 STY XTEMP ; SAVE INDEX. LDX COLCRS ; GET CURRENT CURSOR POSITION. LDA GRFLAG ; DIFFERENT CURSOR IF SPLIT SCREEN. BEQ L15_XT025 LDX TXTCOL ; SPLIT SCREEN -- USE OTHER CURSOR. L15_XT025 STX XTEMP+2 ; SAVE STARTING COLUMN #. DEX ; PRE-CONDITION THE INDEX. L15_XT030 LDA (TELN),Y ; FIND LENGTH OF NEXT WORD. INX INY CPY TELN+3 BEQ L15_XT035 ; END OF TEXT. CMP #' ' ; SPACE? BNE L15_XT030 ; NO -- KEEP SCANNING. L15_XT035 LDY XTEMP ; END OF WORD -- CHECK FOR WORD SPLIT. CPX RGCOL ; DOES IT WRAP SCREEN? BEQ L15_XT040 ; NO -- OUTPUT IT. BCC L15_XT040 ; NO -- OUTPUT IT. LDA XTEMP+2 ; YES -- IS THIS THE 1ST WORD OF LINE? CMP LFCOL BEQ L15_XT040 ; YES -- FORGET ABOUT NEW LINE. JSR NEWLIN ; NO -- START A NEW LINE. L15_XT040 LDA (TELN),Y ; OUTPUT THE WORD JUST SCANNED. CMP #' ' ; SPACE? BNE L15_XT050 ; NO. CPX RGCOL ; YES -- IS IT THE LAST POSITION? BNE L15_XT050 ; NO. LDA #EOL ; YES -- CHANGE TO EOL. L15_XT050 JSR CHOT ; OUTPUT CHAR. JSR SPDDEL ; DELAY IF SPECIFIED. INY CPY TELN+3 ; END OF TEXT? BEQ L15_XT080 ; YES. DEY LDA (TELN),Y ; SPACE? INY CMP #' ' ; SPACE? BNE L15_XT040 ; NO -- NOT END OF WORD. BEQ L15_XT022 ; YES -- NOW DO NEXT WORD (BRA). L15_XT080 LDY XTEMP+1 ; RESTORE STATEMENT INDEX. LDA #0 ; SET CC FOR EXIT. L15_XT090 RTS ; RETURN WITH CC SET. ; 'Y' COMMAND PROCESSOR XTYPE2 BEQ L15_XT500 ; SYNTAX SCAN ONLY. LDA MATCHF ; Y COMMAND (SAME AS 'TY'). BNE L15_XT500 BEQ L15_XT400 ; 'N' COMMAND PROCESSOR XTYPE3 BEQ L15_XT500 ; SYNTAX SCAN ONLY. LDA MATCHF ; N COMMAND (SAME AS 'TN'). BEQ L15_XT500 ; SKIP BRANCH TO 'XTYPE'. XREM ; REMARK COMMAND PROCESSOR TOO. L15_XT400 JMP SCNEOL ; SCAN TO END OF LINE & RETURN WITH CC SET. L15_XT500 JMP XTYPE ; PROC ; ; XPOS -- POSITION COMMAND PROCESSOR ; XPOS JSR EXP ; COLUMN NUMBER. LDA EXEC ; EXECUTE MODE? BEQ L16_XP020 ; NO. JSR TSTMOD ; CHECK SCREEN MODE. CMP #GRFS ; FULL GRAPHICS? BEQ L16_XP080 ; YES -- IGNORE COMMAND. LDA EXPSTK+1 ; RANGE CHECK THE COLUMN #. BNE L16_XP900 ; TOO LARGE. LDA EXPSTK+0 ; PAST RIGHT MARGIN? CMP RGCOL BEQ L16_XP010 BCS L16_XP900 ; YES -- TOO LARGE. L16_XP010 STA COLCRS ; O.K. -- STORE IT. STA TXTCOL ; SPLIT SCREEN TOO. L16_XP020 JSR SKPSEP ; SKIP SEPARATOR. JSR EXP ; ROW NUMBER. LDA EXEC ; EXECUTE MODE? BEQ L16_XP090 ; NO. LDA TRACE ; TRACE EXECUTION? ORA SGLSTP BNE L16_XP080 ; YES -- IGNORE THIS COMMAND. LDA EXPSTK+1 ; RANGE CHECK THE ROW 4. BNE L16_XP900 ; TOO LARGE. LDA EXPSTK+0 CMP BOTSCR BCS L16_XP900 ; TOO LARGE. STA ROWCRS ; O.K. -- STORE IT. STA TXTROW ; SPLIT SCREEN TOO. L16_XP080 LDA #0 ; SET CC FOR NORMAL EXIT. L16_XP090 RTS ; RETURN WITH CC SET. L16_XP900 LDA #IMPERR ; COLUMN/ROW OUT OF RANGE. RTS ; RETURN WITH CC SET. ; PROC ; ; XEND -- END STATEMENT PROCESSOR ; XEND BEQ L17_XE090 ; SYNTAX SCAN ONLY. LDX USTKP ; USE STACK POINTER. BEQ L17_XE095 ; STACK EMPTY. STX RUN ; SET RUN MODE EVEN IF ALREADY SET. DEX ; GET NEXT LINE ADDRESS FROM STACK. DEX STX USTKP LDA USESTK,X STA NXTLN LDA USESTK+1,X STA NXTLN+1 L17_XE090 LDA #0 ; O.K. -- SET CC FOR EXIT. RTS L17_XE095 JSR CLOSEM ; CLOSE ALL OPEN FILES. STY XTEMP JSR REMDEV LDY XTEMP LDA #ENDERR ; STOP CONDITION. STA NOCONT ; NO CONTINUE AFTER END. RTS ; PROC ; ; XSTOP -- STOP COMMAND PROCESSOR ; XSTOP BEQ L18_XS090 ; SYNTAX SCAN ONLY. LDA #STPMES ; GENERATE STOP MESSAGE. L18_XS090 RTS .IF DOS ; PROC ; ; XDOS -- DOS COMMAND PROCESSOR ; XDOS BEQ L19_XD090 ; SYNTAX SCAN ONLY. STA COLDST ; SETUP FOR COLDSTART ON RESET. JSR TXOPEN ; OPEN TEXT SCREEN. JMP (DSVSAV) ; YES. L19_XD090 RTS .ENDIF ; PROC ; ; XRUN -- RUN COMMAND PROCESSOR ; XRUN JSR SLB ; 'RUN '? JSR CHKTRM BEQ L20_XR005 ; YES. ; ASSUME 'RUN ' - SHARP 'LOAD' CODE. JSR XLO100 ; OPEN DEVICE. BNE L20_XR090 ; ERROR. LDA EXEC ; EXECUTE MODE? BEQ L20_XR003 ; NO. STA RUN ; YES -- SET RUN MODE. JSR L20_XR020 ; INITIALIZE ENVIRONMENT. L20_XR003 JMP XLO005 ; NOW LET LOAD DO THE SETUP. L20_XR005 LDA EXEC ; EXECUTE MODE? BEQ L20_XR090 ; NO. STA RUN ; YES -- ENTER RUN MODE. ; *** EXTERNAL ENTRY POINT FROM 'MLOOP' *** XRN010 JSR XNEWV ; CLEAR ALL VARIABLES. L20_XR020 LDA S1L ; SETUP THE NEXT LINE POINTER. STA NXTLN LDA S1L+1 STA NXTLN+1 JSR GCLEAR ; CLEAR SCREEN. JSR GPINIT ; INITIALIZE GRAPHICS PARAMETERS STY XTEMP JSR NULACC ; SET ACCEPT BUFFER TO NULL. LDY XTEMP LDA #0 ; MAKE MATCH FLAG FALSE ... STA USTKP ; ... USE STACK INDEX ... STA MATCHF ; ... & SET CC ALSO. STA NOCONT ; CONTINUE O.K. L20_XR090 RTS ; PROC ; ; XCONT -- CONTINUE COMMAND PROCESSOR ; XCONT BEQ L21_XC090 ; SYNTAX SCAN ONLY. LDX NOCONT ; CONTINUE O.K.? BNE L21_XC100 ; NO -- INFORM OPERATOR. STA RUN ; YES -- ENTER RUN MODE. LDA #0 ; SET CC FOR NORMAL RETURN. L21_XC090 RTS L21_XC100 LDA #CNTERR ; CONTINUE ERROR. RTS ; PROC ; ; XACCPT -- ACCEPT COMMAND PROCESSOR ; XACCPT LDA #0 ; STANDARD ACCFPT. STA AKFLAG STA AXFLAG ; *** EXTERNAL ENTRY POINT FROM 'XACCX' AND 'XACCK' *** L22_XA001 JSR CHKEQS ; '='? BNE L22_XA003 ; NO OR NOT YET. LDA #NULL ; SETUP FOR NULL TARGET. STA XTEMP BNE L22_XA022 ; (BRA). L22_XA003 JSR ATOM ; CHECK FOR VARIABLE. BNE L22_XA009 ; ERROR. STA XTEMP ; SAVE ATOM TYPE. AND #SVAR+USVAR+NVAR+NULL+BPTR BNE L22_XA020 ; VALID ATOM TYPE. LDA #IMPERR ; NONE OF THE ABOVE -- ERROR. L22_XA009 RTS ; RETURN WITH CC SET. L22_XA020 JSR SAVIT ; YES -- SAVE NAME IF STRING TARGET. L22_XA20D JSR CHKEQS ; CHECK FOR ASSIGNMENT OPTION. BEQ L22_XA022 ; YES. LDA EXEC ; EXECUTE MODE? BEQ L22_XA009 ; NO. STY XTEMP+1 ; SAVE STATEMENT INDFX. LDA AKFLAG ; ACCEPT KEY? BNE L22_XA021 ; YES. JSR TSTMOD ; CHECK SCREEN MODE. AND #TXSL+GRSS ; TEXT INPUT O.K.? BNE L22_XA20G ; YES. LDA #NRCERR ; NO -- ERROR. RTS L22_XA20G LDX #TELN-DTAB ; GET A LINE TO THE TEXP BUFFER. JSR GETLIN DEC TELN+3 ; REMOVE EOL. JSR TRAILB ; PROCESS UNDERSCORE IF PRESENT. JMP L22_XA024 L22_XA021 LDA #0 TAY STA ACLN+2 STA TELN+2 LDA #' ' ; LEADING BLANK. STA (ACLN),Y JSR KIN ; GET KEY. STA (TELN),Y INY STY TELN+3 STA (ACLN),Y INY JMP L22_XA030 L22_XA022 INY ; YES -- SKIP OVER '='. LDA POINT ; SAVE 'POINT'. STA GNUMB LDA POINT+1 STA GNUMB+1 JSR TEXP ; EVALUATE TEXT EXPRESSION. LDA EXEC ; EXECUTE MODE? BEQ L22_XA009 ; NO. STY XTEMP+1 ; YES -- RESTORE 'NP'. LDY XTEMP+1 LDA GNUMB ; RESTORE 'POINT'. STA POINT LDA GNUMB+1 STA POINT+1 ; *** EXTERNAL ENTRY POINT FROM 'XIN' *** ; EXPECTS: STATEMENT INDEX IN 'XTEMP+1'. ; TARGET ATOM TYPE IN 'XTEMP'. ; 'POINT' OR 'NP' SETUP PER 'ATOM' CALL. ; 'AXFLAG' SET PROPERLY. ; 'SAVIT' CALLED IF STRING TARGET. ; STRING DATA IN 'TEXP'. XAC024 L22_XA024 JSR RESIT ; YES -- RESTORE NAME IF STRING TARGET. LDA TELN+2 ; MOVE START INDEX. STA ACLN+2 TAX TAY LDA AXFLAG ; ACCEPT LITERAL? BEQ L22_XA24T ; NO. L22_XA24D CPX TELN+3 ; DONE? BEQ L22_XA031 ; YES. LDA TEXBUF,X ; NO -- GET NEXT CHAR. INX CPY #ACCLNG ; ACCEPT BUFFER FULL? BEQ L22_XA031 ; YES. STA (ACLN),Y INY JMP L22_XA24D L22_XA24T LDA #' ' ; INSERT LEADING BLANK. BNE L22_XA027 ; (BRA). L22_XA025 CPX TELN+3 ; DONE? BEQ L22_XA030 ; YES. LDA TEXBUF,X ; NO -- GET NEXT CHAR. INX L22_XA026 CPY #ACCLNG-1 BEQ L22_XA030 ; ACCEPT BUFFER FULL. ; CHARACTER CONVERSION HERE. CMP #'A'+$20 ; LOWER CASE ALPHA? BCC L22_XA027 ; NO CMP #'Z'+1+$20 BCS L22_XA027 ; NO. EOR #$20 ; YES -- CONVERT TO UPPER CASE. L22_XA027 STA (ACLN),Y INY CMP #' ' ; BLANK? BNE L22_XA025 ; NO. L22_XA028 CPX TELN+3 ; YES -- SKIP MULTIPLES. BEQ L22_XA031 ; END OF TEXT. LDA TEXBUF,X ; GET NEXT CHARACTER. INX CMP #' ' ; BLANK? BNE L22_XA026 ; NO -- STORE IT. BEQ L22_XA028 ; YES -- IGNORE IT (BRA). L22_XA030 LDA #' ' ; ADD TRAILING BLANK. STA (ACLN),Y INY L22_XA031 STY ACLN+3 ; END INDEX. LDA XTEMP ; CHECK PARAMETER TYPE AGAIN. CMP #NULL BEQ L22_XA190 ; NONE -- ALL DONE. AND #NVAR+BPTR BNE L22_XA100 ; NUMERIC VARIABLE. JMP XCM300 ; STRING VARIABLE -- GO TO COMMON CODE & RET. L22_XA100 LDY #-1 ; CONVERT NUMBER TO BINARY REPRESENTATION. L22_XA110 INY ; SCAN TO NUMBER OR EOL. LDA (TELN),Y ; GET A CHAR. CMP #EOL ; END OF LINE? BEQ L22_XA120 ; YES -- DONE. CMP #'-' ; NO -- MINUS SIGN? BEQ L22_XA120 ; YES -- DONE. JSR CNUMBR ; NO -- NUMERIC DIGIT? BCS L22_XA110 ; NO -- KEEP SCANNING. L22_XA120 LDX #TELN-DTAB ; NOW CONVERT NUMBER WE FOUND. JSR ASCDEC LDY #0 ; MOVE VALUE TO VARIABLE. LDA NUMBER STA (POINT),Y LDA XTEMP ; SEE IF POINTER TO BYTE. CMP #BPTR BEQ L22_XA190 ; YES -- ALL DONE. INY LDA NUMBER+1 STA (POINT),Y L22_XA190 LDY XTEMP+1 ; RESTORE LINE POINTER. LDA #0 ; SET CC FOR NORMAL EXIT. RTS ; RETURN WITH CC SET. ; ; XACCX -- ACCEPT LITERAL COMMAND PROCESSOR. ; XACCX LDA #1 STA AXFLAG LDA #0 STA AKFLAG JMP L22_XA001 ; ; XACCK -- ACCEPT PROM KEYBOARD (SINGLE CHARACTER). ; XACCK LDA #1 STA AKFLAG JMP L22_XA001 ; PROC ; ; XMATCH -- PATCH COMMAND PROCESSOR ; XMATCH LDA #0 ; FORCE UPPER CASE ALPHA. BEQ L23_XM005 XMATX LDA #1 ; LITERAL MATCH. L23_XM005 STA LITMAT LDA (INLN),Y ; GET FIRST MATCH FIELD BYTE. CMP #EOL BNE L23_XM010 LDA #IMPERR ; NULL MATCH FIELD IS ERROR. L23_XM009 RTS ; RETURN WITH CC SET. L23_XM010 JSR TEXP ; EVALUATE TEXT EXPRESSION OPERAND. LDA EXEC ; EXECUTE MODE? BEQ L23_XM009 ; NO -- DONE. LDA #0 ; RESET MATCH FIELD NUMBER AND FLAG. STA MATCHF LDA #',' ; IS DEFAULT MATCH FIELD DELIMITER. STA MFDEL STY XTEMP+1 ; SAVE INPUT INDEX. LDA TELN+2 ; CHECK FOR NULL RESULT. CMP TELN+3 BNE L23_XM011 JMP L23_XM400 ; NULL PATTERN -- NO MATCH. L23_XM011 LDA LITMAT ; LITERAL MATCH? BNE L23_XM020 ; YES. LDY TELN+2 ; NO -- FORCE UPPER CASE ALPHA. L23_XM012 LDA (TELN),Y ; GET CHAR. JSR CLETTR ; IS IT A LETTER? BCS L23_XM015 ; NO. AND #UC ; YESS -- FORCE UPPER CASE. STA (TELN),Y L23_XM015 INY ; NEXT CHAR. CPY TELN+3 ; DONE? BNE L23_XM012 ; NO. ; THROUGHOUT THE MAIN LOOP THE X REGISTER WILL = ACCEPT START INDEX. L23_XM020 LDX ACLN+2 ; ACCEPT BUFFER START INDEX. LDY TELN+2 ; SETUP MATCH PATTERN START INDEX. LDA (TELN),Y ; CHECK FOR ALTERNATE FIELD DELIMITER. CMP #VBAR BNE L23_XM050 ; NO ALTERNATE SPECIFIED STA MFDEL ; SET ALTERNATE. INY ; SKIP OVER VERTICAL BAR. BNE L23_XM060 ; (BRA). L23_XM050 LDA (TELN),Y ; GET 1ST CHAR OF OPERAND. CMP #CRIGHT ; RIGHT ARROW? BNE L23_XM100 ; NO. INX ; YES -- SKIP FIRST CHAR IK ACCEPT BUFFER. INY ; SKIP OVER RIGHT ARROW TOO. CPX ACLN+3 ; NULL ACCEPT BUFFER? BEQ L23_XM400 ; YES -- NO MATCH. L23_XM060 CPY TELN+3 ; NULL OPERAND? BEQ L23_XM400 ; YES. BNE L23_XM050 ; NO (BRA). L23_XM100 STY XTEMP ; MATCH DATA INDEX (INNER LOOP). STY TEMP+1 ; MATCH DATA INDEX (OUTER LOOP). STX TEMP STX ACLN+2 INC MATCHF ; INCREMENT MATCH FIELD NUMBER. L23_XM120 LDY XTEMP ; SEE IF ALL OF PATTERN HAS HATCHED. INC XTEMP CPY TELN+3 BEQ L23_XM300 ; YES. LDA (TELN),Y ; NOT SURE. CMP MFDEL BEQ L23_XM300 ; YES. LDY ACLN+2 ; NO -- MORE DATA TO MATCH? INC ACLN+2 CPY ACLN+3 BEQ L23_XM140 ; NO -- AT END OF BUFFER. CMP (ACLN),Y ; YES -- COMPARE DATA TO PATTERN. BEQ L23_XM120 ; SO FAR SO GOOD. L23_XM140 LDA TEMP+1 ; RESET MATCH PATTERN INDEX. STA XTEMP INC TEMP ; INCREMENT #ACCBUF' INDEX. LDA TEMP STA ACLN+2 CMP ACLN+3 BNE L23_XM120 LDY TEMP+1 ; INCREMENT 'TEXBUP' INDEX TO NEXT FIELD. L23_XM160 LDA (TELN),Y CPY TELN+3 ; END OF MATCH PATTERN DATA? BEQ L23_XM200 ; YES -- NO MATCH. INY CMP MFDEL BNE L23_XM160 ; KEEP SCANNING. CPY TELN+3 ; END OF MATCH STATEMENT? BNE L23_XM100 ; NO. L23_XM200 LDA #0 ; NO MATCH -- RESET FLAG. STA MATCHF BEQ L23_XM400 ; (BRA). L23_XM300 LDA TEMP ; SAVE START & END INDICES TO MATCH FIELD ... STA MATCHX ; ... FOR 'XMWSP'. LDA ACLN+2 STA MATCHX+1 L23_XM400 LDY XTEMP+1 ; RESTORE INPUT LINE INDEX. LDA #0 ; CLEAR LINE INDEX. STA ACLN+2 JMP SCNEOL ; SCAN TO END OF INPUT LINE & RETURN. ; PROC ; ; XMWSP -- MATCH WITH STRING PRODUCTION COMMAND PROCESSOR ; XMATSX JSR XMATX JMP L24_XM005 XMWSP JSR XMATCH ; FIRST DO ALL OF MATCH COMMAND. L24_XM005 BNE L24_XM090 ; SYNTAX ERROR. LDA EXEC ; EXECUTE MODE? BEQ L24_XM090 ; NO -- DONE (SYNTAX SAME AS NATCH). LDA MATCHF ; WAS MATCH SUCCESSFUL? BEQ L24_XM090 ; NO -- ALL DONE. STY XTEMP LDA #ATRSTR ; 'STRING' ATTRIBUTE. STA ATRTYP TXA ; NOW SET SLEFT = DATA FROM ACCEPT START ... LDY MATCHX ; ... TO START OF MATCH - 1. LDX #LFTSTG-STAB JSR MAKSTG BNE L24_XM080 ; ERROR. LDA MATCHX ; THEN SET SMATCH = DATA FROM MATCH. LDY MATCHX+1 LDX #MATSTG-STAB JSR MAKSTG BNE L24_XM080 ; ERROR. LDA MATCHX+1 ; THEN $RIGHT = DATA FROM MATCH +1 ... LDY ACLN+3 ; ... TO END. LDX #RITSTG-STAB JSR MAKSTG L24_XM080 PHP ; SAVE CC. LDY XTEMP ; RESTORE INDEX. PLP L24_XM090 RTS ; RETURN WITH CC SET. MAKSTG STA DP+2 ; DEFINE DATA PORTION. STY DP+3 LDA ACLN STA DP LDA ACLN+1 STA DP+1 LDA STAB,X ; DEFINE NAME PORTION. STA NP+3 INX STX NP+2 LDA #STAB STA NP+1 JSR SETSVL ; NAMED STRING VARIABLE LIST. JMP SINSRT ; INSERT STRING & RETURN WITH CC SET. STAB = * ; MATCH STRING NAME TABLE. LFTSTG .BYTE LSEND,'LEFT' LSEND = *-STAB MATSTG .BYTE MSEND,'MATCH' MSEND = *-STAB RITSTG .BYTE RSEND,'RIGHT' RSEND = *-STAB ; PROC ; ; XNEWV -- NEW VARIABLES COMMAND PROCESSOR ; XNEWV LDA EXEC ; EXECUTE MODE? BEQ L25_XN090 ; SYNTAX SCAN ONLY. LDA S2H ; CLEAR MOD VARIABLES. STA S2L LDA S2H+1 STA S2L+1 JSR CLOSEM ; CLOSE IOCBS 3 THROUGH 7. LDA RUN ; RUN MODE? BNE L25_XN090 ; YES -- DON'T PRINT 'READY'. JSR RDYMES ; NO -- PRINT 'READY'. XNE090 L25_XN090 LDA #0 ; SET CC FOR EXIT. RTS ; RETURN WITH CC SET. ; PROC ; ; XNEW -- NEW PROGRAM PROCESSOR ; XNEW BEQ XNE090 ; SYNTAX SCAN ONLY. JSR CLRPRG ; CLEAR THE PROGRAM STORAGE AREA. BEQ XNEWV ; (BRA) NOW CLEAR THE VARIABLES ALSO CLRPRG LDA S1L ; YES -- CLEAR PROGRAM STORAGE AREA. STA S1H LDA S1L+1 STA S1H+1 LDA #$FF ; NO CONTINUATION. STA NOCONT LDA #0 STA USTKP ; CLEAR USE STACK. RTS ; RETURN WITH CC AND A = ZERO. ; PROC ; ; XCALL -- CALL MEMORY LOCATION PROCESSOR ; XCALL JSR EXP ; ADDRESS SHOULD FOLLOW. LDA EXEC ; EXECUTE MODE? BEQ L27_XC090 ; NO. TYA ; SAVE THE LINE INDEX FOR THE USER. PHA JSR L27_XC100 ; "OFF WE GO, INTO THE WILD BLUE YONDER". PLA ; UNBELIEVEABLE, THE USER RETURNED. TAY ; RESTORE THE LINE INDEX. CLI ; JUST IN CASE! CLD ; DITTO. LDA #0 ; SET CC FOR EXIT. L27_XC090 RTS ; RETURN WITH CC SET. L27_XC100 JMP (EXPSTK) ; TOO LATE TO CHANGE YOUR MIND. ; PROC ; ; XUSE -- USE COMMAND PROCESSOR ; XUSE BEQ XJMP ; LET 'XJMP' PERFORM SYNTAX CHECK. LDA RUN ; IF IMMEDIATE -- DON'T PUT ANYTHING IN STACK BEQ L28_XU100 LDX USTKP ; USE STACK POINTER. CPX #USTKSZ BEQ L28_XU090 ; STACK FULL. LDA NXTLN ; NEXT LINE ADDRESS TO USE STACK. STA USESTK,X LDA NXTLN+1 STA USESTK+1,X INX INX STX USTKP BNE XJP005 ; REST OF COMMAND IS JUST LIKE 'J:' (BRA). L28_XU090 LDA #USOERR ; STACK OVERFLOW ERROR. RTS L28_XU100 STA USTKP ; CLEAR USE STACK. BEQ XJP005 ; (BRA). ; PROC ; ; XJMP -- JUMP COMMAND PROCESSOR ; XJMP BNE XJP005 ; EXECUTE MODE. JMP SCNLBL ; SCAN OVER LABEL & RETURN. ; *** EXTERNAL ENTRY POINT (FROM 'XJMPM' & 'XUSE') *** XJP005 JSR SLB INY ; SKIP OVER '*'. STY DP+2 ; SETUP 'DP' TO POINT TO JUMP LABEL. JSR SCEOA ; SCAN TO END OF LABEL. STY DP+3 LDA INLN STA DP LDA INLN+1 STA DP+1 JSR STMLST ; SETUP TO SCAN STATEMENT LIST. STY XTEMP ; SAVE INPUT LINE POINTER. L29_XJ030 LDX #LP-DTAB ; CHECK FOR END OF STATEMENT LIST. JSR SEND BEQ L29_XJ200 ; END OF LIST -- LABEL NOT FOUND. LDY #6 ; CHECK FOR PRESENCE OF LABEL. L29_XJ032 LDA (LP),Y CMP #' ' ; BLANK? BNE L29_XJ034 ; NO. INY ; SKIP LEADING BLANKS. BNE L29_XJ032 ; (BRA). L29_XJ034 CMP #'*' BNE L29_XJ060 ; NO -- TRY NEXT STATEMENT. INY STY MP+2 ; YES -- SETUP 'MR' TO POINT TO STATEMENT LABEL. L29_XJ040 LDA (LP),Y ; SCAN TO END OF LABEL. INY JSR CKEOA ; END OF ATOM (LABEL)? BNE L29_XJ040 ; NO. DEY STY MP+3 LDA LP ; SETUP POINTERS FOR ... STA MP ; 'SCOMP' CALL ... STA NXTLN ; ... & STATEMENT TO EXECUTE. LDA LP+1 STA MP+1 STA NXTLN+1 JSR SCOMP ; COMPARE LABELS. BNE L29_XJ060 ; NO MATCH. LDY XTEMP ; RESTORE INPUT LINE POINTER. STY RUN ; SET RUN MODE EVEN IF ALREADY SET LDA #0 STA NOCONT RTS ; RETURN WITH CC SET. L29_XJ060 LDX #LP-DTAB ; GET POINTER TO NEXT STATEMENT. JSR SNXTI JMP L29_XJ030 L29_XJ200 LDY DP+2 ; RESTORE LINE INDEX. LDA #UNDERR ; UNDEFINED LABEL. RTS ; RETURN WITH CC SET. ; PROC ; ; XJMPM -- JUMP ON MATCH RESULT COMMAND PROCESSOR ; XJMPM BNE L30_XJ030 ; EXECUTE MODE. JSR SCNLBL ; SCAN OVER FIRST LABEL. BNE L30_XJ090 ; NOT EVEN ONE LABEL -- ERROR. L30_XJ010 JSR SCNLBL ; SCAN OVER REMAINING LABELS. BEQ L30_XJ010 BNE L30_XJ050 ; NORMAL RETURN. L30_XJ030 LDA MATCHF ; WAS PREVIOUS MATCH SUCCESSFUL? BEQ L30_XJ043 ; NO -- NO JUMP. TAX ; YES -- USE FIELD U AS LOOP COUNT. L30_XJ040 DEX BNE L30_XJ045 ; NOT THERE YET. JSR SKPSEP ; PRE-VALIDATE NEXT LABEL. JSR CHKTRM ; END OF STATEMENT? BEQ L30_XJ090 ; YES -- O.K. JSR XJP005 ; LET 'XJMP' DO THE DIRTY WORK. BNE L30_XJ090 ; ERROR. L30_XJ043 JMP SCNEOL ; SCAN TO END OF STATEMENT & RETURN L30_XJ045 JSR SCNLBL ; SCAN OVER LABEL. BEQ L30_XJ040 ; THERE WAS ONE THERE. L30_XJ050 LDA #0 ; TOO FEW LABELS IS O.K. L30_XJ090 RTS ; RETURN WITH CC SET. ; PROC ; ; XDUMP -- STRING & NUMERIC VARIABLE DUMP COMMAND PROCESSOR ; XDUMP JSR SLB ; SKIP LEADING BLANKS. JSR CHKTRM ; STATEMENT TERMINATOR? BEQ L31_XD020 ; YES. CMP #'#' BEQ L31_XD010 ; NUMERIC VARIABLES ONLY. CMP #'$' BEQ L31_XD010 ; STRING VARIABLES ONLY. LDA #IMPERR ; IMPROPER OPERAND. L31_XD009 RTS ; RETURN WITH CC SET. L31_XD010 INY L31_XD020 STA XTEMP ; SAVE OPERAND LDA EXEC BEQ L31_XD009 ; SYNTAX SCAN. STY XTEMP+1 ; YES -- SAVE INPUT LINE INDEX. LDA #CLEAR ; CLEAR SCREEN. JSR CHOT DEC DSPFLG ; SET DISPLAY CONTROL CHARS FLAG. ; DUMP ALL OF THE STRING VARIABLES LDA XTEMP ; CHECK OPERAND. CMP #'#' ; NUMERIC ONLY? BEQ L31_XD050 ; YES. LDA #16 ; PRODUCE STRING VARIABLE HEADER. JSR MESSOT LDA #ATRSTR ; STRINGS. STA DMPTYP JSR DMPVAR ; DUMP ALL OF THE NUMERIC VARIABLES. LDA XTEMP ; CHECK OPERAND. CMP #'$' ; STRING ONLY. BEQ L31_XD060 ; YES. L31_XD050 LDA #17 ; NUMERIC VARIABLE HEADER. JSR MESSOT LDA #ATRNUM ; NUMERIC. STA DMPTYP JSR DMPVAR ; DUMP THE I/O'S. L31_XD060 LDA XTEMP ; CHECK OPERATOR. LDY XTEMP+1 ; RESTORE INDEX. JSR CHKTRM ; TERMINATOR? BNE L31_XD090 ; NO -- '$' OR '#'. LDA #35 ; I/O HEADER. JSR MESSOT LDA #ATRIO ; I/O'S STA DMPTYP JSR DMPVAR ; DUMP THE CONTENT OF THE STACK. LDA #18 ; PRODUCE USE STACK HEADER. JSR MESSOT LDX USTKP ; STACK EMPTY? BEQ L31_XD088 ; YES. L31_XD087 JSR SPACE ; NO -- PRINT LINE #(S). LDA USESTK-2,X ; GET POINTER TO STORED LINE STA POINT LDA USESTK-1,X STA POINT+1 JSR GTLNNO ; EXTRACT LINE NUMBER. STX XTEMP+2 LDX #LINENO-DTAB ; PRINT LINE NUMBER. JSR DECASC LDX XTEMP+2 DEX DEX BNE L31_XD087 ; MORE TO PRINT. ; DUMP THE GRAPHICS PARAMETERS L31_XD088 LDA #19 ; PRODUCE GRAPHICS HEADER. JSR MESSOT LDA #'X' ; X=FLOOR(). JSR CHOT JSR PRTEQS ; '='. LDX #GX-DTAB JSR DECASC JSR SPACES LDA #'Y' ; Y=FLOOR(). JSR CHOT JSR PRTEQS ; '='. LDX #GY-DTAB JSR DECASC JSR SPACES LDA #20 ; THETA=. JSR MESSOT LDX #THETA-DTAB JSR DECASC ; REPORT ON FREE MEMORY LDA #21 ; FREE MEMORY = . JSR MESSOT LDY #S2L-DTAB ; = #'S2L' - 'S1H' + 1. JSR DLOADA LDY #S1H-DTAB JSR DSUBA LDA #1 JSR DADDS JSR DECASC ; PRINT RESULT. JSR NEWLIN L31_XD090 JSR NEWLIN ; BLANK LINE AFTER DUMP. INC DSPFLG ; RESET DISPLAY CONTROL CHARS FLAG. LDY XTEMP+1 ; DONE -- RESTORE INPUT LINE INDEX. LDA #0 ; SET CC FOR EXIT. RTS ; RETURN WITH CC SET. PRTEQS LDA #'=' ; PRINT '=' ... JMP CHOT ; ... & RETURN. ; PROC ; ; DMPVAR -- COMMON CODE FOR 'XDUMP'. ; ; CALLING SEQUENCE: ; ; DMPTYP = ATTRIBUTE TYPE ; ; JSR DMPVAR ; DMPVAR JSR SETSVL ; POINT TO VARIABLE LIST. L32_DM010 LDX #LP-DTAB JSR SEND ; END OF STRING STORAGE? BEQ L32_DM090 ; YES -- DONE. ; *S* LDX #LP-DTAB JSR SATTR ; CORRECT TYPE? CMP DMPTYP BNE L32_DM080 ; NO. LDX #NUMBER-DTAB ; MOVE POINTER TO 'NUMBER'. LDY #LP-DTAB JSR DMOVI LDA #'$' BIT DMPTYP BMI L32_DM020 ; STRING LDA #'#' BVC L32_DM030 ; I/O. L32_DM020 JSR CHOT ; PREFIX NAME FOR STRING, NUMERIC. L32_DM030 LDY #2 JSR PRTSFD ; PRINT NAME. JSR PRTEQS ; SEPARATE NAME AND DATA WITH '=' BIT DMPTYP BMI L32_DM040 ; STRING. INY ; NUMERIC OR I/O. LDA (NUMBER),Y BVC L32_DM032 ; I/O. TAX ; NUMERIC. INY LDA (NUMBER),Y BVS L32_DM035 ; (BRA). L32_DM032 LSR ; IOCB = # * 16. LSR LSR LSR TAX LDA #0 ; MSB = 0. L32_DM035 STA NUMBER+1 ; MSB. STX NUMBER ; LSB. LDX #NUMBER-DTAB JSR DECASC ; PRINT VALUE. JMP L32_DM050 L32_DM040 LDA #SQUOTE ; DELIMIT STRING DATA WITH '. JSR CHOT JSR PRTSFD ; PRINT STRING DATA. LDA #SQUOTE ; CLOSING DELIMITER. JSR CHOT L32_DM050 JSR NEWLIN L32_DM080 LDX #LP-DTAB ; INCREMENT TO NEXT VARIABLE. JSR SNXTI JMP L32_DM010 L32_DM090 RTS ; PROC PRTSFD LDA (NUMBER),Y ; GET NAME/DATA LENGTH. TAX BEQ L33_PF090 ; DONE. L33_PF010 INY BNE L33_PF020 INC NUMBER+1 ; INDEX WRAPAROUND -- BUMP POINTER. L33_PF020 LDA (NUMBER),Y ; GET CHARACTER. JSR CHOT DEX ; DONE? BNE L33_PF010 ; NO. INY BNE L33_PF090 ; YES. INC NUMBER+1 ; INDEX WRAPAROUND -- BUMP POINTER L33_PF090 RTS ; PROC ; ; XPALET -- COLORS COMMAND PROCESSOR ; XPALET BEQ L34_XP090 ; SYNTAX SCAN ONLY. LDX #0 ; SETUP TO SCAN COLOR NAME TABLE. L34_XP010 JSR PRNTCL ; PRINT COLOR NAME FROM TABLE. JSR SPACES INX ; SKIP OVER 'SB' ... INX ; ... & COLOR VALUF. CPX #PCTUP-PCTAB ; END OF TABLE? BNE L34_XP010 ; NO -- CONTINUE. JSR NEWLIN LDA #0 L34_XP090 RTS ; YES -- RETURN WITH CC SET. ; ; XCOLRS -- PS COMMAND PROCESSOR ; XCOLRS BEQ L34_XP090 ; SYNTAX SCAN ONLY. JSR TSTMOD ; GRAPHICS SPLIT SCREEN? CMP #GRSS BNE L34_XC092 ; NO -- ERROR. STY XTEMP ; SAVE Y REG. LDA #39 ; 'PENS: '. JSR MESSOT LDX #1 ; SETUP TO EXAMINE COLOR ASSIGNS. L34_XC005 CPX NCOLRS ; END OF TABLE? BEQ L34_XC010 ; NO. BCS L34_XC025 ; YES -- ALL DONE WITH PENS. L34_XC010 TXA ; GET PEN NUMBER. EOR #'0' ; CONVERT TO ASCII. JSR CHOT JSR PRTEQS ; '=' CPX NXTCLR ; PEN ASSIGNED? BCS L34_XC020 ; NO. JSR PRCLNM ; YES -- PRINT COLOR NAME. L34_XC020 JSR SPACES INX ; NEXT PEN. BNE L34_XC005 ; (BRA). L34_XC025 JSR NEWLIN LDA #40 ; 'BACKGROUND: '. JSR MESSOT LDX #0 ; BACKGROUND SLOT NUMBER. JSR PRCLNM ; PRINT COLOR NAME. LDA #TAB JSR CHOT LDA #42 ; 'MODE: ' JSR MESSOT LDA GSMODE STA TEMP2+2 LDA #0 STA TEMP2+3 LDX #TEMP2+2-DTAB JSR DECASC ; PRINT NODE NUMBER. JSR NEWLIN LDA #41 ; 'TURTLE PEN: '. JSR MESSOT LDA PEN BPL L34_XC030 ; PEN DOWN. LDX #PCTUP-PCTAB ; 'UP'. BNE L34_XC040 ; (BRA). L34_XC030 LDX #PCTDN-PCTAB ; 'DOWN'. L34_XC040 JSR PRNTCL ; PRINT 'UP' OR 'DOWN'. LDA #'/' ; '/' JSR CHOT LDA PEN ; NOW PRINT PEN NUNBER. AND #$0F EOR #'0' ; CONVERT TO ASCII. JSR CHOT JSR NEWLIN LDY XTEMP LDA #0 ; SET CC FOR EXIT. L34_XC090 RTS L34_XC092 LDA #NRCERR ; COMMAND ONLY VALID IN GRSS RTS ; PROC ; XENVIR -- ES COMMAND, TURTLE ENVIRONMENT STATUS XENVIR BEQ L35_XE090 ; SYNTAX SCAN ONLY. JSR TSTMOD ; GRAPHICS SPLIT SCREEN? CMP #GRSS BNE L35_XE092 ; NO -- ERROR. STY XTEMP ; SAVE Y REGISTER. LDA #43 ; 'EDGE:'. JSR MESSOT LDX #0 L35_XE010 STX XTEMP+1 L35_XE020 LDA EDGTAB,X ; SCAN TO NAME DELIMITER. INX CMP #SB BNE L35_XE020 LDA EDGTAB,X ; SEE IF THIS IS THE RULE IN EFFECT. INX CMP EDGRUL BNE L35_XE010 ; NO -- SCAN TO NEXT NAME. LDX XTEMP+1 ; YES -- BACKUP TO NAME TEXT. L35_XE030 LDA EDGTAB,X ; GET A CHARACTER. BMI L35_XE040 ; DELIMITER. JSR CHOT ; OUTPUT CHAR. INX BNE L35_XE030 ; (BRA). L35_XE040 LDA #TAB JSR CHOT LDA #44 ; 'SPEED: '. JSR MESSOT LDA SPEED STA TEMP2 LDA #0 STA TEMP2+1 LDX #TEMP2-DTAB JSR DECASC JSR NEWLIN LDA #45 ; 'WALLS: '. JSR MESSOT CLC LDY #1 L35_XE050 ROR WALLS+1 ROR WALLS BCC L35_XE060 ; NOT A WALL SELECT. STY TEMP2 ; A WALL SELECT, PRINT POSITION #. LDA #0 STA TEMP2+1 LDX #TEMP2-DTAB JSR DECASC JSR SPACE SEC L35_XE060 INY TYA EOR #17+1 ; COMPARE WITHOUT ALTERING THE CARRY. BNE L35_XE050 JSR NEWLIN LDY XTEMP LDA #0 L35_XE090 RTS L35_XE092 LDA #NRCERR ; COMMAND VALID ONLY IN GRSS. RTS ; PROC XTV LDX #ONOFFX ; CHECK FOR 'ON' OR 'OFF'. JSR SBCMAT BNE L36_XT090 ; ERROR. LDA EXEC ; EXECUTE MODE? BEQ L36_XT090 ; NO. TXA ; ON OR OFF? BEQ L36_XT100 ; OFF. LDA DMASAV ; ON -- TV OFF NOW? BEQ L36_XT090 ; NO. STA DMACT ; YES -- RESTORE PRIOR STATE LDA #0 STA DMASAV L36_XT090 RTS L36_XT100 LDA DMACT ; OFF -- IS TV ON NOW? BEQ L36_XT090 ; NO. STA DMASAV ; YES -- SAVE STATE. LDA #0 ; DMA OFF. STA DMACT RTS ; PROC ; ; COMPUTE COMMAND PROCESSOR ; XCMPUT JSR ATOM ; CHECK FOR TARGET VARIABLE. BNE L37_XC900 ; INVALID ATOM. CMP #NVAR BEQ L37_XC100 ; NUMERIC ASSIGNMENT. CMP #BPTR ; BYTE POINTER? BEQ L37_XC100 ; YES -- SAME AS NUMERIC VARIABLE. AND #SVAR+USVAR ; STRING ASSIGNMENT? BNE L37_XC200 ; YES. L37_XC092 LDA #IMPERR ; NO -- ERROR. RTS ; ARITHMETIC ASSIGNMENT L37_XC100 STA XTEMP ; SAVE TARGET TYPE. JSR CHKEQS ; CHECK FOR ASSIGNMENT OPERATOR NEXT. BNE L37_XC092 ; ASSIGNMENT SYNTAX ERROR. LDA POINT ; SAVE TARGET ADDRESS. PHA LDA POINT+1 PHA INY ; PREPARE TO EVALUATE EXPRESSION. JSR EXP ; EVALUATE EXPRESSION. PLA ; RESTORE TARGET ADDRESS. STA POINT+1 PLA STA POINT LDA EXEC ; EXECUTE MODE? BEQ L37_XC900 ; NO. STY XTEMP+1 ; SAVE LINE INDEX. LDY #0 ; STORE RESULT TO TARGET. LDA EXPSTK STA (POINT),Y LDA XTEMP ; SEE IF TARGET IS POINTER TO BYTE. CMP #BPTR BEQ L37_XC120 ; YES -- ALL DONE. INY LDA EXPSTK+1 STA (POINT),Y L37_XC120 LDY XTEMP+1 ; RESTORE LINE INDEX. LDA #0 ; COMPUTE WAS A SUCCESS. RTS ; STRING ASSIGNMENT L37_XC200 JSR CHKEQS ; ASSIGNMENT OPERATOR? BNE L37_XC092 ; NO -- ERROR. JSR SAVIT2 ; SAVE 'NP' TO 'MP' TEMPORARILY INY ; SKIP OVER '='. JSR TEXP ; EVALUATE TEXT EXPRESSION. LDA EXEC ; EXECUTE MODE? BEQ L37_XC900 ; NO -- DON'T DO ASSIGNMENT. STY XTEMP+1 JSR RESIT2 ; RESTORE 'NP' FROM 'MP'. ; *** EXTERNAL ENTRY POINT FROM 'XACCPT' *** XCM300 LDX #DP-DTAB ; MOVE 'TELN' TO 'DP'. LDY #TELN-DTAB JSR PMOVE LDA #ATRSTR ; 'STRING' ATTRIBUTE. STA ATRTYP JSR SINSRT ; INSERT STRING. PHP LDY XTEMP+1 PLP L37_XC900 RTS ; RETURN WITH CC SET. ; PROC SAVIT LDA XTEMP ; STRING TARGET? AND #SVAR+USVAR BEQ L38_SV090 ; NO. SAVIT2 LDA EXEC ; EXECUTE MODE? BEQ L38_SV090 ; NO. TYA ; SAVE Y REGISTER. PHA LDA #NAMBUF STA MP+1 LDY #2 ; TARGET STRING START INDEX. STY NAMLNG LDY NP+2 ; SOURCE STRING START INDEX. CPY NP+3 ; NULL SOURCE? BEQ L38_SV100 ; YES -- ERROR. L38_SV010 CPY NP+3 ; END OF STRING? BEQ L38_SV080 ; YES. LDA (NP),Y ; NO -- GET A CHAR. INY STY TEMP JSR CKEOA ; END OF ATOM (STRING NAME)? BEQ L38_SV100 ; YES -- ERROR. LDY NAMLNG ; STORE A CHAR. STA (MP),Y INY STY NAMLNG LDY TEMP BNE L38_SV010 ; TRY AGAIN (BRA). L38_SV080 PLA ; RESTORE Y REGISTER. TAY L38_SV090 RTS L38_SV100 PLA ; RESTORE Y REGISTER. TAY LDA #ATMERR+NS ; INVALID STRING NAME. L38_SV190 JMP PSTOP ; ABORT COMMAND. ; PROC RESIT LDA XTEMP ; STRING TARGET? AND #SVAR+USVAR BEQ L39_RS090 ; NO. RESIT2 LDA #NAMBUF STA NP+1 LDA #2 STA NP+2 LDA NAMLNG STA NP+3 L39_RS090 RTS ; PROC ; ; XGRAPH -- GRAPHICS COMMAND PROCESSOR ; XGRAPH LDA EXEC ; EXECUTE MODE? BEQ L40_XG020 ; NO. LDA GRFLAG ; YES -- GRAPHICS SCREEN OPEN? BNE L40_XG020 ; YES. JSR GPINIT ; INITIALIZE GRAPHICS PARAMETERS. STY XTEMP JSR GSOPEN ; OPEN GRAPHICS SCREEN. LDY XTEMP L40_XG020 JSR GCOMND ; PROCESS ONE GRAPHICS SUB-COMMAND. JSR SLB ; SEE IF MULTIPLES. INY CMP #';' BEQ XGRAPH ; YES. DEY ; NO -- ALL DONE. LDA #0 ; CLEAR CC FOR NORMAL EXIT. RTS ; RETURN WITH CC SET. ; PROC ; 'GCOMND' PROCESS ONE GRAPHICS SUB-COMMAND OR NESTED GROUP. GCOMND JSR SLB ; SKIP LEADING BLANKS. CMP #'(' ; CHECK FOR GROUPING WITH '(' & ')' BEQ L41_GC100 JSR ATOM ; CHECK ATOM TYPE. BNE L41_GC090 ; ATOM ERROR. AND #NUM+NVAR+BPTR ; IF NUMERIC, THEN TREAT AS ITERATION COUNT. BNE L41_GC200 ; YEP. LDX #GTABX ; NO -- ASSUME ITS A SUB-COMMAND. JSR SBCMAT BNE L41_GC090 ; NO -- ERROR. LDA SBDTAB,X ; SETUP ADDRESS OF G-ROUTINE. STA GJUMP+1 LDA SBDTAB+1,X STA GJUMP+2 JMP GJUMP ; GO TO G-ROUTINE & RETURN. L41_GC090 JMP PSTOP ; FATAL ERROR -- STOP EXECUTION. ; THIS SECTION HANDLES NESTED GROUPS. L41_GC100 INY ; SKIP OVER '('. JSR XGRAPH ; PROCESS ONE SUB-COMMAND OR NESTED GROUP. JSR SLB INY CMP #')' ; MATCHING PAREN? BEQ L41_GC390 ; YES -- O.K. DEY ; NO -- ERROR. LDA #NSTERR BNE L41_GC090 ; (BRA). ; THIS SECTION HANDLES ITERATIONS ; ; *** EXTERNAL ENTRY POINT *** ; GITER L41_GC200 LDA EXEC ; EXECUTE MODE? BEQ L41_GC300 ; NO -- SYNTAX SCAN ONLY. LDA NUMBER ; SEE IF ZERO ITERATIONS. ORA NUMBER+1 BEQ L41_GC300 ; YES -- SCAN OVER ITERATION BODY. LDA LS ; NO -- SAVE COUNTER ('LS') ... PHA LDA LS+1 PHA TYA ; ... & LINE INDEX. PHA LDA NUMBER ; GET LOOP COUNT TO 'LS'. STA LS LDA NUMBER+1 STA LS+1 L41_GC220 JSR GCOMND ; PROCESS ONE COMMAND. LDX #LS-DTAB ; DECREMENT ITERATION COUNT. JSR DDCRI LDA LS ; CHECK FOR RESULT = 0. ORA LS+1 BEQ L41_GC240 ; DONE. JSR ABRTCK ; CHECK FOR OPERATOR ABORT. PLA ; NOT DONE -- RESTORE SCAN INDEX. PHA TAY BNE L41_GC220 ; (BRA) EXECUTE BODY AGAIN. L41_GC240 PLA ; THROW AWAY STARTING INDEX. PLA ; RESTORE 'LS'. STA LS+1 PLA STA LS RTS ; THIS SECTION SYNTAX SCANS THE BODY OF AN ITERATION. L41_GC300 LDA EXEC ; SAVE CURRENT VALUE. PHA LDA #0 ; SETUP FOR SCAN ONLY STA EXEC JSR GCOMND ; *** RECURSIVE CALL ** PLA ; RESTORE MODE. STA EXEC L41_GC390 RTS ; PETURN WITH CC SET. ; PROC ; ; GREPT -- 'REPEAT' GRAPHICS SUBCOMMAND ; GREPT JSR ATOM ; REPEAT COUNT MUST FOLLOW. BNE L42_GR090 ; ERROR. AND #NUM+NVAR+BPTR ; NUMERIC DATA? BEQ L42_GR088 ; NO -- ERROR. JMP GITER ; YES -- PROCESS REPEAT LOGIC. L42_GR088 LDA #IMPERR L42_GR090 JMP PSTOP ; PROC ; ; XSOUND -- SOUND COMMAND PROCESSOR ; XSOUND LDX #AUREGS*2 ; SETUP INDEX TO A OF REGS. L43_XS010 JSR SKPSEP ; SKIP SEPARATORS & GET CHAR. JSR CHKTRM ; TERMINATOR? BEQ L43_XS080 ; YES -- ALL DONE. CMP #'(' ; LEFT PAREN? BEQ L43_XS050 ; YES -- START OF NOTE LIST. CMP #')' ; RIGHT PAREN? BEQ L43_XS080 ; YES -- END OF NOTE LIST. CMP #'=' ; EQUAL SIGN? BEQ L43_XS020 ; YES -- NO CHANGE FOR VOICE. CMP #'+' ; PLUS SIGN? BEQ L43_XS030 ; YES -- INCREMENT NOTE. CMP #'-' ; MINUS SIGN. BEQ L43_XS040 ; YES -- DECREMENT NOTE. JSR GTNOTE ; GET NUMERIC VALUE. BNE L43_XS090 ; ERROR. LDA NUMBER ; NOTE := NUM. L43_XS015 STA XTEMP ; SAVE NOTE # LDA EXEC ; EXECUTE MODE? BEQ L43_XS017 ; NO. LDA XTEMP ; YES. ORA #$80 ; SET BIT FOR NOT A POINTER. STA AUDIOR-1,X L43_XS017 DEX ; MORE OPERANDS ALLOWED? DEX BNE L43_XS010 ; YES. BEQ L43_XS080 ; NO -- SEE IF DURATION (BRA). L43_XS020 INY BNE L43_XS017 ; (BRA). L43_XS030 INY JSR GTNOTE ; GET INCREMENT VALUE. BNE L43_XS090 ; ERROR. LDA AUDIOR-1,X ; NOTE :=NOTE + NUM. CLC ADC NUMBER JMP L43_XS015 L43_XS040 INY JSR GTNOTE ; GET DECREMENT VALUE. BNE L43_XS090 ; ERROR. LDA AUDIOR-1,X ; NOTE := NOTE - NUM. SEC SBC NUMBER JMP L43_XS015 L43_XS050 INY ; SKIP OVER LEFT RAREN. BNE L43_XS010 ; (BRA). L43_XS080 LDA EXEC ; EXECUTE MODE? BEQ L43_XS084 ; NO. CPX #0 BEQ L43_XS083 L43_XS082 LDA #0 ; CLEAR UNSPECIFIED VOICES. STA AUDIOR-1,X STA AUDF1-2,X ; CLEAR SOUND REGISTERS. STA AUDC1-2,X DEX DEX BNE L43_XS082 L43_XS083 STY XTEMP JSR TONES LDY XTEMP L43_XS084 LDA (INLN),Y ; DURATION FOLLOWING? CMP #')' BNE L43_XS088 ; NO. INY ; YES -- SKIP OVER LEFT PAREN. JMP XWAIT ; PROCESS DURATION AS A PAUSE. L43_XS088 LDA #0 ; RETURN WITH CC SET. RTS L43_XS090 JSR AUDCLR ; CLEAR ALL SOUND REGS. XIN080 LDA #IMPERR XIN090 RTS ; RETURN WITH CC SET. ; PROC GTNOTE STX XTEMP ; SAVE X REGISTER. JSR ATOM ; GET OPERAND. BNE L44_GN090 ; ERROR. AND #NUM+NVAR+BPTR BEQ L44_GN092 ; ERROR. LDX XTEMP ; RESTORE X REGISTER. LDA #0 L44_GN090 RTS L44_GN092 LDA #IMPERR RTS ; PROC ; ; XIN -- READ COMMAND PROCESSOR ; XIN LDA #OREAD ; READ DIRECTION. JSR SCNDEV ; CONVERT DEVICE SPEC TO IOCB INDEX BNE XIN090 ; ERROR. STX XTEMP+2 ; SAVE IOCB INDEX. JSR SKPSEP ; SKIP OVER SEPARATOR. JSR ATOM ; FIND TYPE OF VARIABLE. BNE XIN090 ; ERROR. STA XTEMP ; SAVE ATOM TYPE. AND #SVAR+USVAR+NVAR+NULL+BPTR ; VALID TYPE? BEQ XIN080 ; NO. LDA EXEC ; EXECUTE MODE? BEQ XIN090 ; NO. STY XTEMP+1 ; SAVE LINE INDEX. LDX XTEMP+2 ; GET IOCB INDEX. LDY #0 ; INIT INDEX TO ACCEPT BUFFER. STY TELN+2 LDA OPNBUF ; SEE IF READING FROM TEXT SCREEN. CMP #'E' BNE L45_XI030 ; NO. TYA ; YES -- ENABLE CURSOR CY = 0). JSR CRSNOP ; MAKE IT APPEAR. L45_XI030 JSR DIN ; GET A CHARACTER FROM DEVICE. CMP #EOL ; END OF LINE? BEQ L45_XI040 ; YES -- DONE. STA (TELN),Y INY CPY #TEXLNG ; BUFFER FULL? BNE L45_XI030 ; NO. L45_XI035 JSR DIN ; YES -- FLUSH TO EOL. CMP #EOL BNE L45_XI035 L45_XI040 STY TELN+3 ; SAVE STRING END INDEX. LDA OPNBUF ; READING FROM TEXT SCREEN? CMP #'E' BNE L45_XI045 ; NO. JSR CRSNOP ; DISABLE CURSOR AGAIN (A = $45). L45_XI045 LDA #1 ; SET ACCEPT LITERAL. STA AXFLAG JSR SAVIT ; SAVE NAME IF STRING TARGET. JMP XAC024 ; GO TO ACCEPT CODE TO FINISH PROCESSING. ; PROC ; ; XOUT -- WRITE COMMAND PROCESSOR ; XOUT LDA #OWRIT ; WRITE DIRECTION. JSR SCNDEV ; CONVERT I/O SPEC TO DEVICE INDEX. BNE L46_XO090 ; ERROR. STX XTEMP ; SAVE IOCB INDEX. LDA (INLN),Y JSR CHKTRM ; TERMINATOR FOLLOWING DEVICE SPEC? BEQ L46_XO005 ; YES -- DON'T ADVANCE INDEX. INY ; NO -- SKIP OVER SINGLE SEPARATOR. L46_XO005 JSR TEXP ; REST OF STATEMENT IS A TEXT EXPRESSION. ; *S* LDA EXEC ; EXECUTE MODE? BEQ L46_XO090 ; NO. STY XTEMP+1 ; SAVE LINE INDEX. LDX XTEMP ; GET IOCB INDEX. LDY TELN+2 ; START OF TEXT EXPRESSION EVALUATION. L46_XO010 CPY TELN+3 ; DONE? BEQ L46_XO020 ; YES. LDA TEXBUF,Y ; NO -- PUT CHAR TO DEVICE. JSR DOUT INY BNE L46_XO010 ; (BRA). L46_XO020 LDA #EOL ; TERMINATE RECORD. JSR DOUT LDY XTEMP+1 LDA #0 ; SET CC FOR NORMAL EXIT. L46_XO090 RTS ; RETURN WITH CC SET. ; PROC ; ; XDONE -- CLOSE COMMAND PROCESSOR ; XDONE LDA #0 ; INVALID OPEN CODE MEANS CLOSE. JSR SCNDEV ; CONVERT DEVICE SPEC TO ICCB INDEX. BNE L47_XD090 ; ERROR. LDA EXEC ; EXECUTE MODE? BEQ L47_XD090 ; NO. JSR DCLOSE ; YES -- CLOSE IOCB & DEVICE. LDA #0 ; SET CC FOR NORMAL EXIT. L47_XD090 RTS ; RETURN WITH CC SET. ; PROC ; ; XSSAV -- SAVE SCREEN COMMAND PROCESSOR. ; XSSAV JSR SFNAME ; EXTRACT DEVICE/FILENAME. BNE L48_XS090 ; ERROR. JSR SKPSEP ; SKIP SEPARATOR(S). LDA EXEC ; EXECUTE MODE? BEQ L48_XS090 ; NO. LDX #IOCB3 ; YES -- OPEN DEVICE FOR OUTPUT. LDA #OWRIT JSR DOPEN LDA #PUTC ; SETUP IOCB FOR PUT CHARACTER. STA ICCOM,X LDX #IOCB3 LDA GRFLAG ; GRAPHICS SCREEN FLAG. JSR DOUT LDA GSMODE ; SAVE SCREEN MODE. JSR DOUT LDA SPLTSC ; FULL/SPLIT FLAG. JSR DOUT LDA LETTRSZ ; LETTER SIZE. JSR DOUT LDA SAVMSC+1 ; SETUP POINTER TO BOTTOM OF SCREEN. STA ADRESS+1 LDA #0 STA ADRESS STY XTEMP LDY SAVMSC L48_XS010 LDA (ADRESS),Y ; GET DATA BYTE. JSR DOUT ; OUTPUT IT. INY BNE L48_XS010 INC ADRESS+1 LDA ADRESS+1 CMP RAMTOP ; DONE? BNE L48_XS010 ; NO. LDY XTEMP JSR DCLOSE LDA #0 ; SET CC FOR NORMAL EXIT. L48_XS090 RTS ; RETURN WITH CC SET. ; PROC ; ; XSLOAD -- LOAD SCREEN COMMAND PROCESSOR. ; XSLOD JSR SFNAME ; EXTRACT DEVICE/FILENAME. BNE L49_XS090 ; ERROR. LDA EXEC ; EXECUTE MODE? BEQ L49_XS090 ; NO. LDX #IOCB3 ; YES -- OPEN DEVICE FOR INPUT. LDA #OREAD JSR DOPEN STY XTEMP LDA #GETC ; SETUP I OCB FOR GET CHARACTER STA ICCOM,X LDX #IOCB3 JSR DIN ; GET GRAPHICS FLAG. STA GRFLAG JSR DIN ; GET SCREEN MODE. STA GSMODE JSR DIN ; GET FULL/SPLIT FLAG. STA SPLTSC JSR DIN ; GET LETTER SIZE. STA LETTRSZ JSR TSTMOD ; SEE IF TEXT/SMALL LETTERS. CMP #TXSL BNE L49_XS005 ; NO. JSR TXOPEN ; YES. JMP L49_XS007 L49_XS005 JSR GSOPEN ; OPEN SCREEN. L49_XS007 LDA SAVMSC+1 ; SETUP POINTER TO BOTTOM OF SCREEN STA ADRESS+1 LDA #0 STA ADRESS LDX #IOCB3 LDY SAVMSC L49_XS010 JSR DIN STA (ADRESS),Y INY BNE L49_XS010 INC ADRESS+1 LDA ADRESS+1 CMP RAMTOP ; DONE? BNE L49_XS010 ; NO. LDY XTEMP JSR DCLOSE LDA #0 L49_XS090 RTS ; PROC ; ; XDIR -- DISK DIRECTORY COMMAND PROCESSOR ; XDIR JSR EXP ; GET DRIVE NUMBER. LDA EXEC ; EXECUTE MODE? BEQ L50_XD090 ; NO -- SYNTAX SCAN ONLY. LDX #L50_DTLNG ; MOVE OPEN TEMPLATE ... L50_XD005 LDA L50_DIRTB-1,X ; ... TO OPEN BUFFER. STA OPNBUF-1,X DEX BNE L50_XD005 LDA EXPSTK ; INSERT DRIVE A. EOR #'0' STA OPNBUF+1 LDX #IOCB3 LDA #OREAD+2 ; OPEN FOR DIRECTORY READ. JSR DOPEN L50_XD010 LDX #IOCB3 ; GET A BYTE. JSR DIN LDX IOSTAT ; CHECK FOR END-OF-FILE. CPX #$88 BEQ L50_XD020 ; EOF -- ALL DONE. JSR CHOT ; WRITE TO SCREEN. JMP L50_XD010 L50_XD020 LDX #IOCB3 ; CLOSE THE FILE. JSR DCLOSE JSR NEWLIN LDA #0 ; SET CC FOR EXIT. L50_XD090 RTS L50_DIRTB .BYTE 'D :*.*',EOL ; DIRECTORY OPEN TEMPLATE. L50_DTLNG = *-L50_DIRTB ; PROC ; ; XCOMM -- COMMAND TABLE LISTER ; XCOMM BEQ L51_XC090 ; SYNTAX SCAN ONLY. LDA USRTAB ; FIRST LIST USER SUPPLIED TABLE. LDX USRTAB+1 BEQ L51_XC010 ; NO TABLE. JSR PRINTC L51_XC010 LDA #CTAB JSR PRINTC LDA #0 L51_XC090 RTS ; RETURN WITH CC SET. PRINTC STA TABADR ; SETUP P0INTER TO BEGIN OF TABLE. STX TABADR+1 STY XTEMP ; SAVE Y REG. L51_PC003 LDA #5 ; 5 NAMES PER LINE. STA XTEMP+1 L51_PC005 LDY #0 ; START NAME SCAN. L51_PC010 LDA (TABADR),Y ; GET CHARACTER. BEQ L51_PC080 ; END OF TABLE. BMI L51_PC020 ; END OF NAME. JSR CHOT ; OUTPUT CHARACTER. INY BNE L51_PC010 ; (BRA). L51_PC020 JSR SPACES INY ; SKIP OVER PARAMETERS. INY TYA ; ADD Y REG TO TABADR. CLC ADC TABADR STA TABADR BCC L51_PC030 INC TABADR+1 L51_PC030 DEC XTEMP+1 ; LINE FULL (5 NAMES)? BNE L51_PC005 JSR NEWLIN ; YES. JMP L51_PC003 L51_PC080 JSR NEWLIN LDY XTEMP RTS ; PROC ; ; XWAIT -- PAUSE COMMAND PROCESSOR ; XWAIT JSR EXP ; THERE MUST BE AN EXPRESSION FOLLOWING. LDA EXEC ; EXECUTE MODE? BEQ L52_XW090 ; NO -- ALL DONE. LDX #EXPSTK-DTAB ; YES -- WORK WITH COUNT. STY XTEMP ; SAVE LINE INDEX. L52_XW010 LDY XTEMP ; RESTORE INDEX. LDA EXPSTK ; ALL DONE? ORA EXPSTK+1 BEQ L52_XW090 ; YES. LDY RTCLOK+2 ; NO -- WAIT FOR ... L52_XW020 JSR ABRTCK ; ... OPERATOR ABORT ... CPY RTCLOK+2 BEQ L52_XW020 ; ... OR CLOCK TO CHANGE. JSR DDCRI ; DECREMENT COUNT. JMP L52_XW010 L52_XW090 RTS ; PROC ; ; XSPEED -- SPEED CONTROL COMMAND PROCESSOR ; XSPEED JSR EXP ; THERE MUST BE AN EXPRESSION. LDA EXEC ; EXECUTE MODE? BEQ L53_XS090 ; NO. LDA EXPSTK ; YES -- SET SPEED. STA SPEED LDA #0 ; SET CC FOR EXIT. L53_XS090 RTS ; RETURN WITH CC SET. ; PROC ; ; XCASS -- CASSETTE ON/OFF COMMAND PROCESSOR ; XCASS LDX #ONOFFX ; CHECK FOR 'ON' OR 'OFF' JSR SBCMAT BNE L54_XC090 ; NOT FOUND -- ERROR. LDA EXEC ; EXECUTE MODE? BEQ L54_XC090 ; NO. LDA CASCTL,X ; 0/1 -> CASSETTE CONTROL. STA PACTL LDA #0 ; SET CC FOR NORMAL EXIT. L54_XC090 RTS ; RETURN WITH CC SET. ; CASSETTE CONTROL ; REQUIRES KOFF = 0, KON = 1. CASCTL .BYTE CASSOF .BYTE CASSON ; PROC ; ; XCSYNC -- CASSETTE SYNC COMMAND PROCESSOR ; XCSYNC BEQ L55_XC090 ; SYNTAX SCAN. LDA PACTL ; CHECK CASSETTE MOTOR. AND #$08 BNE L55_XC080 ; MOTOR OFF. LDA #$10 ; ON -- WAIT FOR MARK TO SPACE TRANSITION. L55_XC010 JSR ABRTCK ; WAIT FOR BREAK ... BIT SKSTAT BEQ L55_XC010 ; ... OR MARK. L55_XC020 JSR ABRTCK ; WAIT FOR BREAK ... BIT SKSTAT BNE L55_XC020 ; ... OR SPACE. L55_XC080 LDA #0 ; SET CC FOR NORMAL EXIT. L55_XC090 RTS ; RETURN WITH CC SET. ; PROC ; ; XTRACE -- TRACE MODE ON/OFF COMMAND ; XTRACE LDX #ONOFFX ; CHECK FOR 'ON' OR 'OFF'. JSR SBCMAT BNE L56_XT090 ; NOT FOUND -- ERROR. LDA EXEC ; EXECUTE MODE? BEQ L56_XT090 ; NO. ; REQUIRES KOFF = 0, KON <> 0. STX TRACE ; SET FLAG. LDA #0 ; SET CC FOR NORMAL EXIT. L56_XT090 RTS ; RETURN WITH CC SET. ; PROC ; ; XSAVE -- SAVE COMMAND PROCESSOR ; XSAVE JSR DNAME ; EXTRACT DEVICE/FILENAME. JSR SKPSEP ; SKIP SEPARATOR(S). LDA EXEC ; EXECUTE MODE? BEQ L57_XS090 ; NO. LDX #IOCB3 LDA #OWRIT ; YES -- OPEN DEVICE FOR OUTPUT. JSR DOPEN LDA #PUTC ; SETUP IOCB FOR PUT CHARACTER. STA ICCOM,X LDA #$80+IOCB3 ; RE-ROUTE 'CHOT' OUTPUT TO DEVICE. STA CDEST JSR LISTER ; OUTPUT PROGRAM TO DEVICE. LDX #IOCB3 JSR DCLOSE ; CLOSE DEVICE. LDA #EPUTC-IOVBAS ; RESTORE 'CHOT' OUTPUT. STA CDEST ; *** EXTERNAL ENTRY POINT FROM 'XLIST' *** XSV050 JSR RDYMES ; GENERATE "READY" MESSAGE. LDA #0 ; SET CC FOR NORMAL EXIT. XAP090 XME090 XLO090 RTS ; RETURN WITH CC SET. L57_XS090 JMP LISTER ; SYNTAX CHECK & RETURN WITH CC SET. ; PROC ; ; XLOAD -- LOAD COMMAND PROCESSOR ; XLOAD JSR XLO100 ; COMMON CODE. BNE XLO090 ; ERROR. ; *** EXTERNAL ENTRY FROM 'XRUN' *** XLO005 LDA EXEC ; EXECUTE MODE? BEQ XLO090 ; NOT. JSR CLRPRG ; CLEAR PROGRAM STORAGE AREA. LDA #KLOAD ; SET LOAD FLAG. ; *** EXTERNAL ENTRY FROM 'XMERGE', 'XARPND' *** XLO010 STA LOADFG JMP MLLOAD ; LOAD UNTIL I/O ERROR OR END OF FILE. ; SET 'GETCOM'. XLO100 JSR SFNAME ; EXTRACT DEVICE/FILENAME. BNE XLO090 ; ERROR. LDA EXEC ; EXECUTE MODE? BEQ XLO090 ; NO. LDA LOADFG ; ALREADY LOADING? BNE XLO090 ; YES -- ERROR. LDX #IOCB3 LDA #OREAD ; YES -- OPEN DEVICE FOR READING. JSR DOPEN LDA #0 ; CLEAR USE STACK. STA USTKP RTS ; ; XMERGE -- MERGE COMMAND ; XMERGE JSR XLO100 ; COMMON CODE. BNE XME090 ; ERROR. LDA EXEC ; EXECUTE MODE? BEQ XME090 ; NO. LDA #KMERGE ; SET LOAD FLAG. BNE XLO010 ; (BRA). ; ; XAPPND -- APPEND COMPAND PROCESSOR. ; XAPPND JSR XLO100 ; COMMON CODE. BNE XAP090 ; ERROR. JSR XAU010 ; SHARE 'XAUTO' CODE FOR LINE #'S. BNE XAP090 ; ERROR. LDA EXEC ; EXECUTE MODE? BEQ XAP090 ; NO. LDA #KAPPND ; SET LOAD FLAG. BNE XLO010 ; (BRA). ; PROC ; ; XLETTR -- TEXT LETTER SIZE SELECTION ; XLETTR LDX #LTTABX ; CHECK FOR 'SMALL', 'MEDIUM', OR 'LARGE'. JSR SBCMAT BNE L59_XL090 ; NOT FOUND -- ERROR. LDA EXEC ; EXECUTE MODE? BEQ L59_XL090 ; NO. LDA SGLSTP ; SINGLE STEP? BEQ L59_XL020 ; NO. LDA #NRCERR ; YES -- ERROR. BNE L59_XL090 L59_XL020 STY XTEMP STX LETTRSZ ; YES -- SET NEW LETTER SIZE. TXA BNE L59_XL050 ; MEDIUM OR LARGE LETTERS. JSR TXOPEN ; SMALL LETTERS. JMP L59_XL080 L59_XL050 STX GSMODE ; GRAPHICS MODE. LDA #0 STA SPLTSC ; NO SPLIT SCREEN. JSR GSOPEN ; OPEN SCREEN. L59_XL080 LDY XTEMP LDA #0 ; RESET GRAPHICS MODE FLAG & SET CC. STA GRFLAG L59_XL090 RTS ; RETURN WITH CC SET. ; PROC ; ; XSCROLL -- SCROLL OPTION SELECTION ; XSCROLL LDX #SCTABX ; CHECK FOR 'FINE' OP 'COARSE'. JSR SBCMAT BNE L60_XS090 ; NOT FOUND -- ERROR. LDA EXEC ; EXECUTE MODE? BEQ L60_XS090 ; NO. JSR TSTMOD ; TEXT MODE, SMALL LETTERS? CMP #TXSL BNE L60_XS092 ; NO. STX FINEFG ; SET SCREEN EDITOR FLAG. STY XTEMP JSR COMPRS ; COMPRESS MEMORY. JSR EOPEN ; RE-OPEN E: ON IOCB 0. JSR EXPAND ; EXPAND MEMORY. LDY XTEMP LDA #0 ; SET CC FOR NORMAL EXIT L60_XS090 RTS ; RETURN WITH CC SET. L60_XS092 LDA #NRCERR RTS ; PROC ; ; XLIST -- LIST COMMND PROCESSOR ; ; *** EXTERNAL ENTRY POINT FROM 'XSAVE' *** XLIST JSR LISTER ; DO THE LIST PROCESS. BNE L61_XL009 ; ERROR. LDA EXEC ; EXECUTE MODE? BEQ L61_XL009 ; NO. JMP XSV050 ; YES -- SIGN OFF & RETURN. L61_XL009 RTS ; RETURN WITH CC SET. LISTER LDA #LSTNMS STA POINT+1 JSR MNYNMS ; GET PARAMETERS. BNE L61_XL900 ; SYNTAX ERROR. CPX #3 BCS L61_XL900 ; TOO MANY NUMBERS. CPX #1 ; HOW MANY ARGS? BNE L61_XL010 ; 0 OR 2. LDA NMSBF ; 1 -- LAST LINE = FIRST. STA NMSBF+2 LDA NMSBF+1 STA NMSBF+3 L61_XL010 ; *S* STY XTEMP ; SAVE Y. LDX #LS-DTAB ; 'LS'= FIRST. LDY #0 JSR NMOVI LDX #LEND-DTAB ; 'LEND' = SECOND. LDY #2 JSR NMOVI JSR BRACKT ; BRACKET RANGE. BNE L61_XL900 ; FIRST > LAST. LDA EXEC ; EXECUTE MODE? BEQ L61_XL990 ; NO. L61_XL100 LDX #BLOW-DTAB ; ADDRESS OF NEXT LINE LDY #BHIGH-DTAB ; ADDRESS PAST END. JSR DCMPI BCS L61_XL200 ; DONE. LDY #BLOW-DTAB JSR PSF ; PRINT STORAGE FORM LINE. LDX #BLOW-DTAB ; ADVANCE TO NEXT LINE. JSR SNXTI JMP L61_XL100 L61_XL200 LDA #0 ; SET CC FOR NORMAL EXIT. BEQ L61_XL990 ; (BRA). L61_XL900 LDA #IMPERR ; IMPROPER PARAMETER ERROR. L61_XL990 PHP ; SAVE CC. LDY XTEMP ; RESTORE Y. PLP ; RESTORE CC. RTS ; RETURN KITH CC SET. ; DEFAULTS FOR 'LIST'. LSTNMS .WORD 0 .WORD MAXLN .WORD EONMLS ; PROC ; ; XAUTO -- AUTO-INPUT COMMAND PROCESSOR ; XAUTO JSR XAU010 ; COMMON CODE. BNE L62_XA900 ; ERROR. BEQ L62_XA200 ; *** EXTERNAL ENTRY FOR 'APPEND' *** XAU010 LDA #AUTNMS STA POINT+1 JSR MNYNMS ; GET PARAMETERS. BNE L62_XA190 ; SYNTAX ERROR. ; *S* STY XTEMP ; SAVE Y. TXA ; SET 'Z' FLAG. BNE L62_XA100 ; FIRST LINE ENTERED. ; DEFAULTS: NEXT LINE = LAST PROGRAM LINE + 10 JSR GTLSLN ; 'LINE NO' = LAST PROGRAM LINE + 10 LDX #ALINE-DTAB LDY #LINENO-DTAB JSR DMOVI JMP L62_XA110 ; USE ENTERED VALUES. L62_XA100 LDX #ALINE-DTAB ; 'ALINE' = FIRST. LDY #0 JSR NMOVI L62_XA110 LDX #AINC-DTAB ; 'AINC' = SECOND. LDY #2 JSR NMOVI LDY XTEMP ; RESTORE Y. LDA #0 ; SET CC FOR EXIT. L62_XA190 RTS L62_XA200 LDA EXEC ; EXECUTE MODE? BEQ L62_XA990 ; NO. STA AUTOIN ; YES -- SET AUTO-INPUT MODE; LDA ACOLR2 ; SET SCREEN BACKGROUND COLOR. STA COLOR0+2 LDA ACOLR1 ; SET SCREEN LETTER COLOR. STA COLOR0+1 LDA #0 ; SET CC FOR NORMAL EXIT. STA INDENT ; INITIALIZE 'AUTO INDENT'. BEQ L62_XA990 ; (BRA). L62_XA900 LDA #IMPERR L62_XA990 PHP ; SAVE CC. LDY XTEMP ; RESTORE Y. PLP ; RESTORE CC. RTS ; DEFAULTS FOR 'AUTO', 'APPEND' AUTNMS .WORD 0 ; (DON'T CARE) .WORD 10 .WORD EONMLS ; PROC ; ; XDELET -- DELETE COMMAND PROCESSOR ; XDELET LDA #LSTNMS STA POINT+1 JSR MNYNMS ; GET PARAMETERS. BNE L63_XD900 ; SYNTAX ERROR. CPX #1 ; 0, 1, OR 2 PARAMETERS. BCC L63_XD900 ; 0 = ERROR. BNE L63_XD010 ; 2. LDA NMSBF ; 1 -- LAST LINE = FIRST. STA NMSBF+2 LDA NMSBF+1 STA NMSBF+3 L63_XD010 ; *S* STY XTEMP ; SAVE Y. LDX #LS-DTAB ; 'LS' = FIRST. LDY #0 JSR NMOVI LDX #LEND-DTAB ; 'LEND' = SECOND. LDY #2 JSR NMOVI JSR BRACKT ; BRACKET RANGE. BNE L63_XD900 ; FIRST > LAST. LDA EXEC ; EXECUTE MODE? BEQ L63_XD990 ; NO. LDA BNUM ; ANY LINES TO DELETE? ORA BNUM+1 BEQ L63_XD600 ; NO. ; WARN USER. LDA #DELMES ; 'YOU ARE ABOUT TO DELETE '. JSR MESSOT LDX #BNUM-DTAB ; # OF LINES. JSR DECASC LDA #DL2MES ; 'LINES(S). ARE YOU SURE?' JSR MESSOT LDX #TELN-DTAB ; USE 'TEXBUF'. JSR GETLIN LDA TELN+3 ; EMPTY? BEQ L63_XD500 ; YES -- DO NOT CHANGE. LDA TEXBUF ; FIRST CHARACTER. ORA #LC ; FORCE LOWER CASE. CMP #'Y'+$20 ; Y? BNE L63_XD500 ; NO -- DO NOT CHANGE. ; USER AGREES. STA NOCONT ; NO CONTINUE AFTER DELETIONS. LDX #BHIGH-DTAB ; SIZE OF BRACKETED RANGE. LDY #BLOW-DTAB JSR DSUBI LDX #MEMA-DTAB ; GET READY TO DELETE. ; *S* LDY #BLOW-DTAB JSR DMOVI LDY #0 ; SET BLOCK SIZE TO DELETE. LDA BHIGH STA (BLOW),Y INY LDA BHIGH+1 STA (BLOW),Y JSR MDEALL ; DELETE BLOCK. JSR RDYMES ; LDA #0 ; SET CC FOR NORMAL EXIT. ; BEQ :XD990 ; (BRA). JMP L63_XD600 ; USER DOES NOT AGREE. L63_XD500 LDA #NCHGMS ; 'PROGRAM UNCHANGED'. JSR MESSOT L63_XD600 LDA #0 ; SET CC FOR NORMAL EXIT. BEQ L63_XD990 ; SYNTAX ERROR. L63_XD900 LDA #IMPERR ; IMPROPER PARAMETER ERROR. L63_XD990 PHP ; SAVE CC. LDY XTEMP ; RESTORE Y. PLP ; RESTORE CC. RTS ; PROC ; ; XREN -- RENUMBER COMMAND PROCESSOR ; ; STEP 1: BRACKET T HE RANGE OF LINES TO RENUMBER. ; 2: COMPUTE THE NEW RANGE THEY WILL BECOME. ; 3: FIND STARTING AND ENDING ADDRESSES OF THE NEW LINES. ; 4: THERE ARE TWO VALID CASES FOR THE NEW LINES: ; A. THEY ALL FIT BETWEEN TWO EXISTING LINES. ; B. THEY ALL FIT WITHIN THE RENUMBERED RANGE. ; 5: RENUMBER THE LINES IN PLACE. ; 6: MOVE THEM BETWEEN TWO EXISTING LINES (IF 4A.). ; XREN LDA #RENNMS STA POINT+1 JSR MNYNMS ; GET PARAMETERS. BEQ L64_XR010 ; OK. L64_XR005 JMP L64_XR900 ; SYNTAX ERROR. L64_XR010 ; *S* STY XTEMP ; SAVE Y. LDX #ALINE-DTAB ; 'ALINE' = FIRST. LDY #0 JSR NMOVI LDX #AINC-DTAB ; 'AINC' = SECOND. LDY #2 JSR NMOVI LDX #LS-DTAB ; 'LS' = THIRD. LDY #4 JSR NMOVI LDX #LEND-DTAB ; 'LEND' = FOURTH. LDY #6 JSR NMOVI JSR BRACKT ; BRACKET RANGE. BNE L64_XR005 ; 'LS' > 'LEND'. LDA EXEC ; EXECUTE M100E? BNE L64_XR015 ; YES. JMP L64_XR990 ; NO. L64_XR015 LDA BNUM ; 0 LINES? ORA BNUM+1 BNE L64_XR020 ; NO. JMP L64_XR500 ; YES. L64_XR020 LDX #RTMP-DTAB ; 'RTMP' = # OF LINES. LDY #BNUM-DTAB JSR DMOVI JSR DDCRI ; -1. LDY #AINC-DTAB ; INCREMENT. JSR DMULI LDY #ALINE-DTAB ; # FIRST NEW LINE. JSR DADDI ; # LAST NEW LINE. JSR CHKLN ; IS LINE IN RANGE? BCC L64_XR030 ; YES. JMP L64_XR600 ; NO -- OUT OF RANGE. ; FIND STARTING AND ENDING ADDRESSES OF THE NEW RANGE. L64_XR030 ; *S* LDX #RTMP-DTAB ; 'RTMP' = LAST NEW LINE; JSR RENFND STA XTEMP+1 ; SAVE 'VALID' STATUS. LDX #R2TMP-DTAB ; 'R2TMP' = ADDRESS OF END. LDY #PP-DTAB JSR DMOVI LDX #ALINE-DTAB JSR RENFND ; 'PP' = ADDRESS OF START. ORA XTEMP+1 ; IF EITHER IS INVALID, "OVERLAP" ERROR. BEQ L64_XR040 ; OK. L64_XR035 JMP L64_XR700 ; OVERLAP. ; ; OVERLAPPING RANGES UNLESS: ; 'START' OF NEW = 'END' OF NEW *OR* ; 'START' OF OLD <= 'START' OF NEW *AND* ; 'END' OF NEW <= 'END' OF OLD ; L64_XR040 LDX #PP-DTAB ; 'START' OF NEW. LDY #R2TMP-DTAB ; 'END' OF NEW. JSR DCMPI BEQ L64_XR100 ; NOT OVERLAPPING. ; *S* LDX #PP-DTAB ; 'START' OF NEW. LDY #BLOW-DTAB ; 'START' OF OLD. JSR DCMPI BCC L64_XR035 ; OVERLAPPING. LDX #BHIGH-DTAB ; 'END' OF NEW. LDY #R2TMP-DTAB ; 'END' OF OLD. JSR DCMPI BCC L64_XR035 ; OVERLAPPING. ; RENUMBER IS VALID L64_XR100 LDX #RTMP-DTAB LDY #PP-DTAB JSR DMOVI ; 'RTMP' = ADDRESS OF START. ; RENUMBER EACH LINE IN PLACE L64_XR110 STA NOCONT LDX #PP-DTAB ; NO CONTINUE AFTER RENUMBER. LDY #BLOW-DTAB JSR DMOVI ; 'PP = ADDRESS OF NEXT LINE TO RENUMBER. ; 'ALINE' = NEW LINE NUMBER. ; 'AINC' = INCREMENT. ; 'BNUM' = # OF LINES LEFT TO RENUMBER. L64_XR200 LDY #4 LDA ALINE STA (PP),Y ; NEW LSB (INVERTED). DEY LDA ALINE+1 STA (PP),Y ; NEW MSB (INVERTED). LDX #ALINE-DTAB LDY #AINC-DTAB JSR DADDI ; INCREMENT 'ALINE'. LDX #PP-DTAB JSR SNXTI ; ADDRESS OF NEXT LINE. LDX #BNUM-DTAB JSR DDCRI ; ONE LESS LINE. LDA BNUM ; ANY LINES LEFT? ORA BNUM+1 BNE L64_XR200 ; YES. ; THE LINES HAVE BEEN RENUMBERED IN PLACE. ; THERE ARE FOUR CASES: ; 1. 'START' ADDRESS < 'END' ADDRESS -> ALREADY IN ORDER. ; 2. ONE LINE MOVE, ALREADY IN ORDER (NEW = OLD). ; 3. MOVE THE BLOCK TO LOWER MEMORY (NEW #'S < OLD). ; 4. MOVE THE BLCCK TO HIGHER MEMORY ( NEW #'S > OLD). LDX #RTMP-DTAB ; 'START' ADDRESS. LDY #R2TMP-DTAB ; 'END' ADDRESS. JSR DCMPI BNE L64_XR500 ; ALREADY IN ORDER. ; MOVE ONE STATEMENT AT A TIME (TO AVOID 'NOT ENOUGH MEMORY'), USING 'TEXBUF'. ; 'BLOW' = ADDRESS OF NEXT STATEMENT TO MOVE. ; 'BHIGH' = ADDRESS PAST END. ; *S* LDX #RTMP-DTAB LDY #BLOW-DTAB JSR DCMPI ; IS 'NEW' < 'OLD'? BEQ L64_XR500 ; NEW = OLD. LDA #0 ; SET 'NEW' < 'OLD'. BCC L64_XR210 ; YES. LDA #1 ; NO -- SET 'NEW' > 'OLD'. L64_XR210 STA R2TMP L64_XR300 LDY #0 ; GET LENGTH OF STATEMENT. LDA (BLOW),Y TAY L64_XR310 LDA (BLOW),Y ; MOVE NEXT RYTE TO 'TEXBUF'. STA TEXBUF,Y ; (EXTRA BYTE IS "DON'T CARE"). DEY BPL L64_XR310 LDX #MEMA-DTAB LDY #BLOW-DTAB JSR DMOVI ; 'MEMA' = ADDRESS IN STORAGE. JSR MDEALL ; DELETE IT. LDA R2TMP ; 'NEW' > 'OLD'? BNE L64_XR320 ; YES. ; 'NEW' < 'OLD'. LDX #BLOW-DTAB LDY #MEMB-DTAB JSR DADDI ; ADJUST 'BLOW' FOR NEXT LINE. JMP L64_XR330 ; 'NEW' > 'OLD'. L64_XR320 LDX #RTMP-DTAB LDY #MEMB-DTAB JSR DSUBI ; MOVE 'RTMP' FOR INSERTION. LDX #BHIGH-DTAB ; *S* LDY #MEMB-DTAB JSR DSUBI ; ADJUST 'BHIGH' FOR NEXT LINE. ; ALLOCATE A BLOCK AT 'RTMP'. L64_XR330 LDX #MEMA-DTAB LDY #RTMP-DTAB JSR DMOVI JSR MALLOC ; ? ALLOCATE IT (MUST BE ROOM). LDY MEMB ; COPY STATEMENT FROM 'TEXBUF'. DEY ; # - 1 OF BYTES. L64_XR350 LDA TEXBUF,Y STA (RTMP),Y DEY BPL L64_XR350 ; STATEMENT HAS BEEN INSERTED. LDX #RTMP-DTAB LDY #MEMB-DTAB JSR DADDI ; ADJUST 'RTMP' FOR NEXT LINE. ; ANY MORE TO MOVE? LDX #BLOW-DTAB LDY #BHIGH-DTAB JSR DCMPI BCC L64_XR300 ; YES. L64_XR500 JSR RDYMES ; ALL DONE. LDA #0 ; SET CC FOR NORMAL EXIT. BEQ L64_XR990 ; (BRA). ; ERROR -- MAXIMUM LINE NUMBER EXCEEDED. L64_XR600 LDA #RENERR ; CAN'T RENUMBER. JSR MESSOT LDA #LNOERR ; LINE # OUT OF RANGE. JSR MESSOT JMP L64_XR500 ; ; ERROR -- OVERLAPPING RANGE. ; 'ALINE' FIRST NEW LINE. ; 'RTMP' LAST. L64_XR700 LDA #RENERR ; CAN'T RENUMBER. JSR MESSOT LDA #OVLPER ; OVERLAPPING RANGE. JSR MESSOT LDX #ALINE-DTAB ; FIRST NEW LINE. JSR DECASC LDA #TOMES ; TO. JSR MESSOT LDX #RTMP-DTAB ; LAST NEW LINE. JSR DECASC JMP L64_XR500 ; ERROR -- SYNTAX. L64_XR900 ; EXIT. L64_XR990 PHP ; SAVE CC. LDY XTEMP ; RESTORE Y. PLP ; RESTORE CC. RTS ; DEFAULTS FOR 'RENUMBER'. RENNMS .WORD 10 ; FIRST NEW. .WORD 10 ; INCREMENT. .WORD 0 ; FIRST OLD. .WORD MAXLN ; LAST OLD. .WORD EONMLS ; PROC ; ; MNYNMS -- RETURN 'MANY' NUMBERS FROM 'INLN' ; ; CALLING SEQUENCE: ; ; 'INLN' POINTS TO THE STATEMENT LINE ; Y = CUPPENT OFFSET IN 'INLN' ; 'POINT' = LIST OF VALUES FOR INITIALIZING 'NMSBF' ; ; JSR MNYNMS ; BNE SYNTAX ERROR, RANGE ERROR, OR TOO MANY NUMBERS (A=ERROR ; CODE) ; ; X = NUMBER OF NUMBERS FOUND. ; 'NMSBF' = LIST OF NUMBERS ; Y = CURRENT OFFSET IN 'INLN' ; XTEMP = CURRENT OFFSET IN 'INLN' ; ; 'NMSBF' IS INITIALIZED FROM THE LIST ADDRESSED BY 'POINT'. ; 'EONMLS' REPRESENTS THE END-OF-LIST. ; IF TOO MANY NUMER ARE IN THE SOURCE TEXT, AN ERROR CODE WILL BE ; RECOGNIZED. ; MNYNMS STY XTEMP LDY #0 ; INITIALIZE 'NMSBF' FROM 'POINT'. L65_MN010 LDA (POINT),Y STA NMSBF,Y INY LDA (POINT),Y STA NMSBF,Y INY CMP #>EONMLS ; CHECK FOR END OF LIST. BNE L65_MN010 LDY XTEMP ; RESTORE Y. LDA #0 STA POINT ; INITIALIZE OFFSET TO STORE NEXT VALUE. L65_MN020 JSR SKPSEP ; SKIP LOADING SEPARATORS. JSR ATOM ; GET NEXT NUMBER. BNE L65_MN099 ; ERROR -- RETURN. CMP #NULL ; CHECK FOR 'EOL'. BEQ L65_MN099 ; EOL -- DONE. CMP #NUM ; CHECK FOR NUMBER. BNE L65_MN090 ; NO -- ERROR. STY XTEMP ; SAVE Y. LDX #NUMBER-DTAB ; CHECK IF NUMBER IS IN RANGE. JSR CHKLN BCS L65_MN080 ; NO -- OUT OF RANGE. LDX POINT ; INDEX IN 'NMSBF'. LDA #$FF ; CHECK IF TOO MANY VALUES. CMP NMSBF+1,X BEQ L65_MN090 ; YES -- TOO MANY. LDA NUMBER ; COPY TO NEXT POSITION IN 'NMSBF'. STA NMSBF,X LDA NUMBER+1 STA NMSBF+1,X INX INX STX POINT ; UPDATE INDEX. LDY XTEMP ; RESTORE Y. BNE L65_MN020 ; (BRA). ; OUT OF RANGE L65_MN080 LDA #LNOERR BNE L65_MN099 ; (BRA). ; NEXT 'ATOM' IS NOT A NUMBER, OR TOO MANY NUMBERS. L65_MN090 LDA #IMPERR ; IMPROPER PARAMETER ERROR. L65_MN099 PHP ; SAVE CC. LDA POINT ; INDEX IN 'NMSBF'. LSR TAX ; AS ADVERTISED. PLP RTS ; PROC ; ; BRACKT -- BRACKET A RANGE OF LINES ; ; CALLING SEQUENCE: ; ; 'LS' = START OF RANGE ; 'LEND' = END ; ; JSR BRACKT ; BNE 'LS' > 'LEND' ; ; 'BLOW' = ADDRESS OF START OF RANGE ; 'BHIGH' = ADDRESS OF (PAST) END OF RANGE ; 'BNUM' = # OF LINES IN THE RANGE ; ; USES 'LINENO', 'POINT' ; BRACKT LDX #LEND-DTAB ; CHECK IF 'LS' <= 'LEND LDY #LS-DTAB JSR DCMPI BCC L66_BR090 ; ERROR -- 'LS' > 'LEND' LDA #0 ; INITIALIZE # OF LINES. STA BNUM STA BNUM+1 LDX #LS-DTAB JSR LNFIND LDX #BLOW-DTAB ; 'BLOW' = ADDRESS OF 'LS' OR SUCCESSOR. LDY #PP-DTAB JSR DMOVI LDX #POINT-DTAB ; USE 'POINT' FOR CURRENT LINE ADDRESS. JSR DMOVI L66_BR010 ; *S* LDX #POINT-DTAB JSR SEND ; CHECK IF END OF LIST. BEQ L66_BR050 ; YES -- DONE. JSR GTLNNO ; 'LINENO' IN L/H ORDER FROM 'POINT'. LDX #LEND-DTAB ; CHECK IF CURRENT LINE IS IN RANGE. LDY #LINENO-DTAB JSR DCMPI BCC L66_BR050 ; NO -- NOT IN RANGE. LDA #1 ; ONE MORE LINE IN RANGE. LDX #BNUM-DTAB JSR DADDS LDX #POINT-DTAB ; POINT TO NEXT LINE. JSR SNXTI JMP L66_BR010 ; CHECK NEXT LINE. ; CURRENT LINE IS NOT IN THE RANGE. L66_BR050 LDX #BHIGH-DTAB ; AS ADVERTISED. LDY #POINT-DTAB JSR DMOVI LDA #0 ; SET CC FOR EXIT. ; +S* RTS ; ERROR -- 'LS' > 'LEND' L66_BR090 RTS ; PROC ; ; GTLSLN -- GET LINE NUMBER OF LAST PROGRAM LINE + 10 ; ; CALLING SEQUENCE: ; ; JSR GTLSLN ; ; 'LINENO' = LAST LINE NUMBER + 10 (0 IF EMPTY). ; GTLSLN STY XTEMP ; SAVE Y. LDA #0 ; 'EMPTY' VALUE. STA LINENO STA LINENO+1 JSR STMLST ; 'LP' = 'S1L' LDX #LP-DTAB JSR SEND ; TRAP FOR PROGRAM EMPTY. BEQ L67_GL090 ; EMPTY. L67_GL010 LDY #LP-DTAB ; UPDATE 'POINT'. LDX #POINT-DTAB JSR DMOVI LDX #LP-DTAB ; NEXT LINE. JSR SNXTI JSR SEND BNE L67_GL010 ; KEEP CHECKING. JSR GTLNNO ; 'LINENO' FROM 'POINT'. L67_GL090 LDX #LINENO-DTAB ; LAST LINE + 10 LDA #10 JSR DADDS LDY XTEMP ; RESTORE Y. RTS ; PROC ; ; RENFND -- FIND LINE FOR 'RENUMBER' ; ; CALLING SEQUENCE: ; ; X = DTAB OFFSET TO LINE NUMBER ; 'BLOW' = ADDRESS OF FIRST LINE TO RENUMBER ; 'BHIGH' = ADDRESS PAST LAST ; ; JSR RENFND ; A = 0 VALID ; 1 LINE OVERLAPS A NON-RENUMBERED ONE (ERROR) ; ; PP = ADDRESS OF LINE (OR SUCCESSOR) ; RENFND JSR LNFIND ; FIND ADDRESS. BNE L68_RFD80 ; NO OVERLAP. LDX #PP-DTAB ; >= 'BLOW'? LDY #BLOW-DTAB JSR DCMPI BCC L68_RFD90 ; NO -- ERROR. ; *S* LDX #PP-DTAB LDY #BHIGH-DTAB ; < 'BHIGH'? JSR DCMPI BCS L68_RFD90 ; NO ERROR. L68_RFD80 LDA #0 ; CLEAR A FOR EXIT RTS L68_RFD90 LDA #1 ; SET A FOR ERROR. RTS ; PROC ; ; LNFIND -- FIND LINE NUMBER ; ; CALLING SEQUENCE: ; ; X = OFFSET TO DTAB LINE NUMBER ; ; JSR LNFIND ; BNE NOT FOUND (PP POINTS TO SUCCESSOR) ; ; PP = ADDRESS OF LINE (OR SUCCESSOR) ; ; USES LINENO ; LNFIND LDA DTAB,X ; INVERT LINE NUMBER FOR SEARCH STA LINENO+1 LDA DTAB+1,X STA LINENO JSR NUMNAM ; SETUP 'LINENO' FOR SEARCH. JMP IFIND ; FIND LINE (OP SUCCESSOR). ; PROC ; CHKLN -- CHECK STATEMENT LINE # FOR OUT OF RANGE. ; ; CALLING SEQUENCE: ; ; X = DTAB INDEX TO LINE NUMBER. ; ; JSR CHKLN ; BCS OUT OF RANGE (A = ERROR CODE) ; CHKLN LDY #>[MAXLN+1] LDA #<[MAXLN+1] JSR DCWCI BCC L70_CL090 ; NOT OUT OF RANGE. LDA #LNOERR L70_CL090 RTS ; PROC ; ; NMOVI -- MOVE VALUE FROM 'NMSBF' ; ; CALLING SEQUENCE: ; ; X = DTAB OFFSET TO DESTINATION ; Y = 'NMSBF' OFFSET ; ; JSR NMOVI ; ; DTAB(X) = NMSBF+Y,+Y+1 ; NMOVI LDA NMSBF,Y STA DTAB,X LDA NMSBF+1,Y STA DTAB+1,X RTS ; ; I/O SUBSYTEM ROUTINES ; ; PROC ; ; CHOT -- PRINT ONE CHARACTER TO "E:". ; ; A = ATASCII CHARACTER ; 'CDEST' = I/O ROUTINE OFFSET OR $80 + XX OR $FF ; ; JSR CHOT ; CHOT STX TEMP ; SAVE REGISTERS. STY TEMP+1 LDX CDEST ; PREPARE TO OUTPUT TO DEVICE. BMI L72_CH100 ; SPECIAL OUTPUT. JSR IOHAND ; *** EXTERNAL ENTRY POINT *** IOERCK CPY #0 ; ERROR CHECK. BPL L72_CH120 ; O.K. ; *** EXTERNAL ENTRY POINT *** IOE010 STY IOSTAT ; SAVE I/O STATUS. LDA #IOERR JMP PSTOP ; STOP ON ERROR. L72_CH100 CPX #$FF ; RESULT TO 'TEXBUF'? BEQ L72_CH110 ; YES. LDX #IOCB3 ; NO -- TO IOCB 3. JMP DIO005 ; OUTPUT CHARACTER AND RETURN L72_CH110 LDY TELN+3 ; GET INDEX. CPY #TEXLNG ; BUFFER FULL? BEQ L72_CH120 ; YES -- STORE NO MORE. STA (TELN),Y ; NO -- STORE CHARACTER. INC TELN+3 L72_CH120 LDY TEMP+1 ; RESTORE REGISTERS. LDX TEMP RTS ; PROC ; ; GETLIN -- GET LINE FROR "E:" ; ; CALLING SEQUENCE: ; ; X = OFFSET TO BUFFER ADDRESS. ; ; JSR GETLIN ; ; DTAB(X+2) = 0 -- START INDEX. ; DTAB(X+3) = LINE LENGTH -- END INDEX. ; GETLIN STX TEMP+2 ; SAVE INDICES. STY TEMP+3 LDA #0 ; ENABLE TEXT CURSOR. STA DTAB+2,X ; AS ADVERTISED. JSR CRSNOP ; MAKE CURSOR SHOW NOW. LDA DTAB,X ; SETUP BUFFER ADDRESS. STA IOCB0+ICBAL LDA DTAB+1,X STA IOCB0+ICBAH LDA #GETR ; GET RECORD COMMAND. STA IOCB0+ICCOM L73_GL010 LDA #LINLNG-1 ; SETUP MAXIMUM LINE LENGTH FOR READ. STA IOCB0+ICBLL LDX #IOCB0 ; IOCB0. STX IOCB0+ICBLH ; *S*. JSR CIO ; DO I/O. CPY #$89 ; TRUNCATED RECORD? BNE L73_GL020 ; NO. LDA #OLLERR ; YES -- INFORM OPERATOR & TRY AGAIN JSR MESSOT JMP L73_GL010 L73_GL020 TYA ; ERROR CHECK BMI IOE010 ; ERROR. JSR CRSNOP ; DISABLE TEXT CURSOR (A <> 0). LDX TEMP+2 ; RESTORE INDICES. LDY TEMP+3 LDA IOCB0+ICBLL ; SETUP END INDEX. STA DTAB+3,X RTS ; PROC ; ; TXOPEN -- OPEN THE TEXT SCREEN. ; TXOPEN LDX #0 ; RESET GRAPHICS MODE FLAG. STX GRFLAG STX LETTRSZ ; SMALL LETTERS. STX TRTLON ; VISIBLE TURTLE OFF. JSR TRONOF JSR COMPRS ; COMPRESS MEMORY. LDX #IOCB2 ; CLOSE 'S'. JSR DCLOSE JSR EOPEN ; OPEN 'E'. JMP EXPAND ; EXPAND MEMORY & RETURN. ; PROC ; ; GSOPEN -- OPEN THE GRAPHICS SCREEN ; ; THIS ROUTINE COMPRESSES MEMORY, OPENS THE GRAPHICS SCREEN AND DE-COMPRESSES ; THE MEMORY AGAIN. ; ; CALLING SEQUENCE: ; ; 'GSMODE' = SCREEN MODE NUMBER. ; 'SPLTSC' = SPLIT SCREEN OPTION SELECT. ; 'FINEFG' = FINE SCROLLING FLAG. ; ; JSR GSOPEN ; ; 'XC' & 'YC' = SCREEN CENTER. ; 'S2L'&'S2H' = VAR LIMITS. ; 'APPMHI' = TOP OF VARIABLES. ; 'TRTLON' = 1 OR 0. ; 'THETA' = 0. ; 'GX' & 'GY' = 0. ; GSOPEN JSR COMPRS ; COMPRESS MEMORY. ; NOW ATTEMPT TO OPEN 'S:' TO THE DESIRED SCREEN MODE; THERE MAY ; ENOUGH MEMORY # HOWEVER. L75_GO010 LDX #IOCB2 JSR DCLOSE LDA #'S' ; DEVICE NAME = 'S'. STA OPNBUF LDA #EOL STA OPNBUF+1 LDA #OWRIT+OREAD ; SCREEN OPTIONS. ORA SPLTSC LDX GSMODE ; IF NO MODE CHANGE ... CPX DINDEX BNE L75_GO012 ORA #NOCLR ; ... THEN DON'T CLEAR SCREEN. L75_GO012 STA IOCB2+ICAUX1 STX IOCB2+ICAUX2 LDA #OPEN ; OPEN COMMAND. STA IOCB2+ICCOM LDX #IOCB2 ; OPEN DEVICE ON IOCB2. JSR BUFPNT ; SETUP OPEN BUFFER POINT. JSR CIO STY IOSTAT ; SAVE STATUS FOR LATER. BPL L75_GO013 JMP L75_GO020 ; ERROR -- DON'T PLOT POINT. L75_GO013 DEC CRSINH ; INHIBIT THE CURSOR. LDA GSMODE ; SETUP MODE DEPENDENT VARIABLES ASL ; X2 TAX LDA XCENTR,X STA XC LDA XCENTR+1,X STA XC+1 LDA YCENTR,X STA YC LDA YCENTR+1,X STA YC+1 LDA COLMAX,X ; SET 'FLOOD' LIMITS. STA MAXCOL LDA COLMAX+1,X STA MAXCOL+1 LDA ROWMAX,X STA MAXROW LDX GSMODE LDA COLRS,X ; # OF FOREGROUND COLORS. STA NCOLRS CPX #2+1 ; SEE IF MODES 1 OR 2. BCS L75_GO015 ; NO -- MODE 3-15 LDA LMRGTB,X ; SET MARGINS FOR LARGE LETTERS. STA LFCOL LDA RMRGTB,X STA RGCOL CLC LDA MAXROW ADC #2 ; SET 'BOTSCR' FOR 'VPOS'. STA BOTSCR LDA #KOFF ; SET TURTLE OFF. STA TRTLON LDA #SPUTC-IOVBAS ; ROUTE OUTPUTS TO S*. STA CDEST JMP L75_GO020 ; AVOID TURTLE SETUP. L75_GO015 LDA IOCB2+ICAUX1 ; WAS SCREEN CLEARED? AND #NOCLR BEQ L75_GO017 ; YES. LDA NCOLRS ; NO -- RE-ESTABLISH COLOR REGS. L75_GO016 PHA TAX LDA PNCLRS,X JSR SETCLR PLA SEC SBC #1 BPL L75_GO016 BMI L75_GO018 ; (BRA). L75_GO017 JSR DFCLRS ; SET DEFAULT COLORS FOR MODE. LDA #EPUTC-IOVBAS ; ROUTE OUTPUTS TO E:. STA CDEST LDA #0 ; CLEAR WALL SELECTION. STA WALLS STA WALLS+1 STA PEN ; SET PEN TO ERASE & DOWN. STA LETTRSZ ; LETTER SIZE = SMALL. L75_GO018 LDA #KON ; SET TURTLE ON. STA TRTLON JSR GHOME ; TURTLE HOME. JSR GNORTH ; TURTLE NORTH. LDA SPLTSC ; SPLIT SCREEN MODE? BEQ L75_GO020 ; NO -- FULL SCREEN. LDA #GRDLI STA VDSLST+1 LDA #$C0 ; ENABLE VBLANK 8, DLI. STA NMIEN LDX GSMODE ; GET MODE DEPENDENT OFFSET FROM START ... LDA DLIOFF,X ; ... OF DISPLAY LIST TO LCC OF DLI. TAY LDA SDLSTL STA TEMP LDA SDLSTL+1 STA TEMP+1 LDA (TEMP),Y ; SET THE DLI BIT. ORA #SB STA (TEMP),Y L75_GO020 JSR TRONOF ; ENABLE OR DISABLE VISIBLE TURTLE. JSR EXPAND ; EXPAND MEMORY. LDY IOSTAT ; SEE IF THERE WAS AN I/O ERROR. BPL L75_GO090 ; NO. LDX #IOCB2 ; YES -- CLOSE DEVICE & REPORT ERROR. JSR DCLOSE JMP IOE010 L75_GO090 LDA #1 STA GRFLAG ; SET GRAPHICS SCREEN FLAG. RTS ; PROC ; FIRST COMPRESS THE RAM STORAGE, LEAVING THE FREE AREA AT THE HIGH ADDRESSES ; BY REMOVING THE GAP BETWEEN THE PROGRAM STORAGE AREA AND THE STRING ; STORAGE AREA. COMPRS LDA S1H ; 'MDP' = 'S1H' (DESTINATION). STA MDP LDA S1H+1 STA MDP+1 LDA S2L ; 'MSP' = 'S2L' (SOURCE). STA MSP LDA S2L+1 STA MSP+1 SEC ; 'MBC' = 'S2H' - 'S2L' (BYTE COUNT). LDA S2H ; ('CETEMP' = SAME). SBC S2L STA MBC STA CETEMP ; (SAVE FOR LATER). LDA S2H+1 SBC S2L+1 STA MBC+1 STA CETEMP+1 CLC ; 'APPMHI' = 'S1H' + 'MBC'. LDA S1H ADC MBC STA APPMHI LDA S1H+1 ADC MBC+1 STA APPMHI+1 JMP MOVIA ; MOVE STRING STORAGE DOWN & RETURN. ; PROC ; NOW MOVE THE STRING STORAGE AREA UP TO THE CURRENT TOP OF MEMORY SO ; THAT THE FREE AREA IS ONCE AGAIN BETWEEN THE PROGRAM STORAGE AREA AND ; THE STRING STORAGE AREA. EXPAND LDA CETEMP ; 'MBC' = PRIOR 'MBC' (BYTE COUNT). STA MBC LDA CETEMP+1 STA MBC+1 LDA S1H ; 'MSP' = 'S1H' (SOURCE). STA MSP LDA S1H+1 STA MSP+1 SEC ; 'MDP' = 'MEMHI' - 'MBC' (DESTINATION). LDA MEMHI STA S2H ; 'S2H' = 'MEMHI'. SBC MBC STA MDP STA S2L ; S2L' = SAME AS NEW 'MDP'. LDA MEMHI+1 ; NOW AS ABOVE FOR MSB. STA S2H+1 SBC MBC+1 STA MDP+1 STA S2L+1 LDA #0 ; ALLOWS RESET IN ANY MODE. STA APPMHI STA APPMHI+1 JMP MOVDA ; MOVE STRING STORAGE TO TOP OF MEM & RETURN. ; PROC ; ; EOPEN -- OPEN IOCB 0 TO E: ; EOPEN LDX #IOCB0 JSR DCLOSE LDA FINEFG STA FINE LDA #EPUTC-IOVBAS STA CDEST LDA #'E' STA OPNBUF LDA #EOL STA OPNBUF+1 LDA #OREAD+OWRIT JSR DOPEN LDA LMARGN STA LFCOL LDA RMARGN STA RGCOL DEC CRSINH RTS ; PROC ; ; TSTMOD -- TEST SCREEN MODE ; ; CALLING SEQUENCE: ; ; GRFLAG = 0 FOR TEXT, ELSE GRAPHICS. ; SPLTSC = 0 FOR FULL SCREEN, ELSE SPLIT. ; LETTRS = 0 FOR SMALL, ELSE MEDIUM OR LARGE. ; ; JSR TSTMOD ; ; A = 1 IF TEXT SCREEN, SMALL LETTERS. ; 2 IF TEXT SCREEN, MEDIUM OR LARGE LETTERS. ; 4 IF GRAPHICS SCREEN, WITH TEXT WINDOW (SPLIT). ; 8 IF FULL GRAPHICS SCREEN. TSTMOD LDA GRFLAG ; GRAPHICS MODE? BNE L79_TM030 ; YES. LDA LETTRSZ ; NO -- CHECK FOR LETTER SIZE BNE L79_TM020 ; NOT SMALL. LDA #TXSL ; SMALL. RTS L79_TM020 LDA #TXML ; MEDIUM OR LARGE. RTS L79_TM030 LDA SPLTSC ; SPLIT SCREEN GRAPHICS? BEQ L79_TM040 ; NO -- FULL. LDA #GRSS ; YES -- SPLIT SCREEN. RTS L79_TM040 LDA #GRFS ; FULL SCREEN GRAPHICS. RTS ; PROC ; ; DNAME -- EXTRACT DEVICE/FILENAME ; ; CALLING SEQUENCE: ; ; Y = INDEX TO START OF NAME ; ; JSR DNAME ; ; Y = INDEX TO NAME DELIMITER. ; X = 'OPNBUF' INDEX TO CHAR AFTER NAME (EOL). ; 'OPNBUF' RECEIVES NAME. ; DNAME JSR SLB ; SKIP LEADING BLANKS. JMP FNAME ; NAME TO 'OPNBUF' & RETURN. ; PROC FNAME LDX #0 L81_FN010 LDA (INLN),Y JSR CHKSEP ; SEPARATOR? BEQ L81_FN020 ; YES -- DONE. STA OPNBUF,X ; NO -- PART OF NAME. INX INY CPX #DNSIZE ; NAME TOO LONG? BNE L81_FN010 ; NO -- KEEP SCANNING. L81_FN020 LDA #EOL ; APPEND EOL AFTER NAME. STA OPNBUF,X RTS ; PROC ; ; DOPEN -- DEVICE OPEN ; ; CALLING SEQUENCE: ; ; 'IOEDIS' <> 0 INDICATES TO IGNORE I/O ERROR. ; X = IOCB INDEX. ; A = OPEN DIRECTION + AUX1 OPTIONS. ; 'OPNBUF' CONTAINS DEVICE/FILENAME. ; ; JSR DOPEN ; ; RETURNS ONLY IF OPEN SUCCEEDED. ; DOPEN PHA ; SAVE OPEN CODE. JSR DCLOSE ; *** JUST IN CASE *** PLA ; RESTORE OPEN CODE. STX TEMP STY TEMP+1 ORA AUX1 ; MERGE USER BYTE. STA ICAUX1,X ; SETUP OPEN DIRECTION. JSR CHKDEV ; CHECK FOR INVALID OPEN. LDA AUX2 ; SETUP AUX2. STA ICAUX2,X LDA #0 STA ICBLL,X ; SETUP FOR ACCUMULATOR XFER OF DATA. STA ICBLH,X STA AUX1 ; CLEAR USER BYTES. STA AUX2 LDA #OPEN ; OPEN COMMAND. STA ICCOM,X JSR BUFPNT ; SETUP OPEN BUFFER POINTER. JSR CIO ; JSR COLORS ; RE-ESTABLISH SPECIAL COLORS. ; ; *** NEEDED ONLY IF OUTPUT TO S: OR E: ALLOWED ; ; IN GRAPHICS MODE *** TYA ; CHECK STATUS. BPL DOP010 ; O.K. ; *** EXTERNAL ENTRY POINT *** ; ; X = IOCB INDEX. ; Y = ERROR STATUS ON ENTRY. DOP005 LDA IOEDIS ; ERROR STOP DISABLED? PHP LDA #EOL ; (RETURN EOL CHAR ON ERROR). PLP BEQ L82_DO007 ; NO. LDA RUN ; YES -- IS IT ALSO RUN MODE? PHP LDA #EOL ; RETURN EOL ON ERROR. PLP BNE DOP010 ; YES. L82_DO007 JSR DCLOSE ; NO -- CLOSE FILE IN ERROR. JMP IOE010 ; ERROR -- STOP (SKIP BRANCH POINT). ; PROC ; ; DCLOSE -- CLOSE IOCB ; ; CALLING SEQUENCE: ; ; X = IOCB INDEX ; ; JSR DCLOSE ; ; NOTE: CLOSE STATUS IS OF NO IMPORTANCE TO THIS ROUTINE. ; DCLOSE STX TEMP STY TEMP+1 LDA #CLOSE STA ICCOM,X JSR CIO JSR AUDCLR ; CLEAR AUDIO REGISTERS. ; *** EXTERNAL ENTRY POINT *** DOP010 DIO010 LDX TEMP ; RESTORE REGISTERS. LDY TEMP+1 RTS ; PROC ; ; DIN & DOUT -- IOCB DATA IN AND OUT ; ; CALLING SEQUENCE: ; ; 'IOEDIS' <> 0 INDICATES TO IGNORE I/O ERROR. ; X = IOCB INDEX ; A = DATA ('DOUT' ONLY) ; ; JSR DIN/DOUT ; ; A = DATA ('DIN' ONLY), RETURNS EOL ON ERROR. ; DIN PHA LDA #GETC ; SETUP COMMAND BYTE. BNE L84_IO003 ; (BRA). DOUT PHA ; SAVE DATA BYTE. LDA #PUTC ; SETUP COMMAND BYTE. L84_IO003 STA ICCOM,X PLA STX TEMP ; SAVE REGISTERS. STY TEMP+1 ; *** EXTERNAL ENTRY POINT FROM 'CHOT' *** DIO005 JSR CIO STY IOSTAT ; SAVE I/O STATUS. CPY #0 ; CHECK STATUS. BPL DIO010 ; O.K. LDA #EOL ; RETURN EOL ON ERROR. CPY #$88 ; END OF FILE? BNE DOP005 ; NO -- FATAL ERROR (SKIP BRANCH). BEQ DIO010 ; YES -- RETURN EOL (BRA). ; PROC ; ; KIN -- KEYBOARD CHARACTER INPUT ; ; CALLING SEQUENCE: ; ; JSR KIN ; ; A = ATASCII CHAR ; KIN STX TEMP ; SAME REGISTERS. STY TEMP+1 LDX #KGETC-IOVBAS ; GET CHAR FROM 'K'. JSR IOHAND JMP IOERCK ; CHECK FOR ERROR & RETURN. ; PROC ; ; TOUT -- GRAPHICS DATA OUTPUT ; ; CALLING SEQUENCE: ; ; A = ONE GRAPHICS PIXEL ; ; JSR TOUT ; TOUT STX TEMP ; SAVE REGISTERS. STY TEMP+1 LDX #SPUTC-IOVBAS ; PUT CHARACTER TO 'S:' JSR IOHAND JMP IOERCK ; CHECK FOR ERROR & RETURN. ; PROC BUFPNT LDA #OPNBUF STA ICBAH,X RTS ; PROC ; ; PRTSTG -- PRINT TEXT DATA ; ; CALLING SEQUENCE: ; ; X = OFFSET TO TEXT DATA POINTER. ; ; JSR PRTSTG ; PRTSTG STY TEMP2+3 LDA DTAB,X ; MOVE POINTER. STA TEMP2 LDA DTAB+1,X STA TEMP2+1 LDA DTAB+3,X ; ENDING INDEX. STA TEMP2+2 LDY DTAB+2,X ; STARTING INDEX. L88_PR010 CPY TEMP2+2 ; COMPARE START INDEX WITH END BEQ L88_PR080 ; EQUAL -- DONE. LDA (TEMP2),Y ; GET NEXT CHARACTER. INY JSR CHOT ; PRINT CHARACTER. JMP L88_PR010 L88_PR080 LDY TEMP2+3 RTS ; PROC ; ; IOHAND -- DIRECT I/O TO INTERFACE ROUTINE ; ; CALLING SEQUENCE: ; ; X = I/O ROUTINE OFFSET TO ADDRESS TABLE ENTRY (SYSTEM) ; ; JSR IOHAND ; ; CLOBBERS Y REGISTER. ; IOHAND TAY ; SAVE REGISTER A. LDA IOVBAS+1,X ; GET ADDRESS MSB. PHA LDA IOVBAS+0,X ; GET ADDRESS USB. PHA TYA ; RESTORE REGISTER A. RTS ; (JMP) TO HANDLER. ; PROC ; ; SFNAME -- GET DEVICE NAME AND STORE IN 'OPNBUF'. ; ; CALLING SEQUENCE: ; ; 'EXEC = 0 FOR SCAN MODE, ELSE EXECUTE. ; 'XXXX' = INPUT LINE INDEX. ; X = INDEX TO EOL IN 'OPNBUF'. ; ; JSR SFNAME ; BNE ERROR (A = ERROR CODE). ; ; 'OPNBUF' = DEVICE NAME. ; Y = INPUT LINE INDEX TO FIELD AFTER DEVICE/FILENAME. ; SFNAME JSR ATOM ; GET DEVICE/FILENAME BNE L90_SF090 ; ERROR. CMP #TEXT ; TEXT LITERAL? BEQ L90_SF100 ; YES. AND #SVAR+USVAR ; STRING NAME? BNE L90_SF200 ; YES. LDA #IMPERR ; NO -- ERROR. L90_SF090 RTS ; RETURN WITH CC SET. ; SCAN TEXT LITERAL DATA TO EXTRACT DEVICE/FILENAME. L90_SF100 JSR FNAME ; NAME TO 'OPNBUF'. STY XXXX ; SAVE LINE INDEX. LDA #0 ; SET CC FOR NORMAL EXIT. RTS ; RETURN WITH CC SET. ; DEVICE/FILENAME IS A STRING VARIABLE VALUE L90_SF200 LDA EXEC ; EXECUTE MODE? BEQ L90_SF090 ; NO -- DONE. STY XXXX LDX #0 LDY DP+2 L90_SF220 CPY DP+3 ; DONE? BEQ L90_SF250 ; YES. LDA (DP),Y ; NO -- MOVE NAME. STA OPNBUF,X INY INX CPX #DNSIZE ; OVERLENGTH NAME? BNE L90_SF220 ; O.K. SO FAR. L90_SF250 LDA #EOL STA OPNBUF,X LDA #0 ; SET CC FOR NORMAL EXIT. RTS ; RETURN WITH CC SET. ; PROC ; ; SCNDEV -- GET DEVICE NAME AND SETUP FOR 'READ:', 'WRITE:' OR 'CLOSE:' ; ; CALLING SEQUENCE: ; ; 'EXEC' = 0 FOR SCAN MODE, ELSE EXECUTE. ; Y = INPUT LINE INDEX. ; A = AUX1 OPEN CODE. (0 = CLOSE, ELSE OPEN). ; SCNDEV STA LEND ; SAVE DEVICE OPEN CODE. JSR SFNAME ; EXTRACT FILENAME. BNE L91_SC290 ; ERROR. LDA EXEC ; EXECUTE MODE? BEQ L91_SC290 ; NO -- ALL DONE. LDA #0 STA IOSTAT ; CLEAR I/O STATUS. STA NP+2 STX NP+3 LDA #OPNBUF STA NP+1 JSR SETSVL ; SETUP TO ACCESS STRING VARIABLE LIST. LDA #ATRIO ; 'I/O' ATTRIBUTE. STA ATRTYP JSR SFIND ; SEE IF STRING EXIS:T. BNE L91_SC300 ; NO. LDY DP+2 ; YES -- GET IOCB INDEX FROM VALUE. LDA (DP),Y PHA LDA LEND ; LOOK AT "OPEN" CODE. BNE L91_SC270 ; NORMAL IN OR OUT. JSR SDELET ; 'DONE' -- DELETE NAME. L91_SC270 PLA TAX LDY XXXX LDA #0 ; SET CC FOR NORMAL EXIT. L91_SC290 RTS ; RETURN WITH CC SET. ; FIRST ACCESS TO DEVICE, DO IMPLICIT OPEN. L91_SC300 JSR CHKDEV ; CHECK FOR VALID DEVICE. LDA LEND ; CHECK "OPEN" CODE. BNE L91_SC310 ; NORMAL IN OR OUT. LDY XXXX ; RESTORE INDEX. LDA #IMPERR ; 'DONE' -- CLOSING NON-OPEN FILE. RTS L91_SC310 JSR FNDIOB ; FIND A FREE IOCB, IF AVAILABLE. BNE L91_SC900 ; NONE AVAILABLE. LDA LEND ; GET AUX1 OPEN CODE. JSR DOPEN ; OPEN DEVICE. STX LS ; SAVE IOCB # ASSOCIATED WITH DEVICE. STX CRSINH ; INHIBIT CURSOR JUST IN CASE. LDA #LS STA DP+1 LDA #0 STA DP+2 LDA #1 STA DP+3 JSR SINSRT ; INSERT NAMED STRING CONTAINING INFO. PHP LDX LS LDY XXXX PLP L91_SC900 RTS ; RETURN WITH CC SET. ; PROC ; ; FNDIOB -- FIND A FREE IOCB ; ; CALLING SEQUENCE: ; ; JSR FNDIOB ; BNE NO FREE IOCB (A = ERROR CODE) ; ; X = = IOCB INDEX. ; FNDIOB LDX #IOCB4 ; START WITH IOCB #4. L92_FD010 LDA ICHID,X ; TEST FOR CURRENTLY UNUSED. CMP #$FF BEQ L92_FD090 ; FOUND ONE. JSR NXTIOB ; BUMP INDEX TO NEXT IOCB. BNE L92_FD010 ; MORE TO CHECK. LDA #FILERR ; NONE AVAILABLE. L92_FD090 RTS ; RETURN WITH CC SET. ; PROC ; ; CLOSEM -- CLOSE IOCBS 3 THROUGH 7 (WHETHER OPEN OR NOT). ; CLOSEM LDX #IOCB3 ; START WITH IOCB #3. L93_CL010 JSR DCLOSE ; CLOSE THE IOCB. JSR NXTIOB ; BUMP INDEX TO NEXT IOCB. BNE L93_CL010 ; MORE TO DO. RTS ; PROC ; ; NXTIOB -- BUMP INDEX TO NEXT IOCB. ; ; CALLING SEQUENCE: ; ; X = IOCB INDEX ; ; JSR NXTIOB ; BEQ INDEX PAST IOCB #7 ; ; X = IOCB INDEX TO NEXT IOCB ; NXTIOB TXA CLC ADC #IOCBSZ TAX CPX #IOCB7+IOCBSZ RDV090 CKD090 RTS ; RETURN WITH CC SET. ; PROC ; ; REMDEV -- REMOVE DEVICE ASSIGNMENTS FROM STRING LIST ; L95_RD000 LDX #MEMA-DTAB ; REMOVE STRING VAR FROM LIST. LDY #LP-DTAB JSR DMOVI JSR MDEALL REMDEV JSR SETSVL ; SETUP TO SCAN STRING VARIABLES ... LDX #LP-DTAB ; ... TO REMOVE ALL DEVICE ASSIGNMENTS. L95_RD010 JSR SEND ; END OF LIST? BEQ RDV090 ; YES. LDX #LP-DTAB ; CHECK ATTRIBUTE. JSR SATTR CMP #ATRIO BEQ L95_RD000 ; YES -- REMOVE IT FROM LIST. JSR SNXTI ; GO TO NEXT ITEM IN LTST. JMP L95_RD010 ; PROC ; CHKDEV -- CHECK FOR VALID DEVICE CHKDEV JSR TSTMOD ; CHECK SCREEN MODE. CMP #TXSL ; TEXT, SMALL LETTERS? BEQ CKD090 ; YES -- NO RESTRICTIONS. LDA OPNBUF ; CHECK FOR 'E' OR 'S'. CMP #'E' BEQ L96_CK010 ; INVALID -- CLOBBERS SCREEN. CMP #'S' BNE CKD090 L96_CK010 LDA #SCNERR JMP PSTOP ; ; THIS PACKAGE HAS THREE LEVELS OF STRING HANDLING ROUTINES: ; ; NAMED STRING HANDLING -- SFIND, SDELET & SINSRT ; ; TEXT DATA HANDLING -- SCORP ; ; IMPLEMENTATION UTILITIES -- IFIND, SEND, PSETUP, PROVE, ICOMP ; ILENG, SNXTI, IMATCH & IALLOC ; ; ; NAMED STRING HANDLING ; ; THESE ROUTINES USE THE FOLLOWING VARIABLES ; ; NP = POINTER TO STRING NAME. ; DP = POINTER TO STRING DATA PORTION. ; LP = POINTER TO START OF LIST OF NAMED STRINGS (S1L OR S2L). ; ; PROC ; ; SFIND -- FIND NAMED STRING IN LIST ; ; CALLING SEQUENCE: ; ; LP POINTS TO START OF LIST OF NAMED STRINGS ; NP POINTS TO NAME TO FIND IN LIST ; ATRTYP SET ; ; JSR SFIND ; BNE NAME NOT IN LIST OR NAME IS NULL ; ; DP POINTS TO DATA PORTION OF NAMED STRING FOUND IN LIST ; SFIND JSR IFIND ; FIND NAME IN LIST. BNE L97_SF080 ; NOT FOUND. LDX #DP-DTAB ; SET 'DP' TO POINT TO DATA PORTION. LDY #PP-DTAB JSR DMOVI LDA PP+3 ; SKIP OVER NAME PORTION. JSR DADDP LDA #1 ; SET START INDEX. STA DP+2 LDY #0 ; SET END INDEX. CLC ADC (DP),Y STA DP+3 TYA ; SET CC FOR EXIT. L97_SF080 RTS ; RETURN WITH CC SET. ; PROC ; ; SDELET -- DELETE NAMED STRING FROM LIST ; ; CALLING SEQUENCE: ; ; NP POINTS TO STRING NAME ; LP POINTS TO START OF LIST OF NAMED STRNGS ; ATRTYP SET ; ; JSR SDELET ; BNE NAMED STRING NOT FOUND OR NAME IS NULL ; SDELET JSR IFIND ; FIND STRING IN LIST. BNE L98_SD090 ; NAMED STRING NOT FOUND. ; * * * EXTERNAL ENTRY POINT *** SDEL2 LDX #MEMA-DTAB ; MEMA = PP (FOR DEALLOCATE CALL). LDY #PP-DTAB JSR DMOVI JSR MDEALL ; DELETE STRING. LDX #PP-DTAB ; PP = MEMA. LDY #MEMA-DTAB JSR DMOVI LDA #0 ; SET CC FOR NORMAL EXIT. L98_SD090 RTS ; RETURN WITH CC SET. ; PROC ; ; SINSRT -- NAMED STRING INSERT ; ; CALLING SEQUENCE: ; ; NP POINTS TO STRING NAME ; DP POINTS TO STRING DATA PORTION ; LP POINTS TO START OF NAMED STRING LIST ; ATRTYP SET ; TKNTYP, TKNOFF SET IF NUMBERED STATEMENT. ; ; JSR SINSRT ; BNE NAME IS NULL, OR NO ROOM FOR STRING IN LIST ; ; ATRTYP STORED IF 'VARIABLE' ; TKNTYP, TKNOFF STORED IF NUMBERED STATEMENT. ; SINSRT JSR IFIND ; IS NAME ALREADY IN LIST? BNE L99_SI020 ; NO. JSR SDEL2 ; YES -- DELETE OLD OCCURRENCE. L99_SI020 LDA #0 ; CALCULATE ALLOCATION SIZE. STA MEMB STA MEMB+1 LDX #MEMB-DTAB ; STRING SIZE = NAME SIZE ... SEC LDA NP+3 SBC NP+2 JSR DADDP SEC ; ... + DATA PORTION SIZE ... LDA DP+3 SBC DP+2 JSR DADDP LDA #6 ; ... + 6 BYTES OF OVERHEAD. ; 2 = BLOCK SIZE; 1 = NAME SIZE, ; 1 = DATA SIZE; 2 = 'EXTRA' AT END. JSR DADDP LDX #MEMA-DTAB ; ALLOCATE ADDRESS FROM 'IFIND' CALL IN PP. LDY #PP-DTAB JSR DMOVI JSR MALLOC ; ALLOCATE SPACE IN LIST. BNE L99_SI090 ; NOT ENOUGH ROOM. LDX #NP-DTAB ; MOVE NAME TO NEW STRING ... LDY #2 ; ... STARTING AFTER ALLOCATION SIZE. JSR SMOVI LDX #DP-DTAB ; NOW MOVE DATA PORTION. JSR SMOVI ; 'MEMA' = ADDRESS OF 'ATTRIBUTE' DESTINATION. ; Y = 0. LDA ATRTYP BNE L99_SI060 ; 'VARIABLE' ATTRIBUTE. LDA TKNTYP ; TOKENIZE LINE. STA (MEMA),Y INY LDA TKNOFF ; OFFSET. L99_SI060 STA (MEMA),Y LDA #0 ; SET CC FOR NORMAL EXIT. L99_SI090 RTS ; RETURN WITH CC SET. ; TEXT DATA UTILITIES ; ; THESE ROUTINES USE THE FOLLOWING VARIABLES: ; ; DP = POINTER TO TEXT DATA ; MP = POINTER TO TEXT PATTERN DATA ; AP1 = AUXILLIARY POINTER TO TEXT SUB-STRING ; AP2 = AUXILLIARY POINTER TO TEXT SUB-STRING ; PROC ; ; SCOMP -- COMPARE TWO TEXT STRINGS ; ; CALLING SEQUENCE: ; ; DP POINTS TO DATA TEXT ; MP POINTS TO DATA TEXT ; ; JSR SCOMP ; BEQ DATA TEXTS ARE IDENTICAL ; BCS DP TEXT >= MP TEXT ; BCC DP TEXT < MP TEXT ; ; NOTE: THE COMPARISON IS BASED UPON THE STANDARD ATASCII COLLATION ; SEQUENCE: WHEN ONE TEXT IS A SUBSET OF THE FIRST PART OF THE ; OTHER TEXT, THE SHORTER ONE IS CONSIDERED TO BE < THE LONGER ONE. ; SCOMP JSR PSETUP ; DP TO SP, MP TO PP. JMP ICOMP ; COMPARE TEXT & RETURN WITH CC SET. ; ; GENERAL STRING IMPLEMENTATION UTILITIES ; ; THESE ROUTINES USE THE FOLLOWING VARIABLES: ; ; SP = SOURCE TEXT POINTER ; PP = PATTERN TEXT POINTER ; PROC ; ; IFIND -- FIND NAMED STRING IN LIST ; ; CALLING SEQUENCE: ; ; NP POINTS TO DESIRED NAME ; LP POINTS TO START OF NAMED STRING LIST ; ATRTYP ATTRIBUTE ; ; JSR IFIND ; BNE NOT FOUND (PP POINTS TO SUCCESSOR) ; ; PP POINTS TO NAMED STRING IN LIST ; ; IF NOT FOUND. THE SUCCESSOR IS CHOSEN SO THAT: ; ; STATEMENTS ARE KEPT IN LINE # ORDER. ; VARIABLES ARE APPENDED TO THE END OF THE LIST. ; IFIND LDA NP+2 ; NAME NULL? CMP NP+3 BEQ L101_IF080 ; YES -- DONE. LDX #SP-DTAB ; SP = NP. LDY #NP-DTAB JSR PMOVE LDX #PP-DTAB ; PP = LP. LDY #LP-DTAB JSR PMOVE L101_IF020 LDX #PP-DTAB JSR SEND ; END OF LIST? BEQ L101_IF080 ; YES -- DONE. LDA #3 ; NO -- SETUP START INDEX ... STA PP+2 CLC ; ... & END INDEX (TO NAME) LDY #2 ADC (PP),Y STA PP+3 JSR ICOMP ; NAME COMPARISON. BEQ L101_IF030 ; A MATCH. BCS L101_IF040 ; NOT THERE YET (IF LINE). ; NOT A MATCH (IF VARIABLE). LDA ATRTYP ; LINE INSERTION? BNE L101_IF040 ; NO -- SEARCH TO END. BCC L101_IF080 ; YES -- PAST CORRECT SPOT (BRA). ; CHECK IF ATTRIBUTE MATCHES. L101_IF030 LDA ATRTYP ; ATTRIBUTE TO MATCH. BEQ L101_IF090 ; 'LINE' -- FOUND IT! LDX #PP-DTAB ; CHECK ATTRIBUTE. JSR SATTR CMP ATRTYP BEQ L101_IF090 ; ATTRIBUTE MATCHED! L101_IF040 LDX #PP-DTAB ; SKIP TO NEXT LIST ENTRY. JSR SNXTI JMP L101_IF020 ; TRY AGAIN. L101_IF080 LDA #$FF ; SET CC FOR EXIT (NOT FOUND). L101_IF090 RTS ; RETURN WITH CC SET. ; PROC ; ; ICOMP -- COMPARE TEXT DATA ; ; CALLING SEQUENCE: ; ; SP POINTS TO DATA TEXT ; PP POINTS TO DATA TEXT ; ; JSR ICOMP ; BEQ DATA TEXTS ARE IDENTICAL ; BCS SP DATA >= PP DATA ; BCC SP DATA < PP DATA ; ICOMP JSR ILENG ; SEE IF EQUAL LENGTHS. BEQ IMATCH ; YES -- COMPARE & RETURN. BCS L102_IC050 ; PP DATA SHORTER THAN SP DATA. LDA PP+3 ; SAVE STARTING VALUE. STA TEMP2 SEC ; (CLEAR BORROW). LDA SP+3 ; ADJUST PP DATA LENGTH FOR COMPARISON. SBC SP+2 CLC ADC PP+2 STA PP+3 JSR IMATCH ; NOW COMPARE. PHP LDA TEMP2 ; RESTORE ALTERED PARAMETER. STA PP+3 PLP BNE L102_IC090 ; NOT EQUAL -- CC SET FOR EXIT. LDA #$FF ; SET CC FOR EXIT. CLC RTS ; RETURN WITH CC SET. L102_IC050 LDA SP+3 ; SAVE STARTING VALUE. STA TEMP2 CLC LDA SP+2 ; ADJUST SP LENGTH FOR COMPARISON. ADC PP+3 SEC SBC PP+2 STA SP+3 JSR IMATCH ; NOW COMPARE. PHP LDA TEMP2 ; RESTORE ALTERED PARAMETER. STA SP+3 PLP BNE L102_IC090 ; NOT EQUAL -- CC SET FOR EXIT. LDA #$FF ; SET CC FOR EXIT. SEC L102_IC090 RTS ; RETURN WITH CC SET. ; PROC ; ; IMATCH -- MATCH TWO TEXT DATA STRINGS ; ; CALLING SEQUENCE: ; ; SP = SOURCE DATA TEXT (SOURCE DATA MUST BE LONGER THAN PATTERN) ; PP = PATTERN DATA TEXT ; ; JSR IMATCH ; BEQ PATTERN IS CONTAINED WITHIN SOURCE ; BCS SOURCE COLLATES >= PATTERN ; BCC SOURCE COLLATES < PATTERN ; IMATCH LDA SP+2 ; SAVE STARTING INDICES. STA TEMP LDA PP+2 STA TEMP+1 L103_IM010 LDY PP+2 ; SEE IF ALL OF PATTERN HAS MATCHED. CPY PP+3 BEQ L103_IM090 ; YES -- ALL DONE. LDY SP+2 ; NO -- COMPARE ANOTHER BYTE. LDA (SP),Y INC SP+2 LDY PP+2 CMP (PP),Y BNE L103_IM090 ; NO COMPARE -- CC SET FOR EXIT. INC PP+2 BCS L103_IM010 ; (BRA). L103_IM090 PHP ; SAVE CC. LDA TEMP ; RESTORE STARTING INDICES. STA SP+2 LDA TEMP+1 STA PP+2 PLP ; RESTORE CC. SEN090 RTS ; RETURN WITH CC SET. ; PROC ; ; SEND -- CHECK FOR END OF STRING LIST ; ; CALLING SEQUENCE: ; ; X = DTAB OFFSET TO LIST POINTER ; ; JSR SEND ; BEQ END OF LIST REACHED ; ; Y IS ALTERED ; SEND LDY #S1H-DTAB ; SEE IF END OF REGION #1. JSR DCMPI BEQ SEN090 ; YES. LDY #S2H-DTAB ; SEE IF END OF REGION #2 ... JMP DCMPI ; ... & RETURN WITH CC SET. ; PROC ; ; ILENG -- COMPARE LENGTHS OF SOURCE TEXT AND PATTERN TEXT ; ; CALLING SEQUENCE: ; ; SP POINTS TO SOURCE DATA TEXT ; PP POINTS TO PATTERN DATA TEXT ; ; JSR ILENG ; BEQ DATA TEXTS ARE EQUAL LENGTH ; BCS SOURCE TEXT >= PATTERN TEXT ; BCC SOURCE TEXT < PATTERN TEXT ; ILENG LDA PP+3 SEC SBC PP+2 STA TEMP LDA SP+3 SBC SP+2 SBC TEMP ; CC = SP LENGTH = PP LENGTH. RTS ; PROC ; ; PSETUP -- MOVE POINTERS (DP TO SP, MP TO PP) ; ; CALLING SEQUENCE: ; ; JSR PSETUP ; ; SP = DP ; PP = MP ; PSETUP LDX #SP-DTAB ; SP = DP. LDY #DP-DTAB JSR PMOVE LDX #PP-DTAB ; PP = MP. LDY #MP-DTAB JMP PMOVE ; AND RETURN. ; PROC ; ; PMOVE -- MOVE STRING/DATA TEXT POINTERS ; ; CALLING SEQUENCE: ; ; X = DTAB OFFSET ; Y = DTAB OFFSET ; ; JSR PMOVE ; ; DTAB(X) = DTAB(Y) (4 BYTE MOVE) ; PMOVE LDA DTAB+2,Y STA DTAB+2,X LDA DTAB+3,Y STA DTAB+3,X ; ** EXTERNAL ENTRY POINT *** DMOVI LDA DTAB,Y STA DTAB,X LDA DTAB+1,Y STA DTAB+1,X RTS .IF FALSE ; PROC ; ; IALLOC -- ALLOCATE MEMORY ; ; CALLING SEQUENCE: ; ; A = # OF BYTES TO ALLOCATE ; ; JSR IALLOC ; BNE NOT ENGUGH ROOM ; ; DP POINTS TO NEW ALLOCATION + 2 (START OF STRING) ; IALLCC STA MEMB ; SETUP MEMB = A BYTES ... LDA #0 STA MEMB+1 LDA #3 ; ... + 3 LDX #MEMB-DTAB JSR DADDS LDX #MEMA-DTAB ; SETUP MEMA = ALLOCATION ADDRESS. LDY #S2L-DTAB JSR DMOVI JSR MALLOC ; ALLOCATE MEMORY. BNE L108_IA090 ; NOT ENOUGH ROOM. LDX #DP-DTAB ; DP = ADDRESS OF STRING STORAGE AREA. LDY #MEMA-DTAB JSR DMOVI LDA #2 JSR DADDS LDA #1 ; SET STARTING & ENDING INDICES. STA DP+2 STA DP+3 LDA #0 ; SET CC FOR EXIT. L108_IA090 RTS ; RETURN WITH CC SET. .ENDIF ; PROC ; ; SMOVI -- MOVE TEXT DATA TO MEMA (FORMING STRING) ; ; CALLING SEQUENCE: ; ; X = DTAB INDEX TO STRING POINTER ; Y = MEMA OFFSET TO START STORING ; ; JSR SMOVI ; ; MEMA = LAST LOCATION STORED INTO + 1 ; Y = 0 ; SMOVI LDA DTAB,X ; MOVE SOURCE POINTER TO TEMP. STA TEMP LDA DTAB+1,X STA TEMP+1 LDA DTAB+2,X STA TEMP+2 LDA DTAB+3,X STA TEMP+3 SEC ; CALCULATE STRING LENGTH ... LDA TEMP+3 SBC TEMP+2 L109_SM010 STA (MEMA),Y ; ... & STORE IN TARGET AREA. INY STY TEMP+4 ; SAVE INDEX. LDY TEMP+2 ; DONE? CPY TEMP+3 BEQ L109_SM090 ; YES. LDA (TEMP),Y ; NO -- MOVE A BYTE. INC TEMP+2 LDY TEMP+4 ; GET TARGET INDEX. BNE L109_SM010 ; (BRA). L109_SM090 LDA #0 ; PREPARE FOR D.P. ADDITION. STA TEMP+5 LDX #MEMA-DTAB ; PREPARE TO BUMP MEMA. LDY #TEMP+4-DTAB JSR DADDI LDY #0 ; AS PROMISED. RTS ; PROC ; ; SATTR -- POINT TO ATTRIBUTE BYTE ; ; CALLING SEQUENCE: ; ; X = DATA OFFSET TO STRING POINTER ; ; JSR SATTR ; ; A = ATTRIBUTE VALUE ; TEMP = ADDRESS OF ATTRIBUTE BYTE ; Y = 0 ; SATTR LDA DTAB+1,X ; MOVE POINTER TO TEMP. STA TEMP+1 LDA DTAB,X STA TEMP LDY #0 ; ADDRESS ... CLC ; ...+ LENGTH. ADC (TEMP),Y PHA ; LSB INY LDA TEMP+1 ADC (TEMP),Y STA TEMP+1 ; MSB PLA SEC ; ... -2. SBC #2 STA TEMP BCS L110_SA010 DEC TEMP+1 ; (BORROW). L110_SA010 LDY #0 LDA (TEMP),Y ; AS ADVERTISED. RTS ; PROC ; ; SNXTI -- POINT TO NEXT STRING IN LIST ; ; CALLING SEQUENCE: ; ; X = DATA OFFSET TO STRING LIST POINTER ; ; JSR SNXTI ; ; DTAB(X) = POINTER TO NEXT STRING IN LIST ; SNXTI LDA DTAB+1,X ; MOVE STRING POINTER TO TEMP. STA TEMP+1 LDA DTAB,X STA TEMP LDY #0 ; ADD ADDRESS TO ... CLC ADC (TEMP),Y ; ... ALLOCATION LENGTH ... STA DTAB,X ; ... TO GET NEXT ADDRESS. INY LDA TEMP+1 ADC (TEMP),Y STA DTAB+1,X RTS ; PROC ; ; MALLOC -- MEMORY ALLOCATE ; ; CALLING SEQUENCE: ; ; 'MEMA' CONTAINS THE ADDRESS OF THE START OF ALLOCATION ; REGION #1: DATA AT START ADDRESS AND ABOVE ARE MOVED UP. ; REGION #2: DATA BELOW START ADDRESS ARE MOVED DOWN. ; 'MEMB' CONTAINS THE NUMBER OF BYTES TO ALLOCATE ; ; JSR MALLOC ; BNE NOT ENOUGH MEMORY TO SATISFY ALLOCATION ; ; 'MEMA' CONTAINS LOWEST ADDRESS IN THE ALLOCATED BLOCK ; FIRST TWO BYTES OF ALLOCATED BLOCK = BLOCK SIZE ; MALLOC LDY #S1H-DTAB ; ACC = S1H ... JSR DLOADA LDY #MEMB-DTAB ; ... + MEMB. JSR DADDA LDY #S2L-DTAB ; COMPARE ACC WITH S2L. JSR DCMPA BCS L112_MA300 ; NOT ENOUGH ROOM. LDX #MEMA-DTAB ; SEE IF ALLOCATION IN REGION #1 OR #2. LDY #S2L-DTAB JSR DCMPI BCS L112_MA100 ; REGION M2. ; ALLOCATE FROM REGION #1 LDX #MSP-DTAB ; MSP = MEMA. LDY #MEMA-DTAB JSR DMOVI LDX #MDP-DTAB ; MDP = MEM A ... JSR DMOVI LDY #MEMB-DTAB ; ... + MEMB. JSR DADDI LDX #MBC-DTAB ; MBC = S1H ... LDY #S1H-DTAB JSR DMOVI LDY #MEMA-DTAB ; ... - MEMA. JSR DSUBI LDX #S1H-DTAB ; S1H = ACC (= S1H + MEMB). JSR DSTORA JSR MOVDA JMP L112_MA200 ; ALLOCATE IN REGION #2 L112_MA100 LDX #MSP-DTAB ; MSP = S2L. LDY #S2L-DTAB JSR DMOVI LDX #MBC-DTAB ; MBC = MEMA ... LDY #MEMA-DTAB JSR DMOVI LDY #S2L-DTAB ; ... - S2L. JSR DSUBI LDX #S2L-DTAB ; S2L = S2L - MEMB. LDY #MEMB-DTAB JSR DSUBI LDX #MDP-DTAB ; MDP = S2L (NEW VALUE). LDY #S2L-DTAB JSR DMOVI LDX #MEMA-DTAB ; MEMA = MEMA - MEMB. LDY #MEMB-DTAB JSR DSUBI JSR MOVIA ; MOVE DATA DOWNWARD. ; COMMON CODE L112_MA200 LDY #0 ; MOVE BLOCK SIZE TO BLOCK. LDA MEMB STA (MEMA),Y INY LDA MEMB+1 STA (MEMA),Y DEY ; SET CC FOR NORMAL EXIT. RTS L112_MA300 LDA #INSERR ; SET CC FOR ERROR EXIT. RTS ; PROC ; ; MDEALL -- MEMORY DEALLOCATE ; ; CALLING SEQUENCE: ; ; 'MEMA' = ADDRESS OF BLOCK TO DEALLOCATE ; FIRST 2 BYTES OF BLOCK = SIZE OF BLOCK ; ; JSR MDEALL ; ; 'MEMA' = ADDRESS OF BLOCK FOLLOWING DEALLOCATED BLOCK (AFTER DEALL) ; MDEALL LDY #0 ; GET SIZE OF BLOCK TO MEMB. LDA (MEMA),Y STA MEMB INY LDA (MEMA),Y STA MEMB+1 LDX #MEMA-DTAB ; SEE IF IN REGION #1 OR #2. LDY #S2L-DTAB JSR DCMPI BCS L113_MD100 ; REGION #2. ; DEALLOCATE FROM REGION #1. LDX #MSP-DTAB ; MSP = MEMA ... LDY #MEMA-DTAB JSR DMOVI LDY #MEMB-DTAB ; ... + MEMB. JSR DADDI LDX #MBC-DTAB ; MBC = S1H ... LDY #S1H-DTAB JSR DMOVI LDY #MSP-DTAB ; ... - MSP. JSR DSUBI LDX #S1H-DTAB ; S1H = S1H - MEMB. LDY #MEMB-DTAB JSR DSUBI LDX #MDP-DTAB ; MDP = MEMA. LDY #MEMA-DTAB JSR DMOVI JMP MOVIA ; MOVE DATA DOWNWARD & RETURN. ; DEALLOCATE MEMORY IN REGION #2 L113_MD100 LDX #MSP-DTAB ; MSP = S2L. LDY #S2L-DTAB JSR DMOVI LDX #MBC-DTAB ; MBC = MEMA ... LDY #MEMA-DTAB JSR DMOVI LDY #S2L-DTAB ; ... - S2L. JSR DSUBI LDX #S2L-DTAB ; S2L = S2L + MEMB. LDY #MEMB-DTAB JSR DADDI LDX #MDP-DTAB ; MDP = S2L (NEW VALUE). LDY #S2L-DTAB JSR DMOVI LDX #MEMA-DTAB ; MEMA = MEMA + MEMB. LDY #MEMB-DTAB JSR DADDI JMP MOVDA ; MOVE DATA UPWARD & RETURN ; ; MOVE UTILITIES FOR MEMORY MANAGEMENT ; ; MOVE BLOCKS OF DATA WITH EITHER INCREASING OR DECREASING ADDRESS ; ; THREE VARIABLES CONTROL THE MOVE ROUTINES? ; ; 'MSP' CONTAINS POINTER TO SOURCE DATA LOCATION ; 'MDP' CONTAINS POINTER TO DESTINATION DATA LOCATION ; 'MBC' CONTAINS THE NUMBER OF BYTES TO MOVE ; ; PROC ; ; MOVIA -- MOVE DATA BLOCK WITH INCREASING ADDRESS ; ; CALLING SEQUENCE: ; ; 'MSP', 'MDP' & 'MBC' SETUP ; ; JSR MOVIA ; MOVIA LDA MBC ; SEE IF BYTE COUNT = ZERO. TAX ; SAVE LSB OF BYTE COUNT. ORA MBC+1 BEQ L114_MI090 ; ZERO -- NOTHING TO DO. LDY #0 ; INDEX TO DATA BLOCK. L114_MI010 LDA (MSP),Y ; MOVE DATA. STA (MDP),Y INY ; BUMP INDEX. BNE L114_MI020 ; NO PAGE WRAP. INC MSP+1 ; PAGE WRAP -- BUMP POINTER VARIABLES. INC MDP+1 L114_MI020 DEX ; DONE? BNE L114_MI030 ; NO. LDA MBC+1 ; NOT SURE -- CHECK FURTHER. BEQ L114_MI090 ; YES -- DONE. L114_MI030 CPX #$FF ; MAINTAIN D.P. BYTE COUNT. BNE L114_MI010 DEC MBC+1 ; BORROW FROM MSB. BCS L114_MI010 ; (BRA). L114_MI090 RTS ; PROC ; ; MOVDA -- MOVE DATA BLOCK WITH DECREASING ADDRESS ; ; CALLING SEQUENCE: ; ; 'MSP', 'MDP' & 'MBC' SETUP ; ; JSR MOVDA ; MOVDA LDA MBC ; SETUP BYTE COUNT ... TAX TAY ; ... AND DATA INDEX. ORA MBC+1 ; TEST FOR ZERO BYTE COUNT. BEQ L115_MD090 ; ZERO -- NOTHING TO DO. CLC ; ADJUST POINTERS FOR START. LDA MSP+1 ADC MBC+1 STA MSP+1 CLC LDA MDP+1 ADC MBC+1 STA MDP+1 L115_MD010 DEY ; DECREMENT INDEX. CPY #$FF ; WRAP? BNE L115_MD020 ; NO. DEC MBC+1 ; YES -- DECREMENT ALL POINTERS (MSB) DEC MSP+1 DEC MDP+1 L115_MD020 LDA (MSP),Y ; MOVE A DATA BYTE. STA (MDP),Y DEX ; DONE? BNE L115_MD010 ; NO -- CONTINUE. LDA MBC+1 ; NOT SURE -- CHECK FURTHER. BNE L115_MD010 ; NO -- CONTINUE. L115_MD090 RTS ; YES -- RETURN. ; PROC ; ; MVINLN -- MOVE PART OF 'INLN' TO A FIXED ADDRESS BUFFER ; ; CALLING SEQUENCE: ; ; Y = CURRENT INDEX IN 'INLN' ; ; JSR :MINLN ; ; 'INLNBF' CONTAINS Y/Y+'INBFSZ'-1 CHARACTERS FROM 'INLN' ; LOWER CASE IS CONVERTED TO UPPER CASE. ; Y IS NOT PRESERVED. ; MVINLN LDX #0 L116_MVN10 LDA (INLN),Y CMP #'A'+$20 ; LC? BCC L116_MVN20 ; NO. CMP #'Z'+1+$20 BCS L116_MVN20 ; NO. AND #UC ; YES L116_MVN20 STA INLNBF,X INY INX CPX #INBFSZ BCC L116_MVN10 RTS ; DOUBLE PRECISION ROUTINES ; ; ALL VARIABLES ARE ACCESSED VIA THEIR OFFSET FROM SYMBOL 'DTAB'. ; NORMALLY THE X AND/OR Y REGISTERS CONTAIN THE 'DTAB' OFFSET ; VALUES TO THE VARIABLE(S) TO BE DEALT WITH. ; ; PROC ; ; DCWCI -- DOUBLE BYTE UNSIGNED COMPARE WITH CONSTANT. ; ; CALLING SEQUENCE: ; ; X = DTAB OFFSET TO VARIABLE. ; Y = MSB OF CONSTANT. ; A = LSB OF CONSTANT. ; ; JSR DCWCI ; UNSIGNED COMPARE. ; ; CC = DTAB(X) : Y,A ; DCWCI STA TEMP2 ; SAVE LSB. STY TEMP2+1 ; SAVE MSB. LDY #TEMP2-DTAB ; *S* JMP DCMPI ; COMPARE & RETURN. ; PROC ; ; DCMPI -- DOUBLE BYTE UNSIGNED COMPARE INDEXED ; ; CALLING SEQUENCE: ; ; X = DATA #1 OFFSET ; Y = DATA #2 OFFSET ; ; JSR DCMPI ; BEQ DTAB(X) = DTAB(Y) ; BCS BTAB(X) >= DTAB(Y) ; BCC DTAB(X) < DTAB(Y) ; ; CC = DTAB(X) : DTAB(Y) (UNSIGNED) ; DCMPI LDA DTAB+1,X ; COMPARE MSBS. CMP DTAB+1,Y BNE L118_DC090 ; NOT EQUAL -- ALL DONE. ; *** EXTERNAL ENTRY POINT ** DCM010 LDA DTAB,X ; EQUAL -- COMPARE LSBS. CMP DTAB,Y L118_DC090 RTS ; PROC ; ; DSCMI -- DOUBLE BYTE SIGNED COMPARE INDEXED ; ; CALLING SEQUENCE: ; ; X = DATA #1 OFFSET ; Y = DATA #2 OFFSET ; ; JSR DSCMI ; BEQ DTAB(X) = DTAB(Y) ; BCS DTAB(X) >= DTAB(Y) ; BCC DTAB(X) < DTAB(Y) ; DSCMI LDA DTAB+1,Y ; COMPARE MSBS FIRST. EOR #$80 STA TEMP LDA DTAB+1,X EOR #$80 CMP TEMP BEQ DCM010 ; EQUAL -- COMPARE LSBS. RTS ; NOT EQUAL -- ALL DONE. ; ; DMOVI -- DOUBLE BYTE MOVE INDEXED ; ; CALLING SEQUENCE: ; ; X = DESTINATION OFFSET ; Y = SOURCE OFFSET ; ; JSR DMOVI ; ; DTAB(X) = DTAB(Y) ; ; *** SEE 'PMOVE' FOR THE 'DMOVI' CODE *** ; PROC ; ; DADDI -- DOUBLE PRECISION ADD ; ; CALLING SEQUENCE: ; ; X = OFFSET TO ; Y = OFFSET TO ; ; JSR DADDI ; BVS OVERFLOW ; ; DTAB(X) = DTAB(X) + DTAB(Y) ; DADDI CLC DADDIX LDA DTAB,X ADC DTAB,Y STA DTAB,X LDA DTAB+1,X ADC DTAB+1,Y STA DTAB+1,X RTS ; PROC ; ; DSUBI -- DOUBLE PRECISION SUBTRACT ; ; CALLING SEQUENCE: ; ; X = OFFSET ; Y = OFFSET ; ; JSR DSUBI ; BVS OVERFLOW ; BEQ RESULT = 0 ; ; DTAB(X) = DTAB(X) - DTAB(Y) ; DSUBI SEC DSUBIX LDA DTAB,X SBC DTAB,Y STA DTAB,X LDA DTAB+1,X SBC DTAB+1,Y STA DTAB+1,X ORA DTAB,X ; SET CC FOR ZERO TEST. RTS ; PROC ; ; DMULI -- DOUBLE PRECISION MULTIPLY ; ; CALLING SEQUENCE: ; ; X = OFFSET ; X = OFFSET ; ; JSR DMULI ; ; DTAB(X) = DTAB(X) * DTAB(Y) ; DMULI LDA #16 ; SETUP LOOP COUNTER. STA TEMP+2 LDA #0 ; INITIALIZE TEMP ACCUMULATOR. STA TEMP STA TEMP+1 L122_DM010 ASL DTAB,X ; DOUBLE PRECISION SHIFT LEFT. ROL DTAB+1,X BCC L122_DM020 ; NO BIT PRESENT. CLC ; BIT SET -- ADD TO PARTIAL. LDA TEMP ADC DTAB,Y STA TEMP LDA TEMP+1 ADC DTAB+1,Y STA TEMP+1 L122_DM020 DEC TEMP+2 ; DONE? BEQ L122_DM090 ; YES -- RESULT IS IN 'TEMP'. ASL TEMP ; NO -- DOUBLE PRECISION SHIFT LEFT. ROL TEMP+1 JMP L122_DM010 L122_DM090 LDA TEMP ; DONE -- MOVE RESULT. STA DTAB,X LDA TEMP+1 STA DTAB+1,X RTS ; PROC ; ; DDIVI -- DOUBLE PRECISION DIVIDE ; ; CALLING SEQUENCE: ; ; X = OFFSET TO DIVIDEND ; Y = OFFSET TO DIVISOR ; ; JSR DDIVI ; ; DTAB(X) = DTAB(X) / DTAB(Y) (SIGNED) ; 'TEMP' = REMAINDER (SIGN MAY BE WRONG!!!) ; DDIVI LDA DTAB,Y ; CHECK FOR DIVIDE BY ZERO. ORA DTAB+1,Y BNE L123_DD003 ; NO -- O.K. LDA #DIVERR ; ERROR. JMP PSTOP L123_DD003 LDA #16+1 ; SETUP LOOP COUNTFR. STA TEMP+2 STX TEMP+3 ; SAVE INDEX TO DIVIDEND. LDA #0 ; INITIALIZE REMAINDER. STA TEMP STA TEMP+1 LDA DTAB+1,Y ; SEE IF DIVISOR IS NEGATIVE. STA TEMP+5 BPL L123_DD006 ; NO. JSR DNEGI ; YES -- NEGATE DIVIDEND ... JSR L123_DD093 ; ... & DIVISOR (*** CRAZY CALL ***). L123_DD006 LDA DTAB+1,X ; SEE IF DIVIDEND IS NEGATIVE. STA TEMP+4 BPL L123_DD008 ; NO. JSR DNEGI ; YES -- NEGATE IT NOW (& THEN AGAIN LATER). L123_DD008 CLC L123_DD010 LDX TEMP+3 ; GET INDEX TO DIVIDEND. ROL DTAB,X ; DOUBLE PRECISION ROTATE. ROL DTAB+1,X DEC TEMP+2 ; DONE? BEQ L123_DD090 ; YES. ROL TEMP ; NO. ROL TEMP+1 LDX #TEMP-DTAB ; IS REMAINDER < DIVISOR? JSR DCMPI BCC L123_DD010 ; YES. JSR DSUBI ; NO. SEC BCS L123_DD010 ; (BRA). L123_DD090 LDA TEMP+4 ; SEE IF RESULT IS TO BE NEGATED. BPL L123_DD092 ; NO. JSR DNEGI ; YES -- NEGATE POSITIVE RESULT. L123_DD092 LDA TEMP+5 ; WAS DIVISOR NEGATED EARLIER. BPL L123_DD095 ; NO. L123_DD093 TYA ; YES -- NEGATF IT BACK TO ORIGINAL SIGN. TAX JSR DNEGI LDX TEMP+3 ; RESTORE INDEX. L123_DD095 RTS ; PROC ; ; DMODI -- MODULO OF SORTS ; ; CALLING SEQUENCE: ; ; X = OFFSET TO DIVIDEND ; Y = OFFSET OT DIVISOR ; ; JSR DMODI ; ; DTAB(X) = DTAB(X) MOD DTAB(Y) ; DMODI JSR DDIVI ; FIRST DO DIVISION. LDA TEMP ; TAKE ADVANTAGE OF SIDE EFFECT. STA DTAB,X LDA TEMP+1 STA DTAB+1,X RTS ; PROC ; ; DNEGI -- DOUBLE PRECISION NEGATE ; ; CALLING SEQUENCE: ; ; X = OFFSET TO NUMBER ; ; JSR DNEGI ; ; DTAB(X) = -DTAB(X) ; DNEGI SEC ; (CLEAR BORROW). LDA #0 SBC DTAB,X STA DTAB,X LDA #0 SBC DTAB+1,X STA DTAB+1,X RTS ; PROC ; ; DABSI -- DOUBLE PRECISION ABS FUNCTION ; ; CALLING SEQUENCE: ; ; X = OFFSET TO NUMBER ; ; JSR DABSI ; ; DTAB(X) = ABS (DTAB(X)) ; DABSI LDA DTAB+1,X ; CHECK SIGN OF MSB. BMI DNEGI RTS ; PROC ; ; DADDS -- ADD A REGISTER TO DOUBLE BYTE ; ; CALLING SEQUENCE: ; ; A = SIGNED BINARY NUMBER (-126 TO 127) ; X = DTAB OFFSET TO DP NUMBER ; ; JSR DADDS ; ; DTAB(X) = DTAB(X) + A ; DADDS CMP #0 ; SEE IF POSITIVE OR NEGATIVE. BMI L127_DA030 ; NEGATIVE. ; *** EXTERNAL ENTRY POINT *** DADDP CLC ; POSITIVE -- ADD. ADC DTAB,X STA DTAB,X BCC L127_DA010 ; NO CARRY. INC DTAB+1,X ; CARRY -- ADD TO MSB. L127_DA010 RTS ; *** EXTERNAL ENTRY FOINT *** DDCRI LDA #-1 L127_DA030 CLC ADC DTAB,X STA DTAB,X BCS L127_DA040 ; NO BORROW. DEC DTAB+1,X ; BORROW -- SUB FROM MSB L127_DA040 RTS ; PROC ; RELATIONAL TESTS ; ; CALLING SEQUENCE: ; ; X = DATA #1 OFFSET ; Y = DATA #2 OFFSET ; ; JSR DXXTI ONE OF SIX ROUTINES ; ; DTAB(X) = 1 IF RELATION TRUE, 0 IF FALSE DEQTI JSR DCMPI ; UNSIGNED COMPARE (FASTER THAN SIGNED). BEQ DTRUE ; EQUAL RESULTS IN TRUE. BNE DFALSE ; UNEQUAL RESULTS IN FALSE. DNETI JSR DCMPI ; UNSIGNED COMPARE (FASTER THAN SIGNED). BNE DTRUE ; UNEQUAL RESULTS IN TPUE. BEQ DFALSE ; EQUAL RESULTS IN FALSE. DGTTI JSR DSCMI ; SIGNED COMPARE. BEQ DFALSE ; EQUAL RESULTS IN FALSE. BCC DFALSE ; LESS THAN RESULTS IN FALSE. BCS DTRUE ; GREATER THAN RESULTS IN TRUE. DLTTI JSR DSCMI ; SIGNED COMPARE. BCC DTRUE ; LESS THAN RESULTS IN TPUE. BCS DFALSE ; GREATER THAN OR EQUAL PESULTS IN FALSE DGETI JSR DSCMI ; SIGNED COMPARE. BCS DTRUE ; GREATER THAN OR EQUAL RESULTS IN TRUE. BCC DFALSE ; LESS THAN RESULTS IN FALSE. DLETI JSR DSCMI ; SIGNED COMPARE. BEQ DTRUE ; EQUAL RESULTS IN TRUE. BCS DFALSE ; GREATER THAN RESULTS IN FALSE. ; *S* BCC DTRUE ; LESS THAN RESULTS IN TPUE. DTRUE LDA #1 ;"TRUE" ... BNE DFA010 ; ... TO VARIABLE. DFALSE LDA #0 ; "FALSE" ... DFA010 STA DTAB,X ; ... TO VARIABLE. LDA #0 STA DTAB+1,X RTS ; PROC .IF LOGGRP ; ; DLANDI -- DOUBLE PRECISION LOGICAL AND ; ; CALLING SEQUENCE: ; ; X = OFFSET ; Y = OFFSET ; ; JSR DLAND ; ; DTAB(X) = DTAB(X) LOGICAL AND DTAB(Y) ; DLANDI JSR DTXP ; IS DTAB(X) FALSE? BEQ DFALSE ; YES. ; *** ENTRY FOR 'DLORI' *** DAN010 JSR DTYP ; IS DTAB(Y) FALSE? BEQ DFALSE ; YES -- SET DTAB(X) = FALSE AND EXIT. BNE DTRUE ; NO -- SET DTAB(X) = TRUE AND EXIT. ; PROC ; DLORI -- DOUBLE PRECISION LOGICAL OR ; ; CALLING SEQUENCE: ; ; X = OFFSET ; Y = OFFSET ; ; JSR DLORI ; ; DTAB(X) = DTAB(X) LOGICAL OR DTAB(Y) ; DLORI JSR DTXP ; IS DTAB(X) TRUE? BNE DTRUE ; YES. BEQ DAN010 ; NO (BRA). .ENDIF ; PROC ; ; DLNOTI -- DOUBLE PRECISION LOGICAL NOT ; ; CALLING SEQUENCE: ; ; X = OFFSET ; ; JSR DLNOTI ; ; DTAB(X) = LOGICAL NOT DTAB(X) ; DLNOTI JSR DTXP ; TRUE OR FALSE? BEQ DTRUE ; FALSE -> TRUE AND EXIT. BNE DFALSE ; TRUE -> FALSE AND EXIT. ; PROC ; ; DTXP -- DTAB(X) PREDICATE ; ; CALLING SEQUENCE: ; ; X = OFFSET ; ; JSR DTXP ; ; BNE IF DTAB(X) POSITIVE (TRUE) ; BEQ IF DTAB(X) ZERO OR NEGATIVE (FALSE) ; DTXP LDA DTAB+1,X BMI DTX010 ; NEGATIVE. ORA DTAB,X ; POSITIVE OR ZERO. RTS ; CC IS SET. DTY010 DTX010 LDA #0 RTS ; ; DANDI -- DOUBLE PRECISION AND ; ; CALLING SEQUENCE: ; ; X = OFFSET ; Y = OFFSET ; ; JSR DANDI ; ; DTAB(X) = DTAB(X) DANDI LDA DTAB,X AND DTAB,Y STA DTAB,X LDA DTAB+1,X AND DTAB+1,Y STA DTAB+1,X RTS ; ; DORI -- DOUBLE PRECISION OR ; ; CALLING SEQUENCE: ; ; X = OFFSET ; Y = OFFSET ; ; JSR DORI ; ; DTAB(X) = DTAB(X) OR DTAB(Y) ; DORI LDA DTAB,X ORA DTAB,Y STA DTAB,X LDA DTAB+1,X ORA DTAB+1,Y STA DTAB+1,X RTS ; ; DXORI -- DOUBLE PRECISION XOR ; ; CALLING SEQUENCE: ; ; X = OFFSET ; Y = OFFSET ; ; JSR DXORI ; ; DTAB(X) = DTAB(X) XOR DTAB(Y) ; DXORI LDA DTAB,X EOR DTAB,Y STA DTAB,X LDA DTAB+1,X EOR DTAB+1,Y STA DTAB+1,X RTS ; ; DNOTI -- DOUBLE PRECISION NOT ; ; CALLING SEQUENCE: ; ; X = OFFSET ; ; JSR DNOTI ; ; DTAB(X) = NOT DTAB(X) ; DNOTI LDA DTAB,X EOR #$FF STA DTAB,X LDA DTAB+1,X EOR #$FF STA DTAB+1,X RTS .IF LOGGRP ; PROC ; DTYP -- DTAB(Y) PREDICATE. ; ; CALLING SEQUENCE: ; ; Y = OFFSET ; ; JSR DTYP ; ; BNE IF DTAB(Y) POSITIVE (TRUE) ; BEQ IF DTAB(Y) ZERO OR NEGATIVE (FALSE) ; DTYP LDA DTAB+1,Y BMI DTY010 ; NEGATIVE. ORA DTAB,Y ; POSITIVE OR ZERO. RTS ; CC IS SET. .ENDIF ; PROC ; ; ACCUMULATOR FUNCTIONS -- ASSUME THE EXISTENCE OF A DOUBLE PRECISION ; VARIABLE WITHIN 'DTAB' NAMED 'ACC'. ; ; ; DLOADA -- LOAD 'ACC' WITH DATA ; ; CALLING SEQUENCE: ; ; Y = OFFSET TO SOURCE DATA ; ; JSR DLOADA ; ; X = ACC OFFSET ; 'ACC' = DTAB(Y) ; DLOADA LDX #ACC-DTAB JMP DMOVI ; PROC ; ; DSTORA -- STORE 'ACC' TO LOCATION ; ; CALLING SEQUENCE: ; ; X = OFFSET TO DESTINATION ; ; JSR DSTORA ; ; Y = 'ACC' OFFSET ; DTAB(X) = 'ACC' ; DSTORA LDY #ACC-DTAB JMP DMOVI ; PROC ; ; DADDA -- ADD DATA TO 'ACC' ; ; CALLING SEQUENCE: ; ; Y = OFFSET TO DATA ; ; JSR DADDA ; ; X = 'ACC' OFFSET ; 'ACC' = 'ACC' + DTAB(Y) ; DADDA LDX #ACC-DTAB JMP DADDI ; PROC ; ; DSUBA -- SUBTRACT DATA PROM 'ACC' ; ; CALLING SEQUENCE: ; ; Y = OFFSET TO DATA ; ; JSR DSUBA ; BEQ RESULT = 0 ; ; X = 'ACC' OFFSET ; 'ACC' = 'ACC' - DTAB(Y) ; ; DSUBA LDX #ACC-DTAB JMP DSUBI ; PROC ; ; DCMPA -- COMPARE 'ACC' WITH DATA (UNSIGNED) ; ; CALLING SEQUENCE: ; ; Y = DATA OFFSET ; ; JSR DCMPA ; ; CC = 'ACC' : DTAB(Y) (UNSIGNED) ; X = 'ACC' OFFSET ; DCMPA LDX #ACC-DTAB JMP DCMPI ; PROC ; ; ASCDEC -- DECIMAL IN ASCII TO BINARY CONVERSION ; ; CALLING SEGUENCE: ; ; X = DTAB OFFSET TO POINTER VARIABLE ; Y = OFFSET WITHIN STRING TO START OF NUMBER ; ; JSR ASCDEC ; ; 'NUMBER' = RESULT OF CONVERSION (MODULO 2**16) ; Y = INDEX TO END OF NUMBER DELIMITER ; USES 'TEMP' THRU 'TEMP'+4 ; ASCDEC LDA #0 ; INITIALIZE RESULT. STA NUMBER STA NUMBER+1 LDA DTAB,X ; MOVE POINTER. STA TEMP+2 LDA DTAB+1,X STA TEMP+3 LDA DTAB+3,X ; SAVE END INDEX. STA TEMP+4 LDA (TEMP+2),Y CMP #'-' ; UNARY MINUS? BNE L139_AC010 ; NO. INY ; YES -- SKIP OVER IT. JSR L139_AC010 ; *** RECURSIVE CALL ***. LDX #NUMBER-DTAB JMP DNEGI ; NEGATE RESULT & RETURN. L139_AC010 CPY TEMP+4 ; END OF STRING? BEQ L139_AC090 ; YES. LDA (TEMP+2),Y ; GET A CHARACTER. JSR CNUMBR ; VALID DECIMAL DIGIT? BCS L139_AC090 ; NO -- DONE. INY PHA ; YES -- SAVE IT. ASL NUMBER ; X2. ROL NUMBER+1 LDA NUMBER+1 ; SAVE X2. STA TEMP+1 LDA NUMBER STA TEMP ASL ; X4. ROL NUMBER+1 ASL ; X8. ROL NUMBER+1 CLC ; X10 = X8 + X2. ADC TEMP STA NUMBER BCC L139_AC020 ; NO CARRY. INC NUMBER+1 ; CARRY -- ADD TO MSB. CLC L139_AC020 PLA ; GET NEW DIGIT. ADC NUMBER ; ADD TO PARTIAL RESULT. STA NUMBER LDA NUMBER+1 ADC TEMP+1 STA NUMBER+1 JMP L139_AC010 L139_AC090 RTS ; PROC ; ; DECASC -- BINARY TO DECIMAL IN ASCII CONVERSION ; ; CALLING SEQUENCE: ; ; X = DTAB INDEX TO SIGNED VALUE ; ; JSR DECASC ; ; PRINTS RESULT TO 'CHOT' ROUTINE ; USES 'TEMP'+2 THRU 'TEMP'+5 & 'TEMP2' THRU 'TEMP2'+2 ; DECASC STY TEMP+5 ; SAVE Y REGISTER. LDA DTAB,X ; MOVE DATA TO TEMPORARY STORAGE. STA TEMP2 LDA DTAB+1,X STA TEMP2+1 BPL L140_DC020 ; NUMBER IS POSITIVE. LDX #TEMP2-DTAB ; NEGATE NUMBEP. JSR DNEGI LDA #'-' ; PRINT LEADING MINUS SIGN. JSR CHOT ; PRINT A CHARACTER. L140_DC020 LDY #0 ; INITIALIZE CONVERSION INDEX ... STY TEMP2+2 ; ... & LEADING ZERO SUPPRESS FLAG. L140_DC030 LDA PTEN,Y ; GET POWER OF TEN. STA TEMP+2 LDA PTEN+1,Y STA TEMP+3 STY TEMP+4 ; SAVE INDEX TO TABLE. LDA #'0' ; INITIALIZE DIGIT. STA DIGIT LDX #TEMP2-DTAB ; PREPARE FOR SUCCESSIVE SUBTRACTION. LDY #TEMP+2-DTAB L140_DC040 JSR DSUBI LDA TEMP2+1 ; SEE IF RESULT IS NEGATIVE. BMI L140_DC045 ; YES -- ENOUGH ALREADY. INC DIGIT ; NO -- KEEP SUBTRACTING. BNE L140_DC040 ; (BRA). L140_DC045 JSR DADDI ; NOW CORRECT FROM ONE TOO MANY SUBTRACTS. LDA TEMP2+2 ; SEE IF NON-ZERO DIGIT HAS BEEN PRINTED YET. BNE L140_DC050 ; YES -- PRINT ALL SUBSEQUENT DIGITS. LDA DIGIT ; NO -- SEE IF THIS DIGIT IS ANOTHER ZERO. CMP #'0' BEQ L140_DC060 ; YES IT IS -- SUPPRESS IT. STA TEMP2+2 ; NO -- SET FLAG AND PRINT DIGIT. L140_DC050 LDA DIGIT ; PRINT DIGIT. JSR CHOT L140_DC060 LDY TEMP+4 ; RESTORE TABLE INDEX. INY INY CPY #PTENL ; DONE? BNE L140_DC030 ; NO. LDA TEMP2+2 ; WAS THE NUMBER = 0? BNE L140_DC070 ; NO. LDA #'0' ; YES -- PRINT SINGLE ZERO DIGIT. JSR CHOT L140_DC070 LDY TEMP+5 ; YES -- RESTORE Y REGISTER ... RTS ; ... & RETURN. PTEN .WORD 10000,1000,100,10,1 ; DECREASING POWERS OF TEN. PTENL = *-PTEN ; TABLE LENGTH IN WORDS. ; PROC ; ; CNUMBR -- CHECK ASCII CHARACTER FUR VALID NUMBER ('0 - '9) ; ; CALLING SEQUENCE: ; ; A = ASCII CHAPACTER ; ; JSR CNUMBR ; BCS NOT DECIMAL DIGIT ; ; A = BINARY DIGIT ; CNUMBR CMP #'0' ; < '0? BCC L141_CN010 ; YES -- INVALID. CMP #'9'+1 ; > '9? BCC L141_CN020 ; NO -- VALID DECIMAL DIGIT. L141_CN010 SEC ; SET CARRY FOR EXIT. RTS L141_CN020 SBC #'0'-1 ; (ADJUST FOR CARRY CLEAR). CLC ; SET CC FOR EXIT. RTS ; PROC ; ; CLETTR -- CHECK ASCII CHARACTER FOR ALPHA LETTER ('A - 'Z) ; ; CALLING SEQUENCE: ; ; A = ASCII CHARACTER ; ; JSR CLETTR ; BCS NOT ALPHA LETTER ; ; A = ASCII CHARACTER ; CLETTR PHA ; SAVE CHARACTER. AND #UC ; FORCE UPPER CASE. CMP #'A' ; < 'A? BCC L142_CL010 ; YES -- NOT ALPHA. CMP #'Z'+1 ; > 'Z? BCC L142_CL020 ; NO -- VALID LETTFR L142_CL010 SEC ; SET CARRY FOR EXIT L142_CL020 PLA ; RESTORE CHARACTER. RTS ; PROC ; ; STMLST -- SETUP LIST POINTER TO STATEMENT LIST ; STMLST LDA S1L ; 'LP' = 'S1L'. STA LP LDA S1L+1 STA LP+1 LDA #ATRLIN ; 'LIN' FOR LINE STA ATRTYP RTS ; PROC ; ; SETSVL -- SETUP LIST POINTER TO NAMED STRING LIST ; SETSVL LDA S2L ; 'LP' = 'S2L'. STA LP LDA S2L+1 STA LP+1 RTS ; PROC ; ; CKEOA -- CHECK FOR END OF ATOM (NON- ALPHANUMERIC CHARACTER) ; ; CALLING SEQUENCE: ; ; A = ASCII CHARACTER ; ; JSR CKEOA ; BEQ END OF ATOM (NOT AN ALPHANUMERIC CHARACTER) ; CKEOA JSR CLETTR ; ALPHA LETTER BCC L145_CK090 ; YES. PHA JSR CNUMBR ; NO -- NUMERIC CHARACTER? PLA BCC L145_CK090 ; YES. STA TEMP ; NEITHER -- SET CC FOR EXIT. CMP TEMP RTS L145_CK090 CMP #$FF ; SET CC FOR E RTS ; ; SCEOA -- SCAN TO END OF ATOM ; INY SCEOA LDA (INLN),Y JSR CKEOA ; END OF ATOM? BNE SCEOA-1 ; NO. RTS ; YES -- RETURN WITH CC SET. ; PROC ; ; SCNLBL -- IDENTIFY (& SCAN TO END OF) LABEL ; ; CALLING SEQUENCE: ; ; Y = INDEX TO INPUT LINE. ; ; JSR SCNLBL ; BNE NO LABEL PRESENT (A = CODE) ; ; Y = INDEX TO END OF LABEL + 1 ; INDENT = INDEX TO FIRST NON-SEPARATOR. ; ; NOTE: JUMPS TO 'PSTOP' IF INVALID LABEL NAME FOUND. ; SCNLBL JSR SKPSEP ; SKIP LEADING BLANKS AND/OR COMMAS. STY INDENT ; UPDATE # AUTO INDENT CMP #'*' ; LABEL PREFIX DELIMITER? BEQ L146_SL005 ; YES. LDA #IMPERR ; NO LABEL. RTS L146_SL005 INY LDA (INLN),Y JSR CKEOA ; SEE IF AT LEAST ONE ALPHANUMERIC. BNE SCEOA ; YES -- SCAN TO END OF ATOM & RETURN. LDA #ATMERR ; NO -- INVALID LABEL NAME. JMP PSTOP ; PROC ; ; CHKSEP -- CHECK FOR OPERAND SEPARATOR CHARACTER ; ; CALLING SEQUENCE: ; ; A = CHARACTER. ; ; JSR CHKSEP ; BNE NOT A SEPARATOR ; CHKSEP CMP #' ' ; BLANK? BEQ L147_CS090 ; YES. CMP #',' ; COMMA? BEQ L147_CS090 ; YES. JMP CHKTRM ; END OF STATEMENT CHECK & RETURN. L147_CS090 RTS ; PROC ; ; CHKTRM -- CHECK FOR STATEMENT TERMINATOR (EOL OR '['). ; ; CALLING SEQUENCE: ; ; A = CHARACTER. ; ; JSR CHKTRM ; BNE NOT STATEMENT TERMINATOR. ; CHKTRM CMP #EOL BEQ L148_CK090 CMP #SBRACK L148_CK090 RTS ; PROC ; ; CHKEQS -- CHECK FOR EQUAL SIGN ; ; CALLING SEQUENCE: ; ; Y = 'INLN' INDEX. ; ; JSR CHKEQS ; BEQ 1ST NON-BLANK CHARACTER WAS '='. ; ; Y = 'INLN' INDEX TO 1ST NON-BLANK CHAR. ; CHKEQS JSR SLB ; SKIP LEADING BLANKS. CMP #'=' RTS ; RETURN WITH CC SET. ; PROC ; ; SKPSEP -- SKIP OPERAND SEPARATOR(S) ; ; CALLING SEQUENCE: ; ; Y = INDEX TO INPUT LINE ; ; JSR SKPSEP ; ; Y = INDEX TO FIRST NON-SEPARATOR FOUND ; ; NOTE: ANY STRING OF CONSECUTIVE BLANKS AND/OR COMMAS IS TREATED AS A SINGLE ; SEPARATOR. ; INY SKPSEP LDA (INLN),Y CMP #' ' ; BLANK? BEQ SKPSEP-1 ; YES. CMP #',' ; COMMA? BEQ SKPSEP-1 ; YES. RTS ; PROC ; ; SLB -- SKIP LEADING BLANKS ; ; CALLING SEQUENCE: ; ; JSR SLB ; ; A = FIRST NON-BLANK CHARACTER FOUND. ; INY SLB LDA (INLN),Y CMP #' ' ; BLANK? BEQ SLB-1 ; YES -- KEEP SCANNING. RTS ; PROC ; ; SCNEOL -- SCAN TO END OF LINE ; INY SCNEOL LDA (INLN),Y CMP #EOL BNE SCNEOL-1 RTS ; RETURN WITH CC SET. ; PROC ; ; PSF -- PRINT A STORAGE FORMAT LINE ; ; CALLING SEQUENCE: ; ; Y = INDEX TO LINE POINTER. ; ; JSR PSF ; PSF LDX #POINT-DTAB ; MOVE POINTER TO 'POINT'. JSR DMOVI JSR GTLNNO ; GET LINE A TO 'LINENO'. LDX LINENO+1 ; LEADING SPACES TO RIGHT-JUSTIFY LINE A. CPX #>1000 ; >= 1000? BCC L153_PS002 ; NO. BNE L153_PS003 ; YES. LDA LINENO CMP #<1000 BCS L153_PS003 ; YES. L153_PS002 JSR SPACE TXA ; >= 100? BNE L153_PS003 ; YES. LDX LINENO CPX # 100 ; >= 100? BCS L153_PS003 ; YES. JSR SPACE CPX # 10 ; >= 10? BCS L153_PS003 ; YES. JSR SPACE L153_PS003 LDX #LINENO-DTAB JSR DECASC ; PRINT BINARY LINE #. INY ; LOOK AHEAD TO 1ST CHAR OF STATEMENT. INY LDA #' ' ; IS IT A SPACE? CMP (POINT),Y BEQ L153_PS005 ; YES. JSR SPACE ; NO -- PUT SPACE BETWEEN LINE A AND STATEMENT. L153_PS005 DEY ; GET STATEMENT LENGTH. LDA (POINT),Y TAX DEC DSPFLG ; DISPLAY CONTROL CHARACTERS. L153_PS010 INY ; PRINT STATEMENT BODY. LDA (POINT),Y JSR CHOT DEX BNE L153_PS010 INC DSPFLG ; BACK TO ZERO. RTS ; PROC ; ; NULACC -- SET THE ACCEPT BUFFER TO NULL (SINGLE SPACE) ; NULACC LDY #0 LDA #' ' ; SINGLE SPACE. STA (ACLN),Y STY ACLN+2 ; START INDEX. INY STY ACLN+3 ; END INDEX. RTS ; PROC ; ; ABRTCK -- BREAK KEY ABORT CHECK ; ABRTCK PHA ; (SEE 'XSYNC'). LDA BREAK ; OPERATOR ABORT? BNE L155_AC090 ; NO. DEC BREAK ; YES -- RESET FLAG. L155_AC005 LDA #ABTERR ; STOP WITH STATUS CODE. JMP PSTOP .IF FALSE L155_AC010 LDA CONKEY ; ALTERNATE ABORT? AND #STRTKY ; START KEY? BEQ L155_AC090 ; NO. LDA CONKEY ; YES -- RESET STATUS. AND #$FF-STRTKY STA CONKEY JMP L155_AC005 .ENDIF L155_AC090 PLA RTS ; PROC ; ; GTLNNO -- GET LINE # FROM STORAGE LINE ; ; CALLING SEQUENCE: ; ; 'POINT' POINTS TO STORAGE LINE ; ; JSR GTLNNO ; ; 'LINENO' = BINARY LINE # ; Y = 4 ; GTLNNO LDY #3 LDA (POINT),Y STA LINENO+1 ; RE-INVERT ORDER. INY LDA (POINT),Y STA LINENO RTS ; PROC ; NEWLIN -- ISSUE NEW LINE SEQUENCE TO 'CHOT' NEWLIN LDA #EOL JMP CHOT ; NEWLINE & RETURN. ; PROC ; SPACE(S) -- ISSUE SPACE(S) TO 'CHOT' SPACES LDA #' ' ; TWO SPACES. JSR CHOT SPACE LDA #' ' ; ONE SPACE. JMP CHOT ; & RETURN. ; PROC ; ; CRSNOP -- COMPLICATED NOP TO UPDATE CURSOR INHIBIT/ENABLE STATE ; ; CALLING SEQUENCE: ; ; A = 0 TO ENABLE CURSOR, ELSE DISABLE CURSOR. ; CRSNOP STA CRSINH ; SET CURSOR INHIBIT FLAG. LDA #CUP ; CURSOR UP ... JSR CHOT LDA #CDOWN ; ... THEN DOWN ... JMP CHOT ; ... & RETURN. ; PROC ; ; AUDCLR -- CLEAR AUDIO REGISTERS AND SELECTS ; AUDCLR LDA #$03 ; MAGIC CONSTANT FROM D. CRANE, 27-AUG-79. STA SSKCTL STA SKCTL LDA #0 STA AUDCTL ; SET AUDIO TO 4 INDEPENDENT REGISTERS. LDX #AUREGS*2 L160_AC010 STA AUDF1-2,X ; CLEAR ALL ACTIVE TONES. STA AUDC1-2,X STA AUDIOR-2,X ; CLEAR 'SO' SELECTS. STA AUDIOR-1,X DEX DEX BNE L160_AC010 RTS ; PROC ; ; EXP -- ARITHMETIC EXPRESSION EVALUATOR ; ; CALLING SEQUENCE: ; ; 'INLN' POINTS TO LINE TO BE EVALUATED ; Y = INDEX TO START OF EXPRESSION ; ; JSR EXP ; ; Y = INDEX TO END OF EXPRESSION + 1 ; 'EXPSTK'+0 & +1 = RESULT OF EVALUATION. ; EXP LDA #0 ; INITIALIZE CPITICAL VARIABLES. STA ESTKP ; *** EXTERNAL ENTRY POINT *** EXPRC JSR EXPVAL ; CHECK FOR OPERAND & GET VALUE TO STACK. L161_EX030 JSR SLB ; SKIP LEADING BLANKS. STY TEMP2 ; SAVE INDEX. JSR ATOM ; CHECK FOR OPERATOR. BNE L161_EX080 ; INVALID ATOM. CMP #OPR BNE L161_EX080 ; NOT AN OPERATOR. LDX ESTKP ; PUSH OPERATOR ROUTINE ADDR TO EXP STACK. CPX #ESTKSZ BEQ EXP192 ; STACK FULL. LDA POINT STA EXPSTK,X LDA POINT+1 STA EXPSTK+1,X INX INX STX ESTKP JSR EXPVAL ; CHECK FOR OPERAND & GET VALUE TO STACK. JSR SOP ; OPERATE ON STACK DATA. JMP L161_EX030 L161_EX080 LDY TEMP2 RTS EXP192 LDA #EXPERR EXP194 JMP PSTOP ; PROC ; ; EXPVAL -- VALIDATE OPERAND & PUSH VALUE TO STACK ; ; CALLING SEQUENCE: ; ; Y = INDEX TO 'INLN' ; ; JSR EXPVAL ; EXPP LDA #0 ; EVALUATE EXPR IN PARENS. STA ESTKP EXPVAL JSR SLB LDX #UNTABX ; UNARY OPERATOR? JSR SBCMAT BNE L162_EX010 ; NO. TXA ; YES. PHA ; SAVE OFFSET IN 'SBDTAB'. JSR EXPVAL ; *** RECURSIVE CALL *** PLA ; RESTORE OFFSET IN 'SBDTAB'. TAX LDA SBDTAB,X ; GET OPERATOR ROUTINE ADDRESS. STA SJUMP+1 LDA SBDTAB+1,X STA SJUMP+2 LDA ESTKP ; GET OFFSET TO RESULT. CLC ADC #EXPSTK-DTAB-2 TAX JMP SJUMP ; UNARY ROUTINE & RETURN. L162_EX010 LDA (INLN),Y ; RESTORE CHAR. CMP #'(' ; LEFT PAREN? BNE L162_EX020 ; NO. INY JSR EXPRC ; YES -- EVALUATE SUB-EXPRESSION. LDA (INLN),Y CMP #')' ; MATCHING RIGHT RAREN? BNE EXP192 ; NO -- ERROR. INY ; YES -- SKIP OVER IT. RTS L162_EX020 CMP #'?' ; RANDOM NUMBER? BNE L162_EX030 ; NO. LDA PKYRND ; YES -- GET RANDOM # FROM POKEY. STA NUMBER LDA PKYRND STA NUMBER+1 INY ; SKIP OVER '?'. BNE L162_EX040 ; (BRA). L162_EX030 JSR ATOM BNE EXP194 ; ERROR. AND #NUM+NVAR+BPTR ; NUMERIC VARIABLE, POINTER OR CONSTANT? BEQ EXP192 ; NO -- ERROR. L162_EX040 LDX ESTKP ; RESULT TO STACK. CPX #ESTKSZ BEQ EXP192 ; STACK OVERFLOW. LDA NUMBER STA EXPSTK,X LDA NUMBER+1 STA EXPSTK+1,X INX INX STX ESTKP RTS ; PROC ; ; SOP -- STACK OPERATE ; ; CALLING SEQUENCE: ; SOP LDA EXEC ; EXECUTE? BEQ L163_SO050 ; NO -- JUST REJUSTIFY THE STACK. STY TEMP2 LDA ESTKP ; GET EXP STACK INDEX. .IF DEBUG CMP #6 ; SEE IF STACK HAS AT LEAST 3 ENTRIES. BCC L163_SO090 ; NO -- PROBLEM! .ENDIF CLC ; YES -- CONVERT STACK INDEX TO 'DTAB' ADC #EXPSTK-DTAB-2 TAY TAX DEX ; INDEX TO OPERATOR PROCESSOR ADDRESS. DEX LDA DTAB,X ; GET OPERATE ROUTINE ADDRESS. STA SJUMP+1 LDA DTAB+1,X STA SJUMP+2 DEX ; INDEX TO TARGET ENTRY. DEX JSR SJUMP ; OPERATE ON DATA. LDY TEMP2 L163_SO050 SEC ; (CLEAR BORROW). LDA ESTKP ; ADJUST STACK INDEX SBC #4 STA ESTKP RTS .IF DEBUG L163_SO090 LDA #INTERR ; INTERNAL BUG JMP PSTOP .ENDIF ; PROC ; ; TEXP -- EVALUATE TEXT EXPRESSION ; ; Y = POINTER TO START OF TEXT EXPR IN 'INLN'. ; ; JSR TEXP ; BNE EXECUTE MODE ; ; TEXP+2 = 0 ; TEXP+3 = END OF TEXT EXPRESSION. ; ; THE EOL IS NOT PART OF THE RESULTANT TEXT. ; TEXP LDA EXEC ; EXECUTE MODE? BNE L164_TE005 ; YES. JMP SCNEOL ; NO -- SCAN TO EOL & RETURN. L164_TE005 LDA #0 ; INIT RESULT LENGTH COUNT ... STA TELN+3 STA TELN+2 ; ... & STARTING INDEX. LDA CDEST ; SAVE 'CHOT' DESTINATION. STA CDEST+1 LDA #$FF ; YES -- RE-ROUTE 'CHOT' OUTPUT STA CDEST L164_TE010 LDA (INLN),Y ; GET A CHARACTER. JSR CHKTRM ; STATEMENT TERMINATOR? BEQ L164_TE400 ; YES. CMP #'%' ; SPECIAL NUMBER? BEQ L164_TE100 ; YES. CMP #'@' ; POINTER? BEQ L164_TE100 ; YES. CMP #'#' ; NUMERIC VARIABLE DELIMITER? BEQ L164_TE100 ; YES. CMP #'$' ; STRING VARIABLE DELIMITER? BEQ L164_TE100 ; YES. L164_TE020 INY JSR CHOT ; YES -- PRINT TEXT LITERAL. JMP L164_TE010 L164_TE100 PHA ; SAVE THE TEXT CHARACTER. TYA ; SAVE THE Y REG. PHA JSR ATOM ; GET VALUE. BEQ L164_TE220 ; O.K. L164_TE210 PLA ; NOT ATOM -- RESTORE Y REG ... TAY INY ; LOOK AHEAD. LDA (INLN),Y ; IS NEXT CHAR = DOUBLE QUOTE? CMP #'"' BNE L164_TE216 ; NO. PLA ; YES -- FLUSH THE '%' INY ; GET NEXT CHARACTER IN LITERAL L164_TE212 LDA (INLN),Y JSR CHKTRM ; STATEMENT TERMINATOR? BEQ L164_TE400 ; YES. INY CMP #'"' ; LITERAL TERMINATOR? BEQ L164_TE010 ; YES -- BACK TO NORMAL SCAN JSR CHOT ; NOT PRINT LITERAL CHAR. JMP L164_TE212 L164_TE216 DEY ; SET INDEX BACK. PLA ; ... & CHARACTER. BNE L164_TE020 ; (BRA). L164_TE220 CMP #USVAR ; UNDEFINED STRING? BEQ L164_TE210 ; YES -- PRINT LITERALLY. CMP #SVAR ; DEFINED STRING? BEQ L164_TE300 ; YES -- PRINT VALUE. ; NUMERIC DATA PLA ; NO -- MUST BE NUMERIC VALUE. PLA ; CLEAR STACK. LDX #NUMBER-DTAB ; VALUE OF NUMBER. JSR DECASC ; CONVERT TO ASCII & OUTPUT. JMP L164_TE010 ; CONTINUE. ; STRING VARIABLE L164_TE300 PLA ; CLEAR THE STACK. PLA LDX #DP-DTAB ; INDEX TO STRING VALUE. JSR PRTSTG JMP L164_TE010 L164_TE400 LDA CDEST+1 ; RESTORE 'CHOT' DESTINATION. STA CDEST ; EXTERNAL ENTRY POINT FROM 'XACCPT' *** TRAILB LDX TELN+3 ; EXAMINE LAST CHAR OF TEXP. CPX TELN+2 BEQ L164_TE480 ; NULL RESULT. LDA TEXBUF-1,X ; GET LAST CHAR IN BUFFER. CMP #'_' ; UNDERSCORE? BNE L164_TE480 ; NO. LDA #' ' ; YES -- REPLACE WITH BLANK. STA TEXBUF-1,X L164_TE480 LDA EXEC ; THE CC IS BEING SET TO REFLECT THE STATE ; OF THE 'EXEC' FLAG BECAUSE EVERY SINGLE ; JSR TO 'STEP' USED TO BE FOLLOWED BY A ; 'LDA EXEC ' INSTRUCTION. THESE HAVE ALL BEEN ;"COMMENTED" OUT; WHEN WILL THIS ALL END? RTS ; ; HEREIN RESIDE THE LOWER LEVEL GRAPHICS ROUTINES FOR PILOT GRAPHICS. ; ; ; PROC ; ; GMODE -- GRAPHICS 'MODE' SUBCOMMAND. ; GMODE JSR EXP ; GET MODE #. LDA EXEC ; EXECUTE MODE. BEQ L165_GM090 ; NO. STY XTEMP LDY #0 ; SEE IF MODE IS 0-15. LDA #16 LDX #EXPSTK-DTAB JSR DCWCI BCS L165_GM092 ; NO -- MODE >=16. LDX EXPSTK ; SEE IF ALLOWED AS GRAPHICS MODE. LDA GCHAR,X ; WILL BE ZERO IF NOT ALLOWED. BEQ L165_GM092 ; NOT AN ALLOWFD MODE. LDA SPLTSC ; SEE IF SPLIT DESIRED. BEQ L165_GM020 ; NO. AND GCHAR,X ; YES -- IS SPLIT ALLOWED? BEQ L165_GM094 ; NO -- ERROR. L165_GM020 STX GSMODE ; YES -- SAVE MODE. JSR GSOPEN ; RE-OPEN GRAPHICS SCREEN. LDY XTEMP L165_GM090 RTS L165_GM092 LDA #MODERR ; ILLEGAL GRAPHICS MODE. LDY XTEMP JMP PSTOP GSP094 L165_GM094 LDA #SPTERR ; SPLIT SCREEN NOT ALLOWED. LDY XTEMP JMP PSTOP ; PROC ; ; GFULL -- GRAPHICS 'FULL' SUBCOMMAND. ; GFULL LDA EXEC ; EXECUTE MODE? BEQ L166_GF090 ; NO. LDA RUN ; RUN MODE? BEQ L166_GF092 ; NO -- ERROR. LDA SGLSTP ; SINGLE STOP? BNE L166_GF092 ; YES -- ERROR. LDA #0 ; FULL SCREEN STA SPLTSC STY XTEMP JSR GSOPEN ; OPEN SCREEN. LDY XTEMP L166_GF090 RTS L166_GF092 LDA #NRCERR JMP PSTOP ; PROC ; ; GSPLIT -- GRAPHICS 'SPLIT' SUBCOMMAND. ; GSPLIT LDA EXEC ; EXECUTE MODE? BEQ L167_GS090 ; NO. LDA #SPLIT ; SPLIT SCPEEN. STA SPLTSC LDX GSMODE ; SEE IF SPLIT ALLOWED. AND GCHAR,X BEQ GSP094 ; NO -- ERROR. STY XTEMP JSR GSOPEN ; YES -- OPEN SCREEN. LDY XTEMP L167_GS090 RTS ; PROC ; ; 'DRAWTO', 'FILLTO' & 'GOTO' SUB-COMMAND PROCESSORS. ; GFILTO LDA #FILLTO ; PEN DOWN. BNE L168_GG005 ; (BRA). GDRWTO LDA #DRAWTO ; PEN DOWN. BNE L168_GG005 ; (BRA). GGOTO LDA #GOTO ; PEN UP. L168_GG005 STA GROPR ; SET PEN POSITION. JSR EXP ; GET X-COORDINATE. LDA EXEC ; EXECUTE MODE? BEQ L168_GG010 ; NO. LDA EXPSTK ; YES -- UPDATE X. STA GXNEW LDA EXPSTK+1 STA GXNEW+1 L168_GG010 JSR SKPSEP ; SKIP OPERAND SEPARATOR. JSR EXP ; GET Y-COORDINATE. LDA EXEC ; EXECUTE MODE? BEQ L168_GG090 ; NO. LDA EXPSTK ; YES -- UPDATE Y. STA GYNEW LDA EXPSTK+1 STA GYNEW+1 ; *** EXTERNAL ENTRY POINT FROM 'GHOME' *** GGT030 LDA #0 ; CLEAR FRACTIONAL PORTION OF X & Y. STA GXNEW+2 STA GYNEW+2 JSR GMOVE ; NOW EFFECT MOVE. GGO090 GTR090 GTT090 L168_GG090 RTS ; RETURN. ; PROC GTRNTO JSR EXP ; GET POLAR ANGLE. LDA EXEC ; EXECUTE MODE? BEQ GTT090 ; NO. LDA EXPSTK ; YES -- UPDATE POLAR ANGLE. STA THETA LDA EXPSTK+1 STA THETA+1 JMP MOD360 ; MODULO 360 & RETURN ; PROC GBK LDA #DRAW ; BK N = FD-N. STA GROPR JSR EXP ; GET MAGNITUDE OF MOVE LDX #EXPSTK-DTAB ; NEGATE IT. JSR DNEGI JMP L170_GG010 ; GO TO COMMON CODE. GFIL LDA #FILL ; PEN DOWN BNE L170_GG005 GDRW LDA #DRAW ; PEN DOWN. BNE L170_GG005 GGO LDA #GO ; PEN UP. L170_GG005 STA GROPR ; SET PEN POSITION. JSR EXP ; GET MAGNITUDE OF MOVE. L170_GG010 LDA EXEC ; EXECUTE MODE? BEQ GGO090 ; NO. JSR CALDEL ; CALCULATE GXNEW & GYNEW. JSR GMOVE ; NOW EFFECT MOVE. LDA RBTON ; IS ROBOT TURTLE ON? BEQ L170_GG090 ; NO. STY XTEMP ; SAVE INDEX. JSR RGO ; MOVE ROBOT ALSO. LDY XTEMP ; RESTORE INDEX. L170_GG090 RTS CALDEL LDA #1 ; COS(THETA) = SIN(THETA+90). JSR SINVAL ; GYNEW = GYNEW + ( * COS(THETA)). JSR TMULT LDX #GYNEW-DTAB JSR TADDI LDA #0 JSR SINVAL ; GXNEW = GXNEW + ( * SIN(THETA)). JSR TMULT LDX #GXNEW-DTAB JMP TADDI ; PROC GLT JSR EXP ; LT N = RT -N. LDX #EXPSTK-DTAB JSR DNEGI JMP L171_GT010 ; GO TO COMMON CODE. GTRN JSR EXP ; POLAR ANGLE DELTA THETA. L171_GT010 LDA EXEC ; EXECUTE MODE? BEQ GTR090 ; NO. STY XTEMP ; YES -- SAVE INDEX. LDX #THETA-DTAB ; THETA = THETA + DELTA. LDY #EXPSTK-DTAB JSR DADDI JSR MOD360 ; MODULO 360. LDA RBTON ; IS ROBOT TURTLE ON? BEQ L171_GT090 ; NO. JSR RTURN ; MOVE ROBOT ALSO. L171_GT090 LDY XTEMP RTS ; PROC ; ; GPEN -- GRAPHICS 'PEN' SUBCOMMAND ; GPEN JSR CLRMAT ; SEE IF COLOR MATCH. BNE L172_GP099 ; NO -- ERROR. STA PENCOL ; SAVE COLOR REGISTER VALUE. LDA EXEC ; EXECUTE MODE? BEQ L172_GP090 ; NO. BCS L172_GP040 ; YES -- JIF 'UP', 'DOWN ' OR 'ERASE'. TXA ; IS COLOR ALREADY AVAILABLE? BPL L172_GP030 ; YES. LDA PENCOL ; NO -- FIND VACANT SLOT FOR NEW COLOR. JSR CASSGN BNE L172_GP099 ; NO FREE SLOTS. L172_GP030 TXA ; MERGE PEN UP/DOWN STATUS WITH ... .IF FALSE EOR PEN ; ... NEW PIXEL VALUE. AND #$7F EOR PEN .ENDIF STA PEN RTS L172_GP040 TXA BEQ L172_GP030 ; 'ERASE'. BPL L172_GP050 ; 'DOWN'. ORA PEN ; 'UP'. STA PEN RTS L172_GP050 LDA PEN ; 'DOWN'. AND #$FF-PCUP STA PEN L172_GP090 RTS L172_GP099 JMP PSTOP GPU LDA EXEC ; PEN UP. BEQ L172_GP090 LDX #PCUP JMP L172_GP040 GPD LDA EXEC ; PEN DOWN. BEQ L172_GP090 LDX #PCDN JMP L172_GP040 GPE LDA EXEC ; PEN ERASE. BEQ L172_GP090 LDX #0 JMP L172_GP040 ; PROC ; ; GBACK -- GRAPHICS 'BACKGROUND' SUBCOMMAND ; GBACK JSR CLRMAT ; SEE IF COLOR MATCH. BNE L173_GB099 ; NO -- ERROR. BCS L173_GB092 ; JIF 'UP', 'DOWN' OR 'ERASE'. STA PENCOL ; YES -- SAVE COLOR VALUE. LDA EXEC ; EXECUTE MODE? BEQ L173_GB090 ; NO. LDX #0 ; INDEX FOR BACKGROUND. LDA PENCOL ; COLOR REGISTER VALUE. JSR SETCLR ; SET 'PNCLRS' AND COLOR REGISTER. L173_GB090 RTS L173_GB092 LDA #IMPERR ; OPERAND ERROR. L173_GB099 JMP PSTOP ; PROC ; ; GCHNGE -- GRAPHICS 'CHANGE' SUBCOMMAND ; GCHNGE JSR CLRMAT ; GET "FROM" OPERAND. BNE L174_GC099 ; ERROR. BCS L174_GC092 ; 'UP', 'DOWN' OR 'ERASE' INVALID. LDA EXEC ; EXECUTE MODE? BEQ L174_GC020 ; NO. TXA ; SEE IF "FROM" COLOR EXISTS. BMI L174_GC092 ; NO -- ERROR. L174_GC020 STX PENNUM ; YES -- SAVE PEN NUMBER. JSR SKPSEP JSR CLRMAT ; GET "TO" COLOR OPERAND. BNE L174_GC099 ; ERROR. BCS L174_GC092 ; 'UP', 'DOWN' OR 'ERASE' INVALID. CPX #$FF ; CHECK FOR DOUBLE ASSIGN AFTER CHG BNE L174_GC094 ; DOUBLE ASSIGN -- ERROR. LDX EXEC ; EXECUTE MODE? BEQ L174_GC090 ; NO. LDX PENNUM ; GET PEN NUMBER. JSR SETCLR ; SET 'PNCLRS' AND COLOR REGISTER L174_GC090 RTS L174_GC092 LDA #IMPERR ; INVALID OPERAND. JMP PSTOP L174_GC094 LDA EXEC ; NO PROBLEM IF NOT EXECUTE. BEQ L174_GC090 LDA #DCAERR ; DOUBLE ASSIGN. L174_GC099 JMP PSTOP ; PROC ; ; GSHADE -- GRAPHICS 'SHADE' SUBCOMMAND. ; GSHADE JSR CLRMAT ; MATCH OPERAND. BNE L175_GS099 ; NO MATCH. BCS L175_GS092 ; 'UP', 'DOWN' OR 'ERASE'. STA PENCOL ; SAVE PEN COLOR. LDA EXEC ; EXECUTE MODE? BEQ L175_GS090 ; NO. TXA BPL L175_GS030 ; COLOR ASSIGNED. LDA PENCOL JSR CASSGN ; COLOR NOT ASSIGNED -- DO SO. BNE L175_GS099 ; NO FREE SLOT. L175_GS030 STX FCOLOR ; SAVE FILL COLOR. JSR GREAD ; CHECK FOR IN BOUNDS. BCS L175_GS090 ; TURTLE OUT OF BOUNDS. STY XTEMP JSR FLOOD ; SHADE THE AREA. LDY #GX1-DTAB ; RESTORE VISIBLE TURTLE TO PROPER JSR SETCUR JSR CNVRT LDY XTEMP L175_GS090 RTS L175_GS092 TXA BEQ L175_GS030 ; 'ERASE' OK. LDA #IMPERR L175_GS099 JMP PSTOP ; PROC ; ; GWALL -- WALL SUBCOMMAND PROCESSOR. ; GWALL LDX #WLTABX ; 'NONE'? JSR SBCMAT BNE L176_GW010 ; NO. LDA EXEC ; EXECUTE MODE? BEQ L176_GW009 ; NO. LDA #0 ; YES -- CLEAR WALLS. STA WALLS STA WALLS+1 L176_GW009 RTS L176_GW010 JSR CLRMAT ; PEN/COLOR SELECTION? BNE L176_GW092 ; NO. BCS L176_GW092 ; YES -- JIF 'UP', 'DOWN' OR 'ERASE'. LDA EXEC ; EXECUTE MODE? BEQ L176_GW090 ; NO. TXA BMI L176_GW092 ; COLOR NOT ASSIGNED TO A PEN. BEQ L176_GW092 ; BACKGROUND CAN'T BE A WALL. ASL TAX LDA WMASK,X ORA WALLS STA WALLS LDA WMASK+1,X ORA WALLS+1 STA WALLS+1 L176_GW090 RTS L176_GW092 LDA #IMPERR JMP PSTOP ; PROC ; ; GEXIT -- GRAPHICS 'QUIT' SUBCOMMAND. ; GEXIT LDA EXEC ; EXECUTE MODE? BEQ L177_GE090 ; NO. STY XTEMP JSR RBTOFF ; 'ROBOT TURTLE' OFF. JSR TXOPEN ; OPEN TEXT MODE SCREEN. LDY XTEMP GHM090 GCL090 L177_GE090 RTS ; PROC ; ; GCLEAR -- GRAPHICS 'CLEAR' SUBCOMMAND. ; ; *** CALLED BY 'XRUN' TOO *** GCLEAR LDA EXEC ; EXECUTE MODE? BEQ GCL090 ; NO. LDA #0 ; TO AVOID ERROR $80 IF CURSOR AT LOWER ... STA ROWCRS ; ... RIGHT CORNER OF SCREEN. LDA #CLEAR ; YES -- CLEAR GRAPHICS SCREEN ... JMP TOUT ; ... & RETURN. ; PROC ; ; GCLRPN -- GRAPHICS 'CLEARPENS'. ; GCLRPN LDA EXEC ; EXECUTE MODE? BEQ GCL090 ; NO. LDA #1 ; YES -- CLEAR PEN SELECTS. STA NXTCLR RTS ; PROC ; GHOME -- TURTLE HOME GHOME LDA EXEC ; EXECUTE MODE? BEQ GHM090 ; NO. LDA #0 ; YES -- SET TURTLE X & Y TO ZERO. STA GXNEW STA GXNEW+1 STA GYNEW STA GYNEW+1 LDA #GOTO STA GROPR ; GOTO TYPE. JMP GGT030 ; PROC ; GNORTH -- TURTLE NORTH GNORTH LDA EXEC ; EXECUTE MODE? BEQ L181_GN090 ; NO,. LDA #0 ; YES -- SET THETA TO ZERO. STA THETA STA THETA+1 JSR MOD360 L181_GN090 RTS ; PROC ; ; GEDGE -- 'EDGE' SUBCOMMAND ; GEDGE LDX #EDTABX ; 'FREE', 'HALT', WRAP', OR 'BOUNCE'. JSR SBCMAT BNE L182_GE099 ; NO MATCH. LDA EXEC ; EXECUTE MODE? BEQ L182_GE090 ; NO. STX EDGRUL ; YES -- SET RULE SELECT. CPX #EFREE ; RULE = FREE? BEQ L182_GE090 ; YES. LDX #GX-DTAB ; TURTLE IN SCREEN BOUNDS? JSR INTEST BEQ L182_GE090 ; YES. JSR GHOME ; NO -- SEND TURTLE HOME. L182_GE090 RTS L182_GE099 JMP PSTOP ; PROC ; GTURTL -- TURTLE ON/OFF GTURTL LDX #ONOFFX ; EXPECT 'ON' OR 'OFF' JSR SBCMAT BNE L183_GT100 ; NO MATCH - SEE IF COLOR. LDA EXEC ; EXECUTE MODE? BEQ L183_GT090 ; NO. L183_GT020 STX TRTLON ; YES -- SET TURTLE FLAG. STY XTEMP ; SAVE INDEX. JSR TRONOF ; DEAL WITH TURTLE REP. LDY XTEMP ; RESTORE INDEX. L183_GT090 RTS L183_GT092 LDA #IMPERR L183_GT099 JMP PSTOP L183_GT100 JSR CLRMAT ; COLOR SELECTION? BNE L183_GT099 ; NO -- ERROR. BCS L183_GT092 ; JIF 'UP', 'DOWN', OR 'ERASE'. LDX EXEC ; EXECUTE MODE? BEQ L183_GT090 ; NO. STA TRTCOL ; YES -- UPDATE TURTLE COLOR. BNE L183_GT020 ; (BRA) WITH X <> 0. ; PROC ; ; XSETP -- 'SETPEN' COMMAND PROCESSOR ; XSETL -- 'SETLET' COMMAND PROCESSOR ; XSETL BEQ L184_SP010 ; SYNTAX SCAN ONLY. JSR TSTMOD ; LETTERS MEDIUM OR LARGE? CMP #TXML BNE L184_SP094 ; NO -- ERROR. BEQ L184_SP010 ; (BRA) TO COMMON CODE. XSETP BEQ L184_SP010 ; SYNTAX SCAN ONLY. JSR TSTMOD ; GRAPHICS MODE? AND #GRSS+GRFS BEQ L184_SP094 ; NO -- ERROR. L184_SP010 JSR CLM040 ; GET PEN NUMBER. BNE L184_SP090 ; ERROR. STX PENNUM ; SAVE PEN NUMBER. JSR SKPSEP ; SEE IF ALPHA -- IF SO CALL CLRMAT LDA (INLN),Y JSR CLETTR ; ALPHA CHARACTER? BCS L184_SP012 ; NO -- SHOULD BE NEXP. JSR CLRMAT ; YES -- SEE IF COLOR NAME? BNE L184_SP090 ; NO -- ERROR. BCS L184_SP092 ; NO -- 'UP', 'DOWN' OR 'ERASE'. LDX EXEC ; EXECUTE MODE? BEQ L184_SP090 ; NO. BCC L184_SP030 ; VALID COLOR. L184_SP012 JSR EXP ; GET HUE VALUE. LDA EXEC ; EXECUTE MODE? BEQ L184_SP020 ; NO. LDA EXPSTK+1 BNE L184_SP092 ; OUT OF RANGE. # LDA EXPSTK CMP #$10 BCS L184_SP092 ; OUT OF RANGE. ASL ; JUSTIFY THE HUE VALUE. ASL ASL ASL STA XTEMP ; SAVE ADJUSTED VALUE. L184_SP020 JSR SKPSEP JSR EXP ; GET LUM VALUE. LDA EXEC ; EXECUTE MODE? BEQ L184_SP090 ; NO. LDA EXPSTK+1 BNE L184_SP092 ; OUT OF RANGE. LDA EXPSTK CMP #8 BCS L184_SP092 ; OUT OF RANGE. ASL ; X2. ORA XTEMP ; MERGE HUE WITH LUM. L184_SP030 LDX PENNUM ; GET PEN NUMBER. JSR SETCLR ; SET 'PNCLRS' AND COLOR REGISTER. LDA #0 ; SET CC FOR NORMAL RETURN. L184_SP090 RTS ; RETURN WITH CC SET. L184_SP092 LDA #IMPERR RTS L184_SP094 LDA #NRCERR RTS ; PROC ; ; CLRMAT -- COLOR MATCHER ; ; CALLING SEQUENCE: ; ; 'INLN' = POINTER TO STATEMENT. ; Y = STATEMENT INDEX. ; ; JSR CLRNAT ; BNE ERROR ; ; C = 1 INDICATES X = 'PCUP', 'PCDN' OR 0. ; C = 0 INDICATES A = COLOR REGISTER VALUE. ; X = -1 IF NOT IN 'PNCLRS', OR ; X = PIXEL VALUE ('PNCLRS' SLOT #). ; CLRMAT LDX #PCTABX ; MATCH OPERAND. JSR SBCMAT BNE L185_CM040 ; NO MATCH -- SEE IF NEXP CPX #PCUP ; CHECK FOR 'UP', 'DOWN', OR 'ERASE'. BEQ L185_CM080 ; 'UP'. CPX #PCDN ; 'DOWN'. BEQ L185_CM080 TXA BEQ L185_CM080 ; 'ERASE'. LDX #0 ; SEARCH 'PNCLRS' FOR VALUE PATCH. L185_CM010 INX CPX NXTCLR BCS L185_CM020 ; END OF VALID ENTRIES. CMP PNCLRS,X ; COLOR VALUE MATCH? BNE L185_CM010 ; NO. CLC ; YES -- INDICATF COLOR VALUE O.K. RTS ; RETURN WITH CC SET. L185_CM020 LDX #$FF ; INDICATE NOT FOUND. CPX #$FF ; SET CC. CLC ; INDICATE COLOR VALUE O.K. RTS ; RETURN WITH CC SET. ; *** EXTERNAL ENTRY POINT FROM 'XSETP' & ' XSETL ' *** L185_CM040 CLM040 JSR EXP ; PROCESS AS A NUMERIC EXPRESSION. LDA EXEC ; EXECUTE MODE? BEQ L185_CM050 ; NO. LDX EXPSTK+1 BNE L185_CM092 ; OUT OF RANGE. LDX EXPSTK CPX NCOLRS ; IS VALUE IN RANGE? BEQ L185_CM050 ; YES. BCS L185_CM092 ; NO. L185_CM050 LDA PNCLRS,X ; YES -- GET COLOR VALUE. CMP PNCLRS,X ; SET CC FOR EXIT. CLC ; INDICATE PEN NUMBER O.K. RTS ; RETURN WITH CC SET. L185_CM080 SEC ; X = 'PCUP' OR 'PCDN' OR 0. RTS ; RETURN WITH CC SET. L185_CM092 LDA #IMPERR ; OUT OF RANGE PEN NUMBER. RTS ; PROC ; ; CASSGN -- COLOR ASSIGNMENT ; ; CALLING SEQUENCE: ; ; A = COLOR REGISTER VALUE ; GSMODE = GRAPHICS MODE ; NXTCLR = NEXT AVAILABLE SLOT NUMBER ; NCOLRS = LAST SLOT NUMBER ; ; JSR CASSGN ; BNE ERROR ; ; X = PEN NUMBER ; CASSGN LDX NXTCLR ; GET NEXT SLOT NUMBER. CPX NCOLRS ; USEABLE SLOT? BEQ L186_CN005 ; YES. BCS L186_CN092 ; NO MORE SLOTS. L186_CN005 JSR SETCLR ; ASSIGN COLOR TO PEN & COLOR REG. LDX NXTCLR INC NXTCLR LDA #0 ; SET CC FOR NORMAL EXIT. RTS L186_CN092 LDA #NMCERR ; NO MORE PEN SLOTS. RTS ; PROC ; ; SETCLR -- SET COLOR ; ; CALLING SEQUENCE: ; ; A = COLOR REGISTER VALUE. ; X = PEN NUMBER (PIXEL VALUE). ; GSMODE = GRAHICS MODE. ; ; JSR SETCLR ; SETCLR STA PNCLRS,X ; FIRST SET PIXEL VAL IN TABLE. STY SCTEMP PHA ; SAVE COLOR VALUE. TXA ; PIXEL VALUE TO Y REGISTER. TAY LDA GSMODE ASL ; X2 TAX LDA COLADR,X ; GET POINTER TO REGISTER SET. STA FSTACK LDA COLADR+1,X STA FSTACK+1 LDA (FSTACK),Y ; GET COLOR REGISTER INDEX. TAX PLA STA PCOLR0,X ; STORE COLOR VALUE TO REGISTER. LDY SCTEMP RTS ; PROC ; ; PRCLNM -- FIND AND FRINT COLOR NAME ; ; CALLING SEQUENCE: ; ; X = INDEX TO 'PNCLRS' ; ; JSR PRCLNM ; PRCLNM LDA PNCLRS,X ; GET COLOR REGISTER VALUE. STA TEMP2+2 STX PRTEMP ; SAVE X REGISTER. LDX #-1 ; SETUP TO SCAN THE NAME TABLE. L188_PC010 INX STX TEMP2+1 ; SAVE INDEX TO START OF NAME. L188_PC015 LDA PCTAB,X ; GET A CHARACTER. BEQ L188_PC080 ; END OF TABLE -- NO MATCH. BMI L188_PC020 ; FOUND THE # SB' BYTE. INX ; STILL INSIDE THE NAME. BNE L188_PC015 ; (BRA). L188_PC020 INX ; BUMP TO THE VALUE BYTE. LDA PCTAB,X ; GET THE VALUE. CMP TEMP2+2 ; IS THIS THE ONE WE ARE LOOKING FOR? BNE L188_PC010 ; NO. LDX TEMP2+1 ; YES -- GET INDEX TO NAME. JSR PRNTCL ; PRINT COLOR NAME. LDX PRTEMP ; RESTORE X REGISTER. RTS L188_PC080 LDA #0 ; NO NAME -- PRINT THE NUMERIC VALUE. STA TEMP2+3 ; ZERO THE MSB FIRST. LDX #TEMP2+2-DTAB ; POINT TO NUMBER. JSR DECASC LDX PRTEMP ; RESTORE X REGISTER. RTS ; PROC ; ; PRNTCL -- PRINT COLOR NAME FROM NAME TABLE. ; ; CALLING SEQUENCE: ; ; X = INDEX TO FIRST CHARACTER OF COLOR NAME. ; ; JSR PRNTCL ; ; X = INDEX TO NAME DELIMITER. ; PRNTCL LDA PCTAB,X ; GET A CHARACTER. BMI L189_PC090 ; DELIMITER. JSR CHOT INX BNE PRNTCL ; (BRA). L189_PC090 RTS ; PROC TRTPLC LDX #GX-DTAB ; TURTLE IN BOUNDS? JSR INTEST BEQ L190_TR090 ; YES. LDA #-1 ; NO -- SET FLAG. STA GCOL+1 JSR CLRTRT ; CLEAR OLD TURTLE. L190_TR090 RTS CLRTRT LDX TRYPOS ; GET OLD POSITION. LDY #VTHITE LDA #0 L190_TP020 STA TRBUFF,X ; REMOVE OLD REPRESENTATION. INX DEY BNE L190_TP020 RTS ; PROC ; ; TRTLOC -- PLACE VISIBLE TURTLE (AT NEW LOC). ; ; CALLING SEQUENCE: ; ; 'TUFLAG' = 0 IF GCOL & GROW O.K. ; 'TRTLON' = 0 IF OFF, ELSE ON. ; 'GSMODE' = GRAPHICS SCREEN MODE. ; 'THETA' = TURTLE ANGLE. ; 'GCOL' = TURTLE X POSITION. ; 'GROW' = TURTLE Y POSITION. ; ; JSR TRTLOC ; TRTLOC LDA TRTLON ; TURTLE ON? BEQ L191_TP100 ; NO. LDA TUFLAG ; ARE FARMS VALID? BNE L191_TP100 ; NOT NECESSARILY. LDA GCOL+1 ; IN SCREEN BOUND? BMI L191_TP100 ; NO. JSR CLRTRT ; CLEAR OLD TURTLE. JSR DUMCAL ; CALCULATE ORIENTATION. ; CONVERT CURSOR X TO COLOR CLOCKS. LDX GSMODE ; SCREEN MODE DEPENDENT LDY CCPXTB,X ; GET # OF COLOR CLOCKS PER X UNIT BEQ L191_TP040 ; ZERO INDICATES 1/2 CLOCK. TYA ; START WITH 1/2 POSITION OFFSET. CLC ROR CLC L191_TP030 ADC GCOL ; NOW DO MULTIPLY. DEY BNE L191_TP030 BEQ L191_TP050 ; (BRA). L191_TP040 LDA GCOL+1 ; DIVIDE BY 2 (1/2 COLOR CLOCK). ROR LDA GCOL ROR L191_TP050 CLC ADC #$30 ; LEFT EDGE OFFSET. LDY ORIENT ; SUBTRACT ORIENTATION OFFSET. SEC SBC TRDX,Y CLC STA HPOS0+3 ; RESULT IS PLAYER3 HORIZONTAL POSITION. ; CONVERT CURSOR Y TO SCAN LINES LDY SLPYTB,X ; GET #SC AN LINES PERR Y UNIT. TYA ; START WITH 1/2 POSITION OFFSET. CLC ROR CLC L191_TP060 ADC GROW ; MULTIPLY. DEY BNE L191_TP060 ADC #$15 ; *** MAGIC OFFSET *** LDY ORIENT ; SUBTRACT ORIENTATION OFFSET. SEC SBC TRDY,Y STA TRYPOS ; SAVE FOR NEXT TIME IN. TAX ; SETUP FOR THIS TIME. LDY #0 L191_TP090 LDA (TRADDR),Y ; MOVE PATTERN TO MISSILE BUFFER STA TRBUFF,X INX INY CPY #VTHITE BNE L191_TP090 L191_TP100 RTS ; PROC ; TRTINI -- VISIBLE TURTLE INITIALIZATION. TRTINI LDX #253 ; CLEAR TURTLE REPRESENTATION BUFFER. LDA #0 STA TRYPOS STA TUFLAG ; INITIALIZE TURTLE LOC. INTERLOCK. STA SIZEP3 ; PLAYER SIZE. L192_TI010 STA TPBUFF+2,X DEX BNE L192_TI010 LDX #8 ; INITIALIZE PLAYER/MISSILE HARDWARE. L192_TI020 STA HPOS0-1,X ; SET ALL HORIZONTAL POSITION TO ZERO DEX BNE L192_TI020 LDA #1 ; SET PRIORITY. STA GPRIOR LDA #>[TPBUFF-$700] ; PLAYER/MISSILE BASE ADDRESS STA PMBASE LDA #$02 ; DEFAULT TURTLE COLOR. STA TRTCOL RTS ; PROC ; TRONOF -- MISSILE DMA ON/OFF. TRONOF LDA TRTLON ; TURTLE ON? BEQ L193_TF050 ; NO. LDA TRTCOL ; YES -- SET PLAYER COLOR REG. STA PCOLR0+3 LDA #2 STA GRACTL LDA DMACT ; ENABLE PLAYER DMA (HIGH RESOLUTION ORA #$18 STA DMACT STA DMACTL RTS L193_TF050 LDA DMACT ; PLAYER DMA OFF. AND #$E7 STA DMACT LDA #0 STA GRACTL STA GRAFP3 RTS ; PROC DUMCAL LDA GANGLE ; TRADDR := GANGLE. STA TRADDR LDA GANGLE+1 STA TRADDR+1 LDY #0 LDX #TRADDR-DTAB LDA #-8 JSR DADDS LDA TRADDR+1 BMI L194_DC020 L194_DC010 INY LDA #-15 JSR DADDS LDA TRADDR+1 BPL L194_DC010 CPY #24 BCC L194_DC020 LDY #0 L194_DC020 STY ORIENT LDA #>VTURT ; SETUP POINTER TO TURTLE REP. STA TRADDR+1 LDA #DELTAC LDY #DELTAC-DTAB JSR DCMPI BCC L196_DR050 LDX #ENDPT-DTAB ; THEN BEGIN. LDY #DELTAR-DTAB ; ENDPT := DELTAR. JSR DMOVI LDX #COLAC-DTAB ; COLAC := DELTAR/2. JSR DMOVI LSR COLAC+1 ROR COLAC LDA #0 ; ROWAC := 0. STA ROWAC STA ROWAC+1 LDX #COUNTR-DTAB ; COUNTR := ABS(GY1-GY2) LDY #GY1-DTAB JSR DMOVI LDY #GY2-DTAB JSR DSUBI JSR DABSI JMP L196_DR060 ; END. L196_DR050 LDX #ENDPT-DTAB ; ELSE BEGIN. LDY #DELTAC-DTAB ; ENDPT := DELTAC. JSR DMOVI LDX #ROWAC-DTAB ; ROWAC := DELTAC/2. JSR DMOVI LSR ROWAC+1 ROR ROWAC LDA #0 ; COLAC := 0. STA COLAC STA COLAC+1 LDX #COUNTR-DTAB ; COUNTR := ABS(GX1-GX2). LDY #GX1-DTAB JSR DMOVI LDY #GX2-DTAB JSR DSUBI JSR DABSI ; END. L196_DR060 LDA COUNTR ; IF COUNTR>0 THEN BEGIN. ORA COUNTR+1 BNE L196_DR60F JMP L196_DR900 L196_DR60F LDX #ROWAC-DTAB ; ROWAC := ROWAC + DELY. LDY #DELY-DTAB JSR DADDI LDY #ENDPT-DTAB ; IF ROWAC>=ENDPT THEN BEGIN. JSR DSCMI BCC L196_DR063 JSR DSUBI ; ROWAC := ROWAC-ENDPT. DEC ROWCRS ; ROWCRS := ROWCRS-1. LDA ROWCRS CMP #-1 BNE L196_DR070 STA HITEDG ; SET EDGE HIT FLAG. LDA EDGRUL ; OFF TOP EDGE. CMP #EWRAP ; WRAP? BNE L196_DR061 ; NO -- MUST BE BOUNCE OR HALT. LDA MAXROW ; WRAP TO SCREEN BOTTOM EDGE. STA ROWCRS BNE L196_DR070 ; (BRA). L196_DR061 INC ROWCRS ; BRING TURTLE BACK IN. CMP #EHALT ; HALT? BNE L196_DR067 ; NO. STA HALTFG ; YES -- SET FLAG. BEQ L196_DR070 ; (BRA). L196_DR063 LDA ROWAC+1 ; ELSE IF ROW AC < 0 THEN BEGIN. BPL L196_DR070 JSR DADDI ; ROWAC := ROWAC + ENDPT. INC ROWCRS ; ROWCRS := ROWCRS+1; END. LDA MAXROW CMP ROWCRS BCS L196_DR070 ; ROWCRS <= MAXROW. STA HITEDG ; SET EDGE HIT FLAG. LDA EDGRUL ; OFF BOTTOM EDGE. CMP #EWRAP ; WRAP? BNE L196_DR065 ; NO -- MUST BE BOUNCE OR HALT. LDA #0 ; WRAP TO SCREEN TOP EDGE. STA ROWCRS BEQ L196_DR070 ; (BRA). L196_DR065 DEC ROWCRS ; BRING TURTLE BACK IN. CMP #EHALT ; HALT? BNE L196_DR067 ; NO. STA HALTFG ; YES -- SET FLAG. BEQ L196_DR070 ; (BRA). L196_DR067 JSR DNEGI ; ROWAC:= ENDPT-ROWAC-1. JSR DADDI JSR DDCRI SEC ; THETA := THETA-180. LDA #<180 SBC THETA STA THETA LDA #>180 SBC THETA+1 STA THETA+1 JSR MOD360 LDX #DELY-DTAB ; DELY != -DELY. JSR DNEGI L196_DR070 LDX #COLAC-DTAB ; COLAC := COLAC+DELX. LDY #DELX-DTAB JSR DADDI LDY #ENDPT-DTAB ; IF COLAC >= ENOPT THEN BEGIN. JSR DSCMI BCC L196_DR073 JSR DSUBI ; COLAC := COLAC-ENDPT. JSR INCCOL ; COLCRS := COLCRS+1. LDA MAXCOL+1 CMP COLCRS+1 BNE L196_DR70F LDA MAXCOL CMP COLCRS L196_DR70F BCS L196_DR080 ; COLCRS <= MAXCOL. STA HITEDG ; SET EDGE HIT FLAG. LDA EDGRUL ; OFF RIGHT EDGE. CMP #EWRAP ; WRAP? BNE L196_DR071 ; NO -- MUST BE BOUNCE OR HALT. LDA #0 ; WRAP SCREEN LEFT EDGE. STA COLCRS STA COLCRS+1 BEQ L196_DR080 ; (BRA). L196_DR071 JSR DECCOL ; BRING TURTLE BACK IN. LDA EDGRUL CMP #EHALT ; HALT? BNE L196_DR077 ; NO. STA HALTFG ; YES -- SET FLAG. BEQ L196_DR080 ; (BRA). L196_DR073 LDA COLAC+1 ; ELSE IF COLAC < 0 THEN BEGIN. BPL L196_DR080 JSR DADDI ; COLAC := COLAC+ENDPT. JSR DECCOL ; COLCRS := COLCRS-1. LDA COLCRS+1 BPL L196_DR080 ; COLORS >= MINCOL. STA HITEDG ; SET EDGE HIT FLAG. LDA EDGRUL ; OFF LEFT EDGE. CMP #EWRAP ; WRAP? BNE L196_DR075 ; NO -- MUST BE BOUNCE. LDA MAXCOL ; WRAP TO SCREEN RIGHT EDGE. STA COLCRS LDA MAXCOL+1 STA COLCRS+1 JMP L196_DR080 L196_DR075 JSR INCCOL ; BRING TURTLE BACK IN. LDA EDGRUL CMP #EHALT ; HALT? BNE L196_DR077 ; NO STA HALTFG ; YES -- SET FLAG. BEQ L196_DR080 ; (BRA). L196_DR077 JSR DNEGI ; COLAC:=ENDPT-COLAC-1. JSR DADDI JSR DDCRI LDX #THETA-DTAB ; THETA := -THETA. JSR DNEGI JSR MOD360 LDX #DELX-DTAB ; DELX := -DELX. JSR DNEGI L196_DR080 LDA HALTFG ; HALT? BEQ L196_DR081 ; NO. STA HITEDG ; YES -- SET EDGE HIT FLAG. BNE L196_DR900 ; STOP DRAWING (BRA). L196_DR081 LDA WALLS ; WALLS ACTIVE? ORA WALLS+1 BEQ L196_DR082 ; NO. JSR SGSTUF ; SAVE GROW & GCOL. JSR TSTPIX ; GET PIXEL VALUE AT CURRENT POSITIGN JSR WALLCK ; IS IT A WALL? BNE L196_DR300 ; YES -- BACKUP TO PRIOR POSITION. BEQ L196_DR084 ; (BRA) L196_DR082 JSR CNVRT ; ROW/COLUMN TO MEM ADDRESS. L196_DR084 LDA GROPR ; 'GO'. CMP #GO BEQ L196_DR085 ; YES -- DON'T PLOT INTERMEDIATE POINT. JSR PLOT ; PLOT POINT IF PEN DOWN. LDA GROPR ; 'FILL' OR 'FILLTO'? AND #$10 BEQ L196_DR085 ; NO. LDA #0 ; YES -- SETUP FOR TSTPIX CALL. STA FLDCLR LDA COLCRS ; SAVE CURRENT CURSOR POSITION. PHA LDA COLCRS+1 PHA L196_DR84D JSR TSTCOL ; SEE IF TURTLE AT RIGHT EDGE. LDA COLFLG AND #$40 BNE L196_DR84E ; YES JSR INCCOL ; NO. JMP L196_DR84F L196_DR84E LDA #0 ; SET TURTLE TO LEFT EDGE. STA COLCRS STA COLCRS+1 L196_DR84F JSR TSTPIX ; IS TURTLE OVER BACKGROUND? BNE L196_DR84M ; NO -- ALL DONE WITH SCAN. JSR PLOT ; YES -- REPLACE WITH FILL COLOR. JMP L196_DR84D L196_DR84M PLA STA COLCRS+1 PLA STA COLCRS JSR CNVRT ; REESTABLISH VISIBLE TURTLE. L196_DR085 LDX #COUNTR-DTAB ; COUNTR := COUNTR-1. JSR DDCRI JSR SPDDEL JMP L196_DR060 ; END. L196_DR300 STA HITWLL ; SET FLAG. JSR RGSTUF ; RESTORE GROW & GCOL. L196_DR900 LDA GROPR ; GO? CMP #GO BNE L196_DR990 ; NO. LDA HITWLL ; WALL HIT? BNE L196_DR990 ; YES -- DON'T PLOT POINT. LDA NOPLOT ; PLOT INHIBIT. BNE L196_DR990 ; YES -- DON'T PLOT POINT. JSR CNVRT ; PLOT STOP POINT. JSR PLOT L196_DR990 RTS ; PROC SPDDEL LDX SPEED ; CHECK SPEED SELECTION. BEQ L197_SD200 ; FULL SPEED AHEAD. L197_SD100 LDA RTCLOK+2 ; COUNT CLOCK TICKS. L197_SD110 CMP RTCLOK+2 ; WAIT FOR ONE TICK. BEQ L197_SD110 JSR GABRTC ; OPERATOR BREAK? BEQ L197_SD300 ; YES. DEX ; DONE? BNE L197_SD100 ; NO. L197_SD200 RTS L197_SD300 JSR SETCR2 ; SET CURSOR. JSR TRTPLC ; PLACE TURTLE. LDA #ABTERR JMP PSTOP SGSTUF LDA GROW ; YES SAVE PRIOR POSITION. STA SAVROW LDA GCOL STA SAVCOL LDA GCOL+1 STA SAVCOL+1 RTS RGSTUF LDA SAVROW ; RESTORE PRIOR POSITION. STA GROW INC TUFLAG LDA SAVCOL STA GCOL LDA SAVCOL+1 STA GCOL+1 DEC TUFLAG RTS PLOT LDA PEN ; PEN UP? BMI L197_PL090 ; YES -- DON'T PLOT POINT. STA FCOLOR JSR FPLOT L197_PL090 RTS ; PROC ; ; CONVERT ROW/COLUMN CURSOR INTO REAL ADDRESS (FROM SAVMSC ON UP). ; CNVRT LDX #01 STX MLTTMP ; VERTICAL CALCULATIONS. DEX ; VERTICAL CALCULATIONS. STX ADRESS+1 ; CLEAR HI BYTE. LDA ROWCRS ; ADRESS := ROWCRS*5. STA GROW ; FOR VISIBLE TURTLE. ASL ; MULTIPLY BY 4. ROL ADRESS+1 ASL ROL ADRESS+1 ; CLEAR CARRY. ADC ROWCRS ; ADD TO MAKE *5. STA ADRESS BCC L198_CNVR0 INC ADRESS+1 L198_CNVR0 LDY GSMODE ; GET MODE LDX DHLINE,Y ; GET NUMBER OF SHIFTS. L198_CNVR1 ASL ADRESS ; ADRESS := ADRESS *X. ROL ADRESS+1 ; DO THE DIVIDE. DEX BNE L198_CNVR1 LDA COLCRS+1 ; HORIZONTAL CALCULATIONS. INC TUFLAG ; SET INTERLOCK FOR GCOL UPDATE STA GCOL+1 ; FOR VISIBLE TURTLE. LSR ; SAVE LS8 FOR LATER. LDA COLCRS ; GET LOW BYTE. STA GCOL ; FOR VISIBLE TURTLE. DEC TUFLAG ; CLEAR INTERLOCK. LDX DIV2TB,Y ; GET SHIFT AMOUNT. BEQ L198_CNVR3 ; CARRY CLEAR IF NO SHIFT. L198_CNVR2 ROR ; ROLL IN THE CARRY. ASL MLTTMP ; SHIFT INDEX. DEX BNE L198_CNVR2 L198_CNVR3 ADC ADRESS ; CARRY IS ALWAYS CLEAR. BCC L198_CNVR4 INC ADRESS+1 L198_CNVR4 CLC ADC SAVMSC STA ADRESS LDA ADRESS+1 ADC SAVMSC+1 STA ADRESS+1 LDX DIV2TB,Y LDA HMASK,X AND COLCRS ADC MLTTMP TAY ; MAKE A NEW INDEX. LDA DMASKT,Y ; GET THE FINAL MASK. STA DMASK STA SHFAMT LDY #00 RTS ; PROC ; ; INTEST -- TEST FOR POINT WITHIN SCREEN LIMITS. ; ; CALLING SEQUENCE: ; ; X = DTAB OFFSET TO X,Y PAIR (EACH TRIPLE PRECISION) ; ; JSR INTEST ; BEQ POINT IN SCREEN ; ; A = EDGE TEST BITS (0000LRBT), WHERE 1=OUT OF BOUNDS FOR THAT EDGE. INTEST STY TEMP2+2 ; SAVE Y REGISTER. LDY #TEMP2-DTAB LDA #0 ; INITIALIZE RESULT BYTE. PHA STA TEMP2+1 LDA DTAB+1,X ; CHECK SIGN OF POSITION. BMI L199_IT010 ; NEGATIVE -- COULDN'T BE BEYOND RIGHT EDGE. LDA XC ; SETUP RIGHT EDGE X POSITION STA TEMP2 JSR DSCMI ; TEST RIGHT EDGE. BCC L199_IT020 ; INSIDE SCREEN. BEQ L199_IT020 PLA ; OUTSIDE -- SET STATUS BIT. ORA #ERIGHT BNE L199_IT019 ; (BRA). L199_IT010 SEC ; SET UP LEFT EDGE POSITION. LDA #0 SBC XC STA TEMP2 DEC TEMP2+1 JSR DSCMI ; TEST LEFT EDGE. BCS L199_IT020 ; INSIDE. PLA ; OUTSIDE -- SFT STATUS BIT. ORA #ELEFT L199_IT019 PHA L199_IT020 INX ; ADVANCE TO Y POSITION. INX INX LDA #0 STA TEMP2+1 LDA DTAB+1,X ; CHECK SIGN OF POSITION. BPL L199_IT030 ; POSITIVE -- COULDN'T BE BELOW BOTTOM EDGE. SEC ; SET UP BOTTOM EDGE POSITION. LDA #0 SBC YC STA TEMP2 DEC TEMP2+1 JSR DSCMI ; TEST BOTTOM EDGE. BCS L199_IT040 ; INSIDE. PLA ; OUTSIDE -- SET STATUS BIT. ORA #EBOTOM BNE L199_IT039 ; (BRA). L199_IT030 LDA YC ; SETUP TOP EDGE POSITION. STA TEMP2 JSR DSCMI ; TEST TOP EDGE. BCC L199_IT040 ; INSIDE. BEQ L199_IT040 PLA ; OUTSIDE -- SET STATUS BIT. ORA #ETOP L199_IT039 PHA L199_IT040 LDY TEMP2+2 ; RESTORE Y REGISTER. PLA ; GET STATUS BYTE FOR EXIT. RTS ; PROC ; ; NEWDEL -- COMPUTE SLOPE DELTAS. ; ; CALLING SEQUENCE: ; ; JSR NEWDEL ; BVS OVERFLOW ; ; DELX := GX1-GX2. ; DELY := GY1-GY2. ; NEWDEL LDX #DELX-DTAB ; DELX := GX1-GX2. LDY #GX1-DTAB JSR DMOVI LDY #GX2-DTAB JSR DSUBI BVS L200_ND092 LDX #DELY-DTAB ; DELY := GY1-GY2. LDY #GY1-DTAB JSR DMOVI LDY #GY2-DTAB JSR DSUBI L200_ND092 RTS ; PROC ; ; NEWCUR -- MOVE NEW CURSOR TO CURRENT CURSOR. ; ; 'GX' := 'GXNEW' ; 'GY' := 'GYNEW' ; NEWCUR LDX #6 ; 2 VARIABLES OF 3 BYTES EACH. L201_NC010 LDA GXNEW-1,X STA GX-1,X DEX BNE L201_NC010 RTS ; PROC ; ; MOD36 -- 'THETA' = 'THETA ' MODULO 360 ; MOD360 LDA THETA+1 ; SEE IF ANGLE IS NEGATIVE. BPL L202_MD020 ; NO. LDX #THETA-DTAB ; YES. JSR DNEGI ; GET ABSOLUTE VALUE. LDA THETA+1 ; THETA = 32768 IS A SPECIAL CASE. BMI L202_MD030 JSR MOD360 ; *** RECURSIVE CALL *** LDA THETA ; TEST FOR RESULT = 0. ORA THETA+1 BEQ L202_MD099 ; YES -- DONE. LDA #<360 ; NO -- THETA = 360 - MOD(ABS(THETA)). SEC SBC THETA STA THETA LDA #>360 SBC THETA+1 STA THETA+1 JMP L202_MD090 L202_MD020 LDA THETA+1 ; COMPARE WITH 360. CMP #>360 BNE L202_MD025 LDA THETA CMP #<360 L202_MD025 BCC L202_MD090 ; THETA < 360. LDA #<360 ; PREPARE TO DIVIDE BY 360. STA TEMP2 LDA #>360 STA TEMP2+1 STY TEMP2+2 LDX #THETA-DTAB LDY #TEMP2-DTAB JSR DDIVI LDY TEMP2+2 LDA TEMP ; REMAINDER IN 'TEMP' AFTER DIVIDE. STA THETA LDA TEMP+1 STA THETA+1 JMP L202_MD090 L202_MD030 LDA #<352 ; -32769 MOD 360 = 352 STA THETA LDA #>352 STA THETA+1 L202_MD090 INC TUFLAG ; INTERLOCK FOR GANGLE UPDATE. LDA THETA STA GANGLE LDA THETA+1 STA GANGLE+1 DEC TUFLAG ; CLEAR INTERLOCK. L202_MD099 RTS ; PROC ; ; SETCUR -- SET HANDLER CURSOR ; ; CALLING SEQUENCE: ; ; Y = DTAB OFFSET TO TRIPLE PRECISION X,Y POSITION. ; ; JSR SETCUR ; SETCUR LDA DTAB+2,Y ROL LDA DTAB,Y ADC XC STA COLCRS LDA DTAB+1,Y ADC XC+1 STA COLCRS+1 LDA DTAB+5,Y EOR #SB ROL LDA YC SBC DTAB+3,Y STA ROWCRS RTS ; PROC ; ; GABRTC -- GRAPHICS GPERATOR ABORT CHECKER ; ; CALLING SEQUENCE: ; ; JSR GABRTC ; BEQ ABORT ; GABRTC LDA BREAK ; OPERATOR ABORT? BNE L204_GA090 ; NO. DEC BREAK ; YES -- RESET FLAG. LDA #0 ; SET EXIT STATUS. L204_GA090 RTS ; PROC ; ; WALLCK -- CHECKS TO SEE IF PIXEL VALUE IS A WALL. ; ; CALLING SEQUENCE: ; ; A = PIXEL VALUE (00-$0F) ; ; JSR WALLCK ; BNE PIXEL IS A WALL ; WALLCK ASL ; X2. TAX BEQ L205_WL090 ; BACKGROUND CAN'T BE A WALL. LDA WMASK,X AND WALLS BNE L205_WL090 ; FOUND US A WALL. LDA WMASK+1,X AND WALLS+1 L205_WL090 RTS ; RETURN WITH CC SET. WMASK .WORD 0,$01,$02,$04,$08,$10,$20,$40,$80 .WORD $100,$200,$400,$800,$1000,$2000,$4000 ; PROC ; ; GREAD -- READ GRAPHICS DATA FROM SCREEN. ; ; CALLING SEQUENCE: ; ; CURSOR ALREADY SET TO LOCATION TO READ. ; ; JSR GREAD ; ; A = VALUE OF PIXEL AT CURSOR LOCATION. ; C = 0 IF TURTLE ON SCREEN, 1 IF OFF. ; GREAD LDA EXEC ; EXECUTE MODE? BEQ L206_GR090 ; NO. LDA GRFLAG ; YES -- GRAPHICS SCREEN? BEQ L206_GR090 ; NO. LDX #6 L206_GR010 LDA GX-1,X ; ROUND GX TO GX1 ... ROL ; ... & GY TO GY1. LDA GX-3,X ADC #0 STA GX1-3,X LDA GX-2,X ADC #0 STA GX1-2,X DEX DEX DEX BNE L206_GR010 LDX #GX1-DTAB ; YES -- CHECK FOR POINT IN SCREEN LIMITS. JSR INTEST BNE L206_GR090 ; NOT IN LIMITS -- RETURN VALUE OF ZERO. STY GRTEMP ; SAVE Y REGISTER. LDY #GX1-DTAB ; SET CURSOR POSITION. JSR SETCUR JSR TSTPIX ; GET PIXEL VALUE. LDY GRTEMP CLC RTS L206_GR090 LDA #0 ; RETURN VALUE OF ZERO. SEC VTSRET RTS ; PROC VTSENS LDA #0 ; ASSUME NO OBSTACLE INITIALLY. STA TRTSNS LDA GRFLAG ; GRAPHICS MODE? BEQ VTSRET ; NO --* ALL DONE? JSR SGSTUF ; SAVE GCOL & GROW. TYA ; SAVE. Y REGISTER. PHA LDA PEN ; SAVE PEN. PHA LDA EDGRUL ; SAVE EDGE RULE. PHA LDX #6 ; SAVE TURTLE LOCATION. L207_ST010 LDA GX-1,X PHA DEX BNE L207_ST010 LDA WALLS ; SAVE WALL SELECTIONS. PHA LDA WALLS+1 PHA LDX ESTKP ; ANYTHING IN EXPSTK? BEQ L207_ST017 ; NO. L207_ST015 LDA EXPSTK-1,X ; YES -- SAVE IT ALL. PHA DEX BNE L207_ST015 L207_ST017 LDA #0 ; CLEAR WALLS. STA WALLS STA WALLS+1 LDA #PCUP ; SET PEN TO UP. STA PEN LDA EDGRUL ; IF EDGE RULE = HALT, CHANGE TO FREE. CMP #EHALT BNE L207_ST020 LDA #EFREE STA EDGRUL L207_ST020 LDA #GO ; SIMULATE A GO 1. STA GROPR LDA #0 STA EXPSTK+1 LDA #1 STA EXPSTK JSR CALDEL JSR GMOVE LDX ESTKP ; RESTORE EXPSTK? BEQ L207_ST023 ; NO. LDX #0 L207_ST022 PLA STA EXPSTK,X INX CPX ESTKP BNE L207_ST022 L207_ST023 PLA STA WALLS+1 PLA STA WALLS JSR GREAD BCS L207_ST025 ; NOT IN SCREEN. JSR WALLCK ; WALL? BEQ L207_ST030 ; NO DEC TRTSNS L207_ST025 INC TRTSNS ; YES -- SET SENSOR. INC TRTSNS L207_ST030 LDX #0 ; RESTORE TURTLE POSITION L207_ST040 PLA STA GX,X STA GXNEW,X INX CPX #6 BNE L207_ST040 PLA ; RESTORE EDGE RULE. STA EDGRUL PLA ; RESTORE PEN. STA PEN JSR RGSTUF ; RESTORE GCOL & GROW. PLA TAY ; RESTORE Y-REGISTFR. RTS ; PROC ; ; SINVAL -- GET VALUE OF SIN(THETA+A*90) ; ; CALLING SEQUENCE: ; ; A = QUADRANT OFFSET (0-3) ; 'THETA' = ANGLE (0-359) ; ; JSR SINVAL ; ; 'TEMP' = SIN (THETA+A*90) ; SINVAL STA TEMP+2 ; SAVE QUADRANT OFFSET. STY TEMP+3 LDY #THETA-DTAB ; 'ACC' = 'THETA'. JSR DLOADA ; X = 'ACC' - 'DTAB'. LDA #<90 ; 'TEMP' = 90. STA TEMP LDA #>90 STA TEMP+1 ; NORMALIZE THETA TO 0-90 RANGE AND USE TRIG EQUALITIES TO COMPUTE SINE. L208_SN010 LDY #TEMP-DTAB ; IS 'ACC' <= 90. HP JSR DCMPI BEQ L208_SN020 ; YES. BCC L208_SN020 ; YES. INC TEMP+2 ; NOT YET -- INCREMENT QUADRANT. JSR DSUBI ; 'ACC' = 'ACC' - 90. BNE L208_SN010 ; (BRA UNLESS RESULT = 0). L208_SN020 LDX ACC ; RESULT IS 0 TO 90 FOR TABLE LOOKUP. LDA TEMP+2 ; QUADRANT A. AND #$03 ; MODULO 4. BEQ L208_SN100 ; QUADRANT 0. CMP #1 BNE L208_SN040 LDA #90 ; QUADRANT 1. SBC ACC TAX JMP L208_SN100 L208_SN040 CMP #2 BEQ L208_SN150 ; QUADRANT 2. LDA #90 ; QUADRANT 3. SBC ACC TAX JMP L208_SN150 L208_SN100 LDA #0 ; GET VALUE FROM TABLE. CPX #87 ; 87 THRU 90? BCC L208_SN120 ; NO -- USE TABLE. STA TEMP ; SPECIAL CASE -- FORCE TO 1.0. LDA #1 STA TEMP+1 BNE L208_SN900 ; (BRA). L208_SN120 STA TEMP+1 ; MSB = 0. LDA SINTAB,X STA TEMP ; LSB = VALUE FROM TABLE. JMP L208_SN900 L208_SN150 JSR L208_SN100 ; GET VALUE TO 'TEMP' *** RECURSIVE CALL ***. LDX #TEMP-DTAB ; THEN NEGATE VALUE. JSR DNEGI L208_SN900 LDY TEMP+3 RTS ; SINE TABLE VALUES FOR 0 THROUGH 86 DEGREES SINTAB = * ; SIN(X) * 256 X .BYTE 0,4,9,13,18 ; 0-4 .BYTE 22,27,31,36,40 ; 5-9 .BYTE 44,49,53,58,62 ; 10-14 .BYTE 66,71,75,79,83 ; 15-19 .BYTE 88,92,96,100,104 ; 20-24 .BYTE 108,112,116,120,124 ; 25-29 .BYTE 128,132,136,139,143 ; 30-34 .BYTE 147,150,154,158,161 ; 35-39 .BYTE 165,168,171,175,178 ; 40-44 .BYTE 181,184,187,190,193 ; 45-49 .BYTE 196,199,202,204,207 ; 50-54 .BYTE 210,212,215,217,219 ; 55-59 .BYTE 222,224,226,228,230 ; 60-64 .BYTE 232,234,236,237,239 ; 65-69 .BYTE 241,242,243,245,246 ; 70-74 .BYTE 247,248,249,250,251 ; 75-79 .BYTE 252,253,254,254,255 ; 80-84 .BYTE 255,255 ; 85-66 ; PROC ; ; TMUUT -- TRIPLE PRECISION MULTIPLY ; ; CALLING SEQUENCE: ; ; 'EXPSTK' = WORD OF SIGNED DATA ; 'TEMP' = WORD OF SIGNED DATA ; ; JSR TMULT ; ; 'GNUMB'+1 = MSB OF RESULT ; 'GNUNB'+0 = MIDDLE OF RESULT ; 'GNUMB'+2 = LSB OF RESULT ; TMULT LDA #0 ; CLEAR RESULT REGISTER. STA GNUMB STA GNUMB+1 STA GNUMB+2 STA TEMP+5 ; SIGN EXTENSION BYTES. STA TEMP+4 LDA TEMP+1 ; EXTEND SIGN OF 'TEMP'. BPL L209_TM005 ; SIGN IS POSITIVE. DEC TEMP+5 ; SIGN IS NEGATIVE. L209_TM005 LDA EXPSTK+1 ; EXTEND SIGN OF 'EXPSTK'. BPL L209_TM008 ; SIGN IS POSITIVE. DEC TEMP+4 ; SIGN IS NEGATIVE. L209_TM008 LDX #24 ; SETUP LOOP COUNT. L209_TM010 ASL TEMP ROL TEMP+1 ROL TEMP+5 BCC L209_TM020 CLC LDA GNUMB+2 ADC EXPSTK STA GNUMB+2 LDA GNUMB+0 ADC EXPSTK+1 STA GNUMB+0 LDA GNUMB+1 ADC TEMP+4 STA GNUMB+1 L209_TM020 DEX BEQ L209_TM090 ASL GNUMB+2 ROL GNUMB+0 ROL GNUMB+1 JMP L209_TM010 L209_TM090 RTS ; PROC ; ; TADDI -- TRIPLE PRECISION ADDITION ; ; CALLING SEQUENCE: ; ; X = DTAB OFFSET ; ; JSR TADDI ; ; DTAB(X) = DTAB(X) + 'GNUMB' ; ; NOTE: MSB IS DTAB(X+1), MIDDLE IS DTAB(X+0), LSB IS DTAB(X+2) ; TADDI CLC LDA DTAB+2,X ADC GNUMB+2 STA DTAB+2,X LDA DTAB+0,X ADC GNUMB STA DTAB+0,X LDA DTAB+1,X ADC GNUMB+1 STA DTAB+1,X RTS ; PROC ; ; QMULT -- 16 * 16 YIELDING 32 BIT SIGNED MULTIPLY ; ; CALLING SEQUENCE: ; ; 'GACC' = 2 BYTE MULTIPLICAND. ; Y = DTAB OFFSET TO 2 BYTE MULTIPLIER. ; ; JSR QMULT ; ; 'GACC'[4 BYTE] = 'GACC'[2 BYTE] * 'DTAB'(Y)[2 BYTE] ; QMULT LDX #4 L211_QM010 LDA GACC-1,X STA GTEMP-1,X LDA #0 STA GACC-1,X STA GTEMP2-1,X DEX BNE L211_QM010 LDA DTAB,Y STA GTEMP2 LDA DTAB+1,Y STA GTEMP2+1 BPL L211_QM015 LDA #-1 ; EXTEND SIGN. STA GTEMP2+2 STA GTEMP2+3 L211_QM015 LDA GTEMP+1 BPL L211_QM020 LDA #-1 ; EXTEND SIGN. BNE L211_QM022 ; (BRA). L211_QM020 LDA #0 L211_QM022 STA GTEMP+2 STA GTEMP+3 LDX #32 ; SETUP LOOP COUNT. L211_QM030 ASL GTEMP ; LONG SHIFT LEFT. ROL GTEMP+1 ROL GTEMP+2 ROL GTEMP+3 BCC L211_QM040 ; MSB NOT SET CLC ; BIT SET -- ADD TO PARTIAL LDA GACC ADC GTEMP2 STA GACC LDA GACC+1 ADC GTEMP2+1 STA GACC+1 LDA GACC+2 ADC GTEMP2+2 STA GACC+2 LDA GACC+3 ADC GTEMP2+3 STA GACC+3 L211_QM040 DEX ; DONE? BEQ L211_QM090 ; YES. ASL GACC ; LONG SHIFT LEFT. ROL GACC+1 ROL GACC+2 ROL GACC+3 JMP L211_QM030 L211_QM090 RTS ; PROC ; ; QDIV -- 32 DIVIDED BY 16 YIELDING 16 BIT SIGNED DIVIDE. ; ; CALLING SEQUENCE: ; ; 'GACC' = 4 BYTE DIVIDEND. ; Y = DTAB OFFSET TO 2 BYTE DIVISOR. ; ; JSR QDIV ; BNE OVERFLOW ; ; 'GACC'[2 BYTE] = 'GACC'[4 BYTE] / 'DTAB'(Y) [2 BYTE] ; X = DTAB OFFSET TO 'GACC' ; QDIV = * LDA DTAB,Y ; CHECK FOR DIVIDE BY ZERO. ORA DTAB+1,Y BEQ L212_QD097 LDA #32+1 ; LOOP COUNT. STA TEMP LDA #0 STA GTEMP ; CLEAR REMAINDER TO START. STA GTEMP+1 LDA DTAB+1,Y ; SEE IF DIVISOR IS NEGATIVE. STA TEMP+1 ; SAVE FOR LATER. BPL L212_QD003 ; NO. TYA ; YES -- NEGATE DIVISOR ... TAX JSR DNEGI JSR QNEGA ; ... & DIVIDEND. L212_QD003 LDA GACC+3 ; SEE IF DIVIDEND IS NEGATIVE. STA TEMP+2 ; SAVE FOR LATER. BPL L212_QD006 ; NO. JSR QNEGA ; YES -- NEGATE IT. L212_QD006 LDX #GTEMP-DTAB CLC L212_QD010 ROL GACC ; LONG ROTATE LEFT. ROL GACC+1 ROL GACC+2 ROL GACC+3 ROL GTEMP ; REMAINDER = 2 + NEW BIT. ROL GTEMP+1 DEC TEMP ; DONE? BEQ L212_QD090 ; YES. JSR DCMPI ; IS REMAINDER < DIVISOR? BCC L212_QD010 ; YES. JSR DSUBI ; NO -- CORRECT FOR THAT. SEC BCS L212_QD010 ; (BRA). L212_QD090 JSR DCMPI BCC L212_QD091 LDX #GACC-DTAB LDA #1 JSR DADDS L212_QD091 LDA TEMP+2 ; DONE -- SEE IF RESULT IS TO BE NEGATED? BPL L212_QD093 ; NO. JSR QNEGA ; YES. L212_QD093 LDA TEMP+1 ; SEE IF DIVISOR WAS NEGATED AT BEGINNING. BPL L212_QD096 ; NO. TYA TAX JSR DNEGI ; YES -- CORRECT FOR THAT. L212_QD096 LDX #GACC-DTAB ; AS ADVERTISED. ; CHECK FOR OVERFLOW IN RESULT LDA GACC+1 ; CHECK MSB OF USABLE PORTION. BPL L212_QD098 ; POSITIVE. LDA GACC+2 AND GACC+3 L212_QD097 CMP #-1 JMP L212_QD099 L212_QD098 LDA GACC+2 ORA GACC+3 L212_QD099 RTS ; RETURN WITH CC SET. ; PROC ; ; QNEGA -- 4 BYTE NEGATE ; ; CALLING SEQUENCE: ; ; JSR QNEGA ; ; 'GACC'[4 BYTE] = - 'GACC'[4 BYTE] ; QNEGA SEC ; CLEAR BORROW. LDA #0 SBC GACC STA GACC LDA #0 SBC GACC+1 STA GACC+1 LDA #0 SBC GACC+2 STA GACC+2 LDA #0 SBC GACC+3 STA GACC+3 RTS ; PROC ; ; RADDI -- DOUBLE PRECISION ADD WITH ROUND FROM FRACTION ; RADDI LDA DTAB+2,Y ; GET FRACTION. ROL ; MSB OF FRACTION TO CARRY. JMP DADDIX ; PROC ; ; RSUBI -- DOUBLE PRECISION SUBTRACT WITH BORROW FROM FRACTION. ; RSUBI LDA DTAB+2,Y ; GET FRACTION. EOR #$80 ; INVERT MSB OF FRACTION ROL ; INVERTED MSB TO CARRY. JMP DSUBIX ; PROC ; GPINIT -- INITIALIZE GRAPHICS PARAMETERS (X, Y, THETA & PEN COLOR) GPINIT LDA #0 ; PEN = ERASE AND DOWN. STA PEN LDA #SPLIT ; FORCE SPLIT SCREEN. STA SPLTSC LDA #EFREE ; FREE EDGE TURTLE. STA EDGRUL LDA #SCNMOD ; SET DEFAULT SCREEN MODE STA GSMODE RTS ; PROC ; ; DFCLRS -- SET DEFAULT COLORS ; ; CALLING SEQUENCE: ; ; GSMODE = GRAPHICS MODE ; ; JSR DFCLRS ; ; 'PEN' = 0 ; 'NXTCLR' = 1 ; 'PNCLRS' = DEFAULT VALUES ; COLOR REGS = DEFAULT VALUES ; DFCLRS LDX #0 ; BACKGROUND ... STX PEN LDA #CBLACK ; ... BLACK JSR SETCLR LDX #1 ; PEN #1 ... STX NXTCLR LDA #CRED ; ... RED. JSR SETCLR LDX #2 ; PEN #2 ... LDA #CYELLO ; ... YELLOW. JSR SETCLR LDX #3 ; PEN #3 ... LDA #CBLUE ; ... BLUE. JSR SETCLR RTS ; PROC * * ENTRY POINT FOR FILL ROUTINE: * * THE FOLLOWING PARAMETERS MUST BE SET ON ENTRY: * * GSMODE=GRAPHIC MODE INDEX * FCOLOR=FILL COLOR * ROWCRS,COLCRS=STARTING COORDINATES * MAXROW,MAXCOL=MODE DEPENDENT VALUES * FSTACK = FILL STACK BASE ADDRESS * FLOOD ;ROUTINE ENTRY POINT LDA S1H ; INITIALIZE FLOODSTACK POINTER. STA FSTACK LDA S1H+1 STA FSTACK+1 * * SAVE STARTING COORDINATES * LDA ROWCRS STA SAVROW LDA COLCRS STA SAVCOL LDA COLCRS+1 STA SAVCOL+1 LDX GSMODE ; MASK FCOLOR DOWN TO RANGE. LDA FCOLOR AND DATMSK,X STA FCOLOR * * READ DATA AT STARTING COORDINATES * SAVE AS " FIELD COLOR" * JSR CNVRT ; GET ADDRESS * LDA DMASK AND (ADRESS),Y L218_FIL02 LSR SHFAMT BCS L218_FIL03 LSR BCC L218_FIL02 L218_FIL03 STA FLDCLR ; FIELD COLOR CMP FCOLOR ; SAME AS FILL COLOR? BNE L218_FIL3D ; NO. JMP L218_FIL90 ; YES -- ALL DONE. * L218_FIL3D JSR FPLOT ;PLOT INITIAL POINT * * JSR TSTROW ;TEST ROW BIT ROWFLG BPL L218_FIL04 ; NOT ROW 0 * * IF STARTING ROW = 0 THEN BEGIN * ALGORITHM IN THE DOWN DIRECTION * LDA #DOWN STA ROWINC BNE L218_FIL05 * * STARTING ROW > 0, BEGIN ALGORITHM * IN THE UP DIRECTION * L218_FIL04 LDA #UP STA ROWINC * * PLOT TO STARTING LEFT COLUMN * L218_FIL05 JSR TSTCOL BIT COLFLG BMI L218_FIL07 ;COLCRS=0 * JSR DECCOL JSR TSTPIX BNE L218_FIL06 JSR FPLOT BCS L218_FIL05 * L218_FIL06 JSR INCCOL L218_FIL07 LDA COLCRS STA LFTCOL LDA COLCRS+1 STA LFTCOL+1 * * RESET START COLUMN * LDA SAVCOL STA COLCRS LDA SAVCOL+1 STA COLCRS+1 * * FPLOT TO STARTING RIGHT COLUMN * L218_FIL08 JSR TSTCOL BIT COLFLG BVS L218_FIL10 ;SCREEN EDGE * JSR INCCOL JSR TSTPIX BNE L218_FIL09 JSR FPLOT ;FILL PIXEL BCS L218_FIL08 L218_FIL09 JSR DECCOL L218_FIL10 LDA COLCRS STA RGTCOL LDA COLCRS+1 STA RGTCOL+1 * * TEST ROW -- IF TOP OR BOTTOM THEN * NOTHING REQUIRED ON STACK * JSR TSTROW LDA ROWFLG BNE L218_FIL11 ;TOP OR BOTTOM * * PUSH ONTO FILL STACK -- * ROWCRS * DIRECTION * LFTCOL * RGTCOL * JSR REVROW ;REVERSE ROW/DIRECTION * JSR STKROW JSR STKLC JSR STKRC * JSR REVROW ;RESTORE * * * START THE FILL ALGORITHM * L218_FIL11 CLC ;GO TO NEXT ROW LDA ROWCRS ADC ROWINC STA ROWCRS * L218_FIL12 JSR GABRTC ; OPERATOR ABORT? BNE L218_FIL13 ; NO. JMP L218_FIL95 ; YES. * L218_FIL13 LDA LFTCOL STA COLCRS LDA LFTCOL+1 STA COLCRS+1 * JSR TSTPIX BNE L218_FIL20 ;BORDER PIXEL * L218_FIL14 JSR FPLOT ; FILL PIXEL * LDA COLCRS ;SAVE NEW STA NEWLC ;LEFT LDA COLCRS+1 ;COLUMN STA NEWLC+1 * JSR TSTCOL BIT COLFLG BMI L218_FIL15 ;LEFT SCREEN EDGE * JSR DECCOL JSR TSTPIX BEQ L218_FIL14 ;FIELD PIXEL * * BOUNDARY ENCOUNTERED * COMPARE NEWLC TO LFTCOL * L218_FIL15 SEC LDA LFTCOL SBC NEWLC STA DELTAC LDA LFTCOL+1 SBC NEWLC+1 * BNE L218_FIL16 ;POSSIBLE OPENING LDA DELTAC CMP #3 BCC L218_FIL30 * * * POSSIBLE OPENING -- TEST FOR CLOSURE * L218_FIL16 JSR REVROW L218_FIL17 JSR INCCOL * LDA COLCRS+1 CMP LFTCOL+1 BNE L218_FIL18 LDA COLCRS CMP LFTCOL BNE L218_FIL18 * * CLOSURE -- LEFT EDGE FOUND * NO AREA TO BE PLACED ON STACK * CONTINUE WITH SEARCH FOR RIGHT EDGE * JSR REVROW JMP L218_FIL30 L218_FIL18 JSR TSTPIX BNE L218_FIL17 ;BORDER PIXEL * * FIELD COLOR FOUND -- * SAVE AREA DEFINITION ON STACK * JSR STKROW JSR STKCC ;CURRENT COLCRS JSR STKLC ;LEFT COLUMN * JSR REVROW JMP L218_FIL30 * * * BOUNDARY PIXEL ABOVE/BELOW LEFT COLUMN * SEARCH RIGHT TO FIND NEW LFTCOL * IF RGTCOL REACHED W/O FIELD PIXEL, * THEN AREA IS CLOSED, JUMP TO POP * STACK * L218_FIL20 LDA LFTCOL+1 CMP RGTCOL+1 BNE L218_FIL21 LDA LFTCOL CMP RGTCOL BNE L218_FIL21 * * IF LFTCOL=RGTCOL THEN CLOSURE * JMP L218_FIL70 * L218_FIL21 JSR INCCOL * JSR TSTPIX BEQ L218_FIL22 * * COMPARE TO RGTCOL * LDA COLCRS+1 CMP RGTCOL+1 BNE L218_FIL21 LDA COLCRS CMP RGTCOL BNE L218_FIL21 JMP L218_FIL70 ;CLOSURE * * * FIELD PIXEL FOUND -- * * FILL PIXEL * SET NEWLC * PROCEED TO SEARCH RIGHT FOR RGTCOL * L218_FIL22 JSR FPLOT LDA COLCRS STA NEWLC STA NEWRC LDA COLCRS+1 STA NEWLC+1 STA NEWRC+1 JMP L218_FIL34 * * SEARCH RIGHT FROM LFTCOL TO FIND * NEW RGTCOL * L218_FIL30 LDA LFTCOL STA COLCRS STA NEWRC LDA LFTCOL+1 STA COLCRS+1 STA NEWRC+1 * L218_FIL32 JSR INCCOL * JSR TSTPIX BNE L218_FIL35 ;BORDER PIXEL * JSR FPLOT ;FILL PIXEL * LDA COLCRS STA NEWRC LDA COLCRS+1 STA NEWRC+1 * L218_FIL34 JSR TSTCOL BIT COLFLG BVC L218_FIL32 ;NOT RIGHT SCREEN EDGE * * NEWRC FOUND -- COMPARE TO RGTCOL * L218_FIL35 LDA NEWRC+1 CMP RGTCOL+1 BCC L218_FIL40 BEQ L218_FIL36 BCS L218_FIL50 * L218_FIL36 LDA NEWRC CMP RGTCOL BCS L218_FIL50 * * NEWRC < RGTCOL * IF DELTAC > 3 THEN POSSIBLE OPENING * IN SAME DIRECTION * L218_FIL40 SEC LDA RGTCOL SBC NEWRC STA DELTAC LDA RGTCOL+1 SBC NEWRC+1 BNE L218_FIL41 LDA DELTAC CMP #3 BCS L218_FIL41 JMP L218_FIL60 * * CHECK FOR CLOSURE * L218_FIL41 JSR INCCOL LDA COLCRS+1 CMP RGTCOL+1 BNE L218_FIL43 LDA COLCRS CMP RGTCOL BEQ L218_FIL43 BCS L218_FIL49 ;CLOSURE * L218_FIL43 JSR TSTPIX BNE L218_FIL41 * * OPENING FOUND -- PUSH AREA * DEFINITION ON THE STACK * JSR STKROW JSR STKCC ;CURRENT COLORS JSR STKRC ;RIGHT COLUMN * L218_FIL49 JMP L218_FIL60 * * * NEWRC >= RGTCOL * IF DELTAC > 3 THEN POSSIBLE OPENING * IN THE OPPOSITE DIRECTION * L218_FIL50 BEQ L218_FIL60 SEC LDA NEWRC SBC RGTCOL STA DELTAC LDA NEWRC+1 SBC RGTCOL+1 BNE L218_FIL51 LDA DELTAC CMP #3 BCC L218_FIL60 * * POSSIBLE OPENING - CHECK FOR CLOSURE * L218_FIL51 JSR REVROW L218_FIL52 JSR DECCOL * LDA COLCRS+1 CMP RGTCOL+1 BNE L218_FIL53 LDA COLCRS CMP RGTCOL BNE L218_FIL53 * * CLOSURE * JSR REVROW JMP L218_FIL60 * L218_FIL53 JSR TSTPIX BNE L218_FIL52 * * FIELD COLOR FOUND -- PUSH AREA * DEFINITION ON THE STACK * JSR STKROW JSR STKRC ;RIGHT COLUMN JSR STKCC ;CURRENT COLORS * JSR REVROW * * * CURRENT ROW FILLED -- * TEST FOR SCREEN EDGES, IF NOT * THEN RESET LFTCOL AND RGTCOL * AND JUMP TO START OF ALGORITHM * L218_FIL60 JSR TSTROW LDA ROWFLG ; SCREEN TOP OR BOTTOM BNE L218_FIL70 * LDA NEWLC STA LFTCOL LDA NEWLC+1 STA LFTCOL+1 * LDA NEWRC STA RGTCOL LDA NEWRC+1 STA RGTCOL+1 * JMP L218_FIL11 * * * CLOSURE DETERMINED -- * POP FILL STACK FOR OTHER AREAS TO * BE FILLED * * SETUP NEW ROW,DIRECTION,LFTCOL,RGTCGL * JUMP TO START OF ALGORITHM * L218_FIL70 LDX #FSTACK-DTAB LDY #S1H-DTAB JSR DCMPI BEQ L218_FIL90 JSR POPFS STA RGTCOL+1 JSR POPFS STA RGTCOL JSR POPFS STA LFTCOL+1 JSR POPFS STA LFTCOL JSR POPFS STA ROWINC JSR POPFS STA ROWCRS * JMP L218_FIL12 * * FILL FUNCTION COMPLETE * * RESTORE STARTING CURSOR COORDINATES * AND RETURN * L218_FIL90 LDA SAVROW STA ROWCRS LDA SAVCOL STA COLCRS LDA SAVCOL+1 STA COLCRS+1 * RTS * * FILL FUNCTION ABORT * L218_FIL95 LDY #GX1-DTAB JSR SETCUR JSR CNVRT LDA #ABTERR JMP PSTOP ; PROC * * SUBROUTINES TO SUPPORT THE FILL ROUTINE * * ; PROC * * INCREMENT COLCRS * INCCOL INC COLCRS BNE L220_ICX INC COLCRS+1 L220_ICX RTS * * DECREMENT COLCRS * DECCOL SEC LDA COLCRS SBC #1 STA COLCRS BCS L220_DCX DEC COLCRS+1 L220_DCX RTS * * PLOT DATA POINT AT ROWCRS,COLCRS * ADRESS ALREADY SET BY CONVRT * FPLOT LDA SSFLAG ; HONOR START/STOP (CTRL-1). BNE FPLOT LDA DMASK STA SHFAMT LDA FCOLOR ; FILL COLOR L220_FPLT1 LSR SHFAMT BCS L220_FPLT2 ASL BCC L220_FPLT1 ;UNCONDITIONAL L220_FPLT2 STA MSKTMP ;MASKED DATA LDA DMASK EOR #$FF AND (ADRESS),Y ORA MSKTMP STA (ADRESS),Y RTS ;CARRY SET ; PROC * * TSTPIX -- * CONVERT ROW,COL TO ADDRESS * UNMASK DATA BIT(S) COMPARE WITH FIELD * COLOR RETURN TO TEST CONDITIONS * TSTPIX JSR CNVRT LDA DMASK STA SHFAMT AND (ADRESS),Y L221_TSTP1 LSR SHFAMT ;RIGHT JUSTIFY BCS L221_TSTP2 ;DATA PIXEL LSR BCC L221_TSTP1 ;UNCONDITIONAL L221_TSTP2 CMP FLDCLR ;COMPARE TO FIELD COLOR RTS ; PROC * * TSTCOL -- TEST CURSOR COLUMN * SET COLFLG=$80 FOR COLUMN=0 * SET COLFLG=$40 FOR COLUMN=MAX * TSTCOL LDA #0 STA COLFLG * LDA COLCRS+1 ORA COLCRS BNE L222_TSTC1 * * COLUMN=0 * LDA #$80 STA COLFLG RTS * L222_TSTC1 LDA COLCRS+1 CMP MAXCOL+1 BNE L222_TSTC9 LDA COLCRS CMP MAXCOL BNE L222_TSTC9 * * COLUMN=MAXCOL (RIGHT SCREEN EDGE) * LDA #$40 STA COLFLG L222_TSTC9 RTS ; PROC * * TSTROW -- TEST CURSOR ROW * SET ROWFLG=$80 FOR ROW=0 * SET ROWFLG=$40 FOR ROW=MAX * TSTROW LDA #0 STA ROWFLG CLC LDA ROWCRS BNE L223_TSTR1 * * ROW=0 * LDA #$80 STA ROWFLG RTS * L223_TSTR1 CMP MAXROW BCC TSTRWX * * ROW=MAXROW (BOTTOM SCREEN EDGE) * LDA #$40 STA ROWFLG * TSTRWX RTS ; PROC * * * REVROW -- REVERSE ROW INCREMENT * VALUE (CHANGE SIGN) * AND ADD TO ROWCRS * REVROW CLC LDA ROWINC EOR #$FF ADC #1 STA ROWINC ADC ROWCRS STA ROWCRS RTS ; PROC * * STACK SUBROUTINES * * STKROW - PUSH ROWCRS,ROWINC ONTO FILL STACK * STKROW LDA ROWCRS JSR PUSHFS LDA ROWINC JMP PUSHFS * * STKCC - PUSH CURRENT COLUMN CURSOR ONTO STACK * STKCC LDA COLCRS JSR PUSHFS LDA COLCRS+1 JMP PUSHFS * * STKLC - PUSH LEFT COLUMN ONTO STACK * STKLC LDA LFTCOL JSR PUSHFS LDA LFTCOL+1 JMP PUSHFS * * STKRC - PUSH RIGHT COLUMN ONTO STACK * STKRC LDA RGTCOL JSR PUSHFS LDA RGTCOL+1 JMP PUSHFS STKOVF LDA #FSOFER JMP PSTOP ; ; POPFS -- POP ONE BYTE FROM STACK ; POPFS LDA FSTACK ; FSTACK := FSTACK-1. BNE L225_POP10 DEC FSTACK+1 L225_POP10 DEC FSTACK LDY #0 LDA (FSTACK),Y RTS ; ; PUSHFS -- PUSH ONE BYTE TO STACK. ; PUSHFS LDY FSTACK+1 CPY S2L+1 BCS STKOVF LDY #0 STA (FSTACK),Y INC FSTACK ; FSTACK := FSTACK+1 BNE L225_PSH90 INC FSTACK+1 L225_PSH90 RTS * * TABLES * * DIV2TR = NUMBER OF SHIFTS FOR COLUMN CURSOR * (INDICATES PIXELS PER BYTE) * DMASKT = TABLE OF PIXEL MASKS * * * DINDEX ANTIC MODE BYTSML DIV2TB * * 0 2 40 0 * 1 6 20 0 * 2 7 20 0 * 3 8 10 2 * 4 9 10 3 * 5 A 20 2 * 6 8 20 3 * 7 D 40 2 * 8 F 40 3 * 9 GTIA 1 40 1 * A GTIA 2 40 1 * B GTIA 3 40 1 * C 4 40 0 * D 5 40 0 * E C 20 3 * F E 40 2 * DIV2TB .BYTE 0,0,0,2,3,2,3,2,3,1,1,1,0,0,3,2 * DMASKT .BYTE $00,$FF,$F0,$0F .BYTE $C0,$30,$0C,$03 .BYTE $80,$40,$20,$10 .BYTE $08,$04,$02,$01 * ; PROC ; ; ROBOT TURTLE SUBCOMMANDS FOR PILOT GRAPHICS. ; ; ; RBINIT -- INITIALIZE 'ROBOT TURTLE' ; PBINIT LDA RBVECT+1 ; ROBOT DRIVER INSTALLED? BEQ L226_RI099 ; NO. LDA #RBON ; INITIALIZE. STA RBTCMD JMP REXEC ; EXIT THROUGH DRIVER. ; ; RONOFF -- 'ROBOT ON/OFF' SUBCOMMAND. ; RONOFF LDA RBVECT+1 ; ROBOT DRIVER INSTALLED? BEQ L226_RN090 ; NO. LDX #ONOFFX ; CHECK 'ON' OR 'OFF'. JSR SBCMAT BNE L226_RN092 ; NOT FOUND -- ERROR. TXA ; SET CC FOR 'ON'/'QFF'. BEQ L226_RF020 ; 'OFF'. ; 'ROBOT ON'. STX RBTON ; FLAG 'ROBOT ON'. LDA #RBON ; INTERNAL COMMAND. JMP RXDRIV ; RETURN THROUGH DRIVER. ; 'ROBOT OFF'. ; *** EXTERNAL ENTRY FROM 'GEXIT' ***. RBTOFF LDA RBVECT+1 ; ROBOT DRIVER INSTALLED? BEQ L226_RN099 ; GO -- NOP. LDX #0 ; FLAG 'ROBOT OFF'. L226_RF020 STX RBTON LDA #RBOFF ; INTERNAL COMMAND. JMP RXDRIV ; RETURN THROUGH DRIVER. L226_RH090 L226_RP090 L226_RE090 L226_RN090 LDA #IVCERR ; NO 'ROBOT' OR 'OFF'. L226_RH092 L226_RP092 L226_RE092 L226_RN092 JMP PSTOP L226_RI099 L226_RN099 RTS ; ; REYES -- ROBOT 'EYES' SUBCOMMAND. ; REYES LDA RBTON ; IS ROBOT ON? BEQ L226_RE090 ; NO -- ERROR. LDX #ONOFFX ; CHECK FOR 'ON' OR 'OFF'. JSR SBCMAT BNE L226_RE092 ; NOT FOUND -- ERROR. LDA #RBEYES ; INTERNAL COMMAND. JMP RXDRIV ; RETURN THROUGH DRIVER. ; ; RPEN -- ROBOT 'RPEN' SUBCOMMAND. ; RPEN LDA RBTON ; IS ROBOT ON? BEQ L226_RP090 ; NO -- ERROR. LDX #UPDWNX ; CHECK FOR 'UP' OR 'DOWN'. JSR SBCMAT BNE L226_RP092 ; NOT FOUND -- ERROR. TXA ; CONVERT TO 0 (UP)/1 (DOWN). LDX #0 ; ASSUME UP. CMP #PCDN BNE L226_RP010 ; UP. INX ; DOWN. L226_RP010 LDA #RBPEN ; INTERNAL COMMAND. JMP RXDRIV ; RETURN THROUGH DRIVER. ; ; RHORN -- ROBOT 'HORN' SUBCOMMAND. ; ; 'RHORN OFF' = 'RHORN 0'. ; 'RHORN ON' = 'RHORN 1'. ; RHORN LDA RBTON ; IS ROBOT ON? BEQ L226_RH090 ; NO -- ERROR. LDX #ONOFFX ; CHECK FOR 'ON' OR 'OFF'. JSR SBCMAT BEQ L226_RH020 ; FOUND IT. ; NOT 'ON' OR 'OFF' - CHECK FOR 0,1,2. JSR ATOM ; GET 'HORN' PARAMETER. BNE L226_RH092 ; ERROR -- RETURN. CMP #NUM ; CHECK FOR NUMBER. BNE L226_RH090 ; NO -- ERROR. LDX NUMBER+1 ; 0,1,2 VALID. BNE L226_RH090 ; INVALID. LDX NUMBER CPX #3 BCS L226_RH090 ; INVALID. L226_RH020 LDA #RBHORN ; INTERNAL COMMAND. JMP RXDRIV ; RETURN THROUGH DRIVER. ; ; RGO -- ROBOT 'GO' SUBCOMMAND. ; ; CALLING SEQUENCE: ; ; ROBOT TURTLE ON ; EXPSTK+0,+1 = SIGNED MAGNITUDE. ; EXECUTE MODE ; ; JSR RGO ; RGO LDX #EXPSTK+2-DTAB ; EXPSTK+2,+3 = ABSOLUTE VALUE. LDY #EXPSTK-DTAB JSR DMOVI LDA #RBFWD ; ASSUME FORWARD. BIT EXPSTK+3 ; NOW CHECK SIGN. BPL RGO010 ; FORWARD IT IS. JSR DNEGI ; ABSOLUTE VALUE. LDA #RBBACK ; BACK. ; *** EXTERNAL ENTRY FROM 'RTURN' ***. RGO010 STA RBTCMD ; INTERNAL COMMAND. LDA EXPSTK+2 ; VALUE. STA RBTPRM LDA EXPSTK+3 STA RBTPRM+1 JMP REXEC ; RETURN THROUGH DRIVER. ; ; RTURN -- ROBOT 'TURN' SUBCOMMAND. ; ; CALLING SEQUENCE: ; ; ROBOT TURTLE ON ; EXPSTK+0,+1 = SIGNED MAGNITUDE ; EXECUTE MODE ; ; JSR RTURN ; RTURN LDX #EXPSTK+2-DTAB ; EXPSTK+2,+3 = ABSOLUTE VALUE. LDY #EXPSTK-DTAB JSR DMOVI LDA #RBRGHT ; ASSUME RIGHT. BIT EXPSTK+3 ; NOW CHECK SIGN BPL RGO010 ; RIGHT IT IS. JSR DNEGI ; ABSOLUTE VALUE LDA #RBLEFT ; LEFT. BNE RGO010 ; ; RRDSNS -- ROBOT 'READ SENSORS'. ; ; CALLING SEQUENCE: ; ; JSR RRDSNS ; ; RBTSNS = SENSOR VALUES. ; ; = SNESOR VALUES. ; RRDSNS LDA #RBFWD ; 'GO 0' IS A 'NOP'. LDX #0 STX RBTPRM+1 ; MSB = 0. JSR RXDRIV ; UPDATE SENSORS. LDA RBTSNS ; AS ADVERTISED. RTS ; PROC ; ; RXDRIV -- INTERFACE TO ROBOT DRIVER. ; ; CALLING SEQUENCE: ; ; A = INTERNAL COMMAND. ; X = LSB OF INTERNAL PARAMETER. ; ; JSR RXDRIV ; ; RETURN WITH 'BEQ' ONLY IF OPERATION COMPLETED. ; JUMP TO 'PSTOP' IF 'BREAK' OR LOGIC ERROR. ; ; Y IS PRESERVED. ; ; CHECKS 'EXEC' FLAG AND RETURNS 'OK' IF 'FALSE'. ; RXDRIV STA RBTCMD ; INTERNAL COMMAND. LDA EXEC ; EXECUTE? BEQ L227_RX099 ; NO. STX RBTPRM ; LSB (INTERNAL PARAMETER). ; *S* JMP REXEC ; INTERFACE TO DRIVER. ; ; REXEC -- CALL ROBOT DRIVER. ; ; CALLING SEQUENCE: ; ; 'RBTCMD' = INTERNAL COMMAND BYTE. ; 'RBTPRM' = INTERNAL PARAMETER WORD. ; ; JSR REXEC ; Y IS PRESERVED. ; ; RETURN IF OPERATION COMPLETED. ; JUMP TO 'PSTOP' IF 'BREAK' OR LOGIC ERROR. ; REXEC STY TEMP ; SAVE Y. JSR L227_RX100 ; 'JSR' TO DRIVER. JSR TONES ; Y = 1 (OK); = 128 (BREAK); = 132 (LOGIC ERROR). ; A = ROBOT SENSOR STATE. STA RBTSNS CPY #128 BCC L227_RX090 ; OK. .IF DEBUG BEQ L227_RX020 ; BREAK. L227_RX010 LDA #INTERR ; 'BUG'. BNE L227_RX022 .ENDIF L227_RX020 LDA #ABTERR ; BREAK. L227_RX022 LDY TEMP ; RESTORE Y. JMP PSTOP L227_RX090 LDY TEMP ; RESTORE Y. LDA #0 ; SET CC FOR EXIT. L227_RX099 RTS L227_RX100 .IF DEBUG LDA RBVECT+1 ; ROBOT DRIVER INSTALLED? BEQ L227_RX010 ; NO -- BUG. .ENDIF LDA RBTCMD ; STACK-3. PHA LDA RBTPRM ; STACK-2. PHA LDA RBTPRM+1 ; STACK-1. PHA JMP (RBVECT) ; PROC ; ; AUDIO TONE GENERATION PROCESSOR ; TONES LDX #AUREGS*2 ; SETUP TO SCAN REGISTER ASSIGN TABLE. L228_TO010 LDA AUDIOR-2,X ; POINTER TO VARIABLE. STA POINT ORA AUDIOR-1,X ; NULL ENTRY IF RESULT IS ZERO. BEQ L228_TO020 LDA AUDIOR-1,X ; FINISH MOVING NON-NULL POINTER. .IF FALSE STA POINT+1 BMI L228_TO020 ; NUMERIC CONSTANT. LDY #0 ; NOW GET VALUE. LDA (POINT),Y .ENDIF L228_TO020 AND #$1F ; MODULO 32. TAY LDA AUDTAB,Y ; GET FREQ FROM TABLE. STA AUDF1-2,X ; PUT IN HARDWARE. LDA #$A4 ; QUARTER VOLUME. STA AUDC1-2,X DEX DEX BNE L228_TO010 L228_TO090 RTS AUDTAB .BYTE 0 ; REST .BYTE 243,230,217,204,193,182 .BYTE 172,162,153,144,136,128 .BYTE 121,114,108,102,96,91 .BYTE 85,81,76,72,68,64 .BYTE 60,57,53,50,47,45 .BYTE 42 ; PROC ; ; PILVBL -- DEFERRED VBLANK ROUTINE WHICH READS THE ; CONSOLE KEYS (START/OPTION/SELECT), DEBOUNCES ; THEM AND RETURNS THE STATUS IN 'CONKEY'. ; PILVBL JSR CONKRD ; READ CONSOLE KEYS. JSR TRTLOC ; VISIBLE TURTLE. JMP XITVBV ; EXIT VBLANK. CONKRD LDA CSTATE ; IDLE STATE? BNE L229_CK010 ; NO. LDA CONSOL ; YES -- KEY PRESSED? AND #ANYKEY CMP #ANYKEY BEQ L229_CK090 ; NO -- ALL DOME. EOR #ANYKEY ; INVERT BIT SENSE. STA CONKEY ; SAVE FOR 'MLOOP'. INC CSTATE ; GO TO STATE 1. LDA #$0C ; PUT RETURN CODE IN 'CH'. STA CH LDA #5 ; ACTIVATE TIMER. STA CDTMV5 RTS L229_CK010 CMP #1 ; KEY DOWN DEBOUNCE STATE? BNE L229_CK020 ; NO. LDA CDTMV5 ; YES -- DEBOUNCE DONE? BNE L229_CK090 ; NO. INC CSTATE ; GO TO STATE 2. RTS L229_CK020 CMP #2 ; WAIT FOR KEYS UP STATE? BNE L229_CK030 ; NO. LDA CONSOL ; YES -- ALL KEYS UP? AND #ANYKEY CMP #ANYKEY BNE L229_CK090 ; NO. INC CSTATE ; YES -- GO TO STATE 3. LDA #5 ; ACTIVATE TIMER. STA CDTMV5 RTS L229_CK030 LDA CDTMV5 ; DEBOUNCE DONE? BNE L229_CK090 ; NO. STA CSTATE ; YES -- GO TO STATE 0. L229_CK090 RTS GRDLI PHA STA WSYNC LDA #CBLUE EOR COLRSH ; ATTRACT AND DRKMSK STA COLPF2 LDA #CYELLO EOR COLRSH ; ATTRACT AND DRKMSK STA COLPF1 PLA RTI ; PROC ; ; MESSOT -- MESSAGE GENERATOR ; ; CALLING SEQUENCE: ; ; A = MESSAGE # (INDEX TO INTERNAL TABLE) ; ; JSR MESSOT ; MESSOT = * AND #$7F ; MASK OFF SIGN BIT. ASL .IF DEBUG BEQ L230_MO100 ; 0 IS ILLEGAL. CMP #MTSIZ+1 BCS L230_MO100 ; # IS TOO LARGE. .ENDIF TAX LDA MESTAB-2,X ; GET MESSAGE ADDRESS FROM TABLE. STA TEMP2 LDA MESTAB-1,X STA TEMP2+1 LDY #0 L230_MO010 LDA (TEMP2),Y BEQ L230_MO090 ; DONE (NO EOL AT END). INY ; BUMP POINTER. CMP #CR ; INTERNAL CR? BNE L230_MO015 ; NO. JSR NEWLIN JMP L230_MO010 ; CONTINUE. L230_MO015 CMP #EOL BEQ L230_MO020 ; DONE. JSR CHOT JMP L230_MO010 L230_MO020 JSR NEWLIN L230_MO090 RTS .IF DEBUG L230_MO100 LSR STA ACC ; PRINT # INSTEAD OF CANNED MESSAGE LDA #0 STA ACC+1 LDA #14 JSR MESSOT ; *** RECURSIVE CALL *** LDX #ACC-DTAB JSR DECASC JMP NEWLIN .ENDIF ; PROC RDYMES STY TEMP2+2 ; SAVE Y REG. LDA #RDYTXT ; "READY" TEXT. JSR MESSOT LDY TEMP2+2 RTS ; PROC ; ; TABLE OF MESSAGE ADDRESSES ; MESTAB .WORD L232_MES1 .WORD L232_MES2 .WORD L232_MES3 .WORD L232_MES4 .WORD L232_MES5 .WORD L232_MES6 .WORD L232_MES7 .WORD L232_MES8 .WORD L232_MES9 .WORD L232_MES10 .WORD L232_MES11 .WORD L232_MES12 .WORD L232_MES13 .WORD L232_MES14 .WORD L232_MES15 .WORD L232_MES16 .WORD L232_MES17 .WORD L232_MES18 .WORD L232_MES19 .WORD L232_MES20 .WORD L232_MES21 .WORD L232_MES22 .WORD L232_MES23 .WORD L232_MES24 .WORD L232_MES25 .WORD L232_MES26 .WORD L232_MES27 .WORD L232_MES28 .WORD L232_MES29 .WORD L232_MES30 .WORD L232_MES31 .WORD L232_MES32 .WORD L232_MES33 .WORD L232_MES34 .WORD L232_MES35 .WORD L232_MES36 .WORD L232_MES37 .WORD L232_MES38 .WORD L232_MES39 .WORD L232_MES40 .WORD L232_MES41 .WORD L232_MES42 .WORD L232_MES43 .WORD L232_MES44 .WORD L232_MES45 MTSIZ = *-MESTAB L232_MES1 .BYTE CR,'READY',EOL .IF DEBUG-1 L232_MES12 L232_MES14 L232_MES15 .ENDIF L232_MES2 .BYTE 'WHAT',SQUOTE,'S THAT?',0 L232_MES3 .BYTE 'CAN',SQUOTE,'T USE COMMAND HERE',0 L232_MES4 .BYTE 'DIVIDE BY 0',0 L232_MES5 .BYTE 'OOPS',0 L232_MES6 .BYTE 'I/O ERROR ',0 L232_MES7 .BYTE 'BREAK',0 L232_MES8 .BYTE ' *** ',0 L232_MES9 .BYTE 'NO ROOM',0 L232_MES10 .BYTE 'WHERE?', 0 L232_MES11 .BYTE 'U: TOO DEEP',0 .IF DEBUG L232_MES12 .BYTE 'BUG!',0 .ENDIF L232_MES13 .BYTE 'LINE # OUT OF RANGE',0 .IF DEBUG L232_MES14 .BYTE 'ERROR #',0 L232_MES15 .BYTE 'PLEASE SHORTEN',EOL .ENDIF L232_MES16 .BYTE '$ VARS:',CR,EOL L232_MES17 .BYTE CR,'# VARS:',CR,EOL L232_MES18 .BYTE CR,'USE STACK:',CR,EOL L232_MES19 .BYTE CR,'GR PARMS:',CR,EOL L232_MES20 .BYTE 'THETA=',0 L232_MES21 .BYTE CR,CR,'FREE MEMORY=',0 L232_MES22 .BYTE 'TOO MANY I/OS',0 L232_MES23 .BYTE CLEAR,'ATARI PILOT (C) COPYRIGHT ATARI 1982',EOL L232_MES24 .BYTE '--> ',0 L232_MES25 .BYTE 'CAN',SQUOTE,'T CONTINUE',0 L232_MES26 .BYTE 'STOP',0 L232_MES27 .BYTE CR,'CAN',SQUOTE,'T RENUMBER',EOL L232_MES28 .BYTE 'OVERLAPPING RANGE: ',0 L232_MES29 .BYTE ' TO ',0 L232_MES30 .BYTE CR,'PROGRAM IS UNCHANGED',EOL L232_MES31 .BYTE CR,'YOU ARE ABOUT TO DELETE ',0 L232_MES32 .BYTE ' LINE(S).',CR,'ARE YOU SURE (Y OR N): ',0 L232_MES33 .BYTE 'SPLIT SCREEN NOT ALLOWED',0 L232_MES34 .BYTE 'NOT A GRAPHICS MODE',0 L232_MES35 .BYTE CR,'I/O ASSIGNMENTS:',CR,EOL L232_MES36 .BYTE 'SHADE REGION TOO COMPLEX',0 L232_MES37 .BYTE 'NO MORE PEN COLORS--USE CHANGE',0 L232_MES38 .BYTE 'ALREADY HAVE COLOR',0 L232_MES39 .BYTE 'PENS: ',0 L232_MES40 .BYTE 'BACKGROUND: ',0 L232_MES41 .BYTE 'TURTLE PEN: ',0 L232_MES42 .BYTE 'MODE: ',0 L232_MES43 .BYTE 'EDGE: ',0 L232_MES44 .BYTE 'SPEED: ',0 L232_MES45 .BYTE 'WALLS: ',0 ; EPROC ; ; GRAPHICS TABLES ; ; ; MODE CHARACTERISTICS (BY MODE) ; NG = 0 ; NOT ALLOWED FO = $80 ; ALLOWED BUT NO SPLIT SCREEN (FULL ONLY) SC = FO+SPLIT ; ALLOWED WITH SPLIT SCREEN. GCHAR .BYTE NG,NG,NG .BYTE SC,SC,SC,SC,SC,SC,FO,FO,FO .BYTE NG,NG,SC,SC ; ; PIXEL WIDTH MASKS ; DATMSK .BYTE $FF,$FF,$FF .BYTE 3,1,3,1,3,1,$F,$F,$F .BYTE $FF,$FF,1,3 ; NUMBER OF FOREGROUND COLORS COLRS .BYTE 0,4,4 .BYTE 3,1,3,1,3,1,15,8,15 .BYTE 0,0,1,3 ; SCREEN CENTER OFFSETS XCENTR .WORD 19,9,9 .WORD 19,39,39,79,79,159,39,39,39 .WORD 19,19,79,79 YCENTR .WORD 11,11,5 .WORD 11,23,23,47,47,95,95,95,95 .WORD 11,5,95,95 ; SCREEN BOUNDARIES FOR FILL COLMAX .WORD 38,18,18 .WORD 38,78,78,158,158,318,78,78,78 .WORD 38,38,158,158 ROWMAX .WORD 22,22,10 .WORD 22,46,46,94,94,190,190,190,190 .WORD 22,10,190,190 ; TEXT SCREEN MARGINS LMRGTB .BYTE 2,0,0 ; LEFT MARGINS. RMRGTB .BYTE 39,19,19 ; RIGHT MARGINS ; COLOR CLOCKS PER HORIZONTAL UNIT FOR MODES 0 - 15. CCPXTB .BYTE 8,8,8 .BYTE 4,2,2,1,1,0,2,2,2 ; (0 = 1/2) .BYTE 4,4,1,1 ; SCAN LINES PER CURSOR VERTICAL UNIT FOR MODES 0 - 15. SLPYTB .BYTE 16,8,16 .BYTE 8,4,4,2,2,1,1,1,1 ; (0 = 1/2) .BYTE 8,16,1,1 ; THIS IS THE NUMBER OF LEFT SHIFTS NEEDED TO MULTIPLY COLORS ; BY # BYTES/ROW. (ROWCRS*5)/(2*DHLINE) DHLINE .BYTE 3,2,2 .BYTE 1,1,2,2,3,3,3,3,3 .BYTE 3,3,2,3 ; HMASK .BYTE 0,1,3,7 ; OFFSETS TQ DISPLAY LIST INTERRUPT BYTE FOR SPLIT SCREEN. DLIOFF .BYTE 0,0,0 .BYTE 24,44,44,84,84,166,0,0,0 .BYTE 0,0,164,166 ; VISIBLE TURTLE Y OFFSET TRDY .BYTE 1,1,0,1,0,0 .BYTE 0,2,1,1,1,0 .BYTE 0,0,2,1,1,2 .BYTE 0,0,0,1,0,1 ; VISIBLE TURTLE X OFFSET TRDX .BYTE 3,3,3,3,3,3 .BYTE 3,3,3,3,3,3 .BYTE 3,3,3,3,4,4 .BYTE 5,4,4,4,4,4 ; VISIBLE TURTLE PLAYER DATA VTURT .BYTE $10,$38,$38,$10,$BA,$FE,$6C,$EE,$FE,$FE,$7C,$7C,$BA,$82 ; 0 VTHITE = *-VTURT ; HEIGHT OF TURTLE REP. .BYTE $06,$06,$6E,$36,$7C,$7C,$EE,$EE,$BE,$7F,$7D,$7D,$04,$0C ; 1 .BYTE $33,$13,$BF,$FE,$7E,$EE,$EE,$FF,$FD,$7D,$3C,$18,$08,$18 ; 2 .BYTE $30,$13,$3B,$BF,$FC,$7E,$EE,$EE,$FF,$7D,$7D,$38,$08,$18 ; 3 .BYTE $18,$08,$BB,$FF,$7D,$EE,$EE,$FE,$7C,$7D,$3B,$20,$60,$00 ; 4 .BYTE $30,$90,$FB,$7F,$FF,$EE,$EC,$7E,$7C,$32,$46,$C0,$00,$00 ; 5 .BYTE $08,$88,$B0,$78,$78,$EA,$EF,$FA,$78,$78,$B0,$88,$08,$00 ; 6 .BYTE $00,$00,$C0,$46,$32,$7C,$7E,$EC,$EE,$FF,$7F,$FB,$90,$30 ; 7 .BYTE $00,$60,$20,$3B,$7D,$7C,$EE,$EE,$FE,$7D,$FF,$BB,$08,$18 ; 8 .BYTE $18,$08,$38,$7D,$7D,$FF,$EE,$EE,$7E,$FC,$BF,$3B,$13,$30 ; 9 .BYTE $18,$08,$18,$3C,$7D,$FD,$EF,$EE,$FE,$7E,$FE,$BF,$13,$33 ; 10 .BYTE $0C,$04,$7D,$7D,$7F,$AE,$EE,$FE,$7C,$7C,$36,$6E,$06,$06 ; 11 .BYTE $82,$BA,$7C,$7C,$FE,$EE,$EE,$7C,$FE,$BA,$10,$38,$38,$10 ; 12 .BYTE $30,$20,$BE,$BE,$7E,$6D,$6F,$7F,$3E,$3E,$6C,$76,$60,$60 ; 13 .BYTE $18,$10,$18,$3C,$BE,$BF,$FF,$6F,$6F,$7E,$7F,$FD,$C8,$CC ; 14 .BYTE $18,$10,$1C,$BE,$BE,$FF,$6F,$6F,$7E,$3F,$FD,$DC,$C8,$0C ; 15 .BYTE $00,$06,$04,$DC,$BE,$3E,$77,$77,$7F,$BE,$FF,$DD,$10,$18 ; 16 .BYTE $00,$00,$03,$62,$4C,$3E,$7E,$37,$77,$FF,$FE,$DF,$09,$0C ; 17 .BYTE $10,$11,$0D,$1E,$1E,$5B,$FB,$5F,$1E,$1E,$0D,$11,$10,$00 ; 18 .BYTE $0C,$09,$DF,$FE,$FF,$77,$37,$7E,$3E,$4C,$62,$03,$00,$00 ; 19 .BYTE $18,$10,$DD,$FF,$BE,$77,$77,$7F,$3E,$BE,$DC,$04,$06,$00 ; 20 .BYTE $0C,$C8,$DC,$FD,$3F,$7E,$77,$77,$FF,$BE,$BE,$1C,$10,$18 ; 21 .BYTE $CC,$C8,$FD,$7F,$7E,$77,$77,$FF,$BF,$BE,$3C,$18,$10,$18 ; 22 .BYTE $60,$60,$76,$6C,$3E,$3E,$77,$77,$7D,$7E,$BE,$BE,$20,$30 ; 23 ; COLOR REGISTER ASSIGNMENTS ; PROC COLADR .WORD L233_CSET0 ; MODE 0 .WORD L233_CSET1 ; MODE 1 .WORD L233_CSET1 ; MODE 2 .WORD L233_CSET1 ; MODE 3 .WORD L233_CSET1 ; MODE 4 .WORD L233_CSET1 ; MODE 5 .WORD L233_CSET1 ; MODE 6 .WORD L233_CSET1 ; MODE 7 .WORD L233_CSET2 ; MODE 8 .WORD L233_CSET3 ; MODE 9 .WORD L233_CSET4 ; MODE 10 .WORD L233_CSET3 ; MODE 11 .WORD L233_CSET0 ; MODE 12 .WORD L233_CSET0 ; MODE 13 .WORD L233_CSET1 ; MODE 14 .WORD L233_CSET1 ; MODE 15 L233_CSET0 .BYTE 0,0,0,0 L233_CSET1 .BYTE 8,4,5,6,7 ; BAK, PF0, PF1, PF2 (,PF3 FOR MODES 1 & 2) L233_CSET2 .BYTE 6,5,0,0 ; PF2, PF 1 L233_CSET3 .BYTE 8,0,0,0 ; BAK L233_CSET4 .BYTE 0,1,2,3,4,5,6,7,8 ; EPROC PRGEND = *-1 ; END PILINI