Gury's Atari 8-bit Forever Portal - Site dedicated to Atari 8-bit home computers by Bostjan Gorisek (Gury)

Listing 1
100 GOSUB 2080:GOSUB 650
110 OPEN #1,4,0,"K:":DLY=3:LIM=5:GOSUB 1830
120 GRAPHICS 0:? "INITIALIZING":? "TAKES 15 SECONDS"
130 DIM X1(8),Y1(8),X2(8),Y2(8),A1(8),A2(8),A$(5),F1$(40),F2$(40),B$(17):B$(1)=" ":B$(17)=" ":B$(2)=B$
140 RESTORE 150:FOR J=0 TO 8:READ A,B,C,D:X1(J)=A:Y1(J)=B:X2(J)=C:Y2(J)=D:NEXT J
150 DATA 3,6,22,6,8,6,27,6,13,6,32,6,5,9,24,9,12,9,31,9,4,12,23,12,10,12,29,12,6,15,25,15,12,15,31,15
160 F1$(1)="kmm":F1$(39)="M":F1$(4)=F1$:F2$(1)="lnn":F2$(39)="M":F2$(4)=F2$
170 DIM F3$(17),B1(8),B2(8):F3$="xxxxjopjjopjjopjj"
180 GOSUB 1010:GOSUB 1290:POKE 16,112:POKE 53774,112
190 SMILY=0:FROWN=0:? CHR$(125):SOUND 2,0,0,0:SOUND 3,0,0,0
200 POSITION 0,3:? F1$;:POSITION 0,4:? F2$;:POSITION 0,18:? F1$;:POSITION 0,19:? F2$;
210 FOR J=5 TO 17:POSITION 1,J:? F3$(J,J);:POSITION 20,J:? F3$(J,J);:POSITION 38,J:? F3$(J,J);:NEXT J
220 ANIMAL=INT(RND(0)*7)+1:NUM=INT(RND(0)*(LIM-1))+2:ANIMAL2=ANIMAL+1:IF ANIMAL2=8 THEN ANIMAL2=1
230 IF LOCN=0 THEN FOR J=0 TO 8:A1(J)=J:A2(J)=J:NEXT J
240 IF LOCN=1 THEN GOSUB 1350
250 IF TYPE=0 THEN ANIMAL2=ANIMAL
260 GOSUB 1570:GOSUB 1580
270 POSITION 2,20:? #6;" "
280 IF TASK<>0 THEN 390
290 REM * MATCH GROUPS *
300 GOSUB 1700
310 GOSUB 610:FOR J=0 TO R-1:GOSUB 1430:NEXT J
320 GRP=-1
330 GOSUB 1580:GRP=GRP+1:IF GRP>LIM-2 THEN GOSUB 1650:GOTO 220
340 FOR J=0 TO B1(GRP)-1:GOSUB 1400:NEXT J:N=B1(GRP):GOSUB 1550
350 MAXTIME=60*DLY:GOSUB 1520:GOSUB 1590
360 IF TIMEUP=1 THEN 330
370 IF B1(GRP)<>R THEN GOSUB 1650:GOTO 220
380 GOSUB 1770:GOTO 220
390 IF TASK<>1 THEN 490
400 REM * COUNT ANIMALS *
410 FOR J=0 TO NUM-1:GOSUB 1430:NEXT J
420 CNT=0:MAXTIME=60*DLY:GOSUB 1520
430 GOSUB 1590:IF TIMEUP=0 THEN 460
440 J=CNT:GOSUB 1400:GOSUB 1530:CNT=CNT+1:N=CNT:GOSUB 1550:GOSUB 1520
450 IF CNT<NUM OR CNT=NUM THEN 430
460 IF CNT=NUM THEN GOSUB 1770:GOTO 220
470 GOSUB 1650:GOTO 220
480 REM * MATCH PATTERNS *
490 NUM=LIM:GOSUB 1350:GOSUB 1730:RAND=INT(RND(0)*(LIM-1))+2:ANIMAL=RAND
500 FOR J=0 TO LIM-1:ANIMAL=ANIMAL+1:IF ANIMAL>7 THEN ANIMAL=1
510 GOSUB 1430:NEXT J
520 SEQN=-1:FOR J=0 TO 8:A2(J)=A1(J):NEXT J
530 GOSUB 1580:SEQN=SEQN+1:IF SEQN>LIM THEN GOSUB 1650:GOTO 220
540 ANIMAL2=B1(SEQN):FOR J=0 TO LIM-1:ANIMAL2=ANIMAL2+1:IF ANIMAL2>7 THEN ANIMAL2=1
550 GOSUB 1400:NEXT J
560 MAXTIME=60*DLY:GOSUB 1520:GOSUB 1590
570 IF TIMEUP=1 THEN 530
580 IF B1(SEQN)<>RAND THEN GOSUB 1650:GOTO 220
590 GOSUB 1770:GOTO 220
600 REM * RANDOM #, 2 TO LIM *
610 R=INT(RND(0)*(LIM-1)+2):RETURN
620 REM * RANDOM #, 1 TO LIM *
630 R=INT(RND(0)*LIM+1):RETURN
640 REM * VBI ROUTINE *
650 DIM VBI$(128):RESTORE 660:FOR J=1 TO 128:READ A:VBI$(J,J)=CHR$(A):NEXT J
660 DATA 162,3,189,128,6,240,115,222,132,6,48,39,189,132,6,205,160,6,176,102,189,152,6,240,97,189,148,6
670 DATA 41,240,29,152,6,72,134,205,138,10,170,104,157,1,210,166,205,222,152,6,24,144,71,189,136,6,133,203
680 DATA 189,140,6,133,204,189,148,6,133,206,188,144,6,134,205,138,10,170,177,203,240,32,157,0,210,165,206
690 DATA 157,1,210,166,205,200,177,203,240,23,157,132,6,200,152,157,144,6,189,156,6,157,152,6,24,144,12
700 DATA 157,0,210,24,144,223,157,144,6,222,128,6,202,16,133,76,98,228
710 REM * INSERT VBI ROUTINE *
720 RESTORE 740:FOR J=1536 TO 1545:READ A:POKE J,A:NEXT J
730 VBI=ADR(VBI$):HI=INT(VBI/256):LO=VBI-256*HI:POKE 1538,LO:POKE 1540,HI
740 DATA 104,160,0,162,0,169,7,76,92,228
750 REM * SOUND STRINGS *
760 DIM SND1$(110):RESTORE 770:FOR J=1 TO 110:READ A:SND1$(J,J)=CHR$(A):NEXT J
770 DATA 81,20,81,20,81,20,108,20,96,20,96,20,108,40,64,20,64,20,72,20,72,20,81,60,108,20,81,20,81,20,81,20
780 DATA 108,20,96,20,96,20,108,40,64,20,64,20,72,20,72,20,81,60,108,20,81,20,81,20,81,20,108,20,81,20,81,20
790 DATA 81,20,108,20,81,20,108,20,81,20,108,20,81,20,81,20,96,20,108,20,81,20,81,20,81,20,108,20,96,20,96,20
800 DATA 108,40,64,20,64,20,72,20,72,20,81,60,0,0
810 DIM SND2$(98):RESTORE 820:FOR J=1 TO 98:READ A:SND2$(J,J)=CHR$(A):NEXT J
820 DATA 128,20,128,20,128,40,121,20,121,20,128,40,108,20,108,20,121,20,121,20,128,60,0,20
830 DATA 128,20,128,20,128,40,121,20,121,20,128,40,108,20,108,20,121,20,121,20,128,60,0,20,128,20,128,20,128,20
840 DATA 0,20,128,20,128,20,128,20,0,20,128,40,128,40,128,20,128,20,121,40,128,20,128,20,128,40,121,20,121,20
850 DATA 128,40,108,20,108,20,121,20,121,20,128,60,0,0
860 DIM SND3$(16):RESTORE 870:FOR J=1 TO 16:READ A:SND3$(J,J)=CHR$(A):NEXT J
870 DATA 96,20,81,20,72,20,81,20,96,20,81,20,60,60,0,0
880 DIM SND4$(16):RESTORE 890:FOR J=1 TO 16:READ A:SND4$(J,J)=CHR$(A):NEXT J
890 DATA 102,20,108,20,102,20,121,20,162,20,128,20,121,60,0,0
900 REM * PAGE 6 INIT. *
910 RESTORE 920:FOR J=1664 TO 1696:READ A:POKE J,A:NEXT J
920 DATA 1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,170,170,170,170,10,10,10,10,10,10,10,10,0
930 POKE 1696,15
940 HI=INT(ADR(SND1$)/256):POKE 1676,HI:LO=ADR(SND1$)-256*HI:POKE 1672,LO
950 HI=INT(ADR(SND2$)/256):POKE 1677,HI:LO=ADR(SND2$)-256*HI:POKE 1673,LO
960 HI=INT(ADR(SND3$)/256):POKE 1678,HI:LO=ADR(SND3$)-256*HI:POKE 1674,LO
970 HI=INT(ADR(SND4$)/256):POKE 1679,HI:LO=ADR(SND4$)-256*HI:POKE 1675,LO
980 A=USR(1536)
990 RETURN
1000 REM * Change character set *
1010 DIM MCS$(42):RESTORE 1020:FOR J=1 TO 42:READ A:MCS$(J,J)=CHR$(A):NEXT J
1020 DATA 104,169,0,133,203,133,205,169,224,133,204,165,106,56,233,5,133,106,24
1030 DATA 105,1,133,206,162,4,160,0,177,203,145,205,200,208,249,230,204,230,206,202,208,242,96
1040 A=USR(ADR(MCS$)):CSPAGE=PEEK(106)+1:CS=256*CSPAGE:GRAPHICS 0:POKE 756,CSPAGE
1050 RESTORE 1080:FOR J=CS+208 TO CS+511:READ A:POKE J,A:NEXT J
1060 RESTORE 1210:FOR J=CS+776 TO CS+927:READ A:POKE J,A:NEXT J
1070 RETURN
1080 DATA 0,165,41,10,2,0,0,0,0,85,85,85,149,170,195,243,2,66,106,104,160,128,0,192
1090 DATA 160,47,160,0,0,0,0,0,0,21,165,165,133,134,134,134,0,85,85,85,169,170,166,170
1100 DATA 0,90,90,90,86,86,86,85,253,21,145,149,147,159,175,169,127,84,68,84,196,244,240,96
1110 DATA 138,138,138,72,72,8,8,8,90,85,85,85,68,192,192,192,165,170,106,0,0,0,0,0
1120 DATA 90,90,154,19,19,19,19,19,32,152,152,152,152,152,168,42,8,38,38,38,38,38,38,168
1130 DATA 162,162,171,43,62,61,60,255,138,138,234,233,189,125,60,255,8,42,234,251,127,95,15,63
1140 DATA 64,16,21,17,81,87,5,61,4,16,80,16,20,84,64,240,0,0,0,0,0,48,12,3
1150 DATA 63,63,63,58,58,50,48,240,240,244,245,185,186,186,48,60,3,3,67,87,85,165,5,85
1160 DATA 0,0,0,0,2,9,25,38,0,0,0,170,106,153,157,111,0,0,0,128,96,152,153,102
1170 DATA 38,41,41,10,2,0,0,3,110,157,174,110,191,191,192,192,102,154,154,104,160,128,192,240
1180 DATA 0,0,0,255,40,40,248,56,0,0,0,0,0,5,21,84,9,42,43,10,0,0,0,0
1190 DATA 90,248,255,168,12,60,0,0,137,42,170,170,170,42,58,58,90,106,169,165,169,170,3,3
1200 DATA 138,168,162,106,170,170,160,160,0,0,0,160,160,128,0,0
1210 DATA 0,0,1,6,26,27,107,107,0,85,170,170,170,235,235,235,0,0,64,144,164,228,233,233
1220 DATA 106,106,27,26,6,1,0,0,170,170,170,235,190,170,85,0,169,169,228,164,144,64,0,0
1230 DATA 255,255,63,60,15,3,0,0,255,195,60,255,255,255,255,0,255,255,252,60,240,192,0,0
1240 DATA 60,60,60,60,60,60,60,60
1250 DATA 12,56,40,40,235,235,235,40,40,235,235,235,40,40,40,40,0,0,0,0,255,255,255,0
1260 DATA 0,255,255,255,0,0,0,0,60,60,60,60,60,60,149,149,149,170,60,60,60,60,60,60
1270 DATA 0,0,3,15,63,63,252,252,0,255,255,255,255,60,60,60,0,0,192,240,252,252,63,63
1280 REM * CHANGE DISPLAY LIST *
1290 DL=PEEK(560)+PEEK(561)*256:POKE DL+3,68:FOR J=6 TO 24:POKE DL+J,4:NEXT J:POKE DL+25,7:POKE DL+26,6
1300 POKE DL+27,6:FOR J=29 TO 32:POKE DL+J-1,PEEK(DL+J)
1310 RESTORE 1320:FOR J=708 TO 712:READ A:POKE J,A:NEXT J
1320 DATA 72,62,52,78,58
1330 POKE 752,1:RETURN
1340 REM * SCRAMBLE ANIMAL POS. *
1350 FOR J=0 TO 8
1360 R=INT(RND(0)*9):FOR K=0 TO J-1:IF A1(K)=R THEN 1360
1370 NEXT K:A1(J)=R:A2(J)=A1(J)+ANIMAL:IF A2(J)>8 THEN A2(J)=A2(J)-9
1380 NEXT J:RETURN
1390 REM * PRINT ANIMAL ON RIGHT *
1400 RESTORE 1440+10*ANIMAL2:READ A$:POSITION X2(A2(J)),Y2(A2(J)):? A$;
1410 READ A$:POSITION X2(A2(J)),Y2(A2(J))+1:? A$;:RETURN
1420 REM * PRINT ANIMAL ON LEFT *
1430 RESTORE 1440+10*ANIMAL:READ A$:POSITION X1(A1(J)),Y1(A1(J)):? A$;
1440 READ A$:POSITION X1(A1(J)),Y1(A1(J))+1:? A$;:RETURN
1450 DATA , :;<=, ,
1460 DATA >?@AB,CDEF ,
1470 DATA GH,IJK,
1480 DATA LMN,OPQ,
1490 DATA RST,UVW,
1500 DATA XY,Z[,
1510 DATA ,\]^_,
1520 POKE 764,255:POKE 18,0:POKE 19,0:POKE 20,0:RETURN
1530 TIME=PEEK(20)+256*PEEK(19):IF TIME>MAXTIME THEN MAXTIME=TIME
1540 RETURN
1550 P=2*N:FOR J=15 TO 0 STEP -0.6:POSITION P,20:? #6;CHR$(N+144):POSITION P,20
1560 ? #6;" ":SOUND 3,40,10,J:NEXT J:POSITION P,20:? #6;N:RETURN
1570 FOR J=5 TO 17:POSITION 2,J:? B$;:NEXT J:RETURN
1580 FOR J=5 TO 17:POSITION 21,J:? B$;:NEXT J:RETURN
1590 TIMEUP=0:POKE 764,255
1600 TIME=PEEK(20)+256*PEEK(19):IF TIME>MAXTIME THEN TIMEUP=1:RETURN
1610 IF PEEK(53279)=3 THEN POP:GOSUB 1830:GRAPHICS 0:GOSUB 1290:POKE 756,CSPAGE:GOTO 190
1620 IF PEEK(764)=255 AND STRIG(0)=1 THEN 1600
1630 RETURN
1640 REM * FROWN *
1650 POKE 1667,1
1660 P=4*(8-FROWN)+2:POSITION P,1:? #6;"qrs":POSITION P,2:? #6;"ghi":FROWN=FROWN+1:IF FROWN=9 THEN 190
1670 IF SMILY+FROWN>9 THEN SMILY=SMILY-1
1680 RETURN
1690 REM * SCRAMBLE ARRAY *
1700 FOR J=0 TO LIM-2
1710 GOSUB 610:FOR K=0 TO J-1:IF B1(K)=R THEN 1710
1720 NEXT K:B1(J)=R:NEXT J:RETURN
1730 FOR J=0 TO LIM-1
1740 GOSUB 630:FOR K=0 TO J-1:IF B1(K)=R THEN 1740
1750 NEXT K:B1(J)=R:NEXT J:RETURN
1760 REM * SMILY *
1770 POKE 1666,1
1780 P=4*SMILY+2:POSITION P,1:? #6;"abc":POSITION P,2:? #6;"def":SMILY=SMILY+1
1790 IF SMILY=9 THEN FOR J=1 TO 400:NEXT J:POKE 1664,1:POKE 1665,1:GOTO 190
1800 IF SMILY+FROWN>9 THEN FROWN=FROWN-1
1810 RETURN
1820 REM * MENU *
1830 GRAPHICS 17:POSITION 3,3:? #6;"SETUP CONDITIONS":POSITION 3,5:? #6;"choose #"
1840 POSITION 1,8:? #6;"(1) locations:":POSITION 4,9:IF LOCN=0 THEN ? #6;" ORDERED"
1850 IF LOCN=1 THEN ? #6;" RANDOM"
1860 POSITION 1,11:? #6;"(2) animals:":POSITION 4,12:IF TYPE=0 THEN ? #6;" SAME"
1870 IF TYPE=1 THEN ? #6;" DIFFERENT"
1880 POSITION 1,14:? #6;"(3) task":POSITION 4,15:IF TASK=0 THEN ? #6;" MATCH GROUPS"
1890 IF TASK=1 THEN ? #6;" COUNT ANIMALS"
1900 IF TASK=2 THEN ? #6;" MATCH PATTERN"
1910 POSITION 1,17:? #6;"(4) dly time ";DLY:POSITION 1,19:? #6;"(5) # limit ";LIM
1920 POSITION 1,21:? #6;"(6) start pgrm"
1930 GET #1,A:IF A<49 OR A>54 THEN 1920
1940 IF A=54 THEN RETURN
1950 GOSUB 1950+10*(A-48):GOTO 1830
1960 LOCN=ABS(LOCN-1):RETURN
1970 TYPE=ABS(TYPE-1):RETURN
1980 ? #6;CHR$(125):POSITION 3,6:? #6;"choose a task":POSITION 1,8:? #6;"(1) MATCH GROUPS"
1982 POSITION 1,10:? #6;"(2) COUNT ANIMALS":POSITION 1,12
1984 ? #6;"(3) MATCH PATTERN":GET #1,A:IF A<49 OR A>51 THEN 1980
1986 TASK=A-49:RETURN
1990 ? #6;CHR$(125):POSITION 3,6:? #6;"ENTER DELAY":POSITION 3,8:? #6;"TIME (SEC)":POSITION 3,10:? #6;"(1-9)";
1992 GET #1,DLY:DLY=DLY-48:IF DLY<1 OR DLY>9 THEN 2020
1994 RETURN
2000 ? #6;CHR$(125):POSITION 3,6:? #6;"ENTER MAX.":POSITION 3,8:? #6;"NUMBER OF":POSITION 3,10:? #6;"ANIMALS (3-9)"
2010 GET #1,LIM:LIM=LIM-48:IF LIM<2 OR LIM>9 THEN 2050
2020 RETURN
2030 GET #1,DLY:DLY=DLY-48:IF DLY<1 OR DLY>9 THEN 2020
2040 RETURN
2050 ? #6;CHR$(125):POSITION 3,6:? #6;"ENTER MAX.":POSITION 3,8:? #6;"NUMBER OF":POSITION 3,10:? #6;"ANIMALS (3-9)"
2060 GET #1,LIM:LIM=LIM-48:IF LIM<3 OR LIM>9 THEN 2050
2070 RETURN
2080 GRAPHICS 18:RESTORE 2090:FOR J=1 TO 12:READ X,Y,A:POSITION X,Y:? #6;CHR$(A):NEXT J:RETURN
2090 DATA 7,3,111,9,2,76,11,3,196,1,8,205,3,7,65,5,8,99,8,8,228,10,7,239,12,8,110,14,7,193,16,8,236,18,9,68
References
http://www.atarimagazines.com/v2n9/Productreviews.html
http://www.page6.org/pd_lib/standard/pd_005.htm
http://www.atarimania.com/game-atari-400-800-xl-xe-old-macdonald_3773.html
https://ftp.pigwa.net/stuff/collections/holmes%20cd/Holmes%203/BELLCOM/index.html
https://forums.atariage.com/topic/125131-bellcom-pd-catalog-disk/
https://archive.org/details/BELLCOMPublicDomainSoftwareAtari8Bit
Listing downloads
Download link 1
Downloads
Atari 8-bit Source code
