;------------------------------------------------------------------------
;		Copyright 2010 Integrated Logic Systems
;                  Source Code is Copyright Stephen J. Carden
;
;
;			Please do not share this source!
;------------------------------------------------------------------------
;                              gdevice.com
;
;	This is a program sets up a graphic driver for dot matrix printers
;		init	4/6/2010	sjc new design
;
;
;Updated the screen Print Utility so it will work with the exp-80
; This change will also help "Print P:"		8/17/2012	sjc
;
;
;Also added code for Control+1 pause of screen to the high speed screen
;handling.		8/24/2012	sjc
; 
;
;
;Added code so this file cannot run on the AtariWin800 Emulator
;		8/27/2012	sjc
;
;
;
;
;       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;------------------------------------------------------------------------
; Notes: o This source code MAY NOT be placed for download on any BBS's!
;        o "mea" is a macro that loads the address of the first field
;          into the pointer specified by the second field.
;------------------------------------------------------------------------
; Assembler:  MADMAC (tm) ST Cross Assembler (Atari Corp)
;             XASM   st and IBM VERSIONS
;------------------------------------------------------------------------

com_file_name:		.macro
;			dc.b   13,"filename.ext",$9b
			dc.b   12,"Gdevice.com ",$9b
			.endm

;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; File revision history. Version Number in hex
;
file_ver:		equ   $11
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the Month in dec for the first time this revision 
;was compiled
;
c_month:		equ   8
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the day in dec for the first time this revision 
;was compiled
c_day:			equ   27
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the year in dec for the first time this revision 
;was compiled
c_year:			equ   2012
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Type of compiler used in program
;
; 0 = unknown Compiler
; 1 = xasm
; 2 = mac_65
; 3 = basic
; 4 = compiled basic xl
; 5 = C65
; 6 = Action
;
; We can add more as time goes on!
;
;
;
xasm:			equ	1
mac_65:			equ	2 
basic:			equ	3
basicxl:		equ	4
c65:			equ	5
action:			equ	6

file_compiler:		equ	xasm
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; is this relocatable code ?
; anyother value other than 1 or 2 would be unknown
r..yes:			equ	1
r..no:			equ	2
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Gotta define if it can be relocated
l_relocatable:		equ	r..yes
;
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Gotta define our Header control Byte
;$ff =bypass intro
;$15 = Bypass Dos check
r..crl:			equ	$7d
r..crlf:		equ	$9b
r..space:		equ	$20
r..bypassDOS:		equ	$15
r..bypass:		equ	$ff

l_frstscreenbyte:	equ	r..space
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; The language the output file is in. 
;
;
; 0	=	Undifined
; 1	=	English
; 2	=	German
;
r..language:		equ	1
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~



			.include	equates
			.include	globals
			.include	macros



			.ORG	$4000

win_start:
header_info:
			.include	header		; this reads info out of the header and displays to screen
;							; based on info stored at the front of the file
			lda	consol			; check the consol key
			cmp	#7			; looking for any key
			beq	.a			; nope they are not hold a key down
			jmp 	help_menu		; Show help menu
.a:
			lda 	vcount
			bne 	.a

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;	Check to see if we have a R: Handler
;
check_r_handler:
			jsr	os_off
			mea	tsr,s_ptr
			lda	#gdevice
			jsr	seclvl 			; call routing checking 
			bmi 	.aa
	 		jsr	printsi
			dc.b	$9b
			dc.b	" "
			dc.b	<+128>,"==>"
			dc.b	<+128>,"G: Handler already Present"
			dc.b	<+128>,"<=="
			dc.b	$9b
			dc.b	" "
			dc.b	<+128>,"==>"
			dc.b	<+128>,"And Registered with the OS"
			dc.b	<+128>,"<=="
			dc.b	$9b,-1
			jsr	os_on
			rts				; we are gonna Exit


.aa:
			jsr	os_on


;------------------------------------------------------------------
;	Check to see if we are running on an emulator
; 
pc_run:
			ldy	#$00
loap_1:			lda	$031a,y
			cmp	#'H'     ; WAS THE EDITOR
			beq	get_vec
			iny
			iny
			iny
			cpy	#36
			bne	loap_1
			ldy	#$00
			jmp	ok_look
			rts
;
get_vec
			jsr	printsi
			dc.b	$9b,$20
			dc.b	<+128>,"Error"
			dc.b	$9b
			dc.b	" Gdevice.com does not work with",$9b
			dc.b	" Atari800Win PC Emulator Detected!",$9B
			dc.b	-1
			ldy	#$01

			RTS
;
;

ok_look:



			ldy 	#$00
laap_1:			lda 	$031a,y
			cmp 	#'G'
			beq 	get1_vec
			iny
			iny
			iny
			cpy 	#36
			bne 	laap_1
			jmp 	do_install
			rts
;
get1_vec:
			JSR 	PRINTSI
			dc.b 	" G: handler Already Installed",$9B
			dc.b 	$9b,$9b
			dc.b 	-1
			RTS
;
do_install:
;
;
;
         		lda 	memlo			; setting some stuff up for the relocator
         		sta 	segtab+dorgadr		; Passing Stuff to the relocator
         		sta 	segtab+blkdes		; Passing Stuff to the relocator
         		lda 	memlo+1			; setting some stuff up for the relocator
         		sta 	segtab+dorgadr+1	; Passing Stuff to the relocator
         		sta 	segtab+blkdes+1		; Passing Stuff to the relocator

         		jsr	relocate		; ok do relocation of code!!!!!!!
		

			lda	DOSVEC
w01:			sta	L298B
			lda	DOSVEC+1
w02:			sta	L298B+1
 
			lda	DOSINI
w03:			sta	L25D0+1
w04:			sta	L298D
			lda	DOSINI+1
w05:			sta	L25D0+2
w06:			sta	L298d+1
lb01:			lda	# low l25D0
			sta	DOSINI
hb01:			lda	# high l25d0
			sta	DOSINI+1
w07:			jsr	reinit

			jsr	printsi			; Print we installed ok!
			dc.b	$9b,$9b
			dc.b	" G: Handler installed!",$9b,-1

			jsr	set_g_handler

			rts
;---------------------------------------------------------------------------------------
;
; This gets relocated to memlow
;
;
initz:
;
l25d0:			JSR	$FFFF
reinit:
			ldx	#0
l25d5:			LDA	$031A,X
			beq	L25DF
			INX 
			INX 
			INX 
			bne	L25D5
l25df:			LDA	#'G'
			sta	$031A,X
lb02:			lda	# low g_handler
			sta	$031A+1,X
hb02:			lda	# high g_handler
			sta	$031A+2,X
lb03:			lda	# low l2610
			sta	DOSVEC
hb03:			lda	# high l2610
			sta	DOSVEC+1
lb04:			lda	# low l2eFC
			sta	$02E7
hb04:			lda	# high l2Efc
			sta	$02E7+1
			RTS 
;
g_handler:
w09:			dc.w	p.open-1		;open
w10:			dc.w	p.close-1		;close
w11:			dc.w	p.getbyte-1		;Get Byte
w12:			dc.w	p.putbyte-1		;Put byte
w13:			dc.w	p.status-1		;Status
w14:			dc.w	p.xio-1			;XIO

l260d:
w15:			jmp	p.status
;
l2610:   		LDX	#3
L2612:
w16:	   		LDA	L298B,X
w17:			sta	DOSVEC,X
			DEX 
			BPL	L2612
			jmp	($000A)

;
p.open:			PHP 
			TXA 
			lsr
			lsr
			lsr
			lsr
			TAY 
			DEY 
			bmi	L262B
			cpy	#7
			bcc	L262F
L262B:			LDY	#134				;$86
			bne	L2686
L262F:			LDX	$21
			DEX 
w18:			stx	L29A9
w19:			lda	L29DF,X
w20:			sta	L29D8,Y
			lda	$2b
			cmp	#$FF
			bne	L2643
			lda	#0
L2643:			CMP	#3
			bcs	L264B
			TAX 
w21:			lda	L29E3,X
L264B:
w22:			STA	L29F7
			lda	$22
			cmp	#$40
			bne	L266B
			lda	$2A
			cmp	#2
			bcs	L265E
			lda	#$1C
			bne	L2668
L265E:			CMP	#3
			bcs	L2666
			lda	#$0E
			bne	L2668
L2666:			LDA	#1
L2668:
w23:			STA	L29F4
L266B:
w24:			JSR	L2936
w25:			sta	L29AB
			ldx	#$0A
L2673:
w26:			LDA	L29ED,X
w27:			sta	$03C0,X
			DEX 
			bpl	L2673
w28:			jsr	L2941
			bmi	L2686
w29:			jsr	L2910
			ldy	#1
L2686:			PLP 
			RTS 
;
p.close:
w30:			jsr	L2936
			lda	#$1B
			sta	$03C0
			lda	#$40
			sta	$03C0+1
			lda	#$9B
			sta	$03C0+2
w31:			jsr	L2941
p.status:
			ldy	#1
p.getbyte:
			RTS 
;
p.putbyte
			PHP 
w32:			stx	L29A5
			PHA 
			ldx	#7
L26A7:			LDA	$d4,X
w33:			sta	L299B,X
			DEX 
			bpl	L26A7
w34:			lda	L29A3
			sta	$d4
w35:			lda	L29A3+1
			sta	$d4+1
			PLA 
w36:			ldy	L29AB
			beq	L26D2
			cpy	#64	;$40
			bne	L26D9
			lda	$2b
w37:			sta	L29A8
lb05:			lda	# low l29B8
			sta	$d6
hb05:			lda	# high l29b8
			sta	$d6+1
			bne	L270A
L26D2:			CMP	#$9B
			bne	L26D9
w38:			jmp	L275D
;
L26D9:			LDY	#0
w39:			sty	L29A8
			sty	$d6+1
			asl
w40:			ROR	L29A8
			lsr
w41:			ldy	L29AB
			bne	L26F9
			cmp	#$20
			bcs	L26F2
			adc	#$40
			bcc	L26F9
L26F2:			CMP	#$60
			bcs	L26F9
			SEC 
			sbc	#$20
L26F9:			LDY	#3
L26FB:			ASL
			ROL	$d6+1
			DEY 
			bne	L26FB
			sta	$d6
			lda	$02F4
			ORA	$d6+1
			sta	$d6+1
L270A:			LDY	#7
w42:			sty	L29A6
L270F:			LDA	($d6),Y
w43:			ldy	L29A8
			beq	L2718
			EOR	#$FF
L2718:			LDY	#7
L271A:			lsr
			PHA 
			lda	($d4),Y
			ROR
			sta	($d4),Y
			PLA 
			DEY 
			bpl	L271A
w44:			dec	L29A6
w45:			ldy	L29A6
			bpl	L270F
			ldy	#7
L272F:			LDA	($d4),Y
			cmp	#$9B
			bne	L2739
			lda	#$97
			sta	($d4),Y
L2739:			DEY 
			bpl	L272F
			CLC 
			lda	$d4
			adc	#8
w46:			sta	L29A3
			sta	$d4
			bcc	L274D
w47:			inc	L29A3+1
			inc	$d4
L274D:
w48:			INC	L29FA
w49:			ldx	L29A9
			beq	L27C0
w50:			lda	L29FA
w51:			cmp	L29E6,X
			bne	L27C0
L275D:			LDY	#0
			lda	#$9B
			sta	($d4),Y
w52:			sty	L29AA
			ldx	#3
L2768:
w53:			ASL	L29FA
w54:			rol	L29FB
			DEX 
			bne	L2768
w55:			lda	L29AB
			cmp	#$40
			bne	L277C
			lda	#$4C
			bne	L2788
L277C:
w56:			LDA	L29A5
			lsr
			lsr
			lsr
			lsr
			TAX 
			DEX 
w57:			lda	L29D8,X
L2788:
w58:			STA	L29F9
lb06:			lda	# low l29F8
			sta	$da
hb06:			lda	# high l29f8
			sta	$da+1
L2793:
w59:			JSR	L2936
			TAY 
L2797:			LDA	($da),Y
			sta	$03C0,Y
			cmp	#$9B
			bne	L27A5
w60:			sta	L29AA
			beq	L27B5
L27A5:			INY 
			cpy	#$28
			bne	L2797
			CLC 
			lda	$da
			adc	#40		;$28
			sta	$da
			bcc	L27B5
			inc	$da+1
L27B5:
w61:			JSR	L2941
w62:			lda	L29AA
			beq	L2793
w63:			jsr	L2910
L27C0:			LDX	#7
L27C2:
w64:			LDA	L299B,X
			sta	$d4,X
			DEX 
			bpl	L27C2
			PLP 
			ldy	#1
			RTS 
;
p.xio:
w65:			stx	L29A5
w66:			jsr	p.open
			cpy	#1
			bne	L2829
			lda	#4
w67:			sta	L29A9
			lda	SAVMSC
			sta	$d8
w68:			sta	L29B2
w69:			sta	L29B0
			lda	SAVMSC+1
			sta	$d8+1
w70:			sta	L29B2+1
w71:			sta	L29B0+1
			lda	$22
w72:			sta	L29AB
			cmp	#64		;xio #64 $40
			beq	L282C
			cmp	#17		;xio #17 $11
			bcs	L2802
			lda	#$18
			bne	L2804
L2802:			SBC	#$10
L2804:
w73:			STA	L29AD
L2807:			LDA	#0
w74:			sta	L29AC
L280C:
w75:			LDY	L29AC
			lda	($D8),Y
w76:			ldx	L29A5
w77:			jsr	p.putbyte
w78:			inc	L29AC
w79:			lda	L29AC
			cmp	#40		;$28
			bne	L280C
w80:			jsr	L294F
w81:			dec	L29AD
			bne	L2807
L2829:
w82:			JMP	p.close
;
L282C:			LDA	$2A
			cmp	#2
			bcc	L283F
			cmp	#3
			bcs	L283A
			lda	#5
			bne	L283C
L283A:			LDA	#6
L283C:
w83:			STA	L29A9
L283F:			LDA	$21
			cmp	#3
			bcc	L2850
w84:			sta	L29B7
			ldx	#$A0
			ldy	#0
			lda	#$30
			bne	L285B
L2850:			LDA	#0
w85:			sta	L29B7
			ldx	#$40
			ldy	#1
			lda	#$18
L285B:
w86:			STX	L29B4
w87:			sty	L29B4+1
w88:			sta	L29B6
			lda	#0
w89:			sta	L29AE
L2869:			LDA	#0
w90:			sta	L29AF
L286E:
w91:			LDA	L29B2
			sta	$d8
w92:			lda	L29B2+1
			sta	$d8+1
			ldx	#0
L287A:			LDY	#0
			lda	($d8),Y
w93:			sta	L29B8,X
w94:			ldy	L29B7
			beq	L2889
w95:			sta	L29B9,X
L2889:
w96:			JSR	L294F
			INX 
			cpy	#3
			bcc	L2892
			INX 
L2892:			CPX	#8
			bne	L287A
			lda	$2A
			cmp	#2
			bcc	L28CC
w97:			jsr	L295B
			ldx	#7
L28A1:
w98:			LDA	L29C0,X
w99:			sta	L29B8,X
			DEX 
			bpl	L28A1
w100:			jsr	p.putbyte
			ldx	#7
L28AF:
w101:			LDA	L29C8,X
w102:			sta	L29B8,X
			DEX 
			bpl	L28AF
w103:			jsr	p.putbyte
			lda	$2A
			cmp	#3
			bne	L28CF
			ldx	#7
L28C3:
w104:			LDA	L29D0,X
w105:			sta	L29B8,X
			DEX 
			bpl	L28C3
L28CC:
w106:			JSR	p.putbyte
L28CF:
w107:			INC	L29B2
			bne	L28D7
w108:			inc	L29B2+1
L28D7:
w109:			INC	L29AF
w110:			lda	L29AF
			cmp	#$28
			bne	L286E
			CLC 
w111:			lda	L29B0
w112:			adc	L29B4
w113:			sta	L29B0
w114:			sta	L29B2
w115:			lda	L29B0+1
w116:			adc	L29B4+1
w117:			sta	L29B0+1
w118:			sta	L29B2+1
w119:			inc	L29AE
w120:			lda	L29AE
w121:			cmp	L29B6
			beq	L2908
w122:			jmp	L2869
;
L2908:			LDA	#5
w123:			sta	L29F4
w124:			jmp	p.close
;
L2910:			LDA	#0
			TAX 
L2913:
w125:			STA	L29FC,X
w126:			sta	L2AFC,X
w127:			sta	L2BFC,X
w128:			sta	L2CFC,X
w129:			sta	L2DFC,X
			INX 
			bne	L2913
w130:			sta	L29FA
w131:			sta	L29FB
lb07:			lda	# low l29FC
w132:			sta	L29A3
hb07:			lda	# high l29fc
w133:			sta	L29A3+1
			RTS 
;
L2936:			LDX	#40-1
			lda	#0
L293A:			STA	$03C0,X
			DEX 
			bpl	L293A
			RTS 
;
L2941:			LDX	#11		;$0B
L2943:
w134:			LDA	L298F,X
			sta	$0300,X
			DEX 
			bpl	L2943
			jmp	SIOV
;
L294F:			CLC 
			lda	$d8
			adc	#40		;$28
			sta	$d8
			bcc	L295A
			inc	$d8+1
L295A:			RTS 
;
L295B:			LDX	#23		;$17
			lda	#0
L295F:
w135:			STA	L29C0,X
			DEX 
			bpl	L295F
			ldx	#7

L2967:			LDA	#7
w136:			sta	L29A7
w137:			lda	L29B8,X
L296F:			lsr
			PHA 
			ldy	$2A
L2973:			PHP
w138:			ror	l29c0,x
w139:			ror	l29c8,x
w140:			ror	l29d0,x 
			PLP 
			DEY 
			bne	L2973
			PLA 
w141:			dec	L29A7
			bpl	L296F
			DEX 
			bpl	L2967
			RTS 
;
;
L298B:			dc.w	0
L298d:			dc.w	0
;
;
L298F:			dc.b	$40,$01,$57,$80,$c0,$03,$05,$00,$28,$00,$4e,00 
;
l299b:			dc.b	$00,$00,$00,$00,$00,$00,$00,$00

L29A3:			dc.w	0
L29A5:			dc.b	0
L29A6:			dc.b	0

L29A7			dc.b	0
L29A8:			dc.b	$00
L29A9:			dc.b	$00
L29AA:			dc.b	$00
L29AB:			dc.b	$00
L29AC:			dc.b	$00
L29AD:			dc.b	$00
L29AE:			dc.b	$00
L29AF:			dc.b	$00
L29B0:			dc.w	0
L29B2:			dc.w	0
L29B4:			dc.w	00

L29B6:			dc.b	$00
L29B7:			dc.b	$00
L29B8:			dc.b	$00
L29B9:			dc.b	$00,$00,$00,$00
			dc.b	$00,$00,$00

L29C0:			ds.b	8

L29C8:			ds.b	8

L29D0:			ds.b	8

L29D8:			ds.b	7

L29DF:			dc.b	$4c,$4c,$4b,$4b
;
L29E3:			dc.b	$08,$09,$0c

L29E6:			dc.b	$00,$26,$26,$3c,$28,$50,$78

L29ED:			dc.b	$1B,$40,$1b
			dc.b	$4e

			dc.b	$05,$1b
			dc.b	$4d

L29F4:			dc.b	$05,$1b
			dc.b	$41

l29f7:			dc.b	$08

l29f8:			dc.b	$1b

L29F9:			dc.b	$00
L29FA:			dc.b	$00
L29FB:			dc.b	$00
;
L29FC:			ds.b	256
l2afc:			ds.b	256
L2BFC:			ds.b	256
L2CFC:			ds.b	256
L2DFC:			ds.b	256
l2efc:			ds.b	0
;
;
;
;	End of handler
;
zend:			ds.b 	0			
;
;
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;                        *** END OF HANDLER ***
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;
;       Relocater: main entry
;       ---------------------
; in:
;       segtab  = table of segment descriptors
;               +00 = relocater table address
;               +02 = originate address of block
;               +04 = destination originate of block
;               +06 = address of block
;               +08 = number of bytes in block
;               +10 = destination address of block
;
;       reltab  = relocater table
;               list of address of words to adjust      2 bytes each entry
;               list of address low bytes to adjust     2 bytes each entry
;               list of address high bytes to adjust    3 bytes each entry
;                       followed by their low bytes
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
relocate:	lda	#0			; set ptr to segment 0
	        sta	segment

segloop:	ldx     segment
	        lda     segtab+rettad,x 	; get address of relocater table
	        sta     relget+1
	        lda	segtab+rettad+1,x
		sta	relget+2
		ora     relget+1        	; if zero, then end of segtab
		bne     havseg
		rts

havseg:		sec                     	; calculate offset to add to segment
		lda	segtab+dorgadr,x
		sbc	segtab+orgadr,x
		sta	zoffset
		lda	segtab+dorgadr+1,x
		sbc	segtab+orgadr+1,x
		sta	zoffset+1

zwordlp:	jsr	getzwp
		beq	zlbytlp         	; if zero, go adjust low bytes
		lda	(zwptr),y		; add offset to address
		clc
		adc	zoffset
		sta	(zwptr),y
		iny
		lda	(zwptr),y
		adc	zoffset+1
		sta	(zwptr),y
		jmp	zwordlp

zlbytlp:	jsr	getzwp			; get address
		beq	zhbytlp			; if zero, then adjust high bytes
		lda	(zwptr),y
		clc
		adc	zoffset
		sta	(zwptr),y
		jmp	zlbytlp

zhbytlp:	jsr	getzwp			; get address
		beq	zmovlp			; jump if end of table
		jsr	relget			; get low byte
		clc
		adc	zoffset
		lda	(zwptr),y
		adc	zoffset+1
		sta	(zwptr),y
		jmp	zhbytlp

zmovlp:		ldx	segment			; get block start and to address
		lda	segtab+blkadr,x
		sta	zmovfr+1
		lda	segtab+blkadr+1,x
		sta	zmovfr+2
		lda	segtab+blkdes,x
		sta	zmovto+1
		lda	segtab+blkdes+1,x
		sta	zmovto+2
						; get # pages to move
		ldy	segtab+blkbyt+1,x
		ldx	#0
zmovfr:		lda	$ffff,x
zmovto:		sta	$ffff,x
		inx
		bne	zmovfr
		inc	zmovfr+2
		inc	zmovto+2
		dey
		bpl	zmovfr			; move even # pages, so may move up to 256
						;  bytes more than needed
		lda	segment
		clc
		adc	#seglen			; go to next segment
		sta	segment
		jmp	segloop

relget:		lda	$ffff
		inc	relget+1
		bne	nc1
		inc	relget+2
nc1:		rts

getzwp:		jsr	relget			; top of word adjust loop
		sta	zwptr			; save address of word
		jsr	relget
		ldy	#0
		sta	zwptr+1
		ora	zwptr			; check if at end
		rts

segment:	dc.b	0			; current segment
zoffset:	dc.w	0			; offset to add to addresses
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;		       Relocation data table
;       	       ---------------------
;		We resolve Word locations First!
;
;	Things like	Lda $5000
;			Sta $5000
;			lda $5000,y
;			jsr $5000
;			jmp $5000
;
;	Well you get the Idea..
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
rtable:
		dc.w	w01+1
		dc.w	w02+1
		dc.w	w03+1
		dc.w	w04+1
		dc.w	w05+1
		dc.w	w06+1
		dc.w	w07+1
;		dc.w	w08+1
		dc.w	w09

		dc.w	w10
		dc.w	w11
		dc.w	w12
		dc.w	w13
		dc.w	w14
		dc.w	w15+1
		dc.w	w16+1
		dc.w	w17+1
		dc.w	w18+1
		dc.w	W19+1

		dc.w	w20+1
		dc.w	w21+1
		dc.w	w22+1
		dc.w	w23+1
		dc.w	w24+1
		dc.w	w25+1
		dc.w	w26+1
		dc.w	w27+1
		dc.w	w28+1
		dc.w	w29+1

		dc.w	w30+1
		dc.w	w31+1
		dc.w	w32+1
		dc.w	w33+1
		dc.w	w34+1
		dc.w	w35+1
		dc.w	w36+1
		dc.w	w37+1
		dc.w	w38+1
		dc.w	w39+1

		dc.w	w40+1
		dc.w	w41+1
		dc.w	w42+1
		dc.w	w43+1
		dc.w	w44+1
		dc.w	w45+1
		dc.w	w46+1
		dc.w	w47+1
		dc.w	w48+1
		dc.w	w49+1

		dc.w	w50+1
		dc.w	w51+1
		dc.w	w52+1
		dc.w	w53+1
		dc.w	w54+1
		dc.w	w55+1
		dc.w	w56+1
		dc.w	w57+1
		dc.w	w58+1
		dc.w	w59+1

		dc.w	w60+1
		dc.w	w61+1
		dc.w	w62+1
		dc.w	w63+1
		dc.w	w64+1
		dc.w	w65+1
		dc.w	w66+1
		dc.w	w67+1
		dc.w	w68+1
		dc.w	w69+1

		dc.w	w70+1
		dc.w	w71+1
		dc.w	w72+1
		dc.w	w73+1
		dc.w	w74+1
		dc.w	w75+1
		dc.w	w76+1
		dc.w	w77+1
		dc.w	w78+1
		dc.w	w79+1

		dc.w	w80+1
		dc.w	w81+1
		dc.w	w82+1
		dc.w	w83+1
		dc.w	w84+1
		dc.w	w85+1
		dc.w	w86+1
		dc.w	w87+1
		dc.w	w88+1
		dc.w	w89+1
		dc.w	w90+1

		dc.w	w91+1
		dc.w	w92+1
		dc.w	w93+1
		dc.w	w94+1
		dc.w	w95+1
		dc.w	w96+1
		dc.w	w97+1
		dc.w	w98+1
		dc.w	w99+1
		dc.w	w100+1

		dc.w	w101+1
		dc.w	w102+1
		dc.w	w103+1
		dc.w	w104+1
		dc.w	w105+1
		dc.w	w106+1
		dc.w	w107+1
		dc.w	w108+1
		dc.w	w109+1
		dc.w	w110+1

		dc.w	w111+1
		dc.w	w112+1
		dc.w	w113+1
		dc.w	w114+1
		dc.w	w115+1
		dc.w	w116+1
		dc.w	w117+1
		dc.w	w118+1
		dc.w	W119+1

		dc.w	w120+1
		dc.w	w121+1
		dc.w	w122+1
		dc.w	w123+1
		dc.w	w124+1
		dc.w	w125+1
		dc.w	w126+1
		dc.w	w127+1
		dc.w	w128+1
		dc.w	w129+1

		dc.w	w130+1
		dc.w	w131+1
		dc.w	w132+1
		dc.w	w133+1
		dc.w	w134+1
		dc.w	w135+1
		dc.w	w136+1
		dc.w	w137+1
		dc.w	w138+1
		dc.w	w139+1

		dc.w	w140+1
		dc.w	w141+1

		dc.w	0			; ok done with this part
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;Ok these are low Byte Locations..  only one byte changed!!
;   OK Resolving Low Byte's First
;
		dc.w	lb01+1
		dc.w	lb02+1
		dc.w	lb03+1
		dc.w	lb04+1
		dc.w	lb05+1
		dc.w	lb06+1

		dc.w	lb07+1
		dc.w	0			; ok done with this part

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;Now to resolve High Bytes...... Only one byte to change!
; Here is what is needed...  location of high byte in .word format
; Second thing needed is the low byte of the address you are wishing
;to adjust!
;
;
		dc.w	hb01+1
		dc.b	l25d0

        	dc.w	Hb02+1
		dc.b	g_handler

		dc.w	hb03+1
		dc.b	l2610

		dc.w	hb04+1
		dc.b	l2Efc

		dc.w	hb05+1
		dc.b	l29b8

        	dc.w	Hb06+1
		dc.b	l29f8

		dc.w	hb07+1
		dc.b	l29fc

	        dc.w	0			; ok we are done
		  dc.b 0			; ok we are done

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;End of relocation Table!!!
;
;
segtab:
		dc.w	rtable          ; address of relocater table
		dc.w	initz           ; assembly start address
		dc.w	0               ; relocate to address (filled in)
		dc.w	initz           ; absolute start address of block
		dc.w	zend-initz      ; size of block
		dc.w	0               ; destination of block (filled in)
		dc.w	0       	; END of segments

;
;
;
;
;
;
help_menu:
			.include	notice

			rts
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;   GET KEY  ROUTEEN	      
;this routeen get's one key and return it to the accumlator
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
get_key:   		stx 	$b6
	 		sty 	$b7
	 		jsr 	.a
	 		ldx 	$b6
	 		ldy 	$b7
	 		rts
.a:	    		lda 	$e420+5
	 		pha
	 		lda 	$e420+4
	 		pha
	 		rts


;
ver_num:
			pha
			lsr
			lsr
			lsr
			lsr
			jsr     .a
			lda	#'.'
			jsr	echo
			pla
			and     #$0f
.a:			cmp	#$0a
			bcs	.b
			ora	#$30
			bne	.c
.b:			adc	#$36
.c:         		jsr	echo
			rts


;       print the byte currently in Accum.
;       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

pr_byte:		ldx     #0
pr_card:		stx     fr0+1

pr_num:			sta	fr0
			jsr     ifp                     ;float it
			jsr     fasc                    ;to ascii
			ldy     #0
.prbloop:       	lda	(inbuff),y
			php
			and     #$7f                    ;last byte is negative
			jsr     echo
			iny
			plp
			bpl     .prbloop
			rts

;

;  prints: prints string with address in PR_PTR, length byte in 0th byte
;  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

prints:
echos:
pri2:
			ldy	#0
			lda	(pr_ptr),y              ;get length to print
			beq	.xpri                   ;exit, null string
			sta	.maxlth
			iny
			sty	.tempy

.pril:			ldy	.tempy
			lda	(pr_ptr),y
			jsr	echo
.prnext:		inc	.tempy
			dec	.maxlth
			bne	.pril
.xpri:			rts

.tempy:			dc.b	1
.maxlth:		dc.b	1

;
;------------
; PRINT BYTE 
;------------
echo:
sprint:			sta 	$b8
			lda 	#$04
			sta 	$034a
			stx 	$b6
			sty 	$b7
			ldx 	#$06
			lda 	$e400+1,x
			sta 	$b3
			lda 	$e400,x
			sta 	$b2
			lda 	$b8
			jsr 	.a
			ldx 	$b6
			ldy 	$b7
			lda 	#$0c
			sta 	$034a
			lda 	$b8
			rts
;
.a:			inc 	$b2
			jmp 	($b2)
			rts




;
;----------------------------
;   jsr  printsi             
;this prints an inline string
;     terminated by $ff      
;----------------------------
;        jsr   prints
echosi:
printsi:		pla
			sta 	pstr+1
			pla
			sta 	pstr+2
prsl:			inc 	pstr+1
			bne 	pstr
			inc 	pstr+2
pstr:			lda 	$ffff
			cmp 	#$ff
			beq 	estri
			jsr 	fast_output
			jmp 	prsl
estri:			lda 	pstr+2
			pha
			lda 	pstr+1
			pha
			rts
;
;-------------------------
;actual screen handler    
;screen offset definitions
;-------------------------
scr_offset:		dc.w	0
			dc.w	40
			dc.w	80
			dc.w	120
			dc.w	160
			dc.w	200
			dc.w	240
			dc.w	280
			dc.w	320
			dc.w	360
			dc.w	400
			dc.w	440
			dc.w	480
			dc.w	520
			dc.w	560
			dc.w	600
			dc.w	640
			dc.w	680
			dc.w	720
			dc.w	760
			dc.w	800
			dc.w	840
			dc.w	880
			dc.w	920
;
fast_output:
			sta	$5a
			lda	sc.redirect
			cmp	#print_p
			beq	.go_cio
.leo:
			lda 	$02ff   	; CONTROL 1 FLAG
			cmp 	#$00
			bne 	.leo

			lda	$5a
			cmp	#32
			bcc	.do_look
			cmp	#125
			bcc	.do_here
.do_look:		ldy	#0
.lookup:		lda	.char_table,y
			beq	.do_here
			cmp	$5a
			beq	.go_cio
			iny
			bne	.lookup


.go_cio:		lda	$5a
			jmp	putlocal


.do_here:		ldy	#0
			lda	$5d
			sta	($5e),y
			lda	$5a
			cmp	#$9b
			beq	.docr
.notcr:			jsr	.get_adr
			lda	$5a
			and	#$7f
			cmp	#32
			bcc	.add64
			cmp	#96
			bcc	.sub32
			jmp	.asis
.add64:			clc
			adc	#64
			jmp	.asis
.sub32:			sec
			sbc	#32
.asis:			bit	$5a
			bpl	.xxlate
			ora	#$80
.xxlate:		ldy	#0
			sta	($5e),y
			inc	$55
			inc	$63
			lda	$55
			cmp	#40
			bcs	.next_row
			iny
			lda	($5e),y
			sta	$5d
			ora	#$80
			ldx	752
			bne	.nocurs1
			sta	($5e),y
.nocurs1:		inc	$5e
			bne	.nooav
			inc	$5e+1
.nooav:			rts
.docr:			lda	#0
			sta	$63
.next_row:		lda	$52
			sta	$55
			inc	$54
			ldy	$54
			cpy	#24
			bcs	.scroll
			jsr	.get_adr
			ldy	#0
			lda	($5e),y
			sta	$5d
			ldx	752
			bne	.nocurs2
			ora	#$80
			sta	($5e),y
.nocurs2:		rts

.scroll:		dec	$54
			lda	$58
			sta	$68
			clc
			adc	#40
			sta	$5e
			lda	$58+1
			sta	$68+1
			adc	#0
			sta	$5e+1
			ldy	#0
			ldx	#3
.scloop:		lda	($5e),y
			sta	($68),y
			iny
			bne	.scloop
			inc	$5e+1
			inc	$68+1
			dex
			bne	.scloop
.scloop2:		lda	($5e),y
			sta	($68),y
			iny
			cpy	#152
			bcc	.scloop2
			lda	$58
			clc
			adc	#920&$ff
			sta	$5e
			lda	$58+1
			adc	#920/256
			sta	$5e+1
			ldy	#0
			tya
.clear:			sta	($5e),y
			iny
			cpy	#40
			bcc	.clear
			ldx	752
			bne	.nocurs3
			lda	#$80
			ldy	$55
			sta	($5e),y
.nocurs3:		lda	#0
			sta	$5d
			lda	$5e
			clc
			adc	$55
			sta	$5e
			lda	$5e+1
			adc	#0
			sta	$5e+1
			rts
.get_adr:		lda	$54
			asl
			tay
			lda	$58
			clc
			adc	scr_offset,y
			sta	$5e
			lda	$58+1
			adc	scr_offset+1,y
			sta	$5e+1
			lda	$5e
			clc
			adc	$55
			sta	$5e
			lda	$5e+1
			adc	#0
			sta	$5e+1
			rts
.char_table:
			dc.b	27,28,29,30,31,125,126,127
			dc.b	156,157,158,159,253,254,255,0


putlocal:
			ldx	#11
			stx	$0342
			ldx	#0
			stx	$0348
			stx	$0349
			jmp	$e456
;




;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;   OS on and off ROUTEEN	      
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;

os_off:
			SEI	
			LDA	PORTB
			AND	#$FE
			STA	PORTB
			CLI	
			RTS	
;
os_on:
			SEI	
			LDA	PORTB
			ORA	#1
			STA	PORTB
			CLI	
			RTS	
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;checks user security level pointed to by S_PTR to see if the
;bit specified in the A register is ON.  Returns MInus if the
;user doesn't have the specified security level.
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

seclvl:	    		sty	.tempy
			stx	.tempx
			cmp	#0			;sec lvl of zero?
			beq	.passed			;yes..they have it
			tay				;-1 for shifting
			lda	#128
			sta	.temp			;initialize mask
			lda	#0
			sta	.temp+1
			sta	.temp+2
			sta	.temp+3
			dey
			beq	.mask			;if it was one, no need to shift
.shloop:	   	lsr	.temp			;shift bits down to form mask
			ror	.temp+1
			ror	.temp+2
			ror	.temp+3
			dey
			bne	.shloop
			ldy	#0
.mask:			lda	.temp,y			;now, AND off all the bits
			and	(s_ptr),y
			sta	.temp,y
			iny
			cpy	#4
			bne	.mask
.check:			lda	.temp			;next, OR all the bytes...if any one
			ora	.temp+1			; is > 0, then they passed (whew!)
			ora	.temp+2
			ora	.temp+3
			cmp	#0
			beq	.failed
.passed:	   	lda	#0
			beq	.return
.failed:	   	lda	#$80
.return:	   	php
			ldy	.tempy
			ldx	.tempx
			plp
			rts

.tempy:	    		dc.b    0
.tempx:	    		dc.b    0
.temp:			dc.b    0,0,0,0


;     sets the bit specified (in the A register) of the security
;     level pointed to by S_PTR to a TRUE value.
;     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

setlvl:			sty	.tempy
			stx	.tempx
			cmp	#0			;sec lvl of zero?
			beq	.return			;yes..just exit (shouldn't happen!)
			tay				 ;-1 for shifting
			lda	#128
			sta	.temp			;initialize mask
			lda	#0
			sta	.temp+1
			sta	.temp+2
			sta	.temp+3
			dey
			beq	.mask			;if it was one, no need to shift
.shloop:	   	lsr	.temp			;shift bits down to form mask
			ror	.temp+1
			ror	.temp+2
			ror	.temp+3
			dey
			bne	.shloop
			ldy	#0
.mask:			lda	.temp,y			;now, OR the bit on
			ora	(s_ptr),y
			sta	(s_ptr),y
			iny
			cpy	#4
			bne	.mask
.return:	   	rts

.tempy:			dc.b    0
.tempx:			dc.b    0
.temp:			dc.b    0,0,0,0

;     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
set_g_handler:
			jsr	os_off
			mea	tsr,s_ptr
			lda	#gdevice
			jsr	setlvl
			jsr	os_on
			rts


win_end:		ds.b	0
;
;