\ rand.fs 
\ Version 2026-06-12 Copyright Gan Uesi Starling
\ License: None. Free for all uses.
\ Pseudo-Random Number Generators converted from C
\ Reference https://filterpaper.github.io/prng.html

\ A COLLECTION OF QUALITY PRNG WORDS KEPT AS EXAMPLES
\ THIS FILE NO LONGER CALLED AS PART OF FYBB

[THEN]

INCLUDE ./defs.fs

\ XOR-SHIFT WITH SEED

\ N-bit XOR Shift for 8, 16, 32, whatever-bit systems
\ Mask output as needed $FF, $FFFF, $FFFFFF...

VARIABLE rand_seed
123456789123456789 rand_seed ! \ Overflow by intent

CELL 8 * 1 RSHIFT 1 OR CONSTANT XS_A 
CELL 3 * 1 RSHIFT 1 OR CONSTANT XS_B 
CELL 5 * 1 RSHIFT 1 OR CONSTANT XS_C 

: random ( -- n )
  rand_seed @ 
  DUP XS_A LSHIFT XOR 
  DUP XS_B RSHIFT XOR 
  DUP XS_C LSHIFT XOR 
  DUP rand_seed !  
;

\ FIXED BIT-WIDTH XOR SHIFT WITH SEED

\ 8-bit XOR Shift
VARIABLE seed_08
123 seed_08 !

\ 8-bit Xorshift
: xorshift.08 ( -- n )
    seed_08 @       
    DUP 7 LSHIFT XOR 
    DUP 5 RSHIFT XOR 
    DUP 3 LSHIFT XOR
    DUP seed_08 !
;

\ 16-bit XOR Shift
VARIABLE seed_16
12345 seed_16 !

: xorshift.16 ( -- u )
    seed_16 @
    dup 7 lshift xor
    dup 9 rshift xor
    dup 8 lshift xor
    dup seed_16 ! 
;

\ 32-bit XOR Shift
VARIABLE seed_32 
123456789 seed_32 !

: xorshift.32 ( -- n )
  seed_32 @ 
  dup 13 lshift xor
  dup 17 rshift xor
  dup 5 lshift xor
  dup seed_32 !
;

\ 64-bit XOR Shift
VARIABLE seed_64
123456789 seed_64 !

: xorshift.64 ( -- n )
  seed_64 @ 
  dup 13 lshift xor 
  dup 7 rshift xor 
  dup 17 lshift xor 
  dup seed_64 ! 
;

\ 8-BIT RANDOM
 
\ For use by rand.08
$F1 VALUE rand_08a
$EE VALUE rand_08b
$EE VALUE rand_08c
$EE VALUE rand_08d
$EE VALUE rand_08e

\ Rotate an 8-bit char
\ Used by rand.08
: rot.08 ( c 1-7 -- c )
  2DUP RSHIFT  ( c x c )
  -ROT 8 SWAP - LSHIFT
  OR $FF AND
;

\ JSF8 (Jenkin’s ‘chaotic’ 8-bit PRNG)
\ REF: https://burtleburtle.net/bob/rand/smallprng.html
\ Pattern-free up to 2^29 bytes
: rand.08 ( -- u )
  rand_08c 4 rot.08
  rand_08b XOR
  TO rand_08a
  rand_08c rand_08d + $FF AND TO rand_08b
  rand_08d rand_08e + $FF AND TO rand_08c
  rand_08e rand_08a + $FF AND TO rand_08d
  rand_08d
;

\ 16-BIT RANDOM

1 CELLS 1 = 
[IF] 
  CR ." Oops! 8-bit system. Can't do 16-bit math unless revise for doubles as alternative. " 
  ?!
[THEN]
 
\ For use by rand.16
$F1EA VALUE rand_16a
$80CC VALUE rand_16b
$80CC VALUE rand_16c
$80CC VALUE rand_16d
$80CC VALUE rand_16e

\ Rotate a 16-bit value
\ Used by rand.16
: rot.16 ( u 1-15 -- u )
  2DUP RSHIFT  ( c x c )
  -ROT 16 SWAP - LSHIFT
  OR $FFFF AND
;

\ JSF16 (Jenkin’s 16-bit PRNG)
\ REF: https://burtleburtle.net/bob/rand/smallprng.html
\ Pattern-free up to 2^47 bytes
: rand.16 ( -- u )
  rand_16c 8 rot.16
  rand_16b XOR
  TO rand_16a
  rand_16c rand_16d + $FFFF AND TO rand_16b
  rand_16d rand_16e + $FFFF AND TO rand_16c
  rand_16e rand_16a + $FFFF AND TO rand_16d
  rand_16d 
;

1 CELLS 4 < 
[IF] 
  CR ." Oops! 16-bit system. Can't do 32-bit math unless revise for doubles as alternative. " 
  ?!
[THEN]

\ 24-BIT RANDOM ( 32-bit with MSB empty )

\ Mashup of 8- and 16-bit PRINGs (temporary fill-in)
: rand.24 ( -- u )
  rand_08a $FF AND
  CASE
     0 OF rand.16  8 LSHIFT rand.08 OR  ENDOF \ 16,8
     1 OF rand.08 16 LSHIFT rand.16 OR  ENDOF \ 8,16
    10 OF rand.08 8 LSHIFT rand.08 OR 8 LSHIFT rand.08 OR  ENDOF \ 8,8,8
    11 OF rand.16 DUP $FFFF0000 AND 8 LSHIFT
          rand.08 OR 8 LSHIFT
          SWAP $FFFF AND OR   
       ENDOF \ split 16, cramming 8 between the halves
  ENDCASE
;

\ 32-BIT RANDOM

\ Mashup of two 16-bit PRINGs (temporary fill-in)
: rand.32 ( -- u )
  rand.16 rand.16
  rand_08a 1 AND
  IF
    16 LSHIFT OR
  ELSE
    SWAP 16 LSHIFT OR
  THEN
;

\ Generate a random number in range 1..u-1
: random.range ( u u -- u )   \ max min
  BEGIN
    random
    DUP 3 PICK >        ( u u u flg )
  WHILE
  
  REPEAT                 ( u u u )

  2 PICK MOD            ( u u u )
  NIP NIP
;

\ Generate a random number in range 1..u-1
: random.range.old ( u u -- u )   \ max min
  BEGIN
    random 2 PICK MOD   ( u u u )    
    DUP 2 PICK <        ( u u u flg )
  WHILE
    DROP
  REPEAT
  NIP NIP
;

\ TESTING WORDS
\ Randomness can instead be visualized via bmp.fs

TRUE [IF] \ Make true to run tests. Uncomment specific test.

: test.rand.08
  BEGIN
    rand.08 hex u. decimal cr
    KEY 13 =
  UNTIL
;

: test.rand.16
  BEGIN
    rand.16 hex u. decimal cr
    KEY 13 =
  UNTIL
;

: test.rand.24
  CR ." Listing only very rare cases: 16 bits and below." 
  CR ." Type ENTER to quit, any other key to continue." CR
  BEGIN
    rand.24 
    DUP $FFFF < 
    IF 
      hex u. decimal cr 
    ELSE 
      DROP 
    THEN
    KEY 13 =
  UNTIL
;

: test.random.range
  CR CR ." Testing word RANDOM.RANGE from file defs.fs "
  CR ." Type ENTER to quit, any other key to continue."
  30 3 DO
    CR ." 1 < "
    I 1 random.range .
    ." < " I .
    KEY 13 = IF LEAVE THEN
  LOOP
;

\ test.rand.08
\ test.rand.16
\ test.rand.24

\ test.random.range

[THEN] \ End of file