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|* USER INTERFACE EXAMPLE PROGRAM 1
22|*
23|**************************************************************************
24|**************************************************************************
25|*
26|* This example illustrates a very simple character-based user interface.
27|* This example does not use any visual highlighting, or respond to
28|* function or cursor keys.
29|*
30|**************************************************************************
31|*
32|* The CUST.REC INCLUDE item declares the CUST.REC array, which is used to
33|* store a working copy of the current data record. It also defines the
34|* record layout by equating field names to array positions in the CUST.REC
35|* array.
36|*
37|$INCLUDE UIEX.CUST.REC
38|*
39|**************************************************************************
40|*
41|* EQUates for control characters and delimiters and other constants
42|*
43|EQU VM TO CHAR(253)
44|EQU BEL TO CHAR(7)
45|EQU FALSE TO 0
46|EQU TRUE TO 1
47|*
48|**************************************************************************
49|*
50|* Open our files...
51|*
52|OPEN 'CUST.SAMPLE' TO FN.CUST ELSE PRINT 'NO CUST.SAMPLE FILE'; STOP
53|OPEN 'DICT CUST.SAMPLE' TO FN.DICT.CUST ELSE PRINT 'NO DICT CUST.SAMPLE FILE'; STOP
54|OPEN 'CUST.SAMPLE.XREF' TO FN.CUST.XREF ELSE PRINT 'NO CUST.SAMPLE.XREF'; STOP
55|*
56|**************************************************************************
57|*
58|* Define the data field control structures. NUMFLDS is the number of
59|* fields. The CONTROL array defines the field control elements such as
60|* field label, label position, field position and size, and field prompt.
61|* The IDATA array stores the current field values, and is initialized from
62|* the CUST.REC array when a data record is read from the file. When the
63|* record is updated, values are copied from the IDATA array to the
64|* CUST.REC array and the CUST.REC array is passed to the CUST.UPDATE
65|* subroutine to update the data and index files (a separate subroutine is
66|* used to update the file since the update process may handle other
67|* functions like updating indexes).
68|*
69|NUMFLDS = 12
70|DIM CONTROL(12)
71|DIM IDATA(12)
72|*
73|* Define field control elements
74|* value 1: field label text
75|* value 2: field label column
76|* value 3: field label row
77|* value 4: field label width (0 for actual width, no padding)
78|* value 5: field data column
79|* value 6: field data row
80|* value 7: field data width
81|* value 8: field data height
82|* value 9: field prompt message
83|CONTROL(1) = 'Customer IDý7ý2ý20ý28ý2ý30ý1ýEnter the ID, or name to search for, or N for next number'
84|CONTROL(2) = 'Contactý7ý4ý20ý28ý4ý30ý1ýEnter the contact name'
85|CONTROL(3) = 'Company nameý7ý5ý20ý28ý5ý30ý1ýEnter the company name'
86|CONTROL(4) = 'Address line 1ý7ý6ý20ý28ý6ý30ý1ýEnter address line 1'
87|CONTROL(5) = 'Address line 2ý7ý7ý20ý28ý7ý30ý1ýEnter address line 2'
88|CONTROL(6) = 'Cityý7ý8ý20ý28ý8ý25ý1ýEnter the city'
89|CONTROL(7) = 'State or provinceý7ý9ý20ý28ý9ý15ý1ýEnter the state or province abbreviation'
90|CONTROL(8) = 'Zip/postal codeý7ý10ý20ý28ý10ý10ý1ýEnter the zip or postal code'
91|CONTROL(9) = 'Countryý7ý11ý20ý28ý11ý18ý1ýEnter the country'
92|CONTROL(10) = 'Phoneý7ý12ý20ý28ý12ý15ý1ýEnter the phone number'
93|CONTROL(11) = 'Faxý7ý13ý20ý28ý13ý15ý1ýEnter the fax number'
94|CONTROL(12) = 'Notesý7ý14ý20ý28ý14ý30ý1ýEnter any notes about this customer'
95|*
96|**************************************************************************
97|*
98|* Define some screen control strings for prompts & errors
99|*
100|PROMPT ''
101|CLR = @(-1) ;* Clear entire screen
102|CEOL = @(-4) ;* Clear to end of line
103|PL = @(5,22):CEOL ;* Prompt line
104|EL = @(5,23):CEOL ;* Error line
105|*
106|**************************************************************************
107|*
108|* This program processes one customer record at a time, and is organized
109|* using three nested loops. The outermost loop (the RECORD loop) is
110|* executed once for each record accessed. The loop repeats until the EXIT
111|* control variable is set to TRUE.
112|*
113|EXIT = FALSE
114|LOOP UNTIL EXIT DO
115| *
116| *************************************************************************
117| *
118| * Before prompting for the customer ID, reset the internal data array
119| * (IDATA) and CUST.ID variables, then clear the screen and display the
120| * heading and field labels.
121| *
122| GOSUB RESTART
123| GOSUB DSPSCRN
124| *
125| *************************************************************************
126| *
127| * The middle loop is the ACTION loop. It is executed for the current
128| * record until the user performs an action that terminates processing of
129| * that record, such as exiting, cancelling, saving or deleting the
130| * record. The field number to begin prompting (NXTFLD) is initialized to
131| * 1, causing the ID field to be prompted first. The loop immediately
132| * enters the PROMPT loop, followed by the field modification prompt. The
133| * loop repeats until the DONE control variable is set to TRUE.
134| *
135| NXTFLD = 1
136| DONE = FALSE
137| LOOP
138| *
139| ************************************************************************
140| *
141| * The inner loop is the PROMPT loop. It is executed for each prompt
142| * field as specified by the NXTFLD variable. The prompt loop simply
143| * calls the local INPUT.FIELD subroutine which performs field input,
144| * data validation and keyboard command decoding. The FIELD loop repeats
145| * until the field number is greater than the number of fields, or until
146| * the DONE control variable is set to TRUE. The DONE control variable
147| * may be set to TRUE in the INPUT.FIELD subroutine, if the user enters a
148| * NULL to for the item-ID.
149| *
150| LOOP
151| CURFLD = NXTFLD
152| UNTIL DONE OR CURFLD > NUMFLDS DO
153| *
154| ***********************************************************************
155| *
156| * Prompt for the next field. Update the NXTFLD variable with the field
157| * number to prompt next.
158| *
159| GOSUB INPUT.FIELD
160| REPEAT ;* end of PROMPT loop
161| *
162| ************************************************************************
163| *
164| * If the FIELD loop exited with the DONE control variable set to TRUE,
165| * bypass the modification prompt because no action is required.
166| * Otherwise, prompt for which field to modify, or other actions such as
167| * save or delete.
168| *
169| IF NOT(DONE) THEN
170| *
171| NXTFLD = NUMFLDS + 1 ;* assume we need to reprompt for action
172| *
173| PRINT PL:'Enter field number to modify or FI to save, DE to delete, EX to exit: ':
174| INPUT ANS:
175| PRINT EL:
176| *
177| ***********************************************************************
178| *
179| * Decode the response
180| *
181| ANS = OCONV(ANS, 'MCU')
182| BEGIN CASE
183| CASE NUM(ANS) AND ANS >= 1 AND ANS <= NUMFLDS; NXTFLD = ANS
184| CASE ANS EQ 'FI'; GOSUB SAVE.RECORD
185| CASE ANS EQ 'DE'; GOSUB DELETE.RECORD
186| CASE ANS EQ 'EX' OR ANS EQ ''; GOSUB CHECK.EXIT
187| END CASE
188| *
189| END
190| *
191| UNTIL DONE DO REPEAT ;* end of ACTION loop
192| *
193|REPEAT ;* end of RECORD loop
194|*
195|**************************************************************************
196|*
197|* All done - clear the screen and exit!
198|PRINT CLR:
199|STOP
200|*
201|*
202|**************************************************************************
203|**************************************************************************
204|* LOCAL SUBROUTINES
205|**************************************************************************
206|**************************************************************************
207|*
208|*
209|**************************************************************************
210|*
211|* The INPUT.FIELD subroutine is the main prompting routine. This routine
212|* displays the prompt string (from the CONTROL array), and enters a loop,
213|* prompting for a specified field (CURFLD) and setting the next field
214|* variable (NXTFLD) appropriately. The loop repeats until the NXTFLD
215|* (initially set to CURFLD) changes. This causes the field prompt to be
216|* repeated in case invalid data is entered (illegal customer ID, etc.) If
217|* a NULL is entered for the ID field, and there is no current record, the
218|* ACTION loop control variable, DONE, and the RECORD loop control
219|* variable, EXIT, are set to TRUE, and this routine exits.
220|*
221|INPUT.FIELD:
222|*
223|**************************************************************************
224|*
225|* Display the prompt message
226|*
227|PRINT PL:CONTROL(CURFLD)<1,9>:
228|*
229|**************************************************************************
230|*
231|* Initialize current value, next field
232|*
233|PREVAL = IDATA(CURFLD) ;* Save previous field value to detect change in value
234|*
235|**************************************************************************
236|*
237|* Prompt for this field until NXTFLD variable is updated
238|*
239|LOOP
240| *
241| *************************************************************************
242| *
243| * Assume next field number is next sequential field
244| *
245| NXTFLD = CURFLD + 1
246| *
247| * Prompt for input
248| *
249| PRINT @(CONTROL(CURFLD)<1,5>,CONTROL(CURFLD)<1,6>):
250| INPUT IDATA(CURFLD):
251| *
252| * Check for NULL
253| *
254| K = LEN(IDATA(CURFLD))
255| IF K = 0 THEN
256| *
257| * No change if NULL entered
258| *
259| IDATA(CURFLD) = PREVAL
260| END ELSE
261| *
262| * Erase old data
263| *
264| IF K < CONTROL(CURFLD)<1,7> THEN
265| PRINT @(K+CONTROL(CURFLD)<1,5>,CONTROL(CURFLD)<1,6>):SPACE(CONTROL(CURFLD)<1,7> - K):
266| END
267| END
268| *
269| * Clear the error line
270| *
271| PRINT EL:
272| *
273| *************************************************************************
274| *
275| * Check for any special values (like 'END' or 'EXIT')
276| *
277| IF OCONV(IDATA(CURFLD),'MCU') EQ 'END' THEN
278| IDATA(CURFLD) = PREVAL ;* Restore previous value
279| GOSUB CHECK.ABANDON ;* Ensure OK to loose changes
280| IF OK THEN
281| *
282| ***********************************************************************
283| *
284| * No changes, or user OKs abandoning them, so we are outa here!
285| *
286| DONE = TRUE
287| EXIT = TRUE
288| RETURN
289| *
290| END ELSE
291| *
292| ***********************************************************************
293| *
294| * User does not want to abandon changes, so reprompt
295| *
296| XLINE = CURFLD ;* Set the field number to refresh
297| GOSUB DSPLINE ;* Refresh previous value
298| NXTFLD = CURFLD ;* Reprompt
299| *
300| END
301| END
302| IF IDATA(CURFLD) EQ SPACE(LEN(IDATA(CURFLD))) THEN IDATA(CURFLD) = ''
303| *
304| *************************************************************************
305| *
306| * Peform field data validation if next field number changed
307| *
308| IF NXTFLD NE CURFLD THEN
309| BEGIN CASE
310| *
311| CASE CURFLD EQ 1
312| *
313| **********************************************************************
314| *
315| * Validate the ID field. If NULL, quit. If changed, read new record.
316| *
317| IF CUST.ID EQ '' AND IDATA(CURFLD) EQ '' THEN
318| DONE = TRUE
319| EXIT = TRUE
320| RETURN
321| END
322| *
323| IF IDATA(CURFLD) NE PREVAL THEN
324| ID = IDATA(CURFLD)
325| GOSUB CHECK.ID ;* Check the newly entered ID handling index lookups
326| IF OK THEN
327| *
328| ********************************************************************
329| *
330| * New ID (or result of index lookup) is good!
331| *
332| IDATA(CURFLD) = ID ;* Update the current field value in case of index lookup
333| *
334| END ELSE
335| *
336| ********************************************************************
337| *
338| * New ID is invalid
339| *
340| IDATA(CURFLD) = PREVAL ;* Restore previous value
341| XLINE = CURFLD ;* Set the field number to refresh
342| GOSUB DSPLINE ;* Refresh previous value
343| NXTFLD = CURFLD ;* Reprompt
344| *
345| END
346| END
347| *
348| END CASE
349| END
350| *
351|WHILE CURFLD EQ NXTFLD DO REPEAT
352|*
353|RETURN
354|*
355|*
356|**************************************************************************
357|*
358|* The CHECK.EXIT subroutine checks if any field data has changed, and
359|* prompts if the user wants to abandon changes. If no changes, or the user
360|* decides to abandon the changes, the DONE and EXIT loop control variables
361|* are set to TRUE, causing all three loops to terminate, and the program
362|* itself to exit.
363|*
364|CHECK.EXIT: *
365|*
366|GOSUB CHECK.ABANDON
367|IF OK THEN
368| DONE = TRUE
369| EXIT = TRUE
370|END
371|RETURN
372|*
373|*
374|**************************************************************************
375|*
376|* The CHECK.ID subroutine validates a newly entered item-ID. If the
377|* current record has unsaved changes, the user is prompted to abandon the
378|* changes. If no changes, or the user abandons the changes, and the new ID
379|* is not NULL, an attempt is made to read a record using the new ID. If
380|* the read is not successful, the ID is assumed to be a search string, and
381|* the search subroutine is called to select an ID based on the search
382|* string. If a valid ID is returned (or if one was initially entered), the
383|* new record data is displayed. If the new ID is null, or if the search
384|* routine did not return a valid ID, a warning message is displayed and
385|* the OK indicator variable is set to FALSE. Otherwise it is set to TRUE.
386|*
387|CHECK.ID: *
388|*
389|**************************************************************************
390|*
391|* Make sure we don't have any unsaved data before changing the ID
392|*
393|GOSUB CHECK.ABANDON
394|IF NOT(OK) THEN RETURN ;* Reprompt for the ID
395|IF ID EQ '' THEN
396| OK = FALSE ;* NULL is not a valid ID!
397|END ELSE
398| *
399| *************************************************************************
400| *
401| * Check if user wants new ID
402| *
403| IF ID EQ 'N' OR ID EQ 'n' THEN
404| * Get next sequential ID
405| READVU ID FROM FN.DICT.CUST,'NEXT',2 THEN
406| WRITEV ID + 1 ON FN.DICT.CUST,'NEXT',2
407| GOSUB RESTART
408| IDATA(1) = ID
409| END ELSE
410| PRINT EL:'Next item counter record not found!':BEL:
411| INPUT ANS:
412| PRINT EL:
413| OK = FALSE
414| RETURN
415| END
416| END ELSE
417| *
418| *************************************************************************
419| *
420| * Try to read the customer record from the entered ID
421| *
422| GOSUB READ.RECORD
423| IF NOT(OK) THEN
424| *
425| ************************************************************************
426| *
427| * The attempt to read a record failed - assume the ID is a search string
428| *
429| CALL UIEX.GET.CUST.IDX(XID,ID,FN.CUST.XREF,FN.CUST)
430| GOSUB DSPSCRN ;* Refresh the screen after index lookup
431| *
432| ************************************************************************
433| *
434| * If the user did not select an item in the search routine, reprompt
435| *
436| IF XID EQ '' THEN RETURN
437| *
438| ************************************************************************
439| *
440| * Try to read the customer record from the selected ID
441| *
442| ID = XID
443| GOSUB READ.RECORD
444| *
445| END
446| END
447|END
448|*
449|**************************************************************************
450|*
451|* If success, display the new record, otherwise show warning message
452|*
453|IF OK THEN
454| GOSUB DSPDATA ;* Display new record
455|END ELSE
456| PRINT EL:'Please enter a valid customer ID!':BEL:
457|END
458|RETURN
459|*
460|*
461|**************************************************************************
462|*
463|* The READ.RECORD subroutine reads a new customer record from the file and
464|* initializes the internal field data array (IDATA) from the record array
465|* (CUST.REC). If the record does not exist, the routine returns with the
466|* OK indicator variable set to FALSE. Otherwise OK is set to TRUE, and the
467|* CUST.ID variable is set to the new ID.
468|*
469|READ.RECORD: *
470|*
471|MATREAD CUST.REC FROM FN.CUST,ID THEN
472| CUST.ID = ID
473| IDATA(1) = CUST.ID
474| IDATA(2) = CUST.CONTACT
475| IDATA(3) = CUST.NAME
476| IDATA(4) = CUST.ADDRESS1
477| IDATA(5) = CUST.ADDRESS2
478| IDATA(6) = CUST.CITY
479| IDATA(7) = CUST.ST
480| IDATA(8) = CUST.ZIP
481| IDATA(9) = CUST.COUNTRY
482| IDATA(10) = CUST.PHONE
483| IDATA(11) = CUST.FAX
484| IDATA(12) = CUST.HISTORY
485| OK = TRUE ;* Set the SUCCESS indicator
486|END ELSE
487| OK = FALSE ;* Set the FAILURE indicator
488|END
489|RETURN
490|*
491|*
492|**************************************************************************
493|*
494|* The DELETE.RECORD subroutine confirms that the user intends to delete
495|* the current record. If the action is confirmed, the CUST.DELETE
496|* subroutine is called to perform the deletion. A separate subroutine is
497|* used to handle updating indexes, etc.
498|*
499|DELETE.RECORD: *
500|*
501|IF CUST.ID NE '' THEN
502| PRINT EL:'Are you sure you want to delete this customer? ':
503| INPUT ANS:
504| IF ANS[1,1] EQ 'Y' OR ANS[1,1] EQ 'y' THEN
505| * Deletion has been confirmed - do the delete
506| OK = TRUE ;* Set the SUCCESS indicator
507| CALL UIEX.CUST.DELETE(CUST.ID,FN.CUST,FN.CUST.XREF)
508| DONE = TRUE ;* proceed to next record
509| END ELSE
510| OK = FALSE ;* Set the FAILURE indicator
511| END
512|END
513|RETURN
514|*
515|*
516|**************************************************************************
517|*
518|* The SAVE.RECORD subroutine copies internal field data from the IDATA
519|* array to the customer record array (CUST.REC). The CUST.UPDATE
520|* subroutine is called to perform the update. A separate subroutine is
521|* used to handle updating indexes, etc.
522|*
523|SAVE.RECORD: *
524|*
525|IF IDATA(1) NE '' THEN
526| * Copy data from the internal field data array (IDATA) to the CUST.REC array
527| CUST.ID = IDATA(1)
528| CUST.CONTACT = IDATA(2)
529| CUST.NAME = IDATA(3)
530| CUST.ADDRESS1 = IDATA(4)
531| CUST.ADDRESS2 = IDATA(5)
532| CUST.CITY = IDATA(6)
533| CUST.ST = IDATA(7)
534| CUST.ZIP = IDATA(8)
535| CUST.COUNTRY = IDATA(9)
536| CUST.PHONE = IDATA(10)
537| CUST.FAX = IDATA(11)
538| CUST.HISTORY = IDATA(12)
539| * Update the file
540| CALL UIEX.CUST.UPDATE(CUST.ID,MAT CUST.REC,FN.CUST,FN.CUST.XREF)
541| OK = TRUE ;* Set the SUCCESS indicator
542|END ELSE
543| OK = FALSE ;* Set the FAILURE indicator
544|END
545|DONE = TRUE ;* proceed to next record
546|RETURN
547|*
548|*
549|**************************************************************************
550|*
551|* The RESTART subroutine prepares the internal field data array (IDATA),
552|* customer record array (CUST.REC) and ID for a new customer record.
553|*
554|RESTART: *
555|*
556|CUST.ID = ''
557|MAT CUST.REC = ''
558|MAT IDATA = ''
559|RETURN
560|*
561|*
562|**************************************************************************
563|*
564|* The CHECK.CHANGED subroutine checks if any internal field data has been
565|* changed. The OK indicator variable is set to FALSE if any data is
566|* changed, otherwise it is set to TRUE. The ID field is not checked, since
567|* it is appropriately handled by the CHECK.ID subroutine.
568|*
569|CHECK.CHANGED: *
570|*
571|OK = FALSE
572|IF CUST.CONTACT # IDATA(2) THEN RETURN
573|IF CUST.NAME # IDATA(3) THEN RETURN
574|IF CUST.ADDRESS1 # IDATA(4) THEN RETURN
575|IF CUST.ADDRESS2 # IDATA(5) THEN RETURN
576|IF CUST.CITY # IDATA(6) THEN RETURN
577|IF CUST.ST # IDATA(7) THEN RETURN
578|IF CUST.ZIP # IDATA(8) THEN RETURN
579|IF CUST.COUNTRY # IDATA(9) THEN RETURN
580|IF CUST.PHONE # IDATA(10) THEN RETURN
581|IF CUST.FAX # IDATA(11) THEN RETURN
582|IF CUST.HISTORY # IDATA(12) THEN RETURN
583|OK = TRUE
584|RETURN
585|*
586|*
587|**************************************************************************
588|*
589|* The CHECK.ABANDON subroutine calls CHECK.CHANGED. If any changes are
590|* found, a message is displayed and the user is prompted to abandon the
591|* changes. If there are no changes, or if the user decides to abandon
592|* changes, the OK indicator variable is set to TRUE. Otherwise it is set
593|* to FALSE.
594|*
595|CHECK.ABANDON: *
596|*
597|GOSUB CHECK.CHANGED
598|IF NOT(OK) THEN
599| PRINT EL:'Do you want to abandon all your changes? ':BEL:
600| INPUT ANS:
601| IF ANS[1,1] EQ 'Y' OR ANS[1,1] EQ 'y' THEN OK = 1
602| PRINT EL:
603|END
604|RETURN
605|*
606|*
607|**************************************************************************
608|*
609|* The DSPSCRN subroutine is used to refresh the entire screen.
610|*
611|DSPSCRN: *
612|*
613|* Clear the screen
614|PRINT CLR:
615|*
616|* Display heading & labels
617|PRINT @(5,0):'Customer File Maintenance':
618|FOR XLINE = 1 TO NUMFLDS
619| LBWD = CONTROL(XLINE)<1,4>
620| LBTX = (XLINE 'L#2 ') : CONTROL(XLINE)<1,1> ;* Prepend line number to label
621| IF LBWD > 0 THEN LBTX = (LBTX : STR('.',LBWD))[1,LBWD] ;* Pad label with dots
622| PRINT @(CONTROL(XLINE)<1,2>,CONTROL(XLINE)<1,3>):LBTX:
623|NEXT XLINE
624|*
625|* Display the field data
626|GOSUB DSPDATA
627|RETURN
628|*
629|*
630|**************************************************************************
631|*
632|* The DSPDATA subroutine is used to refresh the field data for all fields.
633|*
634|DSPDATA: *
635|*
636|FOR XLINE = 1 TO NUMFLDS
637| GOSUB DSPLINE
638|NEXT XLINE
639|RETURN
640|*
641|*
642|**************************************************************************
643|*
644|* The DSPLINE subroutine is used to refresh the field data for one field.
645|* The field to be refreshed is specified by the XLINE variable.
646|*
647|DSPLINE: *
648|*
649|MSK = 'L#':CONTROL(XLINE)<1,7>
650|PRINT @(CONTROL(XLINE)<1,5>,CONTROL(XLINE)<1,6>):IDATA(XLINE) MSK:
651|RETURN
652|*
653|