;;; ============================================================
;;;
;;; COPY - Copy changing command for ProDOS-8
;;;
;;; Usage: COPY pathname1,pathname2
;;;
;;; Inspiration from COPY.ALL by Sandy Mossberg, Nibble 6/1987
;;;
;;; ============================================================

        .include "apple2.inc"
        .include "more_apple2.inc"
        .include "prodos.inc"

;;; ============================================================

        .org $4000

        ;; NOTE: Assumes XLEN is set by PATH

        ;; Point BI's parser at the command execution routine.
        lda     #<execute
        sta     XTRNADDR
        page_num2 := *+1         ; address needing updating
        lda     #>execute
        sta     XTRNADDR+1

        ;; Mark command as external (zero).
        lda     #0
        sta     XCNUM

        ;; Set accepted parameter flags

        lda     #PBitsFlags::FN1 | PBitsFlags::FN2 ; Filenames
        sta     PBITS
        lda     #0              ; See below for why PBitsFlags::SD is not used
        sta     PBITS+1

        clc                     ; Success (so far)
        rts                     ; Return to BASIC.SYSTEM

;;; ============================================================

        FN1REF := $D6
        FN2REF := $D7

        FN1INFO := $2EE
        FN2BUF  := $4200
        DATABUF := $4600
        DATALEN = $6000 - DATABUF

execute:
        ;; Fix relative paths. If PREFIX is not emptu, this is not needed.
        ;; If PREFIX is empty, then relative paths will fail. Specifying
        ;; PBitsFlags::SD is the usual fix for BI commands that take paths
        ;; but while it will make FN1 absolute if needed it applies the
        ;; same change to FN2 (nothing or prepending) without inspecting
        ;; FN2. So REL,/ABS becomes /PFX/REL,/PFX//ABS (oops!) and
        ;; /ABS,REL remains /ABS,REL (still relative!).

        jsr     get_prefix
        lda     VPATH1
        ldx     VPATH1+1
        jsr     fix_path
        lda     VPATH2
        ldx     VPATH2+1
        jsr     fix_path

        ;; Get FN1 info
        lda     #$A
        sta     SSGINFO
        lda     #GET_FILE_INFO
        jsr     GOSYSTEM
        bcs     rts1

        ;; Reject directory file
        lda     FIFILID
        cmp     #$F             ; DIR
        bne     :+
        lda     #$D             ; FILE TYPE MISMATCH
        sec
rts1:   rts
:

        ;; Save FN1 info
        ldx     #$11
:       lda     SSGINFO,x
        sta     FN1INFO,x
        dex
        bpl     :-

        ;; Open FN1
        lda     HIMEM           ; Use BI's general purpose buffer
        sta     OSYSBUF
        lda     HIMEM+1
        sta     OSYSBUF+1
        lda     #OPEN
        jsr     GOSYSTEM
        bcs     rts1
        lda     OREFNUM
        sta     FN1REF

        ;; Copy FN2 to FN1
        ptr1 := $06
        ptr2 := $08
        lda     VPATH1
        sta     ptr1
        lda     VPATH1+1
        sta     ptr1+1
        lda     VPATH2
        sta     ptr2
        lda     VPATH2+1
        sta     ptr2+1
        ldy     #0
        lda     (ptr2),y
        tay
:       lda     (ptr2),y
        sta     (ptr1),y
        dey
        bpl     :-

        ;; Get FN2 info
        lda     #GET_FILE_INFO
        jsr     GOSYSTEM
        bcs     :+

        lda     #$13            ; DUPLICATE FILE NAME
err:    pha
        jsr     close
        pla
        sec
        rts

:       cmp     #6              ; BI Errors 6 and 7 cover
        beq     :+              ; vol dir, pathname, or filename
        cmp     #7              ; not found.
        bne     err             ; Otherwise - fail.
:

        ;; Create FN2
        lda     #$C3            ; Free access
        sta     CRACESS
        ldx     #3
:       lda     FN1INFO+4,x     ; storage type, file type,
        sta     CRFKIND-3,x     ; aux type, create date/time
        lda     FN1INFO+$E,x
        sta     CRFKIND+1,x
        dex
        bpl     :-
        lda     #CREATE
        jsr     GOSYSTEM
        bcs     err

        ;; Open FN2
        lda     #<FN2BUF
        sta     OSYSBUF
        lda     #>FN2BUF
        sta     OSYSBUF+1
        lda     #OPEN
        jsr     GOSYSTEM
        bcs     err
        lda     OREFNUM
        sta     FN2REF

        ;; Read
read:   lda     FN1REF
        sta     RWREFNUM
        lda     #<DATABUF
        sta     RWDATA
        lda     #>DATABUF
        sta     RWDATA+1
        lda     #<DATALEN
        sta     RWCOUNT
        lda     #>DATALEN
        sta     RWCOUNT+1
        lda     #READ
        jsr     GOSYSTEM
        bcc     :+
        cmp     #5              ; END OF DATA
        beq     finish
:

        ;; Write
        lda     FN2REF
        sta     RWREFNUM
        lda     #<DATABUF
        sta     RWDATA
        lda     #>DATABUF
        sta     RWDATA+1
        lda     RWTRANS
        sta     RWCOUNT
        lda     RWTRANS+1
        sta     RWCOUNT+1
        lda     #WRITE
        jsr     GOSYSTEM
        bcc     read
        jmp     err


finish: jsr     close
        clc
        rts

.proc close
        lda     FN1REF
        sta     CFREFNUM
        lda     #CLOSE
        jsr     GOSYSTEM
        lda     FN2REF
        sta     CFREFNUM
        lda     #CLOSE
        jsr     GOSYSTEM
        rts
.endproc

;;; Leave PREFIX at INBUF; infers it the same way as BI if empty.
.proc get_prefix
        ;; Try fetching prefix
        MLI_CALL GET_PREFIX, get_prefix_params
        lda     INBUF
        bne     done

        ;; Use BI's current slot and drive to construct unit number
        lda     DEFSLT          ; xxxxxSSS
        asl                     ; xxxxSSS0
        asl                     ; xxxSSS00
        asl                     ; xxSSS000
        asl                     ; xSSS0000
        asl                     ; SSS00000
        ldx     DEFDRV
        cpx     #2              ; C=0 if 1, C=1 if 2
        ror                     ; DSSS0000
        sta     unit

        ;; Get volume name and convert to path
        MLI_CALL ON_LINE, on_line_params
        ;; TODO: Handle failure
        lda     INBUF+1
        and     #$0F            ; mask off name_len
        tax
        inx                     ; leading and trailing '/'
        inx
        stx     INBUF
        lda     #'/'
        sta     INBUF+1         ; leading '/'
        sta     INBUF,x         ; trailing '/'

done:   rts

get_prefix_params:
        .byte   1
        .addr   INBUF

on_line_params:
        .byte   2
unit:   .byte   0
        .addr   INBUF+1         ; leave room to insert leading '/'
.endproc

;;; Fix path passed in A,X if it's relative. Uses prefix in INBUF
.proc fix_path
        ptr := $06
        ptr2 := $08

        sta     ptr
        stx     ptr+1

        ;; Already relative?
        ldy     #1
        lda     (ptr),y
        cmp     #'/'
        beq     done

        ;; Compute new length
        ldy     #0
        lda     (ptr),y
        tay                     ; Y = current length
        clc
        adc     INBUF           ; add prefix length
        pha                     ; stash for later

        ;; Shift path up to make room
        lda     INBUF
        clc
        adc     ptr
        sta     ptr2
        lda     #0
        adc     ptr+1
        sta     ptr2+1
:       lda     (ptr),y
        sta     (ptr2),y
        dey
        bpl     :-

        ;; Insert prefix
        lda     INBUF
        tax
        tay
:       lda     INBUF,x
        sta     (ptr),y
        dex
        dey
        bne     :-

        ;; Assign final length
        pla
        ldy     #0
        sta     (ptr),y

done:   rts
.endproc


        .assert * <= FN2BUF, error, "Too long"