program Hodiny;

{ Program demonstrujici funkci realtimoveho programu. V programu je
  odstartovano celkem 20 procesu, ktere ovladaji pet demonstracnich
  hodin a jeden proces pro komunikaci s uzivatelem. Jedny hodiny
  slouzi jako referencni a ostatni  muze uzivatel libovolne zpomalovat
  a zrychlovat.
}

uses
{$ifdef MCP}
  RtcTime,
{$endif}
  PCInt21,
  Crt,
  Dos,
  Graph,
  ScGraph,
  Kernel;


const
  Limit       = 59;                     { max pocet sekund a  minut }

                                        { graficke konstanty        }
  SecondLength= 60;
  MinuteLength= 50;
  HourLength  = 40;
  Radius      = SecondLength+5;
  DivLimit    = 100;
  Dark        = Black;
  Light       = White;
  TextX       = 210;
  TextY       = 360;
  Title       = 60;

type
  Coords = record X,Y: Integer; end;     { souradnice                }
                                         { cas                       }
  Time   = record Hr, Min, Sec, Hund: Word; end;
                                { schranky potrebne pro jedny hodiny }
  Boxes  = record Seconds, Minutes, Hours: MailBox; end;

const
                           { souradnice umisteni jednotlivych hodin }
  Zero0: Coords = ( X:325; Y:200);
  Zero1: Coords = ( X:110; Y:115);
  Zero2: Coords = ( X:110; Y:310);
  Zero3: Coords = ( X:540; Y:115);
  Zero4: Coords = ( X:540; Y:310);
                           { pocatecni nastaveni rychlosti hodin    }
  Div0: Word = 18;
  Div1: Word = 4;
  Div2: Word = 32;
  Div3: Word = 16;
  Div4: Word = 1;

var
                           { deklarace schranek pro jednotlive hodiny }
  Boxes0, Boxes1, Boxes2, Boxes3, Boxes4: Boxes;
                                          { pomocne graficke promenne }
  Alfa, SinAlfa, CosAlfa, Ratio: Real;
  XX, YY: Word;
  Time0, Time1, Time2, Time3, Time4: Time;
  SecondArray, MinuteArray, HourArray: array [0..Limit] of Coords;
  I, grDriver, grMode: Integer;

                            { procedura pro smazani kterekoliv rucicky }
procedure DrawInv(Thick: Word; Zero,C: Coords);
begin
     SetColor(Dark);
     SetLineStyle(0, 0, Thick);
     Line(Zero.X, Zero.Y, Zero.X + C.X, Zero.Y + C.Y);
     SetColor(Light);
end {DrawInv};

                              { procedura pro vykresleni vsech rucicek }
procedure DrawAll(Zero: Coords; T: Time);
begin
     SetLineStyle(0, 0, 1);
     Line(Zero.X, Zero.Y,
          Zero.X + SecondArray[T.Sec].X, Zero.Y + SecondArray[T.Sec].Y);
     SetLineStyle(0, 0, 2);
     Line(Zero.X, Zero.Y,
          Zero.X + MinuteArray[T.Min].X, Zero.Y + MinuteArray[T.Min].Y);
     SetLineStyle(0, 0, 3);
     Line(Zero.X, Zero.Y,
          Zero.X + HourArray[T.Hr].X, Zero.Y + HourArray[T.Hr].Y);
end {DrawAll};


{$F+}
{
   Proces, ktery urcuje rychlost behu hodin. Proces vzdy ceka,
   nez uplyne Divider taktu absolutniho casu a pak vysle zpravu
   na schranku Seconds, ze uplynula jedna sekunda. Kazde hodiny
   maji svuj proces ProcTicks, ktery jako parametr B obdrzi
   schranky prislusejici tomuto procesu. Parametr Divider je volan
   odkazem a jako skutecny parametr je predana promenna Div0 az Div4
   podle toho, ke kterym hodinam proces prislusi.
}

procedure ProcTicks(No: Char; var Divider: Word; var B: Boxes);
begin
     Start('Ticks'+No, 2000, 80, 1);
     Exit;
     Inc(MinProcessNo);
     repeat
           Wait(Divider);
           SendEmpty(B.Seconds);
     until false;
end {ProcTicks};

{
   Nasledujici procesy ProcSeconds, ProcMinutes a ProcHours mazou
   a kresli vterinovou (resp. minutovou a hodinovou) rucicku. Tyto
   procesy vzdy cekaji na zpravu, ze uplynula sekunda (resp. minuta
   a hodina). V pripade, ze nastala minuta (resp. hodina) posilaji
   o tom zpravu nasledujicimu procesu. Kazde hodiny maji svuj proces
   ProcSeconds, ProcMinutes a ProcHours.
}
procedure ProcSeconds(No: Char; Zero: Coords; var T: Time; var B: Boxes);
begin
     Start('Seconds'+No, 2000, 70, 1);
     Exit;
     Inc(MinProcessNo);
     repeat
           if ArrivedEmpty(B.Seconds) then
           else Accept;
           DrawInv(1, Zero, SecondArray[T.Sec]);
           if T.Sec = Limit then
           begin
                T.Sec := 0;
                SendEmpty(B.Minutes);
           end
           else Inc(T.Sec);
           DrawAll(Zero, T);
     until false;
end {ProcSeconds};

procedure ProcMinutes(No: Char; Zero: Coords; var T: Time; var B: Boxes);
begin
     Start('Minutes'+No, 2000, 60, 1);
     Exit;
     Inc(MinProcessNo);
     repeat
           if ArrivedEmpty(B.Minutes) then
           else Accept;
           DrawInv(2, Zero, MinuteArray[T.Min]);
           if T.Min mod 12 = 0 then SendEmpty(B.Hours);
           if T.Min = Limit
           then T.Min := 0
           else Inc(T.Min);
           DrawAll(Zero, T);
     until false;
end {ProcMinutes};

procedure ProcHours(No: Char; Zero: Coords; var T: Time; var B: Boxes);
begin
     Start('Hours'+No, 2000, 50, 1);
     Exit;
     Inc(MinProcessNo);
     repeat
           if ArrivedEmpty(B.Hours) then
           else Accept;
           DrawInv(3, Zero, HourArray[T.Hr]);
           if T.Hr = Limit then
           begin
                T.Hr := 0;
           end
           else Inc(T.Hr);
           DrawAll(Zero, T);
     until false;
end {ProcHours};

{
   Procedura Run namaluje cifernik a spusti pro zadane hodiny vsechny
   potrebne procesy.
}
procedure Run(No: Char; var Divider: Word; Zero: Coords; var T: Time;
              var B: Boxes);
var S: String[2];
begin
     SetColor(LightBlue);
     OutTextXY(Zero.X-Radius-20, Zero.Y-Radius-20, No);
     for I := 1 to 12 do
     begin
          Alfa := (6-I)/6*Pi;
          XX := Zero.X + Round((Radius+15) * Sin(Alfa)) - 4;
          YY := Zero.Y + Round(Ratio*(Radius+15) * Cos(Alfa)) - 4;
          Str(I, S);
          OutTextXY(XX, YY, S);
     end;
     SetLineStyle(0, 0, 1);
     Circle(Zero.X, Zero.Y, Radius);
     Circle(Zero.X, Zero.Y, Radius+30);
     InitCounterMailBox(B.Seconds, '', Normal);
     InitCounterMailBox(B.Minutes, '', Normal);
     InitCounterMailBox(B.Hours, '', Normal);
     SetColor(Light);
     DrawAll(Zero, T);
     ProcTicks(No, Divider, B);
     ProcSeconds(No, Zero, T, B);
     ProcMinutes(No, Zero, T, B);
     ProcHours(No, Zero, T, B);
end {Run};

{
   Proces, ktery ocekava prikazy uzivatele
}
procedure Keyboard;
begin
     Start('Keyboard', 1000, 100, 1);
     Exit;
     repeat
        if KeyPressed then
           case ReadKey of
           '1': if Div1>1 then Div1 := Div1 div 2;
           '!': if Div1<DivLimit then Div1 := Div1 * 2;     { Shift/'1'}
           '2': if Div2>1 then Div2 := Div2 div 2;
           '@': if Div2<DivLimit then Div2 := Div2 * 2;     { Shift/'2'}
           '3': if Div3>1 then Div3 := Div3 div 2;
           '#': if Div3<DivLimit then Div3 := Div3 * 2;     { Shift/'3'}
           '4': if Div4>1 then Div4 := Div4 div 2;
           '$': if Div4<DivLimit then Div4 := Div4 * 2;     { Shift/'4'}
           ^[: Exit;                                        { Esc      }
           end
        else
          Wait(1);
     until false;
end {Keyboard};

{
   Procedura, ktera se vola pri ukonceni cinnosti jadra
}
procedure MyTerminate;
begin
     CloseGraph;
end;


begin
     InitPCInt21;

                                               { graficka inicializace }
(*
  !@# nesmi se pouzit prikaz LINE
     DetectGraph(grDriver, GrMode);
     grDriver:=VgaHi;
     InitGraph(grDriver, grMode,'');
*)
     grDriver := Detect;
     ScInitGraph(grDriver, grMode);


     GetAspectRatio(XX, YY);
     Ratio := XX/YY;
     for I := 0 to Limit do
     begin
          Alfa := (30-I)/30*Pi;
          SinAlfa := Sin(Alfa);
          CosAlfa := Cos(Alfa);
          HourArray[I].X := Round(HourLength * SinAlfa);
          HourArray[I].Y := Round(Ratio * HourLength * CosAlfa);
          MinuteArray[I].X := Round(MinuteLength * SinAlfa);
          MinuteArray[I].Y := Round(Ratio * MinuteLength * CosAlfa);
          SecondArray[I].X := Round(SecondLength * SinAlfa);
          SecondArray[I].Y := Round(Ratio * SecondLength * CosAlfa);
     end;
     SetColor(LightRed);

     Line(TextX+10, Title-10, TextX+220, Title-10);
     Line(TextX+10, Title-10, TextX+10, Title+15);
     Line(TextX+10, Title+15, TextX+220, Title+15);
     Line(TextX+220, Title-10, TextX+220, Title+15);

     OutTextXY(TextX, Title,       '   T I M E   M A C H I N E');

     SetColor(White);
     OutTextXY(TextX, TextY,    '<1> ... <4>          zrychleni');
     OutTextXY(TextX, TextY+15, '<Shift><1> ... <4>   zpomaleni');
     OutTextXY(TextX, TextY+30, '<Esc>                konec');

                                                  { inicializace jadra }

     UserTerminate := MyTerminate; { definice uzivatelskeho zakonceni  }
     StartMain(1000, 0);           { start hlavniho procesu            }
     InitInterruptStack(1, 512);   { inicalizace prerusovaciho systemu }
     StartTimeSlicing(8);          { spusteni spravy casu              }

                              { spusteni procesu pro jednotlive hodiny }
     GetTime(Time0.Hr, Time0.Min, Time0.Sec, Time0.Hund);
     Time0.Hr := Time0.Hr mod 12 * 5 + Time0.Min div 12;
     Run(' ', Div0, Zero0, Time0, Boxes0);


     Time1 := Time0;
     Run('1', Div1, Zero1, Time1, Boxes1);

     Time2 := Time0;
     Run('2', Div2, Zero2, Time2, Boxes2);

     Time3 := Time0;
     Run('3', Div3, Zero3, Time3, Boxes3);

     Time4 := Time0;
     Run('4', Div4, Zero4, Time4, Boxes4);

     Keyboard;                             { spusteni procesu Keyboard }


     TerminateMain;                        { ukonceni programu         }
end.