1 REM Ins{nd av 7390 Ny Medlem <7390> 1987-10-30 00.44.28 (SEND)
1000 ! UFDGRUND.BAS
1002 ! ------------
1004 !
1006 ! Unsqueezad vers, d{rav lite konstiga variabelnamn.
1008 !
1010 ! Detta {r ett funktionsbibliotek, som sk|ter UFD-
1012 ! hanteringen direkt i BASIC. Detta kan vara mycket
1014 ! anv{ndbart ibland.
1016 !
1018 ! Jag har givit huvudinstruktionerna nya namn, f|r
1020 ! b{ttre f|rst}else, jag har {nnu ej hunnit g} in
1022 ! djupare i programmet, d{rf|r har alla underfunk-
1024 ! tioner f}tt beh}lla sina mindre f|rst}liga namn.
1026 ! (Detta kanske blir en utmaning f|r n}gon?)
1028 !
1030 ! Nedan f|ljer beskrivning p} huvudfunktionerna:
1032 !
1034 ! FNBytufd(X$)
1036 ! . Byter aktivt UFD till inneh}llet i X$
1038 !
1040 ! FNFader(X$)
1042 ! . Byter till faderbiblioteket
1044 ! . {r ej s{ker p} vad X$ skall inneh}lla, kanske
1046 ! . g{llande bibliotek.
1048 !
1050 ! FNCreate(Lc$,Ld$)
1052 ! . Ej s{ker p} inneh}llet i Lc$, kanske g{llande UFD
1054 ! . Ld$ - UFD att skapa
1056 !
1058 ! FNDelete(X$)
1060 ! . Tar bort UFD X$
1062 !
1064 ! FNRename(Lc$,Ld$)
1066 ! . Byter namn p} UFD Lc$ till UFD Ld$
1068 !
1070 !
1072 ! D} stor os{kerhet r}der om vad som {r vad, f}r
1074 ! man se dessa ufdfunktioner som forsknings-
1076 ! projekt.
1078 !
1080 ! Mvh Lars B. Cid <7390> 871029 00.33
1082 !
1084 !
1086 STOP
1088 Z=FNR79 ! Detta m}ste tydligen g|ras (initierar variabler)
1090 !
1092 DEF FNR79 LOCAL La$=67,Lb,Lc
1094 C=0
1096 D=-1
1098 E=PEEK(65364)
1100 F=(PEEK(24688)=8)
1102 G=15*4096+13*256+5*16
1104 RETURN C
1106 FNEND
1108 DEF FNR3793$(La$) LOCAL Lb
1110 IF F OR La$='' THEN RETURN CHR$(PEEK(-9),PEEK(-8),PEEK(-7))
1112 Lb=1
1114 WHILE Lb<=3
1116 POKE -10+Lb,ASCII(MID$(La$,Lb,1))
1118 Lb=Lb+1
1120 WEND
1122 RETURN ''
1124 FNEND
1126 DEF FNR3889$(La$) LOCAL Lb$=16,Lc$=16,Ld$=16,Le
1128 Lb$=La$
1130 Lc$=SPACE$(8+3+3)
1132 Ld$=CHR$(33,VARPTR(Lb$),SWAP%(VARPTR(Lb$)),1,LEN(Lb$),0,205,99,0,33,255,255,216,35,201)
1134 IF CALL(VARPTR(Ld$),VARPTR(Lc$)) THEN RETURN ''
1136 Le=PEEK2(-133)
1138 WHILE Le
1140 IF CHR$(PEEK(Le+2),PEEK(Le+3),PEEK(Le+4))=MID$(Lc$,12,3) THEN RETURN CHR$(PEEK(Le+7),255)+Lc$
1142 Le=PEEK2(Le)
1144 WEND
1146 RETURN CHR$(254,255)+Lc$
1148 FNEND
1150 DEF FNR4099(La,Lb) LOCAL Lc
1152 POKE 64769,La
1154 Lc=CALL(24678,Lb)
1156 IF PEEK(64789)=0 THEN RETURN 0
1158 IF (PEEK(64789) AND 128)=128 THEN RETURN 42
1160 IF (PEEK(64789) AND 16)=16 THEN RETURN 48
1162 IF (PEEK(64789) AND 8)=8 THEN RETURN 48
1164 RETURN -1
1166 FNEND
1168 DEF FNBytufd(La$) LOCAL Lb,Lc,Ld$=67,Le
1170 IF LEN(La$)=0 THEN GOTO 1178
1172 IF RIGHT$(La$,LEN(La$))<>':' THEN GOTO 1182
1174 C1=FNR4806(La$)
1176 IF C1=0 THEN RETURN -1 ELSE IF C1=30 THEN RETURN 0
1178 IF PEEK(24688)<>8 THEN POKE -9,0,0,C1 : RETURN 0
1180 IF C1<>27 AND C1<>30 AND C1<>31 THEN ON ERROR GOTO 1214 : ; '' : ON ERROR GOTO : RETURN 0
1182 ON ERROR GOTO 1214
1184 IF PEEK(24688)=8 THEN ; La$ : RETURN 0
1186 ON ERROR GOTO
1188 Lb=1
1190 Lc=1
1192 Le=0
1194 WHILE Lc<>0
1196 Lc=INSTR(Lb,La$,'/')
1198 IF Lc=0 THEN Ld$=RIGHT$(La$,Lb) ELSE Ld$=MID$(La$,Lb,Lc-Lb)
1200 IF LEN(Ld$)>12 THEN RETURN -1
1202 IF FNR4538(Ld$,Le) THEN RETURN -1
1204 Lb=Lc+1
1206 Le=-1
1208 IF Lb>LEN(La$) THEN Lc=0
1210 WEND
1212 RETURN 0
1214 RETURN ERRCODE
1216 FNEND
1218 DEF FNR4538(La$,Lb) LOCAL Lc$=16,Ld,Le$=16
1220 IF La$='' THEN Ld=0 : GOTO 1240
1222 Le$=FNR3889$(La$)
1224 IF Le$='' OR ASCII(Le$)=254 THEN RETURN -1
1226 IF MID$(Le$,11,3)<>' ' THEN RETURN -1
1228 MID$(Le$,11,3)='Ufd'
1230 IF Lb THEN C1=30 ELSE C1=ASCII(Le$)
1232 Lc$=CHR$(1,C1,0,205,24,96,216,33,0,0,201)
1234 IF CALL(VARPTR(Lc$),VARPTR(Le$)+2) THEN RETURN -1
1236 Ld=PEEK2(-704+8)+2
1238 IF PEEK(-704+1)<>30 THEN POKE PEEK2(24685)+2,PEEK(-704+1)
1240 POKE PEEK2(24685),Ld,SWAP%(Ld)
1242 POKE -704+1,255
1244 RETURN 0
1246 FNEND
1248 DEF FNR4806(La$) LOCAL Lb,Lc$=70,Ld
1250 IF RIGHT$(La$,LEN(La$))=":" THEN Lc$=LEFT$(La$,LEN(La$)-1) ELSE Lc$=La$
1252 Lc$=FNR9391$(Lc$)
1254 WHILE LEN(Lc$)<3
1256 Lc$=Lc$+" "
1258 WEND
1260 Ld=PEEK2(65403)
1262 WHILE Ld
1264 Lb=0
1266 WHILE Lb<3
1268 Lb=Lb+1
1270 IF PEEK(Ld+1+Lb)<>ASCII(RIGHT$(Lc$,Lb)) THEN GOTO 1276
1272 WEND
1274 GOTO 1282
1276 Ld=PEEK2(Ld)
1278 WEND
1280 RETURN 0
1282 Lb=PEEK(Ld+7)
1284 IF Lb>3 THEN RETURN Lb
1286 RETURN PEEK(PEEK2(24683))
1288 FNEND
1290 DEF FNCreate(La$,Lb$) LOCAL Lc$=8,Ld$=14,Le$=0,Lf$=12,Lg$=8,Lh$=23,Li,Lj,Lk,Ll,Lm,Ln,Lo,Lp,Lq,Lr$=16,Ls$=70,Lt,Lu
1292 Lg$=FNR11487$(8,Lb$)
1294 Lc$=CHR$(33,48,0,201,33,43,0,201)
1296 Ll=0
1298 WHILE Ll<=8
1300 Ld$=CHR$(14,Ll,205,69,96,201)
1302 IF Ll=8 THEN Lt=4 ELSE Lt=0
1304 Li=CALL(VARPTR(Ld$),VARPTR(Lc$)+Lt)
1306 Ll=Ll+1
1308 WEND
1310 X$=FNR3793$('')
1312 IF F THEN J1$=La$ : GOTO 1326
1314 V$=FNR8319$(La$)
1316 IF ASCII(V$)<>0 THEN Li=21 : GOTO 1434
1318 J1$=RIGHT$(V$,2)
1320 IF PEEK2(-9)=0 THEN Lq=PEEK(-7) ELSE Lq=30
1322 Lk=PEEK2(-9)
1324 GOTO 1344
1326 Lq=FNR4806(J1$)
1328 IF Lq=0 THEN Lq=255
1330 K1$=CHR$(1,Lq,16,205,24,96,33,255,255,216,35,201)
1332 IF Lq<>255 THEN J1$=RIGHT$(J1$,INSTR(1,J1$,':')+1) : Lr$=FNR6660$(J1$) : Ll=INSTR(1,Lr$,CHR$(255)) : Lr$=LEFT$(Lr$,Ll-1)
1334 IF INSTR(1,J1$,'/')<>0 THEN Lu=D : GOTO 1344
1336 IF Lr$='' THEN Lr$=SPACE$(11) ELSE Lr$=FNR7159$(Lr$)
1338 IF CALL(VARPTR(K1$),VARPTR(Lr$))<>0 THEN Li=21 : GOTO 1418 ELSE Lk=PEEK2(-680)+2 : IF Lk=2 THEN Lk=0
1340 Li=FNR7038(16)
1342 IF Li<>0 THEN GOTO 1434
1344 K1$=CHR$(1,Lq,16,205,24,96,33,255,255,216,35,201)
1346 M1$=J1$
1348 J1$=FNR7159$(J1$)
1350 IF CALL(VARPTR(K1$),VARPTR(J1$))=0 THEN Li=40 : GOTO 1434
1352 Li=FNR7038(16)
1354 IF Li<>0 THEN GOTO 1434
1356 POKE VAROOT(Le$),0,1,0,246,0,1
1358 IF F THEN O1$=CHR$(1,Lq,16,205,21,96,201) ELSE O1$=CHR$(1,Lq,16,205,21,96,33,48,0,216,33,0,0,201)
1360 Li=CALL(VARPTR(O1$),VARPTR(J1$))
1362 IF Li<>0 THEN GOTO 1426
1364 IF Lu THEN Lk=PEEK2(-676)
1366 Le$=CHR$(0,0,0,Lk,SWAP%(Lk),PEEK(G))+STRING$(226,0)+STRING$(7,0)+STRING$(16,0)+CHR$(0)
1368 Li=FNR4099(Lq,14)
1370 IF Li<>0 THEN GOTO 1426 ELSE MID$(Le$,256,1)=CHR$(PEEK(62720+255))
1372 Lf$=CHR$(1,Lq,16,205,48,96,33,0,0,216,235,201)
1374 Lo=CALL(VARPTR(Lf$))
1376 IF Lo=0 THEN Li=36 : GOTO 1426
1378 Le$=STRING$(256,255)
1380 IF F THEN POKE G+15,(PEEK(G+15) OR 128)
1382 Lh$=CHR$(6,16,205,18,96,33,255,255,216,35,201)
1384 Lj=PEEK2(-680)
1386 Ll=1
1388 WHILE Ll<=16
1390 Lp=CALL(VARPTR(Lf$))
1392 IF Lp=0 THEN Li=36 : GOTO 1426 ELSE IF Lp<>Lo+1 THEN Li=41 : GOTO 1426
1394 MID$(Le$,1,3)=STRING$(3,255)
1396 IF NOT F THEN IF CALL(VARPTR(Lh$),Lj+Ll+1)<>0 THEN Li=36 : GOTO 1426
1398 Ll=Ll+1
1400 Lo=Lp
1402 WEND
1404 Li=FNR7038(16)
1406 IF Li<>0 THEN GOTO 1426
1408 IF (NOT F) OR (Lg$=SPACE$(8)) THEN GOTO 1418 ELSE J1$=M1$+'/'+CHR$(13)
1410 Li=CALL(VARPTR(K1$),VARPTR(J1$))
1412 IF Li<>0 THEN GOTO 1426
1414 Li=FNR14063(14+16,11,16,4,VARPTR(Lg$)/256,MOD(VARPTR(Lg$),256))
1416 IF Li<>0 THEN Li=36 : GOTO 1426
1418 Li=FNR7038(16)
1420 X$=FNR3793$(X$)
1422 Li=0
1424 GOTO 1438
1426 Ld$=CHR$(6,16,205,36,96,205,33,96,33,255,255,216,35,201)
1428 Ll=CALL(VARPTR(Ld$),-1)
1430 Li=36
1432 ! *
1434 X$=FNR3793$(X$)
1436 Ln=FNR7038(16)
1438 Ll=0
1440 WHILE Ll<=8
1442 Ld$=CHR$(14,Ll,205,69,96,201)
1444 Ln=CALL(VARPTR(Ld$),0)
1446 Ll=Ll+1
1448 WEND
1450 RETURN Li
1452 FNEND
1454 DEF FNR6660$(La$) LOCAL Lb
1456 Lb=LEN(La$)
1458 WHILE MID$(La$,Lb,1)<>'/' AND MID$(La$,Lb,1)<>':' AND Lb>1
1460 Lb=Lb-1
1462 WEND
1464 IF Lb=1 THEN RETURN CHR$(255)+La$
1466 IF MID$(La$,Lb,1)=':' THEN RETURN LEFT$(La$,Lb)+CHR$(255)+RIGHT$(La$,Lb+1)
1468 RETURN LEFT$(La$,Lb-1)+CHR$(255)+RIGHT$(La$,Lb+1)
1470 FNEND
1472 DEF FNR6823(La$,Lb) LOCAL Lc$=4,Ld$=63,Le,Lf$=15
1474 U1=INSTR(1,La$,':')
1476 IF U1=0 THEN Ld$=La$ ELSE Lc$=LEFT$(La$,U1) : Ld$=RIGHT$(La$,U1+1)
1478 IF U1=0 THEN IF PEEK2(-9)=0 THEN Le=PEEK(-7) : GOTO 1484 ELSE Le=30 : GOTO 1484
1480 Le=FNR4806(FNR9391$(Lc$))
1482 IF Le=0 THEN RETURN 21
1484 Lf$=CHR$(14,Le,6,Lb,205,24,96,33,255,255,216,33,0,0,201)
1486 IF CALL(VARPTR(Lf$),VARPTR(Ld$))<>0 THEN RETURN 21 ELSE RETURN 0
1488 FNEND
1490 DEF FNR7038(La) LOCAL Lb$=6,Lc
1492 Lb$=CHR$(6,La,205,33,96,201)
1494 Lc=CALL(VARPTR(Lb$))
1496 RETURN 0
1498 FNEND
1500 DEF FNR7093(La) LOCAL Lb$=13
1502 Lb$=CHR$(6,La,205,45,96,33,255,255,216,33,0,0,201)
1504 RETURN CALL(VARPTR(Lb$))
1506 FNEND
1508 DEF FNR7159$(La$) LOCAL Lb,Lc
1510 Lb=LEN(La$)
1512 WHILE MID$(La$,Lb,1)<>'/' AND MID$(La$,Lb,1)<>':' AND Lb>1
1514 Lb=Lb-1
1516 WEND
1518 IF MID$(La$,Lb,1)='/' OR MID$(La$,Lb,1)=':' THEN Lb=Lb+1
1520 Lc=Lb
1522 WHILE Lc