Update 4DNav for new_ui
Slava Pestov
parent
20db7ea3c1
commit
72d9be21ae
|
|
@ -13,6 +13,7 @@ sequences
|
|||
combinators
|
||||
continuations
|
||||
colors
|
||||
colors.constants
|
||||
prettyprint
|
||||
vars
|
||||
quotations
|
||||
|
|
@ -28,23 +29,19 @@ ui.gadgets.panes
|
|||
ui.gadgets.borders
|
||||
ui.gadgets.handler
|
||||
ui.gadgets.slate
|
||||
ui.gadgets.theme
|
||||
ui.gadgets.frames
|
||||
ui.gadgets.tracks
|
||||
ui.gadgets.labels
|
||||
ui.gadgets.labelled
|
||||
ui.gadgets.labeled
|
||||
ui.gadgets.lists
|
||||
ui.gadgets.buttons
|
||||
ui.gadgets.packs
|
||||
ui.gadgets.grids
|
||||
ui.gestures
|
||||
ui.tools.workspace
|
||||
ui.gadgets.scrollers
|
||||
splitting
|
||||
vectors
|
||||
math.vectors
|
||||
rewrite-closures
|
||||
self
|
||||
values
|
||||
4DNav.turtle
|
||||
4DNav.window3D
|
||||
|
|
@ -55,6 +52,8 @@ fry
|
|||
adsoda
|
||||
adsoda.tools
|
||||
;
|
||||
QUALIFIED-WITH: ui.pens.solid s
|
||||
|
||||
|
||||
IN: 4DNav
|
||||
VALUE: selected-file
|
||||
|
|
@ -74,10 +73,13 @@ VAR: present-space
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! replacement of namespaces.lib
|
||||
! namespace utilities
|
||||
|
||||
: make* ( seq -- seq ) [ dup quotation? [ call ] [ ] if ] map ;
|
||||
|
||||
: closed-quot ( quot -- quot )
|
||||
namestack swap '[ namestack [ _ set-namestack @ ] dip set-namestack ] ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! waiting for deep-cleave-quots
|
||||
|
||||
|
|
@ -131,11 +133,11 @@ VAR: present-space
|
|||
: model-projection-chooser ( -- gadget )
|
||||
observer3d> projection-mode>>
|
||||
{ { 1 "perspective" } { 0 "orthogonal" } }
|
||||
<toggle-buttons> ;
|
||||
<radio-buttons> ;
|
||||
|
||||
: collision-detection-chooser ( -- gadget )
|
||||
observer3d> collision-mode>>
|
||||
{ { t "on" } { f "off" } } <toggle-buttons> ;
|
||||
{ { t "on" } { f "off" } } <radio-buttons> ;
|
||||
|
||||
: model-projection ( x -- space )
|
||||
present-space> swap space-project ;
|
||||
|
|
@ -184,8 +186,11 @@ VAR: present-space
|
|||
! menu
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
USE: ui.gadgets.labeled.private
|
||||
|
||||
: menu-rotations-4D ( -- gadget )
|
||||
<frame>
|
||||
3 3 <frame>
|
||||
{ 1 1 } >>filled-cell
|
||||
<pile> 1 >>fill
|
||||
"XY +" [ drop rotation-step 4D-Rxy rotation-4D ]
|
||||
button* add-gadget
|
||||
|
|
@ -225,7 +230,8 @@ VAR: present-space
|
|||
;
|
||||
|
||||
: menu-translations-4D ( -- gadget )
|
||||
<frame>
|
||||
3 3 <frame>
|
||||
{ 1 1 } >>filled-cell
|
||||
<pile> 1 >>fill
|
||||
<shelf> 1 >>fill
|
||||
"X+" [ drop { 1 0 0 0 } translation-step v*n
|
||||
|
|
@ -325,12 +331,13 @@ VAR: present-space
|
|||
[ ".xml" tail? ] filter
|
||||
[ append-path ] with map
|
||||
[ <run-file-button> add-gadget ] each
|
||||
swap <labelled-gadget> ;
|
||||
swap <labeled-gadget> ;
|
||||
|
||||
! -----------------------------------------------------
|
||||
|
||||
: menu-rotations-3D ( -- gadget )
|
||||
<frame>
|
||||
3 3 <frame>
|
||||
{ 1 1 } >>filled-cell
|
||||
"Turn\n left" [ rotation-step turn-left ]
|
||||
camera-button @left grid-add
|
||||
"Turn\n right" [ rotation-step turn-right ]
|
||||
|
|
@ -348,7 +355,8 @@ VAR: present-space
|
|||
;
|
||||
|
||||
: menu-translations-3D ( -- gadget )
|
||||
<frame>
|
||||
3 3 <frame>
|
||||
{ 1 1 } >>filled-cell
|
||||
"left\n(alt)" [ translation-step strafe-left ]
|
||||
camera-button @left grid-add
|
||||
"right\n(alt)" [ translation-step strafe-right ]
|
||||
|
|
@ -477,8 +485,7 @@ M: space adsoda-display-model
|
|||
{ 0 1 } <track>
|
||||
menu-bar f track-add
|
||||
<list-runner>
|
||||
<limited-scroller>
|
||||
{ 200 400 } >>max-dim
|
||||
<scroller>
|
||||
f track-add
|
||||
<shelf>
|
||||
"Projection mode : " <label> add-gadget
|
||||
|
|
@ -492,17 +499,17 @@ M: space adsoda-display-model
|
|||
<pile>
|
||||
0.5 >>align
|
||||
menu-4D add-gadget
|
||||
light-purple solid-interior
|
||||
"4D movements" <labelled-gadget>
|
||||
COLOR: purple s:<solid> >>interior
|
||||
"4D movements" <labeled-gadget>
|
||||
f track-add
|
||||
<pile>
|
||||
0.5 >>align
|
||||
{ 2 2 } >>gap
|
||||
menu-3D add-gadget
|
||||
light-purple solid-interior
|
||||
"Camera 3D" <labelled-gadget>
|
||||
COLOR: purple s:<solid> >>interior
|
||||
"Camera 3D" <labeled-gadget>
|
||||
f track-add
|
||||
gray solid-interior
|
||||
COLOR: gray s:<solid> >>interior
|
||||
;
|
||||
|
||||
: viewer-windows* ( -- )
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
USING: kernel namespaces math.vectors opengl 4DNav.turtle
|
||||
self ;
|
||||
USING: kernel namespaces math.vectors opengl 4DNav.turtle ;
|
||||
|
||||
IN: 4DNav.camera
|
||||
|
||||
|
|
|
|||
|
|
@ -139,9 +139,9 @@ file-chooser H{
|
|||
f track-add
|
||||
<shelf>
|
||||
over [ swap fc-go-parent ] curry "go up"
|
||||
swap <bevel-button> add-gadget
|
||||
swap <border-button> add-gadget
|
||||
over [ swap fc-go-home ] curry "go home"
|
||||
swap <bevel-button> add-gadget
|
||||
swap <border-button> add-gadget
|
||||
! over [ swap fc-ok-action ] curry "OK"
|
||||
! swap <bevel-button> add-gadget
|
||||
! [ drop ] "Cancel" swap <bevel-button> add-gadget
|
||||
|
|
|
|||
|
|
@ -2,10 +2,18 @@ USING: kernel math arrays math.vectors math.matrices
|
|||
namespaces make
|
||||
math.constants math.functions
|
||||
math.vectors
|
||||
splitting grouping self math.trig
|
||||
sequences accessors 4DNav.deep models ;
|
||||
splitting grouping math.trig
|
||||
sequences accessors 4DNav.deep models vars ;
|
||||
IN: 4DNav.turtle
|
||||
|
||||
! replacement of self
|
||||
|
||||
VAR: self
|
||||
|
||||
: with-self ( quot obj -- ) [ >self call ] with-scope ;
|
||||
|
||||
: save-self ( quot -- ) self> [ self> clone >self call ] dip >self ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: turtle pos ori ;
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@ IN: 4DNav.window3D
|
|||
TUPLE: window3D < gadget observer ;
|
||||
|
||||
: <window3D> ( model observer -- gadget )
|
||||
window3D new-gadget
|
||||
window3D new
|
||||
swap 2dup
|
||||
projection-mode>> add-connection
|
||||
2dup
|
||||
|
|
|
|||
|
|
@ -4,8 +4,7 @@ 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
|
||||
ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.packs
|
||||
ui.gadgets.theme ;
|
||||
ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.packs ;
|
||||
IN: ui.gadgets.lists
|
||||
|
||||
TUPLE: list < pack index presenter color hook ;
|
||||
|
|
@ -14,7 +13,7 @@ TUPLE: list < pack index presenter color hook ;
|
|||
selection-color >>color ; inline
|
||||
|
||||
: <list> ( hook presenter model -- gadget )
|
||||
list new-gadget
|
||||
list new
|
||||
{ 0 1 } >>orientation
|
||||
1 >>fill
|
||||
0 >>index
|
||||
|
|
|
|||
0
unmaintained/rewrite-closures/authors.txt → extra/ui/gadgets/slate/authors.txt
Normal file → Executable file
0
unmaintained/rewrite-closures/authors.txt → extra/ui/gadgets/slate/authors.txt
Normal file → Executable file
|
|
@ -14,7 +14,6 @@ TUPLE: slate < gadget action pdim graft ungraft ;
|
|||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: init-slate ( slate -- slate )
|
||||
init-gadget
|
||||
[ ] >>action
|
||||
{ 200 200 } >>pdim
|
||||
[ ] >>graft
|
||||
|
|
@ -29,9 +28,12 @@ M: slate pref-dim* ( slate -- dim ) pdim>> ;
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
USING: combinators arrays sequences math math.geometry
|
||||
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 ]
|
||||
|
|
@ -1,27 +0,0 @@
|
|||
|
||||
USING: kernel parser math quotations namespaces sequences macros fry ;
|
||||
|
||||
IN: rewrite-closures
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: [set-parameters] ( seq -- quot ) reverse [ [ set ] curry ] map concat ;
|
||||
|
||||
MACRO: set-parameters ( seq -- quot ) [set-parameters] ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: parametric-quot ( parameters quot -- quot ) '[ _ set-parameters _ call ] ;
|
||||
|
||||
: scoped-quot ( quot -- quot ) '[ _ with-scope ] ;
|
||||
|
||||
: closed-quot ( quot -- quot )
|
||||
namestack swap '[ namestack [ _ set-namestack @ ] dip set-namestack ] ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: lambda ( parameters quot -- quot ) parametric-quot scoped-quot closed-quot ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: C[ \ ] [ >quotation ] parse-literal \ closed-quot parsed ; parsing
|
||||
|
|
@ -1 +0,0 @@
|
|||
Closures implemented via quotation rewriting
|
||||
|
|
@ -1 +0,0 @@
|
|||
extensions
|
||||
|
|
@ -1 +0,0 @@
|
|||
Eduardo Cavazos
|
||||
|
|
@ -1,10 +0,0 @@
|
|||
|
||||
USING: kernel namespaces vars ;
|
||||
|
||||
IN: self
|
||||
|
||||
VAR: self
|
||||
|
||||
: with-self ( quot obj -- ) [ >self call ] with-scope ;
|
||||
|
||||
: save-self ( quot -- ) self> [ self> clone >self call ] dip >self ;
|
||||
|
|
@ -1,27 +0,0 @@
|
|||
|
||||
USING: kernel words lexer parser sequences accessors self ;
|
||||
|
||||
IN: self.slots
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: define-self-slot-reader ( slot -- )
|
||||
[ "->" append current-vocab create dup set-word ]
|
||||
[ ">>" append search [ self> ] swap suffix ] bi
|
||||
(( -- value )) define-declared ;
|
||||
|
||||
: define-self-slot-writer ( slot -- )
|
||||
[ "->" prepend current-vocab create dup set-word ]
|
||||
[ ">>" prepend search [ self> swap ] swap suffix [ drop ] append ] bi
|
||||
(( value -- )) define-declared ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: define-self-slot-accessors ( class -- )
|
||||
"slots" word-prop
|
||||
[ name>> ] map
|
||||
[ [ define-self-slot-reader ] [ define-self-slot-writer ] bi ] each ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: SELF-SLOTS: scan-word define-self-slot-accessors ; parsing
|
||||
|
|
@ -1 +0,0 @@
|
|||
Eduardo Cavazos
|
||||
Loading…
Reference in New Issue