[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
{$g+} { see end of document for more .. }
uses
crt,gru; { GRU in GRAPHICS.SWG }
const
add1=1;
add2=-1;
add3=-1;
var
ptab,ctab:array[0..199] of byte;
stab1,stab2,stab3:array[0..255] of byte;
i,i1,i2,i3:word;
workp:pointer;
work:word;
timer:longint absolute $0040:$006c;
frame,t1,t2:longint;
procedure virtup;
begin
getmem(workp,64000);
work:=seg(workp^);
end;
procedure virtdn;
begin
work:=0;
freemem(workp,64000);
end;
procedure init;
begin
virtup;
frame:=0;
for i:=0 to 255 do begin
stab1[i]:=round(sin(i*2*pi/255)*50)+160;
stab2[i]:=round(cos(i*4*pi/255)*25);
stab3[i]:=round(sin(i*4*pi/255)*25);
end;
fillchar(ctab,sizeof(ctab),0);
i1:=0; i2:=25; i3:=100;
end;
procedure waves;
var x,y:word;
begin
t1:=timer;
repeat
move(ctab,ptab,sizeof(ctab));
for i:=0 to 199 do
begin
ctab[i]:=stab1[(i+i1) mod 255]+stab2[(i+i2) mod 255]+stab3[(i+i3) mod 255];
hline2(0,ctab[i],i,work,ctab[i]-59);
hline2(ctab[i],320,i,work,not (ctab[i]-15));
end;
i1:=(i1+add1) mod 255; i2:=(i2+add2) mod 255; i3:=(i3+add3) mod 255;
flip386(work,vidseg);
inc(frame);
until(keypressed)and(readkey=#27);
t2:=(timer-t1);
end;
procedure main;
begin
init;
setmode($13);
for i:=1 to 199 do setpal(i,i div 4,20+i div 5,10+i div 6);
waves;
setmode($03);
writeln(round((frame*18.2)/t2),' fps.');
virtdn;
end;
begin
main;
end.
{--------------------------- SIN2 -------------------- }
{$g+}
uses
crt,gru;
const
add1=1;
add2=-1;
add3=-1;
var
ptab,ctab:array[0..319] of byte;
stab1,stab2,stab3:array[0..255] of byte;
i,i1,i2,i3:word;
workp:pointer;
work:word;
timer:longint absolute $0040:$006c;
frame,t1,t2:longint;
procedure virtup;
begin
getmem(workp,64000);
work:=seg(workp^);
end;
procedure virtdn;
begin
work:=0;
freemem(workp,64000);
end;
procedure init;
begin
virtup;
frame:=0;
for i:=0 to 255 do
begin
stab1[i]:=round(sin(i*2*pi/255)*50)+109;
stab2[i]:=round(cos(i*4*pi/255)*25);
stab3[i]:=round(sin(i*4*pi/255)*25);
end;
fillchar(ctab,sizeof(ctab),0);
i1:=0; i2:=25; i3:=100;
end;
procedure waves;
var x,y:word;
begin
t1:=timer;
repeat
move(ctab,ptab,sizeof(ctab));
for i:=0 to 319 do
begin
ctab[i]:=stab1[(i+i1) mod 255]+stab2[(i+i2) mod 255]+stab3[(i+i3) mod 255];
vline2(i,0,ctab[i],work,ctab[i]);
vline2(i,ctab[i],200,work,not (ctab[i]+40));
end;
i1:=(i1+add1) mod 255; i2:=(i2+add2) mod 255; i3:=(i3+add3) mod 255;
flip386(work,vidseg);
inc(frame);
until(keypressed)and(readkey=#27);
t2:=(timer-t1);
end;
procedure main;
begin
init;
setmode($13);
for i:=1 to 199 do setpal(i,i div 4,20+i div 5,10+i div 6);
waves;
setmode($03);
writeln('SiNUS iNTRO ][ CODED BY Z00NE/MARCHERSOFT');
writeln(round((frame*18.2)/t2),' fps.');
virtdn;
end;
begin
main;
end.
{ ------------------ SIN3 ---------------------- }
{$g+}
uses
crt,gru;
const
add1=1;
add2=-1;
add3=-1;
var
ptab,ctab:array[0..319] of byte;
stab1,stab2,stab3:array[0..255] of byte;
i,i1,i2,i3:word;
workp:pointer;
work:word;
timer:longint absolute $0040:$006c;
frame,t1,t2:longint;
procedure virtup;
begin
getmem(workp,64000);
work:=seg(workp^);
end;
procedure virtdn;
begin
work:=0;
freemem(workp,64000);
end;
procedure init;
begin
virtup;
frame:=0;
for i:=0 to 255 do begin
stab1[i]:=round(sin(i*2*pi/255)*50)+109;
stab2[i]:=round(cos(i*4*pi/255)*25);
stab3[i]:=round(sin(i*4*pi/255)*25);
end;
fillchar(ctab,sizeof(ctab),0);
i1:=0; i2:=25; i3:=100;
end;
procedure waves;
var x,y:word;
begin
t1:=timer;
repeat
move(ctab,ptab,sizeof(ctab));
for i:=0 to 319 do
begin
ctab[i]:=stab1[(i+i1) mod 255]+stab2[(i+i2) mod 255]+stab3[(i+i3) mod 255];
vline2(i,0,ctab[i],work,ctab[i]);
vline2(i,ctab[i],200,work,not (ctab[i]+40));
smooth1(i-1,ctab[i]-1,work);
smooth1(i-1,ctab[i],work);
smooth1(i-1,ctab[i]-1,work);
smooth1(i+1,ctab[i]+1,work);
smooth1(i+1,ctab[i],work);
smooth1(i,ctab[i]+1,work);
smooth1(i-1,ctab[i]+1,work);
smooth1(i+1,ctab[i]-1,work);
smooth1(i,ctab[i],work);
end;
i1:=(i1+add1) mod 255; i2:=(i2+add2) mod 255; i3:=(i3+add3) mod 255;
flip386(work,vidseg);
inc(frame);
until(keypressed)and(readkey=#27);
t2:=(timer-t1);
end;
procedure main;
begin
init;
setmode($13);
for i:=1 to 199 do setpal(i,i div 4,20+i div 5,10+i div 6);
waves;
setmode($03);
writeln('SiNUS iNTRO ]I[ CODED BY Z00NE/MARCHERSOFT');
writeln(round((frame*18.2)/t2),' fps.');
virtdn;
end;
begin
main;
end.
{ ------------------------ SIN 4 -------------------- }
{$g+,r-,x-,o-,s-,q-,d-,l-,y-,a+,e-,n-,p-,t-,v-,y-}
uses
crt,gru;
const
add1=1;
add2=-1;
add3=-1;
sofs=75;
samp=75;
slen=255;
sprpic:array[0..15,0..15]of byte=(
(0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0),
(0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0),
(0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0),
(0,0,1,1,1,1,1,2,2,1,1,1,1,1,0,0),
(0,1,1,1,1,1,2,2,2,2,1,1,1,1,1,0),
(0,1,1,1,1,2,2,3,3,2,2,1,1,1,1,0),
(1,1,1,1,2,2,3,3,3,3,2,2,1,1,1,1),
(1,1,1,1,2,2,3,4,4,3,2,2,1,1,1,1),
(1,1,1,1,2,2,3,3,3,3,2,2,1,1,1,1),
(0,1,1,1,1,2,2,3,3,2,2,1,1,1,1,0),
(0,1,1,1,1,1,2,2,2,2,1,1,1,1,1,0),
(0,0,1,1,1,1,1,2,2,1,1,1,1,1,0,0),
(0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0),
(0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0),
(0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0),
(0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0));
type
sinarray=array[0..slen]of word;
var
stab:sinarray; { Used to move shade bob. }
ptab,ctab:array[0..319] of byte;
stab1,stab2,stab3:array[0..255] of byte;
i,i1,i2,i3:word;
workp:pointer;
work:word;
timer:longint absolute $0040:$006c;
frame,t1,t2:longint;
procedure virtup;
begin
getmem(workp,64000);
work:=seg(workp^);
end;
procedure virtdn;
begin
work:=0;
freemem(workp,64000);
end;
procedure init;
begin
virtup;
for i:=0 to slen do stab[i]:=round(sin(i*4*pi/slen)*samp)+sofs;
for i:=0 to 255 do
begin
stab1[i]:=round(sin(i*2*pi/255)*50)+109;
stab2[i]:=round(cos(i*4*pi/255)*25);
stab3[i]:=round(sin(i*4*pi/255)*25);
end;
fillchar(ctab,sizeof(ctab),0);
i1:=0; i2:=25; i3:=100;
end;
procedure waves;
var
c,x,y:word;
i,j:byte;
begin
t1:=timer;
i:=0;
j:=25;
c:=0;
clear386(work,0);
repeat
if(c>4)then
begin
c:=0;
smooth(work);
line2(160,100,x,y,work,i);
end;
x:=2*stab[i];
y:=stab[j];
inc(i);
inc(j);
drawsprite(x,y,work,16,16,0,sprpic);
line2(0,0,319,0,work,0);
line2(0,0,0,199,work,0);
line2(0,199,319,199,work,0);
line2(319,199,319,0,work,0);
flip386(work,vidseg);
inc(c);
until(keypressed);
t2:=(timer-t1);
end;
procedure main;
begin
init;
setmode($13);
for i:=1 to 199 do setpal(i,i div 4,20+i div 5,10+i div 6);
waves;
setmode($03);
writeln('SiNUS iNTRO iV CODED BY Z00NE/MARCHERSOFT');
writeln(round((frame*18.2)/t2),' fps.');
virtdn;
end;
begin
main;
end.
{ ---------------------------- SIN 5 ---------------------- }
{$g+}
uses
crt,gru;
const
add1=1;
add2=-1;
add3=-1;
var
ptab,ctab:array[0..319] of byte;
stab1,stab2,stab3:array[0..255] of byte;
i,i1,i2,i3:word;
workp:pointer;
work:word;
timer:longint absolute $0040:$006c;
frame,t1,t2:longint;
procedure virtup;
begin
getmem(workp,64000);
work:=seg(workp^);
end;
procedure virtdn;
begin
work:=0;
freemem(workp,64000);
end;
procedure init;
begin
virtup;
frame:=0;
for i:=0 to 255 do
begin
stab1[i]:=round(sin(i*2*pi/255)*50)+109;
stab2[i]:=round(cos(i*4*pi/255)*25);
stab3[i]:=round(sin(i*4*pi/255)*25);
end;
fillchar(ctab,sizeof(ctab),0);
i1:=0; i2:=25; i3:=100;
end;
procedure waves;
var x,y:word;
begin
t1:=timer;
repeat
move(ctab,ptab,sizeof(ctab));
for i:=0 to 319 do
begin
ctab[i]:=stab1[(i+i1) mod 255]+stab2[(i+i2) mod 255]+stab3[(i+i3) mod 255];
vline2(i,0,200,work,ctab[i]);
vline2(i,ctab[i]-5,ctab[i]+5,work,not(ctab[i]+40));
end;
i1:=(i1+add1) mod 255; i2:=(i2+add2) mod 255; i3:=(i3+add3) mod 255;
flip386(work,vidseg);
inc(frame);
until(keypressed)and(readkey=#27);
t2:=(timer-t1);
end;
procedure main;
begin
init;
setmode($13);
for i:=1 to 199 do setpal(i,i div 4,20+i div 5,10+i div 6);
waves;
setmode($03);
writeln('SiNUS iNTRO V CODED BY Z00NE/MARCHERSOFT');
writeln(round((frame*18.2)/t2),' fps.');
virtdn;
end;
begin
main;
end.
{ --------------------- SIN 6 --------------------- }
{$g+,d-,l-,y-,n-,e-,r-,s-,q-,t-,v-,x-}
uses gru;
const
add1=1;
add2=-1;
add3=-1;
var
ptab,ctab:array[0..199] of byte;
stab1,stab2,stab3:array[0..255] of byte;
i,i1,i2,i3:word;
workp:pointer;
work:word;
timer:longint absolute $0040:$006c;
frame,t1,t2:longint;
function readkey:char; assembler;
asm
xor ah,ah
int 16h
end;
function keypressed:boolean; assembler;
asm
mov ah, 01h
int 16h
mov ax, 00h
jz @1
inc ax
@1:
end;
procedure virtup;
begin
getmem(workp,64000);
work:=seg(workp^);
end;
procedure virtdn;
begin
work:=0;
freemem(workp,64000);
end;
procedure init;
begin
virtup;
frame:=0;
for i:=0 to 255 do begin
stab1[i]:=round(sin(i*2*pi/255)*50)+160;
stab2[i]:=round(cos(i*4*pi/255)*25);
stab3[i]:=round(sin(i*4*pi/255)*25);
end;
fillchar(ctab,sizeof(ctab),0);
i1:=0; i2:=25; i3:=100;
end;
procedure waves;
var x,y:word;
begin
t1:=timer;
repeat
move(ctab,ptab,sizeof(ctab));
for i:=0 to 44 do
begin
ctab[i]:=stab1[(i+i1) mod 255]+stab2[(i+i2) mod 255]+stab3[(i+i3) mod 255];
hline2(0,ctab[i],i,work,ctab[i]-59);
hline2(ctab[i],320,i,work,not (ctab[i]-15));
end;
i1:=(i1+add1) mod 255; i2:=(i2+add2) mod 255; i3:=(i3+add3) mod 255;
for i:=0 to 2 do
smooth2(work,320*44);
flip386(work,vidseg);
inc(frame);
until(keypressed)and(readkey=#27);
t2:=(timer-t1);
end;
procedure main;
begin
init;
setmode($13);
scanlines(8);
for i:=1 to 199 do setpal(i,i div 4,20+i div 5,10+i div 6);
waves;
setmode($03);
writeln(round((frame*18.2)/t2),' fps.');
virtdn;
end;
begin
main;
end.
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]