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.
+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.