PCjs Machines

Challenger 1P BASIC Programs

LIFE.BAS

By Jeff Parsons

[Possibly adapted from a listing in one of those David Ahl books of “BASIC Games” – I don’t remember.]

Listing

1 REM-GRAPHICS WITH-
2 REM-GEOMETRY/LIFE-
3 REM--USER ROUTINE-
4 REM--MEM.SIZE:8167
5 RESTORE:B=8192:POKE11,232:POKE12,31:FORC=1TO24:PRINT:NEXT
6 FORA=B-24TOB-1:READD:POKEA,D:NEXT
7 DATA169,32,160,8,162,0,157,0,208,232,208
8 DATA250,238,240,31,136,208,244,169,208,141,240,31,96
10 REM-MAIN PROGRAM-
12 DIMY(21,21),U(20)
13 GOSUB800
15 POKE8169,32:X=USR(X):AA=54023:G=1:Z=-1
20 FORA=0TO18:POKEAA+A,128:POKEAA+19-A*32,136
25 POKEAA-590-A,128:POKEAA-576+A*32,136
30 NEXTA:POKEAA,209
35 FORB=0TO9:FORA=0TO18:POKEAA-558-A+B*32,209
40 IFB<9ANDA>0THENPOKEAA+A-(B+1)*32,128
43 IFA=0THENPOKEAA-(B+1)*32,209
45 IFA<18THENPOKEAA+A+1-B*32,209
50 NEXTA,B
55 B=64:A=AA+31:FORC=1TO19:POKEA+C,B+C:POKEA-C*32,B+C:NEXT
60 MA=1:NA=1:MI=21:NI=21:REM--GRAPHING--
65 POKEAA+102,123:POKEAA+104,44:POKEAA+106,124
70 POKEAA+103,95:POKEAA+105,95:GOSUB1000:A=C:IFC<0THEN85
73 POKEAA+103,96+C
75 GOSUB1000:B=C:IFC<0THEN85
77 POKEAA+105,96+C:FORT=1TO75:NEXT:POKEAA+A-1-(B-1)*32,161
80 A=A+1:B=B+1:Y(A,B)=1:FORT=1TO250:NEXT:GOSUB400:GOTO70
85 FORC=1TO24:PRINT:NEXT:FORT=1TO1000:NEXT:POKE8169,46:X=USR(X)
87 AA=AA+31:GOSUB300:GOSUB200
90 FORB=1TO21:FORA=1TO21:IFY(A,B)=0THEN100
95 POKEAA+A-1-(B-1)*32,240:P=P+1
100 NEXTA,B:IFP=0THEN15
110 POKEAA+65,91:POKEAA+66,71:POKEAA+67,69:POKEAA+68,78:POKEAA+69,61
112 POKEAA+73,32:POKEAA+74,32
115 POKEAA+75,80:POKEAA+76,79:POKEAA+77,80:POKEAA+78,61:POKEAA+82,93
117 C=3:G$=STR$(G)
120 POKEAA+69+C,ASC(RIGHT$(G$,4-C)):C=C-1:IFC>0THEN120
125 GOSUB605
135 REM-LIFE/DEATH-
140 K=0:FORB=MITOMA:FORA=NITONA
143 R=PEEK(AA+A-1-(B-1)*32):P1=P:POKEAA+A-1-(B-1)*32,171
145 IFY(A,B)<>0THEN155
150 GOSUB500:IFX=B1THENY(A,B)=-1:POKEAA+A-1-(B-1)*32,240:P=P+1:K=1
153 GOTO160
155 GOSUB500:IFX<L1ORX>L2THENY(A,B)=2:POKEAA+A-1-(B-1)*32,46:P=P-1:K=1
157 IFX1>0THENPOKEAA+82,43:POKEAA+83,93
160 IFP<>P1THEN180
170 POKEAA+A-1-(B-1)*32,R
180 GOSUB605:NEXTA,B
181 IFK=0THENGOSUB1000:GOTO15
182 MA=1:NA=1:MI=21:NI=21
183 FORA=1TO21:FORB=1TO21:IFY(A,B)=2THENY(A,B)=0
185 IFY(A,B)=0THEN192
187 IFY(A,B)=-1THENY(A,B)=1
190 GOSUB400
192 NEXTB,A
193 IFP=0THENGOSUB1000:GOTO15
194 K=0:GOSUB300:IFK=0THEN199
195 GOSUB200:FORD=21TO1STEP-1:FORC=1TO21
196 IFY(C,D)=0THENPOKEAA+C-1-(D-1)*32,46:GOTO198
197 POKEAA+C-1-(D-1)*32,240
198 NEXTC,D:GOSUB250
199 G=G+1:GOTO117
200 FORC=1TO19:U(C)=PEEK(AA+64+C):NEXT
205 RESTORE:FORC=1TO100:READD:IFD>=0THENNEXT
210 FORC=1TO19:READD:POKEAA+64+C,D:NEXT
220 RETURN
230 DATA-1,32,32,32,82,69,45,67,69,78,84,69,82,73,78,71,32,32,32,32
250 FORC=1TO19:POKEAA+64+C,U(C):NEXT:RETURN
300 L=INT(((21-MA)-(MI-1))/2+.5)
301 IFL=0THEN350
305 K=1:IFL>0THEN330
310 FORD=1-LTO21:FORC=1TO21:Y(C,D+L)=Y(C,D)
315 Y(C,D)=0
320 NEXTC,D:MA=MA+L:MI=MI+L:GOTO350
330 FORD=21-LTO1STEP-1:FORC=1TO21
340 Y(C,D+L)=Y(C,D):Y(C,D)=0:NEXTC,D
345 MA=MA+L:MI=MI+L
350 L=INT(((21-NA)-(NI-1))/2)
351 IFL=0THENRETURN
355 K=1:IFL>0THEN375
360 FORC=1-LTO21:FORD=1TO21
365 Y(C+L,D)=Y(C,D):Y(C,D)=0:NEXTD,C
370 NA=NA+L:NI=NI+L:RETURN
375 FORC=21-LTO1STEP-1:FORD=1TO21
380 Y(C+L,D)=Y(C,D):Y(C,D)=0:NEXTD,C
385 NA=NA+L:NI=NI+L:RETURN
400 IFB<=MITHENMI=B-1
410 IFB>=MATHENMA=B+1
420 IFA<=NITHENNI=A-1
430 IFA>=NATHENNA=A+1
445 IFMA>21THENMA=21
450 IFMI<1THENMI=1
465 IFNA>21THENNA=21
470 IFNI<1THENNI=1
480 RETURN
500 X=0:X1=0
505 FORC=C1*-1TOC1STEPC1:FORD=C1*-1TOC1STEPC1
507 IFA+C<1ORA+C>21ORB+D<1ORB+D>21THENX1=1:GOTO525
510 IFY(A+C,B+D)<1OR(C=0ANDD=0)THEN525
515 X=X+1
525 NEXTD,C
530 RETURN
600 Z=Z*-1
605 G$=STR$(P):C=3
606 IFZ>0THEN615
610 POKEAA+78+C,ASC(RIGHT$(G$,4-C)):C=C-1:IFC>0THEN610
612 GOTO620
615 POKEAA+79,32:POKEAA+80,32:POKEAA+81,32
620 RETURN
800 PRINT" WHAT ARE THE LOWER/":PRINT:PRINT" UPPER SURVIVAL LIMITS.."
805 INPUTL1,L2:PRINT
810 PRINT" INPUT BIRTH FACTOR";:INPUTB1
820 PRINT:PRINT" INPUT CELL DISTANCE";:INPUTC1
825 FORC=1TO24:PRINT:NEXT:RETURN
1000 REM--SCAN--
1005 C=0:K=57088:POKE530,1
1007 FORT=1TO150:NEXT
1010 POKEK,223:IFPEEK(K)=191THENC=12
1015 IFPEEK(K)=223THENC=15
1017 IFPEEK(K)=247THENC=-1
1020 POKEK,239:IFPEEK(K)=191THENC=5
1025 IFPEEK(K)=223THENC=18
1030 IFPEEK(K)=253THENC=9
1035 POKEK,247:IFPEEK(K)=191THENC=4
1037 IFPEEK(K)=127THENC=19
1040 IFPEEK(K)=223THENC=6
1045 IFPEEK(K)=239THENC=7
1050 IFPEEK(K)=247THENC=8
1055 IFPEEK(K)=251THENC=10
1060 IFPEEK(K)=253THENC=11
1065 POKEK,251:IFPEEK(K)=191THENC=3
1070 IFPEEK(K)=239THENC=2
1075 IFPEEK(K)=247THENC=14
1080 IFPEEK(K)=251THENC=13
1085 POKEK,253:IFPEEK(K)=127THENC=17
1090 IFPEEK(K)=191THENC=1
1093 IFPEEK(K)=223THENC=20
1095 IFPEEK(K)=253THENC=16
1100 IFC=0THEN1010
1105 IFC=20THENY(A,B)=0:POKEAA+A-2-(B-2)*32,209:C=0:GOTO1010
1110 POKE530,0:RETURN

[GitHub Source]