Copyright 1991 Digital Equipment Corporation.
Distributed only by permission.
UNSAFE MODULE ObLibUI;
IMPORT Color, ColorName, FormsVBT, FVTypes, MultiFilter, MultiSplit, Obliq,
ObBuiltIn, ObEval, ObLib, ObValue, Rd, Rect, SourceVBT, Split,
SynLocation, SynWr, Text, Thread, TranslateVBT, Trestle, TrestleComm,
VBT, VBTClass, ZSplit;
VAR setupDone := FALSE;
PROCEDURE PackageSetup() =
BEGIN
IF NOT setupDone THEN
setupDone := TRUE;
Setup();
END;
END PackageSetup;
PROCEDURE Setup() =
BEGIN
SetupColor();
SetupVBT();
SetupZSplit ();
SetupForm();
END Setup;
============ color package ============
TYPE
ColorCode = {Named, RGB, HSV, R, G, B, H, S, V, Brightness};
ColorOpCode =
ObLib.OpCode OBJECT
code: ColorCode;
END;
PackageColor =
ObLib.T OBJECT
OVERRIDES
Eval:=EvalColor;
END;
PROCEDURE IsColor(self: ValColor; other: ObValue.ValAnything): BOOLEAN =
BEGIN
TYPECASE other OF ValColor(oth)=> RETURN self.color = oth.color;
ELSE RETURN FALSE END;
END IsColor;
PROCEDURE CopyColor(self: ObValue.ValAnything; <*UNUSED*>tbl: ObValue.Tbl;
<*UNUSED*>loc: SynLocation.T):
ObValue.ValAnything =
BEGIN
RETURN self;
END CopyColor;
PROCEDURE NewColorOC(name: TEXT; arity: INTEGER; code: ColorCode)
: ColorOpCode =
BEGIN
RETURN NEW(ColorOpCode, name:=name, arity:=arity, code:=code);
END NewColorOC;
PROCEDURE SetupColor() =
TYPE OpCodes = ARRAY OF ObLib.OpCode;
VAR opCodes: REF OpCodes;
BEGIN
opCodes := NEW(REF OpCodes, NUMBER(ColorCode));
opCodes^ :=
OpCodes{
NewColorOC("named", 1, ColorCode.Named),
NewColorOC("rgb", 3, ColorCode.RGB),
NewColorOC("hsv", 3, ColorCode.HSV),
NewColorOC("r", 1, ColorCode.R),
NewColorOC("g", 1, ColorCode.G),
NewColorOC("b", 1, ColorCode.B),
NewColorOC("h", 1, ColorCode.H),
NewColorOC("s", 1, ColorCode.S),
NewColorOC("v", 1, ColorCode.V),
NewColorOC("brightness", 1, ColorCode.Brightness)
};
ObLib.Register(
NEW(PackageColor, name:="color", opCodes:=opCodes));
END SetupColor;
PROCEDURE EvalColor(self: PackageColor; opCode: ObLib.OpCode;
<*UNUSED*>arity: ObLib.OpArity; READONLY args: ObValue.ArgArray;
temp: BOOLEAN; loc: SynLocation.T)
: ObValue.Val RAISES {ObValue.Error} =
VAR real1, real2, real3: LONGREAL; rgb1: Color.T; hsv1: Color.HSV;
text1: TEXT;
BEGIN
CASE NARROW(opCode, ColorOpCode).code OF
| ColorCode.Named =>
TYPECASE args[1] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(1, "text", self.name, opCode.name, loc); END;
TRY rgb1 := ColorName.ToRGB(text1);
EXCEPT ColorName.NotFound => rgb1 := Color.Black;
END;
RETURN NEW(ValColor, what:="<a Color.T>", picklable:=TRUE,
tag := "Color`T", color:=rgb1);
| ColorCode.RGB =>
TYPECASE args[1] OF | ObValue.ValReal(node) => real1:=node.real;
ELSE ObValue.BadArgType(1, "real", self.name, opCode.name,
loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValReal(node) => real2:=node.real;
ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValReal(node) => real3:=node.real;
ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
IF (real1<0.0d0) OR (real1>1.0d0)
THEN ObValue.BadArgVal(1, "in range", self.name, opCode.name, loc);
<*ASSERT FALSE*>
END;
IF (real2<0.0d0) OR (real2>1.0d0)
THEN ObValue.BadArgVal(2, "in range", self.name, opCode.name, loc);<*ASSERT FALSE*>
END;
IF (real3<0.0d0) OR (real3>1.0d0)
THEN ObValue.BadArgVal(3, "in range", self.name, opCode.name, loc);<*ASSERT FALSE*>
END;
rgb1 := Color.T{r:=FLOAT(real1), g:=FLOAT(real2), b:=FLOAT(real3)};
RETURN NEW(ValColor, what:="<a Color.T>", picklable:=TRUE,
tag := "Color`T",
color:=rgb1);
| ColorCode.HSV =>
TYPECASE args[1] OF | ObValue.ValReal(node) => real1:=node.real;
ELSE ObValue.BadArgType(1, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValReal(node) => real2:=node.real;
ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValReal(node) => real3:=node.real;
ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
IF (real1<0.0d0) OR (real1>1.0d0)
THEN ObValue.BadArgVal(1, "in range", self.name,
opCode.name, loc);
<*ASSERT FALSE*>
END;
IF (real2<0.0d0) OR (real2>1.0d0)
THEN ObValue.BadArgVal(2, "in range", self.name, opCode.name, loc);
<*ASSERT FALSE*>
END;
IF (real3<0.0d0) OR (real3>1.0d0)
THEN ObValue.BadArgVal(3, "in range", self.name, opCode.name, loc);
<*ASSERT FALSE*>
END;
rgb1 := Color.FromHSV(
Color.HSV{h:=FLOAT(real1), s:=FLOAT(real2), v:=FLOAT(real3)});
RETURN NEW(ValColor, what:="<a Color.T>", tag:="Color`T",picklable:=TRUE,
color:=rgb1);
| ColorCode.R =>
TYPECASE args[1] OF | ValColor(node) => rgb1:=node.color;
ELSE ObValue.BadArgType(1, "Color`T", self.name, opCode.name, loc);
<*ASSERT FALSE*>
END;
RETURN NEW(ObValue.ValReal, real:=FLOAT(rgb1.r, LONGREAL), temp:=temp);
| ColorCode.G =>
TYPECASE args[1] OF | ValColor(node) => rgb1:=node.color;
ELSE ObValue.BadArgType(1, "Color`T", self.name, opCode.name, loc);<*ASSERT FALSE*> END;
RETURN NEW(ObValue.ValReal, real:=FLOAT(rgb1.g, LONGREAL), temp:=temp);
| ColorCode.B =>
TYPECASE args[1] OF | ValColor(node) => rgb1:=node.color;
ELSE ObValue.BadArgType(1, "Color`T", self.name, opCode.name, loc);<*ASSERT FALSE*> END;
RETURN NEW(ObValue.ValReal, real:=FLOAT(rgb1.b, LONGREAL), temp:=temp);
| ColorCode.H =>
TYPECASE args[1] OF | ValColor(node) => rgb1:=node.color;
ELSE ObValue.BadArgType(1, "Color`T", self.name, opCode.name, loc);<*ASSERT FALSE*> END;
hsv1 := Color.ToHSV(rgb1);
RETURN NEW(ObValue.ValReal, real:=FLOAT(hsv1.h, LONGREAL), temp:=temp);
| ColorCode.S =>
TYPECASE args[1] OF | ValColor(node) => rgb1:=node.color;
ELSE ObValue.BadArgType(1, "Color`T", self.name, opCode.name, loc);<*ASSERT FALSE*> END;
hsv1 := Color.ToHSV(rgb1);
RETURN NEW(ObValue.ValReal, real:=FLOAT(hsv1.s, LONGREAL), temp:=temp);
| ColorCode.V =>
TYPECASE args[1] OF | ValColor(node) => rgb1:=node.color;
ELSE ObValue.BadArgType(1, "Color`T", self.name, opCode.name, loc);<*ASSERT FALSE*> END;
hsv1 := Color.ToHSV(rgb1);
RETURN NEW(ObValue.ValReal, real:=FLOAT(hsv1.v, LONGREAL), temp:=temp);
| ColorCode.Brightness =>
TYPECASE args[1] OF | ValColor(node) => rgb1:=node.color;
ELSE ObValue.BadArgType(1, "Color`T", self.name, opCode.name, loc);<*ASSERT FALSE*> END;
RETURN NEW(ObValue.ValReal,
real:=FLOAT(Color.Brightness(rgb1), LONGREAL), temp:=temp);
ELSE
ObValue.BadOp(self.name, opCode.name, loc);<*ASSERT FALSE*>
END;
END EvalColor;
============ vbt package =============
TYPE
VBTCode = {failure, Lock, Show, Domain};
VBTOpCode = ObLib.OpCode OBJECT
code: VBTCode;
END;
PackageVBT = ObLib.T OBJECT
OVERRIDES
Eval := EvalVBT;
END;
VAR
vbt_mu: ObValue.Val;
VAR vbtException: ObValue.ValException;
PROCEDURE SetupVBT () =
PROCEDURE NewOpCode (name: TEXT; arity: INTEGER; code: VBTCode): VBTOpCode =
BEGIN
RETURN NEW (VBTOpCode, name := name, arity := arity, code := code);
END NewOpCode;
PROCEDURE NewMutex (mu: MUTEX): ObValue.Val =
BEGIN
RETURN NEW (ObBuiltIn.ValMutex,
what := "<a Thread.Mutex>",
tag := "Thread`Mutex",
picklable := FALSE,
mutex := mu);
END NewMutex;
TYPE OpCodes = ARRAY OF ObLib.OpCode;
VAR opCodes: REF OpCodes;
BEGIN
opCodes := NEW (REF OpCodes, NUMBER (VBTCode));
opCodes^ := OpCodes{NewOpCode ("mu", -1, VBTCode.Lock),
NewOpCode ("failure", -1, VBTCode.failure),
NewOpCode ("show", 1, VBTCode.Show),
NewOpCode ("domain", 1, VBTCode.Domain)
};
vbtException := NEW(ObValue.ValException, name:="vbt_failure");
vbt_mu := NewMutex (VBT.mu);
ObLib.Register (NEW (PackageVBT, name := "vbt", opCodes := opCodes));
END SetupVBT;
PROCEDURE EvalVBT ( self : PackageVBT;
opCode: ObLib.OpCode;
<*UNUSED*>arity : ObLib.OpArity;
READONLY args : ObValue.ArgArray;
<*UNUSED*>temp : BOOLEAN;
loc : SynLocation.T): ObValue.Val
RAISES {ObValue.Error, ObValue.Exception} =
VAR
vbt : VBT.T;
BEGIN
CASE NARROW (opCode, VBTOpCode).code OF
| VBTCode.failure => RETURN vbtException;
| VBTCode.Lock => RETURN vbt_mu;
| VBTCode.Show =>
TYPECASE args[1] OF | ValVBT(node) => vbt := node.vbt;
ELSE ObValue.BadArgType(1, "vbt", self.name, opCode.name, loc); END;
TRY
Trestle.Install (vbt);
EXCEPT
| TrestleComm.Failure =>
ObValue.RaiseException(vbtException, opCode.name, loc);
END;
RETURN ObValue.valOk;
| VBTCode.Domain =>
TYPECASE args[1] OF | ValVBT(node) => vbt := node.vbt;
ELSE ObValue.BadArgType(1, "vbt", self.name, opCode.name, loc); END;
WITH dom = VBT.Domain (vbt),
west = Obliq.NewInt (dom.west),
east = Obliq.NewInt (dom.east),
north = Obliq.NewInt (dom.north),
south = Obliq.NewInt (dom.south) DO
RETURN Obliq.NewArray (Obliq.Vals {west, east, north, south});
END;
END;
END EvalVBT;
PROCEDURE IsVBT(self: ValVBT; other: ObValue.ValAnything): BOOLEAN =
BEGIN
TYPECASE other OF ValVBT(oth)=> RETURN self.vbt = oth.vbt;
ELSE RETURN FALSE END;
END IsVBT;
PROCEDURE CopyVBT(<*UNUSED*>self: ObValue.ValAnything; <*UNUSED*>tbl: ObValue.Tbl;
loc: SynLocation.T): ObValue.ValAnything RAISES {ObValue.Error} =
BEGIN
ObValue.RaiseError("Cannot copy vbts", loc);<*ASSERT FALSE*>
END CopyVBT;
============ zsplit package ============
TYPE
ZSplitCode = {Move};
ZSplitOpCode = ObLib.OpCode OBJECT
code: ZSplitCode;
END;
PackageZSplit = ObLib.T OBJECT
OVERRIDES
Eval := EvalZSplit;
END;
PROCEDURE SetupZSplit () =
PROCEDURE NewOpCode (name: TEXT; arity: INTEGER; code: ZSplitCode): ZSplitOpCode =
BEGIN
RETURN NEW (ZSplitOpCode, name := name, arity := arity, code := code);
END NewOpCode;
TYPE OpCodes = ARRAY OF ObLib.OpCode;
VAR opCodes: REF OpCodes;
BEGIN
opCodes := NEW (REF OpCodes, NUMBER (ZSplitCode));
opCodes^ := OpCodes{NewOpCode ("move", 2, ZSplitCode.Move)
};
ObLib.Register (NEW (PackageZSplit, name := "zsplit", opCodes := opCodes));
END SetupZSplit;
PROCEDURE EvalZSplit ( self : PackageZSplit;
opCode: ObLib.OpCode;
<*UNUSED*>arity : ObLib.OpArity;
READONLY args : ObValue.ArgArray;
<*UNUSED*>temp : BOOLEAN;
loc : SynLocation.T): ObValue.Val
RAISES {ObValue.Error} =
VAR
vbt : VBT.T;
rect: Rect.T;
BEGIN
CASE NARROW (opCode, ZSplitOpCode).code OF
| ZSplitCode.Move =>
TYPECASE args[1] OF
| ValVBT(node) =>
vbt := node.vbt;
ELSE
ObValue.BadArgType(1, "vbt", self.name, opCode.name, loc);
END;
TYPECASE args[2] OF
| ObValue.ValArray (node) =>
IF Obliq.ArraySize (node) = 4 THEN
TYPECASE Obliq.ArrayGet(node, 0) OF
| ObValue.ValInt(node) => rect.west:=node.int;
ELSE
ObValue.BadArgType(2, "[4*Int]", self.name, opCode.name, loc);
END;
TYPECASE Obliq.ArrayGet(node, 1) OF
| ObValue.ValInt(node) => rect.east:=node.int;
ELSE
ObValue.BadArgType(2, "[4*Int]", self.name, opCode.name, loc);
END;
TYPECASE Obliq.ArrayGet(node, 2) OF
| ObValue.ValInt(node) => rect.north:=node.int;
ELSE
ObValue.BadArgType(2, "[4*Int]", self.name, opCode.name, loc);
END;
TYPECASE Obliq.ArrayGet(node, 3) OF
| ObValue.ValInt(node) => rect.south:=node.int;
ELSE
ObValue.BadArgType(2, "[4*Int]", self.name, opCode.name, loc);
END;
ELSE
ObValue.BadArgType(2, "[4*Int]", self.name, opCode.name, loc);
END;
ELSE
ObValue.BadArgType(2, "[4*Int]", self.name, opCode.name, loc);
END;
(* Make sure that the parent of "vbt" is a ZSplit.T. *)
TYPECASE VBT.Parent (vbt) OF
| NULL =>
ObValue.BadArgType(1, "vbt", self.name, opCode.name, loc);
| ZSplit.T => (* everything is fine. *)
| VBT.Split =>
ObValue.BadArgType(1, "vbt", self.name, opCode.name, loc);
END;
ZSplit.Move (vbt, rect);
RETURN ObValue.valOk;
END;
END EvalZSplit;
============ form package ============
TYPE
FormCode = {Error, New, FromFile, FromURL, Attach, PutGeneric, PutColor,
GetBool, PutBool, GetInt, PutInt, GetText, PutText,
GetBoolean, PutBoolean, GetChoice, PutChoice, TakeFocus,
GetReactivity, PutReactivity, PopUp, PopDown,
Insert, InsertVBT, Move, Delete, DeleteRange, DeleteVBT,
ChildIndex, Child, NumOfChildren,
ShowAt, Show, Hide, Lift, DetachGarnish,
BeTarget, SetTargetValue, AttachTargetHit, AttachTargetDrop};
FormOpCode =
ObLib.OpCode OBJECT
code: FormCode;
END;
PackageForm =
ObLib.T OBJECT
OVERRIDES
Eval:=EvalForm;
END;
TYPE
Form = FormsVBT.T BRANDED OBJECT
OVERRIDES
realize := Realize;
END;
PROCEDURE Realize (form: Form; type, name: TEXT) : VBT.T
RAISES {FormsVBT.Error} =
BEGIN
IF Text.Equal (type, "Source") THEN
RETURN NEW (Source);
ELSIF Text.Equal (type, "Target") THEN
RETURN NEW (Target, val := Obliq.ok);
ELSE
RETURN FormsVBT.T.realize (form, type, name);
END;
END Realize;
TYPE
Source = FVTypes.FVSource BRANDED OBJECT
hitProc : Obliq.Val := NIL;
dropProc: Obliq.Val := NIL;
OVERRIDES
hit := SourceHit;
callback := SourceCallback;
END;
TYPE
Target = FVTypes.FVTarget BRANDED OBJECT
val: Obliq.Val; (* initialized to "Obliq.ok" *)
END;
PROCEDURE SourceHit ( s : Source;
t : VBT.T;
<* UNUSED *> READONLY cd: VBT.PositionRec): BOOLEAN =
VAR
source: Source := s;
target: Target := t;
BEGIN
(* If there is a "hitProc" procedure attached to the source, call it,
passing it the value attached to the target (default is "ok"). *)
IF source.hitProc # NIL THEN
TRY
WITH result = Obliq.Call (source.hitProc, Obliq.Vals {target.val}) DO
RETURN Obliq.ToBool (result);
END;
EXCEPT
| ObValue.Error, ObValue.Exception =>
(* we should report an error (by printing out a message) *)
RETURN TRUE;
END;
ELSE
RETURN TRUE;
END;
END SourceHit;
PROCEDURE SourceCallback (self: Source; READONLY cd: VBT.MouseRec) =
VAR
target := NARROW (SourceVBT.GetTarget (self), Target);
BEGIN
(* If there is a "dropProc" procedure attached to the source, call it,
passing it the value attached to the target (default is "ok"). *)
IF self.dropProc # NIL THEN
TRY
WITH pt = Obliq.NewArray (Obliq.Vals {Obliq.NewInt (cd.cp.pt.h),
Obliq.NewInt (cd.cp.pt.v)}) DO
EVAL Obliq.Call (self.dropProc, Obliq.Vals {target.val, pt});
END;
EXCEPT
| ObValue.Error, ObValue.Exception =>
(* we should report an error (by printing out a message) *)
END;
END;
END SourceCallback;
TYPE FormClosure =
FormsVBT.Closure OBJECT
fun: ObValue.ValFun;
fv: ObValue.Val;
location: SynLocation.T;
OVERRIDES
apply := ApplyFormClosure;
END;
PROCEDURE ApplyFormClosure(self: FormClosure;
<*UNUSED*>fv: FormsVBT.T; <*UNUSED*>name: TEXT; <*UNUSED*>time: VBT.TimeStamp) RAISES {} =
VAR args: ARRAY [0..0] OF ObValue.Val;
BEGIN
TRY
args[0] := self.fv;
EVAL ObEval.Call(self.fun, args, self.location);
EXCEPT
| ObValue.Error(packet) =>
SynWr.Text(SynWr.out,
"*** A Modula3 callback to Obliq caused an Obliq error: ***\n");
ObValue.ErrorMsg(SynWr.out, packet);
SynWr.Flush(SynWr.out);
| ObValue.Exception(packet) =>
SynWr.Text(SynWr.out,
"*** A Modula3 callback to Obliq caused an Obliq exception: ***\n");
ObValue.ExceptionMsg(SynWr.out, packet);
SynWr.Flush(SynWr.out);
END;
END ApplyFormClosure;
VAR formException: ObValue.ValException;
PROCEDURE NewFormOC(name: TEXT; arity: INTEGER; code: FormCode)
: FormOpCode =
BEGIN
RETURN NEW(FormOpCode, name:=name, arity:=arity, code:=code);
END NewFormOC;
PROCEDURE SetupForm() =
TYPE OpCodes = ARRAY OF ObLib.OpCode;
VAR opCodes: REF OpCodes;
BEGIN
opCodes := NEW(REF OpCodes, NUMBER(FormCode));
opCodes^ :=
OpCodes{
NewFormOC("failure", -1, FormCode.Error),
NewFormOC("new", 1, FormCode.New),
NewFormOC("fromFile", 1, FormCode.FromFile),
NewFormOC("fromURL", 1, FormCode.FromURL),
NewFormOC("attach", 3, FormCode.Attach),
NewFormOC("putGeneric", 3, FormCode.PutGeneric),
NewFormOC("putColor", 4, FormCode.PutColor),
NewFormOC("getBool", 3, FormCode.GetBool),
NewFormOC("putBool", 4, FormCode.PutBool),
NewFormOC("getInt", 3, FormCode.GetInt),
NewFormOC("putInt", 4, FormCode.PutInt),
NewFormOC("getText", 3, FormCode.GetText),
NewFormOC("putText", 5, FormCode.PutText),
NewFormOC("getBoolean", 2, FormCode.GetBoolean),
NewFormOC("putBoolean", 3, FormCode.PutBoolean),
NewFormOC("getChoice", 2, FormCode.GetChoice),
NewFormOC("putChoice", 3, FormCode.PutChoice),
NewFormOC("takeFocus", 3, FormCode.TakeFocus),
NewFormOC("getReactivity", 2, FormCode.GetReactivity),
NewFormOC("putReactivity", 3, FormCode.PutReactivity),
NewFormOC("popUp", 2, FormCode.PopUp),
NewFormOC("popDown", 2, FormCode.PopDown),
NewFormOC("insert", 4, FormCode.Insert),
NewFormOC("insertVBT", 4, FormCode.InsertVBT),
NewFormOC("move", 5, FormCode.Move),
NewFormOC("delete", 3, FormCode.Delete),
NewFormOC("deleteVBT", 3, FormCode.DeleteVBT),
NewFormOC("deleteRange", 4, FormCode.DeleteRange),
NewFormOC("childIndex", 3, FormCode.ChildIndex),
NewFormOC("child", 3, FormCode.Child),
NewFormOC("numOfChildren", 2, FormCode.NumOfChildren),
NewFormOC("showAt", 3, FormCode.ShowAt),
NewFormOC("show", 1, FormCode.Show),
NewFormOC("hide", 1, FormCode.Hide),
NewFormOC("lift", 2, FormCode.Lift),
NewFormOC("detachGarnish", 1, FormCode.DetachGarnish),
NewFormOC("beTarget", 3, FormCode.BeTarget),
NewFormOC("setTargetValue", 3, FormCode.SetTargetValue),
NewFormOC("attachTargetHit", 3, FormCode.AttachTargetHit),
NewFormOC("attachTargetDrop", 3, FormCode.AttachTargetDrop)
};
ObLib.Register(
NEW(PackageForm, name:="form", opCodes:=opCodes));
formException := NEW(ObValue.ValException, name:="form_failure");
ObValue.InhibitTransmission(TYPECODE(ValForm),
"forms cannot be transmitted/duplicated");
END SetupForm;
PROCEDURE EvalForm(self: PackageForm; opCode: ObLib.OpCode;
<*UNUSED*>arity: ObLib.OpArity; READONLY args: ObValue.ArgArray;
<*UNUSED*>temp: BOOLEAN; loc: SynLocation.T)
: ObValue.Val RAISES {ObValue.Error, ObValue.Exception} =
VAR text1, text2, text3: TEXT; fv1: FormsVBT.T; bool1: BOOLEAN;
int1, int2, index: INTEGER; fun1: ObValue.Val;
vbt1: VBT.T; color1: Color.T;
ch, toCh, p: VBT.T;
BEGIN
TRY
CASE NARROW(opCode, FormOpCode).code OF
| FormCode.Error =>
RETURN formException;
| FormCode.New =>
TYPECASE args[1] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(1, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
fv1 :=NEW(Form).init(text1);
RETURN NEW(ValForm, what:="<a FormsVBT.T>", tag:="FormsVBT`T", picklable:=FALSE,
vbt:=fv1);
| FormCode.FromFile =>
TYPECASE args[1] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(1, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TRY
fv1 :=NEW(Form).initFromFile(text1);
EXCEPT
| Rd.Failure =>
ObValue.RaiseException(formException, opCode.name, loc);<*ASSERT FALSE*>
END;
RETURN NEW(ValForm, what:="<a FormsVBT.T>", tag:="FormsVBT`T", picklable:=FALSE,
vbt:=fv1);
| FormCode.FromURL =>
TYPECASE args[1] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(1, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TRY
fv1 :=NEW(Form).initFromURL(text1);
EXCEPT
| Rd.Failure =>
ObValue.RaiseException(formException, opCode.name, loc);<*ASSERT FALSE*>
END;
RETURN NEW(ValForm, what:="<a FormsVBT.T>", picklable:=FALSE, tag:="FormsVBT`T",
vbt:=fv1);
| FormCode.Attach =>
TYPECASE args[1] OF | ValForm(node) => fv1:=node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValFun(node) => fun1:=node;
ELSE ObValue.BadArgType(3, "procedure", self.name, opCode.name, loc); <*ASSERT FALSE*>
END;
FormsVBT.Attach(fv1, text1,
NEW(FormClosure, fun:=fun1, fv:=args[1], location:=loc));
RETURN ObValue.valOk;
| FormCode.PutGeneric =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ValVBT(node) => vbt1 :=node.vbt;
ELSE ObValue.BadArgType(3, "vbt", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE vbt1.parent OF
| NULL => FormsVBT.PutGeneric(fv1, text1, TranslateVBT.New(vbt1));
| TranslateVBT.T (tv) => FormsVBT.PutGeneric(fv1, text1, tv);
ELSE <*ASSERT FALSE*> (* shouldn't happen *)
END;
RETURN ObValue.valOk;
| FormCode.PutColor =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[4] OF | ValColor(node) => color1:=node.color;
ELSE ObValue.BadArgType(4, "color", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
FormsVBT.PutColorProperty(fv1, text1, text2, color1);
RETURN ObValue.valOk;
| FormCode.GetBool =>
TYPECASE args[1] OF | ValForm(node) => fv1:=node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
bool1 := FormsVBT.GetBooleanProperty(fv1, text1, text2);
RETURN NEW(ObValue.ValBool, bool:=bool1);
| FormCode.PutBool =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[4] OF | ObValue.ValBool(node) => bool1:=node.bool;
ELSE ObValue.BadArgType(4, "bool", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
FormsVBT.PutBooleanProperty(fv1, text1, text2, bool1);
RETURN ObValue.valOk;
| FormCode.GetInt =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
IF Text.Empty(text2) THEN
int1 := FormsVBT.GetInteger(fv1, text1);
ELSE
int1 := FormsVBT.GetIntegerProperty(fv1, text1, text2);
END;
RETURN NEW(ObValue.ValInt, int:=int1);
| FormCode.PutInt =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[4] OF | ObValue.ValInt(node) => int1:=node.int;
ELSE ObValue.BadArgType(4, "int", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
IF Text.Empty(text2) THEN
FormsVBT.PutInteger(fv1, text1, int1);
ELSE
FormsVBT.PutIntegerProperty(fv1, text1, text2, int1);
END;
RETURN ObValue.valOk;
| FormCode.GetText =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
IF Text.Empty(text2) THEN
text3 := FormsVBT.GetText(fv1, text1);
ELSE
text3 := FormsVBT.GetTextProperty(fv1, text1, text2);
END;
RETURN ObValue.NewText(text3);
| FormCode.PutText =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[4] OF | ObValue.ValText(node) => text3:=node.text;
ELSE ObValue.BadArgType(4, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[5] OF | ObValue.ValBool(node) => bool1:=node.bool;
ELSE ObValue.BadArgType(5, "bool", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
IF Text.Empty(text2) THEN
FormsVBT.PutText(fv1, text1, text3, bool1);
ELSE
FormsVBT.PutTextProperty(fv1, text1, text2, text3);
END;
RETURN ObValue.valOk;
| FormCode.GetBoolean =>
TYPECASE args[1] OF | ValForm(node) => fv1:=node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
bool1 := FormsVBT.GetBoolean(fv1, text1);
RETURN NEW(ObValue.ValBool, bool:=bool1);
| FormCode.PutBoolean =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValBool(node) => bool1:=node.bool;
ELSE ObValue.BadArgType(3, "bool", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
FormsVBT.PutBoolean(fv1, text1, bool1);
RETURN ObValue.valOk;
| FormCode.GetChoice =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
text2 := FormsVBT.GetChoice(fv1, text1);
RETURN ObValue.NewText(text2);
| FormCode.PutChoice =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
IF Text.Empty(text2) THEN
FormsVBT.PutChoice(fv1, text1, NIL);
ELSE
FormsVBT.PutChoice(fv1, text1, text2);
END;
RETURN ObValue.valOk;
| FormCode.GetReactivity =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
IF FormsVBT.IsActive(fv1, text1) THEN
RETURN ObValue.NewText("active");
ELSIF FormsVBT.IsPassive(fv1, text1) THEN
RETURN ObValue.NewText("passive");
ELSIF FormsVBT.IsDormant(fv1, text1) THEN
RETURN ObValue.NewText("dormant");
ELSIF FormsVBT.IsVanished(fv1, text1) THEN
RETURN ObValue.NewText("vanished");
ELSE
RETURN ObValue.NewText("");
END;
| FormCode.PutReactivity =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
IF Text.Equal(text2, "active") THEN
FormsVBT.MakeActive(fv1, text1);
ELSIF Text.Equal(text2, "passive") THEN
FormsVBT.MakePassive(fv1, text1);
ELSIF Text.Equal(text2, "dormant") THEN
FormsVBT.MakeDormant(fv1, text1);
ELSIF Text.Equal(text2, "vanished") THEN
FormsVBT.MakeVanish(fv1, text1);
ELSE ObValue.BadArgVal(3, "a valid reactivity",
self.name, opCode.name, loc);<*ASSERT FALSE*>
END;
RETURN ObValue.valOk;
| FormCode.TakeFocus =>
TYPECASE args[1] OF | ValForm(node) => fv1:=node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValBool(node) => bool1:=node.bool;
ELSE ObValue.BadArgType(3, "bool", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
FormsVBT.TakeFocus(fv1, text1, FormsVBT.GetTheEventTime(fv1), bool1);
RETURN ObValue.valOk;
| FormCode.PopUp =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
FormsVBT.PopUp(fv1, text1);
RETURN ObValue.valOk;
| FormCode.PopDown =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
FormsVBT.PopDown(fv1, text1);
RETURN ObValue.valOk;
| FormCode.Insert =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[4] OF | ObValue.ValInt(node) => int1:=node.int;
ELSE ObValue.BadArgType(4, "int", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
IF int1 < 0 THEN
ObValue.BadArgVal(4, "non-negative", self.name, opCode.name, loc);<*ASSERT FALSE*>
END;
EVAL FormsVBT.Insert(fv1, text1, text2, int1);
RETURN ObValue.valOk;
| FormCode.InsertVBT =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ValVBT(node) => vbt1:=node.vbt;
ELSE ObValue.BadArgType(3, "vbt", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[4] OF | ObValue.ValInt(node) => int1:=node.int;
ELSE ObValue.BadArgType(4, "int", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
IF int1 < 0 THEN
ObValue.BadArgVal(4, "non-negative", self.name, opCode.name, loc);<*ASSERT FALSE*>
END;
FormsVBT.InsertVBT(fv1, text1, vbt1, int1);
RETURN ObValue.valOk;
| FormCode.ChildIndex =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
p := FormsVBT.GetVBT(fv1, text1);
ch := FormsVBT.GetVBT(fv1, text2);
IF (p = NIL) OR (ch = NIL) THEN
ObValue.RaiseException(formException, opCode.name, loc);<*ASSERT FALSE*>
END;
TRY int1 := MultiSplit.Index(p, ch);
EXCEPT MultiSplit.NotAChild =>
ObValue.RaiseException(formException, opCode.name, loc);<*ASSERT FALSE*>
END;
RETURN NEW(ObValue.ValInt, int:=int1);
| FormCode.Child =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValInt(node) => int1:=node.int;
ELSE ObValue.BadArgType(3, "int", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
IF int1 < 0 THEN
ObValue.BadArgVal(3, "non-negative", self.name, opCode.name, loc);<*ASSERT FALSE*>
END;
p := FormsVBT.GetVBT(fv1, text1);
ch := MultiSplit.Nth(p, int1);
IF (p=NIL) OR (ch=NIL) THEN
ObValue.RaiseException(formException, opCode.name, loc);<*ASSERT FALSE*>
END;
TRY text2 := FormsVBT.GetName(ch);
EXCEPT FormsVBT.Error =>
ObValue.RaiseException(formException, opCode.name, loc);<*ASSERT FALSE*>
END;
RETURN ObValue.NewText(text2);
| FormCode.NumOfChildren =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
p := FormsVBT.GetVBT(fv1, text1);
IF p=NIL THEN
ObValue.RaiseException(formException, opCode.name, loc);<*ASSERT FALSE*>
END;
TRY int1 := MultiSplit.NumChildren(p);
EXCEPT MultiSplit.NotAChild =>
ObValue.RaiseException(formException, opCode.name, loc);<*ASSERT FALSE*>
END;
RETURN NEW(ObValue.ValInt, int:=int1);
| FormCode.Move =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[4] OF | ObValue.ValText(node) => text3:=node.text;
ELSE ObValue.BadArgType(4, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[5] OF | ObValue.ValBool(node) => bool1:=node.bool;
ELSE ObValue.BadArgType(5, "bool", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
IF Text.Equal(text2, text3) THEN RETURN ObValue.valOk END;
p := FormsVBT.GetVBT(fv1, text1);
ch := FormsVBT.GetVBT(fv1, text2);
IF Text.Empty(text3) THEN toCh := NIL
ELSE toCh := FormsVBT.GetVBT(fv1, text3);
END;
IF (p = NIL) OR (ch = NIL) OR
((NOT Text.Empty(text3)) AND (toCh = NIL)) THEN
ObValue.RaiseException(formException, opCode.name, loc);<*ASSERT FALSE*>
END;
TRY
IF bool1 THEN toCh := MultiSplit.Pred(p, toCh) END;
MultiSplit.Move(p, toCh, ch);
EXCEPT MultiSplit.NotAChild =>
ObValue.RaiseException(formException, opCode.name, loc);<*ASSERT FALSE*>
END;
RETURN ObValue.valOk;
| FormCode.Delete =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
p := FormsVBT.GetVBT(fv1, text1);
ch := FormsVBT.GetVBT(fv1, text2);
IF (p = NIL) OR (ch = NIL) THEN
ObValue.RaiseException(formException, opCode.name, loc);<*ASSERT FALSE*>
END;
TRY
index := MultiSplit.Index(p, ch);
EXCEPT MultiSplit.NotAChild =>
ObValue.RaiseException(formException, opCode.name, loc);<*ASSERT FALSE*>
END;
FormsVBT.Delete(fv1, text1, index, 1);
RETURN ObValue.valOk;
| FormCode.DeleteVBT =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ValVBT(node) => vbt1:=node.vbt;
ELSE ObValue.BadArgType(3, "vbt", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
p := FormsVBT.GetVBT(fv1, text1);
IF (p = NIL) OR (vbt1 = NIL) THEN
ObValue.RaiseException(formException, opCode.name, loc);<*ASSERT FALSE*>
END;
TRY
MultiSplit.Delete (p, vbt1);
EXCEPT MultiSplit.NotAChild =>
ObValue.RaiseException(formException, opCode.name, loc);
<*ASSERT FALSE*>
END;
RETURN ObValue.valOk;
| FormCode.DeleteRange =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValInt(node) => int1:=node.int;
ELSE ObValue.BadArgType(3, "int", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[4] OF | ObValue.ValInt(node) => int2:=node.int;
ELSE ObValue.BadArgType(4, "int", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
IF int1 < 0 THEN
ObValue.BadArgVal(3, "non-negative", self.name, opCode.name, loc);<*ASSERT FALSE*>
END;
IF int2 < 0 THEN
ObValue.BadArgVal(4, "non-negative", self.name, opCode.name, loc);<*ASSERT FALSE*>
END;
FormsVBT.Delete(fv1, text1, int1, int2);
RETURN ObValue.valOk;
| FormCode.Show =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
Trestle.Install(fv1);
RETURN ObValue.valOk;
| FormCode.ShowAt =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
IF Text.Empty(text1) THEN Trestle.Install(fv1);
ELSE
Trestle.Install(v:=fv1, trsl:=Trestle.Connect(text1),
windowTitle:=text2, iconTitle:=text2);
END;
RETURN ObValue.valOk;
| FormCode.Hide =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
Trestle.Delete(fv1);
RETURN ObValue.valOk;
| FormCode.Lift =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
ch := FormsVBT.GetVBT(fv1, text1);
IF ch = NIL THEN
ObValue.RaiseException(formException, opCode.name, loc);<*ASSERT FALSE*>
END;
ZSplit.Lift (ch);
RETURN ObValue.valOk;
| FormCode.DetachGarnish =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
WITH v = MultiFilter.Child (fv1) DO
TRY
Split.Delete (v.parent, v);
EXCEPT Split.NotAChild =>
ObValue.RaiseException(formException, opCode.name, loc);
<*ASSERT FALSE*>
END;
RETURN NEW (ValVBT, what:="<a VBT.T>", picklable:=FALSE,
tag:= "VBT`T",vbt := v);
END;
| FormCode.BeTarget =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
vbt1 := FormsVBT.GetVBT(fv1, text1);
IF vbt1 = NIL THEN
ObValue.RaiseException(formException, opCode.name, loc);
<* ASSERT FALSE *>
END;
IF Text.Equal (text2, "invert") THEN
SourceVBT.BeTarget (vbt1, SourceVBT.NewTarget ());
RETURN ObValue.valOk;
ELSIF Text.Equal (text2, "grid") THEN
SourceVBT.BeTarget (vbt1, SourceVBT.NewSwapTarget ());
RETURN ObValue.valOk;
ELSE
ObValue.BadArgType(3, "\"invert\" or \"grid \"",
self.name, opCode.name, loc);
<* ASSERT FALSE *>
END;
| FormCode.SetTargetValue =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE FormsVBT.GetVBT(fv1, text1) OF
| NULL =>
ObValue.RaiseException(formException, opCode.name, loc);
<* ASSERT FALSE *>
| Target (target) =>
target.val := args[3];
RETURN ObValue.valOk;
ELSE
ObValue.RaiseException(formException, opCode.name, loc);
<* ASSERT FALSE *>
END;
| FormCode.AttachTargetHit =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE FormsVBT.GetVBT(fv1, text1) OF
| NULL =>
ObValue.RaiseException(formException, opCode.name, loc);
<* ASSERT FALSE *>
| Source (source) =>
source.hitProc := args[3];
RETURN ObValue.valOk;
ELSE
ObValue.RaiseException(formException, opCode.name, loc);
<* ASSERT FALSE *>
END;
| FormCode.AttachTargetDrop =>
TYPECASE args[1] OF | ValForm(node) => fv1 := node.vbt;
ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
TYPECASE FormsVBT.GetVBT(fv1, text1) OF
| NULL =>
ObValue.RaiseException(formException, opCode.name, loc);
<* ASSERT FALSE *>
| Source (source) =>
source.dropProc := args[3];
RETURN ObValue.valOk;
ELSE
ObValue.RaiseException(formException, opCode.name, loc);
<* ASSERT FALSE *>
END;
ELSE
ObValue.BadOp(self.name, opCode.name, loc);<*ASSERT FALSE*>
END;
EXCEPT
| FormsVBT.Error, FormsVBT.Unimplemented, TrestleComm.Failure =>
ObValue.RaiseException(formException, opCode.name, loc);<*ASSERT FALSE*>
| Thread.Alerted =>
ObValue.RaiseException(ObValue.threadAlerted,
self.name&"_"&opCode.name,loc);<*ASSERT FALSE*>
END;
END EvalForm;
BEGIN
END ObLibUI.