home *** CD-ROM | disk | FTP | other *** search
/ RUN Flagazine Extra: Special 2 / run-special-2.zip / GALTON.BAS < prev    next >
BASIC Source File  |  1992-05-31  |  3KB  |  69 lines
  1. 1000 REM Simulatie Galtonbord GWBASIC GRAPHICS (C) B.GROOTENHUIS
  2. 1010 COMMON MENUFL%:GOSUB 1540:DIM A(16),BV(16)
  3. 1020 CLS:Y=6:U=20:R=20:K=9:T=0:G=0:FOR I=0 TO 16:A(I)=0:BV(I)=0:NEXT I
  4. 1030 AANT=800:IF GV%>300 THEN AANT=1400:IF GV%>400 THEN AANT=1600
  5. 1040 RANDOMIZE TIMER
  6. 1050 FOR M=0 TO 14:FOR N=0 TO 4*R-24 STEP 4
  7. 1060 LOCATE R,K+N:PRINT "^";:NEXT N:R=R-1:K=K+2:NEXT M
  8. 1070 FOR L=0 TO 16:PSET (3+(L+1)*PH,20.5*PV)
  9. 1080 LINE-STEP(0,PV):NEXT L
  10. 1090 LINE(0,3*PV+1)-STEP(GH%/2-2*PH,0)
  11. 1100 LOCATE 1,60:PRINT"Stop met <Esc>":LOCATE 6,1:PRINT"van de ";AANT
  12. 1110 LOCATE 3,37:PRINT"o":LOCATE 5,1:PRINT"Knikker :";T+1
  13. 1120 LINE(3+PH,21.5*PV)-STEP(16*PH,0)
  14. 1130 IF INKEY$=CHR$(27) THEN 1260
  15. 1140 LOCATE 3,37:PRINT" ":LOCATE 4,37:PRINT"o"
  16. 1150 LOCATE 4,37:PRINT" ":K=38
  17. 1160 FOR R=6 TO 20:V=2*SGN(RND -.5)
  18. 1170 LOCATE R,K+V:PRINT"o":Y=Y+2:GOSUB 1410:'SOUND 1500,.1
  19. 1180 LOCATE R,K+V:PRINT" ":GOSUB 1440:IF R<18 THEN K=K+V
  20. 1190 NEXT R:Y=6
  21. 1200 LOCATE 21,K+V:PRINT"o"
  22. 1210 LOCATE 21,K+V:PRINT" ":LOCATE 22,K+V-1:PRINT"o":PS=K+V-1
  23. 1220 Q=(PS-3)/4:LOCATE 22,PS:PRINT" ":A(Q)=A(Q)+1:SOUND 50+A(Q)*10,1
  24. 1230 IF Q MOD 2=0 THEN LOCATE 23,PS-1:PRINT A(Q):GOTO 1250
  25. 1240 LOCATE 24,PS-1:PRINT A(Q);
  26. 1250 T=T+1:IF T<AANT THEN 1110 ELSE 1260
  27. 1260 LINE(3+PH,21.5*PV)-STEP(16*PH,0):BT=T
  28. 1270 BEEP:LOCATE 1,60:PRINT "Druk een toets in."
  29. 1280 WHILE INKEY$="":WEND
  30. 1290 FOR T=1 TO 20:LOCATE T,1:PRINT STRING$(78,32);:NEXT T
  31. 1300 FOR P=6 TO 66 STEP 4:G=G+1:HB=A(G):IF HB=0 THEN 1320
  32. 1310 FOR I=1 TO HB:LINE(7+G*PH,12+20*PV-I)-STEP(PH/4,0):NEXT I
  33. 1320 NEXT P:GOSUB 1460
  34. 1330 LOCATE 1,1:PRINT"Links :":LOCATE 1,55:PRINT"Rechts :"
  35. 1340 LOCATE 2,1:PRINT"geproduceerde verdeling."
  36. 1350 LOCATE 2,55:PRINT"binomiale verdeling."
  37. 1360 LOCATE 4,55:PRINT"Nog een keer (J/N) ?"
  38. 1370 INV$=INPUT$(1):INV=INSTR("JNjn",INV$):IF INV=0 THEN 1370
  39. 1380 IF INV MOD 2=1 THEN 1020
  40. 1390 CLS:SCREEN 0:IF MENUFL% THEN 120
  41. 1400 END
  42. 1410 IF T>9 THEN 1430
  43. 1420 WL!=TIMER:WHILE TIMER<WL!+.1:WEND
  44. 1430 LOCATE 3,Y:PRINT "o":RETURN
  45. 1440 LOCATE 3,Y:PRINT " ":RETURN
  46. 1450 REM BEREKENING BINOMIALE VERDELING
  47. 1460 BV(1)=BT:FOR I=2 TO 16:BV=0
  48. 1470 FOR J=1 TO I-1:W=BV(J)/2:BV(J)=BV+W:BV=W
  49. 1480 NEXT J:BV(I)=BV:NEXT I
  50. 1490 REM TEKENEN BINOMIALE VERDELING
  51. 1500 G=0:FOR P=6 TO 66 STEP 4:G=G+1:HB=INT(BV(G)+.5):IF HB=0 THEN 1520
  52. 1510 FOR I=1 TO HB:LINE(PH/2+7+G*PH,12+20*PV-I)-STEP(PH/4,0),,,&HCCCC:NEXT I
  53. 1520 NEXT P:RETURN
  54. 1530 REM SCREEN MODE OPVRAGEN
  55. 1540 KEY OFF:CLS:SCREEN 0:MD=12:ON ERROR GOTO 1560
  56. 1550 SCREEN MD:IF MD=0 THEN 1640:ELSE 1570
  57. 1560 MD=MD-1:RESUME 1550
  58. 1570 WINDOW SCREEN(0,0)-(1,1):GH%=PMAP(1,0)+1:GV%=PMAP(1,1)+1:WINDOW
  59. 1580 PV=8:PH=32:IF GH%=720 THEN PV=14:PH=36
  60. 1590 IF GV%>=300 THEN PV=14:IF GV%>400 THEN PV=16
  61. 1600 ON ERROR GOTO 0:RETURN
  62. 1610 PV=8:PH=32:IF GH%=720 THEN PV=14:PH=36
  63. 1620 IF GV%>=300 THEN PV=14:IF GV%>400 THEN PV=16
  64. 1630 RETURN
  65. 1640 PRINT"Grafische mode niet aanspeekbaar.  <Esc> voor menu."
  66. 1650 WHILE INKEY$<>CHR$(27):WEND
  67. 1660 GOTO 1390
  68. 20000 REM EIND GALTON
  69.