home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / extra18 / toolbox / schnitt.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-21  |  7.9 KB  |  294 lines
  1. (* ------------------------------------------------- *)
  2. (*                 SCHNITT.PAS                       *)
  3. (*     Überprüfung der Centronics-Schnittstelle      *)
  4. (*    (c) 1990, 1992 Burkhard Schranz & DMV-Verlag   *)
  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;
  50.     lpt : Centronics_INTERFACE;
  51.     co : BOOLEAN;               { Farbmonitor J/N }
  52.     StrDummy : STRING[80];                    { Dummy }
  53.     SCR_BASE : WORD;          { Segment 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;
  77.                   ch, at : BYTE);
  78.   { Fenster mit einem bestimmten
  79.     Attribut / Zeichen füllen }
  80. VAR y:INTEGER;
  81.     Attr, I, J:BYTE;
  82.     DWord : WORD;
  83. BEGIN
  84.   DWord := ch + at SHL 8;
  85.   FOR j := y1 TO y2 DO
  86.     FOR i := x1 TO x2 DO
  87.       MemW[SCR_BASE:Pred(j) * 160 +i+i-2] := DWord;
  88. END;
  89.  
  90. PROCEDURE PutString(x, y : BYTE;VAR s:STRING;
  91.                     Attr : BYTE);
  92.       { String auf den Bildschirm schreiben }
  93. VAR WAttr, StSeg, StOfs, xi : WORD;
  94. BEGIN
  95.   WAttr := Attr SHL 8;
  96.   StSeg := Seg(S);
  97.   StOfs := Ofs(S);
  98.   FOR xi := 1 TO Mem[StSeg:StOfs] DO
  99.     MemW[SCR_BASE:(y - 1) * 160 + 2 * (x + xi) - 4] :=
  100.       Mem[StSeg:StOfs + xi] + WAttr;
  101. END;
  102.  
  103. PROCEDURE ChangeAttr(x1, y1, x2, y2:INTEGER;Attr:BYTE);
  104.           { Attribut eines Bildschirmbereiches ändern }
  105. VAR x, y : INTEGER;
  106. BEGIN
  107.   IF x1<1  THEN x1 := 1; IF x2>80 THEN x2 := 80;
  108.   IF y1<1  THEN y1 := 1; IF y2>25 THEN y2 := 25;
  109.   IF (x1>x2) THEN BEGIN
  110.     x := x1; x1 := x2; x2 := x;
  111.   END;
  112.   IF (y1>y2) THEN BEGIN
  113.     y := y1; y1 := y2; y2 := y;
  114.   END;
  115.   FOR y := y1 TO y2 DO
  116.     FOR x := x1 TO x2 DO
  117.       Mem[SCR_BASE:Pred(y) * 160 + x + x - 1] := Attr;
  118. END;
  119.  
  120. PROCEDURE GetBits(b: BYTE; VAR Bitmap: Bitmaptype);
  121. VAR i: BYTE;
  122. BEGIN
  123.   FOR i := 0 TO 7 DO
  124.     IF b AND ($80 SHR i) = ($80 SHR i) THEN
  125.       Bitmap[i] := '1' ELSE Bitmap[i] := '0';
  126. END;
  127.  
  128. PROCEDURE Putbox(x, y: INTEGER; VAR Bild: BildType);
  129. VAR i: INTEGER;
  130. BEGIN
  131.   FOR i := 1 TO 6 DO
  132.     PutString(x, y + i - 1, bild[i], BildAttr);
  133. END;
  134.  
  135. PROCEDURE PutMessage(x, y, col: BYTE);
  136. BEGIN
  137.   Window(x + 1, y + 1, x + 28, y + 15);
  138.   Fillbox(x, y, x + 28, y + 16, 32, col);
  139.   TextAttr := col;
  140.   Write('STATUS BYTE:', #13, #10,
  141.         '  s0..s2 : keine Bedeutung', #13, #10,
  142.         '      s3 : 0=Error', #13, #10,
  143.         '      s4 : 1=Select', #13, #10,
  144.         '      s5 : 1=Paper out', #13, #10,
  145.         '      s6 : 0=fertig', #13, #10,
  146.         '      s7 : 0=beschäftigt', #13, #10,
  147.         '', #13, #10,
  148.         'CONTROL BYTE:', #13, #10,
  149.         '      c0 : 0=Strobe', #13, #10,
  150.         '      c1 : 0=Autofeed', #13, #10,
  151.         '      c2 : 0=Init', #13, #10,
  152.         '      c3 : 1=Select', #13, #10,
  153.         '      c4 : 1=bei s6=0 IRQ7', #13, #10,
  154.         '  c5..c7 : keine Bedeutung');
  155.   Window(1, 1, 80, 25);
  156. END;
  157.  
  158. PROCEDURE StatusZeile(Msg: STRING);
  159. VAR S: STRING;
  160. BEGIN
  161.   s := Msg;
  162.   FillBox(1, 25, 80, 25, 32, statusattr);
  163.   PutString(2, 25, S, statusattr);
  164. END;
  165.  
  166. PROCEDURE Grundbild;
  167. VAR s: STRING;
  168. BEGIN
  169.   FillBox(1, 1, 80, 25, 176, Backattr);
  170.   FillBox(1, 1, 80, 1, 32, statusattr);
  171.   S := 'Schnittstellenmonitor für ' +
  172.        ' Centronics Interface' +
  173.   PutString(2, 1, S, statusattr);
  174. END;
  175.  
  176. PROCEDURE Putall;
  177. VAR bm: Bitmaptype;
  178.     i, j: BYTE;
  179. BEGIN
  180.   FOR i := 1 TO 3 DO BEGIN
  181.     IF i=1 THEN GetBits(lpt.StatusByte, bm);
  182.     IF i=2 THEN GetBits(lpt.DataByte, bm);
  183.     IF i=3 THEN GetBits(lpt.ControlByte, bm);
  184.     FOR j := 0 TO 7 DO
  185.       PutString(xan1 + j * 5 + 3,
  186.                 yan1 + (i - 1) * 7 + 4, Bm[j],BitAttr);
  187.   END;
  188. END;
  189.  
  190. PROCEDURE Bearbeite;
  191. VAR reihe, Bit: BYTE;
  192.     ch: INTEGER;
  193.     SBuf: STRING[10];
  194.  
  195.   PROCEDURE BitCol(re, bi, co: BYTE);
  196.   VAR x1, y1: BYTE;
  197.   BEGIN
  198.     x1 := xan1 + (7 - bi) * 5 + 2;
  199.     y1 := yan1 + re * 7 + 2;
  200.     ChangeAttr(x1, y1, x1 + 1, y1, co);
  201.   END;
  202.  
  203.   PROCEDURE ChangeBit(re, bi: BYTE);
  204.   BEGIN
  205.     CASE re OF
  206.       0:lpt.StatusByte := lpt.StatusByte XOR (1 SHL bi);
  207.       1:lpt.DataByte := lpt.DataByte XOR (1 SHL bi);
  208.       2:lpt.ControlByte :=
  209.         lpt.ControlByte XOR (1 SHL bi);
  210.     END;
  211.   END;
  212.  
  213. BEGIN
  214.   Reihe := 0; Bit := 0;
  215.   WITH lpt DO REPEAT
  216.     Putall;
  217.     BitCol(Reihe, Bit, WahlAttr);
  218.     ch := Ord(UpCase(ReadKey));
  219.     IF ch=0 THEN ch := 255 + Ord(ReadKey);
  220.     BitCol(Reihe, Bit, Bildattr);
  221.     CASE ch OF
  222.       13:ChangeBit(Reihe, Bit);{Enter}
  223.       83:Reihe := 0;
  224.       68:Reihe := 1;
  225.       67:Reihe := 2;
  226.       48..55:Bit := ch - 48;
  227.      330:IF Bit<7 THEN Inc(Bit) ELSE Bit := 0;
  228.      332:IF Bit>0 THEN Dec(Bit) ELSE Bit := 7;
  229.      327:IF Reihe>0 THEN Dec(Reihe) ELSE Reihe:=2;
  230.      335:IF Reihe<2 THEN Inc(Reihe) ELSE Reihe:=0;
  231.      314:StatusByte := GetStatus;
  232.      315:BEGIN
  233.            WriteData(DataByte);
  234.            StatusByte := GetStatus;
  235.          END;
  236.      316:BEGIN
  237.            WriteControl(controlbyte);
  238.            Statusbyte := GetStatus
  239.          END;
  240.      317:BEGIN
  241.            IF SchnittNr<3 THEN Inc(SchnittNr) ELSE
  242.              SchnittNr := 1;
  243.            SetPortadress(SchnittNr);
  244.            Str(SchnittNr, SBuf); SBuf := 'LPT' + SBuf;
  245.            PutString(69, 25, SBuf, Statusattr);
  246.          END;
  247.      END;
  248.   UNTIL ch=27;
  249. END;
  250.  
  251. PROCEDURE Schnittstellenmonitor;
  252. BEGIN
  253.   lpt.init(1);
  254.   Grundbild;
  255.   StatusZeile('<F1>Status lesen <F2>Data schreiben ' +
  256.           '<F3>Control schreiben <F4>Port:LPT1 <ESC>');
  257.   Putbox(xan1, yan1   , statusbild);
  258.   Putbox(xan1, yan1 + 7, databild);
  259.   Putbox(xan1, yan1 + 14, controlbild);
  260.   PutMessage(50, 5, Msgattr);
  261.   Bearbeite;
  262. END;
  263.  
  264. BEGIN
  265.   co := Color;
  266.   IF Color THEN SCR_BASE := $B800
  267.   ELSE SCR_BASE := $B000;
  268.   IF ParamCount>0 THEN BEGIN
  269.     StrDummy := ParamStr(1);
  270.     IF UpCase(StrDummy[2])='C' THEN co := TRUE;
  271.     IF UpCase(StrDummy[2])='B' THEN co := FALSE;
  272.   END;
  273.   IF co THEN BEGIN
  274.     Bildattr   := $F8;
  275.     StatusAttr := $4F;
  276.     Wahlattr   := $0F;
  277.     BackAttr   := $70;
  278.     MsgAttr    := $17;
  279.     BitAttr    := $F1;
  280.   END;
  281.   IF color THEN setblink(FALSE);
  282.   Schnittstellenmonitor;
  283.   IF color THEN SetBlink(TRUE);
  284.   TextAttr := 7; ClrScr;
  285. END.
  286. (* ------------------------------------------------- *)
  287. (*            Ende von SCHNITT.PAS                   *)
  288.  
  289.  
  290.  
  291.  
  292.  
  293.  
  294.