BSD 4_3_Tahoe development

[unix-history] / usr / src / new / 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