Paste: Print across window

! Copyright (C) 2012 PolyMicro Systems.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs colors.constants fonts io io.styles kernel ui.private
math math.order math.parser namespaces prettyprint.sections sequences ui.text vocabs.parser ;

IN: ui.gadgets.world
: front-window ( -- world )
windows get
[ second focused?>> ] map-find nip
second ;

: window-width ( world -- width )
dim>> first ;

IN: kernel
: 1+ ( n -- n )
1 + ;

IN: splitting
: split-nth ( seq n -- seq )
0 swap
[ drop 1 + 2dup = [ drop 0 t ] [ f ] if ] split*-when 2nip
;

IN: prettyprint
: abullet ( -- )
"•" write ;

: bullets ( n -- )
iota [ drop abullet ] each ;

: column-numbers ( n -- )
iota [ 10 mod number>string write ] each ;

: space ( -- )
"\s" write ;

: spaces ( n -- )
iota [ drop space ] each ;

<PRIVATE

: (max-length) ( seq -- seq columnSize )
! dup length "entries: %d" printf 
0 over [ length max ] each 1+
;

: (printx) ( seq -- seq columnSize columns )
(max-length) dup
! dup " colsize: %d" printf 
front-window window-width
! dup " window-width: %d" printf
! [ listener-font-size /i " window-chars: %d" printf ] keep
swap "*" <repetition> concat monospace-font swap text-width /i 
! dup " columns: %d \n" printf
1 max
;

: (assemble-word) ( len seq -- string )
dup [ length - ] dip
[ " " <repetition> concat ] dip
prepend ;

: (assemble-line) ( colsize seq -- line )
"" -rot [ (assemble-word) append ] with each ;

PRIVATE>

: printx-split ( seq -- columnSize rows )
(printx) rot split-nth ;

: tablex ( seq -- )
printx-split nip
H{
{ font-name "monospace" }
{ font-size 9 }
! { foreground COLOR: DarkOrange4 }
! { table-gap { 20 2 } }
{ table-border COLOR: black }
! { inset { 5 5 } }
! { wrap-margin 100 }
}
[
0 swap [ [ [ [ over pprint pprint 1 + ] with-cell output-stream get stream-flush ] each ] with-row ] each
drop
] tabular-output
;

: printx ( seq -- )
printx-split
H{
! { font-name "Monaco" }
! { font-size 12 }
{ foreground COLOR: DarkRed }
! { table-gap { 20 2 } }
! { table-border COLOR: black }
! { inset { 5 5 } }
! { wrap-margin 300 }
! { nesting-limit f }
! { length-limit f }
! { line-limit f }
! { string-limit? f }
! { c-object-pointers? f }
}
[ [ [ (assemble-line) write nl ] with each
] with with-pprint
] with-style
;

! IN: syntax
! SYNTAX: ." parse-string write ;

IN: vocabs
: current-vocab-str ( -- str )
current-vocab name>> ;

: vwords ( -- )
current-vocab-str vocab-words keys
[ printx ] unless-empty ; 
! [ pprint " " print ] each ;

IN: sequences
vwords