|
Życie Wieczne
|
Zobacz poprzedni temat :: Zobacz następny temat |
Autor |
Wiadomość |
Piotr-246
Gość
|
Wysł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ść
|
Wysł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ść
|
Wysł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ść
|
Wysł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ść
|
Wysł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ść
|
Wysł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ść
|
Wysł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ść
|
Wysł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ść
|
Wysł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ść
|
Wysł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ść
|
Wysł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ść
|
Wysł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ść
|
Wysł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ść
|
Wysł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ść
|
Wysł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 |
|
|
|
|
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
|