home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
PASCAL
/
PAS_0593
/
STARWARP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-05-30
|
4KB
|
124 lines
{─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
Msg : 641 of 728
From : Sean Palmer 1:104/123.0 07 May 93 15:10
To : Micah Lindsey
Subj : StarWarp
────────────────────────────────────────────────────────────────────────────────
ML> SP> Trick is to start them in the center, with a (slow) random speed for X
ML> SP> and Y, and while they are still on the screen, multiply the speed by a
ML> SP> fraction like 1.02 or something small like that so they speed up as
ML> SP> they come "toward" you... (inc(speedX,speedX div 64) or something would
ML> SP> work too, for fixed-point numbers.) If they go off the edge of the
ML> SP> screen, put them back in the middle with a new random speed.
ML> SP> Also making them get bigger as they come would be nice.
ML> SP> If you can't figure it out yourself I could whip something up for
ML> SP> ya... _
ML> I've just recently started working with graphics, and I'd like to
ML> take a look at that. I'd particularly like to know how to animate
ML> something.
Ok, here's some source I just whipped up.}
{$A-,B-,D+,E-,F-,G+,I-,L+,N-,O-,R-,S-,V-,X+}
{$M $2000,0,0}
program starwarp;
uses crt;
const
xRes=320;
yRes=200;
var color:byte;
type
fixed=record case boolean of false:(l:longint);true:(f:word;i:integer);end;
star=record x,y:fixed;xs,ys:longint; timer:word; end;
const numStars=128;
var
a:array[0..numStars-1]of star;
curStar:^Star;
i:integer;
var inPort1:word;
procedure waitRetrace;assembler;asm
mov dx,inPort1; {find crt status reg (input port #1)}
@L1: in al,dx; test al,8; jnz @L1; {wait for no v retrace}
@L2: in al,dx; test al,8; jz @L2; {wait for v retrace}
end;
const
tableWriteIndex=$3C8;
tableDataRegister=$3C9;
procedure setColor(color,r,g,b:byte);assembler;asm {set DAC color}
mov dx,tableWriteIndex; mov al,color; out dx,al; inc dx;
mov al,r; out dx,al; mov al,g; out dx,al; mov al,b;out dx,al;
end; {write index now points to next color}
{plot a pixel in mode $13}
procedure plot(x,y:word);Inline(
$5E/ { pop si ;y}
$5F/ { pop di ;x}
$B8/$00/$A0/ { mov ax,$A000}
$8E/$C0/ { mov es,ax}
$B8/$40/$01/ { mov ax,320}
$F7/$E6/ { mul si}
$01/$C7/ { add di,ax}
$8B/$06/>color/ { mov ax,[color]}
$AA); { stosb}
procedure recenterStar;begin
with curStar^ do begin
timer:=0;
x.f:=0;x.i:=xRes div 2;
y.f:=0;y.i:=yRes div 2;
xs:=integer(random(65535)); if xs<0 then inc(xs);
ys:=integer(random(65535)); if ys<0 then inc(ys);
end;
end;
procedure eraseStar;begin
with curStar^ do begin
color:=0;
plot(x.i,y.i);
end;
end;
procedure moveStar;begin
with curStar^ do begin
inc(x.l,xs);
inc(y.l,ys);
inc(xs,xs div 8);
inc(ys,ys div 8);
if (timer>=64) or (word(x.i)>=xRes) or (word(y.i)>=yRes) then
recenterStar;
inc(timer)
end;
end;
procedure drawStar;begin
with curStar^ do begin
color:=succ(timer shr 3);
plot(x.i,y.i);
end;
end;
begin
inPort1:=memw[$40:$63]+6;
asm mov ax,$13; int $10; end;
for i:=0 to 8 do setcolor(i,i*6,i*5,i*7);
for i:=0 to numStars-1 do begin
curStar:=@a[i];
recenterStar;
end;
repeat
for i:=0 to numStars-1 do begin
curStar:=@a[i];
eraseStar;
moveStar;
drawStar;
end;
waitRetrace;
until keypressed;
readkey;
textmode(c80);
end.