.setcpu "6502" .include "apple2.inc" .include "../inc/apple2.inc" .include "../inc/prodos.inc" .include "../inc/macros.inc" DESKTOP_INIT := $0800 ; init location L7ECA := $7ECA ; ??? ;;; ============================================================ ;;; Patch self in as ProDOS QUIT routine (LCBank2 $D100) ;;; and invoke QUIT. Note that only $200 bytes are copied. .proc install_as_quit .org $2000 src := quit_routine dst := SELECTOR lda LCBANK2 lda LCBANK2 ldy #$00 loop: lda src,y sta dst,y lda src+$100,y sta dst+$100,y dey bne loop lda ROMIN2 MLI_CALL QUIT, quit_params DEFINE_QUIT_PARAMS quit_params .endproc ; install_as_quit ;;; ============================================================ ;;; New QUIT routine. Gets relocated to $1000 by ProDOS before ;;; being executed. .proc quit_routine .org $1000 self: jmp start reinstall_flag: ; set once prefix saved and reinstalled .byte 0 .byte "Mouse Desk" .byte 0 splash_string: PASCAL_STRING "Loading Apple II DeskTop" filename: PASCAL_STRING "DeskTop2" DEFINE_READ_PARAMS read_params, $1E00, $400 ; so the $200 byte mark ends up at $2000 DEFINE_CLOSE_PARAMS close_params DEFINE_SET_PREFIX_PARAMS prefix_params, prefix_buffer DEFINE_OPEN_PARAMS open_params, filename, $1A00 start: lda ROMIN2 ;; Show a splash message on 80 column text screen jsr SETVID jsr SETKBD sta CLR80VID sta SETALTCHAR sta CLR80COL jsr SLOT3ENTRY jsr HOME lda #$00 ; IIgs specific ??? sta SHADOW lda #$40 sta RAMWRTON sta $0100 ; ??? sta $0101 ; ??? sta RAMWRTOFF lda #12 ; VTAB 12 sta CV jsr VTAB lda #80 ; HTAB (80-width)/2 sec ; to center sbc splash_string lsr a sta CH ldy #$00 : lda splash_string+1,y ora #$80 jsr COUT iny cpy splash_string bne :- ;; Close all open files (???) MLI_CALL CLOSE, close_params ;; Initialize system memory bitmap ldx #BITMAP_SIZE-1 lda #$01 ; Protect ProDOS global page sta BITMAP,x dex lda #$00 : sta BITMAP,x dex bpl :- lda #%11001111 ; Protect ZP, stack, Text Page 1 sta BITMAP lda reinstall_flag bne no_reinstall ;; Re-install quit routine (with prefix memorized) MLI_CALL GET_PREFIX, prefix_params beq :+ jmp crash : lda #$FF sta reinstall_flag copy16 IRQ_VECTOR, irq_saved lda LCBANK2 lda LCBANK2 ldy #0 : lda self,y sta SELECTOR,y lda self+$100,y sta SELECTOR+$100,y dey bne :- lda ROMIN2 jmp done_reinstall no_reinstall: copy16 irq_saved, IRQ_VECTOR done_reinstall: ;; Set the prefix, read the first $400 bytes of this system ;; file in (at $1E00), and invoke $200 bytes into it (at $2000) MLI_CALL SET_PREFIX, prefix_params beq :+ jmp prompt_for_system_disk : MLI_CALL OPEN, open_params beq :+ jmp crash : lda open_params::ref_num sta read_params::ref_num MLI_CALL READ, read_params beq :+ jmp crash : MLI_CALL CLOSE, close_params beq :+ jmp crash : jmp $2000 ; Invoke system file ;; Display a string, and wait for Return keypress prompt_for_system_disk: jsr SLOT3ENTRY ; 80 column mode jsr HOME lda #12 ; VTAB 12 sta CV jsr VTAB lda #80 ; HTAB (80 - width)/2 sec ; to center the string sbc disk_prompt lsr a sta CH ldy #$00 : lda disk_prompt+1,y ora #$80 jsr COUT iny cpy disk_prompt bne :- wait: sta KBDSTRB : lda KBD bpl :- and #CHAR_MASK cmp #$0D ; Return bne wait jmp start disk_prompt: PASCAL_STRING "Insert the system disk and Press Return." irq_saved: .addr 0 crash: sta $6 ; Crash? jmp MONZ prefix_buffer: .res 64, 0 .endproc ; quit_routine ;;; ============================================================ ;;; This chunk is invoked at $2000 after the quit handler has been invoked ;;; and updated itself. Using the segment_*_tables below, this loads the ;;; DeskTop application into various parts of main, aux, and bank-switched ;;; memory, then invokes the DeskTop initialization routine. .proc install_segments ;; Pad to be at $200 into the file .res $200 - (.sizeof(install_as_quit) + .sizeof(quit_routine)), 0 .org $2000 jmp start DEFINE_OPEN_PARAMS open_params, filename, $3000 DEFINE_READ_PARAMS read_params, 0, 0 DEFINE_CLOSE_PARAMS close_params DEFINE_SET_MARK_PARAMS set_mark_params, $580 ; This many bytes before the good stuff. filename: PASCAL_STRING "DeskTop2" ;;; Consecutive segments are loaded, |size| bytes are loaded at |addr| ;;; then relocated to |dest| according to |type|. ;;; Segments are: ;;; $4000 aux - MGTK and DeskTop code ;;; $D000 aux/banked - DeskTop code callable from main, and resources ;;; $FB00 aux/banked - more DeskTop resources (icons, strings, etc) ;;; $4000 main - more DeskTop code ;;; $0800 main - DeskTop initialization code; later overwritten by DAs ;;; $0290 main - Routine to invoke other programs segment_addr_table: .word $3F00,$4000,$4000,$4000,$0800,$0290 segment_dest_table: .addr $4000,$D000,$FB00,$4000,$0800,$0290 segment_size_table: .word $8000,$1D00,$0500,$7F00,$0800,$0160 segment_type_table: ; 0 = main, 1 = aux, 2 = banked (aux) .byte 1,2,2,0,0,0 num_segments: .byte 6 start: ;; Configure system bitmap - everything is available ldx #BITMAP_SIZE-1 lda #0 : sta BITMAP+1,x dex bpl :- ;; Open this system file MLI_CALL OPEN, open_params beq :+ brk ; crash : lda open_params::ref_num sta set_mark_params::ref_num sta read_params::ref_num MLI_CALL SET_MARK, set_mark_params beq :+ brk ; crash : lda #0 sta segment_num loop: lda segment_num cmp num_segments bne continue ;; Close and invoke DeskTop init routine MLI_CALL CLOSE, close_params beq :+ brk ; crash : jmp DESKTOP_INIT continue: asl a tax copy16 segment_addr_table,x, read_params::data_buffer copy16 segment_size_table,x, read_params::request_count MLI_CALL READ, read_params beq :+ brk ; crash : ldx segment_num lda segment_type_table,x beq next_segment ; type 0 = main, so done cmp #2 beq :+ jsr aux_segment jmp next_segment : jsr banked_segment next_segment: inc segment_num jmp loop segment_num: .byte 0 ;; Handle bank-switched memory segment .proc banked_segment src := $6 dst := $8 sta ALTZPON lda LCBANK1 lda LCBANK1 lda #$80 ; ??? sta $0100 sta $0101 lda #0 sta src sta dst lda segment_num asl a tax lda segment_dest_table+1,x sta dst+1 lda read_params::data_buffer+1 sta src+1 clc adc segment_size_table+1,x sta max_page lda segment_size_table,x beq :+ inc max_page : ldy #0 loop: lda (src),y sta (dst),y iny bne loop inc src+1 inc dst+1 lda src+1 cmp max_page bne loop sta ALTZPOFF lda ROMIN2 rts max_page: .byte 0 .endproc ;; Handle aux memory segment .proc aux_segment src := $6 dst := $8 lda #0 sta src sta dst lda segment_num asl a tax lda segment_dest_table+1,x sta dst+1 lda read_params::data_buffer+1 sta src+1 clc adc segment_size_table+1,x sta max_page sta RAMRDOFF sta RAMWRTON ldy #0 loop: lda (src),y sta (dst),y iny bne loop inc src+1 inc dst+1 lda src+1 cmp max_page bne loop sta RAMWRTOFF rts max_page: .byte 0 .endproc PAD_TO $2200 .endproc ; install_segments ;;; ============================================================ ;;; Not sure where this could be invoked from .proc dump_screen .org $280 SLOT1 := $C100 hbasl := $6 screen_width = 560 screen_height = 192 ;; Test for OpenApple+SolidApple+P pha lda BUTN0 and BUTN1 bpl :+ lda KBD cmp #('P' | $80) beq invoke : pla jmp L7ECA ; ??? invoke: sta KBDSTRB sta SET80COL sta SET80VID sta DHIRESON lda TXTCLR lda HIRES sta ALTZPOFF sta ROMIN2 lda #0 sta y_row jmp print_screen .proc send_spacing ldy #0 : lda spacing_sequence,y beq done jsr cout iny jmp :- done: rts .endproc .proc send_restore_state ldy #$00 : lda restore_state,y beq done jsr cout iny jmp :- done: rts .endproc .proc send_init_graphics ldx #0 : lda init_graphics,x jsr cout inx cpx #6 bne :- rts init_graphics: .byte CHAR_ESCAPE,"G0560" ; Graphics, 560 data bytes .endproc .proc send_row ;; Tell printer to expect graphics jsr send_init_graphics ldy #0 sty col_num lda #1 sta mask lda #0 sta x_coord sta x_coord+1 col_loop: lda #8 ; 8 vertical pixels per row sta count lda y_row sta y_coord ;; Accumulate 8 pixels y_loop: lda y_coord jsr compute_hbasl ; Row address in screen lda col_num lsr a ; Even or odd column? tay sta PAGE2OFF ; By default, read main mem $2000-$3FFF bcs :+ ; But even columns come from aux, so... sta PAGE2ON ; Read aux mem $2000-$3FFF : lda (hbasl),y ; Grab the whole byte and mask ; Isolate the pixel we care about cmp #1 ; Set carry if non-zero ror accum ; And slide it into place inc y_coord dec count bne y_loop ;; Send the 8 pixels to the printer. lda accum ; Now output it eor #$FF ; Invert pixels (screen vs. print) sta PAGE2OFF ; Read main mem $2000-$3FFF jsr cout ; And actually print ;; Done all pixels across? lda x_coord cmp #<(screen_width-1) bne :+ lda x_coord+1 cmp #>(screen_width-1) beq done ;; Next pixel to the right : asl mask bpl :+ ; Only 7 pixels per column lda #1 sta mask inc col_num : inc x_coord bne col_loop inc x_coord+1 bne col_loop done: sta PAGE2OFF ; Read main mem $2000-$3FFF rts .endproc .proc print_screen ;; Init printer jsr pr_num_1 jsr send_spacing ;; Print a row (560x8), CR+LF loop: jsr send_row lda #CHAR_RETURN jsr cout lda #CHAR_DOWN jsr cout lda y_coord sta y_row cmp #screen_height bcc loop ;; Finish up lda #CHAR_RETURN jsr cout lda #CHAR_RETURN jsr cout jsr send_restore_state sta ALTZPON lda LCBANK1 lda LCBANK1 rts .endproc ;; Given y-coordinate in A, compute HBASL-equivalent .proc compute_hbasl pha and #$C7 eor #$08 sta $07 and #$F0 lsr a lsr a lsr a sta hbasl pla and #$38 asl a asl a eor hbasl asl a rol hbasl+1 asl a rol hbasl+1 eor hbasl sta hbasl rts .endproc .proc pr_num_1 lda #>SLOT1 sta COUT_HOOK+1 lda #