a2d/desk.acc/date.s

        .setcpu "6502"

        .include "apple2.inc"
        .include "../inc/apple2.inc"
        .include "../inc/prodos.inc"
        .include "../inc/auxmem.inc"

        .include "../a2d.inc"
        .include "../desktop.inc" ; redraw icons after window move; font; glyphs

        .org $800

;;; ==================================================

        jmp     copy2aux


stash_stack:  .byte   $00

;;; ==================================================
;;; MLI Call Param Blocks

filename:
        PASCAL_STRING "MD.SYSTEM"

.proc open_params
params: .byte   3
name:   .addr   filename
buffer: .addr   $0900
ref_num:.byte   0
.endproc

.proc set_mark_params
params: .byte   2
ref_num:.byte   0
pos:    .byte   $03,$00,$00
.endproc

.proc write_params
params: .byte   4
ref_num:.byte   0
buffer: .addr   write_buffer
request:.word   sizeof_write_buffer
trans:  .word   0
.endproc

.proc close_params
params: .byte    1
ref_num:.byte   0
.endproc

write_buffer:
        .byte   0,0
        sizeof_write_buffer := * - write_buffer

;;; ==================================================

.proc copy2aux

        start := start_da
        end   := last

        tsx
        stx     stash_stack
        sta     ALTZPOFF
        lda     ROMIN2
        lda     DATELO
        sta     datelo
        lda     DATEHI
        sta     datehi
        lda     #<start
        sta     STARTLO
        lda     #>start
        sta     STARTHI
        lda     #<end
        sta     ENDLO
        lda     #>end
        sta     ENDHI
        lda     #<start
        sta     DESTINATIONLO
        lda     #>start
        sta     DESTINATIONHI
        sec
        jsr     AUXMOVE

        lda     #<start
        sta     XFERSTARTLO
        lda     #>start
        sta     XFERSTARTHI
        php
        pla
        ora     #$40            ; set overflow: aux zp/stack
        pha
        plp
        sec                     ; control main>aux
        jmp     XFER
.endproc

;;; ==================================================
;;; Write date into MD.SYSTEM file and exit the DA

.proc save_date_and_exit
        sta     ALTZPON
        sta     write_buffer
        stx     write_buffer+1
        lda     LCBANK1
        lda     LCBANK1
        lda     write_buffer    ; Dialog committed?
        beq     skip

        ldy     #OPEN           ; open the file
        lda     #<open_params
        ldx     #>open_params
        jsr     JUMP_TABLE_MLI
        bne     skip

        lda     open_params::ref_num
        sta     set_mark_params::ref_num
        sta     write_params::ref_num
        sta     close_params::ref_num

        ldy     #SET_MARK       ; seek
        lda     #<set_mark_params
        ldx     #>set_mark_params
        jsr     JUMP_TABLE_MLI
        bne     close

        ldy     #WRITE          ; write the date
        lda     #<write_params
        ldx     #>write_params
        jsr     JUMP_TABLE_MLI

close:  ldy     #CLOSE          ; close the file
        lda     #<close_params
        ldx     #>close_params
        jsr     JUMP_TABLE_MLI

skip:   ldx     stash_stack     ; exit the DA
        txs
        rts
.endproc

;;; ==================================================

start_da:
        sta     ALTZPON
        lda     LCBANK1
        lda     LCBANK1
        jmp     init_window

;;; ==================================================
;;; Param blocks

        ;; The following 7 rects are iterated over to identify
        ;; a hit target for a click.

        num_hit_rects := 7
        first_hit_rect := *
        up_rect_index := 3
        down_rect_index := 4

ok_button_rect:
        .word   $6A,$2E,$B5,$39
cancel_button_rect:
        .word   $10,$2E,$5A,$39
up_arrow_rect:
        .word   $AA,$0A,$B4,$14
down_arrow_rect:
        .word   $AA,$1E,$B4,$28
day_rect:
        .word   $25,$14,$3B,$1E
month_rect:
        .word   $51,$14,$6F,$1E
year_rect:
        .word   $7F,$14,$95,$1E

.proc text_mask_params
mask:   .byte   0
.endproc

        .res    7, $00          ; ???
        .byte   $FF

.proc white_pattern
        .res    8, $FF
.endproc
        .byte   $FF             ; ??

selected_field:                 ; 1 = day, 2 = month, 3 = year, 0 = none (init)
        .byte   0

datelo: .byte   0
datehi: .byte   0

day:    .byte   26              ; Feb 26, 1985
month:  .byte   2               ; The date this was written?
year:   .byte   85

spaces_string:
        A2D_DEFSTRING "    "

day_pos:
        .word   43, 30
day_string:
        A2D_DEFSTRING "  "

month_pos:
        .word   87, 30
month_string:
        A2D_DEFSTRING "   "

year_pos:
        .word   133, 30
year_string:
        A2D_DEFSTRING "  "

.proc get_input_params
state:  .byte   0

key       := *
modifiers := *+1

xcoord    := *
ycoord    := *+2
        .byte   0,0,0,0
.endproc
        ;; xcoord/ycoord are used to query...
.proc query_target_params
xcoord    := *
ycoord    := *+2
element:.byte   0
id:     .byte   0
.endproc

        window_id := 100

.proc map_coords_params
id:     .byte   window_id
screen:
screenx:.word   0
screeny:.word   0
client:
clientx:.word   0
clienty:.word   0
.endproc

.proc destroy_window_params
id:     .byte   window_id
.endproc
        .byte $00,$01           ; ???

.proc fill_mode_params
mode:   .byte   $02             ; this should be normal, but we do inverts ???
.endproc
        .byte   $06             ; ???

.proc create_window_params
id:     .byte   window_id
flags:  .byte   A2D_CWF_NOTITLE
title:  .addr   0
hscroll:.byte   A2D_CWS_NOSCROLL
vscroll:.byte   A2D_CWS_NOSCROLL
hsmax:  .byte   0
hspos:  .byte   0
vsmax:  .byte   0
vspos:  .byte   0
        .byte   0, 0            ; ???
w1:     .word   100
h1:     .word   100
w2:     .word   $1F4
h2:     .word   $1F4
.proc box
left:   .word   180
top:    .word   50
addr:   .addr   A2D_SCREEN_ADDR
stride: .word   A2D_SCREEN_STRIDE
hoff:   .word   0
voff:   .word   0
width:  .word   $C7
height: .word   $40
.endproc
pattern:.res    8,$00
mskand: .byte   A2D_DEFAULT_MSKAND
mskor:  .byte   A2D_DEFAULT_MSKOR
xpos:   .word   0
ypos:   .word   0
hthick: .byte   4
vthick: .byte   2
mode:   .byte   0
tmask:  .byte   $7F
font:   .addr   DEFAULT_FONT
next:   .addr   0
.endproc

;;; ==================================================
;;; Initialize window, unpack the date.

init_window:
        jsr     save_zp

        ;; Crack the date bytes. Format is:
        ;;   |    DATEHI     |    DATELO     |
        ;;   |7 6 5 4 3 2 1 0 7 6 5 4 3 2 1 0|
        ;;   |    year     | month |  day    |

        lda     datehi
        lsr     a
        sta     year

        lda     datelo
        and     #%11111
        sta     day

        lda     datehi
        ror     a
        lda     datelo
        ror     a
        lsr     a
        lsr     a
        lsr     a
        lsr     a
        sta     month

        A2D_CALL A2D_CREATE_WINDOW, create_window_params
        lda     #0
        sta     selected_field
        jsr     draw_window
        A2D_CALL $2B
        ;; fall through

;;; ==================================================
;;; Input loop

.proc input_loop
        A2D_CALL A2D_GET_INPUT, get_input_params
        lda     get_input_params::state
        cmp     #A2D_INPUT_DOWN
        bne     :+
        jsr     on_click
        jmp     input_loop

:       cmp     #A2D_INPUT_KEY
        bne     input_loop
.endproc

.proc on_key
        lda     get_input_params::modifiers
        bne     input_loop
        lda     get_input_params::key
        cmp     #KEY_RETURN
        bne     :+
        jmp     on_ok

:       cmp     #KEY_ESCAPE
        bne     :+
        jmp     on_cancel
:       cmp     #KEY_LEFT
        beq     on_key_left
        cmp     #KEY_RIGHT
        beq     on_key_right
        cmp     #KEY_DOWN
        beq     on_key_down
        cmp     #KEY_UP
        bne     input_loop

on_key_up:
        A2D_CALL A2D_FILL_RECT, up_arrow_rect
        lda     #up_rect_index
        sta     hit_rect_index
        jsr     do_inc_or_dec
        A2D_CALL A2D_FILL_RECT, up_arrow_rect
        jmp     input_loop

on_key_down:
        A2D_CALL A2D_FILL_RECT, down_arrow_rect
        lda     #down_rect_index
        sta     hit_rect_index
        jsr     do_inc_or_dec
        A2D_CALL A2D_FILL_RECT, down_arrow_rect
        jmp     input_loop

on_key_left:
        sec
        lda     selected_field
        sbc     #1
        bne     update_selection
        lda     #3
        jmp     update_selection

on_key_right:
        clc
        lda     selected_field
        adc     #1
        cmp     #4
        bne     update_selection
        lda     #1

update_selection:
        jsr     highlight_selected_field
        jmp     input_loop
.endproc

;;; ==================================================

.proc on_click
        A2D_CALL A2D_QUERY_TARGET, get_input_params::xcoord
        A2D_CALL A2D_SET_FILL_MODE, fill_mode_params
        A2D_CALL A2D_SET_PATTERN, white_pattern
        lda     query_target_params::id
        cmp     #window_id
        bne     miss
        lda     query_target_params::element
        bne     hit
miss:   rts

hit:    cmp     #A2D_ELEM_CLIENT
        bne     miss
        jsr     find_hit_target
        cpx     #0
        beq     miss
        txa
        sec
        sbc     #1
        asl     a
        tay
        lda     hit_target_jump_table,y
        sta     jump+1
        lda     hit_target_jump_table+1,y
        sta     jump+2
jump:   jmp     $1000           ; self modified

hit_target_jump_table:
        .addr   on_ok, on_cancel, on_up, on_down
        .addr   on_field_click, on_field_click, on_field_click
.endproc

;;; ==================================================

.proc on_ok
        A2D_CALL A2D_FILL_RECT, ok_button_rect

        ;; Pack the date bytes and store
        sta     RAMWRTOFF
        lda     month
        asl     a
        asl     a
        asl     a
        asl     a
        asl     a
        ora     day
        sta     DATELO
        lda     year
        rol     a
        sta     DATEHI
        sta     RAMWRTON

        lda     #1
        sta     dialog_result
        jmp     destroy
.endproc

on_cancel:
        A2D_CALL A2D_FILL_RECT, cancel_button_rect
        lda     #0
        sta     dialog_result
        jmp     destroy

on_up:
        txa
        pha
        A2D_CALL A2D_FILL_RECT, up_arrow_rect
        pla
        tax
        jsr     on_up_or_down
        rts

on_down:
        txa
        pha
        A2D_CALL A2D_FILL_RECT, down_arrow_rect
        pla
        tax
        jsr     on_up_or_down
        rts

on_field_click:
        txa
        sec
        sbc     #4
        jmp     highlight_selected_field

.proc on_up_or_down
        stx     hit_rect_index
loop:   A2D_CALL A2D_GET_INPUT, get_input_params ; Repeat while mouse is down
        lda     get_input_params::state
        cmp     #A2D_INPUT_UP
        beq     :+
        jsr     do_inc_or_dec
        jmp     loop

:       lda     hit_rect_index
        cmp     #up_rect_index
        beq     :+

        A2D_CALL A2D_FILL_RECT, down_arrow_rect
        rts

:       A2D_CALL A2D_FILL_RECT, up_arrow_rect
        rts
.endproc

.proc do_inc_or_dec
        ptr := $7

        jsr     delay
        lda     hit_rect_index
        cmp     #up_rect_index
        beq     incr

decr:   lda     #<decrement_table
        sta     ptr
        lda     #>decrement_table
        sta     ptr+1
        jmp     go

incr:   lda     #<increment_table
        sta     ptr
        lda     #>increment_table
        sta     ptr+1

go:     lda     selected_field
        asl     a
        tay
        lda     (ptr),y
        sta     gosub+1
        iny
        lda     (ptr),y
        sta     gosub+2

gosub:  jsr     $1000           ; self modified
        A2D_CALL A2D_SET_TEXT_MASK, text_mask_params
        jmp     draw_selected_field
.endproc

hit_rect_index:
        .byte   0

;;; ==================================================

increment_table:
        .addr   0, increment_day, increment_month, increment_year
decrement_table:
        .addr   0, decrement_day, decrement_month, decrement_year


        day_min := 1
        day_max := 31
        month_min := 1
        month_max := 12
        year_min := 0
        year_max := 99

increment_day:
        clc
        lda     day
        adc     #1
        cmp     #day_max+1
        bne     :+
        lda     #month_min
:       sta     day
        jmp     prepare_day_string

increment_month:
        clc
        lda     month
        adc     #1
        cmp     #month_max+1
        bne     :+
        lda     #month_min
:       sta     month
        jmp     prepare_month_string

increment_year:
        clc
        lda     year
        adc     #1
        cmp     #year_max+1
        bne     :+
        lda     #year_min
:       sta     year
        jmp     prepare_year_string

decrement_day:
        dec     day
        bne     :+
        lda     #day_max
        sta     day
:       jmp     prepare_day_string

decrement_month:
        dec     month
        bne     :+
        lda     #month_max
        sta     month
:       jmp     prepare_month_string

decrement_year:
        dec     year
        bpl     :+
        lda     #year_max
        sta     year
:       jmp     prepare_year_string

;;; ==================================================

.proc prepare_day_string
        lda     day
        jsr     number_to_ascii
        sta     day_string+3    ; first char
        stx     day_string+4    ; second char
        rts
.endproc

.proc prepare_month_string
        lda     month           ; month * 3 - 1
        asl     a
        clc
        adc     month
        tax
        dex

        ptr := $07
        str := month_string + 3
        len := 3

        lda     #<str
        sta     ptr
        lda     #>str
        sta     ptr+1

        ldy     #len - 1
loop:   lda     month_name_table,x
        sta     (ptr),y
        dex
        dey
        bpl     loop

        rts
.endproc

month_name_table:
        .byte   "Jan","Feb","Mar","Apr","May","Jun"
        .byte   "Jul","Aug","Sep","Oct","Nov","Dec"

.proc prepare_year_string
        lda     year
        jsr     number_to_ascii
        sta     year_string+3
        stx     year_string+4
        rts
.endproc

;;; ==================================================
;;; Tear down the window and exit

dialog_result:  .byte   0

.proc destroy
        A2D_CALL A2D_DESTROY_WINDOW, destroy_window_params
        DESKTOP_CALL DESKTOP_REDRAW_ICONS

        ;; Copy the relay routine to the zero page
        dest := $20

        ldx     #sizeof_routine
loop:   lda     routine,x
        sta     dest,x
        dex
        bpl     loop
        lda     dialog_result
        beq     skip

        ;; Pack date bytes, store in X, A
        lda     month
        asl     a
        asl     a
        asl     a
        asl     a
        asl     a
        ora     day
        tay
        lda     year
        rol     a
        tax
        tya

skip:   jmp     dest

.proc routine
        sta     RAMRDOFF
        sta     RAMWRTOFF
        jmp     save_date_and_exit
.endproc
        sizeof_routine := * - routine
.endproc

;;; ==================================================
;;; Figure out which button was hit (if any).
;;; Index returned in X.

.proc find_hit_target
        lda     get_input_params::xcoord
        sta     map_coords_params::screenx
        lda     get_input_params::xcoord+1
        sta     map_coords_params::screenx+1
        lda     get_input_params::ycoord
        sta     map_coords_params::screeny
        lda     get_input_params::ycoord+1
        sta     map_coords_params::screeny+1
        A2D_CALL A2D_MAP_COORDS, map_coords_params
        A2D_CALL A2D_SET_POS, map_coords_params::client
        ldx     #1
        lda     #<first_hit_rect
        sta     test_addr
        lda     #>first_hit_rect
        sta     test_addr+1

loop:   txa
        pha
        A2D_CALL A2D_TEST_BOX, $1000, test_addr
        bne     done

        clc
        lda     test_addr
        adc     #8              ; size of 4 words
        sta     test_addr
        bcc     :+
        inc     test_addr+1
:       pla
        tax
        inx
        cpx     #num_hit_rects+1
        bne     loop

        ldx     #0
        rts

done:   pla
        tax
        rts
.endproc

;;; ==================================================
;;; Params for the display

border_rect:
        .word   $04,$02,$C0,$3D

date_rect:
        .word   $20,$0F,$9A,$23

label_ok:
        A2D_DEFSTRING {"OK         ",GLYPH_RETURN} ;
label_cancel:
        A2D_DEFSTRING "Cancel  ESC"
label_uparrow:
        A2D_DEFSTRING GLYPH_UARROW
label_downarrow:
        A2D_DEFSTRING GLYPH_DARROW

label_cancel_pos:
        .word   $15,$38
label_ok_pos:
        .word   $6E,$38

label_uparrow_pos:
        .word   $AC,$13
label_downarrow_pos:
        .word   $AC,$27

.proc thickness_params
hthick: .byte   1
vthick: .byte   1
.endproc

;;; ==================================================
;;; Render the window contents

draw_window:
        A2D_CALL A2D_SET_STATE, create_window_params::box
        A2D_CALL A2D_DRAW_RECT, border_rect
        A2D_CALL A2D_SET_THICKNESS, thickness_params
        A2D_CALL A2D_DRAW_RECT, date_rect
        A2D_CALL A2D_DRAW_RECT, ok_button_rect
        A2D_CALL A2D_DRAW_RECT, cancel_button_rect

        A2D_CALL A2D_SET_POS, label_ok_pos
        A2D_CALL A2D_DRAW_TEXT, label_ok

        A2D_CALL A2D_SET_POS, label_cancel_pos
        A2D_CALL A2D_DRAW_TEXT, label_cancel

        A2D_CALL A2D_SET_POS, label_uparrow_pos
        A2D_CALL A2D_DRAW_TEXT, label_uparrow
        A2D_CALL A2D_DRAW_RECT, up_arrow_rect

        A2D_CALL A2D_SET_POS, label_downarrow_pos
        A2D_CALL A2D_DRAW_TEXT, label_downarrow
        A2D_CALL A2D_DRAW_RECT, down_arrow_rect

        jsr     prepare_day_string
        jsr     prepare_month_string
        jsr     prepare_year_string

        jsr     draw_day
        jsr     draw_month
        jsr     draw_year
        A2D_CALL A2D_SET_FILL_MODE, fill_mode_params
        A2D_CALL A2D_SET_PATTERN, white_pattern
        lda     #1
        jmp     highlight_selected_field

.proc draw_selected_field
        lda     selected_field
        cmp     #1
        beq     draw_day
        cmp     #2
        beq     draw_month
        jmp     draw_year
.endproc

.proc draw_day
        A2D_CALL A2D_SET_POS, day_pos
        A2D_CALL A2D_DRAW_TEXT, day_string
        rts
.endproc

.proc draw_month
        A2D_CALL A2D_SET_POS, month_pos
        A2D_CALL A2D_DRAW_TEXT, spaces_string ; variable width, so clear first
        A2D_CALL A2D_SET_POS, month_pos
        A2D_CALL A2D_DRAW_TEXT, month_string
        rts
.endproc

.proc draw_year
        A2D_CALL A2D_SET_POS, year_pos
        A2D_CALL A2D_DRAW_TEXT, year_string
        rts
.endproc

;;; ==================================================
;;; Highlight selected field
;;; Previously selected field in A, newly selected field at top of stack.

.proc highlight_selected_field
        pha
        lda     selected_field  ; initial state is 0, so nothing
        beq     update          ; to invert back to normal

        cmp     #1              ; day?
        bne     :+
        jsr     fill_day
        jmp     update

:       cmp     #2              ; month?
        bne     :+
        jsr     fill_month
        jmp     update

:       jsr     fill_year       ; year!

update: pla                     ; update selection
        sta     selected_field
        cmp     #1
        beq     fill_day
        cmp     #2
        beq     fill_month

fill_year:
        A2D_CALL A2D_FILL_RECT, year_rect
        rts

fill_day:
        A2D_CALL A2D_FILL_RECT, day_rect
        rts

fill_month:
        A2D_CALL A2D_FILL_RECT, month_rect
        rts
.endproc

;;; ==================================================
;;; Delay

.proc delay
        lda     #255
        sec
loop1:  pha

loop2:  sbc     #1
        bne     loop2

        pla
        sbc     #1
        bne     loop1
        rts
.endproc

;;; ==================================================
;;; Save/restore Zero Page

.proc save_zp
        ldx     #$00
loop:   lda     $00,x
        sta     zp_buffer,x
        dex
        bne     loop
        rts
.endproc

.proc restore_zp
        ldx     #$00
loop:   lda     zp_buffer,x
        sta     $00,x
        dex
        bne     loop
        rts
.endproc

zp_buffer:
        .res    256, 0

;;; ==================================================
;;; Convert number to two ASCII digits (in A, X)

.proc number_to_ascii
        ldy     #0
loop:   cmp     #10
        bcc     :+
        sec
        sbc     #10
        iny
        jmp     loop

:       clc
        adc     #'0'
        tax
        tya
        clc
        adc     #'0'
        rts
.endproc

        rts                     ; ???

last := *