home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / tutor / l4p130 < prev    next >
Text File  |  1990-07-15  |  4KB  |  104 lines
  1.        ╔════════════════════════════════════════════════════╗
  2.        ║ Lesson 4 Part 130  F-PC 3.5 Tutorial by Jack Brown ║
  3.        ╚════════════════════════════════════════════════════╝
  4.  
  5. \ Random Case Study. - Visual Demonstration of Random Numbers.
  6. \ Original by John Somerville, Modified by Jack Brown.
  7. \ VGA users must also modify  SCREEN-PREP and RANDPLOT as shown.
  8.  
  9. \ Graphics from SMILEY.ZIP or SMILEY35.ZIP
  10.  
  11. \ FLOAD GRAPHICS           \ This line for  VGA graphics
  12. \ Remove comment above and comment the two lines below for VGA cards.
  13.   FLOAD CGA      DECIMAL   \ Both of these lines
  14.   FLOAD DMULDIV  DECIMAL   \ for CGA graphics
  15.  
  16. \ Some standard double aritmetic words built on those in DMULDIV.SEQ
  17. : UD/MOD ( ud1 ud2 -- udr udq )
  18.          0. 2SWAP UMD/MOD  ;
  19.  
  20. : UD/    ( ud1 ud2 -- udq )
  21.          UD/MOD  2SWAP 2DROP ;
  22.  
  23. : UDMOD  ( ud1 ud2 -- udr )
  24.          UD/MOD  2DROP ;
  25.  
  26. \  D. H. Lehmers Parametric multiplicative linear congruential
  27. \  random number generator is implemented as outlined in the
  28. \  October 1988 Communications of the ACM ( V 31 N 10 page 1192)
  29.      16807. 2CONSTANT A
  30. 2147483647. 2CONSTANT M
  31.     127773. 2CONSTANT Q  \ M A D/
  32.       2836. 2CONSTANT R  \ M A DMOD
  33.             2VARIABLE HI
  34.             2VARIABLE LO
  35.             2VARIABLE SEED
  36.   12345678. SEED 2!
  37.  
  38. \ Returns a full cycle double random number
  39. : DRAND ( -- drand )  \ 0 <= drand < 4,294,967,295
  40.      SEED 2@ Q UD/MOD HI 2! LO 2!
  41.      LO 2@ A D* HI 2@ R D*
  42.      2OVER 2OVER  D>
  43.      IF D- SEED 2!
  44.      ELSE D- M D+ SEED 2!
  45.      THEN  SEED 2@  ;
  46.  
  47. \ Returns single random number less than n
  48. : LRAND ( n -- rnd )  \ 0 <= rnd < n
  49.      DRAND DROP SWAP MOD ;
  50.  
  51. \ From "Starting Forth" by Leo Brodie. page 265
  52. VARIABLE (RND) HERE (RND) !    \ This is the random number generator seed.
  53. : (RANDOM)  ( -- n )
  54.          (RND) @ 31421 * 6927 + DUP (RND) ! ;
  55. : BRAND ( u1 -- u2 )  \ 0 < u2 < u1
  56.          (RANDOM) UM* SWAP DROP ;
  57.  
  58. \ From "Mastering Forth" by Tracy and Anderson  p 65.
  59. VARIABLE (SEED)  1234  (SEED) !  \ This is the random number generator seed.
  60. : RAND  ( -- rnd)
  61.           (SEED) @  5421 * 1+ DUP (SEED) ! ;
  62. : TRAND   ( u1 -- u2 ) \ 0 < u2 < u1
  63.         RAND SWAP MOD ;
  64.  
  65. \ Random Generator Selection with simple vectored execution.
  66. \ We will discuss vectored execution later in the Tutorial
  67. \ Usage:
  68. \ CHOOSE LRAND     ( selects Lehmer's generator )
  69. \ CHOOSE BRAND     ( selects Brodie's generator )
  70. \ CHOOSE TRAND     ( selects Tracy's  generator )
  71.   VARIABLE  CURRENT_GENERATOR \ VARIABLE FOR VECTORED EXECUTION
  72.  
  73. : CHOOSE  ( -- )  \ Use a new pseudo-random generator.
  74.          ' CURRENT_GENERATOR ! ;
  75.  
  76. : RANDOM  ( n -- n? ) \ Invoke the pseudo-random generator.
  77.           CURRENT_GENERATOR @ EXECUTE ;
  78.  
  79. CHOOSE BRAND   \ DEFAULT FUNCTION
  80. \ Set up Graphics + time to stablaize.
  81.   : SCREEN-PREP ( -- )  HIGH   7 TENTHS ;   \ For CGA
  82. \ : SCREEN-PREP ( -- )  VGA640 7 TENTHS ;   \ For VGA
  83.  
  84. \ 80X25 Color text mode.
  85. : C80 ( -- )   3 MODE TEXT ;
  86.  
  87. : RANDPLOT ( -- )
  88.            SCREEN-PREP
  89.            BEGIN
  90.            640 RANDOM               \ A RANDOM X-VALUE
  91.            200 RANDOM               \ A RANDOM Y-VALUE
  92. \          480 RANDOM               \ Replace above with this for VGA
  93.            1   DOT                  \ PLOT A POINT
  94. \          15  DOT                  \ Replace above with this for VGA
  95.            KEY?                     \ was a key pressed, if so pause
  96.            IF   KEY DROP KEY 13 =   \ quit if cr is pressed.
  97.            ELSE FALSE               \ continue if any other key pressed.
  98.            THEN
  99.            UNTIL C80 ;
  100.  
  101. ┌───────────────────────────────────┐
  102. │  Please move to Lesson 4 Part 140 │
  103. └───────────────────────────────────┘
  104.