program CrtTerminal;

uses
  HWSyst,
  CrtType,
  NumToStr,
  uString,
  ChnVirt,
  ChnCom,
  ChnCrt,
  Timer,
  Crt,
  Keyb16h;

const
  cVer = '01.10,30.07.2004';

  ComParams:tParamStr = 'COM=1 IRQ=4 BD=115200 PAR=E STO=1';

{---------------------------------------------------------}
{ data pro VGA a Keyboard }
const
  SegBiosTable= $0040; {segment ROM BIOS TABLE}
 {adresy v RAM pro VGA}
  OfsVideoDisplayData   = $0049;
  OfsVgaDisplayWorkData = $0084;
  OfsVideoMem = $0000; {offset adresy pro VGA RAM TXT mody}
 {adresy v RAM pro Keyboard}
  OfsKeyboardData       = $0017;
  OfsAdditKeyboardData  = $0080;
  OfsAdditKeyboardFlags = $0096;

var
 {lokalni data, ktera se po prijeti od Slave take kopiruji do ROM BIOS TABLE a VIDEO RAM}
  VideoDisplayData   : tVideoDisplayData;
  VgaDisplayWorkData : tVgaDisplayWorkData;
  VideoMem           : tVideoMem;
 {lokalni data, ktera se pri zmene posilaji do Slave}
  KeyboardData       : tKeyboardData      ;
  AdditKeyboardData  : tAdditKeyboardData ;
  AdditKeyboardFlags : tAdditKeyboardFlags;

{---------------------------------------------------------}
{ komunikace }
type
 {stavy komunikacniho automatu}
  tVGAChnState =
   (stReadVideoTables,    {cteni tabulek ROM BIOS TABLE pro VIDEO}
    stReadAllLine,        {postupne cteni vsech radku Video pameti}
    stReadChngLine,       {cteni zmenenych radku Video pameti}
    stWriteKeyboardTables {zapis tabulek ROM BIOS TABLE pro KEYBOARD}
    );

const
  MaChn    : pChnVirt      = nil; {ukazatel na komunikacni kanal}
  SendBuff : pMaSendRecord = nil; {ukazatel na vysilaci buffer}
  RecBuff  : pMaRecRecord  = nil; {ukazatel na prijimaci buffer}
  FlConnect: boolean       = False;{priznak navazane komunikace se Slave stanici}
  CounterRecMess : word      = 0; {pocet prijatych zprav}
  CounterErrMess : word      = 0; {pocet chyb pri prijmu}
  LastErrMess    : tChResult = Res_Ok; {kod posledni zjistene chyby pri prijmu}
  LineIx         : byte    = 1;   {index dalsiho cteneho radku}
  FlFirstAllLine : boolean = True; {priznak prvniho nacteni vsech radku po navazani komunikace}
  VGAChnState:tVGAChnState = stReadVideoTables; {stav komunikacniho automatu Master}
  TimerRefreshAll : tTimer = ();  {casovac pro refresh cele obrazovky}
  KeyBuffForSlave : array[1..16]of word = {stisknute klavesy pro ridici system}
    (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
  IdxToKeyBuffForSlave : byte = 0; {index do KeyBuffForSlave}

{---------------------------------------------------------}
{nastavitelne parametry programu}
const
  PeriodRefreshAll : byte = 20; {perioda [s] refreshe cele obrazovky}
  ReplyTimeOut     : word =1000;{timeout [ms] pri cekani na odpoved}

{---------------------------------------------------------}
procedure ReadVideoTables; forward;
  {nacte s podrizeneho systemu VIDEO ROM BIOS TABLE}
function  DecodeVideoTables:boolean; forward;
  {dekoduje prijatou odpoved na cteni VIDEO ROM BIOS TABLE a vrati priznak uspesnosti}
procedure ReadVideoLine; forward;
  {nacte s podrizeneho systemu radky video pameti od LineIx a tento index pote inkrementuje}
function  DecodeVideoLines:boolean; forward;
  {dekoduje prijatou odpoved na cteni radku VIDEO RAM a vrati priznak pri prechodu na 1.radek}
procedure ReadVideoChngLine; forward;
  {nacte s podrizeneho systemu zmenene radky video pameti LineIx nebo dalsi a tento index pote patricne inkrementuje}
procedure WriteKeyboardTables; forward;
  {pri zmene zapise KEYBOARD ROM BIOS TABLE do podrizeneho systemu}

{---------------------------------------------------------}
const
  KeysForMasPrg : boolean = True; {priznak zda-li zmacknute klavesy jsou urceny
                                   Master programu nebo pro podrizeny system}

{---------------------------------------------------------}
procedure ReadVideoTables;
var T:tTimer;
    L:word;
    W:word;
label L_Receive;
begin
  SendBuff^.Cmd:=Cmd_BiosVideoTable;
  with MaChn^ do
  begin
    ChReceiveFlush;
    ChSend(SendBuff,1);
    repeat
      if ChSendResult<>res_Ok then ;
    until ChSendReady=CHS_SendReady;
    T.SaveTime;
   L_Receive:
    if ChReceiveReady=CHS_ReceiveReady then
    begin
      W:=ChReceiveResult;
      if W<>res_Ok then begin Inc(CounterErrMess); Exit; end;
      ChReceive(L);
      W:=ChReceiveResult;
      if W<>res_Ok then begin Inc(CounterErrMess); Exit; end;
      if not DecodeVideoTables then begin Inc(CounterErrMess); Exit; end;
      Inc(CounterRecMess);
      FlConnect:=True;
    end
    else
    begin
      W:=ChReceiveResult;
      if W<>res_Ok then Inc(CounterErrMess);
      if not T.TstTime(ReplyTimeOut) then goto L_Receive;
      FlConnect:=False;
    end;
  end;
end;
{---------------------------------------------------------}
function  DecodeVideoTables:boolean;
  procedure BlankVideoMem(var _VideoMem:tVideoMem); assembler;
  asm
    les  di,_VideoMem
    mov  ax,0720h
    mov  cx,type tVideoMem
    shr  cx,1
    rep  stosw
  end;
var
  W:word;
begin
  with RecBuff^ do
  begin
    if Cmd<>Cmd_BiosVideoTable then Exit;
    if (BiosVideoTable.VideoDisplayData.CRT_MODE <> VideoDisplayData.CRT_MODE)or
       (BiosVideoTable.VideoDisplayData.CRT_COLS <> VideoDisplayData.CRT_COLS)or
       (BiosVideoTable.VgaDisplayWorkData.ROWS   <> VgaDisplayWorkData.ROWS) then
    begin {zmena videomodu}
      BlankVideoMem(VideoMem);
      Move(VideoMem, Ptr(SegB800 ,OfsVideoMem)^, SizeOf(tVideoMem));
      if BiosVideoTable.VgaDisplayWorkData.ROWS>25 then
           TextMode(BiosVideoTable.VideoDisplayData.CRT_MODE or Font8x8)
      else TextMode(BiosVideoTable.VideoDisplayData.CRT_MODE);
      LineIx:=1;
    end;
    W:=BiosVideoTable.VideoDisplayData.CURSOR_MODE;
    if (W <> VideoDisplayData.CURSOR_MODE) then
    asm   {zmena tvaru kurzoru}
      mov  ah,01h
      mov  cx,W
      Int  10h
    end;
    W:=BiosVideoTable.VideoDisplayData.CURSOR_POSN[0];
    if (W <> VideoDisplayData.CURSOR_POSN[0]) then
    asm   {zmena polohy kurzoru}
      mov  bh,0
      mov  ah,02h
      mov  dx,W
      Int  10h
    end;
    VideoDisplayData  :=BiosVideoTable.VideoDisplayData;
    VgaDisplayWorkData:=BiosVideoTable.VgaDisplayWorkData;
    Move(VideoDisplayData  , Ptr(SegBiosTable,OfsVideoDisplayData  )^, SizeOf(tVideoDisplayData));
    Move(VgaDisplayWorkData, Ptr(SegBiosTable,OfsVgaDisplayWorkData)^, SizeOf(tVgaDisplayWorkData));
  end;
  DecodeVideoTables:=True;
end;

{---------------------------------------------------------}
procedure ReadVideoLine;
var T:tTimer;
    L:word;
    W:tChResult;
label L_Receive;
begin
  SendBuff^.Cmd  :=Cmd_VideoMemLines;
  SendBuff^.LineI:=LineIx;
  with MaChn^ do
  begin
    ChReceiveFlush;
    ChSend(SendBuff,2);
    repeat
      if ChSendResult<>res_Ok then ;
    until ChSendReady=CHS_SendReady;
    T.SaveTime;
   L_Receive:
    if ChReceiveReady=CHS_ReceiveReady then
    begin
      W:=ChReceiveResult;
      if W<>res_Ok then begin Inc(CounterErrMess); Exit; end;
      ChReceive(L);
      W:=ChReceiveResult;
      if W<>res_Ok then begin Inc(CounterErrMess); Exit; end;
      with RecBuff^ do
      begin
        if Cmd=Cmd_BiosVideoTable then
        begin
          DecodeVideoTables;
          FlFirstAllLine:=True;
          LineIx:=1;
          Inc(CounterRecMess);
          Exit;
        end;
        if Cmd<>Cmd_VideoMemLines then begin Inc(CounterErrMess); Exit; end;

        if DecodeVideoLines then LineIx:=1;
        Inc(CounterRecMess);
        FlConnect:=True;
      end;
    end
    else
    begin
      W:=ChReceiveResult;
      if W<>Res_ok then Inc(CounterErrMess);
      if not T.TstTime(ReplyTimeOut) then goto L_Receive;
      FlConnect:=False;
    end;
  end;
end;

{---------------------------------------------------------}
procedure ReadVideoChngLine;
var T:tTimer;
    L:word;
    W:tChResult;
label L_Receive;
begin
  SendBuff^.Cmd  :=Cmd_VideoMemLinesChng;
  SendBuff^.LineI:=LineIx;
  with MaChn^ do
  begin
    ChReceiveFlush;
    ChSend(SendBuff,2);
    repeat
      if ChSendResult<>res_Ok then ;
    until ChSendReady=CHS_SendReady;
    T.SaveTime;
   L_Receive:
    if ChReceiveReady=CHS_ReceiveReady then
    begin
      W:=ChReceiveResult;
      if W<>res_Ok then begin Inc(CounterErrMess); Exit; end;
      ChReceive(L);
      W:=ChReceiveResult;
      if W<>res_Ok then begin Inc(CounterErrMess); Exit; end;
      with RecBuff^ do
      begin
        if Cmd=Cmd_BiosVideoTable then
        begin
          DecodeVideoTables;
          FlFirstAllLine:=True;
          LineIx:=1;
          Inc(CounterRecMess);
          FlConnect:=True;
          Exit;
        end;
        if (Cmd<>Cmd_VideoMemLines)and
           (Cmd<>Cmd_VideoMemLinesChng) then begin Inc(CounterErrMess); Exit; end;

        if DecodeVideoLines then LineIx:=1;
        Inc(CounterRecMess);
        FlConnect:=True;
      end;
    end
    else
    begin
      W:=ChReceiveResult;
      if W<>Res_Ok then Inc(CounterErrMess);
      if not T.TstTime(ReplyTimeOut) then goto L_Receive;
      FlConnect:=False;
    end;
  end;
end;

{---------------------------------------------------------}
function  DecodeVideoLines:boolean;
var I,W:word;
    Fl:boolean;
    PreLineI:byte;
begin
  Fl:=False;
  with RecBuff^.VideoMemLines do
  begin
    PreLineI:=LinesData[1].LineI;
    for I:=1 to LinesCount do
    with LinesData[I] do
    begin
      W:=(LineI-1)*VideoDisplayData.CRT_COLS*2;{index do VideoRam na zacatek radku LineI}
      if BegPos>1 then
        W:=W+(BegPos*2)-(1*2); {posun pozice v radku}
      if OnlyChar then
           PutChars(Chars, pAByte(@VideoMem)^[W], NumChars{pouze znaky})
      else Move    (Chars, pAByte(@VideoMem)^[W], NumChars*2{znaky a atributy});
      if (LineI<PreLineI)or(LineI<LineIx) then
        Fl:=True;{prechod na zacatek obrazovky}
    end;
    {zobrazeni na monitoru}
    Move(VideoMem, Ptr(SegB800 ,OfsVideoMem)^, SizeOf(tVideoMem));

    if not Fl then
    begin
      LineIx:=LinesData[LinesCount].LineI;
      Inc(LineIx);
      if LineIx>VGADisplayWorkData.ROWS+1 then
        Fl:=True;{prechod na zacatek obrazovky}
    end;
  end;
  DecodeVideoLines:=Fl;
end;

{---------------------------------------------------------}
procedure WriteKeyboardTables;
var
  T:tTimer;
  W:word;
  L:word;
label L_Receive;
begin
  if (MemCmp(Ptr(SegBiosTable,OfsKeyboardData      ), @KeyboardData      , SizeOf(tKeyboardData)      ) = 0)and
     (MemCmp(Ptr(SegBiosTable,OfsAdditKeyboardData ), @AdditKeyboardData , SizeOf(tAdditKeyboardData) ) = 0)and
     (MemCmp(Ptr(SegBiosTable,OfsAdditKeyboardFlags), @AdditKeyboardFlags, SizeOf(tAdditKeyboardFlags)) = 0)then
    Exit; {zadna zmena stavu klavesnice}
 {priprava zpravy pro vyslani}
  SendBuff^.Cmd  :=Cmd_BiosKeybTable;
  Move(Ptr(SegBiosTable,OfsKeyboardData      )^, SendBuff^.BiosKeybTable.KeyboardData      , SizeOf(tKeyboardData));
  Move(Ptr(SegBiosTable,OfsAdditKeyboardData )^, SendBuff^.BiosKeybTable.AdditKeyboardData , SizeOf(tAdditKeyboardData));
  Move(Ptr(SegBiosTable,OfsAdditKeyboardFlags)^, SendBuff^.BiosKeybTable.AdditKeyboardFlags, SizeOf(tAdditKeyboardFlags));
  {klavesy pro ridici system sestavit zvlast}
  with SendBuff^.BiosKeybTable.KeyboardData do
  begin
    BUFFER_HEAD:=SendBuff^.BiosKeybTable.AdditKeyboardData.BUFFER_START;
    if IdxToKeyBuffForSlave>0 then
    begin
      for L:=1 to IdxToKeyBuffForSlave do
        KB_BUFFER[L-1]:=KeyBuffForSlave[L];
      BUFFER_TAIL:=BUFFER_HEAD+IdxToKeyBuffForSlave*2;
    end
    else
      BUFFER_TAIL:=BUFFER_HEAD;
  end;
 {vyslani zpravy+cekani na odpoved}
  with MaChn^ do
  begin
    ChReceiveFlush;
    ChSend(SendBuff,1+SizeOf(tCmd_BiosKeybTable));
    repeat
      if ChSendResult<>res_Ok then ;
    until ChSendReady=CHS_SendReady;
    T.SaveTime;
   L_Receive:
    if ChReceiveReady=CHS_ReceiveReady then
    begin
      W:=ChReceiveResult;
      if W<>res_Ok then begin Inc(CounterErrMess); Exit; end;
      ChReceive(L);
      W:=ChReceiveResult;
      if W<>res_Ok then begin Inc(CounterErrMess); Exit; end;
      with RecBuff^ do
      begin
        if Cmd=Cmd_BiosVideoTable then
        begin
          DecodeVideoTables;
          FlFirstAllLine:=True;
          LineIx:=1;
          Inc(CounterRecMess);
          FlConnect:=True;
          Exit;
        end;
        if Cmd<>Cmd_BiosKeybTable then begin Inc(CounterErrMess); Exit; end;
        IdxToKeyBuffForSlave:=0;
        Inc(CounterRecMess);
        FlConnect:=True;
      end;
    end
    else
    begin
      W:=ChReceiveResult;
      if W<>Res_Ok then Inc(CounterErrMess);
      if not T.TstTime(ReplyTimeOut) then goto L_Receive;
      FlConnect:=False;
    end;
  end;
end;

{---------------------------------------------------------}
{ pracovni pomocne promenne }
var
  W:word;
  Key:word;

{$ifNdef MCP}
procedure ReadINIfile;
var F:text;
    S:string;
label L_End;
begin
  Assign(F,'CRTTERM.INI');
 {$I-}
  Reset(F); if IOResult<>0 then goto L_End;
  Readln(F,S);
  Close(F);
  if (Pos('COM',S)=0)or
     (Pos('IRQ',S)=0)or
     (Pos('BD',S)=0) then goto L_End;
  ComParams:=S;
 L_End:
 {$I+}
end;
procedure WriteINIfile;
var F:text;
label L_End;
begin
  Assign(F,'CRTTERM.INI');
 {$I-}
  Rewrite(F); if IOResult<>0 then goto L_End;
  Writeln(F,ComParams); if IOResult<>0 then goto L_End;
 L_End:
  Close(F);
 {$I+}
end;
{$endif}

{---------------------------------------------------------}
Begin
  TextMode(CO80);
  writeln('CrtTerminal pro DOS v',cVer,'  SofCon spol.s r.o. Autor:A.Wild');
 {inicializace VGA bufferu}
  Move(Ptr(SegBiosTable,OfsVideoDisplayData  )^, VideoDisplayData  , SizeOf(tVideoDisplayData));
  Move(Ptr(SegBiosTable,OfsVgaDisplayWorkData)^, VgaDisplayWorkData, SizeOf(tVgaDisplayWorkData));
  Move(Ptr(SegB800     ,OfsVideoMem          )^, VideoMem          , SizeOf(tVideoMem));

 {nacteni parametru komunikace z INI souboru}
 {$ifNdef MCP}
  ReadINIfile;
  WriteINIfile;
 {$endif}

 {inicializace komunikacniho kanalu}
  MaChn:=New(pChnCrt,Init);
  New(SendBuff); FillChar(SendBuff^, SizeOf(tMaSendRecord), 0);
  New(RecBuff);  FillChar(RecBuff ^, SizeOf(tMaRecRecord ), 0);
  with MaChn^ do
  begin
    ChSetParam('NAM=CRT MAS=MASTER LSB=200 '+
               'NAM=COM LRB=1000 '+ComParams);
    W:=ChResult;
    if W<>res_Ok then begin Writeln('ChSetParam Error $',WordStrHex(W)); Exit; end;

    ChOpen;
    W:=ChResult;
    if W<>res_Ok then begin Writeln('ChOpen Error $',WordStrHex(W)); Exit; end;
    while ChReady<>CHS_Open do
    begin
      W:=ChResult;
      if W<>res_Ok then begin Writeln('ChOpen Error $',WordStrHex(W)); Exit; end;
    end;

    ChReceiveBuffer(RecBuff,SizeOf(tMaRecRecord));
    W:=ChReceiveResult;
    if W<>res_Ok then begin Writeln('ChReceiveBuffer Error $',WordStrHex(W)); Exit; end;

    ChConnect;
    W:=ChResult;
    if W<>res_Ok then begin Writeln('ChConnect Error $',WordStrHex(W)); Exit; end;
    while ChReady<>CHS_Connect do
    begin
      W:=ChResult;
      if W<>res_Ok then begin Writeln('ChConnect Error $',WordStrHex(W)); Exit; end;
    end;

    Writeln('COM "',ComParams,'" Init Ok');
  end;
  TimerRefreshAll.SaveTime;

 {komunikacni automat}
  repeat
    case VGAChnState of
      stReadVideoTables:
        begin
          ReadVideoTables;
          if FlConnect then
          begin
            if FlFirstAllLine then
            begin
              VGAChnState:=stReadAllLine;
              FlFirstAllLine:=False;
            end
            else
              if TimerRefreshAll.TstTime(longint(1000)*PeriodRefreshAll) then
              begin
                LineIx:=1;
                VGAChnState:=stReadAllLine;
                TimerRefreshAll.SaveTime;
              end
              else
              begin
                if IdxToKeyBuffForSlave>0 then {je-li stisknuta nejaka klavesa, tak ji prednostne posleme}
                     VGAChnState:=stWriteKeyboardTables
                else VGAChnState:=stReadChngLine;
              end;
          end;
        end;
      stReadAllLine:
        begin
          ReadVideoLine;
          if LineIx=1 then
            VGAChnState:=stWriteKeyboardTables;
        end;
      stReadChngLine:
        begin
          ReadVideoChngLine;
          if LineIx=1 then
            VGAChnState:=stWriteKeyboardTables;
        end;
      stWriteKeyboardTables:
        begin
          WriteKeyboardTables;
          VGAChnState:=stReadVideoTables;
        end;
    end; {case}
    if not FlConnect then
    begin
      VGAChnState:=stReadVideoTables;
      FlFirstAllLine:=True;
      IdxToKeyBuffForSlave:=0;
      TextAttr:=(LightGray shl 4) or Black;
      gotoxy(40-7,12); write('             ');
      gotoxy(40-7,13); write(' Not Connect ');
      gotoxy(40-7,14); write('             ');
    end;
    Key:=GetKeyInBuff;
    if Key<>kNone then
      Key:=Readkey2;
    if Key=kF12 then KeysForMasPrg:=False;
    if Key=kF11 then KeysForMasPrg:=True;
    if (Key<>kNone)and(FlConnect)and(not KeysForMasPrg)and
       (Key<>kF12)and(IdxToKeyBuffForSlave<16) then
    begin {stisknuta klavesa je pro ridici system, ktery je pripojen,
           vlozime ji do bufferu a pozdeji mu ji posleme}
      Inc(IdxToKeyBuffForSlave);
      KeyBuffForSlave[IdxToKeyBuffForSlave]:=Key;
    end;
  until (KeysForMasPrg)and(Key=kEsc);

 {ukonceni}
  Dispose(SendBuff); SendBuff:=nil;
  Dispose(RecBuff);  RecBuff :=nil;
  Dispose(MaChn,Done); MaChn :=nil;
End.
