SUBROUTINE FONT.SELECT
*
* written by Marcel Kelley 9/26/91 to control switching trays on Laser printer
*
* 01/09/92 - BTS - Modified for use in the HBC Contacts sytem
*                  Removed TCL Sentence option since spaces are allowed in
*                  the printer definition record.  Also changed the popup to
*                  allow multiple font selections.
* 06/25/92 - BTS - Added the SETPRINTER option to select a printer
* 12/02/92 - BTS - Update common and printer table for AREV 3.0
*  2/24/93 - BTS - Modify the font locate to search for fonts in the original
*                  positions to correspond with the attributes.
* 07/15/94 - BTS - Remove no font message on printers with no fonts defined
* 01/21/95 - BTS - Remove AREV SETPRINTER option
*                - Add PRINTER OFF instruction after sending fonts
*                - No message if no printer selected
* 06/05/96 - BTS - Added a no selection option, STOP if no font selected
* 06/11/96 - BTS - Last fix leaves records locked if the STOP occurs within
*                  a window. Calling programs need to check for @ANS.

DECLARE SUBROUTINE SET_ACTIVE_PRINTER, MSG
DECLARE FUNCTION POP.UP, ESC.TO.EXIT

$INSERT SYSINCLUDE, ENVIRON.CONSTANTS
$INSERT SYSINCLUDE, PRINT_CONSTANTS

POSITION = ''
TEMP     = ''
FLAG     = ''

* Read the environment to see which printer is selected.

TEMP = ''
FLAG = ''
SET_ACTIVE_PRINTER(3,TEMP,FLAG)
IF NOT(TEMP) THEN RETURN
VAR           = TEMP<1>
VAR2          = @ENVIRON.SET<E.PRN.DRVS>
PRINTER_ID    = EXTRACT(VAR2,'',VAR,'')

* Read the printer record to get the names and attributes of fonts 1-16
* The print constants rely on fonts in a fixed position.  This method allows
* different fonts to be defined for different printers regardless of position.

OPEN 'SYSPRINTERS' TO SYSPRINTERS_FILE ELSE
  MSG('The SYSPRINTERS table is not found.','','','')
  STOP
END
READ RECORD FROM SYSPRINTERS_FILE, PRINTER_ID:"*PRINTER" ELSE
  MSG('The printer record is not found.','','','')
  STOP
END
BEGFONT  = RECORD<6>
ENDFONT  = RECORD<7>
FONTLIST = RECORD<8>
IF FONTLIST = '' THEN
    * There are no fonts selected for the PRINTER_ID
    RETURN
END ELSE
    FONTLIST = "<Use Printer Font>":@VM:FONTLIST
END

* The FONTLIST field is a multivalue with spaces allowed in the field and
* trailing value marks to mark a fixed number of positions.

CONVERT " " TO "_" IN FONTLIST ;* Swap out spaces in fields
CONVERT @VM TO " " IN FONTLIST ;* Convert value marks to spaces
FONTLIST = TRIM(FONTLIST)      ;* Trim the unnecessary null values
CONVERT " " TO @VM IN FONTLIST ;* Put values back
CONVERT "_" TO " " IN FONTLIST ;* Put spaces back


* Determine the largest description to center the popup
MAX.LENGTH = 0
NUMBER.OF.FONTS = COUNT(FONTLIST,@VM) + (FONTLIST NE "")
FOR X = 1 TO NUMBER.OF.FONTS
    FONT   = FONTLIST<1,X>
    LENGTH = LEN(FONT)
    IF MAX.LENGTH < LENGTH THEN MAX.LENGTH = LENGTH
NEXT X

* Display the available fonts in a multi-selection popup

col         = INT((75 - MAX.LENGTH) / 2)
row         = 6
file        = ""
display     = FONTLIST
format      = "1:":MAX.LENGTH:":L::"
mode        = "F"
select      = "1" ;* MULTI SELECTION
title       = PRINTER_ID
attributes  = ""
help        = ""
coordinates = 1
type        = ""

@ANS = ''
@ANS = POP.UP(col, row, file, display, format, mode, select, title, attributes, help, coordinates, type)
FONT = @ANS
IF FONT = '<Use Printer Font>' THEN RETURN

* Send selected fonts to the printer

FONTLIST = RECORD<8> ;* Reset the font list to original positions
NUMBER_OF_FONTS = COUNT(FONT,@FM) + (FONT NE '')
FOR X = 1 TO NUMBER_OF_FONTS
    LOCATE FONT<X> IN FONTLIST USING @VM SETTING POSITION THEN
         BEGATTRIB = (0-88) - (2 * POSITION)
         ** ENDATTRIB = (0-89) - (2 * POSITION)  ;* THIS IS NOT USED HERE
         PRINTER ON
         PRINT @(BEGATTRIB):
         PRINTER OFF
    END ELSE
         MSG("The font is not found in the list.","","","")
    END
NEXT X

RETURN