From e8d0cbbd6aebaacccb9088e1b142f9d9ec79eb19 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 11 Jul 2008 00:46:15 -0500
Subject: [PATCH] UI cleanups
---
extra/ui/gadgets/borders/borders.factor | 12 ++++++++----
extra/ui/gadgets/buttons/buttons.factor | 20 ++++++++------------
extra/ui/gadgets/editors/editors.factor | 18 ++++++++----------
3 files changed, 24 insertions(+), 26 deletions(-)
diff --git a/extra/ui/gadgets/borders/borders.factor b/extra/ui/gadgets/borders/borders.factor
index ce7ea32008..83bb4f3c3f 100644
--- a/extra/ui/gadgets/borders/borders.factor
+++ b/extra/ui/gadgets/borders/borders.factor
@@ -6,11 +6,15 @@ IN: ui.gadgets.borders
TUPLE: border < gadget size fill ;
-: <border> ( child gap -- border )
- border new-gadget
- swap dup 2array >>size
+: new-border ( child class -- border )
+ new-gadget
+ { 0 0 } >>size
{ 0 0 } >>fill
- [ add-gadget ] keep ;
+ [ add-gadget ] keep ; inline
+
+: <border> ( child gap -- border )
+ swap border new-border
+ swap dup 2array >>size ;
M: border pref-dim*
[ border-size 2 v*n ] keep
diff --git a/extra/ui/gadgets/buttons/buttons.factor b/extra/ui/gadgets/buttons/buttons.factor
index e38676c375..770e0b9f15 100755
--- a/extra/ui/gadgets/buttons/buttons.factor
+++ b/extra/ui/gadgets/buttons/buttons.factor
@@ -4,12 +4,12 @@ USING: accessors arrays kernel math models namespaces sequences
strings quotations assocs combinators classes colors
classes.tuple opengl math.vectors
ui.commands ui.gadgets ui.gadgets.borders
-ui.gadgets.labels ui.gadgets.theme ui.gadgets.wrappers
+ui.gadgets.labels ui.gadgets.theme
ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures
ui.render ;
IN: ui.gadgets.buttons
-TUPLE: button < wrapper pressed? selected? quot ;
+TUPLE: button < border pressed? selected? quot ;
: buttons-down? ( -- ? )
hand-buttons get-global empty? not ;
@@ -41,11 +41,9 @@ button H{
} set-gestures
: new-button ( label quot class -- button )
- new-gadget
- swap >>quot
- [ >r >label r> add-gadget ] keep ; inline
+ [ swap >label ] dip new-border swap >>quot ; inline
-: <button> ( gadget quot -- button )
+: <button> ( label quot -- button )
button new-button ;
TUPLE: button-paint plain rollover pressed selected ;
@@ -84,13 +82,11 @@ M: button-paint draw-boundary
: bevel-button-theme ( gadget -- gadget )
<bevel-button-paint> >>interior
+ { 5 5 } >>size
faint-boundary ; inline
-: >bevel-label ( label -- gadget )
- >label 5 <border> ;
-
: <bevel-button> ( label quot -- button )
- >r >bevel-label r> <button> bevel-button-theme ;
+ <button> bevel-button-theme ;
TUPLE: repeat-button < button ;
@@ -101,7 +97,7 @@ repeat-button H{
: <repeat-button> ( label quot -- button )
#! Button that calls the quotation every 100ms as long as
#! the mouse is held down.
- >r >bevel-label r> repeat-button new-button bevel-button-theme ;
+ repeat-button new-button bevel-button-theme ;
TUPLE: checkmark-paint color ;
@@ -209,7 +205,7 @@ M: radio-control model-changed
dup radio-buttons-theme ;
: <toggle-button> ( value model label -- gadget )
- >bevel-label <radio-control> bevel-button-theme ;
+ <radio-control> bevel-button-theme ;
: <toggle-buttons> ( model assoc -- gadget )
[ [ <toggle-button> ] <radio-controls> ] make-shelf ;
diff --git a/extra/ui/gadgets/editors/editors.factor b/extra/ui/gadgets/editors/editors.factor
index 3d55710e54..8cdc65b388 100755
--- a/extra/ui/gadgets/editors/editors.factor
+++ b/extra/ui/gadgets/editors/editors.factor
@@ -9,7 +9,6 @@ ui.gadgets.theme ui.gadgets.wrappers ui.render ui.gestures ;
IN: ui.gadgets.editors
TUPLE: editor < gadget
-self
font color caret-color selection-color
caret mark
focused? ;
@@ -30,8 +29,7 @@ focused? ;
new-gadget
<document> >>model
init-editor-locs
- editor-theme
- dup dup set-editor-self ; inline
+ editor-theme ; inline
: <editor> ( -- editor )
editor new-editor ;
@@ -209,19 +207,19 @@ M: editor pref-dim*
dup editor-font* swap control-value text-dim ;
: contents-changed ( model editor -- )
- editor-self swap
- over editor-caret [ over validate-loc ] (change-model)
- over editor-mark [ over validate-loc ] (change-model)
+ swap
+ over caret>> [ over validate-loc ] (change-model)
+ over mark>> [ over validate-loc ] (change-model)
drop relayout ;
: caret/mark-changed ( model editor -- )
- nip editor-self dup relayout-1 scroll>caret ;
+ nip [ relayout-1 ] [ scroll>caret ] bi ;
M: editor model-changed
{
- { [ 2dup gadget-model eq? ] [ contents-changed ] }
- { [ 2dup editor-caret eq? ] [ caret/mark-changed ] }
- { [ 2dup editor-mark eq? ] [ caret/mark-changed ] }
+ { [ 2dup model>> eq? ] [ contents-changed ] }
+ { [ 2dup caret>> eq? ] [ caret/mark-changed ] }
+ { [ 2dup mark>> eq? ] [ caret/mark-changed ] }
} cond ;
M: editor gadget-selection?