-- CGBrickImpl.mesa Cedar 3.4 version
-- Last changed by Pier, October 8, 1982 3:30 pm

DIRECTORY
CGBrick,
PriorityQueue USING[Ref, Item, Create, Insert, Remove, Empty],
RandomCard USING[Init, Next],
Real USING [FixI, RoundI, Float],
RealFns USING [ CosDeg, SinDeg],
CGStorage USING [pZone],
Inline USING [HighHalf, LowHalf];

CGBrickImpl: PROGRAM
IMPORTS Real, RealFns, Inline, CGStorage, RandomCard, PriorityQueue
EXPORTS CGBrick = {

OPEN PQ: PriorityQueue, CGBrick, Real, RealFns;

sZ: ZONE = CGStorage.pZone;
currentBrick: PUBLIC REF BrickHandle ← sZ.NEW[BrickHandle ← NIL];--global storage for the current brick

QItem: TYPE = REF QItemRep;
QItemRep: TYPE = RECORD [l,p: CARDINAL, val: REAL];


-- sorting function for halftone generator below
SortPred: SAFE PROC [x: PQ.Item, y: PQ.Item, data: REF ← NIL] RETURNS [BOOL] = TRUSTED {
na: QItem ← NARROW[x];
nb: QItem ← NARROW[y];
RETURN[IF na.val=nb.val THEN RandomBool[] ELSE na.val < nb.val] };

RandomBool: PROC RETURNS [BOOLEAN] = {RETURN [(RandomCard.Next[] MOD 2) = 0]};

--Procedure BuildBrick is called with a halftone dot defined by its
--frequency in pixels/dot (may be REAL), rotation angle, and a filter function defined on
--the interval [-1..+1] in both x and y, returning values in the range [0..1].


BuildBrick: PUBLIC PROC[freq: REAL, angle: REAL, filter: PROC[x,y:REAL] RETURNS [fvalue: REAL]]
RETURNS [bH: BrickHandle] = {

tInt: INTEGER;--temporary
u,v: REAL ← 0.0;--u/v is tangent[angle]
iu, iv, iuvsqrd: INTEGER 𡤀-- closest integer values of u,v
absiu, absiv: INTEGER ← 0;-- absolute values of iu,iv
riu, riv, riuvsqrd: REAL ← 0.0;--real versions of iu, iv, etc.
p, L: INTEGER 𡤀--dimensions of halftone brick, L wide and p high
a,b,c,d: REAL ← 0.0;--elements of the transform matrix
LIndex, pIndex: INTEGER ← 0;
x, y: INTEGER ← 0;--for receiving results of ExtendedEuclid.
reali, realj, realiPrime, realjPrime: REAL ← 0.0;

--define the parameters u and v of the "enclosing square"
--surrounding the rotated halftone dot

u ← freq*SinDeg[angle]; v ← freq*CosDeg[angle];
iu ← RoundI[u];-- get nearest integer
iv ← RoundI[v];
IF iu = 0 AND iv = 0 THEN iu ← 1;--appearance error
--now compute rotation for iu, iv into first quadrant
absiv ← ABS[iv]; absiu ← ABS[iu];
IF iu*iv < 0 THEN { tInt ← absiv; absiv ← absiu; absiu ← tInt };
[x, y, p] ← ExtendedEuclid[absiu, absiv];--computes GCD of arguments plus D value arguments
iuvsqrd ← iu*iu + iv*iv;
L ← iuvsqrd/p;--calculate length of brick

--now calculate the elements of the coord transformation from
--brick indexes into the elementary dot. This dot is 2 wide and 2 high
--centered about the origin. The transform is a concatenation of two
--transform matrices, one to normalize the brick by 2, and
--another to rotate the brick coordinates into elementary coordinates:
--
-- [ 2 0 ] [ cos -sin] [ a b]
-- | |* | | = | |
-- [ 0 2 ] [ sin cos] [ c d]

riu ← Float[iu]; riv ← Float[iv]; riuvsqrd ← Float[iuvsqrd];
d ← a ← 2*riv/riuvsqrd ;
c ← 2*riu/riuvsqrd;
b ← -c; -- -2*riu/riuvsqrd

--get brick instance
bH ← sZ.NEW[Brick[L*p] ← [L: L, p: p, D: 0, u: absiu, v: absiv, cBrick: ]];
bH.D ← (x*absiv - y*absiu) MOD L;

--now calculate the brick values
{ -- so we can do some more declarations
item: QItem;
lxp: NAT = L*p;
sliceInterval: REAL = 1.0/Real.Float[lxp];
currentSlice: REAL ← 0;
pQ: PQ.Ref;

[] ← RandomCard.Init[seed: 1];--results in [0..2)
pQ ← PQ.Create[SortPred];

FOR LIndex IN [0..L) DO
reali ← LIndex+0.5;
FOR pIndex IN [0..p) DO
realj ← pIndex+0.5;
realiPrime ← RealMod[(reali*a + realj*c), 2.0] - 1.0;
realjPrime ← RealMod[(reali*b + realj*d), 2.0] - 1.0;
 item ← sZ.NEW[QItemRep];
item^ ← [l: LIndex, p: pIndex, val: filter[realiPrime, realjPrime]];
 PQ.Insert[pQ, item];
ENDLOOP;
ENDLOOP;

FOR i: NAT IN [0..lxp) DO
item ← NARROW[PQ.Remove[pQ]];
bH.cBrick[L*item.p + item.l] ← currentSlice;
currentSlice ← currentSlice + sliceInterval;
ENDLOOP;
IF ~PQ.Empty[pQ] THEN ERROR;

};--brick values

};--BuildBrick

ExtendedEuclid: PROC[u, v: INTEGER] RETURNS [u1, u2, u3: INTEGER] = {
q, v1, v2, v3, t1, t2, t3: INTEGER;

u1 ← 1; u2 ← 0; u3 ←u;
v1 ← 0; v2 ← 1; v3 ← v;

DO
IF (v3 = 0) THEN EXIT;
q ← u3/v3;
t1 ← u1-(v1*q); t2 ← u2-(v2*q); t3 ← u3-(v3*q);
u1 ← v1; u2 ← v2; u3 ← v3;
v1 ← t1; v2 ← t2; v3 ← t3;
ENDLOOP;

};--ExtendedEuclid


RealMod: PROC[a,b: REAL] RETURNS [REAL] =
 { RETURN[a - (FloorI[a/b])*b];};--RealMod

FloorI: PROC[r: REAL] RETURNS [i: INTEGER] = {
n: INTEGER ← 0;
IF r >= 0.0 THEN RETURN[FixI[r]];
n ← FixI[-r+2]; RETURN[FixI[n+r] -n];
};--FloorI

FreeBrick: PUBLIC PROC[pbH: REF BrickHandle] = { pbH^ ← NIL; };--FreeBrick

GetSize: PUBLIC PROC[bH: BrickHandle] RETURNS [L,p: CARDINAL, D: INTEGER] = {
--brick is L long and p high
RETURN[bH.L, bH.p, bH.D];
};--GetSize
 
Modd: PROC[x, y: LONG INTEGER] RETURNS [LONG INTEGER] = {
RETURN [IF x >= 0 THEN (x MOD y) ELSE ((y-1) + (x+1) MOD y)];
};--Modd

GetElement: PUBLIC PROC[bH: BrickHandle, x,y: CARDINAL] RETURNS [bElement: REAL] = {
row, col: CARDINAL ← 0;
row ← GetRow[bH,x,y];
col ← GetCol[bH,x,y];
RETURN [bH.cBrick[bH.L*row + col]];
};--GetElement

GetCurrentBrick: PUBLIC PROC RETURNS [REF BrickHandle] = {
RETURN[currentBrick];
};--GetCurrentBrick

GetRow: PUBLIC PROC[bH: BrickHandle, x,y: CARDINAL] RETURNS [row: CARDINAL] = {
RETURN [y MOD bH.p];
};--GetRow

GetCol: PUBLIC PROC[bH: BrickHandle, x,y: CARDINAL] RETURNS [col: CARDINAL] = {
i: LONG INTEGER ← Modd[(x - LONG[bH.D]*(y/bH.p)), bH.L];
IF Inline.HighHalf[i]#0 THEN ERROR;
RETURN [Inline.LowHalf[i]];
};--GetCol

}. --of CGBrickImpl

LOG
-- created, 21-Oct-81 12:00:21, Pier
-- changed matrix to store by rows instead of columns 26-Oct-81 15:24:40
-- fixed Modd to take LONG INTEGERs; added LONG in GetCol 8-Jan-82 13:27:38
--changed system zone to CGStorage zone, BrickHandle to REF, 13-Jan-82
--reformatted, 18-JAN-82
--changed to general purpose halftone brick, 23-Jan`82
--changed definition of brick to use L,p,D field names, 2/22/82