mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-18 01:58:32 +02:00
151 lines
3.2 KiB
ObjectPascal
151 lines
3.2 KiB
ObjectPascal
PROGRAM Sterne;
|
|
|
|
|
|
uses Exec, AGraphics, Intuition, Utility;
|
|
|
|
|
|
|
|
CONST MAX_STERNE = 42;
|
|
MAX_GESCHW = 15;
|
|
|
|
TYPE Star = packed Record
|
|
x,y :Integer;
|
|
msin :Real;
|
|
mcos :Real;
|
|
d :Integer;
|
|
v :Integer;
|
|
End;
|
|
|
|
VAR Scr :pScreen;
|
|
Win :pWindow;
|
|
Msg :pIntuiMessage;
|
|
Ende :Boolean;
|
|
Stars :Array[1..MAX_STERNE] of Star;
|
|
factor :Real;
|
|
col :Integer;
|
|
dum :Longint;
|
|
|
|
|
|
PROCEDURE newStern(num :Integer);
|
|
|
|
BEGIN
|
|
col:=Random(360);
|
|
Stars[num].x := Scr^.Width shr 1;
|
|
Stars[num].y := Scr^.Height shr 1;
|
|
Stars[num].msin := sin(col*factor);
|
|
Stars[num].mcos := cos(col*factor);
|
|
Stars[num].d := 0;
|
|
Stars[num].v := Random(MAX_GESCHW)+2;
|
|
END;
|
|
|
|
|
|
PROCEDURE moveStern(num :Integer);
|
|
|
|
BEGIN
|
|
Stars[num].d:=Stars[num].d+Stars[num].v;
|
|
Stars[num].x:=Round(Stars[num].d*Stars[num].msin)+Scr^.Width shr 1;
|
|
Stars[num].y:=Round(Stars[num].d*Stars[num].mcos)+Scr^.Height shr 1;
|
|
{Inc(Stars[num].v);}
|
|
END;
|
|
|
|
|
|
PROCEDURE drawSterne;
|
|
|
|
BEGIN
|
|
For dum:=1 to MAX_STERNE Do Begin
|
|
If Stars[dum].v=0 Then Begin
|
|
If Random(10)>4 Then
|
|
newStern(dum);
|
|
End Else If Stars[dum].d>Scr^.Width shr 1 Then Begin
|
|
SetAPen(Win^.RPort,0);
|
|
If WritePixel(Win^.RPort,(Stars[dum].x),(Stars[dum].y))=0 Then;
|
|
Stars[dum].v:=0;
|
|
End Else Begin
|
|
SetAPen(Win^.RPort,0);
|
|
If WritePixel(Win^.RPort,(Stars[dum].x),(Stars[dum].y))=0 Then;
|
|
moveStern(dum);
|
|
col:=(Stars[dum].d shl 5) Div Scr^.Height shr 1;
|
|
If col>7 Then
|
|
col:=7;
|
|
SetAPen(Win^.RPort,col);
|
|
If WritePixel(Win^.RPort,(Stars[dum].x),(Stars[dum].y))=0 Then;
|
|
End;
|
|
End;
|
|
END;
|
|
|
|
|
|
PROCEDURE initSterne;
|
|
|
|
BEGIN
|
|
For dum:=1 to MAX_STERNE Do begin
|
|
Stars[dum].x := Scr^.Width shr 1;
|
|
Stars[dum].y := Scr^.Height shr 1;
|
|
Stars[dum].msin := 0.0;
|
|
Stars[dum].mcos := 0.0;
|
|
Stars[dum].d := 0;
|
|
Stars[dum].v := 0;
|
|
end;
|
|
factor:=PI/180;
|
|
END;
|
|
|
|
|
|
PROCEDURE CleanUp(str:string; code : Longint);
|
|
|
|
BEGIN
|
|
If assigned(Win) Then
|
|
CloseWindow(Win);
|
|
If assigned(Scr) then CloseScreen(Scr);
|
|
if str <> '' then writeln(str);
|
|
Halt(code);
|
|
END;
|
|
|
|
PROCEDURE Init;
|
|
|
|
BEGIN
|
|
|
|
Scr:=Nil; Win:=Nil;
|
|
|
|
Scr := OpenScreenTags(NIL,[
|
|
SA_Depth, 3,
|
|
SA_DisplayID, HIRES_KEY,
|
|
TAG_END]);
|
|
|
|
If Scr=Nil Then CleanUp('No screen',20);
|
|
|
|
Win:=OpenWindowTags(Nil, [
|
|
WA_Flags, WFLG_BORDERLESS,
|
|
WA_IDCMP, IDCMP_MOUSEBUTTONS,
|
|
WA_CustomScreen, AsTag(Scr),
|
|
TAG_DONE]);
|
|
|
|
If Win=Nil Then CleanUp('No window',20);
|
|
|
|
initSterne;
|
|
|
|
SetRGB4(@Scr^.ViewPort, 0, $0,$0,$0);
|
|
SetRGB4(@Scr^.ViewPort, 1, $3,$3,$3);
|
|
SetRGB4(@Scr^.ViewPort, 2, $6,$6,$6);
|
|
SetRGB4(@Scr^.ViewPort, 3, $b,$b,$b);
|
|
SetRGB4(@Scr^.ViewPort, 4, $c,$c,$c);
|
|
SetRGB4(@Scr^.ViewPort, 5, $d,$d,$d);
|
|
SetRGB4(@Scr^.ViewPort, 6, $e,$e,$e);
|
|
SetRGB4(@Scr^.ViewPort, 7, $f,$f,$f);
|
|
|
|
END;
|
|
|
|
|
|
|
|
BEGIN
|
|
Init;
|
|
Ende:=false;
|
|
Repeat
|
|
drawSterne;
|
|
Msg:=pIntuiMessage(GetMsg(Win^.UserPort));
|
|
If Msg<>Nil Then Begin
|
|
ReplyMsg(Pointer(Msg));
|
|
Ende:=true;
|
|
End;
|
|
Until Ende;
|
|
CleanUp('',0);
|
|
END.
|