**********************************************
*
*  Benutzerdefinition von Funktionstasten
*               DEFKEY 1.0
*         Hermann Kneissel 1987
*         © Copyright KICKSTART
*
**********************************************

 xref    _AbsExecBase
 xref    _LVOAllocMem
 xref    _LVOFreeMem
 xref    _LVODebug
 xref    _LVOFindTask
 xref    _LVOOpenDevice
 xref    _LVOCloseDevice
 xref    _LVODoIO
 xref    _LVOOpenLibrary
 xref    _LVOCloseLibrary
 xref    _LVOOutput
 xref    _LVOWrite

 include "include/exec.i"
 include "include/devices/keymap.i"

* Der Macro soll beim Aufbau einer Tabelle
* mit Steuerzeichen helfen. 
* Diese Tabelle enthält das Steuerzeichen,
* gefolgt von dem symbolischen Namen. 
* Das ganze wird mit Nullen auf
* eine Gesamtlänge von 6 Bytes gefüllt.
CONCODE MACRO
tx:     set   *
        dc.b  \1,'\2'
        dcb.b 6-(*-tx),0
        ENDM

* Einige Konstanten:
StrLen:       equ  32 ; max. Stringlänge pro Taste
LF:           equ  $A
CSI:          equ $9B
KeymapOffset: equ $98 ; Den Wert habe ich durch 
                      ; probieren gefunden.
                      ; er ist in keinem Include-File 
                      ; enthalten, funktioniert
                      ; aber mit Kickstart 1.2, bei 
                      ; eventuellen neueren Versionen
                      ; könnten hier Schwierigkeiten auftauchen.
   

* Die Variablen
 STRUCTURE DefKeyData,0
   LONG    DosBase
   LONG    Stdout
   LONG    UserKeys          Pointer auf F1-Tab
   BYTE    Flags     
Alpha:     equ 1             Flag: momentan wird ASCII-String 
                                   ausgegeben
CharOut:   equ 2             Flag: es wurden Zeichen ausgegeben
   BYTE    Flag2
   STRUCT  Buffer,4*StrLen   IO-Buffer
 LABEL     VarLen

*---------------------------------------------
*      Das Programm
*---------------------------------------------
* Register:
*           A6: AbsExecBase
*           A5: Variable
*           A3: Text

Defkey:
       move.l  A0,A3       rette Pointer auf CLI-Kommandozeile
       move.l  _AbsExecBase,A6
       move.l  A6,A4
* reserviere Speicher für einige Variable
       move.l  #MEMF_CLEAR,D1
       move.l   #VarLen,D0
       jsr     _LVOAllocMem(A6)
       tst.l   D0
       beq     Abort0
* initialisiere die benötigten Parameter
       move.l  D0,A5
       lea     DosName(PC),A1
       moveq   #0,D0
       jsr     _LVOOpenLibrary(A6)
       move.l  D0,DosBase(A5)
       beq     Abort1
       move.l  D0,A6
       jsr     _LVOOutput(A6)
       move.l  D0,Stdout(A5)
       beq     Abort2
       move.l  A4,A6
       bsr     GetKeymapBase
       bne.s   Abort3
* dekodiere jetzt die Kommandozeile
       bsr     Execute
Abort3:
       move.l  D0,-(SP)
       bra.s   t2 
Abort2:
       move.l  #22,-(SP)
t2:    move.l  _AbsExecBase,A6
       move.l  DosBase(A5),A1
       jsr     _LVOCloseLibrary(A6)
       bra.s   t1
Abort1:
       move.l  #21,-(SP)
t1:    move.l  A5,A1
       move.l  #VarLen,D0
       jsr     _LVOFreeMem(A6)
       move.l  (SP)+,D0
       bra.s   Exit
Abort0:
       moveq   #20,D0
Exit:  rts

* Suche Keymap-Pointer, und teste auf passende
* Keymap. Falls Fehler auftreten ist D0 
* ungleich 0.
GetKeymapBase:
       moveq   #-1,D0
       moveq   #0,D1
       lea     ConsoleName(PC),A0
       lea     Buffer(A5),A1
       jsr     _LVOOpenDevice(A6)
       tst.l   D0
       bne.s   1$
       move.l  Buffer+IO_DEVICE(A5),A1
       lea     KeymapOffset(A1),A1
       move.l  km_LoKeyMapTypes(A1),A1
       cmp.l   #'user',-8(A1)
       bne     2$
       move.l  -4(A1),UserKeys(A5)
       moveq   #0,D0
       bra.s   4$
1$:    lea     NoConsole(PC),A0
       bra.s   3$
2$:    lea     NoKeymap(PC),A0
3$:    bsr     String
       moveq   #24,D0
4$:    rts

* Dekodiere Funktion und führe sie aus
Execute:
1$:    cmp.b   #' ',(A3)+
       beq.s   1$
       subq.l  #1,A3
       bcs     ListKeys
       move.b  (A3)+,D0
       cmp.b   #'?',D0
       beq     Prompt
       and.b   #$5F,D0
       cmp.b   #'F',D0
       beq     Define
       cmp.b   #'H',D0
       bne     Syntax
       moveq   #2,D1
2$:    lsl.l   #8,D0
       move.b  (A3)+,D0
       and.b   #$5F,D0
       dbra    D1,2$
       cmp.l   #'HELP',D0
       bne     Syntax
       lea     DefKeyHelp(PC),A0
       bra     pm1
Syntax:
       lea     SynErr(PC),A0
       bsr     String
       moveq   #24,D0
       rts
Prompt:
       lea     DefKeyPrompt(PC),A0
pm1:   bsr     String
       moveq   #0,D0
       rts

* Neuer String für eine Funktionstaste
Define:
       bsr     WichKey      Lese Keynummer
       beq     2$
       bsr     GetPointer   Setze Pointer auf Datenfeld
       bne     2$
       bsr     GetString    Lade String in Buffer
       bne     1$
       bsr     CopyString   Kopiere String in Keymap
       moveq   #0,D0
       beq.s   1$
2$:    bsr     String
       moveq   #24,D0
1$:    rts

* Wandelt die Kommandozeilen-Parameter in eine
* Zeichenfolge um.
GetString:
       moveq   #0,D2
       lea     Buffer(A5),A1
Loop:  move.b  (A3)+,D0
       cmp.b   #' ',D0
       beq.s   Loop
       bcs     Done
       cmp.b   #$27,D0
       beq.s   ReadString
       cmp.b   #'"',D0
       beq.s   ReadString
       cmp.b   #'$',D0
       beq     ReadHex
       cmp.b   #'0',D0
       bcs     Syntax
       cmp.b   #'9',D0
       bls     ReadDec
       and.b   #$DF,D0
       lea     ControlTab(PC),A0
1$:    cmp.b   1(A0),D0
       bne.s   3$
       moveq   #1,D1
2$:    addq.w  #1,D1
       tst.b   0(A0,D1.W)
       beq.s   4$
       move.b  -2(A3,D1.W),D3
       and.b   #$DF,D3
       cmp.b   0(A0,D1.W),D3
       beq.s   2$
3$:    tst.b   (A0)
       beq     Syntax
       addq.l  #6,A0
       bra.s   1$
4$:    move.b  (A0),(A1)+
       addq.w  #1,D2
       lea     -2(A3,D1.W),A3
       bra     Delim
ReadString:
       move.b  D0,D3
1$:    move.b  (A3)+,D0
       cmp.b   D0,D3
       beq     Delim
       bsr     IsAlpha
       bcs     Syntax
       move.b  D0,(A1)+
       addq.w  #1,D2
       bra.s   1$
* teste auf Trennzeichen zwischen 
* String-Elementen
Delim: move.b  (A3)+,D0
       cmp.b   #',',D0
       beq     Loop
       cmp.b   #' ',D0
       beq     Loop
       bhi     Syntax
Done:  moveq   #0,D0
       rts
* liest eine Hex-Zahl
ReadHex:
       move.w  #$F000,D0
1$:    moveq   #0,D1
       move.b  (A3)+,D1
       bmi     Syntax
       cmp.b   #'a',D1
       bcs.s   2$
       and.b   #$5F,D1
2$:    sub.b   #'0',D1
       bcs     3$
       cmp.b   #9,D1
       bls.s   4$
       cmp.b   #16,D1
       bls     Syntax
       subq.b  #7,D1
4$:    cmp.b   #16,D1
       bcc     Syntax
       lsl.w   #4,D0
       add.b   D1,D0
       cmp.w   #255,D0
       bhi     Syntax
       bra.s   1$
3$:    tst.w   D0
       bmi     Syntax
       bra.s   ReadFin
* liest eine Dezimale Zahl
ReadDec:
       sub.b   #'0',D0
       ext.w   D0
       moveq   #0,D1
1$:    move.b  (A3)+,D1
       cmp.b   #'0',D1
       bcs.s   ReadFin
       cmp.b   #'9',D1
       bhi.s   ReadFin
       sub.b   #'0',D1
       mulu    #10,D0
       add.w   D1,D0
       cmp.w   #255,D0
       bhi     Syntax
       bra.s   1$
ReadFin:
       move.b  D0,(A1)+
       addq.w  #1,D2
       subq.l  #1,A3
       bra     Delim

* Kopiert den neuen String in die Keymap
CopyString:
       cmp.w   #StrLen,D2
       bls.s   1$
       lea     Truncated(PC),A0
       bsr     String
       moveq   #StrLen,D2
1$:    lea     Buffer(A5),A0
       move.b  D2,(A2)
       subq.w  #1,D2
       bmi.s   3$
2$:    move.b  (A0)+,(A4)+
       dbra    D2,2$
3$:    rts

* erzeugt eine Liste der aktuellen Tastenbelegung
ListKeys:
       moveq   #1,D0
1$:    bsr     ListKey      show key-data
       bne.s   2$
       addq.w  #1,D0
       cmp.w   #20,D0
       bls.s   1$
       moveq   #0,D0
2$:    rts

* Gibt die Belegung des Keys in D0 auf Stdout aus
ListKey:
       movem.l D0/D2/A2-A4,-(SP)
       bsr     GetPointer
       bne     1$
       clr.b   Flags(A5)
       lea     Buffer(A5),A3
       move.w  2(SP),D0
       lsl.w   #2,D0
       lea     KeyNames(PC),A0
       move.l  -4(A0,D0.W),(A3)+
       move.w  #'  ',(A3)+
       move.b  (A2),D2
       beq.s   2$
3$:    move.b  (A4)+,D0
       bsr     IsAlpha
       bcs.s   5$
       bset    #Alpha,Flags(A5)
       bne.s   4$
       bset    #CharOut,Flags(A5)
       beq.s   8$
       move.b  #',',(A3)+
       move.b  #-1,Flag2(A5)
8$:    move.b  #'"',(A3)+
4$:    move.b  D0,(A3)+
       subq.b  #1,D2
       bne.s   3$
       bra.s   6$
5$:    bclr    #Alpha,Flags(A5)
       beq.s   7$
       move.b  #'"',(A3)+
7$:    bset    #CharOut,Flags(A5)
       beq.s   9$
       move.b  #',',(A3)+
9$:    bsr     ListControl
       subq.b  #1,D2
       bne.s   3$
6$:    btst    #Alpha,Flags(A5)
       beq.s   2$
       move.b  #'"',(A3)+
2$:    move.b  #LF,(A3)+
       clr.b   (A3)
       lea     Buffer(A5),A0
       bsr     String
       moveq   #0,D0
1$:    movem.l (SP)+,D0/D2/A2-A4
       rts

* erzeugt für das Zeichen in D0 den entsprechenden
* symbolischen Namen oder, wenn unbekannt, 
* den entsprechenden Hex-Code
ListControl:
       lea     ControlTab(PC),A0
1$:    cmp.b   (A0)+,D0
       beq.s   2$
       tst.b   -1(A0)
       beq.s   3$
       addq.l  #5,A0
       bra.s   1$
2$:    move.b  (A0)+,(A3)+
       bne.s   2$
       subq.l  #1,A3
       bra.s   6$
3$:    cmp.b   #9,D0
       bls.s   9$
       move.b  #'$',(A3)+
9$:    move.b  D0,D1
       lsr.b   #4,D1
       beq.s   10$
       bsr.s   4$
10$:   move.b  D0,D1
4$:    and.b   #$F,D1
       add.b   #'0',D1
       cmp.b   #'9',D1
       bls.s   5$
       addq.b  #7,D1
5$:    move.b  D1,(A3)+
6$:    rts

* Erzeugt für einen Key in D0 (1-20) einen Pointer
* auf den zugehörigen Speicherplatz in der Keymap
* in A4 sowie auf den Descriptor in A2
GetPointer:
       subq.w  #1,D0
       cmp.w   #19,D0
       bhi     3$
       move.w  D0,D1
       cmp.w   #9,D1
       bls.s   1$
       sub.w   #10,D1
1$:    mulu    #4+2*StrLen,D1
       move.l  UserKeys(A5),A2
       lea     0(A2,D1.W),A2
       lea     4(A2),A4
       cmp.w   #9,D0
       bls.s   2$
       lea     StrLen(A4),A4
       addq.l  #2,A2
2$:    moveq   #0,D0
       rts
3$:    lea     WrongKey(PC),A0
       bsr     String
       moveq   #-1,D0
       rts

* ermittelt aus der Kommandozeile die
* gewünschte Funktionstaste in D0
* Bei Fehlern enthaelt D0 den Wert 0
WichKey:
       moveq   #0,D0
       move.b  (A3)+,D1
1$:    sub.b   #'0',D1
       bmi.s   3$
       cmp.b   #9,D1
       bhi     3$
       ext.w   D1
       mulu    #10,D0
       add.w   D1,D0
       cmp.w   #20,D0
       bhi     3$
2$:    move.b  (A3)+,D1
       cmp.b   #' ',D1
       cmp.b   #':',D1
       bne     1$
       tst.w   D0
       bne.s   4$
       rts
3$:    lea     WrongKey(PC),A0
       moveq   #0,D0
4$:    rts

* Sende String in (A0) an Stdout
String:
       movem.l D2/D3/A6,-(SP)
       move.l  DosBase(A5),A6
       move.l  Stdout(A5),D1
       move.l  A0,D2
       moveq   #-1,D3
1$:    addq.l  #1,D3
       tst.b   (A0)+
       bne.s   1$
       jsr     _LVOWrite(A6)
       movem.l (SP)+,D2/D3/A6
       rts

* Prüft, ob D0 ein Steuerzeichen ist
* wenn ja wird das Carry-Bit gesetzt
* D0 - Char
IsAlpha:
       move.b  D0,D1
       cmp.b   #$7F,D1
       beq.s   2$
       bls.s   1$
       and.b   #$7F,D1
1$:    cmp.b   #' ',D1
       rts
2$:    or.b    #1,ccr
       rts

*--------------------------------------------
*        Daten und Texte
*--------------------------------------------

ConsoleName: dc.b 'console.device',0
DosName:     dc.b 'dos.library',0

* Fehlermeldungen in Neu-Hochdeutsch
WrongKey:  dc.b 'DEFKEY: Unrecognizable Key',LF,0
SynErr:    dc.b 'DEFKEY: Syntax Error',LF,0
NoKeymap:  dc.b 'DEFKEY: No User-definable Keymap',LF,0
NoConsole: dc.b 'DEFKEY: No Access to console.device',LF,0
Truncated: dc.b 'DEFKEY: Input truncated',LF,0

DefKeyPrompt:
 dc.b LF,'  '
 dc.b CSI,'7m  DefKey 1.0 ( Hermann Kneissel 5.87) '
 dc.b CSI,'0m',LF
 dc.b LF,'  DEFKEY                listet aktuelle Belegung'
 dc.b LF,'  DEFKEY  Fxx:<String>  definiert die Funktionstaste'
 dc.b LF,'  DEFKEY  HELP          gibt Hilfstext aus'
 dc.b LF,0


DefKeyHelp:
 dc.b 'DEFKEY  Fxx:<String>',LF
 dc.b LF,'     xx : 1-10 für Funktionstaste,'
 dc.b LF,'          11-20 fuer Shift+Funktionstaste' 
 dc.b LF,' String : "<ASCII-Folge>"'
 dc.b LF,'           Zahlen, dezimal oder hex von 0-$FF'
 dc.b LF,'           Konstanten:' 
 dc.b LF,'           NUL,BS,TAB,CR,LF,NL,ESC,DEL,CSI '
 dc.b LF
 dc.b LF,'       Die maximale Länge des Strings ist'
 dc.b LF,'            auf 32 Byte begrenzt'
 dc.b LF,0
 
   cnop 0,2
KeyNames:
 dc.b ' F1: F2: F3: F4: F5: F6: F7: F8: F9:F10:'
 dc.b 'F11:F12:F13:F14:F15:F16:F17:F18:F19:F20:'

* Hier ist die Tabelle mit den Steuerzeichen und
* den zugehörigen symbolischen Namen. 
* Für eigene Erweiterungen
* sollte man beachten, daß der Name maximal 
* 4 Zeichen lang sein darf
* und die Tabelle mit dem Null-Code beendet wird.
ControlTab:
     CONCODE   8,BS
     CONCODE   9,TAB
     CONCODE  $D,CR
     CONCODE  $A,LF
     CONCODE  $A,NL
     CONCODE $1B,ESC
     CONCODE $7F,DEL
     CONCODE $9B,CSI
     CONCODE   0,NUL

     END of DEFKEY