diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 6517c97144..348636c1ef 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -33,8 +33,11 @@ + ui/help: +- track: + - don't allow negative dimensions + - support removing items + - fix round-off error - zooming doesn't work -- sort out various round-off issues - implement handlers for open, quit events, and whatever else - fix top level window positioning - changing window titles diff --git a/library/ui/apropos.factor b/library/ui/apropos.factor index 893c262b9d..e455afecfd 100644 --- a/library/ui/apropos.factor +++ b/library/ui/apropos.factor @@ -3,17 +3,11 @@ USING: gadgets gadgets-editors gadgets-labels gadgets-layouts gadgets-panes gadgets-scrolling gadgets-theme generic inspector kernel ; -TUPLE: apropos-gadget pane input ; +TUPLE: apropos-gadget scroller input ; : apropos-pane ( gadget -- pane ) - [ apropos-gadget? ] find-parent apropos-gadget-pane ; - -: add-apropos-gadget-pane ( pane gadget -- ) - 2dup set-apropos-gadget-pane - >r r> @center frame-add ; - -: add-apropos-gadget-input ( input gadget -- ) - 2dup set-apropos-gadget-input @top frame-add ; + [ apropos-gadget? ] find-parent + apropos-gadget-scroller scroller-gadget ; : ( quot -- editor ) "" [ @@ -24,11 +18,14 @@ TUPLE: apropos-gadget pane input ; dup commit-editor-text swap apropos-pane [ apropos ] with-pane ; +: ( -- gadget ) + [ show-apropos ] dup faint-boundary ; + C: apropos-gadget ( -- ) - over set-delegate - over add-apropos-gadget-pane - [ show-apropos ] dup faint-boundary - over add-apropos-gadget-input ; + { + { [ ] set-apropos-gadget-scroller @center } + { [ ] set-apropos-gadget-input @top } + } make-frame ; M: apropos-gadget pref-dim* drop { 350 200 0 } ; diff --git a/library/ui/frames.factor b/library/ui/frames.factor index d6adca2f06..89c32867aa 100644 --- a/library/ui/frames.factor +++ b/library/ui/frames.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: gadgets-layouts -USING: arrays gadgets generic kernel math namespaces -sequences ; +USING: arrays gadgets generic kernel math namespaces sequences +words ; ! A frame arranges gadgets in a 3x3 grid, where the center ! gadgets gets left-over space. @@ -83,3 +83,20 @@ M: frame layout* ( frame -- dim ) swap reduce-grid [ second ] map 2dup ] keep rect-dim fill-center 3dup position-grid resize-grid ; + +: frame-add-spec ( { quot setter loc } -- ) + first3 >r >r call + frame get 2dup r> dup [ execute ] [ 3drop ] if + r> execute frame-add ; + +: build-frame ( gadget specs -- ) + #! Specs is an array of triples { quot setter loc }. + #! The setter has stack effect ( new gadget -- ), + #! the loc is @center, @top, etc. + [ swap frame set [ frame-add-spec ] each ] with-scope ; + +: make-frame ( gadget specs -- gadget ) + #! Specs is an array of triples { quot setter loc }. + #! The setter has stack effect ( new gadget -- ), + #! the loc is @center, @top, etc. + over [ delegate>frame build-frame ] keep ; diff --git a/library/ui/listener.factor b/library/ui/listener.factor index 2d5c3cd950..68ea0dfdc6 100644 --- a/library/ui/listener.factor +++ b/library/ui/listener.factor @@ -7,7 +7,10 @@ gadgets-theme generic hashtables io jedit kernel listener math namespaces parser prettyprint sequences styles threads words ; -TUPLE: listener-gadget pane stack ; +TUPLE: listener-gadget scroller stack ; + +: listener-gadget-pane ( listener -- pane ) + listener-gadget-scroller scroller-gadget ; : usable-words ( -- words ) use get hash-concat hash-values ; @@ -50,12 +53,10 @@ TUPLE: listener-gadget pane stack ; [ >r clear r> listener-thread ] in-thread drop ; C: listener-gadget ( -- gadget ) - dup delegate>frame - dup pick set-listener-gadget-pane - over @center frame-add - dup pick set-listener-gadget-stack - over @top frame-add - dup start-listener ; + { + { [ ] set-listener-gadget-stack @top } + { [ ] set-listener-gadget-scroller @center } + } make-frame dup start-listener ; M: listener-gadget pref-dim* drop { 600 600 0 } ; diff --git a/library/ui/scrolling.factor b/library/ui/scrolling.factor index 6e0dda3a26..2e40937278 100644 --- a/library/ui/scrolling.factor +++ b/library/ui/scrolling.factor @@ -71,12 +71,6 @@ M: viewport layout* ( viewport -- ) M: viewport focusable-child* ( viewport -- gadget ) gadget-child ; -: add-viewport 2dup set-scroller-viewport @center frame-add ; - -: add-x-slider 2dup set-scroller-x @bottom frame-add ; - -: add-y-slider 2dup set-scroller-y @right frame-add ; - : scroll-to ( gadget -- ) #! Scroll the scroller that contains this gadget, if any, so #! that the gadget becomes visible. @@ -94,11 +88,15 @@ M: viewport focusable-child* ( viewport -- gadget ) C: scroller ( gadget -- scroller ) #! Wrap a scrolling pane around the gadget. - dup delegate>frame - [ >r r> add-viewport ] keep - over add-x-slider - over add-y-slider - dup scroller-actions ; + { + { [ ] set-scroller-viewport @center } + { [ ] set-scroller-x @bottom } + { [ ] set-scroller-y @right } + } make-frame dup scroller-actions ; M: scroller focusable-child* ( scroller -- viewport ) scroller-viewport ; + +: scroller-gadget ( scroller -- gadget ) + #! Gadget being scrolled. + scroller-viewport gadget-child ; diff --git a/library/ui/sliders.factor b/library/ui/sliders.factor index cd386ee137..84bf94ab67 100644 --- a/library/ui/sliders.factor +++ b/library/ui/sliders.factor @@ -108,44 +108,46 @@ M: elevator layout* ( elevator -- ) : slide-by-line ( -1/1 slider -- ) >r 32 * r> slide-by ; -: slider-vertical? gadget-orientation { 0 1 0 } = ; - -: ( orientation polygon amount -- ) +: ( vector polygon amount -- ) >r { 0.5 0.5 0.5 1.0 } swap r> [ swap slide-by-line ] curry [ set-gadget-orientation ] keep ; -: ( slider orientation -- button ) - swap slider-vertical? arrow-up arrow-left ? -1 - ; +: { 0 1 0 } arrow-left -1 ; +: { 0 1 0 } arrow-right 1 ; -: add-up { 1 1 1 } over gadget-orientation v- first2 frame-add ; +: build-x-slider ( slider -- slider ) + { + { [ ] f @left } + { [ { 0 1 0 } ] set-slider-elevator @center } + { [ ] f @right } + } build-frame ; -: ( slider orientation -- button ) - swap slider-vertical? arrow-down arrow-right ? 1 - ; +: { 1 0 0 } arrow-up -1 ; +: { 1 0 0 } arrow-down 1 ; -: add-down { 1 1 1 } over gadget-orientation v+ first2 frame-add ; +: build-y-slider ( slider -- slider ) + { + { [ ] f @top } + { [ { 1 0 0 } ] set-slider-elevator @center } + { [ ] f @bottom } + } build-frame ; -: add-elevator 2dup set-slider-elevator @center frame-add ; - -: add-thumb 2dup slider-elevator add-gadget set-slider-thumb ; - -: slider-opposite ( slider -- vector ) - gadget-orientation { 1 1 0 } swap v- ; +: add-thumb ( slider vector -- ) + swap 2dup slider-elevator add-gadget + set-slider-thumb ; C: slider ( vector -- slider ) dup delegate>frame [ set-gadget-orientation ] keep 0 over set-slider-value 0 over set-slider-page - 0 over set-slider-max - dup slider-opposite - dup pick add-elevator - 2dup pick add-up - 2dup pick add-down - over add-thumb ; + 0 over set-slider-max ; -: ( -- slider ) { 1 0 0 } ; +: ( -- slider ) + { 1 0 0 } dup build-x-slider + dup { 0 1 0 } add-thumb ; -: ( -- slider ) { 0 1 0 } ; +: ( -- slider ) + { 0 1 0 } dup build-y-slider + dup { 1 0 0 } add-thumb ; diff --git a/library/ui/world.factor b/library/ui/world.factor index 511679d8b1..1f1897e408 100644 --- a/library/ui/world.factor +++ b/library/ui/world.factor @@ -9,7 +9,7 @@ math namespaces opengl sequences ; ! fonts: mapping font tuples to sprite vectors ! handle: native resource -TUPLE: world status focus fonts handle ; +TUPLE: world gadget status focus fonts handle ; : free-fonts ( world -- ) dup world-handle select-gl-context @@ -19,18 +19,16 @@ TUPLE: world status focus fonts handle ; : font-sprites ( font world -- sprites ) world-fonts [ drop V{ } clone ] cache ; -: add-status ( status world -- ) - [ set-world-status ] 2keep @bottom frame-add ; - DEFER: request-focus C: world ( gadget status -- world ) - dup delegate>frame + { + { [ ] set-world-status @bottom } + { [ ] f @center } + } make-frame t over set-gadget-root? H{ } clone over set-world-fonts - [ add-status ] keep - [ @center frame-add ] 2keep - swap request-focus ; + dup world-gadget request-focus ; GENERIC: find-world ( gadget -- world ) diff --git a/native/unix/signal.c b/native/unix/signal.c index 28b5f674a2..612949832d 100644 --- a/native/unix/signal.c +++ b/native/unix/signal.c @@ -18,9 +18,6 @@ static bool in_page(void *fault, void *i_area, CELL area_size, int offset) void signal_handler(int signal, siginfo_t* siginfo, void* uap) { - printf("fucked\n"); - fflush(stdout); - if(in_page(siginfo->si_addr, (void *) ds_bot, 0, -1)) general_error(ERROR_DS_UNDERFLOW,F,F,false); else if(in_page(siginfo->si_addr, (void *) ds_bot, ds_size, 0))