;------------------------------------------------------------------------
;
;		Copyright 2006 Intergraded Logic Systems
;                  Source Code is Copyright Stephen J. Carden
;
;
;			Please do not share this source!
;------------------------------------------------------------------------
;       (General hard disk formatter for real.dos SpartaDOS v1.0 
;
;------------------------------------------------------------------------
;                               Real.dos
;			This program is to replace
;		      		percom.com
;
;	Code History.     Init design,   may 19, 2010
;       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;------------------------------------------------------------------------
; 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,"Percom.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   9
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; the day in dec for the first time this revision 
;was compiled
c_day:			equ   7
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; 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 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				;   Where the program Starts in memory.
;

win_start:
header_info:
			.include	header			; this reads info out of the header and displays to screen



			LDY	#LBUF

.comp:			lda	(comtab),y
			cmp	#$9b
			beq	.exit
			cmp	#' '
			beq	.cont
			iny
			jmp	.comp


.exit:			jmp	error




.cont:
			iny
	 		iny
        		LDA	(comtab),Y
			sbc	#48
	 		sta	dunit
			CMP	#$01			;$2F
			bcc	.ea
			cmp	#$09+1
			bcs	.ea
			beq	.c
			bne	.c

.ea:			jmp	error
	
.c:		
;
START_IT:
			LDA	COMTAB  ; calc address of SIO 
			SEC 
			SBC	# low lsio
			STA	XSIO+1
			LDA	COMTAB+1
			SBC	# high lsio
			STA	XSIO+2
			lda	#$6c
			sta	xsio


get_sector_count:
			lda	#$31
			sta	$300
			lda	dunit
			sta	$301
			lda	#'N'				;$4e
			sta	$0302
			lda	#$40
			sta	$0303
			lda	# low huh_data
			sta	$0304
			lda	# high huh_data
			sta	$0305
			lda	#$0c
			sta	$0308
			lda	#$00
			sta	$0309
			sta	$030a
			sta	$030b
			jsr	XSIO
			lda	$0303
			cmp	#$01
			beq	.huh_1

			rts
.huh_1:
.tam:
			jsr	printsi
			dc.b	"       Drive configuration table        ",$9B,$9B,$FF
			lda	huh_data
			jsr	sub_error
			jsr	printsi
			dc.b	"number of tracks",$9B,$FF
			lda	huh_data+1
			jsr	sub_error
			jsr	printsi
			dc.b	"Step rate! normaly 1",$9B,$FF
			lda	huh_data+2
			jsr	sub_error
			jsr	printsi
			dc.b	"Sector/Track high byte",$9B,$FF
			lda	huh_data+3
			jsr	sub_error
			jsr	printsi
			dc.b	"Sector/Track LOW byte",$9B,$FF
			lda	huh_data+4
			jsr	sub_error
			jsr	printsi
			dc.b	"Max head number",$9B,$FF
			lda	huh_data+5
			jsr	sub_error
			jsr	printsi
			dc.b	"Density -0=s, 4 double, 8 High",$9B,$FF
			lda	huh_data+6
			jsr	sub_error
			jsr	printsi
			dc.b	"Byte/sector h byte 1=256 0=128",$9B,$FF
			lda	huh_data+7
			jsr	sub_error
			jsr	printsi
			dc.b	"Byte/sector l byte 0=256 1=128",$9B,$FF
			lda	huh_data+8
			jsr	sub_error
			jsr	printsi
			dc.b	"Drive present flag -returns $ff",$9B,$FF
			lda	huh_data+9
			jsr	sub_error
			jsr	quote

			lda	huh_data+9
			jsr	echo

			jsr	printsi
			dc.b	"' not used",$9B,$FF
			lda	huh_data+10
			jsr	sub_error

			jsr	quote

			lda	huh_data+10
			jsr	echo

			jsr	printsi
			dc.b	"' not used",$9B,$FF
			lda	huh_data+11
			jsr	sub_error
			jsr	quote

			lda	huh_data+11
			jsr	echo


			jsr	printsi
			dc.b	"' not used",$9B
			dc.b	$FF
			rts
sub_error:
			sta	.dan_k
			jsr	printsi
			dc.b	" $",$FF
			lda	.dan_k
			jsr	drive_error
			jsr	printsi
			dc.b	"  ",$FF
			rts
;
.dan_k:			dc.b	0
huh_data:		dc.b	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
huh_data_d:		dc.b	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0



quote:			lda	#'''
			jsr	echo
			rts


calc_sector_count:
			jsr	get_sector_count
			lda	#$ff
			sta	sector_density
			lda	huh_data+5
			cmp	#$08
			bne	.a
			lda	#$02
			sta	percom_density
			jmp	.b
.a:			lda	#$01
			sta	percom_density
			lda	huh_data+5
			cmp	#$00
			bne	.b
			lda	#$80
			sta	sector_density

.b:
			lda	huh_data+2
			cmp	#$00
			bne	.c
			lda	huh_data+3
			cmp	#$00
			bne	.c
			lda	#$ff
			sta	huh_data+2
			sta	huh_data+3

.c:			lda	huh_data+2
			sta	sector_per_trac+1			
			lda	huh_data+3
			sta	sector_per_trac

			lda	huh_data
			cmp	#$03
			bcs	.d
			lda	# low 1
			sta	huh_data
.d:			lda	huh_data
			sta	heads
			lda	#$00
			sta	heads+1


			jsr	zfr0
			lda	heads
			sta	fr0
			lda	heads+1
			sta	fr0+1
			jsr	ifp
			lda	#$00
			sta	cix
			jsr	fmove
			lda	sector_per_trac
			sta	fr0
			lda	sector_per_trac+1
			sta	fr0+1
			lda	#$00
			sta	cix
			jsr	ifp
			jsr	fmult
			jsr	fmove
			lda	percom_density
			sta	fr0
			lda	percom_density+1
			sta	fr0+1
			lda	#$00
			sta	cix
			jsr	ifp
			jsr	fmult
			jsr	fpi
			lda	fr0
			ldx	fr0+1
			sta	real_sector_count
			stx	real_sector_count+1
			sta	end_sector
			stx	end_sector+1
			rts

heads:			dc.w	0
sector_per_trac:	dc.w	0
percom_density:		dc.w	0
real_sector_count:	dc.w	0
end_sector:		dc.w	0
sector_density:		dc.b	-1			; $ff = dd   $80 = sd

XSIO:			jMP	siov

;
drive_error:
			pha
			lsr
			lsr
			lsr
			lsr
			jsr	.a
			pla
			and	#$0f
.a:			cmp	#$0a
			bcs	.b
			ora	#$30
			bne	.c
.b:			adc	#$36
.c:			jsr	ECHO
			rts
;

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



error:
			jsr	printsi
			dc.b	$9b,$9b
			dc.b	"Usage: Percom Dn:"
			dc.b	$9b,$9b,-1
			rts






; 
; 
;================================= 
;       print/input routines 
;================================= 
; 
;       Print character 
;       --------------- 
; in: 
;       A       = character to print 
; out: 
;       all registers preserved 
; 
ECHO:			JSR	SAVER
			JSR	ZOUT
			JMP	RESALL
; 
ZOUT:			STA	ZTEMP+1
			LDA	$0347
			PHA 
			LDA	$0346
			PHA 
ZTEMP:			LDA	#0
			LDX	#0	;1      ; force NO output to PRINT Dn: 
			RTS 
; 
; 
;       Print text 
;       ---------- 
; out: 
;       all registers preserved 
; notes: 
;       This print routine will print all characters 
;       following the JSR PRINT until a delimiter of 
;       -1 ($FF) is reached. PRINT will return to the 
;       point one byte beyond the delimiter. 
; 
printsi:		JSR	SAVER
			TSX 
			LDA	$0105,X
			STA	ZOCH+1
			LDA	$0106,X
			STA	ZOCH+2
; 
			LDY	#1
ZOCH:			LDA	$FFFF,Y
			CMP	#$FF
			BEQ	ZECHO
			JSR	ECHO
			INY 
			BNE	ZOCH
ZECHO:			TYA 
			CLC 
			ADC	$0105,X
			STA	$0105,X
			LDA	$0106,X
			ADC	#0
			STA	$0106,X
			JMP	RESALL
; 
; 
;       SAVE & RESTORE registers 
;       ------------------------ 
; 
SAVER:			PHP 
			PHA 
			PHA 
			PHA 
			PHP 
			PHA 
			TXA 
			PHA 
			TSX 
			LDA	$0109,X
			STA	$0105,X
			LDA	$0107,X
			STA	$0109,X
			LDA	$0101,X
			STA	$0107,X
			LDA	$0108,X
			STA	$0104,X
			LDA	$0106,X
			STA	$0108,X
			TYA 
			STA	$0106,X
			PLA 
			TAX 
			PLA 
			PLP 
			RTS 
; 
RESALL:			PLA 
			TAY 
			PLA 
			TAX 
			PLA 
			PLP 
			RTS 
; 
; 
; 
;       Get character 
;       ------------- 
; out: 
;       A       = character (all others preserved) 
; 
GET_KEY:		JSR	ZGETCH
ZCH:			LDA	#0
			RTS 
; 
ZGETCH:			JSR	SAVER
			JSR	ZPHG
			STA	ZCH+1
			JMP	RESALL
; 
ZPHG:			LDA	$E425
			PHA 
			LDA	$E424
			PHA 
			RTS 
; 
; 
;;--------------------------------------------------------------------
; 
; 
;       Get line 
;       -------- 
; in: 
;       XA      = buffer address 
;       Y       = maximum number of characters 
; out: 
;       @XA     = data, return ends input, a backspace works 
;       all registers preserved 
; notes: 
;       This routine will first clear the input window 
; 
GETLINE:		JSR	SAVER
			STY	ZCNT
			STA	ZSTOR+1
			STX	ZSTOR+2
;	
			LDY	#0
			LDA	#$20
ZCLX:			JSR	ZSTOR
			INY	
			CPY	ZCNT
			BNE	ZCLX
;	
			LDY	#0
ZINLP:			JSR	GET_KEY
			CMP	#$7E
			BEQ	ZBS
			CMP	#$9B
			BEQ	ZENDZ
			CPY	ZCNT
			BEQ	ZINLP
			JSR	ECHO
			JSR	ZSTOR
			INY	
			BNE	ZINLP
;	
ZBS:			CPY	#0
			BEQ	ZINLP
			JSR	ECHO
			DEY	
			LDA	#$20
			JSR	ZSTOR
			BNE	ZINLP
ZENDZ:			JMP	RESALL
;	
ZSTOR:			STA	$FFFF,Y
			RTS	
ZCNT:			dc.b	0
; 
; 



win_end:		ds.b	0
;
;


;
