program Example4;

(* Toto je jednoduchy prikladek a castecne i testik na knihovny
   CrtWin a CrtWin2. Tyto knihovny definuji objekty pro praci s okny
   v TXT rezimu. Je-li zvolen o.s.Retos (viz direktiva define nize),
   pouziva se pro zachovani reentrantnosti pri pristupu k obrazovce
   jednotka CrtWin. Pokud se o.s.Retos nepouziva, plni stejnou
   funkci jednotka CrtWin2.

   Autor: Adam Wild, SofCon spol.s r.o.
*)

{ define Retos}

uses
  HWSyst,
  Crt,
 {$ifdef Retos}
  Kernel,         { o.s.Retos }
  CrtWin,         { obsluha TXT rezimu pod o.s.Retos }
 {$else}
  CrtWin2,        { obsluha TXT rezimu bez o.s.Retos }
 {$endif}
  NumToStr;       { prevody cisel }

type
  tMyWindows = {vycet oken}
   (tpWin1,
    tpWin2,
    tpWin3,
    tpWin4);

const
  cColorStr:array[0..15]of string[12] =
   ('Black       ',
    'Blue        ',
    'Green       ',
    'Cyan        ',
    'Red         ',
    'Magenta     ',
    'Brown       ',
    'LightGray   ',
    'DarkGray    ',
    'LightBlue   ',
    'LightGreen  ',
    'LightCyan   ',
    'LightRed    ',
    'LightMagenta',
    'Yellow      ',
    'White       ');

const
 {ukazatele na okna}
  MyWindows : array[tMyWindows]of pCrtWin = (nil,nil,nil,nil);
 {index aktualniho okna}
  MyActWin : tMyWindows = Low(tMyWindows); {cislo aktualniho okna}

procedure InitDebVyp; forward;
          { inicializace vypisovych oken }

procedure DoneDebVyp; forward;
          { zruseni vypisovych oken }

{-----------------------------------------------------------------------}
procedure WriteClock; {vypis hodin}
var Time:longint;
begin
  Time:=GetPackTime;
  MainWin^.LockWin;
   gotoxy(62,2);
   write(TimeToStrPT(Time,'HH:MM:SS'),' ',DateToStrPT(Time,'DD.MM.YYYY'));
   gotoxy(1,2);
   write('Aktivni okno: ',byte(MyActWin)+1);
  MainWin^.UnLockWin;
end;

{-----------------------------------------------------------------------}
procedure WriteFreeMem; {vypis velikosti volne pameti}
begin
  MainWin^.LockWin;
   gotoxy(62,1);
   write('Free Mem:',MemAvail:8);
  MainWin^.UnLockWin;
end;

{-----------------------------------------------------------------------}
procedure InitDebVyp;
  {--------------}
  procedure WriteColorsAndCursorSettings;
   {vypise aktualni barvu textu a jeho pozadi a rozmery kurzoru}
  begin
    writeln('Barva pozadi : ',cColorStr[TextAttr shr $4]);
    writeln('Barva popredi: ',cColorStr[TextAttr and $F]);
    writeln('Tvar kurzoru : $',WordStrHex(GetCursor));
  end;
  {--------------}
const
 {rozmery oken}
  cTerRect1 : tRect = (X: 2; Y: 4; W:78; H:17);
  cTerRect2 : tRect = (X: 2; Y:23; W:38; H: 8);
  cTerRect3 : tRect = (X:42; Y:23; W:38; H:27);
  cTerRect4 : tRect = (X: 2; Y:33; W:38; H:17);
begin
  { na VGA monitoru zmena rezimu na 80x50 znaku }
  TextMode(Lo(LastMode)+Font8x8);
  {nastaveni barvy pozadi}
  TextAttr:=(LightGray shl 4) or White; {sedy podklad, bily text}

  { inicializace vypisoveho prostredi }
  CrtInit;
  MainWin^.LockWin;
  MainWin^.HiddenCursor;
  ClrScr;
 {$ifdef Retos}
  write('Priklad na jednotku CrtWin verze ',CrtWin.cVer);
 {$else}
  write('Priklad na jednotku CrtWin2 verze ',CrtWin2.cVer);
 {$endif}
  MainWin^.UnLockWin;

  { okno 1 }
  MyWindows[tpWin1]:=New(PCrtWin,Init(cTerRect1,' Okno 1 ',FrameD{double frame},
                         (Blue shl 4) or White {barva titulku okna},
                         (Blue shl 4) or Yellow{barva ramecku okna},
                         (Black shl 4) or LightBlue{barva vnitrku okna},
                         $7,$8{kurzor je podtrzitko}));
  with MyWindows[tpWin1]^ do
  begin
    LockWin;
     ClrScr;
     WriteColorsAndCursorSettings;
    UnLockWin;
  end;

  { okno 2 }
  MyWindows[tpWin2]:=New(PCrtWin,Init(cTerRect2,' Okno 2 ',FrameS{single frame},
                         (Blue shl 4) or White{barva titulku okna},
                         (Blue shl 4) or Yellow{barva ramecku okna},
                         (Green shl 4) or Red{barva vnitrku okna},
                         $20,$0{kurzor je neviditelny}));
  with MyWindows[tpWin2]^ do
  begin
    LockWin;
     ClrScr;
     WriteColorsAndCursorSettings;
    UnLockWin;
  end;

  { okno 3 }
  MyWindows[tpWin3]:=New(PCrtWin,Init(cTerRect3,' Okno 3 ',FrameD{double frame},
                         (Blue shl 4) or White{barva titulku okna},
                         (Blue shl 4) or Yellow{barva ramecku okna},
                         (Cyan shl 4) or LightGreen{barva vnitrku okna},
                         $4,$8{kurzor je tucnejsi podtrzitko}));
  with MyWindows[tpWin3]^ do
  begin
    LockWin;
     ClrScr;
     WriteColorsAndCursorSettings;
    UnLockWin;
  end;

  { okno 4 }
  MyWindows[tpWin4]:=New(PCrtWin,Init(cTerRect4,' Okno 4 ',FrameS{single frame},
                         (Blue shl 4) or White{barva titulku okna},
                         (Blue shl 4) or Yellow{barva ramecku okna},
                         (Magenta shl 4) or White{barva vnitrku okna},
                         $0,$8{kurzor je blok}));
  with MyWindows[tpWin4]^ do
  begin
    LockWin;
     ClrScr;
     WriteColorsAndCursorSettings;
    UnLockWin;
  end;

  MyWindows[MyActWin]^.LockWin;

  WriteClock;
  WriteFreeMem;
end;

{-----------------------------------------------------------------------}
procedure DoneDebVyp;
var w:tMyWindows;
begin
  for w:=Low(tMyWindows) to High(tMyWindows) do
  begin
    if MyWindows[w]<>nil then Dispose(MyWindows[w],Done); MyWindows[w]:=nil;
  end;
  CrtClose;
end;

{-----------------------------------------------------------------------}
Const
  Key : char = #0;

Begin
{$ifdef Retos}
 {inicializace o.s.Retos}
  StartMain(100{SPrio},254{DPrio});
  InitInterruptStack(1,254);
  StartTimeSlicing(8);
{$endif}

 {inicializace vypisovych oken}
  InitDebVyp;

 {smycka programu}
  repeat
    if keypressed then
         Key:=Readkey
    else Key:=#0;
    if Key<>#0 then
    case Key of
      #9{Tab}:begin {zaktivneni dalsiho okna}
                MyWindows[MyActWin]^.UnLockWin;
                if MyActWin<High(tMyWindows) then
                  Inc(MyActWin)
                else MyActWin:=Low(tMyWindows);
                MyWindows[MyActWin]^.LockWin;
              end;
      ' '..#$7F: {pisatelne znaky}
              with MyWindows[MyActWin]^ do
              begin
                write(Key);
              end;
    end;
    WriteFreeMem;   {vypis volne pameti}
    WriteClock;     {vypis aktualniho data a casu}
 {$ifdef Retos}
    Wait(1);
 {$endif}
  until Key=#$1B{Esc};

  DoneDebVyp;
 {$ifdef Retos}
  TerminateMain;
 {$endif}
End.