<?stt
"/ inspired by a corresponding example from the smlServer...
"/ see http://www.smlserver.org
|year calMonth calYear|
year := Date today year.
calMonth :=
[:year :month |
|nDays weekDay thisMonth thisDay|
thisMonth := Date today month.
thisDay := Date today day.
nDays := Date daysInMonth:month forYear:year.
weekDay := (Date day:1 month:month year:year) dayInWeek.
response tableStart:'BORDER'.
response tableRow:[
response nextPutLine:'<th COLSPAN="7">',(Date nameOfMonth:month) asUppercaseFirst, ' ' , year printString,'</th>'.
].
response tableRow:[
(((1 to:7) collect:[:i | (Date abbreviatedNameOfDay:i) asUppercaseFirst]) collect:[:dayName | dayName asUppercaseFirst]) do:[:dayName |
response nextPutAll:'<th>',dayName,'</th>'.
].
].
response tableRowStart:'ALIGN="RIGHT"'.
1 to:weekDay-1 do:[:empty |
response nextPutAll:'<td></td>'.
].
1 to:nDays do:[:day |
(month == thisMonth and:[day == thisDay]) ifTrue:[
response nextPutAll:'<td bgcolor="#FF7F7F">'.
response nextPutAll:'<b>', day printString , '</b>'.
] ifFalse:[
response nextPutAll:'<td>'.
response nextPutAll:day printString.
].
response nextPutAll:'</td>'.
weekDay := weekDay + 1.
weekDay == 8 ifTrue:[
response tableRowEnd.
response nextPutLine:'</tr>'.
response tableRowStart:'ALIGN="RIGHT"'.
weekDay := 1.
]
].
weekDay ~~ 1 ifTrue:[
weekDay to:7 do:[:empty |
response nextPutAll:'<td></td>'.
].
].
response tableRowEnd.
response tableEnd.
].
calYear :=
[:year |
response tableStart:'BORDER'.
1 to:12 by:3 do:[:i |
response tableRowStart:'VALIGN="TOP"'.
i to:i+2 do:[:month |
response nextPutLine:'<td>'.
calMonth value:year value:month.
response nextPutLine:'</td>'.
].
response tableRowEnd.
].
response tableEnd.
]
"/ the original ML-code:
"/<?MSP(* ML Server Pages calendar -- sestoft@dina.kvl.dk 2000-01-09 *)
"/
"/local
"/ open Date Msp
"/ infix &&
"/
"/ val daynames = ["Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"]
"/
"/ val monthnames =
"/ Vector.fromList ["January", "February", "March", "April", "May", "June", "July",
"/ "August", "September", "October", "November", "December"]
"/
"/ fun leap y = y mod 4 = 0 andalso y mod 100 <> 0 orelse y mod 400 = 0
"/
"/ fun daysinmonth year =
"/ fn Jan => 31 | Feb => if leap year then 29 else 28
"/ | Mar => 31 | Apr => 30 | May => 31 | Jun => 30
"/ | Jul => 31 | Aug => 31 | Sep => 30 | Oct => 31
"/ | Nov => 30 | Dec => 31
"/
"/ val tomonthcode =
"/ fn 1 => Jan | 2 => Feb | 3 => Mar | 4 => Apr | 5 => May | 6 => Jun
"/ | 7 => Jul | 8 => Aug | 9 => Sep | 10 => Oct | 11 => Nov | 12 => Dec
"/ | _ => raise Fail "Illegal month number"
"/
"/ val frommonthcode =
"/ fn Jan => 1 | Feb => 2 | Mar => 3 | Apr => 4
"/ | May => 5 | Jun => 6 | Jul => 7 | Aug => 8
"/ | Sep => 9 | Oct => 10 | Nov => 11 | Dec => 12
"/
"/ fun toDatedate (year, month, day) =
"/ date { year = year, month = tomonthcode month, day = day,
"/ hour = 12, minute = 0, second = 0, offset = NONE }
"/
"/ val wdayno =
"/ fn Mon => 1 | Tue => 2 | Wed => 3 | Thu => 4
"/ | Fri => 5 | Sat => 6 | Sun => 7
"/
"/ val dayheader = tr(prmap (th o $) daynames)
"/
"/ fun mkmonth (year : int) (month : int) wrap =
"/ let val firstwdayno = wdayno (weekDay (toDatedate (year, month, 1)))
"/ val daysinmonth = daysinmonth year (tomonthcode month)
"/ val days = List.tabulate(firstwdayno-1, fn _ => NONE)
"/ @ List.tabulate(daysinmonth, fn d => SOME(d+1))
"/ fun makeday NONE = Empty
"/ | makeday (SOME day) =
"/ let val daystring = $ (Int.toString day)
"/ in wrap (year, month, day) daystring end
"/ fun weeks [] = []
"/ | weeks days =
"/ let val thisweek = List.take(days, Int.min(7, length days))
"/ val nextweek = List.drop(days, Int.min(7, length days))
"/ val firstrow = prmap (td o makeday) thisweek
"/ in
"/ firstrow :: weeks nextweek
"/ end
"/ val monthheader =
"/ $$[Vector.sub(monthnames, month-1), " ", Int.toString year]
"/ in
"/ tablea "BORDER" (tr(tha "COLSPAN=7" monthheader)
"/ && dayheader && Nl
"/ && prsep Nl (tra "ALIGN=RIGHT") (weeks days))
"/ end
"/in
"/ val today =
"/ let val dt = fromTimeLocal(Time.now())
"/ in (year dt, frommonthcode (month dt), day dt) end
"/
"/ fun calmonth year month =
"/ let fun wrap date s = if date = today then strong s else s
"/ in mkmonth year month wrap end
"/
"/ fun calyear year =
"/ let fun prtab(n, f) = List.foldr (op &&) Empty (List.tabulate(n, f))
"/ fun mkcalrow r =
"/ tra "VALIGN=TOP" (prtab(3,
"/ fn s => td(calmonth year (3*r+s+1))))
"/ in
"/ tablea "BORDER" (prtab(4, mkcalrow))
"/ end
"/
"/ val year = %%#("year", #1 today);
"/end
?>
<!-- $Header$ -->
<html>
<head>
<title>STT example: Calendar for year <?stt= year printString ?></title>
</head>
<body bgcolor="#fbf2e7">
<h2>STT example: calendar for year <?stt= year printString ?></h2>
<?stt calYear value: year ?>
<p>
<hr>
<p>
Credits:
<br>Inspired by a corresponding example found on <A HREF="http://www.smlserver.org">http://www.smlserver.org</A>.
<p>
<hr><address>Served by your friendly <a href=http://www.exept.de>ST/X WebServer</a></address>
</body>
</html>
|