home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 01 / gameport / puls.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1990-10-26  |  6.1 KB  |  205 lines
  1. (* ------------------------------------------------------ *)
  2. (*                       PULS.PAS                         *)
  3. (*             Pulsmessung über Joystickport              *)
  4. (*                  Turbo Pascal ab 5.0                   *)
  5. (*          (c) 1990 Andreas Bartels & TOOLBOX            *)
  6. (* ------------------------------------------------------ *)
  7.  
  8. {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-} { Tempo ist Trumpf! }
  9.  
  10. PROGRAM Puls_Messung_am_Gameport;
  11.                { Pulsmessung am Finger oder Ohrläppchen... }
  12.  
  13. USES Crt, Graph, Dos;
  14.  
  15. FUNCTION Game_1_X : WORD;              { Gameport abfragen }
  16. VAR
  17.   w             : BYTE;
  18.   Zaehler, Wert : WORD;
  19. BEGIN
  20.   w := 0;
  21.   REPEAT
  22.     Wert := Port[$201];
  23.     Inc(w);
  24.   UNTIL ((Wert AND 3) = 0) OR (w > 100);
  25.   Port[$201] := Wert;
  26.   Zaehler := 0;
  27.   REPEAT
  28.     Wert := Port[$201];
  29.     Inc(Zaehler);
  30.   UNTIL Wert AND 1 = 0;
  31.   Game_1_X := Zaehler;
  32. END;
  33.  
  34. FUNCTION Zeit : REAL;
  35.       { fragt die Zeit ab und wandelt sie in eine Realzahl }
  36. VAR
  37.   Hour, Min, Second, Sec100 : WORD;
  38. BEGIN
  39.   GetTime(Hour, Min, Second, Sec100);
  40.   Zeit := 3600 * Hour + 60 * Min + Second + Sec100 / 100;
  41. END;
  42.  
  43. PROCEDURE Puls;                { Hauptprozedur Pulsmessung }
  44. VAR
  45.   R, RAlt                        : WORD;
  46.   WayDown, PartDown, y           : LONGINT;
  47.   Gd, Gm, x, delx, MaxY, PulsX   : INTEGER;
  48.   yOffset, Min, Max, BeepCounter : WORD;
  49.   yFaktor, At, Nt                : REAL;
  50.   ch                             : CHAR;
  51. CONST
  52.   StrahlColor : WORD = LightGreen;
  53.   RahmenColor : WORD = White;
  54.   Step        : BYTE = 2;
  55.   BeepDelay          = 10;               { rechnerabhängig }
  56.   BeepGuard          = 120;                        { dito! }
  57.  
  58.   PROCEDURE ClearScope;                  { Anzeige löschen }
  59.   BEGIN
  60.     ClearViewPort;
  61.     x := 0;
  62.     delx := 2;
  63.     WayDown := 0;
  64.     PartDown := 0;
  65.     RAlt := 0;
  66.     BeepCounter := 0;
  67.     SetTextStyle(DefaultFont, HorizDir, 1);
  68.     SetTextJustify(LeftText, BottomText);
  69.     OutTextXY(0, GetMaxY, 'toolbox-PULSATOR');
  70.     MoveTo(0, Round((Game_1_X - yOffset)*yFaktor));
  71.   END;
  72.  
  73.   PROCEDURE Abgleich;            { Abgleichen der Meßwerte }
  74.   VAR
  75.     Count, Wert, Overhead : WORD;
  76.   CONST
  77.     MaxCount = 100;                     { Anzahl Messungen }
  78.   BEGIN
  79.     NoSound;
  80.     SetTextStyle(DefaultFont, HorizDir, 2);
  81.     SetTextJustify(CenterText, CenterText);
  82.     SetColor(RahmenColor);
  83.     OutTextXY(GetMaxX DIV 2, MaxY DIV 2,
  84.               'Abgleich - bitte warten...');
  85.     Min := $FFFF;      { Startwert Minimum auf hoch,       }
  86.     Max := 0;          { Startwert Maximum auf tief setzen }
  87.     FOR Count := 0 TO MaxCount DO BEGIN
  88.       Wert := Game_1_X;
  89.       IF Wert < Min THEN Min := Wert;
  90.       IF Wert > Max THEN Max := Wert;
  91.     END;
  92.     Overhead := 3 * (Max - Min) DIV 5;
  93.              { "Reserve" bei der Skalierung; ggf. anpassen }
  94.     IF Min > Overhead THEN Dec(Min, Overhead)
  95.     ELSE Min := 0;
  96.     IF Max < $FFFF THEN Inc(Max, Overhead)
  97.     ELSE Max := $FFFF;
  98.     IF Max = Min THEN         { Division durch 0 vermeiden }
  99.       Max := Min + 2;
  100.     yFaktor := MaxY / (Max - Min);     { Skalierungsfaktor }
  101.     yOffset := Min;                         { Verschiebung }
  102.     ClearScope;                           { Schirm löschen }
  103.   END;
  104.  
  105.   PROCEDURE ShowPuls;        { Puls berechnen und anzeigen }
  106.   VAR
  107.     PulsStr    : STRING[3];
  108.     xAlt, yAlt : INTEGER;
  109.     FPuls      : WORD;
  110.   BEGIN
  111.     xAlt := GetX;          { Position Grafikcursor sichern }
  112.     yAlt := GetY;
  113.     SetFillStyle(SolidFill, 0);
  114.     Bar(PulsX, MaxY, GetMaxX, GetMaxY);     { Feld löschen }
  115.     Nt := Zeit;
  116.     IF Nt <> At THEN BEGIN
  117.       FPuls := Round(60 / (Nt - At));
  118.       IF FPuls < 300 THEN
  119.         At := Nt;
  120.     END;
  121.     Str(FPuls:3, PulsStr);
  122.     SetColor(RahmenColor);
  123.     SetTextStyle(DefaultFont, HorizDir, 1);
  124.     SetTextJustify(LeftText, BottomText);
  125.     OutTextXY(PulsX, GetMaxY, PulsStr);
  126.     MoveTo(xAlt, yAlt);        { Grafikcursor restaurieren }
  127.   END;
  128.  
  129. BEGIN                             { Hauptprogramm GamePuls }
  130.   At := Zeit;
  131.   Nt := Zeit;
  132.   DetectGraph(Gd, Gm);
  133.   InitGraph(Gd, Gm, '');
  134.   IF Gd IN [CGA, MCGA, HercMono, EGAMono] THEN BEGIN
  135.     StrahlColor := 1;
  136.     RahmenColor := 1;
  137.   END;
  138.   SetTextStyle(DefaultFont, HorizDir, 1);
  139.   SetTextJustify(LeftText, BottomText);
  140.   PulsX := GetMaxX - 8 * TextWidth('X');
  141.   MaxY := GetMaxY - 3 * TextHeight('X') DIV 2;
  142.   Abgleich;
  143.   REPEAT
  144.     IF KeyPressed THEN BEGIN
  145.       Ch := ReadKey;
  146.       IF Ch = #0 THEN
  147.         Ch := ReadKey;
  148.       CASE Ch OF
  149.         #32:  Abgleich;
  150.         #27:  BEGIN
  151.                 NoSound;
  152.                 RestoreCrtMode;
  153.                 Halt(0);
  154.               END;
  155.       END;
  156.     END;
  157.     Inc(BeepCounter);
  158.     IF BeepCounter > BeepGuard THEN Abgleich;
  159.     Inc(x, Step);
  160.     IF x > GetMaxX THEN x := 0;
  161.     Inc(delx, Step);
  162.     IF delx > GetMaxX THEN delx := 0;
  163.     SetColor(0);
  164.     SetLineStyle(SolidLn, 0, ThickWidth);
  165.     Line(delx, 1 , delx, Pred(MaxY));
  166.     RAlt := R;
  167.     R := Game_1_X;
  168.     IF RAlt < R THEN BEGIN                { fallende Linie }
  169.       PartDown := Abs(LONGINT(RAlt) - LONGINT(R));
  170.                                    { wichtig: Typecasting! }
  171.       Inc(WayDown, PartDown)
  172.     END ELSE BEGIN                       { steigende Linie }
  173.       IF Abs(RAlt - R) > PartDown THEN BEGIN
  174.         WayDown := 0;
  175.         PartDown := 0;
  176.       END;
  177.     END;
  178.                { Bedingung für Piepsen eventuell anpassen! }
  179.     IF (WayDown > (Max-Min) DIV 4) AND
  180.        (BeepCounter > BeepDelay) THEN BEGIN
  181.       BeepCounter := 0;
  182.       Sound(100);
  183.       ShowPuls;
  184.     END ELSE
  185.       NoSound;
  186.     SetLineStyle(SolidLn, 0, NormWidth);
  187.     SetColor(StrahlColor);
  188.     y := Round((R - yOffset) * yFaktor);
  189.     IF (y > MaxY) OR (y < 0) THEN
  190.       Abgleich                      { Linie verläßt Schirm }
  191.     ELSE
  192.       IF x > 0 THEN
  193.         LineTo(x, INTEGER(y))               { Linie ziehen }
  194.       ELSE
  195.         MoveTo(0, INTEGER(y));               { linker Rand }
  196.   UNTIL FALSE;
  197. END;
  198.  
  199. BEGIN
  200.   Puls;
  201. END.
  202. (* ------------------------------------------------------ *)
  203. (*                   Ende von PULS.PAS                    *)
  204.  
  205.