home *** CD-ROM | disk | FTP | other *** search
- 10 REM ******************************
- 20 REM * SUBROUTINE EXTRACTOR *
- 25 REM * MICRO CONNECTION *
- 30 REM * [FROM DOODLE 5] *
- 35 REM ****************************** .
- 70 POKE53280,2:POKE53281,2:F1=0:F2=0
- 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]
- 85 [153]" FN SUBROUTINE EXTRACTOR WAIT THEN
- 90 PRINT" [165]"TAB(35)"[167]"
- 95 PRINT" [165] BY- MICRO CONNECTION [167]
- 100 [153]" (null)ANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDSQR"
- 101 [153]"DEF REMOVES SUB-ROUTINES FROM BASIC
- 102 PRINT" FILES TO USE IN OTHER PROGRAMS.
- 103 [153]" YOU WILL NEED PGM. NAME AND LINE #'S
- 104 PRINT" TO EXTRACT. EXAMPLE: 120 TO 230
- 105 [153]"LIST VERSION-C64 3.0"
- 110 [153]" DISK DRIVE # 8 REQUIRED"
- 115 [153]"SYS [NOTE: DO NOT USE 'F' KEYS IF YOU
- 120 PRINT" HAVE A 'SNAPSHOT' CARTRIDGE]
- 122 [153]"DEF PRESS <SPACE> TO EXTRACT
- 123 GETG$:IFG$<>" "THEN123
- 125 POKE53280,15:POKE53281,15
- 130 PRINT"[147] [211]UBROUTINE [197]XTRACTOR [146]"
- 132 PRINT"[151] [212]HIS ROUTINE IS VERY SLOW,
- 133 [153]" BUT IS WORTHWHILE IF YOU NEED IT.
- 135 OPEN15,8,15
- 140 PRINT"[151][208]RGRM TO [197]XTRACT FROM :":X$=""
- 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] ";
- 150 PRINT"[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";
- 155 LN=16:NO=0:GOSUB 675 :X$=Y$
- 160 OPEN1,8,2,X$+",P,R"
- 165 INPUT#15,E,E$,E1,E2
- 170 IFETHENGOSUB 640 :CLR:GOTO 125
- 175 GET#1,A$,A$:GOSUB 545:REM GET START ADDRESS
- 180 REM*******************************
- 185 REM* *
- 190 REM* GET BEGINNING LINE # *
- 195 REM* *
- 200 REM*******************************
- 205 PRINT"[194]EGINNING LINE #"
- 210 PRINT" (MAX.5 DIGITS) ";:FORA=1TO5:PRINTCHR$(183);:NEXTA:PRINT"[145] ";
- 215 PRINT"[157][157][157][157][157][157]";:LN=5:NO=1:GOSUB 675 :BL=VAL(Y$)
- 220 IFY$=""THENPRINT"[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";:GOTO 215
- 225 REM*******************************
- 230 REM* *
- 235 REM* GET ENDING LINE # *
- 240 REM* *
- 245 REM*******************************
- 250 PRINT"[197]NDING LINE #"
- 255 PRINT" (MAX.5 DIGITS) ";:FORA=1TO5:PRINTCHR$(183);:NEXTA:PRINT"[145] ";
- 260 PRINT"[157][157][157][157][157][157]";:LN=5:NO=1:GOSUB 675 :EL=VAL(Y$)
- 265 IFY$=""THENPRINT"[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157]";
- 270 REM*******************************
- 275 REM* *
- 280 REM* GET NEW PROGRAM NAME *
- 285 REM* *
- 290 REM*******************************
- 295 PRINT"[206]EW FILE NAME:"
- 300 PRINT"(MAX.16 CHAR) ";:FORA=1TO16:PRINTCHR$(183);:NEXTA
- 305 PRINT"[157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][157][145]";
- 310 LN=16:GOSUB 675
- 315 Z$=Y$
- 320 IFZ$=""THENPRINT"[157][157][157][157][157][157][157][157][157][157]";:GOTO 305
- 325 OPEN8,8,8,"0:"+Z$+",P,W"
- 330 INPUT#15,E,E$,E1,E2
- 335 IF E THEN GOSUB 640 :FORZ=1TO2000:NEXTZ:GOTO 130
- 340 PRINT#8,CHR$(1);CHR$(4);:REM WRITE START ADDRESS TO NEW FILE
- 345 REM ******************************
- 350 REM * *
- 355 REM * COMPARE LINES ROUTINE *
- 360 REM * *
- 365 REM * EL= ENDING LINE NUMBER *
- 370 REM * BL=BEGINNING LINE NUMBER *
- 375 REM * CL=CURRENT LINE EXTRACTED *
- 380 REM ******************************
- 385 PRINT"[147]":PRINTSPC(6);" [194]EGINNING [197]XTRACTION....[146]"
- 386 PRINT"[151] [201] WILL [194][207][206][203] WHEN FINISHED."
- 390 IFCL>ELTHEN 440
- 395 IFCL=ELTHENF1=1
- 400 IFCL=BLTHENF2=1:GOTO 425
- 405 IFCL>BLTHEN 425
- 410 PRINT""SPC(15)"[215]ORKING[151]":GOSUB545
- 415 IFZ>1E8GOTO 440
- 420 PRINT""SPC(15)"[144][192][192][192][192][192][192][192][146][151]":GOTO390
- 425 PRINT#8,CHR$(1);CHR$(1);A$(1);B$(1);C$(1);CHR$(0);
- 430 PRINT""SPC(15)"[158][215]ORKING[151]":GOSUB545
- 435 PRINT""SPC(15)"[144][192][192][192][192][192][192][192][146][151]":GOTO390
- 440 PRINT#8,CHR$(0);CHR$(0);
- 445 CLOSE1:CLOSE8:CLOSE15
- 450 IFF1=1ORF2=1THEN 475:REM TEST FOR LINE # MATCH
- 455 PRINT"[213]NABLE TO FIND ONE OF THE LINE NUMBERS":FORA=1TO2000:NEXTA
- 460 OPEN15,8,15:PRINT#15,"S0:"+Z$:REM SCRATCH NEW FILE
- 465 FORA=1TO1000:NEXTA
- 470 CLOSE15
- 475 PRINT"[147]"
- 480 PRINT""SPC(5);" [197]XTRACTION IS COMPLETE [146]"
- 485 PRINTSPC(7);"[197]XTRACT ANY MORE? [217]/[206] ";
- 486 FORT=15TO0STEP-1:POKE54296,T:::::::::::::::POKE54296,0:NEXT:FORD=1TO50:NEXT
- 490 GETG$:IFG$<>"Y"ANDG$<>"N"THEN480
- 495 IFG$="Y"THEN:CLR:GOTO 130
- 500 IFG$="N"THENPRINT"[147]":END
- 505 GOTO 490
- 510 REM *****************************
- 515 REM * *
- 520 REM * READ A LINE OF BASIC *
- 525 REM * BYTE BY BYTE *
- 530 REM * *
- 535 REM *****************************
- 540 REM
- 545 GET#1,A$,B$:REM GET FORWARD LINK
- 550 IFA$=""ANDB$=""GOTO 605
- 555 GET#1,A$(1),B$(1):REM GET BINARY
- 560 IFA$(1)=""THENA$(1)=CHR$(0)
- 565 IFB$(1)=""THENB$(1)=CHR$(0)
- 570 REM CONVERT BINARY TO ASCII
- 575 CL=ASC(A$(1))+ASC(B$(1))*256:C$(1)=""
- 580 GET#1,A$
- 585 IFA$=""GOTO 610:REM END OF LINE
- 590 C$(1)=C$(1)+A$
- 595 IFST=0ANDLEN(C$(1))<254GOTO 580
- 600 PRINT"PROBLEM FILE ";Y$
- 605 Z=1E9
- 610 RETURN
- 615 REM ******************************
- 620 REM * DISK *
- 625 REM * ERROR ROUTINE *
- 630 REM * *
- 635 REM ******************************
- 640 PRINT"[147] [197] [210] [210] [207] [210] !!! [146]"
- 645 PRINTTAB(13)E$:CLOSE15:CLOSE1:CLOSE8:RETURN
- 650 REM*****************************
- 655 REM* *
- 660 REM* USER INPUT ROUTINE *
- 665 REM* PASS LN-LENGTH OF ENTRY *
- 670 REM* NO=1 THEN NUMERIC TEST *
- 675 REM*****************************
- 680 Y$=""
- 685 POKE204,0:POKE207,0:GETC$
- 690 IFC$=""THEN 685
- 695 IFC$=CHR$(92)THENCLOSE1:CLOSE15:CLOSE8:END
- 700 IFC$=CHR$(20)THEN 750 :REM DELETE KEY
- 705 IFC$="[147]"ORC$=""ORC$=""ORC$="[145]"ORC$=""ORC$="[157]"THEN 685 :REM CLEAR STUFF
- 710 IFNO=1THEN 770 :REM NUMERIC ONLY
- 715 IFC$=CHR$(13)THEN 735 :REM RETURN KEY
- 720 IFLEN(Y$)<LNTHENY$=Y$+C$:PRINTC$;:GOTO 685
- 725 IFLEN(Y$)<1ORLEN(Y$)=>LNTHEN 685
- 730 GOTO 685
- 735 PRINT" ":POKE204,1:POKE207,1:POKE198,0:REM CLEAR CURSOR
- 740 RETURN
- 745 REM DELETE CHARACTER ROUTINE
- 750 IFLEN(Y$)<1THEN 685
- 755 Y$=LEFT$(Y$,(LEN(Y$)-1)):PRINT"[157] [157][157]";
- 760 GOTO 685
- 765 REM TEST FOR NUMERIC ENTRY ONLY
- 770 IFVAL(C$)<0THEN 685
- 775 IFVAL(C$)>9THEN 685
- 780 GOTO 715
-