mirror of
https://github.com/skoelle/dos-phobia-welcome-intro.git
synced 2026-09-17 20:50:24 +00:00
Add files via upload
initial commit
This commit is contained in:
Stefan Koelle
@@ -0,0 +1,431 @@
|
||||
{$A-,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
|
||||
{$M 16384,0,59360}
|
||||
uses crt,textgraf,pho_u,pho_u2;
|
||||
const rot:array[0..1] of integer=(1,0);
|
||||
VERSION='1.3';
|
||||
FADE_SPEED=10;
|
||||
TANZ=10;
|
||||
text:array[1..6*TANZ] of string[30]=('PRESENTS'
|
||||
,'WELCOME'
|
||||
,'---------------'
|
||||
,''
|
||||
,'PC INTRO BY'
|
||||
,'STEFAN KOELLE'
|
||||
,'[[[[[[[[[['
|
||||
,'[ PHOBIA ['
|
||||
,'[ 1994 ['
|
||||
,'[ """""" ['
|
||||
,'[ BY NST ['
|
||||
,'[[[[[[[[[['
|
||||
,''
|
||||
,'CREDITS'
|
||||
,'------'
|
||||
,'CODING BY'
|
||||
,'STEFAN'
|
||||
,''
|
||||
,''
|
||||
,'CREDITS'
|
||||
,'------'
|
||||
,'GFX BY'
|
||||
,'STEFAN'
|
||||
,''
|
||||
,''
|
||||
,'CREDITS'
|
||||
,'------'
|
||||
,'MUSIC'
|
||||
,'RIPPED'
|
||||
,''
|
||||
,''
|
||||
,'CREDITS'
|
||||
,'------'
|
||||
,'IDEA FROM AN'
|
||||
,'AMIGA DEMO'
|
||||
,''
|
||||
,''
|
||||
,'SPECIAL GREETINGS'
|
||||
,'----------------'
|
||||
,'MAD DOC'
|
||||
,'M T L'
|
||||
,''
|
||||
,''
|
||||
,'NORMAL GREETINGS'
|
||||
,'---------------'
|
||||
,'SATAN CLAUS'
|
||||
,'MAJ-SOFT'
|
||||
,''
|
||||
,''
|
||||
,'INFO'
|
||||
,'-------'
|
||||
,'CODED 1994'
|
||||
,'ON 486 DX50'
|
||||
,''
|
||||
,''
|
||||
,'BYE BYE'
|
||||
,'------'
|
||||
,'PRESS ANY'
|
||||
,'KEY'
|
||||
,'');
|
||||
var
|
||||
dev,mix,stat,pro,loop : integer;
|
||||
md : string;
|
||||
i,txtz,txti,j,x,y,k:integer;
|
||||
r,ri:real;
|
||||
rb:boolean;
|
||||
w:word;
|
||||
p:vgacolors;
|
||||
l:vgacolors;
|
||||
cyc:array[0..2] of byte;
|
||||
cy2:array[0..2,1..10] of byte;
|
||||
s:string;
|
||||
ch:char;
|
||||
font : array[1..57,0..15,0..17] of byte;
|
||||
{$L MOD-obj.OBJ} { Link in Object file }
|
||||
{$F+} { force calls to be 'far'}
|
||||
procedure modvolume(v1,v2,v3,v4:integer); external ; {Can do while playing}
|
||||
procedure moddevice(var device:integer); external ;
|
||||
procedure modsetup(var status:integer;device,mixspeed,pro,loop:integer;var str:string); external ;
|
||||
procedure modstop; external ;
|
||||
procedure modinit; external;
|
||||
{$F-}
|
||||
procedure ch_pal;
|
||||
var x,y,i,j:integer;
|
||||
begin
|
||||
inc(k);
|
||||
if k=3 then begin
|
||||
k:=0;
|
||||
for i:=0 to 2 do cyc[i]:=p[94,i];
|
||||
for j:=93 downto 80 do
|
||||
for i:=0 to 2 do p[j+1,i]:=p[j,i];
|
||||
for i:=0 to 2 do p[80,i]:=cyc[i];
|
||||
end;
|
||||
for y:=0 to 1 do
|
||||
for x:=1 to 5 do
|
||||
for i:=0 to 2 do cy2[i,x+y*5]:=p[16+x-1+y*25+20,i];
|
||||
for y:=0 to 1 do
|
||||
for x:=1 to 5 do
|
||||
for j:=1 to 4 do
|
||||
for i:=0 to 2 do p[35+x+y*25-j*5+5,i]:=p[35+x+y*25-j*5,i];
|
||||
for y:=0 to 1 do
|
||||
for x:=1 to 5 do
|
||||
for i:=0 to 2 do p[16+x-1+y*25,i]:=cy2[i,(x+rot[y]*5)];
|
||||
ri:=ri+1;
|
||||
if ri>372 then ri:=ri-372;
|
||||
if sin(ri*6.3)*15<0 then begin
|
||||
r:=r-sin(ri*6.3)*15;
|
||||
rb:=FALSE;
|
||||
end else begin
|
||||
r:=r+sin(ri*6.3)*15;
|
||||
rb:=TRUE;
|
||||
end;
|
||||
if r>20 then begin
|
||||
r:=r-20;
|
||||
if rb then begin
|
||||
for y:=0 to 1 do
|
||||
for x:=1 to 5 do
|
||||
for i:=0 to 2 do cy2[i,x+y*5]:=p[20+(x-1)*5+y*25,i];
|
||||
for y:=0 to 1 do
|
||||
for j:=1 to 4 do
|
||||
for x:=1 to 5 do
|
||||
for i:=0 to 2 do p[20+(x-1)*5+y*25-j+1,i]:=p[20+(x-1)*5+y*25-j,i];
|
||||
for y:=0 to 1 do
|
||||
for x:=1 to 5 do
|
||||
for i:=0 to 2 do p[20+(x-1)*5+y*25-4,i]:=cy2[i,x+rot[y]*5];
|
||||
end else begin
|
||||
for y:=0 to 1 do
|
||||
for x:=1 to 5 do
|
||||
for i:=0 to 2 do cy2[i,x+y*5]:=p[16+(x-1)*5+y*25,i];
|
||||
for y:=0 to 1 do
|
||||
for j:=1 to 4 do
|
||||
for x:=1 to 5 do
|
||||
for i:=0 to 2 do p[16+(x-1)*5+y*25+j-1,i]:=p[16+(x-1)*5+y*25+j,i];
|
||||
for y:=0 to 1 do
|
||||
for x:=1 to 5 do
|
||||
for i:=0 to 2 do p[20+(x-1)*5+y*25,i]:=cy2[i,x+rot[y]*5];
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
procedure writeline(wly : integer; wls : string);
|
||||
var i,x,y,num,wlx:integer;
|
||||
begin
|
||||
wlx:=160-length(wls)*9+14;
|
||||
for i:=1 to length(wls) do
|
||||
for x:=0 to 15 do for y:=0 to 17 do begin
|
||||
if wls[i]<>' ' then begin
|
||||
case wls[i] of
|
||||
'A'..'Z':num:=ord(wls[i])-64;
|
||||
'0'..'9':num:=ord(wls[i])-19;
|
||||
'*':num:=39;
|
||||
'"':num:=40;
|
||||
'!':num:=41;
|
||||
'$':num:=42;
|
||||
':':num:=43;
|
||||
'.':num:=44;
|
||||
',':num:=45;
|
||||
'\':num:=46;
|
||||
'?':num:=47;
|
||||
'-':num:=48;
|
||||
'+':num:=49;
|
||||
'=':num:=50;
|
||||
'[':num:=51;
|
||||
']':num:=52;
|
||||
'%':num:=53;
|
||||
'(':num:=54;
|
||||
')':num:=55;
|
||||
end;
|
||||
if font[num,x,y]<>0 then mem[$A000:(wly+y)*word(320)+wlx+x+(i-1)*16]:=font[num,x,y];
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
procedure writeback(wly : integer; wls : string);
|
||||
var i,x,y,num,wlx:integer;
|
||||
begin
|
||||
wlx:=160-length(wls)*9+14;
|
||||
for i:=1 to length(wls) do
|
||||
for x:=0 to 15 do for y:=0 to 17 do begin
|
||||
if wls[i]<>' ' then begin
|
||||
case wls[i] of
|
||||
'A'..'Z':num:=ord(wls[i])-64;
|
||||
'0'..'9':num:=ord(wls[i])-19;
|
||||
'*':num:=39;
|
||||
'"':num:=40;
|
||||
'!':num:=41;
|
||||
'$':num:=42;
|
||||
':':num:=43;
|
||||
'.':num:=44;
|
||||
',':num:=45;
|
||||
'\':num:=46;
|
||||
'?':num:=47;
|
||||
'-':num:=48;
|
||||
'+':num:=49;
|
||||
'=':num:=50;
|
||||
'[':num:=51;
|
||||
']':num:=52;
|
||||
'%':num:=53;
|
||||
'(':num:=54;
|
||||
')':num:=55;
|
||||
end;
|
||||
if (font[num,x,y]<>0) then mem[$A000:(wly+y)*word(320)+wlx+x+(i-1)*16]
|
||||
:=mem[seg(phopic):ofs(phopic)+(wly+y)*word(320)+wlx+x+(i-1)*16];
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
procedure CLI; inline( $FA ); { Interrupts unterdr�cken }
|
||||
procedure STI; inline( $FB ); { Interrupts wieder erlauben }
|
||||
begin
|
||||
CLI;
|
||||
modinit;
|
||||
clrscr;
|
||||
writeln('PHOBA Intro');
|
||||
writeln('------------');
|
||||
writeln;
|
||||
writeln('F1 -PC Speaker (10000 kHz)');
|
||||
writeln('F2 -PC Speaker (20000 kHz)');
|
||||
writeln('F3 -SoundBlaster (10000 kHz)');
|
||||
writeln('F4 -SoundBlaster (20000 kHz)');
|
||||
writeln('F5 -D/A Wandler (10000 kHz)');
|
||||
writeln('F6 -D/A Wandler (20000 kHz)');
|
||||
writeln('F7 -Disney Source (10000 kHz)');
|
||||
writeln('F8 -Disney Source (20000 kHz)');
|
||||
writeln('F9 -PC Speaker (????? kHz)');
|
||||
writeln('F10-SoundBlaster (????? kHz)');
|
||||
writeln('ESC-No Sound');
|
||||
writeln;
|
||||
writeln('Press F1-F10 or ESC...');
|
||||
i:=1;
|
||||
repeat
|
||||
ch:=readkey;
|
||||
if ch=#27 then begin
|
||||
i:=0;
|
||||
dev:=255;
|
||||
end;
|
||||
if ch='+' then begin
|
||||
clrscr;
|
||||
writeln('Intro by: Stefan Koelle of Phobia * Version '+VERSION);
|
||||
writeln('Intro skipped !!!');
|
||||
STI;
|
||||
halt(1);
|
||||
end;
|
||||
if ch=#0 then begin
|
||||
ch:=readkey;
|
||||
if (ord(ch)>58) and (ord(ch)<69) then i:=0;
|
||||
end;
|
||||
until i=0;
|
||||
case ord(ch) of
|
||||
59:begin
|
||||
dev := 0;
|
||||
mix := 10000;
|
||||
end;
|
||||
60:begin
|
||||
dev := 0;
|
||||
mix := 20000;
|
||||
end;
|
||||
61:begin
|
||||
dev := 7;
|
||||
mix := 10000;
|
||||
end;
|
||||
62:begin
|
||||
dev := 7;
|
||||
mix := 20000;
|
||||
end;
|
||||
63:begin
|
||||
dev := 1;
|
||||
mix := 10000;
|
||||
end;
|
||||
64:begin
|
||||
dev := 1;
|
||||
mix := 20000;
|
||||
end;
|
||||
65:begin
|
||||
dev := 11;
|
||||
mix := 10000;
|
||||
end;
|
||||
66:begin
|
||||
dev := 11;
|
||||
mix := 20000;
|
||||
end;
|
||||
67:begin
|
||||
dev := 0;
|
||||
writeln;
|
||||
write('Enter Sample-Frequence (<=44000 kHz): ');
|
||||
readln(mix);
|
||||
end;
|
||||
68:begin
|
||||
dev := 7;
|
||||
writeln;
|
||||
write('Enter Sample-Frequence (<=20000 kHz): ');
|
||||
readln(mix);
|
||||
end;
|
||||
end;
|
||||
if (dev<>255) then begin
|
||||
if paramcount=1 then begin
|
||||
md:=paramstr(1);
|
||||
end else begin
|
||||
md:='pho.rsc';
|
||||
end;
|
||||
pro := 0; {Leave at 0}
|
||||
loop :=4; {4 means mod will play forever}
|
||||
modvolume (255,255,255,255); { Full volume }
|
||||
end;
|
||||
case InitTextGraf of
|
||||
1: begin end;
|
||||
end;
|
||||
GrafikMode($13);
|
||||
for w:=0 to 63999 do mem[$A000:w]:=0;
|
||||
for i:=0 to 255 do for j:=0 to 2 do
|
||||
l[i,j]:=0;
|
||||
setvgacolors(l);
|
||||
for w:=0 to 63999 do mem[$A000:w]:=mem[seg(phofnt):ofs(phofnt)+w];
|
||||
for j:=0 to 1 do for i:=0 to 18 do
|
||||
for x:=0 to 15 do for y:=0 to 17 do
|
||||
font[i+j*19+1,x,y]:=mem[$A000:(y+j*18+1)*word(320) + x+i*16];
|
||||
j:=2; for i:=0 to 18 do
|
||||
for x:=0 to 15 do for y:=0 to 17 do
|
||||
font[i+j*19+1,x,y]:=mem[$A000:(y+j*18+2)*word(320) + x+i*16];
|
||||
for w:=0 to 63999 do mem[$A000:w]:=mem[seg(phopic):ofs(phopic)+w];
|
||||
for i:=1 to 6 do
|
||||
writeline(53+i*20,text[i]);
|
||||
|
||||
move(mem[seg(phopal):ofs(phopal)],p,sizeof(p));
|
||||
k:=0;ri:=0;r:=0;
|
||||
for x:=(40 div FADE_SPEED) downto 0 do begin
|
||||
ch_pal;
|
||||
for i:=0 to 255 do for j:=0 to 2 do begin
|
||||
l[i,j]:=p[i,j]-x*FADE_SPEED;
|
||||
if l[i,j]>p[i,j] then l[i,j]:=0;
|
||||
end;
|
||||
repeat until port[$3da] and 8 = 8;
|
||||
setvgacolors(l);
|
||||
end;
|
||||
ch:='@';
|
||||
txtz:=0;txti:=0;
|
||||
if (dev<>255) then modsetup ( stat, dev, mix, pro, loop, md );
|
||||
STI;
|
||||
repeat
|
||||
inc(txtz);
|
||||
if txtz>150 then begin
|
||||
txtz:=0;
|
||||
j:=txti;
|
||||
inc(txti);
|
||||
if txti=TANZ then txti:=0;
|
||||
for i:=1 to 6 do begin
|
||||
ch_pal;
|
||||
setvgacolors(p);
|
||||
writeback(53+i*20,text[i+j*6]);
|
||||
ch_pal;
|
||||
setvgacolors(p);
|
||||
writeline(53+i*20,text[i+txti*6]);
|
||||
end;
|
||||
end;
|
||||
inc(k);
|
||||
if k=3 then begin
|
||||
k:=0;
|
||||
for i:=0 to 2 do cyc[i]:=p[94,i];
|
||||
for j:=93 downto 80 do
|
||||
for i:=0 to 2 do p[j+1,i]:=p[j,i];
|
||||
for i:=0 to 2 do p[80,i]:=cyc[i];
|
||||
end;
|
||||
for y:=0 to 1 do
|
||||
for x:=1 to 5 do
|
||||
for i:=0 to 2 do cy2[i,x+y*5]:=p[16+x-1+y*25+20,i];
|
||||
for y:=0 to 1 do
|
||||
for x:=1 to 5 do
|
||||
for j:=1 to 4 do
|
||||
for i:=0 to 2 do p[35+x+y*25-j*5+5,i]:=p[35+x+y*25-j*5,i];
|
||||
for y:=0 to 1 do
|
||||
for x:=1 to 5 do
|
||||
for i:=0 to 2 do p[16+x-1+y*25,i]:=cy2[i,(x+rot[y]*5)];
|
||||
ri:=ri+1;
|
||||
if ri>372 then ri:=ri-372;
|
||||
if sin(ri*6.3)*15<0 then begin
|
||||
r:=r-sin(ri*6.3)*15;
|
||||
rb:=FALSE;
|
||||
end else begin
|
||||
r:=r+sin(ri*6.3)*15;
|
||||
rb:=TRUE;
|
||||
end;
|
||||
if r>20 then begin
|
||||
r:=r-20;
|
||||
if rb then begin
|
||||
for y:=0 to 1 do
|
||||
for x:=1 to 5 do
|
||||
for i:=0 to 2 do cy2[i,x+y*5]:=p[20+(x-1)*5+y*25,i];
|
||||
for y:=0 to 1 do
|
||||
for j:=1 to 4 do
|
||||
for x:=1 to 5 do
|
||||
for i:=0 to 2 do p[20+(x-1)*5+y*25-j+1,i]:=p[20+(x-1)*5+y*25-j,i];
|
||||
for y:=0 to 1 do
|
||||
for x:=1 to 5 do
|
||||
for i:=0 to 2 do p[20+(x-1)*5+y*25-4,i]:=cy2[i,x+rot[y]*5];
|
||||
end else begin
|
||||
for y:=0 to 1 do
|
||||
for x:=1 to 5 do
|
||||
for i:=0 to 2 do cy2[i,x+y*5]:=p[16+(x-1)*5+y*25,i];
|
||||
for y:=0 to 1 do
|
||||
for j:=1 to 4 do
|
||||
for x:=1 to 5 do
|
||||
for i:=0 to 2 do p[16+(x-1)*5+y*25+j-1,i]:=p[16+(x-1)*5+y*25+j,i];
|
||||
for y:=0 to 1 do
|
||||
for x:=1 to 5 do
|
||||
for i:=0 to 2 do p[20+(x-1)*5+y*25,i]:=cy2[i,x+rot[y]*5];
|
||||
end;
|
||||
end;
|
||||
repeat until port[$3da] and 8 = 8;
|
||||
setvgacolors(p);
|
||||
until keypressed;
|
||||
ch:=readkey;
|
||||
CLI;
|
||||
if (dev<>255) then modstop;
|
||||
for x:=1 to (40 div FADE_SPEED) do begin
|
||||
ch_pal;
|
||||
for i:=0 to 255 do for j:=0 to 2 do begin
|
||||
if p[i,j]<FADE_SPEED then p[i,j]:=0 else dec(p[i,j],FADE_SPEED);
|
||||
end;
|
||||
repeat until port[$3da] and 8 = 8;
|
||||
setvgacolors(p);
|
||||
end;
|
||||
for w:=0 to 63999 do mem[$A000:w]:=0;
|
||||
TEXTMODE(co80);
|
||||
clrscr;
|
||||
writeln('Intro by: Stefan Koelle of Phobia * Version '+VERSION);
|
||||
STI;
|
||||
end.
|
||||
Reference in New Issue
Block a user