 |
Życie Wieczne
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Piotr-246
Gość
|
 Wysłany: Śro 20:38, 23 Cze 2021 Temat postu: |
|
|
DECLARE SUB chrup ()
DECLARE SUB braniedia ()
DECLARE SUB beepkam ()
DECLARE SUB beepdia ()
DECLARE SUB plansza ()
DECLARE SUB elementy ()
REM gra musi chodzic w trybie Turbo
SCREEN 13
DEF SEG = 0
DIM SHARED diament(0 TO 16) AS LONG
DIM SHARED diament2(0 TO 16) AS LONG
DIM SHARED diament3(0 TO 16) AS LONG
DIM SHARED diament4(0 TO 16) AS LONG
DIM SHARED kamien(0 TO 16) AS LONG
DIM SHARED czyste(0 TO 16) AS LONG
DIM SHARED murek(0 TO 16) AS LONG
DIM SHARED wegiel(0 TO 16) AS LONG
DIM SHARED stal(0 TO 16) AS LONG
DIM SHARED motyl1(0 TO 16) AS LONG
DIM SHARED motyl2(0 TO 16) AS LONG
DIM SHARED motyl3(0 TO 16) AS LONG
DIM SHARED gracz1(0 TO 16) AS LONG
DIM SHARED pomoc$(0 TO 7)
DIM SHARED tablica$(0 TO 24)
DIM SHARED tabl(0 TO 39, 0 TO 24) AS INTEGER
DIM SHARED motx(0 TO 1) AS INTEGER
DIM SHARED moty(0 TO 1) AS INTEGER
REM ************************ zaladowanie elementow graficznych
elementy
REM ****************************** zaladowanie planszy
restart:
plansza
REM ************************ dane startowe
CLS
tabl(3, 3) = 2
x = 3: y = 3
xs = 3: ys = 3
motx(0) = 15: moty(0) = 17
motx(1) = 23: moty(1) = 23
faza = 0: fazamotyla = 0
REM *************************** petla glowna
petla:
key$ = ""
REM *************************** sprawdzenie tablicy
beepk = 0: beepd = 0
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC(".") THEN
pobrany2 = tabl(xb, yb - 1)
IF pobrany2 = ASC("O") THEN tabl(xb, yb) = ASC("O"): tabl(xb, yb - 1) = ASC("."): IF tabl(xb, yb + 1) <> ASC(".") THEN beepk = 1
IF pobrany2 = ASC("A") THEN tabl(xb, yb) = ASC("A"): tabl(xb, yb - 1) = ASC("."): IF tabl(xb, yb + 1) <> ASC(".") THEN beepd = 1
END IF
REM znaki wieksze od ascii 64 powoduja upadek w bok
IF pobrany > 64 THEN
pobrany2 = tabl(xb, yb - 1)
IF pobrany2 = ASC("O") THEN pobrany3 = tabl(xb - 1, yb): pobrany4 = tabl(xb - 1, yb - 1): IF pobrany3 = ASC(".") AND pobrany4 = ASC(".") THEN tabl(xb - 1, yb - 1) = ASC("O"): tabl(xb, yb - 1) = ASC("."): GOTO skok
IF pobrany2 = ASC("O") THEN pobrany3 = tabl(xb + 1, yb): pobrany4 = tabl(xb + 1, yb - 1): IF pobrany3 = ASC(".") AND pobrany4 = ASC(".") THEN tabl(xb + 1, yb - 1) = ASC("O"): tabl(xb, yb - 1) = ASC(".")
IF pobrany2 = ASC("A") THEN pobrany3 = tabl(xb - 1, yb): pobrany4 = tabl(xb - 1, yb - 1): IF pobrany3 = ASC(".") AND pobrany4 = ASC(".") THEN tabl(xb - 1, yb - 1) = ASC("A"): tabl(xb, yb - 1) = ASC("."): GOTO skok
IF pobrany2 = ASC("A") THEN pobrany3 = tabl(xb + 1, yb): pobrany4 = tabl(xb + 1, yb - 1): IF pobrany3 = ASC(".") AND pobrany4 = ASC(".") THEN tabl(xb + 1, yb - 1) = ASC("A"): tabl(xb, yb - 1) = ASC(".")
skok:
END IF
NEXT xb
NEXT yb
REM ****************** ruch motyli
FOR mot = 0 TO 1
mx = motx(mot)
my = moty(mot)
ruch = 0
nie1 = 0: nie2 = 0: nie3 = 0: nie4 = 0
nie5 = 0: nie6 = 0: nie7 = 0: nie8 = 0
IF tabl(mx + 1, my - 1) <> ASC(".") THEN nie1 = 1
IF tabl(mx + 1, my) <> ASC(".") THEN nie2 = 1
IF tabl(mx + 1, my + 1) <> ASC(".") THEN nie3 = 1
IF tabl(mx, my + 1) <> ASC(".") THEN nie4 = 1
IF tabl(mx - 1, my + 1) <> ASC(".") THEN nie5 = 1
IF tabl(mx - 1, my) <> ASC(".") THEN nie6 = 1
IF tabl(mx - 1, my - 1) <> ASC(".") THEN nie7 = 1
IF tabl(mx, my - 1) <> ASC(".") THEN nie8 = 1
REM ruch w prawo
IF ruch = 0 AND nie8 = 1 AND nie2 = 0 THEN ruch = 1: tabl(mx, my) = ASC("."): mx = mx + 1
IF ruch = 0 AND nie1 = 1 AND nie2 = 0 THEN ruch = 1: tabl(mx, my) = ASC("."): mx = mx + 1
REM ruch w dol
IF ruch = 0 AND nie2 = 1 AND nie4 = 0 THEN ruch = 1: tabl(mx, my) = ASC("."): my = my + 1
IF ruch = 0 AND nie3 = 1 AND nie4 = 0 THEN ruch = 1: tabl(mx, my) = ASC("."): my = my + 1
REM ruch w lewo
IF ruch = 0 AND nie4 = 1 AND nie6 = 0 THEN ruch = 1: tabl(mx, my) = ASC("."): mx = mx - 1
IF ruch = 0 AND nie5 = 1 AND nie6 = 0 THEN ruch = 1: tabl(mx, my) = ASC("."): mx = mx - 1
REM ruch w gore
IF ruch = 0 AND nie6 = 1 AND nie8 = 0 THEN ruch = 1: tabl(mx, my) = ASC("."): my = my - 1
IF ruch = 0 AND nie7 = 1 AND nie8 = 0 THEN ruch = 1: tabl(mx, my) = ASC("."): my = my - 1
REM motyl zapelony w prozni
IF ruch = 0 AND nie2 = 0 AND nie4 = 0 AND nie6 = 0 AND nie8 = 0 THEN
IF fazamotyla = 0 THEN ruch = 1: tabl(mx, my) = ASC("."): mx = mx + 1
IF fazamotyla = 1 THEN ruch = 1: tabl(mx, my) = ASC("."): my = my + 1
IF fazamotyla = 2 THEN ruch = 1: tabl(mx, my) = ASC("."): mx = mx - 1
IF fazamotyla = 3 THEN ruch = 1: tabl(mx, my) = ASC("."): my = my - 1
END IF
IF ruch = 0 THEN tabl(mx, my) = ASC("X")
IF ruch = 1 THEN tabl(mx, my) = ASC("X "): motx(mot) = mx: moty(mot) = my
NEXT mot
REM *************************** wyswietlenie tablicy
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC(".") THEN LOCATE yb + 1, xb + 1: PRINT " ";
IF pobrany = ASC("O") THEN
PUT (xb * 8, yb * 8), czyste, AND
PUT (xb * 8, yb * 8), kamien, OR
END IF
IF pobrany = ASC("+") THEN PUT (xb * 8, yb * 8), wegiel, OR
IF pobrany = ASC("%") THEN PUT (xb * 8, yb * 8), stal, OR
IF pobrany = ASC("M") THEN PUT (xb * 8, yb * 8), murek, OR
IF pobrany = ASC("X") THEN
PUT (xb * 8, yb * 8), czyste, AND
IF fazamotyla = 0 THEN PUT (xb * 8, yb * 8), motyl1, OR
IF fazamotyla = 1 THEN PUT (xb * 8, yb * 8), motyl2, OR
IF fazamotyla = 2 THEN PUT (xb * 8, yb * 8), motyl3, OR
IF fazamotyla = 3 THEN PUT (xb * 8, yb * 8), motyl2, OR
END IF
REM falowanie diamentu:
IF pobrany = ASC("A") THEN
PUT (xb * 8, yb * 8), czyste, AND
IF faza = 0 THEN PUT (xb * 8, yb * 8), diament, OR
IF faza = 1 THEN PUT (xb * 8, yb * 8), diament2, OR
IF faza = 2 THEN PUT (xb * 8, yb * 8), diament3, OR
IF faza = 3 THEN PUT (xb * 8, yb * 8), diament4, OR
END IF
IF pobrany = 2 THEN PUT (xb * 8, yb * 8), czyste, AND: PUT (xb * 8, yb * 8), gracz1, OR
NEXT xb
NEXT yb
IF beepk = 1 THEN beepkam: GOTO skok2
IF beepd = 1 THEN beepdia
skok2:
REM ************** zmiana fazy falowania motyli i diamentow:
faza = faza + 1
IF faza = 4 THEN faza = 0
fazamotyla = fazamotyla + 1
IF fazamotyla = 4 THEN fazamotyla = 0
REM ********************* obsluga klawiatury
IF key$ = "" THEN GOTO petla
k$ = key$
POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury
IF k$ = CHR$(27) THEN END
IF k$ = "r" OR k$ = "R" THEN GOTO restart
IF k$ = CHR$(0) + "M" THEN x = x + 1
IF k$ = CHR$(0) + "K" THEN x = x - 1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
REM ************ sprawdzenie czy wolno wykonac ruch
pobrany = tabl(x, y)
IF pobrany <> ASC(".") AND pobrany <> ASC("+") AND pobrany <> ASC("A") THEN x = xs: y = ys: GOTO petla
IF pobrany = ASC("+") THEN chrup
IF pobrany = ASC("A") THEN braniedia: REM SOUND 1600, 1: SOUND 900, 1
REM ************* kasowanie w tablicy starej pozycji gracza
tabl(xs, ys) = ASC(".")
REM ************* wstawienie do tablicy nowej pozycji gracza
tabl(x, y) = 2
REM zapamietanie starej pozycji gracza
xs = x: ys = y
GOTO petla
SUB beepdia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 2
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 64: OUT 66, 3
OUT 66, 250: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB beepkam
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 32: OUT 66, 1
OUT 66, 32: OUT 66, 0
OUT 66, 104: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 250: OUT 66, 1
OUT 66, 32: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB braniedia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 100 TO 1 STEP -1
OUT 66, i: OUT 66, 3
FOR j = 1 TO 150: NEXT j
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB chrup
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 0
OUT 66, 20: OUT 66, 0
OUT 66, 32: OUT 66, 0
NEXT i
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 54: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 60: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB elementy
REM zielony wegiel
PALETTE 32, 5 * 65536 + 12 * 256 + 0
PALETTE 33, 9 * 65536 + 14 * 256 + 2
REM odcienie kamienia +48
FOR i = 0 TO 15
PALETTE 48 + i, INT(i * 2.5) * 65536 + i * 3 * 256 + i * 4
NEXT i
REM odcienie diamentu +64
FOR i = 0 TO 15
PALETTE 64 + i, INT(i * 4) * 65536 + INT(i * 3.7) * 256 + INT(i * 3.2)
NEXT i
GET (0, 0)-(7, 7), czyste
pomoc$(0) = "...@@..."
pomoc$(1) = "..@$$@.."
pomoc$(2) = ".@****@."
pomoc$(3) = "@::::::@"
pomoc$(4) = "@######@"
pomoc$(5) = ".@$$$$@."
pomoc$(6) = "..@**@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament
pomoc$(0) = "...@@..."
pomoc$(1) = "..@**@.."
pomoc$(2) = ".@::::@."
pomoc$(3) = "@######@"
pomoc$(4) = "@$$$$$$@"
pomoc$(5) = ".@****@."
pomoc$(6) = "..@::@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament2
pomoc$(0) = "...@@..."
pomoc$(1) = "..@::@.."
pomoc$(2) = ".@####@."
pomoc$(3) = "@$$$$$$@"
pomoc$(4) = "@******@"
pomoc$(5) = ".@::::@."
pomoc$(6) = "..@##@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament3
pomoc$(0) = "...@@..."
pomoc$(1) = "..@##@.."
pomoc$(2) = ".@$$$$@."
pomoc$(3) = "@******@"
pomoc$(4) = "@::::::@"
pomoc$(5) = ".@####@."
pomoc$(6) = "..@$$@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament4
pomoc$(0) = "..*$**.."
pomoc$(1) = ".*$###*."
pomoc$(2) = "**$$###*"
pomoc$(3) = "$#*$$#$*"
pomoc$(4) = "*:*#$$#$"
pomoc$(5) = "*$*$:$#*"
pomoc$(6) = ".*:*$**."
pomoc$(7) = "..:*:*.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 3 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 6 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 9 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 48: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), kamien
pomoc$(0) = ".###.###"
pomoc$(1) = ".###.###"
pomoc$(2) = ".###.###"
pomoc$(3) = "........"
pomoc$(4) = "##.###.#"
pomoc$(5) = "##.###.#"
pomoc$(6) = "##.###.#"
pomoc$(7) = "........"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 13 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), murek
pomoc$(0) = "$*******"
pomoc$(1) = "****$***"
pomoc$(2) = "*****$*$"
pomoc$(3) = "*$******"
pomoc$(4) = "***$**$*"
pomoc$(5) = "$*******"
pomoc$(6) = "**$**$**"
pomoc$(7) = "****$***"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 33: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 32: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), wegiel
pomoc$(0) = "########"
pomoc$(1) = "#**##**#"
pomoc$(2) = "#*.##*.#"
pomoc$(3) = "########"
pomoc$(4) = "########"
pomoc$(5) = "#**##**#"
pomoc$(6) = "#*.##*.#"
pomoc$(7) = "########"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 1 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 11 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), stal
CLS
pomoc$(0) = "#......#.#....#...#..#.."
pomoc$(1) = "@@....@@.@@..@@....@@..."
pomoc$(2) = "@$$..$$@..$$$$.....$$..."
pomoc$(3) = "*&*&*&*&..*&*&.....&*..."
pomoc$(4) = "&*&*&*&*..&*&*.....*&..."
pomoc$(5) = "@$$..$$@..$$$$.....$$..."
pomoc$(6) = "@@....@@.@@..@@....@@..."
pomoc$(7) = "#......#.#....#...#..#.."
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "&" THEN COLOR 2 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 11 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 8 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), motyl1
GET (8, 0)-(15, 7), motyl2
GET (16, 0)-(23, 7), motyl3
CLS
pomoc$(0) = "..@@@..."
pomoc$(1) = "..@@@..."
pomoc$(2) = "...@...."
pomoc$(3) = ".*****.."
pomoc$(4) = "*.***.*."
pomoc$(5) = "..###..."
pomoc$(6) = "..#.#..."
pomoc$(7) = ".##.##.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 15: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), gracz1
CLS
END SUB
SUB plansza
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%.......AAAAOAAAAAA%AAOO+OA++A+AO+++O++%"
tablica$(2) = "%.......++++O+++MMM%O++OOO+A+A+AO+A+A++%"
tablica$(3) = "%.......AAAAOAAAAAA%AAOOOOAOAAOOAAO+O++%"
tablica$(4) = "%.......MMMMO++++++%+O+OOOAAOAAAOAO+AOA%"
tablica$(5) = "%AAAAAAAAAAAOAAAAAA%AAOO+O+OAOOAAO++O++%"
tablica$(6) = "%%%%%%%%%%%%%%+++++%+O+OOOA+OAAAO+AOA++%"
tablica$(7) = "%AAAAAAAAAAAAOAAAAA%AAAO+OOOOAOAAAO+OA+%"
tablica$(8) = "%A++++++++++O++++MM%M+AAAOAAOAAOAOO+A+A%"
tablica$(9) = "%AAAA+++++++O++++++%OOOOOOOOOOOOOAOOAAA%"
tablica$(10) = "%++++++++++..++++++%AAAAAAOOOOOOOAAAAAA%"
tablica$(11) = "%AAAAAAAA..........%%%%%%%%%%+%%%%%%%%%%"
tablica$(12) = "%++++%%%%%%%%%%%%%%%...................%"
tablica$(13) = "%+AAAAAAAA.........%...................%"
tablica$(14) = "%++++++++++........%...................%"
tablica$(15) = "%+AAAA+++AAA.......%MMMMMM.......MMMMMM%"
tablica$(16) = "%++++++++++........%...................%"
tablica$(17) = "%+AAAAAAAAAAOAA....%...................%"
tablica$(18) = "%+++++++++++++++...%...................%"
tablica$(19) = "%+AAAAAA++AAOAAAA......................%"
tablica$(20) = "%+++++++++++++++.......................%"
tablica$(21) = "%+AAAAAAAAAAOAAAAA.....................%"
tablica$(22) = "%++++++++++++++++......................%"
tablica$(23) = "%++++++++++++++++.......%%%............%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
FOR yd = 0 TO 24
FOR xd = 0 TO 39
tabl(xd, yd) = ASC(MID$(tablica$(yd), xd + 1, 1))
NEXT xd
NEXT yd
END SUB
|
|
| Powrót do góry |
|
 |
|
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Piotr-246
Gość
|
| Wysłany: Śro 22:14, 23 Cze 2021 Temat postu: |
|
|
DECLARE SUB chrup ()
DECLARE SUB braniedia ()
DECLARE SUB beepkam ()
DECLARE SUB beepdia ()
DECLARE SUB plansza ()
DECLARE SUB elementy ()
REM gra musi chodzic w trybie Turbo
SCREEN 13
DEF SEG = 0
DIM SHARED diament(0 TO 16) AS LONG
DIM SHARED diament2(0 TO 16) AS LONG
DIM SHARED diament3(0 TO 16) AS LONG
DIM SHARED diament4(0 TO 16) AS LONG
DIM SHARED kamien(0 TO 16) AS LONG
DIM SHARED czyste(0 TO 16) AS LONG
DIM SHARED murek(0 TO 16) AS LONG
DIM SHARED wegiel(0 TO 16) AS LONG
DIM SHARED stal(0 TO 16) AS LONG
DIM SHARED motyl1(0 TO 16) AS LONG
DIM SHARED motyl2(0 TO 16) AS LONG
DIM SHARED motyl3(0 TO 16) AS LONG
DIM SHARED gracz1(0 TO 16) AS LONG
DIM SHARED pomoc$(0 TO 7)
DIM SHARED tablica$(0 TO 24)
DIM SHARED tabl(0 TO 39, 0 TO 24) AS INTEGER
DIM SHARED motx(0 TO 1) AS INTEGER
DIM SHARED moty(0 TO 1) AS INTEGER
DIM SHARED motw(0 TO 1) AS INTEGER
REM ************************ zaladowanie elementow graficznych
elementy
REM ****************************** zaladowanie planszy
restart:
plansza
REM ************************ dane startowe
CLS
tabl(3, 3) = 2
x = 3: y = 3
xs = 3: ys = 3
motx(0) = 15: moty(0) = 16: motw(0) = 2
motx(1) = 2: moty(1) = 22: motw(1) = 2
faza = 0: fazamotyla = 0
REM *************************** petla glowna
petla:
key$ = ""
REM *************************** sprawdzenie tablicy
beepk = 0: beepd = 0
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC(".") THEN
pobrany2 = tabl(xb, yb - 1)
IF pobrany2 = ASC("O") THEN tabl(xb, yb) = ASC("O"): tabl(xb, yb - 1) = ASC("."): IF tabl(xb, yb + 1) <> ASC(".") THEN beepk = 1
IF pobrany2 = ASC("A") THEN tabl(xb, yb) = ASC("A"): tabl(xb, yb - 1) = ASC("."): IF tabl(xb, yb + 1) <> ASC(".") THEN beepd = 1
END IF
REM znaki wieksze od ascii 64 powoduja upadek w bok
IF pobrany > 64 THEN
pobrany2 = tabl(xb, yb - 1)
IF pobrany2 = ASC("O") THEN pobrany3 = tabl(xb - 1, yb): pobrany4 = tabl(xb - 1, yb - 1): IF pobrany3 = ASC(".") AND pobrany4 = ASC(".") THEN tabl(xb - 1, yb - 1) = ASC("O"): tabl(xb, yb - 1) = ASC("."): GOTO skok
IF pobrany2 = ASC("O") THEN pobrany3 = tabl(xb + 1, yb): pobrany4 = tabl(xb + 1, yb - 1): IF pobrany3 = ASC(".") AND pobrany4 = ASC(".") THEN tabl(xb + 1, yb - 1) = ASC("O"): tabl(xb, yb - 1) = ASC(".")
IF pobrany2 = ASC("A") THEN pobrany3 = tabl(xb - 1, yb): pobrany4 = tabl(xb - 1, yb - 1): IF pobrany3 = ASC(".") AND pobrany4 = ASC(".") THEN tabl(xb - 1, yb - 1) = ASC("A"): tabl(xb, yb - 1) = ASC("."): GOTO skok
IF pobrany2 = ASC("A") THEN pobrany3 = tabl(xb + 1, yb): pobrany4 = tabl(xb + 1, yb - 1): IF pobrany3 = ASC(".") AND pobrany4 = ASC(".") THEN tabl(xb + 1, yb - 1) = ASC("A"): tabl(xb, yb - 1) = ASC(".")
skok:
END IF
NEXT xb
NEXT yb
REM ****************** ruch motyli
FOR mot = 0 TO 1
mx = motx(mot)
my = moty(mot)
wektor = motw(mot)
ruch = 0
nie1 = 0: nie2 = 0: nie3 = 0: nie4 = 0
nie5 = 0: nie6 = 0: nie7 = 0: nie8 = 0
IF tabl(mx + 1, my - 1) <> ASC(".") THEN nie1 = 1
IF tabl(mx + 1, my) <> ASC(".") THEN nie2 = 1
IF tabl(mx + 1, my + 1) <> ASC(".") THEN nie3 = 1
IF tabl(mx, my + 1) <> ASC(".") THEN nie4 = 1
IF tabl(mx - 1, my + 1) <> ASC(".") THEN nie5 = 1
IF tabl(mx - 1, my) <> ASC(".") THEN nie6 = 1
IF tabl(mx - 1, my - 1) <> ASC(".") THEN nie7 = 1
IF tabl(mx, my - 1) <> ASC(".") THEN nie8 = 1
REM aby kontynuowal kierunek ruchu
powtorz = 0
IF wektor = 6 THEN GOTO wek6
IF wektor = 4 THEN GOTO wek4
IF wektor = 8 THEN GOTO wek8
jeszcze:
REM ruch w prawo
IF ruch = 0 AND nie8 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
IF ruch = 0 AND nie7 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
wek4:
REM ruch w dol
IF ruch = 0 AND nie2 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
IF ruch = 0 AND nie1 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
wek6:
REM ruch w lewo
IF ruch = 0 AND nie4 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
IF ruch = 0 AND nie3 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
wek8:
REM ruch w gore
IF ruch = 0 AND nie6 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
IF ruch = 0 AND nie5 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
REM sprawdz jeszcze raz
IF ruch = 0 AND powtorz = 0 AND (nie2 <> 0 OR nie4 <> 0 OR nie6 <> 0 OR nie8 <> 0) THEN powtorz = 1: GOTO jeszcze
REM motyl zapelony w prozni
IF ruch = 0 AND nie2 = 0 AND nie4 = 0 AND nie6 = 0 AND nie8 = 0 THEN
IF fazamotyla = 0 THEN ruch = 1: wektor = 2
IF fazamotyla = 1 THEN ruch = 1: wektor = 4
IF fazamotyla = 2 THEN ruch = 1: wektor = 6
IF fazamotyla = 3 THEN ruch = 1: wektor = 8
END IF
REM wykonanie ruchu w tablicy
IF ruch = 1 AND wektor = 2 THEN tabl(mx, my) = ASC("."): mx = mx + 1
IF ruch = 1 AND wektor = 4 THEN tabl(mx, my) = ASC("."): my = my + 1
IF ruch = 1 AND wektor = 6 THEN tabl(mx, my) = ASC("."): mx = mx - 1
IF ruch = 1 AND wektor = 8 THEN tabl(mx, my) = ASC("."): my = my - 1
IF ruch = 0 THEN tabl(mx, my) = ASC("X")
IF ruch = 1 THEN tabl(mx, my) = ASC("X "): motx(mot) = mx: moty(mot) = my
motw(mot) = wektor
NEXT mot
REM *************************** wyswietlenie tablicy
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC(".") THEN LOCATE yb + 1, xb + 1: PRINT " ";
IF pobrany = ASC("O") THEN
PUT (xb * 8, yb * 8), czyste, AND
PUT (xb * 8, yb * 8), kamien, OR
END IF
IF pobrany = ASC("+") THEN PUT (xb * 8, yb * 8), wegiel, OR
IF pobrany = ASC("%") THEN PUT (xb * 8, yb * 8), stal, OR
IF pobrany = ASC("M") THEN PUT (xb * 8, yb * 8), murek, OR
IF pobrany = ASC("X") THEN
PUT (xb * 8, yb * 8), czyste, AND
IF fazamotyla = 0 THEN PUT (xb * 8, yb * 8), motyl1, OR
IF fazamotyla = 1 THEN PUT (xb * 8, yb * 8), motyl2, OR
IF fazamotyla = 2 THEN PUT (xb * 8, yb * 8), motyl3, OR
IF fazamotyla = 3 THEN PUT (xb * 8, yb * 8), motyl2, OR
END IF
REM falowanie diamentu:
IF pobrany = ASC("A") THEN
PUT (xb * 8, yb * 8), czyste, AND
IF faza = 0 THEN PUT (xb * 8, yb * 8), diament, OR
IF faza = 1 THEN PUT (xb * 8, yb * 8), diament2, OR
IF faza = 2 THEN PUT (xb * 8, yb * 8), diament3, OR
IF faza = 3 THEN PUT (xb * 8, yb * 8), diament4, OR
END IF
IF pobrany = 2 THEN PUT (xb * 8, yb * 8), czyste, AND: PUT (xb * 8, yb * 8), gracz1, OR
NEXT xb
NEXT yb
IF beepk = 1 THEN beepkam: GOTO skok2
IF beepd = 1 THEN beepdia
skok2:
REM ************** zmiana fazy falowania motyli i diamentow:
faza = faza + 1
IF faza = 4 THEN faza = 0
fazamotyla = fazamotyla + 1
IF fazamotyla = 4 THEN fazamotyla = 0
REM ********************* obsluga klawiatury
IF key$ = "" THEN GOTO petla
k$ = key$
POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury
IF k$ = CHR$(27) THEN END
IF k$ = "r" OR k$ = "R" THEN GOTO restart
IF k$ = CHR$(0) + "M" THEN x = x + 1
IF k$ = CHR$(0) + "K" THEN x = x - 1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
REM ************ sprawdzenie czy wolno wykonac ruch
pobrany = tabl(x, y)
IF pobrany <> ASC(".") AND pobrany <> ASC("+") AND pobrany <> ASC("A") THEN x = xs: y = ys: GOTO petla
IF pobrany = ASC("+") THEN chrup
IF pobrany = ASC("A") THEN braniedia: REM SOUND 1600, 1: SOUND 900, 1
REM ************* kasowanie w tablicy starej pozycji gracza
tabl(xs, ys) = ASC(".")
REM ************* wstawienie do tablicy nowej pozycji gracza
tabl(x, y) = 2
REM zapamietanie starej pozycji gracza
xs = x: ys = y
GOTO petla
SUB beepdia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 2
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 64: OUT 66, 3
OUT 66, 250: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB beepkam
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 32: OUT 66, 1
OUT 66, 32: OUT 66, 0
OUT 66, 104: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 250: OUT 66, 1
OUT 66, 32: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB braniedia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 100 TO 1 STEP -1
OUT 66, i: OUT 66, 3
FOR j = 1 TO 150: NEXT j
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB chrup
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 0
OUT 66, 20: OUT 66, 0
OUT 66, 32: OUT 66, 0
NEXT i
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 54: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 60: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB elementy
REM zielony wegiel
PALETTE 32, 5 * 65536 + 12 * 256 + 0
PALETTE 33, 9 * 65536 + 14 * 256 + 2
REM odcienie kamienia +48
FOR i = 0 TO 15
PALETTE 48 + i, INT(i * 2.5) * 65536 + i * 3 * 256 + i * 4
NEXT i
REM odcienie diamentu +64
FOR i = 0 TO 15
PALETTE 64 + i, INT(i * 4) * 65536 + INT(i * 3.7) * 256 + INT(i * 3.2)
NEXT i
GET (0, 0)-(7, 7), czyste
pomoc$(0) = "...@@..."
pomoc$(1) = "..@$$@.."
pomoc$(2) = ".@****@."
pomoc$(3) = "@::::::@"
pomoc$(4) = "@######@"
pomoc$(5) = ".@$$$$@."
pomoc$(6) = "..@**@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament
pomoc$(0) = "...@@..."
pomoc$(1) = "..@**@.."
pomoc$(2) = ".@::::@."
pomoc$(3) = "@######@"
pomoc$(4) = "@$$$$$$@"
pomoc$(5) = ".@****@."
pomoc$(6) = "..@::@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament2
pomoc$(0) = "...@@..."
pomoc$(1) = "..@::@.."
pomoc$(2) = ".@####@."
pomoc$(3) = "@$$$$$$@"
pomoc$(4) = "@******@"
pomoc$(5) = ".@::::@."
pomoc$(6) = "..@##@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament3
pomoc$(0) = "...@@..."
pomoc$(1) = "..@##@.."
pomoc$(2) = ".@$$$$@."
pomoc$(3) = "@******@"
pomoc$(4) = "@::::::@"
pomoc$(5) = ".@####@."
pomoc$(6) = "..@$$@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament4
pomoc$(0) = "..*$**.."
pomoc$(1) = ".*$###*."
pomoc$(2) = "**$$###*"
pomoc$(3) = "$#*$$#$*"
pomoc$(4) = "*:*#$$#$"
pomoc$(5) = "*$*$:$#*"
pomoc$(6) = ".*:*$**."
pomoc$(7) = "..:*:*.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 3 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 6 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 9 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 48: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), kamien
pomoc$(0) = ".###.###"
pomoc$(1) = ".###.###"
pomoc$(2) = ".###.###"
pomoc$(3) = "........"
pomoc$(4) = "##.###.#"
pomoc$(5) = "##.###.#"
pomoc$(6) = "##.###.#"
pomoc$(7) = "........"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 13 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), murek
pomoc$(0) = "$*******"
pomoc$(1) = "****$***"
pomoc$(2) = "*****$*$"
pomoc$(3) = "*$******"
pomoc$(4) = "***$**$*"
pomoc$(5) = "$*******"
pomoc$(6) = "**$**$**"
pomoc$(7) = "****$***"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 33: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 32: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), wegiel
pomoc$(0) = "########"
pomoc$(1) = "#**##**#"
pomoc$(2) = "#*.##*.#"
pomoc$(3) = "########"
pomoc$(4) = "########"
pomoc$(5) = "#**##**#"
pomoc$(6) = "#*.##*.#"
pomoc$(7) = "########"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 1 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 11 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), stal
CLS
pomoc$(0) = "#......#.#....#...#..#.."
pomoc$(1) = "@@....@@.@@..@@....@@..."
pomoc$(2) = "@$$..$$@..$$$$.....$$..."
pomoc$(3) = "*&*&*&*&..*&*&.....&*..."
pomoc$(4) = "&*&*&*&*..&*&*.....*&..."
pomoc$(5) = "@$$..$$@..$$$$.....$$..."
pomoc$(6) = "@@....@@.@@..@@....@@..."
pomoc$(7) = "#......#.#....#...#..#.."
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "&" THEN COLOR 2 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 11 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 8 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), motyl1
GET (8, 0)-(15, 7), motyl2
GET (16, 0)-(23, 7), motyl3
CLS
pomoc$(0) = "..@@@..."
pomoc$(1) = "..@@@..."
pomoc$(2) = "...@...."
pomoc$(3) = ".*****.."
pomoc$(4) = "*.***.*."
pomoc$(5) = "..###..."
pomoc$(6) = "..#.#..."
pomoc$(7) = ".##.##.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 15: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), gracz1
CLS
END SUB
SUB plansza
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%.......AAAAOAAAAAA%AAOO+OA++A+AO+++O++%"
tablica$(2) = "%.......++++O+++MMM%O++OOO+A+A+AO+A+A++%"
tablica$(3) = "%.......AAAAOAAAAAA%AAOOOOAOAAOOAAO+O++%"
tablica$(4) = "%.......MMMMO++++++%+O+OOOAAOAAAOAO+AOA%"
tablica$(5) = "%AAAAAAAAAAAOAAAAAA%AAOO+O+OAOOAAO++O++%"
tablica$(6) = "%%%%%%%%%%%%%%+++++%+O+OOOA+OAAAO+AOA++%"
tablica$(7) = "%AAAAAAAAAAAAOAAAAA%AAAO+OOOOAOAAAO+OA+%"
tablica$(8) = "%A++++++++++O++++MM%M+AAAOAAOAAOAOO+A+A%"
tablica$(9) = "%AAAA+++++++O++++++%OOOOOOOOOOOOOAOOAAA%"
tablica$(10) = "%++++++++++..++++++%AAAAAAOOOOOOOAAAAAA%"
tablica$(11) = "%AAAAAAAA..........%%%%%%%%%%+%%%%%%%%%%"
tablica$(12) = "%++++%%%%%%%%%%%%%%%...................%"
tablica$(13) = "%+AAAAAAAA.........%...................%"
tablica$(14) = "%++++++++++........%...................%"
tablica$(15) = "%++++A+++AAA.......%MMMMMM.......MMMMMM%"
tablica$(16) = "%++++++++++........%...................%"
tablica$(17) = "%+.++AAAAAAAOAA....%...................%"
tablica$(18) = "%+.+++++++++++++...%...................%"
tablica$(19) = "%+.......+++.+++.......................%"
tablica$(20) = "%+.+++++++++.+++.......................%"
tablica$(21) = "%+.+++++++++.++++......................%"
tablica$(22) = "%+.............++......................%"
tablica$(23) = "%++++++++++++++++.......%%%............%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
FOR yd = 0 TO 24
FOR xd = 0 TO 39
tabl(xd, yd) = ASC(MID$(tablica$(yd), xd + 1, 1))
NEXT xd
NEXT yd
END SUB
|
|
| Powrót do góry |
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Piotr-246
Gość
|
| Wysłany: Pią 8:47, 25 Cze 2021 Temat postu: |
|
|
DECLARE SUB chrup ()
DECLARE SUB braniedia ()
DECLARE SUB beepkam ()
DECLARE SUB beepdia ()
DECLARE SUB plansza ()
DECLARE SUB elementy ()
REM gra musi chodzic w trybie Turbo
SCREEN 13
DEF SEG = 0
DIM SHARED diament(0 TO 16) AS LONG
DIM SHARED diament2(0 TO 16) AS LONG
DIM SHARED diament3(0 TO 16) AS LONG
DIM SHARED diament4(0 TO 16) AS LONG
DIM SHARED kamien(0 TO 16) AS LONG
DIM SHARED czyste(0 TO 16) AS LONG
DIM SHARED murek(0 TO 16) AS LONG
DIM SHARED wegiel(0 TO 16) AS LONG
DIM SHARED stal(0 TO 16) AS LONG
DIM SHARED motyl1(0 TO 16) AS LONG
DIM SHARED motyl2(0 TO 16) AS LONG
DIM SHARED motyl3(0 TO 16) AS LONG
DIM SHARED gracz1(0 TO 16) AS LONG
DIM SHARED pomoc$(0 TO 7)
DIM SHARED tablica$(0 TO 24)
DIM SHARED tabl(0 TO 39, 0 TO 24) AS INTEGER
DIM SHARED motx(0 TO 1) AS INTEGER
DIM SHARED moty(0 TO 1) AS INTEGER
DIM SHARED motw(0 TO 1) AS INTEGER
REM ************************ zaladowanie elementow graficznych
elementy
REM ****************************** zaladowanie planszy
restart:
plansza
REM ************************ dane startowe
CLS
x = 25: y = 18
tabl(x, y) = 2
xs = x: ys = y
motx(0) = 15: moty(0) = 16: motw(0) = 2
motx(1) = 2: moty(1) = 22: motw(1) = 2
faza = 0: fazamotyla = 0
REM *************************** petla glowna
petla:
key$ = ""
REM *************************** sprawdzenie tablicy
beepk = 0: beepd = 0
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("@") THEN tabl(xb, yb) = ASC("."): REM tymczasowa przerwa
IF pobrany = ASC("O") THEN IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("O"): tabl(xb, yb) = ASC("@"): beepk = 1
IF pobrany = ASC("A") THEN IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("A"): tabl(xb, yb) = ASC("@"): beepd = 1
REM znaki wieksze od ascii 64 powoduja upadek w bok
IF pobrany > 64 THEN
pobrany2 = tabl(xb, yb - 1)
IF pobrany2 = ASC("O") THEN pobrany3 = tabl(xb - 1, yb): pobrany4 = tabl(xb - 1, yb - 1): IF pobrany3 = ASC(".") AND pobrany4 = ASC(".") THEN tabl(xb - 1, yb - 1) = ASC("O"): tabl(xb, yb - 1) = ASC("."): GOTO skok
IF pobrany2 = ASC("O") THEN pobrany3 = tabl(xb + 1, yb): pobrany4 = tabl(xb + 1, yb - 1): IF pobrany3 = ASC(".") AND pobrany4 = ASC(".") THEN tabl(xb + 1, yb - 1) = ASC("O"): tabl(xb, yb - 1) = ASC(".")
IF pobrany2 = ASC("A") THEN pobrany3 = tabl(xb - 1, yb): pobrany4 = tabl(xb - 1, yb - 1): IF pobrany3 = ASC(".") AND pobrany4 = ASC(".") THEN tabl(xb - 1, yb - 1) = ASC("A"): tabl(xb, yb - 1) = ASC("."): GOTO skok
IF pobrany2 = ASC("A") THEN pobrany3 = tabl(xb + 1, yb): pobrany4 = tabl(xb + 1, yb - 1): IF pobrany3 = ASC(".") AND pobrany4 = ASC(".") THEN tabl(xb + 1, yb - 1) = ASC("A"): tabl(xb, yb - 1) = ASC(".")
skok:
END IF
NEXT xb
NEXT yb
REM ****************** ruch motyli ***********************
FOR mot = 0 TO 1
mx = motx(mot)
my = moty(mot)
wektor = motw(mot)
ruch = 0
nie1 = 0: nie2 = 0: nie3 = 0: nie4 = 0
nie5 = 0: nie6 = 0: nie7 = 0: nie8 = 0
IF tabl(mx + 1, my - 1) <> ASC(".") THEN nie1 = 1
IF tabl(mx + 1, my) <> ASC(".") THEN nie2 = 1
IF tabl(mx + 1, my + 1) <> ASC(".") THEN nie3 = 1
IF tabl(mx, my + 1) <> ASC(".") THEN nie4 = 1
IF tabl(mx - 1, my + 1) <> ASC(".") THEN nie5 = 1
IF tabl(mx - 1, my) <> ASC(".") THEN nie6 = 1
IF tabl(mx - 1, my - 1) <> ASC(".") THEN nie7 = 1
IF tabl(mx, my - 1) <> ASC(".") THEN nie8 = 1
REM aby kontynuowal kierunek ruchu
powtorz = 0
IF wektor = 6 THEN GOTO wek6
IF wektor = 4 THEN GOTO wek4
IF wektor = 8 THEN GOTO wek8
jeszcze:
REM ruch w prawo
IF ruch = 0 AND nie8 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
IF ruch = 0 AND nie7 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
wek4:
REM ruch w dol
IF ruch = 0 AND nie2 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
IF ruch = 0 AND nie1 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
wek6:
REM ruch w lewo
IF ruch = 0 AND nie4 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
IF ruch = 0 AND nie3 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
wek8:
REM ruch w gore
IF ruch = 0 AND nie6 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
IF ruch = 0 AND nie5 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
REM sprawdz jeszcze raz
IF ruch = 0 AND powtorz = 0 AND (nie2 <> 0 OR nie4 <> 0 OR nie6 <> 0 OR nie8 <> 0) THEN powtorz = 1: GOTO jeszcze
REM motyl zapetlony w prozni
IF ruch = 0 AND nie2 = 0 AND nie4 = 0 AND nie6 = 0 AND nie8 = 0 THEN
IF fazamotyla = 0 THEN ruch = 1: wektor = 2
IF fazamotyla = 1 THEN ruch = 1: wektor = 4
IF fazamotyla = 2 THEN ruch = 1: wektor = 6
IF fazamotyla = 3 THEN ruch = 1: wektor = 8
END IF
REM wykonanie ruchu w tablicy
IF ruch = 1 AND wektor = 2 THEN tabl(mx, my) = ASC("."): mx = mx + 1
IF ruch = 1 AND wektor = 4 THEN tabl(mx, my) = ASC("."): my = my + 1
IF ruch = 1 AND wektor = 6 THEN tabl(mx, my) = ASC("."): mx = mx - 1
IF ruch = 1 AND wektor = 8 THEN tabl(mx, my) = ASC("."): my = my - 1
IF ruch = 0 THEN tabl(mx, my) = ASC("X")
IF ruch = 1 THEN tabl(mx, my) = ASC("X "): motx(mot) = mx: moty(mot) = my
motw(mot) = wektor
NEXT mot
REM *************************** wyswietlenie tablicy
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
PUT (xb * 8, yb * 8), czyste, AND
IF pobrany = ASC(".") THEN LOCATE yb + 1, xb + 1: PRINT " ";
IF pobrany = ASC("O") THEN PUT (xb * 8, yb * 8), kamien, OR
IF pobrany = ASC("+") THEN PUT (xb * 8, yb * 8), wegiel, OR
IF pobrany = ASC("%") THEN PUT (xb * 8, yb * 8), stal, OR
IF pobrany = ASC("M") THEN PUT (xb * 8, yb * 8), murek, OR
IF pobrany = ASC("X") THEN
IF fazamotyla = 0 THEN PUT (xb * 8, yb * 8), motyl1, OR
IF fazamotyla = 1 THEN PUT (xb * 8, yb * 8), motyl2, OR
IF fazamotyla = 2 THEN PUT (xb * 8, yb * 8), motyl3, OR
IF fazamotyla = 3 THEN PUT (xb * 8, yb * 8), motyl2, OR
END IF
REM falowanie diamentu:
IF pobrany = ASC("A") THEN
IF faza = 0 THEN PUT (xb * 8, yb * 8), diament, OR
IF faza = 1 THEN PUT (xb * 8, yb * 8), diament2, OR
IF faza = 2 THEN PUT (xb * 8, yb * 8), diament3, OR
IF faza = 3 THEN PUT (xb * 8, yb * 8), diament4, OR
END IF
IF pobrany = 2 THEN PUT (xb * 8, yb * 8), gracz1, OR
NEXT xb
NEXT yb
IF beepk = 1 THEN beepkam: GOTO skok2
IF beepd = 1 THEN beepdia
skok2:
REM ************** zmiana fazy falowania motyli i diamentow:
faza = faza + 1
IF faza = 4 THEN faza = 0
fazamotyla = fazamotyla + 1
IF fazamotyla = 4 THEN fazamotyla = 0
REM ********************* obsluga klawiatury
IF key$ = "" THEN GOTO petla
k$ = key$
POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury
IF k$ = CHR$(27) THEN END
IF k$ = "r" OR k$ = "R" THEN GOTO restart
IF k$ = CHR$(0) + "M" THEN x = x + 1
IF k$ = CHR$(0) + "K" THEN x = x - 1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
REM ************ sprawdzenie czy wolno wykonac ruch
pobrany = tabl(x, y)
IF pobrany <> ASC(".") AND pobrany <> ASC("+") AND pobrany <> ASC("A") THEN x = xs: y = ys: GOTO petla
IF pobrany = ASC("+") THEN chrup
IF pobrany = ASC("A") THEN braniedia: REM SOUND 1600, 1: SOUND 900, 1
REM ************* kasowanie w tablicy starej pozycji gracza
tabl(xs, ys) = ASC(".")
REM ************* wstawienie do tablicy nowej pozycji gracza
tabl(x, y) = 2
REM zapamietanie starej pozycji gracza
xs = x: ys = y
GOTO petla
SUB beepdia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 2
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 64: OUT 66, 3
OUT 66, 250: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB beepkam
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 32: OUT 66, 1
OUT 66, 32: OUT 66, 0
OUT 66, 104: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 250: OUT 66, 1
OUT 66, 32: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB braniedia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 100 TO 1 STEP -1
OUT 66, i: OUT 66, 3
FOR j = 1 TO 150: NEXT j
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB chrup
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 0
OUT 66, 20: OUT 66, 0
OUT 66, 32: OUT 66, 0
NEXT i
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 54: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 60: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB elementy
REM zielony wegiel
PALETTE 32, 5 * 65536 + 12 * 256 + 0
PALETTE 33, 9 * 65536 + 14 * 256 + 2
REM odcienie kamienia +48
FOR i = 0 TO 15
PALETTE 48 + i, INT(i * 2.5) * 65536 + i * 3 * 256 + i * 4
NEXT i
REM odcienie diamentu +64
FOR i = 0 TO 15
PALETTE 64 + i, INT(i * 4) * 65536 + INT(i * 3.7) * 256 + INT(i * 3.2)
NEXT i
GET (0, 0)-(7, 7), czyste
pomoc$(0) = "...@@..."
pomoc$(1) = "..@$$@.."
pomoc$(2) = ".@****@."
pomoc$(3) = "@::::::@"
pomoc$(4) = "@######@"
pomoc$(5) = ".@$$$$@."
pomoc$(6) = "..@**@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament
pomoc$(0) = "...@@..."
pomoc$(1) = "..@**@.."
pomoc$(2) = ".@::::@."
pomoc$(3) = "@######@"
pomoc$(4) = "@$$$$$$@"
pomoc$(5) = ".@****@."
pomoc$(6) = "..@::@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament2
pomoc$(0) = "...@@..."
pomoc$(1) = "..@::@.."
pomoc$(2) = ".@####@."
pomoc$(3) = "@$$$$$$@"
pomoc$(4) = "@******@"
pomoc$(5) = ".@::::@."
pomoc$(6) = "..@##@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament3
pomoc$(0) = "...@@..."
pomoc$(1) = "..@##@.."
pomoc$(2) = ".@$$$$@."
pomoc$(3) = "@******@"
pomoc$(4) = "@::::::@"
pomoc$(5) = ".@####@."
pomoc$(6) = "..@$$@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament4
pomoc$(0) = "..*$**.."
pomoc$(1) = ".*$###*."
pomoc$(2) = "**$$###*"
pomoc$(3) = "$#*$$#$*"
pomoc$(4) = "*:*#$$#$"
pomoc$(5) = "*$*$:$#*"
pomoc$(6) = ".*:*$**."
pomoc$(7) = "..:*:*.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 3 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 6 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 9 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 48: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), kamien
pomoc$(0) = ".###.###"
pomoc$(1) = ".###.###"
pomoc$(2) = ".###.###"
pomoc$(3) = "........"
pomoc$(4) = "##.###.#"
pomoc$(5) = "##.###.#"
pomoc$(6) = "##.###.#"
pomoc$(7) = "........"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 13 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), murek
pomoc$(0) = "$*******"
pomoc$(1) = "****$***"
pomoc$(2) = "*****$*$"
pomoc$(3) = "*$******"
pomoc$(4) = "***$**$*"
pomoc$(5) = "$*******"
pomoc$(6) = "**$**$**"
pomoc$(7) = "****$***"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 33: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 32: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), wegiel
pomoc$(0) = "########"
pomoc$(1) = "#**##**#"
pomoc$(2) = "#*.##*.#"
pomoc$(3) = "########"
pomoc$(4) = "########"
pomoc$(5) = "#**##**#"
pomoc$(6) = "#*.##*.#"
pomoc$(7) = "########"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 1 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 11 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), stal
CLS
pomoc$(0) = "#......#.#....#...#..#.."
pomoc$(1) = "@@....@@.@@..@@....@@..."
pomoc$(2) = "@$$..$$@..$$$$.....$$..."
pomoc$(3) = "*&*&*&*&..*&*&.....&*..."
pomoc$(4) = "&*&*&*&*..&*&*.....*&..."
pomoc$(5) = "@$$..$$@..$$$$.....$$..."
pomoc$(6) = "@@....@@.@@..@@....@@..."
pomoc$(7) = "#......#.#....#...#..#.."
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "&" THEN COLOR 2 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 11 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 8 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), motyl1
GET (8, 0)-(15, 7), motyl2
GET (16, 0)-(23, 7), motyl3
CLS
pomoc$(0) = "..@@@..."
pomoc$(1) = "..@@@..."
pomoc$(2) = "...@...."
pomoc$(3) = ".*****.."
pomoc$(4) = "*.***.*."
pomoc$(5) = "..###..."
pomoc$(6) = "..#.#..."
pomoc$(7) = ".##.##.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 15: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), gracz1
CLS
END SUB
SUB plansza
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%.......AAAAOAAAAAA%AAOO+OA++A+AO+++O++%"
tablica$(2) = "%.......++++O+++MMM%O++OOO+A+A+AO+A+A++%"
tablica$(3) = "%.......AAAAOAAAAAA%AAOOOOAOAAOOAAO+O++%"
tablica$(4) = "%.......MMMMO++++++%+O+OOOAAOAAAOAO+AOA%"
tablica$(5) = "%AAAAAAAAAAAOAAAAAA%AAOO+O+OAOOAAO++O++%"
tablica$(6) = "%%%%%%%%%%%%%%+++++%+O+OOOA+OAAAO+AOA++%"
tablica$(7) = "%AAAAAAAAAAAAOAAAAA%AAAO+OOOOAOAAAO+OA+%"
tablica$(8) = "%A++++++++++O++++MM%M+AAAOAAOAAOAOO+A+A%"
tablica$(9) = "%AAAA+++++++O++++++%OOOOOOOOOOOOOAOOAAA%"
tablica$(10) = "%++++++++++..++++++%AAAAAAOOOOOOOAAAAAA%"
tablica$(11) = "%AAAAAAAA..........%%%%%%%%%%+%%%%%%%%%%"
tablica$(12) = "%++++%%%%%%%%%%%%%%%...................%"
tablica$(13) = "%+AAAAAAAA.........%...................%"
tablica$(14) = "%++++++++++........%...................%"
tablica$(15) = "%++++A+++AAA.......%MMMMMM.......MMMMMM%"
tablica$(16) = "%++++++++++........%...................%"
tablica$(17) = "%+.++AAAAAAAOAA....%...................%"
tablica$(18) = "%+.+++++++++++++...%...................%"
tablica$(19) = "%+.......+++.+++.......................%"
tablica$(20) = "%+.+++++++++.+++.......................%"
tablica$(21) = "%+.+++++++++.++++......................%"
tablica$(22) = "%+.............++......................%"
tablica$(23) = "%++++++++++++++++.......%%%............%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
FOR yd = 0 TO 24
FOR xd = 0 TO 39
tabl(xd, yd) = ASC(MID$(tablica$(yd), xd + 1, 1))
NEXT xd
NEXT yd
END SUB
|
|
| Powrót do góry |
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Piotr-246
Gość
|
| Wysłany: Pią 13:54, 25 Cze 2021 Temat postu: |
|
|
DECLARE SUB chrup ()
DECLARE SUB braniedia ()
DECLARE SUB beepkam ()
DECLARE SUB beepdia ()
DECLARE SUB plansza ()
DECLARE SUB elementy ()
REM gra musi chodzic w trybie Turbo
SCREEN 13
DEF SEG = 0
DIM SHARED diament(0 TO 16) AS LONG
DIM SHARED diament2(0 TO 16) AS LONG
DIM SHARED diament3(0 TO 16) AS LONG
DIM SHARED diament4(0 TO 16) AS LONG
DIM SHARED kamien(0 TO 16) AS LONG
DIM SHARED czyste(0 TO 16) AS LONG
DIM SHARED murek(0 TO 16) AS LONG
DIM SHARED wegiel(0 TO 16) AS LONG
DIM SHARED stal(0 TO 16) AS LONG
DIM SHARED motyl1(0 TO 16) AS LONG
DIM SHARED motyl2(0 TO 16) AS LONG
DIM SHARED motyl3(0 TO 16) AS LONG
DIM SHARED gracz1(0 TO 16) AS LONG
DIM SHARED pomoc$(0 TO 7)
DIM SHARED tablica$(0 TO 24)
DIM SHARED tabl(0 TO 39, 0 TO 24) AS INTEGER
DIM SHARED motx(0 TO 1) AS INTEGER
DIM SHARED moty(0 TO 1) AS INTEGER
DIM SHARED motw(0 TO 1) AS INTEGER
REM ************************ zaladowanie elementow graficznych
elementy
REM ****************************** zaladowanie planszy
restart:
plansza
REM ************************ dane startowe
CLS
x = 25: y = 18
tabl(x, y) = 2
xs = x: ys = y
motx(0) = 15: moty(0) = 16: motw(0) = 2
motx(1) = 2: moty(1) = 22: motw(1) = 2
faza = 0: fazamotyla = 0
REM *************************** petla glowna
petla:
key$ = ""
REM *************************** sprawdzenie tablicy
beepk = 0: beepd = 0
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("@") THEN tabl(xb, yb) = ASC("."): REM tymczasowa przerwa
IF pobrany = ASC("O") THEN IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("O"): tabl(xb, yb) = ASC("@"): beepk = 1: GOTO skok
IF pobrany = ASC("A") THEN IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("A"): tabl(xb, yb) = ASC("@"): beepd = 1: GOTO skok
REM znaki wieksze od ascii 64 powoduja upadek w bok
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("O"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("O"): tabl(xb, yb) = ASC(".")
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("A"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("A"): tabl(xb, yb) = ASC(".")
END IF
skok:
NEXT xb
NEXT yb
REM ****************** ruch motyli ***********************
FOR mot = 0 TO 1
mx = motx(mot)
my = moty(mot)
wektor = motw(mot)
ruch = 0
nie1 = 0: nie2 = 0: nie3 = 0: nie4 = 0
nie5 = 0: nie6 = 0: nie7 = 0: nie8 = 0
IF tabl(mx + 1, my - 1) <> ASC(".") THEN nie1 = 1
IF tabl(mx + 1, my) <> ASC(".") THEN nie2 = 1
IF tabl(mx + 1, my + 1) <> ASC(".") THEN nie3 = 1
IF tabl(mx, my + 1) <> ASC(".") THEN nie4 = 1
IF tabl(mx - 1, my + 1) <> ASC(".") THEN nie5 = 1
IF tabl(mx - 1, my) <> ASC(".") THEN nie6 = 1
IF tabl(mx - 1, my - 1) <> ASC(".") THEN nie7 = 1
IF tabl(mx, my - 1) <> ASC(".") THEN nie8 = 1
REM aby kontynuowal kierunek ruchu
powtorz = 0
IF wektor = 6 THEN GOTO wek6
IF wektor = 4 THEN GOTO wek4
IF wektor = 8 THEN GOTO wek8
jeszcze:
REM ruch w prawo
IF ruch = 0 AND nie8 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
IF ruch = 0 AND nie7 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
wek4:
REM ruch w dol
IF ruch = 0 AND nie2 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
IF ruch = 0 AND nie1 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
wek6:
REM ruch w lewo
IF ruch = 0 AND nie4 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
IF ruch = 0 AND nie3 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
wek8:
REM ruch w gore
IF ruch = 0 AND nie6 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
IF ruch = 0 AND nie5 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
REM sprawdz jeszcze raz
IF ruch = 0 AND powtorz = 0 AND (nie2 <> 0 OR nie4 <> 0 OR nie6 <> 0 OR nie8 <> 0) THEN powtorz = 1: GOTO jeszcze
REM motyl zapetlony w prozni
IF ruch = 0 AND nie2 = 0 AND nie4 = 0 AND nie6 = 0 AND nie8 = 0 THEN
IF fazamotyla = 0 THEN ruch = 1: wektor = 2
IF fazamotyla = 1 THEN ruch = 1: wektor = 4
IF fazamotyla = 2 THEN ruch = 1: wektor = 6
IF fazamotyla = 3 THEN ruch = 1: wektor = 8
END IF
REM wykonanie ruchu w tablicy
IF ruch = 1 AND wektor = 2 THEN tabl(mx, my) = ASC("."): mx = mx + 1
IF ruch = 1 AND wektor = 4 THEN tabl(mx, my) = ASC("."): my = my + 1
IF ruch = 1 AND wektor = 6 THEN tabl(mx, my) = ASC("."): mx = mx - 1
IF ruch = 1 AND wektor = 8 THEN tabl(mx, my) = ASC("."): my = my - 1
IF ruch = 0 THEN tabl(mx, my) = ASC("X")
IF ruch = 1 THEN tabl(mx, my) = ASC("X "): motx(mot) = mx: moty(mot) = my
motw(mot) = wektor
NEXT mot
REM *************************** wyswietlenie tablicy
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("+") THEN PUT (xb * 8, yb * 8), wegiel, OR: GOTO wyjdz
IF pobrany = ASC("%") THEN PUT (xb * 8, yb * 8), stal, OR: GOTO wyjdz
IF pobrany = ASC("M") THEN PUT (xb * 8, yb * 8), murek, OR: GOTO wyjdz
REM czysczenie tylko pod niektore elementy
PUT (xb * 8, yb * 8), czyste, AND
IF pobrany = ASC("O") THEN PUT (xb * 8, yb * 8), kamien, OR
IF pobrany = ASC("X") THEN
IF fazamotyla = 0 THEN PUT (xb * 8, yb * 8), motyl1, OR
IF fazamotyla = 1 THEN PUT (xb * 8, yb * 8), motyl2, OR
IF fazamotyla = 2 THEN PUT (xb * 8, yb * 8), motyl3, OR
IF fazamotyla = 3 THEN PUT (xb * 8, yb * 8), motyl2, OR
END IF
REM falowanie diamentu:
IF pobrany = ASC("A") THEN
IF faza = 0 THEN PUT (xb * 8, yb * 8), diament, OR
IF faza = 1 THEN PUT (xb * 8, yb * 8), diament2, OR
IF faza = 2 THEN PUT (xb * 8, yb * 8), diament3, OR
IF faza = 3 THEN PUT (xb * 8, yb * 8), diament4, OR
END IF
IF pobrany = 2 THEN PUT (xb * 8, yb * 8), gracz1, OR
wyjdz:
NEXT xb
NEXT yb
IF beepk = 1 THEN beepkam: GOTO skok2
IF beepd = 1 THEN beepdia
skok2:
REM ************** zmiana fazy falowania motyli i diamentow:
faza = faza + 1
IF faza = 4 THEN faza = 0
fazamotyla = fazamotyla + 1
IF fazamotyla = 4 THEN fazamotyla = 0
REM ********************* obsluga klawiatury
IF key$ = "" THEN GOTO petla
k$ = key$
POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury
IF k$ = CHR$(27) THEN END
IF k$ = "r" OR k$ = "R" THEN GOTO restart
dx = 0: dy = 0
IF k$ = CHR$(0) + "M" THEN x = x + 1: dx = 1
IF k$ = CHR$(0) + "K" THEN x = x - 1: dx = -1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
REM ************ sprawdzenie czy wolno wykonac ruch
pobrany = tabl(x, y)
IF y = ys AND pobrany = ASC("O") THEN IF tabl(xs + dx * 2, y) = ASC(".") THEN tabl(xs + dx * 2, y) = ASC("O"): GOTO nowa
IF pobrany <> ASC(".") AND pobrany <> ASC("+") AND pobrany <> ASC("A") THEN x = xs: y = ys: GOTO petla
IF pobrany = ASC("+") THEN chrup
IF pobrany = ASC("A") THEN braniedia: REM SOUND 1600, 1: SOUND 900, 1
nowa:
REM ************* kasowanie w tablicy starej pozycji gracza
tabl(xs, ys) = ASC(".")
REM ************* wstawienie do tablicy nowej pozycji gracza
tabl(x, y) = 2
REM zapamietanie starej pozycji gracza
xs = x: ys = y
GOTO petla
SUB beepdia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 2
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 64: OUT 66, 3
OUT 66, 250: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB beepkam
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 32: OUT 66, 1
OUT 66, 32: OUT 66, 0
OUT 66, 104: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 250: OUT 66, 1
OUT 66, 32: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB braniedia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 100 TO 1 STEP -1
OUT 66, i: OUT 66, 3
FOR j = 1 TO 150: NEXT j
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB chrup
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 0
OUT 66, 20: OUT 66, 0
OUT 66, 32: OUT 66, 0
NEXT i
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 54: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 60: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB elementy
REM zielony wegiel
PALETTE 32, 5 * 65536 + 12 * 256 + 0
PALETTE 33, 9 * 65536 + 14 * 256 + 2
PALETTE 34, 12 * 65536 + 18 * 256 + 6
REM odcienie kamienia +48
FOR i = 0 TO 15
PALETTE 48 + i, INT(i * 2.5) * 65536 + i * 3 * 256 + i * 4
NEXT i
REM odcienie diamentu +64
FOR i = 0 TO 15
PALETTE 64 + i, INT(i * 4) * 65536 + INT(i * 3.7) * 256 + INT(i * 3.2)
NEXT i
GET (0, 0)-(7, 7), czyste
pomoc$(0) = "...@@..."
pomoc$(1) = "..@$$@.."
pomoc$(2) = ".@****@."
pomoc$(3) = "@::::::@"
pomoc$(4) = "@######@"
pomoc$(5) = ".@$$$$@."
pomoc$(6) = "..@**@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament
pomoc$(0) = "...@@..."
pomoc$(1) = "..@**@.."
pomoc$(2) = ".@::::@."
pomoc$(3) = "@######@"
pomoc$(4) = "@$$$$$$@"
pomoc$(5) = ".@****@."
pomoc$(6) = "..@::@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament2
pomoc$(0) = "...@@..."
pomoc$(1) = "..@::@.."
pomoc$(2) = ".@####@."
pomoc$(3) = "@$$$$$$@"
pomoc$(4) = "@******@"
pomoc$(5) = ".@::::@."
pomoc$(6) = "..@##@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament3
pomoc$(0) = "...@@..."
pomoc$(1) = "..@##@.."
pomoc$(2) = ".@$$$$@."
pomoc$(3) = "@******@"
pomoc$(4) = "@::::::@"
pomoc$(5) = ".@####@."
pomoc$(6) = "..@$$@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament4
pomoc$(0) = "..*$**.."
pomoc$(1) = ".*$###*."
pomoc$(2) = "**$$###*"
pomoc$(3) = "$#*$$#$*"
pomoc$(4) = "*:*#$$#$"
pomoc$(5) = "*$*$:$#*"
pomoc$(6) = ".*:*$**."
pomoc$(7) = "..:*:*.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 3 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 6 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 9 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 48: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), kamien
pomoc$(0) = ".###.###"
pomoc$(1) = ".###.###"
pomoc$(2) = ".###.###"
pomoc$(3) = "........"
pomoc$(4) = "##.###.#"
pomoc$(5) = "##.###.#"
pomoc$(6) = "##.###.#"
pomoc$(7) = "........"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 13 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), murek
pomoc$(0) = "$*******"
pomoc$(1) = "**#*$***"
pomoc$(2) = "*****$*$"
pomoc$(3) = "*$**#***"
pomoc$(4) = "***$**$*"
pomoc$(5) = "$******#"
pomoc$(6) = "**$**$**"
pomoc$(7) = "*#**$***"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 33: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 32: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 34: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), wegiel
pomoc$(0) = "########"
pomoc$(1) = "#**##**#"
pomoc$(2) = "#*.##*.#"
pomoc$(3) = "########"
pomoc$(4) = "########"
pomoc$(5) = "#**##**#"
pomoc$(6) = "#*.##*.#"
pomoc$(7) = "########"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 1 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 11 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), stal
CLS
pomoc$(0) = "#......#.#....#...#..#.."
pomoc$(1) = "@@....@@.@@..@@....@@..."
pomoc$(2) = "@$$..$$@..$$$$.....$$..."
pomoc$(3) = "*&*&*&*&..*&*&.....&*..."
pomoc$(4) = "&*&*&*&*..&*&*.....*&..."
pomoc$(5) = "@$$..$$@..$$$$.....$$..."
pomoc$(6) = "@@....@@.@@..@@....@@..."
pomoc$(7) = "#......#.#....#...#..#.."
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "&" THEN COLOR 2 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 11 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 8 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), motyl1
GET (8, 0)-(15, 7), motyl2
GET (16, 0)-(23, 7), motyl3
CLS
pomoc$(0) = "..@@@..."
pomoc$(1) = "..@@@..."
pomoc$(2) = "...@...."
pomoc$(3) = ".*****.."
pomoc$(4) = "*.***.*."
pomoc$(5) = "..###..."
pomoc$(6) = "..#.#..."
pomoc$(7) = ".##.##.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 15: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), gracz1
CLS
END SUB
SUB plansza
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%.......AOOAOAAAAAA%AAOO+OA++A+AO+++O++%"
tablica$(2) = "%.......++A+O+++OAO%O++OOO+A+A+AO+A+A++%"
tablica$(3) = "%.......AOAAOAAOOAA%AAOOOOAOAAOOAAO+O++%"
tablica$(4) = "%...MMMMMMMMMMMMMMM%+O+OOOAAOAAAOAO+AOA%"
tablica$(5) = "%AA+++AO++AAOAA+AAA%AAOO+O+OAOOAAO++O++%"
tablica$(6) = "%+++O+++++OOO++++++%+O+OOOA+OAAAO+AOA++%"
tablica$(7) = "%A+++AOAAOAAAOAA+OA%AAAO+OOOOAOAAAO+OA+%"
tablica$(8) = "%MMMMMMMMMMMMMMM+++%A+AAAOAAOAAOAOO+A+A%"
tablica$(9) = "%AAAA+++++++O++++++%OOOOOOOOOOOOOAOOAAA%"
tablica$(10) = "%++++++++++..++++++%AAAAAAOOOOOOOAAAAAA%"
tablica$(11) = "%AOAOA+++....+++...%AAAOAOAAOAAAAAOOAOA%"
tablica$(12) = "%++++%%%%%%%%%%%%%%%%%%%%%%%%+%%%%%%%%%%"
tablica$(13) = "%+AAAAAAAA.........%++++...........++++%"
tablica$(14) = "%++++++++++........%+++.............+++%"
tablica$(15) = "%++++A+++AAA.......%++...............++%"
tablica$(16) = "%++++++++++........%+.................+%"
tablica$(17) = "%+.++AAAAAAAOAA....%...................%"
tablica$(18) = "%+.+++++++++++++...%...................%"
tablica$(19) = "%+.......+++.+++.......................%"
tablica$(20) = "%+.+++++++++.+++.......................%"
tablica$(21) = "%+.+++++++++.++++......................%"
tablica$(22) = "%+.............++......................%"
tablica$(23) = "%++++++++++++++++......................%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
FOR yd = 0 TO 24
FOR xd = 0 TO 39
tabl(xd, yd) = ASC(MID$(tablica$(yd), xd + 1, 1))
NEXT xd
NEXT yd
END SUB
|
|
| Powrót do góry |
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Piotr-246
Gość
|
| Wysłany: Pią 15:56, 25 Cze 2021 Temat postu: |
|
|
DECLARE SUB chrup ()
DECLARE SUB braniedia ()
DECLARE SUB beepkam ()
DECLARE SUB beepdia (ulamek)
DECLARE SUB plansza ()
DECLARE SUB elementy ()
REM gra musi chodzic w trybie Turbo
SCREEN 13
DEF SEG = 0
DIM SHARED diament(0 TO 16) AS LONG
DIM SHARED diament2(0 TO 16) AS LONG
DIM SHARED diament3(0 TO 16) AS LONG
DIM SHARED diament4(0 TO 16) AS LONG
DIM SHARED kamien(0 TO 16) AS LONG
DIM SHARED czyste(0 TO 16) AS LONG
DIM SHARED murek(0 TO 16) AS LONG
DIM SHARED wegiel(0 TO 16) AS LONG
DIM SHARED stal(0 TO 16) AS LONG
DIM SHARED motyl1(0 TO 16) AS LONG
DIM SHARED motyl2(0 TO 16) AS LONG
DIM SHARED motyl3(0 TO 16) AS LONG
DIM SHARED gracz1(0 TO 16) AS LONG
DIM SHARED pomoc$(0 TO 7)
DIM SHARED tablica$(0 TO 24)
DIM SHARED tabl(0 TO 39, 0 TO 24) AS INTEGER
DIM SHARED motx(0 TO 1) AS INTEGER
DIM SHARED moty(0 TO 1) AS INTEGER
DIM SHARED motw(0 TO 1) AS INTEGER
DIM SHARED stary.port
REM ************************ zaladowanie elementow graficznych
elementy
REM ****************************** zaladowanie planszy
restart:
plansza
REM ************************ dane startowe
CLS
x = 25: y = 18
tabl(x, y) = 2
xs = x: ys = y
motx(0) = 15: moty(0) = 16: motw(0) = 2
motx(1) = 2: moty(1) = 22: motw(1) = 2
faza = 0: fazamotyla = 0
REM *************************** petla glowna
petla:
key$ = ""
REM *************************** sprawdzenie tablicy
beepk = 0: beepd = 0
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("@") THEN tabl(xb, yb) = ASC("."): REM tymczasowa przerwa
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("O"): tabl(xb, yb) = ASC("@"): beepk = 1: GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("A"): tabl(xb, yb) = ASC("@"): beepd = 1: GOTO skok
END IF
REM znaki wieksze od ascii 64 powoduja upadek w bok
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("O"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("O"): tabl(xb, yb) = ASC(".")
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("A"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("A"): tabl(xb, yb) = ASC(".")
END IF
skok:
REM dlaczego nie dziala?
REM IF beepd = 1 OR beepk = 1 THEN
REM IF tabl(xb, yb + 2) = ASC(".") THEN beepd = 0: beepk = 0
REM END IF
NEXT xb
NEXT yb
REM ****************** ruch motyli ***********************
FOR mot = 0 TO 1
mx = motx(mot)
my = moty(mot)
wektor = motw(mot)
ruch = 0
nie1 = 0: nie2 = 0: nie3 = 0: nie4 = 0
nie5 = 0: nie6 = 0: nie7 = 0: nie8 = 0
IF tabl(mx + 1, my - 1) <> ASC(".") THEN nie1 = 1
IF tabl(mx + 1, my) <> ASC(".") THEN nie2 = 1
IF tabl(mx + 1, my + 1) <> ASC(".") THEN nie3 = 1
IF tabl(mx, my + 1) <> ASC(".") THEN nie4 = 1
IF tabl(mx - 1, my + 1) <> ASC(".") THEN nie5 = 1
IF tabl(mx - 1, my) <> ASC(".") THEN nie6 = 1
IF tabl(mx - 1, my - 1) <> ASC(".") THEN nie7 = 1
IF tabl(mx, my - 1) <> ASC(".") THEN nie8 = 1
REM aby kontynuowal kierunek ruchu
powtorz = 0
IF wektor = 6 THEN GOTO wek6
IF wektor = 4 THEN GOTO wek4
IF wektor = 8 THEN GOTO wek8
jeszcze:
REM ruch w prawo
IF ruch = 0 AND nie8 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
IF ruch = 0 AND nie7 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
wek4:
REM ruch w dol
IF ruch = 0 AND nie2 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
IF ruch = 0 AND nie1 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
wek6:
REM ruch w lewo
IF ruch = 0 AND nie4 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
IF ruch = 0 AND nie3 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
wek8:
REM ruch w gore
IF ruch = 0 AND nie6 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
IF ruch = 0 AND nie5 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
REM sprawdz jeszcze raz
IF ruch = 0 AND powtorz = 0 AND (nie2 <> 0 OR nie4 <> 0 OR nie6 <> 0 OR nie8 <> 0) THEN powtorz = 1: GOTO jeszcze
REM motyl zapetlony w prozni
IF ruch = 0 AND nie2 = 0 AND nie4 = 0 AND nie6 = 0 AND nie8 = 0 THEN
IF fazamotyla = 0 THEN ruch = 1: wektor = 2
IF fazamotyla = 1 THEN ruch = 1: wektor = 4
IF fazamotyla = 2 THEN ruch = 1: wektor = 6
IF fazamotyla = 3 THEN ruch = 1: wektor = 8
END IF
REM wykonanie ruchu w tablicy
IF ruch = 1 AND wektor = 2 THEN tabl(mx, my) = ASC("."): mx = mx + 1
IF ruch = 1 AND wektor = 4 THEN tabl(mx, my) = ASC("."): my = my + 1
IF ruch = 1 AND wektor = 6 THEN tabl(mx, my) = ASC("."): mx = mx - 1
IF ruch = 1 AND wektor = 8 THEN tabl(mx, my) = ASC("."): my = my - 1
IF ruch = 0 THEN tabl(mx, my) = ASC("X")
IF ruch = 1 THEN tabl(mx, my) = ASC("X "): motx(mot) = mx: moty(mot) = my
motw(mot) = wektor
NEXT mot
REM *************************** wyswietlenie tablicy
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("+") THEN PUT (xb * 8, yb * 8), wegiel, OR: GOTO wyjdz
IF pobrany = ASC("%") THEN PUT (xb * 8, yb * 8), stal, OR: GOTO wyjdz
IF pobrany = ASC("M") THEN PUT (xb * 8, yb * 8), murek, OR: GOTO wyjdz
REM czysczenie tylko pod niektore elementy
PUT (xb * 8, yb * 8), czyste, AND
IF pobrany = ASC("O") THEN PUT (xb * 8, yb * 8), kamien, OR
IF pobrany = ASC("X") THEN
IF fazamotyla = 0 THEN PUT (xb * 8, yb * 8), motyl1, OR
IF fazamotyla = 1 THEN PUT (xb * 8, yb * 8), motyl2, OR
IF fazamotyla = 2 THEN PUT (xb * 8, yb * 8), motyl3, OR
IF fazamotyla = 3 THEN PUT (xb * 8, yb * 8), motyl2, OR
END IF
REM falowanie diamentu:
IF pobrany = ASC("A") THEN
IF faza = 0 THEN PUT (xb * 8, yb * 8), diament, OR
IF faza = 1 THEN PUT (xb * 8, yb * 8), diament2, OR
IF faza = 2 THEN PUT (xb * 8, yb * 8), diament3, OR
IF faza = 3 THEN PUT (xb * 8, yb * 8), diament4, OR
END IF
IF pobrany = 2 THEN PUT (xb * 8, yb * 8), gracz1, OR
wyjdz:
NEXT xb
IF beepd = 1 THEN beepdia (yb)
NEXT yb
IF beepk = 1 THEN beepkam: GOTO skok2
REM IF beepd = 1 THEN beepdia
skok2:
REM ************** zmiana fazy falowania motyli i diamentow:
faza = faza + 1
IF faza = 4 THEN faza = 0
fazamotyla = fazamotyla + 1
IF fazamotyla = 4 THEN fazamotyla = 0
REM ********************* obsluga klawiatury
IF key$ = "" THEN GOTO petla
k$ = key$
POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury
IF k$ = CHR$(27) THEN END
IF k$ = "r" OR k$ = "R" THEN GOTO restart
dx = 0: dy = 0
IF k$ = CHR$(0) + "M" THEN x = x + 1: dx = 1
IF k$ = CHR$(0) + "K" THEN x = x - 1: dx = -1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
REM ************ sprawdzenie czy wolno wykonac ruch
pobrany = tabl(x, y)
IF y = ys AND pobrany = ASC("O") THEN IF tabl(xs + dx * 2, y) = ASC(".") THEN tabl(xs + dx * 2, y) = ASC("O"): GOTO nowa
IF pobrany <> ASC(".") AND pobrany <> ASC("+") AND pobrany <> ASC("A") THEN x = xs: y = ys: GOTO petla
IF pobrany = ASC("+") THEN chrup
IF pobrany = ASC("A") THEN braniedia: REM SOUND 1600, 1: SOUND 900, 1
nowa:
REM ************* kasowanie w tablicy starej pozycji gracza
tabl(xs, ys) = ASC(".")
REM ************* wstawienie do tablicy nowej pozycji gracza
tabl(x, y) = 2
REM zapamietanie starej pozycji gracza
xs = x: ys = y
GOTO petla
SUB beepdia (ulamek)
IF ulamek < 24 GOTO pominstart
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
pominstart:
FOR i = 1 TO 1
OUT 66, 102: OUT 66, 1
REM OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 3
REM OUT 66, 250: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
IF ulamek > 0 THEN GOTO pominkoniec
REM wylaczenie glosnika
OUT 97, stary.port
pominkoniec:
END SUB
SUB beepkam
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 32: OUT 66, 1
OUT 66, 32: OUT 66, 0
OUT 66, 104: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 250: OUT 66, 1
OUT 66, 32: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB braniedia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 100 TO 1 STEP -1
OUT 66, i: OUT 66, 3
FOR j = 1 TO 150: NEXT j
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB chrup
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 0
OUT 66, 20: OUT 66, 0
OUT 66, 32: OUT 66, 0
NEXT i
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 54: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 60: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB elementy
REM zielony wegiel
PALETTE 32, 5 * 65536 + 12 * 256 + 0
PALETTE 33, 9 * 65536 + 14 * 256 + 2
PALETTE 34, 12 * 65536 + 18 * 256 + 6
REM odcienie kamienia +48
FOR i = 0 TO 15
PALETTE 48 + i, INT(i * 2.5) * 65536 + i * 3 * 256 + i * 4
NEXT i
REM odcienie diamentu +64
FOR i = 0 TO 15
PALETTE 64 + i, INT(i * 4) * 65536 + INT(i * 3.7) * 256 + INT(i * 3.2)
NEXT i
GET (0, 0)-(7, 7), czyste
pomoc$(0) = "...@@..."
pomoc$(1) = "..@$$@.."
pomoc$(2) = ".@****@."
pomoc$(3) = "@::::::@"
pomoc$(4) = "@######@"
pomoc$(5) = ".@$$$$@."
pomoc$(6) = "..@**@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament
pomoc$(0) = "...@@..."
pomoc$(1) = "..@**@.."
pomoc$(2) = ".@::::@."
pomoc$(3) = "@######@"
pomoc$(4) = "@$$$$$$@"
pomoc$(5) = ".@****@."
pomoc$(6) = "..@::@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament2
pomoc$(0) = "...@@..."
pomoc$(1) = "..@::@.."
pomoc$(2) = ".@####@."
pomoc$(3) = "@$$$$$$@"
pomoc$(4) = "@******@"
pomoc$(5) = ".@::::@."
pomoc$(6) = "..@##@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament3
pomoc$(0) = "...@@..."
pomoc$(1) = "..@##@.."
pomoc$(2) = ".@$$$$@."
pomoc$(3) = "@******@"
pomoc$(4) = "@::::::@"
pomoc$(5) = ".@####@."
pomoc$(6) = "..@$$@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament4
pomoc$(0) = "..*$**.."
pomoc$(1) = ".*$###*."
pomoc$(2) = "**$$###*"
pomoc$(3) = "$#*$$#$*"
pomoc$(4) = "*:*#$$#$"
pomoc$(5) = "*$*$:$#*"
pomoc$(6) = ".*:*$**."
pomoc$(7) = "..:*:*.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 3 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 6 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 9 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 48: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), kamien
pomoc$(0) = ".###.###"
pomoc$(1) = ".###.###"
pomoc$(2) = ".###.###"
pomoc$(3) = "........"
pomoc$(4) = "##.###.#"
pomoc$(5) = "##.###.#"
pomoc$(6) = "##.###.#"
pomoc$(7) = "........"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 13 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), murek
pomoc$(0) = "$*******"
pomoc$(1) = "**#*$***"
pomoc$(2) = "*****$*$"
pomoc$(3) = "*$**#***"
pomoc$(4) = "***$**$*"
pomoc$(5) = "$******#"
pomoc$(6) = "**$**$**"
pomoc$(7) = "*#**$***"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 33: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 32: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 34: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), wegiel
pomoc$(0) = "########"
pomoc$(1) = "#**##**#"
pomoc$(2) = "#*.##*.#"
pomoc$(3) = "########"
pomoc$(4) = "########"
pomoc$(5) = "#**##**#"
pomoc$(6) = "#*.##*.#"
pomoc$(7) = "########"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 1 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 11 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), stal
CLS
pomoc$(0) = "#......#.#....#...#..#.."
pomoc$(1) = "@@....@@.@@..@@....@@..."
pomoc$(2) = "@$$..$$@..$$$$.....$$..."
pomoc$(3) = "*&*&*&*&..*&*&.....&*..."
pomoc$(4) = "&*&*&*&*..&*&*.....*&..."
pomoc$(5) = "@$$..$$@..$$$$.....$$..."
pomoc$(6) = "@@....@@.@@..@@....@@..."
pomoc$(7) = "#......#.#....#...#..#.."
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "&" THEN COLOR 2 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 11 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 8 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), motyl1
GET (8, 0)-(15, 7), motyl2
GET (16, 0)-(23, 7), motyl3
CLS
pomoc$(0) = "..@@@..."
pomoc$(1) = "..@@@..."
pomoc$(2) = "...@...."
pomoc$(3) = ".*****.."
pomoc$(4) = "*.***.*."
pomoc$(5) = "..###..."
pomoc$(6) = "..#.#..."
pomoc$(7) = ".##.##.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 15: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), gracz1
CLS
END SUB
SUB plansza
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%.......AOOAOAAAAAA%AAOO+OA++A+AO+++O++%"
tablica$(2) = "%.......++A+O+++OAO%O++OOO+A+A+AO+A+A++%"
tablica$(3) = "%.......AOAAOAAOOAA%AAOOOOAOAAOOAAO+O++%"
tablica$(4) = "%...MMMMMMMMMMMMMMM%+O+OOOAAOAAAOAO+AOA%"
tablica$(5) = "%AA+++AO++AAOAA+AAA%AAOO+O+OAOOAAO++O++%"
tablica$(6) = "%+++O+++++OOO++++++%+O+OOOA+OAAAO+AOA++%"
tablica$(7) = "%A+++AOAAOAAAOAA+OA%AAAO+OOOOAOAAAO+OA+%"
tablica$(8) = "%MMMMMMMMMMMMMMM+++%A+AAAOAAOAAOAOO+A+A%"
tablica$(9) = "%AAAA+++++++O++++++%OOOOOOOOOOOOOAOOAAA%"
tablica$(10) = "%++++++++++..++++++%AAAAAAOOOOOOOAAAAAA%"
tablica$(11) = "%AOAOA+++....+++...%AAAOAOAAOAAAAAOOAOA%"
tablica$(12) = "%++++%%%%%%%%%%%%%%%%%%%%%%%%+%%%%%%%%%%"
tablica$(13) = "%+AAAAAAAA.........%++++...........++++%"
tablica$(14) = "%++++++++++........%+++.............+++%"
tablica$(15) = "%++++A+++AAA.......%++...............++%"
tablica$(16) = "%++++++++++........%+.................+%"
tablica$(17) = "%+.++AAAAAAAOAA....%...................%"
tablica$(18) = "%+.+++++++++++++...%...................%"
tablica$(19) = "%+.......+++.+++.......................%"
tablica$(20) = "%+.+++++++++.+++.......................%"
tablica$(21) = "%+.+++++++++.++++......................%"
tablica$(22) = "%+.............++......................%"
tablica$(23) = "%++++++++++++++++......................%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
FOR yd = 0 TO 24
FOR xd = 0 TO 39
tabl(xd, yd) = ASC(MID$(tablica$(yd), xd + 1, 1))
NEXT xd
NEXT yd
END SUB
|
|
| Powrót do góry |
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Piotr-246
Gość
|
| Wysłany: Pią 16:47, 25 Cze 2021 Temat postu: |
|
|
DECLARE SUB chrup ()
DECLARE SUB braniedia ()
DECLARE SUB beepkam (ulamek)
DECLARE SUB beepdia (ulamek)
DECLARE SUB plansza ()
DECLARE SUB elementy ()
REM gra musi chodzic w trybie Turbo
SCREEN 13
DEF SEG = 0
DIM SHARED diament(0 TO 16) AS LONG
DIM SHARED diament2(0 TO 16) AS LONG
DIM SHARED diament3(0 TO 16) AS LONG
DIM SHARED diament4(0 TO 16) AS LONG
DIM SHARED kamien(0 TO 16) AS LONG
DIM SHARED czyste(0 TO 16) AS LONG
DIM SHARED murek(0 TO 16) AS LONG
DIM SHARED wegiel(0 TO 16) AS LONG
DIM SHARED stal(0 TO 16) AS LONG
DIM SHARED motyl1(0 TO 16) AS LONG
DIM SHARED motyl2(0 TO 16) AS LONG
DIM SHARED motyl3(0 TO 16) AS LONG
DIM SHARED gracz1(0 TO 16) AS LONG
DIM SHARED pomoc$(0 TO 7)
DIM SHARED tablica$(0 TO 24)
DIM SHARED tabl(0 TO 39, 0 TO 24) AS INTEGER
DIM SHARED motx(0 TO 1) AS INTEGER
DIM SHARED moty(0 TO 1) AS INTEGER
DIM SHARED motw(0 TO 1) AS INTEGER
DIM SHARED stary.port
REM ************************ zaladowanie elementow graficznych
elementy
REM ****************************** zaladowanie planszy
restart:
plansza
REM ************************ dane startowe
CLS
x = 25: y = 18
tabl(x, y) = 2
xs = x: ys = y
motx(0) = 15: moty(0) = 16: motw(0) = 2
motx(1) = 2: moty(1) = 22: motw(1) = 2
faza = 0: fazamotyla = 0
REM *************************** petla glowna
petla:
key$ = ""
REM *************************** sprawdzenie tablicy
beepk = 0: beepd = 0
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("@") THEN tabl(xb, yb) = ASC("."): REM tymczasowa przerwa
spadk = 0: spadd = 0
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("O"): tabl(xb, yb) = ASC("@"): spadk = 1: GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("A"): tabl(xb, yb) = ASC("@"): spadd = 1: GOTO skok
END IF
REM znaki wieksze od ascii 64 powoduja upadek w bok
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("O"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("O"): tabl(xb, yb) = ASC(".")
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("A"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("A"): tabl(xb, yb) = ASC(".")
END IF
skok:
IF spadk = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepk = 1
END IF
IF spadd = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepd = 1
END IF
NEXT xb
NEXT yb
REM ****************** ruch motyli ***********************
FOR mot = 0 TO 1
mx = motx(mot)
my = moty(mot)
wektor = motw(mot)
ruch = 0
nie1 = 0: nie2 = 0: nie3 = 0: nie4 = 0
nie5 = 0: nie6 = 0: nie7 = 0: nie8 = 0
IF tabl(mx + 1, my - 1) <> ASC(".") THEN nie1 = 1
IF tabl(mx + 1, my) <> ASC(".") THEN nie2 = 1
IF tabl(mx + 1, my + 1) <> ASC(".") THEN nie3 = 1
IF tabl(mx, my + 1) <> ASC(".") THEN nie4 = 1
IF tabl(mx - 1, my + 1) <> ASC(".") THEN nie5 = 1
IF tabl(mx - 1, my) <> ASC(".") THEN nie6 = 1
IF tabl(mx - 1, my - 1) <> ASC(".") THEN nie7 = 1
IF tabl(mx, my - 1) <> ASC(".") THEN nie8 = 1
REM aby kontynuowal kierunek ruchu
powtorz = 0
IF wektor = 6 THEN GOTO wek6
IF wektor = 4 THEN GOTO wek4
IF wektor = 8 THEN GOTO wek8
jeszcze:
REM ruch w prawo
IF ruch = 0 AND nie8 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
IF ruch = 0 AND nie7 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
wek4:
REM ruch w dol
IF ruch = 0 AND nie2 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
IF ruch = 0 AND nie1 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
wek6:
REM ruch w lewo
IF ruch = 0 AND nie4 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
IF ruch = 0 AND nie3 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
wek8:
REM ruch w gore
IF ruch = 0 AND nie6 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
IF ruch = 0 AND nie5 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
REM sprawdz jeszcze raz
IF ruch = 0 AND powtorz = 0 AND (nie2 <> 0 OR nie4 <> 0 OR nie6 <> 0 OR nie8 <> 0) THEN powtorz = 1: GOTO jeszcze
REM motyl zapetlony w prozni
IF ruch = 0 AND nie2 = 0 AND nie4 = 0 AND nie6 = 0 AND nie8 = 0 THEN
IF fazamotyla = 0 THEN ruch = 1: wektor = 2
IF fazamotyla = 1 THEN ruch = 1: wektor = 4
IF fazamotyla = 2 THEN ruch = 1: wektor = 6
IF fazamotyla = 3 THEN ruch = 1: wektor = 8
END IF
REM wykonanie ruchu w tablicy
IF ruch = 1 AND wektor = 2 THEN tabl(mx, my) = ASC("."): mx = mx + 1
IF ruch = 1 AND wektor = 4 THEN tabl(mx, my) = ASC("."): my = my + 1
IF ruch = 1 AND wektor = 6 THEN tabl(mx, my) = ASC("."): mx = mx - 1
IF ruch = 1 AND wektor = 8 THEN tabl(mx, my) = ASC("."): my = my - 1
IF ruch = 0 THEN tabl(mx, my) = ASC("X")
IF ruch = 1 THEN tabl(mx, my) = ASC("X "): motx(mot) = mx: moty(mot) = my
motw(mot) = wektor
NEXT mot
REM *************************** wyswietlenie tablicy
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("+") THEN PUT (xb * 8, yb * 8), wegiel, OR: GOTO wyjdz
IF pobrany = ASC("%") THEN PUT (xb * 8, yb * 8), stal, OR: GOTO wyjdz
IF pobrany = ASC("M") THEN PUT (xb * 8, yb * 8), murek, OR: GOTO wyjdz
REM czysczenie tylko pod niektore elementy
PUT (xb * 8, yb * 8), czyste, AND
IF pobrany = ASC("O") THEN PUT (xb * 8, yb * 8), kamien, OR
IF pobrany = ASC("X") THEN
IF fazamotyla = 0 THEN PUT (xb * 8, yb * 8), motyl1, OR
IF fazamotyla = 1 THEN PUT (xb * 8, yb * 8), motyl2, OR
IF fazamotyla = 2 THEN PUT (xb * 8, yb * 8), motyl3, OR
IF fazamotyla = 3 THEN PUT (xb * 8, yb * 8), motyl2, OR
END IF
REM falowanie diamentu:
IF pobrany = ASC("A") THEN
IF faza = 0 THEN PUT (xb * 8, yb * 8), diament, OR
IF faza = 1 THEN PUT (xb * 8, yb * 8), diament2, OR
IF faza = 2 THEN PUT (xb * 8, yb * 8), diament3, OR
IF faza = 3 THEN PUT (xb * 8, yb * 8), diament4, OR
END IF
IF pobrany = 2 THEN PUT (xb * 8, yb * 8), gracz1, OR
wyjdz:
NEXT xb
IF beepk = 1 THEN beepkam (yb): GOTO skok3
IF beepd = 1 THEN beepdia (yb)
skok3:
NEXT yb
REM IF beepk = 1 THEN beepkam: GOTO skok2
skok2:
REM ************** zmiana fazy falowania motyli i diamentow:
faza = faza + 1
IF faza = 4 THEN faza = 0
fazamotyla = fazamotyla + 1
IF fazamotyla = 4 THEN fazamotyla = 0
REM ********************* obsluga klawiatury
IF key$ = "" THEN GOTO petla
k$ = key$
POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury
IF k$ = CHR$(27) THEN END
IF k$ = "r" OR k$ = "R" THEN GOTO restart
dx = 0: dy = 0
IF k$ = CHR$(0) + "M" THEN x = x + 1: dx = 1
IF k$ = CHR$(0) + "K" THEN x = x - 1: dx = -1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
REM ************ sprawdzenie czy wolno wykonac ruch
pobrany = tabl(x, y)
IF y = ys AND pobrany = ASC("O") THEN IF tabl(xs + dx * 2, y) = ASC(".") THEN tabl(xs + dx * 2, y) = ASC("O"): GOTO nowa
IF pobrany <> ASC(".") AND pobrany <> ASC("+") AND pobrany <> ASC("A") THEN x = xs: y = ys: GOTO petla
IF pobrany = ASC("+") THEN chrup
IF pobrany = ASC("A") THEN braniedia: REM SOUND 1600, 1: SOUND 900, 1
nowa:
REM ************* kasowanie w tablicy starej pozycji gracza
tabl(xs, ys) = ASC(".")
REM ************* wstawienie do tablicy nowej pozycji gracza
tabl(x, y) = 2
REM zapamietanie starej pozycji gracza
xs = x: ys = y
GOTO petla
SUB beepdia (ulamek)
IF ulamek < 24 GOTO pominstart
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
pominstart:
FOR i = 1 TO 1
OUT 66, 102: OUT 66, 1
REM OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 3
REM OUT 66, 250: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
IF ulamek > 0 THEN GOTO pominkoniec
REM wylaczenie glosnika
OUT 97, stary.port
pominkoniec:
END SUB
SUB beepkam (ulamek)
IF ulamek < 24 THEN GOTO ominto
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
ominto:
FOR i = 1 TO 1
OUT 66, 32: OUT 66, 0
OUT 66, 1: OUT 66, 1
OUT 66, 25: OUT 66, 2
OUT 66, 12: OUT 66, 1
OUT 66, 25: OUT 66, 0
OUT 66, 132: OUT 66, 1
OUT 66, 125: OUT 66, 2
OUT 66, 132: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
IF ulamek > 0 THEN GOTO omindrugie
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
omindrugie:
END SUB
SUB braniedia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 100 TO 1 STEP -1
OUT 66, i: OUT 66, 3
FOR j = 1 TO 150: NEXT j
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB chrup
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 0
OUT 66, 20: OUT 66, 0
OUT 66, 32: OUT 66, 0
NEXT i
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 54: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 60: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB elementy
REM zielony wegiel
PALETTE 32, 5 * 65536 + 12 * 256 + 0
PALETTE 33, 9 * 65536 + 14 * 256 + 2
PALETTE 34, 12 * 65536 + 18 * 256 + 6
REM odcienie kamienia +48
FOR i = 0 TO 15
PALETTE 48 + i, INT(i * 2.5) * 65536 + i * 3 * 256 + i * 4
NEXT i
REM odcienie diamentu +64
FOR i = 0 TO 15
PALETTE 64 + i, INT(i * 4) * 65536 + INT(i * 3.7) * 256 + INT(i * 3.2)
NEXT i
GET (0, 0)-(7, 7), czyste
pomoc$(0) = "...@@..."
pomoc$(1) = "..@$$@.."
pomoc$(2) = ".@****@."
pomoc$(3) = "@::::::@"
pomoc$(4) = "@######@"
pomoc$(5) = ".@$$$$@."
pomoc$(6) = "..@**@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament
pomoc$(0) = "...@@..."
pomoc$(1) = "..@**@.."
pomoc$(2) = ".@::::@."
pomoc$(3) = "@######@"
pomoc$(4) = "@$$$$$$@"
pomoc$(5) = ".@****@."
pomoc$(6) = "..@::@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament2
pomoc$(0) = "...@@..."
pomoc$(1) = "..@::@.."
pomoc$(2) = ".@####@."
pomoc$(3) = "@$$$$$$@"
pomoc$(4) = "@******@"
pomoc$(5) = ".@::::@."
pomoc$(6) = "..@##@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament3
pomoc$(0) = "...@@..."
pomoc$(1) = "..@##@.."
pomoc$(2) = ".@$$$$@."
pomoc$(3) = "@******@"
pomoc$(4) = "@::::::@"
pomoc$(5) = ".@####@."
pomoc$(6) = "..@$$@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament4
pomoc$(0) = "..*$**.."
pomoc$(1) = ".*$###*."
pomoc$(2) = "**$$###*"
pomoc$(3) = "$#*$$#$*"
pomoc$(4) = "*:*#$$#$"
pomoc$(5) = "*$*$:$#*"
pomoc$(6) = ".*:*$**."
pomoc$(7) = "..:*:*.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 3 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 6 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 9 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 48: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), kamien
pomoc$(0) = ".###.###"
pomoc$(1) = ".###.###"
pomoc$(2) = ".###.###"
pomoc$(3) = "........"
pomoc$(4) = "##.###.#"
pomoc$(5) = "##.###.#"
pomoc$(6) = "##.###.#"
pomoc$(7) = "........"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 13 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), murek
pomoc$(0) = "$*******"
pomoc$(1) = "**#*$***"
pomoc$(2) = "*****$*$"
pomoc$(3) = "*$**#***"
pomoc$(4) = "***$**$*"
pomoc$(5) = "$******#"
pomoc$(6) = "**$**$**"
pomoc$(7) = "*#**$***"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 33: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 32: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 34: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), wegiel
pomoc$(0) = "########"
pomoc$(1) = "#**##**#"
pomoc$(2) = "#*.##*.#"
pomoc$(3) = "########"
pomoc$(4) = "########"
pomoc$(5) = "#**##**#"
pomoc$(6) = "#*.##*.#"
pomoc$(7) = "########"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 1 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 11 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), stal
CLS
pomoc$(0) = "#......#.#....#...#..#.."
pomoc$(1) = "@@....@@.@@..@@....@@..."
pomoc$(2) = "@$$..$$@..$$$$.....$$..."
pomoc$(3) = "*&*&*&*&..*&*&.....&*..."
pomoc$(4) = "&*&*&*&*..&*&*.....*&..."
pomoc$(5) = "@$$..$$@..$$$$.....$$..."
pomoc$(6) = "@@....@@.@@..@@....@@..."
pomoc$(7) = "#......#.#....#...#..#.."
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "&" THEN COLOR 2 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 11 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 8 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), motyl1
GET (8, 0)-(15, 7), motyl2
GET (16, 0)-(23, 7), motyl3
CLS
pomoc$(0) = "..@@@..."
pomoc$(1) = "..@@@..."
pomoc$(2) = "...@...."
pomoc$(3) = ".*****.."
pomoc$(4) = "*.***.*."
pomoc$(5) = "..###..."
pomoc$(6) = "..#.#..."
pomoc$(7) = ".##.##.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 15: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), gracz1
CLS
END SUB
SUB plansza
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%.......AOOAOAAAAAA%AAOO+OA++A+AO+++O++%"
tablica$(2) = "%.......++A+O+++OAO%O++OOO+A+A+AO+A+A++%"
tablica$(3) = "%.......AOAAOAAOOAA%AAOOOOAOAAOOAAO+O++%"
tablica$(4) = "%...MMMMMMMMMMMMMMM%+O+OOOAAOAAAOAO+AOA%"
tablica$(5) = "%AA+++AO++AAOAA+AAA%AAOO+O+OAOOAAO++O++%"
tablica$(6) = "%+++O+++++OOO++++++%+O+OOOA+OAAAO+AOA++%"
tablica$(7) = "%A+++AOAAOAAAOAA+OA%AAAO+OOOOAOAAAO+OA+%"
tablica$(8) = "%MMMMMMMMMMMMMMM+++%A+AAAOAAOAAOAOO+A+A%"
tablica$(9) = "%AAAA+++++++O++++++%OOOOOOOOOOOOOAOOAAA%"
tablica$(10) = "%++++++++++..++++++%AAAAAAOOOOOOOAAAAAA%"
tablica$(11) = "%AOAOA+++....+++...%AAAOAOAAOAAAAAOOAOA%"
tablica$(12) = "%++++%%%%%%%%%%%%%%%%%%%%%%%%+%%%%%%%%%%"
tablica$(13) = "%+AAAAAAAA.........%++++...........++++%"
tablica$(14) = "%++++++++++........%+++.............+++%"
tablica$(15) = "%++++A+++AAA.......%++...............++%"
tablica$(16) = "%++++++++++........%+.................+%"
tablica$(17) = "%+.++AAAAAAAOAOOO..%...................%"
tablica$(18) = "%+.++++++++++++++..%...................%"
tablica$(19) = "%+.......+++.+++.......................%"
tablica$(20) = "%+.+++++++++.+++.......................%"
tablica$(21) = "%+.+++++++++.++++......................%"
tablica$(22) = "%+.............++......................%"
tablica$(23) = "%++++++++++++++++......................%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
FOR yd = 0 TO 24
FOR xd = 0 TO 39
tabl(xd, yd) = ASC(MID$(tablica$(yd), xd + 1, 1))
NEXT xd
NEXT yd
END SUB
|
|
| Powrót do góry |
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Piotr-246
Gość
|
| Wysłany: Sob 19:35, 26 Cze 2021 Temat postu: |
|
|
DECLARE SUB chrup ()
DECLARE SUB braniedia ()
DECLARE SUB beepkam (ulamek)
DECLARE SUB beepdia (ulamek)
DECLARE SUB plansza (ktora)
DECLARE SUB elementy ()
REM gra musi chodzic w trybie Turbo
SCREEN 13
DEF SEG = 0
DIM SHARED diament(0 TO 16) AS LONG
DIM SHARED diament2(0 TO 16) AS LONG
DIM SHARED diament3(0 TO 16) AS LONG
DIM SHARED diament4(0 TO 16) AS LONG
DIM SHARED kamien(0 TO 16) AS LONG
DIM SHARED czyste(0 TO 16) AS LONG
DIM SHARED murek(0 TO 16) AS LONG
DIM SHARED wegiel(0 TO 16) AS LONG
DIM SHARED stal(0 TO 16) AS LONG
DIM SHARED motyl1(0 TO 16) AS LONG
DIM SHARED motyl2(0 TO 16) AS LONG
DIM SHARED motyl3(0 TO 16) AS LONG
DIM SHARED gracz1(0 TO 16) AS LONG
DIM SHARED pomoc$(0 TO 7)
DIM SHARED tablica$(0 TO 24)
DIM SHARED tabl(0 TO 39, 0 TO 24) AS INTEGER
DIM SHARED motx(0 TO 1) AS INTEGER
DIM SHARED moty(0 TO 1) AS INTEGER
DIM SHARED motw(0 TO 1) AS INTEGER
DIM SHARED stary.port
REM ************************ zaladowanie elementow graficznych
elementy
REM ****************************** zaladowanie planszy
restart:
plansza (1)
REM ************************ dane startowe
restart2:
CLS
x = 25: y = 18
tabl(x, y) = 2
xs = x: ys = y
motx(0) = 15: moty(0) = 16: motw(0) = 2
motx(1) = 2: moty(1) = 22: motw(1) = 2
faza = 0: fazamotyla = 0
REM *************************** petla glowna
petla:
key$ = ""
REM *************************** sprawdzenie tablicy
beepk = 0: beepd = 0
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("@") THEN tabl(xb, yb) = ASC("."): REM tymczasowa przerwa
spadk = 0: spadd = 0
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("O"): tabl(xb, yb) = ASC("@"): spadk = 1: GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("A"): tabl(xb, yb) = ASC("@"): spadd = 1: GOTO skok
END IF
REM znaki wieksze od ascii 64 powoduja upadek w bok
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("O"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("O"): tabl(xb, yb) = ASC(".")
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("A"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("A"): tabl(xb, yb) = ASC(".")
END IF
skok:
IF spadk = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepk = 1
END IF
IF spadd = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepd = 1
END IF
NEXT xb
NEXT yb
REM ****************** ruch motyli ***********************
FOR mot = 0 TO 1
mx = motx(mot)
my = moty(mot)
wektor = motw(mot)
ruch = 0
nie1 = 0: nie2 = 0: nie3 = 0: nie4 = 0
nie5 = 0: nie6 = 0: nie7 = 0: nie8 = 0
IF tabl(mx + 1, my - 1) <> ASC(".") THEN nie1 = 1
IF tabl(mx + 1, my) <> ASC(".") THEN nie2 = 1
IF tabl(mx + 1, my + 1) <> ASC(".") THEN nie3 = 1
IF tabl(mx, my + 1) <> ASC(".") THEN nie4 = 1
IF tabl(mx - 1, my + 1) <> ASC(".") THEN nie5 = 1
IF tabl(mx - 1, my) <> ASC(".") THEN nie6 = 1
IF tabl(mx - 1, my - 1) <> ASC(".") THEN nie7 = 1
IF tabl(mx, my - 1) <> ASC(".") THEN nie8 = 1
REM aby kontynuowal kierunek ruchu
powtorz = 0
IF wektor = 6 THEN GOTO wek6
IF wektor = 4 THEN GOTO wek4
IF wektor = 8 THEN GOTO wek8
jeszcze:
REM ruch w prawo
IF ruch = 0 AND nie8 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
IF ruch = 0 AND nie7 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
wek4:
REM ruch w dol
IF ruch = 0 AND nie2 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
IF ruch = 0 AND nie1 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
wek6:
REM ruch w lewo
IF ruch = 0 AND nie4 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
IF ruch = 0 AND nie3 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
wek8:
REM ruch w gore
IF ruch = 0 AND nie6 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
IF ruch = 0 AND nie5 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
REM sprawdz jeszcze raz
IF ruch = 0 AND powtorz = 0 AND (nie2 <> 0 OR nie4 <> 0 OR nie6 <> 0 OR nie8 <> 0) THEN powtorz = 1: GOTO jeszcze
REM motyl zapetlony w prozni
IF ruch = 0 AND nie2 = 0 AND nie4 = 0 AND nie6 = 0 AND nie8 = 0 THEN
IF fazamotyla = 0 THEN ruch = 1: wektor = 2
IF fazamotyla = 1 THEN ruch = 1: wektor = 4
IF fazamotyla = 2 THEN ruch = 1: wektor = 6
IF fazamotyla = 3 THEN ruch = 1: wektor = 8
END IF
REM wykonanie ruchu w tablicy
IF ruch = 1 AND wektor = 2 THEN tabl(mx, my) = ASC("."): mx = mx + 1
IF ruch = 1 AND wektor = 4 THEN tabl(mx, my) = ASC("."): my = my + 1
IF ruch = 1 AND wektor = 6 THEN tabl(mx, my) = ASC("."): mx = mx - 1
IF ruch = 1 AND wektor = 8 THEN tabl(mx, my) = ASC("."): my = my - 1
IF ruch = 0 THEN tabl(mx, my) = ASC("X")
IF ruch = 1 THEN tabl(mx, my) = ASC("X "): motx(mot) = mx: moty(mot) = my
motw(mot) = wektor
NEXT mot
REM *************************** wyswietlenie tablicy
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("+") THEN PUT (xb * 8, yb * 8), wegiel, OR: GOTO wyjdz
IF pobrany = ASC("%") THEN PUT (xb * 8, yb * 8), stal, OR: GOTO wyjdz
IF pobrany = ASC("M") THEN PUT (xb * 8, yb * 8), murek, OR: GOTO wyjdz
REM czysczenie tylko pod niektore elementy
PUT (xb * 8, yb * 8), czyste, AND
IF pobrany = ASC("O") THEN PUT (xb * 8, yb * 8), kamien, OR
IF pobrany = ASC("X") THEN
IF fazamotyla = 0 THEN PUT (xb * 8, yb * 8), motyl1, OR
IF fazamotyla = 1 THEN PUT (xb * 8, yb * 8), motyl2, OR
IF fazamotyla = 2 THEN PUT (xb * 8, yb * 8), motyl3, OR
IF fazamotyla = 3 THEN PUT (xb * 8, yb * 8), motyl2, OR
END IF
REM falowanie diamentu:
IF pobrany = ASC("A") THEN
IF faza = 0 THEN PUT (xb * 8, yb * 8), diament, OR
IF faza = 1 THEN PUT (xb * 8, yb * 8), diament2, OR
IF faza = 2 THEN PUT (xb * 8, yb * 8), diament3, OR
IF faza = 3 THEN PUT (xb * 8, yb * 8), diament4, OR
END IF
IF pobrany = 2 THEN PUT (xb * 8, yb * 8), gracz1, OR
wyjdz:
NEXT xb
IF beepk = 1 THEN beepkam (yb): GOTO skok3
IF beepd = 1 THEN beepdia (yb)
skok3:
NEXT yb
REM IF beepk = 1 THEN beepkam: GOTO skok2
skok2:
REM ************** zmiana fazy falowania motyli i diamentow:
faza = faza + 1
IF faza = 4 THEN faza = 0
fazamotyla = fazamotyla + 1
IF fazamotyla = 4 THEN fazamotyla = 0
REM ********************* obsluga klawiatury
IF key$ = "" THEN GOTO petla
k$ = key$
POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury
IF k$ = CHR$(27) THEN END
IF k$ = "r" OR k$ = "R" THEN GOTO restart
IF k$ = "2" THEN plansza (2): GOTO restart2
dx = 0: dy = 0
IF k$ = CHR$(0) + "M" THEN x = x + 1: dx = 1
IF k$ = CHR$(0) + "K" THEN x = x - 1: dx = -1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
REM ************ sprawdzenie czy wolno wykonac ruch
pobrany = tabl(x, y)
IF y = ys AND pobrany = ASC("O") THEN IF tabl(xs + dx * 2, y) = ASC(".") THEN tabl(xs + dx * 2, y) = ASC("O"): GOTO nowa
IF pobrany <> ASC(".") AND pobrany <> ASC("+") AND pobrany <> ASC("A") THEN x = xs: y = ys: GOTO petla
IF pobrany = ASC("+") THEN chrup
IF pobrany = ASC("A") THEN braniedia: REM SOUND 1600, 1: SOUND 900, 1
nowa:
REM ************* kasowanie w tablicy starej pozycji gracza
tabl(xs, ys) = ASC(".")
REM ************* wstawienie do tablicy nowej pozycji gracza
tabl(x, y) = 2
REM zapamietanie starej pozycji gracza
xs = x: ys = y
GOTO petla
SUB beepdia (ulamek)
IF ulamek < 24 GOTO pominstart
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
pominstart:
FOR i = 1 TO 1
OUT 66, 102: OUT 66, 1
OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 3
REM OUT 66, 250: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
IF ulamek > 0 THEN GOTO pominkoniec
REM wylaczenie glosnika
OUT 97, stary.port
pominkoniec:
END SUB
SUB beepkam (ulamek)
IF ulamek < 24 THEN GOTO ominto
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
ominto:
FOR i = 1 TO 15
OUT 66, 42: OUT 66, 0
OUT 66, 71: OUT 66, 3
OUT 66, 135: OUT 66, 1
REM OUT 66, 35: OUT 66, 1
REM OUT 66, 135: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
IF ulamek > 0 THEN GOTO omindrugie
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
omindrugie:
END SUB
SUB braniedia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 100 TO 1 STEP -1
OUT 66, i: OUT 66, 3
FOR j = 1 TO 150: NEXT j
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB chrup
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 0
OUT 66, 20: OUT 66, 0
OUT 66, 32: OUT 66, 0
NEXT i
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 54: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 60: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB elementy
REM zielony wegiel
PALETTE 32, 5 * 65536 + 12 * 256 + 0
PALETTE 33, 9 * 65536 + 14 * 256 + 2
PALETTE 34, 12 * 65536 + 18 * 256 + 6
REM odcienie kamienia +48
FOR i = 0 TO 15
PALETTE 48 + i, INT(i * 2.5) * 65536 + i * 3 * 256 + i * 4
NEXT i
REM odcienie diamentu +64
FOR i = 0 TO 15
PALETTE 64 + i, INT(i * 4) * 65536 + INT(i * 3.7) * 256 + INT(i * 3.2)
NEXT i
GET (0, 0)-(7, 7), czyste
pomoc$(0) = "...@@..."
pomoc$(1) = "..@$$@.."
pomoc$(2) = ".@****@."
pomoc$(3) = "@::::::@"
pomoc$(4) = "@######@"
pomoc$(5) = ".@$$$$@."
pomoc$(6) = "..@**@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament
pomoc$(0) = "...@@..."
pomoc$(1) = "..@**@.."
pomoc$(2) = ".@::::@."
pomoc$(3) = "@######@"
pomoc$(4) = "@$$$$$$@"
pomoc$(5) = ".@****@."
pomoc$(6) = "..@::@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament2
pomoc$(0) = "...@@..."
pomoc$(1) = "..@::@.."
pomoc$(2) = ".@####@."
pomoc$(3) = "@$$$$$$@"
pomoc$(4) = "@******@"
pomoc$(5) = ".@::::@."
pomoc$(6) = "..@##@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament3
pomoc$(0) = "...@@..."
pomoc$(1) = "..@##@.."
pomoc$(2) = ".@$$$$@."
pomoc$(3) = "@******@"
pomoc$(4) = "@::::::@"
pomoc$(5) = ".@####@."
pomoc$(6) = "..@$$@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament4
pomoc$(0) = "..*$**.."
pomoc$(1) = ".*$###*."
pomoc$(2) = "**$$###*"
pomoc$(3) = "$#*$$#$*"
pomoc$(4) = "*:*#$$#$"
pomoc$(5) = "*$*$:$#*"
pomoc$(6) = ".*:*$**."
pomoc$(7) = "..:*:*.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 3 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 6 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 9 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 48: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), kamien
pomoc$(0) = ".###.###"
pomoc$(1) = ".###.###"
pomoc$(2) = ".###.###"
pomoc$(3) = "........"
pomoc$(4) = "##.###.#"
pomoc$(5) = "##.###.#"
pomoc$(6) = "##.###.#"
pomoc$(7) = "........"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 13 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), murek
pomoc$(0) = "$*******"
pomoc$(1) = "**#*$***"
pomoc$(2) = "*****$*$"
pomoc$(3) = "*$**#***"
pomoc$(4) = "***$**$*"
pomoc$(5) = "$******#"
pomoc$(6) = "**$**$**"
pomoc$(7) = "*#**$***"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 33: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 32: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 34: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), wegiel
pomoc$(0) = "########"
pomoc$(1) = "#**##**#"
pomoc$(2) = "#*.##*.#"
pomoc$(3) = "########"
pomoc$(4) = "########"
pomoc$(5) = "#**##**#"
pomoc$(6) = "#*.##*.#"
pomoc$(7) = "########"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 1 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 11 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), stal
CLS
pomoc$(0) = "#......#.#....#...#..#.."
pomoc$(1) = "@@....@@.@@..@@....@@..."
pomoc$(2) = "@$$..$$@..$$$$.....$$..."
pomoc$(3) = "*&*&*&*&..*&*&.....&*..."
pomoc$(4) = "&*&*&*&*..&*&*.....*&..."
pomoc$(5) = "@$$..$$@..$$$$.....$$..."
pomoc$(6) = "@@....@@.@@..@@....@@..."
pomoc$(7) = "#......#.#....#...#..#.."
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "&" THEN COLOR 2 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 11 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 8 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), motyl1
GET (8, 0)-(15, 7), motyl2
GET (16, 0)-(23, 7), motyl3
CLS
pomoc$(0) = "..@@@..."
pomoc$(1) = "..@@@..."
pomoc$(2) = "...@...."
pomoc$(3) = ".*****.."
pomoc$(4) = "*.***.*."
pomoc$(5) = "..###..."
pomoc$(6) = "..#.#..."
pomoc$(7) = ".##.##.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 15: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), gracz1
CLS
END SUB
SUB plansza (ktora)
IF ktora = 2 THEN GOTO plansza2
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%A++.OO.AOOAOAA.AAA%AAO++OA++A+AO+++O+O%"
tablica$(2) = "%OA.++A+++A+O+++OAO%O++AOA+A+A+AO+A+AA+%"
tablica$(3) = "%+A+A+++AOAAOAAOOAA%AAO+AOAOAAOAAAOAO++%"
tablica$(4) = "%O++MMMMMMMMMMMMMMM%+O+OOAAA+AAAOAO+AOA%"
tablica$(5) = "%AA+++AO++AAOAA+AAA%A+AO+++OAOOAAO++O++%"
tablica$(6) = "%+O+O++A.+AOO++O++O%+O+AAOA+OA+AO+AOA++%"
tablica$(7) = "%A+A+AOAAOAAAOAA+OA%AAAO+AAAOAOAAAO+OA+%"
tablica$(8) = "%MMMMMMMMMMMMMMM+++%A+AAAOAAOAAAAOO+A+A%"
tablica$(9) = "%AAAA++O++++O+.++A+%OAAA+OAAAOAAOAOOAAA%"
tablica$(10) = "%++O+++OA+++O++A+++%AOAAAAOAAOAAOAAAAAA%"
tablica$(11) = "%AOAOA+++.O.++++...%AAAOAOAAOAAAAAOOAOA%"
tablica$(12) = "%++++%%%%%%%%%%%%%%%%%%%%%%%%+%%%%%%%%%%"
tablica$(13) = "%+A+AA+AOA...++++++%++++...........++++%"
tablica$(14) = "%++++++++++..++.+++%+++.............+++%"
tablica$(15) = "%++++A+++AAA+++.++.%++...............++%"
tablica$(16) = "%++++++++++...+.+..%+.................+%"
tablica$(17) = "%+.++AAAOA++OAO.+++%...................%"
tablica$(18) = "%+.++++++++++++.+..%...................%"
tablica$(19) = "%+.......+++.++.+.++...................%"
tablica$(20) = "%+.+++++++++.++.+++....................%"
tablica$(21) = "%+.+++++++++.++.++.....................%"
tablica$(22) = "%+...++.........+......................%"
tablica$(23) = "%++++++++++++++++......................%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
GOTO wczytaj
plansza2:
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%A++.OOAAOOAOAA.AAA.AAO++OA++A+AO+++O+O%"
tablica$(2) = "%OA.++A+++A+O+++O.....+AOA+MMMMM++A+AA+%"
tablica$(3) = "%+A+A+++AOAAOAAOOAAMMMM+AOAOAAOAAAOAO++%"
tablica$(4) = "%O++.+++O...+++.OAAA+O+OOAAA+A.AOAO+AOA%"
tablica$(5) = "%AA+++AO++AAOAA+AAA+A+AO++++AAA+++AAO++%"
tablica$(6) = "%+O+OMMMMMMMO++O%%%%%%%%A.A+OA+AO+A++++%"
tablica$(7) = "%A+A+AOA++AOAOAA%......%+MMMMAOAAAO+OA+%"
tablica$(8) = "%A..AO...O++.O..%......%AOAAO+++AOO+A+A%"
tablica$(9) = "%AAAA++O++.+O+.+%......%+OA++OAAOAOOAAA%"
tablica$(10) = "%++O+A+OA+A+O++A%......%AAOAAOAAOAA.AAA%"
tablica$(11) = "%AO.OA+AAOA.+AA+%......%AO..OAA+++OOAOA%"
tablica$(12) = "%++OO..O.++OA..O%......%O.O+++.AA+A..O.%"
tablica$(13) = "%+A+AA+AOA.O.+++%......%..++AA.O..+++.+%"
tablica$(14) = "%++MMMMMMM+.OAA.%......%..MMMMMMMM...++%"
tablica$(15) = "%+O++A+++AAA+++.%......%.++++....AA..++%"
tablica$(16) = "%+AA++.O+++...+.%......%AAA+++AAOOAA..+%"
tablica$(17) = "%+.++AAAOA++OAO.%......%+...A.++++++.A.%"
tablica$(18) = "%+AA+.O+A+.+A.+.%%%%%%%%.AOO..+++.A.O..%"
tablica$(19) = "%+.AA....+.+.++.+.++.+++.....OOO...++++%"
tablica$(20) = "%+.+++MMMMMMMM+.+++..++AAOAAA+++...O+++%"
tablica$(21) = "%+.+.+++.+.+.++AA+..A.....+++++MMMMMM..%"
tablica$(22) = "%+.AA.O.A.AA.....O..MMMMMM.A+++.++++.A.%"
tablica$(23) = "%....++....O...O...+++...++..O..AA..A++%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
wczytaj:
FOR yd = 0 TO 24
FOR xd = 0 TO 39
tabl(xd, yd) = ASC(MID$(tablica$(yd), xd + 1, 1))
NEXT xd
NEXT yd
END SUB
|
|
| Powrót do góry |
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Piotr-246
Gość
|
| Wysłany: Nie 11:51, 27 Cze 2021 Temat postu: |
|
|
DECLARE SUB chrup ()
DECLARE SUB braniedia ()
DECLARE SUB beepkam (ulamek)
DECLARE SUB beepdia (ulamek)
DECLARE SUB plansza (ktora)
DECLARE SUB elementy ()
REM gra musi chodzic w trybie Turbo
SCREEN 13
DEF SEG = 0
DIM SHARED diament(0 TO 16) AS LONG
DIM SHARED diament2(0 TO 16) AS LONG
DIM SHARED diament3(0 TO 16) AS LONG
DIM SHARED diament4(0 TO 16) AS LONG
DIM SHARED kamien(0 TO 16) AS LONG
DIM SHARED czyste(0 TO 16) AS LONG
DIM SHARED murek(0 TO 16) AS LONG
DIM SHARED wegiel(0 TO 16) AS LONG
DIM SHARED stal(0 TO 16) AS LONG
DIM SHARED motyl1(0 TO 16) AS LONG
DIM SHARED motyl2(0 TO 16) AS LONG
DIM SHARED motyl3(0 TO 16) AS LONG
DIM SHARED lawa1(0 TO 16) AS LONG
DIM SHARED lawa2(0 TO 16) AS LONG
DIM SHARED lawa3(0 TO 16) AS LONG
DIM SHARED gracz1(0 TO 16) AS LONG
DIM SHARED pomoc$(0 TO 7)
DIM SHARED tablica$(0 TO 24)
DIM SHARED tabl(0 TO 39, 0 TO 24) AS INTEGER
DIM SHARED motx(0 TO 1) AS INTEGER
DIM SHARED moty(0 TO 1) AS INTEGER
DIM SHARED motw(0 TO 1) AS INTEGER
DIM SHARED stary.port
REM ************************ zaladowanie elementow graficznych
elementy
REM ****************************** zaladowanie planszy
restart:
plansza (1)
REM ************************ dane startowe
restart2:
CLS
x = 25: y = 18
tabl(x, y) = 2
xs = x: ys = y
faza = 0: fazamotyla = 0
REM *************************** petla glowna
petla:
key$ = ""
REM *************************** sprawdzenie tablicy
beepk = 0: beepd = 0
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("@") THEN tabl(xb, yb) = ASC("."): REM tymczasowa przerwa
spadk = 0: spadd = 0
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("O"): tabl(xb, yb) = ASC("@"): spadk = 1: GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("A"): tabl(xb, yb) = ASC("@"): spadd = 1: GOTO skok
END IF
REM znaki wieksze od ascii 64 powoduja upadek w bok
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("O"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("O"): tabl(xb, yb) = ASC(".")
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("A"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("A"): tabl(xb, yb) = ASC(".")
END IF
skok:
IF spadk = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepk = 1
END IF
IF spadd = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepd = 1
END IF
NEXT xb
NEXT yb
REM ****************** ruch motyli ***********************
FOR mot = 0 TO 1
mx = motx(mot)
my = moty(mot)
wektor = motw(mot)
ruch = 0
nie1 = 0: nie2 = 0: nie3 = 0: nie4 = 0
nie5 = 0: nie6 = 0: nie7 = 0: nie8 = 0
IF tabl(mx + 1, my - 1) <> ASC(".") THEN nie1 = 1
IF tabl(mx + 1, my) <> ASC(".") THEN nie2 = 1
IF tabl(mx + 1, my + 1) <> ASC(".") THEN nie3 = 1
IF tabl(mx, my + 1) <> ASC(".") THEN nie4 = 1
IF tabl(mx - 1, my + 1) <> ASC(".") THEN nie5 = 1
IF tabl(mx - 1, my) <> ASC(".") THEN nie6 = 1
IF tabl(mx - 1, my - 1) <> ASC(".") THEN nie7 = 1
IF tabl(mx, my - 1) <> ASC(".") THEN nie8 = 1
REM aby kontynuowal kierunek ruchu
powtorz = 0
IF wektor = 6 THEN GOTO wek6
IF wektor = 4 THEN GOTO wek4
IF wektor = 8 THEN GOTO wek8
jeszcze:
REM ruch w prawo
IF ruch = 0 AND nie8 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
IF ruch = 0 AND nie7 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
wek4:
REM ruch w dol
IF ruch = 0 AND nie2 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
IF ruch = 0 AND nie1 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
wek6:
REM ruch w lewo
IF ruch = 0 AND nie4 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
IF ruch = 0 AND nie3 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
wek8:
REM ruch w gore
IF ruch = 0 AND nie6 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
IF ruch = 0 AND nie5 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
REM sprawdz jeszcze raz
IF ruch = 0 AND powtorz = 0 AND (nie2 <> 0 OR nie4 <> 0 OR nie6 <> 0 OR nie8 <> 0) THEN powtorz = 1: GOTO jeszcze
REM motyl zapetlony w prozni
IF ruch = 0 AND nie2 = 0 AND nie4 = 0 AND nie6 = 0 AND nie8 = 0 THEN
IF fazamotyla = 0 THEN ruch = 1: wektor = 2
IF fazamotyla = 1 THEN ruch = 1: wektor = 4
IF fazamotyla = 2 THEN ruch = 1: wektor = 6
IF fazamotyla = 3 THEN ruch = 1: wektor = 8
END IF
REM wykonanie ruchu w tablicy
IF ruch = 1 AND wektor = 2 THEN tabl(mx, my) = ASC("."): mx = mx + 1
IF ruch = 1 AND wektor = 4 THEN tabl(mx, my) = ASC("."): my = my + 1
IF ruch = 1 AND wektor = 6 THEN tabl(mx, my) = ASC("."): mx = mx - 1
IF ruch = 1 AND wektor = 8 THEN tabl(mx, my) = ASC("."): my = my - 1
IF ruch = 0 THEN tabl(mx, my) = ASC("X")
IF ruch = 1 THEN tabl(mx, my) = ASC("X "): motx(mot) = mx: moty(mot) = my
motw(mot) = wektor
NEXT mot
REM losowe rozszerzanie lawy
FOR speed = 1 TO 8: REM szybkosc powiekszania alwy
xlos = INT(RND(1) * 37) + 1
ylos = INT(RND(1) * 22) + 1
IF tabl(xlos, ylos) = ASC("L") THEN
REM loslawa = INT(RND(1) * 4)
IF tabl(xlos - 1, ylos) = ASC(".") THEN tabl(xlos - 1, ylos) = ASC("L"): GOTO lawaend
IF tabl(xlos + 1, ylos) = ASC(".") THEN tabl(xlos + 1, ylos) = ASC("L"): GOTO lawaend
IF tabl(xlos, ylos - 1) = ASC(".") THEN tabl(xlos, ylos - 1) = ASC("L"): GOTO lawaend
IF tabl(xlos, ylos + 2) = ASC(".") THEN tabl(xlos, ylos + 1) = ASC("L")
lawaend:
END IF
NEXT speed
REM *************************** wyswietlenie tablicy
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("+") THEN PUT (xb * 8, yb * 8), wegiel, OR: GOTO wyjdz
IF pobrany = ASC("%") THEN PUT (xb * 8, yb * 8), stal, OR: GOTO wyjdz
IF pobrany = ASC("M") THEN PUT (xb * 8, yb * 8), murek, OR: GOTO wyjdz
REM czysczenie tylko pod niektore elementy
PUT (xb * 8, yb * 8), czyste, AND
IF pobrany = ASC("O") THEN PUT (xb * 8, yb * 8), kamien, OR
IF pobrany = ASC("X") THEN
IF fazamotyla = 0 THEN PUT (xb * 8, yb * 8), motyl1, OR
IF fazamotyla = 1 THEN PUT (xb * 8, yb * 8), motyl2, OR
IF fazamotyla = 2 THEN PUT (xb * 8, yb * 8), motyl3, OR
IF fazamotyla = 3 THEN PUT (xb * 8, yb * 8), motyl2, OR
END IF
REM falowanie diamentu:
IF pobrany = ASC("A") THEN
IF faza = 0 THEN PUT (xb * 8, yb * 8), diament, OR
IF faza = 1 THEN PUT (xb * 8, yb * 8), diament2, OR
IF faza = 2 THEN PUT (xb * 8, yb * 8), diament3, OR
IF faza = 3 THEN PUT (xb * 8, yb * 8), diament4, OR
END IF
REM falowanie lawy
IF pobrany = ASC("L") THEN
IF fazalawy = 0 THEN PUT (xb * 8, yb * 8), lawa1, OR
IF fazalawy = 1 THEN PUT (xb * 8, yb * 8), lawa2, OR
IF fazalawy = 2 THEN PUT (xb * 8, yb * 8), lawa3, OR
IF fazalawy = 3 THEN PUT (xb * 8, yb * 8), lawa2, OR
END IF
IF pobrany = 2 THEN PUT (xb * 8, yb * 8), gracz1, OR
wyjdz:
NEXT xb
IF beepk = 1 THEN beepkam (yb): GOTO skok3
IF beepd = 1 THEN beepdia (yb)
skok3:
NEXT yb
REM IF beepk = 1 THEN beepkam: GOTO skok2
skok2:
REM ************** zmiana fazy falowania motyli i diamentow:
faza = faza + 1
IF faza = 4 THEN faza = 0
fazamotyla = fazamotyla + 1
IF fazamotyla = 4 THEN fazamotyla = 0
fazalawy = fazalawy + 1
IF fazalawy = 4 THEN fazalawy = 0
REM ********************* obsluga klawiatury
IF key$ = "" THEN GOTO petla
k$ = key$
POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury
IF k$ = CHR$(27) THEN END
IF k$ = "r" OR k$ = "R" THEN GOTO restart
IF k$ = "2" THEN plansza (2): GOTO restart2
dx = 0: dy = 0
IF k$ = CHR$(0) + "M" THEN x = x + 1: dx = 1
IF k$ = CHR$(0) + "K" THEN x = x - 1: dx = -1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
REM ************ sprawdzenie czy wolno wykonac ruch
pobrany = tabl(x, y)
IF y = ys AND pobrany = ASC("O") THEN IF tabl(xs + dx * 2, y) = ASC(".") THEN tabl(xs + dx * 2, y) = ASC("O"): GOTO nowa
IF pobrany <> ASC(".") AND pobrany <> ASC("+") AND pobrany <> ASC("A") THEN x = xs: y = ys: GOTO petla
IF pobrany = ASC("+") THEN chrup
IF pobrany = ASC("A") THEN braniedia: REM SOUND 1600, 1: SOUND 900, 1
nowa:
REM ************* kasowanie w tablicy starej pozycji gracza
tabl(xs, ys) = ASC(".")
REM ************* wstawienie do tablicy nowej pozycji gracza
tabl(x, y) = 2
REM zapamietanie starej pozycji gracza
xs = x: ys = y
GOTO petla
SUB beepdia (ulamek)
IF ulamek < 24 GOTO pominstart
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
pominstart:
FOR i = 1 TO 1
OUT 66, 102: OUT 66, 1
OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 3
REM OUT 66, 250: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
IF ulamek > 0 THEN GOTO pominkoniec
REM wylaczenie glosnika
OUT 97, stary.port
pominkoniec:
END SUB
SUB beepkam (ulamek)
IF ulamek < 24 THEN GOTO ominto
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
ominto:
FOR i = 1 TO 15
OUT 66, 42: OUT 66, 0
OUT 66, 71: OUT 66, 3
OUT 66, 135: OUT 66, 1
REM OUT 66, 35: OUT 66, 1
REM OUT 66, 135: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
IF ulamek > 0 THEN GOTO omindrugie
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
omindrugie:
END SUB
SUB braniedia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 100 TO 1 STEP -1
OUT 66, i: OUT 66, 3
FOR j = 1 TO 150: NEXT j
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB chrup
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 0
OUT 66, 20: OUT 66, 0
OUT 66, 32: OUT 66, 0
NEXT i
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 54: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 60: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB elementy
REM zielony wegiel
PALETTE 32, 5 * 65536 + 12 * 256 + 0
PALETTE 33, 9 * 65536 + 14 * 256 + 2
PALETTE 34, 12 * 65536 + 18 * 256 + 6
REM odcienie kamienia +48
FOR i = 0 TO 15
PALETTE 48 + i, INT(i * 2.5) * 65536 + i * 3 * 256 + i * 4
NEXT i
REM odcienie diamentu +64
FOR i = 0 TO 15
PALETTE 64 + i, INT(i * 4) * 65536 + INT(i * 3.7) * 256 + INT(i * 3.2)
NEXT i
GET (0, 0)-(7, 7), czyste
pomoc$(0) = "...@@..."
pomoc$(1) = "..@$$@.."
pomoc$(2) = ".@****@."
pomoc$(3) = "@::::::@"
pomoc$(4) = "@######@"
pomoc$(5) = ".@$$$$@."
pomoc$(6) = "..@**@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament
pomoc$(0) = "...@@..."
pomoc$(1) = "..@**@.."
pomoc$(2) = ".@::::@."
pomoc$(3) = "@######@"
pomoc$(4) = "@$$$$$$@"
pomoc$(5) = ".@****@."
pomoc$(6) = "..@::@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament2
pomoc$(0) = "...@@..."
pomoc$(1) = "..@::@.."
pomoc$(2) = ".@####@."
pomoc$(3) = "@$$$$$$@"
pomoc$(4) = "@******@"
pomoc$(5) = ".@::::@."
pomoc$(6) = "..@##@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament3
pomoc$(0) = "...@@..."
pomoc$(1) = "..@##@.."
pomoc$(2) = ".@$$$$@."
pomoc$(3) = "@******@"
pomoc$(4) = "@::::::@"
pomoc$(5) = ".@####@."
pomoc$(6) = "..@$$@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament4
pomoc$(0) = "..*$**.."
pomoc$(1) = ".*$###*."
pomoc$(2) = "**$$###*"
pomoc$(3) = "$#*$$#$*"
pomoc$(4) = "*:*#$$#$"
pomoc$(5) = "*$*$:$#*"
pomoc$(6) = ".*:*$**."
pomoc$(7) = "..:*:*.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 3 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 6 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 9 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 48: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), kamien
pomoc$(0) = ".###.###"
pomoc$(1) = ".###.###"
pomoc$(2) = ".###.###"
pomoc$(3) = "........"
pomoc$(4) = "##.###.#"
pomoc$(5) = "##.###.#"
pomoc$(6) = "##.###.#"
pomoc$(7) = "........"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 13 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), murek
pomoc$(0) = "$*******"
pomoc$(1) = "**#*$***"
pomoc$(2) = "*****$*$"
pomoc$(3) = "*$**#***"
pomoc$(4) = "***$**$*"
pomoc$(5) = "$******#"
pomoc$(6) = "**$**$**"
pomoc$(7) = "*#**$***"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 33: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 32: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 34: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), wegiel
pomoc$(0) = "########"
pomoc$(1) = "#**##**#"
pomoc$(2) = "#*.##*.#"
pomoc$(3) = "########"
pomoc$(4) = "########"
pomoc$(5) = "#**##**#"
pomoc$(6) = "#*.##*.#"
pomoc$(7) = "########"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 1 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 11 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), stal
CLS
pomoc$(0) = "#......#.#....#...#..#.."
pomoc$(1) = "@@....@@.@@..@@....@@..."
pomoc$(2) = "@$$..$$@..$$$$.....$$..."
pomoc$(3) = "*&*&*&*&..*&*&.....&*..."
pomoc$(4) = "&*&*&*&*..&*&*.....*&..."
pomoc$(5) = "@$$..$$@..$$$$.....$$..."
pomoc$(6) = "@@....@@.@@..@@....@@..."
pomoc$(7) = "#......#.#....#...#..#.."
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "&" THEN COLOR 2 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 11 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 8 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), motyl1
GET (8, 0)-(15, 7), motyl2
GET (16, 0)-(23, 7), motyl3
CLS
pomoc$(0) = "..@@@..."
pomoc$(1) = "..@@@..."
pomoc$(2) = "...@...."
pomoc$(3) = ".*****.."
pomoc$(4) = "*.***.*."
pomoc$(5) = "..###..."
pomoc$(6) = "..#.#..."
pomoc$(7) = ".##.##.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 15: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), gracz1
CLS
pomoc$(0) = "#####################**#"
pomoc$(1) = "#####**######**#####****"
pomoc$(2) = "#############**#####****"
pomoc$(3) = "##**#################**#"
pomoc$(4) = "#****#####**############"
pomoc$(5) = "#****#####**######**####"
pomoc$(6) = "##**####################"
pomoc$(7) = "########################"
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), lawa1
GET (8, 0)-(15, 7), lawa2
GET (16, 0)-(23, 7), lawa3
CLS
END SUB
SUB plansza (ktora)
IF ktora = 2 THEN GOTO plansza2
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%A++.OO.AOOAOAA.AAA%AAO++OA++A+AO+++O+O%"
tablica$(2) = "%OA.++A+++A+O+++OAO%O++AOA+A+A+AO+A+AA+%"
tablica$(3) = "%+A+A+++AOAAOAAOOAA%AAO+AOAOAAOAAAOAO++%"
tablica$(4) = "%O++MMMMMMMMMMMMMMM%+O+OOAAA+AAAOAO+AOA%"
tablica$(5) = "%AA+++AO++AAOAA+AAA%A+AO+++OAOOAAO++O++%"
tablica$(6) = "%+O+O++A.+AOO++O++O%+O+AAOA+OA+AO+AOA++%"
tablica$(7) = "%A+A+AOAAOAAAOAA+OA%AAAO+AAAOAOAAAO+OA+%"
tablica$(8) = "%MMMMMMMMMMMMMMM+++%A+AAAOAAOAAAAOO+A+A%"
tablica$(9) = "%AAAA++O++++O+.++A+%OAAA+OAAAOAAOAOOAAA%"
tablica$(10) = "%++O+++OA+++O++A+++%AOAAAAOAAOAAOAAAAAA%"
tablica$(11) = "%AOAOA+++.O.++++...%AAAOAOAAOAAAAAOOAOA%"
tablica$(12) = "%++++%%%%%%%%%%%%%%%%%%%%%%%%+%%%%%%%%%%"
tablica$(13) = "%+.+AA+AOA...+++++++++++...........++++%"
tablica$(14) = "%+.++++++++..++.+++++++.............+++%"
tablica$(15) = "%+.++A+++AAA+++.++++++...............++%"
tablica$(16) = "%+.++++++++...+.+++++.................+%"
tablica$(17) = "%+.++AAAOA++OAO.+++%...................%"
tablica$(18) = "%+.++++++++++++.+..%...................%"
tablica$(19) = "%+.......+++.++.+.+%...................%"
tablica$(20) = "%+.+++++++++.++.+++%...................%"
tablica$(21) = "%+.+++++++++.++.++.%......LLLLLLL......%"
tablica$(22) = "%+...++.........+..%...LLLLLLLLLLLLL...%"
tablica$(23) = "%++++++++++++++++..%LLLLLLLLLLLLLLLLLLL%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
motx(0) = 15: moty(0) = 16: motw(0) = 2
motx(1) = 2: moty(1) = 22: motw(1) = 2
GOTO wczytaj
plansza2:
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%LLLLLOA.OOAO.A.AAA.AAO++OA++A+AO+++O+O%"
tablica$(2) = "%LLL++A+++A+.+++O.....+AOA++++++++A+AA+%"
tablica$(3) = "%LL+A+++.OAAO.AOOA++++..AOAMMMMAAAOAO++%"
tablica$(4) = "%O.+..++O...+++.%%%..%%%OAAA+A.AOAO+AOA%"
tablica$(5) = "%.A+++AO++AAOAA+%......%++++AAA+++AAO++%"
tablica$(6) = "%+O+OMMMMMMMO++O%......%A.A+OA+AO+A++++%"
tablica$(7) = "%A+A+AOA++AOAOAA%......%+++O++OAMMMMM++%"
tablica$(8) = "%A..AO...O++.O..%..OO..%AOAAO+++AOO+A+A%"
tablica$(9) = "%AAAA++O++.+O+.+%..++..%+OA++OAAOAOOAAA%"
tablica$(10) = "%++O+A+OA+A+O++A%.O++O.%AAOAAOAAOAA.AAA%"
tablica$(11) = "%A+.OA+AAOA.+AA+%.++++.%AO..OAA+++OOAOA%"
tablica$(12) = "%+++O..O.++OA..O%O+..+O%O.O+++.AA+A..O.%"
tablica$(13) = "%+A+AA+AOA.O.+++%+....+%..++AA.O..+++.+%"
tablica$(14) = "%MMMMMMMMM+.OAA.%A....A%.O....MMMMMMMMM%"
tablica$(15) = "%++++A+++AAA+++.%+A..A+%.++O.....AA..++%"
tablica$(16) = "%+AA++.O+++...+.%++AA++%AAA+++AA++AA..+%"
tablica$(17) = "%+.++AAAOA++OAO.%..AA..%+...A.++++++.A.%"
tablica$(18) = "%+AA+.O+A+.+A.+.%.A++A.%.AOO..+++.A....%"
tablica$(19) = "%+++++++++++++++%A++++A%+++++++++++++++%"
tablica$(20) = "%+%%%%%%%%%+++++%%%%%%%%+++++%%%%%%%%%+%"
tablica$(21) = "%+.....AAA%++++++++++++++++++%AAAAAAAAA%"
tablica$(22) = "%+MMMMMMMM%++++++++++++++++++%AOOOOOOOA%"
tablica$(23) = "%+.....AAA%++++++++++++++++++%AAAAAAAAA%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
motx(0) = 2: moty(0) = 21: motw(0) = 2
motx(1) = 2: moty(1) = 23: motw(1) = 2
wczytaj:
FOR yd = 0 TO 24
FOR xd = 0 TO 39
tabl(xd, yd) = ASC(MID$(tablica$(yd), xd + 1, 1))
NEXT xd
NEXT yd
END SUB
|
|
| Powrót do góry |
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Piotr-246
Gość
|
| Wysłany: Nie 16:23, 27 Cze 2021 Temat postu: |
|
|
DECLARE SUB chrup ()
DECLARE SUB braniedia ()
DECLARE SUB beepkam (ulamek)
DECLARE SUB beepdia (ulamek)
DECLARE SUB plansza (ktora)
DECLARE SUB elementy ()
REM gra musi chodzic w trybie Turbo
SCREEN 13
DEF SEG = 0
DIM SHARED diament(0 TO 16) AS LONG
DIM SHARED diament2(0 TO 16) AS LONG
DIM SHARED diament3(0 TO 16) AS LONG
DIM SHARED diament4(0 TO 16) AS LONG
DIM SHARED kamien(0 TO 16) AS LONG
DIM SHARED czyste(0 TO 16) AS LONG
DIM SHARED murek(0 TO 16) AS LONG
DIM SHARED wegiel(0 TO 16) AS LONG
DIM SHARED stal(0 TO 16) AS LONG
DIM SHARED motyl1(0 TO 16) AS LONG
DIM SHARED motyl2(0 TO 16) AS LONG
DIM SHARED motyl3(0 TO 16) AS LONG
DIM SHARED lawa1(0 TO 16) AS LONG
DIM SHARED lawa2(0 TO 16) AS LONG
DIM SHARED lawa3(0 TO 16) AS LONG
DIM SHARED gracz1(0 TO 16) AS LONG
DIM SHARED pomoc$(0 TO 7)
DIM SHARED tablica$(0 TO 24)
DIM SHARED tabl(0 TO 39, 0 TO 24) AS INTEGER
DIM SHARED motx(0 TO 1) AS INTEGER
DIM SHARED moty(0 TO 1) AS INTEGER
DIM SHARED motw(0 TO 1) AS INTEGER
DIM SHARED stary.port
REM ************************ zaladowanie elementow graficznych
elementy
REM ****************************** zaladowanie planszy
restart:
plansza (1)
REM ************************ dane startowe
restart2:
CLS
x = 25: y = 18
tabl(x, y) = 2
xs = x: ys = y
faza = 0: fazamotyla = 0
REM *************************** petla glowna
petla:
key$ = ""
REM *************************** sprawdzenie tablicy
beepk = 0: beepd = 0
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("@") THEN tabl(xb, yb) = ASC("."): REM tymczasowa przerwa
spadk = 0: spadd = 0
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("O"): tabl(xb, yb) = ASC("@"): spadk = 1: GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("A"): tabl(xb, yb) = ASC("@"): spadd = 1: GOTO skok
END IF
REM znaki wieksze od ascii 64 powoduja upadek w bok
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("O"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("O"): tabl(xb, yb) = ASC(".")
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("A"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("A"): tabl(xb, yb) = ASC(".")
END IF
skok:
IF spadk = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepk = 1
END IF
IF spadd = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepd = 1
END IF
NEXT xb
NEXT yb
REM ****************** ruch motyli ***********************
FOR mot = 0 TO 1
IF moty(mot) = 0 THEN GOTO wyjdzzpetli
mx = motx(mot)
my = moty(mot)
wektor = motw(mot)
REM sprawdzenie dotkniecia lawy
IF tabl(mx + 1, my + 1) = ASC("L") THEN xdz = mx: ydz = my: motx(mot) = 0: moty(mot) = 0: GOSUB dziewiatka: GOTO wyjdzzpetli
IF tabl(mx - 1, my - 1) = ASC("L") THEN xdz = mx: ydz = my: motx(mot) = 0: moty(mot) = 0: GOSUB dziewiatka: GOTO wyjdzzpetli
IF tabl(mx + 1, my - 1) = ASC("L") THEN xdz = mx: ydz = my: motx(mot) = 0: moty(mot) = 0: GOSUB dziewiatka: GOTO wyjdzzpetli
IF tabl(mx - 1, my + 1) = ASC("L") THEN xdz = mx: ydz = my: motx(mot) = 0: moty(mot) = 0: GOSUB dziewiatka: GOTO wyjdzzpetli
ruch = 0
nie1 = 0: nie2 = 0: nie3 = 0: nie4 = 0
nie5 = 0: nie6 = 0: nie7 = 0: nie8 = 0
IF tabl(mx + 1, my - 1) <> ASC(".") THEN nie1 = 1
IF tabl(mx + 1, my) <> ASC(".") THEN nie2 = 1
IF tabl(mx + 1, my + 1) <> ASC(".") THEN nie3 = 1
IF tabl(mx, my + 1) <> ASC(".") THEN nie4 = 1
IF tabl(mx - 1, my + 1) <> ASC(".") THEN nie5 = 1
IF tabl(mx - 1, my) <> ASC(".") THEN nie6 = 1
IF tabl(mx - 1, my - 1) <> ASC(".") THEN nie7 = 1
IF tabl(mx, my - 1) <> ASC(".") THEN nie8 = 1
REM aby kontynuowal kierunek ruchu
powtorz = 0
IF wektor = 6 THEN GOTO wek6
IF wektor = 4 THEN GOTO wek4
IF wektor = 8 THEN GOTO wek8
jeszcze:
REM ruch w prawo
IF ruch = 0 AND nie8 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
IF ruch = 0 AND nie7 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
wek4:
REM ruch w dol
IF ruch = 0 AND nie2 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
IF ruch = 0 AND nie1 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
wek6:
REM ruch w lewo
IF ruch = 0 AND nie4 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
IF ruch = 0 AND nie3 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
wek8:
REM ruch w gore
IF ruch = 0 AND nie6 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
IF ruch = 0 AND nie5 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
REM sprawdz jeszcze raz
IF ruch = 0 AND powtorz = 0 AND (nie2 <> 0 OR nie4 <> 0 OR nie6 <> 0 OR nie8 <> 0) THEN powtorz = 1: GOTO jeszcze
REM motyl zapetlony w prozni
IF ruch = 0 AND nie2 = 0 AND nie4 = 0 AND nie6 = 0 AND nie8 = 0 THEN
IF fazamotyla = 0 THEN ruch = 1: wektor = 2
IF fazamotyla = 1 THEN ruch = 1: wektor = 4
IF fazamotyla = 2 THEN ruch = 1: wektor = 6
IF fazamotyla = 3 THEN ruch = 1: wektor = 8
END IF
REM wykonanie ruchu w tablicy
IF ruch = 1 AND wektor = 2 THEN tabl(mx, my) = ASC("."): mx = mx + 1
IF ruch = 1 AND wektor = 4 THEN tabl(mx, my) = ASC("."): my = my + 1
IF ruch = 1 AND wektor = 6 THEN tabl(mx, my) = ASC("."): mx = mx - 1
IF ruch = 1 AND wektor = 8 THEN tabl(mx, my) = ASC("."): my = my - 1
IF ruch = 0 THEN tabl(mx, my) = ASC("X")
IF ruch = 1 THEN tabl(mx, my) = ASC("X "): motx(mot) = mx: moty(mot) = my
motw(mot) = wektor
wyjdzzpetli:
NEXT mot
REM losowe rozszerzanie lawy
FOR speed = 1 TO 8: REM szybkosc powiekszania alwy
xlos = INT(RND(1) * 37) + 1
ylos = INT(RND(1) * 22) + 1
IF tabl(xlos, ylos) = ASC("L") THEN
REM loslawa = INT(RND(1) * 4)
IF tabl(xlos - 1, ylos) = ASC(".") THEN tabl(xlos - 1, ylos) = ASC("L"): GOTO lawaend
IF tabl(xlos + 1, ylos) = ASC(".") THEN tabl(xlos + 1, ylos) = ASC("L"): GOTO lawaend
IF tabl(xlos, ylos - 1) = ASC(".") THEN tabl(xlos, ylos - 1) = ASC("L"): GOTO lawaend
IF tabl(xlos, ylos + 2) = ASC(".") THEN tabl(xlos, ylos + 1) = ASC("L")
lawaend:
END IF
NEXT speed
REM *************************** wyswietlenie tablicy
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("+") THEN PUT (xb * 8, yb * 8), wegiel, OR: GOTO wyjdz
IF pobrany = ASC("%") THEN PUT (xb * 8, yb * 8), stal, OR: GOTO wyjdz
IF pobrany = ASC("M") THEN PUT (xb * 8, yb * 8), murek, OR: GOTO wyjdz
REM czysczenie tylko pod niektore elementy
PUT (xb * 8, yb * 8), czyste, AND
IF pobrany = ASC("O") THEN PUT (xb * 8, yb * 8), kamien, OR
IF pobrany = ASC("X") THEN
IF fazamotyla = 0 THEN PUT (xb * 8, yb * 8), motyl1, OR
IF fazamotyla = 1 THEN PUT (xb * 8, yb * 8), motyl2, OR
IF fazamotyla = 2 THEN PUT (xb * 8, yb * 8), motyl3, OR
IF fazamotyla = 3 THEN PUT (xb * 8, yb * 8), motyl2, OR
END IF
REM falowanie diamentu:
IF pobrany = ASC("A") THEN
IF faza = 0 THEN PUT (xb * 8, yb * 8), diament, OR
IF faza = 1 THEN PUT (xb * 8, yb * 8), diament2, OR
IF faza = 2 THEN PUT (xb * 8, yb * 8), diament3, OR
IF faza = 3 THEN PUT (xb * 8, yb * 8), diament4, OR
END IF
REM falowanie lawy
IF pobrany = ASC("L") THEN
IF fazalawy = 0 THEN PUT (xb * 8, yb * 8), lawa1, OR
IF fazalawy = 1 THEN PUT (xb * 8, yb * 8), lawa2, OR
IF fazalawy = 2 THEN PUT (xb * 8, yb * 8), lawa3, OR
IF fazalawy = 3 THEN PUT (xb * 8, yb * 8), lawa2, OR
END IF
IF pobrany = 2 THEN PUT (xb * 8, yb * 8), gracz1, OR
wyjdz:
NEXT xb
IF beepk = 1 THEN beepkam (yb): GOTO skok3
IF beepd = 1 THEN beepdia (yb)
skok3:
NEXT yb
REM IF beepk = 1 THEN beepkam: GOTO skok2
skok2:
REM ************** zmiana fazy falowania motyli i diamentow:
faza = faza + 1
IF faza = 4 THEN faza = 0
fazamotyla = fazamotyla + 1
IF fazamotyla = 4 THEN fazamotyla = 0
fazalawy = fazalawy + 1
IF fazalawy = 4 THEN fazalawy = 0
REM ********************* obsluga klawiatury
IF key$ = "" THEN GOTO petla
k$ = key$
POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury
IF k$ = CHR$(27) THEN END
IF k$ = "1" THEN GOTO restart
IF k$ = "2" THEN plansza (2): GOTO restart2
dx = 0: dy = 0
IF k$ = CHR$(0) + "M" THEN x = x + 1: dx = 1
IF k$ = CHR$(0) + "K" THEN x = x - 1: dx = -1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
REM ************ sprawdzenie czy wolno wykonac ruch
pobrany = tabl(x, y)
IF y = ys AND pobrany = ASC("O") THEN IF tabl(xs + dx * 2, y) = ASC(".") THEN tabl(xs + dx * 2, y) = ASC("O"): GOTO nowa
IF pobrany <> ASC(".") AND pobrany <> ASC("+") AND pobrany <> ASC("A") THEN x = xs: y = ys: GOTO petla
IF pobrany = ASC("+") THEN chrup
IF pobrany = ASC("A") THEN braniedia: REM SOUND 1600, 1: SOUND 900, 1
nowa:
REM ************* kasowanie w tablicy starej pozycji gracza
tabl(xs, ys) = ASC(".")
REM ************* wstawienie do tablicy nowej pozycji gracza
tabl(x, y) = 2
REM zapamietanie starej pozycji gracza
xs = x: ys = y
GOTO petla
REM ****** dziewiec diamentow za motyla
dziewiatka:
FOR yy = ydz - 1 TO ydz + 1
FOR xx = xdz - 1 TO xdz + 1
IF tabl(xx, yy) <> ASC("%") THEN tabl(xx, yy) = ASC("A")
NEXT xx
NEXT yy
RETURN
SUB beepdia (ulamek)
IF ulamek < 24 GOTO pominstart
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
pominstart:
FOR i = 1 TO 1
OUT 66, 102: OUT 66, 1
OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 3
REM OUT 66, 250: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
IF ulamek > 0 THEN GOTO pominkoniec
REM wylaczenie glosnika
OUT 97, stary.port
pominkoniec:
END SUB
SUB beepkam (ulamek)
IF ulamek < 24 THEN GOTO ominto
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
ominto:
FOR i = 1 TO 15
OUT 66, 42: OUT 66, 0
OUT 66, 71: OUT 66, 3
OUT 66, 135: OUT 66, 1
REM OUT 66, 35: OUT 66, 1
REM OUT 66, 135: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
IF ulamek > 0 THEN GOTO omindrugie
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
omindrugie:
END SUB
SUB braniedia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 100 TO 1 STEP -1
OUT 66, i: OUT 66, 3
FOR j = 1 TO 150: NEXT j
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB chrup
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 0
OUT 66, 20: OUT 66, 0
OUT 66, 32: OUT 66, 0
NEXT i
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 54: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 60: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB elementy
REM zielony wegiel
PALETTE 32, 5 * 65536 + 12 * 256 + 0
PALETTE 33, 9 * 65536 + 14 * 256 + 2
PALETTE 34, 12 * 65536 + 18 * 256 + 6
REM odcienie kamienia +48
FOR i = 0 TO 15
PALETTE 48 + i, INT(i * 2.5) * 65536 + i * 3 * 256 + i * 4
NEXT i
REM odcienie diamentu +64
FOR i = 0 TO 15
PALETTE 64 + i, INT(i * 4) * 65536 + INT(i * 3.7) * 256 + INT(i * 3.2)
NEXT i
GET (0, 0)-(7, 7), czyste
pomoc$(0) = "...@@......@@..."
pomoc$(1) = "..@$$@....@**@.."
pomoc$(2) = ".@****@..@::::@."
pomoc$(3) = "@::::::@@######@"
pomoc$(4) = "@######@@$$$$$$@"
pomoc$(5) = ".@$$$$@..@****@."
pomoc$(6) = "..@**@....@::@.."
pomoc$(7) = "...@@......@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 15
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament
GET (8, 0)-(15, 7), diament2
pomoc$(0) = "...@@..."
pomoc$(1) = "..@::@.."
pomoc$(2) = ".@####@."
pomoc$(3) = "@$$$$$$@"
pomoc$(4) = "@******@"
pomoc$(5) = ".@::::@."
pomoc$(6) = "..@##@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament3
pomoc$(0) = "...@@..."
pomoc$(1) = "..@##@.."
pomoc$(2) = ".@$$$$@."
pomoc$(3) = "@******@"
pomoc$(4) = "@::::::@"
pomoc$(5) = ".@####@."
pomoc$(6) = "..@$$@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament4
pomoc$(0) = "..*$**.."
pomoc$(1) = ".*$###*."
pomoc$(2) = "**$$###*"
pomoc$(3) = "$#*$$#$*"
pomoc$(4) = "*:*#$$#$"
pomoc$(5) = "*$*$:$#*"
pomoc$(6) = ".*:*$**."
pomoc$(7) = "..:*:*.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 3 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 6 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 9 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 48: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), kamien
pomoc$(0) = ".###.###"
pomoc$(1) = ".###.###"
pomoc$(2) = ".###.###"
pomoc$(3) = "........"
pomoc$(4) = "##.###.#"
pomoc$(5) = "##.###.#"
pomoc$(6) = "##.###.#"
pomoc$(7) = "........"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 13 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), murek
pomoc$(0) = "$*******"
pomoc$(1) = "**#*$***"
pomoc$(2) = "*****$*$"
pomoc$(3) = "*$**#***"
pomoc$(4) = "***$**$*"
pomoc$(5) = "$******#"
pomoc$(6) = "**$**$**"
pomoc$(7) = "*#**$***"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 33: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 32: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 34: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), wegiel
pomoc$(0) = "########"
pomoc$(1) = "#**##**#"
pomoc$(2) = "#*.##*.#"
pomoc$(3) = "########"
pomoc$(4) = "########"
pomoc$(5) = "#**##**#"
pomoc$(6) = "#*.##*.#"
pomoc$(7) = "########"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 1 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 11 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), stal
CLS
pomoc$(0) = "#......#.#....#...#..#.."
pomoc$(1) = "@@....@@.@@..@@....@@..."
pomoc$(2) = "@$$..$$@..$$$$.....$$..."
pomoc$(3) = "*&*&*&*&..*&*&.....&*..."
pomoc$(4) = "&*&*&*&*..&*&*.....*&..."
pomoc$(5) = "@$$..$$@..$$$$.....$$..."
pomoc$(6) = "@@....@@.@@..@@....@@..."
pomoc$(7) = "#......#.#....#...#..#.."
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "&" THEN COLOR 2 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 11 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 8 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), motyl1
GET (8, 0)-(15, 7), motyl2
GET (16, 0)-(23, 7), motyl3
CLS
pomoc$(0) = "..@@@..."
pomoc$(1) = "..@@@..."
pomoc$(2) = "...@...."
pomoc$(3) = ".*****.."
pomoc$(4) = "*.***.*."
pomoc$(5) = "..###..."
pomoc$(6) = "..#.#..."
pomoc$(7) = ".##.##.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 15: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), gracz1
CLS
pomoc$(0) = "#####################**#"
pomoc$(1) = "#####**######**#####****"
pomoc$(2) = "#############**#####****"
pomoc$(3) = "##**#################**#"
pomoc$(4) = "#****#####**############"
pomoc$(5) = "#****#####**######**####"
pomoc$(6) = "##**####################"
pomoc$(7) = "########################"
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), lawa1
GET (8, 0)-(15, 7), lawa2
GET (16, 0)-(23, 7), lawa3
CLS
END SUB
SUB plansza (ktora)
IF ktora = 2 THEN GOTO plansza2
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%A++.OO.AOOAOAA.AAA%AAO++OA++A+AO+++O+O%"
tablica$(2) = "%OA.++A+++A+O+++OAO%O++AOA+A+A+AO+A+AA+%"
tablica$(3) = "%+A+A+++AOAAOAAOOAA%AAO+AOAOAAOAAAOAO++%"
tablica$(4) = "%O++MMMMMMMMMMMMMMM%+O+OOAAA+AAAOAO+AOA%"
tablica$(5) = "%AA+++AO++AAOAA+AAA%A+AO+++OAOOAAO++O++%"
tablica$(6) = "%+O+O++A.+AOO++O++O%+O+AAOA+OA+AO+AOA++%"
tablica$(7) = "%A+A+AOAAOAAAOAA+OA%AAAO+AAAOAOAAAO+OA+%"
tablica$(8) = "%MMMMMMMMMMMMMMM+++%A+AAAOAAOAAAAOO+A+A%"
tablica$(9) = "%AAAA++O++++O+.++A+%OAAA+OAAAOAAOAOOAAA%"
tablica$(10) = "%++O+++OA+++O++A+++%AOAAAAOAAOAAOAAAAAA%"
tablica$(11) = "%AOAOA+++.O.++++...%AAAOAOAAOAAAAAOOAOA%"
tablica$(12) = "%++++%%%%%%%%%%%%%%%%%%%%%%%%+%%%%%%%%%%"
tablica$(13) = "%+.+AA+AOA...+++++++++++...........++++%"
tablica$(14) = "%+.++++++++..++.+++++++.............+++%"
tablica$(15) = "%+.++A+++AAA+++.++++++...............++%"
tablica$(16) = "%+.++++++++...+.+++++.................+%"
tablica$(17) = "%+.++AAAOA++OAO.+++%...................%"
tablica$(18) = "%+.++++++++++++.+..%...................%"
tablica$(19) = "%+.......+++.++.+.+%...................%"
tablica$(20) = "%+.+++++++++.++.+++%...................%"
tablica$(21) = "%+.+++++++++.++.++.%...................%"
tablica$(22) = "%+...++.........+..%...................%"
tablica$(23) = "%++++++++++++++++..%.....LLLLLLLLL.....%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
motx(0) = 15: moty(0) = 16: motw(0) = 2
motx(1) = 2: moty(1) = 22: motw(1) = 2
GOTO wczytaj
plansza2:
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%LLLLLLL.O.AO.A.AAA.AAO++OA++A+AO+++O+O%"
tablica$(2) = "%LLLLL.+.+A+.+++O.....+AOA++++++++A+AA+%"
tablica$(3) = "%LL..+.+.O.AO.AOOA++++..AOAMMMMAAAOAO++%"
tablica$(4) = "%L.+..++O...+++.%%%..%%%OAAA+A.AOAO+AOA%"
tablica$(5) = "%.A++.AO++A.OAA+%......%++++AAA+++AAO++%"
tablica$(6) = "%+O+.MMMMMMMO++O%......%A.A+OA+AO+A++++%"
tablica$(7) = "%A+.+A.A++AO.O.A%......%+++O++OAMMMMM++%"
tablica$(8) = "%A..AO...O++.O..%..OO..%AOAAO+++AOO+A+A%"
tablica$(9) = "%AA.A+.O.+.+O+.+%..++..%+OA++OAAOAOOAAA%"
tablica$(10) = "%++O+A.OA.A+O++A%.O++O.%AAOAAOAAOAA.AAA%"
tablica$(11) = "%A+.OA+AAOA.+AA+%.++++.%AO..OAA+++OOAOA%"
tablica$(12) = "%+++O..O.++OA..O%O+..+O%O.O+++.AA+A..O.%"
tablica$(13) = "%+A+AA+AOA.O.+++%+....+%..++AA.O..+++.+%"
tablica$(14) = "%MMMMMMMMM+.OAA.%A....A%MMMMM.....MMMMM%"
tablica$(15) = "%++++A+++AAA+++.%+A..A+%.++O.....AA..++%"
tablica$(16) = "%+AA++.O+++...+.%++AA++%AAA+++AA++AA..+%"
tablica$(17) = "%+.++AAAOA++OAO.%..AA..%+...A.++++++.A.%"
tablica$(18) = "%+AA+.O+A+.+A.+.%.A++A.%.AOO..+++.A....%"
tablica$(19) = "%+++++++++++++++%A++++A%+++++++++++++++%"
tablica$(20) = "%+%%%%%%%%%+++++%%%%%%%%+++++%%%%%%%%%+%"
tablica$(21) = "%+.....AAA%++++++++++++++++++%AAAAAAAAA%"
tablica$(22) = "%+MMMMMMMM%++++++++++++++++++%AOOOOOOOA%"
tablica$(23) = "%+.....AAA%++++++++++++++++++%AAAAAAAAA%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
motx(0) = 2: moty(0) = 21: motw(0) = 2
motx(1) = 2: moty(1) = 23: motw(1) = 2
wczytaj:
FOR yd = 0 TO 24
FOR xd = 0 TO 39
tabl(xd, yd) = ASC(MID$(tablica$(yd), xd + 1, 1))
NEXT xd
NEXT yd
END SUB
|
|
| Powrót do góry |
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Piotr-246
Gość
|
| Wysłany: Nie 16:47, 27 Cze 2021 Temat postu: |
|
|
DECLARE SUB chrup ()
DECLARE SUB braniedia ()
DECLARE SUB beepkam (ulamek)
DECLARE SUB beepdia (ulamek)
DECLARE SUB plansza (ktora)
DECLARE SUB elementy ()
REM gra musi chodzic w trybie Turbo
SCREEN 13
DEF SEG = 0
DIM SHARED diament(0 TO 16) AS LONG
DIM SHARED diament2(0 TO 16) AS LONG
DIM SHARED diament3(0 TO 16) AS LONG
DIM SHARED diament4(0 TO 16) AS LONG
DIM SHARED kamien(0 TO 16) AS LONG
DIM SHARED czyste(0 TO 16) AS LONG
DIM SHARED murek(0 TO 16) AS LONG
DIM SHARED wegiel(0 TO 16) AS LONG
DIM SHARED stal(0 TO 16) AS LONG
DIM SHARED motyl1(0 TO 16) AS LONG
DIM SHARED motyl2(0 TO 16) AS LONG
DIM SHARED motyl3(0 TO 16) AS LONG
DIM SHARED lawa1(0 TO 16) AS LONG
DIM SHARED lawa2(0 TO 16) AS LONG
DIM SHARED lawa3(0 TO 16) AS LONG
DIM SHARED gracz1(0 TO 16) AS LONG
DIM SHARED pomoc$(0 TO 7)
DIM SHARED tablica$(0 TO 24)
DIM SHARED tabl(0 TO 39, 0 TO 24) AS INTEGER
DIM SHARED motx(0 TO 1) AS INTEGER
DIM SHARED moty(0 TO 1) AS INTEGER
DIM SHARED motw(0 TO 1) AS INTEGER
DIM SHARED stary.port
REM ************************ zaladowanie elementow graficznych
elementy
REM ****************************** zaladowanie planszy
restart:
plansza (1)
REM ************************ dane startowe
restart2:
CLS
x = 25: y = 18
tabl(x, y) = 2
xs = x: ys = y
faza = 0: fazamotyla = 0
REM *************************** petla glowna
petla:
key$ = ""
REM *************************** sprawdzenie tablicy
beepk = 0: beepd = 0
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("@") THEN tabl(xb, yb) = ASC("."): REM tymczasowa przerwa
spadk = 0: spadd = 0
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("O"): tabl(xb, yb) = ASC("@"): spadk = 1: GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("A"): tabl(xb, yb) = ASC("@"): spadd = 1: GOTO skok
END IF
REM znaki wieksze od ascii 64 powoduja upadek w bok
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("O"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("O"): tabl(xb, yb) = ASC(".")
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("A"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("A"): tabl(xb, yb) = ASC(".")
END IF
skok:
REM dzwiek upadku
IF spadk = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepk = 1
IF tabl(xb, yb + 2) = ASC("X") THEN xdz = xb: ydz = yb + 2: GOSUB dziewiatka
END IF
IF spadd = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepd = 1
IF tabl(xb, yb + 2) = ASC("X") THEN xdz = xb: ydz = yb + 2: GOSUB dziewiatka
END IF
NEXT xb
NEXT yb
REM ****************** ruch motyli ***********************
FOR mot = 0 TO 1
IF moty(mot) = 0 THEN GOTO wyjdzzpetli
mx = motx(mot)
my = moty(mot)
wektor = motw(mot)
REM sprawdzenie dotkniecia lawy
styk = 0
IF tabl(mx + 1, my) = ASC("L") THEN styk = 1
IF tabl(mx - 1, my) = ASC("L") THEN styk = 1
IF tabl(mx, my - 1) = ASC("L") THEN styk = 1
IF tabl(mx, my + 1) = ASC("L") THEN styk = 1
IF styk = 1 THEN xdz = mx: ydz = my: GOSUB dziewiatka: GOTO wyjdzzpetli
ruch = 0
nie1 = 0: nie2 = 0: nie3 = 0: nie4 = 0
nie5 = 0: nie6 = 0: nie7 = 0: nie8 = 0
IF tabl(mx + 1, my - 1) <> ASC(".") THEN nie1 = 1
IF tabl(mx + 1, my) <> ASC(".") THEN nie2 = 1
IF tabl(mx + 1, my + 1) <> ASC(".") THEN nie3 = 1
IF tabl(mx, my + 1) <> ASC(".") THEN nie4 = 1
IF tabl(mx - 1, my + 1) <> ASC(".") THEN nie5 = 1
IF tabl(mx - 1, my) <> ASC(".") THEN nie6 = 1
IF tabl(mx - 1, my - 1) <> ASC(".") THEN nie7 = 1
IF tabl(mx, my - 1) <> ASC(".") THEN nie8 = 1
REM aby kontynuowal kierunek ruchu
powtorz = 0
IF wektor = 6 THEN GOTO wek6
IF wektor = 4 THEN GOTO wek4
IF wektor = 8 THEN GOTO wek8
jeszcze:
REM ruch w prawo
IF ruch = 0 AND nie8 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
IF ruch = 0 AND nie7 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
wek4:
REM ruch w dol
IF ruch = 0 AND nie2 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
IF ruch = 0 AND nie1 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
wek6:
REM ruch w lewo
IF ruch = 0 AND nie4 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
IF ruch = 0 AND nie3 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
wek8:
REM ruch w gore
IF ruch = 0 AND nie6 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
IF ruch = 0 AND nie5 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
REM sprawdz jeszcze raz
IF ruch = 0 AND powtorz = 0 AND (nie2 <> 0 OR nie4 <> 0 OR nie6 <> 0 OR nie8 <> 0) THEN powtorz = 1: GOTO jeszcze
REM motyl zapetlony w prozni
IF ruch = 0 AND nie2 = 0 AND nie4 = 0 AND nie6 = 0 AND nie8 = 0 THEN
IF fazamotyla = 0 THEN ruch = 1: wektor = 2
IF fazamotyla = 1 THEN ruch = 1: wektor = 4
IF fazamotyla = 2 THEN ruch = 1: wektor = 6
IF fazamotyla = 3 THEN ruch = 1: wektor = 8
END IF
REM wykonanie ruchu w tablicy
IF ruch = 1 AND wektor = 2 THEN tabl(mx, my) = ASC("."): mx = mx + 1
IF ruch = 1 AND wektor = 4 THEN tabl(mx, my) = ASC("."): my = my + 1
IF ruch = 1 AND wektor = 6 THEN tabl(mx, my) = ASC("."): mx = mx - 1
IF ruch = 1 AND wektor = 8 THEN tabl(mx, my) = ASC("."): my = my - 1
IF ruch = 0 THEN tabl(mx, my) = ASC("X")
IF ruch = 1 THEN tabl(mx, my) = ASC("X "): motx(mot) = mx: moty(mot) = my
motw(mot) = wektor
wyjdzzpetli:
NEXT mot
REM losowe rozszerzanie lawy
FOR speed = 1 TO 8: REM szybkosc powiekszania alwy
xlos = INT(RND(1) * 37) + 1
ylos = INT(RND(1) * 22) + 1
IF tabl(xlos, ylos) = ASC("L") THEN
REM loslawa = INT(RND(1) * 4)
IF tabl(xlos - 1, ylos) = ASC(".") THEN tabl(xlos - 1, ylos) = ASC("L"): GOTO lawaend
IF tabl(xlos + 1, ylos) = ASC(".") THEN tabl(xlos + 1, ylos) = ASC("L"): GOTO lawaend
IF tabl(xlos, ylos - 1) = ASC(".") THEN tabl(xlos, ylos - 1) = ASC("L"): GOTO lawaend
IF tabl(xlos, ylos + 2) = ASC(".") THEN tabl(xlos, ylos + 1) = ASC("L")
lawaend:
END IF
NEXT speed
REM *************************** wyswietlenie tablicy
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("+") THEN PUT (xb * 8, yb * 8), wegiel, OR: GOTO wyjdz
IF pobrany = ASC("%") THEN PUT (xb * 8, yb * 8), stal, OR: GOTO wyjdz
IF pobrany = ASC("M") THEN PUT (xb * 8, yb * 8), murek, OR: GOTO wyjdz
REM czysczenie tylko pod niektore elementy
PUT (xb * 8, yb * 8), czyste, AND
IF pobrany = ASC("O") THEN PUT (xb * 8, yb * 8), kamien, OR
IF pobrany = ASC("X") THEN
IF fazamotyla = 0 THEN PUT (xb * 8, yb * 8), motyl1, OR
IF fazamotyla = 1 THEN PUT (xb * 8, yb * 8), motyl2, OR
IF fazamotyla = 2 THEN PUT (xb * 8, yb * 8), motyl3, OR
IF fazamotyla = 3 THEN PUT (xb * 8, yb * 8), motyl2, OR
END IF
REM falowanie diamentu:
IF pobrany = ASC("A") THEN
IF faza = 0 THEN PUT (xb * 8, yb * 8), diament, OR
IF faza = 1 THEN PUT (xb * 8, yb * 8), diament2, OR
IF faza = 2 THEN PUT (xb * 8, yb * 8), diament3, OR
IF faza = 3 THEN PUT (xb * 8, yb * 8), diament4, OR
END IF
REM falowanie lawy
IF pobrany = ASC("L") THEN
IF fazalawy = 0 THEN PUT (xb * 8, yb * 8), lawa1, OR
IF fazalawy = 1 THEN PUT (xb * 8, yb * 8), lawa2, OR
IF fazalawy = 2 THEN PUT (xb * 8, yb * 8), lawa3, OR
IF fazalawy = 3 THEN PUT (xb * 8, yb * 8), lawa2, OR
END IF
IF pobrany = 2 THEN PUT (xb * 8, yb * 8), gracz1, OR
wyjdz:
NEXT xb
IF beepk = 1 THEN beepkam (yb): GOTO skok3
IF beepd = 1 THEN beepdia (yb)
skok3:
NEXT yb
REM IF beepk = 1 THEN beepkam: GOTO skok2
skok2:
REM ************** zmiana fazy falowania motyli i diamentow:
faza = faza + 1
IF faza = 4 THEN faza = 0
fazamotyla = fazamotyla + 1
IF fazamotyla = 4 THEN fazamotyla = 0
fazalawy = fazalawy + 1
IF fazalawy = 4 THEN fazalawy = 0
REM ********************* obsluga klawiatury
IF key$ = "" THEN GOTO petla
k$ = key$
POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury
IF k$ = CHR$(27) THEN END
IF k$ = "1" THEN GOTO restart
IF k$ = "2" THEN plansza (2): GOTO restart2
dx = 0: dy = 0
IF k$ = CHR$(0) + "M" THEN x = x + 1: dx = 1
IF k$ = CHR$(0) + "K" THEN x = x - 1: dx = -1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
REM ************ sprawdzenie czy wolno wykonac ruch
pobrany = tabl(x, y)
IF y = ys AND pobrany = ASC("O") THEN IF tabl(xs + dx * 2, y) = ASC(".") THEN tabl(xs + dx * 2, y) = ASC("O"): GOTO nowa
IF pobrany <> ASC(".") AND pobrany <> ASC("+") AND pobrany <> ASC("A") THEN x = xs: y = ys: GOTO petla
IF pobrany = ASC("+") THEN chrup
IF pobrany = ASC("A") THEN braniedia: REM SOUND 1600, 1: SOUND 900, 1
nowa:
REM ************* kasowanie w tablicy starej pozycji gracza
tabl(xs, ys) = ASC(".")
REM ************* wstawienie do tablicy nowej pozycji gracza
tabl(x, y) = 2
REM zapamietanie starej pozycji gracza
xs = x: ys = y
GOTO petla
REM ****** dziewiec diamentow za motyla
dziewiatka:
FOR yy = ydz - 1 TO ydz + 1
FOR xx = xdz - 1 TO xdz + 1
IF tabl(xx, yy) <> ASC("%") THEN tabl(xx, yy) = ASC("A")
NEXT xx
NEXT yy
REM ktory motyl?
FOR ktory = 0 TO 1
IF motx(ktory) = xdz AND moty(ktory) = ydz THEN motx(ktory) = 0: moty(ktory) = 0
NEXT ktory
RETURN
SUB beepdia (ulamek)
IF ulamek < 24 GOTO pominstart
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
pominstart:
FOR i = 1 TO 1
OUT 66, 102: OUT 66, 1
OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 3
REM OUT 66, 250: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
IF ulamek > 0 THEN GOTO pominkoniec
REM wylaczenie glosnika
OUT 97, stary.port
pominkoniec:
END SUB
SUB beepkam (ulamek)
IF ulamek < 24 THEN GOTO ominto
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
ominto:
FOR i = 1 TO 15
OUT 66, 42: OUT 66, 0
OUT 66, 71: OUT 66, 3
OUT 66, 135: OUT 66, 1
REM OUT 66, 35: OUT 66, 1
REM OUT 66, 135: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
IF ulamek > 0 THEN GOTO omindrugie
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
omindrugie:
END SUB
SUB braniedia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 100 TO 1 STEP -1
OUT 66, i: OUT 66, 3
FOR j = 1 TO 150: NEXT j
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB chrup
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 0
OUT 66, 20: OUT 66, 0
OUT 66, 32: OUT 66, 0
NEXT i
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 54: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 60: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB elementy
REM zielony wegiel
PALETTE 32, 5 * 65536 + 12 * 256 + 0
PALETTE 33, 9 * 65536 + 14 * 256 + 2
PALETTE 34, 12 * 65536 + 18 * 256 + 6
REM odcienie kamienia +48
FOR i = 0 TO 15
PALETTE 48 + i, INT(i * 2.5) * 65536 + i * 3 * 256 + i * 4
NEXT i
REM odcienie diamentu +64
FOR i = 0 TO 15
PALETTE 64 + i, INT(i * 4) * 65536 + INT(i * 3.7) * 256 + INT(i * 3.2)
NEXT i
GET (0, 0)-(7, 7), czyste
pomoc$(0) = "...@@......@@..."
pomoc$(1) = "..@$$@....@**@.."
pomoc$(2) = ".@****@..@::::@."
pomoc$(3) = "@::::::@@######@"
pomoc$(4) = "@######@@$$$$$$@"
pomoc$(5) = ".@$$$$@..@****@."
pomoc$(6) = "..@**@....@::@.."
pomoc$(7) = "...@@......@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 15
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament
GET (8, 0)-(15, 7), diament2
pomoc$(0) = "...@@..."
pomoc$(1) = "..@::@.."
pomoc$(2) = ".@####@."
pomoc$(3) = "@$$$$$$@"
pomoc$(4) = "@******@"
pomoc$(5) = ".@::::@."
pomoc$(6) = "..@##@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament3
pomoc$(0) = "...@@..."
pomoc$(1) = "..@##@.."
pomoc$(2) = ".@$$$$@."
pomoc$(3) = "@******@"
pomoc$(4) = "@::::::@"
pomoc$(5) = ".@####@."
pomoc$(6) = "..@$$@.."
pomoc$(7) = "...@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament4
pomoc$(0) = "..*$**.."
pomoc$(1) = ".*$###*."
pomoc$(2) = "**$$###*"
pomoc$(3) = "$#*$$#$*"
pomoc$(4) = "*:*#$$#$"
pomoc$(5) = "*$*$:$#*"
pomoc$(6) = ".*:*$**."
pomoc$(7) = "..:*:*.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 3 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 6 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 9 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 48: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), kamien
pomoc$(0) = ".###.###"
pomoc$(1) = ".###.###"
pomoc$(2) = ".###.###"
pomoc$(3) = "........"
pomoc$(4) = "##.###.#"
pomoc$(5) = "##.###.#"
pomoc$(6) = "##.###.#"
pomoc$(7) = "........"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 13 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), murek
pomoc$(0) = "$*******"
pomoc$(1) = "**#*$***"
pomoc$(2) = "*****$*$"
pomoc$(3) = "*$**#***"
pomoc$(4) = "***$**$*"
pomoc$(5) = "$******#"
pomoc$(6) = "**$**$**"
pomoc$(7) = "*#**$***"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 33: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 32: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 34: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), wegiel
pomoc$(0) = "########"
pomoc$(1) = "#**##**#"
pomoc$(2) = "#*.##*.#"
pomoc$(3) = "########"
pomoc$(4) = "########"
pomoc$(5) = "#**##**#"
pomoc$(6) = "#*.##*.#"
pomoc$(7) = "########"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 1 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 11 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), stal
CLS
pomoc$(0) = "#......#.#....#...#..#.."
pomoc$(1) = "@@....@@.@@..@@....@@..."
pomoc$(2) = "@$$..$$@..$$$$.....$$..."
pomoc$(3) = "*&*&*&*&..*&*&.....&*..."
pomoc$(4) = "&*&*&*&*..&*&*.....*&..."
pomoc$(5) = "@$$..$$@..$$$$.....$$..."
pomoc$(6) = "@@....@@.@@..@@....@@..."
pomoc$(7) = "#......#.#....#...#..#.."
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "&" THEN COLOR 2 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 11 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 8 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), motyl1
GET (8, 0)-(15, 7), motyl2
GET (16, 0)-(23, 7), motyl3
CLS
pomoc$(0) = "..@@@..."
pomoc$(1) = "..@@@..."
pomoc$(2) = "...@...."
pomoc$(3) = ".*****.."
pomoc$(4) = "*.***.*."
pomoc$(5) = "..###..."
pomoc$(6) = "..#.#..."
pomoc$(7) = ".##.##.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 15: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), gracz1
CLS
pomoc$(0) = "#####################**#"
pomoc$(1) = "#####**######**#####****"
pomoc$(2) = "#############**#####****"
pomoc$(3) = "##**#################**#"
pomoc$(4) = "#****#####**############"
pomoc$(5) = "#****#####**######**####"
pomoc$(6) = "##**####################"
pomoc$(7) = "########################"
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), lawa1
GET (8, 0)-(15, 7), lawa2
GET (16, 0)-(23, 7), lawa3
CLS
END SUB
SUB plansza (ktora)
IF ktora = 2 THEN GOTO plansza2
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%A++.OO.AOOAOAA.AAA%AAO++OA++A+AO+++O+O%"
tablica$(2) = "%OA.++A+++A+O+++OAO%O++AOA+A+A+AO+A+AA+%"
tablica$(3) = "%+A+A+++AOAAOAAOOAA%AAO+AOAOAAOAAAOAO++%"
tablica$(4) = "%O++MMMMMMMMMMMMMMM%+O+OOAAA+AAAOAO+AOA%"
tablica$(5) = "%AA+++AO++AAOAA+AAA%A+AO+++OAOOAAO++O++%"
tablica$(6) = "%+O+O++A.+AOO++O++O%+O+AAOA+OA+AO+AOA++%"
tablica$(7) = "%A+A+AOAAOAAAOAA+OA%AAAO+AAAOAOAAAO+OA+%"
tablica$(8) = "%MMMMMMMMMMMMMMM+++%A+AAAOAAOAAAAOO+A+A%"
tablica$(9) = "%+O+++O+++++O+.++A+%OAAA+OAAAOAAOAOOAAA%"
tablica$(10) = "%++++++OA+++O++A+++%AOAAAAOAAOAAOAAAAAA%"
tablica$(11) = "%+.+OA+++.O.++++...%AAAOAOAAOAAAAAOOAOA%"
tablica$(12) = "%+.++%%%%%%%%%%%%%%%%%%%%%%%%+%%%%%%%%%%"
tablica$(13) = "%+O+++A++++..+++++++++++...........++++%"
tablica$(14) = "%++++++++++..++.+++++++.............+++%"
tablica$(15) = "%+.+++.++++A+++.++++++...............++%"
tablica$(16) = "%+.+++.++++...+.+++++.................+%"
tablica$(17) = "%+.+++.+++++OAO.+++%...................%"
tablica$(18) = "%+.+++.++++++++.+..%...................%"
tablica$(19) = "%+.+++.+++++.++.+.+%...................%"
tablica$(20) = "%+.+++.+++++.++.+++%...................%"
tablica$(21) = "%+.+++.+++++.++.++.%...................%"
tablica$(22) = "%+.+++.++++.....+..%...................%"
tablica$(23) = "%++++++++++++++++..%.....LLLLLLLLL.....%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
motx(0) = 2: moty(0) = 22: motw(0) = 2
motx(1) = 6: moty(1) = 22: motw(1) = 2
GOTO wczytaj
plansza2:
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%LLLLLLL.O.AO.A.AAA.AAO++OA++A+AO+++O+O%"
tablica$(2) = "%LLLLL.+.+A+.+++O.....+AOA++++++++A+AA+%"
tablica$(3) = "%LL..+.+.O.AO.AOOA++++..AOAMMMMAAAOAO++%"
tablica$(4) = "%L.+..++O...+++.%%%..%%%OAAA+A.AOAO+AOA%"
tablica$(5) = "%.A++.AO++A.OAA+%......%++++AAA+++AAO++%"
tablica$(6) = "%+O+.MMMMMMMO++O%......%A.A+OA+AO+A++++%"
tablica$(7) = "%A+.+A.A++AO.O.A%......%+++O++OAMMMMM++%"
tablica$(8) = "%A..AO...O++.O..%..OO..%AOAAO+++AOO+A+A%"
tablica$(9) = "%AA.A+.O.+.+O+.+%..++..%+OA++OAAOAOOAAA%"
tablica$(10) = "%++O+A.OA.A+O++A%.O++O.%AAOAAOAAOAA.AAA%"
tablica$(11) = "%A+.OA+AAOA.+AA+%.++++.%AO..OAA+++OOAOA%"
tablica$(12) = "%+++O..O.++OA..O%O+..+O%O.O+++.AA+A..O.%"
tablica$(13) = "%+A+AA+AOA.O.+++%+....+%..++AA.O..+++.+%"
tablica$(14) = "%MMMMMMMMM+.OAA.%A....A%MMMMM.....MMMMM%"
tablica$(15) = "%++++A+++AAA+++.%+A..A+%.++O.....AA..++%"
tablica$(16) = "%+AA++.O+++...+.%++AA++%AAA+++AA++AA..+%"
tablica$(17) = "%+.++AAAOA++OAO.%..AA..%+...A.++++++.A.%"
tablica$(18) = "%+AA+.O+A+.+A.+.%.A++A.%.AOO..+++.A....%"
tablica$(19) = "%+++++++++++++++%A++++A%+++++++++++++++%"
tablica$(20) = "%+%%%%%%%%%+++++%%%%%%%%+++++%%%%%%%%%+%"
tablica$(21) = "%+.....AAA%++++++++++++++++++%AAAAAAAAA%"
tablica$(22) = "%+MMMMMMMM%++++++++++++++++++%AOOOOOOOA%"
tablica$(23) = "%+.....AAA%++++++++++++++++++%AAAAAAAAA%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
motx(0) = 2: moty(0) = 21: motw(0) = 2
motx(1) = 2: moty(1) = 23: motw(1) = 2
wczytaj:
FOR yd = 0 TO 24
FOR xd = 0 TO 39
tabl(xd, yd) = ASC(MID$(tablica$(yd), xd + 1, 1))
NEXT xd
NEXT yd
END SUB
|
|
| Powrót do góry |
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Piotr-246
Gość
|
| Wysłany: Nie 18:59, 27 Cze 2021 Temat postu: |
|
|
DECLARE SUB chrup ()
DECLARE SUB braniedia ()
DECLARE SUB beepkam (ulamek)
DECLARE SUB beepdia (ulamek)
DECLARE SUB plansza (ktora)
DECLARE SUB elementy ()
REM gra musi chodzic w trybie Turbo 97240 cykli
SCREEN 13
DEF SEG = 0
DIM SHARED diament(0 TO 16) AS LONG
DIM SHARED diament2(0 TO 16) AS LONG
DIM SHARED diament3(0 TO 16) AS LONG
DIM SHARED diament4(0 TO 16) AS LONG
DIM SHARED kamien(0 TO 16) AS LONG
DIM SHARED czyste(0 TO 16) AS LONG
DIM SHARED murek(0 TO 16) AS LONG
DIM SHARED wegiel(0 TO 16) AS LONG
DIM SHARED stal(0 TO 16) AS LONG
DIM SHARED motyl1(0 TO 16) AS LONG
DIM SHARED motyl2(0 TO 16) AS LONG
DIM SHARED motyl3(0 TO 16) AS LONG
DIM SHARED lawa1(0 TO 16) AS LONG
DIM SHARED lawa2(0 TO 16) AS LONG
DIM SHARED lawa3(0 TO 16) AS LONG
DIM SHARED gracz1(0 TO 16) AS LONG
DIM SHARED pomoc$(0 TO 7)
DIM SHARED tablica$(0 TO 24)
DIM SHARED tabl(0 TO 39, 0 TO 24) AS INTEGER
DIM SHARED motx(0 TO 1) AS INTEGER
DIM SHARED moty(0 TO 1) AS INTEGER
DIM SHARED motw(0 TO 1) AS INTEGER
DIM SHARED stary.port
REM ************************ zaladowanie elementow graficznych
elementy
REM ****************************** zaladowanie 1 planszy
restart:
plansza (1)
REM ************************ dane startowe
restart2:
CLS
x = 25: y = 18
tabl(x, y) = 2
xs = x: ys = y
REM *************************** petla glowna
petla:
key$ = ""
REM *************************** sprawdzenie tablicy
beepk = 0: beepd = 0
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("@") THEN tabl(xb, yb) = ASC("."): REM tymczasowa przerwa
spadk = 0: spadd = 0
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("O"): tabl(xb, yb) = ASC("@"): spadk = 1: GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("A"): tabl(xb, yb) = ASC("@"): spadd = 1: GOTO skok
END IF
REM znaki wieksze od ascii 64 powoduja upadek w bok
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("O"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("O"): tabl(xb, yb) = ASC(".")
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("A"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("A"): tabl(xb, yb) = ASC(".")
END IF
skok:
REM dzwiek upadku
IF spadk = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepk = 1
IF tabl(xb, yb + 2) = ASC("X") THEN xdz = xb: ydz = yb + 2: GOSUB dziewiatka
END IF
IF spadd = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepd = 1
IF tabl(xb, yb + 2) = ASC("X") THEN xdz = xb: ydz = yb + 2: GOSUB dziewiatka
END IF
NEXT xb
NEXT yb
REM ****************** ruch motyli ***********************
FOR mot = 0 TO 1
IF moty(mot) = 0 THEN GOTO wyjdzzpetli
mx = motx(mot)
my = moty(mot)
wektor = motw(mot)
REM sprawdzenie dotkniecia lawy
styk = 0
IF tabl(mx + 1, my) = ASC("L") THEN styk = 1
IF tabl(mx - 1, my) = ASC("L") THEN styk = 1
IF tabl(mx, my - 1) = ASC("L") THEN styk = 1
IF tabl(mx, my + 1) = ASC("L") THEN styk = 1
IF styk = 1 THEN xdz = mx: ydz = my: GOSUB dziewiatka: GOTO wyjdzzpetli
ruch = 0
nie1 = 0: nie2 = 0: nie3 = 0: nie4 = 0
nie5 = 0: nie6 = 0: nie7 = 0: nie8 = 0
IF tabl(mx + 1, my - 1) <> ASC(".") THEN nie1 = 1
IF tabl(mx + 1, my) <> ASC(".") THEN nie2 = 1
IF tabl(mx + 1, my + 1) <> ASC(".") THEN nie3 = 1
IF tabl(mx, my + 1) <> ASC(".") THEN nie4 = 1
IF tabl(mx - 1, my + 1) <> ASC(".") THEN nie5 = 1
IF tabl(mx - 1, my) <> ASC(".") THEN nie6 = 1
IF tabl(mx - 1, my - 1) <> ASC(".") THEN nie7 = 1
IF tabl(mx, my - 1) <> ASC(".") THEN nie8 = 1
REM aby kontynuowal kierunek ruchu
powtorz = 0
IF wektor = 6 THEN GOTO wek6
IF wektor = 4 THEN GOTO wek4
IF wektor = 8 THEN GOTO wek8
jeszcze:
REM ruch w prawo
IF ruch = 0 AND nie8 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
IF ruch = 0 AND nie7 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
wek4:
REM ruch w dol
IF ruch = 0 AND nie2 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
IF ruch = 0 AND nie1 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
wek6:
REM ruch w lewo
IF ruch = 0 AND nie4 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
IF ruch = 0 AND nie3 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
wek8:
REM ruch w gore
IF ruch = 0 AND nie6 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
IF ruch = 0 AND nie5 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
REM sprawdz jeszcze raz
IF ruch = 0 AND powtorz = 0 AND (nie2 <> 0 OR nie4 <> 0 OR nie6 <> 0 OR nie8 <> 0) THEN powtorz = 1: GOTO jeszcze
REM motyl zapetlony w prozni
IF ruch = 0 AND nie2 = 0 AND nie4 = 0 AND nie6 = 0 AND nie8 = 0 THEN
IF fazamotyla = 0 THEN ruch = 1: wektor = 2
IF fazamotyla = 1 THEN ruch = 1: wektor = 4
IF fazamotyla = 2 THEN ruch = 1: wektor = 6
IF fazamotyla = 3 THEN ruch = 1: wektor = 8
END IF
REM wykonanie ruchu w tablicy
IF ruch = 1 AND wektor = 2 THEN tabl(mx, my) = ASC("."): mx = mx + 1
IF ruch = 1 AND wektor = 4 THEN tabl(mx, my) = ASC("."): my = my + 1
IF ruch = 1 AND wektor = 6 THEN tabl(mx, my) = ASC("."): mx = mx - 1
IF ruch = 1 AND wektor = 8 THEN tabl(mx, my) = ASC("."): my = my - 1
IF ruch = 0 THEN tabl(mx, my) = ASC("X")
IF ruch = 1 THEN tabl(mx, my) = ASC("X "): motx(mot) = mx: moty(mot) = my
motw(mot) = wektor
wyjdzzpetli:
NEXT mot
REM ****************** losowe rozszerzanie lawy
FOR speed = 1 TO 8: REM szybkosc powiekszania alwy
xlos = INT(RND(1) * 38) + 1
ylos = INT(RND(1) * 23) + 1
IF tabl(xlos, ylos) = ASC("L") THEN
REM loslawa = INT(RND(1) * 4)
IF tabl(xlos - 1, ylos) = ASC(".") THEN tabl(xlos - 1, ylos) = ASC("L"): GOTO lawaend
IF tabl(xlos + 1, ylos) = ASC(".") THEN tabl(xlos + 1, ylos) = ASC("L"): GOTO lawaend
IF tabl(xlos, ylos - 1) = ASC(".") THEN tabl(xlos, ylos - 1) = ASC("L"): GOTO lawaend
IF tabl(xlos, ylos + 1) = ASC(".") THEN tabl(xlos, ylos + 1) = ASC("L")
lawaend:
END IF
NEXT speed
REM *************************** wyswietlenie tablicy
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("+") THEN PUT (xb * 8, yb * 8), wegiel, OR: GOTO wyjdz
IF pobrany = ASC("%") THEN PUT (xb * 8, yb * 8), stal, OR: GOTO wyjdz
IF pobrany = ASC("M") THEN PUT (xb * 8, yb * 8), murek, OR: GOTO wyjdz
REM czysczenie tylko pod niektore elementy
PUT (xb * 8, yb * 8), czyste, AND
IF pobrany = ASC("O") THEN PUT (xb * 8, yb * 8), kamien, OR
IF pobrany = ASC("X") THEN
IF fazamotyla = 0 THEN PUT (xb * 8, yb * 8), motyl1, OR
IF fazamotyla = 1 THEN PUT (xb * 8, yb * 8), motyl2, OR
IF fazamotyla = 2 THEN PUT (xb * 8, yb * 8), motyl3, OR
IF fazamotyla = 3 THEN PUT (xb * 8, yb * 8), motyl2, OR
END IF
REM falowanie diamentu:
IF pobrany = ASC("A") THEN
IF faza = 0 THEN PUT (xb * 8, yb * 8), diament, OR
IF faza = 1 THEN PUT (xb * 8, yb * 8), diament2, OR
IF faza = 2 THEN PUT (xb * 8, yb * 8), diament3, OR
IF faza = 3 THEN PUT (xb * 8, yb * 8), diament4, OR
END IF
REM falowanie lawy
IF pobrany = ASC("L") THEN
IF fazalawy = 0 THEN PUT (xb * 8, yb * 8), lawa1, OR
IF fazalawy = 1 THEN PUT (xb * 8, yb * 8), lawa2, OR
IF fazalawy = 2 THEN PUT (xb * 8, yb * 8), lawa3, OR
IF fazalawy = 3 THEN PUT (xb * 8, yb * 8), lawa2, OR
END IF
IF pobrany = 2 THEN PUT (xb * 8, yb * 8), gracz1, OR
wyjdz:
NEXT xb
IF beepk = 1 THEN beepkam (yb): GOTO skok3
IF beepd = 1 THEN beepdia (yb)
skok3:
NEXT yb
skok2:
REM ************** zmiana fazy falowania motyli i diamentow:
faza = faza + 1
IF faza = 4 THEN faza = 0
fazamotyla = fazamotyla + 1
IF fazamotyla = 4 THEN fazamotyla = 0
fazalawy = fazalawy + 1
IF fazalawy = 4 THEN fazalawy = 0
REM ********************* obsluga klawiatury
IF key$ = "" THEN GOTO petla
k$ = key$
POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury
IF k$ = CHR$(27) THEN END
IF k$ = "1" THEN GOTO restart
IF k$ = "2" THEN plansza (2): GOTO restart2
dx = 0: dy = 0
IF k$ = CHR$(0) + "M" THEN x = x + 1: dx = 1
IF k$ = CHR$(0) + "K" THEN x = x - 1: dx = -1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
REM ************ sprawdzenie czy wolno wykonac ruch
pobrany = tabl(x, y)
IF y = ys AND pobrany = ASC("O") THEN IF tabl(xs + dx * 2, y) = ASC(".") THEN tabl(xs + dx * 2, y) = ASC("O"): GOTO nowa
IF pobrany <> ASC(".") AND pobrany <> ASC("+") AND pobrany <> ASC("A") THEN x = xs: y = ys: GOTO petla
IF pobrany = ASC("+") THEN chrup
IF pobrany = ASC("A") THEN braniedia
nowa:
REM ************* kasowanie w tablicy starej pozycji gracza
tabl(xs, ys) = ASC(".")
REM ************* wstawienie do tablicy nowej pozycji gracza
tabl(x, y) = 2
REM zapamietanie starej pozycji gracza
xs = x: ys = y
GOTO petla
REM ****** dziewiec diamentow za motyla
dziewiatka:
FOR yy = ydz - 1 TO ydz + 1
FOR xx = xdz - 1 TO xdz + 1
IF tabl(xx, yy) <> ASC("%") THEN tabl(xx, yy) = ASC("A")
NEXT xx
NEXT yy
REM ktory motyl?
FOR ktory = 0 TO 1
IF motx(ktory) = xdz AND moty(ktory) = ydz THEN motx(ktory) = 0: moty(ktory) = 0
NEXT ktory
RETURN
SUB beepdia (ulamek)
IF ulamek < 24 GOTO pominstart
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
pominstart:
FOR i = 1 TO 1
OUT 66, 102: OUT 66, 1
OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 3
REM OUT 66, 250: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
IF ulamek > 0 THEN GOTO pominkoniec
REM wylaczenie glosnika
OUT 97, stary.port
pominkoniec:
END SUB
SUB beepkam (ulamek)
IF ulamek < 24 THEN GOTO ominto
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
ominto:
FOR i = 1 TO 15
OUT 66, 42: OUT 66, 0
OUT 66, 71: OUT 66, 3
OUT 66, 135: OUT 66, 1
REM OUT 66, 35: OUT 66, 1
REM OUT 66, 135: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
IF ulamek > 0 THEN GOTO omindrugie
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
omindrugie:
END SUB
SUB braniedia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 100 TO 1 STEP -1
OUT 66, i: OUT 66, 3
FOR j = 1 TO 150: NEXT j
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB chrup
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 0
OUT 66, 20: OUT 66, 0
OUT 66, 32: OUT 66, 0
NEXT i
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 54: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 60: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB elementy
REM zielony wegiel
PALETTE 32, 5 * 65536 + 12 * 256 + 0
PALETTE 33, 9 * 65536 + 14 * 256 + 2
PALETTE 34, 12 * 65536 + 18 * 256 + 6
FOR i = 0 TO 15
REM odcienie kamienia +48
PALETTE 48 + i, INT(i * 2.5) * 65536 + i * 3 * 256 + i * 4
REM odcienie diamentu +64
PALETTE 64 + i, INT(i * 4) * 65536 + INT(i * 3.7) * 256 + INT(i * 3.2)
NEXT i
GET (0, 0)-(7, 7), czyste
pomoc$(0) = "...@@......@@......@@......@@..."
pomoc$(1) = "..@$$@....@**@....@::@....@##@.."
pomoc$(2) = ".@****@..@::::@..@####@..@$$$$@."
pomoc$(3) = "@::::::@@######@@$$$$$$@@******@"
pomoc$(4) = "@######@@$$$$$$@@******@@::::::@"
pomoc$(5) = ".@$$$$@..@****@..@::::@..@####@."
pomoc$(6) = "..@**@....@::@....@##@....@$$@.."
pomoc$(7) = "...@@......@@......@@......@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 31
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament
GET (8, 0)-(15, 7), diament2
GET (16, 0)-(23, 7), diament3
GET (24, 0)-(31, 7), diament4
pomoc$(0) = "..*$**.."
pomoc$(1) = ".*$###*."
pomoc$(2) = "**$$###*"
pomoc$(3) = "$#*$$#$*"
pomoc$(4) = "*:*#$$#$"
pomoc$(5) = "*$*$:$#*"
pomoc$(6) = ".*:*$**."
pomoc$(7) = "..:*:*.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 3 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 6 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 9 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 48: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), kamien
pomoc$(0) = ".###.###"
pomoc$(1) = ".###.###"
pomoc$(2) = ".###.###"
pomoc$(3) = "........"
pomoc$(4) = "##.###.#"
pomoc$(5) = "##.###.#"
pomoc$(6) = "##.###.#"
pomoc$(7) = "........"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 13 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), murek
pomoc$(0) = "$*******"
pomoc$(1) = "**#*$***"
pomoc$(2) = "*****$*$"
pomoc$(3) = "*$**#***"
pomoc$(4) = "***$**$*"
pomoc$(5) = "$******#"
pomoc$(6) = "**$**$**"
pomoc$(7) = "*#**$***"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 33: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 32: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 34: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), wegiel
pomoc$(0) = "########"
pomoc$(1) = "#**##**#"
pomoc$(2) = "#*.##*.#"
pomoc$(3) = "########"
pomoc$(4) = "########"
pomoc$(5) = "#**##**#"
pomoc$(6) = "#*.##*.#"
pomoc$(7) = "########"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 1 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 11 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), stal
CLS
pomoc$(0) = "#......#.#....#...#..#.."
pomoc$(1) = "@@....@@.@@..@@....@@..."
pomoc$(2) = "@$$..$$@..$$$$.....$$..."
pomoc$(3) = "*&*&*&*&..*&*&.....&*..."
pomoc$(4) = "&*&*&*&*..&*&*.....*&..."
pomoc$(5) = "@$$..$$@..$$$$.....$$..."
pomoc$(6) = "@@....@@.@@..@@....@@..."
pomoc$(7) = "#......#.#....#...#..#.."
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "&" THEN COLOR 2 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 11 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 8 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), motyl1
GET (8, 0)-(15, 7), motyl2
GET (16, 0)-(23, 7), motyl3
CLS
pomoc$(0) = "..@@@..."
pomoc$(1) = "..@@@..."
pomoc$(2) = "...@...."
pomoc$(3) = ".*****.."
pomoc$(4) = "*.***.*."
pomoc$(5) = "..###..."
pomoc$(6) = "..#.#..."
pomoc$(7) = ".##.##.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 15: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), gracz1
CLS
pomoc$(0) = "#####################**#"
pomoc$(1) = "#####**######**#####****"
pomoc$(2) = "#############**#####****"
pomoc$(3) = "##**#################**#"
pomoc$(4) = "#****#####**############"
pomoc$(5) = "#****#####**######**####"
pomoc$(6) = "##**####################"
pomoc$(7) = "########################"
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), lawa1
GET (8, 0)-(15, 7), lawa2
GET (16, 0)-(23, 7), lawa3
CLS
END SUB
SUB plansza (ktora)
IF ktora = 2 THEN GOTO plansza2
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%A++.OO.AOOAOAA.AAA%AAO++OA++A+AO+++O+O%"
tablica$(2) = "%OA.++A+++A+O+++OAO%O++AOA+A+A+AO+A+AA+%"
tablica$(3) = "%+A+A+++AOAAOAAOOAA%AAO+AOAOAAOAAAOAO++%"
tablica$(4) = "%O++MMMMMMMMMMMMMMM%+O+OOAAA+AAAOAO+AOA%"
tablica$(5) = "%AA+++AO++AAOAA+AAA%A+AO+++OAOOAAO++O++%"
tablica$(6) = "%+O+O++A.+AOO++O++O%+O+AAOA+OA+AO+AOA++%"
tablica$(7) = "%A+A+AOAAOAAAOAA+OA%AAAO+AAAOAOAAAO+OA+%"
tablica$(8) = "%MMMMMMMMMMMMMMM+++%A+AAAOAAOAAAAOO+A+A%"
tablica$(9) = "%+O+++O+++++O+.++A+%OAAA+OAAAOAAOAOOAAA%"
tablica$(10) = "%++++++OA+++O++A+++%AOAAAAOAAOAAOAAAAAA%"
tablica$(11) = "%+.+OA+++.O.++++...%AAAOAOAAOAAAAAOOAOA%"
tablica$(12) = "%+.++%%%%%%%%%%%%%%%%%%%%%%%%+%%%%%%%%%%"
tablica$(13) = "%+O+++A++++..+++++++++++...........++++%"
tablica$(14) = "%++++++++++..++.+++++++.............+++%"
tablica$(15) = "%+.+++.++++A+++.++++++...............++%"
tablica$(16) = "%+.+++.++++...+.+++++.................+%"
tablica$(17) = "%+.+++.+++++OAO.+++%...................%"
tablica$(18) = "%+.+++.++++++++.+..%...................%"
tablica$(19) = "%+.+++.+++++.++.+.+%...................%"
tablica$(20) = "%+.+++.+++++.++.+++%..................L%"
tablica$(21) = "%+.+++.+++++.++.++.%.................LL%"
tablica$(22) = "%+.+++.++++.....+..%................LLL%"
tablica$(23) = "%++++++++++++++++..%...............LLLL%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
motx(0) = 2: moty(0) = 22: motw(0) = 2
motx(1) = 6: moty(1) = 22: motw(1) = 2
GOTO wczytaj
plansza2:
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%LLLLLLL.O.AO.A.AAA.AAO++OA++A+AO+++O+O%"
tablica$(2) = "%LLLLL.+.+A+.+++O.....+AOA++++++++A+AA+%"
tablica$(3) = "%LL..+.+.O.AO.AOOA++++..AOAMMMMAAAOAO++%"
tablica$(4) = "%L.+..++O...+++.%%%..%%%OAAA+A.AOAO+AOA%"
tablica$(5) = "%.A++.AO++A.OAA+%......%++++AAA+++AAO++%"
tablica$(6) = "%+O+.MMMMMMMO++O%......%A.A+OA+AO+A++++%"
tablica$(7) = "%A+.+A.A++AO.O.A%......%+++O++OAMMMMM++%"
tablica$(8) = "%A..AO...O++.O..%..OO..%AOAAO+++AOO+A+A%"
tablica$(9) = "%AA.A+.O.+.+O+.+%..++..%+OA++OAAOAOOAAA%"
tablica$(10) = "%++O+A.OA.A+O++A%.O++O.%AAOAAOAAOAA.AAA%"
tablica$(11) = "%A+.OA+AAOA.+AA+%.++++.%AO..OAA+++OOAOA%"
tablica$(12) = "%+++O..O.++OA..O%O+..+O%O.O+++.AA+A..O.%"
tablica$(13) = "%+A+AA+AOA.O.+++%+....+%..++AA.O..+++.+%"
tablica$(14) = "%MMMMMMMMM+.OAA.%A....A%MMMMM.....MMMMM%"
tablica$(15) = "%++++A+++AAA+++.%+A..A+%.++O.....AA..++%"
tablica$(16) = "%+AA++.O+++...+.%++AA++%AAA+++AA++AA..+%"
tablica$(17) = "%+.++AAAOA++OAO.%..AA..%+...A.++++++.A.%"
tablica$(18) = "%+AA+.O+A+.+A.+.%.A++A.%.AOO..+++.A....%"
tablica$(19) = "%+++++++++++++++%A++++A%+++++++++++++++%"
tablica$(20) = "%+%%%%%%%%%+++++%%%%%%%%+++++%%%%%%%%%+%"
tablica$(21) = "%+.....AAA%++++++++++++++++++%AAAAAAAAA%"
tablica$(22) = "%+MMMMMMMM%++++++++++++++++++%AOOOOOOOA%"
tablica$(23) = "%+.....AAA%++++++++++++++++++%AAAAAAAAA%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
motx(0) = 2: moty(0) = 21: motw(0) = 2
motx(1) = 2: moty(1) = 23: motw(1) = 2
wczytaj:
FOR yd = 0 TO 24
FOR xd = 0 TO 39
tabl(xd, yd) = ASC(MID$(tablica$(yd), xd + 1, 1))
NEXT xd
NEXT yd
END SUB
|
|
| Powrót do góry |
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Piotr-246
Gość
|
| Wysłany: Nie 20:51, 27 Cze 2021 Temat postu: |
|
|
DECLARE SUB chrup ()
DECLARE SUB braniedia ()
DECLARE SUB beepkam (ulamek)
DECLARE SUB beepdia (ulamek)
DECLARE SUB plansza (ktora)
DECLARE SUB elementy ()
REM gra musi chodzic w trybie Turbo 97240 cykli
SCREEN 13
DEF SEG = 0
DIM SHARED diament(0 TO 16) AS LONG
DIM SHARED diament2(0 TO 16) AS LONG
DIM SHARED diament3(0 TO 16) AS LONG
DIM SHARED diament4(0 TO 16) AS LONG
DIM SHARED kamien(0 TO 16) AS LONG
DIM SHARED czyste(0 TO 16) AS LONG
DIM SHARED murek(0 TO 16) AS LONG
DIM SHARED wegiel(0 TO 16) AS LONG
DIM SHARED stal(0 TO 16) AS LONG
DIM SHARED motyl1(0 TO 16) AS LONG
DIM SHARED motyl2(0 TO 16) AS LONG
DIM SHARED motyl3(0 TO 16) AS LONG
DIM SHARED lawa1(0 TO 16) AS LONG
DIM SHARED lawa2(0 TO 16) AS LONG
DIM SHARED lawa3(0 TO 16) AS LONG
DIM SHARED gracz1(0 TO 16) AS LONG
DIM SHARED pomoc$(0 TO 7)
DIM SHARED tablica$(0 TO 24)
DIM SHARED tabl(0 TO 39, 0 TO 24) AS INTEGER
DIM SHARED motx(0 TO 1) AS INTEGER
DIM SHARED moty(0 TO 1) AS INTEGER
DIM SHARED motw(0 TO 1) AS INTEGER
DIM SHARED stary.port
DIM SHARED x, y
REM ************************ zaladowanie elementow graficznych
elementy
REM startowa pozycja gracza
x = 25: y = 18
REM ****************************** zaladowanie 1 planszy
restart:
plansza (1)
REM ************************ dane startowe
restart2:
CLS
tabl(x, y) = 2
xs = x: ys = y
REM *************************** petla glowna
petla:
key$ = ""
REM *************************** sprawdzenie tablicy
beepk = 0: beepd = 0
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("@") THEN tabl(xb, yb) = ASC("."): REM tymczasowa przerwa
spadk = 0: spadd = 0
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("O"): tabl(xb, yb) = ASC("@"): spadk = 1: GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("A"): tabl(xb, yb) = ASC("@"): spadd = 1: GOTO skok
END IF
REM znaki wieksze od ascii 64 powoduja upadek w bok
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("O"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("O"): tabl(xb, yb) = ASC(".")
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("A"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("A"): tabl(xb, yb) = ASC(".")
END IF
skok:
REM dzwiek upadku
IF spadk = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepk = 1
IF tabl(xb, yb + 2) = ASC("X") THEN xdz = xb: ydz = yb + 2: GOSUB dziewiatka
END IF
IF spadd = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepd = 1
IF tabl(xb, yb + 2) = ASC("X") THEN xdz = xb: ydz = yb + 2: GOSUB dziewiatka
END IF
NEXT xb
NEXT yb
REM ****************** ruch motyli ***********************
FOR mot = 0 TO 1
IF moty(mot) = 0 THEN GOTO wyjdzzpetli
mx = motx(mot)
my = moty(mot)
wektor = motw(mot)
REM sprawdzenie dotkniecia lawy
styk = 0
IF tabl(mx + 1, my) = ASC("L") THEN styk = 1
IF tabl(mx - 1, my) = ASC("L") THEN styk = 1
IF tabl(mx, my - 1) = ASC("L") THEN styk = 1
IF tabl(mx, my + 1) = ASC("L") THEN styk = 1
IF styk = 1 THEN xdz = mx: ydz = my: GOSUB dziewiatka: GOTO wyjdzzpetli
ruch = 0
nie1 = 0: nie2 = 0: nie3 = 0: nie4 = 0
nie5 = 0: nie6 = 0: nie7 = 0: nie8 = 0
IF tabl(mx + 1, my - 1) <> ASC(".") THEN nie1 = 1
IF tabl(mx + 1, my) <> ASC(".") THEN nie2 = 1
IF tabl(mx + 1, my + 1) <> ASC(".") THEN nie3 = 1
IF tabl(mx, my + 1) <> ASC(".") THEN nie4 = 1
IF tabl(mx - 1, my + 1) <> ASC(".") THEN nie5 = 1
IF tabl(mx - 1, my) <> ASC(".") THEN nie6 = 1
IF tabl(mx - 1, my - 1) <> ASC(".") THEN nie7 = 1
IF tabl(mx, my - 1) <> ASC(".") THEN nie8 = 1
REM aby kontynuowal kierunek ruchu
powtorz = 0
IF wektor = 6 THEN GOTO wek6
IF wektor = 4 THEN GOTO wek4
IF wektor = 8 THEN GOTO wek8
jeszcze:
REM ruch w prawo
IF ruch = 0 AND nie8 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
IF ruch = 0 AND nie7 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
wek4:
REM ruch w dol
IF ruch = 0 AND nie2 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
IF ruch = 0 AND nie1 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
wek6:
REM ruch w lewo
IF ruch = 0 AND nie4 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
IF ruch = 0 AND nie3 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
wek8:
REM ruch w gore
IF ruch = 0 AND nie6 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
IF ruch = 0 AND nie5 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
REM sprawdz jeszcze raz
IF ruch = 0 AND powtorz = 0 AND (nie2 <> 0 OR nie4 <> 0 OR nie6 <> 0 OR nie8 <> 0) THEN powtorz = 1: GOTO jeszcze
REM motyl zapetlony w prozni
IF ruch = 0 AND nie2 = 0 AND nie4 = 0 AND nie6 = 0 AND nie8 = 0 THEN
IF fazamotyla = 0 THEN ruch = 1: wektor = 2
IF fazamotyla = 1 THEN ruch = 1: wektor = 4
IF fazamotyla = 2 THEN ruch = 1: wektor = 6
IF fazamotyla = 3 THEN ruch = 1: wektor = 8
END IF
REM wykonanie ruchu w tablicy
IF ruch = 1 AND wektor = 2 THEN tabl(mx, my) = ASC("."): mx = mx + 1
IF ruch = 1 AND wektor = 4 THEN tabl(mx, my) = ASC("."): my = my + 1
IF ruch = 1 AND wektor = 6 THEN tabl(mx, my) = ASC("."): mx = mx - 1
IF ruch = 1 AND wektor = 8 THEN tabl(mx, my) = ASC("."): my = my - 1
IF ruch = 0 THEN tabl(mx, my) = ASC("X")
IF ruch = 1 THEN tabl(mx, my) = ASC("X "): motx(mot) = mx: moty(mot) = my
motw(mot) = wektor
wyjdzzpetli:
NEXT mot
REM ****************** losowe rozszerzanie lawy
FOR speed = 1 TO 8: REM szybkosc powiekszania alwy
xlos = INT(RND(1) * 38) + 1
ylos = INT(RND(1) * 23) + 1
IF tabl(xlos, ylos) = ASC("L") THEN
REM loslawa = INT(RND(1) * 4)
IF tabl(xlos - 1, ylos) = ASC(".") THEN tabl(xlos - 1, ylos) = ASC("L"): GOTO lawaend
IF tabl(xlos + 1, ylos) = ASC(".") THEN tabl(xlos + 1, ylos) = ASC("L"): GOTO lawaend
IF tabl(xlos, ylos - 1) = ASC(".") THEN tabl(xlos, ylos - 1) = ASC("L"): GOTO lawaend
IF tabl(xlos, ylos + 1) = ASC(".") THEN tabl(xlos, ylos + 1) = ASC("L")
lawaend:
END IF
NEXT speed
REM *************************** wyswietlenie tablicy
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("+") THEN PUT (xb * 8, yb * 8), wegiel, OR: GOTO wyjdz
IF pobrany = ASC("%") THEN PUT (xb * 8, yb * 8), stal, OR: GOTO wyjdz
IF pobrany = ASC("M") THEN PUT (xb * 8, yb * 8), murek, OR: GOTO wyjdz
REM czysczenie tylko pod niektore elementy
PUT (xb * 8, yb * 8), czyste, AND
IF pobrany = ASC("O") THEN PUT (xb * 8, yb * 8), kamien, OR
IF pobrany = ASC("X") THEN
IF fazamotyla = 0 OR fazamotyla = 5 THEN PUT (xb * 8, yb * 8), motyl1, OR
IF fazamotyla = 1 THEN PUT (xb * 8, yb * 8), motyl2, OR
IF fazamotyla = 2 OR fazamotyla = 3 THEN PUT (xb * 8, yb * 8), motyl3, OR
IF fazamotyla = 4 THEN PUT (xb * 8, yb * 8), motyl2, OR
END IF
REM falowanie diamentu:
IF pobrany = ASC("A") THEN
IF faza = 0 THEN PUT (xb * 8, yb * 8), diament, OR
IF faza = 1 THEN PUT (xb * 8, yb * 8), diament2, OR
IF faza = 2 THEN PUT (xb * 8, yb * 8), diament3, OR
IF faza = 3 THEN PUT (xb * 8, yb * 8), diament4, OR
END IF
REM falowanie lawy
IF pobrany = ASC("L") THEN
IF fazalawy = 0 THEN PUT (xb * 8, yb * 8), lawa1, OR
IF fazalawy = 1 THEN PUT (xb * 8, yb * 8), lawa2, OR
IF fazalawy = 2 THEN PUT (xb * 8, yb * 8), lawa3, OR
IF fazalawy = 3 THEN PUT (xb * 8, yb * 8), lawa2, OR
END IF
IF pobrany = 2 THEN PUT (xb * 8, yb * 8), gracz1, OR
wyjdz:
NEXT xb
IF beepk = 1 THEN beepkam (yb): GOTO skok3
IF beepd = 1 THEN beepdia (yb)
skok3:
NEXT yb
skok2:
REM ************** zmiana fazy falowania motyli i diamentow:
faza = faza + 1
IF faza = 4 THEN faza = 0
fazamotyla = fazamotyla + 1
IF fazamotyla = 6 THEN fazamotyla = 0
fazalawy = fazalawy + 1
IF fazalawy = 4 THEN fazalawy = 0
REM ********************* obsluga klawiatury
IF key$ = "" THEN GOTO petla
k$ = key$
POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury
IF k$ = CHR$(27) THEN END
IF k$ = "1" THEN GOTO restart
IF k$ = "2" THEN plansza (2): GOTO restart2
IF k$ = "3" THEN plansza (3): GOTO restart2
dx = 0: dy = 0
IF k$ = CHR$(0) + "M" THEN x = x + 1: dx = 1
IF k$ = CHR$(0) + "K" THEN x = x - 1: dx = -1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
REM ************ sprawdzenie czy wolno wykonac ruch
pobrany = tabl(x, y)
IF y = ys AND pobrany = ASC("O") THEN IF tabl(xs + dx * 2, y) = ASC(".") THEN tabl(xs + dx * 2, y) = ASC("O"): GOTO nowa
IF pobrany <> ASC(".") AND pobrany <> ASC("+") AND pobrany <> ASC("A") THEN x = xs: y = ys: GOTO petla
IF pobrany = ASC("+") THEN chrup
IF pobrany = ASC("A") THEN braniedia
nowa:
REM ************* kasowanie w tablicy starej pozycji gracza
tabl(xs, ys) = ASC(".")
REM ************* wstawienie do tablicy nowej pozycji gracza
tabl(x, y) = 2
REM zapamietanie starej pozycji gracza
xs = x: ys = y
GOTO petla
REM ****** dziewiec diamentow za motyla
dziewiatka:
FOR yy = ydz - 1 TO ydz + 1
FOR xx = xdz - 1 TO xdz + 1
IF tabl(xx, yy) <> ASC("%") THEN tabl(xx, yy) = ASC("A")
NEXT xx
NEXT yy
REM ktory motyl?
FOR ktory = 0 TO 1
IF motx(ktory) = xdz AND moty(ktory) = ydz THEN motx(ktory) = 0: moty(ktory) = 0
NEXT ktory
RETURN
SUB beepdia (ulamek)
IF ulamek < 24 GOTO pominstart
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
pominstart:
FOR i = 1 TO 1
OUT 66, 102: OUT 66, 1
OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 3
REM OUT 66, 250: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
IF ulamek > 0 THEN GOTO pominkoniec
REM wylaczenie glosnika
OUT 97, stary.port
pominkoniec:
END SUB
SUB beepkam (ulamek)
IF ulamek < 24 THEN GOTO ominto
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
ominto:
FOR i = 1 TO 15
OUT 66, 42: OUT 66, 0
OUT 66, 71: OUT 66, 3
OUT 66, 135: OUT 66, 1
REM OUT 66, 35: OUT 66, 1
REM OUT 66, 135: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
IF ulamek > 0 THEN GOTO omindrugie
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
omindrugie:
END SUB
SUB braniedia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 100 TO 1 STEP -1
OUT 66, i: OUT 66, 3
FOR j = 1 TO 150: NEXT j
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB chrup
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 0
OUT 66, 20: OUT 66, 0
OUT 66, 32: OUT 66, 0
NEXT i
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 54: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 60: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB elementy
REM zielony wegiel
PALETTE 32, 5 * 65536 + 12 * 256 + 0
PALETTE 33, 9 * 65536 + 14 * 256 + 2
PALETTE 34, 12 * 65536 + 18 * 256 + 6
FOR i = 0 TO 15
REM odcienie kamienia +48
PALETTE 48 + i, INT(i * 2.5) * 65536 + i * 3 * 256 + i * 4
REM odcienie diamentu +64
PALETTE 64 + i, INT(i * 4) * 65536 + INT(i * 3.7) * 256 + INT(i * 3.2)
NEXT i
GET (0, 0)-(7, 7), czyste
pomoc$(0) = "...@@......@@......@@......@@..."
pomoc$(1) = "..@$$@....@**@....@::@....@##@.."
pomoc$(2) = ".@****@..@::::@..@####@..@$$$$@."
pomoc$(3) = "@::::::@@######@@$$$$$$@@******@"
pomoc$(4) = "@######@@$$$$$$@@******@@::::::@"
pomoc$(5) = ".@$$$$@..@****@..@::::@..@####@."
pomoc$(6) = "..@**@....@::@....@##@....@$$@.."
pomoc$(7) = "...@@......@@......@@......@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 31
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament
GET (8, 0)-(15, 7), diament2
GET (16, 0)-(23, 7), diament3
GET (24, 0)-(31, 7), diament4
pomoc$(0) = "..*$**.."
pomoc$(1) = ".*$###*."
pomoc$(2) = "**$$###*"
pomoc$(3) = "$#*$$#$*"
pomoc$(4) = "*:*#$$#$"
pomoc$(5) = "*$*$:$#*"
pomoc$(6) = ".*:*$**."
pomoc$(7) = "..:*:*.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 3 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 6 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 9 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 48: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), kamien
pomoc$(0) = ".###.###"
pomoc$(1) = ".###.###"
pomoc$(2) = ".###.###"
pomoc$(3) = "........"
pomoc$(4) = "##.###.#"
pomoc$(5) = "##.###.#"
pomoc$(6) = "##.###.#"
pomoc$(7) = "........"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 13 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), murek
pomoc$(0) = "$*******"
pomoc$(1) = "**#*$***"
pomoc$(2) = "*****$*$"
pomoc$(3) = "*$**#***"
pomoc$(4) = "***$**$*"
pomoc$(5) = "$******#"
pomoc$(6) = "**$**$**"
pomoc$(7) = "*#**$***"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 33: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 32: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 34: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), wegiel
pomoc$(0) = "########"
pomoc$(1) = "#**##**#"
pomoc$(2) = "#*.##*.#"
pomoc$(3) = "########"
pomoc$(4) = "########"
pomoc$(5) = "#**##**#"
pomoc$(6) = "#*.##*.#"
pomoc$(7) = "########"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 1 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 11 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), stal
CLS
pomoc$(0) = "#......#.#....#...#..#.."
pomoc$(1) = "@@....@@.@@..@@....@@..."
pomoc$(2) = "@$$..$$@..$$$$.....$$..."
pomoc$(3) = "*&*&*&*&..*&*&.....&*..."
pomoc$(4) = "&*&*&*&*..&*&*.....*&..."
pomoc$(5) = "@$$..$$@..$$$$.....$$..."
pomoc$(6) = "@@....@@.@@..@@....@@..."
pomoc$(7) = "#......#.#....#...#..#.."
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "&" THEN COLOR 2 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 11 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 8 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), motyl1
GET (8, 0)-(15, 7), motyl2
GET (16, 0)-(23, 7), motyl3
CLS
pomoc$(0) = "..@@@..."
pomoc$(1) = "..@@@..."
pomoc$(2) = "...@...."
pomoc$(3) = ".*****.."
pomoc$(4) = "*.***.*."
pomoc$(5) = "..###..."
pomoc$(6) = "..#.#..."
pomoc$(7) = ".##.##.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 15: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), gracz1
CLS
pomoc$(0) = "#####################**#"
pomoc$(1) = "#####**######**#####****"
pomoc$(2) = "#############**#####****"
pomoc$(3) = "##**#################**#"
pomoc$(4) = "#****#####**############"
pomoc$(5) = "#****#####**######**####"
pomoc$(6) = "##**####################"
pomoc$(7) = "########################"
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), lawa1
GET (8, 0)-(15, 7), lawa2
GET (16, 0)-(23, 7), lawa3
CLS
END SUB
SUB plansza (ktora)
IF ktora = 2 THEN GOTO plansza2
IF ktora = 3 THEN GOTO plansza3
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%A++.OO.AOOAOAA.AAA%AAO++OA++A+AO+++O+O%"
tablica$(2) = "%OA.++A+++A+O+++OAO%O++AOA+A+A+AO+A+AA+%"
tablica$(3) = "%+A+A+++AOAAOAAOOAA%AAO+AOAOAAOAAAOAO++%"
tablica$(4) = "%O++MMMMMMMMMMMMMMM%+O+OOAAA+AAAOAO+AOA%"
tablica$(5) = "%AA+++AO++AAOAA+AAA%A+AO+++OAOOAAO++O++%"
tablica$(6) = "%+O+O++A.+AOO++O++O%+O+AAOA+OA+AO+AOA++%"
tablica$(7) = "%A+A+AOAAOAAAOAA+OA%AAAO+AAAOAOAAAO+OA+%"
tablica$(8) = "%MMMMMMMMMMMMMMM+++%A+AAAOAAOAAAAOO+A+A%"
tablica$(9) = "%+O+++O+++++O+.++A+%OAAA+OAAAOAAOAOOAAA%"
tablica$(10) = "%++++++OA+++O++A+++%AOAAAAOAAOAAOAAAAAA%"
tablica$(11) = "%+.+OA+++.O.++++...%AAAOAOAAOAAAAAOOAOA%"
tablica$(12) = "%+.++%%%%%%%%%%%%%%%%%%%%%%%%+%%%%%%%%%%"
tablica$(13) = "%+O+++A++++..+++++++++++...........++++%"
tablica$(14) = "%++++++++++..++.+++++++.............+++%"
tablica$(15) = "%+.+++.++++A+++.++++++...............++%"
tablica$(16) = "%+.+++.++++...+.+++++.................+%"
tablica$(17) = "%+.+++.+++++OAO.+++%...................%"
tablica$(18) = "%+.+++.++++++++.+..%...................%"
tablica$(19) = "%+.+++.+++++.++.+.+%...................%"
tablica$(20) = "%+.+++.+++++.++.+++%...................%"
tablica$(21) = "%+.+++.+++++.++.++.%...................%"
tablica$(22) = "%+.+++.++++.....+..%...................%"
tablica$(23) = "%++++++++++++++++..%...................%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
motx(0) = 2: moty(0) = 22: motw(0) = 2
motx(1) = 6: moty(1) = 22: motw(1) = 2
GOTO wczytaj
plansza2:
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%+++.O...O.AO++++++++++++++++A+AO+++O+O%"
tablica$(2) = "%.A.++++.+A+.+++++++++++++++++++++A+AA+%"
tablica$(3) = "%++O++A+.O.AO.++++++++++++++MMMMMA.AO++%"
tablica$(4) = "%+++O.++O...+++OMMMMMMMMO++++A.A+AO+AOA%"
tablica$(5) = "%.A++.AO++A.O+++M......M++++A+A+++AAO++%"
tablica$(6) = "%+O+.MMMMMMMO+++M......M++++OA+AO+A++++%"
tablica$(7) = "%A+.+A.A++AO.+++M......M+++O++OAMMMMM++%"
tablica$(8) = "%A..AO...O++.+++M..OO..M+++AO+++A+O+A+A%"
tablica$(9) = "%AA.A+.O.+.+O+++M..++..M+++++OA.OAO+A.A%"
tablica$(10) = "%++O+A.OA.A+O+++M.O++O.M+++AAOAAOAA.AAA%"
tablica$(11) = "%A+.O.+A.OA.++++M.++++.M+++.OAA+++O++OA%"
tablica$(12) = "%+++O..O.++OA+++MO+..+OM++++++.AA+A..O.%"
tablica$(13) = "%+A+A.+.OA.O.+++M+....+M++++AA.O..+++.+%"
tablica$(14) = "%MMMMMMMMM+.O+++MA....AM+++MM..++.MMMMM%"
tablica$(15) = "%++++A+++A.A++++M+A..A+M+++O.....AA..++%"
tablica$(16) = "%+A.++.O+++..+++M++AA++M++++++AA++AA..+%"
tablica$(17) = "%+.++A.AOA++O+++M..AA..M+++.A.++++++.A.%"
tablica$(18) = "%+AA+.O+A+.+A+++M.A++A.M+++O..+++.A.++.%"
tablica$(19) = "%+++++++++++++++MA++++AM+++++++++++++++%"
tablica$(20) = "%%%%%%%%%%%+++++MMMMMMMM+++++%%%%%%%%%%%"
tablica$(21) = "%AAAA......++++++++++++++++++%AAAAAAAAA%"
tablica$(22) = "%MMMMMMMMMM++++++++++++++++++%AOOOOOOOA%"
tablica$(23) = "%AAAA......+++++++++++++++++++AAAAAAAAA%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
motx(0) = 8: moty(0) = 21: motw(0) = 2
motx(1) = 8: moty(1) = 23: motw(1) = 2
GOTO wczytaj
plansza3:
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%LLLLLLLLLMAO.A.AAA.AAO++OA++A+AO+++O+O%"
tablica$(2) = "%LLLLL++++M+.+++O.....+AOA++++++++A+AA+%"
tablica$(3) = "%.+A.+.+++MAO.AOOA++++..AOAMMMMAAAOAO++%"
tablica$(4) = "%O.+.+++++M.+++.%%%..%%%OAAA+A.AOAO+AOA%"
tablica$(5) = "%.A++.A+++M.OAA++......+++++AAA+++AAO++%"
tablica$(6) = "%+O+.+++++MMO+.+++MMMM.+A.A+OA+AO+A++++%"
tablica$(7) = "%++.+A.+++MO.O..+MM..MM++++O++OAMMMMM++%"
tablica$(8) = "%A..AO++++M+.O...+...MM+AOAAO+++AOO+A+A%"
tablica$(9) = "%+A.A+++++M+O+..++..MM.++OA++OAAOAOOAAA%"
tablica$(10) = "%++O+A++++M+O..++++..MM+AAOA+++++AA.AAA%"
tablica$(11) = "%A+.OA++++M.+..++MM.+MM+AO..OAA+++OOAOA%"
tablica$(12) = "%++++.++++MOA....OMMMM.+O.O+++.AA+A..O.%"
tablica$(13) = "%+A+A+++++MO.+++++....++..++AA.O..+++.+%"
tablica$(14) = "%MMMMMMM++M.OAA.%A....A%++++M.....MMMMM%"
tablica$(15) = "%++++A++++MA+++.%+A..A+%.++O.....AA..++%"
tablica$(16) = "%+AA++.+++M...+.%++AA++%AAA+++AA++AA..+%"
tablica$(17) = "%+.++AA+++M+OAO.%..++..%+...A.++++++.A.%"
tablica$(18) = "%+AA+.O+++M+A.+.%.A++A.%.AOO..+++.A....%"
tablica$(19) = "%+++++++++M+++++%A++++A%+++++++++++++++%"
tablica$(20) = "%%%%%%%%++M+++++%%%%%++%+++++%%%%%%%%%+%"
tablica$(21) = "%.......++M+++++++++++++++++++++++++AAA%"
tablica$(22) = "%MMMMMMM++M++++++++++++++++++%++++OOOOA%"
tablica$(23) = "%.......++M++++++++++++++++++%AAAA++++A%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
motx(0) = 2: moty(0) = 21: motw(0) = 2
motx(1) = 2: moty(1) = 23: motw(1) = 2
x = 9: y = 10
wczytaj:
FOR yd = 0 TO 24
FOR xd = 0 TO 39
tabl(xd, yd) = ASC(MID$(tablica$(yd), xd + 1, 1))
NEXT xd
NEXT yd
END SUB
|
|
| Powrót do góry |
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Piotr-246
Gość
|
| Wysłany: Pon 8:59, 28 Cze 2021 Temat postu: |
|
|
DECLARE SUB chrup ()
DECLARE SUB braniedia ()
DECLARE SUB beepkam (ulamek)
DECLARE SUB beepdia (ulamek)
DECLARE SUB plansza (ktora)
DECLARE SUB elementy ()
REM gra musi chodzic w trybie Turbo 97240 cykli
SCREEN 13
DEF SEG = 0
DIM SHARED diament(0 TO 16) AS LONG
DIM SHARED diament2(0 TO 16) AS LONG
DIM SHARED diament3(0 TO 16) AS LONG
DIM SHARED diament4(0 TO 16) AS LONG
DIM SHARED kamien(0 TO 16) AS LONG
DIM SHARED czyste(0 TO 16) AS LONG
DIM SHARED murek(0 TO 16) AS LONG
DIM SHARED wegiel(0 TO 16) AS LONG
DIM SHARED stal(0 TO 16) AS LONG
DIM SHARED motyl1(0 TO 16) AS LONG
DIM SHARED motyl2(0 TO 16) AS LONG
DIM SHARED motyl3(0 TO 16) AS LONG
DIM SHARED lawa1(0 TO 16) AS LONG
DIM SHARED lawa2(0 TO 16) AS LONG
DIM SHARED lawa3(0 TO 16) AS LONG
DIM SHARED gracz1(0 TO 16) AS LONG
DIM SHARED pomoc$(0 TO 7)
DIM SHARED tablica$(0 TO 24)
DIM SHARED tabl(0 TO 39, 0 TO 24) AS INTEGER
DIM SHARED motx(0 TO 1) AS INTEGER
DIM SHARED moty(0 TO 1) AS INTEGER
DIM SHARED motw(0 TO 1) AS INTEGER
DIM SHARED stary.port
DIM SHARED x, y
REM ************************ zaladowanie elementow graficznych
elementy
REM startowa pozycja gracza
x = 25: y = 18
REM ****************************** zaladowanie 1 planszy
restart:
plansza (1)
REM ************************ dane startowe
restart2:
CLS
tabl(x, y) = 2
xs = x: ys = y
REM *************************** petla glowna
petla:
key$ = ""
REM *************************** sprawdzenie tablicy
beepk = 0: beepd = 0
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("@") THEN tabl(xb, yb) = ASC("."): REM tymczasowa przerwa
spadk = 0: spadd = 0
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("O"): tabl(xb, yb) = ASC("@"): spadk = 1: GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("A"): tabl(xb, yb) = ASC("@"): spadd = 1: GOTO skok
END IF
REM znaki wieksze od ascii 64 powoduja upadek w bok
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("O"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("O"): tabl(xb, yb) = ASC(".")
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("A"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("A"): tabl(xb, yb) = ASC(".")
END IF
skok:
REM dzwiek upadku
IF spadk = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepk = 1
IF tabl(xb, yb + 2) = ASC("X") THEN xdz = xb: ydz = yb + 2: GOSUB dziewiatka
END IF
IF spadd = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepd = 1
IF tabl(xb, yb + 2) = ASC("X") THEN xdz = xb: ydz = yb + 2: GOSUB dziewiatka
END IF
NEXT xb
NEXT yb
REM ****************** ruch motyli ***********************
FOR mot = 0 TO 1
IF moty(mot) = 0 THEN GOTO wyjdzzpetli
mx = motx(mot)
my = moty(mot)
wektor = motw(mot)
REM sprawdzenie dotkniecia lawy
styk = 0
IF tabl(mx + 1, my) = ASC("L") THEN styk = 1
IF tabl(mx - 1, my) = ASC("L") THEN styk = 1
IF tabl(mx, my - 1) = ASC("L") THEN styk = 1
IF tabl(mx, my + 1) = ASC("L") THEN styk = 1
IF styk = 1 THEN xdz = mx: ydz = my: GOSUB dziewiatka: GOTO wyjdzzpetli
ruch = 0
nie1 = 0: nie2 = 0: nie3 = 0: nie4 = 0
nie5 = 0: nie6 = 0: nie7 = 0: nie8 = 0
IF tabl(mx + 1, my - 1) <> ASC(".") THEN nie1 = 1
IF tabl(mx + 1, my) <> ASC(".") THEN nie2 = 1
IF tabl(mx + 1, my + 1) <> ASC(".") THEN nie3 = 1
IF tabl(mx, my + 1) <> ASC(".") THEN nie4 = 1
IF tabl(mx - 1, my + 1) <> ASC(".") THEN nie5 = 1
IF tabl(mx - 1, my) <> ASC(".") THEN nie6 = 1
IF tabl(mx - 1, my - 1) <> ASC(".") THEN nie7 = 1
IF tabl(mx, my - 1) <> ASC(".") THEN nie8 = 1
REM aby kontynuowal kierunek ruchu
powtorz = 0
IF wektor = 6 THEN GOTO wek6
IF wektor = 4 THEN GOTO wek4
IF wektor = 8 THEN GOTO wek8
jeszcze:
REM ruch w prawo
IF ruch = 0 AND nie8 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
IF ruch = 0 AND nie7 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
wek4:
REM ruch w dol
IF ruch = 0 AND nie2 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
IF ruch = 0 AND nie1 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
wek6:
REM ruch w lewo
IF ruch = 0 AND nie4 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
IF ruch = 0 AND nie3 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
wek8:
REM ruch w gore
IF ruch = 0 AND nie6 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
IF ruch = 0 AND nie5 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
REM sprawdz jeszcze raz
IF ruch = 0 AND powtorz = 0 AND (nie2 <> 0 OR nie4 <> 0 OR nie6 <> 0 OR nie8 <> 0) THEN powtorz = 1: GOTO jeszcze
REM motyl zapetlony w prozni
IF ruch = 0 AND nie2 = 0 AND nie4 = 0 AND nie6 = 0 AND nie8 = 0 THEN
IF fazamotyla = 0 THEN ruch = 1: wektor = 2
IF fazamotyla = 1 THEN ruch = 1: wektor = 4
IF fazamotyla = 2 THEN ruch = 1: wektor = 6
IF fazamotyla = 3 THEN ruch = 1: wektor = 8
END IF
REM wykonanie ruchu w tablicy
IF ruch = 1 AND wektor = 2 THEN tabl(mx, my) = ASC("."): mx = mx + 1
IF ruch = 1 AND wektor = 4 THEN tabl(mx, my) = ASC("."): my = my + 1
IF ruch = 1 AND wektor = 6 THEN tabl(mx, my) = ASC("."): mx = mx - 1
IF ruch = 1 AND wektor = 8 THEN tabl(mx, my) = ASC("."): my = my - 1
IF ruch = 0 THEN tabl(mx, my) = ASC("X")
IF ruch = 1 THEN tabl(mx, my) = ASC("X "): motx(mot) = mx: moty(mot) = my
motw(mot) = wektor
wyjdzzpetli:
NEXT mot
REM ****************** losowe rozszerzanie lawy
FOR speed = 1 TO 8: REM szybkosc powiekszania alwy
xlos = INT(RND(1) * 38) + 1
ylos = INT(RND(1) * 23) + 1
IF tabl(xlos, ylos) = ASC("L") THEN
REM loslawa = INT(RND(1) * 4)
IF tabl(xlos - 1, ylos) = ASC(".") THEN tabl(xlos - 1, ylos) = ASC("L"): GOTO lawaend
IF tabl(xlos + 1, ylos) = ASC(".") THEN tabl(xlos + 1, ylos) = ASC("L"): GOTO lawaend
IF tabl(xlos, ylos - 1) = ASC(".") THEN tabl(xlos, ylos - 1) = ASC("L"): GOTO lawaend
IF tabl(xlos, ylos + 1) = ASC(".") THEN tabl(xlos, ylos + 1) = ASC("L")
lawaend:
END IF
NEXT speed
REM *************************** wyswietlenie tablicy
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("+") THEN PUT (xb * 8, yb * 8), wegiel, OR: GOTO wyjdz
IF pobrany = ASC("%") THEN PUT (xb * 8, yb * 8), stal, OR: GOTO wyjdz
IF pobrany = ASC("M") THEN PUT (xb * 8, yb * 8), murek, OR: GOTO wyjdz
REM czysczenie tylko pod niektore elementy
PUT (xb * 8, yb * 8), czyste, AND
IF pobrany = ASC("O") THEN PUT (xb * 8, yb * 8), kamien, OR
IF pobrany = ASC("X") THEN
IF fazamotyla = 0 OR fazamotyla = 5 THEN PUT (xb * 8, yb * 8), motyl1, OR
IF fazamotyla = 1 THEN PUT (xb * 8, yb * 8), motyl2, OR
IF fazamotyla = 2 OR fazamotyla = 3 THEN PUT (xb * 8, yb * 8), motyl3, OR
IF fazamotyla = 4 THEN PUT (xb * 8, yb * 8), motyl2, OR
END IF
REM falowanie diamentu:
IF pobrany = ASC("A") THEN
IF faza = 0 THEN PUT (xb * 8, yb * 8), diament, OR
IF faza = 1 THEN PUT (xb * 8, yb * 8), diament2, OR
IF faza = 2 THEN PUT (xb * 8, yb * 8), diament3, OR
IF faza = 3 THEN PUT (xb * 8, yb * 8), diament4, OR
END IF
REM falowanie lawy
IF pobrany = ASC("L") THEN
IF fazalawy = 0 THEN PUT (xb * 8, yb * 8), lawa1, OR
IF fazalawy = 1 THEN PUT (xb * 8, yb * 8), lawa2, OR
IF fazalawy = 2 THEN PUT (xb * 8, yb * 8), lawa3, OR
IF fazalawy = 3 THEN PUT (xb * 8, yb * 8), lawa2, OR
END IF
IF pobrany = 2 THEN PUT (xb * 8, yb * 8), gracz1, OR
wyjdz:
NEXT xb
IF beepk = 1 THEN beepkam (yb): GOTO skok3
IF beepd = 1 THEN beepdia (yb)
skok3:
NEXT yb
skok2:
REM ************** zmiana fazy falowania motyli i diamentow:
faza = faza + 1
IF faza = 4 THEN faza = 0
fazamotyla = fazamotyla + 1
IF fazamotyla = 6 THEN fazamotyla = 0
fazalawy = fazalawy + 1
IF fazalawy = 4 THEN fazalawy = 0
REM ********************* obsluga klawiatury
IF key$ = "" THEN GOTO petla
k$ = key$
POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury
IF k$ = CHR$(27) THEN END
IF k$ = "1" THEN GOTO restart
IF k$ = "2" THEN plansza (2): GOTO restart2
IF k$ = "3" THEN plansza (3): GOTO restart2
dx = 0: dy = 0
IF k$ = CHR$(0) + "M" THEN x = x + 1: dx = 1
IF k$ = CHR$(0) + "K" THEN x = x - 1: dx = -1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
REM ************ sprawdzenie czy wolno wykonac ruch
pobrany = tabl(x, y)
IF y = ys AND pobrany = ASC("O") THEN IF tabl(xs + dx * 2, y) = ASC(".") THEN tabl(xs + dx * 2, y) = ASC("O"): GOTO nowa
IF pobrany <> ASC(".") AND pobrany <> ASC("+") AND pobrany <> ASC("A") THEN x = xs: y = ys: GOTO petla
IF pobrany = ASC("+") THEN chrup
IF pobrany = ASC("A") THEN braniedia
nowa:
REM ************* kasowanie w tablicy starej pozycji gracza
tabl(xs, ys) = ASC(".")
REM ************* wstawienie do tablicy nowej pozycji gracza
tabl(x, y) = 2
REM zapamietanie starej pozycji gracza
xs = x: ys = y
GOTO petla
REM ****** dziewiec diamentow za motyla
dziewiatka:
FOR yy = ydz - 1 TO ydz + 1
FOR xx = xdz - 1 TO xdz + 1
IF tabl(xx, yy) <> ASC("%") THEN tabl(xx, yy) = ASC("A")
NEXT xx
NEXT yy
REM ktory motyl?
FOR ktory = 0 TO 1
IF motx(ktory) = xdz AND moty(ktory) = ydz THEN motx(ktory) = 0: moty(ktory) = 0
NEXT ktory
RETURN
SUB beepdia (ulamek)
IF ulamek < 24 GOTO pominstart
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
pominstart:
FOR i = 1 TO 1
OUT 66, 102: OUT 66, 1
OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 3
REM OUT 66, 250: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
IF ulamek > 0 THEN GOTO pominkoniec
REM wylaczenie glosnika
OUT 97, stary.port
pominkoniec:
END SUB
SUB beepkam (ulamek)
IF ulamek < 24 THEN GOTO ominto
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
ominto:
FOR i = 1 TO 15
OUT 66, 42: OUT 66, 0
OUT 66, 71: OUT 66, 3
OUT 66, 135: OUT 66, 1
REM OUT 66, 35: OUT 66, 1
REM OUT 66, 135: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
IF ulamek > 0 THEN GOTO omindrugie
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
omindrugie:
END SUB
SUB braniedia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 100 TO 1 STEP -1
OUT 66, i: OUT 66, 3
FOR j = 1 TO 150: NEXT j
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB chrup
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 0
OUT 66, 20: OUT 66, 0
OUT 66, 32: OUT 66, 0
NEXT i
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 54: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 60: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB elementy
REM zielony wegiel
PALETTE 32, 5 * 65536 + 12 * 256 + 0
PALETTE 33, 9 * 65536 + 14 * 256 + 2
PALETTE 34, 12 * 65536 + 18 * 256 + 6
FOR i = 0 TO 15
REM odcienie kamienia +48
PALETTE 48 + i, INT(i * 2.5) * 65536 + i * 3 * 256 + i * 4
REM odcienie diamentu +64
PALETTE 64 + i, INT(i * 4) * 65536 + INT(i * 3.7) * 256 + INT(i * 3.2)
NEXT i
GET (0, 0)-(7, 7), czyste
pomoc$(0) = "...@@......@@......@@......@@..."
pomoc$(1) = "..@$$@....@**@....@::@....@##@.."
pomoc$(2) = ".@****@..@::::@..@####@..@$$$$@."
pomoc$(3) = "@::::::@@######@@$$$$$$@@******@"
pomoc$(4) = "@######@@$$$$$$@@******@@::::::@"
pomoc$(5) = ".@$$$$@..@****@..@::::@..@####@."
pomoc$(6) = "..@**@....@::@....@##@....@$$@.."
pomoc$(7) = "...@@......@@......@@......@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 31
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament
GET (8, 0)-(15, 7), diament2
GET (16, 0)-(23, 7), diament3
GET (24, 0)-(31, 7), diament4
pomoc$(0) = "..*$**.."
pomoc$(1) = ".*$###*."
pomoc$(2) = "**$$###*"
pomoc$(3) = "$#*$$#$*"
pomoc$(4) = "*:*#$$#$"
pomoc$(5) = "*$*$:$#*"
pomoc$(6) = ".*:*$**."
pomoc$(7) = "..:*:*.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 3 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 6 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 9 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 48: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), kamien
pomoc$(0) = ".###.###"
pomoc$(1) = ".###.###"
pomoc$(2) = ".###.###"
pomoc$(3) = "........"
pomoc$(4) = "##.###.#"
pomoc$(5) = "##.###.#"
pomoc$(6) = "##.###.#"
pomoc$(7) = "........"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 13 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), murek
pomoc$(0) = "$*******"
pomoc$(1) = "**#*$***"
pomoc$(2) = "*****$*$"
pomoc$(3) = "*$**#***"
pomoc$(4) = "***$**$*"
pomoc$(5) = "$******#"
pomoc$(6) = "**$**$**"
pomoc$(7) = "*#**$***"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 33: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 32: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 34: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), wegiel
pomoc$(0) = "########"
pomoc$(1) = "#**##**#"
pomoc$(2) = "#*.##*.#"
pomoc$(3) = "########"
pomoc$(4) = "########"
pomoc$(5) = "#**##**#"
pomoc$(6) = "#*.##*.#"
pomoc$(7) = "########"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 1 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 11 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), stal
CLS
pomoc$(0) = "#......#.#....#...#..#.."
pomoc$(1) = "@@....@@.@@..@@....@@..."
pomoc$(2) = "@$$..$$@..$$$$.....$$..."
pomoc$(3) = "*&*&*&*&..*&*&.....&*..."
pomoc$(4) = "&*&*&*&*..&*&*.....*&..."
pomoc$(5) = "@$$..$$@..$$$$.....$$..."
pomoc$(6) = "@@....@@.@@..@@....@@..."
pomoc$(7) = "#......#.#....#...#..#.."
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "&" THEN COLOR 2 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 11 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 8 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), motyl1
GET (8, 0)-(15, 7), motyl2
GET (16, 0)-(23, 7), motyl3
CLS
pomoc$(0) = "..@@@..."
pomoc$(1) = "..@@@..."
pomoc$(2) = "...@...."
pomoc$(3) = ".*****.."
pomoc$(4) = "*.***.*."
pomoc$(5) = "..###..."
pomoc$(6) = "..#.#..."
pomoc$(7) = ".##.##.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 15: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), gracz1
CLS
pomoc$(0) = "#####################**#"
pomoc$(1) = "#####**######**#####****"
pomoc$(2) = "#############**#####****"
pomoc$(3) = "##**#################**#"
pomoc$(4) = "#****#####**############"
pomoc$(5) = "#****#####**######**####"
pomoc$(6) = "##**####################"
pomoc$(7) = "########################"
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), lawa1
GET (8, 0)-(15, 7), lawa2
GET (16, 0)-(23, 7), lawa3
CLS
END SUB
SUB plansza (ktora)
IF ktora = 2 THEN GOTO plansza2
IF ktora = 3 THEN GOTO plansza3
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%A++.OO.AOOAOAA.AAA%AAO++OA++A+AO+++O+O%"
tablica$(2) = "%OA.++A+++A+O+++OAO%O++AOA+A+A+AO+A+AA+%"
tablica$(3) = "%+A+A+++AOAAOAAOOAA%AAO+AOAOAAOAAAOAO++%"
tablica$(4) = "%O++MMMMMMMMMMMMMMM%+O+OOAAA+AAAOAO+AOA%"
tablica$(5) = "%AA+++AO++AAOAA+AAA%A+AO+++OAOOAAO++O++%"
tablica$(6) = "%+O+O++A.+AOO++O++O%+O+AAOA+OA+AO+AOA++%"
tablica$(7) = "%A+A+AOAAOAAAOAA+OA%AAAO+AAAOAOAAAO+OA+%"
tablica$(8) = "%MMMMMMMMMMMMMMM+++%A+AAAOAAOAAAAOO+A+A%"
tablica$(9) = "%+O+++O+++++O+.++A+%OAAA+OAAAOAAOAOOAAA%"
tablica$(10) = "%++++++OA+++O++A+++%AOAAAAOAAOAAOAAAAAA%"
tablica$(11) = "%+.+OA+++.O.++++...%AAAOAOAAOAAAAAOOAOA%"
tablica$(12) = "%+.++%%%%%%%%%%%%%%%%%%%%%%%%+%%%%%%%%%%"
tablica$(13) = "%+O+++A++++..+++++++++++...........++++%"
tablica$(14) = "%++++++++++..++.+++++++.............+++%"
tablica$(15) = "%+.+++.++++A+++.++++++...............++%"
tablica$(16) = "%+.+++.++++...+.+++++.................+%"
tablica$(17) = "%+.+++.+++++OAO.+++%...................%"
tablica$(18) = "%+.+++.++++++++.+..%...................%"
tablica$(19) = "%+.+++.+++++.++.+.+%...................%"
tablica$(20) = "%+.+++.+++++.++.+++%...................%"
tablica$(21) = "%+.+++.+++++.++.++.%...................%"
tablica$(22) = "%+.+++.++++.....+..%...................%"
tablica$(23) = "%++++++++++++++++..%...................%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
motx(0) = 2: moty(0) = 22: motw(0) = 2
motx(1) = 6: moty(1) = 22: motw(1) = 2
GOTO wczytaj
plansza2:
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%+++.O...O.AO++++++++++++++++A+AO+++O+O%"
tablica$(2) = "%.A.++++.+A+.+++++++++++++++++++++A+AA+%"
tablica$(3) = "%++O++A+.O.AO.++++++++++++++MMMMMA.AO++%"
tablica$(4) = "%+++O.++O...+++OMMMMMMMMO++++A.A+AO+AOA%"
tablica$(5) = "%.A++.AO++A.O+++M......M++++A+A+++AAO++%"
tablica$(6) = "%+O+.MMMMMMMO+++M......M++++OA+AO+A++++%"
tablica$(7) = "%A+.+A.A++AO.+++M......M+++O++OAMMMMM++%"
tablica$(8) = "%A..AO...O++.+++M..OO..M+++AO+++A+O+A+A%"
tablica$(9) = "%AA.A+.O.+.+O+++M..++..M+++++OA.OAO+A.A%"
tablica$(10) = "%++O+A.OA.A+O+++M.O++O.M+++AAOAAOAA.AAA%"
tablica$(11) = "%A+.O.+A.OA.++++M.++++.M+++.OAA+++O++OA%"
tablica$(12) = "%+++O..O.++OA+++MO+..+OM++++++.AA+A..O.%"
tablica$(13) = "%+A+A.+.OA.O.+++M+....+M++++AA.O..+++.+%"
tablica$(14) = "%MMMMMMMMM+.O+++MA....AM+++MM..++.MMMMM%"
tablica$(15) = "%++++A+++A.A++++M+A..A+M+++O.....AA..++%"
tablica$(16) = "%+A.++.O+++..+++M++AA++M++++++AA++AA..+%"
tablica$(17) = "%+.++A.AOA++O+++M..AA..M+++.A.++++++.A.%"
tablica$(18) = "%+AA+.O+A+.+A+++M.A++A.M+++O..+++.A.++.%"
tablica$(19) = "%+++++++++++++++MA++++AM+++++++++++++++%"
tablica$(20) = "%%%%%%%%%%%+++++MMMMMMMM+++++%%%%%%%%%%%"
tablica$(21) = "%AAAA......++++++++++++++++++%AAAAAAAAA%"
tablica$(22) = "%MMMMMMMMMM++++++++++++++++++%AOOOOOOOA%"
tablica$(23) = "%AAAA......+++++++++++++++++++AAAAAAAAA%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
motx(0) = 8: moty(0) = 21: motw(0) = 2
motx(1) = 8: moty(1) = 23: motw(1) = 2
GOTO wczytaj
plansza3:
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%OOOOOOOOOMAO.A.AAA.AAO++OAM+MLLLLLLLLL%"
tablica$(2) = "%A+++++++AM+.+++O.....+AOA+MAM.+++LLLLL%"
tablica$(3) = "%OOOOOOOO+MAO.AOOA++++..AOAM+M.++%%%%%%%"
tablica$(4) = "%A+++++++AM.+++.++++++++OAAM+M.++%+++++%"
tablica$(5) = "%+OOOOOOOOM.OAA++......++++MAM.++%+++++%"
tablica$(6) = "%A+++++++AMMO+.+++MMMM.+A.AM+M.++%+++++%"
tablica$(7) = "%OOOOOOOO+MO.O..+MM..MM++OOM+M.++%+++++%"
tablica$(8) = "%A+++++++AM+.O...+...MM++++MAM.++%+++++%"
tablica$(9) = "%MMMMMMMM+M+O+..++..MM.+MMMM+M.++%+++++%"
tablica$(10) = "%+++++++++M+O..++++..MM+AAOM+M.++%+++++%"
tablica$(11) = "%+++++++++M.+..++MM.+MM+AO.MAM.++%+++++%"
tablica$(12) = "%+++++++++MOA....OMMMM.+O.OM+M.++%+++++%"
tablica$(13) = "%+++++++++MO.+++++....++..+M+M.++%%%%%%%"
tablica$(14) = "%+++++++++M.OAO.+A....A++++MAM.++++++++%"
tablica$(15) = "%+++++++++MA+++.O++..++++++M+M.++++++++%"
tablica$(16) = "%++MMMMMMMM...+.+++++++OO+AM+M.++++++++%"
tablica$(17) = "%+.++AA+++M+OAO.O..++.+++..MAM.MMMMMMMM%"
tablica$(18) = "%+AA+.O+++M+A.+.+.A++A.+.AOM+M.++++++++%"
tablica$(19) = "%+++++++++M++++++++++++++++M+M+++++++++%"
tablica$(20) = "%+++++++++M++++++++++++++++MAM+...+...+%"
tablica$(21) = "%..++++.++M+++++O++++++++++M+M+...+...+%"
tablica$(22) = "%+++++++++M++++++++++++OOMMM+M+...+...+%"
tablica$(23) = "%.++++..++++++++++++++++++++AM+++++++++%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
motx(0) = 32: moty(0) = 22: motw(0) = 2
motx(1) = 36: moty(1) = 22: motw(1) = 2
x = 35: y = 15
wczytaj:
FOR yd = 0 TO 24
FOR xd = 0 TO 39
tabl(xd, yd) = ASC(MID$(tablica$(yd), xd + 1, 1))
NEXT xd
NEXT yd
END SUB
|
|
| Powrót do góry |
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Piotr-246
Gość
|
| Wysłany: Pon 10:28, 28 Cze 2021 Temat postu: |
|
|
DECLARE SUB chrup ()
DECLARE SUB braniedia ()
DECLARE SUB beepkam (ulamek)
DECLARE SUB beepdia (ulamek)
DECLARE SUB plansza (ktora)
DECLARE SUB elementy ()
REM gra musi chodzic w trybie Turbo 97240 cykli
SCREEN 13
DEF SEG = 0
DIM SHARED diament(0 TO 16) AS LONG
DIM SHARED diament2(0 TO 16) AS LONG
DIM SHARED diament3(0 TO 16) AS LONG
DIM SHARED diament4(0 TO 16) AS LONG
DIM SHARED kamien(0 TO 16) AS LONG
DIM SHARED czyste(0 TO 16) AS LONG
DIM SHARED murek(0 TO 16) AS LONG
DIM SHARED wegiel(0 TO 16) AS LONG
DIM SHARED stal(0 TO 16) AS LONG
DIM SHARED motyl1(0 TO 16) AS LONG
DIM SHARED motyl2(0 TO 16) AS LONG
DIM SHARED motyl3(0 TO 16) AS LONG
DIM SHARED lawa1(0 TO 16) AS LONG
DIM SHARED lawa2(0 TO 16) AS LONG
DIM SHARED lawa3(0 TO 16) AS LONG
DIM SHARED gracz1(0 TO 16) AS LONG
DIM SHARED pomoc$(0 TO 7)
DIM SHARED tablica$(0 TO 24)
DIM SHARED tabl(0 TO 39, 0 TO 24) AS INTEGER
DIM SHARED motx(0 TO 3) AS INTEGER
DIM SHARED moty(0 TO 3) AS INTEGER
DIM SHARED motw(0 TO 3) AS INTEGER
DIM SHARED stary.port
DIM SHARED x, y, ilemot
REM ************************ zaladowanie elementow graficznych
elementy
REM startowa pozycja gracza
x = 25: y = 18
REM ****************************** zaladowanie 1 planszy
restart:
plansza (1)
REM ************************ dane startowe
restart2:
CLS
tabl(x, y) = 2
xs = x: ys = y
REM *************************** petla glowna
petla:
key$ = ""
REM *************************** sprawdzenie tablicy
beepk = 0: beepd = 0
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("@") THEN tabl(xb, yb) = ASC("."): REM tymczasowa przerwa
spadk = 0: spadd = 0
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("O"): tabl(xb, yb) = ASC("@"): spadk = 1: GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("A"): tabl(xb, yb) = ASC("@"): spadd = 1: GOTO skok
END IF
REM znaki wieksze od ascii 64 powoduja upadek w bok
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("O"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("O"): tabl(xb, yb) = ASC(".")
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("A"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("A"): tabl(xb, yb) = ASC(".")
END IF
skok:
REM dzwiek upadku
IF spadk = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepk = 1
IF tabl(xb, yb + 2) = ASC("X") THEN xdz = xb: ydz = yb + 2: GOSUB dziewiatka
END IF
IF spadd = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepd = 1
IF tabl(xb, yb + 2) = ASC("X") THEN xdz = xb: ydz = yb + 2: GOSUB dziewiatka
END IF
NEXT xb
NEXT yb
REM ****************** ruch motyli ***********************
FOR mot = 0 TO ilemot - 1
IF moty(mot) = 0 THEN GOTO wyjdzzpetli
mx = motx(mot)
my = moty(mot)
wektor = motw(mot)
REM sprawdzenie dotkniecia lawy
styk = 0
IF tabl(mx + 1, my) = ASC("L") THEN styk = 1
IF tabl(mx - 1, my) = ASC("L") THEN styk = 1
IF tabl(mx, my - 1) = ASC("L") THEN styk = 1
IF tabl(mx, my + 1) = ASC("L") THEN styk = 1
IF styk = 1 THEN xdz = mx: ydz = my: GOSUB dziewiatka: GOTO wyjdzzpetli
ruch = 0
nie1 = 0: nie2 = 0: nie3 = 0: nie4 = 0
nie5 = 0: nie6 = 0: nie7 = 0: nie8 = 0
IF tabl(mx + 1, my - 1) <> ASC(".") THEN nie1 = 1
IF tabl(mx + 1, my) <> ASC(".") THEN nie2 = 1
IF tabl(mx + 1, my + 1) <> ASC(".") THEN nie3 = 1
IF tabl(mx, my + 1) <> ASC(".") THEN nie4 = 1
IF tabl(mx - 1, my + 1) <> ASC(".") THEN nie5 = 1
IF tabl(mx - 1, my) <> ASC(".") THEN nie6 = 1
IF tabl(mx - 1, my - 1) <> ASC(".") THEN nie7 = 1
IF tabl(mx, my - 1) <> ASC(".") THEN nie8 = 1
REM aby kontynuowal kierunek ruchu
powtorz = 0
IF wektor = 6 THEN GOTO wek6
IF wektor = 4 THEN GOTO wek4
IF wektor = 8 THEN GOTO wek8
jeszcze:
REM ruch w prawo
IF ruch = 0 AND nie8 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
IF ruch = 0 AND nie7 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
wek4:
REM ruch w dol
IF ruch = 0 AND nie2 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
IF ruch = 0 AND nie1 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
wek6:
REM ruch w lewo
IF ruch = 0 AND nie4 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
IF ruch = 0 AND nie3 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
wek8:
REM ruch w gore
IF ruch = 0 AND nie6 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
IF ruch = 0 AND nie5 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
REM sprawdz jeszcze raz
IF ruch = 0 AND powtorz = 0 AND (nie2 <> 0 OR nie4 <> 0 OR nie6 <> 0 OR nie8 <> 0) THEN powtorz = 1: GOTO jeszcze
REM motyl zapetlony w prozni
IF ruch = 0 AND nie2 = 0 AND nie4 = 0 AND nie6 = 0 AND nie8 = 0 THEN
IF fazamotyla = 0 THEN ruch = 1: wektor = 2
IF fazamotyla = 1 THEN ruch = 1: wektor = 4
IF fazamotyla = 2 THEN ruch = 1: wektor = 6
IF fazamotyla = 3 THEN ruch = 1: wektor = 8
END IF
REM wykonanie ruchu w tablicy
IF ruch = 1 AND wektor = 2 THEN tabl(mx, my) = ASC("."): mx = mx + 1
IF ruch = 1 AND wektor = 4 THEN tabl(mx, my) = ASC("."): my = my + 1
IF ruch = 1 AND wektor = 6 THEN tabl(mx, my) = ASC("."): mx = mx - 1
IF ruch = 1 AND wektor = 8 THEN tabl(mx, my) = ASC("."): my = my - 1
IF ruch = 0 THEN tabl(mx, my) = ASC("X")
IF ruch = 1 THEN tabl(mx, my) = ASC("X "): motx(mot) = mx: moty(mot) = my
motw(mot) = wektor
wyjdzzpetli:
NEXT mot
REM ****************** losowe rozszerzanie lawy
FOR speed = 1 TO 8: REM szybkosc powiekszania alwy
xlos = INT(RND(1) * 38) + 1
ylos = INT(RND(1) * 23) + 1
IF tabl(xlos, ylos) = ASC("L") THEN
REM loslawa = INT(RND(1) * 4)
IF tabl(xlos - 1, ylos) = ASC(".") THEN tabl(xlos - 1, ylos) = ASC("L"): GOTO lawaend
IF tabl(xlos + 1, ylos) = ASC(".") THEN tabl(xlos + 1, ylos) = ASC("L"): GOTO lawaend
IF tabl(xlos, ylos - 1) = ASC(".") THEN tabl(xlos, ylos - 1) = ASC("L"): GOTO lawaend
IF tabl(xlos, ylos + 1) = ASC(".") THEN tabl(xlos, ylos + 1) = ASC("L")
lawaend:
END IF
NEXT speed
REM *************************** wyswietlenie tablicy
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("+") THEN PUT (xb * 8, yb * 8), wegiel, OR: GOTO wyjdz
IF pobrany = ASC("%") THEN PUT (xb * 8, yb * 8), stal, OR: GOTO wyjdz
IF pobrany = ASC("M") THEN PUT (xb * 8, yb * 8), murek, OR: GOTO wyjdz
REM czysczenie tylko pod niektore elementy
PUT (xb * 8, yb * 8), czyste, AND
IF pobrany = ASC("O") THEN PUT (xb * 8, yb * 8), kamien, OR
IF pobrany = ASC("X") THEN
IF fazamotyla = 0 OR fazamotyla = 5 THEN PUT (xb * 8, yb * 8), motyl1, OR
IF fazamotyla = 1 THEN PUT (xb * 8, yb * 8), motyl2, OR
IF fazamotyla = 2 OR fazamotyla = 3 THEN PUT (xb * 8, yb * 8), motyl3, OR
IF fazamotyla = 4 THEN PUT (xb * 8, yb * 8), motyl2, OR
END IF
REM falowanie diamentu:
IF pobrany = ASC("A") THEN
IF faza = 0 THEN PUT (xb * 8, yb * 8), diament, OR
IF faza = 1 THEN PUT (xb * 8, yb * 8), diament2, OR
IF faza = 2 THEN PUT (xb * 8, yb * 8), diament3, OR
IF faza = 3 THEN PUT (xb * 8, yb * 8), diament4, OR
END IF
REM falowanie lawy
IF pobrany = ASC("L") THEN
IF fazalawy = 0 THEN PUT (xb * 8, yb * 8), lawa1, OR
IF fazalawy = 1 THEN PUT (xb * 8, yb * 8), lawa2, OR
IF fazalawy = 2 THEN PUT (xb * 8, yb * 8), lawa3, OR
IF fazalawy = 3 THEN PUT (xb * 8, yb * 8), lawa2, OR
END IF
IF pobrany = 2 THEN PUT (xb * 8, yb * 8), gracz1, OR
wyjdz:
NEXT xb
IF beepk = 1 THEN beepkam (yb): GOTO skok3
IF beepd = 1 THEN beepdia (yb)
skok3:
NEXT yb
skok2:
REM ************** zmiana fazy falowania motyli i diamentow:
faza = faza + 1
IF faza = 4 THEN faza = 0
fazamotyla = fazamotyla + 1
IF fazamotyla = 6 THEN fazamotyla = 0
fazalawy = fazalawy + 1
IF fazalawy = 4 THEN fazalawy = 0
REM ********************* obsluga klawiatury
IF key$ = "" THEN GOTO petla
k$ = key$
POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury
IF k$ = CHR$(27) THEN END
IF k$ = "1" THEN GOTO restart
IF k$ = "2" THEN plansza (2): GOTO restart2
IF k$ = "3" THEN plansza (3): GOTO restart2
IF k$ = "4" THEN plansza (4): GOTO restart2
dx = 0: dy = 0
IF k$ = CHR$(0) + "M" THEN x = x + 1: dx = 1
IF k$ = CHR$(0) + "K" THEN x = x - 1: dx = -1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
REM ************ sprawdzenie czy wolno wykonac ruch
pobrany = tabl(x, y)
IF y = ys AND pobrany = ASC("O") THEN IF tabl(xs + dx * 2, y) = ASC(".") THEN tabl(xs + dx * 2, y) = ASC("O"): GOTO nowa
IF pobrany <> ASC(".") AND pobrany <> ASC("+") AND pobrany <> ASC("A") THEN x = xs: y = ys: GOTO petla
IF pobrany = ASC("+") THEN chrup
IF pobrany = ASC("A") THEN braniedia
nowa:
REM ************* kasowanie w tablicy starej pozycji gracza
tabl(xs, ys) = ASC(".")
REM ************* wstawienie do tablicy nowej pozycji gracza
tabl(x, y) = 2
REM zapamietanie starej pozycji gracza
xs = x: ys = y
GOTO petla
REM ****** dziewiec diamentow za motyla
dziewiatka:
FOR yy = ydz - 1 TO ydz + 1
FOR xx = xdz - 1 TO xdz + 1
IF tabl(xx, yy) <> ASC("%") THEN tabl(xx, yy) = ASC("A")
NEXT xx
NEXT yy
REM ktory motyl?
FOR ktory = 0 TO ilemot - 1
IF motx(ktory) = xdz AND moty(ktory) = ydz THEN motx(ktory) = 0: moty(ktory) = 0
NEXT ktory
RETURN
SUB beepdia (ulamek)
IF ulamek < 24 GOTO pominstart
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
pominstart:
FOR i = 1 TO 1
OUT 66, 102: OUT 66, 1
OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 3
REM OUT 66, 250: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
IF ulamek > 0 THEN GOTO pominkoniec
REM wylaczenie glosnika
OUT 97, stary.port
pominkoniec:
END SUB
SUB beepkam (ulamek)
IF ulamek < 24 THEN GOTO ominto
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
ominto:
FOR i = 1 TO 15
OUT 66, 42: OUT 66, 0
OUT 66, 71: OUT 66, 3
OUT 66, 135: OUT 66, 1
REM OUT 66, 35: OUT 66, 1
REM OUT 66, 135: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
IF ulamek > 0 THEN GOTO omindrugie
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
omindrugie:
END SUB
SUB braniedia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 100 TO 1 STEP -1
OUT 66, i: OUT 66, 3
FOR j = 1 TO 150: NEXT j
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB chrup
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 0
OUT 66, 20: OUT 66, 0
OUT 66, 32: OUT 66, 0
NEXT i
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 54: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 60: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB elementy
REM zielony wegiel
PALETTE 32, 5 * 65536 + 12 * 256 + 0
PALETTE 33, 9 * 65536 + 14 * 256 + 2
PALETTE 34, 12 * 65536 + 18 * 256 + 6
FOR i = 0 TO 15
REM odcienie kamienia +48
PALETTE 48 + i, INT(i * 2.5) * 65536 + i * 3 * 256 + i * 4
REM odcienie diamentu +64
PALETTE 64 + i, INT(i * 4) * 65536 + INT(i * 3.7) * 256 + INT(i * 3.2)
NEXT i
GET (0, 0)-(7, 7), czyste
pomoc$(0) = "...@@......@@......@@......@@..."
pomoc$(1) = "..@$$@....@**@....@::@....@##@.."
pomoc$(2) = ".@****@..@::::@..@####@..@$$$$@."
pomoc$(3) = "@::::::@@######@@$$$$$$@@******@"
pomoc$(4) = "@######@@$$$$$$@@******@@::::::@"
pomoc$(5) = ".@$$$$@..@****@..@::::@..@####@."
pomoc$(6) = "..@**@....@::@....@##@....@$$@.."
pomoc$(7) = "...@@......@@......@@......@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 31
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament
GET (8, 0)-(15, 7), diament2
GET (16, 0)-(23, 7), diament3
GET (24, 0)-(31, 7), diament4
pomoc$(0) = "..*$**.."
pomoc$(1) = ".*$###*."
pomoc$(2) = "**$$###*"
pomoc$(3) = "$#*$$#$*"
pomoc$(4) = "*:*#$$#$"
pomoc$(5) = "*$*$:$#*"
pomoc$(6) = ".*:*$**."
pomoc$(7) = "..:*:*.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 3 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 6 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 9 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 48: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), kamien
pomoc$(0) = ".###.###"
pomoc$(1) = ".###.###"
pomoc$(2) = ".###.###"
pomoc$(3) = "........"
pomoc$(4) = "##.###.#"
pomoc$(5) = "##.###.#"
pomoc$(6) = "##.###.#"
pomoc$(7) = "........"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 13 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), murek
pomoc$(0) = "$*******"
pomoc$(1) = "**#*$***"
pomoc$(2) = "*****$*$"
pomoc$(3) = "*$**#***"
pomoc$(4) = "***$**$*"
pomoc$(5) = "$******#"
pomoc$(6) = "**$**$**"
pomoc$(7) = "*#**$***"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 33: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 32: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 34: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), wegiel
pomoc$(0) = "########"
pomoc$(1) = "#**##**#"
pomoc$(2) = "#*.##*.#"
pomoc$(3) = "########"
pomoc$(4) = "########"
pomoc$(5) = "#**##**#"
pomoc$(6) = "#*.##*.#"
pomoc$(7) = "########"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 1 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 11 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), stal
CLS
pomoc$(0) = "#......#.#....#...#..#.."
pomoc$(1) = "@@....@@.@@..@@....@@..."
pomoc$(2) = "@$$..$$@..$$$$.....$$..."
pomoc$(3) = "*&*&*&*&..*&*&.....&*..."
pomoc$(4) = "&*&*&*&*..&*&*.....*&..."
pomoc$(5) = "@$$..$$@..$$$$.....$$..."
pomoc$(6) = "@@....@@.@@..@@....@@..."
pomoc$(7) = "#......#.#....#...#..#.."
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "&" THEN COLOR 2 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 11 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 8 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), motyl1
GET (8, 0)-(15, 7), motyl2
GET (16, 0)-(23, 7), motyl3
CLS
pomoc$(0) = "..@@@..."
pomoc$(1) = "..@@@..."
pomoc$(2) = "...@...."
pomoc$(3) = ".*****.."
pomoc$(4) = "*.***.*."
pomoc$(5) = "..###..."
pomoc$(6) = "..#.#..."
pomoc$(7) = ".##.##.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 15: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), gracz1
CLS
pomoc$(0) = "#####################**#"
pomoc$(1) = "#####**######**#####****"
pomoc$(2) = "#############**#####****"
pomoc$(3) = "##**#################**#"
pomoc$(4) = "#****#####**############"
pomoc$(5) = "#****#####**######**####"
pomoc$(6) = "##**####################"
pomoc$(7) = "########################"
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), lawa1
GET (8, 0)-(15, 7), lawa2
GET (16, 0)-(23, 7), lawa3
CLS
END SUB
SUB plansza (ktora)
IF ktora = 2 THEN GOTO plansza2
IF ktora = 3 THEN GOTO plansza3
IF ktora = 4 THEN GOTO plansza4
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%A++.OO.AOOAOAA.AAA%AAO++OA++A+AO+++O+O%"
tablica$(2) = "%OA.++A+++A+O+++OAO%O++AOA+A+A+AO+A+AA+%"
tablica$(3) = "%+A+A+++AOAAOAAOOAA%AAO+AOAOAAOAAAOAO++%"
tablica$(4) = "%O++MMMMMMMMMMMMMMM%+O+OOAAA+AAAOAO+AOA%"
tablica$(5) = "%AA+++AO++AAOAA+AAA%A+AO+++OAOOAAO++O++%"
tablica$(6) = "%+O+O++A.+AOO++O++O%+O+AAOA+OA+AO+AOA++%"
tablica$(7) = "%A+A+AOAAOAAAOAA+OA%AAAO+AAAOAOAAAO+OA+%"
tablica$(8) = "%MMMMMMMMMMMMMMM+++%A+AAAOAAOAAAAOO+A+A%"
tablica$(9) = "%+O+++O+++++O+.++A+%OAAA+OAAAOAAOAOOAAA%"
tablica$(10) = "%++++++OA+++O++A+++%AOAAAAOAAOAAOAAAAAA%"
tablica$(11) = "%+.+OA+++.O.++++...%AAAOAOAAOAAAAAOOAOA%"
tablica$(12) = "%+.++%%%%%%%%%%%%%%%%%%%%%%%%+%%%%%%%%%%"
tablica$(13) = "%+O+++A++++..+++++++++++...........++++%"
tablica$(14) = "%++++++++++..++.+++++++.............+++%"
tablica$(15) = "%+.+++.++++A+++.++++++...............++%"
tablica$(16) = "%+.+++.++++...+.+++++.................+%"
tablica$(17) = "%+.+++.+++++OAO.+++%...................%"
tablica$(18) = "%+.+++.++++++++.+..%...................%"
tablica$(19) = "%+.+++.+++++.++.+.+%...................%"
tablica$(20) = "%+.+++.+++++.++.+++%...................%"
tablica$(21) = "%+.+++.+++++.++.++.%...................%"
tablica$(22) = "%+.+++.++++.....+..%...................%"
tablica$(23) = "%++++++++++++++++..%...................%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
ilemot = 2
motx(0) = 2: moty(0) = 22: motw(0) = 2
motx(1) = 6: moty(1) = 22: motw(1) = 2
GOTO wczytaj
plansza2:
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%+++++%....LLLLLLLLLLLLLLLLLL....%+++++%"
tablica$(2) = "%+...+%.......LLLLLLLLLLL........%+...+%"
tablica$(3) = "%+...+%..........................%+...+%"
tablica$(4) = "%+...+%..........................%+...+%"
tablica$(5) = "%+++++%..........................%+++++%"
tablica$(6) = "%+++++%.M.M.M.M.M.%%%%.M.M.M.M.M.%+++++%"
tablica$(7) = "%+++++%.M.M.M.M.M.%%%%.M.M.M.M.M.%+++++%"
tablica$(8) = "%+++++%.M.M.M.M.M.%%%%.M.M.M.M.M.%+++++%"
tablica$(9) = "%+++++............................+++++%"
tablica$(10) = "%+++++............................+++++%"
tablica$(11) = "%+++++............................+++++%"
tablica$(12) = "%+++++............................+++++%"
tablica$(13) = "%++++++++++++++++++++++++++++++++++++++%"
tablica$(14) = "%++++++++++++++++++++++++++++++++++++++%"
tablica$(15) = "%++++++++++++++++++++++++++++++++++++++%"
tablica$(16) = "%++++++++++++++++++++++++++++++++++++++%"
tablica$(17) = "%++++++++++++++++++++++++++++++++++++++%"
tablica$(18) = "%++++++++++++++++++++++++++++++++++++++%"
tablica$(19) = "%++++++++++++++++++++++++++++++++++++++%"
tablica$(20) = "%+...++++++++++++++++++++++++++++++...+%"
tablica$(21) = "%+...++++++++++++++++++++++++++++++...+%"
tablica$(22) = "%+...++++++++++++++++++++++++++++++...+%"
tablica$(23) = "%++++++++++++++++++++++++++++++++++++++%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
ilemot = 4
motx(0) = 3: moty(0) = 4: motw(0) = 2
motx(1) = 36: moty(1) = 4: motw(1) = 2
motx(2) = 3: moty(2) = 22: motw(2) = 2
motx(3) = 36: moty(3) = 22: motw(3) = 2
x = 35: y = 15
GOTO wczytaj
plansza3:
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%+++.O...O.AO++++++++++++++++A+AO+++O+O%"
tablica$(2) = "%.A.++++.+A+.+++++++++++++++++++++A+AA+%"
tablica$(3) = "%++O++A+.O.AO.++++++++++++++MMMMMA.AO++%"
tablica$(4) = "%+++O.++O...+++OMMMMMMMMO++++A.A+AO+AOA%"
tablica$(5) = "%.A++.AO++A.O+++M......M++++A+A+++AAO++%"
tablica$(6) = "%+O+.MMMMMMMO+++M......M++++OA+AO+A++++%"
tablica$(7) = "%A+.+A.A++AO.+++M......M+++O++OAMMMMM++%"
tablica$(8) = "%A..AO...O++.+++M..OO..M+++AO+++A+O+A+A%"
tablica$(9) = "%AA.A+.O.+.+O+++M..++..M+++++OA.OAO+A.A%"
tablica$(10) = "%++O+A.OA.A+O+++M.O++O.M+++AAOAAOAA.AAA%"
tablica$(11) = "%A+.O.+A.OA.++++M.++++.M+++.OAA+++O++OA%"
tablica$(12) = "%+++O..O.++OA+++MO+..+OM++++++.AA+A..O.%"
tablica$(13) = "%+A+A.+.OA.O.+++M+....+M++++AA.O..+++.+%"
tablica$(14) = "%MMMMMMMMM+.O+++MA....AM+++MM..++.MMMMM%"
tablica$(15) = "%++++A+++A.A++++M+A..A+M+++O.....AA..++%"
tablica$(16) = "%+A.++.O+++..+++M++AA++M++++++AA++AA..+%"
tablica$(17) = "%+.++A.AOA++O+++M..AA..M+++.A.++++++.A.%"
tablica$(18) = "%+AA+.O+A+.+A+++M.A++A.M+++O..+++.A.++.%"
tablica$(19) = "%+++++++++++++++MA++++AM+++++++++++++++%"
tablica$(20) = "%%%%%%%%%%%+++++MMMMMMMM+++++%%%%%%%%%%%"
tablica$(21) = "%AAAA......++++++++++++++++++%AAAAAAAAA%"
tablica$(22) = "%MMMMMMMMMM++++++++++++++++++%AOOOOOOOA%"
tablica$(23) = "%AAAA......+++++++++++++++++++AAAAAAAAA%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
ilemot = 2
motx(0) = 8: moty(0) = 21: motw(0) = 2
motx(1) = 8: moty(1) = 23: motw(1) = 2
GOTO wczytaj
plansza4:
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%OOOOOOOOOMAO.A.AAA.AAO++OAM+MLLLLLLLLL%"
tablica$(2) = "%A+++++++AM+.+++O.....+AOA+MAM.+++LLLLL%"
tablica$(3) = "%OOOOOOOO+MAO.AOOA++++..AOAM+M.++%%%%%%%"
tablica$(4) = "%A+++++++AM.+++.++++++++OAAM+M.++%+++++%"
tablica$(5) = "%+OOOOOOOOM.OAA++......++++MAM.++%+++++%"
tablica$(6) = "%A+++++++AMMO+.+++++++.+A.AM+M.++%+++++%"
tablica$(7) = "%OOOOOOOO+MO.O..+++++++++OOM+M.++%+++++%"
tablica$(8) = "%A+++++++AM+.O...+..+++++++MAM.++%+++++%"
tablica$(9) = "%MMMMMMMM+M+O+..++..++++MMMM+M.++%+++++%"
tablica$(10) = "%+++++++++M+O..++++..+++AAOM+M.++%+++++%"
tablica$(11) = "%+++++++++M.+..+++++++++AO.MAM.++%+++++%"
tablica$(12) = "%+++++++++MOA....+++++.+O.OM+M.++%+++++%"
tablica$(13) = "%+++++++++MO.+++++....++..+M+M.++%%%%%%%"
tablica$(14) = "%+++++++++M.OAO.+A....A++++MAM.++++++++%"
tablica$(15) = "%+++++++++MA+++.O++..++++++M+M.++++++++%"
tablica$(16) = "%++MMMMMMMM...+.+++++++OO+AM+M.++++++++%"
tablica$(17) = "%+.++AA+++M+OAO.O..++.+++..MAM.MMMMMMMM%"
tablica$(18) = "%+AA+.O+++M+A.+.+.A++A.+.AOM+M.++++++++%"
tablica$(19) = "%+++++++++M++++++++++++++++M+M+++++++++%"
tablica$(20) = "%+++++++++M++++++++++++++++MAM+...+...+%"
tablica$(21) = "%.......++M+++++O++++++++++M+M+...+...+%"
tablica$(22) = "%.......++M++++++++++++OOMMM+M+...+...+%"
tablica$(23) = "%.......++++++++++++++++++++AM+++++++++%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
ilemot = 2
motx(0) = 32: moty(0) = 22: motw(0) = 2
motx(1) = 36: moty(1) = 22: motw(1) = 2
x = 35: y = 15
wczytaj:
FOR yd = 0 TO 24
FOR xd = 0 TO 39
tabl(xd, yd) = ASC(MID$(tablica$(yd), xd + 1, 1))
NEXT xd
NEXT yd
END SUB
|
|
| Powrót do góry |
|
|
| Zobacz poprzedni temat :: Zobacz następny temat |
| Autor |
Wiadomość |
Piotr-246
Gość
|
| Wysłany: Pon 12:29, 28 Cze 2021 Temat postu: |
|
|
DECLARE SUB chrup ()
DECLARE SUB braniedia ()
DECLARE SUB beepkam (ulamek)
DECLARE SUB beepdia (ulamek)
DECLARE SUB plansza (ktora)
DECLARE SUB elementy ()
REM gra musi chodzic w trybie Turbo 97240 cykli
SCREEN 13
DEF SEG = 0
DIM SHARED diament(0 TO 16) AS LONG
DIM SHARED diament2(0 TO 16) AS LONG
DIM SHARED diament3(0 TO 16) AS LONG
DIM SHARED diament4(0 TO 16) AS LONG
DIM SHARED kamien(0 TO 16) AS LONG
DIM SHARED czyste(0 TO 16) AS LONG
DIM SHARED murek(0 TO 16) AS LONG
DIM SHARED wegiel(0 TO 16) AS LONG
DIM SHARED stal(0 TO 16) AS LONG
DIM SHARED motyl1(0 TO 16) AS LONG
DIM SHARED motyl2(0 TO 16) AS LONG
DIM SHARED motyl3(0 TO 16) AS LONG
DIM SHARED lawa1(0 TO 16) AS LONG
DIM SHARED lawa2(0 TO 16) AS LONG
DIM SHARED lawa3(0 TO 16) AS LONG
DIM SHARED gracz1(0 TO 16) AS LONG
DIM SHARED pomoc$(0 TO 7)
DIM SHARED tablica$(0 TO 24)
DIM SHARED tabl(0 TO 39, 0 TO 24) AS INTEGER
DIM SHARED motx(0 TO 7) AS INTEGER
DIM SHARED moty(0 TO 7) AS INTEGER
DIM SHARED motw(0 TO 7) AS INTEGER
DIM SHARED stary.port
DIM SHARED x, y, ilemot
REM ************************ zaladowanie elementow graficznych
elementy
REM startowa pozycja gracza
x = 25: y = 18
REM ****************************** zaladowanie 1 planszy
restart:
plansza (1)
REM ************************ dane startowe
restart2:
CLS
tabl(x, y) = 2
xs = x: ys = y
REM *************************** petla glowna
petla:
key$ = ""
REM *************************** sprawdzenie tablicy
beepk = 0: beepd = 0
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("@") THEN tabl(xb, yb) = ASC("."): REM tymczasowa przerwa
spadk = 0: spadd = 0
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("O"): tabl(xb, yb) = ASC("@"): spadk = 1: GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) = ASC(".") THEN tabl(xb, yb + 1) = ASC("A"): tabl(xb, yb) = ASC("@"): spadd = 1: GOTO skok
END IF
REM znaki wieksze od ascii 64 powoduja upadek w bok
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("O"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("O") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("O"): tabl(xb, yb) = ASC(".")
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb - 1, yb + 1) = ASC(".") AND tabl(xb - 1, yb) = ASC(".") THEN tabl(xb - 1, yb) = ASC("A"): tabl(xb, yb) = ASC("."): GOTO skok
END IF
IF pobrany = ASC("A") THEN
IF tabl(xb, yb + 1) > 64 THEN IF tabl(xb + 1, yb + 1) = ASC(".") AND tabl(xb + 1, yb) = ASC(".") THEN tabl(xb + 1, yb) = ASC("A"): tabl(xb, yb) = ASC(".")
END IF
skok:
REM dzwiek upadku
IF spadk = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepk = 1
IF tabl(xb, yb + 2) = ASC("X") THEN xdz = xb: ydz = yb + 2: GOSUB dziewiatka
END IF
IF spadd = 1 THEN
IF tabl(xb, yb + 2) <> ASC(".") THEN beepd = 1
IF tabl(xb, yb + 2) = ASC("X") THEN xdz = xb: ydz = yb + 2: GOSUB dziewiatka
END IF
NEXT xb
NEXT yb
REM ****************** ruch motyli ***********************
FOR mot = 0 TO ilemot - 1
IF moty(mot) = 0 THEN GOTO wyjdzzpetli
mx = motx(mot)
my = moty(mot)
wektor = motw(mot)
REM sprawdzenie dotkniecia lawy
styk = 0
IF tabl(mx + 1, my) = ASC("L") THEN styk = 1
IF tabl(mx - 1, my) = ASC("L") THEN styk = 1
IF tabl(mx, my - 1) = ASC("L") THEN styk = 1
IF tabl(mx, my + 1) = ASC("L") THEN styk = 1
IF styk = 1 THEN xdz = mx: ydz = my: GOSUB dziewiatka: GOTO wyjdzzpetli
ruch = 0
nie1 = 0: nie2 = 0: nie3 = 0: nie4 = 0
nie5 = 0: nie6 = 0: nie7 = 0: nie8 = 0
IF tabl(mx + 1, my - 1) <> ASC(".") THEN nie1 = 1
IF tabl(mx + 1, my) <> ASC(".") THEN nie2 = 1
IF tabl(mx + 1, my + 1) <> ASC(".") THEN nie3 = 1
IF tabl(mx, my + 1) <> ASC(".") THEN nie4 = 1
IF tabl(mx - 1, my + 1) <> ASC(".") THEN nie5 = 1
IF tabl(mx - 1, my) <> ASC(".") THEN nie6 = 1
IF tabl(mx - 1, my - 1) <> ASC(".") THEN nie7 = 1
IF tabl(mx, my - 1) <> ASC(".") THEN nie8 = 1
REM aby kontynuowal kierunek ruchu
powtorz = 0
IF wektor = 6 THEN GOTO wek6
IF wektor = 4 THEN GOTO wek4
IF wektor = 8 THEN GOTO wek8
jeszcze:
REM ruch w prawo
IF ruch = 0 AND nie8 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
IF ruch = 0 AND nie7 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
wek4:
REM ruch w dol
IF ruch = 0 AND nie2 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
IF ruch = 0 AND nie1 = 1 AND nie2 = 0 THEN ruch = 1: wektor = 2
wek6:
REM ruch w lewo
IF ruch = 0 AND nie4 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
IF ruch = 0 AND nie3 = 1 AND nie4 = 0 THEN ruch = 1: wektor = 4
wek8:
REM ruch w gore
IF ruch = 0 AND nie6 = 1 AND nie8 = 0 THEN ruch = 1: wektor = 8
IF ruch = 0 AND nie5 = 1 AND nie6 = 0 THEN ruch = 1: wektor = 6
REM sprawdz jeszcze raz
IF ruch = 0 AND powtorz = 0 AND (nie2 <> 0 OR nie4 <> 0 OR nie6 <> 0 OR nie8 <> 0) THEN powtorz = 1: GOTO jeszcze
REM motyl zapetlony w prozni
IF ruch = 0 AND nie2 = 0 AND nie4 = 0 AND nie6 = 0 AND nie8 = 0 THEN
IF fazamotyla = 0 THEN ruch = 1: wektor = 2
IF fazamotyla = 1 THEN ruch = 1: wektor = 4
IF fazamotyla = 2 THEN ruch = 1: wektor = 6
IF fazamotyla = 3 THEN ruch = 1: wektor = 8
END IF
REM wykonanie ruchu w tablicy
IF ruch = 1 AND wektor = 2 THEN tabl(mx, my) = ASC("."): mx = mx + 1
IF ruch = 1 AND wektor = 4 THEN tabl(mx, my) = ASC("."): my = my + 1
IF ruch = 1 AND wektor = 6 THEN tabl(mx, my) = ASC("."): mx = mx - 1
IF ruch = 1 AND wektor = 8 THEN tabl(mx, my) = ASC("."): my = my - 1
IF ruch = 0 THEN tabl(mx, my) = ASC("X")
IF ruch = 1 THEN tabl(mx, my) = ASC("X "): motx(mot) = mx: moty(mot) = my
motw(mot) = wektor
wyjdzzpetli:
NEXT mot
REM ****************** losowe rozszerzanie lawy
FOR speed = 1 TO 8: REM szybkosc powiekszania alwy
xlos = INT(RND(1) * 38) + 1
ylos = INT(RND(1) * 23) + 1
IF tabl(xlos, ylos) = ASC("L") THEN
REM loslawa = INT(RND(1) * 4)
IF tabl(xlos - 1, ylos) = ASC(".") THEN tabl(xlos - 1, ylos) = ASC("L"): GOTO lawaend
IF tabl(xlos + 1, ylos) = ASC(".") THEN tabl(xlos + 1, ylos) = ASC("L"): GOTO lawaend
IF tabl(xlos, ylos - 1) = ASC(".") THEN tabl(xlos, ylos - 1) = ASC("L"): GOTO lawaend
IF tabl(xlos, ylos + 1) = ASC(".") THEN tabl(xlos, ylos + 1) = ASC("L")
lawaend:
END IF
NEXT speed
REM *************************** wyswietlenie tablicy
FOR yb = 24 TO 0 STEP -1
k$ = INKEY$
IF k$ <> "" THEN key$ = k$
FOR xb = 0 TO 39
pobrany = tabl(xb, yb)
IF pobrany = ASC("+") THEN PUT (xb * 8, yb * 8), wegiel, OR: GOTO wyjdz
IF pobrany = ASC("%") THEN PUT (xb * 8, yb * 8), stal, OR: GOTO wyjdz
IF pobrany = ASC("M") THEN PUT (xb * 8, yb * 8), murek, OR: GOTO wyjdz
REM czysczenie tylko pod niektore elementy
PUT (xb * 8, yb * 8), czyste, AND
IF pobrany = ASC("O") THEN PUT (xb * 8, yb * 8), kamien, OR
IF pobrany = ASC("X") THEN
IF fazamotyla = 0 OR fazamotyla = 5 THEN PUT (xb * 8, yb * 8), motyl1, OR
IF fazamotyla = 1 THEN PUT (xb * 8, yb * 8), motyl2, OR
IF fazamotyla = 2 OR fazamotyla = 3 THEN PUT (xb * 8, yb * 8), motyl3, OR
IF fazamotyla = 4 THEN PUT (xb * 8, yb * 8), motyl2, OR
END IF
REM falowanie diamentu:
IF pobrany = ASC("A") THEN
IF faza = 0 THEN PUT (xb * 8, yb * 8), diament, OR
IF faza = 1 THEN PUT (xb * 8, yb * 8), diament2, OR
IF faza = 2 THEN PUT (xb * 8, yb * 8), diament3, OR
IF faza = 3 THEN PUT (xb * 8, yb * 8), diament4, OR
END IF
REM falowanie lawy
IF pobrany = ASC("L") THEN
IF fazalawy = 0 THEN PUT (xb * 8, yb * 8), lawa1, OR
IF fazalawy = 1 THEN PUT (xb * 8, yb * 8), lawa2, OR
IF fazalawy = 2 THEN PUT (xb * 8, yb * 8), lawa3, OR
IF fazalawy = 3 THEN PUT (xb * 8, yb * 8), lawa2, OR
END IF
IF pobrany = 2 THEN PUT (xb * 8, yb * 8), gracz1, OR
wyjdz:
NEXT xb
IF beepk = 1 THEN beepkam (yb): GOTO skok3
IF beepd = 1 THEN beepdia (yb)
skok3:
NEXT yb
skok2:
REM ************** zmiana fazy falowania motyli i diamentow:
faza = faza + 1
IF faza = 4 THEN faza = 0
fazamotyla = fazamotyla + 1
IF fazamotyla = 6 THEN fazamotyla = 0
fazalawy = fazalawy + 1
IF fazalawy = 4 THEN fazalawy = 0
REM ********************* obsluga klawiatury
IF key$ = "" THEN GOTO petla
k$ = key$
POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury
IF k$ = CHR$(27) THEN END
IF k$ = "1" THEN GOTO restart
IF k$ = "2" THEN plansza (2): GOTO restart2
IF k$ = "3" THEN plansza (3): GOTO restart2
IF k$ = "4" THEN plansza (4): GOTO restart2
dx = 0: dy = 0
IF k$ = CHR$(0) + "M" THEN x = x + 1: dx = 1
IF k$ = CHR$(0) + "K" THEN x = x - 1: dx = -1
IF k$ = CHR$(0) + "H" THEN y = y - 1
IF k$ = CHR$(0) + "P" THEN y = y + 1
REM ************ sprawdzenie czy wolno wykonac ruch
pobrany = tabl(x, y)
IF y = ys AND pobrany = ASC("O") THEN IF tabl(xs + dx * 2, y) = ASC(".") THEN tabl(xs + dx * 2, y) = ASC("O"): GOTO nowa
IF pobrany <> ASC(".") AND pobrany <> ASC("+") AND pobrany <> ASC("A") THEN x = xs: y = ys: GOTO petla
IF pobrany = ASC("+") THEN chrup
IF pobrany = ASC("A") THEN braniedia
nowa:
REM ************* kasowanie w tablicy starej pozycji gracza
tabl(xs, ys) = ASC(".")
REM ************* wstawienie do tablicy nowej pozycji gracza
tabl(x, y) = 2
REM zapamietanie starej pozycji gracza
xs = x: ys = y
GOTO petla
REM ****** dziewiec diamentow za motyla
dziewiatka:
FOR yy = ydz - 1 TO ydz + 1
FOR xx = xdz - 1 TO xdz + 1
IF tabl(xx, yy) <> ASC("%") THEN tabl(xx, yy) = ASC("A")
NEXT xx
NEXT yy
REM ktory motyl?
FOR ktory = 0 TO ilemot - 1
IF motx(ktory) = xdz AND moty(ktory) = ydz THEN motx(ktory) = 0: moty(ktory) = 0
NEXT ktory
RETURN
SUB beepdia (ulamek)
IF ulamek < 24 GOTO pominstart
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
pominstart:
FOR i = 1 TO 1
OUT 66, 102: OUT 66, 1
OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 1
REM OUT 66, 250: OUT 66, 0
REM OUT 66, 64: OUT 66, 3
REM OUT 66, 250: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
IF ulamek > 0 THEN GOTO pominkoniec
REM wylaczenie glosnika
OUT 97, stary.port
pominkoniec:
END SUB
SUB beepkam (ulamek)
IF ulamek < 24 THEN GOTO ominto
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
ominto:
FOR i = 1 TO 15
OUT 66, 42: OUT 66, 0
OUT 66, 71: OUT 66, 3
OUT 66, 135: OUT 66, 1
REM OUT 66, 35: OUT 66, 1
REM OUT 66, 135: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
IF ulamek > 0 THEN GOTO omindrugie
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
omindrugie:
END SUB
SUB braniedia
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 100 TO 1 STEP -1
OUT 66, i: OUT 66, 3
FOR j = 1 TO 150: NEXT j
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB chrup
DEF SEG = 0
REM wlaczene zegara
OUT 67, 182
REM odczytanie wartosci portu 97
stary.port = INP(97)
REM ustawienie wartosci "1" dla bitow 1 i 0
nowy.port = (stary.port OR 3)
REM wlaczenie glosnika
OUT 97, nowy.port
REM najpierw mlodszy potem starszy bajt
t0 = PEEK(1132)
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 64: OUT 66, 0
OUT 66, 20: OUT 66, 0
OUT 66, 32: OUT 66, 0
NEXT i
FOR i = 1 TO 100
OUT 66, 32: OUT 66, 0
OUT 66, 54: OUT 66, 0
OUT 66, 48: OUT 66, 0
OUT 66, 60: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB elementy
REM zielony wegiel
PALETTE 32, 5 * 65536 + 12 * 256 + 0
PALETTE 33, 9 * 65536 + 14 * 256 + 2
PALETTE 34, 12 * 65536 + 18 * 256 + 6
FOR i = 0 TO 15
REM odcienie kamienia +48
PALETTE 48 + i, INT(i * 2.5) * 65536 + i * 3 * 256 + i * 4
REM odcienie diamentu +64
PALETTE 64 + i, INT(i * 4) * 65536 + INT(i * 3.7) * 256 + INT(i * 3.2)
NEXT i
GET (0, 0)-(7, 7), czyste
pomoc$(0) = "...@@......@@......@@......@@..."
pomoc$(1) = "..@$$@....@**@....@::@....@##@.."
pomoc$(2) = ".@****@..@::::@..@####@..@$$$$@."
pomoc$(3) = "@::::::@@######@@$$$$$$@@******@"
pomoc$(4) = "@######@@$$$$$$@@******@@::::::@"
pomoc$(5) = ".@$$$$@..@****@..@::::@..@####@."
pomoc$(6) = "..@**@....@::@....@##@....@$$@.."
pomoc$(7) = "...@@......@@......@@......@@..."
FOR yr = 0 TO 7
FOR xr = 0 TO 31
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 0 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 10 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 15 + 64: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 13 + 64: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), diament
GET (8, 0)-(15, 7), diament2
GET (16, 0)-(23, 7), diament3
GET (24, 0)-(31, 7), diament4
pomoc$(0) = "..*$**.."
pomoc$(1) = ".*$###*."
pomoc$(2) = "**$$###*"
pomoc$(3) = "$#*$$#$*"
pomoc$(4) = "*:*#$$#$"
pomoc$(5) = "*$*$:$#*"
pomoc$(6) = ".*:*$**."
pomoc$(7) = "..:*:*.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = ":" THEN COLOR 3 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 6 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 9 + 48: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 48: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), kamien
pomoc$(0) = ".###.###"
pomoc$(1) = ".###.###"
pomoc$(2) = ".###.###"
pomoc$(3) = "........"
pomoc$(4) = "##.###.#"
pomoc$(5) = "##.###.#"
pomoc$(6) = "##.###.#"
pomoc$(7) = "........"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 13 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), murek
pomoc$(0) = "$*******"
pomoc$(1) = "**#*$***"
pomoc$(2) = "*****$*$"
pomoc$(3) = "*$**#***"
pomoc$(4) = "***$**$*"
pomoc$(5) = "$******#"
pomoc$(6) = "**$**$**"
pomoc$(7) = "*#**$***"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 33: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 32: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 34: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), wegiel
pomoc$(0) = "########"
pomoc$(1) = "#**##**#"
pomoc$(2) = "#*.##*.#"
pomoc$(3) = "########"
pomoc$(4) = "########"
pomoc$(5) = "#**##**#"
pomoc$(6) = "#*.##*.#"
pomoc$(7) = "########"
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 1 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 5 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 11 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), stal
CLS
pomoc$(0) = "#......#.#....#...#..#.."
pomoc$(1) = "@@....@@.@@..@@....@@..."
pomoc$(2) = "@$$..$$@..$$$$.....$$..."
pomoc$(3) = "*&*&*&*&..*&*&.....&*..."
pomoc$(4) = "&*&*&*&*..&*&*.....*&..."
pomoc$(5) = "@$$..$$@..$$$$.....$$..."
pomoc$(6) = "@@....@@.@@..@@....@@..."
pomoc$(7) = "#......#.#....#...#..#.."
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "&" THEN COLOR 2 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 11 + 16: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "$" THEN COLOR 8 + 16: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), motyl1
GET (8, 0)-(15, 7), motyl2
GET (16, 0)-(23, 7), motyl3
CLS
pomoc$(0) = "..@@@..."
pomoc$(1) = "..@@@..."
pomoc$(2) = "...@...."
pomoc$(3) = ".*****.."
pomoc$(4) = "*.***.*."
pomoc$(5) = "..###..."
pomoc$(6) = "..#.#..."
pomoc$(7) = ".##.##.."
FOR yr = 0 TO 7
FOR xr = 0 TO 7
IF MID$(pomoc$(yr), xr + 1, 1) = "." THEN COLOR 0: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "@" THEN COLOR 15: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 14: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), gracz1
CLS
pomoc$(0) = "#####################**#"
pomoc$(1) = "#####**######**#####****"
pomoc$(2) = "#############**#####****"
pomoc$(3) = "##**#################**#"
pomoc$(4) = "#****#####**############"
pomoc$(5) = "#****#####**######**####"
pomoc$(6) = "##**####################"
pomoc$(7) = "########################"
FOR yr = 0 TO 7
FOR xr = 0 TO 23
IF MID$(pomoc$(yr), xr + 1, 1) = "#" THEN COLOR 12: PSET (xr, yr)
IF MID$(pomoc$(yr), xr + 1, 1) = "*" THEN COLOR 4: PSET (xr, yr)
NEXT xr
NEXT yr
GET (0, 0)-(7, 7), lawa1
GET (8, 0)-(15, 7), lawa2
GET (16, 0)-(23, 7), lawa3
CLS
END SUB
SUB plansza (ktora)
IF ktora = 2 THEN GOTO plansza2
IF ktora = 3 THEN GOTO plansza3
IF ktora = 4 THEN GOTO plansza4
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%A++.OO.AOOAOAA.AAA%AAO++OA++A+AO+++O+O%"
tablica$(2) = "%OA.++A+++A+O+++OAO%O++AOA+A+A+AO+A+AA+%"
tablica$(3) = "%+A+A+++AOAAOAAOOAA%AAO+AOAOAAOAAAOAO++%"
tablica$(4) = "%O++MMMMMMMMMMMMMMM%+O+OOAAA+AAAOAO+AOA%"
tablica$(5) = "%AA+++AO++AAOAA+AAA%A+AO+++OAOOAAO++O++%"
tablica$(6) = "%+O+O++A.+AOO++O++O%+O+AAOA+OA+AO+AOA++%"
tablica$(7) = "%A+A+AOAAOAAAOAA+OA%AAAO+AAAOAOAAAO+OA+%"
tablica$(8) = "%MMMMMMMMMMMMMMM+++%A+AAAOAAOAAAAOO+A+A%"
tablica$(9) = "%+O+++O+++++O+.++A+%OAAA+OAAAOAAOAOOAAA%"
tablica$(10) = "%++++++OA+++O++A+++%AOAAAAOAAOAAOAAAAAA%"
tablica$(11) = "%+.+OA+++.O.++++...%AAAOAOAAOAAAAAOOAOA%"
tablica$(12) = "%+.++%%%%%%%%%%%%%%%%%%%%%%%%+%%%%%%%%%%"
tablica$(13) = "%+O+++A++++..+++++++++++...........++++%"
tablica$(14) = "%++++++++++..++.+++++++.............+++%"
tablica$(15) = "%+.+++.++++A+++.++++++...............++%"
tablica$(16) = "%+.+++.++++...+.+++++.................+%"
tablica$(17) = "%+.+++.+++++OAO.+++%...................%"
tablica$(18) = "%+.+++.++++++++.+..%...................%"
tablica$(19) = "%+.+++.+++++.++.+.+%...................%"
tablica$(20) = "%+.+++.+++++.++.+++%...................%"
tablica$(21) = "%+.+++.+++++.++.++.%...................%"
tablica$(22) = "%+.+++.++++.....+..%...................%"
tablica$(23) = "%++++++++++++++++..%...................%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
ilemot = 2
motx(0) = 2: moty(0) = 22: motw(0) = 2
motx(1) = 6: moty(1) = 22: motw(1) = 2
GOTO wczytaj
plansza2:
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%+++++%....LLLLLLLLLLLLLLLLLL....%+++++%"
tablica$(2) = "%+...+%.......LLLLLLLLLLL........%+...+%"
tablica$(3) = "%+...+%..........................%+...+%"
tablica$(4) = "%+...+%..........................%+...+%"
tablica$(5) = "%+++++%..........................%+++++%"
tablica$(6) = "%+++++%.M.M.M.M.M.%%%%.M.M.M.M.M.%+++++%"
tablica$(7) = "%+++++%.M.M.M.M.M.%%%%.M.M.M.M.M.%+++++%"
tablica$(8) = "%+++++%.M.M.M.M.M.%%%%.M.M.M.M.M.%+++++%"
tablica$(9) = "%+++++............................+++++%"
tablica$(10) = "%+++++............................+++++%"
tablica$(11) = "%+++++............................+++++%"
tablica$(12) = "%+++++............................+++++%"
tablica$(13) = "%++++++++++++++++++++++++++++++++++++++%"
tablica$(14) = "%++++++++++++++++++++++++++++++++++++++%"
tablica$(15) = "%++++++++++++++++++++++++++++++++++++++%"
tablica$(16) = "%++++++++++++++++++++++++++++++++++++++%"
tablica$(17) = "%++++++++++++++++++++++++++++++++++++++%"
tablica$(18) = "%++++++++++++++++++++++++++++++++++++++%"
tablica$(19) = "%++++++++++++++++++++++++++++++++++++++%"
tablica$(20) = "%+...+++...+++...++++++...+++...+++...+%"
tablica$(21) = "%+...+++...+++...++++++...+++...+++...+%"
tablica$(22) = "%+...+++...+++...++++++...+++...+++...+%"
tablica$(23) = "%++++++++++++++++++++++++++++++++++++++%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
ilemot = 8
motx(0) = 3: moty(0) = 4: motw(0) = 2
motx(1) = 36: moty(1) = 4: motw(1) = 2
motx(2) = 3: moty(2) = 22: motw(2) = 2
motx(3) = 9: moty(3) = 22: motw(3) = 2
motx(4) = 15: moty(4) = 22: motw(4) = 2
motx(5) = 24: moty(5) = 22: motw(5) = 2
motx(6) = 30: moty(6) = 22: motw(6) = 2
motx(7) = 36: moty(7) = 22: motw(7) = 2
x = 35: y = 15
GOTO wczytaj
plansza3:
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%+++.O...O.AO++++++++++++++++A+AO+++O+O%"
tablica$(2) = "%.A.++++.+A+.+++++++++++++++++++++A+AA+%"
tablica$(3) = "%++O++A+.O.AO.++++++++++++++MMMMMA.AO++%"
tablica$(4) = "%+++O.++O...+++OMMMMMMMMO++++A.A+AO+AOA%"
tablica$(5) = "%.A++.AO++A.O+++M......M++++A+A+++AAO++%"
tablica$(6) = "%+O+.MMMMMMMO+++M......M++++OA+AO+A++++%"
tablica$(7) = "%A+.+A.A++AO.+++M......M+++O++OAMMMMM++%"
tablica$(8) = "%A..AO...O++.+++M..OO..M+++AO+++A+O+A+A%"
tablica$(9) = "%AA.A+.O.+.+O+++M..++..M+++++OA.OAO+A.A%"
tablica$(10) = "%++O+A.OA.A+O+++M.O++O.M+++AAOAAOAA.AAA%"
tablica$(11) = "%A+.O.+A.OA.++++M.++++.M+++.OAA+++O++OA%"
tablica$(12) = "%+++O..O.++OA+++MO+..+OM++++++.AA+A..O.%"
tablica$(13) = "%+A+A.+.OA.O.+++M+....+M++++AA.O..+++.+%"
tablica$(14) = "%MMMMMMMMM+.O+++MA....AM+++MM..++.MMMMM%"
tablica$(15) = "%++++A+++A.A++++M+A..A+M+++O.....AA..++%"
tablica$(16) = "%+A.++.O+++..+++M++AA++M++++++AA++AA..+%"
tablica$(17) = "%+.++A.AOA++O+++M..AA..M+++.A.++++++.A.%"
tablica$(18) = "%+AA+.O+A+.+A+++M.A++A.M+++O..+++.A.++.%"
tablica$(19) = "%+++++++++++++++MA++++AM+++++++++++++++%"
tablica$(20) = "%%%%%%%%%%%+++++MMMMMMMM+++++%%%%%%%%%%%"
tablica$(21) = "%AAAA......++++++++++++++++++%AAAAAAAAA%"
tablica$(22) = "%MMMMMMMMMM++++++++++++++++++%AOOOOOOOA%"
tablica$(23) = "%AAAA......+++++++++++++++++++AAAAAAAAA%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
ilemot = 2
motx(0) = 8: moty(0) = 21: motw(0) = 2
motx(1) = 8: moty(1) = 23: motw(1) = 2
GOTO wczytaj
plansza4:
tablica$(0) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
tablica$(1) = "%OOOOOOOOOMAO.A.AAA.AAO++OAM+MLLLLLLLLL%"
tablica$(2) = "%A+++++++AM+.+++O.....+AOA+MAM.+++LLLLL%"
tablica$(3) = "%OOOOOOOO+MAO.AOOA++++..AOAM+M.++%%%%%%%"
tablica$(4) = "%A+++++++AM.+++.++++++++OAAM+M.++%+++++%"
tablica$(5) = "%+OOOOOOOOM.OAA++......++++MAM.++%+++++%"
tablica$(6) = "%A+++++++AMMO+.+++++++.+A.AM+M.++%+++++%"
tablica$(7) = "%OOOOOOOO+MO.O..+++++++++OOM+M.++%+++++%"
tablica$(8) = "%A+++++++AM+.O...+..+++++++MAM.++%+++++%"
tablica$(9) = "%MMMMMMMM+M+O+..++..++++MMMM+M.++%+++++%"
tablica$(10) = "%+++++++++M+O..++++..+++AAOM+M.++%+++++%"
tablica$(11) = "%+++++++++M.+..+++++++++AO.MAM.++%+++++%"
tablica$(12) = "%+++++++++MOA....+++++.+O.OM+M.++%+++++%"
tablica$(13) = "%+++++++++MO.+++++....++..+M+M.++%%%%%%%"
tablica$(14) = "%+++++++++M.OAO.+A....A++++MAM.++++++++%"
tablica$(15) = "%+++++++++MA+++.O++..++++++M+M.++++++++%"
tablica$(16) = "%++MMMMMMMM...+.+++++++OO+AM+M.++++++++%"
tablica$(17) = "%+.++AA+++M+OAO.O..++.+++..MAM.MMMMMMMM%"
tablica$(18) = "%+AA+.O+++M+A.+.+.A++A.+.AOM+M.++++++++%"
tablica$(19) = "%+++++++++M++++++++++++++++M+M+++++++++%"
tablica$(20) = "%+++++++++M++++++++++++++++MAM+...+...+%"
tablica$(21) = "%.......++M+++++O++++++++++M+M+...+...+%"
tablica$(22) = "%.......++M++++++++++++OOMMM+M+...+...+%"
tablica$(23) = "%.......++++++++++++++++++++AM+++++++++%"
tablica$(24) = "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
ilemot = 2
motx(0) = 32: moty(0) = 22: motw(0) = 2
motx(1) = 36: moty(1) = 22: motw(1) = 2
x = 35: y = 15
wczytaj:
FOR yd = 0 TO 24
FOR xd = 0 TO 39
tabl(xd, yd) = ASC(MID$(tablica$(yd), xd + 1, 1))
NEXT xd
NEXT yd
END SUB
|
|
| Powrót do góry |
|
|
|
|
Możesz pisać nowe tematy
Możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
|
fora.pl - załóż własne forum dyskusyjne za darmo
Powered by phpBB © 2001, 2005 phpBB Group
|
FAQ
Szukaj
Użytkownicy
Grupy
Galerie
Rejestracja
Zaloguj się, by sprawdzić wiadomości
Zaloguj
