home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l074 / 1.ddi / GALTON.TRU < prev    next >
Encoding:
Text File  |  1984-12-19  |  1.9 KB  |  87 lines
  1. ! Galton box
  2. !
  3. ! a True BASIC(tm), Inc. product
  4. !
  5. ! ABSTRACT
  6. !    This program displays the Galton box to illustrate the
  7. !    Central Limit Theorem.
  8. !
  9. !    The program uses True BASIC's animation capabilities to
  10. !    show the movement of the balls as they drop into the slots.
  11. !
  12. ! Copyright (c) 1985 by True BASIC, Inc.
  13.  
  14. SET mode "graphics"
  15. SET window  -5, 27, 0, 20
  16. DIM count(11)
  17. RANDOMIZE
  18.  
  19. SET color "red"                   ! Draw the bottom
  20. PLOT 0,0; 22,0
  21.  
  22. FOR x = 0 to 22 step 2            ! Draw the "boxes" for the balls
  23.     PLOT x,0; x,9
  24. NEXT x
  25.  
  26. SET color "green"                 ! Draw the pegs
  27. FOR r = 1 to 10
  28.     FOR c = 1 to r
  29.         CALL peg(r,c,0)
  30.     NEXT c
  31. NEXT r
  32.  
  33. SET color "yellow"                ! Draw the first ball
  34. CALL disk(ball$)
  35.  
  36. FOR b = 1 to 60
  37.     LET r,c = 1
  38.     CALL ball(r,c,ball$,0)        ! Drop a ball
  39.     FOR t = 1 to 10
  40.         CALL ball(r,c,ball$,-1)
  41.         LET r = r + 1
  42.         IF rnd < .5 then LET c = c+1   ! See to which side the ball rolls
  43.         IF t=10 then LET count(c) = count(c) + 1
  44.         CALL ball(r,c,ball$,count(c))
  45.     NEXT t
  46. NEXT b
  47.  
  48. END
  49.  
  50. SUB peg(r,c,cnt)                  ! Draws a peg
  51.  
  52.     CALL convert(r,c,x,y,cnt)
  53.     BOX AREA x - .11, x + .11, y - .11, y + .1
  54.  
  55. END SUB
  56.  
  57. SUB ball(r,c,b$,cnt)              ! Moves a ball
  58.  
  59.     CALL convert(r,c,x,y,cnt)
  60.     IF cnt < 0 then
  61.        BOX CLEAR x-.25, x+.25, y+.25, y+.75
  62.     ELSE
  63.        BOX SHOW b$ at x-.25, y+.25
  64.     END IF
  65.  
  66. END SUB
  67.  
  68. SUB convert(r,c,x,y,cnt)          ! Converts a ball's location
  69.  
  70.     IF r<11 then
  71.        LET x = 12 - r + 2*(c-1)
  72.        LET y = 20 - r
  73.     ELSE
  74.        LET x = 2*c - 1
  75.        LET y = cnt/2 - .5
  76.     END IF
  77.  
  78. END SUB
  79.  
  80. SUB disk(b$)                      ! Draw and remember the first ball
  81.  
  82.     BOX ELLIPSE 10.75,11.25,19.25,19.75
  83.     FLOOD 11,19.5
  84.     BOX KEEP 10.75, 11.55, 19.25, 19.75 in b$    ! Remember the image
  85.  
  86. END SUB
  87.