Copyright (C) 1994, Digital Equipment Corp.
Created by Marc Najork
MODULE LineGO EXPORTS LineGO, LineGOProxy;
IMPORT Color, ColorProp, ColorPropPrivate, GO, GOPrivate, GraphicsBase,
GraphicsBasePrivate, LineTypeProp, LineTypePropPrivate,
Point3, PointProp, PointPropPrivate, Prop, PropPrivate, RealProp,
RealPropPrivate;
REVEAL
T = Public BRANDED OBJECT
OVERRIDES
init := Init;
draw := Draw;
damageIfDependent := DamageIfDependent;
needsTransparency := NeedsTransparency;
END;
PROCEDURE Init (self : T) : T =
BEGIN
EVAL GO.T.init (self);
IF MkProxyT # NIL AND self.proxy = NIL THEN
MkProxyT (self);
END;
RETURN self;
END Init;
PROCEDURE Draw (self : T; state : GraphicsBase.T) =
BEGIN
state.push (self);
WITH p1 = Point1.getState (state),
p2 = Point2.getState (state) DO
state.drawLine (p1, p2);
state.growBoundingVolume (Point3.MidPoint (p1, p2),
Point3.Distance (p1, p2) / 2.0);
END;
state.pop (self);
END Draw;
PROCEDURE DamageIfDependent (self : T; pn : Prop.Name) =
BEGIN
IF pn = Point1 OR pn = Point2 THEN
self.damaged := TRUE;
END;
END DamageIfDependent;
PROCEDURE NeedsTransparency (<* UNUSED *> self : T;
<* UNUSED *> t : REAL) : BOOLEAN =
BEGIN
RETURN FALSE;
END NeedsTransparency;
PROCEDURE New (p1, p2 : Point3.T) : T =
VAR
line := NEW (T).init ();
BEGIN
SetPoint1 (line, p1);
SetPoint2 (line, p2);
RETURN line;
END New;
***************************************************************************
Colour_PN
***************************************************************************
TYPE
Colour_PN = ColorProp.Name OBJECT
OVERRIDES
damage := DamageColour;
push := PushColour;
pop := PopColour;
END;
PROCEDURE DamageColour (<* UNUSED *> self : Colour_PN; caller : GO.T) =
BEGIN
caller.damaged := TRUE;
END DamageColour;
PROCEDURE PushColour (self : Colour_PN;
state : GraphicsBase.T;
pv : Prop.Val) =
BEGIN
WITH stack = NARROW (state.stacks[self.id], ColorPropPrivate.Stack),
val = NARROW (pv, ColorProp.Val).val DO
IF stack.top # val THEN
state.setLineColor (val);
END;
stack.push (val);
END;
END PushColour;
PROCEDURE PopColour (self : Colour_PN; state : GraphicsBase.T) =
BEGIN
WITH stack = NARROW (state.stacks[self.id], ColorPropPrivate.Stack) DO
state.setLineColor (stack.pop ());
END;
END PopColour;
***************************************************************************
Width_PN
***************************************************************************
TYPE
Width_PN = RealProp.Name OBJECT
OVERRIDES
damage := DamageWidth;
push := PushWidth;
pop := PopWidth;
END;
PROCEDURE DamageWidth (<* UNUSED *> self : Width_PN; caller : GO.T) =
BEGIN
caller.damaged := TRUE;
END DamageWidth;
PROCEDURE PushWidth (self : Width_PN;
state : GraphicsBase.T;
pv : Prop.Val) =
BEGIN
WITH stack = NARROW (state.stacks[self.id], RealPropPrivate.Stack),
val = NARROW (pv, RealProp.Val).val DO
IF stack.top # val THEN
state.setLineWidth (val);
END;
stack.push (val);
END;
END PushWidth;
PROCEDURE PopWidth (self : Width_PN; state : GraphicsBase.T) =
BEGIN
WITH stack = NARROW (state.stacks[self.id], RealPropPrivate.Stack) DO
state.setLineWidth (stack.pop ());
END;
END PopWidth;
***************************************************************************
Type_PN
***************************************************************************
TYPE
Type_PN = LineTypeProp.Name OBJECT
OVERRIDES
damage := DamageType;
push := PushType;
pop := PopType;
END;
PROCEDURE DamageType (<* UNUSED *> self : Type_PN; caller : GO.T) =
BEGIN
caller.damaged := TRUE;
END DamageType;
PROCEDURE PushType (self : Type_PN;
state : GraphicsBase.T;
pv : Prop.Val) =
BEGIN
WITH stack = NARROW (state.stacks[self.id], LineTypePropPrivate.Stack),
val = NARROW (pv, LineTypeProp.Val).val DO
IF stack.top # val THEN
state.setLineType (val);
END;
stack.push (val);
END;
END PushType;
PROCEDURE PopType (self : Type_PN; state : GraphicsBase.T) =
BEGIN
WITH stack = NARROW (state.stacks[self.id], LineTypePropPrivate.Stack) DO
state.setLineType (stack.pop ());
END;
END PopType;
***************************************************************************
Convenience Procedures
***************************************************************************
PROCEDURE SetColour (o : GO.T; v : Color.T) =
BEGIN
o.setProp (Colour.bind (ColorProp.NewConst (v)));
END SetColour;
PROCEDURE SetWidth (o : GO.T; v : REAL) =
BEGIN
o.setProp (Width.bind (RealProp.NewConst (v)));
END SetWidth;
PROCEDURE SetType (o : GO.T; v : LineTypeProp.Kind) =
BEGIN
o.setProp (Type.bind (LineTypeProp.NewConst (v)));
END SetType;
PROCEDURE SetPoint1 (o : GO.T; v : Point3.T) =
BEGIN
o.setProp (Point1.bind (PointProp.NewConst (v)));
END SetPoint1;
PROCEDURE SetPoint2 (o : GO.T; v : Point3.T) =
BEGIN
o.setProp (Point2.bind (PointProp.NewConst (v)));
END SetPoint2;
***************************************************************************
Module body
***************************************************************************
BEGIN
Colour := NEW (Colour_PN).init (Color.White);
Width := NEW (Width_PN).init (1.0);
Type := NEW (Type_PN).init (LineTypeProp.Kind.Solid);
Point1 := NEW (PointProp.Name).init (Point3.T {0.0, 0.0, 0.0});
Point2 := NEW (PointProp.Name).init (Point3.T {1.0, 0.0, 0.0});
END LineGO.