{* Песочные часы *}

Unit PESCHCLOCK;
Interface
Implementation
Begin
 writeln('

Песочные часы с высыпающимся песком

');
End.

Program peschclock;

Uses peschclock.pas; {* Эту строку можно удалить *}
Uses Graph, CRT; {* Вызов внешних функций *}
Const {* Постоянные значения *}
  PauseTime = 30; {длительность паузы при прорисовке изображения}
  Count     = 90; {количество песка в часах,  60 < Count < 125}
Var {* Необходимые переменные *}
  grDriver : Integer; {переменные для инициализации графического режима}
  grMode   : Integer; {номер графического режима}
  ErrCode  : Integer; {код ошибки инициализации графического режима}
  i        : integer;
  j        : integer;
  k        : integer; {переменные циклов}
  Key      : word; {код нажатой клавиши}
Begin
  grDriver := Detect;
  InitGraph(grDriver, grMode, 'e:programbpbgi'); {инициируем графику}
  ErrCode := GraphResult;
  If ErrCode  grOk Then
    Halt(1); {Выход из программы}
  {продолжаем если графика инициализирована удачно}
  Line(50, 50, 150, 200);
  Line(150, 50, 50, 200);
  Line(50, 50, 150, 50);
  Line(50, 200, 150, 200);
  SetFillStyle(SolidFill, DarkGray); { новый стиль заполнения }
  Bar(45, 45, 155, 49);
  Bar(45, 201, 155, 206); {уравнения линий ограничивающих песок: }
  Repeat   {цикл рисования часов, каждый новый круг часы "переворачиваются"}
    {J = Count - верхняя граница линии песка, 125 - нижняя}
  For j := Count To 125 Do { l1 : x = (2y + 50) / 3;
    l2 : x = (2y - 550) / ( - 3) - выведены}
    Begin
      For i := Round((2 * j + 50) / 3) + 1 To Round((2 * j - 550) / ( - 3)) - 1 Do
        PutPixel(i, j, Yellow); {рисуем начальное состояние песка}
    End;
  For k := 199 Downto 199 - Count Do
    For i := Round((2 * k - 550) / ( - 3)) + 1 To Round((2 * k + 50) / 3) - 1 Do
      PutPixel(i, k, Black); {стираем песок в нижнем конусе}
  {ждем реакции пользователя, разрешающей начало течения песка}
  k := ord(ReadKey); {получаем код нажатой клавиши}
  If k = 0 Then
    k := ord(ReadKey); {если нажата клавиша с расширеным кодом}
  If k = 27 Then
    Break; {выходим из цикла, если нажата Esc}
  {y = 125 - ордината точки пересечения двух линий l1 и l2}
  j := 199; {т.к. нижний конус кончается при y=200, чтобы не затереть его}
  k := Count; {уменьшаем начальное значение J}
  Randomize; {инициализируем генератор случайных чисел}
  While (j > 199 - (125 - Count)) And (k < 125) Do
  Begin
    For i := j Downto 125 Do
      If Random(10) < 6 Then {имитируем песчинки в струе песка}
        PutPixel(100, i, Black)
      Else PutPixel(100, i, Yellow); {рисуем полоску песка в нижнем конусе}
        For i := Round((2 * j - 550) / ( - 3)) + 1 To Round((2 * j + 50) / 3) - 1 Do
          PutPixel(i, j, Yellow); {стираем полоску песка в верхнем конусе (1)}
    For i := Round((2 * k + 50) / 3) + 1 To Round((2 * k - 550) / ( - 3)) - 1 Do
      PutPixel(i, k, Black); {стираем полоску песка в верхнем конусе (2)}
    For i := Round((2 * (k + 1) + 50) / 3) + 1 To Round((2 * (k + 1) - 550) / ( - 3)) - 1 Do
      PutPixel(i, k + 1, Black);
    Delay(PauseTime); {пауза и изменение переменных цикла}
    {уровень песка в верхнем конусе уменьшается быстрее, чем повышается}
    {его количество в нижнем}
    dec(j); {* Вычтем из j единицу *}
    inc(k, 2); {* Увеличиваем k, 2 на 1 *}
  End;
  While }
    {завершение работы}
  For i := j Downto 125 Do {cтираем струю песка}
    PutPixel(100, i, Black);
  k := ord(ReadKey); {получаем код нажатой клавиши}
  If k = 0 Then
    k := ord(ReadKey); {если нажата клавиша с расширеным кодом}
  Until k = 27;
  CloseGraph; {закрываем графику}
End.