.setcpu "65C02" .org $800 .include "apple2.inc" .include "../inc/apple2.inc" .include "../inc/prodos.inc" .include "../inc/auxmem.inc" .include "../inc/applesoft.inc" .include "a2d.inc" adjust_txtptr := $B1 ;;; ================================================== ;;; Start of the code start: jmp copy2aux save_stack: .byte 0 ;;; ================================================== ;;; Duplicate the DA (code and data) to AUX memory, ;;; then invoke the code in AUX. .proc copy2aux tsx stx save_stack start := call_init end := da_end dest := start ;; Copy the DA to AUX memory. lda ROMIN2 lda #start sta STARTHI lda #end sta ENDHI lda #dest sta DESTINATIONHI sec ; main>aux jsr AUXMOVE ;; Invoke it. lda #start sta XFERSTARTHI php pla ora #$40 ; set overflow: use aux zp/stack pha plp sec ; control main>aux jmp XFER .endproc ;;; ================================================== .proc exit_da lda LCBANK1 lda LCBANK1 ldx save_stack txs rts .endproc ;;; ================================================== call_init: lda ROMIN2 jmp init ;; Used after a drag-and-drop is completed; ;; redraws the window. .proc call_4015_main zp_stash := $20 ;; Call jump table entry $4015 in main memory, by ;; copying a trampoline routine to the ZP. lda LCBANK1 lda LCBANK1 ldx #(routine_end - routine) : lda routine,x sta zp_stash,x dex bpl :- jsr zp_stash ;; Redraw window after drag lda ROMIN2 lda #window_id jsr draw_window ;; ??? lda LCBANK1 lda LCBANK1 bit redraw_flag bmi skip jsr UNKNOWN_CALL .byte $0C .addr 0 ;; ??? skip: lda #0 sta redraw_flag lda ROMIN2 A2D_CALL A2D_QUERY_STATE, query_state_params A2D_CALL A2D_SET_STATE, state_params rts .proc routine sta RAMRDOFF sta RAMWRTOFF jsr JUMP_TABLE_15 sta RAMRDON sta RAMWRTON rts .endproc routine_end := * .endproc ;;; ================================================== redraw_flag: .byte 0 ; ??? ;; Called after window drag is complete ;; (called with window_id in A) .proc draw_window sta query_state_params_id lda create_window_params_top cmp #screen_height - 1 bcc :+ lda #$80 sta redraw_flag rts : A2D_CALL A2D_QUERY_STATE, query_state_params A2D_CALL A2D_SET_STATE, state_params lda query_state_params_id cmp #window_id bne :+ jmp draw_background : rts .endproc ;;; ================================================== ;;; Call Params (and other data) ;; The following params blocks overlap for data re-use .proc map_coords_params id := * screen := * + 1 screenx := * + 1 ; aligns with input_state::xcoord screeny := * + 3 ; aligns with input_state::ycoord client := * + 5 clientx := * + 5 clienty := * + 7 .endproc .proc drag_params id := * xcoord := * + 1 ; aligns with input_state::xcoord ycoord := * + 3 ; aligns with input_state::ycoord .endproc .proc input_state_params state: .byte 0 xcoord := * ; if state is 0,1,2,4 ycoord := * + 2 ; " key := * ; if state is 3 modifiers := * + 1 ; " .endproc .proc target_params queryx: .word 0 ; aligns with input_state_params::xcoord queryy: .word 0 ; aligns with input_state_params::ycoord elem: .byte 0 id: .byte 0 .endproc .byte 0, 0 ; fills out space for map_coords_params .byte 0, 0 ; ??? .proc close_click_params state: .byte 0 .endproc .proc query_state_params id: .byte 0 .addr state_params .endproc query_state_params_id := query_state_params::id ;; param block for a 1A call L08D4: .byte $80 ;; param block for a 1A call L08D5: .byte $00 ;;; ================================================== ;;; Button Definitions button_width := 17 button_height := 9 col1_left := 13 col1_right := col1_left+button_width ; 30 col2_left := 42 col2_right := col2_left+button_width ; 59 col3_left := 70 col3_right := col3_left+button_width ; 87 col4_left := 98 col4_right := col4_left+button_width ; 115 row1_top := 22 row1_bot := row1_top+button_height ; 31 row2_top := 38 row2_bot := row2_top+button_height ; 47 row3_top := 53 row3_bot := row3_top+button_height ; 62 row4_top := 68 row4_bot := row4_top+button_height ; 77 row5_top := 83 row5_bot := row5_top+button_height ; 92 border_lt := 1 ; border width pixels (left/top) border_br := 2 ; (bottom/right) .proc btn_c .word col1_left - border_lt .word row1_top - border_lt .addr button_bitmap .byte bitmap_stride .byte $00,$00,$00,$00,$00 ; ??? .word button_width + border_lt + border_br .word button_height + border_lt + border_br label: .byte 'c' pos: .word col1_left + 6, row1_bot box: .word col1_left,row1_top,col1_right,row1_bot .endproc .proc btn_e .word col2_left - border_lt .word row1_top - border_lt .addr button_bitmap .byte bitmap_stride .byte $00,$00,$00,$00,$00 .word button_width + border_lt + border_br .word button_height + border_lt + border_br label: .byte 'e' .word col2_left + 6, row1_bot box: .word col2_left,row1_top,col2_right,row1_bot .endproc .proc btn_eq .word col3_left - border_lt .word row1_top - border_lt .addr button_bitmap .byte bitmap_stride .byte $00,$00,$00,$00,$00 .word button_width + border_lt + border_br .word button_height + border_lt + border_br label: .byte '=' .word col3_left + 6, row1_bot box: .word col3_left,row1_top,col3_right,row1_bot .endproc .proc btn_mul .word col4_left - border_lt .word row1_top - border_lt .addr button_bitmap .byte bitmap_stride .byte $00,$00,$00,$00,$00 .word button_width + border_lt + border_br .word button_height + border_lt + border_br label: .byte '*' .word col4_left + 6, row1_bot box: .word col4_left,row1_top,col4_right,row1_bot .endproc .proc btn_7 .word col1_left - border_lt .word row2_top - border_lt .addr button_bitmap .byte bitmap_stride .byte $00,$00,$00,$00,$00 .word button_width + border_lt + border_br .word button_height + border_lt + border_br label: .byte '7' .word col1_left + 6, row2_bot box: .word col1_left,row2_top,col1_right,row2_bot .endproc .proc btn_8 .word col2_left - border_lt .word row2_top - border_lt .addr button_bitmap .byte bitmap_stride .byte $00,$00,$00,$00,$00 .word button_width + border_lt + border_br .word button_height + border_lt + border_br label: .byte '8' .word col2_left + 6, row2_bot box: .word col2_left,row2_top,col2_right,row2_bot .endproc .proc btn_9 .word col3_left - border_lt .word row2_top - border_lt .addr button_bitmap .byte bitmap_stride .byte $00,$00,$00,$00,$00 .word button_width + border_lt + border_br .word button_height + border_lt + border_br label: .byte '9' .word col3_left + 6, row2_bot box: .word col3_left,row2_top,col3_right,row2_bot .endproc .proc btn_div .word col4_left - border_lt .word row2_top - border_lt .addr button_bitmap .byte bitmap_stride .byte $00,$00,$00,$00,$00 .word button_width + border_lt + border_br .word button_height + border_lt + border_br label: .byte '/' .word col4_left + 6, row2_bot box: .word col4_left,row2_top,col4_right,row2_bot .endproc .proc btn_4 .word col1_left - border_lt .word row3_top - border_lt .addr button_bitmap .byte bitmap_stride .byte $00,$00,$00,$00,$00 .word button_width + border_lt + border_br .word button_height + border_lt + border_br label: .byte '4' .word col1_left + 6, row3_bot box: .word col1_left,row3_top,col1_right,row3_bot .endproc .proc btn_5 .word col2_left - border_lt .word row3_top - border_lt .addr button_bitmap .byte bitmap_stride .byte $00,$00,$00,$00,$00 .word button_width + border_lt + border_br .word button_height + border_lt + border_br label: .byte '5' .word col2_left + 6, row3_bot box: .word col2_left,row3_top,col2_right,row3_bot .endproc .proc btn_6 .word col3_left - border_lt .word row3_top - border_lt .addr button_bitmap .byte bitmap_stride .byte $00,$00,$00,$00,$00 .word button_width + border_lt + border_br .word button_height + border_lt + border_br label: .byte '6' .word col3_left + 6, row3_bot box: .word col3_left,row3_top,col3_right,row3_bot .endproc .proc btn_sub .word col4_left - border_lt .word row3_top - border_lt .addr button_bitmap .byte bitmap_stride .byte $00,$00,$00,$00,$00 .word button_width + border_lt + border_br .word button_height + border_lt + border_br label: .byte '-' .word col4_left + 6, row3_bot box: .word col4_left,row3_top,col4_right,row3_bot .endproc .proc btn_1 .word col1_left - border_lt .word row4_top - border_lt .addr button_bitmap .byte bitmap_stride .byte $00,$00,$00,$00,$00 .word button_width + border_lt + border_br .word button_height + border_lt + border_br label: .byte '1' .word col1_left + 6, row4_bot box: .word col1_left,row4_top,col1_right,row4_bot .endproc .proc btn_2 .word col2_left - border_lt .word row4_top - border_lt .addr button_bitmap .byte bitmap_stride .byte $00,$00,$00,$00,$00 .word button_width + border_lt + border_br .word button_height + border_lt + border_br label: .byte '2' .word col2_left + 6, row4_bot box: .word col2_left,row4_top,col2_right,row4_bot .endproc .proc btn_3 .word col3_left - border_lt .word row4_top - border_lt .addr button_bitmap .byte bitmap_stride .byte $00,$00,$00,$00,$00 .word button_width + border_lt + border_br .word button_height + border_lt + border_br label: .byte '3' .word col3_left + 6, row4_bot box: .word col3_left,row4_top,col3_right,row4_bot .endproc .proc btn_0 .word col1_left - border_lt .word row5_top - border_lt .addr wide_button_bitmap .byte 8 ; bitmap_stride (bytes) .byte $00,$00,$00,$00,$00 .word 49 ; 0 is extra wide .word button_height + border_lt + border_br .byte '0' .word col1_left + 6, row5_bot box: .word col1_left,row5_top,col2_right,row5_bot .endproc .proc btn_dec .word col3_left - border_lt .word row5_top - border_lt .addr button_bitmap .byte bitmap_stride .byte $00,$00,$00,$00,$00 .word button_width + border_lt + border_br .word button_height + border_lt + border_br .byte '.' .word col3_left + 6 + 2, row5_bot ; + 2 to center the label box: .word col3_left,row5_top,col3_right,row5_bot .endproc .proc btn_add .word col4_left - border_lt .word row4_top - border_lt .addr tall_button_bitmap .byte bitmap_stride .byte $00,$00,$00,$00,$00 .word button_width + border_lt + border_br .word 27 ; + is extra tall .byte '+' .word col4_left + 6, row5_bot box: .word col4_left,row4_top,col4_right,row5_bot .endproc .byte 0 ; sentinel ;; Button bitmaps. These are used as bitmaps for ;; drawing the shadowed buttons. ;; bitmaps are low 7 bits, 0=black 1=white bitmap_stride := 3 ; bytes button_bitmap: ; bitmap for normal buttons .byte px(%0000000),px(%0000000),px(%0000001) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0000000),px(%0000000),px(%0000000) .byte px(%1000000),px(%0000000),px(%0000000) wide_bitmap_stride := 8 wide_button_bitmap: ; bitmap for '0' button .byte px(%0000000),px(%0000000),px(%0000000),px(%0000000),px(%0000000),px(%0000000),px(%0000000),px(%1111111) .byte px(%0111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111110),px(%0111111) .byte px(%0111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111110),px(%0111111) .byte px(%0111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111110),px(%0111111) .byte px(%0111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111110),px(%0111111) .byte px(%0111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111110),px(%0111111) .byte px(%0111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111110),px(%0111111) .byte px(%0111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111110),px(%0111111) .byte px(%0111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111110),px(%0111111) .byte px(%0111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111110),px(%0111111) .byte px(%0111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111111),px(%1111110),px(%0111111) .byte px(%0000000),px(%0000000),px(%0000000),px(%0000000),px(%0000000),px(%0000000),px(%0000000),px(%0111111) .byte px(%1000000),px(%0000000),px(%0000000),px(%0000000),px(%0000000),px(%0000000),px(%0000000),px(%0111111) tall_button_bitmap: ; bitmap for '+' button .byte px(%0000000),px(%0000000),px(%0000001) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0111111),px(%1111111),px(%1111100) .byte px(%0000000),px(%0000000),px(%0000000) .byte px(%1000000),px(%0000000),px(%0000000) ;;; ================================================== ;;; Calculation state saved_stack: .byte $00 ; restored after error calc_p: .byte $00 ; high bit set if pending op? calc_op:.byte $00 calc_d: .byte $00 ; '.' if decimal present, 0 otherwise calc_e: .byte $00 ; exponential? calc_n: .byte $00 ; negative? calc_g: .byte $00 ; high bit set if last input digit calc_l: .byte $00 ; input length ;;; ================================================== ;;; Miscellaneous param blocks .proc background_box_params left: .word 1 top: .word 0 right: .word 129 bottom: .word 96 .endproc background_pattern: .byte $77,$DD,$77,$DD,$77,$DD,$77,$DD .byte $00 black_pattern: .res 8, $00 .byte $00 white_pattern: .res 8, $FF .byte $00 ;; arg for $0C call ??? L0BEF: .byte $7F display_left := 10 display_top := 5 display_width := 120 display_height := 17 .proc frame_display_params left: .word display_left top: .word display_top width: .word display_width height: .word display_height .endproc .proc clear_display_params left: .word display_left+1 top: .word display_top+1 width: .word display_width-1 height: .word display_height-1 .endproc ;; For drawing 1-character strings (button labels) .proc draw_text_params_label .addr label .byte 1 .endproc label: .byte 0 ; modified with char to draw .proc draw_text_params1 addr: .addr text_buffer1 length: .byte 15 .endproc text_buffer_size := 14 text_buffer1: .res text_buffer_size+2, 0 .proc draw_text_params2 addr: .addr text_buffer2 length: .byte 15 .endproc text_buffer2: .res text_buffer_size+2, 0 spaces_string: A2D_DEFSTRING " " error_string: A2D_DEFSTRING "Error " ;; used when clearing display; params to a $18 call .proc measure_text_params addr: .addr text_buffer1 len: .byte 15 ; ??? width: .word 0 .endproc window_id = $34 .proc destroy_window_params id: .byte window_id .endproc .proc text_pos_params3 left: .word 0 base: .word 16 .endproc .proc text_pos_params2 left: .word 15 base: .word 16 .endproc .proc error_pos left: .word 69 base: .word 16 .endproc farg: .byte $00,$00,$00,$00,$00,$00 .proc title_bar_decoration ; Params for A2D_DRAW_BITMAP left: .word 115 ; overwritten top: .word $FFF7 ; overwritten bitmap:.addr pixels stride: .byte 1 .byte 0,0,0,0,0 ; ??? width: .word 6 height: .word 5 ;; (not part of struct, but not referenced outside) pixels: .byte px(%1000001) .byte px(%1010110) .byte px(%1110001) .byte px(%1110110) .byte px(%0110110) .byte px(%1001001) .endproc ;; param block for a QUERY_SCREEN and SET_STATE calls, and ref'd in QUERY_STATE call .proc state_params left: .word 0 top: .word 0 addr: .word 0 stride: .word 0 hoffset:.word 0 voffset:.word 0 width: .word 0 height: .word 0 pattern:.res 8, 0 mskand: .byte 0 mskor: .byte 0 .byte 0,0,0,0 ; ??? hthick: .byte 0 vthick: .byte 0 .byte 0,0,0,0,0 ; ??? .endproc menu_bar_height := 13 screen_width := 560 screen_height := 192 ;; params for A2D_SET_BOX when decorating title bar .proc screen_box .word 0 .word menu_bar_height .word A2D_SCREEN_ADDR .word A2D_SCREEN_STRIDE .word 0, 0 ; hoffset/voffset .word screen_width - 1 .word screen_height - menu_bar_height - 2 .endproc .proc fill_mode_normal mode: .byte A2D_SFM_NORMAL .endproc .byte $01,$02 ; ?? .proc fill_mode_xor mode: .byte A2D_SFM_XOR .endproc window_width := 130 window_height := 96 default_left := 210 default_top := 60 .proc create_window_params id: .byte window_id flags: .byte $02 .addr title hscroll:.byte 0 vscroll:.byte 0 hs_max: .byte 0 hs_pos: .byte 0 vs_max: .byte 0 vs_pos: .byte 0 .byte 0,0 ; ??? w1: .word window_width h1: .word window_height w2: .word window_width h2: .word window_height left: .word default_left top: .word default_top .word A2D_SCREEN_ADDR .word A2D_SCREEN_STRIDE hoffset:.word 0 voffset:.word 0 width: .word window_width height: .word window_height pattern:.res 8, $FF mskand: .byte A2D_DEFAULT_MSKAND mskor: .byte A2D_DEFAULT_MSKOR .byte 0,0,0,0 ; ??? hthick: .byte 1 vthick: .byte 1 .byte $00,$7F,$00,$88,$00,$00 ; ??? .endproc create_window_params_top := create_window_params::top title: PASCAL_STRING "Calc" ;; param block for $24 call (just before entering input loop) L0CE6: .byte $00,$00,$02,$00,$06,$00,$0E,$00 .byte $1E,$00,$3E,$00,$7E,$00,$1A,$00 .byte $30,$00,$30,$00,$60,$00,$00,$00 .byte $03,$00,$07,$00,$0F,$00,$1F,$00 .byte $3F,$00,$7F,$00,$7F,$01,$7F,$00 .byte $78,$00,$78,$00,$70,$01,$70,$01 .byte $01,$01 ;;; ================================================== ;;; DA Init init: sta ALTZPON lda LCBANK1 lda LCBANK1 A2D_CALL $1A, L08D4 A2D_CALL A2D_CREATE_WINDOW, create_window_params A2D_CALL A2D_QUERY_SCREEN, state_params A2D_CALL A2D_SET_STATE, state_params ; set clipping bounds? A2D_CALL $2B ; reset drawing state? lda #$01 sta input_state_params::state A2D_CALL $2D, input_state_params A2D_CALL A2D_GET_INPUT, input_state_params lda ROMIN2 jsr reset_buffer2 lda #window_id jsr draw_window jsr reset_buffers_and_display lda #'=' ; last operation sta calc_op lda #0 ; clear registers sta calc_p sta calc_d sta calc_e sta calc_n sta calc_g sta calc_l .proc copy_to_b1 ldx #(end_adjust_txtptr_copied - adjust_txtptr_copied + 4) ; should be just + 1 ? loop: lda adjust_txtptr_copied-1,x sta adjust_txtptr-1,x dex bne loop .endproc lda #0 ; Turn off errors sta ERRFLG lda #error_hook sta COUT_HOOK+1 lda #1 jsr FLOAT ldx #farg jsr ROUND lda #0 ; set FAC to 0 jsr FLOAT jsr FADD jsr FOUT lda #$07 jsr FMULT lda #$00 jsr FLOAT ldx #farg jsr ROUND tsx stx saved_stack lda #'=' jsr process_key lda #'C' jsr process_key A2D_CALL $24, L0CE6 ;; fall through ;;; ================================================== ;;; Input Loop input_loop: A2D_CALL A2D_GET_INPUT, input_state_params lda input_state_params::state cmp #A2D_INPUT_DOWN bne :+ jsr on_click jmp input_loop : cmp #A2D_INPUT_KEY bne input_loop jsr on_key_press jmp input_loop ;;; ================================================== ;;; On Click on_click: lda LCBANK1 lda LCBANK1 A2D_CALL A2D_QUERY_TARGET, target_params lda ROMIN2 lda target_params::elem cmp #A2D_ELEM_CLIENT ; Less than CLIENT is MENU or DESKTOP bcc ignore_click lda target_params::id cmp #window_id ; This window? beq :+ ignore_click: rts : lda target_params::elem cmp #A2D_ELEM_CLIENT ; Client area? bne :+ jsr map_click_to_button ; try to translate click into key bcc ignore_click jmp process_key : cmp #A2D_ELEM_CLOSE ; Close box? bne :+ A2D_CALL A2D_CLOSE_CLICK, close_click_params lda close_click_params::state beq ignore_click exit: lda LCBANK1 lda LCBANK1 A2D_CALL A2D_DESTROY_WINDOW, destroy_window_params jsr UNKNOWN_CALL .byte $0C .addr 0 lda ROMIN2 A2D_CALL $1A, L08D5 ; ??? one byte input value? .proc do_close ;; Copy following routine to ZP and invoke it zp_stash := $20 ldx #(routine_end - routine) loop: lda routine,x sta zp_stash,x dex bpl loop jmp zp_stash .proc routine sta RAMRDOFF sta RAMWRTOFF jmp exit_da .endproc routine_end := * ; Can't use .sizeof before the .proc definition .endproc : cmp #A2D_ELEM_TITLE ; Title bar? bne ignore_click lda #window_id sta drag_params::id lda LCBANK1 lda LCBANK1 A2D_CALL A2D_DRAG_WINDOW, drag_params lda ROMIN2 jsr call_4015_main ; redraws window rts ;;; ================================================== ;;; On Key Press .proc on_key_press lda input_state_params::modifiers bne bail lda input_state_params::key cmp #KEY_ESCAPE bne trydel lda calc_p bne clear ; empty state? lda calc_l beq exit ; if so, exit DA clear: lda #'C' ; otherwise turn Escape into Clear trydel: cmp #$7F ; Delete? beq :+ cmp #$60 ; lowercase range? bcc :+ and #$5F ; convert to uppercase : jmp process_key bail: .endproc rts1: rts ; used by next proc ;;; ================================================== ;;; Try to map a click to a button ;;; If a button was clicked, carry is set and accum has key char .proc map_click_to_button lda #window_id sta map_coords_params::id A2D_CALL A2D_MAP_COORDS, map_coords_params lda map_coords_params::clientx+1 ; ensure high bits of coords are 0 ora map_coords_params::clienty+1 bne rts1 lda map_coords_params::clienty ldx map_coords_params::clientx .proc find_button_row cmp #row1_top+border_lt - 1 ; row 1 ? (- 1 is bug in original?) bcc miss cmp #row1_bot+border_br + 1 ; (+ 1 is bug in original?) bcs :+ jsr find_button_col bcc miss lda row1_lookup,x rts : cmp #row2_top-border_lt ; row 2? bcc miss cmp #row2_bot+border_br bcs :+ jsr find_button_col bcc miss lda row2_lookup,x rts : cmp #row3_top-border_lt ; row 3? bcc miss cmp #row3_bot+border_br bcs :+ jsr find_button_col bcc miss lda row3_lookup,x rts : cmp #row4_top-border_lt ; row 4? bcc miss cmp #row4_bot+border_br bcs :+ jsr find_button_col bcc miss sec lda row4_lookup,x rts : cmp #row5_top-border_lt ; special case for tall + button bcs :+ lda map_coords_params::clientx cmp #col4_left-border_lt bcc miss cmp #col4_right+border_br-1 ; is -1 bug in original? bcs miss lda #'+' sec rts : cmp #row5_bot+border_br ; row 5? bcs miss jsr find_button_col bcc :+ lda row5_lookup,x rts : lda map_coords_params::clientx ; special case for wide 0 button cmp #col1_left-border_lt bcc miss cmp #col2_right+border_br bcs miss lda #'0' sec rts miss: clc rts .endproc row1_lookup := *-1 .byte 'C', 'E', '=', '*' row2_lookup := *-1 .byte '7', '8', '9', '/' row3_lookup := *-1 .byte '4', '5', '6', '-' row4_lookup := *-1 .byte '1', '2', '3', '+' row5_lookup := *-1 .byte '0', '0', '.', '+' .proc find_button_col cpx #col1_left-border_lt ; col 1? bcc miss cpx #col1_right+border_br bcs :+ ldx #1 sec rts : cpx #col2_left-border_lt ; col 2? bcc miss cpx #col2_right+border_br bcs :+ ldx #2 sec rts : cpx #col3_left-border_lt ; col 3? bcc miss cpx #col3_right+border_br bcs :+ ldx #3 sec rts : cpx #col4_left-border_lt ; col 4? bcc miss cpx #col4_right+border_br - 1 ; bug in original? bcs miss ldx #4 sec rts miss: clc rts .endproc .endproc ;;; ================================================== ;;; Handle Key ;;; Accumulator is set to key char. Also used by ;;; click handlers (button is mapped to key char) ;;; and during initialization (by sending 'C', etc) .proc process_key cmp #'C' ; Clear? bne :+ ldx #btn_c::box lda #'c' jsr depress_button lda #$00 jsr FLOAT ldx #farg jsr ROUND lda #'=' sta calc_op lda #0 sta calc_p sta calc_l sta calc_d sta calc_e sta calc_n jmp reset_buffers_and_display : cmp #'E' ; Exponential? bne try_eq ldx #btn_e::box lda #'e' jsr depress_button ldy calc_e bne rts1 ldy calc_l bne :+ inc calc_l lda #'1' sta text_buffer1 + text_buffer_size sta text_buffer2 + text_buffer_size : lda #'E' sta calc_e jmp update rts1: rts try_eq: cmp #'=' ; Equals? bne :+ pha ldx #btn_eq::box jmp do_op_click : cmp #'*' ; Multiply? bne :+ pha ldx #btn_mul::box jmp do_op_click : cmp #'.' ; Decimal? bne try_add ldx #btn_dec::box jsr depress_button lda calc_d ora calc_e bne rts2 lda calc_l bne :+ inc calc_l : lda #'.' sta calc_d jmp update rts2: rts try_add:cmp #'+' ; Add? bne :+ pha ldx #btn_add::box jmp do_op_click : cmp #'-' ; Subtract? bne trydiv pha ldx #btn_sub::box lda calc_e ; negate vs. subtract beq :+ lda calc_n bne :+ sec ror calc_n pla pha jmp do_digit_click : pla pha jmp do_op_click trydiv: cmp #'/' ; Divide? bne :+ pha ldx #btn_div::box jmp do_op_click : cmp #'0' ; Digit 0? bne :+ pha ldx #btn_0::box jmp do_digit_click : cmp #'1' ; Digit 1? bne :+ pha ldx #btn_1::box jmp do_digit_click : cmp #'2' ; Digit 2? bne :+ pha ldx #btn_2::box jmp do_digit_click : cmp #'3' ; Digit 3? bne :+ pha ldx #btn_3::box jmp do_digit_click : cmp #'4' ; Digit 4? bne :+ pha ldx #btn_4::box jmp do_digit_click : cmp #'5' ; Digit 5? bne :+ pha ldx #btn_5::box jmp do_digit_click : cmp #'6' ; Digit 6? bne :+ pha ldx #btn_6::box jmp do_digit_click : cmp #'7' ; Digit 7? bne :+ pha ldx #btn_7::box jmp do_digit_click : cmp #'8' ; Digit 8? bne :+ pha ldx #btn_8::box jmp do_digit_click : cmp #'9' ; Digit 9? bne :+ pha ldx #btn_9::box jmp do_digit_click : cmp #$7F ; Delete? bne end ldy calc_l beq end cpy #1 bne :+ jsr reset_buffer1_and_state jmp display_buffer1 : dec calc_l ldx #0 lda text_buffer1 + text_buffer_size cmp #'.' bne :+ stx calc_d : cmp #'E' bne :+ stx calc_e : cmp #'-' bne :+ stx calc_n : ldx #text_buffer_size-1 loop: lda text_buffer1,x sta text_buffer1+1,x sta text_buffer2+1,x dex dey bne loop lda #' ' sta text_buffer1+1,x sta text_buffer2+1,x jmp display_buffer1 end: rts .endproc do_digit_click: jsr depress_button bne :+ pla rts : pla update: sec ror calc_g ldy calc_l bne :+ pha jsr reset_buffer2 pla cmp #'0' bne :+ jmp display_buffer1 : sec ror calc_p cpy #$0A bcs rts3 pha ldy calc_l beq empty lda #$0F sec sbc calc_l tax : lda text_buffer1,x sta text_buffer1-1,x sta text_buffer2-1,x inx dey bne :- empty: inc calc_l pla sta text_buffer1 + text_buffer_size sta text_buffer2 + text_buffer_size jmp display_buffer1 rts3: rts .proc do_op_click jsr depress_button bne :+ pla rts : lda calc_op cmp #'=' bne :+ lda calc_g bne reparse lda #$00 jsr FLOAT jmp do_op : lda calc_g bne reparse pla sta calc_op jmp reset_buffer1_and_state reparse:lda #text_buffer1 sta TXTPTR+1 jsr adjust_txtptr jsr FIN do_op: pla ldx calc_op sta calc_op lda #farg cpx #'+' bne :+ jsr FADD jmp post_op : cpx #'-' bne :+ jsr FSUB jmp post_op : cpx #'*' bne :+ jsr FMULT jmp post_op : cpx #'/' bne :+ jsr FDIV jmp post_op : cpx #'=' bne post_op ldy calc_g bne post_op jmp reset_buffer1_and_state .endproc .proc post_op ldx #farg jsr ROUND jsr FOUT ; output as null-terminated string to FBUFFR ldy #0 ; count the eize sloop: lda FBUFFR,y beq :+ iny bne sloop : ldx #text_buffer_size ; copy to text buffers cloop: lda FBUFFR-1,y sta text_buffer1,x sta text_buffer2,x dex dey bne cloop cpx #0 ; pad out with spaces if needed bmi end pad: lda #' ' sta text_buffer1,x sta text_buffer2,x dex bpl pad end: jsr display_buffer1 ; fall through .endproc .proc reset_buffer1_and_state jsr reset_buffer1 lda #0 sta calc_l sta calc_d sta calc_e sta calc_n sta calc_g rts .endproc .proc depress_button button_state := $FC stx invert_addr stx c13_addr stx restore_addr sty invert_addr+1 sty c13_addr+1 sty restore_addr+1 A2D_CALL A2D_SET_PATTERN, black_pattern A2D_CALL A2D_SET_FILL_MODE, fill_mode_xor sec ror button_state invert: A2D_CALL A2D_FILL_RECT, 0, invert_addr ; Inverts box check_button: A2D_CALL A2D_GET_INPUT, input_state_params lda input_state_params::state cmp #A2D_INPUT_HELD ; Button down? bne done ; Nope, done immediately lda #window_id sta map_coords_params::id A2D_CALL A2D_MAP_COORDS, map_coords_params A2D_CALL A2D_SET_POS, map_coords_params::client A2D_CALL A2D_TEST_BOX, 0, c13_addr bne inside lda button_state ; outside, not down beq check_button ; so keep looping lda #0 ; outside, was down sta button_state ; so set up beq invert ; and show it inside: lda button_state ; inside, and down bne check_button ; so keep looking sec ; inside, was not down ror button_state ; so set down jmp invert ; and show it done: lda button_state ; high bit set if button down beq :+ A2D_CALL A2D_FILL_RECT, 0, restore_addr ; Inverts back to normal : A2D_CALL A2D_SET_FILL_MODE, fill_mode_normal ; Normal draw mode?? lda button_state rts .endproc ;;; ================================================== ;;; Value Display .proc reset_buffer1 ldy #text_buffer_size loop: lda #' ' sta text_buffer1-1,y dey bne loop lda #'0' sta text_buffer1 + text_buffer_size rts .endproc .proc reset_buffer2 ldy #text_buffer_size loop: lda #' ' sta text_buffer2-1,y dey bne loop lda #'0' sta text_buffer2 + text_buffer_size rts .endproc .proc reset_buffers_and_display jsr reset_buffer1 jsr reset_buffer2 ; fall through .endproc .proc display_buffer1 ldx #text_buffer1 jsr pre_display_buffer A2D_CALL A2D_DRAW_TEXT, draw_text_params1 rts .endproc .proc display_buffer2 ldx #text_buffer2 jsr pre_display_buffer A2D_CALL A2D_DRAW_TEXT, draw_text_params2 rts .endproc .proc pre_display_buffer stx measure_text_params::addr ; text buffer address in x,y sty measure_text_params::addr+1 A2D_CALL A2D_MEASURE_TEXT, measure_text_params lda #display_width-15 ; ??? sec sbc measure_text_params::width sta text_pos_params3::left A2D_CALL A2D_SET_POS, text_pos_params2 ; clear with spaces A2D_CALL A2D_DRAW_TEXT, spaces_string A2D_CALL A2D_SET_POS, text_pos_params3 ; set up for display rts .endproc ;;; ================================================== ;;; Draw the window contents (background, buttons) .proc draw_background ;; Frame A2D_CALL A2D_HIDE_CURSOR A2D_CALL A2D_SET_PATTERN, background_pattern A2D_CALL A2D_FILL_RECT, background_box_params A2D_CALL A2D_SET_PATTERN, black_pattern A2D_CALL A2D_DRAW_RECT, frame_display_params A2D_CALL A2D_SET_PATTERN, white_pattern A2D_CALL A2D_FILL_RECT, clear_display_params A2D_CALL $0C, L0BEF ; ??? ;; fall through .endproc .proc draw_buttons ;; Buttons ptr := $FA lda #btn_c sta ptr+1 loop: ldy #0 lda (ptr),y beq draw_title_bar ; done! lda ptr ; address for shadowed rect params sta bitmap_addr ldy ptr+1 sty bitmap_addr+1 clc ; address for label pos adc #(btn_c::pos - btn_c) sta text_addr bcc :+ iny : sty text_addr+1 ldy #(btn_c::label - btn_c) ; label lda (ptr),y sta label A2D_CALL A2D_DRAW_BITMAP, 0, bitmap_addr ; draw shadowed rect A2D_CALL A2D_SET_POS, 0, text_addr ; button label pos A2D_CALL A2D_DRAW_TEXT, draw_text_params_label ; button label text lda ptr ; advance to next record clc adc #.sizeof(btn_c) sta ptr bcc loop inc ptr+1 jmp loop .endproc ;;; ================================================== ;;; Draw the title bar decoration draw_title_bar: offset_left := 115 ; pixels from left of client area offset_top := 22 ; pixels from top of client area (up!) ldx create_window_params::left+1 lda create_window_params::left clc adc #offset_left sta title_bar_decoration::left bcc :+ inx : stx title_bar_decoration::left+1 ldx create_window_params::top+1 lda create_window_params::top sec sbc #offset_top sta title_bar_decoration::top bcs :+ dex : stx title_bar_decoration::top+1 A2D_CALL A2D_SET_BOX, screen_box ; set clipping rect to whole screen A2D_CALL A2D_DRAW_BITMAP, title_bar_decoration ; Draws decoration in title bar lda #window_id sta query_state_params::id A2D_CALL A2D_QUERY_STATE, query_state_params A2D_CALL A2D_SET_STATE, state_params A2D_CALL A2D_SHOW_CURSOR jsr display_buffer2 rts ;; Traps FP error via call to $36 from MON.COUT, resets stack ;; and returns to the input loop. .proc error_hook jsr reset_buffers_and_display A2D_CALL A2D_SET_POS, error_pos A2D_CALL A2D_DRAW_TEXT, error_string jsr reset_buffer1_and_state lda #'=' sta calc_op ldx saved_stack txs jmp input_loop .endproc ;; Following proc is copied to $B1 .proc adjust_txtptr_copied loop: inc TXTPTR bne :+ inc TXTPTR+1 : lda $EA60 ; this ends up being aligned on TXTPTR cmp #'9'+1 ; after digits? bcs end cmp #' ' ; space? keep going beq loop sec sbc #'0' ; convert to digit... sec sbc #$D0 ; carry set if successful end: rts .endproc end_adjust_txtptr_copied := * da_end := *