home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / genie-commodore-file-library / C128Software / DISK-LAB.MSORT_S.1 (.txt) < prev    next >
Encoding:
Commodore BASIC  |  2019-04-13  |  4.6 KB  |  138 lines
  1. 0 CLR:X$="XX":FORI=.TO3:X$=X$+X$:NEXT
  2. 1 X$=X$+"XXXXXXX":GOTO12
  3. 2 > DISK LAB.MSORT/SP100<
  4. 4 > SEIKOSHA SP100VC VER<
  5. 5 > BY FRED LAYBERGER   <
  6. 6 > OMAHA,NE - SEP 1986 <
  7. 8 POKE808,225:A1=PEEK(55):A2=PEEK(56):POKE55,PEEK(51):POKE56,PEEK(52):RETURN
  8. 10 Z=FRE(.):POKE55,A1:POKE56,A2:POKE808,237:RETURN
  9. 12 RESTORE:POKE53280,13:POKE53281,15:P$="[147]WORKING...[151]":PRINTP$
  10. 14 SD=8:DD=8:SR=0:DR=0:SA=0
  11. 16 IFPEEK(1015)<>.THENSD=PEEK(1015):DD=PEEK(1016):SR=PEEK(1017):DR=PEEK(1018):SA=PEEK(1019)
  12. 18 DL=830:IFPEEK(DL)=160THEN24
  13. 20 OPEN1,DD,.,MID$(STR$(DR),2,1)+":DISK LAB.DIR,S,R":FORI=DLTODL+148
  14. 22 INPUT#1,A:POKEI,A:NEXT:CLOSE1
  15. 24 CLOSE15:OPEN15,DD,15:GOSUB524
  16. 26 DIMV$(152):IFPEEK(49152)<>32THENLOAD"DISK LAB.SORT",DD,1:GOSUB524
  17. 28 OPEN1,DD,.,MID$(STR$(DR),2,1)+":\\MASTER*,S,R":GOSUB524
  18. 30 INPUT#1,N:INPUT#1,DT$:INPUT#1,ID$:INPUT#1,BK$:INPUT#1,P:NF=VAL(BK$):ND=N
  19. 32 D$=ID$:ID$="\\"
  20. 34 V$(.)=DT$+ID$+RIGHT$("    "+BK$,4):DIMT$(NF+1)
  21. 36 POKE850,76:POKE851,88:POKE852,3:POKE952,21
  22. 38 GOSUB8:FORI=1TON:SYSDL:V$(I)=LEFT$(X$,16)
  23. 40 PRINT""V$(I):NEXT:GOSUB10:CLOSE1
  24. 42 NF=1:IFP=2THENU=1:I=N+1:V$(I)=" \MSORTED*      ":GOTO48
  25. 44 GOTO150
  26. 46 FORI=1TOND:PRINTP$TAB(20)"DIRECTORY"I"[157] OF"ND
  27. 48 PRINT""V$(I)"[151]"TAB(20)"PROGRAM MAY PAUSE[151]"
  28. 50 CLOSE1:OPEN1,DD,DD,MID$(STR$(DR),2,1)+":"+V$(I)+",S,R":GOSUB524:IFP>1THENI=25
  29. 52 INPUT#1,N:INPUT#1,DT$:INPUT#1,ID$:INPUT#1,BK$:INPUT#1,P:GOSUB8
  30. 54 IFLEFT$(DT$,7)="\MASTER"THENID$="\\"
  31. 56 FORJ=1TON:SYSDL:IFP>1THENT$(NF)=LEFT$(X$,19):GOTO60
  32. 58 T$(NF)=LEFT$(X$,16)+RIGHT$("   "+STR$(I),3)
  33. 60 PRINT""LEFT$(T$(NF),16)TAB(20)"ITEM"NF"[157] OF "RIGHT$(V$(.),4)
  34. 62 IFP>1THENIFJ=ITHENGOSUB10:GOSUB8:I=I+25
  35. 64 NF=NF+1:IFNF>1200ORNF>VAL(RIGHT$(V$(.),4))+1THENJ=N:I=ND:B$="GREATER THEN ":GOSUB516
  36. 66 NEXT:GOSUB10:IFP>1THENCLOSE1:N=NF-1:GOTO104
  37. 68 NEXT:CLOSE1:N=NF-1:PRINTP$:Z=FRE(.)
  38. 69 IFNF<VAL(RIGHT$(V$(.),4))THENB$="LESS THEN ":GOSUB516
  39. 100 PRINT"[147]  SORTING..."N"PROGRAMS"
  40. 102 SYS 49152,N,T$(1):P=2:POKE1015,SD:POKE1016,DD:POKE1017,SR:POKE1018,DR:POKE1019,SA
  41. 104 DT$=LEFT$(V$(.),16):ID$=MID$(V$(.),17,2):BK$=MID$(V$(.),19)
  42. 150 REM ** MAIN MENU
  43. 152 PRINT"[147]DONE -CHOOSE ONE"
  44. 153 PRINT""NF-1"RECORDS ALPHABETIZED[151]"
  45. 154 IFP<2THENPRINT" 1[146] ALPHABETIZE MASTER":IFNF=1THEN162
  46. 156 PRINT" 2[146] PRINT TO SCREEN"
  47. 158 PRINT" 3[146] PRINT TO PRINTER"
  48. 160 IFU<>1THENPRINT" 4[146] SAVE SORTED FILE"
  49. 162 PRINT" 5[146] RETURN TO DISK LABELER+"
  50. 164 PRINT" 6[146] QUIT"
  51. 166 GETA$:IFP<2THENIFA$="1"THEN46
  52. 168 IFNF=1THENIFP<2THEN176
  53. 170 IFA$="2"THENGOSUB502:GOTO150
  54. 172 IFA$="3"THENGOSUB402:GOTO150
  55. 174 IFU<>1THENIFA$="4"THENGOSUB302:GOTO150
  56. 176 IFA$="5"THEN202
  57. 178 IFA$<>"6"THEN166
  58. 180 END
  59. 200 REM ** RETURN TO LABELER
  60. 202 POKE1020,1:PRINT"[147]LOAD "CHR$(34)"DISK LABELER+/S*"CHR$(34)CHR$(44)DD
  61. 204 PRINT"RUN":POKE198,8:FORI=1TO7:POKE630+I,13:NEXT:PRINT"[151]":NEW
  62. 300 REM *** SAVE
  63. 302 PRINTP$:PRINT#15,"S"+MID$(STR$(DR),2,1)+":?\M*":F$=" \MSORTED       "
  64. 304 ID$=D$
  65. 306 OPEN1,DD,DD,MID$(STR$(DR),2,1)+":"+F$+",S,W":PRINT""F$"[151]"
  66. 308 PRINT#1,N:PRINT#1,DT$:PRINT#1,ID$:PRINT#1,BK$:PRINT#1,P:GOSUB8
  67. 310 FORI=1TON
  68. 312 IFU=1THENT$=V$(I)+"    ":GOTO316
  69. 314 T$=LEFT$(T$(I),16)+LEFT$(RIGHT$(T$(I),3)+"    ",4)
  70. 316 PRINT#1,T$:PRINT""LEFT$(T$,16);
  71. 318 PRINT" ITEM"I"[157] OF"N:NEXT:GOSUB10
  72. 320 CLOSE1:GOSUB524:IFU=1THENN=NF-1:ID$="\\":RETURN
  73. 322 F$="\\MASTER        ":N=ND
  74. 324 U=1:PRINTP$:GOTO306
  75. 400 REM ** PRINT TO PRINTER
  76. 402 PRINT"[147]  PREPARE PRINTER AND ALIGN PAPER [151]":GOSUB518:IFA$="^"THENRETURN
  77. 404 PRINT"  *** WORKING[151] *** DO NOT DISTRUB[146][151] ***"
  78. 406 E$=CHR$(27):S=4:CLOSES:OPENS,S,SA:PRINT#S,H1$
  79. 408 DEFFNR(X)=INT((IP/CL-INT(IP/CL))*CL+.5):Z=.:IP=N:C1$=CHR$(15)
  80. 410 H1$=E$+CHR$(120)+CHR$(1):H2$=E$+CHR$(120)+CHR$(0)
  81. 412 A=2:E=17:B=8:C=1:D=1:CL=3:PL=56
  82. 414 T1$=E$+"G":T2$=E$+"H":PG=PL
  83. 416 P1$="":P9$="-----------------------------------"
  84. 418 PRINT#S,E$"U"CHR$(0);:FORI=1TOCL-1:PRINT#S,P1$SPC(B/A);:NEXT:PRINT#S,P1$
  85. 420 PRINT#S,H1$;:FORI=1TOC:PRINT#S:NEXT
  86. 422 PRINT#S:PRINT#S,SPC(E)CHR$(14)DT$ID$CHR$(15)
  87. 424 PRINT#S,SPC(E)NF-1" BLOCKS FREE - "D$;:PRINT#S,H2$;
  88. 426 X=INT(IP/CL):IFN>PG*CLTHENX=PL:IP=PG*CL
  89. 428 C3=2*X:C4=3*X:C5=4*X:R=FNR(X):IFR>.THENIFR<=CLTHENX=X+1
  90. 430 C3=2*X:C4=3*X:C5=4*X
  91. 432 ONRGOTO436,438:REM **CL=3
  92. 434 GOTO440
  93. 436 C3=X:C4=2*X-1:GOTO440
  94. 438 C4=3*X-1:GOTO440
  95. 440 CLOSES:OPENS,4,0:PRINT#S,T1$
  96. 441 OPEN13,4,13:PRINT#13:CLOSE13
  97. 442 FORI=1TOD:PRINT#S:NEXT:FORI=1TOCL-1:PRINT#S,P9$SPC(B);:NEXT:PRINT#S,P9$
  98. 444 IFZ>.THENC3=C3+Z:C4=C4+Z:C5=C5+Z:IFN<=PG*CLTHENIP=IP+Z
  99. 446 F=16:FORI=1TOX:GETA$:IFA$="^"THENI=X:GOTO500
  100. 448 PRINT#S,LEFT$(T$(I+Z),F)SPC(B-5);
  101. 450 K=VAL(RIGHT$(T$(I+Z),3)):PRINT#S,LEFT$(V$(K),16)SPC(B);
  102. 452 IFC3=>I+X+ZTHENPRINT#S,LEFT$(T$(I+X+Z),F)SPC(B-5);
  103. 454 IFC3=>I+X+ZTHENK=VAL(RIGHT$(T$(I+X+Z),3)):PRINT#S,LEFT$(V$(K),16)SPC(B);
  104. 456 IFI+C3>IPTHENPRINT#S:GOTO476
  105. 458 IFC4=>I+C3THENPRINT#S,LEFT$(T$(I+C3),F)SPC(B-5);
  106. 460 IFC4=>I+C3THENK=VAL(RIGHT$(T$(I+C3),3)):PRINT#S,LEFT$(V$(K),16)SPC(B);
  107. 462 IFI+C4>IPTHENPRINT#S:GOTO476
  108. 464 IFC5=>I+C4THENPRINT#S,LEFT$(T$(I+C4),F)SPC(B-5);
  109. 466 IFC5=>I+C4THENK=VAL(RIGHT$(T$(I+C4),3)):PRINT#S,LEFT$(V$(K),16)SPC(B);
  110. 468 IFI+C5>IPTHENPRINT#S:GOTO476
  111. 470 IFC5+X=>I+C5THENPRINT#S,LEFT$(T$(I+C5),F);
  112. 472 IFC5+X=>I+C5THENK=VAL(RIGHT$(T$(I+C5),3)):PRINT#S,LEFT$(V$(K),16)SPC(B);
  113. 474 PRINT#S
  114. 476 NEXT:IFX<PLTHENFORI=1TOINT(PL-X):PRINT#S:NEXT:IFXAND1THENPRINT#S
  115. 478 FORI=1TOCL:PRINT#S,P9$;SPC(B);:NEXT:PRINT#S:PRINT#S
  116. 480 IFN<=PG*CLTHEN500
  117. 482 CLOSES:OPENS,4:PRINT#S,H1$:PRINT#S,T2$:FORI=1TOC:PRINT#S:NEXT
  118. 483 PRINT#4,H1$
  119. 484 PRINT#S,CHR$(14)DT$ID$CHR$(15)" CONTINUED..."
  120. 485 PRINT#S,H1$"PAGE#"(PG/PL)+1" - "D$
  121. 486 Z=PG*CL:IP=N-(PG*CL):PG=PG+PL:GOTO426
  122. 500 CLOSES:OPENS,4:PRINT#S,T2$;:CLOSES:RETURN
  123. 502 REM *** PRINT TO SCREEN
  124. 504 PRINT"[147]  FILENAME"TAB(23)"DISKNAME[151]"
  125. 506 FORI=1TON
  126. 508 PRINTTAB(2)LEFT$(T$(I),16)TAB(23);
  127. 510 K=VAL(RIGHT$(T$(I),3)):PRINTLEFT$(V$(K),16)
  128. 512 IFPEEK(214)=23THENGOSUB518:PRINT"[147]":IFA$="^"THENI=N:NEXT:RETURN
  129. 514 NEXT:GOTO518
  130. 516 PRINT"[147]# OF AVAILABLE RECORDS IS"
  131. 517 PRINT""B$"MASTER COUNT OF"RIGHT$(V$(.),4)""
  132. 518 PRINT" PRESS A KEY TO CONTINUE - '^'TO RETURN[146][151]"
  133. 520 GETA$:IFA$=""THEN520
  134. 522 RETURN
  135. 524 INPUT#15,ER,ER$,T,S
  136. 526 IFERTHENPRINT" "ER;ER$;T;S:GOSUB518:END
  137. 528 RETURN
  138.