1
0
mirror of https://github.com/mgcaret/of816.git synced 2024-11-12 12:08:17 +00:00
of816/platforms/IIgs/platform-lib.s

667 lines
17 KiB
ArmAsm
Raw Normal View History

2019-07-01 17:33:44 +00:00
; Note: we *know* this is running in bank 0
cpu_clk = 2800000 ; nominally
PLATFORM_INCLUDE "platform-include.inc"
.proc _scrn_tab
.addr $400
.addr $480
.addr $500
.addr $580
.addr $600
.addr $680
.addr $700
.addr $780
.addr $428
.addr $4A8
.addr $528
.addr $5A8
.addr $628
.addr $6A8
.addr $728
.addr $7A8
.addr $450
.addr $4D0
.addr $550
.addr $5D0
.addr $650
.addr $6D0
.addr $750
.addr $7D0
.endproc
.proc _system_interface
phx
asl
tax
jmp (table,x)
table: .addr _sf_pre_init
.addr _sf_post_init
.addr _sf_emit
.addr _sf_keyq
.addr _sf_key
.addr _sf_fcode
.addr _sf_reset_all
.endproc
.export _system_interface
.proc _emulation_call
sta AREG
tdc
sta f:DPSAVE
tsc
sta f:SPSAVE
lda SYS_RSTK
tcs
lda #$0000
tcd
lda AREG
sec
xce
.a8
.i8
ldx #$00
jsr (ECALL,x)
php ; save carry state
clc
xce ; back to native
plp ; get it back
rep #SHORT_A|SHORT_I ; go to long registers
.a16
.i16
sta AREG ; save A while we do this thing
lda f:SPSAVE
tcs
lda f:DPSAVE
tcd
lda AREG
rts
.endproc
; A=call number, Y=address
.proc _p8_call
sty plist
sep #SHORT_A
.a8
sta callnum
rep #SHORT_A
.a16
tdc
sta f:DPSAVE
tsc
sta f:SPSAVE
lda SYS_RSTK
tcs
lda #$0000
tcd
sec
xce
.a8
.i8
jsr MLI
callnum: .byte $00
plist: .addr $0000
php
clc
xce
plp
rep #SHORT_A|SHORT_I
.a16
.i16
and #$00FF
sta AREG
lda f:SPSAVE
tcs
lda f:DPSAVE
tcd
lda AREG
rts
.endproc
.proc _sf_success
lda #$0000
tay
clc
rtl
.endproc
.proc _sf_fail
ldy #.loword(-21)
lda #.hiword(-21)
sec
rtl
.endproc
.proc _sf_pre_init
; Most initialization happens outside of the Forth system
stz ESCMODE
plx
bra _sf_success
.endproc
.proc _sf_post_init
plx
bra _sf_success
.endproc
.proc _sf_emit
phk ; ensure we are working with bank 0
plb
plx
jsr _popay
phx
cpy #$00
beq do_null ; ignore nulls
lda ESCMODE
asl
tax
jmp (table,x)
table: .addr _mode0 ; no ESC sequence in progress
.addr _mode1 ; ESC but no [ yet
.addr _mode2 ; ESC[ in progress
do_null: plx
jmp _sf_success
.endproc
.proc _mode0
cpy #$1B ; ESC
bne :+
inc ESCMODE
bra done
: cpy #$0B ; OF code for cursor up
bne :+
ldy #$1F ; Apple II code for cursor up
: jsr _con_write
done: plx
jmp _sf_success
.endproc
.proc _mode1
cpy #'[' ; second char in sequence?
beq :+ ; yes, change modes
stz ESCMODE ; otherwise back to mode 0
phy
ldy #$1B
jsr _con_write ; output the ESC we ate
ply
jsr _con_write ; and output this char
bra done
: stz ESCACC
stz ESCNUM1
inc ESCMODE ; sequence started!
done: plx
jmp _sf_success
.endproc
.proc _mode2
cpy #' ' ; ignore spaces in codes
beq done
cpy #';'
bne :+
lda ESCACC ; move ACC to NUM1 if ;
sta ESCNUM1 ; note that only supports two params!
stz ESCACC
bra done
: tya
sec
sbc #$30
bmi endesc ; eat it and end ESC mode if invalid
cmp #$0a
bcs :+ ; try letters if not a digit
tay ; a digit, accumulate it into ESCACC
lda #10 ; multiply current ESCACC by 10
sta MNUM2
lda #$0000 ; initialize result
beq elp
do_add: clc
adc ESCACC
lp: asl ESCACC
elp: lsr MNUM2
bcs do_add
bne lp
sta ESCACC ; now add the current digit
tya
clc
adc ESCACC
sta ESCACC
bra done
: tya ; not a digit, try letter codes
sbc #'@' ; carry was set above
bmi endesc
cmp #$1B ; ctrl+Z
bcc upper ; upper case code
sbc #$20 ; convert lower case to 00-1A
bmi endesc
cmp #$1B
bcc lower ; lower case codes
endesc: stz ESCMODE
done: plx
jmp _sf_success
none: rts
upper: asl
tax
jsr (utable,x)
bra endesc
utable: .addr ich ; @ insert char
.addr cuu ; A cursor up
.addr cud ; B cursor down
.addr cuf ; C cursor forward
.addr cub ; D cursor backward
.addr cnl ; E cursor next line
.addr cpl ; F cursor previous line
.addr cha ; G cursor horizontal absolute
.addr cup ; H cursor position
.addr none ; I
.addr ed ; J erase display
.addr el ; K erase line
.addr il ; L insert lines
.addr dl ; M delete lines
.addr none ; N
.addr none ; O
.addr dch ; P delete char
.addr none ; Q
.addr none ; R
.addr su ; S scroll up
.addr sd ; T scroll down
.addr none ; U
.addr none ; V
.addr none ; W
.addr none ; X
.addr none ; Y
.addr none ; Z
lower: asl
tax
jsr (ltable,x)
bra endesc
ltable: .addr none ; `
.addr none ; a
.addr none ; b
.addr none ; c
.addr none ; d
.addr none ; e
.addr cup ; f cursor position
.addr none ; g
.addr none ; h
.addr none ; i
.addr none ; j
.addr none ; k
.addr none ; l
.addr sgr ; m set graphic rendition
.addr none ; n device status report (requires input buffer)
.addr none ; o
.addr none ; p normal screen (optional)
.addr none ; q invert screen (optional)
.addr none ; r
.addr none ; s reset screen (optional)
.addr none ; t
.addr none ; u
.addr none ; v
.addr none ; w
.addr none ; x
.addr none ; y
.addr none ; z
; cursor up
cuu: ldy #$1F
jmp con_wr_n
; cursor down
cud: ldy #$0A
jmp con_wr_n
; cursor forward
cuf: ldy #$1C
jmp con_wr_n
; cursor backwards
cub: ldy #$08
jmp con_wr_n
; cursor previous line
cpl: jsr cuu
bra :+ ; eventually repos cursor
; cursor next line
cnl: jsr cud
: lda #$0001 ; set horizontal position to 1
sta ESCACC
; fall-through to CHA
; cursor horizontal absolute
cha: lda a:_CV ; get current cursor vertical
and #$00FF
inc a ; because ANSI counts from 1...
sta ESCNUM1
; fall-through to CUP
; cursor position
cup: ldx ESCACC
beq :+ ; if it's zero, leave it as such
dex
: ldy ESCNUM1
beq :+
dey
: jmp _goto_xy
; erase display
ed: lda ESCACC
beq clreos
dec a
bne :+
rts ; if 1, clear from beginning to cursor (not supported)
: lda _CV ; otherwise clear whole screen
and #$FF
pha
lda _CH
and #$FF
pha
jsr clrscr
plx
ply
jmp _goto_xy
clrscr: ldy #$0C
jmp _con_write
clreos: ldy #$0B
jmp _con_write
; erase line
el: ldy #$1D ; clear to end of line
lda ESCACC
beq :+
cmp #$02
bne :++
erase_ln: ldy #$1A ; clear entire line
: jmp _con_write
: rts
; insert line, cheat because no native function in firmware
; scroll the lines downward and then exit through erase_ln
il: jsr _cursor_off
jsr do_il
dec ESCACC
bmi :+
beq :+
bra il
: jmp _cursor_on
do_il: lda #23 ; start at line 23 and move toward CV
sta ZR ; source line
: lda _CV ; is it the current line?
and #$FF
cmp ZR
beq erase_ln ; it is, erase it
jsr _80store_on
lda ZR
asl
tax
2019-07-09 19:31:40 +00:00
ldy _scrn_tab,x ; get dest line address
2019-07-01 17:33:44 +00:00
dec ZR ; next lower line
lda ZR
asl
tax
lda _scrn_tab,x ; get source line address
tax
jsr _copy_line
jsr _80store_off
bra :-
; delete line
dl: jsr _cursor_off
jsr do_dl
dec ESCACC
bmi :+
beq :+
bra dl
: jmp _cursor_on
do_dl: lda _CV ; start at CV and move toward line 23
and #$FF
sta ZR
: lda ZR ; dest line
cmp #23 ; is it 23?
bne :+ ; no, go move the lines
lda _CV ; save current cursor pos
and #$FF
pha
lda _CH
and #$FF
pha
tax
ldy #23 ; position on bottom line
jsr _goto_xy
jsr erase_ln ; and clear it out
plx
ply
jmp _goto_xy
: jsr _80store_on
lda ZR
asl
tax
ldy _scrn_tab,x
inc ZR
lda ZR
asl
tax
lda _scrn_tab,x
tax
jsr _copy_line
bra :--
; insert char
2019-07-09 19:31:40 +00:00
ich: jsr _80store_on
lda a:_CH
and #$00FF
tax
: jsr _get_char
inx
jsr _put_char
cpx #79
bcc :-
lda a:_CH
and #$00FF
tax
lda #' '
jsr _put_char
jsr _80store_off
rts
2019-07-01 17:33:44 +00:00
; delete char
2019-07-09 19:31:40 +00:00
dch: jsr _80store_on
ldx #79
: jsr _get_char
dex
jsr _put_char
txa
sep #SHORT_I
cpx a:_CH
rep #SHORT_I
bne :-
lda #' '
ldx #79
jsr _put_char
jsr _80store_off
rts
2019-07-01 17:33:44 +00:00
; set graphic rendition
sgr: lda ESCACC
cmp #10
beq mtoff
bcc :+
cmp #20
bcc mton
rts
: and #$01
clc
adc #$0E ; $0E = normal, $0F=inverse
tay
jsr _con_write
rts
mton: sty ESCNUM1
ldy #$1B
jsr _con_write
ldy #$0F
bra _con_write
mtoff: ldy #$18
jsr _con_write
ldy #$0E
bra _con_write
; scroll up
sd: ldy #$16
bra con_wr_n
su: ldy #$17
; fall-through
con_wr_n: sty ESCNUM1
: jsr _con_write
dec ESCACC
bmi :+
beq :+
ldy ESCNUM1
bra :-
: rts
.endproc
.proc _con_write
lda CON_WR
sta ECALL
tya
ldx #$C3 ; required by P1.1 I/F
ldy #$30
jmp _emulation_call
.endproc
.proc _cursor_off
ldy #$06
bra _con_write
.endproc
.proc _cursor_on
ldy #$05
bra _con_write
.endproc
.proc _goto_xy
phy
phx
ldy #$1E
jsr _con_write
pla ; x coord
clc
adc #32
tay
jsr _con_write
pla ; y coord
clc
adc #32
tay
bra _con_write
.endproc
; copy screen line, source base in X, dst base in Y
.proc _copy_line
phb
phy
phx
lda #38 ; # of chars MINUS ONE
mvn $00,$00 ; do main ram bytes
sep #SHORT_A
sta TXTPAGE2
rep #SHORT_A
plx
ply
lda #38
mvn $00,$00 ; do aux ram bytes
sep #SHORT_A
sta TXTPAGE1
rep #SHORT_A
plb
rts
.endproc
2019-07-09 19:31:40 +00:00
; with base address in _BASL and column # in X, set ZR to base address (long pointer)
; select appropriate text page, and set Y to byte offset of the column
.proc _scrn
lda a:_BASL
sta ZR
stz ZR+2
txa
lsr
tay
bcs :+
sep #SHORT_A
sta TXTPAGE2
rep #SHORT_A
: rts
.endproc
; get char in A at pos X assuming BASL/H are the calculated base address
; trashes Y, preserves X
; assumes data bank is 0 because that's where we are supposed to be
.proc _get_char
jsr _scrn
lda [ZR],y
and #$00FF
sep #SHORT_A
sta TXTPAGE1
rep #SHORT_A
rts
.endproc
; put char from A at pos X assuming BASL/H are the calculated base address
; assumes data bank is 0 because that's where we are supposed to be
; trashes Y, preserves A and X
.proc _put_char
pha
jsr _scrn
pla
sep #SHORT_A
sta [ZR],y
sta TXTPAGE1
rep #SHORT_A
rts
.endproc
2019-07-01 17:33:44 +00:00
.proc _80store_on
sep #SHORT_A
sta STO80_ON
rep #SHORT_A
rts
.endproc
.proc _80store_off
sep #SHORT_A
sta STO80_ON
rep #SHORT_A
rts
.endproc
.proc _sf_keyq
lda CON_ST
sta ECALL
lda #$01 ; check input status
ldx #$C3 ; required by P1.1 I/F
ldy #$30
jsr _emulation_call
ldy #$0000
bcc :+ ; if not ready
dey
: tya
plx
jsr _pushay
jmp _sf_success
.endproc
.proc _sf_key
lda CON_RD
sta ECALL
: ldx #$C3 ; required by P1.1 I/F
ldy #$30
jsr _emulation_call
and #$00FF
beq :- ; reject nulls
tay
lda #$0000
plx
jsr _pushay
jmp _sf_success
.endproc
.proc _sf_fcode ; none for now
lda #$0000
tay
plx
jsr _pushay
jmp _sf_success
.endproc
.proc _sf_reset_all
lda #Reset
sta ECALL
inc PwrByte
jsr _emulation_call
jmp _sf_fail
.endproc