% Copyright Barbara Liskov 1985, 1986 x_cursor = cluster is none, create, cons, scons, 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)) x_buf$setup(x_storecursor, func, 0, 0) x_buf$set_l0s23(b2i(image), fore, back) x_buf$set_l2s67(b2i(mask), xoff, 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 x_buf$setup(x_storebitmap, 0, 0, 0) x_buf$set_s01(height, width) x_buf$send_data(w2b(image), 1, z) if _wordvec$size(mask) ~= 0 then x_buf$setup(x_storebitmap, 0, 0, 0) x_buf$set_s01(height, 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 scons = proc (width, height: int, image, mask: string, fore, back: int, xoff, yoff, func: int) returns (x_cursor) signals (error(string)) img: _bytevec := _bytevec$create(string$size(image)) for i: int in int$from_to_by(1, string$size(image), 2) do img[i] := image[i + 1] img[i + 1] := image[i] end msk: _bytevec := _bytevec$create(string$size(mask)) for i: int in int$from_to_by(1, string$size(mask), 2) do msk[i] := mask[i + 1] msk[i + 1] := mask[i] end return(cons(width, height, b2w(img), b2w(msk), fore, back, xoff, yoff, func)) resignal error end scons destroy = proc (cursor: cvt) x_buf$setup(x_freecursor, 0, 0, 0) x_buf$set_l0(cursor) end destroy shape = proc (width, height: int) returns (int, int) signals (error(string)) x_buf$setup(x_queryshape, CursorShape, 0, 0) x_buf$set_s01(height, 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