home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 025.lha / calendar / calendar.main (.txt) < prev    next >
Encoding:
AmigaBASIC Source Code  |  1987-04-02  |  26.7 KB  |  1,135 lines
  1. 'Calendar Main Program  Version 1.1  4-16-86
  2.   SCREEN 1,640,200,3,2
  3. DEFINT a-z
  4. WINDOW 1,"***** AMIGA CALENDAR *****",(0,10)-(250,60),0
  5. COLOR 2,1:CLS
  6. PRINT"BY   Mark D. Hurst
  7. PRINT TAB(6)"S.W. McKibben Rd.
  8. PRINT TAB(6)"Sheridan Oregon 97378
  9. PRINT TAB(6)"503-843-3185
  10. DIM yearbuf(27),days.in.month(12),month$(12)
  11. DIM char(50,26),num(50,10),symbol(102,4)
  12. DIM code$(12),Lo(5,5),s(10),f$(10),f(5)
  13. DIM cov.pat(3),r.edge.pat(3),b.edge.pat(3),reset.pat(3)
  14. DIM change.pat(3),yb(42),a$(13)
  15. PRINT"Just a moment to load some files.  
  16. FOR x=0 TO 3:READ r.edge.pat(x):NEXT x
  17.  DATA &h2222,&h2222,&h2222,&h2222
  18. FOR x=0 TO 3:READ cov.pat(x):change.pat(x)=cov.pat(x):NEXT x
  19.  DATA &h7777, &hbbbb, &hdddd, &heeee
  20. FOR x=0 TO 3:READ b.edge.pat(x):NEXT x
  21.  DATA 0,&hffff,0,&hffff
  22. FOR x=0 TO 3:READ reset.pat(x):NEXT x
  23.  DATA -1,-1,-1,-1
  24. FOR x=0 TO 42:READ yb(x):NEXT x
  25.   DATA 31,35,40,46,53,60,77,83,88,92,95,98,101,104
  26.   DATA 107,110,117,104,102,101,94
  27.   DATA 87,80,77,70,63,59,52,46
  28.   DATA 40,34,28,22,16,11,7,4,3,2,1,0,0,0
  29. FOR x=0 TO 27:READ yearbuf(x):NEXT x
  30.   DATA 6,1,2,3,4,6,7,1,2,4,5,6,7,2,3,4,5,7,1,2,3,5,6,7,1,3,4,5
  31. FOR x=1 TO 12:READ month$(x),days.in.month(x):NEXT x
  32.   DATA JANUARY,31,FEBRUARY,28,MARCH,31,APRIL,30
  33.   DATA MAY,31,JUNE,30,JULY,31,AUGUST,31
  34.   DATA SEPTEMBER,30,OCTOBER,31,NOVEMBER,30,DECEMBER,31
  35. FOR x=1 TO 7:READ day.name$(x):NEXT x
  36.   DATA "Sunday   ","Monday   ","Tuesday  "
  37.   DATA Wednesday,"Thursday ","Friday   ","Saturday "
  38. OPEN "16x16.num.set" FOR INPUT AS 1
  39.   FOR x=1 TO 10:FOR y=0 TO 50
  40.     num(y,x)=CVI(INPUT$(2,1))
  41.   NEXT y,x:CLOSE 1   
  42. OPEN "16x16.char.set" FOR INPUT AS 1
  43.   FOR x=1 TO 26:FOR y=0 TO 50
  44.    char(y,x)=CVI(INPUT$(2,1))
  45.   NEXT y,x:CLOSE 1
  46. OPEN "cal.symbol" FOR INPUT AS 1
  47.   FOR x=1 TO 4:FOR y=0 TO 102
  48.     symbol(y,x)=CVI(INPUT$(2,1))
  49.   NEXT y,x:CLOSE 1
  50. open.files:
  51.   OPEN "cal.data" AS 1 LEN=310
  52.    FIELD 1,300 AS c.dat$, 10 AS s.nam$
  53.     IF LOF(1)/310 <366 THEN GOSUB new.file    
  54.   OPEN "cal.symbol.dat" AS 4 LEN=32
  55.    FIELD 4,32 AS cod$
  56.     FOR x=1 TO 12:GET 4:code$(x)=cod$:NEXT x
  57. Skip4:     
  58.   WINDOW 2,"Amiga Calendar",(0,0)-(564,186),16,1
  59.   WINDOW CLOSE 1
  60. PALETTE 4,1,0,0     'red
  61. PALETTE 5,0,0.7,0    'dk.green
  62. PALETTE 6,0.8,0.6,0.53 'brown
  63. PALETTE 7,1,0.7,0    'orange
  64. draw.calendar: DIM b2(393)
  65.   COLOR 6,1
  66.   LINE (410,5)-(542,17),6,bf
  67.   COLOR 0,6
  68.   LOCATE 2,53:PRINT"PAYMENT SCEDULE""
  69.   GET (410,5)-(542,17),b2
  70.   COLOR 6,1:CLS
  71.   COLOR 5,1
  72.   LOCATE 3,2
  73.   FOR x=1 TO 7
  74.     PRINT day.name$(x)" ";     
  75.   NEXT x
  76. get.current.date
  77.  draw.lines
  78.   put.date
  79.    find.buffers
  80.     fill.in.numbers 
  81. draw.menu:  
  82.   LINE(20,174)-(0,180),4:LINE-(20,184),4
  83.   LINE(148,174)-(168,180),4:LINE-(148,184),4
  84.   LINE(20,174)-(148,184),4,b
  85.   LINE (60,174)-(60,184),4
  86.   LINE(108,174)-(108,184),4
  87.   PAINT (21,175),4:PAINT(147,175),4
  88.   LOCATE 23,4:COLOR 1,4:PRINT"LAST";TAB(15);"NEXT";
  89.   COLOR 4,1:LOCATE 23,9:PRINT"MONTH";
  90.   LINE(188,174)-(252,184),4,bf
  91.   LINE(260,174)-(300,184),4,bf
  92.   LINE(338,174)-(396,184),0,bf
  93.   LINE(402,174)-(458,184),0,bf
  94.   LINE(466,174)-(518,184),0,bf
  95.   LINE(522,174)-(562,184),0,bf
  96.   LOCATE 23,25:COLOR 1,4:PRINT"RESTORE";TAB(34);"JUMP";
  97.   COLOR 1,0
  98.   LOCATE 23,44:PRINT"UPDATE";TAB(52);"REMIND";TAB(60);"DIARY";TAB(67);"QUIT";
  99.   tx=184:COLOR 2,1
  100. FOR x=1 TO 4: 
  101.   LINE(tx,145)-(tx+18,160),0,bf
  102.   PUT(tx,145),symbol(0,x) 
  103.   tx=tx+80
  104. NEXT x
  105.   LOCATE 21,22:PRINT"BIRTHDAY";TAB(33);"BILLS";TAB(42);"MEETINGS";
  106.   PRINT TAB(53);"NOTES";TAB(62);"HOLIDAYS";
  107.   COLOR 4,1:LOCATE 19,64:PRINT"RED"
  108.   LOCATE 20,62:PRINT"NUMBERS"
  109.   LINE (1,167)-(559,167),4
  110.    PUT(432,0),b2
  111.   ERASE b2
  112.    put.day.symbols
  113.     mark.day
  114.   sw.type=0:how(7)=1
  115. main.menu: 
  116.  wait.for.mouse: IF MOUSE(0)>-1 THEN SLEEP:GOTO wait.for.mouse
  117. stay.1: IF MOUSE(0)<0 THEN stay.1
  118.   IF MOUSE(1)>558 THEN BEEP:GOTO main.menu
  119.   IF MOUSE(1)>436 AND MOUSE(2)<13 THEN GOSUB payment.scedule:GOTO main.menu
  120.   IF MOUSE(2)<24 THEN BEEP:GOTO main.menu
  121.   IF MOUSE(2)>23 AND MOUSE(2)<168 THEN
  122.     d=(INT((MOUSE(2)-24)/24)*7)+(INT((MOUSE(1)+1)/80))-month.marg+2
  123.     IF d<1 OR d>days.in.month(mo) THEN
  124.       BEEP:GOTO wait.for.mouse
  125.     ELSE  
  126.       IF d=day THEN GOSUB post.day:GOTO main.menu
  127.       mark.day
  128.         day=d
  129.       mark.day
  130.       GOTO wait.for.mouse 
  131.     END IF  
  132.   END IF
  133.   'bottom menu items
  134.   IF MOUSE(2)>185 OR MOUSE(2)<175 THEN BEEP GOTO wait.for.mouse
  135.   IF MOUSE(1)<56 THEN GOSUB last.:GOTO main.menu
  136.   IF MOUSE(1)<108 THEN GOSUB switch:GOTO main.menu
  137.   IF MOUSE(1)<168 THEN GOSUB next.:GOTO main.menu
  138.   IF MOUSE(1)<272 THEN GOSUB restore.:GOTO main.menu
  139.   IF MOUSE(1)<300 THEN GOSUB jump:GOTO main.menu
  140.   IF MOUSE(1)<396 THEN GOSUB update:GOTO main.menu
  141.   IF MOUSE(1)<456 THEN GOSUB remind
  142.   IF MOUSE(1)<516 THEN GOSUB diary
  143.   CLOSE:SCREEN CLOSE 1:WINDOW 1:CLS:PRINT"Have a Nice Day"
  144.   PRINT"type `SYSTEM' to exit AmigaBasic
  145. END
  146. switch: LOCATE 23,9:COLOR 4,1
  147.   IF sw.type THEN 
  148.    sw.type=0
  149.    PRINT"MONTH"; 
  150.   ELSE 
  151.    sw.type=1
  152.    PRINT"YEAR ";
  153.   END IF
  154.  stay.here: IF MOUSE(0)<0 THEN stay.here
  155.   RETURN wait.for.mouse
  156. next.:
  157.   IF sw.type=0 THEN
  158.     IF mo=12 THEN:mo=1:year=year+1:year$=MID$(STR$(year),2) :ELSE mo=mo+1  
  159.   ELSE
  160.     year=year+1
  161.     year$=MID$(STR$(year),2)
  162.   END IF
  163.   GOTO new.screen
  164.  
  165. restore.:
  166.   IF year$=RIGHT$(DATE$,4) AND mo=VAL(LEFT$(DATE$,2)) THEN
  167.     IF day=VAL(MID$(DATE$,4,2)) THEN RETURN
  168.       mark.day
  169.       day=VAL(MID$(DATE$,4,2))
  170.       mark.day
  171.       RETURN
  172.   END IF
  173.     get.current.date
  174.     GOTO new.screen
  175.  
  176. jump: WINDOW 3,"Type in Date (MO/DY/YEAR)",(40,150)-(280,160),0,1
  177.  again: 
  178.    LOCATE 1,15:LINE INPUT; d$
  179.      m=VAL(LEFT$(d$,2)):d=VAL(MID$(d$,4,2))
  180.      y$=MID$(d$,7):y=VAL(y$)
  181.    IF m<1 OR m>12 OR y<1 OR d<1 OR d>days.in.month(mo) THEN again:
  182.    IF y=year AND m=mo THEN
  183.      IF d=day THEN WINDOW CLOSE 3:RETURN main.menu         
  184.      mark.day
  185.      day=d
  186.      mark.day
  187.      WINDOW CLOSE 3:RETURN main.menu
  188.    END IF  
  189.    WINDOW CLOSE 3
  190.    day=d:mo=m:year=y:year$=y$
  191.    GOTO new.screen
  192. last.:
  193.   IF sw.type=0 THEN
  194.     IF mo=1 THEN:mo=12:year=year-1:year$=MID$(STR$(year),2) :ELSE mo=mo-1    
  195.   ELSE
  196.     year=year-1
  197.     year$=MID$(STR$(year),2) 
  198.   END IF
  199. new.screen:
  200.   clear.screen
  201.    draw.lines
  202.     put.date
  203.      find.buffers
  204.       fill.in.numbers
  205.        put.day.symbols
  206.         mark.day
  207.   RETURN
  208. SUB get.current.date STATIC
  209.  SHARED mo,day,year$,year
  210.   mo=VAL(LEFT$(DATE$,2)):day=VAL(MID$(DATE$,4,2))
  211.   year$=RIGHT$(DATE$,4):year=VAL(year$)
  212.   END SUB
  213. SUB mark.day STATIC
  214. SHARED month.marg,day
  215.   WINDOW OUTPUT 2
  216.   v=INT((day+month.marg-2)/7)
  217.   h=((day-2+month.marg) MOD 7)
  218.   LOCATE v*3+4,h*10+2
  219.   c1=POINT(h*80+16,v*24+24)
  220.   c2=POINT(h*80+12,v*24+24)
  221.   COLOR c1,c2:PRINT MID$(STR$(day)+" ",2,2) 
  222.   END SUB
  223. SUB put.day.symbols STATIC
  224.  SHARED mo,days.in.month(),code$(),month.marg,symbol()
  225.   FOR x=1 TO days.in.month(mo)
  226.     IF MID$(code$(mo),x,1)<>CHR$(0) THEN
  227.       s=1:z=1:code=ASC(MID$(code$(mo),x,1))
  228.       FOR y=1 TO 5
  229.         IF code AND z THEN
  230.           IF y=5 THEN
  231.             v=INT((x+month.marg-2)/7)
  232.             h=((x-2+month.marg) MOD 7)
  233.             LOCATE v*3+4,h*10+2
  234.             COLOR 4,1:PRINT MID$(STR$(x)+" ",2,2) 
  235.           ELSE
  236.             v=INT((x+month.marg-2)/7)*24+31
  237.             h=((x-2+month.marg) MOD 7)*80+s
  238.             LINE(h,v)-(h+18,v+15),0,bf
  239.             PUT(h,v),symbol(0,y)
  240.             s=s+20
  241.           END IF
  242.         END IF
  243.         z=z*2
  244.       NEXT y      
  245.     END IF
  246.   NEXT x
  247.   END SUB
  248. SUB clear.screen STATIC
  249.   LINE(0,23)-(160,167),1,bf
  250.   LINE(166,0)-(412,15),1,bf
  251.   LINE(161,23)-(560,143),1,bf
  252.   END SUB
  253. SUB draw.lines STATIC
  254.   FOR x=0 TO 560 STEP 80
  255.     LINE (x,14)-(x,167),4
  256.   NEXT x
  257.   FOR x=23 TO 167 STEP 24
  258.     LINE (0,x)-(559,x),4
  259.   NEXT x
  260.   END SUB  
  261. SUB fill.in.numbers STATIC  
  262.  SHARED mo,month.marg,days.in.month()
  263.   d=month.marg:y=4
  264.   IF month.marg=1 THEN COLOR 4,1 :ELSE COLOR 2,1
  265.   FOR x=1 TO days.in.month(mo)
  266.     IF d=2 THEN COLOR 2,1
  267.     LOCATE y,(d-1)*10+2:PRINT MID$(STR$(x),2)
  268.     d=d+1:IF d=8 THEN y=y+3:COLOR 4,1:d=1
  269.   NEXT x
  270.   END SUB
  271.  
  272. SUB find.buffers STATIC
  273.  SHARED total.d,mo,year,days.in.month()
  274.  SHARED yearbuf(),leap.buf,month.marg
  275.  total.d=0
  276.   IF mo=1 THEN skip1
  277.   IF year/4=INT(year/4) THEN
  278.     days.in.month(2)=29:leap.buf=0
  279.   ELSE
  280.     days.in.month(2)=28:leap.buf=1
  281.   END IF
  282.   FOR x=1 TO mo-1
  283.     total.d=total.d + days.in.month(x)
  284.   NEXT x
  285.  skip1:
  286.   month.marg=total.d-(INT(total.d/7)*7)+yearbuf(year MOD 28)
  287.   IF month.marg>7 THEN month.marg=month.marg-7    
  288.   END SUB
  289. SUB put.date STATIC  
  290.  SHARED month$(),year$
  291.  SHARED mo,char(),num() 
  292.   LINE(166,0)-(LEN(month$(mo))*16+165,15),0,bf
  293.  FOR x=1 TO LEN(month$(mo))
  294.   c=ASC(MID$(month$(mo),x,1))-64
  295.   PUT (x*16+150,0),char(0,c)
  296.  NEXT x
  297.   LINE(326,0)-(LEN(year$)*16+325,15),0,bf
  298.  FOR x=1 TO LEN(year$)
  299.   n=ASC(MID$(year$,x,1))-47
  300.   IF n<1 OR n>10 THEN skip5
  301.   PUT (310+(x*16),0),num(0,n)
  302.  skip5:
  303.  NEXT x      
  304.  END SUB      
  305.    
  306. post.day: no.input=1
  307.   d$= month$(mo)+STR$(day)+","+year$+"   Calendar Input Screen"
  308.   WINDOW 3,d$,(0,0)-(564,186),0,1
  309.   COLOR 2,3:CLS
  310.     LINE(284,0)-(284,186),2:LINE(0,71)-(564,71),2
  311.     LINE(0,143)-(564,143),2
  312.   put.bold.char "BIRTHDAYS",66,0
  313.   put.bold.char "BILLS",384,0
  314.   put.bold.char "MEETINGS",78,72
  315.   put.bold.char "NOTES",384,72
  316.   put.bold.char "HOLIDAY",86,144
  317.   put.bold.char "EXIT",392,144
  318.    LOCATE 3,4:PRINT "Name";TAB(28);"Year";TAB(38);"Pay To";TAB(58);"Amount"
  319.    LOCATE 12,3:PRINT"What?";TAB(15);"Where?";TAB(27);"When?"
  320.    LOCATE 21,6:PRINT"Name";TAB(22);"Permanent?"; 
  321.   rec=total.d+day
  322.   IF rec> 59 THEN rec=rec+leap.buf
  323.   GOSUB get.data 
  324.   COLOR 0,3
  325.  put.on.screen:  ERASE Lo:DIM Lo(6,5)
  326.     FOR x=1 TO 10
  327.       IF s(x)>0 THEN
  328.         ON s(x) GOSUB p.birth,p.bill,p.meet,p.note,p.holi
  329.       ELSE
  330.         f$(x)=SPACE$(30)
  331.       END IF
  332.     NEXT x
  333.  day.menu:
  334.   LOCATE 23,45:COLOR 2,4:PRINT"MAKE A SELECTION";  
  335.   repeat:
  336.    IF MOUSE(0)>-1 THEN SLEEP:GOTO repeat
  337.      LOCATE 23,45:COLOR 0,3:PRINT SPACE$(16);  
  338.    IF MOUSE(1)<284 AND MOUSE(2)<72 THEN GOSUB i.birth
  339.    IF MOUSE(1)>283 AND MOUSE(2)<72 THEN GOSUB i.bill
  340.    IF MOUSE(1)<284 AND MOUSE(2)>143 THEN GOSUB i.holiday
  341.    IF MOUSE(1)>283 AND MOUSE(2)>143 THEN exit.input
  342.    IF MOUSE(1)<284 THEN GOSUB i.meet
  343.    IF MOUSE(1)>283 THEN GOSUB i.note
  344.   end.of.menu: 
  345.    IF flag=1 THEN 
  346.    ON t GOSUB clear1,clear2,clear3,clear4,clear5
  347.     FOR x=1 TO 10
  348.       IF s(x)=t THEN
  349.         ON s(x) GOSUB p.birth,p.bill,p.meet,p.note,p.holi
  350.       END IF
  351.     NEXT x
  352.    END IF
  353.      flag=0
  354.    GOTO day.menu    
  355.  
  356. SUB put.bold.char (word$,topx,topy) STATIC
  357.  SHARED char()
  358.   FOR x=0 TO LEN(word$)-1
  359.     c=ASC(MID$(word$,x+1,1))-64
  360.     PUT (x*16+topx,topy),char(0,c)
  361.   NEXT x
  362.   END SUB
  363.  
  364.  i.holiday:              
  365.    IF Lo(5,0)=0 THEN 
  366.      find.next.open next.o  
  367.      IF flag=2 THEN RETURN end.of.menu
  368.      n=next.o:flag=3:input.data 5,22,1,1,27,1,n
  369.    ELSE 
  370.      n=Lo(5,1)
  371.      input.data 5,22,1,1,27,1,n
  372.    END IF
  373.    IF flag=1 THEN RETURN end.of.menu
  374.   input.again: 
  375.    LOCATE 22,28:PRINT"y/n";:a$=INPUT$(1)
  376.    IF UCASE$(a$)="Y" THEN 
  377.      MID$(f$(n),28)="YES"
  378.    ELSEIF UCASE$(a$)="N" THEN 
  379.      MID$(f$(n),28)="NO "
  380.    ELSE
  381.      GOTO input.again:
  382.    END IF
  383.    LOCATE 22,28:PRINT RIGHT$(f$(n),3)+"   "
  384.    RETURN end.of.menu
  385.  i.birth:
  386.      IF MOUSE(2)>23 AND MOUSE(2)<Lo(1,0)*8+23 THEN 'edit
  387.        p=INT(MOUSE(2)/8)-2
  388.        IF MOUSE(1)<204 THEN input.data 1,3+p,1,1,26,p,Lo(1,p) :ELSE input.data 1,3+p,28,27,4,p,Lo(1,p)
  389.      ELSE 
  390.        find.next.open next.o
  391.        IF flag<>2 THEN
  392.          input.data 1,Lo(1,0)+4,1,1,26,Lo(1,0)+1,next.o
  393.        IF flag=1 THEN RETURN end.of.menu
  394.          flag=3
  395.          input.data 1,Lo(1,0)+4,28,27,4,Lo(1,0)+1,next.o
  396.        END IF
  397.      END IF
  398.    RETURN end.of.menu     
  399.  i.bill:
  400.      IF MOUSE(2)>23 AND MOUSE(2)<Lo(2,0)*8+23 THEN 'edit
  401.        p=INT(MOUSE(2)/8)-2
  402.        IF MOUSE(1)<448 THEN input.data 2,3+p,37,1,20,p,Lo(2,p) :ELSE input.data 2,3+p,58,21,10,p,Lo(2,p)
  403.      ELSE 
  404.        find.next.open next.o
  405.        IF flag<>2 THEN
  406.          input.data 2,Lo(2,0)+4,37,1,20,Lo(2,0)+1,next.o
  407.          IF flag=1 THEN RETURN end.of.menu
  408.          flag=3
  409.         input.data 2,Lo(2,0)+4,58,21,10,Lo(2,0)+1,next.o
  410.        END IF
  411.      END IF
  412.    RETURN end.of.menu     
  413.  i.meet:
  414.      IF MOUSE(2)>95 AND MOUSE(2)<Lo(3,0)*8+95 THEN
  415.        p=INT(MOUSE(2)/8)-11
  416.        IF MOUSE(1)<99 THEN 
  417.          input.data 3,12+p,1,1,12,p,Lo(3,p)
  418.        ELSEIF MOUSE(1)<195 THEN
  419.          input.data 3,12+p,14,13,12,p,Lo(3,p)
  420.        ELSE
  421.          input.data 3,12+p,27,25,6,p,Lo(3,p)
  422.        END IF
  423.      ELSE 
  424.        find.next.open next.o
  425.        IF flag<>2 THEN 
  426.          input.data 3,Lo(3,0)+13,1,1,12,Lo(3,0)+1,next.o
  427.          IF flag=1 THEN RETURN end.of.menu
  428.          input.data 3,Lo(3,0)+13,14,13,12,Lo(3,0)+1,next.o
  429.          IF flag=1 THEN RETURN end.of.menu
  430.          flag=3
  431.          input.data 3,Lo(3,0)+13,27,25,6,Lo(3,0)+1,next.o
  432.        END IF
  433.      END IF
  434.    RETURN end.of.menu     
  435.  i.note:
  436.      IF MOUSE(2)>95 AND MOUSE(2)<Lo(4,0)*8+95 THEN 'edit
  437.        p=INT(MOUSE(2)/8)-11
  438.        input.data 4,12+p,37,1,30,p,Lo(4,p)
  439.      ELSE 
  440.        find.next.open next.o
  441.        IF flag<>2 THEN flag=3:input.data 4,Lo(4,0)+13,37,1,30,Lo(4,0)+1,next.o
  442.      END IF
  443.    RETURN end.of.menu     
  444. SUB input.data (type,px,py,fpos,length,tpos,no) STATIC
  445. SHARED s(),Lo(),f$(),flag,no.input,t
  446.   IF tpos>5 THEN BEEP:EXIT SUB
  447.   no.input=0:c=4:p=1:GOSUB putcursor
  448.   word$=MID$(f$(no),fpos,length)
  449.  getkey: a$=INKEY$
  450.    WHILE a$="":a$=INKEY$
  451.    IF MOUSE(0)<0 THEN exit.sub
  452.    WEND
  453.   IF a$<CHR$(127) AND a$>CHR$(31) THEN
  454.    IF p>length THEN BEEP:GOTO getkey
  455.     MID$(word$,p,1)=a$:LOCATE px,py:PRINT word$
  456.      p=p+1:c=4:GOSUB putcursor
  457.       GOTO getkey
  458.   END IF        
  459.   IF a$=CHR$(127) THEN
  460.     flag=1:s(no)=0:Lo(type,0)=0:t=type
  461.     f$(no)=STRING$(30,32)
  462.     EXIT SUB
  463.   END IF
  464.    IF a$=CHR$(13) THEN 
  465.    exit.sub:
  466.      MID$(f$(no),fpos,length)=word$
  467.      IF flag=3 THEN s(no)=type:Lo(type,tpos)=no:Lo(type,0)=Lo(type,0)+1
  468.      c=3:GOSUB putcursor
  469.      EXIT SUB
  470.    END IF          
  471.   IF a$=CHR$(8) THEN
  472.     IF p>1 THEN
  473.       IF p=>length THEN c=3:GOSUB putcursor
  474.       p=p-1
  475.       word$=LEFT$(word$,p-1)+MID$(word$,p+1)+" "
  476.       LOCATE px,py:PRINT word$
  477.       c=4:GOSUB putcursor:GOTO getkey
  478.     ELSE
  479.       BEEP:GOTO getkey
  480.     END IF
  481.   END IF
  482.    IF a$=CHR$(30) THEN
  483.      IF p>length THEN BEEP:GOTO getkey
  484.      c=3:GOSUB putcursor:p=p+1:c=4:GOSUB putcursor
  485.      GOTO getkey
  486.    END IF
  487.   IF a$=CHR$(31) THEN
  488.     IF p=1 THEN BEEP:GOTO getkey
  489.     c=3:GOSUB putcursor:p=p-1:c=4:GOSUB putcursor
  490.     GOTO getkey
  491.   END IF
  492.  BEEP:GOTO getkey
  493.   putcursor:
  494.     LINE((py+p-2)*8,(px-1)*8)-((py+p-2)*8,(px-1)*8+6),c
  495.     RETURN
  496.   END SUB
  497.  
  498. SUB find.next.open (n) STATIC
  499. SHARED flag,s()
  500.   FOR n=1 TO 10:IF s(n)=0 THEN EXIT SUB
  501.   NEXT n
  502.   BEEP:flag=2
  503.   END SUB
  504.   
  505. clear1: LINE (0,24)-(283,70),3,bf:RETURN
  506. clear2: LINE (285,24)-(564,70),3,bf:RETURN
  507. clear3: LINE (0,96)-(283,142),3,bf:RETURN
  508. clear4: LINE (285,96)-(564,142),3,bf:RETURN
  509. clear5: LINE (0,168)-(283,178),3,bf:RETURN
  510.   p.birth:
  511.     Lo(1,0)=Lo(1,0)+1:LOCATE Lo(1,0)+3,1
  512.     PRINT LEFT$(f$(x),25)" "RIGHT$(f$(x),5)
  513.     Lo(1,Lo(1,0))=x:RETURN
  514.   p.bill:    
  515.     Lo(2,0)=Lo(2,0)+1:LOCATE Lo(2,0)+3,37
  516.     PRINT LEFT$(f$(x),20)" "RIGHT$(f$(x),10)
  517.     Lo(2,Lo(2,0))=x:RETURN
  518.   p.meet:
  519.     Lo(3,0)=Lo(3,0)+1:LOCATE Lo(3,0)+12,1
  520.     PRINT LEFT$(f$(x),12)" "MID$(f$(x),13,12)" "RIGHT$(f$(x),6)
  521.     Lo(3,Lo(3,0))=x:RETURN
  522.   p.note:
  523.     Lo(4,0)=Lo(4,0)+1:LOCATE Lo(4,0)+12,37
  524.     PRINT f$(x)
  525.     Lo(4,Lo(4,0))=x:RETURN
  526.   p.holi: LOCATE 22,1
  527.     PRINT f$(x):Lo(5,0)=1:Lo(5,1)=x
  528.     RETURN
  529.  
  530.  exit.input: WINDOW CLOSE 3
  531.   IF no.input THEN skip6 
  532.    code=0:z=1:s=1
  533.      v=INT((day+month.marg-2)/7)*24+31
  534.      h=((day-2+month.marg) MOD 7)*80+1
  535.      LINE(h,v)-(h+78,v+15),1,bf
  536.    FOR y=1 TO 5
  537.      IF Lo(y,0) THEN 
  538.        code=code+z
  539.        IF y=5 THEN
  540.          calc.pos v,h
  541.          LOCATE v*3+4,h*10+2
  542.          COLOR 1,4:PRINT MID$(STR$(day)+" ",2,2) 
  543.        ELSE
  544.          calc.pos v,h
  545.          v=v*24+31
  546.          h=h*80+s
  547.          LINE(h,v)-(h+18,v+15),0,bf
  548.          PUT(h,v),symbol(0,y)
  549.          s=s+20
  550.        END IF
  551.      ELSEIF y=5 AND h>1 THEN
  552.        calc.pos v,h
  553.        LOCATE v*3+4,h*10+2
  554.        COLOR 1,2:PRINT MID$(STR$(day)+" ",2,2) 
  555.      ELSEIF y=5 AND h<2 THEN
  556.        calc.pos v,h
  557.        LOCATE v*3+4,2
  558.        COLOR 1,4:PRINT MID$(STR$(day)+" ",2,2) 
  559.      END IF
  560.      z=z*2
  561.    NEXT y 
  562.    MID$(code$(mo),day,1)=CHR$(code)
  563.    LSET cod$=code$(mo):PUT #4,mo
  564.    GOSUB set.data:PUT 1,rec
  565.   skip6: 
  566.    RETURN main.menu
  567. SUB calc.pos (v,h) STATIC
  568. SHARED day,month.marg
  569.   v=INT((day+month.marg-2)/7)
  570.   h=((day-2+month.marg) MOD 7)
  571.   END SUB
  572.      
  573. update: GOSUB restore.
  574.   d$= month$(mo)+STR$(day)+","+year$+"   UPDATE LAST 30 DAYS"  
  575.   WINDOW 3,d$,(16,70)-(544,126),0,1
  576.   COLOR 7,2:CLS
  577.   d=day:m=mo:y=year:rec=total.d+d
  578.   marg=month.marg+day-1:p=0:flag=0
  579.   IF rec>59 THEN rec=rec+leap.buf
  580.   FOR x=30 TO 0 STEP -1 
  581.     IF rec=60 THEN rec=rec-leap.buf
  582.     IF d=0 THEN
  583.       m=m-1
  584.       IF m=0 THEN m=12:y=y-1:rec=366
  585.       d=days.in.month(m)
  586.     END IF  
  587.     IF ASC(MID$(code$(m),d,1))>1 THEN 
  588.       GOSUB get.data
  589.       dat$=month$(m)+STR$(d)+","+STR$(year)
  590.       FOR z=1 TO 10
  591.         IF s(z)>1 THEN
  592.           nam$=f$(z)
  593.           flag=1:CLS
  594.           ON s(z)-1 GOSUB u.bill,u.meet,u.note,u.holiday
  595.         END IF
  596.       NEXT z
  597.     END IF
  598.     IF w.flag THEN 
  599.       w.flag=0:code=0
  600.       ERASE f:DIM f(5)
  601.       FOR z=1 TO 10:IF s(z) THEN f(s(z))=1
  602.       NEXT z
  603.       GOSUB set.data
  604.       v=1:FOR f=1 TO 5:code=code+(v*f(f)):v=v*2:NEXT f
  605.       MID$(code$(m),d,1)=CHR$(code)
  606.       LSET cod$=code$(m):PUT #4,m
  607.     END IF
  608.     d=d-1:rec=rec-1
  609.   NEXT x :IF flag=0 THEN PRINT"Everything Was Up To Date" :ELSE flag=0
  610.   FOR x=1 TO 7000:NEXT x
  611.   WINDOW CLOSE 3
  612.  GOTO new.screen 
  613. u.bill: GOSUB head.1:GOSUB print.1
  614.   PRINT"Did You Pay This Bill ? (y/n)";
  615.   get.answer:
  616.   a$=UCASE$(INPUT$(1))
  617.   IF a$="Y" THEN w.flag=1:s(z)=0:f$(z)="":RETURN
  618.   IF a$="N" THEN RETURN
  619.   LOCATE 4,1:PRINT"COME ON NOW, GIVE ME A STRAIGHT ANSWER !!
  620.   GOTO get.answer
  621. u.meet: PRINT"Deleting Meeting . . . "
  622.   GOSUB print.2:w.flag=1:s(z)=0:f$(z)=""
  623.   FOR pause=0 TO 5000:NEXT pause
  624.   RETURN
  625. u.note: PRINT dat$
  626.   PRINT "Did You ... ";f$(z);"? (y/n)"
  627.   a$=UCASE$(INPUT$(1))
  628.   IF a$="Y" THEN w.flag=1:s(z)=0:f$(z)="":RETURN
  629.   IF a$="N" THEN RETURN
  630.   LOCATE 4,1:PRINT"I HOPE YOU DID IT BETTER THAN YOU ARE PRESSING KEYS ... TRY AGAIN"
  631.   GOTO get.answer
  632. u.holiday:
  633.   IF RIGHT$(f$(z),3)="YES" THEN RETURN
  634.   PRINT"Deleting Holiday . . .":PRINT dat$
  635.   PRINT LEFT$(f$(z),27):s(z)=0:f$(z)="":w.flag=1    
  636.   FOR pause=0 TO 7000:NEXT pause
  637.   RETURN
  638.  
  639. remind: GOSUB restore.
  640.   d$= month$(mo)+STR$(day)+","+year$+"   REMINDERS FOR THE NEXT 30 DAYS"
  641.   WINDOW 3,d$,(0,0)-(504,186),0,1
  642.   COLOR 0,7:CLS
  643.   put.bold.char "BIRTHDAYS",172,0
  644.   PUT (136,0),symbol(0,1)
  645.   PUT (336,0),symbol(0,1)
  646.    LOCATE 3,4:PRINT "Name":LOCATE 3,28:PRINT"Day Name"
  647.    LOCATE 3,39:PRINT"Date":LOCATE 3,57:PRINT"Born"
  648.   d=day:m=mo:y=year:rec=total.d+d
  649.   marg=month.marg+day-1:p=0:flag=0
  650.   IF rec>59 THEN rec=rec+leap.buf
  651. OPEN "ram:temp" AS 5 LEN=58
  652. FIELD 5, 30 AS nam$,1 AS type$,27 AS dat$
  653.   FOR x=0 TO 30  
  654.     IF rec=60 THEN rec=rec+leap.buf
  655.     IF d>days.in.month(m) THEN d=1:m=m+1
  656.     IF m>12 THEN m=1:y=y+1:rec=1
  657.     IF ASC(MID$(code$(m),d,1))>0 THEN 
  658.       GOSUB get.data 
  659.        FOR z=1 TO 10
  660.         IF s(z)>0 THEN
  661.           IF s(z)=1 THEN
  662.             flag=1
  663.             PRINT LEFT$(f$(z),26)" ";
  664.             PRINT day.name$(((marg+x-1) MOD 7)+1)" ";
  665.             PRINT USING"\                 \";month$(m)+STR$(d)+","+STR$(year);
  666.             PRINT RIGHT$(f$(z),4)
  667.             p=p+1:IF p>18 THEN wait.for.key:p=0:CLS
  668.           ELSE
  669.             LSET nam$=f$(z):LSET type$=CHR$(s(z)) 
  670.             IF x=0 THEN
  671.               LSET dat$="TODAY"
  672.             ELSEIF x=1 THEN
  673.               LSET dat$="TOMORROW"
  674.             ELSE              
  675.               LSET dat$=day.name$(((marg+x-1) MOD 7)+1)+" "+month$(m)+STR$(d)+","+STR$(year)
  676.             END IF
  677.             PUT 5
  678.           END IF
  679.         END IF
  680.       NEXT z
  681.     END IF
  682.     d=d+1:rec=rec+1
  683.   NEXT x :IF flag=0 THEN PRINT"None Recorded" :ELSE flag=0
  684.   wait.for.key
  685. FOR x=2 TO 5
  686.  CLS:p=0:total#=0 
  687.   ON x-1 GOSUB head.1,head.2,head.3,head.4
  688.   IF x<>5 THEN PUT (136,0),symbol(0,x):PUT (336,0),symbol(0,x)
  689.   FOR r=1 TO LOF(5)/58
  690.     GET 5,r
  691.     IF x=ASC(type$) THEN
  692.       flag=1
  693.       p=p+1:IF p=19 THEN wait.for.key:p=0:CLS
  694.       ON x-1 GOSUB print.1,print.2,print.3,print.4
  695.     END IF  
  696.   NEXT r
  697.   IF flag=0 THEN
  698.     PRINT"None Recorded"
  699.   ELSE
  700.     flag=0
  701.     IF x=2 THEN PRINT USING"Total Bills Due $$#######.##";total#
  702.   END IF
  703.   wait.for.key
  704. NEXT x  
  705. CLOSE 5:KILL"ram:temp"
  706. WINDOW CLOSE 3:RETURN main.menu
  707.  
  708. head.1: put.bold.char "BILLS",204,0
  709.  LOCATE 3,4:PRINT"Pay To";TAB(28);"Amount";TAB(47);"Due Date"
  710.  RETURN
  711. print.1: PRINT LEFT$(nam$,20)" ";
  712.   PRINT USING"$$#######.## ";VAL(RIGHT$(nam$,10));
  713.     PRINT dat$
  714.     total#=total#+VAL(RIGHT$(nam$,10))
  715.     RETURN
  716. head.2: put.bold.char "MEETINGS",188,0
  717.  LOCATE 3,4:PRINT"What ?";TAB(16);"Where ?";TAB(37);"When ?"
  718.  RETURN
  719. print.2:  PRINT LEFT$(nam$,12)" ";
  720.   PRINT MID$(nam$,13,12)" ";:PRINT RIGHT$(nam$,6);
  721.     PRINT dat$
  722.     RETURN
  723. head.3: put.bold.char "NOTES",204,0
  724.  LOCATE 3,4:PRINT"Don't Forget to .......";;TAB(36);"Date"
  725.   RETURN
  726. print.3: PRINT nam$;dat$:RETURN
  727.  
  728. head.4: put.bold.char "HOLIDAYS",188,0
  729.  LOCATE 3,19:PRINT"Permanent ?"
  730.   RETURN
  731. print.4: PRINT nam$;dat$:RETURN
  732.  
  733. diary: WINDOW 3,"D I A R Y",(0,0)-(564,186),0,1
  734.   COLOR 1,6:CLS
  735. PATTERN &Hffff,cov.pat
  736.   COLOR 2,5:LINE (180,20)-(520,150),2,bf
  737. PATTERN &Hffff,r.edge.pat:COLOR 1,6
  738.   COLOR 1,7:AREA(522,25):AREA(540,41):AREA(540,165)
  739.   AREA(522,150):AREAFILL
  740. PATTERN &Hffff,b.edge.pat
  741.   AREA(522,151):AREA(537,163):AREA(198,163)
  742.   AREA(182,151):AREAFILL
  743.   LINE (536,38)-(539,38),2:LINE (180,20)-(520,150),2,b
  744.   LINE(540,38)-(541,164),2,b:LINE(200,164)-(541,164),2  
  745.   LINE(200,164)-(180,150),2:LINE(199,164)-(179,150),2
  746.   LINE(179,20)-(179,150),2:LINE(519,20)-(519,150),2
  747. put.bold.char "DIARY",274,50
  748. put.bold.num 370,50
  749. diary.date$="      "+day.name$(((month.marg+day-2) MOD 7)+1)+" "+month$(mo)+STR$(day)+","+year$+"          "
  750. t.code$=CHR$(mo)+CHR$(day)
  751. OPEN "diary.data"+year$ AS 5 LEN=520
  752.   FIELD 5,520 AS d.dat$
  753. OPEN "diary.index"+year$ AS 6 LEN=2
  754.  FIELD 6,2 AS f.code$
  755.   IF LOF(6)<2 THEN
  756.     i.rec=1
  757.     FOR x=1 TO 13:a$(x)=STRING$(40,32):NEXT x
  758.     GOTO open.book
  759.   END IF   
  760. FOR i.rec=1 TO LOF(6)/2:GET 6
  761.   IF f.code$=t.code$ THEN
  762.     GET 5,i.rec
  763.     FOR x=0 TO 12:a$(x+1)=MID$(d.dat$,x*40+1,40):NEXT x
  764.     GOTO open.book
  765.   END IF
  766. NEXT i.rec: FOR x=1 TO 13:a$(x)=STRING$(40,32):NEXT x  
  767. open.book: PATTERN &Hffff,cov.pat
  768.    y!=20:x2=0:c=0:y1=16:p=42
  769.   FOR x=508 TO 180 STEP-8
  770.    y!=y!-4:y2=y!+130
  771.    IF y!<1 THEN y1=0::x2=x-yb(c):c=c+1 :ELSE y1=CINT(y!):x2=x
  772.    IF y2<21 THEN y3=21 :ELSE y3=y2
  773.    IF y2<0 THEN y2=0
  774.     COLOR 2,5
  775.     AREA(x,y1):AREA(x,y2):AREA (180,150)
  776.     AREA(180,20):AREA(x2,y1):AREAFILL    
  777.    COLOR 1,1
  778.     AREA(x+1,y3):AREA(180,150):AREA(x+12,150)
  779.     AREA(x+12,24):AREA(x+1,24):AREAFILL
  780.    COLOR 6,6
  781.     AREA (x,y1):AREA(x,23):AREA(520,23):AREA(520,0)
  782.     AREAFILL 
  783.    IF p<41 AND p>0 THEN
  784.      COLOR 5,1
  785.      LOCATE 4,p+24:PRINT MID$(diary.date$,p,2);
  786.      COLOR 0,1:LOCATE 6,1
  787.      FOR dp=1 TO 13
  788.        PRINT TAB(p+23);MID$(a$(dp),p,1)
  789.      NEXT dp  
  790.    END IF
  791.    p=p-1
  792.   NEXT x  :c=36
  793.  FOR x=172 TO 8 STEP -8
  794.    y!=y!+4:y2=y!+130
  795.    IF y1<1 THEN y1=0::x2=x+yb(c)+10:c=c-1 :ELSE y1=CINT(y!):x2=x
  796.    IF y2<21 THEN y3=21 :ELSE y3=y2
  797.    IF y2<0 THEN y2=0
  798.     COLOR 2,4
  799.     AREA(x,y1):AREA(x,y2):AREA (180,152)
  800.     AREA(180,20):AREA(x2,y1):AREAFILL
  801.    COLOR 6,6
  802.     AREA (180,20):AREA(180,0):AREA(x2,0)
  803.     AREAFILL   
  804.    FOR pause=0 TO 200:NEXT pause
  805.  NEXT x
  806.  LINE(x+7,y1)-(x+7,y2),2:LINE-(180,152),2
  807.  LINE-(180,20),2:LINE-(x2,y1),2:LINE-(x+7,y1),2   
  808. put.bold.char "EXIT",232,170
  809. COLOR 0,1
  810. flag=0
  811. get.d.text 13,6,24,40,a$(),4,1
  812. IF flag=1 THEN
  813.  LSET f.code$=t.code$
  814.  PUT 6, i.rec
  815.   a$="":FOR x=1 TO 13:a$=a$+a$(x):NEXT x
  816.   LSET d.dat$=a$
  817.   PUT 5,i.rec
  818. END IF
  819. CLOSE 5:CLOSE 6:WINDOW CLOSE 3
  820. RETURN main.menu
  821. END
  822.  
  823. SUB put.bold.num (topx,topy) STATIC
  824.  SHARED num(),year$
  825.  FOR x=1 TO LEN(year$)
  826.   n=ASC(MID$(year$,x,1))-47
  827.   IF n<1 OR n>10 THEN skip8
  828.   PUT ((topx-16)+(x*16),topy),num(0,n)
  829.   skip8:
  830.  NEXT x
  831.   END SUB
  832.  
  833. SUB wait.for.key STATIC
  834.  SHARED how()
  835.  LOCATE 23,20:PRINT"PRESS ANY KEY OR MOUSE TO CONTINUE";
  836.  keep.waiting:
  837.   a$=INKEY$:IF a$="" AND MOUSE(0)>-1 THEN SLEEP:GOTO keep.waiting
  838.   LOCATE 23,20:PRINT SPACE$(25);
  839.   END SUB
  840. get.data:  GET 1,rec                          
  841.   FOR r=1 TO 10
  842.     f$(r)=MID$(c.dat$,r*30-29,30)
  843.     s(r)=ASC(MID$(s.nam$,r,1))
  844.   NEXT r
  845.   RETURN
  846. set.data: c$="":s$=""
  847.   FOR r=1 TO 10
  848.     c$=c$+f$(r):s$=s$+CHR$(s(r))
  849.   NEXT r  
  850.   LSET c.dat$=c$:LSET s.nam$=s$
  851.   PUT 1,rec
  852.   RETURN
  853.  
  854. SUB get.d.text(lines,topx,topy,wide,a$(),cur,bc) STATIC
  855. SHARED flag
  856. l=1:p=1:c=cur
  857. GOSUB putcur  
  858. getk:
  859.   IF MOUSE(0)<0 THEN
  860.     IF MOUSE(2)<(topx+lines-1)*8 AND MOUSE(2)>(topx-1)*8 AND MOUSE(1)>(topy-1)*8 AND MOUSE(1)<(topy+wide)*8 THEN
  861.       c=bc:GOSUB putcur:c=cur
  862.       p=INT(MOUSE(1)/8)-topy+2
  863.       l=INT(MOUSE(2)/8)-topx+2
  864.       GOSUB putcur
  865.     ELSEIF MOUSE(2)>170 AND MOUSE(2)<186 AND MOUSE(1)>232 AND MOUSE(1)<296 THEN
  866.       EXIT SUB
  867.     ELSE
  868.       BEEP
  869.     END IF
  870.   END IF         
  871.   a$=INKEY$
  872.   IF a$="" THEN SLEEP:GOTO getk
  873.   IF a$=CHR$(13) THEN 
  874.     IF l=lines THEN BEEP:GOTO getk
  875.     c=bc:GOSUB putcur:c=cur
  876.     p=1:l=l+1:GOTO 100
  877.   END IF   
  878.   IF a$=CHR$(8) THEN 
  879.     IF p>1 THEN 
  880.       c=bc:GOSUB putcur:c=cur 
  881.       p=p-1
  882.       a$(l)=LEFT$(a$(l),p-1)+MID$(a$(l),p+1)+" "
  883.       LOCATE topx+l-1,topy
  884.       PRINT a$(l)
  885.       GOTO 100
  886.     ELSEIF l<>1 THEN
  887.       c=bc:GOSUB putcur:c=cur:l=l-1:p=wide
  888.       a$(l)=LEFT$(a$(l),wide-1)+" "
  889.       LOCATE topx+l-1,topy
  890.       PRINT a$(l)
  891.       GOTO 100      
  892.     ELSE 
  893.       BEEP:GOTO getk
  894.     END IF
  895.   END IF   
  896.   ON INSTR(CHR$(28)+CHR$(29)+CHR$(30)+CHR$(31),a$)GOTO up,down,right,left 
  897.   IF p>wide THEN
  898.     IF l=lines THEN BEEP:GOTO getk 
  899.       c=bc:GOSUB putcur:c=cur:GOSUB find.last.32
  900.     IF ls<40 AND a$<>CHR$(32) THEN
  901.       c=bc:GOSUB putcur:c=cur
  902.       chop$=RIGHT$(a$(l),wide-ls)
  903.       a$(l)=LEFT$(a$(l),ls)+SPACE$(wide-ls)
  904.       LOCATE topx+l-1,topy:PRINT a$(l)
  905.       l=l+1:p=LEN(chop$)+1
  906.       a$(l)=chop$+LEFT$(a$(l),wide-LEN(chop$))
  907.       LOCATE topx+l-1,topy:PRINT a$(l)
  908.     ELSE
  909.       l=l+1:p=1
  910.     END IF
  911.   END IF  
  912.     flag=1
  913.     MID$(a$(l),p,1)=a$
  914.     LOCATE topx+l-1,topy+p-1
  915.     PRINT a$;
  916.     p=p+1   
  917. 100 :
  918.   GOSUB putcur  
  919.   GOTO getk
  920. up:
  921.   IF l=1 THEN BEEP:GOTO getk
  922.   c=bc:GOSUB putcur:c=cur
  923.   l=l-1:GOTO 100
  924. down:
  925.   IF l=lines THEN BEEP:GOTO getk
  926.   c=bc:GOSUB putcur:c=cur
  927.   l=l+1:GOTO 100  
  928. right:
  929.   IF p>wide THEN
  930.     IF l=lines THEN BEEP:GOTO getk
  931.     c=bc:GOSUB putcur:c=cur:l=l+1:p=1:GOTO 100
  932.    END IF 
  933.   c=bc:GOSUB putcur:c=cur
  934.   p=p+1:GOTO 100
  935. left:
  936.   IF p=1 THEN 
  937.    IF l=1 THEN BEEP:GOTO getk
  938.    c=bc:GOSUB putcur:c=cur:l=l-1:p=wide:GOTO 100
  939.   END IF 
  940.   c=bc:GOSUB putcur:c=cur
  941.   p=p-1:GOTO 100
  942. putcur:
  943.   LINE((topy+p-2)*8,(topx+l-2)*8)-((topy+p-2)*8,(topx+l-2)*8+6),c
  944.   RETURN
  945. find.last.32: ps=0
  946.   find: ls=ps:ps=INSTR(ps+1,a$(l)," ")
  947.   IF ps=0 THEN RETURN
  948.   GOTO find    
  949. END SUB
  950.  
  951. payment.scedule: GOSUB restore.
  952.   WINDOW 3,"Payment Scedules",(120,0)-(496,186),0,1
  953.   COLOR 1,7:CLS
  954.    LOCATE 1,34:PRINT"LAST PAYMENT"
  955.     LOCATE 2,1:PRINT"      PAY TO          AMOUNT   DAY (MO/YEAR)"
  956.     np$=STRING$(18,"0")
  957.   OPEN "pay.scedule" AS 5 LEN=39
  958.    FIELD 5, 20 AS pay.to$,10 AS amt$,2 AS day$,7 AS lp$
  959.     IF LOF(5)=0 THEN
  960.       LSET pay.to$=STRING$(20,32):LSET amt$=STRING$(10,32)
  961.       LSET day$="  ":LSET lp$="       "
  962.       FOR x=1 TO 18:PUT 5:NEXT x
  963.       GOTO pay.menu
  964.     END IF
  965.   LOCATE 3,1:COLOR 2,7
  966.   FOR x=1 TO 18:GET 5
  967.     PRINT pay.to$" "amt$" "day$"  "lp$
  968.     IF day$="  " THEN MID$(np$,x,1)="0" :ELSE MID$(np$,x,1)="1"
  969.   NEXT x 
  970.   put.bold.char "EXIT",168,170
  971.  pay.menu:
  972.    LOCATE 1,10:COLOR 0,5:PRINT"MAKE A SELECTION";
  973.  repeat2:
  974.    IF MOUSE(0)>-1 THEN repeat2
  975.    LOCATE 1,10:COLOR 2,7:PRINT SPACE$(16);
  976.    IF MOUSE(1)<352 AND MOUSE(1)>0 THEN
  977.      IF MOUSE(2)>16 THEN IF MID$(np$,INT(MOUSE(2)/8)-1,1)="1" THEN GOSUB ps.edit
  978.    END IF
  979.    IF MOUSE(2)>170 AND MOUSE(1)>168 AND MOUSE(1)<232 THEN GOTO ps.exit
  980.    GOSUB ps.input
  981.  ps.input:  px=INSTR(np$,"0"):h=px+2
  982.    IF px=0 THEN BEEP:RETURN pay.menu
  983.    a$(1)=STRING$(20,32)
  984.    input.ps h,1,20,a$(1)  'name
  985.      IF flag=1 THEN MID$(np$,px,1)="0":RETURN pay.menu
  986.    a$(2)=STRING$(10,32)
  987.    input.ps h,22,10,a$(2) 'amount
  988.      IF flag=1 THEN MID$(np$,px,1)="0":RETURN pay.menu
  989.   day.again: 
  990.    a$(3)=STRING$(2,32)
  991.    input.ps h,33,2,a$(3)  'day
  992.      IF flag=1 THEN MID$(np$,px,1)="0":RETURN pay.menu
  993.      d=VAL(a$(3))
  994.      IF d>28 OR d<1 THEN BEEP:GOTO day.again
  995.   mo.year.again: 
  996.    a$(4)=STRING$(7,32)
  997.    input.ps h,37,7,a$(4)  'mo/year
  998.      IF flag=1 THEN MID$(np$,px,1)="0":RETURN pay.menu
  999.      m=VAL(LEFT$(a$(4),2))
  1000.      IF m>12 OR m<1 THEN BEEP:GOTO mo.year.again
  1001.    put.in.file:
  1002.     LSET pay.to$=a$(1):LSET amt$=a$(2)
  1003.     LSET day$=a$(3):LSET lp$=a$(4):PUT 5,px
  1004.     MID$(np$,px,1)="1"
  1005.     RETURN pay.menu
  1006.  ps.edit: px=INT(MOUSE(2)/8)+1:h=INT(MOUSE(1)/8)
  1007.      rec=px-2:GET 5,rec
  1008.      a$(1)=pay.to$:a$(2)=amt$:a$(3)=day$:a$(4)=lp$
  1009.    IF h<21 THEN
  1010.      py=1:x=1:l=20
  1011.    ELSEIF h<32 THEN
  1012.      py=22:x=2:l=10
  1013.    ELSEIF h<36 THEN
  1014.      py=33:x=3:l=2
  1015.    ELSE
  1016.      py=37:x=4:l=7
  1017.    END IF
  1018.    a$(x)=SPACE$(l)
  1019.   edit.again:
  1020.    input.ps px,py,l,a$(x)
  1021.      IF flag=1 THEN
  1022.        LSET pay.to$=" ":LSET amt$=" "
  1023.        LSET day$="  ":LSET lp$=" ":PUT 5,px
  1024.        MID$(np$,rec,1)="0"
  1025.        RETURN pay.menu
  1026.      END IF        
  1027.      IF x=3 THEN
  1028.        IF VAL(a$(3))>28 OR VAL(a$(3))<1 THEN edit.again
  1029.      END IF
  1030.      IF x=4 THEN
  1031.        IF VAL(LEFT$(a$(4),2))>12 OR VAL(LEFT$(a$(4),2))<1 THEN edit.again 
  1032.      END IF
  1033.      GOTO put.in.file
  1034.  ps.exit:
  1035.   LOCATE 22,1:PRINT SPACE$(40)
  1036.   PRINT"     Posting Payment Scedule on Calendar      "; 
  1037.   psexit:
  1038.   FOR ps=1 TO 18
  1039.     IF MID$(np$,ps,1)="1" THEN
  1040.      GET 5,ps
  1041.      FOR check.mo=9 TO 0 STEP -1 
  1042.       m=((mo+check.mo) MOD 12)+1:d=VAL(day$)
  1043.       IF d>day AND check.mo=0 THEN next.ps
  1044.       IF mo>m THEN y=year+1 :ELSE y=year
  1045.       find.rec m,d,y
  1046.       GOSUB get.data
  1047.       IF ASC(MID$(code$(m),d,1)) AND 2 THEN
  1048.         FOR x=1 TO 10
  1049.           IF s(x)=2 THEN
  1050.             IF LEFT$(f$(x),20)=pay.to$ THEN next.ps
  1051.           END IF
  1052.         NEXT x
  1053.       ELSE
  1054.         MID$(code$(m),d,1)=CHR$(ASC(MID$(code$(m),d,1))+2) 
  1055.         LSET cod$=code$(m):PUT 4,m
  1056.       END IF
  1057.       x=1
  1058.       WHILE s(x)<>0 AND x<11
  1059.         x=x+1
  1060.       WEND
  1061.        f$(x)=pay.to$+amt$:s(x)=2:GOSUB set.data              
  1062.      NEXT check.mo
  1063.     END IF
  1064.  next.ps: 
  1065.   NEXT ps    
  1066.   CLOSE 5:WINDOW CLOSE 3
  1067.   RETURN 
  1068. SUB find.rec (mo,day,year) STATIC
  1069. SHARED days.in.month(),rec
  1070.   rec=0
  1071.   IF year/4=INT(year/4) THEN leap.buf=0 :ELSE leap.buf=1
  1072.   IF mo>2 THEN rec=rec+leap.buf
  1073.   IF mo=1 THEN rec=day:EXIT SUB
  1074.   FOR x=1 TO mo-1:rec=rec+days.in.month(x):NEXT x
  1075.   rec=rec+day
  1076.   END SUB
  1077. SUB input.ps (px,py,length,word$) STATIC
  1078. SHARED flag
  1079.   flag=0:LOCATE px,py:PRINT SPACE$(length);
  1080.   no.input=0:c=5:p=1:GOSUB put.cursor
  1081.   getke: a$=INKEY$
  1082.    WHILE a$="":a$=INKEY$
  1083.    IF MOUSE(0)<0 THEN exitsub
  1084.    WEND
  1085.   IF a$<CHR$(127) AND a$>CHR$(31) THEN
  1086.    IF p>length THEN BEEP:GOTO getke
  1087.     MID$(word$,p,1)=a$:LOCATE px,py:PRINT word$
  1088.      p=p+1:c=5:GOSUB put.cursor
  1089.       GOTO getke
  1090.   END IF        
  1091.   IF a$=CHR$(127) THEN
  1092.     LOCATE px,1:PRINT SPACE$(45)
  1093.     flag=1
  1094.     EXIT SUB
  1095.   END IF 
  1096.    IF a$=CHR$(13) THEN 
  1097.    exitsub:
  1098.      c=7:GOSUB put.cursor
  1099.      EXIT SUB
  1100.    END IF          
  1101.   IF a$=CHR$(8) THEN
  1102.     IF p>1 THEN
  1103.       IF p=>length THEN c=7:GOSUB put.cursor
  1104.       p=p-1
  1105.       word$=LEFT$(word$,p-1)+MID$(word$,p+1)+" "
  1106.       LOCATE px,py:PRINT word$
  1107.       c=5:GOSUB put.cursor:GOTO getke
  1108.     ELSE
  1109.       BEEP:GOTO getke
  1110.     END IF
  1111.   END IF
  1112.    IF a$=CHR$(30) THEN
  1113.      IF p>length THEN BEEP:GOTO getke
  1114.      c=7:GOSUB put.cursor:p=p+1:c=5:GOSUB put.cursor
  1115.      GOTO getke
  1116.    END IF
  1117.   IF a$=CHR$(31) THEN
  1118.     IF p=1 THEN BEEP:GOTO getke
  1119.     c=7:GOSUB put.cursor:p=p-1:c=5:GOSUB put.cursor
  1120.     GOTO getke
  1121.   END IF
  1122.  BEEP:GOTO getke
  1123.   put.cursor:
  1124.     LINE((py+p-2)*8,(px-1)*8)-((py+p-2)*8,(px-1)*8+6),c
  1125.     RETURN
  1126.   END SUB
  1127. new.file: LSET c.dat$=SPACE$(300):LSET s.nam$=STRING$(10,0)
  1128.   FOR x=1 TO 366:PUT 1:NEXT x
  1129.   OPEN "cal.symbol.dat" AS 4 LEN=32
  1130.   FIELD 4,32 AS cod$:LSET cod$=STRING$(32,0)
  1131.   FOR x=1 TO 12:PUT 4:NEXT x
  1132.   CLOSE 4
  1133.   RETURN  
  1134.  
  1135.