UI cleanups
slava
parent
d0b79a9419
commit
49d2eed42a
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 <scroller> 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 ;
|
||||
|
||||
: <prompt> ( quot -- editor )
|
||||
"" <editor> [
|
||||
|
|
@ -24,11 +18,14 @@ TUPLE: apropos-gadget pane input ;
|
|||
dup commit-editor-text
|
||||
swap apropos-pane [ apropos ] with-pane ;
|
||||
|
||||
: <apropos-prompt> ( -- gadget )
|
||||
[ show-apropos ] <prompt> dup faint-boundary ;
|
||||
|
||||
C: apropos-gadget ( -- )
|
||||
<frame> over set-delegate
|
||||
<pane> over add-apropos-gadget-pane
|
||||
[ show-apropos ] <prompt> dup faint-boundary
|
||||
over add-apropos-gadget-input ;
|
||||
{
|
||||
{ [ <pane> <scroller> ] set-apropos-gadget-scroller @center }
|
||||
{ [ <apropos-prompt> ] set-apropos-gadget-input @top }
|
||||
} make-frame ;
|
||||
|
||||
M: apropos-gadget pref-dim* drop { 350 200 0 } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
<input-pane> dup pick set-listener-gadget-pane
|
||||
<scroller> over @center frame-add
|
||||
<stack-bar> dup pick set-listener-gadget-stack
|
||||
over @top frame-add
|
||||
dup start-listener ;
|
||||
{
|
||||
{ [ <stack-bar> ] set-listener-gadget-stack @top }
|
||||
{ [ <input-pane> <scroller> ] set-listener-gadget-scroller @center }
|
||||
} make-frame dup start-listener ;
|
||||
|
||||
M: listener-gadget pref-dim* drop { 600 600 0 } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 <viewport> r> add-viewport ] keep
|
||||
<x-slider> over add-x-slider
|
||||
<y-slider> over add-y-slider
|
||||
dup scroller-actions ;
|
||||
{
|
||||
{ [ <viewport> ] set-scroller-viewport @center }
|
||||
{ [ <x-slider> ] set-scroller-x @bottom }
|
||||
{ [ <y-slider> ] 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 ;
|
||||
|
|
|
|||
|
|
@ -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 } = ;
|
||||
|
||||
: <slide-button> ( orientation polygon amount -- )
|
||||
: <slide-button> ( vector polygon amount -- )
|
||||
>r { 0.5 0.5 0.5 1.0 } swap <polygon-gadget> r>
|
||||
[ swap slide-by-line ] curry <repeat-button>
|
||||
[ set-gadget-orientation ] keep ;
|
||||
|
||||
: <up-button> ( slider orientation -- button )
|
||||
swap slider-vertical? arrow-up arrow-left ? -1
|
||||
<slide-button> ;
|
||||
: <left-button> { 0 1 0 } arrow-left -1 <slide-button> ;
|
||||
: <right-button> { 0 1 0 } arrow-right 1 <slide-button> ;
|
||||
|
||||
: add-up { 1 1 1 } over gadget-orientation v- first2 frame-add ;
|
||||
: build-x-slider ( slider -- slider )
|
||||
{
|
||||
{ [ <left-button> ] f @left }
|
||||
{ [ { 0 1 0 } <elevator> ] set-slider-elevator @center }
|
||||
{ [ <right-button> ] f @right }
|
||||
} build-frame ;
|
||||
|
||||
: <down-button> ( slider orientation -- button )
|
||||
swap slider-vertical? arrow-down arrow-right ? 1
|
||||
<slide-button> ;
|
||||
: <up-button> { 1 0 0 } arrow-up -1 <slide-button> ;
|
||||
: <down-button> { 1 0 0 } arrow-down 1 <slide-button> ;
|
||||
|
||||
: add-down { 1 1 1 } over gadget-orientation v+ first2 frame-add ;
|
||||
: build-y-slider ( slider -- slider )
|
||||
{
|
||||
{ [ <up-button> ] f @top }
|
||||
{ [ { 1 0 0 } <elevator> ] set-slider-elevator @center }
|
||||
{ [ <down-button> ] 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 -- )
|
||||
<thumb> 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 <elevator> pick add-elevator
|
||||
2dup <up-button> pick add-up
|
||||
2dup <down-button> pick add-down
|
||||
<thumb> over add-thumb ;
|
||||
0 over set-slider-max ;
|
||||
|
||||
: <x-slider> ( -- slider ) { 1 0 0 } <slider> ;
|
||||
: <x-slider> ( -- slider )
|
||||
{ 1 0 0 } <slider> dup build-x-slider
|
||||
dup { 0 1 0 } add-thumb ;
|
||||
|
||||
: <y-slider> ( -- slider ) { 0 1 0 } <slider> ;
|
||||
: <y-slider> ( -- slider )
|
||||
{ 0 1 0 } <slider> dup build-y-slider
|
||||
dup { 1 0 0 } add-thumb ;
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Reference in New Issue