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