home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug109.arc / BEEDAT.MWB < prev    next >
Text File  |  1979-12-31  |  6KB  |  159 lines
  1.  
  2. 00100 REM    *** BEEDAT version 2.0 ***
  3. 00110 STRS (4000)
  4. 00120 DIM D0(100,5),D1(5)
  5. 00130 N1$="NEW":C=960:GOTO 2040                                                                                   
  6. 00140 REM *** SORT ********************************************
  7. 00150 IF R<2 THEN RETURN ELSE PRINT"FIELD #";:GOSUB 2030
  8. 00160 GOSUB 2010:L=INT(VAL(Z7$))
  9. 00170 IF L<1 OR L>5:GOSUB 2140:RETURN
  10. 00180 PRINT"SORTING";:P=0:M=R
  11. 00190 M=M/2:IF M=0 THEN 290
  12. 00200 FOR K=1 TO M
  13. 00210   I=K:J=K+M:S=0
  14. 00220   IF D0$(I,L)<=D0$(J,L) THEN 260 ELSE LET S=1
  15. 00230   FOR N=1 TO 5
  16. 00240     D1$(N)=D0$(I,N):D0$(I,N)=D0$(J,N):D0$(J,N)=D1$(N)
  17. 00250   NEXT N
  18. 00260   I=J:J=J+M: IF J<=R THEN 220
  19. 00270   IF S<>0 THEN 210
  20. 00280 NEXT K:GOTO 190
  21. 00290  PLAY 10,2:RETURN                                                                                                   
  22. 00300 REM *** LOAD FILE ***************************************
  23. 00310 R=0:CLS:GOSUB 2010:PRINT"LOADING...";
  24. 00320 IN#3:OUT#0 OFF
  25. 00330 INPUT Z7$:IF Z7$(;1,5)<>"*****"THEN 330
  26. 00340 N1$=Z7$(;11,16):R=INT(VAL(Z7$(;6,10))):POKE 61440+R,13
  27. 00350 FOR I=1 TO R:INPUT Z7$,D0$(I,1),D0$(I,2),D0$(I,3),D0$(I,4),D0$(I,5):IF INT(VAL(Z7$))<>I THEN NEXT*I 380
  28. 00360 POKE 61439+I,9:NEXT I
  29. 00370 IN#0:OUT#0:CLS:PRINT N1$:PLAY 9:RETURN
  30. 00380 R=I:IN#0:OUT#0:CLS:PRINT "BAD LOAD":PLAY 9,3;0,8:RETURN
  31. 00390 REM *** SAVE FILE ***************************************
  32. 00400 CLS:CURS C:INPUT"ENTER FILE NAME (6 characters max.)";N1$;
  33. 00410 N1$=N1$+"//////":N1$=N1$(;1,6)
  34. 00420 GOSUB 2010:PRINT"START TAPE AND PRESS <RET>";
  35. 00430 GOSUB 2030:PRINT"RECORDING ...";N1$;
  36. 00440 POKE 61440+R,13
  37. 00450 OUT#3:PRINT"*****";[I5 R];N1$
  38. 00460 FOR I=1 TO R:PRINT[I5 I];",";
  39. 00470 PRINT D0$(I,1);",";D0$(I,2);",";D0$(I,3);",";D0$(I,4);",";D0$(I,5)
  40. 00480 POKE 61439+I,9
  41. 00490 PLAY 0,4
  42. 00500 NEXT I
  43. 00510 PRINT"0,0,0,0,0,0,0,0,0"
  44. 00520 OUT#0:PLAY 9:RETURN
  45. 00530 REM *** INSERT *******************************************
  46. 00540 Q=0:FOR I=1 TO 5
  47. 00550   PRINT"FIELD #";I;" ";   
  48. 00560   IF Q<134 THEN PRINT [A40 95]; ELSE PRINT[A14 95];
  49. 00570   CURS 969:INPUT""D1$(I);:GOSUB 2010:V=LEN(D1$(I))
  50. 00580   Q=Q+V:IF Q>170 OR V>40:Q=Q-V:GOSUB 2000:GOTO 550
  51. 00590 NEXT I
  52. 00600 GOSUB 2010:PRINT"SORTING";:R=R+1
  53. 00610 IF R>1 THEN 650
  54. 00620 FOR I=1 TO 5
  55. 00630   D0$(1,I)=D1$(I)
  56. 00640 NEXT I:RETURN
  57. 00650 FOR I=R-1 TO 1 STEP -1
  58. 00660   IF D0$(I,1)>D1$(1) THEN 720
  59. 00670   IF D0$(I,1)<D1$(1) THEN 690
  60. 00680   IF D0$(I,2)+D0$(I,3)+D0$(I,4)+D0$(I,5)>D1$(2)+D1$(3)+D1$(4)+D1$(5) THEN 720
  61. 00690   FOR J=1 TO 5
  62. 00700     D0$(I+1,J)=D1$(J)
  63. 00710   NEXT J:NEXT*I 770
  64. 00720   FOR J=1 TO 5
  65. 00730     D0$(I+1,J)=D0$(I,J)
  66. 00740     IF I=1:D0$(I,J)=D1$(J)
  67. 00750   NEXT J
  68. 00760 NEXT I
  69. 00770 RETURN
  70. 00780 REM *** DELETE ******************************************
  71. 00790 INPUT"DELETE #"D;:IF D<1 OR D>R THEN GOSUB 2140:RETURN
  72. 00800 R=R-1:IF R<D THEN RETURN
  73. 00810 GOSUB 2010:PRINT"SORTING";
  74. 00820 FOR I=D TO R
  75. 00830   FOR J=1 TO 5
  76. 00840     D0$(I,J)=D0$(I+1,J)
  77. 00850   NEXT J
  78. 00860 NEXT I
  79. 00870 FOR I=1 TO 4:D0$(R+1,I)="":NEXT I:RETURN                                   
  80. 00880 REM *** EDIT ********************************************
  81. 00890 INPUT"EDIT #"D;:IF D<1 OR D>R THEN GOSUB 2140:RETURN
  82. 00900 CLS:PRINT"#";D
  83. 00910 FOR I=1 TO 5
  84. 00920   PRINT TAB(5);I;" ";D0$(D,I)
  85. 00930 NEXT I:GOSUB 2010:PRINT"FIELD #";:GOSUB 2030
  86. 00940 F=INT(VAL(Z7$)):IF F<1 OR F>5 THEN GOSUB 2140:RETURN
  87. 00950 CURS 1,F+1:PRINT">>>":GOSUB 2010:PRINT"FIELD #";F;
  88. 00960 INPUT ""D0$(D,F);:V=LEN(D0$(D,F))
  89. 00970 IF V>40:GOSUB 2000:RETURN
  90. 00980 CURS 8,F+1:PRINT[A45 32];:CURS 8,F+1:PRINT D0$(D,F);
  91. 00990 FOR I=1 TO 5
  92. 01000   D1$(I)=D0$(D,I)
  93. 01010 NEXT I:GOSUB 800:GOSUB 600
  94. 01020 RETURN                                                       
  95. 01030 REM *** FIND ********************************************
  96. 01040 PRINT"FIELD #";:GOSUB 2030:F=INT(VAL(Z7$)):GOSUB 2010
  97. 01050 IF F<1 OR F>5 THEN GOSUB 2140:RETURN
  98. 01060 INPUT"SEARCH FOR >>  ";D1$(F); 
  99. 01070 FOR I=1 TO R
  100. 01080   IF D0$(I,F)<>D1$(F) THEN 1140 ELSE CLS:PRINT"#";I
  101. 01090   FOR J=1 TO 5
  102. 01100     PRINT J;") ";D0$(I,J)
  103. 01110   NEXT J:GOSUB 2010
  104. 01120   PRINT "IS THIS THE ONE ? (Y/N) ";:GOSUB 2030
  105. 01130   IF Z7$="Y" THEN NEXT*I 1150
  106. 01140 NEXT I:CLS:PRINT\"SEARCH FINISHED":GOSUB 2010
  107. 01150 RETURN
  108. 01160 REM *** LIST ********************************************
  109. 01170 CLS:PRINT:Z=0
  110. 01180 FOR I=1 TO R
  111. 01190   PRINT"#";I;
  112. 01200   FOR J=1 TO 5
  113. 01210     PRINT TAB(6);D0$(I,J)
  114. 01220   NEXT J:Z=Z+1
  115. 01230   IF Z=3:GOSUB 2020 :Z=0:CLS:PRINT
  116. 01240 NEXT I:GOSUB 2010:RETURN
  117. 01250 REM *** PRINT ******************************************
  118. 01260 PRINT"PRINTER ON ...";
  119. 01265  OUTL#1
  120. 01270 LPRINT N1$:LPRINT
  121. 01280 FOR I=1 TO R
  122. 01290   LPRINT"#";I; 
  123. 01300   FOR J=1 TO 5
  124. 01310     LPRINT TAB(6);D0$(I,J)
  125. 01320   NEXT J:LPRINT
  126. 01330 NEXT I:RETURN                                                   
  127. 01990 REM *** Minor subroutine ***
  128. 02000 PRINT"TOO LONG";:PLAY 23,2;0,12 
  129. 02010 CURS C:PRINT[A63 32];:CURS C:RETURN
  130. 02020 PRINT"PRESS ANY KEY TO CONTINUE";
  131. 02030 POKE 257,1:Z7$=KEY:IF Z7$=""THEN 2030 ELSE RETURN
  132. 02040 REM *** HELP ********************************************
  133. 02050 RESTORE 2230:GOSUB 2180
  134. 02060 REM *** CONTROL *****************************************
  135. 02070 CURS 936:PRINT[I6 R];[F8.0 FRE(0)];[F8.0 FRE($)]
  136. 02080 GOSUB 2010:PRINT"COMAND ";:GOSUB 2030:GOSUB 2010
  137. 02090 Z=ASC(Z7$):IF Z<67 OR Z>83 THEN LET Z=1 ELSE LET Z=Z-65
  138. 02100 IF R=0 AND (Z<>6 AND Z<>8) THEN GOSUB 2140:GOTO 2060
  139. 02110 ON Z GOSUB 2140,2130,780,880,1030,300,2040,530,2140,2140,1160,2140,2140,2140,1250,2140,390,140
  140. 02120 GOTO 2070
  141. 02130 CLS:RETURN
  142. 02140 IF R>0 THEN PRINT"?????";ELSE PRINT"NO RECORDS";
  143. 02150 PLAY 23,2;0,16:RETURN                                             
  144. 02160 REM *** Centralise ***
  145. 02170 PRINT TAB(64-LEN(Z7$))/2;Z7$:RETURN                              
  146. 02180 REM *** Menu ***
  147. 02190 CLS:PRINT:READ Z7$:GOSUB 2160
  148. 02200 READ Z,T:FOR I=1 TO Z:READ Z7$
  149. 02210 PRINT TAB(T);Z7$
  150. 02220 NEXT I:RETURN
  151. 02230 DATA "B E E D A T",12,43,"C - CLS","D - DELETE","E - EDIT"
  152. 02240 DATA "F - FIND","G - GET FILE","H - HELP","I - INSERT"
  153. 02250 DATA "L - LIST","P - PRINT","R - RECORD FILE","S - SORT"
  154. 02260 DATA "RECDs  MEMFR  STRFRE"
  155. IN#0:CLOSE 6
  156. "I - INSERT"
  157. 02250 DATA "L - LIST","P - PRINT","R - RECORD FILE","S - SORT"
  158. 02260 DATA "RECDs  MEMFR  STRFRE"
  159. IN#0: