% 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