RAMSES Auxiliary Library Modules
Copyright (c) 1986-2007 by Andreas Fischlin, Olivier Roth, Dimitrios Gyalistras,
Alex Itten, Markus Ulrich, Juerg Thoeny, Thomas Nemecek, Christian Pfister,
Frank Thommen, Harald Bugmann, Reiner Zah and ETH Zurich.
mailto://RAMSES@env.ethz.ch http://www.sysecol.ethz.ch/
(*********************************************************************)
(*##### S Y S T E M S E C O L O G Y M O D U L E S #####*)
(*********************************************************************)
The following modules (up to those marked as belonging to the public domain,
see separate section below) are maintained by the Systems Ecology Group of
the Institute of Integrative Biology, ETH Zurich, Switzerland.
All rights reserved.
The authors reserve the right to make changes, additions, and improvements
to the software or documentation at any time without notice to any person or
organization; no guarantee is made that further versions of either will be
compatible with any other version.
The authors hereby disclaim any and all guarantees and warranties on the
software or its documentation, both expressed or implied. No liability
of any form shall be assumed by the authors. Any user of this sofware uses
it at his or her own risk and no fitness for any purpose whatsoever nor
waranty of merchantability are claimed or implied.
(*============================ Buttons ================================*)
TYPE
Button; ButtonActionProc = PROCEDURE( Button );
ButtonDrawProc = PROCEDURE( Button, RectArea ); PaletteDrawProc = PROCEDURE( INTEGER );
VAR notInstalledButton: Button;
PROCEDURE InstallButton ( VAR btn : Button; btnFrame : RectArea;
buttonAction: ButtonActionProc; drawButton : ButtonDrawProc );
PROCEDURE ButtonExists( btn: Button ): BOOLEAN;
PROCEDURE RemoveButton( VAR btn: Button );
PROCEDURE RemoveAllButtonsOfWindow( w: Window );
PROCEDURE SetToDefaultButton ( w: Window; btn: Button; drawDefltButton: ButtonDrawProc );
PROCEDURE NoDefaultButton ( w: Window );
PROCEDURE GetDefaultButton( w: Window; VAR btn: Button );
PROCEDURE SetButtonAliasChar ( btn: Button; modif: BITSET; aliasChar: CHAR );
PROCEDURE DisableButton( btn : Button );
PROCEDURE EnableButton ( btn : Button );
PROCEDURE IsEnabled ( btn: Button ): BOOLEAN;
PROCEDURE SetButtonNr( btn: Button; btnNr: INTEGER );
PROCEDURE ButtonNr ( btn: Button ): INTEGER;
PROCEDURE OwnerWindow( btn: Button ): Window;
PROCEDURE SetButtonAttr( btn: Button; btnFrame: RectArea;
btnAction: ButtonActionProc; drawButton: ButtonDrawProc );
PROCEDURE GetButtonAttr( btn: Button; VAR btnFrame: RectArea;
VAR btnAction: ButtonActionProc; VAR drawButton: ButtonDrawProc );
PROCEDURE DrawTextButton( btnFrame: RectArea; butText: ARRAY OF CHAR );
PROCEDURE DrawDefltButtonFrame( frame: RectArea );
PROCEDURE AggregatePalette( palNr: INTEGER; fstBtn,lstBtn: Button; drawPalette: PaletteDrawProc );
PROCEDURE DummyButtonDrawing( dummyBtn: Button; dummyBtnFrame: RectArea );
PROCEDURE OwnerPalette( btn: Button ): INTEGER;
PROCEDURE GetPaletteDrawProc( palNr: INTEGER; VAR pdp: PaletteDrawProc; VAR done: BOOLEAN );
PROCEDURE DisaggregatePalette( palNr: INTEGER );
PROCEDURE RedrawAllButtons ( w: Window );
PROCEDURE DimmAllDisabledButtons ( w: Window );
PROCEDURE DoForAllButtonsOfWindow ( w: Window; proc: ButtonActionProc );
(*=========================== ByteBlockIO =============================*)
CONST EOL=36C; TYPE BlockAccessProcedure= PROC;
VAR specifyPreviousWorkBlock, specifyNextWorkBlock: BlockAccessProcedure; legalNum: BOOLEAN;
PROCEDURE SetWorkBlock( VAR buf: ARRAY OF BYTE; blockNr: LONGINT; used: LONGINT );
PROCEDURE GetWorkBlock( VAR blockNr: LONGINT; VAR used: LONGINT );
PROCEDURE GetBytePos( VAR pos: LONGINT );
PROCEDURE SetBytePos( pos: LONGINT );
PROCEDURE GetLineCount( VAR line: LONGINT );
PROCEDURE SetLineCount( line: LONGINT );
PROCEDURE ResetByteBlockIO; PROCEDURE EOF(): BOOLEAN;
PROCEDURE Again;
PROCEDURE ReadByte( VAR b: BYTE );
PROCEDURE WriteByte( b: BYTE );
PROCEDURE ReadChar( VAR ch: CHAR );
PROCEDURE SkipGap;
PROCEDURE ReadChars( VAR string: ARRAY OF CHAR );
PROCEDURE WriteChar( ch: CHAR );
PROCEDURE WriteEOL; (* = Write(EOL) *)
PROCEDURE WriteChars( string: ARRAY OF CHAR );
PROCEDURE GetCardinal( VAR c: CARDINAL );
PROCEDURE PutCardinal( c: CARDINAL; n: CARDINAL );
PROCEDURE GetInteger( VAR i: INTEGER );
PROCEDURE PutInteger( i: INTEGER; n: CARDINAL );
PROCEDURE GetReal( VAR x: REAL );
PROCEDURE PutReal( x: REAL; n, dec: CARDINAL );
PROCEDURE PutRealSci( x: REAL; n: CARDINAL );
PROCEDURE GetLongCard( VAR c: LONGCARD );
PROCEDURE GetLongInt( VAR i: LONGINT );
PROCEDURE GetLongReal( VAR x: LONGREAL );
PROCEDURE PutLongCard( lc: LONGCARD; n: CARDINAL );
PROCEDURE PutLongInt( li: LONGINT; n: CARDINAL );
PROCEDURE PutLongReal( lr: LONGREAL; n, dec: CARDINAL );
PROCEDURE PutLongRealSci( lr: LONGREAL; n, dec: CARDINAL );
(*============================ Confidence ================================*)
PROCEDURE FInvNormalStand( alfa: REAL ): REAL; (* µ = 0, sigma = 1 *)
PROCEDURE FInvNormal ( mu,sigma,alfa: REAL ): REAL;
PROCEDURE FInvStudent ( nu: INTEGER; alfa: REAL ): REAL;
PROCEDURE FInvChiSquare ( nu: INTEGER; alfa: REAL ): REAL;
PROCEDURE FInvF ( nu1,nu2: INTEGER; alfa: REAL ): REAL;
PROCEDURE FInvBinomial ( k,N: INTEGER; alfa: REAL ): REAL;
PROCEDURE FInvPoisson ( lambda: INTEGER; alfa: REAL ): REAL;
PROCEDURE FInvNegBinomial( mu,k: REAL; alfa: REAL ): REAL;
(*============================ Console ================================*)
VAR terminalWindow: Window;
PROCEDURE Read( VAR ch: CHAR );
PROCEDURE BusyRead( VAR ch: CHAR );
PROCEDURE ReadString( VAR s: ARRAY OF CHAR );
PROCEDURE Write( ch: CHAR );
PROCEDURE WriteLn;
PROCEDURE WriteString( s: ARRAY OF CHAR );
PROCEDURE OpenTerminal;
PROCEDURE SaveTerminal;
PROCEDURE CloseTerminal;
(*============================ DatFraAux ==============================*)
CONST
nosuchDataFrame = dtfOffset + 10; (* insert Δ is data frame's identifier *)
idDlgCancelled = dtfOffset + 11; (* insert Δ is operation name *)
missingIdent = dtfOffset + 12; (* insert Δ is operation name *)
loadDFErrFromOp = dtfOffset + 13; (* insert Δ is name of loading operation *)
internalMemExceeded = dtfOffset + 14; (* insert Δ is name of operation *)
retrMethFailsOnScal = dtfOffset + 15; (* inserts: Δ - identifier, Δ - retrieval method *)
retrMethFailsOnVect = dtfOffset + 16; (* inserts: Δ - identifier, Δ - retrieval method *)
maxDefsRemembered=16; (* max redefinitions of a single data frame remembered *)
missHistory="..."; (* used instead of data if more than maxDefsRemembered redefinitions occurred *)
(* retrieval codes, see ListType and GetListOfIdents *)
onlyVectRetr=0; onlyScalRetr=1; vectAndScalRetr=2;
(* activity codes, see AtSymbolDetectedProc and AddAtSymbolDetectedHandler*)
scanNormally=0; skipSinceFilterMismatch=1; circularFileRerence=2;
TYPE
DataFrame;
DataFramHandler= PROCEDURE( DataFrame );
DataFrameFile;
DataFrameFileProc= PROCEDURE( DataFrameFile );
ListType=[ onlyVectRetr.. vectAndScalRetr];
AtSymbolDetectedProc= PROCEDURE( BOOLEAN, (* true if a data frame *) ARRAY OF CHAR,
INTEGER, (* activity: scanNormally, or skipSinceFilterMismatch etc. *)
INTEGER, (* number of files currently open *)
VAR BOOLEAN );
AnyDFChangedHandler= PROC;
VAR
unknownDataFrame: DataFrame; (* READ ONLY *)
unknownDataFrameFile: DataFrameFile; (* READ ONLY *)
PROCEDURE IsDataFrameKnown( df: DataFrame ): BOOLEAN;
PROCEDURE FirstDataFrame(): DataFrame;
PROCEDURE NextDataFrame( df: DataFrame ): DataFrame;
PROCEDURE FindDataFrame( dataFrameIdent: ARRAY OF CHAR; VAR df: DataFrame; VAR found: BOOLEAN );
PROCEDURE GetDataFrameIdent( df: DataFrame; VAR dataFrameIdent: ARRAY OF CHAR );
PROCEDURE GetDataFrameAttrIdents( df: DataFrame; VAR parentIdent, modelIdent, keyColumn: ARRAY OF CHAR );
PROCEDURE InspectDataFrame( df: DataFrame; VAR nrOfDefs, totalVectValDefs, totalScalarValDefs: INTEGER;
sepChar: ARRAY OF CHAR;
VAR defNos, parentIdents, keyColumns, remarks,
maxRows, maxCols, storedOnFsWithName, fileNos: ARRAY OF CHAR;
VAR fromFilters, tillFilters: ARRAY OF ReadingFilter; VAR resCode: INTEGER );
PROCEDURE InspectValDef( ident: ARRAY OF CHAR; VAR vectRetr: BOOLEAN; VAR nrOfDefs: INTEGER;
VAR fdt: ARRAY OF ValDefType; sepChar: ARRAY OF CHAR;
VAR vals, dfIdents, parentIdents, keyColumns: ARRAY OF CHAR );
CONST
(* regular retrieval methods *)
retrAsUndef=0;
(* scalar retrieval *)
retrAsInt=1; retrAsReal=2; retrAsBool=3; retrAsIdent=4; retrAsStr=5;
(* vector retrieval *)
retrAsIntVect=6; retrAsRealVect=7; retrAsBoolVect=8; retrAsIdentVect=9;
retrAsIdsStr=10; retrAsStrVect=11; retrAsSStrsStr=12;
(* special retrieval methods *)
getUnknown=13; getType=14; getDim=15; getKeyCol=16; getSubKeyCol=17;
minRetrieveMethod=0; maxRetrieveMethod=17;
TYPE
SimpleRetrieveMethod = [retrAsUndef..retrAsSStrsStr];
SpecialRetrieveMethod = [getUnknown..getSubKeyCol];
RetrieveMethod = [minRetrieveMethod..maxRetrieveMethod];
PROCEDURE RetrieveAValDef( vdident: ARRAY OF CHAR; how: SimpleRetrieveMethod; sepChar: ARRAY OF CHAR;
decDig: CARDINAL; VAR retrievedValue: ARRAY OF CHAR; VAR n: INTEGER );
PROCEDURE RetrieveForValDef( vdident: ARRAY OF CHAR; forType: ValDefType; how: SpecialRetrieveMethod;
subKeyIdent, sepChar: ARRAY OF CHAR; decDig: CARDINAL;
VAR retrievedValue: ARRAY OF CHAR; VAR n: INTEGER );
PROCEDURE ConvertValDefTypeToString( vdt: ValDefType; VAR str: ARRAY OF CHAR );
PROCEDURE ConvertRetrieveMethodString( retrMeth: RetrieveMethod; VAR str: ARRAY OF CHAR );
PROCEDURE InspectDataFrameFile( dff: DataFrameFile; VAR pfn: ARRAY OF CHAR;
VAR fileNo: INTEGER; VAR creationDate, modifDate: LONGINT );
PROCEDURE GetListOfIdents( df: DataFrame; sepChar: ARRAY OF CHAR; lt: ListType;
VAR intIds, realIds, boolIds, strIds, idIds: ARRAY OF CHAR;
VAR ni, nr, nb, ns, nd, vectDim: INTEGER );
PROCEDURE FindDataFrameFile( pfn: ARRAY OF CHAR; VAR dff: DataFrameFile );
PROCEDURE DoForAllDataFrameFiles( dffproc: DataFrameFileProc );
PROCEDURE DropDataFrame( VAR df: DataFrame );
PROCEDURE AddAnyDFChangedHandler( adfchghdl: AnyDFChangedHandler );
PROCEDURE VoidAnyDFChangedHandler( adfchghdl: AnyDFChangedHandler );
PROCEDURE AddDFDropHandler( df: DataFrame; dfdhdl: DataFramHandler );
PROCEDURE VoidDFDropHandler( df: DataFrame; dfdhdl: DataFramHandler );
PROCEDURE AddAtSymbolDetectedHandler( asdh: AtSymbolDetectedProc );
PROCEDURE VoidAtSymbolDetectedHandler( asdh: AtSymbolDetectedProc );
PROCEDURE GetDFErrMsg( resCode: INTEGER; VAR msg: ARRAY OF CHAR );
PROCEDURE GetDFFileType( VAR fileType: ARRAY OF CHAR );
PROCEDURE SetDFFileType( fileType: ARRAY OF CHAR );
(*============================ DataFrames =============================*)
CONST
dtfOffset = userBase + 200; (* constants used for resCode *)
badLoadFromAnchor = dtfOffset + 0; (* internally used by LoadDataFrames *)
loadUserInterrupted = dtfOffset + 1; (* internally used by LoadDataFrames *)
integerOverflow = dtfOffset + 2; (* internally used by VI,VIVec *)
realOverflow = dtfOffset + 3; (* internally used by VR,VRVec *)
datFraHasNoKeyCol = dtfOffset + 4; (* internally used by GetValDefsKeyColumn *)
subKeyIsRealOrBoolCol = dtfOffset + 5; (* internally used by GetValDefsSubKeyColumn *)
(* Note: Error #'s 500..550 are reserved for the entire
package DataFrames. The underlying DataTables uses range
600..650. The DataFrames package uses only module Errors and its
modes for error generation and display. WARNING: In case the
mode is suppressing and deferring error messages, you won't learn
about any errors which have possibly occurred. See also *)
(* Loading data frames from files into memory *)
TYPE ReadingFilter= LONGINT;
VAR defaultFilter, minFilter, maxFilter: ReadingFilter; (* READ ONLY *)
PROCEDURE ReadDataFramesIntoMemory( startOnFileWithName: ARRAY OF CHAR;
fromFilter, tillFilter: ReadingFilter; VAR resCode: INTEGER );
PROCEDURE LoadDataFrames( VAR startOnFileWithName: ARRAY OF CHAR;
fromFilter, tillFilter: ReadingFilter; VAR resCode: INTEGER );
PROCEDURE DropAllDataFrames;
(* Retrieving data *)
TYPE
ALPHA = ARRAY[0..63] OF CHAR; (* also maximum size of identifiers *)
ValDefType=( undefined, integer, longint, singlereal, doublereal, boolean, identifier, string );
ValDefTypes= SET OF ValDefType;
DataFrameSet=( nowhere, inALL, inSpecific, inANY );
VAR
undefInteger : INTEGER; (* READ ONLY; = MIN(INTEGER)+1 *)
undefLongInt : LONGINT; (* READ ONLY; = MIN(LONGINT)+1 *)
undefReal : REAL; (* READ ONLY; = DMConversions.UndefREAL() *)
undefLongReal: LONGREAL; (* READ ONLY; = DMConversions.UndefLONGREAL() *)
undefBoolean : BOOLEAN; (* READ ONLY; = BOOLEAN(ORD(MAX(BOOLEAN))+1) *)
undefString : ARRAY [0..0] OF CHAR; (* READ ONLY; undefString[0] = 0C *)
(* Scalar Retrieval *)
PROCEDURE VI ( ident: ARRAY OF CHAR ): INTEGER;
PROCEDURE VLI ( ident: ARRAY OF CHAR ): LONGINT;
PROCEDURE VR ( ident: ARRAY OF CHAR ): REAL;
PROCEDURE VLR ( ident: ARRAY OF CHAR ): LONGREAL;
PROCEDURE VB ( ident: ARRAY OF CHAR ): BOOLEAN; (* returns undefBoolean if undefined *)
PROCEDURE Flag ( ident: ARRAY OF CHAR ): BOOLEAN; (* returns FALSE if undefined *)
PROCEDURE GetVS ( ident: ARRAY OF CHAR; VAR s: ARRAY OF CHAR );
PROCEDURE GetVId( ident: ARRAY OF CHAR; VAR id: ARRAY OF CHAR );
(* Vector Retrieval *)
PROCEDURE GetIVec ( ident: ARRAY OF CHAR; VAR ivec : ARRAY OF INTEGER; VAR n: INTEGER );
PROCEDURE GetLIVec( ident: ARRAY OF CHAR; VAR livec: ARRAY OF LONGINT; VAR n: INTEGER );
PROCEDURE GetRVec ( ident: ARRAY OF CHAR; VAR rvec : ARRAY OF REAL; VAR n: INTEGER );
PROCEDURE GetLRVec( ident: ARRAY OF CHAR; VAR lrvec: ARRAY OF LONGREAL; VAR n: INTEGER );
PROCEDURE GetBVec ( ident: ARRAY OF CHAR; VAR bvec : ARRAY OF BOOLEAN; VAR n: INTEGER );
PROCEDURE GetSVec ( ident: ARRAY OF CHAR; VAR svec : ARRAY OF ALPHA; VAR n: INTEGER );
PROCEDURE GetIdVec( ident: ARRAY OF CHAR; VAR idvec: ARRAY OF ALPHA; VAR n: INTEGER );
PROCEDURE GetSs ( ident: ARRAY OF CHAR; sepChar: CHAR; VAR ssvec: ARRAY OF CHAR; VAR n: INTEGER );
PROCEDURE GetIds ( ident: ARRAY OF CHAR; sepChar: CHAR; VAR idvec: ARRAY OF CHAR; VAR n: INTEGER );
(* Identifier Routines (Note, rowId = empty string if vector retrieval) *)
PROCEDURE ConcatIdent( dtfParModId, rowId, colId: ARRAY OF CHAR; VAR ident: ARRAY OF CHAR );
PROCEDURE SplitIdent( ident: ARRAY OF CHAR; VAR dtfParModId, rowId, colId: ARRAY OF CHAR );
(* Utilities *)
PROCEDURE FixIdent( VAR ident: ARRAY OF CHAR );
PROCEDURE GetValDefType( ident: ARRAY OF CHAR; VAR fdt: ValDefTypes );
PROCEDURE LastValDefFoundIn(): DataFrameSet;
PROCEDURE GetLastValDefsDFIdent( VAR lastDataFrameIdent: ARRAY OF CHAR );
(* Data Frame Analysis *)
PROCEDURE GetVectDim( ident: ARRAY OF CHAR; ofType: ValDefType; VAR n: INTEGER );
PROCEDURE GetValDefsKeyColumn( ident: ARRAY OF CHAR; ofType: ValDefType;
sepChar: CHAR; VAR keys: ARRAY OF CHAR; VAR n: INTEGER );
PROCEDURE GetValDefsSubKeyColumn( ident: ARRAY OF CHAR; ofType: ValDefType; subKeyIdent: ARRAY OF CHAR;
sepChar: CHAR; VAR subKeys: ARRAY OF CHAR; VAR n: INTEGER );
(*=========================== DatFraUsage =============================*)
TYPE DataInterest;
VAR noDataInterest: DataInterest; (* read only *)
PROCEDURE AnnounceDataInterest( VAR di: DataInterest );
PROCEDURE AddDFToDataInterest ( di: DataInterest; dfIdent: ARRAY OF CHAR );
PROCEDURE DataInterestExists ( di: DataInterest ): BOOLEAN;
PROCEDURE DelDFInDataInterest ( di: DataInterest; dfIdent: ARRAY OF CHAR );
PROCEDURE DenounceDataInterest( VAR di: DataInterest );
(* Data Insterest Specific Settings *)
PROCEDURE SetDataInterestKind( di: DataInterest; autoExtendInterest: BOOLEAN );
PROCEDURE GetDataInterestKind( di: DataInterest; VAR autoExtendInterest: BOOLEAN );
PROCEDURE SetDataInterestReadFilters( di: DataInterest;
minLoadFilter,maxLoadFilter,
minSharedFilter, maxSharedFilter: ReadingFilter );
PROCEDURE GetDataInterestReadFilters( di: DataInterest;
VAR minLoadFilter,maxLoadFilter,
minSharedFilter, maxSharedFilter: ReadingFilter );
(* Data Frame Specific Settings *)
PROCEDURE SetDFInterestKind( di: DataInterest; dfIdent: ARRAY OF CHAR; shared: BOOLEAN );
PROCEDURE GetDFInterestKind( di: DataInterest; dfIdent: ARRAY OF CHAR; VAR shared: BOOLEAN );
(* Readying and Discarding Data *)
PROCEDURE LoadDataFramesWithDlg( prompt: ARRAY OF CHAR; fromFilter, tillFilter: ReadingFilter;
VAR startOnFileWithName: ARRAY OF CHAR; VAR resCode: INTEGER );
PROCEDURE ReadyData( di: DataInterest; overWriteAll: BOOLEAN; anchor: ARRAY OF CHAR;
VAR isready, needsDataAssignment: BOOLEAN; VAR resCode: INTEGER );
PROCEDURE DiscardData( di: DataInterest; sharedToo: BOOLEAN );
(* Error Messages *)
CONST
dfUsageMsgOffset = userBase + 250; (* constants used for resCode *)
dfUsageMsgMaxCode = dfUsageMsgOffset + 10-1;
tooManyDFIdents = dfUsageMsgOffset + 0; (* only internally used *)
couldntLoadDF = dfUsageMsgOffset + 1; (* insert Δ - data frame's identifier *)
unknownDatInt = dfUsageMsgOffset + 2; (* insert Δ - empty *)
unknownDatIntWhile = dfUsageMsgOffset + 3; (* inserts Δ - operation, data frame's identifier *)
datIntDefTwice = dfUsageMsgOffset + 4; (* insert Δ - empty *)
dFIntDefTwice = dfUsageMsgOffset + 5; (* insert Δ - data frame's identifier *)
undknownDFInterest = dfUsageMsgOffset + 6; (* insert Δ - data frame's identifier *)
missingDataFrame = dfUsageMsgOffset + 7; (* insert Δ - data frame's identifier *)
PROCEDURE GetDFUErrMsg( msgnr: INTEGER; VAR msg: ARRAY OF CHAR );
(*=========================== DatFraViewer ============================*)
TYPE
OutMReadyProc= PROCEDURE(): BOOLEAN;
WriteVarStringProc= PROCEDURE( VAR ARRAY OF CHAR );
WriteProc= PROCEDURE( CHAR );
(* Activation of Viewer *)
PROCEDURE MakeDatFraViewer;
PROCEDURE DiscardDatFraViewer;
(* Core Functions of Viewer *)
PROCEDURE LoadDataFramesFromAnchor( VAR anchorfn: ARRAY OF CHAR );
PROCEDURE UnloadDataFrames;
PROCEDURE UnloadDataFrame( VAR dataframeident: ARRAY OF CHAR );
PROCEDURE ShowDataFrames;
PROCEDURE ShowDataFramesRemarks;
PROCEDURE ShowValDefIdentifiers( VAR dataframeident: ARRAY OF CHAR );
PROCEDURE ShowValueDefinition( VAR ident: ARRAY OF CHAR );
PROCEDURE RetrieveValue( VAR ident: ARRAY OF CHAR; VAR forType: ValDefType;
VAR sepChar: CHAR; VAR retrValue: ARRAY OF CHAR );
PROCEDURE RetrieveSpecialValue( VAR ident: ARRAY OF CHAR; VAR forType: ValDefType;
VAR specRetrMeth: SpecialRetrieveMethod;
VAR subKeyIdent, retrValue: ARRAY OF CHAR );
PROCEDURE EditSimpleRetrieveMethod( VAR ident: ARRAY OF CHAR; VAR retrMeth: SimpleRetrieveMethod;
VAR okeyed: BOOLEAN );
PROCEDURE EditSpecialRetrieveMethod( VAR ident: ARRAY OF CHAR; VAR retrMeth: SpecialRetrieveMethod;
VAR forType: ValDefType; VAR subKeyIdent: ARRAY OF CHAR;
VAR okeyed: BOOLEAN );
(* Viewer's Window *)
PROCEDURE OpenDataFrameViewer;
PROCEDURE IsDatFraViewerOpen(): BOOLEAN;
PROCEDURE ClearDatFraViewer;
PROCEDURE IsDatFraViewerReadyForOutput(): BOOLEAN;
PROCEDURE CloseDatFraViewerWindow;
PROCEDURE PlaceDatFraViewer( x, y, w, h: INTEGER );
PROCEDURE GetDatFraViewerPlace( VAR x, y, w, h: INTEGER );
(* Redirecting Viewer's Output *)
PROCEDURE CaptureOutputOnFile( VAR pfn: ARRAY OF CHAR );
PROCEDURE StopOutputCapturing;
PROCEDURE InstallWriteProcs( omrp: OutMReadyProc; wvsp: WriteVarStringProc; wp: WriteProc;
wln, clear: PROC );
PROCEDURE GetCurWriteProcs( VAR omrp: OutMReadyProc; VAR wvsp: WriteVarStringProc; VAR wp: WriteProc;
VAR wln, clear: PROC );
(* Viewer's Preferences *)
PROCEDURE EditPreferences;
PROCEDURE GetPreferences( VAR traceLoadMode, autoShowMode,
showHistoryMode, showLegendsMode, showFiltersMode: BOOLEAN;
VAR sepChar: CHAR; VAR decDig: CARDINAL );
PROCEDURE SetPreferences( traceLoadMode, autoShowMode,
showHistoryMode, showLegendsMode, showFiltersMode: BOOLEAN;
sepChar: CHAR; decDig: CARDINAL );
(* Data Frame Loading Filters *)
PROCEDURE EditFilters;
PROCEDURE GetFilters( VAR fromFilter, tillFilter: ReadingFilter );
PROCEDURE SetFilters( fromFilter, tillFilter: ReadingFilter );
PROCEDURE EditReadingFilters( VAR fromFilt, tillFilt: ReadingFilter; VAR oKClicked: BOOLEAN );
(* Menu Commands' Short Cuts *)
PROCEDURE EditDatFraViewerShortCuts;
PROCEDURE GetMenuShortCuts( VAR openAlCh, closeAlCh, loadAlCh, unloadAlCh, unloadAllAlCh,
showDFsAlCh, showRemsAlCh, showIdentsAlCh, showValDefAlCh,
retrValAlCh, retrSpecAlCh, clearAlCh, captOnFAlCh, stopCaptOnFAlCh,
editFiltAlCh, editPrefsAlCh, editAlChsAlCh: CHAR );
PROCEDURE SetMenuShortCuts( openAlCh, closeAlCh, loadAlCh, unloadAlCh, unloadAllAlCh,
showDFsAlCh, showRemsAlCh, showIdentsAlCh, showValDefAlCh,
retrValAlCh, retrSpecAlCh, clearAlCh, captOnFAlCh, stopCaptOnFAlCh,
editFiltAlCh, editPrefsAlCh, editAlChsAlCh: CHAR );
(* Miscellaneous & Factory Settings *)
PROCEDURE DatFraViewerMenu(): Menu;
PROCEDURE ResetDatFraViewer;
(*============================ DataTables =============================*)
TYPE
DataTable;
CONST
notDone= onlyAnInsert;
unknownRowNr=0; (* rows start at 1 *)
unknownColNr=0; (* columns start at 1 *)
VAR
notExistingDataTable: DataTable; (* read only *)
String63 = ARRAY [0..63] OF CHAR;
DTElementType = ( unknownDTEle,
integer, longint, real, longreal,
boolean, ident, string );
DTColDescr = RECORD
type : DTElementType;
id : String63;
END;
DTElementPtr = POINTER TO DTElement;
SHORTENUM = CHAR; (* will hold [CHAR(MIN(DTElementType))..CHAR(MAX(DTElementType))] *)
DTElement = RECORD
def: BOOLEAN; (* def holds whether DTElement is defined *)
type: SHORTENUM; (* type holds the type *)
CASE : DTElementType OF
| unknownDTEle : undefval : ARRAY [0..(SIZE(LONGREAL) DIV SIZE(CHAR))-1] OF CHAR;
| real : real : REAL;
| longreal : lreal : LONGREAL;
| integer : int : INTEGER;
| longint : lint : LONGINT;
| boolean : boo : BOOLEAN;
| ident : id : String;
| string : str : String;
END;
END;
VAR emptyDataEle: DTElement; (* read only *)
PROCEDURE ShortDTEType( t: DTElementType ): SHORTENUM;
PROCEDURE DTEType( t: SHORTENUM ): DTElementType;
PROCEDURE GetDTElementTypeDescr( dt: DTElementType; VAR descr: ARRAY OF CHAR );
PROCEDURE DeclDataTable( tableName: ARRAY OF CHAR; nRows, nCols: INTEGER;
VAR colDescr: ARRAY OF DTColDescr;
(* VAR for speed-up only *) VAR dt: DataTable;
VAR resCode: INTEGER; VAR insert: ARRAY OF CHAR );
PROCEDURE RemoveDataTable( VAR dt: DataTable );
PROCEDURE DataTableExists( dt: DataTable ): BOOLEAN;
PROCEDURE FirstDataTable(): DataTable;
PROCEDURE NextDataTable( dt: DataTable ): DataTable;
PROCEDURE GetDataTableAttr( dt: DataTable; VAR attr: ADDRESS;
VAR resCode: INTEGER; VAR insert: ARRAY OF CHAR );
PROCEDURE SetDataTableAttr( dt: DataTable; attr: ADDRESS;
VAR resCode: INTEGER; VAR insert: ARRAY OF CHAR );
PROCEDURE LockDataTable( dt: DataTable; VAR resCode: INTEGER; VAR insert: ARRAY OF CHAR );
PROCEDURE UnlockDataTable( dt: DataTable; VAR resCode: INTEGER; VAR insert: ARRAY OF CHAR );
PROCEDURE IsDataTableLocked( dt: DataTable ): BOOLEAN;
PROCEDURE GetDataTableName( dt: DataTable; VAR tableName: ARRAY OF CHAR;
VAR resCode: INTEGER; VAR insert: ARRAY OF CHAR );
PROCEDURE GetDataTableDescr( dt: DataTable; VAR tableName: ARRAY OF CHAR;
VAR nRows, nCols: INTEGER; VAR colDescr: ARRAY OF DTColDescr;
VAR resCode: INTEGER; VAR insert: ARRAY OF CHAR );
PROCEDURE GetDataTableColDescr( dt: DataTable; colNo: INTEGER; VAR colDescr: DTColDescr;
VAR resCode: INTEGER; VAR insert: ARRAY OF CHAR );
PROCEDURE SetDataTableDescr( dt: DataTable; tableName: ARRAY OF CHAR;
VAR(*speed-up*) colDescr: ARRAY OF DTColDescr;
VAR resCode: INTEGER; VAR insert: ARRAY OF CHAR );
PROCEDURE GetDataTableDim( dt: DataTable; VAR nRows: INTEGER; VAR nCols: INTEGER;
VAR resCode: INTEGER; VAR insert: ARRAY OF CHAR );
PROCEDURE ClearDTEle( eleType: DTElementType; VAR ele: DTElement );
PROCEDURE CopyDTEle( eleType: DTElementType; VAR(*speed-up*) from: DTElement; VAR to: DTElement );
PROCEDURE GetDTEle( dt: DataTable; row, col: INTEGER; VAR ele: DTElement );
PROCEDURE SetDTEle( VAR(*speed-up*) ele: DTElement; dt: DataTable; row, col: INTEGER );
PROCEDURE DTEleADR( dt: DataTable; row, col: INTEGER ): DTElementPtr;
PROCEDURE SetMisValParams( misValStr, misQuotStr: ARRAY OF CHAR; misReal: REAL; misInt: INTEGER;
misLReal: LONGREAL; misLInt: LONGINT; misBool: BOOLEAN;
VAR resCode: INTEGER; VAR insert: ARRAY OF CHAR );
PROCEDURE GetMisValParams( VAR misValStr, misQuotStr: ARRAY OF CHAR; VAR misReal: REAL; VAR misInt: INTEGER;
VAR misLReal: LONGREAL; VAR misLInt: LONGINT; VAR misBool: BOOLEAN );
PROCEDURE ReadDataTable( inFName: ARRAY OF CHAR; tryOpenFile, keepFileOpen, eolSeparated: BOOLEAN;
tableName: ARRAY OF CHAR; VAR dt: DataTable;
VAR resCode: INTEGER; VAR insert: ARRAY OF CHAR );
PROCEDURE GetColDescriptors( VAR(*speed-up*) fName: ARRAY OF CHAR; eolSeparated: BOOLEAN;
VAR nCols: INTEGER; VAR colDescr: ARRAY OF DTColDescr;
VAR resCode: INTEGER; VAR insert: ARRAY OF CHAR );
PROCEDURE GetNextDataRow( VAR(*speed-up*) fName: ARRAY OF CHAR; eolSeparated: BOOLEAN; nCols: INTEGER;
VAR colDescr: ARRAY OF DTColDescr; (* is also set! *)
VAR rowData: ARRAY OF DTElement; VAR endOfData: BOOLEAN;
VAR resCode: INTEGER; VAR insert: ARRAY OF CHAR );
PROCEDURE SetNumOutputParams( nIntChars, nLIntChars, nRealChars, nDecDigits,
nLRealChars, nLRDecDigits: INTEGER );
PROCEDURE GetNumOutputParams( VAR nIntChars, nLIntChars, nRealChars, nDecDigits,
nLRealChars, nLRDecDigits: INTEGER );
PROCEDURE WriteDataTable( outF: TextFile; eolSeparated: BOOLEAN;
indentStr, lastIndentStr: ARRAY OF CHAR; VAR dt: DataTable;
VAR resCode: INTEGER; VAR insert: ARRAY OF CHAR );
(*=========================== DatTabAccess ============================*)
CONST
unknownColNr = 0;
unknownRowNr = 0;
PROCEDURE InitFastTableAccess( dt: DataTable );
PROCEDURE StopFastTableAccess;
PROCEDURE ColNum ( dt: DataTable; colID: ARRAY OF CHAR ): INTEGER;
PROCEDURE ColType ( dt: DataTable; colID: ARRAY OF CHAR ): DTElementType;
PROCEDURE ColTypeOK( dt: DataTable; colNr: INTEGER; expctdType: DTElementType ): BOOLEAN;
PROCEDURE MaxRow ( dt: DataTable ): INTEGER;
PROCEDURE MaxCol ( dt: DataTable ): INTEGER;
PROCEDURE IDRowNum ( dt: DataTable; colNr: INTEGER; theID : ARRAY OF CHAR ): INTEGER;
PROCEDURE StrRowNum ( dt: DataTable; colNr: INTEGER; theStr : ARRAY OF CHAR ): INTEGER;
PROCEDURE IntRowNum ( dt: DataTable; colNr: INTEGER; theInt : INTEGER ): INTEGER;
PROCEDURE LIntRowNum( dt: DataTable; colNr: INTEGER; theLInt: LONGINT ): INTEGER;
PROCEDURE SetInt ( dt: DataTable; rowNr,colNr: INTEGER; i: INTEGER );
PROCEDURE GetInt ( dt: DataTable; rowNr,colNr: INTEGER ): INTEGER;
PROCEDURE SetLInt ( dt: DataTable; rowNr,colNr: INTEGER; li: LONGINT );
PROCEDURE GetLInt ( dt: DataTable; rowNr,colNr: INTEGER ): LONGINT;
PROCEDURE SetReal ( dt: DataTable; rowNr,colNr: INTEGER; r: REAL );
PROCEDURE GetReal ( dt: DataTable; rowNr,colNr: INTEGER ): REAL;
PROCEDURE SetLReal ( dt: DataTable; rowNr,colNr: INTEGER; lr: LONGREAL );
PROCEDURE GetLReal ( dt: DataTable; rowNr,colNr: INTEGER ): LONGREAL;
PROCEDURE SetBool ( dt: DataTable; rowNr,colNr: INTEGER; b: BOOLEAN );
PROCEDURE GetBool ( dt: DataTable; rowNr,colNr: INTEGER ): BOOLEAN;
PROCEDURE SetID ( dt: DataTable; rowNr,colNr: INTEGER; id: ARRAY OF CHAR );
PROCEDURE GetID ( dt: DataTable; rowNr,colNr: INTEGER; VAR id: ARRAY OF CHAR );
PROCEDURE SetString( dt: DataTable; rowNr,colNr: INTEGER; str: ARRAY OF CHAR );
PROCEDURE GetString( dt: DataTable; rowNr,colNr: INTEGER; VAR str: ARRAY OF CHAR );
(*=========================== DblLnkLists =============================*)
TYPE
EnclosingItemPtr = ADDRESS; DMLevel = CARDINAL;
ListItemRec = RECORD lev: DMLevel; prev,next: EnclosingItemPtr; END;
VAR nilItemRec: ListItemRec; (* read only *)
PROCEDURE AddToList( q: EnclosingItemPtr; VAR root, tail: EnclosingItemPtr );
PROCEDURE RemoveFromList( q: EnclosingItemPtr; VAR root, tail: EnclosingItemPtr );
PROCEDURE ListItemExists( q, root: EnclosingItemPtr ): BOOLEAN;
(*=========================== DiscrSpaces =============================*)
CONST
DiscrSpacesOffset = DMLanguage.userBase + 720;
allOk = DMLanguage.allOk;
discreteSpaceNotKnown = DiscrSpacesOffset + 1;
discreteSpaceNotAvailable = DiscrSpacesOffset + 2;
atLeastOneDimEleRequired = DiscrSpacesOffset + 3;
atLeastOneDimRequired = DiscrSpacesOffset + 4;
dimensionDoesNotExist = DiscrSpacesOffset + 5;
dimensionUsedMoreThanOnce = DiscrSpacesOffset + 6;
illegalTuple = DiscrSpacesOffset + 7;
identDelim="|";
TYPE
DiscreteSpace; Dimension;
DiscreteSpaceAttribute= ADDRESS; DimensionAttribute= ADDRESS;
DiscreteSpaceRemoveHandler= PROCEDURE( DiscreteSpaceAttribute );
DimensionRemoveHandler= PROCEDURE( DimensionAttribute );
VAR
unknownDiscreteSpace: DiscreteSpace; (* read only *)
unknownDimension: Dimension; (* read only *)
(* Dimensions *)
PROCEDURE CreateDimension( VAR dim: Dimension; dimId, eleIds: ARRAY OF CHAR; VAR resCode: INTEGER );
PROCEDURE DimensionExists( dimId: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE GetDimensionId( dim: Dimension; VAR dimId: ARRAY OF CHAR );
PROCEDURE NumDimensionEles( VAR dimId: ARRAY OF CHAR ): INTEGER;
PROCEDURE GetFirstDimension( VAR dimId: ARRAY OF CHAR );
PROCEDURE GetPrevDimension( curDimId: ARRAY OF CHAR; VAR dimId: ARRAY OF CHAR );
PROCEDURE GetNextDimension( curDimId: ARRAY OF CHAR; VAR dimId: ARRAY OF CHAR );
PROCEDURE GetLastDimension( VAR dimId: ARRAY OF CHAR );
PROCEDURE DiscardDimension( VAR dim: Dimension );
PROCEDURE AddDimensionRemoveHandler( dimId: ARRAY OF CHAR; rmh: DimensionRemoveHandler );
PROCEDURE VoidDimensionRemoveHandler( dimId: ARRAY OF CHAR; rmh: DimensionRemoveHandler );
PROCEDURE GetDimensionEleIds( dimId: ARRAY OF CHAR; VAR eleIds: ARRAY OF CHAR );
PROCEDURE DimensionDim( dimId: ARRAY OF CHAR ): INTEGER;
PROCEDURE DimEleOrd( dimId, eleId: ARRAY OF CHAR ): INTEGER;
PROCEDURE GetDimEle( dimId: ARRAY OF CHAR; eleOrd: INTEGER; VAR eleId: ARRAY OF CHAR );
PROCEDURE AttachDimensionAttr( dimId: ARRAY OF CHAR; da: DimensionAttribute );
PROCEDURE DimensionAttr( dimId: ARRAY OF CHAR ): DimensionAttribute;
(* Discrete Spaces *)
PROCEDURE CreateDiscreteSpace( VAR spc: DiscreteSpace; spcId, dimIds: ARRAY OF CHAR; VAR resCode: INTEGER );
PROCEDURE DiscreteSpaceExists( spcId: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE GetDiscreteSpaceId( spc: DiscreteSpace; VAR spcId: ARRAY OF CHAR );
PROCEDURE NumDiscreteSpaceDims( VAR spcId: ARRAY OF CHAR ): INTEGER;
PROCEDURE GetFirstDiscreteSpace( VAR spcId: ARRAY OF CHAR );
PROCEDURE GetPrevDiscreteSpace( curSpcId: ARRAY OF CHAR; VAR spcId: ARRAY OF CHAR );
PROCEDURE GetNextDiscreteSpace( curSpcId: ARRAY OF CHAR; VAR spcId: ARRAY OF CHAR );
PROCEDURE GetLastDiscreteSpace( VAR spcId: ARRAY OF CHAR );
PROCEDURE DiscardDiscreteSpace( VAR spc: DiscreteSpace );
PROCEDURE AddDiscreteSpaceRemoveHandler ( spcId: ARRAY OF CHAR; rmh: DiscreteSpaceRemoveHandler );
PROCEDURE VoidDiscreteSpaceRemoveHandler( spcId: ARRAY OF CHAR; rmh: DiscreteSpaceRemoveHandler );
PROCEDURE GetDiscreteSpaceDimIds( spcId: ARRAY OF CHAR; VAR dimIds: ARRAY OF CHAR );
PROCEDURE DiscreteSpaceDim( spcId: ARRAY OF CHAR ): INTEGER;
PROCEDURE DimOrd( spcId, dimId: ARRAY OF CHAR ): INTEGER;
PROCEDURE GetDim( spcId: ARRAY OF CHAR; dimOrd: INTEGER; VAR dimId: ARRAY OF CHAR );
PROCEDURE AttachDiscreteSpaceAttr( spcId: ARRAY OF CHAR; da: DiscreteSpaceAttribute );
PROCEDURE DiscreteSpaceAttr( spcId: ARRAY OF CHAR ): DiscreteSpaceAttribute;
(* Management of Tuples *)
PROCEDURE IsLegalTuple( spcId, idTuple: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE GetFirstTuple( spcId: ARRAY OF CHAR; VAR idTuple: ARRAY OF CHAR );
PROCEDURE GetNextTuple( spcId: ARRAY OF CHAR; VAR idTuple: ARRAY OF CHAR );
PROCEDURE ForbidTuple( spc: DiscreteSpace; idTuple: ARRAY OF CHAR; VAR resCode: INTEGER );
PROCEDURE AllowTuple( spc: DiscreteSpace; idTuple: ARRAY OF CHAR; VAR resCode: INTEGER );
PROCEDURE TupleAllowed( spcId, idTuple: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE IdToOrd( spcId, idTuple: ARRAY OF CHAR; VAR ordTuple: ARRAY OF INTEGER );
PROCEDURE OrdToId( spcId, ordTuple: ARRAY OF INTEGER; VAR idTuple: ARRAY OF CHAR );
PROCEDURE GetNthSubString( VAR (*speed-up*) string: ARRAY OF CHAR; n: INTEGER; VAR subs: ARRAY OF CHAR );
(*============================ DLists ================================*)
TYPE DListHandle; Relation= PROCEDURE( ADDRESS, ADDRESS ): BOOLEAN;
Selector= PROCEDURE( ADDRESS ): BOOLEAN; ItemProc= PROCEDURE( ADDRESS );
PROCEDURE NewDList( itemSize: LONGINT; fromHead: BOOLEAN; VAR dListHandle: DListHandle ): BOOLEAN;
PROCEDURE DeleteDList( VAR dListHandle: DListHandle );
PROCEDURE DListSize( dListHandle: DListHandle; VAR numItems: LONGINT ): BOOLEAN;
PROCEDURE SetDirection( dListHandle: DListHandle; fromHead: BOOLEAN );
PROCEDURE GetDirection( dListHandle: DListHandle; VAR fromHead: BOOLEAN ): BOOLEAN;
PROCEDURE SetRelation( dListHandle: DListHandle; relation: Relation );
PROCEDURE GetRelation( dListHandle: DListHandle; VAR relation: Relation );
PROCEDURE DeleteRelation( dListHandle: DListHandle );
PROCEDURE AddItem( dListHandle: DListHandle; item: ADDRESS ): BOOLEAN;
PROCEDURE InsertItem( dListHandle: DListHandle; item: ADDRESS ): BOOLEAN;
PROCEDURE DeleteFirstItem( dListHandle: DListHandle ): BOOLEAN;
PROCEDURE DeleteCurrItem( dListHandle: DListHandle ): BOOLEAN;
PROCEDURE GetFirstItem( dListHandle: DListHandle; VAR item: ADDRESS ): BOOLEAN;
PROCEDURE SetCurrItem( dListHandle: DListHandle; fromCurrent: BOOLEAN; selector: Selector ): BOOLEAN;
PROCEDURE GetCurrItem( dListHandle: DListHandle; VAR item: ADDRESS ): BOOLEAN;
PROCEDURE AdvanceItem( dListHandle: DListHandle; VAR item: ADDRESS ): BOOLEAN;
PROCEDURE DoForAll( dListHandle: DListHandle; itemProc: ItemProc );
PROCEDURE SortDList( dListHandle: DListHandle );
(*============================ DrawAgePyram ================================*)
TYPE AgePyramid;
PROCEDURE MakePyramid( VAR ap: AgePyramid );
PROCEDURE SetPyramidParameters( ap: AgePyramid; defltPlace, place: WindowFrame;
title, femaleLabel, maleLabel: ARRAY OF CHAR;
xMax: REAL; yTickInterval: INTEGER );
PROCEDURE GetPyramidParameters( ap: AgePyramid; VAR defltPlace, place: WindowFrame;
VAR title, femaleLabel, maleLabel: ARRAY OF CHAR;
VAR xMax: REAL; VAR yTickInterval: INTEGER );
PROCEDURE ResetPyramid( ap: AgePyramid );
PROCEDURE ShowPyramidWindow( ap: AgePyramid ); PROCEDURE HidePyramidWindow( ap: AgePyramid );
PROCEDURE DrawPyramid( ap: AgePyramid; VAR females, males: ARRAY OF REAL ); (* VAR for speed-up only *)
PROCEDURE DiscardPyramid( VAR ap: AgePyramid );
(*=========================== DrawParSpace ============================*)
(* of interest during parameter identification, see module IdentParMod *)
PROCEDURE ShowOrOpenParameterSpace;
PROCEDURE InstallParameters( m: Model; VAR p1, p2: Parameter );
PROCEDURE DeinstallParameters;
PROCEDURE UpdateParameterSpace( perfIndex: REAL );
PROCEDURE ClearParameterSpace;
PROCEDURE CloseParameterSpace;
(*============================ EasyAbout ==============================*)
CONST undefpictureID = 0;
PROCEDURE DeclareAbout( title: ARRAY OF CHAR; bodyText: PROC;
titleSize, aboutWidth, aboutHeight,
leftMargin, rightMargin, pictureID: INTEGER );
PROCEDURE WriteCenteredLn( s: ARRAY OF CHAR );
PROCEDURE WriteLeftAdjLn ( s: ARRAY OF CHAR );
PROCEDURE WriteRightAdjLn( s: ARRAY OF CHAR );
PROCEDURE OneLineUp;
PROCEDURE SetMargins( leftMargin, rightMargin: INTEGER );
PROCEDURE NoBodyText;
(*============================ EasyWindow =============================*)
PROCEDURE MakeEasyWindow;
PROCEDURE DiscardEasyWindow;
PROCEDURE SelectEasyWindowForOutput;
PROCEDURE IsEasyWindowOpen(): BOOLEAN;
PROCEDURE EasyWindowMenu(): Menu;
PROCEDURE PlaceEasyWindow( x, y, w, h: INTEGER );
PROCEDURE ResetEasyWindow;
(*============================ Errors ================================*)
CONST
allOk=0; userBase=300;
(* General 'Dialog Machine' *)
onlyAnInsert=-3; unknownErr=-2; insuffMem=-1; tooOldMac=9; tooManyTermProc=10;
notImplemented=100; userInterrupted = 101;
(* DMWindIO arithmetic *)
intOverflow=1; lowUpSame=2;
(* User Input (DMEntryForms etc.) *)
numExpected=5; outOfRange=7; wrongChar=3; wrongCharOrNone=14; only1Char=4; only1CharOrNone=15;
stringTooLong=16;
(* Object access *)
unknownWindow=8; unknownEditField=6; unknownGraph=11;
(* DM2DGraphs *)
noLogScale=12; graphTooSmall=17; fileResBase=20; fileNotFound=21; volNotFound=22; dlgCancelled=23;
unknownFile=24; tooManyFiles=25; diskFull=26; insuffMemForFileFct=27; fileAlreadyOpen=28;
fileIsBusy=29; fileIsLocked=30; fileFctNotDone=31;
PROCEDURE Info ( msgnr: INTEGER; getMsg: MsgRetrieveProc; modIdent, locDescr, insertions: ARRAY OF CHAR );
PROCEDURE Halt ( msgnr: INTEGER; getMsg: MsgRetrieveProc; modIdent, locDescr, insertions: ARRAY OF CHAR );
PROCEDURE Kill ( msgnr: INTEGER; getMsg: MsgRetrieveProc; modIdent, locDescr, insertions: ARRAY OF CHAR );
PROCEDURE DoInfo( msgnr: INTEGER; getMsg: MsgRetrieveProc; modIdent, locDescr, insertions: ARRAY OF CHAR );
PROCEDURE DoHalt( msgnr: INTEGER; getMsg: MsgRetrieveProc; modIdent, locDescr, insertions: ARRAY OF CHAR );
PROCEDURE DoKill( msgnr: INTEGER; getMsg: MsgRetrieveProc; modIdent, locDescr, insertions: ARRAY OF CHAR );
VAR nil: String;
PROCEDURE DbgMsg( modIdent, locDescr: ARRAY OF CHAR; s1, s2, s3, s4, s5: String );
PROCEDURE ReplacePlaceHolders( VAR newMsg: ARRAY OF CHAR; oldMsg, insertions: ARRAY OF CHAR );
PROCEDURE AppendLnBreak( VAR s: ARRAY OF CHAR );
(* Insertion construction *)
PROCEDURE SetInsert( VAR inserts: ARRAY OF CHAR; s: String );
PROCEDURE AppendInsert( VAR inserts: ARRAY OF CHAR; s: String );
PROCEDURE Str( s: ARRAY OF CHAR ): String;
PROCEDURE IStr( x: INTEGER ): String;
PROCEDURE LIStr( x: LONGINT ): String;
PROCEDURE RStr( x: REAL ): String;
PROCEDURE LRStr( x: LONGREAL ): String;
PROCEDURE BStr( x: BOOLEAN ): String;
(* Setting up & modes *)
PROCEDURE ActivateMessageFile( errDocFN: ARRAY OF CHAR; VAR resCode: INTEGER );
CONST globResCode = MIN(INTEGER); allResCode = MAX(INTEGER);
PROCEDURE SetErrHdlgModes( suppress,debug: BOOLEAN; minResCode,maxResCode: INTEGER; VAR done: BOOLEAN );
PROCEDURE GetErrHdlgModes( VAR suppress,debug: BOOLEAN; minResCode,maxResCode: INTEGER; VAR installed: BOOLEAN );
PROCEDURE ForgetRange( minResCode,maxResCode: INTEGER; VAR done: BOOLEAN );
(* easy display of postponed messages *)
PROCEDURE NoOfMsgs( minResCode,maxResCode: INTEGER ): INTEGER;
PROCEDURE ViewErrHistory( minResCode,maxResCode: INTEGER; withGlobMsg: BOOLEAN );
PROCEDURE AskAndViewErrHistory( minResCode,maxResCode: INTEGER; withGlobMsg: BOOLEAN;
VAR answeredToView: BOOLEAN; doViewOnUserYes: BOOLEAN );
PROCEDURE DisplayErrHistory( minResCode,maxResCode: INTEGER );
(* analysis and display of postponed messages *)
CONST noMoreErrs = 0; TYPE ErrorClass=( inform, warn, fatal ); (* for explanation see DMMessages *)
ErrorDescr= RECORD
class: ErrorClass; msg: ARRAY[0..255] OF CHAR; (* holds entire message text *)
resCode: INTEGER; modIdent, locDescr, insertions: ARRAY[0..255] OF CHAR;
END;
PROCEDURE OldestErrNo(): INTEGER;
PROCEDURE OldestErrIndex( minResCode,maxResCode: INTEGER ): INTEGER;
PROCEDURE GetError( n: INTEGER; VAR err: ErrorDescr );
PROCEDURE NextErrIndex ( fromNo,minResCode,maxResCode: INTEGER ): INTEGER;
PROCEDURE PrevErrIndex ( fromNo,minResCode,maxResCode: INTEGER ): INTEGER;
PROCEDURE DisplayAnError( VAR err: ErrorDescr );
PROCEDURE ForgetErrHistory( minResCode,maxResCode: INTEGER );
PROCEDURE ResetErrors;
(*============================ FileNameStrs ================================*)
VAR extSeparator, pathSeparator, volSeparator: CHAR;
PROCEDURE StripExt( fromName: ARRAY OF CHAR; VAR toName: ARRAY OF CHAR );
PROCEDURE SetNewExt( fromName, newExt: ARRAY OF CHAR; VAR toName: ARRAY OF CHAR );
PROCEDURE ExtractExt( pathAndFileName: ARRAY OF CHAR; VAR extension: ARRAY OF CHAR );
PROCEDURE ExtractFolderName (pathAndFileName: ARRAY OF CHAR; VAR folderName: ARRAY OF CHAR );
PROCEDURE ExtractFileName( pathAndFileName: ARRAY OF CHAR; VAR fName: ARRAY OF CHAR );
PROCEDURE ExtractPath( pathAndFileName: ARRAY OF CHAR; VAR path: ARRAY OF CHAR );
PROCEDURE ExtractRelPath( fullPath, basePath : ARRAY OF CHAR; VAR relPath: ARRAY OF CHAR );
PROCEDURE ExtractVolName( fullPath: ARRAY OF CHAR; VAR volName: ARRAY OF CHAR );
PROCEDURE SplitPathFileName( pathAndFileName: ARRAY OF CHAR; VAR path,fName: ARRAY OF CHAR );
PROCEDURE SplitVolPathFileName( fullPath: ARRAY OF CHAR; VAR volN, pathN, fileN: ARRAY OF CHAR );
PROCEDURE CompletePath( basePath, relPath: ARRAY OF CHAR; VAR fullPath: ARRAY OF CHAR );
PROCEDURE CompletePathFileName (volN, pathN, fName: ARRAY OF CHAR; VAR fullPathAndFileName: ARRAY OF CHAR );
(*=========================== FormulIntrpr ============================*)
TYPE
Expression;
Func1Arg= PROCEDURE( REAL ): REAL;
Func2Arg= PROCEDURE( REAL, REAL ): REAL;
Func3Arg= PROCEDURE( REAL, REAL, REAL ): REAL;
SyntaxError=( noErr, badReal, noLParen, noRParen, tooManyRParen, noComma, unknownIdent,
unknownFctIdent, badChar, badOperator, illEnd );
Symbol=( null, ident, num, lParen, rParen, comma, plus, minus, multiply, divide, power, unknown );
ProcPtr= POINTER TO ADDRESS;
FuncType=( none, monadic, diadic, triadic );
SymbolProc= PROCEDURE( Symbol, INTEGER, ARRAY OF CHAR );
StringProc= PROCEDURE( VAR ARRAY OF CHAR );
ArithmeticError=( noAriErr, invalidOperand, underFlow, overFlow, divByZero, complex, undefined );
VAR notInstalledExpression: Expression; (* read only *)
PROCEDURE GetSymbol( VAR formulStr: ARRAY OF CHAR; len: INTEGER; VAR pos: INTEGER; VAR symStr: ARRAY OF CHAR ): Symbol;
PROCEDURE ScanFormula( VAR formulStr: ARRAY OF CHAR; doWithSymbol: SymbolProc );
PROCEDURE WhatFunc( VAR ident: ARRAY OF CHAR; VAR p: ProcPtr ): FuncType;
PROCEDURE InstallExpression( VAR e: Expression; eName: ARRAY OF CHAR;
formulaStr: ARRAY OF CHAR; VAR posBadCHinF: INTEGER );
PROCEDURE DeclAndParseExpr ( VAR e: Expression; fName: ARRAY OF CHAR;
VAR formulaStr: ARRAY OF CHAR; VAR posBadCHinF: INTEGER );
PROCEDURE LastSyntaxErr(): SyntaxError;
PROCEDURE GetErrMsg( err: SyntaxError; VAR errStr: ARRAY OF CHAR );
PROCEDURE RemoveExpression( VAR e: Expression );
PROCEDURE ComputeExpression( e: Expression; VAR ariErr: ArithmeticError ): REAL;
PROCEDURE GetArithmErrMsg( ariErr: ArithmeticError; VAR errStr: ARRAY OF CHAR );
PROCEDURE ExtractFString( e: Expression; VAR fstr: ARRAY OF CHAR );
PROCEDURE GetFormulaName( e: Expression; VAR fName: ARRAY OF CHAR );
PROCEDURE SetFormulaName( e: Expression; VAR fName: ARRAY OF CHAR );
PROCEDURE InstallMonadicFunc( f1: Func1Arg; funcName: ARRAY OF CHAR; VAR done: BOOLEAN );
PROCEDURE InstallDiadicFunc( f2: Func2Arg; funcName: ARRAY OF CHAR; VAR done: BOOLEAN );
PROCEDURE InstallTriadicFunc( f3: Func3Arg; funcName: ARRAY OF CHAR; VAR done: BOOLEAN );
PROCEDURE RemoveFunc( funcName: ARRAY OF CHAR );
PROCEDURE PresentFuncNames( funcType: FuncType; strProc: StringProc );
(*============================ FormulVars =============================*)
CONST noAttr= NIL; noReal= NIL;
TYPE RealPtr= POINTER TO REAL; AttributePtr= ADDRESS;
PROCEDURE DeclareVar( ident: ARRAY OF CHAR; VAR x: REAL; attr: AttributePtr );
PROCEDURE RecordVar( VAR ident: ARRAY OF CHAR; VAR x: REAL; attr: AttributePtr );
PROCEDURE IsVar( VAR ident: ARRAY OF CHAR; VAR v: REAL; VAR realPtr: RealPtr ): BOOLEAN;
PROCEDURE VarVal( VAR ident: ARRAY OF CHAR ): REAL;
PROCEDURE VarPtr( VAR ident: ARRAY OF CHAR ): RealPtr;
PROCEDURE VarAttr( VAR ident: ARRAY OF CHAR ): AttributePtr;
PROCEDURE UndeclareVar( ident: ARRAY OF CHAR );
PROCEDURE DeleteVar( VAR ident: ARRAY OF CHAR );
PROCEDURE DiscardAllVars;
(*============================ Handlers ================================*)
TYPE
Object= SYSTEM. ADDRESS;
EventClass; EventHandler= PROC;
ObjectEventHandler= PROCEDURE( Object );
EvtAcceptTester= PROCEDURE(): BOOLEAN; DoForClassProc= PROCEDURE( EventClass, CARDINAL );
DoForHandlerProc= PROCEDURE( EventHandler, ObjectEventHandler,
BOOLEAN (*hasObject*), INTEGER (*priority*), CARDINAL );
CONST topPriority=0; lowestPriority= MAX( INTEGER );
VAR HandlersDone: BOOLEAN; undeclaredClass: EventClass; (* read only *)
PROCEDURE DeclareEventClass( VAR class: EventClass );
PROCEDURE ClassExists( class: EventClass ): BOOLEAN;
PROCEDURE RemoveEventClass( VAR class: EventClass );
PROCEDURE AddEventHandler( class: EventClass; newHdl: EventHandler; priority: INTEGER );
PROCEDURE AddObjectEventHandler( class: EventClass; newHdl: ObjectEventHandler; priority: INTEGER );
PROCEDURE RemoveEventHandler( class: EventClass; oldHdl: EventHandler );
PROCEDURE RemoveObjectEventHandler( class: EventClass; oldHdl: ObjectEventHandler );
PROCEDURE ExecuteEventHandlers( class: EventClass; obj: Object; whileNotAccepted: EvtAcceptTester;
minLevel, maxLevel: CARDINAL; topPrio, lowPrio: INTEGER );
PROCEDURE NotifyAll(): BOOLEAN;
PROCEDURE DoForAllClasses( cp: DoForClassProc );
PROCEDURE DoForAllHandlers( class: EventClass; hp: DoForHandlerProc );
(*============================ HashTables ================================*)
CONST hashTableOverFlow= userBase+250; unknownHashTable= userBase+251; unStoredKey= userBase+252;
TYPE HashTable; Key= INTEGER; UserEntry= ADDRESS; DoWithUserEntryProc= PROCEDURE( Key, UserEntry );
VAR nonExistentHashTable: HashTable; unknownEntry: UserEntry; resCode: INTEGER; (* read only *)
PROCEDURE CreateHashTable( VAR ht: HashTable ); (* Creates a new hash table ht *)
PROCEDURE HashTableExists( ht: HashTable ): BOOLEAN;
PROCEDURE StoreKey( ht: HashTable; newSeries: BOOLEAN; key: Key );
PROCEDURE DeleteKey( ht: HashTable; key: Key );
PROCEDURE Hash( ht: HashTable; k: Key; VAR found: BOOLEAN ): INTEGER;
PROCEDURE StoreEntry( ht: HashTable; k: Key; e: UserEntry );
PROCEDURE Entry( ht: HashTable; key: Key ): UserEntry;
PROCEDURE DoInSeries( ht: HashTable; fstkey: Key; dwuse: DoWithUserEntryProc );
PROCEDURE DeleteSeries( ht: HashTable; fstkey: Key; dwuse: DoWithUserEntryProc );
PROCEDURE DiscardHashTable( VAR ht: HashTable );
(*============================ Help ================================*)
PROCEDURE ShowHelpWindow;
PROCEDURE SetHelpFileName (fn: ARRAY OF CHAR );
PROCEDURE SetResourceFileName( fn: ARRAY OF CHAR );
PROCEDURE SetInstallationErrHandler( errMsg: PROC );
PROCEDURE SetDebugMode( debugOn: BOOLEAN );
PROCEDURE ResetHelp;
(*============================ Histograms ================================*)
TYPE Histogram; HistoAct = PROCEDURE (Histogram );
PROCEDURE DefineHistogram( w: Window; VAR h: Histogram; r: RectArea; fromClass,toClass: INTEGER;
xLabel: ARRAY OF CHAR; maxFreqency: CARDINAL; freqNumbs: BOOLEAN;
barCol: Color; barPat: Pattern );
PROCEDURE SetYTickInterval( h: Histogram; interval: INTEGER );
PROCEDURE ClearHistogram( h: Histogram );
PROCEDURE DrawHistogram( h: Histogram );
PROCEDURE MidTopPoint( h: Histogram; class: INTEGER; f: CARDINAL; VAR x,y: INTEGER );
PROCEDURE PlotBar( h: Histogram; class: INTEGER; f: CARDINAL );
PROCEDURE SetPlotBarMode( h: Histogram; wipeOut : BOOLEAN );
PROCEDURE GetPlotBarMode( h: Histogram; VAR wipeOut, done : BOOLEAN );
PROCEDURE RemoveHistogram( VAR h: Histogram );
PROCEDURE DoForAllHistograms( p: HistoAct );
(*============================ IdentifyPars ================================*)
TYPE RealFct = PROCEDURE (): REAL; MinMethod = (halfDouble, amoeba, price, random, brent, powell, simplex );
PROCEDURE MarkParForIdentification( VAR p: REAL );
PROCEDURE UnmarkParForIdentification( VAR p: REAL );
PROCEDURE UnmarkAllParsForIdentification;
PROCEDURE SetDefltMinim( meth: MinMethod; maxIter: INTEGER; convC: REAL );
PROCEDURE GetDefltMinim( VAR meth: MinMethod; VAR maxIter: INTEGER; VAR convC: REAL );
PROCEDURE MinimizeDialog( VAR method: MinMethod; VAR convC: REAL;
VAR maxIter: INTEGER; VAR cancOrNoPs, anyPRChanged: BOOLEAN );
PROCEDURE Minimize( method: MinMethod; convC: REAL; maxIter: INTEGER; func: RealFct );
PROCEDURE SuppressAllMonitoring;
PROCEDURE ResetAllMonitoring;
PROCEDURE MinimizeAfterDialog( func: RealFct );
(*=========================== IdentParMod ============================*)
VAR identifyParModDescr: ARRAY[0..63] OF CHAR; (* read only *)
PROCEDURE ActivateIdentifyParMod; (* activates a pseuod parallel model for parameter identification *)
PROCEDURE IdentifyParModIsActive(): BOOLEAN;
PROCEDURE DeactivateIdentifyParMod;
PROCEDURE InstallSysOutput( VAR y: OutVar );
PROCEDURE SysOutputInstalled(): BOOLEAN;
PROCEDURE DeinstallSysOutput;
PROCEDURE InstallMeasurement( VAR yDash: OutVar; t0, tn: REAL );
PROCEDURE MeasurementInstalled(): BOOLEAN;
PROCEDURE DeinstallMeasurement;
PROCEDURE IgnoreMissingValues( ignore: BOOLEAN ); PROCEDURE MissingValuesIgnored(): BOOLEAN;
PROCEDURE UseLogPerformanceIndex( uselg: BOOLEAN ); PROCEDURE LogPerformanceIndexInUse(): BOOLEAN;
PROCEDURE SetNegLogOffset( q0: REAL ); PROCEDURE GetNegLogOffset( VAR q0: REAL );
PROCEDURE ScalePerfIndexBy( scalePI: REAL ); PROCEDURE PerfIndexIsScaledBy( VAR scalePI: REAL );
PROCEDURE HideParFromIdentification ( m: Model; ident: ARRAY OF CHAR; hideit: BOOLEAN );
PROCEDURE IsParHiddenFromIdentification ( m: Model; ident: ARRAY OF CHAR ): BOOLEAN;
(*============================ Jacobi ================================*)
CONST VecSize=40;
TYPE Vector = ARRAY [1..VecSize] OF REAL; Matrix = ARRAY [1..VecSize] OF Vector;
PROCEDURE Jacobi( VAR mat: Matrix; dim: INTEGER; VAR eigVals: Vector;
VAR eigVecs: Matrix; VAR numRot: INTEGER );
PROCEDURE EigSort( VAR eigVals: Vector; VAR eigVecs: Matrix; dim: INTEGER );
(*============================= JacobiL ===============================*)
CONST VecSize= MaxElems;
TYPE Vector= LVector; Matrix= LMatrix;
PROCEDURE Jacobi( VAR mat: Matrix; dim: INTEGER; VAR eigVals: Vector;
VAR eigVecs: Matrix; VAR numRot: INTEGER );
PROCEDURE EigSort( VAR eigVals: Vector; VAR eigVecs: Matrix; dim: INTEGER );
(*============================= JumpTab ===============================*)
TYPE
JumpTabErrorCodes = ( NoError, FileError, WrongVersion, WrongMachine, NoMemory,
TabNotFound, TabAlredyExists, ItemNotFound, WrongMode );
TabHandle; TabLocation=( onFile, inMemory );
TabItem= RECORD posInfo: LONGINT; ident: INTEGER; attribute: LONGINT; END;
PROCEDURE NewTab( VAR tab: TabHandle; location: TabLocation ): JumpTabErrorCodes;
PROCEDURE AddItem( tab: TabHandle; item: TabItem ): JumpTabErrorCodes;
PROCEDURE TabSize( tab: TabHandle; VAR size: CARDINAL ): JumpTabErrorCodes;
PROCEDURE WriteTab( tab: TabHandle; fileName, tabHeader: ARRAY OF CHAR ): JumpTabErrorCodes;
PROCEDURE ReadTab( fileName: ARRAY OF CHAR; VAR tab: TabHandle ): JumpTabErrorCodes;
PROCEDURE GetItem( tab: TabHandle; ident: INTEGER; VAR item: TabItem ): JumpTabErrorCodes;
PROCEDURE DisposeTab( tab: TabHandle ): JumpTabErrorCodes;
(*============================ Lists ================================*)
TYPE
List; SelectionMode = (single, multipleAdjacent, multipleDisconnected );
DispListItemProc = PROCEDURE ( ADDRESS, INTEGER, INTEGER );
ItemSelection = ( selected, notSelected, all );
ListItemProc = PROCEDURE ( ADDRESS );
ListItemWhileProc = PROCEDURE ( ADDRESS, VAR BOOLEAN );
IsSuccessorProc = PROCEDURE ( ADDRESS, ADDRESS ): BOOLEAN;
ConditionProc = PROCEDURE ( ADDRESS ): BOOLEAN;
VAR noList: List; (* read only variable! *)
PROCEDURE DeclList ( VAR list: List; listName: ARRAY OF CHAR );
PROCEDURE RemoveList( VAR list: List );
PROCEDURE ListExists( list: List ): BOOLEAN;
PROCEDURE InsertInList ( list: List; aListItem, beforeItem: ADDRESS );
PROCEDURE DeleteFromList( list: List; VAR aListItem: ADDRESS );
PROCEDURE ListItemExists( list: List; listItem: ADDRESS ): BOOLEAN;
PROCEDURE DoWithListItems ( list: List; doWith: ItemSelection; doSomething: ListItemProc );
PROCEDURE DoWithListItemsWhile( list: List; doWith: ItemSelection; doSomething: ListItemWhileProc );
PROCEDURE SortList( list: List; isSuccessor: IsSuccessorProc );
PROCEDURE InstallLISBox( list : List; window : Window; scrBFrame : RectArea; title : ARRAY OF CHAR;
dispListItem : DispListItemProc; cellW, cellH : INTEGER; selMode : SelectionMode );
PROCEDURE RemoveLISBox( list : List );
PROCEDURE RedrawLISBox( list : List );
PROCEDURE DeclLISBox ( list : List; window : Window; scrBFrame : RectArea; title : ARRAY OF CHAR;
dispListItem : DispListItemProc; cellW, cellH : INTEGER; selMode : SelectionMode );
PROCEDURE SetLISBoxAttr( list: List; title : ARRAY OF CHAR; dispListItem : DispListItemProc;
selMode : SelectionMode );
PROCEDURE GetLISBoxAttr( list: List; VAR title : ARRAY OF CHAR; VAR dispListItem : DispListItemProc;
VAR selMode : SelectionMode );
PROCEDURE SetLISBoxFraming( li: List; boxFramed: BOOLEAN );
PROCEDURE GetLISBoxFraming( li: List; VAR boxFramed: BOOLEAN );
PROCEDURE SetScrollBarPlace( li: List; dx,dy,h: INTEGER );
PROCEDURE GetScrollBarPlace( li: List; VAR dx,dy,h: INTEGER );
PROCEDURE ScrollLISBox( li: List; by: INTEGER );
PROCEDURE FlipLISBox( li: List; direction: BOOLEAN );
PROCEDURE EnableLISBox ( list: List );
PROCEDURE DisableLISBox( list: List );
PROCEDURE ToggleLISBoxItem( li: List; item: ADDRESS; shifted: BOOLEAN );
PROCEDURE SetSelectionForAllIf (li: List; ifp: ConditionProc; isSelected: BOOLEAN );
PROCEDURE SetSelectionForAll (li: List; isSelected: BOOLEAN );
PROCEDURE JumpToLISBoxItem( list: List; item: ADDRESS );
PROCEDURE TopLISBoxItem( list: List ): ADDRESS;
PROCEDURE BotLISBoxItem( list: List ): ADDRESS;
PROCEDURE NextLISBoxItem( list: List; item: ADDRESS ): ADDRESS;
PROCEDURE PrevLISBoxItem( list: List; item: ADDRESS ): ADDRESS;
PROCEDURE IsSelected( list: List; item: ADDRESS ): BOOLEAN;
PROCEDURE GetListItemSelection( list: List; VAR lis: ARRAY OF ADDRESS; VAR nSelected: INTEGER );
PROCEDURE SetListItemSelection( list: List; VAR lis: ARRAY OF ADDRESS; nSelected: INTEGER );
(*============================ LogNTransf =============================*)
TYPE LnTrfType=( noLnTrf, posSkewLnTrf, negSkewLnTrf );
PROCEDURE GetLogNormalTransfParams( VAR data: ARRAY OF REAL; nElems: INTEGER; maxThetaFact: REAL;
VAR lnTrfType: LnTrfType; VAR lnTrfMu: REAL; VAR lnTrfSig: REAL;
VAR lnTrfTheta: REAL; VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE LogNormalProbDensity( mu, sig, theta: REAL; x: REAL ): REAL;
PROCEDURE LogNormalLnLikelihood( VAR data: ARRAY OF REAL; nElems: INTEGER; mu, sig, theta: REAL ): REAL;
PROCEDURE LogNormalTransfPossible( forValue: REAL; lnTrfType: LnTrfType; lnTrfTheta: REAL ): BOOLEAN;
PROCEDURE DoLogNormalTransf( lnTrfType: LnTrfType; lnTrfTheta: REAL; VAR value: REAL );
PROCEDURE DoLogNormalTransfForArr( lnTrfType: LnTrfType; lnTrfTheta: REAL; nElems: INTEGER;
VAR data: ARRAY OF REAL );
PROCEDURE UndoLogNormalTransf( lnTrfType: LnTrfType; lnTrfTheta: REAL; VAR value: REAL );
PROCEDURE UndoLogNormalTransfForArr( lnTrfType: LnTrfType; lnTrfTheta: REAL; nElems: INTEGER;
VAR data: ARRAY OF REAL );
(*============================ LMathProcs ================================*)
PROCEDURE LongEqual ( x,y: LONGREAL ): BOOLEAN;
PROCEDURE LSIGN ( x: LONGREAL ): LONGREAL; PROCEDURE LongInt ( x: LONGREAL ): LONGINT;
PROCEDURE LongRound ( x: LONGREAL ): LONGINT; PROCEDURE LongFrac ( x: LONGREAL ): LONGREAL;
PROCEDURE LongPowerI( x: LONGREAL; iexp: LONGINT ): LONGREAL; PROCEDURE LongPower ( x, exp: LONGREAL ): LONGREAL;
PROCEDURE LongLg ( x: LONGREAL ): LONGREAL; PROCEDURE LongFac ( k: CARDINAL ): LONGCARD;
PROCEDURE LIMax ( i1,i2: LONGINT ): LONGINT; PROCEDURE LIMin ( i1,i2: LONGINT ): LONGINT;
PROCEDURE LRMax ( x1,x2: LONGREAL ): LONGREAL; PROCEDURE LRMin ( x1,x2: LONGREAL ): LONGREAL;
PROCEDURE LongPi (): LONGREAL; PROCEDURE LongTan ( x: LONGREAL ): LONGREAL;
PROCEDURE LongArcSin( x: LONGREAL ): LONGREAL; PROCEDURE LongArcCos( x: LONGREAL ): LONGREAL;
(*========================== LMatInvert ============================*)
PROCEDURE GetMatInvertTolerance( VAR tol: LONGREAL );
PROCEDURE SetMatInvertTolerance( tol: LONGREAL );
PROCEDURE InvertMatrix( VAR(* speed-up *) mat: LMatrix; nRowsCols: INTEGER;
VAR inv: LMatrix; VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE SolveLinEqu( VAR(*speed-up*) A: LMatrix; nRowsCols: INTEGER;
VAR(*speed-up*) b: LVector; VAR x: LVector;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
(*=========================== LMatrices ============================*)
CONST MaxElems=62;
TYPE LVector= ARRAY[1.. MaxElems] OF LONGREAL; LVectorPtr= POINTER TO LVector;
TYPE LMatrix= ARRAY[1.. MaxElems] OF LVector; LMatrixPtr= POINTER TO LMatrix;
PROCEDURE AllocVector( VAR vec: LVectorPtr; initVal: LONGREAL; (* value to inite *)
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE DeallocVector( VAR vec: LVectorPtr );
PROCEDURE AllocMatrix( VAR mat: LMatrixPtr; initVal: LONGREAL; (* value to inite *)
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE DeallocMatrix( VAR mat: LMatrixPtr );
PROCEDURE SetVector( VAR vec: LVector; val: LONGREAL );
PROCEDURE CopyVector( VAR(*speed-up*) vec: LVector; nElements: INTEGER; VAR result: LVector );
PROCEDURE MatVecProduct( VAR(*speed-up*) mat: LMatrix; VAR(*speed-up*) vec: LVector;
nRowsCols: INTEGER; VAR result: LVector );
PROCEDURE SetMatrixColumn( VAR mat: LMatrix; columnNr: INTEGER; VAR(*speed-up*) colData: LVector );
PROCEDURE GetMatrixColumn( VAR(*speed-up*) mat: LMatrix; columnNr: INTEGER; VAR colData: LVector );
PROCEDURE SetMatrix( VAR mat: LMatrix; val: LONGREAL );
PROCEDURE SetToIdentityMatrix( VAR mat: LMatrix );
PROCEDURE IsIdentityMatrix( VAR(*speed-up*) mat: LMatrix; nRowsCols: INTEGER;
tolerance: LONGREAL ): BOOLEAN;
PROCEDURE ScaleMatrix( VAR mat: LMatrix; nRowsCols: INTEGER; factor: LONGREAL );
PROCEDURE CopyMatrix( VAR(*speed-up*) mat: LMatrix; nRowsCols: INTEGER; VAR result: LMatrix );
PROCEDURE TransposeMatrix( VAR(*speed-up*) mat: LMatrix; nRowsCols: INTEGER; VAR result: LMatrix );
PROCEDURE MatrixProduct( VAR(*speed-up*) mat1,mat2: LMatrix; nRowsCols: INTEGER; VAR result: LMatrix );
PROCEDURE MatrixSum ( VAR(*speed-up*) mat1,mat2: LMatrix; nRowsCols: INTEGER; VAR result: LMatrix );
PROCEDURE ReadMatrix ( filename: ARRAY OF CHAR; VAR mat: LMatrix;
VAR nRows: INTEGER; VAR nCols: INTEGER;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE WriteMatrix( filename: ARRAY OF CHAR; VAR(*speed-up*) mat: LMatrix;
nRows: INTEGER; nCols: INTEGER;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
(*============================ Matrices ================================*)
TYPE
Matrix;
Cell = RECORD row, col: INTEGER; END;
Selection = RECORD tople: Cell; botri : Cell; active: Cell; END;
(*============================ MatAccess ================================*)
PROCEDURE SetMatrixEle( m: Matrix; row, col: INTEGER; val: REAL );
PROCEDURE GetMatrixEle( m: Matrix; row, col: INTEGER; VAR val: REAL );
PROCEDURE MEle( m: Matrix; row, col: INTEGER ): REAL;
PROCEDURE FillMatrix ( m: Matrix; v : REAL );
PROCEDURE SetMatrixRow( m: Matrix; nrRow : INTEGER; VAR rowArr : ARRAY OF REAL );
PROCEDURE SetMatrixCol( m: Matrix; nrCol : INTEGER; VAR colArr : ARRAY OF REAL );
PROCEDURE GetMatrixRow( m: Matrix; nrRow : INTEGER; VAR rowArr : ARRAY OF REAL );
PROCEDURE GetMatrixCol( m: Matrix; nrCol : INTEGER; VAR colArr : ARRAY OF REAL );
PROCEDURE SetIndexRangeChecking( doCheck: BOOLEAN );
PROCEDURE GetIndexRangeChecking( VAR doCheck: BOOLEAN );
PROCEDURE SetMatrixName( m: Matrix; VAR name: ARRAY OF CHAR );
PROCEDURE GetMatrixName( m: Matrix; VAR name: ARRAY OF CHAR );
(*============================ MatCopy ================================*)
VAR selOneOne : Selection; (* read only ! *)
PROCEDURE AssignMatrix( VAR myMatrix: ARRAY OF BYTE; m,n: INTEGER; VAR mat: Matrix );
PROCEDURE RetrieveMatrix( mat: Matrix; VAR myMatrix: ARRAY OF BYTE; m,n: INTEGER );
PROCEDURE CopyMatrix( a: Matrix; VAR b: Matrix );
PROCEDURE SelWholeMat( m: Matrix; VAR sel: Selection );
PROCEDURE CopySelection (sourceMat: Matrix; area: Selection; destMat : Matrix; topLeft: Cell );
PROCEDURE SwapSelections( mat1: Matrix; area: Selection; mat2 : Matrix; topLeft: Cell );
PROCEDURE SwapRows( mat1: Matrix; row1: INTEGER; mat2: Matrix; row2: INTEGER );
PROCEDURE SwapCols( mat1: Matrix; col1: INTEGER; mat2: Matrix; col2: INTEGER );
PROCEDURE FillDown ( mat: Matrix; area: Selection );
PROCEDURE FillRight( mat: Matrix; area: Selection );
(*============================ MatDeclare ================================*)
VAR notExistingMatrix: Matrix; (* read only variable! *)
PROCEDURE DeclMatrix( VAR m: Matrix; nRows, nCols: INTEGER; name : ARRAY OF CHAR );
PROCEDURE MatrixExists( m: Matrix ): BOOLEAN;
PROCEDURE RemoveMatrix( VAR m: Matrix );
PROCEDURE SetMatrixDim( VAR m: Matrix; nRows, nCols: INTEGER );
PROCEDURE GetMatrixDim( m: Matrix; VAR nRows, nCols: INTEGER );
(*============================ MatFile ================================*)
TYPE
MatFormOut = RECORD
realF: RealFormat; len, dec: CARDINAL;
separator: ARRAY[0..63] OF CHAR;
crCol: INTEGER; eOM : ARRAY[0..63] OF CHAR;
END;
MatFormIn = RECORD
separator: ARRAY[0..63] OF CHAR; nCols : INTEGER;
rowSep : ARRAY[0..63] OF CHAR; eOM : ARRAY[0..63] OF CHAR;
END;
VAR standardO: MatFormOut; standardI: MatFormIn; matFileOk: BOOLEAN;
PROCEDURE SetMatFormIn ( mf: MatFormIn ); PROCEDURE GetMatFormIn ( VAR mf: MatFormIn );
PROCEDURE SetMatFormOut( mf: MatFormOut ); PROCEDURE GetMatFormOut( VAR mf: MatFormOut );
PROCEDURE WriteMatrix( f : TextFile; m: Matrix );
PROCEDURE WriteRow ( f : TextFile; m: Matrix; rowNr : INTEGER );
PROCEDURE WriteCol ( f : TextFile; m: Matrix; colNr : INTEGER );
PROCEDURE WriteEle ( f : TextFile; m: Matrix; row,col: INTEGER );
PROCEDURE ReadMatrix ( f : TextFile; m: Matrix );
PROCEDURE ReadRow ( f : TextFile; m: Matrix; rowNr : INTEGER );
PROCEDURE ReadCol ( f : TextFile; m: Matrix; colNr : INTEGER );
PROCEDURE ReadEle ( f : TextFile; m: Matrix; row,col: INTEGER );
(*============================ MathProcs ================================*)
PROCEDURE Equal ( x,y: REAL ): BOOLEAN;
PROCEDURE SIGN ( x: REAL ): REAL; PROCEDURE Int ( x: REAL ): INTEGER;
PROCEDURE Round ( x: REAL ): INTEGER; PROCEDURE Frac ( x: REAL ): REAL;
PROCEDURE PowerI( x: REAL; iexp: INTEGER ): REAL; PROCEDURE Power ( x, exp: REAL ): REAL;
PROCEDURE Lg ( x: REAL ): REAL; PROCEDURE Fac ( k: CARDINAL ): CARDINAL;
PROCEDURE IMax ( i1,i2: INTEGER ): INTEGER; PROCEDURE IMin ( i1,i2: INTEGER ): INTEGER;
PROCEDURE RMax ( x1,x2: REAL ): REAL; PROCEDURE RMin ( x1,x2: REAL ): REAL;
PROCEDURE Pi (): REAL; PROCEDURE Tan ( x: REAL ): REAL;
PROCEDURE ArcSin( x: REAL ): REAL; PROCEDURE ArcCos( x: REAL ): REAL;
(*============================ MsgFile ================================*)
CONST english = 0; german = 1; french = 2; italian = 3; myLanguage1 = 4; myLanguage2 = 5; undefMsgNr = -1;
PROCEDURE SetMessageLanguage( l: INTEGER );
PROCEDURE SetAsMessageFile( fn: ARRAY OF CHAR; VAR done: BOOLEAN );
PROCEDURE GetMessage( msgnr: INTEGER; VAR msg: ARRAY OF CHAR );
PROCEDURE GetNumberedMessage( msgnr: INTEGER; VAR msg: ARRAY OF CHAR );
(*============================ MultiNormal ================================*)
TYPE MultiNDistr;
VAR notDeclaredMultiNDistr: MultiNDistr; (* read only *)
PROCEDURE DeclareMultiNDistr( VAR muVec: Vector; VAR sigVec: Vector; VAR corMat: Matrix;
dim: INTEGER; VAR mnd: MultiNDistr );
PROCEDURE MultiNDistrDeclared( mnd: MultiNDistr ): BOOLEAN;
PROCEDURE MultiN( mnd: MultiNDistr; VAR vals: Vector );
PROCEDURE UndeclareMultiNDistr( VAR mnd: MultiNDistr );
(*============================ PatSelect ==============================*)
PROCEDURE SetUpPatSelWindow( title: ARRAY OF CHAR; x, y: INTEGER );
PROCEDURE RemovePatSelWindow;
PROCEDURE PatSelWindowExists( ): BOOLEAN;
PROCEDURE SetColAndPatSelection( col: Color; pttrn: Pattern );
PROCEDURE GetColAndPatSelection( VAR col: Color; VAR pttrn: Pattern );
PROCEDURE DoColAndPatSelection( displayMsg: ARRAY OF CHAR; VAR col: Color; VAR pttrn: Pattern );
(*============================= Patterns ==============================*)
VAR patt: ARRAY [0..59] OF Pattern;
(*============================ PosixAndHFS ================================*)
PROCEDURE PosixPathToHFS (pp: ARRAY OF CHAR; VAR hfsp: ARRAY OF CHAR );
PROCEDURE HFSPathToPosix (hfsp: ARRAY OF CHAR; VAR pp: ARRAY OF CHAR );
(*============================ Preferences ================================*)
CONST maxModes=99;
PROCEDURE RetrievePreferences( prefsFileName: ARRAY OF CHAR; prefsID: INTEGER;
VAR modes: ARRAY OF BOOLEAN; VAR str: ARRAY OF CHAR;
VAR done: BOOLEAN );
PROCEDURE StorePreferences( prefsFileName: ARRAY OF CHAR; prefsID: INTEGER;
modes: ARRAY OF BOOLEAN; str: ARRAY OF CHAR );
PROCEDURE AppendStr( VAR dest: ARRAY OF CHAR; substr: ARRAY OF CHAR );
PROCEDURE AppendInt( VAR dest: ARRAY OF CHAR; int: INTEGER );
PROCEDURE AppendReal( VAR dest: ARRAY OF CHAR; r: REAL );
PROCEDURE ExtractStr( VAR (*speedp-up*) src: ARRAY OF CHAR; start: BOOLEAN; VAR substr: ARRAY OF CHAR );
PROCEDURE ExtractInt( VAR (*speedp-up*) src: ARRAY OF CHAR; start: BOOLEAN; VAR int: INTEGER );
PROCEDURE ExtractReal( VAR (*speedp-up*) src: ARRAY OF CHAR; start: BOOLEAN; VAR r: REAL );
(*============================ Queues ================================*)
TYPE FIFOQueue; ItemAction = PROCEDURE (Transaction );
VAR notExistingFIFOQueue: FIFOQueue; (* read only *)
PROCEDURE CreateFIFOQueue ( VAR q: FIFOQueue; maxLength: INTEGER );
PROCEDURE EmptyFIFOQueue ( q: FIFOQueue );
PROCEDURE FileIntoFIFOQueue ( q: FIFOQueue; ta: Transaction );
PROCEDURE FirstInFIFOQueue ( q: FIFOQueue ): Transaction;
PROCEDURE Take1stFromFIFOQueue( q: FIFOQueue ): Transaction;
PROCEDURE FIFOQueueLength ( q: FIFOQueue ): INTEGER;
PROCEDURE IsFIFOQueueFull ( fifoq: FIFOQueue ): BOOLEAN;
PROCEDURE IsFIFOQueueEmpty( fifoq: FIFOQueue ): BOOLEAN;
PROCEDURE DoForAllInFIFOQueue ( q: FIFOQueue; ia: ItemAction );
PROCEDURE FIFOQueueExists ( q: FIFOQueue ): BOOLEAN;
PROCEDURE DiscardFIFOQueue( VAR q: FIFOQueue );
(*============================ RandGen ================================*)
PROCEDURE SetSeeds( z0,z1,z2: INTEGER ); (*defaults: z0=1, z1=10000, z2=3000*)
PROCEDURE GetSeeds( VAR z0,z1,z2: INTEGER );
PROCEDURE Randomize;
PROCEDURE ResetSeeds;
PROCEDURE U(): REAL; (*U~(0,1], cycle length >≈ 2.78 E13 ~ 220 years for 1000 U/sec*)
(*============================ RandGen0 ================================*)
PROCEDURE J(): INTEGER; PROCEDURE Jp( min, max: INTEGER ): INTEGER;
PROCEDURE SetJPar( min,max: INTEGER ); PROCEDURE GetJPar( VAR min,max: INTEGER );
PROCEDURE R(): REAL; PROCEDURE Rp( min, max: REAL ): REAL;
PROCEDURE SetRPar( min,max: REAL ); PROCEDURE GetRPar( VAR min,max: REAL );
PROCEDURE NegExp(): REAL; PROCEDURE NegExpP( lambda: REAL ): REAL;
PROCEDURE SetNegExpPar( lambda: REAL ); PROCEDURE GetNegExpPar( VAR lambda: REAL );
TYPE URandGen = PROCEDURE(): REAL;
PROCEDURE InstallU0( u0: URandGen );
PROCEDURE InstallU1( u1: URandGen );
(*============================ RandGen1 ================================*)
PROCEDURE Weibull(): REAL;
PROCEDURE WeibullP( alpha,beta: REAL ): REAL;
PROCEDURE SetWeibullPars( alpha,beta: REAL );
PROCEDURE GetWeibullPars( VAR alpha,beta: REAL );
PROCEDURE Triang(): REAL;
PROCEDURE TriangP( min,mode,max: REAL ): REAL;
PROCEDURE SetTriangPars( min,mode,max: REAL );
PROCEDURE GetTriangPars( VAR min,mode,max: REAL );
PROCEDURE VM(): REAL;
PROCEDURE VMP( mean,kappa: REAL ): REAL;
PROCEDURE SetVMPars( mean,kappa: REAL );
PROCEDURE GetVMPars( VAR mean,kappa: REAL );
TYPE URandGen= PROCEDURE(): REAL;
PROCEDURE InstallU0( u0: URandGen );
PROCEDURE InstallU1( u1: URandGen );
(*============================ RandNormal ================================*)
TYPE URandGen = PROCEDURE(): REAL;
PROCEDURE InstallU( U: URandGen ); (* do always call *)
PROCEDURE N(): REAL; (* N~(mu,stdDev) *)
PROCEDURE Np( mu,stdDev: REAL ): REAL;
PROCEDURE SetPars( mu,stdDev: REAL ); (* defaults mu = 0, stdDev = 1 *)
PROCEDURE GetPars( VAR mu,stdDev: REAL );
PROCEDURE ResetN; (* call after SetSeeds for full reset of N *)
(*============================= Randoms ===============================*)
PROCEDURE U(): REAL;
PROCEDURE SetMultiplier( multiplierA: LONGINT ); (* See remarks above *)
PROCEDURE Seed( z0: LONGINT ); (*default z0 = 1*)
PROCEDURE GetZ( VAR curz: LONGINT );
(*============================ ReadData ================================*)
VAR dataF: TextFile; readingAborted: BOOLEAN;
PROCEDURE OpenADataFile( VAR fn: ARRAY OF CHAR; VAR ok: BOOLEAN ); (* always with dialog *)
PROCEDURE OpenDataFile ( VAR fn: ARRAY OF CHAR; VAR ok: BOOLEAN ); (* normally no dialog *)
PROCEDURE ReReadDataFile; (* performs a reset *)
PROCEDURE CloseDataFile;
PROCEDURE SkipHeaderLine;
PROCEDURE ReadHeaderLine( VAR labels: ARRAY OF String; VAR nrVars: INTEGER );
(* assign NIL to labels before first use! *)
PROCEDURE ReadLn ( VAR txt: ARRAY OF CHAR );
PROCEDURE GetChars( VAR str: ARRAY OF CHAR );
PROCEDURE GetStr ( VAR str: String );
PROCEDURE SkipGapOrComment; (* skips <= ' ' and '(* ..... *)" *)
PROCEDURE ReadCharsUnlessAComment( VAR string: ARRAY OF CHAR );
PROCEDURE GetInt ( desc: ARRAY OF CHAR; loc: INTEGER; VAR x: INTEGER; min, max: INTEGER );
PROCEDURE GetReal( desc: ARRAY OF CHAR; loc: INTEGER; VAR x: REAL; min, max: REAL );
PROCEDURE SetMissingValCode( missingValCode: CHAR ); (* default = 'N' ; may be used in dataF to denote missing values *)
PROCEDURE GetMissingValCode( VAR missingValCode: CHAR );
PROCEDURE SetMissingReal ( missingReal: REAL ); (* default = DMConversions.UndefREAL( ); value used for missing reals *)
PROCEDURE GetMissingReal ( VAR missingReal: REAL );
PROCEDURE SetMissingInt ( missingInt: INTEGER ); (* default = MIN(INTEGER)+1; value used for missing integers *)
PROCEDURE GetMissingInt ( VAR missingInt: INTEGER );
PROCEDURE SetEOSCode( eosCode: CHAR ); (* default ASCII us (unit seperator) 37C *)
PROCEDURE GetEOSCode( VAR eosCode: CHAR );
PROCEDURE FindSegment( segNr: CARDINAL; VAR found: BOOLEAN ); (* first segNr = 1 *)
PROCEDURE SkipToNextSegment( VAR done: BOOLEAN );
PROCEDURE AtEOL(): BOOLEAN;
PROCEDURE AtEOS(): BOOLEAN;
PROCEDURE AtEOF(): BOOLEAN;
PROCEDURE TestEOF; (* use only where you don't expect EOF (shows alert) *)
TYPE Relation = ( smaller, equal, greater );
PROCEDURE Compare2Strings( a, b: ARRAY OF CHAR ): Relation;
CONST negLogDelta = 0.01; (*offset to plot log scale if values <= 0*)
TYPE
ErrorType = (NoInt, NoReal, TooBig, TooSmall, NotEqual, EndOfFile, FileNotFound, DataFNotOpen );
NumbType = (Real, Integer );
Error = RECORD
errorType : ErrorType; strFound : ARRAY[0..63] OF CHAR;
CASE numbType : NumbType OF
Integer : minI, maxI: INTEGER
| Real : minR, maxR: REAL
ELSE END;
desc :ARRAY [0..255] OF CHAR; loc :INTEGER
END;
ErrMsgProc = PROCEDURE( Error );
PROCEDURE SetErrMsgP( errP: ErrMsgProc );
PROCEDURE GetErrMsgP( VAR currErrP: ErrMsgProc );
PROCEDURE UseDefaultErrMsg;
(*============================ RelHandler =============================*)
TYPE Object= RECORD id: ADDRESS; type: INTEGER; END;
PROCEDURE InitializeRelationHandler( maxObjects: INTEGER );
PROCEDURE ReleaseRelationHandler;
PROCEDURE NotifyObject( obj: Object );
PROCEDURE IsNotified( obj: Object ): BOOLEAN;
PROCEDURE DenotifyObject( obj: Object );
PROCEDURE Relate( obj, toObj: Object );
PROCEDURE Related( obj, toObj: Object ): BOOLEAN;
PROCEDURE Unrelate( obj, toObj: Object );
PROCEDURE RelatedTo( obj: ADDRESS; VAR lst: ARRAY OF Object; VAR count: INTEGER );
PROCEDURE AdjacentTo( obj: ADDRESS; VAR lst: ARRAY OF Object; VAR count: INTEGER );
PROCEDURE CircularPaths( startFromObj: ADDRESS; VAR path: ARRAY OF Object; VAR lgth: INTEGER ): BOOLEAN;
PROCEDURE CircularGraph( VAR path: ARRAY OF Object; VAR lgth: INTEGER ): BOOLEAN;
(*============================= ScanAux ===============================*)
VAR globErrTxt: ARRAY[0..127] OF CHAR;
PROCEDURE DocumentError( explanation: ARRAY OF CHAR );
PROCEDURE SkipToSym( ss: Symbol ): BOOLEAN;
PROCEDURE Get( ss: Symbol ): BOOLEAN;
PROCEDURE GetInteger( VAR int: INTEGER ): BOOLEAN;
PROCEDURE GetLongInt( VAR lint: LONGINT ): BOOLEAN;
PROCEDURE GetReal( VAR real: REAL ): BOOLEAN;
PROCEDURE GetLongReal( VAR lreal: LONGREAL ): BOOLEAN;
PROCEDURE GetString( VAR str: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE GetID( VAR id: ARRAY OF CHAR ): BOOLEAN;
(*============================= Scanner ===============================*)
CONST MaxChars=1024; LgthResWord=32; MaxResWords=128;
TYPE
SymTable; Symbol = INTEGER;
Str256 = ARRAY[0.. MaxChars-1] OF CHAR;
(* symbols common to all symbol tables *)
nul = 0; (* a bad file or number syntax or an overflow occurred *)
eodSym = -1; (* end of data or of file reached *)
unknownIdent = -2; (* token has syntax of an ident, but is not in the symbol table*)
integerSym = -3; (* an integer number *)
longIntSym = -4; (* a longinteger number *)
realSym = -5; (* a real number *)
longRealSym = -6; (* a longreal number *)
strSym = -7; (* a string *)
specialCharSym = -8; (* a non-"white space" character, given that none of
the above symbols can be returned *)
TYPE
ScannerError = ( noError, unexpectedEOD, badSeparation, badRealSyntax, badIdentSyntax,
numOverflow, identOverflow, strOverflow, strContainsEOL, commentNotClosed );
VAR
str: Str256; (* The last scanned token *)
sym: Symbol; (* Symbolic meaning of the token *)
scanErr: ScannerError; (* Will be <>noError if sym=nul *)
scanErrStr: Str256;
int: INTEGER; lint: LONGINT;
real: REAL; lreal: LONGREAL;
whiteChFollows: BOOLEAN;
notDeclaredSymTable: SymTable; (* read only *)
PROCEDURE IsIdentifier( str: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE IsAllowedResWord( str: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE NewSymTable( VAR symTbl: SymTable;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE RemoveSymTable( VAR symTbl: SymTable );
PROCEDURE InsertSymbol( symTbl: SymTable; resWrd: ARRAY OF CHAR; sym: Symbol;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE InitFileScan( fileName: ARRAY OF CHAR; symTbl: SymTable;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE InitBufferScan( VAR buff: ARRAY OF CHAR; symTbl: SymTable;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE StopScanner;
PROCEDURE SetSymTable( symTbl: SymTable; VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE CurSymTable(): SymTable;
PROCEDURE SetCaseSensitivity( cs: BOOLEAN );
PROCEDURE GetSym;
PROCEDURE ReGetSym;
PROCEDURE GetResWord( symTbl: SymTable; sym: Symbol; VAR str: ARRAY OF CHAR );
PROCEDURE GetLineCount( VAR lineNr: LONGINT );
PROCEDURE GetCharCount( VAR charPos: INTEGER );
PROCEDURE TryGetString( VAR ss: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE TryGetInteger( VAR ii: INTEGER ): BOOLEAN;
PROCEDURE TryGetLongInt( VAR li: LONGINT ): BOOLEAN;
PROCEDURE TryGetReal( VAR rr: REAL ): BOOLEAN;
PROCEDURE TryGetLongReal( VAR lr: LONGREAL ): BOOLEAN;
PROCEDURE TryGetText( untilSym: Symbol; VAR txt: ARRAY OF CHAR ): INTEGER;
(*============================ Selector ================================*)
TYPE
Item= ADDRESS;
FirstItemProc= PROCEDURE(): Item;
NextItemProc= PROCEDURE( Item ): Item;
ItemExistsProc= PROCEDURE( Item ): BOOLEAN;
GetItemIdentProc= PROCEDURE( Item, VAR ARRAY OF CHAR );
MarkItemProc= PROCEDURE( Item, BOOLEAN );
SelectorSetup= RECORD
selectorTitle, checkBoxText: ARRAY[0..127] OF CHAR;
firstItem: FirstItemProc;
nextItem: NextItemProc;
itemExists: ItemExistsProc;
getItemIdent: GetItemIdentProc;
markItem: MarkItemProc;
selMode: SelectionMode;
END;
PROCEDURE ExecuteSelector( ssu: SelectorSetup; VAR checkBoxVar, okButtonPressed: BOOLEAN );
PROCEDURE ChooseFromList (selectorTitle: ARRAY OF CHAR; VAR(*speed-up*) strList: ARRAY OF CHAR;
VAR selection: ARRAY OF CHAR; delim: CHAR; selMode: SelectionMode );
(*=========================== SimDatAccess ============================*)
CONST simDatAccessErrOffset= userBase+390; (* constants used for resCode *)
PROCEDURE AnalyzeModelWorksModelBasis;
(* global data *)
PROCEDURE AssignGlobalSimulationData; PROCEDURE DeassignGlobalSimulationData;
(* model data *)
PROCEDURE AssignModelData( m: Model ); PROCEDURE AssignAllModelData;
PROCEDURE DeassignModelData( m: Model ); PROCEDURE DeassignAllModelData;
(* model object data *)
TYPE ModelObject= REAL;
PROCEDURE AssignMObjData( modObj: ModelObject );
PROCEDURE AssignModelsMObjData( m: Model );
PROCEDURE AssignAllMObjData;
PROCEDURE DeassignMObjData( modObj: ModelObject );
PROCEDURE DeassignModelsMObjData( m: Model );
PROCEDURE DeassignAllMObjData;
PROCEDURE CheckMObjData( modObj: ModelObject; VAR allOk: BOOLEAN );
PROCEDURE CheckModelsMObjData( m: Model; VAR allOk: BOOLEAN );
PROCEDURE CheckAllMObjData( VAR allOk: BOOLEAN );
(* monitoring *)
CONST noMonitoring=0;
PROCEDURE AssignMObjMonitoring( modObj: ModelObject; level: CARDINAL );
PROCEDURE AssignModelsMonitoring( m: Model; level: CARDINAL );
PROCEDURE AssignAllMonitoring( level: CARDINAL );
PROCEDURE DeassignMObjMonitoring( modObj: ModelObject );
PROCEDURE DeassignModelsMonitoring( m: Model );
PROCEDURE DeassignAllMonitoring;
PROCEDURE CheckMObjMonitoring( modObj: ModelObject; VAR allOk: BOOLEAN );
PROCEDURE CheckModelsMonitoring( m: Model; VAR allOk: BOOLEAN );
PROCEDURE CheckAllMonitoring( VAR allOk: BOOLEAN );
(* tallying *)
CONST noTallying=0;
PROCEDURE AssignMObjTallying( modObj: ModelObject; level: CARDINAL );
PROCEDURE AssignModelsTallying( m: Model; level: CARDINAL );
PROCEDURE AssignAllTallying( level: CARDINAL );
PROCEDURE DeassignMObjTallying( modObj: ModelObject );
PROCEDURE DeassignModelsTallying( m: Model );
PROCEDURE DeassignAllTallying;
PROCEDURE CheckMObjTallying( modObj: ModelObject; VAR allOk: BOOLEAN );
PROCEDURE CheckModelsTallying( m: Model; VAR allOk: BOOLEAN );
PROCEDURE CheckAllTallying( VAR allOk: BOOLEAN );
(*============================ SimDatAux ==============================*)
CONST simDatAuxErrOffset= userBase+330; (* constants used for resCode *)
(* Activation of User Interface (Menu Data) *)
PROCEDURE InstallSDAMenuCmds( title: ARRAY OF CHAR );
PROCEDURE RemoveSDAMenuCmds;
(* Core Functions *)
PROCEDURE LoadDFFromFileIntoMem;
PROCEDURE LoadDFFromOtherFileIntoMem( path, filename: ARRAY OF CHAR );
PROCEDURE AssignDatFraData;
PROCEDURE DeassignData;
PROCEDURE AssignGlobSimPars;
PROCEDURE AssignModelsMonitoringForLevel;
PROCEDURE AssignModelsTallyingForLevel;
PROCEDURE PlaceSimEnvsWindows;
PROCEDURE SaveDF;
PROCEDURE SaveAsDF;
(* Customization *)
PROCEDURE SimDatAuxMenu(): Menu;
PROCEDURE GetSDAMenuAliasChars( VAR loadDatAlCh, loadDatFromAlCh, sdfAlCh, sasdfAlCh,
assgnDatAlCh, deassignDatAlCh, assgnGloSiPsAlCh,
chMLevAlCh, chTLevAlCh, placeWinsAlCh,
chkErrAlCh, editPrefsAlCh, editAlChsAlCh: CHAR );
PROCEDURE SetSDAMenuAliasChars( loadDatAlCh, loadDatFromAlCh, sdfAlCh, sasdfAlCh,
assgnDatAlCh, deassignDatAlCh, assgnGloSiPsAlCh,
chMLevAlCh, chTLevAlCh, placeWinsAlCh,
chkErrAlCh, editPrefsAlCh, editAlChsAlCh: CHAR );
(* Preferences *)
CONST
suppressAllErrMode=0; warnOnceErrMode=1; immediateErrMode=2; debugErrMode=3; (* values used for packageErrMode *)
PROCEDURE SetSDAPreferences( clearAtDeassignMode, showIDsAlways, reportOnCheckFail: BOOLEAN;
packageErrMode: INTEGER; globLikePkgErrMode: BOOLEAN );
PROCEDURE GetSDAPreferences( VAR clearAtDeassignMode, showIDsAlways, reportOnCheckFail: BOOLEAN;
VAR packageErrMode: INTEGER; VAR globLikePkgErrMode: BOOLEAN );
PROCEDURE ResetSDAToPresettings;
(* Miscellaneous & Error Handling *)
PROCEDURE CheckForErrPresence;
(*============================ SimDatDump =============================*)
TYPE DataKind = BITSET;
CONST (* used for DataKind *)
project=1; systems=2; models=3; modObjects=4; stateVars=5; params=6;
monit=7; tally=8; globSimPars=9; windows=10; simEnvOptions=11;
VAR allData: DataKind; (* read only *)
PROCEDURE SaveDFsOnFile( VAR fn: ARRAY OF CHAR );
PROCEDURE SetDumpOptions( dk: DataKind; filetype, creator: ARRAY OF CHAR );
PROCEDURE GetDumpOptions( VAR dk: DataKind; VAR filetype, creator: ARRAY OF CHAR );
(*============================= StatAux ===============================*)
PROCEDURE GaussIntegr( z1, z2: REAL ): REAL;
PROCEDURE Chi2Integr( nDegFree: INTEGER; chi2: REAL ): REAL;
PROCEDURE SimpleChi2NormDistrTest( VAR(*speed-up*) data: ARRAY OF REAL; nElems: INTEGER;
minClWidth: INTEGER; muTst: REAL; sigTst: REAL;
VAR chi2: REAL; (* the goodness-of fit statistic *)
VAR nDegFree: INTEGER; (* degrees of freedom *)
VAR sgnfLev: REAL ); (* significance level in % *)
PROCEDURE RobustChi2NormDistrTest( VAR(*speed-up*) data: ARRAY OF REAL; nElems: INTEGER;
muTst: REAL; sigTst: REAL ): REAL;
PROCEDURE LinStats( VAR(*speed-up*) data: ARRAY OF REAL; nElems: INTEGER;
VAR nValid: INTEGER; VAR mu, sig, trd: REAL; VAR trdFVal: REAL );
PROCEDURE Skewness( VAR(*speed-up*) data: ARRAY OF REAL; nElems: INTEGER; mu, sig: REAL ): REAL;
PROCEDURE Extrema ( VAR(*speed-up*) data: ARRAY OF REAL; nElems: INTEGER; VAR min, max: REAL );
PROCEDURE Ranges ( VAR(*speed-up*) data: ARRAY OF REAL; nElems: INTEGER;
VAR min, max, med, low50, up50, low80, up80, low90, up90: REAL );
PROCEDURE LinReg ( VAR xx, yy: ARRAY OF REAL; nElems: INTEGER;
VAR nn, xmu, ymu, sxx, syy, sxy, a, b, cor: REAL );
PROCEDURE Max( i, j: INTEGER ): INTEGER;
PROCEDURE Min( i, j: INTEGER ): INTEGER;
PROCEDURE MuSigI( VAR data: ARRAY OF INTEGER; nElems: INTEGER; VAR mu, sig: REAL );
PROCEDURE RunMean( nRMElems, nElems: INTEGER; VAR data: ARRAY OF REAL );
PROCEDURE QuickSortXY( VAR a: ARRAY OF REAL; VAR b, c: ARRAY OF INTEGER; n: CARDINAL );
PROCEDURE Histogram ( nElems: INTEGER; VAR(*speed-up*) data: ARRAY OF REAL;
minFirstClass: REAL; VAR maxLastClass: REAL;
classWidth: REAL; VAR nBelowFirstClass, nAboveLastClass: INTEGER;
VAR histogram: ARRAY OF INTEGER );
PROCEDURE BuildClasses( nElems: INTEGER; VAR(*speed-up*) attr, data: ARRAY OF REAL;
classWidth, threshhold: REAL; VAR nClasses: INTEGER;
VAR nInClass, nCumul: ARRAY OF INTEGER;
VAR minOfClass, maxOfClass, meanOfClass: ARRAY OF REAL;
VAR nBelowThresh: INTEGER;
VAR nInClassBelowThresh, nCumulBelowThresh: ARRAY OF INTEGER;
VAR nAboveThresh: INTEGER;
VAR nInClassAboveThresh, nCumulAboveThresh: ARRAY OF INTEGER );
(*============================ StateEvents ================================*)
TYPE StateEvt;
VAR unexpectedStateEvt: StateEvt; (* read only! *)
PROCEDURE ExpectStateEvt( VAR evt: StateEvt; x: StateVar; theta1,theta2: REAL );
PROCEDURE StateEvtExpected( evt: StateEvt ): BOOLEAN;
PROCEDURE IsStateEvt( evt: StateEvt; x: StateVar ): BOOLEAN;
PROCEDURE SetStateEvt( evt: StateEvt; x: StateVar; theta1,theta2: REAL );
PROCEDURE GetStateEvt( evt: StateEvt; VAR theta1,theta2: REAL );
PROCEDURE IgnoreStateEvt( VAR evt: StateEvt );
(*============================ StatLib ================================*)
TYPE FunctionXProc = PROCEDURE( REAL ): REAL; InRangeProc = PROCEDURE( REAL, REAL, REAL ): BOOLEAN;
PROCEDURE MinX ( VAR X: ARRAY OF REAL; N: CARDINAL ): REAL;
PROCEDURE MaxX ( VAR X: ARRAY OF REAL; N: CARDINAL ): REAL;
PROCEDURE WSumX ( VAR X: ARRAY OF REAL; N : CARDINAL; FX : FunctionXProc ): REAL;
PROCEDURE SumX ( VAR X: ARRAY OF REAL; N: CARDINAL ): REAL;
PROCEDURE SumXY ( VAR X, Y: ARRAY OF REAL; N: CARDINAL ): REAL;
PROCEDURE SumX2 ( VAR X: ARRAY OF REAL; N: CARDINAL ): REAL;
PROCEDURE SumX3 ( VAR X: ARRAY OF REAL; N: CARDINAL ): REAL;
PROCEDURE SumX4 ( VAR X: ARRAY OF REAL; N: CARDINAL ): REAL;
PROCEDURE WMeanX( VAR X: ARRAY OF REAL; N: CARDINAL; FX : FunctionXProc ): REAL;
PROCEDURE MeanX ( VAR X: ARRAY OF REAL; N: CARDINAL ): REAL;
PROCEDURE VarX ( VAR X: ARRAY OF REAL; N: CARDINAL ): REAL;
PROCEDURE SDevX ( VAR X: ARRAY OF REAL; N: CARDINAL ): REAL;
PROCEDURE SkewX ( VAR X: ARRAY OF REAL; N: CARDINAL ): REAL;
PROCEDURE KurtX ( VAR X: ARRAY OF REAL; N: CARDINAL ): REAL;
PROCEDURE LinearReg ( VAR X, Y: ARRAY OF REAL; N : CARDINAL; VAR a, b, r2 : REAL );
PROCEDURE FuncX ( VAR X, Y: ARRAY OF REAL; N : CARDINAL; FX : FunctionXProc );
PROCEDURE CountX ( VAR X : ARRAY OF REAL; N : CARDINAL; XLow, XHigh: REAL; InRangeX : InRangeProc ): CARDINAL;
PROCEDURE InsertX( VAR X : ARRAY OF REAL; N, j: CARDINAL; xValue : REAL );
PROCEDURE DeleteX( VAR X : ARRAY OF REAL; N, j: CARDINAL );
PROCEDURE ClearX ( VAR X : ARRAY OF REAL; N : CARDINAL; xValue : REAL );
PROCEDURE SortX ( VAR X : ARRAY OF REAL; N : CARDINAL );
PROCEDURE NormDist ( z1, z2 : REAL ): REAL;
PROCEDURE Factorial ( N: CARDINAL ): REAL;
PROCEDURE Combination ( N, R : CARDINAL ): REAL;
PROCEDURE Permutation ( N, R : CARDINAL ): REAL;
(*============================ StochStat ================================*)
TYPE StatArray; Prob2Tail = (prob999, prob990, prob950, prob900, prob800 ); Str31 = ARRAY [0..31] OF CHAR;
VAR notExistingStatArray: StatArray; (* read only *)
PROCEDURE StatArrayExists( statArray: StatArray ): BOOLEAN;
PROCEDURE DeclStatArray( VAR statArray: StatArray; length: INTEGER );
PROCEDURE RemoveStatArray( VAR statArray: StatArray );
PROCEDURE RemoveAllStatArrays;
PROCEDURE ClearStatArray( statArray: StatArray );
PROCEDURE ClearAllStatArrays;
PROCEDURE SetStatArray( statArray: StatArray; N, X, sumY, sumYSquare: ARRAY OF REAL );
PROCEDURE SetUndefValue( undefVal: REAL );
PROCEDURE GetUndefValue( VAR undefVal: REAL );
PROCEDURE SetTolerance( tol: REAL );
PROCEDURE GetTolerance( VAR tol: REAL );
PROCEDURE PutValue( statArray: StatArray; index: INTEGER; x, y: REAL );
PROCEDURE GetValue( statArray: StatArray; index: INTEGER; VAR count, x, sumY, sumYSquare: REAL );
PROCEDURE GetSingleStatistics( statArray: StatArray; index: INTEGER;
VAR count, x, sumY, sumYSquare, meansY, stdDevsY, confIntsY: REAL; confProb: Prob2Tail );
PROCEDURE GetStatistics( statArray: StatArray; VAR N, X, sumY, sumYSquare, meansY, stdDevsY, confIntsY: ARRAY OF REAL;
confProb: Prob2Tail; VAR length: INTEGER );
PROCEDURE DeclDispMV( statArray: StatArray; mDepVar: Model; VAR mvDepVar: REAL; mIndepVar: Model; VAR mvIndepVar: REAL );
PROCEDURE DisplayArray( statArray: StatArray; withErrBars: BOOLEAN; confProb: Prob2Tail );
PROCEDURE DisplayAllArrays( withErrBars: BOOLEAN; confProb: Prob2Tail );
TYPE
RealFileFormat = RECORD rf:RealFormat; n, dec:CARDINAL; END;
FileOutFormat = RECORD
means, counts, sumsY, sumsYSquare, stdDevsY, confIntsY: BOOLEAN;
indepsFormat,meansFormat, sumsYFormat, sumsYSquareFormat,
stdDevsYFormat, confIntsYFormat: RealFileFormat; confProb: Prob2Tail;
END;
VAR (*read only!*) meansOnly, meansSDCI, allVals: FileOutFormat;
PROCEDURE DumpStatArray ( VAR f: TextFile; label: Str31; statArray: StatArray; fof: FileOutFormat );
PROCEDURE DumpStatArrays( VAR f: TextFile; labels: ARRAY OF Str31;
statArrays: ARRAY OF StatArray; fof: FileOutFormat; nArs: INTEGER );
(*============================ StructModAux ================================*)
TYPE StructModelSet = BITSET; BooleanFct = PROCEDURE (): BOOLEAN;
VAR customM: Menu; chooseCmd: Command; (* may be used to install more commands *)
PROCEDURE InstallCustomMenu( title, chooseCmdTxt, chooseAlChr: ARRAY OF CHAR );
PROCEDURE AssignSubModel( VAR which: INTEGER; descr: ARRAY OF CHAR; act,deact: PROC; isact: BooleanFct );
PROCEDURE ChooseModel;
PROCEDURE InstallMyGlobPreferences( myPrefs: PROC );
PROCEDURE SetSimEnv( sms: StructModelSet );
PROCEDURE GetSysConfig( VAR sms: StructModelSet );
PROCEDURE DeassignAllSubModels;
(*=========================== SubmodelSet =============================*)
(* of interest during parameter identification, see module IdentParMod *)
TYPE StructModelSet= BITSET; Notifier= PROC;
PROCEDURE AddNotifierIfActivated( modIdent: ARRAY OF CHAR; n: Notifier );
PROCEDURE RemoveNotifierIfActivated( modIdent: ARRAY OF CHAR; n: Notifier );
PROCEDURE AddNotifierIfDeactivated( modIdent: ARRAY OF CHAR; n: Notifier );
PROCEDURE RemoveNotifierIfDeactivated( modIdent: ARRAY OF CHAR; n: Notifier );
PROCEDURE SetSubmodelName( which: INTEGER; modIdent: ARRAY OF CHAR );
PROCEDURE GetSubmodelName( which: INTEGER; VAR modIdent: ARRAY OF CHAR );
PROCEDURE SubmodelIndex( modIdent: ARRAY OF CHAR ): INTEGER;
PROCEDURE LearnAboutOldSysConfiguration( sms: StructModelSet );
PROCEDURE InformAboutNewSysConfiguration( sms: StructModelSet );
(*============================ SymCompare =============================*)
CONST (* result codes returned *) allOk= Errors.allOk; notDone= Errors.onlyAnInsert;
CONST
nul = 0; eodSym = 1; (* end of data or of file reached *)
unknownIdent = 2; specialCharSym=8;
integerSym = 3; (* an integer number *) longIntSym = 4; (* a longinteger number *)
realSym = 5; (* a real number *) longRealSym = 6; (* a longreal number *)
strSym = 7; (* a string *)
TYPE Symbol=[ nul.. specialCharSym];
CONST f1=1; f2=2; TYPE InputFile=[ f1.. f2];
PROCEDURE PrepFile( f: InputFile; fName: ARRAY OF CHAR; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE GetFileName( f: InputFile; VAR fName: ARRAY OF CHAR );
PROCEDURE StopReadingFile( f: InputFile );
PROCEDURE SetNumOverflowTolerance( tolIOvrflw, tolROvrflw: BOOLEAN );
PROCEDURE GetNumOverflowTolerance( VAR tolIOvrflw, tolROvrflw: BOOLEAN );
PROCEDURE SetNumberTreatment( allIntLongInt, allRealLongReal: BOOLEAN );
PROCEDURE GetNumberTreatment( VAR allIntLongInt, allRealLongReal: BOOLEAN );
PROCEDURE ReadLine( f: InputFile; VAR eof: BOOLEAN; VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE TokenNr ( f: InputFile; token: ARRAY OF CHAR ): INTEGER;
PROCEDURE TokenNrV( f: InputFile; VAR(*speed-up*) token: ARRAY OF CHAR ): INTEGER; (* same as TokenNr. *)
PROCEDURE AdvanceToToken( f: InputFile; token: ARRAY OF CHAR; VAR found: BOOLEAN; VAR eof: BOOLEAN;
VAR resCode: INTEGER; VAR errTxt: ARRAY OF CHAR );
PROCEDURE CurLinesAreIdentical(): BOOLEAN;
PROCEDURE CurLinesHaveSameSyntax(): BOOLEAN;
PROCEDURE TokensAreIdentical( tNr1, tNr2: INTEGER ): BOOLEAN;
PROCEDURE GetSymbolDescr( s: Symbol; VAR descr: ARRAY OF CHAR );
PROCEDURE GetSymbolShortDescr( s: Symbol; VAR sdescr: ARRAY OF CHAR );
PROCEDURE CurLineNum( f: InputFile ): LONGINT;
PROCEDURE CurNumTokens( f: InputFile ): INTEGER;
PROCEDURE GetToken( f: InputFile; tNr: INTEGER; VAR token: ARRAY OF CHAR );
PROCEDURE Pos( f: InputFile; tNr: INTEGER ): INTEGER;
PROCEDURE Sym( f: InputFile; tNr: INTEGER ): Symbol;
PROCEDURE LI( f: InputFile; tNr: INTEGER ): LONGINT;
PROCEDURE LC( f: InputFile; tNr: INTEGER ): LONGCARD;
PROCEDURE LR( f: InputFile; tNr: INTEGER ): LONGREAL;
(*============================ TabFunc ================================*)
TYPE TabFUNC; TabFProc = PROCEDURE( VAR TabFUNC );
VAR notExistingTabF: TabFUNC; (* read only! *)
PROCEDURE DeclTabF( VAR t: TabFUNC; xx, yy: ARRAY OF REAL; NValPairs: INTEGER; modifiable: BOOLEAN;
tabName, xName, yName, xUnit, yUnit: ARRAY OF CHAR;
xMin, xMax, yMin, yMax: REAL );
PROCEDURE DeclTabFM( VAR t: TabFUNC; xyVecs: Matrix; modifiable: BOOLEAN;
tabName, xName, yName, xUnit, yUnit: ARRAY OF CHAR;
xMin, xMax, yMin, yMax: REAL );
PROCEDURE SetTabF( t: TabFUNC; xx, yy: ARRAY OF REAL; NValPairs: INTEGER; modifiable: BOOLEAN;
tabName, xName, yName, xUnit, yUnit: ARRAY OF CHAR;
xMin, xMax, yMin, yMax: REAL );
PROCEDURE GetTabF( t: TabFUNC; VAR xx, yy: ARRAY OF REAL; VAR NValPairs: INTEGER; VAR modifiable: BOOLEAN;
VAR tabName, xName, yName, xUnit, yUnit: ARRAY OF CHAR;
VAR xMin, xMax, yMin, yMax: REAL );
PROCEDURE SetTabFM( t: TabFUNC; xyVecs: Matrix; modifiable: BOOLEAN;
tabName, xName, yName, xUnit, yUnit: ARRAY OF CHAR;
xMin, xMax, yMin, yMax: REAL );
PROCEDURE GetTabFM( t: TabFUNC; VAR xyVecs: Matrix; VAR modifiable: BOOLEAN;
VAR tabName, xName, yName, xUnit, yUnit: ARRAY OF CHAR;
VAR xMin, xMax, yMin, yMax: REAL );
PROCEDURE RemoveTabF( VAR t: TabFUNC );
PROCEDURE EditTabF ( t: TabFUNC );
PROCEDURE ResetTabF ( t: TabFUNC );
PROCEDURE FreezeEditorGraphBounds ( VAR t: TabFUNC; xMin, xMax, yMin, yMax : REAL );
PROCEDURE UnfreezeEditorGraphBounds( VAR t: TabFUNC );
TYPE ExtrapolMode = ( lastSlope, horizontally ); (* default lastSlope *)
PROCEDURE DefineExtrapolationMode( VAR t:TabFUNC; extrapolation:ExtrapolMode );
PROCEDURE ExtrapolationMode( t:TabFUNC ): ExtrapolMode;
PROCEDURE Yi ( t: TabFUNC; x: REAL ): REAL; (* interpolate only ELSE HALT *)
PROCEDURE Yie( t: TabFUNC; x: REAL ): REAL; (* inter- and extrapolate *)
PROCEDURE DoForAllTabF( p: TabFProc );
(*============================ TableHandler ================================*)
TYPE
Table; TableItem = Table; RealPtr = POINTER TO REAL;
ProcPtr = POINTER TO ADDRESS; ItemProc = PROCEDURE( TableItem );
VAR notExistingTable: Table; notExistingItem: TableItem; errcode: CARDINAL; (* read only *)
PROCEDURE InitTable( VAR t: Table ); PROCEDURE DeleteTable( VAR t: Table );
PROCEDURE TableExists( t: Table ): BOOLEAN;
PROCEDURE RecordReal( t: Table; VAR id: ARRAY OF CHAR; VAR r: REAL; attr: ADDRESS );
PROCEDURE RecordProc( t: Table; VAR id: ARRAY OF CHAR; p: ProcPtr; attr: ADDRESS );
PROCEDURE RecordRealAndGetStr( t: Table; VAR id: ARRAY OF CHAR; VAR r: REAL; attr: ADDRESS; VAR str: String );
PROCEDURE DeleteItem( VAR t: Table; VAR id: ARRAY OF CHAR );
PROCEDURE FindRealPtr( t: Table; VAR id: ARRAY OF CHAR ): RealPtr;
PROCEDURE FindReal( t: Table; VAR id: ARRAY OF CHAR ): REAL;
PROCEDURE FindProcPtr( t: Table; VAR id: ARRAY OF CHAR ): ProcPtr;
PROCEDURE FindAttribute( t: Table; VAR id: ARRAY OF CHAR ): ADDRESS;
PROCEDURE FindRealPtrAndAttr( t: Table; VAR id: ARRAY OF CHAR; VAR rp: RealPtr ): ADDRESS;
PROCEDURE FindStr( t: Table; VAR id: ARRAY OF CHAR ): String;
PROCEDURE FindTableItem (t: Table; VAR id: ARRAY OF CHAR ): TableItem;
PROCEDURE ShowItemString( item: TableItem; VAR id: ARRAY OF CHAR );
PROCEDURE ItemValue( item: TableItem ): REAL;
PROCEDURE ItemProcPtr( item: TableItem ): ProcPtr;
PROCEDURE ItemAttr( item: TableItem ): ADDRESS;
PROCEDURE ItemStr( item: TableItem ): String;
PROCEDURE TraverseTree( startAt: TableItem; doWithItem: ItemProc );
(*============================ TableLists ================================*)
(* Error constants *)
CONST
TableListsOffset= DMLanguage.userBase+700; allOk= DMLanguage.allOk; insuffMem= DMLanguage.insuffMem;
unknownTable = TableListsOffset+ 1; errCreatingTable = TableListsOffset+ 8;
unknownItem = TableListsOffset+ 2; errRecordingItem = TableListsOffset+ 9;
tblAlreadyDeclared = TableListsOffset+ 3; errCreatingHashTbl = TableListsOffset+10;
itemAlreadyInTable = TableListsOffset+ 4; errStoringHashTblKey = TableListsOffset+11;
itemKeyAlreadyUsed = TableListsOffset+ 5; errStoringHashTblEntry = TableListsOffset+12;
identAlreadyUsedWithAKey = TableListsOffset+ 6; errDeclaringEventClass = TableListsOffset+13;
badItemKeySpecif = TableListsOffset+ 7; errAddingRemoveHandler = TableListsOffset+14;
TYPE
Table; Item; Tag;
Attribute= ADDRESS; TableProc= PROCEDURE( Table ); ItemProc= PROCEDURE( Item );
VAR
undefTable: Table; (* read only *)
undefItem: Item; (* read only *)
undefTag: Tag; (* read only *)
undefItemKey: INTEGER; (* read only *)
undefAttribute: Attribute; (* read only *)
(* Tables *)
PROCEDURE InitTable( VAR t: Table; name: ARRAY OF CHAR; VAR resCode: INTEGER );
PROCEDURE DeleteTable( t: Table );
PROCEDURE TableExists( t: Table ): BOOLEAN;
PROCEDURE EntriesInTable( t: Table ): INTEGER;
PROCEDURE GetTableName( t: Table; VAR name: ARRAY OF CHAR );
PROCEDURE AttachTableAttr( t: Table; a: Attribute; VAR resCode: INTEGER );
PROCEDURE TableAttr( t: Table ): Attribute;
PROCEDURE AttachTableRemoveHdlr( t: Table; tp: TableProc; VAR resCode: INTEGER );
PROCEDURE DetachTableRemoveHdlr( t: Table; tp: TableProc );
(* Items *)
PROCEDURE RecordItem( t: Table; VAR(*speed-up*) itemId,descr: ARRAY OF CHAR; VAR r: REAL; storeWithKey: BOOLEAN; key: INTEGER; attr: Attribute;
VAR resCode: INTEGER );
PROCEDURE DeleteItem( t: Table; VAR(*speed-up*) itemId: ARRAY OF CHAR );
PROCEDURE AttachItemAttr( t: Table; VAR(*speed-up*) itemId: ARRAY OF CHAR; attr: Attribute; VAR resCode: INTEGER );
PROCEDURE AddTag( t: Table; VAR(*speed-up*) itemId: ARRAY OF CHAR; class: LONGINT; attr: Attribute; VAR resCode: INTEGER );
PROCEDURE DelTag( t: Table; VAR(*speed-up*) itemId: ARRAY OF CHAR; class: LONGINT; attr: Attribute );
PROCEDURE AttachItemRemoveHdlr( t: Table; VAR(*speed-up*) itemId: ARRAY OF CHAR; ip: ItemProc; VAR resCode: INTEGER );
PROCEDURE DetachItemRemoveHdlr( t: Table; VAR(*speed-up*) itemId: ARRAY OF CHAR; ip: ItemProc );
PROCEDURE FrstItem( t: Table ): Item;
PROCEDURE NextItem( item: Item ): Item; (* assumes item is correct *)
PROCEDURE PrevItem( item: Item ): Item; (* assumes item is correct *)
PROCEDURE LastItem( t: Table ): Item;
(* Tags *)
PROCEDURE FrstTagOfItem( t: Table; VAR(*speed-up*) itemId: ARRAY OF CHAR ): Tag;
PROCEDURE LastTagOfItem( t: Table; VAR(*speed-up*) itemId: ARRAY OF CHAR ): Tag;
PROCEDURE FrstTag( item: Item ): Tag; (* assumes item is correct *)
PROCEDURE NextTag( tag: Tag ): Tag; (* assumes tag is correct *)
PROCEDURE PrevTag( tag: Tag ): Tag; (* assumes tag is correct *)
PROCEDURE LastTag( item: Item ): Tag; (* assumes item is correct *)
PROCEDURE TagAvailable( t: Table; VAR(*speed-up*) itemId: ARRAY OF CHAR; class: LONGINT; attr: Attribute ): BOOLEAN;
PROCEDURE TagExists( item: Item; (* assumes item is correct *) class: LONGINT; attr: Attribute ): BOOLEAN;
PROCEDURE NoOfTags( t: Table; VAR(*speed-up*) itemId: ARRAY OF CHAR ): INTEGER;
PROCEDURE TagCount( item: Item ): INTEGER; (* assumes item is correct *)
PROCEDURE TagClass( tag: Tag ): LONGINT; (* assumes tag is correct *)
PROCEDURE TagAttr( tag: Tag ): Attribute; (* assumes tag is correct *)
PROCEDURE SetTagClass( tag: Tag; class: LONGINT ); (* assumes tag is correct *)
PROCEDURE SetTagAttr( tag: Tag; attr: Attribute ); (* assumes tag is correct *)
(* Varia *)
PROCEDURE ItemExists( t: Table; VAR(*speed-up*) itemId: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE FindReal( t: Table; VAR(*speed-up*) itemId: ARRAY OF CHAR ): REAL;
PROCEDURE ItemOrd( item: Item ): INTEGER; (* assumes item is correct *)
PROCEDURE ItemsTable( item: Item ): Table; (* assumes item is correct *)
PROCEDURE GetItemId( item: Item; (* assumes item is correct *) VAR itemId: ARRAY OF CHAR );
PROCEDURE RetrieveItemId( t: Table; key: INTEGER; VAR itemId: ARRAY OF CHAR );
PROCEDURE GetDescrOfItem( t: Table; VAR(*speed-up*) itemId: ARRAY OF CHAR; VAR descr: ARRAY OF CHAR );
PROCEDURE GetItemDescr( item: Item; (* assumes item is correct *) VAR descr: ARRAY OF CHAR );
PROCEDURE RetrieveDescr( t: Table; key: INTEGER; VAR descr: ARRAY OF CHAR );
(* Retrieval of Items *)
PROCEDURE ItemWithId( t: Table; VAR(*speed-up*) itemId: ARRAY OF CHAR ): Item;
PROCEDURE ItemWithKey( t: Table; key: INTEGER ): Item;
PROCEDURE ItemWithAttr( t: Table; attr: Attribute ): Item;
PROCEDURE ItemWithOrd( t: Table; ord: INTEGER ): Item;
(* Retrieval of key *)
PROCEDURE KeyOfItem( t: Table; VAR(*speed-up*) itemId: ARRAY OF CHAR ): INTEGER;
PROCEDURE ItemKey( item: Item ): INTEGER; (* assumes item is correct *)
PROCEDURE AttrOfItem( t: Table; VAR(*speed-up*) itemId: ARRAY OF CHAR ): Attribute;
PROCEDURE ItemAttr( item: Item ): Attribute; (* assumes item is correct *)
PROCEDURE RetrieveAttr( t: Table; key: INTEGER ): Attribute;
(*============================ TimeSeries =============================*)
CONST MaxTimePoints=4*1024; MaxTimeSeries=128;
TYPE
TimeSeries= ARRAY[1.. MaxTimePoints] OF REAL;
TimeSeriesPtr= POINTER TO TimeSeries;
TimeSeriesArr= ARRAY[1.. MaxTimeSeries] OF TimeSeriesPtr;
PROCEDURE AllocTS( VAR(*speed-up*) ts: TimeSeriesPtr; initVal: REAL; (* value to inite *)
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE AllocTSArr( VAR tsArr: TimeSeriesArr; nTimeSeries: INTEGER;
initVal: REAL; VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE DeallocTS( VAR ts: TimeSeriesPtr );
PROCEDURE DeallocTSArr( VAR ts: TimeSeriesArr );
PROCEDURE TSSpecifInRange( nTimeSeries: INTEGER; nElements: INTEGER;
errMsgPrefix: ARRAY OF CHAR; VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE TSNilCheck( VAR tsArr: TimeSeriesArr; (* VAR for speed-up *) nTimeSeries: INTEGER;
errMsgPrefix: ARRAY OF CHAR; VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE ReadTS( filename: ARRAY OF CHAR; initVal: REAL; VAR tsArr: TimeSeriesArr;
VAR nTimeSeries: INTEGER; VAR nElements: INTEGER;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
PROCEDURE WriteTimeSeries( filename: ARRAY OF CHAR; VAR tsArr: TimeSeriesArr;
nTimeSeries, nElements: INTEGER;
VAR errTxt: ARRAY OF CHAR ): BOOLEAN;
(* ============================ E N D ============================== *)
The auxiliary library modules may be freely copied but not for profit!
(************************************************************)
(*##### P U B L I C D O M A I N M O D U L E S #####*)
(************************************************************)
The following modules are all released in source form. We hereby denote these
modules to the public domain and hereby disclaim any and all guarantees and
warranties on the software or its documentation, both expressed or implied.
No liability of any form shall be assumed by the authors. Any user of this
sofware uses it at his or her own risk and no fitness for any purpose whatsoever
nor waranty of merchantability are claimed or implied.
(*============================== ASCII ================================*)
CONST
nul = 00C; soh = 01C; stx = 02C; etx = 03C; eot = 04C; enq = 05C;
ack = 06C; bel = 07C; bs = 10C; ht = 11C; lf = 12C; vt = 13C;
ff = 14C; cr = 15C; so = 16C; si = 17C; dle = 20C; dc1 = 21C;
dc2 = 22C; dc3 = 23C; dc4 = 24C; nak = 25C; syn = 26C; etb = 27C;
can = 30C; em = 31C; sub = 32C; esc = 33C; fs = 34C; gs = 35C;
rs = 36C; us = 37C; del = 177C;
(*============================== Arrows ===============================*)
PROCEDURE DrawArrow( xb, yb, xe, ye: INTEGER;
labelAtBeg, labelAtEnd: ARRAY OF CHAR;
labelOnRightSide: BOOLEAN );
PROCEDURE SetArrowProperties( doubleArrow, leftHalfHead, rightHalfHead,
filledHead: BOOLEAN; arrhle: CARDINAL; alpha: INTEGER );
PROCEDURE GetArrowProperties( VAR doubleArrow, leftHalfHead, rightHalfHead,
filledHead: BOOLEAN; VAR arrhle: CARDINAL; VAR alpha: INTEGER );
(*=============================== Bits ================================*)
TYPE
typeID = ( byt, chr, dec, int, set, wrd );
WordTYPE = RECORD (* 16 bits *)
CASE : typeID OF
byt : b : ARRAY[0..1] OF BYTE;
| chr : c : ARRAY[0..1] OF CHAR;
| dec : d : CARDINAL;
| int : i : INTEGER;
| set : s : BITSET;
| wrd : w : WORD;
END;
END;
ByteTYPE = RECORD (* 8 bits *)
CASE : typeID OF
byt : b : BYTE;
| chr : c : CHAR;
END;
END;
BinSTR16 = ARRAY [0..15] OF CHAR; OctSTR6 = ARRAY [0..5] OF CHAR; HexSTR4 = ARRAY [0..3] OF CHAR;
BinSTR8 = ARRAY [0..7] OF CHAR; OctSTR3 = ARRAY [0..2] OF CHAR; HexSTR2 = ARRAY [0..1] OF CHAR;
VAR Pow2: ARRAY [0..15] OF CARDINAL; HexDIGIT: ARRAY [0..15] OF CHAR;
PROCEDURE WordToBinStr( a: WORD; VAR BinStr: BinSTR16 );
PROCEDURE BinStrToWord( BinStr: BinSTR16; VAR a: WORD );
PROCEDURE WordToOctStr( a: WORD; VAR OctStr: OctSTR6 );
PROCEDURE OctStrToWord( OctStr: OctSTR6; VAR a: WORD );
PROCEDURE WordToHexStr( a: WORD; VAR HexStr: HexSTR4 );
PROCEDURE HexStrToWord( HexStr: HexSTR4; VAR a: WORD );
(* BitManipulations for WordTYPE: *)
PROCEDURE ShiftLeftW( VAR a: WORD; n: CARDINAL );
PROCEDURE CircShiftLeftW( VAR a: WORD; n: CARDINAL );
PROCEDURE ShiftRightW( VAR a: WORD; n: CARDINAL );
PROCEDURE CircShiftRightW( VAR a: WORD; n: CARDINAL );
(* BitOperations for WordTYPE: *)
PROCEDURE NotW( a: WORD ): WORD;
PROCEDURE AndW( a, b: WORD ): WORD;
PROCEDURE OrW( a, b: WORD ): WORD;
PROCEDURE XorW( a, b: WORD ): WORD;
PROCEDURE ByteToBinStr( a: BYTE; VAR BinStr: BinSTR8 );
PROCEDURE BinStrToByte( BinStr: BinSTR8; VAR a: BYTE );
PROCEDURE ByteToOctStr( a: BYTE; VAR OctStr: OctSTR3 );
PROCEDURE OctStrToByte( OctStr: OctSTR3; VAR a: BYTE );
PROCEDURE ByteToHexStr( a: BYTE; VAR HexStr: HexSTR2 );
PROCEDURE HexStrToByte( HexStr: HexSTR2; VAR a: BYTE );
(* BitManipulations for ByteTYPE: *)
PROCEDURE ShiftLeftB( VAR a: BYTE; n: CARDINAL );
PROCEDURE CircShiftLeftB( VAR a: BYTE; n: CARDINAL );
PROCEDURE ShiftRightB( VAR a: BYTE; n: CARDINAL );
PROCEDURE CircShiftRightB( VAR a: BYTE; n: CARDINAL );
(* BitOperations for ByteTYPE: *)
PROCEDURE NotB( a: BYTE ): BYTE;
PROCEDURE AndB( a, b: BYTE ): BYTE;
PROCEDURE OrB( a, b: BYTE ): BYTE;
PROCEDURE XorB( a, b: BYTE ): BYTE;
(*============================ ComplexLib =============================*)
TYPE Complex = RECORD (* extended Type for intermediate *)
re, im: EXTREAL; (* results (80 Bit REAL) *)
END;
VAR one, (* re:1. ; im:0. ); *) zero,(* re:0. ; im:0. ); *) imagUnit: Complex; (* re:0. ; im:1. ); *)
PROCEDURE SetCom( VAR z: Complex; re, im: REAL );
PROCEDURE GetCom( z: Complex; VAR re, im: REAL );
PROCEDURE PolToKart( betr, phi: REAL; VAR z: Complex );
PROCEDURE KartToPol( z: Complex; VAR betr, phi: REAL );
PROCEDURE MultCom( a, b: Complex; VAR z: Complex ); (* MultCom(a,b,c) : c := a * b *)
PROCEDURE DivCom( a, b: Complex; VAR z: Complex ); (* DivCom(a,b,c) : c := a / b *)
PROCEDURE AddCom( a, b: Complex; VAR z: Complex ); (* AddCom(a,b,c) : c := a + b *)
PROCEDURE SubCom( a, b: Complex; VAR z: Complex ); (* SubCom(a,b,c) : c := a - b *)
PROCEDURE NegCom( VAR z: Complex ); (* NegCom(z) : z := -z *)
PROCEDURE ExpCom( VAR z: Complex ); (* ExpCom(z) : z := Exp(z) *)
PROCEDURE SkalCom( VAR z: Complex; r: REAL ); (* SkalCom(c,r: REAL) : c := c * r *)
PROCEDURE RandomCom( VAR z: Complex );
PROCEDURE SetToZero( VAR z: Complex );
(*=========================== Conventions =============================*)
(* all variables are read only!*)
VAR (* input *) ESC, RET,
(* input / output *) EOL, DEL, BS, HT, CAN,
(* output *) CR, LF, VT, FF, BEL,
(* internal *) EOS, UNDEF: CHAR;
(*============================ Curves3D ================================*)
FROM Graphics3D IMPORT Point3D;
CONST nRun = 5; nVal =250;
TYPE
ProjectionEnumerator = (xyPlane, xzPlane, yzPlane, spacial );
Projections = [xyPlane..spacial]; ProjectionSet = SET OF ProjectionEnumerator;
PROCEDURE SelectSymbol( theProjection: Projections; symbol: CHAR );
PROCEDURE ClearUpdateStore;
PROCEDURE StartNewCurve( projection:ProjectionSet; firstPoint: Point3D );
PROCEDURE PlotTo3D( P: Point3D );
PROCEDURE ReplotAll;
PROCEDURE GetCurrentProjection():ProjectionSet;
PROCEDURE StorageOff;
PROCEDURE StorageOn;
(*=========================== DebugHelper =============================*)
VAR debugLev: INTEGER; msg, s1, s2, s3: ARRAY [0..255] OF CHAR; (* for free use to construct messages *)
PROCEDURE AppendS( VAR msg: ARRAY OF CHAR; s: ARRAY OF CHAR );
PROCEDURE AppendBool( VAR msg: ARRAY OF CHAR; b: BOOLEAN );
PROCEDURE AppendInt( VAR msg: ARRAY OF CHAR; x: LONGINT );
PROCEDURE AppendReal( VAR msg: ARRAY OF CHAR; dec: CARDINAL; x: LONGREAL );
PROCEDURE Tell( onDebugLev: INTEGER; msg: ARRAY OF CHAR );
(*============================ ExtMathLib =============================*)
TYPE EXTREAL = ARRAY [1..5] OF CARDINAL;
PROCEDURE ExtSqrt( x: EXTREAL; VAR res: EXTREAL );
PROCEDURE ExtExp( x: EXTREAL; VAR res: EXTREAL );
PROCEDURE ExtLn( x: EXTREAL; VAR res: EXTREAL );
PROCEDURE ExtSin( x: EXTREAL; VAR res: EXTREAL );
PROCEDURE ExtCos( x: EXTREAL; VAR res: EXTREAL );
PROCEDURE ExtArcTan( x: EXTREAL; VAR res: EXTREAL );
PROCEDURE ExtReal( x: LONGINT; VAR res: EXTREAL );
PROCEDURE ExtEntier( x: EXTREAL; VAR res: LONGINT );
PROCEDURE LongToExt( x: LONGREAL; VAR res: EXTREAL );
PROCEDURE ExtToLong( e: EXTREAL; VAR res: LONGREAL );
PROCEDURE RealToExt( x: REAL; VAR res: EXTREAL );
PROCEDURE ExtToReal( e: EXTREAL; VAR res: REAL );
PROCEDURE ExtAdd( a, b: EXTREAL; VAR res: EXTREAL );
PROCEDURE ExtSub( a, b: EXTREAL; VAR res: EXTREAL );
PROCEDURE ExtMul( a, b: EXTREAL; VAR res: EXTREAL );
PROCEDURE ExtDiv( a, b: EXTREAL; VAR res: EXTREAL );
PROCEDURE ExtAbs( e: EXTREAL; VAR res: EXTREAL );
PROCEDURE ExtNeg( e: EXTREAL; VAR res: EXTREAL );
(*=========================== FileErrInfo =============================*)
PROCEDURE WriteFileStatus( f: TextFile );
(*============================ Graphics3D ================================*)
CONST MaxLabelLength = 4;
TYPE
Point3D = RECORD x,y,z: REAL END;
AxisLabelString = ARRAY [0..MaxLabelLength-1] OF CHAR;
CSType = RECORD
origin,
xPoint, yPoint, zPoint: RECORD x, y: INTEGER END;
xMax, yMax, zMax : REAL;
xLabel, yLabel, zLabel: AxisLabelString;
END;
PROCEDURE SetTermMenuText( mText, mCmdText: ARRAY OF CHAR; aliasChar: CHAR );
PROCEDURE GetTermMenuText( VAR mText, mCmdText: ARRAY OF CHAR; VAR aliasChar: CHAR );
PROCEDURE InstallCS( r: RectArea; CS: CSType );
PROCEDURE GetCS( VAR CS: CSType );
PROCEDURE DrawCS;
PROCEDURE EditCS;
PROCEDURE Convert3DToPoint( P: Point3D; VAR x, y: INTEGER );
PROCEDURE Convert3DTo2D( P: Point3D; VAR xUC, yUC: REAL );
(*========================== InputGenerator ===========================*)
TYPE InputType = ( NoInput, StepInput, RectInput, RampInput,
SinusInput, CosinusInput, RandomUniformInput, RandomNormalInput );
VAR sigma, ampl, slope, T: REAL; kindOfInput: InputType;
PROCEDURE Input( time: REAL ): REAL;
(*============================ Journaling =============================*)
PROCEDURE OpenJournal;
PROCEDURE CloseJournal;
PROCEDURE Write( ch: CHAR );
PROCEDURE WriteString( s: ARRAY OF CHAR );
PROCEDURE WriteLn;
PROCEDURE WriteInt( i, c: INTEGER );
PROCEDURE WriteReal( x: REAL; fw, dec: INTEGER );
PROCEDURE WriteRealSci( x: REAL; fw, dec: INTEGER );
PROCEDURE EraseContent;
(*============================= PolyLib ===============================*)
CONST maxPolySize = 8; (* Max Order of polynoms *)
TYPE
NamenString = ARRAY [0..32] OF CHAR;
Polynom = RECORD
name: NamenString; curOrder: CARDINAL; koef: ARRAY [0..maxPolySize] OF Complex;
END;
PROCEDURE InitPolynom( VAR P: Polynom; Name: NamenString; n: CARDINAL );
PROCEDURE SetPolynom ( VAR p: Polynom; coef: ARRAY OF Complex );
PROCEDURE FormPolynom( VAR p: Polynom; roots: ARRAY OF Complex );
PROCEDURE FindRoots( P: Polynom; VAR roots: ARRAY OF Complex; zInit: Complex;
maxError: REAL; maxIteration: CARDINAL;
VAR found: CARDINAL; VAR done: BOOLEAN );
(*=========================== Protocolling ============================*)
CONST dispProgressAtLn = 9; dispProgressAtCol = 2;
PROCEDURE ActivateProtocolWindow; (* opens it or puts it on front *)
PROCEDURE StartProtocol; (* writes header message *)
PROCEDURE EraseProtocol; (* erases all *)
PROCEDURE ReportString( s: ARRAY OF CHAR );
PROCEDURE ReportLine( s: ARRAY OF CHAR );
PROCEDURE ReportIntAt( inRow, atCol, i, le: INTEGER ); (* write i at position [inRow,atCol] *)
PROCEDURE TerminateProtocol; (* writes termination message *)
(*============================= SimLib0 ===============================*)
(* General parameters *)
CONST nmax = 10; (* maximal model order*)
TYPE EquationProcedure = PROCEDURE( VAR ARRAY OF REAL, VAR ARRAY OF REAL );
VAR time: REAL;
PROCEDURE InstallModel( m: EquationProcedure );
(* Integration *)
TYPE IntegrationMethod = ( Euler, Heun, RungeKutta4, DiscreteTime );
PROCEDURE SetIntegrationMethod( m: IntegrationMethod );
PROCEDURE GetIntegrationMethod( VAR m: IntegrationMethod );
PROCEDURE SetIntegrationStep( step: REAL );
PROCEDURE GetIntegrationStep( VAR step: REAL );
TYPE IntegrationProc = PROCEDURE( VAR ARRAY OF REAL, VAR ARRAY OF REAL );
VAR Integrate: IntegrationProc;
(*=========================== SimpleSounds ============================*)
CONST
C = 2994; Cis = 2826; D = 2668; Es = 2518;
E = 2377; F = 2243; Ges = 2117; G = 1998;
Gis = 1886; A = 1780; B = 1680; H = 1586;
PROCEDURE Sound( f, d: INTEGER );
(*============================ SortLib ================================*)
PROCEDURE QuickSortX ( VAR a: ARRAY OF REAL; n: CARDINAL );
PROCEDURE QuickSortXY ( VAR a, b: ARRAY OF REAL; n: CARDINAL );
PROCEDURE BinarySortX ( VAR a: ARRAY OF REAL; n: CARDINAL );
PROCEDURE StrSelSortX ( VAR a: ARRAY OF REAL; n: CARDINAL );
PROCEDURE StrSelSortXY ( VAR a, b: ARRAY OF REAL; n: CARDINAL );
(*=========================== SoundDriver =============================*)
CONST
swMode = -1; (* square-wave synthesizer *)
ftMode = 1; (* four-tone synthesizer *)
ffMode = 0; (* free-form synthesizer *)
TYPE Ptr = ADDRESS; ProcPtr = Ptr; Byte = CHAR; Fixed = LONGINT;
(* for square-wave synthesizer *)
Tone = RECORD
count: CARDINAL; (* 783360/frequency [Hz] *)
amplitude: INTEGER; (* [0..255] *)
duration: INTEGER; (* in ticks *)
END;
Tones = ARRAY [0..5000] OF Tone;
SWSynthPtr = POINTER TO SWSynthRec;
SWSynthRec = RECORD mode: INTEGER; triplets: Tones; END;
(* for four-tone synthesizer *)
FTSynthPtr = POINTER TO FTSynthRec; FTSndRecPtr = POINTER TO FTSoundRec; WavePtr = POINTER TO Wave;
FTSynthRec = RECORD mode: INTEGER; sndRec: FTSndRecPtr; END;
FTSoundRec = RECORD
duration: INTEGER;
sound1Rate: Fixed; sound1Phase: LONGINT;
sound2Rate: Fixed; sound2Phase: LONGINT;
sound3Rate: Fixed; sound3Phase: LONGINT;
sound4Rate: Fixed; sound4Phase: LONGINT;
sound1Wave: WavePtr; sound2Wave: WavePtr; sound3Wave: WavePtr; sound4Wave: WavePtr;
END;
Wave = ARRAY [0..255] OF Byte;
PROCEDURE StartSound( synthRec: Ptr; numBytes: LONGINT; completionRtn: ProcPtr );
PROCEDURE StopSound;
PROCEDURE SoundDone( ): BOOLEAN;
PROCEDURE GetSoundVol( VAR level: INTEGER );
PROCEDURE SetSoundVol( level: INTEGER );
(*============================= Splines ===============================*)
(* Computing procedures *)
PROCEDURE Spline( n: INTEGER; VAR x, y, y1, y2: ARRAY OF REAL );
PROCEDURE Spline1( n: INTEGER; ya, yb: REAL; VAR x, y, y1, y2: ARRAY OF REAL );
PROCEDURE Spline2( n: INTEGER; VAR x, y, y1, y2: ARRAY OF REAL );
PROCEDURE Intrpl( x0: REAL; n: INTEGER; VAR x, y, y1, y2: ARRAY OF REAL ): REAL;
PROCEDURE SplineCurve( n: INTEGER; VAR x, y, t, x1, x2, y1, y2: ARRAY OF REAL );
PROCEDURE SplineCurve2( n: INTEGER; VAR x, y, t, x1, x2, y1, y2: ARRAY OF REAL );
(* Drawing procedures *)
PROCEDURE Bezier( x0, y0, x1, y1, x2, y2, x3, y3: REAL );
PROCEDURE PlotSpline( n: INTEGER; VAR x, y, y1: ARRAY OF REAL );
PROCEDURE PlotSpline2( n: INTEGER; VAR t, x, x1, y, y1: ARRAY OF REAL );
(*============================ StandardIO =============================*)
PROCEDURE SysBeep( millisec: INTEGER );
PROCEDURE MakeStandardIOWindow;
PROCEDURE WriteReal( x: REAL; field, dec: CARDINAL );
PROCEDURE WriteInt( i: INTEGER; field: CARDINAL );
PROCEDURE WriteCard( K, field: CARDINAL );
PROCEDURE Write( c: CHAR );
PROCEDURE WriteString( str: ARRAY OF CHAR );
PROCEDURE WriteLn;
PROCEDURE Read( VAR c: CHAR );
PROCEDURE ReadLn( VAR str: ARRAY OF CHAR );
PROCEDURE ReadReal( VAR x: REAL );
PROCEDURE ReadInt( VAR i: INTEGER );
PROCEDURE ReadCard( VAR k: CARDINAL );
(*============================ WriteDatTim ==============================*)
CONST
Jan = 1; Feb = 2; Mar = 3; Apr = 4; Mai = 5; Jun = 6;
Jul = 7; Aug = 8; Sep = 9; Oct = 10; Nov = 11; Dec = 12;
Sun = 1; Mon = 2; Tue = 3; Wed = 4; Thur = 5; Fri = 6; Sat = 7;
TYPE Months = INTEGER; WeekDays = INTEGER;
DateAndTimeRec = RECORD
year: INTEGER; (* 1904,1905,...2040 *) month: Months;
day, (* 1,...31 *) hour, (* 0,...,23 *) minute, second: INTEGER; (* 0,...,59 *)
dayOfWeek: WeekDays; END;
WriteProc = PROCEDURE (CHAR );
DateFormat = ( brief, (* only numbers: e.g. 31/05/88 *)
letMonth, (* month in letters: e.g. 31/Mai/1988 *)
full ); (* full in letters: e.g. 31st Mai 1988 *)
TimeFormat = ( brief24h, brief24hSecs, let24hSecs, full24hSecs, brief12h );
(* the following procedures write information in English only *)
PROCEDURE WriteDate( d: DateAndTimeRec; w: WriteProc; df: DateFormat );
PROCEDURE WriteTime( d: DateAndTimeRec; w: WriteProc; tf: TimeFormat );
(*============================= WriteRTF ==============================*)
TYPE
RTFFonts = ( Chicago, NewYork, Geneva, Monaco, Bookman, HelveticN,
Palatino, Times, Helvetica, Courier, Symbol, AvanGarde, DfltFont );
RTFStyles = ( plain, bold, italic, underl, outlin, shadow, subscr, supscr, smcaps,
alcaps, hidden, dflt );
RTFStyle = SET OF RTFStyles;
RTFFile = RECORD textf: TextFile; curFont: RTFFonts; curSize: CARDINAL; curStyle: RTFStyle; END;
PROCEDURE CreateRTFFile( VAR f: RTFFile; prompt, defaultName: ARRAY OF CHAR );
PROCEDURE RewriteRTFFile( VAR f: RTFFile; fname: ARRAY OF CHAR );
PROCEDURE CloseRTFFile( f: RTFFile );
PROCEDURE WriteRTFChar( f: RTFFile; ch: CHAR );
PROCEDURE WriteRTFChars( f: RTFFile; str: ARRAY OF CHAR );
PROCEDURE WriteRTFEOL( f: RTFFile ); (* End Of Line *)
PROCEDURE WriteRTFEOP( f: RTFFile ); (* End Of Paragraph *)
PROCEDURE WriteRTFTab( f: RTFFile ); (* Tabulator *)
PROCEDURE WriteRTFPageBrk( f: RTFFile ); (* Page Break *)
PROCEDURE WriteRTFSectMrk( f: RTFFile ); (* Section Mark *)
PROCEDURE PutRTFCardinal( f: RTFFile; card: CARDINAL; n: CARDINAL );
PROCEDURE PutRTFInteger( f: RTFFile; int: INTEGER; n: CARDINAL );
PROCEDURE PutRTFReal( f: RTFFile; real: REAL; n, d: CARDINAL );
PROCEDURE PutRTFRealSci( f: RTFFile; real: REAL; n: CARDINAL );
PROCEDURE SetRTFFont( VAR f: RTFFile; Font: RTFFonts; Size: CARDINAL; Style: RTFStyle );
PROCEDURE GetRTFFont( f: RTFFile; VAR Font: RTFFonts; VAR Size: CARDINAL; VAR Style: RTFStyle );
PROCEDURE PutRTFPict( f: RTFFile; fromWindow: Window );
(* ============================ E N D ============================== *)
The auxiliary library modules may be freely copied but not for profit!
