<> <> <> DIRECTORY Basics, BasicTime, Buttons, ColorDisplayFace, FS, IdleBackdoor, Imager, ImagerBox, ImagerColor, ImagerColorMap, ImagerDitherContext, ImagerFont, ImagerInterpress, ImagerPixelMap, ImagerTerminal, IO, Menus, PaintPM, PopUpButtons, PrincOps, Process, Random, Real, RealFns, Rope, Terminal, ThisMachine, TIPUser, UserProfile, Vector2, ViewerClasses, ViewerOps; ColorKal: CEDAR MONITOR IMPORTS Basics, BasicTime, ColorDisplayFace, FS, IdleBackdoor, Imager, ImagerBox, ImagerColor, ImagerColorMap, ImagerDitherContext, ImagerFont, ImagerInterpress, ImagerPixelMap, ImagerTerminal, IO, PaintPM, PopUpButtons, Process, Random, Real, RealFns, Rope, Terminal, ThisMachine, UserProfile <> <> = { LORA: TYPE = LIST OF REF ANY; ROPE: TYPE = Rope.ROPE; Viewer: TYPE = ViewerClasses.Viewer; PixelMap: TYPE = ImagerPixelMap.PixelMap; Font: TYPE = ImagerFont.Font; ConstantColor: TYPE = Imager.ConstantColor; ColorMap: TYPE = PaintPM.ColorMap; ColorSequence: TYPE = PaintPM.ColorSequence; ColorMapEntryList: TYPE = LIST OF ImagerColorMap.MapEntry; PixelBits: TYPE = [2 .. 8]; Direction: TYPE = {forward, backward}; Generator: TYPE = REF GeneratorRep; GeneratorRep: TYPE = RECORD [a, b, c, countLow, countHigh, lastC: CARDINAL]; TextData: TYPE = RECORD [ texts: TextList, numTexts: NAT, totalProbability: REAL]; TextList: TYPE = LIST OF Text; Text: TYPE = RECORD [ text: ROPE, bounds: Imager.Box, cumProb: REAL ]; Control: TYPE = REF ControlPrivate; ControlPrivate: TYPE = RECORD [ shouldGo: BOOL _ FALSE, direction: Direction _ forward, ipSize: REAL--inches-- _ 3.0, wantIP, wantFlip, hold: BOOL _ FALSE, BitsPerPixel: PixelBits _ 4, symmetry: CARDINAL _ 8, periodLow: CARDINAL _ 10000, periodHigh: CARDINAL _ 10000, persistence: CARDINAL _ 5000, halfBMin: INTEGER _ (LAST[CARDINAL]-2000)/2, halfBMax: INTEGER _ (LAST[CARDINAL]-1500)/2, halfCMin: INTEGER _ 0, halfCMax: INTEGER _ (LAST[CARDINAL]-1)/2, upTextMin: Milliseconds _ 10*OneSecond, upTextMax: Milliseconds _ 60*OneSecond, downTextMin: Milliseconds _ 1*OneSecond, downTextMax: Milliseconds _ 6*OneSecond, doText: BOOL _ TRUE, xStateB: Generator _ NEW [GeneratorRep _ [1, 65536-1849, 3, , , ]], xStateE: Generator _ NEW [GeneratorRep], yStateB: Generator _ NEW [GeneratorRep _ [1, 65536-1809, 3, , , ]], yStateE: Generator _ NEW [GeneratorRep], cStateB: Generator _ NEW [GeneratorRep _ [1, 65536-1889, 3, , , ]], cStateE: Generator _ NEW [GeneratorRep], pausePeriod: Process.Ticks _ 0, holdPeriod: Process.Ticks _ Process.MsecToTicks[500], erase: BOOL _ TRUE, runningPriority: Process.Priority _ Process.priorityBackground, AtATime: NAT _ 64, retraces: NAT _ 1 ]; 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 $MakeIP => wantIP _ TRUE; $FlipDirection => wantFlip _ TRUE; $TogglePause => hold _ NOT hold; ENDCASE => {args: LORA = NARROW[key]; shouldGo _ NOT going; IF shouldGo AND OKToGo[] THEN { symmetry _ SELECT args.first FROM $Square => 8, $Hexagon => 12, ENDCASE => ERROR; BitsPerPixel _ SELECT args.rest.first FROM $Bpp8 => 8, $Bpp4 => 4, $Bpp2 => 2, ENDCASE => ERROR; TRUSTED {Process.Detach[FORK Viewit[]]}; }; }; }; StopGoing: ENTRY PROC = {going _ FALSE}; OKToGo: ENTRY PROC RETURNS [go: BOOL] = {IF go _ NOT going THEN going _ TRUE}; 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] --Buttons.ButtonProc-- = { OPEN ctl; symmetry _ SELECT shift FROM FALSE => 8, TRUE => 12, ENDCASE => ERROR; BitsPerPixel _ SELECT mouseButton FROM red => 8, yellow => 4, blue => 4, ENDCASE => ERROR --8--; [] _ IdleBackdoor.UseAlternateVT[vtProc: DoForVT, logout: NOT control]; }; vtContext: Imager.Context; vtPM: PixelMap; curMap: ColorMap _ NIL; curList: ColorMapEntryList _ NIL; GiveVTContext: PROC [to: PROC [context: Imager.Context, pm: PixelMap]] = {to[vtContext, vtPM]}; 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]}; useImagerDitherContext: BOOL _ TRUE; useImagerColorMap: BOOL _ TRUE; VTWork: PROC [vt: Terminal.Virtual, Stop: PROC RETURNS [BOOL]] = { OPEN ctl; 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 _ curList, 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: vtPM.fSize, yp1: vtPM.sSize, bpp: BitsPerPixel, Stop: Stop, vt: vt, entries: curMap]; vt _ vt; }; [vtContext, vtPM] _ StartDeviceAndPM[vt, BitsPerPixel]; [curList, curMap] _ DefineColorMap[BitsPerPixel]; IF useImagerDitherContext THEN ImagerDitherContext.DoWithDitherMap[context: vtContext, mapEntries: curList, action: WithContext] ELSE WithContext[]; }; SampleMap: PROC [bpp: NAT, offset: NAT _ 0] = { square: NAT _ TwoToThe[bpp]; side: NAT _ TwoToThe[bpp/2]; IF bpp # TwoToThe[vtPM.refRep.lgBitsPerPixel] THEN ERROR; FOR s: NAT IN [0 .. vtPM.sSize) DO FOR f: NAT IN [0 .. vtPM.fSize) DO index: NAT _ ((s*side/vtPM.sSize) + (f*side/vtPM.fSize)*side + offset) MOD square; ImagerPixelMap.PutPixel[vtPM, s+vtPM.sMin, f+vtPM.fMin, index]; ENDLOOP; Process.CheckForAbort[]; ENDLOOP; }; upText, downText, T: Milliseconds _ 0; curText: Text; cto: Vector2.VEC; cts: REAL; FloorLog2: PROC [n: CARDINAL] RETURNS [log: INTEGER] = { log _ SELECT n FROM < 1B => ERROR, < 2B => 0, < 4B => 1, < 10B => 2, < 20B => 3, < 40B => 4, < 100B => 5, < 200B => 6, < 400B => 7, < 1000B => 8, < 2000B => 9, < 4000B => 10, < 10000B => 11, < 20000B => 12, < 40000B => 13, < 100000B => 14, ENDCASE => 15}; TwoToThe: ARRAY [0 .. 15] OF CARDINAL = [ 00001H, 00002H, 00004H, 00008H, 00010H, 00020H, 00040H, 00080H, 00100H, 00200H, 00400H, 00800H, 01000H, 02000H, 04000H, 08000H]; Advance: PROC [gen: Generator] = TRUSTED { OPEN ctl; gen.a _ Basics.BITXOR[gen.a + gen.b, gen.b]; IF (gen.countLow _ gen.countLow - 1) = 0 THEN { gen.b _ Basics.BITXOR[gen.b + gen.c, gen.c]; gen.countLow _ periodLow; IF (gen.countHigh _ gen.countHigh - 1) = 0 THEN { rs _ Random.Create[seed: gen.c]; [] _ rs.NextInt[]; gen.lastC _ gen.c; gen.c _ rs.ChooseInt[0, halfCMax]*2+1; gen.countHigh _ periodHigh; }; }; }; Retard: PROC [gen: Generator] = TRUSTED { OPEN ctl; IF gen.countLow = periodLow THEN { IF gen.countHigh = periodHigh THEN { gen.countHigh _ 0; gen.c _ gen.lastC; rs _ Random.Create[seed: gen.c]; [] _ rs.NextInt[]; --actually, we'd like PrevInt, but can't have it... gen.lastC _ rs.ChooseInt[0, halfCMax]*2+1; }; gen.countHigh _ gen.countHigh + 1; gen.countLow _ 0; gen.b _ CARDINAL[Basics.BITXOR[gen.b, gen.c]] - gen.c; }; gen.countLow _ gen.countLow + 1; gen.a _ CARDINAL[Basics.BITXOR[gen.a, gen.b]] - gen.b; }; Dewit: PROC [giveContext: PROC [to: PROC [context: Imager.Context, pm: PixelMap]], xp0, yp0, xp1, yp1, bpp: INTEGER, Stop: PROC RETURNS [BOOL], vt: Terminal.Virtual, entries: ColorMap] = { OPEN ctl; sMin, fMin: INTEGER; --bounds of used area sMid, fMid: INTEGER; --center of used area radius: LONG CARDINAL; --of used area radiusTimesRootThreeQuarters: LONG CARDINAL; max: INTEGER; --maximum z - zmin valMax: LONG CARDINAL _ TwoToThe[bpp] - 1; 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, pm: PixelMap] = { InnerDoit: PROC = { context.SetXY[cto]; context.TranslateT[cto]; context.ScaleT[cts]; context.SetFont[font]; context.ShowRope[curText.text]; }; Imager.DoSave[context, InnerDoit]; }; pmBounds: DeviceBounds; DeviceBounds: TYPE = RECORD [sMin, fMin, sMax, fMax: INTEGER]; Spots: PROC [pm: PixelMap, u, v, val: CARDINAL] _ SELECT symmetry FROM 8 => Spots8, 12 => Spots12, ENDCASE => ERROR; Spots8: PROC [pm: PixelMap, u, v, val: CARDINAL] = TRUSTED { ur: NAT _ Basics.HighHalf[radius*u]; vr: NAT _ Basics.HighHalf[radius*v]; IF ur < vr THEN { cur: NAT _ max - ur; cvr: NAT _ max - vr; ImagerPixelMap.PutPixel[pm, sMin+ vr, fMin+ ur, val]; ImagerPixelMap.PutPixel[pm, sMin+cvr, fMin+ ur, val]; ImagerPixelMap.PutPixel[pm, sMin+ vr, fMin+cur, val]; ImagerPixelMap.PutPixel[pm, sMin+cvr, fMin+cur, val]; ImagerPixelMap.PutPixel[pm, sMin+ ur, fMin+ vr, val]; ImagerPixelMap.PutPixel[pm, sMin+cur, fMin+ vr, val]; ImagerPixelMap.PutPixel[pm, sMin+ ur, fMin+cvr, val]; ImagerPixelMap.PutPixel[pm, sMin+cur, fMin+cvr, val]; }; }; Spots12: PROC [pm: PixelMap, u, v, val: CARDINAL] = TRUSTED { vh: CARDINAL _ Basics.BITSHIFT[v, -1]; ur: NAT _ Basics.HighHalf[radius*u]; vr: NAT _ Basics.HighHalf[radius*vh]; urH: NAT _ Basics.BITSHIFT[ur, -1]; vrH: NAT _ Basics.BITSHIFT[vr, -1]; urRTQ: NAT _ Basics.HighHalf[radiusTimesRootThreeQuarters*u]; vrRTQ: NAT _ Basics.HighHalf[radiusTimesRootThreeQuarters*vh]; IF v < u THEN {OPEN IPME: ImagerPixelMap; IPME.PutPixel[pm, sMid+vrRTQ, fMid+ur - vrH, val]; IPME.PutPixel[pm, sMid+vrRTQ, fMid-ur + vrH, val]; IPME.PutPixel[pm, sMid-vrRTQ, fMid+ur - vrH, val]; IPME.PutPixel[pm, sMid-vrRTQ, fMid-ur + vrH, val]; IPME.PutPixel[pm, sMid+urRTQ - vrRTQ, fMid+urH + vrH, val]; IPME.PutPixel[pm, sMid+urRTQ - vrRTQ, fMid-urH - vrH, val]; IPME.PutPixel[pm, sMid-urRTQ + vrRTQ, fMid+urH + vrH, val]; IPME.PutPixel[pm, sMid-urRTQ + vrRTQ, fMid-urH - vrH, val]; IPME.PutPixel[pm, sMid+urRTQ, fMid+urH - vr, val]; IPME.PutPixel[pm, sMid+urRTQ, fMid-urH + vr, val]; IPME.PutPixel[pm, sMid-urRTQ, fMid+urH - vr, val]; IPME.PutPixel[pm, sMid-urRTQ, fMid-urH + vr, val]; }; }; SetBounds: PROC [pm: PixelMap] = { dr: ImagerPixelMap.DeviceRectangle _ pm.BoundedWindow[]; pmBounds _ [sMin: dr.sMin, fMin: dr.fMin, sMax: dr.sMin + dr.sSize - 1, fMax: dr.fMin + dr.fSize - 1]; }; DrawInit: PROC [context: Imager.Context, pm: PixelMap] = { Imager.SetColor[context, PickColor[context, entries, 0]]; Imager.MaskRectangle[context, [xp0, yp0, xp1 - xp0, yp1 - yp0]]; SetBounds[pm]; FOR i: CARDINAL IN [1 .. persistence] DO Advance[xStateB]; Advance[yStateB]; Advance[cStateB]; Spots[pm, xStateB.a, yStateB.a, Basics.HighHalf[valMax*cStateB.a] + 1]; ENDLOOP; }; DrawFinal: PROC [context: Imager.Context, pm: PixelMap] = { SetBounds[pm]; IF erase THEN FOR i: CARDINAL IN [1 .. persistence] DO Advance[xStateE]; Advance[yStateE]; Advance[cStateE]; Spots[pm, xStateE.a, yStateE.a, 0]; ENDLOOP; }; prevUp: BOOL _ FALSE; DrawDelta: PROC [context: Imager.Context, pm: PixelMap] = { shouldUp: BOOL _ (T >= upText) AND (T < downText); SetBounds[pm]; IF wantIP THEN { ipm: ImagerInterpress.Ref = ImagerInterpress.Create["///ColorKal.ip"]; scale: REAL = ipSize*Imager.metersPerInch/MAX[pm.sSize, pm.fSize]; PaintIt: PROC [context: Imager.Context] = { PaintPM.PaintPixelMap[context, pm, curMap, 0]; }; wantIP _ FALSE; ipm.DoPage[PaintIt, scale]; ipm.Close[]; }; SELECT direction FROM forward => { THROUGH [0 .. AtATime) DO IF erase THEN { Advance[xStateE]; Advance[yStateE]; Advance[cStateE]; Spots[pm, xStateE.a, yStateE.a, 0]; }; Advance[xStateB]; Advance[yStateB]; Advance[cStateB]; Spots[pm, xStateB.a, yStateB.a, Basics.HighHalf[valMax*cStateB.a] + 1]; ENDLOOP; }; backward => { THROUGH [0 .. AtATime) DO Spots[pm, xStateB.a, yStateB.a, 0]; Retard[xStateB]; Retard[yStateB]; Retard[cStateB]; IF erase THEN { Spots[pm, xStateE.a, yStateE.a, Basics.HighHalf[valMax*cStateE.a] + 1]; Retard[xStateE]; Retard[yStateE]; Retard[cStateE]; }; ENDLOOP; }; ENDCASE => ERROR; IF doText AND shouldUp # prevUp THEN { index: NAT _ rs.ChooseInt[1, entries.length-1]; Imager.SetColor[context, PickColor[context, entries, IF shouldUp THEN index ELSE 0]]; DrawText[context, pm]; prevUp _ shouldUp; }; IF T >= downText THEN PickText[T]; }; oldP: BasicTime.Pulses; SELECT symmetry FROM 8 => radius _ MIN[xp1 - xp0, yp1 - yp0]/2; 12 => radius _ MIN[xp1 - xp0, Real.FixC[(yp1 - yp0)/Root3Quarters]]/2; ENDCASE => ERROR; max _ radius*2 - 1; sMin _ yp0 + (yp1 - yp0 - (max+1))/2; fMin _ xp0 + (xp1 - xp0 - (max+1))/2; sMid _ (yp0 + yp1)/2; fMid _ (xp0 + xp1)/2; radiusTimesRootThreeQuarters _ Real.RoundC[Root3Quarters*radius]; PickText[T _ 0]; RandomizeB[]; xStateB.countLow _ periodLow; yStateB.countLow _ periodLow; cStateB.countLow _ periodLow; xStateB.countHigh _ periodHigh; yStateB.countHigh _ periodHigh; cStateB.countHigh _ periodHigh; xStateE^ _ xStateB^; yStateE^ _ yStateB^; cStateE^ _ cStateB^; giveContext[DrawInit]; oldP _ BasicTime.GetClockPulses[]; FOR i: INT _ 0, i+1 WHILE NOT Stop[] DO newP: BasicTime.Pulses; IF wantFlip THEN { direction _ SELECT direction FROM forward => backward, backward => forward, ENDCASE => ERROR; wantFlip _ FALSE; }; 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; giveContext[DrawFinal]; }; PickColor: PROC [context: Imager.Context, entries: ColorMap, index: NAT] RETURNS [color: ConstantColor] = { color _ entries[index]; }; StartDeviceAndPM: PROC [vt: Terminal.Virtual, bpp: INT] RETURNS [context: Imager.Context, pm: PixelMap] = { OPEN ctl; fb: Terminal.FrameBuffer; <> <> <> <> <<2 => $Std2bpp,>> <<4 => $Std4bpp,>> <<8 => $Std8bpp,>> < ERROR];>> <> <

> <> <> <> 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[]; pm _ FbPm[fb]; }; profiledDisplayType: ColorDisplayFace.ColorDisplayType; FbPm: PROC [fb: Terminal.FrameBuffer] RETURNS [pm: PixelMap] = { pm _ [ sOrigin: 0, fOrigin: 0, sMin: 0, fMin: 0, sSize: fb.height, fSize: fb.width, refRep: NEW [ImagerPixelMap.PixelMapRep _ [ ref: fb.vm, pointer: fb.base, words: fb.vm.words, lgBitsPerPixel: FloorLog2[fb.bitsPerPixel], rast: fb.wordsPerLine, lines: fb.height]] ]; IF fb.bitsPerPixel # TwoToThe[pm.refRep.lgBitsPerPixel] THEN ERROR; }; DefineColorMap: PROC [bpp: PixelBits] RETURNS [list: ColorMapEntryList, seq: ColorMap] = { OPEN ctl; length: NAT = TwoToThe[bpp]; IF (cmLists[bpp] = NIL) # (cmSeqs[bpp] = NIL) THEN ERROR; IF cmLists[bpp] # NIL THEN RETURN [cmLists[bpp], cmSeqs[bpp]]; seq _ MakeEntries[length]; list _ NIL; FOR i: INT IN [0 .. length) DO rgb: ImagerColor.RGB _ MapRound[i, bpp]; list _ CONS [ [ mapIndex: i, red: Floor[rgb.R*255.99], green: Floor[rgb.G*255.99], blue: Floor[rgb.B*255.99] ], list ]; seq[i] _ ImagerColor.ColorFromRGB[rgb, cal]; ENDLOOP; cmLists[bpp] _ list; cmSeqs[bpp] _ seq; }; cal: ImagerColor.RGBCalibration _ ImagerColor.GetDefaultCalibration[]; cmLists: ARRAY PixelBits OF ColorMapEntryList _ ALL[NIL]; cmSeqs: ARRAY PixelBits OF ColorMap _ ALL[NIL]; <> <> <> <> <> <> <> <> <> <> <> <<];>> <> <> <<};>> FixC: PROC [r: REAL] RETURNS [c: CARDINAL] = {c _ Real.FixC[r]}; MapRound: PROC [i, bpp: NAT] RETURNS [rgb: ImagerColor.RGB] = { last: NAT _ TwoToThe[bpp]-1; SELECT i FROM = 000 => rgb _ [0, 0, 0]; <= last => rgb _ ImagerColor.RGBFromHSV[[H: (i-1.0)/last, S: 1, V: 1]]; ENDCASE => ERROR}; MapCopy: PROC [i, bpp: NAT] RETURNS [c: ConstantColor] = { c _ fromMap[i]; }; fromMap: ColorMap _ NIL; MakeEntries: PROC [length: NAT] RETURNS [entries: ColorMap] = {entries _ NEW[ColorSequence[length]]}; 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, "", 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[ [LIST[$Square, $Bpp8], "Start/stop with 8-fold symmetry, 8 bits per pixel"], [LIST[$Square, $Bpp4], "Start/stop with 8-fold symmetry, 4 bits per pixel"], [LIST[$Square, $Bpp2], "Start/stop with 8-fold symmetry, 4 bits per pixel"], [LIST[$Hexagon, $Bpp8], "Start/stop with 12-fold symmetry, 8 bits per pixel"], [LIST[$Hexagon, $Bpp4], "Start/stop with 12-fold symmetry, 4 bits per pixel"], [LIST[$Hexagon, $Bpp2], "Start/stop with 12-fold symmetry, 4 bits per pixel"], [$MakeIP, "Write []<>ColorKal.ip"], [$FlipDirection, "Reverse direction"], [$TogglePause, "Pause or continue"] ], doc: "Color pixel kaleidoscope control" ]] .Instantiate[viewerInfo: [name: "cKal", column: static]]; }; ctlButton: Viewer _ NIL; RandomizeB: PROC = { OPEN ctl; DO xStateB.b _ rs.ChooseInt[halfBMin, halfBMax]*2 + 1; yStateB.b _ rs.ChooseInt[halfBMin, halfBMax]*2 + 1; cStateB.b _ rs.ChooseInt[halfBMin, halfBMax]*2 + 1; IF xStateB.b # yStateB.b AND cStateB.b # yStateB.b AND xStateB.b # cStateB.b THEN EXIT; ENDLOOP; }; RandomizeC: PROC = { OPEN ctl; xStateB.c _ rs.ChooseInt[halfCMin, halfCMax]*2 + 1; yStateB.c _ rs.ChooseInt[halfCMin, halfCMax]*2 + 1; cStateB.c _ rs.ChooseInt[halfCMin, halfCMax]*2 + 1; }; 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 = { UserProfile.CallWhenProfileChanges[NoteProfile]; font _ ImagerFont.Find["Xerox/PressFonts/TimesRoman-MRR"]; td _ ReadTextData["Kal.texts"]; CreateButton[]; }; Start[]; }.