.setcpu "65C02" .include "apple2.inc" .include "../inc/apple2.inc" .include "../inc/prodos.inc" .include "../mgtk.inc" .include "../desktop.inc" .include "../macros.inc" ;;; ============================================================ .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 call_main_trampoline := $20 ; installed on ZP, turns off auxmem and calls... call_main_addr := call_main_trampoline+7 ; address patched in here ;;; Copy the following "call_main_template" routine to $20 .scope sta RAMWRTON sta RAMRDON ldx #sizeof_routine loop: lda routine,x sta call_main_trampoline,x dex bpl loop jmp call_init .endscope .proc routine sta RAMRDOFF sta RAMWRTOFF jsr $1000 ; overwritten (in zp version) sta RAMRDON sta RAMWRTON rts .endproc sizeof_routine := * - routine ; can't .sizeof(proc) before declaration ;; https://github.com/cc65/cc .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 hires := $2000 hires_size := $2000 DEFINE_OPEN_PARAMS open_params, pathbuff, $C00 DEFINE_GET_EOF_PARAMS get_eof_params DEFINE_READ_PARAMS read_params, hires, hires_size DEFINE_CLOSE_PARAMS close_params .proc pathbuff ; 1st byte is length, rest is full path length: .byte $00 data: .res 64, 0 .endproc params_end: ;;; ---------------------------------------- da_window_id := 100 .proc line_pos left: .word 0 base: .word 0 .endproc .proc event_params ; queried to track mouse-up kind: .byte $00 ;;; if state is MGTK::event_kind_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 winfo window_id: .byte da_window_id ; window identifier options: .byte MGTK::option_dialog_box title: .addr window_title hscroll:.byte MGTK::scroll_option_none vscroll:.byte MGTK::scroll_option_none hthumbmax: .byte 32 hthumbpos: .byte 0 vthumbmax: .byte 32 vthumbpos: .byte 0 status: .byte 0 reserved: .byte 0 mincontwidth: .word default_width mincontlength: .word default_height maxcontwidth: .word default_width maxcontlength: .word default_height .proc port viewloc: DEFINE_POINT default_left, default_top mapbits: .addr MGTK::screen_mapbits mapwidth: .word MGTK::screen_mapwidth maprect: DEFINE_RECT 0, 0, default_width, default_height .endproc pattern:.res 8, 0 colormasks: .byte MGTK::colormask_and, MGTK::colormask_or penloc: DEFINE_POINT 0, 0 penwidth: .byte 1 penheight: .byte 1 penmode: .byte 0 textback: .byte $7F textfont: .addr DEFAULT_FONT nextwinfo: .addr 0 .endproc .proc init sta ALTZPON lda LCBANK1 lda LCBANK1 lda #0 sta mode ;; Get filename by checking DeskTop selected window/icon ;; Check that an icon is selected lda #0 sta pathbuff::length lda selected_file_count beq abort ; some file properties? lda path_index ; prefix index in table bne :+ abort: rts ;; Copy path (prefix) into pathbuff buffer. : src := $06 dst := $08 asl a ; (since address table is 2 bytes wide) tax copy16 path_table,x, src ldy #0 lda (src),y tax inc src bne :+ inc src+1 : copy16 #(pathbuff::data), dst jsr copy_pathbuff ; copy x bytes (src) to (dst) ;; Append separator. lda #'/' ldy #0 sta (dst),y inc pathbuff::length inc dst bne :+ inc dst+1 ;; Get file entry. : lda selected_file_list ; file index in table asl a ; (since table is 2 bytes wide) tax copy16 file_table,x, src ;; 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_pathbuff ; copy x bytes (src) to (dst) jmp open_file_and_init_window .proc copy_pathbuff ; copy x bytes from src to dst ldy #0 ; incrementing path length and dst loop: lda (src),y sta (dst),y iny inc pathbuff::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, winfo MGTK_CALL MGTK::SetPort, winfo::port jsr set_color_mode jsr show_file MGTK_CALL MGTK::ShowCursor MGTK_CALL MGTK::FlushEvents MGTK_CALL MGTK::ObscureCursor ;; fall through .endproc ;;; ============================================================ ;;; Main Input Loop .proc input_loop MGTK_CALL MGTK::GetEvent, event_params lda event_params::kind cmp #MGTK::event_kind_button_down ; was clicked? beq exit cmp #MGTK::event_kind_key_down ; any key? beq on_key bne input_loop on_key: lda event_params::modifiers bne input_loop lda event_params::key cmp #CHAR_ESCAPE beq exit cmp #' ' bne :+ jsr toggle_mode : jmp input_loop exit: jsr set_bw_mode MGTK_CALL MGTK::HideCursor MGTK_CALL MGTK::CloseWindow, winfo DESKTOP_CALL DT_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::eof ; fancy 3-byte unsigned compare cmp #<(hires_size+1) lda get_eof_params::eof+1 sbc #>(hires_size+1) lda get_eof_params::eof+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 copy16 #stash, dst 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 copy16 #stash, src 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 ;;; ============================================================ ;;; Color/B&W Toggle mode: .byte 0 ; 0 = B&W, $80 = color .proc toggle_mode lda mode bne set_bw_mode ;; fall through .endproc .proc set_color_mode lda mode bne done lda #$80 sta mode ;; AppleColor Card - Mode 2 (Color 140x192) sta SET80VID lda AN3_OFF lda AN3_ON lda AN3_OFF lda AN3_ON lda AN3_OFF ;; Le Chat Mauve - COL140 mode ;; (AN3 off, HR1 off, HR2 off, HR3 off) sta HR2_OFF sta HR3_OFF ;; Apple IIgs - DHR Color jsr test_iigs bcs done lda NEWVIDEO and #<~(1<<5) ; Color sta NEWVIDEO done: rts .endproc .proc set_bw_mode lda mode beq done lda #0 sta mode ;; AppleColor Card - Mode 1 (Monochrome 560x192) sta CLR80VID lda AN3_OFF lda AN3_ON lda AN3_OFF lda AN3_ON sta SET80VID lda AN3_OFF ;; Le Chat Mauve - BW560 mode ;; (AN3 off, HR1 off, HR2 on, HR3 on) sta HR2_ON sta HR3_ON ;; Apple IIgs - DHR B&W jsr test_iigs bcs done lda NEWVIDEO ora #(1<<5) ; B&W sta NEWVIDEO done: rts .endproc ;;; Returns with carry clear if IIgs, set otherwise. .proc test_iigs lda ROMIN2 sec jsr $FE1F lda LCBANK1 lda LCBANK1 rts .endproc .include "inc/hires_table.inc" .include "inc/hr_to_dhr.inc"