Apple-2-SW/a2d
1
0
Fork 0
mirror of https://github.com/mi57730/a2d.git synced 2025-03-21 08:30:10 +00:00
Code Issues Projects Releases Wiki Activity

Restore new DAs to fixes branch

Browse Source 
This reverts commit 6788d153af2bac069ff3508cecca972be0989926.
This commit is contained in:
Joshua Bell 2018-12-09 20:08:57 -08:00
parent 2aaf5dc8b4
commit d8baeddbe0
8 changed files with 3151 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
desk.acc/README.md
View File

@ -6,6 +6,17 @@ Disassembly of the original desk accessories:
* [Show Text File](show.text.file.s) - in progress! 95% complete
* [Sort Directory](sort.directory.s) - in progress! 60% complete
New desk accessories:
* [Show Image File](show.image.file.s)
* Select an image file (8k Hires or 16k Double Hires), then choose this DA to preview it.
* [This Apple](this.apple.s)
* Gives details about the computer, expanded memory, and what's in each slot.
* [Eyes](eyes.s)
* Eyes that follow the mouse.
* [Screen Dump](screen.dump.s)
* Dumps a screenshot to an ImageWriter II attached to a Super Serial Card in Slot 1.
See [API.md](API.md) for programming details
## Files
@ -17,10 +28,10 @@ See [API.md](API.md) for programming details
## Build Instructions
On Unix-like systems (including Mac OS X) `make all` should build
the desk accessory files into `out/`
the desk accessory files (original and new) into `out/`
output with a `.built` suffix.
The `.built` and `.bin` files can be compared
For the original DAs, the `.built` and `.bin` files can be compared
using `diff` to ensure that no changes have been introduced by the
disassembly process.

5
desk.acc/TARGETS
View File

@ -3,3 +3,8 @@ show.text.file
date
puzzle
sort.directory
show.image.file
this.apple
eyes
screen.dump
run.basic.here

685
desk.acc/eyes.s Normal file
View File

@ -0,0 +1,685 @@
.setcpu "6502"
.include "apple2.inc"
.include "../inc/apple2.inc"
.include "../mgtk.inc"
.include "../desktop.inc"
.include "../macros.inc"
.include "../inc/fp_macros.inc"
;;; ============================================================
.org $800
entry:
;;; Copy the DA to AUX for easy bank switching
.scope
lda ROMIN2
copy16 #$0800, STARTLO
copy16 #da_end, ENDLO
copy16 #$0800, DESTINATIONLO
sec ; main>aux
jsr AUXMOVE
lda LCBANK1
lda LCBANK1
.endscope
.scope
;; run the DA
sta RAMRDON
sta RAMWRTON
jsr init
;; tear down/exit
sta ALTZPON
lda LCBANK1
lda LCBANK1
;; back to main for exit
sta RAMRDOFF
sta RAMWRTOFF
rts
.endscope
;;; ============================================================
da_window_id := 60
da_width := screen_width / 3
da_height := screen_height / 3
da_left := (screen_width - da_width)/2
da_top := 50
str_title:
PASCAL_STRING "Eyes"
;;; TODO: Allow resizing
.proc winfo
window_id: .byte da_window_id
options: .byte MGTK::Option::go_away_box
title: .addr str_title
hscroll: .byte MGTK::Scroll::option_none
vscroll: .byte MGTK::Scroll::option_none
hthumbmax: .byte 32
hthumbpos: .byte 0
vthumbmax: .byte 32
vthumbpos: .byte 0
status: .byte 0
reserved: .byte 0
mincontwidth: .word screen_width / 5
mincontlength: .word screen_height / 5
maxcontwidth: .word screen_width
maxcontlength: .word screen_height
port:
viewloc: DEFINE_POINT da_left, da_top
mapbits: .addr MGTK::screen_mapbits
mapwidth: .word MGTK::screen_mapwidth
maprect: DEFINE_RECT 0, 0, da_width, da_height, maprect
pattern: .res 8, $FF
colormasks: .byte MGTK::colormask_and, MGTK::colormask_or
penloc: DEFINE_POINT 0, 0
penwidth: .byte 1
penheight: .byte 1
penmode: .byte 0
textback: .byte $7F
textfont: .addr DEFAULT_FONT
nextwinfo: .addr 0
.endproc
;;; ============================================================
.proc event_params
kind: .byte 0
;;; EventKind::key_down
key := *
modifiers := * + 1
;;; EventKind::update
window_id := *
;;; otherwise
xcoord := *
ycoord := * + 2
.res 4
.endproc
.proc findwindow_params
mousex: .word 0
mousey: .word 0
which_area: .byte 0
window_id: .byte 0
.endproc
.proc trackgoaway_params
clicked: .byte 0
.endproc
.proc dragwindow_params
window_id: .byte 0
dragx: .word 0
dragy: .word 0
moved: .byte 0
.endproc
.proc winport_params
window_id: .byte da_window_id
port: .addr grafport
.endproc
.proc preserve_zp_params
flag: .byte MGTK::zp_preserve
.endproc
.proc overwrite_zp_params
flag: .byte MGTK::zp_overwrite
.endproc
.proc screentowindow_params
window_id: .byte da_window_id
DEFINE_POINT 0, 0, screen
DEFINE_POINT 0, 0, window
.endproc
mx := screentowindow_params::window::xcoord
my := screentowindow_params::window::ycoord
.proc grafport
viewloc: DEFINE_POINT 0, 0
mapbits: .word 0
mapwidth: .word 0
cliprect: DEFINE_RECT 0, 0, 0, 0
pattern: .res 8, 0
colormasks: .byte 0, 0
penloc: DEFINE_POINT 0, 0
penwidth: .byte 0
penheight: .byte 0
penmode: .byte 0
textback: .byte 0
textfont: .addr 0
.endproc
grow_box_width := 17
grow_box_height := 7
.proc grow_box_params
viewloc: DEFINE_POINT 0, 0, viewloc
mapbits: .addr grow_box_bitmap
mapwidth: .byte 3
reserved: .byte 0
cliprect: DEFINE_RECT 2, 2, 19, 9
.endproc
grow_box_bitmap:
.byte px(%1111111),px(%1111111),px(%1111111)
.byte px(%1000000),px(%0000000),px(%0000001)
.byte px(%1001111),px(%1111110),px(%0000001)
.byte px(%1001100),px(%0000111),px(%1111001)
.byte px(%1001100),px(%0000110),px(%0011001)
.byte px(%1001100),px(%0000110),px(%0011001)
.byte px(%1001111),px(%1111110),px(%0011001)
.byte px(%1000011),px(%0000000),px(%0011001)
.byte px(%1000011),px(%1111111),px(%1111001)
.byte px(%1000000),px(%0000000),px(%0000001)
.byte px(%1111111),px(%1111111),px(%1111111)
;;; ============================================================
.proc init
sta ALTZPON
lda LCBANK1
lda LCBANK1
;; Don't let MGTK smash zero page
MGTK_CALL MGTK::SetZP1, preserve_zp_params
lda #0
sta SHIFT_SIGN_EXT ; Must zero before using FP ops
MGTK_CALL MGTK::OpenWindow, winfo
jsr draw_window
MGTK_CALL MGTK::FlushEvents
;; fall through
.endproc
.proc input_loop
MGTK_CALL MGTK::GetEvent, event_params
bne exit
lda event_params::kind
cmp #MGTK::EventKind::button_down
beq handle_down
cmp #MGTK::EventKind::key_down
beq handle_key
cmp #MGTK::EventKind::no_event
beq handle_no_event
jmp input_loop
.endproc
.proc exit
MGTK_CALL MGTK::CloseWindow, winfo
DESKTOP_CALL DT_REDRAW_ICONS
MGTK_CALL MGTK::SetZP1, overwrite_zp_params
rts
.endproc
;;; ============================================================
.proc handle_key
lda event_params::key
cmp #CHAR_ESCAPE
beq exit
bne input_loop
.endproc
;;; ============================================================
.proc handle_down
copy16 event_params::xcoord, findwindow_params::mousex
copy16 event_params::ycoord, findwindow_params::mousey
MGTK_CALL MGTK::FindWindow, findwindow_params
bne exit
lda findwindow_params::window_id
cmp winfo::window_id
bne input_loop
lda findwindow_params::which_area
cmp #MGTK::Area::close_box
beq handle_close
cmp #MGTK::Area::dragbar
beq handle_drag
cmp #MGTK::Area::content
bne :+
jmp handle_grow
: jmp input_loop
.endproc
;;; ============================================================
.proc handle_close
MGTK_CALL MGTK::TrackGoAway, trackgoaway_params
lda trackgoaway_params::clicked
beq input_loop
bne exit
.endproc
;;; ============================================================
.proc handle_no_event
;; First time? Need to store last coords
lda has_last_coords
bne test
inc has_last_coords
bne moved
;; Moved?
test:
lda event_params::xcoord
cmp screentowindow_params::screen::xcoord
bne moved
lda event_params::xcoord+1
cmp screentowindow_params::screen::xcoord+1
bne moved
lda event_params::ycoord
cmp screentowindow_params::screen::ycoord
bne moved
lda event_params::ycoord+1
cmp screentowindow_params::screen::ycoord+1
beq done
moved: copy16 event_params::xcoord, screentowindow_params::screen::xcoord
copy16 event_params::ycoord, screentowindow_params::screen::ycoord
MGTK_CALL MGTK::ScreenToWindow, screentowindow_params
jsr draw_window
done: jmp input_loop
.endproc
;;; ============================================================
.proc handle_drag
copy winfo::window_id, dragwindow_params::window_id
copy16 event_params::xcoord, dragwindow_params::dragx
copy16 event_params::ycoord, dragwindow_params::dragy
MGTK_CALL MGTK::DragWindow, dragwindow_params
common: lda dragwindow_params::moved
bpl :+
;; Draw DeskTop's windows
sta RAMRDOFF
sta RAMWRTOFF
jsr JUMP_TABLE_REDRAW_ALL
sta RAMRDON
sta RAMWRTON
;; Draw DA's window
lda #0
sta has_last_coords
sta has_drawn_outline
jsr draw_window
;; Draw DeskTop icons
DESKTOP_CALL DT_REDRAW_ICONS
: jmp input_loop
.endproc
;;; ============================================================
.proc handle_grow
;; Is the hit within the grow box area?
copy16 event_params::xcoord, screentowindow_params::screen::xcoord
copy16 event_params::ycoord, screentowindow_params::screen::ycoord
MGTK_CALL MGTK::ScreenToWindow, screentowindow_params
sub16 winfo::maprect::x2, mx, tmpw
cmp16 #grow_box_width, tmpw
bcc nope
sub16 winfo::maprect::y2, my, tmpw
cmp16 #grow_box_height, tmpw
bcc nope
;; Initiate the grow... re-using the drag logic
copy winfo::window_id, dragwindow_params::window_id
copy16 event_params::xcoord, dragwindow_params::dragx
copy16 event_params::ycoord, dragwindow_params::dragy
MGTK_CALL MGTK::GrowWindow, dragwindow_params
jmp handle_drag::common
nope: jmp input_loop
tmpw: .word 0
.endproc
;;; ============================================================
penxor: .byte MGTK::penXOR
notpencopy: .byte MGTK::notpencopy
penw := 8
penh := 4
pupilw := penw * 2
pupilh := penh * 2
.proc outline_pensize
penwidth: .byte penw
penheight: .byte penh
.endproc
.proc pupil_pensize
penwidth: .byte pupilw
penheight: .byte pupilh
.endproc
;;; Flag set once we have coords from a move event
has_last_coords:
.byte 0
;;; Flag set once outline is drawn (cleared on window move)
has_drawn_outline:
.byte 0
;;; Saved coords
pos_l: DEFINE_POINT 0, 0, pos_l
pos_r: DEFINE_POINT 0, 0, pos_r
;;; ============================================================
.proc draw_window
;; Defer if content area is not visible
MGTK_CALL MGTK::GetWinPort, winport_params
cmp #MGTK::Error::window_obscured
bne :+
rts
:
;; Defer until we have mouse coords
lda has_last_coords
bne :+
rts
:
MGTK_CALL MGTK::SetPort, grafport
MGTK_CALL MGTK::HideCursor
copy16 winfo::maprect::x2, rx ; width / 4
lsr16 rx
lsr16 rx
copy16 winfo::maprect::y2, ry ; height / 2
lsr16 ry
lda has_drawn_outline
beq :+
jmp erase_pupils
: inc has_drawn_outline
;; Draw resize box
MGTK_CALL MGTK::SetPenMode, notpencopy
sub16 winfo::maprect::x2, #grow_box_width, grow_box_params::viewloc::xcoord
sub16 winfo::maprect::y2, #grow_box_height, grow_box_params::viewloc::ycoord
MGTK_CALL MGTK::PaintBits, grow_box_params
;; Draw outline
MGTK_CALL MGTK::SetPenMode, notpencopy
MGTK_CALL MGTK::SetPenSize, outline_pensize
copy16 rx, cx
copy16 ry, cy
jsr draw_outline
add16 rx, cx, cx
add16 rx, cx, cx
jsr draw_outline
;; Skip erasing pupils if we're redrawing
jmp draw_pupils
erase_pupils:
MGTK_CALL MGTK::SetPenMode, penxor
MGTK_CALL MGTK::SetPenSize, pupil_pensize
MGTK_CALL MGTK::MoveTo, pos_l
MGTK_CALL MGTK::LineTo, pos_l
MGTK_CALL MGTK::MoveTo, pos_r
MGTK_CALL MGTK::LineTo, pos_r
draw_pupils:
MGTK_CALL MGTK::SetPenMode, penxor
MGTK_CALL MGTK::SetPenSize, pupil_pensize
copy16 rx, cx
copy16 ry, cy
jsr compute_pupil_pos
sub16 ppx, #pupilw/2, pos_l::xcoord
sub16 ppy, #pupilh/2, pos_l::ycoord
MGTK_CALL MGTK::MoveTo, pos_l
MGTK_CALL MGTK::LineTo, pos_l
add16 rx, cx, cx
add16 rx, cx, cx
jsr compute_pupil_pos
sub16 ppx, #pupilw/2, pos_r::xcoord
sub16 ppy, #pupilh/2, pos_r::ycoord
MGTK_CALL MGTK::MoveTo, pos_r
MGTK_CALL MGTK::LineTo, pos_r
MGTK_CALL MGTK::ShowCursor
done: rts
tmpw: .word 0
.endproc
;;; ============================================================
;;; Common input params
rx: .word 0
ry: .word 0
cx: .word 0
cy: .word 0
;;; ============================================================
;;; Compute pupil location
;;;
;;; Inputs: mx, my, cx, cy, rx, ry
;;; Outputs: ppx, ppy
ppx: .word 0
ppy: .word 0
.proc compute_pupil_pos
lda ROMIN2
fac_load_int cx
fac_store cxf
fac_load_int cy
fac_store cyf
;; pupil shouldn't overlap border
sub16 rx, #penw, tmpw
sub16 tmpw, #pupilw, tmpw
fac_load_int tmpw
fac_store prx
sub16 ry, #penh, tmpw
sub16 tmpw, #pupilh, tmpw
fac_load_int tmpw
fac_store pry
;; x scale, so math is circular
;; xs = pry / prx
fac_load prx
fac_div pry
fac_store scale
;; mouse delta, in transformed space
;; dx = (mx - cx) * xs
;; dy = mx - cy
fac_load_int mx ; dx = (mx - cx) * xs
fac_store tmpf
fac_load cxf
fac_sub tmpf
fac_mul scale
fac_store dx
fac_load_int my ; dy = mx - cy
fac_store tmpf
fac_load cyf
fac_sub tmpf
fac_store dy
;; d = SQR(dx * dx + dy * dy)
fac_load dx
fac_mul dx
fac_store tmpf
fac_load dy
fac_mul dy
fac_add tmpf
jsr SQR ; ??? Crashes here after window drag
;; if d > pry:
;; f = pry / d
;; dx = f * dx
;; dy = f * dy
fac_comp pry
bmi skip
fac_div pry ; f = pry / d
fac_store tmpf
fac_mul dx ; dx = f * dx
fac_store dx
fac_load tmpf ; dy = f * dy
fac_mul dy
fac_store dy
skip:
;; plot coords
;; ppx = (dx / xs) + cx
;; ppy = dy + cy
fac_load scale ; ppx = (dx / xs) + cx
fac_div dx
fac_add cxf
fac_store_int ppx
fac_load dy ; ppy = dy + cy
fac_add cyf
fac_store_int ppy
lda LCBANK1
lda LCBANK1
rts
tmpw: .word 0
tmpf: DEFINE_FLOAT
scale: DEFINE_FLOAT
dx: DEFINE_FLOAT
dy: DEFINE_FLOAT
pry: DEFINE_FLOAT
prx: DEFINE_FLOAT
cxf: DEFINE_FLOAT
cyf: DEFINE_FLOAT
.endproc
;;; ============================================================
;;; Draw eye outlines as a 36-sided polygon
;;; Inputs: cx, cy, rx, ry
.proc draw_outline
segments := 36
lda ROMIN2
fac_load_int segw
fac_div CON_TWO_PI
fac_store step
sub16 cx, #penw/2, tmpw
fac_load_int tmpw
fac_store cxf
sub16 cy, #penh/2, tmpw
fac_load_int tmpw
fac_store cyf
sub16 rx, #penw/2, tmpw
fac_load_int tmpw
fac_store rxf
sub16 ry, #penh/2, tmpw
fac_load_int tmpw
fac_store ryf
lda #segments
sta count
jsr ZERO_FAC
fac_store theta
fac_load rxf
fac_add cxf
fac_store_int ptx
fac_load cyf
fac_store_int pty
lda LCBANK1
lda LCBANK1
MGTK_CALL MGTK::MoveTo, drawpos
loop:
lda ROMIN2
fac_load theta
fac_add step
fac_store theta
jsr COS
fac_mul rxf
fac_add cxf
fac_store_int ptx
fac_load theta
jsr SIN
fac_mul ryf
fac_add cyf
fac_store_int pty
lda LCBANK1
lda LCBANK1
MGTK_CALL MGTK::LineTo, drawpos
dec count
bpl loop
rts
count: .byte 0
segw: .word segments
tmpw: .word 0
step: DEFINE_FLOAT
theta: DEFINE_FLOAT
rxf: DEFINE_FLOAT
ryf: DEFINE_FLOAT
cxf: DEFINE_FLOAT
cyf: DEFINE_FLOAT
drawpos: DEFINE_POINT 0, 0, drawpos
ptx := drawpos::xcoord
pty := drawpos::ycoord
.endproc
;;; ============================================================
da_end = *
.assert * < $1B00, error, "DA too big"
;; I/O Buffer starts at MAIN $1C00
;; ... but icon tables start at AUX $1B00

27
desk.acc/res/README_DAS.txt
View File

@ -22,3 +22,30 @@ the menu order:
* Restart
Source code can be found at: https://github.com/inexorabletash/a2d
Show Image File
---------------
In Apple II Desktop, select an image file. Unfortunately, these are
hard to identify in A2D; they appear as a binary file (icon is <01>)
and are usually either 17 (single hi-res) or 33 (double hi-res) blocks
- you can check View > By Name or use Special > Get Info... to see the
size.
Then select Show Image File from the Apple menu. The image should
appear. If garbage appears, it was probably not an image file. You can
move the mouse pointer while the image is displayed. Click the mouse
button or press Escape to return to the DeskTop.
This Apple
----------
Select this item from the Apple menu to see an overview of the model
of computer, the CPU, an estimate of RamWorks memory expansion (if
present), and what cards can be identified in each slot.
Eyes
----
Select this for a demo showing two eyes that follow the mouse cursor.
The window can be moved and resized.

178
desk.acc/run.basic.here.s Normal file
View File

@ -0,0 +1,178 @@
;;; ============================================================
;;; RUN.BASIC.HERE - Desk Accessory
;;;
;;; Launches BASIC.SYSTEM with PREFIX set to the path of the
;;; current window. BYE will return to DeskTop. Looks for
;;; BASIC.SYSTEM up the directory tree from DeskTop itself.
;;; ============================================================
.setcpu "6502"
.include "apple2.inc"
.include "../inc/apple2.inc"
.include "../inc/prodos.inc"
.include "../mgtk.inc"
.include "../desktop.inc"
.include "../macros.inc"
;;; ============================================================
.org $800
;;; ============================================================
jmp start
;;; ============================================================
bs_path: .res 65, 0
prefix_path: .res 65, 0
DEFINE_GET_FILE_INFO_PARAMS get_file_info_params, bs_path
DEFINE_OPEN_PARAMS open_params, bs_path, $C00
DEFINE_READ_PARAMS read_params, $2000, $BF00-$2000
DEFINE_CLOSE_PARAMS close_params
DEFINE_SET_PREFIX_PARAMS set_prefix_params, prefix_path
DEFINE_QUIT_PARAMS quit_params
;;; ============================================================
start:
;; Get active window's path
jsr get_win_path
beq :+
lda #$FA ; "This file cannot be run" - not perfect
bne fail
;; Find BASIC.SYSTEM
: jsr check_basic_system
beq :+
lda #$FE ; "BASIC.SYSTEM not found"
bne fail
;; Restore to normal state
: sta ALTZPOFF
lda ROMIN2
jsr SETVID
jsr SETKBD
jsr INIT
jsr HOME
sta TXTSET
sta LOWSCR
sta LORES
sta MIXCLR
sta DHIRESOFF
sta CLRALTCHAR
sta CLR80VID
sta CLR80COL
;; TODO: restore /RAM?
;; Set PREFIX
MLI_CALL SET_PREFIX, set_prefix_params
bcs quit
;; Load BS
MLI_CALL OPEN, open_params
bcs quit
lda open_params::ref_num
sta read_params::ref_num
sta close_params::ref_num
MLI_CALL READ, read_params
bcs quit
MLI_CALL CLOSE, close_params
bcs quit
;; Launch
jmp $2000
;; Early errors - show alert and return to DeskTop
fail: jsr JUMP_TABLE_ALERT_X
rts
;; Late errors - QUIT, which should relaunch DeskTop
quit: MLI_CALL QUIT, quit_params
;;; ============================================================
DEFINE_GET_PREFIX_PARAMS get_prefix_params, bs_path
.proc check_basic_system
axy_call JUMP_TABLE_MLI, GET_PREFIX, get_prefix_params
bne no_bs
lda bs_path
sta path_length
;; Append BASIC.SYSTEM to path and check for file.
loop: ldx path_length
ldy #0
: inx
iny
copy str_basic_system,y, bs_path,x
cpy str_basic_system
bne :-
stx bs_path
axy_call JUMP_TABLE_MLI, GET_FILE_INFO, get_file_info_params
bne not_found
rts
;; Pop off a path segment and try again.
not_found:
ldx path_length
dex
: lda bs_path,x
cmp #'/'
beq found_slash
dex
bne :-
found_slash:
cpx #1
beq no_bs
stx path_length
jmp loop
no_bs: return #1
;; length of directory path e.g. "/VOL/DIR/"
path_length:
.byte 0
str_basic_system:
PASCAL_STRING "BASIC.SYSTEM"
.endproc
;;; ============================================================
.proc get_win_path
ptr := $06
yax_call JUMP_TABLE_MGTK_RELAY, MGTK::FrontWindow, ptr
lda ptr ; any window open?
beq fail
cmp #9 ; windows are 1-8
bcs fail
asl a ; window index * 2
tay
copy16 path_table,y, ptr
ldy #0
lda (ptr),y
tay
: copy (ptr),y, prefix_path,y
dey
bpl :-
return #0
fail: return #1
.endproc
;;; ============================================================

234
desk.acc/screen.dump.s Normal file
View File

@ -0,0 +1,234 @@
.setcpu "6502"
.include "apple2.inc"
.include "../inc/apple2.inc"
.include "../inc/prodos.inc"
.include "../mgtk.inc"
.include "../desktop.inc"
.include "../macros.inc"
;;; ============================================================
.org $800
;;; ============================================================
yax_call JUMP_TABLE_MGTK_RELAY, MGTK::HideCursor, 0
yax_call JUMP_TABLE_MGTK_RELAY, MGTK::HiliteMenu, last_menu_click_params
jsr dump_screen
yax_call JUMP_TABLE_MGTK_RELAY, MGTK::HiliteMenu, last_menu_click_params
yax_call JUMP_TABLE_MGTK_RELAY, MGTK::ShowCursor, 0
rts
;;; ============================================================
.proc dump_screen
SLOT1 := $C100
hbasl := $6
screen_width := 560
screen_height := 192
lda ROMIN2
jsr print_screen
lda LCBANK1
lda LCBANK1
rts
.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
lda #0
sta y_row
;; 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
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 #<SLOT1
sta COUT_HOOK
lda #(CHAR_RETURN | $80)
jsr invoke_slot1
rts
.endproc
.proc cout
jsr COUT
rts
.endproc
y_row: .byte 0 ; y-coordinate of row start (0, 8, ...)
x_coord:.word 0 ; x-coordinate of pixels being accumulated
y_coord:.byte 0 ; iterates y_row to y_row+7
mask: .byte 0 ; mask for pixel being processed
accum: .byte 0 ; accumulates pixels for output
count: .byte 0 ; 8...1 while a row is output
col_num:.byte 0 ; 0...79
.byte 0, 0
spacing_sequence:
.byte CHAR_ESCAPE,'e' ; 107 DPI (horizontal)
.byte CHAR_ESCAPE,"T16" ; distance between lines (16/144")
.byte CHAR_TAB,$4C,$20,$44,$8D ; ???
.byte CHAR_TAB,$5A,$8D ; ???
.byte 0
restore_state:
.byte CHAR_ESCAPE,'N' ; 80 DPI (horizontal)
.byte CHAR_ESCAPE,"T24" ; distance between lines (24/144")
.byte 0
invoke_slot1:
jmp SLOT1
.endproc ; dump_screen
;;; ============================================================

718
desk.acc/show.image.file.s Normal file
View File

@ -0,0 +1,718 @@
.setcpu "65C02"
.include "apple2.inc"
.include "../inc/apple2.inc"
.include "../inc/prodos.inc"
.include "../mgtk.inc"
.include "../desktop.inc"
.include "../macros.inc"
;;; ============================================================
.org $800
start: jmp copy2aux
save_stack:.byte 0
;;; Copy $800 through $13FF (the DA) to aux
.proc copy2aux
tsx
stx save_stack
sta RAMWRTON
ldy #0
src: lda start,y ; self-modified
dst: sta start,y ; self-modified
dey
bne src
sta RAMWRTOFF
inc src+2
inc dst+2
sta RAMWRTON
lda dst+2
cmp #$14
bne src
.endproc
call_main_trampoline := $20 ; installed on ZP, turns off auxmem and calls...
call_main_addr := call_main_trampoline+7 ; address patched in here
;;; Copy the following "call_main_template" routine to $20
.scope
sta RAMWRTON
sta RAMRDON
COPY_BYTES sizeof_routine+1, routine, call_main_trampoline
jmp call_init
.endscope
.proc routine
sta RAMRDOFF
sta RAMWRTOFF
jsr $1000 ; overwritten (in zp version)
sta RAMRDON
sta RAMWRTON
rts
.endproc
sizeof_routine := * - routine ; can't .sizeof(proc) before declaration
;; https://github.com/cc65/cc
.proc call_init
;; run the DA
jsr init
;; tear down/exit
sta ALTZPON
lda LCBANK1
lda LCBANK1
sta RAMRDOFF
sta RAMWRTOFF
ldx save_stack
txs
rts
.endproc
;;; ============================================================
;;; ProDOS MLI calls
.proc open_file
jsr copy_params_aux_to_main
sta ALTZPOFF
MLI_CALL OPEN, open_params
sta ALTZPON
jsr copy_params_main_to_aux
rts
.endproc
.proc get_file_eof
jsr copy_params_aux_to_main
sta ALTZPOFF
MLI_CALL GET_EOF, get_eof_params
sta ALTZPON
jsr copy_params_main_to_aux
rts
.endproc
.proc read_file
jsr copy_params_aux_to_main
sta ALTZPOFF
MLI_CALL READ, read_params
sta ALTZPON
jsr copy_params_main_to_aux
rts
.endproc
.proc close_file
jsr copy_params_aux_to_main
sta ALTZPOFF
MLI_CALL CLOSE, close_params
sta ALTZPON
jsr copy_params_main_to_aux
rts
.endproc
;;; ============================================================
;;; Copies param blocks from Aux to Main
.proc copy_params_aux_to_main
ldy #(params_end - params_start + 1)
sta RAMWRTOFF
loop: lda params_start - 1,y
sta params_start - 1,y
dey
bne loop
sta RAMRDOFF
rts
.endproc
;;; Copies param blocks from Main to Aux
.proc copy_params_main_to_aux
pha
php
sta RAMWRTON
ldy #(params_end - params_start + 1)
loop: lda params_start - 1,y
sta params_start - 1,y
dey
bne loop
sta RAMRDON
plp
pla
rts
.endproc
;;; ----------------------------------------
params_start:
;;; This block gets copied between main/aux
;;; ProDOS MLI param blocks
hires := $2000
hires_size := $2000
DEFINE_OPEN_PARAMS open_params, pathbuff, $C00
DEFINE_GET_EOF_PARAMS get_eof_params
DEFINE_READ_PARAMS read_params, hires, hires_size
DEFINE_CLOSE_PARAMS close_params
.proc pathbuff ; 1st byte is length, rest is full path
length: .byte $00
data: .res 64, 0
.endproc
params_end:
;;; ----------------------------------------
da_window_id := 100
.proc line_pos
left: .word 0
base: .word 0
.endproc
.proc event_params ; queried to track mouse-up
kind: .byte $00
;;; if state is MGTK::EventKind::key_down
key := *
modifiers := *+1
;;; otherwise
xcoord := *
ycoord := *+2
.res 4 ; space for both
.endproc
default_width := 560
default_height := 192
default_left := 0
default_top := 0
.proc window_title
.byte 0 ; length
.endproc
.proc winfo
window_id: .byte da_window_id ; window identifier
options: .byte MGTK::Option::dialog_box
title: .addr window_title
hscroll:.byte MGTK::Scroll::option_none
vscroll:.byte MGTK::Scroll::option_none
hthumbmax: .byte 32
hthumbpos: .byte 0
vthumbmax: .byte 32
vthumbpos: .byte 0
status: .byte 0
reserved: .byte 0
mincontwidth: .word default_width
mincontlength: .word default_height
maxcontwidth: .word default_width
maxcontlength: .word default_height
.proc port
viewloc: DEFINE_POINT default_left, default_top
mapbits: .addr MGTK::screen_mapbits
mapwidth: .word MGTK::screen_mapwidth
maprect: DEFINE_RECT 0, 0, default_width, default_height
.endproc
pattern:.res 8, 0
colormasks: .byte MGTK::colormask_and, MGTK::colormask_or
penloc: DEFINE_POINT 0, 0
penwidth: .byte 1
penheight: .byte 1
penmode: .byte 0
textback: .byte $7F
textfont: .addr DEFAULT_FONT
nextwinfo: .addr 0
.endproc
.proc init
sta ALTZPON
lda LCBANK1
lda LCBANK1
lda #0
sta mode
;; Get filename by checking DeskTop selected window/icon
;; Check that an icon is selected
lda #0
sta pathbuff::length
lda selected_file_count
beq abort ; some file properties?
lda path_index ; prefix index in table
bne :+
abort: rts
;; Copy path (prefix) into pathbuff buffer.
: src := $06
dst := $08
asl a ; (since address table is 2 bytes wide)
tax
copy16 path_table,x, src
ldy #0
lda (src),y
tax
inc src
bne :+
inc src+1
: copy16 #(pathbuff::data), dst
jsr copy_pathbuff ; copy x bytes (src) to (dst)
;; Append separator.
lda #'/'
ldy #0
sta (dst),y
inc pathbuff::length
inc dst
bne :+
inc dst+1
;; Get file entry.
: lda selected_file_list ; file index in table
asl a ; (since table is 2 bytes wide)
tax
copy16 file_table,x, src
;; Exit if a directory.
ldy #2 ; 2nd byte of entry
lda (src),y
and #$70 ; check that one of bits 4,5,6 is set ???
;; some vague patterns, but unclear
;; basic = $32,$33, text = $52, sys = $11,$14,??, bin = $23,$24,$33
;; dir = $01 (so not shown)
bne :+
rts ; abort ???
;; Append filename to path.
: ldy #9
lda (src),y ; grab length
tax ; name has spaces before/after
dex ; so subtract 2 to get actual length
dex
clc
lda src
adc #11 ; 9 = length, 10 = space, 11 = name
sta src
bcc :+
inc src+1
: jsr copy_pathbuff ; copy x bytes (src) to (dst)
jmp open_file_and_init_window
.proc copy_pathbuff ; copy x bytes from src to dst
ldy #0 ; incrementing path length and dst
loop: lda (src),y
sta (dst),y
iny
inc pathbuff::length
dex
bne loop
tya
clc
adc dst
sta dst
bcc end
inc dst+1
end: rts
.endproc
.endproc
.proc open_file_and_init_window
jsr open_file
lda open_params::ref_num
sta get_eof_params::ref_num
sta read_params::ref_num
sta close_params::ref_num
MGTK_CALL MGTK::HideCursor
jsr stash_menu
MGTK_CALL MGTK::OpenWindow, winfo
MGTK_CALL MGTK::SetPort, winfo::port
jsr set_color_mode
jsr show_file
MGTK_CALL MGTK::ShowCursor
MGTK_CALL MGTK::FlushEvents
MGTK_CALL MGTK::ObscureCursor
;; fall through
.endproc
;;; ============================================================
;;; Main Input Loop
.proc input_loop
MGTK_CALL MGTK::GetEvent, event_params
lda event_params::kind
cmp #MGTK::EventKind::button_down ; was clicked?
beq exit
cmp #MGTK::EventKind::key_down ; any key?
beq on_key
bne input_loop
on_key:
lda event_params::modifiers
bne input_loop
lda event_params::key
cmp #CHAR_ESCAPE
beq exit
cmp #' '
bne :+
jsr toggle_mode
: jmp input_loop
exit:
jsr set_bw_mode
MGTK_CALL MGTK::HideCursor
MGTK_CALL MGTK::CloseWindow, winfo
DESKTOP_CALL DT_REDRAW_ICONS
jsr unstash_menu
MGTK_CALL MGTK::ShowCursor
rts ; exits input loop
.endproc
.proc show_file
jsr get_file_eof
;; If bigger than $2000, assume DHR
lda get_eof_params::eof ; fancy 3-byte unsigned compare
cmp #<(hires_size+1)
lda get_eof_params::eof+1
sbc #>(hires_size+1)
lda get_eof_params::eof+2
sbc #^(hires_size+1)
bcs dhr
jsr show_hr_file
jmp close
dhr: jsr show_dhr_file
close: jsr close_file
rts
.endproc
.proc show_hr_file
sta PAGE2OFF
jsr read_file
jsr close_file
jsr hr_to_dhr
rts
.endproc
.proc show_dhr_file
ptr := $06
;; AUX memory half
sta PAGE2OFF
jsr read_file
;; NOTE: Why not just load into Aux directly by setting
;; PAGE2ON? This works unless loading from a RamWorks-based
;; RAM Disk, where things get messed up. This is slightly
;; slower in the non-RamWorks case.
;; TODO: Load directly into Aux if RamWorks is not present.
;; Copy MAIN to AUX
copy16 #hires, ptr
ldx #>hires_size ; number of pages to copy
ldy #0
: sta PAGE2OFF ; from main
lda (ptr),y
sta PAGE2ON ; to aux
sta (ptr),y
iny
bne :-
inc ptr+1
dex
bne :-
;; MAIN memory half
sta PAGE2OFF
jsr read_file
jsr close_file
;; TODO: Restore PAGE2 state?
rts
.endproc
;;; ============================================================
;;; Convert single hires to double hires
;;; Assumes the image is loaded to MAIN $2000 and
;;; relies on the hr_to_dhr.inc table.
.proc hr_to_dhr
ptr := $06
rows := 192
cols := 40
spill := $08 ; spill-over
lda #0 ; row
rloop: pha
tax
lda hires_table_lo,x
sta ptr
lda hires_table_hi,x
sta ptr+1
ldy #cols-1 ; col
lda #0
sta spill ; spill-over
cloop: lda (ptr),y
tax
bmi hibitset
;; complex case - need to spill in bit from prev col and store
lda hr_to_dhr_aux,x
sta PAGE2ON
sta (ptr),y
lda hr_to_dhr_main,x
ora spill ; apply previous spill bit (to bit 6)
sta PAGE2OFF
sta (ptr),y
ror ; move high bit to bit 6
and #(1 << 6)
sta spill
jmp next
hibitset:
;; simple case - no bit spillage
lda hr_to_dhr_aux,x
sta PAGE2ON
sta (ptr),y
lda hr_to_dhr_main,x
sta PAGE2OFF
sta (ptr),y
lda #0 ; no spill bit
sta spill
next:
dey
bpl cloop
pla
inc
cmp #rows
bne rloop
;; TODO: Restore PAGE2 state?
done: sta PAGE2OFF
rts
.endproc
;;; ============================================================
;;; Stash/Unstash Menu Bar
;;; Have not yet figured out how to force the menu to
;;; redraw, so instead we save the top 13 rows of the
;;; screen to a scratch buffer and restore after
;;; destroying the window.
stash := $1200 ; Past DA code
rows = 13
cols = 40
.proc stash_menu
src := $08
dst := $06
copy16 #stash, dst
sta PAGE2ON
jsr inner
sta PAGE2OFF
inner:
lda #0 ; row #
rloop: pha
tax
lda hires_table_lo,x
sta src
lda hires_table_hi,x
sta src+1
ldy #cols-1
cloop: lda (src),y
sta (dst),y
dey
bpl cloop
clc ; src += cols
lda src
adc #<cols
sta src
lda src+1
adc #>cols
sta src+1
clc ; dst += cols
lda dst
adc #<cols
sta dst
lda dst+1
adc #>cols
sta dst+1
pla
inc
cmp #rows
bcc rloop
rts
.endproc
.proc unstash_menu
src := $08
dst := $06
copy16 #stash, src
sta PAGE2ON
jsr inner
sta PAGE2OFF
inner:
lda #0 ; row #
rloop: pha
tax
lda hires_table_lo,x
sta dst
lda hires_table_hi,x
sta dst+1
ldy #cols-1
cloop: lda (src),y
sta (dst),y
dey
bpl cloop
clc ; src += cols
lda src
adc #<cols
sta src
lda src+1
adc #>cols
sta src+1
clc ; dst += cols
lda dst
adc #<cols
sta dst
lda dst+1
adc #>cols
sta dst+1
pla
inc
cmp #rows
bcc rloop
rts
.endproc
;;; ============================================================
;;; Color/B&W Toggle
mode: .byte 0 ; 0 = B&W, $80 = color
.proc toggle_mode
lda mode
bne set_bw_mode
;; fall through
.endproc
.proc set_color_mode
lda mode
bne done
lda #$80
sta mode
;; AppleColor Card - Mode 2 (Color 140x192)
sta SET80VID
lda AN3_OFF
lda AN3_ON
lda AN3_OFF
lda AN3_ON
lda AN3_OFF
;; IIgs?
jsr test_iigs
bcc iigs
;; Le Chat Mauve - COL140 mode
;; (AN3 off, HR1 off, HR2 off, HR3 off)
;; Skip on IIgs since emulators (KEGS/GSport/GSplus) crash.
sta HR2_OFF
sta HR3_OFF
bcs done
;; Apple IIgs - DHR Color
iigs: lda NEWVIDEO
and #<~(1<<5) ; Color
sta NEWVIDEO
done: rts
.endproc
.proc set_bw_mode
lda mode
beq done
lda #0
sta mode
;; AppleColor Card - Mode 1 (Monochrome 560x192)
sta CLR80VID
lda AN3_OFF
lda AN3_ON
lda AN3_OFF
lda AN3_ON
sta SET80VID
lda AN3_OFF
;; IIgs?
jsr test_iigs
bcc iigs
;; Le Chat Mauve - BW560 mode
;; (AN3 off, HR1 off, HR2 on, HR3 on)
;; Skip on IIgs since emulators (KEGS/GSport/GSplus) crash.
sta HR2_ON
sta HR3_ON
bcs done
;; Apple IIgs - DHR B&W
iigs: lda NEWVIDEO
ora #(1<<5) ; B&W
sta NEWVIDEO
done: rts
.endproc
;;; Returns with carry clear if IIgs, set otherwise.
.proc test_iigs
lda ROMIN2
sec
jsr ID_BYTE_FE1F
lda LCBANK1
lda LCBANK1
rts
.endproc
.include "inc/hires_table.inc"
.include "inc/hr_to_dhr.inc"

1291
desk.acc/this.apple.s Normal file
View File

File diff suppressed because it is too large Load Diff