New labeled gadget

The new labeled gadget is not a frame anymore.
db4
nicolas-p 2015-07-20 20:13:44 +02:00 committed by John Benediktsson
parent 38447c276a
commit f99f32a990
1 changed files with 28 additions and 4 deletions

View File

@ -1,8 +1,9 @@
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors fonts kernel ui.gadgets ui.gadgets.borders
ui.gadgets.corners ui.gadgets.frames ui.gadgets.grids
ui.gadgets.labels ui.pens.image ui.render ;
USING: accessors colors.constants fonts kernel ui.gadgets
ui.gadgets.borders ui.gadgets.corners ui.gadgets.frames
ui.gadgets.grids ui.gadgets.labels ui.gadgets.lines
ui.gadgets.tracks ui.tools.common ui.pens.gradient ui.pens.image ui.render ;
IN: ui.gadgets.labeled
TUPLE: labeled-gadget < frame content ;
@ -25,10 +26,33 @@ M: labeled-gadget focusable-child* content>> ;
PRIVATE>
: <labeled-gadget> ( gadget title -- newgadget )
: <labeled-gadget-old> ( gadget title -- newgadget )
labeled-gadget "labeled-block" [
pick >>content
/-FOO-\
|-----|
\-----/
] make-corners ;
<PRIVATE
CONSTANT: title-bar-gradient { COLOR: white COLOR: grey90 }
: add-title-bar ( title track -- track )
swap >label
[ t >>bold? ] change-font
{ 0 5 } <border>
title-bar-gradient <gradient> >>interior
f track-add ;
: add-content ( content track -- track )
swap white-interior 1 track-add ;
PRIVATE>
: <labeled-gadget> ( gadget title -- newgadget )
vertical <track> with-lines
add-title-bar
add-content ;