New look for menus

basis/ui/gadgets/corners/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/ui/gadgets/corners/corners.factor

@@ -0,0 +1,43 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel sequences namespaces ui.gadgets.frames
+ui.pens.image ui.gadgets.icons ui.gadgets.grids ;
+IN: ui.gadgets.corners
+
+CONSTANT: @center { 1 1 }
+CONSTANT: @left { 0 1 }
+CONSTANT: @right { 2 1 }
+CONSTANT: @top { 1 0 }
+CONSTANT: @bottom { 1 2 }
+
+CONSTANT: @top-left { 0 0 }
+CONSTANT: @top-right { 2 0 }
+CONSTANT: @bottom-left { 0 2 }
+CONSTANT: @bottom-right { 2 2 }
+
+SYMBOL: name
+
+: corner-image ( name -- image )
+    [ name get "-" ] dip 3append theme-image ;
+
+: corner-icon ( name -- icon )
+    corner-image <icon> ;
+
+: /-----\ ( corner -- corner )
+    "top-left" corner-icon @top-left grid-add
+    "top-middle" corner-icon @top grid-add
+    "top-right" corner-icon @top-right grid-add ;
+
+: |-----| ( gadget corner -- corner )
+    "left-edge" corner-icon @left grid-add
+    swap @center grid-add
+    "right-edge" corner-icon @right grid-add ;
+
+: \-----/ ( corner -- corner )
+    "bottom-left" corner-icon @bottom-left grid-add
+    "bottom-middle" corner-icon @bottom grid-add
+    "bottom-right" corner-icon @bottom-right grid-add ;
+
+: make-corners ( class name quot -- corners )
+    [ [ [ 3 3 ] dip new-frame { 1 1 } >>filled-cell ] dip name ] dip
+    with-variable ; inline

basis/ui/gadgets/labeled/labeled.factor

@@ -2,67 +2,33 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel sequences colors fonts ui.gadgets
 ui.gadgets.frames ui.gadgets.grids ui.gadgets.icons ui.gadgets.labels
-ui.gadgets.borders ui.pens.image ;
+ui.gadgets.borders ui.pens.image ui.gadgets.corners ui.render ;
 IN: ui.gadgets.labeled
 
 TUPLE: labeled-gadget < frame content ;
 
 <PRIVATE
 
-CONSTANT: @center { 1 1 }
-CONSTANT: @left { 0 1 }
-CONSTANT: @right { 2 1 }
-CONSTANT: @top { 1 0 }
-CONSTANT: @bottom { 1 2 }
-
-CONSTANT: @top-left { 0 0 }
-CONSTANT: @top-right { 2 0 }
-CONSTANT: @bottom-left { 0 2 }
-CONSTANT: @bottom-right { 2 2 }
-
-: labeled-image ( name -- image )
-    "labeled-block-" prepend theme-image ;
-
-: labeled-icon ( name -- icon )
-    labeled-image <icon> ;
-
-CONSTANT: labeled-title-background
-    T{ rgba f
-        0.7843137254901961
-        0.7686274509803922
-        0.7176470588235294
-        1.0
-    }
-
 : <labeled-title> ( gadget -- label )
     >label
-    [ labeled-title-background font-with-background ] change-font
+    [ panel-background-color font-with-background ] change-font
     { 0 2 } <border>
-    "title-middle" labeled-image
+    "title-middle" corner-image
     <image-pen> t >>fill? >>interior ;
 
 : /-FOO-\ ( title labeled -- labeled )
-    "title-left" labeled-icon @top-left grid-add
+    "title-left" corner-icon @top-left grid-add
     swap <labeled-title> @top grid-add
-    "title-right" labeled-icon @top-right grid-add ;
-
-: |-----| ( gadget labeled -- labeled )
-    "left-edge" labeled-icon @left grid-add
-    swap [ >>content ] [ @center grid-add ] bi
-    "right-edge" labeled-icon @right grid-add ;
-
-: \-----/ ( labeled -- labeled )
-    "bottom-left" labeled-icon @bottom-left grid-add
-    "bottom-middle" labeled-icon @bottom grid-add
-    "bottom-right" labeled-icon @bottom-right grid-add ;
+    "title-right" corner-icon @top-right grid-add ;
 
 M: labeled-gadget focusable-child* content>> ;
 
 PRIVATE>
 
 : <labeled-gadget> ( gadget title -- newgadget )
-    3 3 labeled-gadget new-frame
-        { 1 1 } >>filled-cell
+    labeled-gadget "labeled-block" [
+        over >>content
         /-FOO-\
         |-----|
-        \-----/ ;
+        \-----/
+    ] make-corners ;

basis/ui/gadgets/menus/menus.factor

@@ -1,10 +1,11 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: colors.constants kernel locals math.rectangles
-namespaces sequences ui.commands ui.gadgets ui.gadgets.borders
-ui.gadgets.buttons ui.gadgets.glass ui.gadgets.packs
-ui.gadgets.worlds ui.gestures ui.operations ui.pens ui.pens.solid
-opengl math.vectors words accessors math math.order sorting ;
+USING: colors.constants kernel locals math.rectangles namespaces
+sequences ui.commands ui.gadgets ui.gadgets.borders ui.gadgets.buttons
+ui.gadgets.glass ui.gadgets.packs ui.gadgets.frames ui.gadgets.worlds
+ui.gadgets.frames ui.gadgets.corners ui.gestures ui.operations
+ui.render ui.pens ui.pens.solid opengl math.vectors words accessors
+math math.order sorting ;
 IN: ui.gadgets.menus
 
 : show-menu ( owner menu -- )
@@ -30,6 +31,10 @@ M: separator-pen draw-interior
     dim>> [ { 0 0.5 } v* ] [ { 1 0.5 } v* ] bi
     [ [ >integer ] map ] bi@ gl-line ;
 
+: <menu-items> ( items -- gadget )
+    [ <filled-pile> ] dip add-gadgets
+    panel-background-color <solid> >>interior ;
+
 PRIVATE>
 
 SINGLETON: ----
@@ -43,10 +48,16 @@ M: ---- <menu-item>
 : menu-theme ( gadget -- gadget )
     COLOR: light-gray <solid> >>interior ;
 
+: <menu> ( gadgets -- menu )
+    <menu-items>
+    frame "menu-background" [
+        /-----\
+        |-----|
+        \-----/
+    ] make-corners ;
+
 : <commands-menu> ( target hook commands -- menu )
-    [ <filled-pile> ] 3dip
-    [ <menu-item> add-gadget ] with with each
-    { 5 5 } <border> menu-theme ;
+    [ <menu-item> ] with with map <menu> ;
 
 : show-commands-menu ( target commands -- )
     [ dup [ ] ] dip <commands-menu> show-menu ;

basis/ui/render/render.factor

@@ -112,4 +112,12 @@ M: gadget draw-children
 
 CONSTANT: selection-color T{ rgba f 0.8 0.8 1.0 1.0 }
 
+CONSTANT: panel-background-color
+    T{ rgba f
+        0.7843137254901961
+        0.7686274509803922
+        0.7176470588235294
+        1.0
+    }
+
 CONSTANT: focus-border-color COLOR: dark-gray