! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: gadgets-tracks
USING: gadgets gadgets-layouts gadgets-theme io kernel math
namespaces sequences ;

TUPLE: divider ;

: divider-# ( divider -- n )
    dup gadget-parent gadget-children index 2 /i ;

: divider-size { 8 8 0 } ;

M: divider pref-dim* drop divider-size ;

TUPLE: track sizes saved-sizes ;

C: track ( orientation -- track )
    [ delegate>pack ] keep 1 over set-pack-fill ;

: <x-track> { 0 1 0 } <track> ;

: <y-track> { 1 0 0 } <track> ;

: track-dim ( track -- dim )
    #! Space available for content (minus dividers)
    dup rect-dim swap track-sizes length 1-
    divider-size n*v v- ;

: track-layout ( track -- sizes )
    dup track-dim swap track-sizes
    [ [ over n*v , ] [ divider-size , ] interleave ] { } make
    nip ;

M: track layout* ( splitter -- )
    dup track-layout packed-layout ;

: divider-delta ( track -- delta )
    #! How far the divider has moved along the track?
    drag-loc over track-dim { 1 1 1 } vmax v/
    swap gadget-orientation v. ;

: +nth ( delta n seq -- ) swap [ + ] change-nth ;

: save-sizes ( track -- )
    dup track-sizes clone swap set-track-saved-sizes ;

: restore-sizes ( track -- )
    dup track-saved-sizes clone swap set-track-sizes ;

: change-divider ( delta n track -- )
    [
        dup restore-sizes
        track-sizes
        [ +nth ] 3keep
        >r 1+ >r neg r> r> 2dup length = [ 3drop ] [ +nth ] if
    ] keep relayout-1 ;

: divider-motion ( divider -- )
    dup gadget-parent divider-delta
    over divider-# rot gadget-parent change-divider ;

: divider-actions ( divider -- )
    dup [ gadget-parent save-sizes ] T{ button-down } set-action
    dup [ drop ] T{ button-up } set-action
    [ divider-motion ] T{ drag } set-action ;

C: divider ( -- divider )
    dup delegate>gadget
    dup divider-actions
    dup reverse-video-theme ;

: normalize-sizes ( sizes -- sizes )
    dup sum swap [ swap / ] map-with ;

: track-add-size ( sizes -- sizes )
    dup length 1 max recip add normalize-sizes ;

: add-divider ( track -- )
    dup track-sizes empty?
    [ drop ] [ <divider> swap add-gadget ] if ;

: track-add ( gadget track -- )
    dup add-divider [ add-gadget ] keep
    dup track-sizes track-add-size swap set-track-sizes ;

: nth-gadget gadget-children nth ;

: track-remove@ ( n track -- )
    #! Remove the divider if this is not the last child.
    2dup nth-gadget unparent
    dup gadget-children empty? [
        2dup gadget-children length = [ >r 1- r> ] when
        2dup nth-gadget unparent
    ] unless
    [ >r 2 /i r> track-sizes remove-index normalize-sizes ] keep
    [ set-track-sizes ] keep relayout-1 ;

: track-remove ( gadget track -- )
    [ gadget-children index ] keep track-remove@ ;