[KERNAL] implement PFKEY (X16Community#309)

* [KERNAL] implement PFKEY * C128 keys are 1-based
mooinglemur · Mar 19, 2024 · 1a20e3f · 1a20e3f
1 parent 33630e3
commit 1a20e3f
Show file tree

Hide file tree

Showing 5 changed files with 95 additions and 26 deletions.
diff --git a/cfg/kernal-x16.cfgtpl b/cfg/kernal-x16.cfgtpl
@@ -30,7 +30,6 @@ SEGMENTS {
 	INIT:     load = KERNAL,   type = ro;
 	EDITOR:   load = KERNAL,   type = ro;
 	SCREEN:   load = KERNAL,   type = ro;
-	KBDBUF:   load = KERNAL,   type = ro;
 	PS2:      load = KERNAL,   type = ro;
 	PS2KBD:   load = KERNAL,   type = ro;
 	PS2MOUSE: load = KERNAL,   type = ro;
@@ -52,6 +51,7 @@ SEGMENTS {
 	C816_COP_NATIVE: load = KERNAL, type = ro, start = $EF4C; # low byte: JMP abs, high byte equals low byte of C816_GETIN_THUNK
 	C816_COP_EMULATED: load = KERNAL, type = ro;
 	C816_ABORT_EMULATED: load = KERNAL, type = ro;
+	KBDBUF:   load = KERNAL,   type = ro;
 	CLOCK:    load = KERNAL,   type = ro;
 	I2C:      load = KERNAL,   type = ro;
 	RTC:      load = KERNAL,   type = ro;

diff --git a/inc/kernal.inc b/inc/kernal.inc
@@ -51,7 +51,7 @@ lkupla                       = $ff59
 lkupsa                       = $ff5c
 screen_mode                  = $ff5f ; old name: swapper
 screen_set_charset           = $ff62 ; old name: dlchr
-pfkey                        = $ff65 ; NYI
+pfkey                        = $ff65
 jsrfar                       = $ff6e
 fetch                        = $ff74
 stash                        = $ff77

diff --git a/kernal/cbm/editor.s b/kernal/cbm/editor.s
@@ -16,6 +16,7 @@ nwrap=4 ;max number of physical lines per logical line
 .export cint   ; initialize screen
 .export prt    ; print character
 .export loop5  ; input a line until carriage return
+.export pfkey  ; program function key
 
 .importzp mhz  ; constant
 
@@ -133,7 +134,11 @@ nlinesm1	.res 1          ;    X16: y resolution - 1
 verbatim	.res 1
 
 .segment "KVARSB0"
-isocurch:	.res 1          ;    ISO mode cursor char, usually $9F
+isocurch:
+	.res 1          ; ISO mode cursor char, usually $9F
+fkeytb:
+	.res 99         ; Programmable F key macros
+runtb = fkeytb+88;
 
 .segment "C816_SCRORG"
 ;
@@ -231,6 +236,8 @@ cint	jsr iokeys
 	sta blnct
 	sta blnsw
 
+	jsr set_fkey_defaults
+
 ; clear screen, populate ldtb1 with non-continuing lines
 clsr	lda #$ff
 	ldx #7
@@ -301,7 +308,7 @@ loop3
 	lda shflag      ;Clear 40/80 key bit
 	and #(255-MODIFIER_4080)
 	sta shflag
-	
+
 	and #MODIFIER_SHIFT
 	bne scrpnc
 	jsr screen_toggle_default_nvram
@@ -384,12 +391,14 @@ lp21	plp             ;restore I
 	bne lp22
 ; put SHIFT+STOP text into keyboard buffer
 	jsr kbdbuf_clear
+	KVARS_START_TRASH_A_NZ
 	ldx #0
 :	lda runtb,x
+	beq :+
 	jsr kbdbuf_put
 	inx
-	cpx #runtb_end-runtb
 	bne :-
+:	KVARS_END_TRASH_A_NZ
 	jmp loop3
 
 lp22	pha
@@ -401,24 +410,25 @@ lp22	pha
 	cmp #4
 	rol              ;convert to f1-f8 -> 0-7
 	and #7
+	KVARS_START_TRASH_X_NZ
 	ldx #0
 	tay
 	beq lp27
-lp25	lda fkeytb,x     ;search for replacement
-	beq lp26
-	inx
-	bne lp25
-lp26	inx
+lp25	lda #0
+	clc
+lp26	adc #11
 	dey
-	bne lp25
+	bne lp26
+	tax
 lp27	jsr kbdbuf_clear
 lp24	lda fkeytb,x
 	jsr kbdbuf_put
 	tay              ;set flags
 	beq lp28
 	inx
 	bne lp24
-lp28	pla
+lp28	KVARS_END_TRASH_X_NZ
+	 pla
 loop3a	jmp loop3
 ;
 lp29	pla
@@ -1305,17 +1315,76 @@ iso_cursor_char:
 	KVARS_END
 	rts
 
-runtb	.byt "LOAD",$d,"RUN:",$d
-runtb_end:
-
-fkeytb	.byt "LIST:", 13, 0
-	.byt "SAVE", '"', "@:", 0
-	.byt "LOAD ", '"', 0
-	.byt "S", 'C' + $80, "-1:REM", 0
-	.byt "RUN:", 13, 0
-	.byt "MONITOR:", 13, 0
-	.byt "DOS",'"', "$",13, 0
-	.byt "DOS", '"', 0
+pfkey:
+	KVARS_START
+	cpy #11 ; max length is 10 characters
+	bcs @error
+	dex    ; input shuld be 1-9, shifted to 0-8
+	cpx #9 ; max keynum is 9 (shifted to 8)
+	bcs @error
+	phy ; preserve Y (length)
+	phx ; preserve X (keynum)
+	tax ; pointer is in ZP
+	; get pointer out of arbitrary ZP into kernal ZP
+	lda 0,x
+	sta tmp2
+	lda 1,x
+	sta tmp2+1
+	; convert key number to offset into table
+	; multiply X by 11
+	plx ; restore X (keynum)
+	beq @found
+	clc
+	lda #0
+:	adc #11
+	dex
+	bne :-
+	tax
+@found:
+	ply ; restore Y (length)
+	beq @terminate
+@loop:
+	lda (tmp2)
+	sta fkeytb,x
+	inc tmp2
+	bne :+
+	inc tmp2+1
+:	inx
+	dey
+	bne @loop
+@terminate:
+	lda #0
+	sta fkeytb,x
+@good:
+	clc
+	bra @end
+@error:
+	sec
+@end:
+	KVARS_END
+	rts
+
+set_fkey_defaults:
+	KVARS_START_TRASH_A_NZ
+	ldx #<(fkeydtb_end-fkeydtb)
+:	lda fkeydtb-1,x
+	sta fkeytb-1,x
+	dex
+	bne :-
+	KVARS_END_TRASH_A_NZ
+	rts
+
+fkeydtb:
+	.byt "LIST:", 13, 0, 0, 0, 0, 0
+	.byt "SAVE", '"', "@:", 0, 0, 0, 0
+	.byt "LOAD ", '"', 0, 0, 0, 0, 0
+	.byt "S", 'C' + $80, "-1:REM", 0, 0 ,0
+	.byt "RUN:", 13, 0, 0, 0, 0, 0, 0
+	.byt "MONITOR:", 13, 0, 0
+	.byt "DOS",'"', "$",13, 0, 0, 0, 0, 0
+	.byt "DOS", '"', 0, 0, 0, 0 ,0, 0, 0
+	.byt "LOAD",$d,"RUN:",$d, 0
+fkeydtb_end:
 
 beeplo: .lobytes 526,885,1404
 beephi: .hibytes 526,885,1404

diff --git a/kernal/vectors.s b/kernal/vectors.s
@@ -5,7 +5,7 @@
 
 .feature labels_without_colons
 
-.import plot, scrorg, iclall, igetin, istop, savesp, loadsp, ibsout, ibasin, iclrch, ickout, ichkin, iclose, iopen, setnam, setlfs, readst, talk, listn, unlsn, untlk, ciout, acptr, settmo, kbd_scan, tksa, secnd, setmsg, ramtas, ioinit, cint, cmpare, stash, indfet, jsrfar, screen_set_charset, screen_mode, lkupsa, lkupla, close_all, enter_basic, macptr, mciout
+.import plot, scrorg, iclall, igetin, istop, savesp, loadsp, ibsout, ibasin, iclrch, ickout, ichkin, iclose, iopen, setnam, setlfs, readst, talk, listn, unlsn, untlk, ciout, acptr, settmo, kbd_scan, tksa, secnd, setmsg, ramtas, ioinit, cint, cmpare, stash, indfet, jsrfar, screen_set_charset, screen_mode, lkupsa, lkupla, close_all, enter_basic, macptr, mciout, pfkey
 .import FB_move_pixels, FB_filter_pixels, FB_fill_pixels, FB_set_8_pixels_opaque, FB_set_8_pixels, FB_set_pixels, FB_set_pixel, FB_get_pixels, FB_get_pixel, FB_cursor_next_line, FB_cursor_position, FB_set_palette, FB_get_info, FB_init
 .import memory_decompress, memory_crc, memory_copy, memory_fill
 .import monitor
@@ -124,7 +124,7 @@
 	jmp lkupsa             ; $FF5C: [C128] LKUPSA - look up secondary address
 	jmp screen_mode        ; $FF5F: screen_mode - get/set screen mode              [unsupported C128: SWAPPER]
 	jmp screen_set_charset ; $FF62: activate 8x8 text mode charset                 [incompatible with C128: DLCHR – init 80-col character RAM]
-	.byte 0,0,0            ; $FF65: [C128] PFKEY – program a function key          [NYI]
+	jmp pfkey              ; $FF65: [C128] PFKEY – program a function key
 	jmp mouse_config       ; $FF68: mouse_config - configure mouse pointer         [unsupported C128: SETBNK – set bank for I/O operations]
 	jmp mouse_get          ; $FF6B: mouse_get - get state of mouse                 [unsupported C128: GETCFG – lookup MMU data for given bank]
 	jmp jsrfar             ; $FF6E: [C128] JSRFAR – gosub in another bank          [incompatible with C128]

diff --git a/kernsup/kernsup.inc b/kernsup/kernsup.inc
@@ -70,7 +70,7 @@ bridge lkupla              ; $FF59: LKUPLA
 bridge lkupsa              ; $FF5C: LKUPSA
 bridge screen_mode         ; $FF5F: get/set screen mode
 bridge screen_set_charset  ; $FF62: activate 8x8 text mode charset
-.byte 0,0,0                ; $FF65: PFKEY – program a function key [NYI]
+bridge pfkey               ; $FF65: PFKEY – program a function key
 bridge mouse_config        ; $FF68: mouse_config
 bridge mouse_get           ; $FF6B: mouse_get
 jmp xjsrfar                ; $FF6E: JSRFAR – gosub in another bank