Ir para o conteúdo

Natal e Ano Novo 2015

{$mode objfpc}
program natal2015;
uses crt, sysutils, strutils, math, graph;

const MAXSNOWCOUNT   = 100;
      MAXSNOWRADIUS  = 5;
      DEFAULTHEADING = -30;
      FLOORINCREMENT = 0.05;
      DEFAULTJUMP    = 4.0;
      PROMPT         = 'Feliz Natal e Prospero Ano Novo!';

type TPointReal =
        record
           x, y : Real;
        end;
     TPointApparent =  // EInvalidOp was being generated - this solved it, but I don't understand why... o.O
        record
           x, y : word;
        end;
     TSnowFlake =
        record
           position :
              record
                 previous, current : TPointReal;
                 prev, cur : TPointApparent;
              end;
           radius : word;
           wall, floor : boolean;
        end;
     TSnowHeaven = array [1..MAXSNOWCOUNT] of TSnowFlake;

const NILSNOWFLAKE : TSnowFlake =
         (position :
            (previous :
                (x : 0.0;
                 y : 0.0);
             current :
                (x : 0.0;
                 y : 0.0);
             prev :
                (x : 0;
                 y : 0);
             cur :
                (x : 0;
                 y : 0));
           radius : 0;
           wall   : false;
           floor  : false);

var TOP : word;  // used as a constant


function GenerateSnowFlake(const INIT : boolean; const sh : TSnowFlake) : TSnowFlake;
begin
   with GenerateSnowFlake do begin
      with position do begin
         current.x := Random(graph.GetMaxX) + 1;
         if INIT then
            current.y := RandomRange(TOP + 1, graph.GetMaxY)
         else
            current.y := TOP + 1;
         cur.x := Trunc(current.x);
         cur.y := Trunc(current.y);
         if INIT then begin
            previous.x := current.x;
            previous.y := current.y;
            prev.x := cur.x;
            prev.y := cur.y;
         end else begin
            previous.x := sh.position.current.x;
            previous.y := sh.position.current.y;
            prev.x := sh.position.cur.x;
            prev.y := sh.position.cur.y;
         end;
      end;

      if INIT then begin
         radius := Random(MAXSNOWRADIUS) + 1;
         wall := false;
         floor := false;
      end else begin
         radius := sh.radius;
         wall := sh.wall;
         floor := sh.floor;
      end;
   end;
end;

procedure InitSnowHeaven(out sh : TSnowHeaven);
var i : word;
begin
   Randomize;
   for i := Low(sh) to High(sh) do
      sh[i] := GenerateSnowFlake(true, NILSNOWFLAKE);
end;


procedure PutSnowHeaven(var sh : TSnowHeaven);
var i : word;
begin
   for i := Low(sh) to High(sh) do begin
      with sh[i].position do begin
         if (not sh[i].floor) or sh[i].wall then begin
            SetFillStyle(SolidFill, Black);
            SetColor(Black);
            FillEllipse(prev.x, prev.y, sh[i].radius, sh[i].radius);
         end;

         SetFillStyle(SolidFill, White);
         SetColor(White);
         FillEllipse(cur.x, cur.y, sh[i].radius, sh[i].radius);

         // After drawing, sets "previous" position
         previous := current;
         prev.x := Trunc(previous.x);
         prev.y := Trunc(previous.y);
      end;
   end;
end;


procedure PutFloor(f : Real);
begin
   SetColor(White);
   SetFillStyle(SolidFill, White);
   Bar(0, graph.GetMaxY - Trunc(f), graph.GetMaxX, graph.GetMaxY);
end;


procedure MoveSnowHeaven(var sh : TSnowHeaven; var f : Real; heading : word = DEFAULTHEADING);
var diff : TPointReal;
    i : word;
begin
   with diff do begin
      y := DEFAULTJUMP;
      x := sin(DegToRad(heading))*y;
   end;

   for i := Low(sh) to High(sh) do begin
      with sh[i].position do begin
         if (previous.x + diff.x < sh[i].radius) or (previous.x + diff.x > graph.GetMaxX - sh[i].radius) or (previous.y + diff.y > graph.GetMaxY - sh[i].radius - f) then begin
            sh[i] := GenerateSnowFlake(false, sh[i]);
            if (previous.y + diff.y > graph.GetMaxY - sh[i].radius - f) then begin
               f := f + FLOORINCREMENT;
               sh[i].wall := false;
               sh[i].floor := true;
            end else begin
               sh[i].wall := true;
               sh[i].floor := false;
            end;
         end else begin
            current.x := previous.x + diff.x;
            current.y := previous.y + diff.y;
            cur.x := Trunc(current.x);
            cur.y := Trunc(current.y);
            sh[i].wall := false;
            sh[i].floor := false;
         end;
      end;
   end;
end;


function GetBestFit(const TXT : string) : Word;
var i : word = 0;
begin
   while TextWidth(TXT) < GetMaxX do begin
      Inc(i);
      SetTextStyle(SansSerifFont, HorizDir, i);
   end;
   GetBestFit := i;
end;


var driver, modus : SmallInt;
    snow : TSnowHeaven;
    floor : Real = 0.0;
    f : Text;

begin
   try
      DetectGraph(driver, modus);
      InitGraph(driver, modus, '');

      try
         SetTextStyle(SansSerifFont, HorizDir, GetBestFit(PROMPT));
         TOP := TextHeight(PROMPT) + 10;
         SetColor(Green);
         OutTextXY(5, 5, PROMPT);

         InitSnowHeaven(snow);
         PutSnowHeaven(snow);
         repeat
            while not KeyPressed do begin
               Sleep(1);
               MoveSnowHeaven(snow, floor);
               PutSnowHeaven(snow);
               PutFloor(floor);
            end;
         until ReadKey = #13;

      except
         on ex : Exception do begin
            Assign(f, 'error.txt');
            ReWrite(f);
            writeln(f, 'ERROR ', ex.classname, ', ', ex.message);
            Close(f);
         end;
      end;

   finally
      CloseGraph;
   end;
end.