.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 COPY_BYTES sizeof_routine+1, routine, call_main_trampoline 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::EventKind::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 copy #0, mode ;; Get filename by checking DeskTop selected window/icon ;; Check that an icon is selected copy #0, 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::EventKind::button_down ; was clicked? beq exit cmp #MGTK::EventKind::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 ptr := $06 ;; AUX memory half sta PAGE2OFF jsr read_file ;; NOTE: Why not just load into Aux directly by setting ;; PAGE2ON? This works unless loading from a RamWorks-based ;; RAM Disk, where things get messed up. This is slightly ;; slower in the non-RamWorks case. ;; TODO: Load directly into Aux if RamWorks is not present. ;; Copy MAIN to AUX sta CLR80COL ; read main, write aux sta RAMRDOFF sta RAMWRTON copy16 #hires, ptr ldx #>hires_size ; number of pages to copy ldy #0 : lda (ptr),y sta (ptr),y iny bne :- inc ptr+1 dex bne :- sta RAMWRTON ; read aux, write aux sta RAMRDON sta SET80COL ;; MAIN memory half sta PAGE2OFF jsr read_file jsr close_file 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 copy hires_table_lo,x, ptr copy hires_table_hi,x, ptr+1 ldy #cols-1 ; col copy #0, 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 copy #0, spill ; no spill bit 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 copy hires_table_lo,x, src copy hires_table_hi,x, src+1 ldy #cols-1 cloop: lda (src),y sta (dst),y dey bpl cloop add16 dst, #cols, dst 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 copy hires_table_lo,x, dst copy hires_table_hi,x, dst+1 ldy #cols-1 cloop: lda (src),y sta (dst),y dey bpl cloop add16 src, #cols, src 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 copy #$80, mode ;; AppleColor Card - Mode 2 (Color 140x192) sta SET80VID lda AN3_OFF lda AN3_ON lda AN3_OFF lda AN3_ON lda AN3_OFF ;; IIgs? jsr test_iigs bcc iigs ;; Le Chat Mauve - COL140 mode ;; (AN3 off, HR1 off, HR2 off, HR3 off) ;; Skip on IIgs since emulators (KEGS/GSport/GSplus) crash. sta HR2_OFF sta HR3_OFF bcs done ;; Apple IIgs - DHR Color iigs: 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 ;; IIgs? jsr test_iigs bcc iigs ;; Le Chat Mauve - BW560 mode ;; (AN3 off, HR1 off, HR2 on, HR3 on) ;; Skip on IIgs since emulators (KEGS/GSport/GSplus) crash. sta HR2_ON sta HR3_ON bcs done ;; Apple IIgs - DHR B&W iigs: 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 ID_BYTE_FE1F lda LCBANK1 lda LCBANK1 rts .endproc .include "inc/hires_table.inc" .include "inc/hr_to_dhr.inc"