\ shfl.fs
\ Not standalone! Runs from fybb.fs via 'included'.
\ Array shuffling routines
\ Version 2025-08-18 Copyright Gan Uesli Starling

\ Shuffle the bits of two bytes.
: shfl.bits      ( c1 c2 -- c3 c4 ) \ Reversable
  0 0 $01        ( c1 c2 c3 c4 msk )
  8 0 DO
    DUP 5 PICK   ( c1 c2 c3 c4 msk msk c1 )
    AND          ( c1 c2 c3 c4 msk c1' )
    3 PICK OR >R ( c1 c2 c3 c4 msk )         ( R: c1' )
    DUP 4 PICK   ( c1 c2 c3 c4 msk msk c2 )
    AND          ( c1 c2 c3 c4 msk c2' )
    2 PICK OR >R ( c1 c2 c3 c4 msk )         ( R: c1' c2' )
    1 LSHIFT     ( c1 c2 c3 c4 msk' )
    NIP NIP      ( c1 c2 msk' )
    R> SWAP      ( c1 c2 c2' msk' )          ( R: c1' )
    R> SWAP      ( c1 c2 c2' c1' msk' )      ( R: )
  LOOP
  DROP           ( c1 c2 c2' c1' )
  ROT DROP       ( c1 c2' c1' )
  ROT DROP       ( c2' c1' )
;

\ Like cutting and suffling cards
: shfl.cut ( flg -- )  \ Reversible
  x_span 2 /
  0  
  DO
    0th I +           ( flg addr1 )
    DUP x_span 2 / +  ( flg addr1 addr2 )
    OVER C@ OVER  C@  ( flg addr1 addr2 c1 c2 )
    4 PICK IF 
      shfl.bits
    THEN
    SWAP ROT C!        ( flg addr1 c1 )
    SWAP C!            ( flg )
  2 +LOOP
  DROP
;


\ Like above but with one half reverse-ordered
: shfl.rev ( flg -- )  \ Reversible
  x_span 2 /
  0  
  DO
    0th I +          ( flg addr1 )
    0th x_span + I - ( flg addr1 addr2 )
    OVER C@ OVER C@  ( flg addr1 addr2 c1 c2 )
    4 PICK IF 
      shfl.bits
    THEN
    SWAP ROT C!      ( flg addr1 c1 )
    SWAP C!          ( flg )
  2 +LOOP
  DROP
;

\ Like manuall shuffling cards...
\ ...SWAP every even/odd pair of bytes.
: shfl.adj ( flg -- ) \ Reversible
  x_span 1-
  0  
  DO
    0th I +          ( flg addr1 )
    DUP 1+           ( flg addr1 addr2 )
    OVER C@ OVER C@  ( flg addr1 addr2 c1 c2 )
    4 PICK IF 
      shfl.bits
    THEN
    SWAP ROT C!      ( flg addr1 c2 )
    SWAP C!          ( flg )
  2 +LOOP
  DROP
;

\ TESTING WORDS

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

: test.shfl.bits
  PAGE $00 $FF
  CR ." Testing reversible shfl.bits ... "
  CR CR ." Bits before:" CR
  2dup SWAP show.byte show.byte
  CR CR ." Bits shuffled:" CR
  shfl.bits
  2dup show.byte show.byte
  CR CR ." Bits un-shuffled:" CR
  shfl.bits
  SWAP show.byte show.byte CR
;

: test.shfl.cut ( flg -- )
  PAGE
  DUP IF x.init.odd else x.init.bytes THEN
  CR ." Testing reversible shfl ..." 
  CR CR ." Sub-array before:" x.show.bytes 
  DUP shfl
  CR CR ." Sub-array shuffled:" x.show.bytes
  shfl 
  CR CR ." Sub-array un-shuffled:" x.show.bytes
  CR
;

: test.shfl.rev ( flg -- )
  PAGE
  x.init.bytes
  CR ." Testing reversible shfl.rev ..." 
  CR CR ." Sub-array before:" x.show.bytes 
  DUP shfl.rev
  CR CR ." Sub-array shuffled:" x.show.bytes
  shfl.rev
  CR CR ." Sub-array un-shuffled:" x.show.bytes
  CR
;

: test.shfl.adj ( flg -- )
  PAGE
  DUP IF x.init.odd else x.init.bytes THEN
  CR ." Testing reversible shfl.adj ..." 
  CR CR ." Sub-array before:" x.show.bytes 
  DUP shfl.adj
  CR CR ." Sub-array shuffled:" x.show.bytes
  shfl.adj 
  CR CR ." Sub-array un-shuffled:" x.show.bytes
  CR
;

\ test.shfl.bits
\ 1 test.shfl.cut
\ 1 test.shfl.rev
\ 1 test.shfl.adj

[THEN] \ End of file