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     ! 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.