;------------------------------------------------------------------------
;		Copyright 2010 Integrated Logic Systems
;                  Source Code is Copyright Stephen J. Carden
;
;
;			Please do not share this source!
;------------------------------------------------------------------------
;                              Version.com
;
;	This is a program to peak a byte and display it to the screen
;		init				2/24/2010	sjc new design
;		added hex delimeter 		2/25/2010	sjc		
;		added new code for registered user 2/26/2010	sjc
;		set up a lookup table to handle language printing
;		adding more Languages		4/15/2010	sjc
;		bug fix.. Looking in the wrong spot of name  5/1/2010	sjc
;
;	Updated the screen Print Utility so it will work with the exp-80
; This change will also help "Print P:"		6/19/2010	sjc
;
;Also added code for Control+1 pause of screen to the high speed screen
;handling.		8/24/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   12,"filename.ext",$9b
			dc.b   12,"Version.com ",$9b
			.endm

;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; File revision history. Version Number in hex
;
file_ver:		equ   $19
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; 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..no
;
;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Gotta define if it can be relocated
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
; 3	=	Hungarian
; 4	=	Welsh
; 5	=	Dutch
; 6	=	Polish
; 7	=	Swedish
; 8	=	French
; 9	=	not defined yet
; 10	=	not defined yet
;
;
;
;
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

			ldx	#disk1
			jsr	close
			ldx	#disk2
			jsr	close

			lda	comtab
			CLC 
			adc	# low ZCRNAME
			sta	cli.crunch+1
			lda	comtab+1
			adc	# high ZCRNAME
			sta	cli.crunch+2
			jsr	cli.crunch
			bne	.get_parm1		; nothing there
			jmp	parm_errors

.get_parm1:
			lda	comtab
			CLC 
			adc	# low COMFNAM
			sta	s_ptr
			lda	comtab+1
			adc	# high COMFNAM
			sta	s_ptr+1
			mea	parm_1,d_ptr
			jsr	tostr


			jsr	cli.crunch
			bne	.get_parm2
			jmp	.exit

.get_parm2:		lda	comtab
			CLC 
			adc	# low COMFNAM
			sta	s_ptr
			lda	comtab+1
			adc	# high COMFNAM
			sta	s_ptr+1
			mea	parm_2,d_ptr
			jsr	tostr


			jsr	cli.crunch
			bne	.get_parm3
			jmp	.exit

.get_parm3:		lda	comtab
			CLC 
			adc	# low COMFNAM
			sta	s_ptr
			lda	comtab+1
			adc	# high COMFNAM
			sta	s_ptr+1
			mea	parm_3,d_ptr
			jsr	tostr
			lda	parm_3		; let us see if we have a output filename
			cmp	#6		; is it long enough to be useful
			bcc	.exit		; nope we will use the default

			mea	parm_3,s_ptr
			mea	filename,d_ptr
			jsr	toascii

.exit:
			lda	consol
			cmp	#consol_any
			beq	.no_tell
		
			jsr	printsi		
			dc.b	$9b," this is my cli to parm_1 thur parm_3 Code"
			dc.b	$9b,"Parm_1 =",-1
			mea	parm_1,pr_ptr
			jsr	echos

			jsr	printsi
			dc.b	$9b,"Parm_2 =",-1
			mea	parm_2,pr_ptr
			jsr	echos

			jsr	printsi
			dc.b	$9b,"Output File =",-1
			mea	parm_3,pr_ptr
			jsr	echos

			jsr	printsi
			dc.b	$9b,$9b,-1

.no_tell:
			jmp	VERSION

cli.crunch:		jmp	$0000

parm_errors:

			jsr	printsi
			dc.b	$9B,$9B
			dc.b	" Syntax for use:",$9b
			dc.b	" Version Dn:>dir>fname.ext [parm1] [parm2]",$9b
			dc.b	" Parm1 = /P or /H",$9b
			dc.b	" if Parm1 = /P output to Printer",$9b
			dc.b	" if Parm1 = /H Hardcopy",$9b
			dc.b	" /H must have Parm2",$9b
			dc.b	" Parm2 = dx:>path>filename.ext",$9b
			dc.b	" append text to!",$9b

			dc.b	$9b,-1
			RTS

;-------------------------------
;
INVAL:			dc.b	26," Has an invalid Com Header"
;
SPLIT:			dc.b	38,"--------------------------------------"
;
;
PRN:			dc.b	"P:",$9B,0
;
FILENAME:		dc.b	"D1:>version.lst",$9B,0
			ds.b	80
;
parm_1:			ds.b	80			  ;passed by DOSshell
parm_2:			ds.b	80			 ;passed by DOSshell
parm_3:			ds.b	80
in_str:			ds.b	128			  ;
instr:			ds.b	128			  ;

;
;
WHERE:			dc.b	0

lng.LOW:		dc.b	lng.Undifined &$ff
			dc.b	lng.English &$ff
			dc.b	lng.German &$ff
			dc.b	lng.Hungarian &$ff
			dc.b	lng.Welsh &$ff
			dc.b	lng.Dutch &$ff
			dc.b	lng.Polish &$ff
			dc.b	lng.Swedish &$ff
			dc.b	lng.French &$ff

lng.HIGH:		dc.b	lng.Undifined /256
			dc.b	lng.English /256
			dc.b	lng.German /256
			dc.b	lng.Hungarian /256
			dc.b	lng.Welsh /256
			dc.b	lng.Dutch /256
			dc.b	lng.Polish /256
			dc.b	lng.Swedish /256
			dc.b	lng.French /256
;
;<<<< Note >>>> These are length byte strings that are highlighted
;
;
lng.Undifined:		dc.b	9,"Undefined"

lng.English:		dc.b	7,"English"

lng.German:		dc.b	6,"German"

lng.Hungarian:		dc.b	9,"Hungarian"

lng.Welsh:		dc.b	5,"Welsh"

lng.Dutch:		dc.b	5,"Dutch"

lng.Polish:		dc.b	5,"Polish"

lng.Swedish:		dc.b	7,"Swedish"

lng.french:		dc.b	6,"French"



;
VERSION:

			lda	PARM_1
			cmp	#$04
			bcs	OK
			jsr	printsi
			dc.b	$9B,$9B," Usage: Version D1:>path>filename.ext",$9B,$9B,-1
			RTS
OK:
			lda	PARM_2+4
			cmp	#'/'
			bne	OKP
			lda	PARM_2+5
			jsr	UPCASE
			cmp	#'P'
			beq	OKO
			cmp	#'H'
			bne	OKP
;
;
OKM:			lda	#$01
OKO:			sta	WHERE
;
OKP:

			mea	PARM_1,S_PTR
			mea	BROWSE_FILE,D_PTR
			jsr	TOASCII
			ldx	#disk2
			jsr	CLOSE
			mea	BROWSE_FILE,FN_PTR
			ldx	#disk2
			jsr	OPEN_IN
			bmi	VERRY2
			bne	OKOPEN
			beq	OKOPEN
VERRY2:			jmp	FILE_NOT_FOUND
OKOPEN:
			lda	#$00
			sta	fil.sector
			sta	fil.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_header.error
			lda	BUFFER2+1
			cmp	#$FF
			bne	v_header.error
			lda	BUFFER3
			cmp	#$4C
			bne	v_header.error
			lda	PARM_2+4 ;0,dx:/P
			cmp	#'/'
			bne	WERRY1
			lda	PARM_2+5
			jsr	UPCASE
			cmp	#'P'
			beq	ZERRY1
			cmp	#'H'
			beq	ZERRY1
			cmp	#'C'
			beq	watcom
;
WERRY1:			jmp	VERRY1
;
ZERRY1:			jmp	VER_PRINT
;
watcom:
			rts
;
PERRY1:			jmp	P_ERROR
;
v_header.error:
			lda	WHERE
			cmp	#$00
			beq	PERRY1
;
			jsr	cr_lf
			jsr	cr_lf
			mea	INVAL,PR_PTR
			jsr	ECHOS
			jsr	cr_lf
			jsr	cr_lf
			RTS
VERRY1:
			lda	irf.Com_name
			cmp	#12
			beq	file_ok
			jsr	printsi
			dc.b	$9b,$9b
			dc.b	"Invalid Header Format Version Check Aborted!"
			dc.b	$9b,$9b,-1

file_ok:

			jsr	printsi
			dc.b	$9b
			dc.b	"Internal Name "
			dc.b	-1
			mea	irf.Com_name,pr_ptr
			jsr	echos.nospace

			jsr	printsi
			dc.b	" Serial #"
			dc.b	-1
			lda	irf.serialnum
			ldx	irf.serialnum+1
			jsr	pr_card
			jsr	cr_lf


.nono:			lda	irf.rcopy
			cmp	#$00
			bne	.reg
			jsr	printsi
			dc.b	<+128>,"Not"
			dc.b	" "
			dc.b	-1
.reg:
			jsr	printsi
			dc.b	"Registered",-1

			lda	irf.rcopy
			cmp	#$00
			beq	.go_auth
			cmp	#$81
			beq	.go_site
			cmp	#$01
			bne	.go_auth
			jsr	printsi
			dc.b	" to :",-1
			jmp	.nom

.go_site:		jsr	printsi
			dc.b	" Site :"
			dc.b	-1
.nom:
			mea	irif.register_name,pr_ptr
			jsr	echos.unify
			mea	irif.register_name,pr_ptr
			jsr	echosinv

			jsr	printsi
			dc.b	$9b,-1

.go_auth:

			jsr	printsi
			dc.b	$9b,"Author  :",-1

			mea	irif.Authors_name,pr_ptr

			ldy	#$00
			lda	(pr_ptr),y
			cmp	#$00
                        beq     .no_aut

			jsr	echosinv



.no_aut:		jsr	printsi
			dc.b	$9b,-1

			jsr	printsi
			dc.b	"Company :",-1

			mea	irif.company_id,pr_ptr

			ldy	#$00
			lda	(pr_ptr),y
			cmp	#$00
                        beq     .no_co

			jsr	echosinv

.no_co:
			jsr	printsi
			dc.b	$9b,-1

			jsr	printsi
			dc.b	"Compiler:",-1

			lda	irf.c_compiler
			cmp	#$00
			bne	.a
			jsr	printsi
			dc.b	<+128>,"Unknown"
			dc.b	$9b,-1
			jmp	.exit
.a:			cmp	#$01
			bne	.b
			jsr	printsi
			dc.b	<+128>,"xasm"
			dc.b	$9b,-1
			jmp	.exit
.b:
			cmp	#$02
			bne	.c
			jsr	printsi
			dc.b	<+128>,"Mac/65"
			dc.b	$9b,-1
			jmp	.exit

.c:
			cmp	#$05
			bne	.d
			jsr	printsi
			dc.b	<+128>,"c65"
			dc.b	$9b,-1
			jmp	.exit

.d:
			cmp	#$06
			bne	.exit
			jsr	printsi
			dc.b	<+128>,"Action"
			dc.b	$9b,-1

.exit:
reloc:
			lda	irf.relocation
			cmp	#$01
			bne	.a
			jsr	printsi
			dc.b	<+128>,"Relocation within Code!"
			dc.b	$9b,-1
.a:
			jsr	printsi
			dc.b	"RealDos Support Build ",-1
			lda	irf.dos_build
			ldx	irf.dos_build+1
			jsr	pr_card

			jsr	printsi
			dc.b	$9b,"Language:",-1

;===========================================
; this reflects how many languages we have
;===========================================

			lda	irf.language
			cmp	#lng.HIGH-lng.LOW &$ff				
			bcc	.eng
			jsr	printsi
			dc.b	<+128>,"Language Not Set in file"
			dc.b	$9b,-1
			jmp	.dono

.eng:			ldy	irf.language
			lda	lng.LOW,y
			sta	pr_ptr
			lda	lng.HIGH,y
			sta	pr_ptr+1
			jsr	echosinv
			jsr	cr_lf

.dono:
			jsr	printsi
			dc.b	$9b
			dc.b	"Org's at "
			dc.b	<+128>,"$"
			dc.b	-1
			lda	irf.c_start
			ldx	irf.c_start+1
			jsr	pr_hex_card
			jsr	printsi
			dc.b	" End at "
			dc.b	<+128>,"$"
			dc.b	-1

			lda	irf.eof
			ldx	irf.eof+1
			jsr	pr_hex_card

			lda	irf.c_crc+1
			cmp	irf.dos_build+1
			bne	.crc

			lda	irf.c_crc
			cmp	irf.dos_build
			bne	.crc

			jsr	printsi
			dc.b	$9b
			dc.b	<+128>," CRC Not Set"
			dc.b	-1
			jmp	.notcrc


.crc:			jsr	printsi
			dc.b	$9b,"Internal CRC "
			dc.b	<+128>,"$"
			dc.b	-1
			lda	irf.c_crc
			ldx	irf.c_crc+1
			jsr	pr_hex_card

.notcrc:
			jsr	printsi
			dc.b	$9b,$9b,"Version ",$FF
			lda	irf.c_ver
			jsr	VER_NUM
			jsr	printsi
			dc.b	" last updated ",$FF
			lda	irf.c_month
			jsr	PR_BYTE
			lda	#'/'
			jsr	ECHO
			lda	irf.c_day
			jsr	PR_BYTE
			lda	#'/'
			jsr	ECHO
			lda	irf.c_year
			ldx	irf.c_year+1
			jsr	pr_card
			jsr	cr_lf
			jsr	cr_lf
			RTS
;
FILE_NOT_FOUND:
			ldx	#disk2
			jsr	CLOSE
			jsr	printsi
			dc.b	$9B,$9B," File not found!",$9B,-1
			RTS
;
BROWSE_FILE:		ds.b	80
;
;================================================================
;This is the header data structor
;
			.include	Hd-data


;
; this proccess the version
;of a .com
;
;-----------------------------
;
VER_NUM:
			PHA
			LSR
			LSR
			LSR
			LSR
			jsr	.a
			lda	#'.'+128
			jsr	ECHO
			PLA
			and	#$0F
.a:			cmp	#$0A
			bcs	.b
			ORA	#$30
			bne	.c
.b:			adc	#$36
.c:
			eor	#$80
			jsr	ECHO
			RTS
;
;
;------------------------------
;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	$E456
			RTS
;
;
;		   XIO 37  POINT
POINT:
			lda	#$25
			stx	XIO_39_HOLD
			sta	$0342,X
			lda	OFFSET
			sta	$034C,X
			lda	fil.sector
			sta	$034D,X
			lda	fil.sector+1
			sta	$034E,X
			jsr	PNF_WORK
			ldx	XIO_39_HOLD
			RTS

fil.sector:		dc.w	0
OFFSET:			dc.b	0
XIO_39_HOLD:		dc.b	$00,$00
FNLNG:			dc.b	0,0,0
F_LNG:			dc.b	0,0,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	$E456
			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




;
; generic close
close:
			lda	#$0c
			sta	$0342,x
			jsr	$e456	
			rts

;
;
;
FR_HOLD:  		dc.b	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
;
;
;
FR_BYTE:		ldx	#0
FR_CARD:		stx	FR0+1
FR_NUM:			sta	FR0
			jsr	IFP	 ;float it
			jsr	FASC	;to ascii
			LDY	#0
.a:			lda	(INBUFF),Y
			PHP
			and	#$7F	;last byte is negative
			sta	FR_HOLD+1,Y ;JSR ECHO
			INY
			STY	FR_HOLD
;
			PLP
			BPL .a
			RTS
;------------------------------
;
;
;
;------------------------------
;
OUT_BUFF:
			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
			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
			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
			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
;
SLASH:			dc.b	1,"/"
;
file.dater:		dc.b	14," Last Updated "
;
VER_POP_D:		dc.b	13," Version 1.0 "
;
C_LOW:
			dc.b	 UNK &$ff, MAC &$ff, IASM &$ff, I65 &$ff, ACT &$ff, SASM &$ff, S65 &$ff
C_HIGH:
			dc.b	 UNK /256, MAC /256, IASM /256, I65 /256, ACT /256, SASM /256, S65 /256
;
;
MAC:
			dc.b	20," Compiler = Mac\65  "
IASM:
			dc.b	20," Compiler = Xasm IBM"
I65:
			dc.b	20," Compiler = C\65 ibm"
ACT:
			dc.b	20," Compiler = Action  "
SASM:
			dc.b	20," Compiler = Xasm St "
S65:
			dc.b	20," Compiler = C\65 St "
UNK:
			dc.b	20," Compiler = Unknown "
;
;
;
;
;
VER_POP:
			PHA
			LSR
			LSR
			LSR
			LSR
			jsr	.a

			PLA
			and	#$0F
			cmp	#$0A
			bcs	.b
			ORA	#$30
			bne	.c
.b:			adc	#$36
.c:			sta	VER_POP_D+12
			RTS
;
.a:			cmp	#$0A
			bcs	.d
			ORA	#$30
			bne	.e
.d:			adc	#$36
.e:			sta	VER_POP_D+10
			RTS
;
;------------------------------
;
;
;
;
;
;------------------------------
;
PRINT_V:
;
;			LDY	PARM_1
;			DEY
;			STY	PARM_1
			mea	PARM_1,S_PTR
			mea	OUT_BUFF,D_PTR
			jsr	MOVE_STR

			lda	irf.c_ver
			jsr	VER_POP
			mea	VER_POP_D,S_PTR
			mea	OUT_BUFF,D_PTR
			jsr	CONCAT
;
			mea	file.dater,S_PTR
			mea	OUT_BUFF,D_PTR
			jsr	CONCAT
;
			lda	irf.c_month
			jsr	FR_BYTE
			mea	FR_HOLD,S_PTR
			mea	OUT_BUFF,D_PTR
			jsr	CONCAT
;
			mea	SLASH,S_PTR
			mea	OUT_BUFF,D_PTR
			jsr	CONCAT
;
			lda	irf.c_day
			jsr	FR_BYTE
			mea	FR_HOLD,S_PTR
			mea	OUT_BUFF,D_PTR
			jsr	CONCAT
;
			mea	SLASH,S_PTR
			mea	OUT_BUFF,D_PTR
			jsr	CONCAT

			lda	irf.c_year_short
			jsr	FR_BYTE
			mea	FR_HOLD,S_PTR
			mea	OUT_BUFF,D_PTR
			jsr	CONCAT
			RTS

P_ERROR:
			ldx	#disk2
			jsr	CLOSE
			lda	WHERE
			cmp	#'P'
			bne	P_ERR
			mea	PRN,FN_PTR
			jmp	OPYT
P_ERR:
			mea	FILENAME,FN_PTR
OPYT:			ldx	#disk2
			jsr	OPEN_APP
			bmi	F_ERROR

			mea	SPLIT,PR_PTR
			ldx	#disk2
			jsr	PRINTSD

			mea	PARM_1,PR_PTR
			ldx	#disk2
			jsr	PRINTSD
			mea	INVAL,PR_PTR
			ldx	#disk2
			jsr	PRINTSD

F_ERROR:		ldx	#disk2
			jsr	CLOSE
			RTS
;
VER_PRINT:
			jsr	PRINT_V
			ldx	#disk2
			jsr	CLOSE
			lda	WHERE
			cmp	#'P'
			bne	P_E
			mea	PRN,FN_PTR
			jmp	OYPT
P_E:
			mea	FILENAME,FN_PTR
OYPT:			ldx	#disk2
			jsr	OPEN_APP
			bmi	F_ERROR
			mea	SPLIT,PR_PTR
			ldx	#disk2
			jsr	PRINTSD
			mea	OUT_BUFF,PR_PTR
			ldx	#disk2
			jsr	PRINTSD
			ldx	#disk2
			jsr	CLOSE
			RTS

PRINT_csv:
			mea	PARM_1,S_PTR
			mea	OUT_BUFF,D_PTR
			jsr	MOVE_STR

			lda	irf.c_ver
			jsr	VER_POP
			mea	VER_POP_D,S_PTR
			mea	OUT_BUFF,D_PTR
			jsr	CONCAT
;
			mea	file.dater,S_PTR
			mea	OUT_BUFF,D_PTR
			jsr	CONCAT
;
			lda	irf.c_month
			jsr	FR_BYTE
			mea	FR_HOLD,S_PTR
			mea	OUT_BUFF,D_PTR
			jsr	CONCAT
;
			mea	SLASH,S_PTR
			mea	OUT_BUFF,D_PTR
			jsr	CONCAT
;
			lda	irf.c_day
			jsr	FR_BYTE
			mea	FR_HOLD,S_PTR
			mea	OUT_BUFF,D_PTR
			jsr	CONCAT
;
			mea	SLASH,S_PTR
			mea	OUT_BUFF,D_PTR
			jsr	CONCAT

			lda	irf.c_year_short
			jsr	FR_BYTE
			mea	FR_HOLD,S_PTR
			mea	OUT_BUFF,D_PTR
			jsr	CONCAT
			RTS

; 
; 
;--------------------------------------------
;printsi Routeen macro             
;this is a slow print to the screen
;usage jsr	printsi
;    .byte $9b," string to be printed",$ff
;--------------------------------------------
;
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
;





;-----------------------------
; Print Hex Numbers to screen byte or card
;-----------------------------
;
;
; print a hex word value
; low byte in a reg x is high byte
;
pr_hex_card:		sta	.h_cardd
			txa
			jsr	pr_hex_byte
			lda	.h_cardd
			jsr	pr_hex_byte
			rts
;
.h_cardd:		dc.b	$00
;
pr_hex_byte:		pha
			lsr
			lsr
			lsr
			lsr
			jsr	.a
			pla
			and	#$0f
.a:			cmp	#$0a
			bcs	.b
			ora	#$30
			bne	.c
.b:			adc	#$36
.c:
			eor	#$80
			jsr	echo
			rts

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

.bytecard:		ds.b	10



cr_lf:
			jsr	printsi
			dc.b	$9b,-1
			rts

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

echos:
			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
			cmp	#$00
			beq	.xpri
			jsr	echo
.prnext:		inc	.tempy
			dec	.maxlth
			bne	.pril
.xpri:			rts

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

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

echosinv:
			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
			eor	#$80			; turn it inverse
			jsr	echo
.prnext:		inc	.tempy
			dec	.maxlth
			bne	.pril
.xpri:			rts

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


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

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

			ldy	.tempy
			lda	(pr_ptr),y
			jsr	upcase
			sta	(pr_ptr),y
			jmp	.prnext

.pril:			ldy	.tempy
			cpy	#$02
			bcc	.prnext
			lda	(pr_ptr),y		; changing the bytes to lower case.
			jsr	locase
			sta	(pr_ptr),y

			cmp	#' '			; look for the space
			bne	.prnext
			inc	.tempy
			dec	.maxlth
			ldy	.tempy			
			lda	(pr_ptr),y		; make the char right after the space upper case
			jsr	upcase
			sta	(pr_ptr),y


.prnext:		inc	.tempy
			dec	.maxlth
			bne	.pril
.xpri:			rts

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



;  prints: prints string with address in PR_PTR, length byte in 0th byte
; and supress the space at the end.
;  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

echos.nospace:
			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
			cmp	#' '
			beq	.prnext
			eor	#$80			; turn it inverse
			jsr	echo
.prnext:		inc	.tempy
			dec	.maxlth
			bne	.pril
.xpri:			rts

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







;	  print a string to device in X register
;	  from the string pointed to by pr_ptr.
;	  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

printsd:		ldy	#0
			lda	(pr_ptr),y      ;install EOL at end of string
			tay
			iny
			lda	#$9b
			sta	(pr_ptr),y
			lda	#ccputrec
			sta	iccom,x
			lda	pr_ptr
			clc
			adc	#1		;offset past length byte
			sta	icbal,x
			lda	pr_ptr+1
			adc	#0
			sta	icbah,x
			lda	#80
			sta	icbll,x
			lda	#0
			sta	icblh,x         ;zero hi byte of length
			jmp	ciov            ;get the line

;       Search the string pointed to by S_PTR for the substring
;       pointed to by D_PTR.  Returns a 0 if substring not found.
;       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

substr:			ldy	#0
			lda	(s_ptr),y
			sta	.s_lth
			lda	(d_ptr),y
			sta	.d_lth
			lda	s_ptr
			sta	.comp+1
			lda	s_ptr+1
			sta	.comp+2
			lda	d_ptr
			sta	.get+1
			lda	d_ptr+1
			sta	.get+2
			lda	#1
			sta	.loc
			ldy	#0
			ldx	#0
			jsr	.up_str
			jsr	.up_sub

.comp:			lda	$ffff,y
			jsr	upcase
			sta	.temp
.get:			lda	$ffff,x
			jsr	upcase
			cmp	.temp
			beq	.match
.nomatch:		ldx	#1
			inc	.loc
			jsr	.up_str
			jmp	.comp
.match:			jsr	.up_sub
			jsr	.up_str
			jmp	.comp

.up_str:		iny
			cpy	.s_lth
			bcc	.xup
			beq	.xup
			pla
			pla
			lda	#0
.xup:			rts

.up_sub:		inx
			cpx	.d_lth
			bcc	.xsub
			beq	.xsub
			pla
			pla
			lda	.loc
.xsub:			rts

.temp:			dc.b    0
.loc:			dc.b    0
.s_lth:			dc.b    0
.d_lth:			dc.b    0
;
;
;  Upcase
;
;
upcase:			cmp	#'a'
			bcc	.xupcase
			cmp	#'z'+1
			beq	.xupcase
			bcs	.xupcase
			sec
			sbc	#32
.xupcase:		rts


locase:			cmp     #'A'
			bcc     .xlocase
			cmp     #'Z'+1
			beq     .xlocase
			bcs     .xlocase
			clc
			adc     #32
.xlocase:		rts



;     Make a length-byte string from an ASCII ($9b terminated) string
;     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

tostr:			ldy	#0
.tfe:			lda	(s_ptr),y	;find end of string
			beq	.gotend
			cmp	#$9b
			beq	.gotend
			iny
			bne	.tfe
.gotend:		sty	.lth		;save length
			cpy	#0
			beq	.rtn
			ldy	#0
.loop:			lda	(s_ptr),y
			iny
			sta	(d_ptr),y
			cpy	.lth
			bcc	.loop
.rtn:			ldy	#0
			lda	.lth
			sta	(d_ptr),y
			rts

.lth:			dc.b    1

;
;       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



;       Return the length of string at s_ptr in accumulator
;       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

length:			ldy	#0
			lda	(s_ptr),y
			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



;       Concatenate the string at s_ptr onto the end of string at d_ptr
;       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

concat:			ldy	#0
			lda	(s_ptr),y		;get source lth
			sta	.srclth
			beq	.end			;null string..exit
			lda	(d_ptr),y		;get dest lth
			sta	.desty
			inc	.srcy
			inc	.desty
			ldy	#1			;always start at 1 on
			sty	.srcy			; the source string
.loop:			ldy	.srcy
			lda	(s_ptr),y		;get byte from source
			ldy	.desty
			sta	(d_ptr),y		;store into dest
			lda	.srcy
			cmp	.srclth			;end of string?
			beq	.end			;yes
			inc	.srcy
			inc	.desty			;up indexes
			bne	.loop			;and	keep going
.end:			ldy	#0
			lda	(d_ptr),y		;up the length byte
			clc				; of the dest string
			adc	.srclth
			sta	(d_ptr),y
			rts

.srcy:			dc.b	1
.desty:			dc.b    1
.srclth:		dc.b    1



win_end:		ds.b	0
;
;
