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 Ant