Code somplification
parent
f194a7bc77
commit
0a47cd4a75
|
@ -17,6 +17,7 @@
|
|||
+ ui:
|
||||
|
||||
- editor:
|
||||
- delegation issue with fields and interactors
|
||||
- multi-line inserts
|
||||
- scroll to caret
|
||||
- only redraw visible lines
|
||||
|
|
|
@ -1,25 +1,23 @@
|
|||
! Copyright (C) 2005, 2006 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: gadgets-panes
|
||||
USING: arrays gadgets gadgets-buttons gadgets-controls
|
||||
gadgets-frames gadgets-grids gadgets-labels gadgets-scrolling
|
||||
gadgets-theme generic hashtables io kernel math namespaces
|
||||
sequences strings ;
|
||||
USING: gadgets gadgets-buttons gadgets-controls gadgets-labels
|
||||
gadgets-scrolling gadgets-theme generic hashtables io kernel
|
||||
namespaces sequences ;
|
||||
|
||||
TUPLE: pane output active current prototype scrolls? ;
|
||||
TUPLE: pane output current prototype scrolls? ;
|
||||
|
||||
: add-output 2dup set-pane-output add-gadget ;
|
||||
|
||||
: init-line ( pane -- )
|
||||
dup pane-prototype clone swap set-pane-current ;
|
||||
: add-current 2dup set-pane-current add-gadget ;
|
||||
|
||||
: prepare-line ( pane -- )
|
||||
dup init-line dup pane-active unparent
|
||||
[ pane-current 1array make-shelf ] keep
|
||||
2dup set-pane-active add-gadget ;
|
||||
dup pane-prototype clone swap add-current ;
|
||||
|
||||
: pane-clear ( pane -- )
|
||||
dup pane-output clear-incremental pane-current clear-gadget ;
|
||||
dup
|
||||
pane-output clear-incremental
|
||||
pane-current clear-gadget ;
|
||||
|
||||
C: pane ( -- pane )
|
||||
<pile> over set-delegate
|
||||
|
@ -58,11 +56,7 @@ C: pane ( -- pane )
|
|||
M: pane stream-flush ( pane -- ) drop ;
|
||||
|
||||
: scroll-pane ( pane -- )
|
||||
dup pane-scrolls? [
|
||||
find-scroller [ scroll>bottom ] when*
|
||||
] [
|
||||
drop
|
||||
] if ;
|
||||
dup pane-scrolls? [ scroll>bottom ] [ drop ] if ;
|
||||
|
||||
M: pane stream-terpri ( pane -- )
|
||||
dup pane-current prepare-print
|
||||
|
|
|
@ -16,12 +16,6 @@ TUPLE: scroller viewport x y follows ;
|
|||
|
||||
: find-scroller [ scroller? ] find-parent ;
|
||||
|
||||
: scroll>gadget ( gadget -- )
|
||||
#! Scroll the scroller that contains this gadget, if any, so
|
||||
#! that the gadget becomes visible.
|
||||
dup find-scroller dup
|
||||
[ [ set-scroller-follows ] keep relayout ] [ 2drop ] if ;
|
||||
|
||||
: scroll-up-line scroller-y -1 swap slide-by-line ;
|
||||
|
||||
: scroll-down-line scroller-y 1 swap slide-by-line ;
|
||||
|
@ -63,15 +57,15 @@ C: scroller ( gadget -- scroller )
|
|||
dupd over scroller-y update-slider
|
||||
position-viewport ;
|
||||
|
||||
: scroll>bottom ( scroller -- )
|
||||
t swap set-scroller-follows ;
|
||||
: scroll>bottom ( gadget -- )
|
||||
find-scroller [ t swap set-scroller-follows ] when* ;
|
||||
|
||||
: update-scroller ( scroller -- )
|
||||
dup scroller-follows [
|
||||
dup dup scroller-follows [
|
||||
f over set-scroller-follows
|
||||
dup rect-dim { 0 1 } v*
|
||||
scroller-viewport viewport-dim { 0 1 } v*
|
||||
] [
|
||||
drop dup scroller-origin
|
||||
scroller-origin
|
||||
] if scroll ;
|
||||
|
||||
M: scroller layout* ( scroller -- )
|
||||
|
|
|
@ -27,23 +27,34 @@ TUPLE: listener-gadget input output stack ;
|
|||
[ >r clear r> init-namespaces listener-thread ] in-thread
|
||||
drop ;
|
||||
|
||||
: <listener-input> ( -- gadget )
|
||||
gadget get listener-gadget-output <interactor> ;
|
||||
|
||||
: <pane-tile> ( model quot title -- gadget )
|
||||
>r <pane-control> <scroller> r> f <tile> ;
|
||||
|
||||
: <stack-tile> ( model title -- gadget )
|
||||
[ stack. ] swap <pane-tile> ;
|
||||
|
||||
: <stack-display> ( -- gadget )
|
||||
gadget get listener-gadget-stack "Stack" <stack-tile> ;
|
||||
: <listener-input> ( listener -- gadget )
|
||||
listener-gadget-input <scroller> "Input" f <tile> ;
|
||||
|
||||
: <stack-display> ( listener -- gadget )
|
||||
listener-gadget-stack "Stack" <stack-tile> ;
|
||||
|
||||
: <listener-bar> ( listener -- gadget )
|
||||
dup {
|
||||
{ [ <listener-input> ] f f 1/2 }
|
||||
{ [ <stack-display> ] f f 1/2 }
|
||||
} { 1 0 } make-track ;
|
||||
|
||||
: init-listener ( listener -- )
|
||||
f <model> over set-listener-gadget-stack
|
||||
<scrolling-pane> over set-listener-gadget-output
|
||||
dup listener-gadget-output <interactor>
|
||||
swap set-listener-gadget-input ;
|
||||
|
||||
C: listener-gadget ( -- gadget )
|
||||
f <model> over set-listener-gadget-stack {
|
||||
{ [ <scrolling-pane> ] set-listener-gadget-output [ <scroller> ] 4/6 }
|
||||
{ [ <listener-input> ] set-listener-gadget-input [ <scroller> ] 1/6 }
|
||||
{ [ <stack-display> ] f f 1/6 }
|
||||
dup init-listener {
|
||||
{ [ gadget get listener-gadget-output <scroller> ] f f 5/6 }
|
||||
{ [ gadget get <listener-bar> ] f f 1/6 }
|
||||
} { 0 1 } make-track* dup start-listener ;
|
||||
|
||||
M: listener-gadget pref-dim*
|
||||
|
|
Loading…
Reference in New Issue