REBOL [
   Title: "Timeline"
   Date:  1999-10-5
   Author: ["Ingo Hohmann" "iho"]
   email: ingo@2b1.de
   site: http://www.2b1.de/Rebol/
   Purpose: "Prints a timetable"
   File: %Timeline.r
   Rights: {(c) 1999 Ingo Hohmann - free for any use, except that
       modifications to this script will have to stay free.
       If you improve this script, please tell me about it.}
   category: 'script
   version: 0.9.4
   status: 'beta
   usage: {
When started the program asks for a 
- name for an individual appentmoint,
- weekday ( mo, tu, ... )
- and the time, from, to 
  in the format "hhmm-hhmm", 
  possibly adding ":hhmm" to show that an appointment may
      be relocated in the specified timegap.
examples:
name: Meet boss
weekday: mo
time: 1000-1200
=> Meet the boss at monday, from 10:00 to 12:00
name: go shopping
weekday: sa
time: 900-1600/230
=> Go shopping at saturday, in the time range from 9:00 to 16:00,
   but only for 2 1/2 hours
}
   history: [
         [0.9.4 17-11-1999 {iho} {Deletion of entries now possible} ]
         [0.9.3 10-10-1999 {iho} {same entry for the same time on
             different days: input e.g  "xmofr" as day, will show on 
	     monday and friday, input "mofr" will be shortened 
	     to "mo" and only shown mondays} ]
         [0.9.2 5-10-1999 {iho} {- asks to save before exit, 
             - display char can be changed
             - weekday "nn" for unknown days
             - times like 10:30 are automatically converted to 1030}]
         [0.9.1 4-10-1999 {iho} {errors in Latex output corrected} ]
         [0.9.0 15-9-1999 {iho} {first public release} ]
   ]

   KnownBugs: [
      {lines longer than your screenwidth mess up the display on
      terminals (e.g. under Linux)}
   ]

   ToDo: [
      {I need more error testing}
      {a better way to show different days ...}
      {a way to show, that the same entry takes place on different
      days/times (ANDed / ORed)}
      {add a custom header}
   ]
]

;
; try loading my modules, if not use ...
;

if error? try [
   module 'Timeline.r
   import %iho-tools.r 
] [

   ;
   ; Functions, etc. copied over for distribution ...
   ;

   ; author: Bohdan Lechnowsky <bo@rebol.com>
   align: function [
      "Forms data into columns with optional alignment"
      data length /left /right /center] [len] [
      if right [
         return head copy/part 
         tail insert/dup head form data " " length 
            (length * -1)
      ]
      if center [
         data: head insert/dup head form data " " len: (length / 2)
         data: head insert/dup tail data " " len
         return copy/part at data ((length? data) / 2 - len + 1) length
      ]
      return copy/part head insert/dup tail form data " " length length
   ]

   ;
   ; User Interface
   ;

   menu-object: make object! [

      header: copy "^LHelp" 
      menus: copy []

      init: func [ "Initialize menu" /data men [block!]] [
         either data [menus: copy men]
            [menus: copy []]
      ] ; init

      FIXME: "add /at position  refinement"
      add: func [ "Adds a new menuline"
         key [char! none!] help [string! none!] action
            [block! none!]] [
         append menus key
         append menus help
         insert/only tail menus action
      ] ; add

      show: func [ "Shows the menu" ] [
         print rejoin [ header ]
         foreach [key help action] menus [
            prin either char? key
               [rejoin ["("key") "]]
               ["    "]
            print either string? help
               [help]
               [""]
         ]
         print " "
      ] ; show

      ask: func [ "Waits for a keypress, and DOes menu action" 
         /local con c key help action ] [
         con: open/binary [scheme: 'console]
         wait con
         c: to-char to-integer copy con
         foreach [key help action] menus [
            if key == c [
               if error? try [
                  if error? err: try action [
                     print rejoin ["Error in menu function: " action]
                     if confirm "... would you like to see it (y/N)? " [
                        print mold disarm err
                        self/ask
                     ]
                     return 'error
                  ] [ 
                     'none
                  ] 
               ] [
                  return 'ok
               ]
            ] 
         ]
         return 'not_found
      ] ; ask

      loop: func [ {After keypress, starts waiting for the next key,
           you'd better have a halt in one of your menu actions}
         /show "always show the menu, before waiting for keypress" 
         /do "always do action before waiting" 
         todo [block!] "action to do"] [
         while [ true ] [
            if show [ self/show ]
            if do   [ if error? try todo [
                  print "Error while doing menu action!" 
               ] ]
            ask
         ]
      ] ; loop    
   ] ; make menu

   ;
   ; helpers
   ;

   div: func ["integer division" dividend divisor ] [
      to-integer (to-integer dividend) / to-integer divisor
   ]     

   mod: func ["remainder" dividend divisor ] [
         (to-integer dividend) // to-integer divisor
   ]     

   prompt: func [prompts defaults /local prom] [
      prom: copy prompts
      append prom defaults
      ask head insert/dup tail prom "^H" length? defaults
   ]

] ; if error?


;
; END of Functions, etc. copied over for distribution ...
;

menu: make menu-object []
menu/init/data [
   #"l" "load data" [load-data]
   #"s" "Save data" [save-data]
   #"i" "Input data"[input-data]
   #"e" "Edit data" [edit-data]
   #"r" "remove data" [remove-data]
   #"d" "Display"   [show-data]
   #"c" "Change header" [change-header]
   #"o" "Output data ..."    [output-menu/show output-menu/ask]
   none none none
   #"h" "help"      [menu/show menu/ask]
   #"q" "quit Timeline" [quit-timeline]
]

output-menu: make menu-object []
output-menu/init/data [
   #"t" "output as Txt"   [output-data/txt]
   #"l" "output as Latex" [output-data/latex]
   #"h" "output as Html"  [output-data/html]
]

quit-timeline: func[ "Quits timeline, asks if you want to save"] [
   if all [dirty confirm "Data has been changed, save first? (y/N) "] [
      save-data
   ]
   halt
]

change-header: func[ "Changes the header-line"] [
   print "Please change the Header-line to your wishes: "
   change at header length? header #""
   header: append prompt "" header  #"^/" 
   FIXME: {ask/prompt kill leading spaces, use input instead}
]

load-data: func [] [
   data_file: to-file prompt "LOAD File: " reform [ 
      any [data_file %TimelineData.r]
   ]

   data_list: copy either exists? data_file [ load data_file ] [ [] ]
]

save-data: func [] [
   data_file: to-file prompt "SAVE to File: " form data_file

   save data_file data_list 
   dirty: false
]

input-data: func [/local name date time char dday] [
   while [1][
      print "Please input your data:"
      name: ask "Name: "
      if name == "" [break]
      day:  prompt "Day:  " day
      if all [2 < length? day not #"x" = day/1 ][ dday: at day 3 clear dday ] 
      time: rejoin parse ask "Time: " ":" 
      char: prompt "Show: " def-char
      if not 1 = length? char [char: to-string char/1]

      entry: compose [ (day) (time) (name) (char) ]
      dirty: true
      insert/only tail data_list entry
   ]
   sort-data
]

edit-data: func [/local num name date time entry char dday] [
   num: to-integer ask "Number of entry to edit: "

   if num > (length? data_list) [ exit ] ; ==========>

   print "Please update your data:"
   name: prompt "Name: " third pick data_list num
   day:  prompt "Day:  " first pick data_list num
   if all [2 < length? day not #"x" = day/1 ][ dday: at day 3 clear dday ] 
   time: rejoin parse (prompt "Time: " (second pick data_list num)) ":"  
   char: prompt "Show: " either char: pick pick data_list num 4 
      [char]
      [def-char]
   if not 1 = length? char [char: to-string char/1]

   entry: compose [ (day) (time) (name) (char) ]
   dirty: true
   change/only at data_list num entry
   sort-data
]

remove-data: func [/local num name date time entry char dday] [
   num: to-integer ask "Number of entry to REMOVE: "

   if num > (length? data_list) [ exit ] ; ==========>

   print [ 
    "^/Name: " third pick data_list num
    "^/Day:  " first pick data_list num
    "^/Time: " (second pick data_list num)  
    "^/Show: " either char: pick pick data_list num 4 [char]["x"] 
   ]
   if confirm "^/Really remove? (y/N)" [
     dirty: true
     remove at data_list num 
   ]
]

show-data: func [] [
   print append copy "^L" create-txt-output/edit
]

output-data: func [
   /txt "output as txt"
   /latex "output as latex" 
   /html "output as html"
   /local file out] [

   if txt   [ file: "TimelineOUT.txt" ]
   if latex [ file: "TimelineOUT.tex" ]
   if html  [ file: "TimelineOUT.html" ]

   file: to-file prompt "Filename to save to: " file   

   if txt   [out: create-txt-output]
   if latex [out: create-latex-verbatim-output]
   if html  [out: create-html-pre-output]

   write file out 
]

;
; Program help 
;


FIXME: {use words and aliases for weekdays? 
       Maybe better for different languages?}
weekdays: [ "mo" "di" "mi" "do" "fr" "sa" "so" "nn"]
;weekdays: [ "mo" "tu" "we" "th" "fr" "sa" "su" "nn"] ;this ok for english?

start:  8 ; start time of timeline
end:   22 ; end time of timeline, not used till now
day:  "mo"        ; "default" day
dirty: false      ; has data been changed?
def-char: "x" ; default display character
range-char: "-"   ; character show timerange to relocate
collision-char: "~" ; display colliding 
Header: "                           Timeline^/" ; header to display

;
; Program logic
;

sort-data: func [] [
   sort/compare data_list func [a b] [ 
         (to-integer (pick (parse (pick a 2) " -") 1)) 
      < (to-integer (pick (parse (pick b 2) " -") 1))
   ]
]

FIXME: {still to be done, priorites would be nice}
detect-collision: func[ "Detects collisions in the Timeline"
   /local last
] [
   last: false
   ; works on sorted list
   foreach day weekdays [
      foreach data data_list [
         if find (first data) day [
            if last [
            ]   
         ]
      ]
   ]
]   

characters: func [times char][
   ret: copy ""
   insert/dup ret char times
   ret
]


create-txt-output: func [/edit /local txt idx times offset data char] [
   txt: append copy header
   "   8   9   10  11  12  13  14  15  16  17  18  19  20  21  22^/" 
   foreach day weekdays [
      append txt rejoin [ 
         day 
         " |   |   |   |   |   |   |   |   |   |   |   |   |   |   |^/" 
      ]
      idx: 0
      foreach data data_list [
         idx: idx + 1
         if find (first data) day [
            times: parse data/2 "- ;/"
            offset: (((div times/1 100) - start) * 4) 
               + ((mod times/1 100) / 15)
            either (length? times) = 2 [ 
               length: (((div times/2 100) - start) * 4) 
               + ((mod times/2 100) / 15) - offset
               range: 0
            ] [
               length: ((div times/3 100) * 4) 
               + ((mod times/3 100) / 15); - offset
               range: (((div times/2 100) - start) * 4) 
               + ((mod times/2 100) / 15) - offset - length
            ]
            append txt rejoin [""
               characters offset + 3 " "
               characters length either char: pick data 4 [char] [def-char]
               characters range range-char
               characters 60 - offset - length - range " "
               either edit 
                  [ rejoin ["(" align/right idx 3 ") "] ]
                  [ "" ]
               data/3 "^/"
            ] 
         ]
      ]
   ]
   txt
]

create-latex-verbatim-output: func [] [
   ; landscape seems not to work ...
   rejoin [
      "\documentclass[ 10pt, a4paper, german, landscape]{article}^/"
      "\begin{document}^/"
      "\begin{verbatim}^/"

      create-txt-output

      "\end{verbatim}^/"
      "\end{document}^/"
   ]
]

create-html-pre-output: func [] [
   rejoin [
      {<!doctype html public "-//w3c//dtd html 3.2 final//en">^/}
      "<html>^/"
      "<head>^/"
      "<title>Timeline (c) Ingo Hohmann</title>^/"
      "</head>^/"
      "<body>^/"
      "<pre>^/"

      create-txt-output

      "</pre>^/"
      "</body>^/"
      "</html>^/"
   ]
]

print "^L      Timeline.r (c) Ingo Hohmann^/"
data_file: none
load-data

menu/loop/do [show-data]

halt