home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 09 / tricks / schnitt.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-08-03  |  8.0 KB  |  284 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      SCHNITT.PAS                       *)
  3. (* Programm zur Überprüfung der Centronics-Schnittstelle  *)
  4. (*         (c) 1990 Burkhard Schranz & TOOLBOX            *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM Schnittstelle;
  7. {$R-,V-,D-,L-,S-,I-}
  8.  
  9. USES centron, Dos, Crt;
  10.  
  11. TYPE BitmapType=ARRAY[0..7] OF STRING[1];
  12.      BildType = ARRAY[1..6] OF STRING[80];
  13.  
  14. CONST Bildattr   :BYTE = $70;
  15.       StatusAttr :BYTE = $0F;
  16.       Wahlattr   :BYTE = $7F;
  17.       BackAttr   :BYTE = $70;
  18.       MsgAttr    :BYTE = $07;
  19.       BitAttr    :BYTE = $70;
  20.  
  21.       xan1 : BYTE = 5;
  22.       yan1 : BYTE = 3;
  23.  
  24.       Statusbild:BildType =
  25. (
  26. '┌─── Status Byte ───────────────────────┐',
  27. '│                                       │',
  28. '│ s7 │ s6 │ s5 │ s4 │ s3 │ s2 │ s1 │ s0 │',
  29. '├────┼────┼────┼────┼────┼────┼────┼────┤',
  30. '│    │    │    │    │    │    │    │    │',
  31. '└────┴────┴────┴────┴────┴────┴────┴────┘');
  32.       Databild:BildType =
  33. (
  34. '┌─── Data Byte ─────────────────────────┐',
  35. '│                                       │',
  36. '│ d7 │ d6 │ d5 │ d4 │ d3 │ d2 │ d1 │ d0 │',
  37. '├────┼────┼────┼────┼────┼────┼────┼────┤',
  38. '│    │    │    │    │    │    │    │    │',
  39. '└────┴────┴────┴────┴────┴────┴────┴────┘');
  40.       Controlbild:BildType =
  41. (
  42. '┌─── Control Byte ──────────────────────┐',
  43. '│                                       │',
  44. '│ c7 │ c6 │ c5 │ c4 │ c3 │ c2 │ c1 │ c0 │',
  45. '├────┼────┼────┼────┼────┼────┼────┼────┤',
  46. '│    │    │    │    │    │    │    │    │',
  47. '└────┴────┴────┴────┴────┴────┴────┴────┘');
  48.  
  49. VAR Schnittnr:INTEGER;     { Nummer der Schnittstelle 1..3 }
  50.     lpt : Centronics_INTERFACE;  { Object aus Unit Centron }
  51.     co : BOOLEAN;                        { Farbmonitor J/N }
  52.     StrDummy : STRING[80];                         { Dummy }
  53.     SCR_BASE : WORD;           { Segment des Video-Buffers }
  54.  
  55.  
  56. FUNCTION Color : BOOLEAN;           { Testen, ob Farbmodus }
  57. VAR reg:Registers;
  58. BEGIN
  59.   reg.AH := 15;
  60.   Intr($10, reg);
  61.   Color := reg.al IN [1, 3];
  62. END;
  63.  
  64. PROCEDURE SetBlink(Blink:BOOLEAN);
  65.                       { Blink- / Intensitätsbit umschalten }
  66. VAR reg:Registers;
  67. BEGIN
  68.   IF NOT Color THEN Exit;
  69.   reg.ah := $10;
  70.   reg.al := 3;
  71.   IF Blink THEN reg.bx := 1
  72.   ELSE reg.bx := 0;
  73.   Intr($10, reg);
  74. END;
  75.  
  76. PROCEDURE FillBox(x1, y1, x2, y2 : BYTE;ch, at : BYTE);
  77.   { Fenster mit einem bestimmten Attribut / Zeichen füllen }
  78. VAR y:INTEGER;
  79.     Attr, I, J:BYTE;
  80.     DWord : WORD;
  81. BEGIN
  82.   DWord := ch + at SHL 8;
  83.   FOR j := y1 TO y2 DO
  84.     FOR i := x1 TO x2 DO
  85.       MemW[SCR_BASE:Pred(j) * 160 + i + i - 2] := DWord;
  86. END;
  87.  
  88. PROCEDURE PutString(x, y : BYTE;VAR s:STRING;Attr : BYTE);
  89.                       { String auf den Bilschirm schreiben }
  90. VAR WAttr, StSeg, StOfs, xi : WORD;
  91. BEGIN
  92.   WAttr := Attr SHL 8;
  93.   StSeg := Seg(S);
  94.   StOfs := Ofs(S);
  95.   FOR xi := 1 TO Mem[StSeg:StOfs] DO
  96.     MemW[SCR_BASE:(y - 1) * 160 + 2 * (x + xi) - 4] :=
  97.       Mem[StSeg:StOfs + xi] + WAttr;
  98. END;
  99.  
  100. PROCEDURE ChangeAttr(x1, y1, x2, y2:INTEGER;Attr:BYTE);
  101.                { Attribut eines Bildschirmbereiches ändern }
  102. VAR x, y : INTEGER;
  103. BEGIN
  104.   IF x1<1  THEN x1 := 1; IF x2>80 THEN x2 := 80;
  105.   IF y1<1  THEN y1 := 1; IF y2>25 THEN y2 := 25;
  106.   IF (x1>x2) THEN BEGIN x := x1; x1 := x2; x2 := x; END;
  107.   IF (y1>y2) THEN BEGIN y := y1; y1 := y2; y2 := y; END;
  108.   FOR y := y1 TO y2 DO
  109.     FOR x := x1 TO x2 DO
  110.       Mem[SCR_BASE:Pred(y) * 160 + x + x - 1] := Attr;
  111. END;
  112.  
  113. PROCEDURE GetBits(b: BYTE; VAR Bitmap: Bitmaptype);
  114. VAR i: BYTE;
  115. BEGIN
  116.   FOR i := 0 TO 7 DO
  117.     IF b AND ($80 SHR i) = ($80 SHR i) THEN
  118.       Bitmap[i] := '1' ELSE Bitmap[i] := '0';
  119. END;
  120.  
  121. PROCEDURE Putbox(x, y: INTEGER; VAR Bild: BildType);
  122. VAR i: INTEGER;
  123. BEGIN
  124.   FOR i := 1 TO 6 DO
  125.     PutString(x, y + i - 1, bild[i], BildAttr);
  126. END;
  127.  
  128. PROCEDURE PutMessage(x, y, col: BYTE);
  129. BEGIN
  130.   Window(x + 1, y + 1, x + 28, y + 15);
  131.   Fillbox(x, y, x + 28, y + 16, 32, col);
  132.   TextAttr := col;
  133.   Write('STATUS BYTE:', #13, #10,
  134.         '  s0..s2 : keine Bedeutung', #13, #10,
  135.         '      s3 : 0=Error', #13, #10,
  136.         '      s4 : 1=Select', #13, #10,
  137.         '      s5 : 1=Paper out', #13, #10,
  138.         '      s6 : 0=fertig', #13, #10,
  139.         '      s7 : 0=beschäftigt', #13, #10,
  140.         '', #13, #10,
  141.         'CONTROL BYTE:', #13, #10,
  142.         '      c0 : 0=Strobe', #13, #10,
  143.         '      c1 : 0=Autofeed', #13, #10,
  144.         '      c2 : 0=Init', #13, #10,
  145.         '      c3 : 1=Select', #13, #10,
  146.         '      c4 : 1=bei s6=0 IRQ7', #13, #10,
  147.         '  c5..c7 : keine Bedeutung');
  148.   Window(1, 1, 80, 25);
  149. END;
  150.  
  151. PROCEDURE StatusZeile(Msg: STRING);
  152. VAR S: STRING;
  153. BEGIN
  154.   s := Msg;
  155.   FillBox(1, 25, 80, 25, 32, statusattr);
  156.   PutString(2, 25, S, statusattr);
  157. END;
  158.  
  159. PROCEDURE Grundbild;
  160. VAR s: STRING;
  161. BEGIN
  162.   FillBox(1, 1, 80, 25, 176, Backattr);
  163.   FillBox(1, 1, 80, 1, 32, statusattr);
  164.   S := 'Schnittstellenmonitor für Centronics Interface' +
  165.        ' (c) 1990 B.Schranz & toolbox';
  166.   PutString(2, 1, S, statusattr);
  167. END;
  168.  
  169. PROCEDURE Putall;
  170. VAR bm: Bitmaptype;
  171.     i, j: BYTE;
  172. BEGIN
  173.   FOR i := 1 TO 3 DO BEGIN
  174.     IF i=1 THEN GetBits(lpt.StatusByte, bm);
  175.     IF i=2 THEN GetBits(lpt.DataByte, bm);
  176.     IF i=3 THEN GetBits(lpt.ControlByte, bm);
  177.     FOR j := 0 TO 7 DO
  178.       PutString(xan1 + j * 5 + 3,
  179.                 yan1 + (i - 1) * 7 + 4, Bm[j], BitAttr);
  180.   END;
  181. END;
  182.  
  183. PROCEDURE Bearbeite;
  184. VAR reihe, Bit: BYTE;
  185.     ch: INTEGER;
  186.     SBuf: STRING[10];
  187.  
  188.   PROCEDURE BitCol(re, bi, co: BYTE);
  189.   VAR x1, y1: BYTE;
  190.   BEGIN
  191.     x1 := xan1 + (7 - bi) * 5 + 2;
  192.     y1 := yan1 + re * 7 + 2;
  193.     ChangeAttr(x1, y1, x1 + 1, y1, co);
  194.   END;
  195.  
  196.   PROCEDURE ChangeBit(re, bi: BYTE);
  197.   BEGIN
  198.     CASE re OF
  199.       0:lpt.StatusByte := lpt.StatusByte XOR (1 SHL bi);
  200.       1:lpt.DataByte := lpt.DataByte XOR (1 SHL bi);
  201.       2:lpt.ControlByte := lpt.ControlByte XOR (1 SHL bi);
  202.     END;
  203.   END;
  204.  
  205. BEGIN
  206.   Reihe := 0; Bit := 0;
  207.   WITH lpt DO REPEAT
  208.     Putall;
  209.     BitCol(Reihe, Bit, WahlAttr);
  210.     ch := Ord(UpCase(ReadKey));
  211.     IF ch=0 THEN ch := 255 + Ord(ReadKey);
  212.     BitCol(Reihe, Bit, Bildattr);
  213.     CASE ch OF
  214.       13:ChangeBit(Reihe, Bit);{Enter}
  215.       83:Reihe := 0;
  216.       68:Reihe := 1;
  217.       67:Reihe := 2;
  218.       48..55:Bit := ch - 48;
  219.      330:IF Bit<7 THEN Inc(Bit) ELSE Bit := 0;     { links }
  220.      332:IF Bit>0 THEN Dec(Bit) ELSE Bit := 7;    { rechts }
  221.      327:IF Reihe>0 THEN Dec(Reihe) ELSE Reihe:=2;  { oben }
  222.      335:IF Reihe<2 THEN Inc(Reihe) ELSE Reihe:=0; { unten }
  223.      314:StatusByte := GetStatus;                     { F1 }
  224.      315:BEGIN                                        { F2 }
  225.            WriteData(DataByte);
  226.            StatusByte := GetStatus;
  227.          END;
  228.      316:BEGIN                                        { F3 }
  229.            WriteControl(controlbyte);
  230.            Statusbyte := GetStatus
  231.          END;
  232.      317:BEGIN
  233.            IF SchnittNr<3 THEN Inc(SchnittNr) ELSE
  234.              SchnittNr := 1;
  235.            SetPortadress(SchnittNr);
  236.            Str(SchnittNr, SBuf); SBuf := 'LPT' + SBuf;
  237.            PutString(69, 25, SBuf, Statusattr);
  238.          END;
  239.      END;
  240.   UNTIL ch=27;
  241. END;
  242.  
  243. PROCEDURE Schnittstellenmonitor;
  244. BEGIN
  245.   lpt.init(1);
  246.   Grundbild;
  247.   StatusZeile('<F1>Status lesen <F2>Data schreiben ' +
  248.               '<F3>Control schreiben <F4>Port:LPT1 <ESC>');
  249.   Putbox(xan1, yan1   , statusbild);
  250.   Putbox(xan1, yan1 + 7, databild);
  251.   Putbox(xan1, yan1 + 14, controlbild);
  252.   PutMessage(50, 5, Msgattr);
  253.   Bearbeite;
  254. END;
  255.  
  256. BEGIN
  257.   co := Color;
  258.   IF Color THEN SCR_BASE := $B800
  259.   ELSE SCR_BASE := $B000;
  260.   IF ParamCount>0 THEN BEGIN
  261.     StrDummy := ParamStr(1);
  262.     IF UpCase(StrDummy[2])='C' THEN co := TRUE;
  263.     IF UpCase(StrDummy[2])='B' THEN co := FALSE;
  264.   END;
  265.   IF co THEN BEGIN
  266.     Bildattr   := $F8;
  267.     StatusAttr := $4F;
  268.     Wahlattr   := $0F;
  269.     BackAttr   := $70;
  270.     MsgAttr    := $17;
  271.     BitAttr    := $F1;
  272.   END;
  273.   IF color THEN setblink(FALSE);
  274.   Schnittstellenmonitor;
  275.   IF color THEN SetBlink(TRUE);
  276.   TextAttr := 7; ClrScr;
  277. END.
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.