 Wysłany: Nie 17:35, 12 Wrz 2021 Temat postu: |
|
| REM Mikrogra, Piotr Lubas
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: REM CLS COLOR 8 REM FOR kr = 0 TO 19: PRINT "........................................": NEXT kr COLOR 15 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 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 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 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 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 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 > 40 THEN x = 1: xs = 1: xr = xr + 1: GOTO rysuj IF x < 1 THEN x = 40: xs = 40: 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 8 LOCATE ys, xs: PRINT "."; COLOR 15 LOCATE y, x: PRINT CHR$(2); xs = x: ys = y GOTO petla SUB cegly REM dane elementow 1,2 bi$(0) = "0000000000000000" + "0000000000000000" bi$(1) = "0111111101111111" + "0011111101111111" bi$(2) = "0111011101111011" + "0111111101111111" bi$(3) = "0111111101111111" + "0111101101101111" bi$(4) = "0111111101111111" + "0111111101111111" bi$(5) = "0111111100011111" + "0111111101111111" bi$(6) = "0110111101111101" + "0101111101111111" bi$(7) = "0111111101111111" + "0111111100111111" bi$(8) = "0000000000000000" + "0000000000000000" bi$(9) = "1111011111110111" + "1110011111110111" bi$(10) = "0111011101110111" + "1111011111110111" bi$(11) = "1111011111110101" + "1111011101110101" bi$(12) = "1111011111110111" + "1111011111110111" bi$(13) = "0111011011110111" + "1111011111110111" bi$(14) = "1111011111110111" + "1111011111110111" bi$(15) = "1111011111110101" + "1111011011110111" FOR yb = 0 TO 15 FOR xb = 0 TO 31 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 CLS REM dane elementow 3,4 bi$(0) = "0000000000000000" + "0000000000000000" bi$(1) = "0111111001111111" + "0110111101111111" bi$(2) = "0101111101011111" + "0110111101110111" bi$(3) = "0111111101111111" + "0111111101111111" bi$(4) = "0111111101111101" + "0111101101101111" bi$(5) = "0000111101111111" + "0111111101111111" bi$(6) = "0111111101101111" + "0101111101111011" bi$(7) = "0111111101111111" + "0111111101111111" bi$(8) = "0000000000000000" + "0000000000000000" bi$(9) = "1111011111110111" + "1111011111110111" bi$(10) = "1111010111110111" + "1111011111110111" bi$(11) = "1111011111110111" + "1011011011110111" bi$(12) = "1111011111110111" + "1111011111110111" bi$(13) = "1111011011110101" + "1111011111110111" bi$(14) = "0111011111110111" + "1111011111110101" bi$(15) = "1111011111100111" + "1111010111110111" FOR yb = 0 TO 15 FOR xb = 0 TO 31 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), g3 GET (16, 0)-(31, 15), g4 CLS REM dane elementow 5,6 bi$(0) = "0000000000000000" + "0000000000000000" bi$(1) = "0111111101110111" + "0111111101111111" bi$(2) = "0111111101111111" + "0111101101110111" bi$(3) = "0101111101111111" + "0101111101111111" bi$(4) = "0111101101101111" + "0111111101111101" bi$(5) = "0111111101111111" + "0111111101111111" bi$(6) = "0110111101111011" + "0111011101101111" bi$(7) = "0110111101111111" + "0111111101111111" bi$(8) = "0000000000000000" + "0000000000000000" bi$(9) = "1011011111110111" + "1111011110110111" bi$(10) = "1111010111110111" + "1111011111110111" bi$(11) = "1110011111110111" + "1111011111110111" bi$(12) = "1111011111110111" + "1111011011110101" bi$(13) = "1111011111010101" + "1101011111110111" bi$(14) = "1111011111110111" + "1111011111010111" bi$(15) = "1101011011110111" + "1111011111010111" FOR yb = 0 TO 15 FOR xb = 0 TO 31 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 CLS REM dane elementow 7,8 bi$(0) = "0000000000000000" + "0000000000000000" bi$(1) = "0111111101101111" + "0111111101111111" bi$(2) = "0111011101101111" + "0111011101101111" bi$(3) = "0111111101111111" + "0111111101111111" bi$(4) = "0111111101111111" + "0111111101111111" bi$(5) = "0101111101111111" + "0110111101111111" bi$(6) = "0111111101110111" + "0111111101111111" bi$(7) = "0111101101111111" + "0111111101110111" bi$(8) = "0000000000000000" + "0000000000000000" bi$(9) = "1111011111110111" + "1111011111110111" bi$(10) = "1111011111110111" + "1111011111110111" bi$(11) = "1011011110110110" + "1101010111110111" bi$(12) = "1111011111110111" + "1111011111110111" bi$(13) = "1111011111110111" + "1111011111110111" bi$(14) = "1101010111110111" + "1111011101110011" bi$(15) = "1111011111110111" + "1111011111110111" FOR yb = 0 TO 15 FOR xb = 0 TO 31 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), g7 GET (16, 0)-(31, 15), g8 CLS END SUB SUB wstaw (xe, ye, parametr) COLOR 15: REM color parametr xl = (xe - 1) * 8 + 1: yl = (ye - 1) * 4 + 1 ye = ye - 1: xe = xe - 1 xe = xe * 64 ye = ye * 32 COLOR 8 FOR yy = 0 TO 1 yf = ye + yy * 16 FOR xx = 0 TO 3 xf = xe + xx * 16 IF parametr = 0 THEN LOCATE yl + yy * 2, xl + xx * 2: PRINT "..": LOCATE yl + 1 + yy * 2, xl + xx * 2: PRINT "..": 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 + 2 NEXT xx NEXT yy END SUB |
|
| Wysłany: Nie 11:05, 12 Wrz 2021 Temat postu: |
|
| REM Mikrogra, Piotr Lubas
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 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 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 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 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 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 > 40 THEN x = 1: xs = 1: xr = xr + 1: GOTO rysuj IF x < 1 THEN x = 40: xs = 40: 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" + "0111111101111111" 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 * 64 ye = ye * 32 FOR yy = 0 TO 1 yf = ye + yy * 16 FOR xx = 0 TO 3 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 + 2 NEXT xx NEXT yy END SUB |
|
| 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 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 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 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 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 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 |
|
| 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 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 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 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 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 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 |
|
| 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 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 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 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 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 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 |
|
| 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 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 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 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 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 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 |
|
| 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 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 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 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 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 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 |
|
| 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 "."; 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$; 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 "."; 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 |
|
| 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 "."; 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$; 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 "."; 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 |
|
| 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 "."; 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$; 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 "."; 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 |
|
| 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 "."; 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 "#"; 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 "."; 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 |
|
| 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 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 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 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 |
|
| 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 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 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 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 |
|
| 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 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 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 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 |
|
| 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 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 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 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 |
|