1 REM Ins{nd av Kristoffer Eriksson <5357> 1985-07-09 23.40.34 10 ! save ANIMAL, 1985-07-03 20 ! ++++++++++++++++++++++++++++++++++++++ 30 ! + F|r ABC 800-serien med ISAM. 40 ! + ANIMAL, utg}va 1.0, 1985 50 ! + Av Kristoffer Eriksson <5357> 60 ! + Hj{lpprogram: ANIMCRE 70 ! + Fri kopiering f|r ickekommersiella syften till}ten 80 ! ++++++++++++++++++++++++++++++++++++++ 90 ! Programmet f|rs|ker komma p} vilket objekt (h{r kallat djur) du t{nker p} 100 ! genom att st{lla ett antal ja/nej-fr}gor. Om det visar sig programmet inte 110 ! k{nner till det objekt du t{nker p}, f}r du tillf{lle att tala om f|r 120 ! programmet objektets ben{mning, och en fr}ga det kan anv{nda sig av f|r 130 ! att identifiera objektet. P} s} s{tt utvidgas programmets vetande. 140 ! Fr}gor och objekt lagras i isamregistren ANFR]GOR och ANOBJEKT, d{r de 150 ! h{nger ihop i en bin{rtr{dstruktur. (Dock kan mer {n en fr}ga peka p} 160 ! ett visst objekt) 170 ! 180 ! Programmet ANIMCRE anv{nds f|r att skapa registren, och anropas automa- 190 ! tiskt om de inte finns. Man skulle {ven kunna g|ra ett program f|r att 200 ! omstrukturera programmets vetande, f|r om man inte t{nker sig f|r n{r 210 ! man hittar p} fr}gorna, kan bin{rtr{det bli ganska skevt. 220 ! 230 ! N{r ett nytt objekt matas in, vill programmet veta om det {r "den" eller 240 ! "det". Det g}r att skriva t ex "en mus" i st{llet f|r att f|rst bara 250 ! skriva "mus" och d{refter besvara den/det-fr}gan. 260 ! 270 ! Objekt kan tas bort eller {ndras om man svara "B" respektive "[" i 280 ! i st{llet f|r "J" eller "N" n{r datorn undrar om den gissat r{tt. Fr}gor 290 ! kan {ndras, men ej tas bort, n{r datorn vill ha ett svar p} fr}gan. N{r 300 ! objekt tas bort, f|rsvinner {ven n{rmast f|reg}ende fr}ga. 310 ! 320 ! Objekt har positiva nr, och fr}gor har negativa. 330 ! 340 INTEGER : EXTEND : RANDOMIZE : ! NO RESUME 350 ! 360 Dev$="" ! drive med registren 370 ; CHR$(12) "-------- Animal --------" 380 ; "RETURN = Avsluta, [ = [ndring, B = Borttagning" 390 IF FN\ppningar THEN 440 400 IF FNOmtom THEN 440 410 WHILE FNGissa=0 420 WEND 430 ! 440 CLOSE 450 END 460 ! 470 DEF FN\ppningar LOCAL F 480 ON ERROR GOTO 530 490 F=1 : ISAM OPEN Dev$+"ANFR]GOR" AS FILE F 500 F=2 : ISAM OPEN Dev$+"ANOBJEKT" AS FILE F 510 RETURN 0 520 ! 530 IF ERRCODE=21 THEN CLOSE : CHAIN "ANIMCRE" 540 Z=FNFel(ERRCODE,F) 550 RETURN -1 560 FNEND 570 ! 580 DEF FNOmtom LOCAL Obj$=31 590 ON ERROR GOTO 620 : ISAM READ #2 Obj$ FIRST 600 RETURN 0 ! Ej tom objfil 610 ! 620 IF ERRCODE<>34 THEN 700 630 ; "Jag k{nner inte till n}gra djur {n." 640 ; "N{mn ett djur"; 650 Obj$=FNNyobj$ 660 IF Obj$="" THEN RETURN -1 ! Sluta 670 ON ERROR GOTO 700 : ISAM WRITE #2 Obj$ 680 RETURN 0 690 ! 700 Z=FNFel(ERRCODE,2) : RETURN -1 710 FNEND 720 ! 730 ! ** Mata in ett objekts namn ** 740 DEF FNNyobj$ LOCAL Namn$=160,Genus,P 750 WHILE 1 760 Genus=0 770 ; " (max 25 tecken): "; 780 ON ERROR GOTO 980 : INPUT LINE Namn$ 790 ; 800 Namn$=FNSkipsp$(LEFT$(Namn$,LEN(Namn$)-2),1) 810 IF Namn$="" THEN RETURN "" 820 P=INSTR(1,Namn$," ") 830 IF P=0 THEN P=LEN(Namn$)+1 840 IF FNCaps$(LEFT$(Namn$,P-1))="EN" THEN Genus=1 850 IF FNCaps$(LEFT$(Namn$,P-1))="ETT" THEN Genus=2 860 IF Genus THEN Namn$=FNSkipsp$(Namn$,P+1) 870 WHILE LEN(Namn$)>0 AND LEN(Namn$)<=25 880 WHILE Genus=0 890 ; '[r ' Namn$ ' "Den" eller "Det" (N/T) ? '; 900 Genus=FNSvar("NT"+CHR$(13)) 910 IF 0 WEND 920 MID$(Namn$,1,1)=FNCaps$(LEFT$(Namn$,1)) 930 IF Genus<3 THEN RETURN STRING$(3,255)+CVT%$(1)+CHR$(Genus-1)+Namn$+SPACE$(25-LEN(Namn$)) 940 IF 0 WEND 950 IF Namn$="" THEN ; "Vad}f|rn}got?"; 960 IF LEN(Namn$)>25 THEN ; "F|r l}ngt!"; 970 IF Genus=3 THEN ; "Vad ska det vara f|r n}got d}?"; 980 ; CHR$(7); 990 WEND 1000 FNEND 1010 ! 1020 ! ** Mata in en fr}ga ** 1030 DEF FNNyfr}ga$ LOCAL Fr}ga$=160 1040 ; " (max 80 tecken):" 1050 WHILE 1 1060 ON ERROR GOTO 1160 : INPUT LINE Fr}ga$ 1070 ; 1080 Fr}ga$=FNSkipsp$(FNKillsp$(LEFT$(Fr}ga$,LEN(Fr}ga$)-2)),1) 1090 IF Fr}ga$="" THEN RETURN "" 1100 IF RIGHT$(Fr}ga$,LEN(Fr}ga$))="?" THEN Fr}ga$=LEFT$(Fr}ga$,LEN(Fr}ga$)-1) 1110 IF Fr}ga$="" THEN RETURN "" 1120 MID$(Fr}ga$,1,1)=FNCaps$(LEFT$(Fr}ga$,1)) 1130 IF LEN(Fr}ga$)>80 THEN ; CHR$(7) "F|r l}ng! max 80 tecken:" : GOTO 1170 1140 RETURN STRING$(3,255)+STRING$(6,0)+Fr}ga$+SPACE$(80-LEN(Fr}ga$)) 1150 ! 1160 ; CHR$(7);CHR$(13) SPACE$(80) STRING$(80,8); 1170 WEND 1180 FNEND 1190 ! 1200 DEF FNLagraobj(Obj0$) LOCAL Obj$=31,N 1210 ON ERROR GOTO 1370 : ISAM READ #2 Obj$ INDEX "OBJNR" LAST 1220 N=CVT$%(MID$(Obj$,4,2))+1 1230 Obj$=Obj0$ 1240 MID$(Obj$,4,2)=CVT%$(N) 1250 ON ERROR GOTO 1280 : ISAM WRITE #2 Obj$ 1260 RETURN N 1270 ! 1280 IF ERRCODE<>121 THEN 1380 1290 ON ERROR GOTO 1350 : ISAM READ #2 Obj$ INDEX "NAMN" KEY RIGHT$(Obj0$,7) 1300 ; CHR$(7) "Djuret finns redan. Det tyder p} n}got fel i fr}gekomplexet." 1310 ; "Ska det h{r exemplaret inf|ras {nd} (J/N) ? "; 1320 IF FNSvar("JN")=2 THEN RETURN 0 1330 RETURN CVT$%(MID$(Obj$,4,2)) 1340 ! 1350 IF ERRCODE=120 THEN 1210 ! Dubblerat objektnr (NET-milj|) 1360 GOTO 1380 1370 IF ERRCODE=34 THEN N=1 : GOTO 1230 1380 Z=FNFel(ERRCODE,2) : RETURN -1 1390 FNEND 1400 ! 1410 DEF FNLagrafr}ga(Fr}ga0$) LOCAL Fr}ga$=89,N 1420 ON ERROR GOTO 1510 : ISAM READ #1 Fr}ga$ INDEX "FR]GENR" FIRST 1430 N=CVT$%(MID$(Fr}ga$,4,2))-1 1440 Fr}ga$=Fr}ga0$ 1450 MID$(Fr}ga$,4,2)=CVT%$(N) 1460 ON ERROR GOTO 1490 : ISAM WRITE #1 Fr}ga$ 1470 RETURN N 1480 ! 1490 IF ERRCODE=121 THEN 1420 ! Dubblerat fr}genr (NET-milj|) 1500 GOTO 1520 1510 IF ERRCODE=34 THEN N=-1 : GOTO 1440 1520 Z=FNFel(ERRCODE,1) : RETURN 1 1530 FNEND 1540 ! 1550 ! ** S{tt pekare P (1/2) till N i fr}gepost F ** 1560 DEF FNUpdatfr}ga(F,P,N) LOCAL Fr}ga1$=89,Fr}ga2$=89 1570 IF F=0 THEN RETURN 0 1580 ON ERROR GOTO 1640 : ISAM READ #1 Fr}ga1$ INDEX "FR]GENR" KEY CVT%$(F) 1590 Fr}ga2$=Fr}ga1$ 1600 IF CVT$%(MID$(Fr}ga1$,4+P*2,2))=N THEN RETURN 0 1610 MID$(Fr}ga2$,4+P*2,2)=CVT%$(N) 1620 ISAM UPDATE #1 Fr}ga1$ TO Fr}ga2$ 1630 RETURN 0 1640 IF ERRCODE=123 THEN 1580 ! Kontroll{s. F|rs|k igen 1650 Z=FNFel(ERRCODE,1) : RETURN -1 1660 FNEND 1670 ! 1680 ! ** R{kna pekare till N$, h|gst till Max ** 1690 DEF FNAntpek(N$,Max) LOCAL Fr}ga$=89,Ind$=3,Ind,Ant 1700 Ind$="JA" : Ind=6 1710 WHILE Ind<=8 1720 ON ERROR GOTO 1810 : ISAM READ #1 Fr}ga$ INDEX Ind$ KEY N$ 1730 Ant=Ant+1 1740 WHILE AntN$ THEN 1820 1770 Ant=Ant+1 1780 WEND 1790 RETURN Ant 1800 ! 1810 IF ERRCODE<>120 AND ERRCODE<>34 THEN 1850 1820 Ind=Ind+2 : Ind$="NEJ" 1830 WEND 1840 RETURN Ant 1850 Z=FNFel(ERRCODE,1) : RETURN -1 1860 FNEND 1870 ! 1880 ! ** [ndring av objektnamn. Retur: nytt objnr ** 1890 DEF FN[ndraobj(Obj1$) LOCAL Obj2$=160,N 1900 ; 1910 ; "Vad ska det vara i st{llet f|r ";FNKillsp$(RIGHT$(Obj1$,7)) "?"; 1920 Obj2$=FNNyobj$ 1930 IF Obj2$="" THEN ; "Ingen {ndring." : RETURN 0 1940 IF RIGHT$(Obj1$,6)=RIGHT$(Obj2$,6) THEN RETURN 0 1950 N=FNAntpek(MID$(Obj1$,4,2),2) 1960 IF N<0 THEN RETURN N 1970 IF N>1 THEN RETURN FNLagraobj(Obj2$) ! Nytt namn. Gammalt kvar. 1980 ! Normalt utbyte 1990 MID$(Obj2$,1,5)=MID$(Obj1$,1,5) 2000 ON ERROR GOTO 2030 : ISAM UPDATE #2 Obj1$ TO Obj2$ 2010 RETURN CVT$%(MID$(Obj2$,4,2)) 2020 ! 2030 IF ERRCODE=123 THEN ; CHR$(7) "N}gon annan {ndrade f|re dig." : RETURN 0 2040 IF ERRCODE<>121 THEN 2140 2050 ON ERROR GOTO 2140 : ISAM READ #2 Obj2$ INDEX "NAMN" KEY RIGHT$(Obj2$,7) 2060 N=CVT$%(MID$(Obj2$,4,2)) 2070 ; CHR$(7) "Det djuret finns redan. Ska {ndringen inf|ras {nd} (J/N) ? "; 2080 IF FNSvar("JN")=2 THEN RETURN 0 2090 ! Utbyte mot ett annat som redan finns 2100 ON ERROR GOTO 2140 : ISAM READ #2 Obj2$ INDEX "OBJNR" KEY MID$(Obj1$,4,2) 2110 ISAM DELETE #2 Obj2$ 2120 RETURN N 2130 ! 2140 Z=FNFel(ERRCODE,2) : RETURN -1 2150 FNEND 2160 ! 2170 ! ** Ta bort objekt + fr}ga, l{nka om resten ** 2180 DEF FNBortobj(Nbort,Nkvar,Fbort,Ff|rra,Sf|rra) LOCAL Post$=89,Fil 2190 IF Ff|rra<0 THEN Z=FNUpdatfr}ga(Ff|rra,Sf|rra,Nkvar) : IF Z THEN RETURN Z 2200 ON ERROR GOTO 2330 2210 WHILE Fbort<0 2220 ! Z=FNAntpek(CVT%$(fbort),2) 2230 ! IF Z<0 THEN RETURN Z ELSE IF Z>1 THEN RETURN 0 2240 Fil=1 : ISAM READ #1 Post$ INDEX "FR]GENR" KEY CVT%$(Fbort) 2250 ISAM DELETE #1 Post$ 2260 IF 0 WEND 2270 Z=FNAntpek(CVT%$(Nbort),1) 2280 IF Z<0 THEN RETURN Z ELSE IF Z>0 THEN RETURN 0 2290 Fil=2 : ISAM READ #2 Post$ INDEX "OBJNR" KEY CVT%$(Nbort) 2300 ISAM DELETE #2 Post$ 2310 RETURN 0 2320 ! 2330 Z=FNFel(ERRCODE,Fil) : RETURN -1 2340 FNEND 2350 ! 2360 ! ** [ndra fr}ga ** 2370 DEF FN[ndrafr}ga(Fr}ga1$) LOCAL Fr}ga2$=160,N 2380 ; 2390 ; 'Vad ska det vara i st{llet f|r "';FNKillsp$(RIGHT$(Fr}ga1$,10)) '" ?'; 2400 Fr}ga2$=FNNyfr}ga$ 2410 IF Fr}ga2$="" THEN ; "Ingen {ndring." : RETURN 0 2420 IF RIGHT$(Fr}ga1$,10)=RIGHT$(Fr}ga2$,10) THEN RETURN 0 2430 MID$(Fr}ga2$,1,9)=MID$(Fr}ga1$,1,9) 2440 ON ERROR GOTO 2470 : ISAM UPDATE #1 Fr}ga1$ TO Fr}ga2$ 2450 RETURN 0 2460 ! 2470 IF ERRCODE=123 THEN ; CHR$(7) "N}gon annan {ndrade f|re dig." : RETURN 0 2480 Z=FNFel(ERRCODE,1) : RETURN -1 2490 FNEND 2500 ! 2510 DEF FNGissa LOCAL Fr}ga$=89,Obj$=31,X,F,Ff|rra,S,Sf|rra,N,N2 2520 ; 2530 ; "T{nk p} ett djur!" 2540 X=-1 2550 WHILE X<0 2560 Sf|rra=S : Ff|rra=F 2570 F=X 2580 ON ERROR GOTO 2860 : ISAM READ #1 Fr}ga$ INDEX "FR]GENR" KEY CVT%$(F) 2590 ; FNKillsp$(RIGHT$(Fr}ga$,10)) " (J/N) ? "; 2600 S=FNSvar("JN[B"+CHR$(13)) 2610 IF S=3 THEN X=FN[ndrafr}ga(Fr}ga$) : IF X=0 THEN 2580 ELSE RETURN X 2620 IF S=4 THEN ; CHR$(7) "Fr}gor tas bara bort tillsammans med djur." : GOTO 2590 2630 IF S=5 THEN RETURN (F=-1) 2640 N2=CVT$%(MID$(Fr}ga$,4+(3-S)*2,2)) 2650 X=CVT$%(MID$(Fr}ga$,4+S*2,2)) 2660 WEND 2670 N=X 2680 ON ERROR GOTO 2880 : ISAM READ #2 Obj$ INDEX "OBJNR" KEY CVT%$(N) 2690 X=FNKollagissn(Obj$,"JN[B"+CHR$(13)) 2700 IF X=1 THEN RETURN 0 ! R{tt. Klart. 2710 WHILE X=3 2720 X=FN[ndraobj(Obj$) 2730 IF X>0 THEN RETURN FNUpdatfr}ga(F,S,X) ELSE RETURN X 2740 WEND 2750 WHILE X=4 2760 ; 2770 ; "Ta bort " FNKillsp$(RIGHT$(Obj$,7)) " (J/N) ? "; 2780 IF FNSvar("JN")=1 THEN RETURN FNBortobj(N,N2,F,Ff|rra,Sf|rra) 2790 GOTO 2690 2800 WEND 2810 IF X=5 THEN RETURN -1 ! Avsluta 2820 X=FNUt|k(F,S,N,FNKillsp$(RIGHT$(Obj$,7))) 2830 IF X=1 THEN 2690 2840 RETURN X 2850 ! 2860 IF ERRCODE=120 AND F=-1 THEN F=0 : N=1 : GOTO 2680 2870 Z=FNFel(ERRCODE,1) : RETURN -1 2880 Z=FNFel(ERRCODE,2) : RETURN -1 2890 FNEND 2900 ! 2910 ! ** Ut|ka tr{det med fr}ga + objekt ** 2920 DEF FNUt|k(F,S,N,Namn1$) LOCAL Fr}ga$=89,Obj$=31,Namn2$=25,X,N2 2930 ; 2940 ; "Vilket djur {r det d}?"; 2950 Obj$=FNNyobj$ 2960 IF Obj$="" THEN ; "Inget lagrat." : RETURN 0 2970 Namn2$=FNKillsp$(RIGHT$(Obj$,7)) 2980 IF FNCaps$(Namn1$)=FNCaps$(Namn2$) THEN ; CHR$(7) "Det var ju det jag gissade!" : RETURN 1 2990 ; "Skriv in en ja/nej-fr}ga som skiljer mellan " Namn1$ " och " Namn2$; 3000 Fr}ga$=FNNyfr}ga$ 3010 IF Fr}ga$="" THEN 2940 3020 ; "Vad ska " Namn2$ " ge f|r svar p} den fr}gan? Ja eller Nej? "; 3030 X=FNSvar("JN"+CHR$(13)) 3040 IF X=3 THEN 2990 3050 N2=FNLagraobj(Obj$) 3060 IF N2=0 OR N2=-1 THEN RETURN N2 3070 MID$(Fr}ga$,4+(3-X)*2,2)=CVT%$(N) 3080 MID$(Fr}ga$,4+X*2,2)=CVT%$(N2) 3090 X=FNLagrafr}ga(Fr}ga$) 3100 IF X=1 THEN RETURN -1 3110 RETURN FNUpdatfr}ga(F,S,X) 3120 FNEND 3130 ! 3140 ! ** Fr}ga om datorn gissat r{tt ** 3150 DEF FNKollagissn(Obj$,Alt$) LOCAL Genus,T$=29 3160 T$=FNKillsp$(RIGHT$(Obj$,7)) 3170 Genus=ASCII(MID$(Obj$,6,1)) 3180 IF Genus THEN T$="ett "+T$ ELSE T$="en "+T$ 3190 ON INT(RND*5)+1 GOSUB 3220,3230,3240,3250,3260 3200 ; " (J/N) ? "; 3210 RETURN FNSvar(Alt$) 3220 ; "Jag gissar att det {r " T$ ". St{mmer det"; : RETURN 3230 ; "Kan det vara " T$; : RETURN 3240 ; "Jag tror det {r " T$ "! [r det r{tt"; : RETURN 3250 ; "Det m}ste vara " T$ "! Eller hur"; : RETURN 3260 ; "[r det " T$; : RETURN 3270 FNEND 3280 ! 3290 DEF FNFel(Ec,F) LOCAL I$=1 3300 ; CHR$(7) "Felkod" Ec; 3310 WHILE F 3320 ; "p} ISAM-registret '"; 3330 IF F=1 THEN ; "ANFR]GOR'" 3340 IF F=2 THEN ; "ANOBJEKT'" 3350 IF 0 WEND 3360 ! 3370 ; "Tryck p} CE"; 3380 WHILE I$<>CHR$(24) : GET I$ : WEND 3390 RETURN Ec 3400 FNEND 3410 ! 3420 DEF FNKillsp$(S$) LOCAL P 3430 P=LEN(S$) 3440 WHILE P 3450 IF MID$(S$,P,1)=" " THEN P=P-1 : WEND 3460 RETURN LEFT$(S$,P) 3470 FNEND 3480 ! 3490 DEF FNSvar(Alt$) LOCAL I$=160,P 3500 WHILE 1 3510 ON ERROR GOTO 3560 : INPUT LINE I$ 3520 P=LEN(I$)-2 : ; STRING$(P,8) SPACE$(P) STRING$(P,8); 3530 I$=FNCaps$(LEFT$(I$,1)) 3540 P=INSTR(1,Alt$,I$) 3550 IF P THEN ; MID$(Alt$,P,1) : RETURN P 3560 ; CHR$(7); 3570 WEND 3580 FNEND 3590 ! 3600 DEF FNCaps$(S$) LOCAL T$=160,P 3610 T$=S$ 3620 WHILE P="`" THEN MID$(T$,P,1)=CHR$(ASCII(MID$(T$,P,1))-32) 3640 WEND 3650 RETURN T$ 3660 FNEND 3670 ! 3680 DEF FNSkipsp$(S$,P) 3690 IF P>LEN(S$) THEN RETURN "" 3700 WHILE P<=LEN(S$) 3710 IF MID$(S$,P,1)=" " THEN P=P+1 : WEND 3720 RETURN RIGHT$(S$,P) 3730 FNEND