Return to x_cursor.clu CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / X / CLUlib / sun

Annotation of 43BSD/contrib/X/CLUlib/sun/x_cursor.clu, revision 1.1.1.1

1.1       root        1: % Copyright    Barbara Liskov    1985, 1986
                      2: 
                      3: x_cursor = cluster is none, create, cons, scons, destroy, shape,
                      4:                      get_id, equal, similar, copy
                      5: 
                      6: rep = int
                      7: 
                      8: none = proc () returns (cvt)
                      9:     return(0)
                     10:     end none
                     11: 
                     12: create = proc (image, mask: x_bitmap, fore, back, xoff, yoff, func: int)
                     13:           returns (cvt) signals (error(string))
                     14:     x_buf$setup(x_storecursor, func, 0, 0)
                     15:     x_buf$set_l0s23(b2i(image), fore, back)
                     16:     x_buf$set_l2s67(b2i(mask), xoff, yoff)
                     17:     x_buf$receive()
                     18:        resignal error
                     19:     return(x_buf$get_lp0())
                     20:     end create
                     21: 
                     22: cons = proc (width, height: int, image, mask: _wordvec, fore, back: int,
                     23:             xoff, yoff, func: int) returns (x_cursor) signals (error(string))
                     24:     z: int := ((width + 15) / 16) * height * 2
                     25:     x_buf$setup(x_storebitmap, 0, 0, 0)
                     26:     x_buf$set_s01(height, width)
                     27:     x_buf$send_data(w2b(image), 1, z)
                     28:     if _wordvec$size(mask) ~= 0
                     29:        then x_buf$setup(x_storebitmap, 0, 0, 0)
                     30:            x_buf$set_s01(height, width)
                     31:            x_buf$send_data(w2b(mask), 1, z)
                     32:        end
                     33:     x_buf$receive()
                     34:        except when error (why: string):
                     35:                   if _wordvec$size(mask) ~= 0
                     36:                      then x_buf$receive()
                     37:                              resignal error
                     38:                      end
                     39:              end
                     40:     img: x_bitmap := _cvt[int, x_bitmap](x_buf$get_lp0())
                     41:     msk: x_bitmap := _cvt[int, x_bitmap](0)
                     42:     if _wordvec$size(mask) ~= 0
                     43:        then x_buf$receive()
                     44:               resignal error
                     45:            msk := _cvt[int, x_bitmap](x_buf$get_lp0())
                     46:        end
                     47:     cursor: x_cursor := create(img, msk, fore, back, xoff, yoff, func)
                     48:        resignal error
                     49:     x_bitmap$destroy(img)
                     50:     if _wordvec$size(mask) ~= 0
                     51:        then x_bitmap$destroy(msk) end
                     52:     return(cursor)
                     53:     end cons
                     54: 
                     55: scons = proc (width, height: int, image, mask: string, fore, back: int,
                     56:              xoff, yoff, func: int) returns (x_cursor) signals (error(string))
                     57:     img: _bytevec := _bytevec$create(string$size(image))
                     58:     for i: int in int$from_to_by(1, string$size(image), 2) do
                     59:        img[i] := image[i + 1]
                     60:        img[i + 1] := image[i]
                     61:        end
                     62:     msk: _bytevec := _bytevec$create(string$size(mask))
                     63:     for i: int in int$from_to_by(1, string$size(mask), 2) do
                     64:        msk[i] := mask[i + 1]
                     65:        msk[i + 1] := mask[i]
                     66:        end
                     67:     return(cons(width, height, b2w(img), b2w(msk),
                     68:                fore, back, xoff, yoff, func))
                     69:        resignal error
                     70:     end scons
                     71: 
                     72: destroy = proc (cursor: cvt)
                     73:     x_buf$setup(x_freecursor, 0, 0, 0)
                     74:     x_buf$set_l0(cursor)
                     75:     end destroy
                     76: 
                     77: shape = proc (width, height: int) returns (int, int) signals (error(string))
                     78:     x_buf$setup(x_queryshape, CursorShape, 0, 0)
                     79:     x_buf$set_s01(height, width)
                     80:     x_buf$receive()
                     81:        resignal error
                     82:     return(x_buf$get_sp1(), x_buf$get_sp2())
                     83:     end shape
                     84: 
                     85: get_id = proc (cursor: cvt) returns (int)
                     86:     return(cursor)
                     87:     end get_id
                     88: 
                     89: equal = proc (cursor1, cursor2: cvt) returns (bool)
                     90:     return(cursor1 = cursor2)
                     91:     end equal
                     92: 
                     93: similar = proc (cursor1, cursor2: cvt) returns (bool)
                     94:     return(cursor1 = cursor2)
                     95:     end similar
                     96: 
                     97: copy = proc (cursor: cvt) returns (cvt)
                     98:     return(cursor)
                     99:     end copy
                    100: 
                    101: end x_cursor

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.