ExamDiff Pro Diff Report

E:\spectrum demo CD 2007\session samples\mouse_demo\BP\MOUSE.DEMO1

E:\spectrum demo CD 2007\session samples\mouse_demo\BP\MOUSE.DEMO3

1|*

2|**************************************************************************

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|