1 USING: combinators.short-circuit unicode.categories kernel math
2 combinators splitting sequences math.parser io.files io assocs
3 arrays namespaces make math.ranges unicode.normalize values
4 io.encodings.ascii unicode.syntax unicode.data compiler.units
8 C-ENUM: Any L V T Extend Control CR LF graphemes ;
10 : jamo-class ( ch -- class )
11 dup initial? [ drop L ]
12 [ dup medial? [ drop V ] [ final? T Any ? ] if ] if ;
14 CATEGORY: grapheme-control Zl Zp Cc Cf ;
15 : control-class ( ch -- class )
19 { HEX: 200C [ Extend ] }
20 { HEX: 200D [ Extend ] }
24 CATEGORY: (extend) Me Mn ;
26 { [ (extend)? ] [ "Other_Grapheme_Extend" property? ] } 1|| ;
28 : grapheme-class ( ch -- class )
30 { [ dup jamo? ] [ jamo-class ] }
31 { [ dup grapheme-control? ] [ control-class ] }
32 { [ extend? ] [ Extend ] }
36 : init-grapheme-table ( -- table )
37 graphemes [ graphemes f <array> ] replicate ;
41 : finish-table ( -- table )
42 table get [ [ 1 = ] map ] map ;
44 : set-table ( class1 class2 val -- )
45 -rot table get nth [ swap or ] change-nth ;
47 : connect ( class1 class2 -- ) 1 set-table ;
48 : disconnect ( class1 class2 -- ) 0 set-table ;
50 : connect-before ( class classes -- )
51 [ connect ] with each ;
53 : connect-after ( classes class -- )
54 [ connect ] curry each ;
56 : break-around ( classes1 classes2 -- )
57 [ [ 2dup disconnect swap disconnect ] with each ] curry each ;
59 : make-grapheme-table ( -- )
61 Control CR LF 3array graphemes break-around
62 L L V 2array connect-before
63 V V T 2array connect-before
65 graphemes Extend connect-after ;
69 : grapheme-break? ( class1 class2 -- ? )
70 grapheme-table nth nth not ;
72 : chars ( i str n -- str[i] str[i+n] )
73 swap >r dupd + r> [ ?nth ] curry bi@ ;
75 : find-index ( seq quot -- i ) find drop ; inline
76 : find-last-index ( seq quot -- i ) find-last drop ; inline
78 : first-grapheme ( str -- i )
79 unclip-slice grapheme-class over
80 [ grapheme-class tuck grapheme-break? ] find-index
81 nip swap length or 1+ ;
83 : (>graphemes) ( str -- )
85 dup first-grapheme cut-slice
89 : >graphemes ( str -- graphemes )
90 [ (>graphemes) ] { } make ;
92 : string-reverse ( str -- rts )
93 >graphemes reverse concat ;
95 : last-grapheme ( str -- i )
96 unclip-last-slice grapheme-class swap
97 [ grapheme-class dup rot grapheme-break? ] find-last-index ?1+ nip ;
99 init-grapheme-table table
100 [ make-grapheme-table finish-table ] with-variable
101 \ grapheme-table set-value