ðOberon10.Scn.Fnt Oberon10i.Scn.Fnt5ÆrOberon10b.Scn.Fnt•Z &—MODULE X11; (* rc, js 8.10.93 *) (*---------------------------------------------------------* * Copyright (c) 1990-1996 ETH Z…rich. All Rights Reserved. * Oberon is a trademark of Institut f…r Computersysteme, ETH Z…rich. *---------------------------------------------------------*) (* Oberon interface to X Window System Version 11 *) IMPORT Unix, Kernel, Console, S := SYSTEM; CONST WinNameStr = "HP-Oberon (TM) 4.4a "; CopyrightStr = " Copyright (c) ETH Zurich, 1990-1995."; IconNameStr = "HP-Oberon"; BackgroundCol = 0; ForegroundCol = 15; WhiteCol = BackgroundCol; BlackCol = ForegroundCol; CONST replace* = 0; paint* = 1; invert* = 2; (* color classes *) monochrome* = 0; grayscale* = 1; color* = 2; TYPE Pixmap* = LONGINT; Pattern* = LONGINT (* = PatternPtr *); PatternPtr* = POINTER TO PatternDesc; PatternDesc* = RECORD x*, y*: LONGINT; w*, h*: INTEGER; pixmap*: Pixmap END ; MetricDesc* = RECORD dx*, x*, y*, filler: INTEGER; p*: PatternDesc END ; Font* = POINTER TO Bytes; Bytes* = RECORD metrics*: ARRAY 256 OF MetricDesc; xid*: LONGINT END ; TYPE (* X types *) Display* = LONGINT; Window* = LONGINT; Drawable* = LONGINT; GC* = LONGINT; Bool* = LONGINT; Colormap* = LONGINT; Time* = LONGINT; Atom* = LONGINT; VisualID* = LONGINT; Visual* = RECORD extData*: LONGINT; visualid*: VisualID; class*: LONGINT; redMask*, greenMask*, blueMask*: LONGINT; bitsPerRgb*, mapEntries*: LONGINT END ; VisualPtr* = POINTER TO Visual; VisualInfo* = RECORD visual*: (*VisualPtr*) LONGINT; visualID*: VisualID; screen*, depth*, class*: LONGINT; redmask*, greenmask*, bluemask*: LONGINT; colomapsize*, bitsperrgb*: LONGINT END ; Color* = RECORD pixel*: LONGINT; red*, green*, blue*: INTEGER; flags*, pad*: CHAR END ; Point* = RECORD x*, y*: INTEGER END ; Rectangle* = RECORD x*, y*, w*, h*: INTEGER END ; Cursor* = LONGINT; KeySym* = LONGINT; KeyCode* = LONGINT; Event* = RECORD type*, serial*: LONGINT; sendEvent*: Bool; display*: Display; window*, root*, subwindow*: Window; time*, x*, y*, xRoot*, yRoot*, state*, button*: LONGINT; sameScreen*, focus*: Bool; state2*: LONGINT; pad*: ARRAY 32 OF LONGINT END ; SelectionEvent* = RECORD type*, serial*: LONGINT; sendEvent*: Bool; display*: Display; requestor*: Window; selection*, target*, property*: Atom; time*: Time END ; SelectionRequestEvent* = RECORD type*, serial*: LONGINT; sendEvent*: Bool; display*: Display; owner*, requestor*: Window; selection*, target*, property*: Atom; time*: Time END ; Image* = LONGINT; ImagePtr* = POINTER TO ImageDesc; ImageDesc* = RECORD width*, height*: LONGINT; xoffset*, format*, data*: LONGINT; byteOrder*, bitmapUnit*, bitmapBitOrder*: LONGINT; bitmapPad*, depth*, bytesPerLine*, bitsPerPixel*: LONGINT; redmask*, greenmask*, bluemask*: LONGINT; obdata*, createImage*, destroyImage*, getPixel*, putPixel*, subImage*, addPixel*: LONGINT END ; ErrorEvent* = RECORD type*: LONGINT; display*: Display; resourceid*, serial*: LONGINT; errorCode*, requestCode*, minorCode*: CHAR END ; ErrorEventPtr* = POINTER TO ErrorEvent; ErrorHandler* = PROCEDURE(display: Display; err: ErrorEventPtr): LONGINT; IOErrorHandler* = PROCEDURE(display: Display): LONGINT; WindowAttributes* = RECORD x*, y*: LONGINT; (* location of window *) width*, height*: LONGINT; (* width and height of window *) borderWidth*: LONGINT; (* border width of window *) depth*: LONGINT; (* depth of window *) visual*: LONGINT; (* the address of the associated visual structure *) root*: Window; (* root of screen containing window *) class*: LONGINT; (* InputOutput, InputOnly*) bitGravity*: LONGINT; (* one of bit gravity values *) winGravity*: LONGINT; (* one of the window gravity values *) backingStore*: LONGINT; (* NotUseful, WhenMapped, Always *) backingPlanes*: LONGINT; (* planes to be preserved if possible *) backingPixel*: LONGINT; (* value to be used when restoring planes *) saveUnder*: LONGINT; (* boolean, should bits under be saved? *) colormap*: Colormap; (* color map to be associated with window *) mapInstalled*: LONGINT; (* boolean, is color map currently installed*) mapState*: LONGINT; (* IsUnmapped, IsUnviewable, IsViewable *) allEventMasks*: LONGINT; (* set of events all people have interest in*) yourEventask*: LONGINT; (* my event mask *) doNotPropagateMask*: LONGINT; (* set of events that should not propagate *) overrideRedirect*: LONGINT; (* boolean value for override-redirect *) screen*: LONGINT; (* back pointer to correct screen *) END; WindowChanges* = RECORD x*, y*: LONGINT; width*, height*: LONGINT; borderWidth*: LONGINT; sibling*: Window; stackMode*: LONGINT; END; CONST (* X constants: *) False* = 0; True* = 1; None* = 0; (* line styles: *) LineSolid* = 0; LineOnOffDash* = 1; LineDoubleDash* = 2; (* cap styles: *) CapNotLast* = 0; CapButt* = 1; CapRound* = 2; CapProjecting* = 3; (* join styles: *) JoinMiter* = 0; JoinRound* = 1; JoinBevel* = 2; (* fill styles: *) FillSolid* = 0; FillTiled* = 1; FillStippled* = 2; FillOpaqueStippled* = 3; (* functions: *) GXand* = 1; GXcopy* = 3; GXxor* = 6; GXor* = 7; GXequiv* = 9; (* color flags: *) DoRed* = 1; DoGreen* = 2; DoBlue* = 4; DoAll* = DoRed + DoGreen + DoBlue; (* for CreateColormap : *) AllocNone* = 0; AllocAll* = 1; (* QueryBestSize Class: *) CursorShape* = 0; TileShape* = 1; StippleShape* = 2; (* visual classes: *) StaticGray* = 0; GrayScale* = 1; StaticColor* = 2; PseudoColor* = 3; TrueColor* = 4; DirectColor* = 5; (* arc modes: *) ArcChord* = 0; ArcPieSlice* = 1; (* polygone shape: *) Complex* = 0; Nonconvex* = 1; Convex* = 2; (* clip odering and origin: *) CoordModeOrigin* = 0; CoordModePrevious* = 1; Unsorted* = 0; YSorted* = 1; YXSorted* = 2; YXBanded* = 3; (* property modes: *) PropModeReplace* = 0; (* events types: *) KeyPress* = 2; ButtonPress* = 4; ButtonRelease* = 5; MotionNotify* = 6; FocusIn* = 9; FocusOut* = 10; Expose* = 12; GraphicsExpose* = 13; NoExpose* = 14; UnmapNotify* = 18; MapNotify* = 19; PropertyNotify* = 28; SelectionClear* = 29; SelectionRequest* = 30; SelectionNotify* = 31; ClientMessage* = 33; MappingNotify* = 34; (* event masks: *) KeyPressMask* = 1H; ButtonPressMask* = 4H; ButtonReleaseMask* = 8H; PointerMotionMask* = 40H; PointerMotionHintMask* = 80H; ButtonMotionMask* = 2000H; ExposureMask* = 8000H; StructureNotifyMask* = 20000H; FocusChangeMask* = 200000H; PropertyChangeMask* = 400000H; OwnerGrabButtonMask* = 1000000H; (* event modes: *) QueuedAlready* = 0; QueuedAfterReading* = 1; QueuedAfterFlush* = 2; (* focus revert modes: *) RevertToParent* = 2; (* buttons: *) Button1* = 1; Button2* = 2; Button3* = 3; Button1Mask* = 100H; Button2Mask* = 200H; Button3Mask* = 400H; (* image format: *) XYBitmap* = 0; XYPixmap* = 1; ZPixmap* = 2; (* special keys: *) (* cursor shapes: *) XCleftptr* = 132; (* atoms: *) XAPRIMARY* = 1; XASTRING* = 31; VAR WinName*, IconName*, Copyright*, WinNameCopyright*: ARRAY 128 OF CHAR; display*: Display; primary*, secondary*, root*: Window; basePixel*, foreground*, background*: LONGINT; backgroundCol*, foregroundCol*: INTEGER; screen*, screenw*, screenh*, screenhmm*: LONGINT; cells*, planes*: LONGINT; visualptr*, defvisualptr*: LONGINT; cmap*, defcmap*: Colormap; Width*, Height*, Bottom*, UBottom*, ColLeft*, depth*: INTEGER; pixelValues*: ARRAY 256 OF LONGINT; function*: ARRAY 3 OF LONGINT; planesMask*: LONGINT; colorClass*: SHORTINT; (* monochrome, grayscale or color *) nofcol*: LONGINT; arrow*, noCursor*: Cursor; ErrorText*: ARRAY 80 OF CHAR; ErrorFlag*: BOOLEAN; lastEventTime*: Time; (* character cache *) ccp*: Pattern; ccf*: Font; ccch*: CHAR; ccdx*, ccx*, ccy*: INTEGER; (* line cache *) CONST LcLen* = 256; VAR lcache*: ARRAY LcLen OF CHAR; lcf*: Font; lcx0*, lcy0*, lcx*, lccol*, lcmode*, lclen*: INTEGER; (* cut and paste *) SendSelection*: PROCEDURE(VAR event: SelectionRequestEvent); ReceiveSelection*: PROCEDURE(VAR event: SelectionEvent); ClearSelection*: PROCEDURE; VAR (* Xlib calls: *) OpenDisplay-: PROCEDURE(name: LONGINT): Display; DefaultScreen-: PROCEDURE(display: Display): LONGINT; DisplayWidth-, DisplayHeight-, DisplayHeightMM-, DefaultDepth-, DisplayCells-, DisplayPlanes-, BlackPixel-, WhitePixel-: PROCEDURE(display: Display; screen: LONGINT): LONGINT; DefaultVisual-: PROCEDURE(display: Display; screen: LONGINT): LONGINT; DefaultColormap-: PROCEDURE(display: Display; screen: LONGINT): Colormap; DefaultRootWindow-: PROCEDURE(display: Display): Window; CreateSimpleWindow-: PROCEDURE(display: Display; parent: Window; x, y, width, height, borderWidth, border, background: LONGINT): Window; TranslateCoordinates-: PROCEDURE(display: Display; sw, dw: Window; srcx, srcy: LONGINT; VAR dstx, dsty: LONGINT; VAR child: Window); MoveResizeWindow-: PROCEDURE(display: Display; window: Window; x, y, width, height: LONGINT); StoreName-, SetIconName-: PROCEDURE(display: Display; window: Window; name: LONGINT); SetCommand-: PROCEDURE(display: Display; window: Window; argv, argc: LONGINT); Geometry-: PROCEDURE(display: Display; screen: LONGINT; user, default: LONGINT; bwidth, fw, fh, xpad, ypad: LONGINT; VAR x, y, w, h: LONGINT): LONGINT; MapRaised-, LowerWindow-, ClearWindow-: PROCEDURE(display: Display; window: Window); Sync-: PROCEDURE(display: Display; discard: LONGINT); Flush-: PROCEDURE(display: Display); StoreColor-: PROCEDURE(display: Display; cmap: Colormap; color: LONGINT); CreateBitmapFromData-: PROCEDURE(display: Display; drawable: Drawable; data: LONGINT; width, height: LONGINT): Pixmap; CopyArea-: PROCEDURE(display: Display; src, dest: Drawable; gc: GC; srcX, srcY, width, height, destX, destY: LONGINT); CopyPlane-: PROCEDURE(display: Display; src, dest: Drawable; gc: GC; srcX, srcY, width, height, destX, destY, plane: LONGINT); SetStipple-: PROCEDURE(display: Display; gc: GC; stipple: Pixmap); SetTSOrigin-: PROCEDURE(display: Display; gc: GC; tsxorigin, tsyorigin: LONGINT); DrawPoint-: PROCEDURE(display: Display; window: Drawable; gc: GC; x, y: LONGINT); FillRectangle-: PROCEDURE(display: Display; window: Drawable; gc: GC; x, y, width, height: LONGINT); DrawString-: PROCEDURE(display: Display; window: Drawable; gc: GC; x, y, string, length: LONGINT); CreateGC-: PROCEDURE(display: Display; drawable: Drawable; valueMask, values: LONGINT): GC; SetForeground-, SetBackground-, SetFunction-, SetFont-, SetFillStyle-: PROCEDURE(display: Display; gc: GC; arg: LONGINT); SetPlaneMask-: PROCEDURE(display: Display; gc: GC; mask: LONGINT); SetGraphicsExposures-: PROCEDURE(display: Display; gc: GC; graphicsExposures: Bool); SetLineAttributes-: PROCEDURE(display: Display; gc: GC; lineWidth, lineStyle, capStyle, joinStyle: LONGINT); AllocColorCells-: PROCEDURE(display: Display; cmap: Colormap; contig: Bool; planeMasks: LONGINT; nplanes: LONGINT; pixels: LONGINT; ncolors: LONGINT): LONGINT; SetWindowBackground-: PROCEDURE(display: Display; window: Window; pixel: LONGINT); CreateFontCursor-: PROCEDURE(display: Display; shape: LONGINT): Cursor; CreatePixmapCursor-: PROCEDURE(display: Display; csource, cmask: Pixmap; cfore, cback, xhot, yhot: LONGINT): Cursor; RecolorCursor-: PROCEDURE(display: Display; curs: Cursor; cfore, cback: LONGINT); DefineCursor-: PROCEDURE(display: Display; window: Window; curs: Cursor); DrawLine-: PROCEDURE(display: Display; window: Window; gc: GC; x1, y1, x2, y2: LONGINT); SetArcMode-: PROCEDURE(display: Display; gc: GC; arcmode: LONGINT); DrawArc-, FillArc-: PROCEDURE(display: Display; window: Window; gc: GC; x, y, width, height, angle1, angle2: LONGINT); FillPolygon-: PROCEDURE(display: Display; window: Window; gc: GC; points, npoints, shape, mode: LONGINT); SetClipMask-: PROCEDURE(display: Display; gc: GC; clipMask: Pixmap); SetClipRectangles-: PROCEDURE(display: Display; gc: GC; clipxorigin, clipyorigin, rectangles, n, ordering: LONGINT); ListFonts-: PROCEDURE(display: Display; pattern, maxnames: LONGINT; VAR count: LONGINT): LONGINT; FreeFontNames-: PROCEDURE(list: LONGINT); LoadFont-: PROCEDURE(display: Display; name: LONGINT): LONGINT; SelectInput-: PROCEDURE(display: Display; window: Window; eventMask: LONGINT); NextEvent-: PROCEDURE(display: Display; event: LONGINT); EventsQueued-: PROCEDURE(display: Display; mode: LONGINT): LONGINT; SetInputFocus-: PROCEDURE(display: Display; focus: Window; revertTo: LONGINT; time: LONGINT); LookupString-: PROCEDURE(event, buffer: LONGINT; bufsize: LONGINT; VAR keysym: KeySym; compstatus: LONGINT): LONGINT; QueryPointer-: PROCEDURE(display: Display; window: Window; VAR rw, cw: Window; VAR xr, yr, xw, yw, keysButtons: LONGINT); RefreshKeyboardMapping-: PROCEDURE(event: LONGINT); Bell-: PROCEDURE(display: Display; percent: LONGINT); RebindKeysym-: PROCEDURE(display: Display; reboundsym: KeySym; modlist: LONGINT; modlength: LONGINT; newstring: LONGINT; newlength: LONGINT); StringToKeysym-: PROCEDURE(string: LONGINT): KeySym; KeysymToString-: PROCEDURE (k: KeySym): LONGINT; CopyColormapAndFree-: PROCEDURE(display: Display; cmap: Colormap): Colormap; CreateColormap-: PROCEDURE(display: Display; window: Window; vis, alloc: LONGINT): Colormap; MatchVisualInfo-: PROCEDURE(display: Display; screen, depth, class, vinforet: LONGINT): LONGINT; SetWindowColormap-: PROCEDURE(display: Display; window: Window; cmap: Colormap); QueryBestSize-: PROCEDURE(display: Display; class: LONGINT; screen: Drawable; width, height: LONGINT; VAR w, h: LONGINT); CreatePixmap-: PROCEDURE(display: Display; drawable: Drawable; width, height, depth: LONGINT): Pixmap; FreePixmap-: PROCEDURE(display: Display; pixmap: Pixmap); CreateImage-: PROCEDURE(display: Display; visual: LONGINT; depth, format, offset, data, width, height, bitmapPad, bytesPerLine: LONGINT): Image; DestroyImage-: PROCEDURE(image: Image); SubImage-: PROCEDURE(image: Image; x, y, width, height: LONGINT): Image; GetImage-: PROCEDURE(display: Display; drawable: Drawable; x, y, width, height, planeMask, format: LONGINT): Image; GetSubImage-: PROCEDURE(display: Display; drawable: Drawable; x, y, width, height, planeMask, format: LONGINT; dstImage: Image; dstX, dstY: LONGINT): Image; PutImage-: PROCEDURE(display: Display; drawable: Drawable; gc: GC; image: Image; srcX, srcY, dstX, dstY, width, height: LONGINT); PutPixel-: PROCEDURE(image: Image; x, y, pixel: LONGINT): LONGINT; GetPixel-: PROCEDURE(image: Image; x, y: LONGINT): LONGINT; AddPixel-: PROCEDURE(image: Image; value: LONGINT); Free-: PROCEDURE(data: LONGINT); SetErrorHandler-: PROCEDURE(handler: ErrorHandler); SetIOErrorHandler-: PROCEDURE(handler: IOErrorHandler); GetErrorText-: PROCEDURE(display: Display; code, buffer, length: LONGINT); StoreBytes-: PROCEDURE(display: Display; bytes, nbytes: LONGINT); FetchBytes-: PROCEDURE(display: Display; VAR nbytes: LONGINT): LONGINT; SetSelectionOwner-: PROCEDURE(display: Display; selection: Atom; owner: Window; time: Time); GetSelectionOwner-: PROCEDURE(display: Display; selection: Atom): Window; InternAtom-: PROCEDURE(display: Display; name: LONGINT; onlyifexists: Bool): Atom; SendEvent-: PROCEDURE(display: Display; window: Window; propagate: Bool; eventmask, event: LONGINT); ConvertSelection-: PROCEDURE(display: Display; selection, target, property: Atom; requestor: Window; timestamp: Time); ChangeProperty-: PROCEDURE(display: Display; window: Window; property, type: Atom; format, mode, data, nelements: LONGINT); GetWindowProperty-: PROCEDURE(display: Display; window: Window; property: Atom; offset, length: LONGINT; delete: Bool; reqtype: Atom; VAR type: Atom; VAR format, nitems, bytesafter, prop: LONGINT); GetGeometry-: PROCEDURE (display: Display; drawable: Drawable; VAR root, x, y, width, height, orderWidth, Depth: LONGINT); GetWindowAttributes-: PROCEDURE (display: Display; window: Window; attributesAdr: LONGINT); ResizeWindow-: PROCEDURE (display: Display; window: Window; x, y: LONGINT); MoveWindow-: PROCEDURE (display: Display; window: Window; x, y: LONGINT); ConfigureWindow-: PROCEDURE (display: Display; window: Window; mask, valAdr: LONGINT); DeleteProperty-: PROCEDURE(display: Display; window: Window; property: Atom); WarpPointer-: PROCEDURE(display: Display; srcwin, dstwin: Window; srcx, srcy, srcw, srch, dstx, dsty: LONGINT); InstallColormap-: PROCEDURE (display: Display; cmap: Colormap); TYPE RGBtype = RECORD r, g, b: INTEGER END ; VAR arrowSource, arrowMask, noCursorSource, noCursorMask: Pattern; RGB: ARRAY 257 OF RGBtype; Gc: GC; (* general purpose GC *) lastcol, lastmode: INTEGER; lastfont: Font; dispnameadr, geometryadr, coption, argv, argc, visualClass: LONGINT; PROCEDURE NewPattern*(VAR image: ARRAY OF SET; class: LONGINT; width, height: INTEGER): Pattern; VAR pixmap: Pixmap; pat: PatternPtr; w, h, i, j, b, dest, srcw, destb, srci, desti: LONGINT; data: ARRAY 256*32 OF CHAR; (* 256*256 bits *) BEGIN i := 0; WHILE i < LEN(data) DO data[i] := 0X; INC(i) END ; (*QueryBestSize(display, class, primary, width, height, w, h);*) (*WHILE w < width DO w := w*2 END ;*) (*WHILE h < height DO h := h*2 END ;*) w := width; h := height; srcw := (width+31) DIV 32; (* number of words in source line *) destb := (w+7) DIV 8; (* number of bytes in dest line *) srci := (height-1)*srcw; desti := 0; WHILE srci >= 0 DO i := 0; j := 0; b := 0; dest := 0; LOOP dest := dest DIV 2; IF b IN image[srci+j+1] THEN INC(dest, 80H) END; INC(b); IF b MOD 8 = 0 THEN data[desti+i] := CHR(dest); INC(i); dest := 0; IF i >= destb THEN EXIT END END; IF b = 32 THEN b := 0; INC(j); IF j >= srcw THEN WHILE i < destb DO data[desti+i] := 0X; INC(i) END; EXIT END END END; INC(desti, destb); DEC(srci, srcw) END; pixmap := CreateBitmapFromData(display, primary, S.ADR(data[0]), w, h); IF pixmap = 0 THEN HALT(99) END ; pat := S.VAL(PatternPtr, Unix.Malloc(SIZE(PatternDesc))); pat.x := 0; pat.y := 0; pat.w := width; pat.h := height; pat.pixmap := pixmap; RETURN S.VAL(LONGINT, pat) END NewPattern; PROCEDURE RasterToPixmap*(base, width, height: LONGINT): LONGINT; VAR pixmap: Pixmap; BEGIN pixmap := CreateBitmapFromData(display, primary, base, width, height); IF pixmap = 0 THEN HALT(99) END ; RETURN pixmap END RasterToPixmap; PROCEDURE SetColor*(col, red, green, blue: INTEGER); (* 0 <= col, red, green, blue < 256 *) VAR xcol, cfore, cback: Color; error: ARRAY 15 OF CHAR; BEGIN IF colorClass = grayscale THEN green := red; blue := red END ; RGB[col+1].r := red; RGB[col+1].g := green; RGB[col+1].b := blue; IF (colorClass # monochrome) & (col >= 0) THEN xcol.red := 256*red; xcol.green := 256*green; xcol.blue := 256*blue; xcol.flags := CHR(DoAll); xcol.pixel := pixelValues[col]; IF col < nofcol THEN StoreColor(display, cmap, S.ADR(xcol)) ELSE (*error := "try oberon -c"; HALT(99)*) END ; IF ((col = BackgroundCol) OR (col = ForegroundCol)) & (arrow # 0) THEN cfore.red := 256*RGB[ForegroundCol+1].r; cfore.green := 256*RGB[ForegroundCol+1].g; cfore.blue := 256*RGB[ForegroundCol+1].b; cback.red := 256*RGB[BackgroundCol+1].r; cback.green := 256*RGB[BackgroundCol+1].g; cback.blue := 256*RGB[BackgroundCol+1].b; RecolorCursor(display, arrow, S.ADR(cfore), S.ADR(cback)) END END END SetColor; PROCEDURE GetColor*(col: INTEGER; VAR red, green, blue: INTEGER); BEGIN red := RGB[col+1].r; green := RGB[col+1].g; blue := RGB[col+1].b END GetColor; PROCEDURE FlushLCache*; VAR gc: GC; window: Window; BEGIN gc := Gc; IF lcmode = paint THEN lcmode := replace END ; (* DrawString modifies only foreground pixels, replace and paint modes work as Oberon paint mode *) IF lcmode # lastmode THEN SetFunction(display, gc, function[lcmode]); lastmode := lcmode END ; IF lccol # lastcol THEN SetForeground(display, gc, pixelValues[lccol]); lastcol := lccol END ; IF lcf # lastfont THEN SetFont(display, gc, lcf.xid); lastfont := lcf END ; IF lcy0 >= 0 THEN window := primary ELSE window := secondary; DEC(lcy0, UBottom) END ; DrawString(display, window, gc, lcx0, Height-lcy0, S.ADR(lcache), lclen); lclen := 0 END FlushLCache; PROCEDURE DoSync*; BEGIN IF lclen > 0 THEN FlushLCache END ; Sync(display, 0) END DoSync; PROCEDURE DoFlush*; BEGIN IF lclen > 0 THEN FlushLCache END ; Flush(display) END DoFlush; PROCEDURE Rebind*(keyString: ARRAY OF CHAR; VAR modifierStrings: ARRAY OF ARRAY OF CHAR; nofmod: LONGINT; to: ARRAY OF CHAR; nofchar: LONGINT); VAR modlist: ARRAY 8 OF LONGINT; i: LONGINT; BEGIN i := 0; WHILE i < nofmod DO modlist[i] := StringToKeysym(S.ADR(modifierStrings[i])); INC(i) END ; RebindKeysym(display, StringToKeysym(S.ADR(keyString)), S.ADR(modlist), nofmod, S.ADR(to), nofchar) END Rebind; PROCEDURE LinkToX; VAR xlib: LONGINT; BEGIN xlib := Unix.dlopen("libX11.sl", 0); Unix.dlsym(xlib, "XOpenDisplay", S.VAL(LONGINT, OpenDisplay)); Unix.dlsym(xlib, "XDefaultScreen", S.VAL(LONGINT, DefaultScreen)); Unix.dlsym(xlib, "XDisplayWidth", S.VAL(LONGINT, DisplayWidth)); Unix.dlsym(xlib, "XDisplayHeight", S.VAL(LONGINT, DisplayHeight)); Unix.dlsym(xlib, "XDisplayHeightMM", S.VAL(LONGINT, DisplayHeightMM)); Unix.dlsym(xlib, "XDefaultDepth", S.VAL(LONGINT, DefaultDepth)); Unix.dlsym(xlib, "XDisplayCells", S.VAL(LONGINT, DisplayCells)); Unix.dlsym(xlib, "XDisplayPlanes", S.VAL(LONGINT, DisplayPlanes)); Unix.dlsym(xlib, "XBlackPixel", S.VAL(LONGINT, BlackPixel)); Unix.dlsym(xlib, "XWhitePixel", S.VAL(LONGINT, WhitePixel)); Unix.dlsym(xlib, "XDefaultVisual", S.VAL(LONGINT, DefaultVisual)); Unix.dlsym(xlib, "XDefaultColormap", S.VAL(LONGINT, DefaultColormap)); Unix.dlsym(xlib, "XDefaultRootWindow", S.VAL(LONGINT, DefaultRootWindow)); Unix.dlsym(xlib, "XCreateSimpleWindow", S.VAL(LONGINT, CreateSimpleWindow)); Unix.dlsym(xlib, "XTranslateCoordinates", S.VAL(LONGINT, TranslateCoordinates)); Unix.dlsym(xlib, "XMoveResizeWindow", S.VAL(LONGINT, MoveResizeWindow)); Unix.dlsym(xlib, "XStoreName", S.VAL(LONGINT, StoreName)); Unix.dlsym(xlib, "XSetIconName", S.VAL(LONGINT, SetIconName)); Unix.dlsym(xlib, "XSetCommand", S.VAL(LONGINT, SetCommand)); Unix.dlsym(xlib, "XGeometry", S.VAL(LONGINT, Geometry)); Unix.dlsym(xlib, "XMapRaised", S.VAL(LONGINT, MapRaised)); Unix.dlsym(xlib, "XLowerWindow", S.VAL(LONGINT, LowerWindow)); Unix.dlsym(xlib, "XClearWindow", S.VAL(LONGINT, ClearWindow)); Unix.dlsym(xlib, "XSync", S.VAL(LONGINT, Sync)); Unix.dlsym(xlib, "XFlush", S.VAL(LONGINT, Flush)); Unix.dlsym(xlib, "XStoreColor", S.VAL(LONGINT, StoreColor)); Unix.dlsym(xlib, "XCreateBitmapFromData", S.VAL(LONGINT, CreateBitmapFromData)); Unix.dlsym(xlib, "XCopyArea", S.VAL(LONGINT, CopyArea)); Unix.dlsym(xlib, "XCopyPlane", S.VAL(LONGINT, CopyPlane)); Unix.dlsym(xlib, "XSetStipple", S.VAL(LONGINT, SetStipple)); Unix.dlsym(xlib, "XSetTSOrigin", S.VAL(LONGINT, SetTSOrigin)); Unix.dlsym(xlib, "XFillRectangle", S.VAL(LONGINT, FillRectangle)); Unix.dlsym(xlib, "XDrawPoint", S.VAL(LONGINT, DrawPoint)); Unix.dlsym(xlib, "XDrawString", S.VAL(LONGINT, DrawString)); Unix.dlsym(xlib, "XCreateGC", S.VAL(LONGINT, CreateGC)); Unix.dlsym(xlib, "XSetForeground", S.VAL(LONGINT, SetForeground)); Unix.dlsym(xlib, "XSetBackground", S.VAL(LONGINT, SetBackground)); Unix.dlsym(xlib, "XSetPlaneMask", S.VAL(LONGINT, SetPlaneMask)); Unix.dlsym(xlib, "XSetLineAttributes", S.VAL(LONGINT, SetLineAttributes)); Unix.dlsym(xlib, "XSetFunction", S.VAL(LONGINT, SetFunction)); Unix.dlsym(xlib, "XSetFont", S.VAL(LONGINT, SetFont)); Unix.dlsym(xlib, "XSetFillStyle", S.VAL(LONGINT, SetFillStyle)); Unix.dlsym(xlib, "XSetGraphicsExposures", S.VAL(LONGINT, SetGraphicsExposures)); Unix.dlsym(xlib, "XAllocColorCells", S.VAL(LONGINT, AllocColorCells)); Unix.dlsym(xlib, "XSetWindowBackground", S.VAL(LONGINT, SetWindowBackground)); Unix.dlsym(xlib, "XCreateFontCursor", S.VAL(LONGINT, CreateFontCursor)); Unix.dlsym(xlib, "XCreatePixmapCursor", S.VAL(LONGINT, CreatePixmapCursor)); Unix.dlsym(xlib, "XRecolorCursor", S.VAL(LONGINT, RecolorCursor)); Unix.dlsym(xlib, "XDefineCursor", S.VAL(LONGINT, DefineCursor)); Unix.dlsym(xlib, "XDrawLine", S.VAL(LONGINT, DrawLine)); Unix.dlsym(xlib, "XSetArcMode", S.VAL(LONGINT, SetArcMode)); Unix.dlsym(xlib, "XDrawArc", S.VAL(LONGINT, DrawArc)); Unix.dlsym(xlib, "XFillArc", S.VAL(LONGINT, FillArc)); Unix.dlsym(xlib, "XFillPolygon", S.VAL(LONGINT, FillPolygon)); Unix.dlsym(xlib, "XSetClipMask", S.VAL(LONGINT, SetClipMask)); Unix.dlsym(xlib, "XSetClipRectangles", S.VAL(LONGINT, SetClipRectangles)); Unix.dlsym(xlib, "XListFonts", S.VAL(LONGINT, ListFonts)); Unix.dlsym(xlib, "XFreeFontNames", S.VAL(LONGINT, FreeFontNames)); Unix.dlsym(xlib, "XLoadFont", S.VAL(LONGINT, LoadFont)); Unix.dlsym(xlib, "XSelectInput", S.VAL(LONGINT, SelectInput)); Unix.dlsym(xlib, "XSync", S.VAL(LONGINT, Sync)); Unix.dlsym(xlib, "XNextEvent", S.VAL(LONGINT, NextEvent)); Unix.dlsym(xlib, "XEventsQueued", S.VAL(LONGINT, EventsQueued)); Unix.dlsym(xlib, "XSetInputFocus", S.VAL(LONGINT, SetInputFocus)); Unix.dlsym(xlib, "XLookupString", S.VAL(LONGINT, LookupString)); Unix.dlsym(xlib, "XQueryPointer", S.VAL(LONGINT, QueryPointer)); Unix.dlsym(xlib, "XRefreshKeyboardMapping", S.VAL(LONGINT, RefreshKeyboardMapping)); Unix.dlsym(xlib, "XBell", S.VAL(LONGINT, Bell)); Unix.dlsym(xlib, "XRebindKeysym", S.VAL(LONGINT, RebindKeysym)); Unix.dlsym(xlib, "XStringToKeysym", S.VAL(LONGINT, StringToKeysym)); Unix.dlsym(xlib, "XKeysymToString", S.VAL(LONGINT, KeysymToString)); Unix.dlsym(xlib, "XCopyColormapAndFree", S.VAL(LONGINT, CopyColormapAndFree)); Unix.dlsym(xlib, "XCreateColormap", S.VAL(LONGINT, CreateColormap)); Unix.dlsym(xlib, "XMatchVisualInfo", S.VAL(LONGINT, MatchVisualInfo)); Unix.dlsym(xlib, "XSetWindowColormap", S.VAL(LONGINT, SetWindowColormap)); Unix.dlsym(xlib, "XQueryBestSize", S.VAL(LONGINT, QueryBestSize)); Unix.dlsym(xlib, "XCreatePixmap", S.VAL(LONGINT, CreatePixmap)); Unix.dlsym(xlib, "XFreePixmap", S.VAL(LONGINT, FreePixmap)); Unix.dlsym(xlib, "XCreateImage", S.VAL(LONGINT, CreateImage)); Unix.dlsym(xlib, "XDestroyImage", S.VAL(LONGINT, DestroyImage)); Unix.dlsym(xlib, "XSubImage", S.VAL(LONGINT, SubImage)); Unix.dlsym(xlib, "XGetImage", S.VAL(LONGINT, GetImage)); Unix.dlsym(xlib, "XGetSubImage", S.VAL(LONGINT, GetSubImage)); Unix.dlsym(xlib, "XPutImage", S.VAL(LONGINT, PutImage)); Unix.dlsym(xlib, "XPutPixel", S.VAL(LONGINT, PutPixel)); Unix.dlsym(xlib, "XGetPixel", S.VAL(LONGINT, GetPixel)); Unix.dlsym(xlib, "XAddPixel", S.VAL(LONGINT, AddPixel)); Unix.dlsym(xlib, "XFree", S.VAL(LONGINT, Free)); Unix.dlsym(xlib, "XSetErrorHandler", S.VAL(LONGINT, SetErrorHandler)); Unix.dlsym(xlib, "XSetIOErrorHandler", S.VAL(LONGINT, SetIOErrorHandler)); Unix.dlsym(xlib, "XGetErrorText", S.VAL(LONGINT, GetErrorText)); Unix.dlsym(xlib, "XStoreBytes", S.VAL(LONGINT, StoreBytes)); Unix.dlsym(xlib, "XFetchBytes", S.VAL(LONGINT, FetchBytes)); Unix.dlsym(xlib, "XSetSelectionOwner", S.VAL(LONGINT, SetSelectionOwner)); Unix.dlsym(xlib, "XGetSelectionOwner", S.VAL(LONGINT, GetSelectionOwner)); Unix.dlsym(xlib, "XInternAtom", S.VAL(LONGINT, InternAtom)); Unix.dlsym(xlib, "XSendEvent", S.VAL(LONGINT, SendEvent)); Unix.dlsym(xlib, "XConvertSelection", S.VAL(LONGINT, ConvertSelection)); Unix.dlsym(xlib, "XChangeProperty", S.VAL(LONGINT, ChangeProperty)); Unix.dlsym(xlib, "XGetWindowProperty", S.VAL(LONGINT, GetWindowProperty)); Unix.dlsym(xlib, "XDeleteProperty", S.VAL(LONGINT, DeleteProperty)); Unix.dlsym(xlib, "XWarpPointer", S.VAL(LONGINT, WarpPointer)); Unix.dlsym(xlib, "XInstallColormap", S.VAL(LONGINT, InstallColormap)); Unix.dlsym(xlib, "XGetGeometry", S.VAL(LONGINT, GetGeometry)); Unix.dlsym(xlib, "XGetWindowAttributes", S.VAL(LONGINT, GetWindowAttributes)); Unix.dlsym(xlib, "XMoveWindow", S.VAL(LONGINT, MoveWindow)); Unix.dlsym(xlib, "XResizeWindow", S.VAL(LONGINT, ResizeWindow)); Unix.dlsym(xlib, "XConfigureWindow", S.VAL(LONGINT, ConfigureWindow)); Unix.dlsym(0, "dispnameadr", dispnameadr); Unix.dlsym(0, "geometryadr", geometryadr); Unix.dlsym(0, "coption", coption); Unix.dlsym(0, "argv", argv); Unix.dlsym(0, "argc", argc) END LinkToX; PROCEDURE InitNames; VAR i, j: INTEGER; BEGIN WinName := WinNameStr; IconName := IconNameStr; Copyright := CopyrightStr; WinNameCopyright := WinNameStr; i := 0; WHILE WinNameCopyright[i] # 0X DO INC(i) END ; j := 0; REPEAT WinNameCopyright[i] := Copyright[j]; INC(i); INC(j) UNTIL Copyright[j-1] = 0X END InitNames; PROCEDURE OpenDisp; VAR child: Window; flagmask, fd: LONGINT; event: Event; gRoot, gX, gY, gW, gH, gBW, gD, offset: LONGINT; conf: WindowChanges; defgeo: ARRAY 64 OF CHAR; i: INTEGER; PROCEDURE Int(n: LONGINT); VAR j: INTEGER; BEGIN j := 64; WHILE n > 0 DO DEC(j); defgeo[j] := CHR(n MOD 10 + 48); n := n DIV 10 END ; WHILE j < 64 DO defgeo[i] := defgeo[j]; INC(i); INC(j) END; END Int; BEGIN display := OpenDisplay(dispnameadr); IF display = 0 THEN Console.Str("Cannot open display"); Console.Ln; Unix.Exit(1) END ; S.GET(display+8, fd); Kernel.readSet.w[fd DIV 32] := S.VAL(LONGINT, S.VAL(SET,Kernel.readSet.w[fd DIV 32]) + S.VAL(SET,S.LSH (1,fd MOD 32))); screen := DefaultScreen(display); screenw := DisplayWidth(display, screen); screenh := DisplayHeight(display, screen); screenhmm := DisplayHeightMM(display, screen); depth := SHORT(DefaultDepth(display, screen)); visualptr := DefaultVisual(display, screen); defvisualptr := visualptr; cmap := DefaultColormap(display, screen); defcmap := cmap; cells := DisplayCells(display, screen); planes := DisplayPlanes(display, screen); IF ForegroundCol = BlackCol THEN foreground := BlackPixel(display, screen); background := WhitePixel(display, screen) ELSE foreground := WhitePixel(display, screen); background := BlackPixel(display, screen) END ; root := DefaultRootWindow(display); i := 0; Int(screenw); defgeo[i] := "x"; INC(i); Int(screenh); defgeo[i] := "+"; INC(i); Int(8); defgeo[i] := "+"; INC(i); Int(32); defgeo[i] := 0X; flagmask := Geometry(display, screen, geometryadr, S.ADR(defgeo), 0, 1, 1, 0, 0, gX, gY, gW, gH); primary := CreateSimpleWindow(display, root, gX, gY, gW, gH, 0, foreground, background); StoreName(display, primary, S.ADR(WinNameCopyright)); SetIconName(display, primary, S.ADR(IconName)); SetCommand(display, primary, argv, argc); SelectInput(display, primary, ExposureMask); MapRaised(display, primary); REPEAT NextEvent(display, S.ADR(event)) UNTIL (event.type = Expose) & (event.window = primary); GetGeometry (display, primary, gRoot, gX, gY, gW, gH, gBW, gD); IF gW MOD 8 # 0 THEN DEC (gW, gW MOD 8); ResizeWindow (display, primary, gW, gH); REPEAT NextEvent(display, S.ADR(event)) UNTIL (event.type = Expose) & (event.window = primary); END; Width := SHORT(gW); Height := SHORT(gH); Bottom := 0; UBottom := -Height; (* pixmap cannot be larger than screen: *) IF gW > screenw THEN gW := SHORT(screenw) END ; IF gH > screenh THEN gH := SHORT(screenh) END ; secondary := CreatePixmap(display, primary, gW, gH, depth) END OpenDisp; PROCEDURE CreateColors; VAR col: INTEGER; planeMasks: ARRAY 8 OF LONGINT; visualInfo: VisualInfo; vis: VisualPtr; BEGIN col := 0; WHILE col < 256 DO pixelValues[col] := col; INC(col) END ; IF (coption = 0) & (depth <= 4) THEN colorClass := monochrome ELSIF MatchVisualInfo(display, screen, depth, PseudoColor, S.ADR(visualInfo)) = 1 THEN colorClass := color; visualptr := visualInfo.visual ELSIF MatchVisualInfo(display, screen, depth, GrayScale, S.ADR(visualInfo)) = 1 THEN colorClass := grayscale; visualptr := visualInfo.visual ELSE colorClass := monochrome END ; IF colorClass = monochrome THEN ColLeft := Width; nofcol := 2; basePixel := S.VAL(LONGINT, S.VAL(SET, foreground) * S.VAL(SET, background)); planesMask := S.VAL(LONGINT, S.VAL(SET, foreground) / S.VAL(SET, background)); colorClass := monochrome; pixelValues[BackgroundCol] := background; pixelValues[ForegroundCol] := foreground; col := 1; WHILE col <= 14 DO pixelValues[col] := foreground; INC(col) END ELSE ColLeft := 0; vis := S.VAL(VisualPtr, visualptr); IF coption = 1 THEN nofcol := vis.mapEntries; cmap := CreateColormap(display, primary, visualptr, AllocAll); SetWindowColormap(display, primary, cmap); basePixel := 0; planesMask := ASH(1, depth) - 1 ELSE nofcol := 16; IF AllocColorCells(display, cmap, False, S.ADR(planeMasks), 4, S.ADR(basePixel), 1) = 0 THEN Console.Str("Not enough color cells for Oberon"); Console.Ln; Console.Str("Try oberon -c to allocate a private colormap"); Console.Ln; Unix.Exit(1) END ; col := 0; planesMask := 0; WHILE col < 4 DO planesMask := planesMask + planeMasks[col]; INC(col) END ; col := 0; WHILE col < 16 DO pixelValues[col] := basePixel + (col MOD 2) * planeMasks[0] + (col DIV 2 MOD 2) * planeMasks[1] + (col DIV 4 MOD 2) * planeMasks[2] + (col DIV 8 MOD 2) * planeMasks[3]; INC(col) END END ; foreground := pixelValues[ForegroundCol]; background := pixelValues[BackgroundCol]; SetWindowBackground(display, primary, background); ClearWindow(display, primary) END END CreateColors; PROCEDURE CreateGc; BEGIN function[replace] := GXcopy; function[paint] := GXor; (* not used *) (* drawing in invert mode with BackgroundCol on BackgroundCol is a no-op: *) IF S.VAL(SET, background) * S.VAL(SET, planesMask) # {} THEN function[invert] := GXequiv ELSE function[invert] := GXxor END ; Gc := CreateGC(display, primary, 0, 0); IF Gc = 0 THEN Console.Str("Cannot create X graphic context"); Console.Ln; Unix.Exit(1) END ; SetPlaneMask(display, Gc, planesMask); SetGraphicsExposures(display, Gc, True); SetBackground(display, Gc, background); lastcol := -1; lastmode := -1; lastfont := NIL END CreateGc; PROCEDURE InitColors*; VAR col: INTEGER; BEGIN IF colorClass = grayscale THEN IF BlackCol < WhiteCol THEN col := BlackCol; WHILE col <= WhiteCol DO SetColor(col, 17*col, 0, 0); INC(col) END ELSE col := WhiteCol; WHILE col <= BlackCol DO SetColor(col, 255 - 17*col, 0, 0); INC(col) END END ELSE SetColor(BlackCol, 0, 0, 0); (*black*) SetColor(1, 255, 0, 0); (*red*) SetColor(2, 0, 255, 0); (*green*) SetColor(3, 0, 0, 255); (*blue*) SetColor(4, 255, 0, 255); (*magenta*) SetColor(5, 255, 255, 0); (*yellow*) SetColor(6, 0, 255, 255); (*cyan*) SetColor(7, 170, 0, 0); SetColor(8, 0, 153, 0); SetColor(9, 0, 0, 153); SetColor(10, 119, 0, 204); SetColor(11, 187, 136, 0); SetColor(12, 136, 136, 136); SetColor(13, 170, 170, 170); SetColor(14, 204, 204, 204); SetColor(WhiteCol, 255, 255, 255); (*white*) END END InitColors; PROCEDURE CreatePatterns; VAR image: ARRAY 17 OF SET; i: INTEGER; BEGIN image[1] := {}; image[2] := {13}; image[3] := {12..14}; image[4] := {11..13}; image[5] := {10..12}; image[6] := {9..11}; image[7] := {8..10}; image[8] := {1, 7..9}; image[9] := {1, 2, 6..8}; image[10] := {1..3, 5..7}; image[11] := {1..6}; image[12] := {1..5}; image[13] := {1..6}; image[14] := {1..7}; image[15] := {1..8}; image[16] := {}; arrowSource := NewPattern(image, CursorShape, 16, 16); image[1] := {13}; image[2] := {12..14}; image[3] := {11..15}; image[4] := {10..14}; image[5] := {9..13}; image[6] := {8..12}; image[7] := {0..1, 7..11}; image[8] := {0..2, 6..10}; image[9] := {0..3, 5..9}; image[10] := {0..8}; image[11] := {0..7}; image[12] := {0..6}; image[13] := {0..7}; image[14] := {0..8}; image[15] := {0..9}; image[16] := {0..9}; arrowMask := NewPattern(image, CursorShape, 16, 16); i := 1; WHILE i < 17 DO image[i] := {}; INC(i) END ; noCursorSource := NewPattern(image, CursorShape, 16, 16); noCursorMask := NewPattern(image, CursorShape, 16, 16) END CreatePatterns; PROCEDURE InitCursors; VAR cfore, cback: Color; csource, cmask: PatternPtr; BEGIN cfore.red := 256*RGB[ForegroundCol+1].r; cfore.green := 256*RGB[ForegroundCol+1].g; cfore.blue := 256*RGB[ForegroundCol+1].b; cback.red := 256*RGB[BackgroundCol+1].r; cback.green := 256*RGB[BackgroundCol+1].g; cback.blue := 256*RGB[BackgroundCol+1].b; csource := S.VAL(PatternPtr, arrowSource); cmask := S.VAL(PatternPtr, arrowMask); arrow := CreatePixmapCursor(display, csource.pixmap, cmask.pixmap, S.ADR(cfore), S.ADR(cback), 1, 1); csource := S.VAL(PatternPtr, noCursorSource); cmask := S.VAL(PatternPtr, noCursorMask); noCursor := CreatePixmapCursor(display, csource.pixmap, cmask.pixmap, S.ADR(cfore), S.ADR(cback), 1, 1) END InitCursors; PROCEDURE MyErrorHandler*(display: Display; err: ErrorEventPtr): LONGINT; BEGIN ErrorFlag := TRUE; GetErrorText(display, ORD(err.errorCode), S.ADR(ErrorText), LEN(ErrorText)); RETURN 0 END MyErrorHandler; PROCEDURE MyIOErrorHandler*(display: Display): LONGINT; BEGIN ErrorFlag := TRUE; Unix.Exit(0); END MyIOErrorHandler; BEGIN Kernel.FKey[4] := InitColors; backgroundCol := BackgroundCol; foregroundCol := ForegroundCol; LinkToX; InitNames; SetIOErrorHandler(MyIOErrorHandler); OpenDisp; CreateColors; CreateGc; InitColors; CreatePatterns; InitCursors; DefineCursor(display, primary, arrow); lclen := 0; ErrorFlag := FALSE; END X11.