dev_geral:pascal:comemorativos:hny15
Natal e Ano Novo 2015
- natal2015.pas
{$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.
dev_geral/pascal/comemorativos/hny15.txt · Última modificação em: 2021/12/12 00:43 por staff