--- /dev/null
+arrow = "\040\000\120\000\210\000\004\001\002\002\001\004" ||
+ "\217\007\210\000\210\000\210\000\210\000\210\000" ||
+ "\210\000\370\000"
+arrow_mask = "\040\000\160\000\370\000\374\001\376\003\377\007" ||
+ "\377\007\370\000\370\000\370\000\370\000\370\000" ||
+ "\370\000\370\000"
+arrow_width = 11
+arrow_height = 14
+arrow_x = 5
+arrow_y = 1
+
+cross = "\300\003\100\002\100\002\100\002" ||
+ "\100\002\100\002\177\376\001\200" ||
+ "\001\200\177\376\100\002\100\002" ||
+ "\100\002\100\002\100\002\300\003"
+cross_mask = "\300\003\300\003\300\003\300\003" ||
+ "\300\003\300\003\377\377\377\377" ||
+ "\377\377\377\377\300\003\300\003" ||
+ "\300\003\300\003\300\003\300\003"
+cross_width = 16
+cross_height = 16
+cross_x = 8
+cross_y = 8
--- /dev/null
+% Copyright Barbara Liskov 1985
+
+x_bitmap = cluster is none, create, destroy, c2b, get_id, equal, similar, copy
+
+rep = int
+
+none = proc () returns (cvt)
+ return(0)
+ end none
+
+create = proc (width, height: int, bits: _wordvec) returns (cvt)
+ signals (error(string))
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_storebitmap
+ er.s0 := height
+ or.s1 := width
+ x_buf$send_data(w2b(bits), 1, ((width + 15) / 16) * height * 2)
+ x_buf$receive()
+ resignal error
+ return(x_buf$get_lp0())
+ end create
+
+destroy = proc (bit: cvt)
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_freebitmap
+ lr(er).l0 := bit
+ end destroy
+
+c2b = proc (font: x_font, c: char) returns (cvt) signals (error(string))
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_charbitmap
+ lr(er).l0 := f2i(font)
+ er.s2 := char$c2i(c)
+ x_buf$receive()
+ resignal error
+ return(x_buf$get_lp0())
+ end c2b
+
+get_id = proc (bit: cvt) returns (int)
+ return(bit)
+ end get_id
+
+equal = proc (bit1, bit2: cvt) returns (bool)
+ return(bit1 = bit2)
+ end equal
+
+similar = proc (bit1, bit2: cvt) returns (bool)
+ return(bit1 = bit2)
+ end similar
+
+copy = proc (bit: cvt) returns (cvt)
+ return(bit)
+ end copy
+
+end x_bitmap
--- /dev/null
+% Copyright Barbara Liskov 1985
+
+x_cursor = cluster is none, create, cons, destroy, shape,
+ get_id, equal, similar, copy
+
+rep = int
+
+none = proc () returns (cvt)
+ return(0)
+ end none
+
+create = proc (image, mask: x_bitmap, fore, back, xoff, yoff, func: int)
+ returns (cvt) signals (error(string))
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_storecursor + (func * 2**8)
+ lr(er).l0 := b2i(image)
+ er.s2 := fore
+ or.s3 := back
+ lr(er).l2 := b2i(mask)
+ er.s6 := xoff
+ or.s7 := yoff
+ x_buf$receive()
+ resignal error
+ return(x_buf$get_lp0())
+ end create
+
+cons = proc (width, height: int, image, mask: _wordvec, fore, back: int,
+ xoff, yoff, func: int) returns (x_cursor) signals (error(string))
+ z: int := ((width + 15) / 16) * height * 2
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_storebitmap
+ er.s0 := height
+ or.s1 := width
+ x_buf$send_data(w2b(image), 1, z)
+ if _wordvec$size(mask) ~= 0
+ then or, er := x_buf$get()
+ er.code := x_storebitmap
+ er.s0 := height
+ or.s1 := width
+ x_buf$send_data(w2b(mask), 1, z)
+ end
+ x_buf$receive()
+ except when error (why: string):
+ if _wordvec$size(mask) ~= 0
+ then x_buf$receive()
+ resignal error
+ end
+ end
+ img: x_bitmap := _cvt[int, x_bitmap](x_buf$get_lp0())
+ msk: x_bitmap := _cvt[int, x_bitmap](0)
+ if _wordvec$size(mask) ~= 0
+ then x_buf$receive()
+ resignal error
+ msk := _cvt[int, x_bitmap](x_buf$get_lp0())
+ end
+ cursor: x_cursor := create(img, msk, fore, back, xoff, yoff, func)
+ resignal error
+ x_bitmap$destroy(img)
+ if _wordvec$size(mask) ~= 0
+ then x_bitmap$destroy(msk) end
+ return(cursor)
+ end cons
+
+destroy = proc (cursor: cvt)
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_freecursor
+ lr(er).l0 := cursor
+ end destroy
+
+shape = proc (width, height: int) returns (int, int) signals (error(string))
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_queryshape + (CursorShape * 2**8)
+ er.s0 := height
+ or.s1 := width
+ x_buf$receive()
+ resignal error
+ return(x_buf$get_sp1(), x_buf$get_sp2())
+ end shape
+
+get_id = proc (cursor: cvt) returns (int)
+ return(cursor)
+ end get_id
+
+equal = proc (cursor1, cursor2: cvt) returns (bool)
+ return(cursor1 = cursor2)
+ end equal
+
+similar = proc (cursor1, cursor2: cvt) returns (bool)
+ return(cursor1 = cursor2)
+ end similar
+
+copy = proc (cursor: cvt) returns (cvt)
+ return(cursor)
+ end copy
+
+end x_cursor
--- /dev/null
+% Copyright Barbara Liskov 1985
+
+x_font = cluster is create, destroy, query, widths, width, all_widths,
+ get_id, equal, similar, copy
+
+rep = int
+
+create = proc (name: string) returns (cvt) signals (error(string))
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_getfont
+ er.s0 := string$size(name)
+ x_buf$send_data(s2b(name), 1, string$size(name))
+ x_buf$receive()
+ resignal error
+ return(x_buf$get_lp0())
+ end create
+
+destroy = proc (font: cvt)
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_freefont
+ lr(er).l0 := font
+ end destroy
+
+% returns (avg_width, height, first_char, last_char, baseline, fixedwidth)
+
+query = proc (font: cvt) returns (int, int, char, char, int, bool)
+ signals (error(string))
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_queryfont
+ lr(er).l0 := font
+ x_buf$receive()
+ resignal error
+ return(x_buf$get_sp1(), x_buf$get_sp0(),
+ char$i2c(x_buf$get_sp2()), char$i2c(x_buf$get_sp3()),
+ x_buf$get_sp4(), x_buf$get_sp5() ~= 0)
+ end query
+
+widths = iter (font: cvt, s: string) yields (char, int) signals (error(string))
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_charwidths
+ lr(er).l0 := font
+ er.s2 := string$size(s)
+ x_buf$send_data(s2b(s), 1, string$size(s))
+ x_buf$receive()
+ resignal error
+ b: _bytevec := _bytevec$create(x_buf$get_lp0())
+ x_buf$receive_data(b)
+ i: int := 1
+ for c: char in string$chars(s) do
+ yield(c, _wordvec$wfetch(b2w(b), i))
+ i := i + 2
+ end
+ end widths
+
+width = proc (font: cvt, s: string) returns (int) signals (error(string))
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_stringwidth
+ lr(er).l0 := font
+ er.s2 := string$size(s)
+ x_buf$send_data(s2b(s), 1, string$size(s))
+ x_buf$receive()
+ resignal error
+ return(x_buf$get_sp0())
+ end width
+
+all_widths = proc (font: cvt) returns (_wordvec) signals (error(string))
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_fontwidths
+ lr(er).l0 := font
+ x_buf$receive()
+ resignal error
+ b: _bytevec := _bytevec$create(x_buf$get_lp0())
+ x_buf$receive_data(b)
+ return(b2w(b))
+ end all_widths
+
+get_id = proc (font: cvt) returns (int)
+ return(font)
+ end get_id
+
+equal = proc (font1, font2: cvt) returns (bool)
+ return(font1 = font2)
+ end equal
+
+similar = proc (font1, font2: cvt) returns (bool)
+ return(font1 = font2)
+ end similar
+
+copy = proc (font: cvt) returns (cvt)
+ return(font)
+ end copy
+
+end x_font
--- /dev/null
+% Copyright Barbara Liskov 1985
+
+x_pixmap = cluster is none, create, create_xy, create_z, tile, destroy, shape,
+ get_id, equal, similar, copy
+
+rep = int
+
+none = proc () returns (cvt)
+ return(0)
+ end none
+
+create = proc (mask: x_bitmap, fore, back: int) returns (cvt)
+ signals (error(string))
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_makepixmap
+ lr(er).l0 := b2i(mask)
+ er.s2 := fore
+ or.s3 := back
+ x_buf$receive()
+ resignal error
+ return(x_buf$get_lp0())
+ end create
+
+create_xy = proc (width, height: int, bits: _wordvec) returns (cvt)
+ signals (error(string))
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_storepixmap + (XYFormat * 2**8)
+ er.s0 := height
+ or.s1 := width
+ x_buf$send_data(w2b(bits), 1,
+ ((width + 15) / 16) * height * 2 * x_display$planes())
+ x_buf$receive()
+ resignal error
+ return(x_buf$get_lp0())
+ end create_xy
+
+create_z = proc (width, height: int, bits: _wordvec) returns (cvt)
+ signals (error(string))
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_storepixmap + (ZFormat * 2**8)
+ er.s0 := height
+ or.s1 := width
+ z: int := width * height
+ if x_display$planes() > 8
+ then z := z + z end
+ x_buf$send_data(w2b(bits), 1, z)
+ x_buf$receive()
+ resignal error
+ return(x_buf$get_lp0())
+ end create_z
+
+tile = proc (pixel: int) returns (cvt) signals (error(string))
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_makepixmap
+ lr(er).l0 := 0
+ er.s2 := pixel
+ x_buf$receive()
+ resignal error
+ return(x_buf$get_lp0())
+ end tile
+
+destroy = proc (pix: cvt)
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_freepixmap
+ lr(er).l0 := pix
+ end destroy
+
+shape = proc (width, height: int) returns (int, int) signals (error(string))
+ or: oreq, er: ereq := x_buf$get()
+ er.code := x_queryshape + (TileShape * 2**8)
+ er.s0 := height
+ or.s1 := width
+ x_buf$receive()
+ resignal error
+ return(x_buf$get_sp1(), x_buf$get_sp0())
+ end shape
+
+get_id = proc (pix: cvt) returns (int)
+ return(pix)
+ end get_id
+
+equal = proc (pix1, pix2: cvt) returns (bool)
+ return(pix1 = pix2)
+ end equal
+
+similar = proc (pix1, pix2: cvt) returns (bool)
+ return(pix1 = pix2)
+ end similar
+
+copy = proc (pix: cvt) returns (cvt)
+ return(pix)
+ end copy
+
+end x_pixmap
--- /dev/null
+; Copyright Barbara Liskov 1985
+
+x_vlist = cluster is create, fetch, store, size, equal
+
+rep = null
+
+create = qproc (n: int) returns (cvt) signals (toobig)
+ mull 6,rr,n1
+ movzwl n1,n0
+ ifeql cmpl n1,n0
+ then addl 7,n0
+ bicb 3,n0
+ subl n0,heaplo
+ iflss cmpl heaplo,freelo
+ then jsb memout
+ end
+ movl heaplo,rr
+ movw n1,(rr)
+ movb %bvecb,3(rr)
+ return(rr)
+ end
+ signal toobig
+ end create
+
+store = qproc (list: cvt, i: int, x, y, flags: int) signals (bounds)
+ subl 1,i,n1
+ mull 6,n1
+ movl list,n2
+ movzwl (n2),n3
+ iflssu cmpl n1,n3
+ then movab 4(n2)[n1],n3
+ movw x,(n3)+
+ movw y,(n3)+
+ movw rr,(n3)
+ return
+ end
+ signal bounds
+ end store
+
+fetch = qproc (list: cvt, i: int) returns (int, int, int) signals (bounds)
+ subl 1,rr,n1
+ mull 6,n1
+ movl list,n2
+ movzwl (n2),n3
+ iflssu cmpl n1,n3
+ then movab 4(n2)[n1],n3
+ cvtwl (n3)+,-(sp)
+ cvtwl (n3)+,-(sp)
+ movzwl (n3),rr
+ return(*, *, *)
+ end
+ signal bounds
+ end fetch
+
+size = qproc (list: cvt) returns (int)
+ movzwl (rr),rr
+ divl 6,rr
+ return(rr)
+ end size
+
+equal = qproc (list1, list2: cvt) returns (bool)
+ ifeql cmpl list1,rr
+ then return(true)
+ end
+ return(false)
+ end equal
+
+end x_vlist
--- /dev/null
+merge x ~CLU/lib/*
+ext f
+ce xdefs internal cursors
+loc f
+o
--- /dev/null
+% Copyright Barbara Liskov 1985
+
+x_error = proc (why: string)
+ signal failure(why)
+ end x_error
--- /dev/null
+% Copyright Barbara Liskov 1985
+
+msgs = sequence[string]$["bad request code",
+ "int parameter out of range",
+ "parameter not a Window",
+ "parameter not a Pixmap",
+ "parameter not a Bitmap",
+ "parameter not a Cursor",
+ "parameter not a Font",
+ "parameter mismatch",
+ "Pixmap shape invalid for tiling",
+ "mouse/button already grabbed",
+ "access control violation",
+ "insufficient resources",
+ "no such color"]
+
+x_erstr = proc (err, req, code, func, wid: int) returns (string)
+ return(msgs[err] || ": request code " || int$unparse(code))
+ end x_erstr
--- /dev/null
+% Copyright Barbara Liskov 1985
+
+x_input = cluster is init, set_squish,
+ enq, deq, edeq, mdeq, wdeq,
+ pending, epending, mpending, wpending,
+ empty_event
+
+elist = array[event]
+i2w = _cvt[int, x_window]
+
+rep = null
+
+own have: bool := false
+own free: elist
+own queue: elist
+own squish: bool
+
+init = proc ()
+ free := elist$new()
+ queue := elist$new()
+ squish := true
+ have := true
+ end init
+
+set_squish = proc (flag: bool)
+ squish := flag
+ end set_squish
+
+enq = proc (e: event)
+ if squish cand e.kind = MouseMoved
+ then ne: event := elist$top(queue)
+ if ne.kind = MouseMoved cand w2i(ne.win) = w2i(e.win)
+ then event$r_gets_r(ne, e)
+ return
+ end
+ end except when bounds: end
+ ne: event := empty_event()
+ event$r_gets_r(ne, e)
+ elist$addh(queue, ne)
+ end enq
+
+deq = proc (e: event)
+ while elist$empty(queue) do
+ x_buf$events(true)
+ end
+ oe: event := elist$reml(queue)
+ event$r_gets_r(e, oe)
+ elist$addh(free, oe)
+ end deq
+
+edeq = proc (kind: int, e: event)
+ while true do
+ for i: int in elist$indexes(queue) do
+ oe: event := queue[i]
+ if oe.kind = kind
+ then event$r_gets_r(e, oe)
+ elist$addh(free, oe)
+ while true do
+ queue[i] := queue[i + 1]
+ i := i + 1
+ end except when bounds: end
+ elist$remh(queue)
+ return
+ end
+ end
+ x_buf$events(true)
+ end
+ end edeq
+
+mdeq = proc (kinds: int, e: event)
+ while true do
+ for i: int in elist$indexes(queue) do
+ oe: event := queue[i]
+ if i_and(oe.kind, kinds) ~= 0
+ then event$r_gets_r(e, oe)
+ elist$addh(free, oe)
+ while true do
+ queue[i] := queue[i + 1]
+ i := i + 1
+ end except when bounds: end
+ elist$remh(queue)
+ return
+ end
+ end
+ x_buf$events(true)
+ end
+ end mdeq
+
+wdeq = proc (w: x_window, kinds: int, e: event)
+ while true do
+ for i: int in elist$indexes(queue) do
+ oe: event := queue[i]
+ if w2i(oe.win) = w2i(w) cand i_and(oe.kind, kinds) ~= 0
+ then event$r_gets_r(e, oe)
+ elist$addh(free, oe)
+ while true do
+ queue[i] := queue[i + 1]
+ i := i + 1
+ end except when bounds: end
+ elist$remh(queue)
+ return
+ end
+ end
+ x_buf$events(true)
+ end
+ end wdeq
+
+pending = proc () returns (bool)
+ if ~elist$empty(queue)
+ then return(true) end
+ x_buf$events(false)
+ return(~elist$empty(queue))
+ end pending
+
+epending = proc (kind: int) returns (bool)
+ for e: event in elist$elements(queue) do
+ if e.kind = kind
+ then return(true) end
+ end
+ i: int := elist$high(queue)
+ x_buf$events(false)
+ while true do
+ i := i + 1
+ if queue[i].kind = kind
+ then return(true) end
+ end except when bounds: end
+ return(false)
+ end epending
+
+mpending = proc (kinds: int) returns (bool)
+ for e: event in elist$elements(queue) do
+ if i_and(e.kind, kinds) ~= 0
+ then return(true) end
+ end
+ i: int := elist$high(queue)
+ x_buf$events(false)
+ while true do
+ i := i + 1
+ if i_and(queue[i].kind, kinds) ~= 0
+ then return(true) end
+ end except when bounds: end
+ return(false)
+ end mpending
+
+wpending = proc (w: x_window, kinds: int) returns (bool)
+ for e: event in elist$elements(queue) do
+ if w2i(e.win) = w2i(w) cand i_and(e.kind, kinds) ~= 0
+ then return(true) end
+ end
+ i: int := elist$high(queue)
+ x_buf$events(false)
+ while true do
+ i := i + 1
+ e: event := queue[i]
+ if w2i(e.win) = w2i(w) cand i_and(e.kind, kinds) ~= 0
+ then return(true) end
+ end except when bounds: end
+ return(false)
+ end wpending
+
+empty_event = proc () returns (event)
+ if have
+ then return(elist$remh(free))
+ end except when bounds: end
+ return(event${kind: 0,
+ value: 0,
+ mask: 0,
+ win: i2w(0),
+ sub: i2w(0),
+ x: 0,
+ y: 0,
+ x0: 0,
+ y0: 0,
+ time: 0})
+ end empty_event
+
+end x_input
--- /dev/null
+x_vlist = cluster is create, store, fetch, size, equal
+
+rep = null
+
+create = proc (n: int) returns (cvt) signals (toobig)
+ end create
+
+store = proc (list: cvt, i: int, x, y, flags: int) signals (bounds)
+ end store
+
+fetch = proc (list: cvt, i: int) returns (int, int, int) signals (bounds)
+ end fetch
+
+size = proc (list: cvt) returns (int)
+ end size
+
+equal = proc (list1, list2: cvt) returns (bool)
+ end equal
+
+end x_vlist
--- /dev/null
+event = record[kind: int,
+ value: int,
+ mask: int,
+ win: x_window,
+ sub: x_window,
+ x: int,
+ y: int,
+ x0: int,
+ y0: int,
+ time: int]
+
+% map values
+
+IsUnmapped = 0
+IsMapped = 1
+IsInvisible = 2
+
+% kind values
+
+IsTransparent = 0
+IsOpaque = 1
+IsIcon = 2
+
+% Input Event Codes
+
+NoEvent = 0
+KeyPressed = 1
+KeyReleased = 2
+ButtonPressed = 4
+ButtonReleased = 8
+EnterWindow = 16
+LeaveWindow = 32
+MouseMoved = 64
+ExposeWindow = 128
+ExposeRegion = 256
+ExposeCopy = 512
+RightDownMotion = 1024
+MiddleDownMotion = 2048
+LeftDownMotion = 4096
+UnmapWindow = 8192
+FocusChange = 16384
+
+% Event detail codes
+
+RightButton = 0
+MiddleButton = 1
+LeftButton = 2
+IntoOrFromSubwindow = 1
+VirtualCrossing = 2
+
+% input state masks
+
+ControlMask = 16384
+MetaMask = 8192
+ShiftMask = 4096
+ShiftLockMask = 2048
+LeftMask = 1024
+MiddleMask = 512
+RightMask = 256
+
+BlackPixel = 0
+WhitePixel = 1
+
+% x_vlist flag bits. If the bit is 1 the predicate is true
+
+VertexRelative = 1 % else absolute
+VertexDontDraw = 2 % else draw
+VertexCurved = 4 % else straight
+VertexStartClosed = 8 % else not
+VertexEndClosed = 16 % else not
+VertexDrawLastPoint = 32 % else don't
+
+GXclear = 0 % 0
+GXand = 1 % src AND dst
+GXandReverse = 2 % src AND NOT dst
+GXcopy = 3 % src
+GXandInverted = 4 % NOT src AND dst
+GXnoop = 5 % dst
+GXxor = 6 % src XOR dst
+GXor = 7 % src OR dst
+GXnor = 8 % NOT src AND NOT dst
+GXequiv = 9 % NOT src XOR dst
+GXinvert = 10 % NOT dst
+GXorReverse = 11 % src OR NOT dst
+GXcopyInverted = 12 % NOT src
+GXorInverted = 13 % NOT src OR dst
+GXnand = 14 % NOT src OR NOT dst
+GXset = 15 % 1
+
+pixellist = array[int]
+colordef = record[pixel, red, green, blue: int]
+colordeflist = array[colordef]