From 1b87dd064fd2e6b9a9c9afbd770cb5f84de727cc Mon Sep 17 00:00:00 2001 From: Stefan Koelle Date: Fri, 3 Jan 2025 20:14:10 +0100 Subject: [PATCH] Moved into subfolders --- screenshot.png => images/screenshot.png | Bin COMPILE.BAT => source/COMPILE.BAT | 0 MOD-OBJ.OBJ => source/MOD-OBJ.OBJ | Bin PHO.PAS => source/PHO.PAS | 860 ++++++++++++------------ PHO.RSC => source/PHO.RSC | Bin PHOFNT.OBJ => source/PHOFNT.OBJ | Bin PHOPAL.OBJ => source/PHOPAL.OBJ | Bin PHOPIC.OBJ => source/PHOPIC.OBJ | Bin PHO_U.PAS => source/PHO_U.PAS | 20 +- PHO_U.TPU => source/PHO_U.TPU | Bin PHO_U2.PAS => source/PHO_U2.PAS | 14 +- PHO_U2.TPU => source/PHO_U2.TPU | Bin TEXTGRAF.PAS => source/TEXTGRAF.PAS | 646 +++++++++--------- TEXTGRAF.TPU => source/TEXTGRAF.TPU | Bin 14 files changed, 770 insertions(+), 770 deletions(-) rename screenshot.png => images/screenshot.png (100%) rename COMPILE.BAT => source/COMPILE.BAT (100%) rename MOD-OBJ.OBJ => source/MOD-OBJ.OBJ (100%) rename PHO.PAS => source/PHO.PAS (96%) rename PHO.RSC => source/PHO.RSC (100%) rename PHOFNT.OBJ => source/PHOFNT.OBJ (100%) rename PHOPAL.OBJ => source/PHOPAL.OBJ (100%) rename PHOPIC.OBJ => source/PHOPIC.OBJ (100%) rename PHO_U.PAS => source/PHO_U.PAS (94%) rename PHO_U.TPU => source/PHO_U.TPU (100%) rename PHO_U2.PAS => source/PHO_U2.PAS (93%) rename PHO_U2.TPU => source/PHO_U2.TPU (100%) rename TEXTGRAF.PAS => source/TEXTGRAF.PAS (97%) rename TEXTGRAF.TPU => source/TEXTGRAF.TPU (100%) diff --git a/screenshot.png b/images/screenshot.png similarity index 100% rename from screenshot.png rename to images/screenshot.png diff --git a/COMPILE.BAT b/source/COMPILE.BAT similarity index 100% rename from COMPILE.BAT rename to source/COMPILE.BAT diff --git a/MOD-OBJ.OBJ b/source/MOD-OBJ.OBJ similarity index 100% rename from MOD-OBJ.OBJ rename to source/MOD-OBJ.OBJ diff --git a/PHO.PAS b/source/PHO.PAS similarity index 96% rename from PHO.PAS rename to source/PHO.PAS index 32ea494..e4f7c6b 100644 --- a/PHO.PAS +++ b/source/PHO.PAS @@ -1,431 +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 unterdrcken } -procedure STI; inline( $FB ); { Interrupts wieder erlauben } -begin - CLI; - modinit; - clrscr; - writeln('PHOB­A 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]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 unterdrcken } +procedure STI; inline( $FB ); { Interrupts wieder erlauben } +begin + CLI; + modinit; + clrscr; + writeln('PHOB­A 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] $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 fr 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 fr 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 fr 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 fr 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 zurck } -end; - -procedure ToTextEGA; { wie oben jedoch Variante fr 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 zurck } -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 zurck } - Port[$3c5]:= b; { Wert zurck } -end; - -procedure ToGraphEGA; { wie oben jedoch Variante fr 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 zurck } -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 fr EGA & VGA } - GMode:= $10; { Grafik 640x350 } - if MaxAvail >= sizeof(CGBuf) then { Speicher fr 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 zurck in Textbildschirm fllen } - 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. + unit TextGraf; +interface +uses dos; +type + MonitorTyp = (Hercules, EGA, VGA, other); + VGAColorInfo = array[0..2] of byte; { eine VGA-Farbe: nur fr 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 fr die Grafikpalette, die dann + automatisch verwendet werden. On = false schaltet diese Automatik + wieder ab und gibt den Speicher fr 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 zurck. Vorher sollte ein Grafikmodus mit + ToText verlassen worden sein, um alle Werte zu initialisieren } + + procedure GrafikMode(Mode: byte); + { nur fr 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; { fr 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 fr 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); { gltiger 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 fr 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 fr 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 fr 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 fr 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 zurck } +end; + +procedure ToTextEGA; { wie oben jedoch Variante fr 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 zurck } +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 zurck } + Port[$3c5]:= b; { Wert zurck } +end; + +procedure ToGraphEGA; { wie oben jedoch Variante fr 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 zurck } +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 fr EGA & VGA } + GMode:= $10; { Grafik 640x350 } + if MaxAvail >= sizeof(CGBuf) then { Speicher fr 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 zurck in Textbildschirm fllen } + 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. diff --git a/TEXTGRAF.TPU b/source/TEXTGRAF.TPU similarity index 100% rename from TEXTGRAF.TPU rename to source/TEXTGRAF.TPU