paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-06 11:36:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Reinstated dissapeared code

Browse Source
This commit is contained in:
michael 2002-09-10 20:07:51 +00:00
parent 1174d3b87b
commit ad5c522f02
1 changed files with 139 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

144
packages/extra/ncurses/firework.pp
View File

@ -1,9 +1,143 @@
{
$Id$
}
program firework;
uses
ncurses,linux;
CONST
my_bg : LONGINT = COLOR_BLACK;
Procedure showit;
begin
refresh;
napms(120);
end;
Function get_colour(Var bold : chtype) : longint;
Var
attr : longint;
begin
attr:=random(16) + 1;
bold:=A_NORMAL;
if (attr > 8) then
begin
bold:=A_BOLD;
attr:=attr and 7;
end;
get_colour:=attr;
end;
Procedure explode(Row,Col : longint);
var
Bold : chtype;
begin
ncurses.erase;
mvaddstr(row,col,'-');
showit;
init_pair(1,get_colour(bold),my_bg);
attrset(COLOR_PAIR(1) or bold);
mvaddstr(row-1,col-1,' - ');
mvaddstr(row,col-1,'-+-');
mvaddstr(row+1,col-1,' - ');
showit;
init_pair(1,get_colour(bold),my_bg);
attrset(COLOR_PAIR(1) or bold);
mvaddstr(row-2,col-2,' --- ');
mvaddstr(row-1,col-2,'-+++-');
mvaddstr(row, col-2,'-+#+-');
mvaddstr(row+1,col-2,'-+++-');
mvaddstr(row+2,col-2,' --- ');
showit;
init_pair(1,get_colour(bold),my_bg);
attrset(COLOR_PAIR(1) or bold);
mvaddstr(row-2,col-2,' +++ ');
mvaddstr(row-1,col-2,'++#++');
mvaddstr(row, col-2,'+# #+');
mvaddstr(row+1,col-2,'++#++');
mvaddstr(row+2,col-2,' +++ ');
showit;
init_pair(1,get_colour(bold),my_bg);
attrset(COLOR_PAIR(1) or bold);
mvaddstr(row-2,col-2,' # ');
mvaddstr(row-1,col-2,'## ##');
mvaddstr(row, col-2,'# #');
mvaddstr(row+1,col-2,'## ##');
mvaddstr(row+2,col-2,' # ');
showit;
init_pair(1,get_colour(bold),my_bg);
attrset(COLOR_PAIR(1) or bold);
mvaddstr(row-2,col-2,' # # ');
mvaddstr(row-1,col-2,'# #');
mvaddstr(row, col-2,' ');
mvaddstr(row+1,col-2,'# #');
mvaddstr(row+2,col-2,' # # ');
showit;
end;
Var
startp,endp,row,diff,flag : longint;
direction : boolean;
begin
flag:=0;
initscr;
if (has_colors<>0) then
start_color;
curs_set(0);
randomize;
cbreak;
While true do
begin
repeat
startp:=random (COLS -3);
endp:=random (COLS - 3);
If startp < 2 then
startp:=2;
If endp <2 then
endp:=2;
direction:=startp > endp ;
diff:=abs(startp-endp);
until (diff>2) and (diff<(LINES-2));
attrset(A_NORMAL);
for row:=0 to diff do
begin;
If direction then
mvaddstr(LINES - row,startp + row ,'/')
else
mvaddstr(LINES - row,startp - row ,'\');
inc(flag);
if flag<>0 then
begin
showit;
erase;
flag:=0;
end;
end;
inc(flag);
if (flag<>0) then
begin
showit;
flag:=0;
end;
randomize;
If Direction then
explode(LINES-row,startp+diff)
Else
explode(LINES-row,startp-diff);
erase;
showit;
end;
end.
{
$Log$
Revision 1.2 2002-09-07 15:43:01 peter
* old logs removed and tabs fixed
Revision 1.1 2002/01/29 17:55:17 peter
* splitted to base and extra
Revision 1.3 2002-09-10 20:07:51 michael
+ Reinstated dissapeared code
}