Rename math.geometry.rect to math.rectangles
Remove math.geometry.points Remove rect-loc and rect-dim wordsdb4
parent
dfa0931db1
commit
88b401b383
|
|
@ -1,11 +0,0 @@
|
|||
|
||||
IN: math.geometry
|
||||
|
||||
GENERIC: width ( object -- width )
|
||||
GENERIC: height ( object -- width )
|
||||
|
||||
GENERIC# set-width! 1 ( object width -- object )
|
||||
GENERIC# set-height! 1 ( object height -- object )
|
||||
|
||||
GENERIC# set-x! 1 ( object x -- object )
|
||||
GENERIC# set-y! 1 ( object y -- object )
|
||||
|
|
@ -1,68 +0,0 @@
|
|||
|
||||
USING: kernel arrays sequences
|
||||
math math.points math.vectors math.geometry
|
||||
accessors ;
|
||||
|
||||
IN: math.geometry.rect
|
||||
|
||||
TUPLE: rect loc dim ;
|
||||
|
||||
GENERIC: rect-loc ( obj -- loc )
|
||||
GENERIC: rect-dim ( obj -- dim )
|
||||
|
||||
: init-rect ( rect -- rect ) { 0 0 } clone >>loc { 0 0 } clone >>dim ;
|
||||
|
||||
: <rect> ( loc dim -- rect ) rect boa ;
|
||||
|
||||
: <zero-rect> ( -- rect ) rect new init-rect ;
|
||||
|
||||
M: array rect-loc ;
|
||||
|
||||
M: array rect-dim drop { 0 0 } ;
|
||||
|
||||
M: rect rect-loc loc>> ;
|
||||
|
||||
M: rect rect-dim dim>> ;
|
||||
|
||||
: rect-bounds ( rect -- loc dim ) dup rect-loc swap rect-dim ;
|
||||
|
||||
: rect-extent ( rect -- loc ext ) rect-bounds over v+ ;
|
||||
|
||||
: 2rect-extent ( rect rect -- loc1 loc2 ext1 ext2 )
|
||||
[ rect-extent ] bi@ swapd ;
|
||||
|
||||
: <extent-rect> ( loc ext -- rect ) over [v-] <rect> ;
|
||||
|
||||
: offset-rect ( rect loc -- newrect )
|
||||
over rect-loc v+ swap rect-dim <rect> ;
|
||||
|
||||
: (rect-intersect) ( rect rect -- array array )
|
||||
2rect-extent [ vmax ] [ vmin ] 2bi* ;
|
||||
|
||||
: rect-intersect ( rect1 rect2 -- newrect )
|
||||
(rect-intersect) <extent-rect> ;
|
||||
|
||||
: intersects? ( rect/point rect -- ? )
|
||||
(rect-intersect) [v-] { 0 0 } = ;
|
||||
|
||||
: (rect-union) ( rect rect -- array array )
|
||||
2rect-extent [ vmin ] [ vmax ] 2bi* ;
|
||||
|
||||
: rect-union ( rect1 rect2 -- newrect )
|
||||
(rect-union) <extent-rect> ;
|
||||
|
||||
M: rect width ( rect -- width ) dim>> first ;
|
||||
M: rect height ( rect -- height ) dim>> second ;
|
||||
|
||||
M: rect set-width! ( rect width -- rect ) over dim>> set-first ;
|
||||
M: rect set-height! ( rect height -- rect ) over dim>> set-second ;
|
||||
|
||||
M: rect set-x! ( rect x -- rect ) over loc>> set-first ;
|
||||
M: rect set-y! ( rect y -- rect ) over loc>> set-second ;
|
||||
|
||||
! Accessing corners
|
||||
|
||||
: top-left ( rect -- point ) loc>> ;
|
||||
: top-right ( rect -- point ) [ loc>> ] [ width 1 - ] bi v+x ;
|
||||
: bottom-left ( rect -- point ) [ loc>> ] [ height 1 - ] bi v+y ;
|
||||
: bottom-right ( rect -- point ) [ loc>> ] [ dim>> ] bi v+ { 1 1 } v- ;
|
||||
|
|
@ -1,12 +1,11 @@
|
|||
USING: help.markup help.syntax ;
|
||||
|
||||
IN: math.geometry.rect
|
||||
IN: math.rectangles
|
||||
|
||||
HELP: rect
|
||||
{ $class-description "A rectangle with the following slots:"
|
||||
{ $list
|
||||
{ { $link rect-loc } " - the top-left corner of the rectangle as an x/y pair" }
|
||||
{ { $link rect-dim } " - the dimensions of the rectangle as a width/height pair" }
|
||||
{ { $slot "loc" } " - the top-left corner of the rectangle as an x/y pair" }
|
||||
{ { $slot "dim" } " - the dimensions of the rectangle as a width/height pair" }
|
||||
}
|
||||
"Rectangles are constructed by calling " { $link <rect> } " and " { $link <extent-rect> } "."
|
||||
} ;
|
||||
|
|
@ -47,12 +46,10 @@ HELP: <zero-rect>
|
|||
{ $values { "rect" "a new " { $link rect } } }
|
||||
{ $description "Creates a rectangle located at the origin with zero dimensions." } ;
|
||||
|
||||
ARTICLE: "math.geometry.rect" "Rectangles"
|
||||
"The " { $vocab-link "math.geometry.rect" } " vocabulary defines a rectangle data type and operations on them."
|
||||
ARTICLE: "math.rectangles" "Rectangles"
|
||||
"The " { $vocab-link "math.rectangles" } " vocabulary defines a rectangle data type and operations on them."
|
||||
{ $subsection rect }
|
||||
"Rectangles can be taken apart:"
|
||||
{ $subsection rect-loc }
|
||||
{ $subsection rect-dim }
|
||||
{ $subsection rect-bounds }
|
||||
{ $subsection rect-extent }
|
||||
"New rectangles can be created:"
|
||||
|
|
@ -64,4 +61,4 @@ ARTICLE: "math.geometry.rect" "Rectangles"
|
|||
{ $subsection rect-intersect }
|
||||
{ $subsection intersects? } ;
|
||||
|
||||
ABOUT: "math.geometry.rect"
|
||||
ABOUT: "math.rectangles"
|
||||
|
|
@ -1,7 +1,5 @@
|
|||
|
||||
USING: tools.test math.geometry.rect ;
|
||||
|
||||
IN: math.geometry.rect.tests
|
||||
USING: tools.test math.rectangles ;
|
||||
IN: math.rectangles.tests
|
||||
|
||||
[ T{ rect f { 10 10 } { 20 20 } } ]
|
||||
[
|
||||
|
|
@ -20,18 +18,18 @@ IN: math.geometry.rect.tests
|
|||
[ f ] [
|
||||
T{ rect f { 100 100 } { 50 50 } }
|
||||
T{ rect f { 200 200 } { 40 40 } }
|
||||
intersects?
|
||||
contains-rect?
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
T{ rect f { 100 100 } { 50 50 } }
|
||||
T{ rect f { 120 120 } { 40 40 } }
|
||||
intersects?
|
||||
contains-rect?
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
T{ rect f { 1000 100 } { 50 50 } }
|
||||
T{ rect f { 120 120 } { 40 40 } }
|
||||
intersects?
|
||||
contains-rect?
|
||||
] unit-test
|
||||
|
||||
|
|
@ -0,0 +1,46 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel arrays sequences math math.vectors accessors ;
|
||||
IN: math.rectangles
|
||||
|
||||
TUPLE: rect { loc initial: { 0 0 } } { dim initial: { 0 0 } } ;
|
||||
|
||||
: <rect> ( loc dim -- rect ) rect boa ; inline
|
||||
|
||||
: <zero-rect> ( -- rect ) rect new ; inline
|
||||
|
||||
: point>rect ( loc -- rect ) { 0 0 } <rect> ; inline
|
||||
|
||||
: rect-bounds ( rect -- loc dim ) [ loc>> ] [ dim>> ] bi ;
|
||||
|
||||
: rect-extent ( rect -- loc ext ) rect-bounds over v+ ;
|
||||
|
||||
: with-rect-extents ( rect1 rect2 loc-quot: ( loc1 loc2 -- ) ext-quot: ( ext1 ext2 -- ) -- )
|
||||
[ [ rect-extent ] bi@ ] 2dip bi-curry* bi* ; inline
|
||||
|
||||
: <extent-rect> ( loc ext -- rect ) over [v-] <rect> ;
|
||||
|
||||
: offset-rect ( rect loc -- newrect )
|
||||
over loc>> v+ swap dim>> <rect> ;
|
||||
|
||||
: (rect-intersect) ( rect rect -- array array )
|
||||
[ vmax ] [ vmin ] with-rect-extents ;
|
||||
|
||||
: rect-intersect ( rect1 rect2 -- newrect )
|
||||
(rect-intersect) <extent-rect> ;
|
||||
|
||||
GENERIC: contains-rect? ( rect1 rect2 -- ? )
|
||||
|
||||
M: rect contains-rect?
|
||||
(rect-intersect) [v-] { 0 0 } = ;
|
||||
|
||||
GENERIC: contains-point? ( point rect -- ? )
|
||||
|
||||
M: rect contains-point?
|
||||
[ point>rect ] dip contains-rect? ;
|
||||
|
||||
: (rect-union) ( rect rect -- array array )
|
||||
[ vmin ] [ vmax ] with-rect-extents ;
|
||||
|
||||
: rect-union ( rect1 rect2 -- newrect )
|
||||
(rect-union) <extent-rect> ;
|
||||
|
|
@ -6,7 +6,7 @@ cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types
|
|||
cocoa.windows cocoa.classes cocoa.nibs sequences system ui
|
||||
ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
|
||||
ui.backend.cocoa.views core-foundation core-foundation.run-loop
|
||||
core-graphics.types threads math.geometry.rect fry libc
|
||||
core-graphics.types threads math.rectangles fry libc
|
||||
generalizations alien.c-types cocoa.views
|
||||
combinators io.thread ;
|
||||
IN: ui.backend.cocoa
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
IN: ui.backend.cocoa.views.tests
|
||||
USING: ui.backend.cocoa.views tools.test kernel math.geometry.rect
|
||||
USING: ui.backend.cocoa.views tools.test kernel math.rectangles
|
||||
namespaces ;
|
||||
|
||||
[ t ] [
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ math cocoa.messages cocoa.subclassing cocoa.classes cocoa.views
|
|||
cocoa.application cocoa.pasteboard cocoa.types cocoa.windows
|
||||
sequences ui ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gestures
|
||||
core-foundation.strings core-graphics core-graphics.types
|
||||
threads combinators math.geometry.rect ;
|
||||
threads combinators math.rectangles ;
|
||||
IN: ui.backend.cocoa.views
|
||||
|
||||
: send-mouse-moved ( view event -- )
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ windows.kernel32 windows.gdi32 windows.user32 windows.opengl32
|
|||
windows.messages windows.types windows.nt windows threads libc
|
||||
combinators fry combinators.short-circuit continuations
|
||||
command-line shuffle opengl ui.render ascii math.bitwise locals
|
||||
accessors math.geometry.rect math.order ascii calendar
|
||||
accessors math.rectangles math.order ascii calendar
|
||||
io.encodings.utf16n ;
|
||||
IN: ui.backend.windows
|
||||
|
||||
|
|
@ -434,7 +434,7 @@ M: windows-ui-backend do-events
|
|||
style 0 ex-style AdjustWindowRectEx win32-error=0/f ;
|
||||
|
||||
: make-RECT ( world -- RECT )
|
||||
[ window-loc>> dup ] [ rect-dim ] bi v+
|
||||
[ window-loc>> dup ] [ dim>> ] bi v+
|
||||
"RECT" <c-object>
|
||||
over first over set-RECT-right
|
||||
swap second over set-RECT-bottom
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ ui.event-loop assocs kernel math namespaces opengl
|
|||
sequences strings x11.xlib x11.events x11.xim x11.glx
|
||||
x11.clipboard x11.constants x11.windows io.encodings.string
|
||||
io.encodings.ascii io.encodings.utf8 combinators command-line
|
||||
math.vectors classes.tuple opengl.gl threads math.geometry.rect
|
||||
math.vectors classes.tuple opengl.gl threads math.rectangles
|
||||
environment ascii ;
|
||||
IN: ui.backend.x11
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel sequences models ui.gadgets
|
||||
math.geometry.rect fry ;
|
||||
math.rectangles fry ;
|
||||
IN: ui.gadgets.books
|
||||
|
||||
TUPLE: book < gadget ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
IN: ui.gadgets.borders.tests
|
||||
USING: tools.test accessors namespaces kernel
|
||||
ui.gadgets ui.gadgets.borders math.geometry.rect ;
|
||||
ui.gadgets ui.gadgets.borders math.rectangles ;
|
||||
|
||||
[ { 110 210 } ] [ <gadget> { 100 200 } >>dim { 5 5 } <border> pref-dim ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays ui.gadgets kernel math
|
||||
namespaces vectors sequences math.vectors math.geometry.rect ;
|
||||
namespaces vectors sequences math.vectors math.rectangles ;
|
||||
IN: ui.gadgets.borders
|
||||
|
||||
TUPLE: border < gadget
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ strings quotations assocs combinators classes colors
|
|||
classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets
|
||||
ui.gadgets.borders ui.gadgets.labels ui.gadgets.theme
|
||||
ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures
|
||||
ui.render math.geometry.rect locals alien.c-types
|
||||
ui.render math.rectangles locals alien.c-types
|
||||
specialized-arrays.float fry combinators.smart ;
|
||||
IN: ui.gadgets.buttons
|
||||
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ combinators assocs math.order fry calendar alarms continuations
|
|||
ui.clipboards ui.commands ui.gadgets ui.gadgets.borders
|
||||
ui.gadgets.buttons ui.gadgets.labels ui.gadgets.scrollers
|
||||
ui.gadgets.theme ui.gadgets.menus ui.gadgets.wrappers ui.render
|
||||
ui.text ui.gestures math.geometry.rect splitting unicode.categories
|
||||
ui.text ui.gestures math.rectangles splitting unicode.categories
|
||||
fonts ;
|
||||
IN: ui.gadgets.editors
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
USING: help.markup help.syntax opengl kernel strings
|
||||
classes.tuple classes quotations models math.geometry.rect
|
||||
classes.tuple classes quotations models math.rectangles
|
||||
ui.gadgets.private ;
|
||||
IN: ui.gadgets
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
USING: accessors ui.gadgets ui.gadgets.private ui.gadgets.packs
|
||||
ui.gadgets.worlds tools.test namespaces models kernel dlists deques
|
||||
math sets math.parser ui sequences hashtables assocs io arrays
|
||||
prettyprint io.streams.string math.geometry.rect ;
|
||||
prettyprint io.streams.string math.rectangles ui.gadgets.private ;
|
||||
IN: ui.gadgets.tests
|
||||
|
||||
[ { 300 300 } ]
|
||||
|
|
@ -37,14 +37,14 @@ IN: ui.gadgets.tests
|
|||
"g3" get "g2" get add-gadget drop
|
||||
|
||||
[ { 30 30 } ] [ "g1" get screen-loc ] unit-test
|
||||
[ { 30 30 } ] [ "g1" get screen-rect rect-loc ] unit-test
|
||||
[ { 30 30 } ] [ "g1" get screen-rect rect-dim ] unit-test
|
||||
[ { 30 30 } ] [ "g1" get screen-rect loc>> ] unit-test
|
||||
[ { 30 30 } ] [ "g1" get screen-rect dim>> ] unit-test
|
||||
[ { 20 20 } ] [ "g2" get screen-loc ] unit-test
|
||||
[ { 20 20 } ] [ "g2" get screen-rect rect-loc ] unit-test
|
||||
[ { 50 180 } ] [ "g2" get screen-rect rect-dim ] unit-test
|
||||
[ { 20 20 } ] [ "g2" get screen-rect loc>> ] unit-test
|
||||
[ { 50 180 } ] [ "g2" get screen-rect dim>> ] unit-test
|
||||
[ { 0 0 } ] [ "g3" get screen-loc ] unit-test
|
||||
[ { 0 0 } ] [ "g3" get screen-rect rect-loc ] unit-test
|
||||
[ { 100 200 } ] [ "g3" get screen-rect rect-dim ] unit-test
|
||||
[ { 0 0 } ] [ "g3" get screen-rect loc>> ] unit-test
|
||||
[ { 100 200 } ] [ "g3" get screen-rect dim>> ] unit-test
|
||||
|
||||
<gadget> "g1" set
|
||||
"g1" get { 300 300 } >>dim drop
|
||||
|
|
@ -57,9 +57,9 @@ IN: ui.gadgets.tests
|
|||
"g3" get { 100 100 } >>loc
|
||||
{ 20 20 } >>dim drop
|
||||
|
||||
[ t ] [ { 30 30 } "g2" get inside? ] unit-test
|
||||
[ t ] [ { 30 30 } "g2" get contains-point? ] unit-test
|
||||
|
||||
[ t ] [ { 30 30 } "g1" get (pick-up) "g2" get eq? ] unit-test
|
||||
[ t ] [ { 30 30 } "g1" get pick-up "g2" get eq? ] unit-test
|
||||
|
||||
[ t ] [ { 30 30 } "g1" get pick-up "g2" get eq? ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -3,16 +3,28 @@
|
|||
USING: accessors arrays hashtables kernel models math namespaces
|
||||
make sequences quotations math.vectors combinators sorting
|
||||
binary-search vectors dlists deques models threads
|
||||
concurrency.flags math.order math.geometry.rect fry ;
|
||||
concurrency.flags math.order math.rectangles fry ;
|
||||
IN: ui.gadgets
|
||||
|
||||
! Values for orientation slot
|
||||
CONSTANT: horizontal { 1 0 }
|
||||
CONSTANT: vertical { 0 1 }
|
||||
|
||||
TUPLE: gadget < rect pref-dim parent children orientation focus
|
||||
visible? root? clipped? layout-state graft-state graft-node
|
||||
interior boundary model ;
|
||||
TUPLE: gadget < rect
|
||||
pref-dim
|
||||
parent
|
||||
children
|
||||
{ orientation initial: { 0 1 } }
|
||||
focus
|
||||
{ visible? initial: t }
|
||||
root?
|
||||
clipped?
|
||||
layout-state
|
||||
{ graft-state initial: { f f } }
|
||||
graft-node
|
||||
interior
|
||||
boundary
|
||||
model ;
|
||||
|
||||
M: gadget equal? 2drop f ;
|
||||
|
||||
|
|
@ -24,13 +36,7 @@ M: gadget model-changed 2drop ;
|
|||
|
||||
: nth-gadget ( n gadget -- child ) children>> nth ;
|
||||
|
||||
: init-gadget ( gadget -- gadget )
|
||||
init-rect
|
||||
{ 0 1 } >>orientation
|
||||
t >>visible?
|
||||
{ f f } >>graft-state ; inline
|
||||
|
||||
: new-gadget ( class -- gadget ) new init-gadget ; inline
|
||||
: new-gadget ( class -- gadget ) new ; inline
|
||||
|
||||
: <gadget> ( -- gadget )
|
||||
gadget new-gadget ;
|
||||
|
|
@ -52,7 +58,7 @@ GENERIC: user-input* ( str gadget -- ? )
|
|||
|
||||
M: gadget user-input* 2drop t ;
|
||||
|
||||
GENERIC: children-on ( rect/point gadget -- seq )
|
||||
GENERIC: children-on ( rect gadget -- seq )
|
||||
|
||||
M: gadget children-on nip children>> ;
|
||||
|
||||
|
|
@ -67,23 +73,20 @@ M: gadget children-on nip children>> ;
|
|||
PRIVATE>
|
||||
|
||||
: fast-children-on ( rect axis children -- from to )
|
||||
[ [ rect-loc ] 2dip (fast-children-on) 0 or ]
|
||||
[ [ loc>> ] 2dip (fast-children-on) 0 or ]
|
||||
[ [ rect-bounds v+ ] 2dip (fast-children-on) ?1+ ]
|
||||
3bi ;
|
||||
|
||||
<PRIVATE
|
||||
M: gadget contains-rect? ( bounds gadget -- ? )
|
||||
dup visible?>> [ call-next-method ] [ 2drop f ] if ;
|
||||
|
||||
: inside? ( bounds gadget -- ? )
|
||||
dup visible?>> [ intersects? ] [ 2drop f ] if ;
|
||||
|
||||
: (pick-up) ( point gadget -- gadget )
|
||||
dupd children-on [ inside? ] with find-last nip ;
|
||||
|
||||
PRIVATE>
|
||||
M: gadget contains-point? ( loc gadget -- ? )
|
||||
dup visible?>> [ call-next-method ] [ 2drop f ] if ;
|
||||
|
||||
: pick-up ( point gadget -- child/f )
|
||||
2dup (pick-up) dup
|
||||
[ nip [ rect-loc v- ] keep pick-up ] [ drop nip ] if ;
|
||||
2dup [ dup point>rect ] dip children-on
|
||||
[ contains-point? ] with find-last nip
|
||||
[ [ loc>> v- ] keep pick-up ] [ nip ] ?if ;
|
||||
|
||||
: max-dim ( dims -- dim ) { 0 0 } [ vmax ] reduce ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
USING: ui.gadgets ui.gadgets.grids tools.test kernel arrays
|
||||
namespaces math.geometry.rect accessors ui.gadgets.grids.private
|
||||
namespaces math.rectangles accessors ui.gadgets.grids.private
|
||||
ui.gadgets.debug sequences ;
|
||||
IN: ui.gadgets.grids.tests
|
||||
|
||||
|
|
@ -45,9 +45,9 @@ IN: ui.gadgets.grids.tests
|
|||
{ 10 10 } >>gap
|
||||
dup prefer
|
||||
dup layout
|
||||
rect-dim
|
||||
"a" get rect-dim
|
||||
"b" get rect-dim
|
||||
dim>>
|
||||
"a" get dim>>
|
||||
"b" get dim>>
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays kernel math math.order namespaces make sequences words io
|
||||
math.vectors ui.gadgets columns accessors strings.tables
|
||||
math.geometry.rect locals fry ;
|
||||
math.rectangles fry ;
|
||||
IN: ui.gadgets.grids
|
||||
|
||||
TUPLE: grid < gadget
|
||||
|
|
@ -17,14 +17,19 @@ grid
|
|||
: <grid> ( children -- grid )
|
||||
grid new-grid ;
|
||||
|
||||
:: grid-child ( grid i j -- gadget ) i j grid grid>> nth nth ;
|
||||
<PRIVATE
|
||||
|
||||
:: grid-add ( grid child i j -- grid )
|
||||
grid i j grid-child unparent
|
||||
grid child add-gadget
|
||||
child i j grid grid>> nth set-nth ;
|
||||
: grid@ ( grid pair -- col# row )
|
||||
swap [ first2 ] [ grid>> ] bi* nth ;
|
||||
|
||||
: grid-remove ( grid i j -- grid ) [ <gadget> ] 2dip grid-add ;
|
||||
PRIVATE>
|
||||
|
||||
: grid-child ( grid pair -- gadget ) grid@ nth ;
|
||||
|
||||
: grid-add ( grid child pair -- grid )
|
||||
[ nip grid-child unparent ] [ drop add-gadget ] [ swapd grid@ set-nth ] 3tri ;
|
||||
|
||||
: grid-remove ( grid pair -- grid ) [ <gadget> ] dip grid-add ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
|
@ -52,7 +57,7 @@ TUPLE: grid-layout grid gap fill? row-heights column-widths ;
|
|||
grid>> flip [ first ] iterate-cell-dims ;
|
||||
|
||||
: <grid-layout> ( grid -- grid-layout )
|
||||
grid-layout new
|
||||
\ grid-layout new
|
||||
swap
|
||||
[ grid>> [ [ <cell> ] map ] map >>grid ]
|
||||
[ fill?>> >>fill? ]
|
||||
|
|
@ -72,12 +77,13 @@ TUPLE: grid-layout grid gap fill? row-heights column-widths ;
|
|||
[ row-heights>> ] [ gap>> second ] bi
|
||||
accumulate-cell-dims ;
|
||||
|
||||
M: grid pref-dim*
|
||||
<grid-layout>
|
||||
: grid-pref-dim ( grid-layout -- dim )
|
||||
[ accumulate-cell-xs drop ]
|
||||
[ accumulate-cell-ys drop ]
|
||||
bi 2array ;
|
||||
|
||||
M: grid pref-dim* <grid-layout> grid-pref-dim ;
|
||||
|
||||
: (compute-cell-locs) ( grid-layout -- locs )
|
||||
[ accumulate-cell-xs nip ]
|
||||
[ accumulate-cell-ys nip ]
|
||||
|
|
@ -99,10 +105,12 @@ M: grid pref-dim*
|
|||
[ grid>> [ [ pref-dim>> ] map ] map ]
|
||||
if ;
|
||||
|
||||
M: grid layout*
|
||||
[ grid>> ] [ <grid-layout> [ cell-locs ] [ cell-dims ] bi ] bi
|
||||
: grid-layout ( children grid-layout -- )
|
||||
[ cell-locs ] [ cell-dims ] bi
|
||||
[ [ [ >>loc ] [ >>dim ] bi* drop ] 3each ] 3each ;
|
||||
|
||||
M: grid layout* [ grid>> ] [ <grid-layout> ] bi grid-layout ;
|
||||
|
||||
M: grid children-on ( rect gadget -- seq )
|
||||
dup children>> empty? [ 2drop f ] [
|
||||
{ 0 1 } swap grid>>
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io kernel math namespaces math.vectors ui.gadgets
|
||||
ui.gadgets.private ui.gadgets.packs accessors
|
||||
math.geometry.rect combinators ;
|
||||
math.rectangles combinators ;
|
||||
IN: ui.gadgets.incremental
|
||||
|
||||
TUPLE: incremental < pack cursor ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: locals accessors kernel math namespaces sequences
|
||||
math.vectors colors math.geometry.rect ui.commands ui.operations ui.gadgets
|
||||
math.vectors colors math.rectangles ui.commands ui.operations ui.gadgets
|
||||
ui.gadgets.buttons ui.gadgets.worlds ui.gestures ui.gadgets.theme
|
||||
ui.gadgets.packs ui.gadgets.glass ui.gadgets.borders ;
|
||||
IN: ui.gadgets.menus
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: ui.gadgets.packs ui.gadgets.packs.private ui.gadgets.labels
|
||||
ui.gadgets ui.gadgets.debug ui.render kernel namespaces tools.test
|
||||
math.parser sequences math.geometry.rect accessors ;
|
||||
math.parser sequences math.rectangles accessors ;
|
||||
IN: ui.gadgets.packs.tests
|
||||
|
||||
[ t ] [
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: arrays hashtables io kernel namespaces sequences
|
||||
io.styles strings quotations math opengl combinators memoize
|
||||
math.vectors sorting splitting assocs classes.tuple models
|
||||
continuations destructors accessors math.geometry.rect fry
|
||||
continuations destructors accessors math.rectangles fry
|
||||
fonts ui.gadgets ui.gadgets.private ui.gadgets.borders ui.gadgets.buttons
|
||||
ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.paragraphs
|
||||
ui.gadgets.incremental ui.gadgets.packs ui.gadgets.theme
|
||||
|
|
@ -59,7 +59,7 @@ M: pane gadget-selection ( pane -- string/f )
|
|||
GENERIC: draw-selection ( loc obj -- )
|
||||
|
||||
: if-fits ( rect quot -- )
|
||||
[ clip get over intersects? ] dip [ drop ] if ; inline
|
||||
[ clip get over contains-rect? ] dip [ drop ] if ; inline
|
||||
|
||||
M: gadget draw-selection ( loc gadget -- )
|
||||
swap offset-rect [
|
||||
|
|
@ -341,7 +341,7 @@ M: pack sloppy-pick-up* ( loc gadget -- n )
|
|||
[ orientation>> ] [ children>> ] bi (fast-children-on) ;
|
||||
|
||||
M: gadget sloppy-pick-up*
|
||||
children>> [ inside? ] with find-last drop ;
|
||||
children>> [ contains-point? ] with find-last drop ;
|
||||
|
||||
M: f sloppy-pick-up*
|
||||
2drop f ;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
USING: ui.gadgets help.markup help.syntax ui.gadgets.viewports
|
||||
ui.gadgets.sliders math.geometry.rect ;
|
||||
ui.gadgets.sliders math.rectangles ;
|
||||
IN: ui.gadgets.scrollers
|
||||
|
||||
HELP: scroller
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ USING: ui.gadgets ui.gadgets.scrollers namespaces tools.test
|
|||
kernel models models.compose models.range ui.gadgets.viewports
|
||||
ui.gadgets.labels ui.gadgets.grids ui.gadgets.frames
|
||||
ui.gadgets.sliders math math.vectors arrays sequences
|
||||
tools.test.ui math.geometry.rect accessors ui.gadgets.buttons
|
||||
tools.test.ui math.rectangles accessors ui.gadgets.buttons
|
||||
ui.gadgets.packs ;
|
||||
IN: ui.gadgets.scrollers.tests
|
||||
|
||||
|
|
@ -12,8 +12,8 @@ IN: ui.gadgets.scrollers.tests
|
|||
] unit-test
|
||||
|
||||
[ { 100 200 } ] [
|
||||
{ 100 200 } "g" get scroll>rect
|
||||
"s" get follows>> rect-loc
|
||||
{ 100 200 } point>rect "g" get scroll>rect
|
||||
"s" get follows>> loc>>
|
||||
] unit-test
|
||||
|
||||
[ ] [ "s" get scroll>bottom ] unit-test
|
||||
|
|
@ -28,7 +28,7 @@ IN: ui.gadgets.scrollers.tests
|
|||
"v" get [
|
||||
[ { 10 20 } ] [ "v" get model>> range-value ] unit-test
|
||||
|
||||
[ { 10 20 } ] [ "g" get rect-loc vneg viewport-gap v+ scroller-border v+ ] unit-test
|
||||
[ { 10 20 } ] [ "g" get loc>> vneg viewport-gap v+ scroller-border v+ ] unit-test
|
||||
] with-grafted-gadget
|
||||
|
||||
[ ] [
|
||||
|
|
@ -41,7 +41,7 @@ IN: ui.gadgets.scrollers.tests
|
|||
[ ] [ "s" get layout ] unit-test
|
||||
|
||||
"s" get [
|
||||
[ { 34 34 } ] [ "s" get viewport>> rect-dim ] unit-test
|
||||
[ { 34 34 } ] [ "s" get viewport>> dim>> ] unit-test
|
||||
|
||||
[ { 107 107 } ] [ "s" get viewport>> viewport-dim ] unit-test
|
||||
|
||||
|
|
@ -57,7 +57,7 @@ IN: ui.gadgets.scrollers.tests
|
|||
|
||||
[ { 10 20 } ] [ "s" get viewport>> model>> range-value ] unit-test
|
||||
|
||||
[ { 10 20 } ] [ "g" get rect-loc vneg viewport-gap v+ scroller-border v+ ] unit-test
|
||||
[ { 10 20 } ] [ "g" get loc>> vneg viewport-gap v+ scroller-border v+ ] unit-test
|
||||
] with-grafted-gadget
|
||||
|
||||
<gadget> { 600 400 } >>dim "g1" set
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: accessors arrays ui.gadgets ui.gadgets.viewports
|
|||
ui.gadgets.frames ui.gadgets.grids ui.gadgets.theme
|
||||
ui.gadgets.sliders ui.gestures kernel math namespaces sequences
|
||||
models models.range models.compose combinators math.vectors
|
||||
classes.tuple math.geometry.rect combinators.short-circuit ;
|
||||
classes.tuple math.rectangles combinators.short-circuit ;
|
||||
IN: ui.gadgets.scrollers
|
||||
|
||||
TUPLE: scroller < frame viewport x y follows ;
|
||||
|
|
@ -63,7 +63,7 @@ scroller H{
|
|||
{
|
||||
[ scroller-value vneg offset-rect viewport-gap offset-rect ]
|
||||
[ viewport>> dim>> rect-min ]
|
||||
[ viewport>> 2rect-extent [ v- { 0 0 } vmin ] [ v- { 0 0 } vmax ] 2bi* v+ ]
|
||||
[ viewport>> [ v- { 0 0 } vmin ] [ v- { 0 0 } vmax ] with-rect-extents v+ ]
|
||||
[ scroller-value v+ ]
|
||||
[ scroll ]
|
||||
} cleave ;
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: accessors arrays ui.gestures ui.gadgets ui.gadgets.buttons
|
|||
ui.gadgets.frames ui.gadgets.grids math.order
|
||||
ui.gadgets.theme ui.render kernel math namespaces sequences
|
||||
vectors models models.range math.vectors math.functions
|
||||
quotations colors math.geometry.rect fry ;
|
||||
quotations colors math.rectangles fry ;
|
||||
IN: ui.gadgets.sliders
|
||||
|
||||
TUPLE: elevator < gadget direction ;
|
||||
|
|
|
|||
|
|
@ -1,10 +1,11 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays colors fry kernel math
|
||||
math.geometry.rect math.order math.vectors namespaces opengl
|
||||
math.rectangles math.order math.vectors namespaces opengl
|
||||
sequences ui.gadgets ui.gadgets.scrollers ui.gadgets.status-bar
|
||||
ui.gadgets.worlds ui.gadgets.theme ui.gestures ui.render ui.text
|
||||
ui.gadgets.menus models math.ranges sequences combinators fonts ;
|
||||
ui.gadgets.menus math.rectangles models math.ranges sequences
|
||||
combinators fonts ;
|
||||
IN: ui.gadgets.tables
|
||||
|
||||
! Row rendererer protocol
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
USING: kernel ui.gadgets ui.gadgets.tracks tools.test
|
||||
math.geometry.rect accessors ;
|
||||
math.rectangles accessors ;
|
||||
IN: ui.gadgets.tracks.tests
|
||||
|
||||
[ { 100 100 } ] [
|
||||
|
|
|
|||
|
|
@ -1,9 +1,8 @@
|
|||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors io kernel namespaces fry
|
||||
math math.vectors math.geometry.rect math.order
|
||||
math math.vectors math.rectangles math.order
|
||||
sequences words ui.gadgets ui.gadgets.packs ;
|
||||
|
||||
IN: ui.gadgets.tracks
|
||||
|
||||
TUPLE: track < pack sizes ;
|
||||
|
|
@ -12,14 +11,13 @@ TUPLE: track < pack sizes ;
|
|||
sizes>> dup sift sum '[ dup [ _ / ] when ] map ;
|
||||
|
||||
: init-track ( track -- track )
|
||||
init-gadget
|
||||
V{ } clone >>sizes
|
||||
1 >>fill ;
|
||||
1 >>fill ; inline
|
||||
|
||||
: new-track ( orientation class -- track )
|
||||
new
|
||||
new-gadget
|
||||
init-track
|
||||
swap >>orientation ;
|
||||
swap >>orientation ; inline
|
||||
|
||||
: <track> ( orientation -- track ) track new-track ;
|
||||
|
||||
|
|
@ -67,4 +65,4 @@ M: track pref-dim* ( gadget -- dim )
|
|||
delete-nth
|
||||
] [ 2drop ] if ;
|
||||
|
||||
: clear-track ( track -- ) V{ } clone >>sizes clear-gadget ;
|
||||
: clear-track ( track -- ) [ sizes>> delete-all ] [ clear-gadget ] bi ;
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays ui.gadgets ui.gadgets.borders
|
||||
kernel math namespaces sequences models math.vectors
|
||||
math.geometry.rect ;
|
||||
math.rectangles ;
|
||||
IN: ui.gadgets.viewports
|
||||
|
||||
CONSTANT: viewport-gap { 3 3 }
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: accessors arrays assocs continuations kernel math models
|
||||
namespaces opengl sequences io combinators combinators.short-circuit
|
||||
fry math.vectors ui.gadgets ui.gestures ui.render ui.text ui.text.private
|
||||
ui.backend ui.gadgets.tracks math.geometry.rect ;
|
||||
ui.backend ui.gadgets.tracks math.rectangles ;
|
||||
IN: ui.gadgets.worlds
|
||||
|
||||
TUPLE: world < track
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: ui.gadgets ui.gestures help.markup help.syntax
|
||||
kernel classes strings opengl opengl.gl models
|
||||
math.geometry.rect math colors ;
|
||||
math.rectangles math colors ;
|
||||
IN: ui.render
|
||||
|
||||
HELP: gadget
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: accessors alien alien.c-types arrays hashtables io kernel
|
||||
math namespaces opengl opengl.gl opengl.glu sequences strings
|
||||
vectors combinators math.vectors ui.gadgets colors
|
||||
math.order math.geometry.rect locals specialized-arrays.float ;
|
||||
math.order math.rectangles locals specialized-arrays.float ;
|
||||
IN: ui.render
|
||||
|
||||
SYMBOL: clip
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
USING: help.markup help.syntax strings quotations debugger
|
||||
namespaces ui.backend ui.gadgets ui.gadgets.worlds
|
||||
ui.gadgets.tracks ui.gadgets.packs ui.gadgets.grids
|
||||
ui.gadgets.private math.geometry.rect colors ui.text fonts ;
|
||||
ui.gadgets.private math.rectangles colors ui.text fonts ;
|
||||
IN: ui
|
||||
|
||||
HELP: windows
|
||||
|
|
@ -102,7 +102,7 @@ ARTICLE: "gadgets" "Pre-made UI gadgets"
|
|||
|
||||
ARTICLE: "ui-geometry" "Gadget geometry"
|
||||
"The " { $link gadget } " class inherits from the " { $link rect } " class, and thus all gadgets have a bounding box:"
|
||||
{ $subsection "math.geometry.rect" }
|
||||
{ $subsection "math.rectangles" }
|
||||
"Word for converting from a child gadget's co-ordinate system to a parent's:"
|
||||
{ $subsection relative-loc }
|
||||
{ $subsection screen-loc }
|
||||
|
|
|
|||
|
|
@ -1,10 +1,10 @@
|
|||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math math.functions math.parser models
|
||||
models.filter models.range models.compose sequences ui
|
||||
ui.gadgets ui.gadgets.frames ui.gadgets.labels ui.gadgets.packs
|
||||
ui.gadgets.sliders ui.render math.geometry.rect accessors
|
||||
ui.gadgets.grids colors ;
|
||||
models.filter models.range models.compose sequences ui
|
||||
ui.gadgets ui.gadgets.frames ui.gadgets.labels ui.gadgets.packs
|
||||
ui.gadgets.sliders ui.render math.rectangles accessors
|
||||
ui.gadgets.grids colors ;
|
||||
IN: color-picker
|
||||
|
||||
! Simple example demonstrating the use of models.
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ USING: windows.dinput windows.dinput.constants parser
|
|||
alien.c-types windows.ole32 namespaces assocs kernel arrays
|
||||
vectors windows.kernel32 windows.com windows.dinput shuffle
|
||||
windows.user32 windows.messages sequences combinators locals
|
||||
math.geometry.rect ui.windows accessors math windows alien
|
||||
math.rectangles ui.windows accessors math windows alien
|
||||
alien.strings io.encodings.utf16 io.encodings.utf16n
|
||||
continuations byte-arrays game-input.dinput.keys-array
|
||||
game-input ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! From http://www.ffconsultancy.com/ocaml/maze/index.html
|
||||
USING: sequences namespaces math math.vectors opengl opengl.gl
|
||||
arrays kernel random ui ui.gadgets ui.gadgets.canvas ui.render
|
||||
math.order math.geometry.rect ;
|
||||
math.order math.rectangles ;
|
||||
IN: maze
|
||||
|
||||
: line-width 8 ;
|
||||
|
|
@ -53,7 +53,7 @@ TUPLE: maze < canvas ;
|
|||
|
||||
: <maze> ( -- gadget ) maze new-canvas ;
|
||||
|
||||
: n ( gadget -- n ) rect-dim first2 min line-width /i ;
|
||||
: n ( gadget -- n ) dim>> first2 min line-width /i ;
|
||||
|
||||
M: maze layout* delete-canvas-dlist ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
USING: arrays assocs help.markup help.syntax math.geometry.rect quadtrees quotations sequences ;
|
||||
USING: arrays assocs help.markup help.syntax math.rectangles quadtrees quotations sequences ;
|
||||
IN: quadtrees
|
||||
|
||||
ARTICLE: "quadtrees" "Quadtrees"
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
! (c) 2009 Joe Groff, see BSD license
|
||||
USING: assocs kernel tools.test quadtrees math.geometry.rect sorting ;
|
||||
USING: assocs kernel tools.test quadtrees math.rectangles sorting ;
|
||||
IN: quadtrees.tests
|
||||
|
||||
: unit-bounds ( -- rect ) { -1.0 -1.0 } { 2.0 2.0 } <rect> ;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
! (c) 2009 Joe Groff, see BSD license
|
||||
USING: assocs kernel math.geometry.rect combinators accessors
|
||||
USING: assocs kernel math.rectangles combinators accessors
|
||||
math.vectors vectors sequences math math.points math.geometry
|
||||
combinators.short-circuit arrays fry locals ;
|
||||
IN: quadtrees
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2006, 2007, 2008 Alex Chapman
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alarms arrays calendar kernel make math math.geometry.rect math.parser namespaces sequences system tetris.game tetris.gl ui.gadgets ui.gadgets.labels ui.gadgets.worlds ui.gadgets.status-bar ui.gestures ui.render ui ;
|
||||
USING: accessors alarms arrays calendar kernel make math math.rectangles math.parser namespaces sequences system tetris.game tetris.gl ui.gadgets ui.gadgets.labels ui.gadgets.worlds ui.gadgets.status-bar ui.gestures ui.render ui ;
|
||||
IN: tetris
|
||||
|
||||
TUPLE: tetris-gadget < gadget { tetris tetris } { alarm } ;
|
||||
|
|
@ -18,7 +18,7 @@ M: tetris-gadget pref-dim* drop { 200 400 } ;
|
|||
|
||||
M: tetris-gadget draw-gadget* ( gadget -- )
|
||||
[
|
||||
dup rect-dim [ first ] [ second ] bi rot tetris>> draw-tetris
|
||||
[ dim>> first2 ] [ tetris>> ] bi draw-tetris
|
||||
] keep update-status ;
|
||||
|
||||
: new-tetris ( gadget -- gadget )
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2006, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors math.vectors classes.tuple math.geometry.rect colors
|
||||
USING: accessors math.vectors classes.tuple math.rectangles colors
|
||||
kernel sequences models opengl math math.order namespaces
|
||||
ui.commands ui.gestures ui.render ui.gadgets
|
||||
ui.gadgets.labels ui.gadgets.scrollers
|
||||
|
|
|
|||
Loading…
Reference in New Issue