Apple-2-SW/a2d
1
0
Fork 0
mirror of https://github.com/mi57730/a2d.git synced 2024-12-01 05:50:24 +00:00
Code Issues Projects Releases Wiki Activity
177e988398
a2d/desk.acc/date.s
Joshua Bell 08a034911b wider block separator comment
2018-03-04 21:36:00 -08:00

896 lines
20 KiB
ArmAsm
Raw Blame History

.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 := *
Reference in New Issue View Git Blame Copy Permalink