stefankoelle/dos-phobia-welcome-intro
1
0
Fork 0
mirror of https://github.com/skoelle/dos-phobia-welcome-intro.git synced 2026-09-17 20:50:24 +00:00
Code Issues Packages Projects Releases Wiki Activity

Moved into subfolders

Browse Source
This commit is contained in:
Stefan Koelle
2025-01-03 20:14:10 +01:00
parent 10b9a1d008
commit 1b87dd064f
14 changed files with 770 additions and 770 deletions
Download Patch File Download Diff File Expand all files Collapse all files
screenshot.png → images/screenshot.png
View File
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 14 KiB

COMPILE.BAT → source/COMPILE.BAT
View File
MOD-OBJ.OBJ → source/MOD-OBJ.OBJ
View File
PHO.PAS → source/PHO.PAS
+430 -430
View File
@@ -1,431 +1,431 @@
{$A-,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-} {$A-,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
{$M 16384,0,59360} {$M 16384,0,59360}
uses crt,textgraf,pho_u,pho_u2; uses crt,textgraf,pho_u,pho_u2;
const rot:array[0..1] of integer=(1,0); const rot:array[0..1] of integer=(1,0);
VERSION='1.3'; VERSION='1.3';
FADE_SPEED=10; FADE_SPEED=10;
TANZ=10; TANZ=10;
text:array[1..6*TANZ] of string[30]=('PRESENTS' text:array[1..6*TANZ] of string[30]=('PRESENTS'
,'WELCOME' ,'WELCOME'
,'---------------' ,'---------------'
,'' ,''
,'PC INTRO BY' ,'PC INTRO BY'
,'STEFAN KOELLE' ,'STEFAN KOELLE'
,'[[[[[[[[[[' ,'[[[[[[[[[['
,'[ PHOBIA [' ,'[ PHOBIA ['
,'[ 1994 [' ,'[ 1994 ['
,'[ """""" [' ,'[ """""" ['
,'[ BY NST [' ,'[ BY NST ['
,'[[[[[[[[[[' ,'[[[[[[[[[['
,'' ,''
,'CREDITS' ,'CREDITS'
,'------' ,'------'
,'CODING BY' ,'CODING BY'
,'STEFAN' ,'STEFAN'
,'' ,''
,'' ,''
,'CREDITS' ,'CREDITS'
,'------' ,'------'
,'GFX BY' ,'GFX BY'
,'STEFAN' ,'STEFAN'
,'' ,''
,'' ,''
,'CREDITS' ,'CREDITS'
,'------' ,'------'
,'MUSIC' ,'MUSIC'
,'RIPPED' ,'RIPPED'
,'' ,''
,'' ,''
,'CREDITS' ,'CREDITS'
,'------' ,'------'
,'IDEA FROM AN' ,'IDEA FROM AN'
,'AMIGA DEMO' ,'AMIGA DEMO'
,'' ,''
,'' ,''
,'SPECIAL GREETINGS' ,'SPECIAL GREETINGS'
,'----------------' ,'----------------'
,'MAD DOC' ,'MAD DOC'
,'M T L' ,'M T L'
,'' ,''
,'' ,''
,'NORMAL GREETINGS' ,'NORMAL GREETINGS'
,'---------------' ,'---------------'
,'SATAN CLAUS' ,'SATAN CLAUS'
,'MAJ-SOFT' ,'MAJ-SOFT'
,'' ,''
,'' ,''
,'INFO' ,'INFO'
,'-------' ,'-------'
,'CODED 1994' ,'CODED 1994'
,'ON 486 DX50' ,'ON 486 DX50'
,'' ,''
,'' ,''
,'BYE BYE' ,'BYE BYE'
,'------' ,'------'
,'PRESS ANY' ,'PRESS ANY'
,'KEY' ,'KEY'
,''); ,'');
var var
dev,mix,stat,pro,loop : integer; dev,mix,stat,pro,loop : integer;
md : string; md : string;
i,txtz,txti,j,x,y,k:integer; i,txtz,txti,j,x,y,k:integer;
r,ri:real; r,ri:real;
rb:boolean; rb:boolean;
w:word; w:word;
p:vgacolors; p:vgacolors;
l:vgacolors; l:vgacolors;
cyc:array[0..2] of byte; cyc:array[0..2] of byte;
cy2:array[0..2,1..10] of byte; cy2:array[0..2,1..10] of byte;
s:string; s:string;
ch:char; ch:char;
font : array[1..57,0..15,0..17] of byte; font : array[1..57,0..15,0..17] of byte;
{$L MOD-obj.OBJ} { Link in Object file } {$L MOD-obj.OBJ} { Link in Object file }
{$F+} { force calls to be 'far'} {$F+} { force calls to be 'far'}
procedure modvolume(v1,v2,v3,v4:integer); external ; {Can do while playing} procedure modvolume(v1,v2,v3,v4:integer); external ; {Can do while playing}
procedure moddevice(var device:integer); external ; procedure moddevice(var device:integer); external ;
procedure modsetup(var status:integer;device,mixspeed,pro,loop:integer;var str:string); external ; procedure modsetup(var status:integer;device,mixspeed,pro,loop:integer;var str:string); external ;
procedure modstop; external ; procedure modstop; external ;
procedure modinit; external; procedure modinit; external;
{$F-} {$F-}
procedure ch_pal; procedure ch_pal;
var x,y,i,j:integer; var x,y,i,j:integer;
begin begin
inc(k); inc(k);
if k=3 then begin if k=3 then begin
k:=0; k:=0;
for i:=0 to 2 do cyc[i]:=p[94,i]; for i:=0 to 2 do cyc[i]:=p[94,i];
for j:=93 downto 80 do 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[j+1,i]:=p[j,i];
for i:=0 to 2 do p[80,i]:=cyc[i]; for i:=0 to 2 do p[80,i]:=cyc[i];
end; end;
for y:=0 to 1 do for y:=0 to 1 do
for x:=1 to 5 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 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 y:=0 to 1 do
for x:=1 to 5 do for x:=1 to 5 do
for j:=1 to 4 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 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 y:=0 to 1 do
for x:=1 to 5 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)]; for i:=0 to 2 do p[16+x-1+y*25,i]:=cy2[i,(x+rot[y]*5)];
ri:=ri+1; ri:=ri+1;
if ri>372 then ri:=ri-372; if ri>372 then ri:=ri-372;
if sin(ri*6.3)*15<0 then begin if sin(ri*6.3)*15<0 then begin
r:=r-sin(ri*6.3)*15; r:=r-sin(ri*6.3)*15;
rb:=FALSE; rb:=FALSE;
end else begin end else begin
r:=r+sin(ri*6.3)*15; r:=r+sin(ri*6.3)*15;
rb:=TRUE; rb:=TRUE;
end; end;
if r>20 then begin if r>20 then begin
r:=r-20; r:=r-20;
if rb then begin if rb then begin
for y:=0 to 1 do for y:=0 to 1 do
for x:=1 to 5 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 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 y:=0 to 1 do
for j:=1 to 4 do for j:=1 to 4 do
for x:=1 to 5 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 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 y:=0 to 1 do
for x:=1 to 5 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]; for i:=0 to 2 do p[20+(x-1)*5+y*25-4,i]:=cy2[i,x+rot[y]*5];
end else begin end else begin
for y:=0 to 1 do for y:=0 to 1 do
for x:=1 to 5 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 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 y:=0 to 1 do
for j:=1 to 4 do for j:=1 to 4 do
for x:=1 to 5 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 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 y:=0 to 1 do
for x:=1 to 5 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]; for i:=0 to 2 do p[20+(x-1)*5+y*25,i]:=cy2[i,x+rot[y]*5];
end; end;
end; end;
end; end;
procedure writeline(wly : integer; wls : string); procedure writeline(wly : integer; wls : string);
var i,x,y,num,wlx:integer; var i,x,y,num,wlx:integer;
begin begin
wlx:=160-length(wls)*9+14; wlx:=160-length(wls)*9+14;
for i:=1 to length(wls) do for i:=1 to length(wls) do
for x:=0 to 15 do for y:=0 to 17 do begin for x:=0 to 15 do for y:=0 to 17 do begin
if wls[i]<>' ' then begin if wls[i]<>' ' then begin
case wls[i] of case wls[i] of
'A'..'Z':num:=ord(wls[i])-64; 'A'..'Z':num:=ord(wls[i])-64;
'0'..'9':num:=ord(wls[i])-19; '0'..'9':num:=ord(wls[i])-19;
'*':num:=39; '*':num:=39;
'"':num:=40; '"':num:=40;
'!':num:=41; '!':num:=41;
'$':num:=42; '$':num:=42;
':':num:=43; ':':num:=43;
'.':num:=44; '.':num:=44;
',':num:=45; ',':num:=45;
'\':num:=46; '\':num:=46;
'?':num:=47; '?':num:=47;
'-':num:=48; '-':num:=48;
'+':num:=49; '+':num:=49;
'=':num:=50; '=':num:=50;
'[':num:=51; '[':num:=51;
']':num:=52; ']':num:=52;
'%':num:=53; '%':num:=53;
'(':num:=54; '(':num:=54;
')':num:=55; ')':num:=55;
end; end;
if font[num,x,y]<>0 then mem[$A000:(wly+y)*word(320)+wlx+x+(i-1)*16]:=font[num,x,y]; 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; end;
end; end;
procedure writeback(wly : integer; wls : string); procedure writeback(wly : integer; wls : string);
var i,x,y,num,wlx:integer; var i,x,y,num,wlx:integer;
begin begin
wlx:=160-length(wls)*9+14; wlx:=160-length(wls)*9+14;
for i:=1 to length(wls) do for i:=1 to length(wls) do
for x:=0 to 15 do for y:=0 to 17 do begin for x:=0 to 15 do for y:=0 to 17 do begin
if wls[i]<>' ' then begin if wls[i]<>' ' then begin
case wls[i] of case wls[i] of
'A'..'Z':num:=ord(wls[i])-64; 'A'..'Z':num:=ord(wls[i])-64;
'0'..'9':num:=ord(wls[i])-19; '0'..'9':num:=ord(wls[i])-19;
'*':num:=39; '*':num:=39;
'"':num:=40; '"':num:=40;
'!':num:=41; '!':num:=41;
'$':num:=42; '$':num:=42;
':':num:=43; ':':num:=43;
'.':num:=44; '.':num:=44;
',':num:=45; ',':num:=45;
'\':num:=46; '\':num:=46;
'?':num:=47; '?':num:=47;
'-':num:=48; '-':num:=48;
'+':num:=49; '+':num:=49;
'=':num:=50; '=':num:=50;
'[':num:=51; '[':num:=51;
']':num:=52; ']':num:=52;
'%':num:=53; '%':num:=53;
'(':num:=54; '(':num:=54;
')':num:=55; ')':num:=55;
end; end;
if (font[num,x,y]<>0) then mem[$A000:(wly+y)*word(320)+wlx+x+(i-1)*16] 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]; :=mem[seg(phopic):ofs(phopic)+(wly+y)*word(320)+wlx+x+(i-1)*16];
end; end;
end; end;
end; end;
procedure CLI; inline( $FA ); { Interrupts unterdr�cken } procedure CLI; inline( $FA ); { Interrupts unterdr�cken }
procedure STI; inline( $FB ); { Interrupts wieder erlauben } procedure STI; inline( $FB ); { Interrupts wieder erlauben }
begin begin
CLI; CLI;
modinit; modinit;
clrscr; clrscr;
writeln('PHOB­A Intro'); writeln('PHOB­A Intro');
writeln('------------'); writeln('------------');
writeln; writeln;
writeln('F1 -PC Speaker (10000 kHz)'); writeln('F1 -PC Speaker (10000 kHz)');
writeln('F2 -PC Speaker (20000 kHz)'); writeln('F2 -PC Speaker (20000 kHz)');
writeln('F3 -SoundBlaster (10000 kHz)'); writeln('F3 -SoundBlaster (10000 kHz)');
writeln('F4 -SoundBlaster (20000 kHz)'); writeln('F4 -SoundBlaster (20000 kHz)');
writeln('F5 -D/A Wandler (10000 kHz)'); writeln('F5 -D/A Wandler (10000 kHz)');
writeln('F6 -D/A Wandler (20000 kHz)'); writeln('F6 -D/A Wandler (20000 kHz)');
writeln('F7 -Disney Source (10000 kHz)'); writeln('F7 -Disney Source (10000 kHz)');
writeln('F8 -Disney Source (20000 kHz)'); writeln('F8 -Disney Source (20000 kHz)');
writeln('F9 -PC Speaker (????? kHz)'); writeln('F9 -PC Speaker (????? kHz)');
writeln('F10-SoundBlaster (????? kHz)'); writeln('F10-SoundBlaster (????? kHz)');
writeln('ESC-No Sound'); writeln('ESC-No Sound');
writeln; writeln;
writeln('Press F1-F10 or ESC...'); writeln('Press F1-F10 or ESC...');
i:=1; i:=1;
repeat repeat
ch:=readkey; ch:=readkey;
if ch=#27 then begin if ch=#27 then begin
i:=0; i:=0;
dev:=255; dev:=255;
end; end;
if ch='+' then begin if ch='+' then begin
clrscr; clrscr;
writeln('Intro by: Stefan Koelle of Phobia * Version '+VERSION); writeln('Intro by: Stefan Koelle of Phobia * Version '+VERSION);
writeln('Intro skipped !!!'); writeln('Intro skipped !!!');
STI; STI;
halt(1); halt(1);
end; end;
if ch=#0 then begin if ch=#0 then begin
ch:=readkey; ch:=readkey;
if (ord(ch)>58) and (ord(ch)<69) then i:=0; if (ord(ch)>58) and (ord(ch)<69) then i:=0;
end; end;
until i=0; until i=0;
case ord(ch) of case ord(ch) of
59:begin 59:begin
dev := 0; dev := 0;
mix := 10000; mix := 10000;
end; end;
60:begin 60:begin
dev := 0; dev := 0;
mix := 20000; mix := 20000;
end; end;
61:begin 61:begin
dev := 7; dev := 7;
mix := 10000; mix := 10000;
end; end;
62:begin 62:begin
dev := 7; dev := 7;
mix := 20000; mix := 20000;
end; end;
63:begin 63:begin
dev := 1; dev := 1;
mix := 10000; mix := 10000;
end; end;
64:begin 64:begin
dev := 1; dev := 1;
mix := 20000; mix := 20000;
end; end;
65:begin 65:begin
dev := 11; dev := 11;
mix := 10000; mix := 10000;
end; end;
66:begin 66:begin
dev := 11; dev := 11;
mix := 20000; mix := 20000;
end; end;
67:begin 67:begin
dev := 0; dev := 0;
writeln; writeln;
write('Enter Sample-Frequence (<=44000 kHz): '); write('Enter Sample-Frequence (<=44000 kHz): ');
readln(mix); readln(mix);
end; end;
68:begin 68:begin
dev := 7; dev := 7;
writeln; writeln;
write('Enter Sample-Frequence (<=20000 kHz): '); write('Enter Sample-Frequence (<=20000 kHz): ');
readln(mix); readln(mix);
end; end;
end; end;
if (dev<>255) then begin if (dev<>255) then begin
if paramcount=1 then begin if paramcount=1 then begin
md:=paramstr(1); md:=paramstr(1);
end else begin end else begin
md:='pho.rsc'; md:='pho.rsc';
end; end;
pro := 0; {Leave at 0} pro := 0; {Leave at 0}
loop :=4; {4 means mod will play forever} loop :=4; {4 means mod will play forever}
modvolume (255,255,255,255); { Full volume } modvolume (255,255,255,255); { Full volume }
end; end;
case InitTextGraf of case InitTextGraf of
1: begin end; 1: begin end;
end; end;
GrafikMode($13); GrafikMode($13);
for w:=0 to 63999 do mem[$A000:w]:=0; for w:=0 to 63999 do mem[$A000:w]:=0;
for i:=0 to 255 do for j:=0 to 2 do for i:=0 to 255 do for j:=0 to 2 do
l[i,j]:=0; l[i,j]:=0;
setvgacolors(l); setvgacolors(l);
for w:=0 to 63999 do mem[$A000:w]:=mem[seg(phofnt):ofs(phofnt)+w]; 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 j:=0 to 1 do for i:=0 to 18 do
for x:=0 to 15 do for y:=0 to 17 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]; 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 j:=2; for i:=0 to 18 do
for x:=0 to 15 do for y:=0 to 17 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]; 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 w:=0 to 63999 do mem[$A000:w]:=mem[seg(phopic):ofs(phopic)+w];
for i:=1 to 6 do for i:=1 to 6 do
writeline(53+i*20,text[i]); writeline(53+i*20,text[i]);
move(mem[seg(phopal):ofs(phopal)],p,sizeof(p)); move(mem[seg(phopal):ofs(phopal)],p,sizeof(p));
k:=0;ri:=0;r:=0; k:=0;ri:=0;r:=0;
for x:=(40 div FADE_SPEED) downto 0 do begin for x:=(40 div FADE_SPEED) downto 0 do begin
ch_pal; ch_pal;
for i:=0 to 255 do for j:=0 to 2 do begin for i:=0 to 255 do for j:=0 to 2 do begin
l[i,j]:=p[i,j]-x*FADE_SPEED; l[i,j]:=p[i,j]-x*FADE_SPEED;
if l[i,j]>p[i,j] then l[i,j]:=0; if l[i,j]>p[i,j] then l[i,j]:=0;
end; end;
repeat until port[$3da] and 8 = 8; repeat until port[$3da] and 8 = 8;
setvgacolors(l); setvgacolors(l);
end; end;
ch:='@'; ch:='@';
txtz:=0;txti:=0; txtz:=0;txti:=0;
if (dev<>255) then modsetup ( stat, dev, mix, pro, loop, md ); if (dev<>255) then modsetup ( stat, dev, mix, pro, loop, md );
STI; STI;
repeat repeat
inc(txtz); inc(txtz);
if txtz>150 then begin if txtz>150 then begin
txtz:=0; txtz:=0;
j:=txti; j:=txti;
inc(txti); inc(txti);
if txti=TANZ then txti:=0; if txti=TANZ then txti:=0;
for i:=1 to 6 do begin for i:=1 to 6 do begin
ch_pal; ch_pal;
setvgacolors(p); setvgacolors(p);
writeback(53+i*20,text[i+j*6]); writeback(53+i*20,text[i+j*6]);
ch_pal; ch_pal;
setvgacolors(p); setvgacolors(p);
writeline(53+i*20,text[i+txti*6]); writeline(53+i*20,text[i+txti*6]);
end; end;
end; end;
inc(k); inc(k);
if k=3 then begin if k=3 then begin
k:=0; k:=0;
for i:=0 to 2 do cyc[i]:=p[94,i]; for i:=0 to 2 do cyc[i]:=p[94,i];
for j:=93 downto 80 do 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[j+1,i]:=p[j,i];
for i:=0 to 2 do p[80,i]:=cyc[i]; for i:=0 to 2 do p[80,i]:=cyc[i];
end; end;
for y:=0 to 1 do for y:=0 to 1 do
for x:=1 to 5 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 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 y:=0 to 1 do
for x:=1 to 5 do for x:=1 to 5 do
for j:=1 to 4 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 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 y:=0 to 1 do
for x:=1 to 5 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)]; for i:=0 to 2 do p[16+x-1+y*25,i]:=cy2[i,(x+rot[y]*5)];
ri:=ri+1; ri:=ri+1;
if ri>372 then ri:=ri-372; if ri>372 then ri:=ri-372;
if sin(ri*6.3)*15<0 then begin if sin(ri*6.3)*15<0 then begin
r:=r-sin(ri*6.3)*15; r:=r-sin(ri*6.3)*15;
rb:=FALSE; rb:=FALSE;
end else begin end else begin
r:=r+sin(ri*6.3)*15; r:=r+sin(ri*6.3)*15;
rb:=TRUE; rb:=TRUE;
end; end;
if r>20 then begin if r>20 then begin
r:=r-20; r:=r-20;
if rb then begin if rb then begin
for y:=0 to 1 do for y:=0 to 1 do
for x:=1 to 5 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 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 y:=0 to 1 do
for j:=1 to 4 do for j:=1 to 4 do
for x:=1 to 5 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 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 y:=0 to 1 do
for x:=1 to 5 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]; for i:=0 to 2 do p[20+(x-1)*5+y*25-4,i]:=cy2[i,x+rot[y]*5];
end else begin end else begin
for y:=0 to 1 do for y:=0 to 1 do
for x:=1 to 5 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 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 y:=0 to 1 do
for j:=1 to 4 do for j:=1 to 4 do
for x:=1 to 5 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 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 y:=0 to 1 do
for x:=1 to 5 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]; for i:=0 to 2 do p[20+(x-1)*5+y*25,i]:=cy2[i,x+rot[y]*5];
end; end;
end; end;
repeat until port[$3da] and 8 = 8; repeat until port[$3da] and 8 = 8;
setvgacolors(p); setvgacolors(p);
until keypressed; until keypressed;
ch:=readkey; ch:=readkey;
CLI; CLI;
if (dev<>255) then modstop; if (dev<>255) then modstop;
for x:=1 to (40 div FADE_SPEED) do begin for x:=1 to (40 div FADE_SPEED) do begin
ch_pal; ch_pal;
for i:=0 to 255 do for j:=0 to 2 do begin 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); if p[i,j]<FADE_SPEED then p[i,j]:=0 else dec(p[i,j],FADE_SPEED);
end; end;
repeat until port[$3da] and 8 = 8; repeat until port[$3da] and 8 = 8;
setvgacolors(p); setvgacolors(p);
end; end;
for w:=0 to 63999 do mem[$A000:w]:=0; for w:=0 to 63999 do mem[$A000:w]:=0;
TEXTMODE(co80); TEXTMODE(co80);
clrscr; clrscr;
writeln('Intro by: Stefan Koelle of Phobia * Version '+VERSION); writeln('Intro by: Stefan Koelle of Phobia * Version '+VERSION);
STI; STI;
end. end.
PHO.RSC → source/PHO.RSC
View File
PHOFNT.OBJ → source/PHOFNT.OBJ
View File
PHOPAL.OBJ → source/PHOPAL.OBJ
View File
PHOPIC.OBJ → source/PHOPIC.OBJ
View File
PHO_U.PAS → source/PHO_U.PAS
+10 -10
View File
@@ -1,11 +1,11 @@
unit pho_u; unit pho_u;
INTERFACE INTERFACE
procedure phopic; procedure phopic;
procedure phopal; procedure phopal;
IMPLEMENTATION IMPLEMENTATION
procedure phopic;external procedure phopic;external
{$L phopic.obj}; {$L phopic.obj};
procedure phopal;external procedure phopal;external
{$L phopal.obj}; {$L phopal.obj};
begin begin
end. end.
PHO_U.TPU → source/PHO_U.TPU
View File
PHO_U2.PAS → source/PHO_U2.PAS
+7 -7
View File
@@ -1,8 +1,8 @@
unit pho_u2; unit pho_u2;
INTERFACE INTERFACE
procedure phofnt; procedure phofnt;
IMPLEMENTATION IMPLEMENTATION
procedure phofnt;external procedure phofnt;external
{$L phofnt.obj}; {$L phofnt.obj};
begin begin
end. end.
PHO_U2.TPU → source/PHO_U2.TPU
View File
TEXTGRAF.PAS → source/TEXTGRAF.PAS
+323 -323
View File
@@ -1,323 +1,323 @@
unit TextGraf; unit TextGraf;
interface interface
uses dos; uses dos;
type type
MonitorTyp = (Hercules, EGA, VGA, other); MonitorTyp = (Hercules, EGA, VGA, other);
VGAColorInfo = array[0..2] of byte; { eine VGA-Farbe: nur f�r Demo } VGAColorInfo = array[0..2] of byte; { eine VGA-Farbe: nur f�r Demo }
VGAColors = array[0..255] of VGAColorInfo; { alle VGA-Farben: dito } VGAColors = array[0..255] of VGAColorInfo; { alle VGA-Farben: dito }
function InitTextGraf: integer; function InitTextGraf: integer;
{ Muá ganz zu Anfang des Programms, noch im Textmodus aufgerufen { Muá ganz zu Anfang des Programms, noch im Textmodus aufgerufen
werden. Ohne das funktioniert der Rest nicht. Ergebnis 0: Alles Ok, werden. Ohne das funktioniert der Rest nicht. Ergebnis 0: Alles Ok,
unbekannter Videotyp: -1, zuwenig Speicher: 1 (Bedarf ca. 12Kb) } unbekannter Videotyp: -1, zuwenig Speicher: 1 (Bedarf ca. 12Kb) }
procedure SetPaletteSave(On: boolean); procedure SetPaletteSave(On: boolean);
{ Mit On = true nach InitTextGraf und im Textmodus aufrufen. Sichert die { Mit On = true nach InitTextGraf und im Textmodus aufrufen. Sichert die
Textpalette und reserviert Speicher f�r die Grafikpalette, die dann Textpalette und reserviert Speicher f�r die Grafikpalette, die dann
automatisch verwendet werden. On = false schaltet diese Automatik automatisch verwendet werden. On = false schaltet diese Automatik
wieder ab und gibt den Speicher f�r die Paletten (ca. 1.5Kb) frei.} wieder ab und gibt den Speicher f�r die Paletten (ca. 1.5Kb) frei.}
procedure ToText; procedure ToText;
{ Schaltet vom Grafik- in den Testmodus. Bildspeicher etc. werden in { Schaltet vom Grafik- in den Testmodus. Bildspeicher etc. werden in
Sicherheit gebracht } Sicherheit gebracht }
procedure ToGraph; procedure ToGraph;
{ Schaltet in die Grafik zur�ck. Vorher sollte ein Grafikmodus mit { Schaltet in die Grafik zur�ck. Vorher sollte ein Grafikmodus mit
ToText verlassen worden sein, um alle Werte zu initialisieren } ToText verlassen worden sein, um alle Werte zu initialisieren }
procedure GrafikMode(Mode: byte); procedure GrafikMode(Mode: byte);
{ nur f�r das Demoprogramm. Kann gel”scht werden, wenn BGI-Routinen { nur f�r das Demoprogramm. Kann gel”scht werden, wenn BGI-Routinen
(InitGraph) verwendet werden } (InitGraph) verwendet werden }
function GetMonTyp: MonitorTyp; function GetMonTyp: MonitorTyp;
{ dito } { dito }
procedure SetVGAColors(var Colors: VGAColors); procedure SetVGAColors(var Colors: VGAColors);
{ dito } { dito }
implementation implementation
type type
ScreenArray = array[0..3999] of word; { Bildspeicher bei 80x25 } ScreenArray = array[0..3999] of word; { Bildspeicher bei 80x25 }
CharGenArray = array[0..8191] of byte; { Zeichengenerator } CharGenArray = array[0..8191] of byte; { Zeichengenerator }
ModeType = (Text, Grafik, unknown); ModeType = (Text, Grafik, unknown);
var var
regs: registers; { f�r intr } regs: registers; { f�r intr }
CharGen: CharGenArray absolute $A000:0; { Adresse Zeichengenerator } CharGen: CharGenArray absolute $A000:0; { Adresse Zeichengenerator }
BMode: byte absolute $40:$49; { Bios-Videomode } BMode: byte absolute $40:$49; { Bios-Videomode }
const const
VModus: ModeType = unknown; VModus: ModeType = unknown;
VMonitor: MonitorTyp = other; { Vorgabe: nichts gutes } VMonitor: MonitorTyp = other; { Vorgabe: nichts gutes }
TScreen: ^ScreenArray = nil; { zeigt in den Bildspeicher } TScreen: ^ScreenArray = nil; { zeigt in den Bildspeicher }
ScrBuf: ^ScreenArray = nil; { speichert Textschirm zwischen } ScrBuf: ^ScreenArray = nil; { speichert Textschirm zwischen }
CGBuf: ^CharGenArray = nil; { speichert Zeichengenerator } CGBuf: ^CharGenArray = nil; { speichert Zeichengenerator }
ModeNr: byte = $FF; { Kennung f�r Init } ModeNr: byte = $FF; { Kennung f�r Init }
TMode: byte = $FF; { der zu restaurierende Textmodus } TMode: byte = $FF; { der zu restaurierende Textmodus }
GMode: byte = $FF; { dito Grafikmodus } GMode: byte = $FF; { dito Grafikmodus }
VGATextPal: ^VGAColors = nil; VGATextPal: ^VGAColors = nil;
VGAGraphPal: ^VGAColors = nil; VGAGraphPal: ^VGAColors = nil;
function IsVga: boolean; { haben wir VGA } function IsVga: boolean; { haben wir VGA }
begin begin
with regs do with regs do
begin begin
AX:= $1A00; { Display Combination abfragen } AX:= $1A00; { Display Combination abfragen }
Intr($10, regs); Intr($10, regs);
IsVga:= (AL = $1A); { g�ltiger Aufruf } IsVga:= (AL = $1A); { g�ltiger Aufruf }
end; end;
end; end;
function IsEGA: boolean; { liegt wenigstens EGA vor } function IsEGA: boolean; { liegt wenigstens EGA vor }
begin begin
with regs do with regs do
begin begin
AH:= $12; { Funktion $12 } AH:= $12; { Funktion $12 }
BL:= $10; { get EGA Information } BL:= $10; { get EGA Information }
Intr($10, regs); Intr($10, regs);
IsEga:= (BL <> $10); { hat sich was ge„ndert ? } IsEga:= (BL <> $10); { hat sich was ge„ndert ? }
end; end;
end; end;
procedure GetVGAColors(var Colors: VGAColors); procedure GetVGAColors(var Colors: VGAColors);
begin begin
with regs do with regs do
begin begin
ax:= $1017; ax:= $1017;
bx:= 0; bx:= 0;
cx:= 255; cx:= 255;
es:= seg(Colors); es:= seg(Colors);
dx:= ofs(Colors); dx:= ofs(Colors);
intr($10, regs); intr($10, regs);
end; end;
end; end;
procedure SetVGAColors(var Colors: VGAColors); procedure SetVGAColors(var Colors: VGAColors);
begin begin
with regs do with regs do
begin begin
ax:= $1012; ax:= $1012;
bx:= 0; bx:= 0;
cx:= 255; cx:= 255;
es:= seg(Colors); es:= seg(Colors);
dx:= ofs(Colors); dx:= ofs(Colors);
intr($10, regs); intr($10, regs);
end; end;
end; end;
procedure NoInitStop; procedure NoInitStop;
begin begin
writeln('TextGraph ist nicht initialisiert! Benutzen Sie InitTextGraph!'); writeln('TextGraph ist nicht initialisiert! Benutzen Sie InitTextGraph!');
halt(2); halt(2);
end; end;
procedure HercTextMode; procedure HercTextMode;
var i: integer; var i: integer;
ModeReg: byte absolute 0:$465; ModeReg: byte absolute 0:$465;
const HData: array[0..13] of byte = { Timingdaten! Nicht ver„ndern! } 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); ($61,$50,$52,$0f,$19,$06,$19,$19,$02,$0d,$0b,$0c,0,0);
begin begin
port[$3bf]:= 0; { Config Reg: HalfMode: eine Seite (3 f�r Full Mode) } port[$3bf]:= 0; { Config Reg: HalfMode: eine Seite (3 f�r Full Mode) }
port[$3b8]:= $21; { Mode Control: Dunkel, Text, 80x25 } port[$3b8]:= $21; { Mode Control: Dunkel, Text, 80x25 }
for i:= 0 to 13 do { die Timing-Daten komplett } for i:= 0 to 13 do { die Timing-Daten komplett }
begin begin
port[$3b4]:= i; { Index Laden (Register einblenden) } port[$3b4]:= i; { Index Laden (Register einblenden) }
port[$3b5]:= HData[i]; { Wert schreiben } port[$3b5]:= HData[i]; { Wert schreiben }
end; end;
port[$3b8]:= $29; { ModeControl: Hell, Text, 80x25 } port[$3b8]:= $29; { ModeControl: Hell, Text, 80x25 }
ModeReg:= $29; { im BIOS-Ram protokollieren } ModeReg:= $29; { im BIOS-Ram protokollieren }
end; end;
procedure HercGraphMode; procedure HercGraphMode;
var i: integer; var i: integer;
ModeReg: byte absolute 0:$465; ModeReg: byte absolute 0:$465;
const HData: array[0..13] of byte = { Timingdaten! Nicht ver„ndern! } 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); ($35,$2d,$2e,$07,$5b,$02,$57,$57,$02,$03,0,0,0,0);
begin begin
port[$3bf]:= 1; { Config Reg: HalfMode: eine Seite (3 f�r Full Mode) } port[$3bf]:= 1; { Config Reg: HalfMode: eine Seite (3 f�r Full Mode) }
port[$3b8]:= 2; { Mode Control: Dunkel, Grafik, Seite 0 } port[$3b8]:= 2; { Mode Control: Dunkel, Grafik, Seite 0 }
for i:= 0 to 13 do { die Timing-Daten komplett } for i:= 0 to 13 do { die Timing-Daten komplett }
begin begin
port[$3b4]:= i; { Index Laden (Register einblenden) } port[$3b4]:= i; { Index Laden (Register einblenden) }
port[$3b5]:= HData[i]; { Wert schreiben } port[$3b5]:= HData[i]; { Wert schreiben }
end; end;
port[$3b8]:= $0a; { ModeControl: Hell, Grafik, Seite 0 } port[$3b8]:= $0a; { ModeControl: Hell, Grafik, Seite 0 }
ModeReg:= $0a; { im BIOS-Ram protokollieren } ModeReg:= $0a; { im BIOS-Ram protokollieren }
end; end;
procedure GrafikMode(Mode: byte); { Setzt den Videomodus, nur f�r Demo } procedure GrafikMode(Mode: byte); { Setzt den Videomodus, nur f�r Demo }
var i: integer; var i: integer;
begin begin
if VMonitor <> Hercules then { alle auáer Hercules sind sehr einfach } if VMonitor <> Hercules then { alle auáer Hercules sind sehr einfach }
with regs do with regs do
begin begin
AX:= Mode; { AH:= 0; AL:= Mode } AX:= Mode; { AH:= 0; AL:= Mode }
Intr($10, regs); Intr($10, regs);
end end
else else
begin begin
HercGraphMode; HercGraphMode;
fillchar(ptr($B000,0)^, $8000, 0); { Clearscreen } fillchar(ptr($B000,0)^, $8000, 0); { Clearscreen }
end; end;
end; end;
function GetMonTyp: MonitorTyp; { Zugriffsfunktion, nur f�r das Demo } function GetMonTyp: MonitorTyp; { Zugriffsfunktion, nur f�r das Demo }
begin begin
GetMonTyp:= VMonitor; GetMonTyp:= VMonitor;
end; end;
procedure ToTextVGA; { sichert den Teil des Grafik-Bildspeichers, der } procedure ToTextVGA; { sichert den Teil des Grafik-Bildspeichers, der }
var b: byte; { vom Zeichengenerator �berschrieben wird } var b: byte; { vom Zeichengenerator �berschrieben wird }
begin begin
regs.ax:= $90; { Standardmodus setzen um Zugriff sicherzustellen } regs.ax:= $90; { Standardmodus setzen um Zugriff sicherzustellen }
intr($10, regs); { Bildspeicher bleibt erhalten } intr($10, regs); { Bildspeicher bleibt erhalten }
Port[$3ce]:= 4; { Read Map Select holen } Port[$3ce]:= 4; { Read Map Select holen }
b:= Port[$3cf]; { lesen } b:= Port[$3cf]; { lesen }
Port[$3cf]:= 2; { Plane 2 ein } Port[$3cf]:= 2; { Plane 2 ein }
CGBuf^:= CharGen; { Grafikinhalt von Zeichengenerator sichern } CGBuf^:= CharGen; { Grafikinhalt von Zeichengenerator sichern }
Port[$3cf]:= b; { Wert zur�ck } Port[$3cf]:= b; { Wert zur�ck }
end; end;
procedure ToTextEGA; { wie oben jedoch Variante f�r EGA, } procedure ToTextEGA; { wie oben jedoch Variante f�r EGA, }
var b: byte; { deren Register nicht lesbar sind } var b: byte; { deren Register nicht lesbar sind }
begin begin
regs.ax:= $90; { Standardmodus setzen um Zugriff sicherzustellen } regs.ax:= $90; { Standardmodus setzen um Zugriff sicherzustellen }
intr($10, regs); { Bildspeicher bleibt erhalten } intr($10, regs); { Bildspeicher bleibt erhalten }
Port[$3ce]:= 4; { Read Map Select holen } Port[$3ce]:= 4; { Read Map Select holen }
Port[$3cf]:= 2; { Plane 2 ein } Port[$3cf]:= 2; { Plane 2 ein }
CGBuf^:= CharGen; { Grafikinhalt von Zeichengenerator sichern } CGBuf^:= CharGen; { Grafikinhalt von Zeichengenerator sichern }
Port[$3cf]:= 0; { Default zur�ck } Port[$3cf]:= 0; { Default zur�ck }
end; end;
procedure ToGraphVGA; { �berschreibt den Zeichengenerator mit } procedure ToGraphVGA; { �berschreibt den Zeichengenerator mit }
var b: byte; { gesicherten Grafikinhalt } var b: byte; { gesicherten Grafikinhalt }
begin begin
regs.ax:= $90; { Standardmodus setzen um Zugriff sicherzustellen } regs.ax:= $90; { Standardmodus setzen um Zugriff sicherzustellen }
intr($10, regs); { Bildspeicher bleibt erhalten } intr($10, regs); { Bildspeicher bleibt erhalten }
Port[$3C4]:= 2; { Map Mask Register holen } Port[$3C4]:= 2; { Map Mask Register holen }
b:= Port[$3c5]; { lesen } b:= Port[$3c5]; { lesen }
Port[$3c5]:= 4; { Plane 2 ein } Port[$3c5]:= 4; { Plane 2 ein }
CharGen:= CGBuf^; { Zeichengenerator zur�ck } CharGen:= CGBuf^; { Zeichengenerator zur�ck }
Port[$3c5]:= b; { Wert zur�ck } Port[$3c5]:= b; { Wert zur�ck }
end; end;
procedure ToGraphEGA; { wie oben jedoch Variante f�r EGA, } procedure ToGraphEGA; { wie oben jedoch Variante f�r EGA, }
var b: byte; { deren Register nicht lesbar sind } var b: byte; { deren Register nicht lesbar sind }
begin begin
regs.ax:= $90; { Standardmodus setzen um Zugriff sicherzustellen } regs.ax:= $90; { Standardmodus setzen um Zugriff sicherzustellen }
intr($10, regs); { Bildspeicher bleibt erhalten } intr($10, regs); { Bildspeicher bleibt erhalten }
Port[$3C4]:= 2; { Map Mask Register holen } Port[$3C4]:= 2; { Map Mask Register holen }
Port[$3c5]:= 4; { Plane 2 ein } Port[$3c5]:= 4; { Plane 2 ein }
CharGen:= CGBuf^; { Zeichengenerator kopieren } CharGen:= CGBuf^; { Zeichengenerator kopieren }
Port[$3c5]:= 0; { Default zur�ck } Port[$3c5]:= 0; { Default zur�ck }
end; end;
function InitTextGraf: integer; { ermittelt Monitor, setzt Variablen, } function InitTextGraf: integer; { ermittelt Monitor, setzt Variablen, }
begin { reserviert Speicher } begin { reserviert Speicher }
InitTextGraf:= 0; InitTextGraf:= 0;
if ModeNr <> $FF then exit; { wurde schon aufgerufen, alles ok } if ModeNr <> $FF then exit; { wurde schon aufgerufen, alles ok }
InitTextGraf:= -1; { Fehlervorgabe: falsche Karte } InitTextGraf:= -1; { Fehlervorgabe: falsche Karte }
if IsEGA then VMonitor:= EGA; { EGA ? } if IsEGA then VMonitor:= EGA; { EGA ? }
if IsVGA then VMonitor:= VGA; { oder VGA ? } if IsVGA then VMonitor:= VGA; { oder VGA ? }
TMode:= BMode and $7f; TMode:= BMode and $7f;
if TMode = 7 then if TMode = 7 then
begin begin
TScreen:= ptr($B000,0); { Bildspeicheradresse Text mono setzen } TScreen:= ptr($B000,0); { Bildspeicheradresse Text mono setzen }
if VMonitor = other then { keines von beiden: } if VMonitor = other then { keines von beiden: }
begin begin
VMonitor:= Hercules; { dann Hercules, (evtl Probleme mit CGA-Mono)} VMonitor:= Hercules; { dann Hercules, (evtl Probleme mit CGA-Mono)}
GMode:= 7; { Modi alle 7 } GMode:= 7; { Modi alle 7 }
end; end;
end else end else
TScreen:= ptr($B800,0); { Bildspeicheradresse Text farbig setzen } TScreen:= ptr($B800,0); { Bildspeicheradresse Text farbig setzen }
if VMonitor = other then exit; { was anderes? geht nicht! } if VMonitor = other then exit; { was anderes? geht nicht! }
InitTextGraf:= 1; { Fehlervorgabe: kein Speicher } InitTextGraf:= 1; { Fehlervorgabe: kein Speicher }
if VMonitor in [EGA, VGA] then if VMonitor in [EGA, VGA] then
begin { Vorgaben f�r EGA & VGA } begin { Vorgaben f�r EGA & VGA }
GMode:= $10; { Grafik 640x350 } GMode:= $10; { Grafik 640x350 }
if MaxAvail >= sizeof(CGBuf) then { Speicher f�r Puffer belegen } if MaxAvail >= sizeof(CGBuf) then { Speicher f�r Puffer belegen }
New(CGBuf) New(CGBuf)
else else
exit; { raus mit Fehler 1 } exit; { raus mit Fehler 1 }
end; end;
if MaxAvail >= sizeof(ScrBuf) then { noch mehr } if MaxAvail >= sizeof(ScrBuf) then { noch mehr }
New(ScrBuf) New(ScrBuf)
else else
exit; { raus mit Fehler 1 } exit; { raus mit Fehler 1 }
ModeNr:= TMode; { Initialisierung merken } ModeNr:= TMode; { Initialisierung merken }
InitTextGraf:= 0; { alles ok } InitTextGraf:= 0; { alles ok }
end; end;
procedure SetPaletteSave(On: boolean); procedure SetPaletteSave(On: boolean);
{ aktiviert oder deaktiviert die automatische Palettensicherung } { aktiviert oder deaktiviert die automatische Palettensicherung }
begin begin
if ModeNr = $FF then NoInitStop; { schon Init ? } if ModeNr = $FF then NoInitStop; { schon Init ? }
if On then if On then
begin begin
if VGATextPal = nil then { gibts schon ? } if VGATextPal = nil then { gibts schon ? }
new(VGATextPal); { nein, neu } new(VGATextPal); { nein, neu }
if VGAGraphPal = nil then { dito Grafikpalette } if VGAGraphPal = nil then { dito Grafikpalette }
new(VGAGraphPal); new(VGAGraphPal);
GetVGAColors(VGATextPal^); { Textfarben holen } GetVGAColors(VGATextPal^); { Textfarben holen }
end else end else
begin begin
if VGATextPal <> nil then { was da ? } if VGATextPal <> nil then { was da ? }
begin begin
dispose(VGATextPal); { freigeben } dispose(VGATextPal); { freigeben }
VGATextPal:= nil; { und kennzeichnen } VGATextPal:= nil; { und kennzeichnen }
end; end;
if VGAGraphPal <> nil then { andere auch } if VGAGraphPal <> nil then { andere auch }
begin begin
dispose(VGAGraphPal); dispose(VGAGraphPal);
VGAGraphPal:= nil; VGAGraphPal:= nil;
end; end;
end; end;
end; end;
procedure ToText; { Schaltet in Textmodus, bringt, was �berschrieben } procedure ToText; { Schaltet in Textmodus, bringt, was �berschrieben }
begin { wird in Sicherheit } begin { wird in Sicherheit }
if ModeNr = $FF then NoInitStop; { schon Init ? } if ModeNr = $FF then NoInitStop; { schon Init ? }
GMode:= BMode; { Grafikmodus merken } GMode:= BMode; { Grafikmodus merken }
case VMonitor of case VMonitor of
VGA: begin VGA: begin
if VGAGraphPal <> nil then if VGAGraphPal <> nil then
GetVGAColors(VGAGraphPal^); GetVGAColors(VGAGraphPal^);
ToTextVGA; { Zeichengeneratorbereich sichern } ToTextVGA; { Zeichengeneratorbereich sichern }
end; end;
EGA: ToTextEGA; EGA: ToTextEGA;
end; {case} end; {case}
if VMonitor = Hercules then if VMonitor = Hercules then
HercTextMode { Hercules Textmodus ohne Bildspeicher l”schen } HercTextMode { Hercules Textmodus ohne Bildspeicher l”schen }
else else
begin begin
regs.ax:= TMode or $80; { Text, Bit 7 = 1: Bildspeicher nicht l”schen } regs.ax:= TMode or $80; { Text, Bit 7 = 1: Bildspeicher nicht l”schen }
intr($10, regs); intr($10, regs);
if (VMonitor = VGA) and (VGATextPal <> nil) then if (VMonitor = VGA) and (VGATextPal <> nil) then
SetVGAColors(VGATextPal^); SetVGAColors(VGATextPal^);
end; end;
scrbuf^:= TScreen^; { Grafikinhalt von Textschirm sichern } scrbuf^:= TScreen^; { Grafikinhalt von Textschirm sichern }
VModus:= Text; VModus:= Text;
end; end;
procedure ToGraph; { versucht den Grafikmodus zu restaurieren } procedure ToGraph; { versucht den Grafikmodus zu restaurieren }
begin begin
if ModeNr = $FF then NoInitStop; { schon Init ? } if ModeNr = $FF then NoInitStop; { schon Init ? }
TMode:= BMode; TMode:= BMode;
TScreen^:= ScrBuf^; { Grafikinhalt zur�ck in Textbildschirm f�llen } TScreen^:= ScrBuf^; { Grafikinhalt zur�ck in Textbildschirm f�llen }
case VMonitor of case VMonitor of
VGA: begin VGA: begin
if VGATextPal <> nil then if VGATextPal <> nil then
GetVGAColors(VGATextPal^); GetVGAColors(VGATextPal^);
ToGraphVGA; { dito Zeichengenerator } ToGraphVGA; { dito Zeichengenerator }
end; end;
EGA: ToGraphEGA; EGA: ToGraphEGA;
end; {case} end; {case}
if VMonitor = Hercules then if VMonitor = Hercules then
HercGraphMode { Hercules handmade Grafikmodus } HercGraphMode { Hercules handmade Grafikmodus }
else else
begin begin
regs.ax:= GMode or $80; { Text, Bit 7 = 1: Bildspeicher nicht l”schen } regs.ax:= GMode or $80; { Text, Bit 7 = 1: Bildspeicher nicht l”schen }
intr($10, regs); intr($10, regs);
if (VMonitor = VGA) and (VGAGraphPal <> nil) then if (VMonitor = VGA) and (VGAGraphPal <> nil) then
SetVGAColors(VGAGraphPal^); SetVGAColors(VGAGraphPal^);
end; end;
VModus:= Grafik; VModus:= Grafik;
end; end;
end. end.
TEXTGRAF.TPU → source/TEXTGRAF.TPU
View File