#!/mod/bin/jimsh

package require cgi
source /mod/webif/lib/setup
require rsv.class epg.class system.class classdump

set debug 0

noheader
set renderstart [clock milliseconds]

set events [rsv allevents [[settings] hidevisualota]]
set pending [rsv list pending]

# hSvc -> usSvcId map
lmap i \
    [$::channeldb query {select hSvc, usSvcid from TBL_SVC}] \
    {
	set hmap([lindex $i 1]) [lindex $i 3]
    }

# usSvcId -> hSvc map
#set svcmap [lreverse $hmap]

proc lsum {l} {
	expr [join [linsert $l 0 0] +]
}

proc pop_event {} {
	uplevel {
		lassign [lindex $events $eindex] \
		    start end hsvc eid slotid kind sclass
		incr eindex
		if {$debug > 2} {
			puts "
			--------------------------------------------------
			EVENT$eindex
			START:  $start [clock format $start]
			END:    $end [clock format $end]
			HSVC:   $hsvc
			EID:    $eid
			SID:    $slotid
			KIND:   $kind
			SCLASS: $sclass
			"
		}
	}
}

set pendingclasses {
	1    "pending-unschedule"
	2    "pending-ar"
	3    "pending-ar"
	4    "pending-folder"
	5    "pending-skip"
	6    "pending-refresh"
}

foreach p $pending {
	set action [$p get action]

	# Add - already handled.
	if {$action eq "0"} continue

	set s [rsv fetch "TBL_RESERVATION" \
	    [$p get ersvtype] [$p get hsvc] 0 [$p get usevtid]]

	if {$s eq "0"} continue

	set slot [$s get ulslot]

	set elen [llength $events]
	set eindex 0
	while {$eindex < $elen} {
		pop_event

		if {$slotid ne [$s get ulslot]} continue

		if {$action eq "5" && $start != [$p start]} continue
		lset events $($eindex - 1) 6 $pendingclasses($action)
	}
}

# Event array keys:
#      0:      start
#      1:      end
#      2:      hSvc
#      3:      event_id
#      4:      Schedule Slot ID
#      5:      ucRecKind
#      6:      class (live, pending)

# Filter events array
set skip [rsv _skiplist]
if {[llength $skip]} {
	set events [lmap i $events {
		lassign $i x x s e
		if {"$s:$e" in $::skip} continue
		function $i
	}]
}

# Sort final events array
set events [lsort -index 0 -integer [lsort -index 2 -integer $events]]

if {$debug} {
	puts "<pre>"
	foreach ev $events {
		puts -nonewline $ev
		lassign $ev start end hsvc eid slotid kind sclass
		catch {
			set s [rsv slot $sclass $slotid]
			set shour [clock format $start -format "%H"]
			set ehour [clock format $end -format "%H"]
			set elapsed $($end - $start)
			puts -nonewline "  = $shour,$ehour ($elapsed) - [$s name]"
		}
		puts ""
	}
	puts "</pre>"
}

######################################################################
# Visualisation functions

# Intend 40 pixels / hour for fully populated timeline.
set width $(40 * 24)
# This is the total padding/margin/border width.
set pad 4
set padadj 0

# Returns an absolute number of pixels from the left corresponding
# to a number of seconds into the day.
proc secstopx {daysecs hourpx usedhours} {
	set max [expr {int($daysecs / 3600)}]
	# Subtract any unused hours from $daysecs.
	for {set i 0} {$i < $max} {incr i} {
		if {$i >= 24} break
		if {![lindex $usedhours $i]} {
			incr daysecs -3600
		}
	}
	return [expr {int($daysecs * $hourpx / 3600)}]
}

# daysecs - absolute number of seconds into the day that needs to be reached.
# pxpos   - current pixel position.
proc showpad {daysecs hourpx &pxpos usedhours} {
	global debug pad padadj

	# Determine required pixel position.
	set newpos [set p [secstopx $daysecs $hourpx $usedhours]]

	# Calculate required width of spacer
	incr p -$pxpos

	# Account for padding and any pending adjustment
	incr p $(-($pad + $padadj))

	if {$p <= 0} {
		# If too narrow, show bare skip at full required width.
		incr p $($pad + $padadj)
		# Bare skip
		set class "ct_bskip"
	} else {
		set class "ct_skip"
		if {$debug} { append class " ct_debug" }
	}

	if {$p > 0} {
		puts -nonewline \
		    "<div class=\"$class\" style=\"width: ${p}px;\">"
		if {$debug} {
			puts [format "@%d-%d s=%d w=%dpx @%dpx" \
			    $pxpos $padadj $daysecs $p $newpos]
		}
		puts -nonewline "</div>"
		set pxpos $newpos
		set padadj 0
	}
}

proc showevent {s class &overflow &tomorrow &pxpos start end usedhours daystart dayend hourpx service event sclass} {

	global debug pad padadj dev

	# Required pixel position of event start.
	set p [secstopx $($start - $daystart) $hourpx $usedhours]

	if {$p < $pxpos} {
		# Backwards move => tuner conflict.
		lappend overflow [list $s $start $end $service $event $sclass]
		return
	}

	# Show padding up to event.
	showpad $($start - $daystart) $hourpx pxpos $usedhours

	# And now the event itself.

	set name [set channel "Unknown"]
	set slotid -1
	if {$s ne "0"} {
		set name [$s name]
		set channel [$s channel_name]
		set slotid [$s get ulslot]
	}
	if {$service > 0} {
		set epgs [epg dbfetch dump \
		    -service $service -event $event -sort ""]
		if {[llength $epgs] == 1} {
			lassign $epgs epg
			set name [$epg get name]
			$epg get_channel_info
			set channel [$epg get channel_name]
		}
	}

	if {[string match -nocase "New:*" $name]} {
		set name [string trim [string range $name 4 end]]
	}
	set name [cgi_quote_html $name]

	if {$sclass == "pending"} {
		append class " purpleshade"
	} elseif {$sclass == "pending-unschedule" ||
		  $sclass == "pending-skip"} {
		append class " strike purpleshade"
	} elseif {[string match "*pending*" $sclass]} {
		append class " orangeshade"
	}

	if {$end > $dayend + 1} {
		# Push event into tomorrow.
		if {$s ne "0"} { $s setorigstart $start }
		lappend tomorrow [list $s $($dayend + 1) $end \
		    $service $event $sclass]
		set newpos [set p [secstopx 86400 $hourpx $usedhours]]
		append name "..."
	} else {
		set newpos [set p [\
		    secstopx $($end - $daystart) $hourpx $usedhours]]
		if {$start == $daystart && $s ne "0" &&
		    [$s get _origstart] > 0} {
			set name "..$name"
			set start [$s get _origstart]
			$s setorigstart 0
		}
	}

	# Calculate width
	incr p -$pxpos

	# Account for padding
	incr p -$pad

	if {$p < 8} {
		# Event too narrow, force to 8 pixels.
		set padadj $(8 - $p)
		set p 8
	} else {
		set padadj 0
	}

	puts -nonewline "<div class=\"$class ct_event\" style=\"width: ${p}px;\" sid=\"${slotid}\" sclass=\"$sclass\" period=\"[clock format $start -format {%H:%M}] - [clock format $end -format {%H:%M}]\" xs=$service xe=$event"
	if {$s ne "0"} {
		puts -nonewline " rc=\"[$s get ucRecKind]\" et=\"[$s get ersvtype]\" rt=\"[$s get erepeat]\""
		if {[$s get szCRID] ne ""} {
			puts " crid=\"[$s get szCRID]\""
		}
	}
	puts -nonewline " sz=\"[cgi_quote_html $channel]\""
	puts -nonewline ">"

	if {$debug} {
		puts -nonewline [format "@%d s=%d w=%dpx @%dpx /=%d" \
		    $pxpos $($end - $start) $p $newpos $padadj]
	}

	puts -nonewline "$name</div>"

	set pxpos $newpos
}

proc render_timeline {usedhours} {
	global debug events width pad hmap padadj

	puts "<div class=ct_visual>\n"

	set tothours [lsum $usedhours]

	if {!$tothours} {
		puts "No schedule data found."
		return
	}

	# calculate pixels per hour
	set hourpx [expr {int($width / $tothours)}]

	if {$debug} {
		puts "USEDHOURS: $usedhours<br>\n"
		puts "HOURPX: $hourpx (tothours: $tothours)<br>\n"
	}

	# Show the hour bar.
	puts "<div class=ct_header><div class=ct_row>"
	puts "<div class=ct_dayname>&nbsp;</div>"
	# Account for element padding and margin
	set px $($hourpx - $pad)
	for {set i 0} {$i < 25} {incr i} {
		if {[lindex $usedhours $i] ne "1"} continue
		puts -nonewline \
		    "<div class=ct_hour style=\"width:${px}px\"><center>[\
		    format "%02dh" $i]</center></div>"
	}
	puts "</div></div>\n"

	# To store events which overflow into tomorrow.
	set tomorrow {}

	# Midnight today.
	set day [midnight]
	set gday [clock scan [clock format $day -format {%Y %m %d %T}] \
	    -format {%Y %m %d %T} -gmt 1]

	set elength [llength $events]
	set eindex 0
	set start 0
	while {$start < $day} { pop_event }
	
	for {set i 0} {$i < 8} {incr i} {
		# To store things that need to move to the next row.
		set rows {}

		if {$i % 2} {
			set class "odd"
		} else {
			set class "even"
		}
		set eclass "blueshade"

		set dayend [set daystart $day]
		incr dayend 86399

		# Row 1
		puts "<div class=\"ct_day $class\">"
		puts "<div class=\"ct_row\">"

		puts "<div class=ct_dayname>[clock format $gday \
		    -format {%a %d/%m/%Y} -gmt 1]</div>"

		set pxpos [set padadj 0]

		if {[llength $tomorrow]} {
			set dummy {}
			foreach row $tomorrow {
				lassign $row s xstart xend xs xe xsclass
				showevent $s $eclass rows dummy \
				    pxpos $xstart $xend $usedhours \
				    $daystart $dayend $hourpx \
				    $xs $xe $xsclass
			}

			set tomorrow {}
		}

		while {$start >= $daystart && $start <= $dayend} {
			if {$slotid ne "-1"} {
				set tab "TBL_RESERVATION"
				if {$sclass eq "pending"} {
					set tab "pending"
				}
				set s [rsv slot $tab $slotid]
			} else {
				set s "0"
			}

			if {[dict exists $hmap $hsvc]} {
				set service $hmap($hsvc)
			} else {
				set service 0
			}

			showevent $s $eclass rows tomorrow pxpos \
			    $start $end $usedhours \
			    $daystart $dayend $hourpx \
			    $service $eid $sclass

			pop_event
		}

		# Close row
		showpad 86400 $hourpx pxpos $usedhours
		puts "</div>"

		# Output other rows if necessary
		while {[llength $rows]} {
			set nrows {}
			puts "<div class=\"ct_row $class\"><div class=ct_dayname></div>"
			set pxpos [set padadj 0]
			foreach row $rows {
				lassign $row s xstart xend xs xe xsclass
				showevent $s $eclass nrows tomorrow \
				    pxpos $xstart $xend $usedhours \
				    $daystart $dayend $hourpx \
				    $xs $xe $xsclass
			}
			showpad 86400 $hourpx pxpos $usedhours
			puts "</div>"
			set rows $nrows
			set eclass "pinkshade"
		}

		incr day 86400
		incr gday 86400
		# Close ct_day
		puts "</div>"
	}

	puts "\n</div>\n"
}

######################################################################
# Compressed Day Schedule Visualisation

set usedhours [lrepeat 24 0]

# Determine which hours are used.
foreach e $events {
	lassign $e start end
	set shour [clock format $start -format "%H"]
	set ehour [clock format $end -format "%H"]
	if {$ehour < $shour} {
		incr ehour 24
	}
	for {set i $shour} {$i <= $ehour} {incr i} {
		set index $i
		if {$i > 23} { incr index -24 }
		lset usedhours $index 1
	}
}

# To show 24 hours
#set usedhours [lrepeat 24 1]

puts "
<fieldset id=sched_timeline class=visual>
<legend>
        <h3>Schedule</h3>
</legend>
"

render_timeline $usedhours

puts "</fieldset>"

puts {
<div id=legend>
<h3 style="display: inline-block">Key:</h3>
<div class="ct_key blueshade">
        Scheduled event
</div>
<div class="ct_key pinkshade">
        Conflict
</div>
<div class="ct_key orangeshade">
        Pending change
</div>
<div class="ct_key purpleshade">
        Pending <b>schedule</b>
</div>
<div class="ct_key purpleshade strike">
        Pending <b>unschedule</b>
</div>
</div>
}

source assets.jim

footer