home *** CD-ROM | disk | FTP | other *** search
/ RUN Flagazine: Run 2 / run2.zip / BEROERA.BAS < prev    next >
BASIC Source File  |  2014-09-03  |  3KB  |  58 lines
  1. 100 REM BEROEPENRADEN GWBASIC MONO
  2. 110 CLS:KEY OFF:RANDOMIZE -TIMER:K=20:DIM A$(K)
  3. 120 DEF SEG=0:POKE 1047,PEEK(1047) OR 64
  4. 130 FOR A=0 TO K:READ A$(A):NEXT A
  5. 140 LOCATE 1,30:COLOR 19,0:PRINT "**";:COLOR 7,0
  6. 150 PRINT "Beroepen raden";:COLOR 19,0:PRINT "**";:COLOR 7,0
  7. 160 A$=A$(INT(RND*K)):DIM X(LEN(A$)):Q=1:D$=A$
  8. 170 FOR J=1 TO LEN(A$)
  9. 180 X(J)=INT(RND(1)*LEN(A$)+1)
  10. 190 FOR T=1 TO J-1:IF X(J)=X(T) THEN R=1
  11. 200 NEXT T:IF R=1 THEN R=0:GOTO 180
  12. 220 P$=P$+MID$(A$,X(J),1):NEXT J
  13. 230 LOCATE 10,4:PRINT CHR$(218):LOCATE 15,4:PRINT CHR$(218)
  14. 240 FOR A=1 TO LEN(A$)-1
  15. 250 LOCATE 10,Q+4:PRINT STRING$(3,196)CHR$(194);
  16. 260 LOCATE 15,Q+4:PRINT STRING$(3,196)CHR$(194);
  17. 270 Q=Q+4:NEXT A
  18. 280 LOCATE 10,Q+4:PRINT STRING$(3,196)CHR$(191)
  19. 290 LOCATE 15,Q+4:PRINT STRING$(3,196)CHR$(191)
  20. 300 Q=0:FOR A=1 TO LEN(A$)+1
  21. 310 LOCATE 11,Q+4:PRINT CHR$(179):LOCATE 16,Q+4:PRINT CHR$(179)
  22. 320 Q=Q+4:NEXT A
  23. 330 LOCATE 12,4:PRINT CHR$(192):LOCATE 17,4:PRINT CHR$(192)
  24. 340 Q=1:FOR A=1 TO LEN(A$)-1
  25. 350 LOCATE 12,Q+4:PRINT STRING$(3,196)CHR$(193)
  26. 360 LOCATE 17,Q+4:PRINT STRING$(3,196)CHR$(193):Q=Q+4:NEXT A
  27. 370 LOCATE 12,Q+4:PRINT STRING$(3,196)CHR$(217)
  28. 380 LOCATE 17,Q+4:PRINT STRING$(3,196)CHR$(217):Q=2
  29. 390 FOR A=1 TO LEN(A$):LOCATE 11,Q+4:PRINT MID$(P$,A,1)
  30. 400 Q=Q+4:NEXT A:Q=2
  31. 410 B=B+1:LOCATE 20,15:PRINT "Welk beroep of <Enter> ";
  32. 430 IF B=LEN(A$)-3 THEN BEEP:Q=1:PRINT "NIET GERADEN!":GOTO 500
  33. 440 LINE INPUT R$:IF R$=A$ THEN Q=1:SOUND 1500,5:GOTO 490
  34. 450 X=X+1:LOCATE 16,Q+4:PRINT MID$(A$,X,1):Q=Q+4
  35. 460 FOR A=1 TO LEN(A$)
  36. 470 IF INSTR(MID$(D$,X,1),MID$(P$,A,1))<>0 THEN GOSUB 530 ELSE NEXT
  37. 480 GOTO 410
  38. 490 LOCATE 22,15:PRINT "Geraden in";X;"beurt(en)"
  39. 491 I$=INKEY$:IF I$="" THEN 491 ELSE RUN
  40. 500 FOR A=1 TO LEN(A$):LOCATE 11,Q+4:PRINT STRING$(3,219):Q=Q+4
  41. 510 NEXT A:Q=2:COLOR 19,0:FOR A=1 TO LEN(A$):LOCATE 16,Q+4
  42. 520 PRINT MID$(A$,A,1):Q=Q+4:NEXT A:COLOR 7,0:LOCATE 1,1:GOTO 491
  43. 530 P$=MID$(P$,1,A-1)+" "+MID$(P$,A+1)
  44. 540 LOCATE 11,1+(A*4):PRINT STRING$(3,219):RETURN
  45. 550 DATA "FYSIOTHERAPEUT","ONDERHOUDSMONTEUR","TAMBOERMAJOOR"
  46. 560 DATA "PALEONTOLOOG","ADMINISTRATEUR","KRAAMVERPLEEGSTER"
  47. 570 DATA "ARCHEOLOOG","SYSTEEMPROGRAMMEUR","SYSTEEMANALIST"
  48. 580 DATA "SUPERMARKTMANAGER","POLITIECOMMISSARIS","EDELSMID"
  49. 590 DATA "PARAPSYCHOLOOG","FILMOPERATEUR","OPMAAKREDAKTEUR"
  50. 600 DATA "ACCOUNTANT","METEOROLOOG","PLANTEZIEKTEKUNDIGE"
  51. 610 DATA "DIERENARTS","MONDHYGIENISTE","TANDARTSASSISTENTE"
  52. 620 REM /* 50/.2730,1993,1674,2525,3755,2428,0983,1517,2009,1814
  53. 630 REM /*/....1603,3225,1068,2610,2615,0760,2548,2553,1314,3487
  54. 640 REM /*/....0760,3231,1317,2552,3375,2549,2804,2898,1010,3494
  55. 650 REM /*/....3489,3063,2642,0974,3610,0462,3230,2032,3460,3126
  56. 660 REM /*/....3610,1730,2746,3953,3841,3794,3822,3752,3601,3770
  57. 670 REM Checksum...............:  127908
  58.