\ Vakantie opdracht - intended for 32b forth - f.i. wabiForth
\ uses: Generic Forth plus: INSTRING, UM*

0 value skip 0 value length
create pw$ 80 allot

: NIP swap drop ;

1 value seed0 0 value seed1 	\ at least one of the seeds must not be 0x0
: forthrandom ( -- rndm_val ) 	\ 55c -- Marsaglia & Brent
	seed0
	seed1 to seed0

  	dup 17 lshift xor
  	dup 14 rshift xor
  	dup 12 lshift xor
  	dup 19 rshift xor

  	dup seed1 xor to seed1 ;

\ classic Forth random
	1 value noseed
	: clasrndm  (   -- rnd ) noseed 31421 * 6927 + dup to noseed ;
	: getclrndm ( n -- rnd ) clasrndm um* nip ;

: fillseeds ( len x -- )
	3141592 * 6927 + dup	 	\ 31421 -> 3853455429 gives 0x0
	    	to seed0
	31421 * * to seed1
	8 0 do forthrandom drop		\ 4*#seeds dummy runs
	loop ;

: getrndm   ( n -- rnd ) forthrandom um* nip ;

: getnon   32 getrndm        33 +
	  dup  48 < if exit else 10 + then
	  dup  65 < if exit else 26 + then
	  dup  97 < if exit else 26 + then ;
: getcaps  26 getrndm        65 + ;
: getlower 26 getrndm        97 + ;
: getnum   10 getrndm        48 + ;

: confusing? ( char -- 0 / char -1 )
	dup s" o0O1lI|" instring  	\ <<< expand list as wanted
	-1 = if true else drop false then ;

: space4ch 1 +to skip skip 4 mod 0= if space then ;

: [getchar] ( i -- chr )
	>r begin
		r@ 0 = if getnon else
			r@ 1 = if getnum else
			    r@ 2 = if getnum else
					r@ 3 = if getcaps else
						r@ 4 = if getcaps else
							getlower
		then then then then then
		confusing?
	until rdrop ;

: CLEARPW pw$ 80 0 fill ;
: pw! ( chr ind -- ) pw$ + c! ;
: pw@ ( ind -- chr ) pw$ + c@ ;

: getchars clearpw length 0 do i [getchar] i pw! loop ;
: jumblepw \ swaps every char in password with a random position
	length 0 do
		length getrndm dup
		pw@ i pw@
		rot pw! i pw!
	loop ;
: .pw
	0 to skip
	cr ." wachtwoord: "
	length 0 do
		i pw@ emit
		space4ch
	loop ;

: .ww ( x len -- )
	dup to length
	swap fillseeds
	length 8 41 within 0= if cr ." length between 8 and 40 " abort then
	getchars
	jumblepw
	.pw ;


\ =====  randotests

create arr 48 allot
: cleararr arr 48 0 fill ;

: tst
	cleararr
	6000000 0 do
		1
		6 getrndm
		6 getrndm +
		4* arr + +!
	loop ;

: .arr
	tst cr ." seeds: " seed0 .32hex space seed1 .32hex
	11 0 do
			cr i 2 + 3 .r 2 spaces
			arr i 4* + @ .
		loop
	cr ;

: tstno
	cleararr
	6000000 0 do
		1
		6 getclrndm
		6 getclrndm +

		4* arr + +!
	loop ;

: .noarr
	tstno cr ." seed: " noseed .32hex
	11 0 do
			cr i 2 + 3 .r  2 spaces
			arr i 4* + @ .
		loop
	cr ;