home *** CD-ROM | disk | FTP | other *** search
/ Multimedia & CD-ROM 3 / mmcd03-jun1995-cd.iso / utils / various / utils-1 / lzselect.bas < prev    next >
BASIC Source File  |  1991-06-24  |  67KB  |  1,592 lines
  1. '============================================================================
  2. '   LZSelect 1.0 (C) 1991 Ziff Communications Co. ■ PC Magazine ■ Jay Munro
  3. '   Utility to write PMF files Setup utility (May 30 1989)
  4. '============================================================================
  5. DEFINT A-Z   'All variables are Integers unless noted otherwise
  6.  
  7. ' -------- BASIC Subroutines
  8. DECLARE SUB BarMenu (Item$())                'Menu for selections
  9. DECLARE SUB ClrSc (Ulr, Ulc, Lrr, Lrc, Colr) 'Clear screen
  10. DECLARE SUB CopyFont (FontName$, ID$, TP)    'Copies soft font to printer
  11. DECLARE SUB DeleteInst ()                    'Deletes element from PV array
  12. DECLARE SUB Editor (Text$, LeftCol, RightCol, NumOnly, CapsOn, KeyCode) 'Text editor
  13. DECLARE SUB GetText (Text$, NumDig, NumOnly, CapsOnly) 'Text input routine
  14. DECLARE SUB GetFileName (Filename$, Prompt$) 'Gets Filename of PMF file
  15. DECLARE SUB GetNextItem ()                   'Gets Menu item names
  16. DECLARE SUB HelpScreen ()                    'Help messages
  17. DECLARE SUB InsertInst (Choice)              'Inserts elements into PV array
  18. DECLARE SUB MenuData ()                      'Menu and ESCcode data
  19. DECLARE SUB PrintEsc (Escape$)               'Prints Esc codes on screen
  20. DECLARE SUB PromptInp (Code$)                'Prompts for user input on ESC codes
  21. DECLARE SUB PromptLine (Message$, Flash)     'Standard prompt lines
  22. DECLARE SUB SaveFile ()                      'PMF save routine
  23. DECLARE SUB ScrollMenu (Item$(), AFlag, Choice) 'Printer item array
  24. DECLARE SUB SetColors ()                     'Menu color routine
  25. DECLARE SUB TestPrint (Flag)                 'Prints current line to printer
  26. DECLARE SUB WaitTwo (Msg$)                   'Beeps, prints MSG and waits 2 sec
  27.  
  28. ' -------- BASIC Functions
  29. DECLARE FUNCTION AddCode$ (OldCode$, NewCode$)  'Adds newcode to string
  30. DECLARE FUNCTION BuildLine$ ()                  'Builds complete code string
  31. DECLARE FUNCTION GetDigit$ (X$, X)              'Returns user input
  32. DECLARE FUNCTION OneKey% ()                     'Integer inkey routine
  33. DECLARE FUNCTION YesNo% ()                      'Yes or No replies
  34.  
  35. ' -------- Assembler Subroutines
  36. DECLARE SUB QPrint (Text$, Colr)               'QuickPrint routine
  37. DECLARE SUB MovBytes (BYVAL Segment1, BYVAL Address1, BYVAL Segment2, BYVAL Address2, BYVAL NumEls)
  38.  
  39. 'These two functions are QB4 work-alikes for BASIC 7 keywords
  40. '   and should not be included if compiled with BASIC 7.X
  41. DECLARE FUNCTION Dir$ (Filename$)               'Checks if file exists
  42. DECLARE FUNCTION CurDir$ ()                     'Returns current directory
  43.  
  44. TYPE RegTypeX                           ' Define the type needed for INTERUPTX
  45.   AX    AS INTEGER
  46.   BX    AS INTEGER
  47.   CX    AS INTEGER
  48.   DX    AS INTEGER
  49.   BP    AS INTEGER                      'un-usable in call interrupt
  50.   SI    AS INTEGER
  51.   DI    AS INTEGER
  52.   Flags AS INTEGER
  53.   DS    AS INTEGER
  54.   ES    AS INTEGER
  55. END TYPE
  56. DECLARE SUB INTERRUPTX (IntNum AS INTEGER, InReg AS RegTypeX, OutReg AS RegTypeX)
  57.  
  58. TYPE CArray                             'Control array for menus
  59.   CH AS INTEGER                         '   choice
  60.   Ky AS INTEGER                         '   key pressed in menu
  61.   No AS INTEGER                         '   combined normal color
  62.   Ho AS INTEGER                         '   combined highlight color
  63.   Hl AS INTEGER                         '   combined color for help screen
  64.   CM AS INTEGER                         '   current menu number
  65. END TYPE
  66.  
  67. TYPE PMFArray                           'PMF control array
  68.   CN AS INTEGER                         '   current PMF menu item
  69.   Combine AS INTEGER                    '   flag to Combine like codes
  70.   EscLen AS INTEGER                     '   length of current ESC string
  71.   LastSaved AS INTEGER                  '   flag for last time file was saved
  72.   MI AS INTEGER                         '   maximum instructions
  73.   CI AS INTEGER                         '   current instructions
  74.   Port AS INTEGER                       '   printer port
  75. END TYPE
  76.  
  77. TYPE Value                              'Instruction value array
  78.   MnuNum AS INTEGER                     '   menu number
  79.   MnuChc AS INTEGER                     '   menu choice
  80. END TYPE
  81.  
  82. ' -------- Use BASIC's error checking
  83. ON ERROR GOTO ErrorDept                 'Point to error routines
  84.  
  85. ' -------- Dimension arrays
  86. X = 13                                 'Up to 13 menus
  87. DIM SHARED InReg AS RegTypeX, OutReg AS RegTypeX, Filename$, esc$, QT$
  88. DIM SHARED MC AS CArray, PMF AS PMFArray, Menu$(X, X), EscCode$(X, X)
  89. DIM SHARED MenuTitle$, MaxedOut$, ExistPrompt$
  90. PMF.MI = 100                            'Maximum instruction number
  91. esc$ = "27"                             'ESC character in Setup
  92. MaxedOut$ = "Maximum instructions reached"  'multiple use strings
  93. ExistPrompt$ = " exists, overwrite ? Y/N "
  94. QT$ = CHR$(34)                          '"quote" character
  95. PMF.Combine = 0                         'Combine codes off -- default
  96. PMF.Port = INSTR(COMMAND$, "/2") + 1    'Set printer port to LPT1 or LPT2
  97. REDIM SHARED PMFI$(PMF.MI, 2)           'PMF item array
  98. REDIM SHARED PV(PMF.MI) AS Value        'Instruction value array
  99. REDIM SHARED Title$(PMF.MI)             'Instruction menu item names
  100. REDIM SHARED UsrText$(PMF.MI)           'User text input
  101.  
  102. '============================================================================
  103. '                            Main program
  104. '============================================================================
  105.  
  106.   WIDTH LPRINT 255                      'Keep QB from interfering with printing
  107.   CALL SetColors                        'Check monitor type and set colors
  108.  
  109. ' -------- Clear and build main screen
  110.   CLS
  111.   IF INSTR(COMMAND$, "/?") THEN
  112.      QPrint "LZSelect 1.0  (C) 1991 Ziff Communications Co.  ■  PC Magazine  ■  Jay Munro  ", 7
  113.      LOCATE 3, 1, 0
  114.      QPrint "Command line syntax:", 7
  115.      LOCATE 4, 1
  116.      QPrint "LZSELECT [/F filename],[/2], [/B], [?]", 7
  117.      LOCATE 6, 1
  118.      QPrint "/F filename - specify SETUP file to write to", 7
  119.      LOCATE 7, 1
  120.      QPrint "/2 - specify LPT2 for printer testing", 7
  121.      LOCATE 8, 1
  122.      QPrint "/B - force monochrome colors ", 7
  123.      LOCATE 9, 1
  124.      QPrint "/? - this help message ", 7
  125.      LOCATE 11, 1
  126.      QPrint "Press a key to continue, ESC to end ", 7
  127.      DO
  128.        X = OneKey%
  129.      LOOP UNTIL X
  130.      IF X = 27 THEN GOTO ExitHere
  131.   END IF
  132.  
  133.   CALL ClrSc(1, 1, 25, 80, MC.Ho)
  134.   LOCATE 1, 1, 0
  135.   QPrint "  LZSelect 1.0  (C) 1991 Ziff Communications Co.  ■  PC Magazine  ■  Jay Munro  ", MC.Ho
  136.   LOCATE 24, 1, 0                       'Print items
  137.   QPrint " F1 - Help  F2 - Next Set   F3 - Test Print  F4 - Download Font   F6 - Mode > I ", MC.Ho
  138.   LOCATE 25, 1, 0
  139.   QPrint " F7 - Delete Line  F8 - Insert line  F10 - Save to SETUP   Line length -        ", MC.Ho
  140.   CALL ClrSc(2, 2, 23, 79, MC.No)
  141.   FOR X = 2 TO 17                       'Create vertical line
  142.     LOCATE X, 40
  143.     QPrint CHR$(222), MC.Ho
  144.   NEXT X
  145.  
  146.   LOCATE 19, 2, 0                       'Build input area
  147.     QPrint STRING$(78, 223), MC.Ho
  148.   LOCATE 17, 2, 0
  149.     QPrint STRING$(78, 220), MC.Ho
  150.  
  151. ' -------- Initialize some variables and check command line for file name
  152.   CALL MenuData                         'Load menu choices and Esc codes
  153.   PMF.CI = 1                            'Initialize current instruction = 1
  154.   PMF.CN = 0                            'Set current menu line item
  155.   X = INSTR(COMMAND$, "/F")             'Did they specify a file ?
  156.   IF X THEN                             '  yes, then parse out the name
  157.     X = X + 2                           '  compensate for /F
  158.     Temp$ = LTRIM$(MID$(COMMAND$, X))   '  make a copy to work with
  159.     Z = INSTR(Temp$, " ")               '  search for a trailing space
  160.     IF Z THEN                           'If there is a /F then
  161.       Filename$ = MID$(Temp$, 1, Z)     '  extract the file name
  162.     ELSE                                '  if not, then
  163.       Filename$ = Temp$                 '  the whole thing is the name
  164.     END IF
  165.   END IF
  166.   DO
  167.     CALL GetNextItem                      'Ask for line item name
  168.     IF MC.Ky = 27 THEN
  169.       PromptLine "Menu text line required -- please re-enter or press ESC to quit", 0
  170.       DO
  171.         X = OneKey
  172.       LOOP UNTIL X
  173.       IF X = 27 THEN GOTO ExitHere
  174.     ELSE
  175.       EXIT DO
  176.     END IF
  177.   LOOP
  178.   LastChoice = 1                        'Start main menu at 1
  179.  
  180. ' -------- Main menu input area
  181. MainMenu:                               'Label for error return
  182. DO
  183.   MC.CM = 0                             'Menu 0 = main menu
  184.   MC.CH = LastChoice                    'Initialize first choice
  185. DO
  186.   CALL BarMenu(Menu$())                 'Display Menu
  187.   SELECT CASE MC.Ky                     'Key press
  188.  
  189. ' -------- Item selected with RETURN
  190.     CASE 13                             'Return -
  191.       IF MC.CM = 0 THEN                 'If main menu then call others
  192.         MC.CM = MC.CH                   ' assign current menu to choice
  193.         LastChoice = MC.CH              ' remember where it was
  194.         MC.CH = 1                       ' set choice to 1
  195.       ELSE
  196.         IF PMF.CI <= PMF.MI THEN        'If current instrucion is < max items
  197.           PV(PMF.CI).MnuNum = MC.CM     'Assign current instructions
  198.           PV(PMF.CI).MnuChc = MC.CH     '  to PV array
  199.           CALL PromptInp(EscCode$(PV(PMF.CI).MnuNum, PV(PMF.CI).MnuChc))
  200.           IF MC.Ky <> 27 THEN           'Build ESC code
  201.             Temp$ = BuildLine$
  202.             IF LEN(Temp$) < 255 THEN
  203.               PMFI$(PMF.CN, 1) = Temp$  'Assign Esc code to current line
  204.               CALL PrintEsc(PMFI$(PMF.CN, 1)) 'print it
  205.               PMF.LastSaved = -1         'Change flag
  206.             ELSE
  207.               CALL WaitTwo(MaxedOut$)    'If Len(temp$) > 255 signal user
  208.               PMF.CI = PMF.CI - 1        'Roll back counter that Buildline bumped
  209.               PV(PMF.CI).MnuNum = 0      'Reset PV() array elements
  210.               PV(PMF.CI).MnuChc = 0
  211.               UsrText$(PMF.CI) = ""      'Clear title and user text items
  212.               Title$(PMF.CI) = ""
  213.               CALL ScrollMenu(Title$(), -1, Choice) 'Redisplay items less offending item
  214.             END IF
  215.           END IF
  216.         ELSE
  217.           CALL WaitTwo(MaxedOut$)        'Too many instructions
  218.         END IF
  219.       END IF
  220.   
  221. ' -------- Escape or ALT Q  -  return to main menu or quit
  222.     CASE 27, -16
  223.       EXIT DO
  224.  
  225. ' -------- F1 - display help screen
  226.     CASE -59
  227.       CALL HelpScreen
  228.  
  229. ' -------- ALT F1 - Change Colors
  230.    
  231.     CASE -59
  232.       
  233.  
  234.  
  235. ' -------- F2 - save current item and prompt for new one
  236.     CASE -60
  237.       PMFI$(PMF.CN, 1) = BuildLine$     ' build escape codes
  238.       CALL PrintEsc(PMFI$(PMF.CN, 1))   ' print escape codes
  239.       CALL GetNextItem                  ' get next instruction line
  240.       IF MC.Ky <> 27 THEN               ' if valid line entered, then
  241.         GOSUB ClearVars                 ' clear current work variables
  242.       END IF
  243.       EXIT DO                           ' return to main menu
  244.    
  245. ' -------- F3 - test print of current set of items
  246.     CASE -61
  247.       CALL TestPrint(0)                 ' print to printer
  248.  
  249. ' -------- F4, ALT F4 - Download font
  250.     CASE -62, -107
  251.       IF MC.Ky = -62 THEN TP = -1 ELSE TP = 0   'Temporary/permanent flag
  252.       CALL GetFileName(FontFile$, "Font File ?")'Prompt for name
  253.       IF MC.Ky <> 27 THEN                       ' continue if <> ESC
  254.         IF LEN(Dir$(FontFile$)) THEN            ' does it exist?
  255.           CALL PromptLine("Enter ID number ", 0)' yes, get an ID #
  256.           ID$ = ""
  257.           CALL GetText(ID$, 5, 1, 0)            ' call text routine
  258.           IF MC.Ky <> 27 THEN                   ' continue if <> ESC
  259.             CALL PromptLine("Copying font file ", -1)  ' signal what's happening
  260.             CALL CopyFont(FontFile$, ID$, TP)          ' copy the file
  261.           END IF
  262.         ELSE
  263.           CALL WaitTwo("Font file not found")        ' file not there
  264.         END IF
  265.       END IF
  266.       CALL ClrSc(18, 2, 18, 78, MC.No)
  267.   
  268. ' -------- F5 - view all Setup menu items (sorry no editing)
  269.     CASE -63
  270.       REDIM Temp$(PMF.CN)               ' clear temp array
  271.       FOR X = 1 TO PMF.CN               ' assign elements
  272.         Temp$(X) = PMFI$(X, 0)          ' for scrollmenu
  273.       NEXT X
  274.       CALL ScrollMenu(Temp$(), 0, Choice)      'Call scroll menu- ignore choice
  275.       CALL ScrollMenu(Title$(), -1, Choice)    'Refresh instructions
  276.   
  277. ' -------- F6 - toggle individual/combined escape code format
  278.     CASE -64
  279.       LOCATE 24, 79                     '  and locate the cursor
  280.       IF PMF.Combine THEN               '  Check current status and
  281.         QPrint "I", MC.Ho               '  print opposite
  282.       ELSE
  283.         QPrint "C", MC.Ho
  284.       END IF
  285.       PMF.Combine = ABS(PMF.Combine = -1) - 1 'Toggle the code
  286.       PMFI$(PMF.CN, 1) = BuildLine$     'Assign Esc code to current line
  287.       CALL PrintEsc(PMFI$(PMF.CN, 1))   'Print it
  288.    
  289. ' -------- F7 - delete menu item line
  290.     CASE -65
  291.       CALL DeleteInst                   'Delete current instruction
  292.       IF MC.Ky <> 27 THEN               'continue unless <ESC> pressed
  293.         PMFI$(PMF.CN, 1) = BuildLine$   'Assign Esc code to current line
  294.         CALL PrintEsc(PMFI$(PMF.CN, 1)) ' and print it
  295.       END IF
  296.  
  297. ' -------- Ctrl F7 - delete all menu items
  298.     CASE -100                           'Ctrl F7
  299.       CALL PromptLine("Are you sure you want to delete everything", -1)
  300.       IF YesNo THEN
  301.         PMF.CN = 0                      'Set current menu line item
  302.         GOSUB ClearAllVars              'Clear all arrays
  303.         CALL PrintEsc(PMFI$(PMF.CN, 1)) ' and print it
  304.         CALL ScrollMenu(Title$(), 0, Choice)
  305.         CALL GetNextItem                'Ask for line item name
  306.       END IF
  307.       CALL ClrSc(18, 2, 18, 78, MC.No)
  308.   
  309. ' -------- ALT F7 - delete current set of menu commands
  310.     CASE -110                           'Alt F7
  311.       CALL PromptLine("Are you sure you want to delete this set of commands", -1)
  312.       IF YesNo THEN
  313.         GOSUB ClearVars
  314.         PMFI$(PMF.CN, 0) = ""           'Clear current PMFI item
  315.         PMFI$(PMF.CN, 1) = ""
  316.         CALL PrintEsc(PMFI$(PMF.CN, 1))   ' and print it
  317.         CALL ScrollMenu(Title$(), -1, Choice)
  318.       END IF
  319.       CALL ClrSc(18, 2, 18, 78, MC.No)
  320.     
  321. ' -------- F8 - insert menu item line
  322.      CASE -66
  323.       IF MC.CM > 0 THEN                 'Insert only on sub menus
  324.         DO
  325.           IF LEN(EscCode$(MC.CM, MC.CH)) + PMF.EscLen + ABS((PMF.Combine + 1) * 9) < 255 THEN
  326.             TCI = PMF.CI                'Save current instruction
  327.             CALL InsertInst(Choice)
  328.             IF MC.Ky = 27 THEN EXIT DO
  329.             PV(Choice).MnuNum = MC.CM   'Assign current instructions
  330.             PV(Choice).MnuChc = MC.CH   ' to PV array
  331.             PMF.CI = Choice             'Point at choice
  332.             CALL PromptInp(EscCode$(PV(PMF.CI).MnuNum, PV(PMF.CI).MnuChc))
  333.             PMF.CI = TCI                'retrieve temp PMF.CI
  334.             IF MC.Ky <> 27 THEN
  335.               PMFI$(PMF.CN, 1) = BuildLine$   'Assign Esc code to current line
  336.               CALL PrintEsc(PMFI$(PMF.CN, 1)) ' print it to the screen
  337.               PMF.CI = PMF.CI + 1             ' increment current instruction
  338.             END IF
  339.           END IF
  340.           EXIT DO
  341.         LOOP
  342.       END IF
  343.    
  344. ' -------- F9 - print escape sequences to file
  345.     CASE -67
  346.       CALL TestPrint(-1)                ' print to file
  347.    
  348. ' -------- F10 - save Setup file
  349.     CASE -68
  350.       CALL SaveFile
  351.       EXIT DO
  352.   
  353. ' -------- ALT F10 - save Setup file with new name
  354.     CASE -113                           'ALT F10 - save file w/new name
  355.       Filename$ = ""
  356.       CALL SaveFile
  357.       EXIT DO
  358.   
  359. ' -------- Right Arrow - changes focus to scroll menu
  360.     CASE -77
  361.       CALL ScrollMenu(Title$(), 0, Choice)
  362.    
  363.     CASE ELSE
  364.   END SELECT
  365. LOOP
  366.   IF MC.Ky = -16 THEN EXIT DO           'ALT Q - leave now
  367. LOOP
  368.  
  369. ' -------- Check if file has been saved recently
  370. IF PMF.CI > 1 AND PMF.LastSaved THEN    'If current file hasn't been
  371.   CALL PromptLine("Do you want to save changes? Y/N", -1) ' saved, then
  372.   DO                                                      ' prompt for it
  373.     X = OneKey
  374.   LOOP UNTIL X
  375.   IF X = 89 OR X = 121 THEN CALL SaveFile     '<Y> or <y>es
  376.   IF X = 27 THEN                              ' Esc returns to main menu
  377.     CALL ClrSc(18, 2, 18, 78, MC.No)          'Clear message first
  378.     GOTO MainMenu                             '  and return to menu
  379.   END IF
  380. END IF
  381.  
  382. ' -------- Exit
  383. ExitHere:
  384.   CLS                                   'Clean up at the end
  385. END                                     'End of program
  386.  
  387. ' -------- Routine to clear work variables
  388. ClearAllVars:
  389.   REDIM SHARED PMFI$(PMF.MI, 2)         'PMF item array
  390.  
  391. ClearVars:
  392.   REDIM SHARED Title$(PMF.MI)           'Instruction menu item names
  393.   REDIM SHARED PV(PMF.MI) AS Value      'Instruction value array
  394.   REDIM SHARED UsrText$(PMF.MI)         'User text input
  395.   PMF.CI = 1                            'Initialize current instruction = 1
  396.   PMF.EscLen = 0                        'Clear escape seq length
  397.   RETURN
  398.  
  399. ' -------- Error trapping and messages
  400. ErrorDept:
  401.   SELECT CASE ERR
  402.     CASE 63
  403.       ErMsg$ = "File not found"
  404.       Filename$ = ""
  405.       PMF.LastSaved = -1         'Change flag
  406.     CASE 64
  407.       ErMsg$ = "Bad file name"
  408.       Filename$ = ""
  409.       PMF.LastSaved = -1         'Change flag
  410.     CASE 70
  411.       ErMsg$ = "Permission denied"
  412.       PMF.LastSaved = -1         'Change flag
  413.     CASE 71
  414.       ErMsg$ = "Drive not ready"
  415.       PMF.LastSaved = -1         'Change flag
  416.     CASE 75
  417.       ErMsg$ = "Path/file access error"
  418.       Filename$ = ""
  419.       PMF.LastSaved = -1         'Change flag
  420.     CASE 5
  421.       ErMsg$ = "Illegal function call"
  422.     CASE 24
  423.       ErMsg$ = "Printer not responding"
  424.     CASE 25
  425.       ErMsg$ = "Printer not ready"
  426.     CASE 27
  427.       ErMsg$ = "Printer out of paper"
  428.     CASE ELSE
  429.       ErMsg$ = "Error " + STR$(ERR)
  430.   END SELECT
  431.   CLOSE
  432.   CALL WaitTwo(ErMsg$)
  433.   RESUME MainMenu
  434.  
  435. FUNCTION AddCode$ (OldCode$, NewCode$)
  436. ' -------- Checks for like ESC codes and adds new code to existing string
  437. IF LEN(NewCode$) THEN                   'Is NewCode valid?
  438.   IF LEN(OldCode$) THEN                 ' yes, then do we have an old code?
  439.  
  440. ' -------- Text input
  441.     IF LEFT$(NewCode$, 1) = "√" THEN
  442.       AddCode$ = OldCode$ + "," + QT$ + MID$(NewCode$, 2) + QT$
  443.     ELSE
  444.       SELECT CASE NewCode$              'Check for special characters
  445. ' -------- Control character - no compression
  446.         CASE "12", "13", "10"
  447.           AddCode$ = OldCode$ + "," + NewCode$
  448.  
  449. ' -------- Combine commands
  450.         CASE ELSE
  451.           Search$ = LEFT$(NewCode$, 2)  'Get Group and Parameterize characters
  452.           X = INSTR(OldCode$, Search$)  'Have we had a similar command before
  453.           IF X AND PMF.Combine THEN     'Yes, insert new one
  454.             CodeOnly$ = MID$(NewCode$, 3)     'Extract parameters and terminator only
  455.             Y = INSTR(X, OldCode$, CHR$(34))  'Find next Quote
  456.             Temp$ = LEFT$(OldCode$, Y - 2) + LCASE$(MID$(OldCode$, Y - 1, 1))
  457.             AddCode$ = Temp$ + CodeOnly$ + MID$(OldCode$, Y) 'Too many concat's for QB
  458.           ELSE
  459.             AddCode$ = OldCode$ + "," + esc$ + "," + QT$ + NewCode$ + QT$
  460.           END IF
  461.       END SELECT
  462.     END IF
  463.   ELSE
  464.  
  465. ' -------- Text entry has the √ character as a marker
  466.     IF LEFT$(NewCode$, 1) = "√" THEN
  467.       AddCode$ = QT$ + MID$(NewCode$, 2) + QT$
  468.     ELSE
  469.       SELECT CASE NewCode$
  470.       
  471. ' --------- Control characters
  472.         CASE "10", "12", "13"
  473.           AddCode$ = NewCode$
  474.  
  475. ' --------- Just add the code verbatum
  476.         CASE ELSE
  477.           AddCode$ = esc$ + "," + QT$ + NewCode$ + QT$
  478.         END SELECT
  479.       END IF
  480.     END IF
  481. ELSE
  482. ' -------- No old codes, so just add it
  483.   AddCode$ = OldCode$
  484. END IF
  485.  
  486. END FUNCTION
  487.  
  488. SUB BarMenu (Item$()) STATIC
  489.  
  490. ' -------- Initialize variables
  491.   DO UNTIL MaxLen                       'Do this just once
  492.     Left = 7                            'Location of menu on screen
  493.     Top = 3
  494.     MaxLen = 24                         'Set maximum length
  495.   LOOP                                  'Maxlen is zero only once. . .
  496.   
  497.   TRow = CSRLIN                         'Save current row/col
  498.   TCol = POS(0)
  499.   
  500.   Max = UBOUND(Item$, 2)                'Find upper bound of array
  501.   DO UNTIL LEN(Item$(MC.CM, Max))       'Find actual end of array
  502.     Max = Max - 1
  503.     IF Max < 1 THEN EXIT SUB
  504.   LOOP
  505.   
  506.   LastChoice = MC.CH                    'Set temporary choice for erasing
  507.   CALL ClrSc(2, 4, 15, 35, MC.No)       'Clear the menu area
  508.  
  509. ' -------- Print menu title
  510.   LOCATE 2, 1 + Left + (MaxLen - LEN(Item$(MC.CM, 0))) \ 2
  511.   QPrint "* " + Item$(MC.CM, 0) + " *", MC.No
  512.  
  513. ' -------- Print items
  514.   FOR X = 1 TO Max                      'Print items
  515.     LOCATE Top + X, Left
  516.     QPrint Item$(MC.CM, X) + SPACE$(MaxLen - LEN(Item$(MC.CM, X))), MC.No
  517.   NEXT X
  518.   GOSUB Highlight                       'Highlight first item
  519.  
  520. ' -------- Wait for input and handle it
  521. DO
  522.   DO
  523.     MC.Ky = OneKey                      'Get a keystroke
  524.   LOOP UNTIL MC.Ky
  525.   SELECT CASE MC.Ky
  526.     CASE 13                             'Enter
  527.       IF MC.CM THEN                     ' if menu is not main then exit
  528.         EXIT SUB                        ' without clearing and with choice
  529.       ELSE                              ' else
  530.         EXIT DO                         ' clear screen and exit
  531.       END IF
  532.     CASE 27, -16                        'ESC, ALT Q
  533.       EXIT DO                           ' clear screen and exit
  534.     CASE -80                            'Down Arrow
  535.       MC.CH = MC.CH + 1                 ' increment choice
  536.       IF MC.CH > Max THEN MC.CH = 1     ' if over the top, then = 1
  537.     CASE -72                            'Up Arrow
  538.       MC.CH = MC.CH - 1                 ' decrement choice
  539.       IF MC.CH < 1 THEN MC.CH = Max     ' if < 1 then = max
  540.     CASE -71, -73                       'Home,PgUp
  541.       MC.CH = 1
  542.     CASE -79, -81                       'End,PgDn
  543.       MC.CH = Max
  544.     CASE IS < 0                         'Extended key
  545.       EXIT SUB
  546.     CASE ELSE
  547.   END SELECT
  548.   MC.Ky = 0
  549.   GOSUB Highlight                             'Highlight new selections
  550. LOOP
  551.   CALL ClrSc(Top - 1, Left, Top + Max, Left + MaxLen + 3, MC.No)
  552.   LOCATE TRow, TCol
  553. EXIT SUB
  554.  
  555. ' -------- Highlight by printing reverse color of item
  556. Highlight:
  557.   LOCATE Top + (LastChoice), Left       'Reprint old menu item with
  558.     QPrint Item$(MC.CM, LastChoice) + SPACE$(MaxLen - LEN(Item$(MC.CM, LastChoice))), MC.No
  559.   LOCATE Top + (MC.CH), Left            'Print new menu item with
  560.     QPrint Item$(MC.CM, MC.CH) + SPACE$(MaxLen - LEN(Item$(MC.CM, MC.CH))), MC.Ho
  561.   LastChoice = MC.CH                    'Reset last choice
  562. RETURN
  563.  
  564. END SUB
  565.  
  566. FUNCTION BuildLine$
  567.  
  568. ' -------- Build escape string for display or files
  569. ' -------- T is the top item number in the menu
  570.   T = PMF.CI + (PMF.CI > PMF.MI)        'subtract one if greater than max
  571.   FOR X = 1 TO T                        'Build Esc string
  572.     IF PV(X).MnuNum = 0 AND PV(X).MnuChc = 0 THEN
  573.     ELSE
  574.       Temp$ = EscCode$(PV(X).MnuNum, PV(X).MnuChc)
  575.       NewCode$ = GetDigit$(Temp$, X)
  576.       Code$ = AddCode$(Code$, NewCode$)
  577.       PMF.EscLen = LEN(Code$)
  578.     END IF
  579.   NEXT X
  580.  
  581. ' -- Alternate ASCII characters are used as place holders for some of
  582. '    the actual character so the combined ESC mode works correctly
  583.  
  584. ' -------- Replace reset character code
  585.     DO                                  'Loop to catch all occurences
  586.       X = INSTR(Code$, "≡")             'Special case for reset
  587.       IF X THEN MID$(Code$, X, 1) = "E" 'Replace with reset character
  588.    LOOP WHILE X
  589.  
  590. ' -------- Replace clear margin character
  591.    DO                                   'Loop to catch all occurences
  592.      X = INSTR(Code$, "±")              'Special case for clear margins
  593.      IF X THEN MID$(Code$, X, 1) = "9"  'Replace with '9' character
  594.    LOOP WHILE X
  595.    BuildLine$ = Code$                   'Assign function
  596. END FUNCTION
  597.  
  598. SUB ClrSc (Ulr, Ulc, Lrr, Lrc, Colr) STATIC
  599.  
  600. ' -------- Clears an area of a screen to a color
  601.    New$ = "&h" + HEX$(Colr) + "00"            'Fake shift left
  602.    IntNum = &H10                              'Interrupt 10h
  603.    InReg.AX = &H600                           'Service 6
  604.    InReg.BX = VAL(New$)                       'BH = color
  605.    InReg.CX = (Ulr - 1) * 256 + (Ulc - 1)     'CL = column, CH = row
  606.    InReg.DX = (Lrr - 1) * 256 + (Lrc - 1)     'DL = column, DH = row
  607.    CALL INTERRUPTX(IntNum, InReg, OutReg)     'Call interrupt 10h
  608.  
  609. END SUB
  610.  
  611. SUB CopyFont (FontName$, ID$, TP)
  612.  
  613. ' -------- Copies binary font file to printer and assign ID #
  614. EC$ = CHR$(27)                          'Setup an escape character
  615. DO
  616.   Printer$ = "LPT" + LTRIM$(STR$(PMF.Port)) 'Build a LPT string
  617.   OPEN Printer$ FOR BINARY AS #2         'Open printer as a file
  618.   OPEN FontName$ FOR BINARY AS #3        'Open the font file also
  619.   ID$ = LTRIM$(RTRIM$(ID$))              'Retrieve ID$
  620.   Prefont$ = EC$ + "*c" + ID$ + "D"      'Tell printer which font # to use
  621.   PUT 2, , Prefont$                      'Identify the font
  622.   BufLen% = 4096                         'Buffer size to use
  623.   Buffer$ = SPACE$(BufLen%)              'Set up copy buffer
  624.   FileLen& = LOF(3)                      'Get length of font file
  625.  
  626. ' -------- Get font data and copy to printer
  627. DO
  628.   IF FileLen& < BufLen% THEN Buffer$ = SPACE$(FileLen&)
  629.   GET 3, , Buffer$                     ' Get & Put through buffer
  630.   PUT 2, , Buffer$
  631.   FileLen& = FileLen& - LEN(Buffer$)   'Adjust amount of font left
  632. LOOP WHILE FileLen&                    'Keep going until end of file
  633.  
  634. ' -------- If the font is to be permanent, then set it
  635. IF TP THEN
  636.    PostFont$ = EC$ + "*c5F"            'Make font permanent
  637.    PUT 2, , PostFont$
  638.  END IF
  639.  CLOSE                                 'Close the files
  640.  EXIT DO
  641. LOOP
  642. END SUB
  643.  
  644. FUNCTION CurDir$
  645.  
  646. 'Important Note:                                
  647. 'QB 4, 4.5 & BASIC 6 use only -- BASIC 7 users delete this function
  648.  
  649.    DIM DTABuf AS STRING * 128           'create a DTA
  650.    InReg.AX = &H1900                    'Function 19h - get current disk
  651.    CALL INTERRUPTX(&H21, InReg, OutReg) 'current drive returns in AX
  652.    Drive$ = CHR$(65 + (OutReg.AX AND &HFF)) + ":"
  653.    InReg.AX = &H4700                     'Function 47h get current directory
  654.    InReg.DX = ASC(Drive$) - 64           'Drive number 0=A,1=B etc...
  655.    InReg.DS = VARSEG(DTABuf)             'Segment of buffer into DS
  656.    InReg.SI = VARPTR(DTABuf)             'Address of buffer into SI
  657.    CALL INTERRUPTX(&H21, InReg, OutReg)  'Make the call
  658.                                          'Find last valid character
  659.    FOR X = 64 TO 1 STEP -1               ' by looping and testing
  660.      IF MID$(DTABuf, X, 1) <> CHR$(0) THEN EXIT FOR
  661.    NEXT X
  662.  
  663.    IF X THEN                             'If other than root, assign it
  664.      CurDir$ = Drive$ + "\" + LEFT$(DTABuf, X) 'Assign the function
  665.    ELSE
  666.      CurDir$ = Drive$                    'Otherwise assign just the drive
  667.    END IF
  668. END FUNCTION
  669.  
  670. SUB DeleteInst
  671.  
  672. '--------- Deletes an instruction line
  673.   IF PMF.CI > 1 THEN                    'PMF.CI = 1 then nothing to delete
  674.     CALL PromptLine("Delete which line ? ", 1)
  675.     CALL ScrollMenu(Title$(), 0, Choice)'Get a choice from list
  676.     CALL ClrSc(18, 2, 18, 78, MC.No)    'Clear prompt line
  677.     IF Choice < 1 THEN EXIT SUB         'choice = 0
  678.     IF MC.Ky = 13 THEN                  'Enter
  679.       IF Choice < PMF.CI THEN
  680.         FOR X = Choice TO PMF.MI - 1    'Start at current Choice
  681.           SWAP PV(X), PV(X + 1)         'Move Choices down by one
  682.           SWAP Title$(X), Title$(X + 1)
  683.           SWAP UsrText$(X), UsrText$(X + 1)
  684.         NEXT X
  685.         Choice = X                      'Re-assign Choice to work below
  686.       ELSEIF Choice > PMF.CI THEN       'If deleted Choice is greater
  687.         EXIT SUB                        ' than number available, exit
  688.       END IF
  689.       PV(Choice).MnuNum = 0             'Top item get a zero
  690.       PV(Choice).MnuChc = PV(Choice).MnuNum 'so does menu choice
  691.       Title$(Choice) = ""               'Clear Title$
  692.       UsrText$(Choice) = ""             '  and UsrText$
  693.       PMF.CI = PMF.CI - 1               'fake out print routine
  694.       CALL ScrollMenu(Title$(), -1, Choice)
  695.     END IF
  696.   END IF
  697. END SUB
  698.  
  699. FUNCTION Dir$ (Filename$)
  700.   'This function is only for QB4.x, and Basic 6.x -- Delete for Basic 7.x
  701.   'Note, to trap critical errors like disk drive door open etc... with
  702.   'OnError, this program must be linked with fixed version of QB.LIB
  703.   'available as apnote # S12351 from Microsoft or on Compuserve
  704.   'Using the shipped version could cause lockups.
  705.  
  706.   DIM Buffer  AS STRING * 64            'Allocate a buffer
  707.   DIM TFile  AS STRING * 67             'Temp ASCII Z string for file
  708.   InReg.AX = &H1A00                     'Tell DOS about it (service 1A)
  709.   InReg.DS = VARSEG(Buffer)             'Set segment of Buffer
  710.   InReg.DX = VARPTR(Buffer)             'Set offset of Buffer
  711.   CALL INTERRUPTX(&H21, InReg, OutReg)  'Do it
  712.  
  713.   LSET TFile = LTRIM$(RTRIM$(Filename$)) 'Put filename into Z string
  714.   InReg.AX = &H4E00                      'Service 4E find first file
  715.   InReg.CX = 32                         'Find archive or regular files
  716.   InReg.DS = VARSEG(TFile)              'DS = segment of TFile
  717.   InReg.DX = VARPTR(TFile)              'DX = offset of TFile
  718.   CALL INTERRUPTX(&H21, InReg, OutReg)  'Call it
  719.   IF OutReg.Flags AND &H1 THEN          'Carry bit (bit 0 of flag register)
  720.      Found = 0                          '   set, file not found
  721.      Dir$ = ""                          '   Len(Dir$) = 0
  722.   ELSE Found = -1                                                                '   clear, file found
  723.      Dir$ = MID$(Buffer, &H1E)          '   Len(Dir$) = 99 due to
  724.   END IF                                '   trailing CHR$(0)'s
  725. END FUNCTION
  726.  
  727. SUB Editor (Text$, LeftCol, RightCol, NumOnly, CapsOn, KeyCode)
  728.   '----- Find the cursor's size in Scan Lines
  729.   DEF SEG = 0                                 'Peek at low memory to see
  730.   IF PEEK(&H463) = &HB4 THEN                  'what type of monitor we have
  731.     CsrSize = 12                              'Monochrome uses 13 scan lines
  732.   ELSE                                        '  (numbered 0 to 12)
  733.     CsrSize = 7                               'Color uses 8 (0 to 7)
  734.   END IF
  735.     DEF SEG
  736.  
  737.   Edit$ = SPACE$(RightCol - LeftCol + 1)      'Make a temporary string for
  738.   LSET Edit$ = Text$                          '  editing
  739.  
  740.   TxtPos = POS(0) - LeftCol + 1               'Get the cursor's location to
  741.   IF TxtPos < 1 THEN TxtPos = 1               '  see where to begin editing
  742.   IF TxtPos > LEN(Edit$) THEN TxtPos = LEN(Edit$)
  743.  
  744.   LOCATE , LeftCol                            'Print the editing string
  745.   QPrint Edit$, MC.Ho
  746.   IF KeyCode = -79 THEN GOTO KeyTest          'Force end for file names
  747.   '----- Main loop for handling key presses
  748.   DO
  749.     LOCATE , LeftCol + TxtPos - 1, 1          'Locate the cursor, turn it on
  750.     DO                                        'Wait for a key press
  751.       Ky$ = INKEY$
  752.     LOOP UNTIL LEN(Ky$)
  753.  
  754.     IF LEN(Ky$) = 1 THEN                      'Make a key code from Ky$
  755.        KeyCode = ASC(Ky$)                     'Single character key
  756.     ELSE
  757.        KeyCode = -ASC(RIGHT$(Ky$, 1))         'Extended keys are negative
  758.     END IF
  759.  
  760. KeyTest:
  761.     '----- Branch according to the key pressed
  762.     SELECT CASE KeyCode
  763.      
  764.       CASE 8                              '----- Backspace
  765.         TxtPos = TxtPos - 1               'Back up the text pointer
  766.         LOCATE , LeftCol + TxtPos - 1, 0  'Locate 1 to the left
  767.         IF TxtPos > 0 THEN                'Still within the field?
  768.           IF LZInsert THEN                'Truncate the string
  769.              MID$(Edit$, TxtPos) = MID$(Edit$, TxtPos + 1) + " "
  770.           ELSE                            'Blank the letter
  771.              MID$(Edit$, TxtPos) = " "
  772.           END IF
  773.           QPrint MID$(Edit$, TxtPos), MC.Ho 'Print the new part of text
  774.         END IF
  775.      
  776.       CASE 13, 27                         '----- Enter or Escape
  777.         EXIT DO                           'Bail out
  778.      
  779.       CASE 32 TO 254                      '----- Letter keys
  780.         IF NumOnly THEN
  781.           IF KeyCode < 48 OR KeyCode > 57 THEN
  782.             IF KeyCode <> 45 AND KeyCode <> 43 AND KeyCode <> 46 THEN
  783.               BEEP
  784.               EXIT DO
  785.             END IF
  786.           END IF
  787.         END IF
  788.         IF CapsOn THEN Ky$ = UCASE$(Ky$)
  789.         LOCATE , , 0                      'Turn the cursor off
  790.         IF LZInsert THEN                  'Expand the text string
  791.           MID$(Edit$, TxtPos) = Ky$ + MID$(Edit$, TxtPos)
  792.           QPrint MID$(Edit$, TxtPos), MC.Ho'Print the expanded part
  793.         ELSE
  794.           MID$(Edit$, TxtPos) = Ky$       'Put the new letter in string
  795.           QPrint Ky$, MC.Ho               'Print the letter
  796.         END IF
  797.           TxtPos = TxtPos + 1             'Increment the text pointer
  798.      
  799.       CASE -75                            '----- Left arrow
  800.         TxtPos = TxtPos - 1               'Decrement the text pointer
  801.     
  802.       CASE -77                            '----- Right arrow
  803.         TxtPos = TxtPos + 1               'Increment the text pointer
  804.     
  805.       CASE -71                            '----- Home
  806.         TxtPos = 1                        'Move text pointer to 1
  807.  
  808.       CASE -79                            '----- End
  809.         FOR N = LEN(Edit$) TO 1 STEP -1 'Look backwards for non-blank
  810.           IF MID$(Edit$, N, 1) <> " " THEN EXIT FOR
  811.         NEXT
  812.         TxtPos = N + 1                    'Set pointer to last char +1
  813.         IF TxtPos > LEN(Edit$) THEN TxtPos = LEN(Edit$)
  814.  
  815.       CASE -82                            '----- Insert key
  816.         LZInsert = NOT LZInsert           'Toggle the Insert state
  817.         IF LZInsert THEN                  'Adjust the cursor size
  818.           LOCATE , , , CsrSize \ 2, CsrSize
  819.         ELSE
  820.           LOCATE , , , CsrSize - 1, CsrSize
  821.         END IF
  822.                                           '----- Delete
  823.       CASE -83                            'Truncate the text
  824.         MID$(Edit$, TxtPos) = MID$(Edit$, TxtPos + 1) + " "
  825.         LOCATE , , 0                      'Print the truncated part
  826.         QPrint MID$(Edit$, TxtPos), MC.Ho
  827.  
  828.       CASE ELSE                           'All other keys,
  829.         EXIT DO                           ' bail out
  830.     END SELECT
  831.  
  832.     LOOP UNTIL TxtPos < 1 OR TxtPos > LEN(Edit$) 'If cursor is out of field,
  833.                                                  '  quit editing
  834.  
  835.     Text$ = RTRIM$(Edit$)                       'Trim the right side of text
  836.  
  837. END SUB
  838.  
  839. FUNCTION GetDigit$ (Code$, Index) STATIC  'Replace parameters in ESCcode$
  840.  
  841.   X = INSTR(Code$, "#")                   'Get position to replace
  842.   X = X + INSTR(Code$, "Σ")               'Get position to replace
  843.   X = X + INSTR(Code$, "Φ")               'Get position to replace
  844.   IF INSTR(Code$, "Φ") THEN Y = 3 ELSE Y = 2
  845.  
  846.   IF X THEN                               'If there is a # sign
  847.     Temp$ = LEFT$(Code$, X - 1)           '  then save chars to the left
  848.     T$ = LTRIM$(RTRIM$(UsrText$(Index)))  '  get input from before
  849.     GetDigit$ = Temp$ + T$ + MID$(Code$, X + Y)  'Assign function to code
  850.   ELSEIF INSTR(Code$, "√") THEN           '  Just text flag
  851.     GetDigit$ = UsrText$(Index)           '  get from text array
  852.   ELSE
  853.     GetDigit$ = Code$                     'If no input needed, then
  854.   END IF                                  '  use incoming string
  855. END FUNCTION
  856.  
  857. SUB GetFileName (FlName$, Prompt$)
  858.   CALL PromptLine(Prompt$, 0)           'Prompt for file name
  859.   LOCATE 18, 4 + LEN(Prompt$)
  860.   IF FlName$ = "" THEN
  861.      Text$ = CurDir$                    'Get current directory
  862.      IF RIGHT$(Text$, 1) <> "\" THEN
  863.         Text$ = Text$ + "\"             ' add back slash to end
  864.      END IF
  865.   ELSE
  866.      Text$ = FlName$
  867.   END IF
  868.   MC.Ky = -79                           'Force an END key
  869.   CALL GetText(Text$, 60, 0, 1)         'Max file len = 60, all caps
  870.   IF MC.Ky <> 27 THEN                   'Anything but ESC
  871.     CALL ClrSc(18, 2, 18, 79, MC.No)    'Clear the prompt area
  872.     FOR X = 1 TO LEN(Text$)             'Squeeze out any spaces
  873.       IF MID$(Text$, X, 1) <> CHR$(32) THEN Temp$ = Temp$ + MID$(Text$, X, 1)
  874.     NEXT X
  875.     FlName$ = Temp$                     'Assign the filename
  876.   END IF
  877. END SUB
  878.  
  879. SUB GetNextItem
  880.   IF PMF.CN = PMF.MI THEN               'Warn if over 50 lines
  881.     CALL PromptLine("Maximum Lines Reached Please save file", -1)
  882.   ELSE
  883.     P$ = "Enter menu text" + STR$(PMF.CN + 1)
  884.     CALL PromptLine(P$, 0)
  885.     LOCATE 18, 21
  886.     CALL GetText(Temp$, 20, 0, 0)       '20 characters max
  887.     IF MC.Ky <> 27 THEN                 'Unless ESC was pressed
  888.       IF Temp$ <> "" THEN
  889.         PMF.CN = PMF.CN + 1             'Increment current line
  890.         PMFI$(PMF.CN, 0) = Temp$        'Assign text
  891.         PMFI$(PMF.CN, 1) = ""           'Clear variable
  892.         CALL ClrSc(20, 2, 23, 66, MC.No)'Clear ESC print area
  893.         CALL ClrSc(2, 41, 16, 79, MC.No)
  894.         Temp$ = "Current item:" + STR$(PMF.CN) + " " + Temp$    'Current line
  895.         LOCATE 2, 61 - (LEN(Temp$) \ 2)     'Locate and print
  896.         QPrint Temp$, MC.No
  897.         PMF.CI = 1                      'Reset instruction pointer
  898.         PMF.EscLen = 0                  'Reset esc code length
  899.         CALL PrintEsc("")               'Clear print area
  900.       ELSE
  901.         MC.Ky = 27                      'make it look like ESC pressed
  902.       END IF
  903.     END IF
  904.   END IF
  905.   CALL ClrSc(18, 2, 18, 78, MC.No)
  906. END SUB
  907.  
  908. SUB GetText (Text$, NumDig, NumOnly, CapsOn)  'text in routine
  909.   TRow = CSRLIN                           'save current cursor position
  910.   TCol = POS(0)
  911.   LeftCol = TCol                          'Set left column for editing
  912.   RightCol = LeftCol + NumDig - 1         'Ditto for right column
  913.   LOCATE TRow                             'Set the line number for editing
  914.   DO                                      'Edit the field
  915.     CALL Editor(Text$, LeftCol, RightCol, NumOnly, CapsOn, MC.Ky)
  916.     IF MC.Ky = -59 THEN CALL HelpScreen   'Call for help
  917.   LOOP UNTIL MC.Ky = 13 OR MC.Ky = 27     'Do until Enter or Escape is pressed
  918.   LOCATE TRow, TCol, 0                    ' and print to clear area
  919. END SUB
  920.  
  921. SUB HelpScreen STATIC
  922. ' -------- Displays help screen
  923. DIM ScrArray(2000)                      'Create an array to save it to
  924. DIM Help$(20)
  925.   DEF SEG = 0                           'Point default segment to 0 (low memory)
  926.  
  927. ' -------- Check low memory to see what type of monitor is current
  928.   IF PEEK(&H463) <> &HB4 THEN           'Color save screen
  929.     DEF SEG                             'Set back to default segment
  930.     PCOPY 0, 1                          'Copy current page to back page
  931.     GOSUB HelpStuff                     ' Print our help message
  932.     PCOPY 1, 0                          'Copy saved page back
  933.   ELSE                                  'mono/hercules save screen
  934.     DEF SEG
  935. ' -------- Copy screen into an integer array
  936.     MovBytes &HB000, 0, VARSEG(ScrArray(0)), VARPTR(ScrArray(0)), 2000
  937.     GOSUB HelpStuff
  938. ' -------- Copy integer array back to screen
  939.     MovBytes VARSEG(ScrArray(0)), VARPTR(ScrArray(0)), &HB000, 0, 2000
  940.   END IF
  941. EXIT SUB
  942.  
  943. ' -------- Hard code an array of help
  944. HelpStuff:
  945.    TCol = POS(0)                        'Preserve cursor location
  946.    TRow = CSRLIN
  947.    CALL ClrSc(3, 7, 20, 73, MC.Hl)      'Clear a nice area
  948.     DO UNTIL LEN(Help$(20))             'Assign strings only once
  949.     Help$(1) = "╔════════════════════════╡  LZSelect Help  ╞═══════════════════════╗"
  950.     Help$(2) = "║                                                                  ║"
  951.     Help$(3) = "║ ESC - Main Menu or Cancel         F6 - Individual/Combined mode  ║"
  952.     Help$(4) = "║ ALT Q - Quit LZSelect             F7 - Delete line               ║"
  953.     Help$(5) = "║ F1 - Help                         Alt F7  - Clear menu item set  ║"
  954.     Help$(6) = "║ F2 - Next SETUP menu item         Ctrl F7 - Clear all item sets  ║"
  955.     Help$(7) = "║ F3 - Send line to printer         F8 - Insert line               ║"
  956.     Help$(8) = "║ F4 - Download permanent font      F9 - Save Esc file             ║"
  957.     Help$(9) = "║ Alt F4 - Download temporary font  F10 - Save current SETUP file  ║"
  958.    Help$(10) = "║ F5 - View SETUP menu items        Alt F10 - Save new SETUP file  ║"
  959.    Help$(11) = "║   Right arrow switches from left to right menu to view items     ║"
  960.    Help$(12) = "║                                                                  ║"
  961.    Help$(13) = "║                           Fill patterns                          ║"
  962.    Help$(14) = "║      ────      ││││    /////     \\\\\     ┌┬┬┬┐     /\/\/\      ║"
  963.    Help$(15) = "║      ────      ││││    /////     \\\\\     ├┼┼┼┤     \/\/\/      ║"
  964.    Help$(16) = "║      ────      ││││    /////     \\\\\     └┴┴┴┘     /\/\/\      ║"
  965.    Help$(17) = "║       #1        #2       #3        #4        #5        #6        ║"
  966.    Help$(18) = "║  Horizontal  Vertical  Diagonal  Diagonal   Cross    Diagonal    ║"
  967.    Help$(19) = "║     Lines      Lines    Lines     Lines     Hatch     Hatch      ║"
  968.    Help$(20) = "╚══════════════════════════════════════════════════════════════════╝"
  969.    LOOP
  970.    FOR X = 1 TO 20                      'Print help$ array
  971.       LOCATE 2 + X, 7, 0
  972.       QPrint Help$(X), MC.Hl
  973.    NEXT X
  974.    DO                                   'Wait for a key press
  975.    LOOP UNTIL OneKey
  976.    LOCATE TRow, TCol, 0                 'Put cursor back
  977. RETURN
  978. END SUB
  979.  
  980. SUB InsertInst (Choice) STATIC
  981. IF PMF.CI > 1 THEN                       'PMF.CI = 1 then nothing to delete
  982.   CALL PromptLine("Insert at which line ? ", 1)
  983.   CALL ScrollMenu(Title$(), 0, Choice)
  984.   CALL ClrSc(18, 2, 18, 78, MC.No)
  985.   IF MC.Ky = 13 THEN
  986.     IF Choice < PMF.CI THEN
  987.       FOR X = PMF.CI TO (Choice + 1) STEP -1  'Start at current Choice
  988.         SWAP PV(X), PV(X - 1)            'Swap-faster than assignments
  989.         SWAP Title$(X), Title$(X - 1)
  990.         SWAP UsrText$(X), UsrText$(X - 1)
  991.       NEXT X
  992.     ELSEIF Choice > PMF.CI THEN          'If inserted Choice is greater
  993.       EXIT SUB                           ' than number available, exit
  994.     END IF
  995.   END IF
  996. END IF
  997.  
  998. END SUB
  999.  
  1000. SUB MenuData
  1001. '============================================================================
  1002. 'Format for ESC codes:
  1003. '                                   "&l#3L"
  1004. ' Group and parameterized identifier  / || \termination character (always caps)
  1005. ' code that parameters will be inserted/  \ maximum number of digits allowed
  1006. ' Above Esc code will have # replaced by up to 3 characters
  1007. '============================================================================
  1008. ' Menu selections
  1009. '============================================================================
  1010.  
  1011. Menu$(0, 0) = "Main Menu"
  1012. Menu$(0, 1) = "Job Control":
  1013. Menu$(0, 2) = "Page Control":
  1014. Menu$(0, 3) = "Standard Font Setups":
  1015. Menu$(0, 4) = "Font Selection":
  1016. Menu$(0, 5) = "Lines Per Inch":
  1017. Menu$(0, 6) = "Font Style":
  1018. Menu$(0, 7) = "Paper Source":
  1019. Menu$(0, 8) = "Macros"
  1020. Menu$(0, 9) = "Cursor and Text "
  1021. Menu$(0, 10) = "Print Direction & Model":
  1022. Menu$(0, 11) = "LaserJet III Fonts":
  1023. Menu$(0, 12) = "Rectangular Fills"
  1024. Menu$(0, 13) = "Set Font Attributes"
  1025.  
  1026. Menu$(1, 0) = Menu$(0, 1)
  1027. Menu$(1, 1) = "Printer Reset":         EscCode$(1, 1) = "≡"
  1028. Menu$(1, 2) = "Portrait":              EscCode$(1, 2) = "&l0O"
  1029. Menu$(1, 3) = "Landscape":             EscCode$(1, 3) = "&l1O"
  1030. Menu$(1, 4) = "Number of Copies":      EscCode$(1, 4) = "&l#2X"
  1031. Menu$(1, 5) = "Line Wrap On":          EscCode$(1, 5) = "&s0C"
  1032. Menu$(1, 6) = "Line Wrap Off":         EscCode$(1, 6) = "&s1C"
  1033. Menu$(1, 7) = "Perf Skip On":          EscCode$(1, 7) = "&l1L"
  1034. Menu$(1, 8) = "Perf Skip Off":         EscCode$(1, 8) = "&l0L"
  1035. Menu$(1, 9) = "Left Offset in 1/720":  EscCode$(1, 9) = "&l#5U"
  1036. Menu$(1, 10) = "Top Offset in 1/720":  EscCode$(1, 10) = "&l#5Z"
  1037. Menu$(1, 11) = "Display Function On":  EscCode$(1, 11) = "Y"
  1038. Menu$(1, 12) = "Display Function Off": EscCode$(1, 12) = "Z"
  1039.  
  1040. Menu$(2, 0) = Menu$(0, 2)
  1041. Menu$(2, 1) = "Clear Horiz Margins":   EscCode$(2, 1) = "±"     '9
  1042. Menu$(2, 2) = "Left Margin":           EscCode$(2, 2) = "&a#3L"
  1043. Menu$(2, 3) = "Right Margin":          EscCode$(2, 3) = "&a#3M"
  1044. Menu$(2, 4) = "Top Margin":            EscCode$(2, 4) = "&l#3E"
  1045. Menu$(2, 5) = "Text Length":           EscCode$(2, 5) = "&l#3F"
  1046. Menu$(2, 6) = "Page Feed":             EscCode$(2, 6) = "12"
  1047. Menu$(2, 7) = "Eject Page":            EscCode$(2, 7) = "&l0H"
  1048.                                        
  1049. Menu$(3, 0) = Menu$(0, 3)
  1050. Menu$(3, 1) = "Portrait 10cpi":        EscCode$(3, 1) = "(s0p10H"
  1051. Menu$(3, 2) = "Portrait 12cpi":        EscCode$(3, 2) = "(s0p12H"
  1052. Menu$(3, 3) = "Portrait 16cpi":        EscCode$(3, 3) = "(s0p16.66H"
  1053. Menu$(3, 4) = "Landscape 10cpi":       EscCode$(3, 4) = "&l1o5.45C" + QT$ + ",27," + QT$ + "(s0p10H"
  1054. Menu$(3, 5) = "Landscape 12cpi":       EscCode$(3, 5) = "&l1o5.45C" + QT$ + ",27," + QT$ + "(s0p12H"
  1055. Menu$(3, 6) = "Landscape 16cpi":       EscCode$(3, 6) = "&l1o5.45C" + QT$ + ",27," + QT$ + "(s0p16.66H"
  1056.                                        
  1057. Menu$(4, 0) = Menu$(0, 4)
  1058. Menu$(4, 1) = "Courier":               EscCode$(4, 1) = "(s3T"
  1059. Menu$(4, 2) = "Line Printer":          EscCode$(4, 2) = "(s0T"
  1060. Menu$(4, 3) = "10 Pitch":              EscCode$(4, 3) = "(s10H"
  1061. Menu$(4, 4) = "12 Pitch":              EscCode$(4, 4) = "(s12H"
  1062. Menu$(4, 5) = "16.66 Pitch":           EscCode$(4, 5) = "(s16.66H"
  1063. Menu$(4, 6) = "Set pitch":             EscCode$(4, 6) = "(s#5H"
  1064. Menu$(4, 7) = "Helv":                  EscCode$(4, 7) = "(s4T"
  1065. Menu$(4, 8) = "TmsRmn":                EscCode$(4, 8) = "(s5H"
  1066. Menu$(4, 9) = "Typeface Family":       EscCode$(4, 9) = "(s#4T"
  1067. Menu$(4, 10) = "Set Point Size":       EscCode$(4, 10) = "(s#4V"
  1068. Menu$(4, 11) = "Soft Font ID #":       EscCode$(4, 11) = "(#4X"
  1069.                                        
  1070. Menu$(5, 0) = Menu$(0, 5)
  1071. Menu$(5, 1) = "4 Lines per inch":      EscCode$(5, 1) = "&l4D"
  1072. Menu$(5, 2) = "6 Lines per inch":      EscCode$(5, 2) = "&l6D"
  1073. Menu$(5, 3) = "8 Lines per inch":      EscCode$(5, 3) = "&l8D"
  1074. Menu$(5, 4) = "12 Lines per inch":     EscCode$(5, 4) = "&l12D"
  1075. Menu$(5, 5) = "16 Lines per inch":     EscCode$(5, 5) = "&l16D"
  1076. Menu$(5, 6) = "24 Lines per inch":     EscCode$(5, 6) = "&l24D"
  1077. Menu$(5, 7) = "48 Lines per inch":     EscCode$(5, 7) = "&l48D"
  1078. Menu$(5, 8) = "Page Length":           EscCode$(5, 8) = "&l#3P"
  1079.                                        
  1080. Menu$(6, 0) = Menu$(0, 6)
  1081. Menu$(6, 1) = "Light":                 EscCode$(6, 1) = "(s-3B"
  1082. Menu$(6, 2) = "Normal":                EscCode$(6, 2) = "(s0B"
  1083. Menu$(6, 3) = "Bold":                  EscCode$(6, 3) = "(s3B"
  1084. Menu$(6, 4) = "Underline On":          EscCode$(6, 4) = "&d0D"
  1085. Menu$(6, 5) = "Floating Underline":    EscCode$(6, 5) = "&d3D"
  1086. Menu$(6, 6) = "Underline Off":         EscCode$(6, 6) = "&d@"
  1087. Menu$(6, 7) = "Upright":               EscCode$(6, 7) = "(s0S"
  1088. Menu$(6, 8) = "Italic":                EscCode$(6, 8) = "(s1S"
  1089. Menu$(6, 9) = "PC-8 Symbol Set":       EscCode$(6, 9) = "(10U"
  1090. Menu$(6, 10) = "Roman 8 Symbol Set":   EscCode$(6, 10) = "(8U"
  1091. Menu$(6, 11) = "Set Symbol Set":       EscCode$(6, 11) = "(#4"
  1092.  
  1093. Menu$(7, 0) = Menu$(0, 7)
  1094. Menu$(7, 1) = "Executive":             EscCode$(7, 1) = "&l1A"
  1095. Menu$(7, 2) = "Letter":                EscCode$(7, 2) = "&l2A"
  1096. Menu$(7, 3) = "Legal":                 EscCode$(7, 3) = "&l3A"
  1097. Menu$(7, 4) = "A4":                    EscCode$(7, 4) = "&l26A"
  1098. Menu$(7, 5) = "Monarch Envelope":      EscCode$(7, 5) = "&l80A"
  1099. Menu$(7, 6) = "COM 10 Envelope":       EscCode$(7, 6) = "&l81A"
  1100. Menu$(7, 7) = "DL Envelope":           EscCode$(7, 7) = "&l90A"
  1101. Menu$(7, 8) = "C5 Envelope":           EscCode$(7, 8) = "&l91A"
  1102. Menu$(7, 9) = "Paper Tray":            EscCode$(7, 9) = "&l1H"
  1103. Menu$(7, 10) = "Manual Feed":          EscCode$(7, 10) = "&l2H"
  1104. Menu$(7, 11) = "Envelope Feed":        EscCode$(7, 11) = "&l3H"
  1105. Menu$(7, 12) = "Lower Tray Feed IIP":  EscCode$(7, 12) = "&l4H"
  1106.                                        
  1107. Menu$(8, 0) = Menu$(0, 8)
  1108. Menu$(8, 1) = "Start Macro #":         EscCode$(8, 1) = "&f#5y0X"
  1109. Menu$(8, 2) = "End Temp Macro":        EscCode$(8, 2) = "&f1x9X"
  1110. Menu$(8, 3) = "End Perm Macro":        EscCode$(8, 3) = "&f1x10X"
  1111. Menu$(8, 4) = "Set New Macro #":       EscCode$(8, 4) = "&f#5Y"
  1112. Menu$(8, 5) = "Execute Macro #":       EscCode$(8, 5) = "&f#5y2X"
  1113. Menu$(8, 6) = "Call Macro #":          EscCode$(8, 6) = "&f#5y3X"
  1114. Menu$(8, 7) = "Enable Overlay #":      EscCode$(8, 7) = "&f#5y4X"
  1115. Menu$(8, 8) = "Disable Overlay #":     EscCode$(8, 8) = "&f#5y5X"
  1116. Menu$(8, 9) = "Delete All Macros":     EscCode$(8, 9) = "&f6X"
  1117. Menu$(8, 10) = "Delete Temp Macros":   EscCode$(8, 10) = "&f7X"
  1118. Menu$(8, 11) = "Delete One Macro #":   EscCode$(8, 11) = "&f#5y8X"
  1119.                                        
  1120. Menu$(9, 0) = Menu$(0, 9)
  1121. Menu$(9, 1) = "Horiz Pos'n - Dots":     EscCode$(9, 1) = "*p#5X"
  1122. Menu$(9, 2) = "Horiz Pos'n - Columns":  EscCode$(9, 2) = "&a#4C"
  1123. Menu$(9, 3) = "Horiz Pos'n - Decip'ts": EscCode$(9, 3) = "&a#5H"
  1124. Menu$(9, 4) = "Vert Pos'n - Dots":      EscCode$(9, 4) = "*p#5Y"
  1125. Menu$(9, 5) = "Vert Pos'n - Rows":      EscCode$(9, 5) = "&a#4R"
  1126. Menu$(9, 6) = "Horiz Pos'n - Decip'ts": EscCode$(9, 6) = "&a#5V"
  1127. Menu$(9, 7) = "Push Cursor":            EscCode$(9, 7) = "&f0S"
  1128. Menu$(9, 8) = "Pop Cursor":             EscCode$(9, 8) = "&f1S"
  1129. Menu$(9, 9) = "Half Line Feed":         EscCode$(9, 9) = "="
  1130. Menu$(9, 10) = "Full Line Feed":        EscCode$(9, 10) = "10"
  1131. Menu$(9, 11) = "Carriage Return":       EscCode$(9, 11) = "13"
  1132. Menu$(9, 12) = "Enter Text":            EscCode$(9, 12) = "√"
  1133.  
  1134. Menu$(10, 0) = Menu$(0, 10)
  1135. Menu$(10, 1) = "Rotate 0°   ":         EscCode$(10, 1) = "&a0P"
  1136. Menu$(10, 2) = "Rotate 90°  ":         EscCode$(10, 2) = "&a90P"
  1137. Menu$(10, 3) = "Rotate 180° ":         EscCode$(10, 3) = "&a180P"
  1138. Menu$(10, 4) = "Rotate 270° ":         EscCode$(10, 4) = "&a270P"
  1139. Menu$(10, 5) = "Source Transparent":   EscCode$(10, 5) = "*v0N"
  1140. Menu$(10, 6) = "Source Opaque":        EscCode$(10, 6) = "*v1N"
  1141. Menu$(10, 7) = "Pattern Transparent":  EscCode$(10, 7) = "*v0O"
  1142. Menu$(10, 8) = "Pattern Opaque":       EscCode$(10, 8) = "*v1O"
  1143. Menu$(10, 9) = "Pattern - Black":      EscCode$(10, 9) = "*v0T"
  1144. Menu$(10, 10) = "Pattern - White":     EscCode$(10, 10) = "*v1T"
  1145. Menu$(10, 11) = "Pattern - Shading":   EscCode$(10, 11) = "*v2T"
  1146. Menu$(10, 12) = "Pattern - Cross Hatch": EscCode$(10, 12) = "*v3T"
  1147.  
  1148. Menu$(11, 0) = Menu$(0, 11)
  1149. Menu$(11, 1) = "Font size":            EscCode$(11, 1) = "(s#3V"
  1150. Menu$(11, 2) = "Univers":              EscCode$(11, 2) = "(10U" + QT$ + ",27," + QT$ + "(s1p#3v0s0b4148T"
  1151. Menu$(11, 3) = "CG Times":             EscCode$(11, 3) = "(10U" + QT$ + ",27," + QT$ + "(s1p#3v0s0b4101T"
  1152. Menu$(11, 4) = "Univers Bold":         EscCode$(11, 4) = "(10U" + QT$ + ",27," + QT$ + "(s1p#3v0s3b4148T"
  1153. Menu$(11, 5) = "CG Times Bold":        EscCode$(11, 5) = "(10U" + QT$ + ",27," + QT$ + "(s1p#3v0s3b4101T"
  1154. Menu$(11, 6) = "Univers Italic":       EscCode$(11, 6) = "(10U" + QT$ + ",27," + QT$ + "(s1p#3v1s0b4148T"
  1155. Menu$(11, 7) = "CG Times Italic":      EscCode$(11, 7) = "(10U" + QT$ + ",27," + QT$ + "(s1p#3v1s0b4101T"
  1156. Menu$(11, 8) = "Univers Bold Italic":  EscCode$(11, 8) = "(10U" + QT$ + ",27," + QT$ + "(s1p#3v1s3b4148T"
  1157. Menu$(11, 9) = "CG Times Bold Italic": EscCode$(11, 9) = "(10U" + QT$ + ",27," + QT$ + "(s1p#3v1s3b4101T"
  1158.  
  1159. Menu$(12, 0) = Menu$(0, 12)
  1160. Menu$(12, 1) = "Horiz Size-Dots":      EscCode$(12, 1) = "*c#4A"
  1161. Menu$(12, 2) = "Horiz Size-Deci Pts":  EscCode$(12, 2) = "*c#4H"
  1162. Menu$(12, 3) = "Vert Size-Dots":       EscCode$(12, 3) = "*c#4B"
  1163. Menu$(12, 4) = "Vert Size-Deci Pts":   EscCode$(12, 4) = "*c#4V"
  1164. Menu$(12, 5) = "Fill Shade 1 - 100%":  EscCode$(12, 5) = "*c#3G"
  1165. Menu$(12, 6) = "HP Pattern 1 - 6 ":    EscCode$(12, 6) = "*c#1G "
  1166. Menu$(12, 7) = "Fill Black":           EscCode$(12, 7) = "*c0P"
  1167. Menu$(12, 8) = "Fill White (IIP-III)": EscCode$(12, 8) = "*c1P"
  1168. Menu$(12, 9) = "Fill Shading":         EscCode$(12, 9) = "*c2P"
  1169. Menu$(12, 10) = "Fill Pattern":        EscCode$(12, 10) = "*c3P"
  1170.  
  1171. Menu$(13, 0) = Menu$(0, 13)
  1172. Menu$(13, 1) = "Symbol Set ":          EscCode$(13, 1) = "(Σ4"
  1173. Menu$(13, 2) = "Spacing Fixed":        EscCode$(13, 2) = "(s0P"
  1174. Menu$(13, 3) = "Spacing Prop":         EscCode$(13, 3) = "(s1P"
  1175. Menu$(13, 4) = "Pitch (Fixed Only)":   EscCode$(13, 4) = "(s#5H"
  1176. Menu$(13, 5) = "Height":               EscCode$(13, 5) = "(s#5V"
  1177. Menu$(13, 6) = "Style":                EscCode$(13, 6) = "(s#3S"
  1178. Menu$(13, 7) = "Stroke Weight":        EscCode$(13, 7) = "(s#2B"
  1179. Menu$(13, 8) = "Escape Sequence":      EscCode$(13, 8) = "Φ50"
  1180.  
  1181. END SUB
  1182.  
  1183. FUNCTION OneKey%
  1184.  
  1185. ' -------- Onekey is polled in a loop, so there is no waiting here
  1186.   A$ = INKEY$                           'If a key was pressed, process it
  1187.   X = LEN(A$)
  1188.   IF X THEN
  1189.     IF X = 2 THEN                       ' extended keys have a LEN of 2
  1190.       OneKey% = ASC(RIGHT$(A$, 1)) * -1 ' create negative of ASCII value
  1191.     ELSE
  1192.       OneKey% = ASC(A$)                 ' or return ASCII of character                                        ' all others just ASCII values
  1193.     END IF
  1194.   ELSE
  1195.     OneKey% = 0                         'ASC(0) is illegal, so do this
  1196.   END IF
  1197. END FUNCTION
  1198.  
  1199. SUB PrintEsc (Escape$)
  1200.  
  1201. ' -------- Print Escape$ in lower screen area
  1202.   CALL ClrSc(20, 2, 23, 78, MC.No)      'Clear print area
  1203.   X = 0
  1204.   Max = 64
  1205. ' -------- Test length of string, if greater than 255 don't print
  1206. '          otherwise break into 4 strings of 64 chars each
  1207.   IF PMF.EscLen < 256 THEN              '255 char maximum
  1208.     IF PMF.EscLen > Max THEN
  1209.       DO
  1210.         LOCATE 20 + X, 8
  1211.         QPrint MID$(Escape$, Max * X + 1, Max), MC.No
  1212.         X = X + 1
  1213.       LOOP WHILE LEN(MID$(Escape$, Max * X + 1, Max))
  1214.     ELSE
  1215.       LOCATE 20, 8
  1216.       QPrint Escape$, MC.No
  1217.     END IF
  1218.   ELSE
  1219.     CALL WaitTwo(MaxedOut$)             'too many chars
  1220.   END IF
  1221.  
  1222.   LOCATE 25, 75, 0                     'print length of escape code
  1223.   QPrint SPACE$(4), MC.Ho              'clear old number
  1224.   QPrint STR$(PMF.EscLen), MC.Ho       'print new one
  1225.  
  1226. END SUB
  1227.  
  1228. SUB PromptInp (PCode$)
  1229.  
  1230. ' -------- Prompts for user input on ESC codes that require it
  1231.   TRow = CSRLIN                               '  save current cursor position
  1232.   TCol = POS(0)
  1233.   X = INSTR(PCode$, "#")                          'Test for replaceable parameters
  1234.   CapsCode% = 1
  1235.   NumDigits% = 1
  1236.  
  1237.   IF X THEN
  1238.     NumCode% = 1                                  'numbers only
  1239.   ELSE
  1240.     X = INSTR(PCode$, "Σ")                        'Test for replaceable parameters
  1241.     IF X THEN
  1242.       NumCode% = 0                                'alpha
  1243.     ELSE
  1244.       X = INSTR(PCode$, "Φ")
  1245.       IF X THEN
  1246.         NumCode% = 0
  1247.         CapsCode% = 0
  1248.         NumDigits% = 2
  1249.       END IF
  1250.     END IF
  1251.  
  1252.   END IF
  1253.  
  1254.   IF X THEN                                     'If user input needed then
  1255.     Prompt$ = RTRIM$(Menu$(PV(PMF.CI).MnuNum, PV(PMF.CI).MnuChc))
  1256.     CALL PromptLine(Prompt$, 0)
  1257.     LOCATE 18, 4 + LEN(Prompt$)
  1258.     CALL GetText(UsrText$(PMF.CI), VAL(MID$(PCode$, X + 1, NumDigits%)), NumCode%, CapsCode%) 'Call input routine
  1259.     IF LEN(UsrText$(PMF.CI)) THEN
  1260.       IF MC.Ky <> 27 THEN                       '  save info unless ESC was pressed
  1261.         Title$(PMF.CI) = LEFT$(RTRIM$(Menu$(PV(PMF.CI).MnuNum, PV(PMF.CI).MnuChc)) + " " + UsrText$(PMF.CI), 29)
  1262.         CALL ScrollMenu(Title$(), -1, X)        'Print all current instructions
  1263.         PMF.CI = PMF.CI + 1                     '  point to next instruction
  1264.       END IF
  1265.     ELSE
  1266.       MC.Ky = 27
  1267.     END IF
  1268.     CALL ClrSc(18, 2, 18, 78, MC.No)            'Clear user prompt
  1269.     LOCATE TRow, TCol, 0
  1270.   ELSEIF INSTR(PCode$, "√") THEN                'Test for replaceable parameters
  1271.     X = INSTR(PCode$, "√")                      'Test for replaceable parameters
  1272.     Prompt$ = RTRIM$(Menu$(PV(PMF.CI).MnuNum, PV(PMF.CI).MnuChc))
  1273.     CALL PromptLine(Prompt$, 0)
  1274.     LOCATE 18, 4 + LEN(Prompt$)
  1275.     Temp1 = (252 - PMF.EscLen)                  ' how manu characters can we fit?
  1276.       DO
  1277.         IF Temp1 > 60 THEN                      ' is there at least 60 chars
  1278.           Temp = 60                             ' yes than get 60
  1279.         ELSEIF Temp1 > 0 THEN                   ' well, at least 1 character
  1280.           Temp = Temp1                          ' the difference
  1281.         ELSE
  1282.           MC.Ky = 27                            ' if too small, get out
  1283.           EXIT DO
  1284.         END IF
  1285.         CALL GetText(T$, Temp, 0, 0)            'Call input routine
  1286.         IF LEN(T$) THEN
  1287.           IF MC.Ky <> 27 THEN                   'Save info unless ESC was pressed
  1288.             UsrText$(PMF.CI) = "√" + T$
  1289.             Title$(PMF.CI) = RTRIM$(Menu$(PV(PMF.CI).MnuNum, PV(PMF.CI).MnuChc))
  1290.             CALL ScrollMenu(Title$(), -1, X)    'Print all current instructions
  1291.             PMF.CI = PMF.CI + 1                 '  point to next instruction
  1292.           END IF
  1293.         ELSE
  1294.           MC.Ky = 27
  1295.         END IF
  1296.         EXIT DO
  1297.       LOOP
  1298.       CALL ClrSc(18, 2, 18, 78, MC.No)          'Clear user prompt
  1299.       LOCATE TRow, TCol, 0
  1300.   ELSE                                          'If no input needed
  1301.     Title$(PMF.CI) = RTRIM$(Menu$(PV(PMF.CI).MnuNum, PV(PMF.CI).MnuChc)) ' save code
  1302.     CALL ScrollMenu(Title$(), -1, X)            'Print all current instructions
  1303.     PMF.CI = PMF.CI + 1                         ' point to next instruction
  1304.   END IF
  1305. END SUB
  1306.  
  1307. SUB PromptLine (Message$, Flash) STATIC
  1308.  
  1309. ' -------- Prints message either with flashing color, or constant
  1310.   CALL ClrSc(18, 2, 18, 78, MC.No)      'clear prompt area
  1311.   IF Flash THEN                         'do we flash the message?
  1312.     Colr = MC.No OR 128                 'turn on High bit of background
  1313.   ELSE
  1314.     Colr = MC.No                        'use normal color
  1315.   END IF
  1316.   LOCATE 18, 3, 0
  1317.   QPrint Message$, Colr                 'print message
  1318. END SUB
  1319.  
  1320. SUB SaveFile STATIC
  1321.  
  1322. ' -------- PMF file save routine
  1323.   IF PMF.CI > 1 THEN                    'Make sure all codes are included
  1324.     PMFI$(PMF.CN, 1) = BuildLine$       'Assign Esc code to current line
  1325.     CALL PrintEsc(PMFI$(PMF.CN, 1))     'print it
  1326.   END IF
  1327.  
  1328. ' -------- Request file name, using current directory as default
  1329. PromptForFile:
  1330. DO
  1331.   IF RIGHT$(Filename$, 1) = "\" OR Filename$ = "" THEN  'Just path, no file
  1332.     CALL GetFileName(Filename$, "PMF File Name")
  1333.   ELSEIF LEN(Dir$(Filename$)) THEN      'Check if it exists
  1334.     CALL PromptLine(Filename$ + ExistPrompt$, -1)
  1335.     IF YesNo THEN EXIT DO
  1336.        CALL GetFileName(Filename$, "PMF File Name")
  1337.   ELSE
  1338.       EXIT DO
  1339.   END IF
  1340. LOOP UNTIL MC.Ky = 27
  1341.  
  1342.   IF MC.Ky = 27 THEN                    'user pressed Escape
  1343.     CALL ClrSc(18, 2, 18, 78, MC.No)
  1344.     EXIT SUB
  1345.   END IF
  1346.  
  1347. ' -------- Ask for a title for the menu being saved
  1348.   IF MenuTitle$ = "" THEN
  1349.      MenuTitle$ = "Hewlett Packard LaserJet"  'Default title
  1350.   END IF
  1351.   LOCATE 18, 2
  1352.   QPrint "Enter title or <ENTER> for default ", MC.No
  1353.   LOCATE , 37
  1354.   CALL GetText(MenuTitle$, 26, 0, 0)    'text routine
  1355.   IF MC.Ky <> 27 THEN
  1356.     CALL ClrSc(18, 2, 18, 78, MC.No)
  1357.     PMF.LastSaved = 0                   'Clear last saved flag
  1358.  
  1359. ' -------- Open file and save escape strings
  1360.     OPEN Filename$ FOR OUTPUT AS #1
  1361.     A$ = "#"                            'print header rem character
  1362.     PRINT #1, A$; STRING$(40, 61)       'string of '='s
  1363.     PRINT #1, A$; " HP Laserjet Make File"
  1364.     PRINT #1, A$; " Copyright (c) 1990 Ziff Communications"
  1365.     PRINT #1, A$; " Created by LZSelect 1.0"
  1366.     PRINT #1, A$; STRING$(40, 61)
  1367.     PRINT #1, MenuTitle$
  1368.     B$ = A$ + STRING$(40, 45)
  1369.     FOR X = 1 TO PMF.CN                 'Print instructions to file
  1370.       IF X MOD 10 = 0 THEN PRINT #1, B$ '  with a break every 10
  1371.       IF PMFI$(X, 0) <> "" AND PMFI$(X, 1) <> "" THEN 'skip blanks
  1372.         PRINT #1, PMFI$(X, 0); CHR$(59); 'Print menu text
  1373.         PRINT #1, TAB(25); LEFT$(PMFI$(X, 1), 256) 'print ESC codes
  1374.       END IF
  1375.     NEXT
  1376.     CLOSE #1                            'close Setup File
  1377.   ELSE
  1378.     CALL ClrSc(18, 2, 18, 78, MC.No)
  1379.   END IF
  1380. END SUB
  1381.  
  1382. SUB ScrollMenu (Item$(), AFlag, Choice) STATIC
  1383.  
  1384. ' -------- Menu to show more than 10 items
  1385.   DO UNTIL MaxLen                       'Do it once
  1386.     TopLine = 4
  1387.     MaxLen = 29                         'Maximum length of Item$
  1388.   LOOP
  1389.   Max = UBOUND(Item$)                   'Find upper bound of array
  1390.   CALL ClrSc(4, 45, 16, 78, MC.No)      'Clear instruction area
  1391.   DO WHILE LEN(Item$(Max)) = 0          'Find actual end of array
  1392.     Max = Max - 1
  1393.     IF Max < 1 THEN EXIT SUB
  1394.   LOOP
  1395.   
  1396.   TopEl = Max
  1397.  
  1398. ' -------- Update display of total items
  1399.   LOCATE 16, 50, 0
  1400.   QPrint "Total Items " + STR$(Max), MC.No
  1401.  
  1402. ' -------- Find top group of 10 for starting point
  1403.   Start = 1 + (ABS(Max > 10) * (Max - 10))
  1404.   Choice = Start
  1405.   TChoice = Choice
  1406.   GOSUB Display
  1407.   IF AFlag THEN EXIT SUB
  1408.     GOSUB HiLite
  1409.   DO
  1410.     DO
  1411.       MC.Ky = OneKey
  1412.     LOOP UNTIL MC.Ky
  1413.     SELECT CASE MC.Ky
  1414.       CASE -80                     'down arrow
  1415.         Choice = Choice + 1
  1416.         IF Choice > TopEl THEN
  1417.           IF TopEl < Max THEN
  1418.             TopEl = TopEl + 1
  1419.             Start = Start + 1
  1420.             Choice = TopEl
  1421.             GOSUB Display
  1422.           ELSEIF Choice > Max THEN
  1423.             Choice = Max
  1424.           END IF
  1425.         END IF
  1426.       CASE -72                  'up arrow
  1427.         Choice = Choice - 1
  1428.         IF Choice < Start THEN
  1429.           IF Start > 1 THEN
  1430.             Start = Start - 1
  1431.             TopEl = TopEl - 1
  1432.             Choice = Start
  1433.             GOSUB Display
  1434.           ELSEIF Choice < 1 THEN
  1435.             Choice = 1
  1436.           END IF
  1437.         END IF
  1438.       CASE 27, -75                    'ESC, left arrow
  1439.         Choice = 0
  1440.         EXIT DO
  1441.       CASE 13
  1442.         EXIT DO
  1443.       CASE ELSE
  1444.     END SELECT
  1445.     GOSUB HiLite
  1446.   LOOP
  1447.   GOSUB UnHilite
  1448. EXIT SUB
  1449.  
  1450. Display:
  1451.   Y = 0
  1452.   FOR X = Start TO TopEl
  1453.     LOCATE TopLine + Y, 45, 0
  1454.     QPrint LTRIM$(STR$(X)) + ": " + Item$(X) + SPACE$(MaxLen - LEN(Item$(X))), MC.No
  1455.     Y = Y + 1
  1456.   NEXT X
  1457. RETURN
  1458.  
  1459. UnHilite:
  1460.   LOCATE TopLine + (TChoice - Start), 45, 0
  1461.   QPrint LTRIM$(STR$(TChoice)) + ": " + Item$(TChoice) + SPACE$(MaxLen - LEN(Item$(TChoice))), MC.No
  1462. RETURN
  1463.  
  1464. HiLite:
  1465.   GOSUB UnHilite
  1466.   LOCATE TopLine + (Choice - Start), 45, 0
  1467.   QPrint LTRIM$(STR$(Choice)) + ": " + Item$(Choice) + SPACE$(MaxLen - LEN(STR$(Choice) + ": " + Item$(Choice))), MC.Ho
  1468.   TChoice = Choice
  1469. RETURN
  1470.   
  1471. END SUB
  1472.  
  1473. SUB SetColors STATIC
  1474. ' -------- Set colors of menu and prompts
  1475. CNFFile$ = "LZSelect.CNF"
  1476.  
  1477. IF LEN(Dir$(CNFFile$)) THEN
  1478.    OPEN CNFFile$ FOR INPUT AS #5
  1479.    LINE INPUT #5, X$
  1480.    MC.No = VAL(LEFT$(X$, 3))
  1481.    LINE INPUT #5, X$
  1482.    MC.Ho = VAL(LEFT$(X$, 3))
  1483.    LINE INPUT #5, X$
  1484.    MC.Hl = VAL(LEFT$(X$, 3))
  1485.    CLOSE #5
  1486. ELSE
  1487.   DEF SEG = 0
  1488.   IF PEEK(&H463) = &HB4 OR INSTR(COMMAND$, "/B") THEN  'mono
  1489.     MC.No = 7                           ' white on black
  1490.     MC.Ho = 112                         ' black on white
  1491.     MC.Hl = 15                          ' bright white on black (help)
  1492.   ELSE                                  'Color
  1493.     MC.No = 30                          ' yellow on blue
  1494.     MC.Ho = 113                         ' blue on white
  1495.     MC.Hl = 31                          ' brigh white on blue (help)
  1496.   END IF
  1497.   DEF SEG
  1498.  
  1499.    OPEN CNFFile$ FOR OUTPUT AS #5
  1500.    PRINT #5, LTRIM$(STR$(MC.No)), "Normal"
  1501.    PRINT #5, LTRIM$(STR$(MC.Ho)), "Highlight"
  1502.    PRINT #5, LTRIM$(STR$(MC.Hl)), "Help Screen"
  1503.    CLOSE #5
  1504. END IF
  1505. END SUB
  1506.  
  1507. SUB TestPrint (ToFile) STATIC
  1508. ' -------- Prints actual escape sequences to printer or file
  1509. DIM Ctrl$(1 TO 6)                       'Scan values for FF,CR,LF
  1510.   Ctrl$(1) = "10,": Ctrl$(4) = ",10"
  1511.   Ctrl$(2) = "12,": Ctrl$(5) = ",12"
  1512.   Ctrl$(3) = "13,": Ctrl$(6) = ",13"
  1513.  
  1514. DO
  1515.   IF LEN(PMFI$(PMF.CN, 1)) THEN         'Is there something to print?
  1516.     IF ToFile = 0 THEN                  ' printer flag = 0
  1517.       Printer$ = "LPT" + LTRIM$(STR$(PMF.Port)) 'Build a LPT string
  1518.     ELSE
  1519.       Printer$ = ""
  1520.       DO
  1521.         CALL GetFileName(Printer$, "Print to File: ")
  1522.         IF MC.Ky = 27 THEN EXIT DO
  1523.         IF LEN(Dir$(Printer$)) THEN
  1524.           CALL PromptLine(Printer$ + ExistPrompt$, -1)
  1525.           DO
  1526.             X = OneKey%
  1527.           LOOP UNTIL X
  1528.           IF X = 121 OR X = 89 THEN
  1529.             KILL Printer$
  1530.             EXIT DO
  1531.           END IF
  1532.         ELSE
  1533.           EXIT DO
  1534.         END IF
  1535.       LOOP
  1536.     END IF
  1537.     IF MC.Ky = 27 THEN EXIT DO               'ESC out
  1538.     CALL PromptLine("Sending line to " + Printer$, -1)
  1539.     Temp$ = PMFI$(PMF.CN, 1)            'Just one number
  1540.     IF LEN(Temp$) = 2 THEN
  1541.       Temp$ = CHR$(VAL(Temp$))
  1542.     ELSE
  1543.       DO WHILE INSTR(Temp$, "27,")      'Scan for 27's
  1544.         Temp$ = LEFT$(Temp$, INSTR(Temp$, "27,") - 1) + CHR$(27) + MID$(Temp$, INSTR(Temp$, "27,") + 3)
  1545.       LOOP
  1546.       FOR Z = 0 TO 1                    'Scan for 10,12,13 using CTRL$
  1547.         FOR Y = 1 + (3 * Z) TO 3 + (3 * Z)
  1548.           DO
  1549.             X = INSTR(Temp$, Ctrl$(Y))
  1550.             IF X THEN
  1551.               X$ = MID$(Temp$, X + Z, 2)
  1552.               Temp$ = LEFT$(Temp$, X - 1) + CHR$(VAL(X$)) + "," + MID$(Temp$, X + 3)
  1553.             ELSE
  1554.               EXIT DO
  1555.             END IF
  1556.           LOOP
  1557.         NEXT Y
  1558.       NEXT Z
  1559.     END IF
  1560.     Temp2$ = ""
  1561.     FOR X = 1 TO LEN(Temp$)             'Filter out quotes and commas
  1562.       X$ = MID$(Temp$, X, 1)
  1563.       IF X$ <> CHR$(34) AND X$ <> CHR$(44) THEN
  1564.         Temp2$ = Temp2$ + X$
  1565.       END IF
  1566.     NEXT X
  1567.     OPEN Printer$ FOR BINARY AS #2
  1568.     PUT 2, , Temp2$
  1569.     CLOSE #2
  1570. END IF
  1571. EXIT DO
  1572. LOOP
  1573. CALL ClrSc(18, 2, 18, 78, MC.No)
  1574. END SUB
  1575.  
  1576. SUB WaitTwo (Msg$)
  1577.   CALL PromptLine(Msg$, -1)
  1578.   BEEP
  1579.   T& = TIMER
  1580.   DO
  1581.   LOOP WHILE TIMER < T& + 2
  1582.   CALL ClrSc(18, 2, 18, 78, MC.No)
  1583. END SUB
  1584.  
  1585. FUNCTION YesNo%
  1586.   DO
  1587.     A% = OneKey
  1588.   LOOP UNTIL A%
  1589.   YesNo = (A% = 121) OR (A% = 89)
  1590. END FUNCTION
  1591.  
  1592.