********************************************************************
* NOTE: This file is generated automatically from the event * definition file Wheeler.evt. ********************************************************************<* PRAGMA LL *> MODULEOUTPUT and UPDATE event handling methods:; <*NOWARN*> IMPORT TextConv, ObLibM3, ObLibUI, SynWr, Obliq; <*NOWARN*> IMPORT ObliqParser, Rd, Filter, WheelerViewClass, Fmt; <*NOWARN*> IMPORT ObLibAnim, ZFmt, ZeusPanel, ObValue, TextWr; <*NOWARN*> IMPORT View, VBT, Thread, MiscFmt, TextRd, Rsrc; CONST ViewName = "Compress.obl"; TYPE T = WheelerViewClass.T BRANDED OBJECT object : Obliq.Val; env : Obliq.Env; wr : TextWr.T; swr : SynWr.T; parser : ObliqParser.T; OVERRIDES <* LL.sup < VBT.mu *> startrun := Startrun; <* LL.sup < VBT.mu *> oeStartPermute := StartPermute; oeNextRotation := NextRotation; oeRotationsSorted := RotationsSorted; oePermuteDone := PermuteDone; oeStartEncode := StartEncode; oeEncodeNextChar := EncodeNextChar; oeEncodeDistinctCount := EncodeDistinctCount; oeEncodeFoundCode := EncodeFoundCode; oeEncodeDone := EncodeDone; oeInitDecode := InitDecode; oeStartDecode := StartDecode; oeDecodeNextCode := DecodeNextCode; oeDecodeDistinctCount := DecodeDistinctCount; oeDecodeFoundChar := DecodeFoundChar; oeDecodeDone := DecodeDone; oeStartReconstruct := StartReconstruct; oeFirstChars := FirstChars; oeConsiderChar := ConsiderChar; oeEqualChars := EqualChars; oeFinishCharRun := FinishCharRun; oeStartResult := StartResult; oeResultNextChar := ResultNextChar; oeEndResult := EndResult; oeReveal := Reveal; <* LL.sup = VBT.mu *> END; WheelerCompressObliqView PROCEDUREStartPermute (view: T; string, alphabet: TEXT) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "StartPermute") THEN Invoke (view, "StartPermute", "" & TextConv.Encode(string) & "," & TextConv.Encode(alphabet) ) END END StartPermute; PROCEDURENextRotation (view: T; i: INTEGER; string: TEXT) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "NextRotation") THEN Invoke (view, "NextRotation", "" & Fmt.Int(i) & "," & TextConv.Encode(string) ) END END NextRotation; PROCEDURERotationsSorted (view: T; rotations: MiscFmt.RefTextArray; rowIndex: INTEGER) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "RotationsSorted") THEN Invoke (view, "RotationsSorted", "" & MiscFmt.TextArray(rotations) & "," & Fmt.Int(rowIndex) ) END END RotationsSorted; PROCEDUREPermuteDone (view: T; lastchars: TEXT; rowIndex: INTEGER) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "PermuteDone") THEN Invoke (view, "PermuteDone", "" & TextConv.Encode(lastchars) & "," & Fmt.Int(rowIndex) ) END END PermuteDone; PROCEDUREStartEncode (view: T; alphabet: TEXT) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "StartEncode") THEN Invoke (view, "StartEncode", "" & TextConv.Encode(alphabet) ) END END StartEncode; PROCEDUREEncodeNextChar (view: T; i: INTEGER; c: CHAR) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "EncodeNextChar") THEN Invoke (view, "EncodeNextChar", "" & Fmt.Int(i) & "," & MiscFmt.Char(c) ) END END EncodeNextChar; PROCEDUREEncodeDistinctCount (view: T; i, k, n: INTEGER; c: CHAR) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "EncodeDistinctCount") THEN Invoke (view, "EncodeDistinctCount", "" & Fmt.Int(i) & "," & Fmt.Int(k) & "," & Fmt.Int(n) & "," & MiscFmt.Char(c) ) END END EncodeDistinctCount; PROCEDUREEncodeFoundCode (view: T; i, k, code: INTEGER; c: CHAR) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "EncodeFoundCode") THEN Invoke (view, "EncodeFoundCode", "" & Fmt.Int(i) & "," & Fmt.Int(k) & "," & Fmt.Int(code) & "," & MiscFmt.Char(c) ) END END EncodeFoundCode; PROCEDUREEncodeDone (view: T; alphabet: TEXT; codes: MiscFmt.RefIntArray; rowIndex: INTEGER) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "EncodeDone") THEN Invoke (view, "EncodeDone", "" & TextConv.Encode(alphabet) & "," & MiscFmt.IntArray(codes) & "," & Fmt.Int(rowIndex) ) END END EncodeDone; PROCEDUREInitDecode (view: T; alphabet: TEXT; codes: MiscFmt.RefIntArray; rowIndex: INTEGER) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "InitDecode") THEN Invoke (view, "InitDecode", "" & TextConv.Encode(alphabet) & "," & MiscFmt.IntArray(codes) & "," & Fmt.Int(rowIndex) ) END END InitDecode; PROCEDUREStartDecode (view: T; ) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "StartDecode") THEN Invoke (view, "StartDecode", "" ) END END StartDecode; PROCEDUREDecodeNextCode (view: T; i: INTEGER) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "DecodeNextCode") THEN Invoke (view, "DecodeNextCode", "" & Fmt.Int(i) ) END END DecodeNextCode; PROCEDUREDecodeDistinctCount (view: T; i, k, n: INTEGER) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "DecodeDistinctCount") THEN Invoke (view, "DecodeDistinctCount", "" & Fmt.Int(i) & "," & Fmt.Int(k) & "," & Fmt.Int(n) ) END END DecodeDistinctCount; PROCEDUREDecodeFoundChar (view: T; i, k: INTEGER; c: CHAR) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "DecodeFoundChar") THEN Invoke (view, "DecodeFoundChar", "" & Fmt.Int(i) & "," & Fmt.Int(k) & "," & MiscFmt.Char(c) ) END END DecodeFoundChar; PROCEDUREDecodeDone (view: T; lastchars: TEXT; rowIndex: INTEGER) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "DecodeDone") THEN Invoke (view, "DecodeDone", "" & TextConv.Encode(lastchars) & "," & Fmt.Int(rowIndex) ) END END DecodeDone; PROCEDUREStartReconstruct (view: T; lastchars: TEXT; rowIndex: INTEGER) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "StartReconstruct") THEN Invoke (view, "StartReconstruct", "" & TextConv.Encode(lastchars) & "," & Fmt.Int(rowIndex) ) END END StartReconstruct; PROCEDUREFirstChars (view: T; t: TEXT) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "FirstChars") THEN Invoke (view, "FirstChars", "" & TextConv.Encode(t) ) END END FirstChars; PROCEDUREConsiderChar (view: T; i: INTEGER) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "ConsiderChar") THEN Invoke (view, "ConsiderChar", "" & Fmt.Int(i) ) END END ConsiderChar; PROCEDUREEqualChars (view: T; i, j: INTEGER) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "EqualChars") THEN Invoke (view, "EqualChars", "" & Fmt.Int(i) & "," & Fmt.Int(j) ) END END EqualChars; PROCEDUREFinishCharRun (view: T; ) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "FinishCharRun") THEN Invoke (view, "FinishCharRun", "" ) END END FinishCharRun; PROCEDUREStartResult (view: T; ) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "StartResult") THEN Invoke (view, "StartResult", "" ) END END StartResult; PROCEDUREResultNextChar (view: T; pos, k: INTEGER) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "ResultNextChar") THEN Invoke (view, "ResultNextChar", "" & Fmt.Int(pos) & "," & Fmt.Int(k) ) END END ResultNextChar; PROCEDUREEndResult (view: T; ) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "EndResult") THEN Invoke (view, "EndResult", "" ) END END EndResult; PROCEDUREReveal (view: T; i: INTEGER) = <* LL.sup < VBT.mu *> BEGIN IF FieldDefined(view.object, "Reveal") THEN Invoke (view, "Reveal", "" & Fmt.Int(i) ) END END Reveal; PROCEDURERegisterView () = BEGIN ZeusPanel.RegisterView(New, "Compress.obl", "Wheeler") END RegisterView; PROCEDURENew (): View.T = BEGIN RETURN NEW(T).init(NIL) END New; CONST ObliqStackSizeMultiplier = 8; TYPE Closure = Thread.SizedClosure OBJECT view: T; OVERRIDES apply := ForkedStartrun; END; PROCEDUREStartrun (view: T) = <* LL.sup < VBT.mu *> BEGIN EVAL Thread.Join( Thread.Fork( NEW(Closure, view := view, stackSize := ObliqStackSizeMultiplier * Thread.GetDefaultStackSize()))); END Startrun; PROCEDUREForkedStartrun (cl: Closure): REFANY = VAR rd: Rd.T; view := cl.view; BEGIN IF view.parser = NIL THEN view.wr := TextWr.New(); view.swr := SynWr.New(view.wr); view.parser := ObliqParser.New(view.swr); END; view.object := NIL; TRY rd := Rsrc.Open(ViewName, ZeusPanel.GetPath()); view.env := ParseRd(view.parser, ViewName, rd); WITH obj = Obliq.Lookup("view", view.env) DO IF NOT ISTYPE(obj, ObValue.ValObj) THEN ZeusPanel.ReportError( "not an Obliq object in '" & ViewName & "'") ELSIF FieldDefined (obj, "graphvbt") THEN WITH graphvbt = NARROW(Obliq.ObjectSelect(obj, "graphvbt"), ObLibAnim.ValGraph).vbt DO LOCK VBT.mu DO EVAL Filter.Replace(view, graphvbt) END END; view.object := obj; ELSIF FieldDefined (obj, "rectsvbt") THEN WITH rectsvbt = NARROW(Obliq.ObjectSelect(obj, "rectsvbt"), ObLibAnim.ValRects).vbt DO LOCK VBT.mu DO EVAL Filter.Replace(view, rectsvbt) END END; view.object := obj; ELSIF FieldDefined (obj, "formsvbt") THEN WITH formsvbt = NARROW(Obliq.ObjectSelect(obj, "formsvbt"), ObLibUI.ValForm).vbt DO LOCK VBT.mu DO EVAL Filter.Replace(view, formsvbt) END END; view.object := obj; ELSE ZeusPanel.ReportError( "cannot find 'graphvbt', 'rectsvbt', or 'formsvbt' in '" & ViewName & "'") END END EXCEPT | Rsrc.NotFound => ZeusPanel.ReportError("cannot find '" & ViewName & "'") | ObValue.Error (packet) => OblError(view, packet) | ObValue.Exception (packet) => OblException(view, packet) END; RETURN NIL; END ForkedStartrun; PROCEDUREParseRd (p: ObliqParser.T; name: TEXT; rd: Rd.T): Obliq.Env RAISES {ObValue.Error, ObValue.Exception} = VAR env := Obliq.EmptyEnv(); BEGIN ObliqParser.ReadFrom(p, name, rd, TRUE); TRY LOOP EVAL ObliqParser.EvalPhrase(p, ObliqParser.ParsePhrase(p), env) END EXCEPT ObliqParser.Eof => (* clean exit of loop *) END; RETURN env END ParseRd; PROCEDUREInvoke (view: T; event, args: TEXT) = VAR exp := "view." & event & "(" & args & ");"; name := "Zeus Event <" & event & ">"; BEGIN ObliqParser.ReadFrom (view.parser, name, TextRd.New(exp), FALSE); TRY EVAL Obliq.EvalTerm(ObliqParser.ParseTerm(view.parser), view.env) EXCEPT | ObliqParser.Eof => <* ASSERT FALSE *> | ObValue.Error (packet) => OblError(view, packet) | ObValue.Exception (packet) => OblException(view, packet) END END Invoke; PROCEDUREFieldDefined (object: Obliq.Val; event: TEXT): BOOLEAN = BEGIN TRY RETURN object # NIL AND Obliq.ObjectHas(object, event) EXCEPT | ObValue.Error => | ObValue.Exception => END; RETURN FALSE END FieldDefined; PROCEDUREOblError (view: T; packet: ObValue.ErrorPacket) = BEGIN Obliq.ReportError(view.swr, packet); ZeusPanel.ReportError( "Obliq error: " & TextWr.ToText(view.wr)) END OblError; PROCEDUREOblException (view: T; packet: ObValue.ExceptionPacket) = BEGIN Obliq.ReportException(view.swr, packet); ZeusPanel.ReportError( "Obliq exception: " & TextWr.ToText(view.wr)) END OblException; BEGIN SynWr.Setup(); ObliqParser.PackageSetup(); ObLibM3.PackageSetup(); ObLibUI.PackageSetup(); ObLibAnim.PackageSetup(); RegisterView (); END WheelerCompressObliqView.