--File: IntTrans.mesa
--Written by Martin Newell, July 1979
-- Converted to Mesa 6: October 20, 1980 4:34 PM
--last edited June 10, 1981 4:27 PM

--MUST be compiled /l

-- Transformations are held in homogeneous form, in REALs. The current transformation is
-- held locally in two forms - homogeneous (ground truth) and a divided form for
-- application to a set of input vectors. The transformation stack is a doubly-linked
-- list of homogeneous arrays.


DIRECTORY

AltoDefs: FROM "AltoDefs" USING[PageSize],
IntTransDefs: FROM "IntTransDefs"
USING[Transform, TransformRecord, CoordName, ident, translate, rotscale],
RealFns: FROM "RealFns"
USING[SqRt],
Real: FROM "Real"
USING[Fix],
InlineDefs: FROM "InlineDefs"
USING[BITOR],
IODefs: FROM "IODefs"
USING[WriteString, WriteLine, WriteDecimal],
SegmentDefs: FROM "SegmentDefs" USING[NewDataSegment,
DefaultXMBase, LongDataSegmentAddress, DeleteDataSegment,
LongVMtoDataSegment],
SystemDefs: FROM "SystemDefs"
USING[AllocateHeapNode, FreeHeapNode];

IntTrans: PROGRAM
IMPORTS RealFns, Real, InlineDefs, IODefs, SegmentDefs, SystemDefs
EXPORTS IntTransDefs =
BEGIN
OPEN AltoDefs, IntTransDefs, RealFns, Real, InlineDefs, IODefs, SegmentDefs, SystemDefs;

--For debugging space leaks:
NNodes: INTEGER ← 0;

-- Define a DividedTransform for internal use in transformaing points and vectors:
DividedTransform: TYPE = POINTER TO DividedTransformRecord;
DividedTransformRecord: TYPE = RECORD[
type: [ident..translate+rotscale],
a11,a21,a12,a22: REAL,
a31,a32: LONG INTEGER];

Context: TYPE = POINTER TO ContextRecord;
ContextRecord: TYPE = RECORD [
top: Transform,
refCount: CARDINAL
];

T: DividedTransform = AllocateNode[SIZE[DividedTransformRecord]];
--The current transformation divided (T[3,3]=1)
TH: Transform; --Top of current context, in homogeneous form
LH: Transform = AllocateNode[SIZE[TransformRecord]];
--The local transformation
inTransforms,needsDivision: BOOLEAN;--state flags
Identity: TransformRecord ← [
type: ident,
a11: 1, a21: 0, a31: 0,
a12: 0, a22: 1, a32: 0,
a33: 1,
prev: NIL];

CurrentContext: CARDINAL; --index in ContextArray

DefaultContextArrayLength: CARDINAL = 64;
ContextArray: DESCRIPTOR FOR ARRAY OF ContextRecord ← DESCRIPTOR[NIL,0];

InitTransformation: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
-- Initialize (or re-initialize) Transformation package
BEGIN
i: CARDINAL;
t,prevt: Transform;
FOR i IN [0..LENGTH[ContextArray]) DO
FOR t ← ContextArray[i].top, prevt UNTIL t=NIL DO
prevt ← t.prev;
FreeTransform[t];
ENDLOOP;
ContextArray[i] ← [top: NIL, refCount:0];
ENDLOOP;
ReleaseAllTransforms[];
NNodes ← 0;
IF LENGTH[ContextArray]#DefaultContextArrayLength THEN
BEGIN
IF BASE[ContextArray]#NIL THEN FreeNode[BASE[ContextArray]];
ContextArray ←
DESCRIPTOR[AllocateNode[DefaultContextArrayLength*SIZE[ContextRecord]],
DefaultContextArrayLength];
FOR i IN [0..LENGTH[ContextArray]) DO
ContextArray[i] ← [top: NIL, refCount: 0];
ENDLOOP;
END;
CurrentContext ← 0;
TH ← AllocateTransform[];
TH↑ ← Identity;
LH↑ ← Identity;
ContextArray[0] ← [top: TH, refCount: 1];
inTransforms ← TRUE;
needsDivision ← TRUE;
RETURN[TRUE];
END;

FinishTransformation: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
BEGIN
RETURN[TRUE];
END;

FreezeContext: PUBLIC PROCEDURE RETURNS[id: CARDINAL] =
-- Create new context based on existing context state
BEGIN
cntxt: Context;
IF inTransforms THEN Concatenate[LH, TH, TH];
id ← AllocateContext[];
cntxt ← @ContextArray[id];
cntxt.top ← AllocateTransform[];
cntxt.top↑ ← TH↑;
cntxt.top.prev ← NIL;
LH↑ ← Identity;
inTransforms ← TRUE;
needsDivision ← TRUE;
END;

IncrementRefCount: PUBLIC PROCEDURE[id: CARDINAL] =
-- Increment reference count of context id
BEGIN
IF id >= LENGTH[ContextArray] THEN ERROR TransformationInvalidContext[id];
--seems ok - do it
ContextArray[id].refCount ← ContextArray[id].refCount + 1;
END;

DecrementRefCount: PUBLIC PROCEDURE[id: CARDINAL] =
-- Decrement reference count of context id
BEGIN
IF id >= LENGTH[ContextArray] OR ContextArray[id].refCount=0
THEN ERROR TransformationInvalidContext[id];
--seems ok - do it
ContextArray[id].refCount ← ContextArray[id].refCount - 1;
IF ContextArray[id].refCount=0 THEN FreeContext[id];
END;

SwapContext: PUBLIC PROCEDURE[id: CARDINAL] =
-- Change context to id
BEGIN
IF id >= LENGTH[ContextArray] OR ContextArray[id].refCount=0
THEN ERROR TransformationInvalidContext[id];
--seems ok - do it
IF inTransforms THEN Concatenate[LH,TH,TH];
CurrentContext ← id;
TH ← ContextArray[CurrentContext].top;
LH↑ ← Identity;
inTransforms ← TRUE;
needsDivision ← TRUE;
END;

Push: PUBLIC PROCEDURE =
-- Push current transformation - start a new relative coordinate system
BEGIN
cntxt: Context ← @ContextArray[CurrentContext];
IF inTransforms THEN Concatenate[LH,TH,TH];
cntxt.top ← AllocateTransform[];
cntxt.top↑ ← TH↑;
cntxt.top.prev ← TH;
TH ← cntxt.top;
LH↑ ← Identity;
inTransforms ← TRUE;
needsDivision ← TRUE;
END;

Pop: PUBLIC PROCEDURE =
-- Pop current transformation - return to previous coordinate system
BEGIN
cntxt: Context ← @ContextArray[CurrentContext];
IF cntxt.top.prev = NIL THEN ERROR TransformationStackUnderflow;
cntxt.top ← TH.prev;
FreeTransform[TH];
TH ← cntxt.top;
inTransforms ← FALSE;
needsDivision ← TRUE;
END;

Rotate: PUBLIC PROCEDURE[xRot,yRot: LONG INTEGER] =
-- Rotate x axis to direction of (xRot,yRot)
BEGIN
t: REAL;
IF ~inTransforms THEN ERROR TransformationBadContext;
BEGIN OPEN LH;
SELECT TRUE FROM
xRot = 0 =>BEGIN
t ← -a12; a12 ← a11; a11 ← t;
t ← -a22; a22 ← a21; a21 ← t;
t ← -a32; a32 ← a31; a31 ← t;
IF yRot<0 THEN a33 ← -a33;
END;
yRot = 0 =>IF xRot<0 THEN a33 ← -a33;
ENDCASE =>BEGIN
c: REAL = xRot; s: REAL = yRot;
t ← a11*c - a12*s; a12 ← a11*s + a12*c; a11 ← t;
t ← a21*c - a22*s; a22 ← a21*s + a22*c; a21 ← t;
t ← a31*c - a32*s; a32 ← a31*s + a32*c; a31 ← t;
a33 ← a33*SqRt[c*c + s*s];
END;
type ← BITOR[type,rotscale];
END;
END;

Translate: PUBLIC PROCEDURE[xTrans,yTrans: LONG INTEGER] =
-- Translate by (xTrans,yTrans)
BEGIN
xT: REAL ← xTrans;
yT: REAL ← yTrans;
IF ~inTransforms THEN ERROR TransformationBadContext;
BEGIN OPEN LH;
a31 ← a31 + a33*xT;
a32 ← a32 + a33*yT;
type ← BITOR[type,translate];
END;
END;

Mirror: PUBLIC PROCEDURE[coord: CoordName] =
-- Mirror coordinates
BEGIN
IF ~inTransforms THEN ERROR TransformationBadContext;
BEGIN OPEN LH;
SELECT coord FROM
x =>BEGIN
a11 ← -a11;
a21 ← -a21;
a31 ← -a31;
END;
y =>BEGIN
a12 ← -a12;
a22 ← -a22;
a32 ← -a32;
END;
ENDCASE;
type ← BITOR[type,rotscale];
END;
END;

Scale: PUBLIC PROCEDURE[numerator,denominator: LONG INTEGER] =
-- Scale by numerator/denominator
BEGIN
num: REAL ← numerator;
denom: REAL ← denominator;
IF ~inTransforms THEN ERROR TransformationBadContext;
BEGIN OPEN LH;
a11 ← a11*num;
a21 ← a21*num;
a31 ← a31*num;
a12 ← a12*num;
a22 ← a22*num;
a32 ← a32*num;
a33 ← a33*denom;
type ← BITOR[type,rotscale];
END;
END;

GetLocal: PUBLIC PROCEDURE RETURNS[localTransform: TransformRecord] =
-- Return incremental transformation built since last Push
BEGIN
RETURN[LH↑];
END;

ApplyLocal: PUBLIC PROCEDURE[transform: Transform] =
-- Apply transformation to current local transformation
BEGIN
IF ~inTransforms THEN ERROR TransformationBadContext;
Concatenate[LH,transform,LH];
END;

GetCurrent: PUBLIC PROCEDURE RETURNS[currentTransform: TransformRecord] =
-- Return current cummulative transformation
BEGIN
IF inTransforms
THENBEGIN
Concatenate[LH,TH,TH];
inTransforms ← FALSE;
END;
RETURN[TH↑];
END;

TransformPoint: PUBLIC PROCEDURE[x,y: LONG INTEGER] RETURNS[xT,yT: LONG INTEGER] =
-- Transform the point (x,y) by current cumulative transformation
BEGIN
SELECT TRUE FROM
inTransforms =>BEGIN
Concatenate[LH,TH,TH];
inTransforms ← FALSE;
DivideTransform[TH,T];
needsDivision ← FALSE;
END;
needsDivision =>BEGIN
DivideTransform[TH,T];
needsDivision ← FALSE;
END;
ENDCASE;
BEGIN OPEN T;
SELECT type FROM
ident =>BEGIN
xT ← x;
yT ← y;
END;
translate =>BEGIN
xT ← x + a31;
yT ← y + a32;
END;
rotscale =>BEGIN
X: REAL = x;
Y: REAL = y;
xT ← Round[X*a11 + Y*a21];
yT ← Round[X*a12 + Y*a22];
END;
ENDCASE =>BEGIN
X: REAL = x;
Y: REAL = y;
xT ← a31 + Round[X*a11 + Y*a21];
yT ← a32 + Round[X*a12 + Y*a22];
END;
END;
END;

TransformVector: PUBLIC PROCEDURE[x,y: LONG INTEGER] RETURNS[xT,yT: LONG INTEGER] =
-- Transform the direction (x,y) by current cumulative transformation
BEGIN
SELECT TRUE FROM
inTransforms =>BEGIN
Concatenate[LH,TH,TH];
inTransforms ← FALSE;
DivideTransform[TH,T];
needsDivision ← FALSE;
END;
needsDivision =>BEGIN
DivideTransform[TH,T];
needsDivision ← FALSE;
END;
ENDCASE;
BEGIN OPEN T;
SELECT type FROM
ident, translate =>
BEGIN
xT ← x;
yT ← y;
END;
ENDCASE =>BEGIN
X: REAL = x;
Y: REAL = y;
xT ← Round[X*a11 + Y*a21];
yT ← Round[X*a12 + Y*a22];
END;
END;
END;

RTransformPoint: PUBLIC PROCEDURE[x,y: REAL] RETURNS[xT,yT: REAL] =
-- Transform the point (x,y) by current cumulative transformation - in REALs
BEGIN
IF inTransforms
THENBEGIN
Concatenate[LH,TH,TH];
inTransforms ← FALSE;
END;
BEGIN OPEN TH;
SELECT type FROM
ident =>BEGIN
xT ← x;
yT ← y;
END;
translate =>BEGIN
xT ← x + a31;
yT ← y + a32;
END;
rotscale =>BEGIN
xT ← (x*a11 + y*a21)/a33;
yT ← (x*a12 + y*a22)/a33;
END;
ENDCASE =>BEGIN
xT ← (a31 + x*a11 + y*a21)/a33;
yT ← (a32 + x*a12 + y*a22)/a33;
END;
END;
END;

RTransformVector: PUBLIC PROCEDURE[x,y: REAL] RETURNS[xT,yT: REAL] =
-- Transform the direction (x,y) by current cumulative transformation - in REALs
BEGIN
IF inTransforms
THENBEGIN
Concatenate[LH,TH,TH];
inTransforms ← FALSE;
END;
BEGIN OPEN TH;
SELECT type FROM
ident, translate =>
BEGIN
xT ← x;
yT ← y;
END;
ENDCASE =>BEGIN
xT ← (x*a11 + y*a21)/a33;
yT ← (x*a12 + y*a22)/a33;
END;
END;
END;

Concatenate: PROCEDURE[A,B,C: Transform] =
-- A*B => C, A=C or B=C is OK
BEGIN
Cprev: Transform ← C.prev;
SELECT TRUE FROM
A.type=ident => IF C#B THEN C↑ ← B↑; --(not uncommon for ApplyLocal)
B.type=ident => IF C#A THEN C↑ ← A↑;
ENDCASE =>
BEGIN
T: TransformRecord;
T.a11 ← A.a11*B.a11 + A.a12*B.a21;
T.a21 ← A.a21*B.a11 + A.a22*B.a21;
T.a31 ← A.a31*B.a11 + A.a32*B.a21 + A.a33*B.a31;
T.a12 ← A.a11*B.a12 + A.a12*B.a22;
T.a22 ← A.a21*B.a12 + A.a22*B.a22;
T.a32 ← A.a31*B.a12 + A.a32*B.a22 + A.a33*B.a32;
T.a33 ← A.a33*B.a33;
T.type ← BITOR[A.type,B.type];
C↑ ← T;
END;
C.prev ← Cprev;
END;

DivideTransform: PROCEDURE[AH: Transform, A: DividedTransform] =
-- AH/AH(3,3) => A
BEGIN
IF AH.a33=1
THENBEGIN
A.a11 ← AH.a11;
A.a21 ← AH.a21;
A.a31 ← Round[AH.a31];
A.a12 ← AH.a12;
A.a22 ← AH.a22;
A.a32 ← Round[AH.a32];
END
ELSEBEGIN
ah33: REAL = AH.a33;
A.a11 ← AH.a11/ah33;
A.a21 ← AH.a21/ah33;
A.a31 ← Round[AH.a31/ah33];
A.a12 ← AH.a12/ah33;
A.a22 ← AH.a22/ah33;
A.a32 ← Round[AH.a32/ah33];
END;
A.type ← AH.type;
END;

AllocateContext: PROCEDURE RETURNS[id: CARDINAL] =
-- Allocate slot for new context
-- Contexts are held in an array of ContextRecord
BEGIN
FOR id IN [0..LENGTH[ContextArray]) DO
IF ContextArray[id].refCount=0 THEN EXIT;
REPEAT
FINISHED =>
BEGIN
i: CARDINAL;
newContextArrayLength: CARDINAL ← 2*LENGTH[ContextArray];
newContextArray: DESCRIPTOR FOR ARRAY OF ContextRecord;
WriteString["Increasing ContextArray to "];
WriteDecimal[newContextArrayLength];
WriteLine[" entries"];
newContextArray ←
DESCRIPTOR[AllocateNode[newContextArrayLength*SIZE[ContextRecord]],
newContextArrayLength];
FOR i IN [0..LENGTH[ContextArray]) DO
newContextArray[i] ← ContextArray[i];
newContextArray[i+LENGTH[ContextArray]] ← [top: NIL, refCount:0];
ENDLOOP;
id ← LENGTH[ContextArray];
FreeNode[BASE[ContextArray]];
ContextArray ← newContextArray;
END;
ENDLOOP;
END;

FreeContext: PROCEDURE[id: CARDINAL] =
-- Free context slot
BEGIN
cntxt: Context ← @ContextArray[id];
t,prevt: Transform;
FOR t ← cntxt.top, prevt UNTIL t=NIL DO
prevt ← t.prev;
FreeTransform[t];
ENDLOOP;
cntxt↑ ← [top: NIL, refCount: 0];
END;


FreeTransformList: Transform ← NIL; --kept linked through .prev
TransformPagePointer: LONG POINTER ← NIL;
TransformCount: CARDINAL;

AllocateTransform: PROCEDURE RETURNS [trans: Transform] =
BEGIN
IF FreeTransformList#NIL THEN
BEGIN --take one off the free list
trans ← FreeTransformList;
FreeTransformList ← FreeTransformList.prev;
END
ELSE
BEGIN --allocate a new TransformRecord
IF TransformPagePointer=NIL OR
TransformCount+SIZE[TransformRecord]>AltoDefs.PageSize
THEN --allocate a new page
BEGIN
ptr: LONG POINTER TO LONG POINTER ←
LongDataSegmentAddress[
NewDataSegment[DefaultXMBase,1]];
ptr↑ ← TransformPagePointer;
TransformPagePointer ← ptr;
TransformCount ← SIZE[LONG POINTER];
END;
trans ← TransformPagePointer + TransformCount;
TransformCount ← TransformCount + SIZE[TransformRecord];
END;
END;

FreeTransform: PROCEDURE [trans: Transform] =
BEGIN
trans.prev ← FreeTransformList;
FreeTransformList ← trans;
END;

ReleaseAllTransforms: PROCEDURE =
-- Free all space currently being held for a TransformRecords
BEGIN
ptr: LONG POINTER TO LONG POINTER ←
TransformPagePointer;
next: LONG POINTER;
FOR ptr ← ptr, next UNTIL ptr=NIL DO
next ← ptr↑;
DeleteDataSegment[LongVMtoDataSegment[ptr]];
ENDLOOP;
FreeTransformList ← NIL;
TransformPagePointer ← NIL;
END;

--OldAllocateTransform: PROCEDURE RETURNS[t: Transform] =
-- Allocate space for a TransformRecord
-- These are originally allocated off the heap, but are then kept
-- in a linked list through the first word of each block.
--BEGIN
--IF FreeTransformList=NIL THEN
--RETURN[AllocateNode[SIZE[TransformRecord]]]
--ELSE
--BEGIN
--t ← FreeTransformList;
--FreeTransformList ← FreeTransformList↑;
--END;
--END;

--OldFreeTransform: PROCEDURE[t: Transform] =
-- Free space for a TransformRecord
--BEGIN
--p: POINTER ← t;
--p↑ ← FreeTransformList;
--FreeTransformList ← p;
--END;

--OldReleaseAllTransforms: PROCEDURE =
-- Free all space currently being held for a TransformRecords
--BEGIN
--next: POINTER;
--FOR FreeTransformList ← FreeTransformList, next UNTIL FreeTransformList=NIL DO
--next ← FreeTransformList↑;
--FreeNode[FreeTransformList];
--ENDLOOP;
--END;

AllocateNode: PROCEDURE[size: CARDINAL] RETURNS[POINTER] =
BEGIN
NNodes ← NNodes + 1;
RETURN[AllocateHeapNode[size]];
END;

FreeNode: PROCEDURE[n: POINTER] =
BEGIN
NNodes ← NNodes - 1;
FreeHeapNode[n];
END;

half: REAL = 0.5;
Round: PROCEDURE[r: REAL] RETURNS[i: LONG INTEGER] = INLINE
-- Rounds r to produce i
BEGIN
RETURN[Fix[IF r<0 THEN r-half ELSE r+half]];
END;

TransformationStackUnderflow: PUBLIC ERROR = CODE;
TransformationBadContext: PUBLIC ERROR = CODE;
TransformationInvalidContext: PUBLIC ERROR[id: CARDINAL] = CODE;

END.