# Copyright (c) 1993 by Sanjay Ghemawat
###############################################################################
# Alarms
#
# Rep
#	alarms		list of alarm times in minutes
#	min		smallest element of alarms
#	max		largest element of alarms
#	pending		list of pending alarms; each element is list --
#				{<item> <fire time> <appt start time>}
#	active		active alarms
#
# An alarmer also has two daemons --
#
#	check_daemon	Recomputes the pending list every few hours
#	fire_daemon	Runs at minute boundaries and moves alarms from
#			the pending to the active list.

# Autload support
proc Alarmer {} {}

class Alarmer {} {
    set slot(alarms)	[list 0 5 10 15]
    set slot(min)	0
    set slot(max)	15
    set slot(pending)	""
    set slot(active)	""

    $self parse_options
    $self check_daemon
    $self fire_daemon

    trigger on add	[list $self add]
    trigger on delete	[list $self remove]
    trigger on change	[list $self change]
    trigger on exclude	[list $self exclude]
    trigger on include	[list $self recompute]
}

# effects - Parse alarm list
method Alarmer parse_options {} {
    # Check format
    set list [pref alarms]
    if ![regexp {^[ \t]*([0-9]+[ \t]+)+([0-9]+)[ \t]*$} $list] {
	return
    }

    foreach a $list {
	if {($a < 0) || ($a > 20*60)} {
	    return
	}
    }

    # Well-formatted
    set slot(alarms) $list

    set min_alarm 100000
    set max_alarm -1
    foreach a $list {
	if {$a < $min_alarm} {
	    set min_alarm $a
	}
	if {$a > $max_alarm} {
	    set max_alarm $a
	}
    }
    set slot(min) $min_alarm
    set slot(max) $max_alarm
}

# effects - Periodically recompute pending list
method Alarmer check_daemon {} {
    # Recompute the pending list
    $self recompute

    # Wait before next recompute (six hours?)
    after [expr 6*60*60*1000] $self check_daemon
}

# effects - Recompute alarm list
#	    args are ignored - they are here to keep trigger happy.
method Alarmer recompute {args} {
    set slot(pending) ""

    set now [time now]
    set today [date today]
    set midnight [$self midnight]

    cal query $today $today i d {
	if [$i is appt] {
	    $self appt $i [expr $midnight+[$i starttime]*60] $now
	}
    }

    cal query [expr $today+1] [expr $today+1] i d {
	if [$i is appt] {
	    $self appt $i [expr $midnight+(24*60*60)+[$i starttime]*60] $now
	}
    }
}

# effects - Merge newly added item into pending list
method Alarmer add {item} {
    if ![$item is appt] return

    set now [time now]
    set midnight [$self midnight]

    set added 0
    set today [date today]
    if [$item contains $today] {
	$self appt $item [expr $midnight+[$item starttime]*60] $now
	set added 1
    }

    if [$item contains [expr $today+1]] {
	$self appt $item [expr $midnight+(24*60*60)+[$item starttime]*60] $now
	set added 1
    }
}

# effects - Modify pending list to reflect change in specified item.
method Alarmer change {item} {
    $self remove $item
    $self add $item
}

# effects - Remove entries in pending and active list for specified calendar.
method Alarmer exclude {calendar} {
    # Remove pending items for specified calendar
    set pending ""
    foreach x $slot(pending) {
	if {[[lindex $x 0] calendar] != $calendar} {
	    lappend pending $x
	}
    }
    set slot(pending) $pending

    # Remove active notices for specified calendar
    set active ""
    foreach n $slot(active) {
	if {[[$n item] calendar] == $calendar} {
	    class_kill $n
	} else {
	    lappend active $n
	}
    }
    set slot(active) $active
}

# effects - Get time today started
method Alarmer midnight {} {
    set now [time now]
    set split [time split $now]
    set offset [expr "([lindex $split 0]*60*60 +\
		       [lindex $split 1]*60 +\
		       [lindex $split 2])"]

    return [expr $now-$offset]
}

# effects - Add appt to pending list
#	appt		appointment handle
#	time		time of occurrence
#	now		current time
method Alarmer appt {appt time now} {
    foreach a $slot(alarms) {
	set t [expr $time-($a*60)]
	if {$t < $now} {
	    continue
	}

	lappend slot(pending) [list $appt $t $time]
    }
}

# effects - Remove pending and active entries for specified item
method Alarmer remove {item} {
    $self remove_pending $item
    $self remove_active $item
}

method Alarmer remove_pending {item} {
    set pending ""
    foreach x $slot(pending) {
	if {[lindex $x 0] != $item} {
	    lappend pending $x
	}
    }
    set slot(pending) $pending
}

method Alarmer remove_active {item} {
    # Close active notices
    set active ""
    foreach n $slot(active) {
	if {[$n item] == $item} {
	    class_kill $n
	} else {
	    lappend active $n
	}
    }
    set slot(active) $active
}


# effects - Periodically fire (at every minute boundary)
method Alarmer fire_daemon {} {
    # Save pending changes
    trigger fire save

    # Fire
    $self fire

    # Schedule next firing (at minute boundary)
    set msec [expr "(60-[time second [time now]])*1000"]
    if {$msec <= 0} {set msec 1}
    after $msec $self fire_daemon
}

# effects - Fire pending alarms
method Alarmer fire {} {
    set pending ""

    # Fire alarms a little early (helps bypass round-off errors)
    set now [expr [time now]+5]

    foreach x $slot(pending) {
	if {[lindex $x 1] > $now} {
	    # Not time to fire yet
	    lappend pending $x
	    continue
	}

	# Close active notices
	$self remove_active [lindex $x 0]

	# Add new active
	lappend slot(active) [AlarmNotice [lindex $x 0] [lindex $x 2] $self]
    }

    set slot(pending) $pending

    # Update clocks in notices
    foreach n $slot(active) {
	$n countdown
    }
}

###############################################################################
# Alarm notices

class AlarmNotice {item starttime alarmer} {
    set slot(item) $item
    set slot(starttime) $starttime
    set slot(alarmer) $alarmer

    toplevel .$self -class Reminder -bd 0 -geometry ""

    focus_interest .$self
    bind .$self <Any-Enter> [list focus_restrict .$self]

    wm title .$self Reminder
    wm iconname .$self Reminder
    wm protocol .$self WM_DELETE_WINDOW [list AN_snooze $self]

    set g [option get .$self geometry Geometry]
    if {$g != ""} {
	wm geometry .$self $g
    }

    # Buttons
    frame .$self.bot -relief raised -bd 1
    frame .$self.bot.default -relief sunken -bd 1
    button .$self.bot.default.b -text Snooze -command [list AN_snooze $self]
    button .$self.bot.shutup -text "Shut Up" -command [list AN_shutup $self]
    pack append .$self.bot.default .$self.bot.default.b {left padx 3m pady 3m}
    pack append .$self.bot .$self.bot.default {left padx 3m pady 3m}
    pack append .$self.bot .$self.bot.shutup {right padx 3m pady 3m}

    # Display
    set str [$item text]
    regsub -all "\n\$" $str "" str
    set lines [llength [split $str "\n"]]

    set st [time2text [$item starttime]]
    set fi [time2text [expr [$item starttime]+[$item length]]]


    frame .$self.top -relief raised -bd 1
    label .$self.head -relief flat -bd 1 -text "Appointment from $st to $fi"
    label .$self.foot -relief flat -bd 1 -text ""

    text .$self.text -relief flat -bd 1 -width 50 -height $lines -wrap none
    .$self.text insert insert $str
    .$self.text configure -state disabled

    # Pack everything
    pack append .$self.top .$self.head {top fillx}
    pack append .$self.top .$self.text {top padx 10m pady 10m}
    pack append .$self.top .$self.foot {bottom fillx}

    pack append .$self .$self.top {top expand fillx}
    pack append .$self .$self.bot {bottom fillx}

    # Key bindings
    bind .$self <Control-c> [list AN_snooze $self]
    bind .$self <Return> [list AN_snooze $self]

    wbeep 0
}

# These are not methods because they need to delete the notice
proc AN_shutup {object} {
    [$object alarmer] remove_pending [$object item]
    [$object alarmer] remove_active  [$object item]
}

proc AN_snooze {object} {
    [$object alarmer] remove_active [$object item]
}

method AlarmNotice item {} {
    return $slot(item)
}

method AlarmNotice alarmer {} {
    return $slot(alarmer)
}

method AlarmNotice cleanup {} {
    focus_disinterest .$self
    focus_unrestrict .$self
    destroy .$self
}

method AlarmNotice countdown {} {
    set now [time now]
    if {$now > $slot(starttime)} {
	.$self.foot configure -text "Late for Appointment"
    } else {
	set min [format "%.f" [expr ($slot(starttime)-$now)/60]]
	.$self.foot configure -text "in $min minutes"
    }
}
