********************************************************************
* NOTE: This file is generated automatically from the event * definition file Subtype.evt. ********************************************************************<* PRAGMA LL *> MODULEevent handling methods:; <*NOWARN*> IMPORT TextPort, Rd, ZeusClass, Filter, TextEditVBT; <*NOWARN*> IMPORT SubtypeViewClass, Fmt, ZFmt, Wr, ZeusPanel; <*NOWARN*> IMPORT FormsVBT, AlgSubtype, VBT, View; <* FATAL FormsVBT.Error, FormsVBT.Unimplemented *> REVEAL T = Public BRANDED OBJECT fv: FormsVBT.T := NIL; te: TextEditVBT.T := NIL; OVERRIDES init := TViewInit; install := TViewInstall; delete := TViewDelete; snapshot := TViewSnapshot; restore := TViewRestore; config := TViewConfig; reactivity := TViewReactivity; startrun := TViewStartrun; endrun := TViewEndrun; oeSetup := Setup; oeBegin := Begin; oeNewBot := NewBot; oeNewTop := NewTop; oeNewFun := NewFun; oeNewDomRng := NewDomRng; oeNewLoop := NewLoop; oeEnter := Enter; oeExit := Exit; oeSeenOK := SeenOK; oeNotice := Notice; oeBotLessAnyOK := BotLessAnyOK; oeTopLessTopOK := TopLessTopOK; oeTopLessNonTopKO := TopLessNonTopKO; oeFunLessBotKO := FunLessBotKO; oeFunLessTopOK := FunLessTopOK; oeFunLessFun := FunLessFun; oeOK := OK; oeKO := KO; END; PROCEDURE SubtypeTranscriptView TViewInit (view: T): T = <* LL = VBT.mu *> BEGIN TViewZTrace (view, "init"); RETURN SubtypeViewClass.T.init (view, NIL); END TViewInit; PROCEDUREClear (<* UNUSED *> fv : FormsVBT.T; <* UNUSED *> name: TEXT; cl : REFANY; <* UNUSED *> time: VBT.TimeStamp) = BEGIN TextPort.SetText(NARROW(cl, T).te.tp, "") END Clear; PROCEDURETViewInstall (view: T) = <* LL = VBT.mu *> BEGIN view.fv := ZeusPanel.NewForm("SubtypeTranscriptView.fv"); view.te := FormsVBT.GetVBT(view.fv, "transcript"); TViewZTrace (view, "install"); FormsVBT.AttachProc(view.fv, "clear", Clear, view); EVAL Filter.Replace (view, view.fv); SubtypeViewClass.T.install (view); END TViewInstall; PROCEDURETViewDelete (view: T) = <* LL = VBT.mu *> BEGIN TViewZTrace (view, "delete"); SubtypeViewClass.T.delete (view); END TViewDelete; PROCEDURETViewSnapshot (view: T; wr: Wr.T) RAISES {ZeusClass.Error} = <* LL = VBT.mu *> BEGIN TViewZTrace (view, "snapshot"); SubtypeViewClass.T.snapshot (view, wr); END TViewSnapshot; PROCEDURETViewRestore (view: T; rd: Rd.T) RAISES {ZeusClass.Error} = <* LL = VBT.mu *> BEGIN TViewZTrace (view, "restore"); SubtypeViewClass.T.restore (view, rd); END TViewRestore; PROCEDURETViewConfig ( view: T; state: ZeusClass.StateChange; o: ZeusClass.T) = <* LL = VBT.mu *> BEGIN TViewZTrace (view, "config"); SubtypeViewClass.T.config (view, state, o); END TViewConfig; PROCEDURETViewReactivity (view: T; <*UNUSED*> on: BOOLEAN) = <* LL = VBT.mu *> BEGIN TViewZTrace(view, "reactivity"); SubtypeViewClass.T.reactivity (view, TRUE); END TViewReactivity; PROCEDURETViewStartrun (view: T) = <* LL = {} *> BEGIN TViewZTrace (view, "startrun"); SubtypeViewClass.T.startrun (view); END TViewStartrun; PROCEDURETViewEndrun (view: T) = <* LL = {} *> BEGIN TViewZTrace (view, "endrun"); SubtypeViewClass.T.endrun (view); END TViewEndrun;PROCEDURESetup (view: T; ) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "Setup ...") ELSE TViewTrace (view, "Setup " ) END END END END Setup; PROCEDUREBegin (view: T; lftRoot, rhtRoot: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "Begin ...") ELSE TViewTrace (view, "Begin " & Fmt.Int(lftRoot) & " " & Fmt.Int(rhtRoot) ) END END END END Begin; PROCEDURENewBot (view: T; index: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "NewBot ...") ELSE TViewTrace (view, "NewBot " & Fmt.Int(index) ) END END END END NewBot; PROCEDURENewTop (view: T; index: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "NewTop ...") ELSE TViewTrace (view, "NewTop " & Fmt.Int(index) ) END END END END NewTop; PROCEDURENewFun (view: T; index, domEdgeIndex, rngEdgeIndex: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "NewFun ...") ELSE TViewTrace (view, "NewFun " & Fmt.Int(index) & " " & Fmt.Int(domEdgeIndex) & " " & Fmt.Int(rngEdgeIndex) ) END END END END NewFun; PROCEDURENewDomRng (view: T; index, domIndex, rngIndex: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "NewDomRng ...") ELSE TViewTrace (view, "NewDomRng " & Fmt.Int(index) & " " & Fmt.Int(domIndex) & " " & Fmt.Int(rngIndex) ) END END END END NewDomRng; PROCEDURENewLoop (view: T; fromIndex, toIndex: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "NewLoop ...") ELSE TViewTrace (view, "NewLoop " & Fmt.Int(fromIndex) & " " & Fmt.Int(toIndex) ) END END END END NewLoop; PROCEDUREEnter (view: T; lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "Enter ...") ELSE TViewTrace (view, "Enter " & Fmt.Int(lftIndex) & " " & Fmt.Int(rhtIndex) & " " & Fmt.Int(lftLeadingEdgeIndex) & " " & Fmt.Int(rhtLeadingEdgeIndex) ) END END END END Enter; PROCEDUREExit (view: T; lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER; result: BOOLEAN) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "Exit ...") ELSE TViewTrace (view, "Exit " & Fmt.Int(lftIndex) & " " & Fmt.Int(rhtIndex) & " " & Fmt.Int(lftLeadingEdgeIndex) & " " & Fmt.Int(rhtLeadingEdgeIndex) & " " & AlgSubtype.FmtBool(result) ) END END END END Exit; PROCEDURESeenOK (view: T; fromIndex, toIndex: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "SeenOK ...") ELSE TViewTrace (view, "SeenOK " & Fmt.Int(fromIndex) & " " & Fmt.Int(toIndex) ) END END END END SeenOK; PROCEDURENotice (view: T; fromIndex, toIndex: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "Notice ...") ELSE TViewTrace (view, "Notice " & Fmt.Int(fromIndex) & " " & Fmt.Int(toIndex) ) END END END END Notice; PROCEDUREBotLessAnyOK (view: T; lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "BotLessAnyOK ...") ELSE TViewTrace (view, "BotLessAnyOK " & Fmt.Int(lftIndex) & " " & Fmt.Int(rhtIndex) & " " & Fmt.Int(lftLeadingEdgeIndex) & " " & Fmt.Int(rhtLeadingEdgeIndex) ) END END END END BotLessAnyOK; PROCEDURETopLessTopOK (view: T; lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "TopLessTopOK ...") ELSE TViewTrace (view, "TopLessTopOK " & Fmt.Int(lftIndex) & " " & Fmt.Int(rhtIndex) & " " & Fmt.Int(lftLeadingEdgeIndex) & " " & Fmt.Int(rhtLeadingEdgeIndex) ) END END END END TopLessTopOK; PROCEDURETopLessNonTopKO (view: T; lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "TopLessNonTopKO ...") ELSE TViewTrace (view, "TopLessNonTopKO " & Fmt.Int(lftIndex) & " " & Fmt.Int(rhtIndex) & " " & Fmt.Int(lftLeadingEdgeIndex) & " " & Fmt.Int(rhtLeadingEdgeIndex) ) END END END END TopLessNonTopKO; PROCEDUREFunLessBotKO (view: T; lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "FunLessBotKO ...") ELSE TViewTrace (view, "FunLessBotKO " & Fmt.Int(lftIndex) & " " & Fmt.Int(rhtIndex) & " " & Fmt.Int(lftLeadingEdgeIndex) & " " & Fmt.Int(rhtLeadingEdgeIndex) ) END END END END FunLessBotKO; PROCEDUREFunLessTopOK (view: T; lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "FunLessTopOK ...") ELSE TViewTrace (view, "FunLessTopOK " & Fmt.Int(lftIndex) & " " & Fmt.Int(rhtIndex) & " " & Fmt.Int(lftLeadingEdgeIndex) & " " & Fmt.Int(rhtLeadingEdgeIndex) ) END END END END FunLessTopOK; PROCEDUREFunLessFun (view: T; lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "FunLessFun ...") ELSE TViewTrace (view, "FunLessFun " & Fmt.Int(lftIndex) & " " & Fmt.Int(rhtIndex) & " " & Fmt.Int(lftLeadingEdgeIndex) & " " & Fmt.Int(rhtLeadingEdgeIndex) ) END END END END FunLessFun; PROCEDUREOK (view: T; lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "OK ...") ELSE TViewTrace (view, "OK " & Fmt.Int(lftIndex) & " " & Fmt.Int(rhtIndex) & " " & Fmt.Int(lftLeadingEdgeIndex) & " " & Fmt.Int(rhtLeadingEdgeIndex) ) END END END END OK; PROCEDUREKO (view: T; lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) = <* LL = {} *> BEGIN LOCK VBT.mu DO IF FormsVBT.GetBoolean(view.fv, "alg") THEN IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN TViewTrace (view, "KO ...") ELSE TViewTrace (view, "KO " & Fmt.Int(lftIndex) & " " & Fmt.Int(rhtIndex) & " " & Fmt.Int(lftLeadingEdgeIndex) & " " & Fmt.Int(rhtLeadingEdgeIndex) ) END END END END KO; PROCEDURETViewZTrace (view: T; t: TEXT) = BEGIN IF view.fv # NIL THEN IF FormsVBT.GetBoolean(view.fv, "zeus") THEN TextPort.PutText(view.te.tp, "**zeus: " & t & "\n"); TextPort.Normalize(view.te.tp, LAST(INTEGER)) END END END TViewZTrace; PROCEDURETViewTrace (view: T; t: TEXT) = BEGIN TextPort.PutText(view.te.tp, "--event: " & t & "\n"); TextPort.Normalize(view.te.tp, LAST(INTEGER)) END TViewTrace; PROCEDURETViewNew (): View.T = BEGIN RETURN NEW(T).init() END TViewNew; BEGIN ZeusPanel.RegisterView (TViewNew, "Subtype Transcript View", "Subtype"); END SubtypeTranscriptView.