home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 04 / praxis / switch.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-02-01  |  8.2 KB  |  247 lines
  1. (* ------------------------------------------------------ *)
  2. (*                       SWITCH.PAS                       *)
  3. (*                Bis zu 8 Schalter abfragen              *)
  4. (*                 mit einer IBM-Gamekarte                *)
  5. (*           (c) 1991 Andreas Bartels & TOOLBOX           *)
  6. (* ------------------------------------------------------ *)
  7. {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  8. PROGRAM Switch;
  9. USES Crt, Dos;
  10. CONST
  11.   DaumenfaktorDefault = 0.9988;            { Korrektur für
  12.                   Werteverlauf: wenn nur Einzelwerte nicht
  13.                             stimmen, individuell anpassen! }
  14.   Daumenfaktor  : REAL = DaumenfaktorDefault;
  15.   Daumenschritt = 0.0001;                   { Schrittweite }
  16.   Daumenwert : INTEGER = 0;             { Wert für Anzeige }
  17.   MaxZaehler = 8000;  { Höchstanzahl Zugriffe auf Gameport }
  18.   PortNr   = $201;                              { Gameport }
  19.   TitelCol = Yellow OR Green SHL 4;        { Farbattribute }
  20.   NormCol  = Yellow OR Blue SHL 4;
  21.   WertCol  = LightGreen OR Blue SHL 4;
  22.   SwCol    : ARRAY[FALSE..TRUE] OF BYTE =
  23.              (White OR Blue SHL 4, Yellow OR Red SHL 4);
  24.   SwStringLength      = 34;  { Maximallänge der Stichworte }
  25.   SwStringLengthPlus1 = SwStringLength + 1;
  26.   SwString : ARRAY[0..7] OF STRING[SwStringLength]
  27.            = (' Besuch  (angekündigter Überfall) ',
  28.               ' Einbruch (nicht angek. Überfall) ',
  29.               '     Küche erstickt im Abwasch    ',
  30.               ' Hundehütte muß renoviert werden  ',
  31.               '     Kellerbar wird geplündert    ',
  32.               '     Eisschrank leergefressen     ',
  33.               '       Saunatür verrammelt        ',
  34.               '       Kinder randalieren         ');
  35.    WertX   = 5;           { Schirmkoordinaten Schalterwert }
  36.    WertY   = 9;
  37.    DaumenX = 66;                    { ... und Daumenfaktor }
  38.  
  39. VAR
  40.   Justierung         : REAL;      { Divisor für Umrechnung }
  41.   Min                : INTEGER;            { minimaler und }
  42.   Max                : INTEGER;        { maximaler Meßwert }
  43.   i, X0, Y0,
  44.   SNo, HilfByte      : BYTE;    { Lauf- und Hilfsvariablen }
  45.   Help               : INTEGER;
  46.   GP                 : BYTE;       { Bytewert für Schalter }
  47.   KanalOK            : BOOLEAN;          { Status Gameport }
  48.   Sw                 : ARRAY[0..7] OF BOOLEAN;  { Schalter }
  49.   TSS, DSS, LSS, BSS : STRING[SwStringLengthPlus1];
  50.   DS, LS             : STRING[SwStringLengthPlus1];
  51.   ch                 : CHAR;                       { Taste }
  52.  
  53. PROCEDURE CursorOn;
  54. BEGIN
  55.   INLINE($B4/$01/
  56.          $B9/13/12/    { Cursoranf. 12. Zl., -ende 13. Zl. }
  57.          $CD/$10);
  58. END;
  59.  
  60. PROCEDURE CursorOff;
  61. BEGIN
  62.   INLINE($B4/$01/
  63.          $B9/$FF/$FF/          { Cursoranfang und -ende... }
  64.          $CD/$10);  { ...auf 255 setzen: löscht den Cursor }
  65. END;
  66.  
  67. FUNCTION RStr(r : REAL; n, m : BYTE) : STRING;
  68. VAR                                   { "Str" als Funktion }
  69.   S : STRING;
  70. BEGIN
  71.   Str(r:n:m, S);
  72.   RStr := S;
  73. END;
  74.  
  75. FUNCTION GamePort : INTEGER;     { Wert vom Gameport lesen }
  76. VAR
  77.   GPWert, Zaehler : INTEGER;
  78. BEGIN
  79.   INLINE ($FA);                  { CLI: Interrupts sperren }
  80.   Zaehler := 0;
  81.   REPEAT
  82.     GPWert := Port[PortNr];
  83.     Inc(Zaehler);
  84.   UNTIL (GPWert AND 1 = 0)
  85.      OR (Zaehler >= MaxZaehler);
  86.   Port[PortNr] := GPWert;
  87.   REPEAT
  88.     GPWert := Port[PortNr];
  89.     Inc(Zaehler);
  90.   UNTIL (GPWert AND 1 = 0)
  91.      OR (Zaehler >= MaxZaehler);
  92.   INLINE($FB);           { STI: Interrupts wieder zulassen }
  93.             { Status ermitteln; den Wert "2" ggf. anpassen }
  94.   KanalOK := (Zaehler < MaxZaehler) AND (Zaehler > 2);
  95.   IF KanalOK THEN GamePort := Zaehler
  96.   ELSE GamePort := 0;
  97. END;
  98.  
  99. FUNCTION Messen(Anzahl : BYTE) : INTEGER;
  100. VAR      { Meßreihe durchführen, Ergebnis geometr. mitteln }
  101.   n     : BYTE;
  102.   Summe : LONGINT;
  103. BEGIN
  104.   Summe := 0;
  105.   FOR n := 1 TO Anzahl DO
  106.     Summe := Summe + Sqr(WORD(GamePort));
  107.   Summe := Round(Summe / Anzahl);
  108.   Messen := Round(Sqrt(Summe));
  109. END;
  110.  
  111. PROCEDURE WriteXY(x, y : BYTE; S : STRING; Col : BYTE);
  112. BEGIN
  113.   TextAttr := Col;
  114.   GotoXY(x, y);
  115.   Write(S);
  116. END;
  117.  
  118. PROCEDURE WriteKaestchen(i : BYTE);
  119. BEGIN
  120.   WriteXY(X0, Y0 + i    ,'║' + LS + '║', NormCol );
  121.   WriteXY(X0, Y0 + i + 1,'╠' + DS + '╣', NormCol );
  122. END;
  123.  
  124. PROCEDURE Adjust;                    { Schaltung einmessen }
  125. VAR
  126.   Dummy : INTEGER;
  127. BEGIN
  128.   ClrScr;
  129.   Min := 0;
  130.   Max := 0;
  131.   REPEAT
  132.     WriteLn('Abgleich der Schalter');
  133.     WriteLn('=====================', #10#13);
  134.     WriteLn('Bitte schalten Sie alle Schalter aus ' +
  135.             'und drücken Sie <ENTER>');
  136.     REPEAT UNTIL ReadKey = #13;
  137.     Dummy := GamePort;
  138.     IF KanalOK THEN BEGIN                { Kanal ist aktiv }
  139.       Max := Messen(120);
  140.       WriteLn('Gemessener Wert: ', Max:5);
  141.       WriteLn('Und jetzt: Alle Schalter ein und ' +
  142.               'nochmal <ENTER>');
  143.       REPEAT UNTIL ReadKey = #13;
  144.       Min := GamePort;
  145.       IF Min < Max THEN
  146.         Justierung := (Max - Min) / 256
  147.       ELSE
  148.         WriteLn(^G, 'Justierung falsch! ' +
  149.                     'Bitte wiederholen...', #10#13);
  150.     END;
  151.     IF Justierung = 0.0 THEN
  152.       Justierung := 0.0001;
  153.   UNTIL (Min < Max) OR NOT KanalOK;
  154. END;
  155.  
  156. BEGIN
  157.   TextAttr := NormCol;
  158.   CheckBreak := FALSE;        { wichtig wegen Sperrung der
  159.                     Interrupts in der Funktion "GamePort"! }
  160.   Adjust;                                      { einmessen }
  161.   CursorOff;
  162.   ClrScr;
  163.   X0 := 18;
  164.   Y0 := 8;
  165.   WriteXY(X0, 2,
  166.           '┌─────────────────────────────────────────┐',
  167.           TitelCol);
  168.   WriteXY(X0, 3,
  169.           '│     "Switch": 8 Schalterstellungen      │',
  170.           TitelCol);
  171.   WriteXY(X0, 4,
  172.           '│      über eine Game-Karte abfragen      │',
  173.           TitelCol);
  174.   WriteXY(X0, 5,
  175.           '│      (c) 1991 A. Bartels & toolbox      │',
  176.           TitelCol);
  177.   WriteXY(X0, 6,
  178.           '└─────────────────────────────────────────┘',
  179.           TitelCol);
  180.   X0 := 21;
  181.   DS := '';
  182.   LS := '';
  183.   FOR i := 1 TO SwStringLength DO BEGIN
  184.     DS := DS + '═';
  185.     LS := LS + ' ';
  186.   END;
  187.   TSS := DS + '╦';
  188.   DSS := DS + '╬';
  189.   LSS := LS + '║';
  190.   BSS := DS + '╩';
  191.   WriteXY(X0, Y0, '╔' + DS +'╗', NormCol);
  192.   FOR i := 0 TO 6 DO WriteKaestchen(2 * i + 1);
  193.   WriteXY(X0, Y0 + 15, '║' + LS + '║', NormCol);
  194.   WriteXY(X0, Y0 + 16, '╚' + DS + '╝', NormCol);
  195.   WriteXY(WertX - 1, WertY - 1, '╔══ Wert ══╗', WertCol);
  196.   WriteXY(WertX - 1, WertY    , '║          ║', WertCol);
  197.   WriteXY(WertX - 1, WertY + 1, '╚══════════╝', WertCol);
  198.   WriteXY(DaumenX - 1, WertY - 1, '╔═ Daumen ═╗', WertCol);
  199.   WriteXY(DaumenX - 1, WertY    , '║          ║', WertCol);
  200.   WriteXY(DaumenX - 1, WertY + 1, '╚══════════╝', WertCol);
  201.   WriteXY(DaumenX, WertY, RStr(Daumenwert, 7, 0), WertCol);
  202.   ch := #0;
  203.   REPEAT
  204.  { Gameport-Kanal abfragen, evtl. invertierte Arbeitsweise }
  205.     Help := Messen(20);
  206.     Help := {255-}Round((Help * Daumenfaktor - Min) /
  207.                          Justierung);
  208.     IF Help > 255 THEN Help := 255     { Überlauf abfangen }
  209.     ELSE
  210.       IF Help < 0 THEN Help := 0;
  211.     GP := Help;
  212.     IF KanalOK THEN      { Wert anzeigen }
  213.       WriteXY(WertX, WertY, RStr(GP, 7, 0) + '  ', WertCol)
  214.     ELSE BEGIN
  215.       WriteXY(WertX, WertY, '  Fehler!', WertCol);
  216.       Sound(440);                  { Alarmton, falls Kabel
  217.       Delay(10);                     defekt oder ähnliches }
  218.       NoSound;
  219.     END;
  220.                      { Einzelne Bits in Schalter umrechnen }
  221.     FOR i := 0 TO 7 DO BEGIN
  222.       HilfByte := BYTE(GP SHL (7 - i));
  223.       Sw[i] := (HilfByte SHR 7) > 0;
  224.     END;
  225.     FOR SNo := 0 TO 7 DO     { Schalterzustände darstellen }
  226.      WriteXY(Succ(X0), Succ(Y0) + SNo * 2,
  227.              SwString[SNo], SwCol[Sw[SNo]]);
  228.     IF KeyPressed THEN BEGIN      { Daumenfaktor verändern }
  229.       ch := ReadKey;
  230.       IF ch = #0 THEN ch := ReadKey;
  231.       CASE ch OF
  232.         '+' : Inc(Daumenwert);
  233.         '-' : Dec(Daumenwert);
  234.       END;
  235.       Daumenfaktor := DaumenfaktorDefault + Daumenwert *
  236.                       Daumenschritt;
  237.       WriteXY(DaumenX, WertY,
  238.               RStr(Daumenwert, 7, 0), WertCol);
  239.     END;
  240.   UNTIL ch = #27;
  241.   CursorOn;
  242.   TextMode(LastMode);
  243.   ClrScr;
  244. END.
  245. (* ------------------------------------------------------ *)
  246. (*                   Ende von SWITCH.PAS                  *)
  247.