Forum Życie Wieczne Strona Główna Życie Wieczne

 
 FAQFAQ   SzukajSzukaj   UżytkownicyUżytkownicy   GrupyGrupy   GalerieGalerie   RejestracjaRejestracja 
 ProfilProfil   Zaloguj się, by sprawdzić wiadomościZaloguj się, by sprawdzić wiadomości   ZalogujZaloguj 

Mikrogra
Idź do strony 1, 2  Następny
 
Napisz nowy temat   Odpowiedz do tematu    Forum Życie Wieczne Strona Główna -> Offtopic
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
Piotr-246
Gość






PostWysłany: Pią 13:02, 10 Wrz 2021    Temat postu: Mikrogra

SCREEN 13
REM dane labiryntu
REM 0=brak: 1=gora: 2=prawo: 3=goraprawo
REM 4=dol: 5=goradol: 6=dolprawo: 7=gora+dol+prawo
REM 8=lewo:9=lewogora:A=lewo+prawo:B=lewo+prawo+gora
REM C=lewodol:D=gora+dol+lewo:E=lewo+dol+prawo:Flewo+prawo+gora+dol
lab$(0) = "6AAAAEAAAC"
lab$(1) = "56AAC7AAC5"
lab$(2) = "5568556C55"
lab$(3) = "553A955155"
lab$(4) = "53AAAD3A95"
lab$(5) = "7AAAAFAAAD"
lab$(6) = "56AAAD6AC5"
lab$(7) = "552AC53855"
lab$(8) = "53AA97AA95"
lab$(9) = "3AAAABAAA9"
REM dane startowe
xr = 5: yr = 5
x = 6: y = 6
xs = 6: ys = 6
REM rysowanie planszy
rysuj:
z$ = MID$(lab$(yr), xr + 1, 1)
zl = VAL("&H" + z$)
CLS
FOR i = 1 TO 4: PRINT "############": NEXT i
FOR i = 1 TO 4: PRINT "####....####": NEXT i
FOR i = 1 TO 4: PRINT "############": NEXT i

IF (zl AND 1) = 1 THEN
LOCATE 1, 1
PRINT "####....####"
PRINT "####....####"
PRINT "####....####"
PRINT "####....####"
END IF
IF (zl AND 2) = 2 THEN
LOCATE 5, 1
PRINT "####........"
PRINT "####........"
PRINT "####........"
PRINT "####........"
END IF
IF (zl AND 4) = 4 THEN
LOCATE 9, 1
PRINT "####....####"
PRINT "####....####"
PRINT "####....####"
PRINT "####....####"
END IF
IF (zl AND 8) = 8 THEN
LOCATE 5, 1
PRINT "...."
PRINT "...."
PRINT "...."
PRINT "...."
END IF
LOCATE 13, 1: PRINT "room"; xr; "/"; yr; " "
GOTO wstaw
petla:
k$ = INKEY$
IF k$ = "" THEN GOTO petla
IF k$ = "a" THEN x = x - 1
IF k$ = "d" THEN x = x + 1
IF k$ = "w" THEN y = y - 1
IF k$ = "x" THEN y = y + 1
IF k$ = CHR$(27) THEN END
IF x > 12 THEN x = 1: xs = 1: xr = xr + 1: GOTO rysuj
IF x < 1 THEN x = 12: xs = 12: xr = xr - 1: GOTO rysuj
IF y > 12 THEN y = 1: ys = 1: yr = yr + 1: GOTO rysuj
IF y < 1 THEN y = 12: ys = 12: yr = yr - 1: GOTO rysuj
IF SCREEN(y, x) = ASC("#") THEN x = xs: y = ys: GOTO petla
wstaw:
LOCATE ys, xs: PRINT ".";
LOCATE y, x: PRINT CHR$(2);
xs = x: ys = y
GOTO petla
Powrót do góry
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
Piotr-246
Gość






PostWysłany: Pią 14:51, 10 Wrz 2021    Temat postu:

SCREEN 13
REM dane labiryntu
REM 0=brak: 1=gora: 2=prawo: 3=goraprawo
REM 4=dol: 5=goradol: 6=dolprawo: 7=gora+dol+prawo
REM 8=lewo:9=lewogora:A=lewo+prawo:B=lewo+prawo+gora
REM C=lewodol:D=gora+dol+lewo:E=lewo+dol+prawo:Flewo+prawo+gora+dol
lab$(0) = "6AAAAEAAAC"
lab$(1) = "56AAC7AAC5"
lab$(2) = "5568556C55"
lab$(3) = "553A955155"
lab$(4) = "53AAAD3A95"
lab$(5) = "7AAAAFAAAD"
lab$(6) = "56AAAD6AC5"
lab$(7) = "552AC53855"
lab$(8) = "53AA97AA95"
lab$(9) = "3AAAABAAA9"
REM dane startowe
xr = 5: yr = 5
x = 6: y = 6: xs = 6: ys = 6
REM dane elementow
e1$ = "ABCD": e2$ = "CDAB": e3$ = "DBCA": e4$ = "BDAC"
e5$ = "EFGH": e6$ = "HGFE"
p$ = "...."

REM rysowanie planszy
rysuj:
z$ = MID$(lab$(yr), xr + 1, 1)
zl = VAL("&H" + z$)
CLS
FOR i = 1 TO 2:
PRINT e1$ + e2$ + e3$
PRINT e4$ + e5$ + e6$
NEXT i
FOR i = 1 TO 2
PRINT e4$ + p$ + e5$
PRINT e6$ + p$ + e1$
NEXT i
FOR i = 1 TO 2
PRINT e6$ + e1$ + e2$
PRINT e3$ + e4$ + e5$
NEXT i

IF (zl AND 1) = 1 THEN
LOCATE 1, 1
PRINT e2$ + p$ + e3$
PRINT e4$ + p$ + e1$
PRINT e5$ + p$ + e6$
PRINT e1$ + p$ + e2$
END IF
IF (zl AND 2) = 2 THEN
LOCATE 5, 1
PRINT e2$ + p$ + p$
PRINT e3$ + p$ + p$
PRINT e4$ + p$ + p$
PRINT e1$ + p$ + p$
END IF
IF (zl AND 4) = 4 THEN
LOCATE 9, 1
PRINT e2$ + p$ + e3$
PRINT e4$ + p$ + e1$
PRINT e5$ + p$ + e6$
PRINT e1$ + p$ + e2$
END IF
IF (zl AND 8) = 8 THEN
LOCATE 5, 1
PRINT p$: PRINT p$: PRINT p$: PRINT p$
END IF
LOCATE 14, 1: PRINT "room"; xr; "/"; yr; " "
GOTO wstaw
petla:
k$ = INKEY$
IF k$ = "" THEN GOTO petla
IF k$ = "a" THEN x = x - 1
IF k$ = "d" THEN x = x + 1
IF k$ = "w" THEN y = y - 1
IF k$ = "x" THEN y = y + 1
IF k$ = CHR$(27) THEN END
IF x > 12 THEN x = 1: xs = 1: xr = xr + 1: GOTO rysuj
IF x < 1 THEN x = 12: xs = 12: xr = xr - 1: GOTO rysuj
IF y > 12 THEN y = 1: ys = 1: yr = yr + 1: GOTO rysuj
IF y < 1 THEN y = 12: ys = 12: yr = yr - 1: GOTO rysuj
IF SCREEN(y, x) <> ASC(".") THEN x = xs: y = ys: GOTO petla
wstaw:
LOCATE ys, xs: PRINT ".";
LOCATE y, x: PRINT CHR$(2);
xs = x: ys = y
GOTO petla
Powrót do góry
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
Piotr-246
Gość






PostWysłany: Pią 16:30, 10 Wrz 2021    Temat postu:

SCREEN 13
DIM typ$(0 TO 15)
DIM g1(0 TO 16) AS LONG
DIM g2(0 TO 16) AS LONG
DIM g3(0 TO 16) AS LONG
DIM g4(0 TO 16) AS LONG
DIM g5(0 TO 16) AS LONG
DIM g6(0 TO 16) AS LONG
DIM g7(0 TO 16) AS LONG
DIM g8(0 TO 16) AS LONG

REM dane labiryntu
REM 0=brak przejsc: 1=gora: 2=prawo: 3=goraprawo
REM 4=dol: 5=goradol: 6=dolprawo: 7=gora+dol+prawo
REM 8=lewo:9=lewogora:A=lewo+prawo:B=lewo+prawo+gora
REM C=lewodol:D=gora+dol+lewo:E=lewo+dol+prawo:Flewo+prawo+gora+dol
lab$(0) = "6AAAAEAAAC"
lab$(1) = "56AAC7AAC5"
lab$(2) = "5568556C55"
lab$(3) = "553A955155"
lab$(4) = "53AAAD3A95"
lab$(5) = "7AAAAFAAAD"
lab$(6) = "56AAAD6AC5"
lab$(7) = "552AC53855"
lab$(8) = "53AA97AA95"
lab$(9) = "3AAAABAAA9"

typ$(0) = "#########"
typ$(1) = "#.#######"
typ$(2) = "####..###"
typ$(3) = "#.##..###"
typ$(4) = "#######.#"
typ$(5) = "#.##.##.#"
typ$(6) = "####..#.#"
typ$(7) = "#.##..#.#"
typ$(8) = "###..####"
typ$(9) = "#.#..####"
typ$(10) = "###...###"
typ$(11) = "#.#...###"
typ$(12) = "###..##.#"
typ$(13) = "#.#..##.#"
typ$(14) = "###...#.#"
typ$(15) = "#.#...#.#"

REM dane startowe
xr = 5: yr = 5
x = 6: y = 6: xs = 6: ys = 6
REM dane elementow
e1$ = "ABCD": e2$ = "CDAB": e3$ = "DBCA": e4$ = "BDAC"
e5$ = "EFGH": e6$ = "HGFE"
p$ = "...."
bi$(0) = "01110111" + "11111111" + "00011000" + "11111111" + "01100000" + "11111111" + "01111110" + "11101110"
bi$(1) = "01110111" + "10000001" + "00100100" + "11111111" + "10010000" + "00000000" + "10000001" + "11100000"
bi$(2) = "01110111" + "10000001" + "01000010" + "01111111" + "01110011" + "11111111" + "10001101" + "00001110"
bi$(3) = "00000000" + "10000001" + "10000001" + "01010101" + "00001011" + "00000000" + "10000101" + "11101110"
bi$(4) = "11011101" + "10000001" + "10000001" + "00010101" + "00000100" + "11111111" + "10000001" + "11101110"
bi$(5) = "11011101" + "10000001" + "01000010" + "00010100" + "00011100" + "00000000" + "10000001" + "11100000"
bi$(6) = "11011101" + "10000001" + "00100100" + "00010000" + "00110010" + "11111111" + "10000001" + "00001110"
bi$(7) = "00000000" + "11111111" + "00011000" + "00000000" + "00000010" + "00000000" + "01111110" + "11101110"
FOR yb = 0 TO 7
FOR xb = 0 TO 63
znak$ = MID$(bi$(yb), xb + 1, 1)
znak = VAL(znak$)
COLOR 15 * znak: PSET (xb, yb)
NEXT xb
NEXT yb
GET (0, 0)-(7, 7), g1
GET (8, 0)-(15, 7), g2
GET (16, 0)-(23, 7), g3
GET (24, 0)-(31, 7), g4
GET (32, 0)-(39, 7), g5
GET (40, 0)-(47, 7), g6
GET (48, 0)-(55, 7), g7
GET (56, 0)-(63, 7), g8


REM rysowanie planszy
rysuj:
z$ = MID$(lab$(yr), xr + 1, 1)
zl = VAL("&H" + z$)

CLS
COLOR 15

LOCATE 1, 1
t$ = typ$(zl)
FOR i = 0 TO 3
FOR j = 0 TO 2
te$ = MID$(t$, j + 1, 1)
IF te$ = "#" THEN PRINT e1$;
IF te$ = "." THEN PRINT p$;
NEXT j
PRINT
NEXT i

FOR i = 0 TO 3
FOR j = 0 TO 2
te$ = MID$(t$, j + 4, 1)
IF te$ = "#" THEN PRINT e4$;
IF te$ = "." THEN PRINT p$;
NEXT j
PRINT
NEXT i

FOR i = 0 TO 3
FOR j = 0 TO 2
te$ = MID$(t$, j + 7, 1)
IF te$ = "#" THEN PRINT e5$;
IF te$ = "." THEN PRINT p$;
NEXT j
PRINT
NEXT i


LOCATE 14, 1: PRINT "room"; xr; "/"; yr; " "

GOTO wstaw
petla:
k$ = INKEY$
IF k$ = "" THEN GOTO petla
IF k$ = "a" OR k$ = CHR$(0) + "K" THEN x = x - 1
IF k$ = "d" OR k$ = CHR$(0) + "M" THEN x = x + 1
IF k$ = "w" OR k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = "x" OR k$ = CHR$(0) + "P" THEN y = y + 1
IF k$ = CHR$(27) THEN END
IF x > 12 THEN x = 1: xs = 1: xr = xr + 1: GOTO rysuj
IF x < 1 THEN x = 12: xs = 12: xr = xr - 1: GOTO rysuj
IF y > 12 THEN y = 1: ys = 1: yr = yr + 1: GOTO rysuj
IF y < 1 THEN y = 12: ys = 12: yr = yr - 1: GOTO rysuj
IF SCREEN(y, x) <> ASC(".") THEN x = xs: y = ys: GOTO petla
wstaw:
LOCATE ys, xs: PRINT ".";
LOCATE y, x: PRINT CHR$(2);
xs = x: ys = y
GOTO petla
Powrót do góry
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
Piotr-246
Gość






PostWysłany: Pią 16:41, 10 Wrz 2021    Temat postu:

SCREEN 13
DIM typ$(0 TO 15)
DIM g1(0 TO 16) AS LONG
DIM g2(0 TO 16) AS LONG
DIM g3(0 TO 16) AS LONG
DIM g4(0 TO 16) AS LONG
DIM g5(0 TO 16) AS LONG
DIM g6(0 TO 16) AS LONG
DIM g7(0 TO 16) AS LONG
DIM g8(0 TO 16) AS LONG

REM dane labiryntu
REM 0=brak przejsc: 1=gora: 2=prawo: 3=goraprawo
REM 4=dol: 5=goradol: 6=dolprawo: 7=gora+dol+prawo
REM 8=lewo:9=lewogora:A=lewo+prawo:B=lewo+prawo+gora
REM C=lewodol:D=gora+dol+lewo:E=lewo+dol+prawo:Flewo+prawo+gora+dol
lab$(0) = "6AAAAEAAAC"
lab$(1) = "56AAC7AAC5"
lab$(2) = "5568556C55"
lab$(3) = "553A955155"
lab$(4) = "53AAAD3A95"
lab$(5) = "7AAAAFAAAD"
lab$(6) = "56AAAD6AC5"
lab$(7) = "552AC53855"
lab$(8) = "53AA97AA95"
lab$(9) = "3AAAABAAA9"

REM 15 typow plansz

typ$(0) = "#########"
typ$(1) = "#.#######"
typ$(2) = "####..###"
typ$(3) = "#.##..###"
typ$(4) = "#######.#"
typ$(5) = "#.##.##.#"
typ$(6) = "####..#.#"
typ$(7) = "#.##..#.#"
typ$(8) = "###..####"
typ$(9) = "#.#..####"
typ$(10) = "###...###"
typ$(11) = "#.#...###"
typ$(12) = "###..##.#"
typ$(13) = "#.#..##.#"
typ$(14) = "###...#.#"
typ$(15) = "#.#...#.#"

REM dane startowe
xr = 5: yr = 5
x = 6: y = 6: xs = 6: ys = 6
REM dane elementow
e1$ = "ABCD": e2$ = "CDAB": e3$ = "DBCA": e4$ = "BDAC"
e5$ = "EFGH": e6$ = "HGFE"
p$ = "...."
bi$(0) = "01110111" + "11111111" + "00011000" + "11111111" + "01100000" + "11111111" + "01111110" + "11101110"
bi$(1) = "01110111" + "10000001" + "00100100" + "11111111" + "10010000" + "00000000" + "10000001" + "11100000"
bi$(2) = "01110111" + "10000001" + "01000010" + "01111111" + "01110011" + "11111111" + "10001101" + "00001110"
bi$(3) = "00000000" + "10000001" + "10000001" + "01010101" + "00001011" + "00000000" + "10000101" + "11101110"
bi$(4) = "11011101" + "10000001" + "10000001" + "00010101" + "00000100" + "11111111" + "10000001" + "11101110"
bi$(5) = "11011101" + "10000001" + "01000010" + "00010100" + "00011100" + "00000000" + "10000001" + "11100000"
bi$(6) = "11011101" + "10000001" + "00100100" + "00010000" + "00110010" + "11111111" + "10000001" + "00001110"
bi$(7) = "00000000" + "11111111" + "00011000" + "00000000" + "00000010" + "00000000" + "01111110" + "11101110"
FOR yb = 0 TO 7
FOR xb = 0 TO 63
znak$ = MID$(bi$(yb), xb + 1, 1)
znak = VAL(znak$)
COLOR 15 * znak: PSET (xb, yb)
NEXT xb
NEXT yb
GET (0, 0)-(7, 7), g1
GET (8, 0)-(15, 7), g2
GET (16, 0)-(23, 7), g3
GET (24, 0)-(31, 7), g4
GET (32, 0)-(39, 7), g5
GET (40, 0)-(47, 7), g6
GET (48, 0)-(55, 7), g7
GET (56, 0)-(63, 7), g8


REM rysowanie planszy
rysuj:
z$ = MID$(lab$(yr), xr + 1, 1)
zl = VAL("&H" + z$)

CLS
COLOR 15

LOCATE 1, 1
t$ = typ$(zl)
FOR i = 0 TO 3
FOR j = 0 TO 2
te$ = MID$(t$, j + 1, 1)
IF te$ = "#" THEN FOR k = 0 TO 3: PUT (k * 8 + j * 32, i * 8), g1, PSET: NEXT k
IF te$ = "." THEN LOCATE i + 1, 1 + j * 4: PRINT p$;
NEXT j
PRINT
NEXT i

FOR i = 0 TO 3
FOR j = 0 TO 2
te$ = MID$(t$, j + 4, 1)
IF te$ = "#" THEN FOR k = 0 TO 3: PUT (k * 8 + j * 32, i * 8 + 32), g2, PSET: NEXT k
IF te$ = "." THEN LOCATE i + 1 + 4, 1 + j * 4: PRINT p$;
NEXT j
PRINT
NEXT i

FOR i = 0 TO 3
FOR j = 0 TO 2
te$ = MID$(t$, j + 7, 1)
IF te$ = "#" THEN FOR k = 0 TO 3: PUT (k * 8 + j * 32, i * 8 + 64), g3, PSET: NEXT k
IF te$ = "." THEN LOCATE i + 1 + 8, 1 + j * 4: PRINT p$;
NEXT j
PRINT
NEXT i


LOCATE 14, 1: PRINT "room"; xr; "/"; yr; " "

GOTO wstaw
petla:
k$ = INKEY$
IF k$ = "" THEN GOTO petla
IF k$ = CHR$(0) + "K" THEN x = x - 1
IF k$ = CHR$(0) + "M" THEN x = x + 1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
IF k$ = CHR$(27) THEN END

REM sprawdzenie przejscia do innej planszy

IF x > 12 THEN x = 1: xs = 1: xr = xr + 1: GOTO rysuj
IF x < 1 THEN x = 12: xs = 12: xr = xr - 1: GOTO rysuj
IF y > 12 THEN y = 1: ys = 1: yr = yr + 1: GOTO rysuj
IF y < 1 THEN y = 12: ys = 12: yr = yr - 1: GOTO rysuj
IF SCREEN(y, x) <> ASC(".") THEN x = xs: y = ys: GOTO petla
wstaw:
LOCATE ys, xs: PRINT ".";
LOCATE y, x: PRINT CHR$(2);
xs = x: ys = y
GOTO petla
Powrót do góry
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
Piotr-246
Gość






PostWysłany: Pią 17:02, 10 Wrz 2021    Temat postu:

SCREEN 13
DIM typ$(0 TO 15)
DIM g1(0 TO 16) AS LONG
DIM g2(0 TO 16) AS LONG
DIM g3(0 TO 16) AS LONG
DIM g4(0 TO 16) AS LONG
DIM g5(0 TO 16) AS LONG
DIM g6(0 TO 16) AS LONG
DIM g7(0 TO 16) AS LONG
DIM g8(0 TO 16) AS LONG

REM dane labiryntu
REM 0=brak przejsc: 1=gora: 2=prawo: 3=goraprawo
REM 4=dol: 5=goradol: 6=dolprawo: 7=gora+dol+prawo
REM 8=lewo:9=lewogora:A=lewo+prawo:B=lewo+prawo+gora
REM C=lewodol:D=gora+dol+lewo:E=lewo+dol+prawo:Flewo+prawo+gora+dol
lab$(0) = "6AAAAEAAAC"
lab$(1) = "56AAC7AAC5"
lab$(2) = "5568556C55"
lab$(3) = "553A955155"
lab$(4) = "53AAAD3A95"
lab$(5) = "7AAAAFAAAD"
lab$(6) = "56AAAD6AC5"
lab$(7) = "552AC53855"
lab$(8) = "53AA97AA95"
lab$(9) = "3AAAABAAA9"

REM parametr graficzny i tematyczny planszy

par$(0) = "AABAABBBAB"
par$(1) = "BAABABAABB"
par$(2) = "AABBBABABB"
par$(3) = "ABAABBABBA"
par$(4) = "AABBABBABB"
par$(5) = "ABABAAABAA"
par$(6) = "BABBABAABB"
par$(7) = "ABABAABAAB"
par$(8) = "AAABBBABAB"
par$(9) = "ABBAABBAAB"

REM 15 typow plansz

typ$(0) = "#########"
typ$(1) = "#.#######"
typ$(2) = "####..###"
typ$(3) = "#.##..###"
typ$(4) = "#######.#"
typ$(5) = "#.##.##.#"
typ$(6) = "####..#.#"
typ$(7) = "#.##..#.#"
typ$(8) = "###..####"
typ$(9) = "#.#..####"
typ$(10) = "###...###"
typ$(11) = "#.#...###"
typ$(12) = "###..##.#"
typ$(13) = "#.#..##.#"
typ$(14) = "###...#.#"
typ$(15) = "#.#...#.#"

REM dane startowe
xr = 5: yr = 5
x = 6: y = 6: xs = 6: ys = 6
REM dane elementow
e1$ = "ABCD": e2$ = "CDAB": e3$ = "DBCA": e4$ = "BDAC"
e5$ = "EFGH": e6$ = "HGFE"
p$ = "...."
bi$(0) = "01110111" + "11111111" + "00011000" + "11111111" + "01100000" + "11111111" + "01111110" + "11101110"
bi$(1) = "01110111" + "10000001" + "00100100" + "11111111" + "10010000" + "00000000" + "10000001" + "11100000"
bi$(2) = "01110111" + "10000001" + "01000010" + "01111111" + "01110011" + "11111111" + "10001101" + "00001110"
bi$(3) = "00000000" + "10000001" + "10000001" + "01010101" + "00001011" + "00000000" + "10000101" + "11101110"
bi$(4) = "11011101" + "10000001" + "10000001" + "00010101" + "00000100" + "11111111" + "10000001" + "11101110"
bi$(5) = "11011101" + "10000001" + "01000010" + "00010100" + "00011100" + "00000000" + "10000001" + "11100000"
bi$(6) = "11011101" + "10000001" + "00100100" + "00010000" + "00110010" + "11111111" + "10000001" + "00001110"
bi$(7) = "00000000" + "11111111" + "00011000" + "00000000" + "00000010" + "00000000" + "01111110" + "11101110"
FOR yb = 0 TO 7
FOR xb = 0 TO 63
znak$ = MID$(bi$(yb), xb + 1, 1)
znak = VAL(znak$)
COLOR 15 * znak: PSET (xb, yb)
NEXT xb
NEXT yb
GET (0, 0)-(7, 7), g1
GET (8, 0)-(15, 7), g2
GET (16, 0)-(23, 7), g3
GET (24, 0)-(31, 7), g4
GET (32, 0)-(39, 7), g5
GET (40, 0)-(47, 7), g6
GET (48, 0)-(55, 7), g7
GET (56, 0)-(63, 7), g8


REM rysowanie planszy
rysuj:
z$ = MID$(lab$(yr), xr + 1, 1)
zl = VAL("&H" + z$)
param$ = MID$(par$(yr), xr + 1, 1)

CLS
COLOR 15

LOCATE 1, 1
t$ = typ$(zl)

FOR i = 0 TO 3
FOR j = 0 TO 2
te$ = MID$(t$, j + 1, 1)
IF te$ = "#" THEN
FOR k = 0 TO 3:
IF param$ = "A" THEN PUT (k * 8 + j * 32, i * 8), g1, PSET
IF param$ = "B" THEN PUT (k * 8 + j * 32, i * 8), g2, PSET
NEXT k
END IF
IF te$ = "." THEN LOCATE i + 1, 1 + j * 4: PRINT p$;
NEXT j
PRINT
NEXT i

FOR i = 0 TO 3
FOR j = 0 TO 2
te$ = MID$(t$, j + 4, 1)
IF te$ = "#" THEN
FOR k = 0 TO 3
IF param$ = "A" THEN PUT (k * 8 + j * 32, i * 8 + 32), g3, PSET
IF param$ = "B" THEN PUT (k * 8 + j * 32, i * 8 + 32), g4, PSET
NEXT k
END IF
IF te$ = "." THEN LOCATE i + 1 + 4, 1 + j * 4: PRINT p$;
NEXT j
PRINT
NEXT i

FOR i = 0 TO 3
FOR j = 0 TO 2
te$ = MID$(t$, j + 7, 1)
IF te$ = "#" THEN
FOR k = 0 TO 3
IF param$ = "A" THEN PUT (k * 8 + j * 32, i * 8 + 64), g5, PSET
IF param$ = "B" THEN PUT (k * 8 + j * 32, i * 8 + 64), g6, PSET
NEXT k
END IF
IF te$ = "." THEN LOCATE i + 1 + 8, 1 + j * 4: PRINT p$;
NEXT j
PRINT
NEXT i


LOCATE 14, 1: PRINT "room"; xr; "/"; yr; " "

GOTO wstaw
petla:
k$ = INKEY$
IF k$ = "" THEN GOTO petla
IF k$ = CHR$(0) + "K" THEN x = x - 1
IF k$ = CHR$(0) + "M" THEN x = x + 1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
IF k$ = CHR$(27) THEN END

REM sprawdzenie przejscia do innej planszy

IF x > 12 THEN x = 1: xs = 1: xr = xr + 1: GOTO rysuj
IF x < 1 THEN x = 12: xs = 12: xr = xr - 1: GOTO rysuj
IF y > 12 THEN y = 1: ys = 1: yr = yr + 1: GOTO rysuj
IF y < 1 THEN y = 12: ys = 12: yr = yr - 1: GOTO rysuj
IF SCREEN(y, x) <> ASC(".") THEN x = xs: y = ys: GOTO petla
wstaw:
LOCATE ys, xs: PRINT ".";
LOCATE y, x: PRINT CHR$(2);
xs = x: ys = y
GOTO petla
Powrót do góry
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
Piotr-246
Gość






PostWysłany: Pią 18:06, 10 Wrz 2021    Temat postu:

SCREEN 13
DIM typ$(0 TO 15)
DIM typliczb(0 TO 15, 0 TO 9) AS INTEGER
DIM g1(0 TO 16) AS LONG
DIM g2(0 TO 16) AS LONG
DIM g3(0 TO 16) AS LONG
DIM g4(0 TO 16) AS LONG
DIM g5(0 TO 16) AS LONG
DIM g6(0 TO 16) AS LONG
DIM g7(0 TO 16) AS LONG
DIM g8(0 TO 16) AS LONG

REM dane labiryntu &H0-&HF
REM 0=brak przejsc: 1=gora: 2=prawo: 3=goraprawo
REM 4=dol: 5=goradol: 6=dolprawo: 7=gora+dol+prawo
REM 8=lewo:9=lewogora:A=lewo+prawo:B=lewo+prawo+gora
REM C=lewodol:D=gora+dol+lewo:E=lewo+dol+prawo:Flewo+prawo+gora+dol
lab$(0) = "6AAAAEAAAC"
lab$(1) = "56AAC7AAC5"
lab$(2) = "5568556C55"
lab$(3) = "553A955155"
lab$(4) = "53AAAD3A95"
lab$(5) = "7AAAAFAAAD"
lab$(6) = "56AAAD6AC5"
lab$(7) = "552AC53855"
lab$(8) = "53AA97AA95"
lab$(9) = "3AAAABAAA9"

REM parametr graficzny i tematyczny plansz &H0-&HF

par$(0) = "0101010101"
par$(1) = "1010101010"
par$(2) = "0101010101"
par$(3) = "1010101010"
par$(4) = "0101010101"
par$(5) = "1010101010"
par$(6) = "0101010101"
par$(7) = "1010101010"
par$(8) = "0101010101"
par$(9) = "1010101010"

REM 16 typow plansz pod wgledem labiryntu

typ$(0) = "#########"
typ$(1) = "#.#######"
typ$(2) = "####..###"
typ$(3) = "#.##..###"
typ$(4) = "#######.#"
typ$(5) = "#.##.##.#"
typ$(6) = "####..#.#"
typ$(7) = "#.##..#.#"
typ$(8) = "###..####"
typ$(9) = "#.#..####"
typ$(10) = "###...###"
typ$(11) = "#.#...###"
typ$(12) = "###..##.#"
typ$(13) = "#.#..##.#"
typ$(14) = "###...#.#"
typ$(15) = "#.#...#.#"
REM przepisanie do tablicy liczbowej dla szybkosci
FOR i = 0 TO 15
FOR j = 0 TO 8
typliczb(i, j) = ASC(MID$(typ$(i), j + 1, 1))
NEXT j
NEXT i

REM dane startowe
xr = 5: yr = 5
x = 6: y = 6: xs = 6: ys = 6
REM dane elementow
bi$(0) = "01110111" + "11111111" + "00011000" + "11111111" + "01100000" + "11111111" + "01111110" + "11101110"
bi$(1) = "01110111" + "10000001" + "00100100" + "11111111" + "10010000" + "00000000" + "10000001" + "11100000"
bi$(2) = "01110111" + "10000001" + "01000010" + "01111111" + "01110011" + "11111111" + "10001101" + "00001110"
bi$(3) = "00000000" + "10000001" + "10000001" + "01010101" + "00001011" + "00000000" + "10000101" + "11101110"
bi$(4) = "11011101" + "10000001" + "10000001" + "00010101" + "00000100" + "11111111" + "10000001" + "11101110"
bi$(5) = "11011101" + "10000001" + "01000010" + "00010100" + "00011100" + "00000000" + "10000001" + "11100000"
bi$(6) = "11011101" + "10000001" + "00100100" + "00010000" + "00110010" + "11111111" + "10000001" + "00001110"
bi$(7) = "00000000" + "11111111" + "00011000" + "00000000" + "00000010" + "00000000" + "01111110" + "11101110"
FOR yb = 0 TO 7
FOR xb = 0 TO 63
znak$ = MID$(bi$(yb), xb + 1, 1)
znak = VAL(znak$)
COLOR 15 * znak: PSET (xb, yb)
NEXT xb
NEXT yb
GET (0, 0)-(7, 7), g1
GET (8, 0)-(15, 7), g2
GET (16, 0)-(23, 7), g3
GET (24, 0)-(31, 7), g4
GET (32, 0)-(39, 7), g5
GET (40, 0)-(47, 7), g6
GET (48, 0)-(55, 7), g7
GET (56, 0)-(63, 7), g8

REM ***********************************************
REM rysowanie planszy

rysuj:
z$ = MID$(lab$(yr), xr + 1, 1)
zl = VAL("&H" + z$)
param$ = MID$(par$(yr), xr + 1, 1)

REM CLS
COLOR 15

LOCATE 1, 1
REM t$ = typ$(zl)

FOR i = 0 TO 3
FOR j = 0 TO 2
te$ = CHR$(typliczb(zl, j))
IF te$ = "#" THEN
FOR k = 0 TO 3:
IF param$ = "0" THEN PUT (k * 8 + j * 32, i * 8), g1, PSET
IF param$ = "1" THEN PUT (k * 8 + j * 32, i * 8), g2, PSET
NEXT k
END IF
IF te$ = "." THEN LOCATE i + 1, 1 + j * 4: PRINT "....";
NEXT j
PRINT
NEXT i

FOR i = 0 TO 3
FOR j = 0 TO 2
te$ = CHR$(typliczb(zl, j + 3))
IF te$ = "#" THEN
FOR k = 0 TO 3
IF param$ = "0" THEN PUT (k * 8 + j * 32, i * 8 + 32), g3, PSET
IF param$ = "1" THEN PUT (k * 8 + j * 32, i * 8 + 32), g4, PSET
NEXT k
END IF
IF te$ = "." THEN LOCATE i + 1 + 4, 1 + j * 4: PRINT "....";
NEXT j
PRINT
NEXT i

FOR i = 0 TO 3
FOR j = 0 TO 2
te$ = CHR$(typliczb(zl, j + 6))
IF te$ = "#" THEN
FOR k = 0 TO 3
IF param$ = "0" THEN PUT (k * 8 + j * 32, i * 8 + 64), g5, PSET
IF param$ = "1" THEN PUT (k * 8 + j * 32, i * 8 + 64), g6, PSET
NEXT k
END IF
IF te$ = "." THEN LOCATE i + 1 + 8, 1 + j * 4: PRINT "....";
NEXT j
PRINT
NEXT i


LOCATE 14, 1: PRINT "room"; xr; "/"; yr; " "

GOTO wstaw
petla:
k$ = INKEY$
IF k$ = "" THEN GOTO petla
IF k$ = CHR$(0) + "K" THEN x = x - 1
IF k$ = CHR$(0) + "M" THEN x = x + 1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
IF k$ = CHR$(27) THEN END

REM sprawdzenie przejscia do innej planszy

IF x > 12 THEN x = 1: xs = 1: xr = xr + 1: GOTO rysuj
IF x < 1 THEN x = 12: xs = 12: xr = xr - 1: GOTO rysuj
IF y > 12 THEN y = 1: ys = 1: yr = yr + 1: GOTO rysuj
IF y < 1 THEN y = 12: ys = 12: yr = yr - 1: GOTO rysuj

REM sprawdzenie przeszkody

IF SCREEN(y, x) <> ASC(".") THEN x = xs: y = ys: GOTO petla

wstaw:
LOCATE ys, xs: PRINT ".";
LOCATE y, x: PRINT CHR$(2);
xs = x: ys = y
GOTO petla
Powrót do góry
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
Piotr-246
Gość






PostWysłany: Pią 20:33, 10 Wrz 2021    Temat postu:

REM NOWA ODSLONA MIKROGRY

SCREEN 13

REM Tablice labiryntu
REM 0 - brak przejsc
REM 1 - pojedyncze na srodku
REM 2 - prawo lub gora
REM 3 - lewo lub dol
REM 4 - obydwa
REM
REM tablice przejsc
REM ........gornych.....dolnych.....prawych......lewych
lab$(0) = "0000000000__4444444444__1111111110__0111111111"
lab$(1) = "4444444444__4444444444__1111111110__0111111111"
lab$(2) = "4444444444__4444444444__1111111110__0111111111"
lab$(3) = "4444444444__4444444444__1111111110__0111111111"
lab$(4) = "4444444444__4444444444__1111111110__0111111111"
lab$(5) = "4444444444__4444444444__1111111110__0111111111"
lab$(6) = "4444444444__4444444444__1111111110__0111111111"
lab$(7) = "4444444444__4444444444__1111111110__0111111111"
lab$(8) = "4444444444__4444444444__1111111110__0111111111"
lab$(9) = "4444444444__0000000000__1111111110__0111111111"


REM dane startowe
xr = 5: yr = 5
x = 3: y = 3: xs = 3: ys = 3

REM ***********************************************
REM rysowanie planszy

rysuj:
gora$ = MID$(lab$(yr), xr + 1, 1)
dol$ = MID$(lab$(yr), xr + 1 + 12, 1)
prawo$ = MID$(lab$(yr), xr + 1 + 24, 1)
lewo$ = MID$(lab$(yr), xr + 1 + 36, 1)

REM CLS
COLOR 15

LOCATE 1, 1

REM wiersz 1

PRINT "#";
IF gora$ = "0" THEN PRINT "###";
IF gora$ = "1" THEN PRINT "#.#";
IF gora$ = "2" THEN PRINT "##.";
IF gora$ = "3" THEN PRINT ".##";
IF gora$ = "4" THEN PRINT ".#.";
PRINT "#"

REM wiersz 2

IF lewo$ = "0" THEN PRINT "#";
IF lewo$ = "1" THEN PRINT "#";
IF lewo$ = "2" THEN PRINT ".";
IF lewo$ = "3" THEN PRINT "#";
IF lewo$ = "4" THEN PRINT ".";
PRINT "...";
IF prawo$ = "0" THEN PRINT "#";
IF prawo$ = "1" THEN PRINT "#";
IF prawo$ = "2" THEN PRINT ".";
IF prawo$ = "3" THEN PRINT "#";
IF prawo$ = "4" THEN PRINT ".";
PRINT

REM wiersz 3

IF lewo$ = "0" THEN PRINT "#";
IF lewo$ = "1" THEN PRINT ".";
IF lewo$ = "2" THEN PRINT "#";
IF lewo$ = "3" THEN PRINT "#";
IF lewo$ = "4" THEN PRINT "#";
PRINT "...";
IF prawo$ = "0" THEN PRINT "#";
IF prawo$ = "1" THEN PRINT ".";
IF prawo$ = "2" THEN PRINT "#";
IF prawo$ = "3" THEN PRINT "#";
IF prawo$ = "4" THEN PRINT "#";
PRINT

REM wiersz 4

IF lewo$ = "0" THEN PRINT "#";
IF lewo$ = "1" THEN PRINT "#";
IF lewo$ = "2" THEN PRINT "#";
IF lewo$ = "3" THEN PRINT ".";
IF lewo$ = "4" THEN PRINT ".";
PRINT "...";
IF prawo$ = "0" THEN PRINT "#";
IF prawo$ = "1" THEN PRINT "#";
IF prawo$ = "2" THEN PRINT "#";
IF prawo$ = "3" THEN PRINT ".";
IF prawo$ = "4" THEN PRINT ".";
PRINT

REM wiersz 5

PRINT "#";
IF dol$ = "0" THEN PRINT "###";
IF dol$ = "1" THEN PRINT "#.#";
IF dol$ = "2" THEN PRINT "##.";
IF dol$ = "3" THEN PRINT ".##";
IF dol$ = "4" THEN PRINT ".#.";
PRINT "#"


LOCATE 14, 1: PRINT "room"; xr; "/"; yr; " "

GOTO wstaw
petla:
k$ = INKEY$
IF k$ = "" THEN GOTO petla
IF k$ = CHR$(0) + "K" THEN x = x - 1
IF k$ = CHR$(0) + "M" THEN x = x + 1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
IF k$ = CHR$(27) THEN END

REM sprawdzenie przejscia do innej planszy

IF x > 5 THEN x = 1: xs = 1: xr = xr + 1: GOTO rysuj
IF x < 1 THEN x = 5: xs = 5: xr = xr - 1: GOTO rysuj
IF y > 5 THEN y = 1: ys = 1: yr = yr + 1: GOTO rysuj
IF y < 1 THEN y = 5: ys = 5: yr = yr - 1: GOTO rysuj

REM sprawdzenie przeszkody

IF SCREEN(y, x) <> ASC(".") THEN x = xs: y = ys: GOTO petla

wstaw:
LOCATE ys, xs: PRINT ".";
LOCATE y, x: PRINT CHR$(2);
xs = x: ys = y
GOTO petla
Powrót do góry
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
Piotr-246
Gość






PostWysłany: Pią 20:53, 10 Wrz 2021    Temat postu:

REM NOWA ODSLONA MIKROGRY

SCREEN 13

REM Tablice labiryntu
REM 0 - brak przejsc
REM 1 - pojedyncze na srodku
REM 2 - prawo lub gora
REM 3 - lewo lub dol
REM 4 - obydwa
REM
REM tablice przejsc
REM ........gornych.....dolnych.....prawych......lewych
lab$(0) = "0000000000__4444444444__1111111110__0111111111"
lab$(1) = "4444444444__4444444444__1111111110__0111111111"
lab$(2) = "4444444444__4444444044__1121111110__0112111111"
lab$(3) = "4444444044__4444444444__1111111110__0111111111"
lab$(4) = "4444444444__4444144444__1111111110__0111111111"
lab$(5) = "4444144444__4444444444__1111111110__0111111111"
lab$(6) = "4444444444__4444444444__1111111110__0111111111"
lab$(7) = "4444444444__4444444444__1110111110__0111011111"
lab$(8) = "4444444444__4444444444__1111111110__0111111111"
lab$(9) = "4444444444__0000000000__1111111110__0111111111"


REM dane startowe
xr = 5: yr = 5
x = 3: y = 3: xs = 3: ys = 3
q$ = CHR$(219)
REM ***********************************************
REM rysowanie planszy

rysuj:
gora$ = MID$(lab$(yr), xr + 1, 1)
dol$ = MID$(lab$(yr), xr + 1 + 12, 1)
prawo$ = MID$(lab$(yr), xr + 1 + 24, 1)
lewo$ = MID$(lab$(yr), xr + 1 + 36, 1)

REM CLS
COLOR 15

LOCATE 1, 1

REM wiersz 1

PRINT q$;
IF gora$ = "0" THEN PRINT q$; q$; q$;
IF gora$ = "1" THEN PRINT q$; "."; q$;
IF gora$ = "2" THEN PRINT q$; q$; ".";
IF gora$ = "3" THEN PRINT "."; q$; q$;
IF gora$ = "4" THEN PRINT "."; q$; ".";
PRINT q$

REM wiersz 2

IF lewo$ = "0" THEN PRINT q$;
IF lewo$ = "1" THEN PRINT q$;
IF lewo$ = "2" THEN PRINT ".";
IF lewo$ = "3" THEN PRINT q$;
IF lewo$ = "4" THEN PRINT ".";
PRINT "...";
IF prawo$ = "0" THEN PRINT q$;
IF prawo$ = "1" THEN PRINT q$;
IF prawo$ = "2" THEN PRINT ".";
IF prawo$ = "3" THEN PRINT q$;
IF prawo$ = "4" THEN PRINT ".";
PRINT

REM wiersz 3

IF lewo$ = "0" THEN PRINT q$;
IF lewo$ = "1" THEN PRINT ".";
IF lewo$ = "2" THEN PRINT q$;
IF lewo$ = "3" THEN PRINT q$;
IF lewo$ = "4" THEN PRINT q$;
PRINT "...";
IF prawo$ = "0" THEN PRINT q$;
IF prawo$ = "1" THEN PRINT ".";
IF prawo$ = "2" THEN PRINT q$;
IF prawo$ = "3" THEN PRINT q$;
IF prawo$ = "4" THEN PRINT q$;
PRINT

REM wiersz 4

IF lewo$ = "0" THEN PRINT q$;
IF lewo$ = "1" THEN PRINT q$;
IF lewo$ = "2" THEN PRINT q$;
IF lewo$ = "3" THEN PRINT ".";
IF lewo$ = "4" THEN PRINT ".";
PRINT "...";
IF prawo$ = "0" THEN PRINT q$;
IF prawo$ = "1" THEN PRINT q$;
IF prawo$ = "2" THEN PRINT q$;
IF prawo$ = "3" THEN PRINT ".";
IF prawo$ = "4" THEN PRINT ".";
PRINT

REM wiersz 5

PRINT q$;
IF dol$ = "0" THEN PRINT q$; q$; q$;
IF dol$ = "1" THEN PRINT q$; "."; q$;
IF dol$ = "2" THEN PRINT q$; q$; ".";
IF dol$ = "3" THEN PRINT "."; q$; q$;
IF dol$ = "4" THEN PRINT "."; q$; ".";
PRINT q$;


LOCATE 14, 1: PRINT "room"; xr; "/"; yr; " "

GOTO wstaw
petla:
k$ = INKEY$
IF k$ = "" THEN GOTO petla
IF k$ = CHR$(0) + "K" THEN x = x - 1
IF k$ = CHR$(0) + "M" THEN x = x + 1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
IF k$ = CHR$(27) THEN END

REM sprawdzenie przejscia do innej planszy

IF x > 5 THEN x = 1: xs = 1: xr = xr + 1: GOTO rysuj
IF x < 1 THEN x = 5: xs = 5: xr = xr - 1: GOTO rysuj
IF y > 5 THEN y = 1: ys = 1: yr = yr + 1: GOTO rysuj
IF y < 1 THEN y = 5: ys = 5: yr = yr - 1: GOTO rysuj

REM sprawdzenie przeszkody

IF SCREEN(y, x) <> ASC(".") THEN x = xs: y = ys: GOTO petla

wstaw:
LOCATE ys, xs: PRINT ".";
LOCATE y, x: PRINT CHR$(2);
xs = x: ys = y
GOTO petla
Powrót do góry
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
Piotr-246
Gość






PostWysłany: Pią 21:51, 10 Wrz 2021    Temat postu:

SCREEN 13

REM Tablice labiryntu
REM 0 - brak przejsc
REM 1 - pojedyncze na srodku
REM 2 - prawo lub gora
REM 3 - lewo lub dol
REM 4 - obydwa
REM
REM tablice przejsc
REM ........gornych.....dolnych.....prawych......lewych
lab$(0) = "0000000000__4444444444__1111111110__0111111111"
lab$(1) = "4444444444__4444444444__1111111110__0111111111"
lab$(2) = "4444444444__4444444044__1121111110__0112111111"
lab$(3) = "4444444044__4444444444__1111111110__0111111111"
lab$(4) = "4444444444__4444144444__1111111110__0111111111"
lab$(5) = "4444144444__4444444444__1111111110__0111111111"
lab$(6) = "4444444444__4444444444__1111111110__0111111111"
lab$(7) = "4444444444__4444444444__1110111110__0111011111"
lab$(8) = "4444444444__4444444444__1111111110__0111111111"
lab$(9) = "4444444444__0000000000__1111111110__0111111111"

REM 0- brak przegrod
REM 1- gorna lub prawa (bez srodka)
REM 2- dolna lub lewa (bez srodka)
REM 3 - obydwie
REM tylko poziome: 4-wszystkie, 5 -srodek i lewa, 6 srodek i prawa
REM tablice przegrod
REM ........poziomych...pionowych...serce.......niezdef
prz$(0) = "0160501000__0024200020__1010012010__0111111111"
prz$(1) = "6011015146__0100424142__1401210130__0111111111"
prz$(2) = "4340250241__0220300004__1020030100__0112111111"
prz$(3) = "0120014004__0404412430__0010010010__0111111111"
prz$(4) = "6403061421__4022100341__1012041310__0111111111"
prz$(5) = "4200142040__4040042010__1103120010__0111111111"
prz$(6) = "4203010161__0302010200__1041004110__0111111111"
prz$(7) = "6412041110__0300200121__0010100010__0111011111"
prz$(8) = "4100602121__0022120200__1100213000__0111111111"
prz$(9) = "2452402424__0103030020__1014000120__0111111111"


REM dane startowe
xr = 5: yr = 5
x = 3: y = 3: xs = 3: ys = 3
q$ = CHR$(219)
REM ***********************************************
REM rysowanie planszy

rysuj:
gora$ = MID$(lab$(yr), xr + 1, 1)
dol$ = MID$(lab$(yr), xr + 1 + 12, 1)
prawo$ = MID$(lab$(yr), xr + 1 + 24, 1)
lewo$ = MID$(lab$(yr), xr + 1 + 36, 1)

REM CLS
COLOR 15

LOCATE 1, 1

REM wiersz 1

PRINT q$;
IF gora$ = "0" THEN PRINT q$; q$; q$;
IF gora$ = "1" THEN PRINT q$; "."; q$;
IF gora$ = "2" THEN PRINT q$; q$; ".";
IF gora$ = "3" THEN PRINT "."; q$; q$;
IF gora$ = "4" THEN PRINT "."; q$; ".";
PRINT q$

REM wiersz 2

IF lewo$ = "0" THEN PRINT q$;
IF lewo$ = "1" THEN PRINT q$;
IF lewo$ = "2" THEN PRINT ".";
IF lewo$ = "3" THEN PRINT q$;
IF lewo$ = "4" THEN PRINT ".";
PRINT "...";
IF prawo$ = "0" THEN PRINT q$;
IF prawo$ = "1" THEN PRINT q$;
IF prawo$ = "2" THEN PRINT ".";
IF prawo$ = "3" THEN PRINT q$;
IF prawo$ = "4" THEN PRINT ".";
PRINT

REM wiersz 3

IF lewo$ = "0" THEN PRINT q$;
IF lewo$ = "1" THEN PRINT ".";
IF lewo$ = "2" THEN PRINT q$;
IF lewo$ = "3" THEN PRINT q$;
IF lewo$ = "4" THEN PRINT q$;
PRINT "...";
IF prawo$ = "0" THEN PRINT q$;
IF prawo$ = "1" THEN PRINT ".";
IF prawo$ = "2" THEN PRINT q$;
IF prawo$ = "3" THEN PRINT q$;
IF prawo$ = "4" THEN PRINT q$;
PRINT

REM wiersz 4

IF lewo$ = "0" THEN PRINT q$;
IF lewo$ = "1" THEN PRINT q$;
IF lewo$ = "2" THEN PRINT q$;
IF lewo$ = "3" THEN PRINT ".";
IF lewo$ = "4" THEN PRINT ".";
PRINT "...";
IF prawo$ = "0" THEN PRINT q$;
IF prawo$ = "1" THEN PRINT q$;
IF prawo$ = "2" THEN PRINT q$;
IF prawo$ = "3" THEN PRINT ".";
IF prawo$ = "4" THEN PRINT ".";
PRINT

REM wiersz 5

PRINT q$;
IF dol$ = "0" THEN PRINT q$; q$; q$;
IF dol$ = "1" THEN PRINT q$; "."; q$;
IF dol$ = "2" THEN PRINT q$; q$; ".";
IF dol$ = "3" THEN PRINT "."; q$; q$;
IF dol$ = "4" THEN PRINT "."; q$; ".";
PRINT q$;

REM rysowanie przegrod

poz$ = MID$(prz$(yr), xr + 1, 1)
pio$ = MID$(prz$(yr), xr + 1 + 12, 1)

IF poz$ = "1" THEN LOCATE 3, 4: PRINT q$;
IF poz$ = "2" THEN LOCATE 3, 2: PRINT q$;
IF poz$ = "3" THEN LOCATE 3, 2: PRINT q$; "."; q$;
IF poz$ = "4" THEN LOCATE 3, 2: PRINT q$; q$; q$;
IF poz$ = "5" THEN LOCATE 3, 2: PRINT q$; q$;
IF poz$ = "6" THEN LOCATE 3, 3: PRINT q$; q$;

IF pio$ = "1" THEN LOCATE 2, 3: PRINT q$;
IF pio$ = "2" THEN LOCATE 4, 3: PRINT q$;
IF pio$ = "3" THEN LOCATE 2, 3: PRINT q$: LOCATE 4, 3: PRINT q$;
REM serce
ser$ = MID$(prz$(yr), xr + 1 + 24, 1)
COLOR 12
IF pio$ = "1" THEN LOCATE 2, 2: PRINT CHR$(3);
IF pio$ = "2" THEN LOCATE 2, 4: PRINT CHR$(3);
IF pio$ = "3" THEN LOCATE 4, 2: PRINT CHR$(3);
IF pio$ = "4" THEN LOCATE 4, 4: PRINT CHR$(3);
COLOR 15


LOCATE 14, 1: PRINT "room"; xr; "/"; yr; " "

GOTO wstaw
petla:
k$ = INKEY$
IF k$ = "" THEN GOTO petla
IF k$ = CHR$(0) + "K" THEN x = x - 1
IF k$ = CHR$(0) + "M" THEN x = x + 1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
IF k$ = CHR$(27) THEN END

REM sprawdzenie przejscia do innej planszy

IF x > 5 THEN x = 1: xs = 1: xr = xr + 1: GOTO rysuj
IF x < 1 THEN x = 5: xs = 5: xr = xr - 1: GOTO rysuj
IF y > 5 THEN y = 1: ys = 1: yr = yr + 1: GOTO rysuj
IF y < 1 THEN y = 5: ys = 5: yr = yr - 1: GOTO rysuj

REM sprawdzenie przeszkody
pobierz = SCREEN(y, x)
IF pobierz <> ASC(".") AND pobierz <> 3 THEN x = xs: y = ys: GOTO petla

wstaw:
LOCATE ys, xs: PRINT ".";
LOCATE y, x: PRINT CHR$(2);
xs = x: ys = y
GOTO petla
Powrót do góry
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
Piotr-246
Gość






PostWysłany: Sob 7:50, 11 Wrz 2021    Temat postu:

SCREEN 13

REM Tablice labiryntu
REM 0 - brak przejsc
REM 1 - pojedyncze na srodku
REM 2 - prawo lub gora
REM 3 - lewo lub dol
REM 4 - obydwa
REM
REM tablice przejsc
REM ........gornych.....dolnych.....prawych......lewych
lab$(0) = "0000000000__4444444444__1111111110__0111111111"
lab$(1) = "4444444444__4444444444__1111111110__0111111111"
lab$(2) = "4444444444__4444444044__1121111110__0112111111"
lab$(3) = "4444444044__4444444444__1111111110__0111111111"
lab$(4) = "4444444444__4444144444__1111111110__0111111111"
lab$(5) = "4444144444__4444444444__1111111110__0111111111"
lab$(6) = "4444444444__4444444444__1111111110__0111111111"
lab$(7) = "4444444444__4444444444__1110111110__0111011111"
lab$(8) = "4444444444__4444444444__1111111110__0111111111"
lab$(9) = "4444444444__0000000000__1111111110__0111111111"

REM 0- brak przegrod
REM 1- gorna lub prawa (bez srodka)
REM 2- dolna lub lewa (bez srodka)
REM 3 - obydwie
REM tylko poziome: 4-wszystkie, 5-srodek i lewa, 6 srodek i prawa,7 tylko srodek
REM tablice przegrod ........oraz tablica pol...
REM ........poziomych...pionowych..pozostalych....niezdef
prz$(0) = "0100501000__0020200020__1010012010__0111111111"
prz$(1) = "6011015146__0100020102__1401018130__0111111111"
prz$(2) = "4040250241__0220100004__1000030100__0112111111"
prz$(3) = "0120014004__0404012430__0010010D10__0111111111"
prz$(4) = "6401071421__4012100341__1010200310__0111111111"
prz$(5) = "4200102040__4040042010__1103020700__0111111111"
prz$(6) = "4203010101__0302010200__1041004B10__0111111111"
prz$(7) = "7012007110__0100200121__001A100010__0111011111"
prz$(8) = "4100600121__0020120200__1000313000__0111111111"
prz$(9) = "2070402024__0103010020__1014000120__0111111111"


REM dane startowe
xr = 5: yr = 5
x = 3: y = 3: xs = 3: ys = 3
q$ = CHR$(219)
REM ***********************************************
REM rysowanie planszy

rysuj:
gora$ = MID$(lab$(yr), xr + 1, 1)
dol$ = MID$(lab$(yr), xr + 1 + 12, 1)
prawo$ = MID$(lab$(yr), xr + 1 + 24, 1)
lewo$ = MID$(lab$(yr), xr + 1 + 36, 1)

REM CLS
COLOR 15

LOCATE 1, 1

REM wiersz 1

PRINT q$;
IF gora$ = "0" THEN PRINT q$; q$; q$;
IF gora$ = "1" THEN PRINT q$; "."; q$;
IF gora$ = "2" THEN PRINT q$; q$; ".";
IF gora$ = "3" THEN PRINT "."; q$; q$;
IF gora$ = "4" THEN PRINT "."; q$; ".";
PRINT q$

REM wiersz 2

IF lewo$ = "0" THEN PRINT q$;
IF lewo$ = "1" THEN PRINT q$;
IF lewo$ = "2" THEN PRINT ".";
IF lewo$ = "3" THEN PRINT q$;
IF lewo$ = "4" THEN PRINT ".";
PRINT "...";
IF prawo$ = "0" THEN PRINT q$;
IF prawo$ = "1" THEN PRINT q$;
IF prawo$ = "2" THEN PRINT ".";
IF prawo$ = "3" THEN PRINT q$;
IF prawo$ = "4" THEN PRINT ".";
PRINT

REM wiersz 3

IF lewo$ = "0" THEN PRINT q$;
IF lewo$ = "1" THEN PRINT ".";
IF lewo$ = "2" THEN PRINT q$;
IF lewo$ = "3" THEN PRINT q$;
IF lewo$ = "4" THEN PRINT q$;
PRINT "...";
IF prawo$ = "0" THEN PRINT q$;
IF prawo$ = "1" THEN PRINT ".";
IF prawo$ = "2" THEN PRINT q$;
IF prawo$ = "3" THEN PRINT q$;
IF prawo$ = "4" THEN PRINT q$;
PRINT

REM wiersz 4

IF lewo$ = "0" THEN PRINT q$;
IF lewo$ = "1" THEN PRINT q$;
IF lewo$ = "2" THEN PRINT q$;
IF lewo$ = "3" THEN PRINT ".";
IF lewo$ = "4" THEN PRINT ".";
PRINT "...";
IF prawo$ = "0" THEN PRINT q$;
IF prawo$ = "1" THEN PRINT q$;
IF prawo$ = "2" THEN PRINT q$;
IF prawo$ = "3" THEN PRINT ".";
IF prawo$ = "4" THEN PRINT ".";
PRINT

REM wiersz 5

PRINT q$;
IF dol$ = "0" THEN PRINT q$; q$; q$;
IF dol$ = "1" THEN PRINT q$; "."; q$;
IF dol$ = "2" THEN PRINT q$; q$; ".";
IF dol$ = "3" THEN PRINT "."; q$; q$;
IF dol$ = "4" THEN PRINT "."; q$; ".";
PRINT q$;

REM rysowanie przegrod

poz$ = MID$(prz$(yr), xr + 1, 1)
pio$ = MID$(prz$(yr), xr + 1 + 12, 1)

IF poz$ = "1" THEN LOCATE 3, 4: PRINT q$;
IF poz$ = "2" THEN LOCATE 3, 2: PRINT q$;
IF poz$ = "3" THEN LOCATE 3, 2: PRINT q$; "."; q$;
IF poz$ = "4" THEN LOCATE 3, 2: PRINT q$; q$; q$;
IF poz$ = "5" THEN LOCATE 3, 2: PRINT q$; q$;
IF poz$ = "6" THEN LOCATE 3, 3: PRINT q$; q$;
IF poz$ = "7" THEN LOCATE 3, 3: PRINT q$;


IF pio$ = "1" THEN LOCATE 2, 3: PRINT q$;
IF pio$ = "2" THEN LOCATE 4, 3: PRINT q$;
IF pio$ = "3" THEN LOCATE 2, 3: PRINT q$: LOCATE 4, 3: PRINT q$;
REM pola pozostale

res$ = "&H" + MID$(prz$(yr), xr + 1 + 24, 1)
reszta = VAL(res$)

IF (reszta AND 1) = 1 THEN LOCATE 2, 2: PRINT q$;
IF (reszta AND 2) = 2 THEN LOCATE 2, 4: PRINT q$;
IF (reszta AND 4) = 4 THEN LOCATE 4, 2: PRINT q$;
IF (reszta AND 8) = 8 THEN LOCATE 4, 4: PRINT q$;

LOCATE 14, 1: PRINT "room"; xr; "/"; yr; " "

GOTO wstaw
petla:
k$ = INKEY$
IF k$ = "" THEN GOTO petla
IF k$ = CHR$(0) + "K" THEN x = x - 1
IF k$ = CHR$(0) + "M" THEN x = x + 1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
IF k$ = CHR$(27) THEN END

REM sprawdzenie przejscia do innej planszy

IF x > 5 THEN x = 1: xs = 1: xr = xr + 1: GOTO rysuj
IF x < 1 THEN x = 5: xs = 5: xr = xr - 1: GOTO rysuj
IF y > 5 THEN y = 1: ys = 1: yr = yr + 1: GOTO rysuj
IF y < 1 THEN y = 5: ys = 5: yr = yr - 1: GOTO rysuj

REM sprawdzenie przeszkody
pobierz = SCREEN(y, x)
IF pobierz <> ASC(".") AND pobierz <> 3 THEN x = xs: y = ys: GOTO petla

wstaw:
LOCATE ys, xs: PRINT ".";
LOCATE y, x: PRINT CHR$(2);
xs = x: ys = y
GOTO petla
Powrót do góry
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
Piotr-246
Gość






PostWysłany: Sob 14:53, 11 Wrz 2021    Temat postu:

DECLARE SUB wstaw (x!, y!, parametr!)
SCREEN 13

REM Tablice labiryntu
REM 0 - brak przejsc
REM 1 - pojedyncze na srodku
REM 2 - prawo lub gora
REM 3 - lewo lub dol
REM 4 - obydwa
REM
REM tablice przejsc
REM ........gornych.....dolnych.....prawych......lewych
lab$(0) = "0000000000__4444444444__1111111110__0111111111"
lab$(1) = "4444444444__4444444444__1111111110__0111111111"
lab$(2) = "4444444444__4444444044__1121111110__0112111111"
lab$(3) = "4444444044__4444444444__1111111110__0111111111"
lab$(4) = "4444444444__4444144444__1111111110__0111111111"
lab$(5) = "4444144444__4444444444__1111111110__0111111111"
lab$(6) = "4444444444__4444444444__1111111110__0111111111"
lab$(7) = "4444444444__4444444444__1110111110__0111011111"
lab$(8) = "4444444444__4444444444__1111111110__0111111111"
lab$(9) = "4444444444__0000000000__1111111110__0111111111"

REM 0- brak przegrod
REM 1- gorna lub prawa (bez srodka)
REM 2- dolna lub lewa (bez srodka)
REM 3 - obydwie
REM tylko poziome: 4-wszystkie, 5-srodek i lewa, 6 srodek i prawa,7 tylko srodek
REM tablice przegrod ........oraz tablica pol...
REM ........poziomych...pionowych..pozostalych....niezdef
prz$(0) = "0100701000__0020200020__1010012010__0111111111"
prz$(1) = "6001010106__0100020102__1401018130__0111111111"
prz$(2) = "4070270241__0210100004__1000030100__0112111111"
prz$(3) = "0120014004__0000012030__0010010D10__0111111111"
prz$(4) = "6401071421__0012100301__1010200310__0111111111"
prz$(5) = "7200102040__0000002010__1103020700__0111111111"
prz$(6) = "4203070101__0102010200__1041004B10__0111111111"
prz$(7) = "7017007110__0100200121__001A100010__0111011111"
prz$(8) = "4100600121__0020120200__1000313000__0111111111"
prz$(9) = "2070402024__0103010020__1014000120__0111111111"


REM dane startowe
xr = 5: yr = 5
x = 3: y = 3: xs = 3: ys = 3
q$ = CHR$(219)
REM ***********************************************
REM rysowanie planszy

rysuj:
gora$ = MID$(lab$(yr), xr + 1, 1)
dol$ = MID$(lab$(yr), xr + 1 + 12, 1)
prawo$ = MID$(lab$(yr), xr + 1 + 24, 1)
lewo$ = MID$(lab$(yr), xr + 1 + 36, 1)

REM parametr kolorowania
parax = 0: paray = 0
IF xr / 2 = INT(xr / 2) THEN parax = 1
IF yr / 2 = INT(yr / 2) THEN paray = 1
p = parax * 4 + paray * 8

REM CLS

LOCATE 1, 1

REM wiersz 1
p = p + 1
wstaw 1, 1, p + 0
IF gora$ = "0" THEN wstaw 2, 1, p + 1: wstaw 3, 1, p + 2: wstaw 4, 1, p + 3
IF gora$ = "1" THEN wstaw 2, 1, p + 4: wstaw 3, 1, 0: wstaw 4, 1, p + 5
IF gora$ = "2" THEN wstaw 2, 1, p + 6: wstaw 3, 1, p + 7: wstaw 4, 1, 0
IF gora$ = "3" THEN wstaw 2, 1, 0: wstaw 3, 1, p + 8: wstaw 4, 1, p + 9
IF gora$ = "4" THEN wstaw 2, 1, 0: wstaw 3, 1, p + 10: wstaw 4, 1, 0
wstaw 5, 1, p + 11
PRINT

REM wiersz 2
p = p + 2
IF lewo$ = "0" THEN wstaw 1, 2, p + 0
IF lewo$ = "1" THEN wstaw 1, 2, p + 1
IF lewo$ = "2" THEN wstaw 1, 2, 0
IF lewo$ = "3" THEN wstaw 1, 2, p + 2
IF lewo$ = "4" THEN wstaw 1, 2, 0
REM PRINT "...";
IF prawo$ = "0" THEN wstaw 5, 2, p + 3
IF prawo$ = "1" THEN wstaw 5, 2, p + 4
IF prawo$ = "2" THEN wstaw 5, 2, 0
IF prawo$ = "3" THEN wstaw 5, 2, p + 5
IF prawo$ = "4" THEN wstaw 5, 2, 0
PRINT

REM wiersz 3
p = p + 3
IF lewo$ = "0" THEN wstaw 1, 3, p + 0
IF lewo$ = "1" THEN wstaw 1, 3, 0
IF lewo$ = "2" THEN wstaw 1, 3, p + 1
IF lewo$ = "3" THEN wstaw 1, 3, p + 2
IF lewo$ = "4" THEN wstaw 1, 3, p + 3
REM PRINT "...";
IF prawo$ = "0" THEN wstaw 5, 3, p + 4
IF prawo$ = "1" THEN wstaw 5, 3, 0
IF prawo$ = "2" THEN wstaw 5, 3, p + 5
IF prawo$ = "3" THEN wstaw 5, 3, p + 6
IF prawo$ = "4" THEN wstaw 5, 3, p + 7
PRINT

REM wiersz 4
p = p + 4
IF lewo$ = "0" THEN wstaw 1, 4, p + 0
IF lewo$ = "1" THEN wstaw 1, 4, p + 1
IF lewo$ = "2" THEN wstaw 1, 4, p + 2
IF lewo$ = "3" THEN wstaw 1, 4, 0
IF lewo$ = "4" THEN wstaw 1, 4, 0
REM PRINT "...";
IF prawo$ = "0" THEN wstaw 5, 4, p + 3
IF prawo$ = "1" THEN wstaw 5, 4, p + 4
IF prawo$ = "2" THEN wstaw 5, 4, p + 5
IF prawo$ = "3" THEN wstaw 5, 4, 0
IF prawo$ = "4" THEN wstaw 5, 4, 0
PRINT

REM wiersz 5
p = p + 5
wstaw 1, 5, p + 0
IF dol$ = "0" THEN wstaw 2, 5, p + 1: wstaw 3, 5, p + 2: wstaw 4, 5, p + 3
IF dol$ = "1" THEN wstaw 2, 5, p + 4: wstaw 3, 5, 0: wstaw 4, 5, p + 5
IF dol$ = "2" THEN wstaw 2, 5, p + 6: wstaw 3, 5, p + 7: wstaw 4, 5, 0
IF dol$ = "3" THEN wstaw 2, 5, 0: wstaw 3, 5, p + 8: wstaw 4, 5, p + 9
IF dol$ = "4" THEN wstaw 2, 5, 0: wstaw 3, 5, p + 10: wstaw 4, 5, 0
wstaw 5, 5, p + 11
PRINT

REM rysowanie przegrod
p = p + 6

poz$ = MID$(prz$(yr), xr + 1, 1)
pio$ = MID$(prz$(yr), xr + 1 + 12, 1)
IF poz$ = "0" THEN wstaw 2, 3, 0: wstaw 3, 3, 0: wstaw 4, 3, 0
IF poz$ = "1" THEN wstaw 2, 3, 0: wstaw 3, 3, 0: wstaw 4, 3, p + 0
IF poz$ = "2" THEN wstaw 2, 3, p + 1: wstaw 3, 3, 0: wstaw 4, 3, 0
IF poz$ = "3" THEN wstaw 2, 3, p + 2: wstaw 3, 3, 0: wstaw 4, 3, p + 3
IF poz$ = "4" THEN wstaw 2, 3, p + 4: wstaw 3, 3, p + 5: wstaw 4, 4, p + 6
IF poz$ = "5" THEN wstaw 2, 3, p + 7: wstaw 3, 3, p + 8: wstaw 4, 3, 0
IF poz$ = "6" THEN wstaw 2, 3, 0: wstaw 3, 3, p + 9: wstaw 4, 3, p + 10
IF poz$ = "7" THEN wstaw 2, 3, 0: wstaw 3, 3, p + 11: wstaw 4, 3, 0

IF pio$ = "0" THEN wstaw 3, 2, 0: wstaw 3, 4, 0
IF pio$ = "1" THEN wstaw 3, 2, p + 12: wstaw 3, 4, 0
IF pio$ = "2" THEN wstaw 3, 2, 0: wstaw 3, 4, p + 13
IF pio$ = "3" THEN wstaw 3, 2, p + 14: wstaw 3, 4, p + 15
REM pola pozostale
p = p + 7

res$ = "&H" + MID$(prz$(yr), xr + 1 + 24, 1)
reszta = VAL(res$)

IF (reszta AND 1) = 1 THEN wstaw 2, 2, p + 0
IF (reszta AND 2) = 2 THEN wstaw 4, 2, p + 1
IF (reszta AND 4) = 4 THEN wstaw 2, 4, p + 2
IF (reszta AND 8) = 8 THEN wstaw 4, 4, p + 3
IF (reszta AND 1) = 0 THEN wstaw 2, 2, 0
IF (reszta AND 2) = 0 THEN wstaw 4, 2, 0
IF (reszta AND 4) = 0 THEN wstaw 2, 4, 0
IF (reszta AND 8) = 0 THEN wstaw 4, 4, 0

LOCATE 14, 1: PRINT "room"; xr; "/"; yr; " "

GOTO wstawgracza
petla:
k$ = INKEY$
IF k$ = "" THEN GOTO petla
IF k$ = CHR$(0) + "K" THEN x = x - 1
IF k$ = CHR$(0) + "M" THEN x = x + 1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
IF k$ = CHR$(27) THEN END

REM sprawdzenie przejscia do innej planszy

IF x > 5 THEN x = 1: xs = 1: xr = xr + 1: GOTO rysuj
IF x < 1 THEN x = 5: xs = 5: xr = xr - 1: GOTO rysuj
IF y > 5 THEN y = 1: ys = 1: yr = yr + 1: GOTO rysuj
IF y < 1 THEN y = 5: ys = 5: yr = yr - 1: GOTO rysuj

REM sprawdzenie przeszkody
pobierz = SCREEN(y, x)
IF pobierz <> ASC(".") AND pobierz <> 3 THEN x = xs: y = ys: GOTO petla

wstawgracza:
COLOR 15
LOCATE ys, xs: PRINT ".";
LOCATE y, x: PRINT CHR$(2);
xs = x: ys = y
GOTO petla

SUB wstaw (x, y, parametr)

COLOR 15: REM color parametr
LOCATE y, x

IF parametr = 0 THEN PRINT ".";
IF parametr > 0 THEN PRINT CHR$(65 + parametr);

END SUB
Powrót do góry
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
Piotr-246
Gość






PostWysłany: Sob 15:23, 11 Wrz 2021    Temat postu:

DECLARE SUB cegly ()
DECLARE SUB wstaw (x!, y!, parametr!)
DIM SHARED g1(0 TO 16) AS LONG
DIM SHARED g2(0 TO 16) AS LONG
DIM SHARED g3(0 TO 16) AS LONG
DIM SHARED g4(0 TO 16) AS LONG
DIM SHARED g5(0 TO 16) AS LONG
DIM SHARED g6(0 TO 16) AS LONG
DIM SHARED g7(0 TO 16) AS LONG
DIM SHARED g8(0 TO 16) AS LONG
DIM SHARED bi$(0 TO 7)
SCREEN 13

REM Tablice labiryntu
REM 0 - brak przejsc
REM 1 - pojedyncze na srodku
REM 2 - prawo lub gora
REM 3 - lewo lub dol
REM 4 - obydwa
REM
REM tablice przejsc
REM ........gornych.....dolnych.....prawych......lewych
lab$(0) = "0000000000__4444444444__1111111110__0111111111"
lab$(1) = "4444444444__4444444444__1111111110__0111111111"
lab$(2) = "4444444444__4444444044__1121111110__0112111111"
lab$(3) = "4444444044__4444444444__1111111110__0111111111"
lab$(4) = "4444444444__4444144444__1111111110__0111111111"
lab$(5) = "4444144444__4444444444__1111111110__0111111111"
lab$(6) = "4444444444__4444444444__1111111110__0111111111"
lab$(7) = "4444444444__4444444444__1110111110__0111011111"
lab$(8) = "4444444444__4444444444__1111111110__0111111111"
lab$(9) = "4444444444__0000000000__1111111110__0111111111"

REM 0- brak przegrod
REM 1- gorna lub prawa (bez srodka)
REM 2- dolna lub lewa (bez srodka)
REM 3 - obydwie
REM tylko poziome: 4-wszystkie, 5-srodek i lewa, 6 srodek i prawa,7 tylko srodek
REM tablice przegrod ........oraz tablica pol...
REM ........poziomych...pionowych..pozostalych....niezdef
prz$(0) = "0100701000__0020200020__1010012010__0111111111"
prz$(1) = "6001010106__0100020102__1401018130__0111111111"
prz$(2) = "4070270241__0210100004__1000030100__0112111111"
prz$(3) = "0120014004__0000012030__0010010D10__0111111111"
prz$(4) = "6401071421__0012100301__1010200310__0111111111"
prz$(5) = "7200102040__0000002010__1103020700__0111111111"
prz$(6) = "4203070101__0102010200__1041004B10__0111111111"
prz$(7) = "7017007110__0100200121__001A100010__0111011111"
prz$(8) = "4100600121__0020120200__1000313000__0111111111"
prz$(9) = "2070402024__0103010020__1014000120__0111111111"

REM pobranie grafiki

cegly

REM dane startowe
xr = 5: yr = 5
x = 3: y = 3: xs = 3: ys = 3
q$ = CHR$(219)
REM ***********************************************
REM rysowanie planszy

rysuj:
gora$ = MID$(lab$(yr), xr + 1, 1)
dol$ = MID$(lab$(yr), xr + 1 + 12, 1)
prawo$ = MID$(lab$(yr), xr + 1 + 24, 1)
lewo$ = MID$(lab$(yr), xr + 1 + 36, 1)

REM parametr kolorowania
parax = 0: paray = 0
IF xr / 2 = INT(xr / 2) THEN parax = 1
IF yr / 2 = INT(yr / 2) THEN paray = 1
p = parax * 4 + paray * 8

REM CLS

LOCATE 1, 1

REM wiersz 1
p = p + 1
wstaw 1, 1, p + 0
IF gora$ = "0" THEN wstaw 2, 1, p + 1: wstaw 3, 1, p + 2: wstaw 4, 1, p + 3
IF gora$ = "1" THEN wstaw 2, 1, p + 4: wstaw 3, 1, 0: wstaw 4, 1, p + 5
IF gora$ = "2" THEN wstaw 2, 1, p + 6: wstaw 3, 1, p + 7: wstaw 4, 1, 0
IF gora$ = "3" THEN wstaw 2, 1, 0: wstaw 3, 1, p + 8: wstaw 4, 1, p + 9
IF gora$ = "4" THEN wstaw 2, 1, 0: wstaw 3, 1, p + 10: wstaw 4, 1, 0
wstaw 5, 1, p + 11
PRINT

REM wiersz 2
p = p + 2
IF lewo$ = "0" THEN wstaw 1, 2, p + 0
IF lewo$ = "1" THEN wstaw 1, 2, p + 1
IF lewo$ = "2" THEN wstaw 1, 2, 0
IF lewo$ = "3" THEN wstaw 1, 2, p + 2
IF lewo$ = "4" THEN wstaw 1, 2, 0
REM PRINT "...";
IF prawo$ = "0" THEN wstaw 5, 2, p + 3
IF prawo$ = "1" THEN wstaw 5, 2, p + 4
IF prawo$ = "2" THEN wstaw 5, 2, 0
IF prawo$ = "3" THEN wstaw 5, 2, p + 5
IF prawo$ = "4" THEN wstaw 5, 2, 0
PRINT

REM wiersz 3
p = p + 3
IF lewo$ = "0" THEN wstaw 1, 3, p + 0
IF lewo$ = "1" THEN wstaw 1, 3, 0
IF lewo$ = "2" THEN wstaw 1, 3, p + 1
IF lewo$ = "3" THEN wstaw 1, 3, p + 2
IF lewo$ = "4" THEN wstaw 1, 3, p + 3
REM PRINT "...";
IF prawo$ = "0" THEN wstaw 5, 3, p + 4
IF prawo$ = "1" THEN wstaw 5, 3, 0
IF prawo$ = "2" THEN wstaw 5, 3, p + 5
IF prawo$ = "3" THEN wstaw 5, 3, p + 6
IF prawo$ = "4" THEN wstaw 5, 3, p + 7
PRINT

REM wiersz 4
p = p + 4
IF lewo$ = "0" THEN wstaw 1, 4, p + 0
IF lewo$ = "1" THEN wstaw 1, 4, p + 1
IF lewo$ = "2" THEN wstaw 1, 4, p + 2
IF lewo$ = "3" THEN wstaw 1, 4, 0
IF lewo$ = "4" THEN wstaw 1, 4, 0
REM PRINT "...";
IF prawo$ = "0" THEN wstaw 5, 4, p + 3
IF prawo$ = "1" THEN wstaw 5, 4, p + 4
IF prawo$ = "2" THEN wstaw 5, 4, p + 5
IF prawo$ = "3" THEN wstaw 5, 4, 0
IF prawo$ = "4" THEN wstaw 5, 4, 0
PRINT

REM wiersz 5
p = p + 5
wstaw 1, 5, p + 0
IF dol$ = "0" THEN wstaw 2, 5, p + 1: wstaw 3, 5, p + 2: wstaw 4, 5, p + 3
IF dol$ = "1" THEN wstaw 2, 5, p + 4: wstaw 3, 5, 0: wstaw 4, 5, p + 5
IF dol$ = "2" THEN wstaw 2, 5, p + 6: wstaw 3, 5, p + 7: wstaw 4, 5, 0
IF dol$ = "3" THEN wstaw 2, 5, 0: wstaw 3, 5, p + 8: wstaw 4, 5, p + 9
IF dol$ = "4" THEN wstaw 2, 5, 0: wstaw 3, 5, p + 10: wstaw 4, 5, 0
wstaw 5, 5, p + 11
PRINT

REM rysowanie przegrod
p = p + 6

poz$ = MID$(prz$(yr), xr + 1, 1)
pio$ = MID$(prz$(yr), xr + 1 + 12, 1)
IF poz$ = "0" THEN wstaw 2, 3, 0: wstaw 3, 3, 0: wstaw 4, 3, 0
IF poz$ = "1" THEN wstaw 2, 3, 0: wstaw 3, 3, 0: wstaw 4, 3, p + 0
IF poz$ = "2" THEN wstaw 2, 3, p + 1: wstaw 3, 3, 0: wstaw 4, 3, 0
IF poz$ = "3" THEN wstaw 2, 3, p + 2: wstaw 3, 3, 0: wstaw 4, 3, p + 3
IF poz$ = "4" THEN wstaw 2, 3, p + 4: wstaw 3, 3, p + 5: wstaw 4, 4, p + 6
IF poz$ = "5" THEN wstaw 2, 3, p + 7: wstaw 3, 3, p + 8: wstaw 4, 3, 0
IF poz$ = "6" THEN wstaw 2, 3, 0: wstaw 3, 3, p + 9: wstaw 4, 3, p + 10
IF poz$ = "7" THEN wstaw 2, 3, 0: wstaw 3, 3, p + 11: wstaw 4, 3, 0

IF pio$ = "0" THEN wstaw 3, 2, 0: wstaw 3, 4, 0
IF pio$ = "1" THEN wstaw 3, 2, p + 12: wstaw 3, 4, 0
IF pio$ = "2" THEN wstaw 3, 2, 0: wstaw 3, 4, p + 13
IF pio$ = "3" THEN wstaw 3, 2, p + 14: wstaw 3, 4, p + 15
REM pola pozostale
p = p + 7

res$ = "&H" + MID$(prz$(yr), xr + 1 + 24, 1)
reszta = VAL(res$)

IF (reszta AND 1) = 1 THEN wstaw 2, 2, p + 0
IF (reszta AND 2) = 2 THEN wstaw 4, 2, p + 1
IF (reszta AND 4) = 4 THEN wstaw 2, 4, p + 2
IF (reszta AND 8) = 8 THEN wstaw 4, 4, p + 3
IF (reszta AND 1) = 0 THEN wstaw 2, 2, 0
IF (reszta AND 2) = 0 THEN wstaw 4, 2, 0
IF (reszta AND 4) = 0 THEN wstaw 2, 4, 0
IF (reszta AND 8) = 0 THEN wstaw 4, 4, 0

LOCATE 14, 1: PRINT "room"; xr; "/"; yr; " "

GOTO wstawgracza
petla:
k$ = INKEY$
IF k$ = "" THEN GOTO petla
IF k$ = CHR$(0) + "K" THEN x = x - 1
IF k$ = CHR$(0) + "M" THEN x = x + 1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
IF k$ = CHR$(27) THEN END

REM sprawdzenie przejscia do innej planszy

IF x > 5 THEN x = 1: xs = 1: xr = xr + 1: GOTO rysuj
IF x < 1 THEN x = 5: xs = 5: xr = xr - 1: GOTO rysuj
IF y > 5 THEN y = 1: ys = 1: yr = yr + 1: GOTO rysuj
IF y < 1 THEN y = 5: ys = 5: yr = yr - 1: GOTO rysuj

REM sprawdzenie przeszkody
pobierz = SCREEN(y, x)
IF pobierz <> ASC(".") AND pobierz <> 3 THEN x = xs: y = ys: GOTO petla

wstawgracza:
COLOR 15
LOCATE ys, xs: PRINT ".";
LOCATE y, x: PRINT CHR$(2);
xs = x: ys = y
GOTO petla

SUB cegly

REM dane elementow
bi$(0) = "01110111" + "11111111" + "11111111" + "11111111" + "11111111" + "11111111" + "01111110" + "11101110"
bi$(1) = "01110111" + "10000001" + "10100101" + "11111111" + "10000001" + "00000000" + "10000001" + "11100000"
bi$(2) = "01110111" + "10000001" + "11000011" + "11111111" + "10111101" + "11111111" + "10001101" + "00001110"
bi$(3) = "00000000" + "10000001" + "10000001" + "11010101" + "10100101" + "00000000" + "10000101" + "11101110"
bi$(4) = "11011101" + "10000001" + "10000001" + "10010101" + "10100101" + "11111111" + "10100001" + "11101110"
bi$(5) = "11011101" + "10000001" + "11000011" + "10010101" + "10111101" + "00000000" + "10110001" + "11100000"
bi$(6) = "11011101" + "10000001" + "10100101" + "10010001" + "10000001" + "11111111" + "10000001" + "00001110"
bi$(7) = "00000000" + "11111111" + "11111111" + "11111111" + "11111111" + "00000000" + "01111110" + "11101110"
FOR yb = 0 TO 7
FOR xb = 0 TO 63
znak$ = MID$(bi$(yb), xb + 1, 1)
znak = VAL(znak$)
COLOR 15 * znak: PSET (xb, yb)
NEXT xb
NEXT yb
GET (0, 0)-(7, 7), g1
GET (8, 0)-(15, 7), g2
GET (16, 0)-(23, 7), g3
GET (24, 0)-(31, 7), g4
GET (32, 0)-(39, 7), g5
GET (40, 0)-(47, 7), g6
GET (48, 0)-(55, 7), g7
GET (56, 0)-(63, 7), g8
CLS
END SUB

SUB wstaw (xe, ye, parametr)

COLOR 15: REM color parametr
REM LOCATE ye, xe

IF parametr = 0 THEN LOCATE ye, xe: PRINT ".": GOTO koncz
ye = ye - 1: xe = xe - 1
IF parametr / 8 = INT(parametr / 8) THEN PUT (xe * 8, ye * 8), g1, PSET: GOTO koncz
IF parametr / 7 = INT(parametr / 7) THEN PUT (xe * 8, ye * 8), g2, PSET: GOTO koncz
IF parametr / 6 = INT(parametr / 6) THEN PUT (xe * 8, ye * 8), g3, PSET: GOTO koncz
IF parametr / 5 = INT(parametr / 5) THEN PUT (xe * 8, ye * 8), g4, PSET: GOTO koncz
IF parametr / 4 = INT(parametr / 4) THEN PUT (xe * 8, ye * 8), g5, PSET: GOTO koncz
IF parametr / 3 = INT(parametr / 3) THEN PUT (xe * 8, ye * 8), g6, PSET: GOTO koncz
IF parametr / 2 = INT(parametr / 2) THEN PUT (xe * 8, ye * 8), g7, PSET: GOTO koncz
IF parametr / 1 = INT(parametr / 1) THEN PUT (xe * 8, ye * 8), g8, PSET: GOTO koncz
koncz:

END SUB
Powrót do góry
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
Piotr-246
Gość






PostWysłany: Sob 16:39, 11 Wrz 2021    Temat postu:

DECLARE SUB cegly ()
DECLARE SUB wstaw (x!, y!, parametr!)
DIM SHARED g1(0 TO 36) AS LONG
DIM SHARED g2(0 TO 36) AS LONG
DIM SHARED g3(0 TO 36) AS LONG
DIM SHARED g4(0 TO 36) AS LONG
DIM SHARED g5(0 TO 36) AS LONG
DIM SHARED g6(0 TO 36) AS LONG
DIM SHARED g7(0 TO 36) AS LONG
DIM SHARED g8(0 TO 36) AS LONG
DIM SHARED bi$(0 TO 11)
SCREEN 13

REM Tablice labiryntu
REM 0 - brak przejsc
REM 1 - pojedyncze na srodku
REM 2 - prawo lub gora
REM 3 - lewo lub dol
REM 4 - obydwa
REM
REM tablice przejsc
REM ........gornych.....dolnych.....prawych......lewych
lab$(0) = "0000000000__4444444444__1111111110__0111111111"
lab$(1) = "4444444444__4444444444__1111111110__0111111111"
lab$(2) = "4444444444__4444444044__1121111110__0112111111"
lab$(3) = "4444444044__4444444444__1111111110__0111111111"
lab$(4) = "4444444444__4444144444__1111111110__0111111111"
lab$(5) = "4444144444__4444444444__1111111110__0111111111"
lab$(6) = "4444444444__4444444444__1111111110__0111111111"
lab$(7) = "4444444444__4444444444__1110111110__0111011111"
lab$(8) = "4444444444__4444444444__1111111110__0111111111"
lab$(9) = "4444444444__0000000000__1111111110__0111111111"

REM 0- brak przegrod
REM 1- gorna lub prawa (bez srodka)
REM 2- dolna lub lewa (bez srodka)
REM 3 - obydwie
REM tylko poziome: 4-wszystkie, 5-srodek i lewa, 6 srodek i prawa,7 tylko srodek
REM tablice przegrod ........oraz tablica pol...
REM ........poziomych...pionowych..pozostalych....niezdef
prz$(0) = "0100701000__0020200020__1010012010__0111111111"
prz$(1) = "6001010106__0100020102__1401018130__0111111111"
prz$(2) = "4070270241__0210100004__1000030100__0112111111"
prz$(3) = "0120014004__0000012030__0010010D10__0111111111"
prz$(4) = "6401071421__0012100301__1010200310__0111111111"
prz$(5) = "7200102040__0000002010__1103020700__0111111111"
prz$(6) = "4203070101__0102010200__1041004B10__0111111111"
prz$(7) = "7017007110__0100200121__001A100010__0111011111"
prz$(8) = "4100600121__0020120200__1000313000__0111111111"
prz$(9) = "2070402024__0103010020__1014000120__0111111111"

REM pobranie grafiki

cegly

REM dane startowe
xr = 5: yr = 5
x = 3: y = 3: xs = 3: ys = 3
q$ = CHR$(219)
REM ***********************************************
REM rysowanie planszy

rysuj:
CLS
COLOR 15
FOR kr = 0 TO 15: PRINT "...........................": NEXT kr


gora$ = MID$(lab$(yr), xr + 1, 1)
dol$ = MID$(lab$(yr), xr + 1 + 12, 1)
prawo$ = MID$(lab$(yr), xr + 1 + 24, 1)
lewo$ = MID$(lab$(yr), xr + 1 + 36, 1)

REM parametr kolorowania
parax = 0: paray = 0
IF xr / 2 = INT(xr / 2) THEN parax = 1
IF yr / 2 = INT(yr / 2) THEN paray = 1
p = parax * 4 + paray * 8

REM CLS

LOCATE 1, 1

REM wiersz 1
p = p + 1
wstaw 1, 1, p + 0
IF gora$ = "0" THEN wstaw 2, 1, p + 1: wstaw 3, 1, p + 2: wstaw 4, 1, p + 3
IF gora$ = "1" THEN wstaw 2, 1, p + 4: wstaw 3, 1, 0: wstaw 4, 1, p + 5
IF gora$ = "2" THEN wstaw 2, 1, p + 6: wstaw 3, 1, p + 7: wstaw 4, 1, 0
IF gora$ = "3" THEN wstaw 2, 1, 0: wstaw 3, 1, p + 8: wstaw 4, 1, p + 9
IF gora$ = "4" THEN wstaw 2, 1, 0: wstaw 3, 1, p + 10: wstaw 4, 1, 0
wstaw 5, 1, p + 11
PRINT

REM wiersz 2
p = p + 2
IF lewo$ = "0" THEN wstaw 1, 2, p + 0
IF lewo$ = "1" THEN wstaw 1, 2, p + 1
IF lewo$ = "2" THEN wstaw 1, 2, 0
IF lewo$ = "3" THEN wstaw 1, 2, p + 2
IF lewo$ = "4" THEN wstaw 1, 2, 0
REM PRINT "...";
IF prawo$ = "0" THEN wstaw 5, 2, p + 3
IF prawo$ = "1" THEN wstaw 5, 2, p + 4
IF prawo$ = "2" THEN wstaw 5, 2, 0
IF prawo$ = "3" THEN wstaw 5, 2, p + 5
IF prawo$ = "4" THEN wstaw 5, 2, 0
PRINT

REM wiersz 3
p = p + 3
IF lewo$ = "0" THEN wstaw 1, 3, p + 0
IF lewo$ = "1" THEN wstaw 1, 3, 0
IF lewo$ = "2" THEN wstaw 1, 3, p + 1
IF lewo$ = "3" THEN wstaw 1, 3, p + 2
IF lewo$ = "4" THEN wstaw 1, 3, p + 3
REM PRINT "...";
IF prawo$ = "0" THEN wstaw 5, 3, p + 4
IF prawo$ = "1" THEN wstaw 5, 3, 0
IF prawo$ = "2" THEN wstaw 5, 3, p + 5
IF prawo$ = "3" THEN wstaw 5, 3, p + 6
IF prawo$ = "4" THEN wstaw 5, 3, p + 7
PRINT

REM wiersz 4
p = p + 4
IF lewo$ = "0" THEN wstaw 1, 4, p + 0
IF lewo$ = "1" THEN wstaw 1, 4, p + 1
IF lewo$ = "2" THEN wstaw 1, 4, p + 2
IF lewo$ = "3" THEN wstaw 1, 4, 0
IF lewo$ = "4" THEN wstaw 1, 4, 0
REM PRINT "...";
IF prawo$ = "0" THEN wstaw 5, 4, p + 3
IF prawo$ = "1" THEN wstaw 5, 4, p + 4
IF prawo$ = "2" THEN wstaw 5, 4, p + 5
IF prawo$ = "3" THEN wstaw 5, 4, 0
IF prawo$ = "4" THEN wstaw 5, 4, 0
PRINT

REM wiersz 5
p = p + 5
wstaw 1, 5, p + 0
IF dol$ = "0" THEN wstaw 2, 5, p + 1: wstaw 3, 5, p + 2: wstaw 4, 5, p + 3
IF dol$ = "1" THEN wstaw 2, 5, p + 4: wstaw 3, 5, 0: wstaw 4, 5, p + 5
IF dol$ = "2" THEN wstaw 2, 5, p + 6: wstaw 3, 5, p + 7: wstaw 4, 5, 0
IF dol$ = "3" THEN wstaw 2, 5, 0: wstaw 3, 5, p + 8: wstaw 4, 5, p + 9
IF dol$ = "4" THEN wstaw 2, 5, 0: wstaw 3, 5, p + 10: wstaw 4, 5, 0
wstaw 5, 5, p + 11
PRINT

REM rysowanie przegrod
p = p + 6

poz$ = MID$(prz$(yr), xr + 1, 1)
pio$ = MID$(prz$(yr), xr + 1 + 12, 1)
IF poz$ = "0" THEN wstaw 2, 3, 0: wstaw 3, 3, 0: wstaw 4, 3, 0
IF poz$ = "1" THEN wstaw 2, 3, 0: wstaw 3, 3, 0: wstaw 4, 3, p + 0
IF poz$ = "2" THEN wstaw 2, 3, p + 1: wstaw 3, 3, 0: wstaw 4, 3, 0
IF poz$ = "3" THEN wstaw 2, 3, p + 2: wstaw 3, 3, 0: wstaw 4, 3, p + 3
IF poz$ = "4" THEN wstaw 2, 3, p + 4: wstaw 3, 3, p + 5: wstaw 4, 4, p + 6
IF poz$ = "5" THEN wstaw 2, 3, p + 7: wstaw 3, 3, p + 8: wstaw 4, 3, 0
IF poz$ = "6" THEN wstaw 2, 3, 0: wstaw 3, 3, p + 9: wstaw 4, 3, p + 10
IF poz$ = "7" THEN wstaw 2, 3, 0: wstaw 3, 3, p + 11: wstaw 4, 3, 0

IF pio$ = "0" THEN wstaw 3, 2, 0: wstaw 3, 4, 0
IF pio$ = "1" THEN wstaw 3, 2, p + 12: wstaw 3, 4, 0
IF pio$ = "2" THEN wstaw 3, 2, 0: wstaw 3, 4, p + 13
IF pio$ = "3" THEN wstaw 3, 2, p + 14: wstaw 3, 4, p + 15
REM pola pozostale
p = p + 7

res$ = "&H" + MID$(prz$(yr), xr + 1 + 24, 1)
reszta = VAL(res$)

IF (reszta AND 1) = 1 THEN wstaw 2, 2, p + 0
IF (reszta AND 2) = 2 THEN wstaw 4, 2, p + 1
IF (reszta AND 4) = 4 THEN wstaw 2, 4, p + 2
IF (reszta AND 8) = 8 THEN wstaw 4, 4, p + 3
IF (reszta AND 1) = 0 THEN wstaw 2, 2, 0
IF (reszta AND 2) = 0 THEN wstaw 4, 2, 0
IF (reszta AND 4) = 0 THEN wstaw 2, 4, 0
IF (reszta AND 8) = 0 THEN wstaw 4, 4, 0

LOCATE 14, 1: PRINT "room"; xr; "/"; yr; " "

GOTO wstawgracza
petla:
k$ = INKEY$
IF k$ = "" THEN GOTO petla
IF k$ = CHR$(0) + "K" THEN x = x - 1
IF k$ = CHR$(0) + "M" THEN x = x + 1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
IF k$ = CHR$(27) THEN END

REM sprawdzenie przejscia do innej planszy

IF x > 7 THEN x = 1: xs = 1: xr = xr + 1: GOTO rysuj
IF x < 1 THEN x = 7: xs = 7: xr = xr - 1: GOTO rysuj
IF y > 7 THEN y = 1: ys = 1: yr = yr + 1: GOTO rysuj
IF y < 1 THEN y = 7: ys = 7: yr = yr - 1: GOTO rysuj

REM sprawdzenie przeszkody
pobierz = SCREEN(y, x)
IF pobierz <> ASC(".") AND pobierz <> 3 THEN x = xs: y = ys: GOTO petla

wstawgracza:
COLOR 15
LOCATE ys, xs: PRINT ".";
LOCATE y, x: PRINT CHR$(2);
xs = x: ys = y
GOTO petla

SUB cegly

REM dane elementow
bi$(0) = "011111011111" + "111111111111" + "111111111111" + "111111111111"
bi$(1) = "011111011111" + "100000000001" + "100010010001" + "111111111111"
bi$(2) = "011111011111" + "100000000001" + "100100001001" + "111111111111"
bi$(3) = "011111011111" + "100000000001" + "101000000101" + "110101010101"
bi$(4) = "011111011111" + "100000000001" + "110000000011" + "110101010101"
bi$(5) = "000000000000" + "100000000001" + "100000000001" + "110100010101"
bi$(6) = "110111110111" + "100000000001" + "100000000001" + "110000010001"
bi$(7) = "110111110111" + "100000000001" + "110000000011" + "100000000001"
bi$(8) = "110111110111" + "100000000001" + "101000000101" + "100000000001"
bi$(9) = "110111110111" + "100000000001" + "100100001001" + "111111111111"
bi$(10) = "110111110111" + "100000000001" + "100010010001" + "111111111111"
bi$(11) = "000000000000" + "111111111111" + "111111111111" + "111111111111"

FOR yb = 0 TO 11
FOR xb = 0 TO 47
znak$ = MID$(bi$(yb), xb + 1, 1)
znak = VAL(znak$)
COLOR 15 * znak: PSET (xb, yb)
NEXT xb
NEXT yb
GET (0, 0)-(11, 11), g1
GET (12, 0)-(23, 11), g2
GET (24, 0)-(35, 11), g3
GET (36, 0)-(47, 11), g4

CLS
REM dane elementow
bi$(0) = "111111111111" + "111111111111" + "011111111110" + "111110111110"
bi$(1) = "100000000001" + "000000000000" + "100000000001" + "111110000000"
bi$(2) = "101111111101" + "111111111111" + "100000001101" + "111110111110"
bi$(3) = "101000000101" + "000000000000" + "100000000101" + "000000111110"
bi$(4) = "101011110101" + "111111111111" + "100000000001" + "111110111110"
bi$(5) = "101010010101" + "000000000000" + "100000000001" + "111110111110"
bi$(6) = "101010010101" + "111111111111" + "100000000001" + "111110000000"
bi$(7) = "101011110101" + "000000000000" + "100000000001" + "111110111110"
bi$(8) = "101000000101" + "111111111111" + "101000000001" + "000000111110"
bi$(9) = "101111111101" + "000000000000" + "101100000001" + "111110111110"
bi$(10) = "100000000001" + "111111111111" + "100000000001" + "111110111110"
bi$(11) = "111111111111" + "000000000000" + "011111111110" + "111110111110"

FOR yb = 0 TO 11
FOR xb = 0 TO 47
znak$ = MID$(bi$(yb), xb + 1, 1)
znak = VAL(znak$)
COLOR 15 * znak: PSET (xb, yb)
NEXT xb
NEXT yb

GET (0, 0)-(11, 11), g5
GET (12, 0)-(23, 11), g6
GET (24, 0)-(35, 11), g7
GET (36, 0)-(47, 11), g8


CLS
END SUB

SUB wstaw (xe, ye, parametr)

COLOR 15: REM color parametr

IF parametr = 0 THEN GOTO koncz
ye = ye - 1: xe = xe - 1
xe = xe * 12
ye = ye * 12

IF parametr / 8 = INT(parametr / 8) THEN PUT (xe, ye), g1, PSET: GOTO koncz
IF parametr / 7 = INT(parametr / 7) THEN PUT (xe, ye), g2, PSET: GOTO koncz
IF parametr / 6 = INT(parametr / 6) THEN PUT (xe, ye), g3, PSET: GOTO koncz
IF parametr / 5 = INT(parametr / 5) THEN PUT (xe, ye), g4, PSET: GOTO koncz
IF parametr / 4 = INT(parametr / 4) THEN PUT (xe, ye), g5, PSET: GOTO koncz
IF parametr / 3 = INT(parametr / 3) THEN PUT (xe, ye), g6, PSET: GOTO koncz
IF parametr / 2 = INT(parametr / 2) THEN PUT (xe, ye), g7, PSET: GOTO koncz
IF parametr / 1 = INT(parametr / 1) THEN PUT (xe, ye), g8, PSET: GOTO koncz
koncz:

END SUB
Powrót do góry
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
Piotr-246
Gość






PostWysłany: Sob 19:48, 11 Wrz 2021    Temat postu:

DECLARE SUB cegly ()
DECLARE SUB wstaw (x!, y!, parametr!)
DIM SHARED g1(0 TO 64) AS LONG
DIM SHARED g2(0 TO 64) AS LONG
DIM SHARED g3(0 TO 64) AS LONG
DIM SHARED g4(0 TO 64) AS LONG
DIM SHARED g5(0 TO 64) AS LONG
DIM SHARED g6(0 TO 64) AS LONG
DIM SHARED g7(0 TO 64) AS LONG
DIM SHARED g8(0 TO 64) AS LONG
DIM SHARED bi$(0 TO 15)
SCREEN 13

REM Tablice labiryntu
REM 0 - brak przejsc
REM 1 - pojedyncze na srodku
REM 2 - prawo lub gora
REM 3 - lewo lub dol
REM 4 - obydwa
REM
REM tablice przejsc
REM ........gornych.....dolnych.....prawych......lewych
lab$(0) = "0000000000__4444444444__1111111110__0111111111"
lab$(1) = "4444444444__4444444444__1111111110__0111111111"
lab$(2) = "4444444444__4444444044__1121111110__0112111111"
lab$(3) = "4444444044__4444444444__1111111110__0111111111"
lab$(4) = "4444444444__4444144444__1111111110__0111111111"
lab$(5) = "4444144444__4444444444__1111111110__0111111111"
lab$(6) = "4444444444__4444444444__1111111110__0111111111"
lab$(7) = "4444444444__4444444444__1110111110__0111011111"
lab$(8) = "4444444444__4444444444__1111111110__0111111111"
lab$(9) = "4444444444__0000000000__1111111110__0111111111"

REM 0- brak przegrod
REM 1- gorna lub prawa (bez srodka)
REM 2- dolna lub lewa (bez srodka)
REM 3 - obydwie
REM tylko poziome: 4-wszystkie, 5-srodek i lewa, 6 srodek i prawa,7 tylko srodek
REM tablice przegrod ........oraz tablica pol...
REM ........poziomych...pionowych..pozostalych....niezdef
prz$(0) = "0100701000__0020200020__1010012010__0111111111"
prz$(1) = "6001010106__0100020102__1401018130__0111111111"
prz$(2) = "4070270241__0210100004__1000030100__0112111111"
prz$(3) = "0120014004__0000012030__0010010D10__0111111111"
prz$(4) = "6401071421__0012100301__1010200310__0111111111"
prz$(5) = "7200102040__0000002010__1103020700__0111111111"
prz$(6) = "4203070101__0102010200__1041004B10__0111111111"
prz$(7) = "7017007110__0100200121__001A100010__0111011111"
prz$(8) = "4100600121__0020120200__1000313000__0111111111"
prz$(9) = "2070402024__0103010020__1014000120__0111111111"

REM pobranie grafiki

cegly

REM dane startowe
xr = 5: yr = 5
x = 3: y = 3: xs = 3: ys = 3
q$ = CHR$(219)
REM ***********************************************
REM rysowanie planszy

rysuj:
CLS
COLOR 15
FOR kr = 0 TO 15: PRINT "...........................": NEXT kr


gora$ = MID$(lab$(yr), xr + 1, 1)
dol$ = MID$(lab$(yr), xr + 1 + 12, 1)
prawo$ = MID$(lab$(yr), xr + 1 + 24, 1)
lewo$ = MID$(lab$(yr), xr + 1 + 36, 1)

REM parametr kolorowania
parax = 0: paray = 0
IF xr / 2 = INT(xr / 2) THEN parax = 1
IF yr / 2 = INT(yr / 2) THEN paray = 1
p = parax * 4 + paray * 8

REM CLS

LOCATE 1, 1

REM wiersz 1
p = p + 1
wstaw 1, 1, p + 0
IF gora$ = "0" THEN wstaw 2, 1, p + 1: wstaw 3, 1, p + 2: wstaw 4, 1, p + 3
IF gora$ = "1" THEN wstaw 2, 1, p + 4: wstaw 3, 1, 0: wstaw 4, 1, p + 5
IF gora$ = "2" THEN wstaw 2, 1, p + 6: wstaw 3, 1, p + 7: wstaw 4, 1, 0
IF gora$ = "3" THEN wstaw 2, 1, 0: wstaw 3, 1, p + 8: wstaw 4, 1, p + 9
IF gora$ = "4" THEN wstaw 2, 1, 0: wstaw 3, 1, p + 10: wstaw 4, 1, 0
wstaw 5, 1, p + 11
PRINT

REM wiersz 2
p = p + 2
IF lewo$ = "0" THEN wstaw 1, 2, p + 0
IF lewo$ = "1" THEN wstaw 1, 2, p + 1
IF lewo$ = "2" THEN wstaw 1, 2, 0
IF lewo$ = "3" THEN wstaw 1, 2, p + 2
IF lewo$ = "4" THEN wstaw 1, 2, 0
REM PRINT "...";
IF prawo$ = "0" THEN wstaw 5, 2, p + 3
IF prawo$ = "1" THEN wstaw 5, 2, p + 4
IF prawo$ = "2" THEN wstaw 5, 2, 0
IF prawo$ = "3" THEN wstaw 5, 2, p + 5
IF prawo$ = "4" THEN wstaw 5, 2, 0
PRINT

REM wiersz 3
p = p + 3
IF lewo$ = "0" THEN wstaw 1, 3, p + 0
IF lewo$ = "1" THEN wstaw 1, 3, 0
IF lewo$ = "2" THEN wstaw 1, 3, p + 1
IF lewo$ = "3" THEN wstaw 1, 3, p + 2
IF lewo$ = "4" THEN wstaw 1, 3, p + 3
REM PRINT "...";
IF prawo$ = "0" THEN wstaw 5, 3, p + 4
IF prawo$ = "1" THEN wstaw 5, 3, 0
IF prawo$ = "2" THEN wstaw 5, 3, p + 5
IF prawo$ = "3" THEN wstaw 5, 3, p + 6
IF prawo$ = "4" THEN wstaw 5, 3, p + 7
PRINT

REM wiersz 4
p = p + 4
IF lewo$ = "0" THEN wstaw 1, 4, p + 0
IF lewo$ = "1" THEN wstaw 1, 4, p + 1
IF lewo$ = "2" THEN wstaw 1, 4, p + 2
IF lewo$ = "3" THEN wstaw 1, 4, 0
IF lewo$ = "4" THEN wstaw 1, 4, 0
REM PRINT "...";
IF prawo$ = "0" THEN wstaw 5, 4, p + 3
IF prawo$ = "1" THEN wstaw 5, 4, p + 4
IF prawo$ = "2" THEN wstaw 5, 4, p + 5
IF prawo$ = "3" THEN wstaw 5, 4, 0
IF prawo$ = "4" THEN wstaw 5, 4, 0
PRINT

REM wiersz 5
p = p + 5
wstaw 1, 5, p + 0
IF dol$ = "0" THEN wstaw 2, 5, p + 1: wstaw 3, 5, p + 2: wstaw 4, 5, p + 3
IF dol$ = "1" THEN wstaw 2, 5, p + 4: wstaw 3, 5, 0: wstaw 4, 5, p + 5
IF dol$ = "2" THEN wstaw 2, 5, p + 6: wstaw 3, 5, p + 7: wstaw 4, 5, 0
IF dol$ = "3" THEN wstaw 2, 5, 0: wstaw 3, 5, p + 8: wstaw 4, 5, p + 9
IF dol$ = "4" THEN wstaw 2, 5, 0: wstaw 3, 5, p + 10: wstaw 4, 5, 0
wstaw 5, 5, p + 11
PRINT

REM rysowanie przegrod
p = p + 6

poz$ = MID$(prz$(yr), xr + 1, 1)
pio$ = MID$(prz$(yr), xr + 1 + 12, 1)
IF poz$ = "0" THEN wstaw 2, 3, 0: wstaw 3, 3, 0: wstaw 4, 3, 0
IF poz$ = "1" THEN wstaw 2, 3, 0: wstaw 3, 3, 0: wstaw 4, 3, p + 0
IF poz$ = "2" THEN wstaw 2, 3, p + 1: wstaw 3, 3, 0: wstaw 4, 3, 0
IF poz$ = "3" THEN wstaw 2, 3, p + 2: wstaw 3, 3, 0: wstaw 4, 3, p + 3
IF poz$ = "4" THEN wstaw 2, 3, p + 4: wstaw 3, 3, p + 5: wstaw 4, 4, p + 6
IF poz$ = "5" THEN wstaw 2, 3, p + 7: wstaw 3, 3, p + 8: wstaw 4, 3, 0
IF poz$ = "6" THEN wstaw 2, 3, 0: wstaw 3, 3, p + 9: wstaw 4, 3, p + 10
IF poz$ = "7" THEN wstaw 2, 3, 0: wstaw 3, 3, p + 11: wstaw 4, 3, 0

IF pio$ = "0" THEN wstaw 3, 2, 0: wstaw 3, 4, 0
IF pio$ = "1" THEN wstaw 3, 2, p + 12: wstaw 3, 4, 0
IF pio$ = "2" THEN wstaw 3, 2, 0: wstaw 3, 4, p + 13
IF pio$ = "3" THEN wstaw 3, 2, p + 14: wstaw 3, 4, p + 15
REM pola pozostale
p = p + 7

res$ = "&H" + MID$(prz$(yr), xr + 1 + 24, 1)
reszta = VAL(res$)

IF (reszta AND 1) = 1 THEN wstaw 2, 2, p + 0
IF (reszta AND 2) = 2 THEN wstaw 4, 2, p + 1
IF (reszta AND 4) = 4 THEN wstaw 2, 4, p + 2
IF (reszta AND 8) = 8 THEN wstaw 4, 4, p + 3
IF (reszta AND 1) = 0 THEN wstaw 2, 2, 0
IF (reszta AND 2) = 0 THEN wstaw 4, 2, 0
IF (reszta AND 4) = 0 THEN wstaw 2, 4, 0
IF (reszta AND 8) = 0 THEN wstaw 4, 4, 0

LOCATE 14, 1: PRINT "room"; xr; "/"; yr; " "

GOTO wstawgracza
petla:
k$ = INKEY$
IF k$ = "" THEN GOTO petla
IF k$ = CHR$(0) + "K" THEN x = x - 1
IF k$ = CHR$(0) + "M" THEN x = x + 1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
IF k$ = CHR$(27) THEN END

REM sprawdzenie przejscia do innej planszy

IF x > 9 THEN x = 1: xs = 1: xr = xr + 1: GOTO rysuj
IF x < 1 THEN x = 9: xs = 9: xr = xr - 1: GOTO rysuj
IF y > 9 THEN y = 1: ys = 1: yr = yr + 1: GOTO rysuj
IF y < 1 THEN y = 9: ys = 9: yr = yr - 1: GOTO rysuj

REM sprawdzenie przeszkody
pobierz = SCREEN(y, x)
IF pobierz <> ASC(".") AND pobierz <> 3 THEN x = xs: y = ys: GOTO petla

wstawgracza:
COLOR 15
LOCATE ys, xs: PRINT ".";
LOCATE y, x: PRINT CHR$(2);
xs = x: ys = y
GOTO petla

SUB cegly

REM dane elementow
bi$(0) = "0011111100111111" + "1111111111111111" + "1111111111111111" + "1111111111111111"
bi$(1) = "0011111100111111" + "1000000000000001" + "1000001001000001" + "1111111111111111"
bi$(2) = "0011111100111111" + "1000000000000001" + "1000010000100001" + "1111111111111111"
bi$(3) = "0011111100111111" + "1000000000000001" + "1000100000010001" + "1111111111111111"
bi$(4) = "0011111100111111" + "1000000000000001" + "1001000000001001" + "1111111101011101"
bi$(5) = "0011111100111111" + "1000000000000001" + "1010000000000101" + "1101010101010101"
bi$(6) = "0000000000000000" + "1000000000000001" + "1100000000000011" + "1101010101010101"
bi$(7) = "0000000000000000" + "1000000000000001" + "1000000000000001" + "1100010100010101"
bi$(8) = "1100111111001111" + "1000000000000001" + "1000000000000001" + "1000010000010101"
bi$(9) = "1100111111001111" + "1000000000000001" + "1100000000000011" + "1000010000010001"
bi$(10) = "1100111111001111" + "1000000000000001" + "1010000000000101" + "1000000000010001"
bi$(11) = "1100111111001111" + "1000000000000001" + "1001000000001001" + "1000000000000001"
bi$(12) = "1100111111001111" + "1000000000000001" + "1000100000010001" + "1000000000000001"
bi$(13) = "1100111111001111" + "1000000000000001" + "1000010000100001" + "1000000000000001"
bi$(14) = "0000000000000000" + "1000000000000001" + "1000001001000001" + "1000000000000001"
bi$(15) = "0000000000000000" + "1111111111111111" + "1111111111111111" + "1111111111111111"

FOR yb = 0 TO 15
FOR xb = 0 TO 63
znak$ = MID$(bi$(yb), xb + 1, 1)
znak = VAL(znak$)
COLOR 15 * znak: PSET (xb, yb)
NEXT xb
NEXT yb
GET (0, 0)-(15, 15), g1
GET (16, 0)-(31, 15), g2
GET (32, 0)-(47, 15), g3
GET (48, 0)-(63, 15), g4

CLS
REM dane elementow
bi$(0) = "1111111111111111" + "1111111111111111" + "0111111111111110" + "1111110000000000"
bi$(1) = "1000000000000001" + "0000000000000000" + "1000000000000001" + "1111110011111100"
bi$(2) = "1011111111111101" + "1111111111111111" + "1000000000001101" + "1111110011111100"
bi$(3) = "1010000000000101" + "0000000000000000" + "1000000000000101" + "0000000011111100"
bi$(4) = "1010111111110101" + "1111111111111111" + "1000000000000001" + "1111110011111100"
bi$(5) = "1010100000010101" + "0000000000000000" + "1000000000000001" + "1111110011111100"
bi$(6) = "1010101111010101" + "1111111111111111" + "1000000000000001" + "1111110011111100"
bi$(7) = "1010101001010101" + "0000000000000000" + "1000000000000001" + "1111110011111100"
bi$(8) = "1010101001010101" + "1111111111111111" + "1000000000000001" + "1111110011111100"
bi$(9) = "1010101111010101" + "0000000000000000" + "1000000000000001" + "1111110000000000"
bi$(10) = "1010100000010101" + "1111111111111111" + "1000000000000001" + "1111110011111100"
bi$(11) = "1010111111110101" + "0000000000000000" + "1000000000000001" + "1111110011111100"
bi$(12) = "1010000000000101" + "1111111111111111" + "1010000000000001" + "0000000011111100"
bi$(13) = "1011111111111101" + "0000000000000000" + "1011000000000001" + "1111110011111100"
bi$(14) = "1000000000000001" + "1111111111111111" + "1000000000000001" + "1111110011111100"
bi$(15) = "1111111111111111" + "0000000000000000" + "0111111111111110" + "1111110011111100"

FOR yb = 0 TO 15
FOR xb = 0 TO 63
znak$ = MID$(bi$(yb), xb + 1, 1)
znak = VAL(znak$)
COLOR 15 * znak: PSET (xb, yb)
NEXT xb
NEXT yb

GET (0, 0)-(15, 15), g5
GET (16, 0)-(31, 15), g6
GET (32, 0)-(47, 15), g7
GET (48, 0)-(63, 15), g8


CLS
END SUB

SUB wstaw (xe, ye, parametr)

COLOR 15: REM color parametr

IF parametr = 0 THEN GOTO koncz
ye = ye - 1: xe = xe - 1
xe = xe * 16
ye = ye * 16

IF parametr / 8 = INT(parametr / 8) THEN PUT (xe, ye), g1, PSET: GOTO koncz
IF parametr / 7 = INT(parametr / 7) THEN PUT (xe, ye), g2, PSET: GOTO koncz
IF parametr / 6 = INT(parametr / 6) THEN PUT (xe, ye), g3, PSET: GOTO koncz
IF parametr / 5 = INT(parametr / 5) THEN PUT (xe, ye), g4, PSET: GOTO koncz
IF parametr / 4 = INT(parametr / 4) THEN PUT (xe, ye), g5, PSET: GOTO koncz
IF parametr / 3 = INT(parametr / 3) THEN PUT (xe, ye), g6, PSET: GOTO koncz
IF parametr / 2 = INT(parametr / 2) THEN PUT (xe, ye), g7, PSET: GOTO koncz
IF parametr / 1 = INT(parametr / 1) THEN PUT (xe, ye), g8, PSET: GOTO koncz
koncz:

END SUB
Powrót do góry
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
Piotr-246
Gość






PostWysłany: Nie 10:07, 12 Wrz 2021    Temat postu:

DECLARE SUB cegly ()
DECLARE SUB wstaw (x!, y!, parametr!)
DIM SHARED g1(0 TO 64) AS LONG
DIM SHARED g2(0 TO 64) AS LONG
DIM SHARED g3(0 TO 64) AS LONG
DIM SHARED g4(0 TO 64) AS LONG
DIM SHARED g5(0 TO 64) AS LONG
DIM SHARED g6(0 TO 64) AS LONG
DIM SHARED g7(0 TO 64) AS LONG
DIM SHARED g8(0 TO 64) AS LONG
DIM SHARED bi$(0 TO 15)
SCREEN 13

REM Tablice labiryntu
REM 0 - brak przejsc
REM 1 - pojedyncze na srodku
REM 2 - prawo lub gora
REM 3 - lewo lub dol
REM 4 - obydwa
REM
REM tablice przejsc
REM ........gornych.....dolnych.....prawych......lewych
lab$(0) = "0000000000__4444444444__1111111110__0111111111"
lab$(1) = "4444444444__4444444444__1111111110__0111111111"
lab$(2) = "4444444444__4444444044__1121111110__0112111111"
lab$(3) = "4444444044__4444444444__1111111110__0111111111"
lab$(4) = "4444444444__4444144444__1111111110__0111111111"
lab$(5) = "4444144444__4444444444__1111111110__0111111111"
lab$(6) = "4444444444__4444444444__1111111110__0111111111"
lab$(7) = "4444444444__4444444444__1110111110__0111011111"
lab$(8) = "4444444444__4444444444__1111111110__0111111111"
lab$(9) = "4444444444__0000000000__1111111110__0111111111"

REM 0- brak przegrod
REM 1- gorna lub prawa (bez srodka)
REM 2- dolna lub lewa (bez srodka)
REM 3 - obydwie
REM tylko poziome: 4-wszystkie, 5-srodek i lewa, 6 srodek i prawa,7 tylko srodek
REM tablice przegrod ........oraz tablica pol...
REM ........poziomych...pionowych..pozostalych....niezdef
prz$(0) = "0100701000__0020200020__1010012010__0111111111"
prz$(1) = "6001010106__0100020102__1401018130__0111111111"
prz$(2) = "4070270241__0210100004__1000030100__0112111111"
prz$(3) = "0120014004__0000012030__0010010D10__0111111111"
prz$(4) = "6401071421__0012100301__1010200310__0111111111"
prz$(5) = "7200102040__0000002010__1103020700__0111111111"
prz$(6) = "4203070101__0102010200__1041004B10__0111111111"
prz$(7) = "7017007110__0100200121__001A100010__0111011111"
prz$(8) = "4100600121__0020120200__1000313000__0111111111"
prz$(9) = "2070402024__0103010020__1014000120__0111111111"

REM pobranie grafiki

cegly

REM dane startowe
xr = 5: yr = 5
x = 9: y = 9: xs = 9: ys = 9
q$ = CHR$(219)
REM ***********************************************
REM rysowanie planszy

rysuj:
CLS
COLOR 15
FOR kr = 0 TO 19: PRINT "....................": NEXT kr


gora$ = MID$(lab$(yr), xr + 1, 1)
dol$ = MID$(lab$(yr), xr + 1 + 12, 1)
prawo$ = MID$(lab$(yr), xr + 1 + 24, 1)
lewo$ = MID$(lab$(yr), xr + 1 + 36, 1)

REM parametr kolorowania
parax = 0: paray = 0
IF xr / 2 = INT(xr / 2) THEN parax = 1
IF yr / 2 = INT(yr / 2) THEN paray = 1
p = parax * 4 + paray * 8

REM CLS

LOCATE 1, 1

REM wiersz 1
p = p + 1
wstaw 1, 1, p + 0
IF gora$ = "0" THEN wstaw 2, 1, p + 1: wstaw 3, 1, p + 2: wstaw 4, 1, p + 3
IF gora$ = "1" THEN wstaw 2, 1, p + 4: wstaw 3, 1, 0: wstaw 4, 1, p + 5
IF gora$ = "2" THEN wstaw 2, 1, p + 6: wstaw 3, 1, p + 7: wstaw 4, 1, 0
IF gora$ = "3" THEN wstaw 2, 1, 0: wstaw 3, 1, p + 8: wstaw 4, 1, p + 9
IF gora$ = "4" THEN wstaw 2, 1, 0: wstaw 3, 1, p + 10: wstaw 4, 1, 0
wstaw 5, 1, p + 11
PRINT

REM wiersz 2
p = p + 2
IF lewo$ = "0" THEN wstaw 1, 2, p + 0
IF lewo$ = "1" THEN wstaw 1, 2, p + 1
IF lewo$ = "2" THEN wstaw 1, 2, 0
IF lewo$ = "3" THEN wstaw 1, 2, p + 2
IF lewo$ = "4" THEN wstaw 1, 2, 0
REM PRINT "...";
IF prawo$ = "0" THEN wstaw 5, 2, p + 3
IF prawo$ = "1" THEN wstaw 5, 2, p + 4
IF prawo$ = "2" THEN wstaw 5, 2, 0
IF prawo$ = "3" THEN wstaw 5, 2, p + 5
IF prawo$ = "4" THEN wstaw 5, 2, 0
PRINT

REM wiersz 3
p = p + 3
IF lewo$ = "0" THEN wstaw 1, 3, p + 0
IF lewo$ = "1" THEN wstaw 1, 3, 0
IF lewo$ = "2" THEN wstaw 1, 3, p + 1
IF lewo$ = "3" THEN wstaw 1, 3, p + 2
IF lewo$ = "4" THEN wstaw 1, 3, p + 3
REM PRINT "...";
IF prawo$ = "0" THEN wstaw 5, 3, p + 4
IF prawo$ = "1" THEN wstaw 5, 3, 0
IF prawo$ = "2" THEN wstaw 5, 3, p + 5
IF prawo$ = "3" THEN wstaw 5, 3, p + 6
IF prawo$ = "4" THEN wstaw 5, 3, p + 7
PRINT

REM wiersz 4
p = p + 4
IF lewo$ = "0" THEN wstaw 1, 4, p + 0
IF lewo$ = "1" THEN wstaw 1, 4, p + 1
IF lewo$ = "2" THEN wstaw 1, 4, p + 2
IF lewo$ = "3" THEN wstaw 1, 4, 0
IF lewo$ = "4" THEN wstaw 1, 4, 0
REM PRINT "...";
IF prawo$ = "0" THEN wstaw 5, 4, p + 3
IF prawo$ = "1" THEN wstaw 5, 4, p + 4
IF prawo$ = "2" THEN wstaw 5, 4, p + 5
IF prawo$ = "3" THEN wstaw 5, 4, 0
IF prawo$ = "4" THEN wstaw 5, 4, 0
PRINT

REM wiersz 5
p = p + 5
wstaw 1, 5, p + 0
IF dol$ = "0" THEN wstaw 2, 5, p + 1: wstaw 3, 5, p + 2: wstaw 4, 5, p + 3
IF dol$ = "1" THEN wstaw 2, 5, p + 4: wstaw 3, 5, 0: wstaw 4, 5, p + 5
IF dol$ = "2" THEN wstaw 2, 5, p + 6: wstaw 3, 5, p + 7: wstaw 4, 5, 0
IF dol$ = "3" THEN wstaw 2, 5, 0: wstaw 3, 5, p + 8: wstaw 4, 5, p + 9
IF dol$ = "4" THEN wstaw 2, 5, 0: wstaw 3, 5, p + 10: wstaw 4, 5, 0
wstaw 5, 5, p + 11
PRINT

REM rysowanie przegrod
p = p + 6

poz$ = MID$(prz$(yr), xr + 1, 1)
pio$ = MID$(prz$(yr), xr + 1 + 12, 1)
IF poz$ = "0" THEN wstaw 2, 3, 0: wstaw 3, 3, 0: wstaw 4, 3, 0
IF poz$ = "1" THEN wstaw 2, 3, 0: wstaw 3, 3, 0: wstaw 4, 3, p + 0
IF poz$ = "2" THEN wstaw 2, 3, p + 1: wstaw 3, 3, 0: wstaw 4, 3, 0
IF poz$ = "3" THEN wstaw 2, 3, p + 2: wstaw 3, 3, 0: wstaw 4, 3, p + 3
IF poz$ = "4" THEN wstaw 2, 3, p + 4: wstaw 3, 3, p + 5: wstaw 4, 4, p + 6
IF poz$ = "5" THEN wstaw 2, 3, p + 7: wstaw 3, 3, p + 8: wstaw 4, 3, 0
IF poz$ = "6" THEN wstaw 2, 3, 0: wstaw 3, 3, p + 9: wstaw 4, 3, p + 10
IF poz$ = "7" THEN wstaw 2, 3, 0: wstaw 3, 3, p + 11: wstaw 4, 3, 0

IF pio$ = "0" THEN wstaw 3, 2, 0: wstaw 3, 4, 0
IF pio$ = "1" THEN wstaw 3, 2, p + 12: wstaw 3, 4, 0
IF pio$ = "2" THEN wstaw 3, 2, 0: wstaw 3, 4, p + 13
IF pio$ = "3" THEN wstaw 3, 2, p + 14: wstaw 3, 4, p + 15
REM pola pozostale
p = p + 7

res$ = "&H" + MID$(prz$(yr), xr + 1 + 24, 1)
reszta = VAL(res$)

IF (reszta AND 1) = 1 THEN wstaw 2, 2, p + 0
IF (reszta AND 2) = 2 THEN wstaw 4, 2, p + 1
IF (reszta AND 4) = 4 THEN wstaw 2, 4, p + 2
IF (reszta AND 8) = 8 THEN wstaw 4, 4, p + 3
IF (reszta AND 1) = 0 THEN wstaw 2, 2, 0
IF (reszta AND 2) = 0 THEN wstaw 4, 2, 0
IF (reszta AND 4) = 0 THEN wstaw 2, 4, 0
IF (reszta AND 8) = 0 THEN wstaw 4, 4, 0

LOCATE 23, 1: PRINT "room"; xr; "/"; yr; " "

GOTO wstawgracza
petla:
k$ = INKEY$
IF k$ = "" THEN GOTO petla
IF k$ = CHR$(0) + "K" THEN x = x - 1
IF k$ = CHR$(0) + "M" THEN x = x + 1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
IF k$ = CHR$(27) THEN END

REM sprawdzenie przejscia do innej planszy

IF x > 20 THEN x = 1: xs = 1: xr = xr + 1: GOTO rysuj
IF x < 1 THEN x = 20: xs = 20: xr = xr - 1: GOTO rysuj
IF y > 20 THEN y = 1: ys = 1: yr = yr + 1: GOTO rysuj
IF y < 1 THEN y = 20: ys = 20: yr = yr - 1: GOTO rysuj

REM sprawdzenie przeszkody
pobierz = SCREEN(y, x)
IF pobierz <> ASC(".") AND pobierz <> 3 THEN x = xs: y = ys: GOTO petla

wstawgracza:
COLOR 15
LOCATE ys, xs: PRINT ".";
LOCATE y, x: PRINT CHR$(2);
xs = x: ys = y
GOTO petla

SUB cegly

REM dane elementow
bi$(0) = "0000000000000000" + "1111111111111111" + "1111111111111111" + "1111111111111111"
bi$(1) = "0111111101111111" + "1000000000000001" + "1000001001000001" + "1111111111111111"
bi$(2) = "0111111101111111" + "1000000000000001" + "1000010000100001" + "1111111111111111"
bi$(3) = "0111111101111111" + "1000000000000001" + "1000100000010001" + "1111111111111111"
bi$(4) = "0111111101111111" + "1000000000000001" + "1001000000001001" + "1111111101011101"
bi$(5) = "0111111101111111" + "1000000000000001" + "1010000000000101" + "1101010101010101"
bi$(6) = "0111111101111111" + "1000000000000001" + "1100000000000011" + "1101010101010101"
bi$(7) = "0111111101111111" + "1000000000000001" + "1000000000000001" + "1100010100010101"
bi$(8) = "0000000000000000" + "1000000000000001" + "1000000000000001" + "1000010000010101"
bi$(9) = "1111011111110111" + "1000000000000001" + "1100000000000011" + "1000010000010001"
bi$(10) = "1111011111110111" + "1000000000000001" + "1010000000000101" + "1000000000010001"
bi$(11) = "1111011111110111" + "1000000000000001" + "1001000000001001" + "1000000000000001"
bi$(12) = "1111011111110111" + "1000000000000001" + "1000100000010001" + "1000000000000001"
bi$(13) = "1111011111110111" + "1000000000000001" + "1000010000100001" + "1000000000000001"
bi$(14) = "1111011111110111" + "1000000000000001" + "1000001001000001" + "1000000000000001"
bi$(15) = "1111011111110111" + "1111111111111111" + "1111111111111111" + "1111111111111111"

FOR yb = 0 TO 15
FOR xb = 0 TO 63
znak$ = MID$(bi$(yb), xb + 1, 1)
znak = VAL(znak$)
COLOR 15 * znak: PSET (xb, yb)
NEXT xb
NEXT yb
GET (0, 0)-(15, 15), g1
GET (16, 0)-(31, 15), g2
GET (32, 0)-(47, 15), g3
GET (48, 0)-(63, 15), g4

CLS
REM dane elementow
bi$(0) = "1111111111111111" + "1111111111111111" + "0111111111111110" + "0111111100000000"
bi$(1) = "1000000000000001" + "0000000000000000" + "1000000000000001" + "0111111101111111"
bi$(2) = "1011111111111101" + "1111111111111111" + "1000000000001101" + "0111111101111111"
bi$(3) = "1010000000000101" + "0000000000000000" + "1000000000000101" + "01111111011f11111"
bi$(4) = "1010111111110101" + "1111111111111111" + "1000000000000001" + "0000000001111111"
bi$(5) = "1010100000010101" + "0000000000000000" + "1000000000000001" + "0111111101111111"
bi$(6) = "1010101111010101" + "1111111111111111" + "1000000000000001" + "0111111101111111"
bi$(7) = "1010101001010101" + "0000000000000000" + "1000000000000001" + "0111111101111111"
bi$(8) = "1010101001010101" + "1111111111111111" + "1000000000000001" + "0111111100000000"
bi$(9) = "1010101111010101" + "0000000000000000" + "1000000000000001" + "0111111101111111"
bi$(10) = "1010100000010101" + "1111111111111111" + "1000000000000001" + "0111111101111111"
bi$(11) = "1010111111110101" + "0000000000000000" + "1000000000000001" + "0111111101111111"
bi$(12) = "1010000000000101" + "1111111111111111" + "1010000000000001" + "0000000001111111"
bi$(13) = "1011111111111101" + "0000000000000000" + "1011000000000001" + "0111111101111111"
bi$(14) = "1000000000000001" + "1111111111111111" + "1000000000000001" + "0111111101111111"
bi$(15) = "1111111111111111" + "0000000000000000" + "0111111111111110" + "0111111101111111"

FOR yb = 0 TO 15
FOR xb = 0 TO 63
znak$ = MID$(bi$(yb), xb + 1, 1)
znak = VAL(znak$)
COLOR 15 * znak: PSET (xb, yb)
NEXT xb
NEXT yb

GET (0, 0)-(15, 15), g5
GET (16, 0)-(31, 15), g6
GET (32, 0)-(47, 15), g7
GET (48, 0)-(63, 15), g8


CLS
END SUB

SUB wstaw (xe, ye, parametr)

COLOR 15: REM color parametr

ye = ye - 1: xe = xe - 1
xe = xe * 32
ye = ye * 32

FOR yy = 0 TO 1
yf = ye + yy * 16

FOR xx = 0 TO 1
xf = xe + xx * 16
IF parametr = 0 THEN GOTO koncz

IF parametr / 8 = INT(parametr / 8) THEN PUT (xf, yf), g1, PSET: GOTO koncz
IF parametr / 7 = INT(parametr / 7) THEN PUT (xf, yf), g2, PSET: GOTO koncz
IF parametr / 6 = INT(parametr / 6) THEN PUT (xf, yf), g3, PSET: GOTO koncz
IF parametr / 5 = INT(parametr / 5) THEN PUT (xf, yf), g4, PSET: GOTO koncz
IF parametr / 4 = INT(parametr / 4) THEN PUT (xf, yf), g5, PSET: GOTO koncz
IF parametr / 3 = INT(parametr / 3) THEN PUT (xf, yf), g6, PSET: GOTO koncz
IF parametr / 2 = INT(parametr / 2) THEN PUT (xf, yf), g7, PSET: GOTO koncz
IF parametr / 1 = INT(parametr / 1) THEN PUT (xf, yf), g8, PSET: GOTO koncz

koncz:
IF parametr <> 0 THEN parametr = parametr + 1
NEXT xx
NEXT yy

END SUB
Powrót do góry
Wyświetl posty z ostatnich:   
Napisz nowy temat   Odpowiedz do tematu    Forum Życie Wieczne Strona Główna -> Offtopic Wszystkie czasy w strefie EET (Europa)
Idź do strony 1, 2  Następny
Strona 1 z 2

 
Skocz do:  
Możesz pisać nowe tematy
Możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach

fora.pl - załóż własne forum dyskusyjne za darmo
Powered by phpBB © 2001, 2005 phpBB Group
Regulamin