factor/library/ui/presentations.factor

53 lines
1.7 KiB
Factor

! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: gadgets-presentations
USING: arrays gadgets gadgets-borders gadgets-labels
gadgets-layouts gadgets-outliner gadgets-panes hashtables io
kernel sequences strings styles ;
: init-commands ( style gadget -- gadget )
presented rot hash [ <command-button> ] when* ;
: style-font ( style -- font )
[ font swap hash [ "Monospaced" ] unless* ] keep
[ font-style swap hash [ plain ] unless* ] keep
font-size swap hash [ 12 ] unless* 3array ;
: <styled-label> ( style text -- label )
<label> foreground pick hash [ over set-label-color ] when*
swap style-font over set-label-font ;
: <presentation> ( style text -- presentation )
gadget pick hash
[ ] [ >r dup dup r> <styled-label> init-commands ] ?if
outline rot hash [ <outliner> ] when* ;
UNION: gadget-stream pack paragraph ;
M: gadget-stream stream-write ( string stream -- )
over empty? [ 2drop ] [ >r <label> r> add-gadget ] if ;
M: gadget-stream stream-write1 ( char stream -- )
>r ch>string r> stream-write ;
M: gadget-stream stream-format ( string style stream -- )
pick empty? pick hash-empty? and [
3drop
] [
>r swap <presentation> r> add-gadget
] if ;
M: gadget-stream stream-break ( stream -- )
<break> swap add-gadget ;
M: gadget-stream stream-close ( stream -- ) drop ;
: paragraph-style ( pane style -- pane )
border-width over hash [ >r <border> r> ] when
border-color swap hash
[ <solid> over set-gadget-boundary ] when* ;
M: pane with-nested-stream ( quot style stream -- )
>r >r make-pane r> paragraph-style
r> pane-current add-gadget ;