Иисус отверг Тему - PROTOPANDORA.BAS [entries|archive|friends|userinfo]
Шансонье Дима Даннер

[ website | Полин Квітне ]
[ userinfo | ljr userinfo ]
[ archive | journal archive ]

PROTOPANDORA.BAS [Aug. 15th, 2015|02:19 pm]
Previous Entry Add to Memories Tell A Friend Next Entry
Check 13C78F7D
Auto 8224

# (Прототип предназначен для интерпретатора BasinC 1.69. Переключитесь на режим полной скорости клавишей F1, иначе устанете ждать)
# Клавиши: WASD, пробел - ждать, 023 - изменить белую клетку, T - взять, R - бросить.
# (для перехода на другой уровень на запрос random? нажмите y)

# Run-time Variables

Var c: Num = 1
Var r: NumArray(4, 4, 4) = 0, 3, 3, 3, 2, 2, 2, 2, 3, 3, 3, 3, 1, 1, 1, 1, 0, 3, 3, 3, 2, 2, 2, 2, 3, 3, 3, 3, 1, 1, 1, 1, 0, 3, 3, 3, 2, 2, 2, 2, 3, 3, 3, 3, 1, 1, 1, 1, 0, 3, 3, 3, 2, 2, 2, 2, 3, 3, 3, 3, 1, 1, 1, 1
Var s: NumArray(22, 32) = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
Var a: NumFOR = 23, 22, 1, 9030, 8
Var b: NumFOR = 5, 4, 1, 9020, 3
Var p$: Str = "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
Var a$: Str = "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"

# End Run-time Variables

1 DEF FN i(p,q)=(p-1)*32+q
2 REM final prototype to compile
10 GO SUB 9000
15 GO SUB 8000: LET p$=a$: LET p=11: LET q=17: LET tak=0: LET mov=0: LET en=32: DIM s(22,32): LET s(11,16)=85: REM init
20 GO SUB 2000: PRINT AT p-1,q-1; PAPER 8;"\@": PRINT #1;AT 0,0;en,mov: GO SUB 7000: LET en=en-1: LET mov=mov+1
30 FOR a=1 TO 22: FOR b=1 TO 32: LET c=FN i(a,b): LET d=s(a,b): IF d<>0 AND d<>85 AND d<>170 AND d<>255 THEN GO TO 90
40 LET d=0: IF b<>1 THEN IF p$(c-1)<>"6" THEN LET d=d+r(1,VAL p$(c)+1,VAL p$(c-1)+1)*64
50 IF b<>32 THEN IF p$(c+1)<>"6" THEN LET d=d+r(2,VAL p$(c)+1,VAL p$(c+1)+1)*16
60 IF a<>1 THEN IF p$(c-32)<>"6" THEN LET d=d+r(3,VAL p$(c)+1,VAL p$(c-32)+1)*4
70 IF a<>22 THEN IF p$(c+32)<>"6" THEN LET d=d+r(4,VAL p$(c)+1,VAL p$(c+32)+1)
80 PRINT #1;AT 1,0;c,: IF d<>0 THEN LET s(a,b)=d
90 NEXT b: NEXT a
100 FOR a=1 TO 22: FOR b=1 TO 32: LET c=FN i(a,b): PRINT #1;AT 1,0;c,: LET d=s(a,b): IF d=0 THEN LET p$(c)="0": GO TO 200
110 DIM a(4): LET a(1)=INT (d/64): LET a(2)=INT ((d-a(1)*64)/16): LET a(3)=INT ((d-a(1)*64-a(2)*16)/4): LET a(4)=d-a(1)*64-a(2)*16-a(3)*4
120 LET c$=" ": FOR e=1 TO 4: LET c$(a(e)+1)=STR$ (a(e)): NEXT e
130 IF c$="01 " OR c$=" 1 " THEN LET p$(c)="1": LET s(a,b)=85: GO TO 200
140 IF c$="0 2 " OR c$=" 2 " THEN LET p$(c)="2": LET s(a,b)=170: GO TO 200
150 IF c$="0 3" OR c$=" 3" THEN LET p$(c)="3": LET s(a,b)=255: GO TO 200
160 LET p$(c)="6"
200 NEXT b: NEXT a
205 LET c=FN i(p,q)
210 IF p$(c)="1" THEN GO TO 1100: REM game over
220 IF p$(c)="2" THEN LET en=en-1: GO TO 20
230 IF p$(c)="3" THEN LET en=en+2: GO TO 20
240 IF p$(c)="0" THEN GO TO 20
250 GO SUB 1000
260 LET c$=" ": FOR a=1 TO 4: LET c$(a(a)+1)=STR$ (a(a)): NEXT a
270 IF c$(2)="1" THEN GO TO 1100
280 IF c$(3)="2" THEN LET en=en-1
290 IF c$(4)="3" THEN LET en=en+2
999 GO TO 20
1000 LET c=s(p,q): DIM a(4): LET a(1)=INT (c/64): LET a(2)=INT ((c-a(1)*64)/16): LET a(3)=INT ((c-a(1)*64-a(2)*16)/4): LET a(4)=c-a(1)*64-a(2)*16-a(3)*4: RETURN
1100 GO SUB 2000: PRINT AT p-1,q-1; PAPER 8;"#": PRINT #1;AT 0,0;"GAME OVER": PAUSE 0: GO TO 15
2000 REM \#245\#1720,0;p$:\#254
2010 CLS : FOR a=1 TO 704: PRINT PAPER VAL p$(a)+1; INK 7;p$(a);: NEXT a: RETURN
7000 LET k$="": LET c$=p$(FN i(p,q)): IF c$<>"6" AND c$<>"0" AND tak=0 THEN PRINT #1;AT 1,0;"T ": LET k$="t": GO TO 7200
7010 IF c$="0" AND tak<>0 THEN PRINT #1;AT 1,0;"R ": LET k$="r": GO TO 7200
7020 IF c$<>"6" THEN PRINT #1;AT 1,0;" ": GO TO 7200
7025 GO SUB 1000
7040 LET c$=" ": FOR a=1 TO 4: LET c$(a(a)+1)=STR$ (a(a)): NEXT a: PRINT #1;AT 1,0;c$: LET k$="s"
7200 PAUSE 0
7210 IF INKEY$="t" AND k$="t" THEN LET tak=VAL p$(FN i(p,q)): LET p$(FN i(p,q))="0": LET s(p,q)=0: LET en=en-1: RETURN
7220 IF INKEY$="r" AND k$="r" THEN LET p$(FN i(p,q))=STR$ (tak): LET k$=STR$ (tak): GO SUB 7500: LET tak=0: RETURN
7230 IF INKEY$="0" AND k$="s" THEN LET k$="0": GO TO 7300
7240 IF INKEY$="1" AND k$="s" THEN LET k$="1": GO TO 7300
7250 IF INKEY$="2" AND k$="s" THEN LET k$="2": GO TO 7300
7260 IF INKEY$="3" AND k$="s" THEN LET k$="3": GO TO 7300
7270 GO TO 7400
7300 FOR a=1 TO 4: IF c$(a)=k$ THEN LET p$(FN i(p,q))=k$: GO SUB 7500:
7310 NEXT a: RETURN
7400 IF INKEY$="w" AND p<>1 THEN LET p=p-1: RETURN
7410 IF INKEY$="s" AND p<>22 THEN LET p=p+1: RETURN
7420 IF INKEY$="a" AND q<>1 THEN LET q=q-1: RETURN
7430 IF INKEY$="d" AND q<>32 THEN LET q=q+1: RETURN
7440 IF INKEY$=" " THEN LET en=en-2: RETURN
7450 GO TO 7200
7500 IF k$="0" THEN LET s(p,q)=0: RETURN
7510 IF k$="1" THEN LET s(p,q)=85: RETURN
7520 IF k$="2" THEN LET s(p,q)=170: RETURN
7530 IF k$="3" THEN LET s(p,q)=255: RETURN
7540 RETURN
8000 PRINT AT 0,0;"RANDOM?": PAUSE 0: IF INKEY$<>"y" THEN RETURN
8010 RANDOMIZE : FOR a=1 TO 4: FOR b=1 TO 4: FOR c=1 TO 4: LET r(a,b,c)=INT (RND*4): NEXT c: NEXT b: NEXT a: LET r(1,1,1)=0: LET r(2,1,1)=0: LET r(3,1,1)=0: LET r(4,1,1)=0: RETURN
9000 DIM r(4,4,4): REM rule-lrud,cell,neighbour
9010 FOR a=1 TO 4: LET r(1,2,a)=2: NEXT a: FOR a=1 TO 4: LET r(1,3,a)=3: NEXT a: FOR a=1 TO 4: LET r(1,4,a)=1: NEXT a: FOR a=2 TO 4: LET r(1,1,a)=3: NEXT a
9020 FOR a=1 TO 4: FOR b=1 TO 4: LET c=r(1,a,b): LET r(2,a,b)=c: LET r(3,a,b)=c: LET r(4,a,b)=c: NEXT b: NEXT a
9030 DIM s(22,32): LET a$="": FOR a=1 TO 32: LET a$=a$+"0": NEXT a: LET p$="": FOR a=1 TO 22: LET p$=p$+a$: NEXT a: LET a$=p$: LET a$(FN i(11,16))="1"
9040 RETURN
LinkLeave a comment

Comments:
From:(Anonymous)
Date:August 15th, 2015 - 01:37 pm
(Link)
не пиши так больше
From:(Anonymous)
Date:August 15th, 2015 - 02:47 pm
(Link)
как при совке, щас весь листинг перепечатывать буду
From:(Anonymous)
Date:August 15th, 2015 - 05:06 pm
(Link)
НИХУЯ СЕБЕ АДОВА ПОЕБЕНЬ
From:(Anonymous)
Date:August 15th, 2015 - 06:14 pm
(Link)
Это какой-то ребус?
[User Picture]
From:[info]dmitry_danner
Date:August 15th, 2015 - 09:02 pm
(Link)
это игра в человека против клеточного автомата
From:(Anonymous)
Date:August 15th, 2015 - 11:12 pm
(Link)
Я сюда деградировать захожу.
From:(Anonymous)
Date:August 15th, 2015 - 09:02 pm
(Link)
а на коболе можешь?
[User Picture]
From:[info]dmitry_danner
Date:August 15th, 2015 - 09:02 pm
(Link)
увы
From:(Anonymous)
Date:August 16th, 2015 - 11:49 am
(Link)
настоящие программисты не используют гото.
[User Picture]
From:[info]dmitry_danner
Date:August 16th, 2015 - 12:25 pm
(Link)
а я и не претендую