home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / BF / BF015.ZIP / PCPM4.EXE / arc / CPAPRES.BAS < prev    next >
BASIC Source File  |  1987-02-12  |  5KB  |  279 lines
  1.     'CPAPRES
  2.     common cpafile$
  3.  
  4.  UpperCase:
  5.    def fnucase$(cpafile$)
  6.       length=len(cpafile$)
  7.  
  8.       if length =0 then
  9.          exit def
  10.       end if
  11.  
  12.       for I=1 to length
  13.          ch=asc(mid$(cpafile$,I,1))
  14.                                     
  15.             if ch> 96 and ch<127 then
  16.             mid$(cpafile$,I,1)=chr$(ch-32)
  17.          end if
  18.  
  19.         next
  20.  
  21.       fnucase$=cpafile$
  22.  
  23.     end def
  24.  
  25.     cls
  26.     CLOSE
  27.     print "                  PERSONAL COMPUTER PROJECT MANAGEMENT"
  28.     print
  29.     print"                         PREDESSOR OR SUCCESSOR"
  30.     print
  31.     DIM V(100),T$(11),X$(12)
  32.    DIM S(500),F(500),D$(500),D(500),A5(500)
  33.     DIM P(3000)
  34.  
  35.      GOSUB GetFile                      '5000 READ IN INPUT FILE
  36.  
  37.      INPUT "Enter Predecessor or Successor (P/S) ",Q$
  38.  
  39.      IF LEFT$(Q$,1)="P" or left$(Q$,1)="p" THEN
  40.         F1=1
  41.         ELSE F1=0       'F1=1 THEN PREDESSOR
  42.      end if
  43.  
  44.      IF F1=1 THEN
  45.         OPEN F$+".PRE" FOR OUTPUT AS #1
  46.         ELSE OPEN F$+".SUC" FOR OUTPUT AS #1
  47.      end if
  48.  
  49.      IF F1=1 THEN
  50.         T$="PRECEEDOR "
  51.         ELSE T$="SUCCEEDOR "
  52.      end if
  53.  
  54.      FOR I=1 TO N
  55.         P(I)=I
  56.      NEXT
  57.  
  58.      P6=0
  59.  
  60.     FOR I=1 TO 12
  61.         READ X$(I)
  62.      NEXT I
  63.  
  64.     DATA "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC"
  65.     B4=VAL(MID$(DATE$,1,2))
  66.     B5=VAL(MID$(DATE$,4,2))
  67.      B6=VAL(MID$(DATE$,9,2))
  68.  
  69.      GOSUB WriteHeading                 '660
  70.  
  71.      PRINT "**** SORTING";N;"ACTIVITIES ****";
  72.  
  73.      GOSUB ShellSort                    '7000
  74.  
  75.      PRINT " FINSHED SORTING ****"
  76.      PRINT "**** THE FOLLOWING INDICATES HOW MANY ";T$;"S EXIST FOR EACH ACTIVITY ****"
  77.     K1=1
  78.  
  79. 370 IF F1=1 THEN
  80.         N1=S(P(K1))
  81.         ELSE N1=F(P(K1))
  82.      end if
  83.  
  84.     J2=0
  85.  
  86.      FOR I=1 TO N
  87.  
  88.         IF F1=1 THEN
  89.             J5=F(P(I))
  90.             ELSE J5=S(P(I))
  91.         end if
  92.  
  93.         IF J5<>N1 THEN
  94.             goto 440
  95.         end if
  96.  
  97.         J2=J2+1
  98.         A5(J2)=P(I)
  99.  
  100. 440 NEXT I
  101.     PRINT #1,TAB(3);S(P(K1));TAB(9);F(P(K1));
  102.      PRINT J2;
  103.  
  104.      IF J2=0 THEN
  105.         goto 540
  106.      end if
  107.  
  108.      FOR I=1 TO J2
  109.  
  110.         Q=(I-1)*12+1
  111.         IF I<10 THEN
  112.             goto 520
  113.             ELSE Q=(I-10)*12+1
  114.         end if
  115.  
  116.         IF I=10 THEN
  117.             PRINT #1,G9$
  118.         end if
  119.  
  120. 520   PRINT #1,TAB(15+Q);S(A5(I));TAB(21+Q);F(A5(I));
  121.  
  122.     NEXT I
  123.  
  124. 540 PRINT #1,G9$
  125.      K1=K1+1
  126.  
  127.      IF K1>N THEN
  128.         goto 590
  129.      end if
  130.  
  131.      IF K1/50=INT(K1/50) THEN
  132.         GOSUB WriteHeading                '660
  133.      end if
  134.  
  135.     GOTO 370
  136.  
  137. 590 PRINT
  138.      PRINT "**** ";T$;" DISPLAY CREATED AND EXISTS IN ";
  139.  
  140.      IF F1=1 THEN
  141.         PRINT F$+".PRE";" ****"
  142.         ELSE PRINT F$+".SUC";" ****"
  143.      end if
  144.  
  145.     PRINT
  146.     INPUT "Press ENTER to continue ",Q$
  147.     CLOSE #1
  148.      chain "CPAMENU"
  149.  
  150. WriteHeading:
  151. 660 REM WRITE PAGE HEADING SUBROUTINE
  152.     P6=P6+1
  153.     T4=INT((120-LEN(T$+"DISPLAY"))/2)
  154.     T5=INT((120-LEN(P$))/2)
  155.     PRINT #1,TAB(T5);P$;TAB(115);"PAGE";P6
  156.     PRINT #1,G9$
  157.     PRINT #1,TAB(T4);T$;"DISPLAY";TAB(99);"RUN DATE: ";X$(B4);B5;", 19";RIGHT$(STR$(B6),2)
  158.     PRINT #1,G9$
  159.     R$="  ACTIVITY    "
  160.     R2$=" I     J   "
  161.     PRINT #1,R$;T$;" ";T$;" ";T$;" ";T$;" ";T$;" ";T$;" ";T$;" ";T$;" ";T$
  162.     R4$="I     J    "
  163.     PRINT #1,TAB(4);R4$;R2$;R2$;R2$;R2$;R2$;R2$;R2$;R2$;R2$
  164.     PRINT #1,G9$
  165.      RETURN
  166.  
  167. GetFile:
  168. 5000 REM **** READING IN ALREADY CREATED INPUT FILE ******************
  169.  
  170.     if len(cpafile$) >0 then
  171.         G$=cpafile$
  172.         goto commndfile
  173.     end if
  174.  
  175. GetFile1:
  176. 5010 INPUT "Enter the name of the input file [.CPM] or Q to quit ";G$
  177.  
  178.       IF G$="Q" OR G$="q" THEN
  179.           close
  180.           chain "CPAMENU"
  181.       end if
  182.  
  183.  commndfile:
  184.       P=INSTR(1,G$,".")
  185.  
  186.       IF P<>0 THEN
  187.          F$=LEFT$(G$,INSTR(1,G$,".")-1)
  188.          ELSE F$=G$
  189.       end if
  190.  
  191.       IF LEN(F$)>8 THEN
  192.          PRINT "**** NOT A VALID PCPM FILE ****"
  193.          BEEP
  194.          GOTO GetFile1                   '5010
  195.       end if
  196.  
  197.       ON ERROR GOTO FileNotExist        '5300
  198.  
  199.      cpafile$=F$
  200.      cpafile$=fnucase$(cpafile$)
  201.      F$=cpafile$                
  202.      G$=F$+".CPM"
  203.      OPEN G$ FOR INPUT AS #3
  204.      INPUT #3,P$,T6$,DA$
  205.      I=0
  206.  
  207. 5070 I=I+1
  208.       IF EOF(3) THEN
  209.          goto 5130
  210.       end if
  211.  
  212.       INPUT #3,D$,S(I),F(I),O2,D,A6,PC,B,CT
  213.  
  214.       IF S(I)>N8 THEN
  215.          N8=S(I)   'HIGHEST START NODE NUMBER=N8
  216.       end if
  217.  
  218.       IF I/10=INT(I/10) THEN
  219.          PRINT I;
  220.       end if
  221.  
  222.      GOTO 5070
  223.  
  224. 5130 N=I-1
  225.      M6=VAL(LEFT$(DA$,2)):D6=VAL(MID$(DA$,3,2)):Y6=VAL(RIGHT$(DA$,2))
  226.      CLOSE #3
  227.      PRINT " **** INPUT FILE READ ****"
  228.      RETURN
  229.  
  230. FileNotExist:
  231. 5300 PRINT "**** FILE DOES NOT EXIST - TRY AGAIN ****"
  232.       BEEP
  233.       GOTO GetFile                 '5000
  234.  
  235. ShellSort:
  236. 7000 REM **** SHELL METZNER SORT ****************************************
  237.       J=N
  238.  
  239.       FOR I=1 TO N
  240.         P(I)=J
  241.         J=J-1
  242.       NEXT I
  243.  
  244.      M=N
  245.  
  246. 7040 M=INT(M/2)
  247.       IF M=0 THEN
  248.           RETURN
  249.       end if
  250.  
  251.      J=1
  252.      K=N-M
  253.  
  254. 7080 I=J
  255.  
  256. 7090 L=I+M
  257.  
  258.       IF S(P(I))<S(P(L)) THEN
  259.          goto 7150
  260.       end if
  261.  
  262.      SWAP P(I),P(L)
  263.       I=I-M
  264.  
  265.       IF I<1 THEN
  266.          goto 7150
  267.       end if
  268.  
  269.      GOTO 7090
  270.  
  271. 7150 J=J+1
  272.  
  273.       IF J>K THEN
  274.          goto 7040
  275.       end if
  276.  
  277.      GOTO 7080
  278. 
  279.