rem 12/13/86 common used for terminal characteristics
common today$,warm$,trmtyp$,clear$,bell$,clreol$
common escape$,poscmd$,posofs%,rowcol$
rem - program CALENDAR.BAS
rem - Calendars for any month
rem - Copyright 1982, by Peter C. Hawxhurst
rem - revised 11/18/1982
rem - variable tabulation ************************
rem   cmnd$  = user selection input
rem   count% = month read counter
rem   datex$  = first day of month for any calendar
rem            being displayed
rem   f      = date calculation factor
rem   f1     = 1st half of date calculation formula
rem   f2     = 2nd half of date calculation formula
rem   i%     = for/next loop counter
rem   j%     = for/next loop counter
rem   m      = number of month for plot
rem   m$     = month read from data statements
rem   month$ = name of month being plotted
rem            also month input
rem   n      = number of days in plotted month
rem   p      = plot start point
rem   t      = day of day of week factor
rem   temp$  = temporary date holder
rem   today$ = date routine is entered by user
rem   warm$  = logo switch for return to menu
rem   week$  = letters for days of week heading
rem   y      = year for plot
rem   year$  = year input
rem - program structure **************************
datex$=str$(val(left$(today$,2))-1)+"/01"+right$(today$,5)
if val(left$(datex$,2))>0 then 10
datex$="12/01/"+str$(val(right$(today$,4))-1)
goto 20
10 if val(left$(datex$,2))>9 then 20
datex$="0"+str$(val(left$(today$,2))-1)+"/01"+right$(today$,5)
20 gosub 200 : rem - subscreen
gosub 100 : rem - screen
30 gosub 300 : rem - input
if s1=0 then 30
%chain 100,10000,50,500
print clear$
chain "HANDYSYS.COM"
100 rem - screen subroutine **********************
for j%=1 to 4
    gosub 400 : rem - calculate
    on j% gosub 500,600,700,800
    on j% gosub 900,1000,1100,1200
    gosub 1600 : rem - advance
next j%
return
200 rem - subscreen subroutine *******************
print clear$
ypos%=20:xpos%=1:gosub 15000: rem - cursor
for i%=1 to 49:print "-";:next i%:print
print
print tab(2);"(A)head";tab(11);"(B)ack";
print tab(19);"(E)xit";tab(27);"(S)pecify"
return
300 rem - input subroutine ***********************
310 ypos%=22:xpos%=37:gosub 14000: rem - rubout
gosub 15000 : rem - cursor
print bell$;
print "> ";
while not constat%:wend:cmnd$=ucase$(chr$(conchar%))
if cmnd$="" then 310
if cmnd$="A" then gosub 1300
if cmnd$="A" then 330
if cmnd$="B" then gosub 1400
if cmnd$="B" then 330
if cmnd$="S" then gosub 1500
if cmnd$="S" then 330
if cmnd$="E" then 320
print bell$:goto 310
320 s1=1
330 return
400 rem - calculate subroutine *******************
n=0:d=1:m=val(left$(datex$,2)):y=val(right$(datex$,4))
if m>2 then 410
f1=365*y+d+31*(m-1)+int((y-1)/4)
f2=int(.75*int((y-1)/100)+1)
f=f1-f2
goto 420
410 f1=365*y+d+31*(m-1)-int(.4*m+2.3)
f2=int(y/4)-int(.75*int(y/100)+1)
f=f1+f2
420 t=f-(int(f/7)*7)
if t=0 then let p=7
if t<>0 then let p=t
if m=9 then let n=30
if m=4 then let n=30
if m=6 then let n=30
if m=11 then let n=30
if m<>2 then 430
n=28
if y/4=int(y/4) then let n=29
430 if n=0 then let n=31
return
500 rem - quad 1 heading subroutine **************
for i%=1 to m:read month$:next i%:restore
month$=month$+" "+right$(datex$,4)
ypos%=2:xpos%=9:gosub 15000 : rem - cursor
print month$
week$="S  M  T  W  T  F  S"
ypos%=3:xpos%=4:gosub 15000: rem - cursor
print week$
return
600 rem - quad 2 heading subroutine **************
for i%=1 to m:read month$:next i%:restore
month$=month$+" "+right$(datex$,4)
ypos%=2:xpos%=36:gosub 15000:rem - cursor
print month$
ypos%=3:xpos%=31:gosub 15000 : rem - cursor
print week$
return
700 rem - quad 3 heading subroutine **************
for i%=1 to m:read month$:next i%:restore
month$=month$+" "+right$(datex$,4)
ypos%=11:xpos%=9:gosub 15000: rem - cursor
print month$
ypos%=12:xpos%=4:gosub 15000: rem - cursor
print week$
return
800 rem - quad 4 heading subroutine **************
for i%=1 to m:read month$:next i%:restore
month$=month$+" "+right$(datex$,4)
ypos%=11:xpos%=36:gosub 15000:rem - cursor
print month$
ypos%=12:xpos%=31:gosub 15000:rem - cursor
print week$
return
900 rem - quad 1 plot subroutine *****************
ypos%=4
910 for i%=1 to n
    xpos%=p*3
    if i%>9 then xpos%=xpos%-1
    gosub 15000:rem - cursor
    print i%
    p=p+1
    if p>7 then let ypos%=ypos%+1
    if p>7 then let p=1
next i%
return
1000 rem - quad 2 plot subroutine ****************
ypos%=4
1010 for i%=1 to n
     xpos%=p*3+27
     if i%>9 then xpos%=xpos%-1
     gosub 15000:rem - cursor
     print i%
     p=p+1
     if p>7 then let ypos%=ypos%+1
     if p>7 then let p=1
next i%
return
1100 rem - quad 3 plot subroutine **********************
ypos%=13
gosub 910
return
1200 rem - quad 4 plot subroutine ****************
ypos%=13
gosub 1010
return
1300 rem - ahead subroutine **********************
gosub 1800:  rem - clear screen
gosub 100:   rem - screen
return
1400 rem - back subroutine
temp$=datex$
datex$=str$(val(left$(temp$,2))-8)+"/01"+right$(temp$,5)
if val(left$(datex$,2))>0 then 1410
datex$=str$(4+val(left$(temp$,2)))+"/01"+str$(val(right$(temp$,4))-1)
goto 1420
1410 if val(left$(datex$,2))>9 then 1420
datex$="0"+str$(val(left$(temp$,2))-8)+right$(temp$,5)
1420 gosub 1800:gosub 100
return
1500 rem - specify subroutine ********************
count%=0
1510 ypos%=22:xpos%=1:gosub 14000:rem - rubout
gosub 15000:rem - cursor
input "Enter month to start (JAN,FEB...) >";line month$
if month$="" then 1510
if month$=escape$ then 1580
month$=ucase$(month$)
1520 gosub 14000:gosub 15000
input "Enter year for calendar (YYYY) >";line year$
if year$="" then 1520
if year$=escape$ then 1580
if len(year$)=4 then 1525
print bell$:goto 1520
1525 x$=year$
gosub 11000 : rem - numeric check
if e1=0 then 1530
print bell$
goto 1520
1530 read m$
count%=count%+1
if left$(month$,3)=m$ then 1560
if count%=12 then 1550
goto 1530
1550 restore
print bell$
goto 1510
1560 restore
datex$=str$(count%-1)+"/01/"+year$
if count%>10 then 1570
datex$="0"+str$(count%-1)+"/01/"+year$
if count%>1 then 1570
datex$="12/01/"+str$(val(year$)-1)
1570 gosub 1800 : rem - clear screen
gosub 100 : rem - screen
ypos%=22:xpos%=1:gosub 14000:rem - rubout
gosub 15000 : rem - cursor
print "(A)head  (B)ack  (E)xit  (S)pecify"
1580 return
1600 rem - advance subroutine ********************
temp$=datex$
datex$=str$(val(left$(temp$,2))+1)+"/01"+right$(temp$,5)
if val(left$(datex$,2))<13 then 1610
datex$="01/01/"+str$(val(right$(temp$,4))+1)
goto 1620
1610 if val(left$(datex$,2))>9 then 1620
datex$="0"+str$(val(left$(temp$,2))+1)+"/01"+right$(temp$,5)
1620 return
1800 rem - clear (top of) screen subroutine ***************
ypos%=1:xpos%=1:gosub 15000:rem cursor
for i%=1 to 19
print clreol$
next i%
return
rem - data listing *******************************
data "JAN","FEB","MAR","APR","MAY","JUN"
data "JUL","AUG","SEP","OCT","NOV","DEC"
11000 rem - numeric check subroutine ***************
11010 rem 
11020 rem - variables to check
11030 rem   e1   = error switch
11040 rem   i%   = for/next loop counter
11050 rem   x    = numeric position counter
11060 rem   y    = decimal point locator
11070 rem   z    = numeric position match counter
11080 rem
11090 e1=0:x=0:y=0:z=0:y=match(".",x$,1)
11100 for i%=1 to len(x$):z=z+i%:next i%
11110 if y=0 then 11130
11120 z=z+1
11130 for i%=1 to len(x$):x=x+match("#",x$,i%):next i%
11140 if x=z then 11160
11150 e1=1
11160 return
14000 rem - rubout subroutine ********************
14010 gosub 15000
14020 print clreol$;
14030 return
15000 rem - cursor subroutine ********************
15020 rem - variables to check
15030 rem   xpos% = horizontal cursor position (1-52, L to R)
15040 rem   ypos% = vertical cursor position (1-24, T to B)
15060 if rowcol$=chr$(01) then 15090
15070 print poscmd$+chr$(xpos%+posofs%-1)+chr$(ypos%+posofs%-1);
15080 go to 15100
15090 print poscmd$+chr$(ypos%+posofs%-1)+chr$(xpos%+posofs%-1);
15100 return