home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 06 / praxis / hirnstr.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-10  |  13.3 KB  |  393 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     HIRNSTR.PAS                        *)
  3. (*             Programm zur Aufnahme und                  *)
  4. (*            Auswertung von Gehirnwellen                 *)
  5. (*        (c) 1991 by Andreas Bartels & TOOLBOX           *)
  6. (* ------------------------------------------------------ *)
  7. {$A-,B-,D-,E+,F+,I-,L-,O-,R-,S-,V-}
  8. PROGRAM Hirn_Strom_Messung;
  9.  
  10. {$IFDEF CPU87} {$N+} {$ELSE} {$N-} {$ENDIF}
  11.  
  12. USES
  13.   Crt, Dos, Graph;
  14.  
  15. CONST
  16.   MaxLaenge =  128;                     { = 512 SHR ShiftL }
  17.   dxOben    =  250;
  18.   DX        =  128;               { X-Achsen-Strichabstand }
  19.   XStrOben  = '[ ms ]';
  20.   XStrUnten = '[ Hz ]';
  21.   YStrOben  =  '[ V ]';
  22.   YStrUnten =  '[/Hz]';
  23.                     { Falls ein Coprozessor vorhanden ist: }
  24. {$IFDEF CPU87}
  25.   TYPE REAL = EXTENDED;
  26. {$ENDIF}
  27.  
  28. TYPE
  29.   IntegerFeld = ARRAY[0..MaxLaenge] OF INTEGER;
  30.   RealFeld    = ARRAY[0..MaxLaenge] OF REAL;
  31.   DatenFile   = RECORD
  32.                   Signal    : RealFeld;
  33.                   Spektrum  : RealFeld;
  34.                   Kommentar : STRING;
  35.                 END;
  36.  
  37. VAR
  38.   GraphDriver,
  39.   GraphMode, MaxYWert,
  40.   XLinks, XRechts,
  41.   Y0Oben, Y0Unten,
  42.   Y1Oben, Y1Unten,
  43.   IMR21, IMRA1,
  44.   ShiftL, dXUnten, MYH,
  45.   MaxY, i, j, Hilf     : INTEGER;
  46.   Faktor, MaxWert      : REAL;
  47.   CH                   : CHAR;
  48.   HStr                 : STRING;
  49.   BitRev               : IntegerFeld;
  50.   Sinus, Cosinus,
  51.   RealTeil, ImagTeil   : RealFeld;
  52.   DatenFileName        : STRING[12];
  53.   Dat                  : DatenFile;
  54.   DatFile              : FILE OF DatenFile;
  55.   DateiOK              : BOOLEAN;
  56.  
  57. FUNCTION DatumUndZeitStr : STRING;
  58. VAR
  59.   Year, Month, Day, WeekDay,
  60.   Hour, Min, Second, Sec100 : WORD;
  61.   Monat, Tag,
  62.   Stunde, Minute, Sekunde   : STRING[2];
  63.   Jahr                      : STRING[4];
  64. BEGIN
  65.   GetDate(Year, Month, Day, WeekDay);
  66.   Str (Day:1, Tag);
  67.   IF Day < 10 THEN Tag := '0' + Tag;
  68.   Str(Month:1, Monat);
  69.   IF Month < 10 THEN Monat := '0' + Monat;
  70.   Str(Year:1, Jahr);
  71.   Jahr := Copy(Jahr,4,1);
  72.   GetTime(Hour, Min, Second, Sec100);
  73.   Str(Hour:1, Stunde );
  74.   IF Hour < 10 THEN Stunde := '0' + Stunde;
  75.   Str(Min:1, Minute);
  76.   IF Min < 10 THEN Minute := '0' + Minute;
  77.   Str(Second:1, Sekunde);
  78.   IF Second < 10 THEN Sekunde := '0' + Sekunde;
  79.   DatumUndZeitStr := Stunde + Minute + Sekunde +
  80.                      Tag + '.' + Monat + Jahr;
  81. END;                                     { DatumUndZeitStr }
  82.  
  83. PROCEDURE RahmenUndSoWeiter;     { An Grafikkarte anpassen }
  84. BEGIN
  85.   GraphDriver := Detect;
  86.   InitGraph(GraphDriver, GraphMode, GetEnv('BGIPATH'));
  87.   IF NOT (GraphDriver IN [HercMono, EGA, VGA]) THEN BEGIN
  88.     Writeln('Sorry: Das Programm benötigt eine EGA-, VGA-' +
  89.             ' oder Hercules-Grafikkarte!');
  90.     Halt;
  91.   END;
  92.   IF GraphResult <> GrOK THEN BEGIN
  93.     WriteLn('Grafik konnte nicht initialisiert werden!');
  94.     WriteLn('Geben Sie den Pfad zu den Treibern mit ' +
  95.             'Hilfe der Umgebungsvariablen "BGIPATH" an!',
  96.             ^G);
  97.     Halt;
  98.   END;
  99.   Rectangle(0, 0, 600, 347);
  100.   OutTextXY( 55, 6, 'H I R N S T R O M     Ver. 1.2 ' +
  101.                     '   (c) 1991 A. Bartels & toolbox');
  102.                                        { Beschriftung oben }
  103.   Rectangle(XLinks, Y0Oben, XRechts, Y1Oben);
  104.   FOR i := 0 TO 4 DO BEGIN
  105.     Line(XLinks + i * DX, Y1Oben, XLinks + i * DX,
  106.          Y1Oben + 5);
  107.     Str((i * dxOben):3, HStr);
  108.     OutTextXY(XLinks + i * DX - 15, Y1Oben + 10, HStr);
  109.   END;
  110.   OutTextXY(XLinks + Round(3.5 * DX) - 15,
  111.             Y1Oben + 10, XStrOben);
  112.   FOR i := 0 TO 5 DO BEGIN
  113.     Line(XLinks-5, Y1Oben - 1 - Round(i * MaxYWert / 5),
  114.         XLinks, Y1Oben - 1 - Round(i * MaxYWert / 5));
  115.     Str((i * 0.5):4:1, HStr);
  116.     OutTextXY(XLinks - 40, Y1Oben -
  117.               Round((i * MaxYWert / 5) + 1), HStr);
  118.   END;
  119.   OutTextXY(XLinks-45, Y0Oben + Round(MaxYWert / 8),
  120.             YStrOben);
  121.   Rectangle(XLinks, Y0Unten, XRechts, Y1Unten);
  122.   FOR i := 0 TO 4 DO BEGIN            { Beschriftung unten }
  123.     Line(XLinks + i * DX, Y1Unten, XLinks + i * DX,
  124.          Y1Unten + 5);
  125.     Str((i * dXUnten):3, HStr);
  126.     OutTextXY(XLinks + i * DX - 15, Y1Unten + 10, HStr);
  127.   END;
  128.                                       { 50 Hz - Markierung }
  129.   Line(Round(XLinks + (50 SHL Succ(ShiftL) *
  130.             (dxOben / 250))), Y1Unten + 2,
  131.             Round(XLinks+(50 SHL Succ(ShiftL) *
  132.                   (dxOben / 250))),
  133.             Y1Unten + 7);
  134.   OutTextXY(XLinks + Round(3.5 * DX) - 15,
  135.             Y1Unten + 10, XStrUnten);
  136.   FOR i := 0 TO 5 DO BEGIN
  137.     Line(XLinks - 5, Y1Unten - Round(i * MaxYWert / 5),
  138.          XLinks, Y1Unten-Round(i * MaxYWert / 5));
  139.     Str(i:2, HStr);
  140.     OutTextXY(XLinks - 40,
  141.               Y1Unten - Round((i * MaxYWert / 5) + 1),
  142.               HStr);
  143.   END;
  144.   OutTextXY(XLinks - 45, Y0Unten + Round(MaxYWert / 10),
  145.            YStrUnten);
  146. END;                                   { RahmenUndSoWeiter }
  147.  
  148. PROCEDURE Speichern;
  149. BEGIN
  150.   Sound(50);
  151.   DatenFileName := DatumUndZeitStr;
  152.   Dat.Kommentar := 'Signal und Fourierspektrum.';
  153.   Assign(DatFile, DatumUndZeitStr); ReWrite(DatFile);
  154.   Write(DatFile, Dat); Close(DatFile);
  155.   CH := 'x'; NoSound;
  156. END;                                           { Speichern }
  157.  
  158. PROCEDURE Laden;
  159. VAR HilfStr : STRING[12];
  160. BEGIN
  161.   ClrScr; GotoXY(10, 6);
  162.   Write('Datum des zu ladenden Signals (tt.mmj) > ');
  163.   ReadLn(DatenFileName);
  164.   GotoXY(10, 7);
  165.   Write('Uhrzeit des zu ladenden Signals (hhmmss) > ');
  166.   ReadLn(HilfStr);
  167.   DatenFileName := HilfStr + DatenFileName;
  168.   {$I-}
  169.   Assign(DatFile, DatenFileName); Reset(DatFile);
  170.   IF (IOResult <> 0) OR (DatenFileName = '') THEN BEGIN
  171.     WriteLn('Datei kann nicht geladen werden!', ^G);
  172.     Delay(1000);
  173.     DateiOK := FALSE;
  174.     Exit;
  175.   END;
  176.   DateiOK := TRUE; Read(DatFile, Dat);
  177.   {$I+}
  178.   Close(DatFile); GotoXY(10, 9);
  179.   WriteLn('Kommentar in ', DatenFileName, ' : ',
  180.           Dat.Kommentar);
  181.   GotoXY(10, 12); Write('Bitte <Return> drücken ');
  182.   ReadLn;
  183. END;                                               { Laden }
  184.  
  185. FUNCTION Fenster(i, FNr : INTEGER) : REAL;
  186. BEGIN
  187.   CASE FNr OF
  188.     0 : Fenster := 1;                           { Rechteck }
  189.     1 : Fenster := 1 - 2 *                      { Dreieck  }
  190.                    Abs(i - (MaxLaenge SHR 1)) / MaxLaenge;
  191.     2 : Fenster := 0.5  - 0.5  *                 { Hanning }
  192.                    Cos(2 * Pi * i / MaxLaenge);
  193.     3 : Fenster := 0.54 - 0.46 *                 { Hamming }
  194.                    Cos(2 * Pi * i / MaxLaenge);
  195.   END;
  196. END;                                             { Fenster }
  197.  
  198. PROCEDURE DatenLesen;
  199. VAR
  200.   i, k : INTEGER;
  201.   c    : REAL;
  202. BEGIN
  203.   IMR21 := Port[$21];                 { Interrupts sperren }
  204.   IMRA1 := Port[$A1];
  205.   Port[$21]:= $FF;
  206.   Port[$A1]:= $FF;
  207.                                    {  A/D-Wandler abfragen }
  208.   i := Port[$208];                 { 1. mal Initialisieren }
  209.   Delay(1);
  210.   FOR i := 0 TO MaxLaenge DO BEGIN
  211.     Dat.Signal[i] := Port[$208] * Fenster(i,0);
  212. { andere Fensterfunktion wird symmetrisch um 127 durch:    }
  213. { Dat.Signal[i] := 127+(PORT[$208]-255) * Fenster(i,3)/2;  }
  214. { Verzögerung zur Einstellung der Samplefrequenz           }
  215. { Justierung einfach nach 50 Hz-Brummen                    }
  216.     FOR k := 0 TO 3330 DO;
  217.   END;
  218.   Port[$21]:= IMR21;     { Alte Interrupts wieder zulassen }
  219.   Port[$A1]:= IMRA1;
  220. END;                                          { DatenLesen }
  221.  
  222. PROCEDURE SignalDarstellen;
  223. BEGIN
  224.   MaxWert := 255;   { Nicht auf das Signalmaximum normiert }
  225.   SetViewPort(XLinks + 1, Y0Oben + 1,
  226.               XRechts - 1, Y1Oben - 1, TRUE);
  227.   ClearViewPort;
  228.   SetViewPort(XLinks,Y0Oben,
  229.               XRechts, Y1Oben, TRUE);
  230.   Faktor := MaxYWert / MaxWert;
  231.   MoveTo(0, MaxYWert - Round(Dat.Signal[0] * Faktor));
  232.   FOR i := 1 TO MaxLaenge DO
  233.     LineTo(i SHL ShiftL,
  234.            MaxYWert - Round(Dat.Signal[i] * Faktor));
  235. END;                                    { SignalDarstellen }
  236.  
  237. PROCEDURE LookUpTable;
  238.  { Erstellt eine Tabelle für Sinus, Cosinus und Bit-Umkehr }
  239. VAR
  240.   Laenge, L12,
  241.   AdrNorm, AdrBRev  : INTEGER;
  242.   WinkelEinheit, Wi : REAL;
  243. BEGIN
  244.   WinkelEinheit := 2 * Pi / MaxLaenge; { Sinus und Cosinus }
  245.   L12 := MaxLaenge SHR 1;
  246.   FOR i := 0 TO L12 DO BEGIN
  247.     Wi := WinkelEinheit * i;
  248.            { Symetrieausnutzung bringt weiteren Zeitgewinn }
  249.     Sinus[i] := -Sin(Wi);  Sinus[L12 - i] :=  Sinus[i];
  250.     Sinus[L12 + i] := -Sinus[i];
  251.     Sinus[MaxLaenge - i] := -Sinus[i];
  252.     Cosinus[i] := Cos(Wi); Cosinus[L12 - i] := -Cosinus[i];
  253.     Cosinus[L12 + i] := -Cosinus[i];
  254.     Cosinus[MaxLaenge - i] := Cosinus[i];
  255.   END;
  256.   AdrBRev   := 0; BitRev[0] := 0;             { Bit-Umkehr }
  257.   FOR AdrNorm := 1 TO Pred(MaxLaenge) DO BEGIN
  258.     Laenge := MaxLaenge SHR 1;
  259.     WHILE AdrBRev + Laenge > Pred(MaxLaenge) DO
  260.       Laenge := Laenge SHR 1;
  261.     AdrBRev := AdrBRev MOD Laenge + Laenge;
  262.     IF AdrBRev > Pred(AdrNorm) THEN BEGIN
  263.        BitRev[AdrNorm] := AdrBRev;
  264.        BitRev[AdrBRev] := AdrNorm;
  265.     END;
  266.   END;
  267. END;                                         { LookUpTable }
  268.  
  269. PROCEDURE FFT( RealT : RealFeld );   { Hintransformation ! }
  270. VAR
  271.   TempReal, TempImag,
  272.   WichtungReal, WichtungImag : REAL;
  273.   TabNr, l, m, iSchritt      : INTEGER;
  274. BEGIN
  275.   FOR i := 0 TO Pred(MaxLaenge) DO BEGIN
  276.     RealTeil[i] := RealT[BitRev[i]];
  277.     ImagTeil[i] := 0;
  278.   END;
  279.   l := 1;                              { FFT - Algorithmus }
  280.   WHILE l < MaxLaenge DO BEGIN
  281.     iSchritt := l SHL 1;
  282.     FOR m := 1 TO l DO BEGIN
  283.       TabNr := Round(MaxLaenge SHR 1 DIV l) * Pred(m);
  284.       WichtungReal := Cosinus[TabNr];
  285.       WichtungImag := Sinus[TabNr];
  286.       i := Pred(m);
  287.       REPEAT
  288.         j := i + l;
  289.         TempReal := WichtungReal * RealTeil[j] -
  290.                     WichtungImag * ImagTeil[j];
  291.         TempImag := WichtungReal * ImagTeil[j] +
  292.                     WichtungImag * RealTeil[j];
  293.         RealTeil[j] := RealTeil[i] - TempReal;
  294.         ImagTeil[j] := ImagTeil[i] - TempImag;
  295.         RealTeil[i] := RealTeil[i] + TempReal;
  296.         ImagTeil[i] := ImagTeil[i] + TempImag;
  297.         i := i + iSchritt;
  298.       UNTIL i >= MaxLaenge
  299.     END;
  300.     l := iSchritt;
  301.   END;
  302. END;                                                 { FFT }
  303.  
  304. PROCEDURE SpektrumDarstellen;
  305. BEGIN
  306.   MaxWert := 1;
  307.   Dat.Spektrum[0] := 0;
  308.   FOR i := 0 TO MaxLaenge SHR 1 DO
  309.     IF Dat.Spektrum[i] > MaxWert THEN
  310.       MaxWert := Dat.Spektrum[i];
  311.   SetViewPort(XLinks + 1, Y0Unten + 1,
  312.               XRechts - 1, Y1Unten - 1, FALSE);
  313.   ClearViewPort;
  314.   SetViewPort(XLinks, Y0Unten,
  315.               XRechts, Y1Unten, TRUE);
  316.   Faktor := MaxYWert / MaxWert;
  317.   MoveTo(0, MaxYWert - Round(Dat.Spektrum[0] * Faktor));
  318.   FOR i := 1 TO MaxLaenge SHR 1 DO
  319.     LineTo(i SHL (ShiftL + 1),
  320.            MaxYWert - Round(Dat.Spektrum[i] * Faktor));
  321. END;                                  { SpektrumDarstellen }
  322.  
  323. BEGIN                                      { Hauptprogramm }
  324.                            { je nach Grafik-Karte anpassen }
  325.   XLinks   :=  50;                XRechts  := 562;
  326.   Y0Oben   :=  17;                Y1Oben   := 160;
  327.   MaxYWert := Y1Oben - Y0Oben;    Y0Unten  := 182;
  328.   Y1Unten  := Y0Unten + MaxYWert; ShiftL   := 0;
  329.   Hilf     := MaxLaenge;
  330.   WHILE Hilf < 512 DO BEGIN
  331.     Hilf := Hilf SHL 1; Inc(ShiftL);
  332.   END;
  333.   dXUnten := (64 SHR ShiftL) * 250 DIV dxOben;
  334.   FOR i := 0 TO MaxLaenge DO Dat.Signal[i] := 0;
  335.   WriteLn('Erstelle Look-up-table... ');
  336.   LookUpTable;
  337.   REPEAT
  338.     ClrScr; GotoXY(5, 2);
  339.     Write('***** H I R N S T R O M  Ver. 1.2  ' +
  340.           '(c) 1991 A. Bartels & toolbox *****');
  341.     GotoXY(5, 4);
  342.     WriteLn('Befehle : <M>-essen (<S>-peichern, <P>ause)');
  343.     WriteLn('              <L>-aden');
  344.     WriteLn('              <Q>-uit oder <Esc> : Ende ');
  345.     REPEAT
  346.     UNTIL KeyPressed;
  347.     CH:= ReadKey;
  348.     CASE UpCase(CH) OF
  349.       ' ',
  350.       'M': BEGIN
  351.              RahmenUndSoWeiter;
  352.              REPEAT
  353.                IF KeyPressed THEN
  354.                  CH := ReadKey;
  355.                CH := 'x';
  356.                DatenLesen; SignalDarstellen;
  357.                FFT(Dat.Signal);
  358.                Dat.Spektrum[0] := 0;
  359.                FOR i := 1 TO MaxLaenge SHR 1 DO
  360.                  Dat.Spektrum[i] := Sqrt(Sqr(RealTeil[i]) +
  361.                                     Sqr(ImagTeil[i]));
  362.                SpektrumDarstellen;
  363.                     { Wartet, ob's gespeichert werden soll }
  364.                Delay(1000);
  365.                IF KeyPressed THEN CH := ReadKey;
  366.                IF CH IN ['S', 's', ' '] THEN Speichern;
  367.                IF CH IN ['P','p'] THEN BEGIN
  368.                  REPEAT UNTIL KeyPressed;
  369.                  CH := ReadKey;
  370.                END;
  371.                UNTIL CH IN [#27, 'Q', 'q'];
  372.                CH := #0;
  373.                RestoreCrtMode;
  374.              END;
  375.       'L'  : BEGIN
  376.                Laden;
  377.                IF DateiOK THEN BEGIN
  378.                  RahmenUndSoWeiter;
  379.                  SignalDarstellen;
  380.                  SpektrumDarstellen;
  381.                  CH := ReadKey;
  382.                  RestoreCrtMode;
  383.                  CH := #0;
  384.                END;
  385.              END;
  386.     END;
  387.   UNTIL UpCase(CH) IN [#27, 'Q'];
  388.   RestoreCrtMode;
  389.   ClrScr;
  390. END.                                  { Hirn_Strom_Messung }
  391. (* ------------------------------------------------------ *)
  392. (*                Ende von HIRNSTR.PAS                    *)
  393.