home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
ENTERPRS
/
CPM
/
UTILS
/
A
/
CBMTOCPM.OBJ
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2000-06-30
|
7KB
|
211 lines
1 REM COPY CBM TO CP/M
5 POKE 56,64:CLR:RESTORE
10 FORI=828TO981:READ A:POKE I,A:NEXT I
20 RB=838:BS=6*4096:BP=BS:BE=BS+16383
30 X1=828:REM FILE POSITION
40 X2=830:REM FILE END
50 X3=832:REM BUFF START
60 X4=834:REM BUFF END
70 X=INT(BS/256):Y=BS-(256*X):POKE X3,Y:POKE X3+1,X
80 X=INT(BE/256):Y=BE-(256*X):POKE X4,Y:POKE X4+1,X
105 DIM U%(64),N$(64),T$(64),VT$(20),A%(255),C%(255):POKE59468,14
110 D1=4*4096:REM ADDRESS OF CP/M DIRECTORY INFO
115 D2=D1+2048:REM ADDRESS OF CP/M DISK RECORD MAP
120 D3=D2+3264:REM ADDRESS OF CP/M DISK BLOCK ALLOC MAP
125 FOR I=0TO12:A%(0)=0:NEXT I:A%(13)=13:FOR I=14TO31:A%(I)=0:NEXT I
130 FOR I=32TO64:A%(I)=I:NEXT I:FOR I=65TO90:A%(I)=I+128:NEXT I
135 FOR I=91TO95:A%(I)=I:NEXT I:A%(96)=44:FOR I=97TO122:A%(I)=I-32:NEXT I
140 A%(123)=179:A%(124)=125:A%(125)=171:A%(126)=96:A%(127)=0
145 FOR I=128TO255:A%(I)=A%(I-128):NEXT I
150 FOR I=0TO64:C%(I)=I:NEXT I:FOR I=65TO90:C%(I)=I+32:NEXT I
155 FOR I=91TO127:C%(I)=I:NEXT I:FOR I=128TO255:C%(I)=I-128:NEXT I
160 FOR I=0TO20:READ VT$(I):IF VT$(I)="***"THENI=20
165 NEXT I
170 PRINT CHR$(14)+"[147]";:DK=-1:DN=0:GOSUB800
210 OPEN 15,8,15:PRINT#15,"I0":CLOSE15
215 PRINT"[147][210]EADING [195][208]/[205] [196]IRECTORY":PRINT
220 OPEN 1,8,2,"#":OPEN 15,8,15
225 D=D1:FOR S=0TO7:PRINT#15,"B-P";2;0
230 PRINT#15,"U1";2;0;3;S
235 FOR I=1TO8:PRINT".";
240 FOR J=1TO32:GET#1,X$:IFX$=""THENX$=CHR$(0)
245 POKE D,ASC(X$):D=D+1
250 NEXT J,I,S:CLOSE1:CLOSE15
255 D=D2:REM BUILD RECORD MAP
260 FOR T=3TO17:FOR S=0TO16
265 POKED,T:POKED+1,S:POKED+2,0:POKED+3,T:POKED+4,S:POKED+5,128
270 D=D+6:NEXT S,T
275 FOR T=19TO35:FOR S=0TO16
280 POKED,T:POKED+1,S:POKED+2,0:POKED+3,T:POKED+4,S:POKED+5,128
285 D=D+6:NEXT S,T
290 FORI=D3+2TOD3+135:POKEI,0:NEXT I
295 POKED3,255:POKED3+1,255:REM DIRECTORY BLOCKS
300 D=D1:FOR I=1TO64:U%(I)=PEEK(D):IFU%(I)=229THEN330
305 N$(I)="":FOR J=1TO8:N$(I)=N$(I)+CHR$(PEEK(D+J)):NEXT J
310 T$(I)="":FOR J=9TO11:T$(I)=T$(I)+CHR$(PEEK(D+J)):NEXT J
315 FOR J=16TO31:IF PEEK(D+J)=0 THEN 325
320 X=PEEK(D+J):POKE D3+X,I
325 NEXT J
330 D=D+32:NEXT I
335 PRINT:PRINT"[198]INISHED!":PRINT"[208]RESS ANY KEY TO GO TO MENU"
340 GETA$:IFA$=""THEN340
345 GOTO500
350 IFBP>BETHEN365
355 X$=CHR$(PEEK(BP)):IF BP=FE THEN CS=64
360 BP=BP+1:RETURN
365 DN=1:GOSUB800:OPEN3,8,3,CB$+",S,R"
370 PRINT "[210]EADING A 16[203] [194]UFFER FROM [195][194][205] [196]ISK":SYSRB
375 FE=PEEK(X2)+(PEEK(X2+1)*256)
380 BP=BS:CLOSE3:CLOSE15
385 DN=0:GOSUB800:GOTO350
500 PRINT"[147][195][194][205] -- [195][208]/[205] [213]TILITY"
510 PRINT"[198]UNCTIONS ARE:"
520 PRINT" 1 - [204]IST [195][208]/[205] [196]IRECTORY"
530 PRINT" 2 - [204]IST [195][208]/[205] [198]ILE"
540 PRINT" 3 - [195]OPY [195][194][205] FILE TO [195][208]/[205] FILE"
580 PRINT" 8 - [201]NITIALIZE FOR ANOTHER [195][208]/[205] [196]ISK"
590 PRINT" 9 - [197]XIT [213]TILITY"
600 PRINT"[208]RESS KEY FOR DESIRED FUNCTION"
610 GETA$:IFA$=""THEN610
620 ON VAL(A$) GOTO 1000,2000,3000,500,500,500,500,5,640
630 GOTO 500
640 POKE 56,160:CLR:END
800 IF DK=DN THEN RETURN
810 IF DN=0 THEN PRINT:PRINT"[201]NSERT [195][208]/[205] [196]ISK IN [196]RIVE":GOTO830
820 PRINT:PRINT"[201]NSERT [195][194][205] [196]ISK IN [196]RIVE"
830 PRINT"[208]RESS [[198]1] WHEN READY TO CONTINUE"
835 GETA$:IFA$<>""THEN835
840 GETA$:PRINT"?[157] [157]";
845 IFA$<>CHR$(133)THEN840
850 ZZ=FRE(0):DK=DN:RETURN
900 INPUT#15,E1$,E2$,E3$,E4$
910 DS=VAL(E1$):RETURN
1000 PRINT"[147][213][211][210] [206][193][205][197] [212][217][208] [197][216][212] [210][197][195][211] [211][201][218][197]"
1010 B=2:D=D1:FOR I=1TO64
1020 IF PEEK(D)<>0 THEN 1120
1030 U$=RIGHT$(" "+STR$(U%(I)),2)
1040 N$=N$(I)
1050 T$=T$(I)
1060 E=PEEK(D+12)+1:E$=RIGHT$(" "+STR$(E),2)
1070 S=PEEK(D+15):S$=RIGHT$(" "+STR$(S),3)
1080 K=0:FOR J=16TO31:IF PEEK(D+J)<>0THENK=K+1
1090 K$=RIGHT$(" "+STR$(K),3)
1100 NEXT J:B=B+K
1110 PRINT U$;" ";N$;" ";T$;" ";E$;" ";S$;" ";K$;"K"
1120 D=D+32:NEXT I
1130 PRINT"";STR$(136-B);" 1[203] [194]LOCKS [193]VAILABLE "
1140 PRINT"[208]RESS ANY KEY FOR MENU"
1150 GETA$:IFA$=""THEN1150
1160 GOTO500
2000 OPEN4,3:REM DEFAULT TO SCREEN
2010 PRINT"[147][195][208]/[205] [198]ILE [208]RINT":PRINT"[213]SER, [198]ILE [206]AME, [212][217][208]"
2020 INPUT U$,A$,B$
2030 U%=VAL(U$):IFU%<0ORU>15THENPRINT"[213]SER # [201][206][214][193][204][201][196]":GOTO2400
2040 X=21:FOR I=0TO20:IF B$=VT$(I)THENX=I:I=20:GOTO2060
2050 IFVT$(I)="***"THENI=20
2060 NEXT I:IFX=21THENPRINT"[198]ILE [212][217][208][197] [201][206][214][193][204][201][196]":GOTO2400
2070 A$=LEFT$(A$+" ",8)
2080 F=0:E=0:FORI=1TO64:IFU%(I)=229THEN2100
2090 IFU%=U%(I)ANDA$=N$(I)ANDB$=T$(I)THENF=I:I=64
2100 NEXT I
2110 IFF=0THENPRINT"[198]ILE [206][207][212] [198][207][213][206][196]":GOTO2400
2120 PR=0:INPUT"[211]CREEN (S) OR [208]RINTER (P) S[157][157][157]";A$
2130 IFA$="P"THENOPEN7,4,7:PRINT#7:CLOSE7:CLOSE4:OPEN4,4:PR=1:GOTO2160
2140 IFA$="S"THEN2160
2150 GOTO2120
2160 PRINT#4,"[147]";:BC=0
2170 DN=0:GOSUB800:OPEN 1,8,2,"#":OPEN 15,8,15
2180 D=D1+(F-1)*32
2190 FORK=D+16TOD+31:B=PEEK(K):IFB=0THENK=D+31:GOTO2350
2200 B=D2+(B)*24
2210 FORI=BTOB+18STEP6:T=PEEK(I):S=PEEK(I+1):P=PEEK(I+2)
2220 PRINT#15,"B-P";2;0
2230 PRINT#15,"U1";2;0;T;S
2240 FORJ=1TO256
2250 GET#1,X$:IFX$=""THENX$=CHR$(0)
2260 IFASC(X$)=26THENJ=256:I=B+18:K=D+31:GOTO2330
2270 IFASC(X$)<>9THEN2300
2280 X=INT(BC/8)*8:X=BC-X:X=8-X:FORXX=1TOX:PRINT#4," ";:NEXT XX
2290 BC=BC+X:GOTO2330
2300 IFASC(X$)=12THENPRINT#4,"[147]";:GOTO2330
2310 PRINT#4,CHR$(A%(ASC(X$)));:IFA%(ASC(X$))<>0THENBC=BC+1
2320 IFASC(X$)=13THENBC=0
2330 NEXT J
2340 NEXT I
2350 NEXT K
2360 CLOSE1:CLOSE15
2370 FF=F:E=E+1:FORI=FTO64:IFU%(I)=229THEN2390
2380 IFU%=U%(I)ANDA$=N$(I)ANDB$=T$(I)ANDPEEK(D1+((I-1)*32)+12)=ETHENF=I:I=64
2390 NEXT I:IFF>FFTHEN2170
2400 PRINT:PRINT"[208]RESS ANY KEY FOR MENU"
2410 GETA$:IFA$=""THEN2410
2420 PRINT#4:PRINT#4,""+CHR$(141)+"[147]";:CLOSE4
2430 IFPRTHENOPEN10,4,10:PRINT#10:CLOSE10
2440 GOTO500
3000 PRINT"[147][195]OPY A [195][194][205] FILE TO [195][208]/[205] FILE"
3010 INPUT"[195][194][205] FILE NAME [157][157][157]";CB$
3020 PRINT"[195][208]/[205] USER, FILE NAME, TYPE":INPUT U$,CP$,TY$
3030 IFVAL(U$)<0ORVAL(U$)>15THENPRINT"[201]NVALID [213]SER":GOTO3020
3040 X=21:FOR I=0TO20:IF TY$=VT$(I)THENX=I:I=20:GOTO3060
3050 IFVT$(I)="***"THENI=20
3060 NEXT I:IFX=21THENPRINT"[198]ILE [212]YPE [201]NVALID":GOTO3020
3070 N=0:FOR I=1TO64:IF U%(I)=229 THEN N=I:I=64
3080 NEXT I:IF N=0 THEN PRINT"[195][208]/[205] [196]IRECTORY [198]ULL":GOTO3560
3090 E=0:DN=1:GOSUB800:OPEN15,8,15:PRINT#15,"I0":OPEN3,8,3,CB$+",S,R":GOSUB900
3100 CLOSE3:CLOSE15:IFDS=62 THEN PRINT"[195][194][205] [198]ILE [206]OT [198]OUND":GOTO3560
3105 BP=BE+1:FE=0:POKE X1,0:POKE X1+1,0:PRINT"[147]";
3120 D=D1+(N-1)*32:POKED,VAL(U$):FORI=D+1TOD+8:POKEI,32:NEXT I
3130 FORI=1TOLEN(CP$):POKED+I,ASC(MID$(CP$,I,1)):NEXT I
3140 FORI=9TO11:POKED+I,ASC(MID$(TY$,I-8,1)):NEXT I:POKED+12,E
3150 POKED+13,0:POKED+14,0
3160 U%(N)=VAL(U$):N$(N)=LEFT$(CP$+" ",8):T$(N)=TY$
3170 NR=D+15:BA=D+16:POKENR,0
3180 FOR I=BATOBA+15:POKEI,0:NEXT I
3190 NB=136:FORI=0TO135:IFPEEK(D3+I)=0THENNB=I:I=135
3200 NEXT I:IFNB=136THENPOKED,229:PRINT"[195][208]/[205] [196]ISK [198]ULL":GOTO3560
3210 POKED3+NB,N
3220 POKEBA,NB:FOR R=1TO8
3230 Y$=""
3240 IFX=1THENY$=Y$+CHR$(10):X=0:GOTO3290
3250 GOSUB350:IFX$=""THENX$=CHR$(0)
3260 A=ASC(X$):Y$=Y$+CHR$(C%(A)):PRINTX$;
3280 IFX$=CHR$(13)THENX=1
3290 Y=LEN(Y$):IFY=128THEN3330
3300 IFCS=64ANDX=0THEN3320
3310 GOTO3240
3320 FORI=Y+1TO128:Y$=Y$+CHR$(26):NEXT I
3330 RA=D2+((NB)*24)+((R-1)*3):T=PEEK(RA):S=PEEK(RA+1):P=PEEK(RA+2)
3335 DN=0:GOSUB800:OPEN 15,8,15:PRINT#15,"I0":OPEN 1,8,2,"#"
3340 PRINT#15,"U1";2;0;T;S:PRINT#15,"B-P";2;P
3350 PRINT#1,Y$;:IFCS=64THENPRINT#15,"U2";2;0;T;S:PRINT#15,"B-P";2;0
3360 PRINT#15,"U2";2;0;T;S:POKENR,(PEEK(NR)+1):CLOSE1:CLOSE15
3370 IFCS=64THENR=8
3380 NEXT R:IFCS=64THEN3450
3390 BA=BA+1
3400 IFPEEK(NR)<128THEN3190
3410 N=0:FOR I=1TO64:IF U%(I)=229 THEN N=I:I=64
3420 NEXT I:IF N=0 THEN PRINT"[195][208]/[205] [196]IRECTORY [198]ULL":GOTO3560
3430 E=E+1:GOTO3120
3450 PRINT:PRINT"[215]RITING [195][208]/[205] [196]IRECTORY":PRINT
3460 DN=0:GOSUB800:OPEN 15,8,15:PRINT#15,"I0":OPEN 1,8,2,"#"
3470 D=D1:FOR S=0TO7:PRINT#15,"B-P";2;0
3480 FOR I=1TO8:PRINT".";
3490 X$="":FOR J=1TO32:X=PEEK(D):X$=X$+CHR$(X):D=D+1:NEXT J
3500 PRINT#1,X$;:IFS=7ANDI=8ANDJ=32THENPRINT#15,"U2";2;0;3;S:PRINT#15,"B-P";2,0
3510 NEXT I
3520 PRINT#15,"U2";2;0;3;S
3530 NEXT S:CLOSE1:CLOSE15
3560 PRINT:PRINT"[208]RESS ANY KEY FOR MENU"
3570 GETA$:IFA$=""THEN3570
3580 GOTO500
9000 DATA 0,0,0,0,0,0,0,0,0,0,169,0,141,68,3,141,69,3,141,62,3,141,63,3
9010 DATA 173,64,3,141,143,3,173,65,3,141,144,3,173,68,3,205,60,3,208,8
9020 DATA 173,69,3,205,61,3,240,22,162,3,32,198,255,32,228,255,32,204,255
9030 DATA 238,68,3,208,224,238,69,3,76,96,3,162,3,32,198,255,32,228,255
9040 DATA 141,255,255,32,204,255,238,68,3,208,3,238,69,3,238,60,3,208,3
9050 DATA 238,61,3,32,183,255,201,64,240,30,173,66,3,205,143,3,208,11
9060 DATA 173,67,3,205,144,3,208,3,76,213,3,238,143,3,208,195,238,144,3
9070 DATA 76,134,3,173,143,3,141,62,3,173,144,3,141,63,3,96
10000 DATA 2ZB,ASM,BAK,BAS,BIN,DAT,DOC,HEX,LIB,LST,MAC,PRN,PRT,SRC,SYM,TEX,TXT
10010 DATA ***