DIRECTORY IO, Ascii, RefText, Rope, Xl, XlCursor, XlTextWindow; XlTextWindowImpl: CEDAR MONITOR IMPORTS IO, RefText, Rope, Xl, XlCursor EXPORTS XlTextWindow = BEGIN OPEN Xl, XlTextWindow; Failed: PUBLIC ERROR = CODE; myPropKey: REF ATOM ¬ NEW[ATOM ¬ $XlTextWindowImpl]; events: EventFilter ~ CreateEventFilter[configureNotify, destroyNotify]; TextConnection: TYPE = REF TextConnectionRec; TextConnectionRec: TYPE = MONITORED RECORD [ tq: TQ ¬ NIL, --share the expose tq for texts of same connection textCursor: Xl.Cursor ¬ nullCursor, defaultFont: Font ¬ nullFont ]; InitConnection: InitializeProcType = { tcr: TextConnection ¬ NEW[TextConnectionRec]; tcr.tq ¬ CreateTQ[$XlTextWindowImpl]; tcr.textCursor ¬ XlCursor.SharedStandardCursor[c, circle]; RETURN [tcr] }; TextRecord: TYPE = MONITORED RECORD [ connection: Xl.Connection ¬ NIL, window: Window ¬ nullWindow, wSize: Size ¬ [0, 0], --size of window lineDY: INT ¬ 15, --distance between lines leftSpace: NAT ¬ 2, --distance between left border and first character x origin rightSpace: NAT ¬ 2, --distance between window right border and last characters right border topOffset, bottomOffset: NAT ¬ 2, --distance between baseline and border ascent, descent: NAT ¬ 2, bottomSpace: NAT ¬ 2, charDX: NAT ¬ 10, lineSpace: NAT ¬ 2, pos: Point ¬ [0, 0], --position for next character; not yet clipped font: Font ¬ nullFont, gc: GContext ¬ NIL, --could we somehow share gc's? alive: BOOL ¬ TRUE ]; SetWindowSize: ENTRY PROC [tRef: REF TextRecord, s: Size] = { IF tRef#NIL THEN tRef.wSize ¬ s }; TextEventProc: EventProcType = { ENABLE Xl.XError => GOTO oops; tRef: REF TextRecord ~ NARROW[clientData]; WITH event SELECT FROM destroyNotify: DestroyNotifyEvent => { IF destroyNotify.window=tRef.window THEN tRef.alive ¬ FALSE }; configureNotify: ConfigureNotifyEvent => { IF configureNotify.window=tRef.window THEN { SetWindowSize[tRef, configureNotify.geometry.size]; }; }; mapNotify: MapNotifyEvent => { IF mapNotify.window=tRef.window THEN { g: GeometryRec ¬ GetGeometry[event.connection, tRef.window]; SetWindowSize[tRef, g.geometry.size]; }; }; ENDCASE => {}; EXITS oops => {}; }; CreateTextHandle: PUBLIC PROC [] RETURNS [handle: Handle] = { tRef: REF TextRecord ¬ NEW[TextRecord]; RETURN [tRef]; }; CreateTextWindow: PUBLIC PROC [handle: Handle, c: Connection, parent: Window, geometry: Geometry, font: Font ¬ nullFont, moreMatches: MatchList ¬ NIL, depth: INTEGER ¬ -1, attributes: Attributes] = { SetupFont: PROC [tcr: TextConnection] = { ENABLE UNWIND => NULL; IF tcr.defaultFont=nullFont THEN { tcr.defaultFont ¬ Xl.OpenFont[c, "8x13"]; } }; screen: Screen ¬ QueryScreen[c, parent]; tcr: TextConnection ¬ NARROW[GetConnectionPropAndInit[c, myPropKey, InitConnection]]; tRef: REF TextRecord ¬ NARROW[handle]; IF tRef.window#nullWindow THEN ERROR; attributes.eventMask ¬ OREvents[attributes.eventMask, exposureMask, structureNotifyMask]; IF attributes.backgroundPixel=illegalPixel THEN attributes.backgroundPixel ¬ screen.whitePixel; IF font=nullFont THEN { IF tcr.defaultFont=nullFont THEN SetupFont[tcr]; font ¬ tcr.defaultFont }; tRef.connection ¬ c; tRef.font ¬ font; Xl.IncRefCount[c, tRef]; SetWindowSize[tRef, geometry.size]; BEGIN fi: REF READONLY FontInfoRec ¬ QueryFont[c, tRef.font]; tRef.ascent ¬ fi.fontAscent; tRef.descent ¬ fi.fontDescent; tRef.lineDY ¬ tRef.ascent+tRef.descent+tRef.lineSpace; tRef.charDX ¬ fi.maxBounds.charWidth; tRef.topOffset ¬ tRef.ascent+tRef.lineSpace; tRef.bottomOffset ¬ tRef.descent+tRef.bottomSpace; tRef.gc ¬ MakeGContext[c]; --should we share contexts of same parent??? SetGCForeground[tRef.gc, screen.blackPixel]; SetGCBackground[tRef.gc, screen.whitePixel]; SetGCFont[tRef.gc, font]; END; HomePos[tRef]; moreMatches ¬ CONS[ NEW[MatchRep ¬ [proc: TextEventProc, handles: events, tq: tcr.tq, data: tRef]], moreMatches ]; IF IllegalCursor[attributes.cursor] THEN attributes.cursor ¬ tcr.textCursor; tRef.window ¬ CreateWindow[c: c, matchList: moreMatches, geometry: geometry, depth: depth, attributes: attributes, parent: parent]; tRef.alive ¬ TRUE; }; ForgetWindow: PUBLIC PROC [handle: Handle] = { tRef: REF TextRecord ¬ NARROW[handle]; Xl.DecRefCount[tRef.connection, tRef]; tRef.alive ¬ FALSE; tRef.connection ¬ NIL; tRef.window ¬ Xl.nullWindow; }; GetWindow: PUBLIC PROC [handle: Handle] RETURNS [w: Xl.Window] = { tRef: REF TextRecord ¬ NARROW[handle]; RETURN [tRef.window]; }; HomePos: ENTRY PROC [tRef: REF TextRecord] = { ENABLE UNWIND => NULL; IF tRef#NIL THEN { tRef.pos.x ¬ tRef.leftSpace; tRef.pos.y ¬ tRef.topOffset; }; }; PosAndIncrement: ENTRY PROC [tr: REF TextRecord, rr: INT] RETURNS [pos: Point ¬ [0, 0]] = { ENABLE UNWIND => NULL; IF tr#NIL THEN { pos ¬ tr.pos; tr.pos.x ¬ tr.pos.x+rr; }; }; OutRope: PUBLIC PROC [handle: Handle, r: Rope.ROPE, start: INT ¬ 0, len: INT ¬ Rope.MaxLen] = { tRef: REF TextRecord ¬ NARROW[handle]; Action: Rope.ActionType = {UnflushedOutChar[tRef, c]}; IF tRef.window=nullWindow THEN RETURN; [] ¬ Rope.Map[base: r, action: Action, len: len, start: start]; Flush[tRef.connection, 200]; }; OutChar: PUBLIC PROC [handle: Handle, ch: CHAR] = { tRef: REF TextRecord ¬ NARROW[handle]; IF tRef.window=nullWindow THEN RETURN; UnflushedOutChar[tRef, ch]; Flush[tRef.connection, 200]; }; UnflushedOutChar: PROC [tRef: REF TextRecord, ch: CHAR] = { IF tRef.connection=NIL OR ~tRef.alive THEN RETURN; SELECT ch FROM Ascii.CR, Ascii.LF => { NewLine[tRef]; }; Ascii.FF => { HomePos[tRef]; ClearArea[tRef.connection, tRef.window, [0, 0], [2000, 2000], FALSE]; }; Ascii.NUL => {}; Ascii.BS => { tRef.pos.x ¬ MAX[tRef.pos.x-tRef.charDX, 0]; ClearArea[tRef.connection, tRef.window, [tRef.pos.x, MAX[tRef.pos.y, tRef.ascent]-tRef.ascent], [tRef.charDX, tRef.lineDY], FALSE]; }; ENDCASE => { pos: Point; IF INT[tRef.pos.x+tRef.charDX+tRef.rightSpace]>INT[tRef.wSize.width] AND tRef.pos.x>tRef.leftSpace THEN NewLine[tRef]; pos ¬ PosAndIncrement[tRef, tRef.charDX]; Xl.ImageChar[tRef.connection, tRef.window.drawable, pos, tRef.gc, ch]; }; }; NewLine: PROC [tr: REF TextRecord] = { mustScroll: INT ¬ AdvanceLine[tr]; IF mustScroll>0 AND tr.alive THEN { y: INT; Xl.CopyArea[c: tr.connection, src: tr.window.drawable, dst: tr.window.drawable, srcP: [0, mustScroll], dstP: [0, 0], size: [tr.wSize.width, tr.wSize.height-mustScroll], gc: tr.gc]; y ¬ MAX[tr.pos.y, tr.ascent]-tr.ascent; ClearArea[tr.connection, tr.window, [0, y], [2000, 2000]]; }; }; AdvanceLine: ENTRY PROC [tr: REF TextRecord] RETURNS [mustScroll: INT¬0] = { ENABLE UNWIND => NULL; tr.pos.y ¬ tr.pos.y+tr.lineDY; tr.pos.x ¬ tr.leftSpace; IF INT[tr.pos.y+tr.bottomOffset] > INT[tr.wSize.height] THEN { mustScroll ¬ MIN[MAX[tr.wSize.height/4, tr.lineDY], tr.wSize.height]; tr.pos.y ¬ tr.pos.y - mustScroll; } }; outputStreamProcs: REF IO.StreamProcs ¬ IO.CreateStreamProcs[ variety: $output, class: $XlTexts, putChar: OutputTextWindowStreamPutChar, putBlock: OutputTextWindowStreamPutBlock, eraseChar: OutputTextWindowStreamEraseChar ]; OutputTextWindowStreamPutChar: PROC [self: IO.STREAM, char: CHAR] = { ENABLE Xl.XError, Failed => {ERROR IO.Error[StreamClosed, self]}; tRef: REF TextRecord = NARROW[self.streamData]; IF tRef.window=nullWindow THEN RETURN; UnflushedOutChar[tRef, char]; Flush[tRef.connection, 200]; }; OutputTextWindowStreamPutBlock: PROC [self: IO.STREAM, block: REF READONLY TEXT, startIndex: NAT, count: NAT] = { ENABLE Xl.XError, Failed => {ERROR IO.Error[StreamClosed, self]}; tRef: REF TextRecord = NARROW[self.streamData]; Action: PROC[c: CHAR] RETURNS [BOOL¬FALSE] = {UnflushedOutChar[tRef, c]}; IF tRef.window=nullWindow THEN RETURN; [] ¬ RefText.Map[s: block, action: Action, len: count, start: startIndex]; Flush[tRef.connection, 200]; }; OutputTextWindowStreamEraseChar: PROC [self: IO.STREAM, char: CHAR] = { OutputTextWindowStreamPutChar[self, Ascii.BS] }; OutputStream: PUBLIC PROC [handle: Handle] RETURNS [s: IO.STREAM] = { RETURN[IO.CreateStream[streamProcs: outputStreamProcs, streamData: handle]]; }; END. BXlTextWindowImpl.mesa Copyright Σ 1988, 1989, 1990, 1991, 1992 by Xerox Corporation. All rights reserved. Christian Jacobi, July 4, 1988 1:01:32 pm PDT Christian Jacobi, March 24, 1992 3:42 pm PST --increments position but returns previous value atomicly IF ~tRef.alive THEN ERROR Failed; --scrollup --clear bottom Κ Y•NewlineDelimiter –(cedarcode) style˜codešœ™Kšœ ΟeœI™TKšœ-™-K™,—K˜šΟk œ˜ Kšžœ˜Kšœ˜Kšœ˜Kšœ˜Kšœ˜Kšœ ˜ Kšœ ˜ K˜—šΟnœžœžœ˜ Kšžœžœ˜'Kšžœ˜—šžœžœ˜K˜—KšŸœžœžœžœ˜K˜Kš œ žœžœžœžœ˜4K˜KšœH˜HK˜Kšœžœžœ˜-šœžœž œžœ˜,KšœžœžœΟc2˜AKšœ#˜#Kšœ˜K˜—K˜šŸœ˜&Kšœžœ˜-Kšœ%˜%Kšœ:˜:Kšžœ˜ Kšœ˜—K˜šœ žœž œžœ˜%Kšœžœ˜ Kšœ˜Kšœ ˜&Kšœžœ ˜*Kšœ žœ ;˜OKšœ žœ G˜\Kšœžœ &˜HKšœžœ˜Kšœ žœ˜Kšœžœ˜Kšœ žœ˜Kšœ .˜CKšœ˜Kšœžœ ˜2Kšœžœžœ˜K˜K˜—šŸ œžœžœžœ˜=Kšžœžœžœ˜Kšœ˜—K˜šŸ œ˜ Kšžœžœ˜Kšœžœžœ ˜*šžœžœž˜šœ&˜&Kšžœ"žœž˜;Kšœ˜—šœ*˜*šžœ$žœ˜,Kšœ3˜3K˜—Kšœ˜—šœ˜šžœžœ˜&Kšœ<˜žœ˜EKšœ˜—Kšœžœ˜šœžœ˜ Kšœ žœ˜,Kšœ5žœDžœ˜ƒKšœ˜—šžœ˜ Kšœ ˜ Kš žœžœ)žœžœžœ˜vKšœ)˜)KšœF˜FK˜——K˜—K˜šŸœžœžœ˜&Kšœ žœ˜"šžœžœ žœ˜#Kšœžœ˜Kšœ ™ Kšœ΄˜΄Kšœ™Kšœžœ ˜'Kšœ:˜:Kšœ˜—K˜—K˜š Ÿ œžœžœžœ žœžœ˜LKšžœžœžœ˜Kšœ˜Kšœ˜šžœžœžœžœ˜>Kšœ žœžœ1˜EKšœ!˜!K˜—Kšœ˜—K˜– "cedar" stylešœžœžœžœ˜=K– "cedar" style˜K– "cedar" stylešœ˜K– "cedar" stylešœ'˜'K– "cedar" stylešœ)˜)K– "cedar" stylešœ*˜*K– "cedar" stylešœ˜—K˜– "cedar" styleš Ÿœžœžœžœžœ˜EKšžœžœžœ˜AKšœžœžœ˜0Kšžœžœžœ˜&Kšœ˜Kšœ˜K– "cedar" stylešœ˜K– "cedar" style˜—– "cedar" stylešŸœžœžœžœ žœžœžœžœ žœ˜qKšžœžœžœ˜AKšœžœžœ˜0Kš Ÿœžœžœžœžœžœ ˜IKšžœžœžœ˜&KšœJ˜JKšœ˜K– "cedar" stylešœ˜K– "cedar" style˜—š Ÿœžœžœžœžœ˜GKšœ*žœ˜-Kšœ˜—K˜š Ÿ œžœžœžœžœžœ˜EK– "cedar" stylešžœžœC˜LK˜K˜—Kšžœ˜K˜—…—4+Ο