REM > Support - for PostScript printers

/* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is the Printers+ front-end.
 *
 * The Initial Developer of the Printers front-end is Acorn Computers Ltd.
 * The Initial Developer of the Printers+ extensions is RISCOS Ltd.
 *
 * Portions created by the Initial Developers are Copyright (C) 2003
 * the Initial Developers. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** */

/* Changes list:
 *
 * AMcC: 20-Sep-94
 * - Now pre-processed using CPP (cc -E) instead of basic prog 'Constants'.
 *   Allows us to use the same include file "Values" as used by front-end
 *   prog (!Printers.!RunImage).
 * - Uses C-style comments where cc -E  complains about REM ones.
 * - Occurances of "\" replaced by CHR$92 (again to avoid complaints from cc -E).
 * - All constants changed from the form CONST_name% to CONST_name.
 *
 * PJC: 30-May-95
 * - Changed feed system to allow a list of feeds.
 * - Added constants to index into template file.
 * 
 */

#include "Values.h"
#include "Trace.h"

DEF FNps_support(buff%)
  LOCAL reason%,psup%,prnt%,prdt%,cnfg%,xbuff%,psize_head%,code_entry%
  REM On entry, A%=interface pointer. This must be preserved.
  reason%=buff%!0
  psup%=buff%!4
  prnt%=buff%!8
  xbuff%=buff%!12
  psize_head%=buff%!16
  code_entry%=buff%!20
  IF prnt% THEN
    prdt%=FNprinter_find_prdata_entry(psup%,$prnt%!CONST_prnt_type)
    cnfg%=prnt%!CONST_prnt_cnfg
  ENDIF
  CASE reason% OF
  WHEN -1: PROCps_m1
  WHEN -3: PROCps_m3
  WHEN -4: PROCps_m4
  WHEN -5: PROCps_m5
  WHEN -6: PROCps_m6
  WHEN -7: PROCps_m7
  WHEN -8: PROCps_m8
  WHEN -9: PROCps_m9
  WHEN-10: PROCps_m10
  WHEN 3: PROCps_p3
  WHEN 6: PROCps_p6
  WHEN 8: PROCps_p8
  WHEN 9: PROCps_p9
  WHEN 17,18: PROCps_p17
  ENDCASE
=FALSE

DEF PROCps_m1
  REM VDU: PROCftracef("PROCps_m1")
  REM VDU: psup%!CONST_psup_flags=psup%!CONST_psup_flags OR 200<<8 OR %11000
  psup%!CONST_psup_flags = psup%!CONST_psup_flags OR (1<<5):REM need to be able to write
  psup%!CONST_psup_type=&FF5
  psup%!CONST_psup_text=%1011
  psup%!CONST_psup_cnfg=CONST_cnfg_ps_MAX/4
  psup%!CONST_psup_vsn=1
  REM note that the version number really only reflects
  REM the status of the files being read, ie only change
  REM this number if the file contents change.
  psup%!CONST_psup_dvsn=100
  buff%!0 =&80151
  buff%!4 =&80150
  buff%!8 =&8014F
  buff%!12=&8014E
  buff%!16=&8014D
  buff%!20=&8014C
  buff%!24=0
  SYS"Wimp_AddMessages",buff%
  IFFNrmload_latest_module("PDriver","Printers:Modules.PDriver")
  IFFNrmload_latest_module("PDriverPS","Printers:Modules.PDriverPS")
  IFFNrmload_latest_module("MakePSFont","Printers:Modules.MakePSFont")
ENDPROC

DEF PROCps_m3
  REM initialise the configuration window
  LOCAL config%,ps_i%
  REM VDU: PROCftracef("PROCps_m3")
  config%=FNprinter_find_window(prnt%,"configure")
  PROCicon_write(config%,13,FNprinter_read_string(prnt%!CONST_prnt_name))
  PROCicon_write(config%,6,$prnt%!CONST_prnt_type)
  ps_i%=!cnfg%!CONST_cnfg_ps_flags
  IF ps_i% AND 1 PROCicon_select(config%,8)ELSE PROCicon_deselect(config%,8)
  IF ps_i% AND 2 PROCicon_select(config%,11)ELSE PROCicon_deselect(config%,11)
  PROCicon_write(config%,18,FNmsg_0(psup%!CONST_psup_msg,"PO"+STR$((ps_i% AND 4)>>2)))
  IF FNhas_external_config_app(prnt%) THEN
    PROCicon_unshade(config%,39)
  ELSE
    PROCicon_shade(config%,39)
  ENDIF
  IF FNprinter_read_string_entry(prdt%,CONST_ps_template_feeds)="" THEN
    REM no feed information - choose between manual or automatic
    PROCicon_write(config%,3,FNmsg_0(psup%!CONST_psup_msg,"PF"+STR$((ps_i% AND 8)>>3)))
  ELSE
    IF cnfg%!CONST_cnfg_ps_feed = 0 THEN
      REM using default settings in printer
      PROCicon_write(config%,3,FNmsg_0(psup%!CONST_psup_msg,"ME1b"))
    ELSE
      PROCicon_write(config%,3,FNps_get_feed_name(FNprinter_read_string(cnfg%!CONST_cnfg_ps_feed)))
    ENDIF
  ENDIF
  IF FNprinter_read_integer_entry(prdt%,CONST_ps_template_colour)=1 THEN
    PROCicon_unshade(config%,7)
    IF ps_i% AND 16 PROCicon_select(config%,7)ELSE PROCicon_deselect(config%,7)
  ELSE
    PROCicon_deselect(config%,7)
    PROCicon_shade(config%,7)
  ENDIF
  IF ps_i% AND 32 PROCicon_select(config%,31)ELSE PROCicon_deselect(config%,31)
  IF ps_i% AND 64 PROCicon_select(config%,32)ELSE PROCicon_deselect(config%,32)
  PROCicon_write(config%,30,STR$((ps_i% AND &FF00)>>8))
  PROCicon_write(config%,16,FNmsg_0(psup%!CONST_psup_msg,"TC"+STR$((ps_i% AND &FF0000)>>16)))
  PROCicon_write(config%,23,FNmsg_0(psup%!CONST_psup_msg,"CC"+STR$((ps_i% AND &FF000000)>>24)))
  ps_i%=prnt%!CONST_prnt_psze
  PROCicon_write(config%,27,$ps_i%!CONST_psze_name)
ENDPROC

DEF PROCps_m4
  REM create a CNFG block with suitable defaults
  LOCAL ps_s$,ps_i%,ps_t%,B%,C%,ps_n$
  REM VDU: PROCftracef("PROCps_m4")

  cnfg%!CONST_cnfg_ps_flags=FNstore_integer(100<<8)
  $buff%=FNprinter_read_string_entry(prdt%,CONST_ps_template_shnme): B%=buff%: C%=2: prnt%!CONST_prnt_name=USR(code_entry%+CONST_entry_store_string)
  ps_s$=FNprinter_read_string_entry(prdt%,CONST_ps_template_spnme)
  IF ps_s$<>"ps" $buff%=ps_s$: B%=buff%: C%=2: prnt%!CONST_prnt_sprt=USR(code_entry%+CONST_entry_store_string)
  REM initialise the best paper size we can find ...
  ps_i%=psize_head%
  ps_s$=FNmsg_0(psup%!CONST_psup_msg,"PAP")
  WHILE ps_s$<>FNprinter_read_string(ps_i%!CONST_psze_name)
   ps_i%=ps_i%!CONST_psze_next
   IF ps_i%=0 ps_i%=psize_head%: ps_s$=FNprinter_read_string(ps_i%!CONST_psze_name)
  ENDWHILE
  prnt%!CONST_prnt_psze=ps_i%
  ps_i%=0
  PROCps_ensure_dir
  REPEAT
   SYS"OS_File",5,"PrinterChoices:ps.Printers."+STR$ ps_i% TO ps_t%
   IF ps_t% ps_i%+=1
  UNTIL ps_t%=0
  cnfg%!CONST_cnfg_ps_fonts=FNstore_integer(ps_i%)
  PROCps_create_default_font_file
  PROCps_ensure_fonts(prnt%,FALSE)

  REM if this printer supports fast parallel, set the appropriate flag
  ps_i%=FNprinter_read_integer_entry(prdt%,CONST_ps_template_fastparl)
  IFps_i%<>0 prnt%!CONST_prnt_flags = prnt%!CONST_prnt_flags OR (1<<7)

  REM if we have some paper feeds, pick the first file as the default, otherwise
  REM we will assume automatic paper feed.
  ps_s$=FNprinter_read_string_entry(prdt%,CONST_ps_template_feeds)
  IFps_s$="" THEN
    cnfg%!CONST_cnfg_ps_feed = 0
  ELSE
    SYS"OS_GBPB",9,ps_s$,buff%,1,0,256,"*" TO ,,,ps_i%
    IFps_i%=1 THEN
      CALL Z%,buff%,ps_n$
      $buff%=ps_s$+"."+ps_n$
      IFFNps_get_feed_name($buff%)<>"" THEN
        B%=buff%:C%=2:cnfg%!CONST_cnfg_ps_feed=USR(code_entry%+CONST_entry_store_string)
      ELSE
        cnfg%!CONST_cnfg_ps_feed = 0
      ENDIF
    ENDIF
  ENDIF
ENDPROC

DEF PROCps_m5
  REM check to see if there are any unused font files
  LOCAL ps_i%,ps_j%
  REM VDU: PROCftracef("PROCps_m5")
  PROCps_ensure_dir
  REPEAT
   SYS"OS_GBPB",9,"PrinterChoices:ps.Printers"+CHR$0,buff%,1,ps_i%,128,"*" TO ,,,ps_j%,ps_i%
   IF ps_j%=1 THEN
    ps_j%=buff%: WHILE ?ps_j%: ps_j%+=1: ENDWHILE: ?ps_j%=13
    ps_j%=prnt%
    WHILE ps_j%>0
     IF ps_j%!CONST_prnt_psup=psup% THEN
      REM got a printer in our class - does the name of the font file match?
      cnfg%=ps_j%!CONST_prnt_cnfg
      IF $buff%=STR$ !cnfg%!CONST_cnfg_ps_fonts THEN
       REM yes - leave it alone
       ps_j%=-1
      ELSE
       REM no - try the next printer
       ps_j%=ps_j%!CONST_prnt_next
      ENDIF
     ELSE
      REM not our class - try the next printer
      ps_j%=ps_j%!CONST_prnt_next
     ENDIF
    ENDWHILE
    IF ps_j%=0 THEN
     REM failed to match - delete the file
     REM VDU: PROCftracef("PROCps_m5: deleting PrinterChoices:ps.Printers."+$buff%)
     SYS"OS_File",6,"PrinterChoices:ps.Printers."+$buff%
     REM VDU: PROCftracef("PROCps_m5: deleted")
     REM need to reset the offset now
     ps_i%=0
    ENDIF
   ENDIF
  UNTIL ps_i%=-1
  REM now see if there are any printers that need fonts downloading
  PROCps_find_fonts_to_do(prnt%)
  REM VDU: PROCftracef("PROCps_m5 done")
ENDPROC

DEF PROCps_m6
  REM do whatever is necessary to prime the specified printer
  REM 0 is the magic number for the PostScript driver
  LOCAL ps_i%,ps_s$,ps_f$,ps_t$,cnct%,ptr%,ps_extra$
  LOCAL pxres%,pyres%,pxres_halftone%,pyres_halftone%,colour%,pslevel%
  LOCAL local_margin%,local_pl%,local_pr%,local_pb%,local_pt%
  LOCAL local_psze%,local_pw%,local_ph%,local_fsize%,local_w%
  LOCAL local_h%,local_A%,local_B%,local_G%
  REM VDU: PROCftracef("PROCps_m6")
  SYS"PDriver_SelectDriver",0
  ps_s$=FNprinter_read_string(prnt%!CONST_prnt_name)
  IF ps_s$="" THEN
   ps_s$=$prnt%!CONST_prnt_type
   IF LEN ps_s$>20 THEN
    ps_i%=LEN ps_s$
    WHILE MID$(ps_s$,ps_i%,1)<>" " AND ps_i%>0
     ps_i%-=1
    ENDWHILE
    IF ps_i% THEN
     ps_s$=LEFT$(ps_s$,ps_i%-1)
    ELSE
     ps_s$=LEFT$(ps_s$,20)
    ENDIF
   ENDIF
  ENDIF
  pxres%=FNprinter_read_integer_entry(prdt%,CONST_ps_template_pxres)
  pyres%=FNprinter_read_integer_entry(prdt%,CONST_ps_template_pyres)
  pxres_halftone%=FNprinter_read_integer_entry(prdt%,CONST_ps_template_pxhalf)
  pyres_halftone%=FNprinter_read_integer_entry(prdt%,CONST_ps_template_pyhalf)
  pslevel%=FNprinter_read_integer_entry(prdt%,CONST_ps_template_pslevel)
  IF pslevel%<1 OR pslevel%>32 THEN pslevel%=1
  IF !cnfg%!CONST_cnfg_ps_flags AND 16 colour%=&2000001 ELSE colour%=&2000000
  SYS"XPDriver_SetInfo",,pxres%,pyres%,colour%,ps_s$,pxres_halftone%,pyres_halftone%,0 TO ptr%;ps_i%
  IF ps_i% AND 1 THEN
   ps_s$="": ptr%+=4
   WHILE ?ptr%: ps_s$+=CHR$ ?ptr%: ptr%+=1: ENDWHILE
   ERROR CONST_error_ok,ps_s$
   ENDPROC
  ENDIF
  cnct%=prnt%!CONST_prnt_cnct
  CASE cnct%!CONST_cnct_type OF
  WHEN 1,2: ps_i%=1: REM enable control D output
  OTHERWISE: ps_i%=0: REM disable control D output
  ENDCASE
  IF !cnfg%!CONST_cnfg_ps_flags AND 32 ps_i%+=2: REM verbose prologue
  IF !cnfg%!CONST_cnfg_ps_flags AND 64 ps_i%+=4: REM accented chars
  ps_i%+=(pslevel%-1)*8: REM PostScript level, in bits 3-7
  SYS"PDriver_SetDriver",ps_i%
  SYS"OS_CLI","Set PDriver$PSprologue Printers:ps.PSfiles.PSprolog"
  SYS"OS_CLI","Set PDriver$PSprologue2 Printers:ps.PSfiles.Level"+ \
    STR$(pslevel%)+"."+FNprinter_read_string_entry(prdt%,CONST_ps_template_prologue2)
  local_psze%=prnt%!CONST_prnt_psze
  REM VDU: PROCftracef("Ptr to paper size block = &"+STR$~(local_psze%))
  ps_s$=$local_psze%!CONST_psze_name
  REM VDU: PROCftracef("Paper size name = "+ps_s$)
  ps_i%=0
  WHILE MID$(ps_s$,ps_i%,1)<>" " AND ps_i%<=LEN ps_s$
    ps_i%+=1
  ENDWHILE
  ps_s$=LEFT$(ps_s$,ps_i%-1)

  ps_extra$=""
  SYS"OS_CLI","Unset PDriver$PSextra"
  SYS"OS_CLI","Unset PDriver$PSpaper"
  SYS"OS_CLI","Unset PDriver$PSfeed"

  SYS"OS_File",17,"Printers:ps.Paper."+FNtask_lower(ps_s$) TO ps_i%
  IFps_i%<>1 THEN
    /* paper file can't be found - resort to original kludge */
    ps_extra$=FNmsg_2(psup%!CONST_psup_msg,"PT",ps_s$,FNtask_lower(ps_s$))
  ELSE
    /* set the system variable PDriver$PSPaper to be the file name associated with the specified paper */
    SYS"OS_CLI","Set PDriver$PSPaper Printers:ps.Paper."+FNtask_lower(ps_s$)
  ENDIF

  IF cnfg%!CONST_cnfg_ps_feed <> 0 THEN
    /* set the system variable PDriver$PSFeed to be the file name associated with the specified feed */
    SYS"OS_CLI","Set PDriver$PSFeed "+FNprinter_read_string(cnfg%!CONST_cnfg_ps_feed)
  ELSE
    REM only do auto/manual code if we do not have any feed information otherwise this
    REM means that the user wants to use the default printer setting
    IF FNprinter_read_string_entry(prdt%,CONST_ps_template_feeds)="" THEN
      IF !cnfg%!CONST_cnfg_ps_flags AND 8 THEN
       ps_f$=FNungstrans(FNprinter_read_boolean_string_entry(prdt%,CONST_ps_template_manualfeed,TRUE))
      ELSE
       ps_f$=FNungstrans(FNprinter_read_boolean_string_entry(prdt%,CONST_ps_template_manualfeed,FALSE))
      ENDIF
      IF ps_extra$<>"" ps_extra$=ps_f$+"|J"+ps_extra$ ELSE ps_extra$=ps_f$
    ENDIF
  ENDIF

  IF ps_extra$<>"" SYS"OS_CLI","Set PDriver$PSextra "+ps_extra$

  SYS"OS_CLI","Unset PDriver$TextChars1": REM no character translation to speak of
  local_margin%=50
  local_pl% = local_psze%!CONST_psze_lmargin DIV 100 + 1 + local_margin%
  local_pr% = local_psze%!CONST_psze_rmargin DIV 100 - local_margin%
  local_pb% = local_psze%!CONST_psze_bmargin DIV 100 + 1 + local_margin%
  local_pt% = local_psze%!CONST_psze_tmargin DIV 100 - local_margin%
  IF(!cnfg%!CONST_cnfg_ps_flags AND 4)=0 THEN
   IF !cnfg%!CONST_cnfg_ps_flags AND 1 local_pt%-=150
   local_pw% = local_pr%-local_pl%
   local_ph% = local_pt%-local_pb%
  ELSE
   IF !cnfg%!CONST_cnfg_ps_flags AND 1 local_pl%+=150
   local_pw% = local_pt%-local_pb%
   local_ph% = local_pr%-local_pl%
  ENDIF

  local_fsize%=(!cnfg%!CONST_cnfg_ps_flags AND &FF00)>>8
  REM VDU: PROCftracef("Local font size is "+STR$ local_fsize%)
  local_w%=0.72*local_fsize%
  local_h%=1.2*local_fsize%
  REM VDU: PROCftracef("=> (w, h) = ("+STR$ local_w%+", "+STR$ local_h%+")")
  local_pw%=local_pw% DIV local_w%
  local_ph%=local_ph% DIV local_h%
  IF !cnfg%!CONST_cnfg_ps_flags AND 1 THEN
   local_G%=2
   local_A%=local_ph%+2
  ELSE
   local_G%=0
   local_A%=local_ph%
  ENDIF
  local_B%=(local_pw%+2)DIV(1+((!cnfg%!CONST_cnfg_ps_flags AND &FF0000)>>16))-2
  ps_t$="-Ph "+STR$ local_A%+" -Pw "+STR$ local_B%+" -Mt "+STR$ local_psze%!CONST_psze_ttop
  ps_t$+=" -Mb "+STR$ local_psze%!CONST_psze_tbottom+" -Ml "+STR$ local_psze%!CONST_psze_tleft
  ps_t$+=" -Mr "+STR$ local_psze%!CONST_psze_tright+" -Th "+STR$ local_G%
  SYS"OS_CLI","Set PDriver$TextPage "+ps_t$
  PROCps_add_fonts(FALSE)
  REM VDU: PROCftracef("PROCps_m6 done")
ENDPROC

DEF PROCps_m7
  LOCAL queu%,ps_p%,ps_i%,B%,C%
  REM VDU: PROCftracef("PROCps_m7")
  queu%=!xbuff%
/*  REM we're all done now - free the private block */
  ps_p%=queu%!CONST_queu_tprv
  IF ps_p% THEN
   REM free the two strings we hold
   PROCfree_structure(ps_p%!CONST_tprv_ps_bbox)
   PROCfree_structure(ps_p%!CONST_tprv_ps_transform)
   B%=CONST_ident_TPRV: C%=ps_p%: CALL code_entry%+CONST_entry_heap_free
   queu%!CONST_queu_tprv=0
  ENDIF
  REM now free the character translation list
  ps_p%=queu%!CONST_queu_char
  WHILE ps_p%
   ps_i%=!ps_p%
   B%=CONST_ident_CHAR: C%=ps_p%: CALL code_entry%+CONST_entry_heap_free
   ps_p%=ps_i%
  ENDWHILE
  queu%!CONST_queu_char=0
ENDPROC

DEF PROCps_m9
  REM printer being removed
  REM delete the printer font file
  SYS"XOS_File",6,"PrinterChoices:ps.Printers."+STR$(!cnfg%!CONST_cnfg_ps_fonts)
  REM then check the download window
  PROCps_m10
ENDPROC

DEF PROCps_m10
  REM printer being deactivated
  REM if the font download window is open for this printer, move on
  REM to the next one
  LOCAL ps_i%
  REM VDU: PROCftracef("PROCps_m9")
  ps_i%=psup%!CONST_psup_wind
  WHILE ps_i%
   IF $(ps_i%+CONST_wind_name)="download" THEN
    REM is the window open?
    !buff%=ps_i%!CONST_wind_hand: SYS"Wimp_GetWindowState",,buff%
    IF buff%!32 AND 1<<16 THEN
     REM yes - it is for this printer? If so, move to next printer
     IF ps_i%!CONST_wind_prnt=prnt% THEN
      SYS"Wimp_CloseWindow",,buff%
      PROCps_find_fonts_to_do(prnt%!CONST_prnt_next)
     ENDIF
    ENDIF
    ps_i%=0
   ELSE
    ps_i%=ps_i%!CONST_wind_next
   ENDIF
  ENDWHILE
ENDPROC

DEF PROCps_p3
  REM a window closing
  LOCAL ps_i%
  REM VDU: PROCftracef("PROCps_p3")
  SYS"Wimp_CloseWindow",,xbuff%
  ps_i%=psup%!CONST_psup_wind
  WHILE ps_i%
    IF ps_i%!CONST_wind_hand=!xbuff% THEN
      IF $(ps_i%+CONST_wind_name)="download" THEN
        REM if currently selected printer - reselect it so the mappings are good
        IF prnt%!CONST_prnt_flags AND 2 !buff%=20: buff%!12=0: buff%!16=&80152: SYS"Wimp_SendMessage",17,buff%,0
        REM since the user has decided not to download the fonts, cancel the flag bit
        ps_i%=prnt%!CONST_prnt_fonts
        WHILE ps_i%
          ps_i%!CONST_fonts_flags=ps_i%!CONST_fonts_flags AND NOT(1<<31)
          ps_i%=ps_i%!CONST_fonts_next
        ENDWHILE
        PROCps_find_fonts_to_do(prnt%!CONST_prnt_next)
      ENDIF
      ps_i%=0
    ELSE
      ps_i%=ps_i%!CONST_wind_next
    ENDIF
  ENDWHILE
ENDPROC

DEF PROCps_p6
  REM mouseclick on the configure window
  LOCAL wind%,dummy%
  REM VDU: PROCftracef("PROCps_p6")
  CASE xbuff%!8 OF
    WHEN 2: REM Menu
      CASE xbuff%!16 OF
        WHEN  4: PROCps_menu("ME1",TRUE,TRUE)
        WHEN 20: PROCps_menu("ME2",TRUE,TRUE)
        WHEN 19: PROCps_menu("ME3",TRUE,TRUE)
        WHEN 24: PROCps_menu("ME4",TRUE,TRUE)
        WHEN 26: PROCps_menu("MP1",TRUE,TRUE)
      ENDCASE
    WHEN 4: REM Select
      CASE xbuff%!16 OF
        WHEN 25
          REM VDU: PROCftracef("saving and closing configuration (click SELECT)")
          wind%=xbuff%!12
          PROCps_save_configuration(wind%)
          !xbuff%=wind%
          SYS"Wimp_CloseWindow",,xbuff%
        WHEN  4: PROCps_menu("ME1",TRUE,TRUE)
        WHEN 20: PROCps_menu("ME2",TRUE,TRUE)
        WHEN 19: PROCps_menu("ME3",TRUE,TRUE)
        WHEN 24: PROCps_menu("ME4",TRUE,TRUE)
        WHEN 26: PROCps_menu("MP1",TRUE,TRUE)
        WHEN 33
          !xbuff%=xbuff%!12
          SYS"Wimp_CloseWindow",,xbuff%
        WHEN 39
          dummy%=FNexternal_config_app(prnt%)
      ENDCASE
    WHEN 1: REM Adjust
      CASE xbuff%!16 OF
        WHEN 25
          wind%=xbuff%!12
          PROCps_save_configuration(wind%)
        WHEN 39
          dummy%=FNexternal_config_app(prnt%)
      ENDCASE
  ENDCASE
ENDPROC

DEF PROCps_p8
  REM a key press!
  LOCAL ps_i%
  REM VDU: PROCftracef("PROCps_p8")
  ps_i%=psup%!CONST_psup_wind
  WHILE ps_i%
    IF ps_i%!CONST_wind_hand=!xbuff% THEN
      IF xbuff%!24=13 THEN
        CASE $(ps_i%+CONST_wind_name)OF
          WHEN "configure"
            REM VDU: PROCftracef("saving and closing configuration (press RETURN)")
            SYS "Wimp_CloseWindow",,xbuff%
            PROCps_save_configuration(!xbuff%)
          WHEN "download"
            SYS "Wimp_CloseWindow",,xbuff%
            PROCps_download_fonts(!xbuff%)
        ENDCASE
      ELSE
        SYS "Wimp_ProcessKey",xbuff%!24
      ENDIF

      ENDPROC
    ENDIF

    ps_i%=ps_i%!CONST_wind_next
  ENDWHILE
ENDPROC

DEF PROCps_p9
  LOCAL adjust%,wind%,icon%,ptr%
/*
 * REM menu selections are easy ... we just write the
 * REM selected string into the appropriate icon.
 * REM some other actions may be taken to ensure that
 * REM other choices are OK, but we don't touch any
 * REM data yet.
 */
  REM VDU: PROCftracef("PROCps_p9")
  wind%=FNprinter_find_window(prnt%,"configure")
  adjust%=FNwas_adjust_used
  CASE ps_menu_chsn$ OF
  WHEN "ME1": icon%=3
  WHEN "ME2": icon%=16
  WHEN "ME3": icon%=18
  WHEN "ME4": icon%=23
  WHEN "MP1": icon%=27
  ENDCASE
  ptr%=ps_menu%+28+!xbuff%*24
  IF ptr%!8 AND &100 THEN
   PROCicon_write(wind%,icon%,$ptr%!12)
  ELSE
   PROCicon_write(wind%,icon%,$(ptr%+12))
  ENDIF
  IF ps_menu_chsn$="ME3" THEN
   IF FNicon_read(wind%,18)=FNmsg_0(psup%!CONST_psup_msg,"PO0")THEN
    PROCicon_write(wind%,16,FNmsg_0(psup%!CONST_psup_msg,"PC"))
    PROCicon_write(wind%,30,FNmsg_0(psup%!CONST_psup_msg,"PS"))
   ELSE
    PROCicon_write(wind%,16,FNmsg_0(psup%!CONST_psup_msg,"LC"))
    PROCicon_write(wind%,30,FNmsg_0(psup%!CONST_psup_msg,"LS"))
   ENDIF
  ENDIF
  IF adjust% THEN
   SYS"Wimp_GetPointerInfo",,xbuff%
   PROCps_menu(ps_menu_chsn$,FALSE,FALSE)
  ENDIF
ENDPROC

DEF PROCps_p17
  LOCAL wind%,ps_s$,ps_t$,ps_f$,size%,dest%,recv%
  REM VDU: PROCftracef("PROCps_p17")
  CASE xbuff%!16 OF
  WHEN &502:
    wind%=psup%!CONST_psup_wind
    WHILE wind%
      IF wind%!CONST_wind_hand=xbuff%!32 THEN
        CASE $(wind%+CONST_wind_name)OF
          WHEN "configure": ps_s$=STR$ xbuff%!36
            CASE xbuff%!36 OF
              WHEN 7,31,32,8,11: IF FNicon_set(xbuff%!32,xbuff%!36)ps_s$+="b" ELSE ps_s$+="a"
            ENDCASE
            ps_t$=FNmsg_0(psup%!CONST_psup_msg,"CON"+ps_s$)
            IF ps_t$="CON"+ps_s$ ps_t$=FNmsg_0(psup%!CONST_psup_msg,"CON")
            PROCinteractive_help(ps_t$)
        ENDCASE
        wind%=0
      ELSE
        wind%=wind%!CONST_wind_next
        IF wind%=0 THEN
          REM must be a menu
          PROCinteractive_help(FNmsg_0(psup%!CONST_psup_msg,"H"+ps_menu_chsn$))
        ENDIF
      ENDIF
    ENDWHILE
  WHEN &8014C: IF prnt%=0 THEN
      xbuff%!12=xbuff%!8
      xbuff%!16=&80151: REM PSPrinterNotPS
      SYS"Wimp_SendMessage",17,xbuff%,xbuff%!4
    ELSE
      IF prnt%!CONST_prnt_psup<>psup% THEN
        xbuff%!12=xbuff%!8
        xbuff%!16=&80151: REM PSPrinterNotPS
        SYS"Wimp_SendMessage",17,xbuff%,xbuff%!4
      ELSE
        REM everything checks out. Calculate the size required then send
        REM the acknowledgement BEFORE doing the transfer block as this
        REM then gives us our task handle!
        ps_s$="": IF prnt%!CONST_prnt_name ps_s$=$prnt%!CONST_prnt_name
        ps_t$="": IF prnt%!CONST_prnt_type ps_t$=$prnt%!CONST_prnt_type
        ps_f$="PrinterChoices:ps.Printers."+STR$ !cnfg%!CONST_cnfg_ps_fonts
        PROCps_ensure_dir
        size%=LEN ps_s$+LEN ps_t$+LEN ps_f$+3
        recv%=xbuff%!4
        xbuff%!24=size%
        xbuff%!12=xbuff%!8
        xbuff%!16=&8014D: REM PSPrinterAck
        SYS"Wimp_SendMessage",17,xbuff%,recv%
        IF xbuff%!20 THEN
          dest%=xbuff%!20
          $buff%=ps_s$+CHR$ 0
          SYS"Wimp_TransferBlock",xbuff%!4,buff%,recv%,dest%,LEN ps_s$+1
          dest%+=LEN ps_s$+1
          $buff%=ps_t$+CHR$ 0
          SYS"Wimp_TransferBlock",xbuff%!4,buff%,recv%,dest%,LENps_t$+1
          dest%+=LEN ps_t$+1
          $buff%=ps_f$+CHR$ 0
          SYS"Wimp_TransferBlock",xbuff%!4,buff%,recv%,dest%,LENps_f$+1
        ENDIF
      ENDIF
    ENDIF
  WHEN &8014E: PROCps_try_to_find_fonts(prnt%)
  WHEN &8014F: PROCps_create_default_font_file
    PROCps_ensure_fonts(prnt%,FALSE)
    PROCps_add_fonts(FALSE)
    xbuff%!12=xbuff%!8
    xbuff%!16=&80150: REM PSPrinterDefaulted
    SYS"Wimp_SendMessage",17,xbuff%,xbuff%!4
  ENDCASE
  REM VDU: PROCftracef("PROCps_p17 done")
ENDPROC

DEF FNps_get_feed_name(f$)
  LOCAL ps_c%, ps_s$
  ps_c%=OPENIN(f$):IFps_c%=0 :=""
  ps_s$=GET$#ps_c%:CLOSE#ps_c%
  IFLEFT$(ps_s$,19)="%%RISCOS_FeedName: " THEN :=MID$(ps_s$,20)
  =""

DEF PROCps_create_default_font_file
  LOCAL ps_c%,ps_d%,ps_t%,ps_i%,prdt%
  REM VDU: PROCftracef("PROCps_create_default_font_file")
  ps_i%=A%!CONST_interface_scratch
/*
 * REM we don't know where "ps" lives on the Printers path
 * REM and we can't write to it yet 'cos the font file
 * REM doesn't exist, so we have to canonicalise it
 */
  PROCps_ensure_dir
  SYS"OS_FSControl",37,"PrinterChoices:ps.Printers",ps_i%,,,128
  ps_t%=ps_i%: WHILE ?ps_t%: ps_t%+=1: ENDWHILE
  REM add the name of the font file onto the end of the path string
  $ps_t%="."+STR$ !cnfg%!CONST_cnfg_ps_fonts
  REM and create the file
  ps_c%=OPENOUT $ps_i%
  IF ps_c% THEN
   REM point ps_d% at the font list PRDT block
   prdt%=FNprinter_find_prdata_entry(psup%,$prnt%!CONST_prnt_type)
   ps_d%=FNprinter_read_integer_entry(prdt%,CONST_ps_template_fontalias)
   REM now point at the head of the LSTD list
   ps_d%=ps_d%!CONST_prdt_1st
   WHILE ps_d%
    BPUT#ps_c%,$ps_d%!8+" "+$ps_d%!12+" "+$ps_d%!16
    ps_d%=ps_d%!CONST_lstd_next
   ENDWHILE
   CLOSE#ps_c%
   SYS "XOS_File",4,$ps_i%,,,,&13 /*attributes to WR/r*/
  ENDIF
ENDPROC

DEF PROCps_try_to_find_fonts(prnt%)
/*
 * REM when the user clicks on SAVE in !FontPrint, we can't
 * REM just go and find the fonts, 'cos the download window might
 * REM already be open for another printer
 */
  LOCAL ps_i%,ps_j%
  REM VDU: PROCftracef("PROCps_try_to_find")
  REM is the download window open?
  ps_i%=psup%!CONST_psup_wind
  WHILE ps_i%
   IF $(ps_i%+CONST_wind_name)="download" THEN
    REM is the window open?
    !buff%=ps_i%!CONST_wind_hand: SYS"Wimp_GetWindowState",,buff%
    IF buff%!32 AND 1<<16 THEN
     REM try to find this prnt either from the window
     REM or from later on in the linked list
     ps_j%=ps_i%!CONST_wind_prnt
     WHILE ps_j%
      IF ps_j%=prnt% ENDPROC: REM found - will be dealt with in due course
      ps_j%=ps_j%!CONST_prnt_next
     ENDWHILE
    ENDIF
    REM not found or window closed ... change the window to point
    REM to THIS prnt since it must be earlier in the linked list
    PROCps_find_fonts_to_do(prnt%)
    ENDPROC
   ELSE
    ps_i%=ps_i%!CONST_wind_next
   ENDIF
  ENDWHILE
ENDPROC

DEF PROCps_find_fonts_to_do(prnt%)
  REM VDU: PROCftracef("PROCps_find_fonts_to_do")
  WHILE prnt%
/*
 *  REM if we've got a printer in our class - compare the font file with our
 *  REM idea of what needs to be done
 */
   IF prnt%!CONST_prnt_psup=psup% PROCps_ensure_fonts(prnt%,TRUE)
   prnt%=prnt%!CONST_prnt_next
  ENDWHILE
ENDPROC

DEF PROCps_ensure_fonts(prnt%,take_action%)
  LOCAL ps_i%,ps_j%,ps_k%,ps_s$,ps_t$,ps_e$,ps_download%,ps_changed%
  REM VDU: PROCftracef("PROCps_ensure_fonts")
  cnfg%=prnt%!CONST_prnt_cnfg
  ps_download%=FALSE: REM nothing to download yet
  ps_changed%=FALSE
  REM set all the flags to show no matches against the file
  ps_j%=prnt%!CONST_prnt_fonts
  PROCps_ensure_dir
  WHILE ps_j%
   ps_j%!CONST_fonts_flags=ps_j%!CONST_fonts_flags OR 1<<30
   IF ps_j%!CONST_fonts_flags AND 1<<31 THEN
/*    REM we've got a font to download from an earlier attempt */
    ps_download%=TRUE
    ps_changed%=TRUE
   ENDIF
   ps_j%=ps_j%!CONST_fonts_next
  ENDWHILE
  ps_i%=OPENIN("PrinterChoices:ps.Printers."+STR$ !cnfg%!CONST_cnfg_ps_fonts)
  IF ps_i%=0 THEN
   PROCps_create_default_font_file
   ps_i%=OPENIN("PrinterChoices:ps.Printers."+STR$ !cnfg%!CONST_cnfg_ps_fonts)
  ENDIF
  IF ps_i% THEN
   WHILE NOTEOF#ps_i%
    REM marry up the contents of the file against the current list
    ps_s$=GET$#ps_i%: ps_t$="": ps_e$=""
    ps_j%=INSTR(ps_s$," ")
    IF ps_j%<>0 THEN
     ps_t$=MID$(ps_s$,ps_j%+1)
     ps_s$=LEFT$(ps_s$,ps_j%-1)
     ps_k%=INSTR(ps_t$," ")
     IF ps_k%<>0 THEN
      ps_e$=MID$(ps_t$,ps_k%+1)
      ps_t$=LEFT$(ps_t$,ps_k%-1)
     ENDIF
    ENDIF
    ps_s$="\F"+ps_s$: IF ps_e$<>"" ps_s$+="\E"+ps_e$
    ps_k%=prnt%!CONST_prnt_fonts
    WHILE ps_k%>0
     IF ps_k%!CONST_fonts_foreign ps_e$=$ps_k%!CONST_fonts_foreign ELSE ps_e$=""
     IF $ps_k%!CONST_fonts_acorn=ps_s$ AND ps_e$=ps_t$ THEN
      REM matched this entry in the file
      ps_k%!CONST_fonts_flags=ps_k%!CONST_fonts_flags AND NOT(1<<30)
      ps_k%=-1
     ELSE
      ps_k%=ps_k%!CONST_fonts_next
     ENDIF
    ENDWHILE
    IF ps_k%=0 THEN
     REM got to add font to list
     ps_changed%=TRUE
     B%=CONST_ident_FONT
     C%=CONST_fonts_MAX
     ps_k%=USR(code_entry%+CONST_entry_heap_claim)
     IFps_k%=0 ERROR CONST_error_fatal, FNmsg_0(FNps_host_desc,"FA5")
     ps_k%!CONST_fonts_next=prnt%!CONST_prnt_fonts: prnt%!CONST_prnt_fonts=ps_k%
     $buff%=ps_s$: B%=buff%: C%=2: ps_k%!CONST_fonts_acorn=USR(code_entry%+CONST_entry_store_string)
     REM VDU: PROCftracef("Length of block for '"+$buff%+"' is &"+STR$~(!((ps_k%!CONST_fonts_acorn)-8)))
     $buff%=ps_t$: B%=buff%: C%=2: ps_k%!CONST_fonts_foreign=USR(code_entry%+CONST_entry_store_string)
     REM VDU: PROCftracef("Length of block for '"+$buff%+"' is &"+STR$~(!((ps_k%!CONST_fonts_foreign)-8)))
     ps_k%!CONST_fonts_flags=1
     IF ps_j%=0 THEN
      ps_download%=TRUE: REM got SOMETHING to download
      ps_k%!CONST_fonts_flags=ps_k%!CONST_fonts_flags OR 1<<31
     ENDIF
    ENDIF
   ENDWHILE
   CLOSE#ps_i%
   PROCps_lose_fonts
   IF ps_changed% AND take_action% THEN
    IF ps_download% THEN
     ps_i%=FNprinter_find_window(prnt%,"download")
     PROCicon_write(ps_i%,3,FNprinter_read_string(prnt%!CONST_prnt_name))
     PROCicon_write(ps_i%,4,$prnt%!CONST_prnt_type)
     PROCicon_write(ps_i%,5,"0"): REM The default password for PostScript
     !buff%=ps_i%: SYS"Wimp_GetWindowState",,buff%
     SYS"Wimp_OpenWindow",,buff%
     PROCcaret_set(ps_i%,5): REM get caret at end of string
     REM was SYS"Wimp_SetCaretPosition",ps_i%,5,-1,-1,-1,0
     ENDPROC
    ELSE
     IF prnt%!CONST_prnt_flags AND 2 THEN
/*
 *     REM this is the currently selected printer so re-ensure it 'cos the
 *     REM mappings have changed
 */
      !buff%=20: buff%!12=0: buff%!16=&80152: SYS"Wimp_SendMessage",17,buff%,0
     ENDIF
    ENDIF
   ENDIF
  ELSE
   PROCps_lose_fonts
  ENDIF
ENDPROC

DEF PROCps_download_fonts(wind%)
  LOCAL ps_i%,ps_c%,ps_j%,ps_k%,ps_l%,ps_s$,B%,C%,D%,E%,F%,G%,ptr%
  LOCAL ERROR
  REM VDU: PROCftracef("PROCps_download_fonts")
  REM Check that there is a password.
  IF FNicon_read(wind%,5)="" ERROR CONST_error_ok,FNmsg_0(psup%!CONST_psup_msg,"OK0")
  SYS"Hourglass_On"
  REM need to find a file to spit the data into
  ps_i%=0
  REPEAT
   SYS"OS_File",17,"<Wimp$ScrapDir>.Printers."+STR$ ps_i% TO ps_c%
   IF ps_c% ps_i%+=1
  UNTIL ps_c%=0
  REM now select the PostScript driver module
  SYS"PDriver_SelectDriver",0
  PROCps_add_fonts(TRUE): REM declare the MAPPED fonts
  ps_c%=OPENOUT("<Wimp$ScrapDir>.Printers."+STR$ ps_i%)
  ON ERROR LOCAL RESTORE ERROR: CLOSE#ps_c%: ERROR ERR,REPORT$
  BPUT#ps_c%,"%!PS-Adobe-2.0 ExitServer"
  BPUT#ps_c%,"%%Creator: "+FNmsg_0(psup%!CONST_psup_msg,"ID")
  BPUT#ps_c%,"%%CreationDate: ";
  ?buff%=3: SYS"OS_Word",14,buff%
  SYS"OS_ConvertStandardDateAndTime",buff%,buff%+5,250: ps_k%=buff%+5
  WHILE ?ps_k% BPUT#ps_c%,?ps_k%: ps_k%+=1: ENDWHILE: BPUT#ps_c%,10
  BPUT#ps_c%,"%%DocumentSuppliedFonts: ";
  ps_j%=prnt%!CONST_prnt_fonts: ps_l%=FALSE
  WHILE ps_j%
   IF ps_j%!CONST_fonts_flags AND 1<<31 THEN
    SYS "MakePSFont_MakeFont",-2,$ps_j%!CONST_fonts_acorn+CHR$ 0,buff%,256,0
    IF ps_l% BPUT#ps_c%,"%%+ ";
    ps_k%=buff%: ps_l%=TRUE
    WHILE ?ps_k% BPUT#ps_c%,?ps_k%: ps_k%+=1: ENDWHILE
    BPUT#ps_c%,10
   ENDIF
   ps_j%=ps_j%!CONST_fonts_next
  ENDWHILE
  BPUT#ps_c%,"%%Pages: 0"
  BPUT#ps_c%,"%%BoundingBox: 0 0 0 0"
  BPUT#ps_c%,"%%EndComments"
  BPUT#ps_c%,"%%BeginSetup"
  BPUT#ps_c%,"%%BeginExitServer: "+FNicon_read(wind%,5)
  BPUT#ps_c%,"serverdict begin "+FNicon_read(wind%,5)+" exitserver"
  BPUT#ps_c%,"%%EndExitServer"
  BPUT#ps_c%,"%%EndSetup"
  ps_j%=prnt%!CONST_prnt_fonts
  WHILE ps_j%
   IF ps_j%!CONST_fonts_flags AND 1<<31 THEN
    SYS "MakePSFont_MakeFont",ps_c%,$ps_j%!CONST_fonts_acorn+CHR$0,buff%,256,0
    ps_j%!CONST_fonts_flags=ps_j%!CONST_fonts_flags AND NOT(1<<31)
   ENDIF
   ps_j%=ps_j%!CONST_fonts_next
  ENDWHILE
  BPUT#ps_c%,"%%EOF"
  CLOSE#ps_c%
  RESTORE ERROR
  SYS"OS_File",18,"<Wimp$ScrapDir>.Printers."+STR$ ps_i%,&FF5
  REM re-select the default printer so that the font settings are true
  !buff%=20: buff%!12=0: buff%!16=&80152: SYS"Wimp_SendMessage",17,buff%,0
/*
 * REM we use xbuff here ... this is safe 'cos this procedure gets called
 * REM as a result of a keypress or window close.
 */
  B%=TRUE
  C%=xbuff%: $C%=FNmsg_0(psup%!CONST_psup_msg,"PR")
  D%=C%+LEN $C%+1: $D%="<Wimp$ScrapDir>.Printers."+STR$ ps_i%
  E%=D%+LEN $D%+1: $E%=FNmsg_0(psup%!CONST_psup_msg,"DF")
  F%=prnt%
  G%=&FF5
  CALL code_entry%+CONST_entry_add_queue_entry
  PROCps_find_fonts_to_do(prnt%!CONST_prnt_next)
  SYS"Hourglass_Off"
  REM VDU: PROCftracef("PROCps_download_fonts done")
ENDPROC

DEF PROCps_lose_fonts
  LOCAL ps_i%,ps_old_i%
  REM VDU: PROCftracef("PROCps_lose_fonts")
  ps_i%=prnt%!CONST_prnt_fonts
  WHILE ps_i%
   IF ps_i%!CONST_fonts_flags AND 1<<30 THEN
    REM make the link
    IF ps_old_i% THEN
     ps_old_i%!CONST_fonts_next=ps_i%!CONST_fonts_next
    ELSE
     prnt%!CONST_prnt_fonts=ps_i%!CONST_fonts_next
    ENDIF
    B%=CONST_ident_STRG: C%=ps_i%!CONST_fonts_acorn: CALL code_entry%+CONST_entry_heap_free
    B%=CONST_ident_STRG: C%=ps_i%!CONST_fonts_foreign: CALL code_entry%+CONST_entry_heap_free
    B%=CONST_ident_FONT: C%=ps_i%: ps_i%=ps_i%!CONST_fonts_next: CALL code_entry%+CONST_entry_heap_free
   ELSE
    ps_old_i%=ps_i%
    ps_i%=ps_i%!CONST_fonts_next
   ENDIF
  ENDWHILE
ENDPROC

DEF PROCps_add_fonts(only_mapped%)
  LOCAL ps_i%,ps_j%,ps_old_driver%
  REM VDU: PROCftracef("PROCps_add_fonts")
  SYS"PDriver_SelectDriver",0 TO ps_old_driver%
  SYS"PDriver_MiscOp",1: REM clear all fonts
  ps_i%=prnt%!CONST_prnt_fonts
  WHILE ps_i%
   ps_j%=ps_i%!CONST_fonts_flags AND NOT(3<<30): REM lose our private bits
   IF ps_i%!CONST_fonts_foreign=0 THEN
    IF only_mapped%=FALSE THEN
     REM a downloaded font - need to call MakePSFont in case derived fonts are needed
     REM note that -1 means no output generated
     SYS "MakePSFont_MakeFont",-1,$ps_i%!CONST_fonts_acorn+CHR$ 0,buff%,256,0
    ENDIF
   ELSE
    REM a remap - just declare it
    SYS"PDriver_MiscOp",0,$ps_i%!CONST_fonts_acorn,$ps_i%!CONST_fonts_foreign,ps_j%
   ENDIF
   ps_i%=ps_i%!CONST_fonts_next
  ENDWHILE
  SYS"PDriver_SelectDriver",ps_old_driver%
  REM VDU: PROCftracef("PROCps_add_fonts done")
ENDPROC

DEF PROCps_save_configuration(window%)
  LOCAL ps_i%,ps_j%,ps_k%,ps_s$,B%,C%,ps_t$
  REM VDU: PROCftracef("PROCps_save_configuration_window")
  prdt%=FNprinter_find_prdata_entry(psup%,FNicon_read(window%,6))
  PROCfree_structure(prnt%!CONST_prnt_name)
  $buff%=FNicon_read(window%,13)
  B%=buff%
  C%=2
  prnt%!CONST_prnt_name=USR(code_entry%+CONST_entry_store_string)

  IF cnfg%!CONST_cnfg_ps_feed <> 0 THEN
    PROCfree_structure(cnfg%!CONST_cnfg_ps_feed)
    cnfg%!CONST_cnfg_ps_feed=0
  ENDIF
  ps_i%=0
  ps_t$=FNprinter_read_string_entry(prdt%,CONST_ps_template_feeds)
  REM if the default setting has been chosen, do not save anything away
  IFps_t$<>FNmsg_0(psup%!CONST_psup_msg,"ME1b") AND ps_t$<>"" THEN
    REM otherwise match up on the feed name
    REPEAT
      SYS"OS_GBPB",9,ps_t$,buff%,1,ps_i%,256,"*" TO ,,,ps_j%
      IFps_j%=1 THEN
        CALL Z%,buff%,ps_s$
        $buff%=ps_t$+"."+ps_s$
        IFFNps_get_feed_name($buff%)=FNicon_read(window%,3) THEN
          B%=buff%
          C%=2
          cnfg%!CONST_cnfg_ps_feed=USR(code_entry%+CONST_entry_store_string)
          ps_i%=-1
        ELSE
          ps_i%+=1
        ENDIF
      ENDIF
    UNTIL ps_j%<>1 OR ps_i%<0
  ENDIF

  ps_j%=0
  IF FNicon_set(window%,8)                                                                       ps_j%+=1
  IF FNicon_set(window%,11)                                                                      ps_j%+=2
  IF FNicon_read(window%,18)=FNmsg_0(psup%!CONST_psup_msg,"PO1")                                 ps_j%+=4
  IF cnfg%!CONST_cnfg_ps_feed = 0 AND FNicon_read(window%,3)=FNmsg_0(psup%!CONST_psup_msg,"PF1") ps_j%+=8
  IF FNicon_set(window%,7)                                                                       ps_j%+=16
  IF FNicon_set(window%,31)                                                                      ps_j%+=32
  IF FNicon_set(window%,32)                                                                      ps_j%+=64
  ps_i%=VAL FNicon_read(window%,30)
  IF ps_i%>200 ps_i%=100
  IF ps_i%<20  ps_i%=100
  ps_j%+=ps_i%<<8
  ps_j%+=VAL FNicon_read(window%,16)-1<<16
  CASE FNicon_read(window%,23)OF
    WHEN FNmsg_0(psup%!CONST_psup_msg,"CC1"): ps_j%+=1<<24
    WHEN FNmsg_0(psup%!CONST_psup_msg,"CC2"): ps_j%+=1<<25
  ENDCASE
  !cnfg%!CONST_cnfg_ps_flags=ps_j%

  ps_j%=prnt%!CONST_prnt_psze: ps_s$=FNicon_read(window%,27)
  IF $ps_j%!CONST_psze_name<>ps_s$ THEN
   ps_i%=psize_head%
   WHILE ps_i%
    IF $ps_i%!CONST_psze_name=ps_s$ THEN
     prnt%!CONST_prnt_psze=ps_i%
     ps_i%=0
    ELSE
     ps_i%=ps_i%!CONST_psze_next
    ENDIF
   ENDWHILE
  ENDIF

  IF prnt%!CONST_prnt_icon<>-1 THEN
    REM this printer is ACTIVE!
    REM ensure that its details are correct
    PROCselect_printer(prnt%,TRUE,FALSE)
    REM The front end code will spot that the selected printer has
    REM changed and put everything back the way it was
    REM PROCselect_printer(0,TRUE,TRUE): REM don't do this (calls into overlay). JRC 12 Feb '92
  ENDIF
ENDPROC

DEF PROCps_menu(top$,rebuild%,iconpos%)
  LOCAL wind%,ps_i%,ps_ix%,ps_iy%,ind_title%,list_index%,menu_index%,s$,t$
  REM VDU: PROCftracef("PROCps_menu")
  IF rebuild% THEN
   ps_menu_xpos%=xbuff%!0-64
   ps_menu_ypos%=xbuff%!4
  ENDIF
  IF iconpos% THEN
   !buff%=xbuff%!12: buff%!4=xbuff%!16: SYS"Wimp_GetIconState",,buff%
   ps_ix%=buff%!16: ps_iy%=buff%!20
   SYS"Wimp_GetWindowState",,buff%
   ps_menu_xpos%=buff%!20+buff%!4+ps_ix%+2
   ps_menu_ypos%=buff%!24+buff%!16+ps_iy%-2
  ENDIF
  wind%=FNprinter_find_window(prnt%,"configure")
  ps_menu_chsn$=top$
  CASE top$ OF
  WHEN "ME1": IF FNprinter_read_string_entry(prdt%,CONST_ps_template_feeds)="" THEN
                PROCmenu_create(ps_menu%,FNmsg_0(psup%!CONST_psup_msg,"ME1a"))
              ELSE
                PROCmenu_create(ps_menu%,FNmsg_0(psup%!CONST_psup_msg,"ME1")+","+FNmsg_0(psup%!CONST_psup_msg,"ME1b")+"#")
                ind_title%=(ps_menu%!28 AND &100)<>0
                /* scan the list of available paper feeds */
                list_index%=0
                menu_index%=1:REM add items after default entry
                t$=FNprinter_read_string_entry(prdt%,CONST_ps_template_feeds)
                SYS"Hourglass_On"
                REPEAT
                  SYS"OS_GBPB",9,t$,buff%,1,list_index%,256,"*" TO ,,,ps_i%
                  IFps_i%=1 THEN
                    CALL Z%,buff%,s$
                    s$=FNps_get_feed_name(t$+"."+s$)
                    IFs$<>"" PROCmenu_item(ps_menu%,menu_index%,s$,ind_title%):menu_index%+=1
                    list_index%+=1
                  ENDIF
                UNTIL ps_i%<>1
                SYS"Hourglass_Off"
              ENDIF
              PROCmenu_tick_match(ps_menu%,FNicon_read(wind%,3))
  WHEN "ME2": PROCmenu_create(ps_menu%,FNmsg_0(psup%!CONST_psup_msg,"ME2"))
              PROCmenu_tick_match(ps_menu%,FNicon_read(wind%,16))
  WHEN "ME3": PROCmenu_create(ps_menu%,FNmsg_0(psup%!CONST_psup_msg,"ME3"))
              PROCmenu_tick_match(ps_menu%,FNicon_read(wind%,18))
  WHEN "ME4": PROCmenu_create(ps_menu%,FNmsg_0(psup%!CONST_psup_msg,"ME4"))
              PROCmenu_tick_match(ps_menu%,FNicon_read(wind%,23))
  WHEN "MP1": PROCcreate_paper_menu(ps_menu%,wind%,27)
  ENDCASE
  PROCdisplay_menu(prnt%,ps_menu%,ps_menu_xpos%,ps_menu_ypos%)
ENDPROC

  REM Text printing code

DEF PROCps_m8
  LOCAL ps_r%,queu%,tpub%,tprv%
  REM VDU: PROCftracef("PROCps_m8")
  ps_r%=!xbuff%
  queu%=xbuff%!4
  tpub%=queu%!CONST_queu_tpub
  tprv%=queu%!CONST_queu_tprv
  CASE ps_r% OF
  WHEN -1: PROCps_1
  WHEN -2: PROCps_2
  WHEN -3: PROCps_3
  WHEN -4: PROCps_4
  WHEN -6: PROCps_6
  WHEN -7: PROCps_7
  WHEN -8: PROCps_8
  WHEN -9: PROCps_9
  WHEN-10: PROCps_10
  WHEN-11: PROCps_11
  WHEN-12: PROCps_12
  WHEN-13: PROCps_13
  WHEN-14: PROCps_14
  WHEN-15: PROCps_15
  WHEN-16: PROCps_16
  WHEN-17: PROCps_17
  WHEN-18: PROCps_18
  WHEN-19: PROCps_19
  WHEN-20: PROCps_20
  ENDCASE
ENDPROC

DEF PROCps_1
/*  REM only called if we aren't printing a PostScript file */
  LOCAL local_pl%,local_pr%,local_pb%,local_pt%,local_margin%
  LOCAL local_psze%,local_format_print%,local_pw%
  LOCAL last_char%
  LOCAL ps_i%,ps_s$,ps_h,ps_w,B%,C%
  REM VDU: PROCftracef("PROCps_1")
/*  REM this is the first call to us, so let's claim our private text block */
  B%=CONST_ident_TPRV: C%=CONST_tprv_ps_MAX
  tprv%=USR(code_entry%+CONST_entry_heap_claim)
  IFtprv%=0 ERROR CONST_error_fatal, FNmsg_0(FNps_host_desc,"FA5")
  queu%!CONST_queu_tprv=tprv%
  FORps_i%=CONST_tprv_ps_bbox TO CONST_tprv_ps_right_print STEP 4: tprv%!ps_i%=0: NEXT
  REM
  local_format_print%=(!cnfg%!CONST_cnfg_ps_flags AND 4)>>2
  tprv%!CONST_tprv_ps_cols_print=1+((!cnfg%!CONST_cnfg_ps_flags AND &FF0000)>>16)
  tpub%!CONST_tpub_number_print=(!cnfg%!CONST_cnfg_ps_flags AND 2)>>1
  tpub%!CONST_tpub_title_print=!cnfg%!CONST_cnfg_ps_flags AND 1
  IF queu%!CONST_queu_type=&FFF THEN
   tpub%!CONST_tpub_cc_print=(!cnfg%!CONST_cnfg_ps_flags AND &FF000000)>>24
  ELSE
   tpub%!CONST_tpub_cc_print=(!cnfg%!CONST_cnfg_ps_flags AND &FF000000)>>24: REM was 1 JRC
  ENDIF
  local_margin%=50
  local_psze%=prnt%!CONST_prnt_psze
  local_pl%=local_psze%!CONST_psze_lmargin DIV 100 + 1 + local_margin%
  local_pr%=local_psze%!CONST_psze_rmargin DIV 100 - local_margin%
  local_pb%=local_psze%!CONST_psze_bmargin DIV 100 + 1 + local_margin%
  local_pt%=local_psze%!CONST_psze_tmargin DIV 100 - local_margin%
  ps_s$=STR$(local_pl% DIV 10)+" "+STR$(local_pb% DIV 10)
  ps_s$+=" "+STR$((local_pr%+9)DIV 10)+" "+STR$((local_pt%+9)DIV 10)
  $buff%=ps_s$: B%=buff%: C%=2: tprv%!CONST_tprv_ps_bbox=USR(code_entry%+CONST_entry_store_string)
  IF local_format_print%=0 THEN
   REM portrait
   IF tpub%!CONST_tpub_title_print local_pt%-=150
   local_pw%=local_pr%-local_pl%
   tprv%!CONST_tprv_ps_ph=local_pt%-local_pb%
   $buff%=STR$ local_pl%+" "+STR$ local_pt%+" 0"
  ELSE
   REM landscape
   IF tpub%!CONST_tpub_title_print local_pl%+=150
   local_pw%=local_pt%-local_pb%
   tprv%!CONST_tprv_ps_ph=local_pr%-local_pl%
   $buff%=STR$ local_pb%+" "+STR$ -local_pl%+" 90"
  ENDIF

  B%=buff%: C%=2: tprv%!CONST_tprv_ps_transform=USR(code_entry%+CONST_entry_store_string)
  tprv%!CONST_tprv_ps_fsize=(!cnfg%!CONST_cnfg_ps_flags AND &FF00)>>8
  REM VDU: PROCftracef("Local font size is "+STR$ tprv%!CONST_tprv_ps_fsize)

  ps_w=0.72*tprv%!CONST_tprv_ps_fsize /*: REM courier character width is 60% of size. Also starring "hack." JRC 31 Mar '92 */
  ps_h=1.2*tprv%!CONST_tprv_ps_fsize: REM allow 10% leading

  REM VDU: PROCftracef("=> (w, h) = ("+STR$ ps_w+", "+STR$ ps_h+")")

  local_pw%=local_pw% DIV ps_w: REM size of page in characters
  tprv%!CONST_tprv_ps_ph=tprv%!CONST_tprv_ps_ph DIV ps_h
  tprv%!CONST_tprv_ps_cw=(local_pw%+2)DIV tprv%!CONST_tprv_ps_cols_print-2: REM width of column in characters

  IF tprv%!CONST_tprv_ps_cw<10+local_psze%!CONST_psze_tleft+local_psze%!CONST_psze_tright THEN
    ERROR CONST_error_ok,FNmsg_0(psup%!CONST_psup_msg,"ErrNarr")
  ENDIF

  tprv%!CONST_tprv_ps_mt=local_psze%!CONST_psze_ttop
  tpub%!CONST_tpub_line_max=tprv%!CONST_tprv_ps_ph-local_psze%!CONST_psze_tbottom
  tprv%!CONST_tprv_ps_left_print=local_psze%!CONST_psze_tleft
  tprv%!CONST_tprv_ps_right_print=local_psze%!CONST_psze_tright
  tpub%!CONST_tpub_xc=tprv%!CONST_tprv_ps_cw-tprv%!CONST_tprv_ps_right_print
  tprv%!CONST_tprv_ps_xl=tprv%!CONST_tprv_ps_left_print

  IF tpub%!CONST_tpub_number_print tprv%!CONST_tprv_ps_xl+=6

  REM build a character translation table
  PROCps_add_char(last_char%,40,"\(")
  PROCps_add_char(last_char%,41,"\)")
  PROCps_add_char(last_char%,92,"\\")
  FORps_i%=128 TO 255
   PROCps_add_char(last_char%,ps_i%,FNps_oct(ps_i%))
  NEXT
ENDPROC

DEF PROCps_add_char(RETURN last%,char%,trans$)
  LOCAL ps_p%,B%,C%
  REM VDU: PROCftracef("PROCps_add_char")
  B%=CONST_ident_CHAR: C%=7+LEN trans$
  ps_p%=USR(code_entry%+CONST_entry_heap_claim)
  IFps_p%=0 ERROR CONST_error_fatal, FNmsg_0(FNps_host_desc,"FA5")
  !ps_p%=0
  ps_p%?4=char%
  ps_p%?5=LEN trans$
  $(ps_p%+6)=trans$
  IF last% THEN
   !last%=ps_p%
  ELSE
   queu%!CONST_queu_char=ps_p%
  ENDIF
  last%=ps_p%
ENDPROC

DEF PROCps_2
  REM Produce any required job initialisation output
  LOCAL ps_c%
  REM VDU: PROCftracef("PROCps_2")
  ps_c%=xbuff%!8
  PROCps_header(ps_c%)
  PROCps_prolog(ps_c%)
  PROCps_encoding(ps_c%)
  PROCps_setupline(ps_c%)
ENDPROC

DEF PROCps_header(ps_c%)
  LOCAL ps_old_job%,ps_old_driver%,ps_s$,ps_i%
  REM VDU: PROCftracef("PROCps_header")
  REM need to ensure that PDriverPS is the selected driver
  SYS"PDriver_SelectDriver",0 TO ps_old_driver%
  REM get PDriverPS to output the job header and start a job
  SYS"PDriver_SelectJob",ps_c%,FNprinter_read_string(tpub%!CONST_tpub_name)TO ps_old_job%
  REM now restore the old job
  SYS"PDriver_SelectJob",ps_old_job%
  REM and the old driver
  SYS"PDriver_SelectDriver",ps_old_driver%
  /* output the feed postscript here in case it redefines any words used later on, like showpage */
  IF cnfg%!CONST_cnfg_ps_feed <> 0 THEN
    ps_i%=OPENIN(FNprinter_read_string(cnfg%!CONST_cnfg_ps_feed))
    IFps_i%<>0 THEN WHILE NOT EOF#ps_i%:BPUT#ps_c%,BGET#ps_i%:ENDWHILE:CLOSE#ps_i%
  ENDIF
  BPUT#ps_c%,"/PDdict 50 dict def"
  BPUT#ps_c%,"PDdict begin"
ENDPROC

DEF PROCps_encoding(ps_c%)
  LOCAL ps_f%,ps_h%,ps_old_driver%,ps_b$,ps_bo$,ps_m$,ps_mo$
  LOCAL ps_acc%
  LOCAL ERROR
  REM VDU: PROCftracef("PROCps_encoding")
  REM SYS"XOS_Find",&40,"Printers:ps.PSfiles.PSencoding" TO ps_h%;ps_f%
  REM IF ps_f% AND 1 ps_h%=0
  REM IF ps_h%=0 ERROR CONST_error_ok,FNmsg_0(psup%!CONST_psup_msg,"ErrEnc"): REM Error opening PSencoding file
  REM PROCps_outputfile(ps_h%,ps_c%)
  SYS"PDriver_SelectDriver",0 TO ps_old_driver%
  SYS"PDriver_SelectJob",ps_c% TO ps_h%
  ON ERROR LOCAL RESTORE ERROR: SYS"PDriver_SelectJob",ps_h%: ERROR ERR,REPORT$
  REM VDU: ON ERROR LOCAL RESTORE ERROR: SYS"PDriver_SelectJob",ps_h%: ERROR ERR,REPORT$+" ("+STR$ ERL+")"

  REM if accented chars button checked, then use RF/RFE proc for remapping.  Otherwise send
  REM inline code, which does not do PostScript runtime accent generation.
  REM R4=16+4+1 means use RF and RFE procs to do the remap (supplied in prolog), that this is a
  REM non-permanent print job, and to make the extra declarations for DocumentFonts and DocumentSuppliedFonts

  IF !cnfg%!CONST_cnfg_ps_flags AND 64 ps_acc%=16+4+1 ELSE ps_acc%=4+1

  SYS "MakePSFont_MakeFont",ps_c%,"\FCorpus.Bold"+CHR$ 0,buff%,256,ps_acc%: ps_f%=buff%
  WHILE ?ps_f%: ps_b$+=CHR$ ?ps_f%: ps_f%+=1: ENDWHILE
  SYS "MakePSFont_MakeFont",ps_c%,"\FCorpus.Bold.Oblique"+CHR$ 0,buff%,256,ps_acc%: ps_f%=buff%
  WHILE ?ps_f%: ps_bo$+=CHR$ ?ps_f%: ps_f%+=1: ENDWHILE
  SYS "MakePSFont_MakeFont",ps_c%,"\FCorpus.Medium"+CHR$0,buff%,256,ps_acc%: ps_f%=buff%
  WHILE ?ps_f%: ps_m$+=CHR$ ?ps_f%: ps_f%+=1: ENDWHILE
  SYS "MakePSFont_MakeFont",ps_c%,"\FCorpus.Medium.Oblique"+CHR$ 0,buff%,256,ps_acc%: ps_f%=buff%
  WHILE ?ps_f%: ps_mo$+=CHR$ ?ps_f%: ps_f%+=1: ENDWHILE

  REM now add these names to the DocumentFont list (within the job)
  SYS"XPDriver_MiscOp",0,ps_m$,"X",40,0
  SYS"XPDriver_MiscOp",0,ps_b$,"X",40,0
  SYS"XPDriver_MiscOp",0,ps_mo$,"X",40,0
  SYS"XPDriver_MiscOp",0,ps_bo$,"X",40,0
  SYS"PDriver_SelectJob",ps_h%
  SYS"PDriver_SelectDriver",ps_old_driver%
  BPUT#ps_c%,"/TF /"+ps_b$+" def"
  BPUT#ps_c%,"/NF /"+ps_m$+" def"
  BPUT#ps_c%,"/BF /"+ps_b$+" def"
  BPUT#ps_c%,"/IF /"+ps_mo$+" def"
  BPUT#ps_c%,"/BIF /"+ps_bo$+" def"
  BPUT#ps_c%,10
ENDPROC

DEF PROCps_prolog(ps_c%)
  LOCAL ps_f%,ps_h%
  REM VDU: PROCftracef("PROCps_prologue")
  SYS"XOS_Find",&4F,"Printers:ps.PSfiles.PStprolog" TO ps_h%;ps_f%
  IF ps_f% AND 1 ps_h%=0
  IF ps_h%=0 ERROR CONST_error_ok,$(ps_h%+4)
  PROCps_outputfile(ps_h%,ps_c%)
ENDPROC

DEF PROCps_outputfile(ps_h%,ps_c%)
  REM VDU: PROCftracef("PROCps_output")
  WHILE NOT EOF#ps_h%
    BPUT#ps_c%,GET$#ps_h%
  ENDWHILE
  SYS"XOS_Find",0,ps_h%
ENDPROC

DEF PROCps_setupline(ps_c%)
  LOCAL ps_s$, ps_i%, local_psze%, ps_extra$
  REM VDU: PROCftracef("PROCps_setupline")
  BPUT#ps_c%,"%%EndProlog"
  BPUT#ps_c%,"%%BeginSetup"

  local_psze%=prnt%!CONST_prnt_psze
  ps_s$=$local_psze%!CONST_psze_name
  ps_i%=0
  WHILE MID$(ps_s$,ps_i%,1)<>" " AND ps_i%<=LEN ps_s$
    ps_i%+=1
  ENDWHILE
  ps_s$=LEFT$(ps_s$,ps_i%-1)

  SYS"OS_File",17,"Printers:ps.Paper."+FNtask_lower(ps_s$) TO ps_i%
  IF ps_i%=1 THEN
    ps_i%=OPENIN("Printers:ps.Paper."+FNtask_lower(ps_s$))
    IFps_i%<>0 THEN WHILE NOT EOF#ps_i%:BPUT#ps_c%,BGET#ps_i%:ENDWHILE:CLOSE#ps_i%
  ELSE
    ps_extra$=FNmsg_2(psup%!CONST_psup_msg,"PT",ps_s$,FNtask_lower(ps_s$))
  ENDIF

  BPUT#ps_c%, STR$(FNps_fontsize(tpub%!CONST_tpub_font_num))+" FI"

  IF FNprinter_read_string_entry(prdt%,CONST_ps_template_feeds)="" AND cnfg%!CONST_cnfg_ps_feed = 0 THEN
    IF !cnfg%!CONST_cnfg_ps_flags AND 8 THEN
      ps_s$=FNungstrans(FNprinter_read_boolean_string_entry(prdt%,CONST_ps_template_manualfeed,TRUE))
    ELSE
      ps_s$=FNungstrans(FNprinter_read_boolean_string_entry(prdt%,CONST_ps_template_manualfeed,FALSE))
    ENDIF
    IF ps_extra$<>"" ps_extra$=ps_s$+"|J"+ps_extra$ ELSE ps_extra$=ps_s$
  ENDIF

  IF ps_extra$<>"" THEN
    BPUT#ps_c%,ps_extra$
  ENDIF
  BPUT#ps_c%,"%%EndSetup"
ENDPROC

DEF PROCps_3
  REM Produce page header
  LOCAL ps_s$,old_pos%,local_psze%,local_style_bits%,ps_c%,ps_t$,ps_w,ps_h,@%
  REM VDU: PROCftracef("PROCps_3")
  local_style_bits%=tpub%!CONST_tpub_style_bits
  tpub%!CONST_tpub_style_bits=64: REM title bit
  ps_c%=xbuff%!8
  ps_s$="%%Page: "
  IF tprv%!CONST_tprv_ps_cols_print>1 ps_s$+=STR$(tprv%!CONST_tprv_ps_cols_print*tpub%!CONST_tpub_page_num+1)+"-"
  tpub%!CONST_tpub_page_num+=1
  ps_s$+=STR$(tprv%!CONST_tprv_ps_cols_print*tpub%!CONST_tpub_page_num)+" "+STR$tpub%!CONST_tpub_page_num
  BPUT#ps_c%,ps_s$
  BPUT#ps_c%,"%%PageBoundingBox: "+FNprinter_read_string(tprv%!CONST_tprv_ps_bbox)
  BPUT#ps_c%,FNprinter_read_string(tprv%!CONST_tprv_ps_transform);
  BPUT#ps_c%," "+STR$(1.2*tprv%!CONST_tprv_ps_fsize);
  REM VDU: PROCftracef("Local font size is "+STR$(1.2*tprv%!CONST_tprv_ps_fsize))
  ps_w=0.72*tprv%!CONST_tprv_ps_fsize: REM courier character width is 60% of size
  ps_h=1.2*tprv%!CONST_tprv_ps_fsize
  REM VDU: PROCftracef("=> (w, h) = ("+STR$ ps_w+", "+STR$ ps_h+")")

  @%="+g10.9"
  BPUT#ps_c%," "+STR$ ps_w+" "+STR$ ps_h+" StartPage"
  IF tpub%!CONST_tpub_title_print THEN
    local_psze%=prnt%!CONST_prnt_psze
    old_pos%=tpub%!CONST_tpub_cpos
    ps_s$=STR$(local_psze%!CONST_psze_ttop-0.5)+" "+STR$ tprv%!CONST_tprv_ps_left_print+" MT "+STR$ 64+" ("
    ps_t$=FNprinter_read_string(tpub%!CONST_tpub_name)+"   "+FNprinter_read_string(tpub%!CONST_tpub_time)
    ps_t$+="   "+FNmsg_1(psup%!CONST_psup_msg,"PAG",STR$ tpub%!CONST_tpub_page_num)
    ps_s$+=FNps_trans(ps_t$)+") SS"
    BPUT#ps_c%,ps_s$
    tpub%!CONST_tpub_cpos=old_pos%
  ENDIF
  tpub%!CONST_tpub_style_bits=local_style_bits%
  tprv%!CONST_tprv_ps_col=0
ENDPROC

DEF PROCps_4
  REM post line processing
  LOCAL ps_i%,ps_b$
  REM VDU: PROCftracef("PROCps_4")
  REM if we've output something and we aren't formatting, end the string
  IF xbuff%!8<>0 AND tpub%!CONST_tpub_format_flag=0 ps_b$=") SS"
  REM if we've reached the end or we're ending the page ...
  IF EOF#queu%!CONST_queu_handle_in OR(tpub%!CONST_tpub_page_flag>1)THEN
    REM move on to the next column
    tprv%!CONST_tprv_ps_col+=1
    REM if we've reached the end or we've run out of columns ...
    IF EOF#queu%!CONST_queu_handle_in OR tprv%!CONST_tprv_ps_col>=tprv%!CONST_tprv_ps_cols_print THEN
      REM set the stage to deal with the footer
      tpub%!CONST_tpub_stage=3
    ENDIF
  ENDIF
  xbuff%?8=LEN ps_b$
  $(xbuff%+9)=ps_b$
ENDPROC

DEF PROCps_6
  REMM Do control code processing
  LOCAL ps_s$
  REM VDU: PROCftracef("PROCps_6")
  ps_s$=FNps_display(xbuff%!8)
  xbuff%?8=LEN ps_s$
  $(xbuff%+9)=ps_s$
ENDPROC

DEF PROCps_7
  REM handle a backspace
  REM simple! just move back to where the last character is!
  LOCAL ps_b$
  REM VDU: PROCftracef("PROCps_7")
  PROCps_8: REM stores its value in xbuff%+9
  ps_b$=") SS "+$(xbuff%+9)
  xbuff%?8=LEN ps_b$
  $(xbuff%+9)=ps_b$
ENDPROC

DEF PROCps_8
  REM handle line splitting
  LOCAL ps_b$,ps_i
  REM VDU: PROCftracef("PROCps_8")
  ps_i=tprv%!CONST_tprv_ps_xl
  ps_i+=tprv%!CONST_tprv_ps_col*(tprv%!CONST_tprv_ps_cw+1)
  ps_i+=(tpub%!CONST_tpub_cpos-tprv%!CONST_tprv_ps_xl)*(FNps_fontsize(0)/FNps_fontsize(tpub%!CONST_tpub_font_num))
  ps_b$=STR$ tpub%!CONST_tpub_line_page+" "+STR$ ps_i+" MT "+STR$(tpub%!CONST_tpub_style_bits AND &7F)+" ("
  xbuff%?8=LEN ps_b$
  $(xbuff%+9)=ps_b$
ENDPROC

DEF PROCps_9
  REM handle style changes
  LOCAL ps_b$
  REM VDU: PROCftracef("PROCps_9")
  ps_b$=") SS "+STR$(xbuff%!8 AND &7F)+" ("
  xbuff%?8=LEN ps_b$
  $(xbuff%+9)=ps_b$
ENDPROC

DEF PROCps_10
  REM start a new line
  LOCAL ps_b$,line_num$,wrap%,ps_i
  REM VDU: PROCftracef("PROCps_10")
  tpub%!CONST_tpub_line_page+=1
  tpub%!CONST_tpub_line_doc+=1
  ps_i=tprv%!CONST_tprv_ps_left_print+tprv%!CONST_tprv_ps_col*(tprv%!CONST_tprv_ps_cw+1)
  ps_b$=STR$ tpub%!CONST_tpub_line_page+" "+STR$ ps_i+" MT "
  wrap%=(tpub%!CONST_tpub_cpos>=tpub%!CONST_tpub_xc)
  IF tpub%!CONST_tpub_number_print THEN
    IF tpub%!CONST_tpub_font_num ps_b$+=STR$ FNps_fontsize(0)+" FS "
    ps_b$+="0 ("
    REM print line number, unless wrapped line
    IF wrap% THEN
      tpub%!CONST_tpub_line_doc-=1
      ps_b$+=STRING$(6," ")
    ELSE
      line_num$=STR$ tpub%!CONST_tpub_line_doc
      ps_b$+=STRING$(5-LEN line_num$," ")+line_num$+" "
    ENDIF
    tpub%!CONST_tpub_cpos=6
    ps_b$+=") SS "
    IF tpub%!CONST_tpub_font_num ps_b$+=STR$(FNps_fontsize(tpub%!CONST_tpub_font_num))+" FS "
  ELSE
    tpub%!CONST_tpub_cpos=0
  ENDIF
  IF tprv%!CONST_tprv_ps_left_ruler>0 ps_b$+="0 ("+STRING$(tprv%!CONST_tprv_ps_left_ruler," ")+") SS "
  IF wrap% THEN
    tpub%!CONST_tpub_cpos+=1
    ps_b$+="1 (|) SS ": REM print wrap bar in bold
  ENDIF
  ps_b$+=STR$(tpub%!CONST_tpub_style_bits AND &7F)+" ("
  tpub%!CONST_tpub_cpos+=tprv%!CONST_tprv_ps_left_print+tprv%!CONST_tprv_ps_left_ruler
  xbuff%?8=LEN ps_b$
  $(xbuff%+9)=ps_b$
ENDPROC

DEF PROCps_11
  REM print footnote number
  LOCAL ps_b$,ps_i%
  REM VDU: PROCftracef("PROCps_11")
  PROCps_10: REM stores its value in xbuff%+9
  ps_b$=$(xbuff%+9)+") SS "
  PROCps_10: ps_b$+=$(xbuff%+9)+") SS "+STR$((tpub%!CONST_tpub_style_bits OR 1<<4)AND &7F)+" ("
  REM                                                        turn on superscript ^
  ps_b$+=FNps_trans(RIGHT$("  "+STR$ tpub%!CONST_tpub_footnote_num,3))
  tpub%!CONST_tpub_cpos-=3
  ps_b$+=") SS "
  PROCps_8: REM stores its value in xbuff%+9
  ps_b$+=$(xbuff%+9)+CHR$92                   /* was: ps_b$+=$(xbuff%+9)+"\"   AMcC: 20-Sep-92 */
  xbuff%?8=LEN ps_b$
  $(xbuff%+9)=ps_b$
ENDPROC

DEF PROCps_12
  REM string translation
  LOCAL ps_b$
  REM VDU: PROCftracef("PROCps_12")
  ps_b$=FNps_trans($(xbuff%+8))
  xbuff%?8=LEN ps_b$
  $(xbuff%+9)=ps_b$
ENDPROC

DEF PROCps_13
  REM handle font change
  LOCAL font_new%,ps_b$,ps_i%
  REM VDU: PROCftracef("PROCps_13")
  font_new%=xbuff%!8
  ps_i%=tprv%!CONST_tprv_ps_xl
  ps_i%+=INT((tprv%!CONST_tprv_ps_cw-tprv%!CONST_tprv_ps_xl-tprv%!CONST_tprv_ps_right_print)*FNps_fontsize(font_new%)/FNps_fontsize(0))
  tpub%!CONST_tpub_xc=ps_i%
  tpub%!CONST_tpub_font_num=font_new%
  IF tpub%!CONST_tpub_left_new<tpub%!CONST_tpub_xc-tprv%!CONST_tprv_ps_xl THEN
   tprv%!CONST_tprv_ps_left_ruler=tpub%!CONST_tpub_left_new
  ELSE
   tprv%!CONST_tprv_ps_left_ruler=0
  ENDIF
  IF tpub%!CONST_tpub_right_new<tpub%!CONST_tpub_xc-tprv%!CONST_tprv_ps_xl AND tpub%!CONST_tpub_right_new>tprv%!CONST_tprv_ps_left_ruler THEN
   tpub%!CONST_tpub_xc=tprv%!CONST_tprv_ps_xl+tpub%!CONST_tpub_right_new
  ENDIF
  ps_b$=STR$ FNps_fontsize(font_new%)+" FS"
  xbuff%?8=LEN ps_b$
  $(xbuff%+9)=ps_b$
ENDPROC

DEF PROCps_14
  REM finish page
  REM VDU: PROCftracef("PROCps_14")
  BPUT#xbuff%!8,"EndPage"
ENDPROC

DEF PROCps_15
  REM finish job
  LOCAL ps_c%,cnct%,ps_ptr%,ps_ext%,ps_data%,ps_p%,B%,C%
  REM VDU: PROCftracef("PROCps_15")
  ps_c%=xbuff%!8
  IF queu%!CONST_queu_type<>&FF5 THEN
   REM get the list of fonts ...
   REM (needs to be done before we end the job)
   SYS"PDriver_SelectJob",ps_c% TO ps_ext%
   SYS"PDriver_MiscOp",2,0,0,0,0 TO ,,C%
   IF C%<>0 THEN
    B%=CONST_ident_XXXX: ps_data%=USR(code_entry%+CONST_entry_heap_claim)
    IFps_data%=0 ERROR CONST_error_fatal, FNmsg_0(FNps_host_desc,"FA5")
    SYS"PDriver_MiscOp",2,ps_data%,C%,0,0
   ENDIF
   SYS"PDriver_SelectJob",ps_ext%
/*
 *  REM we have to fudge this a little bit 'cos the printer driver wants
 *  REM to put its bit out, but we need to replace it
 */
   ps_ptr%=PTR#ps_c%: ps_ext%=EXT#ps_c%
   SYS"PDriver_EndJob",ps_c%
   EXT#ps_c%=ps_ext%: PTR#ps_c%=ps_ptr%
   BPUT#ps_c%,"%%Trailer"
   BPUT#ps_c%,"end"
   BPUT#ps_c%,"%%Pages: "+STR$ tpub%!CONST_tpub_page_num
   BPUT#ps_c%,"%%BoundingBox: "+FNprinter_read_string(tprv%!CONST_tprv_ps_bbox)
   IF C%<>0 THEN
    ps_ptr%=PTR#ps_c%: ps_ext%=EXT#ps_c%: BPUT#ps_c%,"%%DocumentFonts: ";
    ps_p%=ps_data%
    REPEAT
     IF ps_p%!8=40 OR ps_p%!8=41 THEN
      B%=!ps_p%
      WHILE ?B%: BPUT#ps_c%,?B%: B%+=1: ENDWHILE: BPUT#ps_c%,10
      ps_ptr%=PTR#ps_c%: ps_ext%=EXT#ps_c%: BPUT#ps_c%,"%%+ ";
     ENDIF
     ps_p%+=12
    UNTIL(ps_p%-ps_data%)>=C%
    EXT#ps_c%=ps_ext%: PTR#ps_c%=ps_ptr%
    ps_ptr%=PTR#ps_c%: ps_ext%=EXT#ps_c%: BPUT#ps_c%,"%%DocumentSuppliedFonts: ";
    ps_p%=ps_data%
    REPEAT
      IF ps_p%!8=41 THEN
        B%=!ps_p%
        WHILE ?B%: BPUT#ps_c%,?B%: B%+=1: ENDWHILE: BPUT#ps_c%,10
        ps_ptr%=PTR#ps_c%: ps_ext%=EXT#ps_c%: BPUT#ps_c%,"%%+ ";
      ENDIF
      ps_p%+=12
    UNTIL ps_p%-ps_data%>=C%
    EXT#ps_c%=ps_ext%: PTR#ps_c%=ps_ptr%
    B%=CONST_ident_XXXX: C%=ps_data%: CALL code_entry%+CONST_entry_heap_free
   ENDIF
  ENDIF
  cnct%=prnt%!CONST_prnt_cnct
  IF cnct%!CONST_cnct_type=1 OR cnct%!CONST_cnct_type=2 BPUT#ps_c%,4
ENDPROC

DEF PROCps_16
  REM process a tab character
  LOCAL ps_b$
  REM VDU: PROCftracef("PROCps_16")
  ps_b$=STRING$(8-((tpub%!CONST_tpub_cpos-tprv%!CONST_tprv_ps_left_print-tprv%!CONST_tprv_ps_left_ruler+1-6*tpub%!CONST_tpub_number_print)MOD8)," ")
  tpub%!CONST_tpub_cpos+=LEN ps_b$
  xbuff%?8=LEN ps_b$
  $(xbuff%+9)=ps_b$
ENDPROC

DEF PROCps_17
  REM no formfeed text ...
  REM VDU: PROCftracef("PROCps_17")
  xbuff%?8=0
ENDPROC

DEF PROCps_18
  REM change layout
  LOCAL layout_height%,layout_top%,layout_bottom%
  REM VDU: PROCftracef("PROCps_18")
  layout_height%=xbuff%!8
  layout_top%=xbuff%!12
  layout_bottom%=xbuff%!16
  IF layout_height%-layout_top%-layout_bottom%>3 AND layout_height%<=tprv%!CONST_tprv_ps_ph THEN
   tpub%!CONST_tpub_line_max=layout_height%-layout_bottom%
   tprv%!CONST_tprv_ps_mt=layout_top%
  ENDIF
  xbuff%?8=0
ENDPROC

DEF PROCps_19
  REM start new page
  REM VDU: PROCftracef("PROCps_19")
  tpub%!CONST_tpub_line_page=tprv%!CONST_tprv_ps_mt
  xbuff%?8=0
ENDPROC

DEF PROCps_20
  REM prepend any code for a native (ie PostScript) file
  LOCAL ps_c%, ps_d%, ps_i%, ps_p%, ps_q%
  REM VDU: PROCftracef("PROCps_20")
  ps_c%=xbuff%!8
  ps_d%=xbuff%!12
  IF cnfg%!CONST_cnfg_ps_feed <>0 THEN
    ps_i%=OPENIN(FNprinter_read_string(cnfg%!CONST_cnfg_ps_feed))
    IFps_i%<>0 THEN
      REM copy %!PS-Adobe line
      PROCps_copy_line(ps_d%, ps_c%)
      REM now copy all of the %% lines
      REPEAT
        ps_p%=BGET#ps_d%:ps_q%=BGET#ps_d%:PTR#ps_d%=PTR#ps_d%-2
        IFps_p%=ASC"%" AND ps_q%=ASC"%" PROCps_copy_line(ps_d%, ps_c%)
      UNTIL ps_p%<>ASC"%" OR ps_q%<>ASC"%"
      REM now copy the feed code
      WHILE NOT EOF#ps_i%:BPUT#ps_c%,BGET#ps_i%:ENDWHILE
      CLOSE#ps_i%
    ENDIF
  ENDIF
ENDPROC

DEF PROCps_copy_line(from%, to%)
  LOCAL ps_c%
  REPEAT
    ps_c%=BGET#from%
    BPUT#to%, ps_c%
  UNTIL ps_c%=10 OR ps_c%=13
  REPEAT
    ps_c%=BGET#from%
    IFps_c%=10 OR ps_c%=13 BPUT#to%,ps_c% ELSE PTR#from%=PTR#from%-1
  UNTIL ps_c%<>10 AND ps_c%<>13
ENDPROC

DEF FNps_fontsize(num%)
  REM provide notional cpi sizes
  REM VDU: PROCftracef("FNps_fontsize")
  CASE num% OF
  WHEN 0: =10: REM pica
  WHEN 1: =12: REM elite
  WHEN 2: =17: REM condensed
  WHEN 3: = 6: REM expanded
  ENDCASE
=0

DEF FNps_trans(ps_s$)
  LOCAL ps_i%,byte%,out$,str$
  REM VDU: PROCftracef("FNps_trans")
  IF ps_s$="" THEN =""
  FOR ps_i%=1 TO LEN ps_s$
    byte%=ASC MID$(ps_s$,ps_i%,1)
    str$=""
    CASE TRUE OF
      WHEN byte%<32 OR byte%=127
        IF tpub%!CONST_tpub_cc_print=1 THEN str$=FNps_display(byte%)
      WHEN byte%>127 AND tpub%!CONST_tpub_cc_print<>0
        IF tpub%!CONST_tpub_cc_print=1 THEN str$=FNps_display(byte%)
      WHEN tpub%!CONST_tpub_cc_print<>0
        str$=CHR$ byte%
        tpub%!CONST_tpub_cpos+=1
      OTHERWISE
        tpub%!CONST_tpub_cpos+=1
        IF byte%>127 THEN
          str$=FNps_oct(byte%)
        ELSE
          CASE byte% OF
            WHEN ASC"(": str$="\("
            WHEN ASC")": str$="\)"
            WHEN     92: str$="\\"                /* was: WHEN ASC"\": str$="\\"   AMcC: 20-Sep-94 */
            OTHERWISE: str$=CHR$ byte%
          ENDCASE
        ENDIF
    ENDCASE
    out$+=str$
  NEXT
=out$

DEF FNps_display(byte%)
  LOCAL buf$
  REM VDU: PROCftracef("FNps_display")
  tpub%!CONST_tpub_cpos+=4
  buf$=") SS "+STR$((tpub%!CONST_tpub_style_bits AND &7F)OR 1)+" ("
  REM                                          bold_bit ^
  buf$+="["+RIGHT$("0"+STR$~byte%,2)+"]"
  buf$+=") SS "+STR$(tpub%!CONST_tpub_style_bits AND &7F)+" ("
=buf$

DEF FNps_oct(byte%)
  REM VDU: PROCftracef("FNps_oct")
=CHR$92+CHR$((byte%>>6 AND 7)+48)+CHR$((byte%>>3 AND 7)+48)+CHR$((byte% AND 7)+48) /* CHR$92: was "\"  AMcC: 20-Sep-94 */

DEF PROCps_ensure_dir

  LOCAL f%

  SYS "XOS_File", 8, "PrinterChoices:ps" TO ; f%
  SYS "XOS_File", 8, "PrinterChoices:ps.Printers" TO ; f%

ENDPROC

DEF FNps_host_desc
LOCAL a%
a%=buff%!24
=a%!CONST_interface_host_desc
