Add files via upload

This commit is contained in:
Stefan Koelle
2025-01-04 18:39:33 +01:00
committed by GitHub
parent 85ff662d23
commit b842430a7c
28 changed files with 1677 additions and 0 deletions
+11
View File
@@ -0,0 +1,11 @@
unit amn;
INTERFACE
procedure tcmamn;
procedure tcmpal;
IMPLEMENTATION
procedure tcmamn;external
{$L tcmamn.obj};
procedure tcmpal;external
{$L tcmpal.obj};
begin
end.
+3
View File
@@ -0,0 +1,3 @@
c:\progs\tp\tpc amn.pas
c:\progs\tp\tpc textgraf.pas
c:\progs\tp\tpc logo-int.pas
Binary file not shown.
Binary file not shown.
+323
View File
@@ -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 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.
Binary file not shown.
+257
View File
@@ -0,0 +1,257 @@
{$A-,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
{$M 16384,0,655360}
uses crt,textgraf,WOWTPU,WOWCONST,amn;
type
lpi = array[0..2] of byte;
lp = array[0..255] of lpi;
var
speed:integer;
k,i,j,x,y,anz,h1,h2,texti : integer;
l : lp;
p : vgacolors;
s : string;
ch:char;
textp:boolean;
font : array[0..80, 0..7, 0..7] of byte;
font2: array[0..80,0..15,0..15] of byte;
SBPort: word;
flag:integer;
lint:longint;
const text:array[1..15] of string = (''' TCM PRESENTS ''',
''' A NEW INTRO ''',
'''CODE/GFX/MUSIC BY ''',
''' STEFAN KOELLE ''',
''' RELEASED 1993 ''',
''' IN TURBO PASCAL ''',
''' AND ASSEMBLER ''',
''' GREETINGS TO ''',
'''MATTHIAS AND MAJIC''',
''' AND MILKRUN ''',
''' INTRO KEYS ARE: ''',
''' VOLUMECONTROL: ''',
''' PLUS AND MINUS ''',
'''SPEEDCTRL: S AND A''',
''' BYE BYE ''');
procedure writeline(wlx,wly : integer; wls : string);
var i,x,y:integer;
begin
for i:=1 to length(wls) do begin
for x:=0 to 7 do begin
for y:=0 to 7 do begin
if ord(wls[i])<>32 then
mem[$A000: (wly+y) * word(320) + wlx+x+(i-1)*8]:=font[ord(wls[i])-32,x,y]
end;
end;
end;
end;
procedure writeline2(wlx,wly : integer; wls : string);
var i,x,y:integer;
begin
for i:=1 to length(wls) do begin
for x:=0 to 15 do begin
for y:=0 to 15 do begin
if ord(wls[i])=32 then wls[i]:='*';
mem[$A000: (wly+y) * word(320) + wlx+x+(i-1)*16]:=font2[ord(wls[i])-32,x,y]
end;
end;
end;
end;
procedure CLI; inline( $FA ); { Interrupts unterdrcken }
procedure STI; inline( $FB ); { Interrupts wieder erlauben }
begin
CLI;
case InitTextGraf of
1: begin end;
end;
GrafikMode($13);
for i:=0 to 31999 do begin
mem[$A000:i]:=0;
end;
for i:=0 to 31999 do begin
mem[$A000:i+32000]:=0;
end;
for i:=0 to 255 do begin
for j:=0 to 2 do begin
p[i,j]:=0;
end;
end;
setvgacolors(p);
for i:=0 to 31999 do
begin
mem[$A000: i]:= mem[seg(tcmamn): ofs(tcmamn)+i+3];
end;
for i:=0 to 31999 do
begin
mem[$A000: i+32000]:= mem[seg(tcmamn): ofs(tcmamn)+i+3+32000];
end;
for j:=0 to 1 do begin
for i:=0 to 39 do begin
for x:=0 to 7 do begin
for y:=0 to 7 do begin
font[i+j*40,x,y]:= mem[$A000: (y+j*8+81) * word(320) + x+i*8];
end;
end;
end;
end;
for j:=0 to 2 do begin
for i:=0 to 19 do begin
for x:=0 to 15 do begin
for y:=0 to 15 do begin
font2[i+j*20,x,y]:= mem[$A000: (y+j*16+99) * word(320) + x+i*16];
end;
end;
end;
end;
move(mem[seg(tcmpal): ofs(tcmpal)],l,sizeof(l));
for i:=0 to 79 do begin
move(mem[$A000:320*(80-i)],mem[$A000:320*(80-i+50)],320);
end;
for i:=0 to 50 do
for j:=0 to 319 do
mem[$A000:i*320+j]:=0;
for i:=130 to 199 do
for j:=0 to 319 do
mem[$A000:i*320+j]:=0;
for j:=0 to 2 do p[0,j]:=l[1,j];
for x:=1 to 80 do begin
for i:=1 to 255 do
begin
for j:=0 to 2 do
begin
if p[i,j]<l[i+1,j] then inc(p[i,j]);
end;
end;
setvgacolors(p);
end;
STI;
CLI;
i:=51;j:=102;
repeat
dec(i);inc(j);
move(mem[$A000:320*(i+1)],mem[$A000:320*i],320*52);
move(mem[$A000:320*(j-1)],mem[$A000:320*j],320*30);
until i<=0;
STI;
SBPort:=IdentifySB;
if SBPort=0 then begin (* bei IdentifySB=0 -> Keine Soundblaster *)
SBPort:=$42; (* Lautsprecherausgabe *)
end;
if SBPort=$42 then begin
flag:=doit('logo-int.ovl',sbport,0,21000);
end else begin
flag:=doit('logo-int.ovl',sbport,0,12000);
end;
writeline(65,60,' = TRANCEMISSION = ');
writeline(65,68,' = PROUDLY PRESENTS = ');
writeline(65,76,' ---------------------- ');
writeline(65,84,' THE LOGO INTRO ');
writeline(65,100,' CODE GFX MUSIC BY ');
writeline(65,108,' STEFAN KOELLE ');
writeline(65,124,' RELEASED 1993 ');
writeline(65,132,' ON PC 486 DX 50 ');
writeline(65,52,'************************');
writeline(65,140,'************************');
for i:=1 to 11 do writeline(65,52+(8*i),'* *');
writeline2(0,185,text[1]);
{ mem[$A000:round(sin(i*6)*90)+320*(50+i)+150]:=66;}
x:=0;
ch:='A';
speed:=1;
texti:=1;
ledz:=10000;
repeat
inc(x,speed);
if x>375 then x:=1;
y:=round(sin(x*6.3)*30)+50;
for i:=7 to 16 do begin
h1:=(i+140-y)*320;
h2:=(-i+155-y)*320;
for j:=0 to 63 do begin
if i=16 then begin
mem[$A000:h1+j]:=0;
mem[$A000:h2+j]:=0;
end else begin
mem[$A000:h1+j]:=i+31;
mem[$A000:h2+j]:=i+31;
end;
end;
for j:=319-60 to 319 do begin
if i=16 then begin
mem[$A000:h1+j]:=0;
mem[$A000:h2+j]:=0;
end else begin
mem[$A000:h1+j]:=i+31;
mem[$A000:h2+j]:=i+31;
end;
end;
end;
if textp and (ledz<10000) then begin
inc(texti);
writeline2(0,185,text[texti]);
if texti>=15 then texti:=0;
textp:=false;
end;
if (ledz>10000) and (not textp) then textp:=true;
if keypressed then begin
ch:=readkey;
case ch of
's','S':begin
inc(speed);
if speed>20 then speed:=20;
end;
'a','A':begin
dec(speed);
if speed<1 then speed:=1;
end;
'+':begin
lint:=volume;
inc(lint,5);
if lint>256 then volume:=256 else volume:=lint;
end;
'-':begin
lint:=volume;
dec(lint,5);
if lint<0 then volume:=0 else volume:=lint;
end;
end;
end;
until (ch=#27) or (ch=#13) or (ch=' ');
endit;
CLI;
i:=0;j:=155;
repeat
inc(i);dec(j);
move(mem[$A000:320*(i-1)],mem[$A000:320*i],320*50);
move(mem[$A000:320*181],mem[$A000:320*(i-1)],320);
move(mem[$A000:320*(j+1)],mem[$A000:320*j],320*30);
for x:=1 to 3 do begin
for y:=1 to 16 do begin
mem[$A000:320*(200-y)+x+(i-1)*3]:=0;
mem[$A000:320*(200-y)+319-(x+(i-1)*3)]:=0;
end;end;
until i>=53;
STI;
for x:=1 to 80 do begin
for i:=0 to 255 do
begin
for j:=0 to 2 do
begin
if p[i,j]>0 then dec(p[i,j]);
end;
end;
setvgacolors(p);
end;
for i:=0 to 31999 do begin
mem[$A000:i]:=0;
end;
for i:=0 to 31999 do begin
mem[$A000:i+32000]:=0;
end;
TEXTMODE(co80);
end.
Binary file not shown.
Binary file not shown.
+11
View File
@@ -0,0 +1,11 @@
unit amn;
INTERFACE
procedure tcmamn;
procedure tcmpal;
IMPLEMENTATION
procedure tcmamn;external
{$L tcmamn.obj};
procedure tcmpal;external
{$L tcmpal.obj};
begin
end.
+4
View File
@@ -0,0 +1,4 @@
c:\progs\tp\tpc amn.pas
c:\progs\tp\tpc textgraf.pas
c:\progs\tp\tpc menu-int.pas
Binary file not shown.
Binary file not shown.
+323
View File
@@ -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 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.
+234
View File
@@ -0,0 +1,234 @@
uses WOWCONST, WOWTPU,crt,textgraf,amn;
type
lpi = array[0..2] of byte;
lp = array[0..256] of lpi;
const col=30;
var
f : file;
k,i,j,x,y,men,mm : integer;
n,m : word;
b : byte;
l : lp;
p : vgacolors;
s : string;
c : array[0..130] of byte;
ch:char;
logo:array[0..80,0..240] of char;
SBPort: word;
flag:integer;
sinus:array[0..120] of integer;
bo,ende:boolean;
font : array[0..80, 0..7, 0..7] of byte;
leer:array[1..8*320] of char;
CONST text:array[1..18] of string=('TRANCEMISSION PRESENTS','OUR NEW MENU INTRO',
'CODE AND GFX BY STEFAN KOELLE',
'RELEASE 1992 ON DOS PC',
'THIS COULD BE USED BEFORE DEMOS',
'TO CHANGE SETTINGS OF THE DEMO',
'MENU WAS NEVER COMPLETED',
'CODED IN TURBO PASCAL',
'AND INLINE ASSEMBLER',
'BY STEFAN KOELLE',
'LOGO AND FONT ALSO DESIGNED',
'BY STEFAN KOELLE',
'GREETINGS TO THE FOLLOWING',
'MATTHIAS, MILKRUN, MAJIC',
'MANY THANKS FOR READING THIS FAR',
'STILL READING, YEAH',
'REALLY PROUD OF IT',
'... TAKE CARE AND ENJOY ...');
menu:array[1..3] of string=(' TOGGLE: YES',
' OPTION MENU ITEM',
' EXIT');
function Key : boolean;
var flag : boolean;
begin
asm
mov Flag,0
in al,$60
test al,128
jne @@KeineTaste
mov Flag,1
@@KeineTaste:
end;
Key:=Flag;
end;
procedure writeline(wlx,wly : integer; wls : string);
var i,x,y:integer;
begin
for i:=1 to length(wls) do begin
if ord(wls[i])<>32 then begin
for x:=0 to 7 do begin
for y:=0 to 7 do begin
if font[ord(wls[i])-64+32,x,y]<>0 then
mem[$A000: (wly+y) * word(320) + wlx+x+(i-1)*8]:=font[ord(wls[i])-64+32,x,y]
end;
end;
end;
end;
end;
begin
DirectVideo:= false;
case InitTextGraf of
-1: begin
writeln(' Dieses Programm l„uft auf Ihrer Grafikkarte leider nicht!');
halt(1);
end;
1: begin
writeln(' Zu wenig Speicher!');
halt(2);
end;
end;
GrafikMode($13);
for i:=0 to 255 do
begin
for j:=0 to 2 do
begin
p[i,j]:=0;
end;
end;
setvgacolors(p);
for i:=0 to 31999 do
begin
mem[$A000: i]:= mem[seg(tcmamn): ofs(tcmamn)+i+3];
end;
for i:=0 to 31999 do
begin
mem[$A000: i+32000]:= mem[seg(tcmamn): ofs(tcmamn)+i+3+32000];
end;
for i:=0 to 80 do
move(mem[$A000:320*i+43],logo[i],240);
for j:=0 to 1 do begin
for i:=0 to 39 do begin
for x:=0 to 7 do begin
for y:=0 to 7 do begin
font[i+j*40,x,y]:= mem[$A000: (y+j*8+98) * word(320) + x+i*8];
end;
end;
end;
end;
SBPort:=IdentifySB;
if SBPort=0 then begin (* bei IdentifySB=0 -> Keine Soundblaster *)
SBPort:=$42; (* Lautsprecherausgabe *)
end;
for i:=1 to paramcount do if paramstr(i)='-p' then SBPort:=$42;
for i:=0 to 31999 do
mem[$A000:i]:=0;
for i:=0 to 31999 do
mem[$A000:i+32000]:=0;
for i:=0 to 320 do
sinus[i]:=round(sin(Pi/24*i+1)*5)+46; (* round(sin(i*6.2)*5)+46 *)
move(mem[$A000:191*320],leer,8*320);
move(mem[seg(tcmpal): ofs(tcmpal)],l,sizeof(l));
for i:=0 to 255 do
begin
for j:=0 to 2 do
begin
p[i,j]:=l[i,j];
end;
end;
setvgacolors(p);
for i:=0 to 8*320-1 do
mem[$A000:i+320*164]:=col;
writeline(125,114,'PRESENTS');
writeline(55,124,' THE MENU INTRO');
for i:=1 to 3 do
writeline(55,134+i*10,menu[i]);
flag:=doit('menu-int.res',sbport,0,12000);
bo:=true;
n:=0;
m:=0; (* wobble style *)
mm:=0;
writeline(159-length(text[1])*4,191,text[1]);
k:=2;
ende:=false;
men:=3;
ledz:=0;
repeat
if mm>2 then begin
mm:=0;
if bo then begin
inc(n,1);
if n>39 then begin
bo:=false;
end;
end else begin
dec(n,1);
if n<1 then begin
bo:=true;
end;
end;
end else begin
inc(mm,1);
end;
if m>46 then begin
m:=0;
end else begin
inc(m,1);
end;
if ledz>20000 then begin
ledz:=0;
move(leer,mem[$A000:191*320],8*320);
writeline(159-length(text[k])*4,191,text[k]);
inc(k);
if k>18 then k:=1;
end;
for i:=3 to 74 do
move(logo[i],mem[$A000: 320*(n+i)+sinus[i+m]],226);
if keypressed then begin
ch:=readkey;
if ch=#0 then begin
ch:=readkey;
if (ch=#80) and (men<3) then begin
move(leer,mem[$A000:(134+men*10)*320],8*320);
writeline(55,134+men*10,menu[men]);
inc(men);
for i:=0 to 8*320-1 do
mem[$A000:i+320*(134+men*10)]:=col;
writeline(55,134+men*10,menu[men]);
end;
if (ch=#72) and (men>1) then begin
move(leer,mem[$A000:(134+men*10)*320],8*320);
writeline(55,134+men*10,menu[men]);
dec(men);
for i:=0 to 8*320-1 do
mem[$A000:i+320*(134+men*10)]:=col;
writeline(55,134+men*10,menu[men]);
end;
end else begin
if ch=#27 then ende:=true;
if ch=#13 then begin
case men of
1:begin
if menu[1,17]='Y' then begin
menu[1,17]:=' ';
menu[1,18]:='N';
menu[1,19]:='O';
end else begin
menu[1,17]:='Y';
menu[1,18]:='E';
menu[1,19]:='S';
end;
for i:=0 to 8*320-1 do
mem[$A000:i+320*(134+men*10)]:=col;
writeline(55,134+men*10,menu[men]);
end;
2:begin
end;
3:ende:=true;
end;
end;
end;
end;
until ende;
endit;
for i:=0 to 31999 do
mem[$A000:i]:=0;
for i:=0 to 31999 do
mem[$A000:i+32000]:=0;
textmode(CO80);
end.
Binary file not shown.
Binary file not shown.
Binary file not shown.
+2
View File
@@ -0,0 +1,2 @@
c:\progs\tp\tpc textgraf.pas
c:\progs\tp\tpc star-int.pas
+323
View File
@@ -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 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.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
+186
View File
@@ -0,0 +1,186 @@
{$S-}
{$R-}
{$G+}
{$D-}
uses crt,textgraf,WOWTPU,WOWCONST;
type
lpi = array[0..2] of byte;
lp = array[0..255] of lpi;
var
f : file;
k,i,j,x,y,anz : integer;
n : word;
b : byte;
l : lp;
p : vgacolors;
s : string;
c : array[0..130] of byte;
ch:char;
sx : array[0..300] of integer;
sy : array[0..300] of integer;
sc : array[0..300] of integer;
sc2: array[0..300] of integer;
font : array[0..80, 0..7, 0..7] of byte;
lauf : string;
lx,li: integer;
SBPort: word;
flag:integer;
procedure writeline(wlx,wly : integer; wls : string);
begin
for i:=1 to length(wls) do begin
for x:=0 to 7 do begin
for y:=0 to 7 do begin
if ord(wls[i])<>32 then
mem[$A000: (wly+y) * word(320) + wlx+x+(i-1)*8]:=font[ord(wls[i])-64,x,y]
end;
end;
end;
end;
function Key : boolean;
var flag : boolean;
begin
asm
mov Flag,0
in al,$60
test al,128
jne @@KeineTaste
mov Flag,1
@@KeineTaste:
end;
Key:=Flag;
end;
begin
case InitTextGraf of
1: begin end;
end;
GrafikMode($13);
for i:=0 to 31999 do begin
mem[$A000:i]:=0;
end;
for i:=0 to 31999 do begin
mem[$A000:i+32000]:=0;
end;
for i:=0 to 255 do begin
for j:=0 to 2 do begin
p[i,j]:=0;
end;
end;
setvgacolors(p);
assign(f,'star-int.004');
reset(f);
blockread(f,c,1,n);
for i:=0 to 130 do
begin
mem[$A000: i]:= c[3+i];
end;
blockread(f,mem[$A007:13],500,n);
close(f);
for j:=0 to 1 do begin
for i:=0 to 39 do begin
for x:=0 to 7 do begin
for y:=0 to 7 do begin
font[i+j*40,x,y]:= mem[$A000: (y+j*8) * word(320) + x+i*8];
end;
end;
end;
end;
assign(f,'star-int.001');
reset(f);
blockread(f,l,sizeof(l),n);
for i:=0 to 255 do
begin
for j:=0 to 2 do
begin
p[i,j]:=l[i+1,j];
end;
end;
close(f);
assign(f,'star-int.003');
reset(f);
blockread(f,l,sizeof(l),n);
for i:=208 to 223 do
begin
for j:=0 to 2 do
begin
p[i,j]:=l[i+1-208,j];
end;
end;
close(f);
assign(f,'star-int.002');
reset(f);
blockread(f,c,1,n);
for i:=0 to 130 do
begin
mem[$A000: i]:= c[3+i];
end;
blockread(f,mem[$A007:13],500,n);
close(f);
writeline(74,90, ' star intro');
writeline(74,106,' code gfx music');
writeline(74,122,' by stefan koelle');
writeline(78,138,' press any key');
randomize;
for x:=0 to 150 do
begin
sx[x] := random(319);
repeat
k:=0;
sy[x] := random(199)+1;
for i:=0 to x-1 do
begin
if sy[i]=sy[x] then k:=1;
end;
for i:=x+1 to 150 do
begin
if sy[i]=sy[x] then k:=1;
end;
until k=0;
sc[x] := random(3)+1;
sc2[x]:= mem[$A000: sy[x] * word(320) + sx[x]];
end;
setvgacolors(p);
SBPort:=IdentifySB;
if SBPort=0 then begin (* bei IdentifySB=0 -> Keine Soundblaster *)
SBPort:=$42; (* Lautsprecherausgabe *)
end;
for i:=1 to paramcount do
if paramstr(i)='-p' then SBPort:=$42;
if sbport=$42 then begin
flag:=doit('star-int.005',sbport,0,21000);
end else begin
flag:=doit('star-int.005',sbport,0,16000);
end;
repeat
for x:=0 to 150 do begin
mem[$A000: sy[x] * word(320) + sx[x]]:= sc2[x];
sx[x]:=sx[x]+SC[X];
if sx[x]>319 then
begin
sx[x]:=0;
sc[x]:=random(3)+1;
end;
sc2[x]:=mem[$A000: sy[x] * word(320) + sx[x]];
if mem[$A000: sy[x] * word(320) + sx[x]]=0 then
begin
mem[$A000: sy[x] * word(320) + sx[x]]:= (-sc[x]*3)+27;
end;
end;
until key;
ch:=readkey;
endit;
for i:=0 to 31999 do begin
mem[$A000:i]:=0;
end;
for i:=0 to 31999 do begin
mem[$A000:i+32000]:=0;
end;
TEXTMODE(co80);
end.
Binary file not shown.
Binary file not shown.