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 @@
|
|||||||
|
c:\progs\tp\tpc pho.pas
|
||||||
BIN
Binary file not shown.
@@ -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.
|
||||||
BIN
Binary file not shown.
BIN
Binary file not shown.
BIN
Binary file not shown.
@@ -0,0 +1,11 @@
|
|||||||
|
unit pho_u;
|
||||||
|
INTERFACE
|
||||||
|
procedure phopic;
|
||||||
|
procedure phopal;
|
||||||
|
IMPLEMENTATION
|
||||||
|
procedure phopic;external
|
||||||
|
{$L phopic.obj};
|
||||||
|
procedure phopal;external
|
||||||
|
{$L phopal.obj};
|
||||||
|
begin
|
||||||
|
end.
|
||||||
@@ -0,0 +1,8 @@
|
|||||||
|
unit pho_u2;
|
||||||
|
INTERFACE
|
||||||
|
procedure phofnt;
|
||||||
|
IMPLEMENTATION
|
||||||
|
procedure phofnt;external
|
||||||
|
{$L phofnt.obj};
|
||||||
|
begin
|
||||||
|
end.
|
||||||
BIN
Binary file not shown.
+323
@@ -0,0 +1,323 @@
|
|||||||
|
unit TextGraf;
|
||||||
|
interface
|
||||||
|
uses dos;
|
||||||
|
type
|
||||||
|
MonitorTyp = (Hercules, EGA, VGA, other);
|
||||||
|
VGAColorInfo = array[0..2] of byte; { eine VGA-Farbe: nur f�r Demo }
|
||||||
|
VGAColors = array[0..255] of VGAColorInfo; { alle VGA-Farben: dito }
|
||||||
|
|
||||||
|
function InitTextGraf: integer;
|
||||||
|
{ Muá ganz zu Anfang des Programms, noch im Textmodus aufgerufen
|
||||||
|
werden. Ohne das funktioniert der Rest nicht. Ergebnis 0: Alles Ok,
|
||||||
|
unbekannter Videotyp: -1, zuwenig Speicher: 1 (Bedarf ca. 12Kb) }
|
||||||
|
procedure SetPaletteSave(On: boolean);
|
||||||
|
{ Mit On = true nach InitTextGraf und im Textmodus aufrufen. Sichert die
|
||||||
|
Textpalette und reserviert Speicher f�r die Grafikpalette, die dann
|
||||||
|
automatisch verwendet werden. On = false schaltet diese Automatik
|
||||||
|
wieder ab und gibt den Speicher f�r die Paletten (ca. 1.5Kb) frei.}
|
||||||
|
procedure ToText;
|
||||||
|
{ Schaltet vom Grafik- in den Testmodus. Bildspeicher etc. werden in
|
||||||
|
Sicherheit gebracht }
|
||||||
|
procedure ToGraph;
|
||||||
|
{ Schaltet in die Grafik zur�ck. Vorher sollte ein Grafikmodus mit
|
||||||
|
ToText verlassen worden sein, um alle Werte zu initialisieren }
|
||||||
|
|
||||||
|
procedure GrafikMode(Mode: byte);
|
||||||
|
{ nur f�r das Demoprogramm. Kann gel”scht werden, wenn BGI-Routinen
|
||||||
|
(InitGraph) verwendet werden }
|
||||||
|
function GetMonTyp: MonitorTyp;
|
||||||
|
{ dito }
|
||||||
|
procedure SetVGAColors(var Colors: VGAColors);
|
||||||
|
{ dito }
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
ScreenArray = array[0..3999] of word; { Bildspeicher bei 80x25 }
|
||||||
|
CharGenArray = array[0..8191] of byte; { Zeichengenerator }
|
||||||
|
ModeType = (Text, Grafik, unknown);
|
||||||
|
|
||||||
|
var
|
||||||
|
regs: registers; { f�r intr }
|
||||||
|
CharGen: CharGenArray absolute $A000:0; { Adresse Zeichengenerator }
|
||||||
|
BMode: byte absolute $40:$49; { Bios-Videomode }
|
||||||
|
|
||||||
|
const
|
||||||
|
VModus: ModeType = unknown;
|
||||||
|
VMonitor: MonitorTyp = other; { Vorgabe: nichts gutes }
|
||||||
|
TScreen: ^ScreenArray = nil; { zeigt in den Bildspeicher }
|
||||||
|
ScrBuf: ^ScreenArray = nil; { speichert Textschirm zwischen }
|
||||||
|
CGBuf: ^CharGenArray = nil; { speichert Zeichengenerator }
|
||||||
|
ModeNr: byte = $FF; { Kennung f�r Init }
|
||||||
|
TMode: byte = $FF; { der zu restaurierende Textmodus }
|
||||||
|
GMode: byte = $FF; { dito Grafikmodus }
|
||||||
|
VGATextPal: ^VGAColors = nil;
|
||||||
|
VGAGraphPal: ^VGAColors = nil;
|
||||||
|
|
||||||
|
function IsVga: boolean; { haben wir VGA }
|
||||||
|
begin
|
||||||
|
with regs do
|
||||||
|
begin
|
||||||
|
AX:= $1A00; { Display Combination abfragen }
|
||||||
|
Intr($10, regs);
|
||||||
|
IsVga:= (AL = $1A); { g�ltiger Aufruf }
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function IsEGA: boolean; { liegt wenigstens EGA vor }
|
||||||
|
begin
|
||||||
|
with regs do
|
||||||
|
begin
|
||||||
|
AH:= $12; { Funktion $12 }
|
||||||
|
BL:= $10; { get EGA Information }
|
||||||
|
Intr($10, regs);
|
||||||
|
IsEga:= (BL <> $10); { hat sich was ge„ndert ? }
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure GetVGAColors(var Colors: VGAColors);
|
||||||
|
begin
|
||||||
|
with regs do
|
||||||
|
begin
|
||||||
|
ax:= $1017;
|
||||||
|
bx:= 0;
|
||||||
|
cx:= 255;
|
||||||
|
es:= seg(Colors);
|
||||||
|
dx:= ofs(Colors);
|
||||||
|
intr($10, regs);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SetVGAColors(var Colors: VGAColors);
|
||||||
|
begin
|
||||||
|
with regs do
|
||||||
|
begin
|
||||||
|
ax:= $1012;
|
||||||
|
bx:= 0;
|
||||||
|
cx:= 255;
|
||||||
|
es:= seg(Colors);
|
||||||
|
dx:= ofs(Colors);
|
||||||
|
intr($10, regs);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure NoInitStop;
|
||||||
|
begin
|
||||||
|
writeln('TextGraph ist nicht initialisiert! Benutzen Sie InitTextGraph!');
|
||||||
|
halt(2);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure HercTextMode;
|
||||||
|
var i: integer;
|
||||||
|
ModeReg: byte absolute 0:$465;
|
||||||
|
const HData: array[0..13] of byte = { Timingdaten! Nicht ver„ndern! }
|
||||||
|
($61,$50,$52,$0f,$19,$06,$19,$19,$02,$0d,$0b,$0c,0,0);
|
||||||
|
begin
|
||||||
|
port[$3bf]:= 0; { Config Reg: HalfMode: eine Seite (3 f�r Full Mode) }
|
||||||
|
port[$3b8]:= $21; { Mode Control: Dunkel, Text, 80x25 }
|
||||||
|
for i:= 0 to 13 do { die Timing-Daten komplett }
|
||||||
|
begin
|
||||||
|
port[$3b4]:= i; { Index Laden (Register einblenden) }
|
||||||
|
port[$3b5]:= HData[i]; { Wert schreiben }
|
||||||
|
end;
|
||||||
|
port[$3b8]:= $29; { ModeControl: Hell, Text, 80x25 }
|
||||||
|
ModeReg:= $29; { im BIOS-Ram protokollieren }
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure HercGraphMode;
|
||||||
|
var i: integer;
|
||||||
|
ModeReg: byte absolute 0:$465;
|
||||||
|
const HData: array[0..13] of byte = { Timingdaten! Nicht ver„ndern! }
|
||||||
|
($35,$2d,$2e,$07,$5b,$02,$57,$57,$02,$03,0,0,0,0);
|
||||||
|
begin
|
||||||
|
port[$3bf]:= 1; { Config Reg: HalfMode: eine Seite (3 f�r Full Mode) }
|
||||||
|
port[$3b8]:= 2; { Mode Control: Dunkel, Grafik, Seite 0 }
|
||||||
|
for i:= 0 to 13 do { die Timing-Daten komplett }
|
||||||
|
begin
|
||||||
|
port[$3b4]:= i; { Index Laden (Register einblenden) }
|
||||||
|
port[$3b5]:= HData[i]; { Wert schreiben }
|
||||||
|
end;
|
||||||
|
port[$3b8]:= $0a; { ModeControl: Hell, Grafik, Seite 0 }
|
||||||
|
ModeReg:= $0a; { im BIOS-Ram protokollieren }
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure GrafikMode(Mode: byte); { Setzt den Videomodus, nur f�r Demo }
|
||||||
|
var i: integer;
|
||||||
|
begin
|
||||||
|
if VMonitor <> Hercules then { alle auáer Hercules sind sehr einfach }
|
||||||
|
with regs do
|
||||||
|
begin
|
||||||
|
AX:= Mode; { AH:= 0; AL:= Mode }
|
||||||
|
Intr($10, regs);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
HercGraphMode;
|
||||||
|
fillchar(ptr($B000,0)^, $8000, 0); { Clearscreen }
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetMonTyp: MonitorTyp; { Zugriffsfunktion, nur f�r das Demo }
|
||||||
|
begin
|
||||||
|
GetMonTyp:= VMonitor;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ToTextVGA; { sichert den Teil des Grafik-Bildspeichers, der }
|
||||||
|
var b: byte; { vom Zeichengenerator �berschrieben wird }
|
||||||
|
begin
|
||||||
|
regs.ax:= $90; { Standardmodus setzen um Zugriff sicherzustellen }
|
||||||
|
intr($10, regs); { Bildspeicher bleibt erhalten }
|
||||||
|
Port[$3ce]:= 4; { Read Map Select holen }
|
||||||
|
b:= Port[$3cf]; { lesen }
|
||||||
|
Port[$3cf]:= 2; { Plane 2 ein }
|
||||||
|
CGBuf^:= CharGen; { Grafikinhalt von Zeichengenerator sichern }
|
||||||
|
Port[$3cf]:= b; { Wert zur�ck }
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ToTextEGA; { wie oben jedoch Variante f�r EGA, }
|
||||||
|
var b: byte; { deren Register nicht lesbar sind }
|
||||||
|
begin
|
||||||
|
regs.ax:= $90; { Standardmodus setzen um Zugriff sicherzustellen }
|
||||||
|
intr($10, regs); { Bildspeicher bleibt erhalten }
|
||||||
|
Port[$3ce]:= 4; { Read Map Select holen }
|
||||||
|
Port[$3cf]:= 2; { Plane 2 ein }
|
||||||
|
CGBuf^:= CharGen; { Grafikinhalt von Zeichengenerator sichern }
|
||||||
|
Port[$3cf]:= 0; { Default zur�ck }
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ToGraphVGA; { �berschreibt den Zeichengenerator mit }
|
||||||
|
var b: byte; { gesicherten Grafikinhalt }
|
||||||
|
begin
|
||||||
|
regs.ax:= $90; { Standardmodus setzen um Zugriff sicherzustellen }
|
||||||
|
intr($10, regs); { Bildspeicher bleibt erhalten }
|
||||||
|
Port[$3C4]:= 2; { Map Mask Register holen }
|
||||||
|
b:= Port[$3c5]; { lesen }
|
||||||
|
Port[$3c5]:= 4; { Plane 2 ein }
|
||||||
|
CharGen:= CGBuf^; { Zeichengenerator zur�ck }
|
||||||
|
Port[$3c5]:= b; { Wert zur�ck }
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ToGraphEGA; { wie oben jedoch Variante f�r EGA, }
|
||||||
|
var b: byte; { deren Register nicht lesbar sind }
|
||||||
|
begin
|
||||||
|
regs.ax:= $90; { Standardmodus setzen um Zugriff sicherzustellen }
|
||||||
|
intr($10, regs); { Bildspeicher bleibt erhalten }
|
||||||
|
Port[$3C4]:= 2; { Map Mask Register holen }
|
||||||
|
Port[$3c5]:= 4; { Plane 2 ein }
|
||||||
|
CharGen:= CGBuf^; { Zeichengenerator kopieren }
|
||||||
|
Port[$3c5]:= 0; { Default zur�ck }
|
||||||
|
end;
|
||||||
|
|
||||||
|
function InitTextGraf: integer; { ermittelt Monitor, setzt Variablen, }
|
||||||
|
begin { reserviert Speicher }
|
||||||
|
InitTextGraf:= 0;
|
||||||
|
if ModeNr <> $FF then exit; { wurde schon aufgerufen, alles ok }
|
||||||
|
InitTextGraf:= -1; { Fehlervorgabe: falsche Karte }
|
||||||
|
if IsEGA then VMonitor:= EGA; { EGA ? }
|
||||||
|
if IsVGA then VMonitor:= VGA; { oder VGA ? }
|
||||||
|
TMode:= BMode and $7f;
|
||||||
|
if TMode = 7 then
|
||||||
|
begin
|
||||||
|
TScreen:= ptr($B000,0); { Bildspeicheradresse Text mono setzen }
|
||||||
|
if VMonitor = other then { keines von beiden: }
|
||||||
|
begin
|
||||||
|
VMonitor:= Hercules; { dann Hercules, (evtl Probleme mit CGA-Mono)}
|
||||||
|
GMode:= 7; { Modi alle 7 }
|
||||||
|
end;
|
||||||
|
end else
|
||||||
|
TScreen:= ptr($B800,0); { Bildspeicheradresse Text farbig setzen }
|
||||||
|
if VMonitor = other then exit; { was anderes? geht nicht! }
|
||||||
|
InitTextGraf:= 1; { Fehlervorgabe: kein Speicher }
|
||||||
|
if VMonitor in [EGA, VGA] then
|
||||||
|
begin { Vorgaben f�r EGA & VGA }
|
||||||
|
GMode:= $10; { Grafik 640x350 }
|
||||||
|
if MaxAvail >= sizeof(CGBuf) then { Speicher f�r Puffer belegen }
|
||||||
|
New(CGBuf)
|
||||||
|
else
|
||||||
|
exit; { raus mit Fehler 1 }
|
||||||
|
end;
|
||||||
|
if MaxAvail >= sizeof(ScrBuf) then { noch mehr }
|
||||||
|
New(ScrBuf)
|
||||||
|
else
|
||||||
|
exit; { raus mit Fehler 1 }
|
||||||
|
ModeNr:= TMode; { Initialisierung merken }
|
||||||
|
InitTextGraf:= 0; { alles ok }
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SetPaletteSave(On: boolean);
|
||||||
|
{ aktiviert oder deaktiviert die automatische Palettensicherung }
|
||||||
|
begin
|
||||||
|
if ModeNr = $FF then NoInitStop; { schon Init ? }
|
||||||
|
if On then
|
||||||
|
begin
|
||||||
|
if VGATextPal = nil then { gibts schon ? }
|
||||||
|
new(VGATextPal); { nein, neu }
|
||||||
|
if VGAGraphPal = nil then { dito Grafikpalette }
|
||||||
|
new(VGAGraphPal);
|
||||||
|
GetVGAColors(VGATextPal^); { Textfarben holen }
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
if VGATextPal <> nil then { was da ? }
|
||||||
|
begin
|
||||||
|
dispose(VGATextPal); { freigeben }
|
||||||
|
VGATextPal:= nil; { und kennzeichnen }
|
||||||
|
end;
|
||||||
|
if VGAGraphPal <> nil then { andere auch }
|
||||||
|
begin
|
||||||
|
dispose(VGAGraphPal);
|
||||||
|
VGAGraphPal:= nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ToText; { Schaltet in Textmodus, bringt, was �berschrieben }
|
||||||
|
begin { wird in Sicherheit }
|
||||||
|
if ModeNr = $FF then NoInitStop; { schon Init ? }
|
||||||
|
GMode:= BMode; { Grafikmodus merken }
|
||||||
|
case VMonitor of
|
||||||
|
VGA: begin
|
||||||
|
if VGAGraphPal <> nil then
|
||||||
|
GetVGAColors(VGAGraphPal^);
|
||||||
|
ToTextVGA; { Zeichengeneratorbereich sichern }
|
||||||
|
end;
|
||||||
|
EGA: ToTextEGA;
|
||||||
|
end; {case}
|
||||||
|
if VMonitor = Hercules then
|
||||||
|
HercTextMode { Hercules Textmodus ohne Bildspeicher l”schen }
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
regs.ax:= TMode or $80; { Text, Bit 7 = 1: Bildspeicher nicht l”schen }
|
||||||
|
intr($10, regs);
|
||||||
|
if (VMonitor = VGA) and (VGATextPal <> nil) then
|
||||||
|
SetVGAColors(VGATextPal^);
|
||||||
|
end;
|
||||||
|
scrbuf^:= TScreen^; { Grafikinhalt von Textschirm sichern }
|
||||||
|
VModus:= Text;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ToGraph; { versucht den Grafikmodus zu restaurieren }
|
||||||
|
begin
|
||||||
|
if ModeNr = $FF then NoInitStop; { schon Init ? }
|
||||||
|
TMode:= BMode;
|
||||||
|
TScreen^:= ScrBuf^; { Grafikinhalt zur�ck in Textbildschirm f�llen }
|
||||||
|
case VMonitor of
|
||||||
|
VGA: begin
|
||||||
|
if VGATextPal <> nil then
|
||||||
|
GetVGAColors(VGATextPal^);
|
||||||
|
ToGraphVGA; { dito Zeichengenerator }
|
||||||
|
end;
|
||||||
|
EGA: ToGraphEGA;
|
||||||
|
end; {case}
|
||||||
|
if VMonitor = Hercules then
|
||||||
|
HercGraphMode { Hercules handmade Grafikmodus }
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
regs.ax:= GMode or $80; { Text, Bit 7 = 1: Bildspeicher nicht l”schen }
|
||||||
|
intr($10, regs);
|
||||||
|
if (VMonitor = VGA) and (VGAGraphPal <> nil) then
|
||||||
|
SetVGAColors(VGAGraphPal^);
|
||||||
|
end;
|
||||||
|
VModus:= Grafik;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
Binary file not shown.
Reference in New Issue
Block a user