|
Totaal programma
<![CDATA[ 1 /* REXX ********************************************************************/
2 /* */ 3 /* YAHTZEE.rex - Tripple YAHTZEE in REXX op basis van PC3270 support
*/ 4 /* */ 5 /***************************************************************************/
6 7 Main: 8 Arg SPELPARAMETER . 9 10 If (SPELPARAMETER = '') Then 11 SPELPARAMETER
= 'C' 12 13 Call ProgrammaInit 14 15 Do Until (OPDRACHT = QUIT) 16 17 Do
Until (GOEDFOUT = GOED) 18 Call ZendScherm 19 Call LeesScherm 20 21 Select
22 When (OPDRACHT = YAHTZEE) Then Do 23 Call ControleerYahtzee 24 GOEDFOUT
= RESULT 25 End 26 27 When (OPDRACHT = HELP) Then Do 28 Call ControleerHelp
29 GOEDFOUT = RESULT 30 End 31 32 When (OPDRACHT = QUIT) Then Do 33 GOEDFOUT
= GOED 34 End 35 36 End /* Select */ 37 38 End /* Do */ 39 40 Select 41
When (OPDRACHT = YAHTZEE) Then 42 Call VerwerkYahtzee 43 44 When (OPDRACHT
= QUIT) Then 45 Call VerwerkQuit 46 47 End /* Select */ 48 49 End /* Do
*/ 50 51 Exit 0 52 53 54 55 /***************************************************************************/
56 /* Controleer de Help opdracht */ 57 /***************************************************************************/
58 ControleerHelp: 59 ROW = 21 60 COLUMN = 66 61 Call ConField 23 24 BRIGHT
RED, 62 '__________**___H_E_L_P___N_I_E_T___A_A_N_W_E_Z_I_G___**' 63 Return
FOUT 64 65 66 67 /***************************************************************************/
68 /* Controleer het gekozen spel */ 69 /***************************************************************************/
70 71 ControleerYahtzee: 72 73 If (INVOER = WORP) Then 74 Return GOED 75
76 SPEL = Translate(FIELD.1.5,' ','.') 77 KOLOM = Translate(FIELD.2.5,'
','.') 78 79 If (SPEL = '') Then Do 80 ROW = 21 81 COLUMN = 66 82 Call ConField
23 24 BRIGHT RED, 83 '______**___N_U_M_M_E_R___N_I_E_T___I_N_G_E_V_U_L_D___**'
84 Return FOUT 85 End /* If */ 86 87 If (KOLOM = '') Then Do 88 ROW = 21
89 COLUMN = 77 90 Call ConField 23 24 BRIGHT RED, 91 '________**___K_O_L_O_M___N_I_E_T___I_N_G_E_V_U_L_D___**'
92 Return FOUT 93 End /* If */ 94 95 If (DataType(SPEL,'W') = 0) Then Do
96 ROW = 21 97 COLUMN = 66 98 Call ConField 23 24 BRIGHT RED, 99 '______**___N_U_M_M_E_R___N_I_E_T___N_U_M_E_R_I_E_K___**'
100 Return FOUT 101 End /* If */ 102 103 If (DataType(KOLOM,'W') = 0) Then
Do 104 ROW = 21 105 COLUMN = 77 106 Call ConField 23 24 BRIGHT RED, 107
'________**___K_O_L_O_M___N_I_E_T___N_U_M_E_R_I_E_K___**' 108 Return FOUT
109 End /* If */ 110 111 SPEL = SPEL + 0 112 113 If (SPEL < 1 | SPEL > 13)
Then Do 114 ROW = 21 115 COLUMN = 66 116 Call ConField 23 24 BRIGHT RED,
117 '__________**___N_U_M_M_E_R___I_S___O_N_G_E_L_D_I_G___**' 118 Return
FOUT 119 End /* If */ 120 121 If (KOLOM < 1 | KOLOM > 3) Then Do 122 ROW
= 21 123 COLUMN = 77 124 Call ConField 23 24 BRIGHT RED, 125 '____________**___K_O_L_O_M___I_S___O_N_G_E_L_D_I_G___**'
126 Return FOUT 127 End /* If */ 128 129 If (SPEL <> 12 & VAKJE.KOLOM.SPEL
<> -1) Then Do 130 ROW = 21 131 COLUMN = 66 132 Call ConField 23 24 BRIGHT
RED, 133 '**___V_A_K_J_E___I_S___R_E_E_D_S___I_N_G_E_V_U_L_D___**' 134 Return
FOUT 135 End /* If */ 136 137 Return GOED 138 139 140 141 /***************************************************************************/
142 /* Lees het scherm */ 143 /***************************************************************************/
144 LeesScherm: 145 146 Select 147 When KEYPRESSED = ENTER Then 148 OPDRACHT
= YAHTZEE 149 150 When KEYPRESSED = PF3 Then 151 OPDRACHT = QUIT 152 153
Otherwise 154 OPDRACHT = HELP 155 156 End /* Select */ 157 158 Return 0
159 160 161 162 /***************************************************************************/
163 /* Programma initialisatie */ 164 /***************************************************************************/
165 ProgrammaInit: 166 167 /* Highligting */ 168 NORMAL = 0 169 BRIGHT =
1 170 UNDERSCORE = 4 171 BLINK = 5 172 REVERSE = 7 173 HIDDEN = 8 174 175
/* Type */ 176 MIXED = 10 177 UPCASE = 11 178 PROTECTED = 12 179 180 /*
Colors */ 181 DEFAULT = 30 182 RED = 31 183 GREEN = 32 184 YELLOW = 33 185
BLUE = 34 186 PINK = 35 187 TURQUOISE = 36 188 WHITE = 37 189 190 /* Action
codes */ 191 NOACTION = 40 192 TABFORWARD = 41 193 TABBACKWARD = 42 194
LOOKPROTECTED = 43 195 GOBACK = 49 196 197 /* Key codes */ 198 ENTER = '0D'x
199 TAB = '09'x 200 ESCAPE = '1B'x 201 202 PFKEY = '00'x 203 BACKTAB = '0F'x
204 PF1 = '3B'x 205 PF2 = '3C'x 206 PF3 = '3D'x 207 PF4 = '3E'x 208 PF5
= '3F'x 209 PF6 = '40'x 210 PF7 = '41'x 211 PF8 = '42'x 212 PF9 = '43'x
213 PF10 = '44'x 214 PF11 = '85'x 215 PF12 = '86'x 216 217 ARROWKEY = 'E0'x
218 ARROWUP = '48'x 219 ARROWLEFT = '4B'x 220 ARROWRIGHT = '4D'x 221 ARROWDOWN
= '50'x 222 223 224 /* Macro defines */ 225 ENEN = 1 226 TWEEEN = 2 227
DRIEEN = 3 228 VIEREN = 4 229 VIJVEN = 5 230 ZESSEN = 6 231 THREE_OF_A_KIND
= 7 232 CARRE = 8 233 FULL_HOUSE = 9 234 KLEINE_STRAAT = 10 235 GROTE_STRAAT
= 11 236 Y_A_H_T_Z_E_E = 12 237 CHANCE = 13 238 239 GOED = 21 240 FOUT =
22 241 JA = 23 242 NEE = 24 243 SPELEN = 25 244 WORP = 26 245 246 YAHTZEE
= 31 247 HELP = 32 248 QUIT = 33 249 250 FALSE = 0 251 TRUE = 1 252 FILE_ID
= 'YAHTZEE.DAT' 253 254 /* Initialiseer de Scherm linked list header */
255 Call InitScreen 256 257 /* Kijk of het de eerste keer is en zet persoonlijk
record */ 258 REGEL = LineIn(FILE_ID) 259 If (REGEL = '') Then Do 260 PERSREC
= 0 261 SPELPARAMETER = 'N' 262 End; Else Do 263 Parse Var REGEL SPELTEL
. . PERSREC . 264 If (SPELTEL = 0) Then 265 SPELPARAMETER = 'N' 266 End
/* If */ 267 268 Call Stream FILE_ID,'C','Close' 269 270 /* Initialiseer
tellers voor een niew spel */ 271 If (SPELPARAMETER = 'N') Then Do 272 Call
RxFuncAdd 'SysFileDelete', 'RexxUtil', 'SysFileDelete' 273 Call SysFileDelete
FILE_ID 274 Call RxFuncDrop 'SysFileDelete' 275 DS1 = Random(1,6) 276 DS2
= Random(1,6) 277 DS3 = Random(1,6) 278 DS4 = Random(1,6) 279 DS5 = Random(1,6)
280 Call LineOut FILE_ID, '39 2 0 'PERSREC' 'DS1' 'DS2' 'DS3' 'DS4' 'DS5
281 Call LineOut FILE_ID, '-1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 0 0 0'
282 Call LineOut FILE_ID, '-1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 0 0 0'
283 Call LineOut FILE_ID, '-1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 0 0 0'
284 Call Stream FILE_ID,'C','Close' 285 End /* If */ 286 287 /* Teken de
vaste velden op het scherm */ 288 Call ConField 0 2 BRIGHT BLUE 'YZ-pc3270'
289 290 Call ConField 0 21 BRIGHT BLUE, 291 '***___P_E_R_S_O_O_N_L_I_J_K___R_E_C_O_R_D___*'
292 293 Call ConField 0 69 BRIGHT TURQUOISE Right(PERSREC,4,0) 294 295 Call
ConField 0 76 BRIGHT BLUE '***' 296 297 Call ConField 1 0 BRIGHT BLUE Copies('=',79)
298 299 Call ConField 3 2 BRIGHT BLUE 'NR__KEUZE' 300 301 Call ConField
3 28 BRIGHT BLUE, 302 'KOL_1_____KOL_2_____KOL_3_______TOTAAL_SCORE' 303
304 Call ConField 5 3 BRIGHT BLUE '1__E_N_E_N_________:' 305 306 Call ConField
6 3 BRIGHT BLUE '2__T_W_E_E_E_N_____:' 307 308 Call ConField 7 3 BRIGHT
BLUE '3__D_R_I_E_E_N_____:' 309 310 Call ConField 8 3 BRIGHT BLUE '4__V_I_E_R_E_N_____:'
311 312 Call ConField 9 3 BRIGHT BLUE '5__V_I_J_V_E_N_____:' 313 314 Call
ConField 10 3 BRIGHT BLUE '6__Z_E_S_S_E_N_____:' 315 316 Call ConField 11
56 BRIGHT BLUE '---_BONUS_INDICATIE_---' 317 318 Call ConField 13 3 BRIGHT
BLUE '7__THREE_OF_A_KIND_:' 319 320 Call ConField 14 3 BRIGHT BLUE '8__CARRE___________:'
321 322 Call ConField 15 3 BRIGHT BLUE '9__FULL_HOUSE______:' 323 324 Call
ConField 16 2 BRIGHT BLUE '10__KLEINE_STRAAT___:' 325 326 Call ConField
17 2 BRIGHT BLUE '11__GROTE_STRAAT____:' 327 328 Call ConField 18 2 BRIGHT
BLUE '12__Y_A_H_T_Z_E_E___:' 329 330 Call ConField 19 2 BRIGHT BLUE '13__CHANCE__________:'
331 332 Call ConField 20 58 BRIGHT BLUE 'GEGOOID_:' 333 334 Call ConField
22 0 BRIGHT BLUE Copies('=',79) 335 336 Call ConField 23 0 BRIGHT BLUE '(C)_Frans_Fokkenrood'
337 338 /* Lees de spelwaarden in */ 339 REGEL = LineIn(FILE_ID) 340 Parse
Var REGEL SPELTEL WORPTEL SCORE PERSREC DS1 DS2 DS3 DS4 DS5 . 341 342 Do
K = 1 To 3 343 REGEL = LineIn(FILE_ID) 344 345 Do S = 1 To 13 346 Parse
Var REGEL VAKJE.K.S REGEL 347 348 If (VAKJE.K.S = -1) Then 349 Iterate 350
351 If (S < 7) Then 352 Call ConField S+4 K*10+18 BRIGHT TURQUOISE Right(VAKJE.K.S,4,'_')
353 Else 354 Call ConField S+6 K*10+18 BRIGHT TURQUOISE Right(VAKJE.K.S,4,'_')
355 356 End /* Do */ 357 358 Parse Var REGEL TOTAAL.K YZ.K BONUS.K 359 360
End /* Do */ 361 362 Call Stream FILE_ID,'C','Close' 363 364 /* Initialiseer
programma variabelen */ 365 KOLOM = '.' 366 SPEL = '..' 367 INVOER = WORP
368 ROW = 21 369 COLUMN = 69 370 371 If (SPELTEL > 9) Then 372 Call ConField
23 24 BRIGHT TURQUOISE, 373 '___________**___'SPELTEL'__SPELEN___*___'WORPTEL'__KEER__DOBBELEN___**'
374 Else 375 Call ConField 23 24 BRIGHT TURQUOISE, 376 '____________**___'SPELTEL'__SPELEN___*___'WORPTEL'__KEER__DOBBELEN___**'
377 378 Call RxFuncAdd 'SysGetKey', 'RexxUtil', 'SysGetKey' 379 380 Return
0 381 382 383 384 /***************************************************************************/
385 /* Verwerking bij afsluiting van het programma */ 386 /***************************************************************************/
387 VerwerkQuit: 388 389 PERSREC = Max(SCORE,PERSREC) 390 391 Call RxFuncAdd
'SysFileDelete', 'RexxUtil', 'SysFileDelete' 392 Call SysFileDelete FILE_ID
393 Call RxFuncDrop 'SysFileDelete' 394 395 Call LineOut FILE_ID, SPELTEL
WORPTEL SCORE PERSREC DS1 DS2 DS3 DS4 DS5 396 397 Do K = 1 To 3 398 REGEL
= '' 399 400 Do S = 1 To 13 401 REGEL = REGEL' 'VAKJE.K.S 402 End /* Do
*/ 403 404 REGEL = REGEL' 'TOTAAL.K' 'YZ.K' 'BONUS.K 405 406 Call LineOut
FILE_ID, REGEL 407 408 End /* Do */ 409 410 Call Stream FILE_ID,'C','Close'
411 412 Call RxFuncDrop 'SysGetKey' 413 414 Call CharOut,ESCAPE'[2J' 415
416 Return 0 417 418 419 420 /***************************************************************************/
421 /* Verwerking Spel */ 422 /***************************************************************************/
423 VerwerkSpel: 424 425 OGEN. = 0 426 427 OGEN.DS1 = OGEN.DS1 + 1 428 OGEN.DS2
= OGEN.DS2 + 1 429 OGEN.DS3 = OGEN.DS3 + 1 430 OGEN.DS4 = OGEN.DS4 + 1 431
OGEN.DS5 = OGEN.DS5 + 1 432 433 OGEN = OGEN.1||OGEN.2||OGEN.3||OGEN.4||OGEN.5||OGEN.6
434 435 If (Pos('5',OGEN) > 0) Then 436 YAHTZEE = JA 437 Else 438 YAHTZEE
= NEE 439 440 K = KOLOM 441 S = SPEL 442 PUNTEN = 0 443 444 /* Reken de
mogelijke PUNTEN uit, afhankelijk van het gekozen spel */ 445 Select 446
When (S < 7) Then Do 447 If (YAHTZEE = JA) Then 448 PUNTEN = S * 5 * K 449
Else 450 PUNTEN = S * OGEN.S * K 451 BONUS.K = BONUS.K + (PUNTEN - (3 *
S * K)) 452 End 453 454 When (S = THREE_OF_A_KIND) Then Do 455 If (Pos('3',OGEN)
> 0 | Pos('4',OGEN) > 0 | YAHTZEE = JA) Then 456 PUNTEN = (DS1 + DS2 + DS3
+ DS4 + DS5) * K 457 End 458 459 When (S = CARRE) Then Do 460 If (Pos('4',OGEN)
> 0 | YAHTZEE = JA) Then 461 PUNTEN = (DS1 + DS2 + DS3 + DS4 + DS5) * K
462 End 463 464 When (S = FULL_HOUSE) Then Do 465 If ((Pos('2',OGEN) > 0
& Pos('3',OGEN) > 0) | YAHTZEE = JA) Then 466 PUNTEN = 25 * K 467 End 468
469 When (S = KLEINE_STRAAT) Then Do 470 If (YAHTZEE = JA) Then 471 PUNTEN
= 30 * K 472 Else If (Pos('1111',OGEN) > 0) Then 473 PUNTEN = 30 * K 474
Else If (Pos('2111',OGEN) > 0) Then 475 PUNTEN = 30 * K 476 Else If (Pos('1211',OGEN)
> 0) Then 477 PUNTEN = 30 * K 478 Else If (Pos('1121',OGEN) > 0) Then 479
PUNTEN = 30 * K 480 Else If (Pos('1112',OGEN) > 0) Then 481 PUNTEN = 30
* K 482 End 483 484 When (S = GROTE_STRAAT) Then Do 485 If (Pos('11111',OGEN)
> 0 | YAHTZEE = JA) Then 486 PUNTEN = 40 * K 487 End 488 489 When (S = Y_A_H_T_Z_E_E)
Then Do 490 If (YAHTZEE = JA) Then Do 491 YZ.K = YZ.K + 1 492 If (YZ.K >
1) Then 493 PUNTEN = 100 * K 494 Else 495 PUNTEN = 50 * K 496 End /* If
*/ 497 End 498 499 When (S = CHANCE) Then Do 500 PUNTEN = (DS1 + DS2 + DS3
+ DS4 + DS5) * K 501 End 502 503 End /* Select */ 504 505 /* Verwerk de
PUNTEN in de score en initialiseer een nieuw spel */ 506 If (VAKJE.K.S =
-1) Then Do 507 VAKJE.K.S = PUNTEN 508 509 If (S < 7) Then 510 Call ConField
S+4 K*10+18 BRIGHT TURQUOISE Right(VAKJE.K.S,4,'_') 511 Else 512 Call ConField
S+6 K*10+18 BRIGHT TURQUOISE Right(VAKJE.K.S,4,'_') 513 End /* If */ 514
515 TOTAAL.K = TOTAAL.K + PUNTEN 516 SCORE = SCORE + PUNTEN 517 518 DS1
= Random(1,6) 519 DS2 = Random(1,6) 520 DS3 = Random(1,6) 521 DS4 = Random(1,6)
522 DS5 = Random(1,6) 523 524 KOLOM = '.' 525 SPEL = '..' 526 INVOER = WORP
527 528 If (SPELTEL > 0) Then Do 529 ROW = 21 530 COLUMN = 69 531 If (SPELTEL
> 9) Then 532 Call ConField 23 24 BRIGHT TURQUOISE, 533 '___________**___'SPELTEL'__SPELEN___*___'WORPTEL'__KEER__DOBBELEN___**'
534 Else 535 Call ConField 23 24 BRIGHT TURQUOISE, 536 '____________**___'SPELTEL'__SPELEN___*___'WORPTEL'__KEER__DOBBELEN___**'
537 End; Else Do 538 ROW = 23 539 COLUMN = 79 540 Call ConField 23 24 BRIGHT
RED, 541 '____________________________**___G_A_M_E___O_V_E_R___**' 542 End
/* If */ 543 544 Return 0 545 546 547 548 /***************************************************************************/
549 /* Verwerking Worp */ 550 /***************************************************************************/
551 VerwerkWorp: 552 553 If (SPELTEL < 1) Then Do 554 ROW = 23 555 COLUMN
= 79 556 Call ConField 23 24 BRIGHT RED, 557 '____________________________**___G_A_M_E___O_V_E_R___**'
558 Return 0 559 End /* If */ 560 561 OPNIEUW = 0 562 WORP.1 = FIELD.1.5
563 WORP.2 = FIELD.2.5 564 WORP.3 = FIELD.3.5 565 WORP.4 = FIELD.4.5 566
WORP.5 = FIELD.5.5 567 568 If (WORP.1 = '/' | WORP.1 = 'x') Then Do 569
DS1 = Random(1,6) 570 OPNIEUW = OPNIEUW + 1 571 End /* If */ 572 573 If
(WORP.2 = '/' | WORP.2 = 'x') Then Do 574 DS2 = Random(1,6) 575 OPNIEUW
= OPNIEUW + 1 576 End /* If */ 577 578 If (WORP.3 = '/' | WORP.3 = 'x')
Then Do 579 DS3 = Random(1,6) 580 OPNIEUW = OPNIEUW + 1 581 End /* If */
582 583 If (WORP.4 = '/' | WORP.4 = 'x') Then Do 584 DS4 = Random(1,6) 585
OPNIEUW = OPNIEUW + 1 586 End /* If */ 587 588 If (WORP.5 = '/' | WORP.5
= 'x') Then Do 589 DS5 = Random(1,6) 590 OPNIEUW = OPNIEUW + 1 591 End /*
If */ 592 593 WORPTEL = WORPTEL - 1 594 595 If (OPNIEUW = 0 | WORPTEL =
0) Then Do 596 SPELTEL = SPELTEL - 1 597 WORPTEL = 2 598 INVOER = SPELEN
599 ROW = 21 600 COLUMN = 66 601 Call ConField 23 24 BRIGHT TURQUOISE, 602
'__________________________________**___K_I_E_Z_E_N___**' 603 End; Else
Do 604 ROW = 21 605 COLUMN = 69 606 If (SPELTEL > 9) Then 607 Call ConField
23 24 BRIGHT TURQUOISE, 608 '___________**___'SPELTEL'__SPELEN___*___'WORPTEL'__KEER__DOBBELEN___**'
609 Else 610 Call ConField 23 24 BRIGHT TURQUOISE, 611 '____________**___'SPELTEL'__SPELEN___*___'WORPTEL'__KEER__DOBBELEN___**'
612 End /* If */ 613 614 Return 0 615 616 617 618 /***************************************************************************/
619 /* Verwerking Yahtzee spel */ 620 /***************************************************************************/
621 622 VerwerkYahtzee: 623 624 If (INVOER = WORP) Then 625 Call VerwerkWorp
626 Else 627 Call VerwerkSpel 628 629 Return 0 630 631 632 633 /***************************************************************************/
634 /* Stuur het spelscherm naar het beeldscherm van de PC */ 635 /***************************************************************************/
636 ZendScherm: 637 638 /* Teken de variable velden op het scherm */ 639
If (SCORE <= PERSREC ) Then 640 Call ConField 5 64 BRIGHT TURQUOISE Right(SCORE,4,0)
641 Else 642 Call ConField 5 60 BRIGHT RED '** 'Right(SCORE,4,0)' **' 643
644 Call ConField 12 58 BRIGHT TURQUOISE Right(BONUS.1,4,'_') 645 Call ConField
12 64 BRIGHT TURQUOISE Right(BONUS.2,4,'_') 646 Call ConField 12 70 BRIGHT
TURQUOISE Right(BONUS.3,4,'_') 647 648 Call ConField 20 69 BRIGHT TURQUOISE
DS1'_'DS2'_'DS3'_'DS4'_'DS5 649 650 If (INVOER = WORP) Then Do 651 Call
ConField 21 15 BRIGHT BLUE 'TOTAAL_:__' 652 Call ConField 21 28 BRIGHT TURQUOISE
Right(TOTAAL.1,4,'_')'______' 653 Call ConField 21 38 BRIGHT TURQUOISE Right(TOTAAL.2,4,'_')'______'
654 Call ConField 21 48 BRIGHT TURQUOISE Right(TOTAAL.3,4,'_')'______' 655
Call ConField 21 58 BRIGHT BLUE 'OPNIEUW_:_' 656 Call ConField 21 68 BRIGHT
BLUE '__________' 657 End; Else Do 658 Call ConField 21 15 BRIGHT BLUE '__________'
659 Call ConField 21 28 BRIGHT BLUE '__________' 660 Call ConField 21 38
BRIGHT BLUE 'VUL_KEUZE_' 661 Call ConField 21 48 BRIGHT BLUE 'IN_===>___'
662 Call ConField 21 58 BRIGHT BLUE 'NUMMER:___' 663 Call ConField 21 68
BRIGHT BLUE '__KOLOM:__' 664 End /* If */ 665 666 /*************************************************************************/
667 /* Teken de intikbare velden op het scherm */ 668 /*************************************************************************/
669 If (INVOER = WORP) Then Do 670 WORP. = '.' 671 Call DropField 21 77
672 Call DropField 21 66 673 Call VarField 21 69 BRIGHT GREEN WORP.1 1 674
Call VarField 21 71 BRIGHT GREEN WORP.2 1 675 Call VarField 21 73 BRIGHT
GREEN WORP.3 1 676 Call VarField 21 75 BRIGHT GREEN WORP.4 1 677 Call VarField
21 77 BRIGHT GREEN WORP.5 1 678 End; Else Do 679 Call DropField 21 77 680
Call DropField 21 75 681 Call DropField 21 73 682 Call DropField 21 71 683
Call DropField 21 69 684 Call VarField 21 66 BRIGHT GREEN Translate(SPEL,'.','
') 2 685 Call VarField 21 77 BRIGHT GREEN Translate(KOLOM,'.',' ') 1 686
End /* If */ 687 688 Call Display 689 690 Return 0 691 692 693 694 /***************************************************************************/
695 /* Subroutine to Initialize the screen */ 696 /***************************************************************************/
697 InitScreen: 698 699 Call CharOut,ESCAPE'[2J' /* CLS */ 700 701 SCREEN_ROWS
= 25 702 SCREEN_COLUMNS = 80 703 704 FIELD. = '' 705 FIELD.0 = 0 706 707
Return 0 708 709 710 711 /***************************************************************************/
712 /* Subroutine to place Constant field on the screen */ 713 /***************************************************************************/
714 ConField: 715 Parse Arg XROW XCOLUMN INTENSITY COLOR STRING 716 717
Call CharOut,ESCAPE'['INTENSITY';'COLOR'm' 718 Call CharOut,ESCAPE'['XROW+1';'XCOLUMN+1'H'Translate(STRING,'
','_') 719 720 Return 0 721 722 723 724 /***************************************************************************/
725 /* Subroutine to place Variable field on the screen */ 726 /***************************************************************************/
727 VarField: 728 Parse Arg XROW XCOLUMN INTENSITY COLOR STRING LENGTE 729
730 /* Find the location of the field structure within the list */ 731 Do
i=1 To FIELD.0 732 If (XROW = FIELD.i.1 & XCOLUMN = FIELD.i.2) Then 733
Leave 734 End /* Do */ 735 736 /* Register the parameters of the variable
field definition */ 737 FIELD.i.1 = XROW 738 FIELD.i.2 = XCOLUMN 739 FIELD.i.3
= INTENSITY 740 FIELD.i.4 = COLOR 741 FIELD.i.5 = STRING 742 FIELD.i.6 =
LENGTE 743 744 If (i > FIELD.0) Then 745 FIELD.0 = FIELD.0 + 1 746 747 Return
0 748 749 750 751 /***************************************************************************/
752 /* Subroutine to Display the screen */ 753 /***************************************************************************/
754 Display: 755 756 /* Print the content of the variable fields on the
screen */ 757 Do i=1 To FIELD.0 758 Call CharOut,ESCAPE'['FIELD.i.3';'FIELD.i.4'm'
759 Call CharOut,ESCAPE'['FIELD.i.1+1';'FIELD.i.2+1'H'FIELD.i.5 760 End
/* Do */ 761 762 /* Locate the cursor on its initial position */ 763 /*
Look If cursor is located in an unprotected area of the screen */ 764 Call
CharOut,ESCAPE'['ROW+1';'COLUMN+1'H' 765 766 PCH = 0 767 PROTECTED = TRUE
768 769 Do i=1 To FIELD.0 770 If (ROW = FIELD.i.1 & COLUMN >= FIELD.i.2
& COLUMN < FIELD.i.2+FIELD.i.6) Then Do 771 PCH = COLUMN - FIELD.i.2 + 1
772 PROTECTED = FALSE 773 Leave 774 End /* If */ 775 End /* Do */ 776 777
/* Accept keystrokes from the keyboard until an Attention Key is pressed
*/ 778 /* First determine which key is pressed, then select its action.
*/ 779 780 READY = FALSE 781 Do While (READY = FALSE) 782 KEY = SysGetKey('NOECHO')
783 /* Determine the KEY type and its value */ 784 Select 785 When (KEY
= ENTER) Then 786 ACTION = GOBACK 787 788 When (KEY = TAB) Then 789 ACTION
= TABFORWARD 790 791 When (KEY = PFKEY) Then Do 792 KEY = SysGetKey('NOECHO')
793 If (KEY = BACKTAB) Then 794 ACTION = TABBACKWARD 795 Else 796 ACTION
= GOBACK 797 End 798 799 When (KEY = ESCAPE) Then Do 800 KEY = PF3 801 ACTION
= GOBACK 802 End 803 804 When (KEY = ARROWKEY) Then Do 805 KEY = SysGetKey('NOECHO')
806 Select 807 When (KEY = ARROWUP) Then Do 808 ROW = ROW - 1 809 If (ROW
< 0) Then Do 810 ROW = SCREEN_ROWS - 1 811 COLUMN = COLUMN - 1 812 End /*
If */ 813 ACTION = LOOKPROTECTED 814 End 815 When (KEY = ARROWDOWN) Then
Do 816 ROW = ROW + 1 817 If (ROW >= SCREEN_ROWS) Then Do 818 ROW = 0 819
COLUMN = COLUMN + 1 820 End /* If */ 821 ACTION = LOOKPROTECTED 822 End
823 When (KEY = ARROWRIGHT) Then Do 824 COLUMN = COLUMN + 1 825 If (COLUMN
>= SCREEN_COLUMNS) Then Do 826 ROW = ROW + 1 827 COLUMN = 0 828 End /* If
*/ 829 ACTION = LOOKPROTECTED 830 End 831 When (KEY = ARROWLEFT) Then Do
832 COLUMN = COLUMN - 1 833 If (COLUMN < 0) Then Do 834 ROW = ROW + 1 835
COLUMN = SCREEN_COLUMNS - 1 836 End /* If */ 837 ACTION = LOOKPROTECTED
838 End 839 Otherwise 840 Beep(440,500) 841 ACTION = NOACTION 842 End /*
Select */ 843 End 844 845 Otherwise 846 If (PROTECTED = TRUE) Then Do 847
Beep(440,500) 848 ACTION = NOACTION 849 End; Else Do 850 Call CharOut,KEY
851 FIELD.i.5 = Overlay(KEY,FIELD.i.5,PCH) 852 PCH = PCH + 1 853 COLUMN
= COLUMN + 1 854 If (COLUMN < FIELD.i.2 + FIELD.i.6) Then 855 ACTION = NOACTION
856 Else 857 ACTION = TABFORWARD 858 End /* If */ 859 860 End /* Select
*/ 861 862 863 /* Select the appropriate action */ 864 Select 865 When (ACTION
= NOACTION) Then 866 Nop 867 868 When (ACTION = TABFORWARD) Then Do 869
If (i < FIELD.0) Then 870 i = i + 1 871 Else 872 i = 1 873 If (FIELD.0 >
0) Then Do 874 ROW = FIELD.i.1 875 COLUMN = FIELD.i.2 876 PCH = 1 877 PROTECTED
= FALSE 878 Call CharOut,ESCAPE'['ROW+1';'COLUMN+1'H' 879 End; Else Do 880
PCH = 0 881 Beep(440,500) 882 End /* If */ 883 End 884 885 When (ACTION
= TABBACKWARD) Then Do 886 If (i > 1) Then 887 i = i - 1 888 Else 889 i
= FIELD.0 890 If (FIELD.0 > 0) Then Do 891 ROW = FIELD.i.1 892 COLUMN =
FIELD.i.2 893 PCH = 1 894 PROTECTED = FALSE 895 Call CharOut,ESCAPE'['ROW+1';'COLUMN+1'H'
896 End; Else Do 897 PCH = 0 898 Beep(440,500) 899 End /* If */ 900 End
901 902 When (ACTION = LOOKPROTECTED) Then Do 903 Call CharOut,ESCAPE'['ROW+1';'COLUMN+1'H'
904 PROTECTED = TRUE 905 Do j=1 To FIELD.0 906 If (ROW = FIELD.j.1 & COLUMN
>= FIELD.j.2 & COLUMN < FIELD.j.2+FIELD.j.6) Then Do 907 PCH = COLUMN -
FIELD.j.2 + 1 908 PROTECTED = FALSE 909 i = j 910 Leave 911 End /* If */
912 End /* Do */ 913 End 914 915 When (ACTION = GOBACK) Then Do 916 KEYPRESSED
= KEY 917 READY = TRUE 918 End 919 920 End /* Select */ 921 922 End /* Do
*/ 923 924 Return 0 925 926 927 928 /***************************************************************************/
929 /* Subroutine to Drop a field from the list of fields */ 930 /***************************************************************************/
931 DropField: 932 Arg XROW XCOLUMN 933 934 /* If the list of fields is
already empty then Return */ 935 If (FIELD.0 = 0) Then 936 Return 0 937
938 939 /* Find the location of the field structure within the list */ 940
Do i=1 To FIELD.0 941 If (XROW = FIELD.i.1 & XCOLUMN = FIELD.i.2) Then 942
Leave 943 End /* Do */ 944 945 946 /* If no field could be found then Return
*/ 947 If (i > FIELD.0) Then 948 Return 0 949 950 951 /* Else remove the
field from the list depending on its position */ 952 Do j=i+1 To FIELD.0
953 FIELD.i.1 = FIELD.j.1 954 FIELD.i.2 = FIELD.j.2 955 FIELD.i.3 = FIELD.j.3
956 FIELD.i.4 = FIELD.j.4 957 FIELD.i.5 = FIELD.j.5 958 FIELD.i.6 = FIELD.j.6
959 i = j 960 End /* Do */ 961 962 /* Update the Field counter in the screen
structure */ 963 FIELD.0 = FIELD.0 - 1 964 965 Return 0 966 967 968 969
/***** (C) Frans Fokkenrood - Januari 2001 *********************************/
]]>
|
Webdesign |
|
  
Heb je een Hosting?
Geef hier jouw mening over jouw web hosting
Webadres.info: Goede domeinnaam kiezen
Gesponsorde links:
Budget Webhosting
Web2host.nl
10eurohost.nl
Denit Hosting Solutions
YourHosting.nl
Starthosting.nl
Eduvision.nl
Educruitment.nl
Webadres.info
De link top 5:
Gratis Computercursussen
WebmasterStartpagina
MijnStartpagina.nu
Bluebird Animatie
Anouksweb
Link aanmelden
Alle Partners
Webmasterwoordenboek
A | B | C | D | E | F
G | H | I | J | K | L | M
N | O | P | Q | R | S | T
U | V | W | X | Y | Z
Films vanavond op Tv:
De klok:
(advertentie)
HTML leren
PHP cursus
XML lessen
XHTML les
CSS leer
leer C
REXX online
Red Hat Linux cursus
|
