// timecom.sr

//	Last modified May 2, 1979  2:24 PM by Taft


get "BRAVO1.DF"
get "ST.DF"
get "VM.DF"
get "SELECT.DF"
get "COM.DF"
get "MSG.DF"
get "NEWMSG.DF"


// Incoming Procedures

external [
	UNPACKDT
	ReadCalendar
	stappend; 
	stcopy
	stsize
	stnum
	stcompare
	insertd
	PutSbScr
	setsel
	ugt
	invalidatedisplay
	move
	processtsesc
	mapcp
	]


// Incoming Statics

external	[
	selmain
	selaux
	deltacp
	cpscrt
	rgmaccp
	vdlhint
	dcpendofdoc
	vmapstatus
	vlook1
	vlook2
	]


// Outgoing Procedures

external [
	createsbtime
	timecom
	]


// Local Structures

structure DYT:
	[ year	word
	month	word
	day	word
	hour	word
	minute	word
	second	word
	fdst	word
	]
manifest [
	lndyt = (size DYT)/16
	]


// Local Manifests

// manifest


// C R E A T E S B T I M E

let createsbtime(sbtime, tod) = valof
[
let dyt = vec lndyt
UNPACKDT(tod, dyt)
stcopy(sbtime, MONTHNAME(dyt>>DYT.month))
stappend(sbtime, " ")
let sbnum = vec 50
sbnum ! 0 = 0
stnum(sbnum, dyt>>DYT.day, 10, 0, false, false, false)
stappend(sbtime, sbnum)
stappend(sbtime, ", ")
stnum(sbnum, dyt>>DYT.year, 10, 0, false, false, false)
stappend(sbtime, sbnum)
stappend(sbtime, "  ")
let ich = stsize(sbtime)
let fam = true
if dyt>>DYT.hour ge 12 then
	[
	fam = false
	if dyt>>DYT.hour gr 12 then		
		dyt>>DYT.hour = dyt>>DYT.hour-12
	]
if dyt>>DYT.hour eq 0 then		
	dyt>>DYT.hour = 12
stnum(sbnum, dyt>>DYT.hour, 10, 0, false, false, false)
stappend(sbtime, sbnum)
stappend(sbtime, ":")
stnum(sbnum, dyt>>DYT.minute, 10, 2, true, false, false)
stappend(sbtime, sbnum)
stappend(sbtime, " ")
test fam eq true
	ifso stappend(sbtime, "AM")	
	ifnot stappend(sbtime, "PM")
resultis ich
]

// T I M E C O M

and timecom(cf) = valof
[
let sel = cf>>CF.sel
let doc = sel>>SEL.doc
if ugt(sel>>SEL.cpfirst, (rgmaccp ! doc)-dcpendofdoc) then
	sel>>SEL.cpfirst = (rgmaccp ! doc)-dcpendofdoc
let tod = vec lntod
ReadCalendar(tod)
let sbtime = vec 50
sbtime ! 0 = 0
let tich = createsbtime(sbtime, tod)
processtsesc($T, sbtime)
if stcompare(sbtime, "**") eq 0 then
	[
	sbtime ! 0 = 0
	let tich = createsbtime(sbtime, tod)
	]
vmapstatus = statusblind
mapcp(sel>>SEL.doc, sel>>SEL.cpfirst)
let tfc = cpscrt
deltacp = 0
let tbifr = PutSbScr(sbtime, vlook1 & not trailerbits, vlook2)
cpscrt = cpscrt + deltacp
insertd(sel>>SEL.doc, sel>>SEL.cpfirst, sbtime>>SB.cch, fnscr, tfc, tbifr)
move(sel, selaux, sell)
invalidatedisplay(sel>>SEL.doc, sel>>SEL.cpfirst, vdlhint)
setsel(selaux, sel>>SEL.cpfirst, sel>>SEL.cpfirst+(sbtime>>SB.cch)-1)
setsel(sel, sel>>SEL.cpfirst+tich-2, sel>>SEL.cpfirst+(sbtime>>SB.cch)-1)
resultis true
]


and MONTHNAME(mo) = monthnames()+mo*5

and monthnames() =	// (Sigh.)
// monthnames!(j*5) is the name of month j
"x*007January*000*000*010February*000*005March*000*000*000*000*005April*000*000*000*000*003May*000*000*000*000*000*000*004June*000*000*000*000*000*004July*000*000*000*000*000*006August*000*000*000*011September*007October*000*000*010November*000*010December*000"+1