Code somplification

slava 2006-07-20 00:23:08 +00:00
parent f194a7bc77
commit 0a47cd4a75
4 changed files with 36 additions and 36 deletions

View File

@ -17,6 +17,7 @@
+ ui:
- editor:
- delegation issue with fields and interactors
- multi-line inserts
- scroll to caret
- only redraw visible lines

View File

@ -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

View File

@ -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 -- )

View File

@ -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*