$! *** Font_downloader.com ***
$! This is a command file useful for any printer that uses a built-in
$! hard drive. It was originally created for the DEClaser 5100 printer, but
$! uses no function known to be specific to that printer. 
$!
$! The main purpose of this program is to provide a simple means to upload
$! fonts to, or delete fonts from the printer's hard drive. Files are created 
$! that the user may edit to create the list of fonts that are to be loaded
$! or deleted. The user is expected to be able to use a simple text editor on
$! these files in order to create the 'input' files this program uses. 
$!
$! This program is menu driven with built-in help. There are appropriate checks
$! in place to allow the user to gracefully abort an operation. 
$!
$! This program requires the use of DCPS print supervisor. Backchannel message
$! capture and job queuing are the required dcps features.
$!
$! UPDATE: 23-AUG-1994 - 
$! Version 0.4 upgrades the functionality of this program to upload/view/delete
$! and manage fonts downloaded to the DEClaser 3500 Programmable Font Module, 
$! more commonly known simply as the PFM. PostScript interpreters handle
$! filesystem devices such as the DISK and the PFM in a manner which allows 
$! this program to download a font to either device without explicitly 
$! specifying the device name. In the case of the DEClaser 3500 which may 
$! have a PFM installed and cannot support a disk, the fonts are automatically
$! routed to this writable device. In order to avoid extensive modifications
$! at this time, I've decided to leave it to the user to know whether a writable
$! device is installed in his printer. As an example of a possibly confusing 
$! behavior, in a printer such as the DEClaser 5100, there may be a disk, and
$! a cartridge installed. The cartridge may not be a writable device, but this
$! program will provide a listing of fonts that may be on the cartridge. Fonts
$! on read-only devices cannot be modified by this or any other program. 
$!
$! UPDATE: 21-SEP-1994 - 
$! Version 0.5 fixes the problem caused by the changes made to DCPS v1.1. 
$! DCPS v1.1 began affixing a date stamp to the records returned to a captured 
$! log file and the parsing in this program had to be changed. 
$!
$! Author: Steve Hope 
$! Version 0.5
$! Date:   21-SEP-1994
$!
$! Digital Equipment Corporation
$! Copyright 1993, 1994
$! All rights reserved.
$! Permission is granted to copy this utility freely. 
$! Define some shorthand commands
$ esc[0,7]=27
$ csi = esc + "["
$ home = csi + "H"
$ clear = csi + "2J"
$ cursor_up = csi + "A"
$ bell[0,32] = %X07
$ pri:= print/notify/par=data=post
$ wri:= write sys$output
$ gon = esc +"(0"
$ goff = esc +"(B"
$ l1 = csi + "1;2H"
$ l2 = csi + "2;2H"
$ l3 = csi + "3;2H"
$ l4 = csi + "4;2H"
$ l5 = csi + "5;2H"
$ l6 = csi + "6;2H"
$ l7 = csi + "7;2H"
$ l8 = csi + "8;2H"
$ l9 = csi + "9;2H"
$ l10 = csi + "10;2H"
$ l11 = csi + "11;2H"
$ l12 = csi + "12;2H"
$ l13 = csi + "13;2H"
$ l14 = csi + "14;2H"
$ l15 = csi + "15;2H"
$ l16 = csi + "16;2H"
$ l1c2 = csi + "1;40H"
$ l2c2 = csi + "2;40H"
$ l3c2 = csi + "3;40H"
$ l4c2 = csi + "4;40H"
$ l5c2 = csi + "5;40H"
$ l6c2 = csi + "6;40H"
$ l7c2 = csi + "7;40H"
$ l8c2 = csi + "8;40H"
$ l9c2 = csi + "9;40H"
$ l10c2 = csi + "10;40H"
$ blank = "                                                                            "
$ bar = "''gon'lqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqk''goff'"
$ side= "''gon'x''goff'                                                                            ''gon'x''goff'"
$ lbar = "''gon'mqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqj''goff'"
$! 
$ border: subroutine
$ wri clear,home
$ wri csi+"1;1H",bar
$ count=2
$ loop1:
$ wri csi+f$string(count)+";1H",side
$ count=count+1
$ if count .ge. 17 
$ then 
$	goto outloop1
$ else
$ 	goto loop1
$ endif
$ outloop1:
$ wri csi+f$string(count)+";1H",lbar
$ wri csi+"2;30H","Font Downloader Utility"
$ endsubroutine
$!
$ clear_box: subroutine
$ count=3
$ loop3:
$ wri csi+f$string(count)+";2H",blank
$ count=count+1
$ if count .eq. 16
$ then
$	goto outloop3
$ else
$	goto loop3
$ endif
$ outloop3:
$ endsubroutine
$!
$ get_disk_list: subroutine
$	call clear_box
$ wri l4,"This menu item finds all PostScript fonts that may be located"    
$ wri l5,"on the target printer's hard disk or cartridge. A file is created in your "     
$ wri l6,"sys$login directory which you may edit to make a list of fonts"
$ wri l7,"you want to delete from the disk or cartridge. This command procedure parses"
$ wri l8,"the file you create and submits a print job to the target printer."
$ que_again:
$ inquire/nopunc cont "''l13'Continue? (y/n) --> "
$ if cont .eqs. "Y"
$ then
$ wri l13,blank
$ inquire  /nopunc quename "''l13'Name of printer queue --> "
$ open/write/error=openerror disk_files get_disk_fonts.ps
$!RSE: 940915: Reminded them to look at end of file.
$ write disk_files "(*** Be sure to delete lines at end of file ***\n)print"
$ write disk_files "(*** Delete this line and all above it ***\n) print"
$! write disk_files "(%disk%) { == } 100 string filenameforall"
$! write disk_files "(%cartridge1%) { == } 100 string filenameforall"
$ write disk_files "(%*) { == } 100 string filenameforall"
$ write disk_files "(*** Delete this line and all below it ***) print"
$ close disk_files
$ wri clear,home
$ wri "Creating DCPS$JOB_nnn.LOG in your sys$login directory."
$ print/que='quename/delete /par=(data=post,mess=keep) get_disk_fonts.ps
$ wri l8,"DCPS$JOB_nnn.LOG has been created in your sys$login directory,"
$ wri l9,"where nnn = the job number. Edit this file to create the list of"
$ wri l10,"fonts to delete."
$ stop
$ else
$ if cont .eqs. "N"
$ then
$	call clear_box
$	call get_menu_item
$ else
$ wri l15,"Invalid Entry"
$ goto que_again
$ endif
$ endsubroutine
$!
$ get_source_fonts: subroutine
$	call clear_box
$ wri l4,"This menu item finds all PostScript files in the target directory"
$ wri l5,"and creates a file suitable for parsing by this command procedure."
$ wri l6,"Make sure that all font files have a .PS extension and the only"
$ wri l7,"files in the target directory are PostScript type 1 font files."
$ wri l8,"Edit the file to remove font files that you do not want to have"
$ wri l9,"written to the printer's disk or cartridge. You may also add the names"
$ wri l10,"of font files that may be located in the target directory."
$ path_again:
$ inquire/nopunc cont "''l13'Continue? (y/n) --> "
$ if cont .eqs. "Y"
$ then 
$	wri l13,blank
$	inquire/nopunc font_dir "''l13'Input Target Directory --> "
$	wri clear,home
$	wri "Creating FONT_SOURCE_FILES.DAT..."
$ open/write/error=openerror out_source_files font_source_files.dat
$ loop2:
$ font_file_name = f$search ("''font_dir'*.ps")
$ if font_file_name .eqs. "" 
$ then
$	goto outloop2
$ else
$	write out_source_files font_file_name
$	goto loop2
$ endif
$ outloop2:
$ close out_source_files
$ wri l9,"FONT_SOURCE_FILES.DAT created."
$ wri l10,"Edit this file to create a list of fonts to download."
$ stop  
$ else
$ if cont .eqs. "N"
$ then
$	call clear_box
$	call get_menu_item
$ else
$	wri l15,"Invalid entry"
$	goto path_again
$ endif      
$ return
$ endsubroutine
$!
$ do_bad_files:
$ subroutine
$ goto skip1
$ endit_bd:
$ close badfiles
$ close outfile_d 
$ call build_postscript_downloader                              
$ exit
$ skip1:
$ wri l4,"There were some files which did not have a /FontName parameter."
$ wri l5,"Either these files are not really font files, or the optional"
$ wri l6,"/FontName parameter was not used. This command procedure requires"
$ wri l7,"the parameter to operate properly. "
$ inquire/nopunc anything "''l9'Press Return to continue"
$ call clear_box
$ open/append/error=openerror outfile_d modified_download_list.tmp
$ open/read badfiles possible_bad_font_files.tmp
$ bad_loop:
$ read/end_of_file = endit_bd badfiles badfilename
$ wri l4,"''badfilename'"
$ wri l7,"1 - Not a font file, so skip it."
$ wri l8,"2 - This is a font file, so name the font."
$ badfile_again:
$ wri l13,blank
$ inquire/nopunc choice "''l13'Choose 1 or 2 --> "
$ if choice .eq. 1
$	then
$		goto bad_loop
$	else
$ if choice .eq. 2
$	then
$		wri l13,blank
$		inquire/nopunc thename "''l13'Enter the font name --> "
$		if f$extract(1,1,thename) .nes. "/"
$			then 
$			 thename = "/"+"''thename'"
$			 write outfile_d "''badfilename' ''thename'"
$			else
$			 write outfile_d "''badfilename' ''thename'"
$		endif
$		goto bad_loop
$	else
$		wri l15,"Invalid Entry"
$		goto badfile_again
$ endif	
$ endsubroutine
$!
$ build_postscript_downloader:
$ subroutine
$ call clear_box
$ wri l4,"Creating the PostScript downloader files......"
$ open/read modfile modified_download_list.tmp
$ loop_loader:
$ read/end_of_file = endit_loader modfile font_descriptor
$ actual_font_name=f$element(1," ",font_descriptor)
$ striped_font_name="''actual_font_name'" - "/"
$ actual_font_file = f$element(0," ",font_descriptor)
$ open/write/error=openerror font_down_prol download_to_disk_'striped_font_name.ps
$ write font_down_prol "/inbuf 256 string def"
$ write font_down_prol "/RsrcFName 100 string def"
$ write font_down_prol "/WriteResource"
$ write font_down_prol "  { /Category findresource"
$ write font_down_prol "    begin RsrcFName ResourceFileName end"
$ write font_down_prol "(!) print dup print (\n) print flush"
$ write font_down_prol "    /outfile exch (w) file def"
$ write font_down_prol "    { currentfile inbuf readstring"
$ write font_down_prol "      outfile 3 -1 roll writestring not { exit } if"
$ write font_down_prol "    } loop"
$ write font_down_prol "    outfile closefile"
$ write font_down_prol "  } def
$ write font_down_prol "''actual_font_name' /Font WriteResource"
$ close font_down_prol
$ pri/que='quename download_to_disk_'striped_font_name.ps/delete,'actual_font_file
$ goto loop_loader
$ endit_loader:
$ close modfile
$ wri clear,home
$ stop
$ exit
$ endsubroutine
$!
$ download_fonts_to_disk: 
$ subroutine
$ bad_file_flag=0
$ call clear_box
$ wri l4,"This procedure parses the file created in menu item 1, and editted"
$ wri l5,"by you. The font files listed in the file will be examined for "
$ wri l6,"information about the font's name."
$ wri l7,"Then a PostScript Prologue file will be created for each font "
$ wri l8,"that will be downloaded. "
$ download_again:
$ inquire/nopunc cont "''l13'Continue? (y/n) --> "
$ if cont .eqs. "Y"
$ then
$	wri l13,blank
$	inquire/nopunc infile_download "''l13'Enter the font list filename. --> "
$	wri l13,blank
$	inquire/nopunc quename "''l13'Enter the printer queue --> "
$	open/read infile_d 'infile_download
$	open/write/error=openerror outfile_d modified_download_list.tmp
$	call clear_box
$	wri l5," Examining the font files for font names..."
$	loop_fontfile:
$	read/end_of_file=endit_list infile_d font_filename
$	wri l7,blank
$	wri l7,"Examining ''font_filename'..."
$ 	open/read fontfile 'font_filename
$ 	loop_fontname:
$ 	read/end_of_file=endit_nice fontfile fileline
$ 	location = f$locate("/FontName",fileline)
$ 	if location .eq. f$length(fileline)
$   	  then
$		goto loop_fontname
$   	  else
$		substring = f$extract(location,f$length(fileline)-location,fileline)
$       	thename = f$element(1," ",substring)
$		write outfile_d "''font_filename' ''thename'"
$		close fontfile
$ 	endif
$	goto loop_fontfile
$ endit_list:
$ 	call clear_box
$	close outfile_d
$	if bad_file_flag .eq. 1 then close badfiles
$	close infile_d
$	call clear_box
$	if bad_file_flag .eq.1
$	 then
$		call do_bad_files
$		exit
$	 else
$		call build_postscript_downloader
$		exit
$	endif
$ endit_nice:
$ 	bad_file_flag=1	
$	open/write/error=openerror badfiles possible_bad_font_files.tmp
$	write badfiles "''font_filename'"
$	close fontfile
$	goto loop_fontfile
$ else
$	if cont .eqs. "N"
$	then
$		call get_menu_item
$	else
$		wri l15,"Invalid Entry"
$		goto download_again
$	endif
$
$ endif
$ endsubroutine
$!
$ delete_disk_fonts:
$ subroutine
$ call clear_box
$ wri l4,"This procedure reads the file created in menu item 3 to create"
$ wri l5,"a PostScript program which will delete fonts currently on the "
$ wri l6,"printer's disk or cartridge. Please make sure that the file contains only those"
$ wri l7,"fonts which you want deleted."
$ del_inq_again:
$ inquire/nopunc cont "''l13'Continue? (y/n) --> "
$ if cont .eqs. "Y"
$ then
$	call clear_box
$	wri l13,blank
$	inquire/nopunc quename "''l13'Enter the printer's queue name --> "
$	wri l13,blank
$ 	inquire/nopunc listfile "''l13'Enter the font list file name --> "
$	call clear_box
$	wri l4,"Reading ''listfile' ..."
$	open/read infile_delete 'listfile
$	open/write/error=openerror outfile_delete delete_disk_fonts_immediate.ps
$! RSE: 940915: modified this loop to make font_file_name data after the 
$!		time stamp and dcps-i-userdata string.
$	delete_loop:
$	read/end_of_file=endit_delete infile_delete log_file_record
$ 	font_file_name = F$EXTRACT((F$LOCATE("DCPS-I-USERDATA,", log_file_record)+17), 255, log_file_record)
$	write outfile_delete "''font_file_name' status"
$	write outfile_delete "{''font_file_name' deletefile clear} if"
$	goto delete_loop
$	endit_delete:
$	close outfile_delete
$	close infile_delete
$	print/que='quename/par=(data=post)/delete delete_disk_fonts_immediate.ps
$	write clear,home
$	call border
$	call clear_box
$	call get_menu_item
$	exit
$ else
$	if cont .eqs. "N"
$	then
$	call clear_box
$	call get_menu_item
$	exit
$ else
$	wri l15,"Invalid Entry"
$	goto del_inq_again:
$ endif
$ endsubroutine
$!
$ helpme:
$ subroutine
$ call clear_box
$ wri l4,"The command file provides a menu driven means to upload or delete"
$ wri l5,"PostScript fonts to a printer's hard disk or cartridge. You may be required to"
$ wri l6,"run this procedure multiple times to perform a given operation."
$ wri l7,"Menu items 1 and 3 will create files that are used for menu items"
$ wri l8,"2 and 4 respectively. You will be instructed to edit these files"
$ wri l9,"with you favorite text editor and then use the edited files as input"
$ wri l10,"to this command procedure."
$ inquire/nopunc cont "''l13' Press Return to continue ..."
$ call clear_box
$ wri l4,"PostScript files will be created as needed and queued to the printer"
$ wri l5,"of your choice. These files will be deleted after used in order to"
$ wri l6,"minimize the number of garbage files in your directory. 
$ inquire/nopunc cont "''l13' Press Return to continue ..."
$ call clear_box
$ wri l4,"LOADING FONTS TO THE PRINTER'S HARD DISK or Cartridge:"
$ wri l6,"First select item 1 from the menu to create a parsible list of font"
$ wri l7,"files that you wish to have downloaded to the printer. You will be "
$ wri l8,"asked for a directory path to your collection of PostScript fonts. "
$ wri l9,"Edit the file that is created to create a list of fonts to download."
$ wri l10,"Re-run this procedure and select menu item 2. Your file will be read"
$ wri l11,"and the font files will be examined for a font name. "
$ inquire/nopunc cont "''l13' Press Return to continue ..."
$ call clear_box
$ wri l4,"If a font name cannot be found, then you will be prompted to either"
$ wri l5,"give this font a name, or skip the file and not download it. When the"
$ wri l6,"operation is completed, the appropriate PostScript files will be"
$ wri l7,"created and queued to the printer. The command procedure will"
$ wri l8,"automatically exit after sending the files. 
$ inquire/nopunc cont "''l13' Press Return to continue ..."
$ call clear_box
$ wri l4,"DELETING FONTS ON THE PRINTER'S HARD DRIVE:"
$ wri l6,"First select item 3. This will send a PostScript file to the printer"
$ wri l7,"which will instruct the printer to send backchannel information "
$ wri l8,"on the fonts currently stored on the printer's hard drive. This "
$ wri l9,"information is captured by using the DCPS facilities for capturing"
$ wri l10,"backchannel data in a LOG file. Edit this file to create a list of"
$ wri l11,"fonts you wish to have deleted. "
$ inquire/nopunc cont "''l13' Press Return to continue ..."
$ call clear_box
$ wri l4,"Re-run this procedure and select menu item 4. This procedure will "
$ wri l5,"read the file you have edited and create a PostScript file that will"
$ wri l6,"be sent to the printer. The named font files will be deleted from"
$ wri l7,"the printer's hard drive and this procedure will automatically exit." 
$ inquire/nopunc cont "''l13' Press Return to continue ..."
$ call clear_box
$ call get_menu_item
$ exit
$ endsubroutine
$!
$ other_util:
$ subroutine
$ call clear_box
$ wri l4,"1 - Create a hardcopy of all font samples.(PS Level 2 ONLY)"
$ wri l5,"2 - RESERVED FOR FUTURE EXPANSION"
$ menu2_again:
$ inquire/nopunc menu2_item "''l14'Choice --> "
$ if menu2_item .eq. 2
$ then
$	call clear_box
$ 	wri l12,"Feature not implemented yet!"
$	inquire/nopunc cont "''l14'Press return to continue"
$	call clear_box
$	call get_menu_item
$	exit
$ else 
$ if menu2_item .eq. 1
$ then
$ call clear_box
$ wri l4,"This item creates a PostScript program which will generate a"
$ wri l5,"hardcopy sample of every font found on the target printer."
$ wri l6,"Special precautions have been made to allow this program to run"
$ wri l7,"in low memory configurations, but it is very slow."
$ sample_again:
$ inquire/nopunc cont "''l14'Continue? (y/n) --> "
$ if cont .eqs. "N" 
$ then
$ 	call clear_box
$	call get_menu_item
$	exit
$ else
$ if cont .eqs. "Y"
$ then
$ wri l14,blank           
$!
$! The following PostScript code courtesy of Tom Powers.
$!
$ inquire/nopunc quename "''l14'Name of printer queue --> "
$ open/write/error=openerror scanfont scanfontsamples.ps
$ wfile:=write scanfont
$ wfile "%! "
$ wfile "/fnames  [systemdict /languagelevel known { systemdict /languagelevel "
$ wfile "get exec } { 1 } ifelse 2 ge { (*) { cvn } 128 string /Font resourceforall }"
$ wfile "{ FontDirectory { pop } forall } ifelse ]  def"
$ wfile "1 dict begin fnames { dup currentdict exch known { pop } { true def } ifelse"
$ wfile "} forall /fnames [ currentdict end { pop } forall ] def"
$ wfile "/forallsort where { pop /fnames [ fnames { } forallsort ] def } if"
$ wfile "/tsize 12 def /hsize 20 def /fns 50 string def"
$ wfile "/pagetop { 130 720 moveto gsave /Helvetica-Bold findfont hsize "
$ wfile "scalefont setfont statusdict begin product end show ( resident fonts ) show "
$ wfile "grestore 240 720 moveto 20 tsize hsize gt { tsize } { hsize } "
$ wfile "ifelse -1.2 mul rmoveto } def"
$ wfile "/nfont /Helvetica findfont tsize scalefont def"
$ wfile "/sample_string (ABCDEFGHIJKLMNOP abcdefghijklmnop 012345 @#$%^&*() ) def"
$ wfile "/debugit where { pop pagetop /Courier findfont 8 scalefont setfont"
$ wfile "fnames { gsave fns cvs /debugit where { pop dup (!) print "
$ wfile "print (\015) print } if show grestore 0 -10 rmoveto } forall showpage} if"
$ wfile "/error_substitute {gsave /Courier findfont tsize 0.707 mul scalefont setfont"
$ wfile "(This font is not directly executable.) show grestore } def"
$ wfile "/process_this_name{ /debugit where { dup 40 string cvs (! ) print "
$ wfile "print ( - ) print vmstatus exch sub exch pop 12 string cvs print flush} if"
$ wfile "findfont tsize scalefont setfont /debugit where { ( | ) print "
$ wfile "vmstatus exch sub exch pop 12 string cvs print (\n) print flush} if gsave "
$ wfile "gsave nfont setfont fns cvs dup stringwidth pop neg 0 rmoveto show (:) show"
$ wfile "grestore 12 0 rmoveto mark { sample_string show } stopped { error_substitute } if cleartomark"
$ wfile "grestore 0 tsize -1.2 mul rmoveto  } def"
$ wfile "pagetop fnames {/fsaveobj save def dup findfont dup /FontInfo known "
$ wfile "{ /FontInfo get dup /FullName known { /FullName get }{ pop dup } ifelse }"
$ wfile "{ pop dup } ifelse exch process_this_name currentpoint fsaveobj "
$ wfile "restore 1 vmreclaim moveto currentpoint exch pop 50 lt "
$ wfile "{ showpage pagetop } if } forall showpage"
$ close scanfont
$ pri/que='quename/delete scanfontsamples.ps
$ wri clear,home
$ stop
$ else
$ 	wri l16,"Invalid Entry"
$	goto sample_again
$ endif
$
$ else
$	wri l16,"Invalid Entry"
$	goto menu2_again
$ endif
$ endsubroutine
$!
$ get_menu_item: subroutine
$ wri l4,"1 - Create a file listing the font files available for downloading"
$ wri l5,"2 - Download font(s) to printer's disk or cartridge"
$ wri l7,"3 - Create a file listing the printer's current fonts"
$ wri l8,"4 - Delete font(s) on printer's disk or cartridge"
$ wri l10,"5 - HELP (getting started)"
$ wri l11,"6 - Other utilities"
$ wri l12,"7 - EXIT"
$ menu_again:             
$ inquire/nopunc menu_item "''l14'Choice --> "
$ if menu_item .eq. 1
$ then
$	call get_source_fonts
$ else
$ if menu_item .eq. 2
$ then
$	call download_fonts_to_disk
$ else
$ if menu_item .eq. 3
$ then
$	call get_disk_list
$ else
$ if menu_item .eq. 4
$ then
$	call delete_disk_fonts
$ else
$ if menu_item .eq. 5
$ then
$	call helpme
$ else
$ if menu_item .eq. 6
$ then
$	call other_util	
$ else
$ if menu_item .eq. 7
$ then
$	wri clear
$	stop
$ else
$	wri l16,"Invalid entry"
$	goto menu_again
$ endif
$ endsubroutine
$!
$ call border
$ call get_menu_item
$ openerror:
$ wri l10,"Error - Cannot open a file for writing"
$ stop