Compile old QB4.5 code help

[AdyTT]

Hi All,

New user here. Not experienced in QB at all so be gentle :-)

I  stumbled across this forum in hope I could find a solution to my problem. I have some very old quick basic 4.5 code that I need to be able to run on Windows 10 (64 bit) operating system. QB64 seems to do the trick and I can run it no problems on my windows 10 machine.

I have successfully opened the old .bas file and converted it to readable txt from binary but when I try to compile, it complains of a syntax error.

The error is relating to a sub function that is not included in the file but is actually included in another .bas file.

How can I tell QB64 to look in another file for Subs besides the one which is open?

Summary:

I have two files

file1.bas
file2.bas

File1 will not compile to exe because of syntax error. The error is due to a sub not being found. The sub actually resides in File2. File2 compiles no problems but doesn't actually do anything as its simply a utility piece of code to support file1.

Thank you for any help

Thanks

Andy

[mpgcan]

At the end of file1.bas add the following line:

'$INCLUDE: 'file2.bas'

Additional information check wiki page http://www.qb64.org/wiki/$INCLUDE

[bplus]

Yes and if file2.bas has constants or user defined types that part of the file should be INCLUDEd at the top of file1.bas.

The top include is called a file2.BI and the bottom with the SUBs and FUNCTIONs is called file2.BM. The BI and BM extension names are not required but are conventional extension names.

[SpriggsySpriggs]

If the files don't contain personal information you can attach them to a post here and one of us would be glad to help you convert the syntax over to the modern usage.

[bplus]

What I do most of the time is just copy/paste the sub(s) or function(s) into the bas program that needs it.

I have a whole toolbox of such subs and functions = procedures. With the copy/paste method you only have one file to worry about AND you can modify the procedures to your hearts desire, worry free that modifying an include file wont mess up all the other bas programs using same include file.

bi and bm includes usually work best for a library set of procedures build around special types like formats for png and other image or sound files or API works, right @SpriggsySpriggs ? :)

[SpriggsySpriggs]

bi and bm includes usually work best for a library set of procedures build around special types like formats for png and other image or sound files or API works, right @SpriggsySpriggs ? :)

@bplus Right.
I love using BI and BM files for my APIs and other specialized functions and find that most of the time if I'm using Windows DLLs then all I need is a BM because I can put my DECLARE DYNAMIC LIBRARY right before the function so I don't need to have a BI with just the DECLARE.

[AdyTT]

If the files don't contain personal information you can attach them to a post here and one of us would be glad to help you convert the syntax over to the modern usage.

If anyone would be kind enough to convert the attached programs that would be amazing. It doesn't appear to be as straight forward as including the missing files as I originally first thought.

Attachment has 4 separate programs. The software is that old there is no concern over confidential/personal info being contained within.

Many Thanks

Andy

[SpriggsySpriggs]

I've downloaded the files and I'm going through them right now. Some variable declarations are a little wonky but so far so good.

[SpriggsySpriggs]

Hmmmm.... Apparently it will take someone more versed in TYPEs than myself.

[bplus]

I took a look at SPECEDIT added the UTIL stuff to code but all that unnecessary dot stuff drives me batty!

The first error flagged

Code: QB64: [Select]

1. Type.number$ = "~~~~~~"    
2.  

might be fixed by renaming TType.number$ = ...  , yeah that flag gone by replacing with new name (throughout the code).

Then we come to this (line 525 after I remove all redundant DECLAREs):

Code: QB64: [Select]

1.             CASE 67 'F9
2.                 Setst$ = LTRIM$(STR$(Edit.set%))
3.                 IF Ask("Are you sure you want to MAKE INDICES = LINE NUMBERS in Set " + Setst$) = YES THEN
4.                     FOR Line.number% = 1 TO Psf.numpars%(Edit.set%)
5.         Psfset(Edit.set%, Line.number%).Index = Line.number%   ' <<<<<<<< flagged
6.       NEXT Line.number%
7.  

Really use this: "Line.number%" for a FOR loop index?
Line.number% not conflicting with LINE because:

Code: QB64: [Select]

1. FOR line.number% = 1 TO 10
2.     PRINT line.number%
3. NEXT
4.  

works!

Anyway looks like a ton of naming conflicts.

This might be conflict that line 525 is flagging:

Code: QB64: [Select]

1. DIM Psfset(3, 1 TO 220) AS Psfparamtype ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  2 of same name
2. '-----------------------------------------------------------------------------
3. 'General
4. COMMON SHARED Softiss AS STRING * 2, Softdate AS STRING * 13, Printerok%
5. COMMON SHARED Type.number AS STRING * 6, Choose.done%
6. 'File operations
7. COMMON SHARED Drive$, Path$, Psf$, Psfoption$, Prev.issue AS STRING * 3
8. COMMON SHARED Fileunfound%, Fileduplicate%
9. 'File contents data
10. COMMON SHARED Psf.typeno AS STRING * 6, Psf.progiss AS STRING * 3
11. COMMON SHARED Psf.preceding AS STRING * 3, Psf.progdate AS STRING * 10
12. COMMON SHARED Psf.sourcename AS STRING * 20, Psf.sourceiss AS STRING * 5
13. COMMON SHARED Psf.sourcedate AS STRING * 10, Psf.amendrefs AS STRING * 80
14. COMMON SHARED Psf.custype AS STRING * 20, Psf.hitemp AS INTEGER
15. COMMON SHARED Psf.lotemp AS INTEGER, Psf.sermark AS INTEGER
16. COMMON SHARED Psf.history AS STRING * 80, Psf.crn AS STRING * 6
17. COMMON SHARED Psf.eng AS STRING * 10, Psf.comment1 AS STRING * 80
18. COMMON SHARED Psf.comment2 AS STRING * 80, Psf.comment3 AS STRING * 80
19. COMMON SHARED Psf.comment4 AS STRING * 80, Psf.comment5 AS STRING * 80
20. COMMON SHARED Psf.numsets AS INTEGER, Psf.numpars AS INTEGER
21. COMMON SHARED Psf.numspaces AS INTEGER, Psf.setlabel AS STRING * 20
22. COMMON SHARED Psfset AS Psfparamtype, Host AS STRING * 20 '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  2 of same name
23. '-----------------------------------------------------------------------------
24.  

good coding practice DIM variables for main code after COMMON SHARED or DIM SHARED

' whole monster!

Code: QB64: [Select]

1. '-----------------------------------------------------------------------------
2. '                           NAMING CONVENTIONS
3. '  Category............................................  Format  Example
4. 'PROCEDURES
5. '  Main procedure relating to main menu function         NNNN    TASK
6. '  Subsidiary procedure in main module                   Nn.nn   Do.task
7. '  Utility procedure                                     Nnnn    Utility
8. 'DATA
9. '  Constant                                              NNNN    FRED
10. '  General variable                                      Nnnn    Fredgen
11. '  One of a set of variables related to a subject (Fred) Nn.nn   Fred.variable
12. '  Element of variable (Fred) with user-defined type     Nn.Nn   Fred.Element
13. '
14. '      I/O PATHS
15. '      #1    Printer LPT1
16. '      #2    PSF file I/P
17. '      #3    PSF file O/P
18. '-----------------------------------------------------------------------------
19. CONST TRUE = 1, YES = 1, SETFLAG = 1
20. CONST FALSE = 0, NO = 0, RESETFLAG = 0
21. '-----------------------------------------------------------------------------
22. TYPE Psfparamtype
23.     Index AS INTEGER
24.     Label AS STRING * 24
25.     Units AS STRING * 5
26.     Lower AS SINGLE
27.     Upper AS SINGLE
28. END TYPE
29. TYPE Psfparamsttype ' String-only version for file reading
30.     Index AS STRING * 4
31.     Label AS STRING * 24
32.     Units AS STRING * 5
33.     Lower AS STRING * 9
34.     Upper AS STRING * 9
35. END TYPE
36. '-----------------------------------------------------------------------------
37. DIM Psf.numpars(3) AS INTEGER, Psf.setlabel(3) AS STRING * 20
38. DIM Psfset(3, 1 TO 220) AS Psfparamtype ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  2 of same name
39. '-----------------------------------------------------------------------------
40. 'General
41. COMMON SHARED Softiss AS STRING * 2, Softdate AS STRING * 13, Printerok%
42. COMMON SHARED Type.number AS STRING * 6, Choose.done%
43. 'File operations
44. COMMON SHARED Drive$, Path$, Psf$, Psfoption$, Prev.issue AS STRING * 3
45. COMMON SHARED Fileunfound%, Fileduplicate%
46. 'File contents data
47. COMMON SHARED Psf.typeno AS STRING * 6, Psf.progiss AS STRING * 3
48. COMMON SHARED Psf.preceding AS STRING * 3, Psf.progdate AS STRING * 10
49. COMMON SHARED Psf.sourcename AS STRING * 20, Psf.sourceiss AS STRING * 5
50. COMMON SHARED Psf.sourcedate AS STRING * 10, Psf.amendrefs AS STRING * 80
51. COMMON SHARED Psf.custype AS STRING * 20, Psf.hitemp AS INTEGER
52. COMMON SHARED Psf.lotemp AS INTEGER, Psf.sermark AS INTEGER
53. COMMON SHARED Psf.history AS STRING * 80, Psf.crn AS STRING * 6
54. COMMON SHARED Psf.eng AS STRING * 10, Psf.comment1 AS STRING * 80
55. COMMON SHARED Psf.comment2 AS STRING * 80, Psf.comment3 AS STRING * 80
56. COMMON SHARED Psf.comment4 AS STRING * 80, Psf.comment5 AS STRING * 80
57. COMMON SHARED Psf.numsets AS INTEGER, Psf.numpars AS INTEGER
58. COMMON SHARED Psf.numspaces AS INTEGER, Psf.setlabel AS STRING * 20
59. COMMON SHARED Psfset AS Psfparamtype, Host AS STRING * 20 '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  2 of same name
60. '-----------------------------------------------------------------------------
61. 'SPECIFICATION EDITOR PROGRAM - SPECEDIT.BAS    S J Oxley
62. Softiss$ = "5 ": Softdate$ = "- 08/11/04"
63. 'REVISION RECORD:
64. '..DATE....ISSUE......................REVISION DETAILS..................
65. '25/01/99   1     FIRST ISSUE - Archived as SPECED01.BAS + UTILS02.BAS
66. '22/02/99  (1)    Added choice of Template File in CHOOSE, F9 & F10 functions
67. '                 on editor P.2 (default indices & copy set)
68. '13/10/99   2     Added clearance of unused parameter sets when loading a PSF
69. '                 with fewer parameter sets than the previous PSF.
70. '                 Cleared Print.tol format bug; Label/Units trailing spaces.
71. '                 Archived as SPECED02.BAS
72. '19/10/99  (2)    Added default drive selection using OPTIONH.PSF file.
73. '14/01/00  (2)    Changed Filename$ to Psf$ when saving edited PSF at end of
74. '                 EDIT. The global Psf$ is now updated when changing class.
75. '28/02/00  (2)    Removal of F7 option.
76. '04/06/03   3     Default drive and paths set to T and \TEST\SPECS.
77. '02/09/03   4     Index as STRING * 3 changed to * 4.
78. '                 Changed to allow for index>100 " 100" is 4 CHRs.
79. '                 Changed default drive and paths back to C and \BLP\SPECS.
80. '07/11/04   5     Changed DIM Psfset(3,1 TO 200) to 220 to get more parameters.
81. '-----------------------------------------------------------------------------
82. OPEN "LPT1" FOR OUTPUT AS #1
83. ON ERROR GOTO Errhandler
84. LOCATE 2
85. CALL Show.bars
86. CLS 2
87. CALL Init.vars
88. Stay% = YES
89. WHILE Stay% = YES
90.     ON KEY(1) GOSUB Callchoose
91.     ON KEY(2) GOSUB Calledit
92.     ON KEY(3) GOSUB Calltolerance
93.     ON KEY(4) GOSUB Callhistory
94.     ON KEY(8) GOSUB Quit
95.     LOCATE 2
96.     CALL Show.bars
97.     CLS 2
98.     LOCATE 3, 28: PRINT "MAIN MENU"
99.     LOCATE 4, 28: PRINT "========="
100.     LOCATE 7, 28: PRINT "F1. CHOOSE    ";: COLOR 7: PRINT "  - Set directory, file & options": COLOR 6: IF Choose.done% = YES THEN COLOR 15
101.     LOCATE 8, 28: PRINT "F2. EDIT      ";: COLOR 7: PRINT "  - Edit spec data": COLOR 6: IF Choose.done% = YES THEN COLOR 15
102.     LOCATE 9, 28: PRINT "F3. TOLERANCE ";: COLOR 7: PRINT "  - View / print tolerances": COLOR 6: IF Choose.done% = YES AND Psfoption$ = "CURRENT" THEN COLOR 15
103.     LOCATE 10, 28: PRINT "F4. HISTORY   ";: COLOR 7: PRINT "  - View / print history": COLOR 11
104.     LOCATE 12, 28: PRINT "F8. QUIT      ";: COLOR 7: PRINT "  - Exit": COLOR 15
105.     FOR S = 1 TO 4
106.         KEY(S) ON
107.     NEXT S
108.     KEY(8) ON
109.     Continue% = NO
110.     DO
111.         DO
112.             IF Continue% = YES THEN EXIT DO
113.         LOOP WHILE INKEY$ = ""
114.         IF Continue% = YES THEN EXIT DO
115.     LOOP
116. WEND
117. VIEW PRINT 1 TO 25: COLOR 15, 0
118. CLS 2
119. END
120. '-----------------------------------------------------------------------------
121. Keysoff: 'De-activate main menu softkeys
122. FOR S = 1 TO 4
123.     KEY(S) OFF
124. NEXT S
125. KEY(8) OFF
126. RETURN
127. Callchoose: GOSUB Keysoff: CALL CHOOSE: Continue% = YES: RETURN
128. Calledit: GOSUB Keysoff: CALL EDIT: Continue% = YES: RETURN
129. Calltolerance: GOSUB Keysoff: CALL TOLERANCE: Continue% = YES: RETURN
130. Callhistory: GOSUB Keysoff: CALL HISTORY: Continue% = YES: RETURN
131. Quit: GOSUB Keysoff: Stay% = NO: Continue% = YES: RETURN
132. Errhandler: '------------------------------------------------------------------
133. SELECT CASE ERR
134.     CASE 25, 27
135.         SOUND 1000, 10
136.         CALL State("PRINTER NOT READY - Check paper loaded & on-line, then press any key.")
137.     CASE 53, 64, 76
138.         Fileunfound% = TRUE
139.         RESUME NEXT
140.     CASE 58
141.         Fileduplicate% = TRUE
142.         RESUME NEXT
143.     CASE 61, 72
144.         SOUND 1500, 5
145.         CALL State("DISK FULL OR BAD - Replace disk, then press any key.")
146.     CASE 71
147.         SOUND 1500, 5
148.         CALL State("DISK WRITE-PROTECTED - Replace or unprotect disk, then press any key.")
149.     CASE ELSE
150.         'SOUND 800, 15
151.         Message$ = "ERROR NUMBER " + STR$(ERR)
152.         CALL State(Message$)
153. END SELECT
154. CALL Waitkey
155. CALL State(SPACE$(80))
156. IF (ERR = 25 OR ERR = 27) THEN
157.     IF Ask%("Do you want to ABANDON PRINT") = YES THEN
158.         Printerok% = NO
159.         RESUME NEXT
160.     END IF
161. END IF
162. RESUME
163.  
164. DEFSNG A-Z
165. SUB CHOOSE
166.     CALL Edit.setup
167.     Pathname$ = Drive$ + ":" + Path$ + Psf$
168.     Fileunfound% = RESETFLAG
169.     OPEN Pathname$ FOR INPUT AS #2
170.     IF Fileunfound% = NO THEN
171.         CALL Read.psf
172.         CLOSE #2
173.         Choose.done% = YES
174.     ELSE
175.         IF Psfoption$ = "PREVIOUS" THEN
176.             PRINT "FAILED TO FIND PREVIOUS PSF "; Pathname$; ". Press any key."
177.             CALL Waitkey
178.         ELSEIF Ask%("This PSF does not exist. Do you want to CREATE NEW PSF") = YES THEN
179.             State ("Just press ENTER FOR DEFAULT - C:\BLP\SPECS\SPECEDIT.PSF")
180.             LOCATE 23: LINE INPUT ; "Enter TEMPLATE FILE pathname - "; Entry$
181.             IF Entry$ = "" THEN
182.                 Pathname$ = "C:\BLP\SPECS\SPECEDIT.PSF"
183.             ELSE
184.                 Pathname$ = UCASE$(LTRIM$(RTRIM$(Entry$)))
185.             END IF
186.             Fileunfound% = RESETFLAG
187.             OPEN Pathname$ FOR INPUT AS #2
188.             IF Fileunfound% = NO THEN
189.                 CALL Read.psf
190.                 CLOSE #2
191.                 Psf.typeno$ = "******"
192.                 Psf.preceding$ = "*"
193.                 Choose.done% = YES
194.             ELSE
195.                 State ("Could not find " + Pathname$ + " Press any key.")
196.                 Waitkey
197.             END IF
198.         END IF
199.     END IF
200. END SUB
201.  
202. SUB EDIT
203.     IF Choose.done% = NO THEN
204.         SOUND 300, 4
205.         CALL State("Working file not specified yet; select CHOOSE first. Press any key.")
206.         CALL Waitkey
207.         EXIT SUB
208.     END IF
209.     CLS 2
210.     Issue.raised% = NO
211.     IF Psfoption$ = "CURRENT" THEN
212.         IF Psf.typeno$ = "******" THEN 'New PSF
213.             Valid% = NO
214.             WHILE Valid% = NO
215.                 CALL State("The issue must be a valid DOS filename extension.")
216.                 LOCATE 23, 1: PRINT SPACE$(80);
217.                 LOCATE 23, 1: LINE INPUT "Enter the FIRST ISSUE (up to 3 characters), or ENTER for A - "; New.iss$
218.                 IF New.iss$ = "" THEN New.iss$ = "A"
219.                 New.iss$ = LEFT$(New.iss$, 3)
220.                 IF Dosvalid%(New.iss$) = YES THEN
221.                     Valid% = YES
222.                 ELSE
223.                     SOUND 300, 4
224.                 END IF
225.             WEND
226.             Psf.progiss$ = New.iss$
227.             Psf.preceding$ = "*"
228.         ELSE
229.             Stay% = YES
230.             WHILE Stay% = YES
231.                 CALL State("If you up-issue, the loaded CURRENT PSF is first archived as a PREVIOUS PSF.")
232.                 IF Ask%("Are you CHANGING THE ISSUE of the test program & PSF") = YES THEN
233.                     Valid% = NO
234.                     WHILE Valid% = NO
235.                         CALL State("Current issue is " + Psf.progiss$ + ". The issue must be a valid DOS filename extension.")
236.                         LOCATE 23, 1: PRINT SPACE$(80);
237.                         LOCATE 23, 1: LINE INPUT "Enter the NEW ISSUE (up to 3 characters): "; New.iss$
238.                         New.iss$ = LEFT$(New.iss$, 3)
239.                         IF Dosvalid%(New.iss$) = YES THEN
240.                             Valid% = YES
241.                         ELSE
242.                             SOUND 300, 4
243.                         END IF
244.                     WEND
245.                     CALL State("About to change issue from " + Psf.progiss$ + " to " + New.iss$)
246.                     IF Ask%("Are you sure you want to CHANGE ISSUE NOW") = YES THEN
247.                         Filename$ = TType.number$ + "P." + Psf.progiss$
248.                         OPEN Drive$ + ":" + Path$ + Filename$ FOR OUTPUT AS #3
249.                         CALL Write.psf
250.                         CLOSE #3
251.                         Issue.raised% = YES
252.                         Psf.preceding$ = Psf.progiss$
253.                         Psf.progiss$ = New.iss$
254.                         Stay% = NO
255.                     END IF
256.                 ELSE
257.                     Stay% = NO
258.                 END IF
259.             WEND
260.         END IF
261.     END IF
262.     CALL Show.bars
263.     COLOR , 4
264.     Pageno% = 1
265.     Stay% = YES
266.     WHILE Stay% = YES
267.         SELECT CASE Pageno%
268.             CASE 0
269.                 Stay% = NO
270.             CASE 1
271.                 CALL Edit.head1(Pageno%)
272.                 Edit.set% = 0: Edit.line% = 1: Copy.set% = 1
273.             CASE 2
274.                 CALL Edit.head2(Pageno%, Edit.set%, Edit.line%, Copy.set%)
275.             CASE 3
276.                 CALL Edit.param(Pageno%, Edit.set%, Edit.line%)
277.         END SELECT
278.     WEND
279.     CLS 2
280.     Save.file% = YES
281.     IF Issue.raised% = NO THEN
282.         CALL State("You can either save the edited PSF or quit without saving & lose any edits.")
283.         IF Psfoption$ = "PREVIOUS" THEN
284.             Question$ = "Do you wish to SAVE THE EDITED PREVIOUS PSF AS HYPOTHETICAL"
285.         ELSE
286.             Question$ = "Do you wish to SAVE THE EDITED PSF"
287.         END IF
288.         IF Ask%(Question$) = NO THEN
289.             Save.file% = NO
290.         ELSE
291.             IF Psfoption$ = "PREVIOUS" THEN Psfoption$ = "HYPOTHETICAL"
292.             IF Psfoption$ = "CURRENT" THEN
293.                 CALL State("You can either save as CURRENT PSF (same issue) or convert to HYPOTHETICAL.")
294.                 IF Ask("Do you wish to SAVE AS CURRENT PSF") = NO THEN Psfoption$ = "HYPOTHETICAL"
295.             END IF
296.         END IF
297.     END IF
298.     IF Save.file% = YES THEN
299.         Psf$ = TType.number$ + LEFT$(Psfoption$, 1) + ".PSF"
300.         OPEN Drive$ + ":" + Path$ + Psf$ FOR OUTPUT AS #3
301.         CALL Write.psf
302.         CLOSE #3
303.     END IF
304. END SUB
305.  
306. SUB Edit.head1 (Pageno%)
307.     'Move cursor around first header screen and edit data
308.     STATIC Hitempst AS STRING * 3
309.     STATIC Lotempst AS STRING * 3
310.     STATIC Sermarkst AS STRING * 1
311.     Lineno% = 4
312.     Stay% = YES
313.     WHILE Stay% = YES
314.         CALL Show.head1
315.         IF Lineno% = 12 OR Lineno% = 18 THEN
316.             Colno% = 1
317.         ELSE
318.             Colno% = 30
319.         END IF
320.         LOCATE Lineno%, Colno%
321.         SELECT CASE Lineno%
322.             CASE 4
323.                 CALL Line.edit(Psf.typeno$, 6, Exit.code%)
324.             CASE 7
325.                 CALL Line.edit(Psf.progdate$, 10, Exit.code%)
326.             CASE 8
327.                 CALL Line.edit(Psf.sourcename$, 20, Exit.code%)
328.             CASE 9
329.                 CALL Line.edit(Psf.sourceiss$, 5, Exit.code%)
330.             CASE 10
331.                 CALL Line.edit(Psf.sourcedate$, 10, Exit.code%)
332.             CASE 12
333.                 CALL Line.edit(Psf.amendrefs$, 80, Exit.code%)
334.             CASE 13
335.                 CALL Line.edit(Psf.custype$, 20, Exit.code%)
336.             CASE 14
337.                 Hitempst$ = LTRIM$(STR$(Psf.hitemp%))
338.                 CALL Line.edit(Hitempst$, 3, Exit.code%)
339.                 Entry% = VAL(Hitempst$)
340.                 IF Entry% = 999 THEN
341.                     Psf.hitemp% = Entry%
342.                 ELSE
343.                     IF Checkint%(Entry%, 23, 200) = YES THEN Psf.hitemp% = Entry%
344.                 END IF
345.             CASE 15
346.                 Lotempst$ = LTRIM$(STR$(Psf.lotemp%))
347.                 CALL Line.edit(Lotempst$, 3, Exit.code%)
348.                 Entry% = VAL(Lotempst$)
349.                 IF Entry% = 999 THEN
350.                     Psf.lotemp% = Entry%
351.                 ELSE
352.                     IF Checkint%(Entry%, -99, 23) = YES THEN Psf.lotemp% = Entry%
353.                 END IF
354.             CASE 16
355.                 Sermarkst$ = LTRIM$(STR$(Psf.sermark%))
356.                 CALL Line.edit(Sermarkst$, 1, Exit.code%)
357.                 Entry% = VAL(Sermarkst$)
358.                 IF Checkint%(Entry%, 0, 1) = YES THEN Psf.sermark% = Entry%
359.             CASE 18
360.                 CALL Line.edit(Psf.history$, 80, Exit.code%)
361.             CASE 19
362.                 CALL Line.edit(Psf.crn$, 6, Exit.code%)
363.             CASE 20
364.                 CALL Line.edit(Psf.eng$, 10, Exit.code%)
365.         END SELECT
366.         SELECT CASE Exit.code%
367.             CASE 9, 80, 13 'TAB, Down, ENTER
368.                 SELECT CASE Lineno%
369.                     CASE 4
370.                         Lineno% = Lineno% + 3
371.                     CASE 10, 16
372.                         Lineno% = Lineno% + 2
373.                     CASE 20
374.                     CASE ELSE
375.                         Lineno% = Lineno% + 1
376.                 END SELECT
377.             CASE 15, 72 'Shift TAB, Up
378.                 SELECT CASE Lineno%
379.                     CASE 4
380.                     CASE 7
381.                         Lineno% = Lineno% - 3
382.                     CASE 12, 18
383.                         Lineno% = Lineno% - 2
384.                     CASE ELSE
385.                         Lineno% = Lineno% - 1
386.                 END SELECT
387.             CASE 71 'Home
388.                 Lineno% = 4
389.             CASE 79 'End
390.                 Lineno% = 20
391.             CASE 81 'Pg Down
392.                 Pageno% = 2
393.                 Stay% = NO
394.             CASE 73 'Pg Up
395.             CASE 27 'ESC
396.                 Pageno% = 0
397.                 Stay% = NO
398.         END SELECT
399.     WEND
400. END SUB
401.  
402. SUB Edit.head2 (Pageno%, Edit.set%, Edit.line%, Copy.set%)
403.     'Move cursor around second header screen and edit data
404.     STATIC Numparsst AS STRING * 3
405.     STATIC Numspacesst AS STRING * 3
406.     STATIC Setst AS STRING * 1
407.     STATIC Linest AS STRING * 3
408.     STATIC Copysetst AS STRING * 1
409.     Lineno% = 5
410.     Stay% = YES
411.     WHILE Stay% = YES
412.         CALL Show.head2(Edit.set%, Edit.line%, Copy.set%)
413.         IF Lineno% < 10 THEN
414.             Colno% = 1
415.         ELSE
416.             Colno% = 30
417.         END IF
418.         LOCATE Lineno%, Colno%
419.         SELECT CASE Lineno%
420.             CASE 5
421.                 CALL Line.edit(Psf.comment1$, 80, Exit.code%)
422.             CASE 6
423.                 CALL Line.edit(Psf.comment2$, 80, Exit.code%)
424.             CASE 7
425.                 CALL Line.edit(Psf.comment3$, 80, Exit.code%)
426.             CASE 8
427.                 CALL Line.edit(Psf.comment4$, 80, Exit.code%)
428.             CASE 9
429.                 CALL Line.edit(Psf.comment5$, 80, Exit.code%)
430.             CASE 11
431.                 CALL Line.edit(Psf.setlabel$(0), 20, Exit.code%)
432.             CASE 12
433.                 Numparsst$ = LTRIM$(STR$(Psf.numpars%(0)))
434.                 CALL Line.edit(Numparsst$, 3, Exit.code%)
435.                 Entry% = VAL(Numparsst$)
436.                 IF Checkint%(Entry%, 1, Psf.numspaces%) = YES THEN Psf.numpars%(0) = Entry%
437.             CASE 13
438.                 CALL Line.edit(Psf.setlabel$(1), 20, Exit.code%)
439.             CASE 14
440.                 Numparsst$ = LTRIM$(STR$(Psf.numpars%(1)))
441.                 CALL Line.edit(Numparsst$, 3, Exit.code%)
442.                 Entry% = VAL(Numparsst$)
443.                 IF Checkint%(Entry%, 0, Psf.numspaces%) = YES THEN Psf.numpars%(1) = Entry%
444.             CASE 15
445.                 CALL Line.edit(Psf.setlabel$(2), 20, Exit.code%)
446.             CASE 16
447.                 Numparsst$ = LTRIM$(STR$(Psf.numpars%(2)))
448.                 CALL Line.edit(Numparsst$, 3, Exit.code%)
449.                 Entry% = VAL(Numparsst$)
450.                 IF Checkint%(Entry%, 0, Psf.numspaces%) = YES THEN Psf.numpars%(2) = Entry%
451.             CASE 17
452.                 CALL Line.edit(Psf.setlabel$(3), 20, Exit.code%)
453.             CASE 18
454.                 Numparsst$ = LTRIM$(STR$(Psf.numpars%(3)))
455.                 CALL Line.edit(Numparsst$, 3, Exit.code%)
456.                 Entry% = VAL(Numparsst$)
457.                 IF Checkint%(Entry%, 0, Psf.numspaces%) = YES THEN Psf.numpars%(3) = Entry%
458.             CASE 19
459.                 Numspacesst$ = LTRIM$(STR$(Psf.numspaces%))
460.                 CALL Line.edit(Numspacesst$, 3, Exit.code%)
461.                 Entry% = VAL(Numspacesst$)
462.                 IF Checkint%(Entry%, 1, 220) = YES THEN Psf.numspaces% = Entry%
463.             CASE 21
464.                 Setst$ = LTRIM$(STR$(Edit.set%))
465.                 CALL Line.edit(Setst$, 1, Exit.code%)
466.                 Entry% = VAL(Setst$)
467.                 IF Checkint%(Entry%, 0, Psf.numsets%) = YES THEN Edit.set% = Entry%
468.             CASE 22
469.                 Linest$ = LTRIM$(STR$(Edit.line%))
470.                 CALL Line.edit(Linest$, 3, Exit.code%)
471.                 Entry% = VAL(Linest$)
472.                 IF Checkint%(Entry%, 1, 220) = YES THEN Edit.line% = Entry%
473.             CASE 23
474.                 Copysetst$ = LTRIM$(STR$(Copy.set%))
475.                 CALL Line.edit(Copysetst$, 1, Exit.code%)
476.                 Entry% = VAL(Copysetst$)
477.                 IF Checkint%(Entry%, 0, Psf.numsets%) = YES THEN Copy.set% = Entry%
478.         END SELECT
479.         SELECT CASE Exit.code%
480.             CASE 9, 80, 13 'TAB, Down, ENTER
481.                 SELECT CASE Lineno%
482.                     CASE 9, 19
483.                         Lineno% = Lineno% + 2
484.                     CASE 14
485.                         Lineno% = 15: IF Psf.numpars%(1) = 0 THEN Lineno% = 19
486.                     CASE 16
487.                         Lineno% = 17: IF Psf.numpars%(2) = 0 THEN Lineno% = 19
488.                     CASE 23
489.                     CASE ELSE
490.                         Lineno% = Lineno% + 1
491.                 END SELECT
492.             CASE 15, 72 'Shift TAB, Up
493.                 SELECT CASE Lineno%
494.                     CASE 5
495.                     CASE 11, 21
496.                         Lineno% = Lineno% - 2
497.                     CASE 19
498.                         IF Psf.numpars%(1) = 0 THEN
499.                             Lineno% = 14
500.                         ELSEIF Psf.numpars%(2) = 0 THEN
501.                             Lineno% = 16
502.                         ELSE
503.                             Lineno% = 18
504.                         END IF
505.                     CASE ELSE
506.                         Lineno% = Lineno% - 1
507.                 END SELECT
508.             CASE 71 'Home
509.                 Lineno% = 5
510.             CASE 79 'End
511.                 Lineno% = 23
512.             CASE 73 'Pg Up
513.                 Pageno% = 1
514.                 Stay% = NO
515.             CASE 81 'Pg Down
516.                 Pageno% = 3
517.                 Stay% = NO
518.             CASE 27 'ESC
519.                 Pageno% = 0
520.                 Stay% = NO
521.             CASE 67 'F9
522.                 Setst$ = LTRIM$(STR$(Edit.set%))
523.                 IF Ask("Are you sure you want to MAKE INDICES = LINE NUMBERS in Set " + Setst$) = YES THEN
524.                     FOR Line.number% = 1 TO Psf.numpars%(Edit.set%)
525.         Psfset(Edit.set%, Line.number%).Index = Line.number%
526.       NEXT Line.number%
527.     END IF
528.     COLOR , 4
529.   CASE 68  'F10
530.     IF Copy.set% <> Edit.set% THEN
531.       Setst$ = LTRIM$(STR$(Edit.set%))
532.       Copysetst$ = LTRIM$(STR$(Copy.set%))
533.       IF Ask("Are you sure you want to COPY SET " + Setst$ + " TO SET " + Copysetst$) = YES THEN
534.         Psf.numpars%(Copy.set%) = Psf.numpars%(Edit.set%)
535.         FOR Line.number% = 1 TO Psf.numpars%(Edit.set%)
536.           Psfset(Copy.set%, Line.number%).Index = Psfset(Edit.set%, Line.number%).Index
537.           Psfset(Copy.set%, Line.number%).Label = Psfset(Edit.set%, Line.number%).Label
538.           Psfset(Copy.set%, Line.number%).Units = Psfset(Edit.set%, Line.number%).Units
539.           Psfset(Copy.set%, Line.number%).Lower = Psfset(Edit.set%, Line.number%).Lower
540.           Psfset(Copy.set%, Line.number%).Upper = Psfset(Edit.set%, Line.number%).Upper
541.         NEXT Line.number%
542.       END IF
543.     END IF
544.     COLOR , 4
545.   END SELECT
546.   IF Psf.numpars%(1) = 0 THEN
547.     Psf.numpars%(2) = 0
548.     Psf.numpars%(3) = 0
549.     Psf.numsets% = 1
550.   ELSEIF Psf.numpars%(2) = 0 THEN
551.     Psf.numpars%(3) = 0
552.     Psf.numsets% = 2
553.   ELSEIF Psf.numpars%(3) = 0 THEN
554.     Psf.numsets% = 3
555.   ELSE
556.     Psf.numsets% = 4
557.   END IF
558.   IF Edit.set% > Psf.numsets% THEN Edit.set% = Psf.numsets%
559.   IF Copy.set% > Psf.numsets% THEN Copy.set% = Psf.numsets%
560. WEND
561. IF Edit.set% > Psf.numsets% - 1 THEN Edit.set% = Psf.numsets% - 1
562. END SUB
563.  
564. SUB Edit.param (Pageno%, Edit.set%, Edit.line%)
565. 'Scroll and edit parameter data
566. STATIC Indexst AS STRING * 3
567. STATIC Lowerst AS STRING * 10
568. STATIC Upperst AS STRING * 10
569. Colno% = 7
570. Stay% = YES
571. IF Psf.numpars%(Edit.set%) = 0 THEN
572.   Pageno% = 2
573.   Stay% = NO
574. END IF
575. WHILE Stay% = YES
576.   CALL Show.param(Edit.set%, Edit.line%)
577.   LOCATE 14, Colno%
578.   SELECT CASE Colno%
579.   CASE 7
580.     Indexst$ = LTRIM$(STR$(Psfset(Edit.set%, Edit.line%).Index))
581.     CALL Line.edit(Indexst$, 3, Exit.code%)
582.     Entry% = VAL(Indexst$)
583.     Unique% = YES
584.     FOR Line.number% = 1 TO Psf.numpars%(Edit.set%)
585.       IF Line.number% <> Edit.line% THEN
586.         IF Psfset(Edit.set%, Line.number%).Index = Entry% THEN Unique% = NO
587.       END IF
588.     NEXT Line.number%
589.     IF Unique% = YES THEN
590.       Psfset(Edit.set%, Edit.line%).Index = Entry%
591.     ELSE
592.       SOUND 300, 4: COLOR , 4: LOCATE 23, 1: PRINT "INDEX"; Entry%; "ALREADY USED! Indices must be unique within each set. Press any key.";
593.       CALL Waitkey
594.       Exit.code% = 0
595.     END IF
596.   CASE 13
597.     CALL Line.edit(Psfset(Edit.set%, Edit.line%).Label, 24, Exit.code%)
598.   CASE 40
599.     CALL Line.edit(Psfset(Edit.set%, Edit.line%).Units, 5, Exit.code%)
600.   CASE 48
601.     Lowerst$ = LTRIM$(STR$(Psfset(Edit.set%, Edit.line%).Lower))
602.     CALL Line.edit(Lowerst$, 10, Exit.code%)
603.     Entry.real! = VAL(Lowerst$)
604.     IF Entry.real! < -9999.999 THEN Entry.real! = -9999.999
605.     IF Entry.real! > 9999.999 THEN Entry.real! = 9999.999
606.     Hilim! = Psfset(Edit.set%, Edit.line%).Upper
607.     IF Checkreal%(Entry.real!, -9999.999, Hilim!) = YES THEN
608.       Psfset(Edit.set%, Edit.line%).Lower = Entry.real!
609.     ELSE
610.       IF Exit.code% = 9 OR Exit.code% = 13 THEN
611.         Psfset(Edit.set%, Edit.line%).Lower = Entry.real!
612.       ELSE
613.         SOUND 300, 4: COLOR , 4: LOCATE 23, 1: PRINT "LIMITS OUT OF RANGE! (-/+9999.999 and LOWER < UPPER). Press any key.";
614.         CALL Waitkey
615.         Exit.code% = 0
616.       END IF
617.     END IF
618.   CASE 61
619.     Upperst$ = LTRIM$(STR$(Psfset(Edit.set%, Edit.line%).Upper))
620.     CALL Line.edit(Upperst$, 10, Exit.code%)
621.     Entry.real! = VAL(Upperst$)
622.     IF Entry.real! < -9999.999 THEN Entry.real! = -9999.999
623.     IF Entry.real! > 9999.999 THEN Entry.real! = 9999.999
624.     Lolim! = Psfset(Edit.set%, Edit.line%).Lower
625.     IF Checkreal%(Entry.real!, Lolim!, 9999.999) = YES THEN
626.       Psfset(Edit.set%, Edit.line%).Upper = Entry.real!
627.     ELSE
628.       IF Exit.code% = 15 THEN
629.         Psfset(Edit.set%, Edit.line%).Upper = Entry.real!
630.       ELSE
631.         SOUND 300, 4: COLOR , 4: LOCATE 23, 1: PRINT "LIMITS OUT OF RANGE! (-/+9999.999 and LOWER < UPPER). Press any key.";
632.         CALL Waitkey
633.         Exit.code% = 0
634.       END IF
635.     END IF
636.   END SELECT
637.   SELECT CASE Exit.code%
638.   CASE 0
639.   CASE 9, 13  'TAB, ENTER
640.     IF Colno% < 13 THEN
641.       Colno% = 13
642.     ELSEIF Colno% < 40 THEN
643.       Colno% = 40
644.     ELSEIF Colno% < 48 THEN
645.       Colno% = 48
646.     ELSEIF Colno% < 61 THEN
647.       Colno% = 61
648.     END IF
649.   CASE 15  'Shift TAB
650.     IF Colno% >= 61 THEN
651.       Colno% = 48
652.     ELSEIF Colno% >= 48 THEN
653.       Colno% = 40
654.     ELSEIF Colno% >= 40 THEN
655.       Colno% = 13
656.     ELSEIF Colno% >= 13 THEN
657.       Colno% = 7
658.     END IF
659.   CASE 80  'Down
660.     IF Edit.line% < Psf.numpars%(Edit.set%) THEN Edit.line% = Edit.line% + 1
661.   CASE 72  'Up
662.     IF Edit.line% > 1 THEN Edit.line% = Edit.line% - 1
663.   CASE 71  'Home
664.     Edit.line% = 1
665.   CASE 79  'End
666.     Edit.line% = Psf.numpars%(Edit.set%)
667.   CASE 67  'F9
668.     IF Psf.numpars%(Edit.set%) < Psf.numspaces% THEN
669.       FOR Line.number% = Psf.numpars%(Edit.set%) TO Edit.line% STEP -1
670.         Psfset(Edit.set%, (Line.number% + 1)).Index = Psfset(Edit.set%, Line.number%).Index
671.         Psfset(Edit.set%, (Line.number% + 1)).Label = Psfset(Edit.set%, Line.number%).Label
672.         Psfset(Edit.set%, (Line.number% + 1)).Units = Psfset(Edit.set%, Line.number%).Units
673.         Psfset(Edit.set%, (Line.number% + 1)).Lower = Psfset(Edit.set%, Line.number%).Lower
674.         Psfset(Edit.set%, (Line.number% + 1)).Upper = Psfset(Edit.set%, Line.number%).Upper
675.       NEXT Line.number%
676.       Psfset(Edit.set%, Edit.line%).Index = 0
677.       Psfset(Edit.set%, Edit.line%).Label = ""
678.       Psfset(Edit.set%, Edit.line%).Units = ""
679.       Psfset(Edit.set%, Edit.line%).Lower = 0
680.       Psfset(Edit.set%, Edit.line%).Upper = 0
681.       Psf.numpars%(Edit.set%) = Psf.numpars%(Edit.set%) + 1
682.     ELSE
683.       SOUND 300, 4: COLOR , 4: LOCATE 23: PRINT "NO SPACE to insert new parameter! Increase TRF record size first. Press any key.";
684.       CALL Waitkey
685.     END IF
686.   CASE 68  'F10
687.     IF Ask("Are you sure you want to DELETE THIS LINE") = YES THEN
688.       IF Edit.line% < Psf.numpars%(Edit.set%) THEN
689.         FOR Line.number% = Edit.line% + 1 TO Psf.numpars%(Edit.set%)
690.           Psfset(Edit.set%, (Line.number% - 1)).Index = Psfset(Edit.set%, Line.number%).Index
691.           Psfset(Edit.set%, (Line.number% - 1)).Label = Psfset(Edit.set%, Line.number%).Label
692.           Psfset(Edit.set%, (Line.number% - 1)).Units = Psfset(Edit.set%, Line.number%).Units
693.           Psfset(Edit.set%, (Line.number% - 1)).Lower = Psfset(Edit.set%, Line.number%).Lower
694.           Psfset(Edit.set%, (Line.number% - 1)).Upper = Psfset(Edit.set%, Line.number%).Upper
695.         NEXT Line.number%
696.       END IF
697.       Psfset(Edit.set%, Psf.numpars%(Edit.set%)).Index = 0
698.       Psfset(Edit.set%, Psf.numpars%(Edit.set%)).Label = ""
699.       Psfset(Edit.set%, Psf.numpars%(Edit.set%)).Units = ""
700.       Psfset(Edit.set%, Psf.numpars%(Edit.set%)).Lower = 0
701.       Psfset(Edit.set%, Psf.numpars%(Edit.set%)).Upper = 0
702.       Psf.numpars%(Edit.set%) = Psf.numpars%(Edit.set%) - 1
703.       IF Psf.numpars%(Edit.set%) = 0 THEN
704.         Pageno% = 2
705.         Stay% = NO
706.       END IF
707.     END IF
708.     COLOR , 4
709.   CASE 73  'Pg Up
710.     Pageno% = 2
711.     Stay% = NO
712.   CASE 81  'Pg Down
713.   CASE 27  'ESC
714.     Pageno% = 0
715.     Stay% = NO
716.   END SELECT
717. WEND
718. END SUB
719.  
720. SUB Edit.setup
721. 'Move cursor around setup screen and edit data
722. Prev.issue$ = "1  "
723. Lineno% = 9
724. Stay% = YES
725. WHILE Stay% = YES
726.   CALL Show.bars
727.   CALL Show.setup
728.   LOCATE Lineno%, 20
729.   SELECT CASE Lineno%
730.   CASE 7
731.     CALL Line.edit(Drive$, 1, Exit.code%)
732.     Drive$ = UCASE$(LEFT$(Drive$, 1))
733.   CASE 8
734.     CALL Line.edit(Path$, 40, Exit.code%)
735.     Path$ = UCASE$(LTRIM$(RTRIM$(Path$)))
736.     IF LEFT$(Path$, 1) <> "\" THEN Path$ = "\" + Path$
737.     IF RIGHT$(Path$, 1) <> "\" THEN Path$ = Path$ + "\"
738.   CASE 9
739.     CALL Line.edit(TType.number$, 6, Exit.code%)
740.   CASE 10
741.     Option$ = LEFT$(Psfoption$, 1)
742.     CALL Line.edit(Option$, 1, Exit.code%)
743.     Option$ = UCASE$(Option$)
744.     SELECT CASE Option$
745.     CASE "C"
746.       Psfoption$ = "CURRENT"
747.     CASE "P"
748.       Psfoption$ = "PREVIOUS"
749.     CASE "H"
750.       Psfoption$ = "HYPOTHETICAL"
751.     END SELECT
752.   CASE 11
753.     Edit.prev.issue$ = Prev.issue$
754.     CALL Line.edit(Edit.prev.issue$, 3, Exit.code%)
755.     IF Dosvalid%(Edit.prev.issue$) = YES THEN Prev.issue$ = Edit.prev.issue$
756.   END SELECT
757.   SELECT CASE Exit.code%
758.   CASE 80, 13  'Down, ENTER
759.     IF Lineno% < 10 THEN Lineno% = Lineno% + 1
760.     IF Lineno% = 10 AND Psfoption$ = "PREVIOUS" THEN Lineno% = 11
761.   CASE 72  'Up
762.     IF Lineno% > 7 THEN Lineno% = Lineno% - 1
763.   CASE 71  'Home
764.     Lineno% = 7
765.   CASE 79  'End
766.     IF Psfoption$ = "PREVIOUS" THEN
767.       Lineno% = 11
768.     ELSE
769.       Lineno% = 10
770.     END IF
771.   CASE 81, 73 'Pg Down, Pg Up
772.   CASE 27  'ESC
773.     Stay% = NO
774.   END SELECT
775. WEND
776. CALL Show.setup
777. END SUB
778.  
779. SUB Hist.print
780. 'Print out the History Report entry for the PSF now loaded
781. PRINT #1,PRINT
782. IF Plain$(Psf.crn$) <> "NONE" THEN
783.   Issued$ = ") issued under Change Note No. " + Psf.crn$
784. ELSE
785.   Issued$ = ") not issued."
786. END IF
787. PRINT #1, Psfoption$; " ("; Psf$; Issued$
788. PRINT #1, "PROG Iss. "; Psf.progiss$; " - "; Psf.progdate$; "  SPEC "; Psf.sourcename$; " Iss. "; Psf.sourceiss$; " - "; Psf.sourcedate$
789. IF LTRIM$(RTRIM$(Psf.amendrefs$)) <> "" THEN PRINT #1, Psf.amendrefs$
790. PRINT #1, Psf.history$
791. END SUB
792.  
793. SUB Hist.show
794. 'Display the History Report entry for the PSF now loaded
795. COLOR 14, 4: PRINT
796. IF Plain$(Psf.crn$) <> "NONE" THEN
797.   Issued$ = " issued under Change Note No. " + Psf.crn$
798. ELSE
799.   Issued$ = " not issued."
800. END IF
801. COLOR 14: PRINT Psfoption$; " ("; Psf$; ")";: COLOR 15: PRINT Issued$
802. PRINT "PROG Iss. "; Psf.progiss$; " - "; Psf.progdate$; "  SPEC "; Psf.sourcename$; " Iss. "; Psf.sourceiss$; " - "; Psf.sourcedate$
803. IF LTRIM$(RTRIM$(Psf.amendrefs$)) <> "" THEN PRINT Psf.amendrefs$
804. PRINT Psf.history$
805. END SUB
806.  
807. SUB HISTORY
808. STATIC Lotempst AS STRING * 8
809. STATIC Hitempst AS STRING * 8
810. IF Choose.done% = NO THEN
811.   SOUND 300, 4
812.   CALL State("Working file not specified yet; select CHOOSE first. Press any key.")
813.   CALL Waitkey
814.   EXIT SUB
815. END IF
816. IF Psfoption$ <> "CURRENT" THEN
817.   SOUND 300, 4
818.   CALL State("You can produce a History Report only from a CURRENT PSF . Press any key.")
819.   CALL Waitkey
820.   EXIT SUB
821. END IF
822. Pathname$ = Drive$ + ":" + Path$ + Psf$
823. Fileunfound% = RESETFLAG
824. OPEN Pathname$ FOR INPUT AS #2
825. IF Fileunfound% = NO THEN
826.   CALL Read.psf
827.   CLOSE #2
828. END IF
829. History.complete% = YES
830. CLS 2
831. LOCATE 3: COLOR 14
832. PRINT "HISTORY REPORT for "; TType.number$; " produced on "; British$(DATE$); " @ "; LEFT$(TIME$, 5); " Engineer:"; Psf.eng$
833. COLOR 15: PRINT STRING$(78, "-")
834. PRINT "Program + "; Psf$; SPACE$(19 - LEN(Psf$)); "Issue:"; Psf.progiss$; "               Dated:"; Psf.progdate$
835. PRINT "Source:"; Psf.sourcename$; "  Issue:"; Psf.sourceiss$; "             Dated:"; Psf.sourcedate$
836. IF Psf.sermark% = YES THEN
837.   Sermarked$ = "              Serial Marked"
838. ELSE
839.   Sermarked$ = "              Not Serial Marked"
840. END IF
841. PRINT "Customer Reference:"; Psf.custype$; Sermarked$
842. IF Psf.lotemp% = 999 THEN
843.   Lotempst$ = " N/A    "
844. ELSE
845.   Lotempst$ = "=" + STR$(Psf.lotemp%) + "DegC"
846. END IF
847. IF Psf.hitemp% = 999 THEN
848.   Hitempst$ = " N/A    "
849. ELSE
850.   Hitempst$ = "=" + RTRIM$(LTRIM$(STR$(Psf.hitemp%))) + "DegC"
851. END IF
852. PRINT "Low Temp."; Lotempst$; "            Ambient Temp.=23DegC    High Temp."; Hitempst$
853. PRINT STRING$(78, "-")
854. Line.counter% = 7
855. CALL Hist.show
856. Line.counter% = Line.counter% + 5
857. Psfoption$ = "PREVIOUS"
858. Preceding.issue% = Dosvalid%(Psf.preceding$)
859. WHILE Preceding.issue% = YES
860.   Psf$ = TType.number$ + "P." + Noblanks$(Psf.preceding$)
861.   Pathname$ = Drive$ + ":" + Path$ + Psf$
862.   Fileunfound% = RESETFLAG
863.   OPEN Pathname$ FOR INPUT AS #2
864.   IF Fileunfound% = NO THEN
865.     CALL Read.psf
866.     CLOSE #2
867.     CALL Hist.show
868.     Line.counter% = Line.counter% + 5
869.     Preceding.issue% = Dosvalid%(Psf.preceding$)
870.     IF Line.counter% > 14 THEN
871.       CALL State("Press any key to continue."): COLOR 15, 4
872.       CALL Waitkey
873.       Line.counter% = 0
874.       CLS 2: LOCATE 3
875.     END IF
876.   ELSE
877.     PRINT: COLOR 14
878.     PRINT "HISTORY REPORT MAY BE INCOMPLETE: "; Psf$; " was referenced but not found."
879.     COLOR 15
880.     Preceding.issue% = NO
881.     History.complete% = NO
882.   END IF
883. WEND
884. IF History.complete% = YES THEN
885.   PRINT: COLOR 14
886.   PRINT "HISTORY REPORT COMPLETE."
887.   COLOR 15
888. END IF
889. Psfoption$ = "CURRENT"
890. Psf$ = TType.number$ + "C.PSF"
891. Pathname$ = Drive$ + ":" + Path$ + Psf$
892. OPEN Pathname$ FOR INPUT AS #2
893. CALL Read.psf
894. CLOSE #2
895. IF Ask%("Do you want to PRINT THIS REPORT") = YES THEN
896.   History.complete% = YES
897.   PRINT #1, "HISTORY REPORT for "; TType.number$; " produced on "; British$(DATE$); " @ "; LEFT$(TIME$, 5); " Engineer:"; Psf.eng$
898.   PRINT #1, STRING$(78, "-")
899.   PRINT #1, "Program + "; Psf$; SPACE$(19 - LEN(Psf$)); "Issue:"; Psf.progiss$; "               Dated:"; Psf.progdate$
900.   PRINT #1, "Source:"; Psf.sourcename$; "  Issue:"; Psf.sourceiss$; "             Dated:"; Psf.sourcedate$
901.   IF Psf.sermark% = YES THEN
902.     Sermarked$ = "              Serial Marked"
903.   ELSE
904.     Sermarked$ = "              Not Serial Marked"
905.   END IF
906.   PRINT #1, "Customer Reference:"; Psf.custype$; Sermarked$
907.   IF Psf.lotemp% = 999 THEN
908.     Lotempst$ = " N/A    "
909.   ELSE
910.     Lotempst$ = "=" + STR$(Psf.lotemp%) + "DegC"
911.   END IF
912.   IF Psf.hitemp% = 999 THEN
913.     Hitempst$ = " N/A    "
914.   ELSE
915.     Hitempst$ = "=" + RTRIM$(LTRIM$(STR$(Psf.hitemp%))) + "DegC"
916.   END IF
917.   PRINT #1, "Low Temp."; Lotempst$; "            Ambient Temp.=23DegC    High Temp."; Hitempst$
918.   PRINT #1, STRING$(78, "-")
919.   CALL Hist.print
920.   Line.counter% = 1
921.   Psfoption$ = "PREVIOUS"
922.   Preceding.issue% = Dosvalid%(Psf.preceding$)
923.   WHILE Preceding.issue% = YES
924.     Psf$ = TType.number$ + "P." + Noblanks$(Psf.preceding$)
925.     Pathname$ = Drive$ + ":" + Path$ + Psf$
926.     Fileunfound% = RESETFLAG
927.     OPEN Pathname$ FOR INPUT AS #2
928.     IF Fileunfound% = NO THEN
929.       CALL Read.psf
930.       CLOSE #2
931.       CALL Hist.print
932.       Line.counter% = Line.counter% + 1
933.       Preceding.issue% = Dosvalid%(Psf.preceding$)
934.     ELSE
935.       PRINT #1,PRINT
936.       PRINT #1, "HISTORY REPORT MAY BE INCOMPLETE: "; Psf$; " was referenced but not found."
937.       Preceding.issue% = NO
938.       History.complete% = NO
939.     END IF
940.   WEND
941.   IF History.complete% = YES THEN
942.     PRINT #1,PRINT
943.     PRINT #1, "HISTORY REPORT COMPLETE."
944.   END IF
945.   PRINT #1, CHR$(12)
946.   Psfoption$ = "CURRENT"          ' Restore current file
947.   Psf$ = TType.number$ + "C.PSF"
948.   Pathname$ = Drive$ + ":" + Path$ + Psf$
949.   OPEN Pathname$ FOR INPUT AS #2
950.   CALL Read.psf
951.   CLOSE #2
952. END IF
953. END SUB
954.  
955. SUB Init.vars
956. 'Initialise all shared variables
957.  
958. Fileunfound% = RESETFLAG
959. OPEN "C:\BLP\SPECS\OPTIONH.PSF" FOR INPUT AS #2
960. IF Fileunfound% = NO THEN
961.   CALL Read.psf
962.   CLOSE #2
963.   Host$ = Psf.custype$
964.   Drive$ = UCASE$(LEFT$(Psf.progdate$, 1))
965. ELSE
966.   Host$ = ""
967.   Drive$ = "C"
968. END IF
969.  
970. Printerok% = YES
971. TType.number$ = "~~~~~~"
972. Choose.done% = NO
973. Path$ = "\BLP\SPECS\"
974. Psf$ = "SPECEDIT.PSF"
975. Psfoption$ = "CURRENT"
976. Fileunfound% = FALSE
977. Fileduplicate% = FALSE
978.  
979. END SUB
980.  
981. SUB Line.edit (Edit.string$, Field.size%, Exit.code%)
982. 'Line editor - processes left & right arrow, delete and insert keys to edit
983. 'Edit.string$, which is padded if necessary to a length of Field.size%.
984. 'Exit.code% is ASCII code of key used to quit line edit:- TAB, Shift+TAB, Up,
985. 'Down, ENTER, Pg Up, Pg Down, ESC, Home, End, F9, F10
986. COLOR , 0
987. IF Field.size% < LEN(Edit.string$) THEN
988.   PRINT "Line.edit: Edit string exceeds field size": STOP
989. END IF
990. Start.char% = POS(0)
991. End.char% = Start.char% + Field.size% - 1
992. Char% = Start.char%
993. Insert.mode% = NO: LOCATE , , , 0, 7
994. Stay% = YES
995. WHILE Stay% = YES
996.   Spaces% = Field.size% - LEN(Edit.string$)
997.   Edit.string$ = Edit.string$ + STRING$(Spaces%, " ")
998.   LOCATE , Start.char%: PRINT Edit.string$;: LOCATE , Char%, 1
999.   Chars.left% = Char% - Start.char%
1000.   Chars.right% = Start.char% + LEN(Edit.string$) - Char% - 1: IF Chars.right% < 0 THEN Chars.right% = 0
1001.   Left.part$ = LEFT$(Edit.string$, Chars.left%)
1002.   Right.part$ = RIGHT$(Edit.string$, Chars.right%)
1003.   Incl.right.part$ = RIGHT$(Edit.string$, Chars.right% + 1)
1004.   DO
1005.     K$ = INKEY$
1006.   LOOP WHILE K$ <> ""  'Empty keyboard buffer
1007.   DO
1008.     K$ = INKEY$
1009.   LOOP WHILE K$ = ""
1010.   Keycode$ = RIGHT$(K$, 1)
1011.   Ascii% = ASC(Keycode$)
1012.   IF LEN(K$) = 2 THEN Ascii% = Ascii% * 100' EXTENDED CODE
1013.   SELECT CASE Ascii%
1014.   CASE 8, 7500 'LEFT
1015.     IF Char% > Start.char% THEN Char% = Char% - 1: LOCATE , Char%
1016.   CASE 7700  'RIGHT
1017.     IF Char% < End.char% THEN Char% = Char% + 1: LOCATE , Char%
1018.   CASE 8200  'INSERT
1019.     IF Insert.mode% = NO THEN
1020.       Insert.mode% = YES: LOCATE , , , 7, 7
1021.     ELSE
1022.       Insert.mode% = NO: LOCATE , , , 0, 7
1023.     END IF
1024.   CASE 8300  'DELETE
1025.     Edit.string$ = Left.part$ + Right.part$
1026.   CASE 9, 1500, 7200, 8000, 13, 7300, 8100, 27, 7100, 7900, 6700, 6800 'EXIT CODES
1027.     Exit.code% = Ascii%: IF Exit.code% > 255 THEN Exit.code% = Exit.code% / 100
1028.     LOCATE , , 0, 7, 7
1029.     Stay% = NO
1030.   CASE ELSE  'CHARACTER
1031.     IF Ascii% > 31 AND Ascii% < 128 THEN
1032.       IF Insert.mode% = YES THEN
1033.         Edit.string$ = Left.part$ + CHR$(Ascii%) + LEFT$(Incl.right.part$, Chars.right%)
1034.       ELSE  'Overwrite
1035.         Edit.string$ = Left.part$ + CHR$(Ascii%) + Right.part$
1036.       END IF
1037.     IF Char% < End.char% THEN Char% = Char% + 1: LOCATE , Char%
1038.     END IF
1039.   END SELECT
1040. WEND
1041. COLOR , 4
1042. END SUB
1043.  
1044. SUB Read.psf
1045. 'Enter all data from PSF file, which has already been opened as #2
1046. DIM Psfparamst AS Psfparamsttype
1047. LINE INPUT #2, Psf.typeno$: LINE INPUT #2, Psf.progiss$
1048. LINE INPUT #2, Psf.preceding$: LINE INPUT #2, Psf.progdate$
1049. LINE INPUT #2, Psf.sourcename$: LINE INPUT #2, Psf.sourceiss$
1050. LINE INPUT #2, Psf.sourcedate$: LINE INPUT #2, Psf.amendrefs$
1051. LINE INPUT #2, Psf.custype$: LINE INPUT #2, Psf.hitempst$
1052. LINE INPUT #2, Psf.lotempst$: LINE INPUT #2, Psf.sermarkst$
1053. LINE INPUT #2, Psf.history$: LINE INPUT #2, Psf.crn$
1054. LINE INPUT #2, Psf.eng$: LINE INPUT #2, Psf.comment1$
1055. LINE INPUT #2, Psf.comment2$: LINE INPUT #2, Psf.comment3$
1056. LINE INPUT #2, Psf.comment4$: LINE INPUT #2, Psf.comment5$
1057. LINE INPUT #2, Psf.numsetsst$
1058. Psf.numsets% = VAL(Psf.numsetsst$)
1059. FOR Setno% = 0 TO Psf.numsets% - 1
1060.   LINE INPUT #2, Psf.numparsst$
1061.   Psf.numpars%(Setno%) = VAL(Psf.numparsst$)
1062. NEXT Setno%
1063. FOR Setno% = Psf.numsets% TO 3  'Clear unused parameter sets
1064.   Psf.numpars%(Setno%) = 0
1065. NEXT Setno%
1066. LINE INPUT #2, Psf.numspacesst$
1067. FOR Setno% = 0 TO Psf.numsets% - 1
1068.   LINE INPUT #2, Psf.setlabel$(Setno%)
1069. NEXT Setno%
1070. FOR Setno% = Psf.numsets% TO 3  'Clear unused parameter sets
1071.   Psf.setlabel$(Setno%) = ""
1072. NEXT Setno%
1073. FOR Setno% = 0 TO Psf.numsets% - 1
1074.   FOR Paramno% = 1 TO Psf.numpars%(Setno%)
1075.     LINE INPUT #2, Psfparamst.Index
1076.     LINE INPUT #2, Psfparamst.Label
1077.     LINE INPUT #2, Psfparamst.Units
1078.     LINE INPUT #2, Psfparamst.Lower
1079.     LINE INPUT #2, Psfparamst.Upper
1080.     Psfset(Setno%, Paramno%).Index = VAL(Psfparamst.Index)
1081.     Psfset(Setno%, Paramno%).Label = Psfparamst.Label
1082.     Psfset(Setno%, Paramno%).Units = Psfparamst.Units
1083.     Psfset(Setno%, Paramno%).Lower = VAL(Psfparamst.Lower) / 10000
1084.     Psfset(Setno%, Paramno%).Upper = VAL(Psfparamst.Upper) / 10000
1085.   NEXT Paramno%
1086. NEXT Setno%
1087. Psf.hitemp% = VAL(Psf.hitempst$)
1088. Psf.lotemp% = VAL(Psf.lotempst$)
1089. Psf.sermark% = VAL(Psf.sermarkst$)
1090. Psf.numspaces% = VAL(Psf.numspacesst$)
1091. END SUB
1092.  
1093. SUB Show.bars
1094. 'Display / refresh status bars at top & bottom of screen
1095. Linenum% = CSRLIN
1096. Colnum% = POS(0)
1097. VIEW PRINT 1 TO 25: COLOR 4, 7
1098. LOCATE 1, 1: PRINT SPACE$(80);
1099. LOCATE 1, 1: PRINT "***  SPECification EDITor   SOFTWARE ISSUE "; Softiss$; Softdate$;: LOCATE 1, 66: PRINT "S J OXLEY   ***";
1100. LOCATE 25, 1: PRINT "***"; SPACE$(74); "***";
1101. IF Choose.done% = YES THEN
1102.   Specpath$ = Drive$ + ":" + Path$
1103.   IF LEN(Specpath$) > 22 THEN Specpath$ = LEFT$(Specpath$, 19) + "..."
1104.   LOCATE 25, 5: PRINT "Directory "; Specpath$; "  File "; TType.number$; " - "; Psfoption$;
1105.   IF Psfoption$ <> "HYPOTHETICAL" THEN PRINT "  Issue: "; Psf.progiss$;
1106. ELSE
1107.   LOCATE 25, 5: PRINT "Working File not chosen.  ";
1108.   LOCATE 25, 40: COLOR 0: PRINT "Running on "; Host$;
1109. END IF
1110. VIEW PRINT 2 TO 24: COLOR 15, 4
1111. LOCATE Linenum%, Colnum%
1112. END SUB
1113.  
1114. SUB Show.head1
1115. 'Display first header edit screen
1116. STATIC Hitempst AS STRING * 3
1117. STATIC Lotempst AS STRING * 3
1118. STATIC Sermarkst AS STRING * 1
1119. CLS 2
1120. LOCATE 2: PRINT "Page 1";
1121. LOCATE , 30:  COLOR 15: PRINT "Main Header Data";: COLOR 14: PRINT "      (Yellow fields are optional.)"
1122. PRINT
1123. COLOR 15, 4: PRINT "Type Number";: LOCATE , 30: COLOR , 1: PRINT Psf.typeno$
1124. COLOR 15, 4: PRINT "Program Issue";: LOCATE , 30: PRINT Psf.progiss$
1125. COLOR 15, 4: PRINT "Preceding Program Issue";: LOCATE , 30: PRINT Psf.preceding$
1126. COLOR 15, 4: PRINT "Program Date";: LOCATE , 30: COLOR , 1: PRINT Psf.progdate$
1127. COLOR 15, 4: PRINT "Source Spec Name";: LOCATE , 30: COLOR , 1: PRINT Psf.sourcename$
1128. COLOR 15, 4: PRINT "Source Spec Issue";: LOCATE , 30: COLOR , 1: PRINT Psf.sourceiss$
1129. COLOR 14, 4: PRINT "Source Spec Date";: LOCATE , 30: COLOR 15, 1: PRINT Psf.sourcedate$
1130. COLOR 14, 4: PRINT "Source Spec Amendments..."
1131. COLOR 15, 1: PRINT Psf.amendrefs$
1132. COLOR 14, 4: PRINT "Customer Type";: LOCATE , 30: COLOR 15, 1: PRINT Psf.custype$
1133. Hitempst$ = LTRIM$(STR$(Psf.hitemp%))
1134. COLOR 15, 4: PRINT "High Temperature [23 to 200]";: LOCATE , 30: COLOR , 1: PRINT Hitempst$;: COLOR , 4: PRINT "    (Enter 999 if not applicable.)"
1135. Lotempst$ = LTRIM$(STR$(Psf.lotemp%))
1136. COLOR 15, 4: PRINT "Low Temperature [-99 to 23]";: LOCATE , 30: COLOR , 1: PRINT Lotempst$;: COLOR , 4: PRINT "    (Enter 999 if not applicable.)"
1137. Sermarkst$ = LTRIM$(STR$(Psf.sermark%))
1138. COLOR 15, 4: PRINT "Serial Marked";: LOCATE , 30: COLOR , 1: PRINT Sermarkst$;: COLOR , 4: PRINT "      (Enter [0]/1 for [not] serial marked.)"
1139. COLOR 15, 4: PRINT "Change History..."
1140. COLOR , 1: PRINT Psf.history$
1141. COLOR 15, 4: PRINT "Change Note Number";: LOCATE , 30: COLOR , 1: PRINT Psf.crn$;: COLOR , 4: PRINT " (Enter NONE for pre-issue program.)"
1142. COLOR 14, 4: PRINT "Engineer Responsible";: LOCATE , 30: COLOR 15, 1: PRINT Psf.eng$
1143. LOCATE 24
1144. COLOR 15, 2: PRINT "Up/Dn, Home/End, TAB keys to move; Ins/Del as normal; Pg Dn for P.2; ESC to quit";: COLOR 15, 4
1145. END SUB
1146.  
1147.  
1148. SUB Show.head2 (Edit.set%, Edit.line%, Copy.set%)
1149. 'Display second header edit screen
1150. STATIC Numparsst AS STRING * 3
1151. STATIC Numspacesst AS STRING * 3
1152. STATIC Setst AS STRING * 1
1153. STATIC Linest AS STRING * 3
1154. STATIC Copysetst AS STRING * 1
1155. CLS 2
1156. LOCATE 2: PRINT "Page 2";
1157. LOCATE , 30: PRINT "Comments & Parameter Set Data"
1158. PRINT
1159. COLOR 14, 4: PRINT "Comments...": COLOR 15, 1
1160. PRINT Psf.comment1$
1161. PRINT Psf.comment2$
1162. PRINT Psf.comment3$
1163. PRINT Psf.comment4$
1164. PRINT Psf.comment5$
1165. PRINT
1166. COLOR 15, 4: PRINT "Parameter Set 0 Label";: LOCATE , 30: COLOR , 1: PRINT Psf.setlabel$(0)
1167. Numparsst$ = LTRIM$(STR$(Psf.numpars%(0)))
1168. COLOR 15, 4: PRINT "                Size";: LOCATE , 30: COLOR , 1: PRINT Numparsst$;: COLOR , 4: PRINT "  (1 to TRF record size.)"
1169. COLOR 14, 4: PRINT "Parameter Set 1 Label";: LOCATE , 30: COLOR 15, 1: PRINT Psf.setlabel$(1)
1170. Numparsst$ = LTRIM$(STR$(Psf.numpars%(1)))
1171. COLOR 14, 4: PRINT "                Size";: LOCATE , 30: COLOR 15, 1: PRINT Numparsst$;: COLOR , 4: PRINT "  (1 to TRF record size, 0 if unused.)"
1172. Col% = 1: IF Psf.numpars(1) = 0 THEN Col% = 4
1173. COLOR 14, 4: PRINT "Parameter Set 2 Label";: LOCATE , 30: COLOR 15, Col%: PRINT Psf.setlabel$(2)
1174. Numparsst$ = LTRIM$(STR$(Psf.numpars%(2)))
1175. COLOR 14, 4: PRINT "                Size";: LOCATE , 30: COLOR 15, Col%: PRINT Numparsst$;: COLOR , 4: PRINT "  (1 to TRF record size, 0 if unused.)"
1176. Col% = 1: IF Psf.numpars(2) = 0 THEN Col% = 4
1177. COLOR 14, 4: PRINT "Parameter Set 3 Label";: LOCATE , 30: COLOR 15, Col%: PRINT Psf.setlabel$(3)
1178. Numparsst$ = LTRIM$(STR$(Psf.numpars%(3)))
1179. COLOR 14, 4: PRINT "                Size";: LOCATE , 30: COLOR 15, Col%: PRINT Numparsst$;: COLOR , 4: PRINT "  (1 to TRF record size, 0 if unused.)"
1180. Numspacesst$ = LTRIM$(STR$(Psf.numspaces%))
1181. COLOR 15, 4: PRINT "TRF Record Size";: LOCATE , 30: COLOR , 1: PRINT Numspacesst$;: COLOR , 4: PRINT "  (1 to 220 parameter spaces in TRF record.)"
1182. PRINT
1183. COLOR 15, 2: PRINT SPACE$(80): PRINT SPACE$(80): PRINT SPACE$(80);: LOCATE 20
1184. Setst$ = LTRIM$(STR$(Edit.set%))
1185. COLOR 15, 2: PRINT "             Current Set";: LOCATE , 30: COLOR , 0: PRINT Setst$;
1186. COLOR , 2: LOCATE , 35: PRINT "Pg Dn to Edit Current Line in Current Set"
1187. Linest$ = LTRIM$(STR$(Edit.line%))
1188. COLOR 15, 2: PRINT "             Current Line";: LOCATE , 30: COLOR , 0: PRINT Linest$;
1189. Copysetst$ = LTRIM$(STR$(Copy.set%))
1190. COLOR , 2: LOCATE , 35: PRINT "F9 for Default Indices in Current Set";
1191. COLOR 15, 2: PRINT "             Destination Set";: LOCATE , 30: COLOR , 0: PRINT Copysetst$;
1192. COLOR , 2: LOCATE , 35: PRINT "F10 to Copy Current Set to Destination Set";
1193. LOCATE 23
1194. COLOR 15, 2: PRINT "Up/Dn, Home/End or TAB keys to move; Ins; Del; Pg Up/Dn for P.1/P.3; ESC to quit";: COLOR 15, 4
1195. END SUB
1196.  
1197. SUB Show.param (Edit.set%, Edit.line%)
1198. 'Display parameter edit screen
1199. STATIC Indexst AS STRING * 3
1200. STATIC Lowerst AS STRING * 10
1201. STATIC Upperst AS STRING * 10
1202. CLS 2
1203. Setlabelst$ = "- " + Psf.setlabel$(Edit.set%)
1204. LOCATE 2: PRINT "Page 3";: LOCATE , 30: PRINT "Parameter Data for Set"; Edit.set%; Setlabelst$
1205. COLOR 15, 4: LOCATE 4, 1: PRINT "Line  IND.  LABEL                      UNITS   LOWER        UPPER        Line"
1206. IF Edit.line% > Psf.numpars%(Edit.set%) THEN Edit.line% = Psf.numpars%(Edit.set%)
1207. IF Edit.line% < 1 THEN Edit.line% = 1
1208. FOR Line.number% = Edit.line% - 9 TO Edit.line% + 8
1209.   IF Line.number% > 0 AND Line.number% <= Psf.numpars%(Edit.set%) THEN
1210.     COLOR 15, 4: PRINT Line.number%;
1211.     IF Line.number% = Edit.line% THEN
1212.       COLOR 15, 1
1213.     ELSE
1214.       COLOR 14
1215.     END IF
1216.     Indexst$ = LTRIM$(STR$(Psfset(Edit.set%, Line.number%).Index))
1217.     LOCATE , 7: PRINT Indexst$;
1218.     LOCATE , 13: PRINT Psfset(Edit.set%, Line.number%).Label;
1219.     LOCATE , 40: PRINT Psfset(Edit.set%, Line.number%).Units;
1220.     Lowerst$ = LTRIM$(STR$(Psfset(Edit.set%, Line.number%).Lower))
1221.     LOCATE , 48: PRINT Lowerst$;
1222.     Upperst$ = LTRIM$(STR$(Psfset(Edit.set%, Line.number%).Upper))
1223.     LOCATE , 61: PRINT Upperst$;
1224.     LOCATE , 74: COLOR 15, 4: PRINT Line.number%
1225.   ELSE
1226.     PRINT
1227.   END IF
1228. NEXT Line.number%
1229. Lowval! = Psfset(Edit.set%, Edit.line%).Lower
1230. Upval! = Psfset(Edit.set%, Edit.line%).Upper
1231. IF Lowval! > Upval! THEN
1232.   LOCATE 23, 15: COLOR 10, 1: PRINT " Lower limit is greater than upper limit.      "
1233. ELSE
1234.   Unit$ = LTRIM$(RTRIM$(Psfset(Edit.set%, Edit.line%).Units))
1235.   Nominal! = (Round!(((Lowval! + Upval!) / 2), 3))
1236.   Nomval$ = LTRIM$(RTRIM$(STR$(Nominal!)))
1237.   IF LEFT$(Nomval$, 1) = "." THEN Nomval$ = "0" + Nomval$
1238.   Rangeval$ = LTRIM$(RTRIM$(STR$(Round!(((Upval! - Lowval!) / 2), 3))))
1239.   IF LEFT$(Rangeval$, 1) = "." THEN Rangeval$ = "0" + Rangeval$
1240.   IF Lowval! * Upval! <= 0 OR INSTR(Unit$, "dB") > 0 OR INSTR(Unit$, "%") > 0 THEN
1241.     LOCATE 23, 15: COLOR 10, 1: PRINT " Specified Value: "; Nomval$; Unit$; " "; CHR$(241); " "; Rangeval$; Unit$; " "
1242.   ELSE
1243.     Tolval$ = LTRIM$(RTRIM$(STR$(Round!((ABS(100 * (Upval! - Lowval!) / 2 / Nominal!)), 2))))
1244.     IF LEFT$(Tolval$, 1) = "." THEN Tolval$ = "0" + Tolval$
1245.     LOCATE 23, 15: COLOR 10, 1: PRINT " Specified Value: "; Nomval$; Unit$; " "; CHR$(241); " "; Rangeval$; Unit$; " ("; Tolval$; "%) "
1246.   END IF
1247. END IF
1248. COLOR 15, 2: PRINT "Arrow & TAB keys to move; F9/F10 Insert/Delete line; Pg Up for P.2; ESC to quit ";: COLOR 15, 4
1249. END SUB
1250.  
1251. SUB Show.setup
1252. 'Display current CHOOSE options
1253. CLS 2
1254. LOCATE 5, 20:  COLOR 15: PRINT "Working Directory & PSF Selection"
1255. PRINT
1256. COLOR 15, 4: PRINT "Drive";: LOCATE , 20: COLOR , 1: PRINT Drive$
1257. COLOR 15, 4: PRINT "Path";: LOCATE , 20: COLOR , 1: PRINT Path$
1258. COLOR 15, 4: PRINT "Product type";: LOCATE , 20: COLOR , 1: PRINT TType.number$
1259. Option$ = LEFT$(Psfoption$, 1)
1260. COLOR 15, 4: PRINT "PSF Class";: LOCATE , 20: COLOR , 1: PRINT Option$;: COLOR , 4: PRINT "   C=CURRENT, P=PREVIOUS, H=HYPOTHETICAL"
1261. IF UCASE$(Option$) = "P" THEN
1262.   COLOR 15, 4: PRINT "Issue";: LOCATE , 20: COLOR , 1: PRINT Prev.issue$;: COLOR , 4: PRINT " The issue must be a valid DOS filename extension."
1263.   Psf$ = TType.number$ + "P." + Noblanks$(Prev.issue$)
1264. ELSE
1265.   Psf$ = TType.number$ + Option$ + ".PSF"
1266. END IF
1267. LOCATE 13: COLOR 15, 4
1268. SELECT CASE UCASE$(Option$)
1269. CASE "C"
1270.   PRINT "If you load a CURRENT PSF you can edit it, produce a Tolerance Report or"
1271.   PRINT "produce a History Report."
1272.   PRINT "If you choose to edit it, you must decide whether you are going to raise the"
1273.   PRINT "software issue of the test program. If so, the PSF will be archived as a"
1274.   PRINT "PREVIOUS PSF before editing commences, and then the edited version will be"
1275.   PRINT "saved as the new CURRENT PSF. If you choose not to change the issue, you will"
1276.   PRINT "be able to save the edited version as either CURRENT or HYPOTHETICAL, or to"
1277.   PRINT "quit the editor without saving the changes."
1278. CASE "H"
1279.   PRINT "If you load a HYPOTHETICAL PSF you can edit it or produce a Tolerance Report,"
1280.   PRINT "but not a History Report."
1281.   PRINT "If you choose to edit it, you will be able to save the edited version as"
1282.   PRINT "HYPOTHETICAL, or quit the editor without saving the changes. You cannot"
1283.   PRINT "convert a HYPOTHETICAL PSF to CURRENT class. This preserves the integrity of"
1284.   PRINT "the issue history."
1285. CASE "P"
1286.   PRINT "If you load a PREVIOUS PSF you can edit it or produce a Tolerance Report, but"
1287.   PRINT "not a History Report."
1288.   PRINT "If you choose to edit it, you will be able to save the edited version as"
1289.   PRINT "HYPOTHETICAL, or quit the editor without saving the changes. You cannot"
1290.   PRINT "convert a PREVIOUS PSF to CURRENT class, nor can you over-write a PREVIOUS"
1291.   PRINT "class file. This preserves the integrity of the issue history and of the"
1292.   PRINT "archived PSF data."
1293. END SELECT
1294. LOCATE 24: COLOR 15, 2: PRINT "Up/Dn, Home/End keys to move; Edit entry or TAB to select option; ESC to finish ";: COLOR , 4
1295. END SUB
1296.  
1297. SUB Tol.print
1298. 'Print out a tolerance report for the loaded PSF
1299. STATIC Lotempst AS STRING * 8
1300. STATIC Hitempst AS STRING * 8
1301. STATIC Indexst AS STRING * 3
1302. ' STATIC Labelst AS STRING * 24
1303. STATIC Unitsst AS STRING * 5
1304. STATIC Lowerst AS STRING * 10
1305. STATIC Upperst AS STRING * 10
1306. STATIC Nomst AS STRING * 10
1307. STATIC Tolst AS STRING * 7
1308. PRINT #1, "TOLERANCE REPORT for "; TType.number$; " produced on "; British$(DATE$); " @ "; LEFT$(TIME$, 5); " Engineer:"; Psf.eng$
1309. PRINT #1, STRING$(78, "-")
1310. IF Psfoption$ = "HYPOTHETICAL" THEN
1311.   PRINT #1, "HYPOTHETICAL PSF - Generated for results analysis, not applied in testing."
1312. ELSE
1313.   IF Psfoption$ = "PREVIOUS" THEN
1314.     Prev.psf$ = " (PREVIOUS)    Dated:"
1315.   ELSE
1316.     Prev.psf$ = "               Dated:"
1317.   END IF
1318.   PRINT #1, "Program + "; Psf$; SPACE$(19 - LEN(Psf$)); "Issue:"; Psf.progiss$; Prev.psf$; Psf.progdate$
1319. END IF
1320. PRINT #1, "Source:"; Psf.sourcename$; "  Issue:"; Psf.sourceiss$; "             Dated:"; Psf.sourcedate$
1321. IF LTRIM$(RTRIM$(Psf.amendrefs$)) <> "" THEN PRINT #1, Psf.amendrefs$
1322. IF Psf.sermark% = YES THEN
1323.   Sermarked$ = "              Serial Marked"
1324. ELSE
1325.   Sermarked$ = "              Not Serial Marked"
1326. END IF
1327. PRINT #1, "Customer Reference:"; Psf.custype$; Sermarked$
1328. IF Psf.lotemp% = 999 THEN
1329.   Lotempst$ = " N/A    "
1330. ELSE
1331.   Lotempst$ = "=" + STR$(Psf.lotemp%) + "DegC"
1332. END IF
1333. IF Psf.hitemp% = 999 THEN
1334.   Hitempst$ = " N/A    "
1335. ELSE
1336.   Hitempst$ = "=" + RTRIM$(LTRIM$(STR$(Psf.hitemp%))) + "DegC"
1337. END IF
1338. PRINT #1, "Low Temp."; Lotempst$; "            Ambient Temp.=23DegC    High Temp."; Hitempst$
1339. PRINT #1, STRING$(78, "-")
1340. FOR Setno% = 0 TO Psf.numsets% - 1
1341.   PRINT #1, "PARAMETER SET NUMBER"; Setno%; "      "; Psf.setlabel$(Setno%); "   "; Psf.numpars%(Setno%); "Parameters:-"
1342.   PRINT #1, " ============================================================================"
1343.   PRINT #1, "[IND|        PARAMETER        |  LOWER   |  UPPER   |  Nominal & Tol. | UNITS]"
1344.   PRINT #1, "[---+-------------------------+----------+----------+-----------------+------]"
1345.   FOR Paramno% = 1 TO Psf.numpars%(Setno%)
1346.     Indexst$ = RTRIM$(LTRIM$(STR$(Psfset(Setno%, Paramno%).Index)))
1347.     Labelst$ = Psfset(Setno%, Paramno%).Label
1348.     Unitsst$ = Psfset(Setno%, Paramno%).Units
1349.     Lowerst$ = STR$(Psfset(Setno%, Paramno%).Lower)
1350.     Upperst$ = STR$(Psfset(Setno%, Paramno%).Upper)
1351.     Lowval! = Psfset(Setno%, Paramno%).Lower
1352.     Upval! = Psfset(Setno%, Paramno%).Upper
1353.     Nominal! = (Round!(((Lowval! + Upval!) / 2), 4))
1354.     Nomst$ = STR$(Nominal!)
1355.     IF Lowval! * Upval! <= 0 OR INSTR(Unitsst$, "dB") > 0 OR INSTR(Unitsst$, "%") > 0 THEN
1356.       Toleranceval! = (Upval! - Lowval!) / 2
1357.       IF Toleranceval! > 999 THEN
1358.         Tolst$ = "+->999"
1359.       ELSEIF Toleranceval! > 100 THEN
1360.         Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 0))))
1361.       ELSEIF Toleranceval! > 10 THEN
1362.         Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 1))))
1363.       ELSEIF Toleranceval! > 1 THEN
1364.         Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 2))))
1365.       ELSE
1366.         Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 3))))
1367.       END IF
1368.     ELSE
1369.       Toleranceval! = 100 * (Upval! - Lowval!) / 2 / ABS(Nominal!)
1370.       IF Toleranceval! > 99.9 THEN
1371.         Tolst$ = "+-99.9%"
1372.       ELSEIF Toleranceval! > 10 THEN
1373.         Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 1)))) + "%"
1374.       ELSEIF Toleranceval! > 1 THEN
1375.         Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 2)))) + "%"
1376.       ELSE
1377.         Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 3)))) + "%"
1378.       END IF
1379.     END IF
1380.     PRINT #1, "["; Indexst$; "| ";
1381.     FOR Charpos = 1 TO 24
1382.       Char$ = MID$(Labelst$, Charpos, 1)
1383.       IF ASC(Char$) = 0 THEN
1384.         Char$ = " "
1385.       END IF
1386.       PRINT #1, Char$;
1387.     NEXT Charpos
1388.     PRINT #1, "|"; Lowerst$; "|"; Upperst$; "|"; Nomst$; Tolst$; "| ";
1389.     FOR Charpos = 1 TO 5
1390.       Char$ = MID$(Unitsst$, Charpos, 1)
1391.       IF ASC(Char$) = 0 THEN
1392.         Char$ = " "
1393.       END IF
1394.       PRINT #1, Char$;
1395.     NEXT Charpos
1396.     PRINT #1, "]"
1397.   NEXT Paramno%
1398.   PRINT #1, " ============================================================================"
1399. NEXT Setno%
1400. PRINT #1, CHR$(12)
1401. END SUB
1402.  
1403. SUB Tol.show
1404. 'Display a tolerance report for the loaded PSF
1405. STATIC Lotempst AS STRING * 8
1406. STATIC Hitempst AS STRING * 8
1407. STATIC Indexst AS STRING * 3
1408. STATIC Labelst AS STRING * 24
1409. STATIC Unitsst AS STRING * 5
1410. STATIC Lowerst AS STRING * 10
1411. STATIC Upperst AS STRING * 10
1412. STATIC Nomst AS STRING * 10
1413. STATIC Tolst AS STRING * 7
1414. LOCATE 3: COLOR 14
1415. PRINT "TOLERANCE REPORT for "; TType.number$; " produced on "; British$(DATE$); " @ "; LEFT$(TIME$, 5); " Engineer:"; Psf.eng$
1416. COLOR 15: PRINT STRING$(78, "-")
1417. IF Psfoption$ = "HYPOTHETICAL" THEN
1418.   PRINT "HYPOTHETICAL PSF - Generated for results analysis, not applied in testing."
1419. ELSE
1420.   IF Psfoption$ = "PREVIOUS" THEN
1421.     Prev.psf$ = " (PREVIOUS)    Dated:"
1422.   ELSE
1423.     Prev.psf$ = "               Dated:"
1424.   END IF
1425.   PRINT "Program + "; Psf$; SPACE$(19 - LEN(Psf$)); "Issue:"; Psf.progiss$; Prev.psf$; Psf.progdate$
1426. END IF
1427. PRINT "Source:"; Psf.sourcename$; "  Issue:"; Psf.sourceiss$; "             Dated:"; Psf.sourcedate$
1428. IF LTRIM$(RTRIM$(Psf.amendrefs$)) <> "" THEN PRINT Psf.amendrefs$
1429. IF Psf.sermark% = YES THEN
1430.   Sermarked$ = "              Serial Marked"
1431. ELSE
1432.   Sermarked$ = "              Not Serial Marked"
1433. END IF
1434. PRINT "Customer Reference:"; Psf.custype$; Sermarked$
1435. IF Psf.lotemp% = 999 THEN
1436.   Lotempst$ = " N/A    "
1437. ELSE
1438.   Lotempst$ = "=" + STR$(Psf.lotemp%) + "DegC"
1439. END IF
1440. IF Psf.hitemp% = 999 THEN
1441.   Hitempst$ = " N/A    "
1442. ELSE
1443.   Hitempst$ = "=" + RTRIM$(LTRIM$(STR$(Psf.hitemp%))) + "DegC"
1444. END IF
1445. PRINT "Low Temp."; Lotempst$; "            Ambient Temp.=23DegC    High Temp."; Hitempst$
1446. PRINT STRING$(78, "-")
1447. Line.counter% = 7
1448. FOR Setno% = 0 TO Psf.numsets% - 1
1449.   COLOR 14: PRINT "PARAMETER SET NUMBER"; Setno%;: COLOR 15: PRINT "      "; Psf.setlabel$(Setno%); "   "; Psf.numpars%(Setno%); "Parameters:-"
1450.   PRINT " ============================================================================"
1451.   PRINT "[IND|        PARAMETER        |  LOWER   |  UPPER   |  Nominal & Tol. | UNITS]"
1452.   PRINT "[---+-------------------------+----------+----------+-----------------+------]"
1453.   Line.counter% = Line.counter% + 4
1454.   FOR Paramno% = 1 TO Psf.numpars%(Setno%)
1455.     Indexst$ = RTRIM$(LTRIM$(STR$(Psfset(Setno%, Paramno%).Index)))
1456.     Labelst$ = Psfset(Setno%, Paramno%).Label
1457.     Unitsst$ = Psfset(Setno%, Paramno%).Units
1458.     Lowerst$ = STR$(Psfset(Setno%, Paramno%).Lower)
1459.     Upperst$ = STR$(Psfset(Setno%, Paramno%).Upper)
1460.     Lowval! = Psfset(Setno%, Paramno%).Lower
1461.     Upval! = Psfset(Setno%, Paramno%).Upper
1462.     Nominal! = (Round!(((Lowval! + Upval!) / 2), 4))
1463.     Nomst$ = STR$(Nominal!)
1464.     IF Lowval! * Upval! <= 0 OR INSTR(Unitsst$, "dB") > 0 OR INSTR(Unitsst$, "%") > 0 THEN
1465.       Toleranceval! = (Upval! - Lowval!) / 2
1466.       IF Toleranceval! > 999 THEN
1467.         Tolst$ = "+->999"
1468.       ELSEIF Toleranceval! > 100 THEN
1469.         Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 0))))
1470.       ELSEIF Toleranceval! > 10 THEN
1471.         Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 1))))
1472.       ELSEIF Toleranceval! > 1 THEN
1473.         Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 2))))
1474.       ELSE
1475.         Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 3))))
1476.       END IF
1477.     ELSE
1478.       Toleranceval! = 100 * (Upval! - Lowval!) / 2 / ABS(Nominal!)
1479.       IF Toleranceval! > 99.9 THEN
1480.         Tolst$ = "+-99.9%"
1481.       ELSEIF Toleranceval! > 10 THEN
1482.         Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 1)))) + "%"
1483.       ELSEIF Toleranceval! > 1 THEN
1484.         Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 2)))) + "%"
1485.       ELSE
1486.         Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 3)))) + "%"
1487.       END IF
1488.     END IF
1489.     PRINT "["; Indexst$; "| ";
1490.     FOR Charpos = 1 TO 24
1491.       Char$ = MID$(Labelst$, Charpos, 1)
1492.       IF ASC(Char$) = 0 THEN
1493.         Char$ = " "
1494.       END IF
1495.       PRINT Char$;
1496.     NEXT Charpos
1497.     PRINT "|"; Lowerst$; "|"; Upperst$; "|"; Nomst$; Tolst$; "| ";
1498.     FOR Charpos = 1 TO 5
1499.       Char$ = MID$(Unitsst$, Charpos, 1)
1500.       IF ASC(Char$) = 0 THEN
1501.         Char$ = " "
1502.       END IF
1503.       PRINT Char$;
1504.     NEXT Charpos
1505.     PRINT "]"
1506.     Line.counter% = Line.counter% + 1
1507.     IF Line.counter% > 19 THEN
1508.       CALL State("Press any key to continue."): COLOR 15, 4
1509.       CALL Waitkey
1510.       CLS 2: LOCATE 3
1511.       Line.counter% = 0
1512.     END IF
1513.   NEXT Paramno%
1514.   PRINT " ============================================================================"
1515.   Line.counter% = Line.counter% + 1
1516.   IF Line.counter% > 15 THEN
1517.     CALL State("Press any key to continue."): COLOR 15, 4
1518.     CALL Waitkey
1519.     CLS 2: LOCATE 3
1520.     Line.counter% = 0
1521.   END IF
1522. NEXT Setno%
1523. END SUB
1524.  
1525. SUB TOLERANCE
1526. IF Choose.done% = NO THEN
1527.   SOUND 300, 4
1528.   CALL State("Working file not specified yet; select CHOOSE first. Press any key.")
1529.   CALL Waitkey
1530.   EXIT SUB
1531. END IF
1532. CLS 2
1533. Pathname$ = Drive$ + ":" + Path$ + Psf$
1534. Fileunfound% = RESETFLAG
1535. OPEN Pathname$ FOR INPUT AS #2
1536. IF Fileunfound% = NO THEN
1537.   CALL Read.psf
1538.   CLOSE #2
1539. END IF
1540. CALL Tol.show
1541. IF Ask%("Do you want to PRINT THIS REPORT") = YES THEN
1542.   State ("Printing Tolerance Report...")
1543.   CALL Tol.print
1544.   State ("")
1545. END IF
1546. END SUB
1547.  
1548. SUB Write.psf
1549. ' Output all data to PSF file, which has already been opened as #3
1550.   DIM Psfparamst AS Psfparamsttype
1551.   Psf.hitempst$ = STR$(Psf.hitemp%)
1552.   Psf.lotempst$ = STR$(Psf.lotemp%)
1553.   Psf.sermarkst$ = STR$(Psf.sermark%)
1554.   Psf.numspacesst$ = STR$(Psf.numspaces%)
1555.   PRINT #3, Psf.typeno$: PRINT #3, Psf.progiss$
1556.   PRINT #3, Psf.preceding$: PRINT #3, Psf.progdate$
1557.   PRINT #3, Psf.sourcename$: PRINT #3, Psf.sourceiss$
1558.   PRINT #3, Psf.sourcedate$: PRINT #3, Psf.amendrefs$
1559.   PRINT #3, Psf.custype$: PRINT #3, Psf.hitempst$
1560.   PRINT #3, Psf.lotempst$: PRINT #3, Psf.sermarkst$
1561.   PRINT #3, Psf.history$: PRINT #3, Psf.crn$
1562.   PRINT #3, Psf.eng$: PRINT #3, Psf.comment1$
1563.   PRINT #3, Psf.comment2$: PRINT #3, Psf.comment3$
1564.   PRINT #3, Psf.comment4$: PRINT #3, Psf.comment5$
1565.   Psf.numsetsst$ = STR$(Psf.numsets%)
1566.   PRINT #3, Psf.numsetsst$
1567.   FOR Setno% = 0 TO Psf.numsets% - 1
1568.     Psf.numparsst$ = STR$(Psf.numpars%(Setno%))
1569.     PRINT #3, Psf.numparsst$
1570.   NEXT Setno%
1571.   PRINT #3, Psf.numspacesst$
1572.   FOR Setno% = 0 TO Psf.numsets% - 1
1573.     PRINT #3, Psf.setlabel$(Setno%)
1574.   NEXT Setno%
1575.   FOR Setno% = 0 TO Psf.numsets% - 1
1576.     FOR Paramno% = 1 TO Psf.numpars%(Setno%)
1577.       Psfparamst.Index = STR$(Psfset(Setno%, Paramno%).Index)
1578.       Psfparamst.Label = Psfset(Setno%, Paramno%).Label
1579.       Psfparamst.Units = Psfset(Setno%, Paramno%).Units
1580.       Lower.val! = (Psfset(Setno%, Paramno%).Lower * 10000)
1581.       Lower.val! = Lower.val! + .1 * SGN(Lower.val!) 'Eliminate rounding errors
1582.       Lower.int& = FIX(Lower.val!)
1583.       Psfparamst.Lower = STR$(Lower.int&)
1584.       Upper.val! = (Psfset(Setno%, Paramno%).Upper * 10000)
1585.       Upper.val! = Upper.val! + .1 * SGN(Upper.val!) 'Eliminate rounding errors
1586.       Upper.int& = FIX(Upper.val!)
1587.       Psfparamst.Upper = STR$(Upper.int&)
1588.       PRINT #3, Psfparamst.Index
1589.       PRINT #3, Psfparamst.Label
1590.       PRINT #3, Psfparamst.Units
1591.       PRINT #3, Psfparamst.Lower
1592.       PRINT #3, Psfparamst.Upper
1593.     NEXT Paramno%
1594.   NEXT Setno%
1595. END SUB
1596.  
1597. ' UTILs _____________________________________________________________________________________
1598.  
1599. FUNCTION Ask% (Question$)
1600.     'Prompt for Y / N response
1601.     DO
1602.         Dummy$ = INKEY$
1603.     LOOP UNTIL Dummy$ = ""
1604.     COLOR 10, 1
1605.     Valid% = NO
1606.     WHILE Valid% = NO
1607.         LOCATE 23, 1
1608.         PRINT SPACE$(80);
1609.         LOCATE 23, 1
1610.         PRINT Question$; "? (Y/N) ";
1611.         DO
1612.             K$ = INKEY$
1613.         LOOP WHILE K$ = ""
1614.         Valid% = YES
1615.         SELECT CASE K$
1616.             CASE "Y", "y"
1617.                 Ask% = YES
1618.             CASE "N", "n"
1619.                 Ask% = NO
1620.             CASE ELSE
1621.                 Valid% = NO
1622.         END SELECT
1623.     WEND
1624.     COLOR 15, 1
1625.     LOCATE 23, 1
1626.     PRINT SPACE$(80);
1627. END FUNCTION
1628.  
1629. FUNCTION British$ (Indate$)
1630.     'Converts "m[m]{-./}d[d]{-./}yy[yy]" to "dd/mm/yy[yy]"
1631.  
1632.     Delim = INSTR(Indate$, "/") + INSTR(Indate$, ".") + INSTR(Indate$, "-")
1633.     IF Delim > 0 THEN
1634.         Month% = VAL(LEFT$(Indate$, (Delim - 1)))
1635.         Indate$ = RIGHT$(Indate$, (LEN(Indate$) - Delim))
1636.         Delim = INSTR(Indate$, "/") + INSTR(Indate$, ".") + INSTR(Indate$, "-")
1637.         IF Delim > 0 THEN Day% = VAL(LEFT$(Indate$, (Delim - 1)))
1638.         IF Delim > 0 THEN Year% = VAL(RIGHT$(Indate$, (LEN(Indate$) - Delim)))
1639.     END IF
1640.     d$ = STR$(Day%)
1641.     d$ = RIGHT$(d$, (LEN(d$) - 1))
1642.     IF LEN(d$) = 1 THEN d$ = "0" + d$
1643.     m$ = STR$(Month%)
1644.     m$ = RIGHT$(m$, (LEN(m$) - 1))
1645.     IF LEN(m$) = 1 THEN m$ = "0" + m$
1646.     y$ = STR$(Year%)
1647.     y$ = RIGHT$(y$, (LEN(y$) - 1))
1648.     British$ = d$ + "/" + m$ + "/" + y$
1649.  
1650. END FUNCTION
1651.  
1652. FUNCTION Checkint% (Value%, Lolim%, Hilim%)
1653.     IF Value% < Lolim% OR Value% > Hilim% THEN
1654.         SOUND 400, 1
1655.         Checkint% = NO
1656.     ELSE
1657.         Checkint% = YES
1658.     END IF
1659. END FUNCTION
1660.  
1661. FUNCTION Checkreal% (Value!, Lolim!, Hilim!)
1662.     IF Value! < Lolim! OR Value! > Hilim! THEN
1663.         SOUND 400, 1
1664.         Checkreal% = NO
1665.     ELSE
1666.         Checkreal% = YES
1667.     END IF
1668. END FUNCTION
1669.  
1670. FUNCTION Datestr$ (Inputdate&)
1671.     'Converts a number of days since 30/12/1899 (Quattro pro ref) into a date
1672.     'string. Output date string is DD/MM/YYYY
1673.  
1674.     Indate& = Inputdate& + 364
1675.     DIM Numdays(12) AS INTEGER
1676.     Numdays(1) = 31
1677.     Numdays(2) = 28
1678.     Numdays(3) = 31
1679.     Numdays(4) = 30
1680.     Numdays(5) = 31
1681.     Numdays(6) = 30
1682.     Numdays(7) = 31
1683.     Numdays(8) = 31
1684.     Numdays(9) = 30
1685.     Numdays(10) = 31
1686.     Numdays(11) = 30
1687.     Numdays(12) = 31
1688.  
1689.     'Derive date from input number of days past reference
1690.     Year% = 1899
1691.     WHILE Indate& > 366
1692.         IF Year% MOD 400 = 0 OR (Year% MOD 4 = 0 AND Year% MOD 100 <> 0) THEN
1693.             Indate& = Indate& - 366
1694.         ELSE
1695.             Indate& = Indate& - 365
1696.         END IF
1697.         Year% = Year% + 1
1698.     WEND
1699.     IF Year% MOD 400 = 0 OR (Year% MOD 4 = 0 AND Year% MOD 100 <> 0) THEN
1700.         Numdays(2) = 29
1701.     ELSE
1702.         IF Indate& = 366 THEN
1703.             Indate& = 1
1704.             Year% = Year% + 1
1705.         END IF
1706.     END IF
1707.     Month% = 1
1708.     WHILE Indate& > Numdays(Month%)
1709.         Indate& = Indate& - Numdays(Month%)
1710.         Month% = Month% + 1
1711.     WEND
1712.     Day% = Indate&
1713.  
1714.     'Construct date$
1715.     d$ = STR$(Day%)
1716.     d$ = RIGHT$(d$, (LEN(d$) - 1))
1717.     IF LEN(d$) = 1 THEN d$ = "0" + d$
1718.     m$ = STR$(Month%)
1719.     m$ = RIGHT$(m$, (LEN(m$) - 1))
1720.     IF LEN(m$) = 1 THEN m$ = "0" + m$
1721.     y$ = STR$(Year%)
1722.     y$ = RIGHT$(y$, (LEN(y$) - 1))
1723.  
1724.     Datestr$ = d$ + "/" + m$ + "/" + y$
1725.  
1726. END FUNCTION
1727.  
1728. FUNCTION Dateval& (Inputdate$)
1729.     'Converts a date string into number of days since 30/12/1899 (Quattro-Pro ref)  1/1/1899
1730.     'Input date string is DAY/MONTH/YEAR, DAY.MONTH.YEAR or DAY-MONTH-YEAR
1731.     'where DAY and MONTH are 1 or 2 digits and YEAR is 2 or 4 digits
1732.     'A 2-digit year is interpreted as being between 1951 and 2050. Dates outside
1733.     'this range and invalid dates return error code (-1).
1734.  
1735.     Indate$ = Inputdate$
1736.     DIM Numdays(12) AS INTEGER
1737.     Numdays(1) = 31
1738.     Numdays(2) = 28
1739.     Numdays(3) = 31
1740.     Numdays(4) = 30
1741.     Numdays(5) = 31
1742.     Numdays(6) = 30
1743.     Numdays(7) = 31
1744.     Numdays(8) = 31
1745.     Numdays(9) = 30
1746.     Numdays(10) = 31
1747.     Numdays(11) = 30
1748.     Numdays(12) = 31
1749.  
1750.     'Extract days, months and years from Indate$
1751.     Delim = INSTR(Indate$, "/") + INSTR(Indate$, ".") + INSTR(Indate$, "-")
1752.     IF Delim > 0 THEN
1753.         Day% = VAL(LEFT$(Indate$, (Delim - 1)))
1754.         Indate$ = RIGHT$(Indate$, (LEN(Indate$) - Delim))
1755.         Delim = INSTR(Indate$, "/") + INSTR(Indate$, ".") + INSTR(Indate$, "-")
1756.         IF Delim > 0 THEN Month% = VAL(LEFT$(Indate$, (Delim - 1)))
1757.         IF Delim > 0 THEN Year% = VAL(RIGHT$(Indate$, (LEN(Indate$) - Delim)))
1758.         IF Year% < 100 THEN
1759.             IF Year% < 51 THEN
1760.                 Year% = Year% + 2000
1761.             ELSE
1762.                 Year% = Year% + 1900
1763.             END IF
1764.         END IF
1765.     END IF
1766.  
1767.     'Convert date to number of days since reference
1768.     Daycount& = 0
1769.     IF Year% < 1951 OR Year% > 2050 OR Month% < 1 OR Month% > 12 THEN
1770.         Daycount& = -1
1771.     ELSE
1772.         IF (Year% MOD 400 = 0 OR (Year% MOD 4 = 0 AND Year% MOD 100 <> 0)) AND Month% = 2 THEN
1773.             IF Day% > 29 THEN Daycount& = -1
1774.         ELSE
1775.             IF Day% > Numdays(Month%) THEN Daycount& = -1
1776.         END IF
1777.         IF Day% < 1 THEN Daycount& = -1
1778.     END IF
1779.     IF Daycount& = 0 THEN
1780.         FOR I = 1899 TO Year% - 1
1781.             Daycount& = Daycount& + 365
1782.             IF I MOD 400 = 0 OR (I MOD 4 = 0 AND I MOD 100 <> 0) THEN
1783.                 Daycount& = Daycount& + 1
1784.             END IF
1785.         NEXT I
1786.         FOR I = 1 TO Month% - 1
1787.             Daycount& = Daycount& + Numdays(I)
1788.         NEXT I
1789.         IF Year% MOD 400 = 0 OR (Year% MOD 4 = 0 AND Year% MOD 100 <> 0) THEN
1790.             IF Month% > 2 THEN Daycount& = Daycount& + 1
1791.         END IF
1792.         Daycount& = Daycount& + Day%
1793.     END IF
1794.     IF Daycount& > 0 THEN
1795.         Dateval& = Daycount& - 364
1796.     ELSE
1797.         Dateval& = -1
1798.     END IF
1799. END FUNCTION
1800.  
1801. FUNCTION Dosvalid% (Extension$)
1802.     'Check whether (first 3 chars of) Extension$ is a valid DOS filename extension
1803.     DIM C%(3)
1804.     Check.ext$ = Extension$
1805.     IF LEN(Extension$) < 3 THEN
1806.         Check.ext$ = Check.ext$ + SPACE$(3 - LEN(Extension$))
1807.     END IF
1808.     Check.ext$ = LEFT$(Check.ext$, 3)
1809.     C%(1) = ASC(Check.ext$)
1810.     C%(2) = ASC(RIGHT$(Check.ext$, 2))
1811.     C%(3) = ASC(RIGHT$(Check.ext$, 1))
1812.     Valid% = YES
1813.     FOR n% = 1 TO 3
1814.         Validchar% = NO
1815.         X% = C%(n%)
1816.         IF X% = 33 OR (X% > 34 AND X% < 42) OR X% = 45 OR (X% > 47 AND X% < 58) THEN Validchar% = YES
1817.         IF (X% > 63 AND X% < 91) OR (X% > 93 AND X% < 124) OR X% = 125 OR X% = 126 THEN Validchar% = YES
1818.         IF n% > 1 AND X% = 32 THEN Validchar% = YES 'Allow trailing spaces
1819.         IF Validchar% = NO THEN Valid% = NO
1820.     NEXT n%
1821.     'IF Valid% = NO THEN SOUND 400, 1
1822.     Dosvalid% = Valid%
1823. END FUNCTION
1824.  
1825. FUNCTION Noblanks$ (Instring$)
1826.     ' Strip leading, trailing and all contained spaces and convert to upper case
1827.     ' (see Plain$)
1828.     Temp$ = LTRIM$(RTRIM$(UCASE$(Instring$)))
1829.     Blanksin% = YES
1830.     WHILE Blanksin% = YES
1831.         Spacepos% = INSTR(Temp$, " ")
1832.         IF Spacepos% THEN
1833.             Leftbit$ = LEFT$(Temp$, Spacepos% - 1)
1834.             Rightbit$ = RIGHT$(Temp$, LEN(Temp$) - Spacepos%)
1835.             Temp$ = Leftbit$ + Rightbit$
1836.         ELSE
1837.             Blanksin% = NO
1838.         END IF
1839.     WEND
1840.     Noblanks$ = Temp$
1841. END FUNCTION
1842.  
1843. SUB Pause (T!)
1844.     Start.time = TIMER
1845.     WHILE TIMER < Start.time + T!
1846.         IF TIMER < Start.time THEN Start.time = Start.time - 24 * 3600 'IF MIDNIGHT HAPPENS
1847.     WEND
1848. END SUB
1849.  
1850. FUNCTION Plain$ (Instring$)
1851.     ' Strip leading & trailing spaces and convert to upper case (see Noblanks$)
1852.     Plain$ = LTRIM$(RTRIM$(UCASE$(Instring$)))
1853. END FUNCTION
1854.  
1855. FUNCTION Qpwdate& (Intimedate!)
1856.     'Derives a Quattro-pro date value from an HP Basic TIMEDATE value.
1857.     Qpwdate& = INT(Intimedate! / 86400 - 2415019)
1858.  
1859. END FUNCTION
1860.  
1861. FUNCTION Qpwtime# (Intimedate#)
1862.     'Derives a Quattro-pro time value from an HP Basic TIMEDATE value.
1863.     Qpwtime# = (Intimedate# / 86400) - INT(Intimedate# / 86400)
1864.  
1865. END FUNCTION
1866.  
1867. FUNCTION Round! (Value!, Dec%)
1868.     'Round Value! to Dec% DP, max 4 DP
1869.     IF Dec% > 4 THEN Dec% = 4
1870.     Power.ten! = 10 ^ Dec%
1871.     Integer.part! = FIX(Value!)
1872.     Decimal.part! = Value! - FIX(Value!)
1873.     IF Power.ten! <> 0 THEN Decimal.part! = CINT(Decimal.part! * Power.ten!) / Power.ten!
1874.     Round! = Integer.part! + Decimal.part!
1875. END FUNCTION
1876.  
1877. SUB State (Prompt$)
1878.     'Display single line prompt
1879.     Linenum% = CSRLIN
1880.     Colnum% = POS(0)
1881.     COLOR 14, 1
1882.     LOCATE 24, 1
1883.     PRINT SPACE$(80);
1884.     LOCATE 24, 1
1885.     PRINT Prompt$;
1886.     LOCATE Linenum%, Colnum%
1887.     COLOR 15, 1
1888. END SUB
1889.  
1890. FUNCTION Timedate! (Inqpwdate&, Inqpwtime!)
1891.     'Converts a Quattro-pro date and time value to the corresponding HP Basic
1892.     'TIMEDATE value.
1893.     Timedate! = (Inqpwdate& + 2415019 + Inqpwtime!) * 86400
1894. END FUNCTION
1895.  
1896. FUNCTION Timestr$ (Inputtime#)
1897.     'Converts a fraction of a day (Quattro pro format) into a time string.
1898.     'Output time string is HH:MM:SS. Conversion accuracy +/- 1 Sec.
1899.  
1900.     Inputhours! = (Inputtime# - INT(Inputtime#)) * 24
1901.     Hour% = INT(Inputhours!)
1902.     Min% = INT((Inputhours! - Hour%) * 60)
1903.     Sec% = INT(((Inputhours! - Hour%) * 60 - Min%) * 60)
1904.  
1905.     'Construct time$
1906.     h$ = STR$(Hour%)
1907.     h$ = RIGHT$(h$, (LEN(h$) - 1))
1908.     IF LEN(h$) = 1 THEN h$ = "0" + h$
1909.     m$ = STR$(Min%)
1910.     m$ = RIGHT$(m$, (LEN(m$) - 1))
1911.     IF LEN(m$) = 1 THEN m$ = "0" + m$
1912.     s$ = STR$(Sec%)
1913.     s$ = RIGHT$(s$, (LEN(s$) - 1))
1914.     IF LEN(s$) = 1 THEN s$ = "0" + s$
1915.  
1916.     Timestr$ = h$ + ":" + m$ + ":" + s$
1917. END FUNCTION
1918.  
1919. FUNCTION Toggle% (Inflag%)
1920.     ' If inflag is logic (1 / 0) then its complement is returned.
1921.  
1922.     SELECT CASE Inflag%
1923.         CASE 0
1924.             Toggle% = 1
1925.         CASE 1
1926.             Toggle% = 0
1927.         CASE ELSE
1928.             Toggle% = Inflag%
1929.     END SELECT
1930.  
1931. END FUNCTION
1932.  
1933. SUB Waitkey
1934.     'Wait for keypress then continue
1935.     Pause (.1) ' Delay to avoid keybounce
1936.     DO
1937.         K$ = INKEY$
1938.     LOOP UNTIL K$ = "" ' Clear buffer
1939.     DO
1940.         K$ = INKEY$
1941.     LOOP WHILE K$ = ""
1942.     Pause (.1) ' Delay to avoid keybounce
1943. END SUB
1944.  
1945. SUB Warn (Prompt$)
1946.     'Display single line prompt
1947.     Linenum% = CSRLIN
1948.     Colnum% = POS(0)
1949.     LOCATE 24, 1
1950.     PRINT SPACE$(80);
1951.     LOCATE 24, 1
1952.     COLOR 28, 1
1953.     PRINT "WARNING - ";
1954.     COLOR 12, 1
1955.     PRINT Prompt$;
1956.     SOUND 400, 1
1957.     LOCATE Linenum%, Colnum%
1958.     COLOR 15, 1
1959. END SUB
1960.  
1961.  

[bplus]

Yeah, did this:

Code: QB64: [Select]

1. '-----------------------------------------------------------------------------
2. DIM Psf.numpars(3) AS INTEGER, Psf.setlabel(3) AS STRING * 20
3. DIM SHARED Psfset(3, 1 TO 220) AS Psfparamtype '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< changed SHARED
4. '-----------------------------------------------------------------------------
5. 'General
6. COMMON SHARED Softiss AS STRING * 2, Softdate AS STRING * 13, Printerok%
7. COMMON SHARED Type.number AS STRING * 6, Choose.done%
8. 'File operations
9. COMMON SHARED Drive$, Path$, Psf$, Psfoption$, Prev.issue AS STRING * 3
10. COMMON SHARED Fileunfound%, Fileduplicate%
11. 'File contents data
12. COMMON SHARED Psf.typeno AS STRING * 6, Psf.progiss AS STRING * 3
13. COMMON SHARED Psf.preceding AS STRING * 3, Psf.progdate AS STRING * 10
14. COMMON SHARED Psf.sourcename AS STRING * 20, Psf.sourceiss AS STRING * 5
15. COMMON SHARED Psf.sourcedate AS STRING * 10, Psf.amendrefs AS STRING * 80
16. COMMON SHARED Psf.custype AS STRING * 20, Psf.hitemp AS INTEGER
17. COMMON SHARED Psf.lotemp AS INTEGER, Psf.sermark AS INTEGER
18. COMMON SHARED Psf.history AS STRING * 80, Psf.crn AS STRING * 6
19. COMMON SHARED Psf.eng AS STRING * 10, Psf.comment1 AS STRING * 80
20. COMMON SHARED Psf.comment2 AS STRING * 80, Psf.comment3 AS STRING * 80
21. COMMON SHARED Psf.comment4 AS STRING * 80, Psf.comment5 AS STRING * 80
22. COMMON SHARED Psf.numsets AS INTEGER, Psf.numpars AS INTEGER
23. COMMON SHARED Psf.numspaces AS INTEGER, Psf.setlabel AS STRING * 20
24. 'COMMON SHARED Psfset AS Psfparamtype, Host AS STRING * 20  '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< changed
25. DIM SHARED Host AS STRING * 20
26. '-----------------------------------------------------------------------------
27.  

and the problem with the array goes away.

Then this is flagged!

Code: QB64: [Select]

1. SUB Hist.print
2.     'Print out the History Report entry for the PSF now loaded
3. PRINT #1,PRINT  '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< WTH?
4. IF Plain$(Psf.crn$) <> "NONE" THEN
5.   Issued$ = ") issued under Change Note No. " + Psf.crn$
6. ELSE
7.   Issued$ = ") not issued."
8. END IF
9. PRINT #1, Psfoption$; " ("; Psf$; Issued$
10. PRINT #1, "PROG Iss. "; Psf.progiss$; " - "; Psf.progdate$; "  SPEC "; Psf.sourcename$; " Iss. "; Psf.sourceiss$; " - "; Psf.sourcedate$
11. IF LTRIM$(RTRIM$(Psf.amendrefs$)) <> "" THEN PRINT #1, Psf.amendrefs$
12. PRINT #1, Psf.history$
13. END SUB
14.  

Say did this code even work?

[SpriggsySpriggs]

Yeah there were so many naming conflicts. I would fix one and then another line is screwed lol

[bplus]

Actually I just assumed

Code: QB64: [Select]

1. PRINT #1,PRINT

meant print a blank line so I replaced them all with

Code: QB64: [Select]

1. PRINT #1, " "

and then I got the OK to compile! wow

Code: QB64: [Select]

1. '-----------------------------------------------------------------------------
2. '                           NAMING CONVENTIONS
3. '  Category............................................  Format  Example
4. 'PROCEDURES
5. '  Main procedure relating to main menu function         NNNN    TASK
6. '  Subsidiary procedure in main module                   Nn.nn   Do.task
7. '  Utility procedure                                     Nnnn    Utility
8. 'DATA
9. '  Constant                                              NNNN    FRED
10. '  General variable                                      Nnnn    Fredgen
11. '  One of a set of variables related to a subject (Fred) Nn.nn   Fred.variable
12. '  Element of variable (Fred) with user-defined type     Nn.Nn   Fred.Element
13. '
14. '      I/O PATHS
15. '      #1    Printer LPT1
16. '      #2    PSF file I/P
17. '      #3    PSF file O/P
18. '-----------------------------------------------------------------------------
19. CONST TRUE = 1, YES = 1, SETFLAG = 1
20. CONST FALSE = 0, NO = 0, RESETFLAG = 0
21. '-----------------------------------------------------------------------------
22. TYPE Psfparamtype
23.     Index AS INTEGER
24.     Label AS STRING * 24
25.     Units AS STRING * 5
26.     Lower AS SINGLE
27.     Upper AS SINGLE
28. END TYPE
29. TYPE Psfparamsttype ' String-only version for file reading
30.     Index AS STRING * 4
31.     Label AS STRING * 24
32.     Units AS STRING * 5
33.     Lower AS STRING * 9
34.     Upper AS STRING * 9
35. END TYPE
36. '-----------------------------------------------------------------------------
37. DIM Psf.numpars(3) AS INTEGER, Psf.setlabel(3) AS STRING * 20 ' <<<<<<<<<<<<<<<<<<<<<<<<<<<< these never used
38. DIM SHARED Psfset(3, 1 TO 220) AS Psfparamtype '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< changed SHARED
39. '-----------------------------------------------------------------------------
40. 'General
41. COMMON SHARED Softiss AS STRING * 2, Softdate AS STRING * 13, Printerok%
42. COMMON SHARED Type.number AS STRING * 6, Choose.done%
43. 'File operations
44. COMMON SHARED Drive$, Path$, Psf$, Psfoption$, Prev.issue AS STRING * 3
45. COMMON SHARED Fileunfound%, Fileduplicate%
46. 'File contents data
47. COMMON SHARED Psf.typeno AS STRING * 6, Psf.progiss AS STRING * 3
48. COMMON SHARED Psf.preceding AS STRING * 3, Psf.progdate AS STRING * 10
49. COMMON SHARED Psf.sourcename AS STRING * 20, Psf.sourceiss AS STRING * 5
50. COMMON SHARED Psf.sourcedate AS STRING * 10, Psf.amendrefs AS STRING * 80
51. COMMON SHARED Psf.custype AS STRING * 20, Psf.hitemp AS INTEGER
52. COMMON SHARED Psf.lotemp AS INTEGER, Psf.sermark AS INTEGER
53. COMMON SHARED Psf.history AS STRING * 80, Psf.crn AS STRING * 6
54. COMMON SHARED Psf.eng AS STRING * 10, Psf.comment1 AS STRING * 80
55. COMMON SHARED Psf.comment2 AS STRING * 80, Psf.comment3 AS STRING * 80
56. COMMON SHARED Psf.comment4 AS STRING * 80, Psf.comment5 AS STRING * 80
57. COMMON SHARED Psf.numsets AS INTEGER, Psf.numpars AS INTEGER
58. COMMON SHARED Psf.numspaces AS INTEGER, Psf.setlabel AS STRING * 20
59. 'COMMON SHARED Psfset AS Psfparamtype, Host AS STRING * 20  '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< changed
60. DIM SHARED Host AS STRING * 20
61. '-----------------------------------------------------------------------------
62. 'SPECIFICATION EDITOR PROGRAM - SPECEDIT.BAS    S J Oxley
63. Softiss$ = "5 ": Softdate$ = "- 08/11/04"
64. 'REVISION RECORD:
65. '..DATE....ISSUE......................REVISION DETAILS..................
66. '25/01/99   1     FIRST ISSUE - Archived as SPECED01.BAS + UTILS02.BAS
67. '22/02/99  (1)    Added choice of Template File in CHOOSE, F9 & F10 functions
68. '                 on editor P.2 (default indices & copy set)
69. '13/10/99   2     Added clearance of unused parameter sets when loading a PSF
70. '                 with fewer parameter sets than the previous PSF.
71. '                 Cleared Print.tol format bug; Label/Units trailing spaces.
72. '                 Archived as SPECED02.BAS
73. '19/10/99  (2)    Added default drive selection using OPTIONH.PSF file.
74. '14/01/00  (2)    Changed Filename$ to Psf$ when saving edited PSF at end of
75. '                 EDIT. The global Psf$ is now updated when changing class.
76. '28/02/00  (2)    Removal of F7 option.
77. '04/06/03   3     Default drive and paths set to T and \TEST\SPECS.
78. '02/09/03   4     Index as STRING * 3 changed to * 4.
79. '                 Changed to allow for index>100 " 100" is 4 CHRs.
80. '                 Changed default drive and paths back to C and \BLP\SPECS.
81. '07/11/04   5     Changed DIM Psfset(3,1 TO 200) to 220 to get more parameters.
82. '-----------------------------------------------------------------------------
83. OPEN "LPT1" FOR OUTPUT AS #1
84. ON ERROR GOTO Errhandler
85. LOCATE 2
86. CALL Show.bars
87. CLS 2
88. CALL Init.vars
89. Stay% = YES
90. WHILE Stay% = YES
91.     ON KEY(1) GOSUB Callchoose
92.     ON KEY(2) GOSUB Calledit
93.     ON KEY(3) GOSUB Calltolerance
94.     ON KEY(4) GOSUB Callhistory
95.     ON KEY(8) GOSUB Quit
96.     LOCATE 2
97.     CALL Show.bars
98.     CLS 2
99.     LOCATE 3, 28: PRINT "MAIN MENU"
100.     LOCATE 4, 28: PRINT "========="
101.     LOCATE 7, 28: PRINT "F1. CHOOSE    ";: COLOR 7: PRINT "  - Set directory, file & options": COLOR 6: IF Choose.done% = YES THEN COLOR 15
102.     LOCATE 8, 28: PRINT "F2. EDIT      ";: COLOR 7: PRINT "  - Edit spec data": COLOR 6: IF Choose.done% = YES THEN COLOR 15
103.     LOCATE 9, 28: PRINT "F3. TOLERANCE ";: COLOR 7: PRINT "  - View / print tolerances": COLOR 6: IF Choose.done% = YES AND Psfoption$ = "CURRENT" THEN COLOR 15
104.     LOCATE 10, 28: PRINT "F4. HISTORY   ";: COLOR 7: PRINT "  - View / print history": COLOR 11
105.     LOCATE 12, 28: PRINT "F8. QUIT      ";: COLOR 7: PRINT "  - Exit": COLOR 15
106.     FOR S = 1 TO 4
107.         KEY(S) ON
108.     NEXT S
109.     KEY(8) ON
110.     Continue% = NO
111.     DO
112.         DO
113.             IF Continue% = YES THEN EXIT DO
114.         LOOP WHILE INKEY$ = ""
115.         IF Continue% = YES THEN EXIT DO
116.     LOOP
117. WEND
118. VIEW PRINT 1 TO 25: COLOR 15, 0
119. CLS 2
120. END
121. '-----------------------------------------------------------------------------
122. Keysoff: 'De-activate main menu softkeys
123. FOR S = 1 TO 4
124.     KEY(S) OFF
125. NEXT S
126. KEY(8) OFF
127. RETURN
128. Callchoose: GOSUB Keysoff: CALL CHOOSE: Continue% = YES: RETURN
129. Calledit: GOSUB Keysoff: CALL EDIT: Continue% = YES: RETURN
130. Calltolerance: GOSUB Keysoff: CALL TOLERANCE: Continue% = YES: RETURN
131. Callhistory: GOSUB Keysoff: CALL HISTORY: Continue% = YES: RETURN
132. Quit: GOSUB Keysoff: Stay% = NO: Continue% = YES: RETURN
133. Errhandler: '------------------------------------------------------------------
134. SELECT CASE ERR
135.     CASE 25, 27
136.         SOUND 1000, 10
137.         CALL State("PRINTER NOT READY - Check paper loaded & on-line, then press any key.")
138.     CASE 53, 64, 76
139.         Fileunfound% = TRUE
140.         RESUME NEXT
141.     CASE 58
142.         Fileduplicate% = TRUE
143.         RESUME NEXT
144.     CASE 61, 72
145.         SOUND 1500, 5
146.         CALL State("DISK FULL OR BAD - Replace disk, then press any key.")
147.     CASE 71
148.         SOUND 1500, 5
149.         CALL State("DISK WRITE-PROTECTED - Replace or unprotect disk, then press any key.")
150.     CASE ELSE
151.         'SOUND 800, 15
152.         Message$ = "ERROR NUMBER " + STR$(ERR)
153.         CALL State(Message$)
154. END SELECT
155. CALL Waitkey
156. CALL State(SPACE$(80))
157. IF (ERR = 25 OR ERR = 27) THEN
158.     IF Ask%("Do you want to ABANDON PRINT") = YES THEN
159.         Printerok% = NO
160.         RESUME NEXT
161.     END IF
162. END IF
163. RESUME
164.  
165. DEFSNG A-Z
166. SUB CHOOSE
167.     CALL Edit.setup
168.     Pathname$ = Drive$ + ":" + Path$ + Psf$
169.     Fileunfound% = RESETFLAG
170.     OPEN Pathname$ FOR INPUT AS #2
171.     IF Fileunfound% = NO THEN
172.         CALL Read.psf
173.         CLOSE #2
174.         Choose.done% = YES
175.     ELSE
176.         IF Psfoption$ = "PREVIOUS" THEN
177.             PRINT "FAILED TO FIND PREVIOUS PSF "; Pathname$; ". Press any key."
178.             CALL Waitkey
179.         ELSEIF Ask%("This PSF does not exist. Do you want to CREATE NEW PSF") = YES THEN
180.             State ("Just press ENTER FOR DEFAULT - C:\BLP\SPECS\SPECEDIT.PSF")
181.             LOCATE 23: LINE INPUT ; "Enter TEMPLATE FILE pathname - "; Entry$
182.             IF Entry$ = "" THEN
183.                 Pathname$ = "C:\BLP\SPECS\SPECEDIT.PSF"
184.             ELSE
185.                 Pathname$ = UCASE$(LTRIM$(RTRIM$(Entry$)))
186.             END IF
187.             Fileunfound% = RESETFLAG
188.             OPEN Pathname$ FOR INPUT AS #2
189.             IF Fileunfound% = NO THEN
190.                 CALL Read.psf
191.                 CLOSE #2
192.                 Psf.typeno$ = "******"
193.                 Psf.preceding$ = "*"
194.                 Choose.done% = YES
195.             ELSE
196.                 State ("Could not find " + Pathname$ + " Press any key.")
197.                 Waitkey
198.             END IF
199.         END IF
200.     END IF
201. END SUB
202.  
203. SUB EDIT
204.     IF Choose.done% = NO THEN
205.         SOUND 300, 4
206.         CALL State("Working file not specified yet; select CHOOSE first. Press any key.")
207.         CALL Waitkey
208.         EXIT SUB
209.     END IF
210.     CLS 2
211.     Issue.raised% = NO
212.     IF Psfoption$ = "CURRENT" THEN
213.         IF Psf.typeno$ = "******" THEN 'New PSF
214.             Valid% = NO
215.             WHILE Valid% = NO
216.                 CALL State("The issue must be a valid DOS filename extension.")
217.                 LOCATE 23, 1: PRINT SPACE$(80);
218.                 LOCATE 23, 1: LINE INPUT "Enter the FIRST ISSUE (up to 3 characters), or ENTER for A - "; New.iss$
219.                 IF New.iss$ = "" THEN New.iss$ = "A"
220.                 New.iss$ = LEFT$(New.iss$, 3)
221.                 IF Dosvalid%(New.iss$) = YES THEN
222.                     Valid% = YES
223.                 ELSE
224.                     SOUND 300, 4
225.                 END IF
226.             WEND
227.             Psf.progiss$ = New.iss$
228.             Psf.preceding$ = "*"
229.         ELSE
230.             Stay% = YES
231.             WHILE Stay% = YES
232.                 CALL State("If you up-issue, the loaded CURRENT PSF is first archived as a PREVIOUS PSF.")
233.                 IF Ask%("Are you CHANGING THE ISSUE of the test program & PSF") = YES THEN
234.                     Valid% = NO
235.                     WHILE Valid% = NO
236.                         CALL State("Current issue is " + Psf.progiss$ + ". The issue must be a valid DOS filename extension.")
237.                         LOCATE 23, 1: PRINT SPACE$(80);
238.                         LOCATE 23, 1: LINE INPUT "Enter the NEW ISSUE (up to 3 characters): "; New.iss$
239.                         New.iss$ = LEFT$(New.iss$, 3)
240.                         IF Dosvalid%(New.iss$) = YES THEN
241.                             Valid% = YES
242.                         ELSE
243.                             SOUND 300, 4
244.                         END IF
245.                     WEND
246.                     CALL State("About to change issue from " + Psf.progiss$ + " to " + New.iss$)
247.                     IF Ask%("Are you sure you want to CHANGE ISSUE NOW") = YES THEN
248.                         Filename$ = TType.number$ + "P." + Psf.progiss$
249.                         OPEN Drive$ + ":" + Path$ + Filename$ FOR OUTPUT AS #3
250.                         CALL Write.psf
251.                         CLOSE #3
252.                         Issue.raised% = YES
253.                         Psf.preceding$ = Psf.progiss$
254.                         Psf.progiss$ = New.iss$
255.                         Stay% = NO
256.                     END IF
257.                 ELSE
258.                     Stay% = NO
259.                 END IF
260.             WEND
261.         END IF
262.     END IF
263.     CALL Show.bars
264.     COLOR , 4
265.     Pageno% = 1
266.     Stay% = YES
267.     WHILE Stay% = YES
268.         SELECT CASE Pageno%
269.             CASE 0
270.                 Stay% = NO
271.             CASE 1
272.                 CALL Edit.head1(Pageno%)
273.                 Edit.set% = 0: Edit.line% = 1: Copy.set% = 1
274.             CASE 2
275.                 CALL Edit.head2(Pageno%, Edit.set%, Edit.line%, Copy.set%)
276.             CASE 3
277.                 CALL Edit.param(Pageno%, Edit.set%, Edit.line%)
278.         END SELECT
279.     WEND
280.     CLS 2
281.     Save.file% = YES
282.     IF Issue.raised% = NO THEN
283.         CALL State("You can either save the edited PSF or quit without saving & lose any edits.")
284.         IF Psfoption$ = "PREVIOUS" THEN
285.             Question$ = "Do you wish to SAVE THE EDITED PREVIOUS PSF AS HYPOTHETICAL"
286.         ELSE
287.             Question$ = "Do you wish to SAVE THE EDITED PSF"
288.         END IF
289.         IF Ask%(Question$) = NO THEN
290.             Save.file% = NO
291.         ELSE
292.             IF Psfoption$ = "PREVIOUS" THEN Psfoption$ = "HYPOTHETICAL"
293.             IF Psfoption$ = "CURRENT" THEN
294.                 CALL State("You can either save as CURRENT PSF (same issue) or convert to HYPOTHETICAL.")
295.                 IF Ask("Do you wish to SAVE AS CURRENT PSF") = NO THEN Psfoption$ = "HYPOTHETICAL"
296.             END IF
297.         END IF
298.     END IF
299.     IF Save.file% = YES THEN
300.         Psf$ = TType.number$ + LEFT$(Psfoption$, 1) + ".PSF"
301.         OPEN Drive$ + ":" + Path$ + Psf$ FOR OUTPUT AS #3
302.         CALL Write.psf
303.         CLOSE #3
304.     END IF
305. END SUB
306.  
307. SUB Edit.head1 (Pageno%)
308.     'Move cursor around first header screen and edit data
309.     STATIC Hitempst AS STRING * 3
310.     STATIC Lotempst AS STRING * 3
311.     STATIC Sermarkst AS STRING * 1
312.     Lineno% = 4
313.     Stay% = YES
314.     WHILE Stay% = YES
315.         CALL Show.head1
316.         IF Lineno% = 12 OR Lineno% = 18 THEN
317.             Colno% = 1
318.         ELSE
319.             Colno% = 30
320.         END IF
321.         LOCATE Lineno%, Colno%
322.         SELECT CASE Lineno%
323.             CASE 4
324.                 CALL Line.edit(Psf.typeno$, 6, Exit.code%)
325.             CASE 7
326.                 CALL Line.edit(Psf.progdate$, 10, Exit.code%)
327.             CASE 8
328.                 CALL Line.edit(Psf.sourcename$, 20, Exit.code%)
329.             CASE 9
330.                 CALL Line.edit(Psf.sourceiss$, 5, Exit.code%)
331.             CASE 10
332.                 CALL Line.edit(Psf.sourcedate$, 10, Exit.code%)
333.             CASE 12
334.                 CALL Line.edit(Psf.amendrefs$, 80, Exit.code%)
335.             CASE 13
336.                 CALL Line.edit(Psf.custype$, 20, Exit.code%)
337.             CASE 14
338.                 Hitempst$ = LTRIM$(STR$(Psf.hitemp%))
339.                 CALL Line.edit(Hitempst$, 3, Exit.code%)
340.                 Entry% = VAL(Hitempst$)
341.                 IF Entry% = 999 THEN
342.                     Psf.hitemp% = Entry%
343.                 ELSE
344.                     IF Checkint%(Entry%, 23, 200) = YES THEN Psf.hitemp% = Entry%
345.                 END IF
346.             CASE 15
347.                 Lotempst$ = LTRIM$(STR$(Psf.lotemp%))
348.                 CALL Line.edit(Lotempst$, 3, Exit.code%)
349.                 Entry% = VAL(Lotempst$)
350.                 IF Entry% = 999 THEN
351.                     Psf.lotemp% = Entry%
352.                 ELSE
353.                     IF Checkint%(Entry%, -99, 23) = YES THEN Psf.lotemp% = Entry%
354.                 END IF
355.             CASE 16
356.                 Sermarkst$ = LTRIM$(STR$(Psf.sermark%))
357.                 CALL Line.edit(Sermarkst$, 1, Exit.code%)
358.                 Entry% = VAL(Sermarkst$)
359.                 IF Checkint%(Entry%, 0, 1) = YES THEN Psf.sermark% = Entry%
360.             CASE 18
361.                 CALL Line.edit(Psf.history$, 80, Exit.code%)
362.             CASE 19
363.                 CALL Line.edit(Psf.crn$, 6, Exit.code%)
364.             CASE 20
365.                 CALL Line.edit(Psf.eng$, 10, Exit.code%)
366.         END SELECT
367.         SELECT CASE Exit.code%
368.             CASE 9, 80, 13 'TAB, Down, ENTER
369.                 SELECT CASE Lineno%
370.                     CASE 4
371.                         Lineno% = Lineno% + 3
372.                     CASE 10, 16
373.                         Lineno% = Lineno% + 2
374.                     CASE 20
375.                     CASE ELSE
376.                         Lineno% = Lineno% + 1
377.                 END SELECT
378.             CASE 15, 72 'Shift TAB, Up
379.                 SELECT CASE Lineno%
380.                     CASE 4
381.                     CASE 7
382.                         Lineno% = Lineno% - 3
383.                     CASE 12, 18
384.                         Lineno% = Lineno% - 2
385.                     CASE ELSE
386.                         Lineno% = Lineno% - 1
387.                 END SELECT
388.             CASE 71 'Home
389.                 Lineno% = 4
390.             CASE 79 'End
391.                 Lineno% = 20
392.             CASE 81 'Pg Down
393.                 Pageno% = 2
394.                 Stay% = NO
395.             CASE 73 'Pg Up
396.             CASE 27 'ESC
397.                 Pageno% = 0
398.                 Stay% = NO
399.         END SELECT
400.     WEND
401. END SUB
402.  
403. SUB Edit.head2 (Pageno%, Edit.set%, Edit.line%, Copy.set%)
404.     'Move cursor around second header screen and edit data
405.     STATIC Numparsst AS STRING * 3
406.     STATIC Numspacesst AS STRING * 3
407.     STATIC Setst AS STRING * 1
408.     STATIC Linest AS STRING * 3
409.     STATIC Copysetst AS STRING * 1
410.     Lineno% = 5
411.     Stay% = YES
412.     WHILE Stay% = YES
413.         CALL Show.head2(Edit.set%, Edit.line%, Copy.set%)
414.         IF Lineno% < 10 THEN
415.             Colno% = 1
416.         ELSE
417.             Colno% = 30
418.         END IF
419.         LOCATE Lineno%, Colno%
420.         SELECT CASE Lineno%
421.             CASE 5
422.                 CALL Line.edit(Psf.comment1$, 80, Exit.code%)
423.             CASE 6
424.                 CALL Line.edit(Psf.comment2$, 80, Exit.code%)
425.             CASE 7
426.                 CALL Line.edit(Psf.comment3$, 80, Exit.code%)
427.             CASE 8
428.                 CALL Line.edit(Psf.comment4$, 80, Exit.code%)
429.             CASE 9
430.                 CALL Line.edit(Psf.comment5$, 80, Exit.code%)
431.             CASE 11
432.                 CALL Line.edit(Psf.setlabel$(0), 20, Exit.code%)
433.             CASE 12
434.                 Numparsst$ = LTRIM$(STR$(Psf.numpars%(0)))
435.                 CALL Line.edit(Numparsst$, 3, Exit.code%)
436.                 Entry% = VAL(Numparsst$)
437.                 IF Checkint%(Entry%, 1, Psf.numspaces%) = YES THEN Psf.numpars%(0) = Entry%
438.             CASE 13
439.                 CALL Line.edit(Psf.setlabel$(1), 20, Exit.code%)
440.             CASE 14
441.                 Numparsst$ = LTRIM$(STR$(Psf.numpars%(1)))
442.                 CALL Line.edit(Numparsst$, 3, Exit.code%)
443.                 Entry% = VAL(Numparsst$)
444.                 IF Checkint%(Entry%, 0, Psf.numspaces%) = YES THEN Psf.numpars%(1) = Entry%
445.             CASE 15
446.                 CALL Line.edit(Psf.setlabel$(2), 20, Exit.code%)
447.             CASE 16
448.                 Numparsst$ = LTRIM$(STR$(Psf.numpars%(2)))
449.                 CALL Line.edit(Numparsst$, 3, Exit.code%)
450.                 Entry% = VAL(Numparsst$)
451.                 IF Checkint%(Entry%, 0, Psf.numspaces%) = YES THEN Psf.numpars%(2) = Entry%
452.             CASE 17
453.                 CALL Line.edit(Psf.setlabel$(3), 20, Exit.code%)
454.             CASE 18
455.                 Numparsst$ = LTRIM$(STR$(Psf.numpars%(3)))
456.                 CALL Line.edit(Numparsst$, 3, Exit.code%)
457.                 Entry% = VAL(Numparsst$)
458.                 IF Checkint%(Entry%, 0, Psf.numspaces%) = YES THEN Psf.numpars%(3) = Entry%
459.             CASE 19
460.                 Numspacesst$ = LTRIM$(STR$(Psf.numspaces%))
461.                 CALL Line.edit(Numspacesst$, 3, Exit.code%)
462.                 Entry% = VAL(Numspacesst$)
463.                 IF Checkint%(Entry%, 1, 220) = YES THEN Psf.numspaces% = Entry%
464.             CASE 21
465.                 Setst$ = LTRIM$(STR$(Edit.set%))
466.                 CALL Line.edit(Setst$, 1, Exit.code%)
467.                 Entry% = VAL(Setst$)
468.                 IF Checkint%(Entry%, 0, Psf.numsets%) = YES THEN Edit.set% = Entry%
469.             CASE 22
470.                 Linest$ = LTRIM$(STR$(Edit.line%))
471.                 CALL Line.edit(Linest$, 3, Exit.code%)
472.                 Entry% = VAL(Linest$)
473.                 IF Checkint%(Entry%, 1, 220) = YES THEN Edit.line% = Entry%
474.             CASE 23
475.                 Copysetst$ = LTRIM$(STR$(Copy.set%))
476.                 CALL Line.edit(Copysetst$, 1, Exit.code%)
477.                 Entry% = VAL(Copysetst$)
478.                 IF Checkint%(Entry%, 0, Psf.numsets%) = YES THEN Copy.set% = Entry%
479.         END SELECT
480.         SELECT CASE Exit.code%
481.             CASE 9, 80, 13 'TAB, Down, ENTER
482.                 SELECT CASE Lineno%
483.                     CASE 9, 19
484.                         Lineno% = Lineno% + 2
485.                     CASE 14
486.                         Lineno% = 15: IF Psf.numpars%(1) = 0 THEN Lineno% = 19
487.                     CASE 16
488.                         Lineno% = 17: IF Psf.numpars%(2) = 0 THEN Lineno% = 19
489.                     CASE 23
490.                     CASE ELSE
491.                         Lineno% = Lineno% + 1
492.                 END SELECT
493.             CASE 15, 72 'Shift TAB, Up
494.                 SELECT CASE Lineno%
495.                     CASE 5
496.                     CASE 11, 21
497.                         Lineno% = Lineno% - 2
498.                     CASE 19
499.                         IF Psf.numpars%(1) = 0 THEN
500.                             Lineno% = 14
501.                         ELSEIF Psf.numpars%(2) = 0 THEN
502.                             Lineno% = 16
503.                         ELSE
504.                             Lineno% = 18
505.                         END IF
506.                     CASE ELSE
507.                         Lineno% = Lineno% - 1
508.                 END SELECT
509.             CASE 71 'Home
510.                 Lineno% = 5
511.             CASE 79 'End
512.                 Lineno% = 23
513.             CASE 73 'Pg Up
514.                 Pageno% = 1
515.                 Stay% = NO
516.             CASE 81 'Pg Down
517.                 Pageno% = 3
518.                 Stay% = NO
519.             CASE 27 'ESC
520.                 Pageno% = 0
521.                 Stay% = NO
522.             CASE 67 'F9
523.                 Setst$ = LTRIM$(STR$(Edit.set%))
524.                 IF Ask("Are you sure you want to MAKE INDICES = LINE NUMBERS in Set " + Setst$) = YES THEN
525.                     FOR Line.number% = 1 TO Psf.numpars%(Edit.set%)
526.                         Psfset(Edit.set%, Line.number%).Index = Line.number%
527.                     NEXT Line.number%
528.                 END IF
529.                 COLOR , 4
530.             CASE 68 'F10
531.                 IF Copy.set% <> Edit.set% THEN
532.                     Setst$ = LTRIM$(STR$(Edit.set%))
533.                     Copysetst$ = LTRIM$(STR$(Copy.set%))
534.                     IF Ask("Are you sure you want to COPY SET " + Setst$ + " TO SET " + Copysetst$) = YES THEN
535.                         Psf.numpars%(Copy.set%) = Psf.numpars%(Edit.set%)
536.                         FOR Line.number% = 1 TO Psf.numpars%(Edit.set%)
537.                             Psfset(Copy.set%, Line.number%).Index = Psfset(Edit.set%, Line.number%).Index
538.                             Psfset(Copy.set%, Line.number%).Label = Psfset(Edit.set%, Line.number%).Label
539.                             Psfset(Copy.set%, Line.number%).Units = Psfset(Edit.set%, Line.number%).Units
540.                             Psfset(Copy.set%, Line.number%).Lower = Psfset(Edit.set%, Line.number%).Lower
541.                             Psfset(Copy.set%, Line.number%).Upper = Psfset(Edit.set%, Line.number%).Upper
542.                         NEXT Line.number%
543.                     END IF
544.                 END IF
545.                 COLOR , 4
546.         END SELECT
547.         IF Psf.numpars%(1) = 0 THEN
548.             Psf.numpars%(2) = 0
549.             Psf.numpars%(3) = 0
550.             Psf.numsets% = 1
551.         ELSEIF Psf.numpars%(2) = 0 THEN
552.             Psf.numpars%(3) = 0
553.             Psf.numsets% = 2
554.         ELSEIF Psf.numpars%(3) = 0 THEN
555.             Psf.numsets% = 3
556.         ELSE
557.             Psf.numsets% = 4
558.         END IF
559.         IF Edit.set% > Psf.numsets% THEN Edit.set% = Psf.numsets%
560.         IF Copy.set% > Psf.numsets% THEN Copy.set% = Psf.numsets%
561.     WEND
562.     IF Edit.set% > Psf.numsets% - 1 THEN Edit.set% = Psf.numsets% - 1
563. END SUB
564.  
565. SUB Edit.param (Pageno%, Edit.set%, Edit.line%)
566.     'Scroll and edit parameter data
567.     STATIC Indexst AS STRING * 3
568.     STATIC Lowerst AS STRING * 10
569.     STATIC Upperst AS STRING * 10
570.     Colno% = 7
571.     Stay% = YES
572.     IF Psf.numpars%(Edit.set%) = 0 THEN
573.         Pageno% = 2
574.         Stay% = NO
575.     END IF
576.     WHILE Stay% = YES
577.         CALL Show.param(Edit.set%, Edit.line%)
578.         LOCATE 14, Colno%
579.         SELECT CASE Colno%
580.             CASE 7
581.                 Indexst$ = LTRIM$(STR$(Psfset(Edit.set%, Edit.line%).Index))
582.                 CALL Line.edit(Indexst$, 3, Exit.code%)
583.                 Entry% = VAL(Indexst$)
584.                 Unique% = YES
585.                 FOR Line.number% = 1 TO Psf.numpars%(Edit.set%)
586.                     IF Line.number% <> Edit.line% THEN
587.                         IF Psfset(Edit.set%, Line.number%).Index = Entry% THEN Unique% = NO
588.                     END IF
589.                 NEXT Line.number%
590.                 IF Unique% = YES THEN
591.                     Psfset(Edit.set%, Edit.line%).Index = Entry%
592.                 ELSE
593.                     SOUND 300, 4: COLOR , 4: LOCATE 23, 1: PRINT "INDEX"; Entry%; "ALREADY USED! Indices must be unique within each set. Press any key.";
594.                     CALL Waitkey
595.                     Exit.code% = 0
596.                 END IF
597.             CASE 13
598.                 CALL Line.edit(Psfset(Edit.set%, Edit.line%).Label, 24, Exit.code%)
599.             CASE 40
600.                 CALL Line.edit(Psfset(Edit.set%, Edit.line%).Units, 5, Exit.code%)
601.             CASE 48
602.                 Lowerst$ = LTRIM$(STR$(Psfset(Edit.set%, Edit.line%).Lower))
603.                 CALL Line.edit(Lowerst$, 10, Exit.code%)
604.                 Entry.real! = VAL(Lowerst$)
605.                 IF Entry.real! < -9999.999 THEN Entry.real! = -9999.999
606.                 IF Entry.real! > 9999.999 THEN Entry.real! = 9999.999
607.                 Hilim! = Psfset(Edit.set%, Edit.line%).Upper
608.                 IF Checkreal%(Entry.real!, -9999.999, Hilim!) = YES THEN
609.                     Psfset(Edit.set%, Edit.line%).Lower = Entry.real!
610.                 ELSE
611.                     IF Exit.code% = 9 OR Exit.code% = 13 THEN
612.                         Psfset(Edit.set%, Edit.line%).Lower = Entry.real!
613.                     ELSE
614.                         SOUND 300, 4: COLOR , 4: LOCATE 23, 1: PRINT "LIMITS OUT OF RANGE! (-/+9999.999 and LOWER < UPPER). Press any key.";
615.                         CALL Waitkey
616.                         Exit.code% = 0
617.                     END IF
618.                 END IF
619.             CASE 61
620.                 Upperst$ = LTRIM$(STR$(Psfset(Edit.set%, Edit.line%).Upper))
621.                 CALL Line.edit(Upperst$, 10, Exit.code%)
622.                 Entry.real! = VAL(Upperst$)
623.                 IF Entry.real! < -9999.999 THEN Entry.real! = -9999.999
624.                 IF Entry.real! > 9999.999 THEN Entry.real! = 9999.999
625.                 Lolim! = Psfset(Edit.set%, Edit.line%).Lower
626.                 IF Checkreal%(Entry.real!, Lolim!, 9999.999) = YES THEN
627.                     Psfset(Edit.set%, Edit.line%).Upper = Entry.real!
628.                 ELSE
629.                     IF Exit.code% = 15 THEN
630.                         Psfset(Edit.set%, Edit.line%).Upper = Entry.real!
631.                     ELSE
632.                         SOUND 300, 4: COLOR , 4: LOCATE 23, 1: PRINT "LIMITS OUT OF RANGE! (-/+9999.999 and LOWER < UPPER). Press any key.";
633.                         CALL Waitkey
634.                         Exit.code% = 0
635.                     END IF
636.                 END IF
637.         END SELECT
638.         SELECT CASE Exit.code%
639.             CASE 0
640.             CASE 9, 13 'TAB, ENTER
641.                 IF Colno% < 13 THEN
642.                     Colno% = 13
643.                 ELSEIF Colno% < 40 THEN
644.                     Colno% = 40
645.                 ELSEIF Colno% < 48 THEN
646.                     Colno% = 48
647.                 ELSEIF Colno% < 61 THEN
648.                     Colno% = 61
649.                 END IF
650.             CASE 15 'Shift TAB
651.                 IF Colno% >= 61 THEN
652.                     Colno% = 48
653.                 ELSEIF Colno% >= 48 THEN
654.                     Colno% = 40
655.                 ELSEIF Colno% >= 40 THEN
656.                     Colno% = 13
657.                 ELSEIF Colno% >= 13 THEN
658.                     Colno% = 7
659.                 END IF
660.             CASE 80 'Down
661.                 IF Edit.line% < Psf.numpars%(Edit.set%) THEN Edit.line% = Edit.line% + 1
662.             CASE 72 'Up
663.                 IF Edit.line% > 1 THEN Edit.line% = Edit.line% - 1
664.             CASE 71 'Home
665.                 Edit.line% = 1
666.             CASE 79 'End
667.                 Edit.line% = Psf.numpars%(Edit.set%)
668.             CASE 67 'F9
669.                 IF Psf.numpars%(Edit.set%) < Psf.numspaces% THEN
670.                     FOR Line.number% = Psf.numpars%(Edit.set%) TO Edit.line% STEP -1
671.                         Psfset(Edit.set%, (Line.number% + 1)).Index = Psfset(Edit.set%, Line.number%).Index
672.                         Psfset(Edit.set%, (Line.number% + 1)).Label = Psfset(Edit.set%, Line.number%).Label
673.                         Psfset(Edit.set%, (Line.number% + 1)).Units = Psfset(Edit.set%, Line.number%).Units
674.                         Psfset(Edit.set%, (Line.number% + 1)).Lower = Psfset(Edit.set%, Line.number%).Lower
675.                         Psfset(Edit.set%, (Line.number% + 1)).Upper = Psfset(Edit.set%, Line.number%).Upper
676.                     NEXT Line.number%
677.                     Psfset(Edit.set%, Edit.line%).Index = 0
678.                     Psfset(Edit.set%, Edit.line%).Label = ""
679.                     Psfset(Edit.set%, Edit.line%).Units = ""
680.                     Psfset(Edit.set%, Edit.line%).Lower = 0
681.                     Psfset(Edit.set%, Edit.line%).Upper = 0
682.                     Psf.numpars%(Edit.set%) = Psf.numpars%(Edit.set%) + 1
683.                 ELSE
684.                     SOUND 300, 4: COLOR , 4: LOCATE 23: PRINT "NO SPACE to insert new parameter! Increase TRF record size first. Press any key.";
685.                     CALL Waitkey
686.                 END IF
687.             CASE 68 'F10
688.                 IF Ask("Are you sure you want to DELETE THIS LINE") = YES THEN
689.                     IF Edit.line% < Psf.numpars%(Edit.set%) THEN
690.                         FOR Line.number% = Edit.line% + 1 TO Psf.numpars%(Edit.set%)
691.                             Psfset(Edit.set%, (Line.number% - 1)).Index = Psfset(Edit.set%, Line.number%).Index
692.                             Psfset(Edit.set%, (Line.number% - 1)).Label = Psfset(Edit.set%, Line.number%).Label
693.                             Psfset(Edit.set%, (Line.number% - 1)).Units = Psfset(Edit.set%, Line.number%).Units
694.                             Psfset(Edit.set%, (Line.number% - 1)).Lower = Psfset(Edit.set%, Line.number%).Lower
695.                             Psfset(Edit.set%, (Line.number% - 1)).Upper = Psfset(Edit.set%, Line.number%).Upper
696.                         NEXT Line.number%
697.                     END IF
698.                     Psfset(Edit.set%, Psf.numpars%(Edit.set%)).Index = 0
699.                     Psfset(Edit.set%, Psf.numpars%(Edit.set%)).Label = ""
700.                     Psfset(Edit.set%, Psf.numpars%(Edit.set%)).Units = ""
701.                     Psfset(Edit.set%, Psf.numpars%(Edit.set%)).Lower = 0
702.                     Psfset(Edit.set%, Psf.numpars%(Edit.set%)).Upper = 0
703.                     Psf.numpars%(Edit.set%) = Psf.numpars%(Edit.set%) - 1
704.                     IF Psf.numpars%(Edit.set%) = 0 THEN
705.                         Pageno% = 2
706.                         Stay% = NO
707.                     END IF
708.                 END IF
709.                 COLOR , 4
710.             CASE 73 'Pg Up
711.                 Pageno% = 2
712.                 Stay% = NO
713.             CASE 81 'Pg Down
714.             CASE 27 'ESC
715.                 Pageno% = 0
716.                 Stay% = NO
717.         END SELECT
718.     WEND
719. END SUB
720.  
721. SUB Edit.setup
722.     'Move cursor around setup screen and edit data
723.     Prev.issue$ = "1  "
724.     Lineno% = 9
725.     Stay% = YES
726.     WHILE Stay% = YES
727.         CALL Show.bars
728.         CALL Show.setup
729.         LOCATE Lineno%, 20
730.         SELECT CASE Lineno%
731.             CASE 7
732.                 CALL Line.edit(Drive$, 1, Exit.code%)
733.                 Drive$ = UCASE$(LEFT$(Drive$, 1))
734.             CASE 8
735.                 CALL Line.edit(Path$, 40, Exit.code%)
736.                 Path$ = UCASE$(LTRIM$(RTRIM$(Path$)))
737.                 IF LEFT$(Path$, 1) <> "\" THEN Path$ = "\" + Path$
738.                 IF RIGHT$(Path$, 1) <> "\" THEN Path$ = Path$ + "\"
739.             CASE 9
740.                 CALL Line.edit(TType.number$, 6, Exit.code%)
741.             CASE 10
742.                 Option$ = LEFT$(Psfoption$, 1)
743.                 CALL Line.edit(Option$, 1, Exit.code%)
744.                 Option$ = UCASE$(Option$)
745.                 SELECT CASE Option$
746.                     CASE "C"
747.                         Psfoption$ = "CURRENT"
748.                     CASE "P"
749.                         Psfoption$ = "PREVIOUS"
750.                     CASE "H"
751.                         Psfoption$ = "HYPOTHETICAL"
752.                 END SELECT
753.             CASE 11
754.                 Edit.prev.issue$ = Prev.issue$
755.                 CALL Line.edit(Edit.prev.issue$, 3, Exit.code%)
756.                 IF Dosvalid%(Edit.prev.issue$) = YES THEN Prev.issue$ = Edit.prev.issue$
757.         END SELECT
758.         SELECT CASE Exit.code%
759.             CASE 80, 13 'Down, ENTER
760.                 IF Lineno% < 10 THEN Lineno% = Lineno% + 1
761.                 IF Lineno% = 10 AND Psfoption$ = "PREVIOUS" THEN Lineno% = 11
762.             CASE 72 'Up
763.                 IF Lineno% > 7 THEN Lineno% = Lineno% - 1
764.             CASE 71 'Home
765.                 Lineno% = 7
766.             CASE 79 'End
767.                 IF Psfoption$ = "PREVIOUS" THEN
768.                     Lineno% = 11
769.                 ELSE
770.                     Lineno% = 10
771.                 END IF
772.             CASE 81, 73 'Pg Down, Pg Up
773.             CASE 27 'ESC
774.                 Stay% = NO
775.         END SELECT
776.     WEND
777.     CALL Show.setup
778. END SUB
779.  
780. SUB Hist.print
781.     'Print out the History Report entry for the PSF now loaded
782.     PRINT #1, " " '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<, just skip ???  blank line I bet!
783.     IF Plain$(Psf.crn$) <> "NONE" THEN
784.         Issued$ = ") issued under Change Note No. " + Psf.crn$
785.     ELSE
786.         Issued$ = ") not issued."
787.     END IF
788.     PRINT #1, Psfoption$; " ("; Psf$; Issued$
789.     PRINT #1, "PROG Iss. "; Psf.progiss$; " - "; Psf.progdate$; "  SPEC "; Psf.sourcename$; " Iss. "; Psf.sourceiss$; " - "; Psf.sourcedate$
790.     IF LTRIM$(RTRIM$(Psf.amendrefs$)) <> "" THEN PRINT #1, Psf.amendrefs$
791.     PRINT #1, Psf.history$
792. END SUB
793.  
794. SUB Hist.show
795.     'Display the History Report entry for the PSF now loaded
796.     COLOR 14, 4: PRINT
797.     IF Plain$(Psf.crn$) <> "NONE" THEN
798.         Issued$ = " issued under Change Note No. " + Psf.crn$
799.     ELSE
800.         Issued$ = " not issued."
801.     END IF
802.     COLOR 14: PRINT Psfoption$; " ("; Psf$; ")";: COLOR 15: PRINT Issued$
803.     PRINT "PROG Iss. "; Psf.progiss$; " - "; Psf.progdate$; "  SPEC "; Psf.sourcename$; " Iss. "; Psf.sourceiss$; " - "; Psf.sourcedate$
804.     IF LTRIM$(RTRIM$(Psf.amendrefs$)) <> "" THEN PRINT Psf.amendrefs$
805.     PRINT Psf.history$
806. END SUB
807.  
808. SUB HISTORY
809.     STATIC Lotempst AS STRING * 8
810.     STATIC Hitempst AS STRING * 8
811.     IF Choose.done% = NO THEN
812.         SOUND 300, 4
813.         CALL State("Working file not specified yet; select CHOOSE first. Press any key.")
814.         CALL Waitkey
815.         EXIT SUB
816.     END IF
817.     IF Psfoption$ <> "CURRENT" THEN
818.         SOUND 300, 4
819.         CALL State("You can produce a History Report only from a CURRENT PSF . Press any key.")
820.         CALL Waitkey
821.         EXIT SUB
822.     END IF
823.     Pathname$ = Drive$ + ":" + Path$ + Psf$
824.     Fileunfound% = RESETFLAG
825.     OPEN Pathname$ FOR INPUT AS #2
826.     IF Fileunfound% = NO THEN
827.         CALL Read.psf
828.         CLOSE #2
829.     END IF
830.     History.complete% = YES
831.     CLS 2
832.     LOCATE 3: COLOR 14
833.     PRINT "HISTORY REPORT for "; TType.number$; " produced on "; British$(DATE$); " @ "; LEFT$(TIME$, 5); " Engineer:"; Psf.eng$
834.     COLOR 15: PRINT STRING$(78, "-")
835.     PRINT "Program + "; Psf$; SPACE$(19 - LEN(Psf$)); "Issue:"; Psf.progiss$; "               Dated:"; Psf.progdate$
836.     PRINT "Source:"; Psf.sourcename$; "  Issue:"; Psf.sourceiss$; "             Dated:"; Psf.sourcedate$
837.     IF Psf.sermark% = YES THEN
838.         Sermarked$ = "              Serial Marked"
839.     ELSE
840.         Sermarked$ = "              Not Serial Marked"
841.     END IF
842.     PRINT "Customer Reference:"; Psf.custype$; Sermarked$
843.     IF Psf.lotemp% = 999 THEN
844.         Lotempst$ = " N/A    "
845.     ELSE
846.         Lotempst$ = "=" + STR$(Psf.lotemp%) + "DegC"
847.     END IF
848.     IF Psf.hitemp% = 999 THEN
849.         Hitempst$ = " N/A    "
850.     ELSE
851.         Hitempst$ = "=" + RTRIM$(LTRIM$(STR$(Psf.hitemp%))) + "DegC"
852.     END IF
853.     PRINT "Low Temp."; Lotempst$; "            Ambient Temp.=23DegC    High Temp."; Hitempst$
854.     PRINT STRING$(78, "-")
855.     Line.counter% = 7
856.     CALL Hist.show
857.     Line.counter% = Line.counter% + 5
858.     Psfoption$ = "PREVIOUS"
859.     Preceding.issue% = Dosvalid%(Psf.preceding$)
860.     WHILE Preceding.issue% = YES
861.         Psf$ = TType.number$ + "P." + Noblanks$(Psf.preceding$)
862.         Pathname$ = Drive$ + ":" + Path$ + Psf$
863.         Fileunfound% = RESETFLAG
864.         OPEN Pathname$ FOR INPUT AS #2
865.         IF Fileunfound% = NO THEN
866.             CALL Read.psf
867.             CLOSE #2
868.             CALL Hist.show
869.             Line.counter% = Line.counter% + 5
870.             Preceding.issue% = Dosvalid%(Psf.preceding$)
871.             IF Line.counter% > 14 THEN
872.                 CALL State("Press any key to continue."): COLOR 15, 4
873.                 CALL Waitkey
874.                 Line.counter% = 0
875.                 CLS 2: LOCATE 3
876.             END IF
877.         ELSE
878.             PRINT: COLOR 14
879.             PRINT "HISTORY REPORT MAY BE INCOMPLETE: "; Psf$; " was referenced but not found."
880.             COLOR 15
881.             Preceding.issue% = NO
882.             History.complete% = NO
883.         END IF
884.     WEND
885.     IF History.complete% = YES THEN
886.         PRINT: COLOR 14
887.         PRINT "HISTORY REPORT COMPLETE."
888.         COLOR 15
889.     END IF
890.     Psfoption$ = "CURRENT"
891.     Psf$ = TType.number$ + "C.PSF"
892.     Pathname$ = Drive$ + ":" + Path$ + Psf$
893.     OPEN Pathname$ FOR INPUT AS #2
894.     CALL Read.psf
895.     CLOSE #2
896.     IF Ask%("Do you want to PRINT THIS REPORT") = YES THEN
897.         History.complete% = YES
898.         PRINT #1, "HISTORY REPORT for "; TType.number$; " produced on "; British$(DATE$); " @ "; LEFT$(TIME$, 5); " Engineer:"; Psf.eng$
899.         PRINT #1, STRING$(78, "-")
900.         PRINT #1, "Program + "; Psf$; SPACE$(19 - LEN(Psf$)); "Issue:"; Psf.progiss$; "               Dated:"; Psf.progdate$
901.         PRINT #1, "Source:"; Psf.sourcename$; "  Issue:"; Psf.sourceiss$; "             Dated:"; Psf.sourcedate$
902.         IF Psf.sermark% = YES THEN
903.             Sermarked$ = "              Serial Marked"
904.         ELSE
905.             Sermarked$ = "              Not Serial Marked"
906.         END IF
907.         PRINT #1, "Customer Reference:"; Psf.custype$; Sermarked$
908.         IF Psf.lotemp% = 999 THEN
909.             Lotempst$ = " N/A    "
910.         ELSE
911.             Lotempst$ = "=" + STR$(Psf.lotemp%) + "DegC"
912.         END IF
913.         IF Psf.hitemp% = 999 THEN
914.             Hitempst$ = " N/A    "
915.         ELSE
916.             Hitempst$ = "=" + RTRIM$(LTRIM$(STR$(Psf.hitemp%))) + "DegC"
917.         END IF
918.         PRINT #1, "Low Temp."; Lotempst$; "            Ambient Temp.=23DegC    High Temp."; Hitempst$
919.         PRINT #1, STRING$(78, "-")
920.         CALL Hist.print
921.         Line.counter% = 1
922.         Psfoption$ = "PREVIOUS"
923.         Preceding.issue% = Dosvalid%(Psf.preceding$)
924.         WHILE Preceding.issue% = YES
925.             Psf$ = TType.number$ + "P." + Noblanks$(Psf.preceding$)
926.             Pathname$ = Drive$ + ":" + Path$ + Psf$
927.             Fileunfound% = RESETFLAG
928.             OPEN Pathname$ FOR INPUT AS #2
929.             IF Fileunfound% = NO THEN
930.                 CALL Read.psf
931.                 CLOSE #2
932.                 CALL Hist.print
933.                 Line.counter% = Line.counter% + 1
934.                 Preceding.issue% = Dosvalid%(Psf.preceding$)
935.             ELSE
936.                 PRINT #1, " "
937.                 PRINT #1, "HISTORY REPORT MAY BE INCOMPLETE: "; Psf$; " was referenced but not found."
938.                 Preceding.issue% = NO
939.                 History.complete% = NO
940.             END IF
941.         WEND
942.         IF History.complete% = YES THEN
943.             PRINT #1, " "
944.             PRINT #1, "HISTORY REPORT COMPLETE."
945.         END IF
946.         PRINT #1, CHR$(12)
947.         Psfoption$ = "CURRENT" ' Restore current file
948.         Psf$ = TType.number$ + "C.PSF"
949.         Pathname$ = Drive$ + ":" + Path$ + Psf$
950.         OPEN Pathname$ FOR INPUT AS #2
951.         CALL Read.psf
952.         CLOSE #2
953.     END IF
954. END SUB
955.  
956. SUB Init.vars
957.     'Initialise all shared variables
958.  
959.     Fileunfound% = RESETFLAG
960.     OPEN "C:\BLP\SPECS\OPTIONH.PSF" FOR INPUT AS #2
961.     IF Fileunfound% = NO THEN
962.         CALL Read.psf
963.         CLOSE #2
964.         Host$ = Psf.custype$
965.         Drive$ = UCASE$(LEFT$(Psf.progdate$, 1))
966.     ELSE
967.         Host$ = ""
968.         Drive$ = "C"
969.     END IF
970.  
971.     Printerok% = YES
972.     TType.number$ = "~~~~~~"
973.     Choose.done% = NO
974.     Path$ = "\BLP\SPECS\"
975.     Psf$ = "SPECEDIT.PSF"
976.     Psfoption$ = "CURRENT"
977.     Fileunfound% = FALSE
978.     Fileduplicate% = FALSE
979.  
980. END SUB
981.  
982. SUB Line.edit (Edit.string$, Field.size%, Exit.code%)
983.     'Line editor - processes left & right arrow, delete and insert keys to edit
984.     'Edit.string$, which is padded if necessary to a length of Field.size%.
985.     'Exit.code% is ASCII code of key used to quit line edit:- TAB, Shift+TAB, Up,
986.     'Down, ENTER, Pg Up, Pg Down, ESC, Home, End, F9, F10
987.     COLOR , 0
988.     IF Field.size% < LEN(Edit.string$) THEN
989.         PRINT "Line.edit: Edit string exceeds field size": STOP
990.     END IF
991.     Start.char% = POS(0)
992.     End.char% = Start.char% + Field.size% - 1
993.     Char% = Start.char%
994.     Insert.mode% = NO: LOCATE , , , 0, 7
995.     Stay% = YES
996.     WHILE Stay% = YES
997.         Spaces% = Field.size% - LEN(Edit.string$)
998.         Edit.string$ = Edit.string$ + STRING$(Spaces%, " ")
999.         LOCATE , Start.char%: PRINT Edit.string$;: LOCATE , Char%, 1
1000.         Chars.left% = Char% - Start.char%
1001.         Chars.right% = Start.char% + LEN(Edit.string$) - Char% - 1: IF Chars.right% < 0 THEN Chars.right% = 0
1002.         Left.part$ = LEFT$(Edit.string$, Chars.left%)
1003.         Right.part$ = RIGHT$(Edit.string$, Chars.right%)
1004.         Incl.right.part$ = RIGHT$(Edit.string$, Chars.right% + 1)
1005.         DO
1006.             K$ = INKEY$
1007.         LOOP WHILE K$ <> "" 'Empty keyboard buffer
1008.         DO
1009.             K$ = INKEY$
1010.         LOOP WHILE K$ = ""
1011.         Keycode$ = RIGHT$(K$, 1)
1012.         Ascii% = ASC(Keycode$)
1013.         IF LEN(K$) = 2 THEN Ascii% = Ascii% * 100 ' EXTENDED CODE
1014.         SELECT CASE Ascii%
1015.             CASE 8, 7500 'LEFT
1016.                 IF Char% > Start.char% THEN Char% = Char% - 1: LOCATE , Char%
1017.             CASE 7700 'RIGHT
1018.                 IF Char% < End.char% THEN Char% = Char% + 1: LOCATE , Char%
1019.             CASE 8200 'INSERT
1020.                 IF Insert.mode% = NO THEN
1021.                     Insert.mode% = YES: LOCATE , , , 7, 7
1022.                 ELSE
1023.                     Insert.mode% = NO: LOCATE , , , 0, 7
1024.                 END IF
1025.             CASE 8300 'DELETE
1026.                 Edit.string$ = Left.part$ + Right.part$
1027.             CASE 9, 1500, 7200, 8000, 13, 7300, 8100, 27, 7100, 7900, 6700, 6800 'EXIT CODES
1028.                 Exit.code% = Ascii%: IF Exit.code% > 255 THEN Exit.code% = Exit.code% / 100
1029.                 LOCATE , , 0, 7, 7
1030.                 Stay% = NO
1031.             CASE ELSE 'CHARACTER
1032.                 IF Ascii% > 31 AND Ascii% < 128 THEN
1033.                     IF Insert.mode% = YES THEN
1034.                         Edit.string$ = Left.part$ + CHR$(Ascii%) + LEFT$(Incl.right.part$, Chars.right%)
1035.                     ELSE 'Overwrite
1036.                         Edit.string$ = Left.part$ + CHR$(Ascii%) + Right.part$
1037.                     END IF
1038.                     IF Char% < End.char% THEN Char% = Char% + 1: LOCATE , Char%
1039.                 END IF
1040.         END SELECT
1041.     WEND
1042.     COLOR , 4
1043. END SUB
1044.  
1045. SUB Read.psf
1046.     'Enter all data from PSF file, which has already been opened as #2
1047.     DIM Psfparamst AS Psfparamsttype
1048.     LINE INPUT #2, Psf.typeno$: LINE INPUT #2, Psf.progiss$
1049.     LINE INPUT #2, Psf.preceding$: LINE INPUT #2, Psf.progdate$
1050.     LINE INPUT #2, Psf.sourcename$: LINE INPUT #2, Psf.sourceiss$
1051.     LINE INPUT #2, Psf.sourcedate$: LINE INPUT #2, Psf.amendrefs$
1052.     LINE INPUT #2, Psf.custype$: LINE INPUT #2, Psf.hitempst$
1053.     LINE INPUT #2, Psf.lotempst$: LINE INPUT #2, Psf.sermarkst$
1054.     LINE INPUT #2, Psf.history$: LINE INPUT #2, Psf.crn$
1055.     LINE INPUT #2, Psf.eng$: LINE INPUT #2, Psf.comment1$
1056.     LINE INPUT #2, Psf.comment2$: LINE INPUT #2, Psf.comment3$
1057.     LINE INPUT #2, Psf.comment4$: LINE INPUT #2, Psf.comment5$
1058.     LINE INPUT #2, Psf.numsetsst$
1059.     Psf.numsets% = VAL(Psf.numsetsst$)
1060.     FOR Setno% = 0 TO Psf.numsets% - 1
1061.         LINE INPUT #2, Psf.numparsst$
1062.         Psf.numpars%(Setno%) = VAL(Psf.numparsst$)
1063.     NEXT Setno%
1064.     FOR Setno% = Psf.numsets% TO 3 'Clear unused parameter sets
1065.         Psf.numpars%(Setno%) = 0
1066.     NEXT Setno%
1067.     LINE INPUT #2, Psf.numspacesst$
1068.     FOR Setno% = 0 TO Psf.numsets% - 1
1069.         LINE INPUT #2, Psf.setlabel$(Setno%)
1070.     NEXT Setno%
1071.     FOR Setno% = Psf.numsets% TO 3 'Clear unused parameter sets
1072.         Psf.setlabel$(Setno%) = ""
1073.     NEXT Setno%
1074.     FOR Setno% = 0 TO Psf.numsets% - 1
1075.         FOR Paramno% = 1 TO Psf.numpars%(Setno%)
1076.             LINE INPUT #2, Psfparamst.Index
1077.             LINE INPUT #2, Psfparamst.Label
1078.             LINE INPUT #2, Psfparamst.Units
1079.             LINE INPUT #2, Psfparamst.Lower
1080.             LINE INPUT #2, Psfparamst.Upper
1081.             Psfset(Setno%, Paramno%).Index = VAL(Psfparamst.Index)
1082.             Psfset(Setno%, Paramno%).Label = Psfparamst.Label
1083.             Psfset(Setno%, Paramno%).Units = Psfparamst.Units
1084.             Psfset(Setno%, Paramno%).Lower = VAL(Psfparamst.Lower) / 10000
1085.             Psfset(Setno%, Paramno%).Upper = VAL(Psfparamst.Upper) / 10000
1086.         NEXT Paramno%
1087.     NEXT Setno%
1088.     Psf.hitemp% = VAL(Psf.hitempst$)
1089.     Psf.lotemp% = VAL(Psf.lotempst$)
1090.     Psf.sermark% = VAL(Psf.sermarkst$)
1091.     Psf.numspaces% = VAL(Psf.numspacesst$)
1092. END SUB
1093.  
1094. SUB Show.bars
1095.     'Display / refresh status bars at top & bottom of screen
1096.     Linenum% = CSRLIN
1097.     Colnum% = POS(0)
1098.     VIEW PRINT 1 TO 25: COLOR 4, 7
1099.     LOCATE 1, 1: PRINT SPACE$(80);
1100.     LOCATE 1, 1: PRINT "***  SPECification EDITor   SOFTWARE ISSUE "; Softiss$; Softdate$;: LOCATE 1, 66: PRINT "S J OXLEY   ***";
1101.     LOCATE 25, 1: PRINT "***"; SPACE$(74); "***";
1102.     IF Choose.done% = YES THEN
1103.         Specpath$ = Drive$ + ":" + Path$
1104.         IF LEN(Specpath$) > 22 THEN Specpath$ = LEFT$(Specpath$, 19) + "..."
1105.         LOCATE 25, 5: PRINT "Directory "; Specpath$; "  File "; TType.number$; " - "; Psfoption$;
1106.         IF Psfoption$ <> "HYPOTHETICAL" THEN PRINT "  Issue: "; Psf.progiss$;
1107.     ELSE
1108.         LOCATE 25, 5: PRINT "Working File not chosen.  ";
1109.         LOCATE 25, 40: COLOR 0: PRINT "Running on "; Host$;
1110.     END IF
1111.     VIEW PRINT 2 TO 24: COLOR 15, 4
1112.     LOCATE Linenum%, Colnum%
1113. END SUB
1114.  
1115. SUB Show.head1
1116.     'Display first header edit screen
1117.     STATIC Hitempst AS STRING * 3
1118.     STATIC Lotempst AS STRING * 3
1119.     STATIC Sermarkst AS STRING * 1
1120.     CLS 2
1121.     LOCATE 2: PRINT "Page 1";
1122.     LOCATE , 30: COLOR 15: PRINT "Main Header Data";: COLOR 14: PRINT "      (Yellow fields are optional.)"
1123.     PRINT
1124.     COLOR 15, 4: PRINT "Type Number";: LOCATE , 30: COLOR , 1: PRINT Psf.typeno$
1125.     COLOR 15, 4: PRINT "Program Issue";: LOCATE , 30: PRINT Psf.progiss$
1126.     COLOR 15, 4: PRINT "Preceding Program Issue";: LOCATE , 30: PRINT Psf.preceding$
1127.     COLOR 15, 4: PRINT "Program Date";: LOCATE , 30: COLOR , 1: PRINT Psf.progdate$
1128.     COLOR 15, 4: PRINT "Source Spec Name";: LOCATE , 30: COLOR , 1: PRINT Psf.sourcename$
1129.     COLOR 15, 4: PRINT "Source Spec Issue";: LOCATE , 30: COLOR , 1: PRINT Psf.sourceiss$
1130.     COLOR 14, 4: PRINT "Source Spec Date";: LOCATE , 30: COLOR 15, 1: PRINT Psf.sourcedate$
1131.     COLOR 14, 4: PRINT "Source Spec Amendments..."
1132.     COLOR 15, 1: PRINT Psf.amendrefs$
1133.     COLOR 14, 4: PRINT "Customer Type";: LOCATE , 30: COLOR 15, 1: PRINT Psf.custype$
1134.     Hitempst$ = LTRIM$(STR$(Psf.hitemp%))
1135.     COLOR 15, 4: PRINT "High Temperature [23 to 200]";: LOCATE , 30: COLOR , 1: PRINT Hitempst$;: COLOR , 4: PRINT "    (Enter 999 if not applicable.)"
1136.     Lotempst$ = LTRIM$(STR$(Psf.lotemp%))
1137.     COLOR 15, 4: PRINT "Low Temperature [-99 to 23]";: LOCATE , 30: COLOR , 1: PRINT Lotempst$;: COLOR , 4: PRINT "    (Enter 999 if not applicable.)"
1138.     Sermarkst$ = LTRIM$(STR$(Psf.sermark%))
1139.     COLOR 15, 4: PRINT "Serial Marked";: LOCATE , 30: COLOR , 1: PRINT Sermarkst$;: COLOR , 4: PRINT "      (Enter [0]/1 for [not] serial marked.)"
1140.     COLOR 15, 4: PRINT "Change History..."
1141.     COLOR , 1: PRINT Psf.history$
1142.     COLOR 15, 4: PRINT "Change Note Number";: LOCATE , 30: COLOR , 1: PRINT Psf.crn$;: COLOR , 4: PRINT " (Enter NONE for pre-issue program.)"
1143.     COLOR 14, 4: PRINT "Engineer Responsible";: LOCATE , 30: COLOR 15, 1: PRINT Psf.eng$
1144.     LOCATE 24
1145.     COLOR 15, 2: PRINT "Up/Dn, Home/End, TAB keys to move; Ins/Del as normal; Pg Dn for P.2; ESC to quit";: COLOR 15, 4
1146. END SUB
1147.  
1148.  
1149. SUB Show.head2 (Edit.set%, Edit.line%, Copy.set%)
1150.     'Display second header edit screen
1151.     STATIC Numparsst AS STRING * 3
1152.     STATIC Numspacesst AS STRING * 3
1153.     STATIC Setst AS STRING * 1
1154.     STATIC Linest AS STRING * 3
1155.     STATIC Copysetst AS STRING * 1
1156.     CLS 2
1157.     LOCATE 2: PRINT "Page 2";
1158.     LOCATE , 30: PRINT "Comments & Parameter Set Data"
1159.     PRINT
1160.     COLOR 14, 4: PRINT "Comments...": COLOR 15, 1
1161.     PRINT Psf.comment1$
1162.     PRINT Psf.comment2$
1163.     PRINT Psf.comment3$
1164.     PRINT Psf.comment4$
1165.     PRINT Psf.comment5$
1166.     PRINT
1167.     COLOR 15, 4: PRINT "Parameter Set 0 Label";: LOCATE , 30: COLOR , 1: PRINT Psf.setlabel$(0)
1168.     Numparsst$ = LTRIM$(STR$(Psf.numpars%(0)))
1169.     COLOR 15, 4: PRINT "                Size";: LOCATE , 30: COLOR , 1: PRINT Numparsst$;: COLOR , 4: PRINT "  (1 to TRF record size.)"
1170.     COLOR 14, 4: PRINT "Parameter Set 1 Label";: LOCATE , 30: COLOR 15, 1: PRINT Psf.setlabel$(1)
1171.     Numparsst$ = LTRIM$(STR$(Psf.numpars%(1)))
1172.     COLOR 14, 4: PRINT "                Size";: LOCATE , 30: COLOR 15, 1: PRINT Numparsst$;: COLOR , 4: PRINT "  (1 to TRF record size, 0 if unused.)"
1173.     Col% = 1: IF Psf.numpars(1) = 0 THEN Col% = 4
1174.     COLOR 14, 4: PRINT "Parameter Set 2 Label";: LOCATE , 30: COLOR 15, Col%: PRINT Psf.setlabel$(2)
1175.     Numparsst$ = LTRIM$(STR$(Psf.numpars%(2)))
1176.     COLOR 14, 4: PRINT "                Size";: LOCATE , 30: COLOR 15, Col%: PRINT Numparsst$;: COLOR , 4: PRINT "  (1 to TRF record size, 0 if unused.)"
1177.     Col% = 1: IF Psf.numpars(2) = 0 THEN Col% = 4
1178.     COLOR 14, 4: PRINT "Parameter Set 3 Label";: LOCATE , 30: COLOR 15, Col%: PRINT Psf.setlabel$(3)
1179.     Numparsst$ = LTRIM$(STR$(Psf.numpars%(3)))
1180.     COLOR 14, 4: PRINT "                Size";: LOCATE , 30: COLOR 15, Col%: PRINT Numparsst$;: COLOR , 4: PRINT "  (1 to TRF record size, 0 if unused.)"
1181.     Numspacesst$ = LTRIM$(STR$(Psf.numspaces%))
1182.     COLOR 15, 4: PRINT "TRF Record Size";: LOCATE , 30: COLOR , 1: PRINT Numspacesst$;: COLOR , 4: PRINT "  (1 to 220 parameter spaces in TRF record.)"
1183.     PRINT
1184.     COLOR 15, 2: PRINT SPACE$(80): PRINT SPACE$(80): PRINT SPACE$(80);: LOCATE 20
1185.     Setst$ = LTRIM$(STR$(Edit.set%))
1186.     COLOR 15, 2: PRINT "             Current Set";: LOCATE , 30: COLOR , 0: PRINT Setst$;
1187.     COLOR , 2: LOCATE , 35: PRINT "Pg Dn to Edit Current Line in Current Set"
1188.     Linest$ = LTRIM$(STR$(Edit.line%))
1189.     COLOR 15, 2: PRINT "             Current Line";: LOCATE , 30: COLOR , 0: PRINT Linest$;
1190.     Copysetst$ = LTRIM$(STR$(Copy.set%))
1191.     COLOR , 2: LOCATE , 35: PRINT "F9 for Default Indices in Current Set";
1192.     COLOR 15, 2: PRINT "             Destination Set";: LOCATE , 30: COLOR , 0: PRINT Copysetst$;
1193.     COLOR , 2: LOCATE , 35: PRINT "F10 to Copy Current Set to Destination Set";
1194.     LOCATE 23
1195.     COLOR 15, 2: PRINT "Up/Dn, Home/End or TAB keys to move; Ins; Del; Pg Up/Dn for P.1/P.3; ESC to quit";: COLOR 15, 4
1196. END SUB
1197.  
1198. SUB Show.param (Edit.set%, Edit.line%)
1199.     'Display parameter edit screen
1200.     STATIC Indexst AS STRING * 3
1201.     STATIC Lowerst AS STRING * 10
1202.     STATIC Upperst AS STRING * 10
1203.     CLS 2
1204.     Setlabelst$ = "- " + Psf.setlabel$(Edit.set%)
1205.     LOCATE 2: PRINT "Page 3";: LOCATE , 30: PRINT "Parameter Data for Set"; Edit.set%; Setlabelst$
1206.     COLOR 15, 4: LOCATE 4, 1: PRINT "Line  IND.  LABEL                      UNITS   LOWER        UPPER        Line"
1207.     IF Edit.line% > Psf.numpars%(Edit.set%) THEN Edit.line% = Psf.numpars%(Edit.set%)
1208.     IF Edit.line% < 1 THEN Edit.line% = 1
1209.     FOR Line.number% = Edit.line% - 9 TO Edit.line% + 8
1210.         IF Line.number% > 0 AND Line.number% <= Psf.numpars%(Edit.set%) THEN
1211.             COLOR 15, 4: PRINT Line.number%;
1212.             IF Line.number% = Edit.line% THEN
1213.                 COLOR 15, 1
1214.             ELSE
1215.                 COLOR 14
1216.             END IF
1217.             Indexst$ = LTRIM$(STR$(Psfset(Edit.set%, Line.number%).Index))
1218.             LOCATE , 7: PRINT Indexst$;
1219.             LOCATE , 13: PRINT Psfset(Edit.set%, Line.number%).Label;
1220.             LOCATE , 40: PRINT Psfset(Edit.set%, Line.number%).Units;
1221.             Lowerst$ = LTRIM$(STR$(Psfset(Edit.set%, Line.number%).Lower))
1222.             LOCATE , 48: PRINT Lowerst$;
1223.             Upperst$ = LTRIM$(STR$(Psfset(Edit.set%, Line.number%).Upper))
1224.             LOCATE , 61: PRINT Upperst$;
1225.             LOCATE , 74: COLOR 15, 4: PRINT Line.number%
1226.         ELSE
1227.             PRINT
1228.         END IF
1229.     NEXT Line.number%
1230.     Lowval! = Psfset(Edit.set%, Edit.line%).Lower
1231.     Upval! = Psfset(Edit.set%, Edit.line%).Upper
1232.     IF Lowval! > Upval! THEN
1233.         LOCATE 23, 15: COLOR 10, 1: PRINT " Lower limit is greater than upper limit.      "
1234.     ELSE
1235.         Unit$ = LTRIM$(RTRIM$(Psfset(Edit.set%, Edit.line%).Units))
1236.         Nominal! = (Round!(((Lowval! + Upval!) / 2), 3))
1237.         Nomval$ = LTRIM$(RTRIM$(STR$(Nominal!)))
1238.         IF LEFT$(Nomval$, 1) = "." THEN Nomval$ = "0" + Nomval$
1239.         Rangeval$ = LTRIM$(RTRIM$(STR$(Round!(((Upval! - Lowval!) / 2), 3))))
1240.         IF LEFT$(Rangeval$, 1) = "." THEN Rangeval$ = "0" + Rangeval$
1241.         IF Lowval! * Upval! <= 0 OR INSTR(Unit$, "dB") > 0 OR INSTR(Unit$, "%") > 0 THEN
1242.             LOCATE 23, 15: COLOR 10, 1: PRINT " Specified Value: "; Nomval$; Unit$; " "; CHR$(241); " "; Rangeval$; Unit$; " "
1243.         ELSE
1244.             Tolval$ = LTRIM$(RTRIM$(STR$(Round!((ABS(100 * (Upval! - Lowval!) / 2 / Nominal!)), 2))))
1245.             IF LEFT$(Tolval$, 1) = "." THEN Tolval$ = "0" + Tolval$
1246.             LOCATE 23, 15: COLOR 10, 1: PRINT " Specified Value: "; Nomval$; Unit$; " "; CHR$(241); " "; Rangeval$; Unit$; " ("; Tolval$; "%) "
1247.         END IF
1248.     END IF
1249.     COLOR 15, 2: PRINT "Arrow & TAB keys to move; F9/F10 Insert/Delete line; Pg Up for P.2; ESC to quit ";: COLOR 15, 4
1250. END SUB
1251.  
1252. SUB Show.setup
1253.     'Display current CHOOSE options
1254.     CLS 2
1255.     LOCATE 5, 20: COLOR 15: PRINT "Working Directory & PSF Selection"
1256.     PRINT
1257.     COLOR 15, 4: PRINT "Drive";: LOCATE , 20: COLOR , 1: PRINT Drive$
1258.     COLOR 15, 4: PRINT "Path";: LOCATE , 20: COLOR , 1: PRINT Path$
1259.     COLOR 15, 4: PRINT "Product type";: LOCATE , 20: COLOR , 1: PRINT TType.number$
1260.     Option$ = LEFT$(Psfoption$, 1)
1261.     COLOR 15, 4: PRINT "PSF Class";: LOCATE , 20: COLOR , 1: PRINT Option$;: COLOR , 4: PRINT "   C=CURRENT, P=PREVIOUS, H=HYPOTHETICAL"
1262.     IF UCASE$(Option$) = "P" THEN
1263.         COLOR 15, 4: PRINT "Issue";: LOCATE , 20: COLOR , 1: PRINT Prev.issue$;: COLOR , 4: PRINT " The issue must be a valid DOS filename extension."
1264.         Psf$ = TType.number$ + "P." + Noblanks$(Prev.issue$)
1265.     ELSE
1266.         Psf$ = TType.number$ + Option$ + ".PSF"
1267.     END IF
1268.     LOCATE 13: COLOR 15, 4
1269.     SELECT CASE UCASE$(Option$)
1270.         CASE "C"
1271.             PRINT "If you load a CURRENT PSF you can edit it, produce a Tolerance Report or"
1272.             PRINT "produce a History Report."
1273.             PRINT "If you choose to edit it, you must decide whether you are going to raise the"
1274.             PRINT "software issue of the test program. If so, the PSF will be archived as a"
1275.             PRINT "PREVIOUS PSF before editing commences, and then the edited version will be"
1276.             PRINT "saved as the new CURRENT PSF. If you choose not to change the issue, you will"
1277.             PRINT "be able to save the edited version as either CURRENT or HYPOTHETICAL, or to"
1278.             PRINT "quit the editor without saving the changes."
1279.         CASE "H"
1280.             PRINT "If you load a HYPOTHETICAL PSF you can edit it or produce a Tolerance Report,"
1281.             PRINT "but not a History Report."
1282.             PRINT "If you choose to edit it, you will be able to save the edited version as"
1283.             PRINT "HYPOTHETICAL, or quit the editor without saving the changes. You cannot"
1284.             PRINT "convert a HYPOTHETICAL PSF to CURRENT class. This preserves the integrity of"
1285.             PRINT "the issue history."
1286.         CASE "P"
1287.             PRINT "If you load a PREVIOUS PSF you can edit it or produce a Tolerance Report, but"
1288.             PRINT "not a History Report."
1289.             PRINT "If you choose to edit it, you will be able to save the edited version as"
1290.             PRINT "HYPOTHETICAL, or quit the editor without saving the changes. You cannot"
1291.             PRINT "convert a PREVIOUS PSF to CURRENT class, nor can you over-write a PREVIOUS"
1292.             PRINT "class file. This preserves the integrity of the issue history and of the"
1293.             PRINT "archived PSF data."
1294.     END SELECT
1295.     LOCATE 24: COLOR 15, 2: PRINT "Up/Dn, Home/End keys to move; Edit entry or TAB to select option; ESC to finish ";: COLOR , 4
1296. END SUB
1297.  
1298. SUB Tol.print
1299.     'Print out a tolerance report for the loaded PSF
1300.     STATIC Lotempst AS STRING * 8
1301.     STATIC Hitempst AS STRING * 8
1302.     STATIC Indexst AS STRING * 3
1303.     ' STATIC Labelst AS STRING * 24
1304.     STATIC Unitsst AS STRING * 5
1305.     STATIC Lowerst AS STRING * 10
1306.     STATIC Upperst AS STRING * 10
1307.     STATIC Nomst AS STRING * 10
1308.     STATIC Tolst AS STRING * 7
1309.     PRINT #1, "TOLERANCE REPORT for "; TType.number$; " produced on "; British$(DATE$); " @ "; LEFT$(TIME$, 5); " Engineer:"; Psf.eng$
1310.     PRINT #1, STRING$(78, "-")
1311.     IF Psfoption$ = "HYPOTHETICAL" THEN
1312.         PRINT #1, "HYPOTHETICAL PSF - Generated for results analysis, not applied in testing."
1313.     ELSE
1314.         IF Psfoption$ = "PREVIOUS" THEN
1315.             Prev.psf$ = " (PREVIOUS)    Dated:"
1316.         ELSE
1317.             Prev.psf$ = "               Dated:"
1318.         END IF
1319.         PRINT #1, "Program + "; Psf$; SPACE$(19 - LEN(Psf$)); "Issue:"; Psf.progiss$; Prev.psf$; Psf.progdate$
1320.     END IF
1321.     PRINT #1, "Source:"; Psf.sourcename$; "  Issue:"; Psf.sourceiss$; "             Dated:"; Psf.sourcedate$
1322.     IF LTRIM$(RTRIM$(Psf.amendrefs$)) <> "" THEN PRINT #1, Psf.amendrefs$
1323.     IF Psf.sermark% = YES THEN
1324.         Sermarked$ = "              Serial Marked"
1325.     ELSE
1326.         Sermarked$ = "              Not Serial Marked"
1327.     END IF
1328.     PRINT #1, "Customer Reference:"; Psf.custype$; Sermarked$
1329.     IF Psf.lotemp% = 999 THEN
1330.         Lotempst$ = " N/A    "
1331.     ELSE
1332.         Lotempst$ = "=" + STR$(Psf.lotemp%) + "DegC"
1333.     END IF
1334.     IF Psf.hitemp% = 999 THEN
1335.         Hitempst$ = " N/A    "
1336.     ELSE
1337.         Hitempst$ = "=" + RTRIM$(LTRIM$(STR$(Psf.hitemp%))) + "DegC"
1338.     END IF
1339.     PRINT #1, "Low Temp."; Lotempst$; "            Ambient Temp.=23DegC    High Temp."; Hitempst$
1340.     PRINT #1, STRING$(78, "-")
1341.     FOR Setno% = 0 TO Psf.numsets% - 1
1342.         PRINT #1, "PARAMETER SET NUMBER"; Setno%; "      "; Psf.setlabel$(Setno%); "   "; Psf.numpars%(Setno%); "Parameters:-"
1343.         PRINT #1, " ============================================================================"
1344.         PRINT #1, "[IND|        PARAMETER        |  LOWER   |  UPPER   |  Nominal & Tol. | UNITS]"
1345.         PRINT #1, "[---+-------------------------+----------+----------+-----------------+------]"
1346.         FOR Paramno% = 1 TO Psf.numpars%(Setno%)
1347.             Indexst$ = RTRIM$(LTRIM$(STR$(Psfset(Setno%, Paramno%).Index)))
1348.             Labelst$ = Psfset(Setno%, Paramno%).Label
1349.             Unitsst$ = Psfset(Setno%, Paramno%).Units
1350.             Lowerst$ = STR$(Psfset(Setno%, Paramno%).Lower)
1351.             Upperst$ = STR$(Psfset(Setno%, Paramno%).Upper)
1352.             Lowval! = Psfset(Setno%, Paramno%).Lower
1353.             Upval! = Psfset(Setno%, Paramno%).Upper
1354.             Nominal! = (Round!(((Lowval! + Upval!) / 2), 4))
1355.             Nomst$ = STR$(Nominal!)
1356.             IF Lowval! * Upval! <= 0 OR INSTR(Unitsst$, "dB") > 0 OR INSTR(Unitsst$, "%") > 0 THEN
1357.                 Toleranceval! = (Upval! - Lowval!) / 2
1358.                 IF Toleranceval! > 999 THEN
1359.                     Tolst$ = "+->999"
1360.                 ELSEIF Toleranceval! > 100 THEN
1361.                     Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 0))))
1362.                 ELSEIF Toleranceval! > 10 THEN
1363.                     Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 1))))
1364.                 ELSEIF Toleranceval! > 1 THEN
1365.                     Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 2))))
1366.                 ELSE
1367.                     Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 3))))
1368.                 END IF
1369.             ELSE
1370.                 Toleranceval! = 100 * (Upval! - Lowval!) / 2 / ABS(Nominal!)
1371.                 IF Toleranceval! > 99.9 THEN
1372.                     Tolst$ = "+-99.9%"
1373.                 ELSEIF Toleranceval! > 10 THEN
1374.                     Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 1)))) + "%"
1375.                 ELSEIF Toleranceval! > 1 THEN
1376.                     Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 2)))) + "%"
1377.                 ELSE
1378.                     Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 3)))) + "%"
1379.                 END IF
1380.             END IF
1381.             PRINT #1, "["; Indexst$; "| ";
1382.             FOR Charpos = 1 TO 24
1383.                 Char$ = MID$(Labelst$, Charpos, 1)
1384.                 IF ASC(Char$) = 0 THEN
1385.                     Char$ = " "
1386.                 END IF
1387.                 PRINT #1, Char$;
1388.             NEXT Charpos
1389.             PRINT #1, "|"; Lowerst$; "|"; Upperst$; "|"; Nomst$; Tolst$; "| ";
1390.             FOR Charpos = 1 TO 5
1391.                 Char$ = MID$(Unitsst$, Charpos, 1)
1392.                 IF ASC(Char$) = 0 THEN
1393.                     Char$ = " "
1394.                 END IF
1395.                 PRINT #1, Char$;
1396.             NEXT Charpos
1397.             PRINT #1, "]"
1398.         NEXT Paramno%
1399.         PRINT #1, " ============================================================================"
1400.     NEXT Setno%
1401.     PRINT #1, CHR$(12)
1402. END SUB
1403.  
1404. SUB Tol.show
1405.     'Display a tolerance report for the loaded PSF
1406.     STATIC Lotempst AS STRING * 8
1407.     STATIC Hitempst AS STRING * 8
1408.     STATIC Indexst AS STRING * 3
1409.     STATIC Labelst AS STRING * 24
1410.     STATIC Unitsst AS STRING * 5
1411.     STATIC Lowerst AS STRING * 10
1412.     STATIC Upperst AS STRING * 10
1413.     STATIC Nomst AS STRING * 10
1414.     STATIC Tolst AS STRING * 7
1415.     LOCATE 3: COLOR 14
1416.     PRINT "TOLERANCE REPORT for "; TType.number$; " produced on "; British$(DATE$); " @ "; LEFT$(TIME$, 5); " Engineer:"; Psf.eng$
1417.     COLOR 15: PRINT STRING$(78, "-")
1418.     IF Psfoption$ = "HYPOTHETICAL" THEN
1419.         PRINT "HYPOTHETICAL PSF - Generated for results analysis, not applied in testing."
1420.     ELSE
1421.         IF Psfoption$ = "PREVIOUS" THEN
1422.             Prev.psf$ = " (PREVIOUS)    Dated:"
1423.         ELSE
1424.             Prev.psf$ = "               Dated:"
1425.         END IF
1426.         PRINT "Program + "; Psf$; SPACE$(19 - LEN(Psf$)); "Issue:"; Psf.progiss$; Prev.psf$; Psf.progdate$
1427.     END IF
1428.     PRINT "Source:"; Psf.sourcename$; "  Issue:"; Psf.sourceiss$; "             Dated:"; Psf.sourcedate$
1429.     IF LTRIM$(RTRIM$(Psf.amendrefs$)) <> "" THEN PRINT Psf.amendrefs$
1430.     IF Psf.sermark% = YES THEN
1431.         Sermarked$ = "              Serial Marked"
1432.     ELSE
1433.         Sermarked$ = "              Not Serial Marked"
1434.     END IF
1435.     PRINT "Customer Reference:"; Psf.custype$; Sermarked$
1436.     IF Psf.lotemp% = 999 THEN
1437.         Lotempst$ = " N/A    "
1438.     ELSE
1439.         Lotempst$ = "=" + STR$(Psf.lotemp%) + "DegC"
1440.     END IF
1441.     IF Psf.hitemp% = 999 THEN
1442.         Hitempst$ = " N/A    "
1443.     ELSE
1444.         Hitempst$ = "=" + RTRIM$(LTRIM$(STR$(Psf.hitemp%))) + "DegC"
1445.     END IF
1446.     PRINT "Low Temp."; Lotempst$; "            Ambient Temp.=23DegC    High Temp."; Hitempst$
1447.     PRINT STRING$(78, "-")
1448.     Line.counter% = 7
1449.     FOR Setno% = 0 TO Psf.numsets% - 1
1450.         COLOR 14: PRINT "PARAMETER SET NUMBER"; Setno%;: COLOR 15: PRINT "      "; Psf.setlabel$(Setno%); "   "; Psf.numpars%(Setno%); "Parameters:-"
1451.         PRINT " ============================================================================"
1452.         PRINT "[IND|        PARAMETER        |  LOWER   |  UPPER   |  Nominal & Tol. | UNITS]"
1453.         PRINT "[---+-------------------------+----------+----------+-----------------+------]"
1454.         Line.counter% = Line.counter% + 4
1455.         FOR Paramno% = 1 TO Psf.numpars%(Setno%)
1456.             Indexst$ = RTRIM$(LTRIM$(STR$(Psfset(Setno%, Paramno%).Index)))
1457.             Labelst$ = Psfset(Setno%, Paramno%).Label
1458.             Unitsst$ = Psfset(Setno%, Paramno%).Units
1459.             Lowerst$ = STR$(Psfset(Setno%, Paramno%).Lower)
1460.             Upperst$ = STR$(Psfset(Setno%, Paramno%).Upper)
1461.             Lowval! = Psfset(Setno%, Paramno%).Lower
1462.             Upval! = Psfset(Setno%, Paramno%).Upper
1463.             Nominal! = (Round!(((Lowval! + Upval!) / 2), 4))
1464.             Nomst$ = STR$(Nominal!)
1465.             IF Lowval! * Upval! <= 0 OR INSTR(Unitsst$, "dB") > 0 OR INSTR(Unitsst$, "%") > 0 THEN
1466.                 Toleranceval! = (Upval! - Lowval!) / 2
1467.                 IF Toleranceval! > 999 THEN
1468.                     Tolst$ = "+->999"
1469.                 ELSEIF Toleranceval! > 100 THEN
1470.                     Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 0))))
1471.                 ELSEIF Toleranceval! > 10 THEN
1472.                     Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 1))))
1473.                 ELSEIF Toleranceval! > 1 THEN
1474.                     Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 2))))
1475.                 ELSE
1476.                     Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 3))))
1477.                 END IF
1478.             ELSE
1479.                 Toleranceval! = 100 * (Upval! - Lowval!) / 2 / ABS(Nominal!)
1480.                 IF Toleranceval! > 99.9 THEN
1481.                     Tolst$ = "+-99.9%"
1482.                 ELSEIF Toleranceval! > 10 THEN
1483.                     Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 1)))) + "%"
1484.                 ELSEIF Toleranceval! > 1 THEN
1485.                     Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 2)))) + "%"
1486.                 ELSE
1487.                     Tolst$ = "+-" + LTRIM$(RTRIM$(STR$(Round!(Toleranceval!, 3)))) + "%"
1488.                 END IF
1489.             END IF
1490.             PRINT "["; Indexst$; "| ";
1491.             FOR Charpos = 1 TO 24
1492.                 Char$ = MID$(Labelst$, Charpos, 1)
1493.                 IF ASC(Char$) = 0 THEN
1494.                     Char$ = " "
1495.                 END IF
1496.                 PRINT Char$;
1497.             NEXT Charpos
1498.             PRINT "|"; Lowerst$; "|"; Upperst$; "|"; Nomst$; Tolst$; "| ";
1499.             FOR Charpos = 1 TO 5
1500.                 Char$ = MID$(Unitsst$, Charpos, 1)
1501.                 IF ASC(Char$) = 0 THEN
1502.                     Char$ = " "
1503.                 END IF
1504.                 PRINT Char$;
1505.             NEXT Charpos
1506.             PRINT "]"
1507.             Line.counter% = Line.counter% + 1
1508.             IF Line.counter% > 19 THEN
1509.                 CALL State("Press any key to continue."): COLOR 15, 4
1510.                 CALL Waitkey
1511.                 CLS 2: LOCATE 3
1512.                 Line.counter% = 0
1513.             END IF
1514.         NEXT Paramno%
1515.         PRINT " ============================================================================"
1516.         Line.counter% = Line.counter% + 1
1517.         IF Line.counter% > 15 THEN
1518.             CALL State("Press any key to continue."): COLOR 15, 4
1519.             CALL Waitkey
1520.             CLS 2: LOCATE 3
1521.             Line.counter% = 0
1522.         END IF
1523.     NEXT Setno%
1524. END SUB
1525.  
1526. SUB TOLERANCE
1527.     IF Choose.done% = NO THEN
1528.         SOUND 300, 4
1529.         CALL State("Working file not specified yet; select CHOOSE first. Press any key.")
1530.         CALL Waitkey
1531.         EXIT SUB
1532.     END IF
1533.     CLS 2
1534.     Pathname$ = Drive$ + ":" + Path$ + Psf$
1535.     Fileunfound% = RESETFLAG
1536.     OPEN Pathname$ FOR INPUT AS #2
1537.     IF Fileunfound% = NO THEN
1538.         CALL Read.psf
1539.         CLOSE #2
1540.     END IF
1541.     CALL Tol.show
1542.     IF Ask%("Do you want to PRINT THIS REPORT") = YES THEN
1543.         State ("Printing Tolerance Report...")
1544.         CALL Tol.print
1545.         State ("")
1546.     END IF
1547. END SUB
1548.  
1549. SUB Write.psf
1550.     ' Output all data to PSF file, which has already been opened as #3
1551.     DIM Psfparamst AS Psfparamsttype
1552.     Psf.hitempst$ = STR$(Psf.hitemp%)
1553.     Psf.lotempst$ = STR$(Psf.lotemp%)
1554.     Psf.sermarkst$ = STR$(Psf.sermark%)
1555.     Psf.numspacesst$ = STR$(Psf.numspaces%)
1556.     PRINT #3, Psf.typeno$: PRINT #3, Psf.progiss$
1557.     PRINT #3, Psf.preceding$: PRINT #3, Psf.progdate$
1558.     PRINT #3, Psf.sourcename$: PRINT #3, Psf.sourceiss$
1559.     PRINT #3, Psf.sourcedate$: PRINT #3, Psf.amendrefs$
1560.     PRINT #3, Psf.custype$: PRINT #3, Psf.hitempst$
1561.     PRINT #3, Psf.lotempst$: PRINT #3, Psf.sermarkst$
1562.     PRINT #3, Psf.history$: PRINT #3, Psf.crn$
1563.     PRINT #3, Psf.eng$: PRINT #3, Psf.comment1$
1564.     PRINT #3, Psf.comment2$: PRINT #3, Psf.comment3$
1565.     PRINT #3, Psf.comment4$: PRINT #3, Psf.comment5$
1566.     Psf.numsetsst$ = STR$(Psf.numsets%)
1567.     PRINT #3, Psf.numsetsst$
1568.     FOR Setno% = 0 TO Psf.numsets% - 1
1569.         Psf.numparsst$ = STR$(Psf.numpars%(Setno%))
1570.         PRINT #3, Psf.numparsst$
1571.     NEXT Setno%
1572.     PRINT #3, Psf.numspacesst$
1573.     FOR Setno% = 0 TO Psf.numsets% - 1
1574.         PRINT #3, Psf.setlabel$(Setno%)
1575.     NEXT Setno%
1576.     FOR Setno% = 0 TO Psf.numsets% - 1
1577.         FOR Paramno% = 1 TO Psf.numpars%(Setno%)
1578.             Psfparamst.Index = STR$(Psfset(Setno%, Paramno%).Index)
1579.             Psfparamst.Label = Psfset(Setno%, Paramno%).Label
1580.             Psfparamst.Units = Psfset(Setno%, Paramno%).Units
1581.             Lower.val! = (Psfset(Setno%, Paramno%).Lower * 10000)
1582.             Lower.val! = Lower.val! + .1 * SGN(Lower.val!) 'Eliminate rounding errors
1583.             Lower.int& = FIX(Lower.val!)
1584.             Psfparamst.Lower = STR$(Lower.int&)
1585.             Upper.val! = (Psfset(Setno%, Paramno%).Upper * 10000)
1586.             Upper.val! = Upper.val! + .1 * SGN(Upper.val!) 'Eliminate rounding errors
1587.             Upper.int& = FIX(Upper.val!)
1588.             Psfparamst.Upper = STR$(Upper.int&)
1589.             PRINT #3, Psfparamst.Index
1590.             PRINT #3, Psfparamst.Label
1591.             PRINT #3, Psfparamst.Units
1592.             PRINT #3, Psfparamst.Lower
1593.             PRINT #3, Psfparamst.Upper
1594.         NEXT Paramno%
1595.     NEXT Setno%
1596. END SUB
1597.  
1598. ' UTILs _____________________________________________________________________________________
1599.  
1600. FUNCTION Ask% (Question$)
1601.     'Prompt for Y / N response
1602.     DO
1603.         Dummy$ = INKEY$
1604.     LOOP UNTIL Dummy$ = ""
1605.     COLOR 10, 1
1606.     Valid% = NO
1607.     WHILE Valid% = NO
1608.         LOCATE 23, 1
1609.         PRINT SPACE$(80);
1610.         LOCATE 23, 1
1611.         PRINT Question$; "? (Y/N) ";
1612.         DO
1613.             K$ = INKEY$
1614.         LOOP WHILE K$ = ""
1615.         Valid% = YES
1616.         SELECT CASE K$
1617.             CASE "Y", "y"
1618.                 Ask% = YES
1619.             CASE "N", "n"
1620.                 Ask% = NO
1621.             CASE ELSE
1622.                 Valid% = NO
1623.         END SELECT
1624.     WEND
1625.     COLOR 15, 1
1626.     LOCATE 23, 1
1627.     PRINT SPACE$(80);
1628. END FUNCTION
1629.  
1630. FUNCTION British$ (Indate$)
1631.     'Converts "m[m]{-./}d[d]{-./}yy[yy]" to "dd/mm/yy[yy]"
1632.  
1633.     Delim = INSTR(Indate$, "/") + INSTR(Indate$, ".") + INSTR(Indate$, "-")
1634.     IF Delim > 0 THEN
1635.         Month% = VAL(LEFT$(Indate$, (Delim - 1)))
1636.         Indate$ = RIGHT$(Indate$, (LEN(Indate$) - Delim))
1637.         Delim = INSTR(Indate$, "/") + INSTR(Indate$, ".") + INSTR(Indate$, "-")
1638.         IF Delim > 0 THEN Day% = VAL(LEFT$(Indate$, (Delim - 1)))
1639.         IF Delim > 0 THEN Year% = VAL(RIGHT$(Indate$, (LEN(Indate$) - Delim)))
1640.     END IF
1641.     d$ = STR$(Day%)
1642.     d$ = RIGHT$(d$, (LEN(d$) - 1))
1643.     IF LEN(d$) = 1 THEN d$ = "0" + d$
1644.     m$ = STR$(Month%)
1645.     m$ = RIGHT$(m$, (LEN(m$) - 1))
1646.     IF LEN(m$) = 1 THEN m$ = "0" + m$
1647.     y$ = STR$(Year%)
1648.     y$ = RIGHT$(y$, (LEN(y$) - 1))
1649.     British$ = d$ + "/" + m$ + "/" + y$
1650.  
1651. END FUNCTION
1652.  
1653. FUNCTION Checkint% (Value%, Lolim%, Hilim%)
1654.     IF Value% < Lolim% OR Value% > Hilim% THEN
1655.         SOUND 400, 1
1656.         Checkint% = NO
1657.     ELSE
1658.         Checkint% = YES
1659.     END IF
1660. END FUNCTION
1661.  
1662. FUNCTION Checkreal% (Value!, Lolim!, Hilim!)
1663.     IF Value! < Lolim! OR Value! > Hilim! THEN
1664.         SOUND 400, 1
1665.         Checkreal% = NO
1666.     ELSE
1667.         Checkreal% = YES
1668.     END IF
1669. END FUNCTION
1670.  
1671. FUNCTION Datestr$ (Inputdate&)
1672.     'Converts a number of days since 30/12/1899 (Quattro pro ref) into a date
1673.     'string. Output date string is DD/MM/YYYY
1674.  
1675.     Indate& = Inputdate& + 364
1676.     DIM Numdays(12) AS INTEGER
1677.     Numdays(1) = 31
1678.     Numdays(2) = 28
1679.     Numdays(3) = 31
1680.     Numdays(4) = 30
1681.     Numdays(5) = 31
1682.     Numdays(6) = 30
1683.     Numdays(7) = 31
1684.     Numdays(8) = 31
1685.     Numdays(9) = 30
1686.     Numdays(10) = 31
1687.     Numdays(11) = 30
1688.     Numdays(12) = 31
1689.  
1690.     'Derive date from input number of days past reference
1691.     Year% = 1899
1692.     WHILE Indate& > 366
1693.         IF Year% MOD 400 = 0 OR (Year% MOD 4 = 0 AND Year% MOD 100 <> 0) THEN
1694.             Indate& = Indate& - 366
1695.         ELSE
1696.             Indate& = Indate& - 365
1697.         END IF
1698.         Year% = Year% + 1
1699.     WEND
1700.     IF Year% MOD 400 = 0 OR (Year% MOD 4 = 0 AND Year% MOD 100 <> 0) THEN
1701.         Numdays(2) = 29
1702.     ELSE
1703.         IF Indate& = 366 THEN
1704.             Indate& = 1
1705.             Year% = Year% + 1
1706.         END IF
1707.     END IF
1708.     Month% = 1
1709.     WHILE Indate& > Numdays(Month%)
1710.         Indate& = Indate& - Numdays(Month%)
1711.         Month% = Month% + 1
1712.     WEND
1713.     Day% = Indate&
1714.  
1715.     'Construct date$
1716.     d$ = STR$(Day%)
1717.     d$ = RIGHT$(d$, (LEN(d$) - 1))
1718.     IF LEN(d$) = 1 THEN d$ = "0" + d$
1719.     m$ = STR$(Month%)
1720.     m$ = RIGHT$(m$, (LEN(m$) - 1))
1721.     IF LEN(m$) = 1 THEN m$ = "0" + m$
1722.     y$ = STR$(Year%)
1723.     y$ = RIGHT$(y$, (LEN(y$) - 1))
1724.  
1725.     Datestr$ = d$ + "/" + m$ + "/" + y$
1726.  
1727. END FUNCTION
1728.  
1729. FUNCTION Dateval& (Inputdate$)
1730.     'Converts a date string into number of days since 30/12/1899 (Quattro-Pro ref)  1/1/1899
1731.     'Input date string is DAY/MONTH/YEAR, DAY.MONTH.YEAR or DAY-MONTH-YEAR
1732.     'where DAY and MONTH are 1 or 2 digits and YEAR is 2 or 4 digits
1733.     'A 2-digit year is interpreted as being between 1951 and 2050. Dates outside
1734.     'this range and invalid dates return error code (-1).
1735.  
1736.     Indate$ = Inputdate$
1737.     DIM Numdays(12) AS INTEGER
1738.     Numdays(1) = 31
1739.     Numdays(2) = 28
1740.     Numdays(3) = 31
1741.     Numdays(4) = 30
1742.     Numdays(5) = 31
1743.     Numdays(6) = 30
1744.     Numdays(7) = 31
1745.     Numdays(8) = 31
1746.     Numdays(9) = 30
1747.     Numdays(10) = 31
1748.     Numdays(11) = 30
1749.     Numdays(12) = 31
1750.  
1751.     'Extract days, months and years from Indate$
1752.     Delim = INSTR(Indate$, "/") + INSTR(Indate$, ".") + INSTR(Indate$, "-")
1753.     IF Delim > 0 THEN
1754.         Day% = VAL(LEFT$(Indate$, (Delim - 1)))
1755.         Indate$ = RIGHT$(Indate$, (LEN(Indate$) - Delim))
1756.         Delim = INSTR(Indate$, "/") + INSTR(Indate$, ".") + INSTR(Indate$, "-")
1757.         IF Delim > 0 THEN Month% = VAL(LEFT$(Indate$, (Delim - 1)))
1758.         IF Delim > 0 THEN Year% = VAL(RIGHT$(Indate$, (LEN(Indate$) - Delim)))
1759.         IF Year% < 100 THEN
1760.             IF Year% < 51 THEN
1761.                 Year% = Year% + 2000
1762.             ELSE
1763.                 Year% = Year% + 1900
1764.             END IF
1765.         END IF
1766.     END IF
1767.  
1768.     'Convert date to number of days since reference
1769.     Daycount& = 0
1770.     IF Year% < 1951 OR Year% > 2050 OR Month% < 1 OR Month% > 12 THEN
1771.         Daycount& = -1
1772.     ELSE
1773.         IF (Year% MOD 400 = 0 OR (Year% MOD 4 = 0 AND Year% MOD 100 <> 0)) AND Month% = 2 THEN
1774.             IF Day% > 29 THEN Daycount& = -1
1775.         ELSE
1776.             IF Day% > Numdays(Month%) THEN Daycount& = -1
1777.         END IF
1778.         IF Day% < 1 THEN Daycount& = -1
1779.     END IF
1780.     IF Daycount& = 0 THEN
1781.         FOR I = 1899 TO Year% - 1
1782.             Daycount& = Daycount& + 365
1783.             IF I MOD 400 = 0 OR (I MOD 4 = 0 AND I MOD 100 <> 0) THEN
1784.                 Daycount& = Daycount& + 1
1785.             END IF
1786.         NEXT I
1787.         FOR I = 1 TO Month% - 1
1788.             Daycount& = Daycount& + Numdays(I)
1789.         NEXT I
1790.         IF Year% MOD 400 = 0 OR (Year% MOD 4 = 0 AND Year% MOD 100 <> 0) THEN
1791.             IF Month% > 2 THEN Daycount& = Daycount& + 1
1792.         END IF
1793.         Daycount& = Daycount& + Day%
1794.     END IF
1795.     IF Daycount& > 0 THEN
1796.         Dateval& = Daycount& - 364
1797.     ELSE
1798.         Dateval& = -1
1799.     END IF
1800. END FUNCTION
1801.  
1802. FUNCTION Dosvalid% (Extension$)
1803.     'Check whether (first 3 chars of) Extension$ is a valid DOS filename extension
1804.     DIM C%(3)
1805.     Check.ext$ = Extension$
1806.     IF LEN(Extension$) < 3 THEN
1807.         Check.ext$ = Check.ext$ + SPACE$(3 - LEN(Extension$))
1808.     END IF
1809.     Check.ext$ = LEFT$(Check.ext$, 3)
1810.     C%(1) = ASC(Check.ext$)
1811.     C%(2) = ASC(RIGHT$(Check.ext$, 2))
1812.     C%(3) = ASC(RIGHT$(Check.ext$, 1))
1813.     Valid% = YES
1814.     FOR n% = 1 TO 3
1815.         Validchar% = NO
1816.         X% = C%(n%)
1817.         IF X% = 33 OR (X% > 34 AND X% < 42) OR X% = 45 OR (X% > 47 AND X% < 58) THEN Validchar% = YES
1818.         IF (X% > 63 AND X% < 91) OR (X% > 93 AND X% < 124) OR X% = 125 OR X% = 126 THEN Validchar% = YES
1819.         IF n% > 1 AND X% = 32 THEN Validchar% = YES 'Allow trailing spaces
1820.         IF Validchar% = NO THEN Valid% = NO
1821.     NEXT n%
1822.     'IF Valid% = NO THEN SOUND 400, 1
1823.     Dosvalid% = Valid%
1824. END FUNCTION
1825.  
1826. FUNCTION Noblanks$ (Instring$)
1827.     ' Strip leading, trailing and all contained spaces and convert to upper case
1828.     ' (see Plain$)
1829.     Temp$ = LTRIM$(RTRIM$(UCASE$(Instring$)))
1830.     Blanksin% = YES
1831.     WHILE Blanksin% = YES
1832.         Spacepos% = INSTR(Temp$, " ")
1833.         IF Spacepos% THEN
1834.             Leftbit$ = LEFT$(Temp$, Spacepos% - 1)
1835.             Rightbit$ = RIGHT$(Temp$, LEN(Temp$) - Spacepos%)
1836.             Temp$ = Leftbit$ + Rightbit$
1837.         ELSE
1838.             Blanksin% = NO
1839.         END IF
1840.     WEND
1841.     Noblanks$ = Temp$
1842. END FUNCTION
1843.  
1844. SUB Pause (T!)
1845.     Start.time = TIMER
1846.     WHILE TIMER < Start.time + T!
1847.         IF TIMER < Start.time THEN Start.time = Start.time - 24 * 3600 'IF MIDNIGHT HAPPENS
1848.     WEND
1849. END SUB
1850.  
1851. FUNCTION Plain$ (Instring$)
1852.     ' Strip leading & trailing spaces and convert to upper case (see Noblanks$)
1853.     Plain$ = LTRIM$(RTRIM$(UCASE$(Instring$)))
1854. END FUNCTION
1855.  
1856. FUNCTION Qpwdate& (Intimedate!)
1857.     'Derives a Quattro-pro date value from an HP Basic TIMEDATE value.
1858.     Qpwdate& = INT(Intimedate! / 86400 - 2415019)
1859.  
1860. END FUNCTION
1861.  
1862. FUNCTION Qpwtime# (Intimedate#)
1863.     'Derives a Quattro-pro time value from an HP Basic TIMEDATE value.
1864.     Qpwtime# = (Intimedate# / 86400) - INT(Intimedate# / 86400)
1865.  
1866. END FUNCTION
1867.  
1868. FUNCTION Round! (Value!, Dec%)
1869.     'Round Value! to Dec% DP, max 4 DP
1870.     IF Dec% > 4 THEN Dec% = 4
1871.     Power.ten! = 10 ^ Dec%
1872.     Integer.part! = FIX(Value!)
1873.     Decimal.part! = Value! - FIX(Value!)
1874.     IF Power.ten! <> 0 THEN Decimal.part! = CINT(Decimal.part! * Power.ten!) / Power.ten!
1875.     Round! = Integer.part! + Decimal.part!
1876. END FUNCTION
1877.  
1878. SUB State (Prompt$)
1879.     'Display single line prompt
1880.     Linenum% = CSRLIN
1881.     Colnum% = POS(0)
1882.     COLOR 14, 1
1883.     LOCATE 24, 1
1884.     PRINT SPACE$(80);
1885.     LOCATE 24, 1
1886.     PRINT Prompt$;
1887.     LOCATE Linenum%, Colnum%
1888.     COLOR 15, 1
1889. END SUB
1890.  
1891. FUNCTION Timedate! (Inqpwdate&, Inqpwtime!)
1892.     'Converts a Quattro-pro date and time value to the corresponding HP Basic
1893.     'TIMEDATE value.
1894.     Timedate! = (Inqpwdate& + 2415019 + Inqpwtime!) * 86400
1895. END FUNCTION
1896.  
1897. FUNCTION Timestr$ (Inputtime#)
1898.     'Converts a fraction of a day (Quattro pro format) into a time string.
1899.     'Output time string is HH:MM:SS. Conversion accuracy +/- 1 Sec.
1900.  
1901.     Inputhours! = (Inputtime# - INT(Inputtime#)) * 24
1902.     Hour% = INT(Inputhours!)
1903.     Min% = INT((Inputhours! - Hour%) * 60)
1904.     Sec% = INT(((Inputhours! - Hour%) * 60 - Min%) * 60)
1905.  
1906.     'Construct time$
1907.     h$ = STR$(Hour%)
1908.     h$ = RIGHT$(h$, (LEN(h$) - 1))
1909.     IF LEN(h$) = 1 THEN h$ = "0" + h$
1910.     m$ = STR$(Min%)
1911.     m$ = RIGHT$(m$, (LEN(m$) - 1))
1912.     IF LEN(m$) = 1 THEN m$ = "0" + m$
1913.     s$ = STR$(Sec%)
1914.     s$ = RIGHT$(s$, (LEN(s$) - 1))
1915.     IF LEN(s$) = 1 THEN s$ = "0" + s$
1916.  
1917.     Timestr$ = h$ + ":" + m$ + ":" + s$
1918. END FUNCTION
1919.  
1920. FUNCTION Toggle% (Inflag%)
1921.     ' If inflag is logic (1 / 0) then its complement is returned.
1922.  
1923.     SELECT CASE Inflag%
1924.         CASE 0
1925.             Toggle% = 1
1926.         CASE 1
1927.             Toggle% = 0
1928.         CASE ELSE
1929.             Toggle% = Inflag%
1930.     END SELECT
1931.  
1932. END FUNCTION
1933.  
1934. SUB Waitkey
1935.     'Wait for keypress then continue
1936.     Pause (.1) ' Delay to avoid keybounce
1937.     DO
1938.         K$ = INKEY$
1939.     LOOP UNTIL K$ = "" ' Clear buffer
1940.     DO
1941.         K$ = INKEY$
1942.     LOOP WHILE K$ = ""
1943.     Pause (.1) ' Delay to avoid keybounce
1944. END SUB
1945.  
1946. SUB Warn (Prompt$)
1947.     'Display single line prompt
1948.     Linenum% = CSRLIN
1949.     Colnum% = POS(0)
1950.     LOCATE 24, 1
1951.     PRINT SPACE$(80);
1952.     LOCATE 24, 1
1953.     COLOR 28, 1
1954.     PRINT "WARNING - ";
1955.     COLOR 12, 1
1956.     PRINT Prompt$;
1957.     SOUND 400, 1
1958.     LOCATE Linenum%, Colnum%
1959.     COLOR 15, 1
1960. END SUB
1961.  
1962.  

That DIM block was added in later I would bet actual money! ;-))

And so I compiled and ran next stop line 83 no file found, of course not look at line 83

Code: QB64: [Select]

1. OPEN "LPT1" FOR OUTPUT AS #1
2. ON ERROR GOTO Errhandler
3. LOCATE 2
4.  
5.  

Well I didn't want to print anything anyway! but apparently the error handler didn't work either! ;(

Wait aren't those supposed to be used before the line that might commit an error?
Never used error handlers much, rather avoid the error in first place.

[bplus]

OK I did this:

Code: QB64: [Select]

1. 'OPEN "LPT1" FOR OUTPUT AS #1
2. OPEN "Output to Printer.txt" AS #1
3.  

and now we get a menu!
  [ You are not allowed to view this attachment ]  

[bplus]

You know this allot like an adventure game you guys are always writing :)

Here is F1 keypress menu:
  [ You are not allowed to view this attachment ]  

Well I don't know what's supposed to happen so hard to continue checking code.

BTW My "Output to Printer.txt" file got made but nothing in it and the fan is running overtime so I am shutting down for lunch.