rem 12/13/86 common used for terminal characteristics
common today$,warm$,trmtyp$,clear$,bell$,clreol$
common escape$,poscmd$,posofs%,rowcol$
rem - program PLANNING.BAS
rem - planning calendar
rem - Copyright Peter C. Hawxhurst 1982
rem - revised 11/25/1982
rem
rem - program structure ***********************
%chain 100,10000,50,500
dim xpoint%(31)
dim ypoint%(31)
m=val (left$(today$,2))
y=val(right$(today$,4))
date0$=today$
gosub 1000 : rem - subscreen
70 gosub 370:rem - calculate
80 gosub 590:rem - headings
90 gosub 690:rem - plot
gosub 1100 : rem - report
95 gosub 1200 : rem - input
if s1=0 then 100
goto 180
100 if cmnd$="A" then gosub 1300
if cmnd$="D" then gosub 1400
if cmnd$="F" then gosub 1500
if cmnd$="N" then gosub 1600
print bell$
goto 95
180 print clear$
chain "HANDYSYS.COM"
370 rem - calculate subroutine *******************
for i%=1 to m:read m$:next i%:restore
380 d=1:n=0
390 if m>2 then 440
400 let f1=365*y+d+31*(m-1)+int((y-1)/4)
410 let f2=int(.75*int((y-1)/100)+1)
420 let f=f1-f2
430 goto 470
440 let f1=365*y+d+31*(m-1)-int(.4*m+2.3)
450 let f2=int(y/4)-int(.75*int(y/100)+1)
460 let f=f1+f2
470 let t=f-(int(f/7)*7)
480 if t=0 then let p=7
490 if t<>0 then let p=t
500 if m$="SEP" then let n=30
510 if m$="APR" then let n=30
520 if m$="JUN" then let n=30
530 if m$="NOV" then let n=30
540 if m$<>"FEB" then 570
let n=28
560 if y/4=int(y/4) then let n=29
570 if n=0 then let n=31
580 return
590 rem - headings subroutine ********************
if s2>0 then 620
ypos%=2:xpos%=1:gosub 15000 : rem - cursor
print tab(28);m$;",";y
goto 630
620 print tab(26);m$;",";y
630 s2=1
print
640 print tab(4);"SUN";tab(11);"MON";tab(18);"TUE";
650 print tab(25);"WED";tab(32);"THU";
660 print tab(39);"FRI";tab(46);"SAT"
670 print
680 return
690 rem - plot subroutine ************************
point%=7
700 for i%=1 to n
710 print tab(p*7-3);" ";
720 print using "##";i%;
xpoint%(i%)=p*7-3
ypoint%(i%)=point%
730 let p=p+1
740 if p>7 then print
750 if p>7 then print
if p>7 then let point%=point%+2
760 if p>7 then let p=1
770 next i%
780 return
1000 rem - subscreen subroutine ******************
print clear$
ypos%=19:xpos%=4:gosub 15000:rem - cursor
for j%=1 to 46
    print "-";
next j%
print
print "     (A)dd (D)elete (E)xit (F)uture (N)ext"
return
1100 rem - report subroutine *********************
if end #1 then 1110
open "PLANNING.DAT" as 1
goto 1120
1110 create "PLANNING.DAT" as 1
goto 1150
1120 if end #1 then 1150
read #1;start$,item$,length$
if left$(start$,2)=left$(date0$,2) then 1130
goto 1120
1130 if right$(start$,4)=right$(date0$,4)then 1140
goto 1120
1140 ypos%=ypoint%(val(mid$(start$,4,2)))
xpos%=xpoint%(val(mid$(start$,4,2)))-4
gosub 15000 : rem - cursor
print item$;
xpos%=xpos%+len(item$):dot%=val(length$)*7-len(item$)
for i%=1 to dot%
    gosub 15000:rem - cursor
    print "."
    xpos%=xpos%+1
    if xpos%>=49 then ypos%=ypos%+2
    if xpos%>=49 then dot%=dot%-4
    if xpos%>=49 then xpos%=4
next i%
goto 1120
1150 close 1
return
1200 rem - input subroutine **********************
1210 ypos%=20:xpos%=44:gosub 15000:rem - cursor
print bell$;
print "> ";
while not constat%:wend:cmnd$=ucase$(chr$(conchar%))
if cmnd$="" then gosub 14000:goto 1210
if cmnd$="" then 1210
if cmnd$="E" then let s1=1
return
1300 rem - add subroutine ************************
open "PLANNING.DAT" as 1
1310 if end #1 then 1320
read #1;start$,item$,length$
goto 1310
1320 ypos%=20:xpos%=44:gosub 14000:rem - rubout
1330 ypos%=22:xpos%=6:gosub 15000:rem - cursor
input "Enter starting day (DD) >";line begin$
if begin$="" then 1320
if begin$=escape$ then 1370
start$=left$(date0$,3)+begin$+right$(date0$,5)
gosub 10000 : rem - date check
if e1=0 then 1340
print bell$:gosub 14000:goto 1330
1340 gosub 14000:gosub 15000
input "Enter number of days for activity >";line length$
if length$="" then 1340
if length$=escape$ then 1370
x$=length$:gosub 11000 : rem - numeric check
if e1=0 then 1350
print bell$:gosub 14000:goto 1340
1350 gosub 14000:gosub 15000
print "Description (";val(length$)*5;
input "letters max ) >";item$
if len(item$)<=val(length$)*5 then 1360
print bell$:gosub 14000:goto 1350
1360 print #1;start$,item$,length$
1370 close 1
gosub 14000 : rem - rubout
gosub 1100 : rem - report
return
1400 rem - delete subroutine *********************
ypos%=20:xpos%=44:gosub 14000:rem - rubout
1410 ypos%=22:xpos%=6:gosub 15000:rem - cursor
input "Enter beginning day (DD) >";line begin$
if begin$="" then gosub 14000
if begin$="" then 1410
if begin$=escape$ then 1450
temp$=left$(date0$,3)+begin$+right$(date0$,5)
date0$=temp$
gosub 10000:rem - date check
if e1=0 then 1420
print bell$:gosub 14000:goto 1410
1420 open "PLANNING.DAT" as 1
create "TRANS" as 2
1430 if end #1 then 1440
read #1;start$,item$,length$
if date0$=start$ then let erase%=val(length$)*7
if date0$=start$ then 1430
if val(right$(start$,4))<val(right$(today$,4)) then 1430
if val(right$(start$,4))>val(right$(today$,4)) then 1435
if val(left$(start$,2))<val(left$(today$,2)) then 1430
1435 print #2;start$,item$,length$
goto 1430
1440 delete 1
close 2
ren%=rename("PLANNING.DAT","TRANS")
ypos%=ypoint%(val(mid$(date0$,4,2)))
xpos%=xpoint%(val(mid$(date0$,4,2)))-4
gosub 15000
for i% =1 to erase%
    gosub 15000 : rem - cursor
    print " "
    xpos%=xpos%+1
    if xpos%>=49 then ypos%=ypos%+2
    if xpos%>=49 then erase%=erase%-4
    if xpos%>=49 then xpos%=4
next i%
1450 ypos%=22:xpos%=1:gosub 14000: rem - rubout
return
1500 rem - future subroutine *********************
ypos%=20:xpos%=44:gosub 14000 : rem - rubout
1510 ypos%=22:xpos%=6:gosub 15000 : rem - cursor
input "Enter future month (JAN, FEB...) >";line month$
if month$="" then gosub 14000
if month$="" then 1510
if month$=escape$ then 1596
month$=ucase$(month$)
month$=left$(month$,3)
count%=0
1520 read m$
count%=count%+1
if m$=month$ then 1540
if m$="NONE" then 1530
goto 1520
1530 restore:print bell$:gosub 14000:goto 1510
1540 restore
gosub 14000 :rem - cursor
1550 gosub 15000 : rem - cursor
input "Enter future year (YYYY) >";line year$
if year$="" then gosub 14000
if year$="" then 1550
if year$=escape$ then 1596
x$=year$
gosub 11000 : rem - numeric check
if e1=0 then 1560
print bell$:gosub 14000:goto 1550
1560 if len(year$)=4 then 1570
print bell$:gosub 14000:goto 1550
1570 m=count%
y=val(year$)
if count%>9 then 1580
date0$="0"+str$(count%)+"/01/"+year$
goto 1590
1580 date0$=str$(count%)+"/01/"+year$
1590 gosub 14000:rem - rubout
1595 ypos%=1:xpos%=1:gosub 15000:rem-cursor
for i%=1 to 16:print clreol$:next i%
ypos%=2:xpos%=1:gosub 15000:rem - cursor
gosub 370: rem - calculate
gosub 590: rem - headings
gosub 690: rem - plot
gosub 1100:rem - report
1596 return
1600 rem - next subroutine ***********************
m=m+1
if m>12 then y=y+1
if m>12 then m=1
if m>9 then 1610
date0$="0"+str$(m)+"/01/"+str$(y)
goto 1620
1610 date0$=str$(m)+"/01/"+str$(y)
1620 ypos%=20:xpos%=44:gosub 14000:rem - rubout
gosub 1595:rem - future
return
rem - data statements ****************************
data "JAN","FEB","MAR","APR"
data "MAY","JUN","JUL","AUG"
data "SEP","OCT","NOV"
data "DEC","NONE"
10000 rem - date check subroutine ******************
10010 rem
10020 rem - variables to check
10030 rem   date0$ = date being checked
10040 rem   e1    = error switch
10050 rem   i%    = for/next loop counter
10060 rem   p$    = substitute for date to be checked
10070 rem   p1$   = month
10080 rem   p2$   = day
10090 rem   p3$   = year
10100 rem   x     = numeric counter
10110 rem
10120 e1=0 
10130 p$=date0$ 
10140 if len(p$)>10 then 10340
10150 x=0
10160 for i%=1 to 10:x=x+match("#",p$,i%):next i%
10170 if x<>57 then 10340
10180 p1$=left$(p$,2):p2$=mid$(p$,4,2):p3$=right$(p$,4)
10190 if val(p1$)<1 then 10340
10200 if val(p1$)>12 then 10340
10210 if val(p2$)<1 then 10340
10220 if val(p3$)<1 then 10340
10230 if val(p1$)<>int(val(p1$)) then 10340
10240 if val(p2$)<>int(val(p2$)) then 10340
10250 if val(p3$)<>int(val(p3$)) then 10340
10260 if val(p1$)=9 and val(p2$)>30 then 10340
10270 if val(p1$)=4 and val(p2$)>30 then 10340
10280 if val(p1$)=6 and val(p2$)>30 then 10340
10290 if val(p1$)=11 and val(p2$)>30 then 10340
10300 if val(p1$)=2 and val(p2$)>29 then 10340
10310 if val(p3$)/4=int(val(p3$)/4) then 10350
10320 if val(p1$)=2 and val(p2$)>28 then 10340
10330 goto 10350
10340 let e1=1
10350 return
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   dpt  = decimal point locator
11070 rem   z    = numeric position match counter
11080 rem
11090 e1=0:x=0:dpt=0:z=0:dpt=match(".",x$,1)
11100 for i%=1 to len(x$):z=z+i%:next i%
11110 if dpt=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