IMPLEMENTATION (*ADO*) MODULE TraceVW;

(* Amadeus *)
IMPORT AttrWindow, Events, NumberConversion, Resource, Windows2;
FROM Windows2 IMPORT Colour;

(* Application *)
FROM RS232ADT IMPORT LineStatus, LineStatusSet, ErrorCodes, ErrorCodeSet;
IMPORT RS232ADT, ItemQueues, LnMsg;
FROM HardError IMPORT Assert;
IMPORT HardError;

CONST
   (* --- COM 1 --- *)
   DefaultPort = 03F8H;
   DefaultIrq = 4;

TYPE
   ByteSet = SET OF [0..7];
   ByteCard = SHORTCARD[0..255];

VAR
   traceWin : Windows2.Window;
   firstLine : BOOLEAN;
   serialPort : RS232ADT.Port;
   workSpace :ARRAY[0..2000H] OF WORD;
   display : ItemQueues.ItemQueue;
   oldPollExternal: Events.EventPollProc;

PROCEDURE Protocol();

   TYPE
      States = ( WAIT, OPCN, MSG );

   VAR
      state       : States;
      len         : CARDINAL[0..127];
      expectedLen : CARDINAL[0..127];
      m           : LnMsg.LoconetMessage;
      b           : BYTE;
      bv          : BOOLEAN;
      opc         : BOOLEAN;
      err         : BOOLEAN;

   PROCEDURE PutMessage();
      BEGIN
         IF NOT ItemQueues.IsFull( display ) THEN
            ItemQueues.Insert( display, m );
         ELSE
            Windows2.WriteString( traceWin, "Queue full" );
            Windows2.WriteLn( traceWin );
         END;
         len := 0;
      END PutMessage;

   PROCEDURE PutCompleteMessage();
      BEGIN
         m.length := len;
         PutMessage();
      END PutCompleteMessage;

   PROCEDURE PutIncompleteMessage();
      BEGIN
         m.length := -VAL(INTEGER,len);
         PutMessage();
      END PutIncompleteMessage;

   PROCEDURE PutLineError(*Message*)( error : RS232ADT.ErrorCodeSet );
      BEGIN
         m.length := 0;
         m.message[0] := error;
         PutMessage();
         len := 0;
      END PutLineError;

   PROCEDURE HandleByteError();
      (* b contains a valid (but unexpected) byte, handle it *)
      BEGIN
         IF opc THEN
            (* assume start of new message *)
            PutIncompleteMessage();
            m.message[len] := b; INC(len);
            CASE (ByteCard(b) DIV 32) MOD 4 OF
            | 0 : state := MSG; expectedLen := 2;
            | 1 : state := MSG; expectedLen := 4;
            | 2 : state := MSG; expectedLen := 6;
            | 3 : state := OPCN;
            END (*CASE*);
         ELSE
            m.message[len] := b; INC(len);
            PutIncompleteMessage();
            state := WAIT;
         END;
      END HandleByteError;

   PROCEDURE GetByte;
      VAR
         ch    : CHAR;
         error : RS232ADT.ErrorCodeSet;
      BEGIN
         REPEAT
            RS232ADT.BusyRead ( serialPort, ch , bv, error );
            IF NOT bv AND (error=ErrorCodeSet{}) THEN
               RS232ADT.SleepUntilNextChar( serialPort );
               RS232ADT.BusyRead( serialPort, ch, bv, error );
            END;
            b := ch;
            opc := bv & (7 IN ByteSet(b));
            err := error # ErrorCodeSet{};
            (* now we have got a byte or errorcond from the serial controller *)
            Assert( bv OR err );
            IF err THEN
               IF bv THEN (* add byte, iff any *)
                  m.message[len] := b; INC(len);
               END;
               IF len>0 THEN (* enqueue anything in the buffer *)
                  PutIncompleteMessage();
               END;
               (* now enqueue the errormessage *)
               PutLineError( error );
               state := WAIT;
            END (*IF*);
         UNTIL ~err;
         Assert( bv & ~err );
      END GetByte;

   BEGIN
      len := 0;
      state := WAIT; (* waiting on opcode *)
      LOOP
         GetByte();
         (* now: bv & ~err *)
         CASE state OF
         | WAIT : IF opc THEN
                     m.message[len] := b; INC(len);
                     CASE (ByteCard(b) DIV 32) MOD 4 OF
                     | 0 : state := MSG; expectedLen := 2;
                     | 1 : state := MSG; expectedLen := 4;
                     | 2 : state := MSG; expectedLen := 6;
                     | 3 : state := OPCN;
                     END (*CASE*);
                  ELSE
                     HandleByteError();
                  END (*IF*);
         | OPCN : IF ~opc & (ByteCard(b)>2) THEN
                     m.message[len] := b; INC(len);
                     expectedLen := VAL(CARDINAL,ByteCard(b));
                     state := MSG;
                  ELSE
                     HandleByteError();
                  END;
         | MSG  : IF ~opc THEN
                     m.message[len] := b; INC(len);
                     IF len<expectedLen THEN
                        state := MSG;
                     ELSE
                        PutCompleteMessage();
                        state := WAIT;
                     END (*IF*);
                  ELSE
                     HandleByteError();
                  END;
         ELSE
                  HardError.Err( "TraceVW: invalid state" );
         END (*CASE*);
      END (*LOOP*);
   END Protocol;

VAR msgNumber :CARDINAL;

PROCEDURE DisplayLoconetMessages( VAR ev :Events.EventType ) :BOOLEAN;

   VAR m :LnMsg.LoconetMessage;

   PROCEDURE OutputMsgNumber();
      VAR number : ARRAY [0..2] OF CHAR;
      BEGIN
         NumberConversion.CardToString( msgNumber, number, SIZE(number) );
         AttrWindow.SetAttribute( traceWin, White, Black, TRUE, FALSE );
         Windows2.WriteString( traceWin, number );
         Windows2.WriteString( traceWin, " " );
      END OutputMsgNumber;

   PROCEDURE OutputHexCodes();
      VAR i : INTEGER;
          number : ARRAY [0..2] OF CHAR;
      BEGIN
         FOR i := 0 TO ABS(m.length)-1 DO
             NumberConversion.NumToString( CARDINAL(m.message[i]),
                                           16, number, SIZE(number) );
             IF CARDINAL(m.message[i]) < 16 THEN
                number[1] := '0';
             END;
             Windows2.WriteString( traceWin, number );
         END (*FOR*);
         Windows2.WriteString( traceWin, " " );
      END OutputHexCodes;

   PROCEDURE OutputMessage();
      VAR msgString :ARRAY [0..80] OF CHAR;
      BEGIN
         CASE m.message[0] OF                 (*    fore,  back, hiint, blink *)
         | 081H: AttrWindow.SetAttribute( traceWin, Red,   Blue, TRUE,  FALSE );
         | 082H: AttrWindow.SetAttribute( traceWin, Brown, Blue, TRUE,  FALSE );
         | 083H: AttrWindow.SetAttribute( traceWin, Brown, Blue, TRUE,  FALSE );
         | 085H: AttrWindow.SetAttribute( traceWin, Red,   Blue, TRUE,  FALSE );
         | 0A0H: AttrWindow.SetAttribute( traceWin, Cyan,  Green, TRUE,  FALSE );
         | 0A1H: AttrWindow.SetAttribute( traceWin, Magenta, Green, TRUE, FALSE );
         ELSE    AttrWindow.SetAttribute( traceWin, White, Red,  FALSE, FALSE );
         END (*CASE*);
         LnMsg.ToString( m, msgString );
         Windows2.WriteString( traceWin, msgString );
      END OutputMessage;

   BEGIN
      IF ev#Events.ExternalEvent THEN
         HardError.Err( "TraceVW: ill. EventType" );
         RETURN TRUE;
      END;
      IF ItemQueues.IsEmpty( display ) THEN
         RETURN FALSE;
      END;
      Windows2.FreezeScreen();
      WHILE NOT ItemQueues.IsEmpty( display ) DO
         IF NOT firstLine THEN
            Windows2.WriteLn( traceWin );
         END;
         firstLine := FALSE;
         ItemQueues.Get( display, m );
         msgNumber := (msgNumber + 1) MOD 1000;
         OutputMsgNumber();
         OutputHexCodes();
         OutputMessage();
      END (*WHILE*);
      Windows2.UnFreezeScreen();
      Windows2.Refresh();
      Windows2.Refresh();
      RETURN TRUE;
   END DisplayLoconetMessages;

PROCEDURE QueueNotEmpty(): BOOLEAN;
   BEGIN
      IF NOT ItemQueues.IsEmpty( display ) THEN
          RETURN TRUE;
      END;
      RETURN oldPollExternal();
   END QueueNotEmpty;

PROCEDURE Initialize( w : Window; errDisp : ErrorDisplayProc ) : BOOLEAN;
   VAR done : BOOLEAN;
       port, irq : CARDINAL;
       m : LnMsg.LoconetMessage;
   BEGIN
      ItemQueues.Init( display, 100, m );
      oldPollExternal := Events.pollExternal;
      Events.pollExternal := QueueNotEmpty;
      msgNumber := 0;
      firstLine := TRUE;
      traceWin := w;
      AttrWindow.DefineAttrWindow( w );
      Events.InstallEventHandler( DisplayLoconetMessages,
                                  Events.EventTypeSet{Events.ExternalEvent} );
      IF ~Resource.GetCardinalWithBase( "SerialPortAdr", 16, port ) THEN
         port := DefaultPort;
      END;
      IF ~Resource.GetCardinal( "SerialPortIrq", irq ) THEN
         irq := DefaultIrq;
      END;
      RS232ADT.OpenPort( serialPort );
      RS232ADT.SetPortAndIrq( serialPort, port, BYTE(irq) );
      RS232ADT.Init( serialPort, 16457, 1, FALSE, FALSE, 8, done );
      IF NOT done THEN
         errDisp( "Error on Serial-Port-Init" );
         RETURN FALSE;
      END;
      RS232ADT.SetLineStatus( serialPort, LineStatusSet{RTS} );
      RS232ADT.AssignProtoProcess( serialPort, Protocol, ADR(workSpace), SIZE(workSpace) );
      RETURN TRUE;
   END Initialize;

PROCEDURE StartTrace();
   BEGIN
      Windows2.PopUp( traceWin );
      RS232ADT.StartReading( serialPort );
   END StartTrace;

PROCEDURE StopTrace();
   BEGIN
      RS232ADT.StopReading( serialPort );
      Windows2.HideWindow( traceWin )
   END StopTrace;

PROCEDURE Cleanup();
   BEGIN
      RS232ADT.ClosePort( serialPort );
   END Cleanup;

PROCEDURE ClearTrace();
   BEGIN
      firstLine := TRUE;
      msgNumber := 0;
      Windows2.ClsAll( traceWin );
   END ClearTrace;

END TraceVW.