1 ! Copyright (C) 2013 Fred Alger
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: combinators grouping kernel math math.bitwise
7 : gb0 ( a -- a0 ) 0xff bitand ; inline
8 : gb1 ( a -- a1 ) -8 shift gb0 ; inline
9 : gb2 ( a -- a2 ) -16 shift gb0 ; inline
10 : gb3 ( a -- a3 ) -24 shift gb0 ; inline
12 ! pack 4 bytes into 32-bit unsigned int
14 : >ui32 ( a0 a1 a2 a3 -- a )
15 [ 8 shift ] [ 16 shift ] [ 24 shift ] tri*
16 bitor bitor bitor 32 bits ;
19 : ui32> ( word -- a0 a1 a2 a3 )
20 [ gb0 ] keep [ gb1 ] keep [ gb2 ] keep gb3 ; inline
22 : ui32-rev> ( word -- a3 a2 a1 a0 )
23 [ gb3 ] keep [ gb2 ] keep [ gb1 ] keep gb0 ; inline
25 : bytes>words ( seq -- seq )
26 4 <groups> [ <reversed> first4 >ui32 ] V{ } map-as ;
31 [ [ gb0 ] map first4 >ui32 ]
32 [ [ gb1 ] map first4 >ui32 ]
33 [ [ gb2 ] map first4 >ui32 ]
34 [ [ gb3 ] map first4 >ui32 ]
35 } cleave .h .h .h .h ;
38 ! given 4 columns, output the first diagonal, i.e.
39 ! C[0,0] C[1,1] C[2,2] C[3,3]
40 : first-diag ( c0 c1 c2 c3 -- a0 a1 a2 a3 )
41 { [ gb3 ] [ gb2 ] [ gb1 ] [ gb0 ] } spread ;
43 : second-diag ( c0 c1 c2 c3 -- a0 a1 a2 a3 ) roll first-diag ;
44 : third-diag ( c0 c1 c2 c3 -- a0 a1 a2 a3 ) roll second-diag ;
45 : fourth-diag ( c0 c1 c2 c3 -- a0 a1 a2 a3 ) roll third-diag ;
47 ! given 4 columns, output the first reverse diagonal, i.e.
48 ! C[0,0] C[3,1] C[2,2] C[1,3]
49 : -first-diag ( c0 c1 c2 c3 -- a0 a1 a2 a3 ) spin first-diag ;
50 : -second-diag ( c0 c1 c2 c3 -- a0 a1 a2 a3 ) spin roll first-diag ;
51 : -third-diag ( c0 c1 c2 c3 -- a0 a1 a2 a3 ) spin roll second-diag ;
52 : -fourth-diag ( c0 c1 c2 c3 -- a0 a1 a2 a3 ) spin roll third-diag ;
54 :: set-first4-unsafe ( seq a0 a1 a2 a3 -- )
55 a0 0 seq set-nth-unsafe
56 a1 1 seq set-nth-unsafe
57 a2 2 seq set-nth-unsafe
58 a3 3 seq set-nth-unsafe ;
60 : 4th-from-end ( seq -- el )
61 [ length 4 - ] keep nth ;