[_CDCSL_93-16_]<1>Cedar>release>Slate>SlateWidgetImpl.mesa

SlateWidgetImpl.mesa

Created by Christian Jacobi, November 2, 1990 1:04:32 pm PST

Weiser, September 3, 1992 8:10 pm PDT

Theimer, December 17, 1992 3:15 pm PST

Christian Jacobi, August 24, 1993 5:13 pm PDT

This used to be a real simple small demo program to show the power of BitmapWidgets. User whishes and MPad performance hacks made it not quite simple anymore.

DIRECTORY

Ascii,

Char,

Commander,

CommanderOps,

ConvertUnsafe,

FanoutStream,

ForkOps,

Identification,

Imager,

ImagerBackdoor,

ImagerBox,

ImagerColor,

ImagerFont,

ImagerPath,

ImagerSample,

IO,

KeySymsSun,

KeySymsOSF,

KeySymsHP,

KeySymsKB,

PropList,

Real,

Rope,

RuntimeError,

SF,

SharedCell,

SlateControls,

SlateIO,

Slate,

Xl,

XlAscii,

XlBitmap,

XlCutBuffers,

XTk,

XTkBitmapScroller,

XTkBitmapWidgetsExtras,

XTkSharedCell,

XTkPopUps,

XTkLabels,

XTkWidgets;

SlateWidgetImpl: CEDAR MONITOR

IMPORTS Char, Commander, CommanderOps, ConvertUnsafe, FanoutStream, ForkOps, Identification, Imager, ImagerBackdoor, ImagerColor, ImagerFont, ImagerPath, ImagerSample, IO, PropList, Real, Rope, RuntimeError, SharedCell, SlateControls, Slate, SlateIO, Xl, XlAscii, XlBitmap, XlCutBuffers, XTk, XTkBitmapScroller, XTkBitmapWidgetsExtras, XTkSharedCell, XTkLabels, XTkPopUps, XTkWidgets

EXPORTS Slate ~

BEGIN OPEN Slate;

Widget: TYPE = XTk.Widget;

varyingFlag: XTk.WidgetFlagKey ~ wf6;

Data: TYPE = REF DataRec;

DataRec: TYPE = RECORD [

page: Page ← NIL,

scrollPos: Xl.Point ¬ [0, 0],

followTextCell: SharedCell.Cell ¬ NIL,

followMode: REF FollowSpec ¬ NIL,

motionType: INT ¬ 1,

motionT: Xl.TimeStamp ¬ Xl.currentTime,

motionP: Xl.Point ¬ [0, 0],

instance: Instance ¬ NIL,

controlPanel: ControlPanel ¬ NIL,

tq: Xl.TQ ¬ NIL,

log: IO.STREAM,

context: Imager.Context ¬ NIL,

currentFontData: REF FontData ¬ NIL,

buttonMode: ATOM ¬ $normal,

buttonModeFancy: BOOL ¬ FALSE,

hasStart: BOOL ¬ FALSE,

startP: Xl.Point ¬ [0, 0],

directPaintGC: Xl.GContext ¬ NIL,

directEraseGC: Xl.GContext ¬ NIL,

directErasePixmap: Xl.Pixmap ¬ Xl.nullPixmap,

delayMore: BOOL ¬ FALSE,

delayedPaintList: LIST OF DelayedPaintRec ¬ NIL,

bitmapSize: Xl.Size ¬ [0, 0],

eraserWidth: INT ¬ 3,

eraseMinimum: REAL ¬ 2.5,

eraseTrajectory: Imager.Trajectory ¬ NIL,

mode: ATOM ¬ NIL,

sname, usedPageIndicator, bitmapScroller, realBitmapWidget, pagesCont, shellWidget, fonts, colorWidget, eraserWidthWidget, invertMouseWidget: Widget,

lineHeight: REAL ¬ 10,

textOfLine: Rope.ROPE ¬ NIL,

inputfocusX: REAL ¬ 0,

inputfocusY: REAL ¬ 0,

imageMode: ImageModeRep ¬ []

];

DelayedPaintRec: TYPE = RECORD [

p1, p2: Xl.Point

];

FontData: TYPE = RECORD [

presentName: Rope.ROPE,

realName: Rope.ROPE,

scale: REAL

];

ColorSpec: TYPE = RECORD [

color: Imager.Color,

];

ImageModeRep: TYPE = RECORD [

color: REF ColorSpec ¬ NIL,

font: Imager.Font ¬ NIL,

thickness: INT ¬ 1,

requiredLineHeight: INT ¬ 20

];

FollowSpec: TYPE = RECORD [

follow: BOOL,

];

keyForPage: REF INT ~ NEW [INT];

eraseColor: Imager.Color ~ Imager.MakeGray[0.125];

fontChoiceList: XTkPopUps.ChoiceList ¬ NIL;

colorChoiceList: XTkPopUps.ChoiceList ¬ NIL;

followChoiceList: XTkPopUps.ChoiceList ¬ NIL;

defaultFontData: REF FontData;

defaultColorData: REF ColorSpec;

defaultFollowData: REF FollowSpec;

nowhereBM: XlBitmap.Bitmap ¬ XlBitmap.Create[[1, 1], 1, FALSE];

nowhereContext: Imager.Context ¬ XlBitmap.CreateContext[nowhereBM];

ResetBM: PROC [d: Data, newBM: XlBitmap.Bitmap] = {

bm: XlBitmap.Bitmap ¬ IF newBM=NIL THEN nowhereBM ELSE newBM;

box: SF.Box ~ XlBitmap.GetBox[bm];

sz: Xl.Size ~ [box.max.f-box.min.f, box.max.s-box.min.s];

context: Imager.Context;

XTkBitmapScroller.SetBitmap[d.bitmapScroller, bm];

IF ImagerSample.GetBitsPerSample[XlBitmap.GetSM[bm]]>1 THEN {

implWidget: Widget ¬ XTkBitmapScroller.GetImplWidget[d.bitmapScroller];

XTkBitmapWidgetsExtras.FollowColors[implWidget, bm];

};

XTkTIP.ChangePseudoHeight[d.instance.surface, sz.height];

context ¬ XlBitmap.CreateContext[bm];

Imager.ClipRectangle[context, [1, 1, sz.width-2, sz.height-2]];

Imager.SetStrokeEnd[context, round];

Imager.SetStrokeJoint[context, round];

d.bitmapSize ¬ sz;

d.context ¬ context;

UseThickness[d];

UseFont[d];

UseColor[d];

};

InitFonts: PROC [] = {

Look at /imagerfonts/xerox/tiogafonts/ to find fonts

currentList: XTkPopUps.ChoiceList ¬ NIL;

FontEntry: PROC [realName: Rope.ROPE, scale: REAL, short: Rope.ROPE] RETURNS [fd: REF FontData] = {

fd ¬ NEW[FontData ¬ [

presentName: short,

realName: realName,

scale: scale

]];

currentList ¬ CONS[

[short, fd, NIL, "Font on type in", SetFontButtonHit], currentList

];

};

FontSubMenu: PROC [familyName: Rope.ROPE] = {

fontChoiceList ¬ CONS[

[familyName, NIL, currentList, "Use this font family"], fontChoiceList

];

currentList ¬ NIL;

};

defaultFontData ¬ NEW[FontData ¬ [

presentName: "Tioga10 ",

realName: "Xerox/TiogaFonts/Tioga10",

scale: 1.0

]];

[] ¬ FontEntry["Xerox/TiogaFonts/Tioga10", 1.0, "Tioga10"];

[] ¬ FontEntry["Xerox/TiogaFonts/Tioga10", 1.5, "Tioga10 x 1.5"];

[] ¬ FontEntry["Xerox/TiogaFonts/Tioga10", 2.0, "Tioga10 x 2"];

[] ¬ FontEntry["Xerox/TiogaFonts/Tioga10", 3.0, "Tioga10 x 3"];

[] ¬ FontEntry["Xerox/TiogaFonts/Tioga10", 4.0, "Tioga10 x 4"];

[] ¬ FontEntry["Xerox/TiogaFonts/Tioga10", 6.0, "Tioga10 x 6"];

[] ¬ FontEntry["Xerox/TiogaFonts/Tioga10", 8.0, "Tioga10 x 8"];

FontSubMenu["Tioga"];

[] ¬ FontEntry["Xerox/TiogaFonts/Gacha10", 1.0, "Gacha10"];

[] ¬ FontEntry["Xerox/TiogaFonts/Gacha10", 2.0, "Gacha10 x 2"];

[] ¬ FontEntry["Xerox/TiogaFonts/Gacha10", 3.0, "Gacha10 x 3"];

[] ¬ FontEntry["Xerox/TiogaFonts/Gacha10", 4.0, "Gacha10 x 4"];

[] ¬ FontEntry["Xerox/TiogaFonts/Gacha10", 6.0, "Gacha10 x 6"];

[] ¬ FontEntry["Xerox/TiogaFonts/Gacha10", 8.0, "Gacha10 x 8"];

FontSubMenu["Gacha"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica10", 1.0, "Helvetica10"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica14", 1.0, "Helvetica14"];

defaultFontData ¬ FontEntry["Xerox/TiogaFonts/Helvetica18", 1.0, "Helvetica18"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica18", 1.5, "Helvetica18 x 1.5"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica18", 2.0, "Helvetica18 x 2.0"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica18", 3.0, "Helvetica18 x 3.0"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica18", 4.0, "Helvetica18 x 4.0"];

FontSubMenu["Helvetica"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica10i", 1.0, "Helvetica10 italic"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica14i", 1.0, "Helvetica14 italic"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica18i", 1.0, "Helvetica18 italic"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica18i", 1.5, "Helvetica18 italic x 1.5"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica18i", 2.0, "Helvetica18 italic x 2.0"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica18i", 3.0, "Helvetica18 italic x 3.0"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica18i", 4.0, "Helvetica18 italic x 4.0"];

FontSubMenu["Helvetica italic"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica10b", 1.0, "Helvetica10 bold"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica14b", 1.0, "Helvetica14 bold"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica18b", 1.0, "Helvetica18 bold"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica18b", 1.5, "Helvetica18 bold x 1.5"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica18b", 2.0, "Helvetica18 bold x 2.0"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica18b", 3.0, "Helvetica18 bold x 3.0"];

[] ¬ FontEntry["Xerox/TiogaFonts/Helvetica18b", 4.0, "Helvetica18 bold x 4.0"];

FontSubMenu["Helvetica bold"];

[] ¬ FontEntry["Xerox/TiogaFonts/oldenglish10", 1.0, "Oldenglish10"];

[] ¬ FontEntry["Xerox/TiogaFonts/math10", 1.0, "Math10"];

[] ¬ FontEntry["Xerox/TiogaFonts/timesroman10", 1.0, "TimesRoman10"];

[] ¬ FontEntry["Xerox/TiogaFonts/hippo10", 1.0, "Hippo10"];

[] ¬ FontEntry["Xerox/TiogaFonts/hebrew14", 1.0, "Hebrew14"];

[] ¬ FontEntry["Xerox/TiogaFonts/cyrillic12", 1.0, "Cyrillic12"];

[] ¬ FontEntry["Xerox/TiogaFonts/cream12", 1.0, "Cream12"];

FontSubMenu["Others"];

};

InitColors: PROC [] = {

ColorEntry: PROC [name: Rope.ROPE, color: Imager.Color] RETURNS [cs: REF ColorSpec] = {

cs ¬ NEW[ColorSpec ¬ [

color: color,

]];

colorChoiceList ¬ CONS[

[name, cs, NIL, "Color for painting", SetColorButtonHit], colorChoiceList

];

};

[] ¬ ColorEntry["invert", ImagerBackdoor.invert];

[] ¬ ColorEntry["H", ImagerColor.ColorFromHighlight[[0.5, 0.5]]];

[] ¬ ColorEntry["B", ImagerColor.ColorFromRGB[[0.0, 0.0, 1.0]]];

[] ¬ ColorEntry["G", ImagerColor.ColorFromRGB[[0.0, 1.0, 0.0]]];

[] ¬ ColorEntry["R", ImagerColor.ColorFromRGB[[1.0, 0.0, 0.0]]];

[] ¬ ColorEntry["white", Imager.white];

[] ¬ ColorEntry["1/8", Imager.MakeGray[0.125]];

[] ¬ ColorEntry["2/8", Imager.MakeGray[0.25]];

[] ¬ ColorEntry["3/8", Imager.MakeGray[0.375]];

[] ¬ ColorEntry["4/8", Imager.MakeGray[0.5]];

[] ¬ ColorEntry["5/8", Imager.MakeGray[0.625]];

[] ¬ ColorEntry["6/8", Imager.MakeGray[0.75]];

[] ¬ ColorEntry["7/8", Imager.MakeGray[0.875]];

defaultColorData ¬ ColorEntry["black", Imager.black];

};

InitFollows: PROC [] = {

FollowEntry: PROC [name: Rope.ROPE, follow: BOOL, help: Rope.ROPE] RETURNS [f: REF FollowSpec] = {

f ← NEW[FollowSpec ← [follow: follow, name: name]];

followChoiceList ¬ CONS[

[image: name, key: f, impl: NIL, help: help, notify: SetFollowButtonHit], followChoiceList

];

};

defaultFollowData ¬ FollowEntry["Follow: independent", FALSE, "Everyone can see a different page."];

[] ¬ FollowEntry["Follow: synchronous", TRUE, "Everyone sees the page I see."];

};

ControlPanel: TYPE = REF ControlPanelRec;

ControlPanelRec: TYPE = RECORD [

d: Data,

controlShell: Widget ¬ NIL

];

SwapControlPanel: ENTRY PROC [d: Data, c: ControlPanel] RETURNS [old: ControlPanel ¬ NIL] = {

IF d#NIL THEN {

old ¬ d.controlPanel;

d.controlPanel ¬ c

};

SetControlPanel: PROC [d: Data, c: ControlPanel] = {

c ¬ SwapControlPanel[d, c];

IF c#NIL THEN {

controlShell: Widget ¬ c.controlShell;

IF controlShell#NIL THEN XTkWidgets.DestroyShell[controlShell]

};

MotionHistoryHit: XTkWidgets.ButtonHitProcType = {

d: Data ~ NARROW[registerData];

IF d.motionType=0

THEN {

d.motionType ¬ 1;

XTkWidgets.SetText[widget, "Motion: events "];

}

ELSE {

d.motionType ¬ 0;

XTkWidgets.SetText[widget, "Motion: history "];

};

RenameSessionHit: XTkWidgets.ButtonHitProcType = {

instance: Slate.Instance ~ NARROW[registerData];

session: Session ¬ instance.session;

nameWidget: Widget ¬ NARROW[callData];

IF session#NIL THEN SetSessionName[session, name];

};

SetFollowButtonHit: XTkWidgets.ButtonHitProcType = {

instance: Slate.Instance ~ NARROW[registerData];

f: REF FollowSpec ~ NARROW[callData];

d: Data ~ NARROW[instance.uiPrivate];

ChooseFollow[d, f];

};

CreateControlPanelWidget: PROC [d: Data] = {

c: ControlPanel ¬ NEW[ControlPanelRec ¬ [d: d]];

shellWidget: Widget ¬ c.controlShell ¬ XTkWidgets.CreateShell[

rootTQ: d.tq,

className: $SlateControl,

windowHeader: "Slate Control",

packageName: "SlateControl",

shortName: "Slate Control"

];

--log

logWidget: Widget ¬ XTkWidgets.CreateStreamWidget[widgetSpec: [geometry: XTk.G[-1, 60]]];

--pages

newPageS: Widget ~ XTkWidgets.CreateButton[

text: "NewPage", hitProc: NewPageHit, registerData: d, tq: d.tq

];

pageSizeBut: Widget ~ XTkWidgets.CreateToggle[

choices: LIST[["(large)", $large], ["(small)", $small]] ,

hitProc: PageSizeHit, registerData: d, tq: d.tq

];

clearPage: Widget ~ XTkWidgets.CreateButton[

text: "ClearPage ", hitProc: ClearPageButtonHit, registerData: d, tq: d.tq

];

deletePage: Widget ~ XTkWidgets.CreateButton[

text: "DeletePage ", hitProc: DeletePageButtonHit, registerData: d, tq: d.tq

];

deleteAllPages: Widget ~ XTkWidgets.CreateButton[

text: "DeleteAllPages ", hitProc: DeleteAllPagesButtonHit, registerData: d, tq: d.tq

];

topControlsCont: Widget ~ XTkWidgets.CreateXStack[[],

LIST[newPageS, pageSizeBut, clearPage, deletePage, deleteAllPages, name]

];

fancyControlsCont: Widget ~ SlateControls.MakeRowWidget[d.instance, $Main];

createColorMenu: XTkPopUps.WidgetCreateClosure ¬ XTkPopUps.WidgetCreateClosureFromChoiceList[list: colorChoiceList, defaultNotify: SetColorButtonHit, notifyTQ: d.tq];

colorChoiceWidget: Widget ¬ d.colorWidget ¬ XTkPopUps.CreatePopUpButton[

text: " ...color... ", createMenu: createColorMenu, registerData: d

];

createFontMenu: XTkPopUps.WidgetCreateClosure ¬ XTkPopUps.WidgetCreateClosureFromChoiceList[list: fontChoiceList, defaultNotify: SetFontButtonHit, notifyTQ: d.tq];

fonts: Widget ¬ d.fonts ¬ XTkPopUps.CreatePopUpButton[

text: " ...font... ", createMenu: createFontMenu, registerData: d

];

motion: Widget ~ XTkWidgets.CreateButton[

text: "Motion: events ", hitProc: MotionHistoryHit, registerData: d

];

controls1Cont: Widget ¬ XTkWidgets.CreateXStack[[],

LIST[colorChoiceWidget, fonts, motion]

];

topYCont: Widget ← XTkWidgets.CreateYStack[[],

LIST[XTkWidgets.HRule[], logWidget, XTkWidgets.HRule[], topControlsCont, controls1Cont, fancyControlsCont]

];

XTkSharedCell.BindText[d.instance.session.nameCell, name];

XTk.SetWidgetFlag[logWidget, varyingFlag];

XTkWidgets.SetShellChild[c.controlShell, topYCont];

XTkWidgets.BindScreenShell[c.controlShell, d.shellWidget.connection ! Xl.connectionNotCreated => {

IO.PutRope[d.instance.log, Rope.Concat["Failed: ", why.reason]];

GOTO oops

}];

XTkWidgets.BindStream[logWidget, d.instance.log];

SetControlPanel[d, c];

TrackColor[d];

TrackThickness[d];

TrackPageSize[d, pageSizeBut];

XTkWidgets.RealizeShell[c.controlShell];

EXITS oops => {};

};

CreateControlPanelButtonHit: XTkWidgets.ButtonHitProcType = {

d: Data ~ NARROW[registerData];

CreateControlPanelWidget[d];

};

CreateSlateWidget: PROC [] RETURNS [Data] = {

d: Data ¬ NEW[DataRec ¬ [

context: nowhereContext,

followTextCell: SharedCell.Create[initial: defaultFollowData.name]

]];

tq: Xl.TQ ¬ d.tq ¬ Xl.CreateTQ[order: XTk.rootLockingOrder];

shell: Widget ¬ d.shellWidget ¬ XTkWidgets.CreateShell[

rootTQ: tq,

className: $Slate,

windowHeader: Rope.Concat["Slate on ", Identification.Self[]],

packageName: "Slate",

shortName: "Slate"

];

bitmapScroller: Widget ¬ d.bitmapScroller ¬ XTkBitmapScroller.CreateBitmapScroller[scrollTQ: tq, scrollData: d, scrolledCallBack: ScrolledCallBack];

widthLabelWidget: Widget ~ XTkWidgets.CreateLabel[[], "W:"];

widthChoiceWidget: Widget ~ XTkWidgets.CreateChoices[

choices: LIST [

["1", NEW[INT ¬ 1]],

["2", NEW[INT ¬ 2]],

["3", NEW[INT ¬ 3]],

["4", NEW[INT ¬ 4]],

["6", NEW[INT ¬ 6]],

["10", NEW[INT ¬ 10]],

["15", NEW[INT ¬ 15]],

["20", NEW[INT ¬ 20]],

["25", NEW[INT ¬ 25]],

["30", NEW[INT ¬ 30]]

hitProc: ThicknessButtonHit, registerData: d

];

sname: Widget ¬ d.sname ¬ XTkWidgets.CreateLabel[];

eraserWidthWidget: Widget ¬ d.eraserWidthWidget ¬ XTkWidgets.CreateLabel[[], EraserExplanation[d]];

invertMouseWidget: Widget ¬ d.invertMouseWidget ¬ XTkWidgets.CreateButton[

text: "...", hitProc: InvertButtonsButtonHit, registerData: d, tq: tq

];

createControlPanel: Widget ~ XTkWidgets.CreateButton[

text: "Panel ", hitProc: CreateControlPanelButtonHit, registerData: d, tq: tq

];

newPage: Widget ~ XTkWidgets.CreateButton[

text: "Page", hitProc: NewPageHit, registerData: d, tq: tq

];

safe: Widget ~ XTkWidgets.CreateButton[

text: "Safe", hitProc: SafeHit, registerData: d, tq: tq

];

controls1Cont: Widget ¬ XTkWidgets.CreateXStack[[],

LIST[createControlPanel, widthLabelWidget, widthChoiceWidget, eraserWidthWidget, invertMouseWidget, newPage, safe, sname]

];

pagesCont: Widget ¬ d.pagesCont ¬ XTkWidgets.CreateYStack[[geometry: [size: [width: 20, height: Xl.dontUse]]], NIL];

mainAreaCont: Widget ¬ XTkWidgets.CreateXStack[[],

LIST[pagesCont, XTkWidgets.VRule[], bitmapScroller]

];

topYCont: Widget ← XTkWidgets.CreateYStack[[geometry: [pos: [1, 1], size: [600, 400], borderWidth: Xl.dontUse]],

LIST[XTkWidgets.HRule[], controls1Cont, XTkWidgets.HRule[], mainAreaCont]

];

bmw: Widget ← d.realBitmapWidget ¬ XTkBitmapScroller.GetImplWidget[bitmapScroller];

XTk.PutWidgetProp[bmw, $BitmapBorder, NEW[INT ¬ 1]];

XTk.PutWidgetProp[bmw, $OverheadCost, NEW[INT ¬ 1]];

XTk.PutWidgetProp[bmw, $ServerQueueLimit, NEW[INT ¬ 4]];

XTkWidgets.SetShellChild[shell, topYCont];

XTk.AddPermanentMatch[bmw, [proc: TipEvent, handles: Xl.CreateEventFilter[keyPress, buttonPress, buttonRelease, motionNotify], tq: tq, data: d], [buttonMotion: TRUE, buttonRelease: TRUE, buttonPress: TRUE, keyRelease: TRUE, keyPress: TRUE]];

XTk.AddPermanentMatch[bmw, [proc: ClientMessageEvent, handles: Xl.CreateEventFilter[clientMessage], tq: tq, data: d]];

XTk.RegisterNotifier[shell, XTk.postWidgetDestructionKey, ShellDestroyed, d];

XTkWidgets.SetFocusMethod[shell: shell, focusProtocol: true, inputHint: false]; --Globally active

XTk.RegisterNotifier[shell, XTk.preWindowCreationKey, HackWindowCreation, d];

TrackInvertButtons[d];

ForkOps.ForkPeriodically[501, PeriodicalFork, d];

RETURN [d];

};

HackWindowCreation: XTk.WidgetNotifyProc = {

d: Data ~ NARROW[registerData];

c: Xl.Connection ¬ widget.connection;

screen: Xl.Screen ¬ widget.screenDepth.screen;

pGC, eGC: Xl.GContext;

--direct paining

d.directPaintGC ¬ pGC ¬ Xl.MakeGContext[c, widget.window];

Xl.SetGCForeground[pGC, screen.blackPixel];

Xl.SetGCBackground[pGC, screen.whitePixel];

Xl.SetGCFunction[pGC, copy];

Xl.SetGCCapStyle[pGC, round];

Xl.SetGCJoinStyle[pGC, round];

--direct erasing

d.directEraseGC ¬ eGC ¬ Xl.MakeGContext[c, widget.window];

Xl.SetGCFunction[gc: eGC, function: copy];

Xl.SetGCForeground[eGC, screen.blackPixel];

Xl.SetGCBackground[eGC, screen.whitePixel];

d.directErasePixmap ¬ Xl.CreatePixmap[c, screen.root.drawable, [4, 4], widget.screenDepth.depth];

TRUSTED {

Xl.PutImage[c: c, drawable: d.directErasePixmap.drawable, gc: eGC, size: [4, 4], dest: [0, 0], base: LOOPHOLE[@stippleSpace[0]], offx: 0, offy: 0, scanLineBytes: 4, bitsPerPixel: 1];

};

Xl.SetGCTile[eGC, d.directErasePixmap];

Xl.SetGCFillStyle[eGC, tiled];

Xl.SetGCLineWidth[eGC, d.eraserWidth];

Xl.SetGCCapStyle[eGC, round];

Xl.SetGCJoinStyle[eGC, round];

};

stippleSpace: REF ARRAY [0..4) OF CARD32 =

NEW[ARRAY [0..4) OF CARD32 ¬ [088888888H, 0, 022222222H, 0]];

PeriodicalFork: PROC [data: REF] = {

d: Data ~ NARROW[data];

IF ~d.delayMore

THEN {Xl.Enqueue[d.tq, TQPaintDelayed, d, NIL]; d.delayMore ¬ TRUE}

ELSE d.delayMore ¬ d.delayedPaintList=NIL;

};

TQPaintDelayed: Xl.EventProcType = {

d: Data ~ NARROW[clientData];

PaintDelayed[d];

};

PaintDelayed: <<d.tq>> PROC [d: Data] = {

hl: LIST OF DelayedPaintRec ¬ d.delayedPaintList;

d.delayedPaintList ¬ NIL;

FOR l: LIST OF DelayedPaintRec ¬ hl, l.rest WHILE l#NIL DO

Imager.MaskVector[d.context,

[Cx[d, l.first.p1.x], Cy[d, l.first.p1.y]],

[Cx[d, l.first.p2.x], Cy[d, l.first.p2.y]]

];

ENDLOOP;

};

ShellDestroyed: XTk.WidgetNotifyProc = {

d: Data ~ NARROW[registerData];

SetControlPanel[d, NIL];

DestroyInstance[d.instance]; --is idempotent

ForkOps.Stop[PeriodicalFork, d]

};

ContinuePaint: <<tip notifier>> PROC [d: Data, p: Xl.Point] = INLINE {

IF d.mode=$paint THEN {

IF ~d.hasStart THEN SetStart[d, p];

--also paints the first null vector to draw a nice point

IF d.imageMode.color.color=Imager.black

THEN {

--This is much faster for slow connections

d.delayMore ¬ TRUE;

d.delayedPaintList ¬ CONS[[d.startP, p], d.delayedPaintList];

Xl.DrawLine[d.realBitmapWidget.connection, d.realBitmapWidget.window, d.startP, p, d.directPaintGC];

Xl.Flush[d.realBitmapWidget.connection];

}

ELSE {

Imager.MaskVector[d.context,

[Cx[d, d.startP.x], Cy[d, d.startP.y]],

[Cx[d, p.x], Cy[d, p.y]]

];

};

d.startP ¬ p;

};

ContinueErase: <<tip notifier>> PROC [d: Data, p: Xl.Point] = INLINE {

IF d.mode=$erase AND d.eraseTrajectory#NIL THEN {

IF ~d.hasStart THEN SetStart[d, p];

d.eraseTrajectory ¬ ImagerPath.LineTo[d.eraseTrajectory, [x: Cx[d, p.x], y: Cy[d, p.y]]];

--also paints the first null vector to draw a nice circle on button down

Xl.DrawLine[d.realBitmapWidget.connection, d.realBitmapWidget.window, d.startP, p, d.directEraseGC];

Xl.Flush[d.realBitmapWidget.connection];

d.startP ¬ p;

};

ContinueAny: <<tip notifier>> PROC [d: Data, p: Xl.Point] = {

SELECT d.mode FROM

$paint => ContinuePaint[d, p];

$erase => ContinueErase[d, p];

ENDCASE => {};

};

EndPaint: <<tip notifier>> PROC [d: Data, p: Xl.Point] = INLINE {

IF d.hasStart AND d.mode=$paint THEN ContinuePaint[d, p];

d.hasStart ¬ FALSE;

d.mode ¬ NIL;

};

EndErase: <<tip notifier>> PROC [d: Data, p: Xl.Point] = {

IF d.hasStart AND d.mode=$erase THEN ContinueErase[d, p];

IF d.eraseTrajectory#NIL THEN {

action: PROC [] = {

Imager.SetColor[d.context, Imager.white];

Imager.SetStrokeWidth[d.context, d.eraserWidth];

Imager.MaskStrokeTrajectory[d.context, d.eraseTrajectory];

};

Imager.DoSave[d.context, action];

d.eraseTrajectory ¬ NIL;

};

IF d.mode=$erase THEN {

Imager.SetStrokeWidth[d.context, d.imageMode.thickness];

Imager.SetColor[d.context, d.imageMode.color.color];

};

d.mode ¬ NIL;

d.hasStart ¬ FALSE;

};

EndAny: <<tip notifier>> PROC [d: Data, p: Xl.Point] = {

SELECT d.mode FROM

$paint => EndPaint[d, p];

$erase => EndErase[d, p];

ENDCASE => {};

d.mode ¬ NIL;

};

PaintSetStart: <<tip notifier>> PROC [d: Data, p: Xl.Point] = INLINE {

IF d.mode=$erase THEN EndErase[d, p];

d.mode ¬ $paint;

SetStart[d, p];

};

EraseSetStart: <<tip notifier>> PROC [d: Data, p: Xl.Point] = INLINE {

PaintDelayed[d];

IF d.mode#$erase AND ~d.hasStart THEN {

SetStart[d, p];

d.mode ¬ $erase;

d.eraseTrajectory ¬ ImagerPath.MoveTo[[x: Cx[d, p.x], y: Cy[d, p.y]]];

Imager.SetStrokeWidth[d.context, d.eraserWidth];

Imager.SetColor[d.context, eraseColor];

ContinueErase[d, p];

};

SetStart: PROC [d: Data, p: Xl.Point] = INLINE {

d.startP ¬ p;

d.hasStart ¬ TRUE;

};

GridAndSetFocus: <<tip notifier>> PROC [d: Data] = {

d.textOfLine ¬ NIL;

d.inputfocusY ¬ d.inputfocusY/4*4; --gridding y to make alignment easier

Imager.SetXY[d.context, [d.inputfocusX, d.inputfocusY]];

};

AdvanceLine: <<tip notifier>> PROC [d: Data, leftX: BOOL ¬ FALSE] = {

IF leftX THEN d.inputfocusX ¬ 5;

d.inputfocusY ¬ d.inputfocusY - d.lineHeight;

GridAndSetFocus[d];

};

PaintRope: <<tip notifier>> PROC [d: Data, r: Rope.ROPE] = {

ENABLE RuntimeError.UNCAUGHT => GOTO Oops;

BackSpaceChar: PROC [d: Data] = {

leng: INT ~ Rope.Length[d.textOfLine];

IF leng>0 THEN {

BackWardsProc: ImagerFont.XStringProc = {

charAction[Char.Make[set: 0, code: ORD[ch]]];

};

ch: CHAR ~ Rope.Fetch[d.textOfLine, leng-1];

d.textOfLine ¬ Rope.Substr[d.textOfLine, 0, leng-1];

Imager.SetColor[d.context, Imager.white];

Imager.ShowBackward[d.context, BackWardsProc];

Imager.SetColor[d.context, d.imageMode.color.color];

};

length: INT ~ Rope.Length[r];

nextPos: INT ¬ 0;

d.hasStart ¬ FALSE;

IF d.mode=$erase THEN EndErase[d, d.startP];

d.lineHeight ¬ d.imageMode.requiredLineHeight;

Imager.SetFont[d.context, d.imageMode.font];

IF length=1 THEN {

SELECT Rope.Fetch[r, 0] FROM

Ascii.BS, Ascii.DEL => {BackSpaceChar[d]; RETURN};

ENDCASE => {}

};

crPos: INT ~ Rope.SkipTo[s: r, pos: nextPos, skip: "\l\r"];

IF crPos>nextPos THEN {

piece: Rope.ROPE ¬ Rope.Substr[r, nextPos, crPos-nextPos];

Imager.ShowRope[d.context, piece];

d.textOfLine ¬ Rope.Concat[d.textOfLine, piece];

};

nextPos ¬ crPos+1;

IF nextPos>=length THEN RETURN;

AdvanceLine[d, FALSE];

ENDLOOP;

EXITS Oops => {};

};

SetInputFocus: <<tip notifier>> PROC [d: Data, x, y: REAL] = {

i: Instance ¬ d.instance;

XTkWidgets.SetFocus[shell: i.shell, time: Xl.currentTime, child: i.surface];

d.inputfocusX ¬ x;

d.inputfocusY ¬ y;

GridAndSetFocus[d];

};

ScrolledCallBack: XTkBitmapScroller.ScrolledCallBackProc = {

d: Data ¬ NARROW[data];

PaintDelayed[d];

d.scrollPos ¬ pos;

XTkTIP.ChangeScrollPos[d.istance.surface, [pos.x, pos.y]];

};

SetFontButtonHit: XTkWidgets.ButtonHitProcType = {

d: Data ~ NARROW[registerData];

fd: REF FontData ~ NARROW[callData];

ChooseFont[d, fd];

};

SetColorButtonHit: XTkWidgets.ButtonHitProcType = {

d: Data ~ NARROW[registerData];

cs: REF ColorSpec ~ NARROW[callData];

ChooseColor[d, cs];

};

ChooseColor: PROC [d: Data, cs: REF ColorSpec] = {

d.imageMode.color ¬ cs;

IF d.mode#$erase AND d.context#NIL THEN

Imager.SetColor[d.context, d.imageMode.color.color];

TrackColor[d];

};

UseColor: PROC [d: Data] = {

IF d.mode#$erase THEN Imager.SetColor[d.context, d.imageMode.color.color];

};

TrackColor: PROC [d: Data] = {

colorWidget: Widget ¬ d.colorWidget;

cs: REF ColorSpec ¬ d.imageMode.color;

IF colorWidget#NIL AND cs#NIL THEN

XTkWidgets.SetText[colorWidget, Rope.Cat["Color: ", cs.name, " "]];

};

ChooseFollow: PROC [d: Data, f: REF FollowSpec] = {

page: Slate.Page ¬ Slate.ActivePage[d.instance.session];

d.followMode ← f;

SharedCell.SetContents[d.followTextCell, f.name];

IF d.followMode.follow AND LocalActivePage[d]#page AND page#NIL THEN

LocalActivatePage[d, page]

};

MessageHit: XTkWidgets.ButtonHitProcType = {

instance: Slate.Instance ~ NARROW[registerData];

tField: Widget ~ NARROW[callData];

message: Rope.ROPE ¬ XTkWidgets.GetText[tField];

CallGlobalForAllInstancesOfSession[session: instance.session, event: $Message, callData: Rope.Cat[Xl.ServerName[widget.connection], "> ", message, "\n"]]

};

IsColorWidget: PROC [w: Widget] RETURNS [BOOL] = {

shell: Widget ¬ XTk.RootWidget[w];

RETURN [XTk.GetWidgetProp[shell, $Color]#NIL]

};

ClientMessageEvent: Xl.EventProcType = {

d: Data ~ NARROW[clientData];

SELECT event.type FROM

Xl.EventCode.clientMessage => {

cme: Xl.ClientMessageEvent ~ NARROW[event];

a: Xl.XAtom ¬ Xl.MakeAtom[cme.connection, "PARC←Handwriting"];

IF cme.typeAtom=a AND cme.w[0]=Xl.AtomId[a] THEN {

i: INT32 ~ LOOPHOLE[cme.w[1]];

stuffKey: INT32 ~ -1;

nextKey: INT32 ~ -3;

SELECT i FROM

stuffKey => {

text: Rope.ROPE ¬ XlCutBuffers.Get[cme.connection];

PaintRope[d, text];

};

nextKey => {

AdvanceLine[d, TRUE]

};

ENDCASE => {};

};

ENDCASE => {};

};

Cx: PROC [d: Data, x: INT] RETURNS [INT] = INLINE {

Given an X window coordinate, returns an Imager coordinate

RETURN [x-d.scrollPos.x]

};

Cy: PROC [d: Data, y: INT] RETURNS [INT] = INLINE {

Given an X window coordinate, returns an Imager coordinate

RETURN [d.bitmapSize.height-y+d.scrollPos.y]

};

listOfSpecials: LIST OF Xl.KeySym ~ LIST[KeySymsSun.Paste, KeySymsOSF.Paste, KeySymsHP.Paste];

TipEvent: Xl.EventProcType = {

d: Data ~ NARROW[clientData];

Motion: PROC [d: Data, stopT: Xl.TimeStamp, stopP: Xl.Point, stop: BOOL] = {

i: Instance ~ d.instance;

cnt: NAT ¬ 0;

tc: REF Xl.TimeCoords ¬ NIL;

IF d.motionType=0 THEN {

tc ¬ Xl.GetMotionEvents[c: i.surface.connection, window: i.surface.window, start: d.motionT, stop: stopT];

cnt ¬ tc.size

};

IF cnt=0

THEN {

IF stop

THEN EndAny[d, stopP]

ELSE ContinueAny[d, stopP];

}

ELSE {

FOR i: NAT IN [0..cnt-1) DO

ContinueAny[d, tc[i].p];

ENDLOOP;

BEGIN

l: NAT ~ cnt-1;

IF stop

THEN EndAny[d, tc[l].p]

ELSE ContinueAny[d, tc[l].p];

END;

};

d.motionT ¬ stopT;

d.motionP ¬ stopP;

};

SELECT event.type FROM

Xl.EventCode.buttonPress => {

e: Xl.ButtonPressEvent ~ NARROW[event];

paint: BOOL ¬ e.button=1;

IF e.button=2 THEN {

SetInputFocus[d, Cx[d, e.pos.x], Cy[d, e.pos.y]];

RETURN

};

IF (e.state.button1 OR e.state.button2 OR e.state.button3) AND d.buttonMode#$focus THEN {

Only the first button is looked at...

RETURN;

};

SELECT d.buttonMode FROM

$normal => {};

$inverted => paint ¬ NOT paint;

$focus => {

IF (e.state.button1 OR e.state.button2 OR e.state.button3)

THEN {

insert: Rope.ROPE ¬ XlCutBuffers.Get[e.connection];

PaintRope[d, insert];

}

ELSE SetInputFocus[d, Cx[d, e.pos.x], Cy[d, e.pos.y]];

RETURN

};

ENDCASE => RETURN;

d.motionT ¬ e.timeStamp;

d.motionP ¬ e.pos;

--Now we either paint, or, erase

IF paint

THEN PaintSetStart[d, e.pos]

ELSE EraseSetStart[d, e.pos];

};

Xl.EventCode.buttonRelease => {

e: Xl.ButtonReleaseEvent ~ NARROW[event];

cnt: INT ¬ ORD[e.state.button1] + ORD[e.state.button2] + ORD[e.state.button3];

stop: BOOL ¬ cnt<=1; --only stop when last button is released

Motion[d, e.timeStamp, e.pos, stop];

IF stop THEN {

d.buttonModeFancy ¬ FALSE;

IF d.buttonMode=$focus THEN {

d.buttonMode ¬ $normal;

TrackInvertButtons[d];

};

Xl.EventCode.motionNotify => {

e: Xl.MotionNotifyEvent ~ NARROW[event];

Motion[d, e.timeStamp, e.pos, FALSE];

};

Xl.EventCode.keyPress => {

char: CHAR; keysym: Xl.KeySym; matched: Xl.KeySym; isModifier: BOOL;

e: Xl.KeyPressEvent ~ NARROW[event];

[char: char, keysym: keysym, matched: matched, isModifier: isModifier] ¬ XlAscii.Convert[e.connection, e.keyCode, e.state, listOfSpecials];

IF isModifier THEN RETURN;

SELECT matched FROM

KeySymsSun.Paste, KeySymsOSF.Paste, KeySymsHP.Paste => {

insert: Rope.ROPE ¬ XlCutBuffers.Get[e.connection];

PaintRope[d, insert];

};

ENDCASE => {

SELECT char FROM

'\l => AdvanceLine[d, TRUE];

'\r => AdvanceLine[d, FALSE];

ENDCASE => PaintRope[d, Rope.FromChar[char]];

};

ENDCASE => {};

};

InstallBitmap: <<unmonitored: widget initialization>> PROC [d: Data, bitmap: XlBitmap.Bitmap] = {

<<NOTE: tip notifier not yet active>>

ChooseThickness[d, 1];

ChooseFont[d, defaultFontData];

ChooseColor[d, defaultColorData];

ChooseFollow[d, defaultFollowData];

ResetBM[d, bitmap];

d.inputfocusY ¬ d.bitmapSize.height;

AdvanceLine[d, TRUE];

};

InvertButtonsButtonHit: XTkWidgets.ButtonHitProcType = {

d: Data ~ NARROW[registerData];

SELECT d.buttonMode FROM

$normal => d.buttonMode ¬ IF d.buttonModeFancy THEN $focus ELSE $inverted;

$inverted => d.buttonMode ¬ IF d.buttonModeFancy THEN $focus ELSE $normal;

ENDCASE => d.buttonMode ¬ $normal;

d.buttonModeFancy ¬ NOT d.buttonModeFancy;

TrackInvertButtons[d];

};

TrackInvertButtons: PROC [d: Data] = {

invertMouseWidget: Widget ¬ d.invertMouseWidget;

IF invertMouseWidget#NIL THEN {

text: Rope.ROPE;

SELECT d.buttonMode FROM

$normal => text ¬ "painting";

$inverted => text ¬ "erasing";

$focus => text ¬ "focus";

ENDCASE => {};

XTkWidgets.SetText[invertMouseWidget, text]

};

ThicknessButtonHit: XTkWidgets.ButtonHitProcType = {

d: Data ~ NARROW[registerData];

width: INT ~ NARROW[callData, REF INT];

ChooseThickness[d, width];

};

ClearPageButtonHit: <<tq>> XTkWidgets.ButtonHitProcType = {

d: Data ~ NARROW[registerData];

page: Page ¬ LocalActivePage[d];

IF page=NIL

THEN IO.PutRope[d.log, "No active page\n"]

ELSE {

ImagerSample.Clear[XlBitmap.GetSM[page.activeArea]];

XlBitmap.Refresh[page.activeArea];

}

};

Bind: PROC [d: Data, i: Instance] = {

d.instance ¬ i;

i.uiPrivate ¬ d;

d.log ¬ i.log;

i.shell ¬ d.shellWidget;

i.surface ¬ d.realBitmapWidget;

InstallBitmap[d, i.session.activePage.activeArea];

InitPages[d];

XTkSharedCell.BindText[d.instance.session.nameCell, d.sname];

Slate.CallGlobalEvent[i, i.session, $UICreated];

PageHasBeenActivated[instance: i, session: i.session, callData: NIL, registerData: NIL, event: NIL];

};

DoSharedTool: PROC [session: Session, server: REF, log: IO.STREAM] = {

instance: Instance ¬ NewInstance[session];

d: Data ← CreateSlateWidget[];

XTkWidgets.BindScreenShell[d.shellWidget, server ! Xl.connectionNotCreated => {

IO.PutRope[log, Rope.Concat["Failed: ", why.reason]];

GOTO oops

}];

Bind[d, instance];

XTkWidgets.RealizeShell[d.shellWidget];

IO.PutRope[log, " Slate tool created\n"];

EXITS oops => {};

};

GetTQ: PROC [instance: Instance] RETURNS [Xl.TQ] = {

RETURN [NARROW[instance.uiPrivate, Data].tq]

};

NewInstanceTool: PUBLIC PROC [session: Session, server: REF] RETURNS [instance: Instance] =

BEGIN

d: Data ← CreateSlateWidget[];

XTkWidgets.BindScreenShell[d.shellWidget, server ! Xl.connectionNotCreated => {

IO.PutRope[session.debugLog, Rope.Concat["Failed: ", why.reason]];

GOTO oops

}];

instance ¬ NewInstance[session];

Bind[d, instance];

XTkWidgets.RealizeShell[d.shellWidget];

IO.PutRope[session.debugLog, " Slate tool created\n"];

EXITS oops => {};

END;

SelectSessionButtonHit: XTkWidgets.ButtonHitProcType = {

instance: Slate.Instance ~ NARROW[registerData];

session: Session ¬ instance.session;

globalLastSession ¬ session;

};

DeleteAllPagesButtonHit: XTkWidgets.ButtonHitProcType = {

d: Data ~ NARROW[registerData];

bpp: NAT ¬ IF IsColorWidget[d.shellWidget] THEN 8 ELSE 1;

session: Session ¬ d.instance.session;

newPage: Page ¬ NewPage[session: session, bpp: bpp];

EachPage: PageProc = {

IF page#newPage AND page#NIL THEN RemovePage[page];

};

ActivatePage[newPage];

[] ¬ EnumeratePages[session, EachPage];

};

DeletePageButtonHit: XTkWidgets.ButtonHitProcType = {

d: Data ~ NARROW[registerData];

session: Session ¬ d.instance.session;

delete: Page ¬ LocalActivePage[d];

pages: LIST OF Page ¬ CurrentListOfPages[session];

IF pages#NIL THEN {

nextPage: Page ¬ pages.first;

IF pages.rest=NIL THEN {

IO.PutRope[d.log, "must keep one page\n"];

RETURN

};

FOR list: LIST OF Page ¬ pages, list.rest WHILE list#NIL DO

IF list.first=delete THEN {

IF list.rest#NIL THEN {nextPage ¬ list.rest.first};

EXIT;

};

ENDLOOP;

IF nextPage=delete THEN nextPage ¬ NIL;

ActivatePage[nextPage];

IF delete#NIL THEN RemovePage[delete];

};

EraserExplanation: PROC [d: Data] RETURNS [Rope.ROPE] = {

RETURN [IO.PutFR1[" (%4g)", IO.int[-d.eraserWidth]]]

};

CreateSharedToolMenu: XTkPopUps.CreateWidgetProc = {

in: REF InstName ~ NARROW[closureData];

menu: Widget ~ XTkWidgets.CreateYStack[];

OneChild: PROC [text: Rope.ROPE, key: REF ¬ NIL] = {

child: Widget ¬ XTkWidgets.CreateButton[text: text, hitProc: SharedToolButtonHit, registerData: in, callData: key];

XTkWidgets.AppendChild[menu, child];

};

OneChild["Same X server", NIL];

OneChild["Using name field", $sharedWidget];

RETURN [menu];

};

SharedToolButtonHit: XTkWidgets.ButtonHitProcType = {

server: REF ANY;

in: REF InstName ~ NARROW[registerData];

WITH callData SELECT FROM

a: ATOM =>{

server ¬ XTkWidgets.GetText[in.name];

};

ENDCASE => server ¬ widget.connection;

DoSharedTool[in.instance.session, server, in.instance.log];

};

ChooseThickness: PROC [d: Data, width: INT] = {

d.imageMode.thickness ¬ width ¬ MIN[MAX[width, 1], 200];

d.eraserWidth ¬ MAX[width, 3]*3 + 3;

d.eraseMinimum ¬ d.eraserWidth/10+1.5;

UseThickness[d];

TrackThickness[d];

};

UseThickness: PROC [d: Data] = {

IF d.context#NIL THEN {

Imager.SetStrokeWidth[d.context, d.imageMode.thickness];

};

IF d.directPaintGC#NIL THEN {

Xl.SetGCLineWidth[d.directPaintGC, d.imageMode.thickness];

Xl.SetGCLineWidth[d.directEraseGC, d.eraserWidth];

};

TrackThickness: PROC [d: Data] = {

eraserWidthWidget: Widget ¬ d.eraserWidthWidget;

IF eraserWidthWidget#NIL THEN

XTkWidgets.SetText[eraserWidthWidget, EraserExplanation[d]]

};

ChooseFont: PROC [d: Data, fd: REF FontData] = {

ENABLE Imager.Error => GOTO Oops;

font: Imager.Font; e: ImagerFont.Extents;

d.currentFontData ¬ fd;

font ¬ ImagerFont.Scale[ImagerFont.Find[fd.realName, substituteQuietly], fd.scale];

e ¬ ImagerFont.FontBoundingBox[font];

d.imageMode.font ← font;

d.imageMode.requiredLineHeight ¬ Real.Ceiling[e.descent + e.ascent + e.ascent / 5];

TrackFont[d];

EXITS Oops => {};

};

UseFont: PROC [d: Data] = {

};

TrackFont: PROC [d: Data] = {

fd: REF FontData ¬ d.currentFontData;

fonts: Widget ¬ d.fonts;

IF fonts#NIL THEN

XTkWidgets.SetText[fonts, Rope.Cat["Font: ", fd.presentName, " "]];

};

ParticipantsButtonHit: XTkWidgets.ButtonHitProcType = {

instance: Slate.Instance ~ NARROW[registerData];

log: IO.STREAM ~ instance.log;

Each: InstanceProc = {

WITH instance.uiPrivate SELECT FROM

d: Data => {

c: Xl.Connection ← d.shellWidget.connection;

IF Xl.Alive[c]

THEN {

IO.PutRope[log, Xl.ServerName[c]];

IO.PutRope[log, " "]

}

ELSE {IO.PutRope[log, "dead-server "]}

};

ENDCASE => {IO.PutRope[log, "unknown-server "]}

};

[] ← EnumerateInstances[instance.session, Each];

IO.PutRope[log, "\n"];

};

ActivatePageButtonHit: XTkWidgets.ButtonHitProcType = {

d: Data ~ NARROW[registerData];

page: Page ~ NARROW[callData];

IF page#NIL THEN

IF d.followMode.follow

THEN ActivatePage[page]

ELSE LocalActivatePage[d, page];

};

NewPageWithSize: PROC [d: Data, sz: SF.Vec ¬ [0, 0]] = {

bpp: NAT ¬ IF IsColorWidget[d.shellWidget] THEN 8 ELSE 1;

page: Page ¬ Slate.NewPage[session: d.instance.session, bpp: bpp, sz: sz];

IF d.followMode.follow

THEN ActivatePage[page]

ELSE LocalActivatePage[d, page];

};

PageSizeHit: XTkWidgets.ButtonHitProcType = {

d: Data ~ NARROW[registerData];

[] ¬ PropList.PutProp[d.instance.properties, $PageSize, callData]

};

GetPageSizeKey: PROC [instance: Slate.Instance] RETURNS [REF ANY] = {

x: REF ANY ¬ PropList.GetProp[instance.properties, $PageSize];

IF x=NIL THEN x ¬ $small;

RETURN [x]

};

NewPageHit: XTkWidgets.ButtonHitProcType = {

largeSz: SF.Vec ¬ [768, 1024];

sz: SF.Vec ¬ [0, 0];

d: Data ~ NARROW[registerData];

SELECT GetPageSizeKey[d.instance] FROM

$small => sz ¬ [0, 0];

$large => sz ¬ largeSz;

ENDCASE => {};

NewPageWithSize[d, sz];

};

SafeHit: XTkWidgets.ButtonHitProcType = {

d: Data ~ NARROW[registerData];

instance: Slate.Instance ~ d.instance;

fileName: Rope.ROPE;

WITH PropList.GetProp[instance.properties, $SafeName] SELECT FROM

r: Rope.ROPE => fileName ¬ r;

ENDCASE => fileName ¬ "/tmp/temp.slate";

SlateIO.WriteSlateFile[pages: Slate.CurrentListOfPages[instance.session], fileName: fileName, log: instance.log, server: widget.connection]

};

TrackPageSize: PROC [d: Data, w: XTk.Widget] = {

XTkWidgets.Choose[w, [callData: GetPageSizeKey[d.instance]]]

};

globalLastSession: Session ¬ NIL;

MakeOrGetSession: PROC [get: BOOL ¬ FALSE, bpp: INT ¬ 1, name: Rope.ROPE] RETURNS [session: Session ¬ NIL] = {

stream: IO.STREAM ¬ debugStream;

IF get THEN session ¬ globalLastSession;

IF session=NIL THEN {

page: Page;

IF name#NIL THEN {

parameter: REF REF ANY ¬ NEW[REF ANY ¬ name];

Slate.CallGlobalEvent[event: $FindSession, callData: parameter];

WITH parameter SELECT FROM

s: Session => {globalLastSession ¬ s; RETURN [s]};

ENDCASE => {};

};

session ¬ NewSession[];

page ¬ NewPage[session: session, bpp: bpp];

ActivatePage[page];

IF stream#NIL THEN {

FanoutStream.AddSlave[session.debugLog, stream];

};

IF name#NIL THEN Slate.SetSessionName[session, name];

globalLastSession ¬ session;

};

debugStream: IO.STREAM ¬ NIL;

SlateCommand: Commander.CommandProc = {

instance: Instance;

session: Session;

d: Data;

n: INT ← 0;

bpp: INT ← 1;

color: BOOL ← FALSE;

createInstance: BOOL ← TRUE;

display: Rope.ROPE ← NIL;

sessionName: Rope.ROPE ← NIL;

arg: Rope.ROPE ← CommanderOps.NextArgument[cmd];

MatchPrefix: PROC [s: LONG STRING] RETURNS [BOOL] ~ {

run: INT ~ Rope.Run[s1: arg, s2: ConvertUnsafe.ToRope[s], case: FALSE];

RETURN [run = Rope.Size[arg] AND run > 1];

};

BadSwitch: PROC = {

CommanderOps.Failed[Rope.Cat["Unknown or ambiguous argument: " , arg, helpMessage]]

};

IF arg=NIL THEN EXIT;

SELECT TRUE FROM

MatchPrefix["-color"] => { color ← TRUE; bpp ← 8 };

MatchPrefix["-noInstance"] => { createInstance ← FALSE };

MatchPrefix["-debug"] => { debugStream ← cmd.out };

MatchPrefix["-session"] => { sessionName ← CommanderOps.NextArgument[cmd] };

MatchPrefix["-display"] => { display ← CommanderOps.NextArgument[cmd] };

Rope.Match["-*", arg] => { BadSwitch[] };

ENDCASE => BadSwitch[];

n ← n+1;

ENDLOOP;

session ¬ MakeOrGetSession[bpp: bpp, name: sessionName];

IF createInstance THEN {

d ← CreateSlateWidget[];

IF color THEN {

XTk.PutWidgetProp[d.shellWidget, $Color, $Color];

};

XTkWidgets.BindScreenShell[d.shellWidget, display ! Xl.connectionNotCreated =>

CommanderOps.Failed[Rope.Concat["Failed: " , why.reason]]

];

instance ¬ NewInstance[session];

Bind[d, instance];

XTkWidgets.RealizeShell[d.shellWidget, [pos: [2, 2]]];

};

InitPages: PROC [d: Data] = {

EachPage: PageProc = {

IF page#NIL THEN CreatePageIndicator[d, page];

};

[] ¬ EnumeratePages[d.instance.session, EachPage];

LocalIndicate[d, d.instance.session.activePage];

};

FindPageWidget: PROC [page: Page, d: Data] RETURNS [pageIndicator: Widget ¬ NIL] = {

No back pointing properties on page: so instances are completely garbage collectable

Each: XTk.EachChild = {

IF XTk.GetWidgetProp[child, keyForPage]=page THEN {

pageIndicator ¬ child;

stop ¬ TRUE

};

IF page#NIL THEN

XTk.ShallowInternalEnumerateChildren[d.pagesCont, Each, page];

};

CreatePageIndicator: PROC [d: Data, page: Page] = {

IF page#NIL THEN {

pw: Widget;

numberText: Rope.ROPE;

WITH PropList.GetProp[page.properties, $PageNumber] SELECT FROM

ri: REF INT => numberText ¬ IO.PutFR1["%2g", IO.int[ri]];

ENDCASE => numberText ¬ "xx";

pw ¬ XTkWidgets.CreateButton[text: numberText,

hitProc: ActivatePageButtonHit, registerData: d, callData: page

];

XTk.PutWidgetProp[pw, keyForPage, page];

XTkWidgets.AppendChild[d.pagesCont, pw];

};

DestroyPageIndicator: PROC [instance: Instance, page: Page] = {

WITH instance.uiPrivate SELECT FROM

d: Data => {

pageIndicator: Widget ¬ FindPageWidget[page, d];

IF pageIndicator#NIL THEN XTk.DestroyWidget[pageIndicator]

};

ENDCASE => {};

};

NewPageHasBeenCreated: EventProc = {

--Called once per instance when new page is created

IF instance#NIL THEN

WITH instance.uiPrivate SELECT FROM

d: Data => {CreatePageIndicator[d, NARROW[callData]]};

ENDCASE => {};

};

Page numbering is not a global public feature because the file format does not keep track of permanent page numbers

pageNumberKey: REF INT ¬ NEW[INT];

InitPageNumber: PropList.InitializeProcType = {

RETURN [NEW[INT¬0]]

};

NextPageNum: PROC [session: Session] RETURNS [i: INT ¬ 0] = {

x: REF ¬ PropList.GetPropOrInit[session.properties, pageNumberKey, InitPageNumber, session].val;

rNum: REF INT ~ NARROW[x];

Monitored: PROC [rNum: REF INT] RETURNS [INT] = {

rNum ¬ rNum+1; RETURN [rNum];

};

IF rNum#NIL THEN i ¬ Monitored[rNum];

};

NewPageHasBeenCreated0: Slate.EventProc = {

--Called once per session when new page is created

page: Page ~ NARROW[callData];

IF page#NIL THEN {

num: INT ¬ NextPageNum[page.session];

[] ¬ PropList.PutProp[page.properties, $PageNumber, NEW[INT ¬ num]];

};

PageHasBeenRemoved: Slate.EventProc = {

page: Page ~ NARROW[callData];

IF page#NIL THEN

WITH instance.uiPrivate SELECT FROM

d: Data => {

IF ~d.followMode.follow AND LocalActivePage[d]=page THEN {

new: Page ¬ ActivePage[d.instance.session];

IF new=page THEN new ¬ NIL;

LocalActivatePage[d, new];

};

DestroyIndicator[d, page];

};

ENDCASE => {};

};

DestroyIndicator: PROC [d: Data, page: Page] = {

pageIndicator: Widget ¬ FindPageWidget[page, d];

IF pageIndicator#NIL THEN XTk.DestroyWidget[pageIndicator];

};

LocalIndicate: PROC [d: Data, page: Page] = {

oldIndicator: Widget ¬ d.usedPageIndicator;

newIndicator: Widget ¬ FindPageWidget[page, d];

IF oldIndicator#NIL AND oldIndicator#newIndicator THEN XTkLabels.SetStyleKey[oldIndicator, NIL];

d.usedPageIndicator ¬ newIndicator;

IF newIndicator#NIL THEN XTkLabels.SetStyleKey[newIndicator, $Gray2]

};

LocalActivePage: PROC [d: Data] RETURNS [page: Page] = {

RETURN [d.page];

};

LocalActivatePage: PROC [d: Data, page: Page] = {

IF d.page#page THEN {

d.page ¬ page;

d.hasStart ¬ FALSE;

d.mode ¬ NIL;

IF page=NIL

THEN ResetBM[d, nowhereBM]

ELSE ResetBM[d, page.activeArea];

LocalIndicate[d, page];

};

PageHasBeenActivated: Slate.EventProc = {

IF instance#NIL THEN

WITH instance.uiPrivate SELECT FROM

d: Data => IF d.followMode.follow OR d.page=NIL THEN {

LocalActivatePage[d, ActivePage[d.instance.session]];

};

ENDCASE => {};

};

ReceiveMessage: Slate.EventProc = {

IF instance#NIL THEN {

message: Rope.ROPE ¬ NARROW[callData];

IO.PutRope[instance.log, message];

};

InstName: TYPE = RECORD [instance: Slate.Instance, name: Widget];

CreateSharingWidget: Slate.EventProc = {

shell: Widget ¬ XTkWidgets.CreateShell[

className: $SlateControl,

windowHeader: "Slate Multi-User Ops",

packageName: "SlateControl",

shortName: "Slate Multi"

];

sname: Widget ¬ XTkWidgets.CreateLabel[];

tField: Widget ¬ XTkWidgets.CreateLabeledField[label: "name:", init: "???"];

in: REF InstName ~ NEW[InstName ¬ [instance, tField]];

tq: Xl.TQ ~ GetTQ[instance];

createFollowMenu: XTkPopUps.WidgetCreateClosure ¬ XTkPopUps.WidgetCreateClosureFromChoiceList[list: followChoiceList, defaultNotify: SetFollowButtonHit, notifyTQ: tq];

createSharedToolClosure: XTkPopUps.WidgetCreateClosure ¬ NEW[XTkPopUps.WidgetCreateClosureRec ¬ [CreateSharedToolMenu, in]] ;

sharedTool: Widget ~ XTkPopUps.CreatePopUpButton[

text: "SharedSlate", createMenu: createSharedToolClosure

];

participants: Widget ~ XTkWidgets.CreateButton[

text: "Participants", hitProc: ParticipantsButtonHit, registerData: instance

];

msg: Widget ~ XTkWidgets.CreateButton[

text: "Msg", hitProc: MessageHit, registerData: instance, tq: tq, callData: tField

];

windowFollow: Widget ← XTkPopUps.CreatePopUpButton[

text: "WindowFollowing", createMenu: createFollowMenu, registerData: instance

];

selectSession: Widget ~ XTkWidgets.CreateButton[

text: "SelectSession", hitProc: SelectSessionButtonHit, registerData: instance

];

nameSession: Widget ~ XTkWidgets.CreateButton[

text: "RenameSession", hitProc: RenameSessionHit, registerData: instance, callData: tField

];

xCont: Widget ~ XTkWidgets.CreateXStack[[],

LIST[sharedTool, participants, msg, selectSession, nameSession]

];

xCont2: Widget ~ XTkWidgets.CreateXStack[[],

LIST[windowFollow, sname]

];

topYCont: Widget ← XTkWidgets.CreateYStack[[], LIST[tField, xCont, xCont2]];

XTkSharedCell.BindText[

NARROW[instance.uiPrivate, Data].followTextCell,

windowFollow

];

XTkSharedCell.BindText[instance.session.nameCell, sname];

XTkWidgets.SetShellChild[shell, topYCont];

XTkWidgets.BindScreenShell[shell, callData ! Xl.connectionNotCreated => {

IO.PutRope[instance.log, Rope.Concat["Failed: ", why.reason]];

GOTO oops

}];

SlateControls.LimitLifetime[shell, instance];

XTkWidgets.RealizeShell[shell];

EXITS oops => {}

};

helpMessage: Rope.ROPE ~ "

Usage: {argument}*

argument:

-color

-debug

-noInstance

-display x-server-name

-session session-name

Slate.RegisterGlobalEventProc[$Message, ReceiveMessage, NIL];

Slate.RegisterGlobalEventProc[$AddPage, NewPageHasBeenCreated, NIL];

Slate.RegisterGlobalEventProc[$AddPage0, NewPageHasBeenCreated0, NIL];

Slate.RegisterGlobalEventProc[$RemovePage, PageHasBeenRemoved, NIL];

Slate.RegisterGlobalEventProc[$ActivatePage, PageHasBeenActivated, NIL];

InitFonts[];

InitColors[];

InitFollows[];

SlateControls.RegisterButton[$Main, "Sharing", $CreateSharing];

Slate.RegisterGlobalEventProc[$CreateSharing, CreateSharingWidget];

Commander.Register["Slate", SlateCommand, Rope.Concat["Shared drawing tool", helpMessage]];

END.