program Example_CrtCom_3;

uses
  CrtType,      {typy Video a Keyboard BIOSu}
 {$ifdef MCP}
  Crt2Mem,      {obsluhy Video a Keyboard BIOSu pro komunikaci na KitXxx}
 {$endif}
  Crt,          {Pascalske funkce pro VGA a klavesnici}
  Kernel,       {o.s.Retos}
  Tick,         {obsluha casovacu}
  Timer,        {odmerovani casovych intervalu}
  CrtWin,       {Obsluha oken pod o.s.Retos}
  NumToStr,     {Prevody cisel na string}
  uString,      {Prace s retezci}
  ChnVirt,      {jednotne rozhranni vsech komunikacnich knihoven}
  ChnCom,       {komunikacni knihovna pro fyzicke rozhranni UART i8250}
  ChnCrt,       {komunikacni protokol pro prenos Video a Keyboard}
  CrtComSl;     {komunikacni automat pro prenos Video a Keyboard}

{----------------------------------------------------------------------------}
const
  cAppVer = '01.00,10.08.2004'; {verze tohoto prikladu}

const
  Proc1Win   : pCrtWin = nil; {okno procesu 1}
  Proc2Win   : pCrtWin = nil; {okno procesu 2}
  Proc3Win   : pCrtWin = nil; {okno procesu 3}
  cProc1TerRect : tRect = (X: 2; Y: 4; W:28; H:46);
  cProc2TerRect : tRect = (X:32; Y: 4; W:20; H:46);
  cProc3TerRect : tRect = (X:54; Y: 4; W:26; H:46);

const
 {pro tento priklad}
  Counter1 : word = 0; {citac pro priklad, inkrementuje se pri kazdem pruchodu procesem 1}
  Counter2 : word = 0; {citac pro priklad, inkrementuje se pri kazdem pruchodu procesem 2}
  Counter3 : word = 0; {citac pro priklad, inkrementuje se pri kazdem pruchodu procesem 3}
  CounterFastTick : word = 0; {citac, inkrementuje se ve zrychlenem preruseni od casovace}
  CounterNormTick : word = 0; {citac, inkrementuje se ve standardnim preruseni od casovace}
  Timer3   : tTimer = ();

const
  FlEnd : boolean = False; {priznak pro ukonceni aplikace}

{----------------------------------------------------------------------------}
procedure Proces1; far;
var K:char;
    S:string[80];
begin
  {inicializace okna}
  Proc1Win:=New(PCrtWin,Init(cProc1TerRect,' Proces 1 ',FrameD,
             (Black shl 4) or White{barva nadpisu},
             (Black shl 4) or White{barva ramecku},
             (Black shl 4) or Yellow{barva textu},
             $20,$0){tvar kurzoru:neviditelny});
  Proc1Win^.LockWin;
   ClrScr;
  Proc1Win^.UnLockWin;

  Start('Proces1',4096{Stack},99{SPRio},254{DPrio}); Exit;
  repeat
    Inc(Counter1);
    Proc1Win^.LockWin;
     gotoxy(1,1);
     writeln('Cas od spusteni: ',Timer3.ReadTime,'ms');
     writeln;
     TextColor(White);
     writeln('Citace        pribl.perioda');
     TextColor(Yellow);
     writeln('Proces 1:',Counter1       :5,'   55ms');
     writeln('Proces 2:',Counter2       :5,'  110ms');
     writeln('Proces 3:',Counter3       :5,'  220ms');
     writeln('FastTick:',CounterFastTick:5,'    1ms');
     writeln('NormTick:',CounterNormTick:5,'   55ms');
     writeln;
     TextColor(White);
     writeln('Komunikace s CRT terminalem');
     TextColor(Yellow);
     writeln('Pocet prijatych zprav:',CounterRecMess:5);
     writeln('Pocet chyb pri prijmu:',CounterErrMess:5);
     writeln('Kod posledni chyby   :',WordStrHex(LastErrMess),'h');
     gotoxy(1,20); TextAttr:=TextAttr or Blink; ClrEol;
     write('- Zmackni <Enter> pro zadani textu -'); ClrEol;
     if keypressed then
     begin
       K:=Readkey;
       if K=#$0D{Enter} then
       begin
         gotoxy(1,20); TextAttr:=TextAttr and not Blink; ClrEol;
         write('Zadej text a potom <Enter>, zadas-li "RunError", vygeneruje se RunError(90):');ClrEol;
         Proc1Win^.SetCursor(6,7);
         readln(S);
         Proc1Win^.HiddenCursor;
         S:=UpCaseStr(S);
         if Pos('RUNERROR',S)<>0 then RunError(90);
       end;
       if K=#$1B{Esc} then FlEnd:=True;{ukonceni programu}
     end;
     TextAttr:=TextAttr and not Blink;
    Proc1Win^.UnLockWin;
     Wait(1);
  until FlEnd;
  Terminate;
end;

procedure Proces2; far;
begin
  {inicializace okna}
  Proc2Win:=New(PCrtWin,Init(cProc2TerRect,' Proces 2 ',FrameD,
             (Black shl 4) or White{barva nadpisu},
             (Black shl 4) or White{barva ramecku},
             (Black shl 4) or White{barva textu},
             $20,$0){tvar kurzoru:neviditelny});
  Proc2Win^.LockWin;
   ClrScr;
  Proc2Win^.UnLockWin;

  Start('Proces2',4096{Stack},100{SPRio},254{DPrio}); Exit;
  repeat
    Inc(Counter2);
    Proc2Win^.LockWin;
     if Random(300)=0 then ClrScr; {jednou za cas vymazeme okno}
     write(Counter2,',');
    Proc2Win^.UnLockWin;
    Wait(2);
  until FlEnd;
  Terminate;
end;

procedure Proces3; far;
begin
  {inicializace okna}
  Proc3Win:=New(PCrtWin,Init(cProc3TerRect,' Proces 3 ',FrameD,
             (Black shl 4) or White{barva nadpisu},
             (Black shl 4) or LightGray{barva ramecku},
             (Black shl 4) or LightGray{barva textu},
             $20,$0){tvar kurzoru:neviditelny});
  Proc3Win^.LockWin;
   ClrScr;
  Proc3Win^.UnLockWin;

  Start('Proces3',4096{Stack},101{SPRio},254{DPrio}); Exit;
  repeat
    Inc(Counter3);
    Proc3Win^.LockWin;
     writeln('Time from start ',RealToStr(Timer3.ReadTime/1000,2,tpFixedDes),' s');
    Proc3Win^.UnLockWin;
    Wait(4);
  until FlEnd;
  Terminate;
end;

procedure MyUserTick1; far;
  {procedura volana ve zrychlenem preruseni od casovace}
begin
  Inc(CounterFastTick);
end;

procedure MyUserTick2; far;
  {procedura volana ve standardnim preruseni od casovace}
begin
  Inc(CounterNormTick);
end;

var
  SaveExit:pointer; {pro ulozeni puvodni ExitProc}

procedure MyExitProc; far;
var PomTimer:tTimer;
begin
  ExitProc:=SaveExit;
  if ExitCode<>0 then {obsluha pri RunTime chybe}
  begin
    asm Pushf; Cli end;
    {ukoncime obsluhy preruseni od casovacu}
     SetTickDivider(1);
     UserTick1:=Nic;
     UserTick2:=Nic;
    asm Popf end;

    {o.s.Retos je jiz ukoncen}

    {vypis na obrazovku}
     TextColor(White or Blink);
     Write('RunError ',ExitCode,' Addr:',PtrToStr(ErrorAddr),' Process:',RunningProcess);

    {3s volame komunikacni automat}
     PomTimer.SaveTime;
     repeat
       CrtComMake;
     until PomTimer.TstTime(3000);

    {$ifdef MCP}{reset na KitXxx}
     asm cli end;
     repeat until False;
    {$endif}
  end;
end;

{----------------------------------------------------------------------------}
Begin
 {Inicializace komunikacniho automatu}
 {$ifdef Kit188}
  if InitCrtCom('NAM=CRT MAS=SLAVE LSB=200 '+
                'NAM=COM ADD=$2100 IRQ=$E BD=115200 PAR=E STO=1 LRB=500') <> res_Ok then RunError(10);
 {$else}
  {Kit386EXR}
  if InitCrtCom('NAM=CRT MAS=SLAVE LSB=500 '+
                'NAM=COM COM=2 IRQ=3 BD=115200 PAR=E STO=1 LRB=500') <> res_Ok then RunError(10);
 {$endif}

 {nastaveni vlastni ExitProc pro zachyceni pripadne RunTime chyby}
  SaveExit:=ExitProc;
  ExitProc:=@MyExitProc;

 {inicializace o.s.Retos}
  StartMain(200{SPrio},254{DPrio});
  InitInterruptStack(1,254);
  StartTimeSlicing(8);

 {inicializace casovacu Tick}
  InitTick;
  SetTickDivider(55);{zrychleny casovac bude s periodou 1ms}
  asm Pushf; Cli end;
  UserTick1:=MyUserTick1;{nastaveni zrychlene obsluhy s per. 1ms}
  UserTick2:=MyUserTick2;{nastaveni normalni obsluhy s per. 55ms}
  asm Popf end;

 {inicializace vypisoveho prostredi}
  TextMode(CO80+Font8x8);{textovy rezim 16 barev 80x50 znaku}
  CrtInit;               {inicializace CrtWin}

  MainWin^.LockWin;
  MainWin^.HiddenCursor;
  TextAttr:=White;
  ClrScr;
  write('CrtCom Example 3, ver "',cAppVer,'"');
  MainWin^.UnLockWin;

  Timer3.SaveTime;

 {spusteni procesu 1 az 3}
  Proces1;
  Proces2;
  Proces3;

 {telo hlavniho procesu}
  repeat
    MainWin^.LockWin;
    gotoxy(65,1);write('Clock: ',TimeToStrPT(GetPackTime,'HH:MM:SS'));
    MainWin^.UnLockWin;

   {krok komunikacniho automatu}
    CrtComMake;

    Wait(1);
  until FlEnd;

  TerminateMain;
 {$ifdef MCP}{reset na KitXxx}
  asm cli end;
  repeat until False;
 {$endif}
End.
