#-h- date.r          3697  asc  30-oct-80 13:15:12  [002,100]
#-h- dates            520  asc  30-oct-80 13:12:35  [002,100]
## dates - print current date

 subroutine main

character buf(MAXLINE), dat(10)
integer cupper, length

call gdate(dat)
call fold(dat)
call wkday( dat, buf)
dat(4) = cupper(dat(4))		# capitalize first character of month
i = length(buf)
buf(i+1) = BLANK
i = i + 2
call stcopy( dat, 1, buf, i)
buf(i) = BLANK
call gtime (buf(i+1))
i = length(buf)
#buf(i+1) = BLANK
#call scopy( "PDT", 1, buf, i+2) #!!! Must be changed manually !!!
#i = length(buf)
buf(i+1) = NEWLINE
buf(i+2) = EOS
call putlin(buf, STDOUT)

 return
end
#-h- wkday           1488  asc  30-oct-80 13:12:36  [002,100]
subroutine wkday( datstr, daynam)

integer dyofmn	# [1..31]
integer dyofwk	# [1..7] => [sun..sat]
integer year
integer c, i, k
integer monnum	# [1..12]
integer ctoi, mod, oldmon # function(s)
character daynam(4)
character datstr(ARB)	# dd-mmm-yy format assumed.
character daystr(3), monstr(4), yrstr(3)

string sunday "Sunday"
string monday "Monday"
string tuesda "Tuesday"
string wednes "Wednesday"
string thursd "Thursday"
string friday "Friday"
string Saturd "Saturday"

# Extract day, month, and year from datstr.
call mvsubs( datstr, 1, 2, daystr)
call mvsubs( datstr, 4, 3, monstr)
call mvsubs( datstr, 8, 2, yrstr)

# Convert day and year to integer.
i = 1
dyofmn = ctoi( daystr, i)
i = 1
year = ctoi( yrstr, i)

if( year == 0 )
{
  year = 100
  c = 18
}
else
  c = 19 # Assume ( 1900 <= year <= 1999 )

k = c/4 - 2*c # `Century' constant.

# Get `real' number of month.
call fold(monstr)
monnum = oldmon(monstr)

if( monnum > 10 )
  year = year - 1

dyofwk = mod(dyofmn + (26*monnum-2)/10 + year + year/4 + k, 7) + 1

if( dyofwk <= 0 )
  dyofwk = dyofwk + 7 # Correct for `funny' mod functions.

switch (dyofwk)
    {
    case 1: call scopy(sunday, 1, daynam, 1)
    case 2: call scopy(monday, 1, daynam, 1)
    case 3: call scopy(tuesda, 1, daynam, 1)
    case 4: call scopy(wednes, 1, daynam, 1)
    case 5: call scopy(thursd, 1, daynam, 1)
    case 6: call scopy(friday, 1, daynam, 1)
    case 7: call scopy(saturd, 1, daynam, 1)
    default: daynam(1) = EOS
    }

return
end
#-h- movchs           238  asc  30-oct-80 13:12:37  [002,100]
## MovChs - Move `n' chars from `src' to `dst'.

integer function movchs( src, dst, n)

character dst(ARB), src(ARB)
integer   i, n

for( i = 1 ; i <= n & src(i) != EOS ; i = i + 1 )
  dst(i) = src(i)

dst(i) = EOS
movchs = i

return
end
#-h- mvsubs           313  asc  30-oct-80 13:12:37  [002,100]
## MvSubS - Move <= `n' chars from `in(i)' to `out'.

integer function mvsubs( in, i, n, out)

integer    i, j, k, n
character  in(ARB), out(ARB)

k = i

for( j = 1  ;  in(k) != EOS & j <= n  ;  j = j + 1 )
{
  out(j) = in(k)
  k = k + 1
}
out(j) = EOS

mvsubs = j - 1 # Return number of chars moved.

return
end
#-h- oldmon           341  asc  30-oct-80 13:12:38  [002,100]
integer function oldmon( monstr )

integer trigrm # function(s)
integer month # [1..12] => [mar..feb]

character monstr(4)

string months "maraprmayjunjulaugsepoctnovdecjanfeb"

month = trigrm( monstr, months, 12)
if( month == 0 )
{
  call putlin( "? Bad month_string `", ERROUT)
  call remark( monstr, ERROUT)
}

oldmon = month

return
end
#-h- trigrm           425  asc  30-oct-80 13:12:38  [002,100]
## TriGrm - Lookup `tg' in `list' of `n' trigrams. Return index or 0.

integer function trigrm( tg, list, n)

integer   i, j, junk, n
integer   equal # function(s)
character list(ARB), tg(ARB)

junk = movchs( list, str, 3)

j = 1
for( i = 1 ; equal( tg, str) == NO ; i = i + 1 )
  if( i <= n )
  {
    j = j + 3
    junk = movchs( list(j), str, 3)
  }
  else
    break

if( i > n )
  trigrm = 0
else
  trigrm = i

return
end