Forum Chrześcijańskie

Piotr-246 · Gość

REM ta wersja programu zajmuje sie glownie obrazkiem na scianie
REM poprzednie proby znikna ze scian

DEF SEG = 0
SCREEN 13: COLOR 15

TYPE rekord
znak AS STRING * 1
poczatek AS INTEGER
koniec AS INTEGER
xwtabl AS INTEGER
ywtabl AS INTEGER
wysokosc AS INTEGER
END TYPE

DIM elementy(0 TO 310) AS rekord

DIM sinus(0 TO 3599)
DIM cosinus(0 TO 3599)
DIM t$(0 TO 99)

REM deklaracje tych zmiennych maja na celu ograniczenie ich wielkosci
REM czyli zwiekszenia predkosci

DIM xgracza AS INTEGER, ygracza AS INTEGER
DIM kier AS INTEGER, K AS INTEGER, kat AS INTEGER
DIM n AS INTEGER, ktora AS INTEGER

REM tworzenie tablicy sinusow i cosinisow
REM podawanych w stopniach * 10

pi = 3.14159
REM przelicznik stopni na radiany xrad=(pi*xstop)/180
FOR I = 0 TO 3599
s = SIN((pi * I / 10) / 180)
c = COS((pi * I / 10) / 180)
sinus(I) = INT(s * 100) / 100
cosinus(I) = INT(c * 100) / 100
NEXT I

REM tablica labiryntu

t$(0) = "#####################################################################################################"
t$(1) = "#KCBDBCBD0QRSQRSQRSQRSQRSQRSQRSQRSQRSQRSQRSQRSQRSQRSQRS====CBDBCBDBCBDBCBDBCBDBCBDBC===============K#"
t$(2) = "#G.................................................................................................I#"
t$(3) = "#E.................................................................................................I#"
t$(4) = "#F..:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::..I#"
t$(5) = "#E..:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::..I#"
t$(6) = "#G..:::::::::///////////////////////////////:::::::::::::::::::::::::::::::::::::::::::::::::::::..I#"
t$(7) = "#E.........::///////////////////////////////::.....................................................I#"
t$(8) = "#F.........:://%%%%%%%%%%%%%%%%%%%%%%%%%%%//::.....................................................I#"
t$(9) = "#K======K..:://%%%%%%%%%%%%%%%%%%%%%%%%%%%//::..K==================================================K#"
t$(10) = "########I..:://%%>>>>>>>>>>>>>>>>>>>>>>>%%//::..I###################################################"
t$(11) = "#K======K..:://%%%%%%%%%%%>>>>%%%%%%%%%%%%//::..K====================K#"
t$(12) = "#G.........:://%%%%%%%%%%%>>>>%%%%%%%%%%%%//::.......................G#"
t$(13) = "#E.........::///////////%%>>>>%%////////////::.......................E#"
t$(14) = "#F..:::::::::///////////%%>>>>%%////////////:::::::::::::::::::::::..F#"
t$(15) = "#E..:::::::::::::::::://%%>>>>%%//:::::::::::::::::::::::::::::::::..E#"
t$(16) = "#G..:::::::::::::::::://%%>>>>%%//:::::::::::::::::::::::::::::::::..G#"
t$(17) = "#E..................:://%%>>>>%%//::.................................E#"
t$(18) = "#F..................:://%%>>>>%%//::.................................F#"
t$(19) = "#K===============K..:://%%>>>>%%//::..KDBCBDBCBDBCBDBCBDBCBDBCBDBCBDBK#"
t$(20) = "#################I..:://%%>>>>%%//::..I################################################"
t$(21) = "#################I..:://%%>>>>%%//::..KYXYWYXYW======================================K#"
t$(22) = "#################I..:://%%>>>>%%//::.................................................G#"
t$(23) = "#K===============K..:://%%>>>>%%//::.................................................E#"
t$(24) = "#I..................:://%%>>>>%%//:::::::::::::::::::::::::::::::::::::::::::::::::..F#"
t$(25) = "#I..................:://%%>>>>%%//:::::::::::::::::::::::::::::::::::::::::::::::::..E#"
t$(26) = "#I..:::::::::::::::::://%%>>>>%%//////////////////////:::::::::::::::::::::::::::::..G#"
t$(27) = "#I..............:::::://%%>>>>%%//////////////////////::.............................E#"
t$(28) = "#I..............:://////%%>>>>%%%%%%%%%%%%%%%%%%%%%%//::.............................F#"
t$(29) = "#K===========K..:://////%%>>>>%%%%%%%%%%%%%%%%%%%%%%//::..KDBCBDBCBDBCBDBCBDBCBDBCBDBK#"
t$(30) = "#############I..:://%%%%%%>>>>>>>>>>>>>>>>>>>>>>>>%%//::..I############################"
t$(31) = "#KBCBDBCBDBCBK..:://%%%%%%>>>>>>>>>>>>>>>>>>>>>>>>%%//::..K==========K#"
t$(32) = "#I..............:://%%>>>>>>>>>>>>>>>>>>>>>>>>>>>>%%//::.............G#"
t$(33) = "#I..............:://%%>>>>>>>>>>>>>>>>>>>>>>>>>>>>%%//::.............E#"
t$(34) = "#I..:::::::::::::://%%%%%%%%%%%%%%%%>>>>>>>>>%%%%%%%//:::::::::::::..F#"
t$(35) = "#I..:::::::::///////%%%%%%%%%%%%%%%%>>>>>>>>>%%%%%%%//:::::::::::::..E#"
t$(36) = "#I.........:://///////////////////%%>>>>>>>>>%%//::..................G#"
t$(37) = "#I.........:://%//////////////////%%>>>>>>>>>%%//::..................E#"
t$(38) = "#K======K..:://%//:::::::::::::://%%>>>>>>>>>%%//::..K===============K#"
t$(39) = "########I..:://%//:::::::::::::://%%>>>>>>>>>%%//::..I#########################################"
t$(40) = "#K======K..:://%//::..........:://%%>>>>>>>>>%%//::..K=======================================K#"
t$(41) = "#G.........:://%//::..........:://%%>>>>>>>>>%%//::..........................................I#"
t$(42) = "#E.........:://%//::..KSRQ=K..:://%%>>>>>>>>>%%//::..........................................I#"
t$(43) = "#F..::::::::://%//::..I####I..:://%%>>>>>>>>>%%//::::::::::::::::::::::::::::::::::::::::::..I#"
t$(44) = "#E..::::::::://%//::..I####I..:://%%%%%%%%%%%%%//::::::::::::::::::::::::::::::::::::::::::..I#"
t$(45) = "#G..:://///////%//::..I####I..:://%%%%%%%%%%%%%//::..........................................I#"
t$(46) = "#E..:://///////%//::..I####I..:://///////////%%//::..........................................I#"
t$(47) = "#F..:://%%%%%%%%//::..I####I..:://///////////%%//::..KDBCBDBCBDBCBDBC========================K#"
t$(48) = "#E..:://%%%%%%%%//::..I####I..::::::::::::://%%//::..I#################"
t$(49) = "#G..:://%%>>>>%%//::..I####I..::::::::::::://%%//::..K===============K#"
t$(50) = "#E..:://%%>>>>%%//::..I####I.............:://%%//::..................I#"
t$(51) = "#F..:://%%>>>>%%//::..I####I.............:://%%//::..................I#"
t$(52) = "#E..:://%%>>>>%%//::..I####K==========K..:://%%//::::::::::::::::::..I############"
t$(53) = "#G..:://%%>>>>%%//::..I###############G..:://%%//::::::::::::::::::..KBCBDBCBDBCK#"
t$(54) = "#E..:://%%>>>>%%//::..I###############E..:://%%//////////////////::.............I#"
t$(55) = "#F..:://%%>>>>%%//::..I###############F..:://%%//////////////////::.............I#######"
t$(56) = "#E..:://%%>>>>%%//::..I###############E..:://%%%%%%%%%%%%%%%%%%//:::::::::::::..K=====I#"
t$(57) = "#I..:://%%>>>>%%//::..I###############G..:://%%%%%%%%%%%%%%%%%%//:::::::::::::........G#"
t$(58) = "#I..:://%%>>>>%%//::..I###############E..:://%%>>>>>>>>>>>>>>%%/////////////::........E#"
t$(59) = "#I..:://%%>>>>%%//::..I###############G..:://%%>>>>>>>>>>>>>>%%/////////////::::::::..F#"
t$(60) = "#I..:://%%>>>>%%//::..I###############E..:://%%>>>>>>>>>>>>>>%%%%%%%%%%%%%////////::..E#"
t$(61) = "#I..:://%%>>>>%%//::..I###############F..:://%%>>>>>>>>>>>>>>%%%%%%%%%%%%%////////::..G#"
t$(62) = "#I..:://%%>>>>%%//::..I###############E..:://%%>>>>>>>>>>>>>>>>>>>>>>>>>%%%%%%%%//::..E#"
t$(63) = "#I..:://%%>>>>%%//::..I###############G..:://%%>>>%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%//::..F#"
t$(64) = "#I..:://%%>>>>%%//::..I###############E..:://%%>>>%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%//::..E#"
t$(65) = "#I..:://%%>>>>%%//::..I###############F..:://%%>>>%%//////////////////////%%>>%%//::..G#############################"
t$(66) = "#I..:://%%>>>>%%//::..I###############E..:://%%>>>%%//////////////////////%%>>%%//::..K===========================K#"
t$(67) = "#I..:://%%>>>>%%//::..I###############I..:://%%>>>%%//:::::::::::::::::://%%>>%%//::..............................I#"
t$(68) = "#I..:://%%>>>>%%//::..I###############I..:://%%>>>%%//:::::::::::::::::://%%>>%%//::..............................I#"
t$(69) = "#I..:://%%>>>>%%//::..K===============K..:://%%>>>%%//::..............:://%%>>%%//::::::::::::::::::::::::::::::..I#"
t$(70) = "#I..:://%%>>>>%%//::.....................:://%%>>>%%//::..............:://%%>>%%//::::::::::::::::::::::::::::::..I###########"
t$(71) = "#I..:://%%>>>>%%//::.....................:://%%>>>%%//::..K========K..:://%%>>%%//////////////////////////////::..K=========K#"
t$(72) = "#I..:://%%>>>>%%//::::::::::::::::::::::::://%%>>>%%//::..G########I..:://%%>>%%//////////////////////////////::............I#"
t$(73) = "#I..:://%%>>>>%%//::::::::::::::::::::::::://%%>>>%%//::..E########I..:://%%>>%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%//::............I#"
t$(74) = "#G..:://%%>>>>%%//::.....................:://%%>>>%%//::..F########I..:://%%>>%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%//::::::::::::..G#"
t$(75) = "#E..:://%%>>>>%%//::.....................:://%%>>>%%//::..E########I..:://%%>>>>>>>>>>>>%%////////////////////::::::::::::..E#"
t$(76) = "#F..:://%%>>>>%%//::..K===============K..:://%%>>>%%//::..G########I..:://%%>>>>>>>>>>>>%%//////////////////////////////::..F#"
t$(77) = "#E..:://%%>>>>%%//::..I###############E..:://%%>>>%%//::..E########I..:://%%>>>>>>>>>>>>%%//::::::::::::::://///////////::..E#"
t$(78) = "#G..:://%%>>>>%%//::..I###############G..:://%%>>>%%//::..F########I..:://%%>>>>>>>>>>>>%%//::::::::::::::://%%%%%%%%%//::..G#"
t$(79) = "#E..:://%%>>>>%%//::..I###############E..:://%%>>>%%//::..E########I..:://%%>>>>>>>>>>>>%%//::...........:://%%>>>>>%%//::..E#"
t$(80) = "#F..:://%%>>>>%%//::..I###############F..:://%%>>>%%//::..G########I..:://%%>>>>>>>>>>>>%%//::...........:://%%>>>>>%%//::..F###########"
t$(81) = "#E..:://%%>>>>%%//::..I###############E..:://%%>>>%%//::..E########I..:://%%>>>>>>>>>>>>%%//::..K=====K..:://%%>>>>>%%//::..K=========K#"
t$(82) = "#G..:://%%>>>>%%//::..I###############G..:://%%>>>%%//::..F########I..:://%%>>>>>>>>>>>>%%//::..I#####I..:://%%>>>>>%%//::............G#"
t$(83) = "#E..:://%%>>>>%%//::..I###############E..:://%%>>>%%//::..E########I..:://%%>>>>>>>>>>>>%%//::..I#####I..:://%%>>>>>%%//::............E#"
t$(84) = "#F..:://%%>>>>%%//::..I###############F..:://%%>>>%%//::..G########I..:://%%>>>>>>>>>>>>%%//::..I#####I..:://%%>>>>>%%//::::::::::::..F#"
t$(85) = "#E..:://%%>>>>%%//::..I###############E..:://%%>>>%%//::..E########I..:://%%>>>>>>>>>>>>%%//::..I#####I..:://%%>>>>>%%//::::::::::::..E#"
t$(86) = "#G..:://%%>>>>%%//::..I###############G..:://%%>>>%%//::..F########I..:://%%>>>>>>>>>>>>%%//::..K=====K..:://%%>>>>>%%////////////::..G#"
t$(87) = "#E..:://%%>>>>%%//::..I###############E..:://%%>>>%%//::..E########I..:://%%>>>>>>>>>>>>%%//::...........:://%%>>>>>%%////////////::..E#"
t$(88) = "#F..:://%%>>>>%%//::..I###############F..:://%%>>>%%//::..G########I..:://%%>>>>>>>>>>>>%%//::...........:://%%>>>>>%%%%%%%%%%%%//::..F#"
t$(89) = "#E..:://%%>>>>%%//::..I###############E..:://%%>>>%%//::..E########I..:://%%>>>>>>>>>>>>%%//::::::::::::::://%%>>>>>%%%%%%%%%%%%//::..E#"
t$(90) = "#G..:://%%%%%%%%//::..I###############G..:://%%%%%%%//::..F########I..:://%%%%%%%%%%%%%%%%//::::::::::::::://%%%%%%%%%%%%%%%%%%%//::..G#"
t$(91) = "#E..:://%%%%%%%%//::..I###############E..:://%%%%%%%//::..E########I..:://%%%%%%%%%%%%%%%%///////////////////%%%%%%%%%%%%%%%%%%%//::..E#"
t$(92) = "#F..::////////////::..I###############F..::///////////::..G########I..:://////////////////////////////////////////////////////////::..F#"
t$(93) = "#E..::////////////::..I###############E..::///////////::..E########I..:://////////////////////////////////////////////////////////::..E#"
t$(94) = "#G..::::::::::::::::..I###############G..:::::::::::::::..F########I..::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::..G#"
t$(95) = "#E..::::::::::::::::..I###############E..:::::::::::::::..E########I..::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::..E#"
t$(96) = "#G....................I###############G...................G########I..................................................................G#"
t$(97) = "#E....................I###############E...................E########I..................................................................E#"
t$(98) = "#K====================K###############KDBCBDBCBDBCBDBCBDBCK########K====================BCBDBCBDBCBDBCBDBCBD==========================K#"
t$(99) = "########################################################################################################################################"

REM tablica rysunku

a01$ = "000000000808080808085A5A5A5A5A5A5A5A5A5A5A5A00000000000000000000"
a02$ = "00000808080808085A5A5A5A5A5A5A5A5A5A5A5A5A5A5A5A5A5A000000000000"
a03$ = "000808080808085A5A5A5A5A5A000F5A5A5A5A5A5A5A5A0C0C5A5A5A5A5A0000"
a04$ = "080808080808085A5A5A5A5A0009095A5A5A5A5A5A5A5A5A0C0C5A5A5A5A5A00"
a05$ = "080808080808085A5A5A5A5A5A5A5A5A5A5A5A5A5A5A5A5A0C0C5A5A5A5A5A00"
a06$ = "080808080808085A5A5A5A5A5A5A5A5A5A5A5A5A5A5A5A5A0C0C5A5A5A5A5A00"
a07$ = "080808080808085A5A5A5A5A0009095A5A5A5A5A5A5A5A5A0C0C5A5A5A5A5A00"
a08$ = "000808080808085A5A5A5A5A5A000F5A5A5A5A5A5A5A5A0C0C5A5A5A5A5A0000"
a09$ = "00000808080808085A5A5A5A5A5A5A5A5A5A5A5A5A5A5A5A5A5A5A0000000000"
a10$ = "000000000808080808085A5A5A5A5A5A5A5A5A5A5A5A00000000000000000000"
a11$ = "000000002F2F2F2F000000004F4F4F4F000000006A6A6A6A000000003D3D3D3D"
a12$ = "1F1F1F1F000000003F3F3F3F000000007A7A7A7A000000002C2C2C2C00000000"

REM **************************** dane startowe
dal = 150
kier = 0: REM 0 stopni
xgracza = 25
ygracza = 20

REM ************************************* petla glowna

powtorz:

REM ********** PETLA FOR - BADANIE KOLEJNYCH KATOW
REM t1 i t2 - pomiar predkosci
REM petla for liczona jest w stopniach
REM zmienna k bezposrednio wyznacza tutaj takze wspolrzedna ekranu
REM kier - kierunek gracza, kat - kierunek badania widocznosci
REM xb, yb - wspolrzedne badanych punktow
REM zostana zaokraglone dopiero po stwierdzeniu sciany

ktora = -1
t1 = PEEK(1132)
FOR K = -150 TO 150 STEP 5
ktora = ktora + 1
kat = K + kier
IF kat < 0 THEN kat = 3600 + kat
IF kat > 3599 THEN kat = kat - 3600

xb = xgracza: REM x badania
yb = ygracza: REM y badania

c = cosinus(kat): s = sinus(kat)

REM petla badania widocznosci
petla:
xb = xb + c: yb = yb + s
znak$ = MID$(t$(INT(yb)), INT(xb) + 1, 1)
IF znak$ = ":" THEN xb = xb + c + c: yb = yb + s + s: znak$ = MID$(t$(INT(yb)), INT(xb) + 1, 1): GOTO omin
IF znak$ = "/" THEN xb = xb + c * 4: yb = yb + s * 4: znak$ = MID$(t$(INT(yb)), INT(xb) + 1, 1): GOTO omin
IF znak$ = "%" THEN xb = xb + c * 6: yb = yb + s * 6: znak$ = MID$(t$(INT(yb)), INT(xb) + 1, 1): GOTO omin
IF znak$ = ">" THEN xb = xb + c * 8: yb = yb + s * 8: znak$ = MID$(t$(INT(yb)), INT(xb) + 1, 1)
omin:
IF znak$ <> "." AND znak$ <> ":" AND znak$ <> "/" AND znak$ <> "%" AND znak$ <> ">" THEN
xb = INT(xb): yb = INT(yb)
dx = xgracza - xb: dy = ygracza - yb
odleglosc = SQR(dx ^ 2 + dy ^ 2)
wys = INT((dal / odleglosc) * 7)

COLOR 28: REM KOLOR DLA ELEMENTOW NIEOKRESLONYCH
IF znak$ = "K" THEN COLOR 28
IF znak$ = "I" THEN COLOR 26
IF znak$ = "=" THEN COLOR 30

REM wpis do tablicy
elementy(ktora).znak = znak$
elementy(ktora).xwtabl = xb
elementy(ktora).ywtabl = yb
elementy(ktora).wysokosc = wys
IF wys > 0 THEN GOSUB linia
GOTO wyjscie
END IF

GOTO petla
wyjscie:

NEXT K
GOSUB dotablicy
t2 = PEEK(1132)

REM koniec rysowania planszy

COLOR 15: LOCATE 1, 1: PRINT "dt="; t2 - t1

REM ************* gracz ma wplyw na kolejny ruch

czekaj:
I$ = INKEY$
IF I$ = "" THEN GOTO czekaj
POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury

IF I$ = CHR$(0) + "K" THEN kier = kier - 50
IF I$ = CHR$(0) + "M" THEN kier = kier + 50

IF kier < 0 THEN kier = 3600 + kier: REM plus czyli tutaj minus
IF kier > 3599 THEN kier = kier - 3600

IF I$ = CHR$(0) + "H" THEN GOSUB WPRZOD
IF I$ = CHR$(0) + "P" THEN GOSUB wtyl

GOTO powtorz

REM ************************** GOSUB-RETURN dla ruchu wprzod

WPRZOD:
xs = xgracza
ys = ygracza

xgracza = xgracza + cosinus(kier) * 2
ygracza = ygracza + sinus(kier) * 2

REM ****************** zakaz wchodzenia na mur
znak$ = MID$(t$(ygracza), xgracza + 1, 1)
IF znak$ <> "." AND znak$ <> ":" AND znak$ <> "/" AND znak$ <> "%" AND znak$ <> ">" THEN xgracza = xs: ygracza = ys
RETURN

REM *********************** GOSUB-RETURN dla ruchu w tyl
wtyl:
xs = xgracza
ys = ygracza

xgracza = xgracza - cosinus(kier) * 2
ygracza = ygracza - sinus(kier) * 2

REM ****************** zakaz wchodzenia na mur
znak$ = MID$(t$(ygracza), xgracza + 1, 1)

IF znak$ <> "." AND znak$ <> ":" AND znak$ <> "/" AND znak$ <> "%" AND znak$ <> ">" THEN xgracza = xs: ygracza = ys
RETURN

REM *********************** GOSUN RETURN dla rysowania zwyklych linii
REM nie obrazek - obrazek potem

linia:
pomoc1 = K + 150
pomoc2 = K + 150 + 4

IF znak$ = "Q" OR znak$ = "R" OR znak$ = "S" THEN GOTO wroc

REM zwykla linia
LINE (pomoc1, 120 - wys)-(pomoc2, 120 + wys), , BF

wroc:

LINE (pomoc1, 0)-(pomoc2, 120 - wys - 1), 150, BF
LINE (pomoc1, 120 + wys + 1)-(pomoc2, 200), 20, BF

RETURN

REM *******************************************************
REM GOSUB RETURN - przetworzenie danych tablicy ekranowej

dotablicy:

n = ktora

REM badanie poczatku wystpowania elementu - znaku, ale
REM zgadzac musza sie tez jego wspolrzedne w tablicy labiryntu

FOR I = 0 TO n
IF I = 0 THEN elementy(1).poczatek = 0: GOTO konczpetle
IF elementy(I).znak = elementy(I - 1).znak AND elementy(I).xwtabl = elementy(I - 1).xwtabl AND elementy(I).ywtabl = elementy(I - 1).ywtabl THEN elementy(I).poczatek = elementy(I - 1).poczatek: GOTO konczpetle
elementy(I).poczatek = I
konczpetle:
NEXT I

REM w odwrotna strone - badanie konca wystepowanie elementu

FOR I = n TO 0 STEP -1
IF I = n THEN elementy(I).koniec = n: GOTO konczpetle2
IF elementy(I).znak = elementy(I + 1).znak AND elementy(I).xwtabl = elementy(I + 1).xwtabl AND elementy(I).ywtabl = elementy(I + 1).ywtabl THEN elementy(I).koniec = elementy(I + 1).koniec: GOTO konczpetle2
elementy(I).koniec = I
konczpetle2:
NEXT I

REM ****************************************************
REM zbadaj czy Q,R,S znajduja sie w kolejnych kolumnach tablicy ekranowej

I = -1
petlarysowania:
I = I + 1: REM DAWNIEJ FOR I = 0 TO n - NIE STOSOWAC PETLI BO BEDZIE MIGAC
REM CZYLI WIELE RAZY TO SAMO SPRAWDZAC

wys = elementy(I).wysokosc
xp = elementy(I).poczatek * 5
xk = elementy(I).koniec * 5 + 4

srednia = INT((xp + xk) / 2)
jednaczwarta = INT((xp + srednia) / 2)
trzyczwarte = INT((srednia + xk) / 2)

pomoc1 = xp: pomoc11 = jednaczwarta
pomoc2 = jednaczwarta + 1: pomoc22 = srednia
pomoc3 = srednia + 1: pomoc33 = trzyczwarte
pomoc4 = trzyczwarte + 1: pomoc44 = xk

dh = (wys / 32) * 2

IF elementy(I).znak = "Q" THEN
FOR ii = 0 TO 31
pozycja = ii * 2 + 1
poziom = 120 - wys + ii * dh
col = VAL("&H" + MID$(a01$, pozycja, 2))
LINE (pomoc1, poziom)-(pomoc11, poziom + dh), col, BF
col = VAL("&H" + MID$(a02$, pozycja, 2))
LINE (pomoc2, poziom)-(pomoc22, poziom + dh), col, BF
col = VAL("&H" + MID$(a03$, pozycja, 2))
LINE (pomoc3, poziom)-(pomoc33, poziom + dh), col, BF
col = VAL("&H" + MID$(a04$, pozycja, 2))
LINE (pomoc4, poziom)-(pomoc44, poziom + dh), col, BF
NEXT ii
I = elementy(I).koniec: GOTO petlarysowania
END IF

REM *************************************

IF elementy(I).znak = "R" THEN
FOR ii = 0 TO 31
poziom = 120 - wys + ii * dh
pozycja = ii * 2 + 1
col = VAL("&H" + MID$(a05$, pozycja, 2))
LINE (pomoc1, poziom)-(pomoc11, poziom + dh), col, BF
col = VAL("&H" + MID$(a06$, pozycja, 2))
LINE (pomoc2, poziom)-(pomoc22, poziom + dh), col, BF
col = VAL("&H" + MID$(a07$, pozycja, 2))
LINE (pomoc3, poziom)-(pomoc33, poziom + dh), col, BF
col = VAL("&H" + MID$(a08$, pozycja, 2))
LINE (pomoc4, poziom)-(pomoc44, poziom + dh), col, BF
NEXT ii
I = elementy(I).koniec: GOTO petlarysowania
END IF

REM *************************************

IF elementy(I).znak = "S" THEN
FOR ii = 0 TO 31
poziom = 120 - wys + ii * dh
pozycja = ii * 2 + 1
col = VAL("&H" + MID$(a09$, pozycja, 2))
LINE (pomoc1, poziom)-(pomoc11, poziom + dh), col, BF
col = VAL("&H" + MID$(a10$, pozycja, 2))
LINE (pomoc2, poziom)-(pomoc22, poziom + dh), col, BF
col = VAL("&H" + MID$(a11$, pozycja, 2))
LINE (pomoc3, poziom)-(pomoc33, poziom + dh), col, BF
col = VAL("&H" + MID$(a12$, pozycja, 2))
LINE (pomoc4, poziom)-(pomoc44, poziom + dh), col, BF
NEXT ii
I = elementy(I).koniec: GOTO petlarysowania
END IF

IF I < n GOTO petlarysowania

RETURN

Piotr-246 · Gość

DEF SEG = 0: REM Ustawienie segmentu pamieci dla instrukcji Peek i Poke
SCREEN 13

REM Nowy typ powstal aby zebrac dane o punktach badanych podczas
REM badania ich widocznosci oraz natepnych ich danych

TYPE rekord
znak AS STRING * 1: REM znak jaki wystepuje w tablicy labiryntu
poczatek AS INTEGER: REM poczatek wystepowania tego znaku gdy wystepuje wielokrotnie
koniec AS INTEGER: REM koniec wystepowania tego znaku gdy wystepuje wielokrotnie
xwtabl AS INTEGER: REM wspolrzedna x tego znaku w tablicy labiryntu
ywtabl AS INTEGER: REM wspolrzedna y tego znaku tablicy labiryntu
wysokosc AS INTEGER
END TYPE
DIM elementy(0 TO 310) AS rekord

REM deklaracje tablic, zwykle pierwszy element o indeksie 0

DIM t$(0 TO 99)
DIM labi(0 TO 160, 0 TO 15) AS STRING * 1

REM deklaracje tych zmiennych maja na celu ograniczenie ich wielkosci
REM czyli zwiekszenia predkosci

DIM xgracza, ygracza, n, ktora AS INTEGER
DIM ii, jj, przes, pozp, pozk, xp, xk, r, wys AS INTEGER

CONST pi = 3.14159
REM ...przelicznik stopni na radiany xrad=(pi*xstop)/180

REM mapa geometrii labiryntu.
REM cyfry i litery wyznaczaja POLA a nie punkty
REM Litery zarezerwowane beda dla obrazkow na scianach
REM A - sciana pozioma
REM B - sciana pionowa
REM C - krawedz, bloczek widoczny
REM D - krawedz, bloczek niewidoczny
REM kropka, drukropek, "/", "%" oraz ">" oznaczaja punkty
REM oddalone od scian i pozwalaja na skok wektora badania o kilka pozycji
REM znak # - bezwzgledny mur

t$(0) = "##############################################################################################################################################################"
t$(1) = "#DAAAAAAAAAAAAAAAAD###DAAAAAAAAAAAAAAAAAAAAAD###DAAAAAAD##DAAAAAD######DAAAAAD##DAAAAAAAAAAAAAAAAD###DAAAAAAAAAAAAAAAAAAAAAD###DAAAAAAD##DAAAAAD######DAAAAAD#"
t$(2) = "#B................B###B.....................B###B......B##B.....B######B.....B##B................B###B.....................B###B......B##B.....B######B.....B#"
t$(3) = "#B.::::::::::::::.B###B.:::::::::::::::::::.B###B.::::.B##B.:::.B######B.:::.B##B.::::::::::::::.B###B.:::::::::::::::::::.B###B.::::.B##B.:::.B######B.:::.B#"
t$(4) = "#B....://///////:.CAAAC.:/:.......:///////:.B###B.://:.CAAA.:/:.DAAAAAAD.:::.B##B.:////////////:.CAAAC.://///////////////:.B###B.://:.CAAA.:/:.DAAAAAAD.:::.B#"
t$(5) = "#DAAC.:/%%%%%%%/:.......:/:.CAAAC.:/%%%%%/:.B###B.://:......:::..........:::.B##D.:/%%%%%%%%%%/:.......:/:::::::::/%%%%%/:.B###B.://:......:::..........:::.B#"
t$(6) = "###CB.:/%>%/////:::::::::/:.Q###B.:/%>>>%/:.CAAAC.://:::::::.......:::::::::.CAAC.:/%>>>>%/////:::::::::/:.......:/%>>>%/:.CAAAC.://:::::::.......::........B#"
t$(7) = "####B.:/%>%/:::::::://////:.R###B.:/%>>>%/:.......::::::///:.CAAAC.:///////:......:/%>>>>%/:::::::://////:.CAAAC.:/%>>>%/:.......::::::///:.CAAAC.::.CAAAAAAD#"
t$(8) = "#DAAC.:/%%%/:......:/%%%%/:.S###B.:/%%%%%/::::::.......:///:.B###B.:/%%%%%/:......:/%%%%%%/:......:/%%%%/:.B###B.:/%%%%%/::::::.......:///:.B###B.::.B########"
t$(9) = "#B....://///:.CAAC.://////:.B###B.:////////////:.CAAAC.:///:.B###B.:///////:.CAAC.:////////:.CAAC.://////:.B###B.:////////////:.CAAAC.:///:.B###B.::.CAAAAAAD#"
t$(10) = "#B.::::::::::.B##B.::::::::.B###B.::::::::::::::.B###B.:::::.B###B.:::::::::.B##B.::::::::::.B##B.::::::::.B###B.::::::::::::::.B###B.:::::.B###B.::........B#"
t$(11) = "#B............B##B..........B###B................B###B.......B###B...........B##B............B##B..........B###B................B###B.......B###B...........B#"
t$(12) = "#DAAAAAAAAAAAAD##DAAAAAAAAAAD###DAAAAAAAAAAAAAAAAD###DAAAAAAAD###DAAAAAAAAAAAD##DAAAAAAAAAAAAD##DAAAAAAAAAAD###DAAAAAAAAAAAAAAAAD###DAAAAAAAD###DAAAAAAAAAAAD#"
t$(13) = "##############################################################################################################################################################"

REM Przetworzenie ciagow znakowych labiryntu na tablice znakowa
REM PRINT LEN(t$(13)); "..."
FOR yy = 0 TO 13
FOR xx = 0 TO 157
pom$ = MID$(t$(yy), xx + 1, 1)
IF pom$ = "" THEN pom$ = "#"
labi(xx, yy) = pom$
NEXT xx
t$(yy) = "": REM czyszczenie pamieci
NEXT yy
GOSUB zaladujobraz

REM **************************** dane startowe
dal = 50: REM przelicznik optyczny dla obliczenia wysokosci sciany
kier = 0: REM kierunek patrzenia gracza ustawiony na 0 stopni
xgracza = 7: REM wspolrzedne gracza w tablicy labiryntu
ygracza = 6

REM ************************************* petla glowna

REM ********** PETLA FOR - BADANIE KOLEJNYCH KATOW
REM t1, t2 i dalsze - pomiar predkosci
REM petla for liczona jest w stopniach
REM zmienna k bezposrednio wyznacza tutaj takze wspolrzedna ekranu
REM kier - kierunek gracza, kat - kierunek badania widocznosci
REM xb, yb - wspolrzedne badanych punktow
REM zostana zaokraglone do xbint =int(xb+0.5)
REM zaokraglone, a nie obciete

POWTORZ: REM miejsce powrotu po kolejnym ruchu gracza

ktora = -1: REM ustawienie pozycji zapisania elementu w tablicach ekranowych
t1 = PEEK(1132)

FOR K = -150 TO 150 STEP 4: REM petla kata badania, krok co 4 stpnie (i co 4 pixele)

ktora = ktora + 1
kat = (K / 10) + kier
IF kat < 0 THEN kat = 360 + kat: REM poprawki dla przeliczania stopni
IF kat > 359.9 THEN kat = kat - 360: REM w przedziale <0-360)
xb = xgracza: REM ustalenie wpolrzenych nowego badania
yb = ygracza

s = SIN((pi * kat) / 180)
c = COS((pi * kat) / 180)

REM petla badania widocznosci
petla:
xb = xb + c
yb = yb + s

GOSUB zaokraglij: REM zaokraglowe wartosci miejsca badania

znak$ = labi(xbint, ybint): REM odczytanie badanego znaku
skok = 0: REM tutaj nastepuje przyspieszenie badania
IF znak$ = ":" THEN skok = 1: GOTO omin
IF znak$ = "/" THEN skok = 2: GOTO omin
IF znak$ = "%" THEN skok = 3: GOTO omin
IF znak$ = ">" THEN skok = 4
omin:
IF skok > 0 THEN
xb = xb + c * skok
yb = yb + s * skok
GOSUB zaokraglij

znak$ = labi(xbint, ybint)
END IF

IF skok = 0 AND znak$ <> "." THEN

elementy(ktora).xwtabl = xbint: REM musza byc przed gosub
elementy(ktora).ywtabl = ybint

GOSUB przeciecie

REM wpis danych elementu do tablicy ekranowej
elementy(ktora).znak = znak$
elementy(ktora).wysokosc = wys

GOTO wyjscie
END IF

GOTO petla: REM koniec petli badania daego kierunku
wyjscie:

NEXT K: REM koniec badania pola widzenia

t2 = PEEK(1132): REM pomiar czasu

GOSUB dotablicy: REM skok do alizy elementow
t3 = PEEK(1132): REM pomiar czasu

GOSUB linia: REM RYSOWANIE Z TABLICY
t4 = PEEK(1132): REM pomiar czasu

i = -1
GOSUB petlarysowania: REM rysowanie obrazkow na scianach

REM koniec rysowania planszy

COLOR 15: LOCATE 1, 1:
PRINT "bad.wid="; t2 - t1
PRINT "przetw="; t3 - t2
PRINT "rys="; t4 - t3

REM ********************************************************
REM ************* gracz ma wplyw na kolejny ruch
REM ********************************************************

czekaj:
i$ = INKEY$
IF i$ = CHR$(27) THEN END
IF i$ = "" THEN GOTO czekaj
POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury

IF i$ = CHR$(0) + "K" THEN kier = kier - 5
IF i$ = CHR$(0) + "M" THEN kier = kier + 5

IF kier < 0 THEN kier = 360 + kier: REM plus czyli tutaj minus
IF kier > 359.9 THEN kier = kier - 360

IF i$ = CHR$(0) + "H" THEN GOSUB WPRZOD
IF i$ = CHR$(0) + "P" THEN GOSUB wtyl

GOTO POWTORZ

REM ************************** GOSUB-RETURN dla ruchu wprzod

WPRZOD:
xs = xgracza
ys = ygracza

REM krok wprzod gracza nastpeje po linii kata wiedzenia
s = SIN(pi * kier / 180)
c = COS(pi * kier / 180)

xgracza = xgracza + 2 * c
ygracza = ygracza + 2 * s

REM ****************** zakaz wchodzenia na mur
znak$ = labi(xgracza, ygracza)

IF znak$ <> "." AND znak$ <> ":" AND znak$ <> "/" AND znak$ <> "%" AND znak$ <> ">" THEN xgracza = xs: ygracza = ys
RETURN

REM *********************** GOSUB-RETURN dla ruchu w tyl
wtyl:
xs = xgracza
ys = ygracza
s = SIN(pi * kier / 180)
c = COS(pi * kier / 180)

xgracza = xgracza - 2 * c
ygracza = ygracza - 2 * s

REM ****************** zakaz wchodzenia na mur
znak$ = labi(xgracza, ygracza)

IF znak$ <> "." AND znak$ <> ":" AND znak$ <> "/" AND znak$ <> "%" AND znak$ <> ">" THEN xgracza = xs: ygracza = ys
RETURN

REM ****************************************************************
REM ***** GOSUB RETURN - przetworzenie danych tablicy ekranowej
REM ****************************************************************
dotablicy:

n = ktora: REM n to liczba elementow tablic ekranowych

REM badanie poczatku wystepowania elementu - znaku, ale
REM zgadzac musza sie tez jego wspolrzedne w tablicy labiryntu

FOR i = 0 TO n
IF i = 0 THEN elementy(0).poczatek = 0: GOTO konczpetle
IF elementy(i).znak = elementy(i - 1).znak AND elementy(i).xwtabl = elementy(i - 1).xwtabl AND elementy(i).ywtabl = elementy(i - 1).ywtabl THEN elementy(i).poczatek = elementy(i - 1).poczatek: GOTO konczpetle
elementy(i).poczatek = i
konczpetle:
NEXT i

REM w odwrotna strone - badanie konca wystepowanie elementu

FOR i = n TO 0 STEP -1
IF i = n THEN elementy(i).koniec = n: GOTO konczpetle2
IF elementy(i).znak = elementy(i + 1).znak AND elementy(i).xwtabl = elementy(i + 1).xwtabl AND elementy(i).ywtabl = elementy(i + 1).ywtabl THEN elementy(i).koniec = elementy(i + 1).koniec: GOTO konczpetle2
elementy(i).koniec = i
konczpetle2:
NEXT i

RETURN

REM ******************************************************************
REM *************** GOSUN RETURN dla rysowania zwyklych linii
REM *************** rysowanie odbywa sie z tablicy

linia:

FOR i = 0 TO n: REM n - ustalony WCZEJSNIEJ ROZMIAR TABLIC EKRANOWYCH

ktory = i - elementy(i).poczatek
wys = elementy(i).wysokosc
znak$ = elementy(i).znak

COLOR 28: REM KOLOR DLA ELEMENTOW NIEOKRESLONYCH
IF znak$ = "A" THEN COLOR 26
IF znak$ = "B" THEN COLOR 30

pomoc1 = i * 4
pomoc2 = i * 4 + 3: REM plus zalezy od ustalonej dokladnosci ekranowej

REM czyszczenie podlogi i sufitu (lub nieba) z poprzednich rysunkow

IF ASC(znak$) >= 81 THEN GOTO nierysuj: REM obrazki nie rysowane tutaj

IF wys <= 0 THEN wys = 0: GOTO nierysuj
IF wys > 120 THEN wys = 120

LINE (pomoc1, 0)-(pomoc2, 120 - wys - 1), 150, BF
LINE (pomoc1, 120 + wys + 1)-(pomoc2, 200), 20, BF

REM zwykla linia
LINE (pomoc1, 120 - wys)-(pomoc2, 120 + wys), , BF
nierysuj:
NEXT i
REM nierysuj:

RETURN
REM *************************************************************
REM obliczenie punktow przeciecia

przeciecie:
xb = xb - .1 * c: REM wspolrzedna badania cofnieta o 0.1 cosinusa
yb = yb - .1 * s: REM wspolrzedna badania cofnieta o 0.1 sinusa
GOSUB zaokraglij
back$ = labi(xbint, ybint)
IF ASC(back$) < 64 THEN GOTO znalazlem
GOTO przeciecie

znalazlem:
odleglosc = SQR((xgracza - xb) ^ 2 + (ygracza - yb) ^ 2)
wys = INT((dal / odleglosc) * 7)
RETURN

REM********************** prawidlowe zaokraglanie xb yb

zaokraglij:
xbint = INT(xb)
ulamek = ABS(xb - INT(xb))
IF xb > 0 AND ulamek >= .5 THEN xbint = xbint + 1
IF xb < 0 AND ulamek >= .5 THEN xbint = xbint - 1

ybint = INT(yb)
ulamek = ABS(yb - INT(yb))
IF yb > 0 AND ulamek >= .5 THEN ybint = ybint + 1
IF yb < 0 AND ulamek >= .5 THEN ybint = ybint - 1
RETURN

REM *************************************************************
REM ******* Od tego miejsca beda umieszczane procedury
REM ******* zwiazane z naklejaniem obrazkow

zaladujobraz:
DIM obraz(0 TO 23, 0 TO 31) AS STRING * 1
DIM a$(0 TO 31)
REM 24x32

a$(0) = "0F0F0F0F0F0F0101010101010101010101010101010E0E0E"
a$(1) = "0F0F0F0F0F010101010202020202020201010101010E0E0E"
a$(2) = "0F0F0F0F0101010102020202020202020201010101010E0E"
a$(3) = "010101010101010202020602020202020202010101010101"
a$(4) = "010101010101020202020602020202060202020101010101"
a$(5) = "010101010102020202020602020202060202020201010101"
a$(6) = "010101010102020202020602020206020202020201010101"
a$(7) = "010101010102020602020602020206020206020201010101"
a$(8) = "010101010102020602020206020206020206020201010101"
a$(9) = "010101010102020206020206020602020602020201010101"
a$(10) = "010101010102020206020206020602020602020201010101"
a$(11) = "010101010102020202060206020602020602020201010101"
a$(12) = "010101010102020202060206060602060202020201010101"
a$(13) = "010101010102020202020606060606020202020201010101"
a$(14) = "010101010102020602020206060602020206020201010101"
a$(15) = "010101010101020206020206060602020602020101010101"
a$(16) = "080808080808080202060206060602060202080808080808"
a$(17) = "080808080808080802020606060606020208080808080808"
a$(18) = "080808080808080808020206060602020808080808080808"
a$(19) = "080808080808080808080806060608080808080808080808"
a$(20) = "080808080808080808080806060608080808080808080808"
a$(21) = "070707070707070707070706060607070707070707070707"
a$(22) = "070707070707070707070706060607070707070707070707"
a$(23) = "070707070707070707070706060607070707070707070707"
a$(24) = "070707070707070707070706060607070707070707070707"
a$(25) = "070707070707070707070706060607070707070707070707"
a$(26) = "070707070707070707070706060607070707070707070707"
a$(27) = "070707070707050707070706060607070507070705070707"
a$(28) = "070707070707020707070706060607070207070702070707"
a$(29) = "020202020202020202020606060606020202020202020202"
a$(30) = "020202020202020202060606060606060202020202020202"
a$(31) = "020202020202020202020202020202020202020202020202"

FOR y = 0 TO 31
FOR x = 0 TO 23
obraz(x, y) = CHR$(VAL("&H" + MID$(a$(y), x * 2 + 1, 2)))
NEXT x
a$(y) = "": REM czyszczenie pamieci
NEXT y
RETURN

REM **************************************************
REM ******************** Rysowanie znakow Q,R,S
REM **************************************************

REM zbadaj czy Q,R,S znajduja sie w kolejnych kolumnach tablicy ekranowej

REM wczesniej jest i = -1
petlarysowania:

i = i + 1: REM DAWNIEJ FOR I = 0 TO n - Nie stosowac petli FOR
REM bo bedzie migac, czyli kilka razy to samo sprawdzac.
REM Lepiej aby prostokaty zachodzily na siebie niz aby byla jakas luka.

REM ustalenie danych pikselowych
REM program przewiduje zmienna wysokosc elementu

wys = elementy(i).wysokosc

xp = elementy(i).poczatek * 4: REM wspolrzedna poczatku elementu
xk = elementy(i).koniec * 4 + 3: REM wspolrzedna konca elementu

wysp = elementy(elementy(i).poczatek).wysokosc: REM wysokosc pierwszego elementu wsrod elementow identycznyc
wysk = elementy(elementy(i).koniec).wysokosc: REM wysokosc ostatniego elementu wsrod elementow identycznych

r = xk - xp + 1: REM dlugosc wystepowania
REM danego elementu w tablicy ekranowej od 1 zaczynajac

dxe = r / 8: REM jednostkowa szerokosc danego koloru
REM (sposrod 8 przypadajacych na jeden element)

rh = wysk - wysp: REM roznica wysokosci ekranowej pierwszej i ostatniej kolumny tego samego elementu
dw = rh / 8: REM jednoskowa wysokosc ekranowa danej komorki tablicy obrazka

IF elementy(i).znak = "Q" THEN przes = 0: GOTO rysujmatryce
IF elementy(i).znak = "R" THEN przes = 8: GOTO rysujmatryce
IF elementy(i).znak = "S" THEN przes = 16: GOTO rysujmatryce

REM *************************************

IF i < n GOTO petlarysowania
COLOR 0: LINE (304, 0)-(304, 200)

RETURN

REM ------------------- wskok przez GOTO i powrot przez GOTO
rysujmatryce:
dm0 = PEEK(1132)

FOR jj = 0 TO 7: REM petla kolumn rysunku

wys = wysp + dw * jj: REM wys -tutaj wysokosc polowkaowa sciany w tym miescu
dh = (wys / 32) * 2: REM jednostowa wysokosc komorki tablicy obrazka

LINE (xp + dxe * jj, 0)-(xp + dxe * (jj + 1), 120 - wys), 150, BF
LINE (xp + dxe * jj, 120 + wys + dw * 8 - 1)-(xp + dxe * (jj + 1), 200), 20, BF

FOR ii = 0 TO 31
pozp = 120 - wys + ii * dh: REM wysokosc gornej krawedzi komorki obrazka
pozk = pozp + dh: REM wysokosc dolnej krawedzi komorki obrazka

LINE (xp + dxe * jj, pozp)-(xp + dxe * (jj + 1), pozk), ASC(obraz(jj + przes, ii)), BF
NEXT ii
NEXT jj
i = elementy(i).koniec: REM pominiecie badania tych samych znakow w tablicy ekranowej
dm1 = PEEK(1132)
GOTO petlarysowania