home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Hacker Chronicles 2
/
HACKER2.BIN
/
157.GLOBAL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-03-17
|
19KB
|
439 lines
{----------------------------------------------------------------------------}
{- -}
{- These constant, types, variables and procedures are ones used -}
{- throughout the program. -}
{- -}
{- NOTE: To use the DOSCrt unit instead of the Crt unit, define DOSCrt -}
{- in the O/C/C menu option. This unit, while slower, will work -}
{- with the Cordata LP-300 laser printer. -}
{- -}
{----------------------------------------------------------------------------}
UNIT Global;
INTERFACE
USES
DOS,
Printer,
{$IFDEF DOSCrt}
DOSCrt,
{$ELSE}
Crt,
{$ENDIF}
{----------------------------------------------------------------------------}
{--- Define real data types dependent upon whether an 8087 is present ---}
{----------------------------------------------------------------------------}
Extended_Reals,
Graph,
DrawGraf,
TextOps;
CONST
{$IFDEF DOSCrt}
{$IFOPT N+}
VersionNumber = '3.09A-JF';
{$ELSE}
VersionNumber = '3.09AN-JF';
{$ENDIF}
{$ELSE}
{$IFOPT N+}
VersionNumber = '3.09-JF';
{$ELSE}
VersionNumber = '3.09N-JF';
{$ENDIF}
{$ENDIF}
{----------------------------------------------------------------------------}
{--- Version 'A' uses the DOSCrt unit. While slower than the Crt unit ---}
{--- otherwise used, this unit is compatible with the Cordata LP-300 ---}
{--- laser printers. NOTE: these routines do NOT seem to work on ---}
{--- Monichrome monitors. ---}
{----------------------------------------------------------------------------}
{--- Version 'N' does NOT use the 80x87 numeric coprocessor. This is ---}
{--- for machines not equipped with such, and is much slower than the ---}
{--- 80x87 versions, and much less accurate. ---}
{----------------------------------------------------------------------------}
{ Version 3.02 modified 11 Mar 88. (?) }
{ 1: Support for MODAS data files added since SPS BASIC formats }
{ numbers in a manner incompatible with Turbo Pascal. }
{ }
{ Version 3.03 modified 22 Mar 88. }
{ 1: Time delay added in CreateWaveform; }
{ 2: Exit to System changed to ESC key. }
{ }
{ Version 3.04 modified 25 Mar 88. }
{ 1: Support for DOSCrt unit added; }
{ 2: Screen title position corrected in graph printouts. }
{ }
{ Version 3.05 modified 15 Apr 88. }
{ 1: Changes made to DrawGraph routine to allow untyped pointers }
{ to arrays to be passed, instead of declaring new types in the }
{ calling program; }
{ 2: Main body of program cleaned up and main menu reorganized; }
{ 3: "Import DDT file" option deleted from FileIO menu. This filetype }
{ is no longer to be used; instead the Tektronix SPD "standard" }
{ waveform will be used in all future DDT programs. Support will }
{ be added for this filetype at a later date. (All FFT files will }
{ be of this type, once implemented.) }
{ }
{ Version 3.06 modified 15 Jun 88. }
{ (This was the version initially released to the public, after }
{ publication of my Technical Memorandum.) }
{ 1: Arithmetic overflow in Create Waveform options corrected. }
{ 2: New version number for no 8087 installed added }
{ ("N" in VersionNumber). }
{ 3: Header added with author and program name, version number, }
{ and TM number (HDL-TM_88-7) for documentation. }
{ }
{ Version 3.07 modified 30 Jun 88. }
{ 1. ReadText added to UNIT GraphText. This allows text to be read }
{ from the keyboard and echoed to a graphics screen. }
{ 2: Redundancy of Graphics initialization routine and variables }
{ removed from the main body of the program. }
{----------------------------------------------------------------------------}
{----------------------------------------------------------------------------}
{--- Definition of main data types ---}
{----------------------------------------------------------------------------}
CONST
TNArraySize = 2048; { max number of data points }
TYPE
TNVectorArray = ARRAY [0..TNArraySize] OF REAL;
TNVectorPtr = ^TNVectorArray;
VAR
time : TNVectorPtr; { time axis information }
ampl : TNVectorPtr; { amplitude of time domain data }
freq : TNVectorPtr; { frequency axis information }
mag : TNVectorPtr; { magnitude of freq domain data }
phase : TNVectorPtr; { phase of freq domain data }
{----------------------------------------------------------------------------}
{--- Default options; change these from the advanced options menu. ---}
{----------------------------------------------------------------------------}
CONST
BackColor : BYTE = Blue; { Background color on color monitor }
DrawColor : BYTE = 7; { Drawing color for color monitors }
ForeColor : BYTE = LightGreen; { Foreground color on color monitor }
NoPrinter : BOOLEAN = true; { Printer connected to computer? }
SerialPort : BYTE = 0; { Comm. port for digitizer. }
SPLINE : BOOLEAN = true; { Cubic Spline or Linear Interp.? }
DefaultDataDir : string[64] = 'c:'; { Default data disk/directory }
DefaultOptions = 'FFT.cfg'; { File for default options }
{----------------------------------------------------------------------------}
{--- System constants ---}
{----------------------------------------------------------------------------}
CONST
blank = ' '; { Blank string for info }
MaxInfo = 15; { Max num of info lines in file }
PI = 3.141592979431152; { PI, in double precision }
precision = 15; { Precision of output file }
StartColumn = 20; { Left edge of menus }
TNNearlyZero = 1e-15; { anything smaller than this is zero }
{----------------------------------------------------------------------------}
{--- Valid powers-of-two for interpolation routines ---}
{----------------------------------------------------------------------------}
CONST
MinPower = 9; { Min power of 2 to interpolate to }
MinP_Less1 = 8; { MinPower - 1 }
MaxPower = 12; { Max power of 2 to interpolate to }
Pow2 : ARRAY [MinP_Less1..MaxPower] OF INTEGER
= (256,512,1024,2048,4096); { 2^power }
{----------------------------------------------------------------------------}
TYPE
InfoArray = ARRAY [1..MaxInfo] OF string; { Desriptive info in file }
VAR
ACCEPT : BOOLEAN; { Interpolated data acceptable? }
Choice : CHAR; { temporary variable }
HeapTop : ^BYTE; { Marks top of dynamic memory. }
i : INTEGER; { Counter variable. }
info : InfoArray; { Array of information stored at }
{ End of data files. }
NumPoints : INTEGER; { Number of points read. }
NumFreqs : INTEGER; { Number of distinct frequencies. }
ORIG : BOOLEAN; { Original Data? }
OutArrayX : TNVectorPtr; { Temporary output ptr to TNVector. }
OutArrayY : TNVectorPtr; { Temporary output ptr to TNVector. }
TempXPtr : TNVectorPtr; { Temporary pointer to TNVector. }
TempYPtr : TNVectorPtr; { Temporary pointer to TNVector. }
TRANS : BOOLEAN; { Data Translated by FFT? }
XMaxTemp : INTEGER; { Used in window definitions }
YMaxTemp : INTEGER; { Used in window definitions }
{----------------------------------------------------------------------------}
PROCEDURE Initialize_Variables;
{----------------------------------------------------------------------------}
{- -}
{- ClearWindow is to clear a portion of the screen, from text -}
{- coordinates (XMin,YMin) in the upper left, to (XMax,YMax) in the -}
{- lower right. -}
{- -}
{----------------------------------------------------------------------------}
PROCEDURE ClearWindow ( XMin : BYTE; { first column to be erased }
YMin : BYTE; { last column to be erased }
XMax : BYTE; { first row to be erased }
YMax : BYTE { last row to be erased }
);
{----------------------------------------------------------------------------}
{- -}
{- Procedure Buzzer sounds a warning buzzer when an incorrect response -}
{- is given by the user. -}
{- -}
{----------------------------------------------------------------------------}
PROCEDURE Buzzer;
{----------------------------------------------------------------------------}
{- -}
{- MainMenu display the main system menu at the center of the screen. -}
{- -}
{----------------------------------------------------------------------------}
PROCEDURE MainMenu;
{----------------------------------------------------------------------------}
{- -}
{- Function EXIST determines if the specified filename already exists. -}
{- -}
{----------------------------------------------------------------------------}
FUNCTION EXIST (filename : string) : BOOLEAN;
{----------------------------------------------------------------------------}
{- -}
{- PrintErrorMsg prints the string s starting at text coordinates -}
{- (x,y). The message is surrounded by an error box. If wait is true, -}
{- then a char response ,resp, may be read before returning control -}
{- to the calling procedure. -}
{- -}
{----------------------------------------------------------------------------}
PROCEDURE PrintErrorMsg ( s : string;
x : BYTE;
y : BYTE;
wait : BOOLEAN;
VAR resp : CHAR
);
(****************************************************************************)
(****************************************************************************)
IMPLEMENTATION
PROCEDURE Initialize_Variables;
BEGIN {Initialize_Variables}
TRANS :=false;
ORIG :=false;
ACCEPT :=false;
Mark (HeapTop);
NEW (time);
NEW (ampl);
NEW (freq);
NEW (mag);
NEW (phase);
NEW (TempXPtr);
NEW (TempYPtr);
NEW (OutArrayX);
NEW (OutArrayY);
FillChar (info,SizeOf(info),0);
END; {Initialize_Variables}
{----------------------------------------------------------------------------}
{$IFDEF DOSCrt}
PROCEDURE ClearWindow ( XMin : BYTE; { first column to be erased }
YMin : BYTE; { last column to be erased }
XMax : BYTE; { first row to be erased }
YMax : BYTE { last row to be erased }
);
VAR
x : BYTE;
y : BYTE;
BEGIN {ClearWindow}
FOR y:=YMin TO YMax DO BEGIN
GotoXY (XMin,y);
FOR x:=XMin TO XMax DO Write (' ');
END; {FOR}
END; {ClearWindow}
{$ELSE}
PROCEDURE ClearWindow ( XMin : BYTE; { first column to be erased }
YMin : BYTE; { last column to be erased }
XMax : BYTE; { first row to be erased }
YMax : BYTE { last row to be erased }
);
VAR
CurrXMin : BYTE;
CurrYMin : BYTE;
CurrXMax : BYTE;
CurrYMax : BYTE;
BEGIN {ClearWindow}
CurrXMin:=succ(Lo(WindMin));
CurrYMin:=succ(Hi(WindMin));
CurrXMax:=succ(Lo(WindMax));
CurrYMax:=succ(Hi(WindMax));
Window (XMin,YMin,XMax,YMax);
ClrScr;
Window (CurrXMin,CurrYMin,CurrXMax,CurrYMax);
END; {ClearWindow}
{$ENDIF}
{----------------------------------------------------------------------------}
PROCEDURE Buzzer;
CONST
pitch = 440; { pitch of warning sound }
PauseLength = 250; { length of warning sound, in ms }
LongPauseLength = 1000; { additional time to display error msg }
BEGIN {Buzzer}
{$IFNDEF DOSCrt}
Sound (pitch);
Delay (PauseLength);
NoSound;
Delay (LongPauseLength);
{$ENDIF}
END; {Buzzer}
{----------------------------------------------------------------------------}
PROCEDURE MainMenu;
BEGIN {MainMenu}
IF GraphDriver <> HercMono THEN BEGIN
TextColor (ForeColor);
TextBackground (BackColor);
END; {IF}
ClrScr;
GotoXY (StartColumn+8,3); Write ('FFT Main Menu (',VersionNumber,')');
GotoXY (StartColumn,5); Write ('Select Option by typing a number:');
GotoXY (StartColumn+8,8); Write ('1. Create Waveform ');
GotoXY (StartColumn+8,10); Write ('2. Retrieve/Save Data ');
GotoXY (StartColumn+8,12); Write ('3. Signal Processing ');
GotoXY (StartColumn+8,14); Write ('4. Graph Results ');
GotoXY (StartColumn+8,16); Write ('5. Advanced Options ');
GotoXY (StartColumn+8,18); Write ('6. Digitizer ');
GotoXY (StartColumn+4,25); Write ('[ESC - Exit to System] ');
GotoXY (StartColumn,21); Write ('Your Choice? ');
REPEAT
Choice:=ReadKey;
UNTIL (Choice IN ['1'..'6',ESC]);
Write (Choice);
END; {MainMenu}
{----------------------------------------------------------------------------}
FUNCTION EXIST (filename : string) : BOOLEAN;
VAR
OK : BOOLEAN; { temporary variable, equal to exist }
Name : text;
BEGIN {EXIST}
IF length (filename) > 0
THEN BEGIN
Assign (Name,filename);
{$I-} Reset (Name); {$I+}
OK:=(IOresult=0);
exist:=OK;
IF OK THEN Close (Name);
END {THEN}
ELSE EXIST:=false;
END; {EXIST}
{----------------------------------------------------------------------------}
PROCEDURE PrintErrorMsg ( s : string;
x : BYTE;
y : BYTE;
wait : BOOLEAN;
VAR resp : CHAR
);
CONST
PauseLength = 1000;
VAR
CurrMinX : BYTE;
CurrMinY : BYTE;
CurrMaxX : BYTE;
BEGIN {PrintErrorMsg}
CurrMinX:=x-2;
CurrMinY:=y-1;
CurrMaxX:=CurrMinX+length(s)+4;
IF wait THEN INC(CurrMaxX,1);
TextColor (White);
TextBackground (Red);
ClearWindow (CurrMinX,CurrMinY,CurrMaxX,CurrMinY+2);
DrawBorder (CurrMinX,CurrMinY,CurrMaxX,CurrMinY+2);
WriteXY (s,x,CurrMinY+1);
Buzzer;
IF NOT wait
THEN Delay (PauseLength)
ELSE resp:=ReadKey;
TextColor (ForeColor);
TextBackground (BackColor);
ClearWindow (CurrMinX,CurrMinY,CurrMaxX,CurrMinY+2);
END; {PrintErrorMsg}
(****************************************************************************)
VAR
ch : CHAR;
BEGIN {Initialization}
TextColor (ForeColor);
TextBackground (BackColor);
ClrScr;
DrawBorder (15,10,65,14);
WriteXY ('FFT - Waveform Analysis Program - '+VersionNumber,21,12);
WriteXY ('Written by Jeff Falter, Harry Diamond Laboratories.',15,19);
WriteXY ('Documentation for this program can be found in HDL-TM-88-7.',11,20);
TextColor (ForeColor+Blink);
WriteXY ('Press any key to continue ...',26,25);
ch:=ReadKey;
END. {UNIT Global}