Category : Files from Magazines
Archive   : DDJ8710.ZIP
Filename : SHAMLST.OCT

 
Output of file : SHAMLST.OCT contained in archive : DDJ8710.ZIP

Listing 1. QuickBASIC library to implement opaque matrices.

' QuickBASIC implementation of an opaque numeric matrix
' Matrix is stored as arrays of columns
' OPTION BASE 0 must be used, although the row/column indices
' start at one.

SUB InitMat(Mat#(1), Max.Row%, Max.Col%) STATIC
' Initialize matrix

Mat#(0) = Max.Row% + Max.Col% / 1000

FOR I% = 1 TO UBound(Mat#)
Mat#(I%) = 0
NEXT I%

END SUB ' CreateMat


SUB StoreElem(Mat#(1), Row%, Col%, Elem#, OK%) STATIC

' Store Elem# in matrix position (Row%,Col%)
' OK% is zero if error has occurred, -1 if operation was done

STATIC I%, MaxR%, MaxC%

MaxR% = INT(Mat#(0))
MaxC% = 1000 * (Mat#(0) - MaxR%)

IF (MaxR% < Row%) OR (MaxC% < Col%) OR (Row% < 1) OR (Col% < 1) THEN
OK% = 0 ' Bad row or column numbers.
EXIT SUB
END IF

OK% = -1

' Calculate index
I% = Row% + (Col% - 1) * MaxR%
' for the arrays of rows representation use
' I% = Col% + (Row% - 1) * MaxC%


' Store element
Mat#(I%) = Elem#

END SUB ' StoreElem


SUB RecallElem(Mat#(1), Row%, Col%, Elem#, OK%) STATIC

' Recall Elem# in matrix position (Row%,Col%)
' OK% is zero if error has occurred, -1 if operation was done

STATIC I%, MaxR%, MaxC%

MaxR% = INT(Mat#(0))
MaxC% = 1000 * (Mat#(0) - MaxR%)

IF (MaxR% < Row%) OR (MaxC% < Col%) OR (Row% < 1) OR (Col% < 1) THEN
OK% = 0 ' Bad row or column numbers.
EXIT SUB
END IF

OK% = -1

' Calculate index
I% = Row% + (Col% - 1) * MaxR%
' for the arrays of rows representation use
' I% = Col% + (Row% - 1) * MaxC%

' Recall element
Elem# = Mat#(I%)

END SUB ' RecallElem



Listing 2. True BASIC module that implements an array-based binary tree.

MODULE Binary_Tree

! TRUE BASIC module that implements a single binary tree
! Copyright (c) 1987 Namir Clement Shammas

DECLARE DEF NIL, TRUE, FALSE
SHARE Left(1), Right(1), Node_Count, Num_Nodes, Bin_Tree$(1)


!------------ Module initialization ---------
LET Num_Nodes = 0

!----------- local functions -----------

DEF NIL = MAXNUM
DEF TRUE = 1
DEF FALSE = 0


SUB Initialize(Item$)
! Subroutine to initialize the binary tree

LET Num_Nodes = 1
LET Tree_Size = 1
LET Bin_Tree$(1) = Item$
LET Left(1) = NIL
LET Right(1) = NIL

END SUB


SUB Search(Item$, Found, Index)
! Search for Item$ and return Index if found.

LET Found = FALSE
LET Index = 1

DO WHILE (Index <> NIL) AND (Found = FALSE)
IF Bin_Tree$(Index) = Item$ THEN
LET Found = TRUE
ELSE
IF Bin_Tree$(Index) < Item$ THEN
LET Index = Right(Index)
ELSE
LET Index = Left(Index)
END IF
END IF
LOOP

END SUB


SUB Insert(Item$)
! Insert Item$ in the "dynamic" binary tree structure

LET Num_Nodes = Num_Nodes + 1

IF Num_Nodes > Tree_Size THEN
LET Tree_Size = Num_Nodes
MAT REDIM Bin_Tree$(Tree_Size), Left(Tree_Size), Right(Tree_Size)
END IF

LET Index = 1
LET Found = FALSE

DO WHILE Index <> NIL
IF Bin_Tree$(Index) < Item$ THEN
IF Right(Index) <> NIL THEN
LET Index = Right(Index)
ELSE
LET Right(Index) = Num_Nodes
LET Index = NIL
END IF
ELSE
IF Left(Index) <> NIL THEN
LET Index = Left(Index)
ELSE
LET Left(Index) = Num_Nodes
LET Index = NIL
END IF
END IF
LOOP

LET Bin_Tree$(Num_Nodes) = Item$
LET Right(Num_Nodes) = NIL
LET Left(Num_Nodes) = NIL

END SUB

END MODULE



Listing 3. Pascal code for emulating opaque complex data types.



TYPE
Opaque_Complex_type = ^Opaque_Complex_type_record;

{ record type is deliberately empty }
Opaque_Complex_type_record = RECORD
END;


Actual_Complex_type = ^Actual_Complex_type_record;

Actual_Complex_type_record = RECORD
Reel,
Imag : REAL;
END;

Convert_Complex = RECORD
CASE BOOLEAN OF
TRUE : (Opaque : Opaque_Complex_type);
FALSE : (Actual : Actual_Complex_type)
END;



FUNCTION Convert_Opaque_to_Actual( Opaque_Complex : Opaque_Complex_type ) :
Actual_Complex_type;

VAR Transfer : Convert_Complex;

BEGIN
Transfer.Opaque := Opaque_Complex;
Convert_Opaque_to_Actual := Transfer.Actual
END; { Convert_Opaque_to_Actual }



FUNCTION Convert_Actual_to_Opaque( Actual_Complex : Actual_Complex_type ) :
Opaque_Complex_type;

VAR Transfer : Convert_Complex;

BEGIN
Transfer.Actual := Actual_Complex;
Convert_Actual_to_Opaque := Transfer.Opaque
END; { Convert_Actual_to_Opaque }



FUNCTION Real_Imag_Complex(Re, Im : REAL) : Opaque_Complex_type;
{ Convert from Real/Imaginary numbers to opaque complex numbers }
VAR Transfer : Actual_Complex_type;

BEGIN
NEW(Transfer);
Transfer^.Reel := Re;
Transfer^.Imag := Im;
Real_Imag_Complex:= Convert_Actual_to_Opaque(Transfer);
END; { Real_Imag_Complex }


FUNCTION Polar_Complex(Angle, Modulus : REAL) : Opaque_Complex_type;
{ Convert from polar coordinates to opaque complex numbers }
VAR Transfer : Actual_Complex_type;

BEGIN
NEW(Transfer);
Transfer^.Reel := Modulus * SIN(Angle);
Transfer^.Imag := Modulus * COS(Angle);
Real_Imag_Complex:= Convert_Actual_to_Opaque(Transfer);
END; { Polar_Complex }



PROCEDURE Get_Real_Imag(MyComplex : Opaque_Complex_type;
VAR Re, Im : REAL { output});
{ Convert opaque complex numbers into Real/Imaginary components }
VAR Transfer : Actual_Complex_type;

BEGIN
Transfer := Convert_Opaque_to_Actual(MyComplex);
Re := Transfer^.Reel;
Im := Transfer^.Imag;
END; { Get_Real_Imag }


PROCEDURE Get_Polar(MyComplex : Opaque_Complex_type;
VAR Angle, Modulus : REAL { output});
{ Convert opaque complex numbers into polar components }
VAR Transfer : Actual_Complex_type;

BEGIN
Transfer := Convert_Opaque_to_Actual(MyComplex);
WITH Transfer^ DO BEGIN
Modulus := SQRT(SQR(Reel) + SQR(Imag));
Angle := Imag / Reel;
END; { WITH }
END; { Get_Polar }



FUNCTION Add_Complex(C1, C2 : Opaque_Complex_type) : Opaque_Complex_type;


VAR Transfer : Actual_Complex_type;
Re, Im : REAL;

BEGIN
{ Get first complex number }
Transfer := Convert_Opaque_to_Actual(C1);
Re := Transfer^.Reel;
Im := Transfer^.Imag;
{ Get second complex number }
Transfer := Convert_Opaque_to_Actual(C2);
Re := Re + Transfer^.Reel;
Im := Im + Transfer^.Imag;
{ Update result }
Transfer^.Reel := Re;
Transfer^.Imag := Im;
Add_Complex := Convert_Actual_to_Opaque(Transfer);
END; { Add_Complex }



Listing 4. Modula-2 code for opaque complex data types.


DEFINITION MODULE Complex;

EXPORT QUALIFIED Complex, RealImagComplex, PolarComplex,


TYPE Complex; (* opaque type *)


PROCEDURE RealImagComplex(Re, Im : REAL) : Complex;
(* Convert from Real/Imaginary numbers to opaque complex numbers *)

PROCEDURE PolarComplex(Angle, Modulus : REAL) : Complex;
(* Convert from polar coordinates to opaque complex numbers *)

PROCEDURE GetRealImag(MyComplex : Complex; VAR Re, Im : REAL (* output *));
(* Convert opaque complex numbers into Real/Imaginary components *)


PROCEDURE GetPolar(MyComplex : Complex; VAR Angle, Modulus : REAL (* output*));
(* Convert opaque complex numbers into polar components *)

PROCEDURE AddComplex(C1, C2 : Complex) : Complex;

END Complex.



IMPLEMENTATION MODULE Complex;

FROM MathLib0 IMPORT sqrt, sin, cos;

TYPE

ComplexRecord = RECORD
Reel,
Imag : REAL;
END;

(* opaque type mus be a pointer *)
Complex = POINTER TO ComplexRecord;


PROCEDURE RealImagComplex(Re, Im : REAL) : Complex;
(* Convert from Real/Imaginary numbers to opaque complex numbers *)

VAR C : Complex;

BEGIN
NEW(C);
C^.Reel := Re;
C^.Imag := Im;
RETURN(C)
END RealImagComplex;


FUNCTION PolarComplex(Angle, Modulus : REAL) : Complex;
(* Convert from polar coordinates to opaque complex numbers *)

VAR C : Complex;

BEGIN
NEW(C);
C^.Reel := Modulus * sin(Angle);
C^.Imag := Modulus * cos(Angle);
RETURN(C)
END PolarComplex;



PROCEDURE GetRealImag(MyComplex : Complex; VAR Re, Im : REAL (* output *));
(* Convert opaque complex numbers into Real/Imaginary components *)

BEGIN
Re := MyComplex^.Reel;
Im := MyComplex^.Imag;
END GetRealImag;


PROCEDURE GetPolar(MyComplex : Complex; VAR Angle, Modulus : REAL (* output*));
(* Convert opaque complex numbers into polar components *)

BEGIN
WITH MyComplex DO
Modulus := sqrt(Reel*Reel + Imag*Imag);
Angle := Imag / Reel;
END;
END GetPolar;



PROCEDURE AddComplex(C1, C2 : Complex) : Complex;

VAR C : Complex;
Re, Im : REAL;

BEGIN
(* Get first complex number *)
Re := C1^.Reel;
Im := C1^.Imag;
(* Get second complex number *)
Re := Re + C2^.Reel;
Im := Im + C2^.Imag;
(* Update result *)
C^.Reel := Re;
C^.Imag := Im;
RETURN(C)
END AddComplex;

END Complex.





SUB Jekyll.and.Hyde(, Menu.Choice) STATIC

STATIC

SELECT CASE Menu.Choice

CASE 1



CASE 2



CASE 3



ELSE



END SELECT

END SUB

Example 1: General scheme for using static local variables in QuickBASIC and Turbo BASIC