4.3BSD/usr/contrib/X/CLUlib/vax/x_cursor.clu

% 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