1 REM Ins{nd av Kristoffer Eriksson <5357> 1985-07-09 22.42.58 10 ! save ANIMCRE, 1985-07-29 20 ! ++++++++++++++++++++++++++++++++++++++ 30 ! + F|r ABC 800-serien. 40 ! + ANIMCRE, Utg}va 1.0, 1985 50 ! + Av Kristoffer Eriksson <5357> 60 ! + Hj{lpprogram till ANIMAL. 70 ! + Fri kopiering f|r ickekommersiella syften till}ten. 80 ! ++++++++++++++++++++++++++++++++++++++ 90 ! Skapa register 100 ! 110 ! DATA: Antal index, Postl{ngd, 120 ! . Indexnamn, Duplicerade nycklar?, Startpos, L{ngd, Typ ... 130 ! Typer B=Bin{rt, A=ASCII, I=Integer, F=Float Single, D=Float Double, C=BCD 140 ! (0=Bin{rt, 1=ASCII, 2=Integer, 3=Float Single, 4=Float Double, 5=BCD) 150 ! Duplicerade nycklar: D och J betyder Ja, allt annat ({ven tom) Nej. 160 ! 170 ! 180 EXTEND 190 INTEGER 200 Dv$="" 210 IF Chain$="" THEN LET Chain$="ANIMAL" 220 ; CHR$(12) 'Skapa register till "Animal"' 230 ; STRING$(80,ASCII("-")) : ; 240 ! 250 ! *** ANFR]GOR 260 ! F{ltnamn Typ Startpos, L{ngd som index, Verklig l{ngd i posten 270 ! --------------------------------------------------------------------- 280 ! Lisamfyllnad B 1 - 3 290 ! FR]GENR I 4 2 2 300 ! JA I 6 2 2 310 ! NEJ I 8 2 2 320 ! FR]GA A 10 - 80 330 ! Summa: 89 bytes 340 ! --- 350 ! 360 DATA 3, 89 370 DATA FR]GENR, N, 4, 2, I 380 DATA JA, J, 6, 2, I 390 DATA NEJ, J, 8, 2, I 400 ! 410 RESTORE 360 420 Z=FNMakeit("ANFR]GOR","Fr}geregistret",0) ! --slslsl 430 ! 440 ! 450 ! 460 ! *** ANOBJEKT 470 ! F{ltnamn Typ Startpos, L{ngd som index, Verklig l{ngd i posten 480 ! --------------------------------------------------------------------- 490 ! Lisamfyllnad B 1 - 3 500 ! OBJNR I 4 2 2 510 ! GENUS B 6 - 1 520 ! NAMN A 7 25 25 530 ! Summa: 31 bytes 540 ! --- 550 ! 560 DATA 2, 31 570 DATA OBJNR, N, 4, 2, I 580 DATA NAMN, N, 7, 25, A 590 ! 600 RESTORE 560 610 Z=FNMakeit("ANOBJEKT","Ben{mningsregistret",0) ! --slslsl 620 ! 630 ! 640 ! 650 ! --- 660 ! 670 ; "Klart." 680 I=0 : WHILE I<700 AND SYS(5)<128 690 I=I+1 700 WEND 710 IF SYS(5)>127 THEN GET I$ 720 ! 730 ! ON ERROR GOTO 1110 : CHAIN "RAM:"+Chain$ 740 ON ERROR GOTO 750 : CHAIN Chain$ 750 ; RED NWBG YEL CHR$(7) "> Hittar inte programmet '" Chain$ "' <" BLBG 760 IF ERRCODE<>21 THEN ; "( Felkod" ERRCODE ")" 770 ; "Tryck p} CE..."; 780 I$="" : WHILE I$<>CHR$(24) : GET I$ : WEND 790 ON ERROR GOTO 800 : CHAIN "XS0" 800 END 810 ! 820 ! 830 ! 840 DEF FNFel(N,Typ) LOCAL Gt$=1 850 ; CHR$(7) RED NWBG YEL "> "; 860 IF Typ=1 THEN ; FNBasicfel$(N); : GOTO 880 870 ON N GOSUB 910 880 ; " <" BLBG 890 GET Gt$ 900 RETURN N OR SWAP%(Typ) 910 ; ; : RETURN 920 FNEND 930 ! 940 DEF FNBasicfel$(X) 950 IF X=21 THEN RETURN "Filen finns ej" 960 IF X=22 THEN RETURN "Biblioteket finns ej" 970 IF X=48 THEN RETURN "Fel i biblioteket" 980 IF X=35 THEN RETURN "Kontrollsummafel vid l{sning" 990 IF X=36 THEN RETURN "Kontrollsummafel vid skrivning." 1000 IF X=39 THEN RETURN "Filen skrivskyddad" 1010 IF X=40 THEN RETURN "Filen l{sskyddad" 1020 IF X=41 THEN RETURN "Skivan {r full" 1030 IF X=42 THEN RETURN "Enheten ej klar" 1040 IF X=43 THEN RETURN "Skivan skrivskyddad" 1050 IF X=46 THEN RETURN "Biblioteket ej inst{llt" 1060 IF X=52 THEN RETURN "G}r inte p} denna enhet" 1070 IF X=51 THEN RETURN "Enheten upptagen" 1080 RETURN "Felkod "+NUM$(X) 1090 FNEND 1100 ! 1110 DEF FNPrep(F$,T$) LOCAL I$=160 1120 ; T$ 1130 ON ERROR GOTO 1250 1140 OPEN Dv$+F$+".ISM" AS FILE 1 : OPEN Dv$+F$+".ISD" AS FILE 2 1150 CLOSE 1160 ; CHR$(7); 1170 ; "Registret finns redan! "; 1180 ; "Ska det verkligen " FLSH "raderas" STDY; 1190 ON ERROR GOTO 1170 : INPUT " J/N ? ";I$ : ON ERROR GOTO 1200 IF I$="" THEN 1170 1210 I$=CHR$(ASCII(I$) AND 95) 1220 IF I$="N" THEN ; "Registret {r kvar." : ; : RETURN -1 1230 IF I$<>"J" THEN 1160 1240 ! 1250 ON ERROR GOTO 1350 1260 ; "Registret skapas ..." CHR$(13); 1270 PREPARE Dv$+F$+".ISD" AS FILE 1 : CLOSE 1 1280 PREPARE Dv$+F$+".ISM" AS FILE 2 1290 RETURN 0 1300 ! 1310 IF ERRCODE=21 THEN 1250 1320 Z=FNFel(ERRCODE,1) 1330 GOTO 1180 1340 ! 1350 Z=FNFel(ERRCODE,1) : RETURN -1 1360 FNEND 1370 ! 1380 DEF FNIsinit(F$) LOCAL Ant,Ind,N$=8,I 1390 ON ERROR GOTO 1680 1400 PUT #2 CHR$(1) ! Isamfilversion 1410 PUT #2 CHR$(255)+F$+SPACE$(8-LEN(F$))+"ISD"+CHR$(3) 1420 READ Ant 1430 PUT #2 CVT%$(Ant+1) ! Antal index + 1 1440 PUT #2 STRING$(9,0) 1450 READ I 1460 PUT #2 CVT%$(I) ! Postl{ngd 1470 Ind=1 1480 WHILE Ind<=Ant 1490 READ N$ 1500 PUT #2 N$+SPACE$(8-LEN(N$))+CHR$(3) ! Indexnamn 1510 PUT #2 CVT%$(Ind) ! Indexnr 1520 READ N$ 1530 I=0 : IF LEN(N$) THEN I=INSTR(1,"DdJj",N$) AND 1 1540 PUT #2 CHR$(I) ! Duplicerade nycklar till}tna? 1550 READ I 1560 PUT #2 CVT%$(I) ! Startpos i post 1570 READ I 1580 PUT #2 CHR$(I) ! L{ngd p} index 1590 READ N$ 1600 I=INSTR(1,"BAIFDC",N$)-1 ! Bin, ASC, Int, Float singel, Double, BCD 1610 PUT #2 CHR$(I) ! Typ 1620 PUT #2 CHR$(0,0,0,0) 1630 Ind=Ind+1 1640 WEND 1650 PUT #2 STRING$(2530+253-MOD(POSIT(2),253),0) 1660 CLOSE 1670 RETURN 0 1680 Z=FNFel(ERRCODE,1) 1690 CLOSE : RETURN -1 1700 FNEND 1710 ! 1720 DEF FNMakeit(F$,T$,Stat) 1730 IF FNPrep(F$,T$) THEN RETURN -1 1740 IF FNIsinit(F$) THEN RETURN -1 1750 ! Z=FNIschmod(F$,Stat) 1760 ; "Registret {r nu skapat." : ; 1770 RETURN 0 1780 FNEND