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