;------------------------------------------------------------------------
;		Copyright 2010 Integrated Logic Systems
;                  Source Code is Copyright Stephen J. Carden
;
;
;			Please do not share this source!
;------------------------------------------------------------------------
;                             Set_crc.com
;
;	This is a program to to set a crc to make sure the value per
;	byte has not changed.
;
;		init	3/08/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
; 
;	Last updated 8/26/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,"Set_crc.com ",$9b
			.endm

;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; File revision history. Version Number in hex
;
file_ver:		equ   $12
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; 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   28
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; 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..no
;
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Gotta define if it so I can print what I need
r..crl:			equ	$7d
r..crlf:		equ	$9b
r..space:		equ	$20

l_frstscreenbyte:	equ	r..space
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; The language the output file is in. 
;
;
; 0	=	Undifined
; 1	=	English
; 2	=	German
;
r..language:		equ	1
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;
;
;
;
buff_l:  		equ    $9fff-copy_buff
;
;
;
;
eat_it_up:		.macro dest 
			lda	%1
			sta	tom_mccomb
			lda	%1+1
			sta	tom_mccomb+1
			lda	%1+2
			sta	tom_mccomb+2
			lda	%1+3
			sta	tom_mccomb+3
			lda	%1+4
			sta	tom_mccomb+4
			lda	%1+5
			sta	tom_mccomb+5
			lda	%1+6
			sta	tom_mccomb+6
			lda	%1+7
			sta	tom_mccomb+7
			lda	%1+8
			sta	tom_mccomb+8
			jsr	kiss_it
			.ENDM
;
nip:			.macro dest
			dc.b	%1-$7000+6 / 256
			dc.b	0
			dc.b	%1-$7000+6 & $ff
			.ENDM
;
;
;
;
			.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
readcli:

			ldx	#$00
			ldy	#LBUF    			; loading the offset into comtab
.a:			lda	(comtab),y
			cmp	#' '				; looking for the space in the parm line
			beq	.gotspacechar 			; got the space let'S see if there is anything we can use
			cmp	#$9b				; nope!!  no parm
			beq	.noparmerror 			; let'S see if they are playing with the consol

			iny
			jmp	.a



.noparmerror:		jmp	top	; based on info stored at the front of the file

.gotspacechar:		ldx	#$00

.lop:			iny
			inx
			lda	(comtab),y
			sta	parm_1,x
			stx	parm_1
			cmp	#$9b
			bne	.lop
;
;
;  Debug Routeen
;
			jsr	cr_lf
			jsr	cr_lf
			mea	parm_1,pr_ptr
			jsr	echos
			jsr	cr_lf
			jsr	cr_lf
;			rts

			jmp	top


;-------------------------------
;
;this is the fix code.
;for each of the fucked up
;commands!
;
;
;------------------------------
;
;N_S .BYTE $60
n_s_buf:		dc.w	parm_1,crc_sum
			dc.w	2
			nip	$7007

;------------------------------
;
ov_counter:		dc.b	0

;
;
;-------------------------------
outbuff:
	 		dc.b 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	 		dc.b 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
;
;
work_out: 		dc.b 0
	 		dc.w 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	 		dc.w 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
;
;
;
parm_1:			ds.b	80


from_kbd:		dc.b	80

tom_mccomb:
			dc.w	0
			dc.w	0
			dc.w	0
			dc.w	0
			dc.b	0
			dc.b	0,0,0,0,0



;
kiss_it:



			ldx	#disk2
			jsr	close
		 	mea	parm_1,s_ptr
			mea	outbuff,d_ptr
			jsr	move_str
			mea	outbuff,s_ptr
			mea	work_out,d_ptr
			jsr	toascii
			mea	work_out,fn_ptr
			jsr	open_in
			bmi	no_good
			jmp	version
no_good:
			ldx	#disk2
			jsr	close
			jmp	youdo
;
version:
			lda	#$00
			sta	f.sector
			sta	f.sector+1
			lda	#$00
			sta	offset
			ldx	#disk2
			jsr	point
			mea	buffer2,pr_ptr
			lda	buf_2
			sta	lnptr
			lda	buf_2+1
			sta	lnptr+1
			ldx	#disk2
			jsr	bget
			ldx	#disk2
			jsr	close
;
			lda	buffer2
			cmp	#$ff
			bne	v_fuck
			lda	buffer2+1
			cmp	#$ff
			bne	v_fuck
			lda	buffer3
			cmp	#$4c
			bne	v_fuck
			jmp	verry1
v_fuck:
			jsr	printsi
			dc.b	$9b," Invalid header",$9B,$9B,$FF
			rts
verry1:
			jmp	ok_good

;================================================================
;This is the header data structor
;
			.include	Hd-data


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


ok_good:
Tammy:
			ldx	#disk2
			jsr	close
			mea	work_out,fn_ptr
			ldx	#disk2
			jsr	open_updt
			lda	tom_mccomb+6    ;  7
			sta	f.sector
			lda	tom_mccomb+7    ; 8
			sta	f.sector+1
			lda	tom_mccomb+8    ; 9
			sta	offset
			ldx	#disk2


			jsr	point
			lda	tom_mccomb+2    ;3
			sta	pr_ptr
			lda	tom_mccomb+3    ;4
			sta	pr_ptr+1
			lda	tom_mccomb+4    ;5
			sta	lnptr
			lda	tom_mccomb+5    ;6
			sta	lnptr+1
			ldx	#disk2
			jsr	bput
			ldx	#disk2
			jsr	close

			jsr	printsi
			dc.b	$9b," Command CRC updated",$9B,-1
youdo:
			rts

;
;------------------------------
aux:      dc.b 0,0
;------------------------------
;you must jsr	to this vector for point, note, file lenght
;
pnfdata:		dc.b	"Dx:",$00
pnfdata1:		dc.b	$00,$00

pnf_work:
			stx	pnfdata1
			lda	fn_ptr
			sta	pnf_1+1
			lda	fn_ptr+1
			sta	pnf_1+2
			sty	pnfdata1+1
			ldy	#$01
pnf_1:			lda	$ffff,y
			sta	pnfdata+1
			ldy	pnfdata1+1
			ldx	pnfdata1
			lda	#$00
			sta	$034a,x
			lda	#$00
			sta	$034b,x
			lda	# low pnfdata
			sta	$0344,x
			lda	# high pnfdata
			sta	$0345,x
			jsr	c_iov
			rts
;
;
point:    ;           XIO 37  POINT
			lda	#$25
			stx	xio_39_hold
			sta	$0342,x
			lda	offset
			sta	$034c,x
			lda	f.sector
			sta	$034d,x
			lda	f.sector+1
			sta	$034e,x
			jsr	pnf_work
			ldx	xio_39_hold
			rts
f.sector:			dc.w 0
offset:			dc.b 0
note:     ;           XIO_38  NOTE
			stx	xio_39_hold
			lda	#$26
			sta	$0342,x
			jsr	pnf_work
			ldx	xio_39_hold
			lda	$034c,x
			sta	offset
			lda	$034d,x
			sta	f.sector
			lda	$034e,x
			sta	f.sector+1
xio_38e:		rts
npsave1:		dc.b	0,0,0
npsave:
			lda	offset
			sta	npsave1
			lda	f.sector
			sta	npsave1+1
			lda	f.sector+1
			sta	npsave1+2
			rts
npload:
			lda	npsave1
			sta	offset
			lda	npsave1+1
			sta	f.sector
			lda	npsave1+2
			sta	f.sector+1
			rts
;
f_length: ;           XIO#39 FILE LENGTH SPARTA ONLY
			stx	xio_39_hold
			lda	#$27
			sta	$0342,x
			jsr	pnf_work
			ldx	xio_39_hold
			lda	$034c,x
			sta	fnlng
			sta	f_lng
			lda	$034d,x
			sta	fnlng+1
			sta	f_lng+1
			lda	$034e,x
			sta	fnlng+2
			sta	f_lng+2
			rts
xio_39_hold: dc.b 0,0
fnlng:    dc.b 0,0,0
f_lng:    dc.b 0,0,0
;FN_PTR .WORD 0
lnptr:    dc.w 0
;
;----------------------------;
; lda	PR_PTR ; BUFFER
; sta	#<BUFFER+1
;
bget:
			lda	#$07
			sta	$0342,x
			lda	pr_ptr
			sta	$0344,x
			lda	pr_ptr+1
			sta	$0345,x
			lda	lnptr
			sta	$0348,x
			lda	lnptr+1
			sta	$0349,x
			lda	#$03
			sta	$034a,x
			lda	#$00
			sta	$034b,x
			jsr	c_iov
			rts
;---------------------
;  PR_PTR=BUFFER  FN_PTR=LEINGTH OF BUFFER
;---------------------
bput:
			lda	#$0b
			sta	$0342,x
			lda	pr_ptr
			sta	$0344,x
			lda	pr_ptr+1
			sta	$0345,x
			lda	lnptr
			sta	$0348,x
			lda	lnptr+1
			sta	$0349,x
			lda	#$03
			sta	$034a,x
			lda	#$00
			sta	$034b,x
c_iov:
			jsr	$e456
			lda	$0303
			tay
			cpy	#$81
			bcc	c_iov_exit
			jsr	drive_error
c_iov_exit:		rts
			rts
drive_error:
			pha
			jsr	printsi
			dc.b	$9b," Ciov Error # ",$FF
			pla
			jsr	pr_byte
			jsr	cr_lf
			rts
;
;-----------------------------
;  main body of the source
; code.
; to Tom mccomb and
;@ircular Logic!
;
;----------------------------
;
top:

			lda	parm_1
			cmp	#$04
			bcs	ok_
			jsr	printsi
			dc.b	$9b,$9b,$9b," Missing Dx:>Path>",$9B
			dc.b	" No Filename Needed",$9B,$9B,$FF
			rts
ok_:
			lda	u_node
			ldx	u_node+1
			sta	d_node
			stx	d_node+1
;			lda	ov_counter
;			cmp	#$01
;			bcc     .aa
;			jmp	.not
;.aa:
;			lda	from_kbd
;			cmp	$80
;			beq	.not1
;			jmp	.not
;
;
;.not1:			jsr	printsi
;			dc.b	$9b,$9b," Enter Node Number ",-1
;			jsr	get_card
;			sta	d_node
;			stx	d_node+1
;.not:
;


;
;       Copy the file in source_path/source_file to dest_path/source_file
;       -----------------------------------------------------------------
copy_file:
;
			mea	parm_1,s_ptr
			mea	_infile,d_ptr
			jsr	toascii
;    mea	PARM_2,S_PTR
;    mea	_OUTFILE,D_PTR
;   jsr	TOASCII
;
			mea	_infile,fn_ptr
			ldx	#disk2
			jsr	open_in
			bmi	_shutdown
_srcok:
;    mea	_OUTFILE,FN_PTR
;   LDX #$40    ;use #4 as target of copy
;   jsr	OPEN_OUT
;   bmi	_SHUTDOWN
_copyloop:
			ldx	#disk2
			jsr	blockread
			dc.w	copy_buff
			dc.w	buff_l
			bpl	_readok
			cpy	#136
			beq	_readok
_shutdown:		sty	_savey			;copy error - shut this
			ldx	#disk2			; baby down right now__
			jsr	close
;   LDX #$40
;   jsr	CLOSE
			ldy	_savey
;   jsr	ECHOSI
			jmp	next_run
			rts
;
first_call:		dc.b	0
;
_readok:
			lda	first_call
			cmp	#$00
			bne	cly
			jsr	set_pass
			inc	first_call
;
cly:
			ldx	#disk2
			lda	icbll,x
			sta	A_totbytes
			lda	icblh,x
			sta	A_totbytes+1
;
			jsr	wipe

;   LDX #$40
;   jsr	BLOCKWRITE ;pretty sleazy, huh?
;   .WORD COPY_BUFF ;I love self-modifying
;A_totbytes .WORD BUFF_L ; code__
;   bmi	_SHUTDOWN ;damn___write error!

			lda	A_totbytes
			cmp	#buff_l & $ff ;did we read a full buffer?
			bne	_done   ;nope, must be done!
			lda	A_totbytes+1
			cmp	#buff_l / 256
			bne	_done
			jmp	_copyloop
;
A_totbytes:		dc.w	buff_l

_done:			ldy	#1
			jmp	_shutdown
_idx:			dc.b	0
_savey:			dc.b	0
_infile:
			dc.b	0,0,0,0,0,0,0,0,0,0
			dc.b	0,0,0,0,0,0,0,0,0,0
			dc.b	0,0,0,0,0,0,0,0,0,0
			dc.b	0,0,0,0,0,0,0,0,0,0
			dc.b	0,0,0,0,0,0,0,0,0,0
			dc.b	0,0,0,0,0,0,0,0,0,0
			dc.b	0,0,0,0,0,0,0,0,0,0
			dc.b	0,0,0,0,0,0,0,0,0,0
_outfile:
			dc.b	0,0,0,0,0,0,0,0,0,0
			dc.b	0,0,0,0,0,0,0,0,0,0
			dc.b	0,0,0,0,0,0,0,0,0,0
			dc.b	0,0,0,0,0,0,0,0,0,0
			dc.b	0,0,0,0,0,0,0,0,0,0
			dc.b	0,0,0,0,0,0,0,0,0,0
			dc.b	0,0,0,0,0,0,0,0,0,0
			dc.b	0,0,0,0,0,0,0,0,0,0

;       Expand wildcarded name to create an output filename_
;       Input is source_file, dest_file; output is out_name_
;       ----------------------------------------------------
;
;
;
put256_out:
			ldy	#0
			sty	crc_sum
			sty	crc_sum+1
			sty	chk_sum
;
crc_loop:
			lda	(pr_ptr),y
			pha
			clc
			adc	chk_sum ;calc standard checksum
			sta	chk_sum
			pla
			eor	crc_sum+1 ;now do the CRC checksum
			tax
			lda	crc_hitable,x
			eor	crc_sum
			sta	crc_sum+1
			lda	crc_lotable,x
			eor	#0
			sta	crc_sum
			rts
;
;
;
crc_lotable:
			dc.b $00,$21,$42,$63,$84,$a5,$c6,$e7,$08,$29
			dc.b $4a,$6b,$8c,$ad,$ce,$ef,$31,$10,$73,$52
			dc.b $b5,$94,$f7,$d6,$39,$18,$7b,$5a,$bd,$9c
			dc.b $ff,$de,$62,$43,$20,$01,$e6,$c7,$a4,$85
			dc.b $6a,$4b,$28,$09,$ee,$cf,$ac,$8d,$53,$72
			dc.b $11,$30,$d7,$f6,$95,$b4,$5b,$7a,$19,$38
			dc.b $df,$fe,$9d,$bc,$c4,$e5,$86,$a7,$40,$61
			dc.b $02,$23,$cc,$ed,$8e,$af,$48,$69,$0a,$2b
			dc.b $f5,$d4,$b7,$96,$71,$50,$33,$12,$fd,$dc
			dc.b $bf,$9e,$79,$58,$3b,$1a,$a6,$87,$e4,$c5
			dc.b $22,$03,$60,$41,$ae,$8f,$ec,$cd,$2a,$0b
			dc.b $68,$49,$97,$b6,$d5,$f4,$13,$32,$51,$70
			dc.b $9f,$be,$dd,$fc,$1b,$3a,$59,$78,$88,$a9
			dc.b $ca,$eb,$0c,$2d,$4e,$6f,$80,$a1,$c2,$e3
			dc.b $04,$25,$46,$67,$b9,$98,$fb,$da,$3d,$1c
			dc.b $7f,$5e,$b1,$90,$f3,$d2,$35,$14,$77,$56
			dc.b $ea,$cb,$a8,$89,$6e,$4f,$2c,$0d,$e2,$c3
			dc.b $a0,$81,$66,$47,$24,$05,$db,$fa,$99,$b8
			dc.b $5f,$7e,$1d,$3c,$d3,$f2,$91,$b0,$57,$76
			dc.b $15,$34,$4c,$6d,$0e,$2f,$c8,$e9,$8a,$ab
			dc.b $44,$65,$06,$27,$c0,$e1,$82,$a3,$7d,$5c
			dc.b $3f,$1e,$f9,$d8,$bb,$9a,$75,$54,$37,$16
			dc.b $f1,$d0,$b3,$92,$2e,$0f,$6c,$4d,$aa,$8b
			dc.b $e8,$c9,$26,$07,$64,$45,$a2,$83,$e0,$c1
			dc.b $1f,$3e,$5d,$7c,$9b,$ba,$d9,$f8,$17,$36
			dc.b $55,$74,$93,$b2,$d1,$f0
crc_hitable:
			dc.b $00,$10,$20,$30,$40,$50,$60,$70,$81,$91,$a1,$b1,$c1
			dc.b $d1,$e1,$f1,$12,$02,$32,$22,$52,$42,$72,$62,$93,$83
			dc.b $b3,$a3,$d3,$c3,$f3,$e3,$24,$34,$04,$14,$64,$74,$44
			dc.b $54,$a5,$b5,$85,$95,$e5,$f5,$c5,$d5,$36,$26,$16,$06
			dc.b $76,$66,$56,$46,$b7,$a7,$97,$87,$f7,$e7,$d7,$c7,$48
			dc.b $58,$68,$78,$08,$18,$28,$38,$c9,$d9,$e9,$f9,$89,$99
			dc.b $a9,$b9,$5a,$4a,$7a,$6a,$1a,$0a,$3a,$2a,$db,$cb,$fb
			dc.b $eb,$9b,$8b,$bb,$ab,$6c,$7c,$4c,$5c,$2c,$3c,$0c,$1c
			dc.b $ed,$fd,$cd,$dd,$ad,$bd,$8d,$9d,$7e,$6e,$5e,$4e,$3e
			dc.b $2e,$1e,$0e,$ff,$ef,$df,$cf,$bf,$af,$9f,$8f,$91,$81
			dc.b $b1,$a1,$d1,$c1,$f1,$e1,$10,$00,$30,$20,$50,$40,$70
			dc.b $60,$83,$93,$a3,$b3,$c3,$d3,$e3,$f3,$02,$12,$22,$32
			dc.b $42,$52,$62,$72,$b5,$a5,$95,$85,$f5,$e5,$d5,$c5,$34
			dc.b $24,$14,$04,$74,$64,$54,$44,$a7,$b7,$87,$97,$e7,$f7
			dc.b $c7,$d7,$26,$36,$06,$16,$66,$76,$46,$56,$d9,$c9,$f9
			dc.b $e9,$99,$89,$b9,$a9,$58,$48,$78,$68,$18,$08,$38,$28
			dc.b $cb,$db,$eb,$fb,$8b,$9b,$ab,$bb,$4a,$5a,$6a,$7a,$0a
			dc.b $1a,$2a,$3a,$fd,$ed,$dd,$cd,$bd,$ad,$9d,$8d,$7c,$6c
			dc.b $5c,$4c,$3c,$2c,$1c,$0c,$ef,$ff,$cf,$df,$af,$bf,$8f
			dc.b $9f,$6e,$7e,$4e,$5e,$2e,$3e,$0e,$1e
;
;
;
;
cksum_lo:		dc.b	0
cksum_hi:		dc.b	0
crcsize:		dc.w 	0
crctemp:		dc.w 	0
crc_sum:		dc.w 	0
chk_sum:		dc.w 	0
;
real_sum:		dc.w 	0     ; real crc check sum
n_split:		dc.w 	0     ; split of node number
n_split1:		dc.w 	0     ; split of node number
;
;
;       Blockread from disk channel in X register.
;
;       call:   jsr	    blockread
;			       dc.w   buffer_address
;			       dc.w   number_of_bytes
;       ------------------------------------------
;
;
blockread:		lda	#ccgetch
			sta	iccom,x
			jmp	blockio
blockwrite:		lda	#ccputch
			sta	iccom,x
			jmp	blockio
blockio:		pla
			sta	pr_ptr
			pla
			sta	pr_ptr+1
			inc	pr_ptr
			bne	Anovf
			inc	pr_ptr+1
Anovf:			ldy	#0
			lda	(pr_ptr),y
			sta	icbal,x
			iny
			lda	(pr_ptr),y
			sta	icbah,x
			iny
			lda	(pr_ptr),y
			sta	icbll,x
			iny
			lda	(pr_ptr),y
			sta	icblh,x
			lda	pr_ptr
			clc
			adc	#3
			sta	pr_ptr
			lda	pr_ptr+1
			adc	#0
			pha
			lda	pr_ptr
			pha
			lda	icbll,x ;make sure not requesting
			ora	icblh,x ; zero bytes!
			beq	Aoops
			jmp	ciov
Aoops:			ldy #1      ;signal success and exit
			rts
;-----------------------------
;    ERROR NUMBER             
;-----------------------------
;
h_cardd:		dc.b	$00
;
; print a hex word value
; low byte in a reg x is high byte
;
h_card:			sta	h_cardd
			txa
			jsr	d_error
			lda	h_cardd
			jsr	d_error
			rts
;
;
d_error:		pha
			lsr
			lsr
			lsr
			lsr
			jsr	t8913
			pla
			and	#$0f
t8913:			cmp	#$0a
			bcs	t891b
			ora	#$30
			bne	t891d
t891b:			adc	#$36
t891d:			jsr	echo
			rts
;
set_pass:
			lda	d_node
			sta	copy_buff+13
			lda	d_node+1
			sta	copy_buff+14
			rts
;
;.byte ff ff 00 00 00 00 4c 00 00
; ver month day year
;   .word 0
;
u_node:			dc.w	l_dos_build

d_node:			dc.w	0

test_crc:		dc.w	0
;
block_w:		dc.w	0


wipe:
			mea	copy_buff,pr_ptr
			mea	copy_buff,fr0
			jsr	ifp
			jsr	fmove
			lda	A_totbytes
			sta	fr0
			lda	A_totbytes+1
			sta	fr0+1
			jsr	ifp
			jsr	fadd
			jsr	fpi
;
			lda	fr0
			sta	block_w
			lda	fr0+1
			sta	block_w+1
;
			jsr	printsi
			dc.b	$9b," START $",-1
			lda	# low copy_buff
			ldx	# high copy_buff
			jsr	h_card
			jsr	printsi
			dc.b	" END $",-1
			lda	block_w
			ldx	block_w+1
			jsr	h_card
;   RTS
			jsr	cr_lf
;
;   jsr	GET_KEY
;
			ldy	#$00
;
;       $FFFF
wp1:			lda	(pr_ptr),y
;   jsr	ECHO
			jsr	crc_loop
			iny
			cpy	#$00
			bne	wp1
			inc	pr_ptr+1 ;WP1+2
			ldy	#$00
			lda	pr_ptr+1 ;WP1+2
			cmp	block_w+1
			bcc	wp1
			ldy	#$00
wp2:			lda	(pr_ptr),y
;   jsr	ECHO
			jsr	crc_loop
			iny
			cpy	block_w
			bcc	wp2
			rts
;
next_run:
			jsr	printsi
			dc.b	$9b,$9b," Crc =$",-1
			lda	crc_sum
			ldx	crc_sum+1
			jsr	h_card
			jsr	cr_lf
			jsr	cr_lf
;  RTS
;
;
fix_elite:
			eat_it_up  n_s_buf
			rts
;
;-----------------------------
;This does a c/r to the screen
;-----------------------------

cr_lf:			lda	#$9b
			jsr	echo
			rts



;-----------------------------
;CHANGES THE CHARTER TO UPCASE
;-----------------------------
upcase
			cmp	#$61
			bcc	.a
			cmp	#$7a
			bcs	.a
			sbc	#$1f
.a:			rts

;
;---------------------------
;this one make's a nice tone
;---------------------------
bell
			sta	.data
			sty	.data+1
			stx	.data+2
			ldy	#$af
			lda	#$14
			sta	$d200
.a:			sty	$d201
			lda	#$00
			sta	$14
.b:			lda	$14
			cmp	#$02
			bcc	.b
			dey
			cpy	#$a0
			bcs	.a
			lda	.data
			ldy	.data+1
			ldx	.data+2
			rts
.data:			dc.b	$00,$00,$00
;
;
;
;----------------------------
;   jsr  printsi             
;this prints an inline string
;     terminated by $ff      
;----------------------------
;        jsr   prints
;       dc.b "print this",$9B,$FF
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
;
echo:
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
;



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

open_in:  		lda	#4
			jmp	do_open

open_out:		lda	#8
			jmp	do_open

open_app:		lda	#9
			jmp	do_open

open_updt:		lda	#12
			jmp	do_open

open_dir:		lda	#6
			jmp	do_open

open_raw:		lda	#20     	;open raw directory
			jmp	do_open

do_open:
			pha 		        ;open filespec pointed to by fn_ptr
			txa 		        ;
			pha
			jsr	close		;make sure device is closed
			pla
			tax
			pla
			sta	icaux1,x
			lda	#ccopen
			sta	iccom,x
			lda	fn_ptr
			sta	icbal,x
			lda	fn_ptr+1
			sta	icbah,x
			lda	#80
			sta	icbll,x
			lda	#0
			sta	icblh,x
			lda	#128		;for long directory (shouldn't hurt??)
			sta	icaux2,x
			jmp 	ciov


close:			lda	#ccclose
			sta	iccom,x
			jmp 	ciov

;       Move string pointed to by s_ptr to string pointed to by d_ptr
;       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


move_str:       	ldy	    #0
                	lda	(s_ptr),y               ;get lth byte
                	tay                             ;go backwards
.loop:          	lda	(s_ptr),y
                	sta	(d_ptr),y
                	cpy     #0
                	beq     .done
                	dey
                	jmp     .loop
.done:          	rts

;     Make an ASCII ($9b terminated) string out of a lth-byte string
;     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

toascii:        	ldy	#0
                	lda	(s_ptr),y               ;get lth byte
                	sta	.lth
                	beq     .null
                	iny
                	inc     .lth
.loop:          	lda	(s_ptr),y
                	dey
                	sta	(d_ptr),y
                	iny
                	iny
                	cpy	.lth
                	bne	.loop
.done:          	ldy	.lth
                	dey
.rtn:           	lda	#$9b
                	sta	(d_ptr),y
                	rts
.null:          	ldy	#0
                	beq	.rtn

.lth:			dc.b    1

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;Prints a byte or a card to the screen
;
;
pr_byte:
			ldx	#$00
pr_card:
			sta	fr0
			stx	fr0+1
			lda	#$00
			sta	cix
			jsr	ifp
			jsr	fasc
			ldy	#$00
.aprbloop:
			lda	(inbuff),y
			php
			and	#$7f
			iny
			jsr	echo
			plp
			bpl	.aprbloop
			rts

;       gets a CARD value - returned in A/X
;       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

get_card:       	jsr     get_str
                 	dc.w   .work
                 	dc.b   5,1,0
                	tay
                	iny
                	lda     #$9b                    ;install eol
                	sta     .work,y
                	mea     .work,inbuff
                	lda     #1
                	sta     cix
                	jsr     afp                     ;ascii --> floating pt.
                	bcs     .default
                	jsr     fpi                     ;floating --> integer
                	bcs     .default
                	lda     fr0
                	ldx     fr0+1
                	rts
.default:       	lda     #0
                	tax
                	rts

.work:          ds.b    10
;
;
;
;    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
;
;       get_str    gets an input line into the specified string.
;
;       input:  address of string in in_ptr
;               A - max length
;               X - mask (0=alpha/numeric, 1=numeric)
;               Y - allow return key only (1=yes)
;
;     length of inputted string is returned in the 0th position (and A)
;    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

get_str:        	pla                             ;entry here, parms on stack
                	sta     pr_ptr
                	pla
                	sta     pr_ptr+1
                	ldy     #1
                	lda     (pr_ptr),y              ;get address lo
                	sta     in_ptr
                	iny
                	lda     (pr_ptr),y              ;   address hi
                	sta     in_ptr+1
                	iny
                	lda     (pr_ptr),y              ;   length byte
                	sta     .gsa
                	iny
                	lda     (pr_ptr),y              ;   mask
                	sta     .gsx
                	iny
                	lda     (pr_ptr),y              ;   return allowed?
                	sta     .gsy
                	lda     pr_ptr                  ;now, correct stack
                	clc
                	adc     #5
                	sta     pr_ptr
                	lda     pr_ptr+1
                	adc     #0
                	pha
                	lda     pr_ptr
                	pha
                	lda     .gsa
                	ldx     .gsx
                	ldy     .gsy
                	jmp     get_string

.gsa:           	dc.b    0
.gsx:           	dc.b    0
.gsy:           	dc.b    0


get_string:		cmp     #83                     ;max < 83?
			bcc     .gsentry                ;yes
			lda     #80
.gsentry:		sta     .maxlth                 ;save max length
			stx     .mask
			sty     .return

 
			lda     in_ptr
			sta     .address                ;hold address of string
			lda     in_ptr+1                ; to input into
			sta     .address+1
			lda     #0
			sta     .instr                  ;zero length byte

.gsloop:		jsr     get_key                 ;get a keypress
			cmp     #'\'                   ;can't allow this key!
			beq     .gsloop                 ;yes, ignore
			cmp     #$9b                    ;carriage return?
			bne     .nogs                   ;nope
			jmp     .gscr                   ;yes
.nogs:			cmp     #14                     ;treat ^N as a C/R
			bne     .not14
			jmp     .gscr
.not14:			cmp     #126                    ;backspace?
			beq     .bspace
			cmp     #30
			beq     .bspace
			cmp     #24                     ;^X?
			bne     .nowipe
			jmp     .wipeout
.nowipe:		and     #$7f                    ;strip inverse bit
			sta     .key                    ;hold it

;       now, see if it falls within requested mask
;       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


			ldx     .mask                   ;get mask
			beq     .alphanum
			cpx     #1
			beq     .numeric

.alphanum:		cmp     #32                     ; < space?
			bcc     .gsloop                 ;yes, ignore
			cmp     #'z'+1                  ; > 'z'
			bcs     .gsloop                 ;yes, ignore
			jmp     .gsstore

.numeric:		cmp     #'0'                    ; < '0'?
			bcc     .gsloop                 ;yes, ignore
			cmp     #'9'+1                  ; > '9'
			bcs     .gsloop                 ;yes, ignore
			jmp     .gsstore

.gsstore:		lda     .instr                  ;get length byte
			cmp     .maxlth
			beq     .gsloop                 ;ignore it..at
			bcs     .gsloop                 ; max length now
			tay
			iny
			lda     .key
			cmp     #32                     ;is it a space?
			bne     .notspc                 ;nope
			cpy     #1                      ;1st char in line?
			bne     .notspc
			jmp     .gsloop                 ;yes..don't allow it
.notspc:		sta     .instr,y                ;save key into string
			inc     .instr                  ;increase length
;			bit     hide                    ;hide input?
;			bpl     .nohide
;			lda     #'*'
;			bne     .showit
;.nohide:		lda     .key
.showit:		jsr     echo
			lda     .maxlth                 ;one-key input?
			cmp     #1
			bne     .nohot                  ;nope
			lda     .instr
			cmp     #1                      ;1 byte entered?
			bne     .nohot
;			lda     u_flags
;			and     #f_hotkey               ;user want hotkeys?
;			beq     .nohot                  ;nope..
			jmp     .gscr                   ;yes - auto carriage return!

.nohot:			jmp     .gsloop                 ;keep cookin..

.bspace:		lda     .instr                  ;can't backspace
			cmp     #0                      ; if no length!
			bne     .nt0
			jmp     .gsloop
.nt0:			dec     .instr                  ;-1 to length byte
			lda     #126                    ;output a BSpace
			jsr     echo
			jmp     .gsloop

.wipeout:		lda     .instr                  ;can't backspace if no length
			bne     .wt0
			jmp     .gsloop
.wt0:			dec     .instr                  ;-1 to length byte
			lda     #126                    ;output a BSpace
			jsr     echo
			jmp     .wipeout                ;go until line cleared

.gscr:			lda     .instr                  ;get length
			bne     .nonull                 ;its not null
			ldx     .return                 ;allow return only?
			bne     .nonull                 ;yes..exit
			jmp     .gsloop                 ;nope..ignore it

;       done, so move our string into where they want it.
;       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

.nonull:		lda     s_ptr
			sta     .holds
			lda     s_ptr+1
			sta     .holds+1
			lda     d_ptr
			sta     .holdd
			lda     d_ptr+1
			sta     .holdd+1
			mea     .instr,s_ptr
			lda     .address
			sta     d_ptr
			lda     .address+1
			sta     d_ptr+1
			jsr     move_str                ;move to their area..
			lda     .holds
			sta     s_ptr
			lda     .holds+1
			sta     s_ptr+1
			lda     .holdd
			sta     d_ptr
			lda     .holdd+1
			sta     d_ptr+1
;			lda     #0
;			sta     hide
			lda     .instr                  ;return with lth in A
			rts


.address:		ds.b    2
.holds:			ds.b    2
.holdd:			ds.b    2
.maxlth:		ds.b    1
.mask:			ds.b    1
.return:		ds.b    1
.key:			ds.b    1
.instr:			ds.b    86

;------------------------------
;   GET KEY  ROUTEEN           
;this routeen get's one key and
;return it to the accumlator   
;------------------------------
;
get_key:		stx	$b6
			sty	$b7
			jsr	g_fff
			ldx	$b6
			ldy	$b7
			rts
g_fff:			lda	$e420+5
			pha
			lda	$e420+4
			pha
			rts
;
;  prints: prints string with address in PR_PTR, length byte in 0th byte
;  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

prints: 	        ldy     #$80
			bne     pri2
echos:          	ldy     #0

pri2:           	sty     pr_mode
                	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
                	bit     pr_mode
                	bmi     .prloc
;			eor	#$80
                	jsr     echo
                	jmp     .prnext
.prloc:
;			eor	#$80
			jsr     echo
.prnext:        	inc     .tempy
                	dec     .maxlth
                	bne     .pril
.xpri:          	rts

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

pr_mode:		dc.b	0



;
win_end:		ds.b	0
;
	 		.org  $6000
copy_buff:		ds.b	0
;
;
