
    <<PolyKal.Mesa>>
        <<Copyright © 1986 by Xerox Corporation.  All rights reserved.>>
        <<Mike Spreitzer November 14, 1986 8:42:01 pm PST>>

    DIRECTORY Basics, BasicTime, Buttons, ColorDisplayFace, FS, IdleBackdoor, Imager, ImagerBox, ImagerColor, ImagerColorMap, 
    ImagerDitherContext, ImagerFont, ImagerInterpress, ImagerPath, ImagerPixelMap, ImagerTerminal, ImagerTransformation, IO, Menus, 
    PopUpButtons, PrincOps, Process, Random, Real, RealFns, Rope, Terminal, ThisMachine, TIPUser, UserProfile, Vector2, 
    ViewerClasses, ViewerOps;

    PolyKal: CEDAR MONITOR
        IMPORTS BasicTime, ColorDisplayFace, FS, IdleBackdoor, Imager, ImagerBox, ImagerColor, ImagerColorMap, ImagerDitherContext, 
        ImagerFont, ImagerInterpress, ImagerPath, ImagerTerminal, ImagerTransformation, IO, PopUpButtons, Process, Random, Real, 
        RealFns, Rope, Terminal, ThisMachine, UserProfile, Vector2
        <<INVARIANT>>
            <<going IFF there is a process running the kaleidoscope.>>
        =

        {

        ROPE: TYPE = Rope.ROPE;
        VEC: TYPE = Vector2.VEC;
        Viewer: TYPE = ViewerClasses.Viewer;
        PixelMap: TYPE = ImagerPixelMap.PixelMap;
        Font: TYPE = ImagerFont.Font;
        ConstantColor: TYPE = Imager.ConstantColor;
        Transformation: TYPE = ImagerTransformation.Transformation;
        ColorMapEntryList: TYPE = LIST OF ImagerColorMap.MapEntry;

        Sgn: TYPE = INTEGER[-1 .. 1];

        TextData: TYPE = RECORD [
            texts: TextList,
            numTexts: NAT,
            totalProbability: REAL];

        TextList: TYPE = LIST OF Text;
        Text: TYPE = RECORD [
            text: ROPE,
            bounds: Imager.Box,
            cumProb: REAL
            ];

        RealCtl: TYPE = RECORD [
            min: REAL _ 0.0,
            max: REAL _ 1.0,
            exp: REAL _ 0.5];

        Control: TYPE = REF ControlPrivate;
        ControlPrivate: TYPE = RECORD [
            shouldGo: BOOL _ FALSE,
            ipRadius: REAL--inches-- _ 3.0,
            ipCenter: VEC _ [3.0, 3.0],
            ipContext: Imager.Context _ NIL,
            wantIP, hold: BOOL _ FALSE,
            symmetry: CARDINAL _ 8,
            colorSpace: {hsv, hsl, rgb} _ hsv,
            p1Ctl: RealCtl _ [exp: 1.0],
            p2Ctl, p3Ctl: RealCtl _ [],
            background: ImagerColor.RGB _ [0, 0, 0],
            upTextMin: Milliseconds _ 10*OneSecond,
            upTextMax: Milliseconds _ 60*OneSecond,
            downTextMin: Milliseconds _ 1*OneSecond,
            downTextMax: Milliseconds _ 6*OneSecond,
            vCenter: VEC _ [0, 0],
            xSize--x size of 0th slice--, ySize: NAT _ 0,
            doText: BOOL _ FALSE,
            pausePeriod: Process.Ticks _ 0,
            holdPeriod: Process.Ticks _ Process.MsecToTicks[500],
            runningPriority: Process.Priority _ Process.priorityBackground,
            retraces: NAT _ 1,
            change: CONDITION
            ];

        td: TextData;
        font: Font _ NIL;
        rs: Random.RandomStream _ Random.Create[seed: -1];

        Milliseconds: TYPE = INT;
        OneSecond: Milliseconds = 1000;

        Root3Quarters: REAL _ RealFns.SqRt[0.75];

        black: Imager.Color _ Imager.black;
        white: Imager.Color _ Imager.white;

        going: BOOL _ FALSE;
        machineName: ROPE _ ThisMachine.Name[];
        ctl: Control _ NEW [ControlPrivate _ []];

        ButtonControl: PROC [viewer: Viewer, instanceData, classData: REF ANY, key: REF ANY] --PopUpButtons.PopUpButtonProc-- = {
            OPEN ctl;
            SELECT key FROM
                $RunStop, $SameSymmetry => {
                    shouldGo _ NOT going;
                    IF shouldGo AND OKToGo[] THEN {
                        IF key = $RunStop THEN symmetry _ rs.ChooseInt[2, 8]*2;
                        TRUSTED {Process.Detach[FORK Viewit[]]};
                        };
                    };
                $ToggleIPWriting => wantIP _ NOT wantIP;
                $TogglePause => hold _ NOT hold;
                ENDCASE => ERROR;
            };

        StopGoing: ENTRY PROC = {going _ FALSE; BROADCAST ctl.change};
        OKToGo: ENTRY PROC RETURNS [go: BOOL] = {
            IF go _ NOT going THEN {going _ TRUE; BROADCAST ctl.change}};

        StopViewing: PROC RETURNS [BOOL] =
            {OPEN ctl; RETURN [NOT shouldGo]};

        Kalidle: PROC [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift, control: BOOL _ FALSE] = {
            OPEN ctl;
            symmetry _ rs.ChooseInt[2, 8]*2;
            [] _ IdleBackdoor.UseAlternateVT[vtProc: DoForVT, logout: NOT control];
            };

        vtContext: Imager.Context;

        GiveVTContext: PROC [to: PROC [context: Imager.Context]] =
            {to[vtContext]};

        Viewit: PROC = {
            OPEN ctl;
            TRUSTED {
                Process.SetPriority[runningPriority];
                };
            VTWork[Terminal.Current[], StopViewing !UNWIND => StopGoing[]];
            StopGoing[];
            };

        DoForVT: PROC [vt: Terminal.Virtual] = {
            context: Imager.Context;
            vt.Select[];
            [] _ vt.SetBWBitmapState[allocated];
            [] _ vt.SetBWBitmapState[displayed];
            context _ ImagerTerminal.BWContext[vt: vt, pixelUnits: TRUE];
            Imager.SetColor[context, Imager.white];
            Imager.MaskRectangle[context, [0, 0, vt.bwWidth, vt.bwHeight]];
            VTWork[vt, KeyTyped];
            };

        KeyTyped: PROC RETURNS [stop: BOOL] = {
            stop _ IdleBackdoor.KeyTyped[IdleBackdoor.defaultKeyFilter]};

        VTWork: PROC [vt: Terminal.Virtual, Stop: PROC RETURNS [BOOL]] = {
            OPEN ctl;
            width, height: INTEGER;
            mapEntries: ColorMapEntryList _ ImagerColorMap.StandardColorMapEntries[8];
            SimpleSet: PROC [a, b: Terminal.ChannelValue _ 0, red, green, blue: Terminal.ColorValue, shared: BOOL _ TRUE] = {
                Terminal.SetColor[vt: vt, aChannelValue: a, bChannelValue: b, red: red, green: green, blue: blue];
                };
            WithContext: PROC = {
                IF useImagerColorMap THEN ImagerColorMap.Change[vt, WithVT] ELSE WithVT[SimpleSet];
                };
            WithVT: PROC [set: ImagerColorMap.MapProc] = {
                vt _ vt;
                FOR cml: ColorMapEntryList _ mapEntries, cml.rest WHILE cml # NIL DO
                    set[a: cml.first.mapIndex, b: 0, red: cml.first.red, green: cml.first.green, blue: cml.first.blue];
                    ENDLOOP;
                vt _ vt;
                Dewit[giveContext: GiveVTContext, xp0: 0, yp0: 0, xp1: width, yp1: height, Stop: Stop, vt: vt];
                vt _ vt;
                };
            [vtContext, width, height] _ StartDeviceAndPM[vt];
            IF useImagerDitherContext THEN ImagerDitherContext.DoWithDitherMap[context: vtContext, mapEntries: mapEntries, action: WithContext] 
            ELSE WithContext[];
            };

        useImagerDitherContext: BOOL _ TRUE;
        useImagerColorMap: BOOL _ TRUE;
        upText, downText, T: Milliseconds _ 0;
        curText: Text;
        cto: Vector2.VEC;
        cts: REAL;

        TwoToThe: ARRAY [0 .. 15] OF CARDINAL = [
            00001H, 00002H, 00004H, 00008H,
            00010H, 00020H, 00040H, 00080H,
            00100H, 00200H, 00400H, 00800H,
            01000H, 02000H, 04000H, 08000H];

        ForkIPWriter: PROC = TRUSTED {Process.Detach[ipWriter _ FORK IPWriter[]]};
        ipWriter: PROCESS;

        IPWriter: PROC = {
            DO
                GetRequest: ENTRY PROC = {
                    ENABLE UNWIND => NULL;
                    WHILE ctl.wantIP = (ctl.ipContext # NIL) OR NOT going DO WAIT ctl.change ENDLOOP;
                    };
                CollectPage: ENTRY PROC [ipContext: Imager.Context] = {
                    ENABLE UNWIND => NULL;
                    ipContext.ScaleT[Imager.metersPerInch];
                    ipContext.TranslateT[ctl.ipCenter];
                    ipContext.ScaleT[ctl.ipRadius/ctl.xSize];
                    ipContext.TranslateT[ctl.vCenter.Neg[]];
                    ctl.ipContext _ ipContext;
                    BROADCAST ctl.change;
                    WHILE going AND ctl.wantIP DO WAIT ctl.change ENDLOOP;
                    ctl.ipContext _ NIL;
                    BROADCAST ctl.change;
                    };
                GetRequest[];
                ipFile _ ImagerInterpress.Create["[]<>PolyKal.IP"];
                ImagerInterpress.DoPage[ipFile, CollectPage];
                ImagerInterpress.Close[ipFile];
                ENDLOOP;
            };
            ipFile: ImagerInterpress.Ref;

        Dewit: PROC [giveContext: PROC [to: PROC [context: Imager.Context]], xp0, yp0, xp1, yp1: INTEGER, Stop: PROC RETURNS [BOOL], vt: 
        Terminal.Virtual] = {
            OPEN ctl;
            
            sin
            cos
            vCenter _ [x: (xp0 + xp1)/2, y: (yp0 + yp1)/2];
            {toZero: Transformation = ImagerTransformation.Translate[[-vCenter.x, -vCenter.y]];
            rotateCCW: Transformation = toZero.PostRotate[2*
            rotateCW: Transformation = toZero.PostRotate[-2*
            negateY: Transformation = toZero.PostScale2[[1.0, -1.0]].PostTranslate[vCenter];
            d0: REAL = sin
            PickText: PROC [T: Milliseconds] = {
                p: REAL _ Choose[0, td.totalProbability*0.999];
                tl: TextList;
                FOR tl _ td.texts, tl.rest WHILE p > tl.first.cumProb DO NULL ENDLOOP;
                curText _ tl.first;
                upText _ T + rs.ChooseInt[upTextMin, upTextMax];
                downText _ upText + rs.ChooseInt[downTextMin, downTextMax];
                cts _ (xp1 - xp0)/(curText.bounds.xmax - curText.bounds.xmin)/2;
                cto _ [
                    x: Choose[
                        xp0 - cts*curText.bounds.xmin,
                        xp1 - cts*curText.bounds.xmax],
                    y: Choose[
                        yp0 - cts*curText.bounds.ymin,
                        yp1 - cts*curText.bounds.ymax]];
                };
            DrawText: PROC [context: Imager.Context] = {
                InnerDoit: PROC = {
                    context.SetXY[cto];
                    context.TranslateT[cto];
                    context.ScaleT[cts];
                    context.SetFont[font];
                    context.ShowRope[curText.text];
                    };
                Imager.DoSave[context, InnerDoit];
                };
            prevUp: BOOL _ FALSE;
            outline: ImagerPath.Outline = NEW [ImagerPath.OutlineRep[symmetry]];
            DrawInit: PROC [context: Imager.Context] = {
                Imager.SetColor[context, ImagerColor.ColorFromRGB[background]];
                Imager.MaskBox[context, [xp0, yp0, xp1, yp1]];
                };
            SettleIPContext: ENTRY PROC = {
                ENABLE UNWIND => NULL;
                WHILE wantIP # (ipContext # NIL) DO NOTIFY change; WAIT change ENDLOOP;
                };
            DrawDelta: PROC [context: Imager.Context] = {
                shouldUp: BOOL = (T >= upText) AND (T < downText);
                urVerts: CARDINAL = rs.ChooseInt[3, 7];
                Generate: ImagerPath.PathProc = {
                    first: BOOL _ TRUE;
                    firstV, lastV: VEC;
                    firstD, lastD: REAL;
                    firstS, lastS: Sgn _ 0;
                    See: PROC [v: VEC, d: REAL, sgn: Sgn] = {
                        IF sgn*lastS < 0 THEN {
                            perLast: REAL = d / REAL[d - lastD];
                            perCur: REAL = - lastD / REAL[d - lastD];
                            cross: VEC = [
                                x: perCur*v.x + perLast*lastV.x,
                                y: perCur*v.y + perLast*lastV.y];
                            IF first
                                THEN {first _ FALSE; moveTo[cross]}
                                ELSE lineTo[cross];
                            }
                        ELSE IF sgn >= 0 THEN {
                            IF first
                                THEN {first _ FALSE; moveTo[v]}
                                ELSE lineTo[v];
                            };
                        };
                    FOR i: INT IN [1 .. urVerts] DO
                        v: VEC = [
                            vCenter.x + rs.ChooseInt[0, xSize],
                            vCenter.y + rs.ChooseInt[0, ySize]];
                        d: REAL = sin
                        sgn: Sgn = SGN[d];
                        IF i = 1 THEN {firstV _ v; firstD _ d; firstS _ sgn};
                        See[v, d, sgn];
                        lastV _ v;
                        lastD _ d;
                        lastS _ sgn;
                        ENDLOOP;
                    See[firstV, firstD, firstS];
                    };
                tl: ImagerPath.TrajectoryList _ NIL;
                thisColor: ConstantColor = PickColor[];
                WHILE tl = NIL DO tl _ ImagerPath.TrajectoryListFromPath[Generate] ENDLOOP;
                outline[0] _ tl.first;
                IF tl.rest # NIL THEN ERROR;
                outline[1] _ TransformTrajectory[outline[0], negateY];
                FOR i: INT IN (0 .. symmetry/2) DO
                    outline[2*i+0] _ TransformTrajectory[outline[2*i-2], rotateCCW];
                    outline[2*i+1] _ TransformTrajectory[outline[2*i-1], rotateCW];
                    ENDLOOP;
                Imager.SetColor[context, thisColor];
                Imager.MaskFillOutline[context, outline, TRUE];
                IF ipContext # NIL THEN {
                    Imager.SetColor[ipContext, thisColor];
                    Imager.MaskFillOutline[ipContext, outline, TRUE];
                    };
                IF doText AND shouldUp # prevUp THEN {
                    Imager.SetColor[context, IF shouldUp THEN PickColor[] ELSE black];
                    DrawText[context];
                    prevUp _ shouldUp;
                    };
                IF T >= downText THEN PickText[T];
                };
            oldP: BasicTime.Pulses;
            xSize _ MIN[
                Real.Fix[(xp1 - xp0) * (SELECT symmetry MOD 4 FROM
                    0 => 1.0,
                    2 => cos
                    ENDCASE => ERROR)],
                Real.Fix[(yp1 - yp0) / (IF symmetry = 4
                    THEN 1.0
                    ELSE MAX[
                        ImagerTransformation.Rotate[Real.Fix[(90 - 
                        ImagerTransformation.Rotate[Ceiling[(90 - 
                        ])]
                ]/2;
            ySize _ IF symmetry # 4
                THEN Real.RoundI[xSize*RealFns.TanDeg[
                ELSE xSize;
            PickText[T _ 0];
            giveContext[DrawInit];
            oldP _ BasicTime.GetClockPulses[];
            FOR i: INT _ 0, i+1 WHILE NOT Stop[] DO
                newP: BasicTime.Pulses;
                SettleIPContext[];
                IF hold THEN Process.Pause[holdPeriod] ELSE giveContext[DrawDelta];
                IF pausePeriod # 0 THEN Process.Pause[pausePeriod];
                FOR i: NAT IN [0 .. retraces) DO
                    Terminal.WaitForBWVerticalRetrace[vt];
                    ENDLOOP;
                newP _ BasicTime.GetClockPulses[];
                IF newP > oldP THEN {
                    
                    T _ T + 
                oldP _ newP;
                ENDLOOP;
            oldP _ oldP;
            }};

        TransformTrajectory: PROC [traj: ImagerPath.Trajectory, m: Transformation] RETURNS [new: ImagerPath.Trajectory] = {
            Produce: ImagerPath.PathProc = {
                ImagerPath.MapTrajectory[traj, moveTo, lineTo, curveTo, conicTo, arcTo];
                };
            first: BOOL _ TRUE;
            Consume: PROC [t: ImagerPath.Trajectory] = {
                IF first THEN {first _ FALSE; new _ t} ELSE ERROR;
                };
            ImagerPath.TrajectoriesFromPath[Produce, m, Consume];
            };

        EvalCtl: PROC [rc: RealCtl] RETURNS [r: REAL] = {
            r _ rc.min + (rc.max - rc.min)*RealFns.Power[rs.ChooseInt[0, 16384]/16384.0, rc.exp]};

        PickColor: PROC RETURNS [color: ConstantColor] = {
            OPEN ctl;
            p1: REAL = EvalCtl[p1Ctl];
            p2: REAL = EvalCtl[p2Ctl];
            p3: REAL = EvalCtl[p3Ctl];
            color _ ImagerColor.ColorFromRGB[SELECT colorSpace FROM
                hsv => ImagerColor.RGBFromHSV[[H: p1, S: p2, V: p3]],
                hsl => ImagerColor.RGBFromHSL[[H: p1, S: p2, L: p3]],
                rgb => [R: p1, G: p2, B: p3],
                ENDCASE => ERROR
                ];
            };

        StartDeviceAndPM: PROC [vt: Terminal.Virtual] RETURNS [context: Imager.Context, width, height: INTEGER] = {
            OPEN ctl;
            bpp: INT = 8;
            fb: Terminal.FrameBuffer;
            IF ColorDisplayFace.displayType = none THEN [] _ ColorDisplayFace.SetDisplayType[profiledDisplayType];
            [] _ Terminal.SetColorBitmapState[vt: vt, newState: displayed, newMode: [full: FALSE, bitsPerPixelChannelA: bpp, 
            bitsPerPixelChannelB: 0], newVisibility: aOnly];
            context _ ImagerTerminal.ColorContext[vt: vt, pixelUnits: TRUE];
            IF vt.GetColorMode[].bitsPerPixelChannelA # bpp THEN ERROR;
            fb _ vt.GetColorFrameBufferA[];
            width _ fb.width;
            height _ fb.height;
            };

        profiledDisplayType: ColorDisplayFace.ColorDisplayType;

        FixC: PROC [r: REAL] RETURNS [c: CARDINAL] = {c _ Real.FixC[r]};

        Floor: PROC [r: REAL] RETURNS [i: INT] = {
            d: INT _ 1 - Real.Fix[r];
            i _ Real.Fix[r+d]-d};

        Ceiling: PROC [r: REAL] RETURNS [i: INT] = {
            d: INT _ 1 + Real.Fix[r];
            i _ Real.Fix[r-d]+d};

        ReadTextData: PROC [fileName: ROPE] RETURNS [td: TextData] = {
            OPEN ctl;
            from: IO.STREAM _ FS.StreamOpen[fileName];
            last: TextList _ NIL;
            td _ [
                texts: NIL,
                numTexts: 0,
                totalProbability: 0];
            DO
                prob: REAL;
                text: ROPE;
                this: TextList;
                [] _ from.SkipWhitespace[];
                IF from.EndOf[] THEN EXIT;
                prob _ from.GetReal[];
                text _ from.GetRopeLiteral[];
                text _ Replace[text, "<machine name>", machineName];
                td.numTexts _ td.numTexts + 1;
                this _ LIST[ [
                    text: text,
                    bounds: ImagerBox.BoxFromExtents[font.RopeBoundingBox[text]],
                    cumProb: td.totalProbability _ td.totalProbability + prob] ];
                IF last = NIL THEN td.texts _ this ELSE last.rest _ this;
                last _ this;
                ENDLOOP;
            from.Close[];
            };

        Choose: PROC [min, max: REAL] RETURNS [r: REAL] =
            {r _ min + (rs.ChooseInt[0, 10000]/1.0E4) * (max-min)};

        Replace: PROC [in, what, with: ROPE] RETURNS [new: ROPE] = {
            start, len: INT;
            ousLen: INT _ what.Length[];
            new _ in;
            WHILE (start _ new.Index[s2: what]) < (len _ new.Length[]) DO
                new _ new.Substr[len: start].Cat[with, new.Substr[start: start+ousLen, len: len - (start+ousLen)]];
                ENDLOOP;
            };

        CreateButton: PROC = {
            ctlButton _
                PopUpButtons.MakeClass[[
                    proc: ButtonControl,
                    choices: LIST[
                        [$RunStop, "Start/stop"],
                        [$ToggleIPWriting, "Start/stop writing to []<>PolyKal.IP"],
                        [$TogglePause, "Pause or continue"],
                        [$SameSymmetry, "Start/stop, but don't choose new symmetry"]
                        ],
                    doc: "Polygon kaleidoscope control"
                    ]]
                .Instantiate[viewerInfo: [name: "pKal", column: static]];
            };
            ctlButton: Viewer _ NIL;

        SGN: PROC [r: REAL] RETURNS [sgn: Sgn] = {
            sgn _ SELECT r FROM
                <0 => -1,
                =0 => 0,
                >0 => 1,
                ENDCASE => ERROR;
            };

        NoteProfile: PROC [reason: UserProfile.ProfileChangeReason] --UserProfile.ProfileChangedProc-- = {
            displayTypeRope: ROPE _ UserProfile.Token["ColorDisplay.Type", "640x480"];
            profiledDisplayType _ SELECT TRUE FROM
                displayTypeRope.Equal["1024x768", FALSE] => highResolution,
                displayTypeRope.Equal["640x480", FALSE] => standard,
                ENDCASE => standard;
            };

        Start: PROC = {
            TRUSTED {
                Process.InitializeCondition[@ctl.change, Process.SecondsToTicks[60]];
                Process.EnableAborts[@ctl.change]};
            ForkIPWriter[];
            UserProfile.CallWhenProfileChanges[NoteProfile];
            font _ ImagerFont.Find["Xerox/PressFonts/TimesRoman-MRR"];
            td _ ReadTextData["Kal.texts"];
            CreateButton[];
            };

        Start[];

        }.