home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 09 / ldm / makeckbd.prn < prev    next >
Encoding:
Text File  |  1989-06-15  |  16.1 KB  |  421 lines
  1.    1: (* ------------------------------------------------------ *)
  2.    2: (*                   MAKECKBD.PAS                         *)
  3.    3: (*        (c)  1989  Olaf Stoyke  &  TOOLBOX              *)
  4.    4: (* ------------------------------------------------------ *)
  5.    5: PROGRAM MakeCKBD;
  6.    6: 
  7.    7: USES Dos;
  8.    8: 
  9.    9: Const
  10.   10:   CRLF        = #13#10;
  11.   11:   NUL         = #0;
  12.   12:   QUOTE1      = '''';
  13.   13:   QUOTE2      = '"';
  14.   14:   BACKSLASH   = '\';
  15.   15:   SEMICOLON   = ';';
  16.   16:   BUFSIZE     = 2048;      { Für bessere I/O-Performance }
  17.   17:   CKBD1SIZE   = 166;       { Größe von CKBD1.BIN }
  18.   18:   CKBD2SIZE   = 378;       { Größe von CKBD2.BIN }
  19.   19:   INITOFSOFS  = 10;        { Offset von 'initofs' in CKBD1 }
  20.   20:      { MAXOFS gibt die maximale Größe des Textspeichers an }
  21.   21:   MAXOFS      = 65535 - CKBD2SIZE;
  22.   22:                                { Für Dez/Hex-Umwandlungen: }
  23.   23:   Digits      : Array[0..15] Of Char = '0123456789ABCDEF';
  24.   24: 
  25.   25: Type
  26.   26:   KeyList     = ^KeyString;
  27.   27:   KeyString   = RECORD
  28.   28:                        { Scancode und Offset werden in die
  29.   29:                        Scancodetabelle geschrieben }
  30.   30:                   ScanCode,
  31.   31:                   Offset    : WORD;
  32.   32:                        { Wird gesetzt, wenn ein Scancode
  33.   33:                          zum zweiten Mal gelesen wird }
  34.   34:                   DefTwice  : BOOLEAN;
  35.   35:                        { Der Text für die Taste: }
  36.   36:                   KeyText   : STRING[81];
  37.   37:                   Next      : KeyList;
  38.   38:                 END;
  39.   39: 
  40.   40: VAR
  41.   41:   Root        : KeyList;   { Liste aller Definitionen }
  42.   42:   KeyDefs     : WORD;      { Anzahl gültiger Definitionen }
  43.   43:   SourceName,              { Dateinamen ... }
  44.   44:   CKBDName    : DirStr;    { 'DirStr' kommt aus 'Dos' }
  45.   45:   IOBuffer    : ARRAY[0..BUFSIZE - 1] OF BYTE;
  46.   46: 
  47.   47:   PROCEDURE CKBD1; { Binärcode von CKBD1 }
  48.   48:   {$L CKBD1.OBJ }
  49.   49:   EXTERNAL;
  50.   50: 
  51.   51:   PROCEDURE CKBD2; { Binärcode von CKBD2 }
  52.   52:   {$L CKBD2.OBJ }
  53.   53:   EXTERNAL;
  54.   54: 
  55.   55:   PROCEDURE GetNames;
  56.   56: {  Es werden die Dateinamen erfragt, wobei gleichzeitig
  57.   57:     getestet wird, ob die Quelldatei existiert und ob der
  58.   58:     Anwender damit einverstanden ist, daß wenn die Datei
  59.   59:     schon existiert, CKBD.COM überschrieben wird.  }
  60.   60:   VAR
  61.   61:     Flag : BOOLEAN;
  62.   62:     F    : SearchRec;
  63.   63: 
  64.   64:     FUNCTION Yes : BOOLEAN;
  65.   65:   { Ja/Nein-Abfrage, Version in Neudeutsch. }
  66.   66:     VAR
  67.   67:       R : Registers;
  68.   68:     BEGIN
  69.   69:       WITH R DO BEGIN
  70.   70:         ah := 0;
  71.   71:         Intr($16, R);
  72.   72:         Yes := (al = 89) Or (al = 121);
  73.   73:       END; { With }
  74.   74:     END; { Yes }
  75.   75: 
  76.   76:   BEGIN
  77.   77:     REPEAT
  78.   78:       WriteLn('Enter source filename:');
  79.   79:       ReadLn(SourceName);
  80.   80:       FindFirst(SourceName, Archive, F);
  81.   81:     UNTIL DosError = 0;
  82.   82:     REPEAT
  83.   83:       WriteLn('Enter CKBD.COM path: ');
  84.   84:       ReadLn(CKBDName);
  85.   85:       If CKBDName[Length(CKBDName)] <> '\' THEN
  86.   86:         CKBDName := CKBDName + '\';
  87.   87:       CKBDName := CKBDName + 'CKBD.COM';
  88.   88:       FindFirst(CKBDName, Archive, F);
  89.   89:       If DosError = 0 THEN BEGIN
  90.   90:         WriteLn('Overwrite ', CKBDName, ' ? (Y/N)');
  91.   91:         Flag := Yes;
  92.   92:       END { If } ELSE
  93.   93:         Flag := True;
  94.   94:     UNTIL Flag;
  95.   95:     WriteLn;
  96.   96:   END; { GetNames }
  97.   97: 
  98.   98:   FUNCTION HexStr(W : WORD) : STRING;
  99.   99:   VAR
  100.  100:     I      : WORD;
  101.  101:     HS     : STRING[4];
  102.  102:   BEGIN
  103.  103:     I     := 1;
  104.  104:     HS[0] := #4;
  105.  105:     WHILE I < 5 DO BEGIN
  106.  106:       HS[5 - I] := Digits[W MOD 16];
  107.  107:       W := W SHR 4;
  108.  108:       Inc(I);
  109.  109:     END; { While }
  110.  110:     HexStr := HS;
  111.  111:   END; { HexStr }
  112.  112: 
  113.  113:   PROCEDURE ReadSource;
  114.  114: { Hyper-Prozedur mit Lesen der Quelldatei und Compi-
  115.  115:   lieren derselben. Weil Strings unter Turbo Pascal
  116.  116:   auf maximal 255 Zeichen Länge begrenzt sind, wird
  117.  117:   mittels 'WHILE NOT EoLn(Source) DO ...' die gesamte
  118.  118:   Zeile ein- bzw. überlesen ohne irgendwelche internen
  119.  119:   Grenzen zu überschreiten ... }
  120.  120:   CONST
  121.  121:     STRSIZE = 255;     { Maximale Stringlänge }
  122.  122:   VAR
  123.  123:     Source  : TEXT;    { Quelldatei }
  124.  124:     Buffer  : STRING;  { Übertragungspuffer }
  125.  125:     LC,                { Zeilenzähler }
  126.  126:     Index   : WORD;    { Index für den 'Buffer' }
  127.  127:     C       : CHAR;    { Für Datei-I/O }
  128.  128: 
  129.  129:     PROCEDURE Compile(VAR Line : STRING);
  130.  130:   { Die übergebene Zeile wird compiliert, das heißt
  131.  131:     es wird versucht, sie zu "verstehen".  }
  132.  132:     VAR
  133.  133:       Buffer : STRING;  { Der String kommt hier hin }
  134.  134:       I, J,             { Quell- / Pufferindex }
  135.  135:       V, SC  : WORD;    { V: Dummy, SC: Scancode }
  136.  136:       S, Ch  : CHAR;
  137.  137: 
  138.  138:       PROCEDURE ListInsert(SCode : WORD; TData : STRING);
  139.  139:     { Einfügen einer neuen Tastendefinition, bestehend
  140.  140:       aus Scancode 'SCode' und Text 'TData', in die
  141.  141:       Liste. Wenn 'SCode' schon in der Liste anzutref-
  142.  142:       fen ist, wird der alte Eintrag als Doppeldefini-
  143.  143:       tion vermerkt und die neue Definition ignoriert. }
  144.  144:       VAR
  145.  145:         HelpPtr : KeyList;
  146.  146:       BEGIN
  147.  147:         HelpPtr := Root;
  148.  148:         WHILE (HelpPtr <> Nil) AND
  149.  149:               (HelpPtr^.Scancode <> SCode) DO
  150.  150:           HelpPtr := HelpPtr^.Next;
  151.  151:         IF HelpPtr = Nil THEN BEGIN
  152.  152:           New(HelpPtr);
  153.  153:           WITH HelpPtr^ DO BEGIN
  154.  154:             Next := Root;
  155.  155:             Scancode := SCode;
  156.  156:             KeyText := TData;
  157.  157:             DefTwice := FALSE;
  158.  158:             { Mit der nächsten Zuweisung wird das Offset
  159.  159:               auf einen Wert gesetzt der sich aus der
  160.  160:               Länge des PSP und der Größe von CKBD1.BIN
  161.  161:               ergibt und sich auf die ausführbare Datei
  162.  162:               CKBD.COM bezieht: }
  163.  163:             Offset := 256 + CKBD1SIZE;
  164.  164:           END; { With }
  165.  165:           Root := HelpPtr;
  166.  166:           Inc(KeyDefs);
  167.  167:         END { If } ELSE
  168.  168:           HelpPtr^.DefTwice := TRUE;
  169.  169:       END; { ListInsert }
  170.  170: 
  171.  171:       FUNCTION CharsLeft : BOOLEAN;
  172.  172:       {  Sucht von der aktuellen Position innerhalb
  173.  173:          der Zeile an ein Zeichen, daß kein Blank oder
  174.  174:          Steuerzeichen ist und gibt 'True' aus, wenn
  175.  175:          ein solches Zeichen existiert.  }
  176.  176:       BEGIN
  177.  177:         WHILE (I <= Length(Line)) AND (Line[I] < '!') DO
  178.  178:           Inc(I);
  179.  179:         CharsLeft := I <= Length(Line);
  180.  180:       END; { CharsLeft }
  181.  181: 
  182.  182:       PROCEDURE Message(LC, PC : WORD; Msg : STRING);
  183.  183:       BEGIN
  184.  184:         WriteLn('Error at line ',
  185.  185:                              LC, ', pos ', PC, ': ', Msg);
  186.  186:       END; { Message }
  187.  187: 
  188.  188:     BEGIN
  189.  189:       I := 1;
  190.  190:       IF NOT CharsLeft THEN Exit;
  191.  191:       IF Line[I] <> SEMICOLON THEN BEGIN
  192.  192:         SC := 0;
  193.  193:         FOR J := 0 TO 3 DO BEGIN
  194.  194:           V := Pos(UpCase(Line[I + J]), Digits);
  195.  195:           IF V = 0 THEN BEGIN
  196.  196:             Message(LC, I + J, 'Error in base 16 const.');
  197.  197:             Exit;
  198.  198:           END; { If }
  199.  199:           SC := V - 1 + SC SHL 4;
  200.  200:         END; { For }
  201.  201:         I := I + J + 1;
  202.  202:         IF NOT CharsLeft THEN
  203.  203:           Message(LC, I, 'Unexpected end of line.')
  204.  204:         ELSE BEGIN
  205.  205:           S := Line[I];
  206.  206:           IF (S = QUOTE1) OR (S = QUOTE2) THEN BEGIN
  207.  207:             J := 1; { Für 1. Zeichen im Puffer }
  208.  208:             Inc(I);
  209.  209:             WHILE (I <= Length(Line)) AND
  210.  210:                   (Line[I] <> S) DO BEGIN
  211.  211:               Ch := Line[I];
  212.  212:               { Falls \, Rest analysieren. Zahlen-
  213.  213:                 konstante als ASCII-Wert interpretie-
  214.  214:                 ren, sonst normales Zeichen ... }
  215.  215:               IF Ch = BACKSLASH THEN BEGIN
  216.  216:                 Inc(I);
  217.  217:                 IF ('/' < Line[I]) AND
  218.  218:                    (Line[I] < ':') THEN BEGIN
  219.  219:                   V := 0; { Puffer für ASCII-Code }
  220.  220:                   REPEAT
  221.  221:                     V := V * 10 + Ord(Line[I]) - 48;
  222.  222:                     Inc(I);
  223.  223:                   UNTIL (Line[I] < '0') Or ('9' < Line[I]);
  224.  224:                   { Da unten steht ein Inc(I), also kommt
  225.  225:                     hier ein Dec(I) hin ... }
  226.  226:                   Dec(I);
  227.  227:                   If V > 255 THEN BEGIN
  228.  228:                     Message(LC, I, 'Invalid ascii const.');
  229.  229:                     Exit;
  230.  230:                   END { If } ELSE
  231.  231:                     Ch := Chr(V);
  232.  232:                 END { If } ELSE
  233.  233:                   Ch := Line[I];
  234.  234:               END; { If }
  235.  235:               IF Ch = NUL THEN BEGIN
  236.  236:                 Message(LC, I, 'Invalid NUL in string.');
  237.  237:                 Exit;
  238.  238:               END ELSE
  239.  239:                 Buffer[J] := Ch;
  240.  240:               Inc(I); { Nächstes Zeichen Quellzeile }
  241.  241:               Inc(J); { Nächstes Zeichen Zielpuffer }
  242.  242:             END; { While }
  243.  243:             { J ist Anzahl gelesener Zeichen plus 1 }
  244.  244:             Buffer[J] := NUL;
  245.  245:             Buffer[0] := Chr(J);
  246.  246:             IF I > Length(Line) THEN BEGIN
  247.  247:               Message(LC, I, 'Unexpected end of line.');
  248.  248:               Exit;
  249.  249:             END; { If }
  250.  250:             IF J = 1 THEN BEGIN
  251.  251:               Message(LC, J, 'Invalid string.');
  252.  252:               Exit;
  253.  253:             END; { If }
  254.  254:             Inc(I);
  255.  255:             IF CharsLeft THEN
  256.  256:               Message(LC, I, 'Extra chars on line.')
  257.  257:             ELSE
  258.  258:               ListInsert(SC, Buffer);
  259.  259:           END { If } ELSE
  260.  260:             Message(LC, I, '" or '' expected.');
  261.  261:         END; { Else }
  262.  262:       END; { If }
  263.  263:     END; { Compile }
  264.  264: 
  265.  265:     PROCEDURE TestDefTwice;
  266.  266:   { Durchsucht die Liste der Tastendfinitionen und
  267.  267:     meldet sich, wenn eine Definition mit dem ge-
  268.  268:     setzten Flag für eine Doppeldefinition gefunden
  269.  269:     wurde. }
  270.  270:     VAR
  271.  271:       Walker : KeyList;
  272.  272:     BEGIN
  273.  273:       Walker := Root;
  274.  274:       IF Walker = Nil THEN
  275.  275:         WriteLn('No lines compiled.')
  276.  276:       ELSE
  277.  277:         REPEAT
  278.  278:           WITH Walker^ DO BEGIN
  279.  279:             IF DefTwice THEN
  280.  280:               WriteLn(HexStr(Scancode), ' read twice.');
  281.  281:             Walker := Next;
  282.  282:           END; { With }
  283.  283:         UNTIL Walker = Nil;
  284.  284:     END; { TestDefTwice }
  285.  285: 
  286.  286:   BEGIN
  287.  287:     {$I-}
  288.  288:     Assign(Source, SourceName);
  289.  289:     Reset(Source);
  290.  290:     {$I+}
  291.  291:     IF IOResult <> 0 THEN BEGIN
  292.  292:       WriteLn(CRLF, 'Cannot open ', SourceName, '.');
  293.  293:       Halt(1);
  294.  294:     END { If } ELSE
  295.  295:       SetTextBuf(Source, IOBuffer, BUFSIZE);
  296.  296:     LC := 1;
  297.  297:     WriteLn('Reading . . .');
  298.  298:     WHILE NOT EoF(Source) DO BEGIN
  299.  299:       Index := 1;
  300.  300:       WHILE NOT EoLn(Source) DO BEGIN { Bis zum Zeilen- }
  301.  301:         Read(Source, C);              { ende Zeichen }
  302.  302:         IF Index <= STRSIZE THEN      { einlesen ... }
  303.  303:           Buffer[Index] := C;
  304.  304:         Inc(Index);
  305.  305:       END; { While }
  306.  306:       { 'Read(Source, C, C)' überliest das EoLn-Merkmal,
  307.  307:         in der Regel ein CR und ein LF. (oder LF/CR ?) }
  308.  308:       Read(Source, C, C);
  309.  309:       IF Index > 1 THEN BEGIN
  310.  310:         Buffer[0] := Chr(Index - 1); { Länge setzen }
  311.  311:         Compile(Buffer);
  312.  312:       END; { If }
  313.  313:       Inc(LC);
  314.  314:     END; { While }
  315.  315:     Close(Source);
  316.  316:     TestDefTwice;
  317.  317:   END; { ReadSource }
  318.  318: 
  319.  319:   PROCEDURE MakeCode;
  320.  320: { 'MakeCode' generiert das ready-to-run CKBD.COM
  321.  321:    mittels der Tastendefinitionen in der Liste. }
  322.  322:   CONST
  323.  323:     { 'TabEnd' wird ans Ende der Scancodetabelle ange-
  324.  324:       hängt, um CKBD mitzuteilen, wo die Tabelle endet. }
  325.  325:     TabEnd    : LongInt = $FFFFFFFF;
  326.  326:   VAR
  327.  327:     Walker    : KeyList;
  328.  328:     CKBD      : File; { Zieldatei }
  329.  329:     TDLength  : Word; { Offset der Textdaten }
  330.  330: 
  331.  331:     PROCEDURE GenOffsets;
  332.  332:     BEGIN
  333.  333:       WriteLn(KeyDefs, ' line(s) compiled.');
  334.  334:       TDLength := 4 + KeyDefs * 4;
  335.  335:       Walker := Root;
  336.  336:       WHILE Walker <> Nil DO
  337.  337:         WITH Walker^ DO BEGIN
  338.  338:           { siehe auch 'ListInsert' ... }
  339.  339:           Inc(Offset, TDLength);
  340.  340:           Inc(TDLength, Length(KeyText));
  341.  341:           IF TDLength > MAXOFS THEN BEGIN
  342.  342:             { Kein Platz mehr für CKBD2 }
  343.  343:             WriteLn('Not enough memory for text data.');
  344.  344:             Halt(1);
  345.  345:           END; { If }
  346.  346:           Walker := Next;
  347.  347:         END; { With }
  348.  348:       WriteLn(HexStr(TDLength), ' bytes text data.');
  349.  349:       WriteLn;
  350.  350:     END; { GenOffsets }
  351.  351: 
  352.  352:     PROCEDURE GenCode(VAR C; CodeL : WORD);
  353.  353:     { Generelle Ausgabeprozedur mit zentraler Fehler-
  354.  354:       behandlung. }
  355.  355:       VAR
  356.  356:         Result : WORD;
  357.  357:       BEGIN
  358.  358:         BlockWrite(CKBD, C, CodeL, Result);
  359.  359:         IF Result < CodeL THEN BEGIN
  360.  360:           WriteLn(CRLF, CKBDName, ': Write error.');
  361.  361:           Halt(1);
  362.  362:         END; { If }
  363.  363:       END; { GenCode }
  364.  364: 
  365.  365:   BEGIN
  366.  366:     {$I-}
  367.  367:     Assign(CKBD, CKBDName);
  368.  368:     Rewrite(CKBD, 1);
  369.  369:     {$I+}
  370.  370:     IF IOResult > 0 THEN BEGIN
  371.  371:       WriteLn(CRLF, 'Cannot open ', CKBDName, '.');
  372.  372:       Halt(1);
  373.  373:     END; { If }
  374.  374:     GenOffsets;
  375.  375:     WriteLn('Writing . . .');
  376.  376:     { Die folgende, kryptische Zuweisung setzt die Varia-
  377.  377:       ble 'initofs' in CKBD1.BIN auf das Startoffset der
  378.  378:       Initialisierungsroutine in CKBD2.BIN. Dieser be-
  379.  379:       rechnet sich aus Länge des PSP (256) plus Länge von
  380.  380:       CKBD1.BIN plus Länge der Textdaten ... }
  381.  381:     MemW[Seg(CKBD1):Ofs(CKBD1) + INITOFSOFS] :=
  382.  382:                                256 + CKBD1SIZE + TDLength;
  383.  383:     GenCode(Addr(CKBD1)^, CKBD1SIZE);
  384.  384:     Walker := Root;
  385.  385:     WHILE Walker <> Nil DO
  386.  386:       WITH Walker^ DO BEGIN   { Schreibe Scancodetabelle }
  387.  387:         GenCode(ScanCode, 2); { 1) Den Scancode selbst }
  388.  388:         GenCode(Offset, 2);   { 2) Das Offset dazu }
  389.  389:         Walker := Next;
  390.  390:       END; { With }
  391.  391:     GenCode(TabEnd, 4); { Anhängen des Ende-Merkmals }
  392.  392:     Walker := Root;
  393.  393:     WHILE Walker <> Nil DO
  394.  394:       WITH Walker^ DO BEGIN    { Ausgabe des Texts: }
  395.  395:         GenCode(KeyText[1], Length(KeyText));
  396.  396:         Walker := Next;
  397.  397:       END; { With }
  398.  398:     GenCode(Addr(CKBD2)^, CKBD2SIZE);
  399.  399:     Close(CKBD);
  400.  400:     WriteLn(HexStr(CKBD1SIZE + CKBD2SIZE + TDLength),
  401.  401:                                        ' bytes written.');
  402.  402:     WriteLn;
  403.  403:   END; { MakeCode }
  404.  404: 
  405.  405: BEGIN
  406.  406:   WriteLn(CRLF, 'MAKECKBD Version 1.30', CRLF,
  407.  407:           'Copyright (c) 1989 by Olaf Stoyke & TOOLBOX',
  408.  408:           CRLF);
  409.  409:   KeyDefs := 0;   { Noch keine gültigen Zeilen gelesen }
  410.  410:   Root := Nil;    { ... deshalb auch eine leere Liste }
  411.  411:   GetNames;       { Dateinamen einlesen und testen }
  412.  412:   ReadSource;     { Quelle lesen und compilieren }
  413.  413:   IF Root <> Nil THEN { Wenn gültige Zeilen existieren }
  414.  414:     MakeCode      { Zieldatei ausgeben: CKBD.COM }
  415.  415:   ELSE
  416.  416:     WriteLn;
  417.  417:   WriteLn('Done.'); { Stimmt ! }
  418.  418: END.
  419.  419: (* ------------------------------------------------------ *)
  420.  420: (*                Ende von MAKECKBD.PAS                   *)
  421.