''' Calendar Program '' with pen GUI extensions '' Apologies to Bob Riess for hacking his code :-) '' [This will look best on a palm] '' GUI/changes '' opens with current month '' tap < for previous month '' tap > for next month '' tap elsewhere for month/year entry '' tap "." to exit const box=18 const lmar=80-box*7/2 const tmar=34 declare sub setup() declare sub askdate() declare sub drawcal() declare sub calcdate() declare func penio() '' pen gui declare sub mup(m y) '' next month declare sub mdn(m y) '' prev month SUB setup dim ds(0 to 6),ms(12,2) for i=0 to 6 : read ds(i) : next data "Su","Mo","Tu","We","Th","Fr","Sa" for i=1 to 2 : for j=1 to 12 : read ms(j,i) next : next data "January","February","March","April","May","June","July","August","September","October","November","December" data 31,28,31,30,31,30,31,31,30,31,30,31 split DATE ,"/,",v '' start at current month m=val(v(1)) y=val(v(2)) end SUB askdate at 3,148 input "Month,Year? ",ln$ cls if ln$="." '' stop stop elseif ln$=0 split DATE ,"/,",v '' restart at current month m=val(v(1)) y=val(v(2)) else split ln$,"/,",v '' month/year entry m=val(v(0)) y=val(v(1)) endif end SUB calcdate d=(1461*(y+4800+(m-14)\\12)\\4+367*(m-2-12*((m-14)\\12))\\12-3*((y+4900+(m-14)\\12)\\100)\\4+1)%7 ms(2,2)=28+(y%4=0 and (y%100<>0 or y%400=0)) n=ms(m,1)+" "+str$(y) end FUNC penio '' pen GUI function local o pen on p=tmar/2 + 6*box o=0 while pen(0)=0 wend while pen(3)=1 wend if pen(1) > tmar/2 and pen(1) < tmar and pen(2)> tmar/2-txth("<") and pen(2) < tmar/2 o=1 elif pen(1)>p and pen(1) < p+box and pen(2) > 1 and pen(2) < tmar/2 o=2 fi penio=o end SUB drawcal at 1+tmar/2,6 print "<"; p=tmar/2 + 6*box at 8+p+box/4,6 print ">"; '' header at 1+(160-txtw(n))/2-len(n)/2,tmar/2-txth(n) print cat(1);n;cat(0) '' # of rows i=(ms(m,2)+d+6)\\7 '' verticals for n=0 to 7 : line lmar+box*n,tmar,lmar+box*n,tmar+box*i : next '' horizontals for n=0 to i : line lmar,tmar+box*n,lmar+box*7,tmar+box*n : next '' days for n=0 to 6 at lmar+1+box*n+(box-txtw(ds(n)))/2,tmar-1-txth(ds(n)) print ds(n) next '' actual calendar for i=0 to ms(m,2)-1 row=(d+i)\\7 col=(d+i)%7 n=str$(i+1) at lmar+1+box*col+(box-txtw(n))/2,tmar+1+box*row+(box-txth(n))/2 print n next end sub mup(BYREF m, BYREF y) m=m+1 if m=13 y=y+1 m=1 fi end sub mdn(BYREF m, BYREF y) m=m-1 if m=0 y=y-1 m=12 fi end #MAIN setup repeat if ubound(v) then calcdate drawcal q=penio if q=2 cls mup m, y elseif q=1 cls mdn m, y else askdate fi fi until '