home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / genie-commodore-file-library / C64Toolkit / SUB-ROUTINE-EXCT (.txt) < prev    next >
Commodore BASIC  |  2019-04-13  |  5KB  |  158 lines
  1. 10 REM ******************************
  2. 20 REM *   SUBROUTINE EXTRACTOR     *
  3. 25 REM *     MICRO CONNECTION       *
  4. 30 REM *     [FROM  DOODLE 5]       *
  5. 35 REM ******************************  .
  6. 70 POKE53280,2:POKE53281,2:F1=0:F2=0
  7. 80 PRINT"[147][142]    [207][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][208]
  8. 85 [153]"    FN     SUBROUTINE EXTRACTOR  WAIT   THEN
  9. 90 PRINT"    [165]"TAB(35)"[167]"
  10. 95 PRINT"    [165]     BY- MICRO CONNECTION     [167]
  11. 100 [153]"    (null)ANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDSQR"
  12. 101 [153]"DEF    REMOVES SUB-ROUTINES FROM BASIC
  13. 102 PRINT"    FILES TO USE IN OTHER PROGRAMS.
  14. 103 [153]"  YOU WILL NEED PGM. NAME AND LINE #'S
  15. 104 PRINT"    TO EXTRACT. EXAMPLE:  120 TO 230
  16. 105 [153]"LIST            VERSION-C64 3.0"
  17. 110 [153]"        DISK DRIVE # 8 REQUIRED"
  18. 115 [153]"SYS   [NOTE: DO NOT USE 'F' KEYS IF YOU
  19. 120 PRINT"      HAVE A 'SNAPSHOT' CARTRIDGE]
  20. 122 [153]"DEF        PRESS <SPACE> TO EXTRACT
  21. 123 GETG$:IFG$<>" "THEN123
  22. 125 POKE53280,15:POKE53281,15
  23. 130 PRINT"[147]         [211]UBROUTINE [197]XTRACTOR [146]"
  24. 132 PRINT"[151]       [212]HIS ROUTINE IS VERY SLOW,
  25. 133 [153]"   BUT IS WORTHWHILE IF YOU NEED IT.
  26. 135 OPEN15,8,15
  27. 140 PRINT"[151][208]RGRM TO [197]XTRACT FROM :":X$=""
  28. 145 PRINT"  (MAX.16 CHAR) [198]1-[197]XIT[183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183]";:PRINT"[145] ";
  29. 150 PRINT"[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";
  30. 155 LN=16:NO=0:GOSUB 675 :X$=Y$
  31. 160 OPEN1,8,2,X$+",P,R"
  32. 165 INPUT#15,E,E$,E1,E2
  33. 170 IFETHENGOSUB 640 :CLR:GOTO 125
  34. 175 GET#1,A$,A$:GOSUB 545:REM GET START ADDRESS
  35. 180 REM*******************************
  36. 185 REM*                             *
  37. 190 REM*     GET BEGINNING LINE #    *
  38. 195 REM*                             *
  39. 200 REM*******************************
  40. 205 PRINT"[194]EGINNING LINE #"
  41. 210 PRINT" (MAX.5 DIGITS) ";:FORA=1TO5:PRINTCHR$(183);:NEXTA:PRINT"[145] ";
  42. 215 PRINT"[157][157][157][157][157][157]";:LN=5:NO=1:GOSUB 675 :BL=VAL(Y$)
  43. 220 IFY$=""THENPRINT"[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";:GOTO 215
  44. 225 REM*******************************
  45. 230 REM*                             *
  46. 235 REM*     GET ENDING  LINE #      *
  47. 240 REM*                             *
  48. 245 REM*******************************
  49. 250 PRINT"[197]NDING LINE    #"
  50. 255 PRINT" (MAX.5 DIGITS) ";:FORA=1TO5:PRINTCHR$(183);:NEXTA:PRINT"[145] ";
  51. 260 PRINT"[157][157][157][157][157][157]";:LN=5:NO=1:GOSUB 675 :EL=VAL(Y$)
  52. 265 IFY$=""THENPRINT"[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";
  53. 270 REM*******************************
  54. 275 REM*                             *
  55. 280 REM*     GET NEW PROGRAM NAME    *
  56. 285 REM*                             *
  57. 290 REM*******************************
  58. 295 PRINT"[206]EW FILE NAME:"
  59. 300 PRINT"(MAX.16 CHAR) ";:FORA=1TO16:PRINTCHR$(183);:NEXTA
  60. 305 PRINT"[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][145]";
  61. 310 LN=16:GOSUB 675 
  62. 315 Z$=Y$
  63. 320 IFZ$=""THENPRINT"[157][157][157][157][157][157][157][157][157][157]";:GOTO 305
  64. 325 OPEN8,8,8,"0:"+Z$+",P,W"
  65. 330 INPUT#15,E,E$,E1,E2
  66. 335 IF E THEN GOSUB 640  :FORZ=1TO2000:NEXTZ:GOTO 130
  67. 340 PRINT#8,CHR$(1);CHR$(4);:REM WRITE START ADDRESS TO NEW FILE
  68. 345 REM ******************************
  69. 350 REM *                            *
  70. 355 REM *   COMPARE LINES ROUTINE    *
  71. 360 REM *                            *
  72. 365 REM *   EL= ENDING LINE NUMBER   *
  73. 370 REM *  BL=BEGINNING LINE NUMBER  *
  74. 375 REM *  CL=CURRENT LINE EXTRACTED *
  75. 380 REM ******************************
  76. 385 PRINT"[147]":PRINTSPC(6);"   [194]EGINNING [197]XTRACTION....[146]"
  77. 386 PRINT"[151]      [201] WILL [194][207][206][203] WHEN FINISHED."
  78. 390 IFCL>ELTHEN 440
  79. 395 IFCL=ELTHENF1=1
  80. 400 IFCL=BLTHENF2=1:GOTO 425
  81. 405 IFCL>BLTHEN 425
  82. 410 PRINT""SPC(15)"[215]ORKING[151]":GOSUB545
  83. 415 IFZ>1E8GOTO 440
  84. 420 PRINT""SPC(15)"[144][192][192][192][192][192][192][192][146][151]":GOTO390
  85. 425 PRINT#8,CHR$(1);CHR$(1);A$(1);B$(1);C$(1);CHR$(0);
  86. 430 PRINT""SPC(15)"[158][215]ORKING[151]":GOSUB545
  87. 435 PRINT""SPC(15)"[144][192][192][192][192][192][192][192][146][151]":GOTO390
  88. 440 PRINT#8,CHR$(0);CHR$(0);
  89. 445 CLOSE1:CLOSE8:CLOSE15
  90. 450 IFF1=1ORF2=1THEN 475:REM TEST FOR LINE # MATCH
  91. 455 PRINT"[213]NABLE TO FIND ONE OF THE LINE NUMBERS":FORA=1TO2000:NEXTA
  92. 460 OPEN15,8,15:PRINT#15,"S0:"+Z$:REM SCRATCH NEW FILE
  93. 465 FORA=1TO1000:NEXTA
  94. 470 CLOSE15
  95. 475 PRINT"[147]"
  96. 480 PRINT""SPC(5);"   [197]XTRACTION IS COMPLETE   [146]"
  97. 485 PRINTSPC(7);"[197]XTRACT ANY MORE?   [217]/[206] ";
  98. 486 FORT=15TO0STEP-1:POKE54296,T:::::::::::::::POKE54296,0:NEXT:FORD=1TO50:NEXT
  99. 490 GETG$:IFG$<>"Y"ANDG$<>"N"THEN480
  100. 495 IFG$="Y"THEN:CLR:GOTO 130
  101. 500 IFG$="N"THENPRINT"[147]":END
  102. 505 GOTO 490
  103. 510 REM *****************************
  104. 515 REM *                           *
  105. 520 REM *   READ A LINE OF BASIC    *
  106. 525 REM *        BYTE BY BYTE       *
  107. 530 REM *                           *
  108. 535 REM *****************************
  109. 540 REM
  110. 545 GET#1,A$,B$:REM GET FORWARD LINK
  111. 550 IFA$=""ANDB$=""GOTO 605
  112. 555 GET#1,A$(1),B$(1):REM GET BINARY
  113. 560 IFA$(1)=""THENA$(1)=CHR$(0)
  114. 565 IFB$(1)=""THENB$(1)=CHR$(0)
  115. 570 REM CONVERT BINARY TO ASCII
  116. 575 CL=ASC(A$(1))+ASC(B$(1))*256:C$(1)=""
  117. 580 GET#1,A$
  118. 585 IFA$=""GOTO 610:REM END OF LINE
  119. 590 C$(1)=C$(1)+A$
  120. 595 IFST=0ANDLEN(C$(1))<254GOTO 580
  121. 600 PRINT"PROBLEM FILE ";Y$
  122. 605 Z=1E9
  123. 610 RETURN
  124. 615 REM ******************************
  125. 620 REM *           DISK             *
  126. 625 REM *       ERROR ROUTINE        *
  127. 630 REM *                            *
  128. 635 REM ******************************
  129. 640 PRINT"[147]               [197] [210] [210] [207] [210] !!!         [146]"
  130. 645 PRINTTAB(13)E$:CLOSE15:CLOSE1:CLOSE8:RETURN
  131. 650 REM*****************************
  132. 655 REM*                           *
  133. 660 REM*     USER INPUT ROUTINE    *
  134. 665 REM*   PASS LN-LENGTH OF ENTRY *
  135. 670 REM*   NO=1 THEN NUMERIC TEST  *
  136. 675 REM*****************************
  137. 680 Y$=""
  138. 685 POKE204,0:POKE207,0:GETC$
  139. 690 IFC$=""THEN 685 
  140. 695 IFC$=CHR$(92)THENCLOSE1:CLOSE15:CLOSE8:END
  141. 700 IFC$=CHR$(20)THEN 750 :REM DELETE KEY
  142. 705 IFC$="[147]"ORC$=""ORC$=""ORC$="[145]"ORC$=""ORC$="[157]"THEN 685 :REM CLEAR STUFF
  143. 710 IFNO=1THEN 770 :REM NUMERIC ONLY
  144. 715 IFC$=CHR$(13)THEN 735 :REM RETURN KEY
  145. 720 IFLEN(Y$)<LNTHENY$=Y$+C$:PRINTC$;:GOTO 685 
  146. 725 IFLEN(Y$)<1ORLEN(Y$)=>LNTHEN 685 
  147. 730 GOTO 685 
  148. 735 PRINT" ":POKE204,1:POKE207,1:POKE198,0:REM CLEAR CURSOR
  149. 740 RETURN
  150. 745 REM DELETE CHARACTER ROUTINE
  151. 750 IFLEN(Y$)<1THEN 685 
  152. 755 Y$=LEFT$(Y$,(LEN(Y$)-1)):PRINT"[157]  [157][157]";
  153. 760 GOTO 685 
  154. 765 REM TEST FOR NUMERIC ENTRY ONLY
  155. 770 IFVAL(C$)<0THEN 685 
  156. 775 IFVAL(C$)>9THEN 685 
  157. 780 GOTO 715 
  158.