ca65 V2.19 - Git e5f4ca6
Main file   : ONLIBASIC.ca65
Current file: ONLIBASIC.ca65

000000r 1               ;
000000r 1               ; Acorn BASIC ONLIBASIC Extension
000000r 1               ;
000000r 1               ; Chris Oddy April 2021
000000r 1               ;
000000r 1               	.setcpu		"6502"
000000r 1               	.listbytes	unlimited
000000r 1               ;
000000r 1               ; This source code can create either a System or Atom variant of ONLIBASIC
000000r 1               ;
000000r 1               	.define	ATOM 1		; set to 1 for the Atom variant
000000r 1               	.define SYSTEM 0	; set to 1 for the System variant
000000r 1               ;
000000r 1               ; Note the System variant is intended for use with the Teletext VDU only
000000r 1               ; if the 80x25 VDU is used then the graphics features will not work correctly.
000000r 1               ;
000000r 1               ; check valid options selected
000000r 1               	.if (ATOM=0 .and SYSTEM=0) .or (ATOM<>0 .and SYSTEM<>0)
000000r 1               	.error "Invalid variant options selected"
000000r 1               	.endif
000000r 1               ;
000000r 1               			;	****** Zero Page Workspace ******
000000r 1               ;
000000r 1               ; BASIC Workspace ($00 to $6F)
000000r 1               ;
000000r 1               index	:= $03		; index to text pointer (1-byte)
000000r 1               accptr	:= $04		; accumulator stack pointer (1-byte)
000000r 1               txtptr	:= $05		; text area pointer (2-bytes)
000000r 1               bitst	:= $0F		; bit state in CLR
000000r 1               acc1	:= $16		; 1st byte of accumulator stack (15-levels)
000000r 1               acc2	:= $25		; 2nd byte of accumulator stack (15-levels)
000000r 1               acc3	:= $34		; 3rd byte of accumulator stack (15-levels)
000000r 1               acc4	:= $43		; 4th byte of accumulator stack (15-levels)
000000r 1               bwork	:= $52		; BASIC workspace area
000000r 1               rpatern	:= $52		; REACT Function pattern to send (2-bytes)
000000r 1               rmask	:= $54		; REACT Function input response mask (2-bytes)
000000r 1               PADRLB	:= $56		; PORT Address LSB (1-byte)
000000r 1               PADRMB	:= pltcnt		; PORT Address MSB (1-byte)
000000r 1               patern1	:= $56		; REACT Function Pattern 1 (4-bytes)
000000r 1               time1	:= $5A		; REACT Function Time 1 (4-bytes)
000000r 1               time2	:= $5E		; REACT Function Time 2 (4-bytes)
000000r 1               react	:= $62		; REACT Function reaction time (result) (4-bytes)
000000r 1               time	:= $66		; Centisecond Clock (4-bytes)
000000r 1               rclock	:= $6A		; base address for 8 RCLK clocks (32-bytes)
000000r 1               ;	:= $6A-$6D	; clock 0 (4-bytes)
000000r 1               ;	:= $6E-$71	; clock 1 (4-bytes)
000000r 1               ;	:= $72-$75	; clock 2 (4-bytes)
000000r 1               ;	:= $76-$79	; clock 3 (4-bytes)
000000r 1               ;	:= $7A-$7D	; clock 4 (4-bytes)
000000r 1               ;	:= $7E-$81	; clock 5 (4-bytes)
000000r 1               ;	:= $82-$85	; clock 6 (4-bytes)
000000r 1               ;	:= $86-$89	; clock 7 (4-bytes)
000000r 1               irclk0	:= $8A		; IRQ RCLK clock zero mask (1-byte)
000000r 1               irqprt	:= $8B		; IRQ PORT 0 current state (only used in IRQ) (1-byte)
000000r 1               ;	:= $8C		; IRQ PORT 1 current state (1-byte)
000000r 1               ;	:= $8D		; not used (1-byte)
000000r 1               irqpre	:= $8E		; IRQ PORT 0 previous state (1-byte)
000000r 1               ;	:= $8F		; IRQ PORT 1 previous state (1-byte)
000000r 1               rclken	:= $90		; RCLK clock enabled flags (1-byte)
000000r 1               rqinen	:= $91		; RQIN PORT 0 active port lines (1=active) (1-byte)
000000r 1               ;	:= $92		; RQIN PORT 1 active port lines (1-byte)
000000r 1               irqsig	:= $93		; IRQ routine signalling to HANGUP
000000r 1               ;	:= $93		; RCLK clock zero flags  (1=clock has reached zero) (1-byte)
000000r 1               ;	:= $94		; RQIN PORT 0 port line triggered flags (1=triggered) (1-byte)
000000r 1               ;	:= $95		; RQIN PORT 1 port line triggered flags (1-byte)
000000r 1               rqpol	:= $96		; PORT 0 RQIN Polarities (0=low to high transition, 1=high to low transition) (2-bytes)
000000r 1               ;	:= $97		; PORT 1 RQIN Polarities (1-byte)
000000r 1               rclkmsk	:= $98		; IRQ RCLK clock pointer mask (1-byte)
000000r 1               iomask	:= $99		; PORT I/O Masks (0 for input, 1 for output) (4-bytes)
000000r 1               ;	:= $99		; PORT 0 I/O Mask
000000r 1               ;	:= $9A		; PORT 1 I/O Mask
000000r 1               ;	:= $9B		; PORT 2 I/O Mask
000000r 1               ;	:= $9C		; PORT 3 I/O Mask
000000r 1               ;
000000r 1               BUFFER	:= $0100	; Input Buffer (64-bytes)
000000r 1               ;
000000r 1               IRQVEC	:= $0204	; vector to IRQ service routine (2-bytes)
000000r 1               ;
000000r 1               RCGOL	:= $03C5	; RCLK GO line numbers for each of 8 clocks (LSB) (8-bytes)
000000r 1               RQGOL	:= $03CD	; RQIN GO line numbers for each of 16 lines of port 0 and 1 (LSB) (16-bytes)
000000r 1               RCGOH	:= $03DD	; RCLK GO line numbers for each of 8 clocks (MSB) (8-bytes)
000000r 1               RQGOH	:= $03E5	; RQIN GO line numbers for each of 16 lines of ports 0 and 1 (MSB) (16-bytes)
000000r 1               ;
000000r 1               			; Used by System Graphics
000000r 1               			; FROM position on screen for plot (4-bytes)
000000r 1               X1L	:= $52		; LSB of x
000000r 1               X1M	:= $53		; MSB of x
000000r 1               Y1L	:= $54		; LSB of y
000000r 1               Y1M	:= $55		; MSB of y
000000r 1               xdir	:= $56		; Plot direction (1-byte)
000000r 1               pltcnt	:= $57		; Plot counter
000000r 1               ;
000000r 1               			; TO position on screen for plot (4-bytes)
000000r 1               X2L	:= $5A		; LSB of x
000000r 1               X2M	:= $5B		; MSB of x
000000r 1               Y2L	:= $5C		; LSB of y
000000r 1               Y2M	:= $5D		; MSB of y
000000r 1               ;
000000r 1               MODE	:= $5E		; Plot <mode> 0-15 (1-byte)
000000r 1               yofset	:= $61		; y pixel offset within a character (1-byte)
000000r 1               ;
000000r 1               			; Current position on screen (4-bytes)
000000r 1               X0L	:= $03C1	; LSB of x
000000r 1               X0M	:= $03C2	; MSB of x
000000r 1               Y0L	:= $03C3	; LSB of y
000000r 1               Y0M	:= $03C4	; MSB of y
000000r 1               ;
000000r 1               			; Used by Atom Graphics
000000r 1               XL	:= $5A		; LSB of x position on screen (1-byte)
000000r 1               XM	:= $5B		; MSB of x position on screen (1-byte)
000000r 1               YL	:= $5C		; LSB of y position on screen (1-byte)
000000r 1               YM	:= $5D		; MSB of y position on screen (1-byte)
000000r 1               doplot	:= $5E		; Point Plot Routine function 1=set bit, 2=invert bit, else clear bit (1-byte)
000000r 1               pixadr	:= $5F		; address of pixel to plot (2-bytes)
000000r 1               ;
000000r 1               colour	:= $03FD	; Colour to Plot (1-byte)
000000r 1               plotl	:= $03FE	; BASIC Plot Routine address LSB (1-byte)
000000r 1               ploth	:= $03FF	; BASIC Plot Routine address MSB (1-byte)
000000r 1               ;
000000r 1               			; ****** Hardware Addresses ******
000000r 1               ;
000000r 1               			; *** 200.000 6502 CPU Board ***
000000r 1               			; 8154 Interface located at $0900 (IC8)
000000r 1               IC8	:= $0900	; Base Address
000000r 1               IC8A	:= $0920	; Port A Register (port lines 0 to 7)
000000r 1               IC8B	:= $0921	; Port B Register (port lines 8 to 15)
000000r 1               ;
000000r 1               			; 8154 Interface located at $0E20 (IC2)
000000r 1               IC2	:= $0E20
000000r 1               IC2B	:= $0E21	; 8154 Port B Data Register (keyboard)
000000r 1               ;
000000r 1               			; *** 100.015 Laboratory Interface ***
000000r 1               			; 8154 Interface located at $0900 (IC36 with default link settings)
000000r 1               IC36L	:= $0900	; Base Address
000000r 1               IC36LA	:= $0920	; Port A Register (port lines 0 to 7)
000000r 1               IC36LB	:= $0921	; Port B Register (port lines 8 to 15)
000000r 1               ;
000000r 1               			; 8154 interface located at $1000 (IC36 with alternative link settings)
000000r 1               IC36H	:= $1000	; Base Address
000000r 1               IC36HA	:= $1020	; Port A Register (port lines 16 to 23)
000000r 1               IC36HB	:= $1021	; Port B Register (port lines 24 to 31)
000000r 1               ;
000000r 1               			; *** 100.014 Analogue Interface Board ***
000000r 1               			; The DACs, a pair of National Semiconductors ADC1220, are interfaced via an 8255:
000000r 1               			; DAC 0	bits 0 to 3  via PC0 to PC3
000000r 1               			;	bits 4 to 11 via PA0 to PA7
000000r 1               			; DAC 1	bits 0 to 3  via PC1 to PC7
000000r 1               			;	bits 4 to 11 via PB0 to PB7
000000r 1               ;
000000r 1               DACPAR	:= $1A00	; Port A Register
000000r 1               DACPBR	:= $1A01	; Port B Register
000000r 1               DACPCR	:= $1A02	; Port C Register
000000r 1               DACCR	:= $1A03	; Control Register
000000r 1               ;
000000r 1               			; the 12-bit ADC, a National Semiconductors ADC1210, is interfaced via a 6522:
000000r 1               			;	bits 0 to 3 via PB0 to PB3
000000r 1               			;	bits 4 to 11 via PA0 to PA7
000000r 1               			;	the clock is provided by PB7
000000r 1               			;	CA2 provides Start Conversion, a high starts the conversion
000000r 1               			;	CA1 signals Conversion Complete when low
000000r 1               			;	PB4-6 select 1 of 8 analogue inputs
000000r 1               ;
000000r 1               ADCORB	:= $1A30	; Output Register for Port B
000000r 1               ADCORA	:= $1A31	; Output Register for Port A
000000r 1               ADCDDB	:= $1A32	; Data Direction Register for Port B
000000r 1               ADCT1L	:= $1A34	; Timer 1 LSB
000000r 1               ADCT1M	:= $1A35	; Timer 1 MSB
000000r 1               ADCACR	:= $1A3B	; Auxiliary Control Register
000000r 1               ADCPCR	:= $1A3C	; Peripheral Control Register
000000r 1               ADCIFR	:= $1A3D	; Interrupt Flag Register
000000r 1               ;
000000r 1               			; ****** Graphics ******
000000r 1               ;
000000r 1               			; *** System 40x25 (Teletext) VDU Video RAM ***
000000r 1               TELTXT	:= $0400	; Screen RAM base address
000000r 1               ;
000000r 1               			; *** Atom Video RAM ***
000000r 1               ;SCREEN	:= $8000	; Screen RAM base address
000000r 1               ;SCRENA	:= $8000	;
000000r 1               ;SCRENB	:= $8100	;
000000r 1               ;SCRMD1	:= $8200	; Graphics Mode 1
000000r 1               ;SCRMD2	:= $8400	; Graphics Mode 2
000000r 1               SCRMD3	:= $8600	; Graphics Mode 3
000000r 1               ;SCRMD4	:= $8C00	; Graphics Mode 4
000000r 1               ;
000000r 1               			; *** Atom 8255 PIA (IC25) ***
000000r 1               IC25A	:= $B000	; bits 0-3: keyboard row (output)
000000r 1               			; bits 4-7: graphics mode (output)
000000r 1               IC25B	:= $B001	; bits 0-5: keyboard column (input)
000000r 1               			; bit 6: CTRL key (input, active low)
000000r 1               			; bit 7: SHIFT keys (input, active low)
000000r 1               IC25C	:= $B002	; bit 0: cassette interface output
000000r 1               			; bit 1: 2.4kHz enable (output)
000000r 1               			; bit 2: loudspeaker output
000000r 1               			; bit 3: not used
000000r 1               			; bit 4: cassette interface 2.4kHz input
000000r 1               			; bit 5: cassette interface input
000000r 1               			; bit 6: REPT key (input, active low)
000000r 1               			; bit 7: 60 Hz sync (low during flyback)
000000r 1               IC25CL	:= $B003	; control register, normally $8A: mode 0
000000r 1               			; outputs: port A, port C lower; inputs: port B, port C upper
000000r 1               ;
000000r 1               			; ONLIBASIC PORTs
000000r 1               ;
000000r 1               PORT01	:= IC8	; or IC36L	; uses either IC8 on 6502 or IC36 on Lab Interface (same addresses)
000000r 1               PORT0	:= IC8A	; or IC36LA
000000r 1               PORT1	:= IC8B	; or IC36LB
000000r 1               PORT23	:= IC36H		; uses IC36 on Lab Interface with alternative link settings
000000r 1               PORT2	:= IC36HA
000000r 1               PORT3	:= IC36HB
000000r 1               ;
000000r 1               .if ATOM=1
000000r 1               	KEYBRD := IC25B	; Atom keyboard on IC25
000000r 1               .endif
000000r 1               ;
000000r 1               .if SYSTEM=1
000000r 1               	KEYBRD := IC2B	; System Keyboard on IC2
000000r 1               .endif
000000r 1               ;
000000r 1               			; ****** BASIC ROM Links ******
000000r 1               ;
000000r 1               PARCOM	:= $C231	; Parse Comma
000000r 1               NXTCOM	:= $C2CF	; BASIC Prompt
000000r 1               GETI_W	:= $C3C8	; Read Integer into Workspace
000000r 1               MOVA_W	:= $C3CB	; Move A to Workspace
000000r 1               MOVA_Y	:= $C3CD	; Move A to Y
000000r 1               EQUEXP	:= $C4DE	; Parse =
000000r 1               ENDTST	:= $C4E4	; Test for End of Statement
000000r 1               ENDCNT	:= $C558	; Test for end of present statement and continue execution of next statement
000000r 1               CONT_X	:= $C55B	; Continue execution at next statement
000000r 1               FNDLNS	:= $C62E	; Find BASIC line number (number in accumulator)
000000r 1               GETINT	:= $C8BC	; Get integer constant, variable or expression
000000r 1               BYTE_A	:= $C97C	; Move to accumulator and clear remainder
000000r 1               MOVY_A	:= $C99F	; Move 4-byte value at Y to Accumulator
000000r 1               err_29	:= $CA1B	; error 29 'Unknown or missing function'
000000r 1               RSTCON	:= $CBFF	; reset text pointer index, test for Escape
000000r 1               GODEST	:= $CC1F	; Find Destination Of GOTO or GOSUB
000000r 1               ;
000000r 1               			; OS Calls
000000r 1               ;
000000r 1               OSWRCH	:= $FFF4	; WRite CHaracter - sends the byte in A down the output channel
000000r 1               ;
000000r 1               			; ASCII Control Codes
000000r 1               ;
000000r 1               FRMFED	:= $0C		; Form Feed
000000r 1               CR	:= $0D		; Carriage Return
000000r 1               SPACE	:= $20		; SPACE
000000r 1               ESCAPE	:= $1B		; ESCAPE
000000r 1               ;
000000r 1               	.org	$D000
00D000  1               ;
00D000  1  AA 55        	.byte	$AA,$55
00D002  1               ;
00D002  1  82 D0        	.byte	<Entry2,>Entry2		; Command Entry Point
00D004  1  7E D0        	.byte	<Entry1,>Entry1		; Function Entry Point
00D006  1               ;
00D006  1               			; Statements and Functions Table
00D006  1  53 54 41 52  COMTAB:	.byte	"START",>START,<START
00D00A  1  54 D0 B4     
00D00D  1               ;
00D00D  1               .if SYSTEM=1
00D00D  1               	.byte	"PLOT",>PLOT,<PLOT
00D00D  1               	.byte	"DRAW",>DRAW,<DRAW
00D00D  1               	.byte	"MOVE",>MOVE,<MOVE
00D00D  1               	.byte	"CLEAR",>CLEAR,<CLEAR
00D00D  1               .endif
00D00D  1               ;
00D00D  1  43 4C 49 D0  	.byte	"CLI",>CLII,<CLII
00D011  1  E0           
00D012  1  53 45 49 D0  	.byte	"SEI",>SEII,<SEII
00D016  1  E4           
00D017  1  52 45 4C D1  	.byte	"REL",>REL,<REL
00D01B  1  A6           
00D01C  1  4B 49 4C 4C  	.byte	"KILL",>KILL,<KILL
00D020  1  D1 C6        
00D022  1  52 51 49 4E  	.byte	"RQIN",>RQIN,<RQIN
00D026  1  D3 21        
00D028  1  52 43 4C 4B  	.byte	"RCLK",>RCLK,<RCLK
00D02C  1  D3 83        
00D02E  1  48 41 4E 47  	.byte	"HANGUP",>HANGUP,<HANGUP
00D032  1  55 50 D3 DC  
00D036  1  53 45 54 D0  	.byte	"SET",>SET,<SET
00D03A  1  E8           
00D03B  1  43 4C 52 D0  	.byte	"CLR",>CLR,<CLR
00D03F  1  EC           
00D040  1  44 45 46 50  	.byte	"DEFPORT",>DEFPRT,<DEFPRT
00D044  1  4F 52 54 D1  
00D048  1  0E           
00D049  1  50 4F 52 54  	.byte	"PORT",>PORT,<PORT
00D04D  1  D1 D5        
00D04F  1  54 49 4D 45  	.byte	"TIME",>TIME,<TIME
00D053  1  D2 0E        
00D055  1  44 41 43 D4  	.byte	"DAC",>DAC,<DAC
00D059  1  68           
00D05A  1               ;
00D05A  1               .if ATOM=1
00D05A  1  43 4F 4C 4F  	.byte	"COLOUR",>COLOUR,<COLOUR
00D05E  1  55 52 D4 AF  
00D062  1               .endif
00D062  1               ;
00D062  1  C5 58        	.byte	>ENDCNT,<ENDCNT	; test for end of present statement and continue execution of next statement
00D064  1               ;
00D064  1               				; FUNCTIONS Table
00D064  1  41 44 43 D4  FNCTAB:	.byte	"ADC",>ADCF,<ADCF
00D068  1  28           
00D069  1  54 49 4D 45  	.byte	"TIME",>TIMEF,<TIMEF
00D06D  1  D2 05        
00D06F  1  50 4F 52 54  	.byte	"PORT",>PORTF,<PORTF
00D073  1  D1 FA        
00D075  1  52 45 41 43  	.byte	"REACT",>REACTF,<REACTF
00D079  1  54 D2 1C     
00D07C  1  CA 1B        	.byte	>err_29,<err_29	; error 29 'Unknown or missing function'
00D07E  1               ;
00D07E  1  A2 5D        Entry1:	ldx	#FNCTAB-COMTAB-1 ; pointer to start of FUNCTIONS table -1
00D080  1  D0 02        	bne	Parse		; branch always
00D082  1               ;
00D082  1  A2 FF        Entry2:	ldx	#$FF		; pointer to start of COMMANDS table -1
00D084  1  88           Parse:	dey			; backup text pointer
00D085  1  84 52        	sty	bwork		; and save it
00D087  1  A4 52        nxtcom:	ldy	bwork		; retrieve initial text pointer
00D089  1  C8           nxtchr:	iny			; increment to next character
00D08A  1  E8           	inx			; increment table pointer
00D08B  1  BD 06 D0     readtb:	lda	COMTAB,x	; read table entry
00D08E  1  30 16        	bmi	match		; is it an address ?
00D090  1  D1 05        	cmp	(txtptr),y	; no - compare with text character
00D092  1  F0 F5        	beq	nxtchr		; if equal continue comparing
00D094  1  CA           	dex			; not equal - backup table pointer
00D095  1  E8           fndadr:	inx			; increment table pointer
00D096  1  BD 06 D0     	lda	COMTAB,x	; get next table entry
00D099  1  10 FA        	bpl	fndadr		; until we get to an address
00D09B  1  E8           	inx			; increment table pointer
00D09C  1  B1 05        	lda	(txtptr),y	; get text entry
00D09E  1  C9 2E        	cmp	#'.'		; was it an abbreviated statement or command ?
00D0A0  1  D0 E5        	bne	nxtcom		; no - compare with next table entry
00D0A2  1  C8           	iny			; yes - increment text pointer
00D0A3  1  CA           	dex			; and backup table pointer
00D0A4  1  B0 E5        	bcs	readtb		; branch always
00D0A6  1  85 53        match:	sta	bwork+1		; save MSB of routine address
00D0A8  1  BD 07 D0     	lda	COMTAB+1,x
00D0AB  1  85 52        	sta	bwork		; and LSB
00D0AD  1  84 03        	sty	index		; update text index to next position
00D0AF  1  A6 04        	ldx	accptr
00D0B1  1  6C 52 00     	jmp	(bwork)		; and call Command/Function handler routine
00D0B4  1               ;
00D0B4  1               				; START Statement
00D0B4  1               				; takes no parameters
00D0B4  1               				; Clears the interrupt flag and starts the centisecond clock running from 0;
00D0B4  1               				; relinquishes all interrupts and abandons clocks, resetting them to 0.
00D0B4  1               START:
00D0B4  1               .if ATOM=1
00D0B4  1  A9 28        	lda	#<IRQ		; setup IRQ vector
00D0B6  1  EA           	nop
00D0B7  1  EA           	nop
00D0B8  1  EA           	nop
00D0B9  1  A9 D1        	lda	#>IRQ
00D0BB  1  EA           	nop
00D0BC  1  EA           	nop
00D0BD  1  EA           	nop
00D0BE  1               .endif
00D0BE  1               ;
00D0BE  1               .if SYSTEM=1
00D0BE  1               	lda	#<IRQ		; setup IRQ vector
00D0BE  1               	sta	IRQVEC
00D0BE  1               	lda	#>IRQ
00D0BE  1               	sta	IRQVEC+1
00D0BE  1               .endif
00D0BE  1               ;
00D0BE  1  A9 00        	lda	#$00		; reset all clocks etc. to 0 (addresses $66 to $95)
00D0C0  1  A2 2F        	ldx	#$2F
00D0C2  1  95 66        clrclk:	sta	time,x
00D0C4  1  CA           	dex
00D0C5  1  10 FB        	bpl	clrclk
00D0C7  1  A9 C0        	lda	#$C0		; enable counter 1 free running mode and output via PB7 (ADC clock)
00D0C9  1  8D 3B 1A     	sta	ADCACR		; ADC (6522) Auxiliary Control Register
00D0CC  1  A9 70        	lda	#$70		; port B pins 4 to 6 are outputs (analogue input select)
00D0CE  1  8D 32 1A     	sta	ADCDDB		; ADC (6522) Data Direction Register Port B
00D0D1  1  A9 80        	lda	#$80		; all ports are outputs
00D0D3  1  8D 03 1A     	sta	DACCR		; DAC (8255) Control Register
00D0D6  1  A9 02        	lda	#$02		; divide by 4 i.e. generate a 250kHz clock for the ADC
00D0D8  1  8D 34 1A     	sta	ADCT1L		; ADC (6522) Timer 1 LSB
00D0DB  1  A9 00        	lda	#$00
00D0DD  1  8D 35 1A     	sta	ADCT1M		; ADC (6522) Timer 1 MSB
00D0E0  1               				; then clear interrupts and return
00D0E0  1               ;
00D0E0  1               				; CLI Statement
00D0E0  1               				; takes no parameters
00D0E0  1               				; Clears the interrupt flag in the processor status register,
00D0E0  1               				; enabling the 100Hz IRQ clock.
00D0E0  1               ;
00D0E0  1  58           CLII:	cli			; clear interrupt flag (enabling interrupts)
00D0E1  1  4C 58 C5     	jmp	ENDCNT		; test for end of present statement and continue execution of next statement
00D0E4  1               ;
00D0E4  1               				; SEI Statement
00D0E4  1               				; takes no parameters
00D0E4  1               				; Sets the interrupt flag in the processor status register,
00D0E4  1               				; preventing the detection of interrupts or clocks timing out: freezes TIME.
00D0E4  1               ;
00D0E4  1  78           SEII:	sei			; set interrupt flag (disabling interrupts)
00D0E5  1  4C 58 C5     	jmp	ENDCNT		; test for end of present statement and continue execution of next statement
00D0E8  1               ;
00D0E8  1               				; SET Statement
00D0E8  1               				; syntax: SET <port_line>
00D0E8  1               				; Turns on I/O <port_line> (between 0 and 31), if the line is already on
00D0E8  1               				; or defined as an input, nothing happens.
00D0E8  1               ;
00D0E8  1  A9 10        SET:	lda	#$10		; bit set
00D0EA  1  D0 02        	bne	setclr		; branch always
00D0EC  1               ;
00D0EC  1               				; CLR Statement
00D0EC  1               				; syntax: CLR <port_line>
00D0EC  1               				; Turns off I/O <port_line> (between 0 and 31), if the line is already
00D0EC  1               				; off or is defined as an input nothing happens.
00D0EC  1               ;
00D0EC  1  A9 00        CLR:	lda	#$00		; bit clear
00D0EE  1  85 0F        setclr:	sta	bitst		; save bit state
00D0F0  1  20 C8 C3     	jsr	GETI_W		; get (integer) port line into workspace
00D0F3  1  20 E4 C4     	jsr	ENDTST		; test for End of Statement
00D0F6  1  A5 52        	lda	bwork		; load port line
00D0F8  1  29 0F        	and	#$0F		; mask off bottom 4 bits
00D0FA  1  05 0F        	ora	bitst		; OR in the bit state
00D0FC  1  AA           	tax			; use result as an index
00D0FD  1  A5 52        	lda	bwork		; load port line again
00D0FF  1  C9 10        	cmp	#$10		; is bit 4 set i.e. port lines 16 to 31 ?
00D101  1  B0 05        	bcs	port23		; yes - these refer to ports 2 and 3
00D103  1  9D 00 09     	sta	PORT01,x	; set/clear port line of port 0/1
00D106  1  90 03        	bcc	clrrtn		; always branch
00D108  1  9D 00 10     port23:	sta	PORT23,x	; set/clear port line of port 2/3
00D10B  1  4C 5B C5     clrrtn:	jmp	CONT_X		; continue execution at next statement
00D10E  1               ;
00D10E  1               				; DEFPORT Statement
00D10E  1               				; syntax: DEFPORT <port>=<i/o_mask>
00D10E  1               				; Defines the I/O direction of <port> (between 0 and 3), each line in the port
00D10E  1               				; is defined as an input if the corresponding bit in <i/o_mask> is clear,
00D10E  1               				; and as an output if it is set.
00D10E  1               ;
00D10E  1  20 BC C8     DEFPRT:	jsr	GETINT		; get port (integer constant, variable or expression)
00D111  1  20 DE C4     	jsr	EQUEXP		; parse '='
00D114  1  20 CB C3     	jsr	MOVA_W		; move result from accumulator stack to BASIC workspace
00D117  1  20 E8 D1     	jsr	prtadr		; get PORT address
00D11A  1  A0 02        	ldy	#$02		; offset from port address to port ODR
00D11C  1  A5 52        	lda	bwork		; get I/O mask (from function parameter 1st byte)
00D11E  1  91 56        	sta	(PADRLB),y	; and write to ODR
00D120  1  B4 16        	ldy	acc1,x		; get port number from accumulator stack
00D122  1  99 99 00     	sta	iomask,y	; save I/O mask
00D125  1  4C 5B C5     	jmp	CONT_X		; continue execution at next statement
00D128  1               ;
00D128  1               				; Interrupt Routine (occurs every 10mS)
00D128  1               ;
00D128  1  E6 66        IRQ:	inc	time		; increment 4-byte Centisecond Clock
00D12A  1  D0 0A        	bne	noinc
00D12C  1  E6 67        	inc	time+1
00D12E  1  D0 06        	bne	noinc
00D130  1  E6 68        	inc	time+2
00D132  1  D0 02        	bne	noinc
00D134  1  E6 69        	inc	time+3
00D136  1  8A           noinc:	txa			; save X
00D137  1  48           	pha			; on stack
00D138  1               ;
00D138  1  A9 00        	lda	#$00		; process RCLK
00D13A  1  85 8A        	sta	irclk0		; clear RCLK zero mask
00D13C  1  A9 80        	lda	#$80		; MSB set for RCLK clock 7
00D13E  1  85 98        	sta	rclkmsk		; RCLK clock pointer mask
00D140  1  A2 1C        	ldx	#$1C		; RCLK index pointer to clocks
00D142  1  B5 6A        dorclk:	lda	rclock,x	; is this RCLK clock active ?
00D144  1  15 6B        	ora	rclock+1,x
00D146  1  15 6C        	ora	rclock+2,x
00D148  1  15 6D        	ora	rclock+3,x
00D14A  1  F0 24        	beq	nrclk		; no - branch
00D14C  1  B5 6A        	lda	rclock,x	; decrement RCLK 4-byte clock
00D14E  1  D0 0E        	bne	deca
00D150  1  B5 6B        	lda	rclock+1,x
00D152  1  D0 08        	bne	decb
00D154  1  B5 6C        	lda	rclock+2,x
00D156  1  D0 02        	bne	decc
00D158  1  D6 6D        	dec	rclock+3,x
00D15A  1  D6 6C        decc:	dec	rclock+2,x
00D15C  1  D6 6B        decb:	dec	rclock+1,x
00D15E  1  D6 6A        deca:	dec	rclock,x
00D160  1  B5 6A        	lda	rclock,x	; has the clock reached zero ?
00D162  1  15 6B        	ora	rclock+1,x
00D164  1  15 6C        	ora	rclock+2,x
00D166  1  15 6D        	ora	rclock+3,x
00D168  1  D0 06        	bne	nrclk		; no - branch
00D16A  1  A5 8A        	lda	irclk0		; yes
00D16C  1  05 98        	ora	rclkmsk		; set RCLK clock zero mask bit
00D16E  1  85 8A        	sta	irclk0
00D170  1  46 98        nrclk:	lsr	rclkmsk		; shift to RCLK mask to next bit (7 to 0)
00D172  1  CA           	dex			; decrement index by 4
00D173  1  CA           	dex
00D174  1  CA           	dex
00D175  1  CA           	dex
00D176  1  10 CA        	bpl	dorclk		; and repeat process for all 8 RCLK counters
00D178  1  A5 8A        	lda	irclk0		; retrieve RCLK clock zero mask
00D17A  1  25 90        	and	rclken		; AND with RCLK enabled flags
00D17C  1  05 93        	ora	irqsig		; and save result - clock has reached zero
00D17E  1  85 93        	sta	irqsig		; signalling HANGUP
00D180  1               ;
00D180  1  A2 01        	ldx	#$01		; index pointer to PORT
00D182  1  B5 99        scan:	lda	iomask,x	; port I/O mask
00D184  1  49 FF        	eor	#$FF
00D186  1  3D 20 09     	and	PORT0,x		; read port 0/1
00D189  1  48           	pha			; save port state on stack
00D18A  1  95 8B        	sta	irqprt,x	; save port
00D18C  1  55 8E        	eor	irqpre,x	; compare with last save port
00D18E  1  95 8E        	sta	irqpre,x	; save result
00D190  1  B5 96        	lda	rqpol,x		; RQIN polarities (0=low to high transition, 1=high to low transition)
00D192  1  55 8B        	eor	irqprt,x	; EOR with current port state
00D194  1  35 8E        	and	irqpre,x	; AND with previous port state
00D196  1  35 91        	and	rqinen,x	; to get changed inputs
00D198  1  15 94        	ora	irqsig+1,x	; set RQIN triggered
00D19A  1  95 94        	sta	irqsig+1,x	; and signal HANGUP
00D19C  1  68           	pla			; retrieve port state from stack
00D19D  1  95 8E        	sta	irqpre,x	; save port state for next time
00D19F  1  CA           	dex			; decrement index pointer
00D1A0  1  10 E0        	bpl	scan		; and repeat for port 1
00D1A2  1  68           	pla			; retrieve X
00D1A3  1  AA           	tax
00D1A4  1  68           	pla			; A
00D1A5  1  40           	rti			; and return from interrupt
00D1A6  1               ;
00D1A6  1               				; REL Statement
00D1A6  1               				; syntax: REL <event>
00D1A6  1               				; Relinquishes control of interrupts and kills clocks.
00D1A6  1               				; A value between 0 and 15 causes the appropriate input Port Line to be ignored,
00D1A6  1               				; a value between 16 and 23 abandons a Clock number <event>-16
00D1A6  1               				; (i.e. the corresponding Clock in the range 0 to 7),
00D1A6  1               ;
00D1A6  1  20 BC C8     REL:	jsr	GETINT		; get parameter (integer constant, variable or expression)
00D1A9  1  20 E4 C4     	jsr	ENDTST		; test for End of Statement
00D1AC  1  20 FB D2     	jsr	Split		; split parameter
00D1AF  1  49 FF        	eor	#$FF		; invert bit mask
00D1B1  1  A8           	tay			; and transfer to Y
00D1B2  1  08           	php			; save status on stack
00D1B3  1  78           	sei			; set interrupt flag (disabling interrupts)
00D1B4  1  BD F8 D2     	lda	Convrt,x	; convert 0 to 1 and 1 to 2
00D1B7  1  AA           	tax			; and transfer to X
00D1B8  1  98           	tya			; transfer Y, inverted bit mask, back to A
00D1B9  1  35 90        	and	rclken,x	; use bit mask to clear RCLK enabled bit
00D1BB  1  95 90        	sta	rclken,x	; and update
00D1BD  1  98           	tya			; transfer Y, inverted bit mask, back to A
00D1BE  1  35 93        	and	irqsig,x	; use bit mask to clear IRQ signalling bit
00D1C0  1  95 93        	sta	irqsig,x	; and update
00D1C2  1  28           	plp			; retrieve status
00D1C3  1  4C 5B C5     	jmp	CONT_X		; continue execution at next statement
00D1C6  1               ;
00D1C6  1               				; KILL Statement
00D1C6  1               				; takes no parameters
00D1C6  1               				; Cancels all requests for interrupts and clocks.
00D1C6  1               ;
00D1C6  1  08           KILL:	php			; save status on stack
00D1C7  1  78           	sei			; set interrupt flag (disabling interrupts)
00D1C8  1  A2 05        	ldx	#$05
00D1CA  1  A9 00        	lda	#$00
00D1CC  1  95 90        dokill:	sta	rclken,x	; clear all 6 RCLK and RQIN flag registers
00D1CE  1  CA           	dex
00D1CF  1  10 FB        	bpl	dokill
00D1D1  1  28           	plp			; retrieve status
00D1D2  1  4C 58 C5     	jmp	ENDCNT		; test for end of present statement and continue execution of next statement
00D1D5  1               ;
00D1D5  1               				; PORT Statement
00D1D5  1               				; syntax: PORT <port>=<on/off_mask>
00D1D5  1               				; Each line defined as an output in <port> (between 0 and 3) is turned on
00D1D5  1               				; if the corresponding bit in the lowest byte of <on/off_mask> is set,
00D1D5  1               				; and turned off if it is clear, lines defined as inputs are unaffected.
00D1D5  1               ;
00D1D5  1  20 BC C8     PORT:	jsr	GETINT		; get port number (integer constant, variable or expression)
00D1D8  1  20 DE C4     	jsr	EQUEXP		; parse =
00D1DB  1  20 CB C3     	jsr	MOVA_W		; move A (port) to workspace
00D1DE  1  20 E8 D1     	jsr	prtadr		; convert port number to port address
00D1E1  1  A5 52        	lda	bwork		; retrieve on/off mask
00D1E3  1  91 56        	sta	(PADRLB),y	; and write to port
00D1E5  1  4C 5B C5     	jmp	CONT_X		; continue execution at next statement
00D1E8  1               ;
00D1E8  1               				; Convert a Port Number to an 8154 Address
00D1E8  1               				; 	port number 0 returns $0920 (IC8)
00D1E8  1               				; 	port number 1 returns $0921 (IC8)
00D1E8  1               				; 	port number 2 returns $1020
00D1E8  1               				; 	port number 3 returns $1021
00D1E8  1  CA           prtadr:	dex			; decrement accumulator stack pointer
00D1E9  1  86 04        	stx	accptr		; and save
00D1EB  1  B4 16        	ldy	acc1,x		; get accumulator (port)
00D1ED  1  B9 20 D4     	lda	prtlsb,y	; lookup port address LSB
00D1F0  1  85 56        	sta	PADRLB		; and save
00D1F2  1  B9 24 D4     	lda	prtmsb,y	; and MSB
00D1F5  1  85 57        	sta	PADRMB		; and save
00D1F7  1  A0 00        	ldy	#$00		; Y=0
00D1F9  1  60           	rts			; and return
00D1FA  1               ;
00D1FA  1               				; PORT Function
00D1FA  1               				; syntax: <result> = PORT <port>
00D1FA  1               				; Each bit in the return value reflects the state of the bits at the specified port.
00D1FA  1               ;
00D1FA  1  20 BC C8     PORTF:	jsr	GETINT		; get port parameter (integer constant, variable or expression)
00D1FD  1  20 E8 D1     	jsr	prtadr		; convert to an 8154 address
00D200  1  B1 56        	lda	(PADRLB),y
00D202  1  4C 7C C9     	jmp	BYTE_A		; move to accumulator and clear remainder
00D205  1               ;
00D205  1               				; TIME Function
00D205  1               				; syntax <result> = TIME
00D205  1               				; takes no parameters
00D205  1               				; returns the current value of the Centisecond Clock
00D205  1               ;
00D205  1  A0 66        TIMEF:	ldy	#time		; point Y at Centisecond Clock
00D207  1  08           	php			; save status on stack
00D208  1  78           	sei			; set interrupt flag (disabling interrupts)
00D209  1  20 9F C9     	jsr	MOVY_A		; move 4-byte value at Y to Accumulator
00D20C  1  28           	plp			; retrieve status
00D20D  1  60           	rts			; and return
00D20E  1               ;
00D20E  1               				; TIME Statement
00D20E  1               				; syntax TIME<time>
00D20E  1               				; The Centisecond clock is set to the value of <time>.
00D20E  1               ;
00D20E  1  20 DE C4     TIME:	jsr	EQUEXP		; Parse '='
00D211  1  A0 66        	ldy	#time		; point Y at Centisecond Clock
00D213  1  08           	php			; save status on stack
00D214  1  78           	sei			; set interrupt flag (disabling interrupts)
00D215  1  20 CD C3     	jsr	MOVA_Y		; move A to Y
00D218  1  28           	plp			; retrieve status
00D219  1  4C 5B C5     	jmp	CONT_X		; and continue execution at next statement
00D21C  1               ;
00D21C  1               				; REACT Function
00D21C  1               				; syntax: <result> = REACT<pattern_2>,<pattern_1>,<time_2>,<time_1>
00D21C  1               				; <pattern_1> is output for <time_1> then <pattern_2> is output for <time_2>.
00D21C  1               				; If an input, defined by <pattern_1> becomes active then the elapsed time is returned
00D21C  1               ;
00D21C  1  20 BC C8     REACTF:	jsr	GETINT		; get parameter (integer constant, variable or expression)
00D21F  1  20 31 C2     	jsr	PARCOM		; parse comma
00D222  1  20 BC C8     	jsr	GETINT		; get parameter (integer constant, variable or expression)
00D225  1  20 31 C2     	jsr	PARCOM		; parse comma
00D228  1  20 BC C8     	jsr	GETINT		; get parameter (integer constant, variable or expression)
00D22B  1  20 31 C2     	jsr	PARCOM		; parse comma
00D22E  1  20 BC C8     	jsr	GETINT		; get parameter (integer constant, variable or expression)
00D231  1  A0 5A        	ldy	#time1
00D233  1  20 CD C3     	jsr	MOVA_Y		; move A to Y (4th parameter) time 1
00D236  1  A0 5E        	ldy	#time2
00D238  1  20 CD C3     	jsr	MOVA_Y		; move A to Y (3rd parameter) time 2
00D23B  1  A0 56        	ldy	#patern1
00D23D  1  20 CD C3     	jsr	MOVA_Y		; move A to Y (2nd parameter) pattern 1
00D240  1  A9 00        	lda	#$00		; initialise return result
00D242  1  85 62        	sta	react
00D244  1  85 63        	sta	react+1
00D246  1  85 64        	sta	react+2
00D248  1  85 65        	sta	react+3
00D24A  1  A2 01        	ldx	#$01		; port index pointer
00D24C  1  B5 99        IOMASK:	lda	iomask,x	; port I/O mask (bit=1 for output)
00D24E  1  49 FF        	eor	#$FF		; invert it (bit=1 for output)
00D250  1  35 56        	and	patern1,x	; AND with pattern 2
00D252  1  95 54        	sta	rmask,x		; this is the input response mask
00D254  1  CA           	dex
00D255  1  10 F5        	bpl	IOMASK		; repeat for port 0
00D257  1  20 E2 D2     	jsr	WRPTRN		; write pattern 1 to ports
00D25A  1  A6 04        	ldx	accptr		; retrieve BASIC accumulator stack pointer
00D25C  1  A0 56        	ldy	#patern1	; reset pointer to pattern 1
00D25E  1  20 CD C3     	jsr	MOVA_Y		; move A to Y (copy pattern 2 to pattern 1)
00D261  1  08           	php
00D262  1  78           	sei			; set interrupt flag (disabling interrupts)
00D263  1  A2 09        RWAIT:	ldx	#$09		; delay
00D265  1  CA           RDELAY:	dex
00D266  1  D0 FD        	bne	RDELAY
00D268  1  EA           	nop
00D269  1  EA           	nop
00D26A  1  AD 01 B0     	lda	KEYBRD		; check keyboard
00D26D  1               ;
00D26D  1               .if ATOM=1
00D26D  1  29 20        	and	#SPACE		; for space pressed ?
00D26F  1               .endif
00D26F  1               ;
00D26F  1               .if SYSTEM=1
00D26F  1               	cmp	#ESCAPE		; for escape pressed ?
00D26F  1               .endif
00D26F  1               ;
00D26F  1  F0 6B        	beq	REXIT		; yes - exit
00D271  1  18           	clc			; 32 bit subtraction to decrement time 1 (pattern 1 time)
00D272  1  A5 5A        	lda	time1		; subtract 1 from 1st byte
00D274  1  E9 00        	sbc	#$00
00D276  1  85 5A        	sta	time1
00D278  1  A5 5B        	lda	time1+1		; subtract 1 from 2nd byte
00D27A  1  E9 00        	sbc	#$00
00D27C  1  85 5B        	sta	time1+1
00D27E  1  A5 5C        	lda	time1+2		; subtract 1 from 3rd byte
00D280  1  E9 00        	sbc	#$00
00D282  1  85 5C        	sta	time1+2
00D284  1  A5 5D        	lda	time1+3		; subtract 1 from 4th byte
00D286  1  E9 00        	sbc	#$00
00D288  1  85 5D        	sta	time1+3
00D28A  1  05 5A        	ora	time1		; has time 1 expired ?
00D28C  1  05 5B        	ora	time1+1
00D28E  1  05 5C        	ora	time1+2
00D290  1  D0 03        	bne	TIME1		; no - branch
00D292  1  20 E2 D2     	jsr	WRPTRN		; yes - write pattern 2 to ports
00D295  1  A5 54        TIME1:	lda	rmask		; look for response pattern
00D297  1  2D 20 09     	and	PORT0		; read port 0
00D29A  1  D0 40        	bne	REXIT		; match ? - finish
00D29C  1  A5 55        	lda	rmask+1
00D29E  1  2D 21 09     	and	PORT1		; read port 1
00D2A1  1  D0 39        	bne	REXIT		; match ? - finish
00D2A3  1  38           	sec			; 32 bit addition to increment result (reaction time)
00D2A4  1  A5 62        	lda	react		; add 1 to 1st byte
00D2A6  1  69 00        	adc	#$00
00D2A8  1  85 62        	sta	react
00D2AA  1  A5 63        	lda	react+1		; add 1 to 2nd byte
00D2AC  1  69 00        	adc	#$00
00D2AE  1  85 63        	sta	react+1
00D2B0  1  A5 64        	lda	react+2		; add 1 to 3rd byte
00D2B2  1  69 00        	adc	#$00
00D2B4  1  85 64        	sta	react+2
00D2B6  1  A5 65        	lda	react+3		; add 1 to 4th byte
00D2B8  1  69 00        	adc	#$00
00D2BA  1  85 65        	sta	react+3
00D2BC  1               				; 32 bit subtraction to decrement time 2
00D2BC  1  A5 5E        	lda	time2		; subtract 1 from 1st byte
00D2BE  1  E9 00        	sbc	#$00
00D2C0  1  85 5E        	sta	time2
00D2C2  1  A5 5F        	lda	time2+1		; subtract 1 from 2nd byte
00D2C4  1  E9 00        	sbc	#$00
00D2C6  1  85 5F        	sta	time2+1
00D2C8  1  A5 60        	lda	time2+2		; subtract 1 from 3rd byte
00D2CA  1  E9 00        	sbc	#$00
00D2CC  1  85 60        	sta	time2+2
00D2CE  1  A5 61        	lda	time2+3		; subtract 1 from 4th byte
00D2D0  1  E9 00        	sbc	#$00
00D2D2  1  85 61        	sta	time2+3
00D2D4  1  05 60        	ora	time2+2		; has time 2 expired ?
00D2D6  1  05 5F        	ora	time2+1
00D2D8  1  05 5E        	ora	time2
00D2DA  1  D0 87        	bne	RWAIT		; no - continue
00D2DC  1  28           REXIT:	plp
00D2DD  1  A0 62        	ldy	#react		; pointer to result (reaction time)
00D2DF  1  4C 9F C9     	jmp	MOVY_A		; move 4-byte value at Y to accumulator stack and return
00D2E2  1               ;
00D2E2  1               				; Write 32-bit Pattern to Ports
00D2E2  1  A2 03        WRPTRN:	ldx	#$03		; port index pointer
00D2E4  1  A0 00        	ldy	#$00
00D2E6  1  BD 20 D4     do4prt:	lda	prtlsb,x	; LSB of address of port x
00D2E9  1  85 52        	sta	rpatern		; save
00D2EB  1  BD 24 D4     	lda	prtmsb,x	; MSB of address of port x
00D2EE  1  85 53        	sta	rpatern+1	; save
00D2F0  1  B5 56        	lda	patern1,x	; get pattern to send to port
00D2F2  1  91 52        	sta	(rpatern),y	; write to port
00D2F4  1  CA           	dex			; decrement pointer
00D2F5  1  10 EF        	bpl	do4prt		; do all 4 ports
00D2F7  1  60           	rts			; and return
00D2F8  1               ;
00D2F8  1               				; Convert Table (used by REL)
00D2F8  1  01 02        Convrt:	.byte	$01,$02
00D2FA  1               ;
00D2FA  1  00           RELBRK:	brk
00D2FB  1               ;				; Split REL/RQIN Statements Parameter
00D2FB  1  20 CB C3     Split:	jsr	MOVA_W		; move parameter to BASIC workspace ($52 to $55)
00D2FE  1  A5 55        	lda	bwork+3		; check MS 3-bytes are zero
00D300  1  05 54        	ora	bwork+2
00D302  1  05 53        	ora	bwork+1
00D304  1  D0 F4        	bne	RELBRK		; no - Error 13 - Invalid parameter
00D306  1  A5 52        	lda	bwork		; get LS byte
00D308  1  C9 18        	cmp	#$18		; check value less than 24
00D30A  1  B0 EE        	bcs	RELBRK		; no - Error 13 - Invalid parameter
00D30C  1  4A           	lsr	a		; shift right 3 bits
00D30D  1  4A           	lsr	a
00D30E  1  4A           	lsr	a		; retaining bits 4 and 5 (Port)
00D30F  1  AA           	tax			; transfer to X
00D310  1  A5 52        	lda	bwork		; get parameter again
00D312  1  29 07        	and	#$07		; retain LS bits 1 to 3
00D314  1  A8           	tay			; transfer to Y
00D315  1  B9 19 D3     	lda	BITMSK,y	; convert value to a bit mask
00D318  1  60           	rts			; and return
00D319  1               ;
00D319  1               				; Table 1 - Table of bit masks for bit positions 1 to 8
00D319  1  01 02 04 08  BITMSK:	.byte	$01,$02,$04,$08,$10,$20,$40,$80
00D31D  1  10 20 40 80  
00D321  1               ;
00D321  1               				; RQIN Statement
00D321  1               				; syntax: RQIN <polarity><port_line><line_number>
00D321  1               				; If the least significant bit of <polarity> is set, a transition from
00D321  1               				; low to high will cause a jump to <line_number>.
00D321  1               				; Conversely if the <polarity> bit is clear, a transition from high to low will cause a jump.
00D321  1               				; If <port_line> is defined as an output, nothing happens.
00D321  1               				; Is only used with port lines 0 to 15 i.e. Ports 0 and 1.
00D321  1               ;
00D321  1  20 BC C8     RQIN:	jsr	GETINT		; get parameter (integer constant, variable or expression)
00D324  1  20 31 C2     	jsr	PARCOM		; parse comma
00D327  1  20 BC C8     	jsr	GETINT		; get parameter (integer constant, variable or expression)
00D32A  1  20 31 C2     	jsr	PARCOM		; parse comma
00D32D  1  20 1F CC     	jsr	GODEST		; find destination of GOTO or GOSUB
00D330  1  20 E4 C4     	jsr	ENDTST		; test for End of Statement
00D333  1  A5 57        	lda	bwork+5		; what is the status of <line_number>
00D335  1  D0 05        	bne	label1		; if zero its a line number, else a label
00D337  1  20 2E C6     	jsr	FNDLNS		; find line number (line number is in accumulator)
00D33A  1  B0 6F        	bcs	err243		; Error - Invalid line number
00D33C  1  A6 04        label1:	ldx	accptr
00D33E  1  20 FB D2     	jsr	Split		; split parameter (A=bit mask, X=port number)
00D341  1  85 57        	sta	bwork+5		; save port bit mask
00D343  1  A5 52        	lda	bwork		; retrieve the port line number
00D345  1  C9 10        	cmp	#$10		; must be 0 to 15
00D347  1  B0 B1        	bcs	RELBRK		; Error 13 - Invalid parameter
00D349  1  A5 57        	lda	bwork+5		; retrieve port bit mask
00D34B  1  08           	php			; save status on stack
00D34C  1  78           	sei			; set interrupt flag (disable interrupts)
00D34D  1  15 91        	ora	rqinen,x	; OR port line bit mask (1=active port line)
00D34F  1  95 91        	sta	rqinen,x	; update RQIN active port lines
00D351  1  A5 57        	lda	bwork+5		; retrieve port bit mask
00D353  1  49 FF        	eor	#$FF		; invert(bit=1 for inactive port line)
00D355  1  35 94        	and	irqsig+1,x	; AND port line bit mask
00D357  1  95 94        	sta	irqsig+1,x	; clearing IRQ signalling bit
00D359  1  86 56        	stx	bwork+4		; save port number
00D35B  1  A6 52        	ldx	bwork		; retrieve port line number
00D35D  1  A5 58        	lda	bwork+6		; get LSB of address of <line_number>
00D35F  1  9D CD 03     	sta	RQGOL,x		; and save
00D362  1  A5 59        	lda	bwork+7		; get MSB of address of <line_number>
00D364  1  9D E5 03     	sta	RQGOH,x		; and save
00D367  1  A6 04        	ldx	accptr
00D369  1  20 CB C3     	jsr	MOVA_W		; get 1st parameter <polarity>
00D36C  1  A6 56        	ldx	bwork+4		; retrieve port number
00D36E  1  A5 57        	lda	bwork+5		; retrieve port bit mask
00D370  1  46 52        	lsr	bwork		; shift polarity bit into C
00D372  1  B0 04        	bcs	polhi		; if polarity=1 branch
00D374  1  15 96        	ora	rqpol,x		; polarity=0 - OR port bit mask to set bit
00D376  1  90 04        	bcc	pollo		; always branch
00D378  1  49 FF        polhi:	eor	#$FF		; invert port bit mask
00D37A  1  35 96        	and	rqpol,x		; AND with polarity bit to clear bit
00D37C  1  95 96        pollo:	sta	rqpol,x		; save polarity
00D37E  1  28           	plp			; retrieve status
00D37F  1  4C 5B C5     	jmp	CONT_X		; and continue execution at next statement
00D382  1               ;
00D382  1  00           RCLBRK:	brk
00D383  1               ;
00D383  1               				; RCLK Statement
00D383  1               				; syntax: RCLK <clock><timeout><line_number>
00D383  1               				; <clock> (between 0 and 7) is set running and will cause a jump to <line_number>
00D383  1               				; after <timeout> centiseconds.
00D383  1               ;
00D383  1  20 BC C8     RCLK:	jsr	GETINT		; get parameter (integer constant, variable or expression)
00D386  1  20 31 C2     	jsr	PARCOM		; parse comma
00D389  1  20 BC C8     	jsr	GETINT		; get parameter (integer constant, variable or expression)
00D38C  1  A5 43        	lda	acc4		; (byte 4 of 1st accumulator stack location)
00D38E  1  05 25        	ora	acc2		; (byte 3 of 1st accumulator stack location)
00D390  1  05 34        	ora	acc3		; (byte 2 of 1st accumulator stack location)
00D392  1  D0 EE        	bne	RCLBRK		; they should all be zero - if not Error 149 - Invalid parameter
00D394  1  A5 16        	lda	acc1		; get <clock> (byte 1 of 1st accumulator stack location)
00D396  1  C9 08        	cmp	#$08		; is it 8 or greater ?
00D398  1  B0 E8        	bcs	RCLBRK		; yes - Error 149 - Invalid parameter
00D39A  1  48           	pha			; save <clock> on stack
00D39B  1  20 31 C2     	jsr	PARCOM		; parse comma
00D39E  1  20 1F CC     	jsr	GODEST		; find destination of GOTO or GOSUB
00D3A1  1  20 E4 C4     	jsr	ENDTST		; test for End of Statement
00D3A4  1  A5 57        	lda	bwork+5		; what is the status of <line_number
00D3A6  1  D0 05        	bne	label2		; if zero its a line number, else a label
00D3A8  1  20 2E C6     	jsr	FNDLNS		; find BASIC line number (line number in accumulator)
00D3AB  1  B0 33        err243:	bcs	again+1		; Error 243 - Invalid line number
00D3AD  1  68           label2:	pla			; retrieve <clock> from stack
00D3AE  1  AA           	tax			; and transfer to X
00D3AF  1  BD 19 D3     	lda	BITMSK,x	; convert <clock> to a bit position
00D3B2  1  08           	php			; save status on stack
00D3B3  1  48           	pha			; save clock number bit position on stack
00D3B4  1  78           	sei			; set interrupt flag (disabling interrupts)
00D3B5  1  05 90        	ora	rclken		; enable clock <clock>
00D3B7  1  85 90        	sta	rclken		; and update
00D3B9  1  68           	pla			; retrieve clock number bit position from stack
00D3BA  1  49 FF        	eor	#$FF		; invert the bit
00D3BC  1  25 93        	and	irqsig		; clear clock zero bit
00D3BE  1  85 93        	sta	irqsig		; and update
00D3C0  1               
00D3C0  1  A5 58        	lda	bwork+6		; get LSB of address of <line_number>
00D3C2  1  9D C5 03     	sta	RCGOL,x		; and save
00D3C5  1  A5 59        	lda	bwork+7		; get MSB of address of <line_number>
00D3C7  1  9D DD 03     	sta	RCGOH,x		; and save
00D3CA  1               
00D3CA  1  8A           	txa
00D3CB  1  0A           	asl	a
00D3CC  1  0A           	asl	a
00D3CD  1  69 6A        	adc	#$6A
00D3CF  1  A8           	tay
00D3D0  1  A6 04        	ldx	accptr		; retrieve accumulator stack pointer
00D3D2  1  20 CD C3     	jsr	MOVA_Y		; move A to Y
00D3D5  1  28           	plp			; retrieve status
00D3D6  1  CA           	dex
00D3D7  1  86 04        	stx	accptr
00D3D9  1  4C 5B C5     	jmp	CONT_X		; continue execution at next statement
00D3DC  1               ;
00D3DC  1               				; HANGUP Statement
00D3DC  1               				; takes no parameter
00D3DC  1               				; Stops the interpreter and waits until an interrupt occurs or a clock times out.
00D3DC  1               ;
00D3DC  1  20 E4 C4     HANGUP:	jsr	ENDTST		; test for End of Statement
00D3DF  1  A2 00        again:	ldx	#$00		; clear port counter
00D3E1  1  AD 01 B0     	lda	KEYBRD		; check keyboard
00D3E4  1               ;
00D3E4  1               .if ATOM=1
00D3E4  1  29 20        	and	#SPACE		; for space
00D3E6  1               .endif
00D3E6  1               ;
00D3E6  1               .if SYSTEM=1
00D3E6  1               	cmp	#ESCAPE		; for escape
00D3E6  1               .endif
00D3E6  1               ;
00D3E6  1  D0 03        	bne	prtsx4
00D3E8  1  4C CF C2     	jmp	NXTCOM		; if pressed jump to BASIC prompt
00D3EB  1  A0 00        prtsx4:	ldy	#$00		; clear bit counter
00D3ED  1  B5 93        	lda	irqsig,x	; get IRQ signalling flags for (1=RCLK clock has reached zero or RQIN trigger)
00D3EF  1  4A           doport:	lsr	a		; shift into carry and test each bit in turn
00D3F0  1  B0 0C        	bcs	set		; if set either RCLK counter has reached zero or RQIN input has triggered - branch
00D3F2  1  C8           	iny			; increment bit counter
00D3F3  1  C0 08        	cpy	#$08		; have we tested eight bits yet ?
00D3F5  1  90 F8        	bcc	doport		; no - go around again
00D3F7  1  E8           	inx			; yes - increment port counter
00D3F8  1  E0 03        	cpx	#$03		; have we tested RCLK and both RQIN ports ?
00D3FA  1  90 EF        	bcc	prtsx4		; no - go around again
00D3FC  1  B0 E1        	bcs	again		; yes - start again from RCLK
00D3FE  1  B9 19 D3     set:	lda	BITMSK,y	; convert bit count to a bit position
00D401  1  49 FF        	eor	#$FF		; and invert
00D403  1  78           	sei			; set interrupt flag (disabling interrupts)
00D404  1  35 93        	and	irqsig,x	; clear IRQ signalling flag bit
00D406  1  95 93        	sta	irqsig,x
00D408  1  58           	cli			; clear interrupt flag (enabling interrupts)
00D409  1  18           	clc
00D40A  1  98           	tya			; copy bit number in Y to A
00D40B  1  CA           nxtprt:	dex			; decrement port number
00D40C  1  30 04        	bmi	rclkgo
00D40E  1  69 08        	adc	#$08		; add 8 to bit number to eventually get a port line
00D410  1  90 F9        	bcc	nxtprt
00D412  1  A8           rclkgo:	tay			; use port line in Y to index RCLK GO line number
00D413  1  B9 C5 03     	lda	RCGOL,y		; get RCLK line number LSB
00D416  1  85 05        	sta	txtptr		; update BASIC text pointer LSB
00D418  1  B9 DD 03     	lda	RCGOH,y		; get RCLK line number MSB
00D41B  1  85 06        	sta	txtptr+1	; update BASIC text pointer MSB
00D41D  1  4C FF CB     	jmp	RSTCON		; reset text pointer index
00D420  1               ;
00D420  1               				; Table of LSB I/O Port Address's
00D420  1  20 21 20 21  prtlsb:	.byte	<PORT0,<PORT1,<PORT2,<PORT3
00D424  1               ;
00D424  1               				; Table of MSB I/O Port Address's
00D424  1  09 09 10 10  prtmsb:	.byte	>PORT0,>PORT1,>PORT2,>PORT3
00D428  1               ;
00D428  1               				; ADC Function
00D428  1               				; syntax: <result> = ADC<channel>
00D428  1               				; reads from selected ADC channel
00D428  1               ;
00D428  1  20 BC C8     ADCF:	jsr	GETINT		; get parameter (integer constant, variable or expression)
00D42B  1  B5 15        	lda	acc1-1,x	; get channel number
00D42D  1  0A           	asl	a		; and shift to upper nibble (bits 4 to 6)
00D42E  1  0A           	asl	a
00D42F  1  0A           	asl	a
00D430  1  0A           	asl	a
00D431  1  8D 30 1A     	sta	ADCORB		; and write to ADC mux (6522 Port B)
00D434  1  A9 0C        	lda	#$0C		; take CA2 low
00D436  1  8D 3C 1A     	sta	ADCPCR		; ADC (6522) Peripheral Control Register
00D439  1  A9 0E        	lda	#$0E		; take CA2 high (start conversion)
00D43B  1  8D 3C 1A     	sta	ADCPCR		; ADC (6522) Peripheral Control Register
00D43E  1  A9 02        	lda	#$02		; read CA1
00D440  1  2C 3D 1A     watadc:	bit	ADCIFR		; ADC (6522) Interrupt Flag Register
00D443  1  F0 FB        	beq	watadc		; wait for CA1 to go low (conversion complete)
00D445  1  A9 00        	lda	#$00
00D447  1  95 24        	sta	acc2-1,x
00D449  1  95 33        	sta	acc3-1,x
00D44B  1  95 42        	sta	acc4-1,x
00D44D  1  AD 31 1A     	lda	ADCORA		; read MS 8 bits of ADC (6522 Port A)
00D450  1  0A           	asl	a
00D451  1  36 24        	rol	acc2-1,x
00D453  1  0A           	asl	a
00D454  1  36 24        	rol	acc2-1,x
00D456  1  0A           	asl	a
00D457  1  36 24        	rol	acc2-1,x
00D459  1  0A           	asl	a
00D45A  1  36 24        	rol	acc2-1,x
00D45C  1  85 52        	sta	bwork
00D45E  1  AD 30 1A     	lda	ADCORB		; read LS 4 bits of ADC (6522 Port B)
00D461  1  29 0F        	and	#$0F
00D463  1  05 52        	ora	bwork
00D465  1  95 15        	sta	acc1-1,x
00D467  1  60           	rts			; and return
00D468  1               ;
00D468  1               				; DAC Statement
00D468  1               				; syntax: DAC <channel>=<value>
00D468  1               				; writes to specified DAC channel.
00D468  1               ;
00D468  1  20 BC C8     DAC:	jsr	GETINT		; get parameter (integer constant, variable or expression)
00D46B  1  20 DE C4     	jsr	EQUEXP		; parse '='
00D46E  1  B5 14        	lda	acc1-2,x	; get DAC channel number
00D470  1  29 01        	and	#$01		; retain bit 0 only
00D472  1  A8           	tay			; transfer to Y
00D473  1  B5 15        	lda	acc1-1,x	; get value to write
00D475  1  85 52        	sta	bwork
00D477  1  85 53        	sta	bwork+1
00D479  1  B5 24        	lda	acc2-1,x
00D47B  1  06 52        	asl	bwork
00D47D  1  2A           	rol	a
00D47E  1  06 52        	asl	bwork
00D480  1  2A           	rol	a
00D481  1  06 52        	asl	bwork
00D483  1  2A           	rol	a
00D484  1  06 52        	asl	bwork
00D486  1  2A           	rol	a
00D487  1  99 00 1A     	sta	DACPAR,y	; write 8 MS bits to appropriate DAC (8255 Port A for DAC 0, B for DAC 1)
00D48A  1  A5 52        	lda	bwork
00D48C  1  A2 F0        	ldx	#$F0		; mask for DAC 0 and 2
00D48E  1  C0 01        	cpy	#$01
00D490  1  F0 04        	beq	DAC02		; DAC 0 or 2 ?
00D492  1  A2 0F        	ldx	#$0F		; no - mask for DAC 1 and 3
00D494  1  A5 53        	lda	bwork+1
00D496  1  86 52        DAC02:	stx	bwork
00D498  1  25 52        	and	bwork
00D49A  1  85 53        	sta	bwork+1
00D49C  1  A5 52        	lda	bwork
00D49E  1  49 FF        	eor	#$FF
00D4A0  1  2D 02 1A     	and	DACPCR 		; read current DAC 4 LS bits (8255 Port C)
00D4A3  1  05 53        	ora	bwork+1		; retain bits of other DAC
00D4A5  1  8D 02 1A     	sta	DACPCR 		; DAC (8255) Port C Register
00D4A8  1  C6 04        	dec	accptr
00D4AA  1  C6 04        	dec	accptr
00D4AC  1  4C 5B C5     	jmp	CONT_X		; continue execution at next statement
00D4AF  1               ;
00D4AF  1               .if SYSTEM=1
00D4AF  1               ;				  *** System Graphic Routines ***
00D4AF  1               ;
00D4AF  1               				; DRAW Statement
00D4AF  1               				; syntax: <x><y>
00D4AF  1               				; Draw a line in white to absolute position <x>,<y>
00D4AF  1               ;
00D4AF  1               DRAW:	ldx	#$05		; DRAW is the same as PLOT 5 (mode=5)
00D4AF  1               	bne	DODRAW		; branch always
00D4AF  1               ;
00D4AF  1               				; MOVE Statement
00D4AF  1               				; syntax: <x><y>
00D4AF  1               				; Move to absolute position <x>,<y>
00D4AF  1               ;
00D4AF  1               MOVE:	ldx	#$0C		; MOVE is the same as PLOT 12 (mode=12)
00D4AF  1               DODRAW:	stx	acc1
00D4AF  1               	inc	accptr
00D4AF  1               	bne	DOPLOT		; branch always
00D4AF  1               ;
00D4AF  1               				; PLOT Statement
00D4AF  1               				; syntax: <mode><x><y>
00D4AF  1               				; Depending on the value of <mode> PLOT will move or draw a line or point:
00D4AF  1               				; mode=0: move relative to last position
00D4AF  1               				; mode=1: draw coloured line relative to last position
00D4AF  1               				; mode=2: invert colour of line relative to last position
00D4AF  1               				; mode=3: draw black line relative to last position
00D4AF  1               				; mode=4: move to absolute position
00D4AF  1               				; mode=5: draw coloured line to absolute position
00D4AF  1               				; mode=6: invert colour of line to absolute position
00D4AF  1               				; mode=7: draw black line to absolute position
00D4AF  1               				; mode=8: move relative to last position
00D4AF  1               				; mode=9: plot coloured point relative to last position
00D4AF  1               				; mode=10: invert colour of point relative to last position
00D4AF  1               				; mode=11: plot black point relative to last position
00D4AF  1               				; mode=12: move relative to last position
00D4AF  1               				; mode=13: plot coloured point at absolute position
00D4AF  1               				; mode=14: invert colour of point at absolute position
00D4AF  1               				; mode=15: plot black point at absolute position
00D4AF  1               
00D4AF  1               				; Black is the background colour, the graphics colour was defined by CLEAR
00D4AF  1               				; Invert alternates between the current colour and black
00D4AF  1               ;
00D4AF  1               PLOT:	jsr	GETINT		; get (integer constant, variable or expression) <mode>
00D4AF  1               	jsr	PARCOM		; parse separating comma
00D4AF  1               ;
00D4AF  1               DOPLOT:	jsr	GETINT		; get (integer constant, variable or expression) <x>
00D4AF  1               	jsr	PARCOM		; parse separating comma
00D4AF  1               	jsr	GETINT		; get (integer constant, variable or expression) <y>
00D4AF  1               	jsr	ENDTST		; test for end of statement
00D4AF  1               	lda	acc1-1,x	; get LSB of 3rd parameter <y>
00D4AF  1               	sta	Y2L		; and store at Y2L
00D4AF  1               	lda	acc2-1,x	; get MSB of 3rd parameter <y>
00D4AF  1               	sta	Y2M		; and store at Y2M
00D4AF  1               	lda	acc1-2,x	; get LSB of 2nd parameter <x>
00D4AF  1               	sta	X2L		; and store at X2L
00D4AF  1               	lda	acc2-2,x	; get MSB of 2nd parameter <x>
00D4AF  1               	sta	X2M		; and store at X2M
00D4AF  1               	ldx	#$00		; reset accumulator pointer
00D4AF  1               	stx	accptr
00D4AF  1               	ldx	#$03
00D4AF  1               cpypos:	lda	X0L,x		; copy Current position X0/Y0 to From position X1/Y1
00D4AF  1               	sta	X1L,x
00D4AF  1               	dex
00D4AF  1               	bpl	cpypos
00D4AF  1               	lda	acc1		; get <mode>
00D4AF  1               	and	#$04		; absolute or relative position ?
00D4AF  1               	bne	abs		; branch if absolute
00D4AF  1               	clc			; relative
00D4AF  1               	lda	X2L		; add From position X1/Y1 to To position X2/Y2
00D4AF  1               	adc	X1L
00D4AF  1               	sta	X2L
00D4AF  1               	lda	X2M
00D4AF  1               	adc	X1M
00D4AF  1               	sta	X2M
00D4AF  1               	clc
00D4AF  1               	lda	Y2L
00D4AF  1               	adc	Y1L
00D4AF  1               	sta	Y2L
00D4AF  1               	lda	Y2M
00D4AF  1               	adc	Y1M
00D4AF  1               	sta	Y2M
00D4AF  1               abs:	ldx	#$03		; and update plot position
00D4AF  1               updpos:	lda	X2L,x		; copy To
00D4AF  1               	sta	X0L,x		; to Current
00D4AF  1               	dex
00D4AF  1               	bpl	updpos
00D4AF  1               	lda	acc1		; get <mode>
00D4AF  1               	and	#$03		; move ?
00D4AF  1               	beq	move		; yes - branch
00D4AF  1               	sta	MODE		; save LS 2-bits of <mode>
00D4AF  1               	lda	acc1		; get <mode>
00D4AF  1               	and	#$08		; point or line ?
00D4AF  1               	beq	line		; branch if line
00D4AF  1               	jsr	PLTPT		; otherwise plot a point (at X2,Y2 using MODE)
00D4AF  1               move:	jmp	CONT_X		; point/move - finished (nothing to plot), continue execution at next statement
00D4AF  1               ;
00D4AF  1               line:	ldx	#$02		; Plot a Line from X1/Y1 to X2/Y2
00D4AF  1               linex:	sec
00D4AF  1               	lda	X2L,x		; subtract X1 From position LSB from X2 To position LSB
00D4AF  1               	sbc	X1L,x
00D4AF  1               	ldy	X1L,x		; copy X1 From position LSB to X2 To position LSB
00D4AF  1               	sty	X2L,x
00D4AF  1               	sta	X1L,x		; and save result, the difference, in X1 From position LSB
00D4AF  1               	ldy	X1M,x
00D4AF  1               	lda	X2M,x
00D4AF  1               	sbc	X1M,x		; subtract X1 From position MSB from X2 To position X2 MSB
00D4AF  1               	sty	X2M,x		; copy X1 From position MSB to X2 To position MSB
00D4AF  1               	sta	X1M,x		; and save result, the difference, in X1 From position MSB
00D4AF  1               	sta	xdir,x		; also save result as the plot direction
00D4AF  1               	bpl	posdif
00D4AF  1               	lda	#$00		; if result negative make it positive (magnitude)
00D4AF  1               	sec
00D4AF  1               	sbc	X1L,x		; subtract X1 From position LSB from 0
00D4AF  1               	sta	X1L,x		; and save as X1 From position LSB
00D4AF  1               	lda	#$00
00D4AF  1               	sbc	X1M,x		; subtract X1 From position MSB from 0
00D4AF  1               	sta	X1M,x		; and save as X1 From position MSB
00D4AF  1               posdif:	dex			; decrement pointer by 2 pixels
00D4AF  1               	dex
00D4AF  1               	bpl	linex		; repeat process for both x and y
00D4AF  1               	lda	Y1L		; which direction has the largest change ?
00D4AF  1               	cmp	X1L
00D4AF  1               	lda	Y1M
00D4AF  1               	sbc	X1M
00D4AF  1               	bcc	x_gt_y
00D4AF  1               	lda	#$00		; y greater than x
00D4AF  1               	sbc	Y1L		; set up plot counter
00D4AF  1               	sta	pltcnt
00D4AF  1               	lda	#$00
00D4AF  1               	sbc	Y1M
00D4AF  1               	sec
00D4AF  1               	ror	a
00D4AF  1               	sta	pltcnt+2
00D4AF  1               	ror	pltcnt
00D4AF  1               nxplta:	jsr	PLTPT		; plot point (at X2,Y2 using MODE)
00D4AF  1               	lda	Y2L		; Y2 To position LSB
00D4AF  1               	cmp	Y0L		; Y0 Current position LSB
00D4AF  1               	bne	adjsty		; have we finished ? not the same ?
00D4AF  1               	lda	Y2M		; Y2 To position MSB
00D4AF  1               	cmp	Y0M		; Y0 Current position MSB
00D4AF  1               	bne	adjsty		; have we finished ? not the same ?
00D4AF  1               drwend:	jmp	CONT_X		; finished - continue execution at next statement
00D4AF  1               adjsty:	jsr	INYDEY		; increment/decrement y position
00D4AF  1               	lda	pltcnt+2	; test MSB of counter
00D4AF  1               	bmi	nxplta		; do we need to adjust x ?
00D4AF  1               	jsr	INXDEX		; yes
00D4AF  1               	jmp	nxplta		; then plot next point
00D4AF  1               x_gt_y:	lda	X1M		; is x greater than y
00D4AF  1               	lsr	a		; set up plot counter
00D4AF  1               	sta	pltcnt+2
00D4AF  1               	lda	X1L
00D4AF  1               	ror	a
00D4AF  1               	sta	pltcnt
00D4AF  1               nxpltb:	jsr	PLTPT		; plot point (at X2,Y2 using MODE)
00D4AF  1               	lda	X2L		; compare current x with To position
00D4AF  1               	cmp	X0L
00D4AF  1               	bne	adjstx
00D4AF  1               	lda	X2M
00D4AF  1               	cmp	X0M
00D4AF  1               	beq	drwend
00D4AF  1               adjstx:	jsr	INXDEX		; increment/decrement x position
00D4AF  1               	lda	pltcnt+2	; test MSB of counter
00D4AF  1               	bpl	nxpltb		; do we need to adjust y ?
00D4AF  1               	jsr	INYDEY		; yes
00D4AF  1               	jmp	nxpltb		; then plot next point
00D4AF  1               ;
00D4AF  1               INXDEX:	sec			; Subtract magnitude of Y1 from counter
00D4AF  1               	lda	pltcnt
00D4AF  1               	sbc	Y1L		; Y1 From position LSB
00D4AF  1               	sta	pltcnt
00D4AF  1               	lda	pltcnt+2
00D4AF  1               	sbc	Y1M		; Y1 From position MSB
00D4AF  1               	sta	pltcnt+2
00D4AF  1               	ldx	#$00		; point at x position
00D4AF  1               	beq	tstdir
00D4AF  1               ;
00D4AF  1               INYDEY:	clc			; Add magnitude of X1 to counter
00D4AF  1               	lda	pltcnt
00D4AF  1               	adc	X1L
00D4AF  1               	sta	pltcnt
00D4AF  1               	lda	pltcnt+2
00D4AF  1               	adc	X1M
00D4AF  1               	sta	pltcnt+2
00D4AF  1               	ldx	#$02		; point at y position
00D4AF  1               tstdir:	clc
00D4AF  1               	lda	xdir,x		; which direction are we plotting in ?
00D4AF  1               	bpl	incpos		; up
00D4AF  1               	lda	X2L,x		; down - decrement X2/Y2 To position
00D4AF  1               	sbc	#$00
00D4AF  1               	sta	X2L,x
00D4AF  1               	bcs	incrts
00D4AF  1               	dec	X2M,x
00D4AF  1               incrts:	rts			; and return
00D4AF  1               incpos:	lda	X2L,x		; increment X2/Y2 To position
00D4AF  1               	adc	#$01
00D4AF  1               	sta	X2L,x
00D4AF  1               	bcc	incrts
00D4AF  1               	inc	X2M,x
00D4AF  1               	rts			; and return
00D4AF  1               ;
00D4AF  1               				; CLEAR Statement
00D4AF  1               				; syntax: CLEAR <colour>
00D4AF  1               				; 0 white, 1 cyan, 2 magenta, 3 blue, 4 yellow, 5 green, 6 red
00D4AF  1               				;
00D4AF  1               				; Teletext VDU provides 25 lines of 40 characters.  For graphics the first
00D4AF  1               				; character of each line is written with a graphics colour code ($11 to $17)
00D4AF  1               				; Each character position then provides 2 x 3 graphics pixels resulting in
00D4AF  1               				; a graphics screen 78(x) x 75(y) pixels
00D4AF  1               ;
00D4AF  1               CLEAR:	jsr	GETI_W		; get (integer) <colour> into workspace
00D4AF  1               	lda	#FRMFED
00D4AF  1               	jsr	OSWRCH		; clear the screen using OSWRCH
00D4AF  1               	ldy	#$00		; then write graphics code to start of each line
00D4AF  1               	ldx	#$18		; 25 lines
00D4AF  1               clrvdu:	lda	VDULSB,x	; LSB of address of start of Teletext VDU line
00D4AF  1               	sta	bwork+1
00D4AF  1               	lda	VDUMSB,x	; MSB of address of start of Teletext VDU line
00D4AF  1               	sta	bwork+2
00D4AF  1               	lda	bwork		; get colour
00D4AF  1               	eor	#$17		; convert to a teletext graphics code ($11 to $17)
00D4AF  1               	sta	(bwork+1),y	; write to start of line
00D4AF  1               	dex
00D4AF  1               	bpl	clrvdu		; next line
00D4AF  1               	jmp	ENDCNT		; test for end of statement and continue execution of next statement
00D4AF  1               ;
00D4AF  1               				; Plot a Point (at X2,Y2 using MODE)
00D4AF  1               PLTPT:	lda	X2M		; check position is on screen
00D4AF  1               	ora	Y2M
00D4AF  1               	bne	PLTRTN		; return if both x and y MSB are not 0
00D4AF  1               	lda	X2L		; check x is on screen
00D4AF  1               	cmp	#$4E		; 78 (39 lines of 2 horizontal pixels)
00D4AF  1               	bcs	PLTRTN		; return if greater than 78
00D4AF  1               	lsr	a		; divide by 2 (2 horizontal pixels per character position)
00D4AF  1               	sta	pixadr		; character position on line
00D4AF  1               	lda	Y2L		; check y is on screen
00D4AF  1               	cmp	#$4B		; 75 (25 rows x 3 vertical pixels)
00D4AF  1               	bcs	PLTRTN		; return if greater than 75
00D4AF  1               	ldx	#$FF
00D4AF  1               	sec
00D4AF  1               sub3:	inx
00D4AF  1               	sbc	#$03		; subtract 3 from y (3 vertical pixels per character)
00D4AF  1               	bcs	sub3		; until the result goes negative
00D4AF  1               	adc	#$03		; then put 3 back on again
00D4AF  1               	sta	yofset		; and save the result  (y pixel offset within a character)
00D4AF  1               	lda	VDULSB,x	; LSB of address of start of Teletext VDU line
00D4AF  1               	sec
00D4AF  1               	adc	pixadr		; address of start of line + character position on line + 1
00D4AF  1               	sta	pixadr		; save as absolute character address LSB
00D4AF  1               	lda	VDUMSB,x	; MSB of address of start of Teletext VDU line
00D4AF  1               	adc	#$00
00D4AF  1               	sta	pixadr+1	; character address MSB
00D4AF  1               	lda	X2L		; retrieve pixel x position
00D4AF  1               	lsr	a		; shift LS bit into carry
00D4AF  1               	lda	yofset		; retrieve y offset
00D4AF  1               	rol	a		; roll carry into LS bit
00D4AF  1               	tay			; to get index the pixel mask
00D4AF  1               	lda	PIXELS,y	; get pixel mask to write to character position
00D4AF  1               	ldy	#$00
00D4AF  1               	ldx	MODE		; determine drawing mode - retrieve LS 2-bits of <mode>
00D4AF  1               	dex			; and decrement
00D4AF  1               	beq	pltset		; if 0 - draw coloured (set)
00D4AF  1               	dex			; decrement again
00D4AF  1               	beq	pltinv		; if 0 - invert
00D4AF  1               	eor	#$FF		; must be draw black, invert mask
00D4AF  1               	and	(pixadr),y	; and clear pixel
00D4AF  1               	sta	(pixadr),y
00D4AF  1               	rts			; and return
00D4AF  1               pltinv:	eor	(pixadr),y	; invert pixel
00D4AF  1               	sta	(pixadr),y
00D4AF  1               	rts			; and return
00D4AF  1               pltset:	ora	(pixadr),y	; set pixel
00D4AF  1               	sta	(pixadr),y
00D4AF  1               PLTRTN:	rts			; and return
00D4AF  1               ;
00D4AF  1               				; Table of Teletext Character Pixel Masks
00D4AF  1               PIXELS:	.byte	$10,$40,$04,$08,$01,$02	; bottom L, bottom R, middle L, middle R, top L, top R
00D4AF  1               ;
00D4AF  1               				; Table 3 LSB of address of start of Teletext VDU lines
00D4AF  1               VDULSB:	.byte	$C0,$98,$70,$48,$20,$F8,$D0,$A8
00D4AF  1               	.byte	$80,$58,$30,$08,$E0,$B8,$90,$68
00D4AF  1               	.byte	$40,$18,$F0,$C8,$A0,$78,$50,$28
00D4AF  1               	.byte	$00
00D4AF  1               ;
00D4AF  1               				; Table 4 MSB of address of Start of Teletext VDU Lines
00D4AF  1               VDUMSB:	.byte	$07,$07,$07,$07,$07,$06,$06,$06
00D4AF  1               	.byte	$06,$06,$06,$06,$05,$05,$05,$05
00D4AF  1               	.byte	$05,$05,$04,$04,$04,$04,$04,$04
00D4AF  1               	.byte	$04
00D4AF  1               .endif
00D4AF  1               ;
00D4AF  1               .if ATOM=1
00D4AF  1               ; 				  *** Atom Graphic Routines ***
00D4AF  1               ;				; (This code is exactly the same as that in the Floating Point ROM)
00D4AF  1               ;
00D4AF  1               				; COLOUR Statement
00D4AF  1               				; syntax: COLOUR <colour>
00D4AF  1               				; 0 green, 1 yellow, 2 blue, 3 read
00D4AF  1               ;
00D4AF  1  20 C8 C3     COLOUR:	jsr	GETI_W		; transfer (integer) colour parameter to workspace
00D4B2  1  A5 52        	lda	bwork
00D4B4  1  29 03        	and	#$03		; retain 2-bits only i.e. 0 to 3
00D4B6  1  A8           	tay			; and transfer to Y
00D4B7  1  B9 FB D4     	lda	COLTAB,y	; and use as index to table of coloured pixels
00D4BA  1  8D FD 03     	sta	colour		; save for later use
00D4BD  1  AD 00 B0     	lda	IC25A		; get graphics mode (bits 4 to 7 A/G, GM0, GM1, GM2))
00D4C0  1  29 F0        	and	#$F0		; mask off keyboard rows (bits 0 to 3)
00D4C2  1  C9 70        	cmp	#$70		; is it Graphics Mode 2 (6847 RG2)
00D4C4  1  D0 0C        	bne	nmode2		; no - branch
00D4C6  1  A9 00        	lda	#$00		; yes -
00D4C8  1  A8           	tay			; A=Y=0
00D4C9  1  99 00 86     clrmd2:	sta	SCRMD3,y	; clear the 512bytes of RAM just above Mode 2 ?
00D4CC  1  99 00 87     	sta	SCRMD3+$0100,y
00D4CF  1  88           	dey
00D4D0  1  D0 F7        	bne	clrmd2
00D4D2  1  AD 00 B0     nmode2:	lda	IC25A		; get graphics mode (bits 4 to 7) again
00D4D5  1  29 DF        	and	#$DF		; retain bits 4,6,7 only (A/G, GM1, GM2) i.e. GM0=0 Colour CG mode
00D4D7  1  8D 00 B0     	sta	IC25A		; write graphics mode back to 6847
00D4DA  1  2A           	rol	a		; roll GM2, GM1, GM0 around to bits 3,2,1
00D4DB  1  2A           	rol	a
00D4DC  1  2A           	rol	a
00D4DD  1  29 03        	and	#$03		; and lose the rest
00D4DF  1  A8           	tay			; transfer to Y as an index to the
00D4E0  1  B9 EF D4     	lda	PLOT_L,y	; replacement colour graphics plot point routine
00D4E3  1  8D FE 03     	sta	plotl		; Address of plot point routine (LSB)
00D4E6  1  B9 F3 D4     	lda	PLOT_H,y
00D4E9  1  8D FF 03     	sta	ploth		; Address of plot point routine (MSB)
00D4EC  1  4C 58 C5     	jmp	ENDCNT		; test for end of present statement and continue execution of next statement
00D4EF  1               ;
00D4EF  1               				; Table of Colour Plot Point Routine Addresses
00D4EF  1  FF 1D 35 4D  PLOT_L:	.byte	<PLOT1A,<PLOT2A,<PLOT3A,<PLOT4A		; LSB of PLOT Routines
00D4F3  1  D4 D5 D5 D5  PLOT_H:	.byte	>PLOT1A,>PLOT2A,>PLOT3A,>PLOT4A		; MSB of PLOT Routines
00D4F7  1               ;
00D4F7  1               				; Table of Pixel Masks
00D4F7  1  3F CF F3 FC  PIXMSK:	.byte	$3F,$CF,$F3,$FC	; bits 7/6, 5/4, 3/2, 1/0
00D4FB  1               ;
00D4FB  1               				; Table of Colour Pixel Values
00D4FB  1  00 55 AA FF  COLTAB:	.byte	$00,$55,$AA,$FF	; 4 pixels of green, yellow, blue or read
00D4FF  1               ;
00D4FF  1               				; Graphics Mode 1a  Plot Point Routine
00D4FF  1               				; 64 x 64 pixels - 16bytes x 64bytes (1Kbytes)
00D4FF  1  A5 5B        PLOT1A:	lda	XM
00D501  1  05 5D        	ora	YM		; x and y MSB should be zero if on screen
00D503  1  D0 47        	bne	pltrts		; if not return
00D505  1  A5 5A        	lda	XL
00D507  1  C9 40        	cmp	#$40		; is x beyond 64 ?
00D509  1  B0 41        	bcs	pltrts		; yes - return off screen
00D50B  1  4A           	lsr	a		; divide x by 4, 4 pixels/byte
00D50C  1  4A           	lsr	a
00D50D  1  85 5F        	sta	pixadr		; to get LS 4-bits of the pixel address
00D50F  1  A0 00        	ldy	#$00
00D511  1  84 60        	sty	pixadr+1	; MSB of pixel address = 0
00D513  1  A9 3F        	lda	#$3F		; 63
00D515  1  38           	sec
00D516  1  E5 5C        	sbc	YL
00D518  1  C9 40        	cmp	#$40		; 64 (y limit)
00D51A  1  90 4F        	bcc	PLOTB		; on screen, continue to plot
00D51C  1  60           	rts			; return off screen
00D51D  1               ;
00D51D  1               				; Graphics Mode 2a Plot Point Routine
00D51D  1               				; 128 x 64 pixels - 32bytes x 64bytes (2Kbytes)
00D51D  1  A5 5B        PLOT2A:	lda	XM
00D51F  1  05 5D        	ora	YM		; x and y MSB should be zero if on screen
00D521  1  D0 29        	bne	pltrts		; if not return
00D523  1  A5 5A        	lda	XL		; is x beyond 128 ?
00D525  1  30 25        	bmi	pltrts		; yes - return off screen
00D527  1  4A           	lsr	a		; divide x by 4, 4 pixels/byte
00D528  1  4A           	lsr	a
00D529  1  85 5F        	sta	pixadr		; to get LSB of pixel address
00D52B  1  A9 3F        	lda	#$3F
00D52D  1  38           	sec
00D52E  1  E5 5C        	sbc	YL
00D530  1  C9 40        	cmp	#$40		; 64 (y limit)
00D532  1  90 30        	bcc	PLOTA		; on screen, continue to plot
00D534  1  60           	rts			; return off screen
00D535  1               ;
00D535  1               				; Graphics Mode 3a Plot Point Routine
00D535  1               				; 128 x 96 pixels 32bytes x 96bytes (3Kbytes)
00D535  1  A5 5B        PLOT3A:	lda	XM
00D537  1  05 5D        	ora	YM		; x and y MSB should be zero if on screen
00D539  1  D0 11        	bne	pltrts		; if not return
00D53B  1  A5 5A        	lda	XL		; is x beyond 128 ?
00D53D  1  30 0D        	bmi	pltrts		; yes - return off screen
00D53F  1  4A           	lsr	a		; divide x by 4, 4 pixels/byte
00D540  1  4A           	lsr	a
00D541  1  85 5F        	sta	pixadr		; to get LSB of pixel address
00D543  1  A9 5F        	lda	#$5F
00D545  1  38           	sec
00D546  1  E5 5C        	sbc	YL
00D548  1  C9 60        	cmp	#$60		; 96 (y limit)
00D54A  1  90 18        	bcc	PLOTA		; on screen, continue to plot
00D54C  1  60           pltrts:	rts			; return off screen
00D54D  1               ;
00D54D  1               				; Graphics Mode 4a Plot Point Routine
00D54D  1               				; 128 x 192 pixels 32bytes x 192bytes (6KBytes)
00D54D  1  A5 5B        PLOT4A:	lda	XM
00D54F  1  05 5D        	ora	YM		; x and y MSB should be zero if on screen
00D551  1  D0 F9        	bne	pltrts		; if not return
00D553  1  A5 5A        	lda	XL		; is x beyond 128 ?
00D555  1  30 F5        	bmi	pltrts		; yes - return off screen
00D557  1  4A           	lsr	a		; divide x by 4, 4 pixels/byte
00D558  1  4A           	lsr	a
00D559  1  85 5F        	sta	pixadr		; to get LSB of pixel address
00D55B  1  A9 BF        	lda	#$BF
00D55D  1  38           	sec
00D55E  1  E5 5C        	sbc	YL
00D560  1  C9 C0        	cmp	#$C0		; 192 (y limit)
00D562  1  B0 E8        	bcs	pltrts		; return off screen
00D564  1               ;
00D564  1               				; do the plot
00D564  1  A0 00        PLOTA:	ldy	#$00
00D566  1  84 60        	sty	pixadr+1	; MSB of pixel address = 0
00D568  1  0A           	asl	a		; shift MS bit of A into pixel address MSB
00D569  1  26 60        	rol	pixadr+1
00D56B  1  0A           PLOTB:	asl	a		; shift the 4 MS bits of A into pixel address MSB (0 to 3)
00D56C  1  26 60        	rol	pixadr+1
00D56E  1  0A           	asl	a
00D56F  1  26 60        	rol	pixadr+1
00D571  1  0A           	asl	a
00D572  1  26 60        	rol	pixadr+1
00D574  1  0A           	asl	a
00D575  1  26 60        	rol	pixadr+1
00D577  1  65 5F        	adc	pixadr		; A=00 to F0, add lSB of pixel address (00 to 0F)
00D579  1  85 5F        	sta	pixadr		; and save
00D57B  1  A5 60        	lda	pixadr+1	; retrieve MSB of pixel address
00D57D  1  69 80        	adc	#$80		; and add base address of screen - $8000
00D57F  1  85 60        	sta	pixadr+1	; save
00D581  1  A5 5A        	lda	XL		; LSB of x position on screen
00D583  1  29 03        	and	#$03		; mask off LS 2-bits
00D585  1  AA           	tax			; and use as index to
00D586  1  BD F7 D4     	lda	PIXMSK,x	; table of pixel masks
00D589  1  A6 5E        	ldx	doplot		; what to do: set (1), invert (2) or clear bit (anything else)
00D58B  1  CA           	dex			; set (0), invert (1) or clear bit (anything else)
00D58C  1  F0 0F        	beq	atmset		; set
00D58E  1  CA           	dex
00D58F  1  F0 05        	beq	atminv
00D591  1  31 5F        	and	(pixadr),y	; clear pixel
00D593  1  91 5F        	sta	(pixadr),y	; update screen
00D595  1  60           	rts			; and return
00D596  1               ;
00D596  1  49 FF        atminv:	eor	#$FF		; invert pixel mask
00D598  1  51 5F        	eor	(pixadr),y	; invert pixel
00D59A  1  91 5F        	sta	(pixadr),y	; update screen
00D59C  1  60           	rts			; and return
00D59D  1               ;
00D59D  1  AA           atmset:	tax			; save A
00D59E  1  31 5F        	and	(pixadr),y	; AND pixel mask with pixel to clear old pixel colour
00D5A0  1  91 5F        	sta	(pixadr),y
00D5A2  1  8A           	txa			; retrieve A (pixel mask)
00D5A3  1  49 FF        	eor	#$FF		; invert
00D5A5  1  2D FD 03     	and	colour		; AND with plot colour
00D5A8  1  11 5F        	ora	(pixadr),y	; OR pixel with new colour
00D5AA  1  91 5F        	sta	(pixadr),y	; update screen
00D5AC  1  60           	rts			; and return
00D5AD  1               .endif
00D5AD  1