10 REM > KBDDemo 1.10
   20 REM Display keyboard keyvalues and demo character conversion functions
   30 REM Note, the fiddly platform tests may mean this code is not 100% correct
   40 :
   50 A%=0:X%=1:os%=((USR&FFF4)AND&FF00)DIV256:IF(K%AND-128)<>128:K%=128
   60 escOn$="ESC ON":escOff$="ESC OFF":ON ERROR escOn$="FX229":escOff$="FX229,1"
   70 A%=VPOS:OSCLIescOn$:ON ERROR OFF:IF A%<>VPOS:escOn$="":escOff$="":VDU11,11:PRINTSPC60;CHR$13;
   80 FOR A%=0 TO 7:OSCLI"FX"+STR$(221+A%)+","+STR$((A%EOR4)*16+112):NEXT
   90 OSCLI"FX225,1":OSCLI"FX4":OSCLIescOn$
  100 PRINT"Keypress input/character output test"'STRING$(36,"-")
  110 PRINT"Program running on ";FNs(FNhost(os%));". ";
  120 IF (K% AND 64):PRINT"K"ELSE PRINT"Native k";
  130 PRINT"eycodes are:":PROCkbdinfo(-1)
  140 VDU 8:wdt%=POS:PRINT':IF wdt%:IF wdt%<31 OR wdt%>79:wdt%=79:IF POS:VDU 11
  150 :
  160 PRINT"Native keycodes:              RISCOS-mapped keycodes:   Regular keycodes:"
  170 PRINT" 1: GET                        6: GET                    A: GET"
  180 PRINT" 2: INKEY(100)                 7: INKEY(100)             B: INKEY(100)"
  190 PRINT" 3: INKEY(100+&8000)           8: INKEY(100+&8000)       C: INKEY(100+&8000)"
  200 PRINT" 4: ADVAL(128-1), buffer read"
  210 PRINT" 5: Test ADVAL(-1), EOF#0      9: Toggle kbd map (";MID$("Native RISC OS",(K%DIV192)*7+1,7+(K%<192));")"
  220 PRINT"Press a key: ";
  230 REPEAT:type$=GET$:IF type$>"`":type$=CHR$(ASCtype$-32)
  240 UNTIL INSTR(CHR$9+"0123456789ABC",type$):PRINTtype$
  250 IF type$="9":K%=(K%EOR64)OR128:PRINT:RUN
  260 IF type$=CHR$9:CLS:RUN
  270 IF type$="0":END
  280 :
  290 adval%=TRUE:ON ERROR adval%=0
  300 IF adval%:adval%=ADVAL(0)OR1
  310 ON ERROR PRINT''':REPORT:PRINT':IF ERR=17:RUN ELSE END
  320 FOR A%=0 TO 7:OSCLI"FX"+STR$(221+A%)+","+STR$((A%EOR4)*16+128):NEXT
  330 IF os%>4:IF INSTR("678ABC",type$):FOR A%=0 TO 7:OSCLI"FX"+STR$(221+A%)+",2":NEXT
  340 OSCLI"FX219,9":OSCLI"FX254,"+STR$K%:OSCLI"FX4,2"
  350 IF type$="5":PROCbuftest:RUN
  360 OSCLIescOff$
  370 PRINT "Esc+Esc to end"''"Returned keycodes should be:"
  380 IF type$<"5":PROCkbdinfo(-1) ELSE IF type$>"8":PROCkbdinfo(8) ELSE PROCkbdinfo(6)
  390 col%=0:key%=0
  400 REPEAT
  410   last%=key%
  420   IF type$="1":key%=GET
  430   IF type$="6":key%=FNrok_GET
  440   IF type$="A":key%=FNkbd_GET
  450   IF type$="2":key%=INKEY(100)
  460   IF type$="7":key%=FNrok_INKEY(100)
  470   IF type$="B":key%=FNkbd_INKEY(100)
  480   IF type$="3":key%=INKEY(&8000+100)
  490   IF type$="8":key%=FNrok_INKEY(&8000+100)
  500   IF type$="C":key%=FNkbd_INKEY(&8000+100)
  510   IF type$="4":key%=FNbuf_rd(0)
  520   PRINT FNh0(key%,3)'STRING$(col%,CHR$9);
  530   FOR A%=0 TO 3:IF A%=2:A%=3
  540     A$=EVAL("FNc"+STR$(A%)+"("+STR$(key%AND255)+")")
  550     PRINT A$'STRING$(col%,CHR$9);
  560   NEXT A%
  570   PRINT STRING$(4,CHR$11);STRING$(5,CHR$9);:col%=col%+5
  580   IF (wdt%>0 AND (col%>wdt%-4 OR (POS<5 AND POS>0))) OR col%>70:PRINTCHR$8'''':col%=0
  590   key%=key% AND 255
  600 UNTIL (key%=27 AND last%=27) OR (INKEY-1 AND INKEY-113)
  610 PRINT''''
  620 RUN
  630 :
  640 DEFPROCbuftest
  650 eof%=TRUE:ON ERROR eof%=0
  660 IF eof%:A%=EOF#0
  670 ptr%=TRUE:ON ERROR ptr%=0
  680 IF ptr%:A%=PTR#0
  690 ext%=TRUE:ON ERROR ext%=0
  700 IF ext%:A%=EXT#0
  710 ON ERROR PRINT''':REPORT:PRINT':IF ERR=17:RUN ELSE END
  720 PRINT'"Type at the keyboard, press SHIFT to fetch, "'"Escape to quit"'
  730 REPEAT
  740   PRINT "ADVAL(-1)=";:A%=ADVAL(-1):PRINT;A%;LEFT$(" not",A%<>0);" empty";SPC4
  750   PRINT "EOF#0=";:IF eof%=0:PRINT "unsupported" ELSE A%=EOF#0:PRINT;A%;LEFT$(" no",A%);" pending";SPC4
  760   PRINT "PTR#0=";:IF ptr%=0:PRINT "unsupported" ELSE PRINT;PTR#0;SPC3
  770   PRINT "EXT#0=";:IF ext%=0:PRINT "unsupported" ELSE PRINT;EXT#0;SPC3
  780   PRINT "INKEY=";:IF INKEY-1:PRINT;INKEY(0);"  " ELSE PRINT
  790 VDU 11,11,11,11,11:UNTIL INKEY-1 AND INKEY-113:RUN
  800 ENDPROC
  810 :
  820 DEFPROCkbdinfo(A%)
  830 IF A%=-1:IF (INKEY-256AND&DB)=&53:PRINT"&8x: c<-,c->,Home,End,PgUp,PgDn,Ins,Del,<-,->,Dn, Up,MsDn,MsUp"
  840 IF A%=-1:IF (INKEY-256AND&DB)=&53:PRINT"&9x: F0, F1,  F2,  F3, F4,  F5, F6, F7, F8,F9,F10,F11,F12,f13,f14,f15":ENDPROC
  850 IF A%=-1:A%=os%
  860 IF A%<8 OR (K%AND64):PRINT"&8x: F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,Break,Copy,<-,->, Dn , Up"
  870 IF A%<8 OR (K%AND64):PRINT"&9x:"SPC48"PgDn,PgUp"'"&Cx:"SPC32"F10, F11,F12,Ins":ENDPROC
  880 IF A%>7:PRINT"&8x: F0,F1,F2,F3,F4,F5,F6, F7, F8, F9, F10, F11, F12,f13,f14,f15"
  890 IF A%>7:PRINT"&Cx:"SPC18"Ins,Del,Home,End,PgDn,PgUp, <-, ->, Dn, Up"
  900 ENDPROC
  910 :
  920 DEFFNhost(A%)
  930 IF A%>27:IF A%<33:=MID$("Commodore 64/128TI Calculator   Amstrad CPC     ZX Spectrum     DOS/Windows     ",A%*16-447,16)
  940 IF A%<11:=MID$("ElectronBBC B   BBC B+  Master  MasterETCompact RISC OS SpringbdUnix    6809UnixApple  ",A%*8+1,8)
  950 IF A%=17:="6809Beeb" ELSE IF A%=24:="CP/M" ELSE IF A%=43:="RT11/RSX/RSTS" ELSE IF A%=57:="6809DOS"
  960 ="unknown"
  970 :
  980 DEFFNh0(A%,N%)=RIGHT$("0000000"+STR$~A%,N%)
  990 DEFFNs(A$):IFLEFT$(A$,1)=" ":REPEATA$=MID$(A$,2):UNTILLEFT$(A$,1)<>" "
 1000 IFRIGHT$(A$,1)=" ":REPEATA$=LEFT$(A$,LENA$-1):UNTILRIGHT$(A$,1)<>" "
 1010 =A$
 1020 :
 1030 REM Character conversions
 1040 DEFFNc0(A%):IF A%>127:="|!"+FNc0(A% AND 127)
 1050 IF A%<32 OR A%=127:="|"+CHR$(A% EOR 64) ELSE =LEFT$("|",A%=34 OR A%=124)+CHR$A%
 1060 DEFFNc1(A%):IF ((A%+1) AND 127)<33:="^"+CHR$(A% EOR 64) ELSE =CHR$A%
 1070 DEFFNc2(A%):IF A%<32 OR A%=127:="." ELSE =CHR$A%
 1080 DEFFNc3(A%):IF ((A%+1) AND 127)<33:="." ELSE =CHR$A%
 1090 :
 1100 REM Buffer read
 1110 DEFFNbuf_rd(X%)
 1120 IF adval%:REPEAT:A%=ADVAL(127-X%):UNTILA%<&8000:=A%
 1130 REPEAT:A%=&91:A%=USR&FFF4:UNTIL (A% AND &1000000)=0
 1140 =(A% AND &FF0000) DIV 65536
 1150 :
 1160 REM Return RISC OS key mapping
 1170 DEFFNrok_GET:LOCAL A%:REPEAT A%=FNrok_INKEY(100):UNTIL A%<>-1:=A%
 1180 DEFFNrok_INKEY(T%):IF os%>7:=FNro2_INKEY(T%)
 1190 A%=INKEY(T%):IF A%>&7F:A%=A% OR &100
 1200 IF os%>4:IF A%=0:A%=INKEY(T%):IF A%>&7F:A%=A% OR &100
 1210 =A%
 1220 DEFFNro2_INKEY(T%)
 1230 A%=FNkbd_INKEY(T%):IFA%<&100:=A%
 1240 IF(A%AND&CE)=&C4:=A%+10
 1250 IF(A%AND&CF)=&C6:=A%+7
 1260 IF(A%AND&CF)=&C8:=&1E
 1270 IF(A%AND&CF)=&C9:=A%-&3E
 1280 IF(A%AND&CE)=&CA:=(A%EOR&50)+4
 1290 =A%EOR((A%AND15)>9AND&40)
 1300 :
 1310 REM General cross-platform regular key input
 1320 DEFFNkbd_GET:LOCAL A%:REPEAT A%=FNkbd_INKEY(100):UNTIL A%<>-1:=A%
 1330 DEFFNkbd_INKEY(T%)
 1340 IF (INKEY-256AND&DB)=&53:=FNkbd_Inkey(T%)
 1350 A%=INKEY(T%)
 1360 IF A%=&AA:IF INKEY-2=0:=A%
 1370 IF A%=&DD:IF INKEY-1=0:=A%
 1380 IF A%=&9C:IF INKEY-30=0:=A%
 1390 IF A%>&7F:A%=A% OR &100
 1400 IF os%>4:IF A%=0:A%=INKEY(T%):IF A%>&7F:A%=A% OR &100
 1410 IF os%>7:=A%
 1420 IF A%<&100:IF A%<>30:=A%
 1430 IF A%=30:=&1C8+(INKEY-1AND16)+(INKEY-2AND32) :REM Home
 1440 IF (A%AND&CF)=&CD:=A%-7                      :REM Ins
 1450 IF (A%AND15)>9:A%=A%EOR&40                   :REM F10-F12/cursors
 1460 IF (A%AND&CF)=&CB:=A%-2                      :REM End
 1470 IF (A%AND&DE)=&CE:=A%+(INKEY-1AND12)         :REM Down/Up or Shift-PgDn/Shift-PgUp
 1480 IF (A%AND&DE)=&DE:=A%-20+(INKEY-1AND20)      :REM Shift-Down/Shift-Up or PgDn/PgUp
 1490 =A%
 1500 :
 1510 REM > BLib.Win.Keyboard 0.11
 1520 REM 03-Dec-2005: J.G.Harston
 1530 :
 1540 DEFFNkbd_Get:LOCAL A%:REPEAT A%=FNkbd_Inkey(100):UNTIL A%<>-1:=A%
 1550 DEFFNkbd_Inkey(T%):LOCALA%,S%:IFT%<0:=INKEYT%
 1560 A%=INKEYT%:S%=(INKEY-1AND16)+(INKEY-2AND32)+(INKEY-3AND48):IFA%<128:=A%
 1570 IFA%=&80:IFINKEY-3:=&A4
 1580 IFA%=&A6:IFINKEY-3:=A%
 1590 IFA%=&A3:IFINKEY-18:=A%
 1600 IFA%=&AC:IFINKEY-46:=A%
 1610 IFA%<&82:=A%+&16C
 1620 IFA%>&9F:=A%-16+&100
 1630 IFA%>&9B:IFS%AND32:=(A%+&14C)EOR((A%>&9D)AND1)
 1640 IFA%=&9A:IFS%AND16:=&1D1
 1650 IFA%>&8F:=A%-16+&100
 1660 =EVAL("&"+MID$("89BA67CDEF45",A%-129,1))+S%+&1C0