MODULE*************************************************************************** Colour_PN ***************************************************************************LineGO EXPORTSLineGO ,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; PROCEDUREInit (self : T) : T = BEGIN EVAL GO.T.init (self); IF MkProxyT # NIL AND self.proxy = NIL THEN MkProxyT (self); END; RETURN self; END Init; PROCEDUREDraw (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; PROCEDUREDamageIfDependent (self : T; pn : Prop.Name) = BEGIN IF pn = Point1 OR pn = Point2 THEN self.damaged := TRUE; END; END DamageIfDependent; PROCEDURENeedsTransparency (<* UNUSED *> self : T; <* UNUSED *> t : REAL) : BOOLEAN = BEGIN RETURN FALSE; END NeedsTransparency; PROCEDURENew (p1, p2 : Point3.T) : T = VAR line := NEW (T).init (); BEGIN SetPoint1 (line, p1); SetPoint2 (line, p2); RETURN line; END New;
TYPE Colour_PN = ColorProp.Name OBJECT OVERRIDES damage := DamageColour; push := PushColour; pop := PopColour; END; PROCEDURE*************************************************************************** Width_PN ***************************************************************************DamageColour (<* UNUSED *> self : Colour_PN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageColour; PROCEDUREPushColour (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; PROCEDUREPopColour (self : Colour_PN; state : GraphicsBase.T) = BEGIN WITH stack = NARROW (state.stacks[self.id], ColorPropPrivate.Stack) DO state.setLineColor (stack.pop ()); END; END PopColour;
TYPE Width_PN = RealProp.Name OBJECT OVERRIDES damage := DamageWidth; push := PushWidth; pop := PopWidth; END; PROCEDURE*************************************************************************** Type_PN ***************************************************************************DamageWidth (<* UNUSED *> self : Width_PN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageWidth; PROCEDUREPushWidth (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; PROCEDUREPopWidth (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 Type_PN = LineTypeProp.Name OBJECT OVERRIDES damage := DamageType; push := PushType; pop := PopType; END; PROCEDURE*************************************************************************** Convenience Procedures ***************************************************************************DamageType (<* UNUSED *> self : Type_PN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageType; PROCEDUREPushType (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; PROCEDUREPopType (self : Type_PN; state : GraphicsBase.T) = BEGIN WITH stack = NARROW (state.stacks[self.id], LineTypePropPrivate.Stack) DO state.setLineType (stack.pop ()); END; END PopType;
PROCEDURE*************************************************************************** Module body ***************************************************************************SetColour (o : GO.T; v : Color.T) = BEGIN o.setProp (Colour.bind (ColorProp.NewConst (v))); END SetColour; PROCEDURESetWidth (o : GO.T; v : REAL) = BEGIN o.setProp (Width.bind (RealProp.NewConst (v))); END SetWidth; PROCEDURESetType (o : GO.T; v : LineTypeProp.Kind) = BEGIN o.setProp (Type.bind (LineTypeProp.NewConst (v))); END SetType; PROCEDURESetPoint1 (o : GO.T; v : Point3.T) = BEGIN o.setProp (Point1.bind (PointProp.NewConst (v))); END SetPoint1; PROCEDURESetPoint2 (o : GO.T; v : Point3.T) = BEGIN o.setProp (Point2.bind (PointProp.NewConst (v))); END SetPoint2;
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.