-- 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 _0;-- 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 _0;--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 Ę˜JšüĪc^œĪk œžœ:žœžœ"žœ žœžœ$žœžœ=žœžœžœ.žœ"žœžœžœžœ'œžœžœžœžœžœžœ1œĪnœžœžœžœ žœ žœžœžœžœžœžœžœ žœžœžœžœŸ œžœžœžœžœžœ íœŸ œžœžœžœ žœ žœžœžœ žœžœ žœ œžœœžœ!œžœœžœ œžœžœ2œ žœ#œžœžœ+œ(žœ:œ'œFœžœžœžœœ6œ žœžœžœ žœ[3œžœ œ>œGœEœ;œGœœ*œ*œ*œ}œœ žœžœžœžœžœ+žœžœžœ!œ'œžœžœžœ*žœžœ-œ žœžœžœžœžœ#žœžœžœ¤žœZžœžœžœ žœžœžœ žœžœžœžœZžœžœžœ žœžœ œ œŸœžœžœžœžœ#žœ:žœžœ žœžœ‡žœœŸœžœžœžœžœžœ œŸœžœžœžœžœ žœžœ žœžœžœ œŸ œžœžœžœžœ œŸœžœžœžœžœžœžœžœœžœžœ žœ œŸœžœžœžœžœžœžœžœžœžœžœžœžœ œŸ œžœžœžœžœ žœžœ8žœžœ œŸœžœžœžœžœžœœŸœžœžœžœžœžœžœžœ  œŸœžœžœžœžœžœ žœžœ žœžœžœžœžœžœžœ œœžœ’œ˜ô1—…—ö