REBOL [
    Title:   "Time-Line"
    Name:    'time-line
    File:    %time-line.r
    
    Version: 0.3.1
    Date:    4-Mar-2006 
        
    Author:  "Christian Ensel"
    Email:   christian.ensel@gmx.de
    
    Owner:   "Christian Ensel"
    
    Purpose: {
        Time-line VID style for use in time-table editing using AGG.
    }
    
    History: [
        0.3.1 4-Mar-2006 {
            - With View 1.3.2 script wasn't working as expected (misplaced gradients), fixed.
            - Grabbing the two ends of a period changed from left/right third to quarter width.
        }
    ]
    
    Library: [
        level:    'intermediate
        platform: 'all
        type: [tool demo]
        code: 'module
        domain: [user-interface vid gui]
        tested-under: [
            view 1.3.1 on "WinXP" 
            view 1.3.2 on "WinXP"
        ]
        support: none
        license: none
        see-also: none
    ]
]

;===============================================================================
;REBOL [
;    title: "collect"
;    file: %collect.r
;    author: "Brett Handley"
;    email: brett@codeconscious.com
;    web: http://www.codeconscious.com
;    date: 24-Jul-2003
;    purpose: "Accumulate a repeated expression.."
;]
;-------------------------------------------------------------------------------
collect: func [
    {Collects block evaluations, use as body in For, Repeat, etc.}
    block [block!] "Block to evaluate."
    /initial result [series! datatype!] "Initialise the result."
    /only "Inserts into result using Only refinement."
] [
    if not initial [result: block!]
    result: any [all [datatype? result make result 1000] result]
    reduce ['head pick [insert insert/only] not only 'tail result to paren! block]
]
;===============================================================================


stylize/master [
    time-line: box with [
        style: 'time-line
        size: 100x100
        handle: 0x0
        color: none 
        colors: reduce [none yellow + 0.191.191]
        start:  6:00
        end:   21:00
        data:  none
        
        font: make font [name: "Tahoma" size: 8 style: shadow: none]
        
        para: make para [       ;-- Hinder View's caret to be visible if the 
            origin: -100x-100   ;   face gets the focus. 
        ]
        
        resolution:  0:30       ;-- Resolution sets the granularity of edits.
                                ;   All edits are stored on a per minute base but
                                ;   are rounded before displaying them
        
        pixel-of: func [
            "Converts a time value into it's corresponding horizontal pixel offset."
            time [time!]
        ][
            size/x - 1 * (time - start) / (end - start)       
        ]
        
        time-of: func [
            "Converts a horizontal pixel offset into it's corresponding time value."
            pixel [number!]
        ][
            pixel * (end - start) / (size/x - 1) + start
        ]
        
        edge:  none         ;-- NOT SUPPORTED!
        
        mouse: 'away            ;-- Maybe I could do without this
        
        others: 'may-hover      ;-- Two state flag telling other time-line
                                ;   faces whether the are allowed to show up
                                ;   in hovered state ('MAY-HOVER) or 
                                ;   not ('NEED-NOT-HOVER).
                                
        edit:  none             ;-- Holds flags 'START and 'END, telling
                                ;   whether to resize a period at either it's
                                ;   start or end or to move it
                                
        active-period:    none
        
        selected-periods: none  ;-- Block holding all selected period objects
                                ;   for multi-edits
        
        words: [
            periods [                   
                new/data: second args       ;-- Period descriptions will be dialected
                next args                   ;   and converted to objects internally.
            ]
            range [
                new/start: first second args
                new/end:   second second args
                next args
            ]
        ]
        
        drawings: none      ;-- The context where all the drawings for
                            ;   grid, periods, selected-periods and the cursor
                            ;   are kept (initialised in the INIT block).
            
        draw: context [
            
            grid: func ["Draws the hourly, half and quarterly grid." face [object!]] [
                face/drawings/grid: any [face/drawings/grid copy []]
                insert clear face/drawings/grid for time face/start face/end 1:00 collect [
                    compose [
                        pen (face/color / 8)
                        line-width 0.5
                        line (as-pair face/pixel-of time 0) 
                             (as-pair face/pixel-of time face/size/y)
                        pen (face/color / 4)
                        line-width 0.25 
                        line (as-pair face/pixel-of time + 0:30 0) 
                             (as-pair face/pixel-of time + 0:30 face/size/y)
                        pen (face/color / 2)
                        line-width 0.125
                        line (as-pair face/pixel-of time + 0:15 0) 
                             (as-pair face/pixel-of time + 0:15 face/size/y)
                        line (as-pair face/pixel-of time + 0:45 0) 
                             (as-pair face/pixel-of time + 0:45 face/size/y)
                    ]
                ]
            ]
            
            periods: func [face [object!] /local start end] [
                face/drawings/periods: any [face/drawings/periods copy []]
                if empty? face/data [clear face/drawings/periods return]
                
                insert clear face/drawings/periods foreach period face/data collect [
                    start: round/to period/start face/resolution 
                    end:   round/to period/end   face/resolution
                    compose [
                        line-width 0,66
                        pen (black)
                        fill-pen linear 0x0 0 (face/size/y - 2) 90 1 1 (period/color + 0.0.0.64) 
                                                                       (255.255.255.64)
                                                                       (period/color + 0.0.0.64) 
                                                                       (period/color + 0.0.0.32)
                                                                       (period/color / 2)
                                                                       (period/color / 4)
                        box (as-pair face/pixel-of start 3)
                            (as-pair face/pixel-of   end face/size/y - 4) (period/radius)
                        pen black fill-pen white 
                        font (font)
                        text (copy/part skip tail join "0" mold start -5 5)
                             (as-pair   3 + face/pixel-of start face/size/y / 2 - 5)
                        text (copy/part skip tail join "0" mold   end -5 5)
                             (as-pair -21 + face/pixel-of   end face/size/y / 2 - 5)
                        
                    ]
                ]
            ]
        
            grip: func [
                "Draws the grip." face /local period fill start start? end end? width color
            ][
                face/drawings/grip: any [face/drawings/grip copy []]
                
                if none? period: face/active-period [
                    clear face/drawings/grip
                    return
                ] 
                
                start: round/to period/start face/resolution 
                end:   round/to period/end   face/resolution                 
                width: (face/pixel-of end) - (face/pixel-of start)
                color: period/color / 4 - 0.0.0.255 + 0.0.0.127 ;period/color
                ;color: gold + 0.0.0.127
                
                start?: found? find period/edit 'start? 
                end?:   found? find period/edit 'end?   
                
                fill: compose any [
                    if all [start? end?] [
                        ;[fill-pen linear (as-pair face/pixel-of start 0) (face/pixel-of start) (width) 0 1 1 (color + 0.0.0.127) (color) (color + 0.0.0.127)] ; + 0.0.0.255) (color + 0.0.0.127) (color + 0.0.0.63) (color) (color + 0.0.0.63) (color + 0.0.0.127) (color + 0.0.0.255)]
                        [fill-pen linear (as-pair face/pixel-of start 0) 0 (width) 0 1 1 (color + 0.0.0.255) (color) (color) (color + 0.0.0.255)]
                    ]
                    if start? [
                        ;[fill-pen linear (as-pair face/pixel-of start 0) (face/pixel-of start) (width) 0 1 1 (color) (color + 0.0.0.63) (color + 0.0.0.127) (color + 0.0.0.255)]
                        [fill-pen linear (as-pair face/pixel-of start 0) 0 (width) 0 1 1 (color) (color + 0.0.0.127) (color + 0.0.0.255) (color + 0.0.0.255)]
                    ]
                    if end? [
                        ;[fill-pen linear (as-pair face/pixel-of start 0) (face/pixel-of start) (width) 0 1 1 (color + 0.0.0.255) (color + 0.0.0.127) (color + 0.0.0.63) (color)]
                        [fill-pen linear (as-pair face/pixel-of start 0) 0 (width) 0 1 1 (color + 0.0.0.255) (color + 0.0.0.255) (color + 0.0.0.127) (color)]
                    ]
                ]
                    
                insert clear face/drawings/grip compose [
                    line-width 1 
                    pen black fill-pen (fill)
                    box (as-pair face/pixel-of start 3)
                        (as-pair face/pixel-of end   face/size/y - 4) (period/radius)
                ]
            ]
            
            cursor: func [
                "Draws the cursor."
                face [object!] offset [integer! none!] /local period time color
            ][
                color: navy ; + 0.0.0.63
                
                face/drawings/cursor: any [face/drawings/cursor copy []]
                clear face/drawings/cursor
                
                if any [
                    none? offset
                    face/active-period: face/feel/period? face offset
                ][
                    return
                ]
                
                time: round/to face/time-of offset face/resolution 
                insert face/drawings/cursor compose [
                    pen (color) line-width 3
                    line (as-pair face/pixel-of time 0) (as-pair face/pixel-of time face/size/y)
                    pen black
                    font (face/font)
                    text (copy/part skip tail join "0" mold round/to time 0:01 -5 5) (as-pair  -9 + face/pixel-of time face/size/y / 2 - 5)
                ]

            ]
            
            selected-periods: func [face /local start end color] [
                face/drawings/selected-periods: any [face/drawings/selected-periods copy []]
                
                clear face/drawings/selected-periods
                
                if empty? face/selected-periods [return]
                
                
                
                color: navy ;+ 0.0.0.63
                
                insert clear face/drawings/selected-periods foreach period face/selected-periods collect [
                    start: round/to period/start face/resolution 
                    end:   round/to period/end   face/resolution
                    compose [
                        line-width 3
                        pen (color) fill-pen none 
                        box (as-pair -2 + face/pixel-of start 1)
                            (as-pair +2 + face/pixel-of end   face/size/y - 2) (period/radius + 3)
                    
                        (
                            compose either find period/edit 'start [
                                [
                                    pen none fill-pen (color)
                                    triangle (as-pair -3 + face/pixel-of start 0)
                                             (as-pair -3 + face/pixel-of start face/size/y)
                                             (as-pair - face/size/y / 2 - 3 + face/pixel-of start face/size/y / 2)
                                ]
                            ][[]]
                        )
                        (
                            compose either find period/edit 'end [
                                [
                                    pen none fill-pen (color)
                                    triangle (as-pair 4 + face/pixel-of end 0) ;face/size/y - 1 / 3)
                                             (as-pair 4 + face/pixel-of end face/size/y)
                                             (as-pair face/size/y / 2 + 4 + face/pixel-of end face/size/y / 2)
                                ]
                            ][[]]
                        )
                    ]
                ]
            ]
        ]
        
        feel: make feel [
            
            redraw: func [face action offset] [
                either face <> system/view/focal-face [
                    face/color: face/colors/1
                    clear face/drawings/selected-periods
                ][
                    face/color: face/colors/2
                ]
                face/drawings/grid
            ]
            
            edit: func [
                "Determines the edit mode for the active period." face offset 
            /local
                period start end quarter
            ][
                if none? period: face/active-period [return]
                start: face/pixel-of round/to period/start face/resolution 
                end:   face/pixel-of round/to period/end   face/resolution                 
                quarter: end - start / 4
                any [
                    if all [start <= offset offset <= (start + quarter)] [
                        edit-end/data: off edit-start/data: on ;#####
                        remove find period/edit 'start?
                        remove find period/edit 'end?
                        insert period/edit 'start?
                    ]
                    if all [end - quarter <= offset offset <= end] [
                        edit-start/data: off edit-end/data: on ;#####
                        remove find period/edit 'start?
                        remove find period/edit 'end?
                        insert period/edit 'end?
                    ]
                    do [   
                        edit-start/data: edit-end/data: on ;#####
                        remove find period/edit 'start?
                        remove find period/edit 'end?
                        insert period/edit [start? end?]
                    ]
                ]
                show [edit-start edit-end] ;#####
            ]
            
            period?: func [face offset [pair! time! number! none!] /all] [
                if none? offset [return none]
                offset: switch type?/word offset [
                    integer! [face/time-of offset]
                    decimal! [face/time-of offset]
                    pair!    [face/time-of offset/x]
                    time!    [offset]
                ]
                foreach period face/data [
                    if (period/start < offset) and (offset < period/end) [break/return period]  
                ] 
            ]
            
            over: func [face over? offset] [
                face/selected-periods: any [face/selected-periods copy []]
                
                ;-- Don't hover time-line if we're editing another
                ;
                if all [
                    system/view/focal-face
                    get in system/view/focal-face 'style 
                    system/view/focal-face/style = 'time-line
                    system/view/focal-face <> face
                    system/view/focal-face/others = 'need-not-hover
                ][
                    return
                ] 
                
                offset: offset - win-offset? face   ;-- Remember, offset argument is relative to window here!
                face/feel/edit face offset/x
                
                face/mouse: pick [over away] over?
                
                face/draw/selected-periods face
                face/draw/grip face
                face/draw/cursor face offset/x
                if not over? [
                    clear face/drawings/cursor
                    clear face/drawings/grip
                ]
                
                show face
            ]
            
            engage: func [face action event /local delta swap edit offset] [
                shift-key/data: event/shift show shift-key
                control-key/data: event/control show control-key
                
                offset: event/offset - win-offset? face   ;-- Remember, offset argument is relative to window here!
                
                face/selected-periods: any [face/selected-periods copy []]
                if action = 'key [
                    if event/key = #"^[" [
                        foreach period face/selected-periods [
                            clear period/edit
                        ]
                        clear face/selected-periods
                    ]
                    if event/key = #"^A" [
                        insert clear face/selected-periods face/data
                        foreach period face/selected-periods [
                            insert clear period/edit [start end]
                        ]
                    ]
                    if event/key = 'up [
                        foreach period face/selected-periods [
                            insert clear period/edit 'start
                            if any [event/shift event/control] [
                                insert period/edit 'end
                            ]
                        ]
                    ]
                    if event/key = 'down  [
                        foreach period face/selected-periods [
                            insert clear period/edit 'end
                            if any [event/shift event/control] [
                                insert period/edit 'start
                            ]
                        ]
                    ]
                    if event/key = #"^M" [
                        clear face/selected-periods 
                        face/active-period: none
                    ]
                    if find [left right] event/key [
                        delta: face/resolution * select [left -1 right +1] event/key
                        foreach period face/selected-periods [
                            if find period/edit 'start [period/started: period/start: period/start + delta]
                            if find period/edit 'end   [period/ended:   period/end:   period/end + delta]
                            if period/start > period/end [
                                ;set bind [start end] in period 'self reduce bind [end start] in period 'self
                                swap: period/start period/start: period/end period/end: swap 
                                alter period/edit 'start
                                alter period/edit 'end
                                edit-start/data: not edit-start/data ;#####
                                edit-end/data: not edit-end/data ;#####
                                show [edit-start edit-end]
                            ]
                        ]
                    ]
                ]
                
                if find [over away] action [
                    foreach period face/selected-periods [
                        delta: (face/time-of event/offset/x - face/handle/x) - face/start
                        if find period/edit 'start [
                            period/start: round/to period/started + delta face/resolution
                        ]
                        if find period/edit 'end [
                            period/end: round/to period/ended + delta face/resolution
                        ]
                        if period/end < period/start [
                            swap: period/start period/start: period/end period/end: swap 
                            alter period/edit 'start
                            alter period/edit 'end
                            edit-start/data: not edit-start/data ;#####
                            edit-end/data: not edit-end/data ;#####
                            show [edit-start edit-end]
                        ]
                    ]
                    ;face/handle: event/offset
                    face/mouse: action
                ]
                
                if find [down alt-down] action [
                    if face <> system/view/focal-face [focus/no-show face]
                    either face/active-period [
                        remove find face/active-period/edit 'start
                        remove find face/active-period/edit 'end
                    ][
                        either not event/double-click [
                            clear face/selected-periods
                        ][
                            insert tail face/data face/active-period: make object! compose [
                                type:   'unknown 
                                started: start:  round/to face/time-of event/offset/x face/resolution
                                ended:   end:    round/to face/resolution + face/time-of event/offset/x face/resolution
                                color:  0.0.0.31 + random white 
                                radius: -1 + random 16
                                edit:   copy [end?]
                            ]
                        ]
                    ]
                    if not any [event/shift event/control] [
                        clear face/selected-periods
                        clear face/drawings/grip
                    ]
                    if face/active-period [
                        face/others: 'need-not-hover
                        if not found? find face/selected-periods face/active-period [
                            insert face/selected-periods face/active-period
                        ]
                        if find face/active-period/edit 'start? [insert face/active-period/edit 'start]
                        if find face/active-period/edit 'end?   [insert face/active-period/edit 'end  ]
                    ]
                    face/handle: event/offset
                ]
                
                if find [up alt-up] action [
                    foreach period face/data [
                        period/started: period/start
                        period/ended: period/end
                    ]
                    if not any [event/shift event/control] [
                        clear face/selected-periods
                        clear face/drawings/grip
                    ]
                    if face/active-period [
                        if not found? find face/selected-periods face/active-period [
                            insert face/selected-periods face/active-period
                        ]
                    ]
                    ;if face/mouse = 'away [clear face/drawings/cursor]
                    face/others: 'may-hover
                ]
                
                face/draw/periods face
                face/draw/selected-periods face
                face/draw/grip face
                
                clear face/drawings/cursor
                ;if not find [over away] action [ 
                ;    face/draw/cursor face event/offset/x
                ;]
                
                show face
            ]
        ]
        
        resize: func [new [pair!]] [
            ;size: max 90x12 new
            size: new
            draw/grid self
            draw/periods self
            draw/selected-periods self
            draw/grip self
        ]
        
        init: copy [
            data: any [data copy []]
            color: any [color white]
            colors/1: color
            selected-periods: copy []
            edit:      copy []
        
            drawings: context [grid: periods: selected-periods: grip: cursor: none]
            draw/grid       self
            draw/periods    self
            draw/selected-periods self
            draw/grip       self
            draw/cursor     self none
            effect: compose/only [draw (drawings/grid) draw (drawings/selected-periods) draw (drawings/periods) draw (drawings/grip) draw (drawings/cursor)]
        ]
    ]
    
]


;################################ DEMO #########################################
;

change-grid: func [resolution [time!]] [
    foreach face time-lines/pane [
        face/resolution: resolution
        foreach period face/data [
            period/started: period/start: round/to period/start resolution
            period/ended:   period/end:   round/to period/end   resolution
        ]
        face/draw/periods face
        face/draw/selected-periods face
        show face
    ]
]

window: center-face layout compose/deep [
    across space 8x1
    text "Working:" bold return
    pad 24x0 text "- Double click to create new periods." return
    pad 24x0 text "- Use cursor keys, CTRL+A and ESC for keyboard editing (incomplete)." return
    pad 0x24 
    text "To do:" bold return
    pad 24x0 text "- Currently, you can't resize 0-width periods (events)" return
    pad 24x0 text "- Swapping start and end times produces unexpected results for now" return
    pad 24x0 text "- Think about collision detection!" return
    pad 24x0 text "- Think about period names!" return
    pad 24x0 text "- Period dialect" return
    pad 0x24 
    text "Resolution:" bold
    radio-line "0:01 h" of 'grid [change-grid 0:01]  
    radio-line "0:05 h" of 'grid [change-grid 0:05]  
    radio-line "0:15 h" of 'grid [change-grid 0:15] 
    radio-line "0:30 h" of 'grid [change-grid 0:30] on
    radio-line "1:00 h" of 'grid [change-grid 1:00] 
    pad 80
    text "Edit Mode:" bold
    edit-start: check-line "start" of 'mode
    edit-end:   check-line "end"   of 'mode 
    pad 80
    text "Modifiers:" bold
    shift-key:   check-line "Shift"   
    control-key: check-line "Control" 
    return
    panel [
        across
        panel [
            space 1x1 origin 1x1
            btn 48x24 "Mo."
            btn 48x24 "Di." 
            btn 48x24 "Mi."
            btn 48x24 "Do." 
            btn 48x24 "Fr." 
            btn 48x24 "Sa." 255.223.223
            btn 48x24 "So." 255.191.191
        ]
        time-lines: panel [
            space 1x1 origin 1x1
            time-line 960x24 periods [
                (context [type: 'work started: start: 07:00 ended: end: 10:00 color: 255.255.255.031 radius: 4 edit: []])
                (context [type: 'away started: start: 10:00 ended: end: 16:00 color: 063.127.255.031 radius: 8 edit: []])
            ]
            time-line 960x24 periods [
                (context [type: 'away started: start: 09:00 ended: end: 12:00 color: 063.127.255.031 radius: 8 edit: []])
                (context [type: 'work started: start: 12:00 ended: end: 14:00 color: 255.127.063.031 radius: 4 edit: []])
                (context [type: 'ill  started: start: 16:00 ended: end: 18:00 color: 063.255.127.031 radius: 4 edit: []])
            ]
            time-line 960x24 periods []
            time-line 960x24 periods []
            time-line 960x24 periods []
            time-line 960x24 periods [] 255.223.223 range [0:00 24:00]
            time-line 960x24 periods [] 255.191.191 range [0:00 24:00]
        ]
    ]
]

if request/confirm {
    You may try the time-line with or without Romano Paolo Tenca's RESIZE-VID script.
    Do you want to do-thru http://www.rebol.it/~romano/resize-vid.r now?
} [
    do-thru http://www.rebol.it/~romano/resize-vid.r
    window: auto-resize window
]

view/options window [resize all-over]