\ wurstkessel tests

: test-hash
    s" wurstkessel.fs" wurst-file
    source-init state-init  roundse# roundsh# wurst-hash ;
: test-encrypt
    s" wurstkessel.fs" wurst-file s" wurstkessel.wurst" wurst-outfile
    wurst-key wurst-salt roundse# rounds# wurst-encrypt ;
: test-decrypt
    s" wurstkessel.wurst" wurst-file s" wurstkessel.fs2" wurst-outfile
    wurst-key roundse# rounds# wurst-decrypt ;
: test-rng ( n -- ) s" wurst.random" wurst-outfile rng-init
    rounds# >reads state# * swap
    0 ?DO
	rounds# wurst-rng
	message over wurst-out write-file throw
	message over erase  LOOP wurst-close ;
: out-rng ( n -- ) stdout to wurst-out \ rng-init
    rounds# >reads state# * swap
    0 ?DO
	rounds# wurst-rng
	message over wurst-out write-file throw
	message over erase  LOOP wurst-close ;

\ test for quality

[IFDEF] 'rounds
    : wurst-break  s" wurstkessel.fs" wurst-file s" wurstkessel.wurst2" wurst-outfile
	wurst-key wurst-salt roundse# roundsh# wurst-encrypt
	s" wurstkessel.fs" wurst-file roundsh# read-first drop
	s" wurstkessel.wurst2" wurst-file
	wurst-source state# wurst-in read-file throw drop
	s" wurstkessel.wurst2" wurst-file
	wurst-source state# wurst-in read-file throw drop
	wurst-state state# wurst-in read-file throw drop
	wurst-state wurst-source state# xors
	message wurst-source state# xors
	wurst-source wurst-state state# xors
	wurst-state wurst-source state# xors
	wurst-state state# wurst-in read-file throw drop
	wurst-source wurst-state state# xors
	message state# + wurst-state state# xors
	message wurst-source state# xors
	state# 0 wurst-in reposition-file throw
	s" wurstkessel.fs3" wurst-outfile roundsh# >r
	r@ encrypt-read
	r@  message swap  dup $F and 8 umin 0 ?DO
	    I 0> IF 'rounds I cells + @ execute THEN
	    dup 'round-flags Ith and IF
		swap -entropy swap
	    THEN
	LOOP 2drop
	r@ .xormsg-size
	BEGIN  0>  WHILE
		r@ encrypt-read
		r@ rounds-decrypt  r@ message>'
	REPEAT
	rdrop  wurst-close ;
[THEN]

Create rng-histogram $100 0 [DO] 0 , [LOOP]
: time-rng ( n -- ) rng-init
    0 ?DO  rounds# wurst-rng  LOOP ;
: eval-rng ( n -- )
    0 ?DO  rounds# wurst-rng
	wurst-state state# bounds ?DO
	    1 I c@ cells rng-histogram + +!  LOOP
    LOOP
    state# 0 DO rng-histogram I cells + @ . cr LOOP ;

: wurst-test test-hash test-encrypt test-decrypt ;

Create wurst-tmp state# allot

: find-same ( d -- )
    $100 0 DO
	$100 I DO
	    j rngs i rngs rot xor -rot xor swap
	    8 0 DO 2over 2over d= IF I . J . K . cr THEN 0. wurst
	    LOOP 2drop
	LOOP
    LOOP 2drop ;

s" gforth" environment? [IF] 2drop
    require fft.fs
[THEN]
s" bigforth" environment? [IF] 2drop
    include fft.fb
[THEN]

: 32>f dup $80000000 and negate or s>f 4.6566128731E-10 f* ;

: rng-fft-test ( n -- ) dup points rng-init
    rounds# >reads state# * swap
    dup 0 ?DO
	rounds# wurst-rng
	I message 2 pick bounds ?DO
	    I     32@ 32>f
	    I 4 + 32@ 32>f dup values z! 1+
	8 +LOOP drop
	message over erase
    8 +LOOP
    fft #points s>f 1/f fsqrt fftscale ;

: rngs-fft-test ( -- ) $100 points
    'rngs $100 64s bounds ?DO
	    I     32@ 32>f
	    I 4 + 32@ 32>f dup values z! 1+
    8 +LOOP
    fft #points s>f 1/f fsqrt fftscale ;

Create fft-test-2d here $1000 cells dup allot erase

: >test-2d ( -- )
    #points 0 ?DO
	I values z@
	$8 fm* 32e f+ f>s $8 fm* 32e f+ f>s 6 lshift + cells fft-test-2d + 1 swap +!
    LOOP ;

: .test-2d ( -- )
    $40 0 DO
	$40 0 DO
	    J 6 lshift I + cells fft-test-2d + ?
	LOOP cr
    LOOP ;

: >test-1d ( -- )
    #points 0 ?DO
	I values z@
	$8 fm* 32e f+ f>s cells fft-test-2d + 1 swap +!
	$8 fm* 32e f+ f>s cells fft-test-2d + 1 swap +!
    LOOP ;

: .test-1d ( -- )
    $40 0 DO
	I cells fft-test-2d + ?
    LOOP ;

\ check for dupes

: test32 ( n -- )  message $20 erase base @ >r hex
    0 ?DO  hash-init I message ! roundsh# rounds32 roundse# rounds32
	.source32 space .state32 space I 8 u.r cr LOOP
    r> base ! ;

Variable lastx

root definitions
: x? ( -- )
    2 pick lastx @ = IF  pad count type source type cr  THEN  2drop lastx !
    source pad place ;
forth definitions