Rebol [
    title: "Desk Project"
    file: %deskproject.r
    date: 2006-07-06
    Purpose: {
        I am working in multiple porjects at the same time, so i wanted to have a tool, to track my time spent for each project.
        This simple tool makes this available.
    }
    author: "Varga Arpád"
    version: 1.0.0
    email: %varga--cason--hu
    Library: [
        level: 'beginner
        platform: 'all
        type: 'tool
        domain: 'database
        tested-under: [view 1.3.2.3.1 on "Windows XP"]
        support: [author: "Arpad Varga" email: %arpicheck--yahoo--com]
        license: 'gpl
    ]
]

nulls: func [num][either num < 10 [join "0" num][num]]

cancel: false
today: copy []
projects: none
main-projects: none
times: none

load-data: does [
    if not exists? %deskprogdat1.r [write %deskprogdat1.r decompress #{789C530A28CACF4A4D2E5170545288560A2E4D02730C9514E06C23A5582E25982A272504DB194987522C003362163B49000000}]
    if not exists? %deskprogdat2.r [write %deskprogdat2.r ""]
    projects: load %deskprogdat1.r
    main-projects: copy []
    foreach proj projects [if string? proj [append main-projects proj]]
    times: load %deskprogdat2.r
]
load-data

preformat: has [
    date block
    formatted
][
    load-data
    times: sort/skip/reverse times 2
    formatted: copy ""
    foreach [date block] times [
        append formatted join mold date newline
        append formatted rejoin ["^-" replace/all mold copy block newline "" newline]
    ]
    write %deskprogdat2.r formatted
]

doCalc: has [
    load-data
    today today-projects
    last-time last-project
    started project theme
    sum-time
    fullist
][
    if error? try [to-date calc-date/text] [
        alert {Field "Day" must contaion a valid date.}
        exit
    ]
    today: any [select times to-date calc-date/text copy []]
    today-projects: unique extract/index today 3 2
    today-projects: tail today-projects
    while [not head? today-projects][
        today-projects: back today-projects
        insert next today-projects [0:0:0]
    ]
    last-time: none
    last-project: none
    foreach [started project theme] today [
        if not none? do last-time [
            sum-time: find/tail today-projects last-project
            change find/tail today-projects last-project ((first sum-time) + (started - last-time))
        ]
        last-time: started
        last-project: project
    ]
    attempt [
        fullist: join [] rejoin [calc-date/text ", " to-string first today " - " last-time ]
        foreach [project sum-time] today-projects [if (greater? sum-time 0:0) [append fullist rejoin [project " ^-" sum-time]]]
        append/only fullist copy []
        append all-projects/data fullist
        show all-projects
    ]
]

doCalcWeek: has [
    start old-string 
    thisday
][
    if error? try [to-date calc-date/text] [
        alert {Field "Day" must contaion a valid date.}
        exit
    ]
    old-string: copy calc-date/text
    start: to-date calc-date/text
    start: start - start/weekday + 1
    for thisday start start + 6 1 [
        calc-date/text: rejoin [thisday/year "-" nulls thisday/month "-" nulls thisday/day]
        doCalc
    ]
    calc-date/text: copy old-string
]

copy-all: has [ text row ][
    text: copy ""
    foreach row all-projects/data [append text join row newline]
    write clipboard:// text
]

subsel: has [ subs ][
    if not-equal? main-projects proj/list-data [
        proj/list-data: main-projects
        proj/reset
        show proj
    ]
    subs: attempt [copy select projects proj/text]
    either all [not none? subs block? subs] [
        insert head subs copy "-"
        sub/text: first sub/list-data: copy subs
        sub/reset
        show sub
    ][
        sub/text: first sub/list-data: copy ["-"]
        sub/reset
        show sub
    ]
]

save-task: has [ today ][
    load-data
    today: select times to-date date/text
    if none? do today [
        append times reduce [to-date date/text copy []]
        today: select times to-date date/text
    ]
    append today reduce [to-time time/text copy proj/text copy sub/text]
    save %deskprogdat2.r times
]

ok-date-time?: does [
    if error? try [to-date date/text] [
        alert {Field "Day" must contaion a valid date.}
        return false
    ]
    if error? try [1 + to-time time/text] [
        alert {Field "Time" must contaion a valid time.}
        return false
    ]
    true
]

layCalc: layout [
    backdrop effect [gradient 1x1 180.190.224 210.210.210]
    across
    text "Day:" bold
    calc-date: field 80 rejoin [now/year "-" nulls now/month "-" nulls now/day]
    pad 5x0
    btn "Day" 220.248.220 [ clear all-projects/data doCalc ]
    btn "Week" 220.220.248 [ clear all-projects/data doCalcWeek ]
    btn "Copy" 248.248.220 [ copy-all ]
    btn "Close" 248.220.220 [ unview ]
    return
    box 316x2 black return
    return
    all-projects: text-list 316x200 today
]

layNewtask: layout [
    backdrop effect [gradient 1x1 180.190.224 210.210.210]
    do [cancel: true]
    proj: drop-down 300 with [show-arrow? false rows: 6] data main-projects [subsel]
    sub: drop-down 300 with [show-arrow? false rows: 4] "-"
    do [proj/text: proj/list-data/1]
    do [subsel]
    pad 220x30 
    btn "Start task" 80 220.248.220 [save-task unview]
    btn "Cancel" 80 248.220.220 font [space: 2x0] [unview]
]

view center-face layout [
    backdrop effect [gradient 1x1 200.220.244 220.220.220]
    across
    text "Day:" 53 bold
    date: field 100 rejoin [now/year "-" nulls now/month "-" nulls now/day]
    text "Time:" 53 bold
    time: field 100 to-string now/time
    return
    box 330x2 black return
    btn "New task now" 220.248.220 [ if ok-date-time? [load-data subsel view/new center-face layNewtask] ]
    btn "Calc day" 248.248.220 [ view/new center-face layCalc ]
    btn "Edit project list" 248.220.220 [editor %deskprogdat1.r]
    btn "Edit archives" 248.220.220 [preformat editor %deskprogdat2.r]
]