From 958f20e97c3aa47f22611ae346ea0d2002d4c8ec Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Fri, 6 May 2005 03:58:45 +0000
Subject: [PATCH] fix text string sizing in UI

---
 library/ui/editors.factor |  4 ++--
 library/ui/gadgets.factor | 10 +++++++++-
 library/ui/labels.factor  |  9 ++++++---
 library/ui/paint.factor   |  5 ++---
 library/ui/text.factor    | 15 +++------------
 library/ui/tiles.factor   |  5 ++---
 6 files changed, 24 insertions(+), 24 deletions(-)

diff --git a/library/ui/editors.factor b/library/ui/editors.factor
index 326a2f07ab..8a42142224 100644
--- a/library/ui/editors.factor
+++ b/library/ui/editors.factor
@@ -90,11 +90,11 @@ M: editor user-input* ( ch editor -- ? )
     scroll>bottom  t ;
 
 M: editor pref-size ( editor -- w h )
-    editor-text shape-size >r 1 + r> ;
+    dup editor-text label-size >r 1 + r> ;
 
 M: editor layout* ( editor -- )
     dup editor-caret over caret-size rot resize-gadget
     dup editor-caret swap caret-pos rot move-gadget ;
 
 M: editor draw-shape ( editor -- )
-    dup [ editor-text draw-shape ] with-trans ;
+    [ editor-text ] keep [ draw-string ] with-trans ;
diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor
index 36aedf89a2..26e933f1bf 100644
--- a/library/ui/gadgets.factor
+++ b/library/ui/gadgets.factor
@@ -59,7 +59,15 @@ C: gadget ( shape -- gadget )
     [ [ resize-shape ] keep relayout ] ?resize ;
 
 : paint-prop ( gadget key -- value )
-    swap gadget-paint hash ;
+    over [
+        dup pick gadget-paint hash* dup [
+            2nip cdr
+        ] [
+            drop >r gadget-parent r> paint-prop
+        ] ?ifte
+    ] [
+        2drop f
+    ] ifte ;
 
 : set-paint-prop ( gadget value key -- )
     rot gadget-paint set-hash ;
diff --git a/library/ui/labels.factor b/library/ui/labels.factor
index 86275ce1a1..09b8d66a8f 100644
--- a/library/ui/labels.factor
+++ b/library/ui/labels.factor
@@ -9,8 +9,11 @@ TUPLE: label text ;
 C: label ( text -- label )
     <empty-gadget> over set-delegate [ set-label-text ] keep ;
 
-M: label pref-size label-text shape-size ;
+: label-size ( gadget text -- w h )
+    >r font paint-prop r> size-string ;
+
+M: label pref-size ( label -- w h )
+    dup label-text label-size ;
 
 M: label draw-shape ( label -- )
-    dup delegate draw-shape
-    dup shape-pos [ label-text draw-shape ] with-trans ;
+    [ label-text ] keep [ draw-string ] with-trans ;
diff --git a/library/ui/paint.factor b/library/ui/paint.factor
index ba6ad25f18..0018d7d467 100644
--- a/library/ui/paint.factor
+++ b/library/ui/paint.factor
@@ -53,7 +53,7 @@ SYMBOL: clip
 : with-clip ( shape quot -- )
     #! All drawing done inside the quotation is clipped to the
     #! shape's bounds. The quotation is called with a boolean
-    #! that is set to false if 
+    #! that is set to false if the gadget is entirely clipped.
     [
         >r screen-bounds clip [ intersect dup ] change set-clip
         r> call
@@ -65,7 +65,7 @@ SYMBOL: clip
     #! paint, just call the quotation.
     f over set-gadget-redraw?
     dup gadget-paint [
-        dup dup [
+        dup [
             [
                 drop
             ] [
@@ -74,5 +74,4 @@ SYMBOL: clip
                 ] with-trans
             ] ifte
         ] with-clip
-        surface get swap [ shape-x x get + ] keep [ shape-y y get + ] keep [ shape-w pick + 1 - ] keep shape-h pick + 1 - red rgb rectangleColor
     ] bind ;
diff --git a/library/ui/text.factor b/library/ui/text.factor
index af04fb462a..9a43602a66 100644
--- a/library/ui/text.factor
+++ b/library/ui/text.factor
@@ -63,18 +63,7 @@ global [
         swap *int swap *int
     ] ifte ;
 
-global [ <namespace> fonts set ] bind
-
-M: string shape-x drop 0 ;
-M: string shape-y drop 0 ;
-M: string shape-w
-    font get swap size-string ( h -) drop ;
-
-M: string shape-h ( text -- h )
-    #! This is just the height of the current font.
-    drop font get lookup-font TTF_FontHeight ;
-
-M: string draw-shape ( text -- )
+: draw-string ( text -- )
     dup empty? [
         drop
     ] [
@@ -85,3 +74,5 @@ M: string draw-shape ( text -- )
         [ >r x get y get r> draw-surface ] keep
         SDL_FreeSurface
     ] ifte ;
+
+global [ <namespace> fonts set ] bind
diff --git a/library/ui/tiles.factor b/library/ui/tiles.factor
index a97f532275..6cbb455729 100644
--- a/library/ui/tiles.factor
+++ b/library/ui/tiles.factor
@@ -70,11 +70,10 @@ TUPLE: tile original ;
 C: tile ( child caption -- tile )
     [ f line-border swap set-delegate ] keep
     [ >r tile-content r> add-gadget ] keep
-    [ tile-actions ] keep
-    dup delegate pref-size pick resize-gadget ;
+    [ tile-actions ] keep ;
 
 M: tile pref-size shape-size ;
 
 : tile ( gadget title -- )
     #! Show the gadget in a new tile.
-    <tile> world get add-gadget ;
+    <tile> [ world get add-gadget ] keep prefer ;