// TimeIO.bcpl -- conversion between unpacked internal representation
//		and external (printed) form
// Copyright Xerox Corporation 1979, 1981

// last modified May 5, 1981  6:48 PM by Taft

get "Time.d"

//	WRITEUDT(strm, uvec [, printZone])
// writes the unpacked date and time from uvec onto the
// stream strm in the form "29-DEC-74 14:43:37".  If uvec=0,
// uses the current date and time.  If printZone is supplied and true,
// appends the time zone to the result, e.g., " PDT" or " +03" or "-02:30".

//	CONVUDT(strg, uvec [, printZone])
// same as WRITEUDT, but puts the result into the string strg.
// Value is strg.

//	FINDMONTH(strg)
// returns the month number (0-11) for the month whose name
// is strg (may be a prefix), or -1 if not a month name.

//	MONTHNAME(mo)
// returns the name of month number mo.


external
[
// outgoing procedures
WRITEUDT
CONVUDT
FINDMONTH
MONTHNAME

// incoming procedures
UNPACKDT
PACKDT
MoveBlock
Wss
Max
]

structure String:	// BCPL string
[
length byte
char↑1,255 byte
]


// Exported procedures

//----------------------------------------------------------------------------
let CONVUDT(strg, uvec, printZone; numargs na) = valof
//----------------------------------------------------------------------------
// Sigh, this would be much easier using streams and the Template package...
[
let ucur = vec 6
if uvec eq 0 then [ UNPACKDT(0, ucur); uvec = ucur ]
let w2d(s, x, pos) be
   [
   if x ge 10 then s>>String.char↑pos = x/10+$0
   s>>String.char↑(pos+1) = (x rem 10)+$0
   ]
MoveBlock(strg, " 0-xxx-00  0:00:00", 10)
w2d(strg, uvec>>UTV.day, 1)
let mn = monthnames()+uvec!1*5
// trim to 3 chars
for i = 1 to 3 do strg>>String.char↑(3+i) = mn>>String.char↑i
w2d(strg, uvec>>UTV.year rem 100, 8)
w2d(strg, uvec>>UTV.hour, 11)
w2d(strg, uvec>>UTV.minute, 14)
w2d(strg, uvec>>UTV.second, 17)

if na ge 3 & printZone then
   [
   strg>>String.char↑19 = $*S
   MoveBlock(lv strg>>String.char↑20, "0T:00", 3)
   strg>>String.length = 22
   switchon uvec>>UTV.zone into
      [
      case 4 lshift size UTV.zone.minute:
      case 5 lshift size UTV.zone.minute:
      case 6 lshift size UTV.zone.minute:
      case 7 lshift size UTV.zone.minute:
      case 8 lshift size UTV.zone.minute:
      case 9 lshift size UTV.zone.minute:
      case 10 lshift size UTV.zone.minute:
         strg>>String.char↑20 = "AECMPYH">>String.char↑(uvec>>UTV.zone.hour-3)
         strg>>String.char↑21 = (uvec>>UTV.daylight? $D, $S)
         endcase
      case 0:
         unless uvec>>UTV.daylight do  // daylight falls thru to default case
            [ strg!(20/2) = $G lshift 8 + $M; endcase ]
      default:
         let h = uvec>>UTV.zone.hour
         if uvec>>UTV.zone.sign then h = -h
         if uvec>>UTV.daylight then h = h-1
         strg>>String.char↑20 = (h ls 0? $-, $+)
         w2d(strg, Max(h, -h), 21)
         if uvec>>UTV.zone.minute ne 0 then
            [ w2d(strg, uvec>>UTV.zone.minute, 24); strg>>String.length = 25 ]
         endcase
      ]
   ]
resultis strg
]

//----------------------------------------------------------------------------
and WRITEUDT(strm, uvec, printZone; numargs na) be
//----------------------------------------------------------------------------
[
let strg = vec 12   // xx-xxx-xx xx:xx:xx sxx:xx
CONVUDT(strg, uvec, na ge 3 & printZone)
Wss(strm, strg)
]

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

//----------------------------------------------------------------------------
and FINDMONTH(strg) = valof
//----------------------------------------------------------------------------
[
let len = strg>>String.length
if len ls 3 resultis -1
let mntbl = monthnames()
for j = 0 by 5 to 55 do
   [
   let tstr = mntbl+j
   if len gr tstr>>String.length then loop
   let i = 1
      [ // repeat
      if (tstr>>String.char↑i & #337) ne
       (strg>>String.char↑i & #337) then break
      if i eq len resultis j/5
      i = i+1
      ] repeat
   ]
resultis -1
]


// Local procedures

//----------------------------------------------------------------------------
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