.setcpu "6502" .include "apple2.inc" .include "../inc/apple2.inc" .include "../inc/prodos.inc" .include "../mgtk/mgtk.inc" .include "../desktop.inc" .include "../inc/macros.inc" ;;; ============================================================ .org $800 dir_data_buffer := $0E00 dir_data_buffer_len = $0E00 ;;; ============================================================ cli jmp start ;; unit_num for active window, for block operations unit_num: .byte 0 save_stack: .byte 0 ;;; ============================================================ start: tsx stx save_stack jmp start2 .proc exit ldx save_stack txs lda a:$0A bne :+ rts : lda #>(JUMP_TABLE_SELECT_WINDOW-1) pha lda #<(JUMP_TABLE_SELECT_WINDOW-1) pha lda a:$0A rts .endproc ;;; ============================================================ ;;; ProDOS Relays .proc open sta ALTZPOFF MLI_CALL OPEN, open_params sta ALTZPON rts .endproc .proc read sta ALTZPOFF MLI_CALL READ, read_params sta ALTZPON rts .endproc .proc write_block sta ALTZPOFF MLI_CALL WRITE_BLOCK, block_params sta ALTZPON rts .endproc .proc read_block sta ALTZPOFF MLI_CALL READ_BLOCK, block_params sta ALTZPON rts .endproc .proc on_line sta ALTZPOFF MLI_CALL ON_LINE, on_line_params sta ALTZPON rts .endproc .byte 0 ;;; unused ??? .proc write sta ALTZPOFF MLI_CALL WRITE, write_params sta ALTZPON rts .endproc ;;; unused ??? .proc set_mark sta ALTZPOFF MLI_CALL SET_MARK, set_mark_params sta ALTZPON rts .endproc ;;; unused ??? .proc get_file_info sta ALTZPOFF MLI_CALL GET_FILE_INFO, file_info_params sta ALTZPON rts .endproc ;;; unused ??? .proc set_file_info sta ALTZPOFF MLI_CALL SET_FILE_INFO, file_info_params sta ALTZPON rts .endproc .proc close sta ALTZPOFF MLI_CALL CLOSE, close_params sta ALTZPON rts .endproc ;;; ============================================================ ;;; ProDOS call parameter blocks DEFINE_ON_LINE_PARAMS on_line_params,, on_line_buffer on_line_buffer: .res 16, 0 DEFINE_SET_MARK_PARAMS set_mark_params, $2B DEFINE_READ_BLOCK_PARAMS block_params, 0, 0 .byte 0 io_buf := $1C00 buffer := dir_data_buffer buffer_len = dir_data_buffer_len DEFINE_OPEN_PARAMS open_params, path_buf, io_buf DEFINE_READ_PARAMS read_params, buffer, buffer_len DEFINE_WRITE_PARAMS write_params, buffer, buffer_len DEFINE_CLOSE_PARAMS close_params DEFINE_GET_FILE_INFO_PARAMS file_info_params, path_buf .res 3 ; for SET_FILE_INFO ??? path_buf: .res 65, 0 ;;; ============================================================ ;;; Main DA logic .proc start2 sta ALTZPON lda LCBANK1 lda LCBANK1 ptr := $0A yax_call JUMP_TABLE_MGTK_RELAY, MGTK::FrontWindow, ptr lda ptr ; any window open? beq bail ; nope, bail cmp #9 ; DeskTop windows are 1-8 bcc has_window bail: jmp exit .endproc has_window: .scope ;; Copy window path to buffer asl a ; window index * 2 tay copy16 path_table,y, $06 ldy #0 sty $10 ; ??? lda ($06),y sta len sta path_buf loop: iny lda ($06),y and #CHAR_MASK cmp #'a' ; lower case? bcc :+ and #CASE_MASK ; restore to upper-case : sta path_buf,y len := *+1 cpy #0 bne loop .endscope .scope ;; Enumerate devices to find unit_num matching path. ldy DEVCNT sty dev_num loop: ldy dev_num lda DEVLST,y and #$F0 ; mask off drive/slot sta on_line_params::unit_num jsr on_line bne next jsr compare_paths_for_unit_num beq found_unit_num next: dec dev_num bpl loop .endscope exit1: jmp exit found_unit_num: lda on_line_params::unit_num sta unit_num jsr open bne exit1 lda open_params::ref_num sta read_params::ref_num sta close_params::ref_num ;; Read a chunk of the directory jsr read jsr close bne exit1 ldx #$02 L09BC := *+2 L09BA: lda buffer + 2 sta L0A95,x L09C2 := *+2 lda buffer + 3 sta L0A95+1,x ora L0A95,x beq L09DD inc L09BC inc L09BC inc L09C2 inc L09C2 inx inx cpx #$0E bne L09BA L09DD: txa clc adc #$0E sta L0A93 jsr L0B40 L09E7: jsr L0B16 bcs L0A3B ldy #0 lda ($06),y and #STORAGE_TYPE_MASK beq L09E7 ldy #SubdirectoryHeader::file_count copy16in ($06),y, L0A95 jsr L0AE8 lda unit_num sta block_params::unit_num lda #$00 sta L0A94 L0A0F: lda L0A94 asl a tay copy16 L0A95,y, block_params::block_num ora block_params::block_num beq L0A3E tya clc adc #$0E sta block_params::data_buffer+1 lda #$00 sta block_params::data_buffer jsr write_block bne L0A3B inc L0A94 bne L0A0F L0A3B: jmp exit L0A3E: copy16 #$1C00, block_params::data_buffer jsr L0B40 L0A4B: jsr L0B16 bcs L0A8E ldy #0 lda ($06),y and #STORAGE_TYPE_MASK beq L0A4B cmp #(ST_LINKED_DIRECTORY << 4) bne L0A4B ldy #$11 copy16in ($06),y, block_params::block_num jsr read_block bne L0A8F lda $07 sec sbc #$0E and #$FE tay copy16 L0A95,y, $1C27 copy L0AAF, $1C29 jsr write_block jmp L0A4B L0A8E: pla ; WTF ??? L0A8F: jmp exit dev_num: .byte 0 L0A93: .byte 0 L0A94: .byte 0 L0A95: .res 26, 0 L0AAF: .byte 0 ;;; ============================================================ ;;; Compare path from ON_LINE vs. path from window, since we ;;; need unit_num for block operations. .proc compare_paths_for_unit_num lda on_line_buffer and #$0F sta on_line_buffer ldy #0 loop: iny lda on_line_buffer,y and #CHAR_MASK cmp #'a' bcc :+ and #CASE_MASK ; make upper-case : cmp path_buf+1,y bne fail cpy on_line_buffer bne loop lda on_line_buffer clc adc #$01 cmp path_buf beq success lda path_buf+2,y cmp #'/' bne fail success: return #$00 fail: return #$FF .endproc ;;; ============================================================ .proc L0AE8 lda #0 sta L0B15 jsr L0B40 jsr L0B16 loop: copy16 $06, $08 jsr L0B16 bcs done jsr compare_file_entries bcc loop jsr swap_entries lda #$FF sta L0B15 bne loop done: lda L0B15 bne L0AE8 rts L0B15: .byte 0 .endproc ;;; ============================================================ .proc L0B16 ptr := $06 inc L0AAF lda ptr clc adc #.sizeof(FileEntry) sta ptr bcc :+ inc ptr+1 : lda ptr cmp #$FF bne rtcc inc ptr+1 lda #1 sta L0AAF lda #$04 ; skip over block header ??? sta ptr lda ptr+1 cmp L0A93 bcs rtcs rtcc: clc rts rtcs: sec rts .endproc ;;; ============================================================ L0B40: lda #1 sta L0AAF copy16 #dir_data_buffer + 4, $06 rts ;;; ============================================================ ;;; Swap file entries .proc swap_entries ptr1 := $06 ptr2 := $08 ldy #.sizeof(FileEntry) - 1 loop: lda (ptr1),y pha lda (ptr2),y sta (ptr1),y pla sta (ptr2),y dey bpl loop rts .endproc ;;; ============================================================ ;;; Compare file entries ($06, $08); order returned in carry. ;;; Uses compare_selection_orders, compare_file_entry_names, ;;; and compare_entry_types_and_names as appropriate. .proc compare_file_entries ptr1 := $06 ptr2 := $08 ldy #0 lda (ptr1),y and #STORAGE_TYPE_MASK ; Active file entry? bne :+ jmp rtcc : lda (ptr2),y and #STORAGE_TYPE_MASK ; Active file entry? bne :+ jmp rtcs : lda selected_file_count beq :+ lda path_index beq :+ jmp compare_selection_orders : ldax ptr2 jsr check_system_file bcc rtcc ldax ptr1 jsr check_system_file bcc rtcs ldy #0 lda (ptr2),y and #STORAGE_TYPE_MASK sta storage_type2 ldy #0 lda (ptr1),y and #STORAGE_TYPE_MASK sta storage_type1 ;; Why does this dir-first comparison not just use FT_DIRECTORY ??? ;; Is #2 a dir? lda storage_type2 cmp #(ST_LINKED_DIRECTORY << 4) beq dirs ; yep, check #1 ;; Is #1 a dir? lda storage_type1 cmp #(ST_LINKED_DIRECTORY << 4) beq rtcs ; yep, but 2 wasn't, so order bne check_types ; neither are dirs - check types ;; #2 was a dir - is #1? dirs: lda storage_type1 cmp #(ST_LINKED_DIRECTORY << 4) bne rtcc ;; Both are dirs, order by name jsr compare_file_entry_names bcc rtcc bcs rtcs ;; TXT files first check_types: lda #FT_TEXT jsr compare_entry_types_and_names bne :+ bcc rtcc bcs rtcs ;; SYS files next : lda #FT_SYSTEM jsr compare_entry_types_and_names bne :+ bcc rtcc bcs rtcs ;; Then order by type from $FD down : lda #$FD sta type loop: dec type lda type beq rtcc jsr compare_entry_types_and_names bne loop bcs rtcs jmp rtcc rtcs: sec rts rtcc: clc rts storage_type2: .byte 0 storage_type1: .byte 0 type: .byte 0 .endproc ;;; ============================================================ ;;; Compare selection order of icons; order returned in carry. ;;; Handles either icon being not selected. .proc compare_selection_orders entry_ptr := $10 filename := $06 filename2 := $08 ldx selected_file_count loop: dex bmi done1 ;; Look up next icon, compare length. lda selected_file_list,x asl a tay add16 file_table,y, #IconEntry::len, entry_ptr ldy #0 lda (entry_ptr),y sec sbc #2 ; remove leading/trailing space sta cmp_len inc16 entry_ptr ; points at start of name lda (filename),y and #NAME_LENGTH_MASK cmp_len := *+1 cmp #0 bne loop ; lengths don't match, so not a match ;; Bytewise compare names. sta cpy_len next: iny ; skip leading space lda (entry_ptr),y and #CHAR_MASK cmp #'a' bcc :+ and #CASE_MASK ; make upper-case : sta cmp_char lda (filename),y and #CHAR_MASK cmp #'a' bcc :+ and #CASE_MASK ; make upper-case cmp_char := *+1 : cmp #0 bne loop ; no match - try next icon cpy_len := *+1 cpy #0 bne next done1: stx match ; match, or $FF if none ldx selected_file_count loop2: dex bmi done2 ;; Look up next icon, compare length. lda selected_file_list,x asl a tay add16 file_table,y, #IconEntry::len, entry_ptr ldy #0 lda (entry_ptr),y ; len sec sbc #2 ; remove leading/trailing space sta cmp_len2 inc16 entry_ptr ; points at start of name lda (filename2),y and #NAME_LENGTH_MASK cmp_len2 := *+1 cmp #0 bne loop2 ; lengths don't match, so not a match ;; Bytewise compare names. sta cpy_len2 next2: iny lda (entry_ptr),y and #CHAR_MASK cmp #'a' bcc :+ and #CASE_MASK ; make upper-case : sta cmp_char2 lda (filename2),y and #CHAR_MASK cmp #'a' bcc :+ and #CASE_MASK ; make upper-case cmp_char2 := *+1 : cmp #0 bne loop2 ; no match - try next icon cpy_len2 := *+1 cpy #0 bne next2 done2: stx match2 ; match, or $FF if none lda match and match2 cmp #$FF ; if either didn't match beq clear lda match2 cmp match beq clear ; if they're the same rts ; otherwise carry is order ;; No match sec rts clear: clc rts match: .byte 0 match2: .byte 0 .endproc ;;; ============================================================ ;;; Compare file types/names ($06, $08 = ptrs, A=type) ;;; ;;; Output: A=$FF if neither matches type; A=$00 and carry is order .proc compare_entry_types_and_names ptr1 := $06 ptr2 := $08 max_length := 16 sta type0 ldy #max_length lda (ptr2),y sta type2 lda (ptr1),y sta type1 lda type2 cmp type0 beq :+ lda type1 cmp type0 beq rtcs bne neither : lda type1 cmp type0 bne rtcc jsr compare_file_entry_names bcc rtcc bcs rtcs neither: return #$FF type2: .byte 0 type1: .byte 0 rtcc: lda #0 clc rts rtcs: lda #0 sec rts type0: .byte 0 .endproc ;;; ============================================================ ;;; Is the file entry a SYS file with .SYSTEM suffix? ;;; Returns carry clear if true, set if false. .proc check_system_file ptr := $00 ;; Check for SYS stax ptr ldy #FileEntry::file_type lda (ptr),y cmp #$FF ; type=SYS bne fail ;; Could name end in .SYSTEM? ldy #FileEntry::storage_type_name_length lda (ptr),y and #NAME_LENGTH_MASK sec sbc #.strlen(".SYSTEM")-1 bcc fail ; too short tay ;; Check name suffix ldx #0 dey loop: iny inx lda (ptr),y and #CHAR_MASK cmp str_system,x bne fail cpx str_system bne loop clc rts fail: sec rts str_system: PASCAL_STRING ".SYSTEM" .endproc ;;; ============================================================ ;;; Compare file entry names; carry indicates order .proc compare_file_entry_names ptr1 := $06 ptr2 := $08 ldy #0 lda (ptr2),y and #NAME_LENGTH_MASK sta len2 sta len lda (ptr1),y and #NAME_LENGTH_MASK sta len1 cmp len bcs :+ sta len : ldy #0 loop: iny lda (ptr2),y cmp (ptr1),y beq next bcc rtcc rtcs: sec rts len := *+1 next: cpy #0 bne loop lda len2 cmp len1 beq rtcc bcs rtcs rtcc: clc rts len2: .byte 0 len1: .byte 0 .endproc