Turbo Toolbox/Turbo_Toolbox.iso/1989/09/ldm/makeckbd.pas

Pascal/Delphi Source File | 1989-06-15 | 13.6 KB | 421 lines

(* ------------------------------------------------------ *)
(*                   MAKECKBD.PAS                         *)
(*        (c)  1989  Olaf Stoyke  &  TOOLBOX              *)
(* ------------------------------------------------------ *)
PROGRAM MakeCKBD;

USES Dos;

Const
  CRLF        = #13#10;
  NUL         = #0;
  QUOTE1      = '''';
  QUOTE2      = '"';
  BACKSLASH   = '\';
  SEMICOLON   = ';';
  BUFSIZE     = 2048;      { Für bessere I/O-Performance }
  CKBD1SIZE   = 166;       { Größe von CKBD1.BIN }
  CKBD2SIZE   = 378;       { Größe von CKBD2.BIN }
  INITOFSOFS  = 10;        { Offset von 'initofs' in CKBD1 }
     { MAXOFS gibt die maximale Größe des Textspeichers an }
  MAXOFS      = 65535 - CKBD2SIZE;
                               { Für Dez/Hex-Umwandlungen: }
  Digits      : Array[0..15] Of Char = '0123456789ABCDEF';

Type
  KeyList     = ^KeyString;
  KeyString   = RECORD
                       { Scancode und Offset werden in die
                       Scancodetabelle geschrieben }
                  ScanCode,
                  Offset    : WORD;
                       { Wird gesetzt, wenn ein Scancode
                         zum zweiten Mal gelesen wird }
                  DefTwice  : BOOLEAN;
                       { Der Text für die Taste: }
                  KeyText   : STRING[81];
                  Next      : KeyList;
                END;

VAR
  Root        : KeyList;   { Liste aller Definitionen }
  KeyDefs     : WORD;      { Anzahl gültiger Definitionen }
  SourceName,              { Dateinamen ... }
  CKBDName    : DirStr;    { 'DirStr' kommt aus 'Dos' }
  IOBuffer    : ARRAY[0..BUFSIZE - 1] OF BYTE;

  PROCEDURE CKBD1; { Binärcode von CKBD1 }
  {$L CKBD1.OBJ }
  EXTERNAL;

  PROCEDURE CKBD2; { Binärcode von CKBD2 }
  {$L CKBD2.OBJ }
  EXTERNAL;

  PROCEDURE GetNames;
{  Es werden die Dateinamen erfragt, wobei gleichzeitig
    getestet wird, ob die Quelldatei existiert und ob der
    Anwender damit einverstanden ist, daß wenn die Datei
    schon existiert, CKBD.COM überschrieben wird.  }
  VAR
    Flag : BOOLEAN;
    F    : SearchRec;

    FUNCTION Yes : BOOLEAN;
  { Ja/Nein-Abfrage, Version in Neudeutsch. }
    VAR
      R : Registers;
    BEGIN
      WITH R DO BEGIN
        ah := 0;
        Intr($16, R);
        Yes := (al = 89) Or (al = 121);
      END; { With }
    END; { Yes }

  BEGIN
    REPEAT
      WriteLn('Enter source filename:');
      ReadLn(SourceName);
      FindFirst(SourceName, Archive, F);
    UNTIL DosError = 0;
    REPEAT
      WriteLn('Enter CKBD.COM path: ');
      ReadLn(CKBDName);
      If CKBDName[Length(CKBDName)] <> '\' THEN
        CKBDName := CKBDName + '\';
      CKBDName := CKBDName + 'CKBD.COM';
      FindFirst(CKBDName, Archive, F);
      If DosError = 0 THEN BEGIN
        WriteLn('Overwrite ', CKBDName, ' ? (Y/N)');
        Flag := Yes;
      END { If } ELSE
        Flag := True;
    UNTIL Flag;
    WriteLn;
  END; { GetNames }

  FUNCTION HexStr(W : WORD) : STRING;
  VAR
    I      : WORD;
    HS     : STRING[4];
  BEGIN
    I     := 1;
    HS[0] := #4;
    WHILE I < 5 DO BEGIN
      HS[5 - I] := Digits[W MOD 16];
      W := W SHR 4;
      Inc(I);
    END; { While }
    HexStr := HS;
  END; { HexStr }

  PROCEDURE ReadSource;
{ Hyper-Prozedur mit Lesen der Quelldatei und Compi-
  lieren derselben. Weil Strings unter Turbo Pascal
  auf maximal 255 Zeichen Länge begrenzt sind, wird
  mittels 'WHILE NOT EoLn(Source) DO ...' die gesamte
  Zeile ein- bzw. überlesen ohne irgendwelche internen
  Grenzen zu überschreiten ... }
  CONST
    STRSIZE = 255;     { Maximale Stringlänge }
  VAR
    Source  : TEXT;    { Quelldatei }
    Buffer  : STRING;  { Übertragungspuffer }
    LC,                { Zeilenzähler }
    Index   : WORD;    { Index für den 'Buffer' }
    C       : CHAR;    { Für Datei-I/O }

    PROCEDURE Compile(VAR Line : STRING);
  { Die übergebene Zeile wird compiliert, das heißt
    es wird versucht, sie zu "verstehen".  }
    VAR
      Buffer : STRING;  { Der String kommt hier hin }
      I, J,             { Quell- / Pufferindex }
      V, SC  : WORD;    { V: Dummy, SC: Scancode }
      S, Ch  : CHAR;

      PROCEDURE ListInsert(SCode : WORD; TData : STRING);
    { Einfügen einer neuen Tastendefinition, bestehend
      aus Scancode 'SCode' und Text 'TData', in die
      Liste. Wenn 'SCode' schon in der Liste anzutref-
      fen ist, wird der alte Eintrag als Doppeldefini-
      tion vermerkt und die neue Definition ignoriert. }
      VAR
        HelpPtr : KeyList;
      BEGIN
        HelpPtr := Root;
        WHILE (HelpPtr <> Nil) AND
              (HelpPtr^.Scancode <> SCode) DO
          HelpPtr := HelpPtr^.Next;
        IF HelpPtr = Nil THEN BEGIN
          New(HelpPtr);
          WITH HelpPtr^ DO BEGIN
            Next := Root;
            Scancode := SCode;
            KeyText := TData;
            DefTwice := FALSE;
            { Mit der nächsten Zuweisung wird das Offset
              auf einen Wert gesetzt der sich aus der
              Länge des PSP und der Größe von CKBD1.BIN
              ergibt und sich auf die ausführbare Datei
              CKBD.COM bezieht: }
            Offset := 256 + CKBD1SIZE;
          END; { With }
          Root := HelpPtr;
          Inc(KeyDefs);
        END { If } ELSE
          HelpPtr^.DefTwice := TRUE;
      END; { ListInsert }

      FUNCTION CharsLeft : BOOLEAN;
      {  Sucht von der aktuellen Position innerhalb
         der Zeile an ein Zeichen, daß kein Blank oder
         Steuerzeichen ist und gibt 'True' aus, wenn
         ein solches Zeichen existiert.  }
      BEGIN
        WHILE (I <= Length(Line)) AND (Line[I] < '!') DO
          Inc(I);
        CharsLeft := I <= Length(Line);
      END; { CharsLeft }

      PROCEDURE Message(LC, PC : WORD; Msg : STRING);
      BEGIN
        WriteLn('Error at line ',
                             LC, ', pos ', PC, ': ', Msg);
      END; { Message }

    BEGIN
      I := 1;
      IF NOT CharsLeft THEN Exit;
      IF Line[I] <> SEMICOLON THEN BEGIN
        SC := 0;
        FOR J := 0 TO 3 DO BEGIN
          V := Pos(UpCase(Line[I + J]), Digits);
          IF V = 0 THEN BEGIN
            Message(LC, I + J, 'Error in base 16 const.');
            Exit;
          END; { If }
          SC := V - 1 + SC SHL 4;
        END; { For }
        I := I + J + 1;
        IF NOT CharsLeft THEN
          Message(LC, I, 'Unexpected end of line.')
        ELSE BEGIN
          S := Line[I];
          IF (S = QUOTE1) OR (S = QUOTE2) THEN BEGIN
            J := 1; { Für 1. Zeichen im Puffer }
            Inc(I);
            WHILE (I <= Length(Line)) AND
                  (Line[I] <> S) DO BEGIN
              Ch := Line[I];
              { Falls \, Rest analysieren. Zahlen-
                konstante als ASCII-Wert interpretie-
                ren, sonst normales Zeichen ... }
              IF Ch = BACKSLASH THEN BEGIN
                Inc(I);
                IF ('/' < Line[I]) AND
                   (Line[I] < ':') THEN BEGIN
                  V := 0; { Puffer für ASCII-Code }
                  REPEAT
                    V := V * 10 + Ord(Line[I]) - 48;
                    Inc(I);
                  UNTIL (Line[I] < '0') Or ('9' < Line[I]);
                  { Da unten steht ein Inc(I), also kommt
                    hier ein Dec(I) hin ... }
                  Dec(I);
                  If V > 255 THEN BEGIN
                    Message(LC, I, 'Invalid ascii const.');
                    Exit;
                  END { If } ELSE
                    Ch := Chr(V);
                END { If } ELSE
                  Ch := Line[I];
              END; { If }
              IF Ch = NUL THEN BEGIN
                Message(LC, I, 'Invalid NUL in string.');
                Exit;
              END ELSE
                Buffer[J] := Ch;
              Inc(I); { Nächstes Zeichen Quellzeile }
              Inc(J); { Nächstes Zeichen Zielpuffer }
            END; { While }
            { J ist Anzahl gelesener Zeichen plus 1 }
            Buffer[J] := NUL;
            Buffer[0] := Chr(J);
            IF I > Length(Line) THEN BEGIN
              Message(LC, I, 'Unexpected end of line.');
              Exit;
            END; { If }
            IF J = 1 THEN BEGIN
              Message(LC, J, 'Invalid string.');
              Exit;
            END; { If }
            Inc(I);
            IF CharsLeft THEN
              Message(LC, I, 'Extra chars on line.')
            ELSE
              ListInsert(SC, Buffer);
          END { If } ELSE
            Message(LC, I, '" or '' expected.');
        END; { Else }
      END; { If }
    END; { Compile }

    PROCEDURE TestDefTwice;
  { Durchsucht die Liste der Tastendfinitionen und
    meldet sich, wenn eine Definition mit dem ge-
    setzten Flag für eine Doppeldefinition gefunden
    wurde. }
    VAR
      Walker : KeyList;
    BEGIN
      Walker := Root;
      IF Walker = Nil THEN
        WriteLn('No lines compiled.')
      ELSE
        REPEAT
          WITH Walker^ DO BEGIN
            IF DefTwice THEN
              WriteLn(HexStr(Scancode), ' read twice.');
            Walker := Next;
          END; { With }
        UNTIL Walker = Nil;
    END; { TestDefTwice }

  BEGIN
    {$I-}
    Assign(Source, SourceName);
    Reset(Source);
    {$I+}
    IF IOResult <> 0 THEN BEGIN
      WriteLn(CRLF, 'Cannot open ', SourceName, '.');
      Halt(1);
    END { If } ELSE
      SetTextBuf(Source, IOBuffer, BUFSIZE);
    LC := 1;
    WriteLn('Reading . . .');
    WHILE NOT EoF(Source) DO BEGIN
      Index := 1;
      WHILE NOT EoLn(Source) DO BEGIN { Bis zum Zeilen- }
        Read(Source, C);              { ende Zeichen }
        IF Index <= STRSIZE THEN      { einlesen ... }
          Buffer[Index] := C;
        Inc(Index);
      END; { While }
      { 'Read(Source, C, C)' überliest das EoLn-Merkmal,
        in der Regel ein CR und ein LF. (oder LF/CR ?) }
      Read(Source, C, C);
      IF Index > 1 THEN BEGIN
        Buffer[0] := Chr(Index - 1); { Länge setzen }
        Compile(Buffer);
      END; { If }
      Inc(LC);
    END; { While }
    Close(Source);
    TestDefTwice;
  END; { ReadSource }

  PROCEDURE MakeCode;
{ 'MakeCode' generiert das ready-to-run CKBD.COM
   mittels der Tastendefinitionen in der Liste. }
  CONST
    { 'TabEnd' wird ans Ende der Scancodetabelle ange-
      hängt, um CKBD mitzuteilen, wo die Tabelle endet. }
    TabEnd    : LongInt = $FFFFFFFF;
  VAR
    Walker    : KeyList;
    CKBD      : File; { Zieldatei }
    TDLength  : Word; { Offset der Textdaten }

    PROCEDURE GenOffsets;
    BEGIN
      WriteLn(KeyDefs, ' line(s) compiled.');
      TDLength := 4 + KeyDefs * 4;
      Walker := Root;
      WHILE Walker <> Nil DO
        WITH Walker^ DO BEGIN
          { siehe auch 'ListInsert' ... }
          Inc(Offset, TDLength);
          Inc(TDLength, Length(KeyText));
          IF TDLength > MAXOFS THEN BEGIN
            { Kein Platz mehr für CKBD2 }
            WriteLn('Not enough memory for text data.');
            Halt(1);
          END; { If }
          Walker := Next;
        END; { With }
      WriteLn(HexStr(TDLength), ' bytes text data.');
      WriteLn;
    END; { GenOffsets }

    PROCEDURE GenCode(VAR C; CodeL : WORD);
    { Generelle Ausgabeprozedur mit zentraler Fehler-
      behandlung. }
      VAR
        Result : WORD;
      BEGIN
        BlockWrite(CKBD, C, CodeL, Result);
        IF Result < CodeL THEN BEGIN
          WriteLn(CRLF, CKBDName, ': Write error.');
          Halt(1);
        END; { If }
      END; { GenCode }

  BEGIN
    {$I-}
    Assign(CKBD, CKBDName);
    Rewrite(CKBD, 1);
    {$I+}
    IF IOResult > 0 THEN BEGIN
      WriteLn(CRLF, 'Cannot open ', CKBDName, '.');
      Halt(1);
    END; { If }
    GenOffsets;
    WriteLn('Writing . . .');
    { Die folgende, kryptische Zuweisung setzt die Varia-
      ble 'initofs' in CKBD1.BIN auf das Startoffset der
      Initialisierungsroutine in CKBD2.BIN. Dieser be-
      rechnet sich aus Länge des PSP (256) plus Länge von
      CKBD1.BIN plus Länge der Textdaten ... }
    MemW[Seg(CKBD1):Ofs(CKBD1) + INITOFSOFS] :=
                               256 + CKBD1SIZE + TDLength;
    GenCode(Addr(CKBD1)^, CKBD1SIZE);
    Walker := Root;
    WHILE Walker <> Nil DO
      WITH Walker^ DO BEGIN   { Schreibe Scancodetabelle }
        GenCode(ScanCode, 2); { 1) Den Scancode selbst }
        GenCode(Offset, 2);   { 2) Das Offset dazu }
        Walker := Next;
      END; { With }
    GenCode(TabEnd, 4); { Anhängen des Ende-Merkmals }
    Walker := Root;
    WHILE Walker <> Nil DO
      WITH Walker^ DO BEGIN    { Ausgabe des Texts: }
        GenCode(KeyText[1], Length(KeyText));
        Walker := Next;
      END; { With }
    GenCode(Addr(CKBD2)^, CKBD2SIZE);
    Close(CKBD);
    WriteLn(HexStr(CKBD1SIZE + CKBD2SIZE + TDLength),
                                       ' bytes written.');
    WriteLn;
  END; { MakeCode }

BEGIN
  WriteLn(CRLF, 'MAKECKBD Version 1.30', CRLF,
          'Copyright (c) 1989 by Olaf Stoyke & TOOLBOX',
          CRLF);
  KeyDefs := 0;   { Noch keine gültigen Zeilen gelesen }
  Root := Nil;    { ... deshalb auch eine leere Liste }
  GetNames;       { Dateinamen einlesen und testen }
  ReadSource;     { Quelle lesen und compilieren }
  IF Root <> Nil THEN { Wenn gültige Zeilen existieren }
    MakeCode      { Zieldatei ausgeben: CKBD.COM }
  ELSE
    WriteLn;
  WriteLn('Done.'); { Stimmt ! }
END.
(* ------------------------------------------------------ *)
(*                Ende von MAKECKBD.PAS                   *)