unit LinearSystem; interface {============== WAV Format Coding Type ==================} type WAVHeader = record nChannels : Word; nBitsPerSample : LongInt; nSamplesPerSec : LongInt; nAvgBytesPerSec : LongInt; RIFFSize : LongInt; fmtSize : LongInt; formatTag : Word; nBlockAlign : LongInt; DataSize : LongInt; end; {============== Sample DataStreams ========================} const MaxN = 300; { max number of sample values } type SampleIndex = 0 .. MaxN+3; type DataStream = array[ SampleIndex ] of Real; var N : SampleIndex; {============== Observation Variables ======================} type Observation = record Name : String[40]; {Name of this observat ion} yyy : DataStream; {Array of data points} WAV : WAVHeader; {WAV specs for observa tion} Last : SampleIndex;{Last valid index to y yy} MinO, MaxO : Real; {Range values from yyy } end; var K0R, K1R, K2R, K3R : Observation; K0B, K1B, K2B, K3B : Observation; {================== File Name Variables ===================} var StandardDatabase : String[ 80 ]; BaseFileName : String[ 80 ]; StandardOutput : String[ 80 ]; StandardInput : String[ 80 ]; {=============== Operations ==================} procedure ReadWAVFile (var Ki, Kj : Observation); procedure WriteWAVFile(var Ki, Kj : Observation); procedure ScaleData (var Kk : Observation); procedure InitAllSignals; procedure InitLinearSystem; implementation {$R *.DFM} uses VarGraph, SysUtils; {================== Standard WAV File Format ===================} const MaxDataSize : LongInt = (MaxN+1)*2*2; const MaxRIFFSize : LongInt = (MaxN+1)*2*2+36; const StandardWAV : WAVHeader = ( nChannels : Word(2); nBitsPerSample : LongInt(16); nSamplesPerSec : LongInt(8000); nAvgBytesPerSec : LongInt(32000); RIFFSize : LongInt((MaxN+1)*2*2+36); fmtSize : LongInt(16); formatTag : Word(1); nBlockAlign : LongInt(4); DataSize : LongInt((MaxN+1)*2*2) ); {================== Scale Observation Data ===================} procedure ScaleData(var Kk : Observation); var I : SampleIndex; begin {Initialize the scale values} Kk.MaxO := Kk.yyy[0]; Kk.MinO := Kk.yyy[0]; {Then scan for any higher or lower values} for I := 1 to Kk.Last do begin if Kk.MaxO < Kk.yyy[I] then Kk.MaxO := Kk.yyy[I]; if Kk.MinO > Kk.yyy[I] then Kk.MinO := Kk.yyy[I]; end; end; { ScaleData } procedure ScaleAllData; begin ScaleData(K0R); ScaleData(K0B); ScaleData(K1R); ScaleData(K1B); ScaleData(K2R); ScaleData(K2B); ScaleData(K3R); ScaleData(K3B); end; {ScaleAllData} {================== WAV Data I/O ===================} VAR InFile, OutFile : file of Byte; type Tag = (F0, T1, M1); type FudgeNum = record case X:Tag of F0 : (chrs : array[0..3] of Byte); T1 : (lint : LongInt); M1 : (up,dn: Integer); end; var ChunkSize : FudgeNum; procedure WriteChunkName(Name:String); var i : Integer; MM : Byte; begin for i := 1 to 4 do begin MM := ord(Name[i]); write(OutFile,MM); end; end; {WriteChunkName} procedure WriteChunkSize(LL:Longint); var I : integer; begin ChunkSize.x:=T1; ChunkSize.lint:=LL; ChunkSize.x:=F0; for I := 0 to 3 do Write(OutFile,ChunkSize.chrs[I]); end; procedure WriteChunkWord(WW:Word); var I : integer; begin ChunkSize.x:=T1; ChunkSize.up:=WW; ChunkSize.x:=M1; for I := 0 to 1 do Write(OutFile,ChunkSize.chrs[I]); end; {WriteChunkWord} procedure WriteOneDataBlock(var Ki, Kj : Observation); var I : Integer; begin ChunkSize.x:=M1; with Ki.WAV do begin case nChannels of 1:if nBitsPerSample=16 then begin {1..2 16-bit samples in buffer for one channel} ChunkSize.up := trunc(Ki.yyy[N]+0.5); if N .5); N := N+2; end else begin {1..4 8-bit samples in buffer for one channel} for I:=0 to 3 do ChunkSize.chrs[I] := trunc(Ki.yyy[N+I]+0.5); N := N+4; end; 2:if nBitsPerSample=16 then begin {2 16-bit samples on two channels} ChunkSize.dn := trunc(Ki.yyy[N]+0.5); ChunkSize.up := trunc(Kj.yyy[N]+0.5); N := N+1; end else begin {4 8-bit samples on two channels} ChunkSize.chrs[1] := trunc(Ki.yyy[N]+0.5); ChunkSize.chrs[3] := trunc(Ki.yyy[N+1]+0.5); ChunkSize.chrs[0] := trunc(Kj.yyy[N]+0.5); ChunkSize.chrs[2] := trunc(Kj.yyy[N+1]+0.5); N := N+2; end; end; {with WAV do begin..} end; {the four-byte variable "ChunkSize" has now been filled} ChunkSize.x:=T1; WriteChunkSize(ChunkSize.lint);{put 4 bytes of data} end; {WriteOneDataBlock} procedure WriteWAVFile(var Ki, Kj : Observation); var MM : Byte; I : Integer; OK : Boolean; begin {Prepare to write a file of data} AssignFile(OutFile, StandardOutput); { File selected in dialog } ReWrite( OutFile ); With Ki.WAV do begin DataSize := nChannels*(nBitsPerSample div 8)*(Ki.Last+1); RIFFSize := DataSize+36; fmtSize := 16; end; {Write ChunkName "RIFF"} WriteChunkName('RIFF'); {Write ChunkSize} WriteChunkSize(Ki.WAV.RIFFSize); {Write ChunkName "WAVE"} WriteChunkName('WAVE'); {Write tag "fmt_"} WriteChunkName('fmt '); {Write ChunkSize} Ki.WAV.fmtSize := 16; {should be 16-18} WriteChunkSize(Ki.WAV.fmtSize); {Write formatTag, nChannels} WriteChunkWord(Ki.WAV.formatTag); WriteChunkWord(Ki.WAV.nChannels); {Write nSamplesPerSec} WriteChunkSize(Ki.WAV.nSamplesPerSec); {Write nAvgBytesPerSec} WriteChunkSize(Ki.WAV.nAvgBytesPerSec); {Write nBlockAlign, nBitsPerSample} WriteChunkWord(Ki.WAV.nBlockAlign); WriteChunkWord(Ki.WAV.nBitsPerSample); {WriteDataBlock tag "data"} WriteChunkName('data'); {Write DataSize} WriteChunkSize(Ki.WAV.DataSize); N:=0; {first write-out location} while N<=Ki.Last do WriteOneDataBlock(Ki,Kj); {put 4 bytes & incr ement N} {Free the file buffers} CloseFile( OutFile ); end; {WriteWAVFile} procedure InitSpecs; begin end; { InitSpecs } procedure InitSignals(var Kk : Observation); var J : Integer; begin for J := 0 to MaxN do Kk.yyy[J] := 0.0; Kk.MinO := 0.0; Kk.MaxO := 0.0; Kk.Last := MaxN; end; {InitSignals} procedure InitAllSignals; begin InitSignals(K0R); InitSignals(K0B); InitSignals(K1R); InitSignals(K1B); InitSignals(K2R); InitSignals(K2B); InitSignals(K3R); InitSignals(K3B); end; {InitAllSignals} var ChunkName : string[4]; procedure ReadChunkName; var I : integer; MM : Byte; begin ChunkName[0]:=chr(4); for I := 1 to 4 do begin Read(InFile,MM); ChunkName[I]:=chr(MM); end; end; {ReadChunkName} procedure ReadChunkSize; var I : integer; MM : Byte; begin ChunkSize.x := F0; ChunkSize.lint := 0; for I := 0 to 3 do begin Read(InFile,MM); ChunkSize.chrs[I]:=MM; end; ChunkSize.x := T1; end; {ReadChunkSize} procedure ReadOneDataBlock(var Ki,Kj:Observation); var I : Integer; begin if N<=MaxN then begin ReadChunkSize; {get 4 bytes of data} ChunkSize.x:=M1; with Ki.WAV do case nChannels of 1:if nBitsPerSample=16 then begin {1..2 16-bit samples in buffer for one channel} Ki.yyy[N] :=1.0*ChunkSize.up; if N N := N+2; end else begin {1..4 8-bit samples in buffer for one channel} for I:=0 to 3 do Ki.yyy[N+I]:=1.0*ChunkSize.chrs[I ]; N := N+4; end; 2:if nBitsPerSample=16 then begin {2 16-bit samples on two channels} Ki.yyy[N]:=1.0*ChunkSize.dn; Kj.yyy[N]:=1.0*ChunkSize.up; N := N+1; end else begin {4 8-bit samples on two channels} Ki.yyy[N] :=1.0*ChunkSize.chrs[1]; Ki.yyy[N+1]:=1.0*ChunkSize.chrs[3]; Kj.yyy[N] :=1.0*ChunkSize.chrs[0]; Kj.yyy[N+1]:=1.0*ChunkSize.chrs[2]; N := N+2; end; end; if N<=MaxN then begin {LastN := N;} Ki.Last := N; if Ki.WAV.nChannels=2 then Kj.Last := N; end else begin {LastN := MaxN;} Ki.Last := MaxN; if Ki.WAV.nChannels=2 then Kj.Last := MaxN ; end; end; end; {ReadOneDataBlock} procedure ReadWAVFile(var Ki, Kj :Observation); var MM : Byte; I : Integer; OK : Boolean; NoDataYet : Boolean; DataYet : Boolean; nDataBytes : LongInt; begin if FileExists(StandardInput) then with Ki.WAV do begin { Bring up open file dialog } OK := True; {unless changed somewhere below} {Prepare to read a file of data} AssignFile(InFile, StandardInput); { File selected in dialog } Reset( InFile ); {Read ChunkName "RIFF"} ReadChunkName; if ChunkName<>'RIFF' then OK := False; {Read ChunkSize} ReadChunkSize; RIFFSize := ChunkSize.lint; {should be 18,678} {Read ChunkName "WAVE"} ReadChunkName; if ChunkName<>'WAVE' then OK := False; {Read ChunkName "fmt_"} ReadChunkName; if ChunkName<>'fmt ' then OK := False; {Read ChunkSize} ReadChunkSize; fmtSize := ChunkSize.lint; {should be 18} {Read formatTag, nChannels} ReadChunkSize; ChunkSize.x := M1; formatTag := ChunkSize.up; nChannels := ChunkSize.dn; {Read nSamplesPerSec} ReadChunkSize; nSamplesPerSec := ChunkSize.lint; {Read nAvgBytesPerSec} ReadChunkSize; nAvgBytesPerSec := ChunkSize.lint; {Read nBlockAlign} ChunkSize.x := F0; ChunkSize.lint := 0; for I := 0 to 3 do begin Read(InFile,MM); ChunkSize.chrs[I]:=MM; end; ChunkSize.x := M1; nBlockAlign := ChunkSize.up; {Read nBitsPerSample} nBitsPerSample := ChunkSize.dn; for I := 17 to fmtSize do Read(InFile,MM); NoDataYet := True; while NoDataYet do begin begin {Read tag "data"} ReadChunkName; {Read DataSize} ReadChunkSize; DataSize := ChunkSize.lint; if ChunkName<>'data' then begin for I := 1 to DataSize do {skip over any nondata stuff} Read(InFile,MM); end else NoDataYet := False; end; nDataBytes := DataSize; {Finally, start reading data for nDataBytes bytes} if nDataBytes>0 then DataYet := True; N:=0; {first read-in location} while DataYet do begin ReadOneDataBlock(Ki,Kj); {get 4 bytes} nDataBytes := nDataBytes-4; if nDataBytes<=4 then DataYet := False; end; ScaleData(Ki); if Ki.WAV.nChannels=2 then begin Kj.WAV := Ki.WAV; ScaleData(Kj); end; {Free the file buffers} CloseFile( InFile ); end else begin InitSpecs;{file does not exist} InitSignals(Ki);{zero "Ki" array} InitSignals(Kj);{zero "Kj" array} end; end; { ReadWAVFile } {================= Database Operations ====================} const MaxNumberOfDataBaseItems = 360; type SignalDirectoryIndex = 0 .. MaxNumberOfDataBaseItems; VAR DataBaseFile : file of Observation; LastDataBaseItem : LongInt; {Current number of database items} ItemNameS : array[SignalDirectoryIndex] of String[40]; procedure GetDatabaseItem( Kk : Observation; N : LongInt ); begin if N<=LastDataBaseItem then begin Seek(DataBaseFile, N); Read(DataBaseFile, Kk); end else InitSignals(Kk); end; {GetDatabaseItem} procedure PutDatabaseItem( Kk : Observation; N : LongInt ); begin if N then then if N<=LastDataBaseItem then begin Seek(DataBaseFile, N); Write(DataBaseFile, Kk); LastDataBaseItem := LastDataBaseItem+1; end else while LastDataBaseItem<=N do begin Seek(DataBaseFile, LastDataBaseItem); Write(DataBaseFile, Kk); LastDataBaseItem := LastDataBaseItem+1; end else ReportError(1); {Attempt to read beyond MaxNumberOfDataBaseItems } end; {PutDatabaseItem} procedure InitDataBase; begin LastDataBaseItem := 0; if FileExists(StandardDataBase) then begin begin Assign(DataBaseFile,StandardDataBase); Reset(DataBaseFile); while not EOF(DataBaseFile) do begin GetDataBaseItem(K0R, LastDataBaseItem); ItemNameS[LastDataBaseItem] := K0R.Name; LastDataBaseItem := LastDataBaseItem+1; end; if EOF(DataBaseFile) then if LastDataBaseItem>0 then LastDataBaseItem := LastDataBaseItem-1; end; end; {InitDataBase} function FindDataBaseName( Nstg : String ):LongInt; var ThisOne : LongInt; begin ThisOne := 0; FindDataBaseName := -1; while ThisOne begin if Nstg=ItemNameS[ThisOne] then begin FindDataBaseName := ThisOne; Exit; end; ThisOne := ThisOne+1; end; end; {FindDataBaseName} {======================= Init Unit ========================} procedure InitLinearSystem; begin BaseFileName := '\PROGRA~1\SIGNAL~1\'; StandardOutput := BaseFileName + 'K0.wav'; StandardInput := BaseFileName + 'K0.wav'; StandardDataBase := BaseFileName + 'Radar.sdb'; InitAllSignals; InitDataBase; ReadWAVFile(K0R,K0B); ScaleAllData; end; {InitLinearSystem} begin {unit initialization code} InitLinearSystem; end. {Unit LinearSystem} |