home *** CD-ROM | disk | FTP | other *** search
/ Hacker Chronicles 2 / HACKER2.BIN / 137.CREATEWA.PAS < prev    next >
Pascal/Delphi Source File  |  1988-06-15  |  10KB  |  327 lines
  1. UNIT CreateWaveform;
  2.  
  3. INTERFACE
  4. USES
  5. {$IFDEF DOSCrt}
  6.    DOSCrt,
  7. {$ELSE}
  8.    Crt,
  9. {$ENDIF}
  10.    Extended_Reals,
  11.    TextOps,
  12.    Global,
  13.    GraphWaveform;
  14.  
  15. PROCEDURE AnalyticWaveform;
  16.  
  17.  
  18. (****************************************************************************)
  19.  
  20. IMPLEMENTATION
  21.  
  22. CONST
  23. {$IFOPT N-}
  24.    TestValue = 85;
  25. {$ELSE}
  26.    TestValue = 10000;
  27. {$ENDIF}
  28.  
  29. VAR
  30.    ch : CHAR;
  31.  
  32. PROCEDURE AnalyticMenu;
  33.  
  34.    BEGIN   {AnalyticMenu}
  35.       ClrScr;
  36.       WriteXY ('Create Waveform Menu',StartColumn+8,3);
  37.       WriteXY ('Select waveform to create by typing a number.',
  38.                                               StartColumn,5);
  39.       WriteXY ('1. Damped Sine Wave       ',StartColumn+8,8);
  40.       WriteXY ('2. EMP Double Exponential ',StartColumn+8,10);
  41.       WriteXY ('3. Reciprocal Double Exponential',StartColumn+8,12);
  42.       WriteXY ('4. General Exponential Sum',StartColumn+8,14);
  43.       WriteXY ('9. Exit to Main Menu      ',StartColumn+8,16);
  44.       WriteXY ('Your Choice? ',StartColumn+8,24);
  45.       REPEAT
  46.          ch:=ReadKey;
  47.       UNTIL (ch IN ['1'..'4','9']);
  48.       IF ch <> '9' THEN BEGIN
  49.          NumPoints:=TNArraySize;
  50.          NumFreqs :=TNArraySize div 2;
  51.       END;   {IF}
  52.    END;   {AnalyticMenu}
  53.  
  54. {----------------------------------------------------------------------------}
  55.  
  56. PROCEDURE MakeDampSine;
  57.  
  58.    VAR
  59.       i      : INTEGER;
  60.       t0     : REAL;
  61.       A      : REAL;
  62.       alpha  : REAL;
  63.       t      : REAL;
  64.       beta   : REAL;
  65.       cycles : REAL;
  66.       phi    : REAL;
  67.       dummy  : string;
  68.       first  : REAL;
  69.  
  70.    BEGIN   {MakeDampSine}
  71.       WriteXY ('Damped Sine Wave',StartColumn+8,2);
  72.       WriteXY ('This wave is of the form   ',1,5);
  73.       Write ('A · exp(-α(t-t0)) · sin(2πf(t-t0) + φ).');
  74.       REPEAT
  75.          WriteXY ('Period of wave =            ',1,8);
  76.          GotoXY (18,8); ReadLn (dummy);
  77.          IF dummy = '' THEN dummy:='0';
  78.          String_to_Value (dummy,beta,dummy);
  79.       UNTIL (beta <> 0);
  80.       REPEAT
  81.          WriteXY ('Number of cycles =          ',1,10);
  82.          GotoXY (20,10); ReadLn (dummy);
  83.          IF dummy = '' THEN dummy:='0';
  84.          String_to_Value (dummy,cycles,dummy);
  85.       UNTIL (cycles <> 0);
  86.       WriteXY ('Time delay, t0 =           ',1,12);
  87.       GotoXY (18,12); ReadLn (dummy);
  88.       IF dummy = '' THEN dummy:='0';
  89.       String_to_Value (dummy,t0,dummy);
  90.       REPEAT
  91.          WriteXY ('A =           ',1,14);
  92.          GotoXY (5,14); ReadLn (dummy);
  93.          IF dummy = '' THEN dummy:='0';
  94.          String_to_Value (dummy,A,dummy);
  95.       UNTIL (A <> 0);
  96.       WriteXY ('α = ',1,16); ReadLn (dummy);
  97.       IF dummy = '' THEN dummy:='0';
  98.       String_to_Value (dummy,alpha,dummy);
  99.       WriteXY ('φ (in degrees) = ',1,18); ReadLn (dummy);
  100.       IF dummy = '' THEN dummy:='0';
  101.       String_to_Value (dummy,phi,dummy);
  102.       phi:=phi*pi/180;
  103.       FOR i:=0 TO NumPoints-1 DO BEGIN
  104.          t:=beta*i*cycles/(NumPoints-1)+t0;
  105.          time^[i]:=t;
  106.          IF (alpha*(t-t0) > TestValue)
  107.             THEN first:=0
  108.             ELSE first:=EXP(-alpha*(t-t0));
  109.          ampl^[i]:=A*first*SIN(2*PI*(t-t0)/beta+phi);
  110.       END;   {FOR}
  111.    END;   {MakeDampSine}
  112.  
  113. {----------------------------------------------------------------------------}
  114.  
  115. PROCEDURE MakeDoubleExp;
  116.  
  117.    VAR
  118.       ch        : CHAR;
  119.       i         : INTEGER;
  120.       t0        : REAL;
  121.       A         : REAL;
  122.       alpha     : REAL;
  123.       t         : REAL;
  124.       beta      : REAL;
  125.       timeofmax : REAL;
  126.       maxtime   : REAL;
  127.       dummy     : string;
  128.       first     : REAL;
  129.       second    : REAL;
  130.  
  131.    BEGIN   {MakeDoubleExp}
  132.       WriteXY ('EMP Double Exponential',StartColumn+8,2);
  133.       WriteXY ('This wave is of the form   ',1,5);
  134.       Write ('A · [exp(-α·t) - exp(-ß·t)].');
  135.       REPEAT
  136.          WriteXY ('Maximum amplitude = ',1,8); ReadLn (dummy);
  137.          IF dummy = '' THEN dummy:='0';
  138.          String_to_Value (dummy,A,dummy);
  139.       UNTIL (A <> 0);
  140.       REPEAT
  141.          WriteXY ('risetime =           ',1,10);
  142.          GotoXY (12,10); ReadLn (dummy);
  143.          IF dummy = '' THEN dummy:='0';
  144.          String_to_Value (dummy,beta,dummy);
  145.       UNTIL (beta > 0);
  146.       REPEAT
  147.          WriteXY ('falltime =            ',1,12);
  148.          GotoXY (12,12); ReadLn (dummy);
  149.          IF dummy = '' THEN dummy:='0';
  150.          String_to_Value (dummy,alpha,dummy);
  151.       UNTIL (alpha > 0);
  152.       maxtime:=3*alpha;
  153.       alpha:=LN(10)/alpha;
  154.       beta :=LN(9) /beta;
  155.       timeofmax:=LN(beta/alpha)/(beta-alpha);
  156.       A:=A/(EXP(-alpha*timeofmax)-EXP(-beta*timeofmax));
  157.       FOR i:= 0 TO NumPoints-1 DO BEGIN
  158.          t:=maxtime*i/(NumPoints-1);
  159.          time^[i]:=t;
  160.          IF alpha*t > TestValue
  161.             THEN first:=0
  162.             ELSE first:=EXP(-alpha*t);
  163.          IF beta*t > TestValue
  164.             THEN second:=0
  165.             ELSE second:=EXP(-beta*t);
  166.          ampl^[i]:=A*(first-second);
  167.       END;   {FOR}
  168.    END;   {MakeDoubleExp}
  169.  
  170. {----------------------------------------------------------------------------}
  171.  
  172. PROCEDURE MakeRecipDoubleExp;
  173.  
  174.    VAR
  175.       i     : INTEGER;
  176.       A     : REAL;
  177.       alpha : REAL;
  178.       b     : REAL;
  179.       t     : REAL;
  180.       beta  : REAL;
  181.       t0    : REAL;
  182.       dummy : string;
  183.  
  184.    BEGIN   {MakeRecipDoubleExp}
  185.       WriteXY ('Reciprocal Double Exponential',StartColumn+8,2);
  186.       WriteXY ('This wave is of the form   ',1,5);
  187.       Write ('A / {exp[α·(t-t0)] - exp[ß·(t-t0)]}.');
  188.       WriteXY ('Initial time = ',1,8); ReadLn (dummy);
  189.       String_to_Value (dummy,t0,dummy);
  190.       WriteXY ('Maximum time = ',1,10); ReadLn (dummy);
  191.       String_to_Value (dummy,beta,dummy);
  192.       WriteXY ('A = ',1,12); ReadLn (dummy);
  193.       String_to_Value (dummy,A,dummy);
  194.       WriteXY ('α = ',1,14); ReadLn (dummy);
  195.       String_to_Value (dummy,alpha,dummy);
  196.       WriteXY ('ß = ',1,16); ReadLn (dummy);
  197.       String_to_Value (dummy,b,dummy);
  198.       FOR i:=0 TO NumPoints-1 DO BEGIN
  199.          t:=beta*i/(NumPoints-1);
  200.          time^[i]:=t;
  201.          IF ((alpha*(t-t0) > TestValue) OR (b*(t-t0) > TestValue))
  202.             THEN ampl^[i]:=0
  203.             ELSE ampl^[i]:=A/(EXP(alpha*(t-t0))-EXP(b*(t-t0)));
  204.       END;   {FOR}
  205.    END;   {MakeRecipDoubleExp}
  206.  
  207. {----------------------------------------------------------------------------}
  208.  
  209. PROCEDURE MakeGeneralSum;
  210.  
  211.    VAR
  212.       i        : INTEGER;
  213.       j        : INTEGER;
  214.       A        : REAL;
  215.       alpha    : REAL;
  216.       t        : REAL;
  217.       t0       : REAL;
  218.       beta     : REAL;
  219.       NumTerms : INTEGER;
  220.       dummy    : string;
  221.  
  222.    BEGIN   {MakeGeneralSum}
  223.       WriteXY ('General Exponential Sum',StartColumn+8,2);
  224.       WriteXY ('This wave is of the form   ',1,5);
  225.       Write ('SUM A·exp(α·(t-t0)).');
  226.       REPEAT
  227.          WriteXY ('Maximum time =                  ',1,8);
  228.          GotoXY (16,8); ReadLn (dummy);
  229.          IF dummy = '' THEN dummy:='0';
  230.          String_to_Value (dummy,beta,dummy);
  231.       UNTIL (beta > 0);
  232.       WriteXY ('Time delay, t0 =           ',1,10);
  233.       GotoXY (18,10); ReadLn (dummy);
  234.       IF dummy = '' THEN dummy:='0';
  235.       String_to_Value (dummy,t0,dummy);
  236.       FOR i:=0 TO NumPoints-1 DO BEGIN
  237.          t:=beta*i/(NumPoints-1)+t0;
  238.          time^[i]:=t;
  239.          ampl^[i]:=0;
  240.       END;   {FOR}
  241.       WriteXY ('Number of exponential terms:        ',1,12);
  242.       GotoXY (30,12); ReadLn (dummy);
  243.       IF dummy = '' THEN dummy:='0';
  244.       String_to_Value (dummy,t,dummy);
  245.       NumTerms:=round(t);
  246.       ORIG:=FALSE;
  247.       FOR i:=1 TO NumTerms DO BEGIN
  248.          GotoXY (1,16); ClrEOL;
  249.          GotoXY (1,18); ClrEOL;
  250.          GotoXY (1,14); WriteLn ('Exponential term #',i);
  251.          WriteXY ('A = ',5,16); ClrEOL; ReadLn (dummy);
  252.          IF dummy = '' THEN dummy:='0';
  253.          String_to_Value (dummy,A,dummy);
  254.          IF NOT ORIG THEN IF A <> 0 THEN ORIG:=TRUE;
  255.          WriteXY ('α = ',5,18); ClrEOL; ReadLn (dummy);
  256.          IF dummy = '' THEN dummy:='0';
  257.          String_to_Value (dummy,alpha,dummy);
  258.          FOR j:=0 TO NumPoints-1 DO IF (alpha*(time^[j]-t0) > TestValue)
  259.             THEN ampl^[j]:=A*EXP(TestValue)           + ampl^[j]
  260.             ELSE ampl^[j]:=A*EXP(alpha*(time^[j]-t0)) + ampl^[j];
  261.       END;   {FOR}
  262.    END;   {MakeGeneralSum}
  263.  
  264. {----------------------------------------------------------------------------}
  265.  
  266. PROCEDURE AddNoise;
  267.  
  268.    VAR
  269.       ch    : CHAR;            (* Add noise?                     *)
  270.       dummy : string;          (* Scale value of noise           *)
  271.       Scale : REAL;            (* Scale value of noise           *)
  272.       max_r : REAL;            (* Max value of waveform          *)
  273.       max_i : INTEGER;         (* Index of max value of waveform *)
  274.       i     : INTEGER;         (* Counter variable               *)
  275.       noise : REAL;
  276.  
  277.    BEGIN   {AddNoise}
  278.       WriteXY ('Add noise to waveform (y/n)? ',1,20);
  279.       REPEAT
  280.          ch:=UpCase(ReadKey);
  281.       UNTIL (ch IN ['Y','N',ENTER]);
  282.       IF (ch = ENTER)
  283.          THEN Write ('N')
  284.          ELSE Write (ch);
  285.       IF (ch = 'Y') THEN BEGIN
  286.          WriteXY ('Signal-to-Noise ratio (dB) = ',1,22); ReadLn (dummy);
  287.          IF dummy = ''
  288.             THEN Scale:=1000
  289.             ELSE String_to_Value (dummy,Scale,dummy);
  290.          max_i:=0;
  291.          FOR i:=1 TO NumPoints-1 DO
  292.             IF ampl^[i] > ampl^[max_i] THEN max_i:=i;
  293.          max_r:=ampl^[max_i];
  294.          Scale:=max_r*EXP((-Scale/10)*LN(10));   {converts dB to real #}
  295.          Randomize;
  296.          FOR i:=0 TO NumPoints-1 DO BEGIN
  297.             noise:=Scale*random;
  298.             ampl^[i]:=ampl^[i]+noise;
  299.          END;   {FOR}
  300.       END;   {IF}
  301.    END;   {AddNoise}
  302.  
  303. {----------------------------------------------------------------------------}
  304.  
  305. PROCEDURE AnalyticWaveform;
  306.  
  307.    BEGIN   {AnalyticWaveform}
  308.       AnalyticMenu;
  309.       ClrScr;
  310.       CASE ch OF
  311.          '1': MakeDampSine;
  312.          '2': MakeDoubleExp;
  313.          '3': MakeRecipDoubleExp;
  314.          '4': MakeGeneralSum;
  315.          '9': Exit;
  316.       END;   {CASE}
  317.       AddNoise;
  318.       TRANS:=FALSE;
  319.       ACCEPT:=TRUE;
  320.       ORIG:=TRUE;
  321.       GraphResults ('T');
  322.    END;   {AnalyticWaveform}
  323.  
  324. (****************************************************************************)
  325.  
  326. BEGIN   {Initialization}
  327. END.   {UNIT CreateWaveform}