! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays hashtables kernel models math namespaces
+USING: accessors arrays hashtables kernel math namespaces
make sequences quotations math.vectors combinators sorting
binary-search vectors dlists deques models threads
-concurrency.flags math.order math.rectangles fry ;
+concurrency.flags math.order math.rectangles fry locals ;
IN: ui.gadgets
! Values for orientation slot
CONSTANT: vertical { 0 1 }
TUPLE: gadget < rect
+id
pref-dim
parent
children
M: gadget equal? 2drop f ;
-M: gadget hashcode* drop gadget hashcode* ;
+M: gadget hashcode* nip [ [ \ gadget counter ] unless* ] change-id id>> ;
M: gadget model-changed 2drop ;
: ((fast-children-on)) ( gadget dim axis -- <=> )
[ swap loc>> v- ] dip v. 0 <=> ;
-: (fast-children-on) ( dim axis children -- i )
- -rot '[ _ _ ((fast-children-on)) ] search drop ;
+:: (fast-children-on) ( dim axis children -- i )
+ children [ dim axis ((fast-children-on)) ] search drop ;
PRIVATE>
orientation>> vertical = "\n" "" ? ;
: gadget-seq-text ( seq gadget -- )
- gadget-text-separator swap
- [ dup % ] [ gadget-text* ] interleave drop ;
+ gadget-text-separator '[ _ % ] [ gadget-text* ] interleave ;
M: gadget gadget-text*
[ children>> ] keep gadget-seq-text ;
: forget-pref-dim ( gadget -- ) f >>pref-dim drop ;
-: ui-state ( symbol -- value ) get [ "UI not running" throw ] unless* ;
-
-: layout-queue ( -- queue ) \ layout-queue ui-state ;
+: layout-queue ( -- queue ) \ layout-queue get ;
: layout-later ( gadget -- )
#! When unit testing gadgets without the UI running, the
<PRIVATE
-: graft-queue ( -- dlist ) \ graft-queue ui-state ;
+: graft-queue ( -- dlist )
+ \ graft-queue get [ "UI not running" throw ] unless* ;
: unqueue-graft ( gadget -- )
[ graft-node>> graft-queue delete-node ]
: focus-path ( gadget -- seq )
[ focus>> ] follow ;
+
+USING: vocabs vocabs.loader ;
+
+"prettyprint" vocab [ "ui.gadgets.prettyprint" require ] when