Program SmallCom;

{
    Ce programme est un programme simplifié pour un terminal, qui, à
la base, n'a aucune caractéristique particulière, mais qui fonctionne
raisonnablement bien. Il s'agit d'un terminal compatible avec la norme
ANSI là où se trouve le console.device - celui-ci se borne à passer les
données d'entrée, en provenance du clavier ou du périphérique série,
au périphérique console.

    Pour augmenter un peu le contrôle sur le programme, vous pourriez
vouloir jeter un coup d'oeil aux caractères une fois qu'ils ont été
translatés (après l'appel à DeadKeyConvert) et en traiter certains (les
touches de fonctions, par exemple) au lieu de les envoyer vers le
console.device.
}

{$I "Include:Exec/Interrupts.i"}
{$I "Include:Exec/Libraries.i"}
{$I "Include:Exec/Ports.i"}
{$I "Include:Exec/IO.i"}
{$I "Include:Exec/Devices.i"}
{$I "Include:Devices/Console.i"}
{$I "Include:Utils/IOUtils.i"}
{$I "Include:Utils/ConsoleIO.i"}
{$I "Include:Intuition/Intuition.i"}
{$I "Include:Devices/InputEvent.i"}
{$I "Include:Utils/DeadKeyConvert.i"}
{$I "Include:Utils/BuildMenu.i"}
{$I "Include:Devices/Serial.i"}
{$I "Include:Exec/Memory.i"}
{$I "Include:Utils/StringLib.i"}


Type
    ParityType = (no_parity, even_parity, odd_parity);

Const
    w      : WindowPtr = Nil;
    SerialWrite   : IOExtSerPtr = Nil;
    SerialRead   : IOExtSerPtr = Nil;
    ConsoleWrite : IOStdReqPtr = Nil;

    WritingConsole   : Boolean = False;
    WritingSerial   : Boolean = False;

    SerialSendBuffer   : String = Nil;
    ConsoleSendBuffer   : String = Nil;
    SerialReceiveBuffer : String = Nil;
    TranslateBuffer   : String = Nil;

    BaudRate   : Integer = 2400;
    DataBits   : Byte = 8;
    Parity   : ParityType = no_parity;
    StopBits   : Byte = 1;
    HalfDuplex   : Boolean = False;

    QuitStopDie   : Boolean = False;

    BaudRates   : Array [0..5] of Integer = (300, 1200, 2400,
                    4800, 9600, 19200);

var
    IMessage   : IntuiMessage;
    Msg      : MessagePtr;
    TitleBuffer : Array [0..79] of Char;

Procedure MakeWindowTitle;
var
    TitlePtr : String;
    NumBuff  : Array [0..79] of Char;
    Error    : Integer;
begin
    TitlePtr := Adr(TitleBuffer);
    strcpy(TitlePtr, "SmallCom     ");
    Error := IntToStr(Adr(NumBuff), BaudRate);
    strcat(TitlePtr, Adr(NumBuff));
    NumBuff[0] := ' ';
    NumBuff[1] := Chr(DataBits + 48);
    case Parity of
      no_parity   : NumBuff[2] := 'N';
      even_parity : NumBuff[2] := 'E';
      odd_parity  : NumBuff[2] := 'O';
    end;
    NumBuff[3] := Chr(StopBits + 48);
    NumBuff[4] := '\0';
    strcat(TitlePtr, Adr(NumBuff));
    SetWindowTitles(w, TitlePtr, Nil);
end;

Function OpenTheWindow : Boolean;
var
    nw : NewWindowPtr;
begin
    new(nw);
    with nw^ do begin
   LeftEdge := 0;
   TopEdge := 0;
   Width := 320;
   Height := 200;

   DetailPen := -1;
   BlockPen  := -1;
   IDCMPFlags := RAWKEY_f + MENUPICK_f + CLOSEWINDOW_f;
   Flags := SMART_REFRESH + ACTIVATE + WINDOWSIZING + WINDOWDRAG +
         WINDOWDEPTH + WINDOWCLOSE + SIZEBBOTTOM;
   FirstGadget := Nil;
   CheckMark := Nil;
   Title := "";
   Screen := Nil;
   BitMap := Nil;
   MinWidth := 0;
   MaxWidth := -1;
   MinHeight := 0;
   MaxHeight := -1;
   WType := WBENCHSCREEN_f;
    end;

    w := OpenWindow(nw);
    dispose(nw);
    OpenTheWindow := w <> nil;
end;

Procedure AddTheMenus;
begin
    InitializeMenu(w);
    NewMenu("Project");
    NewItem("Quit",'Q');
    NewMenu("Serial");

    NewItem("Baud Rate",'\0');
    NewSubItem("  300", '1');
    NewSubItem(" 1200", '2');
    NewSubItem(" 2400", '3');
    NewSubItem(" 4800", '4');
    NewSubItem(" 9600", '5');
    NewSubItem("19200", '6');

    NewItem("Data Size", '\0');
    NewSubItem("7N2", '\0');
    NewSubItem("7E1", '\0');
    NewSubItem("7O1", '\0');
    NewSubItem("8N1", '\0');

    NewItem("Duplex   ", '\0');
    NewSubItem("Half", 'H');
    NewSubItem("Full", 'F');

    AttachMenu;
end;


Function CreateExtIO(ioReplyPort : MsgPortPtr; Size : Integer) : Address;
var
    Request : IOStdReqPtr;
begin
    if ioReplyPort = Nil then
   CreateExtIO := Nil;

    Request := AllocMem(Size, MEMF_CLEAR + MEMF_PUBLIC);
    if Request = Nil then
   CreateExtIO := Nil;

    with Request^.io_Message.mn_Node do begin
   ln_Type := NTMessage;
   ln_Pri := 0;
    end;
    Request^.io_Message.mn_ReplyPort := ioReplyPort;
    CreateExtIO := Request;
end;


Procedure DeleteExtIO(Request : Address; Size : Integer);
var
    Req : IOStdReqPtr;
begin
    Req := Request;
    with Req^ do begin
   io_Message.mn_Node.ln_Type := NodeType($FF);
   io_Device := Address(-1);
   io_Unit := Address(-1);
    end;
    FreeMem(Request, Size);
end;


Procedure Die;
var
    Error : Integer;
begin
    if SerialWrite <> Nil then begin
   if CheckIO(SerialRead) = Nil then begin
       Error := AbortIO(SerialRead);
       Error := WaitIO(SerialRead);
   end;
   CloseDevice(SerialWrite);
   DeleteExtIO(SerialWrite, SizeOf(IOExtSer));
   if SerialRead <> Nil then
       DeleteExtIO(SerialRead, SizeOf(IOExtSer));
    end;

    if ConsoleWrite <> Nil then begin
   CloseDevice(ConsoleWrite);
   DeleteStdIO(ConsoleWrite);
    end;
    if w <> Nil then begin
   DetachMenu;
   Forbid;
   while GetMsg(w^.UserPort) <> Nil do;
   Permit;
   CloseWindow(w);
    end;
    Exit(0);
end;

Procedure SendSerial(IO : IOExtSerPtr; Data : Address; Size : Integer);
var
    Error : Short;
begin
    with IO^.IOSer do begin
   io_Data := Data;
   io_Length := Size;
   io_Command := CMD_WRITE;
    end;
    Error := DoIO(IO);
end;

Procedure QueueSerialRead;
var
    Waiting : Integer;
begin
    with SerialRead^.IOSer do begin
   io_Command := SDCMD_QUERY;
   Waiting := DoIO(SerialRead);
   Waiting := io_Actual;
   if Waiting = 0 then
       Waiting := 1
   else if Waiting > 80 then
       Waiting := 80;
   io_Length := Waiting;
   io_Command := CMD_READ;
   io_Data := SerialReceiveBuffer;
    end;
    SendIO(SerialRead);
end;


Procedure SetSerialParams;
var
    Error : Short;
begin
    with SerialWrite^ do begin
   io_ReadLen   := DataBits;
   io_BrkTime   := 750000;
   io_Baud      := BaudRate;
   io_WriteLen   := DataBits;
   io_StopBits   := StopBits;
   io_RBufLen   := 4000;
   io_TermArray.TermArray0 := $51040303;
   io_TermArray.TermArray1 := $03030303;
   io_CtlChar   := SER_DEFAULT_CTLCHAR;
   case parity of
     no_parity   : io_SerFlags := 0;
     even_parity   : io_SerFlags := SERF_PARTY_ON;
     odd_parity   : io_SerFlags := SERF_PARTY_ON + SERF_PARTY_ODD;
   end;
   IOSer.io_Command := SDCMD_SETPARAMS;
    end;
    if CheckIO(SerialRead) = Nil then begin
   Error := AbortIO(SerialRead);
   Error := WaitIO(SerialRead);
    end;
    Error := DoIO(SerialWrite);
    QueueSerialRead;
    MakeWindowTitle;
end;


Function OpenSerialDevice : Boolean;
var
    Error : Short;
begin
    SerialWrite := CreateExtIO(w^.UserPort, SizeOf(IOExtSer));
    if SerialWrite = Nil then
   OpenSerialDevice := False;
    SerialRead := CreateExtIO(w^.UserPort, SizeOf(IOExtSer));
    if SerialWrite = Nil then begin
   DeleteExtIO(SerialWrite, SizeOf(IOExtSer));
   SerialWrite := Nil;
   OpenSerialDevice := False;
    end;

    with SerialWrite^ do begin
   io_ReadLen   := DataBits;
   io_BrkTime   := 750000;
   io_Baud      := BaudRate;
   io_WriteLen   := DataBits;
   io_StopBits   := StopBits;
   io_RBufLen   := 4000;
   io_SerFlags   := 0;
   io_SerFlags   := 0;
    end;

    Error := OpenDevice("serial.device", 0, SerialWrite, 0);

    if Error = 0 then begin
   SerialRead^ := SerialWrite^;
   QueueSerialRead;
   SetSerialParams;
   OpenSerialDevice := True;
    end else begin
   DeleteExtIO(SerialWrite, SizeOf(IOExtSer));
   DeleteExtIO(SerialRead, SizeOf(IOExtSer));
   SerialWrite := Nil;
   OpenSerialDevice := False;
    end;
end;


Function OpenConsoleDevice : Boolean;
var
    Error : Short;
begin
    ConsoleWrite := CreateStdIO(w^.UserPort);
    if ConsoleWrite = Nil then
   OpenConsoleDevice := False;

    with ConsoleWrite^ do begin
   io_Data := w;
   io_Length := SizeOf(Window);
    end;

    Error := OpenDevice("console.device", 0, ConsoleWrite, 0);
    if Error = 0 then
   ConsoleBase := ConsoleWrite^.io_Device
    else
   DeleteStdIO(ConsoleWrite);
    OpenConsoleDevice := Error = 0;
end;


Procedure OpenEverything;
begin
    SerialSendBuffer   := AllocString(80);
    ConsoleSendBuffer   := AllocString(80);
    SerialReceiveBuffer := AllocString(80);
    TranslateBuffer   := AllocString(80);
    
    if not OpenTheWindow then
   Die;

    AddTheMenus;

    if not OpenConsoleDevice then
   Die;

    if not OpenSerialDevice then
   Die;
end;


Procedure ProcessIntuitionMsg;
var
    IMessage   : IntuiMessage;
    IPtr   : IntuiMessagePtr;

    Procedure ProcessMenu;
    var
   MenuNumber   : Short;
   ItemNumber   : Short;
   SubItemNumber   : Short;
    begin
   if IMessage.Code = MENUNULL then
       return;

   MenuNumber := MenuNum(IMessage.Code);
   ItemNumber := ItemNum(IMessage.Code);
   SubItemNumber := SubNum(IMessage.Code);

   case MenuNumber of
     0 : if ItemNumber = 0 then
       QuitStopDie := True;
     1 : begin
        case ItemNumber of
          0 : BaudRate := BaudRates[SubItemNumber];
          1 : case SubItemNumber of
           0 : begin
              DataBits := 7;
              Parity   := no_parity;
              StopBits := 2;
               end;
           1 : begin
              DataBits := 7;
              Parity   := even_parity;
              StopBits := 1;
               end;
           2 : begin
              DataBits := 7;
              Parity   := odd_parity;
              StopBits := 1;
               end;
           3 : begin
              DataBits := 8;
              Parity   := no_parity;
              StopBits := 1;
               end;
         end;
          2 : HalfDuplex := SubItemNumber = 0;
        end;
        if ItemNumber < 2 then
            SetSerialParams;
         end;
   end;
    end;


    Procedure ProcessKeypress;
    var
   Length   : Short;
   Buffer   : Array [0..79] of Char;
    begin
   if IMessage.Code < 128 then begin
       Length := DeadKeyConvert(Adr(IMessage), TranslateBuffer, 79, Nil);
       if Length > 0 then begin
      if HalfDuplex then
          ConWrite(ConsoleWrite, TranslateBuffer, Length);
      SendSerial(SerialWrite, TranslateBuffer, Length);
       end;
   end;
    end;

begin
    IPtr := IntuiMessagePtr(Msg);
    IMessage := IPtr^;
    ReplyMsg(Msg);

    case IMessage.Class of
      MENUPICK_f : ProcessMenu;
      RAWKEY_f   : ProcessKeypress;
      CLOSEWINDOW_f : QuitStopDie := True;
    end;
end;

Procedure ProcessSerialInput;
begin
    with SerialRead^.IOSer do begin
   if io_Actual > 0 then
       ConWrite(ConsoleWrite, SerialReceiveBuffer, io_Actual);
    end;
    QueueSerialRead;
end;

begin
    OpenEverything;
    repeat
   Msg := WaitPort(w^.UserPort);
   Msg := GetMsg(w^.UserPort);
   if Msg = MessagePtr(SerialRead) then
       ProcessSerialInput
   else
       ProcessIntuitionMsg;
    until QuitStopDie;
    Die;
end.