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

View File

@ -38,15 +38,21 @@ C: command-button ( gadget object -- button )
M: command-button gadget-help ( button -- string )
command-button-object dup word? [ synopsis ] [ summary ] if ;
: init-commands ( gadget -- gadget )
( dup presented paint-prop [ <command-button> ] when* ) ;
: init-commands ( style gadget -- gadget )
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 )
<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 )
gadget pick assoc dup
[ nip ] [ drop dupd <styled-label> init-commands ] if
gadget pick assoc
[ ] [ >r dup dup r> <styled-label> init-commands ] ?if
outline rot assoc [ <outliner> ] when* ;
: gadget. ( gadget -- )