;------------------------------------------------------------------------
;		Copyright 2010 Integrated Logic Systems
;                  Source Code is Copyright Stephen J. Carden
;
;
;			Please do not share this source!
;------------------------------------------------------------------------
;                              Makedir.com
;
;	This is a program makes recursive directors
;	recursive dir maker	06/05/2010	sjc
;
;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/28/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,"Makedir.com ",$9b
			.endm

;
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; File revision history. Version Number in hex
;
file_ver:		equ	$13
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; 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 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	$ff
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; 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
 
tammy:
			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

			mea	fname,s_ptr
			mea	parm_1,d_ptr
			jsr	concat			; add a junk filename

			mea	parm_1,s_ptr
			mea	filename,d_ptr		;move our path
			jsr	toascii


			jsr	make_path


			lda	consol
			cmp	#$07
			beq	.no_tell		;beq

			
		
			jsr	printsi		
			dc.b	$9b," this is my cli to parm Code"
			dc.b	$9b,"Parm_1 =",-1
			mea	parm_1,pr_ptr
			jsr	echos

			jsr	cr_lf
			mea	path1,pr_ptr
			jsr	echos


			jsr	printsi
			dc.b	" #",-1
			lda	totalpath
			jsr	pr_byte

			jsr	printsi
			dc.b	$9b,$9b,-1
			jsr	get_key
			jsr	printsi
			dc.b	" Any Key to Continue",$9b,$9b,-1
			rts

.no_tell:
			jmp	top

cli.crunch:		jmp	$0000

parm_errors:
			lda	#$7d
			jsr	echo
			jsr	tammy-3

			jsr	printsi
			dc.b	$9B,$9B
			dc.b	" "
			dc.b	<+128>,"Syntax"
			dc.b	" for use:",$9b
			dc.b	" Makedir Dn:>Path",$9b
			dc.b	" Makedir Dn:>real>dos>command",$9b
			dc.b	" Makedir Dx:>A>B>C>D>E>F>G>H>I>J>ECT>",$9b,$9b
			dc.b	" This Program will make Directories",$9b
			dc.b	"  for you up to the length of the ",$9b
			dc.b	"  command line buffer. 64 Bytes",$9b

			dc.b	$9b
			dc.b	-1
			rts
;





parm_1:			ds.b	80
parm_2:			ds.b	80
parm_3:			ds.b	80
in_str:         	ds.b    80              ;
instr:          	ds.b    80              ;
fname:			dc.b	11,">wmsarp.sjc"
;
my_count:		ds.b	1

tammy_c:		dc.w	0
steve1:			dc.b	26


filename:		ds.b	80


totalpath:		dc.b	0
path1:			ds.b	128


;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;Make Path
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
make_path:
			ldx	#0
			ldy	#1
.a:			lda	parm_1,y
			cmp	#'>'
			bne	.b
			lda	#$00			;'%'
			inc	totalpath
			inx

.b:			cmp	#'.'
			beq	.strip
			cpy	parm_1
			beq	.strip
			sta	path1,y
			sty	path1
			iny
			lda	#$9b
			sta	path1,y
			beq	.a
			bne	.a
.strip:
			lda	totalpath
			cmp	#$00
			beq	.done
			ldy	path1
.loop:			dey
			lda	path1,y
			cmp	#$00			;'%'
			bne	.loop
.done:			sty	path1
			lda	#$9b
			sta	path1,y
			ldy	#4
			lda	path1,y
			cmp	#$00			;'%'
			bne	.exit
			lda	#'>'
			sta	path1,y
			ldy	totalpath
			dey
			sty	totalpath
.exit:
			rts
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;next Path
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

next_path:
			lda	totalpath
			cmp	#$00
			bne	.next
			rts
.next:
			ldy	#$00
.a:			iny
			lda	path1,y
			cpy	path1
			beq	.done
			cmp	#$00			;'%'
			bne	.a
			lda	#'>'
			sta	path1,y
			ldy	totalpath
			dey
			sty	totalpath
			rts
.done:
			lda	#$00
			sta	totalpath
			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

;     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


;       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


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

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

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

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



cr_lf:			lda	#$9b
			jsr	fast_output
			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
                	jsr     fast_output
.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
;  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

echosE:
                	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			; stop printing if a zero is present
                	jsr     fast_output
.prnext:        	inc     .tempy
                	dec     .maxlth
                	bne     .pril
.xpri:          	rts

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



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

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


;==========================================================
;Start of file.
;
;==========================================================
top:
			lda	#$7d
			jsr	echo
			jsr	tammy-3

			jsr	printsi
			dc.b	$9b
			dc.b	<+128>,""
			dc.b	$9B
			dc.b	<+128>,"|    Recursive Directory Builder   |"
			dc.b	$9B
			dc.b	<+128>,"|       by Stephen J. Carden       |"
			dc.b	$9B
			dc.b	<+128>,""
			dc.b	$9B,-1

			jsr	cr_lf
			jsr	cr_lf
			jsr	printsi
			dc.b	"Creating directory!",$9b,-1



create:
			ldx	#disk_2
			jsr	close
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;          open  2,8,0,fn
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
			ldx	#disk_2
			lda	#$03		
			sta	iccom,x
			lda	#$08
			sta	icaux1,x
			lda	#$00
			sta	icaux1+1,x
			lda	# low filename
			sta	icbal,x
			lda	# high filename
			sta	icbal+1,x
			jsr	cio

			cpy	#150
			beq	makedir
			cpy	#1
			bne	error
			jmp	deletefile
error:
			tya
			jsr	sys_error
			ldx	#disk_2
			jsr	close
			rts



makedir:
			lda	totalpath
			cmp	#$01
			beq	.onemore
			cmp	#$00
			bne	.do_dir
			jmp	create
.onemore:
			jsr	.next_dir
			lda	#$00
			sta	totalpath
			jmp	create
.do_dir:
			jsr	.next_dir
			jsr	next_path
			jmp	create

.next_dir:
			jsr	printsi
			dc.b	156,"=>                                   "
			dc.b	156,"=>",$FF

			mea	path1,pr_ptr
			jsr	echosE

			ldx	#disk_2
			jsr	close
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;	xio  42,2,0,0,path1+1
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
			ldx	#disk_2
			lda	#42
			sta	iccom,x
			lda	#$00
			sta	icaux1,x
			lda	#$00
			sta	icaux1+1,x
			lda	# low path1+1
			sta	icbal,x
			lda	# high path1+1
			sta	icbal+1,x
			jsr	cio

			ldx	#disk_2
			jsr	close

			jsr	printsi
			dc.b	" ok!",$FF
			rts
;


;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;	xio  33,2,0,0,fn
;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
deletefile:
			ldx	#disk_2
			jsr	close
			ldx	#disk_2
			lda	#33	; xio 33
			sta	iccom,x
			lda	#$00
			sta	icaux1,x
			lda	#$00
			sta	icaux1+1,x
			lda	#low filename
			sta	icbal,x
			lda	#high filename
			sta	icbal+1,x
			jsr	cio
			ldx	#disk_2
			jsr	close
			jsr	printsi
			dc.b	"Done",$9B,$9B,$FF
			rts

;       Generic system error routine
;       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~


sys_error:		save                            ;save all registers
                	sty     .temp                   ;save error status
       			jsr	printsi
			dc.b    $9b,$9b
			dc.b	"System Error: ",-1
			lda     .temp
			jsr	pr_byte
			jsr	cr_lf
			restore                         ;restore registers
			rts

.temp:			dc.b    1

close:			lda 	#ccclose
			sta 	iccom,x
			jmp 	ciov

win_end:		ds.b	0
;
;
