a2d/desk.acc/show_image_file.s

        .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 input_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 $2B            ; ???
        ;; fall through
.endproc

;;; ==================================================
;;; Main Input Loop

.proc input_loop
        MGTK_CALL MGTK::GetEvent, input_params
        lda     input_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     input_params::modifiers
        bne     input_loop
        lda     input_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
        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
        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
        lda     #<stash
        sta     src
        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
        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

        .include "inc/hires_table.inc"
        .include "inc/hr_to_dhr.inc"