home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 05 / dfkernel.inc < prev    next >
Encoding:
Text File  |  1987-04-15  |  3.7 KB  |  158 lines
  1. (*-----------------------------------------------------------------------*)
  2. (*                       DFKERNEL.INC                                    *)
  3. (*            Dieser Kernteil des Programms enthaelt                     *)
  4. (*              rechnerunabhaengige Basisroutinen.                       *)
  5.  
  6. (* die Prozedur gib_Zeichen_aus bringt ein Zeichen auf den Bildschirm. *)
  7.  
  8. PROCEDURE gib_Zeichen_aus(Zeichen: CHAR);
  9.  
  10. BEGIN
  11.   IF Zeichen IN [CR,LF,BELL,' '..'{'] THEN
  12.     Write(Zeichen);
  13.   IF (Zeichen = CR) AND LineFeed THEN
  14.     Write(LF)
  15. END;
  16.  
  17.  
  18. (* Procedure sende_Zeichen wartet bis die Schnittstelle frei ist und sendet *)
  19. (* dann ein Zeichen.                                                        *)
  20.  
  21. PROCEDURE sende_Zeichen(Zeichen : CHAR);
  22.  
  23. BEGIN
  24.   REPEAT UNTIL OutStatus;
  25.   OutSIO(Zeichen)
  26. END;
  27.  
  28.  
  29.  
  30. (* Prozedur Warte_auf_XON wartet auf Senderlaubnis,wenn die Gegenstation
  31.    das Senden abgebrochen hat.                                             *)
  32.  
  33. PROCEDURE warte_auf_XON;
  34.  
  35. VAR Zeichen : CHAR;
  36.  
  37. BEGIN
  38.   Write(INV_EIN,'XOFF',INV_AUS);
  39.   REPEAT
  40.     Zeichen := InpSIO;
  41.   UNTIL (Zeichen = XON) OR KeyPressed
  42. END;
  43.  
  44.  
  45.  
  46. (* Funktion IOFEHLER liefert bei I/O-Result in einer Form, die die anderen
  47.    Prozeduren verarbeiten koennen.                                          *)
  48.  
  49. FUNCTION IOFehler : BOOLEAN;
  50.  
  51. VAR Fehler  : INTEGER;
  52.  
  53. BEGIN
  54.   Fehler := IOResult;
  55.   IF Fehler <> 0 THEN BEGIN
  56.     WriteLn(BELL,INV_EIN,'I/O-Fehler aufgetreten',INV_AUS);
  57.     Delay(5000);
  58.     IOFehler := TRUE
  59.   END
  60.   ELSE
  61.     IOFehler := FALSE
  62. END;
  63.  
  64.  
  65.  
  66. (* die folgenden Funktionen wandeln eine Integerzahl in eine
  67.    HexzahlSTRING um. ( Fuer Intel-Hex-Konvertierung )                      *)
  68.  
  69. FUNCTION hexb(bite: INTEGER) : String2;
  70.  
  71. VAR highnibble,lownibble   : INTEGER;
  72.     hexdigit : ARRAY[0..15] OF CHAR;
  73.  
  74. BEGIN
  75.    hexdigit := '0123456789ABCDEF';
  76.    highnibble := bite DIV 16;
  77.    lownibble := bite MOD 16;
  78.    hexb := hexdigit[highnibble] + hexdigit[lownibble];
  79. END;
  80.  
  81.  
  82.  
  83. FUNCTION hexi(Int : INTEGER): String4;
  84.  
  85. BEGIN
  86.    hexi := hexb(Hi(Int)) + hexb(Lo(Int));
  87. END;
  88.  
  89.  
  90.  
  91. (* Zeichen auf den Buffer schieben und ggf. speichern *)
  92. PROCEDURE PushBuffer(Zeichen : CHAR);
  93.  
  94. CONST Geduld = 1000; (* Wie oft gucken ob noch was kommt ? *)
  95.  
  96. VAR i : INTEGER;
  97.  
  98. BEGIN
  99.   TextBuf[Zaehler] := Zeichen;
  100.   Zaehler := Succ(Zaehler);
  101.   IF Zaehler > BUFEND - 500 THEN BEGIN
  102.     OutSIO(XOFF);
  103.     WHILE InpStatus DO BEGIN
  104.       TextBuf[Zaehler] := InpSIO;
  105.       Zaehler := Succ(Zaehler)
  106.     END;
  107.     FOR i := 1 TO Geduld DO (* Kommt noch was ? *)
  108.       IF InpStatus THEN BEGIN
  109.         TextBuf[Zaehler] := InpSIO;
  110.         Zaehler := Succ(Zaehler)
  111.       END;
  112.     FOR i := 1 TO Pred(Zaehler) DO BEGIN
  113.       IF TextBuf[i] IN [LF,CR,' '..'}'] THEN
  114.         Write(Logfile,TextBuf[i]);
  115.       IF TextBuf[i] = CR THEN
  116.         WriteLn(Logfile)
  117.     END;
  118.     Zaehler := 1;
  119.     OutSIO(XON)
  120.   END
  121. END;
  122.  
  123.  
  124.  
  125. (* Die Prozedur oeffnet ein Logfile unter dem Namen LOGFILE.xxx, wobei xxx
  126.    bei Null beginnend fuer jedes Logfile hochgezaehlt wird.                 *)
  127.  
  128. PROCEDURE oeffne_Protokoll;
  129.  
  130. VAR Name : STRING[14];
  131.     Ext  : STRING[3];
  132.     Nummer : INTEGER;
  133.     Fehler : BOOLEAN;
  134.  
  135. BEGIN
  136.   Nummer := 0;
  137.   REPEAT
  138.     Str(Nummer,Ext);
  139.     Name := Concat('LOGFILE.',Ext);
  140.     Assign(Logfile,Name);
  141. (*$I-*)
  142.     ReSet(Logfile);
  143. (*$I+*)
  144.     Fehler := (IOResult <> 0);
  145.     IF NOT Fehler THEN
  146.       Close(Logfile);
  147.     Nummer := Succ(Nummer)
  148.   UNTIL Fehler OR (Nummer > 999);
  149.   IF Nummer > 999 THEN
  150.     Nummer := Nummer - 1000;
  151.   Assign(Logfile,Name);
  152.   ReWrite(Logfile)
  153. END;
  154.  
  155.  
  156. (*                          Ende DFKERNEL.INC                                *)
  157. (*---------------------------------------------------------------------------*)
  158.