MODULE*************************************************************************** DistinguishFacets_PN ***************************************************************************; IMPORT BooleanProp, BooleanPropPrivate, Color, ColorProp, ColorPropPrivate, GO, GOPrivate, GraphicsBase, GraphicsBasePrivate, LineTypeProp, LineTypePropPrivate, Prop, PropPrivate, RasterModeProp, RasterModePropPrivate, RealProp, RealPropPrivate, ShadingProp, ShadingPropPrivate; REVEAL T = GO.T BRANDED OBJECT OVERRIDES needsTransparency := NeedsTransparency; END; PROCEDURE SurfaceGO NeedsTransparency (self : T; t : REAL) : BOOLEAN = BEGIN IF self.trans # FIRST(REAL) THEN t := self.trans; END; RETURN t > 0.0; END NeedsTransparency;
TYPE DistinguishFacets_PN = BooleanProp.Name OBJECT OVERRIDES damage := DamageDistinguishFacets; push := PushDistinguishFacets; pop := PopDistinguishFacets; END; PROCEDURE*************************************************************************** Colour_PN ***************************************************************************DamageDistinguishFacets (<* UNUSED *> self : DistinguishFacets_PN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageDistinguishFacets; PROCEDUREPushDistinguishFacets (self : DistinguishFacets_PN; state : GraphicsBase.T; pv : Prop.Val) = BEGIN WITH stack = NARROW (state.stacks[self.id], BooleanPropPrivate.Stack), val = NARROW (pv, BooleanProp.Val).val DO IF stack.top # val THEN state.setDistinguishFacetsFlag (val); END; stack.push (val); END; END PushDistinguishFacets; PROCEDUREPopDistinguishFacets (self : DistinguishFacets_PN; state : GraphicsBase.T) = BEGIN WITH stack = NARROW (state.stacks[self.id], BooleanPropPrivate.Stack) DO state.setDistinguishFacetsFlag (stack.pop ()); END; END PopDistinguishFacets;
TYPE Colour_PN = ColorProp.Name OBJECT OVERRIDES damage := DamageColour; push := PushColour; pop := PopColour; END; PROCEDURE*************************************************************************** BackColour_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.setSurfaceColor (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.setSurfaceColor (stack.pop ()); END; END PopColour;
TYPE BackColour_PN = ColorProp.Name OBJECT OVERRIDES damage := DamageBackColour; push := PushBackColour; pop := PopBackColour; END; PROCEDURE*************************************************************************** RasterMode_PN ***************************************************************************DamageBackColour (<* UNUSED *> self : BackColour_PN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageBackColour; PROCEDUREPushBackColour (self : BackColour_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.setSurfaceBackColor (val); END; stack.push (val); END; END PushBackColour; PROCEDUREPopBackColour (self : BackColour_PN; state : GraphicsBase.T) = BEGIN WITH stack = NARROW (state.stacks[self.id], ColorPropPrivate.Stack) DO state.setSurfaceBackColor (stack.pop ()); END; END PopBackColour;
TYPE RasterMode_PN = RasterModeProp.Name OBJECT OVERRIDES damage := DamageRasterMode; push := PushRasterMode; pop := PopRasterMode; END; PROCEDURE*************************************************************************** AmbientReflectionCoeff_PN ***************************************************************************DamageRasterMode (<* UNUSED *> self : RasterMode_PN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageRasterMode; PROCEDUREPushRasterMode (self : RasterMode_PN; state : GraphicsBase.T; pv : Prop.Val) = BEGIN WITH stack = NARROW (state.stacks[self.id], RasterModePropPrivate.Stack), val = NARROW (pv, RasterModeProp.Val).val DO IF stack.top # val THEN state.setRasterMode (val); END; stack.push (val); END; END PushRasterMode; PROCEDUREPopRasterMode (self : RasterMode_PN; state : GraphicsBase.T) = BEGIN WITH stack = NARROW (state.stacks[self.id], RasterModePropPrivate.Stack) DO state.setRasterMode (stack.pop ()); END; END PopRasterMode;
TYPE AmbientReflectionCoeff_PN = RealProp.Name OBJECT OVERRIDES damage := DamageAmbientReflectionCoeff; push := PushAmbientReflectionCoeff; pop := PopAmbientReflectionCoeff; END; PROCEDURE*************************************************************************** DiffuseReflectionCoeff_PN ***************************************************************************DamageAmbientReflectionCoeff ( <* UNUSED *> self : AmbientReflectionCoeff_PN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageAmbientReflectionCoeff; PROCEDUREPushAmbientReflectionCoeff (self : AmbientReflectionCoeff_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.setAmbientReflCoeff (val); END; stack.push (val); END; END PushAmbientReflectionCoeff; PROCEDUREPopAmbientReflectionCoeff (self : AmbientReflectionCoeff_PN; state : GraphicsBase.T) = BEGIN WITH stack = NARROW (state.stacks[self.id], RealPropPrivate.Stack) DO state.setAmbientReflCoeff (stack.pop ()); END; END PopAmbientReflectionCoeff;
TYPE DiffuseReflectionCoeff_PN = RealProp.Name OBJECT OVERRIDES damage := DamageDiffuseReflectionCoeff; push := PushDiffuseReflectionCoeff; pop := PopDiffuseReflectionCoeff; END; PROCEDURE*************************************************************************** SpecularReflectionCoeff_PN ***************************************************************************DamageDiffuseReflectionCoeff ( <* UNUSED *> self : DiffuseReflectionCoeff_PN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageDiffuseReflectionCoeff; PROCEDUREPushDiffuseReflectionCoeff (self : DiffuseReflectionCoeff_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.setDiffuseReflCoeff (val); END; stack.push (val); END; END PushDiffuseReflectionCoeff; PROCEDUREPopDiffuseReflectionCoeff (self : DiffuseReflectionCoeff_PN; state : GraphicsBase.T) = BEGIN WITH stack = NARROW (state.stacks[self.id], RealPropPrivate.Stack) DO state.setDiffuseReflCoeff (stack.pop ()); END; END PopDiffuseReflectionCoeff;
TYPE SpecularReflectionCoeff_PN = RealProp.Name OBJECT OVERRIDES damage := DamageSpecularReflectionCoeff; push := PushSpecularReflectionCoeff; pop := PopSpecularReflectionCoeff; END; PROCEDURE*************************************************************************** SpecularReflectionConcPN ***************************************************************************DamageSpecularReflectionCoeff ( <* UNUSED *> self : SpecularReflectionCoeff_PN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageSpecularReflectionCoeff; PROCEDUREPushSpecularReflectionCoeff (self : SpecularReflectionCoeff_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.setSpecularReflCoeff (val); END; stack.push (val); END; END PushSpecularReflectionCoeff; PROCEDUREPopSpecularReflectionCoeff (self : SpecularReflectionCoeff_PN; state : GraphicsBase.T) = BEGIN WITH stack = NARROW (state.stacks[self.id], RealPropPrivate.Stack) DO state.setSpecularReflCoeff (stack.pop ()); END; END PopSpecularReflectionCoeff;
TYPE SpecularReflectionConcPN = RealProp.Name OBJECT OVERRIDES damage := DamageSpecularReflectionConc; push := PushSpecularReflectionConc; pop := PopSpecularReflectionConc; END; PROCEDURE*************************************************************************** TransmissionCoeff_PN ***************************************************************************DamageSpecularReflectionConc ( <* UNUSED *> self : SpecularReflectionConcPN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageSpecularReflectionConc; PROCEDUREPushSpecularReflectionConc (self : SpecularReflectionConcPN; 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.setSpecularReflConc (val); END; stack.push (val); END; END PushSpecularReflectionConc; PROCEDUREPopSpecularReflectionConc (self : SpecularReflectionConcPN; state : GraphicsBase.T) = BEGIN WITH stack = NARROW (state.stacks[self.id], RealPropPrivate.Stack) DO state.setSpecularReflConc (stack.pop ()); END; END PopSpecularReflectionConc;
TYPE TransmissionCoeff_PN = RealProp.Name OBJECT OVERRIDES damage := DamageTransmissionCoeff; push := PushTransmissionCoeff; pop := PopTransmissionCoeff; END; PROCEDURE*************************************************************************** SpecularReflectionColour_PN ***************************************************************************DamageTransmissionCoeff ( <* UNUSED *> self : TransmissionCoeff_PN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageTransmissionCoeff; PROCEDUREPushTransmissionCoeff (self : TransmissionCoeff_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.setTransmissionCoeff (val); END; stack.push (val); END; END PushTransmissionCoeff; PROCEDUREPopTransmissionCoeff (self : TransmissionCoeff_PN; state : GraphicsBase.T) = BEGIN WITH stack = NARROW (state.stacks[self.id], RealPropPrivate.Stack) DO state.setTransmissionCoeff (stack.pop ()); END; END PopTransmissionCoeff;
TYPE SpecularReflectionColour_PN = ColorProp.Name OBJECT OVERRIDES damage := DamageSpecularReflectionColour; push := PushSpecularReflectionColour; pop := PopSpecularReflectionColour; END; PROCEDURE*************************************************************************** Lighting_PN ***************************************************************************DamageSpecularReflectionColour ( <* UNUSED *> self : SpecularReflectionColour_PN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageSpecularReflectionColour; PROCEDUREPushSpecularReflectionColour (self : SpecularReflectionColour_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.setSpecularReflColor (val); END; stack.push (val); END; END PushSpecularReflectionColour; PROCEDUREPopSpecularReflectionColour (self : SpecularReflectionColour_PN; state : GraphicsBase.T) = BEGIN WITH stack = NARROW (state.stacks[self.id], ColorPropPrivate.Stack) DO state.setSpecularReflColor (stack.pop ()); END; END PopSpecularReflectionColour;
TYPE Lighting_PN = BooleanProp.Name OBJECT OVERRIDES damage := DamageLighting; push := PushLighting; pop := PopLighting; END; PROCEDURE*************************************************************************** Shading_PN ***************************************************************************DamageLighting (<* UNUSED *> self : Lighting_PN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageLighting; PROCEDUREPushLighting (self : Lighting_PN; state : GraphicsBase.T; pv : Prop.Val) = BEGIN WITH stack = NARROW (state.stacks[self.id], BooleanPropPrivate.Stack), val = NARROW (pv, BooleanProp.Val).val DO IF stack.top # val THEN state.setLighting (val); END; stack.push (val); END; END PushLighting; PROCEDUREPopLighting (self : Lighting_PN; state : GraphicsBase.T) = BEGIN WITH stack = NARROW (state.stacks[self.id], BooleanPropPrivate.Stack) DO state.setLighting (stack.pop ()); END; END PopLighting;
TYPE Shading_PN = ShadingProp.Name OBJECT OVERRIDES damage := DamageShading; push := PushShading; pop := PopShading; END; PROCEDURE*************************************************************************** EdgeVisibility_PN ***************************************************************************DamageShading (<* UNUSED *> self : Shading_PN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageShading; PROCEDUREPushShading (self : Shading_PN; state : GraphicsBase.T; pv : Prop.Val) = BEGIN WITH stack = NARROW (state.stacks[self.id], ShadingPropPrivate.Stack), val = NARROW (pv, ShadingProp.Val).val DO IF stack.top # val THEN state.setShading (val); END; stack.push (val); END; END PushShading; PROCEDUREPopShading (self : Shading_PN; state : GraphicsBase.T) = BEGIN WITH stack = NARROW (state.stacks[self.id], ShadingPropPrivate.Stack) DO state.setShading (stack.pop ()); END; END PopShading;
TYPE EdgeVisibility_PN = BooleanProp.Name OBJECT OVERRIDES damage := DamageEdgeVisibility; push := PushEdgeVisibility; pop := PopEdgeVisibility; END; PROCEDURE*************************************************************************** EdgeColour_PN ***************************************************************************DamageEdgeVisibility (<* UNUSED *> self : EdgeVisibility_PN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageEdgeVisibility; PROCEDUREPushEdgeVisibility (self : EdgeVisibility_PN; state : GraphicsBase.T; pv : Prop.Val) = BEGIN WITH stack = NARROW (state.stacks[self.id], BooleanPropPrivate.Stack), val = NARROW (pv, BooleanProp.Val).val DO IF stack.top # val THEN state.setSurfaceEdgeFlag (val); END; stack.push (val); END; END PushEdgeVisibility; PROCEDUREPopEdgeVisibility (self : EdgeVisibility_PN; state : GraphicsBase.T) = BEGIN WITH stack = NARROW (state.stacks[self.id], BooleanPropPrivate.Stack) DO state.setSurfaceEdgeFlag (stack.pop ()); END; END PopEdgeVisibility;
TYPE EdgeColour_PN = ColorProp.Name OBJECT OVERRIDES damage := DamageEdgeColour; push := PushEdgeColour; pop := PopEdgeColour; END; PROCEDURE*************************************************************************** EdgeType_PN ***************************************************************************DamageEdgeColour (<* UNUSED *> self : EdgeColour_PN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageEdgeColour; PROCEDUREPushEdgeColour (self : EdgeColour_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.setSurfaceEdgeColor (val); END; stack.push (val); END; END PushEdgeColour; PROCEDUREPopEdgeColour (self : EdgeColour_PN; state : GraphicsBase.T) = BEGIN WITH stack = NARROW (state.stacks[self.id], ColorPropPrivate.Stack) DO state.setSurfaceEdgeColor (stack.pop ()); END; END PopEdgeColour;
TYPE EdgeType_PN = LineTypeProp.Name OBJECT OVERRIDES damage := DamageEdgeType; push := PushEdgeType; pop := PopEdgeType; END; PROCEDURE*************************************************************************** EdgeWidth_PN ***************************************************************************DamageEdgeType (<* UNUSED *> self : EdgeType_PN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageEdgeType; PROCEDUREPushEdgeType (self : EdgeType_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.setSurfaceEdgeType (val); END; stack.push (val); END; END PushEdgeType; PROCEDUREPopEdgeType (self : EdgeType_PN; state : GraphicsBase.T) = BEGIN WITH stack = NARROW (state.stacks[self.id], LineTypePropPrivate.Stack) DO state.setSurfaceEdgeType (stack.pop ()); END; END PopEdgeType;
TYPE EdgeWidth_PN = RealProp.Name OBJECT OVERRIDES damage := DamageEdgeWidth; push := PushEdgeWidth; pop := PopEdgeWidth; END; PROCEDURE*************************************************************************** Convenience Procedures ***************************************************************************DamageEdgeWidth (<* UNUSED *> self : EdgeWidth_PN; caller : GO.T) = BEGIN caller.damaged := TRUE; END DamageEdgeWidth; PROCEDUREPushEdgeWidth (self : EdgeWidth_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.setSurfaceEdgeWidth (val); END; stack.push (val); END; END PushEdgeWidth; PROCEDUREPopEdgeWidth (self : EdgeWidth_PN; state : GraphicsBase.T) = BEGIN WITH stack = NARROW (state.stacks[self.id], RealPropPrivate.Stack) DO state.setSurfaceEdgeWidth (stack.pop ()); END; END PopEdgeWidth;
PROCEDURE*************************************************************************** Main body ***************************************************************************SetDistinguishFacets (o : GO.T; v : BOOLEAN) = BEGIN o.setProp (DistinguishFacets.bind (BooleanProp.NewConst (v))); END SetDistinguishFacets; PROCEDURESetColour (o : GO.T; v : Color.T) = BEGIN o.setProp (Colour.bind (ColorProp.NewConst (v))); END SetColour; PROCEDURESetBackColour (o : GO.T; v : Color.T) = BEGIN o.setProp (BackColour.bind (ColorProp.NewConst (v))); END SetBackColour; PROCEDURESetRasterMode (o : GO.T; v : RasterModeProp.Kind) = BEGIN o.setProp (RasterMode.bind (RasterModeProp.NewConst (v))); END SetRasterMode; PROCEDURESetAmbientReflectionCoeff (o : GO.T; v : REAL) = BEGIN o.setProp (AmbientReflectionCoeff.bind (RealProp.NewConst (v))); END SetAmbientReflectionCoeff; PROCEDURESetDiffuseReflectionCoeff (o : GO.T; v : REAL) = BEGIN o.setProp (DiffuseReflectionCoeff.bind (RealProp.NewConst (v))); END SetDiffuseReflectionCoeff; PROCEDURESetSpecularReflectionCoeff (o : GO.T; v : REAL) = BEGIN o.setProp (SpecularReflectionCoeff.bind (RealProp.NewConst (v))); END SetSpecularReflectionCoeff; PROCEDURESetSpecularReflectionConc (o : GO.T; v : REAL) = BEGIN o.setProp (SpecularReflectionConc.bind (RealProp.NewConst (v))); END SetSpecularReflectionConc; PROCEDURESetTransmissionCoeff (o : GO.T; v : REAL) = BEGIN o.setProp (TransmissionCoeff.bind (RealProp.NewConst (v))); END SetTransmissionCoeff; PROCEDURESetSpecularReflectionColour (o : GO.T; v : Color.T) = BEGIN o.setProp (SpecularReflectionColour.bind (ColorProp.NewConst (v))); END SetSpecularReflectionColour; PROCEDURESetLighting (o : GO.T; v : BOOLEAN) = BEGIN o.setProp (Lighting.bind (BooleanProp.NewConst (v))); END SetLighting; PROCEDURESetShading (o : GO.T; v : ShadingProp.Kind) = BEGIN o.setProp (Shading.bind (ShadingProp.NewConst (v))); END SetShading; PROCEDURESetEdgeVisibility (o : GO.T; v : BOOLEAN) = BEGIN o.setProp (EdgeVisibility.bind (BooleanProp.NewConst (v))); END SetEdgeVisibility; PROCEDURESetEdgeColour (o : GO.T; v : Color.T) = BEGIN o.setProp (EdgeColour.bind (ColorProp.NewConst (v))); END SetEdgeColour; PROCEDURESetEdgeType (o : GO.T; v : LineTypeProp.Kind) = BEGIN o.setProp (EdgeType.bind (LineTypeProp.NewConst (v))); END SetEdgeType; PROCEDURESetEdgeWidth (o : GO.T; v : REAL) = BEGIN o.setProp (EdgeWidth.bind (RealProp.NewConst (v))); END SetEdgeWidth;
BEGIN DistinguishFacets := NEW (DistinguishFacets_PN).init (FALSE); Colour := NEW (Colour_PN).init (Color.White); BackColour := NEW (BackColour_PN).init (GraphicsBasePrivate.VoidColor); RasterMode := NEW (RasterMode_PN).init (RasterModeProp.Kind.Solid); AmbientReflectionCoeff := NEW (AmbientReflectionCoeff_PN).init (0.5); DiffuseReflectionCoeff := NEW (DiffuseReflectionCoeff_PN).init (1.0); SpecularReflectionCoeff := NEW (SpecularReflectionCoeff_PN).init (0.0); SpecularReflectionConc := NEW (SpecularReflectionConcPN).init (0.0); TransmissionCoeff := NEW (TransmissionCoeff_PN).init (0.0); (* DIFFERS FROM MANUAL *) SpecularReflectionColour := NEW (SpecularReflectionColour_PN).init (Color.White); Lighting := NEW (Lighting_PN).init (TRUE); Shading := NEW (Shading_PN).init (ShadingProp.Kind.Flat); EdgeVisibility := NEW (EdgeVisibility_PN).init (FALSE); EdgeColour := NEW (EdgeColour_PN).init (Color.White); EdgeType := NEW (EdgeType_PN).init (LineTypeProp.Kind.Solid); EdgeWidth := NEW (EdgeWidth_PN).init (1.0); END SurfaceGO.