1 REM +++++++++++++++++++++++++++++++++
2 REM ! Program .... HAJFISK
3 REM ! Kommenterad i ABC-BLADET 1985:2
4 REM ! gjort av Sven Wickberg <1384>
6 REM ! Minne 16 Kbytes
7 REM ! Ins{nt av Sven Wickberg <1384>
8 REM +++++++++++++++++++++++++++++++++
10 REM HAJFISK
11 REM 84 02 28 Sven Wickberg
30 REM --------------------------------
40 REM |ppna printer
50 W%=1%
60 OPEN 'pr:' ASFILE W%
80 REM --------------------------------
90 REM initiering, variabler etc
200 ]1%=1% : REM fisk}lder vid fortpl
210 ]2%=9% : REM haj}lder vid fortpl
220 ]3%=1% : REM tid f|r hajsv{lt
300 R0%=3% : R9%=16% : REM gr{nser f|r rad
310 K0%=5% : K9%=37% : REM gr{nser f|r kol
350 DIM F%(R9%+1%,K9%+1%),H%(R9%+1%,K9%+1%),S%(R9%+1%,K9%+1%),D%(R9%+1%,K9%+1%)
400 RANDOMIZE
410 ; CHR$(12%);
450 GOSUB 1000 : REM "skapelsen"
460 REM -------------------------------
500 REM huvudprogram
600 GOSUB 1500 : REM nollst{ll "dragmak|ren" D%()
700 GOSUB 2000 : REM hajflytt
800 GOSUB 4000 : REM fiskflytt
900 GOSUB 5000 : REM rita spelplan
910 GOTO 600
1000 REM ------------------------------
1010 REM skapelsen
1020 FOR R%=R0% TO R9%
1030 FOR K%=K0% TO K9%
1035 ; CUR(R%,K%);
1040 IF RND>.3 THEN 1070
1041 REM IF F%>200% THEN 1070
1050 ; '.'; : F%=F%+1%
1060 F%(R%,K%)=1%+RND*]1% : GOTO 1100
1065 REM ---------
1070 IF RND>.2 THEN ; ' '; : GOTO 1100
1071 REM IF H%>20% THEN 1100
1080 ; 'O'; : H%=H%+1%
1090 H%(R%,K%)=1%+RND*]2% : S%(R%,K%)=RND*]3%
1100 NEXT K%
1110 NEXT R%
1120 ; CUR(22%,0%)F%;H%;' ']1%;]2%;]3%
1130 ; #W%,'start: fiskar'F%',hajar'H%',]1']1%',]2']2%',]3']3%
1140 REM ------------------------------
1500 REM nollst{ll D%() "dragmark|r"
1510 FOR R%=R0% TO R9%
1520 FOR K%=K0% TO K9%
1530 D%(R%,K%)=0%
1540 NEXT K%
1550 NEXT R%
1560 RETURN
1570 REM ---------------------------
1600 REM "g} |ver kanten" (wrap around)
1610 IF Q%R9% THEN Q%=R0%
1640 IF P%>K9% THEN P%=K0%
1650 RETURN
2000 REM ------------------------------
2010 REM hajen flyttar
2020 FOR R%=R0% TO R9%
2030 FOR K%=K0% TO K9%
2032 IF H%(R%,K%)=0% THEN 2500 : REM ingen haj
2033 IF D%(R%,K%) THEN 2500 : REM redan flyttad
2045 REM -----------------
2050 REM kolla omgivningen
2060 X%=0% : Y%=0%
2070 FOR I%=-1% TO 1%
2080 FOR J%=-1% TO 1%
2090 Q%=R%+I% : P%=K%+J%
2100 GOSUB 1600 : REM wrap around
2110 IF F%(Q%,P%)=0% THEN 2150 : REM ingen fisk
2120 Y%=Y%+1% : F1%(Y%)=Q% : G1%(Y%)=P% : REM r{kna fiskarna och h}ll deras l{gen
2130 IF Y%>0% THEN 2180 : REM fisk finns, hoppa |ver hajarna
2140 REM -----------------
2150 REM kolla haj
2160 IF H%(Q%,P%) THEN 2180 : REM rutan upptagen
2170 X%=X%+1% : H1%(X%)=Q% : I1%(X%)=P% : REM r{kna tomrummen och h}ll deras l{gen
2180 NEXT J%
2190 NEXT I%
2195 REM -----------------------------
2200 REM omgivningen klar - }tg{rder
2210 IF Y%=0% THEN 2280 : REM ingen fisk, s|k tomrum
2220 GOSUB 2800 : REM v{lj fisk P,Q
2230 S%(R%,K%)=0% : REM sv{lt slut
2240 S%(Q%,P%)=0%
2250 F%(Q%,P%)=0% : REM fisk upp{ten
2255 A$=' ' : GOSUB 9000
2260 GOTO 2400 : REM reproduktion?
2270 REM -------------------
2280 REM kolla tomrum
2300 IF X%=0% THEN S%(R%,K%)=S%(R%,K%)+1% : GOSUB 3010 : GOTO 2500 : REM kan ej flytta men sv{lter
2310 GOSUB 2900 : REM v{lj tomrum P,Q
2320 S%(Q%,P%)=S%(R%,K%)+1% : GOSUB 3020 : REM kolla hajd|d
2330 S%(R%,K%)=0%
2340 GOTO 2500 : REM ingen repr vid sv{lt
2390 REM --------------------
2400 REM kolla reproduktion
2410 IF H%(R%,K%)>]2% THEN A%=1% ELSE A%=H%(R%,K%)+1%
2420 IF A%=1% THEN H%(R%,K%)=1% : GOSUB 2700 ELSE H%(R%,K%)=0% : A$=' ' : GOSUB 9999
2450 H%(Q%,P%)=A%
2455 A$='O' : GOSUB 9000
2460 GOSUB 2710 : REM markera drag
2500 NEXT K%
2550 NEXT R%
2560 RETURN
2590 REM ------------------------------
2600 REM markera drag
2700 D%(R%,K%)=-1% : RETURN
2710 D%(Q%,P%)=-1% : RETURN
2720 REM -----------------------------
2800 REM v{lj fisk
2810 Y1%=Y%*RND+1%
2820 Q%=F1%(Y1%) : P%=G1%(Y1%)
2825 GOSUB 1600 : REM wrap around
2830 RETURN
2840 REM ------------------------------
2900 REM v{lj tomrum
2910 X1%=X%*RND+1%
2920 Q%=H1%(X1%) : P%=I1%(X1%)
2925 GOSUB 1600 : REM wrap around
2930 RETURN
2940 REM ------------------------------
3000 REM kolla hajd|d, ta bort d|d haj
3010 IF S%(R%,K%)>]3% THEN 3030 ELSE GOSUB 2700 : GOTO 3040
3020 IF S%(Q%,P%)>]3% THEN S%(Q%,P%)=0% : A$=' ' ELSE A$='O' : H%(Q%,P%)=1% : GOSUB 2710 : REM markera
3025 GOSUB 9000 : REM rita
3030 H%(R%,K%)=0% : A$=' ' : GOSUB 9999
3040 RETURN
3050 REM ------------------------------
4000 REM
4010 REM fisken flyttar
4020 FOR R%=R0% TO R9%
4030 FOR K%=K0% TO K9%
4040 IF F%(R%,K%)=0% THEN 4270 : REM ingen fisk
4050 IF D%(R%,K%) THEN 4270 : REM redan flyttad
4060 REM -----------------
4070 REM kolla omgivningen
4080 X%=0% : Y%=0%
4090 FOR I%=-1% TO 1%
4100 FOR J%=-1% TO 1%
4110 Q%=R%+I% : P%=K%+J%
4120 GOSUB 1600 : REM wrap around
4130 IF H%(Q%,P%) OR F%(Q%,P%) THEN 4150 : REM rutan upptagen
4140 X%=X%+1% : H1%(X%)=Q% : I1%(X%)=P% : REM r{kna tomrummen och h}ll deras l{gen
4150 NEXT J%
4160 NEXT I%
4165 REM ----------------------------
4170 REM omgivningen klar - }tg{rder
4180 REM kolla tomrum
4190 IF X%=0% THEN GOSUB 2700 : GOTO 4270 : REM kan ej flytta
4200 GOSUB 2900 : REM v{lj tomrum P,Q
4210 REM --------------------
4220 REM kolla reproduktion
4230 IF F%(R%,K%)>]1% THEN A%=1% ELSE A%=F%(R%,K%)+1%
4240 IF A%=1% THEN F%(R%,K%)=1% : GOSUB 2700 ELSE F%(R%,K%)=0% : A$=' ' : GOSUB 9999
4250 F%(Q%,P%)=A%
4255 A$='.' : GOSUB 9000
4260 GOSUB 2710 : REM markera drag
4270 NEXT K%
4280 NEXT R%
4290 RETURN
4300 REM ------------------------------
5000 REM
5005 F%=0% : H%=0%
5010 REM rita spelplan
5020 FOR R%=R0% TO R9%
5030 FOR K%=K0% TO K9%
5040 ; CUR(R%,K%);
5050 IF F%(R%,K%) THEN ; '.'; : F%=F%+1%
5060 IF H%(R%,K%) THEN ; 'O'; : H%=H%+1% ELSE ; ' ';
5070 NEXT K%
5080 NEXT R%
5090 T%=T%+1% : REM varvr{knare
5100 ; CUR(23,0)T%' ';F%' ';H%' ';
5110 ; #W%,T%;F%;H%,
5120 IF H%=0% THEN 6000
5130 IF F%=0% AND H%=0% THEN 6000
5900 RETURN
6000 OUT 6%,5% : END
8900 REM ------------------------------
8990 REM direkt sk{rmutskrift
9000 ; CUR(Q%,P%)A$; : RETURN
9999 ; CUR(R%,K%)A$; : RETURN