Oryginalnie grę chciałem wysłać na konkurs "Napisze se"
Ze względu na brak czasu nie mogę (na razie) ukończyć gry.
oryginał: http://pl.youtube.com/watch?v=Qps3wXgEabk
Kiedyś przerabiałem tę grę na XP-ka (FreeBASIC), więc na ATARI to była tylko kwestia przekonwertowania kodu na TBXL. Najlepiej działa skopilowany kod.
0 GRAPHICS 2
10 DIM LEV(6,6),MOV$(10),LEWO$(10),PRAWO$(10),A1$(128)
11 LEWO$="":PRAWO$="":MOV$="":QWE=100:POZIOM=0
20 EXEC GENERUJ
30 EXEC WYSWIETL
35 DO
40 EXEC POKAZ_KURSOR
41 EXEC PRZESUN_KURSOR
43 EXEC UKRYJ_KURSOR
45 LOOP
900 --
910 PROC CONVERTER:REM TAJEMNICE ATARI 6-7/92 STR.32
911 A1=LEN(A1$)
912 X1=0
913 FOR I1=1 TO A1
914 D1=ASC(A1$(I1,I1))-48
915 D1=D1-7*(D1>9)
916 X1=P1*X1+D1
917 NEXT I1:I1=128
918 DO
919 I1=I1-1
920 Y1=INT(X1/Q1)
921 D1=X1-Q1*Y1
922 A1$(I1,I1)=CHR$(D1+48+7*(D1>9))
923 X1=Y1
924 IF X1=0 THEN EXIT
925 loop
926 ENDPROC
998 --
999 END
1000 PROC GENERUJ
1010 LINE_X=1:LINE_Y=1
1015 LINES=0:POZIOM=LINES
1020 FOR I=1 TO 12
1030 X=INT(RAND(6))+1
1040 Y=INT(RAND(6))+1
1050 IF LEV(X,Y)=0
1060 LEV(X,Y)=1
1070 ELSE
1080 DO
1090 X=INT(RAND(6))+1
1100 Y=INT(RAND(6))+1
1110 IF LEV(X,Y)<>1 THEN LEV(X,Y)=1:EXIT
1125 ENDIF
1120 LOOP
1130 NEXT I
1140 FOR I=1 TO 12
1150 X=INT(RAND(6))+1
1160 Y=INT(RAND(6))+1
1170 IF LEV(X,Y)=0
1180 LEV(X,Y)=2
1190 ELSE
1200 DO
1210 X=INT(RAND(6))+1
1220 Y=INT(RAND(6))+1
1230 IF LEV(X,Y)=0 THEN LEV(X,Y)=2:EXIT
1240 LOOP
1250 ENDIF
1260 NEXT I
1270 ENDPROC
1280 --
1300 PROC WYSWIETL
1305 POSITION 0,0
1310 for i=1 to 6
1320 for j=1 to 6
1330 IF LEV(J,I)=0 : ? #6;CHR$($20); :ENDIF
1331 IF LEV(J,I)=1 : ? #6;CHR$($4F); :ENDIF
1332 IF LEV(J,I)=2 : ? #6;CHR$($CF); :ENDIF
1333 IF LEV(J,I)=3 : ? #6;CHR$($6F); :ENDIF
1334 IF LEV(J,I)=4 : ? #6;CHR$($EF); :ENDIF
1340 NEXT J :? #6
1350 NEXT I
1360 ENDPROC
1370 --
1400 PROC POKAZ_KURSOR
1410 POSITION 6,LINE_X-1:? #6; CHR$(ASC("#")+FIRE*128)
1420 POSITION LINE_Y-1,6:? #6; CHR$(ASC("#")+FIRE*128)
1421 POSITION 9,0:? #6; "LINII:";LINES
1430 ENDPROC
1440 --
1450 PROC UKRYJ_KURSOR
1460 POSITION 6,OLD_LINE_X-1:? #6; " "
1470 POSITION OLD_LINE_Y-1,6:? #6; " "
1480 ENDPROC
1490 --
1500 PROC PRZESUN_KURSOR
1510 REPEAT :ST=STICK(0):FIRE=STRIG(0):C=PEEK(53279):PAUSE 5:EXEC POKAZ_KURSOR:UNTIL ST<>15 OR FIRE<>1 OR C<>7
1511 LEWO$="":PRAWO$="":a=a^1
1512 DL=0 :REM DL=DLUGOSC LEWO$
1513 DR=0 :REM DR=DLUGOSC PRAWO$
1520 OLD_LINE_X=LINE_X:OLD_LINE_Y=LINE_Y
1530 IF FIRE=0 THEN MOV$="":EXEC PRZESUN_BECZKI:ENDPROC
1540 IF ST=14 THEN LINE_X=LINE_X-1:IF LINE_X<1 THEN LINE_X=6
1550 IF ST=13 THEN LINE_X=LINE_X+1:IF LINE_X>6 THEN LINE_X=1
1560 IF ST=7 THEN LINE_Y=LINE_Y+1:IF LINE_Y>6 THEN LINE_Y=1
1570 IF ST=11 THEN LINE_Y=LINE_Y-1:IF LINE_Y<1 THEN LINE_Y=6
1580 ENDPROC
1590 --
1600 PROC PRZESUN_BECZKI
1610 ST=STICK(0):FIRE=STRIG(0):C=PEEK(53279)
1620 IF ST=14 and FIRE=0 THEN EXEC W_GORE
1630 IF ST=13 and FIRE=0 THEN EXEC W_DOL
1640 IF ST=7 and FIRE=0 THEN EXEC W_PRAWO
1650 IF ST=11 and FIRE=0 THEN EXEC W_LEWO
1660 EXEC POKAZ_KURSOR
1670 ENDPROC
1680 --
1700 PROC LEWO:ZER=0
1705 for i=1 to 6
1710 if MOV$(I,I)="0" :zer=zer+1 :else :DL=DL+1:LEWO$(DL,DL)=MOV$(I,I) :ENDIF
1715 next I
1720 if zer>0
1725 for i=1 to zer
1730 DL=DL+1:LEWO$(DL,DL)="0"
1735 next I
1740 endif
1745 endPROC
1746 --
1750 PROC PRAWO:ZER=0
1755 for i=1 to 6
1760 if MOV$(I,I)="0" :zer=zer+1 :else :DR=DR+1:PRAWO$(DR,DR)=MOV$(I,I) :ENDIF
1765 next I
1770 if zer>0
1775 for i=1 to zer
1780 DL=DL+1:LEWO$(DL,DL)="0"
1785 next I:LEWO$(DL+1)=PRAWO$:PRAWO$=LEWO$
1790 endif
1795 endPROC
1796 --
1800 PROC W_GORE
1805 FOR I=1 TO 6:MOV$(I,I)=STR$(LEV(LINE_Y,I)):NEXT I:EXEC LEWO
1810 FOR I=1 TO 6:LEV(LINE_Y,I)=VAL(LEWO$(I,I)):NEXT I:EXEC WYSWIETL:EXEC SPRAWDZ
1815 ENDPROC
1820 PROC W_DOL
1825 FOR I=1 TO 6:MOV$(I,I)=STR$(LEV(LINE_Y,I)):NEXT I:EXEC PRAWO
1830 FOR I=1 TO 6:LEV(LINE_Y,I)=VAL(PRAWO$(I,I)):NEXT I:EXEC WYSWIETL:EXEC SPRAWDZ
1835 ENDPROC
1840 PROC W_LEWO
1845 FOR I=1 TO 6:MOV$(I,I)=STR$(LEV(I,LINE_X)):NEXT I:EXEC LEWO
1850 FOR I=1 TO 6:LEV(I,LINE_X)=VAL(LEWO$(I,I)):NEXT I:EXEC WYSWIETL:EXEC SPRAWDZ
1855 ENDPROC
1860 PROC W_PRAWO
1865 FOR I=1 TO 6:MOV$(I,I)=STR$(LEV(I,LINE_X)):NEXT I:EXEC PRAWO
1870 FOR I=1 TO 6:LEV(I,LINE_X)=VAL(PRAWO$(I,I)):NEXT I:EXEC WYSWIETL:EXEC SPRAWDZ
1875 ENDPROC
1876 --
1900 PROC SPRAWDZ
1901 POSITION 9,1:? #6;"CHWILA"
1905 REM linie x
1910 za1=0:za2=0:za3=0:za4=0
1915 for i=1 to 6
1920 za1=0:za2=0:za3=0:za4=0
1925 For zn=1 to 6
1930 if lev(zn,i)=1 : za1=za1+1:ELSE
1932 if lev(zn,i)=2 : za2=za2+1:ELSE
1934 if lev(zn,i)=3 : za3=za3+1:ELSE
1936 if lev(zn,i)=4 : za4=za4+1:ENDIF:ENDIF:ENDIF:ENDIF
1940 next ZN
1945 if za1=6 or za2=6 OR za3=6 OR za4=6
1950 P1=10 : lines=lines+1:POZIOM=POZIOM+1:IF POZIOM=32 THEN POZIOM=0
1955 IF POZIOM>=0 AND POZIOM <=8 THEN A1$=str$(int(rnd(1) * 61)+1+64):Q1=2
1960 IF POZIOM>=9 AND POZIOM <=16 THEN A1$=str$(int(rnd(1) * 726)+1+729):Q1=3
1965 IF POZIOM>=17 AND POZIOM <=32 THEN A1$=str$(int(rnd(1) * 4093)+1+4096):Q1=4
1970 EXEC CONVERTER
1975 LEWO$=A1$(I1)
1980 for zn=1 to 6
1985 if asc(LEWO$(zn,zn))<>0 :lev(zn,I)=VAL(LEWO$(zn,zn))+1 :else :lev(zn,I)=0 :endif
1990 next ZN
1995 endif
2000 next I
2005 REM linie y
2010 za1=0:za2=0:za3=0:za4=0
2015 for i=1 to 6
2020 za1=0:za2=0:za3=0:za4=0
2025 for zn=1 to 6
2030 if lev(I,zn)=1 : za1=za1+1:ELSE
2032 if lev(I,zn)=2 : za2=za2+1:ELSE
2034 if lev(I,zn)=3 : za3=za3+1:ELSE
2036 if lev(I,zn)=4 : za4=za4+1:ENDIF:ENDIF:ENDIF:ENDIF
2040 next ZN
2045 if za1=6 or za2=6 OR za3=6 OR za4=6
2050 P1=10 : lines=lines+1:POZIOM=POZIOM+1:IF POZIOM=32 THEN POZIOM=0
2055 IF POZIOM>=0 AND POZIOM <=8 THEN A1$=str$(int(rnd(1) * 61)+1+64):Q1=2
2060 IF POZIOM>=9 AND POZIOM <=16 THEN A1$=str$(int(rnd(1) * 726)+1+729):Q1=3
2065 IF POZIOM>=17 AND POZIOM <=32 THEN A1$=str$(int(rnd(1) * 4093)+1+4096):Q1=4
2070 EXEC CONVERTER
2075 LEWO$=A1$(I1)
2080 for zn=1 to 6
2085 if asc(LEWO$(zn,zn))<>0 :lev(i,zn)=VAL(LEWO$(zn,zn))+1 :else :lev(i,zn)=0 :endif
2090 next ZN
2095 endif
2100 next I:EXEC WYSWIETL
2101 POSITION 9,1:? #6;" "
2105 endPROC
EDIT: gra ostatecznie poszła na konkurs
więcej info:http://atarionline.pl/v01/index.phtml?subaction=showfull&id=1229384479&archive=&start_from=&ucat=1&ct=nowinki
Download v1.5: post #7 http://atariarea.krap.pl/forum/viewtopi … 496#p89496