<> <> <> <> DIRECTORY Ascii USING [CR], Buttons, Containers, Imager, ImagerBackdoor, ImagerFont, Labels USING [Create], LookerDefs USING [DoAction, InputAction, NewPriority, ShowBroadcast], PrincOpsUtils USING [LongCopy], Process USING [Detach, Priority, priorityBackground, priorityNormal], Rope USING [ROPE], VFonts USING [EstablishFont], ViewerClasses, ViewerOps, ViewerTools; FunnyDisplay: MONITOR IMPORTS Buttons, Containers, Imager, ImagerBackdoor, ImagerFont, Labels, LookerDefs, PrincOpsUtils, Process, VFonts, ViewerOps, ViewerTools EXPORTS LookerDefs = { font: ImagerFont.Font = VFonts.EstablishFont["Helvetica",8]; fontAscent: REAL _ ImagerFont.FontBoundingBox[font].ascent; fontDescent: REAL _ ImagerFont.FontBoundingBox[font].descent; fontSpace: REAL _ fontAscent+fontDescent; topPos: REAL = fontAscent; myViewer: ViewerClasses.Viewer; pause, fast, slow, hostText, bYes, bNo, normal, back, small, big: ViewerClasses.Viewer; line: REF TEXT = NEW[TEXT[600]]; xPos: REAL _ 0.0; yPos: REAL _ topPos; -- offset from top of text area -- DisplayChar: PUBLIC PROC [c: CHAR] = { IF c = Ascii.CR THEN { SendNow[]; xPos _ 0.0; yPos _ yPos + fontSpace; } ELSE { line[line.length] _ c; line.length _ line.length+1 }; }; DisplayMultiple: PUBLIC PROC [desc: LONG DESCRIPTOR FOR PACKED ARRAY OF CHAR] = { amount: CARDINAL = MIN[line.maxLength-line.length, LENGTH[desc]]; IF line.length MOD 2 = 0 THEN PrincOpsUtils.LongCopy[from: BASE[desc], to: LOOPHOLE[line,LONG POINTER]+SIZE[TEXT[0]]+line.length/2, nwords: (amount+1)/2] ELSE FOR i: CARDINAL IN [0..amount) DO line[line.length+i] _ desc[i] ENDLOOP; line.length _ line.length + amount; }; GetLength: PUBLIC PROC [r: Rope.ROPE] RETURNS [length: REAL] = { RETURN[ImagerFont.RopeWidth[font, r].x] }; SetPos: PUBLIC PROC [pos: REAL] = { SendNow[]; xPos _ pos; }; SendNow: PUBLIC PROC = { ViewerOps.PaintViewer[myViewer, client, FALSE, line]; line.length _ 0; }; Clear: PUBLIC PROC = { ViewerOps.PaintViewer[myViewer, client, FALSE, $Clear]; }; WriteTitle: PUBLIC PROC [r: Rope.ROPE] = { myViewer.parent.name _ r; ViewerOps.PaintViewer[myViewer.parent, caption, FALSE, NIL]; }; myClass: ViewerClasses.ViewerClass = NEW[ViewerClasses.ViewerClassRec _[ paint: MyPaint, destroy: MyDestroy, icon: tool]]; screenLines: CARDINAL _ 0; ScreenLines: PUBLIC ENTRY PROC RETURNS [CARDINAL] = { RETURN[screenLines]; }; MyPaint: ENTRY ViewerClasses.PaintProc = TRUSTED { <> bounds: Imager.Rectangle = ImagerBackdoor.GetBounds[context]; box: Imager.Box _ [xmin: bounds.x, xmax: bounds.x+bounds.w, ymin: bounds.y, ymax: bounds.y+bounds.h]; IF whatChanged = NIL THEN { yPos _ topPos; screenLines _ 0; { tempY: REAL _ topPos; WHILE box.ymax - tempY - fontDescent >= box.ymin DO screenLines _ screenLines+1; tempY _ tempY + fontSpace; ENDLOOP; }; RETURN }; WITH whatChanged SELECT FROM text: REF TEXT => { IF box.ymax - yPos - fontDescent < box.ymin THEN yPos _ topPos; IF xPos = 0.0 THEN { <> yBase: REAL = IF box.ymax - yPos - fontDescent - fontSpace < box.ymin THEN topPos ELSE yPos + fontSpace; Imager.SetColor[context, Imager.white]; Imager.MaskBox[context, [ xmin: box.xmin, ymin: box.ymax - yBase - fontDescent, xmax: box.xmax, ymax: box.ymax - yBase + fontAscent]]; Imager.SetColor[context, Imager.black]; }; Imager.SetXY[context, [box.xmin + xPos, box.ymax - yPos]]; Imager.SetFont[context, font]; FOR i: NAT IN [0..text.length) DO < \177 to be that character, to avoid problems with potentially small fonts for our printing.>> IF text[i] > '\177 THEN text[i] _ '\177; ENDLOOP; Imager.ShowText[context, text]; xPos _ ImagerBackdoor.GetCP[context].x - box.xmin; }; x: ATOM => SELECT x FROM $Clear => { Imager.SetColor[context, Imager.white]; Imager.MaskBox[context, [xmin: box.xmin, ymin: box.ymin, xmax: box.xmax, ymax: box.ymax - topPos + fontAscent]]; xPos _ 0.0; yPos _ topPos; }; ENDCASE => NULL; ENDCASE => NULL; }; MyDestroy: ViewerClasses.DestroyProc = TRUSTED { <> Process.Detach[FORK LookerDefs.DoAction[[stop[]]]]; }; active: ATOM = $WhiteOnBlack; Create: PROC RETURNS [text: ViewerClasses.Viewer] = { <> outer: ViewerClasses.Viewer = Containers.Create[ info: [name: "Pupwatch", column: right, scrollable: FALSE, iconic: TRUE]]; child: ViewerClasses.Viewer _ CreateChildren[outer]; Buttons.SetDisplayStyle[fast, active, FALSE]; Buttons.SetDisplayStyle[back, active, FALSE]; Buttons.SetDisplayStyle[bNo, active, FALSE]; Buttons.SetDisplayStyle[small, active, FALSE]; text _ ViewerOps.CreateViewer[ flavor: $Pupwatch, info: [parent: outer, scrollable: FALSE, border: FALSE, wx: 2, wy: child.wy + child.wh + 2]]; Containers.ChildXBound[outer, text]; Containers.ChildYBound[outer, text]; }; CreateChildren: PROC [v: ViewerClasses.Viewer] RETURNS [child: ViewerClasses.Viewer] = { InputButton: PROC [name: Rope.ROPE, action: LookerDefs.InputAction] = { child _ Buttons.Create[ info: [name: name, parent: v, border: TRUE, wx: IF child = NIL THEN 2 ELSE 2+child.wx+child.ww, wy: IF child = NIL THEN 1 ELSE child.wy], proc: DoSimpleAction, clientData: NEW[LookerDefs.InputAction _ action], fork: TRUE]; }; SimpleLabel: PROC [name: Rope.ROPE, newLine: BOOL _ FALSE] = { child _ Labels.Create[ info: [name: name, parent: v, border: FALSE, wx: IF newLine THEN 2 ELSE 2+child.wx+child.ww, wy: IF newLine THEN child.wy + child.wh + 2 ELSE child.wy]]; }; SimpleButton: PROC [name: Rope.ROPE, proc: Buttons.ButtonProc, newLine: BOOL _ FALSE, border: BOOL _ TRUE] RETURNS [ViewerClasses.Viewer] = { child _ Buttons.Create[ info: [name: name, parent: v, border: border, wx: IF newLine THEN 2 ELSE 2+child.wx+child.ww, wy: IF newLine THEN child.wy + child.wh + 2 ELSE child.wy], proc: proc, fork: TRUE]; RETURN [child]; }; child _ NIL; InputButton["Continue", [pauseContinue[]]]; pause _ child; InputButton["Fast", [fast[]]]; fast _ child; InputButton["Slow", [slow[]]]; slow _ child; InputButton["Replay", [replay[]]]; InputButton["Write log", [writeLog[]]]; [] _ SimpleButton["New host", DoHost]; [] _ SimpleButton[" Host: ", DoHostPrompt, FALSE, TRUE]; hostText _ ViewerTools.MakeNewTextViewer[ info: [parent: v, scrollable: FALSE, border: FALSE, wx: 2+child.wx+child.ww, wy: child.wy, ww: v.cw-(2+child.wx+child.ww), wh: child.wh]]; Containers.ChildXBound[v, hostText]; SimpleLabel["Broadcasts:", TRUE]; bYes _ SimpleButton["yes", DoBroadcast]; bNo _ SimpleButton["no", DoBroadcast]; SimpleLabel["Priority:"]; normal _ SimpleButton["normal", DoPriority]; back _ SimpleButton["background", DoPriority]; SimpleLabel["PktSize:"]; small _ SimpleButton["small", DoSize]; big _ SimpleButton["big", DoSize]; }; NotePausing: PUBLIC ENTRY PROC [nowPausing: BOOL] = { Buttons.ReLabel[pause, IF nowPausing THEN "Continue" ELSE "Pause"]; }; DoSimpleAction: Buttons.ButtonProc = TRUSTED { <> LookerDefs.DoAction[NARROW[clientData, REF LookerDefs.InputAction]^]; }; isSlow: BOOL _ FALSE; NoteSlow: PUBLIC ENTRY PROC [nowSlow: BOOL] = { Buttons.SetDisplayStyle[IF isSlow THEN slow ELSE fast, $BlackOnWhite]; isSlow _ nowSlow; Buttons.SetDisplayStyle[IF isSlow THEN slow ELSE fast, active]; }; DoHost: Buttons.ButtonProc = TRUSTED { <> LookerDefs.DoAction[[newHost[ViewerTools.GetContents[hostText]]]]; }; DoHostPrompt: Buttons.ButtonProc = TRUSTED { <> text: ViewerClasses.Viewer = hostText; SELECT mouseButton FROM red => ViewerTools.SetSelection[text, NIL]; blue => { ViewerTools.SetContents[text, NIL]; ViewerTools.SetSelection[text, NIL] }; yellow => NULL; ENDCASE => ERROR; }; DoBroadcast: Buttons.ButtonProc = TRUSTED { <> viewer: Buttons.Button = NARROW[parent]; Buttons.SetDisplayStyle[bYes, IF viewer = bYes THEN active ELSE $BlackOnWhite]; Buttons.SetDisplayStyle[bNo, IF viewer = bNo THEN active ELSE $BlackOnWhite]; LookerDefs.ShowBroadcast[viewer = bYes]; }; DoPriority: Buttons.ButtonProc = TRUSTED { <> viewer: Buttons.Button = NARROW[parent]; Buttons.SetDisplayStyle[normal, IF viewer = normal THEN active ELSE $BlackOnWhite]; Buttons.SetDisplayStyle[back, IF viewer = back THEN active ELSE $BlackOnWhite]; LookerDefs.NewPriority[IF viewer = normal THEN Process.priorityNormal ELSE Process.priorityBackground]; }; DoSize: Buttons.ButtonProc = TRUSTED { <> viewer: Buttons.Button = NARROW[parent]; Buttons.SetDisplayStyle[small, IF viewer = small THEN active ELSE $BlackOnWhite]; Buttons.SetDisplayStyle[big, IF viewer = big THEN active ELSE $BlackOnWhite]; LookerDefs.DoAction[[pktSize[big: viewer = big]]]; }; ViewerOps.RegisterViewerClass[$Pupwatch, myClass]; myViewer _ Create[]; LookerDefs.DoAction[[start[]]]; }.