--	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
	THEN	BEGIN
			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
	THEN	BEGIN
			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
	THEN	BEGIN
			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
	THEN	BEGIN
			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
	ELSE	BEGIN
			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.(635)\151b22B292b9B34i8I501b8B330b16B44b22B103b7B35b13B667b18B920b20B68b13B366b17B247b17B334b11B370b4B355b3B324b6B720b10B288b7B353b6B386b9B148b11B198b11B224b15B868b16B670b15B602b17B444b11B613b15B464b15B883b11B379b17B326i8I380b14B108b20B337b22B398b18B154b25B270b12B116b8B98b5B140b28B23b24B23b28B