planar.sa


Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
 
------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand        --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute  and/or modify it under the terms of the GNU Library General --
-- Public  License (LGPL)  as published  by the  Free  Software  Foundation; --
-- either version 2 of the license, or (at your option) any later version.   --
-- This  library  is distributed  in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details.       --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------


abstract class $PLANES < $SURFACES

abstract class $PLANES < $SURFACES is -- This abstraction covers all two-dimensional planar classes. -- Version 1.0 Jan 97. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 10 Jan 97 kh Original end ; -- $PLANES

immutable class POINT < $IS_EQ, $PLANES, $IMMUTABLE, $BINARY

immutable class POINT < $IS_EQ, $PLANES, $IMMUTABLE, $BINARY is -- This class encapsulates the idea of rectangular co-ordinates which -- have a dimension rather than being just numbers. -- Version 1.1 Jan 99. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 10 Jan 97 kh Original -- 11 Jan 99 kh included $IMMUTABLE sub-typing include COMPARABLE ; include BINARY ; readonly attr x_val, y_val : LENGTH ; build( cursor : BIN_CURSOR ) : SAME pre ~void(cursor) and ~cursor.is_done post true -- could be an origin of 0,0 is -- This routine creates a new coordinate from the indicated binary -- string. return x_val(LENGTH::build(cursor)).y_val(LENGTH::build(cursor)) end ; create( xdim, ydim : LENGTH ) : SAME is -- This creates a new set of co-ordinates from the individual value -- arguments return x_val(xdim).y_val(ydim) end ; create(x, y : FLT, kind : UNITS ) : SAME pre (x >= 0.0) and (y >= 0.0) is -- This routine creates a co-ordinate from the raw numeric values -- and primitive dimension. return x_val(LENGTH::create(x,kind)).y_val(LENGTH::create(y,kind)) end ; binstr : BINSTR pre true post (result.size > 0) is -- This routine returns a binary string representation of self. return x_val.binstr + y_val.binstr end ; valid_offset( by : OFFSET ) : BOOL is -- This is the predicate used to tell if a particular offset can be -- applied to this coordinate. res : BOOL := (by.x_direction = DIRECTIONS::Right) and (by.y_direction = DIRECTIONS::Up) ; if res then -- unconditional success! return true else res := (by.x_direction = DIRECTIONS::Left) and (x_val > by.x_shift) ; if res then -- OK so far! res := (by.y_direction = DIRECTIONS::Down) and (y_val > by.y_shift) end end ; return res end ; is_eq( other : SAME ) : BOOL is -- This predicate returns true if and only if other is in the same -- position as self. return (x_val = other.x_val) and (y_val = other.y_val) end ; diff( other : SAME ) : LENGTH is -- This routine returns the distance between other and self as the -- positive square root of the sum of the squares of the x and y distances. x_distance : FLT := x_val.lgth - other.x_val.lgth ; y_distance : FLT := y_val.lgth - other.x_val.lgth ; return LENGTH::create((x_distance * x_distance + y_distance * y_distance).sqrt) end ; offset( other : SAME ) : OFFSET is -- This routine returns the distance between other and self expressed as -- an offset. x_distance : FLT := x_val.lgth - other.x_val.lgth ; y_distance : FLT := y_val.lgth - other.x_val.lgth ; x_val : LENGTH := LENGTH::create(x_distance.abs) ; y_val : LENGTH := LENGTH::create(y_distance.abs) ; hdir : DIRECTIONS ; vdir : DIRECTIONS ; if x_distance.is_neg then hdir := DIRECTIONS::Left else hdir := DIRECTIONS::Right end ; if y_distance.is_neg then hdir := DIRECTIONS::Down else hdir := DIRECTIONS::Up end ; return OFFSET::create(x_val,y_val,hdir,vdir) end ; plus( by : OFFSET ) : SAME pre valid_offset(by) post true is -- This routine is provided to enable simple offsetting of a coordinate -- providing that the pre-requisite is satisfied. res : SAME ; loc_xval : FLT ; loc_yval : FLT ; if by.x_direction = DIRECTIONS::Left then loc_xval := - (by.x_shift).lgth else loc_xval := by.x_shift.lgth end ; if by.y_direction = DIRECTIONS::Down then loc_yval := - (by.y_shift).lgth else loc_yval := by.y_shift.lgth end ; return x_val(x_val + LENGTH::create(loc_xval)).y_val( y_val + LENGTH::create(loc_yval)) end ; transform( by : TRANSFORM_MATRIX ) : SAME is -- This operation applies the given transformation matrix to the -- co-ordinate, returning the result. return create(((x_val * by.matrix[0]) + (y_val * by.matrix[2])) + LENGTH::create(by.matrix[4]), ((x_val * by.matrix[1]) + (y_val * by.matrix[3])) + LENGTH::create(by.matrix[5])) end ; scale( factor : FLT ) : SAME is -- This routine creates a 'scaled' coordinate. trans : TRANSFORM_MATRIX := TRANSFORM_MATRIX::scaling(factor,factor) ; return transform(trans) end ; nodim_str( units : UNITS, sep : CHAR, lib : LIBCHARS ) : STR is -- This routine provides a string representation of the co-ordinates -- together with the associated unit of measurement in the given repertoire -- and encoding. return STR::create + lib.Left_Parenthesis.char + x_val.nodim_str(units,lib) + sep + y_val.nodim_str(units,lib) + lib.Right_Parenthesis.char end ; str( units : UNITS, lib : LIBCHARS ) : STR is -- This routine provides a string representation of the co-ordinates -- together with the associated unit of measurement in the given repertoire -- and encoding. loc_sep : CHAR := lib.Space.char ; -- the last resort! if ~void(lib.culture.numeric.format.thousands_sep) then loc_sep := lib.culture.numeric.format.thousands_sep.char end ; return nodim_str(units,loc_sep,lib) + lib.Space.char + units.str(lib) end ; str( units : UNITS ) : STR is -- This routine provides a string representation of the co-ordinates -- together with the default unit of measurement in the default repertoire -- and encoding. return str(units, LIBCHARS::default) end ; str( lib : LIBCHARS ) : STR is -- This routine provides a string representation of the co-ordinates -- together with the default unit of measurement in the default repertoire -- and encoding. return str(UNITS::Millimetres,lib) end ; str : STR is -- This routine provides a string representation of the co-ordinates -- together with the default unit of measurement in the default repertoire -- and encoding. return str(UNITS::Millimetres, LIBCHARS::default) end ; end ; -- POINT

immutable class OFFSET < $PLANES, $IS_EQ, $IMMUTABLE, $BINARY

immutable class OFFSET < $PLANES, $IS_EQ, $IMMUTABLE, $BINARY is -- This class represents the shifting amount and direction which may -- be required when carrying out two-dimensional graphic operations. -- -- Note that the "sign" of the shift is indicated by the two -- direction components. -- Version 1.2 Jan 99. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 10 Jan 97 kh Original -- 8 Aug 97 kh Modified for string portability, etc -- 11 Jan 99 kh subtyping from $IMMUTABLE added. include COMPARABLE ; include BINARY ; readonly attr x_shift : LENGTH ; readonly attr y_shift : LENGTH ; readonly attr x_direction : DIRECTIONS ; readonly attr y_direction : DIRECTIONS ; build( cursor : BIN_CURSOR ) : SAME pre ~void(cursor) and ~cursor.is_done post ~void(result) is -- This routine creates a new offset from the indicated binary string. me : SAME ; me := me.x_shift(LENGTH::build(cursor)) ; me := me.y_shift(LENGTH::build(cursor)) ; me := me.x_direction(DIRECTIONS::build(cursor)) ; me := me.y_direction(DIRECTIONS::build(cursor)) ; return me end ; create( x_move : FLT, y_move : FLT, dims : UNITS ) : SAME is -- This create version assumes that positive shifting is Up and Right -- respectively and that negative shifting is Down and Left. me : SAME ; if x_move >= 0.0 then me := me.x_shift(LENGTH::create(x_move,dims)) ; me := me.x_direction(DIRECTIONS::Right) else me := me.x_shift(LENGTH::create(- x_move,dims)) ; me := me.x_direction(DIRECTIONS::Left) end ; if y_move >= 0.0 then me := me.y_shift(LENGTH::create(y_move,dims)) ; me := me.y_direction(DIRECTIONS::Up) else me := me.y_shift(LENGTH::create(- y_move,dims)) ; me := me.y_direction(DIRECTIONS::Down) end ; return me end ; create( x_dist : LENGTH, y_dist : LENGTH, horiz : DIRECTIONS, vert : DIRECTIONS ) : SAME pre (((horiz = DIRECTIONS::Right) or (horiz = DIRECTIONS::Left)) and ((vert = DIRECTIONS::Up) or (vert = DIRECTIONS::Down))) is -- This create version converts both distances to a common unit before -- creating the resulting offset. Note the pre-requisite. me : SAME ; me := me.x_shift(x_dist) ; me := me.y_shift(y_dist) ; me := me.x_direction(horiz) ; me := me.y_direction(vert) ; return me end ; binstr : BINSTR pre true post (result.size > 0) is -- This routine returns a binary string representation of self. return x_shift.binstr + y_shift.binstr + x_direction.binstr + y_direction.binstr end ; scale( factor : FLT ) : SAME pre factor > FLT::zero post true is -- This routine permits offsets to be scaled by a single number. return create(x_shift * factor, y_shift * factor,x_direction,y_direction) end ; is_eq( other : SAME ) : BOOL is -- This predicate yields true iff all components are the same value, -- otherwise false. return (x_shift = other.x_shift) and (y_shift = other.y_shift) and (x_direction = other.x_direction) and (y_direction = other.y_direction) end ; plus( other : SAME ) : SAME is -- This operation produces the result of adding together the two -- offsets. The resultant directions may be changed. res : SAME ; if x_direction = other.x_direction then res := res.x_direction(other.x_direction) ; res := res.x_shift(x_shift + other.x_shift) else if x_shift < other.x_shift then res := res.x_direction(other.x_direction) ; res := res.x_shift(other.x_shift - x_shift) else res := res.x_direction(x_direction) ; res := res.x_shift(x_shift - other.x_shift) end end ; if y_direction = other.y_direction then res := res.y_direction(other.y_direction) ; res := res.y_shift(y_shift + other.y_shift) else if y_shift < other.y_shift then res := res.y_direction(other.y_direction) ; res := res.y_shift(other.y_shift - y_shift) else res := res.y_direction(y_direction) ; res := res.y_shift(y_shift - other.y_shift) end end ; return res end ; minus( other : SAME ) : SAME is -- This operation produces the result of subtracting other from this -- offset. The resultant directions may be changed. res : SAME ; if x_direction = other.x_direction then if x_shift < other.x_shift then if x_direction = DIRECTIONS::Left then res := res.x_direction(DIRECTIONS::Right) else res := res.x_direction(DIRECTIONS::Left) end ; res := res.x_shift(other.x_shift - x_shift) else res := res.x_direction(other.x_direction) ; res := res.x_shift(x_shift - other.x_shift) end else if x_shift < other.x_shift then res := res.x_direction(other.x_direction) ; res := res.x_shift(other.x_shift - x_shift) else res := res.x_direction(x_direction) ; res := res.x_shift(x_shift - other.x_shift) end end ; if y_direction = other.y_direction then if y_shift < other.y_shift then if y_direction = DIRECTIONS::Up then res := res.y_direction(DIRECTIONS::Down) else res := res.y_direction(DIRECTIONS::Up) end ; res := res.y_shift(other.y_shift - y_shift) else res := res.y_direction(other.y_direction) ; res := res.y_shift(y_shift - other.y_shift) end else if y_shift < other.y_shift then res := res.y_direction(other.y_direction) ; res := res.y_shift(other.y_shift - y_shift) else res := res.y_direction(y_direction) ; res := res.y_shift(y_shift - other.y_shift) end end ; return res end ; str( units : UNITS, lib : LIBCHARS ) : STR is -- This routine produces a textual representation of an offset. loc_sep : CHAR := lib.Space.char ; -- the last resort! if ~void(lib.culture.numeric.format.thousands_sep) then loc_sep := lib.culture.numeric.format.thousands_sep.char end ; return x_shift.nodim_str(units,lib) + lib.Space.char + lib.Colon.char + x_direction.str + loc_sep + y_shift.nodim_str(units,lib) + lib.Space.char + lib.Colon.char + y_direction.str + lib.Space.char + lib.Left_Parenthesis.char + units.str(lib) + lib.Right_Parenthesis.char end ; str( lib : LIBCHARS ) : STR is -- This routine produces a textual representation of an offset. return str(UNITS::Millimetres,lib) end ; str( units : UNITS ) : STR is -- This routine produces a textual representation of an offset. return str(units,LIBCHARS::default) end ; str : STR is -- This routine produces a textual representation of an offset. return str(UNITS::Millimetres,LIBCHARS::default) end ; end ; -- OFFSET

immutable class AREA < $PLANES, $IS_EQ, $IMMUTABLE, $BINARY

immutable class AREA < $PLANES, $IS_EQ, $IMMUTABLE, $BINARY is -- This class provides objects which model the area of a surface of some -- kind. -- Version 1.2 Jan 99. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 10 Jan 97 kh Original -- 8 Aug 97 kh Modelled on LENGTH -- 11 Jan 99 kh added $IMMUTABLE sub-typing include COMPARABLE ; include BINARY ; private const Microfactor : FLT := 1000.0 ; -- An Area Mult Factor. readonly attr val : FLT ; private Square( loc_lib : LIBCHARS ) : CODE_STR is -- This private routine returns the superscript 'squared' symbol. return CODE_STR::create(loc_lib) + CHAR_CODE::create(UNICODE::SUPERSCRIPT_TWO.card,loc_lib) end ; build( cursor : BIN_CURSOR ) : SAME pre ~void(cursor) and ~cursor.is_done post true is -- This routine creates a new area from the indicated binary string. return val(FLT::build(cursor)) end ; create( mag : FLT ) : SAME pre (mag >= 0.0) is -- This routine creates a new value as defined by the argument given -- which defaults to a measurement in square millimetres. return mag * Microfactor end ; create( mag : FLT, dim : UNITS ) : SAME pre (mag >= 0.0) is -- This routine creates a new value as defined by the arguments given. return mag * dim.factor(UNITS::Millimetres) * dim.factor(UNITS::Millimetres) * Microfactor end ; create( mag : FLT, dim : STR ) : SAME pre (mag >= 0.0) is -- This routine creates a new value as defined by the arguments given. loc_units : UNITS := UNITS::create(dim) ; if loc_units.is_nil then -- invalid anyway! return void else return mag * loc_units.factor(UNITS::Millimetres) * loc_units.factor(UNITS::Millimetres) * Microfactor end end ; binstr : BINSTR pre true post (result.size > 0) is -- This routine returns a binary string representation of self. return val.binstr end ; square : FLT is -- This routine returns the value of self in square millimetres (the -- default). return val / Microfactor end ; square( unit : UNITS ) : FLT is -- This routine returns the value of self as an area in the given units. return val / (Microfactor * unit.factor(UNITS::Millimetres) * unit.factor(UNITS::Millimetres)) end ; is_eq( other : SAME ) : BOOL is -- This predicate returns true if and only if other and self have the same -- value. return val = other.val end ; is_lt( other : SAME ) : BOOL is -- This predicate returns true if and only if self is less than other. return val < other.val end ; plus( other : SAME ) : SAME is -- This routine adds together two measurements, to give the resulting -- dimension. return val + other.val end ; minus( other : SAME ) : SAME pre (val >= other) is -- This routine subtracts other from self provided that the result would -- be non-negative. return val - other end ; times( factor : FLT ) : SAME pre factor >= 0.0 is -- This routine multiplies the size by factor -- providing that -- this is not less than zero! return val * factor end ; div( factor : FLT ) : SAME pre (factor > 0.0) is -- This routine divides the size by factor -- providing that -- this is greater than zero! return val / factor end ; div( other : SAME ) : FLT is -- This routine divides two dimensions producing a scale factor / ratio. return val / other.val end ; hash : CARD is -- This routine returns a hash value for the area. return val.hash end ; str( units : UNITS, lib : LIBCHARS ) : STR is -- This provides a string representation in the unit specified. loc_factor : FLT := units.factor(UNITS::Millimetres) ; loc_factor := loc_factor * loc_factor * Microfactor ; return (val / loc_factor).str(3) + units.str(lib) + Square(lib).tgt_str end ; str( units : UNITS ) : STR is -- This provides a string representation in the unit specified using -- the current repertoire and encoding. return str(units,LIBCHARS::default) end ; str( lib : LIBCHARS ) : STR is -- This provides a string representation in the unit specified using -- the current repertoire and encoding. return str(UNITS::Millimetres,lib) end ; str : STR is -- This provides a string representation in the default unit of -- square millimetres using the current repertoire and encoding. return str(UNITS::Millimetres, LIBCHARS::default) end ; end ; -- AREA

immutable class BOX < $PLANES, $IMMUTABLE, $BINARY, $IS_EQ

immutable class BOX < $PLANES, $IMMUTABLE, $BINARY, $IS_EQ is -- This abstraction defines a box bounding some area in terms of its -- lower left co-ordinates and upper right co-ordinates. No operations -- for arithmetic operations on the box as a whole are provided, but -- an encloses predicate, together with an enclosure operation which -- are more appropriate to a box as a whole. -- Version 1.2 Aug 2001. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 10 Jan 97 kh Original -- 8 Aug 97 kh Updated for portability -- 23 Aug 01 kh Added sub-typing include COMPARABLE ; include BINARY ; readonly attr ll, ur : POINT ; build( cursor : BIN_CURSOR ) : SAME pre ~void(cursor) and ~cursor.is_done post true is -- This routine creates a new area from the indicated binary string. return ll(POINT::build(cursor)).ur(POINT::build(cursor)) end ; create( ll_x, ll_y, ur_x, ur_y : FLT, kind : UNITS ) : SAME pre (ll_x >= 0.0) and (ll_y >= 0.0) and (ur_x >= ll_x) and (ur_y >= ll_x) is -- This routine creates a new bounding box from the four given -- numeric values and the dimension. No checking for plausibility -- can be carried out except to ensure that negative values are not -- used and that the upper right corner is no less than the lower left.. me : SAME ; me := me.ll(POINT::create(ll_x,ll_y,kind)) ; me:= me.ur(POINT::create(ur_x,ur_y,kind)) ; return me end ; create( ll_coords, ur_coords : POINT ) : SAME is -- Given the two POINTs which make up the box definition this -- routine creates a new box. return ll(ll_coords).ur(ur_coords) end ; create( lower_left : POINT, rect : RECTANGLE ) : SAME is -- This routine creates a new box given the lower left co-ordinate and -- the rectangle - effectively fixing the rectangle. me : SAME := me.ll(lower_left) ; me := me.ur(POINT::create((lower_left.x_val + rect.height), (lower_left.y_val + rect.width))) ; return me end ; binstr : BINSTR pre true post (result.size > 0) is -- This routine returns a binary string representation of self. return ll.binstr + ur.binstr end ; scale( factor : FLT ) : SAME pre (factor > 0.0) is -- This routine scales all coordinates of the box by factor. The pre- -- condition is provided since a box cannot be 'negative'/imaginary! return ll(ll.scale(factor)).ur(ur.scale(factor)) end ; width : LENGTH is -- This yields the width of the box in the current units. return ur.x_val - ll.x_val end ; height : LENGTH is -- This yields the height of the box in the current units. return ur.y_val - ll.y_val end ; shape : RECTANGLE is -- This routine returns the rectangle of which this box is an instance. return RECTANGLE::create(width,height) end ; reshape( shape : RECTANGLE ) : SAME is -- This routine returns a new rectangle with the same origin as self -- but the given rectangle enclosure. return create(ll,shape) end ; is_eq( other : SAME ) : BOOL is -- This predicate returns true iff self and other are boxes covering the -- identical area. if is_empty or other.is_empty then return false else return (ll = other.ll) and (ur = other.ur) end end ; is_empty : BOOL is -- This predicate returns true iff self is an empty box (ie has no area -- at all. return ll = ur end ; encloses( point : POINT ) : BOOL is -- This function returns true iff the given point is within -- the bounding box, otherwise false. if is_empty then return false else return ((ll.x_val <= point.x_val) and (ll.y_val <= point.y_val)) and ((ur.x_val >= point.x_val) and (ur.y_val >= point.y_val)) end end ; encloses( other : BOX ) : BOOL is -- This function returns true iff other is entirely surrounded by -- this bounding box, otherwise false. if is_empty then return false elsif other.is_empty then return true else return ((ll.x_val <= other.ll.x_val) and (ll.y_val <= other.ll.y_val)) and ((ur.x_val >= other.ur.x_val) and (ur.y_val >= other.ur.y_val)) end end ; enclosure( point : POINT ) : SAME is -- This routine produces a bounding box which includes the given point -- and self. if self.encloses(point) then return create(self.ll,self.ur) else me : SAME ; x_val : LENGTH ; y_val : LENGTH ; if (ll.x_val < point.x_val) then x_val := ll.x_val else x_val := point.x_val end ; if (ll.y_val < point.y_val) then y_val := ll.y_val else y_val := point.y_val end ; me := me.ll(POINT::create(x_val,y_val)) ; if (ur.x_val < point.x_val) then x_val := point.x_val else x_val := ur.x_val end ; if (ur.y_val < point.y_val) then y_val := point.y_val else y_val := ur.y_val end ; me := me.ur(POINT::create(x_val,y_val)) ; return me end end ; enclosure( other : BOX ) : SAME is -- This routine produces a bounding box which is the smallest bounding -- box which encloses both self and other. if self.encloses(other) then return create(self.ll,self.ur) elsif other.encloses(self) then return create(other.ll,other.ur) else me : SAME ; if (ll.x_val < other.ll.x_val) or (ll.y_val < other.ll.y_val) then me := me.ll(POINT::create(ll.x_val,ll.y_val)) else me := me.ll(POINT::create(other.ll.x_val,other.ll.y_val)) end ; if (ur.x_val > other.ur.x_val) or (ur.y_val > other.ur.y_val) then me := me.ur(POINT::create(ur.x_val,ur.y_val)) else me := me.ur(POINT::create(other.ur.x_val,other.ur.y_val)) end ; return me end end ; overlaps( other : BOX ) : BOOL is -- This function returns true iff other is overlapped by any part of -- this bounding box, otherwise false. if is_empty then return true else return (self.ll.x_val < other.ur.x_val) and (self.ur.x_val > other.ll.x_val) and (self.ll.y_val < other.ur.y_val) and (self.ur.y_val > other.ll.y_val) end end ; overlap( other : BOX ) : SAME pre overlaps(other) post ~result.is_empty is -- This routine produces a bounding box which is the intersection of the -- other bounding box overlapped by this one. if self.encloses(other) then return create(other.ll,other.ur) elsif other.encloses(self) then return create(self.ll,self.ur) else me : SAME ; tmp_x, tmp_y : LENGTH ; if (ll.x_val < other.ll.x_val) then tmp_x := other.ll.x_val else tmp_x := ll.x_val end ; if (ll.y_val < other.ll.y_val) then tmp_y := other.ll.y_val else tmp_y := ll.y_val end ; me := me.ll(POINT::create(tmp_x,tmp_y)) ; if (ur.x_val < other.ur.x_val) then tmp_x := ur.x_val else tmp_x := other.ur.x_val end ; if (ur.y_val < other.ur.y_val) then tmp_y := ur.y_val else tmp_y := other.ur.y_val end ; me := me.ur(POINT::create(tmp_x,tmp_y)) ; return me end end ; non_overlap( other : SAME ) : FLIST{SAME} pre overlaps(other) post ~result.is_empty is -- This routine produces a list of boxes which together comprise the -- area of other NOT overlapped by this bounding box. res : FLIST{SAME} ; -- First work out corner relationships. llx : BOOL := ll.x_val < other.ll.x_val ; lly : BOOL := ll.y_val < other.ll.y_val ; urx : BOOL := ur.x_val < other.ur.x_val ; ury : BOOL := ur.y_val < other.ur.y_val ; lleft : POINT ; uright : POINT ; -- The remainder is a large if statement on the x-relations each -- arm of which has an if statement on the y-relations! if llx and ~urx then if lly and ~ury then return void elsif ~lly and ury then uright := POINT::create(ll.x_val,other.ur.y_val) ; res := res.push(BOX::create(other.ll,uright)) ; lleft := POINT::create(ur.x_val,other.ll.y_val) ; res := res.push(BOX::create(lleft,other.ur)) elsif lly and ury then uright := POINT::create(other.ur.x_val,ll.y_val) ; res := res.push(BOX::create(other.ll,uright)) else -- neither y relation true! lleft := POINT::create(other.ll.x_val,ur.y_val) ; res := res.push(BOX::create(lleft,other.ur)) end elsif ~llx and urx then if lly and ~ury then uright := POINT::create(other.ur.x_val,ll.y_val) ; res := res.push(BOX::create(other.ll,uright)) ; lleft := POINT::create(other.ll.x_val,ur.y_val) ; res := res.push(BOX::create(lleft,other.ur)) elsif ~lly and ury then uright := POINT::create(other.ur.x_val,ll.y_val) ; res := res.push(BOX::create(other.ll,uright)) ; lleft := POINT::create(other.ll.x_val,ur.y_val) ; res := res.push(BOX::create(lleft,other.ur)) ; lleft := POINT::create(other.ll.x_val,ll.y_val) ; uright := POINT::create(ll.x_val,ur.y_val) ; res := res.push(BOX::create(lleft,uright)) ; lleft := POINT::create(ur.x_val,ll.y_val) ; uright := POINT::create(other.ll.x_val,ur.y_val) ; res := res.push(BOX::create(lleft,uright)) elsif lly and ury then uright := POINT::create(ll.x_val,other.ur.y_val) ; res := res.push(BOX::create(other.ll,uright)) ; lleft := POINT::create(ur.x_val,other.ll.y_val) ; res := res.push(BOX::create(lleft,other.ur)) ; lleft := POINT::create(ll.x_val,ur.y_val) ; uright := POINT::create(ur.x_val,other.ur.y_val) ; res := res.push(BOX::create(lleft,uright)) else -- neither y relation true! uright := POINT::create(ll.x_val,other.ur.y_val) ; res := res.push(BOX::create(other.ll,uright)) ; lleft := POINT::create(ur.x_val,other.ll.y_val) ; res := res.push(BOX::create(lleft,other.ur)) ; lleft := POINT::create(ll.x_val,other.ll.y_val) ; uright := POINT::create(ur.x_val,ll.y_val) ; res := res.push(BOX::create(lleft,uright)) end elsif llx and urx then if lly and ~ury then lleft := POINT::create(ur.x_val,other.ll.y_val) ; res := res.push(BOX::create(lleft,other.ur)) elsif ~lly and ury then uright := POINT::create(other.ur.x_val,ll.y_val) ; res := res.push(BOX::create(other.ll,uright)) ; lleft := POINT::create(other.ll.x_val,ur.y_val) ; res := res.push(BOX::create(lleft,other.ur)) ; lleft := POINT::create(ur.x_val,ll.y_val) ; uright := POINT::create(other.ur.x_val,ur.y_val) ; res := res.push(BOX::create(lleft,uright)) elsif lly and ury then lleft := POINT::create(other.ll.x_val,ur.y_val) ; res := res.push(BOX::create(lleft,other.ur)) ; lleft := POINT::create(ur.x_val,other.ll.y_val) ; uright := POINT::create(other.ur.x_val,ur.y_val) ; res := res.push(BOX::create(lleft,uright)) else -- neither y relation true! uright := POINT::create(other.ur.x_val,ll.y_val) ; res := res.push(BOX::create(other.ll,uright)) ; lleft := POINT::create(ur.x_val,ll.y_val) ; res := res.push(BOX::create(lleft,other.ur)) end else -- neither x relation true! if lly and ~ury then uright := POINT::create(ll.x_val,other.ur.y_val) ; res := res.push(BOX::create(other.ll,uright)) elsif ~lly and ury then uright := POINT::create(other.ur.x_val,ll.y_val) ; res := res.push(BOX::create(other.ll,uright)) ; lleft := POINT::create(other.ll.x_val,ur.y_val) ; res := res.push(BOX::create(lleft,other.ur)) ; lleft := POINT::create(other.ll.x_val,ur.y_val) ; uright := POINT::create(ll.x_val,ur.y_val) ; res := res.push(BOX::create(lleft,uright)) elsif lly and ury then lleft := POINT::create(other.ll.x_val,ur.y_val) ; res := res.push(BOX::create(lleft,other.ur)) ; uright := POINT::create(ll.x_val,ur.y_val) ; res := res.push(BOX::create(other.ll,uright)) else -- neither y relation true! uright := POINT::create(other.ur.x_val,ll.y_val) ; res := res.push(BOX::create(other.ll,uright)) ; lleft := POINT::create(other.ll.x_val,ll.y_val) ; uright := POINT::create(ll.x_val,other.ur.y_val) ; res := res.push(BOX::create(lleft,uright)) end end ; return res end ; origin : POINT is -- This routine is a renaming of the ll attribute! return ll end ; origin( new_ll : POINT ) : SAME is -- This routine sets the origin of the box to the new value! shift : OFFSET := ll.offset(new_ll) ; return move(shift) end ; move( off : OFFSET ) : SAME is -- This routine moves the box by the given offset relative to the origin -- of the co-ordinates. return ll(self.ll + off).ur(self.ur + off) end ; nodim_str( units : UNITS, sep : CHAR, lib : LIBCHARS ) : STR pre ~units.is_nil and ~void(lib) and sep.is_print post ~void(result) is -- This provides a string representation of the bounding box using -- the sep character as separator -- with no following dimension -- representation. return ll.x_val.nodim_str(units,lib) + sep + ll.y_val.nodim_str(units,lib) + lib.Space.char + lib.Hyphen.char + lib.Space.char + ur.x_val.nodim_str(units,lib) + sep + ur.y_val.nodim_str(units,lib) end ; str( units : UNITS, sep : CHAR, lib : LIBCHARS ) : STR pre ~units.is_nil and ~void(lib) and sep.is_print post ~void(result) is -- This provides a string representation of the bounding box using -- the ch character as separator -- followed by the dimension in -- parentheses. return nodim_str(units,sep,lib) + lib.Space.char + lib.Left_Parenthesis.char + units.str(lib) + lib.Right_Parenthesis.char end ; str( sep : CHAR, units : UNITS ) : STR pre ~units.is_nil and sep.is_print post ~void(result) is -- This provides a string representation of the box as four values -- separated by sep in the given units using the current repertoire and -- encoding. lib : LIBCHARS := LIBCHARS::default ; return str(UNITS::Millimetres,lib.Comma.char,lib) end ; str( sep : CHAR ) : STR pre sep.is_print post ~void(result) is -- This provides a string representation of the box as four values -- separated by sep, using the default unit, repertoire and encoding. lib : LIBCHARS := LIBCHARS::default ; return str(UNITS::Millimetres,sep,lib) end ; str( lib : LIBCHARS ) : STR pre ~void(lib) post ~void(result) is -- This provides a string representation of the box as four values -- separated by sep, using the default unit and given repertoire and encoding. return str(UNITS::Millimetres,lib.Comma.char,lib) end ; str : STR is -- This provides a default string representation of the box as four comma -- separated values using the current repertoire and encoding. lib : LIBCHARS := LIBCHARS::default ; return str(UNITS::Millimetres,lib.Comma.char,lib) end ; end ; -- BOX

immutable class RECTANGLE < $IS_EQ, $PLANES, $IMMUTABLE, $BINARY, $NIL

immutable class RECTANGLE < $IS_EQ, $PLANES, $IMMUTABLE, $BINARY, $NIL is -- This class encapsulates the idea of a rectangular area, having -- a shape specified in terms of width and height. This rectangle is not -- positioned in relation to any plane it may be on either in coordinates -- or rotation. -- Version 1.1 Jan 99. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 9 Jan 97 kh Original extracted from FLT. -- 11 Jan 99 kh added $IMMUTABLE sub-typing include COMPARABLE ; include BINARY ; readonly attr width, height : LENGTH ; build( cursor : BIN_CURSOR ) : SAME pre ~void(cursor) and ~cursor.is_done post true is -- This routine creates a new size object from the indicated binary -- string. return width(LENGTH::build(cursor)).height(LENGTH::build(cursor)) end ; create( wdth : LENGTH, ht : LENGTH ) : SAME pre (wdth.lgth > 0.0) and (ht.lgth > 0.0) post true is -- This routine creates a new object from the given dimensions. return width(wdth).height(ht) ; end ; create( wdth : FLT, ht : FLT, kind : UNITS ) : SAME pre (wdth > 0.0) and (ht > 0.0) and ~kind.is_nil post true is -- This routine creates a new size object from the given numeric values -- and kind. No consistency checking is possible. me : SAME ; me := me.width(LENGTH::create(wdth,kind)) ; me := me.height(LENGTH::create(ht,kind)) ; return me end ; nil : SAME is -- This routine returns the null rectangle. return width(LENGTH::null).height(LENGTH::null) end ; is_nil : BOOL is -- This routine returns true if and only if self is the null rectangle. return (width = LENGTH::null) or (height = LENGTH::null) end ; position( at : POINT ) : BOX is -- This routine creates a box from self positioned so that the lower -- left corner is at the given point. return BOX::create(at,self) end ; is_eq( other : SAME ) : BOOL is -- This predicate returns true if and only if the two objects have -- the same height and width. return (width = other.width) and (height = other.height) end ; binstr : BINSTR pre true post (result.size > 0) is -- This routine creates a binary string representation of self. return width.binstr + height.binstr end ; str( units : UNITS, lib : LIBCHARS ) : STR pre ~is_nil and ~units.is_nil and ~void(lib) post ~void(result) is -- This routine provides a string representation of the size in -- an area product form in the given units, using the given repertoire and -- encoding. return width.nodim_str(units,lib) + lib.Space.char + lib.Asterisk.char + lib.Space.char + height.nodim_str(units,lib) + units.str(lib) end ; str( units : UNITS ) : STR pre ~is_nil and ~units.is_nil post ~void(result) is -- This routine provides a string representation of the size in an area -- product form, using the given units, in the default repertoire and -- encoding. return str(units,LIBCHARS::default) end ; str( lib : LIBCHARS ) : STR pre ~is_nil and ~void(lib) post ~void(result) is -- This routine provides a string representation of the size in -- an area product form, in the default units (millimetres), using the given -- repertoire and encoding. return str(UNITS::Millimetres,lib) end ; str : STR pre ~is_nil post ~void(result) is -- This routine provides a string representation of the size in -- an area product form, using the default units (millimetres), in the -- default encoding and repertoire. return str(UNITS::Millimetres,LIBCHARS::default) end ; end ; -- RECTANGLE

immutable class TRANSFORM_MATRIX < $IS_EQ, $STR

immutable class TRANSFORM_MATRIX < $IS_EQ, $STR is -- This class represents the mathematical two-dimensional co-ordinate -- transformation matrix -- incorporating only the six elements necessary -- for carrying out the transformation. In addition to equality testing, -- a matrix multiplication operation is provided. -- -- The three-dimensional matrix is defined as -- -- x_scale * cos(rot) y_scale * sin(rot) [ 0 ] -- - x_scale * sin(rot) y_scale * cos(rot) [ 0 ] -- x_shift y_shift [ 1 ] -- -- in which the third column is not represented. Coordinates of the -- array representation, starting with zeroth index element, are read left -- to right then top to bottom. -- -- NOTE Rotation is defined in terms of ANTI-CLOCKWISE positive. -- Version 1.1 Aug 97. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 10 Jan 97 kh Original -- 8 Aug 97 kh Modified to include from AVAL! include AVAL{FLT} ; include COMPARABLE ; readonly attr matrix : ARRAY{FLT} ; private const asize : CARD := 6 ; const identity : SAME := identity.matrix(| 1.0, 0.0, 0.0, 1.0, 0.0, 0.0 |) ; const x_flip : SAME := x_flip.matrix(| -1.0, 0.0, 0.0, 1.0, 0.0, 0.0 |) ; const y_flip : SAME := y_flip.matrix(| 1.0, 0.0, 0.0, -1.0, 0.0, 0.0 |) ; const clockwise : SAME := clockwise.matrix(| 0.0, 1.0, -1.0, 0.0, 0.0, 0.0 |) ; const anti_clockwise : SAME := anti_clockwise.matrix( | 0.0, -1.0, 1.0, 0.0, 0.0, 0.0 |) ; create( x_scale, y_scale, x_shift, y_shift : FLT, angle : ANGLE ) : SAME pre (x_scale /= 0.0) and (y_scale /= 0.0) is -- This form of creation provides for a general transformation matrix. -- The angle of rotation must be specified in radians! me : SAME ; sine : FLT := angle.sin ; cosine : FLT := angle.cos ; me := me.matrix(| x_scale * cosine, y_scale * sine, - x_scale * sine, y_scale * cosine, x_shift, y_shift | ) ; return me end ; translation( x_shift, y_shift : FLT ) : SAME is -- This is a variation of creation solely providing the indicated -- translation. me : SAME := me.matrix(| 1.0, 0.0, 0.0, 1.0, x_shift, y_shift |) ; return me end ; scaling( x_scale, y_scale : FLT ) : SAME pre (x_scale /= 0.0) and (y_scale /= 0.0) is -- This variant of creation provides a matrix for scaling only. me : SAME := me.matrix(| x_scale, 0.0, 0.0, y_scale, 0.0, 0.0 |) ; return me end ; rotation( angle : ANGLE ) : SAME is -- This creation variant provides a matrix for rotation (anti-clockwise -- positive) by an angle given in radians! sine : FLT := angle.sin ; cosine : FLT := angle.cos ; me : SAME := me.matrix(| cosine, sine, -sine, cosine, 0.0, 0.0 |) ; return me end ; is_eq( other : SAME ) : BOOL is -- This predicate returns true if and only if self and other are the same transformation matrix. return (matrix[0] = other.matrix[0]) and (matrix[1] = other.matrix[1]) and (matrix[2] = other.matrix[2]) and (matrix[3] = other.matrix[3]) and (matrix[4] = other.matrix[4]) and (matrix[5] = other.matrix[5]) end ; angle : ANGLE is -- This routine returns the angle in the range pi to -pi which -- the matrix provides. loc_angle : ANGLE ; loc_factor : FLT := self.matrix[1] ; if self.matrix[3] = 0.0 then loc_sign : NUM_SIGNS := loc_factor.sign ; if loc_sign = NUM_SIGNS::Positive then loc_factor := FLT::one elsif loc_sign = NUM_SIGNS::Zero then loc_factor := FLT::zero else loc_factor := - FLT::one end ; loc_angle := ANGLE::radians((FLT::pi / 2.0) * loc_factor) else loc_angle := ANGLE::atan(loc_factor / self.matrix[3]) end ; if (self.matrix[0] < 0.0) then return ANGLE::radians(FLT::pi) - loc_angle else return loc_angle end end ; times( other : SAME ) : SAME is -- This is the matrix 'multiplication' operator which ensures that -- the resultant transformation is the product of the individual -- translations applied successively. res : SAME := res.matrix( | (self.matrix[0] * other.matrix[0]) + (self.matrix[1] * other.matrix[2]), (self.matrix[0] * other.matrix[1]) + (self.matrix[1] * other.matrix[3]), (self.matrix[2] * other.matrix[0]) + (self.matrix[3] * other.matrix[2]), (self.matrix[2] * other.matrix[1]) + (self.matrix[3] * other.matrix[3]), self.matrix[4] + other.matrix[4], self.matrix[5] + other.matrix[5] | ) ; return res end ; str( sep : CHAR, lib : LIBCHARS ) : STR pre ~void(lib) and sep.is_print post ~void(result) is -- This operation provides a string form representation with the given -- item separator in the given repertoire and encoding. return STR::create + lib.Left_Bracket.char + matrix[0].str + sep + matrix[1].str + sep + matrix[2].str + sep + matrix[3].str + sep + matrix[4].str + sep + matrix[5].str + lib.Right_Bracket.char end ; ps_str( lib : LIBCHARS ) : STR pre ~void(lib) post ~void(result) is -- This routine provides a string form representation of the -- transformation matrix in a special form suitable for sending to -- a Postscript engine using the given repertoire and encoding. return str(lib.Space.char,lib) end ; str( sep : CHAR ) : STR pre sep.is_print post ~void(result) is -- This operation provides a string form representation using the given -- item separator in the current repertoire and encoding. return str(sep,LIBCHARS::default) end ; str( lib : LIBCHARS ) : STR pre ~void(lib) post ~void(result) is -- This operation provides a string form representation of the -- transformation matrix in a form suitable for sending to a Postscript -- engine using the given repertoire and encoding. return str(lib.Comma.char,lib) end ; str : STR pre true post ~void(result) is -- This operation provides a default string form representation using -- the current repertoire and encoding. lib : LIBCHARS := LIBCHARS::default ; return str(lib.Comma.char,lib) end ; end ; -- TRANSFORM_MATRIX