                                                                   26 June 1994

                        THE FORMAT OF GEM SCREEN FONTS

                         Rufus S. Hendon [73250,2674]



                                 Introduction

     There used to be two kinds of GEM font:  screen fonts and printer fonts.
With the demise of the GEM version of Ventura Publisher, GEM printer fonts
have become obsolete in the PC world.  GEM screen fonts, on the other hand,
continue to have a sphere of application due to their use in programs such as
NeoPaint (OSCS Software Development, Inc.).  (NeoPaint was written using the GX
graphics development library from Genus Microprogramming.  Whether the
developers used the GX Text toolkit to supply NeoPaint's font-handling
capabilities I don't know.  If they did, this would indicate that the GX
graphics system employs the GEM screen-font format, and hence any other
application programs written with the aid of the GX system would also use this
format for their fonts.)

     I got my first information about the format of GEM screen fonts from
reading the files written by John Spirko contained in GFAFNT.ARC, which he
uploaded on 11 December 1989 to Data Library 11 of the ATARIPRO Forum on
CompuServe.  In particular, these files provided essential information about
the structure of the Font Header and the meaning of its various fields.  It
would have been much harder to figure out the format without the help provided
by Spirko's files.  The rest of what I know about GEM screen fonts was derived
from using a hex editor to examine fonts supplied with NeoPaint.

     There are some fields in the Font Header the purpose and interpretation of
which are still unclear to me, but I have learned enough to be able to convert
fonts from other formats to GEM screen fonts that are usable with NeoPaint and
to use GEM screen fonts in programs of my own to write text on the screen.

     To have a practical example to refer to in this memo, I have included at
the end an annotated dump of the NeoPaint font called THYMES13.GFT.  This font
will be referred to as the "sample font".


                                  Conventions

     Hexadecimal numbers will be identified by a suffixed H, e.g. 20H.  Numbers
without this suffix are decimal except when there is a note to the contrary.

     For the sake of consistency, all numbering is assumed to begin from 0, not
1.  Arrays are also assumed to have a lower bound of 0, not 1.

     The symbol * is used to indicate multiplication.


              How characters are represented in a GEM screen font

     Each character is displayed on the screen as a particular shape.  For
example, the character with code 26H (38) is shown by a shape similar to '&'.
The shape occupies a rectangular area called a "character cell".  The pixels
inside the cell have one of two colors.  The pixels that belong to the shape
are in the foreground color; the pixels that are not part of the shape are in
the background color.  A character is defined by specifying the dimensions of
its cell and the pattern of foreground and background pixels that forms the
shape associated with the character.

     In a GEM screen font, the cells for all characters are of the same height.
If the font is a fixed-pitch font, the width of the cell is also the same for
all characters.  In proportional-spaced fonts, on the other hand, the widths
are different, the width of the cell for a particular character depending on
the shape of the character.  The cell for 'i', for instance, will be narrower
than the cell for 'W'.

     The first illustration to the right shows the           Column
pattern for code 26H (38) in the sample font.  To           01234567
make the shape stand out, background pixels are      Row 0  --------   00000000
shown as '-' and foreground pixels as 'X'.  The      Row 1  --------   00000000
cell is 8 pixels wide and 13 pixels high.  To state  Row 2  --XX----   00110000
it differently, the cell consists of 13 rows         Row 3  -X--X---   01001000
numbered 0-12 and 8 columns numbered 0-7.            Row 4  -X--X---   01001000
                                                     Row 5  --XX----   00110000
     In the font file, screen pixels are repre-      Row 6  --XX----   00110000
sented by bits.  A bit with the value 0 corresponds  Row 7  -X--X-XX   01001011
to a background pixel, a bit with the value 1 to a   Row 8  -X--X-X-   01001010
foreground pixel.  The second illustration to the    Row 9  -X---X--   01000100
right shows the cell for '&' in bit notation.        Row 10 --XXX-X-   00111010
                                                     Row 11 --------   00000000
     This example shows certain features that are    Row 12 --------   00000000
characteristic of the way character patterns are
defined in GEM screen fonts:

     (1) Note that the column 0 of the cell consists entirely of background
pixels.  This means that if the cell for '&' is displayed on the screen
immediately to the right of the cell for another character, there will be at
least one blank column separating the two characters.  As this shows, in GEM
screen fonts the space necessary to keep successive characters apart is built
into the designs of the characters themselves, in the form of blank columns at
the left and right edges of the cell.  These blank areas preceding and
following the shape are called "sidebearings".  The fact that the font provides
sidebearings in the character pattern itself makes it unnecessary for a program
that uses the font to adjust the positions of the cells in order to insert
space between characters.  If character cells are simply placed one immediately
after the other, appropriate spacing between characters is automatically
achieved by virtue of the presence of sidebearings in the cells themselves.  As
'&' illustrates, not all characters will have both left and right sidebearings:
'&' has a one-pixel left sidebearing but no right sidebearing.  However, any
character that follows '&' is likely to have a left sidebearing, so there will
still be separation between the two characters despite the absence of a right
sidebearing in the '&' cell.

     (2) All character patterns position the shape vertically within the cell
with reference to a "baseline", which is the same for all characters.  This
ensures that when characters are strung together in a line of text they will
all appear to sit on a common baseline in the typographically appropriate
manner.  As you can see, the bottom of the '&' shape is in row 10, and the
bottoms of all letters without descenders, such as 'E' and 'r', will likewise
be in row 10.  In the '&' cell, rows 11 and 12 are blank (i.e. occupied by
background pixels), but for characters such as 'g', 'p', and 'y' the descender
will be formed by foreground pixels in these two rows.  Rows 0 and 1 are also
blank in the '&' cell, and this will be true for the patterns of most other
characters.  These blank rows ensure that there will be some space between
successive rows of text even when the cells of one row are placed immediately
below the cells of the row above.


              How character patterns are stored in the font file

     A font consists of cells specifying the shapes of all the characters
defined in the font.  Character codes can range from 0H (0) to FFH (255), but a
font typically defines only a portion of this range.  The range for a
particular font extends from the "Low ASCII" code through the "High ASCII"
code.  For the sample font, the range is from Low ASCII 20H (32), which is the
code for the space character, through High ASCII F8H (248), which is the code
for the degree sign in the extended IBM character set.  A font must provide a
cell containing a character pattern for every code in the specified range.

     All cells have the same number of rows, since all cells are of the same
height.  The GEM storage system views the font as consisting of the cells for
characters placed one after the next (going from left to right) in order by
the character codes.  Schematically, for the sample font:

Row 0  +----++----++----++----++----++----+      +----++----++----++----++----+
Row 1  |    ||    ||    ||    ||    ||    |      |    ||    ||    ||    ||    |
Row 2  |    ||    ||    ||    ||    ||    |      |    ||    ||    ||    ||    |
Row 3  |    ||    ||    ||    ||    ||    |      |    ||    ||    ||    ||    |
Row 4  |    ||    ||    ||    ||    ||    |      |    ||    ||    ||    ||    |
Row 5  |code||code||code||code||code||code|      |code||code||code||code||code|
Row 6  |20H ||21H ||22H ||23H ||24H ||25H | .... |F4H ||F5H ||F6H ||F7H ||F8H |
Row 7  |    ||    ||    ||    ||    ||    |      |    ||    ||    ||    ||    |
Row 8  |    ||    ||    ||    ||    ||    |      |    ||    ||    ||    ||    |
Row 9  |    ||    ||    ||    ||    ||    |      |    ||    ||    ||    ||    |
Row 10 |    ||    ||    ||    ||    ||    |      |    ||    ||    ||    ||    |
Row 11 |    ||    ||    ||    ||    ||    |      |    ||    ||    ||    ||    |
Row 12 +----++----++----++----++----++----+      +----++----++----++----++----+

The boxes represent the character cells containing the character patterns.
They are shown here as equal in width, but in a proportional font such as the
sample font the widths will vary.

     To store the font, each row of this array of cells is stored as a unit.
The font thus begins with row 0 of cell 20H followed by row 0 of cell 21H
followed by row 0 of cell 22H and so on through row 0 of cell F8H.  I will call
such a concatenation of the corresponding rows of a succession of cells a
"strike" (this is the term used in the documentation for Windows screen fonts,
which employ a similar storage scheme).  For a font composed of cells with a
height of 13, such as the sample font, the font is stored as 13 successive
strikes, with strike n consisting of a concatenation of the nth rows of each of
the cells.  Note that when a font is stored by strikes, the bits constituting
the pattern for a given character are not all contiguous in the file.  The bits
in a given row are contiguous, but successive rows of the pattern are separated
from one another by pattern rows for other characters.  For example, for code
24H, the bits of its row 2 are separated from the bits of its row 3 by the bits
for row 2 of all characters from code 25H through code F8H and the bits for row
3 of all characters from code 20H through code 23H.

     Physically, storage in the font file and in the computer is organized on
the basis of the byte as the smallest unit.  A byte is 8 bits long.  Each
strike is stored beginning on a byte boundary.  Within the strike, however, the
concatenation of the bits from the same-numbered rows of successive cells is
done without regard to byte boundaries.  In the sample font, the cells for the
first five codes, 20H-24H, are respectively 2, 3, 4, 6, and 5 pixels wide.  In
the strike for row n, row n for these five codes will therefore occupy
positions 0-1, 2-4, 5-8, 9-14, and 15-19:

Code:  20H-|21H-----|22H--------|23H--------------|24H-----------|25H
Bit:   0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
Byte:  0---------------------|1----------------------|2----------------------|

You can see that of the five codes, only row n of code 20H begins on a byte
boundary; for the other codes, the row begins somewhere in the middle of a
byte.  In all these cases, the row ends in the middle of a byte.  (Of course,
the rows for some codes will begin or end on a byte boundary, but this will be
merely by happenstance.)

     The length of a strike in bits is the sum of the widths of all the
character cells in the font.  For the sample font, the length is 1,146 bits.
However, since the byte is the smallest unit of storage, each strike has to be
stored in an integral number of bytes.  The number of bytes, which I call the
"strike size", is the minimum number required to hold the number of bits in the
strike, namely the number of bits divided by 8 with the result, if not an
integer, rounded up to the next higher integer.  For the sample font, 1,146/8 =
143.25, and so the strike size is 144 bytes.  The stored strike is thus 8 * 144
= 1,152 bits long, which is 6 bits more than needed.  The last 6 bits of the
last byte are therefore unused.

     The sample font, therefore, consists of 13 strikes each of which is 144
bytes long.  The first strike (strike 0) contains row 0 for all the characters,
the next strike (strike 1) contains row 1, and so on.  The font occupies 13 *
144 = 1,872 bytes of storage.


                         The components of a font file

     The collection of character patterns just described is, of course, the
heart of a font.  However, additional information is required to enable a
program to access and display these patterns.  This information is included in
the font file along with the font proper (the character patterns).

     A font file consists of four components:  (1) the Font Header, (2) the
Horizontal Offset Table, (3) the Character Offset Table, and (4) the Font Data.
The Horizontal Offset Table, however, is evidently optional, since none of the
fonts I have examined include one.

     Except for the Name field of the Font Header, the Font Header and the
offset tables consist of numbers.  These are either two-byte (16-bit) integers
or four-byte (32-bit) integers.  The way in which the integers are stored
follows the Intel convention, in which storage begins with the least
significant byte of the value on the left and ends with the most significant
byte on the right.  For example, the number 15,882 is 3E0A in hex notation.  If
this number is stored as a two-byte integer, the two bytes, from left to right,
have the values 0A 3E.  If the same number is stored as a four-byte integer,
the bytes have the values 0A 3E 00 00.


(1) The Font Header

     This identifies the file as containing a GEM screen font and gives
information about the font, including addresses (file offsets) by which the
tables and the font data can be located.

   The header in NeoPaint GEM fonts is 84 bytes long.  It has the structure
shown below.  The offset is the distance of the field from the beginning of the
file, in bytes; the field size is the length of the field in bytes:

 Offset  Field size                   Field name and contents
-------------------------------------------------------------------------------
 0H (0)       2      Font ID
                       A number identifying the font (typeface).  In NeoPaint
                       fonts this is always 0.
 2H (2)       2      Point Size
                       Supposedly the height of the font in points.  In
                       NeoPaint fonts it is the height of the character cell in
                       pixels.
 4H (4)      32      Font Name
                       The name of the font.  The maximum length is 32
                       characters (bytes).  If the name is shorter than this,
                       it is left-justified in the field and the remaining
                       bytes are filled with 00H.
24H (36)      2      Low ASCII
                       The lowest character code defined in the font.
26H (38)      2      High ASCII
                       The highest character code defined in the font.
28H (40)      2      Top                    )
2AH (42)      2      Ascent                 ) See the discussion
2CH (44)      2      Half (From Baseline)   ) below.
2EH (46)      2      Descent                )
30H (48)      2      Bottom                 )
32H (50)      2      Maximum Character Width
                       The width in pixels of the widest character pattern,
                       exclusive of sidebearings.
34H (52)      2      Maximum Cell Width
                       The width in pixels of the widest character cell (this
                       includes sidebearings).
36H (54)      2      Left Offset (Italic Text)
                       Function unknown.
38H (56)      2      Right Offset (Italic Text)
                       Function unknown.
3AH (58)      2      Thickness (Bold)
                       Function unknown.  (Presumably the amount in pixels by
                       which the program should thicken lines horizontally
                       when it generates bold characters from this font.)
3CH (60)      2      Underscore Thickness
                       Function unknown.  (Presumably the thickness in pixels
                       of the line the program draws when it underlines text in
                       this font.)
3EH (62)      2      Light Text Mask
                       Function unknown.
40H (64)      2      Italic Text Mask
                       Function unknown.
42H (66)      2      Flags
                       Function unknown.
44H (68)      4      Horizontal Offset Table Offset
                       The byte offset of the table from the beginning of the
                       file.  An offset of 00000000H indicates that there is no
                       table.
48H (72)      4      Character Offset Table Offset
                       The byte offset of the table from the beginning of the
                       file.
4CH (76)      4      Font Data Offset
                       The byte offset of the Font Data from the beginning of
                       the file.
50H (80)      2      Strike Size
                       The length in bytes of each strike in the Font Data.
52H (82)      2      Height
                       The height of the character cell in pixels (rows).
                       (Remember that all character cells have the same
                       height.)

     The five fields from Top to Bottom have something to do with the vertical
division of the character cell into zones and the placement of patterns in the
cell, but I haven't been able to deduce their meanings from an examination of
the usage of these fields in actual NeoPaint fonts.  In many fonts, but not in
all, Ascent + Descent = Height, but the point at which these two values divide
the cell doesn't, as one would expect, specify the location of the baseline.
In the sample font Ascent = 9, Descent = 4, and Height = 13, but the baseline
is row 10 (if rows are number beginning with 0) or 11 (if numbering starts
with 1).  All NeoPaint fonts have 0 for Top; some have 0 for Bottom as well,
while others set Bottom to the cell height.  For Half, some have 0, others
have one-half the cell height.  This variation seems to indicate that the
NeoPaint program itself pays no attention to these fields.

     The Font Header described by Spirko has an extra four-byte field at the
end (making the total length of the Font Header 88 bytes).  This field is
supposed to be the byte offset of the next font in the file, if the file
contains more than one font, or 00000000H if there is no next font.  This
field isn't present in the Font Headers of NeoPaint fonts.  All NeoPaint font
files contain only one font.


(2) The Horizontal Offset Table

     This table is absent in all the NeoPaint fonts, and hence this field
always has the value 00000000H.  I have no idea what the function of this
table would be in fonts that include it.


(3) The Character Offset Table

     The Character Offset Table provides the clues by which the program using
the font can retrieve the character pattern associated with a given code.  It
consists of a series of entries, each of which is a two-byte integer.  The
number of entries is n, where n = the number of codes defined in the font + 1.
The number of codes defined is High ASCII - Low ASCII + 1. In the sample font,
Low ASCII = 20H (32) and High ASCII = F8H (248), so the number of codes defined
is 248-32+1 = 217; the Character Offset Table therefore has 218 entries
(entries 0-217).  (The reason for the extra entry will be discussed in a
moment.)

     Each entry corresponds to a particular character code:  entry 0 to Low
ASCII code, entry 1 to Low ASCII code + 1, entry 2 to Low ASCII code + 2, and
so on.  Given a character code c, the number of the corresponding entry is c -
Low ASCII.  Take the character 'B' as an example.  The code for 'B' is 42H
(66).  If Low ASCII = 20H (32), the entry for 'B' in the table is entry 66-32 =
34.  If the Character Offset Table is viewed as an array of two-byte integers,
the element of the array for 'B' is the element with subscript 34.  (Since
each entry is two bytes long, the byte offset of an entry from the beginning of
the table is 2 times the entry number; the entry [or array element] for 'B'
therefore consists of bytes 68 and 69 of the table.)

     The number stored in the entry for a given code is the bit offset of the
rows of the cell for that code in the strikes constituting the Font Data.  In
the sample font, the entry for 'B' consists of two bytes with the values A1 00,
which is the Intel-format representation of the number 00A1H = 161.  This means
that in strike n of the Font Data the series of bits constituting row n of the
pattern for 'B' begins with bit 161 of the strike.

     The Character Offset Table also allows the width of the character cell for
a given code to be ascertained.  For code c, the cell width is the bit offset
given in the entry for code c+1 minus the bit offset given in the entry for
code c. For instance, in the sample font the entry for 'B' (entry 35) specifies
bit offset 161 and the entry for 'C' (entry 36) specifies bit offset 168 (A8H).
The width of the character cell for 'B' is therefore 168-161 = 7 pixels.  In
order to make this system work for the last character in the defined range,
High ASCII, the Character Offset Table has an extra entry at the end.  This
entry corresponds to a fictitious character with the code High ASCII + 1, and
specifies a fictitious bit offset equal to the bit offset of the High ASCII
code + the width of the High ASCII cell.  Because the entry for code High ASCII
+ 1 has this value, subtracting the bit offset of the High ASCII code from it
correctly yields the width of the High ASCII cell.


(4) The Font Data

     The Font Data portion of the file consists of the cells containing the
character patterns for the codes defined in the font.  The data are organized
into strikes, as described earlier.  The number of strikes is equal to the cell
height, as specified by the Height field of the Font Header.  The strikes are
in order by row, beginning from the top of the cell.  Each strike is n bytes
long, where n = the value specified in the Strike Size field of the Font
Header.


       Retrieving and displaying the character pattern for a given code

     Let's say that a program wishes to display the character 'f' with the
upper left corner of its cell at position (x,y) on the screen.  The character
is to be taken from the sample font.  It is assumed that the program has stored
a copy of the font file somewhere in memory.  Here are the steps the program
must take (some of these calculations could, of course, be done beforehand, and
the order of the steps could be changed):

     (1) Determine whether 'f' is defined in the font.  This is done by
consulting the Low ASCII and High ASCII fields of the Font Header.  If the
code for 'f' (66H = 102) is >= Low ASCII and <= High ASCII, 'f' is defined in
the font.  This is the case.

     (2) Get the bit offset of the cell for 'f' in the strikes.  The number of
the entry for 'f' in the Character Offset Table is 102 - Low ASCII = 102-32 =
70.  If the program defines the Character Offset Table as an array of two-byte
integers, the entry is element 70 of that array.  The value of element 70,
namely 185H (389), is the bit offset of the 'f' cell.

     (3) Determine the width of the cell for 'f'.  The width is the bit offset
specified for 'g' - the bit offset of 'f'.  Since the bit offset for 'f' is in
element 70 of the Character Offset Table array, the bit offset for 'g' is in
element 71, which has the value 188H (392).  The width of the 'f' cell is
therefore 392-389 = 3 pixels.

     (4) Check whether there is room on the current screen line for 'f'.  If
there isn't room at position (x,y) for the 3-pixel-wide 'f' cell, reset x and
y to the beginning of a new line.  The minimum increment for y is the cell
height of the font (given in the Height field of the Font Header).  If a new
line must be started, also check whether the new y value allows room for Height
rows beginning at that vertical position.  If it doesn't, take appropriate
action.

     (5) Determine the index (serial number) of the strike byte in which the
row for 'f' begins.  This is the bit offset (obtained in step 2) divided by 8,
with truncation to an integer.  The bit offset for 'f' is 389; hence the byte
index is 389/8 = 48.  The row for 'f' therefore begins in byte 48 of each
strike.  Then determine which of the 8 bits in byte 48 is the first bit of the
row for 'f'.  The index of the bit (its serial number in the byte) is the bit
offset - (8 * the byte number) = 389-(8*48) = 389-384 = 5. The row for 'f'
therefore begins with bit 5 in byte 48 of the strike.  (The convention in
programming literature is to number the bits of a byte 0-7 starting from the
right, but for present purposes the numbering is assumed to begin from the
left.)  Assign these two values to variables ibyte (the byte index = 48) and
ibit (the bit index = 5).

     (6) For n = 0 to (Height - 1 = 12), do the following:
         (a) Set s to the offset of strike n from the beginning of the Font
Data.  The offset is n * Strike Size (0*144 = 0 for strike 0, 1*144 = 144 for
strike 1, 2*144 = 288 for strike 2, and so on).
         (b) Set r to the offset of the byte at offset ibyte in strike n from
the beginning of the Font Data = s+ibyte (0+48 = 48 for strike 0, 144+48 = 192
for strike 1, 288+48 = 336 for strike 2, and so on).  This is the byte in which
row n of the 'f' cell begins in strike n.
         (c) Extract (with the aid of a sliding bit mask) the bits constituting
row n of the 'f' cell, beginning with bit ibit in byte r of the Font Data.
Advance into as many following bytes as necessary to obtain the number of bits
required (the cell width, as determined in step 3).  In the case of 'f', ibit
is 5 and the cell width is 3, so the bits to be extracted (bits 5, 6, and 7)
are all in the same byte (byte r), hence advance to additional bytes isn't
required.
         (d) Write the bits of the row to the screen, beginning at (x,y), using
the background color for 0 bits and the foreground color for 1 bits.  Then add
1 to y to move down on the screen to the position for the next pattern row.

     (7) Reset y to its original position (the vertical coordinate of the top
cell row for the current screen line) and add the cell width (3 for 'f') to x,
so that (x,y) points to the position where the upper left corner of the next
character pattern is to be placed.

*******************************************************************************

                       Annotated dump of the sample font

File:  THYMES13.GFT (NeoPaint font)

The numbers in cols. 1-6 are offsets in the file, in hex.  All byte values are
in hex.
-------------------------------------------------------------------------------
        Font Header

000000  00 00        Font ID: 0
        0D 00        Point Size: 13
                     Font Name: Thymes (padded with hex 00 to 32 characters)
        54 68 79 6D 65 73 00 00 00 00 00 00
000010  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
000020  00 00 00 00
        20 00        Low ASCII: 32 (space)
        F8 00        High ASCII: 248 (degree sign)
        00 00        Top: 0
        09 00        Ascent: 9
        06 00        Half: 6
        04 00        Descent: 4
000030  0D 00        Bottom: 13
        0A 00        Maximum Character Width: 10 pixels
        0B 00        Maximum Cell Width: 11 pixels
        00 00        Left Offset (Italic Text): 0
        00 00        Right Offset (Italic Text): 0
        01 00        Thickness (Bold): 1
        01 00        Underscore Thickness: 1 pixel
        55 55        Light Text Mask
000040  55 55        Italic Text Mask
        00 00        Flags
        00 00 00 00  Horizontal Offset Table Offset: 00000000H (no table!)
        54 00 00 00  Character Offset Table Offset: 00000054H
        08 02 00 00  Font Data Offset: 00000208H
000050  90 00        Strike Size: 144 bytes
        0D 00        Height: 13 pixels
-------------------------------------------------------------------------------
        Character Offset Table
        218 entries, each 2 bytes long.
        The character to which an entry corresponds is shown above the entry;
        this information is not part of the file.  For characters in the
        standard ASCII range, the character itself is shown ("sp." = "space).
        For extended ASCII characters, the code is shown in hex.

                   | sp. |  !  |  "  |  #  |  $  |  %  |
000054             |00 00|02 00|05 00|09 00|0F 00|14 00|
          &  |  '  |  (  |  )  |  *  |  +  |  ,  |  -  |
000060  1E 00|26 00|28 00|2B 00|2E 00|33 00|39 00|3B 00|
          .  |  /  |  0  |  1  |  2  |  3  |  4  |  5  |
000070  3E 00|40 00|43 00|48 00|4D 00|52 00|57 00|5C 00|
          6  |  7  |  8  |  9  |  :  |  ;  |  <  |  =  |
000080  61 00|66 00|6B 00|70 00|75 00|77 00|79 00|7F 00|
          >  |  ?  |  @  |  A  |  B  |  C  |  D  |  E  |
000090  85 00|8B 00|90 00|99 00|A1 00|A8 00|AF 00|B7 00|
          F  |  G  |  H  |  I  |  J  |  K  |  L  |  M  |
0000A0  BE 00|C4 00|CC 00|D4 00|D8 00|DD 00|E5 00|EB 00|
          N  |  O  |  P  |  Q  |  R  |  S  |  T  |  U  |
0000B0  F5 00|FD 00|05 01|0B 01|13 01|1A 01|20 01|26 01|
          V  |  W  |  X  |  Y  |  Z  |  [  |  \  |  ]  |
0000C0  2E 01|36 01|40 01|48 01|50 01|56 01|59 01|5C 01|
          ^  |  _  |  `  |  a  |  b  |  c  |  d  |  e  |
0000D0  5F 01|64 01|69 01|6C 01|71 01|76 01|7B 01|80 01|
          f  |  g  |  h  |  i  |  j  |  k  |  l  |  m  |
0000E0  85 01|88 01|8D 01|92 01|94 01|96 01|9B 01|9D 01|
          n  |  o  |  p  |  q  |  r  |  s  |  t  |  u  |
0000F0  A5 01|AA 01|AF 01|B4 01|B9 01|BD 01|C1 01|C4 01|
          v  |  w  |  x  |  y  |  z  |  {  |  |  |  }  |
000100  C9 01|CE 01|D6 01|DB 01|E0 01|E5 01|E9 01|EB 01|
          ~  | 7F  | 80  | 81  | 82  | 83  | 84  | 85  |
000110  EF 01|F5 01|FD 01|04 02|09 02|0E 02|13 02|18 02|
         86  | 87  | 88  | 89  | 8A  | 8B  | 8C  | 8D  |
000120  1D 02|22 02|27 02|2C 02|31 02|36 02|3A 02|3E 02|
         8E  | 8F  | 90  | 91  | 92  | 93  | 94  | 95  |
000130  42 02|4A 02|52 02|59 02|61 02|6B 02|70 02|75 02|
         96  | 97  | 98  | 99  | 9A  | 9B  | 9C  | 9D  |
000140  7A 02|7F 02|84 02|89 02|90 02|98 02|9E 02|A5 02|
         9E  | 9F  | A0  | A1  | A2  | A3  | A4  | A5  |
000150  AD 02|B4 02|BA 02|BF 02|C3 02|C8 02|CD 02|D2 02|
         A6  | A7  | A8  | A9  | AA  | AB  | AC  | AD  |
000160  DA 02|DF 02|E4 02|E9 02|F3 02|F3 02|FD 02|07 03|
         AE  | AF  | B0  | B1  | B2  | B3  | B4  | B5  |
000170  0A 03|11 03|18 03|18 03|22 03|2B 03|32 03|3A 03|
         B6  | B7  | B8  | B9  | BA  | BB  | BC  | BD  |
000180  42 03|4A 03|52 03|5C 03|5C 03|5C 03|5C 03|5C 03|
         BE  | BF  | C0  | C1  | C2  | C3  | C4  | C5  |
000190  61 03|69 03|69 03|69 03|69 03|69 03|6F 03|6F 03|
         C6  | C7  | C8  | C9  | CA  | CB  | CC  | CD  |
0001A0  73 03|78 03|80 03|88 03|90 03|9A 03|A2 03|AA 03|
         CE  | CF  | D0  | D1  | D2  | D3  | D4  | D5  |
0001B0  B2 03|BA 03|C1 03|C7 03|CF 03|D6 03|DD 03|E4 03|
         D6  | D7  | D8  | D9  | DA  | DB  | DC  | DD  |
0001C0  E4 03|E8 03|EC 03|F0 03|F4 03|F4 03|F4 03|F4 03|
         DE  | DF  | E0  | E1  | E2  | E3  | E4  | E5  |
0001D0  F4 03|F8 03|F8 03|FF 03|06 04|0D 04|14 04|19 04|
         E6  | E7  | E8  | E9  | EA  | EB  | EC  | ED  |
0001E0  20 04|25 04|2B 04|31 04|39 04|41 04|49 04|4E 04|
         EE  | EF  | F0  | F1  | F2  | F3  | F4  | F5  |
0001F0  56 04|56 04|59 04|63 04|63 04|63 04|6D 04|6D 04|
         F6  | F7  | F8  |extra|
000200  76 04|76 04|76 04|7A 04|
-------------------------------------------------------------------------------
        Font Data
        13 strikes, each Strike Size (90H [144]) bytes long.

                                Strike 0
000208                          00 00 00 00 00 00 00 00
000210  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
000220  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
000230  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
000240  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
000250  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
000260  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
000270  02 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
000280  00 00 20 00 00 20 00 00 00 40 00 00 00 00 00 04
000290  00 00 00 00 00 00 00 00
                                Strike 1
                                00 00 00 00 00 00 00 00
0002A0  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
0002B0  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
0002C0  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
0002D0  00 00 00 00 00 00 00 00 00 04 00 20 80 00 20 01
0002E0  08 82 02 00 00 00 02 08 80 22 22 00 00 00 00 02
0002F0  21 08 06 80 00 00 00 00 00 00 00 00 00 00 00 01
000300  85 0C 00 00 00 14 00 1A 00 00 00 00 00 00 00 00
000310  00 00 50 A1 01 55 04 08 00 A1 00 1A 00 00 02 0A
000320  08 00 10 80 00 00 70 10
                                Strike 2
                                12 94 23 04 C1 29 20 00
000330  26 11 8C 17 99 E6 30 00 00 06 1E 04 3C 1E F0 F9
000340  F1 E7 77 3B B3 8C 1B 38 E3 C3 8F 06 7D DD DD C7
000350  77 77 7D A6 60 20 60 03 01 06 17 18 00 00 00 00
000360  00 00 00 00 00 88 68 00 E4 88 C0 11 40 60 12 58
000370  80 05 04 00 03 E6 01 14 40 00 00 00 E0 EB C0 84
000380  42 13 4B 0C 61 0F 08 02 00 00 00 3B A0 20 00 02
000390  08 82 07 80 3B 88 05 2C 5C 1D 76 C0 1F C0 1F C0
0003A0  00 F0 00 00 82 00 22 10 60 00 82 A6 00 0E 04 00
0003B0  04 04 21 00 0C 00 81 88
                                Strike 3
                                12 94 64 89 21 28 C0 00
0003C0  29 32 52 34 25 29 48 00 00 09 21 04 12 22 48 48
0003D0  92 22 22 11 21 04 11 11 11 24 44 8A 54 88 88 82
0003E0  22 22 45 22 90 10 20 01 02 02 01 08 00 00 00 00
0003F0  20 00 00 00 01 24 B0 01 10 11 29 08 80 94 88 24
000400  42 02 1F 00 03 29 48 A2 24 9C 77 01 11 11 21 48
000410  84 25 90 C2 90 10 88 22 08 80 00 44 10 40 00 02
000420  02 02 08 41 11 1C AB 08 62 23 25 C0 10 40 10 40
000430  06 48 F9 F3 E7 77 27 38 90 E1 C5 9C 01 04 39 BB
000440  B3 89 CE 00 02 21 02 44
                                Strike 4
                                12 BE 94 91 21 44 C2 00
000450  29 10 42 34 21 29 4A 80 00 09 4E 8A 12 20 44 40
000460  82 02 22 11 41 06 31 91 11 24 44 88 10 88 88 82
000470  14 22 09 22 00 00 20 01 02 02 01 08 00 00 00 00
000480  20 00 00 00 01 24 00 01 00 00 00 00 00 00 00 00
000490  02 02 09 00 05 00 00 00 00 22 22 05 01 31 21 00
0004A0  00 00 08 8E 91 2E 48 42 10 00 00 44 08 80 00 02
0004B0  02 02 13 21 11 14 40 08 72 27 25 44 14 47 17 56
0004C0  88 44 48 91 22 22 72 44 91 12 20 22 01 07 11 11
0004D0  11 10 88 00 06 41 61 80
                                Strike 5
                                10 14 83 20 C0 45 22 00
0004E0  29 10 42 57 20 49 48 06 03 01 52 8A 12 20 44 50
0004F0  A2 02 22 11 81 06 31 91 11 24 44 88 10 88 88 92
000500  14 14 09 22 00 03 38 C7 37 3B BD 2D B5 8D 63 59
000510  FD C5 AF 69 79 24 00 41 0D 98 C6 31 8C 63 19 98
000520  C5 05 08 1B 05 46 31 B7 B4 A2 22 39 01 51 21 0C
000530  C6 DD 8C 92 61 29 48 82 20 00 00 44 05 02 0D 85
000540  05 05 14 A3 8A 10 66 14 02 20 00 04 14 44 14 49
000550  18 44 40 81 02 22 22 44 A1 12 23 22 49 C4 91 11
000560  11 24 50 00 02 81 90 0C
                                Strike 6
                                10 14 40 40 C0 44 0F 8C
000570  29 10 8C 54 B8 46 38 18 F8 C2 52 8A 1C 20 44 70
000580  E2 73 E2 11 81 05 51 51 11 C4 47 04 10 88 50 92
000590  08 14 11 22 00 00 A5 29 4A 4A 55 4A 4A 52 94 AA
0005A0  24 C5 25 49 49 24 00 A1 04 A4 21 08 52 94 A4 88
0005B0  45 05 0E 04 8F C9 4A 52 94 A2 22 48 E1 51 C3 82
0005C0  49 4A 4A 8E 02 2E 49 02 44 84 C8 47 02 07 12 45
0005D0  05 05 14 24 1F 08 81 14 02 20 00 04 14 46 16 50
0005E0  A4 F4 70 E1 C2 22 22 44 91 12 24 A2 49 24 91 11
0005F0  11 24 50 00 0D 11 08 04
                                Strike 7
                                10 14 20 99 2C 44 02 00
000600  49 11 02 90 A4 49 08 20 00 24 52 91 12 20 44 50
000610  A2 22 22 11 41 05 51 51 11 04 45 02 10 88 50 AA
000620  14 08 21 12 00 03 A5 09 7A 4A 55 8A 4A 52 94 A1
000630  24 A9 54 89 12 22 01 11 14 BC E7 39 D0 F7 BC 88
000640  48 88 88 1F 89 49 4A 52 94 A2 22 59 81 51 21 0E
000650  49 4A 4A 80 F4 2B 42 F0 8C 89 24 44 02 07 13 C8
000660  88 88 94 A4 04 04 47 22 02 20 00 04 14 44 14 50
000670  A4 44 40 81 02 22 22 44 89 12 24 A2 49 24 91 11
000680  11 24 20 3F E2 30 98 04
                                Strike 8
                                00 3E 11 25 28 44 02 00
000690  49 12 02 F0 A4 89 08 18 F8 C4 52 9F 12 20 44 40
0006A0  82 22 22 11 21 04 91 31 11 04 44 82 10 88 50 AA
0006B0  14 08 21 12 00 04 A5 09 42 4A 55 8A 4A 52 94 A0
0006C0  A4 A9 54 89 21 24 02 08 F4 A1 29 4A 52 84 20 88
0006D0  4F 8F 88 24 09 09 4A 52 94 A2 22 68 81 91 71 12
0006E0  49 4A 49 9E 04 A9 44 11 14 92 12 44 05 02 12 0F
0006F0  8F 8F 93 24 1F 04 29 3E 02 20 00 07 17 44 14 50
000700  A4 44 40 81 02 22 22 44 89 12 24 A2 49 C4 91 11
000710  11 24 20 00 04 50 68 04
                                Strike 9
                                00 14 92 25 10 44 00 00
000720  49 12 52 14 A4 89 08 06 03 00 4D 11 12 22 48 48
000730  82 22 22 51 11 24 91 31 11 04 44 8A 10 88 20 44
000740  22 08 45 12 00 04 A5 29 4A 4A 55 4A 4A 52 94 A0
000750  A4 90 89 46 49 24 03 F8 24 A5 29 4A 4E 94 A4 88
000760  48 88 89 24 91 29 4A 52 93 22 22 48 89 11 21 12
000770  49 4A 49 80 04 90 88 62 3C 89 24 44 08 80 12 48
000780  88 88 88 43 84 14 29 22 22 22 00 00 10 40 10 50
000790  A4 48 48 91 22 22 22 44 89 12 24 A2 49 07 11 11
0007A0  11 18 20 00 08 F0 08 04
                                Strike 10
                                10 14 64 18 E8 44 00 21
0007B0  46 3B CC 13 18 86 32 80 00 04 20 3B BE 1C F0 F9
0007C0  C1 C7 77 63 9B EE 3B 90 E3 83 8E CC 38 70 20 44
0007D0  77 1C 7D 12 00 03 98 C7 33 3A 55 2A 4A 4C E3 B3
0007E0  13 90 8B 64 79 24 00 00 C3 98 E7 39 C4 63 18 88
0007F0  5D DD DF 1F 3B E6 31 8E 71 1C 1C B1 F2 E3 B6 0E
000800  46 3A 5C 80 03 0F 00 80 04 84 C8 3B 90 40 0D 9D
000810  DD DD C7 81 0E 18 C7 77 1C 1C 00 00 1F C0 1F C9
000820  18 F0 F9 F3 E7 77 27 38 90 E1 C3 1C 71 04 0E 0E
000830  0E 08 70 00 00 10 10 04
                                Strike 11
                                00 00 20 00 00 28 00 20
000840  00 00 00 00 00 00 00 80 00 00 1E 00 00 00 00 00
000850  00 00 00 00 00 00 00 00 00 01 80 00 00 00 00 00
000860  00 00 01 02 00 00 00 00 00 08 04 00 00 00 80 80
000870  00 00 00 04 01 24 00 00 00 00 00 00 08 00 00 00
000880  00 00 00 00 00 00 00 00 02 00 00 00 00 00 00 00
000890  00 00 00 00 00 00 00 F0 04 80 00 00 20 20 00 00
0008A0  00 00 00 01 00 00 00 00 00 00 00 00 00 00 00 16
0008B0  80 00 00 00 00 00 20 00 A0 00 00 00 40 0E 00 00
0008C0  00 10 00 00 00 10 E0 00
                                Strike 12
                                00 00 00 00 00 28 00 00
0008D0  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
0008E0  00 00 00 00 00 00 00 00 00 00 C0 00 00 00 00 00
0008F0  00 00 01 86 0F 80 00 00 00 30 08 00 00 01 C1 80
000900  00 00 00 08 00 88 00 00 00 00 00 00 00 00 00 00
000910  00 00 00 00 00 00 00 00 04 00 00 00 00 00 00 00
000920  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
000930  00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
000940  00 00 00 00 00 00 00 00 00 00 00 00 40 00 00 00
000950  00 20 00 00 00 00 00 00                           
-------------------------------------------------------------------------------
        Font Data by strike, converted to bits (only the first part of each
        strike is shown).
Strike 0   0000000000000000000000000000000000000000000000000000000000000000 ...
Strike 1   0000000000000000000000000000000000000000000000000000000000000000 ...
Strike 2   0001001010010100001000110000010011000001001010010010000000000000 ...
Strike 3   0001001010010100011001001000100100100001001010001100000000000000 ...
Strike 4   0001001010111110100101001001000100100001010001001100001000000000 ...
Strike 5   0001000000010100100000110010000011000000010001010010001000000000 ...
Strike 6   0001000000010100010000000100000011000000010001000000111110001100 ...
Strike 7   0001000000010100001000001001100100101100010001000000001000000000 ...
Strike 8   0000000000111110000100010010010100101000010001000000001000000000 ...
Strike 9   0000000000010100100100100010010100010000010001000000000000000000 ...
Strike 10  0001000000010100011001000001100011101000010001000000000000100001 ...
Strike 11  0000000000000000001000000000000000000000001010000000000000100000 ...
Strike 12  0000000000000000000000000000000000000000001010000000000000000000 ...

        The same, with 0 bits represented by - and 1 bits by X, to make the
        character patterns more apparent.  The characters shown are: space ! "
        # $ % & ' ( ) * + , - .
Strike 0   ---------------------------------------------------------------- ...
Strike 1   ---------------------------------------------------------------- ...
Strike 2   ---X--X-X--X-X----X---XX-----X--XX-----X--X-X--X--X------------- ...
Strike 3   ---X--X-X--X-X---XX--X--X---X--X--X----X--X-X---XX-------------- ...
Strike 4   ---X--X-X-XXXXX-X--X-X--X--X---X--X----X-X---X--XX----X--------- ...
Strike 5   ---X-------X-X--X-----XX--X-----XX-------X---X-X--X---X--------- ...
Strike 6   ---X-------X-X---X-------X------XX-------X---X------XXXXX---XX-- ...
Strike 7   ---X-------X-X----X-----X--XX--X--X-XX---X---X--------X--------- ...
Strike 8   ----------XXXXX----X---X--X--X-X--X-X----X---X--------X--------- ...
Strike 9   -----------X-X--X--X--X---X--X-X---X-----X---X------------------ ...
Strike 10  ---X-------X-X---XX--X-----XX---XXX-X----X---X------------X----X ...
Strike 11  ------------------X-----------------------X-X-------------X----- ...
Strike 12  ------------------------------------------X-X------------------- ...


Programs and Units:
-------------------

GEMHEADR.PAS - BP7 program to show the contents of the header of a GEM font.

VIEWGEM.PAS  - Program to display user-entered text in any GEM font.  (Shows
               how to extract character bitmaps from the font and draw them on
               the screen.)

GEMFONTU.PAS - BP7 unit that makes it possible to employ GEM fonts in programs
               that use BGI graphics.

NEWSG.PAS    - Unit embedding NEWSG34.OBJ and assigning it the "procedure"
               name NewsGothic34, so that the font can be incorporated in
               BP7 .EXE files without having to load it from a file.  (Used by
               TRYGEMFO.)

TRYGEMFO.PAS - Trial program using GEMFONTU.TPU and NEWSG.TPU.

The only things you won't have (aside from the .TPU and .EXE files you can
generate for yourself with BP7) are these:

VGADRIV.TPU  - The BP7 BGI VGA driver, made into a unit so that the driver can
               be incorporated into the .EXE file without having to load it
               from a file.  (Used by VIEWGEM, TRYGEMFO.)  You can create this
               following the instructions given in the BP7 "Programmer's
               Reference" (see RegisterBGIdriver) and the BGLINK.PAS sample
               program.  If you already have a BGI driver .TPU, put its name
               in place of VGADRIV.TPU in VIEWGEM and TRYGEMFO.

NEWSG.TPU    - This is a particular GEM font converted into a unit so that it
               can be incoporated into the .EXE without having to be loaded
               from a file.  Replace this with a .TPU for some GEM font you
               have on hand.  Use BINOBJ to make it into a .OBJ file and then
               write and compile a unit on the model of NEWSG.PAS.  Substitute
               your unit for NEWSG in the "uses" line of the programs that
               make use of NEWSG.TPU.



{ VIEWGEM.PAS 1.01 (12 September 1994) (Borland Pascal 7.0, real) }
program ViewGEM;
{==============================================================================
   ViewGEM allows you to try a GEM font to see what text drawn in it looks
like.  Any number of fonts can be tried in a single session.  The program
requires a VGA card.
   ViewGEM may be invoked without arguments, in which case it will prompt you
for the name of a file containing a GEM font.
   Alternatively you may specify a file name as an argument when you invoke
ViewGEM.
-------------------------------------------------------------------------------
 3/20/93 - 1.00.  Initial compilation.
 9/14/93 - 1.01.  Corrected the handling of errors in LoadFont (after detecting
           an error, LoadFont incorrectly went on to test for other
           conditions).
==============================================================================}
uses DOS, CRT, Graph, VGADriv;

type

  TWordArray = array[0..0] of word;
  PWordArray = ^TWordArray;

  TByteArray = array[0..0] of byte;
  PByteArray = ^TByteArray;

  TGEMFontHeader = record
    FontID: word;
    PointSize: word;
    FontName: array[0..31] of char;
    LowASCII: word;
    HighASCII: word;
    Top, Ascent, Half, Descent, Bottom: integer;
    WidestCharacterWidth: word;
    WidestCellWidth: word;
    LeftOffset: integer;
    RightOffset: integer;
    Thickness: word;
    UnderscoreThickness: word;
    LightTextMask: word;
    ItalicTextMask: word;
    Flags: word;
    HorizontalOffsetTableOffset: longint;
    CharacterOffsetTableOffset: longint;
    FontDataOffset: longint;
    SpanWidth: word;
    Height: word;
    NextFontOffset: longint
  end;
  PGEMFontHeader = ^TGEMFontHeader;

var

  Argument: string;

  OriginalTextAttr: byte;

  FontFileName: PathStr;

  FontPtr: PByteArray;
  FontFileSize: word;
  FontStorageAllocated: boolean;
  FontHeaderPtr: PGEMFontHeader;
  HOTPtr, CharacterOffsetTablePtr: PWordArray;
  FontDataPtr: PByteArray;
  Ch: char;
  GraphDriver, GraphMode: integer;
  MaxX, MaxY: integer;
  CellHeight, Leading, MinCode, MaxCode, Code: word;
  CharacterNumber: word;
  CharacterX: array[1..500] of word;
  PatternOffset, PatternWidth: word;
  X, Y, PreviousX, NextX: integer;
  ByteIndex: word;
  Mask: byte;
  Col, RowIndex, Row: word;
  RowByte: byte;
  ErrorCode: word;
{*****************************************************************************}
procedure IdentifyProgram;
begin { IdentifyProgram }
  Writeln('IMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM;');
  Writeln(':                              VIEWGEM 1.01                                   :');
  Writeln(':          Copyright 1993 by Rufus S. Hendon.  All rights reserved.           :');
  Writeln('HMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM<');
end; { IdentifyProgram }
{*****************************************************************************}
procedure Explain;
begin { Explain }
  IdentifyProgram;
  Writeln('   ViewGEM allows you to try a GEM font to see what text drawn in it looks');
  Writeln('like.  Any number of fonts can be tried in a single session.  The program');
  Writeln('requires a VGA card and a color monitor.');
  Writeln('   ViewGEM may be invoked without arguments, in which case it will prompt you');
  Writeln('for the name of a file containing a GEM font.');
  Writeln('   Alternatively you may specify a file name as an argument when you invoke');
  Writeln('ViewGEM.');
  Halt(1)
end; { Explain }
{*****************************************************************************}
function ColorMonitor: boolean;
{    The function returns True if the monitor attached to the system is a
  color monitor, False if it is a monochrome monitor.  (The information is
  taken from the System Equipment Data Area.) }
var
  Flags: byte;
begin { ColorMonitor }
  asm
    int $11
    mov Flags,ah
  end;
  ColorMonitor := (Flags and $30) <> $30
end; { ColorMonitor }
{*****************************************************************************}
function FileExists(FileName: string): boolean;
{ The function returns True if the file designated by FileName exists, False
  if it doesn't. }
var
  ASCIIZName: string;
  P: pointer;
begin { FileExists }
  ASCIIZName := FileName+#0;
  P := @ASCIIZName;
  asm
    push ds              { Save DS                                      }
    mov ax,$4300         { Attempt to ascertain the attributes of       }
    mov dx,word ptr P    {   the file named FileName                    }
    inc dx
    mov cx,word ptr P+2
    mov ds,cx
    int $21
    jc @1                { If the attempt failed (carry flag set)       }
    and cx,$0018         {   or if the attempt succeeded but FileName   }
    jnz @1               {   is actually a volume label or a directory, }
    mov al,1             {   set the return value to False.  Otherwise  }
    jmp @2               {   set it to True                             }
    @1: xor al,al
    @2: mov @Result,al
    pop ds               { Restore DS                                   }
  end
end; { FileExists }
{*****************************************************************************}
procedure Warble;
{ A warbling sound is produced. }
var
  I: word;
begin { Warble }
  for I := 1 to 2 do begin
    Sound(740);
    Delay(65);
    NoSound;
    Sound(600);
    Delay(50);
    NoSound
  end;
  Sound(740);
  Delay(65);
  NoSound
end; { Warble }
{*****************************************************************************}
function GetFontFileName: boolean;
begin { GetFontFileName }
  while True do begin
    Writeln(
        'If you want to view another GEM font, enter the name of the file.');
    Writeln('But if you want to quit, just press Enter.');
    Write('>');
    Readln(FontFileName);
    if Length(FontFileName) = 0
      then Break
      else if FileExists(FontFileName)
        then Break
        else Writeln('Can''t find the file!')
  end;
  GetFontFileName := Length(FontFileName) > 0
end; { GetFontFileName }
{*****************************************************************************}
function LoadFont(var ErrorCode: word): boolean;
var
  FontFile: file;
  LongFileSize: longint;
  IsGEMFont: boolean;
begin { LoadFont }
  if FontStorageAllocated then begin
    FreeMem(FontPtr,FontFileSize);
    FontStorageAllocated := False
  end;

  Assign(FontFile,FontFileName);
  Reset(FontFile,1);

  LongFileSize := FileSize(FontFile);
  if LongFileSize > 65528
    then begin
      ErrorCode := 1;
      LoadFont := False;
      Exit
    end
  else FontFileSize := LongFileSize;

  if FontFileSize > MaxAvail
    then begin
      ErrorCode := 2;
      LoadFont := False;
      Exit
    end
    else begin
      GetMem(FontPtr,FontFileSize);
      FontStorageAllocated := True
    end;

  BlockRead(FontFile,FontPtr^,FontFileSize);
  Close(FontFile);

  FontHeaderPtr := PGEMFontHeader(FontPtr);
  IsGEMFont := True;
  with FontHeaderPtr^ do begin
    if (LowASCII > 255) or (HighASCII > 255) or (LowASCII > HighASCII)
      then IsGEMFont := False
      else if WidestCharacterWidth > WidestCellWidth
        then IsGEMFont := False
          else if (HorizontalOffsetTableOffset <> 0) and
              ((HorizontalOffsetTableOffset < SizeOf(TGEMFontHeader)-4) or
              (HorizontalOffsetTableOffset > FontFileSize))
            then IsGEMFont := False
            else if (CharacterOffsetTableOffset < SizeOf(TGEMFontHeader)-4) or
              (CharacterOffsetTableOffset > FontFileSize)
            then IsGEMFont := False
            else if (FontDataOffset < CharacterOffsetTableOffset) or
                (FontDataOffset > FontFileSize)
              then IsGEMFont := False
  end; { with ... }
  if IsGEMFont
    then ErrorCode := 0
    else ErrorCode := 3;
  LoadFont := IsGEMFont
end; { LoadFont }
{*****************************************************************************}
procedure ClearGraphicsScreen;
begin { ClearGraphicsScreen }
{ Fill the screen with light gray: }
  SetFillStyle(SolidFill,LightGray);
  Bar(0,0,MaxX,MaxY)
end; { ClearGraphicsScreen }
{*****************************************************************************}
procedure StartNewLine(var X, Y: integer);
begin { StartNewLine }
  Inc(Y,Leading);
  if (Y+Pred(Leading)) > MaxY then begin
    ClearGraphicsScreen;
    Y := 0
  end;
  X := 0
end; { StartNewLine }
{*****************************************************************************}
begin { ViewGEM }
  if ParamCount > 0 then begin
    Argument := ParamStr(1);
    if (Argument = '/?') or (Argument = '?') then Explain
  end;

  OriginalTextAttr := TextAttr;
  if ColorMonitor
    then TextAttr := $17   { light gray on blue }
    else TextAttr := $70;  { black on low-intensity white }

  ClrScr;
  IdentifyProgram;

  DetectGraph(GraphDriver,GraphMode);
  if (GraphDriver = grNotDetected) or (GraphDriver <> VGA)
    then begin
      TextAttr := OriginalTextAttr;
      Writeln('This program requires a VGA.');
      Halt(1)
    end
    else begin
      GraphMode := VGAHi;
      if RegisterBGIDriver(@EGAVGADriverProc) < 0 then begin
        TextAttr := OriginalTextAttr;
        Writeln('EGA/VGA: ',GraphErrorMsg(GraphResult));
        Halt(1)
      end
    end;

  FontStorageAllocated := False;
  FileMode := 0;  { allow read-only files to be processed }

  while GetFontFileName do begin
    ClrScr;

    if LoadFont(ErrorCode)

      then begin  { font loaded }
        with FontHeaderPtr^ do begin
          HOTPtr := @FontPtr^[HorizontalOffsetTableOffset];
          CharacterOffsetTablePtr := @FontPtr^[CharacterOffsetTableOffset];
          FontDataPtr := @FontPtr^[FontDataOffset];
          Writeln('File name: ',FontFileName);
          Writeln('Font name: ',FontName,' (height: ',PointSize,' pixels)');
          Writeln('Character code range: ',LowASCII,'-',HighASCII)
        end; { with ... }
        Writeln;
        Writeln('ZDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD?');
        Writeln('3                                Instructions                                3');
        Writeln('3                                                                            3');
        Writeln('3 After the switch to graphics mode, type text.  The text will be displayed  3');
        Writeln('3 on the screen in the GEM font.  You may use backspace to erase characters. 3');
        Writeln('3 Press Enter to begin a new line.  When the screen is full, it will be      3');
        Writeln('3 cleared automatically.  When you want to quit, press any function key.     3');
        Writeln('@DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDY');
        Writeln;
        Writeln('                           [Press any key to begin!]');
        Ch := ReadKey;

        InitGraph(GraphDriver,GraphMode,'');
        if GraphResult <> grOK then begin
          TextAttr := OriginalTextAttr;
          Writeln('Error attempting to switch to graphics mode.');
          Halt(1)
        end;

        MaxX := GetMaxX;
        MaxY := GetMaxY;

        with FontHeaderPtr^ do begin
          CellHeight := Height;
          MinCode := LowASCII;
          MaxCode := HighASCII;
          Leading := Height
        end;

        ClearGraphicsScreen;

        X := 0;
        Y := 0;
        CharacterNumber := 0;
        Ch := ReadKey;
        while Ch <> #0 do begin
          Code := Ord(Ch);

          if Code = 13  { Enter }

            then begin
              StartNewLine(X,Y);
              CharacterNumber := 0
            end

            else if Code = 8  { Backspace }

              then begin
                if CharacterNumber = 0
                  then { don't do anything }
                  else begin
                  { Fill the area occupied by the pattern with light gray: }
                    SetFillStyle(SolidFill,LightGray);
                    PreviousX := CharacterX[CharacterNumber];
                    Bar(PreviousX,Y,Pred(X),Y+Pred(Leading));
                    X := PreviousX;
                    Dec(CharacterNumber)
                  end
              end

              else if (Code < MinCode) or (Code > MaxCode)

                then  { don't do anything }

                else begin  { valid character code }
                  Code := Code-MinCode;
                  PatternOffset := CharacterOffsetTablePtr^[Code];
                  PatternWidth := CharacterOffsetTablePtr^[Succ(Code)]-
                      PatternOffset;

                  if PatternWidth = 0

                    then  { undefined character -- don't do anything }

                    else begin  { defined character }
                      NextX := X+Pred(PatternWidth);
                      if NextX > MaxX then begin
                        Inc(Y,Leading);
                        if (Y+Pred(Leading)) > MaxY then begin
                          SetFillStyle(SolidFill,LightGray);
                          Bar(0,0,MaxX,MaxY);
                          Y := 0
                        end;
                        X := 0;
                        CharacterNumber := 0
                      end;
                      ByteIndex := PatternOffset div 8;
                      Mask := $80 shr (PatternOffset mod 8);
                      for Col := 0 to Pred(PatternWidth) do begin
                        RowIndex := ByteIndex;
                        for Row := 0 to Pred(CellHeight) do begin
                          RowByte := FontDataPtr^[RowIndex];
                          if (RowByte and Mask) = Mask
                            then PutPixel(X+Col,Y+Row,Black);
                          RowIndex := RowIndex+FontHeaderPtr^.SpanWidth
                        end; { for Row ... }
                        Mask := Mask shr 1;
                        if Mask = $00 then begin
                          Inc(ByteIndex);
                          Mask := $80
                        end
                      end; { for Col ... }
                      Inc(CharacterNumber);
                      CharacterX[CharacterNumber] := X;
                      Inc(X,PatternWidth)
                    end  { defined character }

                end;  { valid character code }

          Ch := ReadKey
        end; { while Ch <> #0 ... }

        Ch := ReadKey;  { read the pending extended code }
        CloseGraph;
        ClrScr
      end  { font loaded }
      else begin  { font not loaded }
        ClrScr;
        case ErrorCode of
          1: Writeln('This file is too large to contain a GEM font.');
          2: Writeln('There isn''t enough memory to load this file.');
          3: Writeln('This file doesn''t appear to contain a GEM Font.')
        end; { case ... }
        Writeln('                         [Press any key to continue.]');
        Ch := ReadKey;
        if Ch = #0 then Ch := ReadKey
      end  { font not loaded }

  end; { while GetFontFileName ... }

  TextAttr := OriginalTextAttr;
  ClrScr
end. { ViewGEM }



{ GEMFONTU.PAS 1.00 (22 March 1993) (Borland Pascal 7.0, real) }
{ Copyright 1993 by Rufus S. Hendon.  All rights reserved. }
unit GEMFontU;
{==============================================================================
   This unit provides facilities for using GEM-format bitmap fonts in programs
that use BGI graphics.
   GEM fonts may be loaded from files during program execution or they may be
linked into the .EXE file.  (This requires converting the font to an .OBJ file
using BINOBJ and then creating a .TPU file following the same procedures as for
BGI drivers and fonts.)  GEM fonts are manipulated by identifiers, which have
the form of pointers.
   The same color setting and text settings that control the use of BGI fonts
also control the use of GEM fonts, with these differences:
   (1) The text settings for font and size are ignored.  GEM files are always
drawn at their native size.
   (2) Several directions in addition to the two available for BGI fonts can be
specified in a call to SetTextSettings.  These are:
       2 - Vertical, from top to bottom, rotated 90 degrees clockwise.  For
this direction, left justification means that the top (beginning) of the text
is at the current position, center justification means that half the text is
above the current position and half below, and right justification means that
the bottom (end) of the text is at the current position.
       3 - Horizontal, from right to left.  Right justification means that the
right end (beginning) of the text is at the current position, center justifica-
tion means that the text is centered at the current position, and left justifi-
cation means that the left end (end) of the text is at the current position.
       4 - Vertical, from top to bottom, without rotation.  The meaning of
justification is the same as for 2.  The "Vert" setting is interpreted as
applying to the horizontal positioning of the characters relative to the X
coordinate of the current position.  TopText causes the left edges of the
characters to be aligned at X.  CenterText causes the characters to be centered
at X.  BottomText causes the right edges of the characters to be aligned at X.
-------------------------------------------------------------------------------
 3/20/93 - 1.00.  Initial compilation.
==============================================================================}
interface
uses DOS;

type

  TWordArray0 = array[0..32766] of word;
  PWordArray0 = ^TWordArray0;

  TByteArray0 = array[0..65534] of byte;
  PByteArray0 = ^TByteArray0;

  TExtendedGEMFontHeader = record
    CharacterOffsetTablePtr: PWordArray0;  { Extended portion begins here }
    FontDataPtr: PByteArray0;
    AllocatedBytes: word;
    FontID: word;                          { True font header begins here }
    PointSize: word;
    FontName: array[0..31] of char;
    LowASCII: word;
    HighASCII: word;
    Top, Ascent, Half, Descent, Bottom: integer;
    WidestCharacterWidth: word;
    WidestCellWidth: word;
    LeftOffset: integer;
    RightOffset: integer;
    Thickness: word;
    UnderscoreThickness: word;
    LightTextMask: word;
    ItalicTextMask: word;
    Flags: word;
    HorizontalOffsetTableOffset: longint;
    CharacterOffsetTableOffset: longint;
    FontDataOffset: longint;
    SpanWidth: word;
    Height: word;
    NextFontOffset: longint
  end;
  PExtendedGEMFontHeader = ^TExtendedGEMFontHeader;

function GEMTextHeight(GEMFontID: pointer; TextString: string): word;
{ If GEMFontID is a valid identifier of a GEM font, this function returns the
  character height of TextString in pixels when drawn in font GEMFontID.  (The
  character height is identical with the cell height of the font.)  Otherwise
  the function returns 0.  (The function makes no use of TextString, since the
  cell height is an attribute of the font. TextString is included for symmetry
  with the TextHeight function.) }

function GEMTextWidth(GEMFontID: pointer; TextString: string): word;
{ If GEMFontID is a valid identifier of a GEM font, this function returns the
  width of TextString in pixels when drawn in font GEMFontID.  Otherwise it
  returns 0. }

function LoadGEMFont(FontFileName: PathStr; var Leading, ErrorCode: word):
  pointer;
{ This function loads a GEM font from file FontFileName, sets Leading to the
  cell height of the font and ErrorCode to 0, and returns an identifier for
  the font.  If, however, an error occurs during the attempt to load the font,
  the function returns nil with ErrorCode set to one of these codes:
     1 - The file is too large for LoadGEMFont to process.
     2 - There isn't enough heap memory to store the font.
     3 - The file doesn't contain a GEM font.                                 }

procedure OutGEMText(GEMFontID: pointer; TextString: string);
{ If GEMFontID is a valid identifier of a GEM font, TextString is drawn at the
  current position in that font.  The text is clipped at the boundaries of the
  screen.  The current position is updated only if the direction is horizontal
  and justification is left (if the direction is left to right) or right (if
  the direction is right to left).  However, if GEMFontID isn't a valid
  identifier, no action is taken. }

procedure OutGEMTextXY(GEMFontID: pointer; X, Y: integer; TextString: string);
{ Like OutGEMText,except that the text is drawn at position (X,Y) rather than
  the current position.  Also, the current position isn't updated under any
  circumstances. }

function RegisterGEMFont(LinkedGEMFontPtr: pointer; var Leading, ErrorCode:
  word): pointer;
{ LinkedGEMFontPtr is the address of the external name of a GEM font that was
  linked into the .EXE file from a unit.  The function returns an identifier
  for the font, sets Leading to the cell height of the font, and sets ErrorCode
  to 0.  However, if an error is detected, the function returns nil with
  Leading set to 0 and ErrorCode set to one of these codes:
     1 - LinkedGEMFontPtr is nil.
     2 - There isn't enough heap memory for the control information created by
         the function.
     3 - LinkedGEMFontPtr doesn't point to a GEM font.                        }

procedure UnloadGEMFont(var GEMFontID: pointer);
{ The GEM font identified by GEMFontID is removed from memory and GEMFontID is
  set to nil. }
{=============================================================================}
implementation
uses Graph;

const
  ExtensionBytes = 10;  { extra bytes needed for the font header extension }

{*****************************************************************************}
function GEMTextHeight(GEMFontID: pointer; TextString: string): word;
var
  FontHeaderPtr: PExtendedGEMFontHeader absolute GEMFontID;
begin { GEMTextHeight }
  if GEMFontID <> nil
    then GEMTextHeight := FontHeaderPtr^.Height
    else GEMTextHeight := 0
end; { GEMTextHeight }
{*****************************************************************************}
function GEMTextWidth(GEMFontID: pointer; TextString: string): word;
var
  FontHeaderPtr: PExtendedGEMFontHeader absolute GEMFontID;

  MinCode, MaxCode, Width: word;
  COTPtr: PWordArray0;
  StringPtr: pointer;
  SaveDS: word;
begin { GEMTextWidth }
  Width := 0;

  if GEMFontID <> nil then begin
    with FontHeaderPtr^ do begin
      MinCode := LowASCII;
      MaxCode := HighASCII;
      COTPtr := CharacterOffsetTablePtr
    end;
    StringPtr := @TextString;
    asm
      mov SaveDS,ds            { Save DS in SaveDS                            }
      lds si,StringPtr         { Set DS:SI to @TextString[0]                  }
      mov cl,[si]              { Set CX to Length(TextString)                 }
      xor ch,ch                {                                              }
      jcxz @3                  { If CX = 0, skip to @3                        }
      mov ah,byte ptr MaxCode  { Otherwise set AH to MaxCode, AL to MinCode   }
      mov al,byte ptr MinCode  {                                              }
      les di,COTPtr            { Set ES:DI to point to the Character Offset   }
                               {   Table                                      }
      @1: inc si               { For each character of TextString:            }
      mov bl,[si]              {   Set BL to the character                    }
      cmp bl,al                {   If BL < Mincode or > MaxCode, do nothing   }
      jb @2                    {                                              }
      cmp bl,ah                {                                              }
      ja @2                    {                                              }
      sub bl,al                {   Otherwise reset BX to (BL-MinCode)*2 to    }
      xor bh,bh                {     index the Character Offset Table entry   }
      shl bx,1                 {     for the character                        }
      mov dx,es:[di+bx+2]      {   Set DX to the entry for the next higher    }
      sub dx,es:[di+bx]        {     character - the entry for this character }
                               {     = the width of this character            }
      add Width,dx             {   Add DX to Width                            }
      @2: loop @1              {                                              }
      @3: mov ds,SaveDS        { Restore DS from SaveDS                       }
    end
  end;

  GEMTextWidth := Width
end; { GEMTextWidth }
{****************************************************************************}
function LoadGEMFont(FontFileName: PathStr; var Leading, ErrorCode: word):
  pointer;
var
  FontFile: file;
  LongFileSize: longint;
  FontFileSize, AllocationSize: word;
  FontPtr: PByteArray0;
  FontHeaderPtr: PExtendedGEMFontHeader absolute FontPtr;
  IsGEMFont: boolean;
  TrueFontHeaderSize: word;
begin { LoadGEMFont }
  Assign(FontFile,FontFileName);
  Reset(FontFile,1);

  LongFileSize := FileSize(FontFile);
  if LongFileSize > 65518  { 65528-ExtensionBytes }
    then begin
      ErrorCode := 1;
      LoadGEMFont := nil
    end
  else begin
    FontFileSize := LongFileSize;
    AllocationSize := ExtensionBytes+FontFileSize
  end;

  if AllocationSize > MaxAvail
    then begin
      ErrorCode := 2;
      LoadGEMFont := nil
    end
    else GetMem(FontPtr,AllocationSize);

  BlockRead(FontFile,FontPtr^[ExtensionBytes],FontFileSize);
  Close(FontFile);

  IsGEMFont := True;
  TrueFontHeaderSize := SizeOf(TExtendedGEMFontHeader)-ExtensionBytes;
  with FontHeaderPtr^ do begin
    if (LowASCII > 255) or (HighASCII > 255) or (LowASCII > HighASCII)
      then IsGEMFont := False
      else if WidestCharacterWidth > WidestCellWidth
        then IsGEMFont := False
          else if (HorizontalOffsetTableOffset <> 0) and
              ((HorizontalOffsetTableOffset < (TrueFontHeaderSize-4))
              or (HorizontalOffsetTableOffset > FontFileSize))
            then IsGEMFont := False
            else if (CharacterOffsetTableOffset < (TrueFontHeaderSize-4)) or
              (CharacterOffsetTableOffset > FontFileSize)
            then IsGEMFont := False
            else if (FontDataOffset < CharacterOffsetTableOffset) or
                (FontDataOffset > FontFileSize)
              then IsGEMFont := False
  end; { with ... }
  if not IsGEMFont
    then begin
      FreeMem(FontPtr,AllocationSize);
      ErrorCode := 3;
      Leading := 0;
      LoadGEMFont := nil
    end
    else with FontHeaderPtr^ do begin
      AllocatedBytes := AllocationSize;
      CharacterOffsetTablePtr := @FontPtr^[CharacterOffsetTableOffset+
          ExtensionBytes];
      FontDataPtr := @FontPtr^[FontDataOffset+ExtensionBytes];
      Leading := Height;
      ErrorCode := 0;
      LoadGEMFont := FontPtr
    end
end; { LoadGEMFont }
{*****************************************************************************}
(*
procedure DrawGEMText(GEMFontID: pointer; X, Y: integer; var TextString:
  string; UpdateCP: boolean);
var
  FontPtr: PByteArray0 absolute GEMFontID;
  FontHeaderPtr: PExtendedGEMFontHeader absolute GEMFontID;

  CellHeight, CellHeightLess1, MinCode, MaxCode: word;
  COTPtr: PWordArray0;
  StrikePtr: PByteArray0;
  RowInterval: word;
  TextSettings: TextSettingsType;
  Width: word;
  OriginalY, MaxX, MaxY: integer;
  Color, I: word;
  Ch: char;
  Code, PatternOffset, PatternWidth, PatternWidthLess1, ByteIndex: word;
  Mask: byte;
  Col, RowIndex, Row: integer;
  RowByte: byte;
begin { DrawGEMText }
  if GEMFontID = nil then Exit;

  with FontHeaderPtr^ do begin
    CellHeight := Height;
    MinCode := LowASCII;
    MaxCode := HighASCII;
    COTPtr := CharacterOffsetTablePtr;
    StrikePtr := FontDataPtr;
    RowInterval := SpanWidth
  end; { with FontHeaderPtr^ ... }

  GetTextSettings(TextSettings);
  with TextSettings do begin
    if (Direction <> HorizDir) or (Horiz <> LeftText)
      then UpdateCP := False;
    if Horiz <> LeftText then begin
      Width := GEMTextWidth(GEMFontID,TextString);
      if Horiz = CenterText
        then X := X-Width div 2
        else if Horiz = RightText
          then X := Succ(X-Width)
    end;
    OriginalY := Y;
    case Vert of
      BottomText:  Y := Succ(Y-CellHeight);
      CenterText:  Y := Y-CellHeight div 2;
      TopText: { leave Y as is };
    end
  end; { with TextSettings ... }

  MaxX := GetMaxX;
  MaxY := GetMaxY;
  Color := GetColor;

  if Y+Pred(CellHeight) > MaxY        { to clip at the bottom of the screen }
    then CellHeight := Succ(MaxY-Y);  { if necessary                        }

  CellHeightLess1 := Pred(CellHeight);

  for I := 1 to Length(TextString) do begin
    Ch := TextString[I];
    Code := Ord(Ch);
    if (Code < MinCode) or (Code > MaxCode)

      then  { don't do anything }

      else begin  { valid character code }
        Code := Code-MinCode;
        PatternOffset := COTPtr^[Code];
        PatternWidth := COTPtr^[Succ(Code)]-PatternOffset;

        if PatternWidth = 0

          then  { undefined character -- don't do anything }

          else begin  { defined character }
            PatternWidthLess1 := Pred(PatternWidth);
            if X+PatternWidthLess1 > MaxX then begin  { clip at the right  }
              PatternWidth := Succ(MaxX-X);           { edge of the screen }
              PatternWidthLess1 := Pred(PatternWidth) { if necessary       }
            end;
            ByteIndex := PatternOffset div 8;
            Mask := $80 shr (PatternOffset mod 8);
            for Col := X to X+PatternWidthLess1 do begin
              if Col >= 0 then begin  { clip at the left edge of the screen }
                RowIndex := ByteIndex;
                for Row := Y to Y+CellHeightLess1 do begin
                  RowByte := StrikePtr^[RowIndex];
                  if (RowByte and Mask) = Mask
                    then PutPixel(Col,Row,Color);
                  Inc(RowIndex,RowInterval)
                end { for Row ... }
              end;
              if Mask = $01
                then begin
                  Inc(ByteIndex);
                  Mask := $80
                end
                else Mask := Mask shr 1
            end; { for Col ... }
            Inc(X,PatternWidth);
            if X > MaxX then Break
          end  { defined character }

      end  { valid character code }

  end; { for I ... }

  if UpdateCP then begin
    if X <= MaxX
      then MoveTo(X,OriginalY)
      else MoveTo(MaxX,OriginalY) { Programmer's Reference doesn't specify   }
                                  { what OutText does in this case, so this  }
                                  { is arbitrary!                            }
  end
end; { DrawGEMText }
*)
{*****************************************************************************}
procedure DrawGEMText0(GEMFontID: pointer; X, Y: integer; var TextString:
  string; var TextSettings: TextSettingsType; UpdateCP: boolean);
var
  FontPtr: PByteArray0 absolute GEMFontID;
  FontHeaderPtr: PExtendedGEMFontHeader absolute GEMFontID;

  CellHeight, MinCode, MaxCode: word;
  COTPtr: PWordArray0;
  StrikePtr: PByteArray0;
  RowInterval: word;
  Width: word;
  OriginalY, MaxX, MaxY: integer;
  Color: word;
  PatternOffset, PatternWidth, ByteIndex: word;
  Mask: byte;
  Col, RowIndex, Row: integer;

  TextStringPtr: pointer;
  SaveDS, TextStringCX, ColCX, RowCX: word;
  MinMax: word;
begin { DrawGEMText0 }
  with FontHeaderPtr^ do begin
    CellHeight := Height;
    MinCode := LowASCII;
    MaxCode := HighASCII;
    COTPtr := CharacterOffsetTablePtr;
    StrikePtr := FontDataPtr;
    RowInterval := SpanWidth
  end; { with FontHeaderPtr^ ... }

  with TextSettings do begin
    if (Direction <> HorizDir) or (Horiz <> LeftText)
      then UpdateCP := False;
    if Horiz <> LeftText then begin
      Width := GEMTextWidth(GEMFontID,TextString);
      if Horiz = CenterText
        then X := X-Width div 2
        else if Horiz = RightText
          then X := Succ(X-Width)
    end;
    OriginalY := Y;
    case Vert of
      BottomText: Y := Succ(Y-CellHeight);
      CenterText: Y := Y-CellHeight div 2;
      TopText: { leave Y as is };
    end
  end; { with TextSettings ... }

  MaxX := GetMaxX;
  MaxY := GetMaxY;
  Color := GetColor;

  if Y+Pred(CellHeight) > MaxY        { to clip at the bottom of the screen }
    then CellHeight := Succ(MaxY-Y);  { if necessary                        }

  TextStringPtr := @TextString;

  asm
    mov SaveDS,ds
    mov al,byte ptr MinCode
    mov ah,byte ptr MaxCode
    mov MinMax,ax
    lds si,TextStringPtr
    mov cl,[si]
    xor ch,ch
    test cx,cx
    jnz @NextCh
    jmp @ResetDS

    @NextCh: mov TextStringCX,cx
    lds si,TextStringPtr
    inc si
    mov word ptr TextStringPtr,si
    mov bl,[si]
    mov ax,MinMax
    cmp bl,al
    jb @StepCh
    cmp bl,ah
    ja @StepCh
    xor bh,bh
    sub bl,al
    shl bx,1
    lds si,COTPtr
    mov ax,[si+bx]
    mov PatternOffset,ax
    mov bx,[si+bx+2]
    sub bx,ax
    mov PatternWidth,bx
    mov cx,ax
    shr ax,1
    shr ax,1
    shr ax,1
    mov ByteIndex,ax  { PatternOffset div 8 }
    mov al,$80
    and cx,$07
    shr al,cl
    mov Mask,al  { $80 shr (PatternOffset mod 8) }
    mov ax,X
    add ax,bx
    dec ax  { X+PatternWidth-1 }
    cmp ax,MaxX
    jle @XOK

    mov ax,MaxX
    sub ax,X
    inc ax
    mov PatternWidth,ax  { MaxX-X+1 }

    @XOK: mov si,X  { Col }
    mov ah,Mask
    mov cx,PatternWidth
    mov ds,SaveDS  { for PutPixel }

    @ColLoop: mov ColCX,cx
    test si,si
    jl @ShiftMask
    mov bx,ByteIndex
    mov dx,Y  { Row }
    les di,StrikePtr
    mov cx,CellHeight

    @RowLoop: mov al,es:[di+bx]
    and al,ah
    jz @StepRow

    mov Mask,ah  { save AH, BX, CX, DX, SI }
    mov RowIndex,bx
    mov RowCX,cx
    mov Row,dx
    mov Col,si
    push si  { PutPixel(Col,Row,Color); }
    push dx
    mov ax,Color
    push ax
    call PutPixel
    mov ah,Mask  { restore AH, BX, CX, DX, SI }
    mov bx,RowIndex
    mov cx,RowCX
    mov dx,Row
    mov si,Col
    les di,StrikePtr  { reset ES:DI }

    @StepRow: add bx,RowInterval
    inc dx
    loop @RowLoop

    @ShiftMask: shr ah,1
    jnz @StepCol
    inc ByteIndex
    mov ah,$80
    @StepCol: inc si
    mov cx,ColCX
    loop @ColLoop

    mov ax,X
    add ax,PatternWidth
    cmp ax,MaxX
    jg @ResetDS
    mov X,ax
    @StepCh: mov cx,TextStringCX
    loop @StepCh1
    jmp @ResetDS
    @StepCh1: jmp @NextCh

    @ResetDS: mov ds,SaveDS
  end;

  if UpdateCP then begin
    if X < 0
      then X := 0
      else if X > MaxX
        then X := MaxX;
    MoveTo(X,OriginalY)
  end
end; { DrawGEMText0 }
{*****************************************************************************}
procedure DrawGEMText1(GEMFontID: pointer; X, Y: integer; var TextString:
  string; var TextSettings: TextSettingsType);
{ For Direction = VertDir (vertical, bottom up, rotated 90 degrees counter-
  clockwise). }
var
  FontPtr: PByteArray0 absolute GEMFontID;
  FontHeaderPtr: PExtendedGEMFontHeader absolute GEMFontID;

  CellHeight, CellHeightLess1, MinCode, MaxCode: word;
  COTPtr: PWordArray0;
  StrikePtr: PByteArray0;
  RowInterval: word;
  Width: word;
  MaxX, MaxY: integer;
  Color, I: word;
  Ch: char;
  Code, PatternOffset, PatternWidth, PatternWidthLess1, ByteIndex: word;
  Mask: byte;
  Col, RowIndex, Row: integer;
  RowByte: byte;
begin { DrawGEMText1 }
  with FontHeaderPtr^ do begin
    CellHeight := Height;
    MinCode := LowASCII;
    MaxCode := HighASCII;
    COTPtr := CharacterOffsetTablePtr;
    StrikePtr := FontDataPtr;
    RowInterval := SpanWidth
  end; { with FontHeaderPtr^ ... }

  with TextSettings do begin
    if Horiz <> LeftText then begin
      Width := GEMTextWidth(GEMFontID,TextString);
      if Horiz = CenterText
        then Y := Y+Width div 2
        else if Horiz = RightText
          then Y := Pred(Y+Width)
    end;
    case Vert of
      BottomText: X := Succ(X-CellHeight);
      CenterText: X := X-CellHeight div 2;
      TopText: { leave X as is };
    end
  end; { with TextSettings ... }

  MaxX := GetMaxX;
  MaxY := GetMaxY;
  Color := GetColor;

  if X+Pred(CellHeight) > MaxX        { to clip at the right edge of the }
    then CellHeight := Succ(MaxX-X);  { screen                           }

  CellHeightLess1 := Pred(CellHeight);

  for I := 1 to Length(TextString) do begin
    Ch := TextString[I];
    Code := Ord(Ch);
    if (Code < MinCode) or (Code > MaxCode)

      then  { don't do anything }

      else begin  { valid character code }
        Code := Code-MinCode;
        PatternOffset := COTPtr^[Code];
        PatternWidth := COTPtr^[Succ(Code)]-PatternOffset;

        if PatternWidth = 0

          then  { undefined character -- don't do anything }

          else begin  { defined character }
            PatternWidthLess1 := Pred(PatternWidth);
            if Y-PatternWidthLess1 < 0 then begin     { clip at the top of }
              PatternWidth := Succ(Y);                { the screen         }
              PatternWidthLess1 := Pred(PatternWidth)
            end;
            ByteIndex := PatternOffset div 8;
            Mask := $80 shr (PatternOffset mod 8);
            for Col := Y downto Y-PatternWidthLess1 do begin
              if Col <= MaxY then begin  { clip at the bottom of the screen }
                RowIndex := ByteIndex;
                for Row := X to X+CellHeightLess1 do begin
                  RowByte := StrikePtr^[RowIndex];
                  if (RowByte and Mask) = Mask
                    then if Row >= 0                { clip at the left edge }
                      then PutPixel(Row,Col,Color); { of the screen         }
                  Inc(RowIndex,RowInterval)
                end { for Row ... }
              end;
              if Mask = $01
                then begin
                  Inc(ByteIndex);
                  Mask := $80
                end
                else Mask := Mask shr 1
            end; { for Col ... }
            Dec(Y,PatternWidth);
            if Y < 0 then Break
          end  { defined character }

      end  { valid character code }

  end { for I ... }
end; { DrawGEMText1 }
{*****************************************************************************}
procedure DrawGEMText2(GEMFontID: pointer; X, Y: integer; var TextString:
  string; var TextSettings: TextSettingsType);
{ For Direction = 2 (vertical, top down, rotated 90 degrees clockwise. }
var
  FontPtr: PByteArray0 absolute GEMFontID;
  FontHeaderPtr: PExtendedGEMFontHeader absolute GEMFontID;

  CellHeight, CellHeightLess1, MinCode, MaxCode: word;
  COTPtr: PWordArray0;
  StrikePtr: PByteArray0;
  RowInterval: word;
  Width: word;
  MaxX, MaxY: integer;
  Color, I: word;
  Ch: char;
  Code, PatternOffset, PatternWidth, PatternWidthLess1, ByteIndex: word;
  Mask: byte;
  Col, RowIndex, Row: integer;
  RowByte: byte;
begin { DrawGEMText1 }
  with FontHeaderPtr^ do begin
    CellHeight := Height;
    MinCode := LowASCII;
    MaxCode := HighASCII;
    COTPtr := CharacterOffsetTablePtr;
    StrikePtr := FontDataPtr;
    RowInterval := SpanWidth
  end; { with FontHeaderPtr^ ... }

  with TextSettings do begin
    if Horiz <> LeftText then begin
      Width := GEMTextWidth(GEMFontID,TextString);
      if Horiz = CenterText
        then Y := Y-Width div 2
        else if Horiz = RightText
          then Y := Succ(Y-Width)
    end;
    case Vert of
      BottomText: X := Pred(X+CellHeight);
      CenterText: X := X+CellHeight div 2;
      TopText: { leave X as is };
    end
  end; { with TextSettings ... }

  MaxX := GetMaxX;
  MaxY := GetMaxY;
  Color := GetColor;

  if Succ(X) < CellHeight        { to clip at the left edge of the }
    then CellHeight := Succ(X);  { screen                          }

  CellHeightLess1 := Pred(CellHeight);

  for I := 1 to Length(TextString) do begin
    Ch := TextString[I];
    Code := Ord(Ch);
    if (Code < MinCode) or (Code > MaxCode)

      then  { don't do anything }

      else begin  { valid character code }
        Code := Code-MinCode;
        PatternOffset := COTPtr^[Code];
        PatternWidth := COTPtr^[Succ(Code)]-PatternOffset;

        if PatternWidth = 0

          then  { undefined character -- don't do anything }

          else begin  { defined character }
            PatternWidthLess1 := Pred(PatternWidth);
            if Y+PatternWidthLess1 > MaxY then begin  { clip at the bottom }
              PatternWidth := Succ(MaxY-Y);           { of the screen      }
              PatternWidthLess1 := Pred(PatternWidth)
            end;
            ByteIndex := PatternOffset div 8;
            Mask := $80 shr (PatternOffset mod 8);
            for Col := Y to Y+PatternWidthLess1 do begin
              if Col >= 0 then begin  { clip at the top of the screen }
                RowIndex := ByteIndex;
                for Row := X downto X-CellHeightLess1 do begin
                  RowByte := StrikePtr^[RowIndex];
                  if (RowByte and Mask) = Mask
                    then if Row <= MaxX             { clip at the right  }
                      then PutPixel(Row,Col,Color); { edge of the screen }
                  Inc(RowIndex,RowInterval)
                end { for Row ... }
              end;
              if Mask = $01
                then begin
                  Inc(ByteIndex);
                  Mask := $80
                end
                else Mask := Mask shr 1
            end; { for Col ... }
            Inc(Y,PatternWidth);
            if Y > MaxY then Break
          end  { defined character }

      end  { valid character code }

  end { for I ... }
end; { DrawGEMText2 }
{*****************************************************************************}
procedure DrawGEMText3(GEMFontID: pointer; X, Y: integer; var TextString:
  string; var TextSettings: TextSettingsType; UpdateCP: boolean);
{ For Direction = 3 (horizontal, right to left). }
var
  FontPtr: PByteArray0 absolute GEMFontID;
  FontHeaderPtr: PExtendedGEMFontHeader absolute GEMFontID;

  CellHeight, MinCode, MaxCode: word;
  COTPtr: PWordArray0;
  StrikePtr: PByteArray0;
  RowInterval: word;
  Width: word;
  OriginalY, MaxX, MaxY: integer;
  Color: word;
  PatternOffset, PatternWidth, ByteIndex: word;
  Mask: byte;
  Col, RowIndex, Row: integer;

  TextStringPtr: pointer;
  SaveDS, TextStringCX, ColCX, RowCX: word;
  MinMax: word;
begin { DrawGEMText3 }
  with FontHeaderPtr^ do begin
    CellHeight := Height;
    MinCode := LowASCII;
    MaxCode := HighASCII;
    COTPtr := CharacterOffsetTablePtr;
    StrikePtr := FontDataPtr;
    RowInterval := SpanWidth
  end; { with FontHeaderPtr^ ... }

  with TextSettings do begin
    if (Direction <> HorizDir) or (Horiz <> RightText)
      then UpdateCP := False;
    if Horiz <> RightText then begin
      Width := GEMTextWidth(GEMFontID,TextString);
      if Horiz = CenterText
        then X := X+Width div 2
        else if Horiz = LeftText
          then X := Pred(X+Width)
    end;
    OriginalY := Y;
    case Vert of
      BottomText: Y := Succ(Y-CellHeight);
      CenterText: Y := Y-CellHeight div 2;
      TopText: { leave Y as is };
    end
  end; { with TextSettings ... }

  MaxX := GetMaxX;
  MaxY := GetMaxY;
  Color := GetColor;

  if Y+Pred(CellHeight) > MaxY        { to clip at the bottom of the screen }
    then CellHeight := Succ(MaxY-Y);  { if necessary                        }

  TextStringPtr := @TextString;

  asm
    mov SaveDS,ds
    mov al,byte ptr MinCode
    mov ah,byte ptr MaxCode
    mov MinMax,ax
    lds si,TextStringPtr
    mov cl,[si]
    xor ch,ch
    test cx,cx
    jnz @NextCh
    jmp @ResetDS

    @NextCh: mov TextStringCX,cx
    lds si,TextStringPtr
    inc si
    mov word ptr TextStringPtr,si
    mov bl,[si]
    mov ax,MinMax
    cmp bl,al
    jb @StepCh
    cmp bl,ah
    ja @StepCh
    xor bh,bh
    sub bl,al
    shl bx,1
    lds si,COTPtr
    mov ax,[si+bx]
    mov PatternOffset,ax
    mov bx,[si+bx+2]
    sub bx,ax
    mov PatternWidth,bx
    mov cx,ax
    shr ax,1
    shr ax,1
    shr ax,1
    mov ByteIndex,ax  { PatternOffset div 8 }
    mov al,$80
    and cx,$07
    shr al,cl
    mov Mask,al  { $80 shr (PatternOffset mod 8) }
    mov ax,X
    sub ax,bx
    inc ax  { X-PatternWidth+1 }
    jge @XOK

    mov ax,X
    inc ax
    mov PatternWidth,ax  { X+1 }

    @XOK: mov si,X  { Col = X-PatternWidth+1 }
    mov cx,PatternWidth
    sub si,cx
    inc si
    mov ah,Mask
    mov ds,SaveDS  { for PutPixel }

    @ColLoop: mov ColCX,cx
    cmp si,MaxX
    jg @ShiftMask
    test si,si
    jl @ShiftMask
    mov bx,ByteIndex
    mov dx,Y  { Row }
    les di,StrikePtr
    mov cx,CellHeight

    @RowLoop: mov al,es:[di+bx]
    and al,ah
    jz @StepRow

    mov Mask,ah  { save AH, BX, CX, DX, SI }
    mov RowIndex,bx
    mov RowCX,cx
    mov Row,dx
    mov Col,si
    push si  { PutPixel(Col,Row,Color); }
    push dx
    mov ax,Color
    push ax
    call PutPixel
    mov ah,Mask  { restore AH, BX, CX, DX, SI }
    mov bx,RowIndex
    mov cx,RowCX
    mov dx,Row
    mov si,Col
    les di,StrikePtr  { reset ES:DI }

    @StepRow: add bx,RowInterval
    inc dx
    loop @RowLoop

    @ShiftMask: shr ah,1
    jnz @StepCol
    inc ByteIndex
    mov ah,$80
    @StepCol: inc si
    mov cx,ColCX
    loop @ColLoop

    mov ax,X
    sub ax,PatternWidth
    jl @ResetDS
    mov X,ax
    @StepCh: mov cx,TextStringCX
    loop @StepCh1
    jmp @ResetDS
    @StepCh1: jmp @NextCh

    @ResetDS: mov ds,SaveDS
  end;

  if UpdateCP then begin
    if X < 0
      then X := 0
      else if X > MaxX
        then X := MaxX;
    MoveTo(X,OriginalY)
  end
end; { DrawGEMText3 }
{*****************************************************************************}
procedure DrawGEMText4(GEMFontID: pointer; X, Y: integer; var TextString:
  string; var TextSettings: TextSettingsType);
{ For Direction = 4 (vertical, top down, no rotation. }
var
  FontPtr: PByteArray0 absolute GEMFontID;
  FontHeaderPtr: PExtendedGEMFontHeader absolute GEMFontID;

  CellHeight, CellHeightLess1, MinCode, MaxCode: word;
  COTPtr: PWordArray0;
  StrikePtr: PByteArray0;
  RowInterval: word;
  LeftAlign, CenterAlign, RightAlign: boolean;
  Width: word;
  MaxX, MaxY: integer;
  Color, I: word;
  Ch: char;
  Code, PatternOffset, PatternWidth, PatternWidthLess1, ByteIndex: word;
  Mask: byte;
  Col, RowIndex, Row, CharX: integer;
  RowByte: byte;
begin { DrawGEMText4 }
  with FontHeaderPtr^ do begin
    CellHeight := Height;
    MinCode := LowASCII;
    MaxCode := HighASCII;
    COTPtr := CharacterOffsetTablePtr;
    StrikePtr := FontDataPtr;
    RowInterval := SpanWidth
  end; { with FontHeaderPtr^ ... }

  with TextSettings do begin
    if Horiz <> LeftText then begin
      Width := GEMTextWidth(GEMFontID,TextString);
      if Horiz = CenterText
        then Y := Y-Width div 2
        else if Horiz = RightText
          then Y := Succ(Y-Width)
    end;
    LeftAlign := False;
    CenterAlign := False;
    RightAlign := False;
    case Vert of
      TopText:    LeftAlign := True;    { X to left of character }
      CenterText: CenterAlign := True;  { X in center of character }
      BottomText: RightAlign := True;   { X to right of character }
    end
  end; { with TextSettings ... }

  MaxX := GetMaxX;
  MaxY := GetMaxY;
  Color := GetColor;

  CellHeightLess1 := Pred(CellHeight);

  for I := 1 to Length(TextString) do begin
    Ch := TextString[I];
    Code := Ord(Ch);
    if (Code < MinCode) or (Code > MaxCode)

      then  { don't do anything }

      else begin  { valid character code }
        Code := Code-MinCode;
        PatternOffset := COTPtr^[Code];
        PatternWidth := COTPtr^[Succ(Code)]-PatternOffset;

        if PatternWidth = 0

          then  { undefined character -- don't do anything }

          else begin  { defined character }
            PatternWidthLess1 := Pred(PatternWidth);
            if LeftAlign
              then CharX := X
              else if CenterAlign
                then CharX := X-PatternWidth div 2
                else CharX := X-PatternWidthLess1;
            if X+PatternWidthLess1 > MaxX then begin   { clip at the right  }
              PatternWidth := Succ(MaxX-CharX);        { edge of the screen }
              PatternWidthLess1 := Pred(PatternWidth)
            end;
            ByteIndex := PatternOffset div 8;
            Mask := $80 shr (PatternOffset mod 8);
            for Col := CharX to CharX+PatternWidthLess1 do begin
              if Col >= 0 then begin  { clip at the left edge of the screen }
                RowIndex := ByteIndex;
                for Row := Y to Y+CellHeightLess1 do begin
                  RowByte := StrikePtr^[RowIndex];
                  if (RowByte and Mask) = Mask
                    then if (Row >= 0) and (Row <= MaxY)  { clip at the top   }
                      then PutPixel(Col,Row,Color);       { and the bottom of }
                  Inc(RowIndex,RowInterval)               { screen            }
                end { for Row ... }
              end;
              if Mask = $01
                then begin
                  Inc(ByteIndex);
                  Mask := $80
                end
                else Mask := Mask shr 1
            end; { for Col ... }
            Inc(Y,CellHeight);
            if Y > MaxY then Break
          end  { defined character }

      end  { valid character code }

  end { for I ... }
end; { DrawGEMText4 }
{*****************************************************************************}
procedure OutGEMText(GEMFontID: pointer; TextString: string);
var
  X, Y: integer;
  TextSettings: TextSettingsType;
begin { OutGEMText }
  if GEMFontID <> nil then begin
    X := GetX;
    Y := GetY;
    GetTextSettings(TextSettings);
    case TextSettings.Direction of
      HorizDir: DrawGEMText0(GEMFontID,X,Y,TextString,TextSettings,True);
      VertDir:  DrawGEMText1(GEMFontID,X,Y,TextString,TextSettings);
      2:        DrawGEMText2(GEMFontID,X,Y,TextString,TextSettings);
      3:        DrawGEMText3(GEMFontID,X,Y,TextString,TextSettings,True);
      4:        DrawGEMText4(GEMFontID,X,Y,TextString,TextSettings);
    end
  end
end; { OutGEMText }
{*****************************************************************************}
procedure OutGEMTextXY(GEMFontID: pointer; X, Y: integer; TextString: string);
var
  TextSettings: TextSettingsType;
begin { OutGEMTextXY }
  if GEMFontID <> nil then begin
    GetTextSettings(TextSettings);
    case TextSettings.Direction of
      HorizDir: DrawGEMText0(GEMFontID,X,Y,TextString,TextSettings,True);
      VertDir:  DrawGEMText1(GEMFontID,X,Y,TextString,TextSettings);
      2:        DrawGEMText2(GEMFontID,X,Y,TextString,TextSettings);
      3:        DrawGEMText3(GEMFontID,X,Y,TextString,TextSettings,True);
      4:        DrawGEMText4(GEMFontID,X,Y,TextString,TextSettings);
    end
  end
end; { OutGEMTextXY }
{*****************************************************************************}
function IncPtr(P: pointer; Inc: longint): pointer;
{ Increments P by Inc and returns the result in normalized form.  Inc may be
  negative. }
type
  TPtrRec = record  { structure of a pointer }
    Offset, Segment: Word
  end;
var
  L: longint;
begin
  with TPtrRec(P) do
    L := ((longint(Segment) shl 4) + longint(Offset))+Inc;
  IncPtr := Ptr(word(L shr 4),word(L and $0000000F))
end;
{*****************************************************************************}
function RegisterGEMFont(LinkedGEMFontPtr: pointer; var Leading, ErrorCode:
  word): pointer;
var
  ObjFontPtr: PByteArray0 absolute LinkedGEMFontPtr;
  ObjFontHeaderPtr, NewFontHeaderPtr: PExtendedGEMFontHeader;
  IsGEMFont: boolean;
  TrueFontHeaderSize: word;
begin { RegisterGEMFont }
  Leading := 0;
  RegisterGEMFont := nil;

  if LinkedGEMFontPtr = nil then begin
    ErrorCode := 1;
    Exit
  end;

  ObjFontHeaderPtr := IncPtr(LinkedGEMFontPtr,-ExtensionBytes);

  IsGEMFont := True;
  TrueFontHeaderSize := SizeOf(TExtendedGEMFontHeader)-ExtensionBytes;
  with ObjFontHeaderPtr^ do begin
    if (LowASCII > 255) or (HighASCII > 255) or (LowASCII > HighASCII)
      then IsGEMFont := False
      else if WidestCharacterWidth > WidestCellWidth
        then IsGEMFont := False
          else if (HorizontalOffsetTableOffset <> 0) and
              (HorizontalOffsetTableOffset < (TrueFontHeaderSize-4))
            then IsGEMFont := False
            else if (CharacterOffsetTableOffset < (TrueFontHeaderSize-4))
              then IsGEMFont := False
              else if FontDataOffset < CharacterOffsetTableOffset
                then IsGEMFont := False
  end; { with ... }

  if not IsGEMFont then begin
    ErrorCode := 3;
    Exit
  end;

  if SizeOf(TExtendedGEMFontHeader) > MaxAvail then begin
    ErrorCode := 2;
    Exit
  end;

  GetMem(NewFontHeaderPtr,SizeOf(TExtendedGEMFontHeader));
  Move(LinkedGEMFontPtr^,NewFontHeaderPtr^.FontID,TrueFontHeaderSize);
  with NewFontHeaderPtr^ do begin
    CharacterOffsetTablePtr := @ObjFontPtr^[CharacterOffsetTableOffset];
    FontDataPtr := @ObjFontPtr^[FontDataOffset];
    AllocatedBytes := SizeOf(TExtendedGEMFontHeader);
    Leading := Height
  end;
  ErrorCode := 0;
  RegisterGEMFont := pointer(NewFontHeaderPtr)
end; { RegisterGEMFont }
{*****************************************************************************}
procedure UnloadGEMFont(var GEMFontID: pointer);
var
  FontHeaderPtr: PExtendedGEMFontHeader absolute GEMFontID;
begin { UnloadGEMFont }
  if GEMFontID <> nil then begin
    FreeMem(GEMFontID,FontHeaderPtr^.AllocatedBytes);
    GEMFontID := nil
  end
end; { UnloadGEMFont }
{*****************************************************************************}
end.



{ TRYGEMFO.PAS (23 March 1993) (Borland Pascal 7.0, real) }
program TryGEMFont;
{==============================================================================
This is a test bed for trying out the effect of text settings on the operation
of OutGEMText and OutGEMTextXY.
==============================================================================}
uses DOS, CRT, Graph, VGADriv, GEMFontU;

var

  OriginalTextAttr: byte;

  GEMFontPtr: pointer;
  FontHeaderPtr: PExtendedGEMFontHeader absolute GEMFontPtr;
  GraphDriver, GraphMode: integer;
  MaxX, MaxY: integer;
  Leading, MinCode, MaxCode: word;
  ErrorCode: word;
  TextSettings: TextSettingsType;
{*****************************************************************************}
procedure NewsGothic34; external;
{$L NEWSG34.OBJ }
{*****************************************************************************}
function ColorMonitor: boolean;
{ The function returns True if the monitor attached to the system is a color
  monitor, False if it is a monochrome monitor.  (The information is taken
  from the System Equipment Data Area.) }
var
  Flags: byte;
begin { ColorMonitor }
  asm
    int $11
    mov Flags,ah
  end;
  ColorMonitor := (Flags and $30) <> $30
end; { ColorMonitor }
{*****************************************************************************}
function RegisterFont(var ErrorCode: word): boolean;
begin { RegisterFont }
  GEMFontPtr := RegisterGEMFont(@NewsGothic34,Leading,ErrorCode);
  RegisterFont := GEMFontPtr <> nil
end; { RegisterFont }
{*****************************************************************************}
procedure ClearGraphicsScreen;
begin { ClearGraphicsScreen }
{ Fill the screen with light gray: }
  SetFillStyle(SolidFill,LightGray);
  Bar(0,0,MaxX,MaxY)
end; { ClearGraphicsScreen }
{*****************************************************************************}
procedure WaitForKeyPress;
var
  Ch: char;
begin { WaitForKeyPress }
  Ch := ReadKey;
  if Ch = #0 then Ch := ReadKey
end; { WaitForKeyPress }
{*****************************************************************************}
begin { ViewGEM }
  OriginalTextAttr := TextAttr;
  if ColorMonitor
    then TextAttr := $17   { light gray on blue }
    else TextAttr := $70;  { black on low-intensity white }

  ClrScr;

  DetectGraph(GraphDriver,GraphMode);
  if (GraphDriver = grNotDetected) or (GraphDriver <> VGA)
    then begin
      TextAttr := OriginalTextAttr;
      Writeln('This program requires a VGA.');
      Halt(1)
    end
    else begin
      GraphMode := VGAHi;
      if RegisterBGIDriver(@EGAVGADriverProc) < 0 then begin
        TextAttr := OriginalTextAttr;
        Writeln('EGA/VGA: ',GraphErrorMsg(GraphResult));
        Halt(1)
      end
    end;

  FileMode := 0;  { allow read-only files to be processed }
  GEMFontPtr := nil;

  ClrScr;

  if RegisterFont(ErrorCode)

    then begin  { font registered }
      with FontHeaderPtr^ do begin
        Writeln('Font name: ',FontName,' (height: ',PointSize,' pixels)');
        Writeln('Character code range: ',LowASCII,'-',HighASCII)
      end; { with ... }
      Writeln;
      Writeln('Text in this font will be displayed in various positions and orientations.');
      Writeln('After each display, press a key to see the next display.');
      Writeln;
      Writeln('                           [Press any key to begin!]');
      WaitForKeyPress;

      InitGraph(GraphDriver,GraphMode,'');
      if GraphResult <> grOK then begin
        TextAttr := OriginalTextAttr;
        Writeln('Error attempting to switch to graphics mode.');
        Halt(1)
      end;

      MaxX := GetMaxX;
      MaxY := GetMaxY;

      ClearGraphicsScreen;
      SetColor(Red);

    { Horizontal, left-to-right }

      MoveTo(0,Leading);
      OutGEMText(GEMFontPtr,'Procrastination is the thief of time.');
      WaitForKeyPress;

      MoveTo(MaxX div 2,3*Leading);
      SetTextJustify(CenterText,TopText);
      OutGEMText(GEMFontPtr,'Procrastination is the thief of time.');
      WaitForKeyPress;

      MoveTo(MaxX,5*Leading);
      SetTextJustify(RightText,TopText);
      OutGEMText(GEMFontPtr,'Procrastination is the thief of time.');
      WaitForKeyPress;

      MoveTo(MaxX div 2,7*Leading);
      SetTextJustify(LeftText,TopText);
      OutGEMText(GEMFontPtr,'Procrastination is the thief of time.');
      WaitForKeyPress;

      MoveTo(-(MaxX div 2),9*Leading);
      SetTextJustify(LeftText,TopText);
      OutGEMText(GEMFontPtr,'Procrastination is the thief of time.');
      WaitForKeyPress;

    { Vertical, bottom-to-top. }

      ClearGraphicsScreen;
      SetTextStyle(DefaultFont,VertDir,1);
      MoveTo(MaxX div 2,MaxY);
      OutGEMText(GEMFontPtr,'Procrastination is the thief of time.');
      WaitForKeyPress;

    { Vertical, top-to-bottom }
      SetTextStyle(DefaultFont,2,1);
      MoveTo(MaxX div 2+2*Leading,0);
      OutGEMText(GEMFontPtr,'Procrastination is the thief of time.');
      WaitForKeyPress;

    { Horizontal, right-to-left. }

      ClearGraphicsScreen;
      SetTextStyle(DefaultFont,3,1);  { right-to-left direction }

      MoveTo(MaxX,Leading);
      SetTextJustify(RightText,TopText);
      OutGEMText(GEMFontPtr,'Procrastination is the thief of time.');
      WaitForKeyPress;

      MoveTo(MaxX div 2,3*Leading);
      SetTextJustify(CenterText,TopText);
      OutGEMText(GEMFontPtr,'Procrastination is the thief of time.');
      WaitForKeyPress;

      MoveTo(0,5*Leading);
      SetTextJustify(LeftText,TopText);
      OutGEMText(GEMFontPtr,'Procrastination is the thief of time.');
      WaitForKeyPress;

      MoveTo(MaxX div 2,7*Leading);
      SetTextJustify(RightText,TopText);
      OutGEMText(GEMFontPtr,'Procrastination is the thief of time.');
      WaitForKeyPress;

      MoveTo(MaxX div 2,9*Leading);
      SetTextJustify(LeftText,TopText);
      OutGEMText(GEMFontPtr,'Procrastination is the thief of time.');
      WaitForKeyPress;

    { Vertical, top to bottom, unrotated. }
      ClearGraphicsScreen;
      SetColor(Blue);
      MoveTo(MaxX div 2,0);
      LineTo(MaxX div 2,MaxY);
      SetColor(Red);
      SetTextStyle(DefaultFont,4,1);  { top to bottom, unrotated }

      MoveTo(MaxX div 2,0);
      SetTextJustify(LeftText,CenterText);
      OutGEMText(GEMFontPtr,'Procrastination is the thief of time.');
      WaitForKeyPress;

      CloseGraph;
      ClrScr
    end  { font registered }

    else begin  { font not registered }
      ClrScr;
      Writeln('Error trying to register the font: ',ErrorCode);
      Writeln('                         [Press any key to continue.]');
      WaitForKeyPress
    end;  { font not registered }

  TextAttr := OriginalTextAttr;
  ClrScr
end. { ViewGEM }



{ GEMHEADR.PAS (16 March 1993) (Borland Pascal 7.0, real) }
program GEMHeader;
{==============================================================================
   This program requires the name of a file containing a screen font in GEM
format.  The name may be specified as a command-line argument; if it isn't, the
program prompts for the name.
   The program loads the font and reports the information contained in its
header.
   The output of the program may be redirected.
==============================================================================}
uses CRT;

type

  TGEMFontHeader = record
    FontID: word;
    PointSize: word;
    FontName: array[0..31] of char;
    LowASCII: word;
    HighASCII: word;
    Top, Ascent, Half, Descent, Bottom: integer;
    WidestCharacterWidth: word;
    WidestCellWidth: word;
    LeftOffset: integer;
    RightOffset: integer;
    Thickness: word;
    UnderscoreThickness: word;
    LightTextMask: word;
    ItalicTextMask: word;
    Flags: word;
    HorizontalOffsetTableOffset: longint;
    CharacterOffsetTableOffset: longint;
    FontDataOffset: longint;
    SpanWidth: word;
    Height: word;
    NextFontOffset: longint
  end;
  PGEMFontHeader = ^TGEMFontHeader;

var

  RedirectedOutput: text;
  FontFileName: string;
  FontFile: file;
  FontHeader: TGEMFontHeader;
  Hyphens: string[79];
{*****************************************************************************}
const
  HexadecimalDigit: array[0..15] of Char = '0123456789ABCDEF';
function HexByte(var B): string;
var
  BValue: Byte absolute B;
  S: string[2];
begin { HexByte }
  S[1] := HexadecimalDigit[BValue shr 4];
  S[2] := HexadecimalDigit[BValue and $0F];
  S[0] := #2;
  HexByte := S
end; { HexByte }
{*****************************************************************************}
function HexWord(var W): string;
var
  WValue: Word absolute W;
  HighPart, LowPart: Byte;
begin { HexWord }
  HighPart := Hi(WValue);
  LowPart := Lo(WValue);
  HexWord := HexByte(HighPart)+HexByte(LowPart)
end; { HexWord }
{*****************************************************************************}
begin { GEMHeader }
  Assign(RedirectedOutput,'');
  Rewrite(RedirectedOutput);

  if ParamCount = 0
    then begin
      Write('Enter the name of the GEM font file: ');
      Readln(FontFileName)
    end
    else FontFileName := ParamStr(1);
  FileMode := 0;  { so a read-only file can be processed }
  Assign(FontFile,FontFileName);
  Reset(FontFile,1);

  BlockRead(FontFile,FontHeader,SizeOf(TGEMFontHeader));
  Close(FontFile);

  FillChar(Hyphens[1],79,'-');
  Hyphens[0] := Chr(79);
  Writeln(RedirectedOutput,Hyphens);

  Writeln(RedirectedOutput,  'File name ................. ',FontFileName);
  with FontHeader do begin
    Writeln(RedirectedOutput,'Font ID ................... ',FontID);
    Writeln(RedirectedOutput,'Font name ................. ',FontName);
    Writeln(RedirectedOutput,'Point size ................ ',PointSize);
    Writeln(RedirectedOutput,'Low ASCII ................. ',LowASCII);
    Writeln(RedirectedOutput,'High ASCII ................ ',HighASCII);
    Writeln(RedirectedOutput,'Top ....................... ',Top);
    Writeln(RedirectedOutput,'Ascent .................... ',Ascent);
    Writeln(RedirectedOutput,'Half ...................... ',Half);
    Writeln(RedirectedOutput,'Descent ................... ',Descent);
    Writeln(RedirectedOutput,'Bottom .................... ',Bottom);
    Writeln(RedirectedOutput,'Maximum character width ... ',WidestCharacterWidth);
    Writeln(RedirectedOutput,'Maximum cell width ........ ',WidestCellWidth);
    Writeln(RedirectedOutput,'Italic left offset ........ ',LeftOffset);
    Writeln(RedirectedOutput,'Italic right offset ....... ',RightOffset);
    Writeln(RedirectedOutput,'Bold thickness ............ ',Thickness);
    Writeln(RedirectedOutput,'Underscore thickness ...... ',UnderscoreThickness);
    Writeln(RedirectedOutput,'Light text mask ........... ',HexWord(LightTextMask),' hex');
    Writeln(RedirectedOutput,'Italic text mask .......... ',HexWord(ItalicTextMask),' hex');
    Writeln(RedirectedOutput,'Flags ..................... ',HexWord(Flags),' hex');
    Writeln(RedirectedOutput,'Font data row bytes ....... ',SpanWidth);
    Writeln(RedirectedOutput,'Font data rows ............ ',Height)
  end; { with ... }
  Close(RedirectedOutput)
end. { GEMHeader }



{-----------------------------------------------------------------------------}
unit NewsG;

interface

procedure NewsGothic34;

implementation

procedure NewsGothic34; external;
{$L NEWSG34.OBJ }
end.
{-----------------------------------------------------------------------------}

