Copyright (C) 1994, Digital Equipment Corp. MODULE; IMPORT DisplayList, DisplayListStack, DPS, DPSWindow, FileWr, Linked2Tree, PopupMenuDLE, Rd, SlideLineDLE, Text, Fmt, TextRd, TextWr, Thread, TranslateDLE, Wr, OSError; CONST AllowTranslation = TRUE; CONST millisecond = 0.001d0; CONST second = 1.0d0; CONST pointsDefault = 24.0; CONST aboveLeadingDefault = 8.0; CONST heightDefault = pointsDefault; CONST belowLeadingDefault = 0.0; OneSlideDLE
CONST lowLeadingDefault = 0.0;
CONST leftLeadingDefault = 24.0; CONST pointsDefaultTop = 30.0; CONST aboveLeadingDefaultTop = 8.0; CONST heightDefaultTop = pointsDefaultTop; CONST belowLeadingDefaultTop = 16.0; CONST leftLeadingDefaultTop = 0.0; CONST TopMargin = 32.0; CONST LeftMarginOfLines = 60.0; (* Alas has to factor in the boilerplate. *)CONST ItemsInitiallyVisible = 1; Cannot be zero. Need to start stack.
CONST DecorationMarginLeft = 20.0; CONST DecorationMarginRight = 20.0; CONST DecorationMarginTop = 20.0; CONST DecorationMarginBottom = 40.0;
^^ Because bottom of screen hard to see.
CONST backgroundPostScript = " 20.0 ButtonDLEDrawRoundedPath 6.0 setlinewidth 0.5 0.5 0.5 setrgbcolor stroke "; PROCEDUREBoxFromXYWH (x, y: REAL; w, h: REAL := 0.0): DPS.Box = VAR box: DPS.Box; BEGIN box.low.x := x; box.high.x := x + w; box.low.y := y; box.high.y := y + h; RETURN box; END BoxFromXYWH; PROCEDURERepaint (t: T; box: DPS.Box; only: REFANY): TEXT = VAR bkgBox: DPS.Box; BEGIN bkgBox.low.x := t.box.low.x + DecorationMarginLeft; bkgBox.high.x := t.box.high.x - DecorationMarginRight; bkgBox.low.y := t.box.low.y + DecorationMarginBottom; bkgBox.high.y := t.box.high.y - DecorationMarginTop; RETURN DPS.GSaveAndClip(box) & " gsave " & DPS.BoxCoordsAsText (bkgBox) & " 20.0 ButtonDLEDrawRoundedPath clip " & DisplayList.Repaint (t, box, only) & " grestore " & DPS.BoxCoordsAsText (bkgBox) & backgroundPostScript & DPS.GRestore(); END Repaint; PROCEDUREClip (e: E; text: TEXT): TEXT = VAR bkgBox: DPS.Box; BEGIN bkgBox.low.x := e.box.low.x + DecorationMarginLeft; bkgBox.high.x := e.box.high.x - DecorationMarginRight; bkgBox.low.y := e.box.low.y + DecorationMarginBottom; bkgBox.high.y := e.box.high.y - DecorationMarginTop; RETURN " gsave " & DPS.BoxCoordsAsText (bkgBox) & " 20.0 ButtonDLEDrawRoundedPath clip " & text & " grestore "; END Clip; PROCEDUREPostScriptToParentClipped (e: E; script: TEXT) = VAR p: DisplayList.T; BEGIN p := e.parent; IF p # NIL THEN p.ImmediatePostScript (Clip (e, script)); END; END PostScriptToParentClipped; PROCEDUREDirtyToParentClipped (e: E; box: DPS.Box; only: DisplayList.T := NIL) = VAR p: DisplayList.T; BEGIN p := e.parent; IF p # NIL THEN p.Dirty (box, only); END; END DirtyToParentClipped; PROCEDUREInit (t: T; window: DPSWindow.T; content: Rd.T := NIL) = BEGIN IF t.initialized THEN RETURN; END; (* Later compute based on content: *) t.box.low.y := t.box.high.y - t.maximumHeight; t.window := window; (* Used in capturing PostSCript. *) t.backgroundPopup := NEW ( PopupMenuDLE.T, items := NEW (REF ARRAY OF PopupMenuDLE.Item, 5) ); t.backgroundPopup.items^[0] := NEW ( PopupMenuDLE.Item, text := "All Invisible", Proc := AllInvisiblePop, context := t ); t.backgroundPopup.items^[1] := NEW ( PopupMenuDLE.Item, text := "Next Visible", Proc := NextVisiblePop, context := t ); t.backgroundPopup.items^[2] := NEW (PopupMenuDLE.Item, text := "All Visible", Proc := AllVisiblePop, context := t); t.backgroundPopup.items^[3] := NEW (PopupMenuDLE.Item, text := "Toggle Mouse -> Child", Proc := ToggleMouseChildPop, context := t); t.backgroundPopup.items^[4] := NEW (PopupMenuDLE.Item, text := "PostScript -> /tmp/slide.ps", Proc := PSPop, context := t); t.initialized := TRUE; window.SendFoundation ( " /ButtonDLEDrawRoundedPath " & " { /r exch def /highy exch def /highx exch def " & " /lowy exch def /lowx exch def " & " newpath lowx lowy r add moveto " & " lowx r add highy r sub r 180 90 arcn " & " highx r sub highy r sub r 90 0 arcn " & " highx r sub lowy r add r 0 270 arcn " & " lowx r add lowy r add r 270 180 arcn " & " closepath } def " ); IF content # NIL THEN AddContent (t, window, content); END; END Init; PROCEDURERdDotGetLine (r: Rd.T): TEXT RAISES {Rd.EndOfFile} =
Rd.GetLine is buggy. 21aug91
<*FATAL Rd.Failure, Thread.Alerted*> VAR c: CHAR; VAR line: TEXT := ""; BEGIN c := Rd.GetChar(r); (* Initial EOF propogates. *) IF c = '\n' THEN RETURN line; END; line := line & Text.FromChar (c); WHILE NOT Rd.EOF(r) DO c := Rd.GetChar(r); IF c = '\n' THEN RETURN line; END; line := line & Text.FromChar (c); END; RETURN line; END RdDotGetLine; PROCEDURE******** PROCEDURE Key (t: T; window: DPSWindow.T; event: DPS.KeyEvent) = VAR got: CHAR; VAR e: DisplayList.E; BEGIN Init (t, window); got := DPS.CharFromKey (event.key, event.modifiers); IF got = '\000' THEN RETURN; END; e := t.Last(); WHILE e # NIL DO IF e.Char (window, got) THEN RETURN; END; e := e.Previous(); END; Err.Msg (AddContent ( t: T; window: DPSWindow.T; data: Rd.T ) = VAR sle: SlideLineDLE.E; VAR line: TEXT; VAR itemIndex: INTEGER := 0; VAR invisible, newInvisible: BOOLEAN := FALSE; VAR xlate: TranslateDLE.T; VAR appendTo: DisplayList.T; BEGIN Init (t, window); t.fixed := NEW (DisplayList.T); t.visible := NEW ( DisplayListStack.T, MakeChildFirst := MakeChildFirstNOP, MakeChildLast := MakeChildLastNOP ); t.invisible := NEW (Linked2Tree.T); IF AllowTranslation THEN xlate := NEW ( TranslateDLE.T, translationX := 0.0, translationY := 0.0, fixedX := TRUE, onlyIfShifted := FALSE ); Linked2Tree.Append (t, xlate); appendTo := xlate; ELSE appendTo := t; END; Linked2Tree.Append (appendTo, t.fixed); Linked2Tree.Append (appendTo, t.visible); LOOP TRY line := RdDotGetLine (data); IF Text.Equal ("/invisible", Text.Sub(line,0,10)) THEN invisible := TRUE; newInvisible := TRUE; IF sle # NIL THEN sle.togetherWithNext := FALSE; END; ELSIF Text.Equal ("/half", Text.Sub(line,0,5)) THEN sle := NEW ( SlideLineDLE.E, box := BoxFromXYWH (LeftMarginOfLines, 0.0, 0.0, 0.0), typefacePoints := pointsDefault, aboveLeading := aboveLeadingDefault, height := heightDefault / 2.0, belowLeading := belowLeadingDefault, leftLeading := leftLeadingDefault, text := " ", togetherWithNext := TRUE ); newInvisible := FALSE; SlideLineDLE.Init (sle, window); IF NOT invisible THEN t.visible.Append (sle); ELSE t.invisible.Append (sle); END; INC (itemIndex); ELSIF itemIndex < 1 THEN sle := NEW ( SlideLineDLE.E, box := BoxFromXYWH (LeftMarginOfLines, 0.0, 0.0, 0.0), typefacePoints := pointsDefaultTop, aboveLeading := aboveLeadingDefaultTop, height := heightDefaultTop, belowLeading := belowLeadingDefaultTop, leftLeading := leftLeadingDefaultTop, text := ConvertOctals(line), togetherWithNext := TRUE ); newInvisible := FALSE; SlideLineDLE.Init (sle, window); IF NOT invisible THEN t.visible.Append (sle); ELSE t.invisible.Append (sle); END; INC (itemIndex); ELSE sle := NEW ( SlideLineDLE.E, box := BoxFromXYWH (LeftMarginOfLines, 0.0, 0.0, 0.0), typefacePoints := pointsDefault, aboveLeading := aboveLeadingDefault, height := heightDefault, belowLeading := belowLeadingDefault, leftLeading := leftLeadingDefault, text := ConvertOctals(line), togetherWithNext := TRUE ); newInvisible := FALSE; SlideLineDLE.Init (sle, window); IF NOT invisible THEN t.visible.Append (sle); ELSE t.invisible.Append (sle); END; INC (itemIndex); END; EXCEPT Rd.EndOfFile => EXIT; END; END; t.visible.Stack (t.box.high.y - TopMargin - pointsDefault); END AddContent; PROCEDUREConvertOctals (t: TEXT): TEXT = <*FATAL Rd.Failure, Wr.Failure, Thread.Alerted*> VAR j: INTEGER; VAR rd: Rd.T; VAR wr: Wr.T; VAR c, o1, o2, o3: CHAR; BEGIN j := Text.FindChar (t,'\\'); rd := TextRd.New (t); wr := TextWr.New(); LOOP TRY c := Rd.GetChar (rd); IF c = '\\' THEN o1 := Rd.GetChar (rd); o2 := Rd.GetChar (rd); o3 := Rd.GetChar (rd); j := (ORD(o1)-48) * 64 + (ORD(o2)-48) * 8 + (ORD(o3)-48); j := MIN (j, 255); j := MAX (0, j); c := VAL (j, CHAR); END; Wr.PutChar (wr, c); EXCEPT Rd.EndOfFile => RETURN TextWr.ToText(wr); END; END; END ConvertOctals; PROCEDUREPrepend (t: T; e: Linked2Tree.E) = BEGIN Init (t, NIL); t.fixed.Prepend (e); END Prepend; PROCEDUREAppend (t: T; e: Linked2Tree.E) = BEGIN Init (t, NIL); AppendVariable (t, e); END Append; PROCEDUREAppendFixed (t: T; e: Linked2Tree.E) = BEGIN Init (t, NIL); t.fixed.Append (e); END AppendFixed; PROCEDUREAppendVariable (t: T; e: Linked2Tree.E) = BEGIN t.visible.Append (e); t.visible.Stack (t.box.high.y - TopMargin - pointsDefault); END AppendVariable; PROCEDUREInsertBefore (t: T; e, before: Linked2Tree.E) = BEGIN Init (t, NIL); t.visible.InsertBefore (e, before); END InsertBefore; PROCEDUREInsertAfter (t: T; e, after: Linked2Tree.E) = BEGIN Init (t, NIL); t.visible.InsertAfter (e, after); END InsertAfter; PROCEDUREPSPop (p: PopupMenuDLE.Item) = <*FATAL OSError.E, Wr.Failure, Thread.Alerted*> VAR t: T; VAR wr: Wr.T; BEGIN t := NARROW (p.context, T); wr := FileWr.Open ("/tmp/slide.ps"); Wr.PutText (wr, "%!IPS-Adobe-1.0\n"); Wr.PutText (wr, "%%Creator: Postscript Button in SlideX\n"); Wr.PutText (wr, "%%Title: Client Slides\n"); Wr.PutText (wr, "%%EndComments\n"); Wr.PutText (wr, "%%EndProlog\n\n"); AllVisible (t); DPS.PostscriptToWriter (t.window, wr); Wr.PutText (wr, "\nshowpage\n\n"); Wr.PutText (wr, "%%Trailer\n\n"); Wr.Close(wr); END PSPop; PROCEDUREToggleMouseChildPop (p: PopupMenuDLE.Item) = VAR t: T; BEGIN t := NARROW (p.context, T); t.canMouseChildren := NOT t.canMouseChildren; END ToggleMouseChildPop; PROCEDUREAllInvisiblePop (p: PopupMenuDLE.Item) = BEGIN AllInvisible (NARROW(p.context, T)); END AllInvisiblePop; PROCEDURENextVisiblePop (p: PopupMenuDLE.Item) = BEGIN NextVisible (NARROW(p.context, T)); END NextVisiblePop; PROCEDUREAllVisiblePop (p: PopupMenuDLE.Item) = BEGIN AllVisible (NARROW(p.context, T)); END AllVisiblePop; PROCEDUREAllInvisible (t: T) = VAR cur: DisplayList.E; BEGIN t.LoseInputFocus(); (* Have to kill input focus of anything moving to invisible list. *) LOOP cur := t.visible.First(); IF cur = NIL THEN EXIT; END; cur.Remove (); t.invisible.Append (cur); END; t.Dirty (t.box, NIL); END AllInvisible; PROCEDURENextVisible (t: T) = VAR cur: DisplayList.E; BEGIN LOOP cur := t.invisible.First(); IF cur = NIL THEN RETURN; END; cur.Remove (); t.visible.Append (cur); TYPECASE cur OF | SlideLineDLE.E (sle) => Reappear (sle); IF NOT sle.togetherWithNext THEN EXIT; END; ELSE cur.Dirty (cur.box, cur); EXIT; END; END; END NextVisible; PROCEDURENextSomething (t: T): BOOLEAN = BEGIN IF t.invisible.First() # NIL THEN NextVisible (t); RETURN TRUE; ELSE RETURN FALSE; END; END NextSomething; PROCEDUREAllVisible (t: T) = VAR cur: DisplayList.E; BEGIN LOOP cur := t.invisible.First(); IF cur = NIL THEN RETURN; END; cur.Remove (); t.visible.Append (cur); TYPECASE cur OF | SlideLineDLE.E (sle) => Reappear (sle); ELSE cur.Dirty (cur.box, cur); END; END; END AllVisible; PROCEDURENthVisible (t: T; n: INTEGER): DisplayList.T = VAR cur: DisplayList.E; BEGIN cur := t.visible.First(); WHILE n > 0 DO IF cur = NIL THEN RETURN NIL; END; cur := cur.Next(); DEC (n); END; RETURN cur; END NthVisible; TYPE RepaintClosure = Thread.Closure OBJECT item: SlideLineDLE.E; END; PROCEDURERepaintNormallyAFterPause (rc: RepaintClosure): REFANY RAISES {} = BEGIN Thread.Pause (2.0d0 * second); rc.item.Dirty (rc.item.box, rc.item); RETURN NIL; END RepaintNormallyAFterPause; PROCEDUREReappear (item: SlideLineDLE.E) = CONST wait = 100.0d0 * millisecond; CONST delta = 0.167; VAR r, g, b: REAL; VAR ps: TEXT; PROCEDURE DownRed () = BEGIN r := MAX (0.0, r - delta); item.ImmediatePostScript ( " " & Fmt.Real(r) & " " & Fmt.Real(g) & " " & Fmt.Real(b) & " setrgbcolor " & ps ); Thread.Pause (wait); END DownRed; PROCEDURE DownGB () = BEGIN g := MAX (0.0, g - delta); b := MAX (0.0, b - delta); item.ImmediatePostScript ( " " & Fmt.Real(r) & " " & Fmt.Real(g) & " " & Fmt.Real(b) & " setrgbcolor " & ps ); Thread.Pause (wait); END DownGB; BEGIN ps := item.Repaint (item.box, item); (* May not really be on top, but we lie in the Dirty/Repaint calls. *) (* If really obscured, the repaints would look ugly any way. *) r := 1.0; g := 1.0; b := 1.0; WHILE g > 0.0 DO DownGB(); END; WHILE r > 0.0 DO DownRed(); END; item.ImmediatePostScript ( " 0.0 0.0 0.0 setrgbcolor " ); (* EVAL Thread.Fork ( NEW ( RepaintClosure, apply := RepaintNormallyAFterPause, item := item ) ); *) END Reappear; PROCEDUREMakeChildFirst (<*UNUSED*> t: T; <*UNUSED*> e: Linked2Tree.E): Linked2Tree.E = BEGIN RETURN NIL; (* RETURN Linked2Tree.MakeChildFirst (t.visible, e); *) END MakeChildFirst; PROCEDUREMakeChildLast (<*UNUSED*> t: T; <*UNUSED*> e: Linked2Tree.E): Linked2Tree.E = BEGIN RETURN NIL; (* RETURN Linked2Tree.MakeChildLast (t.visible, e); *) END MakeChildLast; PROCEDUREMakeChildFirstNOP (<*UNUSED*> t: Linked2Tree.T; <*UNUSED*> e: Linked2Tree.E): Linked2Tree.E = BEGIN RETURN NIL; END MakeChildFirstNOP; PROCEDUREMakeChildLastNOP (<*UNUSED*> t: Linked2Tree.T; <*UNUSED*> e: Linked2Tree.E): Linked2Tree.E = BEGIN RETURN NIL; END MakeChildLastNOP; PROCEDUREMouse (t: T; window: DPSWindow.T; event: DPS.MouseEvent): BOOLEAN = VAR e: DisplayList.E; BEGIN Init (t, window); CASE event.whatChanged OF | DPS.Button.Left => IF event.clickType=DPS.ClickType.FirstDown THEN t.GetInputFocus (); END; | DPS.Button.Middle => | DPS.Button.Right => END; (* of CASE *) IF (event.whatChanged = DPS.Button.Right) (* For imbedded translator. *) OR t.canMouseChildren THEN e := t.Last(); WHILE e # NIL DO IF e.Mouse (window, event) THEN RETURN TRUE; END; e := e.Previous(); END; END; IF event.clickType # DPS.ClickType.FirstDown THEN RETURN FALSE; END; (* Used to allow user to highlight by pointing. *) (* But that "cheated" by looking at boxes of children, *) (* which may be bogus due to intermediate translation. *) CASE event.whatChanged OF | DPS.Button.Left => | DPS.Button.Middle => t.backgroundPopup.Popup (event.place, window); | DPS.Button.Right => END; (* of CASE *) RETURN TRUE; END Mouse; PROCEDUREShortHighlight (sle: SlideLineDLE.E) = VAR ps: TEXT; BEGIN ps := sle.Repaint (sle.box, sle); sle.ImmediatePostScript ( " 1.0 0.0 0.0 setrgbcolor " & ps ); sle.ImmediatePostScript ( " 0.0 0.0 0.0 setrgbcolor " ); EVAL Thread.Fork ( NEW ( RepaintClosure, apply := RepaintNormallyAFterPause, item := sle ) ); END ShortHighlight; PROCEDUREMaybeShortHighlight (e: DisplayList.E) = BEGIN IF e # NIL THEN TYPECASE e OF SlideLineDLE.E(sle) => ShortHighlight (sle); ELSE END; END; END MaybeShortHighlight; PROCEDUREChar (e: E; window: DPSWindow.T; char: CHAR): BOOLEAN = VAR ee: DisplayList.E; BEGIN Init (e, window); ee := e.childWithInputFocus; IF ee # NIL THEN RETURN ee.Char (window, char); END; CASE char OF | ' ' => RETURN NextSomething (e); | 'i' => AllInvisible (e); | 'v' => NextVisible (e); | 'a' => AllVisible (e); | '1' => MaybeShortHighlight ( NthVisible (e, 0) ); | '2' => MaybeShortHighlight ( NthVisible (e, 1) ); | '3' => MaybeShortHighlight ( NthVisible (e, 2) ); | '4' => MaybeShortHighlight ( NthVisible (e, 3) ); | '5' => MaybeShortHighlight ( NthVisible (e, 4) ); | '6' => MaybeShortHighlight ( NthVisible (e, 5) ); | '7' => MaybeShortHighlight ( NthVisible (e, 6) ); | '8' => MaybeShortHighlight ( NthVisible (e, 7) ); | '9' => MaybeShortHighlight ( NthVisible (e, 8) ); ELSE RETURN FALSE; END; (* of CASE *) RETURN TRUE; END Char;
Ignored Keystroke =
, Text.FromChar(got), .
);
END Key;
*********
BEGIN END OneSlideDLE.