a2d/desk.acc/date.s

        .setcpu "6502"

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

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

        .org $800

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

        jmp     copy2aux


stash_stack:  .byte   $00

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

filename:
        PASCAL_STRING "MD.SYSTEM"

        DEFINE_OPEN_PARAMS open_params, filename, $900
        DEFINE_SET_MARK_PARAMS set_mark_params, 3
        DEFINE_WRITE_PARAMS write_params, write_buffer, sizeof_write_buffer
        DEFINE_CLOSE_PARAMS close_params

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

        copy16  #start, STARTLO
        copy16  #end, ENDLO
        copy16  #start, DESTINATIONLO
        sec
        jsr     AUXMOVE

        copy16  #start, XFERSTARTLO
        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
        ldax    #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
        ldax    #set_mark_params
        jsr     JUMP_TABLE_MLI
        bne     close

        ldy     #WRITE          ; write the date
        ldax    #write_params
        jsr     JUMP_TABLE_MLI

close:  ldy     #CLOSE          ; close the file
        ldax    #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 settextbg_params
backcolor:   .byte   0          ; black
.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:
        DEFINE_STRING "    "

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

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

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

.proc event_params
kind:  .byte   0

key       := *
modifiers := *+1

xcoord    := *
ycoord    := *+2
        .byte   0,0,0,0
.endproc
        ;; xcoord/ycoord are used to query...
.proc findwindow_params
mousex    := *
mousey    := *+2
which_area:.byte   0
window_id: .byte   0
.endproc

        da_window_id := 100

.proc screentowindow_params
window_id:     .byte   da_window_id
screen:
screenx:.word   0
screeny:.word   0
window:
windowx:.word   0
windowy:.word   0
.endproc

.proc closewindow_params
window_id:     .byte   da_window_id
.endproc
        .byte $00,$01           ; ???

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

.proc winfo
window_id:     .byte   da_window_id
options:.byte   MGTK::option_dialog_box
title:  .addr   0
hscroll:.byte   MGTK::scroll_option_none
vscroll:.byte   MGTK::scroll_option_none
hthumbmax:  .byte   0
hthumbpos:  .byte   0
vthumbmax:  .byte   0
vthumbpos:  .byte   0
status:     .byte       0
reserved:       .byte   0
mincontwidth:     .word   100
maxcontwidth:     .word   100
mincontlength:     .word   $1F4
maxcontlength:     .word   $1F4
port:
viewloc:        DEFINE_POINT 180, 50
mapbits:   .addr   MGTK::screen_mapbits
mapwidth: .word   MGTK::screen_mapwidth
cliprect:       DEFINE_RECT 0, 0, $C7, $40
pattern:.res    8,$00
colormasks:     .byte   MGTK::colormask_and, MGTK::colormask_or
penloc: DEFINE_POINT 0, 0
penwidth: .byte   4
penheight: .byte   2
penmode:   .byte   0
textback:  .byte   $7F
textfont:   .addr   DEFAULT_FONT
nextwinfo:   .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

        MGTK_CALL MGTK::OpenWindow, winfo
        lda     #0
        sta     selected_field
        jsr     draw_window
        MGTK_CALL MGTK::FlushEvents
        ;; fall through

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

.proc input_loop
        MGTK_CALL MGTK::GetEvent, event_params
        lda     event_params::kind
        cmp     #MGTK::event_kind_button_down
        bne     :+
        jsr     on_click
        jmp     input_loop

:       cmp     #MGTK::event_kind_key_down
        bne     input_loop
.endproc

.proc on_key
        lda     event_params::modifiers
        bne     input_loop
        lda     event_params::key
        cmp     #CHAR_RETURN
        bne     :+
        jmp     on_ok

:       cmp     #CHAR_ESCAPE
        bne     :+
        jmp     on_cancel
:       cmp     #CHAR_LEFT
        beq     on_key_left
        cmp     #CHAR_RIGHT
        beq     on_key_right
        cmp     #CHAR_DOWN
        beq     on_key_down
        cmp     #CHAR_UP
        bne     input_loop

on_key_up:
        MGTK_CALL MGTK::PaintRect, up_arrow_rect
        lda     #up_rect_index
        sta     hit_rect_index
        jsr     do_inc_or_dec
        MGTK_CALL MGTK::PaintRect, up_arrow_rect
        jmp     input_loop

on_key_down:
        MGTK_CALL MGTK::PaintRect, down_arrow_rect
        lda     #down_rect_index
        sta     hit_rect_index
        jsr     do_inc_or_dec
        MGTK_CALL MGTK::PaintRect, 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
        MGTK_CALL MGTK::FindWindow, event_params::xcoord
        MGTK_CALL MGTK::SetPenMode, penmode_params
        MGTK_CALL MGTK::SetPattern, white_pattern
        lda     findwindow_params::window_id
        cmp     #da_window_id
        bne     miss
        lda     findwindow_params::which_area
        bne     hit
miss:   rts

hit:    cmp     #MGTK::area_content
        bne     miss
        jsr     find_hit_target
        cpx     #0
        beq     miss
        txa
        sec
        sbc     #1
        asl     a
        tay
        copy16  hit_target_jump_table,y, jump+1
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
        MGTK_CALL MGTK::PaintRect, 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:
        MGTK_CALL MGTK::PaintRect, cancel_button_rect
        lda     #0
        sta     dialog_result
        jmp     destroy

on_up:
        txa
        pha
        MGTK_CALL MGTK::PaintRect, up_arrow_rect
        pla
        tax
        jsr     on_up_or_down
        rts

on_down:
        txa
        pha
        MGTK_CALL MGTK::PaintRect, 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:   MGTK_CALL MGTK::GetEvent, event_params ; Repeat while mouse is down
        lda     event_params::kind
        cmp     #MGTK::event_kind_button_up
        beq     :+
        jsr     do_inc_or_dec
        jmp     loop

:       lda     hit_rect_index
        cmp     #up_rect_index
        beq     :+

        MGTK_CALL MGTK::PaintRect, down_arrow_rect
        rts

:       MGTK_CALL MGTK::PaintRect, 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:   copy16  #decrement_table, ptr
        jmp     go

incr:   copy16  #increment_table, ptr

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
        MGTK_CALL MGTK::SetTextBG, settextbg_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

        copy16  #str, ptr

        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
        MGTK_CALL MGTK::CloseWindow, closewindow_params
        DESKTOP_CALL DT_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
        copy16  event_params::xcoord, screentowindow_params::screenx
        copy16  event_params::ycoord, screentowindow_params::screeny
        MGTK_CALL MGTK::ScreenToWindow, screentowindow_params
        MGTK_CALL MGTK::MoveTo, screentowindow_params::window
        ldx     #1
        copy16  #first_hit_rect, test_addr

loop:   txa
        pha
        MGTK_CALL MGTK::InRect, $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:
        DEFINE_STRING {"OK         ",GLYPH_RETURN} ;
label_cancel:
        DEFINE_STRING "Cancel  ESC"
label_uparrow:
        DEFINE_STRING GLYPH_UARROW
label_downarrow:
        DEFINE_STRING 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 setpensize_params
penwidth: .byte   1
penheight: .byte   1
.endproc

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

draw_window:
        MGTK_CALL MGTK::SetPort, winfo::port
        MGTK_CALL MGTK::FrameRect, border_rect
        MGTK_CALL MGTK::SetPenSize, setpensize_params
        MGTK_CALL MGTK::FrameRect, date_rect
        MGTK_CALL MGTK::FrameRect, ok_button_rect
        MGTK_CALL MGTK::FrameRect, cancel_button_rect

        MGTK_CALL MGTK::MoveTo, label_ok_pos
        MGTK_CALL MGTK::DrawText, label_ok

        MGTK_CALL MGTK::MoveTo, label_cancel_pos
        MGTK_CALL MGTK::DrawText, label_cancel

        MGTK_CALL MGTK::MoveTo, label_uparrow_pos
        MGTK_CALL MGTK::DrawText, label_uparrow
        MGTK_CALL MGTK::FrameRect, up_arrow_rect

        MGTK_CALL MGTK::MoveTo, label_downarrow_pos
        MGTK_CALL MGTK::DrawText, label_downarrow
        MGTK_CALL MGTK::FrameRect, down_arrow_rect

        jsr     prepare_day_string
        jsr     prepare_month_string
        jsr     prepare_year_string

        jsr     draw_day
        jsr     draw_month
        jsr     draw_year
        MGTK_CALL MGTK::SetPenMode, penmode_params
        MGTK_CALL MGTK::SetPattern, 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
        MGTK_CALL MGTK::MoveTo, day_pos
        MGTK_CALL MGTK::DrawText, day_string
        rts
.endproc

.proc draw_month
        MGTK_CALL MGTK::MoveTo, month_pos
        MGTK_CALL MGTK::DrawText, spaces_string ; variable width, so clear first
        MGTK_CALL MGTK::MoveTo, month_pos
        MGTK_CALL MGTK::DrawText, month_string
        rts
.endproc

.proc draw_year
        MGTK_CALL MGTK::MoveTo, year_pos
        MGTK_CALL MGTK::DrawText, 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:
        MGTK_CALL MGTK::PaintRect, year_rect
        rts

fill_day:
        MGTK_CALL MGTK::PaintRect, day_rect
        rts

fill_month:
        MGTK_CALL MGTK::PaintRect, 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 := *