.setcpu "65C02" .include "apple2.inc" .include "../inc/apple2.inc" .include "../inc/prodos.inc" .include "../inc/auxmem.inc" .include "../mgtk.inc" .include "../desktop.inc" ; get selection, font .org $800 start: jmp copy2aux save_stack:.byte 0 ;;; Copy $800 through $13FF (the DA) to aux .proc copy2aux tsx stx save_stack sta RAMWRTON ldy #0 src: lda start,y ; self-modified dst: sta start,y ; self-modified dey bne src sta RAMWRTOFF inc src+2 inc dst+2 sta RAMWRTON lda dst+2 cmp #$14 bne src .endproc .proc call_init ;; run the DA jsr init ;; tear down/exit sta ALTZPON lda LCBANK1 lda LCBANK1 sta RAMRDOFF sta RAMWRTOFF ldx save_stack txs rts .endproc ;;; ================================================== ;;; ProDOS MLI calls .proc open_file jsr copy_params_aux_to_main sta ALTZPOFF MLI_CALL OPEN, open_params sta ALTZPON jsr copy_params_main_to_aux rts .endproc .proc get_file_eof jsr copy_params_aux_to_main sta ALTZPOFF MLI_CALL GET_EOF, get_eof_params sta ALTZPON jsr copy_params_main_to_aux rts .endproc .proc read_file jsr copy_params_aux_to_main sta ALTZPOFF MLI_CALL READ, read_params sta ALTZPON jsr copy_params_main_to_aux rts .endproc .proc close_file jsr copy_params_aux_to_main sta ALTZPOFF MLI_CALL CLOSE, close_params sta ALTZPON jsr copy_params_main_to_aux rts .endproc ;;; ================================================== ;;; Copies param blocks from Aux to Main .proc copy_params_aux_to_main ldy #(params_end - params_start + 1) sta RAMWRTOFF loop: lda params_start - 1,y sta params_start - 1,y dey bne loop sta RAMRDOFF rts .endproc ;;; Copies param blocks from Main to Aux .proc copy_params_main_to_aux pha php sta RAMWRTON ldy #(params_end - params_start + 1) loop: lda params_start - 1,y sta params_start - 1,y dey bne loop sta RAMRDON plp pla rts .endproc ;;; ---------------------------------------- params_start: ;;; This block gets copied between main/aux ;;; ProDOS MLI param blocks .proc open_params .byte 3 ; param_count .addr pathname ; pathname .addr $0C00 ; io_buffer ref_num:.byte 0 ; ref_num .endproc .proc get_eof_params .byte 2 ; param_count ref_num:.byte 0 ; ref_num length: .byte 0,0,0 ; EOF (lo, mid, hi) .endproc hires := $2000 hires_size := $2000 .proc read_params .byte 4 ; param_count ref_num:.byte 0 ; ref_num buffer: .addr hires ; data_buffer request:.word hires_size ; request_count .word 0 ; trans_count .endproc .proc close_params .byte 1 ; param_count ref_num:.byte 0 ; ref_num .endproc .proc pathname ; 1st byte is length, rest is full path length: .byte $00 data: .res 64, 0 .endproc params_end: ;;; ---------------------------------------- window_id := 100 .proc line_pos left: .word 0 base: .word 0 .endproc .proc event_params ; queried to track mouse-up state: .byte $00 ;;; if state is MGTK::key_down key := * modifiers := *+1 ;;; otherwise xcoord := * ycoord := *+2 .res 4 ; space for both .endproc default_width := 560 default_height := 192 default_left := 0 default_top := 0 .proc window_title .byte 0 ; length .endproc .proc window_params id: .byte window_id ; window identifier flags: .byte MGTK::option_dialog_box title: .addr window_title hscroll:.byte MGTK::scroll_option_none vscroll:.byte MGTK::scroll_option_none hsmax: .byte 32 hspos: .byte 0 vsmax: .byte 32 vspos: .byte 0 .byte 0, 0 ; ??? w1: .word default_width h1: .word default_height w2: .word default_width h2: .word default_height .proc box left: .word default_left top: .word default_top addr: .addr MGTK::screen_mapbits stride: .word MGTK::screen_mapwidth hoff: .word 0 voff: .word 0 width: .word default_width height: .word default_height .endproc pattern:.res 8, 0 mskand: .byte MGTK::colormask_and mskor: .byte MGTK::colormask_or xpos: .word 0 ypos: .word 0 hthick: .byte 1 vthick: .byte 1 mode: .byte 0 tmask: .byte $7F font: .addr DEFAULT_FONT next: .addr 0 .endproc .proc init sta ALTZPON lda LCBANK1 lda LCBANK1 ;; Get filename by checking DeskTop selected window/icon ;; Check that an icon is selected lda #0 sta pathname::length lda file_selected beq abort ; some file properties? lda path_index ; prefix index in table bne :+ abort: rts ;; Copy path (prefix) into pathname buffer. : src := $06 dst := $08 asl a ; (since address table is 2 bytes wide) tax lda path_table,x ; pathname ??? sta src lda path_table+1,x sta src+1 ldy #0 lda (src),y tax inc src bne :+ inc src+1 : lda #<(pathname::data) sta dst lda #>(pathname::data) sta dst+1 jsr copy_pathname ; copy x bytes (src) to (dst) ;; Append separator. lda #'/' ldy #0 sta (dst),y inc pathname::length inc dst bne :+ inc dst+1 ;; Get file entry. : lda file_index ; file index in table asl a ; (since table is 2 bytes wide) tax lda file_table,x sta src lda file_table+1,x sta src+1 ;; Exit if a directory. ldy #2 ; 2nd byte of entry lda (src),y and #$70 ; check that one of bits 4,5,6 is set ??? ;; some vague patterns, but unclear ;; basic = $32,$33, text = $52, sys = $11,$14,??, bin = $23,$24,$33 ;; dir = $01 (so not shown) bne :+ rts ; abort ??? ;; Append filename to path. : ldy #9 lda (src),y ; grab length tax ; name has spaces before/after dex ; so subtract 2 to get actual length dex clc lda src adc #11 ; 9 = length, 10 = space, 11 = name sta src bcc :+ inc src+1 : jsr copy_pathname ; copy x bytes (src) to (dst) jmp open_file_and_init_window .proc copy_pathname ; copy x bytes from src to dst ldy #0 ; incrementing path length and dst loop: lda (src),y sta (dst),y iny inc pathname::length dex bne loop tya clc adc dst sta dst bcc end inc dst+1 end: rts .endproc .endproc .proc open_file_and_init_window jsr open_file lda open_params::ref_num sta get_eof_params::ref_num sta read_params::ref_num sta close_params::ref_num MGTK_CALL MGTK::HideCursor jsr stash_menu MGTK_CALL MGTK::OpenWindow, window_params MGTK_CALL MGTK::SetPort, window_params::box jsr show_file MGTK_CALL MGTK::ShowCursor MGTK_CALL MGTK::FlushEvents ;; fall through .endproc ;;; ================================================== ;;; Main Input Loop .proc input_loop MGTK_CALL MGTK::GetEvent, event_params lda event_params::state cmp #MGTK::button_down ; was clicked? beq exit cmp #MGTK::key_down ; any key? beq on_key bne input_loop on_key: lda event_params::modifiers bne input_loop lda event_params::key cmp #KEY_ESCAPE beq exit bne input_loop exit: MGTK_CALL MGTK::HideCursor MGTK_CALL MGTK::CloseWindow, window_params DESKTOP_CALL DESKTOP_REDRAW_ICONS jsr unstash_menu MGTK_CALL MGTK::ShowCursor rts ; exits input loop .endproc .proc show_file jsr get_file_eof ;; If bigger than $2000, assume DHR lda get_eof_params::length ; fancy 3-byte unsigned compare cmp #<(hires_size+1) lda get_eof_params::length+1 sbc #>(hires_size+1) lda get_eof_params::length+2 sbc #^(hires_size+1) bcs dhr jsr show_hr_file jmp close dhr: jsr show_dhr_file close: jsr close_file rts .endproc .proc show_hr_file sta PAGE2OFF jsr read_file jsr close_file jsr hr_to_dhr rts .endproc .proc show_dhr_file ;; AUX memory half sta PAGE2ON jsr read_file ;; MAIN memory half sta PAGE2OFF jsr read_file ;; TODO: Restore PAGE2 state? rts .endproc ;;; ================================================== ;;; Convert single hires to double hires ;;; Assumes the image is loaded to MAIN $2000 and ;;; relies on the hr_to_dhr.inc table. .proc hr_to_dhr ptr := $06 rows := 192 cols := 40 spill := $08 ; spill-over lda #0 ; row rloop: pha tax lda hires_table_lo,x sta ptr lda hires_table_hi,x sta ptr+1 ldy #cols-1 ; col lda #0 sta spill ; spill-over cloop: lda (ptr),y tax bmi hibitset ;; complex case - need to spill in bit from prev col and store lda hr_to_dhr_aux,x sta PAGE2ON sta (ptr),y lda hr_to_dhr_main,x ora spill ; apply previous spill bit (to bit 6) sta PAGE2OFF sta (ptr),y ror ; move high bit to bit 6 and #(1 << 6) sta spill jmp next hibitset: ;; simple case - no bit spillage lda hr_to_dhr_aux,x sta PAGE2ON sta (ptr),y lda hr_to_dhr_main,x sta PAGE2OFF sta (ptr),y lda #0 ; no spill bit sta spill next: dey bpl cloop pla inc cmp #rows bne rloop ;; TODO: Restore PAGE2 state? done: sta PAGE2OFF rts .endproc ;;; ================================================== ;;; Stash/Unstash Menu Bar ;;; Have not yet figured out how to force the menu to ;;; redraw, so instead we save the top 13 rows of the ;;; screen to a scratch buffer and restore after ;;; destroying the window. stash := $1200 ; Past DA code rows = 13 cols = 40 .proc stash_menu src := $08 dst := $06 lda #stash sta dst+1 sta PAGE2ON jsr inner sta PAGE2OFF inner: lda #0 ; row # rloop: pha tax lda hires_table_lo,x sta src lda hires_table_hi,x sta src+1 ldy #cols-1 cloop: lda (src),y sta (dst),y dey bpl cloop clc ; src += cols lda src adc #cols sta src+1 clc ; dst += cols lda dst adc #cols sta dst+1 pla inc cmp #rows bcc rloop rts .endproc .proc unstash_menu src := $08 dst := $06 lda #stash sta src+1 sta PAGE2ON jsr inner sta PAGE2OFF inner: lda #0 ; row # rloop: pha tax lda hires_table_lo,x sta dst lda hires_table_hi,x sta dst+1 ldy #cols-1 cloop: lda (src),y sta (dst),y dey bpl cloop clc ; src += cols lda src adc #cols sta src+1 clc ; dst += cols lda dst adc #cols sta dst+1 pla inc cmp #rows bcc rloop rts .endproc .include "inc/hires_table.inc" .include "inc/hr_to_dhr.inc"