<<>> <> <> <> <> <> <> <> <> <> <> <> DIRECTORY Atom USING [GetProp], Basics, PFS USING [Error, PathFromRope, StreamOpen], Icons, Imager USING [ClipRectangleI, Context, Font, SetColor, SetFont, SetXYI, ShowRope, white], ImagerBackdoor USING [DrawBits], InputFocus USING [GetInputFocus, SetInputFocus], IO, Menus USING [FindEntry, MenuEntry], MessageWindow USING [Append, Blink, Confirm], MultiCursors, Process USING [Detach], Rope USING [Concat, Fetch, Length, ROPE, Run, Substr], SimpleFeedback, TIPUser USING [InstantiateNewTIPTable, TIPScreenCoords, TIPTable], UserProfile USING [CallWhenProfileChanges, ProfileChangedProc, ListOfTokens], VFonts USING [CharWidth, EstablishFont, FontAscent, StringWidth], ViewerClasses USING [ModifyProc, NotifyProc, Viewer], ViewerOps USING [DestroyViewer, OpenIcon, PaintViewer, ChangeColumn, SaveViewer], ViewerPrivate USING [], ViewerTools USING [SelPosRec, SetSelection], WindowManager USING [colorDisplayOn]; IconsImpl: CEDAR MONITOR IMPORTS Atom, SimpleFeedback, PFS, Imager, ImagerBackdoor, InputFocus, IO, Menus, MessageWindow, MultiCursors, Process, Rope, TIPUser, UserProfile, VFonts, ViewerOps, ViewerTools, WindowManager EXPORTS Icons, ViewerPrivate SHARES ViewerClasses = BEGIN DrawIconProc: TYPE = Icons.DrawIconProc; IconFileFormat: TYPE = Icons.IconFileFormat; IconFlavor: TYPE = Icons.IconFlavor; IconRef: TYPE = Icons.IconRef; IconRep: TYPE = Icons.IconRep; ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; Viewer: TYPE = ViewerClasses.Viewer; <> bigFont: Imager.Font ¬ NIL; bigFontHeight: INTEGER ¬ 0; smallFont: Imager.Font ¬ NIL; smallFontHeight: INTEGER ¬ 0; suppressIconPrefixes: LIST OF ROPE ¬ NIL; nextFlavor: IconFlavor ¬ document; initMaxIcons: CARDINAL = 64; IconSeq: TYPE = RECORD [ length: NAT ¬ 0, entries: SEQUENCE max: NAT OF IconRef]; icons: REF IconSeq ¬ NEW[IconSeq[initMaxIcons]]; <> ColorizeIconProc: TYPE = PROC [context: Imager.Context, label: ROPE, iconInfo: IconRef, x, y: INTEGER] RETURNS [IconRef]; DrawIcon: PUBLIC ENTRY DrawIconProc = { ENABLE UNWIND => NULL; IF flavor.ORD < icons.length THEN { leading: INTEGER = 3; iconInfo: IconRef ¬ icons[ORD[flavor]]; prefix: ROPE ¬ NIL; proc: DrawIconProc ¬ iconInfo.proc; IF proc=NIL THEN { TRUSTED { base: LONG POINTER ¬ LOOPHOLE[@iconInfo.bits]; ImagerBackdoor.DrawBits[ context: context, base: base, wordsPerLine: Icons.iconW/Basics.bitsPerWord, sMin: 0, fMin: 0, sSize: Icons.iconH, fSize: Icons.iconW, tx: x, ty: y+Icons.iconH]; }; WITH Atom.GetProp[$Icons, $ColorizeIcon] SELECT FROM cip: REF ColorizeIconProc => iconInfo ¬ cip­[context, label, iconInfo, x, y]; ENDCASE; IF iconInfo.label THEN { iconFont: Imager.Font; fontHeight: INTEGER; ix: INTEGER ¬ x+iconInfo.lx; iy: INTEGER ¬ y+iconInfo.ly+iconInfo.lh; indent: INTEGER ¬ 0; segments: LIST OF ROPE ¬ NIL; IF VFonts.StringWidth[label, bigFont]<=iconInfo.lw THEN { iconFont ¬ bigFont; fontHeight ¬ bigFontHeight; segments ¬ LIST[label]; } ELSE { iconFont ¬ smallFont; fontHeight ¬ smallFontHeight; indent ¬ VFonts.CharWidth[' , iconFont]; segments ¬ Decompose[label, iconInfo.lw, indent, iconFont, 1+((iconInfo.lh-fontHeight)/(fontHeight+leading))]; }; Imager.ClipRectangleI[context, ix, iy, iconInfo.lw, -iconInfo.lh]; Imager.SetFont[context, iconFont]; IF iconInfo.invertLabel THEN Imager.SetColor[context, Imager.white]; FOR list: LIST OF ROPE ¬ segments, list.rest UNTIL list=NIL DO rope: ROPE ~ list.first; iy ¬ iy-fontHeight; Imager.SetXYI[context, ix, iy]; iy ¬ iy-leading; Imager.ShowRope[context, rope]; IF list=segments THEN ix ¬ ix+indent; ENDLOOP; }; } ELSE proc[flavor, context, x, y, label]; }; }; GetFonts: ENTRY PROC = { ENABLE UNWIND => NULL; bigFont ¬ VFonts.EstablishFont["Helvetica", 8]; bigFontHeight ¬ VFonts.FontAscent[bigFont]; smallFont ¬ VFonts.EstablishFont["Helvetica", 7]; smallFontHeight ¬ VFonts.FontAscent[smallFont]; }; ChangePrefix: UserProfile.ProfileChangedProc ~ { suppressIconPrefixes ¬ UserProfile.ListOfTokens[key: "Viewers.SuppressIconPrefix", default: NIL]; }; Decompose: PROC [name: ROPE, width, indent: INTEGER, font: Imager.Font, rows: INTEGER] RETURNS [segments: LIST OF ROPE ¬ NIL] = { start: INT ¬ 0; stop: INT ¬ name.Length[]; row: INT ¬ rows-1; extension: ROPE ¬ NIL; Build: PROC[stop: INT] ~ { maxw: INTEGER ¬ (IF row=0 THEN width ELSE width-indent); sw: INTEGER ¬ 0; -- width of string so far rest: LIST OF ROPE; next: INT ¬ -1; IF (start>=stop) OR (row<0) THEN RETURN; FOR i: INT DECREASING IN[start..stop) DO c: CHAR ~ name.Fetch[i]; sw ¬ sw+VFonts.CharWidth[c, font]; IF sw>maxw THEN { IF next<0 THEN next ¬ MIN[i+1, stop-1]; EXIT }; -- stop here SELECT c FROM '], '>, '/, ' => IF i<(stop-1) THEN next ¬ i+1; -- could end a line IN['A..'Z], IN['0..'9], '. => next ¬ i; -- next line could start here ENDCASE; REPEAT FINISHED => next ¬ start; ENDLOOP; row ¬ row-1; segments ¬ CONS[name.Substr[start: next, len: stop-next], segments]; Build[next]; }; IF suppressIconPrefixes # NIL THEN { FOR each: LIST OF ROPE ¬ suppressIconPrefixes, each.rest UNTIL each = NIL DO prefixLen: INT ~ Rope.Length[each.first]; IF Rope.Run[s1: name, s2: each.first, case: FALSE] = prefixLen THEN { start ¬ prefixLen; EXIT; }; ENDLOOP; }; FOR i: INT DECREASING IN[start..stop) DO SELECT name.Fetch[i] FROM ' , '/ => { EXIT }; '. => { segments ¬ LIST[name.Substr[start: i]]; row¬row-1; stop ¬ i; EXIT }; ENDCASE => NULL; ENDLOOP; Build[stop]; RETURN; }; NewIcon: PUBLIC ENTRY PROC [info: IconRef] RETURNS [newFlavor: IconFlavor] = { ENABLE UNWIND => NULL; newFlavor ¬ nextFlavor; nextFlavor ¬ SUCC[newFlavor]; IF icons.max < nextFlavor.ORD THEN { <> new: REF IconSeq ¬ NEW[IconSeq[newFlavor.ORD+initMaxIcons]]; FOR i: NAT IN [0..icons.length) DO new[i] ¬ icons[i]; ENDLOOP; icons ¬ new; }; icons[ORD[newFlavor]] ¬ info; icons.length ¬ nextFlavor.ORD; }; gMsgList: LIST OF Rope.ROPE ¬ NIL; gThisMsgList: LIST OF Rope.ROPE ¬ NIL; gCount: NAT ¬ 0; IconRefFromStream: PROC [stream: STREAM, n: CARDINAL] RETURNS [IconRef] ~ { format: REF IconFileFormat ~ NEW[IconFileFormat]; -- 1024 bytes! bytesPerIcon: INT ~ WORDS[IconFileFormat]*Basics.bytesPerWord; IO.SetIndex[stream, bytesPerIcon*n]; TRUSTED { base: LONG POINTER TO Basics.RawBytes ~ LOOPHOLE[format]; bytesRead: INT ~ IO.UnsafeGetBlock[stream, [base: base, count: bytesPerIcon]]; gMsgList ¬ CONS[IO.PutFLR["%g Icon %g, Read %g, Len %g", LIST[[integer[gCount]], [integer[bytesPerIcon]], [integer[bytesRead]], [integer[icons.length]]] ], gMsgList]; IF bytesRead#bytesPerIcon THEN ERROR IO.EndOfStream[stream]; }; RETURN[NEW[IconRep ¬ [bits: format.bits, label: format.label, invertLabel: format.invertLabel, lx: format.lx, ly: format.ly, lw: format.lw, lh: format.lh]]]; }; IconsFromFile: ENTRY PROC [file: ROPE] RETURNS [first: IconFlavor, nRead: INTEGER] ~ { ENABLE UNWIND => NULL; stream: STREAM ~ OpenWithDefault[file]; first ¬ nextFlavor; FOR nRead ¬ 0, nRead+1 DO info: IconRef ~ IconRefFromStream[stream, nRead ! IO.EndOfStream => EXIT]; icons[ORD[nextFlavor]] ¬ info; nextFlavor ¬ nextFlavor.SUCC; icons.length ¬ nextFlavor.ORD; ENDLOOP; }; NewIconFromFile: PUBLIC PROC [file: ROPE, n: CARDINAL] RETURNS [IconFlavor ¬ unInit] ~ { stream: STREAM ~ OpenWithDefault[file]; IF stream # NIL THEN { info: IconRef ~ IconRefFromStream[stream, n ! IO.EndOfStream => GOTO Fail]; RETURN [NewIcon[info]]; }; EXITS Fail => NULL; }; OpenWithDefault: PROC [name: ROPE] RETURNS [stream: STREAM ¬ NIL] = { fullFName: ROPE; LocalOpen: PROC [name: ROPE] RETURNS [STREAM] = { ENABLE PFS.Error => IF error.group = user THEN GO TO nullReturn; RETURN [PFS.StreamOpen[PFS.PathFromRope[name], $read]]; EXITS nullReturn => {RETURN [NIL]}; }; stream ¬ LocalOpen[name]; IF stream = NIL THEN { SimpleFeedback.Append[$Icons, $begin, $info, " Failed to find icon file; for "]; SimpleFeedback.Append[$Icons, $middle, $info, name]; SimpleFeedback.Append[$Icons, $end, $info, NIL]; SimpleFeedback.Blink[$Icons, $info]; }; RETURN [stream]; }; <> IconNotifyMouse: PUBLIC PROC [self: Viewer, input: LIST OF REF ANY, device: REF ¬ NIL, user: REF ¬ NIL, display: REF ¬ NIL] = { mx, my: INTEGER; closeOthers, switchDisplays: BOOL ¬ FALSE; FOR l: LIST OF REF ANY ¬ input, l.rest UNTIL l = NIL DO WITH l.first SELECT FROM z: TIPUser.TIPScreenCoords => [mouseX: mx, mouseY: my] ¬ z­; z: ATOM => SELECT z FROM $OpenDesktop, $ResetDesktop => { IF self.class.flavor = $DeskTop THEN self.class.notify[self, input]; RETURN}; $SetInputFocus => SELECT self.class.flavor FROM $Text => ViewerTools.SetSelection[self, NEW[ViewerTools.SelPosRec¬[]]]; $Typescript, $Chat => ViewerTools.SetSelection[self]; ENDCASE; $CloseOthers => closeOthers ¬ TRUE; $Color => IF WindowManager.colorDisplayOn THEN ViewerOps.ChangeColumn[self, color]; $Delete => DestroyIcon[self]; $Save => { entry: Menus.MenuEntry = Menus.FindEntry[self.menu, "Save"]; MessageWindow.Append["Saving icon . . . ", TRUE]; IF entry = NIL THEN [] ¬ ViewerOps.SaveViewer[self] ELSE entry.proc[self]; MessageWindow.Append["done."]}; $Left => ViewerOps.ChangeColumn[self, left]; $MouseMove => { cursorName: ATOM ¬ NARROW[device]; MultiCursors.SetACursor[textPointer, cursorName]; }; $Open => ViewerOps.OpenIcon[self, closeOthers]; $Right => ViewerOps.ChangeColumn[self, right]; $Select => SelectIcon[self]; $TogglePos => ViewerOps.ChangeColumn[self, SELECT self.column FROM left => right, right => left, color => left, ENDCASE => ERROR]; ENDCASE => NULL; ENDCASE => NULL; ENDLOOP; }; IconNotify: PUBLIC ViewerClasses.NotifyProc = { mx, my: INTEGER; closeOthers, switchDisplays: BOOL ¬ FALSE; FOR l: LIST OF REF ANY ¬ input, l.rest UNTIL l = NIL DO WITH l.first SELECT FROM z: TIPUser.TIPScreenCoords => [mouseX: mx, mouseY: my] ¬ z­; z: ATOM => SELECT z FROM $OpenDesktop, $ResetDesktop => { IF self.class.flavor = $DeskTop THEN self.class.notify[self, input]; RETURN}; $SetInputFocus => SELECT self.class.flavor FROM $Text => ViewerTools.SetSelection[self, NEW[ViewerTools.SelPosRec¬[]]]; $Typescript, $Chat => ViewerTools.SetSelection[self]; ENDCASE; $CloseOthers => closeOthers ¬ TRUE; $Color => IF WindowManager.colorDisplayOn THEN ViewerOps.ChangeColumn[self, color]; $Delete => DestroyIcon[self]; $Save => { entry: Menus.MenuEntry = Menus.FindEntry[self.menu, "Save"]; MessageWindow.Append["Saving icon . . . ", TRUE]; IF entry = NIL THEN [] ¬ ViewerOps.SaveViewer[self] ELSE entry.proc[self]; MessageWindow.Append["done."]}; $Left => ViewerOps.ChangeColumn[self, left]; $MouseMove => { SimpleFeedback.Append[$Viewers, oneLiner, $Error, "IconNotify is setting cursor shape (not IconNotifyMouse). Bug?"]; MultiCursors.SetACursor[textPointer, NIL]; }; $Open => ViewerOps.OpenIcon[self, closeOthers]; $Right => ViewerOps.ChangeColumn[self, right]; $Select => SelectIcon[self]; $TogglePos => ViewerOps.ChangeColumn[self, SELECT self.column FROM left => right, right => left, color => left, ENDCASE => ERROR]; ENDCASE => NULL; ENDCASE => NULL; ENDLOOP; }; IconModify: PUBLIC ViewerClasses.ModifyProc = { SELECT change FROM set => ViewerOps.PaintViewer[self, all]; kill => {selectedIcon ¬ NIL; ViewerOps.PaintViewer[self, all]}; ENDCASE; }; selectedIcon: PUBLIC ViewerClasses.Viewer ¬ NIL; DestroyIcon: PROC [icon: Viewer] = { IF icon.inhibitDestroy THEN { MessageWindow.Append["That icon cannot be destroyed.", TRUE]; MessageWindow.Blink[]; RETURN}; IF icon.link = NIL AND (icon.newVersion OR icon.newFile) THEN TRUSTED {Process.Detach[FORK ConfirmDestroyIcon[icon]]} -- fork for confirmation ELSE ViewerOps.DestroyViewer[icon]; }; ConfirmDestroyIcon: PROC [icon: Viewer] = { IF MessageWindow.Confirm[Rope.Concat["Confirm delete (and loss of edits) for icon: ", icon.name]] THEN ViewerOps.DestroyViewer[icon]; }; SelectIcon: PROC [viewer: Viewer] = { IF InputFocus.GetInputFocus[].owner#viewer THEN { InputFocus.SetInputFocus[NIL]; -- kill old so we don't smash selectedIcon selectedIcon ¬ viewer; InputFocus.SetInputFocus[viewer]; }; }; <> iconTIP: PUBLIC TIPUser.TIPTable ¬ TIPUser.InstantiateNewTIPTable["Icons.tip"]; GetFonts[]; [] ¬ IconsFromFile["Standard.icons"]; UserProfile.CallWhenProfileChanges[ChangePrefix]; END.