home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / msdos / clipper / nannws33.arc / CLOSNCTR.PRG < prev    next >
Encoding:
Text File  |  1988-11-01  |  3.2 KB  |  109 lines
  1. * Program: ClosNctr.prg
  2. * Author:  Gerry S. Braganza
  3. * Version: Clipper Summer '87
  4. * Note(s): Close_Encounters program to demonstrate a technique to
  5. *          produce pseudo-random numbers.
  6. *
  7. * Copyright (c) 1988 Nantucket Corp.
  8.  
  9. * Declare array to hold color table.
  10. DECLARE arr_color[10]
  11.  
  12. arr_color[1]="N"                  && Black.
  13. arr_color[2]="B"                  && Blue.
  14. arr_color[3]="G"                  && Green.
  15. arr_color[4]="BG"                 && Cyan.
  16. arr_color[5]="R"                  && Red.
  17. arr_color[6]="RB"                 && Magenta.
  18. arr_color[7]="GR"                 && Brown.
  19. arr_color[8]="W"                  && White.
  20. arr_color[9]="N+"                 && Gray.
  21. arr_color[10]="GR+"               && Yellow.
  22.  
  23. PUBLIC rsd, bsd, mmax
  24.  
  25. * Initialize ever-changing seed.
  26. rsd =.123456789 + SECONDS()/1000 + DAY(DATE())/10
  27.  
  28. * Initialize - prime numbers are generally good seeds.
  29. bsd = 31415821
  30.  
  31. mmax = 1000000.0                       
  32. tmp=space(0)                      && Initialize character or
  33.                                   ** string holder.
  34. CLEAR
  35.  
  36. DO WHILE .T.
  37.    FOR I=1 TO 10000
  38.       tmp = RandomChar(1)         && Call RandomChar passing 1 as
  39.                                   && size of string.
  40.        x = INT((rsd * 11) % 11)   && Random integer between
  41.                                   ** 0 and 10 for color.
  42.  
  43.        rsd=Rndm()                 && Issue another Rndm call.
  44.        a = INT((rsd * 24) % 24)   && Random integer between
  45.                                   ** 0 and 23 for row position.
  46.  
  47.        rsd=Rndm()                 && And another call!
  48.        b = INT((rsd * 80) % 80)   && Random integer between
  49.                                   ** 0 and 79 for column position.
  50.  
  51.        IF x <= 0                  && Check whether x = 0, if true
  52.           x = x + 1               && then increment for color array
  53.        ENDIF                      && position.
  54.  
  55.        y = arr_color[x]           && Assign color variable.
  56.  
  57.        IF y = "N"                 ** If color is black,
  58.           SETCOLOR("W")           && set to white.
  59.        ELSE
  60.           SETCOLOR("&y.")         && Set to appropriate color.
  61.        ENDIF
  62.  
  63.        rsd=Rndm()                 && Just one more time!
  64.        TONE(((rSD * 1000) % 1000),(((Rndm()) * 6) % 6)) && Sounds.
  65.        @ a, b SAY tmp             && Display character.
  66.  
  67.    NEXT
  68.    ?
  69.    ?
  70.    ? 'Any key to continue, Q to quit . . . '
  71.    ?
  72.    SET CONSOLE OFF
  73.    WAIT TO quit
  74.    SET CONSOLE ON
  75.    IF quit$'Qq'
  76.       EXIT                        && Let's go home.
  77.    ENDIF
  78. ENDDO
  79. @ 23,0
  80. QUIT
  81.  
  82.  
  83. * Rndm()
  84. * Generates a random value between 0 and 1
  85. *
  86. FUNCTION Rndm
  87.  
  88. * Divide the result of the equation by mmax to get a random
  89. * number between 0 and 1.
  90. rsd = ((rsd*bsd + 1) % Mmax) / Mmax
  91.  
  92. RETURN(rsd)                       && Return random number.
  93.  
  94.  
  95. * RandomChar()
  96. *
  97. FUNCTION RandomChar
  98. PARAMETERS size                   && Size of char. or string.
  99. PRIVATE i, temptext
  100. temptext = space(0)               ** Char//string place holder.
  101.  
  102. FOR i = 1 to size
  103.    rsd = Rndm(rsd)                && Call thee.
  104.    * Upper case letters A - Z.
  105.    * If you like lower case letters, change 65 to 97.
  106.    temptext = temptext + chr(26*rsd+65) 
  107. NEXT
  108. RETURN(temptext)
  109.