MODULE*************************************************************************** Wrapper for RasterModeProp.Kind ***************************************************************************; IMPORT ObAnimHandle, ObAux, ObCommand, ObLib, ObLongReal, ObProp, ObProtoLoader, ObReal, ObValue, Obliq, Prop, ProxiedObj, RasterModeProp, RasterModePropProxy, SynLocation, Text; ObRasterModeProp
PROCEDURE*************************************************************************** Wrapper for RasterModeProp.Name ***************************************************************************NewKind (kind : RasterModeProp.Kind) : ObValue.Val = BEGIN CASE kind OF | RasterModeProp.Kind.Hollow => RETURN Obliq.NewText ("Hollow"); | RasterModeProp.Kind.Solid => RETURN Obliq.NewText ("Solid"); | RasterModeProp.Kind.Empty => RETURN Obliq.NewText ("Empty"); END; END NewKind; EXCEPTION BadKind(TEXT); PROCEDUREKindToM3 (val : ObValue.Val) : RasterModeProp.Kind RAISES {BadKind} = BEGIN TYPECASE val OF | ObValue.ValText (node) => IF Text.Equal (node.text, "Hollow") THEN RETURN RasterModeProp.Kind.Hollow; ELSIF Text.Equal (node.text, "Solid") THEN RETURN RasterModeProp.Kind.Solid; ELSIF Text.Equal (node.text, "Empty") THEN RETURN RasterModeProp.Kind.Empty; ELSE RAISE BadKind("Unknown RasterMode"); END; ELSE RAISE BadKind("RasterMode must be a Text"); END; END KindToM3; PROCEDUREGetKind (args : ObValue.ArgArray; idx : INTEGER; package : ObLib.T; opCode : ObLib.OpCode; loc : SynLocation.T) : RasterModeProp.Kind RAISES {ObValue.Error} = BEGIN TRY RETURN KindToM3 (args[idx]); EXCEPT | BadKind => ObValue.BadArgType (idx, pkgname, package.name, opCode.name, loc); RETURN RasterModeProp.Kind.Solid; (* to suppress compiler warning *) END; END GetKind;
TYPE Name = ObProp.Name BRANDED "ObRasterModeProp.Name" OBJECT END; PROCEDURE*************************************************************************** Wrapper for RasterModeProp.Val ***************************************************************************AddNameObj (pn : RasterModeProp.Name) = <* FATAL ObValue.Error, ObValue.Exception *> BEGIN WITH obj = Obliq.ObjectClone (Obliq.Vals {NameProto}), raw = NEW (Name, what := "<a RasterModeProp.Name>", po := pn) DO Obliq.ObjectUpdate (obj, "raw", raw); pn.proxy := NEW (ProxiedObj.Proxy, obj := obj); END; END AddNameObj; PROCEDUREGetName (args : ObValue.ArgArray; idx : INTEGER; package : ObLib.T; opCode : ObLib.OpCode; loc : SynLocation.T) : RasterModeProp.Name RAISES {ObValue.Error, ObValue.Exception} = BEGIN WITH raw = Obliq.ObjectSelect (args[idx], "raw") DO TYPECASE raw OF | Name (node) => RETURN node.po; ELSE ObValue.BadArgType (idx, pkgname, package.name, opCode.name, loc); RETURN NIL; (* ... only to suppress compiler warning *) END; END; END GetName;
TYPE Val = ObProp.Val BRANDED "ObRasterModeProp.Val" OBJECT END; PROCEDURE*************************************************************************** Wrapper for RasterModeProp.Beh ***************************************************************************AddValObj (pv : RasterModeProp.Val) = <* FATAL ObValue.Error, ObValue.Exception *> BEGIN WITH obj = Obliq.ObjectClone (Obliq.Vals {ValProto}), raw = NEW (Val, what := "<a RasterModeProp.Val>", po := pv) DO Obliq.ObjectUpdate (obj, "raw", raw); pv.proxy := NEW (ProxiedObj.Proxy, obj := obj); END; END AddValObj; PROCEDUREGetVal (args : ObValue.ArgArray; idx : INTEGER; package : ObLib.T; opCode : ObLib.OpCode; loc : SynLocation.T) : RasterModeProp.Val RAISES {ObValue.Error, ObValue.Exception} = BEGIN WITH raw = Obliq.ObjectSelect (args[idx], "raw") DO TYPECASE raw OF | Val (node) => RETURN node.po; ELSE ObValue.BadArgType (idx, pkgname, package.name, opCode.name, loc); RETURN NIL; (* ... only to suppress compiler warning *) END; END; END GetVal; PROCEDUREGetOverloadedVal (args : ObValue.ArgArray; idx : INTEGER; package : ObLib.T; opCode : ObLib.OpCode; loc : SynLocation.T) : RasterModeProp.Val RAISES {ObValue.Error, ObValue.Exception} = BEGIN TYPECASE args[idx] OF | ObValue.ValText (node) => IF Text.Equal (node.text, "Hollow") THEN RETURN RasterModeProp.NewConst (RasterModeProp.Kind.Hollow); ELSIF Text.Equal (node.text, "Solid") THEN RETURN RasterModeProp.NewConst (RasterModeProp.Kind.Solid); ELSIF Text.Equal (node.text, "Empty") THEN RETURN RasterModeProp.NewConst (RasterModeProp.Kind.Empty); ELSE ObValue.BadArgType (idx, pkgname, package.name, opCode.name, loc); RETURN NIL; (* ... only to suppress compiler warning *) END; | ObValue.ValObj => WITH raw = Obliq.ObjectSelect (args[idx], "raw") DO TYPECASE raw OF | Val (node) => RETURN node.po; ELSE ObValue.BadArgType (idx, pkgname, package.name, opCode.name, loc); RETURN NIL; (* ... only to suppress compiler warning *) END; END; ELSE ObValue.BadArgType (idx, pkgname, package.name, opCode.name, loc); RETURN NIL; (* ... only to suppress compiler warning *) END; END GetOverloadedVal;
TYPE Beh = ObProp.Beh BRANDED "ObRasterModeProp.Beh" OBJECT END; PROCEDURE*************************************************************************** Wrapper for RasterModeProp.ConstBeh ***************************************************************************GetBeh (args : ObValue.ArgArray; idx : INTEGER; package : ObLib.T; opCode : ObLib.OpCode; loc : SynLocation.T) : RasterModeProp.Beh RAISES {ObValue.Error, ObValue.Exception} = BEGIN WITH raw = Obliq.ObjectSelect (args[idx], "raw") DO TYPECASE raw OF | Beh (node) => RETURN node.po; ELSE ObValue.BadArgType (idx, pkgname, package.name, opCode.name, loc); RETURN NIL; (* ... only to suppress compiler warning *) END; END; END GetBeh;
TYPE ConstBeh = Beh BRANDED "ObRasterModeProp.ConstBeh" OBJECT END; PROCEDURE*************************************************************************** Wrapper for RasterModeProp.SyncBeh ***************************************************************************AddConstBehObj (beh : RasterModeProp.ConstBeh) = <* FATAL ObValue.Error, ObValue.Exception *> BEGIN WITH obj = Obliq.ObjectClone (Obliq.Vals {ConstBehProto}), raw = NEW (ConstBeh, what := "<a RasterModeProp.ConstBeh>", po := beh) DO Obliq.ObjectUpdate (obj, "raw", raw); beh.proxy := NEW (ProxiedObj.Proxy, obj := obj); END; END AddConstBehObj; PROCEDUREGetConstBeh (args : ObValue.ArgArray; idx : INTEGER; package : ObLib.T; opCode : ObLib.OpCode; loc : SynLocation.T) : RasterModeProp.ConstBeh RAISES {ObValue.Error, ObValue.Exception} = BEGIN WITH raw = Obliq.ObjectSelect (args[idx], "raw") DO TYPECASE raw OF | ConstBeh (node) => RETURN node.po; ELSE ObValue.BadArgType (idx, pkgname, package.name, opCode.name, loc); RETURN NIL; (* ... only to suppress compiler warning *) END; END; END GetConstBeh;
TYPE SyncBeh = Beh BRANDED "ObRasterModeProp.SyncBeh" OBJECT END; PROCEDURE*************************************************************************** Wrapper for RasterModeProp.AsyncBeh ***************************************************************************AddSyncBehObj (beh : RasterModeProp.SyncBeh) = <* FATAL ObValue.Error, ObValue.Exception *> BEGIN WITH obj = Obliq.ObjectClone (Obliq.Vals {SyncBehProto}), raw = NEW (SyncBeh, what := "<a RasterModeProp.SyncBeh>", po := beh) DO Obliq.ObjectUpdate (obj, "raw", raw); beh.proxy := NEW (ProxiedObj.Proxy, obj := obj); END; END AddSyncBehObj; PROCEDUREGetSyncBeh (args : ObValue.ArgArray; idx : INTEGER; package : ObLib.T; opCode : ObLib.OpCode; loc : SynLocation.T) : RasterModeProp.SyncBeh RAISES {ObValue.Error, ObValue.Exception} = BEGIN WITH raw = Obliq.ObjectSelect (args[idx], "raw") DO TYPECASE raw OF | SyncBeh (node) => RETURN node.po; ELSE ObValue.BadArgType (idx, pkgname, package.name, opCode.name, loc); RETURN NIL; (* ... only to suppress compiler warning *) END; END; END GetSyncBeh;
TYPE AsyncBeh = Beh BRANDED "ObRasterModeProp.AsyncBeh" OBJECT END; PROCEDURE*************************************************************************** Wrapper for RasterModeProp.DepBeh ***************************************************************************AddAsyncBehObj (beh : RasterModeProp.AsyncBeh) = <* FATAL ObValue.Error, ObValue.Exception *> BEGIN WITH obj = Obliq.ObjectClone (Obliq.Vals {AsyncBehProto}), raw = NEW (AsyncBeh, what := "<a RasterModeProp.AsyncBeh>", po := beh) DO Obliq.ObjectUpdate (obj, "raw", raw); beh.proxy := NEW (AsyncBehProxy, obj := obj); END; END AddAsyncBehObj; TYPE AsyncBehProxy = RasterModePropProxy.AsyncBehProxy BRANDED OBJECT OVERRIDES compute := AsyncBehCompute; END; PROCEDUREAsyncBehCompute (proxy : AsyncBehProxy; time : LONGREAL) : RasterModeProp.Kind RAISES {Prop.BadMethod} = BEGIN TRY WITH args = Obliq.Vals {Obliq.NewReal (time)}, obj = NARROW (proxy.obj, Obliq.Val), res = Obliq.ObjectInvoke (obj, "compute", args) DO RETURN KindToM3 (res); END; EXCEPT | BadKind (msg) => RAISE Prop.BadMethod (msg); | ObValue.Error (packet) => RAISE Prop.BadMethod (ObAux.ErrorToText (packet)); | ObValue.Exception (packet) => RAISE Prop.BadMethod (ObAux.ExceptionToText (packet)); END; END AsyncBehCompute;
TYPE DepBeh = Beh BRANDED "ObRasterModeProp.DepBeh" OBJECT END; PROCEDURE*************************************************************************** Wrapper for RasterModeProp.Request ***************************************************************************AddDepBehObj (beh : RasterModeProp.DepBeh) = <* FATAL ObValue.Error, ObValue.Exception *> BEGIN WITH obj = Obliq.ObjectClone (Obliq.Vals {DepBehProto}), raw = NEW (DepBeh, what := "<a RasterModeProp.DepBeh>", po := beh) DO Obliq.ObjectUpdate (obj, "raw", raw); beh.proxy := NEW (DepBehProxy, obj := obj); END; END AddDepBehObj; TYPE DepBehProxy = RasterModePropProxy.DepBehProxy BRANDED OBJECT OVERRIDES compute := DepBehCompute; END; PROCEDUREDepBehCompute (proxy : DepBehProxy; time : LONGREAL) : RasterModeProp.Kind RAISES {Prop.BadMethod} = BEGIN TRY WITH args = Obliq.Vals {Obliq.NewReal (time)}, obj = NARROW (proxy.obj, Obliq.Val), res = Obliq.ObjectInvoke (obj, "compute", args) DO RETURN KindToM3 (res); END; EXCEPT | BadKind (msg) => RAISE Prop.BadMethod (msg); | ObValue.Error (packet) => RAISE Prop.BadMethod (ObAux.ErrorToText (packet)); | ObValue.Exception (packet) => RAISE Prop.BadMethod (ObAux.ExceptionToText (packet)); END; END DepBehCompute;
TYPE Request = ObProp.Request BRANDED "ObRasterModeProp.Request" OBJECT END; PROCEDURE*************************************************************************** Setup procedures ***************************************************************************AddRequestObj (req : RasterModeProp.Request) = <* FATAL ObValue.Error, ObValue.Exception *> BEGIN WITH obj = Obliq.ObjectClone (Obliq.Vals {RequestProto}), raw = NEW (Request, what := "<a RasterModeProp.Request>", po := req) DO Obliq.ObjectUpdate (obj, "raw", raw); req.proxy := NEW (RequestProxy, obj := obj); END; END AddRequestObj; PROCEDUREGetRequest (args : ObValue.ArgArray; idx : INTEGER; package : ObLib.T; opCode : ObLib.OpCode; loc : SynLocation.T) : RasterModeProp.Request RAISES {ObValue.Error, ObValue.Exception} = BEGIN WITH raw = Obliq.ObjectSelect (args[idx], "raw") DO TYPECASE raw OF | Request (node) => RETURN node.po; ELSE ObValue.BadArgType (idx, pkgname, package.name, opCode.name, loc); RETURN NIL; (* ... only to suppress compiler warning *) END; END; END GetRequest; TYPE RequestProxy = RasterModePropProxy.RequestProxy BRANDED OBJECT OVERRIDES value := RequestValue; END; PROCEDURERequestValue (proxy : RequestProxy; startval : RasterModeProp.Kind; reltime : REAL) : RasterModeProp.Kind RAISES {Prop.BadMethod} = BEGIN TRY WITH args = Obliq.Vals {NewKind (startval), ObReal.M3ToObliq (reltime)}, obj = NARROW (proxy.obj, Obliq.Val), res = Obliq.ObjectInvoke (obj, "value", args) DO RETURN KindToM3 (res); END; EXCEPT | BadKind (msg) => RAISE Prop.BadMethod (msg); | ObValue.Error (packet) => RAISE Prop.BadMethod (ObAux.ErrorToText (packet)); | ObValue.Exception (packet) => RAISE Prop.BadMethod (ObAux.ExceptionToText (packet)); END; END RequestValue;
PROCEDURE*************************************************************************** Execution machinery ***************************************************************************SetupPackage () = PROCEDURE NewOpCode (name: TEXT; arity: INTEGER; code: Code) : OpCode = BEGIN RETURN NEW (OpCode, name := name, arity := arity, code := code); END NewOpCode; TYPE OpCodes = ARRAY OF ObLib.OpCode; VAR opCodes := NEW (REF OpCodes, NUMBER (Code)); BEGIN opCodes^ := OpCodes { NewOpCode ("NameBind", 2, Code.NameBind), NewOpCode ("ValGetBeh", 1, Code.ValGetBeh), NewOpCode ("ValSetBeh", 2, Code.ValSetBeh), NewOpCode ("ValGet", 1, Code.ValGet), NewOpCode ("ValValue", 2, Code.ValValue), NewOpCode ("NewConst", 1, Code.NewConst), NewOpCode ("NewSync", 2, Code.NewSync), NewOpCode ("NewAsync", 1, Code.NewAsync), NewOpCode ("NewDep", 1, Code.NewDep), NewOpCode ("ConstBehSet", 2, Code.ConstBehSet), NewOpCode ("NewConstBeh", 1, Code.NewConstBeh), NewOpCode ("SyncBehAddRequest", 2, Code.SyncBehAddRequest), NewOpCode ("SyncBehChange", 3, Code.SyncBehChange), NewOpCode ("NewSyncBeh", 2, Code.NewSyncBeh), NewOpCode ("NewAsyncBeh", 1, Code.NewAsyncBeh), NewOpCode ("NewDepBeh", 1, Code.NewDepBeh), NewOpCode ("NewRequest", 3, Code.NewRequest) }; ObLib.Register (NEW (Package, name := pkgname, opCodes := opCodes)); ObLib.RegisterHelp (pkgname, Help); END SetupPackage; VAR NameProto : ObValue.Val; ValProto : ObValue.Val; ConstBehProto : ObValue.Val; SyncBehProto : ObValue.Val; AsyncBehProto : ObValue.Val; DepBehProto : ObValue.Val; RequestProto : ObValue.Val; PROCEDURESetupModule (loader : ObProtoLoader.T) = BEGIN (*** retrieve the prototypes ***) loader.load ("RasterModeProp.obl"); NameProto := loader.get ("RasterModeProp_NameProto"); ValProto := loader.get ("RasterModeProp_ValProto"); ConstBehProto := loader.get ("RasterModeProp_ConstBehProto"); SyncBehProto := loader.get ("RasterModeProp_SyncBehProto"); AsyncBehProto := loader.get ("RasterModeProp_AsyncBehProto"); DepBehProto := loader.get ("RasterModeProp_DepBehProto"); RequestProto := loader.get ("RasterModeProp_RequestProto"); (*** Register the proxy makers ***) RasterModePropProxy.NamePM := AddNameObj; RasterModePropProxy.ValPM := AddValObj; RasterModePropProxy.ConstBehPM := AddConstBehObj; RasterModePropProxy.SyncBehPM := AddSyncBehObj; RasterModePropProxy.AsyncBehPM := AddAsyncBehObj; RasterModePropProxy.DepBehPM := AddDepBehObj; RasterModePropProxy.RequestPM := AddRequestObj; END SetupModule;
TYPE Code = {NameBind, ValGetBeh, ValSetBeh, ValGet, ValValue, NewConst, NewSync, NewAsync, NewDep, ConstBehSet, NewConstBeh, SyncBehAddRequest, SyncBehChange, NewSyncBeh, NewAsyncBeh, NewDepBeh, NewRequest}; OpCode = ObLib.OpCode BRANDED OBJECT code: Code; END; Package = ObLib.T BRANDED OBJECT OVERRIDES Eval := DoEval; END; CONST pkgname = "RasterModeProp"; PROCEDURE*************************************************************************** Help ***************************************************************************DoEval (self : Package; opCode : ObLib.OpCode; <* UNUSED *> arity : ObLib.OpArity; READONLY args: ObValue.ArgArray; <* UNUSED *> temp : BOOLEAN; loc : SynLocation.T) : ObValue.Val RAISES {ObValue.Error, ObValue.Exception} = BEGIN CASE NARROW (opCode, OpCode).code OF | Code.NameBind => WITH pn = GetName (args, 1, self, opCode, loc), pv = GetVal (args, 2, self, opCode, loc), prop = pn.bind (pv) DO RETURN prop.proxy.obj; END; | Code.ValGetBeh => WITH pv = GetVal (args, 1, self, opCode, loc) DO RETURN pv.beh.proxy.obj; END; | Code.ValSetBeh => WITH pv = GetVal (args, 1, self, opCode, loc), beh = GetBeh (args, 2, self, opCode, loc) DO pv.beh := beh; RETURN ObValue.valOk; END; | Code.ValGet => WITH pv = GetVal (args, 1, self, opCode, loc) DO TRY RETURN NewKind (pv.get ()); EXCEPT | Prop.BadMethod => ObValue.RaiseException (ObProp.BadMethod, opCode.name, loc); RETURN ObValue.valOk; (* ... only to suppress compiler warning *) END; END; | Code.ValValue => WITH pv = GetVal (args, 1, self, opCode, loc), time = ObLongReal.GetArg (args, 2, self, opCode, loc) DO TRY RETURN NewKind (pv.value (time)); EXCEPT | Prop.BadMethod => ObValue.RaiseException (ObProp.BadMethod, opCode.name, loc); RETURN ObValue.valOk; (* ... only to suppress compiler warning *) END; END; | Code.NewConst => (*** AddValObj creates the actual Obliq object ***) WITH lt = GetKind (args, 1, self, opCode, loc), val = RasterModeProp.NewConst (lt) DO RETURN val.proxy.obj; END; | Code.NewSync => WITH ah = ObAnimHandle.GetT (args, 1, self, opCode, loc), lt = GetKind (args, 2, self, opCode, loc), val = RasterModeProp.NewSync (ah, lt) DO RETURN val.proxy.obj; END; | Code.NewAsync => WITH beh = NEW (RasterModeProp.AsyncBeh).init (), obj = NARROW (beh.proxy.obj, Obliq.Val) DO Obliq.ObjectUpdate (obj, "compute", args[1]); WITH val = RasterModeProp.NewAsync (beh) DO RETURN val.proxy.obj; END; END; | Code.NewDep => WITH beh = NEW (RasterModeProp.DepBeh).init (), obj = NARROW (beh.proxy.obj, Obliq.Val) DO Obliq.ObjectUpdate (obj, "compute", args[1]); WITH val = RasterModeProp.NewDep (beh) DO RETURN val.proxy.obj; END; END; | Code.ConstBehSet => WITH beh = GetConstBeh (args, 1, self, opCode, loc), lt = GetKind (args, 2, self, opCode, loc) DO beh.set (lt); RETURN ObValue.valOk; END; | Code.NewConstBeh => WITH lt = GetKind (args, 1, self, opCode, loc), beh = NEW (RasterModeProp.ConstBeh).init (lt) DO RETURN beh.proxy.obj; END; | Code.SyncBehAddRequest => WITH beh = GetSyncBeh (args, 1, self, opCode, loc), req = GetRequest (args, 2, self, opCode, loc) DO TRY beh.addRequest (req); EXCEPT | Prop.BadInterval => ObValue.RaiseException (ObProp.BadInterval, opCode.name, loc); END; RETURN ObValue.valOk; END; | Code.SyncBehChange => WITH beh = GetSyncBeh (args, 1, self, opCode, loc), lt = GetKind (args, 2, self, opCode, loc), start = ObReal.GetArg (args, 3, self, opCode, loc) DO TRY beh.change (lt, start); EXCEPT Prop.BadInterval => ObValue.RaiseException (ObProp.BadInterval, opCode.name, loc); END; RETURN ObValue.valOk; END; | Code.NewSyncBeh => WITH ah = ObAnimHandle.GetT (args, 1, self, opCode, loc), lt = GetKind (args, 2, self, opCode, loc), beh = NEW (RasterModeProp.SyncBeh).init (ah, lt) DO RETURN beh.proxy.obj; END; | Code.NewAsyncBeh => WITH beh = NEW (RasterModeProp.AsyncBeh).init (), obj = NARROW (beh.proxy.obj, Obliq.Val) DO Obliq.ObjectUpdate (obj, "compute", args[1]); RETURN obj; END; | Code.NewDepBeh => WITH beh = NEW (RasterModeProp.DepBeh).init (), obj = NARROW (beh.proxy.obj, Obliq.Val) DO Obliq.ObjectUpdate (obj, "compute", args[1]); RETURN obj; END; | Code.NewRequest => WITH start = ObReal.GetArg (args, 1, self, opCode, loc), dur = ObReal.GetArg (args, 2, self, opCode, loc), req = NEW (RasterModeProp.Request).init (start, dur), obj = NARROW (req.proxy.obj, Obliq.Val) DO Obliq.ObjectUpdate (obj, "value", args[3]); RETURN obj; END; END; END DoEval;
PROCEDUREHelp (self : ObCommand.T; arg : TEXT; <* UNUSED *> data : REFANY) = BEGIN ObAux.Help (self, arg, pkgname); END Help; BEGIN END ObRasterModeProp.