Return to x_cursor.clu CVS log

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

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

1.1       root        1: % Copyright    Barbara Liskov    1985
                      2: 
                      3: x_cursor = cluster is none, create, cons, 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:     or: oreq, er: ereq := x_buf$get()
                     15:     er.code := x_storecursor + (func * 2**8)
                     16:     lr(er).l0 := b2i(image)
                     17:     er.s2 := fore
                     18:     or.s3 := back
                     19:     lr(er).l2 := b2i(mask)
                     20:     er.s6 := xoff
                     21:     or.s7 := yoff
                     22:     x_buf$receive()
                     23:        resignal error
                     24:     return(x_buf$get_lp0())
                     25:     end create
                     26: 
                     27: cons = proc (width, height: int, image, mask: _wordvec, fore, back: int,
                     28:             xoff, yoff, func: int) returns (x_cursor) signals (error(string))
                     29:     z: int := ((width + 15) / 16) * height * 2
                     30:     or: oreq, er: ereq := x_buf$get()
                     31:     er.code := x_storebitmap
                     32:     er.s0 := height
                     33:     or.s1 := width
                     34:     x_buf$send_data(w2b(image), 1, z)
                     35:     if _wordvec$size(mask) ~= 0
                     36:        then or, er := x_buf$get()
                     37:            er.code := x_storebitmap
                     38:            er.s0 := height
                     39:            or.s1 := width
                     40:            x_buf$send_data(w2b(mask), 1, z)
                     41:        end
                     42:     x_buf$receive()
                     43:        except when error (why: string):
                     44:                   if _wordvec$size(mask) ~= 0
                     45:                      then x_buf$receive()
                     46:                              resignal error
                     47:                      end
                     48:              end
                     49:     img: x_bitmap := _cvt[int, x_bitmap](x_buf$get_lp0())
                     50:     msk: x_bitmap := _cvt[int, x_bitmap](0)
                     51:     if _wordvec$size(mask) ~= 0
                     52:        then x_buf$receive()
                     53:               resignal error
                     54:            msk := _cvt[int, x_bitmap](x_buf$get_lp0())
                     55:        end
                     56:     cursor: x_cursor := create(img, msk, fore, back, xoff, yoff, func)
                     57:        resignal error
                     58:     x_bitmap$destroy(img)
                     59:     if _wordvec$size(mask) ~= 0
                     60:        then x_bitmap$destroy(msk) end
                     61:     return(cursor)
                     62:     end cons
                     63: 
                     64: destroy = proc (cursor: cvt)
                     65:     or: oreq, er: ereq := x_buf$get()
                     66:     er.code := x_freecursor
                     67:     lr(er).l0 := cursor
                     68:     end destroy
                     69: 
                     70: shape = proc (width, height: int) returns (int, int) signals (error(string))
                     71:     or: oreq, er: ereq := x_buf$get()
                     72:     er.code := x_queryshape + (CursorShape * 2**8)
                     73:     er.s0 := height
                     74:     or.s1 := width
                     75:     x_buf$receive()
                     76:        resignal error
                     77:     return(x_buf$get_sp1(), x_buf$get_sp2())
                     78:     end shape
                     79: 
                     80: get_id = proc (cursor: cvt) returns (int)
                     81:     return(cursor)
                     82:     end get_id
                     83: 
                     84: equal = proc (cursor1, cursor2: cvt) returns (bool)
                     85:     return(cursor1 = cursor2)
                     86:     end equal
                     87: 
                     88: similar = proc (cursor1, cursor2: cvt) returns (bool)
                     89:     return(cursor1 = cursor2)
                     90:     end similar
                     91: 
                     92: copy = proc (cursor: cvt) returns (cvt)
                     93:     return(cursor)
                     94:     end copy
                     95: 
                     96: end x_cursor

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