home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
BTH3SRC.ZIP
/
BTH3.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-02-04
|
34KB
|
1,014 lines
(*
__ $$m. ____ .mm. ______________ .m$$ _______________________________
~~ $$$$ ~~~~ $$$$ ~~~~~~~~~~~~~~ $$$$
$$$$$$$m. $$$$ .m$$$$$m$ .m$$$$$$$ .m$$$$$m.
$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ee$$$ Beyond The Horizon
$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$````` issue #3
$$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$$$ $$m. .
$$$$$$$$' $$$$ `$$$$$$$$ `$$$$$$$$ `$$$$$$$' : .
________________________________________________________|____:_______
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
coded by : shivan bastard (murray@jax.gulfnet.com) *)
{$M 16384,0,65360} {655360}
program Beyond_The_Horizon_Issue_3;
uses
crt,dos,
mse_tp, {for the music}
winttt5,
{ fliplay,}
ansi3;
{ fonts;}
var
percent,percent2:real;
min,n,max,count,i,q,x,y:integer;
marker,ch,fkey:char;
skip,found,done:boolean; {skip is auto-scroll,found is use,done is used}
tf,screen:text;
s,fn,title,author:string;
ray:array[1..500] of string[64];
yy:byte;
SoundCardName : String;
DMA, IRQ : Byte;
BaseIO : Word;
SampleRate : Word;
DMABuffer : Word;
Handle : File;
Header : GDMHeader;
EMSFlag : Word;
MusicChannels : Word;
ChannelCount : Word;
ExitProgram : Boolean;
sound:boolean; {background sound?}
{$I sound.pas}
{$I main.pas}
{$I main2.pas}
{$I reader.pas}
{$I end.pas}
{$L intro.obj}
procedure pushead;external;
procedure tc (i: integer); begin textcolor (i);end;
procedure tb (i: integer); begin textbackground (i);end;
procedure nl; begin writeln;end;
procedure d;
begin
delay(100);gotoxy(31,24);
end;
procedure waitretrace;assembler; {wait for next vertical retrace}
asm
mov dx,$3DA
@V1: in al,dx; test al,8; jz @v1;
@V2: in al,dx; test al,8; jnz @v2;
end;
type
rgb = record r, g, b : byte; end;
paltype = array[0..255]of rgb;
var
j : integer;
pal : paltype;
procedure get_color(var pal : paltype); {save palette}
var
j : integer;
begin
port[$3C7] := $00;
for j:= 0 to 255 do begin
pal[j].r := port[$3C9];
pal[j].g := port[$3C9];
pal[j].b := port[$3C9];
end;
end;
procedure set_intensity(intensity : byte);
var
j : integer;
begin
port[$3C8] := $00;
for j := 0 to 255 do begin
port[$3C9] := pal[j].r*intensity div 63;
port[$3C9] := pal[j].g*intensity div 63;
port[$3C9] := pal[j].b*intensity div 63;
end;
end;
procedure set_to_color(r,g,b,h: integer);
var
j : integer;
begin
port[$3C8] := $00;
for j := 0 to 255 do begin
port[$3C9] := pal[j].r+(r-pal[j].r)*h div 63;
port[$3C9] := pal[j].g+(g-pal[j].g)*h div 63;
port[$3C9] := pal[j].b+(b-pal[j].b)*h div 63;
end;
end;
procedure fade_out(t : integer); {fades from pal to black}
begin
for j := 63 downto 0 do begin waitretrace; set_intensity(j); delay(t); end;
end;
procedure fade_in(t : integer); {fades from black to pal}
begin
for j := 0 to 63 do begin waitretrace; set_intensity(j); delay(t); end;
end;
procedure flash_in(r,b,g: byte;t : integer); {fades from pal to color}
begin
for j := 0 to 63 do begin waitretrace; set_to_color(r,b,g,j); delay(t); end;
end;
procedure flash_out(r,g,b: byte;t : integer); {fades from color to pal}
begin
for j := 63 downto 0 do begin waitretrace;set_to_color(r,g,b,j);delay(t);end;
end;
procedure introansi;
begin
y:=0;
for i:=1 to 47 do begin
move (@pushead^,memw[$b800:y*160],11654); {move-source,destination,size}
move(memw[$b800:160],memw[$b800:0],11654);
dec(y);
delay(3);
end;
ch:=readkey;
sliderestorescreen(1,up);disposescreen(1);
end;
procedure drawmain;
begin
tc(8);
gotoxy(2,2);write(' Introduction ');
gotoxy(2,3);write(' Articles ');
gotoxy(2,4);write(' Interviews ');
gotoxy(2,5);write(' Pack Reviews ');
gotoxy(2,6);write(' WWW Reviews ');
gotoxy(2,7);write(' BBS Reviews ');
gotoxy(2,8);write('Program Reviews ');
gotoxy(2,9);write(' Best ANSIs ');tb(0);
end;
procedure showmain;
begin
tc (11);
if y=2 then begin gotoxy(2,y);write(' Introduction');end;
if y=3 then begin gotoxy(2,y);write(' Articles ');end;
if y=4 then begin gotoxy(2,y);write(' Interviews ');end;
if y=5 then begin gotoxy(2,y);write(' Pack Reviews');end;
if y=6 then begin gotoxy(2,y);write(' WWW Reviews ');end;
if y=7 then begin gotoxy(2,y);write(' BBS Reviews ');end;
if y=8 then begin gotoxy(2,y);write('Program Reviews');end;
if y=9 then begin gotoxy(2,y);write(' Best ANSIs ');end;tb(0);
end;
procedure drawintro;
begin
tc(8);
gotoxy(52,7);write(' Introduction to Issue #3');
gotoxy(52,8);write(' Programmers Notes');
gotoxy(52,9);write(' February Contributors');
gotoxy(52,10);write(' Contacting the BTH staff ');tb(0);
end;
procedure showintro;
begin
tc (11);
if y=7 then begin gotoxy(52,y);write(' Introduction to Issue #3');end;
if y=8 then begin gotoxy(52,y);write(' Programmers Notes');end;
if y=9 then begin gotoxy(52,y);write(' February Contributors');end;
if y=10 then begin gotoxy(52,y);write(' Contacting the BTH staff');end;tb(0);
end;
procedure drawarticles;
begin
tc(8);
gotoxy(52,5);write(' Pushead on Blade');
gotoxy(52,6);write(' Infiniti Productions ');
gotoxy(52,7);write(' DE''s Farewell letter ');
gotoxy(52,8);write(' Internet Security ');
gotoxy(52,9);write(' Art Payment? ');
gotoxy(52,10);write(' BTH Rumor Wall(tm) ');
gotoxy(52,11);write(' Emag Reviews ');
gotoxy(52,12);write(' History of Forum Hacks');
gotoxy(52,13);write(' Live with it ');tb(0);
end;
procedure showarticles;
begin
tc (11);
if y=5 then begin gotoxy(52,y);write(' Pushead on Blade');end;
if y=6 then begin gotoxy(52,y);write(' Infiniti Productions');end;
if y=7 then begin gotoxy(52,y);write(' DE''s farewell letter');end;
if y=8 then begin gotoxy(52,y);write(' Internet Security');end;
if y=9 then begin gotoxy(52,y);write(' Art Payment?');end;
if y=10 then begin gotoxy(52,y);write(' BTH Rumor Wall(tm)');end;
if y=11 then begin gotoxy(52,y);write(' Emag Reviews');end;
if y=12 then begin gotoxy(52,y);write(' History of Forum Hacks');end;
if y=13 then begin gotoxy(52,y);write(' Live with it');end;tb(0);
end;
procedure drawinterview;
begin
tc(8);
gotoxy(48,7);write(' Interview with Darkened Enmity ');
gotoxy(48,8);write(' Interview with Somms ');
gotoxy(48,9);write(' Interview with Nootropic ');tb(0);
end;
procedure showinterview;
begin
tc (11);
if y=7 then begin gotoxy(48,y);write(' Interview with Darkened Enmity ');end;
if y=8 then begin gotoxy(48,y);write(' Interview with Somms');end;
if y=9 then begin gotoxy(48,y);write(' Interview with Nootropic');end;tb(0);
end;
procedure drawreview;
begin
tc(8);
gotoxy(48,7);write(' ACiD - January ''96 (acdu0196)');
gotoxy(48,8);write(' iCE - December ''95 (ice1295?)');
gotoxy(48,9);write('Legend - December ''95 (legend05)');
gotoxy(48,10);write(' Fire - February ''96 (fire0296)');
gotoxy(48,11);write(' Mop - February ''96 (mop9602)');
gotoxy(48,12);write('Legend - February ''96 (legend06)');
tb(0);
end;
procedure showreview;
begin
tc (11);
if y=7 then begin gotoxy(48,y);write(' ACiD - January ''96 (acdu0196)');end;
if y=8 then begin gotoxy(48,y);write(' iCE - December ''95 (ice1295?)');end;
if y=9 then begin gotoxy(48,y);write('Legend - December ''95 (legend05)');end;
if y=10 then begin gotoxy(48,y);write(' Fire - February ''96 (fire0296)');end;
if y=11 then begin gotoxy(48,y);write(' Mop - February ''96 (mop9602)');end;
if y=12 then begin gotoxy(48,y);write('Legend - February ''96 (legend06)');end;
tb(0);
end;
procedure drawpics;
begin
tc (8);
gotoxy(50,6);write('#1 Somms - The Regency ');
gotoxy(50,7);write('#2 Neurotic - Biohazard');
gotoxy(50,8);write('#3 SG+SA - The Realm of Magic');
gotoxy(50,9);write('#4 Cold & Ugly - Splat');
gotoxy(50,10);write('#5 Tremor - Parasite');tb(0);
end;
procedure showpics;
begin
tc(11);
if y=6 then begin gotoxy(50,y);write('#1 Somms - The Regency ');end;
if y=7 then begin gotoxy(50,y);write('#2 Neurotic - Biohazard ');end;
if y=8 then begin gotoxy(50,y);write('#3 SG+SA - The Realm of Magic');end;
if y=9 then begin gotoxy(50,y);write('#4 Cold & Ugly - Splat ');end;
if y=10 then begin gotoxy(50,y);write('#5 Tremor - Parasite ');end;tb(0);
end;
Procedure ansiscroll;
begin
directvideo := false;
Assign(screen, '');append(screen);clrscr;found:=false;
reset(tf);
repeat
begin readln(tf,s);if s=fn then found:=true;end;
until found;
read(tf,ch);
repeat
begin
write(screen,ch);read(tf,ch);
end;
until ch=marker;
gotoxy(30,24);tc(1);write('[ ]');gotoxy(31,24);tc(15);
close(tf);
repeat
write(' Expand Your Horizons ');d;
write('Expand Your Horizons ');d;
write('xpand Your Horizons E');d;
write('pand Your Horizons Ex');d;
write('and Your Horizons Exp');d;
write('nd Your Horizons Expa');d;
write('d Your Horizons Expan');d;
write(' Your Horizons Expand');d;
write('Your Horizons Expand ');D;
write('our Horizons Expand Y');d;
write('ur Horizons Expand Yo');d;
write('r Horizons Expand You');d;
write(' Horizons Expand Your');d;
write('Horizons Expand Your ');d;
write('orizons Expand Your H');d;
write('rizons Expand Your Ho');d;
write('izons Expand Your Hor');d;
write('zons Expand Your Hori');d;
write('ons Expand Your Horiz');d;
write('ns Expand Your Horizo');d;
write('s Expand Your Horizon');d;
write(' Expand Your Horizons');d;
until keypressed;memw[$0000:$041a]:=memw[$0000:$041c];
sliderestorescreen(1,up);disposescreen(1);
end;
procedure wait;assembler; {wait for next vertical retrace}
asm
mov dx,$3DA
@V1: in al,dx; test al,8; jz @v1;
@V2: in al,dx; test al,8; jnz @v2;
end;
Procedure scroller;
procedure clear;
begin
for i:=1 to 500 do
ray[i]:=' ';
end;
procedure scroll;
begin
if q<1 then q:=1;
x:=9;y:=6;tb(1);tc(15);
for i:=1 to 15 do
begin
gotoxy(x,y);write(' ');
gotoxy(x,y);writeln(ray[q]);y:=y+1;q:=q+1;
end;
tc(15);tb(7);gotoxy(65,23);write('[',q,'/',max,'] ');
tb(0);tc(15);tb(1);
percent:=100 * (q / max);
percent2:=percent/(100/7);
{* alright this is the messiest part of my code. all this does is
make a scroll bar on the side, its not very efficient, but it works
could've probably made some weird complicated loop, but chose instead to
go with the cut n' paste method heh. =) *}
if percent2 > 0 then begin if percent2 <2 then begin
tc(15);tb(1);gotoxy(77,10);write('▓');
gotoxy(77,11);tc(1);tb(7);write('▓');
gotoxy(77,12);tc(1);tb(7);write('▓');
gotoxy(77,13);tc(1);tb(7);write('▓');
gotoxy(77,14);tc(1);tb(7);write('▓');
gotoxy(77,15);tc(1);tb(7);write('▓');
gotoxy(77,16);tc(1);tb(7);write('▓');end;end;
if percent2 > 2 then begin if percent2 <3 then begin
tc(15);tb(1);gotoxy(77,11);write('▓');
gotoxy(77,10);tc(1);tb(7);write('▓');
gotoxy(77,12);tc(1);tb(7);write('▓');
gotoxy(77,13);tc(1);tb(7);write('▓');
gotoxy(77,14);tc(1);tb(7);write('▓');
gotoxy(77,15);tc(1);tb(7);write('▓');
gotoxy(77,16);tc(1);tb(7);write('▓');end;end;
if percent2 > 3 then begin if percent2 < 4 then begin
tc(15);tb(1);gotoxy(77,12);write('▓');
gotoxy(77,10);tc(1);tb(7);write('▓');
gotoxy(77,11);tc(1);tb(7);write('▓');
gotoxy(77,13);tc(1);tb(7);write('▓');
gotoxy(77,14);tc(1);tb(7);write('▓');
gotoxy(77,15);tc(1);tb(7);write('▓');
gotoxy(77,16);tc(1);tb(7);write('▓');end;end;
if percent2 > 4 then begin if percent2<5 then begin
tc(15);tb(1);gotoxy(77,13);write('▓');
gotoxy(77,10);tc(1);tb(7);write('▓');
gotoxy(77,11);tc(1);tb(7);write('▓');
gotoxy(77,12);tc(1);tb(7);write('▓');
gotoxy(77,14);tc(1);tb(7);write('▓');
gotoxy(77,15);tc(1);tb(7);write('▓');
gotoxy(77,16);tc(1);tb(7);write('▓');end;end;
if percent2 > 5 then begin if percent2<6 then begin
tc(15);tb(1);gotoxy(77,14);write('▓');
gotoxy(77,10);tc(1);tb(7);write('▓');
gotoxy(77,11);tc(1);tb(7);write('▓');
gotoxy(77,12);tc(1);tb(7);write('▓');
gotoxy(77,13);tc(1);tb(7);write('▓');
gotoxy(77,15);tc(1);tb(7);write('▓');
gotoxy(77,16);tc(1);tb(7);write('▓');end;end;
if percent2 > 6 then begin if percent2<7 then begin
tc(15);tb(1);gotoxy(77,15);write('▓');
gotoxy(77,10);tc(1);tb(7);write('▓');
gotoxy(77,11);tc(1);tb(7);write('▓');
gotoxy(77,12);tc(1);tb(7);write('▓');
gotoxy(77,13);tc(1);tb(7);write('▓');
gotoxy(77,14);tc(1);tb(7);write('▓');
gotoxy(77,16);tc(1);tb(7);write('▓');end;end;
if percent2 >= 7 then begin tc(15);tb(1);gotoxy(77,16);write('▓');
gotoxy(77,10);tc(1);tb(7);write('▓');
gotoxy(77,11);tc(1);tb(7);write('▓');
gotoxy(77,12);tc(1);tb(7);write('▓');
gotoxy(77,13);tc(1);tb(7);write('▓');
gotoxy(77,14);tc(1);tb(7);write('▓');
gotoxy(77,15);tc(1);tb(7);write('▓');end;
tb(0);
end;
begin
fade_out(20);readeransi;fade_in(1);Flash_Out(100,16,32,20);
tb(7);tc(0);gotoxy(12,2);write(title);gotoxy(12,3);write(author);tb(0);tc(15);
done:=false;
reset(tf);
repeat
readln(tf,s);
until s=fn;
readln(tf,max);
for i:=1 to max do readln(tf,ray[i]);
close(tf);max:=max+2;if max<16 then max:=16;
q:=1;scroll;
repeat
while not keypressed do begin
{ if b2 > 0 then begin write(b2);b2:=b2-2;g2:=g2+2;wait;pal2(1);end;
if g2 > 0 then begin g2:=g2-1;b2:=b2+1;wait;pal2(1);end;}
end;
ch:=upcase(readkey);
if max > 16 then begin
(* down scroll *)
if ((ch=#80) and (q<max)) then
begin
q:=q-14;scroll;
end;
(* up scroll *)
if ch=#72 then
begin
q:=q-16;scroll;
end;
(* page down *)
if ((ch=#81) and ((q+14)<max)) then
begin
scroll;
end;
(* page up *)
if ch=#73 then
begin
q:=q-30;scroll;
end;
(* home key *)
if ch=#71 then
begin
tc(1);tb(7);for n:=11 to 16 do begin
gotoxy(77,n);write('▓');end;
q:=1;scroll;
end;
(* end key *)
if ch=#79 then
begin
tc(1);tb(7);for n:=10 to 15 do begin
gotoxy(77,n);write('▓');end;
q:=max-15;scroll;
end;
end;
(* exit reader *)
if ch=#27 then done:=true;
until done;
done:=false;
clear;
sliderestorescreen(1,up);disposescreen(1);
end;
procedure introduction;
begin
mainansi2;
drawintro;showintro;count:=1;
repeat
if keypressed=true then begin ch := upcase (readkey);
(*=- when the hit [esc] -=*)
if ch = #27 then done := true;
if ch = #0 then begin ch := readkey;
(*=- Up arror/cursor crap -=*)
if ch = #72 then begin if wherey <> 7 then begin
dec (y);drawintro;showintro;end;end;
(*=- Down arror/cursor crap -=*)
if ch = #80 then begin if wherey <> 10 then begin
inc(y);drawintro;showintro;end;end;end;
(*=- when they hit enter -=*)
if ch = #13 then begin
if y=7 then begin savescreen(1);fn:='intro.bth';title:='BTH Issue #3 Introduction';author:='Mindcrime';
scroller;y:=7;drawintro;showintro;continue;end;
if y=8 then begin savescreen(1);fn:='notes.bth';title:='Programmers Notes';author:='shivan bastard';
scroller;y:=8;drawintro;showintro;continue;end;
if y=9 then begin savescreen(1);fn:='credits.bth';title:='BTH Credits';author:='BTH Staff';
scroller;y:=9;drawintro;showintro;continue;end;
if y=10 then begin savescreen(1);fn:='contact.bth';title:='How to contribute';author:='BTH Staff';
scroller;y:=10;drawintro;showintro;continue;end;
end;
end;
until done;tb (0);done:=false;mainansi;
end;
procedure articles;
begin
mainansi2;
drawarticles;showarticles;count:=1;
repeat
if keypressed=true then begin ch := upcase (readkey);
(*=- when the hit [esc] -=*)
if ch = #27 then done := true;
if ch = #0 then begin ch := readkey;
(*=- Up arror/cursor crap -=*)
if ch = #72 then begin if wherey <> 5 then begin
dec (y);drawarticles;showarticles;end;end;
(*=- Down arror/cursor crap -=*)
if ch = #80 then begin if wherey <> 13 then begin
inc(y);drawarticles;showarticles;end;end;end;
(*=- when they hit enter -=*)
if ch = #13 then begin
if y=5 then begin savescreen(1);fn:='article.1';title:='Pushead on Blade';author:='Pushead';
scroller;y:=5;drawarticles;showarticles;continue;end;
if y=6 then begin savescreen(1);fn:='article.2';title:='Infiniti Productions';author:='Pushead';
scroller;y:=6;drawarticles;showarticles;continue;end;
if y=7 then begin savescreen(1);fn:='article.3';title:='Farewell Letter';author:='Darkened Enmity';
scroller;y:=7;drawarticles;showarticles;continue;end;
if y=8 then begin savescreen(1);fn:='article.4';title:='The Internet';author:='Darklord';
scroller;y:=8;drawarticles;showarticles;continue;end;
if y=9 then begin savescreen(1);fn:='article.5';title:='Payment for Art';author:='Shivan Bastard';
scroller;y:=9;drawarticles;showarticles;continue;end;
if y=10 then begin savescreen(1);fn:='article.6';title:='Rumor Wall';author:='Shivan Bastard + MindCrime';
scroller;y:=10;drawarticles;showarticles;continue;end;
if y=11 then begin savescreen(1);fn:='article.7';title:='Electronic Magazines';author:='MindCrime';
scroller;y:=11;drawarticles;showarticles;continue;end;
if y=12 then begin savescreen(1);fn:='article.8';title:='History of Forum Hacks';author:='Meltdown';
scroller;y:=12;drawarticles;showarticles;continue;end;
if y=13 then begin savescreen(1);fn:='article.9';title:='Live with it!';author:='Bedlam';
scroller;y:=13;drawarticles;showarticles;continue;end;
end;end;
until done;tb (0);done:=false;mainansi;
end;
procedure interviews;
begin
MAINANSI2;
drawinterview;showinterview;count:=1;
repeat
if keypressed=true then begin ch := upcase (readkey);
(*=- when the hit [esc] -=*)
if ch = #27 then done := true;
if ch = #0 then begin ch := readkey;
(*=- Up arror/cursor crap -=*)
if ch = #72 then begin if wherey <> 7 then begin
dec (y);drawinterview;showinterview;end;end;
(*=- Down arror/cursor crap -=*)
if ch = #80 then begin if wherey <> 9 then begin
inc(y);drawinterview;showinterview;end;end;end;
(*=- when they hit enter -=*)
if ch = #13 then begin
if y=7 then begin savescreen(1);fn:='iv.1';title:='Interview with Darkened Enmity';author:='Shivan Bastard';
scroller;y:=7;drawinterview;showinterview;continue;end;
if y=8 then begin savescreen(1);fn:='iv.2';title:='Interview with Somms';author:='Shivan Bastard';
scroller;y:=8;drawinterview;showinterview;continue;end;
if y=9 then begin savescreen(1);fn:='iv.3';title:='Interview with Nootropic';author:='MindCrime';
scroller;y:=9;drawinterview;showinterview;continue;end;
end;end;
until done;tb (0);done:=false;mainansi;
end;
procedure reviews;
begin
mainansi2;
drawreview;showreview;count:=1;
repeat
if keypressed=true then begin ch := upcase (readkey);
(*=- when the hit [esc] -=*)
if ch = #27 then done := true;
if ch = #0 then begin ch := readkey;
(*=- Up arror/cursor crap -=*)
if ch = #72 then begin if wherey <> 7 then begin
dec (y);drawreview;showreview;end;end;
(*=- Down arror/cursor crap -=*)
if ch = #80 then begin if wherey <> 12 then begin
inc(y);drawreview;showreview;end;end;end;
(*=- when they hit enter -=*)
if ch = #13 then begin
if y=7 then begin savescreen(1);fn:='review.1';title:='ACiD 12/95';author:='MindCrime';
scroller;y:=7;drawreview;showreview;continue;end;
if y=8 then begin savescreen(1);fn:='review.2';title:='iCE 11/95';author:='Shivan Bastard';
scroller;y:=8;drawreview;showreview;continue;end;
if y=9 then begin savescreen(1);fn:='review.3';title:='Legend 12/95';author:='Shivan Bastard';
scroller;y:=9;drawreview;showreview;continue;end;
if y=10 then begin savescreen(1);fn:='review.4';title:='Fire 2/96';author:='MindCrime';
scroller;y:=10;drawreview;showreview;continue;end;
if y=11 then begin savescreen(1);fn:='review.5';title:='Mop 2/96';author:='MindCrime';
scroller;y:=11;drawreview;showreview;continue;end;
if y=12 then begin savescreen(1);fn:='review.6';title:='Legend 2/96';author:='MindCrime';
scroller;y:=12;drawreview;showreview;continue;end;
end;end;
until done;tb (0);done:=false;mainansi;
end;
procedure pics;
begin
mainansi2;
drawpics;showpics;count:=1;
repeat
if keypressed=true then begin ch := upcase (readkey);
(*=- when the hit [esc] -=*)
if ch = #27 then done := true;
if ch = #0 then begin ch := readkey;
(*=- Up arror/cursor crap -=*)
if ch = #72 then begin if wherey <> 6 then begin
dec (y);drawpics;showpics;end;end;
(*=- Down arror/cursor crap -=*)
if ch = #80 then begin if wherey <> 10 then begin
inc(y);drawpics;showpics;end;end;end;
(*=- when they hit enter -=*)
if ch = #13 then begin
if y=6 then begin savescreen(1);fn:='ansi.1';marker:=#1;
ansiscroll;y:=6;drawpics;showpics;continue;end;
if y=7 then begin savescreen(1);fn:='ansi.2';marker:=#2;
ansiscroll;y:=7;drawpics;showpics;continue;end;
if y=8 then begin savescreen(1);fn:='ansi.3';marker:=#3;
ansiscroll;y:=8;drawpics;showpics;continue;end;
if y=9 then begin savescreen(1);fn:='ansi.4';marker:=#4;
ansiscroll;y:=9;drawpics;showpics;continue;end;
if y=10 then begin savescreen(1);fn:='ansi.5';marker:=#5;
ansiscroll;y:=10;drawpics;showpics;continue;end;
end;end;
until done;tb (0);done:=false;
mainansi;
end;
procedure mainmenu;
begin
memw[$0000:$041a]:=memw[$0000:$041c];
drawmain;showmain;count:=1;
done:=false;
repeat
if keypressed=true then begin ch := upcase (readkey);
(*=- when the hit [esc] -=*)
if ch = #27 then done := true;
if ch = #0 then begin ch := readkey;
(*=- Up arror/cursor crap -=*)
if ch = #72 then begin if wherey <> 2 then begin
dec (y);drawmain;showmain;end;end;
(*=- Down arror/cursor crap -=*)
if ch = #80 then begin if wherey <> 9 then begin
inc(y);drawmain;showmain;end;end;end;
(*=- when they hit enter -=*)
if ch = #13 then begin
if y=2 then begin y:=7;introduction;y:=2;drawmain;showmain;continue;end;
if y=3 then begin y:=5;articles;y:=3;drawmain;showmain;continue;end;
if y=4 then begin y:=7;interviews;y:=4;drawmain;showmain;continue;end;
if y=5 then begin y:=7;reviews;y:=5;drawmain;showmain;continue;end;
if y=6 then begin y:=2;savescreen(1);fn:='www.rev';title:='Web Site Reviews';Author:='MindCrime';
scroller;y:=6;drawmain;showmain;continue;end;
if y=7 then begin y:=2;savescreen(1);fn:='bbs.rev';title:='BBS Reviews';Author:='Shivan Bastard';
scroller;y:=7;drawmain;showmain;continue;end;
if y=8 then begin y:=2;savescreen(1);fn:='program.rev';title:='Art Viewer Reviews';Author:='Shivan Bastard';
scroller;y:=8;drawmain;showmain;continue;end;
if y=9 then begin y:=6;pics;y:=9;drawmain;showmain;continue;end;
end;
end;
until done;tb(0);
end;
{*
**
** Sound Procedures
** Copyright 1993-95 Edward Schlunder
**
*}
Procedure EndProg(ErrorString : String);
{ Prints the error string and Halts the program }
Begin
Writeln;
Writeln(ErrorString);
If IOResult <> 0 then Close(Handle);
Halt(0);
End;
procedure drawsc1;
begin
tc(7);tb(0);
gotoxy(6,15);write(' Gravis Ultrasound ');
gotoxy(6,16);write(' SoundBlaster 1.0 ');
gotoxy(6,17);write(' SoundBlaster 2.0 ');
gotoxy(6,18);write(' SoundBlaster Pro ');
gotoxy(6,19);write(' SoundBlaster 16 ');
gotoxy(6,20);write(' Pro Audio Spectrum ');
gotoxy(6,21);write(' No Sound ');
end;
procedure showsc1;
begin
tc(15);tb(1);gotoxy(6,y);
if y = 15 then write(' Gravis Ultrasound ');
if y = 16 then write(' SoundBlaster 1.0 ');
if y = 17 then write(' SoundBlaster 2.0 ');
if y = 18 then write(' SoundBlaster Pro ');
if y = 19 then write(' SoundBlaster 16 ');
if y = 20 then write(' Pro Audio Spectrum ');
if y = 21 then write(' No Sound ');tb(0);
end;
Procedure GetSoundCardName;
Begin
y:=15;done:=false;
repeat
drawsc1;showsc1;
ch:=upcase(readkey);
if ch=#13 then begin
if y=15 then SoundCardName := 'GUS.MSE';
if y=16 then SoundCardName := 'SB1X.MSE';
if y=17 then SoundCardName := 'SB2X.MSE';
if y=18 then SoundCardName := 'SBPRO.MSE';
if y=19 then SoundCardName := 'SB16.MSE';
if y=20 then SoundCardName := 'PAS.MSE';
if y=21 then sound:=false;
done:=true;
end;
if ch=#0 then begin fkey:=upcase(readkey);
if ((fkey=#80) and (y<>21)) then inc(y);
if ((fkey=#72) and (y<>15)) then dec(y);
end;
if ch=#27 then begin gotoxy(1,24);tc(15);tb(0);writeln('BTH Issue 3 Sound Card Detection Aborted');halt;end;
until done;
End;
procedure drawsc2;
begin
tc(7);tb(0);
gotoxy(6,15);write(' IRQ 2 ');
gotoxy(6,16);write(' IRQ 3 ');
gotoxy(6,17);write(' IRQ 5 ');
gotoxy(6,18);write(' IRQ 7 ');
gotoxy(6,19);write(' IRQ 11 ');
gotoxy(6,20);write(' IRQ 12 ');
gotoxy(6,21);write(' Autodetect ');
end;
procedure showsc2;
begin
tc(15);tb(1);gotoxy(6,y);
if y = 15 then write(' IRQ 2 ');
if y = 16 then write(' IRQ 3 ');
if y = 17 then write(' IRQ 5 ');
if y = 18 then write(' IRQ 7 ');
if y = 19 then write(' IRQ 11 ');
if y = 20 then write(' IRQ 12 ');
if y = 21 then write(' Autodetect ');tb(0);
end;
Procedure GetIRQNumber;
begin
tc(15);tb(0);
gotoxy(6,13);write('IRQ Setting ');gotoxy(25,13);write('2');
y:=21;done:=false;
repeat
drawsc2;showsc2;
ch:=upcase(readkey);
if ch=#13 then begin
if y=15 then irq := 2;
if y=16 then irq := 3;
if y=17 then irq := 5;
if y=18 then irq := 7;
if y=19 then irq := 11;
if y=20 then irq := 12;
if y=21 then irq := $FF;
done:=true;
end;
if ch=#0 then begin fkey:=upcase(readkey);
if ((fkey=#80) and (y<>21)) then inc(y);
if ((fkey=#72) and (y<>15)) then dec(y);
end;
if ch=#27 then begin gotoxy(1,24);tc(15);tb(0);writeln('BTH Issue 3 Sound Card Detection Aborted');halt;end;
until done;
End;
procedure drawsc3;
begin
tc(7);tb(0);
gotoxy(6,15);write(' DMA Channel 1 ');
gotoxy(6,16);write(' DMA Channel 2 ');
gotoxy(6,17);write(' DMA Channel 3 ');
gotoxy(6,18);write(' DMA Channel 5 ');
gotoxy(6,19);write(' Autodetect ');
gotoxy(6,20);write(' ');
gotoxy(6,21);write(' ');
end;
procedure showsc3;
begin
tc(15);tb(1);gotoxy(6,y);
if y = 15 then write(' DMA Channel 1');
if y = 16 then write(' DMA Channel 2');
if y = 17 then write(' DMA Channel 3');
if y = 18 then write(' DMA Channel 5');
if y = 19 then write(' Autodetect ');
if y = 20 then write(' ');
if y = 21 then write(' ');tb(0);
end;
Procedure GetDMAChannel;
Begin
tc(15);tb(0);
gotoxy(6,13);write('DMA Channel ');gotoxy(25,13);write('3');
y:=19;done:=false;
repeat
drawsc3;showsc3;
ch:=upcase(readkey);
if ch=#13 then begin
if y=15 then dma := 1;
if y=16 then dma := 2;
if y=17 then dma := 3;
if y=18 then dma := 5;
if y=19 then dma := $FF;
done:=true;
end;
if ch=#0 then begin fkey:=upcase(readkey);
if ((fkey=#80) and (y<>19)) then inc(y);
if ((fkey=#72) and (y<>15)) then dec(y);
end;
if ch=#27 then begin gotoxy(1,24);tc(15);tb(0);writeln('BTH Issue 3 Sound Card Detection Aborted');halt;end;
until done;
End;
procedure drawsc4;
begin
tc(7);tb(0);
gotoxy(6,15);write(' 210h ');
gotoxy(6,16);write(' 220h ');
gotoxy(6,17);write(' 230h ');
gotoxy(6,18);write(' 240h ');
gotoxy(6,19);write(' 250h ');
gotoxy(6,20);write(' 260h ');
gotoxy(6,21);write(' Autodetect ');
end;
procedure showsc4;
begin
tc(15);tb(1);gotoxy(6,y);
if y = 15 then write(' 210h ');
if y = 16 then write(' 220h ');
if y = 17 then write(' 230h ');
if y = 18 then write(' 240h ');
if y = 19 then write(' 250h ');
if y = 20 then write(' 260h ');
if y = 21 then write(' Autodetect ');tb(0);
end;
Procedure GetBaseIO;
Begin
tc(15);tb(0);
gotoxy(6,13);write('Base IO Address');gotoxy(25,13);write('4');
y:=21;done:=false;
repeat
drawsc4;showsc4;
ch:=upcase(readkey);
if ch=#13 then begin
if y=15 then baseio := $210;
if y=16 then baseio := $220;
if y=17 then baseio := $230;
if y=18 then baseio := $240;
if y=19 then baseio := $250;
if y=20 then baseio := $260;
if y=21 then baseio := $FFFF;
done:=true;
end;
if ch=#0 then begin fkey:=upcase(readkey);
if ((fkey=#80) and (y<>21)) then inc(y);
if ((fkey=#72) and (y<>15)) then dec(y);
end;
if ch=#27 then begin gotoxy(1,24);tc(15);tb(0);writeln('BTH Issue 3 Sound Card Detection Aborted');halt;end;
until done;
End;
Function ToHex(Num : Word) : String;
{ Converts a decimal number to Hexidecimal }
Const
HexChars : String = '0123456789ABCDEF';
Var
Temp : String;
Begin
Temp := '';
Temp := Temp + HexChars[((Num Shr 8) And 15) + 1];
Temp := Temp + HexChars[((Num Shr 4) And 15) + 1];
Temp := Temp + HexChars[((Num Shr 0) And 15) + 1];
ToHex := Temp + 'h';
End;
Begin
tc(15);tb(0);
assign(tf,'bth3.dat');
{$I-}
reset(tf);
{$I+}
if ioresult <> 0 then
begin
writeln('BTH Data File : BTH3.DAT not found! ');
halt;
end;
sound:=true;
setupansi;
getsoundcardname;
if sound then begin
getirqnumber;
getdmachannel;
getbaseio;
samplerate:=45;
dmabuffer:=4096;
Case LoadMSE(SoundCardName, 0, SampleRate, DMABuffer, BaseIO, IRQ, DMA) of
1 : EndProg('Base I/O address autodetection failure');
2 : EndProg('IRQ level autodetection failure');
3 : EndProg('DMA channel autodetection failure');
4 : EndProg('DMA channel not supported');
6 : EndProg('Sound device does not respond');
7 : EndProg('Memory control blocks destroyed');
8 : EndProg('Insufficient memory for mixing buffers');
9 : EndProg('Insufficient memory for MSE file');
10: EndProg('MSE has invalid identification string');
11: EndProg('MSE disk read failure');
12: EndProg('MVSOUND.SYS not loaded');
End;
ExitProc := @FreeMSE; { Call FreeMSE on abnormal program end }
If EMSExist { Check for EMS }
Then EMSFlag := 1 { Yes, EMS exists, so use it }
Else EMSFlag := 0; { EMS does not exist }
{$I-} { Turn off I/O checking }
Assign(Handle, 'bth3.gdm'); { Open the file for loading }
Reset(Handle);
{$I+} { Turn I/O checking back on }
If IOResult <> 0 Then
EndProg('You deleted BTH3.GDM dumbass!');{ File not found, exit program }
Case LoadGDM(Handle, 0, EMSFlag, Header) of
1 : EndProg('Module is corrupt');
2 : EndProg('Could not autodetect module type (N/A)');
3 : EndProg('Bad file format ID string');
4 : EndProg('Insufficient memory to load module');
5 : EndProg('Can not unpack samples');
6 : EndProg('AdLib instruments not supported');
End;
Close(Handle);
MusicChannels := 0; { Calculate the number of channels in song }
For ChannelCount := 1 to 32 do
Begin
If Header.PanMap[ChannelCount] <> $FF
Then MusicChannels := MusicChannels + 1;
End;
SampleRate := StartOutput(MusicChannels, 0);
StartMusic;
gotoxy(6,23);tc(7);
Writeln('Port: ', ToHex(BaseIO),' IRQ: ',IRQ,' DMA: ',DMA);
end;
get_color(pal);fade_out(30);
{ introansi;readkey;}
memw[$0000:$041a]:=memw[$0000:$041c];
offcursor;clrscr;fade_in(0);
introansi;
y:=2;mainansi;fade_in(20);mainmenu;
fade_out(20);clrscr;
if sound then begin
StopMusic;
StopOutput;
UnloadModule;
FreeMse;
end;
endansi;
fade_in(30);gotoxy(1,24);oncursor;
End.