steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fix various UI bugs; use opengl-style colors

cvs
Slava Pestov 2005-10-29 01:13:41 +00:00
parent db5e6c5f2a
commit f6499a63b0
1 changed files with 11 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
library/ui/presentations.factor
View File

@ -38,15 +38,21 @@ C: command-button ( gadget object -- button )
M: command-button gadget-help ( button -- string ) M: command-button gadget-help ( button -- string )
command-button-object dup word? [ synopsis ] [ summary ] if ; command-button-object dup word? [ synopsis ] [ summary ] if ;
: init-commands ( gadget -- gadget ) : init-commands ( style gadget -- gadget )
( dup presented paint-prop [ <command-button> ] when* ) ; presented rot assoc [ <command-button> ] when* ;
: style-font ( style -- font )
[ font swap assoc [ "Monospaced" ] unless* ] keep
[ font-style swap assoc [ plain ] unless* ] keep
font-size swap assoc [ 12 ] unless* 3array ;
: <styled-label> ( style text -- label ) : <styled-label> ( style text -- label )
<label> nip ; ! dup rot dup [ alist>hash ] when add-paint ; <label> foreground pick assoc over set-label-text
swap style-font over set-label-font ;
: <presentation> ( style text -- presentation ) : <presentation> ( style text -- presentation )
gadget pick assoc dup gadget pick assoc
[ nip ] [ drop dupd <styled-label> init-commands ] if [ ] [ >r dup dup r> <styled-label> init-commands ] ?if
outline rot assoc [ <outliner> ] when* ; outline rot assoc [ <outliner> ] when* ;
: gadget. ( gadget -- ) : gadget. ( gadget -- )