steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-07-20 20:26:56 -05:00
parent 046a6e6ec0 d937e03e1a
commit 547c0e87b1
3 changed files with 26 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
extra/math/geometry/geometry.factor Normal file
View File

@ -0,0 +1,8 @@
IN: math.geometry
GENERIC: width ( object -- width )
GENERIC: height ( object -- width )
GENERIC# set-x! 1 ( object x -- object )
GENERIC# set-y! 1 ( object y -- object )

15
extra/math/geometry/rect/rect.factor
View File

@ -1,13 +1,15 @@
USING: kernel arrays math.vectors ; USING: kernel arrays sequences math.vectors math.geometry accessors ;
IN: math.geometry.rect IN: math.geometry.rect
TUPLE: rect { loc initial: { 0 0 } } { dim initial: { 0 0 } } ; TUPLE: rect loc dim ;
: <zero-rect> ( -- rect ) rect new ; : init-rect ( rect -- rect ) { 0 0 } clone >>loc { 0 0 } clone >>dim ;
C: <rect> rect : <rect> ( loc dim -- rect ) rect boa ;
: <zero-rect> ( -- rect ) rect new init-rect ;
M: array rect-loc ; M: array rect-loc ;
@ -40,3 +42,8 @@ M: array rect-dim drop { 0 0 } ;
: rect-union ( rect1 rect2 -- newrect ) : rect-union ( rect1 rect2 -- newrect )
(rect-union) <extent-rect> ; (rect-union) <extent-rect> ;
M: rect width ( rect -- width ) dim>> first ;
M: rect height ( rect -- height ) dim>> second ;
M: rect set-x! ( rect x -- rect ) over loc>> set-first ;
M: rect set-y! ( rect y -- rect ) over loc>> set-second ;

12
extra/ui/gadgets/gadgets.factor
View File

@ -27,11 +27,13 @@ M: gadget model-changed 2drop ;
: nth-gadget ( n gadget -- child ) children>> nth ; : nth-gadget ( n gadget -- child ) children>> nth ;
: new-gadget ( class -- gadget ) : init-gadget ( gadget -- gadget )
new init-rect
{ 0 1 } >>orientation { 0 1 } >>orientation
t >>visible? t >>visible?
{ f f } >>graft-state ; inline { f f } >>graft-state ; inline
: new-gadget ( class -- gadget ) new init-gadget ; inline
: <gadget> ( -- gadget ) : <gadget> ( -- gadget )
gadget new-gadget ; gadget new-gadget ;