More 4DNav fixes
Slava Pestov
parent
987a89bc4d
commit
08c3842403
|
|
@ -3,6 +3,7 @@
|
|||
USING: kernel
|
||||
namespaces
|
||||
accessors
|
||||
assocs
|
||||
make
|
||||
math
|
||||
math.functions
|
||||
|
|
@ -16,6 +17,7 @@ colors
|
|||
colors.constants
|
||||
prettyprint
|
||||
vars
|
||||
call
|
||||
quotations
|
||||
io
|
||||
io.directories
|
||||
|
|
@ -27,8 +29,6 @@ ui.gadgets.panes
|
|||
ui.gadgets
|
||||
ui.traverse
|
||||
ui.gadgets.borders
|
||||
ui.gadgets.handler
|
||||
ui.gadgets.slate
|
||||
ui.gadgets.frames
|
||||
ui.gadgets.tracks
|
||||
ui.gadgets.labels
|
||||
|
|
@ -53,6 +53,7 @@ adsoda
|
|||
adsoda.tools
|
||||
;
|
||||
QUALIFIED-WITH: ui.pens.solid s
|
||||
QUALIFIED-WITH: ui.gadgets.wrappers w
|
||||
|
||||
|
||||
IN: 4DNav
|
||||
|
|
@ -392,6 +393,13 @@ USE: ui.gadgets.labeled.private
|
|||
add-gadget
|
||||
menu-quick-views add-gadget ;
|
||||
|
||||
TUPLE: handler < w:wrapper table ;
|
||||
|
||||
: <handler> ( child -- handler ) handler w:new-wrapper ;
|
||||
|
||||
M: handler handle-gesture ( gesture gadget -- ? )
|
||||
tuck table>> at dup [ call( gadget -- ) f ] [ 2drop t ] if ;
|
||||
|
||||
: add-keyboard-delegate ( obj -- obj )
|
||||
<handler>
|
||||
{
|
||||
|
|
|
|||
|
|
@ -24,7 +24,6 @@ ui.gadgets.panes
|
|||
ui.gadgets.scrollers
|
||||
prettyprint
|
||||
combinators
|
||||
rewrite-closures
|
||||
accessors
|
||||
values
|
||||
tools.walker
|
||||
|
|
@ -67,7 +66,7 @@ file-chooser H{
|
|||
[ directory? ] bi or ] filter
|
||||
;
|
||||
|
||||
: update-filelist-model ( file-chooser -- file-chooser )
|
||||
: update-filelist-model ( file-chooser -- )
|
||||
[ list-of-files ] [ model>> ] bi set-model ;
|
||||
|
||||
: init-filelist-model ( file-chooser -- file-chooser )
|
||||
|
|
@ -86,7 +85,7 @@ file-chooser H{
|
|||
: fc-go-home ( file-chooser -- )
|
||||
[ home ] (fc-go) ;
|
||||
|
||||
: fc-change-directory ( file-chooser file -- file-chooser )
|
||||
: fc-change-directory ( file-chooser file -- )
|
||||
dupd [ path>> value>> normalize-path ] [ name>> ] bi*
|
||||
append-path over path>> set-model
|
||||
update-filelist-model
|
||||
|
|
|
|||
|
|
@ -10,9 +10,9 @@ IN: 4DNav.turtle
|
|||
|
||||
VAR: self
|
||||
|
||||
: with-self ( quot obj -- ) [ >self call ] with-scope ;
|
||||
: with-self ( quot obj -- ) [ >self call ] with-scope ; inline
|
||||
|
||||
: save-self ( quot -- ) self> [ self> clone >self call ] dip >self ;
|
||||
: save-self ( quot -- ) self> [ self> clone >self call ] dip >self ; inline
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
|
|||
|
|
@ -1 +0,0 @@
|
|||
Eduardo Cavazos
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
|
||||
USING: kernel assocs ui.gestures ui.gadgets.wrappers accessors ;
|
||||
|
||||
IN: ui.gadgets.handler
|
||||
|
||||
TUPLE: handler < wrapper table ;
|
||||
|
||||
: <handler> ( child -- handler ) handler new-wrapper ;
|
||||
|
||||
M: handler handle-gesture ( gesture gadget -- ? )
|
||||
tuck table>> at dup [ call f ] [ 2drop t ] if ;
|
||||
|
|
@ -1 +0,0 @@
|
|||
Eduardo Cavazos
|
||||
|
|
@ -1,13 +0,0 @@
|
|||
! Copyright (C) 2009 Eduardo Cavazos
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax multiline ;
|
||||
IN: ui.gadgets.slate
|
||||
|
||||
ARTICLE: "ui.gadgets.slate" "Slate gadget"
|
||||
{ $description "A gadget with an 'action' slot which should be set to a callable."}
|
||||
{ $heading "Example" }
|
||||
{ $code <" USING: processing.shapes ui.gadgets.slate ui.gadgets.panes ;
|
||||
[ { { 10 10 } { 50 30 } { 10 50 } } polygon fill-mode ] <slate>
|
||||
gadget."> } ;
|
||||
|
||||
ABOUT: "ui.gadgets.slate"
|
||||
|
|
@ -1,124 +0,0 @@
|
|||
! Copyright (C) 2009 Eduardo Cavazos
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel namespaces opengl ui.render ui.gadgets accessors ;
|
||||
|
||||
IN: ui.gadgets.slate
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: slate < gadget action pdim graft ungraft ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: init-slate ( slate -- slate )
|
||||
[ ] >>action
|
||||
{ 200 200 } >>pdim
|
||||
[ ] >>graft
|
||||
[ ] >>ungraft ;
|
||||
|
||||
: <slate> ( action -- slate )
|
||||
slate new
|
||||
init-slate
|
||||
swap >>action ;
|
||||
|
||||
M: slate pref-dim* ( slate -- dim ) pdim>> ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
USING: combinators arrays sequences math
|
||||
opengl.gl ui.gadgets.worlds ;
|
||||
|
||||
: width ( rect -- w ) dim>> first ;
|
||||
: height ( rect -- h ) dim>> second ;
|
||||
|
||||
: screen-y* ( gadget -- loc )
|
||||
{
|
||||
[ find-world height ]
|
||||
[ screen-loc second ]
|
||||
[ height ]
|
||||
}
|
||||
cleave
|
||||
+ - ;
|
||||
|
||||
: screen-loc* ( gadget -- loc )
|
||||
{
|
||||
[ screen-loc first ]
|
||||
[ screen-y* ]
|
||||
}
|
||||
cleave
|
||||
2array ;
|
||||
|
||||
: setup-viewport ( gadget -- gadget )
|
||||
dup
|
||||
{
|
||||
[ screen-loc* ]
|
||||
[ dim>> ]
|
||||
}
|
||||
cleave
|
||||
gl-viewport ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: default-coordinate-system ( gadget -- gadget )
|
||||
dup
|
||||
{
|
||||
[ drop 0 ]
|
||||
[ width 1 - ]
|
||||
[ height 1 - ]
|
||||
[ drop 0 ]
|
||||
}
|
||||
cleave
|
||||
-1 1
|
||||
glOrtho ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
M: slate graft* ( slate -- ) graft>> call ;
|
||||
M: slate ungraft* ( slate -- ) ungraft>> call ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
GENERIC: establish-coordinate-system ( gadget -- gadget )
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
M: slate establish-coordinate-system ( slate -- slate )
|
||||
default-coordinate-system ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
GENERIC: draw-slate ( slate -- slate )
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
M: slate draw-slate ( slate -- slate ) dup action>> call ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
M: slate draw-gadget* ( slate -- )
|
||||
|
||||
GL_PROJECTION glMatrixMode glPushMatrix glLoadIdentity
|
||||
|
||||
establish-coordinate-system
|
||||
|
||||
GL_MODELVIEW glMatrixMode glPushMatrix glLoadIdentity
|
||||
|
||||
setup-viewport
|
||||
|
||||
draw-slate
|
||||
|
||||
GL_PROJECTION glMatrixMode glPopMatrix glLoadIdentity
|
||||
GL_MODELVIEW glMatrixMode glPopMatrix glLoadIdentity
|
||||
|
||||
dup
|
||||
find-world
|
||||
! The world coordinate system is a little wacky:
|
||||
dup { [ drop 0 ] [ width ] [ height ] [ drop 0 ] } cleave -1 1 glOrtho
|
||||
setup-viewport
|
||||
drop
|
||||
drop ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
Loading…
Reference in New Issue