Schönere Programme durch Zeichensätze: Fonts unter ST-pascal plus
GEM bietet einige sehr interessante Möglichkeiten, die auf dem ST leider noch gar nicht richtig ausgenutzt werden. Ein wichtiger Punkt dabei sind die Textdarstellungen. Da jeder Text im Grafikmodus ausgegeben wird, bietet GEM (VDI) die Möglichkeit, verschiedene Textattribute (fett usw.) einzustellen und die Textgröße zu wählen. Davon machen ja auch schon viele Programme (v.a. im Grafikbereich) reichlich Gebrauch. Die Entwickler von GEM sind aber noch einen sehr großen Schritt weitergegangen.
Man kann außer den Systemzeichensätzen noch andere Fonts von Diskette laden (sollte man wenigstens können). Das Format dabei ist außerdem recht flexibel (Proportionalschrift usw.). Dabei tritt nur ein großes Problem auf: die Implementation auf dem Atari ST. Diese ist nämlich nicht ganz vollständig, bzw. fehlerfrei. Mit dem normalen, nicht erweiterten Betriebssystem ist es deshalb nicht möglich, diese Zeichensätze zu benutzen.
Aus diesem Grund gibt es prinzipiell zwei Möglichkeiten, auf dem ST-Zeichensätze zu laden.
Die eine ist sozusagen die offizielle: Man packt das Programm GDOS.PRG (gehört nicht zum Lieferumfang des ST) in den Autoordner der Programm-bzw. Systemdiskette, muß alle einzelnen Fontgrößen auf diese Diskette kopieren und die möglichen Fonts vorher in einer Datei namens ASSIGN.SYS festlegen. Dann, und nur dann, kann das eigentliche Programm die VDI-Funktionen vst_load_fonts und vst_unload_fonts (119 und 120) benutzen, da sie dann funktionieren. Dieses Verfahren kann man natürlich anwenden, es hat aber im Vergleich zu dem folgenden sehr viele Nachteile: der Anwender muß neu booten (wer bootet schon immer mit GDOS.PRG und dem richtigen ASSIGN.SYS), die Zeichensätze sind vorher festgelegt (es kann nicht im Programm gewählt werden), und es schwirren sehr viele Dateien im Hauptdirectory (zwingend!) der Diskette rum, für jede Größe eine.
Deshalb sollte sich bei Interesse auf jeden Fall mi folgendem Verfahren näher beschäftigen: Die Zeichensatzdateien werden direkt in den Speicher geladen. Sie haben ja einen definierten Aufbau und auch die interne Organisation der Fonts ist dokumentiert. Dies ist gar nicht so schwierig, wie es zunächst erscheinen mag, allerdings auch nicht ganz einfach.
Im folgenden beschreibe ich eine Lösung für GEM-Programme unter ST-Pascal plus. Die Anwendung ist recht einfach, da es sich lediglich um zwei Include-Dateien handelt, die einige Funktionen zur Zeichensatzanwendung zur Verfügung stellen. Um das Prinzip zu verstehen, sollte man sich den Aufbau von Font-Dateien verdeutlichen. Jeder Zeichensatz besteht prinzipiell aus zwei Teilen, dem Font-Header und den eigentlichen Zeichensatzdaten und einer (oder zwei) Tabellen. Für die Lösung unseres Problems ist vor allem der Font-Header interessant. Für Pascal läßt er sich als Record darstellen, wie es in FONTTYPE.PAS (Listing 1) geschehen ist. Sehr wichtig ist der Eintrag NextFont, da alle geladenen Fonts im Speicher über diesen Zeiger verkettet sind. Die anderen Einträge sind auch wichtig, allerdings verweise ich für genauere Informationen auf die unten angegebenen Publikationen, vor allem auf das zweite Sonderheft der ST-Computer. Außerdem sollten Sie sich einmal das Listing 1 ansehen, da ich im folgenden von Datentypen spreche, die dort definiert sind.
Das Prinzip beim Laden eines Fonts besteht darin, vom Betriebssystem entsprechend Speicher anzufordern, die Datei dorthin zu laden, und die Zeiger entsprechend zu korrigieren (wie es so schön heißt, den Zeichensatz in die Liste einzuhängen). Ganz so einfach ist es allerdings nicht, wie ich weiter unten zeigen werden. Doch wo, werden sich findige Leser jetzt fragen, soll ich den ersten Zeichensatz denn "einhängen'"? Dazu muß man das eigentliche GEM verlassen und die Line-A-Routinen betrachten, die für die Ausgabe von Grafik (und auch Text) auf den Bildschirm zuständig sind. Die Funktion Line-A-Init ($AOOO) gibt drei Adressen zurück, wovon eine auf eine Tabelle zeigt, die wiederum die Adressen der Systemfont-Header enthält (Kommen Sie noch mit?). Aus dieser Tatsache ergibt sich auch die Aufgabe einer Prozedur in meinen Routinen, nämlich von FirstFontPtr. Diese Funktion liefert einen Zeiger auf den Header des ersten GEM-Fonts zurück (Datentyp FontPtr, oder auch Font).
Wie oben schon erwähnt, ist dazu allerdings etwas Assembler notwendig. Der Einfachheit halber habe ich diese kurze Routine in ein Feld gepackt und zum Aufruf die XBios-Routine SupExec (38) benutzt. Der Aufruf erfolgt zwar im Supervisormodus, und man darf keine Betriebssystemfunktionen benutzen, aber das stört hier nicht (dieses Verfahren bietet sich sowieso bei kleinen Routinen an, wenn man nicht gleich eine extra Objekt-Datei nutzen will.) Nach Aufruf dieser Funktion steht in Routine. Pointer die Adresse des ersten GEM-Fonts (gleich als richtiger Typ). Für Interessierte: Der Quelltext der Routine steht in FONT1NIT.ASM (Listing 2b). LastFontPtr benutzt FirstFontPtr und “hangelt" sich dann die Liste entlang, um den letzen Font zu bestimmen. Dort werden neue Fonts angehängt.
Um einen Zeichensatz zu laden (FNT-Datei), wird die Funktion LoadFont benutzt. Diese öffnet die Datei und ruft dann InstallFont auf. InstallFont erledigt die eigentliche Arbeit. Ich möchte das eigentliche Funktionsprinzip nur kurz beschreiben, sehen Sie sich das Listing an, oder benutzen Sie die angegebene Literatur.
Zuerst wird entsprechend der Dateilänge vom Betriebssystem Speicher angefordert. Aus diesem Grund muß bei Benutzung von FONTSUBS folgendes auf jedem Fall gewährleistet sein: Das Betriebssystem muß genügend Speicher haben! Also am besten die U-Option des Compilers benutzen: {$U 100} wird wohl reichen. Nachdem also hoffentlich Speicher reserviert werden konnte, wird die Datei an diese Stelle mit Hilfe von FRead (Gemdos) eingelesen. Nun folgen aber noch einige Operationen, die vor allem folgenden Sinn haben: Da GEM auch auf PCs zu finden ist. sind im Fontheader und in den Tabellen Worte im Intel-Format abgespeichert (erst Low-Byte, dann Hi-Byte). Im Speicher müssen sie aber richtig vorliegen (der ST benutzt einen MC68000). Aus diesem Grund werden im größten Teil des Fontheaders und in den dann folgenden Tabellen die Worte “motorolatisiert". Die eigentlichen Zeichensatzdaten sind aber schon richtig vorhanden (wenn auf dem ST erstellt). Nach diesen Vorgängen werden die Offsets noch zu Adressen erweitert und der Zeichensatz in die Liste "eingehängt". InstallFont gibt dann den Zeiger auf den Zeichensatz als FontPtr zurück. Die entgegengesetzte Funktion zu LoadFont ist UnloadFont. Der Zeichensatz wird aus der Liste "ausgehängt" und der belegte Speicher wieder freigegeben.
Mit diesen beiden Funktionen können Sie schon mehr machen als mit den Original-Funktionen. Wenn Sie einen Zeichensatz laden wollen, müssen Sie folgendermaßen vorgehen: Sie fügen in GEM-Programmen (und nur dort) hinter {SIGEMTYPE) bzw. {SIGEMSUBS) {$IFONTTYPE} und {$IFONTSUBS} ein und deklarieren dann eine Variable vom Typ Font. Um dann einen Zeichensatz zu laden, machen Sie folgendes (Ihre Variable heißt z.B. Zeichens):
Zeidiens:=LoadFont('DATEINAM.FNT',2);
'DATEI NAM.FNT' steht dabei für den Namen der Fontdatei, die 2 für die Nummer, unter der der Font angesprochen werden soll. Wenn Zeichens danach NIL ist, ist ein Fehler aufgetreten (Datei nicht vorhanden, zu wenig Speicher).
Wenn Sie nun diese Schrift benötigen, kommt Text_Face zum Einsatz: Text_Face(2); wählt den Font mit der Nummer zwei. Alle Grafik-Text-Ausgaben benutzen dann diesen Font bis Sie mit Text_Face( 1); wieder den Systemfont einschalten. So einfach kann die Anwendung von Zeichensätzen sein (oder ist das etwa nicht einfach ?!). Vor Programmende müssen Sie dann nur noch Unload Font(Zeichens); aufrufen, um den Speicher wieder ordnungsgemäß freizugeben.
Bis hierhin ist es ja schon ganz schön und ich war auch ganz erfreut, daß ich nach einigen Mühen und leider auch Abstürzen zum ersten Mal Proportionalschrift auf dem “Pascal-Bildschirm” sah. Es bleibt nur noch ein Problem: die vielen Dateien auf den Disketten. Eine eigene Datei für jede Größe jedes Zeichensatzes ist nun wirklich nicht nötig. Es sieht nicht nur unübersichtlich aus, sondern benötigt effektiv auch mehr Platz auf der Diskette und mehr Ladezeit. Deshalb habe ich mir ein Format ausgedacht, um mehrere Dateien sinnvoll zusammenzufassen. Es ist zugegebenermaßen nicht sehr aufwendig, aber dafür extrem nützlich. Hier nun eine Beschreibung dieses Formats:
Die ersten zwölf Bytes stellen eine Kennung da, um die Datei zu identifizieren. Sie müssen “ZSA-GEM-FONT” enthalten, da ich solch eine Datei ZSA-Datei nenne (von Zeichensatz, klar?).
Das nächste Wort gibt nun die Anzahl der verschiedenen Fontarten (Faces) an. Für jedes Face wiederholen sich die folgenden Daten:
1 Wort: Anzahl der Zeichensatzgrößen für jedes Face.
Für diese einzelnen Größen wiederholen sich nun wiederum die nächsten Daten:
1 Wort: Länge der eigentlichen Zeichensatzdatei (FNT).
danach: Die Daten dieser FNT-Datei ohne jede Änderung.
Wenn man eine so aufgebaute Datei laden will, kommen andere Funktionen zum Einsatz. Sie brauchen keine Variable des Types Font mehr, sondern dafür eine vom Typ FontList. Der Funktion LoadZsaFonts übergeben Sie folgende Parameter:
Zuerst wieder den Dateinamen (*.ZSA), dann die Face-Nummer; diese Face-Nummer gilt für den ersten geladenen Face. Alle weiteren Faces werden fortlaufend numeriert. Der letze Parameter ist die eben erwähnte “Font-Liste”. Die Funktion LoadZsaFonts lädt alle Fonts in den Speicher. Das genaue Vorgehen entnehmen Sie bitte dem Listing. Es wird auch InstallFont benutzt, die Hauptsache funktioniert also genauso wie bei LoadFont. LoadZsaFonts gibt die Anzahl der korrekt geladenden Faces zurück. Bei Auftreten eines Fehlers ist der Funktionswert Null.
Die nachgeladenen Fonts können Sie dann mit Text_Face(2,3,4 usw.) ansprechen. Wenn das Programm mit seiner Arbeit fertig ist, muß es nicht UnloadFont sondern UnloadFonts (das kleine s ist wichtig!) aufrufen. UnloadFonts verlangt genau wie UnloadFont einen Parameter, aber nicht vom Typ Font, sondern vom Typ FontList. Es werden alle Zeichensätze freigegeben, und es kann auf sie nicht mehr zugegriffen werden.
Mehrere Zeichensätze in einer Datei
Meiner Meinung nach sind diese zusammengefaßten Zeichensätze in den meisten Fällen eine große Erleichterung. Um nun auch das Erstellen einer solchen Datei zu erleichtern, habe ich ein kleines GFA-Basic-Programm geschrieben (Listing 4). Es ist zwar nicht sehr komfortabel, aber trotzdem ist die Bedienung recht einfach, so daß ich hier nicht weiter darauf eingehe.
Das Anwenden von GEM-Fonts reduziert sich durch diese Routine auf folgende Schritte: Include-Files an den richtigen Stellen definieren. LoadFont oder LoadZsaFonts mit den entsprechenden Variablen aufrufen. Bei Bedarf mit Text_Face die gewünschte Schriftart bestimmen und am Ende UnloadFont oder UnloadFonts aufrufen.
Einen Hinweis muß ich allerdings noch anbringen: In dieser Form laufen die Routinen nur mit der neuesten Version von Pascal plus. Ich benutze z.B. manchmal Long_Integers als Schleifenvariablen, und außerdem sind in älteren Versionen einige GEM-Funktionen nicht vordefiniert. Ein Umschreiben müßte möglich sein, doch empfehle ich sowieso auf jeden Fall, sich die neueste Version zu besorgen (Das Update ist gar nicht so teuer, es lohnt sich.).
Ab jetzt steht also der Verschönerung von GEM-Programmen durch verschiedene Zeichensätze nichts mehr im Wege. (Außer daß Sie keine Zeichensätze haben?! Da kann ich Ihnen auch nicht helfen. Aber trösten Sie sich, ich habe da auch meine Probleme. Man bekommt wirklich fast keine. Aber vielleicht ändert sich das jetzt; als Anregung: Wer schreibt einen guten Font-Editor?)
Konvertierung der Zeichensätze
Es gibt allerdings eine Lösung für dieses Problem der fehlenden GEM-Zeichensätze: Die Konvertierung von anderen Formaten. Sicherlich gibt es einige Leser, die STAD- oder Font-loader-Fonts haben. Solche gibt es teilweise auch schon auf Public-Domain-Disketten. Nun habe ich ein kleines GFA-Basic-Programm geschrieben, das diese Konvertierung vomimmt. Ein Nachteil ist, daß solche Zeichensätze nicht proportional und nur in der Standardgröße vorhanden sind. Trotzdem lohnt es sich, sie zu benutzen. Es ist immerhin etwas. Zur Anwendung des Programms (Listing 4) ist folgendes zu sagen:
In einer Alert-Box wählen Sie die Art des zu konvertierenden Fonts, dann den Namen. Danach wird er in den Speicher geladen und Sie werden aufgefordert, den Namen einzugeben, der in den Font-Header eingetragen wird. Danach geben Sie den Dateinamen des GEM-Fonts ein und er wird auf Diskette geschrieben. Dazu noch eine Anmerkung: Lassen Sie sich ein System einfallen, um GEM-Fonts von anderen Fonts zu unterscheiden, da alle die Extension “FNT” haben.
Nun noch einige Hinweise zu dem beigefügten Beispielprogramm (Listing 3): Es macht nicht besonders viel: Sie können eine FNT- oder ZSA-Datei wählen und dann Face, Attribute und Größe einstellen. Nach diesen Parametern wird dann ein kleiner Text ausgegeben. Vertiefen Sie sich in das Listing, da das Programm st keinen praktischen Wert hat.
Noch viel Spaß beim Programmieren, vorallem mit dem ausgezeichneten Pascal plus, und vielleicht erstellt ja jemand mal Zeichensätze. Ich würde mich darüber freuen.
Weitere Informationen finden Sie in:
-
GFA-Basic-Buch (GFA) vor allem im Kapitel Fonts (dort ist eine ähnliche Lösung für GFA-Basic beschrieben).
-
Atari ST - GEM (Data Becker)
-
Atari ST Intern (Data Becker)
-
ST-Computer-Sonderheft 2 (Heim-Verlag)
außerdem natürlich auch noch in anderen Büchern über GEM.
{ Listing 1: }
{ ========== }
{ FONTTYPE.PAS - Typendefinitionen für FONTSUBS.PAS
GEM-Fonts unter ST-Pascal plus
laden. LPSoft 1987 }
FontPtr = ^FontHeader;
FontHeader = Record
FontId : Integer;
FontSize : Integer;
FaceName : Packed Array [1..32] of Char;
LowADE : Integer;
HighADE : Integer;
TopLine : Integer;
AscentLine : Integer;
HalfLine : Integer;
DescentLine : Integer;
ButtomLine : Integer;
CharWidth ; Integer;
CellWidth : Integer;
LeftOffset : Integer;
RightOffset : Integer;
Thickening : Integer;
UnderLineSize : Integer;
LightMask : Integer;
SkewMask : Integer;
Flags : Integer;
HorOffsetTable : Long__Integer;
CharOffsetTable : Long_Integer;
FontData : Long_Integer;
FormWidth : Integer;
FormHeight : Integer;
NextFont : FontPtr;
End;
Font = FontPtr;
FontListPtr = ^FontListEle;
FontListEle = Record
Pointer : FontPtr;
Next : FontListPtr;
End;
FontList = FontListPtr;
{ END OF FONTTYPE.PAS }
{ Listing 2: }
{ ========== }
{ FONTSUBS.PAS - 'GEM-Fonts' unter ST-Pascal plus
laden und benutzen. 1987 by LPSoft Lutz Preßler,
2904 Hatten 23.11.87 }
{ ************* VORHANDENE FUNKTIONEN ****************
Function LoadFont(<Name:String>,<FaceNo:Integer>): <FontPtr>;
-> Eine Zeichensatzdatei laden (<Name>:*.FNT) und als Face <FaceNo>
installieren. Rückgabewert (FontPtr): Zeiger auf
Zeichensatz oder NIL bei Fehler.
Function LoadZsaFonts(<Name:String>,<FaceNo:Integer>, <List:FontList>) : <Integer>
—> Mehrere Zeichensätze im ZSA-Format laden und die darin enthalten Faces ab Nummer <FaceNo>
installieren. <Name>:*.ZSA, <List>: Liste von
Font-Pointern (für späteren Zugriff und Löschen; muß nicht leer sein).
Rückgabewert (Integer): Anzahl der geladenen Faces oder 0 bei Fehler.
Procedure UnloadFont(<Ptr:FontPtr>)
-> Einen Zeichensatz (Ptr) löschen. Er kann danach
nicht mehr benutzt werden, der belegte Speicher wird freigegeben.
Procedure UnloadFonts(<List:FontList>)
—> Mehrere Zeichensätze löschen (Liste der Zeichens.:
List). Siehe UnloadFont. Die Liste ist danach leer (NIL).
Procedure Text_Face(<FaceNo:Integer>)
—> Textface auswählen. Bei nicht vorhandenem Face wird der Systemfont benutzt.
Die anderen Funktionen werden eigentlich nur intern benötigt.
Anm. : Der Datentyp Font entspricht FontPtr.
************************************************ }
Function FontAdress(Ptr:FontPtr): Long_Integer;
Var X: Record Case Integer Of
0: (Adr: Long_Integer);
1: (Ptr: FontPtr);
End;
Begin {$P~} X.Ptr:=Ptr; FontAdress:=X.Adr; {$P=} End (of FontAdress);
Function FontPointer(Adr:Long_Integer): FontPtr;
Var X: Record Case Integer Of
0: (Adr: Long_Integer);
1: (Ptr: FontPtr);
End;
Begin {$P-} X.Adr:=Adr; FontPointer:=X.Ptr;{$P=} End {of FontPointer};
Function FirstFontPtr: FontPtr;
Type RoutType = Record
Code: Array[1..7] of Long_Integer;
Pointer: FontPtr;
End;
Var Routine: RoutType;
Procedure CallSup(Var Code:RoutType); XBios(38);
Begin
Routine.Code[1]:=$48E780E0;
Routine.Code[2]:=$A0002269;
Routine.Code[3]:=$00042269;
Routine.Code[4]:=$005441FA;
Routine.Code[5]:=$000C2089;
Routine.Code[6]:=$4CDF0701;
Routine.Code[7]:=$4E754E71;
CallSup(Routine);
FirstFontPtr:=Routine.Pointer;
End {of FirstFontPtr};
Function LastFontPtr: FontPtr;
Var P: FontPtr;
Begin
{$P-} P :=FirstFontPtr;
While P^.NextFont<>NIL do P :=P^.NextFont;
LastFontPtr:=P; {$P=}
End {of LastFontPtr};
Function InstallFont(FaceNo,FHandle:Integer;Flang;Long_Integer): FontPtr;
Var Adr,Anz,I : Long_Integer;
Ptr,PrPtr : FontPtr;
Function SwapWord(X:Integer): Integer;
Begin SwapWord:=Shl((X&$FF),8)+(Shr(X,8)&$FF); End;
Function Malloc(Amount:Long_Integer): Long_Integer;Gemdos($48);
Procedure Fread(H:Integer; C,Buf:Long_Integer);Gemdos($3F);
Function PeekWord(Adr:Long_Integer): Integer;
Var X: Record Case Integer Of
0: (Adr: Long_Integer);
1: (Ptr: ^Integer);
End;
Begin {$P-} X.Adr:=Adr; PeekWord:=X.Ptr^; {$P=} End;
Procedure PokeWord(Adr:Long_Integer; Wert:Integer);
Var X: Record Case Integer Of
0: (Adr: Long_Integer);
1: (Ptr: ^Integer);
End;
Begin {$P-} X.Adr:=Adr; X.Ptr^:=Wert; {$P=} End;
Begin
Adr:=Malloc(Flang);
If Adr<=0 then InstallFont:=NIL else begin
Fread(FHandle,Flang,Adr);
Ptr:=FontPointer(Adr);
{$P-}
Anz:=SwapWord(Int(Shr(Ptr^.FontData,16)));
Ptr^.FontId:=SwapWord(Ptr^.FontId);
Ptr^.FontSize:=SwapWord(Ptr^.FontSize);
For I:=18 to (Anz-1) div 2 do
PokeWord(Adr+I*2,SwapWord(PeekWord(Adr+I*2)));
Ptr^.HorOffsetTable:=Adr+Int(Shr(Ptr^.HorOffsetTable,16));
Ptr^.CharOffsetTable:=Adr+Int(Shr (Ptr^.CharOffsetTable,16));
Ptr^.FontData:=Adr+Int(Shr(Ptr^.FontData,16));
PrPtr:=LastFontPtr; PrPtr^.NextFont:=Ptr;
InstallFont:=Ptr; Ptr^.FontId:=FaceNo;
Ptr^.NextFont:=NIL;
{$P=}
End;
End {of InstallFont};
Function LoadFont(Name:String;FaceNo:Integer): FontPtr;
Var Dat : Text;
FHandle : Integer;
Flang,I : Long_Integer;
IOStat : Boolean;
Function Fseek(Offs:Long_Integer; H,M:Integer): Long_Integer; Gemdos($42);
Function IO_State: Boolean; External;
Begin
IOStat:=IO_State; IO_Check(False);
Reset(Dat,Name);
If IO_Result<>0 then LoadFont:=NIL else begin
FHandle:=Handle(Dat);
Flang:=Fseek(0,FHandle,2); I:=Fseek(0,FHandle,0);
LoadFont:=InstallFont(FaceNo,FHandle,Flang);
End;
IO_Check(IOStat);
End {of LoadFont};
Function LoadZsaFonts(Name:String; FaceNo:Integer;
Var ListrFontList): Integer;
Var Dat : Text;
FHandle,I : Integer;
Lang : Long_Integer;
IOStat,
Fehler : Boolean;
Test : String[8];
TChar : Char;
FaceAnz,Fa,
GrAnz,Gr : Integer;
Ptr : FontPtr;
LPtr : FontList;
Function IO_State: Boolean; External;
Function Fseek(Offs:Long_Integer; H,M:Integer): Long_Integer; Gemdos($42);
Function ReadInt: Long_Integer;
Type IntegerPtr = ^Integer;
Var I: IntegerPtr;
Procedure Fread(H:Integer; C:Long_Integer;
C,Buf:IntegerPtr); Gemdos($3F);
Begin
I:=NIL; New(I);
FRead(FHandle, 2,1);
ReadInt:=(IA&$FFFF);
Dispose(I);
End;
Begin
IOStat:=IO_State; IO_Check(False);
Reset(Dat,Name);
If IO_Result<>0 then LoadZsaFonts:=0 else begin
Test:='';
For I:=1 to 4 do Read (Dat, TChar);
For I:=1 to 8 do begin Read (Dat, TChar);Test[I]:=TChar; End;
Test[0]:=Chr(8);
If Test=' GEM-FONT' then begin
FHandle:=Handle(Dat); Lang:=FSeek(12,FHandle,0);
FaceAnz:=ReadInt;
Fehler:=False;
For Fa:=FaceNo To FaceNo+FaceAnz-1 do begin
GrAnz:=ReadInt;
For Gr:=l to GrAnz do begin
If not Fehler then begin
Lang:=ReadInt;
Ptr:=InstallFont(Fa,FHandle,Lang);
If Ptr=NIL then begin
Fehler:=True; FaceAnz:=Fa-PaceNo; end
else begin
New(LPtr);
LPtr^.Pointer:=Ptr;
LPtr^.Next:=List;
List:=LPtr;
End;
End;
End;
End;
LoadZsaFonts:=FaceAnz;
End else LoadZsaFonts:=0;
End;
IO_Check(IOStat);
End {of LoadZsaFonts};
Procedure UnloadFont(Ptr:FontPtr);
Var P: FontPtr;
Procedure FMfree(Adr:FontPtr); Gemdos($49);
Begin
{$P-} P:=FirstFontPtr;
While P^.NextFont<>Ptr do P:=P^.NextFont;
P^.NextFont:=Ptr^.NextFont; {$P=}
FMfree(Ptr);
End {of UnloadFont};
Procedure UnloadFonts(Var List:FontList) ;
Var P: FontList;
Begin
P:=List;
While P<>NIL do begin
UnloadFont(P^.Pointer);
List:=P;
P:=P^.Next;
Dispose(List);
End;
List:=NIL;
End {of UnloadFonts};
Procedure Text_Face(FaceNo:Integer);
Var Control : Ctrl_Parms;
Int_in : Int_In_Parms; Int_out : Int_Out_Parms;
Pts_in : Pts_In_Parms; Pts_out : Pts_Out_Parms;
Begin
Int_in[0]:=FaceNo;
VDI_Call(21,0,1,0,Control,Int_in,Int_out,Pts_in, Pts_out,False);
End {of Text_Face};
{ END OF FONTSUBS.PAS }
; Listing 2b:
; ===========
;
Start
movem.l d0/a0-a2,-(a7) ; Register retten
dc.w $a000 ; Line-A-Init
movea.l 4(a1),a1 ; Adresse des ersten
movea.l 84(a1),a1 ; GEM-Fonts bestimmen
lea Reg(Pc),a0 ; dort soll diese Adresse hin...
move.l a1, (a0) ; also machen wir das
movem.l (a7)+,d0/a0-a2 ; Register restaurieren
rts ; und zurück zum Pascal...
nop
Reg ds.l 1
End
{ Listing 3: }
{ ======== }
{$U100}
Program Font_Test; { 1987 by LPSoft Lutz Preßler 24.11.1987 }
Const {$IGEMCONST}
Type {$IGEMTYPE}
{$IFONTTYPE}
Var Zeichensatz : Font;
Pfad,ZeichsName,FaceNa : String;
Thoch,Attribute : Integer;
Ok,Zsa : Boolean;
A1,Anzahl,Face,I : Integer;
ZListe : FontList;
{$IGEMSUBS}
{$IFONTSUBS}
Procedure Taste; Gemdos(7);
{ Procedure Text_Heigth(Height:Integer); External; bei mir in GEMSUBS.PAS deklariert. }
Procedure DefText(Color,Style,Rotation,Height,
Face:Integer);
Begin
If Face>0 then Text_Face(Face);
If Color>=0 then Text_Color(Color);
If Style>=0 then Text_Style(Style);
If Rotation>=0 then Text_Rotation(Rotation);
If Height>0 then Text_Heigth(Height);
End;
Procedure FaceName(Faceld:Integer;
Var FaceName:String);
Var Control : Ctrl_Parms;
Int_in : Int_In_Parms; Int_out : Int_Out_Parms;
Pts_in : Pts_In_Parms; Pts_out : Pts_Out_Parms;
I : Integer;
Begin
Int_in[0]:=FaceId;
VDI_Call(130,0,1,0,Control,Int_in,Int_out,Pts_in, Pts_out,False);
I:=1;
Repeat
FaceName[I]:=Chr(Int_out[I]); I:=I+1;
Until (I=35) or (FaceName[I-1]=Chr(0));
FaceName[0]:=Chr(I-2);
End;
Procedure TestAusgabe(F:Integer);
Begin
Write ('Texthöhe(Pixel) : '); ReadLn(Thoch);
If IO_Result<>0 then Thoch:=13;
Write('Textattribute : '); ReadLn(Attribute);
If IO_Result<>0 then Attribute:=0;
DefText(-1,Attribute,-1,Thoch,F);
Hide_mouse;
Draw_String(10,200,'Dies ist ein GEM-Zeichensatz-Test. Lutz Pre_ler');
Show_mouse;
DefText(-1,0,-1,13,1);
End;
Procedure Bildschirm_loeschen;
Begin
Hide_mouse; Clear_Screen;
Write(Chr(27),' H'); Show_mouse;
End;
Begin If Init_Gem>=0 then begin
Bildschirm_loeschen;
Set_Clip(0,0,640,400);
WriteLn ('Letzter Font HEX: ',FontAdress(LastFontPtr):8:h);
Repeat
A1:=Do_Alert('[1][LPSoft-Pasca1-GEM-Font-Demo| Welche Zeichensatz-Art?][FNT|ZSA|ENDE]',1);
Ok:=(A1<>3);
If Ok then begin
Zsa:=(A1=2);
If Zsa then Pfad:='\*.ZSA' else Pfad:='\*.FNT' ;
ZeichsName:=' ';
Ok:=Get_In_File(Pfad,ZeichsName);
If Ok then begin
Bildschirm_loeschen;
If Zsa then begin
ZListe:=NIL;
Anzahl:=LoadZsaFonts(ZeichsName,2,ZListe);
If Anzahl=0 then WriteLn('FEHLER!') else begin WriteLn('Geladene Faces');
For I:=2 to Anzahl+1 do begin
FaceName(I,FaceNa) ;
WriteLn(I:2,': ',FaceNa);
End;
Taste; Bildschirm_loeschen;
WriteLn('Letzter Font HEX: ',FontAdress(LastFontPtr):8:h);
Repeat
IO_Check(False);
Write('Face (von 1 bis ',Anzahl+1,',Ende=0): '); ReadLn(Face);
If IO_Result<>0 then Face:=0;
If Face>0 then begin
TestAusgabe(Face);
IO_Check(True);
Taste;
End;
Bildschirm_loeschen;
Until Face=0;
UnloadFonts(ZListe);
WriteLn ('Letzter Font HEX: ', FontAdress(LastFontPtr):8:h);
End
End else begin
Zeichensatz:=LoadFont(ZeichsName,2);
If Zeichensatz=NIL then WriteLn('FEHLER!') else begin
FaceName(2,FaceNa);
WriteLn('Face-Name: ',FaceNa);
WriteLn('Letzter Font HEX: ',FontAdress(LastFontPtr):8:h);
IO_Check(False);
TestAusgabe(2);
IO_Check(True) ;
UnloadFont(Zeichensatz) ;
WriteLn('Letzter Font HEX: ',FontAdress(LastFontPtr):8:h);
Taste;
End;
End;
End;
End;
Until Ok=False;
Exit_Gem; End; End.
' Listing 4:
'
' Mehrere GEM (*.FNT) - Fonts zu einer Datei (*.ZSA) zusammenfassen.
' 1987 LPSoft, Lutz Preßler
Print " GEM-Fonts zu einer *.ZSA-Datei zusammenfassen."
Print " ";StringS(46,"-")
Print " Erzeuge Datei ... ";
Fileselect ”\*.ZSA","",Ausgabef$
Print Ausgabef$
Open "O",#1, Ausgabef$
Print #1, "ZSA-GEM-FONT*;
Input " Wieviele Faces ? ",Faces%
Print #1,Mki$(Faces%);
For F%=1 Tc Faces%
Print " Face ";F%;" : Wieviele Größen ? ";
Input "",Groessen%
Print #1,Mki$(Groessen%);
For G%=1 To Groessen%
Print " Grö_e ";G%;" ... ",
Fileselect "\*.FNT",Name$
Print Name$
Open "I",#2,Name$
Laenge%=Lof(#2)
Print #1,Mki$(Laenge%);
While Laenge%>32000
Print #1,Input$(32000,#2);
Sub Laenge%,32000
Wend
Print #1,Input$(Laenge%, #2);
Close #2
Next G%
Next F%
Close #1
Print " Ok."
Void Inp(2)
Edit
' Listing 4:
' ==========
'
' *** Font-Konvertierung von STAD- oder Fontloader-Format zu GEM-Font ***
' *** 1987 by LPSoft Lutz Pre_ler, Sandkrug, Ahornweg 11, 2904 Hatten ***
'
Repeat
Cls
Alert 1,"Font-Konvertierung , LPSoft|STAD- oder Fontloader-Fonts| in GEM-Fonts umwandeln.",1, "STAD|FONTLOAD|ENDE",Res
If Res=3
Edit
Endif
Fileselect "\*.FNT","",A$
If A$="" Or Right$(A$)="\"
Edit
Endif
If Exist(A$)
Open "I",#1,A$
Chars%=(Lof(#1)/16*Res)+32*(Res=2)
If Chars%>256 Or Chars%=0 Or (Res=2 And Chars%<65)
Print "Falsches Datei-Format!"
Void Inp(2)
Edit
Endif
If Res=2 And Chars%>96
Chars%=96
Endif
Dat$=Space$(Lof(#1)*Res+256*(Res=2))
'
If Res=1
For I=0 To Chars%-1
For B=0 To 15
Poke Varptr(Dat$)+I+B*Chars%,Inp(#1)
Next B
Next I
Lowade%=0
Else
For I=0 To Chars%+31
If I>64 And I<=96
For B=0 To 7
Void Inp(#1)
Next B
Else
J=I+32*(I>96)
For B=0 To 7
Poke Varptr(Dat$)+J+B*2*Chars%, Inp(#1)
Poke Varptr(Dat$)+J+(B*2+1)*Chars%,Peek(Varptr(Dat$)+J+B*2*Chars%)
Next B
Endif
Next I
Lowade%=32
Endif
'
Highade%=Lowade%+Chars%-1
If Res=2
Name$="Fontloader-Font"
Else
Name$="STAD-Font"
Endif
Print "Fontname: ";
Form Input 31 As Name$
Name$=Left$(Name$+String$(32,0),32)
'
Head$=Mki$(0)+Mki$(&HA00)+Name$
Head$=Head$+Chr$(Lowade%)+Chr$(0)
Head$=Head$+Chr$(Highade%)+Chr$(0)
Restore Header.data
For I=1 To 18
Read Za$
Head$=Head$+Mki$(Val("&H"+Za$))
Next I
Head$=Head$+Chr$((88+2*(Chars%+1)) Mod 256)+Chr$((88+2*(Chars%+1))\256)+Mki$(0)
Head$=Head$+Chr$(Chars% Mod 256)+Chr$(Chars%\256)+ Mki$(&H1000)+Mkl$(0)
For I=0 To Chars%
Head$=Head$+Chr$((I*8) Mod 256)+Chr$((I*8)\256)
Next I
'
Header.data:
Data 0D00,0B00,0800,0200,0200,0700,0800,0100,0700, 0100,0100,5555,5555,0800,0000,0000,5800,0000
'
Fileselect "\*.FNT","",A$
If A$<>"" And Right$(A$)<>"\"
Open "O",#2,A$
Bput #2,Varptr(Head$),88+2*(Chars%+1)
Bput #2,Varptr(Dat$),Len(Dat$)
Endif
Close
Print "Ok."
Endif
Alert 2,"Noch einen Font umwandeln?",1,"JA|NEIN",Res
Until Res=2
Edit
; *** FONTLOADER - STAD-Font als neuen Systemfont ***
; *** (sowohl GEM als auch TOS) installieren. ***
; *** auch für AUTO-Ordner(ohne Param.=SYSFONT.FNT) ***
; *** 10.12.1987 by LPSoft,Lutz Pre_ler,2904 Hatten ***
;
; Konstantendefinitionen
GemDos equ 1
Keep equ $31
FOpen equ $3D
FClose equ $3E
FRead equ $3F
FSeek equ $42
FSetDTA equ $1A
FSFirst equ $4E
Bios equ 13
Xbios equ 14
GetRez equ 4
SupExe equ 38
;
; Programmlänge berechnen
move.l 4(a7),a0
move.1 #Text,d6
sub.l a0,d6 ; d6 = zu reserv. Bereich
;
adda.l #129,a0
movea.l a0,a6 ; Adresse der Commandline
clr.l d0 ; Null-Byte ans Ende setzen
move.b -1(a0),d0
clr.b (a0,d0.b)
; Auflösung überprüfen
move #GetRez,-(a7)
trap #XBios
addq.l #2,-(a7)
lea WrongRes,a0
cmpi #2,d0
bne Error ; Fehlermeldung
;
move.l #Ok,Text ; Default-Text nach Installation
;
; Programm schon resident?
move.l #GetTrap,-(a7)
move #SupExe,-(a7)
trap #XBios
addq.l #6,a7
; movea.l OldTrap,a0
clr.b d2
movea.l #FontData,a4 ; Adresse des Fontbereichs
cmpi.l #"Lutz",-4(a0)
bne.s NichtRes
move.b #$ff,d2 ; Flag für "resident" setzen
movea.l -12(a0),a4 ; jetzt vorhandene Fontadresse
move.l -8(a0),OldFont ; Adresse des Origina1-Fonts
move.l -16(a0),GemDosTrap
move.l -20(a0),OldTrap
; Commandline "#" oder "~"
move.b (a6),d0
cmpi.b #"~",d0
beq.s RAend
move.b (a6),d0
cmpi.b #"#",d0
bne.s RWeiter
RAend
move.l #Sys,Text ; ja: Ausgabetext ändern
;
bra.s RWeiter
NichtRes ; Programm noch nicht resident:
movea.l #Info,a0 ; Info anzeigen
bsr Message
move.b (a6),d0 ; Commandline
cmpi.b #"~",d0
beq.s RFehler ; oder
move.b (a6),d0
cmpi.b #"#",d0 ; Commandline "#"
bne.s RWeiter
RFehler
movea.l #Exit,a0 ; ja: geht nicht —> Hinweise
bsr Message ; zur Anwendung anzeigen
bsr Key ; Auf Tastendruck warten
bra FResi ; Programm normal beenden
RWeiter
move.b d2,Flag ; "resident"-Flag abspeichern
;
bsr FontLaden ; —>Fontdatei(4096 Bytes)laden
; Font installieren
; Font-Adressen bestimmen
dc.w $A000
movea.1 4(a1),a3
movea.1 84(a3),a3
move.1 a3,FontBase
move.l 76(a3),d0
tst.l d0
beq FAuto
move.1 d0,OldFont
move.l a4,76(a3) ; Adresse eintragen
FAuto
move.l a4,FontAdr
; Font anmelden (direkt zugreifen)
dc.w $A000
move.l a4,-22(a0)
; Text ausgeben
movea.l Text,a0
bsr Message
; Commandline "~"?
move.b (a6),d0
cmpi.b #"~",d0
bne.s TextEnde
movea.l #NichtResiT,a0
bsr Message
TextEnde
cst.b Flag ; schon resident ?
bne FResiX
; nicht resident, dann:
; Autoordner-Start?
move.l #AutoTest,-(a7)
move #SupExe,-(a7)
trap #XBios
addq.l #6,a7
tst.b Auto
beq Normal
movea.1 #AText, a0
jsr Message
move.l #SetDOS,-(a7)
move #SupExe,-(a7)
trap #XBios
addq.l #6,a7
bra.s ResEnd
Normal
; neuen GEM-Trap und GemDos installieren
move.l #SetTraps,-(a7)
move #SupExe,-(a7)
trap #XBios
addq.l #6,a7
jsr Key
ResEnd
; Programm resident lassen
clr.w -(a7)
move.l d6,-(a7)
move.w #Keep,-(a7)
trap #GemDos
;
FResiX ; war schon resident:
jsr Key
; Commandline "~"?
move.b (a6),d0
cmpi.b #"~",d0
bne FResi
; Traps zurücksetzen
move.l #ResetTraps,-(a7)
move #SupExe,-(a7)
trap #XBios
addq.l #6,a7
FResi ; normal beenden
clr -(a7)
trap #GemDos
;
SetDOS
move.l 136,OldTrap
bra.s SetDOS2
SetTraps
move.l 136,OldTrap
move.1 #GemTrap2,136
SetDOS2
move.l 132,GemDosTrap
move.l #Trap1,132
rts
ResetTraps
move.1 OldTrap,136
move.1 GemDosTrap,132
rts
GetTrap
move.l 136,a0
rts
AutoTest
movem.l d0/d2/a0,-(a7)
clr.b d2
movea.l FontBase,a0
move.l 76(a0),d0
tst.l d0
bne.s ExAuto
move.b #$ff,d2
ExAuto
move.b d2,Auto
movem.l (a7)+,d0/d2/a0
rts
;
FontLaden
; Commandline "#" oder "~"?
move.b (a6),d0
cmpi.b #"~",d0
beq.s SysAdresse
move.b (a6),d0
cmpi.b #"#",d0
bne.s Laden
SysAdresse
; ja: Systemfontadresse in a4
; und Laden beenden
movea.l OldFont,a4
bra LEnde
Laden
move.b (a6),d0
cmpi.b #"-",d0 ; - am Anfang
bne.s DiskDa
; ja: Warten und Disk prüfen
lea InsertDisk,a0
bsr Message
bsr Key
addq.l #1,a6
move.l #FontData,-(a7)
move #FSetDTA,-(a7)
trap #GemDos
addq.l #6,a7
move #31,-(a7)
move.l #Dummy,-(a7)
move #FSFirst,-(a7)
trap #GemDos
adda.l #8,a7
;
DiskDa
; Commandline leer —> Default-Datei "SYSFONT.FNT"
move.b -1(a6),d0
tst.b d0
bne.s NameOk
move.l #Default,a6
NameOk
; Datei öffnen
move.w #0,-(a7)
move.l a6,-(a7)
move.w #FOpen,-(a7)
trap #GemDos
addq.l #8,a7
move.l d0,d1
lea NoFile,a0
tst d0
bmi Error
; Länge bestimmen
move #2,-(a7)
move d1,-(a7)
clr.l -(a7)
move #FSeek,-(a7)
trap #GemDos
adda.l #10,a7
lea WrongSize,a0
cmpi.l #4096,d0
bne ClError
move #0,-(a7)
move d1,-(a7)
clr.l -(a7)
move #FSeek,-(a7)
trap #GemDos
adda.l #10,a7
;
; Datei etwas "verdreht" einladen
clr.l d2
Zeichen
clr.w d3
Bits
clr.l d4
movea.l a4,a5
move.w d3,d4
asl.w #8,d4
add.l d2,d4
adda.l d4,a5
move.l a5,-(a7)
move.l #1,-(a7)
move.w d1,-(a7)
move.w #FRead,-(a7)
trap #GemDos
adda.l #12,a7
add.w #1,d3
cmpi.w #16,d3
bne.s Bits
add.l #1,d2
cmpi.l #256,d2
bne.s Zeichen
; Datei schlie_en
move.w d1,-(a7)
move.w #FClose,-(a7)
trap #GemDos
addq.l #4,a7
LEnde
rts
;
Trap1 ; neuer GemDos-Trap
movem.l d0/d1/a0,-(a7)
tst.b Auto
beq TNormal
move.1 FontBase,a0
move.l 76(a0),d0
tst.l d0
beq TrapOk
bsr Autoinst
bra TrapOk
TNormal
move.1 136,d0
cmpi.l #$FC0000,d0
bgt.s ChngTrap
move.l $4f2,d1
cmp.l d1,d0
blt.s TrapOk
move.l $4fa,d1
cmp.l d1,d0
bgt.s TrapOk
ChngTrap
; GEM-Trap im TOS —> ändern
move.1 #GemTrap2,136
TrapOk
movem.l (a7)+,d0/d1/a0
move.l GemdosTrap,a0
jmp(a0)
;
Autoinst
move.l 136,O1dTrap
move.l #GemTrap2,136
clr.b Auto
movea.l FontBase,a0
move.l 76(a0),OldFont
move.l FontAdr,76(a0) ; Adresse eintragen
rts
;
OldTrap
dc.l 0
GemDosTrap
dc.l 0
FontAdr
dc.l 0
OldFont
dc.l 0
dc.b "Lutz"
GemTrap2 ; neuer GEM-Trap
cmpi.b #$73,d0 ; VDI ?
bne.s JumpGEM
movem.l d0-d2/a0-a5,-(a7)
movea.l d1,a4 ; a4 zeigt auf VDIPB
movea.l (a4),a5 ; a5 zeigt auf Contrl-Feld
cmpi.w #5,(a5) ; Escape-Funktion ?
bne.s ContGEM
cmpi.w #102,10(a5) ; Font anmelden ?
bne.s ContGEM
movea.l 4(a4),a5 ; a5 zeigt jetzt auf Intin-Array
; Font-Adressen bestimmen
dc.w $A000
move.l 8(a1),d2 ; -> TOS-Font
movea.l 4(a1),a3
movea.l 84(a3),a3 ; —> GEM-Font
cmp.l d2,(a5) ; TOS-Font anmelden?
bne.s ContGEM
move.l a3,(a5) ; ... dann GEM-Font anmelden.
ContGEM
movem.l (a7)+,d0-d2/a0-a5
JumpGEM
move.l OldTrap,a0
jmp(a0)
;
; String ausgeben
Message
move.l a0,-(a7)
move #9,-(a7)
trap #GemDos
addq.l #6,a7
rts
; Auf Tastendruck warten
Key
move #7,-(a7)
trap #GemDos
addq.l #2,a7
rts
; Fehlerbehandlung...
ClError
movea.l a0,a6
; Datei schlie_en
move d1,-(a7)
move #FClose,-(a7)
trap #GemDos
addq.l #4,a7
movea.l a6,a0
Error
bsr.s Message
bsr.s Key
; Programm normal beenden
clr -(a7)
trap #GemDos
End
.data
Ok dc.b "Neuer Zeichensatz installiert. (LPSoft,1987)", 7,13,10,0
Sys dc.b "Original Systemzeichensatz wieder angemeldet.",7,13,10,0
NoFile dc.b "Fontdatei nicht vorhanden !!!", 7,13,10,0
WrongSize dc.b "Datei hat nicht das richtige Fontformat"
dc.b " (falsche Länge) ! !!", 7,13,10,0
WrongRes dc.b "Programm läuft nur in hoher Auflösung ! ! ! ", 7,13,10,0
InsertDisk dc.b "Bitte Diskette einlegen.",7,13,10,0
Info dc.b "STAD-Font als neuen 8x16 GEM- und TOS-Systemzeichensatz"
dc.b" installieren.",13,10
dc.b "(c) 1987 by LPSoft, Lutz Pre_ler, Ahornweg 11,"
dc.b" 2904 Hatten",13,10,0
Exit dc.b 13,10,"ANWENDUNG: FONTINST.TTP DATEINAM.FNT "
dc.b "DATEINAM.FNT installieren.",13,10
dc.b " oder FONTINST.TTP # Originalzeichensatz"
dc.b " wieder anmelden.",13,10,7,0
NichtResiT dc.b "Programm nicht mehr resident.",13,10,0
Dummy dc.b "\*.*", 0
Default dc.b "SYSFONT.FNT",0
AText dc.b "Aus AUTO-Ordner gestartet.",13,10
.even
.bss
;
FontBase ds. 1 1
TAuto ds.1 1
Auto ds.w 1
FontData ds.b 4096 ; Datenbereich für Font
; bis hier hin resident
Text ds.l 1 ; Textadresse (Ok oder Sys)
Flag ds.w 1 ; "resident"-Flag
;
PrgEnd
Lutz Preßler