1|*
2|**************************************************************************
3|* Copyright (c) 2004 Schellenbach & Associates, Inc. dba AccuSoft *
4|* Enterprises as an unpublished work. Permission is hereby granted, free *
5|* of charge, to any person obtaining a copy of this software, to use the *
6|* software without restriction, including without limitation the rights *
7|* to use, copy, modify, merge, publish or distribute the software, and *
8|* to permit persons to whom the software is furnished to do so, subject *
9|* to the following conditions: This copyright notice and permission *
10|* notice shall be included in all copies or substantial portions of the *
11|* software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY *
12|* KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES *
13|* OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *
14|* NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR *
15|* ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF *
16|* CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION *
17|* WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. *
18|**************************************************************************
19|**************************************************************************
20|*
21|* MOUSE DEMO PROGRAM 1
22|*
23|**************************************************************************
24|**************************************************************************
25|*
26|* The CUST.REC INCLUDE item declares the CUST.REC array, which is used to
27|* store a working copy of the current data record. It also defines the
28|* record layout by equating field names to array positions in the CUST.REC
29|* array.
30|*
31|$INCLUDE UIEX UIEX.CUST.REC
32|*
33|**************************************************************************
34|*
35|* EQUates for control characters and delimiters and other constants
36|*
37|EQU VM TO CHAR(253)
38|EQU BEL TO CHAR(7)
39|EQU ESC TO CHAR(27)
40|EQU STX TO CHAR(2)
41|EQU CR TO CHAR(13)
42|EQU BACKSPACE TO CHAR(8)
43|EQU FALSE TO 0
44|EQU TRUE TO 1
45|*
46|**************************************************************************
47|*
48|* Open our files...
49|*
50|OPEN 'CUST.SAMPLE' TO FN.CUST ELSE PRINT 'NO CUST.SAMPLE FILE';STOP
51|OPEN 'CUST.SAMPLE.CTRL' TO FN.CUST.CTRL ELSE PRINT 'NO CUST.SAMPLE.CTRL FILE';STOP
52|OPEN 'CUST.SAMPLE.XREF' TO FN.CUST.XREF ELSE PRINT 'NO CUST.SAMPLE.XREF';STOP
53|*
54|**************************************************************************
55|*
56|* Define the data field control structures. NUMFLDS is the number of
57|* fields. The CONTROL array defines the field control elements such as
58|* field label, label position, field position and size, and field prompt.
59|* The IDATA array stores the current field values, and is initialized from
60|* the CUST.REC array when a data record is read from the file. When the
61|* record is updated, values are copied from the IDATA array to the
62|* CUST.REC array and the CUST.REC array is passed to the CUST.UPDATE
63|* subroutine to update the data and index files (a separate subroutine is
64|* used to update the file since the update process may handle other
65|* functions like updating indexes).
66|*
67|NUMFLDS = 12
68|DIM CONTROL(12)
69|DIM IDATA(12)
70|*
71|* Define field control elements
72|* value 1: field label text
73|* value 2: field label column
74|* value 3: field label row
75|* value 4: field label width (0 for actual width, no padding)
76|* value 5: field data column
77|* value 6: field data row
78|* value 7: field data width
79|* value 8: field data height
80|* value 9: field prompt message
81|CONTROL(1) = 'Customer IDý7ý2ý20ý28ý2ý30ý1ýEnter the ID, or name to search for, or N for next number'
82|CONTROL(2) = 'Contactý7ý4ý20ý28ý4ý30ý1ýEnter the contact name'
83|CONTROL(3) = 'Company nameý7ý5ý20ý28ý5ý30ý1ýEnter the company name'
84|CONTROL(4) = 'Address line 1ý7ý6ý20ý28ý6ý30ý1ýEnter address line 1'
85|CONTROL(5) = 'Address line 2ý7ý7ý20ý28ý7ý30ý1ýEnter address line 2'
86|CONTROL(6) = 'Cityý7ý8ý20ý28ý8ý25ý1ýEnter the city'
87|CONTROL(7) = 'State or provinceý7ý9ý20ý28ý9ý15ý1ýEnter the state or province abbreviation'
88|CONTROL(8) = 'Zip/postal codeý7ý10ý20ý28ý10ý10ý1ýEnter the zip or postal code'
89|CONTROL(9) = 'Countryý7ý11ý20ý28ý11ý18ý1ýEnter the country'
90|CONTROL(10) = 'Phoneý7ý12ý20ý28ý12ý15ý1ýEnter the phone number'
91|CONTROL(11) = 'Faxý7ý13ý20ý28ý13ý15ý1ýEnter the fax number'
92|CONTROL(12) = 'Notesý7ý14ý20ý28ý14ý30ý1ýEnter any notes about this customer'
93|*
94|**************************************************************************
95|*
96|* Define some screen control strings for prompts & errors
97|*
98|PROMPT ''
99|CLR = @(-1) ;* Clear entire screen
100|CEOL = @(-4) ;* Clear to end of line
101|PL = @(5,22):CEOL ;* Prompt line
102|EL = @(5,23):CEOL ;* Error line
103|*
104|* Wyse 60 attributes for NORMAL, REVERSE, DIM REVERSE and UNDERLINE
105|* REVERSE (we like Wyse 60 because the attributes dont take any space on
106|* the screen, and more than one attribute can be displayed at one time).
107|* If running AccuTerm in Viewpoint A2 Enhanced emulation, you can use the
108|* ADDS 4000 attributes instead. Just change the upper-case "G" below to
109|* lower-case "g".
110|*
111|NORMAL = ESC:'G0' ;* Normal - display headings & field labels
112|REVERSE = ESC:'G4' ;* Reverse - display active field data
113|DIMREV = ESC:'Gt' ;* Dim Reverse - display inactive field data
114|UNDREV = ESC:'G<' ;* Underline Reverse - display warnings
115|*
116|**************************************************************************
117|*
118|* This program processes one customer record at a time, and is organized
119|* using three nested loops. The outermost loop (the RECORD loop) is
120|* executed once for each record accessed. The loop repeats until the XIT
121|* control variable is set to TRUE.
122|*
123|XIT = FALSE
124|LOOP UNTIL XIT DO
125| *
126| *************************************************************************
127| *
128| * Before prompting for the customer ID, reset the internal data array
129| * (IDATA) and CUST.ID variables, then clear the screen and display the
130| * heading and field labels.
131| *
132| GOSUB RESTART
133| GOSUB DSPSCRN
134| *
135| *************************************************************************
136| *
137| * The middle loop is the ACTION loop. It is executed for the current
138| * record until the user performs an action that terminates processing of
139| * that record, such as exiting, cancelling, saving or deleting the
140| * record. The field number to begin prompting (NXTFLD) is initialized to
141| * 1, causing the ID field to be prompted first. The loop immediately
142| * enters the PROMPT loop, followed by the field modification prompt. The
143| * loop repeats until the DONE control variable is set to TRUE.
144| *
145| NXTFLD = 1
146| DONE = FALSE
147| LOOP
148| *
149| ************************************************************************
150| *
151| * The inner loop is the PROMPT loop. It is executed for each prompt
152| * field as specified by the NXTFLD variable. The prompt loop simply
153| * calls the local INPUT.FIELD subroutine which performs field input,
154| * data validation and keyboard command decoding. The FIELD loop repeats
155| * until the field number is greater than the number of fields, or until
156| * the DONE control variable is set to TRUE. The DONE control variable
157| * may be set to TRUE in the INPUT.FIELD subroutine, if the user enters a
158| * NULL to for the item-ID.
159| *
160| LOOP
161| CURFLD = NXTFLD
162| UNTIL DONE OR CURFLD > NUMFLDS DO
163| *
164| ***********************************************************************
165| *
166| * Prompt for the next field. Update the NXTFLD variable with the field
167| * number to prompt next.
168| *
169| GOSUB INPUT.FIELD
170| REPEAT ;* end of PROMPT loop
171| *
172| ************************************************************************
173| *
174| * If the FIELD loop exited with the DONE control variable set to TRUE,
175| * bypass the modification prompt because no action is required.
176| * Otherwise, prompt for which field to modify, or other actions such as
177| * save or delete.
178| *
179| IF NOT(DONE) THEN
180| *
181| NXTFLD = NUMFLDS + 1 ;* assume we need to reprompt for action
182| *
183| PRINT PL:'Enter field number to modify or FI to save, DE to delete, EX to exit: ':
184| GOSUB INPCMD
185| PRINT EL:
186| *
187| ***********************************************************************
188| *
189| * Decode the response
190| *
191| IF CMD NE '' THEN ANS = CMD ELSE ANS = OCONV(DIO, 'MCU')
192| BEGIN CASE
193| CASE NUM(ANS) AND ANS >= 1 AND ANS <= NUMFLDS; NXTFLD = ANS
194| CASE ANS EQ 'FI'; GOSUB SAVE.RECORD
195| CASE ANS EQ 'DE'; GOSUB DELETE.RECORD
196| CASE ANS EQ 'EX' OR ANS EQ ''; GOSUB CHECK.EXIT
197| END CASE
198| *
199| END
200| *
201| UNTIL DONE DO REPEAT ;* end of ACTION loop
202| *
203|REPEAT ;* end of RECORD loop
204|*
205|**************************************************************************
206|*
207|* All done - clear the screen and exit!
208|PRINT CLR:
209|STOP
210|*
211|*
212|**************************************************************************
213|**************************************************************************
214|* LOCAL SUBROUTINES
215|**************************************************************************
216|**************************************************************************
217|*
218|*
219|**************************************************************************
220|*
221|* The INPUT.FIELD subroutine is the main prompting routine. This routine
222|* displays the prompt string (from the CONTROL array), and enters a loop,
223|* prompting for a specified field (CURFLD) and setting the next field
224|* variable (NXTFLD) appropriately. The loop repeats until the NXTFLD
225|* (initially set to CURFLD) changes. This causes the field prompt to be
226|* repeated in case invalid data is entered (illegal customer ID, etc.) If
227|* a NULL is entered for the ID field, and there is no current record, the
228|* ACTION loop control variable, DONE, and the RECORD loop control
229|* variable, XIT, are set to TRUE, and this routine exits.
230|*
231|INPUT.FIELD:
232|*
233|**************************************************************************
234|*
235|* Display the prompt message
236|*
237|PRINT PL:CONTROL(CURFLD)<1,9>:
238|*
239|**************************************************************************
240|*
241|* Initialize current value, next field
242|*
243|PREVAL = IDATA(CURFLD) ;* Save previous field value to detect change in value
244|*
245|**************************************************************************
246|*
247|* Prompt for this field until NXTFLD variable is updated
248|*
249|LOOP
250| *
251| *************************************************************************
252| *
253| * Assume next field number is next sequential field
254| *
255| NXTFLD = CURFLD + 1
256| *
257| * Highlight current field data
258| *
259| XLINE = CURFLD ;* Set the field number to display
260| ACTIVE = CURFLD ;* Set the active field number to highlight field
261| GOSUB DSPLINE
262| *
263| * Prompt for input
264| *
265| PRINT @(CONTROL(CURFLD)<1,5>,CONTROL(CURFLD)<1,6>):REVERSE:
266| GOSUB INPCMD
267| IDATA(CURFLD) = DIO
268| *
269| * Check for NULL
270| *
271| K = LEN(IDATA(CURFLD))
272| IF K = 0 THEN
273| *
274| * No change if NULL entered
275| *
276| IDATA(CURFLD) = PREVAL
277| END ELSE
278| *
279| * Erase old data
280| *
281| IF K < CONTROL(CURFLD)<1,7> THEN
282| PRINT @(K+CONTROL(CURFLD)<1,5>,CONTROL(CURFLD)<1,6>):SPACE(CONTROL(CURFLD)<1,7> - K):
283| END
284| END
285| *
286| * Reset display attribute
287| *
288| PRINT NORMAL:
289| *
290| * Clear the error line
291| *
292| PRINT EL:
293| *
294| *************************************************************************
295| *
296| * Check for any special values (like 'END' or 'EXIT')
297| *
298| IF OCONV(DIO,'MCU') = 'END' THEN CMD = 'EX'
299| IF CMD NE '' THEN
300| BEGIN CASE
301| CASE CMD = 'EX'
302| IDATA(CURFLD) = PREVAL ;* Restore previous value
303| GOSUB CHECK.ABANDON ;* Ensure OK to loose changes
304| IF OK THEN
305| *
306| ***********************************************************************
307| *
308| * No changes, or user OKs abandoning them, so we are outa here!
309| *
310| DONE = TRUE
311| XIT = TRUE
312| RETURN
313| *
314| END ELSE
315| *
316| ***********************************************************************
317| *
318| * User does not want to abandon changes, so reprompt
319| *
320| NXTFLD = CURFLD ;* Reprompt
321| *
322| END
323| CASE CMD = 'FI'
324| GOSUB SAVE.RECORD
325| CASE CMD = 'DE'
326| GOSUB DELETE.RECORD
327| END CASE
328| END
329| IF IDATA(CURFLD) EQ SPACE(LEN(IDATA(CURFLD))) THEN IDATA(CURFLD) = ''
330| *
331| *************************************************************************
332| *
333| * Peform field data validation if next field number changed
334| *
335| IF NXTFLD NE CURFLD THEN
336| BEGIN CASE
337| *
338| CASE CURFLD EQ 1
339| *
340| **********************************************************************
341| *
342| * Validate the ID field. If NULL, quit. If changed, read new record.
343| *
344| IF CUST.ID EQ '' AND IDATA(CURFLD) EQ '' THEN
345| DONE = TRUE
346| XIT = TRUE
347| RETURN
348| END
349| *
350| IF IDATA(CURFLD) NE PREVAL THEN
351| ID = IDATA(CURFLD)
352| GOSUB CHECK.ID ;* Check the newly entered ID handling index lookups
353| IF OK THEN
354| *
355| ********************************************************************
356| *
357| * New ID (or result of index lookup) is good!
358| *
359| IDATA(CURFLD) = ID ;* Update the current field value in case of index lookup
360| *
361| END ELSE
362| *
363| ********************************************************************
364| *
365| * New ID is invalid
366| *
367| IDATA(CURFLD) = PREVAL ;* Restore previous value
368| NXTFLD = CURFLD ;* Reprompt
369| *
370| END
371| END
372| *
373| END CASE
374| END
375| *
376|WHILE CURFLD EQ NXTFLD DO REPEAT
377|*
378|* Redisplay the field data using the inactive highlighting
379|*
380|XLINE = CURFLD
381|ACTIVE = 0
382|GOSUB DSPLINE
383|*
384|RETURN
385|*
386|*
387|**************************************************************************
388|*
389|* The CHECK.EXIT subroutine checks if any field data has changed, and
390|* prompts if the user wants to abandon changes. If no changes, or the user
391|* decides to abandon the changes, the DONE and XIT loop control variables
392|* are set to TRUE, causing all three loops to terminate, and the program
393|* itself to exit.
394|*
395|CHECK.EXIT: *
396|*
397|GOSUB CHECK.ABANDON
398|IF OK THEN
399| DONE = TRUE
400| XIT = TRUE
401|END
402|RETURN
403|*
404|*
405|**************************************************************************
406|*
407|* The CHECK.ID subroutine validates a newly entered item-ID. If the
408|* current record has unsaved changes, the user is prompted to abandon the
409|* changes. If no changes, or the user abandons the changes, and the new ID
410|* is not NULL, an attempt is made to read a record using the new ID. If
411|* the read is not successful, the ID is assumed to be a search string, and
412|* the search subroutine is called to select an ID based on the search
413|* string. If a valid ID is returned (or if one was initially entered), the
414|* new record data is displayed. If the new ID is null, or if the search
415|* routine did not return a valid ID, a warning message is displayed and
416|* the OK indicator variable is set to FALSE. Otherwise it is set to TRUE.
417|*
418|CHECK.ID: *
419|*
420|**************************************************************************
421|*
422|* Make sure we don't have any unsaved data before changing the ID
423|*
424|GOSUB CHECK.ABANDON
425|IF NOT(OK) THEN RETURN ;* Reprompt for the ID
426|IF ID EQ '' THEN
427| OK = FALSE ;* NULL is not a valid ID!
428|END ELSE
429| *
430| *************************************************************************
431| *
432| * Check if user wants new ID
433| *
434| IF ID EQ 'N' OR ID EQ 'n' THEN
435| * Get next sequential ID
436| READVU ID FROM FN.CUST.CTRL,'NEXT',2 THEN
437| WRITEV ID + 1 ON FN.CUST.CTRL,'NEXT',2
438| GOSUB RESTART
439| IDATA(1) = ID
440| END ELSE
441| PRINT EL:UNDREV:'Next item counter record not found!':NORMAL:BEL:
442| GOSUB INPCMD
443| PRINT EL:
444| OK = FALSE
445| RETURN
446| END
447| END ELSE
448| *
449| *************************************************************************
450| *
451| * Try to read the customer record from the entered ID
452| *
453| GOSUB READ.RECORD
454| IF NOT(OK) THEN
455| *
456| ************************************************************************
457| *
458| * The attempt to read a record failed - assume the ID is a search string
459| *
460| CALL UIEX.GET.CUST.IDX(XID,ID,FN.CUST.XREF,FN.CUST)
461| GOSUB DSPSCRN ;* Refresh the screen after index lookup
462| *
463| ************************************************************************
464| *
465| * If the user did not select an item in the search routine, reprompt
466| *
467| IF XID EQ '' THEN RETURN
468| *
469| ************************************************************************
470| *
471| * Try to read the customer record from the selected ID
472| *
473| ID = XID
474| GOSUB READ.RECORD
475| *
476| END
477| END
478|END
479|*
480|**************************************************************************
481|*
482|* If success, display the new record, otherwise show warning message
483|*
484|IF OK THEN
485| GOSUB DSPDATA ;* Display new record
486|END ELSE
487| PRINT EL:UNDREV:'Please enter a valid customer ID!':NORMAL:BEL:
488|END
489|RETURN
490|*
491|*
492|**************************************************************************
493|*
494|* The READ.RECORD subroutine reads a new customer record from the file and
495|* initializes the internal field data array (IDATA) from the record array
496|* (CUST.REC). If the record does not exist, the routine returns with the
497|* OK indicator variable set to FALSE. Otherwise OK is set to TRUE, and the
498|* CUST.ID variable is set to the new ID.
499|*
500|READ.RECORD: *
501|*
502|MATREAD CUST.REC FROM FN.CUST,ID THEN
503| CUST.ID = ID
504| IDATA(1) = CUST.ID
505| IDATA(2) = CUST.CONTACT
506| IDATA(3) = CUST.NAME
507| IDATA(4) = CUST.ADDRESS1
508| IDATA(5) = CUST.ADDRESS2
509| IDATA(6) = CUST.CITY
510| IDATA(7) = CUST.ST
511| IDATA(8) = CUST.ZIP
512| IDATA(9) = CUST.COUNTRY
513| IDATA(10) = CUST.PHONE
514| IDATA(11) = CUST.FAX
515| IDATA(12) = CUST.HISTORY
516| OK = TRUE ;* Set the SUCCESS indicator
517|END ELSE
518| OK = FALSE ;* Set the FAILURE indicator
519|END
520|RETURN
521|*
522|*
523|**************************************************************************
524|*
525|* The DELETE.RECORD subroutine confirms that the user intends to delete
526|* the current record. If the action is confirmed, the CUST.DELETE
527|* subroutine is called to perform the deletion. A separate subroutine is
528|* used to handle updating indexes, etc.
529|*
530|DELETE.RECORD: *
531|*
532|IF CUST.ID NE '' THEN
533| PRINT EL:UNDREV:'Are you sure you want to delete this customer? ':NORMAL:
534| GOSUB INPCMD
535| IF DIO[1,1] EQ 'Y' OR DIO[1,1] EQ 'y' THEN
536| * Deletion has been confirmed - do the delete
537| OK = TRUE ;* Set the SUCCESS indicator
538| CALL UIEX.CUST.DELETE(CUST.ID,FN.CUST,FN.CUST.XREF)
539| DONE = TRUE ;* proceed to next record
540| END ELSE
541| OK = FALSE ;* Set the FAILURE indicator
542| END
543|END
544|RETURN
545|*
546|*
547|**************************************************************************
548|*
549|* The SAVE.RECORD subroutine copies internal field data from the IDATA
550|* array to the customer record array (CUST.REC). The CUST.UPDATE
551|* subroutine is called to perform the update. A separate subroutine is
552|* used to handle updating indexes, etc.
553|*
554|SAVE.RECORD: *
555|*
556|IF IDATA(1) NE '' THEN
557| * Copy data from the internal field data array (IDATA) to the CUST.REC array
558| CUST.ID = IDATA(1)
559| CUST.CONTACT = IDATA(2)
560| CUST.NAME = IDATA(3)
561| CUST.ADDRESS1 = IDATA(4)
562| CUST.ADDRESS2 = IDATA(5)
563| CUST.CITY = IDATA(6)
564| CUST.ST = IDATA(7)
565| CUST.ZIP = IDATA(8)
566| CUST.COUNTRY = IDATA(9)
567| CUST.PHONE = IDATA(10)
568| CUST.FAX = IDATA(11)
569| CUST.HISTORY = IDATA(12)
570| * Update the file
571| CALL UIEX.CUST.UPDATE(CUST.ID,MAT CUST.REC,FN.CUST,FN.CUST.XREF)
572| OK = TRUE ;* Set the SUCCESS indicator
573|END ELSE
574| OK = FALSE ;* Set the FAILURE indicator
575|END
576|DONE = TRUE ;* proceed to next record
577|RETURN
578|*
579|*
580|**************************************************************************
581|*
582|* The RESTART subroutine prepares the internal field data array (IDATA),
583|* customer record array (CUST.REC) and ID for a new customer record.
584|*
585|RESTART: *
586|*
587|CUST.ID = ''
588|MAT CUST.REC = ''
589|MAT IDATA = ''
590|ACTIVE = 0
591|RETURN
592|*
593|*
594|**************************************************************************
595|*
596|* The CHECK.CHANGED subroutine checks if any internal field data has been
597|* changed. The OK indicator variable is set to FALSE if any data is
598|* changed, otherwise it is set to TRUE. The ID field is not checked, since
599|* it is appropriately handled by the CHECK.ID subroutine.
600|*
601|CHECK.CHANGED: *
602|*
603|OK = FALSE
604|IF CUST.CONTACT # IDATA(2) THEN RETURN
605|IF CUST.NAME # IDATA(3) THEN RETURN
606|IF CUST.ADDRESS1 # IDATA(4) THEN RETURN
607|IF CUST.ADDRESS2 # IDATA(5) THEN RETURN
608|IF CUST.CITY # IDATA(6) THEN RETURN
609|IF CUST.ST # IDATA(7) THEN RETURN
610|IF CUST.ZIP # IDATA(8) THEN RETURN
611|IF CUST.COUNTRY # IDATA(9) THEN RETURN
612|IF CUST.PHONE # IDATA(10) THEN RETURN
613|IF CUST.FAX # IDATA(11) THEN RETURN
614|IF CUST.HISTORY # IDATA(12) THEN RETURN
615|OK = TRUE
616|RETURN
617|*
618|*
619|**************************************************************************
620|*
621|* The CHECK.ABANDON subroutine calls CHECK.CHANGED. If any changes are
622|* found, a message is displayed and the user is prompted to abandon the
623|* changes. If there are no changes, or if the user decides to abandon
624|* changes, the OK indicator variable is set to TRUE. Otherwise it is set
625|* to FALSE.
626|*
627|CHECK.ABANDON: *
628|*
629|GOSUB CHECK.CHANGED
630|IF NOT(OK) THEN
631| PRINT EL:UNDREV:'Do you want to abandon all your changes? ':NORMAL:BEL:
632| GOSUB INPCMD
633| IF DIO[1,1] EQ 'Y' OR DIO[1,1] EQ 'y' THEN OK = 1
634| PRINT EL:
635|END
636|RETURN
637|*
638|*
639|**************************************************************************
640|*
641|* The DSPSCRN subroutine is used to refresh the entire screen.
642|*
643|DSPSCRN: *
644|*
645|* Clear the screen
646|PRINT CLR:NORMAL:
647|*
648|* Display heading & labels
649|PRINT @(5,0):'Customer File Maintenance':
650|FOR XLINE = 1 TO NUMFLDS
651| LBWD = CONTROL(XLINE)<1,4>
652| LBTX = (XLINE 'L#2 ') : CONTROL(XLINE)<1,1> ;* Prepend line number to label
653| IF LBWD > 0 THEN LBTX = (LBTX : STR('.',LBWD))[1,LBWD] ;* Pad label with dots
654| PRINT @(CONTROL(XLINE)<1,2>,CONTROL(XLINE)<1,3>):LBTX:
655|NEXT XLINE
656|*
657|PRINT @(5,20):REVERSE:'F5 = Save':NORMAL:
658|PRINT @(20,20):REVERSE:'F3 = Delete':NORMAL:
659|PRINT @(35,20):REVERSE:'F2 = Exit':NORMAL:
660|*
661|* Display the field data
662|GOSUB DSPDATA
663|RETURN
664|*
665|*
666|**************************************************************************
667|*
668|* The DSPDATA subroutine is used to refresh the field data for all fields.
669|*
670|DSPDATA: *
671|*
672|FOR XLINE = 1 TO NUMFLDS
673| GOSUB DSPLINE
674|NEXT XLINE
675|RETURN
676|*
677|*
678|**************************************************************************
679|*
680|* The DSPLINE subroutine is used to refresh the field data for one field.
681|* The field to be refreshed is specified by the XLINE variable. If the
682|* field is active (XLINE = ACTIVE), then the field data is displayed using
683|* the REVERSE display attribute. Otherwise it is displayed using the
684|* DIMREV display attribute.
685|*
686|DSPLINE: *
687|*
688|MSK = 'L#':CONTROL(XLINE)<1,7>
689|PRINT @(CONTROL(XLINE)<1,5>,CONTROL(XLINE)<1,6>):
690|IF XLINE EQ ACTIVE THEN
691| PRINT REVERSE:
692|END ELSE
693| PRINT DIMREV:
694|END
695|PRINT IDATA(XLINE) MSK:
696|PRINT NORMAL:
697|RETURN
698|*
699|*
700|**************************************************************************
701|*
702|* The INPCMD subroutine is used to input data or function key. If function
703|* key presed, the CMD variable is set to 'FI', 'DE', or 'EX'.
704|* Otherwise, CMD is null, and the entered data is returned in DIO.
705|*
706|INPCMD: *
707|*
708|ECHO OFF
709|DIO = ''
710|CMD = ''
711|INPDONE = FALSE
712|LOOP UNTIL INPDONE DO
713| CHR = KEYIN(); * get raw character (no echo)
714| CHRNUM = SEQ(CHR) ;* get ASCII value
715| BEGIN CASE
716| CASE CHRNUM = 13 OR CHRNUM = 10
717| * CR or LF terminates input
718| INPDONE = TRUE
719| CASE CHRNUM = 8
720| * Backspace
721| IF DIO NE '' THEN
722| DIO = DIO[1,LEN(DIO)-1]
723| PRINT BACKSPACE:' ':BACKSPACE:
724| END
725| CASE CHRNUM = 1
726| * Wyse function key lead-in
727| INPUT REST:
728| IF DIO = '' THEN
729| * Decode the function key if pressed at beginning of input
730| BEGIN CASE
731| CASE REST = 'A'; CMD = 'EX'; INPDONE = TRUE
732| CASE REST = 'B'; CMD = 'DE'; INPDONE = TRUE
733| CASE REST = 'D'; CMD = 'FI'; INPDONE = TRUE
734| CASE TRUE; * ignore other function keys
735| END CASE
736| END
737| CASE CHRNUM = 27
738| * Discard escape sequences - Wyse escape sequences are
739| * ESC followed by another character
740| CHR = KEYIN() ;*
741| CASE CHRNUM >= 32
742| * append printable characters to DIO & echo
743| DIO = DIO : CHR
744| PRINT CHR:
745| END CASE
746|REPEAT
747|ECHO ON
748|RETURN
749|*
750|*
751|END
752|