a2d/desk.acc/show.image.file.s

        .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

        ;; 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
        bne     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
        lda     src+1
        adc     #>cols
        sta     src+1

        clc                     ; dst += cols
        lda     dst
        adc     #<cols
        sta     dst
        lda     dst+1
        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
        lda     src+1
        adc     #>cols
        sta     src+1

        clc                     ; dst += cols
        lda     dst
        adc     #<cols
        sta     dst
        lda     dst+1
        adc     #>cols
        sta     dst+1

        pla
        inc
        cmp     #rows
        bcc     rloop
        rts
.endproc

;;; ============================================================
;;; Color/B&W Toggle

;;; TODO: Also consider Le Chat Mauve BW560 mode.
;;; https://github.com/inexorabletash/a2d/issues/41

.proc set_color_mode
        ;; AppleColor Card - Mode 2 (Color 140x192)
        sta     SET80VID
        lda     AN3_OFF
        lda     AN3_ON
        lda     AN3_OFF
        lda     AN3_ON
        lda     AN3_OFF

        ;; Apple IIgs - DHR Color
        jsr     test_iigs
        bcs     done
        lda     #%00000000
        sta     NEWVIDEO

done:   rts
.endproc

.proc set_bw_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

        ;; Apple IIgs - DHR B&W
        jsr     test_iigs
        bcs     done
        lda     #%00100000
        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"