mirror of
https://github.com/mi57730/a2d.git
synced 2024-11-29 07:49:20 +00:00
685 lines
16 KiB
ArmAsm
685 lines
16 KiB
ArmAsm
.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"
|