Monster Media 1993 #2

home *** CD-ROM | disk | FTP | other *** search

/ Monster Media 1993 #2 / Image.iso / text / dodsum93.zip / DOD.LST < prev next >

Wrap

File List | 1993-06-27 | 115KB | 1,706 lines

DOD.CLA CLARION COMPILER v2.0 6/27/93 7:50 PM PAGE 1 1 DOD PROGRAM 2 1 INCLUDE('STD_KEYS.CLA') 3 1 INCLUDE('CTL_KEYS.CLA') 4 1 INCLUDE('ALT_KEYS.CLA') 5 1 INCLUDE('SHF_KEYS.CLA') 6 1 7 1 REJECT_KEY EQUATE(CTRL_ESC) 8 1 ACCEPT_KEY EQUATE(CTRL_ENTER) 9 1 TRUE EQUATE(1) 10 1 FALSE EQUATE(0) 11 12 1 MAP 13 2 PROC(G_OPENFILES) 14 2 PROC(MAIN) !DIRECTORY ON DISK, WINTER 93 15 2 PROC(LISTED_COMP) 16 2 PROC(VIEW_COMP) !LISTINGS BY COMPANY NAME 17 2 PROC(UPDATE_LIST) !Company information 18 2 PROC(VIEW_PROD) !VIEW COMPANIES BY PRODUCT 19 2 PROC(VIEW_STATE) !VIEW COMPANIES BY LOCATION 20 2 PROC(VIEW_CATEGO) !PRODUCT AND SERVICE CATEGORIES 21 2 PROC(UPDATE_CAT) !Update categories 22 2 PROC(PRINT_RECORD) !Directory on disk listing 23 2 PROC(PRINT_CAT) !Print categories 24 2 . DOD.CLA CLARION COMPILER v2.0 FILE LAYOUTS 6/27/93 7:50 PM PAGE 2 26 1 LISTINGS FILE,PRE(LIS),CREATE,RECLAIM 27 2 COMP_KEY KEY(LIS:COMPANY_NAME),DUP,NOCASE,OPT 28 2 PRODUCT_KEY KEY(LIS:PRODUCT),DUP,NOCASE,OPT 29 2 STATE_KEY KEY(LIS:STATE),DUP,NOCASE,OPT 30 2 COMMENTS MEMO(3000) !comments 31 2 RECORD RECORD 32 3 COMPANY_NAME STRING(30) !company name 33 3 CONTACT_NAME STRING(35) !contact person 34 3 PRODUCT STRING(19) !product 35 3 ADDRESS_1 STRING(30) !address 36 3 ADDRESS_2 STRING(20) !box or suite # 37 3 CITY STRING(25) !city 38 3 STATE STRING(2) !state 39 3 ZIP STRING(10) 40 3 PHONE DECIMAL(12,0) !phone 41 3 FAX DECIMAL(12,0) !fax 42 3 E_MAIL STRING(30) !e-mail 43 3 DESCRIPTION STRING(50) !product/service description 44 3 REBATE STRING(50) !rebate/discount or free item 45 3 EXPIRES LONG !expiration date 46 3 . . 47 1 GROUP,OVER(LIS:COMMENTS) 48 2 LIS_MEMO_ROW STRING(50),DIM(60) 49 2 . 50 51 1 INDEX FILE,PRE(IND),CREATE,RECLAIM 52 2 CAT_INDEX KEY(IND:CATEGORY),DUP,NOCASE,OPT 53 2 RECORD RECORD 54 3 CATEGORY STRING(25) !INDEX OF CATEGORIES 55 3 COMMENT STRING(30) !COMMENT ON CATERGORY 56 3 . . 57 DOD.CLA CLARION COMPILER v2.0 GLOBAL MEMORY VARIABLES 6/27/93 7:50 PM PAGE 3 59 1 ACTION SHORT !0 = NO ACTION 60 !1 = ADD RECORD 61 !2 = CHANGE RECORD 62 !3 = DELETE RECORD 63 !4 = LOOKUP FIELD 64 1 GROUP,PRE(MEM) 65 2 MESSAGE STRING(30) !Global Message Area 66 2 PAGE DECIMAL(3,0) !Report Page Number 67 2 LINE DECIMAL(3,0) !Report Line Number 68 2 DEVICE STRING(30) !Report Device Name 69 2 . 70 DOD.CLA CLARION COMPILER v2.0 CODE SECTION 6/27/93 7:50 PM PAGE 4 72 1 CODE 73 1 SETHUE(7,0) !SET WHITE ON BLACK 74 1 BLANK ! AND BLANK 75 1 G_OPENFILES !OPEN OR CREATE FILES 76 1 SETHUE() ! THE SCREEN 77 1 MAIN !DIRECTORY ON DISK, WINTER 93 78 1 RETURN !EXIT TO DOS 79 80 1 G_OPENFILES PROCEDURE !OPEN FILES & CHECK FOR ERROR 81 1 CODE 82 1 SHOW(25,1,CENTER('OPENING FILE: ' & 'LISTINGS',80)) !DISPLAY FILE NAME 83 1 OPEN(LISTINGS) !OPEN THE FILE 84 1 IF ERROR() !OPEN RETURNED AN ERROR 85 2 CASE ERRORCODE() ! CHECK FOR SPECIFIC ERROR 86 3 OF 37 ! MISSING KEY FILE 87 3 OROF 46 ! KEYS NEED TO BE REQUILT 88 3 SETHUE(0,7) ! BLACK ON WHITE 89 3 SHOW(25,1,CENTER('REBUILDING KEY FILES FOR LISTINGS',80)) !INDICATE MSG 90 3 BUILD(LISTINGS) ! CALL THE BUILD PROCEDURE 91 3 SETHUE(7,0) ! WHITE ON BLACK 92 3 BLANK(25,1,1,80) ! BLANK THE MESSAGE 93 3 OF 2 !IF NOT FOUND, 94 3 CREATE(LISTINGS) ! CREATE 95 3 ELSE ! ANY OTHER ERROR 96 3 LOOP;STOP('LISTINGS: ' & ERROR()). ! STOP EXECUTION 97 3 . . 98 99 1 SHOW(25,1,CENTER('OPENING FILE: ' & 'INDEX',80)) !DISPLAY FILE NAME 100 1 OPEN(INDEX) !OPEN THE FILE 101 1 IF ERROR() !OPEN RETURNED AN ERROR 102 2 CASE ERRORCODE() ! CHECK FOR SPECIFIC ERROR 103 3 OF 37 ! MISSING KEY FILE 104 3 OROF 46 ! KEYS NEED TO BE REQUILT 105 3 SETHUE(0,7) ! BLACK ON WHITE 106 3 SHOW(25,1,CENTER('REBUILDING KEY FILES FOR INDEX',80)) !INDICATE MSG 107 3 BUILD(INDEX) ! CALL THE BUILD PROCEDURE 108 3 SETHUE(7,0) ! WHITE ON BLACK 109 3 BLANK(25,1,1,80) ! BLANK THE MESSAGE 110 3 OF 2 !IF NOT FOUND, 111 3 CREATE(INDEX) ! CREATE 112 3 ELSE ! ANY OTHER ERROR 113 3 LOOP;STOP('INDEX: ' & ERROR()). ! STOP EXECUTION 114 3 . . 115 116 1 BLANK !BLANK THE SCREEN 117 118 DOD.CLA CLARION COMPILER v2.0 DIRECTORY ON DISK, WINTER 93 6/27/93 7:50 PM PAGE 5 120 1 MAIN PROCEDURE 121 122 1 SCREEN SCREEN PRE(SCR),WINDOW(17,50),HUE(15,4) 123 2 ROW(7,3) PAINT(1,14),HUE(15,1) 124 2 ROW(7,38) PAINT(1,1),HUE(15,1) 125 2 ROW(13,1) PAINT(5,50),HUE(15,2) 126 2 ROW(15,2) PAINT(2,48),HUE(10,5) 127 2 ROW(2,49) PAINT(3,1),HUE(10,3) 128 2 ROW(11,49) PAINT(2,1),HUE(30,0) 129 2 ROW(11,2) PAINT(2,47),HUE(14,0) 130 2 ROW(2,2) PAINT(3,47),HUE(0,3) 131 2 ROW(1,1) STRING('┌─{48}┐'),REV 132 2 ROW(2,1) REPEAT(4),EVERY(2);STRING('│<0{48}>│'),REV . 133 2 ROW(3,1) REPEAT(3),EVERY(4);STRING('│<0{48}>│'),REV . 134 2 ROW(5,1) REPEAT(2),EVERY(5);STRING('│─{48}┤'),REV . 135 2 ROW(9,1) REPEAT(2),EVERY(3);STRING('│<0{48}>│'),REV . 136 2 ROW(13,1) REPEAT(4);STRING('│<0{48}>│'),REV . 137 2 ROW(17,1) STRING('└─{48}┘'),REV 138 2 ROW(2,12) STRING('DIRECTORY ON DISK, SUMMER 93') 139 2 ROW(3,11) STRING('(c) Copyright 1993, INFOSERVE') 140 2 ROW(4,15) STRING('All rights reserved') 141 2 ROW(9,14) STRING('Use arrow keys to select') 142 2 ROW(11,13) STRING('You may copy and pass on to') 143 2 ROW(12,15) STRING('Friends and associates') 144 2 ROW(13,7) STRING('To get listed, see file "getlistd.dod"') 145 2 ROW(14,8) STRING('To subscribe, see file "subcribe.dod"') 146 2 ROW(15,2) STRING('INFOSERVE, (904)-724-6707, Compuserve 76440' | 147 2 & ',1477') 148 2 ROW(16,11) STRING('Prodigy wbmx59a, AOL dodbargain') 149 2 ENTRY,USE(?FIRST_FIELD) 150 2 MENU,USE(MENU_FIELD"),REQ 151 3 ROW(7,3) STRING('VIEW COMPANIES'),ENH,SEL(0,2) 152 3 COL(38) STRING('EXIT TO DOS'),ENH,SEL(0,2) 153 3 . . 154 DOD.CLA CLARION COMPILER v2.0 DIRECTORY ON DISK, WINTER 93 6/27/93 7:50 PM PAGE 6 156 1 CODE 157 1 OPEN(SCREEN) !OPEN THE MENU SCREEN 158 1 SETCURSOR !TURN OFF ANY CURSOR 159 1 LOOP !LOOP UNTIL USER EXITS 160 2 ALERT !TURN OFF ALL ALERTED KEYS 161 2 ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY 162 2 ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY 163 2 ACCEPT !READ A FIELD OR MENU CHOICE 164 2 IF KEYCODE() = REJECT_KEY THEN RETURN. !RETURN ON SCREEN REJECT 165 166 2 EDIT_RANGE# = FIELD() !SET ONE FIELD EDIT RANGE 167 2 IF KEYCODE() = ACCEPT_KEY !ON SCREEN ACCEPT KEY 168 3 UPDATE ! MOVE ALL FIELDS FROM SCREEN 169 3 EDIT_RANGE# = ?MENU_FIELD" - 1 ! AND EDIT REMAINING FIELDS 170 3 SELECT(?MENU_FIELD") ! IF OK THEN START HERE NEXT 171 3 . ! 172 173 2 LOOP FIELD# = FIELD() TO EDIT_RANGE# !EDIT FIELDS IN THE EDIT RANGE 174 175 3 CASE FIELD# !JUMP TO FIELD EDIT ROUTINE 176 4 OF ?FIRST_FIELD !FROM THE FIRST FIELD 177 4 IF KEYCODE() = ESC_KEY THEN RETURN. ! RETURN ON ESC KEY 178 179 4 OF ?MENU_FIELD" !FROM THE MENU FIELD 180 4 EXECUTE CHOICE() ! CALL THE SELECTED PROCEDURE 181 5 LISTED_COMP ! 182 5 RETURN 183 5 . . . . DOD.CLA CLARION COMPILER v2.0 DIRECTORY ON DISK, WINTER 93 6/27/93 7:50 PM PAGE 7 185 1 LISTED_COMP PROCEDURE 186 187 1 SCREEN SCREEN PRE(SCR),WINDOW(20,68),HUE(7,0) 188 2 ROW(16,2) PAINT(2,66),HUE(14,5) 189 2 ROW(2,2) PAINT(1,66),HUE(15,4) 190 2 ROW(3,2) PAINT(3,66),HUE(14,1) 191 2 ROW(6,2) PAINT(2,66),HUE(14,6) 192 2 ROW(18,2) PAINT(2,66),HUE(15,3) 193 2 ROW(1,1) STRING('╔═{66}╗'),REV 194 2 ROW(2,1) REPEAT(6);STRING('║<0{66}>║'),REV . 195 2 ROW(8,1) STRING('║<7{67}>'),REV 196 2 ROW(9,1) REPEAT(6);STRING('║<0{66}>║'),REV . 197 2 ROW(15,1) STRING('<7{68}>'),REV 198 2 ROW(16,1) REPEAT(4);STRING('║<0{66}>║'),REV . 199 2 ROW(20,1) STRING('╚═{66}╝'),REV 200 2 ROW(2,11) STRING('WELCOME TO THE DIRECTORY ON DISK, SUMMER 93' | 201 2 & ' ISSUE') 202 2 ROW(3,5) STRING('All listed companies offer a rebate/discount'| 203 2 & ' or a Free sample') 204 2 ROW(4,26) STRING('of their products.') 205 2 ROW(5,6) STRING('Save hundreds of dollars by shopping through'| 206 2 & ' the directory') 207 2 ROW(6,2) STRING('For updates and changes on the offers ' | 208 2 & 'listed, call The Bargain bbs') 209 2 ROW(7,17) STRING('904-724-3108, wildcat ANSI, 2400.9600') 210 2 ROW(16,10) STRING('If you sell a product or service, get listed'| 211 2 & ' NOW!') 212 2 ROW(17,13) STRING('Limited disk space per issue, don''t miss ' | 213 2 & 'out.') 214 2 ROW(18,5) STRING('For more FREEBIES! Subscribe to The D.O.D. &'| 215 2 & ' The Bargain BBS') 216 2 ROW(19,23) STRING('Windows version available') 217 2 ENTRY,USE(?FIRST_FIELD) 218 2 MENU,USE(MENU_FIELD"),REQ 219 3 ROW(10,3) STRING('View companies by name'),ENH,SEL(0,2) 220 3 COL(40) STRING('View companies by product'),ENH,SEL(0,2) 221 3 ROW(12,3) STRING('View companies by location'),ENH,SEL(0,2) 222 3 COL(40) STRING('View categories'),ENH,SEL(0,2) 223 3 COL(59) STRING('Exit'),ENH,SEL(0,2) 224 3 . . 225 DOD.CLA CLARION COMPILER v2.0 DIRECTORY ON DISK, WINTER 93 6/27/93 7:50 PM PAGE 8 227 1 CODE 228 1 OPEN(SCREEN) !OPEN THE MENU SCREEN 229 1 SETCURSOR !TURN OFF ANY CURSOR 230 1 LOOP !LOOP UNTIL USER EXITS 231 2 ALERT !TURN OFF ALL ALERTED KEYS 232 2 ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY 233 2 ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY 234 2 ACCEPT !READ A FIELD OR MENU CHOICE 235 2 IF KEYCODE() = REJECT_KEY THEN RETURN. !RETURN ON SCREEN REJECT 236 237 2 EDIT_RANGE# = FIELD() !SET ONE FIELD EDIT RANGE 238 2 IF KEYCODE() = ACCEPT_KEY !ON SCREEN ACCEPT KEY 239 3 UPDATE ! MOVE ALL FIELDS FROM SCREEN 240 3 EDIT_RANGE# = ?MENU_FIELD" - 1 ! AND EDIT REMAINING FIELDS 241 3 SELECT(?MENU_FIELD") ! IF OK THEN START HERE NEXT 242 3 . ! 243 244 2 LOOP FIELD# = FIELD() TO EDIT_RANGE# !EDIT FIELDS IN THE EDIT RANGE 245 246 3 CASE FIELD# !JUMP TO FIELD EDIT ROUTINE 247 4 OF ?FIRST_FIELD !FROM THE FIRST FIELD 248 4 IF KEYCODE() = ESC_KEY THEN RETURN. ! RETURN ON ESC KEY 249 250 4 OF ?MENU_FIELD" !FROM THE MENU FIELD 251 4 EXECUTE CHOICE() ! CALL THE SELECTED PROCEDURE 252 5 VIEW_COMP ! LISTINGS BY COMPANY NAME 253 5 VIEW_PROD ! VIEW COMPANIES BY PRODUCT 254 5 VIEW_STATE ! VIEW COMPANIES BY LOCATION 255 5 VIEW_CATEGO ! PRODUCT AND SERVICE CATEGORIES 256 5 RETURN 257 5 . . . . DOD.CLA CLARION COMPILER v2.0 LISTINGS BY COMPANY NAME 6/27/93 7:50 PM PAGE 9 259 1 VIEW_COMP PROCEDURE 260 261 1 SCREEN SCREEN PRE(SCR),WINDOW(22,77),HUE(15,4) 262 2 ROW(19,1) PAINT(4,77),HUE(10,1) 263 2 ROW(1,1) STRING('┌─{75}┐'),ENH 264 2 ROW(2,1) REPEAT(2),EVERY(2);STRING('│<0{75}>│'),ENH . 265 2 ROW(3,1) REPEAT(2),EVERY(2);STRING('├─{75}┤'),ENH . 266 2 ROW(6,1) REPEAT(13);STRING('│<0{75}>│'),ENH . 267 2 ROW(19,1) STRING('├─{75}┤'),ENH 268 2 ROW(20,1) REPEAT(2);STRING('│<0{75}>│'),ENH . 269 2 ROW(22,1) STRING('└─{75}┘'),ENH 270 2 ROW(2,27) STRING('LISTINGS BY COMPANY NAME') 271 2 ROW(4,2) STRING('Company name {20}Contact person {21}State') 272 2 ROW(20,22) STRING('(Use arrow keys to point and select)') 273 2 ROW(21,11) STRING('Press(Enter) to view company info. (Esc) for'| 274 2 & ' previous menu') 275 2 ENTRY,USE(?FIRST_FIELD) 276 2 REPEAT(13),EVERY(1),INDEX(NDX) 277 3 ROW(6,2) POINT(1,72),USE(?POINT),ESC(?-1) 278 3 COMPANY_NAME COL(2) STRING(30) 279 3 CONTACT_NAME COL(34) STRING(35) 280 3 STATE COL(72) STRING(2) 281 3 . . 282 283 1 NDX BYTE !REPEAT INDEX FOR POINT FIELD 284 1 ROW BYTE !ACTUAL ROW OF SCROLL AREA 285 1 COL BYTE !ACTUAL COLUMN OF SCROLL AREA 286 1 MAX LONG !LESSER OF COUNT AND RECORDS 287 1 COUNT BYTE(13) !NUMBER OF ITEMS TO SCROLL 288 1 ROWS BYTE(13) !NUMBER OF ROWS TO SCROLL 289 1 COLS BYTE(72) !NUMBER OF COLUMNS TO SCROLL 290 291 DOD.CLA CLARION COMPILER v2.0 LISTINGS BY COMPANY NAME 6/27/93 7:50 PM PAGE 10 293 1 CODE 294 1 ACTION# = ACTION !SAVE ACTION 295 1 OPEN(SCREEN) !OPEN THE SCREEN 296 1 SETCURSOR !TURN OFF ANY CURSOR 297 1 NDX = 1 !PUT SELECTOR BAR ON TOP ITEM 298 1 ROW = ROW(?POINT) !REMEMBER TOP ROW AND 299 1 COL = COL(?POINT) ! LEFT COLUMN OF SCROLL AREA 300 1 IF ACTION = 4 !IF THIS IS A LOOKUP REQUEST 301 2 SET(LIS:COMP_KEY,LIS:COMP_KEY) ! FIND IT IN THE FILE 302 2 NEXT(LISTINGS) ! AND READ IT 303 2 POINTER# = POINTER(LISTINGS) ! SAVE POINTER TO CURRENT 304 2 SKIP(LISTINGS,-1) ! MAKE IT THE TOP RECORD 305 2 DO SHOW_TABLE ! FILL SCROLL AREA 306 2 GET(LISTINGS,POINTER#) ! AND REFRESH CURRENT RECORD 307 2 ELSE !OTHERWISE 308 2 SET(LIS:COMP_KEY) ! SET TO FIRST RECORD IN FILE 309 2 DO SHOW_TABLE ! FILL SCROLL AREA 310 2 . 311 1 RECORDS# = TRUE !INITIALIZE RECORDS FLAG 312 1 LOOP !LOOP UNTIL USER EXITS 313 2 MAX = RECORDS(LIS:COMP_KEY) !SET LESSER OF FILE RECORD 314 2 IF MAX > COUNT THEN MAX = COUNT. ! COUNT AND SCROLL ITEM COUNT 315 2 ACTION = ACTION# !RESTORE ACTION 316 2 POINTER# = 0 !CLEAR ADD POINTER 317 2 IF ~RECORDS(LIS:COMP_KEY) !IF THERE ARE NO RECORDS 318 3 CLEAR(LIS:RECORD) ! CLEAR RECORD AREA 319 3 ACTION = 1 ! SET ACTION TO ADD 320 3 UPDATE_LIST ! CALL FORM FOR FIRST RECORD 321 3 IF ~RECORDS(LIS:COMP_KEY) THEN BREAK. ! IF ADD ABORTED THEN EXIT 322 3 DO SHOW_RECORD 323 3 SET(LIS:COMP_KEY) ! SET TO NEW RECORD 324 3 DO SHOW_TABLE ! FILL SCROLL AREA 325 3 NDX = 1 ! PUT SELECTOR BAR ON TOP ITEM 326 3 MAX = 1 ! MAXIMUM DISPLAYED IS 1 327 3 . ! 328 2 ALERT !RESET ALERTED KEYS 329 2 ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY 330 2 ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY 331 2 ACCEPT !READ A FIELD 332 2 IF KEYCODE() = REJECT_KEY THEN BREAK. !RETURN ON SCREEN REJECT KEY 333 334 2 EDIT_RANGE# = FIELD() !SET ONE FIELD EDIT RANGE 335 2 IF KEYCODE() = ACCEPT_KEY AND | !ON SCREEN ACCEPT KEY 336 2 EDIT_RANGE# <> ?POINT ! AND NOT ON THE POINT FIELD 337 3 UPDATE ! MOVE ALL FIELDS FROM SCREEN 338 3 EDIT_RANGE# = ?POINT - 1 ! AND EDIT REMAINING FIELDS 339 3 SELECT(?POINT) ! IF OK THEN START HERE NEXT 340 3 . ! 341 342 2 LOOP FIELD# = FIELD() TO EDIT_RANGE# !EDIT FIELDS IN THE EDIT RANGE 343 344 3 CASE FIELD# !JUMP TO FIELD EDIT ROUTINE 345 4 OF ?FIRST_FIELD !FROM THE FIRST FIELD 346 4 IF KEYCODE() = ESC_KEY OR | ! RETURN ON ESC KEY DOD.CLA CLARION COMPILER v2.0 LISTINGS BY COMPANY NAME 6/27/93 7:50 PM PAGE 11 347 4 RECORDS# = FALSE ! OR NO RECORDS 348 5 RETURN 349 5 . 350 4 RECORDS# = TRUE ! ASSUME RECORDS ARE HERE 351 4 OF ?POINT !FROM THE POINT FIELD 352 4 CASE KEYCODE() ! PROCESS THE KEYSTROKE 353 5 OF INS_KEY !INSERT KEY 354 5 CLEAR(LIS:RECORD) ! CLEAR RECORD AREA 355 5 ACTION = 1 ! SET ACTION TO ADD 356 5 UPDATE_LIST ! CALL FORM FOR NEW RECORD 357 5 IF ~ACTION ! IF A NEW RECORD WAS ADDED 358 6 POINTER# = POINTER(LISTINGS) ! REMEMBER WHICH RECORD 359 6 SET(LIS:COMP_KEY,LIS:COMP_KEY) ! SET TO NEW RECORD AND 360 6 SKIP(LISTINGS,-1) ! MAKE IT THE TOP ITEM 361 6 DO SHOW_TABLE ! DISPLAY THAT PAGE 362 6 . 363 5 OF ENTER_KEY !ENTER KEY OR 364 5 OROF ACCEPT_KEY !CTRL ENTER KEY 365 5 DO GET_RECORD ! READ THE SELECTED RECORD 366 5 IF ACTION = 4 AND KEYCODE() = ENTER_KEY! IF THIS IS A LOOKUP REQUEST 367 6 ACTION = 0 ! SET ACTION TO COMPLETE 368 6 RETURN ! AND RETURN TO CALLER 369 6 . ! 370 5 ACTION = 2 ! SET ACTION TO CHANGE 371 5 UPDATE_LIST ! CALL FORM TO CHANGE RECORD 372 5 IF ~ACTION ! IF THE RECORD WAS CHANGED 373 6 POINTER# = POINTER(LISTINGS) ! REMEMBER WHICH RECORD 374 6 SET(LIS:COMP_KEY,LIS:COMP_KEY) ! SET TO CHANGED RECORD 375 6 SKIP(LISTINGS,-1) ! MAKE IT THE TOP ITEM 376 6 DO SHOW_TABLE ! AND DISPLAY THAT PAGE 377 6 ELSE ! OTHERWISE 378 6 SKIP(LISTINGS,(MAX-NDX)) ! SKIP BACK TO SAME PAGE 379 6 . 380 5 OF DEL_KEY !DELETE KEY 381 5 DO GET_RECORD ! READ THE SELECTED RECORD 382 5 ACTION = 3 ! SET ACTION TO DELETE 383 5 UPDATE_LIST ! CALL FORM TO DELETE RECORD 384 5 IF ~ACTION ! IF RECORD WAS DELETED 385 6 SKIP(LISTINGS,-NDX) ! SET NEXT RECORD ON TOP 386 6 DO SHOW_TABLE ! AND DISPLAY THAT PAGE 387 6 ELSE ! OTHERWISE 388 6 SKIP(LISTINGS,(MAX-NDX)) ! SKIP BACK TO SAME PAGE 389 6 . 390 5 OF DOWN_KEY !DOWN ARROW KEY 391 5 IF NOT EOF(LISTINGS) ! IF THERE ARE MORE RECORDS 392 6 SCROLL(ROW,COL,ROWS,COLS,ROWS(?POINT)) ! SCROLL THE SCREEN UP 393 6 NEXT(LISTINGS) ! READ THE BOTTOM RECORD 394 6 DO SHOW_RECORD ! AND DISPLAY IT 395 6 . 396 5 OF PGDN_KEY !PAGE DOWN KEY 397 5 IF EOF(LISTINGS) ! ON THE LAST PAGE 398 6 NDX = MAX ! POINT TO BOTTOM ITEM 399 6 ELSE ! OTHERWISE 400 6 DO SHOW_TABLE ! DISPLAY NEXT PAGE DOD.CLA CLARION COMPILER v2.0 LISTINGS BY COMPANY NAME 6/27/93 7:50 PM PAGE 12 401 6 . 402 5 OF CTRL_PGDN !CTRL-PAGE DOWN KEY 403 5 NDX = MAX ! POINT TO BOTTOM ITEM 404 5 IF NOT EOF(LISTINGS) ! ON THE LAST PAGE 405 6 SET(LIS:COMP_KEY) ! SET TO BOTTOM RECORD MINUS 406 6 SKIP(LISTINGS,-COUNT) ! ONE PAGE OF RECORDS 407 6 DO SHOW_TABLE ! DISPLAY THE LAST PAGE 408 6 . 409 5 OF UP_KEY !UP ARROW KEY 410 5 SKIP(LISTINGS,-(COUNT-1)) ! SET TO TOP RECORD MINUS 1 411 5 IF NOT BOF(LISTINGS) ! IF THERE IS A PRIOR RECORD 412 6 PREVIOUS(LISTINGS) ! READ THE TOP RECORD 413 6 IF NOT ERROR() ! IF READ A RECORD 414 7 SCROLL(ROW,COL,ROWS,COLS,-(ROWS(?POINT)))! SCROLL THE SCREEN DOWN 415 7 DO SHOW_RECORD ! AND DISPLAY IT 416 7 ELSIF ERRORCODE() = 33 ! ELSIF RECORD NOT AVAILABLE 417 7 NEXT(LISTINGS) ! RETRIEVE FIRST ONE 418 7 . . 419 5 SKIP(LISTINGS,COUNT-1) ! SET RECORD FOR NEXT PAGE 420 421 5 OF PGUP_KEY !PAGE UP KEY 422 5 SKIP(LISTINGS,-(COUNT-1)) ! SET TO TOP RECORD MINUS ONE 423 5 IF BOF(LISTINGS) ! IF THERE IS NO PRIOR RECORD 424 6 NDX = 1 ! THEN POINT TO TOP ITEM 425 6 SKIP(LISTINGS,COUNT-1) ! SET RECORD FOR THIS PAGE 426 6 ELSE ! OTHERWISE 427 6 SKIP(LISTINGS,-(COUNT+1)) ! SET RECORD FOR PRIOR PAGE 428 6 DO SHOW_TABLE ! AND DISPLAY THE PAGE 429 6 . 430 5 OF CTRL_PGUP !CTRL-PAGE UP KEY 431 5 SET(LIS:COMP_KEY) ! SET TO FIRST RECORD 432 5 NDX = 1 ! POINT TO TOP ITEM 433 5 DO SHOW_TABLE ! AND DISPLAY THE PAGE 434 5 . 435 4 . . . 436 1 RETURN !RETURN TO CALLER 437 438 1 SHOW_TABLE ROUTINE !DISPLAY A PAGE OF RECORDS 439 1 SKIP(LISTINGS,COUNT-1) ! SET TO THE BOTTOM RECORD 440 1 IF EOF(LISTINGS) ! FOR A PARTIAL PAGE 441 2 SET(LIS:COMP_KEY) ! SET TO THE LAST RECORD 442 2 SKIP(LISTINGS,-COUNT) ! AND BACK UP ONE PAGE 443 2 ELSE ! OTHERWISE 444 2 SKIP(LISTINGS,-(COUNT-1)) ! SET RECORD FOR THIS PAGE 445 2 . 446 1 NDX# = NDX ! SAVE REPEAT INDEX 447 1 LOOP NDX = 1 TO COUNT ! LOOP THRU THE SCROLL AREA 448 2 IF EOF(LISTINGS) THEN BREAK. ! BREAK ON END OF FILE 449 2 NEXT(LISTINGS) ! READ THE NEXT RECORD 450 2 DO SHOW_RECORD ! AND DISPLAY IT 451 2 IF POINTER(LISTINGS) = POINTER# 452 3 NDX# = NDX ! POINT TO CORRECT RECORD 453 3 . . 454 1 NDX = NDX# ! RESTORE REPEAT INDEX DOD.CLA CLARION COMPILER v2.0 LISTINGS BY COMPANY NAME 6/27/93 7:50 PM PAGE 13 455 1 CLEAR(LIS:RECORD) ! CLEAR RECORD AREA 456 1 IF RECORDS(LIS:COMP_KEY) < COUNT ! IF RECORDS DO NOT FILL 457 2 NDX#= RECORDS(LIS:COMP_KEY) * 1 ! GET NUMBER TIMES SIZE 458 2 BLANK(ROW + NDX#,COL,ROWS-NDX#,COLS) ! BLANK REMAINING AREA 459 2 . 460 461 1 SHOW_RECORD ROUTINE !DISPLAY A RECORD 462 1 SCR:COMPANY_NAME = LIS:COMPANY_NAME 463 1 SCR:CONTACT_NAME = LIS:CONTACT_NAME 464 1 SCR:STATE = LIS:STATE 465 466 1 GET_RECORD ROUTINE !READ SELECTED RECORD 467 1 SKIP(LISTINGS,-(MAX-NDX+1)) ! SET TO SELECTED RECORD 468 1 NEXT(LISTINGS) ! AND READ IT 469 470 1 FIND_RECORD ROUTINE !LOCATE REQUESTED RECORD 471 1 SET(LIS:COMP_KEY,LIS:COMP_KEY) ! SET TO REQUESTED RECORD 472 1 IF EOF(LISTINGS) ! IF BEYOND END OF FILE 473 2 PREVIOUS(LISTINGS) ! GET THE LAST RECORD 474 2 ELSE ! ELSE 475 2 NEXT(LISTINGS) ! READ THIS RECORD 476 2 . 477 1 POINTER# = POINTER(LISTINGS) ! SAVE ITS RECORD POINTER 478 1 SKIP(LISTINGS,-1) ! MAKE IT THE TOP RECORD 479 1 DO SHOW_TABLE ! AND FILL THE SCROLL AREA 480 481 1 SAME_PAGE ROUTINE !SET TO SAME PAGE ROUTINE 482 1 POINTER# = POINTER(LISTINGS) ! SAVE ITS RECORD POINTER 483 1 GET(LISTINGS,POINTER#) ! GET THE RECORD 484 1 SET(LIS:COMP_KEY,LIS:COMP_KEY) ! SET TO THE SAME RECORD 485 1 SKIP(LISTINGS,-1) ! SKIP TO TOP OF SAME PAGE 486 DOD.CLA CLARION COMPILER v2.0 Company information 6/27/93 7:50 PM PAGE 14 488 1 UPDATE_LIST PROCEDURE 489 490 1 SCREEN SCREEN PRE(SCR),WINDOW(24,69),HUE(15,4) 491 2 ROW(22,1) PAINT(3,69),HUE(10,1) 492 2 ROW(1,1) STRING('┌─{67}┐'),ENH 493 2 ROW(2,1) REPEAT(20);STRING('│<0{67}>│'),ENH . 494 2 ROW(22,1) REPEAT(2);STRING('│<0{67}>│'),ENH . 495 2 ROW(24,1) STRING('└─{67}┘'),ENH 496 2 ROW(2,28) STRING('Company information') 497 2 ROW(4,4) STRING('COMPANY NAME:') 498 2 ROW(5,4) STRING('CONTACT NAME:') 499 2 ROW(6,4) STRING('PRODUCT {5}:') 500 2 ROW(7,4) STRING('ADDRESS 1 :') 501 2 ROW(8,4) STRING('ADDRESS 2 :') 502 2 ROW(9,4) STRING('CITY {8}:') 503 2 ROW(10,4) STRING('STATE {7}:') 504 2 ROW(11,4) STRING('ZIP {9}:') 505 2 ROW(12,4) STRING('PHONE {7}:') 506 2 ROW(13,4) STRING('FAX {9}:') 507 2 ROW(14,4) STRING('E MAIL {6}:') 508 2 ROW(15,4) STRING('DESCRIPTION :') 509 2 ROW(16,4) STRING('REBATE {6}:') 510 2 ROW(17,4) STRING('EXPIRES {5}:') 511 2 ROW(18,4) STRING('COMMENTS :') 512 2 ROW(22,6) STRING('Use arrow keys to scroll comments, (Esc) for'| 513 2 & ' previous menu,') 514 2 ROW(23,9) STRING('(F2) to print this record and order form if' | 515 2 & ' available.') 516 2 MESSAGE ROW(3,21) STRING(30) 517 2 ENTRY,USE(?FIRST_FIELD) 518 2 ROW(4,17) ENTRY(@S30),USE(LIS:COMPANY_NAME),LFT,UPR,OVR,SEL(0,2) 519 2 ROW(5,17) ENTRY(@S35),USE(LIS:CONTACT_NAME),LFT,OVR,SEL(0,2) 520 2 ROW(6,17) ENTRY(@S19),USE(LIS:PRODUCT),LFT,OVR,SEL(0,2) 521 2 ROW(7,17) ENTRY(@S30),USE(LIS:ADDRESS_1),LFT,OVR,SEL(0,2) 522 2 ROW(8,17) ENTRY(@S20),USE(LIS:ADDRESS_2),LFT,OVR,SEL(0,2) 523 2 ROW(9,17) ENTRY(@S25),USE(LIS:CITY),LFT,OVR,SEL(0,2) 524 2 ROW(10,17) ENTRY(@S2),USE(LIS:STATE),LFT,UPR,OVR,SEL(0,2) 525 2 ROW(11,17) ENTRY(@S10),USE(LIS:ZIP),LFT,OVR,SEL(0,2) 526 2 ROW(12,17) ENTRY(@P###-###-####P),USE(LIS:PHONE),OVR,SEL(0,2) 527 2 ROW(13,17) ENTRY(@P###-###-####P),USE(LIS:FAX),OVR,SEL(0,2) 528 2 ROW(14,17) ENTRY(@S30),USE(LIS:E_MAIL),LFT,OVR,SEL(0,2) 529 2 ROW(15,17) ENTRY(@S50),USE(LIS:DESCRIPTION),LFT,OVR,SEL(0,2) 530 2 ROW(16,17) ENTRY(@S50),USE(LIS:REBATE),LFT,OVR,SEL(0,2) 531 2 ROW(17,17) ENTRY(@D1),USE(LIS:EXPIRES),OVR 532 2 ROW(18,17) TEXT(4,50),USE(LIS:COMMENTS),LFT,INS,ENH,SEL(15,5) 533 2 ENTRY,USE(?LAST_FIELD) 534 2 PAUSE(''),USE(?DELETE_FIELD) 535 2 . 536 DOD.CLA CLARION COMPILER v2.0 Company information 6/27/93 7:50 PM PAGE 15 538 1 CODE 539 1 OPEN(SCREEN) !OPEN THE SCREEN 540 1 SETCURSOR !TURN OFF ANY CURSOR 541 1 ACTION# = ACTION !SAVE ACTION VALUE 542 1 ACTION = ACTION# !RESET ACTION 543 1 DISPLAY !DISPLAY THE FIELDS 544 1 EXECUTE ACTION !SET THE CURRENT RECORD POINTER 545 2 POINTER# = 0 ! NO RECORD FOR ADD 546 2 POINTER# = POINTER(LISTINGS) ! CURRENT RECORD FOR CHANGE 547 2 POINTER# = POINTER(LISTINGS) ! CURRENT RECORD FOR CHANGE 548 2 . 549 1 LOOP !LOOP THRU ALL THE FIELDS 550 2 MEM:MESSAGE = CENTER(MEM:MESSAGE,SIZE(MEM:MESSAGE)) !DISPLAY ACTION MESSAGE 551 2 SCR:MESSAGE = MEM:MESSAGE 552 2 ALERT !RESET ALERTED KEYS 553 2 ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY 554 2 ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY 555 2 ALERT(F2_KEY) !ALERT HOT KEY 556 2 ACCEPT !READ A FIELD 557 2 IF KEYCODE() = F2_KEY !ON HOT KEY 558 3 SAVACTN# = ACTION ! SAVE ACTION 559 3 PRINT_RECORD ! CALL HOT KEY PROCEDURE 560 3 ACTION = SAVACTN# ! RESTORE ACTION 561 3 SELECT(?) ! DO SAME FIELD AGAIN 562 3 CYCLE ! AND LOOP AGAIN 563 3 . 564 2 IF KEYCODE() = REJECT_KEY THEN RETURN. !RETURN ON SCREEN REJECT KEY 565 2 EXECUTE ACTION !SET ACTION MESSAGE 566 3 MEM:MESSAGE = 'Record will be Added' ! 567 3 MEM:MESSAGE = 'Record will be Changed' ! 568 3 MEM:MESSAGE = 'Press Enter to Delete' ! 569 3 . 570 2 EDIT_RANGE# = FIELD() !SET ONE FIELD EDIT RANGE 571 2 IF KEYCODE() = ACCEPT_KEY !ON SCREEN ACCEPT KEY 572 3 UPDATE ! MOVE ALL FIELDS FROM SCREEN 573 3 EDIT_RANGE# = FIELDS() ! AND EDIT REMAINING FIELDS 574 3 . ! 575 2 LOOP FIELD# = FIELD() TO EDIT_RANGE# !EDIT FIELDS IN THE EDIT RANGE 576 3 CASE FIELD# !JUMP TO FIELD EDIT ROUTINE 577 4 OF ?FIRST_FIELD !FROM THE FIRST FIELD 578 4 IF KEYCODE() = ESC_KEY THEN RETURN. ! RETURN ON ESC KEY 579 4 IF ACTION = 3 THEN SELECT(?DELETE_FIELD).! OR CONFIRM FOR DELETE 580 581 4 OF ?LIS:COMPANY_NAME !company name 582 4 IF LIS:COMPANY_NAME = '' !IF REQUIRED FIELD IS EMPTY 583 5 BEEP ! SOUND KEYBOARD ALARM 584 5 SELECT(?LIS:COMPANY_NAME) ! AND STAY ON THIS FIELD 585 5 BREAK ! 586 5 . 587 588 4 OF ?LIS:CONTACT_NAME !contact person 589 4 IF LIS:CONTACT_NAME = '' !IF REQUIRED FIELD IS EMPTY 590 5 BEEP ! SOUND KEYBOARD ALARM 591 5 SELECT(?LIS:CONTACT_NAME) ! AND STAY ON THIS FIELD DOD.CLA CLARION COMPILER v2.0 Company information 6/27/93 7:50 PM PAGE 16 592 5 BREAK ! 593 5 . 594 595 4 OF ?LIS:PRODUCT !product 596 4 IF LIS:PRODUCT = '' !IF REQUIRED FIELD IS EMPTY 597 5 BEEP ! SOUND KEYBOARD ALARM 598 5 SELECT(?LIS:PRODUCT) ! AND STAY ON THIS FIELD 599 5 BREAK ! 600 5 . 601 602 4 OF ?LIS:ADDRESS_1 !address 603 4 IF LIS:ADDRESS_1 = '' !IF REQUIRED FIELD IS EMPTY 604 5 BEEP ! SOUND KEYBOARD ALARM 605 5 SELECT(?LIS:ADDRESS_1) ! AND STAY ON THIS FIELD 606 5 BREAK ! 607 5 . 608 609 4 OF ?LIS:ADDRESS_2 !box or suite # 610 611 4 OF ?LIS:CITY !city 612 4 IF LIS:CITY = '' !IF REQUIRED FIELD IS EMPTY 613 5 BEEP ! SOUND KEYBOARD ALARM 614 5 SELECT(?LIS:CITY) ! AND STAY ON THIS FIELD 615 5 BREAK ! 616 5 . 617 618 4 OF ?LIS:STATE !state 619 4 IF LIS:STATE = '' !IF REQUIRED FIELD IS EMPTY 620 5 BEEP ! SOUND KEYBOARD ALARM 621 5 SELECT(?LIS:STATE) ! AND STAY ON THIS FIELD 622 5 BREAK ! 623 5 . 624 625 4 OF ?LIS:ZIP 626 4 IF LIS:ZIP = '' !IF REQUIRED FIELD IS EMPTY 627 5 BEEP ! SOUND KEYBOARD ALARM 628 5 SELECT(?LIS:ZIP) ! AND STAY ON THIS FIELD 629 5 BREAK ! 630 5 . 631 632 4 OF ?LIS:PHONE !phone 633 634 4 OF ?LIS:FAX !fax 635 636 4 OF ?LIS:E_MAIL !e-mail 637 638 4 OF ?LIS:DESCRIPTION !product/service description 639 4 IF LIS:DESCRIPTION = '' !IF REQUIRED FIELD IS EMPTY 640 5 BEEP ! SOUND KEYBOARD ALARM 641 5 SELECT(?LIS:DESCRIPTION) ! AND STAY ON THIS FIELD 642 5 BREAK ! 643 5 . 644 645 4 OF ?LIS:REBATE !rebate/discount or free item DOD.CLA CLARION COMPILER v2.0 Company information 6/27/93 7:50 PM PAGE 17 646 4 IF LIS:REBATE = '' !IF REQUIRED FIELD IS EMPTY 647 5 BEEP ! SOUND KEYBOARD ALARM 648 5 SELECT(?LIS:REBATE) ! AND STAY ON THIS FIELD 649 5 BREAK ! 650 5 . 651 652 4 OF ?LIS:EXPIRES !expiration date 653 654 4 OF ?LIS:COMMENTS !comments 655 656 4 OF ?LAST_FIELD !FROM THE LAST FIELD 657 4 EXECUTE ACTION ! UPDATE THE FILE 658 5 ADD(LISTINGS) ! ADD NEW RECORD 659 5 PUT(LISTINGS) ! CHANGE EXISTING RECORD 660 5 DELETE(LISTINGS) ! DELETE EXISTING RECORD 661 5 . 662 4 IF ERROR() THEN STOP(ERROR()). ! CHECK FOR UNEXPECTED ERROR 663 4 ACTION = 0 ! SET ACTION TO COMPLETE 664 4 RETURN ! AND RETURN TO CALLER 665 666 4 OF ?DELETE_FIELD !FROM THE DELETE FIELD 667 4 IF KEYCODE() = ENTER_KEY | ! ON ENTER KEY 668 4 OR KEYCODE() = ACCEPT_KEY ! OR CTRL-ENTER KEY 669 5 SELECT(?LAST_FIELD) ! DELETE THE RECORD 670 5 ELSE ! OTHERWISE 671 5 BEEP ! BEEP AND ASK AGAIN 672 5 . . . . 673 DOD.CLA CLARION COMPILER v2.0 Directory on disk listing 6/27/93 7:50 PM PAGE 18 675 676 1 PRINT_RECORD PROCEDURE 677 678 1 TITLE REPORT LENGTH(59),WIDTH(80),PRE(TTL) 679 2 RPT_HEAD DETAIL 680 3 . . 681 1 REPORT REPORT LENGTH(59),WIDTH(80),PAGE(MEM:PAGE),LINE(MEM:LINE) | 682 1 PRE(RPT) 683 2 PAGE_HEAD HEADER 684 3 COL(1) STRING('Directory on disk listing') CTL(@LF2) 685 3 . 686 2 DETAIL DETAIL 687 3 COL(1) STRING(30),USE(LIS:COMPANY_NAME) 688 3 COL(33) STRING(35),USE(LIS:CONTACT_NAME) 689 3 ROW(+1,1) STRING(19),USE(LIS:PRODUCT) 690 3 ROW(+1,1) STRING(30),USE(LIS:ADDRESS_1) 691 3 COL(33) STRING(20),USE(LIS:ADDRESS_2) 692 3 ROW(+1,1) STRING(25),USE(LIS:CITY) 693 3 COL(33) STRING(2),USE(LIS:STATE) 694 3 COL(37) STRING(10),USE(LIS:ZIP) 695 3 ROW(+1,1) STRING(@P###-###-####P),USE(LIS:PHONE) 696 3 COL(16) STRING(@P###-###-####P),USE(LIS:FAX) 697 3 COL(33) STRING(30),USE(LIS:E_MAIL) 698 3 ROW(+1,1) STRING(50),USE(LIS:COMMENTS) CTL(@LF) 699 3 . 700 2 DETAILA DETAIL 701 3 MEMO_1 COL(1) STRING(50) CTL(@LF) 702 3 . 703 2 DETAILB DETAIL 704 3 CTL(@LF) 705 3 . 706 2 RPT_FOOT DETAIL 707 3 . 708 2 PAGE_FOOT FOOTER 709 3 . . 710 711 1 CODE 712 1 PRINT(TTL:RPT_HEAD) !PRINT TITLE PAGE 713 1 CLOSE(TITLE) !CLOSE TITLE REPORT 714 1 MEM:DEVICE = '+' & MEM:DEVICE !APPEND DISK RPT TO TITLE 715 1 OPEN(REPORT) !OPEN REPORT BODY 716 1 PRINT(RPT:DETAIL) !PRINT DETAIL LINES 717 1 LOOP MEMO_1# = 60 TO 2 BY -1 !BACKSCAN THE MEMO FIELD TO 718 2 IF LIS_MEMO_ROW[MEMO_1#] <> '' THEN BREAK. ! FIND NUMBER OF ROWS USED 719 2 . ! END OF MEMOLEN 720 1 J# = 2 !START WITH ROW 2 721 1 LOOP !LOOP THRU ALL USED ROWS 722 2 MEMODONE# = 0 ! NO MEMOS DONE YET 723 2 IF J# <= MEMO_1# !IF IN THE RANGE OF THIS MEMO 724 3 RPT:MEMO_1 = LIS_MEMO_ROW[J#] ! MOVE A MEMO FIELD ROW 725 3 MEMODONE# = 1 ! MEMO HAS BEEN MOVED 726 3 ELSE !OTHERWISE 727 3 RPT:MEMO_1 = '' ! NO MEMO TO DO 728 3 . ! END OF SETMEMO DOD.CLA CLARION COMPILER v2.0 Directory on disk listing 6/27/93 7:50 PM PAGE 19 729 2 IF MEMODONE# = 0 THEN BREAK. ! ALL MEMOS PRINTED 730 2 PRINT(RPT:DETAILA) !PRINT THE DETAIL RECORD 731 2 J# += 1 ! INCREMENT COUNTER 732 2 . 733 1 PRINT(RPT:DETAILB) !PRINT THE DETAIL RECORD 734 1 PRINT(RPT:RPT_FOOT) !PRINT REPORT FOOTER 735 1 CLOSE(REPORT) !CLOSE REPORT 736 1 MEM:DEVICE = SUB(MEM:DEVICE,2,LEN(MEM:DEVICE)-1) !TURN OFF APPEND REPORT 737 1 RETURN !RETURN TO CALLER 738 DOD.CLA CLARION COMPILER v2.0 VIEW COMPANIES BY PRODUCT 6/27/93 7:50 PM PAGE 20 740 1 VIEW_PROD PROCEDURE 741 742 1 SCREEN SCREEN PRE(SCR),WINDOW(22,76),HUE(15,4) 743 2 ROW(19,1) PAINT(4,76),HUE(10,1) 744 2 ROW(1,1) STRING('┌─{74}┐'),ENH 745 2 ROW(2,1) REPEAT(2),EVERY(2);STRING('│<0{74}>│'),ENH . 746 2 ROW(3,1) REPEAT(2),EVERY(2);STRING('├─{74}┤'),ENH . 747 2 ROW(6,1) REPEAT(13);STRING('│<0{74}>│'),ENH . 748 2 ROW(19,1) STRING('├─{74}┤'),ENH 749 2 ROW(20,1) REPEAT(2);STRING('│<0{74}>│'),ENH . 750 2 ROW(22,1) STRING('└─{74}┘'),ENH 751 2 ROW(2,27) STRING('VIEW COMPANIES BY PRODUCT') 752 2 ROW(4,2) STRING('Product {21}Contact person {25}State') 753 2 ROW(20,22) STRING('Use arrow keys to point and select') 754 2 ROW(21,6) STRING('Press (Enter) to view company information. ' | 755 2 & '(Esc) for previous menu') 756 2 ENTRY,USE(?FIRST_FIELD) 757 2 REPEAT(13),EVERY(1),INDEX(NDX) 758 3 ROW(6,2) POINT(1,69),USE(?POINT),ESC(?-1) 759 3 PRODUCT COL(2) STRING(19) 760 3 CONTACT_NAME COL(30) STRING(35) 761 3 STATE COL(69) STRING(2) 762 3 . . 763 764 1 NDX BYTE !REPEAT INDEX FOR POINT FIELD 765 1 ROW BYTE !ACTUAL ROW OF SCROLL AREA 766 1 COL BYTE !ACTUAL COLUMN OF SCROLL AREA 767 1 MAX LONG !LESSER OF COUNT AND RECORDS 768 1 COUNT BYTE(13) !NUMBER OF ITEMS TO SCROLL 769 1 ROWS BYTE(13) !NUMBER OF ROWS TO SCROLL 770 1 COLS BYTE(69) !NUMBER OF COLUMNS TO SCROLL 771 772 DOD.CLA CLARION COMPILER v2.0 VIEW COMPANIES BY PRODUCT 6/27/93 7:50 PM PAGE 21 774 1 CODE 775 1 ACTION# = ACTION !SAVE ACTION 776 1 OPEN(SCREEN) !OPEN THE SCREEN 777 1 SETCURSOR !TURN OFF ANY CURSOR 778 1 NDX = 1 !PUT SELECTOR BAR ON TOP ITEM 779 1 ROW = ROW(?POINT) !REMEMBER TOP ROW AND 780 1 COL = COL(?POINT) ! LEFT COLUMN OF SCROLL AREA 781 1 IF ACTION = 4 !IF THIS IS A LOOKUP REQUEST 782 2 SET(LIS:PRODUCT_KEY,LIS:PRODUCT_KEY) ! FIND IT IN THE FILE 783 2 NEXT(LISTINGS) ! AND READ IT 784 2 POINTER# = POINTER(LISTINGS) ! SAVE POINTER TO CURRENT 785 2 SKIP(LISTINGS,-1) ! MAKE IT THE TOP RECORD 786 2 DO SHOW_TABLE ! FILL SCROLL AREA 787 2 GET(LISTINGS,POINTER#) ! AND REFRESH CURRENT RECORD 788 2 ELSE !OTHERWISE 789 2 SET(LIS:PRODUCT_KEY) ! SET TO FIRST RECORD IN FILE 790 2 DO SHOW_TABLE ! FILL SCROLL AREA 791 2 . 792 1 RECORDS# = TRUE !INITIALIZE RECORDS FLAG 793 1 LOOP !LOOP UNTIL USER EXITS 794 2 MAX = RECORDS(LIS:PRODUCT_KEY) !SET LESSER OF FILE RECORD 795 2 IF MAX > COUNT THEN MAX = COUNT. ! COUNT AND SCROLL ITEM COUNT 796 2 ACTION = ACTION# !RESTORE ACTION 797 2 POINTER# = 0 !CLEAR ADD POINTER 798 2 IF ~RECORDS(LIS:PRODUCT_KEY) !IF THERE ARE NO RECORDS 799 3 CLEAR(LIS:RECORD) ! CLEAR RECORD AREA 800 3 ACTION = 1 ! SET ACTION TO ADD 801 3 UPDATE_LIST ! CALL FORM FOR FIRST RECORD 802 3 IF ~RECORDS(LIS:PRODUCT_KEY) THEN BREAK. ! IF ADD ABORTED THEN EXIT 803 3 DO SHOW_RECORD 804 3 SET(LIS:PRODUCT_KEY) ! SET TO NEW RECORD 805 3 DO SHOW_TABLE ! FILL SCROLL AREA 806 3 NDX = 1 ! PUT SELECTOR BAR ON TOP ITEM 807 3 MAX = 1 ! MAXIMUM DISPLAYED IS 1 808 3 . ! 809 2 ALERT !RESET ALERTED KEYS 810 2 ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY 811 2 ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY 812 2 ACCEPT !READ A FIELD 813 2 IF KEYCODE() = REJECT_KEY THEN BREAK. !RETURN ON SCREEN REJECT KEY 814 815 2 EDIT_RANGE# = FIELD() !SET ONE FIELD EDIT RANGE 816 2 IF KEYCODE() = ACCEPT_KEY AND | !ON SCREEN ACCEPT KEY 817 2 EDIT_RANGE# <> ?POINT ! AND NOT ON THE POINT FIELD 818 3 UPDATE ! MOVE ALL FIELDS FROM SCREEN 819 3 EDIT_RANGE# = ?POINT - 1 ! AND EDIT REMAINING FIELDS 820 3 SELECT(?POINT) ! IF OK THEN START HERE NEXT 821 3 . ! 822 823 2 LOOP FIELD# = FIELD() TO EDIT_RANGE# !EDIT FIELDS IN THE EDIT RANGE 824 825 3 CASE FIELD# !JUMP TO FIELD EDIT ROUTINE 826 4 OF ?FIRST_FIELD !FROM THE FIRST FIELD 827 4 IF KEYCODE() = ESC_KEY OR | ! RETURN ON ESC KEY DOD.CLA CLARION COMPILER v2.0 VIEW COMPANIES BY PRODUCT 6/27/93 7:50 PM PAGE 22 828 4 RECORDS# = FALSE ! OR NO RECORDS 829 5 RETURN 830 5 . 831 4 RECORDS# = TRUE ! ASSUME RECORDS ARE HERE 832 4 OF ?POINT !FROM THE POINT FIELD 833 4 CASE KEYCODE() ! PROCESS THE KEYSTROKE 834 5 OF INS_KEY !INSERT KEY 835 5 CLEAR(LIS:RECORD) ! CLEAR RECORD AREA 836 5 ACTION = 1 ! SET ACTION TO ADD 837 5 UPDATE_LIST ! CALL FORM FOR NEW RECORD 838 5 IF ~ACTION ! IF A NEW RECORD WAS ADDED 839 6 POINTER# = POINTER(LISTINGS) ! REMEMBER WHICH RECORD 840 6 SET(LIS:PRODUCT_KEY,LIS:PRODUCT_KEY) ! SET TO NEW RECORD AND 841 6 SKIP(LISTINGS,-1) ! MAKE IT THE TOP ITEM 842 6 DO SHOW_TABLE ! DISPLAY THAT PAGE 843 6 . 844 5 OF ENTER_KEY !ENTER KEY OR 845 5 OROF ACCEPT_KEY !CTRL ENTER KEY 846 5 DO GET_RECORD ! READ THE SELECTED RECORD 847 5 IF ACTION = 4 AND KEYCODE() = ENTER_KEY! IF THIS IS A LOOKUP REQUEST 848 6 ACTION = 0 ! SET ACTION TO COMPLETE 849 6 RETURN ! AND RETURN TO CALLER 850 6 . ! 851 5 ACTION = 2 ! SET ACTION TO CHANGE 852 5 UPDATE_LIST ! CALL FORM TO CHANGE RECORD 853 5 IF ~ACTION ! IF THE RECORD WAS CHANGED 854 6 POINTER# = POINTER(LISTINGS) ! REMEMBER WHICH RECORD 855 6 SET(LIS:PRODUCT_KEY,LIS:PRODUCT_KEY) ! SET TO CHANGED RECORD 856 6 SKIP(LISTINGS,-1) ! MAKE IT THE TOP ITEM 857 6 DO SHOW_TABLE ! AND DISPLAY THAT PAGE 858 6 ELSE ! OTHERWISE 859 6 SKIP(LISTINGS,(MAX-NDX)) ! SKIP BACK TO SAME PAGE 860 6 . 861 5 OF DEL_KEY !DELETE KEY 862 5 DO GET_RECORD ! READ THE SELECTED RECORD 863 5 ACTION = 3 ! SET ACTION TO DELETE 864 5 UPDATE_LIST ! CALL FORM TO DELETE RECORD 865 5 IF ~ACTION ! IF RECORD WAS DELETED 866 6 SKIP(LISTINGS,-NDX) ! SET NEXT RECORD ON TOP 867 6 DO SHOW_TABLE ! AND DISPLAY THAT PAGE 868 6 ELSE ! OTHERWISE 869 6 SKIP(LISTINGS,(MAX-NDX)) ! SKIP BACK TO SAME PAGE 870 6 . 871 5 OF DOWN_KEY !DOWN ARROW KEY 872 5 IF NOT EOF(LISTINGS) ! IF THERE ARE MORE RECORDS 873 6 SCROLL(ROW,COL,ROWS,COLS,ROWS(?POINT)) ! SCROLL THE SCREEN UP 874 6 NEXT(LISTINGS) ! READ THE BOTTOM RECORD 875 6 DO SHOW_RECORD ! AND DISPLAY IT 876 6 . 877 5 OF PGDN_KEY !PAGE DOWN KEY 878 5 IF EOF(LISTINGS) ! ON THE LAST PAGE 879 6 NDX = MAX ! POINT TO BOTTOM ITEM 880 6 ELSE ! OTHERWISE 881 6 DO SHOW_TABLE ! DISPLAY NEXT PAGE DOD.CLA CLARION COMPILER v2.0 VIEW COMPANIES BY PRODUCT 6/27/93 7:50 PM PAGE 23 882 6 . 883 5 OF CTRL_PGDN !CTRL-PAGE DOWN KEY 884 5 NDX = MAX ! POINT TO BOTTOM ITEM 885 5 IF NOT EOF(LISTINGS) ! ON THE LAST PAGE 886 6 SET(LIS:PRODUCT_KEY) ! SET TO BOTTOM RECORD MINUS 887 6 SKIP(LISTINGS,-COUNT) ! ONE PAGE OF RECORDS 888 6 DO SHOW_TABLE ! DISPLAY THE LAST PAGE 889 6 . 890 5 OF UP_KEY !UP ARROW KEY 891 5 SKIP(LISTINGS,-(COUNT-1)) ! SET TO TOP RECORD MINUS 1 892 5 IF NOT BOF(LISTINGS) ! IF THERE IS A PRIOR RECORD 893 6 PREVIOUS(LISTINGS) ! READ THE TOP RECORD 894 6 IF NOT ERROR() ! IF READ A RECORD 895 7 SCROLL(ROW,COL,ROWS,COLS,-(ROWS(?POINT)))! SCROLL THE SCREEN DOWN 896 7 DO SHOW_RECORD ! AND DISPLAY IT 897 7 ELSIF ERRORCODE() = 33 ! ELSIF RECORD NOT AVAILABLE 898 7 NEXT(LISTINGS) ! RETRIEVE FIRST ONE 899 7 . . 900 5 SKIP(LISTINGS,COUNT-1) ! SET RECORD FOR NEXT PAGE 901 902 5 OF PGUP_KEY !PAGE UP KEY 903 5 SKIP(LISTINGS,-(COUNT-1)) ! SET TO TOP RECORD MINUS ONE 904 5 IF BOF(LISTINGS) ! IF THERE IS NO PRIOR RECORD 905 6 NDX = 1 ! THEN POINT TO TOP ITEM 906 6 SKIP(LISTINGS,COUNT-1) ! SET RECORD FOR THIS PAGE 907 6 ELSE ! OTHERWISE 908 6 SKIP(LISTINGS,-(COUNT+1)) ! SET RECORD FOR PRIOR PAGE 909 6 DO SHOW_TABLE ! AND DISPLAY THE PAGE 910 6 . 911 5 OF CTRL_PGUP !CTRL-PAGE UP KEY 912 5 SET(LIS:PRODUCT_KEY) ! SET TO FIRST RECORD 913 5 NDX = 1 ! POINT TO TOP ITEM 914 5 DO SHOW_TABLE ! AND DISPLAY THE PAGE 915 5 . 916 4 . . . 917 1 RETURN !RETURN TO CALLER 918 919 1 SHOW_TABLE ROUTINE !DISPLAY A PAGE OF RECORDS 920 1 SKIP(LISTINGS,COUNT-1) ! SET TO THE BOTTOM RECORD 921 1 IF EOF(LISTINGS) ! FOR A PARTIAL PAGE 922 2 SET(LIS:PRODUCT_KEY) ! SET TO THE LAST RECORD 923 2 SKIP(LISTINGS,-COUNT) ! AND BACK UP ONE PAGE 924 2 ELSE ! OTHERWISE 925 2 SKIP(LISTINGS,-(COUNT-1)) ! SET RECORD FOR THIS PAGE 926 2 . 927 1 NDX# = NDX ! SAVE REPEAT INDEX 928 1 LOOP NDX = 1 TO COUNT ! LOOP THRU THE SCROLL AREA 929 2 IF EOF(LISTINGS) THEN BREAK. ! BREAK ON END OF FILE 930 2 NEXT(LISTINGS) ! READ THE NEXT RECORD 931 2 DO SHOW_RECORD ! AND DISPLAY IT 932 2 IF POINTER(LISTINGS) = POINTER# 933 3 NDX# = NDX ! POINT TO CORRECT RECORD 934 3 . . 935 1 NDX = NDX# ! RESTORE REPEAT INDEX DOD.CLA CLARION COMPILER v2.0 VIEW COMPANIES BY PRODUCT 6/27/93 7:50 PM PAGE 24 936 1 CLEAR(LIS:RECORD) ! CLEAR RECORD AREA 937 1 IF RECORDS(LIS:PRODUCT_KEY) < COUNT ! IF RECORDS DO NOT FILL 938 2 NDX#= RECORDS(LIS:PRODUCT_KEY) * 1 ! GET NUMBER TIMES SIZE 939 2 BLANK(ROW + NDX#,COL,ROWS-NDX#,COLS) ! BLANK REMAINING AREA 940 2 . 941 942 1 SHOW_RECORD ROUTINE !DISPLAY A RECORD 943 1 SCR:PRODUCT = LIS:PRODUCT 944 1 SCR:CONTACT_NAME = LIS:CONTACT_NAME 945 1 SCR:STATE = LIS:STATE 946 947 1 GET_RECORD ROUTINE !READ SELECTED RECORD 948 1 SKIP(LISTINGS,-(MAX-NDX+1)) ! SET TO SELECTED RECORD 949 1 NEXT(LISTINGS) ! AND READ IT 950 951 1 FIND_RECORD ROUTINE !LOCATE REQUESTED RECORD 952 1 SET(LIS:PRODUCT_KEY,LIS:PRODUCT_KEY) ! SET TO REQUESTED RECORD 953 1 IF EOF(LISTINGS) ! IF BEYOND END OF FILE 954 2 PREVIOUS(LISTINGS) ! GET THE LAST RECORD 955 2 ELSE ! ELSE 956 2 NEXT(LISTINGS) ! READ THIS RECORD 957 2 . 958 1 POINTER# = POINTER(LISTINGS) ! SAVE ITS RECORD POINTER 959 1 SKIP(LISTINGS,-1) ! MAKE IT THE TOP RECORD 960 1 DO SHOW_TABLE ! AND FILL THE SCROLL AREA 961 962 1 SAME_PAGE ROUTINE !SET TO SAME PAGE ROUTINE 963 1 POINTER# = POINTER(LISTINGS) ! SAVE ITS RECORD POINTER 964 1 GET(LISTINGS,POINTER#) ! GET THE RECORD 965 1 SET(LIS:PRODUCT_KEY,LIS:PRODUCT_KEY) ! SET TO THE SAME RECORD 966 1 SKIP(LISTINGS,-1) ! SKIP TO TOP OF SAME PAGE 967 DOD.CLA CLARION COMPILER v2.0 VIEW COMPANIES BY LOCATION 6/27/93 7:50 PM PAGE 25 969 1 VIEW_STATE PROCEDURE 970 971 1 SCREEN SCREEN PRE(SCR),WINDOW(22,78),HUE(15,4) 972 2 ROW(19,1) PAINT(4,78),HUE(10,1) 973 2 ROW(1,1) STRING('┌─{76}┐'),ENH 974 2 ROW(2,1) REPEAT(2),EVERY(2);STRING('│<0{76}>│'),ENH . 975 2 ROW(3,1) REPEAT(2),EVERY(2);STRING('├─{76}┤'),ENH . 976 2 ROW(6,1) REPEAT(13);STRING('│<0{76}>│'),ENH . 977 2 ROW(19,1) STRING('├─{76}┤'),ENH 978 2 ROW(20,1) REPEAT(2);STRING('│<0{76}>│'),ENH . 979 2 ROW(22,1) STRING('└─{76}┘'),ENH 980 2 ROW(2,27) STRING('VIEW COMPANIES BY LOCATION') 981 2 ROW(4,2) STRING('Location {13}Company name {24}Product') 982 2 ROW(20,23) STRING('Use arrow keys to point and select') 983 2 ROW(21,7) STRING('Press (Enter) to view company information. ' | 984 2 & '(Esc) for previous menu') 985 2 ENTRY,USE(?FIRST_FIELD) 986 2 REPEAT(13),EVERY(1),INDEX(NDX) 987 3 ROW(6,2) POINT(1,76),USE(?POINT),ESC(?-1) 988 3 STATE COL(2) STRING(2) 989 3 COMPANY_NAME COL(23) STRING(30) 990 3 PRODUCT COL(59) STRING(19) 991 3 . . 992 993 1 NDX BYTE !REPEAT INDEX FOR POINT FIELD 994 1 ROW BYTE !ACTUAL ROW OF SCROLL AREA 995 1 COL BYTE !ACTUAL COLUMN OF SCROLL AREA 996 1 MAX LONG !LESSER OF COUNT AND RECORDS 997 1 COUNT BYTE(13) !NUMBER OF ITEMS TO SCROLL 998 1 ROWS BYTE(13) !NUMBER OF ROWS TO SCROLL 999 1 COLS BYTE(76) !NUMBER OF COLUMNS TO SCROLL 1000 1001 DOD.CLA CLARION COMPILER v2.0 VIEW COMPANIES BY LOCATION 6/27/93 7:50 PM PAGE 26 1003 1 CODE 1004 1 ACTION# = ACTION !SAVE ACTION 1005 1 OPEN(SCREEN) !OPEN THE SCREEN 1006 1 SETCURSOR !TURN OFF ANY CURSOR 1007 1 NDX = 1 !PUT SELECTOR BAR ON TOP ITEM 1008 1 ROW = ROW(?POINT) !REMEMBER TOP ROW AND 1009 1 COL = COL(?POINT) ! LEFT COLUMN OF SCROLL AREA 1010 1 IF ACTION = 4 !IF THIS IS A LOOKUP REQUEST 1011 2 SET(LIS:STATE_KEY,LIS:STATE_KEY) ! FIND IT IN THE FILE 1012 2 NEXT(LISTINGS) ! AND READ IT 1013 2 POINTER# = POINTER(LISTINGS) ! SAVE POINTER TO CURRENT 1014 2 SKIP(LISTINGS,-1) ! MAKE IT THE TOP RECORD 1015 2 DO SHOW_TABLE ! FILL SCROLL AREA 1016 2 GET(LISTINGS,POINTER#) ! AND REFRESH CURRENT RECORD 1017 2 ELSE !OTHERWISE 1018 2 SET(LIS:STATE_KEY) ! SET TO FIRST RECORD IN FILE 1019 2 DO SHOW_TABLE ! FILL SCROLL AREA 1020 2 . 1021 1 RECORDS# = TRUE !INITIALIZE RECORDS FLAG 1022 1 LOOP !LOOP UNTIL USER EXITS 1023 2 MAX = RECORDS(LIS:STATE_KEY) !SET LESSER OF FILE RECORD 1024 2 IF MAX > COUNT THEN MAX = COUNT. ! COUNT AND SCROLL ITEM COUNT 1025 2 ACTION = ACTION# !RESTORE ACTION 1026 2 POINTER# = 0 !CLEAR ADD POINTER 1027 2 IF ~RECORDS(LIS:STATE_KEY) !IF THERE ARE NO RECORDS 1028 3 CLEAR(LIS:RECORD) ! CLEAR RECORD AREA 1029 3 ACTION = 1 ! SET ACTION TO ADD 1030 3 UPDATE_LIST ! CALL FORM FOR FIRST RECORD 1031 3 IF ~RECORDS(LIS:STATE_KEY) THEN BREAK. ! IF ADD ABORTED THEN EXIT 1032 3 DO SHOW_RECORD 1033 3 SET(LIS:STATE_KEY) ! SET TO NEW RECORD 1034 3 DO SHOW_TABLE ! FILL SCROLL AREA 1035 3 NDX = 1 ! PUT SELECTOR BAR ON TOP ITEM 1036 3 MAX = 1 ! MAXIMUM DISPLAYED IS 1 1037 3 . ! 1038 2 ALERT !RESET ALERTED KEYS 1039 2 ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY 1040 2 ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY 1041 2 ACCEPT !READ A FIELD 1042 2 IF KEYCODE() = REJECT_KEY THEN BREAK. !RETURN ON SCREEN REJECT KEY 1043 1044 2 EDIT_RANGE# = FIELD() !SET ONE FIELD EDIT RANGE 1045 2 IF KEYCODE() = ACCEPT_KEY AND | !ON SCREEN ACCEPT KEY 1046 2 EDIT_RANGE# <> ?POINT ! AND NOT ON THE POINT FIELD 1047 3 UPDATE ! MOVE ALL FIELDS FROM SCREEN 1048 3 EDIT_RANGE# = ?POINT - 1 ! AND EDIT REMAINING FIELDS 1049 3 SELECT(?POINT) ! IF OK THEN START HERE NEXT 1050 3 . ! 1051 1052 2 LOOP FIELD# = FIELD() TO EDIT_RANGE# !EDIT FIELDS IN THE EDIT RANGE 1053 1054 3 CASE FIELD# !JUMP TO FIELD EDIT ROUTINE 1055 4 OF ?FIRST_FIELD !FROM THE FIRST FIELD 1056 4 IF KEYCODE() = ESC_KEY OR | ! RETURN ON ESC KEY DOD.CLA CLARION COMPILER v2.0 VIEW COMPANIES BY LOCATION 6/27/93 7:50 PM PAGE 27 1057 4 RECORDS# = FALSE ! OR NO RECORDS 1058 5 RETURN 1059 5 . 1060 4 RECORDS# = TRUE ! ASSUME RECORDS ARE HERE 1061 4 OF ?POINT !FROM THE POINT FIELD 1062 4 CASE KEYCODE() ! PROCESS THE KEYSTROKE 1063 5 OF INS_KEY !INSERT KEY 1064 5 CLEAR(LIS:RECORD) ! CLEAR RECORD AREA 1065 5 ACTION = 1 ! SET ACTION TO ADD 1066 5 UPDATE_LIST ! CALL FORM FOR NEW RECORD 1067 5 IF ~ACTION ! IF A NEW RECORD WAS ADDED 1068 6 POINTER# = POINTER(LISTINGS) ! REMEMBER WHICH RECORD 1069 6 SET(LIS:STATE_KEY,LIS:STATE_KEY) ! SET TO NEW RECORD AND 1070 6 SKIP(LISTINGS,-1) ! MAKE IT THE TOP ITEM 1071 6 DO SHOW_TABLE ! DISPLAY THAT PAGE 1072 6 . 1073 5 OF ENTER_KEY !ENTER KEY OR 1074 5 OROF ACCEPT_KEY !CTRL ENTER KEY 1075 5 DO GET_RECORD ! READ THE SELECTED RECORD 1076 5 IF ACTION = 4 AND KEYCODE() = ENTER_KEY! IF THIS IS A LOOKUP REQUEST 1077 6 ACTION = 0 ! SET ACTION TO COMPLETE 1078 6 RETURN ! AND RETURN TO CALLER 1079 6 . ! 1080 5 ACTION = 2 ! SET ACTION TO CHANGE 1081 5 UPDATE_LIST ! CALL FORM TO CHANGE RECORD 1082 5 IF ~ACTION ! IF THE RECORD WAS CHANGED 1083 6 POINTER# = POINTER(LISTINGS) ! REMEMBER WHICH RECORD 1084 6 SET(LIS:STATE_KEY,LIS:STATE_KEY) ! SET TO CHANGED RECORD 1085 6 SKIP(LISTINGS,-1) ! MAKE IT THE TOP ITEM 1086 6 DO SHOW_TABLE ! AND DISPLAY THAT PAGE 1087 6 ELSE ! OTHERWISE 1088 6 SKIP(LISTINGS,(MAX-NDX)) ! SKIP BACK TO SAME PAGE 1089 6 . 1090 5 OF DEL_KEY !DELETE KEY 1091 5 DO GET_RECORD ! READ THE SELECTED RECORD 1092 5 ACTION = 3 ! SET ACTION TO DELETE 1093 5 UPDATE_LIST ! CALL FORM TO DELETE RECORD 1094 5 IF ~ACTION ! IF RECORD WAS DELETED 1095 6 SKIP(LISTINGS,-NDX) ! SET NEXT RECORD ON TOP 1096 6 DO SHOW_TABLE ! AND DISPLAY THAT PAGE 1097 6 ELSE ! OTHERWISE 1098 6 SKIP(LISTINGS,(MAX-NDX)) ! SKIP BACK TO SAME PAGE 1099 6 . 1100 5 OF DOWN_KEY !DOWN ARROW KEY 1101 5 IF NOT EOF(LISTINGS) ! IF THERE ARE MORE RECORDS 1102 6 SCROLL(ROW,COL,ROWS,COLS,ROWS(?POINT)) ! SCROLL THE SCREEN UP 1103 6 NEXT(LISTINGS) ! READ THE BOTTOM RECORD 1104 6 DO SHOW_RECORD ! AND DISPLAY IT 1105 6 . 1106 5 OF PGDN_KEY !PAGE DOWN KEY 1107 5 IF EOF(LISTINGS) ! ON THE LAST PAGE 1108 6 NDX = MAX ! POINT TO BOTTOM ITEM 1109 6 ELSE ! OTHERWISE 1110 6 DO SHOW_TABLE ! DISPLAY NEXT PAGE DOD.CLA CLARION COMPILER v2.0 VIEW COMPANIES BY LOCATION 6/27/93 7:50 PM PAGE 28 1111 6 . 1112 5 OF CTRL_PGDN !CTRL-PAGE DOWN KEY 1113 5 NDX = MAX ! POINT TO BOTTOM ITEM 1114 5 IF NOT EOF(LISTINGS) ! ON THE LAST PAGE 1115 6 SET(LIS:STATE_KEY) ! SET TO BOTTOM RECORD MINUS 1116 6 SKIP(LISTINGS,-COUNT) ! ONE PAGE OF RECORDS 1117 6 DO SHOW_TABLE ! DISPLAY THE LAST PAGE 1118 6 . 1119 5 OF UP_KEY !UP ARROW KEY 1120 5 SKIP(LISTINGS,-(COUNT-1)) ! SET TO TOP RECORD MINUS 1 1121 5 IF NOT BOF(LISTINGS) ! IF THERE IS A PRIOR RECORD 1122 6 PREVIOUS(LISTINGS) ! READ THE TOP RECORD 1123 6 IF NOT ERROR() ! IF READ A RECORD 1124 7 SCROLL(ROW,COL,ROWS,COLS,-(ROWS(?POINT)))! SCROLL THE SCREEN DOWN 1125 7 DO SHOW_RECORD ! AND DISPLAY IT 1126 7 ELSIF ERRORCODE() = 33 ! ELSIF RECORD NOT AVAILABLE 1127 7 NEXT(LISTINGS) ! RETRIEVE FIRST ONE 1128 7 . . 1129 5 SKIP(LISTINGS,COUNT-1) ! SET RECORD FOR NEXT PAGE 1130 1131 5 OF PGUP_KEY !PAGE UP KEY 1132 5 SKIP(LISTINGS,-(COUNT-1)) ! SET TO TOP RECORD MINUS ONE 1133 5 IF BOF(LISTINGS) ! IF THERE IS NO PRIOR RECORD 1134 6 NDX = 1 ! THEN POINT TO TOP ITEM 1135 6 SKIP(LISTINGS,COUNT-1) ! SET RECORD FOR THIS PAGE 1136 6 ELSE ! OTHERWISE 1137 6 SKIP(LISTINGS,-(COUNT+1)) ! SET RECORD FOR PRIOR PAGE 1138 6 DO SHOW_TABLE ! AND DISPLAY THE PAGE 1139 6 . 1140 5 OF CTRL_PGUP !CTRL-PAGE UP KEY 1141 5 SET(LIS:STATE_KEY) ! SET TO FIRST RECORD 1142 5 NDX = 1 ! POINT TO TOP ITEM 1143 5 DO SHOW_TABLE ! AND DISPLAY THE PAGE 1144 5 . 1145 4 . . . 1146 1 RETURN !RETURN TO CALLER 1147 1148 1 SHOW_TABLE ROUTINE !DISPLAY A PAGE OF RECORDS 1149 1 SKIP(LISTINGS,COUNT-1) ! SET TO THE BOTTOM RECORD 1150 1 IF EOF(LISTINGS) ! FOR A PARTIAL PAGE 1151 2 SET(LIS:STATE_KEY) ! SET TO THE LAST RECORD 1152 2 SKIP(LISTINGS,-COUNT) ! AND BACK UP ONE PAGE 1153 2 ELSE ! OTHERWISE 1154 2 SKIP(LISTINGS,-(COUNT-1)) ! SET RECORD FOR THIS PAGE 1155 2 . 1156 1 NDX# = NDX ! SAVE REPEAT INDEX 1157 1 LOOP NDX = 1 TO COUNT ! LOOP THRU THE SCROLL AREA 1158 2 IF EOF(LISTINGS) THEN BREAK. ! BREAK ON END OF FILE 1159 2 NEXT(LISTINGS) ! READ THE NEXT RECORD 1160 2 DO SHOW_RECORD ! AND DISPLAY IT 1161 2 IF POINTER(LISTINGS) = POINTER# 1162 3 NDX# = NDX ! POINT TO CORRECT RECORD 1163 3 . . 1164 1 NDX = NDX# ! RESTORE REPEAT INDEX DOD.CLA CLARION COMPILER v2.0 VIEW COMPANIES BY LOCATION 6/27/93 7:50 PM PAGE 29 1165 1 CLEAR(LIS:RECORD) ! CLEAR RECORD AREA 1166 1 IF RECORDS(LIS:STATE_KEY) < COUNT ! IF RECORDS DO NOT FILL 1167 2 NDX#= RECORDS(LIS:STATE_KEY) * 1 ! GET NUMBER TIMES SIZE 1168 2 BLANK(ROW + NDX#,COL,ROWS-NDX#,COLS) ! BLANK REMAINING AREA 1169 2 . 1170 1171 1 SHOW_RECORD ROUTINE !DISPLAY A RECORD 1172 1 SCR:STATE = LIS:STATE 1173 1 SCR:COMPANY_NAME = LIS:COMPANY_NAME 1174 1 SCR:PRODUCT = LIS:PRODUCT 1175 1176 1 GET_RECORD ROUTINE !READ SELECTED RECORD 1177 1 SKIP(LISTINGS,-(MAX-NDX+1)) ! SET TO SELECTED RECORD 1178 1 NEXT(LISTINGS) ! AND READ IT 1179 1180 1 FIND_RECORD ROUTINE !LOCATE REQUESTED RECORD 1181 1 SET(LIS:STATE_KEY,LIS:STATE_KEY) ! SET TO REQUESTED RECORD 1182 1 IF EOF(LISTINGS) ! IF BEYOND END OF FILE 1183 2 PREVIOUS(LISTINGS) ! GET THE LAST RECORD 1184 2 ELSE ! ELSE 1185 2 NEXT(LISTINGS) ! READ THIS RECORD 1186 2 . 1187 1 POINTER# = POINTER(LISTINGS) ! SAVE ITS RECORD POINTER 1188 1 SKIP(LISTINGS,-1) ! MAKE IT THE TOP RECORD 1189 1 DO SHOW_TABLE ! AND FILL THE SCROLL AREA 1190 1191 1 SAME_PAGE ROUTINE !SET TO SAME PAGE ROUTINE 1192 1 POINTER# = POINTER(LISTINGS) ! SAVE ITS RECORD POINTER 1193 1 GET(LISTINGS,POINTER#) ! GET THE RECORD 1194 1 SET(LIS:STATE_KEY,LIS:STATE_KEY) ! SET TO THE SAME RECORD 1195 1 SKIP(LISTINGS,-1) ! SKIP TO TOP OF SAME PAGE 1196 DOD.CLA CLARION COMPILER v2.0 PRODUCT AND SERVICE CATEGORIES 6/27/93 7:50 PM PAGE 30 1198 1 VIEW_CATEGO PROCEDURE 1199 1200 1 SCREEN SCREEN PRE(SCR),WINDOW(22,50),HUE(15,4) 1201 2 ROW(1,1) STRING('┌─{48}┐'),ENH 1202 2 ROW(2,1) REPEAT(2),EVERY(18);STRING('│<0{48}>│'),ENH . 1203 2 ROW(3,1) REPEAT(2),EVERY(16);STRING('├─{48}┤'),ENH . 1204 2 ROW(4,1) REPEAT(15);STRING('│<0{48}>│'),ENH . 1205 2 ROW(21,1) STRING('│<0{48}>│'),ENH 1206 2 ROW(22,1) STRING('└─{48}┘'),ENH 1207 2 ROW(2,11) STRING('PRODUCT AND SERVICE CATEGORIES') 1208 2 ROW(20,12) STRING('Press (Esc) for previous menu') 1209 2 ROW(21,4) STRING('Press (Enter) then F2 to print category list') 1210 2 ENTRY,USE(?FIRST_FIELD) 1211 2 REPEAT(15),EVERY(1),INDEX(NDX) 1212 3 ROW(4,2) POINT(1,25),USE(?POINT),ESC(?-1) 1213 3 CATEGORY COL(2) STRING(25) 1214 3 . . 1215 1216 1 NDX BYTE !REPEAT INDEX FOR POINT FIELD 1217 1 ROW BYTE !ACTUAL ROW OF SCROLL AREA 1218 1 COL BYTE !ACTUAL COLUMN OF SCROLL AREA 1219 1 MAX LONG !LESSER OF COUNT AND RECORDS 1220 1 COUNT BYTE(15) !NUMBER OF ITEMS TO SCROLL 1221 1 ROWS BYTE(15) !NUMBER OF ROWS TO SCROLL 1222 1 COLS BYTE(25) !NUMBER OF COLUMNS TO SCROLL 1223 1224 DOD.CLA CLARION COMPILER v2.0 PRODUCT AND SERVICE CATEGORIES 6/27/93 7:50 PM PAGE 31 1226 1 CODE 1227 1 ACTION# = ACTION !SAVE ACTION 1228 1 OPEN(SCREEN) !OPEN THE SCREEN 1229 1 SETCURSOR !TURN OFF ANY CURSOR 1230 1 NDX = 1 !PUT SELECTOR BAR ON TOP ITEM 1231 1 ROW = ROW(?POINT) !REMEMBER TOP ROW AND 1232 1 COL = COL(?POINT) ! LEFT COLUMN OF SCROLL AREA 1233 1 IF ACTION = 4 !IF THIS IS A LOOKUP REQUEST 1234 2 SET(IND:CAT_INDEX,IND:CAT_INDEX) ! FIND IT IN THE FILE 1235 2 NEXT(INDEX) ! AND READ IT 1236 2 POINTER# = POINTER(INDEX) ! SAVE POINTER TO CURRENT 1237 2 SKIP(INDEX,-1) ! MAKE IT THE TOP RECORD 1238 2 DO SHOW_TABLE ! FILL SCROLL AREA 1239 2 GET(INDEX,POINTER#) ! AND REFRESH CURRENT RECORD 1240 2 ELSE !OTHERWISE 1241 2 SET(IND:CAT_INDEX) ! SET TO FIRST RECORD IN FILE 1242 2 DO SHOW_TABLE ! FILL SCROLL AREA 1243 2 . 1244 1 RECORDS# = TRUE !INITIALIZE RECORDS FLAG 1245 1 LOOP !LOOP UNTIL USER EXITS 1246 2 MAX = RECORDS(IND:CAT_INDEX) !SET LESSER OF FILE RECORD 1247 2 IF MAX > COUNT THEN MAX = COUNT. ! COUNT AND SCROLL ITEM COUNT 1248 2 ACTION = ACTION# !RESTORE ACTION 1249 2 POINTER# = 0 !CLEAR ADD POINTER 1250 2 IF ~RECORDS(IND:CAT_INDEX) !IF THERE ARE NO RECORDS 1251 3 CLEAR(IND:RECORD) ! CLEAR RECORD AREA 1252 3 ACTION = 1 ! SET ACTION TO ADD 1253 3 UPDATE_CAT ! CALL FORM FOR FIRST RECORD 1254 3 IF ~RECORDS(IND:CAT_INDEX) THEN BREAK. ! IF ADD ABORTED THEN EXIT 1255 3 DO SHOW_RECORD 1256 3 SET(IND:CAT_INDEX) ! SET TO NEW RECORD 1257 3 DO SHOW_TABLE ! FILL SCROLL AREA 1258 3 NDX = 1 ! PUT SELECTOR BAR ON TOP ITEM 1259 3 MAX = 1 ! MAXIMUM DISPLAYED IS 1 1260 3 . ! 1261 2 ALERT !RESET ALERTED KEYS 1262 2 ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY 1263 2 ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY 1264 2 ACCEPT !READ A FIELD 1265 2 IF KEYCODE() = REJECT_KEY THEN BREAK. !RETURN ON SCREEN REJECT KEY 1266 1267 2 EDIT_RANGE# = FIELD() !SET ONE FIELD EDIT RANGE 1268 2 IF KEYCODE() = ACCEPT_KEY AND | !ON SCREEN ACCEPT KEY 1269 2 EDIT_RANGE# <> ?POINT ! AND NOT ON THE POINT FIELD 1270 3 UPDATE ! MOVE ALL FIELDS FROM SCREEN 1271 3 EDIT_RANGE# = ?POINT - 1 ! AND EDIT REMAINING FIELDS 1272 3 SELECT(?POINT) ! IF OK THEN START HERE NEXT 1273 3 . ! 1274 1275 2 LOOP FIELD# = FIELD() TO EDIT_RANGE# !EDIT FIELDS IN THE EDIT RANGE 1276 1277 3 CASE FIELD# !JUMP TO FIELD EDIT ROUTINE 1278 4 OF ?FIRST_FIELD !FROM THE FIRST FIELD 1279 4 IF KEYCODE() = ESC_KEY OR | ! RETURN ON ESC KEY DOD.CLA CLARION COMPILER v2.0 PRODUCT AND SERVICE CATEGORIES 6/27/93 7:50 PM PAGE 32 1280 4 RECORDS# = FALSE ! OR NO RECORDS 1281 5 RETURN 1282 5 . 1283 4 RECORDS# = TRUE ! ASSUME RECORDS ARE HERE 1284 4 OF ?POINT !FROM THE POINT FIELD 1285 4 CASE KEYCODE() ! PROCESS THE KEYSTROKE 1286 5 OF INS_KEY !INSERT KEY 1287 5 CLEAR(IND:RECORD) ! CLEAR RECORD AREA 1288 5 ACTION = 1 ! SET ACTION TO ADD 1289 5 UPDATE_CAT ! CALL FORM FOR NEW RECORD 1290 5 IF ~ACTION ! IF A NEW RECORD WAS ADDED 1291 6 POINTER# = POINTER(INDEX) ! REMEMBER WHICH RECORD 1292 6 SET(IND:CAT_INDEX,IND:CAT_INDEX) ! SET TO NEW RECORD AND 1293 6 SKIP(INDEX,-1) ! MAKE IT THE TOP ITEM 1294 6 DO SHOW_TABLE ! DISPLAY THAT PAGE 1295 6 . 1296 5 OF ENTER_KEY !ENTER KEY OR 1297 5 OROF ACCEPT_KEY !CTRL ENTER KEY 1298 5 DO GET_RECORD ! READ THE SELECTED RECORD 1299 5 IF ACTION = 4 AND KEYCODE() = ENTER_KEY! IF THIS IS A LOOKUP REQUEST 1300 6 ACTION = 0 ! SET ACTION TO COMPLETE 1301 6 RETURN ! AND RETURN TO CALLER 1302 6 . ! 1303 5 ACTION = 2 ! SET ACTION TO CHANGE 1304 5 UPDATE_CAT ! CALL FORM TO CHANGE RECORD 1305 5 IF ~ACTION ! IF THE RECORD WAS CHANGED 1306 6 POINTER# = POINTER(INDEX) ! REMEMBER WHICH RECORD 1307 6 SET(IND:CAT_INDEX,IND:CAT_INDEX) ! SET TO CHANGED RECORD 1308 6 SKIP(INDEX,-1) ! MAKE IT THE TOP ITEM 1309 6 DO SHOW_TABLE ! AND DISPLAY THAT PAGE 1310 6 ELSE ! OTHERWISE 1311 6 SKIP(INDEX,(MAX-NDX)) ! SKIP BACK TO SAME PAGE 1312 6 . 1313 5 OF DEL_KEY !DELETE KEY 1314 5 DO GET_RECORD ! READ THE SELECTED RECORD 1315 5 ACTION = 3 ! SET ACTION TO DELETE 1316 5 UPDATE_CAT ! CALL FORM TO DELETE RECORD 1317 5 IF ~ACTION ! IF RECORD WAS DELETED 1318 6 SKIP(INDEX,-NDX) ! SET NEXT RECORD ON TOP 1319 6 DO SHOW_TABLE ! AND DISPLAY THAT PAGE 1320 6 ELSE ! OTHERWISE 1321 6 SKIP(INDEX,(MAX-NDX)) ! SKIP BACK TO SAME PAGE 1322 6 . 1323 5 OF DOWN_KEY !DOWN ARROW KEY 1324 5 IF NOT EOF(INDEX) ! IF THERE ARE MORE RECORDS 1325 6 SCROLL(ROW,COL,ROWS,COLS,ROWS(?POINT)) ! SCROLL THE SCREEN UP 1326 6 NEXT(INDEX) ! READ THE BOTTOM RECORD 1327 6 DO SHOW_RECORD ! AND DISPLAY IT 1328 6 . 1329 5 OF PGDN_KEY !PAGE DOWN KEY 1330 5 IF EOF(INDEX) ! ON THE LAST PAGE 1331 6 NDX = MAX ! POINT TO BOTTOM ITEM 1332 6 ELSE ! OTHERWISE 1333 6 DO SHOW_TABLE ! DISPLAY NEXT PAGE DOD.CLA CLARION COMPILER v2.0 PRODUCT AND SERVICE CATEGORIES 6/27/93 7:50 PM PAGE 33 1334 6 . 1335 5 OF CTRL_PGDN !CTRL-PAGE DOWN KEY 1336 5 NDX = MAX ! POINT TO BOTTOM ITEM 1337 5 IF NOT EOF(INDEX) ! ON THE LAST PAGE 1338 6 SET(IND:CAT_INDEX) ! SET TO BOTTOM RECORD MINUS 1339 6 SKIP(INDEX,-COUNT) ! ONE PAGE OF RECORDS 1340 6 DO SHOW_TABLE ! DISPLAY THE LAST PAGE 1341 6 . 1342 5 OF UP_KEY !UP ARROW KEY 1343 5 SKIP(INDEX,-(COUNT-1)) ! SET TO TOP RECORD MINUS 1 1344 5 IF NOT BOF(INDEX) ! IF THERE IS A PRIOR RECORD 1345 6 PREVIOUS(INDEX) ! READ THE TOP RECORD 1346 6 IF NOT ERROR() ! IF READ A RECORD 1347 7 SCROLL(ROW,COL,ROWS,COLS,-(ROWS(?POINT)))! SCROLL THE SCREEN DOWN 1348 7 DO SHOW_RECORD ! AND DISPLAY IT 1349 7 ELSIF ERRORCODE() = 33 ! ELSIF RECORD NOT AVAILABLE 1350 7 NEXT(INDEX) ! RETRIEVE FIRST ONE 1351 7 . . 1352 5 SKIP(INDEX,COUNT-1) ! SET RECORD FOR NEXT PAGE 1353 1354 5 OF PGUP_KEY !PAGE UP KEY 1355 5 SKIP(INDEX,-(COUNT-1)) ! SET TO TOP RECORD MINUS ONE 1356 5 IF BOF(INDEX) ! IF THERE IS NO PRIOR RECORD 1357 6 NDX = 1 ! THEN POINT TO TOP ITEM 1358 6 SKIP(INDEX,COUNT-1) ! SET RECORD FOR THIS PAGE 1359 6 ELSE ! OTHERWISE 1360 6 SKIP(INDEX,-(COUNT+1)) ! SET RECORD FOR PRIOR PAGE 1361 6 DO SHOW_TABLE ! AND DISPLAY THE PAGE 1362 6 . 1363 5 OF CTRL_PGUP !CTRL-PAGE UP KEY 1364 5 SET(IND:CAT_INDEX) ! SET TO FIRST RECORD 1365 5 NDX = 1 ! POINT TO TOP ITEM 1366 5 DO SHOW_TABLE ! AND DISPLAY THE PAGE 1367 5 . 1368 4 . . . 1369 1 RETURN !RETURN TO CALLER 1370 1371 1 SHOW_TABLE ROUTINE !DISPLAY A PAGE OF RECORDS 1372 1 SKIP(INDEX,COUNT-1) ! SET TO THE BOTTOM RECORD 1373 1 IF EOF(INDEX) ! FOR A PARTIAL PAGE 1374 2 SET(IND:CAT_INDEX) ! SET TO THE LAST RECORD 1375 2 SKIP(INDEX,-COUNT) ! AND BACK UP ONE PAGE 1376 2 ELSE ! OTHERWISE 1377 2 SKIP(INDEX,-(COUNT-1)) ! SET RECORD FOR THIS PAGE 1378 2 . 1379 1 NDX# = NDX ! SAVE REPEAT INDEX 1380 1 LOOP NDX = 1 TO COUNT ! LOOP THRU THE SCROLL AREA 1381 2 IF EOF(INDEX) THEN BREAK. ! BREAK ON END OF FILE 1382 2 NEXT(INDEX) ! READ THE NEXT RECORD 1383 2 DO SHOW_RECORD ! AND DISPLAY IT 1384 2 IF POINTER(INDEX) = POINTER# 1385 3 NDX# = NDX ! POINT TO CORRECT RECORD 1386 3 . . 1387 1 NDX = NDX# ! RESTORE REPEAT INDEX DOD.CLA CLARION COMPILER v2.0 PRODUCT AND SERVICE CATEGORIES 6/27/93 7:50 PM PAGE 34 1388 1 CLEAR(IND:RECORD) ! CLEAR RECORD AREA 1389 1 IF RECORDS(IND:CAT_INDEX) < COUNT ! IF RECORDS DO NOT FILL 1390 2 NDX#= RECORDS(IND:CAT_INDEX) * 1 ! GET NUMBER TIMES SIZE 1391 2 BLANK(ROW + NDX#,COL,ROWS-NDX#,COLS) ! BLANK REMAINING AREA 1392 2 . 1393 1394 1 SHOW_RECORD ROUTINE !DISPLAY A RECORD 1395 1 SCR:CATEGORY = IND:CATEGORY 1396 1397 1 GET_RECORD ROUTINE !READ SELECTED RECORD 1398 1 SKIP(INDEX,-(MAX-NDX+1)) ! SET TO SELECTED RECORD 1399 1 NEXT(INDEX) ! AND READ IT 1400 1401 1 FIND_RECORD ROUTINE !LOCATE REQUESTED RECORD 1402 1 SET(IND:CAT_INDEX,IND:CAT_INDEX) ! SET TO REQUESTED RECORD 1403 1 IF EOF(INDEX) ! IF BEYOND END OF FILE 1404 2 PREVIOUS(INDEX) ! GET THE LAST RECORD 1405 2 ELSE ! ELSE 1406 2 NEXT(INDEX) ! READ THIS RECORD 1407 2 . 1408 1 POINTER# = POINTER(INDEX) ! SAVE ITS RECORD POINTER 1409 1 SKIP(INDEX,-1) ! MAKE IT THE TOP RECORD 1410 1 DO SHOW_TABLE ! AND FILL THE SCROLL AREA 1411 1412 1 SAME_PAGE ROUTINE !SET TO SAME PAGE ROUTINE 1413 1 POINTER# = POINTER(INDEX) ! SAVE ITS RECORD POINTER 1414 1 GET(INDEX,POINTER#) ! GET THE RECORD 1415 1 SET(IND:CAT_INDEX,IND:CAT_INDEX) ! SET TO THE SAME RECORD 1416 1 SKIP(INDEX,-1) ! SKIP TO TOP OF SAME PAGE 1417 DOD.CLA CLARION COMPILER v2.0 Update categories 6/27/93 7:50 PM PAGE 35 1419 1 UPDATE_CAT PROCEDURE 1420 1421 1 SCREEN SCREEN PRE(SCR),WINDOW(7,45),HUE(15,4) 1422 2 ROW(1,1) STRING('┌─{43}┐'),ENH 1423 2 ROW(2,1) REPEAT(5);STRING('│<0{43}>│'),ENH . 1424 2 ROW(7,1) STRING('└─{43}┘'),ENH 1425 2 ROW(2,15) STRING('Update categories') 1426 2 ROW(4,4) STRING('CATEGORY:') 1427 2 ROW(5,4) STRING('COMMENT :') 1428 2 ROW(6,16) STRING('TYPE F2 TO PRINT') 1429 2 MESSAGE ROW(3,9) STRING(30) 1430 2 ENTRY,USE(?FIRST_FIELD) 1431 2 ROW(4,13) ENTRY(@S25),USE(IND:CATEGORY),LFT,UPR,OVR 1432 2 ROW(5,13) ENTRY(@S30),USE(IND:COMMENT),LFT,OVR 1433 2 ENTRY,USE(?LAST_FIELD) 1434 2 PAUSE(''),USE(?DELETE_FIELD) 1435 2 . 1436 DOD.CLA CLARION COMPILER v2.0 Update categories 6/27/93 7:50 PM PAGE 36 1438 1 CODE 1439 1 OPEN(SCREEN) !OPEN THE SCREEN 1440 1 SETCURSOR !TURN OFF ANY CURSOR 1441 1 ACTION# = ACTION !SAVE ACTION VALUE 1442 1 ACTION = ACTION# !RESET ACTION 1443 1 DISPLAY !DISPLAY THE FIELDS 1444 1 EXECUTE ACTION !SET THE CURRENT RECORD POINTER 1445 2 POINTER# = 0 ! NO RECORD FOR ADD 1446 2 POINTER# = POINTER(INDEX) ! CURRENT RECORD FOR CHANGE 1447 2 POINTER# = POINTER(INDEX) ! CURRENT RECORD FOR CHANGE 1448 2 . 1449 1 LOOP !LOOP THRU ALL THE FIELDS 1450 2 MEM:MESSAGE = CENTER(MEM:MESSAGE,SIZE(MEM:MESSAGE)) !DISPLAY ACTION MESSAGE 1451 2 SCR:MESSAGE = MEM:MESSAGE 1452 2 ALERT !RESET ALERTED KEYS 1453 2 ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY 1454 2 ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY 1455 2 ALERT(F2_KEY) !ALERT HOT KEY 1456 2 ACCEPT !READ A FIELD 1457 2 IF KEYCODE() = F2_KEY !ON HOT KEY 1458 3 SAVACTN# = ACTION ! SAVE ACTION 1459 3 PRINT_CAT ! CALL HOT KEY PROCEDURE 1460 3 ACTION = SAVACTN# ! RESTORE ACTION 1461 3 SELECT(?) ! DO SAME FIELD AGAIN 1462 3 CYCLE ! AND LOOP AGAIN 1463 3 . 1464 2 IF KEYCODE() = REJECT_KEY THEN RETURN. !RETURN ON SCREEN REJECT KEY 1465 2 EXECUTE ACTION !SET ACTION MESSAGE 1466 3 MEM:MESSAGE = 'Record will be Added' ! 1467 3 MEM:MESSAGE = 'Record will be Changed' ! 1468 3 MEM:MESSAGE = 'Press Enter to Delete' ! 1469 3 . 1470 2 EDIT_RANGE# = FIELD() !SET ONE FIELD EDIT RANGE 1471 2 IF KEYCODE() = ACCEPT_KEY !ON SCREEN ACCEPT KEY 1472 3 UPDATE ! MOVE ALL FIELDS FROM SCREEN 1473 3 EDIT_RANGE# = FIELDS() ! AND EDIT REMAINING FIELDS 1474 3 . ! 1475 2 LOOP FIELD# = FIELD() TO EDIT_RANGE# !EDIT FIELDS IN THE EDIT RANGE 1476 3 CASE FIELD# !JUMP TO FIELD EDIT ROUTINE 1477 4 OF ?FIRST_FIELD !FROM THE FIRST FIELD 1478 4 IF KEYCODE() = ESC_KEY THEN RETURN. ! RETURN ON ESC KEY 1479 4 IF ACTION = 3 THEN SELECT(?DELETE_FIELD).! OR CONFIRM FOR DELETE 1480 1481 4 OF ?IND:CATEGORY !INDEX OF CATEGORIES 1482 4 IF IND:CATEGORY = '' !IF REQUIRED FIELD IS EMPTY 1483 5 BEEP ! SOUND KEYBOARD ALARM 1484 5 SELECT(?IND:CATEGORY) ! AND STAY ON THIS FIELD 1485 5 BREAK ! 1486 5 . 1487 1488 4 OF ?IND:COMMENT !COMMENT ON CATERGORY 1489 1490 4 OF ?LAST_FIELD !FROM THE LAST FIELD 1491 4 EXECUTE ACTION ! UPDATE THE FILE DOD.CLA CLARION COMPILER v2.0 Update categories 6/27/93 7:50 PM PAGE 37 1492 5 ADD(INDEX) ! ADD NEW RECORD 1493 5 PUT(INDEX) ! CHANGE EXISTING RECORD 1494 5 DELETE(INDEX) ! DELETE EXISTING RECORD 1495 5 . 1496 4 IF ERROR() THEN STOP(ERROR()). ! CHECK FOR UNEXPECTED ERROR 1497 4 ACTION = 0 ! SET ACTION TO COMPLETE 1498 4 RETURN ! AND RETURN TO CALLER 1499 1500 4 OF ?DELETE_FIELD !FROM THE DELETE FIELD 1501 4 IF KEYCODE() = ENTER_KEY | ! ON ENTER KEY 1502 4 OR KEYCODE() = ACCEPT_KEY ! OR CTRL-ENTER KEY 1503 5 SELECT(?LAST_FIELD) ! DELETE THE RECORD 1504 5 ELSE ! OTHERWISE 1505 5 BEEP ! BEEP AND ASK AGAIN 1506 5 . . . . 1507 DOD.CLA CLARION COMPILER v2.0 Print categories 6/27/93 7:50 PM PAGE 38 1509 1510 1 PRINT_CAT PROCEDURE 1511 1512 1 TITLE REPORT LENGTH(30),WIDTH(80),PRE(TTL) 1513 2 RPT_HEAD DETAIL 1514 3 . . 1515 1 REPORT REPORT LENGTH(30),WIDTH(80),PAGE(MEM:PAGE),LINE(MEM:LINE) | 1516 1 PRE(RPT) 1517 2 PAGE_HEAD HEADER 1518 3 COL(1) STRING('Print categories') CTL(@LF2) 1519 3 . 1520 2 DETAIL DETAIL 1521 3 ROW(+1,1) STRING(25),USE(IND:CATEGORY) CTL(@LF2) 1522 3 . 1523 2 RPT_FOOT DETAIL 1524 3 . 1525 2 PAGE_FOOT FOOTER 1526 3 . . 1527 1528 1529 1 CODE 1530 1 DONE# = 0 !TURN OFF DONE FLAG 1531 1 CLEAR(IND:RECORD) !MAKE SURE RECORD CLEARED 1532 1 PRINT(TTL:RPT_HEAD) !PRINT TITLE PAGE 1533 1 CLOSE(TITLE) !CLOSE TITLE REPORT 1534 1 SET(IND:CAT_INDEX) !SET TO FIRST RECORD 1535 1 DO NEXT_RECORD !READ FIRST RECORD 1536 1 MEM:DEVICE = '+' & MEM:DEVICE !APPEND DISK RPT TO TITLE 1537 1 OPEN(REPORT) !OPEN THE REPORT 1538 1 LOOP UNTIL DONE# !READ ALL RECORDS IN FILE 1539 2 SAVE_LINE# = MEM:LINE ! SAVE LINE NUMBER 1540 2 LAST_REC# = POINTER(INDEX) 1541 2 PRINT(RPT:DETAIL) ! PRINT DETAIL LINES 1542 2 DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED 1543 2 DO NEXT_RECORD ! GET NEXT RECORD 1544 2 . ! 1545 1 PRINT(RPT:RPT_FOOT) !PRINT GRAND TOTALS 1546 1 DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED 1547 1 CLOSE(REPORT) !CLOSE REPORT 1548 1 MEM:DEVICE = SUB(MEM:DEVICE,2,LEN(MEM:DEVICE)-1) !TURN OFF APPEND REPORT 1549 1 RETURN !RETURN TO CALLER 1550 1551 1552 1 NEXT_RECORD ROUTINE !GET NEXT RECORD 1553 1 LOOP UNTIL EOF(INDEX) ! READ UNTIL END OF FILE 1554 2 NEXT(INDEX) ! READ NEXT RECORD 1555 2 EXIT ! EXIT THE ROUTINE 1556 2 . ! 1557 1 DONE# = 1 ! ON EOF, SET DONE FLAG 1558 1559 1 CHECK_PAGE ROUTINE !CHECK FOR NEW PAGE 1560 1 IF MEM:LINE <= SAVE_LINE# ! ON PAGE OVERFLOW 1561 2 SAVE_LINE# = MEM:LINE ! RESET LINE NUMBER 1562 2 . DOD.CLA CLARION COMPILER v2.0 Print categories 6/27/93 7:50 PM PAGE 39 1563 1 LOOP UNTIL NOT KEYBOARD() !LOOK FOR KEYSTROKE 1564 2 ASK 1565 2 IF KEYCODE() = REJECT_KEY THEN RETURN. !ABORT REPORT 1566 2 . 1567 1568 NO MESSAGES THIS COMPILE