(* FONTS.PAS -- handle GEOS fonts
** Copyright (c) 1995,1996 Jochen Metzinger
**
** This program is free software; you can redistribute it and/or modify
** it under the terms of the GNU General Public License as published by
** the Free Software Foundation; either version 2, or (at your option)
** any later version.
**
** This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
** GNU General Public License for more details.
**
** You should have received a copy of the GNU General Public License
** along with this program; if not, write to the Free Software
** Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)

UNIT fonts;

INTERFACE

USES global, errors, geos, cvt;

FUNCTION is_font: BOOLEAN;
(* is cvt file a GEOS font? *)

PROCEDURE open_fonts;
(* open font usage *)

FUNCTION font_id: STRING;
(* return a identifier string *)

FUNCTION open_font(VAR height: BYTE): BOOLEAN;
(* select font with size >= height *)

FUNCTION get_underline: BYTE;
(* returm underline value *)

FUNCTION space_width: WORD;
(* get width of space char *)

FUNCTION select_char(ch: CHAR; VAR wd, underline: WORD): BOOLEAN;
(* select character with code CH *)

FUNCTION get_dot(x, y: INTEGER): BOOLEAN;
(* is (X,Y) set? *)

PROCEDURE close_font;
(* unselect font *)

PROCEDURE close_fonts;
(* close font usage *)

IMPLEMENTATION

TYPE
 FontHeader =
  RECORD
   underline: BYTE; (* Pixels minus 1 above the underline. *)
   bit_size: WORD; (* Bytes in the bit stream *)
   point: BYTE; (* Point size, character height in pixels *)
   off_index: WORD; (* Index to table of bit stream indices *)
   off_bits: WORD; (* Index to first bit stream. *)
  END;

 FontIndices =
  ARRAY [32..127] OF WORD;
  (* Indices for char ' ' to '~' *)

VAR
 id: STRING;
 size: INTEGER;
 header: FontHeader;
 index: FontIndices;
 buffer: BUFFER_PTR;
 code: INTEGER;
 bit_pos, width: WORD;

FUNCTION is_font: BOOLEAN;
 VAR info: InfoRec;
BEGIN
 cvt_info(info);
 is_font := (info.gtyp = 8);
END; (* is_font *)

PROCEDURE open_fonts;
 VAR info: InfoRec;
BEGIN
 cvt_info(info);
 IF info.gtyp <> 8 THEN FATAL('not a font');
 id := cvt_name + '['+long2str(info.w[128 DIV 2],0)+']';
 size := -1;
 code := -1;
END; (* open_fonts *)

FUNCTION font_id: STRING;
BEGIN
 font_id := id;
END; (* font_id *)

FUNCTION open_font(VAR height: BYTE): BOOLEAN;
 VAR result: WORD; c: BYTE;
BEGIN
 open_font := FALSE;
 size := -1;
 code := -1;
 (* search font with size >= height *)
 WHILE cvt_size(height) < 0 DO BEGIN
  IF height > 125 THEN EXIT;
  INC(height);
 END; (* while *)
 (* load font *)
 cvt_chain(height);
 (* load header *)
 cvt_read(header, SizeOf(header), result);
 IF result < SizeOf(header) THEN BEGIN
  error('font '+long2str(height,0)+' too short');
  EXIT;
 END; (* if *)
 WITH header DO BEGIN
  IF point <> height THEN
   error('font '+long2str(height,0)+' is in wrong chain')
  ELSE IF underline > point THEN
   error('font '+long2str(height,0)+' underline error')
  ELSE IF SizeOf(fontHeader) > off_index THEN
   error('font '+long2str(height,0)+' header & index crash')
  ELSE IF off_index+SizeOf(FontIndices) > off_bits THEN
   error('font '+long2str(height,0)+' index & stream crash')
  ELSE IF off_bits + point*bit_size > cvt_size(height) THEN
   error('font '+long2str(height,0)+' stream incomplete');
  IF is_err THEN EXIT;
 END; (* with *)
 (* load index *)
 cvt_seek(header.off_index);
 cvt_read(index, SizeOf(index), result);
 IF result <> SizeOf(index) THEN BEGIN
  error('read error');
  EXIT;
 END; (* if *)
 FOR c := 32 TO 126 DO BEGIN
  IF index[c] DIV 8 > header.bit_size THEN BEGIN
   error('font '+long2str(size,0)+' at "'+CHR(c)+'" index out of range');
   EXIT;
  END; (* if *)
  IF index[c+1] - index[c] <= 0 THEN BEGIN
   error('font '+long2str(size,0)+' at "'+CHR(c)+'" negativ width');
   EXIT;
  END; (* if *)
 END; (* for *)
 (* get buffer *)
 buffer := cvt_buffer;
 size := height;
 open_font := TRUE;
END; (* open_font *)

FUNCTION get_underline: BYTE;
BEGIN
 get_underline := header.underline;
END; (* get_underline *)

FUNCTION space_width: WORD;
BEGIN
 space_width := index[33] - index[32];
END; (* space_width *)

FUNCTION select_char(ch: CHAR; VAR wd, underline: WORD): BOOLEAN;
 VAR cc: BYTE;
BEGIN
 select_char := FALSE;
 code := -1;
 cc := ORD(ch);
 IF (cc < 32) OR (cc > 127) THEN
  EXIT;
 bit_pos := index[cc];
 width := index[cc+1] - index[cc];
 IF width = 0 THEN EXIT;
 wd := width;
 underline := header.underline;
 code := cc;
 select_char := TRUE;
END; (* select_char *)

FUNCTION get_dot(x, y: INTEGER): BOOLEAN;
 VAR data, mask: BYTE;
BEGIN
 get_dot := FALSE;
 IF (x < 0) OR (width <= x) THEN EXIT;
 IF (y < 0) OR (size <= y)  THEN EXIT;
 mask := $80 SHR ((bit_pos + x) AND $07);
 data := buffer^[header.off_bits+(bit_pos+x) SHR 3 + header.bit_size*y];
 get_dot := ((data AND mask) <> 0);
END; (* get_dot *)

PROCEDURE close_font;
BEGIN
 size := -1;
 code := -1;
END; (* close_font *)

PROCEDURE close_fonts;
BEGIN
 id := '';
 size := -1;
 code := -1;
END; (* close_fonts *)

BEGIN
 id := '';
 size := -1;
 code := -1;
END. (* fonts *)