of816/platforms/Neon816/platform-lib.s

1247 lines
33 KiB
ArmAsm

; Platform support library for Neon816
;
.include "./Neon816-hw.inc"
PLATF_DP = DP_END
KEYMODS = PLATF_DP ; keyboard modifiers, 16 bits
; b15 = left shift
; b14 = right shift
; b7 = left ctrl
; b6 = right ctrl
; these 3 are same position as set LED command:
; b2 = scroll lock (reserved)
; b1 = num lock (reserved)
; b0 = caps lock
; Neon816 dictionary, a bit of a different approach than the other ports
; This will get set up by the post init function of the system interface
; The system interface functions are after this dictionary.
; Note that most of the words are based on words found in NeonFORTH and
; are not subject to the OF816 license terms, but rather any terms that
; Lenore Byron places on them.
dstart "neon816"
dchain H_FORTH ; Make branch off the word FORTH
; H: ( byte -- ) write byte to PS/2 keyboard port.
dword PS2K_STORE,"PS2K!"
jsr _popay
tya
jsr ps2k_write
NEXT
eword
; H: ( -- f ) f is true if data waiting at PS/2 keyboard port.
dword PS2K_QUERY,"PS2K?"
jsr ps2k_ready
ldy #$0000
bcc :+
dey
: tya
PUSHNEXT
eword
; H: ( -- byte ) read byte from PS/2 keyboard port.
dword PS2K_FETCH,"PS2K@"
jsr ps2k_read
jsr _pusha
NEXT
eword
; H: ( -- c ) wait for keypress on PS/2 port, c is the character typed.
dword PS2KEY,"PS2KEY"
jsr ps2_keyin
jsr _pusha
NEXT
eword
; H: ( -- code f ) read raw keycode from PS/2 port.
; H: code is keycode, either xx or E0xx, f is true if break.
dword PS2RAW,"PS2RAW"
jsr ps2_readcode
php
jsr _pusha
ldy #$00
plp
bcc :+
dey
: tya
PUSHNEXT
eword
; H: ( byte -- ) write byte to PS/2 mouse port.
dword PS2M_STORE,"PS2M!"
jsr _popay
tya
sep #SHORT_A
.a8
sta f:PS2Mio
: lda f:PS2Mstat
bit #$08
bne :-
rep #SHORT_A
.a16
NEXT
eword
; H: ( -- f ) f is true if data waiting at PS/2 mouse port.
dword PS2M_QUERY,"PS2M?"
ldy #$0000
sep #SHORT_A
.a8
lda f:PS2Mstat
ror
rep #SHORT_A
.a16
bcc :+
dey
: tya
PUSHNEXT
eword
; H: ( -- byte ) read byte from PS/2 keyboard port.
dword PS2M_FETCH,"PS2M@"
sep #SHORT_A
.a8
: lda f:PS2Mstat
ror
bcc :-
lda f:PS2Mio
rep #SHORT_A
.a16
and #$00FF
jsr _pusha
NEXT
eword
; H: ( -- ) send reset command to PS/2 keyboard
dword dKBDRESET,"$KBDRESET"
ENTER
ONLIT $FF
.dword PS2K_STORE
EXIT
eword
; H: ( day hour minutes seconds ms us -- ) set RTC
; The registers must be set starting with the microseconds and ending with the day
; when the day is written the clock registers are copied to the internal registers
dword SETRTC,"SETRTC"
txa
clc
adc #20
cmp STK_TOP
bcc :+
jmp _stku_err
: lda STACKBASE+0,x
sta RTCus
lda STACKBASE+4,x
sta RTCms
sep #SHORT_A
.a8
lda STACKBASE+8,x
sta RTCsec
lda STACKBASE+12,x
sta RTCmin
lda STACKBASE+16,x
sta RTChour
rep #SHORT_A
.a16
lda STACKBASE+20,x
sta RTCday
txa
clc
adc #24
tax
NEXT
eword
; H: ( -- day hour minutes seconds ms us ) get RTC
; The registers must be read starting with the microseconds to copy the internal
; registers to the clock registers.
dword GETRTC,"GETRTC"
lda #$0000
tay
jsr _pushay
jsr _pushay
jsr _pushay
jsr _pushay
jsr _pushay
jsr _pushay
lda RTCus
sta STACKBASE+0,x
lda RTCms
sta STACKBASE+4,x
sep #SHORT_A
.a8
lda RTCsec
sta STACKBASE+8,x
lda RTCmin
sta STACKBASE+12,x
lda RTChour
sta STACKBASE+16,x
rep #SHORT_A
.a16
lda RTCday
sta STACKBASE+20,x
NEXT
eword
.proc _getms
lda RTCus ; latch clock registers
lda RTCms ; get ms
rts
.endproc
; waits for up to 511 ms (ms timer is 0-999)
.proc _mswait
and #$1FF
beq :++
pha
jsr _getms
and #$1FF
pha
: jsr _getms
sec ; should we worry about 1 ms?
sbc 1,s
and #$1FF
cmp 3,s
bcc :-
pla
pla
: rts
.endproc
; NOTE: sets short accumulator and leaves it that way on exit!
.proc I2C2_busy_wait
sep #SHORT_A
nosep:
.a8
: lda f:I2C2ctrl
rol
bcs :-
rts
.a16
.endproc
; H: ( -- ) start I2C2 communication.
dword I2C2START,"I2C2START"
jsr I2C2_busy_wait
.a8
lda #$01
sta f:I2C2ctrl
rep #SHORT_A
.a16
NEXT
eword
; H: ( -- ) stop I2C2 communication.
dword I2C2STOP,"I2C2STOP"
jsr I2C2_busy_wait
.a8
lda #$02
sta f:I2C2ctrl
rep #SHORT_A
.a16
NEXT
eword
; H: ( byte -- ) write byte to I2C2.
dword I2C2_STORE,"I2C2!"
jsr _popay
jsr I2C2_busy_wait
.a8
tya
sta f:I2C2io
lda #$08
sta f:I2C2ctrl
rep #SHORT_A
.a16
NEXT
eword
; H: ( -- byte ) receive byte from I2C2, send ack.
dword I2C2_FETCH_ACK,"I2C2@+"
jsr I2C2_busy_wait
.a8
lda #$44
dofetch: sta f:I2C2ctrl
jsr I2C2_busy_wait::nosep
lda f:I2C2io
rep #SHORT_A
.a16
and #$00FF
jsr _pusha
NEXT
eword
; H: ( -- byte ) receive byte from I2C2, do not send ack.
dword I2C2_FETCH,"I2C2@"
jsr I2C2_busy_wait
.a8
lda #$04
bra I2C2_FETCH_ACK::dofetch
.a16
eword
; H: ( offset byte -- ) write byte to VDC at offset
dword VDC_C_STORE,"VDCC!"
jsr _popay ; pop offset
phy ; save low word
jsr _popay ; pop value to write
pla ; get offset back
phx ; save SP
tax ; offset to x reg
sep #SHORT_A ; whew! that was fun!
.a8
tya ; value to A
sta f:VDCbase,x
rep #SHORT_A
.a16
plx ; restore SP
NEXT
eword
; H: ( offset -- byte ) read byte from VDC at offset
dword VDC_C_FETCH,"VDCC@"
jsr _popay ; pop offet
phx ; save SP
tya
tax
sep #SHORT_A ; whew! that was fun!
.a8
lda f:VDCbase,x
rep #SHORT_A
.a16
plx ; restore SP
and #$00FF
jsr _pusha
NEXT
eword
; H: ( offset word -- ) write word to VDC at offset
dword VDC_STORE,"VDC!"
jsr _popay ; again! again! again!
phy
jsr _popay
pla
phx
tax
tya
sta f:VDCbase,x
rep #SHORT_A
.a16
plx ; restore SP
NEXT
eword
dword VIDSTART,"VIDSTART"
ENTER
ONLIT $0799
ONLIT $10
.dword VDC_STORE
ONLIT $0839
ONLIT $12
.dword VDC_STORE
ONLIT $03C7
ONLIT $14
.dword VDC_STORE
ONLIT $041E
ONLIT $16
.dword VDC_STORE
ONLIT $0257
ONLIT $18
.dword VDC_STORE
ONLIT $0258
ONLIT $1A
.dword VDC_STORE
ONLIT $025C
ONLIT $1C
.dword VDC_STORE
ONLIT $0272
ONLIT $1E
.dword VDC_STORE
vid_on: ONLIT $92
: .dword ZERO
.dword VDC_C_STORE
.dword ZERO
.dword VDC_C_FETCH
.dword IF
.dword :- ; branch if false
.dword I2C2START
ONLIT $70
.dword I2C2_STORE
ONLIT $08
.dword I2C2_STORE
ONLIT $B9
.dword I2C2_STORE
.dword I2C2STOP
EXIT
eword
dword VMODELINE,"VMODELINE"
ENTER
.dword TWO
.dword MINUS
ONLIT $1E
.dword VDC_STORE
.dword DECR
ONLIT $1C
.dword VDC_STORE
.dword DECR
ONLIT $1A
.dword VDC_STORE
.dword DECR
ONLIT $18
.dword VDC_STORE
.dword TWO
.dword MINUS
ONLIT $16
.dword VDC_STORE
.dword DECR
ONLIT $14
.dword VDC_STORE
.dword DECR
ONLIT $12
.dword VDC_STORE
.dword DECR
ONLIT $10
.dword VDC_STORE
JUMP VIDSTART::vid_on
eword
dword VIDSTOP,"VIDSTOP"
ENTER
.dword I2C2START
ONLIT $70
.dword I2C2_STORE
ONLIT $08
.dword I2C2_STORE
ONLIT $FE
.dword I2C2_STORE
.dword I2C2STOP
.dword ZERO
.dword ZERO
.dword VDC_C_STORE
EXIT
eword
; H: ( -- ) dump display EDID data, first 256 bytes.
dword DUMPEDID,"DUMPEDID"
dump_size = $0100
ENTER
ONLIT dump_size
.dword ALLOC ; buffer for downloaded EDID data
.dword I2C2START
ONLIT $A0
.dword I2C2_STORE
.dword ZERO
.dword I2C2_STORE
.dword I2C2START
ONLIT $A1
.dword I2C2_STORE
ONLIT dump_size
.dword ZERO
.dword _DO
: .dword I2C2_FETCH_ACK
.dword OVER
.dword IX
.dword PLUS
.dword CSTORE
.dword ONE
.dword _PLOOP
.dword :-
.dword UNLOOP
.dword I2C2_FETCH ; NeonFORTH displays this
.dword I2C2STOP
.dword DUP
ONLIT dump_size
.dword DUMP
ONLIT dump_size
.dword FREE
EXIT
eword
; H: ( -- ) initialize SPI2.
dword SPI2INIT,"SPI2INIT"
sep #SHORT_A
.a8
lda #$00
sta f:SPI2ctrl
sta f:SPI2ctrl2
lda #$05
sta f:SPI2ctrl3
rep #SHORT_A
.a16
NEXT
eword
; H: ( -- ) start SPI2 communication.
dword SPI2START,"SPI2START"
sep #SHORT_A
.a8
lda #$01
sta f:SPI2ctrl
rep #SHORT_A
.a16
NEXT
eword
; H: ( -- ) stop SPI2 communication.
dword SPI2STOP,"SPI2STOP"
sep #SHORT_A
.a8
: lda f:SPI2ctrl
and #$40
bne :-
sta f:SPI2ctrl ; note A=0
rep #SHORT_A
.a16
NEXT
eword
; NOTE: sets short accumulator and leaves it that way on exit!
.proc SPI2_busy_wait
sep #SHORT_A
nosep:
.a8
: lda f:SPI2ctrl
rol
bcs :-
rts
.a16
.endproc
; H: ( byte -- ) write byte to SPI2.
dword SPI2_STORE,"SPI2!"
jsr _popay
jsr SPI2_busy_wait
.a8
tya
sta f:SPI2io
rep #SHORT_A
.a16
NEXT
eword
; H: ( -- byte ) fetch byte from SPI2.
dword SPI2_FETCH,"SPI2@"
jsr SPI2_busy_wait
.a8
lda #$00
sta f:SPI2io
: lda f:SPI2ctrl
bit #$40
bne :-
lda f:SPI2io
rep #SHORT_A
.a16
and #$00FF
jsr _pusha
NEXT
eword
dend
; and now for the system interface
.proc _system_interface
;wdm 3
phx
asl
tax
jmp (.loword(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 _sf_success
lda #$0000
tay
clc
rtl
.endproc
.proc _sf_fail
ldy #.loword(-21)
lda #.hiword(-21)
sec
rtl
.endproc
.proc _sf_pre_init
; NeonFORTH does this, presumably to initialize the serial port
; The code from here to the EOC commment was adapted from code written by Lenore Byron
sep #SHORT_A
.a8
lda #$8D
sta f:SERctrlA
lda #$06
sta f:SERctrlB
lda #$00
sta f:SERctrlC
rep #SHORT_A
.a16
; EOC
plx
jmp _sf_success
.endproc
.proc _sf_post_init
plx
stz KEYMODS
; Here we make a vocabulary definition for the neon816 dictionary
; that we defined at the beginning of this file.
ENTER
ONLIT LAST_neon816
SLIT "NEON816"
.dword dVOCAB
.dword LAST ; now set the head of the vocabulary to the
.dword drXT ; last word defined in the neon816 dictionary
.dword rBODY
.dword STORE
CODE
jmp _sf_success
.endproc
.proc _sf_emit
plx ; get forth SP
jsr _popay ; grab the top item
phx ; and save new SP
; The code from here to the EOC commment was adapted from code written by Lenore Byron
sep #SHORT_A
.a8
tya
sta f:SERio
: lda f:SERstat
bit #$08
bne :-
rep #SHORT_A
.a16
; EOC
plx
jmp _sf_success
.endproc
.proc _sf_keyq
ldy #$0000 ; anticipate false
; The code from here to the EOC commment was adapted from code written by Lenore Byron
sep #SHORT_A
.a8
lda f:SERstat ; b0=1 if data ready
ror
bcc :+
iny
: rep #SHORT_A
.a16
; EOC
tya
plx
jsr _pushay
jmp _sf_success
.endproc
.proc _sf_key
; The code from here to the EOC commment was adapted from code written by Lenore Byron
sep #SHORT_A
.a8
: lda f:SERstat
ror
bcc :-
lda f:SERio
rep #SHORT_A
.a16
; EOC
and #$00FF
tay
lda #$0000
plx
jsr _pushay
jmp _sf_success
.endproc
.proc _sf_fcode
.if include_fcode
ldy #.loword(list)
lda #.hiword(list)
.else
lda #$0000
tay
.endif
plx
jsr _pushay
jmp _sf_success
.if include_fcode
list:
.dword 0
.endif
.endproc
; TODO....
.proc _sf_reset_all
plx
jmp _sf_fail
.endproc
; return carry set if data waiting at PS/2 keyboard port, clear otherwise
; destroys A
.proc ps2k_ready
sep #SHORT_A
.a8
lda f:PS2Kstat
ror
rep #SHORT_A
.a16
rts
.endproc
; read data from PS/2 keyboard port, blocking
; returns byte in A
.proc ps2k_read
sep #SHORT_A
.a8
: lda f:PS2Kstat
ror
bcc :-
lda f:PS2Kio
rep #SHORT_A
.a16
and #$00FF
rts
.endproc
; write data byte in A to PS/2 keyboard port
.proc ps2k_write
sep #SHORT_A
.a8
sta f:PS2Kio
: lda f:PS2Kstat
bit #$08
bne :-
rep #SHORT_A
.a16
rts
.endproc
.proc ps2k_command
jsr ps2k_write
jsr ps2k_read
cmp #$00FA
rts
.endproc
; Keyboard translate tables
; unshifted and shifted codes
; if high bit set, jump to special handler routine
.proc mktab ; 'main' scan codes'
; $00
.byte $00,$00 ; none
.byte $00,$00 ; F9
.byte $00,$00 ; none
.byte $00,$00 ; F5
.byte $00,$00 ; F3
.byte $00,$00 ; F1
.byte $00,$00 ; F2
.byte $00,$00 ; F12
; $08
.byte $00,$00 ; none
.byte $00,$00 ; F10
.byte $00,$00 ; F8
.byte $00,$00 ; F6
.byte $00,$00 ; F4
.byte $09,$09 ; Tab
.byte '`','~'
.byte $00,$00 ; none
; $10
.byte $00,$00 ; none
.byte $00,$00 ; left alt
.byte $80,$80 ; left shift
.byte $00,$00 ; none
.byte $86,$86 ; left control
.byte 'q','Q'
.byte '1','!'
.byte $00,$00 ; none
; $18
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte 'z','Z'
.byte 's','S'
.byte 'a','A'
.byte 'w','W'
.byte '2','@'
.byte $00,$00 ; none
; $20
.byte $00,$00 ; none
.byte 'c','C'
.byte 'x','X'
.byte 'd','D'
.byte 'e','E'
.byte '4','$'
.byte '3','#'
.byte $00,$00 ; none
; $28
.byte $00,$00 ; none
.byte ' ',' '
.byte 'v','V'
.byte 'f','F'
.byte 't','T'
.byte 'r','R'
.byte '5','S'
.byte $00,$00 ; none
; $30
.byte $00,$00 ; none
.byte 'n','N'
.byte 'b','B'
.byte 'h','H'
.byte 'g','G'
.byte 'y','Y'
.byte '6','^'
.byte $00,$00 ; none
; $38
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte 'm','M'
.byte 'j','J'
.byte 'u','U'
.byte '7','&'
.byte '8','*'
.byte $00,$00 ; none
; $40
.byte $00,$00 ; none
.byte ',','<'
.byte 'k','K'
.byte 'i','I'
.byte 'o','O'
.byte '0',')'
.byte '9','('
.byte $00,$00 ; none
; $48
.byte $00,$00 ; none
.byte '.','>'
.byte '/','?'
.byte 'l','L'
.byte ';',':'
.byte 'p','P'
.byte '-','_'
.byte $00,$00 ; none
; $50
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $27,'"'
.byte $00,$00 ; none
.byte '[','{'
.byte '=','+'
.byte $00,$00 ; none
.byte $00,$00 ; none
; $58
.byte $84,$84 ; caps lock
.byte $82,$82 ; right shift
.byte $0D,$0D ; enter
.byte ']','}'
.byte $00,$00 ; none
.byte '\','|'
.byte $00,$00 ; none
.byte $00,$00 ; none
; $60
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $08,$7F ; backspace
.byte $00,$00 ; none
; $68
.byte $00,$00 ; none
.byte '1','1' ; keypad
.byte $00,$00 ; none
.byte '4','4' ; keypad
.byte '7','7' ; keypad
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
; $70
.byte '0','0' ; keypad
.byte '.','.' ; keypad
.byte '2','2' ; keypad
.byte '5','5' ; keypad
.byte '6','6' ; keypad
.byte '8','8' ; keypad
.byte $1B,$1B ; escape
.byte $00,$00 ; num lock
; $78
.byte $00,$00 ; F11
.byte '+','+' ; keypad
.byte '3','3' ; keypad
.byte '-','-' ; keypad
.byte '*','*' ; keypad
.byte '9','9' ; keypad
.byte $00,$00 ; scroll lock
.byte $00,$00 ; none
; $80
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; F7
.endproc
.proc ektab ; E0 scan codes
; $00
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
; $08
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
; $10
.byte $00,$00 ; MM WWW search
.byte $00,$00 ; right alt
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $88,$88 ; right control
.byte $00,$00 ; MM prev track
.byte $00,$00 ; none
.byte $00,$00 ; none
; $18
.byte $00,$00 ; MM WWW favorites
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; left GUI
; $20
.byte $00,$00 ; MM WWW refresh
.byte $00,$00 ; MM vol down
.byte $00,$00 ; MM mute
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; right GUI
; $28
.byte $00,$00 ; MM WWW stop
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; MM calculator
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; 'apps'
; $30
.byte $00,$00 ; MM WWW forward
.byte $00,$00 ; none
.byte $00,$00 ; MM vol up
.byte $00,$00 ; none
.byte $00,$00 ; MM play/pause
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; ACPI power
; $38
.byte $00,$00 ; MM WWW back
.byte $00,$00 ; none
.byte $00,$00 ; MM WWW home
.byte $00,$00 ; MM stop
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; ACPI sleep
; $40
.byte $00,$00 ; MM my computer
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
; $48
.byte $00,$00 ; MM email
.byte $00,$00 ; none
.byte '/','/' ; keypad
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; MM next track
.byte $00,$00 ; none
.byte $00,$00 ; none
; $50
.byte $00,$00 ; MM select
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
; $58
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $0D,$0D ; keypad 'enter'
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; ACPI wake
.byte $00,$00 ; none
; $60
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
; $68
.byte $00,$00 ; none
.byte $00,$00 ; end
.byte $00,$00 ; none
.byte $08,$08 ; cursor left
.byte $00,$00 ; home
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; none
; $70
.byte $00,$00 ; insert
.byte $7F,$7F ; delete
.byte $0A,$0A ; cursor down
.byte $00,$00 ; none
.byte $15,$15 ; cursor right
.byte $0B,$0B ; cursor up
.byte $00,$00 ; none
.byte $00,$00 ; none
; $78
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; page down
.byte $00,$00 ; none
.byte $00,$00 ; none
.byte $00,$00 ; page up
.endproc
; Tables of routines for special make/break of keys (values > $80)
; kmktbl and kbktbl must match up.
.proc kmktbl
.addr mk_lshift-1 ; $80
.addr mk_rshift-1 ; $82
.addr mk_caps-1 ; $84
.addr mk_lctrl-1 ; $86
.addr mk_rctrl-1 ; $88
.endproc
.proc kbktbl
.addr bk_lshift-1 ; $80
.addr bk_rshift-1 ; $82
.addr bk_caps-1 ; $84
.addr bk_lctrl-1 ; $86
.addr bk_rctrl-1 ; $88
.endproc
.proc mk_lshift
lda #%1000000000000000
bra makemod
.endproc
.proc mk_rshift
lda #%0100000000000000
bra makemod
.endproc
.proc mk_caps
lda KEYMODS
eor #%1
sta KEYMODS
; fall-through to ps2_setLEDs
.endproc
.proc ps2_setleds
lda #$ED ; set LEDs command
jsr ps2k_command
lda KEYMODS
and #%111
jsr ps2k_command
rts
.endproc
.proc mk_lctrl
lda #%0000000010000000
bra makemod
.endproc
.proc mk_rctrl
lda #%0000000001000000
;bra makemod
.endproc
.proc makemod
tsb KEYMODS
rts
.endproc
.proc bk_lshift
lda #%1000000000000000
bra breakmod
.endproc
.proc bk_rshift
lda #%0100000000000000
bra breakmod
.endproc
.proc bk_caps
rts
.endproc
.proc bk_lctrl
lda #%0000000010000000
bra breakmod
.endproc
.proc bk_rctrl
lda #%0000000001000000
;bra breakmod
.endproc
.proc breakmod
trb KEYMODS
rts
.endproc
; Read a code from the keyboard, return carry set if it was 'break' and clear
; if it was 'make'
.proc ps2_readcode
phy ; save Y
ldy #$0000 ; flag for break
phy ; space for extended code byte
: jsr ps2k_read
cmp #$E1 ; pause/break annoyance
beq pausebrk
cmp #$E0 ; extended code?
bne :+
xba
sta 1,s ; yes, put in upper byte on stack
bra :- ; back to read
: cmp #$F0 ; break code?
bne :+
iny ; yes, flag
bra :-- ; back to read
: ora 1,s ; if none of those, put in lower byte
sta 1,s ; inefficient but it works
pla ; and get it off the stack
done: cpy #$01 ; set carry if break
ply ; restore Y
rts
pausebrk: pla
ldy #7
: jsr ps2k_read ; drop 7 bytes
dey
bne :-
lda #$E000 ; bogus scan code
bra done
.endproc
; get code from translate table for key code in A, return in A
; destroys y, returns 0000 if there is no translation
.proc ps2_keytran
pha
and #$00FF
asl
tay
pla
and #$FF00
cmp #$E000
beq ext
cpy #.sizeof(mktab)
bcs bad
lda mktab,y
bra done
ext: cpy #.sizeof(ektab)
bcs bad
lda ektab,y
bra done
bad: lda #$0000
done: cmp #$0001
rts
.endproc
; take translated code in A, apply keyboard modifiers, and return result in A
; if special, return carry set
.proc ps2_keymod
pha ; work with it on stack
lda KEYMODS
and #%1100000000000000 ; shift keys
beq :+
lda 1,s
xba
sta 1,s
: lda 1,s
and #$0080
bne :++ ; shortcut special
lda KEYMODS
ror ; caps into carry
bcc :+
lda 1,s
and #$00FF
cmp #'a'
bcc :+
cmp #'z'+1
bcs :+
and #$DF
sta 1,s
: lda KEYMODS
and #%0000000011000000 ; ctrl keys
beq :+
lda 1,s
and #%11111 ; make ctrl char
sta 1,s
: pla
and #$00FF
cmp #$0080
rts
.endproc
; Wait for a valid key, when we get one, decode and return
.proc ps2_keyin
: php
: plp
jsr ps2_readcode
php
jsr ps2_keytran
bcc :- ; carry is clear if no value for key
jsr ps2_keymod
bcs special
plp
bcs :-- ; break code, wait for another
rts
special: and #$007F
tay
lda kmktbl,y
plp
bcc :+ ; if make
lda kbktbl,y
: jsr :+
bra :--- ; for special, we go back to waiting
: pha ; do RTS trick
rts
.endproc