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