Życie Wieczne

Piotr-246 · Gość

DECLARE SUB zabranie ()

REM Gra "Serca" UWAGA wersaj gry wymaga
REM emulatora o predkosci 6075 cyklow
REM wymaga pliku bitmap1.scr utworzonego przez modul bsave.bas

DECLARE SUB dreptanie ()
DECLARE SUB animacja ()
DECLARE SUB rysowanie ()
DECLARE SUB palety ()
DECLARE SUB plansze ()
DECLARE SUB cegly ()

REM plansza startowa:
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
roomx = 7: roomy = 4

DIM SHARED kolor$(0 TO 255)
DIM pamiec(0 TO 128) AS LONG
DIM poledzialania(0 TO 240) AS LONG
DIM SHARED p$(0 TO 159)
DIM SHARED kod$
DIM SHARED serca(0 TO 15, 0 TO 9) AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER

REM pamiec tla pod wziatek

DIM SHARED tlo(0 TO 32) AS LONG

REM tlo

DIM SHARED szaretlo(0 TO 74) AS LONG
DIM SHARED szaretlo2(0 TO 148) AS LONG
DIM SHARED szaretlo4(0 TO 300) AS LONG
REM dane elementow planszy

DIM SHARED ceg2(0 TO 75) AS LONG
DIM SHARED ceg40(0 TO 730) AS LONG
DIM SHARED ceg17plus17(0 TO 730) AS LONG
DIM SHARED ceg13plus13(0 TO 760) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 750) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED nieb(0 TO 145) AS LONG

DIM SHARED blokp(0 TO 74) AS LONG
DIM SHARED bloks(0 TO 74) AS LONG
DIM SHARED blokk(0 TO 74) AS LONG
DIM SHARED blok2(0 TO 158) AS LONG
DIM SHARED blok4(0 TO 296) AS LONG

REM ****************** DANE ANIMACJI

DIM SHARED znakp1(0 TO 128) AS LONG
DIM SHARED znakl1(0 TO 128) AS LONG
DIM SHARED znakp2(0 TO 128) AS LONG
DIM SHARED znakl2(0 TO 128) AS LONG
DIM SHARED znakp3(0 TO 128) AS LONG
DIM SHARED znakl3(0 TO 128) AS LONG
DIM SHARED vertd1(0 TO 128) AS LONG

REM matryce okien

DIM SHARED window1(0 TO 160) AS LONG
DIM SHARED window2(0 TO 160) AS LONG
DIM SHARED window3(0 TO 160) AS LONG

DIM SHARED wentylator(0 TO 64) AS LONG

REM ************************* DANE STARTOWE

SCREEN 13
REM PRINT FRE(-2): END
DEF SEG = 0: REM - to dla pomiaru predkosci

x = 150: y = 35: xs = 150: ys = 35: REM wspolrzedne poczatkowe gracza na ekranie
licz = -1: REM wartosc startowa zegara
REM roomx = 3: roomy = 3 przeniesione wyzej
kolwent = 30 + 30 * 256 + 30 * 65536: REM kolor lopat wentylatora

REM ***** SUB palety - ustawienie nowych wartosci barw
palety

REM ***** SUB cegly - zapelnienie pozostalych tablic
cegly

REM SUB plansze - wypelnienie tablicy wygladu plansz
plansze

REM SUB animacja - tablice animacji postaci
REM animacja

REM ************************* WYBOR POMIESZCZENIA

rysuj:

kod$ = p$(roomx + roomy * 16)

REM ******************** rysowanie pomieszczenia
t0 = PEEK(1132): REM pomiar czasu rysowania

REM SUB rysowanie - rysowanie planszy
rysowanie

REM pomiar czasu rysowania
t1 = PEEK(1132):

REM menu na dole
COLOR 235
REM LOCATE 23, 1: FOR i = 1 TO 40: PRINT CHR$(223); : NEXT i
LOCATE 25, 15: PRINT "L-SHIFT ALT P-SHIFT";

LOCATE 24, 2: COLOR 3: PRINT "T:"; t0; "/"; t1; FRE(-2);
PRINT " ROOM:"; roomx; "/"; roomy; "--";

REM **************** zapamietanie pola pod graczem
GET (x, y)-(x + 15, y + 31), pamiec
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
REM PUT (x, y), vertd1, PSET
liczsercaroom = 0: zrobione = 0
GOTO postaw
REM *************************** PETLA GLOWNA

petla:
dx = 0: dy = 0
IF dzwiekbrania = 1 THEN dzwiekbrania = 0: zabranie

REM ******************* czas gry w sekundach

se$ = MID$(TIME$, 7, 2)
se = VAL(se$)
IF se <> ses THEN licz = licz + 1
ses = se
LOCATE 25, 2: COLOR 15: PRINT "Czas:"; licz;

REM ************************ petla opozniajaca
FOR delay = 1 TO 700: NEXT delay

REM faza wentylatora

komorka = PEEK(1132) / 1.5
faz = INT(komorka)
IF faz / 3 = INT(faz / 3) THEN faza = 0
IF (faz + 1) / 3 = INT((faz + 1) / 3) THEN faza = 1
IF (faz + 2) / 3 = INT((faz + 2) / 3) THEN faza = 2
FOR i = 0 TO 2: i16 = i * 16
IF faza = 0 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, 0
IF faza = 1 THEN PALETTE 11 + i16, 0: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, kolwent
IF faza = 2 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, 0: PALETTE 13 + i16, kolwent
NEXT i

REM ************************ sprawdzenie klawiszy

alt = 0: lshift = 0: pshift = 0: skos = 0

k$ = INKEY$
IF k$ = "f" THEN roomx = roomx - 1: GOTO rysuj
IF k$ = "h" THEN roomx = roomx + 1: GOTO rysuj
IF k$ = "t" THEN roomy = roomy - 1: GOTO rysuj
IF k$ = "b" THEN roomy = roomy + 1: GOTO rysuj

IF k$ = CHR$(27) THEN END

REM klawisz alt - wznoszenie sie
IF (PEEK(1047) AND 8) = 8 THEN alt = 1
IF (PEEK(1047) AND 2) = 2 THEN lshift = 1
IF (PEEK(1047) AND 1) = 1 THEN pshift = 1

REM bezruch = grawitacja
IF lshift = 0 AND pshift = 0 AND alt = 0 THEN dy = 2: vert = 1: obrot = 0: przebiervert = 0: GOTO czy

POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury

IF lshift = 1 THEN dx = -4: dy = 2: obrot = -1: vert = 0
IF pshift = 1 THEN dx = 4: dy = 2: obrot = 1: vert = 0
IF alt = 1 THEN dy = -4: vert = 1
IF dx <> 0 AND dy <> 0 THEN skos = 1
czy:

REM ************ sprawdzenie czy jest przejscie do innej planszy

IF x + dx > 300 THEN x = 5: xs = 5: roomx = roomx + 1: GOTO rysuj
IF x + dx < 3 THEN x = 300: xs = 300: roomx = roomx - 1: GOTO rysuj
IF y + dy > 144 THEN y = 5: ys = 5: roomy = roomy + 1: GOTO rysuj
IF y + dy < 4 THEN y = 145: ys = 145: roomy = roomy - 1: GOTO rysuj

REM *********** sprawdzenie czy ruch jest mozliwy
REM sprawdzenie przeszkody. Przeszkoda sa kolory > 200

xmozliwy = 0: xniemozliwy = 0
ymozliwy = 0: yniemozliwy = 0

REM sprawdzenie sasiedztwa obok

IF dx > 0 THEN
FOR i = 0 TO 31: punkt = POINT(x + 19, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 198 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF

IF dx < 0 THEN
FOR i = 0 TO 31: punkt = POINT(x - 3, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 199 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF xniemozliwy = 0 THEN xmozliwy = 1
IF xniemozliwy = 1 THEN xmozliwy = 0

REM sprawdzenie sasiedztwa gora dol

IF dy > 0 THEN
FOR i = 0 TO 15:
IF POINT(x + i, y + 32) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y + 33) > 200 THEN yniemozliwy = 1: EXIT FOR

NEXT i
END IF

IF dy < 0 THEN
FOR i = 0 TO 15
IF POINT(x + i, y - 4) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y - 5) > 200 THEN yniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF yniemozliwy = 0 THEN ymozliwy = 1
IF yniemozliwy = 1 THEN ymozliwy = 0

REM ruch gdy oba mozliwe x oraz y
IF ymozliwy = 1 AND xmozliwy = 1 THEN IF dx <> 0 OR dy <> 0 THEN GOTO ruch

REM szczegolne przypadki gdy tylko x albo y mozliwy
IF ymozliwy = 0 AND xmozliwy = 1 THEN dy = 0: GOTO czy
IF ymozliwy = 1 AND xmozliwy = 0 THEN dx = 0: GOTO czy

REM ruch niemozliwy powrot petli glownej bez zmian pozostaja x y

x = xs: y = ys
GOTO petla

REM ***************** RUCH

ruch:

x = x + dx: y = y + dy
IF dy = 0 AND przebieranie = 0 AND alt = 0 THEN dreptanie: REM dzwiek chodzenia

REM ******************** czy jest wziatek
deltawx = ABS(x + 4 - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek

REM ************************************** operacja odswiezania tla
postaw:
REM punkt 1 zapamietanie nowego pola dzialania (brudnego)
REM w oparciu o nowe x,y

GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania

REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo

deltax = x - xs: deltay = y - ys
inversx = -1 * deltax: inversy = -1 * deltay
inver4 = INT(inversx / 4)
FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = (yt + inversy) * 6
FOR xt = 0 TO 3
index1 = 1 + (yt6 + 24) + (xt + inver4) + 1
index2 = 1 + yt4 + xt
poledzialania(index1) = pamiec(index2)
NEXT xt: NEXT yt

REM zmazanie serca z pola dzialania

IF liczsercaroom = 1 AND zrobione = 0 THEN
zrobione = 1
PUT (x - 4, y - 4), poledzialania, PSET
PUT (xserca, yserca), tlo, PSET
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
END IF

REM nowa mala pamiec

FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = yt * 6
FOR xt = 0 TO 3:
index1 = 1 + (yt6 + 24) + (xt + 1):
index2 = 1 + yt4 + xt:
pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt

REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU

REM aby nie rysowac dwoch postaci w przypadku skosu
IF skos = 1 THEN GOTO bezskosu:

REM ************************** ruch w dol lub gore

IF vert = 1 THEN wkleic = 7: GOTO wklej
bezskosu:
REM ************************** ruch w lewo

IF obrot = -1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1
IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 1: GOTO wklej
IF przebieranie = 1 THEN wkleic = 2: GOTO wklej
IF przebieranie = 2 THEN wkleic = 3: GOTO wklej
END IF

REM ****************** ruch w prawo

IF obrot = 1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1

IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 4: GOTO wklej
IF przebieranie = 1 THEN wkleic = 5: GOTO wklej
IF przebieranie = 2 THEN wkleic = 6: GOTO wklej
END IF

xs = x: ys = y

GOTO petla

wklej:

IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt
IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt
IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt
IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt
IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt
IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt
IF wkleic = 7 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)): NEXT xt: NEXT yt

REM wklejenie wyniku operacji na tablicy:
PUT (x - 4, y - 4), poledzialania, PSET

xs = x: ys = y
GOTO petla

REM GOSUB-RETURN****************************** obsluga wziatku

wziatek:
IF serca(roomx, roomy) = 0 THEN GOTO niemawziatku
IF liczsercaroom = 1 THEN GOTO niemawziatku
serca(roomx, roomy) = 0
liczserca = liczserca + 1
PUT (xserca, yserca), tlo, PSET

liczsercaroom = 1
dzwiekbrania = 1

LOCATE 1, 1: COLOR 6: PRINT liczserca;
niemawziatku:
RETURN

SUB animacja
REM ************************ znaczek - glowny bohater
REM ****************** DANE ANIMACJI
REM ten SUB jest do skasowania

END SUB

SUB cegly

BLOAD "bitmap1.scr"

REM INPUT a$
REM pobranie z ekranu tablic elementow
REM uwaga! wysokosc elementu to 9 lub 18 px

GET (0, 0)-(31, 8), ceg2
GET (0, 0)-(319, 8), ceg40
GET (0, 9)-(319, 17), ceg17plus17
GET (0, 18)-(319, 26), ceg13plus13
GET (0, 27)-(319, 35), ceg4plus20plus4
GET (0, 36)-(15, 53), szaretlo
GET (0, 36)-(31, 53), szaretlo2
GET (0, 36)-(63, 53), szaretlo4: REM 36+18=46+8=54

GET (16, 64)-(31, 79), palma
GET (32, 64)-(47, 81), blokp
GET (48, 64)-(63, 81), bloks
GET (64, 64)-(79, 81), blokk
GET (0, 156)-(31, 173), blok2
GET (0, 156)-(63, 173), blok4
GET (80, 64)-(111, 81), nieb

GET (0, 88)-(15, 119), znakl1
GET (16, 88)-(31, 119), znakp1
GET (32, 88)-(47, 119), znakl2
GET (48, 88)-(63, 119), znakp2
GET (64, 88)-(79, 119), znakl3
GET (80, 88)-(95, 119), znakp3
GET (96, 88)-(111, 119), vertd1

GET (0, 120)-(31, 139), window1
GET (32, 120)-(63, 139), window2
GET (64, 120)-(95, 139), window3
GET (0, 140)-(15, 155), wentylator
CLS
END SUB

SUB dreptanie

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)

REM ewentualnie:
REM OUT 66, 30: OUT 66, 0
REM OUT 66, 164: OUT 66, 2
REM OUT 66, 130: OUT 66, 1
REM OUT 66, 74: OUT 66, 0
REM OUT 66, 220: OUT 66, 1

FOR i = 1 TO 10
OUT 66, 30: OUT 66, 0
OUT 66, 84: OUT 66, 2
OUT 66, 30: OUT 66, 0
OUT 66, 94: OUT 66, 2
OUT 66, 10: OUT 66, 0
OUT 66, 40: OUT 66, 2
OUT 66, 84: OUT 66, 0
OUT 66, 10: 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 palety

REM palety kolorow *********************************
REM max koloru=3F

FOR i = 0 TO 255: kolor$(i) = "00 00 00 00"
PALETTE i, 31 + 31 * 256 + 31 * 65536: NEXT i

REM kolory za ludzikiem

kolor$(0) = "00 00 00 00": REM rejestr zero- wolny
kolor$(1) = "01 05 05 06": REM tlo plyta
kolor$(2) = "02 02 03 02": REM tlo fuga
kolor$(3) = "03 07 06 06": REM tlo krawedz
kolor$(4) = "04 00 22 00": REM liscie
kolor$(5) = "05 3F 08 00": REM serce
kolor$(6) = "06 30 30 30": REM framuga okna
kolor$(7) = "07 28 0A 00": REM doniczka drzewa
kolor$(8) = "08 00 21 39": REM niebo
kolor$(9) = "09 3F 3F 00": REM slonce
kolor$(10) = "0A 14 14 14": REM framuga zewnetrzna
kolor$(11) = "0B 00 00 00": REM wentylator faza 1
kolor$(12) = "0C 00 00 00": REM wentylator faza 2
kolor$(13) = "0D 00 00 00": REM wentylator faza 3
kolor$(14) = "0E 3F 3F 3F"
kolor$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza

REM rejestry przezroczyste gracza
kolor$(16) = "10 18 02 02": REM sweter + zero
kolor$(17) = "11 18 02 02": REM
kolor$(18) = "12 18 02 02": REM
kolor$(19) = "13 18 02 02": REM
kolor$(20) = "14 22 12 00": REM sweter + liscie
kolor$(21) = "15 3F 00 00": REM
kolor$(22) = "16 2F 09 09": REM sweter + framuga okna
kolor$(23) = "17 2B 08 00": REM sweter + doniczka drzewa
kolor$(24) = "18 25 16 24": REM sweter + niebo
kolor$(25) = "19 3F 3F 3F": REM sweter + slonce
kolor$(26) = "1A 16 0F 0F": REM sweter + framuga zew
kolor$(27) = "1B 3F 3F 3F": REM
kolor$(28) = "1C 3F 3F 3F": REM
kolor$(29) = "1D 3F 3F 3F": REM
kolor$(30) = "1E 3F 3F 3F": REM
REM kolor 31 1F zastrzezony dla gracza
kolor$(32) = "20 0A 13 29": REM spodnie + zero
kolor$(33) = "21 0A 13 29": REM
kolor$(34) = "22 0A 13 29": REM
kolor$(35) = "23 0A 13 29": REM
kolor$(36) = "24 05 1D 24": REM spodnie+ liscie
kolor$(37) = "25 3F 3F 3F": REM
kolor$(38) = "26 1B 1B 32": REM spodnie + framuga okna
kolor$(39) = "27 1A 10 3F": REM spodnie + doniczka
kolor$(40) = "28 00 1A 3F": REM spodnie + niebo
kolor$(41) = "29 3F 3F 3F": REM spodnie +slonce
kolor$(42) = "2A 10 14 20": REM spodnie + framuga zew
kolor$(43) = "2B 3F 3F 3F": REM
kolor$(44) = "2C 3F 3F 3F": REM
kolor$(45) = "2D 3F 3F 3F": REM
kolor$(46) = "2E 3F 3F 3F": REM
REM rejestr 47 2F zastrzezony dla gracza

REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF)
REM rejestry nieprzezroczyste

kolor$(31) = "1F 2F 09 09": REM sweter
kolor$(47) = "2F 0D 1A 37": REM spodnie
kolor$(63) = "3F 1A 1A 1A": REM wlosy i buty
kolor$(79) = "4F 10 10 10": REM pasek2
kolor$(95) = "5F 3F 2F 0F":
kolor$(111) = "6F 3F 30 20": REM skora1
kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych
kolor$(143) = "8F 32 22 02": REM nos
kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych
kolor$(175) = "AF 22 02 02": REM sweter3
kolor$(191) = "BF 20 20 20": REM pasek
kolor$(207) = "CF 37 27 06": REM usta
REM FF- zarezerwowany dla przeslony

REM rejestry jednokierunkowe
kolor$(198) = "C6 20 20 20"
kolor$(199) = "C7 20 20 20"

REM bloczek

kolor$(224) = "E0 00 00 00": REM
kolor$(225) = "E1 04 04 04": REM
kolor$(226) = "E2 08 08 08": REM
kolor$(227) = "E3 0B 0B 0B": REM
kolor$(228) = "E4 10 10 10": REM
kolor$(229) = "E5 14 14 14": REM
kolor$(230) = "E6 18 18 18": REM
kolor$(231) = "E7 1B 1B 1B": REM
kolor$(232) = "E8 20 20 20": REM
kolor$(233) = "E9 24 24 24": REM
kolor$(234) = "EA 28 28 28": REM
kolor$(235) = "EB 2B 2B 2B": REM
kolor$(236) = "EC 30 30 30": REM
kolor$(237) = "ED 34 34 34": REM
kolor$(238) = "EE 38 38 38": REM
kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika

REM kolor 240 - przeslona
kolor$(240) = "F0 38 38 38"
REM cegly male niebieskie

kolor$(249) = "F9 22 27 30": REM krawedz
kolor$(250) = "FA 09 0E 14": REM fuga
kolor$(251) = "FB 11 17 1F": REM cegla

REM cegly male czerwone

kolor$(252) = "FC 30 27 27": REM krawedz
kolor$(253) = "FD 14 0E 0E": REM fuga
kolor$(254) = "FE 1F 17 17": REM cegla
kolor$(255) = "FF 28 28 28": REM przeslona

FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2)
red$ = "&H" + MID$(kolor$(i), 4, 2)
gre$ = "&H" + MID$(kolor$(i), 7, 2)
blu$ = "&H" + MID$(kolor$(i), 10, 2)
REM PRINT rej$; " "; red$; " "; gre$; " "; blu$
rej = VAL(rej$)
red = VAL(red$)
gre = VAL(gre$)
blu = VAL(blu$)
REM PRINT rej; " "; red; " "; gre; " "; blu

PALETTE rej, red + gre * 256 + blu * 65536
NEXT i

END SUB

SUB plansze

REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** roomy*16+roomx

REM kody plansz +++nr.po.ok.we.se_kw_dod
REM ************ plansze wiersza roomy=0

p$(0) = "h22233322d.0.UI.YO....GN________!"
p$(1) = "h000fff11h.1....MD....__________!"
p$(2) = "h11133333f.2.UI.HE....___EQ_____!"
p$(3) = "hh2223cchh.3..........SJ________!"
p$(4) = "h300033fff.4....ZK....__________!"
p$(5) = "h2001c333f.5....LG....______AQG_!"
p$(6) = "h111g3222f.6....LD....___EQ_F[Q_!"
p$(7) = "hh222d111g.7.BE....DF.aH_WI_____!"
p$(8) = "hhDDDfCCCg.8..........__________!"
p$(9) = "hhhhhf111c.9..........__________!"
p$(10) = "hhhhhf222g.A..........GG_EQ_____!"
p$(11) = "hh333f111d.B....HG....__________!"
p$(12) = "hhffff333g.C..........__________!"
p$(13) = "h22233333c.D.UN.aK.DF.MK____AYC_!"
p$(14) = "h111ff22hh.E..........___aG_BLM_!"
p$(15) = "h3333311cc.F....ZK....aH____AIG_!"

REM ************ plansze wiersza roomy=1

p$(16) = "d333c2223h.0.......FN.__________!"
p$(17) = "h33330003h.1.WH.SO....dE____COM_!"
p$(18) = "ff333111ff.2.WJ.ML....__________!"
p$(19) = "hc222c333c.3..........___QQ_____!"
p$(20) = "f31113333h.4.UM.aI.aO.__________!"
p$(21) = "f333aa333h.5..........RN_GQ_____!"
p$(22) = "ffff333fff.6....DJ....aM____G[M_!"
p$(23) = "gg333a33hh.7..........__________!"
p$(24) = "gg333333ff.8.AK....IF.__________!"
p$(25) = "cc3322333c.9.WM.......eF________!"
p$(26) = "gg331133hh.A....LF....aO________!"
p$(27) = "ddaa22cccc.B..........__________!"
p$(28) = "g33300333h.C.AM....aO.__________!"
p$(29) = "c33311333c.D.0M.......ZK____AQO_!"
p$(30) = "h3322233dd.E.BE....aF.__________!"
p$(31) = "c33111333h.F.AM.bD....___QQ_COH_!"

REM ************* plansze wiersza roomy=2

p$(32) = "h333ff333c.0..........KE_WQ_____!"
p$(33) = "h33332222c.1....KD....UP____CGI_!"
p$(34) = "faaaa0000h.2....WO.VI.__________!"
p$(35) = "ccccc1111f.3....MM....___EQ_____!"
p$(36) = "h33333223h.4.WI.FP....SM________!"
p$(37) = "haa33200af.5.UJ....GL.______HIE_!"
p$(38) = "f333c111ah.6....aM....UP________!"
p$(39) = "hh333d333g.7....YP....___KQ_____!"
p$(40) = "ff3333333g.8.#I.......KK____CGN_!"
p$(41) = "c33g33d33c.9..........__________!"
p$(42) = "hh3333333g.A.WM.LI....__________!"
p$(43) = "cc333322cc.B.UJ.......__________!"
p$(44) = "hhaacc00hh.C.BE....JG.ZM____AQM_!"
p$(45) = "c333cc11gg.D....aN....______AQM_!"
p$(46) = "dd33cc22hh.E..........______AQE_!"
p$(47) = "hh3331113c.F.UK....VI.___EQ_____!"

REM ************ plansze wiersza roomy=3

p$(48) = "c33332222f.0....ZM.ZD.SF____COI_!"
p$(49) = "ccccc1111h.1..........__________!"
p$(50) = "ha3222333c.2.#F.LO....UO_SQ_____!"
p$(51) = "ff3111333f.3.WM.YI.VI.SJ_GQ_____!"
p$(52) = "h3333c333f.4..........NG____CKK_!"
p$(53) = "ff333c222f.5....ZO....SG________!"
p$(54) = "hhaaff000f.6.BE.......___KQ_____!"
p$(55) = "gggg33111f.7....LO.VJ.______IYM_!"
p$(56) = "gg3322ffff.8..........GG________!"
p$(57) = "cccc00hfff.9..........__________!"
p$(58) = "gg33DDffff.A..........___KK_CCH_!"
p$(59) = "cccccfffff.B.......TL.__________!"
p$(60) = "hh3333333f.C....KK....DP________!"
p$(61) = "g333333hhh.D.UJ....TF.______CKK_!"
p$(62) = "hh3222333f.E..........___GQ_____!"
p$(63) = "c331113hhh.F....ZK....__________!"

REM ****************** plansze wiersza roomy=4

p$(64) = "f22322322h.0....DD....SP_YQ_CKK_!"
p$(65) = "h00f00f00h.1..........__________!"
p$(66) = "c11311311f.2....aP.KP.__________!"
p$(67) = "ff3332223h.3.UJ.ML....___YQ_____!"
p$(68) = "f3333111hh.4.WJ.YL....__________!"
p$(69) = "ffaafaaaff.5.......VI.__________!"
p$(70) = "ffa333c33h.6....OG....SQ_YQ_____!"
p$(71) = "ff2233c33d.7....aP....______LVO_!": REM startowa
p$(72) = "ff113cc33d.8..........aO____JVO_!"
p$(73) = "ff33cc33ff.9..........______COI_!"
p$(74) = "ff3333333d.A.WM.LI.ZP.PP________!"
p$(75) = "ff2233333f.B.UM.......___EQ_____!"
p$(76) = "ff11333hhh.C.......KH.__________!"
p$(77) = "h333333333.D.BE.SK....bF____CKK_!"
p$(78) = "ff22233hhh.E.UJ.......______FEE_!"
p$(79) = "h311133fff.F.WJ.......MM________!"

REM ******************* plansze wiersza roomy=5

p$(80) = "haf222faff.0.......VI.___KK_____!"
p$(81) = "hhf111222h.1..........SP____CKK_!"
p$(82) = "fa333c000h.2....GO....__________!"
p$(83) = "h222fa111f.3..........___YQ_____!"
p$(84) = "h111c2223h.4.0Q....EE.MM________!"
p$(85) = "ffffa111ff.5..........______GOE_!"
p$(86) = "h333c333af.6....DD....ZF_MQ_____!"
p$(87) = "dd333f333g.7.......VI.___aI_____!"
p$(88) = "dd3333333g.8.UN.KP....______COI_!"
p$(89) = "f32233f33f.9.......ED.KK________!"
p$(90) = "ddDDCC333h.A....ZK....KO________!"
p$(91) = "f33300f33f.B..........______COH_!"
p$(92) = "h33300333c.C....NN....__________!"
p$(93) = "333311333h.D.0M....TG.GG________!"
p$(94) = "h33222333c.E.AM.......__________!"
p$(95) = "ff3111333h.F.WM.FF....___YQ_____!"

REM ******************* plansze wiersza roomy=6

p$(96) = "fffa222hhh.0....EJ....___YM_____!"
p$(97) = "hhhf000bbb.1....SJ....ML____CMO_!"
p$(98) = "h222111hhh.2..........___KM_____!"
p$(99) = "f111aaafff.3....PH....ZJ________!"
p$(100) = "h222ahhhhh.4..........EE________!"
p$(101) = "f11133222h.5.0I.......___GQ_____!"
p$(102) = "ffffff000h.6....LO....__________!"
p$(103) = "gg333d111f.7....MO....aP________!"
p$(104) = "gg333hCCCh.8.......ZN.EG____HIE_!"
p$(105) = "ffffffDDDh.9..........__________!"
p$(106) = "hh333fCCCh.A.BE.......___KI_____!"
p$(107) = "ff3333111h.B.0I....KK.aP____CKK_!"
p$(108) = "cc22dd22ff.C..........__________!"
p$(109) = "hhDDffDDhh.D.......TJ.LN________!"
p$(110) = "ccc2222hhh.E..........__________!"
p$(111) = "hhhDDDDhhh.F..........TK_KM_____!"

REM ******************* plansze wiersza roomy=7

p$(112) = "hfaa222hhh.0..........______COJ_!"
p$(113) = "bbbb000hhh.1....KK....__________!"
p$(114) = "h222111fff.2.BJ.......ZE____AIK_!"
p$(115) = "f000aaahhh.3..........___KM_____!"
p$(116) = "h000ahhhhh.4.......KF.__________!"
p$(117) = "h111hh222h.5..........KQ________!"
p$(118) = "hfffff000f.6....KO....__________!"
p$(119) = "fffeee000h.7..........___KQ_____!"
p$(120) = "hh3333000h.8.BL.......______CKK_!"
p$(121) = "hCCCffDDDh.9..........KO________!"
p$(122) = "hDDDccCCCh.A..........___MK_____!"
p$(123) = "hf333300Df.B.AL.......__________!"
p$(124) = "ffffff00hh.C....KN....______IOI_!"
p$(125) = "hhhhhf00fh.D.......TK.__________!"
p$(126) = "h33c3300ff.E..........KK____COG_!"
p$(127) = "hhheefDDhh.F....KN....__________!"

REM ***************** n/8 plansze wiersza roomy=8

p$(128) = "hffa222hhh.0..........__________!"
p$(129) = "hbbb000hhh.1..........__________!"
p$(130) = "f222111fff.2..........__________!"
p$(131) = "h000aaahhh.3..........______COI_!"
p$(132) = "h000ahhhhh.4..........__________!"
p$(133) = "h111hh222h.5..........__________!"
p$(134) = "ffffff000f.6..........______DQK_!"
p$(135) = "hhhhha000h.7..........______ESK_!"
p$(136) = "hh3333000h.8..........______CKK_!"
p$(137) = "h33333111h.9..........__________!"
p$(138) = "h33333222h.A.BG.......__________!"
p$(139) = "ffCCff00ff.B..........______KaE_!"
p$(140) = "hfDDff00hh.C..........______JKM_!"
p$(141) = "hhhaac00fh.D..........__________!"
p$(142) = "f3333300ff.E..........______COL_!"
p$(143) = "hhheefDDhh.F..........__________!"

REM ***************** n/9 plansze wiersza roomy=9

p$(144) = "hffa222hhh.0..........__________!"
p$(145) = "hbbb000hhh.1..........__________!"
p$(146) = "f222111hhh.2..........__________!"
p$(147) = "h000aaahhh.3..........__________!"
p$(148) = "h000ahhhhh.4..........__________!"
p$(149) = "h111hh333h.5..........__________!"
p$(150) = "ffffaa222h.6..........__________!"
p$(151) = "hhaaaa000h.7..........__________!"
p$(152) = "hh3333000h.8..........__________!"
p$(153) = "h33333111h.9..........__________!"
p$(154) = "h33333222h.A..........__________!"
p$(155) = "ffCCff00Dh.B..........__________!"
p$(156) = "hfDDff00hh.C..........__________!"
p$(157) = "hhhaac00fh.D..........__________!"
p$(158) = "f3333300hh.E..........__________!"
p$(159) = "hhheefDDhh.F..........__________!"

REM tablica serc
FOR xr = 0 TO 15
FOR yr = 0 TO 9
s = xr + yr * 16
znak$ = MID$(p$(s), 23, 1)
IF znak$ <> "_" THEN serca(xr, yr) = 1
NEXT yr: NEXT xr

END SUB

SUB rysowanie

FOR yw = 0 TO 9
el$ = MID$(kod$, yw + 1, 1)
y16 = yw * 18

REM tymczasowe sygnalizacje bledow:

IF el$ = "Q" OR el$ = "L" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "P" OR el$ = "W" OR el$ = "=" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "A" OR el$ = "B" OR el$ = "U" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "@" THEN COLOR 15: LINE (0, y16)-(200, y16)

REM elementy uzupelniajace

IF el$ = "C" THEN
PUT (128, y16), szaretlo4, PSET: PUT (192, y16), szaretlo4, PSET
PUT (256, y16), szaretlo4, PSET
PUT (0, y16), blok4, PSET: PUT (64, y16), blok2, PSET:
PUT (96, y16), bloks, PSET: PUT (112, y16), blokk, PSET
END IF

IF el$ = "D" THEN
PUT (0, y16), szaretlo4, PSET: PUT (64, y16), szaretlo4, PSET
PUT (128, y16), szaretlo4, PSET
PUT (192, y16), blokp, PSET: PUT (208, y16), blok4, PSET
PUT (272, y16), blok2, PSET: PUT (304, y16), bloks, PSET
END IF

REM czesc automatyczna, znaki a-h
ascii = ASC(el$)

IF ascii > 96 THEN
bity = ascii - 97
PUT (0, y16), blok4, PSET:
pop1 = 0
pop2 = 0
pop3 = 0

IF (bity AND 4) = 4 THEN PUT (64, y16), blok4, PSET: pop1 = 1
IF (bity AND 4) = 0 THEN PUT (48, y16), blokk, PSET: PUT (64, y16), szaretlo4, PSET: pop1 = 0
REM
IF (bity AND 2) = 2 THEN pop2 = 1: PUT (128, y16), blok4, PSET: IF pop1 = 0 THEN PUT (128, y16), blokp, PSET
IF (bity AND 2) = 0 THEN pop2 = 0: PUT (128, y16), szaretlo4, PSET: IF pop1 = 1 THEN PUT (112, y16), blokk, PSET
REM
IF (bity AND 1) = 1 THEN pop3 = 1: PUT (192, y16), blok4, PSET: IF pop2 = 0 THEN PUT (192, y16), blokp, PSET
IF (bity AND 1) = 0 THEN pop3 = 0: PUT (192, y16), szaretlo4, PSET: IF pop2 = 1 THEN PUT (176, y16), blokk, PSET
PUT (256, y16), blok4, PSET
IF pop3 = 0 THEN PUT (256, y16), blokp, PSET
END IF

REM znaki 0-3

IF ascii < 58 THEN
bity = ascii - 48
IF (bity AND 2) = 2 THEN PUT (0, y16), blokk, PSET
IF (bity AND 2) = 0 THEN PUT (0, y16), szaretlo, PSET
PUT (16, y16), szaretlo4, PSET
PUT (80, y16), szaretlo4, PSET
PUT (144, y16), szaretlo4, PSET
PUT (208, y16), szaretlo4, PSET
PUT (272, y16), szaretlo2, PSET

IF (bity AND 1) = 1 THEN PUT (304, y16), blokp, PSET
IF (bity AND 1) = 0 THEN PUT (304, y16), szaretlo, PSET
END IF

NEXT yw

REM rysowanie podestow

el$ = MID$(kod$, 14, 1)
IF el$ = "" OR el$ = "." THEN GOTO dodatek

el2$ = MID$(kod$, 15, 1)
yokna = (ASC(el2$) - 65) * 9
IF el$ = "#" THEN PUT (0, yokna), ceg40, PSET
IF el$ = "W" THEN PUT (0, yokna), ceg4plus20plus4, PSET
IF el$ = "U" THEN PUT (0, yokna), ceg17plus17, PSET
IF el$ = "0" THEN PUT (0, yokna), ceg13plus13, PSET
IF el$ = "A" THEN FOR xx = 0 TO 4: PUT (16 + xx * 64, yokna), ceg2, PSET: NEXT xx
IF el$ = "B" THEN FOR xx = 0 TO 5: PUT (64 + xx * 32, yokna), ceg2, PSET: NEXT xx

REM dodatkowy element
dodatek:

el$ = MID$(kod$, 29, 1)
IF el$ = "" OR el$ = "_" THEN GOTO okna
el2$ = MID$(kod$, 30, 1)
xokna = (ASC(el2$) - 65) * 8
el2$ = MID$(kod$, 31, 1)
yokna = (ASC(el2$) - 65) * 9
IF el$ = "A" THEN
PUT (xokna, yokna), blokp, PSET:
PUT (xokna, yokna + 18), blokp, PSET
PUT (xokna + 16, yokna), blok2, PSET:
PUT (xokna + 16, yokna + 18), blok2, PSET
PUT (xokna + 48, yokna), blokk, PSET:
PUT (xokna + 48, yokna + 18), blokk, PSET
END IF

IF el$ = "B" THEN COLOR 235: LINE (xokna + 5, yokna)-(xokna + 9, yokna + 35), , BF
IF el$ = "C" THEN PUT (xokna, yokna), ceg2, PSET: PUT (xokna + 32, yokna), ceg2, PSET: PUT (xokna + 64, yokna), ceg2, PSET
IF el$ = "D" THEN LINE (xokna, yokna)-(xokna + 22, yokna + 17), 235, BF: LINE (xokna + 42, yokna)-(xokna + 63, yokna + 17), 235, BF
IF el$ = "E" THEN LINE (xokna, yokna)-(xokna + 5, yokna + 35), 235, BF: LINE (xokna + 26, yokna + 36)-(xokna + 31, yokna + 72), 235, BF
REM niebieskie klocki
IF el$ = "F" THEN PUT (xokna, yokna), nieb, PSET
IF el$ = "G" THEN PUT (xokna, yokna), nieb, PSET: PUT (xokna + 64, yokna), nieb, PSET
IF el$ = "H" THEN PUT (xokna, yokna), nieb, PSET: PUT (xokna + 64, yokna + 36), nieb, PSET
IF el$ = "I" THEN PUT (xokna, yokna), nieb, PSET: PUT (xokna + 64, yokna - 36), nieb, PSET
REM jednokierunkowe bramki
IF el$ = "J" THEN PSET (xokna - 2, yokna), 199: DRAW "R18 D35 L18 U35 F18 U1 G18"
IF el$ = "K" THEN PSET (xokna - 2, yokna), 198: DRAW "R18 D35 L18 U35 R18 G18 U1 F18"
REM zaslonka
IF el$ = "L" THEN LINE (xokna, yokna)-(xokna + 15, yokna + 35), 255, BF
okna:

REM rysowanie okien

el$ = MID$(kod$, 17, 1)
IF el$ = "" OR el$ = "." THEN GOTO serce
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 18, 1)
yokna = (ASC(el$) - 65) * 9
IF roomy < 2 THEN PUT (xokna, yokna), window2, PSET
IF roomy > 1 AND roomy < 5 THEN PUT (xokna, yokna), window1, PSET
IF roomy > 4 THEN PUT (xokna, yokna), window3, PSET

serce:
REM serce
xserca = -20
yokna = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 23, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xserca = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 24, 1)
yserca = (ASC(el$) - 65) * 9
GET (xserca, yserca)-(xserca + 15, yserca + 7), tlo
COLOR 5
LINE (xserca, yserca + 1)-(xserca, yserca + 3)
LINE (xserca + 1, yserca)-(xserca + 1, yserca + 4)
LINE (xserca + 2, yserca)-(xserca + 2, yserca + 5)
LINE (xserca + 3, yserca + 1)-(xserca + 3, yserca + 6)
LINE (xserca + 4, yserca)-(xserca + 4, yserca + 5)
LINE (xserca + 5, yserca)-(xserca + 5, yserca + 4)
LINE (xserca + 6, yserca + 1)-(xserca + 6, yserca + 3)

donica:
el$ = MID$(kod$, 26, 1)
IF el$ = "" OR el$ = "_" THEN GOTO wentyl
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 27, 1)
yokna = (ASC(el$) - 65) * 9 + 2
PUT (xokna, yokna), palma, PSET

wentyl:
el$ = MID$(kod$, 20, 1)
IF el$ = "" OR el$ = "." THEN GOTO koniecrysowania
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 21, 1)
yokna = (ASC(el$) - 65) * 9
PUT (xokna, yokna), wentylator, PSET

koniecrysowania:

LOCATE 24, 2: COLOR 15: PRINT "Czas:"; licz;

END SUB

SUB zabranie
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)

OUT 66, 32: OUT 66, 3
FOR i = 1 TO 6000: NEXT i

OUT 66, 204: OUT 66, 4
FOR i = 1 TO 6000: NEXT i

t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port

END SUB

Piotr-246 · Gość

REM modul BSAVE do gry "Serca"

SCREEN 13

DIM kolor$(0 TO 255)
DIM cegla(0 TO 42) AS LONG
DIM tlo(0 TO 40) AS LONG
DIM poltlo(0 TO 16) AS LONG
DIM bitmap$(0 TO 31)
DIM blok(0 TO 74) AS LONG

REM palety kolorow *********************************
REM max koloru=3F

FOR i = 0 TO 255: kolor$(i) = "00 00 00 00": NEXT i

REM kolory za ludzikiem

kolor$(0) = "00 00 00 00": REM rejestr zero- wolny
kolor$(1) = "01 0A 0A 0A": REM tlo plyta
kolor$(2) = "02 06 06 06": REM tlo fuga
kolor$(3) = "03 10 10 10": REM tlo krawedz
kolor$(4) = "04 00 2F 00": REM liscie
kolor$(5) = "05 3F 3F 3F"
kolor$(6) = "06 3F 3F 3F"
kolor$(7) = "07 28 0A 00": REM doniczka
kolor$(8) = "08 00 00 3F": REM niebo
kolor$(9) = "09 3F 3F 00": REM slonce
kolor$(10) = "0A 20 20 20": REM framuga zewnetrzna
kolor$(11) = "0B 18 18 18": REM wentylator obudowa
kolor$(12) = "0C 3F 3F 3F": REM wentylator faza 1
kolor$(13) = "0D 2F 2F 2F": REM wentylator faza 2
kolor$(14) = "0E 1F 1F 1F": REM wentylator faza 3
kolor$(15) = "0F 3F 3F 3F": REM napis startowy

REM bloki przezroczystosci
kolor$(16) = "10 3F 3F 3F"
kolor$(32) = "20 3F 3F 3F"

REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF)

kolor$(31) = "1F 28 00 00": REM sweter
kolor$(47) = "2F 05 12 2F": REM spodnie
kolor$(63) = "3F 17 17 17": REM wlosy i buty
kolor$(79) = "4F 10 10 10": REM pasek2
kolor$(95) = "5F 3F 2F 0F":
kolor$(111) = "6F 3F 2C 17": REM skora1
kolor$(127) = "7F 18 00 00": REM sweter 2 przeniesiony do przezroczystych
kolor$(143) = "8F 30 20 00": REM nos
kolor$(159) = "9F 04 0D 23": REM spodnie2 przeniesiony do przezroczystych
kolor$(175) = "AF 20 00 00": REM sweter3
kolor$(191) = "BF 20 20 20": REM pasek
kolor$(207) = "CF 37 27 06": REM usta

REM bloczek

kolor$(224) = "E0 00 00 00": REM
kolor$(225) = "E1 04 04 04": REM
kolor$(226) = "E2 08 08 08": REM
kolor$(227) = "E3 0B 0B 0B": REM
kolor$(228) = "E4 10 10 10": REM
kolor$(229) = "E5 14 14 14": REM
kolor$(230) = "E6 18 18 18": REM
kolor$(231) = "E7 1B 1B 1B": REM
kolor$(232) = "E8 20 20 20": REM
kolor$(233) = "E9 24 2B 2B": REM
kolor$(234) = "EA 28 28 28": REM
kolor$(235) = "EB 2B 2B 2B": REM
kolor$(236) = "EC 30 30 30": REM
kolor$(237) = "ED 34 34 34": REM
kolor$(238) = "EE 38 38 38": REM
kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika

REM cegly male niebieskie

kolor$(249) = "F9 22 27 30": REM krawedz
kolor$(250) = "FA 09 0E 14": REM fuga
kolor$(251) = "FB 11 17 1F": REM cegla

REM cegly male czerwone

kolor$(252) = "FC 30 27 27": REM krawedz
kolor$(253) = "FD 14 0E 0E": REM fuga
kolor$(254) = "FE 1F 17 17": REM cegla
kolor$(255) = "FF 3F 3F 3F": REM zarezerwowany dla ludzika

FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2)
red$ = "&H" + MID$(kolor$(i), 4, 2)
gre$ = "&H" + MID$(kolor$(i), 7, 2)
blu$ = "&H" + MID$(kolor$(i), 10, 2)
REM PRINT rej$; " "; red$; " "; gre$; " "; blu$
rej = VAL(rej$)
red = VAL(red$)
gre = VAL(gre$)
blu = VAL(blu$)
REM PRINT rej; " "; red; " "; gre; " "; blu

PALETTE rej, red + gre * 256 + blu * 65536
NEXT i

REM rysunki ****************************************

REM rysunek cegly

bitmap$(0) = "DDDDDDDDDDDDDDDE"
bitmap$(1) = "DFFFFFFFFFFFFFFE"
bitmap$(2) = "DFFFFFFFFFFFFFFE"
bitmap$(3) = "DFFFFFFFFFFFFFFE"
bitmap$(4) = "DFFFFFFFFFFFFFFE"
bitmap$(5) = "DFFFFFFFFFFFFFFE"
bitmap$(6) = "DFFFFFFFFFFFFFFE"
bitmap$(7) = "DFFFFFFFFFFFFFFE"
bitmap$(8) = "EEEEEEEEEEEEEEEE"

REM 250-A 251-B 252-C 253-D 254-E 255-F

FOR yd = 0 TO 8
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 - 1 + &HF0 + 10
: PSET (xd, yd)
NEXT xd: NEXT yd
GET (0, 0)-(15, 8), cegla

REM komorka tla

REM tlo(0) = &H80040

bitmap$(0) = "0001200000012000"
bitmap$(1) = "1111200000011111"
bitmap$(2) = "2221200000012222"
bitmap$(3) = "0001200000012000"
bitmap$(4) = "0001200000012000"
bitmap$(5) = "0001111111112000"
bitmap$(6) = "0001222222212000"
bitmap$(7) = "0001200000012000"
bitmap$(8) = "0001200000012000"

FOR yd = 0 TO 8
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 48 + 1
: PSET (xd, yd)
NEXT xd: NEXT yd

GET (0, 0)-(15, 8), tlo

REM przygotowanie tablic elementow wierszowych
CLS

FOR x = 0 TO 19
FOR y = 0 TO 8
PUT (x * 16, y * 9), tlo, PSET
NEXT y
NEXT x

REM cegly

FOR i = 0 TO 19
PUT (i * 16, 0), cegla, PSET
NEXT i

FOR i = 0 TO 7
PUT (i * 16, 9), cegla, PSET
PUT (304 - i * 16, 9), cegla, PSET
NEXT i

FOR i = 0 TO 4
PUT (i * 16, 18), cegla, PSET
PUT (304 - i * 16, 18), cegla, PSET
NEXT i

FOR i = 0 TO 2
PUT (i * 16, 27), cegla, PSET
PUT (304 - i * 16, 27), cegla, PSET
NEXT i
FOR i = 0 TO 9
PUT (i * 16 + 80, 27), cegla, PSET
NEXT i

REM poszerzenie przejsc pionowych

REM GET (8, 64)-(15, 71), poltlo
REM PUT (136, 8), poltlo, PSET
REM PUT (40, 24), poltlo, PSET
REM GET (0, 64)-(7, 71), poltlo
REM PUT (176, 8), poltlo, PSET
REM PUT (272, 24), poltlo, PSET

REM wykonczenie cegiel
REM COLOR 253: REM szczeliny
REM LINE (135, 8)-(135, 15)
REM LINE (79, 16)-(79, 23)
REM LINE (39, 24)-(39, 31)
REM LINE (239, 24)-(239, 31)

REM COLOR 252: REM krawedzie
REM LINE (184, 12)-(184, 14)
REM LINE (240, 21)-(240, 22)
REM LINE (80, 28)-(80, 30)
REM LINE (280, 28)-(280, 30)

REM RYSUNEK DONICZKI

bitmap$(0) = "DDDCBEEBBEECDDDD"
bitmap$(1) = "BBBCEEEEEEEEDBBB"
bitmap$(2) = "BBBEEEEEEEEEEBBB"
bitmap$(3) = "BBBEEEEEEEECEEBB"
bitmap$(4) = "BBEEDEDEEDECEEBB"
bitmap$(5) = "BBECBEBEEBECDEBB"
bitmap$(6) = "BBECEBBEEBBEDEBB"
bitmap$(7) = "BBECEBBEEBBEDEBB"
bitmap$(8) = "CCCCDBBEEBBCDCCC"
bitmap$(9) = "DDDCDBBEEBBCDDDD"
bitmap$(10) = "BBBCDBBEEBBCDBBB"
bitmap$(11) = "BBBCDHHHHHHCDBBB"
bitmap$(12) = "BBBCCHHHHHHCDBBB"
bitmap$(13) = "BBBCDDHHHHDCDBBB"
bitmap$(14) = "BBBCDBHHHHBCDBBB"
bitmap$(15) = "BBBCDBHHHHBCDBBB"

FOR yd = 0 TO 15
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65
: PSET (xd + 16, yd + 64)
NEXT xd: NEXT yd

REM rysunek bloku

bitmap$(0) = "KLKLKLKLKLKLKLKF" + "JJJJJJJJJJJJJJJF" + "KLKLKLKLKLKLKLKF"
bitmap$(1) = "LJJJJJJJJJJJJJJF" + "KHHHHHIHHGHHHHHF" + "LJJJJJJJJJJJJJJF"
bitmap$(2) = "MJKIJIJKJJKJJJJF" + "KHHHIHHHIHHGHHHF" + "MJJKJKJIJKJIJIJF"
bitmap$(3) = "LJJJJJJJJIJIJIJF" + "KHGHHHHIHHHHIHHF" + "LJJJIJJJIJJJJKJF"
bitmap$(4) = "MJJKJJJJJKJJJJJF" + "KHHHIHGHHIHHHHHF" + "MJJJJKJJJJJKJJJF"
bitmap$(5) = "MJJIJKJIJJIJKJJF" + "KHHHHHHIHHHHIHHF" + "MJKJJJJIJJJJJKJF"
bitmap$(6) = "LJKJIJJJKJJIJIJF" + "KHHGHHIHGHHIHGHF" + "LJKJIJJJKJJJIJJF"
bitmap$(7) = "MJJJJJJJJJJJJJJF" + "KHHHHHHHHHHHHHHF" + "MJJJJJJJJJIJJJJF"
bitmap$(8) = "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF"
bitmap$(9) = "KLKLKLKFJJJJJJJJ" + "JJJJJJJFJJJJJJJJ" + "JJJJJJJFKLKLKLKF"
bitmap$(10) = "LJJJJJJFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFLJJJJJJF"
bitmap$(11) = "MJJIJJJFKHIHHIHH" + "HIHIHHHFKHHGHGHH" + "HHGHIHHFMJKJIJJF"
bitmap$(12) = "LJJJKJJFKHHGHHHI" + "HHGHHGHFKHIHHHHI" + "HGHHHHHFLJJJKJJF"
bitmap$(13) = "MJIJJIJFKHIHHHHH" + "GHHHIHHFKHHHHHGH" + "HHIHHHHFMJKJJIJF"
bitmap$(14) = "MJJIJJJFKHHHIHHH" + "GHIHHHHFKHHHGHHH" + "HHHHHIHFMJJJJJJF"
bitmap$(15) = "LJKJKJJFKHIHHGHI" + "HHHIHGHFKHGHHIHG" + "HIHGHHHFLJKJIKJF"
bitmap$(16) = "MJJJJJJFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFMJJJJJJF"
bitmap$(17) = "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF"

FOR yd = 0 TO 17
FOR xd = 0 TO 47
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + 224
: PSET (xd + 32, yd + 64)
NEXT xd: NEXT yd

GET (48, 64)-(63, 81), blok
FOR i = 0 TO 19: PUT (i * 16, 156), blok, PSET
NEXT i

COLOR 15: LOCATE 10, 16: PRINT "SERCA 1.0"

REM animacja
REM 7,9 - rejestry przezroczyste

bitmap$(0) = "0000003333000000" + "0000003333000000"
bitmap$(1) = "0000033333300000" + "0000033333300000"
bitmap$(2) = "0000066663300000" + "0000033366600000"
bitmap$(3) = "0000063663300000" + "0000033663600000"
bitmap$(4) = "0000866666300000" + "0000036666680000"
bitmap$(5) = "0000066666300000" + "0000036666600000"
bitmap$(6) = "0000006666000000" + "0000006666000000"
bitmap$(7) = "0000000661000000" + "0000001660000000"
bitmap$(8) = "0000000711700000" + "0000071170000000"
bitmap$(9) = "0000007111100000" + "0000011117000000"

bitmap$(10) = "0000071111170000" + "0000711111700000"
bitmap$(11) = "0000011111170000" + "0000711111100000"
bitmap$(12) = "0000011111110000" + "0000111111100000"
bitmap$(13) = "0000711111117000" + "0007111111170000"
bitmap$(14) = "0000711111111000" + "0001111111170000"
bitmap$(15) = "0000111111111000" + "0001111111110000"
bitmap$(16) = "0001111333311000" + "0001133331111000"
bitmap$(17) = "0006602222206600" + "0066022222066000"
bitmap$(18) = "0006002222200600" + "0060022222006000"
bitmap$(19) = "0000092222200000" + "0000922222900000"
bitmap$(20) = "0000022222290000" + "0000222222200000"
bitmap$(21) = "0000022222220000" + "0000222222200000"
bitmap$(22) = "0000022202220000" + "0000222022200000"
bitmap$(23) = "0000922202220000" + "0000222022220000"
bitmap$(24) = "0000222202222000" + "0009222022220000"
bitmap$(25) = "0000222009222000" + "0002229002220000"
bitmap$(26) = "0000222000222000" + "0002220002220000"
bitmap$(27) = "0000222000222000" + "0002220002220000"
bitmap$(28) = "0009222000222300" + "0032220009229000"
bitmap$(29) = "0002220000033300" + "0033300000222000"
bitmap$(30) = "0003330000330000" + "0000330000222000"
bitmap$(31) = "0033330000000000" + "0000000000333300"

FOR yd = 0 TO 31
FOR xd = 0 TO 31
znak$ = MID$(bitmap$(yd), xd + 1, 1)
kolor = VAL("&H" + znak$ + "F")
IF znak$ <> "0" THEN COLOR kolor: PSET (xd, yd + 88)
IF znak$ = "7" THEN COLOR 16: PSET (xd, yd + 88)
IF znak$ = "A" THEN COLOR 16: PSET (xd, yd + 88)

IF znak$ = "9" THEN COLOR 32: PSET (xd, yd + 88)

NEXT xd
NEXT yd

REM ************************************ FAZA 2

bitmap$(0) = "0000003333000000" + "0000003333000000"
bitmap$(1) = "0000033333300000" + "0000033333300000"
bitmap$(2) = "0000066633300000" + "0000033366600000"
bitmap$(3) = "0000063663300000" + "0000033663600000"
bitmap$(4) = "0000866663300000" + "0000033666680000"
bitmap$(5) = "0000066666300000" + "0000036666600000"
bitmap$(6) = "0000006666000000" + "0000006666000000"
bitmap$(7) = "0000000661000000" + "0000001660000000"
bitmap$(8) = "0000000711700000" + "0000071170000000"
bitmap$(9) = "0000007111100000" + "0000011117000000"

bitmap$(10) = "0000001111100000" + "0000011111000000"
bitmap$(11) = "0000001111100000" + "0000011111000000"
bitmap$(12) = "0000001111100000" + "0000011111000000"
bitmap$(13) = "0000001111100000" + "0000011111000000"
bitmap$(14) = "0000071111100000" + "0000011111700000"
bitmap$(15) = "0000071111100000" + "0000011111700000"
bitmap$(16) = "0000071111300000" + "0000031111700000"
bitmap$(17) = "0000028118200000" + "0000028118200000"
bitmap$(18) = "0000022662200000" + "0000022662200000"
bitmap$(19) = "0000022662200000" + "0000022662200000"
bitmap$(20) = "0000022222000000" + "0000002222200000"
bitmap$(21) = "0000922222000000" + "0000002222290000"
bitmap$(22) = "0000222222000000" + "0000002222220000"
bitmap$(23) = "0000922222000000" + "0000002222290000"
bitmap$(24) = "0000022222000000" + "0000002222200000"
bitmap$(25) = "0000022222300000" + "0000032222200000"
bitmap$(26) = "0000002222300000" + "0000032222000000"
bitmap$(27) = "0000000222330000" + "0000332220000000"
bitmap$(28) = "0000000222033000" + "0003300222000000"
bitmap$(29) = "0000000222000000" + "0000000222000000"
bitmap$(30) = "0000000222000000" + "0000000222000000"
bitmap$(31) = "0000033330000000" + "0000000033330000"

FOR yd = 0 TO 31
FOR xd = 0 TO 31
znak$ = MID$(bitmap$(yd), xd + 1, 1)
kolor = VAL("&H" + znak$ + "F")
IF znak$ <> "0" THEN COLOR kolor: PSET (xd + 32, yd + 88)
IF znak$ = "7" THEN COLOR 16: PSET (xd + 32, yd + 88)
IF znak$ = "A" THEN COLOR 16: PSET (xd + 32, yd + 88)
IF znak$ = "9" THEN COLOR 32: PSET (xd + 32, yd + 88)

NEXT xd
NEXT yd

REM ************************ ruch poziomy FAZA 3

bitmap$(0) = "0000003333000000" + "0000003333000000"
bitmap$(1) = "0000033333300000" + "0000033333300000"
bitmap$(2) = "0000066633300000" + "0000033366600000"
bitmap$(3) = "0000063663300000" + "0000033663600000"
bitmap$(4) = "0000866663300000" + "0000033666680000"
bitmap$(5) = "0000066666300000" + "0000036666600000"
bitmap$(6) = "0000006666000000" + "0000006666000000"
bitmap$(7) = "0000000661000000" + "0000001660000000"
bitmap$(8) = "0000000711700000" + "0000071170000000"
bitmap$(9) = "0000007111100000" + "0000011117000000"

bitmap$(10) = "0000071111100000" + "0000111117000000"
bitmap$(11) = "0000011111170000" + "0000111111700000"
bitmap$(12) = "0000711111110000" + "0000111111170000"
bitmap$(13) = "0000711111110000" + "0000111111170000"
bitmap$(14) = "0000711111110000" + "0000111111170000"
bitmap$(15) = "0000111111110000" + "0000111111110000"
bitmap$(16) = "0000111333310000" + "0000133331110000"
bitmap$(17) = "0000066222260000" + "0000622226600000"
bitmap$(18) = "0000006222260000" + "0000622226000000"
bitmap$(19) = "0000002222200000" + "0000022222000000"
bitmap$(20) = "0000002222200000" + "0000022222000000"
bitmap$(21) = "0000022222200000" + "0000022222200000"
bitmap$(22) = "0000022222200000" + "0000022222200000"
bitmap$(23) = "0000922222200000" + "0000022222290000"
bitmap$(24) = "0000222022200000" + "0000022202220000"
bitmap$(25) = "0000222022200000" + "0000022202220000"
bitmap$(26) = "0000222092290000" + "0000922902220000"
bitmap$(27) = "0000222002220000" + "0000222002220000"
bitmap$(28) = "0000222002220000" + "0000222002220000"
bitmap$(29) = "0003333002220000" + "0000222003333000"
bitmap$(30) = "0000000000222000" + "0002220000000000"
bitmap$(31) = "0000000033330000" + "0000333300000000"

FOR yd = 0 TO 31
FOR xd = 0 TO 31
znak$ = MID$(bitmap$(yd), xd + 1, 1)
kolor = VAL("&H" + znak$ + "F")
IF znak$ <> "0" THEN COLOR kolor: PSET (xd + 64, yd + 88)
IF znak$ = "7" THEN COLOR 16: PSET (xd + 64, yd + 88)
IF znak$ = "A" THEN COLOR 16: PSET (xd + 64, yd + 88)

IF znak$ = "9" THEN COLOR 32: PSET (xd + 64, yd + 88)

NEXT xd
NEXT yd

REM ************************ fazy ruchu pionowego

REM Ludzik idacy w dol lub w gore

bitmap$(0) = "0000003330000000"
bitmap$(1) = "0000033333000000"
bitmap$(2) = "0000336663300000"
bitmap$(3) = "0000363636300000"
bitmap$(4) = "0000366666300000"
bitmap$(5) = "000006C8C6000000"
bitmap$(6) = "0000006860000000"
bitmap$(7) = "0000001610000000"
bitmap$(8) = "0000711111700000"
bitmap$(9) = "0001111111110000"

bitmap$(10) = "0071111111117000"
bitmap$(11) = "0071111111117000"
bitmap$(12) = "0011711111711000"
bitmap$(13) = "0711711111711700"
bitmap$(14) = "0A11711111711A00"
bitmap$(15) = "0117A11111A71100"
bitmap$(16) = "0117111111171100"
bitmap$(17) = "01104BBBBB401100"
bitmap$(18) = "0860922222906800"
bitmap$(19) = "0000922222900000"
bitmap$(20) = "0000929092900000"
bitmap$(21) = "0000929092900000"
bitmap$(22) = "0000929092900000"
bitmap$(23) = "0000929092900000"
bitmap$(24) = "0000929092900000"
bitmap$(25) = "0000929092900000"
bitmap$(26) = "0000929092900000"
bitmap$(27) = "0000929092900000"
bitmap$(28) = "0000929092900000"
bitmap$(29) = "0000929092900000"
bitmap$(30) = "0000333033300000"
bitmap$(31) = "0003330003330000"
FOR yd = 0 TO 31
FOR xd = 0 TO 15
znak$ = MID$(bitmap$(yd), xd + 1, 1)
kolor = VAL("&H" + znak$ + "F")
IF znak$ <> "0" THEN COLOR kolor: PSET (xd + 96, yd + 88)
IF znak$ = "7" THEN COLOR 16: PSET (xd + 96, yd + 88)
IF znak$ = "A" THEN COLOR 16: PSET (xd + 96, yd + 88)
IF znak$ = "4" THEN COLOR 32: PSET (xd + 96, yd + 88)

IF znak$ = "9" THEN COLOR 32: PSET (xd + 96, yd + 88)

NEXT xd
NEXT yd

REM RYSUNEK OKNA NIEBIESKO-ZIELONEGO
bitmap$(0) = "AAGGGGGGGGGGGGGGGGGGGGGGGGGGGGAA"
bitmap$(1) = "AAGKKKKKKKKGKKKKKKKKGKKKKKKKKGAA"
bitmap$(2) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(3) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(4) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(5) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(6) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(7) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(8) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(9) = "AAGKIEEEEIIGKIIEEIIIGKEEEIIIIGAA"
bitmap$(10) = "AAGKEEEEEEIGKIEEEEIEGKEEEEIIIGAA"
bitmap$(11) = "AAGKEEEEEEEGKEEEEEEEGKEEEEEEIGAA"
bitmap$(12) = "AAGKEHEEEEEGKEEEEEEEGKEEEEEEEGAA"
bitmap$(13) = "AAGKEHEHEEEGKEHEEEEEGKEEHEEEEGAA"
bitmap$(14) = "AAGKEEHEEEEGKEHEHEEEGKHEHEEHEGAA"
bitmap$(15) = "AAGKEEHEEEEGKEEHEEEEGKEHEEHEEGAA"
bitmap$(16) = "AAGKHEHEEEEGKHEHEHEEGKEEHEHEEGAA"
bitmap$(17) = "AAGKEHEEEHEGKEHEEEHEGKEEEHEEEGAA"
bitmap$(18) = "AAGKEHEEEHEGKEHEEEHEGKEEHEEEEGAA"
bitmap$(19) = "AGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGA"

FOR yd = 0 TO 19
FOR xd = 0 TO 31
color$ = MID$(bitmap$(yd), xd + 1, 1)

COLOR ASC(color$) - 65
PSET (xd, yd + 120)
NEXT xd: NEXT yd

REM RYSUNEK OKNA NIEBIESKIEGO
bitmap$(0) = "AAGGGGGGGGGGGGGGGGGGGGGGGGGGGGAA"
bitmap$(1) = "AAGKKKKKKKKGKKKKKKKKGKKKKKKKKGAA"
bitmap$(2) = "AAGKIIIIIIIGKIIIIIIIGKIIIJJJJGAA"
bitmap$(3) = "AAGKIIIIIIIGKIIIIIIIGKIIIJJJJGAA"
bitmap$(4) = "AAGKIIIIIIIGKIIIIIIIGKIIIIJJJGAA"
bitmap$(5) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIJJGAA"
bitmap$(6) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(7) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(8) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(9) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(10) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(11) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(12) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(13) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(14) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(15) = "AAGKIEEEEIIGKIIEEIIIGKEEEIIIIGAA"
bitmap$(16) = "AAGKEEEEEEIGKIEEEEIEGKEEEEIIIGAA"
bitmap$(17) = "AAGKEEEEEEEGKEEEEEEEGKEEEEEEIGAA"
bitmap$(18) = "AAGKEEEEEEEGKEEEEEEEGKEEEEEEEGAA"
bitmap$(19) = "AGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGA"

FOR yd = 0 TO 19
FOR xd = 0 TO 31
color$ = MID$(bitmap$(yd), xd + 1, 1)

COLOR ASC(color$) - 65
PSET (xd + 32, yd + 120)
NEXT xd: NEXT yd

REM RYSUNEK OKNA ZIELONEGO

bitmap$(0) = "AAGGGGGGGGGGGGGGGGGGGGGGGGGGGGAA"
bitmap$(1) = "AAGKKKKKKKKGKKKKKKKKGKKKKKKKKGAA"
bitmap$(2) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(3) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(4) = "AAGKIEEEEIIGKIIEEIIIGKEEEIIIIGAA"
bitmap$(5) = "AAGKEEEEEEIGKIEEEEIEGKEEEEIIIGAA"
bitmap$(6) = "AAGKEEEEEEEGKEEEEEEEGKEEEEEEIGAA"
bitmap$(7) = "AAGKEEHEEEEGKEEHEHEEGKEHEEEEEGAA"
bitmap$(8) = "AAGKEEHEHEEGKEEEHEEHGKEEHEEEEGAA"
bitmap$(9) = "AAGKEEEHEEEGKHEEHEHEGKHEHEEHEGAA"
bitmap$(10) = "AAGKHEEHEEEGKHEHEHEEGKEHEEHEEGAA"
bitmap$(11) = "AAGKEHEHEHEGKEHEEHEHGKEEHEHEEGAA"
bitmap$(12) = "AAGKEEHEEHEGKEHEEEHEGKEEHHEEEGAA"
bitmap$(13) = "AAGKEEHEHEEGKEHEHEHEGKEEHEEEEGAA"
bitmap$(14) = "AAGKEEHHEEEGKEHHEEHEGKEEHEEEEGAA"
bitmap$(15) = "AAGKEEHEEEEGKEHEEEHEGKEEHEEEEGAA"
bitmap$(16) = "AAGKEEHEEEEGKEHEEHHHGKEEHEEEEGAA"
bitmap$(17) = "AAGKEHHHEEEGKHHHEEEEGKEHHHEEEGAA"
bitmap$(18) = "AAGKEEEEEEEGKEEEEEEEGKEEEEEEEGAA"
bitmap$(19) = "AGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGA"

FOR yd = 0 TO 19
FOR xd = 0 TO 31
color$ = MID$(bitmap$(yd), xd + 1, 1)

COLOR ASC(color$) - 65
PSET (xd + 64, yd + 120)
NEXT xd: NEXT yd

REM RYSUNEK wentylatora

bitmap$(0) = "KKKKKGGGGGKKKKKALLLLLGGGGGLLLLLA"
bitmap$(1) = "KKKGGNNLLLGGKKKALLLGGLLLLLGGLLLA"
bitmap$(2) = "KKGNNNNLLLLLGKKALLGALLLLLLLAGLLA"
bitmap$(3) = "KGMMNNNLLLLMMGKALGAALLLLLLLAAGLA"
bitmap$(4) = "KGMMMNNLLLMMMGKALGAAALLLLLAAAGLA"
bitmap$(5) = "GMMMMMNLLMMMMMGAGAAAALLLLLAAAAGA"
bitmap$(6) = "GMMMMMGGGMMMMNGAGAAAAALLLAAAAAGA"
bitmap$(7) = "GLLLLLGGGNNNNNGAGLLLAAALAAALLLGA"
bitmap$(8) = "GLLLLLGGGNNNNNGAGLLLLLLALLLLLLGA"
bitmap$(9) = "GLLLNNNMLLLNNNGAGLLLLLLALLLLLLGA"
bitmap$(10) = "KGNNNNMMMLLLNGKALGLLLLAAALLLLGLA"
bitmap$(11) = "KGNNNNMMMLLLLGKALGLLLAAAAALLLGLA"
bitmap$(12) = "KKGNNNMMMLLLGKKALLGLLAAAAALLGLLA"
bitmap$(13) = "KKKGGMMMMMGGKKKALLLGGAAAAAGGLLLA"
bitmap$(14) = "KKKKKGGGGGKKKKKALLLLLGGGGGLLLLLA"
bitmap$(15) = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"

FOR yd = 0 TO 15
FOR xd = 0 TO 31
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65
: PSET (xd, yd + 140)
NEXT xd: NEXT yd

REM rysunek bloku niebieskiego
REM 249-D 250-E 251-F

bitmap$(0) = "DDDDDDDDDDDDDDDE"
bitmap$(1) = "DFFFFFFFFFFFFFFE"
bitmap$(2) = "DFFFFFFFFFFFFFFE"
bitmap$(3) = "DFFFFFFFFFFFFFFE"
bitmap$(4) = "DFFFFFFFFFFFFFFE"
bitmap$(5) = "DFFFFFFFFFFFFFFE"
bitmap$(6) = "DFFFFFFFFFFFFFFE"
bitmap$(7) = "DFFFFFFFFFFFFFFE"
bitmap$(8) = "DFFFFFFFFFFFFFFE"
bitmap$(9) = "DFFFFFFFFFFFFFFE"
bitmap$(10) = "DFFFFFFFFFFFFFFE"
bitmap$(11) = "DFFFFFFFFFFFFFFE"
bitmap$(12) = "DFFFFFFFFFFFFFFE"
bitmap$(13) = "DFFFFFFFFFFFFFFE"
bitmap$(14) = "DFFFFFFFFFFFFFFE"
bitmap$(15) = "DFFFFFFFFFFFFFFE"
bitmap$(16) = "DFFFFFFFFFFFFFFE"
bitmap$(17) = "DEEEEEEEEEEEEEEE"
FOR yd = 0 TO 17
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + 246
PSET (80 + xd, 64 + yd)
PSET (96 + xd, 64 + yd)

NEXT xd: NEXT yd

REM zapis do pliku

DEF SEG = &HA000
BSAVE "bitmap1.scr", 0, 57000
COLOR 15: LOCATE 23, 1
INPUT a$
CLS

BLOAD "bitmap1.scr"

END

Piotr-246 · Gość

DECLARE SUB zabranie ()

REM Gra "Serca" UWAGA wersaj gry wymaga
REM emulatora o predkosci 6075 cyklow
REM wymaga pliku bitmap1.scr utworzonego przez modul bsave.bas

DECLARE SUB dreptanie ()
DECLARE SUB animacja ()
DECLARE SUB rysowanie ()
DECLARE SUB palety ()
DECLARE SUB plansze ()
DECLARE SUB cegly ()

REM plansza startowa:
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
roomx = 7: roomy = 4

DIM SHARED kolor$(0 TO 255)
DIM pamiec(0 TO 128) AS LONG
DIM poledzialania(0 TO 240) AS LONG
DIM SHARED p$(0 TO 159)
DIM SHARED kod$
DIM SHARED serca(0 TO 15, 0 TO 9) AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER

REM pamiec tla pod wziatek

DIM SHARED tlo(0 TO 32) AS LONG

REM tlo

DIM SHARED szaretlo(0 TO 74) AS LONG
DIM SHARED szaretlo2(0 TO 148) AS LONG
DIM SHARED szaretlo4(0 TO 300) AS LONG
REM dane elementow planszy

DIM SHARED ceg2(0 TO 75) AS LONG
DIM SHARED ceg40(0 TO 730) AS LONG
DIM SHARED ceg17plus17(0 TO 730) AS LONG
DIM SHARED ceg13plus13(0 TO 760) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 750) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED nieb(0 TO 145) AS LONG

DIM SHARED blokp(0 TO 74) AS LONG
DIM SHARED bloks(0 TO 74) AS LONG
DIM SHARED blokk(0 TO 74) AS LONG
DIM SHARED blok2(0 TO 158) AS LONG
DIM SHARED blok4(0 TO 296) AS LONG

REM ****************** DANE ANIMACJI

DIM SHARED znakp1(0 TO 128) AS LONG
DIM SHARED znakl1(0 TO 128) AS LONG
DIM SHARED znakp2(0 TO 128) AS LONG
DIM SHARED znakl2(0 TO 128) AS LONG
DIM SHARED znakp3(0 TO 128) AS LONG
DIM SHARED znakl3(0 TO 128) AS LONG
DIM SHARED vertd1(0 TO 128) AS LONG

REM matryce okien

DIM SHARED window1(0 TO 160) AS LONG
DIM SHARED window2(0 TO 160) AS LONG
DIM SHARED window3(0 TO 160) AS LONG

DIM SHARED wentylator(0 TO 64) AS LONG

REM ************************* DANE STARTOWE

SCREEN 13
REM PRINT FRE(-2): END
DEF SEG = 0: REM - to dla pomiaru predkosci

x = 150: y = 35: xs = 150: ys = 35: REM wspolrzedne poczatkowe gracza na ekranie
licz = -1: REM wartosc startowa zegara
REM roomx = 3: roomy = 3 przeniesione wyzej
kolwent = 30 + 30 * 256 + 30 * 65536: REM kolor lopat wentylatora

REM ***** SUB palety - ustawienie nowych wartosci barw
palety

REM ***** SUB cegly - zapelnienie pozostalych tablic
cegly

REM SUB plansze - wypelnienie tablicy wygladu plansz
plansze

REM SUB animacja - tablice animacji postaci
REM animacja

REM ************************* WYBOR POMIESZCZENIA

rysuj:

kod$ = p$(roomx + roomy * 16)

REM ******************** rysowanie pomieszczenia
t0 = PEEK(1132): REM pomiar czasu rysowania

REM SUB rysowanie - rysowanie planszy
rysowanie

REM pomiar czasu rysowania
t1 = PEEK(1132):

REM menu na dole
COLOR 235
REM LOCATE 23, 1: FOR i = 1 TO 40: PRINT CHR$(223); : NEXT i
LOCATE 25, 15: PRINT "L-SHIFT ALT P-SHIFT";

LOCATE 24, 2: COLOR 3: PRINT "T:"; t0; "/"; t1; FRE(-2);
PRINT " ROOM:"; roomx; "/"; roomy; "--";

REM **************** zapamietanie pola pod graczem
GET (x, y)-(x + 15, y + 31), pamiec
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
REM PUT (x, y), vertd1, PSET
liczsercaroom = 0: zrobione = 0
GOTO postaw
REM *************************** PETLA GLOWNA

petla:
dx = 0: dy = 0
IF dzwiekbrania = 1 THEN dzwiekbrania = 0: zabranie

REM ******************* czas gry w sekundach

se$ = MID$(TIME$, 7, 2)
se = VAL(se$)
IF se <> ses THEN licz = licz + 1
ses = se
LOCATE 25, 2: COLOR 15: PRINT "Czas:"; licz;

REM ************************ petla opozniajaca
FOR delay = 1 TO 700: NEXT delay

REM faza wentylatora

komorka = PEEK(1132) / 1.5
faz = INT(komorka)
IF faz / 3 = INT(faz / 3) THEN faza = 0
IF (faz + 1) / 3 = INT((faz + 1) / 3) THEN faza = 1
IF (faz + 2) / 3 = INT((faz + 2) / 3) THEN faza = 2
FOR i = 0 TO 2: i16 = i * 16
IF faza = 0 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, 0
IF faza = 1 THEN PALETTE 11 + i16, 0: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, kolwent
IF faza = 2 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, 0: PALETTE 13 + i16, kolwent
NEXT i

REM ************************ sprawdzenie klawiszy

alt = 0: lshift = 0: pshift = 0: skos = 0

k$ = INKEY$
IF k$ = "f" THEN roomx = roomx - 1: GOTO rysuj
IF k$ = "h" THEN roomx = roomx + 1: GOTO rysuj
IF k$ = "t" THEN roomy = roomy - 1: GOTO rysuj
IF k$ = "b" THEN roomy = roomy + 1: GOTO rysuj

IF k$ = CHR$(27) THEN END

REM klawisz alt - wznoszenie sie
IF (PEEK(1047) AND 8) = 8 THEN alt = 1
IF (PEEK(1047) AND 2) = 2 THEN lshift = 1
IF (PEEK(1047) AND 1) = 1 THEN pshift = 1

REM bezruch = grawitacja
IF lshift = 0 AND pshift = 0 AND alt = 0 THEN dy = 2: vert = 1: obrot = 0: przebiervert = 0: GOTO czy

POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury

IF lshift = 1 THEN dx = -4: dy = 2: obrot = -1: vert = 0
IF pshift = 1 THEN dx = 4: dy = 2: obrot = 1: vert = 0
IF alt = 1 THEN dy = -4: vert = 1
IF dx <> 0 AND dy <> 0 THEN skos = 1
czy:

REM ************ sprawdzenie czy jest przejscie do innej planszy

IF x + dx > 300 THEN x = 5: xs = 5: roomx = roomx + 1: GOTO rysuj
IF x + dx < 3 THEN x = 300: xs = 300: roomx = roomx - 1: GOTO rysuj
IF y + dy > 144 THEN y = 5: ys = 5: roomy = roomy + 1: GOTO rysuj
IF y + dy < 4 THEN y = 145: ys = 145: roomy = roomy - 1: GOTO rysuj

REM *********** sprawdzenie czy ruch jest mozliwy
REM sprawdzenie przeszkody. Przeszkoda sa kolory > 200

xmozliwy = 0: xniemozliwy = 0
ymozliwy = 0: yniemozliwy = 0

REM sprawdzenie sasiedztwa obok

IF dx > 0 THEN
FOR i = 0 TO 31: punkt = POINT(x + 19, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 198 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF

IF dx < 0 THEN
FOR i = 0 TO 31: punkt = POINT(x - 3, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 199 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF xniemozliwy = 0 THEN xmozliwy = 1
IF xniemozliwy = 1 THEN xmozliwy = 0

REM sprawdzenie sasiedztwa gora dol

IF dy > 0 THEN
FOR i = 0 TO 15:
IF POINT(x + i, y + 32) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y + 33) > 200 THEN yniemozliwy = 1: EXIT FOR

NEXT i
END IF

IF dy < 0 THEN
FOR i = 0 TO 15
IF POINT(x + i, y - 4) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y - 5) > 200 THEN yniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF yniemozliwy = 0 THEN ymozliwy = 1
IF yniemozliwy = 1 THEN ymozliwy = 0

REM ruch gdy oba mozliwe x oraz y
IF ymozliwy = 1 AND xmozliwy = 1 THEN IF dx <> 0 OR dy <> 0 THEN GOTO ruch

REM szczegolne przypadki gdy tylko x albo y mozliwy
IF ymozliwy = 0 AND xmozliwy = 1 THEN dy = 0: GOTO czy
IF ymozliwy = 1 AND xmozliwy = 0 THEN dx = 0: GOTO czy

REM ruch niemozliwy powrot petli glownej bez zmian pozostaja x y

x = xs: y = ys
GOTO petla

REM ***************** RUCH

ruch:

x = x + dx: y = y + dy
IF dy = 0 AND przebieranie = 0 AND alt = 0 THEN dreptanie: REM dzwiek chodzenia

REM ******************** czy jest wziatek
deltawx = ABS(x + 4 - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek

REM ************************************** operacja odswiezania tla
postaw:
REM punkt 1 zapamietanie nowego pola dzialania (brudnego)
REM w oparciu o nowe x,y

GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania

REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo

deltax = x - xs: deltay = y - ys
inversx = -1 * deltax: inversy = -1 * deltay
inver4 = INT(inversx / 4)
FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = (yt + inversy) * 6
FOR xt = 0 TO 3
index1 = 1 + (yt6 + 24) + (xt + inver4) + 1
index2 = 1 + yt4 + xt
poledzialania(index1) = pamiec(index2)
NEXT xt: NEXT yt

REM zmazanie serca z pola dzialania

IF liczsercaroom = 1 AND zrobione = 0 THEN
zrobione = 1
PUT (x - 4, y - 4), poledzialania, PSET
PUT (xserca, yserca), tlo, PSET
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
END IF

REM nowa mala pamiec

FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = yt * 6
FOR xt = 0 TO 3:
index1 = 1 + (yt6 + 24) + (xt + 1):
index2 = 1 + yt4 + xt:
pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt

REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU

REM aby nie rysowac dwoch postaci w przypadku skosu
IF skos = 1 THEN GOTO bezskosu:

REM ************************** ruch w dol lub gore

IF vert = 1 THEN wkleic = 7: GOTO wklej
bezskosu:
REM ************************** ruch w lewo

IF obrot = -1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1
IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 1: GOTO wklej
IF przebieranie = 1 THEN wkleic = 2: GOTO wklej
IF przebieranie = 2 THEN wkleic = 3: GOTO wklej
END IF

REM ****************** ruch w prawo

IF obrot = 1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1

IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 4: GOTO wklej
IF przebieranie = 1 THEN wkleic = 5: GOTO wklej
IF przebieranie = 2 THEN wkleic = 6: GOTO wklej
END IF

xs = x: ys = y

GOTO petla

wklej:

IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt
IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt
IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt
IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt
IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt
IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt
IF wkleic = 7 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)): NEXT xt: NEXT yt

REM wklejenie wyniku operacji na tablicy:
PUT (x - 4, y - 4), poledzialania, PSET

xs = x: ys = y
GOTO petla

REM GOSUB-RETURN****************************** obsluga wziatku

wziatek:
IF serca(roomx, roomy) = 0 THEN GOTO niemawziatku
IF liczsercaroom = 1 THEN GOTO niemawziatku
serca(roomx, roomy) = 0
liczserca = liczserca + 1
PUT (xserca, yserca), tlo, PSET

liczsercaroom = 1
dzwiekbrania = 1

LOCATE 1, 1: COLOR 6: PRINT liczserca;
niemawziatku:
RETURN

SUB animacja
REM ************************ znaczek - glowny bohater
REM ****************** DANE ANIMACJI
REM ten SUB jest do skasowania

END SUB

SUB cegly

BLOAD "bitmap1.scr"

REM INPUT a$
REM pobranie z ekranu tablic elementow
REM uwaga! wysokosc elementu to 9 lub 18 px

GET (0, 0)-(31, 8), ceg2
GET (0, 0)-(319, 8), ceg40
GET (0, 9)-(319, 17), ceg17plus17
GET (0, 18)-(319, 26), ceg13plus13
GET (0, 27)-(319, 35), ceg4plus20plus4
GET (0, 36)-(15, 53), szaretlo
GET (0, 36)-(31, 53), szaretlo2
GET (0, 36)-(63, 53), szaretlo4: REM 36+18=46+8=54

GET (16, 64)-(31, 79), palma
GET (32, 64)-(47, 81), blokp
GET (48, 64)-(63, 81), bloks
GET (64, 64)-(79, 81), blokk
GET (0, 156)-(31, 173), blok2
GET (0, 156)-(63, 173), blok4
GET (80, 64)-(111, 81), nieb

GET (0, 88)-(15, 119), znakl1
GET (16, 88)-(31, 119), znakp1
GET (32, 88)-(47, 119), znakl2
GET (48, 88)-(63, 119), znakp2
GET (64, 88)-(79, 119), znakl3
GET (80, 88)-(95, 119), znakp3
GET (96, 88)-(111, 119), vertd1

GET (0, 120)-(31, 139), window1
GET (32, 120)-(63, 139), window2
GET (64, 120)-(95, 139), window3
GET (0, 140)-(15, 155), wentylator
CLS
END SUB

SUB dreptanie

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)

REM ewentualnie:
REM OUT 66, 30: OUT 66, 0
REM OUT 66, 164: OUT 66, 2
REM OUT 66, 130: OUT 66, 1
REM OUT 66, 74: OUT 66, 0
REM OUT 66, 220: OUT 66, 1

FOR i = 1 TO 10
OUT 66, 30: OUT 66, 0
OUT 66, 84: OUT 66, 2
OUT 66, 30: OUT 66, 0
OUT 66, 94: OUT 66, 2
OUT 66, 10: OUT 66, 0
OUT 66, 40: OUT 66, 2
OUT 66, 84: OUT 66, 0
OUT 66, 10: 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 palety

REM palety kolorow *********************************
REM max koloru=3F

FOR i = 0 TO 255: kolor$(i) = "00 00 00 00"
PALETTE i, 31 + 31 * 256 + 31 * 65536: NEXT i

REM kolory za ludzikiem

kolor$(0) = "00 00 00 00": REM rejestr zero- wolny
kolor$(1) = "01 05 05 06": REM tlo plyta
kolor$(2) = "02 02 03 02": REM tlo fuga
kolor$(3) = "03 07 06 06": REM tlo krawedz
kolor$(4) = "04 00 22 00": REM liscie
kolor$(5) = "05 3F 08 00": REM serce
kolor$(6) = "06 30 30 30": REM framuga okna
kolor$(7) = "07 28 0A 00": REM doniczka drzewa
kolor$(8) = "08 00 21 39": REM niebo
kolor$(9) = "09 3F 3F 00": REM slonce
kolor$(10) = "0A 14 14 14": REM framuga zewnetrzna
kolor$(11) = "0B 00 00 00": REM wentylator faza 1
kolor$(12) = "0C 00 00 00": REM wentylator faza 2
kolor$(13) = "0D 00 00 00": REM wentylator faza 3
kolor$(14) = "0E 20 20 20": REM srednia szarosc
kolor$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza

REM rejestry przezroczyste gracza
kolor$(16) = "10 18 02 02": REM sweter + zero
kolor$(17) = "11 18 02 02": REM
kolor$(18) = "12 18 02 02": REM
kolor$(19) = "13 18 02 02": REM
kolor$(20) = "14 22 12 00": REM sweter + liscie
kolor$(21) = "15 3F 00 00": REM
kolor$(22) = "16 2F 09 09": REM sweter + framuga okna
kolor$(23) = "17 2B 08 00": REM sweter + doniczka drzewa
kolor$(24) = "18 25 16 24": REM sweter + niebo
kolor$(25) = "19 3F 3F 3F": REM sweter + slonce
kolor$(26) = "1A 16 0F 0F": REM sweter + framuga zew
kolor$(27) = "1B 3F 3F 3F": REM
kolor$(28) = "1C 3F 3F 3F": REM
kolor$(29) = "1D 3F 3F 3F": REM
kolor$(30) = "1E 20 10 10": REM sweter + przyciski
REM kolor 31 (1F) zastrzezony dla gracza
kolor$(32) = "20 0A 13 29": REM spodnie + zero
kolor$(33) = "21 0A 13 29": REM
kolor$(34) = "22 0A 13 29": REM
kolor$(35) = "23 0A 13 29": REM
kolor$(36) = "24 05 1D 24": REM spodnie+ liscie
kolor$(37) = "25 3F 3F 3F": REM
kolor$(38) = "26 1B 1B 32": REM spodnie + framuga okna
kolor$(39) = "27 1A 10 3F": REM spodnie + doniczka
kolor$(40) = "28 00 1A 3F": REM spodnie + niebo
kolor$(41) = "29 3F 3F 3F": REM spodnie +slonce
kolor$(42) = "2A 10 14 20": REM spodnie + framuga zew
kolor$(43) = "2B 3F 3F 3F": REM
kolor$(44) = "2C 3F 3F 3F": REM
kolor$(45) = "2D 3F 3F 3F": REM
kolor$(46) = "2E 3F 3F 3F": REM
REM rejestr 47 (2F) zastrzezony dla gracza

REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF)
REM rejestry nieprzezroczyste

kolor$(31) = "1F 2F 09 09": REM sweter
kolor$(47) = "2F 0D 1A 37": REM spodnie
kolor$(63) = "3F 1A 1A 1A": REM wlosy i buty
kolor$(79) = "4F 10 10 10": REM pasek2
kolor$(95) = "5F 3F 2F 0F":
kolor$(111) = "6F 3F 30 20": REM skora1
REM kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych
kolor$(143) = "8F 32 22 02": REM nos
REM kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych
REM kolor$(175) = "AF 22 02 02": REM sweter3
kolor$(191) = "BF 20 20 20": REM pasek
kolor$(207) = "CF 37 27 06": REM usta
REM FF- zarezerwowany dla przeslony

REM rejestry jednokierunkowe
kolor$(198) = "C6 20 20 20"
kolor$(199) = "C7 20 20 20"

REM bloczek

kolor$(224) = "E0 00 00 00": REM
kolor$(225) = "E1 04 04 04": REM
kolor$(226) = "E2 08 08 08": REM
kolor$(227) = "E3 0B 0B 0B": REM
kolor$(228) = "E4 10 10 10": REM
kolor$(229) = "E5 14 14 14": REM
kolor$(230) = "E6 18 18 18": REM
kolor$(231) = "E7 1B 1B 1B": REM
kolor$(232) = "E8 20 20 20": REM
kolor$(233) = "E9 24 24 24": REM
kolor$(234) = "EA 28 28 28": REM
kolor$(235) = "EB 2B 2B 2B": REM
kolor$(236) = "EC 30 30 30": REM
kolor$(237) = "ED 34 34 34": REM
kolor$(238) = "EE 38 38 38": REM
kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika

REM kolor 240 - przeslona
kolor$(240) = "F0 38 38 38"

REM cegly male niebieskie

kolor$(249) = "F9 22 27 30": REM krawedz
kolor$(250) = "FA 09 0E 14": REM fuga
kolor$(251) = "FB 11 17 1F": REM cegla

REM cegly male czerwone

kolor$(252) = "FC 30 27 27": REM krawedz
kolor$(253) = "FD 14 0E 0E": REM fuga
kolor$(254) = "FE 1F 17 17": REM cegla
kolor$(255) = "FF 28 28 28": REM przeslona

FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2)
red$ = "&H" + MID$(kolor$(i), 4, 2)
gre$ = "&H" + MID$(kolor$(i), 7, 2)
blu$ = "&H" + MID$(kolor$(i), 10, 2)
REM PRINT rej$; " "; red$; " "; gre$; " "; blu$
rej = VAL(rej$)
red = VAL(red$)
gre = VAL(gre$)
blu = VAL(blu$)
REM PRINT rej; " "; red; " "; gre; " "; blu

PALETTE rej, red + gre * 256 + blu * 65536
NEXT i

END SUB

SUB plansze

REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** roomy*16+roomx

REM kody plansz +++nr.po.ok.we.se_kw_dod
REM ************ plansze wiersza roomy=0

p$(0) = "h22233322d.0.UI.YO....GN________!"
p$(1) = "h000fff11h.1....MD....__________!"
p$(2) = "h11133333f.2.UI.HE....___EQ_____!"
p$(3) = "hh2223cchh.3..........SJ________!"
p$(4) = "h300033fff.4....ZK....__________!"
p$(5) = "h2001c333f.5....LG....______AQG_!"
p$(6) = "h111g3322f.6....LD....___EQ_F[Q_!"
p$(7) = "hh222dd11g.7.BE....DF.aH_WI_MdO_!"
p$(8) = "hhDDDfCCCg.8..........__________!"
p$(9) = "hhhhhf111c.9..........__________!"
p$(10) = "hhhhhf222g.A..........GG_EQ_____!"
p$(11) = "hh333f111d.B....HG....__________!"
p$(12) = "hhffff333g.C..........__________!"
p$(13) = "h22233333c.D.UN.aK.DF.MK____AYC_!"
p$(14) = "h111ff22hh.E..........___aG_BLM_!"
p$(15) = "h3333311cc.F....ZK....aH____AIG_!"

REM ************ plansze wiersza roomy=1

p$(16) = "d333c2223h.0.......FN.__________!"
p$(17) = "h33330003h.1.WH.SO....dE____COM_!"
p$(18) = "ff333111ff.2.WJ.ML....__________!"
p$(19) = "hc222c333c.3..........___QQ_____!"
p$(20) = "f31113333h.4.UM.aI.aO.__________!"
p$(21) = "f333aa333h.5..........RN_GQ_____!"
p$(22) = "ffff333fff.6....DJ....aM____G[M_!"
p$(23) = "gg333a33hh.7..........__________!"
p$(24) = "gg333333ff.8.AK....IF.__________!"
p$(25) = "cc3322333c.9.WM.......eF________!"
p$(26) = "gg331133hh.A....LF....aO________!"
p$(27) = "ddaa22cccc.B..........__________!"
p$(28) = "g33300333h.C.AM....aO.__________!"
p$(29) = "c33311333c.D.0M.......ZK____AQO_!"
p$(30) = "h3322233dd.E.BE....aF.__________!"
p$(31) = "c33111333h.F.AM.bD....___QQ_COH_!"

REM ************* plansze wiersza roomy=2

p$(32) = "h333ff333c.0..........KE_WQ_____!"
p$(33) = "h33332222c.1....KD....UP____CGI_!"
p$(34) = "faaaa0000h.2....WO.VI.__________!"
p$(35) = "ccccc1111f.3....MM....___EQ_____!"
p$(36) = "h33333223h.4.WI.FP....SM________!"
p$(37) = "haa33200af.5.UJ....GL.______HIE_!"
p$(38) = "f333c111ah.6....aM....UP________!"
p$(39) = "hh333d333g.7....YP....___KQ_____!"
p$(40) = "ff3333333g.8.#I.......KK____CGN_!"
p$(41) = "c33g33d33c.9..........__________!"
p$(42) = "hh3333333g.A.WM.LI....__________!"
p$(43) = "cc333322cc.B.UJ.......__________!"
p$(44) = "hhaacc00hh.C.BE....JG.ZM____AQM_!"
p$(45) = "c333cc11gg.D....aN....______AQM_!"
p$(46) = "dd33cc22hh.E..........______AQE_!"
p$(47) = "hh3331113c.F.UK....VI.___EQ_____!"

REM ************ plansze wiersza roomy=3

p$(48) = "c33332222f.0....ZM.ZD.SF____COI_!"
p$(49) = "ccccc1111h.1..........__________!"
p$(50) = "ha3222333c.2.#F.LO....UO_SQ_____!"
p$(51) = "ff3111333f.3.WM.YI.VI.SJ_GQ_____!"
p$(52) = "h3333c333f.4..........NG____CKK_!"
p$(53) = "ff333c222f.5....ZO....SG________!"
p$(54) = "hhaaff000f.6.BE.......___KQ_____!"
p$(55) = "gggg33111f.7....LO.VJ.______IYM_!"
p$(56) = "gg3322ffff.8..........GG________!"
p$(57) = "cccc00hfff.9..........__________!"
p$(58) = "gg33DDffff.A..........___KK_CCH_!"
p$(59) = "cccccfffff.B.......TL.__________!"
p$(60) = "hh3333333f.C....KK....DP________!"
p$(61) = "g333333hhh.D.UJ....TF.______CKK_!"
p$(62) = "hh3222333f.E..........___GQ_____!"
p$(63) = "c331113hhh.F....ZK....__________!"

REM ****************** plansze wiersza roomy=4

p$(64) = "f22322322h.0....DD....SP_YQ_CKK_!"
p$(65) = "h00f00f00h.1..........__________!"
p$(66) = "c11311311f.2....aP.KP.__________!"
p$(67) = "ff3332223h.3.UJ.ML....___YQ_____!"
p$(68) = "f3333111hh.4.WJ.YL....__________!"
p$(69) = "ffaafaaaff.5.......VI.__________!"
p$(70) = "ffa333c33h.6....OG....SQ_YQ_____!"
p$(71) = "ff2233c33d.7....TP....______MdO_!": REM startowa
p$(72) = "ff113cc33d.8..........MO____JVO_!"
p$(73) = "ff33cc33ff.9..........______COI_!"
p$(74) = "ff3333333d.A.WM.LI.ZP.PP________!"
p$(75) = "ff2233333f.B.UM.......___EQ_____!"
p$(76) = "ff11333hhh.C.......KH.__________!"
p$(77) = "h333333333.D.BE.SK....bF____CKK_!"
p$(78) = "ff22233hhh.E.UJ.......______FEE_!"
p$(79) = "h311133fff.F.WJ.......MM________!"

REM ******************* plansze wiersza roomy=5

p$(80) = "haf222faff.0.......VI.___KK_____!"
p$(81) = "hhf111222h.1..........SP____CKK_!"
p$(82) = "fa333c000h.2....GO....__________!"
p$(83) = "h222fa111f.3..........___YQ_____!"
p$(84) = "h111c2223h.4.0Q....EE.MM________!"
p$(85) = "ffffa111ff.5..........______GOE_!"
p$(86) = "h333c333af.6....DD....ZF_MQ_____!"
p$(87) = "dd333f333g.7.......VI.___aI_____!"
p$(88) = "dd3333333g.8.UN.KP....______COI_!"
p$(89) = "f32233f33f.9.......ED.KK________!"
p$(90) = "ddDDCC333h.A....ZK....KO________!"
p$(91) = "f33300f33f.B..........______COH_!"
p$(92) = "h33300333c.C....NN....__________!"
p$(93) = "333311333h.D.0M....TG.GG________!"
p$(94) = "h33222333c.E.AM.......__________!"
p$(95) = "ff3111333h.F.WM.FF....___YQ_____!"

REM ******************* plansze wiersza roomy=6

p$(96) = "fffa222hhh.0....EJ....___YM_____!"
p$(97) = "hhhf000bbb.1....SJ....ML____CMO_!"
p$(98) = "h222111hhh.2..........___KM_____!"
p$(99) = "f111aaafff.3....PH....ZJ________!"
p$(100) = "h222ahhhhh.4..........EE________!"
p$(101) = "f11133222h.5.0I.......___GQ_____!"
p$(102) = "ffffff000h.6....LO....__________!"
p$(103) = "gg333d111f.7....MO....aP________!"
p$(104) = "gg333hCCCh.8.......ZN.EG____HIE_!"
p$(105) = "ffffffDDDh.9..........__________!"
p$(106) = "hh333fCCCh.A.BE.......___KI_____!"
p$(107) = "ff3333111h.B.0I....KK.aP____CKK_!"
p$(108) = "cc22dd22ff.C..........__________!"
p$(109) = "hhDDffDDhh.D.......TJ.LN________!"
p$(110) = "ccc2222hhh.E..........__________!"
p$(111) = "hhhDDDDhhh.F..........TK_KM_____!"

REM ******************* plansze wiersza roomy=7

p$(112) = "hfaa222hhh.0..........______COJ_!"
p$(113) = "bbbb000hhh.1....KK....__________!"
p$(114) = "h222111fff.2.BJ.......ZE____AIK_!"
p$(115) = "f000aaahhh.3..........___KM_____!"
p$(116) = "h000ahhhhh.4.......KF.__________!"
p$(117) = "h111hh222h.5..........KQ________!"
p$(118) = "hfffff000f.6....KO....__________!"
p$(119) = "fffeee000h.7..........___KQ_____!"
p$(120) = "hh3333000h.8.BL.......______CKK_!"
p$(121) = "hCCCffDDDh.9..........KO________!"
p$(122) = "hDDDccCCCh.A..........___MK_____!"
p$(123) = "hf333300Df.B.AL.......__________!"
p$(124) = "ffffff00hh.C....KN....______IOI_!"
p$(125) = "hhhhhf00fh.D.......TK.__________!"
p$(126) = "h33c3300ff.E..........KK____COG_!"
p$(127) = "hhheefDDhh.F....KN....__________!"

REM ***************** n/8 plansze wiersza roomy=8

p$(128) = "hffa222hhh.0..........__________!"
p$(129) = "hbbb000hhh.1..........__________!"
p$(130) = "f222111fff.2..........__________!"
p$(131) = "h000aaahhh.3..........______COI_!"
p$(132) = "h000ahhhhh.4..........__________!"
p$(133) = "h111hh222h.5..........__________!"
p$(134) = "ffffff000f.6..........______DQK_!"
p$(135) = "hhhhha000h.7..........______ESK_!"
p$(136) = "hh3333000h.8..........______CKK_!"
p$(137) = "h33333111h.9..........__________!"
p$(138) = "h33333222h.A.BG.......__________!"
p$(139) = "ffCCff00ff.B..........______KaE_!"
p$(140) = "hfDDff00hh.C..........______JKM_!"
p$(141) = "hhhaac00fh.D..........__________!"
p$(142) = "f3333300ff.E..........______COL_!"
p$(143) = "hhheefDDhh.F..........__________!"

REM ***************** n/9 plansze wiersza roomy=9

p$(144) = "hffa222hhh.0..........__________!"
p$(145) = "hbbb000hhh.1..........__________!"
p$(146) = "f222111hhh.2..........__________!"
p$(147) = "h000aaahhh.3..........__________!"
p$(148) = "h000ahhhhh.4..........__________!"
p$(149) = "h111hh333h.5..........__________!"
p$(150) = "ffffaa222h.6..........__________!"
p$(151) = "hhaaaa000h.7..........__________!"
p$(152) = "hh3333000h.8..........__________!"
p$(153) = "h33333111h.9..........__________!"
p$(154) = "h33333222h.A..........__________!"
p$(155) = "ffCCff00Dh.B..........__________!"
p$(156) = "hfDDff00hh.C..........__________!"
p$(157) = "hhhaac00fh.D..........__________!"
p$(158) = "f3333300hh.E..........__________!"
p$(159) = "hhheefDDhh.F..........__________!"

REM tablica serc
FOR xr = 0 TO 15
FOR yr = 0 TO 9
s = xr + yr * 16
znak$ = MID$(p$(s), 23, 1)
IF znak$ <> "_" THEN serca(xr, yr) = 1
NEXT yr: NEXT xr

END SUB

SUB rysowanie

FOR yw = 0 TO 9
el$ = MID$(kod$, yw + 1, 1)
y16 = yw * 18

REM tymczasowe sygnalizacje bledow:

IF el$ = "Q" OR el$ = "L" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "P" OR el$ = "W" OR el$ = "=" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "A" OR el$ = "B" OR el$ = "U" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "@" THEN COLOR 15: LINE (0, y16)-(200, y16)

REM elementy uzupelniajace

IF el$ = "C" THEN
PUT (128, y16), szaretlo4, PSET: PUT (192, y16), szaretlo4, PSET
PUT (256, y16), szaretlo4, PSET
PUT (0, y16), blok4, PSET: PUT (64, y16), blok2, PSET:
PUT (96, y16), bloks, PSET: PUT (112, y16), blokk, PSET
END IF

IF el$ = "D" THEN
PUT (0, y16), szaretlo4, PSET: PUT (64, y16), szaretlo4, PSET
PUT (128, y16), szaretlo4, PSET
PUT (192, y16), blokp, PSET: PUT (208, y16), blok4, PSET
PUT (272, y16), blok2, PSET: PUT (304, y16), bloks, PSET
END IF

REM czesc automatyczna, znaki a-h
ascii = ASC(el$)

IF ascii > 96 THEN
bity = ascii - 97
PUT (0, y16), blok4, PSET:
pop1 = 0
pop2 = 0
pop3 = 0

IF (bity AND 4) = 4 THEN PUT (64, y16), blok4, PSET: pop1 = 1
IF (bity AND 4) = 0 THEN PUT (48, y16), blokk, PSET: PUT (64, y16), szaretlo4, PSET: pop1 = 0
REM
IF (bity AND 2) = 2 THEN pop2 = 1: PUT (128, y16), blok4, PSET: IF pop1 = 0 THEN PUT (128, y16), blokp, PSET
IF (bity AND 2) = 0 THEN pop2 = 0: PUT (128, y16), szaretlo4, PSET: IF pop1 = 1 THEN PUT (112, y16), blokk, PSET
REM
IF (bity AND 1) = 1 THEN pop3 = 1: PUT (192, y16), blok4, PSET: IF pop2 = 0 THEN PUT (192, y16), blokp, PSET
IF (bity AND 1) = 0 THEN pop3 = 0: PUT (192, y16), szaretlo4, PSET: IF pop2 = 1 THEN PUT (176, y16), blokk, PSET
PUT (256, y16), blok4, PSET
IF pop3 = 0 THEN PUT (256, y16), blokp, PSET
END IF

REM znaki 0-3

IF ascii < 58 THEN
bity = ascii - 48
IF (bity AND 2) = 2 THEN PUT (0, y16), blokk, PSET
IF (bity AND 2) = 0 THEN PUT (0, y16), szaretlo, PSET
PUT (16, y16), szaretlo4, PSET
PUT (80, y16), szaretlo4, PSET
PUT (144, y16), szaretlo4, PSET
PUT (208, y16), szaretlo4, PSET
PUT (272, y16), szaretlo2, PSET

IF (bity AND 1) = 1 THEN PUT (304, y16), blokp, PSET
IF (bity AND 1) = 0 THEN PUT (304, y16), szaretlo, PSET
END IF

NEXT yw

REM rysowanie podestow

el$ = MID$(kod$, 14, 1)
IF el$ = "" OR el$ = "." THEN GOTO dodatek

el2$ = MID$(kod$, 15, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "#" THEN PUT (0, yo), ceg40, PSET
IF el$ = "W" THEN PUT (0, yo), ceg4plus20plus4, PSET
IF el$ = "U" THEN PUT (0, yo), ceg17plus17, PSET
IF el$ = "0" THEN PUT (0, yo), ceg13plus13, PSET
IF el$ = "A" THEN FOR xx = 0 TO 4: PUT (16 + xx * 64, yo), ceg2, PSET: NEXT xx
IF el$ = "B" THEN FOR xx = 0 TO 5: PUT (64 + xx * 32, yo), ceg2, PSET: NEXT xx

REM dodatkowy element
dodatek:

el$ = MID$(kod$, 29, 1)
IF el$ = "" OR el$ = "_" THEN GOTO okna
el2$ = MID$(kod$, 30, 1)
xo = (ASC(el2$) - 65) * 8
el2$ = MID$(kod$, 31, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "A" THEN
PUT (xo, yo), blokp, PSET:
PUT (xo, yo + 18), blokp, PSET
PUT (xo + 16, yo), blok2, PSET:
PUT (xo + 16, yo + 18), blok2, PSET
PUT (xo + 48, yo), blokk, PSET:
PUT (xo + 48, yo + 18), blokk, PSET
END IF

IF el$ = "B" THEN COLOR 235: LINE (xo + 5, yo)-(xo + 9, yo + 35), , BF
IF el$ = "C" THEN PUT (xo, yo), ceg2, PSET: PUT (xo + 32, yo), ceg2, PSET: PUT (xo + 64, yo), ceg2, PSET
IF el$ = "D" THEN LINE (xo, yo)-(xo + 22, yo + 17), 235, BF: LINE (xo + 42, yo)-(xo + 63, yo + 17), 235, BF
IF el$ = "E" THEN LINE (xo, yo)-(xo + 5, yo + 35), 235, BF: LINE (xo + 26, yo + 36)-(xo + 31, yo + 72), 235, BF
REM niebieskie klocki
IF el$ = "F" THEN PUT (xo, yo), nieb, PSET
IF el$ = "G" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo), nieb, PSET
IF el$ = "H" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo + 36), nieb, PSET
IF el$ = "I" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo - 36), nieb, PSET
REM jednokierunkowe bramki
IF el$ = "J" THEN PSET (xo - 2, yo), 199: DRAW "R18 D35 L18 U35 F18 U1 G18"
IF el$ = "K" THEN PSET (xo - 2, yo), 198: DRAW "R18 D35 L18 U35 R18 G18 U1 F18"
REM zaslonka
IF el$ = "L" THEN LINE (xo, yo)-(xo + 15, yo + 35), 255, BF
REM winda
xwindy = -10: ywindy = -10

IF el$ = "M" THEN
LINE (xo, yo)-(xo + 23, yo + 35), 10, BF
LINE (xo, yo)-(xo, yo + 36), 6, BF
LINE (xo, yo)-(xo + 23, yo), 6, BF
LINE (xo + 3, yo + 7)-(xo + 5, yo + 18), 14, BF
LINE (xo + 1, yo)-(xo + 23, yo), 9
REM LINE (xo + 20, yo + 1)-(xo + 22, yo + 1), 9
PSET (xo + 4, yo + 9), 5
PSET (xo + 4, yo + 11), 5
PSET (xo + 4, yo + 13), 5
PSET (xo + 4, yo + 15), 5
PSET (xo + 4, yo + 17), 12
xwindy = xo: ywindy = yo
END IF

okna:

REM rysowanie okien

el$ = MID$(kod$, 17, 1)
IF el$ = "" OR el$ = "." THEN GOTO serce
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 18, 1)
yo = (ASC(el$) - 65) * 9
IF roomy < 2 THEN PUT (xo, yo), window2, PSET
IF roomy > 1 AND roomy < 5 THEN PUT (xo, yo), window1, PSET
IF roomy > 4 THEN PUT (xo, yo), window3, PSET

serce:
REM serce
xserca = -20
yserca = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 23, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xserca = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 24, 1)
yserca = (ASC(el$) - 65) * 9
GET (xserca, yserca)-(xserca + 15, yserca + 7), tlo
COLOR 5
LINE (xserca, yserca + 1)-(xserca, yserca + 3)
LINE (xserca + 1, yserca)-(xserca + 1, yserca + 4)
LINE (xserca + 2, yserca)-(xserca + 2, yserca + 5)
LINE (xserca + 3, yserca + 1)-(xserca + 3, yserca + 6)
LINE (xserca + 4, yserca)-(xserca + 4, yserca + 5)
LINE (xserca + 5, yserca)-(xserca + 5, yserca + 4)
LINE (xserca + 6, yserca + 1)-(xserca + 6, yserca + 3)

donica:
el$ = MID$(kod$, 26, 1)
IF el$ = "" OR el$ = "_" THEN GOTO wentyl
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 27, 1)
yo = (ASC(el$) - 65) * 9 + 2
PUT (xo, yo), palma, PSET

wentyl:
el$ = MID$(kod$, 20, 1)
IF el$ = "" OR el$ = "." THEN GOTO koniecrysowania
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 21, 1)
yo = (ASC(el$) - 65) * 9
PUT (xo, yo), wentylator, PSET

koniecrysowania:

LOCATE 24, 2: COLOR 15: PRINT "Czas:"; licz;

END SUB

SUB zabranie
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)

OUT 66, 32: OUT 66, 3
FOR i = 1 TO 6000: NEXT i

OUT 66, 204: OUT 66, 4
FOR i = 1 TO 6000: NEXT i

t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port

END SUB

Piotr-246 · Gość

DECLARE SUB zabranie ()

REM Gra "Serca" UWAGA wersaj gry wymaga
REM emulatora o predkosci 6075 cyklow
REM wymaga pliku bitmap1.scr utworzonego przez modul bsave.bas

DECLARE SUB dreptanie ()
DECLARE SUB animacja ()
DECLARE SUB rysowanie ()
DECLARE SUB palety ()
DECLARE SUB plansze ()
DECLARE SUB cegly ()

REM plansza startowa:
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
roomx = 7: roomy = 4

DIM SHARED kolor$(0 TO 255)
DIM pamiec(0 TO 128) AS LONG
DIM poledzialania(0 TO 240) AS LONG
DIM SHARED pozycjewind(1 TO 2) AS INTEGER
DIM SHARED p$(0 TO 159)
DIM SHARED kod$
DIM SHARED serca(0 TO 15, 0 TO 9) AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED xwindy AS INTEGER, ywindy AS INTEGER
DIM SHARED winda AS INTEGER

REM pamiec tla pod wziatek

DIM SHARED tlo(0 TO 32) AS LONG

REM tlo

DIM SHARED szaretlo(0 TO 74) AS LONG
DIM SHARED szaretlo2(0 TO 148) AS LONG
DIM SHARED szaretlo4(0 TO 300) AS LONG
REM dane elementow planszy

DIM SHARED ceg2(0 TO 75) AS LONG
DIM SHARED ceg40(0 TO 730) AS LONG
DIM SHARED ceg17plus17(0 TO 730) AS LONG
DIM SHARED ceg13plus13(0 TO 760) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 750) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED nieb(0 TO 145) AS LONG

DIM SHARED blokp(0 TO 74) AS LONG
DIM SHARED bloks(0 TO 74) AS LONG
DIM SHARED blokk(0 TO 74) AS LONG
DIM SHARED blok2(0 TO 158) AS LONG
DIM SHARED blok4(0 TO 296) AS LONG

REM ****************** DANE ANIMACJI

DIM SHARED znakp1(0 TO 128) AS LONG
DIM SHARED znakl1(0 TO 128) AS LONG
DIM SHARED znakp2(0 TO 128) AS LONG
DIM SHARED znakl2(0 TO 128) AS LONG
DIM SHARED znakp3(0 TO 128) AS LONG
DIM SHARED znakl3(0 TO 128) AS LONG
DIM SHARED vertd1(0 TO 128) AS LONG

REM matryce okien

DIM SHARED window1(0 TO 160) AS LONG
DIM SHARED window2(0 TO 160) AS LONG
DIM SHARED window3(0 TO 160) AS LONG

DIM SHARED wentylator(0 TO 64) AS LONG

REM ************************* DANE STARTOWE

SCREEN 13
REM PRINT FRE(-2): END
DEF SEG = 0: REM - to dla pomiaru predkosci

x = 200: y = 35: xs = 200: ys = 35: REM wspolrzedne poczatkowe gracza na ekranie
licz = -1: REM wartosc startowa zegara
winda = 0
REM roomx = 3: roomy = 3 przeniesione wyzej
kolwent = 30 + 30 * 256 + 30 * 65536: REM kolor lopat wentylatora

REM ***** SUB palety - ustawienie nowych wartosci barw
palety

REM ***** SUB cegly - zapelnienie pozostalych tablic
cegly

REM SUB plansze - wypelnienie tablicy wygladu plansz
plansze

REM SUB animacja - tablice animacji postaci
REM animacja

REM ************************* WYBOR POMIESZCZENIA

rysuj:

kod$ = p$(roomx + roomy * 16)

REM ******************** rysowanie pomieszczenia
t0 = PEEK(1132): REM pomiar czasu rysowania

winda = 0
REM SUB rysowanie - rysowanie planszy
rysowanie
IF winda = 1 THEN y = ywindy + 3: ys = ywindy + 3
REM pomiar czasu rysowania
t1 = PEEK(1132):

REM menu na dole
COLOR 235
REM LOCATE 23, 1: FOR i = 1 TO 40: PRINT CHR$(223); : NEXT i
LOCATE 25, 15: PRINT "L-SHIFT ALT P-SHIFT";

LOCATE 24, 2: COLOR 3: PRINT "T:"; t0; "/"; t1; FRE(-2);
PRINT " ROOM:"; roomx; "/"; roomy; "--";

REM **************** zapamietanie pola pod graczem
GET (x, y)-(x + 15, y + 31), pamiec
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
REM PUT (x, y), vertd1, PSET
liczsercaroom = 0: zrobione = 0
GOTO postaw
REM *************************** PETLA GLOWNA

petla:
dx = 0: dy = 0
IF dzwiekbrania = 1 THEN dzwiekbrania = 0: zabranie

REM ******************* czas gry w sekundach

se$ = MID$(TIME$, 7, 2)
se = VAL(se$)
IF se <> ses THEN licz = licz + 1
ses = se
LOCATE 25, 2: COLOR 15: PRINT "Czas:"; licz;

REM ************************ petla opozniajaca
FOR delay = 1 TO 700: NEXT delay

REM faza wentylatora

komorka = PEEK(1132) / 1.5
faz = INT(komorka)
IF faz / 3 = INT(faz / 3) THEN faza = 0
IF (faz + 1) / 3 = INT((faz + 1) / 3) THEN faza = 1
IF (faz + 2) / 3 = INT((faz + 2) / 3) THEN faza = 2
FOR i = 0 TO 2: i16 = i * 16
IF faza = 0 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, 0
IF faza = 1 THEN PALETTE 11 + i16, 0: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, kolwent
IF faza = 2 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, 0: PALETTE 13 + i16, kolwent
NEXT i

REM ************************ sprawdzenie klawiszy

alt = 0: lshift = 0: pshift = 0: skos = 0

k$ = INKEY$
IF k$ = "f" THEN roomx = roomx - 1: GOTO rysuj
IF k$ = "h" THEN roomx = roomx + 1: GOTO rysuj
IF k$ = "t" THEN roomy = roomy - 1: GOTO rysuj
IF k$ = "b" THEN roomy = roomy + 1: GOTO rysuj
IF k$ = CHR$(27) THEN END
IF k$ = "1" AND x > xwindy AND y - ywindy < 10 THEN GOSUB przejazd: GOTO rysuj
IF k$ = "2" AND x > xwindy AND y - ywindy < 10 THEN GOSUB przejazd: GOTO rysuj

REM klawisz alt - wznoszenie sie
IF (PEEK(1047) AND 8) = 8 THEN alt = 1
IF (PEEK(1047) AND 2) = 2 THEN lshift = 1
IF (PEEK(1047) AND 1) = 1 THEN pshift = 1

REM bezruch = grawitacja
IF lshift = 0 AND pshift = 0 AND alt = 0 THEN dy = 2: vert = 1: obrot = 0: przebiervert = 0: GOTO czy

POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury

IF lshift = 1 THEN dx = -4: dy = 2: obrot = -1: vert = 0
IF pshift = 1 THEN dx = 4: dy = 2: obrot = 1: vert = 0
IF alt = 1 THEN dy = -4: vert = 1
IF dx <> 0 AND dy <> 0 THEN skos = 1
czy:

REM ************ sprawdzenie czy jest przejscie do innej planszy

IF x + dx > 300 THEN x = 5: xs = 5: roomx = roomx + 1: GOTO rysuj
IF x + dx < 3 THEN x = 300: xs = 300: roomx = roomx - 1: GOTO rysuj
IF y + dy > 144 THEN y = 5: ys = 5: roomy = roomy + 1: GOTO rysuj
IF y + dy < 4 THEN y = 145: ys = 145: roomy = roomy - 1: GOTO rysuj

REM *********** sprawdzenie czy ruch jest mozliwy
REM sprawdzenie przeszkody. Przeszkoda sa kolory > 200

xmozliwy = 0: xniemozliwy = 0
ymozliwy = 0: yniemozliwy = 0

REM sprawdzenie sasiedztwa obok

IF dx > 0 THEN
FOR i = 0 TO 31: punkt = POINT(x + 19, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 198 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF

IF dx < 0 THEN
FOR i = 0 TO 31: punkt = POINT(x - 3, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 199 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF xniemozliwy = 0 THEN xmozliwy = 1
IF xniemozliwy = 1 THEN xmozliwy = 0

REM sprawdzenie sasiedztwa gora dol

IF dy > 0 THEN
FOR i = 0 TO 15:
IF POINT(x + i, y + 32) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y + 33) > 200 THEN yniemozliwy = 1: EXIT FOR

NEXT i
END IF

IF dy < 0 THEN
FOR i = 0 TO 15
IF POINT(x + i, y - 4) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y - 5) > 200 THEN yniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF yniemozliwy = 0 THEN ymozliwy = 1
IF yniemozliwy = 1 THEN ymozliwy = 0

REM ruch gdy oba mozliwe x oraz y
IF ymozliwy = 1 AND xmozliwy = 1 THEN IF dx <> 0 OR dy <> 0 THEN GOTO ruch

REM szczegolne przypadki gdy tylko x albo y mozliwy
IF ymozliwy = 0 AND xmozliwy = 1 THEN dy = 0: GOTO czy
IF ymozliwy = 1 AND xmozliwy = 0 THEN dx = 0: GOTO czy

REM ruch niemozliwy powrot petli glownej bez zmian pozostaja x y

x = xs: y = ys
GOTO petla

REM ***************** RUCH

ruch:

x = x + dx: y = y + dy
IF dy = 0 AND przebieranie = 0 AND alt = 0 THEN dreptanie: REM dzwiek chodzenia

REM ******************** czy jest wziatek
deltawx = ABS(x + 4 - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek

REM ************************************** operacja odswiezania tla
postaw:
REM punkt 1 zapamietanie nowego pola dzialania (brudnego)
REM w oparciu o nowe x,y

GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania

REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo

deltax = x - xs: deltay = y - ys
inversx = -1 * deltax: inversy = -1 * deltay
inver4 = INT(inversx / 4)
FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = (yt + inversy) * 6
FOR xt = 0 TO 3
index1 = 1 + (yt6 + 24) + (xt + inver4) + 1
index2 = 1 + yt4 + xt
poledzialania(index1) = pamiec(index2)
NEXT xt: NEXT yt

REM zmazanie serca z pola dzialania

IF liczsercaroom = 1 AND zrobione = 0 THEN
zrobione = 1
PUT (x - 4, y - 4), poledzialania, PSET
PUT (xserca, yserca), tlo, PSET
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
END IF

REM nowa mala pamiec

FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = yt * 6
FOR xt = 0 TO 3:
index1 = 1 + (yt6 + 24) + (xt + 1):
index2 = 1 + yt4 + xt:
pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt

REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU

REM aby nie rysowac dwoch postaci w przypadku skosu
IF skos = 1 THEN GOTO bezskosu:

REM ************************** ruch w dol lub gore

IF vert = 1 THEN wkleic = 7: GOTO wklej
bezskosu:
REM ************************** ruch w lewo

IF obrot = -1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1
IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 1: GOTO wklej
IF przebieranie = 1 THEN wkleic = 2: GOTO wklej
IF przebieranie = 2 THEN wkleic = 3: GOTO wklej
END IF

REM ****************** ruch w prawo

IF obrot = 1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1

IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 4: GOTO wklej
IF przebieranie = 1 THEN wkleic = 5: GOTO wklej
IF przebieranie = 2 THEN wkleic = 6: GOTO wklej
END IF

xs = x: ys = y

GOTO petla

wklej:

IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt
IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt
IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt
IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt
IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt
IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt
IF wkleic = 7 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)): NEXT xt: NEXT yt

REM wklejenie wyniku operacji na tablicy:
PUT (x - 4, y - 4), poledzialania, PSET

xs = x: ys = y
GOTO petla

REM GOSUB-RETURN****************************** obsluga wziatku

wziatek:
IF serca(roomx, roomy) = 0 THEN GOTO niemawziatku
IF liczsercaroom = 1 THEN GOTO niemawziatku
serca(roomx, roomy) = 0
liczserca = liczserca + 1
PUT (xserca, yserca), tlo, PSET

liczsercaroom = 1
dzwiekbrania = 1

LOCATE 1, 1: COLOR 6: PRINT liczserca;
niemawziatku:
RETURN

REM GOSUB-RETURN przejazd:
przejazd:

IF k$ = "1" THEN pietro = 1: roomy = pozycjewind(1)
IF k$ = "2" THEN pietro = 2: roomy = pozycjewind(2)
FOR i = 23 TO 0 STEP -1
LINE (xwindy + i, ywindy)-(xwindy + i, ywindy + 35), 255
FOR j = 1 TO 10000: NEXT j
NEXT i
CLS
FOR i = 1 TO 40000: NEXT i

RETURN

SUB animacja
REM ************************ znaczek - glowny bohater
REM ****************** DANE ANIMACJI
REM ten SUB jest do skasowania

END SUB

SUB cegly

BLOAD "bitmap1.scr"

REM INPUT a$
REM pobranie z ekranu tablic elementow
REM uwaga! wysokosc elementu to 9 lub 18 px

GET (0, 0)-(31, 8), ceg2
GET (0, 0)-(319, 8), ceg40
GET (0, 9)-(319, 17), ceg17plus17
GET (0, 18)-(319, 26), ceg13plus13
GET (0, 27)-(319, 35), ceg4plus20plus4
GET (0, 36)-(15, 53), szaretlo
GET (0, 36)-(31, 53), szaretlo2
GET (0, 36)-(63, 53), szaretlo4: REM 36+18=46+8=54

GET (16, 64)-(31, 79), palma
GET (32, 64)-(47, 81), blokp
GET (48, 64)-(63, 81), bloks
GET (64, 64)-(79, 81), blokk
GET (0, 156)-(31, 173), blok2
GET (0, 156)-(63, 173), blok4
GET (80, 64)-(111, 81), nieb

GET (0, 88)-(15, 119), znakl1
GET (16, 88)-(31, 119), znakp1
GET (32, 88)-(47, 119), znakl2
GET (48, 88)-(63, 119), znakp2
GET (64, 88)-(79, 119), znakl3
GET (80, 88)-(95, 119), znakp3
GET (96, 88)-(111, 119), vertd1

GET (0, 120)-(31, 139), window1
GET (32, 120)-(63, 139), window2
GET (64, 120)-(95, 139), window3
GET (0, 140)-(15, 155), wentylator
CLS
END SUB

SUB dreptanie

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)

REM ewentualnie:
REM OUT 66, 30: OUT 66, 0
REM OUT 66, 164: OUT 66, 2
REM OUT 66, 130: OUT 66, 1
REM OUT 66, 74: OUT 66, 0
REM OUT 66, 220: OUT 66, 1

FOR i = 1 TO 10
OUT 66, 30: OUT 66, 0
OUT 66, 84: OUT 66, 2
OUT 66, 30: OUT 66, 0
OUT 66, 94: OUT 66, 2
OUT 66, 10: OUT 66, 0
OUT 66, 40: OUT 66, 2
OUT 66, 84: OUT 66, 0
OUT 66, 10: 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 palety

REM palety kolorow *********************************
REM max koloru=3F

FOR i = 0 TO 255: kolor$(i) = "00 00 00 00"
PALETTE i, 31 + 31 * 256 + 31 * 65536: NEXT i

REM kolory za ludzikiem

kolor$(0) = "00 00 00 00": REM rejestr zero- wolny
kolor$(1) = "01 05 05 06": REM tlo plyta
kolor$(2) = "02 02 03 02": REM tlo fuga
kolor$(3) = "03 07 06 06": REM tlo krawedz
kolor$(4) = "04 00 22 00": REM liscie
kolor$(5) = "05 3F 08 00": REM serce
kolor$(6) = "06 30 30 30": REM framuga okna
kolor$(7) = "07 28 0A 00": REM doniczka drzewa
kolor$(8) = "08 00 21 39": REM niebo
kolor$(9) = "09 3F 3F 00": REM slonce
kolor$(10) = "0A 14 14 14": REM framuga zewnetrzna
kolor$(11) = "0B 00 00 00": REM wentylator faza 1
kolor$(12) = "0C 00 00 00": REM wentylator faza 2
kolor$(13) = "0D 00 00 00": REM wentylator faza 3
kolor$(14) = "0E 20 20 20": REM srednia szarosc
kolor$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza

REM rejestry przezroczyste gracza
kolor$(16) = "10 18 02 02": REM sweter + zero
kolor$(17) = "11 18 02 02": REM
kolor$(18) = "12 18 02 02": REM
kolor$(19) = "13 18 02 02": REM
kolor$(20) = "14 22 12 00": REM sweter + liscie
kolor$(21) = "15 3F 00 00": REM
kolor$(22) = "16 2F 09 09": REM sweter + framuga okna
kolor$(23) = "17 2B 08 00": REM sweter + doniczka drzewa
kolor$(24) = "18 25 16 24": REM sweter + niebo
kolor$(25) = "19 3F 3F 3F": REM sweter + slonce
kolor$(26) = "1A 16 0F 0F": REM sweter + framuga zew
kolor$(27) = "1B 3F 3F 3F": REM
kolor$(28) = "1C 3F 3F 3F": REM
kolor$(29) = "1D 3F 3F 3F": REM
kolor$(30) = "1E 20 10 10": REM sweter + przyciski
REM kolor 31 (1F) zastrzezony dla gracza
kolor$(32) = "20 0A 13 29": REM spodnie + zero
kolor$(33) = "21 0A 13 29": REM
kolor$(34) = "22 0A 13 29": REM
kolor$(35) = "23 0A 13 29": REM
kolor$(36) = "24 05 1D 24": REM spodnie+ liscie
kolor$(37) = "25 3F 3F 3F": REM
kolor$(38) = "26 1B 1B 32": REM spodnie + framuga okna
kolor$(39) = "27 1A 10 3F": REM spodnie + doniczka
kolor$(40) = "28 00 1A 3F": REM spodnie + niebo
kolor$(41) = "29 3F 3F 3F": REM spodnie +slonce
kolor$(42) = "2A 10 14 20": REM spodnie + framuga zew
kolor$(43) = "2B 3F 3F 3F": REM
kolor$(44) = "2C 3F 3F 3F": REM
kolor$(45) = "2D 3F 3F 3F": REM
kolor$(46) = "2E 3F 3F 3F": REM
REM rejestr 47 (2F) zastrzezony dla gracza

REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF)
REM rejestry nieprzezroczyste

kolor$(31) = "1F 2F 09 09": REM sweter
kolor$(47) = "2F 0D 1A 37": REM spodnie
kolor$(63) = "3F 1A 1A 1A": REM wlosy i buty
kolor$(79) = "4F 10 10 10": REM pasek2
kolor$(95) = "5F 3F 2F 0F":
kolor$(111) = "6F 3F 30 20": REM skora1
REM kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych
kolor$(143) = "8F 32 22 02": REM nos
REM kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych
REM kolor$(175) = "AF 22 02 02": REM sweter3
kolor$(191) = "BF 20 20 20": REM pasek
kolor$(207) = "CF 37 27 06": REM usta
REM FF- zarezerwowany dla przeslony

REM rejestry jednokierunkowe
kolor$(198) = "C6 20 20 20"
kolor$(199) = "C7 20 20 20"

REM bloczek

kolor$(224) = "E0 00 00 00": REM
kolor$(225) = "E1 04 04 04": REM
kolor$(226) = "E2 08 08 08": REM
kolor$(227) = "E3 0B 0B 0B": REM
kolor$(228) = "E4 10 10 10": REM
kolor$(229) = "E5 14 14 14": REM
kolor$(230) = "E6 18 18 18": REM
kolor$(231) = "E7 1B 1B 1B": REM
kolor$(232) = "E8 20 20 20": REM
kolor$(233) = "E9 24 24 24": REM
kolor$(234) = "EA 28 28 28": REM
kolor$(235) = "EB 2B 2B 2B": REM
kolor$(236) = "EC 30 30 30": REM
kolor$(237) = "ED 34 34 34": REM
kolor$(238) = "EE 38 38 38": REM
kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika

REM kolor 240 - przeslona
kolor$(240) = "F0 38 38 38"

REM cegly male niebieskie

kolor$(249) = "F9 22 27 30": REM krawedz
kolor$(250) = "FA 09 0E 14": REM fuga
kolor$(251) = "FB 11 17 1F": REM cegla

REM cegly male czerwone

kolor$(252) = "FC 30 27 27": REM krawedz
kolor$(253) = "FD 14 0E 0E": REM fuga
kolor$(254) = "FE 1F 17 17": REM cegla
kolor$(255) = "FF 28 28 28": REM przeslona

FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2)
red$ = "&H" + MID$(kolor$(i), 4, 2)
gre$ = "&H" + MID$(kolor$(i), 7, 2)
blu$ = "&H" + MID$(kolor$(i), 10, 2)
REM PRINT rej$; " "; red$; " "; gre$; " "; blu$
rej = VAL(rej$)
red = VAL(red$)
gre = VAL(gre$)
blu = VAL(blu$)
REM PRINT rej; " "; red; " "; gre; " "; blu

PALETTE rej, red + gre * 256 + blu * 65536
NEXT i

END SUB

SUB plansze

REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** roomy*16+roomx

REM kody plansz +++nr.po.ok.we.se_kw_dod
REM ************ plansze wiersza roomy=0

p$(0) = "h22233322d.0.UI.YO....GN________!"
p$(1) = "h000fff11h.1....MD....__________!"
p$(2) = "h11133333f.2.UI.HE....___EQ_____!"
p$(3) = "hh2223cchh.3..........SJ________!"
p$(4) = "h300033fff.4....ZK....__________!"
p$(5) = "h2001c333f.5....LG....______AQG_!"
p$(6) = "h111g3322f.6....LD....___EQ_F[Q_!"
p$(7) = "hh222dd11g.7.BE....DF.aH_WI_MdO_!"
p$(8) = "hhDDDfCCCg.8..........__________!"
p$(9) = "hhhhhf111c.9..........__________!"
p$(10) = "hhhhhf222g.A..........GG_EQ_____!"
p$(11) = "hh333f111d.B....HG....__________!"
p$(12) = "hhffff333g.C..........__________!"
p$(13) = "h22233333c.D.UN.aK.DF.MK____AYC_!"
p$(14) = "h111ff22hh.E..........___aG_BLM_!"
p$(15) = "h3333311cc.F....ZK....aH____AIG_!"

REM ************ plansze wiersza roomy=1

p$(16) = "d333c2223h.0.......FN.__________!"
p$(17) = "h33330003h.1.WH.SO....dE____COM_!"
p$(18) = "ff333111ff.2.WJ.ML....__________!"
p$(19) = "hc222c333c.3..........___QQ_____!"
p$(20) = "f31113333h.4.UM.aI.aO.__________!"
p$(21) = "f333aa333h.5..........RN_GQ_____!"
p$(22) = "ffff333fff.6....DJ....aM____G[M_!"
p$(23) = "gg333a33hh.7..........__________!"
p$(24) = "gg333333ff.8.AK....IF.__________!"
p$(25) = "cc3322333c.9.WM.......eF________!"
p$(26) = "gg331133hh.A....LF....aO________!"
p$(27) = "ddaa22cccc.B..........__________!"
p$(28) = "g33300333h.C.AM....aO.__________!"
p$(29) = "c33311333c.D.0M.......ZK____AQO_!"
p$(30) = "h3322233dd.E.BE....aF.__________!"
p$(31) = "c33111333h.F.AM.bD....___QQ_COH_!"

REM ************* plansze wiersza roomy=2

p$(32) = "h333ff333c.0..........KE_WQ_____!"
p$(33) = "h33332222c.1....KD....UP____CGI_!"
p$(34) = "faaaa0000h.2....WO.VI.__________!"
p$(35) = "ccccc1111f.3....MM....___EQ_____!"
p$(36) = "h33333223h.4.WI.FP....SM________!"
p$(37) = "haa33200af.5.UJ....GL.______HIE_!"
p$(38) = "f333c111ah.6....aM....UP________!"
p$(39) = "hh333d333g.7....YP....___KQ_____!"
p$(40) = "ff3333333g.8.#I.......KK____CGN_!"
p$(41) = "c33g33d33c.9..........__________!"
p$(42) = "hh3333333g.A.WM.LI....__________!"
p$(43) = "cc333322cc.B.UJ.......__________!"
p$(44) = "hhaacc00hh.C.BE....JG.ZM____AQM_!"
p$(45) = "c333cc11gg.D....aN....______AQM_!"
p$(46) = "dd33cc22hh.E..........______AQE_!"
p$(47) = "hh3331113c.F.UK....VI.___EQ_____!"

REM ************ plansze wiersza roomy=3

p$(48) = "c33332222f.0....ZM.ZD.SF____COI_!"
p$(49) = "ccccc1111h.1..........__________!"
p$(50) = "ha3222333c.2.#F.LO....UO_SQ_____!"
p$(51) = "ff3111333f.3.WM.YI.VI.SJ_GQ_____!"
p$(52) = "h3333c333f.4..........NG____CKK_!"
p$(53) = "ff333c222f.5....ZO....SG________!"
p$(54) = "hhaaff000f.6.BE.......___KQ_____!"
p$(55) = "gggg33111f.7....LO.VJ.______IYM_!"
p$(56) = "gg3322ffff.8..........GG________!"
p$(57) = "cccc00hfff.9..........__________!"
p$(58) = "gg33DDffff.A..........___KK_CCH_!"
p$(59) = "cccccfffff.B.......TL.__________!"
p$(60) = "hh3333333f.C....KK....DP________!"
p$(61) = "g333333hhh.D.UJ....TF.______CKK_!"
p$(62) = "hh3222333f.E..........___GQ_____!"
p$(63) = "c331113hhh.F....ZK....__________!"

REM ****************** plansze wiersza roomy=4

p$(64) = "f22322322h.0....DD....SP_YQ_CKK_!"
p$(65) = "h00f00f00h.1..........__________!"
p$(66) = "c11311311f.2....aP.KP.__________!"
p$(67) = "ff3332223h.3.UJ.ML....___YQ_____!"
p$(68) = "f3333111hh.4.WJ.YL....__________!"
p$(69) = "ffaafaaaff.5.......VI.__________!"
p$(70) = "ffa333c33h.6....OG....SQ_YQ_____!"
p$(71) = "ff223c33cd.7....SN....______MdM_!": REM startowa
p$(72) = "ff113cc33d.8..........MO____JVO_!"
p$(73) = "ff33cc33ff.9..........______COI_!"
p$(74) = "ff3333333d.A.WM.LI.ZP.PP________!"
p$(75) = "ff2233333f.B.UM.......___EQ_____!"
p$(76) = "ff11333hhh.C.......KH.__________!"
p$(77) = "h333333333.D.BE.SK....bF____CKK_!"
p$(78) = "ff22233hhh.E.UJ.......______FEE_!"
p$(79) = "h311133fff.F.WJ.......MM________!"

REM ******************* plansze wiersza roomy=5

p$(80) = "haf222faff.0.......VI.___KK_____!"
p$(81) = "hhf111222h.1..........SP____CKK_!"
p$(82) = "fa333c000h.2....GO....__________!"
p$(83) = "h222fa111f.3..........___YQ_____!"
p$(84) = "h111c2223h.4.0Q....EE.MM________!"
p$(85) = "ffffa111ff.5..........______GOE_!"
p$(86) = "h333c333af.6....DD....ZF_MQ_____!"
p$(87) = "dd333f333g.7.......VI.___aI_____!"
p$(88) = "dd3333333g.8.UN.KP....______COI_!"
p$(89) = "f32233f33f.9.......ED.KK________!"
p$(90) = "ddDDCC333h.A....ZK....KO________!"
p$(91) = "f33300f33f.B..........______COH_!"
p$(92) = "h33300333c.C....NN....__________!"
p$(93) = "333311333h.D.0M....TG.GG________!"
p$(94) = "h33222333c.E.AM.......__________!"
p$(95) = "ff3111333h.F.WM.FF....___YQ_____!"

REM ******************* plansze wiersza roomy=6

p$(96) = "fffa222hhh.0....EJ....___YM_____!"
p$(97) = "hhhf000bbb.1....SJ....ML____CMO_!"
p$(98) = "h222111hhh.2..........___KM_____!"
p$(99) = "f111aaafff.3....PH....ZJ________!"
p$(100) = "h222ahhhhh.4..........EE________!"
p$(101) = "f11133222h.5.0I.......___GQ_____!"
p$(102) = "ffffff000h.6....LO....__________!"
p$(103) = "gg333d111f.7....MO....aP________!"
p$(104) = "gg333hCCCh.8.......ZN.EG____HIE_!"
p$(105) = "ffffffDDDh.9..........__________!"
p$(106) = "hh333fCCCh.A.BE.......___KI_____!"
p$(107) = "ff3333111h.B.0I....KK.aP____CKK_!"
p$(108) = "cc22dd22ff.C..........__________!"
p$(109) = "hhDDffDDhh.D.......TJ.LN________!"
p$(110) = "ccc2222hhh.E..........__________!"
p$(111) = "hhhDDDDhhh.F..........TK_KM_____!"

REM ******************* plansze wiersza roomy=7

p$(112) = "hfaa222hhh.0..........______COJ_!"
p$(113) = "bbbb000hhh.1....KK....__________!"
p$(114) = "h222111fff.2.BJ.......ZE____AIK_!"
p$(115) = "f000aaahhh.3..........___KM_____!"
p$(116) = "h000ahhhhh.4.......KF.__________!"
p$(117) = "h111hh222h.5..........KQ________!"
p$(118) = "hfffff000f.6....KO....__________!"
p$(119) = "fffeee000h.7..........___KQ_____!"
p$(120) = "hh3333000h.8.BL.......______CKK_!"
p$(121) = "hCCCffDDDh.9..........KO________!"
p$(122) = "hDDDccCCCh.A..........___MK_____!"
p$(123) = "hf333300Df.B.AL.......__________!"
p$(124) = "ffffff00hh.C....KN....______IOI_!"
p$(125) = "hhhhhf00fh.D.......TK.__________!"
p$(126) = "h33c3300ff.E..........KK____COG_!"
p$(127) = "hhheefDDhh.F....KN....__________!"

REM ***************** n/8 plansze wiersza roomy=8

p$(128) = "hffa222hhh.0..........__________!"
p$(129) = "hbbb000hhh.1..........__________!"
p$(130) = "f222111fff.2..........__________!"
p$(131) = "h000aaahhh.3..........______COI_!"
p$(132) = "h000ahhhhh.4..........__________!"
p$(133) = "h111hh222h.5..........__________!"
p$(134) = "ffffff000f.6..........______DQK_!"
p$(135) = "hhhhha000h.7..........______ESK_!"
p$(136) = "hh3333000h.8..........______CKK_!"
p$(137) = "h33333111h.9..........__________!"
p$(138) = "h33333222h.A.BG.......__________!"
p$(139) = "ffCCff00ff.B..........______KaE_!"
p$(140) = "hfDDff00hh.C..........______JKM_!"
p$(141) = "hhhaac00fh.D..........__________!"
p$(142) = "f3333300ff.E..........______COL_!"
p$(143) = "hhheefDDhh.F..........__________!"

REM ***************** n/9 plansze wiersza roomy=9

p$(144) = "hffa222hhh.0..........__________!"
p$(145) = "hbbb000hhh.1..........__________!"
p$(146) = "f222111hhh.2..........__________!"
p$(147) = "h000aaahhh.3..........__________!"
p$(148) = "h000ahhhhh.4..........__________!"
p$(149) = "h111hh333h.5..........__________!"
p$(150) = "ffffaa222h.6..........__________!"
p$(151) = "hhaaaa000h.7..........__________!"
p$(152) = "hh3333000h.8..........__________!"
p$(153) = "h33333111h.9..........__________!"
p$(154) = "h33333222h.A..........__________!"
p$(155) = "ffCCff00Dh.B..........__________!"
p$(156) = "hfDDff00hh.C..........__________!"
p$(157) = "hhhaac00fh.D..........__________!"
p$(158) = "f3333300hh.E..........__________!"
p$(159) = "hhheefDDhh.F..........__________!"

REM tablica serc
FOR xr = 0 TO 15
FOR yr = 0 TO 9
s = xr + yr * 16
znak$ = MID$(p$(s), 23, 1)
IF znak$ <> "_" THEN serca(xr, yr) = 1
NEXT yr: NEXT xr

REM tablica wind
pozycjewind(1) = 0
pozycjewind(2) = 4

END SUB

SUB rysowanie

FOR yw = 0 TO 9
el$ = MID$(kod$, yw + 1, 1)
y16 = yw * 18

REM tymczasowe sygnalizacje bledow:

IF el$ = "Q" OR el$ = "L" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "P" OR el$ = "W" OR el$ = "=" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "A" OR el$ = "B" OR el$ = "U" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "@" THEN COLOR 15: LINE (0, y16)-(200, y16)

REM elementy uzupelniajace

IF el$ = "C" THEN
PUT (128, y16), szaretlo4, PSET: PUT (192, y16), szaretlo4, PSET
PUT (256, y16), szaretlo4, PSET
PUT (0, y16), blok4, PSET: PUT (64, y16), blok2, PSET:
PUT (96, y16), bloks, PSET: PUT (112, y16), blokk, PSET
END IF

IF el$ = "D" THEN
PUT (0, y16), szaretlo4, PSET: PUT (64, y16), szaretlo4, PSET
PUT (128, y16), szaretlo4, PSET
PUT (192, y16), blokp, PSET: PUT (208, y16), blok4, PSET
PUT (272, y16), blok2, PSET: PUT (304, y16), bloks, PSET
END IF

REM czesc automatyczna, znaki a-h
ascii = ASC(el$)

IF ascii > 96 THEN
bity = ascii - 97
PUT (0, y16), blok4, PSET:
pop1 = 0
pop2 = 0
pop3 = 0

IF (bity AND 4) = 4 THEN PUT (64, y16), blok4, PSET: pop1 = 1
IF (bity AND 4) = 0 THEN PUT (48, y16), blokk, PSET: PUT (64, y16), szaretlo4, PSET: pop1 = 0
REM
IF (bity AND 2) = 2 THEN pop2 = 1: PUT (128, y16), blok4, PSET: IF pop1 = 0 THEN PUT (128, y16), blokp, PSET
IF (bity AND 2) = 0 THEN pop2 = 0: PUT (128, y16), szaretlo4, PSET: IF pop1 = 1 THEN PUT (112, y16), blokk, PSET
REM
IF (bity AND 1) = 1 THEN pop3 = 1: PUT (192, y16), blok4, PSET: IF pop2 = 0 THEN PUT (192, y16), blokp, PSET
IF (bity AND 1) = 0 THEN pop3 = 0: PUT (192, y16), szaretlo4, PSET: IF pop2 = 1 THEN PUT (176, y16), blokk, PSET
PUT (256, y16), blok4, PSET
IF pop3 = 0 THEN PUT (256, y16), blokp, PSET
END IF

REM znaki 0-3

IF ascii < 58 THEN
bity = ascii - 48
IF (bity AND 2) = 2 THEN PUT (0, y16), blokk, PSET
IF (bity AND 2) = 0 THEN PUT (0, y16), szaretlo, PSET
PUT (16, y16), szaretlo4, PSET
PUT (80, y16), szaretlo4, PSET
PUT (144, y16), szaretlo4, PSET
PUT (208, y16), szaretlo4, PSET
PUT (272, y16), szaretlo2, PSET

IF (bity AND 1) = 1 THEN PUT (304, y16), blokp, PSET
IF (bity AND 1) = 0 THEN PUT (304, y16), szaretlo, PSET
END IF

NEXT yw

REM rysowanie podestow

el$ = MID$(kod$, 14, 1)
IF el$ = "" OR el$ = "." THEN GOTO dodatek

el2$ = MID$(kod$, 15, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "#" THEN PUT (0, yo), ceg40, PSET
IF el$ = "W" THEN PUT (0, yo), ceg4plus20plus4, PSET
IF el$ = "U" THEN PUT (0, yo), ceg17plus17, PSET
IF el$ = "0" THEN PUT (0, yo), ceg13plus13, PSET
IF el$ = "A" THEN FOR xx = 0 TO 4: PUT (16 + xx * 64, yo), ceg2, PSET: NEXT xx
IF el$ = "B" THEN FOR xx = 0 TO 5: PUT (64 + xx * 32, yo), ceg2, PSET: NEXT xx

REM dodatkowy element
dodatek:

el$ = MID$(kod$, 29, 1)
IF el$ = "" OR el$ = "_" THEN GOTO okna
el2$ = MID$(kod$, 30, 1)
xo = (ASC(el2$) - 65) * 8
el2$ = MID$(kod$, 31, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "A" THEN
PUT (xo, yo), blokp, PSET:
PUT (xo, yo + 18), blokp, PSET
PUT (xo + 16, yo), blok2, PSET:
PUT (xo + 16, yo + 18), blok2, PSET
PUT (xo + 48, yo), blokk, PSET:
PUT (xo + 48, yo + 18), blokk, PSET
END IF

IF el$ = "B" THEN COLOR 235: LINE (xo + 5, yo)-(xo + 9, yo + 35), , BF
IF el$ = "C" THEN PUT (xo, yo), ceg2, PSET: PUT (xo + 32, yo), ceg2, PSET: PUT (xo + 64, yo), ceg2, PSET
IF el$ = "D" THEN LINE (xo, yo)-(xo + 22, yo + 17), 235, BF: LINE (xo + 42, yo)-(xo + 63, yo + 17), 235, BF
IF el$ = "E" THEN LINE (xo, yo)-(xo + 5, yo + 35), 235, BF: LINE (xo + 26, yo + 36)-(xo + 31, yo + 72), 235, BF
REM niebieskie klocki
IF el$ = "F" THEN PUT (xo, yo), nieb, PSET
IF el$ = "G" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo), nieb, PSET
IF el$ = "H" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo + 36), nieb, PSET
IF el$ = "I" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo - 36), nieb, PSET
REM jednokierunkowe bramki
IF el$ = "J" THEN PSET (xo - 2, yo), 199: DRAW "R18 D35 L18 U35 F18 U1 G18"
IF el$ = "K" THEN PSET (xo - 2, yo), 198: DRAW "R18 D35 L18 U35 R18 G18 U1 F18"
REM zaslonka
IF el$ = "L" THEN LINE (xo, yo)-(xo + 15, yo + 35), 255, BF
REM winda
xwindy = -10: ywindy = -10
IF el$ = "M" THEN
LINE (xo, yo)-(xo + 23, yo + 35), 10, BF
LINE (xo, yo)-(xo, yo + 36), 6, BF
LINE (xo, yo)-(xo + 23, yo), 6, BF
LINE (xo + 3, yo + 7)-(xo + 5, yo + 18), 14, BF
LINE (xo + 1, yo)-(xo + 23, yo), 9
REM LINE (xo + 20, yo + 1)-(xo + 22, yo + 1), 9
PSET (xo + 4, yo + 9), 12
PSET (xo + 4, yo + 11), 5
PSET (xo + 4, yo + 13), 5
PSET (xo + 4, yo + 15), 5
PSET (xo + 4, yo + 17), 5
xwindy = xo: ywindy = yo: winda = 1
END IF

okna:

REM rysowanie okien

el$ = MID$(kod$, 17, 1)
IF el$ = "" OR el$ = "." THEN GOTO serce
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 18, 1)
yo = (ASC(el$) - 65) * 9
IF roomy < 2 THEN PUT (xo, yo), window2, PSET
IF roomy > 1 AND roomy < 5 THEN PUT (xo, yo), window1, PSET
IF roomy > 4 THEN PUT (xo, yo), window3, PSET

serce:
REM serce
xserca = -20
yserca = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 23, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xserca = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 24, 1)
yserca = (ASC(el$) - 65) * 9
GET (xserca, yserca)-(xserca + 15, yserca + 7), tlo
COLOR 5
LINE (xserca, yserca + 1)-(xserca, yserca + 3)
LINE (xserca + 1, yserca)-(xserca + 1, yserca + 4)
LINE (xserca + 2, yserca)-(xserca + 2, yserca + 5)
LINE (xserca + 3, yserca + 1)-(xserca + 3, yserca + 6)
LINE (xserca + 4, yserca)-(xserca + 4, yserca + 5)
LINE (xserca + 5, yserca)-(xserca + 5, yserca + 4)
LINE (xserca + 6, yserca + 1)-(xserca + 6, yserca + 3)

donica:
el$ = MID$(kod$, 26, 1)
IF el$ = "" OR el$ = "_" THEN GOTO wentyl
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 27, 1)
yo = (ASC(el$) - 65) * 9 + 2
PUT (xo, yo), palma, PSET

wentyl:
el$ = MID$(kod$, 20, 1)
IF el$ = "" OR el$ = "." THEN GOTO koniecrysowania
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 21, 1)
yo = (ASC(el$) - 65) * 9
PUT (xo, yo), wentylator, PSET

koniecrysowania:

LOCATE 24, 2: COLOR 15: PRINT "Czas:"; licz;

END SUB

SUB zabranie
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)

OUT 66, 32: OUT 66, 3
FOR i = 1 TO 6000: NEXT i

OUT 66, 204: OUT 66, 4
FOR i = 1 TO 6000: NEXT i

t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port

END SUB

Piotr-246 · Gość

DECLARE SUB zabranie ()

REM Gra "Serca" UWAGA wersaj gry wymaga
REM emulatora o predkosci 6075 cyklow
REM wymaga pliku bitmap1.scr utworzonego przez modul bsave.bas

DECLARE SUB dreptanie ()
DECLARE SUB animacja ()
DECLARE SUB rysowanie ()
DECLARE SUB palety ()
DECLARE SUB plansze ()
DECLARE SUB cegly ()

REM plansza startowa:
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
roomx = 7: roomy = 4

DIM SHARED kolor$(0 TO 255)
DIM pamiec(0 TO 128) AS LONG
DIM poledzialania(0 TO 240) AS LONG
DIM SHARED pozycjewind(1 TO 2) AS INTEGER
DIM SHARED p$(0 TO 159)
DIM SHARED kod$
DIM SHARED serca(0 TO 15, 0 TO 9) AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED xwindy AS INTEGER, ywindy AS INTEGER
DIM SHARED winda AS INTEGER

REM pamiec tla pod wziatek

DIM SHARED tlo(0 TO 32) AS LONG

REM tlo

DIM SHARED szaretlo(0 TO 74) AS LONG
DIM SHARED szaretlo2(0 TO 148) AS LONG
DIM SHARED szaretlo4(0 TO 300) AS LONG
REM dane elementow planszy

DIM SHARED ceg2(0 TO 75) AS LONG
DIM SHARED ceg40(0 TO 730) AS LONG
DIM SHARED ceg17plus17(0 TO 730) AS LONG
DIM SHARED ceg13plus13(0 TO 760) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 750) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED nieb(0 TO 145) AS LONG

DIM SHARED blokp(0 TO 74) AS LONG
DIM SHARED bloks(0 TO 74) AS LONG
DIM SHARED blokk(0 TO 74) AS LONG
DIM SHARED blok2(0 TO 158) AS LONG
DIM SHARED blok4(0 TO 296) AS LONG

REM ****************** DANE ANIMACJI

DIM SHARED znakp1(0 TO 128) AS LONG
DIM SHARED znakl1(0 TO 128) AS LONG
DIM SHARED znakp2(0 TO 128) AS LONG
DIM SHARED znakl2(0 TO 128) AS LONG
DIM SHARED znakp3(0 TO 128) AS LONG
DIM SHARED znakl3(0 TO 128) AS LONG
DIM SHARED vertd1(0 TO 128) AS LONG

REM matryce okien

DIM SHARED window1(0 TO 160) AS LONG
DIM SHARED window2(0 TO 160) AS LONG
DIM SHARED window3(0 TO 160) AS LONG

DIM SHARED wentylator(0 TO 64) AS LONG

REM ************************* DANE STARTOWE

SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci

x = 200: y = 35: xs = 200: ys = 35: REM wspol. pocz. gracza na ekr.
licz = -1: REM wartosc start. zegara
winda = 0
kolwent = 30 + 30 * 256 + 30 * 65536: REM kolor lopat wentylatora

REM ***** SUB palety - ustawienie nowych wartosci barw
palety

REM ***** SUB cegly - zapelnienie pozostalych tablic
cegly

REM SUB plansze - wypelnienie tablicy wygladu plansz
plansze

REM ************************* WYBOR POMIESZCZENIA

rysuj:

kod$ = p$(roomx + roomy * 16)

REM ******************** rysowanie pomieszczenia
t0 = PEEK(1132): REM pomiar czasu rysowania

winda = 0
REM SUB rysowanie - rysowanie planszy
rysowanie
IF winda = 1 THEN y = ywindy + 3: ys = ywindy + 3
REM pomiar czasu rysowania
t1 = PEEK(1132):

REM menu na dole
COLOR 235
REM LOCATE 23, 1: FOR i = 1 TO 40: PRINT CHR$(223); : NEXT i
LOCATE 25, 15: PRINT "L-SHIFT ALT P-SHIFT";

LOCATE 24, 2: COLOR 3: PRINT "T:"; t0; "/"; t1; FRE(-2);
PRINT " ROOM:"; roomx; "/"; roomy; "--";

REM **************** zapamietanie pola pod graczem
GET (x, y)-(x + 15, y + 31), pamiec
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
REM PUT (x, y), vertd1, PSET
liczsercaroom = 0: zrobione = 0
GOTO postaw
REM *************************** PETLA GLOWNA

petla:
dx = 0: dy = 0
IF dzwiekbrania = 1 THEN dzwiekbrania = 0: zabranie

REM ******************* czas gry w sekundach

se$ = MID$(TIME$, 7, 2)
se = VAL(se$)
IF se <> ses THEN licz = licz + 1
ses = se
LOCATE 25, 2: COLOR 15: PRINT "Czas:"; licz;

REM ************************ petla opozniajaca
FOR delay = 1 TO 700: NEXT delay

REM faza wentylatora

komorka = PEEK(1132) / 1.5
faz = INT(komorka)
IF faz / 3 = INT(faz / 3) THEN faza = 0
IF (faz + 1) / 3 = INT((faz + 1) / 3) THEN faza = 1
IF (faz + 2) / 3 = INT((faz + 2) / 3) THEN faza = 2
FOR i = 0 TO 2: i16 = i * 16
IF faza = 0 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, 0
IF faza = 1 THEN PALETTE 11 + i16, 0: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, kolwent
IF faza = 2 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, 0: PALETTE 13 + i16, kolwent
NEXT i

REM ************************ sprawdzenie klawiszy

alt = 0: lshift = 0: pshift = 0: skos = 0

k$ = INKEY$
IF k$ = "f" THEN roomx = roomx - 1: GOTO rysuj
IF k$ = "h" THEN roomx = roomx + 1: GOTO rysuj
IF k$ = "t" THEN roomy = roomy - 1: GOTO rysuj
IF k$ = "b" THEN roomy = roomy + 1: GOTO rysuj
IF k$ = CHR$(27) THEN END
IF k$ = "1" AND x >= xwindy AND y - ywindy < 10 THEN GOSUB przejazd: GOTO rysuj
IF k$ = "2" AND x >= xwindy AND y - ywindy < 10 THEN GOSUB przejazd: GOTO rysuj

REM klawisz alt - wznoszenie sie
IF (PEEK(1047) AND 8) = 8 THEN alt = 1
IF (PEEK(1047) AND 2) = 2 THEN lshift = 1
IF (PEEK(1047) AND 1) = 1 THEN pshift = 1

REM bezruch = grawitacja
IF lshift = 0 AND pshift = 0 AND alt = 0 THEN dy = 2: vert = 1: obrot = 0: przebiervert = 0: GOTO czy

POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury

IF lshift = 1 THEN dx = -4: dy = 2: obrot = -1: vert = 0
IF pshift = 1 THEN dx = 4: dy = 2: obrot = 1: vert = 0
IF alt = 1 THEN dy = -4: vert = 1
IF dx <> 0 AND dy <> 0 THEN skos = 1
czy:

REM ************ sprawdzenie czy jest przejscie do innej planszy

IF x + dx > 300 THEN x = 5: xs = 5: roomx = roomx + 1: GOTO rysuj
IF x + dx < 3 THEN x = 300: xs = 300: roomx = roomx - 1: GOTO rysuj
IF y + dy > 144 THEN y = 5: ys = 5: roomy = roomy + 1: GOTO rysuj
IF y + dy < 4 THEN y = 145: ys = 145: roomy = roomy - 1: GOTO rysuj

REM *********** sprawdzenie czy ruch jest mozliwy
REM sprawdzenie przeszkody. Przeszkoda sa kolory > 200

xmozliwy = 0: xniemozliwy = 0
ymozliwy = 0: yniemozliwy = 0

REM sprawdzenie sasiedztwa obok

IF dx > 0 THEN
FOR i = 0 TO 31: punkt = POINT(x + 19, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 198 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF

IF dx < 0 THEN
FOR i = 0 TO 31: punkt = POINT(x - 3, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 199 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF xniemozliwy = 0 THEN xmozliwy = 1
IF xniemozliwy = 1 THEN xmozliwy = 0

REM sprawdzenie sasiedztwa gora dol

IF dy > 0 THEN
FOR i = 0 TO 15:
IF POINT(x + i, y + 32) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y + 33) > 200 THEN yniemozliwy = 1: EXIT FOR

NEXT i
END IF

IF dy < 0 THEN
FOR i = 0 TO 15
IF POINT(x + i, y - 4) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y - 5) > 200 THEN yniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF yniemozliwy = 0 THEN ymozliwy = 1
IF yniemozliwy = 1 THEN ymozliwy = 0

REM ruch gdy oba mozliwe x oraz y
IF ymozliwy = 1 AND xmozliwy = 1 THEN IF dx <> 0 OR dy <> 0 THEN GOTO ruch

REM szczegolne przypadki gdy tylko x albo y mozliwy
IF ymozliwy = 0 AND xmozliwy = 1 THEN dy = 0: GOTO czy
IF ymozliwy = 1 AND xmozliwy = 0 THEN dx = 0: GOTO czy

REM ruch niemozliwy powrot petli glownej bez zmian pozostaja x y

x = xs: y = ys
GOTO petla

REM ***************** RUCH

ruch:

x = x + dx: y = y + dy
IF dy = 0 AND przebieranie = 0 AND alt = 0 THEN dreptanie: REM dzwiek chodzenia

REM ******************** czy jest wziatek
deltawx = ABS(x + 4 - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek

REM ************************************** operacja odswiezania tla
postaw:
REM punkt 1 zapamietanie nowego pola dzialania (brudnego)
REM w oparciu o nowe x,y

GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania

REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo

deltax = x - xs: deltay = y - ys
inversx = -1 * deltax: inversy = -1 * deltay
inver4 = INT(inversx / 4)
FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = (yt + inversy) * 6
FOR xt = 0 TO 3
index1 = 1 + (yt6 + 24) + (xt + inver4) + 1
index2 = 1 + yt4 + xt
poledzialania(index1) = pamiec(index2)
NEXT xt: NEXT yt

REM zmazanie serca z pola dzialania

IF liczsercaroom = 1 AND zrobione = 0 THEN
zrobione = 1
PUT (x - 4, y - 4), poledzialania, PSET
PUT (xserca, yserca), tlo, PSET
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
END IF

REM nowa mala pamiec

FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = yt * 6
FOR xt = 0 TO 3:
index1 = 1 + (yt6 + 24) + (xt + 1):
index2 = 1 + yt4 + xt:
pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt

REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU

REM aby nie rysowac dwoch postaci w przypadku skosu
IF skos = 1 THEN GOTO bezskosu:

REM ************************** ruch w dol lub gore

IF vert = 1 THEN wkleic = 7: GOTO wklej
bezskosu:
REM ************************** ruch w lewo

IF obrot = -1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1
IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 1: GOTO wklej
IF przebieranie = 1 THEN wkleic = 2: GOTO wklej
IF przebieranie = 2 THEN wkleic = 3: GOTO wklej
END IF

REM ****************** ruch w prawo

IF obrot = 1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1

IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 4: GOTO wklej
IF przebieranie = 1 THEN wkleic = 5: GOTO wklej
IF przebieranie = 2 THEN wkleic = 6: GOTO wklej
END IF

xs = x: ys = y

GOTO petla

wklej:

IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt
IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt
IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt
IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt
IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt
IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt
IF wkleic = 7 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)): NEXT xt: NEXT yt

REM wklejenie wyniku operacji na tablicy:
PUT (x - 4, y - 4), poledzialania, PSET

xs = x: ys = y
GOTO petla

REM GOSUB-RETURN****************************** obsluga wziatku

wziatek:
IF serca(roomx, roomy) = 0 THEN GOTO niemawziatku
IF liczsercaroom = 1 THEN GOTO niemawziatku
serca(roomx, roomy) = 0
liczserca = liczserca + 1
PUT (xserca, yserca), tlo, PSET

liczsercaroom = 1
dzwiekbrania = 1

LOCATE 1, 1: COLOR 6: PRINT liczserca;
niemawziatku:
RETURN

REM GOSUB-RETURN przejazd:
przejazd:

IF k$ = "1" THEN pietro = 1: roomy = pozycjewind(1)
IF k$ = "2" THEN pietro = 2: roomy = pozycjewind(2)
FOR i = 23 TO 0 STEP -1
LINE (xwindy + i, ywindy)-(xwindy + i, ywindy + 35), 255
FOR j = 1 TO 10000: NEXT j
NEXT i
CLS
FOR i = 1 TO 40000: NEXT i

RETURN

SUB cegly

BLOAD "bitmap1.scr"

REM INPUT a$
REM pobranie z ekranu tablic elementow
REM uwaga! wysokosc elementu to 9 lub 18 px

GET (0, 0)-(31, 8), ceg2
GET (0, 0)-(319, 8), ceg40
GET (0, 9)-(319, 17), ceg17plus17
GET (0, 18)-(319, 26), ceg13plus13
GET (0, 27)-(319, 35), ceg4plus20plus4
GET (0, 36)-(15, 53), szaretlo
GET (0, 36)-(31, 53), szaretlo2
GET (0, 36)-(63, 53), szaretlo4: REM 36+18=46+8=54

GET (16, 64)-(31, 79), palma
GET (32, 64)-(47, 81), blokp
GET (48, 64)-(63, 81), bloks
GET (64, 64)-(79, 81), blokk
GET (0, 156)-(31, 173), blok2
GET (0, 156)-(63, 173), blok4
GET (80, 64)-(111, 81), nieb

GET (0, 88)-(15, 119), znakl1
GET (16, 88)-(31, 119), znakp1
GET (32, 88)-(47, 119), znakl2
GET (48, 88)-(63, 119), znakp2
GET (64, 88)-(79, 119), znakl3
GET (80, 88)-(95, 119), znakp3
GET (96, 88)-(111, 119), vertd1

GET (0, 120)-(31, 139), window1
GET (32, 120)-(63, 139), window2
GET (64, 120)-(95, 139), window3
GET (0, 140)-(15, 155), wentylator
CLS
END SUB

SUB dreptanie

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)

REM ewentualnie:
REM OUT 66, 30: OUT 66, 0
REM OUT 66, 164: OUT 66, 2
REM OUT 66, 130: OUT 66, 1
REM OUT 66, 74: OUT 66, 0
REM OUT 66, 220: OUT 66, 1

FOR i = 1 TO 10
OUT 66, 30: OUT 66, 0
OUT 66, 84: OUT 66, 2
OUT 66, 30: OUT 66, 0
OUT 66, 94: OUT 66, 2
OUT 66, 10: OUT 66, 0
OUT 66, 40: OUT 66, 2
OUT 66, 84: OUT 66, 0
OUT 66, 10: 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 palety

REM palety kolorow *********************************
REM max koloru=3F

FOR i = 0 TO 255: kolor$(i) = "00 00 00 00"
PALETTE i, 31 + 31 * 256 + 31 * 65536: NEXT i

REM kolory za ludzikiem

kolor$(0) = "00 00 00 00": REM rejestr zero- wolny
kolor$(1) = "01 05 05 06": REM tlo plyta
kolor$(2) = "02 02 03 02": REM tlo fuga
kolor$(3) = "03 07 06 06": REM tlo krawedz
kolor$(4) = "04 00 22 00": REM liscie
kolor$(5) = "05 3F 08 00": REM serce
kolor$(6) = "06 30 30 30": REM framuga okna
kolor$(7) = "07 28 0A 00": REM doniczka drzewa
kolor$(8) = "08 00 21 39": REM niebo
kolor$(9) = "09 3F 3F 00": REM slonce
kolor$(10) = "0A 14 14 14": REM framuga zewnetrzna
kolor$(11) = "0B 00 00 00": REM wentylator faza 1
kolor$(12) = "0C 00 00 00": REM wentylator faza 2
kolor$(13) = "0D 00 00 00": REM wentylator faza 3
kolor$(14) = "0E 20 20 20": REM srednia szarosc
kolor$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza

REM rejestry przezroczyste gracza
kolor$(16) = "10 18 02 02": REM sweter + zero
kolor$(17) = "11 18 02 02": REM
kolor$(18) = "12 18 02 02": REM
kolor$(19) = "13 18 02 02": REM
kolor$(20) = "14 22 12 00": REM sweter + liscie
kolor$(21) = "15 3F 00 00": REM
kolor$(22) = "16 2F 09 09": REM sweter + framuga okna
kolor$(23) = "17 2B 08 00": REM sweter + doniczka drzewa
kolor$(24) = "18 25 16 24": REM sweter + niebo
kolor$(25) = "19 3F 3F 3F": REM sweter + slonce
kolor$(26) = "1A 16 0F 0F": REM sweter + framuga zew
kolor$(27) = "1B 3F 3F 3F": REM
kolor$(28) = "1C 3F 3F 3F": REM
kolor$(29) = "1D 3F 3F 3F": REM
kolor$(30) = "1E 20 10 10": REM sweter + przyciski
REM kolor 31 (1F) zastrzezony dla gracza
kolor$(32) = "20 0A 13 29": REM spodnie + zero
kolor$(33) = "21 0A 13 29": REM
kolor$(34) = "22 0A 13 29": REM
kolor$(35) = "23 0A 13 29": REM
kolor$(36) = "24 05 1D 24": REM spodnie+ liscie
kolor$(37) = "25 3F 3F 3F": REM
kolor$(38) = "26 1B 1B 32": REM spodnie + framuga okna
kolor$(39) = "27 1A 10 3F": REM spodnie + doniczka
kolor$(40) = "28 00 1A 3F": REM spodnie + niebo
kolor$(41) = "29 3F 3F 3F": REM spodnie +slonce
kolor$(42) = "2A 10 14 20": REM spodnie + framuga zew
kolor$(43) = "2B 3F 3F 3F": REM
kolor$(44) = "2C 3F 3F 3F": REM
kolor$(45) = "2D 3F 3F 3F": REM
kolor$(46) = "2E 3F 3F 3F": REM
REM rejestr 47 (2F) zastrzezony dla gracza

REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF)
REM rejestry nieprzezroczyste

kolor$(31) = "1F 2F 09 09": REM sweter
kolor$(47) = "2F 0D 1A 37": REM spodnie
kolor$(63) = "3F 1A 1A 1A": REM wlosy i buty
kolor$(79) = "4F 10 10 10": REM pasek2
kolor$(95) = "5F 3F 2F 0F":
kolor$(111) = "6F 3F 30 20": REM skora1
REM kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych
kolor$(143) = "8F 32 22 02": REM nos
REM kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych
REM kolor$(175) = "AF 22 02 02": REM sweter3
kolor$(191) = "BF 20 20 20": REM pasek
kolor$(207) = "CF 37 27 06": REM usta
REM FF- zarezerwowany dla przeslony

REM rejestry jednokierunkowe
kolor$(198) = "C6 20 20 20"
kolor$(199) = "C7 20 20 20"

REM bloczek

kolor$(224) = "E0 00 00 00": REM
kolor$(225) = "E1 04 04 04": REM
kolor$(226) = "E2 08 08 08": REM
kolor$(227) = "E3 0B 0B 0B": REM
kolor$(228) = "E4 10 10 10": REM
kolor$(229) = "E5 14 14 14": REM
kolor$(230) = "E6 18 18 18": REM
kolor$(231) = "E7 1B 1B 1B": REM
kolor$(232) = "E8 20 20 20": REM
kolor$(233) = "E9 24 24 24": REM
kolor$(234) = "EA 28 28 28": REM
kolor$(235) = "EB 2B 2B 2B": REM
kolor$(236) = "EC 30 30 30": REM
kolor$(237) = "ED 34 34 34": REM
kolor$(238) = "EE 38 38 38": REM
kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika

REM kolor 240 - przeslona
kolor$(240) = "F0 38 38 38"

REM cegly male niebieskie

kolor$(249) = "F9 22 27 30": REM krawedz
kolor$(250) = "FA 09 0E 14": REM fuga
kolor$(251) = "FB 11 17 1F": REM cegla

REM cegly male czerwone

kolor$(252) = "FC 30 27 27": REM krawedz
kolor$(253) = "FD 14 0E 0E": REM fuga
kolor$(254) = "FE 1F 17 17": REM cegla
kolor$(255) = "FF 28 28 28": REM przeslona

FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2)
red$ = "&H" + MID$(kolor$(i), 4, 2)
gre$ = "&H" + MID$(kolor$(i), 7, 2)
blu$ = "&H" + MID$(kolor$(i), 10, 2)
REM PRINT rej$; " "; red$; " "; gre$; " "; blu$
rej = VAL(rej$)
red = VAL(red$)
gre = VAL(gre$)
blu = VAL(blu$)
REM PRINT rej; " "; red; " "; gre; " "; blu

PALETTE rej, red + gre * 256 + blu * 65536
NEXT i

END SUB

SUB plansze

REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** roomy*16+roomx

REM kody plansz +++nr.po.ok.we.se_kw_dod
REM ************ plansze wiersza roomy=0

p$(0) = "h22233322d.0.UI.YO....GN________!"
p$(1) = "h000fff11h.1....MD....__________!"
p$(2) = "h11133333f.2.UI.HE....___EQ_____!"
p$(3) = "hh2223cchh.3..........SJ________!"
p$(4) = "h300033fff.4....ZK....__________!"
p$(5) = "h2001c333f.5....LG....______AQG_!"
p$(6) = "h111g3322f.6....LD....___EQ_F[Q_!"
p$(7) = "hh222ff11d.7.BE....DF.aH_ZI_MdO_!"
p$(8) = "hhDDDfCCCg.8..........__________!"
p$(9) = "hhhhhf111c.9..........__________!"
p$(10) = "hhhhhf222g.A..........GG_EQ_____!"
p$(11) = "hh333f111d.B....HG....__________!"
p$(12) = "hhffff333g.C..........__________!"
p$(13) = "h22233333c.D.UN.aK.DF.MK____AYC_!"
p$(14) = "h111ff22hh.E..........___aG_BLM_!"
p$(15) = "h3333311cc.F....ZK....aH____AIG_!"

REM ************ plansze wiersza roomy=1

p$(16) = "d333c2223h.0.......FN.__________!"
p$(17) = "h33330003h.1.WH.SO....dE____COM_!"
p$(18) = "ff333111ff.2.WJ.ML....__________!"
p$(19) = "hc222c333c.3..........___QQ_____!"
p$(20) = "f31113333h.4.UM.aI.aO.__________!"
p$(21) = "f333aa333h.5..........RN_GQ_____!"
p$(22) = "ffff333fff.6....DJ....aM____G[M_!"
p$(23) = "dd333a33hh.7..........__________!"
p$(24) = "gg333333ff.8.AK....IF.__________!"
p$(25) = "cc3322333c.9.WM.......eF________!"
p$(26) = "gg331133hh.A....LF....aO________!"
p$(27) = "ddaa22cccc.B..........__________!"
p$(28) = "g33300333h.C.AM....aO.__________!"
p$(29) = "c33311333c.D.0M.......ZK____AQO_!"
p$(30) = "h3322233dd.E.BE....aF.__________!"
p$(31) = "c33111333h.F.AM.bD....___QQ_COH_!"

REM ************* plansze wiersza roomy=2

p$(32) = "h333ff333c.0..........KE_WQ_____!"
p$(33) = "h33332222c.1....KD....UP____CGI_!"
p$(34) = "faaaa0000h.2....WO.VI.__________!"
p$(35) = "ccccc1111f.3....MM....___EQ_____!"
p$(36) = "h33333223h.4.WI.FP....SM________!"
p$(37) = "haa33200af.5.UJ....GL.______HIE_!"
p$(38) = "f333c111ah.6....aM....UP________!"
p$(39) = "hh333d333g.7....YP....___KQ_____!"
p$(40) = "ff3333333g.8.#I.......KK____CGN_!"
p$(41) = "c33g33d33c.9..........__________!"
p$(42) = "hh3333333g.A.WM.LI....__________!"
p$(43) = "cc333322cc.B.UJ.......__________!"
p$(44) = "hhaacc00hh.C.BE....JG.ZM____AQM_!"
p$(45) = "c333cc11gg.D....aN....______AQM_!"
p$(46) = "dd33cc22hh.E..........______AQE_!"
p$(47) = "hh3331113c.F.UK....VI.___EQ_____!"

REM ************ plansze wiersza roomy=3

p$(48) = "c33332222f.0....ZM.ZD.SF____COI_!"
p$(49) = "ccccc1111h.1..........__________!"
p$(50) = "ha3222333c.2.#F.LO....UO_SQ_____!"
p$(51) = "ff3111333f.3.WM.YI.VI.SJ_GQ_____!"
p$(52) = "h3333c333f.4..........NG____CKK_!"
p$(53) = "ff333c222f.5....ZO....SG________!"
p$(54) = "hhaaff000f.6.BE.......___KQ_____!"
p$(55) = "gggg33111f.7....LO.VJ.______IYM_!"
p$(56) = "gg3322ffff.8..........GG________!"
p$(57) = "cccc00hfff.9..........__________!"
p$(58) = "gg33DDffff.A..........___KK_CCH_!"
p$(59) = "cccccfffff.B.......TL.__________!"
p$(60) = "hh3333333f.C....KK....DP________!"
p$(61) = "g333333hhh.D.UJ....TF.______CKK_!"
p$(62) = "hh3222333f.E..........___GQ_____!"
p$(63) = "c331113hhh.F....ZK....__________!"

REM ****************** plansze wiersza roomy=4

p$(64) = "f22322322h.0....DD....SP_YQ_CKK_!"
p$(65) = "h00f00f00h.1..........__________!"
p$(66) = "c11311311f.2....aP.KP.__________!"
p$(67) = "ff3332223h.3.UJ.ML....___YQ_____!"
p$(68) = "f3333111hh.4.WJ.YL....__________!"
p$(69) = "ffaafaaaff.5.......VI.__________!"
p$(70) = "ffa333c33h.6....OG....SQ_YQ_____!"
p$(71) = "ff223c33cd.7....SN.DF.GN_TI_MdM_!": REM startowa
p$(72) = "ff113cc33d.8..........MO____JVO_!"
p$(73) = "ff33cc33ff.9..........______COI_!"
p$(74) = "ff3333333d.A.WM.LI.ZP.PP________!"
p$(75) = "ff2233333f.B.UM.......___EQ_____!"
p$(76) = "ff11333hhh.C.......KH.__________!"
p$(77) = "h333333333.D.BE.SK....bF____CKK_!"
p$(78) = "ff22233hhh.E.UJ.......______FEE_!"
p$(79) = "h311133fff.F.WJ.......MM________!"

REM ******************* plansze wiersza roomy=5

p$(80) = "haf222faff.0.......VI.___KK_____!"
p$(81) = "hhf111222h.1..........SP____CKK_!"
p$(82) = "fa333c000h.2....GO....__________!"
p$(83) = "h222fa111f.3..........___YQ_____!"
p$(84) = "h111c2223h.4.0Q....EE.MM________!"
p$(85) = "ffffa111ff.5..........______GOE_!"
p$(86) = "h333c333af.6....DD....ZF_MQ_____!"
p$(87) = "dd333f333g.7.......VI.___aI_____!"
p$(88) = "dd3333333g.8.UN.KP....______COI_!"
p$(89) = "f32233f33f.9.......ED.KK________!"
p$(90) = "ddDDCC333h.A....ZK....KO________!"
p$(91) = "f33300f33f.B..........______COH_!"
p$(92) = "h33300333c.C....NN....__________!"
p$(93) = "333311333h.D.0M....TG.GG________!"
p$(94) = "h33222333c.E.AM.......__________!"
p$(95) = "ff3111333h.F.WM.FF....___YQ_____!"

REM ******************* plansze wiersza roomy=6

p$(96) = "fffa222hhh.0....EJ....___YM_____!"
p$(97) = "hhhf000bbb.1....SJ....ML____CMO_!"
p$(98) = "h222111hhh.2..........___KM_____!"
p$(99) = "f111aaafff.3....PH....ZJ________!"
p$(100) = "h222ahhhhh.4..........EE________!"
p$(101) = "f11133222h.5.0I.......___GQ_____!"
p$(102) = "ffffff000h.6....LO....__________!"
p$(103) = "gg333d111f.7....MO....aP________!"
p$(104) = "gg333hCCCh.8.......ZN.EG____HIE_!"
p$(105) = "ffffffDDDh.9..........__________!"
p$(106) = "hh333fCCCh.A.BE.......___KI_____!"
p$(107) = "ff3333111h.B.0I....KK.aP____CKK_!"
p$(108) = "cc22dd22ff.C..........__________!"
p$(109) = "hhDDffDDhh.D.......TJ.LN________!"
p$(110) = "ccc2222hhh.E..........__________!"
p$(111) = "hhhDDDDhhh.F..........TK_KM_____!"

REM ******************* plansze wiersza roomy=7

p$(112) = "hfaa222hhh.0..........______COJ_!"
p$(113) = "bbbb000hhh.1....KK....__________!"
p$(114) = "h222111fff.2.BJ.......ZE____AIK_!"
p$(115) = "f000aaahhh.3..........___KM_____!"
p$(116) = "h000ahhhhh.4.......KF.__________!"
p$(117) = "h111hh222h.5..........KQ________!"
p$(118) = "hfffff000f.6....KO....__________!"
p$(119) = "fffeee000h.7..........___KQ_____!"
p$(120) = "hh3333000h.8.BL.......______CKK_!"
p$(121) = "hCCCffDDDh.9..........KO________!"
p$(122) = "hDDDccCCCh.A..........___MK_____!"
p$(123) = "hf333300Df.B.AL.......__________!"
p$(124) = "ffffff00hh.C....KN....______IOI_!"
p$(125) = "hhhhhf00fh.D.......TK.__________!"
p$(126) = "h33c3300ff.E..........KK____COG_!"
p$(127) = "hhheefDDhh.F....KN....__________!"

REM ***************** n/8 plansze wiersza roomy=8

p$(128) = "hffa222hhh.0..........__________!"
p$(129) = "hbbb000hhh.1..........__________!"
p$(130) = "f222111fff.2..........__________!"
p$(131) = "h000aaahhh.3..........______COI_!"
p$(132) = "h000ahhhhh.4..........__________!"
p$(133) = "h111hh222h.5..........__________!"
p$(134) = "ffffff000f.6..........______DQK_!"
p$(135) = "hhhhha000h.7..........______ESK_!"
p$(136) = "hh3333000h.8..........______CKK_!"
p$(137) = "h33333111h.9..........__________!"
p$(138) = "h33333222h.A.BG.......__________!"
p$(139) = "ffCCff00ff.B..........______KaE_!"
p$(140) = "hfDDff00hh.C..........______JKM_!"
p$(141) = "hhhaac00fh.D..........__________!"
p$(142) = "f3333300ff.E..........______COL_!"
p$(143) = "hhheefDDhh.F..........__________!"

REM ***************** n/9 plansze wiersza roomy=9

p$(144) = "hffa222hhh.0..........__________!"
p$(145) = "hbbb000hhh.1..........__________!"
p$(146) = "f222111hhh.2..........__________!"
p$(147) = "h000aaahhh.3..........__________!"
p$(148) = "h000ahhhhh.4..........__________!"
p$(149) = "h111hh333h.5..........__________!"
p$(150) = "ffffaa222h.6..........__________!"
p$(151) = "hhaaaa000h.7..........__________!"
p$(152) = "hh3333000h.8..........__________!"
p$(153) = "h33333111h.9..........__________!"
p$(154) = "h33333222h.A..........__________!"
p$(155) = "ffCCff00Dh.B..........__________!"
p$(156) = "hfDDff00hh.C..........__________!"
p$(157) = "hhhaac00fh.D..........__________!"
p$(158) = "f3333300hh.E..........__________!"
p$(159) = "hhheefDDhh.F..........__________!"

REM tablica serc
FOR xr = 0 TO 15
FOR yr = 0 TO 9
s = xr + yr * 16
znak$ = MID$(p$(s), 23, 1)
IF znak$ <> "_" THEN serca(xr, yr) = 1
NEXT yr: NEXT xr

REM tablica wind
pozycjewind(1) = 0
pozycjewind(2) = 4

END SUB

SUB rysowanie

FOR yw = 0 TO 9
el$ = MID$(kod$, yw + 1, 1)
y16 = yw * 18

REM tymczasowe sygnalizacje bledow:

IF el$ = "Q" OR el$ = "L" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "P" OR el$ = "W" OR el$ = "=" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "A" OR el$ = "B" OR el$ = "U" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "@" THEN COLOR 15: LINE (0, y16)-(200, y16)

REM elementy uzupelniajace

IF el$ = "C" THEN
PUT (128, y16), szaretlo4, PSET: PUT (192, y16), szaretlo4, PSET
PUT (256, y16), szaretlo4, PSET
PUT (0, y16), blok4, PSET: PUT (64, y16), blok2, PSET:
PUT (96, y16), bloks, PSET: PUT (112, y16), blokk, PSET
END IF

IF el$ = "D" THEN
PUT (0, y16), szaretlo4, PSET: PUT (64, y16), szaretlo4, PSET
PUT (128, y16), szaretlo4, PSET
PUT (192, y16), blokp, PSET: PUT (208, y16), blok4, PSET
PUT (272, y16), blok2, PSET: PUT (304, y16), bloks, PSET
END IF

REM czesc automatyczna, znaki a-h
ascii = ASC(el$)

IF ascii > 96 THEN
bity = ascii - 97
PUT (0, y16), blok4, PSET:
pop1 = 0
pop2 = 0
pop3 = 0

IF (bity AND 4) = 4 THEN PUT (64, y16), blok4, PSET: pop1 = 1
IF (bity AND 4) = 0 THEN PUT (48, y16), blokk, PSET: PUT (64, y16), szaretlo4, PSET: pop1 = 0
REM
IF (bity AND 2) = 2 THEN pop2 = 1: PUT (128, y16), blok4, PSET: IF pop1 = 0 THEN PUT (128, y16), blokp, PSET
IF (bity AND 2) = 0 THEN pop2 = 0: PUT (128, y16), szaretlo4, PSET: IF pop1 = 1 THEN PUT (112, y16), blokk, PSET
REM
IF (bity AND 1) = 1 THEN pop3 = 1: PUT (192, y16), blok4, PSET: IF pop2 = 0 THEN PUT (192, y16), blokp, PSET
IF (bity AND 1) = 0 THEN pop3 = 0: PUT (192, y16), szaretlo4, PSET: IF pop2 = 1 THEN PUT (176, y16), blokk, PSET
PUT (256, y16), blok4, PSET
IF pop3 = 0 THEN PUT (256, y16), blokp, PSET
END IF

REM znaki 0-3

IF ascii < 58 THEN
bity = ascii - 48
IF (bity AND 2) = 2 THEN PUT (0, y16), blokk, PSET
IF (bity AND 2) = 0 THEN PUT (0, y16), szaretlo, PSET
PUT (16, y16), szaretlo4, PSET
PUT (80, y16), szaretlo4, PSET
PUT (144, y16), szaretlo4, PSET
PUT (208, y16), szaretlo4, PSET
PUT (272, y16), szaretlo2, PSET

IF (bity AND 1) = 1 THEN PUT (304, y16), blokp, PSET
IF (bity AND 1) = 0 THEN PUT (304, y16), szaretlo, PSET
END IF

NEXT yw

REM rysowanie podestow

el$ = MID$(kod$, 14, 1)
IF el$ = "" OR el$ = "." THEN GOTO dodatek

el2$ = MID$(kod$, 15, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "#" THEN PUT (0, yo), ceg40, PSET
IF el$ = "W" THEN PUT (0, yo), ceg4plus20plus4, PSET
IF el$ = "U" THEN PUT (0, yo), ceg17plus17, PSET
IF el$ = "0" THEN PUT (0, yo), ceg13plus13, PSET
IF el$ = "A" THEN FOR xx = 0 TO 4: PUT (16 + xx * 64, yo), ceg2, PSET: NEXT xx
IF el$ = "B" THEN FOR xx = 0 TO 5: PUT (64 + xx * 32, yo), ceg2, PSET: NEXT xx

REM dodatkowy element
dodatek:

el$ = MID$(kod$, 29, 1)
IF el$ = "" OR el$ = "_" THEN GOTO okna
el2$ = MID$(kod$, 30, 1)
xo = (ASC(el2$) - 65) * 8
el2$ = MID$(kod$, 31, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "A" THEN
PUT (xo, yo), blokp, PSET:
PUT (xo, yo + 18), blokp, PSET
PUT (xo + 16, yo), blok2, PSET:
PUT (xo + 16, yo + 18), blok2, PSET
PUT (xo + 48, yo), blokk, PSET:
PUT (xo + 48, yo + 18), blokk, PSET
END IF

IF el$ = "B" THEN COLOR 235: LINE (xo + 5, yo)-(xo + 9, yo + 35), , BF
IF el$ = "C" THEN PUT (xo, yo), ceg2, PSET: PUT (xo + 32, yo), ceg2, PSET: PUT (xo + 64, yo), ceg2, PSET
IF el$ = "D" THEN LINE (xo, yo)-(xo + 22, yo + 17), 235, BF: LINE (xo + 42, yo)-(xo + 63, yo + 17), 235, BF
IF el$ = "E" THEN LINE (xo, yo)-(xo + 5, yo + 35), 235, BF: LINE (xo + 26, yo + 36)-(xo + 31, yo + 72), 235, BF
REM niebieskie klocki
IF el$ = "F" THEN PUT (xo, yo), nieb, PSET
IF el$ = "G" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo), nieb, PSET
IF el$ = "H" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo + 36), nieb, PSET
IF el$ = "I" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo - 36), nieb, PSET
REM jednokierunkowe bramki
IF el$ = "J" THEN PSET (xo - 2, yo), 199: DRAW "R18 D35 L18 U35 F18 U1 G18"
IF el$ = "K" THEN PSET (xo - 2, yo), 198: DRAW "R18 D35 L18 U35 R18 G18 U1 F18"
REM zaslonka
IF el$ = "L" THEN LINE (xo, yo)-(xo + 15, yo + 35), 255, BF
REM winda
xwindy = -10: ywindy = -10
IF el$ = "M" THEN
LINE (xo, yo)-(xo + 23, yo + 35), 10, BF
LINE (xo, yo)-(xo, yo + 36), 6, BF
LINE (xo, yo)-(xo + 23, yo), 6, BF
LINE (xo + 3, yo + 7)-(xo + 5, yo + 18), 14, BF
LINE (xo + 1, yo)-(xo + 23, yo), 9
REM LINE (xo + 20, yo + 1)-(xo + 22, yo + 1), 9
PSET (xo + 4, yo + 9), 12
PSET (xo + 4, yo + 11), 5
PSET (xo + 4, yo + 13), 5
PSET (xo + 4, yo + 15), 5
PSET (xo + 4, yo + 17), 5
xwindy = xo: ywindy = yo: winda = 1
COLOR 8: LOCATE (ywindy / 8) + 2, 34
IF roomy = 0 THEN PRINT "1"
IF roomy = 4 THEN PRINT "2"
END IF

okna:

REM rysowanie okien

el$ = MID$(kod$, 17, 1)
IF el$ = "" OR el$ = "." THEN GOTO serce
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 18, 1)
yo = (ASC(el$) - 65) * 9
IF roomy < 2 THEN PUT (xo, yo), window2, PSET
IF roomy > 1 AND roomy < 5 THEN PUT (xo, yo), window1, PSET
IF roomy > 4 THEN PUT (xo, yo), window3, PSET

serce:
REM serce
xserca = -20
yserca = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 23, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xserca = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 24, 1)
yserca = (ASC(el$) - 65) * 9
GET (xserca, yserca)-(xserca + 15, yserca + 7), tlo
COLOR 5
LINE (xserca, yserca + 1)-(xserca, yserca + 3)
LINE (xserca + 1, yserca)-(xserca + 1, yserca + 4)
LINE (xserca + 2, yserca)-(xserca + 2, yserca + 5)
LINE (xserca + 3, yserca + 1)-(xserca + 3, yserca + 6)
LINE (xserca + 4, yserca)-(xserca + 4, yserca + 5)
LINE (xserca + 5, yserca)-(xserca + 5, yserca + 4)
LINE (xserca + 6, yserca + 1)-(xserca + 6, yserca + 3)

donica:
el$ = MID$(kod$, 26, 1)
IF el$ = "" OR el$ = "_" THEN GOTO wentyl
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 27, 1)
yo = (ASC(el$) - 65) * 9 + 2
PUT (xo, yo), palma, PSET

wentyl:
el$ = MID$(kod$, 20, 1)
IF el$ = "" OR el$ = "." THEN GOTO koniecrysowania
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 21, 1)
yo = (ASC(el$) - 65) * 9
PUT (xo, yo), wentylator, PSET

koniecrysowania:

LOCATE 24, 2: COLOR 15: PRINT "Czas:"; licz;

END SUB

SUB zabranie
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)

OUT 66, 32: OUT 66, 3
FOR i = 1 TO 6000: NEXT i

OUT 66, 204: OUT 66, 4
FOR i = 1 TO 6000: NEXT i

t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port

END SUB

Piotr-246 · Gość

DECLARE SUB zabranie ()

REM Gra "Serca" UWAGA wersaj gry wymaga
REM emulatora o predkosci 6075 cyklow
REM wymaga pliku bitmap1.scr utworzonego przez modul bsave.bas

DECLARE SUB dreptanie ()
DECLARE SUB animacja ()
DECLARE SUB rysowanie ()
DECLARE SUB palety ()
DECLARE SUB plansze ()
DECLARE SUB cegly ()

REM plansza startowa:
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
roomx = 7: roomy = 4

DIM SHARED kolor$(0 TO 255)
DIM pamiec(0 TO 128) AS LONG
DIM poledzialania(0 TO 240) AS LONG
DIM SHARED pozycjewind(1 TO 3) AS INTEGER
DIM SHARED p$(0 TO 159)
DIM SHARED kod$
DIM SHARED serca(0 TO 15, 0 TO 9) AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED xwindy AS INTEGER, ywindy AS INTEGER

REM pamiec tla pod wziatek

DIM SHARED tlo(0 TO 32) AS LONG

REM tlo

DIM SHARED szaretlo(0 TO 74) AS LONG
DIM SHARED szaretlo2(0 TO 148) AS LONG
DIM SHARED szaretlo4(0 TO 300) AS LONG
REM dane elementow planszy

DIM SHARED ceg2(0 TO 75) AS LONG
DIM SHARED ceg40(0 TO 730) AS LONG
DIM SHARED ceg17plus17(0 TO 730) AS LONG
DIM SHARED ceg13plus13(0 TO 760) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 750) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED nieb(0 TO 145) AS LONG

DIM SHARED blokp(0 TO 74) AS LONG
DIM SHARED bloks(0 TO 74) AS LONG
DIM SHARED blokk(0 TO 74) AS LONG
DIM SHARED blok2(0 TO 158) AS LONG
DIM SHARED blok4(0 TO 296) AS LONG

REM ****************** DANE ANIMACJI

DIM SHARED znakp1(0 TO 128) AS LONG
DIM SHARED znakl1(0 TO 128) AS LONG
DIM SHARED znakp2(0 TO 128) AS LONG
DIM SHARED znakl2(0 TO 128) AS LONG
DIM SHARED znakp3(0 TO 128) AS LONG
DIM SHARED znakl3(0 TO 128) AS LONG
DIM SHARED vertd1(0 TO 128) AS LONG

REM matryce okien

DIM SHARED window1(0 TO 160) AS LONG
DIM SHARED window2(0 TO 160) AS LONG
DIM SHARED window3(0 TO 160) AS LONG

DIM SHARED wentylator(0 TO 64) AS LONG

REM ************************* DANE STARTOWE

SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci

x = 200: y = 35: xs = 200: ys = 35: REM wspol. pocz. gracza na ekr.
licz = -1: REM wartosc start. zegara
kolwent = 30 + 30 * 256 + 30 * 65536: REM kolor lopat wentylatora

REM ***** SUB palety - ustawienie nowych wartosci barw
palety

REM ***** SUB cegly - zapelnienie pozostalych tablic
cegly

REM SUB plansze - wypelnienie tablicy wygladu plansz
plansze

REM ************************* START POMIESZCZENIA

rysuj:

kod$ = p$(roomx + roomy * 16)

REM ******************** rysowanie pomieszczenia
t0 = PEEK(1132): REM pomiar czasu rysowania

REM SUB rysowanie - rysowanie planszy
rysowanie

IF przejechal = 1 THEN y = ywindy + 3: ys = ywindy + 3: przejechal = 0

REM pomiar czasu rysowania
t1 = PEEK(1132):

REM menu na dole
LINE (0, 180)-(319, 182), 234, BF
LOCATE 25, 15: PRINT "L-SHIFT ALT P-SHIFT";
LOCATE 24, 2: COLOR 3: PRINT "T:"; t0; "/"; t1; FRE(-2);
PRINT " ROOM:"; roomx; "/"; roomy; "--";

REM **************** zapamietanie pola pod graczem
GET (x, y)-(x + 15, y + 31), pamiec
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
REM PUT (x, y), vertd1, PSET
liczsercaroom = 0: zrobione = 0
GOTO postaw
REM *************************** PETLA GLOWNA

petla:
dx = 0: dy = 0
IF dzwiekbrania = 1 THEN dzwiekbrania = 0: zabranie

REM ******************* czas gry w sekundach

se$ = MID$(TIME$, 7, 2)
se = VAL(se$)
IF se <> ses THEN licz = licz + 1
ses = se
LOCATE 25, 2: COLOR 15: PRINT "Czas:"; licz;

REM ************************ petla opozniajaca
FOR delay = 1 TO 700: NEXT delay

REM faza wentylatora

komorka = PEEK(1132) / 1.5
faz = INT(komorka)
IF faz / 3 = INT(faz / 3) THEN faza = 0
IF (faz + 1) / 3 = INT((faz + 1) / 3) THEN faza = 1
IF (faz + 2) / 3 = INT((faz + 2) / 3) THEN faza = 2
FOR i = 0 TO 2: i16 = i * 16
IF faza = 0 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, 0
IF faza = 1 THEN PALETTE 11 + i16, 0: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, kolwent
IF faza = 2 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, 0: PALETTE 13 + i16, kolwent
NEXT i

REM ************************ sprawdzenie klawiszy

alt = 0: lshift = 0: pshift = 0: skos = 0

k$ = INKEY$
IF k$ = "f" THEN roomx = roomx - 1: GOTO rysuj
IF k$ = "h" THEN roomx = roomx + 1: GOTO rysuj
IF k$ = "t" THEN roomy = roomy - 1: GOTO rysuj
IF k$ = "b" THEN roomy = roomy + 1: GOTO rysuj
IF k$ = CHR$(27) THEN END

IF x >= xwindy AND y - ywindy < 10 THEN
IF k$ = "1" OR k$ = "2" THEN GOSUB przejazd: GOTO rysuj
IF k$ = "3" THEN GOSUB przejazd: GOTO rysuj
END IF

REM klawisz alt - wznoszenie sie
IF (PEEK(1047) AND 8) = 8 THEN alt = 1
IF (PEEK(1047) AND 2) = 2 THEN lshift = 1
IF (PEEK(1047) AND 1) = 1 THEN pshift = 1

REM bezruch = grawitacja
IF lshift = 0 AND pshift = 0 AND alt = 0 THEN dy = 2: vert = 1: obrot = 0: przebiervert = 0: GOTO czy

POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury

IF lshift = 1 THEN dx = -4: dy = 2: obrot = -1: vert = 0
IF pshift = 1 THEN dx = 4: dy = 2: obrot = 1: vert = 0
IF alt = 1 THEN dy = -4: vert = 1
IF dx <> 0 AND dy <> 0 THEN skos = 1
czy:

REM ************ sprawdzenie czy jest przejscie do innej planszy

IF x + dx > 300 THEN x = 5: xs = 5: roomx = roomx + 1: GOTO rysuj
IF x + dx < 3 THEN x = 300: xs = 300: roomx = roomx - 1: GOTO rysuj
IF y + dy > 144 THEN y = 5: ys = 5: roomy = roomy + 1: GOTO rysuj
IF y + dy < 4 THEN y = 145: ys = 145: roomy = roomy - 1: GOTO rysuj

REM *********** sprawdzenie czy ruch jest mozliwy
REM sprawdzenie przeszkody. Przeszkoda sa kolory > 200

xmozliwy = 0: xniemozliwy = 0
ymozliwy = 0: yniemozliwy = 0

REM sprawdzenie sasiedztwa obok

IF dx > 0 THEN
FOR i = 0 TO 31: punkt = POINT(x + 19, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 198 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF

IF dx < 0 THEN
FOR i = 0 TO 31: punkt = POINT(x - 3, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 199 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF xniemozliwy = 0 THEN xmozliwy = 1
IF xniemozliwy = 1 THEN xmozliwy = 0

REM sprawdzenie sasiedztwa gora dol

IF dy > 0 THEN
FOR i = 0 TO 15:
IF POINT(x + i, y + 32) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y + 33) > 200 THEN yniemozliwy = 1: EXIT FOR

NEXT i
END IF

IF dy < 0 THEN
FOR i = 0 TO 15
IF POINT(x + i, y - 4) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y - 5) > 200 THEN yniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF yniemozliwy = 0 THEN ymozliwy = 1
IF yniemozliwy = 1 THEN ymozliwy = 0

REM ruch gdy oba mozliwe x oraz y
IF ymozliwy = 1 AND xmozliwy = 1 THEN IF dx <> 0 OR dy <> 0 THEN GOTO ruch

REM szczegolne przypadki gdy tylko x albo y mozliwy
IF ymozliwy = 0 AND xmozliwy = 1 THEN dy = 0: GOTO czy
IF ymozliwy = 1 AND xmozliwy = 0 THEN dx = 0: GOTO czy

REM ruch niemozliwy powrot petli glownej bez zmian pozostaja x y

x = xs: y = ys
GOTO petla

REM ***************** RUCH

ruch:

x = x + dx: y = y + dy
IF dy = 0 AND przebieranie = 0 AND alt = 0 THEN dreptanie: REM dzwiek chodzenia

REM ******************** czy jest wziatek
deltawx = ABS(x + 4 - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek

REM ************************************** operacja odswiezania tla
postaw:
REM punkt 1 zapamietanie nowego pola dzialania (brudnego)
REM w oparciu o nowe x,y

GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania

REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo

deltax = x - xs: deltay = y - ys
inversx = -1 * deltax: inversy = -1 * deltay
inver4 = INT(inversx / 4)
FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = (yt + inversy) * 6
FOR xt = 0 TO 3
index1 = 1 + (yt6 + 24) + (xt + inver4) + 1
index2 = 1 + yt4 + xt
poledzialania(index1) = pamiec(index2)
NEXT xt: NEXT yt

REM zmazanie serca z pola dzialania

IF liczsercaroom = 1 AND zrobione = 0 THEN
zrobione = 1
PUT (x - 4, y - 4), poledzialania, PSET
PUT (xserca, yserca), tlo, PSET
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
END IF

REM nowa mala pamiec

FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = yt * 6
FOR xt = 0 TO 3:
index1 = 1 + (yt6 + 24) + (xt + 1):
index2 = 1 + yt4 + xt:
pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt

REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU

REM aby nie rysowac dwoch postaci w przypadku skosu
IF skos = 1 THEN GOTO bezskosu:

REM ************************** ruch w dol lub gore

IF vert = 1 THEN wkleic = 7: GOTO wklej
bezskosu:
REM ************************** ruch w lewo

IF obrot = -1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1
IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 1: GOTO wklej
IF przebieranie = 1 THEN wkleic = 2: GOTO wklej
IF przebieranie = 2 THEN wkleic = 3: GOTO wklej
END IF

REM ****************** ruch w prawo

IF obrot = 1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1

IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 4: GOTO wklej
IF przebieranie = 1 THEN wkleic = 5: GOTO wklej
IF przebieranie = 2 THEN wkleic = 6: GOTO wklej
END IF

xs = x: ys = y

GOTO petla

wklej:

IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt
IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt
IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt
IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt
IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt
IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt
IF wkleic = 7 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)): NEXT xt: NEXT yt

REM wklejenie wyniku operacji na tablicy:
PUT (x - 4, y - 4), poledzialania, PSET

xs = x: ys = y
GOTO petla

REM GOSUB-RETURN****************************** obsluga wziatku

wziatek:
IF serca(roomx, roomy) = 0 THEN GOTO niemawziatku
IF liczsercaroom = 1 THEN GOTO niemawziatku
serca(roomx, roomy) = 0
liczserca = liczserca + 1
PUT (xserca, yserca), tlo, PSET

liczsercaroom = 1
dzwiekbrania = 1

LOCATE 1, 1: COLOR 6: PRINT liczserca;
niemawziatku:
RETURN

REM GOSUB-RETURN przejazd:
przejazd:
pietro = VAL(k$)
roomy = pozycjewind(pietro)

FOR i = 23 TO 0 STEP -1
LINE (xwindy + i, ywindy)-(xwindy + i, ywindy + 35), 255
FOR j = 1 TO 10000: NEXT j
NEXT i
CLS
FOR i = 1 TO 30000: NEXT i
przejechal = 1
RETURN

SUB cegly

BLOAD "bitmap1.scr"

REM INPUT a$
REM pobranie z ekranu tablic elementow
REM uwaga! wysokosc elementu to 9 lub 18 px

GET (0, 0)-(31, 8), ceg2
GET (0, 0)-(319, 8), ceg40
GET (0, 9)-(319, 17), ceg17plus17
GET (0, 18)-(319, 26), ceg13plus13
GET (0, 27)-(319, 35), ceg4plus20plus4
GET (0, 36)-(15, 53), szaretlo
GET (0, 36)-(31, 53), szaretlo2
GET (0, 36)-(63, 53), szaretlo4: REM 36+18=46+8=54

GET (16, 64)-(31, 79), palma
GET (32, 64)-(47, 81), blokp
GET (48, 64)-(63, 81), bloks
GET (64, 64)-(79, 81), blokk
GET (0, 156)-(31, 173), blok2
GET (0, 156)-(63, 173), blok4
GET (80, 64)-(111, 81), nieb

GET (0, 88)-(15, 119), znakl1
GET (16, 88)-(31, 119), znakp1
GET (32, 88)-(47, 119), znakl2
GET (48, 88)-(63, 119), znakp2
GET (64, 88)-(79, 119), znakl3
GET (80, 88)-(95, 119), znakp3
GET (96, 88)-(111, 119), vertd1

GET (0, 120)-(31, 139), window1
GET (32, 120)-(63, 139), window2
GET (64, 120)-(95, 139), window3
GET (0, 140)-(15, 155), wentylator
CLS
END SUB

SUB dreptanie

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)

REM ewentualnie:
REM OUT 66, 30: OUT 66, 0
REM OUT 66, 164: OUT 66, 2
REM OUT 66, 130: OUT 66, 1
REM OUT 66, 74: OUT 66, 0
REM OUT 66, 220: OUT 66, 1

FOR i = 1 TO 10
OUT 66, 30: OUT 66, 0
OUT 66, 84: OUT 66, 2
OUT 66, 30: OUT 66, 0
OUT 66, 94: OUT 66, 2
OUT 66, 10: OUT 66, 0
OUT 66, 40: OUT 66, 2
OUT 66, 84: OUT 66, 0
OUT 66, 10: 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 palety

REM palety kolorow *********************************
REM max koloru=3F

FOR i = 0 TO 255: kolor$(i) = "00 00 00 00"
PALETTE i, 31 + 31 * 256 + 31 * 65536: NEXT i

REM kolory za ludzikiem

kolor$(0) = "00 00 00 00": REM rejestr zero- wolny
kolor$(1) = "01 05 05 06": REM tlo plyta
kolor$(2) = "02 02 03 02": REM tlo fuga
kolor$(3) = "03 07 06 06": REM tlo krawedz
kolor$(4) = "04 00 22 00": REM liscie
kolor$(5) = "05 3F 08 00": REM serce
kolor$(6) = "06 30 30 30": REM framuga okna
kolor$(7) = "07 28 0A 00": REM doniczka drzewa
kolor$(8) = "08 00 21 39": REM niebo
kolor$(9) = "09 3F 3F 00": REM slonce
kolor$(10) = "0A 14 14 14": REM framuga zewnetrzna
kolor$(11) = "0B 00 00 00": REM wentylator faza 1
kolor$(12) = "0C 00 00 00": REM wentylator faza 2
kolor$(13) = "0D 00 00 00": REM wentylator faza 3
kolor$(14) = "0E 20 20 20": REM srednia szarosc
kolor$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza

REM rejestry przezroczyste gracza
kolor$(16) = "10 18 02 02": REM sweter + zero
kolor$(17) = "11 18 02 02": REM
kolor$(18) = "12 18 02 02": REM
kolor$(19) = "13 18 02 02": REM
kolor$(20) = "14 22 12 00": REM sweter + liscie
kolor$(21) = "15 3F 00 00": REM
kolor$(22) = "16 2F 09 09": REM sweter + framuga okna
kolor$(23) = "17 2B 08 00": REM sweter + doniczka drzewa
kolor$(24) = "18 25 16 24": REM sweter + niebo
kolor$(25) = "19 3F 3F 3F": REM sweter + slonce
kolor$(26) = "1A 16 0F 0F": REM sweter + framuga zew
kolor$(27) = "1B 3F 3F 3F": REM
kolor$(28) = "1C 3F 3F 3F": REM
kolor$(29) = "1D 3F 3F 3F": REM
kolor$(30) = "1E 20 10 10": REM sweter + przyciski
REM kolor 31 (1F) zastrzezony dla gracza
kolor$(32) = "20 0A 13 29": REM spodnie + zero
kolor$(33) = "21 0A 13 29": REM
kolor$(34) = "22 0A 13 29": REM
kolor$(35) = "23 0A 13 29": REM
kolor$(36) = "24 05 1D 24": REM spodnie+ liscie
kolor$(37) = "25 3F 3F 3F": REM
kolor$(38) = "26 1B 1B 32": REM spodnie + framuga okna
kolor$(39) = "27 1A 10 3F": REM spodnie + doniczka
kolor$(40) = "28 00 1A 3F": REM spodnie + niebo
kolor$(41) = "29 3F 3F 3F": REM spodnie +slonce
kolor$(42) = "2A 10 14 20": REM spodnie + framuga zew
kolor$(43) = "2B 3F 3F 3F": REM
kolor$(44) = "2C 3F 3F 3F": REM
kolor$(45) = "2D 3F 3F 3F": REM
kolor$(46) = "2E 3F 3F 3F": REM
REM rejestr 47 (2F) zastrzezony dla gracza

REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF)
REM rejestry nieprzezroczyste

kolor$(31) = "1F 2F 09 09": REM sweter
kolor$(47) = "2F 0D 1A 37": REM spodnie
kolor$(63) = "3F 1A 1A 1A": REM wlosy i buty
kolor$(79) = "4F 10 10 10": REM pasek2
kolor$(95) = "5F 3F 2F 0F":
kolor$(111) = "6F 3F 30 20": REM skora1
REM kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych
kolor$(143) = "8F 32 22 02": REM nos
REM kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych
REM kolor$(175) = "AF 22 02 02": REM sweter3
kolor$(191) = "BF 20 20 20": REM pasek
kolor$(207) = "CF 37 27 06": REM usta
REM FF- zarezerwowany dla przeslony

REM rejestry jednokierunkowe
kolor$(198) = "C6 20 20 20"
kolor$(199) = "C7 20 20 20"

REM bloczek

kolor$(224) = "E0 00 00 00": REM
kolor$(225) = "E1 04 04 04": REM
kolor$(226) = "E2 08 08 08": REM
kolor$(227) = "E3 0B 0B 0B": REM
kolor$(228) = "E4 10 10 10": REM
kolor$(229) = "E5 14 14 14": REM
kolor$(230) = "E6 18 18 18": REM
kolor$(231) = "E7 1B 1B 1B": REM
kolor$(232) = "E8 20 20 20": REM
kolor$(233) = "E9 24 24 24": REM
kolor$(234) = "EA 28 28 28": REM
kolor$(235) = "EB 2B 2B 2B": REM
kolor$(236) = "EC 30 30 30": REM
kolor$(237) = "ED 34 34 34": REM
kolor$(238) = "EE 38 38 38": REM
kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika

REM kolor 240 - przeslona
kolor$(240) = "F0 38 38 38"

REM cegly male niebieskie

kolor$(249) = "F9 22 27 30": REM krawedz
kolor$(250) = "FA 09 0E 14": REM fuga
kolor$(251) = "FB 11 17 1F": REM cegla

REM cegly male czerwone

kolor$(252) = "FC 30 27 27": REM krawedz
kolor$(253) = "FD 14 0E 0E": REM fuga
kolor$(254) = "FE 1F 17 17": REM cegla
kolor$(255) = "FF 28 28 28": REM przeslona

FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2)
red$ = "&H" + MID$(kolor$(i), 4, 2)
gre$ = "&H" + MID$(kolor$(i), 7, 2)
blu$ = "&H" + MID$(kolor$(i), 10, 2)
REM PRINT rej$; " "; red$; " "; gre$; " "; blu$
rej = VAL(rej$)
red = VAL(red$)
gre = VAL(gre$)
blu = VAL(blu$)
REM PRINT rej; " "; red; " "; gre; " "; blu

PALETTE rej, red + gre * 256 + blu * 65536
NEXT i

END SUB

SUB plansze

REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** roomy*16+roomx

REM kody plansz +++nr.po.ok.we.se_kw_dod
REM ************ plansze wiersza roomy=0

p$(0) = "h22233322d.0.UI.YO....GN________!"
p$(1) = "h000fff11h.1....MD....__________!"
p$(2) = "h11133333f.2.UI.HE....___EQ_____!"
p$(3) = "hh2223cchh.3..........SJ________!"
p$(4) = "h300033fff.4....ZK....__________!"
p$(5) = "h2001c333f.5....LG....______AQG_!"
p$(6) = "h111g3322f.6....LD....___EQ_F[Q_!"
p$(7) = "hh222ff11d.7.BE....DF.aH_ZI_MdO_!"
p$(8) = "hhDDDfCCCg.8..........__________!"
p$(9) = "hhhhhf111c.9..........__________!"
p$(10) = "hhhhhf222g.A..........GG_EQ_____!"
p$(11) = "hh333f111d.B....HG....__________!"
p$(12) = "hhffff333g.C..........__________!"
p$(13) = "h22233333c.D.UN.aK.DF.MK____AYC_!"
p$(14) = "h111ff22hh.E..........___aG_BLM_!"
p$(15) = "h3333311cc.F....ZK....aH____AIG_!"

REM ************ plansze wiersza roomy=1

p$(16) = "d333c2223h.0.......FN.__________!"
p$(17) = "h33330003h.1.WH.SO....dE____COM_!"
p$(18) = "ff333111ff.2.WJ.ML....__________!"
p$(19) = "hc222c333c.3..........___QQ_____!"
p$(20) = "f31113333h.4.UM.aI.aO.__________!"
p$(21) = "f333aa333h.5..........RN_GQ_____!"
p$(22) = "ffff333fff.6....DJ....aM____G[M_!"
p$(23) = "dd333a33hh.7..........__________!"
p$(24) = "gg333333ff.8.AK....IF.__________!"
p$(25) = "cc3322333c.9.WM.......eF________!"
p$(26) = "gg331133hh.A....LF....aO________!"
p$(27) = "ddaa22cccc.B..........__________!"
p$(28) = "g33300333h.C.AM....aO.__________!"
p$(29) = "c33311333c.D.0M.......ZK____AQO_!"
p$(30) = "h3322233dd.E.BE....aF.__________!"
p$(31) = "c33111333h.F.AM.bD....___QQ_COH_!"

REM ************* plansze wiersza roomy=2

p$(32) = "h333ff333c.0..........KE_WQ_____!"
p$(33) = "h33332222c.1....KD....UP____CGI_!"
p$(34) = "faaaa0000h.2....WO.VI.__________!"
p$(35) = "ccccc1111f.3....MM....___EQ_____!"
p$(36) = "h33333223h.4.WI.FP....SM________!"
p$(37) = "haa33200af.5.UJ....GL.______HIE_!"
p$(38) = "f333c111ah.6....aM....UP________!"
p$(39) = "hh333d333g.7....YP....___KQ_____!"
p$(40) = "ff3333333g.8.#I.......KK____CGN_!"
p$(41) = "c33g33d33c.9..........__________!"
p$(42) = "hh3333333g.A.WM.LI....__________!"
p$(43) = "cc333322cc.B.UJ.......__________!"
p$(44) = "hhaacc00hh.C.BE....JG.ZM____AQM_!"
p$(45) = "c333cc11gg.D....aN....______AQM_!"
p$(46) = "dd33cc22hh.E..........______AQE_!"
p$(47) = "hh3331113c.F.UK....VI.___EQ_____!"

REM ************ plansze wiersza roomy=3

p$(48) = "c33332222f.0....ZM.ZD.SF____COI_!"
p$(49) = "ccccc1111h.1..........__________!"
p$(50) = "ha3222333c.2.#F.LO....UO_SQ_____!"
p$(51) = "ff3111333f.3.WM.YI.VI.SJ_GQ_____!"
p$(52) = "h3333c333f.4..........NG____CKK_!"
p$(53) = "ff333c222f.5....ZO....SG________!"
p$(54) = "hhaaff000f.6.BE.......___KQ_____!"
p$(55) = "gggg33111f.7....LO.VJ.______IYM_!"
p$(56) = "gg3322ffff.8..........GG________!"
p$(57) = "cccc00hfff.9..........__________!"
p$(58) = "gg33DDffff.A..........___KK_CCH_!"
p$(59) = "cccccfffff.B.......TL.__________!"
p$(60) = "hh3333333f.C....KK....DP________!"
p$(61) = "g333333hhh.D.UJ....TF.______CKK_!"
p$(62) = "hh3222333f.E..........___GQ_____!"
p$(63) = "c331113hhh.F....ZK....__________!"

REM ****************** plansze wiersza roomy=4

p$(64) = "f22322322h.0....DD....SP_YQ_CKK_!"
p$(65) = "h00f00f00h.1..........__________!"
p$(66) = "c11311311f.2....aP.KP.__________!"
p$(67) = "ff3332223h.3.UJ.ML....___YQ_____!"
p$(68) = "f3333111hh.4.WJ.YL....__________!"
p$(69) = "ffaafaaaff.5.......VI.__________!"
p$(70) = "ffa333c33h.6....OG....SQ_YQ_____!"
p$(71) = "ff223c33cd.7....SN.DF.GN_TI_MdM_!": REM startowa
p$(72) = "ff113cc33d.8..........MO____JVO_!"
p$(73) = "ff33cc33ff.9..........______COI_!"
p$(74) = "ff3333333d.A.WM.LI.ZP.PP________!"
p$(75) = "ff2233333f.B.UM.......___EQ_____!"
p$(76) = "ff11333hhh.C.......KH.__________!"
p$(77) = "h333333333.D.BE.SK....bF____CKK_!"
p$(78) = "ff22233hhh.E.UJ.......______FEE_!"
p$(79) = "h311133fff.F.WJ.......MM________!"

REM ******************* plansze wiersza roomy=5

p$(80) = "haf222faff.0.......VI.___KK_____!"
p$(81) = "hhf111222h.1..........SP____CKK_!"
p$(82) = "fa333c000h.2....GO....__________!"
p$(83) = "h222fa111f.3..........___YQ_____!"
p$(84) = "h111c2223h.4.0Q....EE.MM________!"
p$(85) = "ffffa111ff.5..........______GOE_!"
p$(86) = "h333c333af.6....DD....ZF_MQ_____!"
p$(87) = "dd333f333g.7.......VI.___aI_____!"
p$(88) = "dd3333333g.8.UN.KP....______COI_!"
p$(89) = "f32233f33f.9.......ED.KK________!"
p$(90) = "ddDDCC333h.A....ZK....KO________!"
p$(91) = "f33300f33f.B..........______COH_!"
p$(92) = "h33300333c.C....NN....__________!"
p$(93) = "333311333h.D.0M....TG.GG________!"
p$(94) = "h33222333c.E.AM.......__________!"
p$(95) = "ff3111333h.F.WM.FF....___YQ_____!"

REM ******************* plansze wiersza roomy=6

p$(96) = "fffa222hhh.0....EJ....___YM_____!"
p$(97) = "hhhf000bbb.1....SJ....ML____CMO_!"
p$(98) = "h222111hhh.2..........___KM_____!"
p$(99) = "f111aaafff.3....PH....ZJ________!"
p$(100) = "h222ahhhhh.4..........EE________!"
p$(101) = "f11133222h.5.0I.......___GQ_____!"
p$(102) = "ffffff000h.6....LO....__________!"
p$(103) = "gg333d111f.7....MO....aP________!"
p$(104) = "gg333hCCCh.8.......ZN.EG____HIE_!"
p$(105) = "ffffffDDDh.9..........__________!"
p$(106) = "hh333fCCCh.A.BE.......___KI_____!"
p$(107) = "ff3333111h.B.0I....KK.aP____CKK_!"
p$(108) = "cc22dd22ff.C..........__________!"
p$(109) = "hhDDffDDhh.D.......TJ.LN________!"
p$(110) = "ccc2222hhh.E..........__________!"
p$(111) = "hhhDDDDhhh.F..........TK_KM_____!"

REM ******************* plansze wiersza roomy=7

p$(112) = "hfaa222hhh.0..........______COJ_!"
p$(113) = "bbbb000hhh.1....KK....__________!"
p$(114) = "h222111fff.2.BJ.......ZE____AIK_!"
p$(115) = "f000aaahhh.3..........___KM_____!"
p$(116) = "h000ahhhhh.4.......KF.__________!"
p$(117) = "h111hh222h.5..........KQ________!"
p$(118) = "hfffff001f.6....KO....__________!"
p$(119) = "ff33ee00hh.7..........___KO_MdE_!"
p$(120) = "hh3333002h.8.BL.......______CCQ_!"
p$(121) = "hCCCffDDDh.9..........KO________!"
p$(122) = "hDDDccCCCh.A..........___MK_____!"
p$(123) = "hf333300Df.B.AL.......__________!"
p$(124) = "ffffff00hh.C....KN....______IOI_!"
p$(125) = "hhhhhf00fh.D.......TK.__________!"
p$(126) = "h33c3300ff.E..........KK____COG_!"
p$(127) = "hhheefDDhh.F....KN....__________!"

REM ***************** n/8 plansze wiersza roomy=8

p$(128) = "hffa222hhh.0..........__________!"
p$(129) = "hbbb000hhh.1..........__________!"
p$(130) = "f222111fff.2..........__________!"
p$(131) = "h000aaahhh.3..........______COI_!"
p$(132) = "h000ahhhhh.4..........__________!"
p$(133) = "h111hh222h.5..........__________!"
p$(134) = "ffffff000f.6..........______DQK_!"
p$(135) = "hhhhha000h.7..........______ESK_!"
p$(136) = "hh3333000h.8..........______CKK_!"
p$(137) = "h33333111h.9..........__________!"
p$(138) = "h33333222h.A.BG.......__________!"
p$(139) = "ffCCff00ff.B..........______KaE_!"
p$(140) = "hfDDff00hh.C..........______JKM_!"
p$(141) = "hhhaac00fh.D..........__________!"
p$(142) = "f3333300ff.E..........______COL_!"
p$(143) = "hhheefDDhh.F..........__________!"

REM ***************** n/9 plansze wiersza roomy=9

p$(144) = "haaa222ffh.0....SD....______COH_!"
p$(145) = "hbbb000hhh.1.......DK.__________!"
p$(146) = "f222111hhh.2..........KK________!"
p$(147) = "h000aaahhh.3..........______IOJ_!"
p$(148) = "h000ahhhhh.4....KH....__________!"
p$(149) = "h111hhhhhh.5..........__________!"
p$(150) = "ffffaa222h.6.......ZK.______HEM_!"
p$(151) = "hhaaaa000h.7..........__________!"
p$(152) = "hh3333000h.8..........KK________!"
p$(153) = "h33333111h.9....SD....______GOK_!"
p$(154) = "h33333222h.A..........______FGH_!"
p$(155) = "ffCCff00Dh.B..........__________!"
p$(156) = "hfDDff00hh.C.......SK.__________!"
p$(157) = "hhhaac00fh.D....KK....______DYK_!"
p$(158) = "f3333300hh.E..........KK____ECI_!"
p$(159) = "hhheefDDhh.F.......DK.______BCD_!"

REM tablica serc
FOR xr = 0 TO 15
FOR yr = 0 TO 9
s = xr + yr * 16
znak$ = MID$(p$(s), 23, 1)
IF znak$ <> "_" THEN serca(xr, yr) = 1
NEXT yr: NEXT xr

REM tablica wind
pozycjewind(1) = 0
pozycjewind(2) = 4
pozycjewind(3) = 7
END SUB

SUB rysowanie

FOR yw = 0 TO 9
el$ = MID$(kod$, yw + 1, 1)
y16 = yw * 18

REM tymczasowe sygnalizacje bledow:

IF el$ = "Q" OR el$ = "L" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "P" OR el$ = "W" OR el$ = "=" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "A" OR el$ = "B" OR el$ = "U" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "@" THEN COLOR 15: LINE (0, y16)-(200, y16)

REM elementy uzupelniajace

IF el$ = "C" THEN
PUT (128, y16), szaretlo4, PSET: PUT (192, y16), szaretlo4, PSET
PUT (256, y16), szaretlo4, PSET
PUT (0, y16), blok4, PSET: PUT (64, y16), blok2, PSET:
PUT (96, y16), bloks, PSET: PUT (112, y16), blokk, PSET
END IF

IF el$ = "D" THEN
PUT (0, y16), szaretlo4, PSET: PUT (64, y16), szaretlo4, PSET
PUT (128, y16), szaretlo4, PSET
PUT (192, y16), blokp, PSET: PUT (208, y16), blok4, PSET
PUT (272, y16), blok2, PSET: PUT (304, y16), bloks, PSET
END IF

REM czesc automatyczna, znaki a-h
ascii = ASC(el$)

IF ascii > 96 THEN
bity = ascii - 97
PUT (0, y16), blok4, PSET:
pop1 = 0
pop2 = 0
pop3 = 0

IF (bity AND 4) = 4 THEN PUT (64, y16), blok4, PSET: pop1 = 1
IF (bity AND 4) = 0 THEN PUT (48, y16), blokk, PSET: PUT (64, y16), szaretlo4, PSET: pop1 = 0
REM
IF (bity AND 2) = 2 THEN pop2 = 1: PUT (128, y16), blok4, PSET: IF pop1 = 0 THEN PUT (128, y16), blokp, PSET
IF (bity AND 2) = 0 THEN pop2 = 0: PUT (128, y16), szaretlo4, PSET: IF pop1 = 1 THEN PUT (112, y16), blokk, PSET
REM
IF (bity AND 1) = 1 THEN pop3 = 1: PUT (192, y16), blok4, PSET: IF pop2 = 0 THEN PUT (192, y16), blokp, PSET
IF (bity AND 1) = 0 THEN pop3 = 0: PUT (192, y16), szaretlo4, PSET: IF pop2 = 1 THEN PUT (176, y16), blokk, PSET
PUT (256, y16), blok4, PSET
IF pop3 = 0 THEN PUT (256, y16), blokp, PSET
END IF

REM znaki 0-3

IF ascii < 58 THEN
bity = ascii - 48
IF (bity AND 2) = 2 THEN PUT (0, y16), blokk, PSET
IF (bity AND 2) = 0 THEN PUT (0, y16), szaretlo, PSET
PUT (16, y16), szaretlo4, PSET
PUT (80, y16), szaretlo4, PSET
PUT (144, y16), szaretlo4, PSET
PUT (208, y16), szaretlo4, PSET
PUT (272, y16), szaretlo2, PSET

IF (bity AND 1) = 1 THEN PUT (304, y16), blokp, PSET
IF (bity AND 1) = 0 THEN PUT (304, y16), szaretlo, PSET
END IF

NEXT yw

REM rysowanie podestow

el$ = MID$(kod$, 14, 1)
IF el$ = "" OR el$ = "." THEN GOTO dodatek

el2$ = MID$(kod$, 15, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "#" THEN PUT (0, yo), ceg40, PSET
IF el$ = "W" THEN PUT (0, yo), ceg4plus20plus4, PSET
IF el$ = "U" THEN PUT (0, yo), ceg17plus17, PSET
IF el$ = "0" THEN PUT (0, yo), ceg13plus13, PSET
IF el$ = "A" THEN FOR xx = 0 TO 4: PUT (16 + xx * 64, yo), ceg2, PSET: NEXT xx
IF el$ = "B" THEN FOR xx = 0 TO 5: PUT (64 + xx * 32, yo), ceg2, PSET: NEXT xx

REM dodatkowy element
dodatek:

el$ = MID$(kod$, 29, 1)
IF el$ = "" OR el$ = "_" THEN GOTO okna
el2$ = MID$(kod$, 30, 1)
xo = (ASC(el2$) - 65) * 8
el2$ = MID$(kod$, 31, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "A" THEN
PUT (xo, yo), blokp, PSET:
PUT (xo, yo + 18), blokp, PSET
PUT (xo + 16, yo), blok2, PSET:
PUT (xo + 16, yo + 18), blok2, PSET
PUT (xo + 48, yo), blokk, PSET:
PUT (xo + 48, yo + 18), blokk, PSET
END IF

IF el$ = "B" THEN COLOR 235: LINE (xo + 5, yo)-(xo + 9, yo + 35), , BF
IF el$ = "C" THEN PUT (xo, yo), ceg2, PSET: PUT (xo + 32, yo), ceg2, PSET: PUT (xo + 64, yo), ceg2, PSET
IF el$ = "D" THEN LINE (xo, yo)-(xo + 22, yo + 17), 235, BF: LINE (xo + 42, yo)-(xo + 63, yo + 17), 235, BF
IF el$ = "E" THEN LINE (xo, yo)-(xo + 5, yo + 35), 235, BF: LINE (xo + 26, yo + 36)-(xo + 31, yo + 72), 235, BF
REM niebieskie klocki
IF el$ = "F" THEN PUT (xo, yo), nieb, PSET
IF el$ = "G" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo), nieb, PSET
IF el$ = "H" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo + 36), nieb, PSET
IF el$ = "I" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo - 36), nieb, PSET
REM jednokierunkowe bramki
IF el$ = "J" THEN PSET (xo - 2, yo), 199: DRAW "R18 D35 L18 U35 F18 U1 G18"
IF el$ = "K" THEN PSET (xo - 2, yo), 198: DRAW "R18 D35 L18 U35 R18 G18 U1 F18"
REM zaslonka
IF el$ = "L" THEN LINE (xo, yo)-(xo + 15, yo + 35), 255, BF
REM winda
xwindy = -10: ywindy = -10
IF el$ = "M" THEN
LINE (xo, yo)-(xo + 23, yo + 35), 10, BF
LINE (xo, yo)-(xo, yo + 36), 6, BF
LINE (xo, yo)-(xo + 23, yo), 6, BF
LINE (xo + 3, yo + 7)-(xo + 5, yo + 18), 14, BF
LINE (xo + 1, yo)-(xo + 23, yo), 9
REM LINE (xo + 20, yo + 1)-(xo + 22, yo + 1), 9
PSET (xo + 4, yo + 9), 12
PSET (xo + 4, yo + 11), 5
PSET (xo + 4, yo + 13), 5
PSET (xo + 4, yo + 15), 5
PSET (xo + 4, yo + 17), 5
xwindy = xo: ywindy = yo: winda = 1
COLOR 8: LOCATE (ywindy / 8) + 2, 34
IF roomy = 0 THEN PRINT "1"
IF roomy = 4 THEN PRINT "2"
IF roomy = 7 THEN PRINT "3"

END IF

okna:

REM rysowanie okien

el$ = MID$(kod$, 17, 1)
IF el$ = "" OR el$ = "." THEN GOTO serce
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 18, 1)
yo = (ASC(el$) - 65) * 9
IF roomy < 2 THEN PUT (xo, yo), window2, PSET
IF roomy > 1 AND roomy < 5 THEN PUT (xo, yo), window1, PSET
IF roomy > 4 THEN PUT (xo, yo), window3, PSET

serce:
REM serce
xserca = -20
yserca = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 23, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xserca = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 24, 1)
yserca = (ASC(el$) - 65) * 9
GET (xserca, yserca)-(xserca + 15, yserca + 7), tlo
COLOR 5
LINE (xserca, yserca + 1)-(xserca, yserca + 3)
LINE (xserca + 1, yserca)-(xserca + 1, yserca + 4)
LINE (xserca + 2, yserca)-(xserca + 2, yserca + 5)
LINE (xserca + 3, yserca + 1)-(xserca + 3, yserca + 6)
LINE (xserca + 4, yserca)-(xserca + 4, yserca + 5)
LINE (xserca + 5, yserca)-(xserca + 5, yserca + 4)
LINE (xserca + 6, yserca + 1)-(xserca + 6, yserca + 3)

donica:
el$ = MID$(kod$, 26, 1)
IF el$ = "" OR el$ = "_" THEN GOTO wentyl
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 27, 1)
yo = (ASC(el$) - 65) * 9 + 2
PUT (xo, yo), palma, PSET

wentyl:
el$ = MID$(kod$, 20, 1)
IF el$ = "" OR el$ = "." THEN GOTO koniecrysowania
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 21, 1)
yo = (ASC(el$) - 65) * 9
PUT (xo, yo), wentylator, PSET

koniecrysowania:

LOCATE 24, 2: COLOR 15: PRINT "Czas:"; licz;

END SUB

SUB zabranie
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)

OUT 66, 32: OUT 66, 3
FOR i = 1 TO 6000: NEXT i

OUT 66, 204: OUT 66, 4
FOR i = 1 TO 6000: NEXT i

t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port

END SUB

Piotr-246 · Gość

DECLARE SUB zabranie ()

REM Gra "Serca" UWAGA wersaj gry wymaga
REM emulatora o predkosci 6075 cyklow
REM wymaga pliku bitmap1.scr utworzonego przez modul bsave.bas

DECLARE SUB dreptanie ()
DECLARE SUB animacja ()
DECLARE SUB rysowanie ()
DECLARE SUB palety ()
DECLARE SUB plansze ()
DECLARE SUB cegly ()

REM plansza startowa:
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
roomx = 7: roomy = 4

DIM SHARED kolor$(0 TO 255)
DIM pamiec(0 TO 128) AS LONG
DIM poledzialania(0 TO 240) AS LONG
DIM SHARED pozycjewind(1 TO 3) AS INTEGER
DIM SHARED p$(0 TO 159)
DIM SHARED kod$
DIM SHARED serca(0 TO 15, 0 TO 9) AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED xwindy AS INTEGER, ywindy AS INTEGER

REM pamiec tla pod wziatek

DIM SHARED tlo(0 TO 32) AS LONG

REM tlo

DIM SHARED szaretlo(0 TO 74) AS LONG
DIM SHARED szaretlo2(0 TO 148) AS LONG
DIM SHARED szaretlo4(0 TO 300) AS LONG
REM dane elementow planszy

DIM SHARED ceg2(0 TO 75) AS LONG
DIM SHARED ceg40(0 TO 730) AS LONG
DIM SHARED ceg17plus17(0 TO 730) AS LONG
DIM SHARED ceg13plus13(0 TO 760) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 750) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED nieb(0 TO 145) AS LONG

DIM SHARED blokp(0 TO 74) AS LONG
DIM SHARED bloks(0 TO 74) AS LONG
DIM SHARED blokk(0 TO 74) AS LONG
DIM SHARED blok2(0 TO 158) AS LONG
DIM SHARED blok4(0 TO 296) AS LONG

REM ****************** DANE ANIMACJI

DIM SHARED znakp1(0 TO 128) AS LONG
DIM SHARED znakl1(0 TO 128) AS LONG
DIM SHARED znakp2(0 TO 128) AS LONG
DIM SHARED znakl2(0 TO 128) AS LONG
DIM SHARED znakp3(0 TO 128) AS LONG
DIM SHARED znakl3(0 TO 128) AS LONG
DIM SHARED vertd1(0 TO 128) AS LONG

REM matryce okien

DIM SHARED window1(0 TO 160) AS LONG
DIM SHARED window2(0 TO 160) AS LONG
DIM SHARED window3(0 TO 160) AS LONG

DIM SHARED wentylator(0 TO 64) AS LONG

REM ************************* DANE STARTOWE

SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci

x = 200: y = 35: xs = 200: ys = 35: REM wspol. pocz. gracza na ekr.
licz = -1: REM wartosc start. zegara
kolwent = 30 + 30 * 256 + 30 * 65536: REM kolor lopat wentylatora

REM ***** SUB palety - ustawienie nowych wartosci barw
palety

REM ***** SUB cegly - zapelnienie pozostalych tablic
cegly

REM SUB plansze - wypelnienie tablicy wygladu plansz
plansze

REM ************************* START POMIESZCZENIA

rysuj:

kod$ = p$(roomx + roomy * 16)

REM ******************** rysowanie pomieszczenia
t0 = PEEK(1132): REM pomiar czasu rysowania

REM SUB rysowanie - rysowanie planszy
rysowanie

IF przejechal = 1 THEN y = ywindy + 3: ys = ywindy + 3: przejechal = 0

REM pomiar czasu rysowania
t1 = PEEK(1132):

REM menu na dole
LINE (0, 180)-(319, 182), 234, BF
LOCATE 25, 15: PRINT "L-SHIFT ALT P-SHIFT";
LOCATE 24, 2: COLOR 3: PRINT "T:"; t0; "/"; t1; FRE(-2);
PRINT " ROOM:"; roomx; "/"; roomy; "--";

REM **************** zapamietanie pola pod graczem
GET (x, y)-(x + 15, y + 31), pamiec
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
REM PUT (x, y), vertd1, PSET
liczsercaroom = 0: zrobione = 0
GOTO postaw
REM *************************** PETLA GLOWNA

petla:
dx = 0: dy = 0
IF dzwiekbrania = 1 THEN dzwiekbrania = 0: zabranie

REM ******************* czas gry w sekundach

se$ = MID$(TIME$, 7, 2)
se = VAL(se$)
IF se <> ses THEN licz = licz + 1
ses = se
LOCATE 25, 2: COLOR 15: PRINT "Czas:"; licz;

REM ************************ petla opozniajaca
FOR delay = 1 TO 700: NEXT delay

REM faza wentylatora

komorka = PEEK(1132) / 1.5
faz = INT(komorka)
IF faz / 3 = INT(faz / 3) THEN faza = 0
IF (faz + 1) / 3 = INT((faz + 1) / 3) THEN faza = 1
IF (faz + 2) / 3 = INT((faz + 2) / 3) THEN faza = 2
FOR i = 0 TO 2: i16 = i * 16
IF faza = 0 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, 0
IF faza = 1 THEN PALETTE 11 + i16, 0: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, kolwent
IF faza = 2 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, 0: PALETTE 13 + i16, kolwent
NEXT i

REM ************************ sprawdzenie klawiszy

alt = 0: lshift = 0: pshift = 0: skos = 0

k$ = INKEY$
IF k$ = "f" THEN roomx = roomx - 1: GOTO rysuj
IF k$ = "h" THEN roomx = roomx + 1: GOTO rysuj
IF k$ = "t" THEN roomy = roomy - 1: GOTO rysuj
IF k$ = "b" THEN roomy = roomy + 1: GOTO rysuj
IF k$ = CHR$(27) THEN END

IF x >= xwindy AND y - ywindy < 10 THEN
IF k$ = "1" OR k$ = "2" THEN GOSUB przejazd: GOTO rysuj
IF k$ = "3" THEN GOSUB przejazd: GOTO rysuj
END IF

REM klawisz alt - wznoszenie sie
IF (PEEK(1047) AND 8) = 8 THEN alt = 1
IF (PEEK(1047) AND 2) = 2 THEN lshift = 1
IF (PEEK(1047) AND 1) = 1 THEN pshift = 1

REM bezruch = grawitacja
IF lshift = 0 AND pshift = 0 AND alt = 0 THEN dy = 2: vert = 1: obrot = 0: przebiervert = 0: GOTO czy

POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury

IF lshift = 1 THEN dx = -4: dy = 2: obrot = -1: vert = 0
IF pshift = 1 THEN dx = 4: dy = 2: obrot = 1: vert = 0
IF alt = 1 THEN dy = -4: vert = 1
IF dx <> 0 AND dy <> 0 THEN skos = 1
czy:

REM ************ sprawdzenie czy jest przejscie do innej planszy

IF x + dx > 300 THEN x = 5: xs = 5: roomx = roomx + 1: GOTO rysuj
IF x + dx < 3 THEN x = 300: xs = 300: roomx = roomx - 1: GOTO rysuj
IF y + dy > 144 THEN y = 5: ys = 5: roomy = roomy + 1: GOTO rysuj
IF y + dy < 4 THEN y = 145: ys = 145: roomy = roomy - 1: GOTO rysuj

REM *********** sprawdzenie czy ruch jest mozliwy
REM sprawdzenie przeszkody. Przeszkoda sa kolory > 200

xmozliwy = 0: xniemozliwy = 0
ymozliwy = 0: yniemozliwy = 0

REM sprawdzenie sasiedztwa obok

IF dx > 0 THEN
FOR i = 0 TO 31: punkt = POINT(x + 19, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 198 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF

IF dx < 0 THEN
FOR i = 0 TO 31: punkt = POINT(x - 3, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 199 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF xniemozliwy = 0 THEN xmozliwy = 1
IF xniemozliwy = 1 THEN xmozliwy = 0

REM sprawdzenie sasiedztwa gora dol

IF dy > 0 THEN
FOR i = 0 TO 15:
IF POINT(x + i, y + 32) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y + 33) > 200 THEN yniemozliwy = 1: EXIT FOR

NEXT i
END IF

IF dy < 0 THEN
FOR i = 0 TO 15
IF POINT(x + i, y - 4) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y - 5) > 200 THEN yniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF yniemozliwy = 0 THEN ymozliwy = 1
IF yniemozliwy = 1 THEN ymozliwy = 0

REM ruch gdy oba mozliwe x oraz y
IF ymozliwy = 1 AND xmozliwy = 1 THEN IF dx <> 0 OR dy <> 0 THEN GOTO ruch

REM szczegolne przypadki gdy tylko x albo y mozliwy
IF ymozliwy = 0 AND xmozliwy = 1 THEN dy = 0: GOTO czy
IF ymozliwy = 1 AND xmozliwy = 0 THEN dx = 0: GOTO czy

REM ruch niemozliwy powrot petli glownej bez zmian pozostaja x y

x = xs: y = ys
GOTO petla

REM ***************** RUCH

ruch:

x = x + dx: y = y + dy
IF dy = 0 AND przebieranie = 0 AND alt = 0 THEN dreptanie: REM dzwiek chodzenia

REM ******************** czy jest wziatek
deltawx = ABS(x + 4 - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek

REM ************************************** operacja odswiezania tla
postaw:
REM punkt 1 zapamietanie nowego pola dzialania (brudnego)
REM w oparciu o nowe x,y

GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania

REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo

deltax = x - xs: deltay = y - ys
inversx = -1 * deltax: inversy = -1 * deltay
inver4 = INT(inversx / 4)
FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = (yt + inversy) * 6
FOR xt = 0 TO 3
index1 = 1 + (yt6 + 24) + (xt + inver4) + 1
index2 = 1 + yt4 + xt
poledzialania(index1) = pamiec(index2)
NEXT xt: NEXT yt

REM zmazanie serca z pola dzialania

IF liczsercaroom = 1 AND zrobione = 0 THEN
zrobione = 1
PUT (x - 4, y - 4), poledzialania, PSET
PUT (xserca, yserca), tlo, PSET
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
END IF

REM nowa mala pamiec

FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = yt * 6
FOR xt = 0 TO 3:
index1 = 1 + (yt6 + 24) + (xt + 1):
index2 = 1 + yt4 + xt:
pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt

REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU

REM aby nie rysowac dwoch postaci w przypadku skosu
IF skos = 1 THEN GOTO bezskosu:

REM ************************** ruch w dol lub gore

IF vert = 1 THEN wkleic = 7: GOTO wklej
bezskosu:
REM ************************** ruch w lewo

IF obrot = -1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1
IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 1: GOTO wklej
IF przebieranie = 1 THEN wkleic = 2: GOTO wklej
IF przebieranie = 2 THEN wkleic = 3: GOTO wklej
END IF

REM ****************** ruch w prawo

IF obrot = 1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1

IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 4: GOTO wklej
IF przebieranie = 1 THEN wkleic = 5: GOTO wklej
IF przebieranie = 2 THEN wkleic = 6: GOTO wklej
END IF

xs = x: ys = y

GOTO petla

wklej:

IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt
IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt
IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt
IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt
IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt
IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt
IF wkleic = 7 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)): NEXT xt: NEXT yt

REM wklejenie wyniku operacji na tablicy:
PUT (x - 4, y - 4), poledzialania, PSET

xs = x: ys = y
GOTO petla

REM GOSUB-RETURN****************************** obsluga wziatku

wziatek:
IF serca(roomx, roomy) = 0 THEN GOTO niemawziatku
IF liczsercaroom = 1 THEN GOTO niemawziatku
serca(roomx, roomy) = 0
liczserca = liczserca + 1
PUT (xserca, yserca), tlo, PSET

liczsercaroom = 1
dzwiekbrania = 1

LOCATE 1, 1: COLOR 6: PRINT liczserca;
niemawziatku:
RETURN

REM GOSUB-RETURN przejazd:
przejazd:
pietro = VAL(k$)
roomy = pozycjewind(pietro)

FOR i = 23 TO 0 STEP -1
LINE (xwindy + i, ywindy)-(xwindy + i, ywindy + 35), 255
FOR j = 1 TO 10000: NEXT j
NEXT i
CLS
FOR i = 1 TO 30000: NEXT i
przejechal = 1
RETURN

SUB cegly

BLOAD "bitmap1.scr"

REM INPUT a$
REM pobranie z ekranu tablic elementow
REM uwaga! wysokosc elementu to 9 lub 18 px

GET (0, 0)-(31, 8), ceg2
GET (0, 0)-(319, 8), ceg40
GET (0, 9)-(319, 17), ceg17plus17
GET (0, 18)-(319, 26), ceg13plus13
GET (0, 27)-(319, 35), ceg4plus20plus4
GET (0, 36)-(15, 53), szaretlo
GET (0, 36)-(31, 53), szaretlo2
GET (0, 36)-(63, 53), szaretlo4: REM 36+18=46+8=54

GET (16, 64)-(31, 79), palma
GET (32, 64)-(47, 81), blokp
GET (48, 64)-(63, 81), bloks
GET (64, 64)-(79, 81), blokk
GET (0, 156)-(31, 173), blok2
GET (0, 156)-(63, 173), blok4
GET (80, 64)-(111, 81), nieb

GET (0, 88)-(15, 119), znakl1
GET (16, 88)-(31, 119), znakp1
GET (32, 88)-(47, 119), znakl2
GET (48, 88)-(63, 119), znakp2
GET (64, 88)-(79, 119), znakl3
GET (80, 88)-(95, 119), znakp3
GET (96, 88)-(111, 119), vertd1

GET (0, 120)-(31, 139), window1
GET (32, 120)-(63, 139), window2
GET (64, 120)-(95, 139), window3
GET (0, 140)-(15, 155), wentylator
CLS
END SUB

SUB dreptanie

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)

REM ewentualnie:
REM OUT 66, 30: OUT 66, 0
REM OUT 66, 164: OUT 66, 2
REM OUT 66, 130: OUT 66, 1
REM OUT 66, 74: OUT 66, 0
REM OUT 66, 220: OUT 66, 1

FOR i = 1 TO 10
OUT 66, 30: OUT 66, 0
OUT 66, 84: OUT 66, 2
OUT 66, 30: OUT 66, 0
OUT 66, 94: OUT 66, 2
OUT 66, 10: OUT 66, 0
OUT 66, 40: OUT 66, 2
OUT 66, 84: OUT 66, 0
OUT 66, 10: 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 palety

REM palety kolorow *********************************
REM max koloru=3F

FOR i = 0 TO 255: kolor$(i) = "00 00 00 00"
PALETTE i, 31 + 31 * 256 + 31 * 65536: NEXT i

REM kolory za ludzikiem

kolor$(0) = "00 00 00 00": REM rejestr zero- wolny
kolor$(1) = "01 05 05 06": REM tlo plyta
kolor$(2) = "02 02 03 02": REM tlo fuga
kolor$(3) = "03 07 06 06": REM tlo krawedz
kolor$(4) = "04 00 22 00": REM liscie
kolor$(5) = "05 3F 08 00": REM serce
kolor$(6) = "06 30 30 30": REM framuga okna
kolor$(7) = "07 28 0A 00": REM doniczka drzewa
kolor$(8) = "08 00 21 39": REM niebo
kolor$(9) = "09 3F 3F 00": REM slonce
kolor$(10) = "0A 14 14 14": REM framuga zewnetrzna
kolor$(11) = "0B 00 00 00": REM wentylator faza 1
kolor$(12) = "0C 00 00 00": REM wentylator faza 2
kolor$(13) = "0D 00 00 00": REM wentylator faza 3
kolor$(14) = "0E 20 20 20": REM srednia szarosc
kolor$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza

REM rejestry przezroczyste gracza
kolor$(16) = "10 18 02 02": REM sweter + zero
kolor$(17) = "11 18 02 02": REM
kolor$(18) = "12 18 02 02": REM
kolor$(19) = "13 18 02 02": REM
kolor$(20) = "14 22 12 00": REM sweter + liscie
kolor$(21) = "15 3F 00 00": REM
kolor$(22) = "16 2F 09 09": REM sweter + framuga okna
kolor$(23) = "17 2B 08 00": REM sweter + doniczka drzewa
kolor$(24) = "18 25 16 24": REM sweter + niebo
kolor$(25) = "19 3F 3F 3F": REM sweter + slonce
kolor$(26) = "1A 16 0F 0F": REM sweter + framuga zew
kolor$(27) = "1B 3F 3F 3F": REM
kolor$(28) = "1C 3F 3F 3F": REM
kolor$(29) = "1D 3F 3F 3F": REM
kolor$(30) = "1E 20 10 10": REM sweter + przyciski
REM kolor 31 (1F) zastrzezony dla gracza
kolor$(32) = "20 0A 13 29": REM spodnie + zero
kolor$(33) = "21 0A 13 29": REM
kolor$(34) = "22 0A 13 29": REM
kolor$(35) = "23 0A 13 29": REM
kolor$(36) = "24 05 1D 24": REM spodnie+ liscie
kolor$(37) = "25 3F 3F 3F": REM
kolor$(38) = "26 1B 1B 32": REM spodnie + framuga okna
kolor$(39) = "27 1A 10 3F": REM spodnie + doniczka
kolor$(40) = "28 00 1A 3F": REM spodnie + niebo
kolor$(41) = "29 3F 3F 3F": REM spodnie +slonce
kolor$(42) = "2A 10 14 20": REM spodnie + framuga zew
kolor$(43) = "2B 3F 3F 3F": REM
kolor$(44) = "2C 3F 3F 3F": REM
kolor$(45) = "2D 3F 3F 3F": REM
kolor$(46) = "2E 3F 3F 3F": REM
REM rejestr 47 (2F) zastrzezony dla gracza

REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF)
REM rejestry nieprzezroczyste

kolor$(31) = "1F 2F 09 09": REM sweter
kolor$(47) = "2F 0D 1A 37": REM spodnie
kolor$(63) = "3F 1A 1A 1A": REM wlosy i buty
kolor$(79) = "4F 10 10 10": REM pasek2
kolor$(95) = "5F 3F 2F 0F":
kolor$(111) = "6F 3F 30 20": REM skora1
REM kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych
kolor$(143) = "8F 32 22 02": REM nos
REM kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych
REM kolor$(175) = "AF 22 02 02": REM sweter3
kolor$(191) = "BF 20 20 20": REM pasek
kolor$(207) = "CF 37 27 06": REM usta
REM FF- zarezerwowany dla przeslony

REM rejestry jednokierunkowe
kolor$(198) = "C6 20 20 20"
kolor$(199) = "C7 20 20 20"

REM bloczek

kolor$(224) = "E0 00 00 00": REM
kolor$(225) = "E1 04 04 04": REM
kolor$(226) = "E2 08 08 08": REM
kolor$(227) = "E3 0B 0B 0B": REM
kolor$(228) = "E4 10 10 10": REM
kolor$(229) = "E5 14 14 14": REM
kolor$(230) = "E6 18 18 18": REM
kolor$(231) = "E7 1B 1B 1B": REM
kolor$(232) = "E8 20 20 20": REM
kolor$(233) = "E9 24 24 24": REM
kolor$(234) = "EA 28 28 28": REM
kolor$(235) = "EB 2B 2B 2B": REM
kolor$(236) = "EC 30 30 30": REM
kolor$(237) = "ED 34 34 34": REM
kolor$(238) = "EE 38 38 38": REM
kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika

REM kolor 240 - przeslona
kolor$(240) = "F0 38 38 38"

REM cegly male niebieskie

kolor$(249) = "F9 22 27 30": REM krawedz
kolor$(250) = "FA 09 0E 14": REM fuga
kolor$(251) = "FB 11 17 1F": REM cegla

REM cegly male czerwone

kolor$(252) = "FC 30 27 27": REM krawedz
kolor$(253) = "FD 14 0E 0E": REM fuga
kolor$(254) = "FE 1F 17 17": REM cegla
kolor$(255) = "FF 28 28 28": REM przeslona

FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2)
red$ = "&H" + MID$(kolor$(i), 4, 2)
gre$ = "&H" + MID$(kolor$(i), 7, 2)
blu$ = "&H" + MID$(kolor$(i), 10, 2)
REM PRINT rej$; " "; red$; " "; gre$; " "; blu$
rej = VAL(rej$)
red = VAL(red$)
gre = VAL(gre$)
blu = VAL(blu$)
REM PRINT rej; " "; red; " "; gre; " "; blu

PALETTE rej, red + gre * 256 + blu * 65536
NEXT i

END SUB

SUB plansze

REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** roomy*16+roomx

REM kody plansz +++nr.po.ok.we.se_kw_dod
REM ************ plansze wiersza roomy=0

p$(0) = "h22233322d.0.UI.YO....GN________!"
p$(1) = "h000fff11h.1....MD....__________!"
p$(2) = "h11133333f.2.UI.HE....___EQ_____!"
p$(3) = "hh2223cchh.3..........SJ________!"
p$(4) = "h300033fff.4....ZK....__________!"
p$(5) = "h2001c333f.5....LG....______AQG_!"
p$(6) = "h111g3322f.6....LD....___EQ_F[Q_!"
p$(7) = "hh222ff11d.7.BE.......aH_ZI_MdO_!"
p$(8) = "hhDDDfCCCg.8..........__________!"
p$(9) = "hhhhhf111c.9..........__________!"
p$(10) = "hhhhhf222g.A..........GG_EQ_____!"
p$(11) = "hh333f111d.B....HG....__________!"
p$(12) = "hhffff333g.C..........__________!"
p$(13) = "h22233333c.D.UN.aK.DF.MK____AYC_!"
p$(14) = "h111ff22hh.E..........___aG_BLM_!"
p$(15) = "h3333311cc.F....ZK....aH____AIG_!"

REM ************ plansze wiersza roomy=1

p$(16) = "d333c2223h.0.......FN.__________!"
p$(17) = "h33330003h.1.WH.SO....dE____COM_!"
p$(18) = "ff333111ff.2.WJ.ML....__________!"
p$(19) = "hc222c333c.3..........___QQ_____!"
p$(20) = "f31113333h.4.UM.aI.aO.__________!"
p$(21) = "f333aa333h.5..........RN_GQ_____!"
p$(22) = "ffff333fff.6....DJ....aM____G[M_!"
p$(23) = "dd333a33hh.7..........__________!"
p$(24) = "gg333333ff.8.AK....IF.__________!"
p$(25) = "cc3322333c.9.WM.......eF________!"
p$(26) = "gg331133hh.A....LF....aO________!"
p$(27) = "ddaa22cccc.B..........__________!"
p$(28) = "g33300333h.C.AM....aO.__________!"
p$(29) = "c33311333c.D.0M.......ZK____AQO_!"
p$(30) = "h3322233dd.E.BE....aF.__________!"
p$(31) = "c33111333h.F.AM.bD....___QQ_COH_!"

REM ************* plansze wiersza roomy=2

p$(32) = "h333ff333c.0..........KE_WQ_____!"
p$(33) = "h33332222c.1....KD....UP____CGI_!"
p$(34) = "faaaa0000h.2....WO.VI.__________!"
p$(35) = "ccccc1111f.3....MM....___EQ_____!"
p$(36) = "h33333223h.4.WI.FP....SM________!"
p$(37) = "haa33200af.5.UJ....GL.______HIE_!"
p$(38) = "f333c111ah.6....aM....UP________!"
p$(39) = "hh333d333g.7....YP....___KQ_____!"
p$(40) = "ff3333333g.8.#I.......KK____CGN_!"
p$(41) = "c33g33d33c.9..........__________!"
p$(42) = "hh3333333g.A.WM.LI....__________!"
p$(43) = "cc333322cc.B.UJ.......__________!"
p$(44) = "hhaacc00hh.C.BE....JG.ZM____AQM_!"
p$(45) = "c333cc11gg.D....aN....______AQM_!"
p$(46) = "dd33cc22hh.E..........______AQE_!"
p$(47) = "hh3331113c.F.UK....VI.___EQ_____!"

REM ************ plansze wiersza roomy=3

p$(48) = "c33332222f.0....ZM.ZD.SF____COI_!"
p$(49) = "ccccc1111h.1..........__________!"
p$(50) = "ha3222333c.2.#F.LO....UO_SQ_____!"
p$(51) = "ff3111333f.3.WM.YI.VI.SJ_GQ_____!"
p$(52) = "h3333c333f.4..........NG____CKK_!"
p$(53) = "ff333c222f.5....ZO....SG________!"
p$(54) = "hhaaff000f.6.BE.......___KQ_____!"
p$(55) = "gggg33111f.7....LO.VJ.______IYM_!"
p$(56) = "gg3322ffff.8..........GG________!"
p$(57) = "cccc00hfff.9..........__________!"
p$(58) = "gg33DDffff.A..........___KK_CCH_!"
p$(59) = "cccccfffff.B.......TL.__________!"
p$(60) = "hh3333333f.C....KK....DP________!"
p$(61) = "g333333hhh.D.UJ....TF.______CKK_!"
p$(62) = "hh3222333f.E..........___GQ_____!"
p$(63) = "c331113hhh.F....ZK....__________!"

REM ****************** plansze wiersza roomy=4

p$(64) = "f22322322h.0....DD....SP_YQ_CKK_!"
p$(65) = "h00f00f00h.1..........__________!"
p$(66) = "c11311311f.2....aP.KP.__________!"
p$(67) = "ff3332223h.3.UJ.ML....___YQ_____!"
p$(68) = "f3333111hh.4.WJ.YL....__________!"
p$(69) = "ffaafaaaff.5.......VI.__________!"
p$(70) = "ffa333c33h.6....OG....SQ_YQ_____!"
p$(71) = "ff223c33cd.7....SN....GN_TI_MdM_!": REM startowa
p$(72) = "ff113cc33d.8..........MO____JVO_!"
p$(73) = "ff33cc33ff.9..........______COI_!"
p$(74) = "ff3333333d.A.WM.LI.ZP.PP________!"
p$(75) = "ff2233333f.B.UM.......___EQ_____!"
p$(76) = "ff11333hhh.C.......KH.__________!"
p$(77) = "h333333333.D.BE.SK....bF____CKK_!"
p$(78) = "ff22233hhh.E.UJ.......______FEE_!"
p$(79) = "h311133fff.F.WJ.......MM________!"

REM ******************* plansze wiersza roomy=5

p$(80) = "haf222faff.0.......VI.___KK_____!"
p$(81) = "hhf111222h.1..........SP____CKK_!"
p$(82) = "fa333c000h.2....GO....__________!"
p$(83) = "h222fa111f.3..........___YQ_____!"
p$(84) = "h111c2223h.4.0Q....EE.MM________!"
p$(85) = "ffffa111ff.5..........______GOE_!"
p$(86) = "h333c333af.6....DD....ZF_MQ_____!"
p$(87) = "dd333f333g.7.......VI.___aI_____!"
p$(88) = "dd3333333g.8.UN.KP....______COI_!"
p$(89) = "f32233f33f.9.......ED.KK________!"
p$(90) = "ddDDCC333h.A....ZK....KO________!"
p$(91) = "f33300f33f.B..........______COH_!"
p$(92) = "h33300333c.C....NN....__________!"
p$(93) = "333311333h.D.0M....TG.GG________!"
p$(94) = "h33222333c.E.AM.......__________!"
p$(95) = "ff3111333h.F.WM.FF....___YQ_____!"

REM ******************* plansze wiersza roomy=6

p$(96) = "fffa222hhh.0....EJ....___YM_____!"
p$(97) = "hhhf000bbb.1....SJ....ML____CMO_!"
p$(98) = "h222111hhh.2..........___KM_____!"
p$(99) = "f111aaafff.3....PH....ZJ________!"
p$(100) = "h222ahhhhh.4..........EE________!"
p$(101) = "f11133222h.5.0I.......___GQ_____!"
p$(102) = "ffffff000h.6....LO....__________!"
p$(103) = "gg333d111f.7....MO....aP________!"
p$(104) = "gg333hCCCh.8.......ZN.EG____HIE_!"
p$(105) = "ffffffDDDh.9..........__________!"
p$(106) = "hh333fCCCh.A.BE.......___KI_____!"
p$(107) = "ff3333111h.B.0I....KK.aP____CKK_!"
p$(108) = "cc22dd22ff.C..........__________!"
p$(109) = "hhDDffDDhh.D.......TJ.LN________!"
p$(110) = "ccc2222hhh.E..........__________!"
p$(111) = "hhhDDDDhhh.F..........TK_KM_____!"

REM ******************* plansze wiersza roomy=7

p$(112) = "hfaa222hhh.0..........______COJ_!"
p$(113) = "bbbb000hhh.1....KK....__________!"
p$(114) = "h222111fff.2.BJ.......ZE____AIK_!"
p$(115) = "f000aaahhh.3..........___KM_____!"
p$(116) = "h000ahhhhh.4.......KF.__________!"
p$(117) = "h111hh222h.5..........KQ________!"
p$(118) = "hfffff001f.6....KO....__________!"
p$(119) = "ff33ee00hh.7..........___KO_MdE_!"
p$(120) = "hh3333002h.8.BL.......______CCQ_!"
p$(121) = "hCCCffDDDh.9..........KO________!"
p$(122) = "hDDDccCCCh.A..........___MK_____!"
p$(123) = "hf333300Df.B.AL.......__________!"
p$(124) = "ffffff00hh.C....KN....______IOI_!"
p$(125) = "hhhhhf00fh.D.......TK.__________!"
p$(126) = "h33c3300ff.E..........KK____COG_!"
p$(127) = "hhheefDDhh.F....KN....__________!"

REM ***************** n/8 plansze wiersza roomy=8

p$(128) = "hffa222hhh.0..........KK________!"
p$(129) = "hbbb000hhh.1.UL.KK....__________!"
p$(130) = "f222111fff.2.......KK.__________!"
p$(131) = "h000aaahhh.3..........______COI_!"
p$(132) = "h000afffhh.4.UK.......RN________!"
p$(133) = "h333ff222h.5....KO....__________!"
p$(134) = "ffffff000f.6.......aN.______DQK_!"
p$(135) = "hhhhha000h.7..........______ESK_!"
p$(136) = "hh3333000h.8....KK....______CKK_!"
p$(137) = "h33333111h.9..........KK________!"
p$(138) = "h33333222h.A.BG.......__________!"
p$(139) = "ffCCff00ff.B....KK....______KaE_!"
p$(140) = "hfDDff00hh.C.......KK.______JKM_!"
p$(141) = "hhhaac00fh.D.0L.......__________!"
p$(142) = "f3333300ff.E....KK....______COL_!"
p$(143) = "hhheefDDhh.F..........KK________!"

REM ***************** n/9 plansze wiersza roomy=9

p$(144) = "haaa222ffh.0....SD....______COH_!"
p$(145) = "hbbb000hhh.1.......DK.__________!"
p$(146) = "f222111hhh.2.AH.......KK________!"
p$(147) = "h000aaahhh.3..........______IOJ_!"
p$(148) = "h000ahhhhh.4....KH....__________!"
p$(149) = "h111hhhhhh.5..........___KK_____!"
p$(150) = "ffffaa222h.6.......ZK.______HEM_!"
p$(151) = "hhaaaa000h.7.UL.......__________!"
p$(152) = "hh3333000h.8.AL.......dI________!"
p$(153) = "h33333111h.9....SD....______GOK_!"
p$(154) = "h33333222h.A..........______FGH_!"
p$(155) = "ffCCff00Dh.B.BL.......__________!"
p$(156) = "hfDDff00hh.C.......SK.__________!"
p$(157) = "hhhaac00fh.D....KK....______DYK_!"
p$(158) = "f3333300hh.E..........KK____ECI_!"
p$(159) = "hhheefDDhh.F.......DK.______BCD_!"

REM tablica serc
FOR xr = 0 TO 15
FOR yr = 0 TO 9
s = xr + yr * 16
znak$ = MID$(p$(s), 23, 1)
IF znak$ <> "_" THEN serca(xr, yr) = 1
NEXT yr: NEXT xr

REM tablica wind
pozycjewind(1) = 0
pozycjewind(2) = 4
pozycjewind(3) = 7
END SUB

SUB rysowanie

FOR yw = 0 TO 9
el$ = MID$(kod$, yw + 1, 1)
y16 = yw * 18

REM tymczasowe sygnalizacje bledow:

IF el$ = "Q" OR el$ = "L" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "P" OR el$ = "W" OR el$ = "=" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "A" OR el$ = "B" OR el$ = "U" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "@" THEN COLOR 15: LINE (0, y16)-(200, y16)

REM elementy uzupelniajace

IF el$ = "C" THEN
PUT (128, y16), szaretlo4, PSET: PUT (192, y16), szaretlo4, PSET
PUT (256, y16), szaretlo4, PSET
PUT (0, y16), blok4, PSET: PUT (64, y16), blok2, PSET:
PUT (96, y16), bloks, PSET: PUT (112, y16), blokk, PSET
END IF

IF el$ = "D" THEN
PUT (0, y16), szaretlo4, PSET: PUT (64, y16), szaretlo4, PSET
PUT (128, y16), szaretlo4, PSET
PUT (192, y16), blokp, PSET: PUT (208, y16), blok4, PSET
PUT (272, y16), blok2, PSET: PUT (304, y16), bloks, PSET
END IF

REM czesc automatyczna, znaki a-h
ascii = ASC(el$)

IF ascii > 96 THEN
bity = ascii - 97
PUT (0, y16), blok4, PSET:
pop1 = 0
pop2 = 0
pop3 = 0

IF (bity AND 4) = 4 THEN PUT (64, y16), blok4, PSET: pop1 = 1
IF (bity AND 4) = 0 THEN PUT (48, y16), blokk, PSET: PUT (64, y16), szaretlo4, PSET: pop1 = 0
REM
IF (bity AND 2) = 2 THEN pop2 = 1: PUT (128, y16), blok4, PSET: IF pop1 = 0 THEN PUT (128, y16), blokp, PSET
IF (bity AND 2) = 0 THEN pop2 = 0: PUT (128, y16), szaretlo4, PSET: IF pop1 = 1 THEN PUT (112, y16), blokk, PSET
REM
IF (bity AND 1) = 1 THEN pop3 = 1: PUT (192, y16), blok4, PSET: IF pop2 = 0 THEN PUT (192, y16), blokp, PSET
IF (bity AND 1) = 0 THEN pop3 = 0: PUT (192, y16), szaretlo4, PSET: IF pop2 = 1 THEN PUT (176, y16), blokk, PSET
PUT (256, y16), blok4, PSET
IF pop3 = 0 THEN PUT (256, y16), blokp, PSET
END IF

REM znaki 0-3

IF ascii < 58 THEN
bity = ascii - 48
IF (bity AND 2) = 2 THEN PUT (0, y16), blokk, PSET
IF (bity AND 2) = 0 THEN PUT (0, y16), szaretlo, PSET
PUT (16, y16), szaretlo4, PSET
PUT (80, y16), szaretlo4, PSET
PUT (144, y16), szaretlo4, PSET
PUT (208, y16), szaretlo4, PSET
PUT (272, y16), szaretlo2, PSET

IF (bity AND 1) = 1 THEN PUT (304, y16), blokp, PSET
IF (bity AND 1) = 0 THEN PUT (304, y16), szaretlo, PSET
END IF

NEXT yw

REM rysowanie podestow

el$ = MID$(kod$, 14, 1)
IF el$ = "" OR el$ = "." THEN GOTO dodatek

el2$ = MID$(kod$, 15, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "#" THEN PUT (0, yo), ceg40, PSET
IF el$ = "W" THEN PUT (0, yo), ceg4plus20plus4, PSET
IF el$ = "U" THEN PUT (0, yo), ceg17plus17, PSET
IF el$ = "0" THEN PUT (0, yo), ceg13plus13, PSET
IF el$ = "A" THEN FOR xx = 0 TO 4: PUT (16 + xx * 64, yo), ceg2, PSET: NEXT xx
IF el$ = "B" THEN FOR xx = 0 TO 5: PUT (64 + xx * 32, yo), ceg2, PSET: NEXT xx

REM dodatkowy element
dodatek:

el$ = MID$(kod$, 29, 1)
IF el$ = "" OR el$ = "_" THEN GOTO okna
el2$ = MID$(kod$, 30, 1)
xo = (ASC(el2$) - 65) * 8
el2$ = MID$(kod$, 31, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "A" THEN
PUT (xo, yo), blokp, PSET: PUT (xo, yo + 18), blokp, PSET
PUT (xo + 16, yo), blok2, PSET: PUT (xo + 16, yo + 18), blok2, PSET
PUT (xo + 48, yo), blokk, PSET: PUT (xo + 48, yo + 18), blokk, PSET
END IF

IF el$ = "B" THEN COLOR 235: LINE (xo + 5, yo)-(xo + 9, yo + 35), , BF
IF el$ = "C" THEN PUT (xo, yo), ceg2, PSET: PUT (xo + 32, yo), ceg2, PSET: PUT (xo + 64, yo), ceg2, PSET
IF el$ = "D" THEN LINE (xo, yo)-(xo + 22, yo + 17), 235, BF: LINE (xo + 42, yo)-(xo + 63, yo + 17), 235, BF
IF el$ = "E" THEN LINE (xo, yo)-(xo + 5, yo + 35), 235, BF: LINE (xo + 26, yo + 36)-(xo + 31, yo + 72), 235, BF
REM niebieskie klocki
IF el$ = "F" THEN PUT (xo, yo), nieb, PSET
IF el$ = "G" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo), nieb, PSET
IF el$ = "H" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo + 36), nieb, PSET
IF el$ = "I" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo - 36), nieb, PSET
REM jednokierunkowe bramki
IF el$ = "J" THEN PSET (xo - 2, yo), 199: DRAW "R18 D35 L18 U35 F18 U1 G18"
IF el$ = "K" THEN PSET (xo - 2, yo), 198: DRAW "R18 D35 L18 U35 R18 G18 U1 F18"
REM zaslonka
IF el$ = "L" THEN LINE (xo, yo)-(xo + 15, yo + 35), 255, BF
REM winda
xwindy = -10: ywindy = -10
IF el$ = "M" THEN
LINE (xo, yo)-(xo + 23, yo + 35), 10, BF
LINE (xo, yo)-(xo, yo + 36), 6
LINE (xo + 3, yo + 7)-(xo + 5, yo + 17), 14, BF
LINE (xo + 1, yo)-(xo + 23, yo), 9
PSET (xo + 4, yo + 8), 12
PSET (xo + 4, yo + 10), 5: DRAW "D7 C14 R1 U2 L2 U2 R2 U2 L2"
xwindy = xo: ywindy = yo
COLOR 8: LOCATE (ywindy / 8) + 2, 34
IF roomy = 0 THEN PRINT "1"
IF roomy = 4 THEN PRINT "2"
IF roomy = 7 THEN PRINT "3"
END IF

okna:

REM rysowanie okien

el$ = MID$(kod$, 17, 1)
IF el$ = "" OR el$ = "." THEN GOTO serce
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 18, 1)
yo = (ASC(el$) - 65) * 9
IF roomy < 2 THEN PUT (xo, yo), window2, PSET
IF roomy > 1 AND roomy < 5 THEN PUT (xo, yo), window1, PSET
IF roomy > 4 THEN PUT (xo, yo), window3, PSET

serce:
REM serce
xserca = -20: yserca = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 23, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xserca = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 24, 1)
yserca = (ASC(el$) - 65) * 9
GET (xserca, yserca)-(xserca + 15, yserca + 7), tlo
PSET (xserca, yserca + 1), 5
DRAW "D2 F1 U4 R1 D5 F1 U5 E1 D5 E1 U4 F1 D2"

donica:
el$ = MID$(kod$, 26, 1)
IF el$ = "" OR el$ = "_" THEN GOTO wentyl
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 27, 1)
yo = (ASC(el$) - 65) * 9 + 2
PUT (xo, yo), palma, PSET

wentyl:
el$ = MID$(kod$, 20, 1)
IF el$ = "" OR el$ = "." THEN GOTO koniecrysowania
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 21, 1)
yo = (ASC(el$) - 65) * 9
PUT (xo, yo), wentylator, PSET

koniecrysowania:

COLOR 15

END SUB

SUB zabranie
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)

OUT 66, 32: OUT 66, 3
FOR i = 1 TO 6000: NEXT i

OUT 66, 204: OUT 66, 4
FOR i = 1 TO 6000: NEXT i

t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port

END SUB

Piotr-246 · Gość

DECLARE SUB dzwiek (ktory!)
DECLARE SUB zabranie ()

REM Gra "Serca", UWAGA wersja gry wymaga
REM emulatora o predkosci 6075 cyklow
REM wymaga pliku bitmap1.scr utworzonego przez modul bsave.bas

DECLARE SUB DREPTANIE ()
DECLARE SUB animacja ()
DECLARE SUB rysowanie ()
DECLARE SUB palety ()
DECLARE SUB plansze ()
DECLARE SUB cegly ()

REM plansza startowa:
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
roomx = 7: roomy = 4

DIM SHARED kolor$(0 TO 255)
DIM pamiec(0 TO 128) AS LONG
DIM poledzialania(0 TO 240) AS LONG
DIM SHARED pozycjewind(1 TO 3) AS INTEGER
DIM SHARED p$(0 TO 159)
DIM SHARED kod$
DIM SHARED serca(0 TO 15, 0 TO 9) AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED xwindy AS INTEGER, ywindy AS INTEGER

REM pamiec tla pod wziatek

DIM SHARED tlo(0 TO 32) AS LONG

REM tlo

DIM SHARED szaretlo(0 TO 74) AS LONG
DIM SHARED szaretlo2(0 TO 148) AS LONG
DIM SHARED szaretlo4(0 TO 300) AS LONG
REM dane elementow planszy

DIM SHARED ceg2(0 TO 75) AS LONG
DIM SHARED ceg40(0 TO 730) AS LONG
DIM SHARED ceg17plus17(0 TO 730) AS LONG
DIM SHARED ceg13plus13(0 TO 760) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 750) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED nieb(0 TO 145) AS LONG

DIM SHARED blokp(0 TO 74) AS LONG
DIM SHARED bloks(0 TO 74) AS LONG
DIM SHARED blokk(0 TO 74) AS LONG
DIM SHARED blok2(0 TO 158) AS LONG
DIM SHARED blok4(0 TO 296) AS LONG

REM ****************** DANE ANIMACJI

DIM SHARED znakp1(0 TO 128) AS LONG
DIM SHARED znakl1(0 TO 128) AS LONG
DIM SHARED znakp2(0 TO 128) AS LONG
DIM SHARED znakl2(0 TO 128) AS LONG
DIM SHARED znakp3(0 TO 128) AS LONG
DIM SHARED znakl3(0 TO 128) AS LONG
DIM SHARED vertd1(0 TO 128) AS LONG

REM matryce okien

DIM SHARED window1(0 TO 160) AS LONG
DIM SHARED window2(0 TO 160) AS LONG
DIM SHARED window3(0 TO 160) AS LONG

DIM SHARED wentylator(0 TO 64) AS LONG

REM ************************* DANE STARTOWE

SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci

x = 200: y = 35: xs = 200: ys = 35: REM wspol. pocz. gracza na ekr.
licz = -1: REM wartosc start. zegara
kolwent = 30 + 30 * 256 + 30 * 65536: REM kolor lopat wentylatora

REM ***** SUB palety - ustawienie nowych wartosci barw
palety

REM ***** SUB cegly - zapelnienie pozostalych tablic
cegly

REM SUB plansze - wypelnienie tablicy wygladu plansz
plansze

REM ************************* START POMIESZCZENIA

rysuj:

kod$ = p$(roomx + roomy * 16)

REM ******************** rysowanie pomieszczenia
t0 = PEEK(1132): REM pomiar czasu rysowania

REM SUB rysowanie - rysowanie planszy
rysowanie

IF przejechal = 1 THEN y = ywindy + 3: ys = ywindy + 3: przejechal = 0

REM pomiar czasu rysowania
t1 = PEEK(1132):

REM menu na dole
LINE (0, 180)-(319, 182), 234, BF
LOCATE 25, 15: PRINT "L-SHIFT ALT P-SHIFT";
LOCATE 24, 2: COLOR 3: PRINT "T:"; t0; "/"; t1; FRE(-2);
PRINT " ROOM:"; roomx; "/"; roomy; "--";

REM **************** zapamietanie pola pod graczem
GET (x, y)-(x + 15, y + 31), pamiec
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
REM PUT (x, y), vertd1, PSET
liczsercaroom = 0: zrobione = 0
GOTO postaw
REM *************************** PETLA GLOWNA

petla:
dx = 0: dy = 0
IF dzwiekbrania = 1 THEN dzwiekbrania = 0: dzwiek (2)

REM ******************* czas gry w sekundach

se$ = MID$(TIME$, 7, 2)
se = VAL(se$)
IF se <> ses THEN licz = licz + 1
ses = se
LOCATE 25, 2: COLOR 15: PRINT "Czas:"; licz;

REM ************************ petla opozniajaca
FOR delay = 1 TO 700: NEXT delay

REM faza wentylatora

komorka = PEEK(1132) / 1.5
faz = INT(komorka)
IF faz / 3 = INT(faz / 3) THEN faza = 0
IF (faz + 1) / 3 = INT((faz + 1) / 3) THEN faza = 1
IF (faz + 2) / 3 = INT((faz + 2) / 3) THEN faza = 2
FOR i = 0 TO 2: i16 = i * 16
IF faza = 0 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, 0
IF faza = 1 THEN PALETTE 11 + i16, 0: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, kolwent
IF faza = 2 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, 0: PALETTE 13 + i16, kolwent
NEXT i

REM ************************ sprawdzenie klawiszy

alt = 0: lshift = 0: pshift = 0: skos = 0

k$ = INKEY$
IF k$ = "f" THEN roomx = roomx - 1: GOTO rysuj
IF k$ = "h" THEN roomx = roomx + 1: GOTO rysuj
IF k$ = "t" THEN roomy = roomy - 1: GOTO rysuj
IF k$ = "b" THEN roomy = roomy + 1: GOTO rysuj
IF k$ = CHR$(27) THEN END

IF x >= xwindy AND y - ywindy < 10 THEN
IF k$ = "1" OR k$ = "2" THEN GOSUB przejazd: GOTO rysuj
IF k$ = "3" THEN GOSUB przejazd: GOTO rysuj
END IF

REM klawisz alt - wznoszenie sie
IF (PEEK(1047) AND 8) = 8 THEN alt = 1
IF (PEEK(1047) AND 2) = 2 THEN lshift = 1
IF (PEEK(1047) AND 1) = 1 THEN pshift = 1

REM bezruch = grawitacja
IF lshift = 0 AND pshift = 0 AND alt = 0 THEN dy = 2: vert = 1: obrot = 0: przebiervert = 0: GOTO czy

POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury

IF lshift = 1 THEN dx = -4: dy = 2: obrot = -1: vert = 0
IF pshift = 1 THEN dx = 4: dy = 2: obrot = 1: vert = 0
IF alt = 1 THEN dy = -4: vert = 1
IF dx <> 0 AND dy <> 0 THEN skos = 1
czy:

REM ************ sprawdzenie czy jest przejscie do innej planszy

IF x + dx > 300 THEN x = 5: xs = 5: roomx = roomx + 1: GOTO rysuj
IF x + dx < 3 THEN x = 300: xs = 300: roomx = roomx - 1: GOTO rysuj
IF y + dy > 144 THEN y = 5: ys = 5: roomy = roomy + 1: GOTO rysuj
IF y + dy < 4 THEN y = 145: ys = 145: roomy = roomy - 1: GOTO rysuj

REM *********** sprawdzenie czy ruch jest mozliwy
REM sprawdzenie przeszkody. Przeszkoda sa kolory > 200

xmozliwy = 0: xniemozliwy = 0
ymozliwy = 0: yniemozliwy = 0

REM sprawdzenie sasiedztwa obok

IF dx > 0 THEN
FOR i = 0 TO 31: punkt = POINT(x + 19, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 198 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF

IF dx < 0 THEN
FOR i = 0 TO 31: punkt = POINT(x - 3, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 199 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF xniemozliwy = 0 THEN xmozliwy = 1
IF xniemozliwy = 1 THEN xmozliwy = 0

REM sprawdzenie sasiedztwa gora dol

IF dy > 0 THEN
FOR i = 0 TO 15:
IF POINT(x + i, y + 32) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y + 33) > 200 THEN yniemozliwy = 1: EXIT FOR

NEXT i
END IF

IF dy < 0 THEN
FOR i = 0 TO 15
IF POINT(x + i, y - 4) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y - 5) > 200 THEN yniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF yniemozliwy = 0 THEN ymozliwy = 1
IF yniemozliwy = 1 THEN ymozliwy = 0

REM ruch gdy oba mozliwe x oraz y
IF ymozliwy = 1 AND xmozliwy = 1 THEN IF dx <> 0 OR dy <> 0 THEN GOTO ruch

REM szczegolne przypadki gdy tylko x albo y mozliwy
IF ymozliwy = 0 AND xmozliwy = 1 THEN dy = 0: GOTO czy
IF ymozliwy = 1 AND xmozliwy = 0 THEN dx = 0: GOTO czy

REM ruch niemozliwy powrot petli glownej bez zmian pozostaja x y

x = xs: y = ys
GOTO petla

REM ***************** RUCH

ruch:

x = x + dx: y = y + dy
IF dy = 0 AND przebieranie = 0 AND alt = 0 THEN dzwiek (1): REM dzwiek chodzenia

REM ******************** czy jest wziatek
deltawx = ABS(x + 4 - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek

REM ************************************** operacja odswiezania tla
postaw:
REM punkt 1 zapamietanie nowego pola dzialania (brudnego)
REM w oparciu o nowe x,y

GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania

REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo

deltax = x - xs: deltay = y - ys
inversx = -1 * deltax: inversy = -1 * deltay
inver4 = INT(inversx / 4)
FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = (yt + inversy) * 6
FOR xt = 0 TO 3
index1 = 1 + (yt6 + 24) + (xt + inver4) + 1
index2 = 1 + yt4 + xt
poledzialania(index1) = pamiec(index2)
NEXT xt: NEXT yt

REM zmazanie serca z pola dzialania

IF liczsercaroom = 1 AND zrobione = 0 THEN
zrobione = 1
PUT (x - 4, y - 4), poledzialania, PSET
PUT (xserca, yserca), tlo, PSET
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
END IF

REM nowa mala pamiec

FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = yt * 6
FOR xt = 0 TO 3:
index1 = 1 + (yt6 + 24) + (xt + 1):
index2 = 1 + yt4 + xt:
pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt

REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU

REM aby nie rysowac dwoch postaci w przypadku skosu
IF skos = 1 THEN GOTO bezskosu:

REM ************************** ruch w dol lub gore

IF vert = 1 THEN wkleic = 7: GOTO wklej
bezskosu:
REM ************************** ruch w lewo

IF obrot = -1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1
IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 1: GOTO wklej
IF przebieranie = 1 THEN wkleic = 2: GOTO wklej
IF przebieranie = 2 THEN wkleic = 3: GOTO wklej
END IF

REM ****************** ruch w prawo

IF obrot = 1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1

IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 4: GOTO wklej
IF przebieranie = 1 THEN wkleic = 5: GOTO wklej
IF przebieranie = 2 THEN wkleic = 6: GOTO wklej
END IF

xs = x: ys = y

GOTO petla

wklej:

IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt
IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt
IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt
IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt
IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt
IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt
IF wkleic = 7 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)): NEXT xt: NEXT yt

REM wklejenie wyniku operacji na tablicy:
PUT (x - 4, y - 4), poledzialania, PSET

xs = x: ys = y
GOTO petla

REM GOSUB-RETURN****************************** obsluga wziatku

wziatek:
IF serca(roomx, roomy) = 0 THEN GOTO niemawziatku
IF liczsercaroom = 1 THEN GOTO niemawziatku
serca(roomx, roomy) = 0
liczserca = liczserca + 1
PUT (xserca, yserca), tlo, PSET

liczsercaroom = 1
dzwiekbrania = 1

LOCATE 1, 1: COLOR 6: PRINT liczserca;
niemawziatku:
RETURN

REM GOSUB-RETURN przejazd:
przejazd:
pietro = VAL(k$)
roomy = pozycjewind(pietro)

FOR i = 23 TO 0 STEP -1
LINE (xwindy + i, ywindy)-(xwindy + i, ywindy + 35), 255
FOR j = 1 TO 10000: NEXT j
NEXT i
CLS
FOR i = 1 TO 30000: NEXT i
przejechal = 1
RETURN

SUB cegly

BLOAD "bitmap1.scr"

REM INPUT a$
REM pobranie z ekranu tablic elementow
REM uwaga! wysokosc elementu to 9 lub 18 px

GET (0, 0)-(31, 8), ceg2
GET (0, 0)-(319, 8), ceg40
GET (0, 9)-(319, 17), ceg17plus17
GET (0, 18)-(319, 26), ceg13plus13
GET (0, 27)-(319, 35), ceg4plus20plus4
GET (0, 36)-(15, 53), szaretlo
GET (0, 36)-(31, 53), szaretlo2
GET (0, 36)-(63, 53), szaretlo4: REM 36+18=46+8=54

GET (16, 64)-(31, 79), palma
GET (32, 64)-(47, 81), blokp
GET (48, 64)-(63, 81), bloks
GET (64, 64)-(79, 81), blokk
GET (0, 156)-(31, 173), blok2
GET (0, 156)-(63, 173), blok4
GET (80, 64)-(111, 81), nieb

GET (0, 88)-(15, 119), znakl1
GET (16, 88)-(31, 119), znakp1
GET (32, 88)-(47, 119), znakl2
GET (48, 88)-(63, 119), znakp2
GET (64, 88)-(79, 119), znakl3
GET (80, 88)-(95, 119), znakp3
GET (96, 88)-(111, 119), vertd1

GET (0, 120)-(31, 139), window1
GET (32, 120)-(63, 139), window2
GET (64, 120)-(95, 139), window3
GET (0, 140)-(15, 155), wentylator
CLS
END SUB

SUB dzwiek (ktory)

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

REM DREPTANIE
IF ktory = 1 THEN

REM ewentualnie:
REM OUT 66, 30: OUT 66, 0
REM OUT 66, 164: OUT 66, 2
REM OUT 66, 130: OUT 66, 1
REM OUT 66, 74: OUT 66, 0
REM OUT 66, 220: OUT 66, 1

FOR i = 1 TO 10
OUT 66, 30: OUT 66, 0
OUT 66, 84: OUT 66, 2
OUT 66, 30: OUT 66, 0
OUT 66, 94: OUT 66, 2
OUT 66, 10: OUT 66, 0
OUT 66, 40: OUT 66, 2
OUT 66, 84: OUT 66, 0
OUT 66, 10: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
END IF

REM zabranie serca

IF ktory = 2 THEN
OUT 66, 32: OUT 66, 3
FOR i = 1 TO 6000: NEXT i
OUT 66, 204: OUT 66, 4
FOR i = 1 TO 6000: NEXT i
END IF

REM wylaczenie glosnika
OUT 97, stary.port

END SUB

SUB palety

REM palety kolorow *********************************
REM max koloru=3F

FOR i = 0 TO 255: kolor$(i) = "00 00 00 00"
PALETTE i, 31 + 31 * 256 + 31 * 65536: NEXT i

REM kolory za ludzikiem

kolor$(0) = "00 00 00 00": REM rejestr zero- wolny
kolor$(1) = "01 05 05 06": REM tlo plyta
kolor$(2) = "02 02 03 02": REM tlo fuga
kolor$(3) = "03 07 06 06": REM tlo krawedz
kolor$(4) = "04 00 22 00": REM liscie
kolor$(5) = "05 3F 08 00": REM serce
kolor$(6) = "06 30 30 30": REM framuga okna
kolor$(7) = "07 28 0A 00": REM doniczka drzewa
kolor$(8) = "08 00 21 39": REM niebo
kolor$(9) = "09 3F 3F 00": REM slonce
kolor$(10) = "0A 14 14 14": REM framuga zewnetrzna
kolor$(11) = "0B 00 00 00": REM wentylator faza 1
kolor$(12) = "0C 00 00 00": REM wentylator faza 2
kolor$(13) = "0D 00 00 00": REM wentylator faza 3
kolor$(14) = "0E 20 20 20": REM srednia szarosc
kolor$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza

REM rejestry przezroczyste gracza
kolor$(16) = "10 18 02 02": REM sweter + zero
kolor$(17) = "11 18 02 02": REM
kolor$(18) = "12 18 02 02": REM
kolor$(19) = "13 18 02 02": REM
kolor$(20) = "14 22 12 00": REM sweter + liscie
kolor$(21) = "15 3F 00 00": REM
kolor$(22) = "16 2F 09 09": REM sweter + framuga okna
kolor$(23) = "17 2B 08 00": REM sweter + doniczka drzewa
kolor$(24) = "18 25 16 24": REM sweter + niebo
kolor$(25) = "19 3F 3F 3F": REM sweter + slonce
kolor$(26) = "1A 16 0F 0F": REM sweter + framuga zew
kolor$(27) = "1B 3F 3F 3F": REM
kolor$(28) = "1C 3F 3F 3F": REM
kolor$(29) = "1D 3F 3F 3F": REM
kolor$(30) = "1E 20 10 10": REM sweter + przyciski
REM kolor 31 (1F) zastrzezony dla gracza
kolor$(32) = "20 0A 13 29": REM spodnie + zero
kolor$(33) = "21 0A 13 29": REM
kolor$(34) = "22 0A 13 29": REM
kolor$(35) = "23 0A 13 29": REM
kolor$(36) = "24 05 1D 24": REM spodnie+ liscie
kolor$(37) = "25 3F 3F 3F": REM
kolor$(38) = "26 1B 1B 32": REM spodnie + framuga okna
kolor$(39) = "27 1A 10 3F": REM spodnie + doniczka
kolor$(40) = "28 00 1A 3F": REM spodnie + niebo
kolor$(41) = "29 3F 3F 3F": REM spodnie +slonce
kolor$(42) = "2A 10 14 20": REM spodnie + framuga zew
kolor$(43) = "2B 3F 3F 3F": REM
kolor$(44) = "2C 3F 3F 3F": REM
kolor$(45) = "2D 3F 3F 3F": REM
kolor$(46) = "2E 3F 3F 3F": REM
REM rejestr 47 (2F) zastrzezony dla gracza

REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF)
REM rejestry nieprzezroczyste

kolor$(31) = "1F 2F 09 09": REM sweter
kolor$(47) = "2F 0D 1A 37": REM spodnie
kolor$(63) = "3F 1A 1A 1A": REM wlosy i buty
kolor$(79) = "4F 10 10 10": REM pasek2
kolor$(95) = "5F 3F 2F 0F":
kolor$(111) = "6F 3F 30 20": REM skora1
REM kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych
kolor$(143) = "8F 32 22 02": REM nos
REM kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych
REM kolor$(175) = "AF 22 02 02": REM sweter3
kolor$(191) = "BF 20 20 20": REM pasek
kolor$(207) = "CF 37 27 06": REM usta
REM FF- zarezerwowany dla przeslony

REM rejestry jednokierunkowe
kolor$(198) = "C6 20 20 20"
kolor$(199) = "C7 20 20 20"

REM bloczek

kolor$(224) = "E0 00 00 00": REM
kolor$(225) = "E1 04 04 04": REM
kolor$(226) = "E2 08 08 08": REM
kolor$(227) = "E3 0B 0B 0B": REM
kolor$(228) = "E4 10 10 10": REM
kolor$(229) = "E5 14 14 14": REM
kolor$(230) = "E6 18 18 18": REM
kolor$(231) = "E7 1B 1B 1B": REM
kolor$(232) = "E8 20 20 20": REM
kolor$(233) = "E9 24 24 24": REM
kolor$(234) = "EA 28 28 28": REM
kolor$(235) = "EB 2B 2B 2B": REM
kolor$(236) = "EC 30 30 30": REM
kolor$(237) = "ED 34 34 34": REM
kolor$(238) = "EE 38 38 38": REM
kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika

REM kolor 240 - przeslona
kolor$(240) = "F0 38 38 38"

REM cegly male niebieskie

kolor$(249) = "F9 22 27 30": REM krawedz
kolor$(250) = "FA 09 0E 14": REM fuga
kolor$(251) = "FB 11 17 1F": REM cegla

REM cegly male czerwone

kolor$(252) = "FC 30 27 27": REM krawedz
kolor$(253) = "FD 14 0E 0E": REM fuga
kolor$(254) = "FE 1F 17 17": REM cegla
kolor$(255) = "FF 28 28 28": REM przeslona

FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2)
red$ = "&H" + MID$(kolor$(i), 4, 2)
gre$ = "&H" + MID$(kolor$(i), 7, 2)
blu$ = "&H" + MID$(kolor$(i), 10, 2)
REM PRINT rej$; " "; red$; " "; gre$; " "; blu$
rej = VAL(rej$)
red = VAL(red$)
gre = VAL(gre$)
blu = VAL(blu$)
REM PRINT rej; " "; red; " "; gre; " "; blu

PALETTE rej, red + gre * 256 + blu * 65536
NEXT i

END SUB

SUB plansze

REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** roomy*16+roomx

REM kody plansz +++nr.po.ok.we.se_kw_dod
REM ************ plansze wiersza roomy=0

p$(0) = "h22233322d.0.UI.YO....GN________!"
p$(1) = "h000fff11h.1....MD....__________!"
p$(2) = "h11133333f.2.UI.HE....___EQ_____!"
p$(3) = "hh2223cchh.3..........SJ________!"
p$(4) = "h300033fff.4....ZK....__________!"
p$(5) = "h2001c333f.5....LG....______AQG_!"
p$(6) = "h111g3322f.6....LD....___EQ_F[Q_!"
p$(7) = "hh222ff11d.7.BE.......aH_ZI_MdO_!"
p$(8) = "hhDDDfCCCg.8..........__________!"
p$(9) = "hhhhhf111c.9..........__________!"
p$(10) = "hhhhhf222g.A..........GG_EQ_____!"
p$(11) = "hh333f111d.B....HG....__________!"
p$(12) = "hhffff333g.C..........__________!"
p$(13) = "h22233333c.D.UN.aK.DF.MK____AYC_!"
p$(14) = "h111ff22hh.E..........___aG_BLM_!"
p$(15) = "h3333311cc.F....ZK....aH____AIG_!"

REM ************ plansze wiersza roomy=1

p$(16) = "d333c2223h.0.......FN.__________!"
p$(17) = "h33330003h.1.WH.SO....dE____COM_!"
p$(18) = "ff333111ff.2.WJ.ML....__________!"
p$(19) = "hc222c333c.3..........___QQ_____!"
p$(20) = "f31113333h.4.UM.aI.aO.__________!"
p$(21) = "f333aa333h.5..........RN_GQ_____!"
p$(22) = "ffff333fff.6....DJ....aM____G[M_!"
p$(23) = "dd333a33hh.7..........__________!"
p$(24) = "gg333333ff.8.AK....IF.__________!"
p$(25) = "cc3322333c.9.WM.......eF________!"
p$(26) = "gg331133hh.A....LF....aO________!"
p$(27) = "ddaa22cccc.B..........__________!"
p$(28) = "g33300333h.C.AM....aO.__________!"
p$(29) = "c33311333c.D.0M.......ZK____AQO_!"
p$(30) = "h3322233dd.E.BE....aF.__________!"
p$(31) = "c33111333h.F.AM.bD....___QQ_COH_!"

REM ************* plansze wiersza roomy=2

p$(32) = "h333ff333c.0..........KE_WQ_____!"
p$(33) = "h33332222c.1....KD....UP____CGI_!"
p$(34) = "faaaa0000h.2....WO.VI.__________!"
p$(35) = "ccccc1111f.3....MM....___EQ_____!"
p$(36) = "h33333223h.4.WI.FP....SM________!"
p$(37) = "haa33200af.5.UJ....GL.______HIE_!"
p$(38) = "f333c111ah.6....aM....UP________!"
p$(39) = "hh333d333g.7....YP....___KQ_____!"
p$(40) = "ff3333333g.8.#I.......KK____CGN_!"
p$(41) = "c33g33d33c.9..........__________!"
p$(42) = "hh3333333g.A.WM.LI....__________!"
p$(43) = "cc333322cc.B.UJ.......__________!"
p$(44) = "hhaacc00hh.C.BE....JG.ZM____AQM_!"
p$(45) = "c333cc11gg.D....aN....______AQM_!"
p$(46) = "dd33cc22hh.E..........______AQE_!"
p$(47) = "hh3331113c.F.UK....VI.___EQ_____!"

REM ************ plansze wiersza roomy=3

p$(48) = "c33332222f.0....ZM.ZD.SF____COI_!"
p$(49) = "ccccc1111h.1..........__________!"
p$(50) = "ha3222333c.2.#F.LO....UO_SQ_____!"
p$(51) = "ff3111333f.3.WM.YI.VI.SJ_GQ_____!"
p$(52) = "h3333c333f.4..........NG____CKK_!"
p$(53) = "ff333c222f.5....ZO....SG________!"
p$(54) = "hhaaff000f.6.BE.......___KQ_____!"
p$(55) = "gggg33111f.7....LO.VJ.______IYM_!"
p$(56) = "gg3322ffff.8..........GG________!"
p$(57) = "cccc00hfff.9..........__________!"
p$(58) = "gg33DDffff.A..........___KK_CCH_!"
p$(59) = "cccccfffff.B.......TL.__________!"
p$(60) = "hh3333333f.C....KK....DP________!"
p$(61) = "g333333hhh.D.UJ....TF.______CKK_!"
p$(62) = "hh3222333f.E..........___GQ_____!"
p$(63) = "c331113hhh.F....ZK....__________!"

REM ****************** plansze wiersza roomy=4

p$(64) = "f22322322h.0....DD....SP_YQ_CKK_!"
p$(65) = "h00f00f00h.1..........__________!"
p$(66) = "c11311311f.2....aP.KP.__________!"
p$(67) = "ff3332223h.3.UJ.ML....___YQ_____!"
p$(68) = "f3333111hh.4.WJ.YL....__________!"
p$(69) = "ffaafaaaff.5.......VI.__________!"
p$(70) = "ffa333c33h.6....OG....SQ_YQ_____!"
p$(71) = "ff223c33cd.7....SN....GN_TI_MdM_!": REM startowa
p$(72) = "ff113cc33d.8..........MO____JVO_!"
p$(73) = "ff33cc33ff.9..........______COI_!"
p$(74) = "ff3333333d.A.WM.LI.ZP.PP________!"
p$(75) = "ff2233333f.B.UM.......___EQ_____!"
p$(76) = "ff11333hhh.C.......KH.__________!"
p$(77) = "h333333333.D.BE.SK....bF____CKK_!"
p$(78) = "ff22233hhh.E.UJ.......______FEE_!"
p$(79) = "h311133fff.F.WJ.......MM________!"

REM ******************* plansze wiersza roomy=5

p$(80) = "haf222faff.0.......VI.___KK_____!"
p$(81) = "hhf111222h.1..........SP____CKK_!"
p$(82) = "fa333c000h.2....GO....__________!"
p$(83) = "h222fa111f.3..........___YQ_____!"
p$(84) = "h111c2223h.4.0Q....EE.MM________!"
p$(85) = "ffffa111ff.5..........______GOE_!"
p$(86) = "h333c333af.6....DD....ZF_MQ_____!"
p$(87) = "dd333f333g.7.......VI.___aI_____!"
p$(88) = "dd3333333g.8.UN.KP....______COI_!"
p$(89) = "f32233f33f.9.......ED.KK________!"
p$(90) = "ddDDCC333h.A....ZK....KO________!"
p$(91) = "f33300f33f.B..........______COH_!"
p$(92) = "h33300333c.C....NN....__________!"
p$(93) = "333311333h.D.0M....TG.GG________!"
p$(94) = "h33222333c.E.AM.......__________!"
p$(95) = "ff3111333h.F.WM.FF....___YQ_____!"

REM ******************* plansze wiersza roomy=6

p$(96) = "fffa222hhh.0....EJ....___YM_____!"
p$(97) = "hhhf000bbb.1....SJ....ML____CMO_!"
p$(98) = "h222111hhh.2..........___KM_____!"
p$(99) = "f111aaafff.3....PH....ZJ________!"
p$(100) = "h222ahhhhh.4..........EE________!"
p$(101) = "f11133222h.5.0I.......___GQ_____!"
p$(102) = "ffffff000h.6....LO....__________!"
p$(103) = "gg333d111f.7....MO....aP________!"
p$(104) = "gg333hCCCh.8.......ZN.EG____HIE_!"
p$(105) = "ffffffDDDh.9..........__________!"
p$(106) = "hh333fCCCh.A.BE.......___KI_____!"
p$(107) = "ff3333111h.B.0I....KK.aP____CKK_!"
p$(108) = "cc22dd22ff.C..........__________!"
p$(109) = "hhDDffDDhh.D.......TJ.LN________!"
p$(110) = "ccc2222hhh.E..........__________!"
p$(111) = "hhhDDDDhhh.F..........TK_KM_____!"

REM ******************* plansze wiersza roomy=7

p$(112) = "hfaa222fff.0..........______COJ_!"
p$(113) = "bbbb000hhh.1....KK....__________!"
p$(114) = "h222111fff.2.BJ.......ZE____AIK_!"
p$(115) = "f000aaahhh.3..........___KM_____!"
p$(116) = "h000ahhhhh.4.......KF.__________!"
p$(117) = "h111hh222h.5..........KQ________!"
p$(118) = "hffaaa001f.6....KO....__________!"
p$(119) = "ff33ee00hh.7..........___KO_MdE_!"
p$(120) = "hh3333002h.8.BL.......______CCQ_!"
p$(121) = "hCCCffDDDh.9..........KO________!"
p$(122) = "hDDDccCCCh.A..........___MK_____!"
p$(123) = "hf333300Df.B.AL.......__________!"
p$(124) = "ffffff00hh.C....KN....______IOI_!"
p$(125) = "hhhhhf00fh.D.......TK.__________!"
p$(126) = "h33c3300ff.E..........KK____COG_!"
p$(127) = "hhheefDDhh.F....KN....__________!"

REM ***************** n/8 plansze wiersza roomy=8

p$(128) = "fffa222hhh.0..........KK________!"
p$(129) = "hbbb000hhh.1.UH.ZK....__________!"
p$(130) = "f222111fff.2.......KK.__________!"
p$(131) = "h000ccchhh.3..........______COI_!"
p$(132) = "h000afffhh.4.UK.......RN________!"
p$(133) = "h333ff222h.5....KO....__________!"
p$(134) = "ffffff000f.6.......aN.______DQK_!"
p$(135) = "hhhhha000h.7..........______ESK_!"
p$(136) = "hh3333000h.8....KG....______CKK_!"
p$(137) = "h33333111h.9..........KK________!"
p$(138) = "h33333222h.A.BG.......__________!"
p$(139) = "ffCCff00ff.B....KN....______KaE_!"
p$(140) = "hfDDff00hh.C.......TH.______JKM_!"
p$(141) = "hhhaac00fh.D.0L.......__________!"
p$(142) = "f3333300ff.E....SI....______COL_!"
p$(143) = "hhheefDDhh.F..........]H________!"

REM ***************** n/9 plansze wiersza roomy=9

p$(144) = "haaa222ffh.0....SD....______COH_!"
p$(145) = "heee000hhh.1.......DK.__________!"
p$(146) = "f222111hhh.2.AH.......KK________!"
p$(147) = "h000aaahhh.3..........______IOJ_!"
p$(148) = "h000ahhhhh.4....KH....__________!"
p$(149) = "h111hhhhhh.5..........___KG_____!"
p$(150) = "ffffaa222h.6.......ZK.______HEM_!"
p$(151) = "hhaaaa000h.7.UL.......__________!"
p$(152) = "hh3333000h.8.AL.......dI________!"
p$(153) = "h33333111h.9....SD....______GOK_!"
p$(154) = "h33333222h.A..........______FGH_!"
p$(155) = "ff223300Dh.B.BL.......__________!"
p$(156) = "hfDDff00hh.C.......SK.__________!"
p$(157) = "hhhaac00fh.D....KK....______DYK_!"
p$(158) = "f3333300hh.E..........KK____ECI_!"
p$(159) = "haa333DDhh.F.WL....DK.__________!"

REM tablica serc
FOR xr = 0 TO 15
FOR yr = 0 TO 9
s = xr + yr * 16
znak$ = MID$(p$(s), 23, 1)
IF znak$ <> "_" THEN serca(xr, yr) = 1
NEXT yr: NEXT xr

REM tablica wind
pozycjewind(1) = 0
pozycjewind(2) = 4
pozycjewind(3) = 7
END SUB

SUB rysowanie

FOR yw = 0 TO 9
el$ = MID$(kod$, yw + 1, 1)
y16 = yw * 18

REM tymczasowe sygnalizacje bledow:

IF el$ = "Q" OR el$ = "L" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "P" OR el$ = "W" OR el$ = "=" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "A" OR el$ = "B" OR el$ = "U" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "@" THEN COLOR 15: LINE (0, y16)-(200, y16)

REM elementy uzupelniajace

IF el$ = "C" THEN
PUT (128, y16), szaretlo4, PSET: PUT (192, y16), szaretlo4, PSET
PUT (256, y16), szaretlo4, PSET
PUT (0, y16), blok4, PSET: PUT (64, y16), blok2, PSET:
PUT (96, y16), bloks, PSET: PUT (112, y16), blokk, PSET
END IF

IF el$ = "D" THEN
PUT (0, y16), szaretlo4, PSET: PUT (64, y16), szaretlo4, PSET
PUT (128, y16), szaretlo4, PSET
PUT (192, y16), blokp, PSET: PUT (208, y16), blok4, PSET
PUT (272, y16), blok2, PSET: PUT (304, y16), bloks, PSET
END IF

REM czesc automatyczna, znaki a-h
ascii = ASC(el$)

IF ascii > 96 THEN
bity = ascii - 97
PUT (0, y16), blok4, PSET:
pop1 = 0
pop2 = 0
pop3 = 0

IF (bity AND 4) = 4 THEN PUT (64, y16), blok4, PSET: pop1 = 1
IF (bity AND 4) = 0 THEN PUT (48, y16), blokk, PSET: PUT (64, y16), szaretlo4, PSET: pop1 = 0
REM
IF (bity AND 2) = 2 THEN pop2 = 1: PUT (128, y16), blok4, PSET: IF pop1 = 0 THEN PUT (128, y16), blokp, PSET
IF (bity AND 2) = 0 THEN pop2 = 0: PUT (128, y16), szaretlo4, PSET: IF pop1 = 1 THEN PUT (112, y16), blokk, PSET
REM
IF (bity AND 1) = 1 THEN pop3 = 1: PUT (192, y16), blok4, PSET: IF pop2 = 0 THEN PUT (192, y16), blokp, PSET
IF (bity AND 1) = 0 THEN pop3 = 0: PUT (192, y16), szaretlo4, PSET: IF pop2 = 1 THEN PUT (176, y16), blokk, PSET
PUT (256, y16), blok4, PSET
IF pop3 = 0 THEN PUT (256, y16), blokp, PSET
END IF

REM znaki 0-3

IF ascii < 58 THEN
bity = ascii - 48
IF (bity AND 2) = 2 THEN PUT (0, y16), blokk, PSET
IF (bity AND 2) = 0 THEN PUT (0, y16), szaretlo, PSET
PUT (16, y16), szaretlo4, PSET
PUT (80, y16), szaretlo4, PSET
PUT (144, y16), szaretlo4, PSET
PUT (208, y16), szaretlo4, PSET
PUT (272, y16), szaretlo2, PSET

IF (bity AND 1) = 1 THEN PUT (304, y16), blokp, PSET
IF (bity AND 1) = 0 THEN PUT (304, y16), szaretlo, PSET
END IF

NEXT yw

REM rysowanie podestow

el$ = MID$(kod$, 14, 1)
IF el$ = "" OR el$ = "." THEN GOTO dodatek

el2$ = MID$(kod$, 15, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "#" THEN PUT (0, yo), ceg40, PSET
IF el$ = "W" THEN PUT (0, yo), ceg4plus20plus4, PSET
IF el$ = "U" THEN PUT (0, yo), ceg17plus17, PSET
IF el$ = "0" THEN PUT (0, yo), ceg13plus13, PSET
IF el$ = "A" THEN FOR xx = 0 TO 4: PUT (16 + xx * 64, yo), ceg2, PSET: NEXT xx
IF el$ = "B" THEN FOR xx = 0 TO 5: PUT (64 + xx * 32, yo), ceg2, PSET: NEXT xx

REM dodatkowy element
dodatek:

el$ = MID$(kod$, 29, 1)
IF el$ = "" OR el$ = "_" THEN GOTO okna
el2$ = MID$(kod$, 30, 1)
xo = (ASC(el2$) - 65) * 8
el2$ = MID$(kod$, 31, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "A" THEN
PUT (xo, yo), blokp, PSET: PUT (xo, yo + 18), blokp, PSET
PUT (xo + 16, yo), blok2, PSET: PUT (xo + 16, yo + 18), blok2, PSET
PUT (xo + 48, yo), blokk, PSET: PUT (xo + 48, yo + 18), blokk, PSET
END IF

IF el$ = "B" THEN COLOR 235: LINE (xo + 5, yo)-(xo + 9, yo + 35), , BF
IF el$ = "C" THEN PUT (xo, yo), ceg2, PSET: PUT (xo + 32, yo), ceg2, PSET: PUT (xo + 64, yo), ceg2, PSET
IF el$ = "D" THEN LINE (xo, yo)-(xo + 22, yo + 17), 235, BF: LINE (xo + 42, yo)-(xo + 63, yo + 17), 235, BF
IF el$ = "E" THEN LINE (xo, yo)-(xo + 5, yo + 35), 235, BF: LINE (xo + 26, yo + 36)-(xo + 31, yo + 72), 235, BF
REM niebieskie klocki
IF el$ = "F" THEN PUT (xo, yo), nieb, PSET
IF el$ = "G" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo), nieb, PSET
IF el$ = "H" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo + 36), nieb, PSET
IF el$ = "I" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo - 36), nieb, PSET
REM jednokierunkowe bramki
IF el$ = "J" THEN PSET (xo - 2, yo), 199: DRAW "R18 D35 L18 U35 F18 U1 G18"
IF el$ = "K" THEN PSET (xo - 2, yo), 198: DRAW "R18 D35 L18 U35 R18 G18 U1 F18"
REM zaslonka
IF el$ = "L" THEN LINE (xo, yo)-(xo + 15, yo + 35), 255, BF
REM winda
xwindy = -10: ywindy = -10
IF el$ = "M" THEN
LINE (xo, yo)-(xo + 23, yo + 35), 10, BF
LINE (xo, yo)-(xo, yo + 36), 6
LINE (xo + 3, yo + 7)-(xo + 5, yo + 17), 14, BF
LINE (xo + 1, yo)-(xo + 23, yo), 9
PSET (xo + 4, yo + 8), 12
PSET (xo + 4, yo + 10), 5: DRAW "D7 C14 R1 U2 L2 U2 R2 U2 L2"
xwindy = xo: ywindy = yo
COLOR 8: LOCATE (ywindy / 8) + 2, 34
IF roomy = 0 THEN PRINT "1"
IF roomy = 4 THEN PRINT "2"
IF roomy = 7 THEN PRINT "3"
END IF

okna:

REM rysowanie okien

el$ = MID$(kod$, 17, 1)
IF el$ = "" OR el$ = "." THEN GOTO serce
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 18, 1)
yo = (ASC(el$) - 65) * 9
IF roomy < 2 THEN PUT (xo, yo), window2, PSET
IF roomy > 1 AND roomy < 5 THEN PUT (xo, yo), window1, PSET
IF roomy > 4 THEN PUT (xo, yo), window3, PSET

serce:
REM serce
xserca = -20: yserca = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 23, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xserca = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 24, 1)
yserca = (ASC(el$) - 65) * 9
GET (xserca, yserca)-(xserca + 15, yserca + 7), tlo
PSET (xserca, yserca + 1), 5
DRAW "D2 F1 U4 R1 D5 F1 U5 E1 D5 E1 U4 F1 D2"

donica:
el$ = MID$(kod$, 26, 1)
IF el$ = "" OR el$ = "_" THEN GOTO wentyl
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 27, 1)
yo = (ASC(el$) - 65) * 9 + 2
PUT (xo, yo), palma, PSET

wentyl:
el$ = MID$(kod$, 20, 1)
IF el$ = "" OR el$ = "." THEN GOTO koniecrysowania
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 21, 1)
yo = (ASC(el$) - 65) * 9
PUT (xo, yo), wentylator, PSET

koniecrysowania:

COLOR 15

END SUB

Piotr-246 · Gość

REM modul BSAVE do gry "Serca"

SCREEN 13

DIM kolor$(0 TO 255)
DIM cegla(0 TO 42) AS LONG
DIM tlo(0 TO 40) AS LONG
DIM poltlo(0 TO 16) AS LONG
DIM bitmap$(0 TO 31)
DIM blok(0 TO 74) AS LONG

REM palety kolorow *********************************
REM max koloru=3F

FOR i = 0 TO 255: kolor$(i) = "00 00 00 00": NEXT i

REM kolory za ludzikiem

kolor$(0) = "00 00 00 00": REM rejestr zero- wolny
kolor$(1) = "01 0A 0A 0A": REM tlo plyta
kolor$(2) = "02 06 06 06": REM tlo fuga
kolor$(3) = "03 10 10 10": REM tlo krawedz
kolor$(4) = "04 00 2F 00": REM liscie
kolor$(5) = "05 3F 3F 3F"
kolor$(6) = "06 3F 3F 3F"
kolor$(7) = "07 28 0A 00": REM doniczka
kolor$(8) = "08 00 00 3F": REM niebo
kolor$(9) = "09 3F 3F 00": REM slonce
kolor$(10) = "0A 20 20 20": REM framuga zewnetrzna
kolor$(11) = "0B 18 18 18": REM wentylator obudowa
kolor$(12) = "0C 3F 3F 3F": REM wentylator faza 1
kolor$(13) = "0D 2F 2F 2F": REM wentylator faza 2
kolor$(14) = "0E 1F 1F 1F": REM wentylator faza 3
kolor$(15) = "0F 3F 3F 3F": REM napis startowy

REM bloki przezroczystosci
kolor$(16) = "10 3F 3F 3F"
kolor$(32) = "20 3F 3F 3F"

REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF)

kolor$(31) = "1F 28 00 00": REM sweter
kolor$(47) = "2F 05 12 2F": REM spodnie
kolor$(63) = "3F 17 17 17": REM wlosy i buty
kolor$(79) = "4F 10 10 10": REM pasek2
kolor$(95) = "5F 3F 2F 0F":
kolor$(111) = "6F 3F 2C 17": REM skora1
kolor$(127) = "7F 18 00 00": REM sweter 2 przeniesiony do przezroczystych
kolor$(143) = "8F 30 20 00": REM nos
kolor$(159) = "9F 04 0D 23": REM spodnie2 przeniesiony do przezroczystych
kolor$(175) = "AF 20 00 00": REM sweter3
kolor$(191) = "BF 20 20 20": REM pasek
kolor$(207) = "CF 37 27 06": REM usta

REM bloczek

kolor$(224) = "E0 00 00 00": REM
kolor$(225) = "E1 04 04 04": REM
kolor$(226) = "E2 08 08 08": REM
kolor$(227) = "E3 0B 0B 0B": REM
kolor$(228) = "E4 10 10 10": REM
kolor$(229) = "E5 14 14 14": REM
kolor$(230) = "E6 18 18 18": REM
kolor$(231) = "E7 1B 1B 1B": REM
kolor$(232) = "E8 20 20 20": REM
kolor$(233) = "E9 24 2B 2B": REM
kolor$(234) = "EA 28 28 28": REM
kolor$(235) = "EB 2B 2B 2B": REM
kolor$(236) = "EC 30 30 30": REM
kolor$(237) = "ED 34 34 34": REM
kolor$(238) = "EE 38 38 38": REM
kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika

REM cegly male niebieskie

kolor$(249) = "F9 22 27 30": REM krawedz
kolor$(250) = "FA 09 0E 14": REM fuga
kolor$(251) = "FB 11 17 1F": REM cegla

REM cegly male czerwone

kolor$(252) = "FC 30 27 27": REM krawedz
kolor$(253) = "FD 14 0E 0E": REM fuga
kolor$(254) = "FE 1F 17 17": REM cegla
kolor$(255) = "FF 3F 3F 3F": REM zarezerwowany dla ludzika

FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2)
red$ = "&H" + MID$(kolor$(i), 4, 2)
gre$ = "&H" + MID$(kolor$(i), 7, 2)
blu$ = "&H" + MID$(kolor$(i), 10, 2)
REM PRINT rej$; " "; red$; " "; gre$; " "; blu$
rej = VAL(rej$)
red = VAL(red$)
gre = VAL(gre$)
blu = VAL(blu$)
REM PRINT rej; " "; red; " "; gre; " "; blu

PALETTE rej, red + gre * 256 + blu * 65536
NEXT i

REM rysunki ****************************************

REM rysunek cegly

bitmap$(0) = "DDDDDDDDDDDDDDDE"
bitmap$(1) = "DFFFFFFFFFFFFFFE"
bitmap$(2) = "DFFFFFFFFFFFFFFE"
bitmap$(3) = "DFFFFFFFFFFFFFFE"
bitmap$(4) = "DFFFFFFFFFFFFFFE"
bitmap$(5) = "DFFFFFFFFFFFFFFE"
bitmap$(6) = "DFFFFFFFFFFFFFFE"
bitmap$(7) = "DFFFFFFFFFFFFFFE"
bitmap$(8) = "EEEEEEEEEEEEEEEE"

REM 250-A 251-B 252-C 253-D 254-E 255-F

FOR yd = 0 TO 8
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 - 1 + &HF0 + 10
: PSET (xd, yd)
NEXT xd: NEXT yd
GET (0, 0)-(15, 8), cegla

REM komorka tla

REM tlo(0) = &H80040

bitmap$(0) = "0001200000012000"
bitmap$(1) = "1111200000011111"
bitmap$(2) = "2221200000012222"
bitmap$(3) = "0001200000012000"
bitmap$(4) = "0001200000012000"
bitmap$(5) = "0001111111112000"
bitmap$(6) = "0001222222212000"
bitmap$(7) = "0001200000012000"
bitmap$(8) = "0001200000012000"

FOR yd = 0 TO 8
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 48 + 1
: PSET (xd, yd)
NEXT xd: NEXT yd

GET (0, 0)-(15, 8), tlo

REM przygotowanie tablic elementow wierszowych
CLS

FOR x = 0 TO 19
FOR y = 0 TO 8
PUT (x * 16, y * 9), tlo, PSET
NEXT y
NEXT x

REM cegly

FOR i = 0 TO 19
PUT (i * 16, 0), cegla, PSET
NEXT i

FOR i = 0 TO 7
PUT (i * 16, 9), cegla, PSET
PUT (304 - i * 16, 9), cegla, PSET
NEXT i

FOR i = 0 TO 4
PUT (i * 16, 18), cegla, PSET
PUT (304 - i * 16, 18), cegla, PSET
NEXT i

FOR i = 0 TO 2
PUT (i * 16, 27), cegla, PSET
PUT (304 - i * 16, 27), cegla, PSET
NEXT i
FOR i = 0 TO 9
PUT (i * 16 + 80, 27), cegla, PSET
NEXT i

REM poszerzenie przejsc pionowych

REM GET (8, 64)-(15, 71), poltlo
REM PUT (136, 8), poltlo, PSET
REM PUT (40, 24), poltlo, PSET
REM GET (0, 64)-(7, 71), poltlo
REM PUT (176, 8), poltlo, PSET
REM PUT (272, 24), poltlo, PSET

REM wykonczenie cegiel
REM COLOR 253: REM szczeliny
REM LINE (135, 8)-(135, 15)
REM LINE (79, 16)-(79, 23)
REM LINE (39, 24)-(39, 31)
REM LINE (239, 24)-(239, 31)

REM COLOR 252: REM krawedzie
REM LINE (184, 12)-(184, 14)
REM LINE (240, 21)-(240, 22)
REM LINE (80, 28)-(80, 30)
REM LINE (280, 28)-(280, 30)

REM RYSUNEK DONICZKI

bitmap$(0) = "DDDCBEEBBEECDDDD"
bitmap$(1) = "BBBCEEEEEEEEDBBB"
bitmap$(2) = "BBBEEEEEEEEEEBBB"
bitmap$(3) = "BBBEEEEEEEECEEBB"
bitmap$(4) = "BBEEDEDEEDECEEBB"
bitmap$(5) = "BBECBEBEEBECDEBB"
bitmap$(6) = "BBECEBBEEBBEDEBB"
bitmap$(7) = "BBECEBBEEBBEDEBB"
bitmap$(8) = "CCCCDBBEEBBCDCCC"
bitmap$(9) = "DDDCDBBEEBBCDDDD"
bitmap$(10) = "BBBCDBBEEBBCDBBB"
bitmap$(11) = "BBBCDHHHHHHCDBBB"
bitmap$(12) = "BBBCCHHHHHHCDBBB"
bitmap$(13) = "BBBCDDHHHHDCDBBB"
bitmap$(14) = "BBBCDBHHHHBCDBBB"
bitmap$(15) = "BBBCDBHHHHBCDBBB"

FOR yd = 0 TO 15
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65
: PSET (xd + 16, yd + 64)
NEXT xd: NEXT yd

REM rysunek bloku

bitmap$(0) = "KLKLKLKLKLKLKLKF" + "JJJJJJJJJJJJJJJF" + "KLKLKLKLKLKLKLKF"
bitmap$(1) = "LJJJJJJJJJJJJJJF" + "KHHHHHIHHGHHHHHF" + "LJJJJJJJJJJJJJJF"
bitmap$(2) = "MJKIJIJKJJKJJJJF" + "KHHHIHHHIHHGHHHF" + "MJJKJKJIJKJIJIJF"
bitmap$(3) = "LJJJJJJJJIJIJIJF" + "KHGHHHHIHHHHIHHF" + "LJJJIJJJIJJJJKJF"
bitmap$(4) = "MJJKJJJJJKJJJJJF" + "KHHHIHGHHIHHHHHF" + "MJJJJKJJJJJKJJJF"
bitmap$(5) = "MJJIJKJIJJIJKJJF" + "KHHHHHHIHHHHIHHF" + "MJKJJJJIJJJJJKJF"
bitmap$(6) = "LJKJIJJJKJJIJIJF" + "KHHGHHIHGHHIHGHF" + "LJKJIJJJKJJJIJJF"
bitmap$(7) = "MJJJJJJJJJJJJJJF" + "KHHHHHHHHHHHHHHF" + "MJJJJJJJJJIJJJJF"
bitmap$(8) = "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF"
bitmap$(9) = "KLKLKLKFJJJJJJJJ" + "JJJJJJJFJJJJJJJJ" + "JJJJJJJFKLKLKLKF"
bitmap$(10) = "LJJJJJJFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFLJJJJJJF"
bitmap$(11) = "MJJIJJJFKHIHHIHH" + "HIHIHHHFKHHGHGHH" + "HHGHIHHFMJKJIJJF"
bitmap$(12) = "LJJJKJJFKHHGHHHI" + "HHGHHGHFKHIHHHHI" + "HGHHHHHFLJJJKJJF"
bitmap$(13) = "MJIJJIJFKHIHHHHH" + "GHHHIHHFKHHHHHGH" + "HHIHHHHFMJKJJIJF"
bitmap$(14) = "MJJIJJJFKHHHIHHH" + "GHIHHHHFKHHHGHHH" + "HHHHHIHFMJJJJJJF"
bitmap$(15) = "LJKJKJJFKHIHHGHI" + "HHHIHGHFKHGHHIHG" + "HIHGHHHFLJKJIKJF"
bitmap$(16) = "MJJJJJJFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFMJJJJJJF"
bitmap$(17) = "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF"

FOR yd = 0 TO 17
FOR xd = 0 TO 47
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + 224
: PSET (xd + 32, yd + 64)
NEXT xd: NEXT yd

GET (48, 64)-(63, 81), blok
FOR i = 0 TO 19: PUT (i * 16, 156), blok, PSET
NEXT i

COLOR 15: LOCATE 10, 16: PRINT "SERCA 1.0"

REM animacja
REM 7,9 - rejestry przezroczyste

bitmap$(0) = "0000003333000000"
bitmap$(1) = "0000033333300000"
bitmap$(2) = "0000066663300000"
bitmap$(3) = "0000063663300000"
bitmap$(4) = "0000866666300000"
bitmap$(5) = "0000066666300000"
bitmap$(6) = "0000006666000000"
bitmap$(7) = "0000000661000000"
bitmap$(8) = "0000000711700000"
bitmap$(9) = "0000007111100000"

bitmap$(10) = "0000071111170000"
bitmap$(11) = "0000011111170000"
bitmap$(12) = "0000011111110000"
bitmap$(13) = "0000711111117000"
bitmap$(14) = "0000711111111000"
bitmap$(15) = "0000111111111000"
bitmap$(16) = "0001111333311000"
bitmap$(17) = "0006602222206600"
bitmap$(18) = "0006002222200600"
bitmap$(19) = "0000092222200000"
bitmap$(20) = "0000022222290000"
bitmap$(21) = "0000022222220000"
bitmap$(22) = "0000022202220000"
bitmap$(23) = "0000922202220000"
bitmap$(24) = "0000222202222000"
bitmap$(25) = "0000222009222000"
bitmap$(26) = "0000222000222000"
bitmap$(27) = "0000222000222000"
bitmap$(28) = "0009222000222300"
bitmap$(29) = "0002220000033300"
bitmap$(30) = "0003330000330000"
bitmap$(31) = "0033330000000000"

FOR yd = 0 TO 31
FOR xd = 0 TO 15
znak$ = MID$(bitmap$(yd), xd + 1, 1)
kolor = VAL("&H" + znak$ + "F")
IF znak$ <> "0" THEN COLOR kolor: PSET (xd, yd + 88): PSET (31 - xd, yd + 88)
IF znak$ = "7" THEN COLOR 16: PSET (xd, yd + 88): PSET (31 - xd, yd + 88)
IF znak$ = "A" THEN COLOR 16: PSET (xd, yd + 88): PSET (31 - xd, yd + 88)

IF znak$ = "9" THEN COLOR 32: PSET (xd, yd + 88): PSET (31 - xd, yd + 88)

NEXT xd
NEXT yd

REM ************************************ FAZA 2

bitmap$(0) = "0000003333000000"
bitmap$(1) = "0000033333300000"
bitmap$(2) = "0000066633300000"
bitmap$(3) = "0000063663300000"
bitmap$(4) = "0000866663300000"
bitmap$(5) = "0000066666300000"
bitmap$(6) = "0000006666000000"
bitmap$(7) = "0000000661000000"
bitmap$(8) = "0000000711700000"
bitmap$(9) = "0000007111100000"

bitmap$(10) = "0000001111100000"
bitmap$(11) = "0000001111100000"
bitmap$(12) = "0000001111100000"
bitmap$(13) = "0000001111100000"
bitmap$(14) = "0000071111100000"
bitmap$(15) = "0000071111100000"
bitmap$(16) = "0000071111300000"
bitmap$(17) = "0000028118200000"
bitmap$(18) = "0000022662200000"
bitmap$(19) = "0000022662200000"
bitmap$(20) = "0000022222000000"
bitmap$(21) = "0000922222000000"
bitmap$(22) = "0000222222000000"
bitmap$(23) = "0000922222000000"
bitmap$(24) = "0000022222000000"
bitmap$(25) = "0000022222300000"
bitmap$(26) = "0000002222300000"
bitmap$(27) = "0000000222330000"
bitmap$(28) = "0000000222033000"
bitmap$(29) = "0000000222000000"
bitmap$(30) = "0000000222000000"
bitmap$(31) = "0000033330000000"

FOR yd = 0 TO 31
FOR xd = 0 TO 15
znak$ = MID$(bitmap$(yd), xd + 1, 1)
kolor = VAL("&H" + znak$ + "F")
IF znak$ <> "0" THEN COLOR kolor: PSET (xd + 32, yd + 88): PSET (63 - xd, yd + 88)
IF znak$ = "7" THEN COLOR 16: PSET (xd + 32, yd + 88): PSET (63 - xd, yd + 88)
IF znak$ = "A" THEN COLOR 16: PSET (xd + 32, yd + 88): PSET (63 - xd, yd + 88)
IF znak$ = "9" THEN COLOR 32: PSET (xd + 32, yd + 88): PSET (63 - xd, yd + 88)

NEXT xd
NEXT yd

REM ************************ ruch poziomy FAZA 3

bitmap$(0) = "0000003333000000"
bitmap$(1) = "0000033333300000"
bitmap$(2) = "0000066633300000"
bitmap$(3) = "0000063663300000"
bitmap$(4) = "0000866663300000"
bitmap$(5) = "0000066666300000"
bitmap$(6) = "0000006666000000"
bitmap$(7) = "0000000661000000"
bitmap$(8) = "0000000711700000"
bitmap$(9) = "0000007111100000"

bitmap$(10) = "0000071111100000"
bitmap$(11) = "0000011111170000"
bitmap$(12) = "0000711111110000"
bitmap$(13) = "0000711111110000"
bitmap$(14) = "0000711111110000"
bitmap$(15) = "0000111111110000"
bitmap$(16) = "0000111333310000"
bitmap$(17) = "0000066222260000"
bitmap$(18) = "0000006222260000"
bitmap$(19) = "0000002222200000"
bitmap$(20) = "0000002222200000"
bitmap$(21) = "0000022222200000"
bitmap$(22) = "0000022222200000"
bitmap$(23) = "0000922222200000"
bitmap$(24) = "0000222022200000"
bitmap$(25) = "0000222022200000"
bitmap$(26) = "0000222092290000"
bitmap$(27) = "0000222002220000"
bitmap$(28) = "0000222002220000"
bitmap$(29) = "0003333002220000"
bitmap$(30) = "0000000000222000"
bitmap$(31) = "0000000033330000"

FOR yd = 0 TO 31
FOR xd = 0 TO 15
znak$ = MID$(bitmap$(yd), xd + 1, 1)
kolor = VAL("&H" + znak$ + "F")
IF znak$ <> "0" THEN COLOR kolor: PSET (xd + 64, yd + 88): PSET (95 - xd, yd + 88)
IF znak$ = "7" THEN COLOR 16: PSET (xd + 64, yd + 88): PSET (95 - xd, yd + 88)
IF znak$ = "A" THEN COLOR 16: PSET (xd + 64, yd + 88): PSET (95 - xd, yd + 88)

IF znak$ = "9" THEN COLOR 32: PSET (xd + 64, yd + 88): PSET (95 - xd, yd + 88)

NEXT xd
NEXT yd

REM ************************ fazy ruchu pionowego

REM Ludzik idacy w dol lub w gore

bitmap$(0) = "0000003330000000"
bitmap$(1) = "0000033333000000"
bitmap$(2) = "0000336663300000"
bitmap$(3) = "0000363636300000"
bitmap$(4) = "0000366666300000"
bitmap$(5) = "000006C8C6000000"
bitmap$(6) = "0000006860000000"
bitmap$(7) = "0000001610000000"
bitmap$(8) = "0000711111700000"
bitmap$(9) = "0001111111110000"

bitmap$(10) = "0071111111117000"
bitmap$(11) = "0071111111117000"
bitmap$(12) = "0011711111711000"
bitmap$(13) = "0711711111711700"
bitmap$(14) = "0A11711111711A00"
bitmap$(15) = "0117A11111A71100"
bitmap$(16) = "0117111111171100"
bitmap$(17) = "01104BBBBB401100"
bitmap$(18) = "0860922222906800"
bitmap$(19) = "0000922222900000"
bitmap$(20) = "0000929092900000"
bitmap$(21) = "0000929092900000"
bitmap$(22) = "0000929092900000"
bitmap$(23) = "0000929092900000"
bitmap$(24) = "0000929092900000"
bitmap$(25) = "0000929092900000"
bitmap$(26) = "0000929092900000"
bitmap$(27) = "0000929092900000"
bitmap$(28) = "0000929092900000"
bitmap$(29) = "0000929092900000"
bitmap$(30) = "0000333033300000"
bitmap$(31) = "0003330003330000"
FOR yd = 0 TO 31
FOR xd = 0 TO 15
znak$ = MID$(bitmap$(yd), xd + 1, 1)
kolor = VAL("&H" + znak$ + "F")
IF znak$ <> "0" THEN COLOR kolor: PSET (xd + 96, yd + 88)
IF znak$ = "7" THEN COLOR 16: PSET (xd + 96, yd + 88)
IF znak$ = "A" THEN COLOR 16: PSET (xd + 96, yd + 88)
IF znak$ = "4" THEN COLOR 32: PSET (xd + 96, yd + 88)

IF znak$ = "9" THEN COLOR 32: PSET (xd + 96, yd + 88)

NEXT xd
NEXT yd

REM RYSUNEK OKNA NIEBIESKO-ZIELONEGO
bitmap$(0) = "AAGGGGGGGGGGGGGGGGGGGGGGGGGGGGAA"
bitmap$(1) = "AAGKKKKKKKKGKKKKKKKKGKKKKKKKKGAA"
bitmap$(2) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(3) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(4) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(5) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(6) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(7) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(8) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(9) = "AAGKIEEEEIIGKIIEEIIIGKEEEIIIIGAA"
bitmap$(10) = "AAGKEEEEEEIGKIEEEEIEGKEEEEIIIGAA"
bitmap$(11) = "AAGKEEEEEEEGKEEEEEEEGKEEEEEEIGAA"
bitmap$(12) = "AAGKEHEEEEEGKEEEEEEEGKEEEEEEEGAA"
bitmap$(13) = "AAGKEHEHEEEGKEHEEEEEGKEEHEEEEGAA"
bitmap$(14) = "AAGKEEHEEEEGKEHEHEEEGKHEHEEHEGAA"
bitmap$(15) = "AAGKEEHEEEEGKEEHEEEEGKEHEEHEEGAA"
bitmap$(16) = "AAGKHEHEEEEGKHEHEHEEGKEEHEHEEGAA"
bitmap$(17) = "AAGKEHEEEHEGKEHEEEHEGKEEEHEEEGAA"
bitmap$(18) = "AAGKEHEEEHEGKEHEEEHEGKEEHEEEEGAA"
bitmap$(19) = "AGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGA"

FOR yd = 0 TO 19
FOR xd = 0 TO 31
color$ = MID$(bitmap$(yd), xd + 1, 1)

COLOR ASC(color$) - 65
PSET (xd, yd + 120)
NEXT xd: NEXT yd

REM RYSUNEK OKNA NIEBIESKIEGO
bitmap$(0) = "AAGGGGGGGGGGGGGGGGGGGGGGGGGGGGAA"
bitmap$(1) = "AAGKKKKKKKKGKKKKKKKKGKKKKKKKKGAA"
bitmap$(2) = "AAGKIIIIIIIGKIIIIIIIGKIIIJJJJGAA"
bitmap$(3) = "AAGKIIIIIIIGKIIIIIIIGKIIIJJJJGAA"
bitmap$(4) = "AAGKIIIIIIIGKIIIIIIIGKIIIIJJJGAA"
bitmap$(5) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIJJGAA"
bitmap$(6) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(7) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(8) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(9) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(10) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(11) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(12) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(13) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(14) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(15) = "AAGKIEEEEIIGKIIEEIIIGKEEEIIIIGAA"
bitmap$(16) = "AAGKEEEEEEIGKIEEEEIEGKEEEEIIIGAA"
bitmap$(17) = "AAGKEEEEEEEGKEEEEEEEGKEEEEEEIGAA"
bitmap$(18) = "AAGKEEEEEEEGKEEEEEEEGKEEEEEEEGAA"
bitmap$(19) = "AGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGA"

FOR yd = 0 TO 19
FOR xd = 0 TO 31
color$ = MID$(bitmap$(yd), xd + 1, 1)

COLOR ASC(color$) - 65
PSET (xd + 32, yd + 120)
NEXT xd: NEXT yd

REM RYSUNEK OKNA ZIELONEGO

bitmap$(0) = "AAGGGGGGGGGGGGGGGGGGGGGGGGGGGGAA"
bitmap$(1) = "AAGKKKKKKKKGKKKKKKKKGKKKKKKKKGAA"
bitmap$(2) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(3) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(4) = "AAGKIEEEEIIGKIIEEIIIGKEEEIIIIGAA"
bitmap$(5) = "AAGKEEEEEEIGKIEEEEIEGKEEEEIIIGAA"
bitmap$(6) = "AAGKEEEEEEEGKEEEEEEEGKEEEEEEIGAA"
bitmap$(7) = "AAGKEEHEEEEGKEEHEHEEGKEHEEEEEGAA"
bitmap$(8) = "AAGKEEHEHEEGKEEEHEEHGKEEHEEEEGAA"
bitmap$(9) = "AAGKEEEHEEEGKHEEHEHEGKHEHEEHEGAA"
bitmap$(10) = "AAGKHEEHEEEGKHEHEHEEGKEHEEHEEGAA"
bitmap$(11) = "AAGKEHEHEHEGKEHEEHEHGKEEHEHEEGAA"
bitmap$(12) = "AAGKEEHEEHEGKEHEEEHEGKEEHHEEEGAA"
bitmap$(13) = "AAGKEEHEHEEGKEHEHEHEGKEEHEEEEGAA"
bitmap$(14) = "AAGKEEHHEEEGKEHHEEHEGKEEHEEEEGAA"
bitmap$(15) = "AAGKEEHEEEEGKEHEEEHEGKEEHEEEEGAA"
bitmap$(16) = "AAGKEEHEEEEGKEHEEHHHGKEEHEEEEGAA"
bitmap$(17) = "AAGKEHHHEEEGKHHHEEEEGKEHHHEEEGAA"
bitmap$(18) = "AAGKEEEEEEEGKEEEEEEEGKEEEEEEEGAA"
bitmap$(19) = "AGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGA"

FOR yd = 0 TO 19
FOR xd = 0 TO 31
color$ = MID$(bitmap$(yd), xd + 1, 1)

COLOR ASC(color$) - 65
PSET (xd + 64, yd + 120)
NEXT xd: NEXT yd

REM RYSUNEK wentylatora

bitmap$(0) = "KKKKKGGGGGKKKKKALLLLLGGGGGLLLLLA"
bitmap$(1) = "KKKGGNNLLLGGKKKALLLGGLLLLLGGLLLA"
bitmap$(2) = "KKGNNNNLLLLLGKKALLGALLLLLLLAGLLA"
bitmap$(3) = "KGMMNNNLLLLMMGKALGAALLLLLLLAAGLA"
bitmap$(4) = "KGMMMNNLLLMMMGKALGAAALLLLLAAAGLA"
bitmap$(5) = "GMMMMMNLLMMMMMGAGAAAALLLLLAAAAGA"
bitmap$(6) = "GMMMMMGGGMMMMNGAGAAAAALLLAAAAAGA"
bitmap$(7) = "GLLLLLGGGNNNNNGAGLLLAAALAAALLLGA"
bitmap$(8) = "GLLLLLGGGNNNNNGAGLLLLLLALLLLLLGA"
bitmap$(9) = "GLLLNNNMLLLNNNGAGLLLLLLALLLLLLGA"
bitmap$(10) = "KGNNNNMMMLLLNGKALGLLLLAAALLLLGLA"
bitmap$(11) = "KGNNNNMMMLLLLGKALGLLLAAAAALLLGLA"
bitmap$(12) = "KKGNNNMMMLLLGKKALLGLLAAAAALLGLLA"
bitmap$(13) = "KKKGGMMMMMGGKKKALLLGGAAAAAGGLLLA"
bitmap$(14) = "KKKKKGGGGGKKKKKALLLLLGGGGGLLLLLA"
bitmap$(15) = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"

FOR yd = 0 TO 15
FOR xd = 0 TO 31
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65
: PSET (xd, yd + 140)
NEXT xd: NEXT yd

REM rysunek bloku niebieskiego
REM 249-D 250-E 251-F

bitmap$(0) = "DDDDDDDDDDDDDDDE"
bitmap$(1) = "DFFFFFFFFFFFFFFE"
bitmap$(2) = "DFFFFFFFFFFFFFFE"
bitmap$(3) = "DFFFFFFFFFFFFFFE"
bitmap$(4) = "DFFFFFFFFFFFFFFE"
bitmap$(5) = "DFFFFFFFFFFFFFFE"
bitmap$(6) = "DFFFFFFFFFFFFFFE"
bitmap$(7) = "DFFFFFFFFFFFFFFE"
bitmap$(8) = "DFFFFFFFFFFFFFFE"
bitmap$(9) = "DFFFFFFFFFFFFFFE"
bitmap$(10) = "DFFFFFFFFFFFFFFE"
bitmap$(11) = "DFFFFFFFFFFFFFFE"
bitmap$(12) = "DFFFFFFFFFFFFFFE"
bitmap$(13) = "DFFFFFFFFFFFFFFE"
bitmap$(14) = "DFFFFFFFFFFFFFFE"
bitmap$(15) = "DFFFFFFFFFFFFFFE"
bitmap$(16) = "DFFFFFFFFFFFFFFE"
bitmap$(17) = "DEEEEEEEEEEEEEEE"
FOR yd = 0 TO 17
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + 246
PSET (80 + xd, 64 + yd)
PSET (96 + xd, 64 + yd)

NEXT xd: NEXT yd

REM zapis do pliku

DEF SEG = &HA000
BSAVE "bitmap1.scr", 0, 57000
COLOR 15: LOCATE 23, 1
INPUT a$
CLS

BLOAD "bitmap1.scr"

END

Piotr-246 · Gość

DECLARE SUB dzwiek (ktory!)

REM Gra "Serca", UWAGA wersja gry wymaga
REM emulatora o predkosci 6075 cyklow
REM wymaga pliku bitmap1.scr utworzonego przez modul bsave.bas

DECLARE SUB animacja ()
DECLARE SUB rysowanie ()
DECLARE SUB palety ()
DECLARE SUB plansze ()
DECLARE SUB cegly ()

REM plansza startowa:
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
roomx = 7: roomy = 4

DIM SHARED kolor$(0 TO 255)
DIM pamiec(0 TO 128) AS LONG
DIM poledzialania(0 TO 240) AS LONG
DIM SHARED pozycjewind(1 TO 3) AS INTEGER
DIM SHARED p$(0 TO 159)
DIM SHARED kod$
DIM SHARED serca(0 TO 15, 0 TO 9) AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED xwindy AS INTEGER, ywindy AS INTEGER

REM pamiec tla pod wziatek

DIM SHARED tlo(0 TO 32) AS LONG

REM tlo

DIM SHARED szaretlo(0 TO 74) AS LONG
DIM SHARED szaretlo2(0 TO 148) AS LONG
DIM SHARED szaretlo4(0 TO 300) AS LONG
REM dane elementow planszy

DIM SHARED ceg2(0 TO 75) AS LONG
DIM SHARED ceg40(0 TO 730) AS LONG
DIM SHARED ceg17plus17(0 TO 730) AS LONG
DIM SHARED ceg13plus13(0 TO 760) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 750) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED nieb(0 TO 145) AS LONG

DIM SHARED blokp(0 TO 74) AS LONG
DIM SHARED bloks(0 TO 74) AS LONG
DIM SHARED blokk(0 TO 74) AS LONG
DIM SHARED blok2(0 TO 158) AS LONG
DIM SHARED blok4(0 TO 296) AS LONG

REM ****************** DANE ANIMACJI

DIM SHARED znakp1(0 TO 128) AS LONG
DIM SHARED znakl1(0 TO 128) AS LONG
DIM SHARED znakp2(0 TO 128) AS LONG
DIM SHARED znakl2(0 TO 128) AS LONG
DIM SHARED znakp3(0 TO 128) AS LONG
DIM SHARED znakl3(0 TO 128) AS LONG
DIM SHARED vertd1(0 TO 128) AS LONG

REM matryce okien

DIM SHARED window1(0 TO 160) AS LONG
DIM SHARED window2(0 TO 160) AS LONG
DIM SHARED window3(0 TO 160) AS LONG

DIM SHARED wentylator(0 TO 64) AS LONG

REM ************************* DANE STARTOWE

SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci

x = 200: y = 35: xs = 200: ys = 35: REM wspol. pocz. gracza na ekr.
licz = -1: REM wartosc start. zegara
kolwent = 30 + 30 * 256 + 30 * 65536: REM kolor lopat wentylatora

REM ***** SUB palety - ustawienie nowych wartosci barw
palety

REM ***** SUB cegly - zapelnienie pozostalych tablic
cegly

REM SUB plansze - wypelnienie tablicy wygladu plansz
plansze

REM ************************* START POMIESZCZENIA

rysuj:

kod$ = p$(roomx + roomy * 16)

REM ******************** rysowanie pomieszczenia
t0 = PEEK(1132): REM pomiar czasu rysowania

REM SUB rysowanie - rysowanie planszy
rysowanie

IF przejechal = 1 THEN y = ywindy + 3: ys = ywindy + 3: przejechal = 0

REM pomiar czasu rysowania
t1 = PEEK(1132):

REM menu na dole
LINE (0, 180)-(319, 182), 234, BF
LOCATE 25, 15: PRINT "L-SHIFT ALT P-SHIFT";
LOCATE 24, 2: COLOR 3: PRINT "T:"; t0; "/"; t1; FRE(-2);
PRINT " ROOM:"; roomx; "/"; roomy; "--";

REM **************** zapamietanie pola pod graczem
GET (x, y)-(x + 15, y + 31), pamiec
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
REM PUT (x, y), vertd1, PSET
liczsercaroom = 0: zrobione = 0
GOTO postaw
REM *************************** PETLA GLOWNA

petla:
dx = 0: dy = 0
IF dzwiekbrania = 1 THEN dzwiekbrania = 0: dzwiek (2)

REM ******************* czas gry w sekundach

se$ = MID$(TIME$, 7, 2)
se = VAL(se$)
IF se <> ses THEN licz = licz + 1
ses = se
LOCATE 25, 2: COLOR 15: PRINT "Czas:"; licz;

REM ************************ petla opozniajaca
FOR delay = 1 TO 700: NEXT delay

REM faza wentylatora

komorka = PEEK(1132) / 1.5
faz = INT(komorka)
IF faz / 3 = INT(faz / 3) THEN faza = 0
IF (faz + 1) / 3 = INT((faz + 1) / 3) THEN faza = 1
IF (faz + 2) / 3 = INT((faz + 2) / 3) THEN faza = 2
FOR i = 0 TO 2: i16 = i * 16
IF faza = 0 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, 0
IF faza = 1 THEN PALETTE 11 + i16, 0: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, kolwent
IF faza = 2 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, 0: PALETTE 13 + i16, kolwent
NEXT i

REM ************************ sprawdzenie klawiszy

alt = 0: lshift = 0: pshift = 0: skos = 0

k$ = INKEY$
IF k$ = "f" THEN roomx = roomx - 1: GOTO rysuj
IF k$ = "h" THEN roomx = roomx + 1: GOTO rysuj
IF k$ = "t" THEN roomy = roomy - 1: GOTO rysuj
IF k$ = "b" THEN roomy = roomy + 1: GOTO rysuj
IF k$ = CHR$(27) THEN END

IF x >= xwindy AND y - ywindy < 10 THEN
IF k$ = "1" OR k$ = "2" THEN GOSUB przejazd: GOTO rysuj
IF k$ = "3" THEN GOSUB przejazd: GOTO rysuj
END IF

REM klawisz alt - wznoszenie sie
IF (PEEK(1047) AND 8) = 8 THEN alt = 1
IF (PEEK(1047) AND 2) = 2 THEN lshift = 1
IF (PEEK(1047) AND 1) = 1 THEN pshift = 1

REM bezruch = grawitacja
IF lshift = 0 AND pshift = 0 AND alt = 0 THEN dy = 2: vert = 1: obrot = 0: przebiervert = 0: GOTO czy

POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury

IF lshift = 1 THEN dx = -4: dy = 2: obrot = -1: vert = 0
IF pshift = 1 THEN dx = 4: dy = 2: obrot = 1: vert = 0
IF alt = 1 THEN dy = -4: vert = 1
IF dx <> 0 AND dy <> 0 THEN skos = 1
czy:

REM ************ sprawdzenie czy jest przejscie do innej planszy

IF x + dx > 300 THEN x = 5: xs = 5: roomx = roomx + 1: GOTO rysuj
IF x + dx < 3 THEN x = 300: xs = 300: roomx = roomx - 1: GOTO rysuj
IF y + dy > 144 THEN y = 5: ys = 5: roomy = roomy + 1: GOTO rysuj
IF y + dy < 4 THEN y = 145: ys = 145: roomy = roomy - 1: GOTO rysuj

REM *********** sprawdzenie czy ruch jest mozliwy
REM sprawdzenie przeszkody. Przeszkoda sa kolory > 200

xmozliwy = 0: xniemozliwy = 0
ymozliwy = 0: yniemozliwy = 0

REM sprawdzenie sasiedztwa obok

IF dx > 0 THEN
FOR i = 0 TO 31: punkt = POINT(x + 19, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 198 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF

IF dx < 0 THEN
FOR i = 0 TO 31: punkt = POINT(x - 3, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 199 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF xniemozliwy = 0 THEN xmozliwy = 1
IF xniemozliwy = 1 THEN xmozliwy = 0

REM sprawdzenie sasiedztwa gora dol

IF dy > 0 THEN
FOR i = 0 TO 15:
IF POINT(x + i, y + 32) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y + 33) > 200 THEN yniemozliwy = 1: EXIT FOR

NEXT i
END IF

IF dy < 0 THEN
FOR i = 0 TO 15
IF POINT(x + i, y - 4) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y - 5) > 200 THEN yniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF yniemozliwy = 0 THEN ymozliwy = 1
IF yniemozliwy = 1 THEN ymozliwy = 0

REM ruch gdy oba mozliwe x oraz y
IF ymozliwy = 1 AND xmozliwy = 1 THEN IF dx <> 0 OR dy <> 0 THEN GOTO ruch

REM szczegolne przypadki gdy tylko x albo y mozliwy
IF ymozliwy = 0 AND xmozliwy = 1 THEN dy = 0: GOTO czy
IF ymozliwy = 1 AND xmozliwy = 0 THEN dx = 0: GOTO czy

REM ruch niemozliwy powrot petli glownej bez zmian pozostaja x y

x = xs: y = ys
GOTO petla

REM ***************** RUCH

ruch:

x = x + dx: y = y + dy
IF dy = 0 AND przebieranie = 0 AND alt = 0 THEN dzwiek (1): REM dzwiek chodzenia

REM ******************** czy jest wziatek
deltawx = ABS(x + 4 - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek

REM ************************************** operacja odswiezania tla
postaw:
REM punkt 1 zapamietanie nowego pola dzialania (brudnego)
REM w oparciu o nowe x,y

GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania

REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo

deltax = x - xs: deltay = y - ys
inversx = -1 * deltax: inversy = -1 * deltay
inver4 = INT(inversx / 4)
FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = (yt + inversy) * 6
FOR xt = 0 TO 3
index1 = 1 + (yt6 + 24) + (xt + inver4) + 1
index2 = 1 + yt4 + xt
poledzialania(index1) = pamiec(index2)
NEXT xt: NEXT yt

REM zmazanie serca z pola dzialania

IF liczsercaroom = 1 AND zrobione = 0 THEN
zrobione = 1
PUT (x - 4, y - 4), poledzialania, PSET
PUT (xserca, yserca), tlo, PSET
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
END IF

REM nowa mala pamiec

FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = yt * 6
FOR xt = 0 TO 3:
index1 = 1 + (yt6 + 24) + (xt + 1):
index2 = 1 + yt4 + xt:
pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt

REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU

REM aby nie rysowac dwoch postaci w przypadku skosu
IF skos = 1 THEN GOTO bezskosu:

REM ************************** ruch w dol lub gore

IF vert = 1 THEN wkleic = 7: GOTO wklej
bezskosu:
REM ************************** ruch w lewo

IF obrot = -1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1
IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 1: GOTO wklej
IF przebieranie = 1 THEN wkleic = 2: GOTO wklej
IF przebieranie = 2 THEN wkleic = 3: GOTO wklej
END IF

REM ****************** ruch w prawo

IF obrot = 1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1

IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 4: GOTO wklej
IF przebieranie = 1 THEN wkleic = 5: GOTO wklej
IF przebieranie = 2 THEN wkleic = 6: GOTO wklej
END IF

xs = x: ys = y

GOTO petla

wklej:

IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt
IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt
IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt
IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt
IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt
IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt
IF wkleic = 7 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)): NEXT xt: NEXT yt

REM wklejenie wyniku operacji na tablicy:
PUT (x - 4, y - 4), poledzialania, PSET

xs = x: ys = y
GOTO petla

REM GOSUB-RETURN****************************** obsluga wziatku

wziatek:
IF serca(roomx, roomy) = 0 THEN GOTO niemawziatku
IF liczsercaroom = 1 THEN GOTO niemawziatku
serca(roomx, roomy) = 0
liczserca = liczserca + 1
PUT (xserca, yserca), tlo, PSET

liczsercaroom = 1
dzwiekbrania = 1

LOCATE 1, 1: COLOR 6: PRINT liczserca;
niemawziatku:
RETURN

REM GOSUB-RETURN przejazd:
przejazd:
pietro = VAL(k$)
roomy = pozycjewind(pietro)

FOR i = 23 TO 0 STEP -1
LINE (xwindy + i, ywindy)-(xwindy + i, ywindy + 35), 255
FOR j = 1 TO 7500: NEXT j
NEXT i
CLS
FOR i = 1 TO 30000: NEXT i
przejechal = 1
RETURN

SUB cegly

BLOAD "bitmap1.scr"

REM INPUT a$
REM pobranie z ekranu tablic elementow
REM uwaga! wysokosc elementu to 9 lub 18 px

GET (0, 0)-(31, 8), ceg2
GET (0, 0)-(319, 8), ceg40
GET (0, 9)-(319, 17), ceg17plus17
GET (0, 18)-(319, 26), ceg13plus13
GET (0, 27)-(319, 35), ceg4plus20plus4
GET (0, 36)-(15, 53), szaretlo
GET (0, 36)-(31, 53), szaretlo2
GET (0, 36)-(63, 53), szaretlo4: REM 36+18=46+8=54

GET (16, 64)-(31, 79), palma
GET (32, 64)-(47, 81), blokp
GET (48, 64)-(63, 81), bloks
GET (64, 64)-(79, 81), blokk
GET (0, 156)-(31, 173), blok2
GET (0, 156)-(63, 173), blok4
GET (80, 64)-(111, 81), nieb

GET (0, 88)-(15, 119), znakl1
GET (16, 88)-(31, 119), znakp1
GET (32, 88)-(47, 119), znakl2
GET (48, 88)-(63, 119), znakp2
GET (64, 88)-(79, 119), znakl3
GET (80, 88)-(95, 119), znakp3
GET (96, 88)-(111, 119), vertd1

GET (0, 120)-(31, 139), window1
GET (32, 120)-(63, 139), window2
GET (64, 120)-(95, 139), window3
GET (0, 140)-(15, 155), wentylator
CLS
END SUB

SUB dzwiek (ktory)

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

REM DREPTANIE
IF ktory = 1 THEN

REM ewentualnie:
REM OUT 66, 30: OUT 66, 0
REM OUT 66, 164: OUT 66, 2
REM OUT 66, 130: OUT 66, 1
REM OUT 66, 74: OUT 66, 0
REM OUT 66, 220: OUT 66, 1

FOR i = 1 TO 10
OUT 66, 30: OUT 66, 0
OUT 66, 84: OUT 66, 2
OUT 66, 30: OUT 66, 0
OUT 66, 94: OUT 66, 2
OUT 66, 10: OUT 66, 0
OUT 66, 40: OUT 66, 2
OUT 66, 84: OUT 66, 0
OUT 66, 10: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
END IF

REM zabranie serca

IF ktory = 2 THEN
OUT 66, 32: OUT 66, 3
FOR i = 1 TO 6000: NEXT i
OUT 66, 204: OUT 66, 4
FOR i = 1 TO 6000: NEXT i
END IF

REM wylaczenie glosnika
OUT 97, stary.port

END SUB

SUB palety

REM palety kolorow *********************************
REM max koloru=3F

FOR i = 0 TO 255: kolor$(i) = "00 00 00 00"
PALETTE i, 31 + 31 * 256 + 31 * 65536: NEXT i

REM kolory za ludzikiem

kolor$(0) = "00 00 00 00": REM rejestr zero- wolny
kolor$(1) = "01 05 05 06": REM tlo plyta
kolor$(2) = "02 02 03 02": REM tlo fuga
kolor$(3) = "03 07 06 06": REM tlo krawedz
kolor$(4) = "04 00 22 00": REM liscie
kolor$(5) = "05 3F 08 00": REM serce
kolor$(6) = "06 30 30 30": REM framuga okna
kolor$(7) = "07 28 0A 00": REM doniczka drzewa
kolor$(8) = "08 00 21 39": REM niebo
kolor$(9) = "09 3F 3F 00": REM slonce
kolor$(10) = "0A 14 14 14": REM framuga zewnetrzna
kolor$(11) = "0B 00 00 00": REM wentylator faza 1
kolor$(12) = "0C 00 00 00": REM wentylator faza 2
kolor$(13) = "0D 00 00 00": REM wentylator faza 3
kolor$(14) = "0E 20 20 20": REM srednia szarosc
kolor$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza

REM rejestry przezroczyste gracza
kolor$(16) = "10 18 02 02": REM sweter + zero
kolor$(17) = "11 18 02 02": REM
kolor$(18) = "12 18 02 02": REM
kolor$(19) = "13 18 02 02": REM
kolor$(20) = "14 22 12 00": REM sweter + liscie
kolor$(21) = "15 3F 00 00": REM
kolor$(22) = "16 2F 09 09": REM sweter + framuga okna
kolor$(23) = "17 2B 08 00": REM sweter + doniczka drzewa
kolor$(24) = "18 25 16 24": REM sweter + niebo
kolor$(25) = "19 3F 3F 3F": REM sweter + slonce
kolor$(26) = "1A 16 0F 0F": REM sweter + framuga zew
kolor$(27) = "1B 3F 3F 3F": REM
kolor$(28) = "1C 3F 3F 3F": REM
kolor$(29) = "1D 3F 3F 3F": REM
kolor$(30) = "1E 20 10 10": REM sweter + przyciski
REM kolor 31 (1F) zastrzezony dla gracza
kolor$(32) = "20 0A 13 29": REM spodnie + zero
kolor$(33) = "21 0A 13 29": REM
kolor$(34) = "22 0A 13 29": REM
kolor$(35) = "23 0A 13 29": REM
kolor$(36) = "24 05 1D 24": REM spodnie+ liscie
kolor$(37) = "25 3F 3F 3F": REM
kolor$(38) = "26 1B 1B 32": REM spodnie + framuga okna
kolor$(39) = "27 1A 10 3F": REM spodnie + doniczka
kolor$(40) = "28 00 1A 3F": REM spodnie + niebo
kolor$(41) = "29 3F 3F 3F": REM spodnie +slonce
kolor$(42) = "2A 10 14 20": REM spodnie + framuga zew
kolor$(43) = "2B 3F 3F 3F": REM
kolor$(44) = "2C 3F 3F 3F": REM
kolor$(45) = "2D 3F 3F 3F": REM
kolor$(46) = "2E 3F 3F 3F": REM
REM rejestr 47 (2F) zastrzezony dla gracza

REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF)
REM rejestry nieprzezroczyste

kolor$(31) = "1F 2F 09 09": REM sweter
kolor$(47) = "2F 0D 1A 37": REM spodnie
kolor$(63) = "3F 1A 1A 1A": REM wlosy i buty
kolor$(79) = "4F 10 10 10": REM pasek2
kolor$(95) = "5F 3F 2F 0F":
kolor$(111) = "6F 3F 30 20": REM skora1
REM kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych
kolor$(143) = "8F 32 22 02": REM nos
REM kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych
REM kolor$(175) = "AF 22 02 02": REM sweter3
kolor$(191) = "BF 20 20 20": REM pasek
kolor$(207) = "CF 37 27 06": REM usta
REM FF- zarezerwowany dla przeslony

REM rejestry jednokierunkowe
kolor$(198) = "C6 20 20 20"
kolor$(199) = "C7 20 20 20"

REM bloczek

kolor$(224) = "E0 00 00 00": REM
kolor$(225) = "E1 04 04 04": REM
kolor$(226) = "E2 08 08 08": REM
kolor$(227) = "E3 0B 0B 0B": REM
kolor$(228) = "E4 10 10 10": REM
kolor$(229) = "E5 14 14 14": REM
kolor$(230) = "E6 18 18 18": REM
kolor$(231) = "E7 1B 1B 1B": REM
kolor$(232) = "E8 20 20 20": REM
kolor$(233) = "E9 24 24 24": REM
kolor$(234) = "EA 28 28 28": REM
kolor$(235) = "EB 2B 2B 2B": REM
kolor$(236) = "EC 30 30 30": REM
kolor$(237) = "ED 34 34 34": REM
kolor$(238) = "EE 38 38 38": REM
kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika

REM kolor 240 - przeslona
kolor$(240) = "F0 38 38 38"

REM cegly male niebieskie

kolor$(249) = "F9 22 27 30": REM krawedz
kolor$(250) = "FA 09 0E 14": REM fuga
kolor$(251) = "FB 11 17 1F": REM cegla

REM cegly male czerwone

kolor$(252) = "FC 30 27 27": REM krawedz
kolor$(253) = "FD 14 0E 0E": REM fuga
kolor$(254) = "FE 1F 17 17": REM cegla
kolor$(255) = "FF 28 28 28": REM przeslona

FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2)
red$ = "&H" + MID$(kolor$(i), 4, 2)
gre$ = "&H" + MID$(kolor$(i), 7, 2)
blu$ = "&H" + MID$(kolor$(i), 10, 2)
REM PRINT rej$; " "; red$; " "; gre$; " "; blu$
rej = VAL(rej$)
red = VAL(red$)
gre = VAL(gre$)
blu = VAL(blu$)
REM PRINT rej; " "; red; " "; gre; " "; blu

PALETTE rej, red + gre * 256 + blu * 65536
NEXT i

END SUB

SUB plansze

REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** roomy*16+roomx

REM kody plansz +++nr.po.ok.we.se_kw_dod
REM ************ plansze wiersza roomy=0

p$(0) = "h22233322d.0.UI.YO....GN________!"
p$(1) = "h000fff11h.1....MD....__________!"
p$(2) = "h11133333f.2.UI.HE....___EQ_____!"
p$(3) = "hh2223cchh.3..........SJ________!"
p$(4) = "h300033fff.4....ZK....__________!"
p$(5) = "h2001c333f.5....LG....______AQG_!"
p$(6) = "h111g3322f.6....LD....___EQ_F[Q_!"
p$(7) = "hh222ff11d.7.BE.......aH_ZI_MdO_!"
p$(8) = "hhDDDfCCCg.8..........__________!"
p$(9) = "hhhhhf111c.9..........__________!"
p$(10) = "hhhhhf222g.A..........GG_EQ_____!"
p$(11) = "hh333f111d.B....HG....__________!"
p$(12) = "hhffff333g.C..........__________!"
p$(13) = "h22233333c.D.UN.aK.DF.MK____AYC_!"
p$(14) = "h111ff22hh.E..........___aG_BLM_!"
p$(15) = "h3333311cc.F....ZK....aH____AIG_!"

REM ************ plansze wiersza roomy=1

p$(16) = "d333c2223h.0.......FN.__________!"
p$(17) = "h33330003h.1.WH.SO....dE____COM_!"
p$(18) = "ff333111ff.2.WJ.ML....__________!"
p$(19) = "hc222c333c.3..........___QQ_____!"
p$(20) = "f31113333h.4.UM.aI.aO.__________!"
p$(21) = "f333aa333h.5..........RN_GQ_____!"
p$(22) = "ffff333fff.6....DJ....aM____G[M_!"
p$(23) = "dd333a33hh.7..........__________!"
p$(24) = "gg333333ff.8.AK....IF.__________!"
p$(25) = "cc3322333c.9.WM.......eF________!"
p$(26) = "gg331133hh.A....LF....aO________!"
p$(27) = "ddaa22cccc.B..........__________!"
p$(28) = "g33300333h.C.AM....aO.__________!"
p$(29) = "c33311333c.D.0M.......ZK____AQO_!"
p$(30) = "h3322233dd.E.BE....aF.__________!"
p$(31) = "c33111333h.F.AM.bD....___QQ_COH_!"

REM ************* plansze wiersza roomy=2

p$(32) = "h333ff333c.0..........KE_WQ_____!"
p$(33) = "h33332222c.1....KD....UP____CGI_!"
p$(34) = "faaaa0000h.2....WO.VI.__________!"
p$(35) = "ccccc1111f.3....MM....___EQ_____!"
p$(36) = "h33333223h.4.WI.FP....SM________!"
p$(37) = "haa33200af.5.UJ....GL.______HIE_!"
p$(38) = "f333c111ah.6....aM....UP________!"
p$(39) = "hh333d333g.7....YP....___KQ_____!"
p$(40) = "ff3333333g.8.#I.......KK____CGN_!"
p$(41) = "c33g33d33c.9..........__________!"
p$(42) = "hh3333333g.A.WM.LI....__________!"
p$(43) = "cc333322cc.B.UJ.......__________!"
p$(44) = "hhaacc00hh.C.BE....JG.ZM____AQM_!"
p$(45) = "c333cc11gg.D....aN....______AQM_!"
p$(46) = "dd33cc22hh.E..........______AQE_!"
p$(47) = "hh3331113c.F.UK....VI.___EQ_____!"

REM ************ plansze wiersza roomy=3

p$(48) = "c33332222f.0....ZM.ZD.SF____COI_!"
p$(49) = "ccccc1111h.1..........__________!"
p$(50) = "ha3222333c.2.#F.LO....UO_SQ_____!"
p$(51) = "ff3111333f.3.WM.YI.VI.SJ_GQ_____!"
p$(52) = "h3333c333f.4..........NG____CKK_!"
p$(53) = "ff333c222f.5....ZO....SG________!"
p$(54) = "hhaaff000f.6.BE.......___KQ_____!"
p$(55) = "gggg33111f.7....LO.VJ.______IYM_!"
p$(56) = "gg3322ffff.8..........GG________!"
p$(57) = "cccc00hfff.9..........__________!"
p$(58) = "gg33DDffff.A..........___KK_CCH_!"
p$(59) = "cccccfffff.B.......TL.__________!"
p$(60) = "hh3333333f.C....KK....DP________!"
p$(61) = "g333333hhh.D.UJ....TF.______CKK_!"
p$(62) = "hh3222333f.E..........___GQ_____!"
p$(63) = "c331113hhh.F....ZK....__________!"

REM ****************** plansze wiersza roomy=4

p$(64) = "f22322322h.0....DD....SP_YQ_CKK_!"
p$(65) = "h00f00f00h.1..........__________!"
p$(66) = "c11311311f.2....aP.KP.__________!"
p$(67) = "ff3332223h.3.UJ.ML....___YQ_____!"
p$(68) = "f3333111hh.4.WJ.YL....__________!"
p$(69) = "ffaafaaaff.5.......VI.__________!"
p$(70) = "ffa333c33h.6....OG....SQ_YQ_____!"
p$(71) = "ff223c33cd.7....SN....GN_TI_MdM_!": REM startowa
p$(72) = "ff113cc33d.8..........MO____JVO_!"
p$(73) = "ff33cc33ff.9..........______COI_!"
p$(74) = "ff3333333d.A.WM.LI.ZP.PP________!"
p$(75) = "ff2233333f.B.UM.......___EQ_____!"
p$(76) = "ff11333hhh.C.......KH.__________!"
p$(77) = "h333333333.D.BE.SK....bF____CKK_!"
p$(78) = "ff22233hhh.E.UJ.......______FEE_!"
p$(79) = "h311133fff.F.WJ.......MM________!"

REM ******************* plansze wiersza roomy=5

p$(80) = "haf222faff.0.......VI.___KK_____!"
p$(81) = "hhf111222h.1..........SP____CKK_!"
p$(82) = "fa333c000h.2....GO....__________!"
p$(83) = "h222fa111f.3..........___YQ_____!"
p$(84) = "h111c2223h.4.0Q....EE.MM________!"
p$(85) = "ffffa111ff.5..........______GOE_!"
p$(86) = "h333c333af.6....DD....ZF_MQ_____!"
p$(87) = "dd333f333g.7.......VI.___aI_____!"
p$(88) = "dd3333333g.8.UN.KP....______COI_!"
p$(89) = "f32233f33f.9.......ED.KK________!"
p$(90) = "ddDDCC333h.A....ZK....KO________!"
p$(91) = "f33300f33f.B..........______COH_!"
p$(92) = "h33300333c.C....NN....__________!"
p$(93) = "333311333h.D.0M....TG.GG________!"
p$(94) = "h33222333c.E.AM.......__________!"
p$(95) = "ff3111333h.F.WM.FF....___YQ_____!"

REM ******************* plansze wiersza roomy=6

p$(96) = "fffa222hhh.0....EJ....___YM_____!"
p$(97) = "hhhf000bbb.1....SJ....ML____CMO_!"
p$(98) = "h222111hhh.2..........___KM_____!"
p$(99) = "f111aaafff.3....PH....ZJ________!"
p$(100) = "h222ahhhhh.4..........EE________!"
p$(101) = "f11133222h.5.0I.......___GQ_____!"
p$(102) = "ffffff000h.6....LO....__________!"
p$(103) = "gg333d111f.7....MO....aP________!"
p$(104) = "gg333hCCCh.8.......ZN.EG____HIE_!"
p$(105) = "ffffffDDDh.9..........__________!"
p$(106) = "hh333fCCCh.A.BE.......___KI_____!"
p$(107) = "ff3333111h.B.0I....KK.aP____CKK_!"
p$(108) = "cc22dd22ff.C..........__________!"
p$(109) = "hhDDffDDhh.D.......TJ.LN________!"
p$(110) = "ccc2222hhh.E..........__________!"
p$(111) = "hhhDDDDhhh.F..........TK_KM_____!"

REM ******************* plansze wiersza roomy=7

p$(112) = "hfaa222fff.0..........______COJ_!"
p$(113) = "bbbb000hhh.1....KK....__________!"
p$(114) = "h222111fff.2.BJ.......ZE____AIK_!"
p$(115) = "f000aaahhh.3..........___KM_____!"
p$(116) = "h000ahhhhh.4.......KF.__________!"
p$(117) = "h111hh222h.5..........KQ________!"
p$(118) = "hffaaa001f.6....KO....__________!"
p$(119) = "ff33ee00hh.7..........___KO_MdE_!"
p$(120) = "hh3333002h.8.BL.......______CCQ_!"
p$(121) = "hCCCffDDDh.9..........KO________!"
p$(122) = "hDDDccCCCh.A..........___MK_____!"
p$(123) = "hf333300Df.B.AL.......__________!"
p$(124) = "ffffff00hh.C....KN....______IOI_!"
p$(125) = "hhhhhf00fh.D.......TK.__________!"
p$(126) = "h33c3300ff.E..........KK____COG_!"
p$(127) = "hhheefDDhh.F....KN....__________!"

REM ***************** n/8 plansze wiersza roomy=8

p$(128) = "fffa222hhh.0..........KK________!"
p$(129) = "hbbb000hhh.1.UH.ZK....__________!"
p$(130) = "f222111fff.2.......KK.__________!"
p$(131) = "h000ccchhh.3..........______COI_!"
p$(132) = "h000afffhh.4.UK.......RN________!"
p$(133) = "h333ff222h.5....KO....__________!"
p$(134) = "ffffff000f.6.......aN.______DQK_!"
p$(135) = "hhhhha000h.7..........______ESK_!"
p$(136) = "hh3333000h.8....KG....______CKK_!"
p$(137) = "h33333111h.9..........KK________!"
p$(138) = "h33333222h.A.BG.......__________!"
p$(139) = "ffCCff00ff.B....KN....______KaE_!"
p$(140) = "hfDDff00hh.C.......TH.______JKM_!"
p$(141) = "hhhaac00fh.D.0L.......__________!"
p$(142) = "f3333300ff.E....SI....______COL_!"
p$(143) = "hhheefDDhh.F..........]H________!"

REM ***************** n/9 plansze wiersza roomy=9

p$(144) = "haaa222ffh.0....SD....______COH_!"
p$(145) = "heee000hhh.1.......DK.__________!"
p$(146) = "f222111hhh.2.AH.......KK________!"
p$(147) = "h000aaahhh.3..........______IOJ_!"
p$(148) = "h000ahhhhh.4....KH....__________!"
p$(149) = "h111hhhhhh.5..........___KG_____!"
p$(150) = "ffffaa222h.6.......ZK.______HEM_!"
p$(151) = "hhaaaa000h.7.UL.......__________!"
p$(152) = "hh3333000h.8.AL.......dI________!"
p$(153) = "h33333111h.9....SD....______GOK_!"
p$(154) = "h33333222h.A..........______FGH_!"
p$(155) = "ff223300Dh.B.BL.......__________!"
p$(156) = "hfDDff00hh.C.......SK.__________!"
p$(157) = "hhhaac00fh.D....KK....______DYK_!"
p$(158) = "f3333300hh.E..........KK____ECI_!"
p$(159) = "haa333DDhh.F.WL....DK.__________!"

REM tablica serc
FOR xr = 0 TO 15
FOR yr = 0 TO 9
s = xr + yr * 16
znak$ = MID$(p$(s), 23, 1)
IF znak$ <> "_" THEN serca(xr, yr) = 1
NEXT yr: NEXT xr

REM tablica wind
pozycjewind(1) = 0
pozycjewind(2) = 4
pozycjewind(3) = 7
END SUB

SUB rysowanie

FOR yw = 0 TO 9
el$ = MID$(kod$, yw + 1, 1)
y16 = yw * 18

REM tymczasowe sygnalizacje bledow:

IF el$ = "Q" OR el$ = "L" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "P" OR el$ = "W" OR el$ = "=" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "A" OR el$ = "B" OR el$ = "U" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "@" THEN COLOR 15: LINE (0, y16)-(200, y16)

REM elementy uzupelniajace

IF el$ = "C" THEN
PUT (128, y16), szaretlo4, PSET: PUT (192, y16), szaretlo4, PSET
PUT (256, y16), szaretlo4, PSET
PUT (0, y16), blok4, PSET: PUT (64, y16), blok2, PSET:
PUT (96, y16), bloks, PSET: PUT (112, y16), blokk, PSET
END IF

IF el$ = "D" THEN
PUT (0, y16), szaretlo4, PSET: PUT (64, y16), szaretlo4, PSET
PUT (128, y16), szaretlo4, PSET
PUT (192, y16), blokp, PSET: PUT (208, y16), blok4, PSET
PUT (272, y16), blok2, PSET: PUT (304, y16), bloks, PSET
END IF

REM czesc automatyczna, znaki a-h
ascii = ASC(el$)

IF ascii > 96 THEN
bity = ascii - 97
PUT (0, y16), blok4, PSET:
pop1 = 0
pop2 = 0
pop3 = 0

IF (bity AND 4) = 4 THEN PUT (64, y16), blok4, PSET: pop1 = 1
IF (bity AND 4) = 0 THEN PUT (48, y16), blokk, PSET: PUT (64, y16), szaretlo4, PSET: pop1 = 0
REM
IF (bity AND 2) = 2 THEN pop2 = 1: PUT (128, y16), blok4, PSET: IF pop1 = 0 THEN PUT (128, y16), blokp, PSET
IF (bity AND 2) = 0 THEN pop2 = 0: PUT (128, y16), szaretlo4, PSET: IF pop1 = 1 THEN PUT (112, y16), blokk, PSET
REM
IF (bity AND 1) = 1 THEN pop3 = 1: PUT (192, y16), blok4, PSET: IF pop2 = 0 THEN PUT (192, y16), blokp, PSET
IF (bity AND 1) = 0 THEN pop3 = 0: PUT (192, y16), szaretlo4, PSET: IF pop2 = 1 THEN PUT (176, y16), blokk, PSET
PUT (256, y16), blok4, PSET
IF pop3 = 0 THEN PUT (256, y16), blokp, PSET
END IF

REM znaki 0-3

IF ascii < 58 THEN
bity = ascii - 48
IF (bity AND 2) = 2 THEN PUT (0, y16), blokk, PSET
IF (bity AND 2) = 0 THEN PUT (0, y16), szaretlo, PSET
PUT (16, y16), szaretlo4, PSET
PUT (80, y16), szaretlo4, PSET
PUT (144, y16), szaretlo4, PSET
PUT (208, y16), szaretlo4, PSET
PUT (272, y16), szaretlo2, PSET

IF (bity AND 1) = 1 THEN PUT (304, y16), blokp, PSET
IF (bity AND 1) = 0 THEN PUT (304, y16), szaretlo, PSET
END IF

NEXT yw

REM rysowanie podestow

el$ = MID$(kod$, 14, 1)
IF el$ = "" OR el$ = "." THEN GOTO dodatek

el2$ = MID$(kod$, 15, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "#" THEN PUT (0, yo), ceg40, PSET
IF el$ = "W" THEN PUT (0, yo), ceg4plus20plus4, PSET
IF el$ = "U" THEN PUT (0, yo), ceg17plus17, PSET
IF el$ = "0" THEN PUT (0, yo), ceg13plus13, PSET
IF el$ = "A" THEN FOR xx = 0 TO 4: PUT (16 + xx * 64, yo), ceg2, PSET: NEXT xx
IF el$ = "B" THEN FOR xx = 0 TO 5: PUT (64 + xx * 32, yo), ceg2, PSET: NEXT xx

REM dodatkowy element
dodatek:

el$ = MID$(kod$, 29, 1)
IF el$ = "" OR el$ = "_" THEN GOTO okna
el2$ = MID$(kod$, 30, 1)
xo = (ASC(el2$) - 65) * 8
el2$ = MID$(kod$, 31, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "A" THEN
PUT (xo, yo), blokp, PSET: PUT (xo, yo + 18), blokp, PSET
PUT (xo + 16, yo), blok2, PSET: PUT (xo + 16, yo + 18), blok2, PSET
PUT (xo + 48, yo), blokk, PSET: PUT (xo + 48, yo + 18), blokk, PSET
END IF

IF el$ = "B" THEN COLOR 235: LINE (xo + 5, yo)-(xo + 9, yo + 35), , BF
IF el$ = "C" THEN PUT (xo, yo), ceg2, PSET: PUT (xo + 32, yo), ceg2, PSET: PUT (xo + 64, yo), ceg2, PSET
IF el$ = "D" THEN LINE (xo, yo)-(xo + 22, yo + 17), 235, BF: LINE (xo + 42, yo)-(xo + 63, yo + 17), 235, BF
IF el$ = "E" THEN LINE (xo, yo)-(xo + 5, yo + 35), 235, BF: LINE (xo + 26, yo + 36)-(xo + 31, yo + 72), 235, BF
REM niebieskie klocki
IF el$ = "F" THEN PUT (xo, yo), nieb, PSET
IF el$ = "G" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo), nieb, PSET
IF el$ = "H" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo + 36), nieb, PSET
IF el$ = "I" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo - 36), nieb, PSET
REM jednokierunkowe bramki
IF el$ = "J" THEN PSET (xo - 2, yo), 199: DRAW "R18 D35 L18 U35 F18 U1 G18"
IF el$ = "K" THEN PSET (xo - 2, yo), 198: DRAW "R18 D35 L18 U35 R18 G18 U1 F18"
REM zaslonka
IF el$ = "L" THEN LINE (xo, yo)-(xo + 15, yo + 35), 255, BF
REM winda
xwindy = -10: ywindy = -10
IF el$ = "M" THEN
LINE (xo, yo)-(xo + 23, yo + 35), 10, BF
LINE (xo, yo)-(xo, yo + 36), 6
LINE (xo + 3, yo + 7)-(xo + 5, yo + 17), 14, BF
LINE (xo + 1, yo)-(xo + 23, yo), 9
PSET (xo + 4, yo + 8), 12
PSET (xo + 4, yo + 10), 5: DRAW "D7 C14 R1 U2 L2 U2 R2 U2 L2"
xwindy = xo: ywindy = yo
COLOR 8: LOCATE (ywindy / 8) + 2, 34
IF roomy = 0 THEN PRINT "1"
IF roomy = 4 THEN PRINT "2"
IF roomy = 7 THEN PRINT "3"
END IF

okna:

REM rysowanie okien

el$ = MID$(kod$, 17, 1)
IF el$ = "" OR el$ = "." THEN GOTO serce
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 18, 1)
yo = (ASC(el$) - 65) * 9
IF roomy < 2 THEN PUT (xo, yo), window2, PSET
IF roomy > 1 AND roomy < 5 THEN PUT (xo, yo), window1, PSET
IF roomy > 4 THEN PUT (xo, yo), window3, PSET

serce:
REM serce
xserca = -20: yserca = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 23, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xserca = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 24, 1)
yserca = (ASC(el$) - 65) * 9
GET (xserca, yserca)-(xserca + 15, yserca + 7), tlo
PSET (xserca, yserca + 1), 5
DRAW "D2 F1 U4 R1 D5 F1 U5 E1 D5 E1 U4 F1 D2"

donica:
el$ = MID$(kod$, 26, 1)
IF el$ = "" OR el$ = "_" THEN GOTO wentyl
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 27, 1)
yo = (ASC(el$) - 65) * 9 + 2
PUT (xo, yo), palma, PSET

wentyl:
el$ = MID$(kod$, 20, 1)
IF el$ = "" OR el$ = "." THEN GOTO koniecrysowania
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 21, 1)
yo = (ASC(el$) - 65) * 9
PUT (xo, yo), wentylator, PSET

koniecrysowania:

COLOR 15

END SUB

Piotr-246 · Gość

DECLARE SUB dzwiek (ktory!)

REM Gra "Serca", UWAGA wersja gry wymaga
REM emulatora o predkosci 6075 cyklow
REM wymaga pliku bitmap1.scr utworzonego przez modul bsave.bas

DECLARE SUB animacja ()
DECLARE SUB rysowanie ()
DECLARE SUB palety ()
DECLARE SUB plansze ()
DECLARE SUB cegly ()

REM plansza startowa:
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
roomx = 7: roomy = 4

DIM SHARED kolor$(0 TO 255)
DIM pamiec(0 TO 128) AS LONG
DIM poledzialania(0 TO 240) AS LONG
DIM SHARED pozycjewind(1 TO 3) AS INTEGER
DIM SHARED p$(0 TO 159)
DIM SHARED kod$
DIM SHARED serca(0 TO 15, 0 TO 9) AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED xwindy AS INTEGER, ywindy AS INTEGER

REM pamiec tla pod wziatek

DIM SHARED tlo(0 TO 32) AS LONG

REM tlo

DIM SHARED szaretlo(0 TO 74) AS LONG
DIM SHARED szaretlo2(0 TO 148) AS LONG
DIM SHARED szaretlo4(0 TO 300) AS LONG
REM dane elementow planszy

DIM SHARED ceg2(0 TO 75) AS LONG
DIM SHARED ceg40(0 TO 730) AS LONG
DIM SHARED ceg17plus17(0 TO 730) AS LONG
DIM SHARED ceg13plus13(0 TO 760) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 750) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED nieb(0 TO 145) AS LONG

DIM SHARED blokp(0 TO 74) AS LONG
DIM SHARED bloks(0 TO 74) AS LONG
DIM SHARED blokk(0 TO 74) AS LONG
DIM SHARED blok2(0 TO 158) AS LONG
DIM SHARED blok4(0 TO 296) AS LONG

REM ****************** DANE ANIMACJI

DIM SHARED znakp1(0 TO 128) AS LONG
DIM SHARED znakl1(0 TO 128) AS LONG
DIM SHARED znakp2(0 TO 128) AS LONG
DIM SHARED znakl2(0 TO 128) AS LONG
DIM SHARED znakp3(0 TO 128) AS LONG
DIM SHARED znakl3(0 TO 128) AS LONG
DIM SHARED vertd1(0 TO 128) AS LONG

REM matryce okien

DIM SHARED window1(0 TO 160) AS LONG
DIM SHARED window2(0 TO 160) AS LONG
DIM SHARED window3(0 TO 160) AS LONG

DIM SHARED wentylator(0 TO 64) AS LONG

REM ************************* DANE STARTOWE

SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci

x = 200: y = 35: xs = 200: ys = 35: REM wspol. pocz. gracza na ekr.
licz = -1: REM wartosc start. zegara
kolwent = 30 + 30 * 256 + 30 * 65536: REM kolor lopat wentylatora

REM ***** SUB palety - ustawienie nowych wartosci barw
palety

REM ***** SUB cegly - zapelnienie pozostalych tablic
cegly

REM SUB plansze - wypelnienie tablicy wygladu plansz
plansze

REM ************************* START POMIESZCZENIA

rysuj:

kod$ = p$(roomx + roomy * 16)

REM ******************** rysowanie pomieszczenia
t0 = PEEK(1132): REM pomiar czasu rysowania

REM SUB rysowanie - rysowanie planszy
rysowanie

IF przejechal = 1 THEN y = ywindy + 3: ys = ywindy + 3: przejechal = 0

REM pomiar czasu rysowania
t1 = PEEK(1132):

REM menu na dole
LINE (0, 180)-(319, 182), 234, BF
LOCATE 25, 15: PRINT "L-SHIFT ALT P-SHIFT";
LOCATE 24, 2: COLOR 3: PRINT "T:"; t0; "/"; t1; FRE(-2);
PRINT " ROOM:"; roomx; "/"; roomy; "--";

REM **************** zapamietanie pola pod graczem
GET (x, y)-(x + 15, y + 31), pamiec
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
REM PUT (x, y), vertd1, PSET
liczsercaroom = 0: zrobione = 0
GOTO postaw
REM *************************** PETLA GLOWNA

petla:
dx = 0: dy = 0
IF dzwiekbrania = 1 THEN dzwiekbrania = 0: dzwiek (2)

REM ******************* czas gry w sekundach

se$ = MID$(TIME$, 7, 2)
se = VAL(se$)
IF se <> ses THEN licz = licz + 1
ses = se
LOCATE 25, 2: COLOR 15: PRINT "Czas:"; licz;

REM ************************ petla opozniajaca
FOR delay = 1 TO 700: NEXT delay

REM faza wentylatora

komorka = PEEK(1132) / 1.5
faz = INT(komorka)
IF faz / 3 = INT(faz / 3) THEN faza = 0
IF (faz + 1) / 3 = INT((faz + 1) / 3) THEN faza = 1
IF (faz + 2) / 3 = INT((faz + 2) / 3) THEN faza = 2
FOR i = 0 TO 2: i16 = i * 16
IF faza = 0 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, 0
IF faza = 1 THEN PALETTE 11 + i16, 0: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, kolwent
IF faza = 2 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, 0: PALETTE 13 + i16, kolwent
NEXT i

REM ************************ sprawdzenie klawiszy

alt = 0: lshift = 0: pshift = 0: skos = 0

k$ = INKEY$
IF k$ = "f" THEN roomx = roomx - 1: GOTO rysuj
IF k$ = "h" THEN roomx = roomx + 1: GOTO rysuj
IF k$ = "t" THEN roomy = roomy - 1: GOTO rysuj
IF k$ = "b" THEN roomy = roomy + 1: GOTO rysuj
IF k$ = CHR$(27) THEN END

IF x >= xwindy AND y - ywindy < 10 THEN
IF k$ = "1" OR k$ = "2" THEN GOSUB przejazd: GOTO rysuj
IF k$ = "3" THEN GOSUB przejazd: GOTO rysuj
END IF

REM klawisz alt - wznoszenie sie
IF (PEEK(1047) AND 8) = 8 THEN alt = 1
IF (PEEK(1047) AND 2) = 2 THEN lshift = 1
IF (PEEK(1047) AND 1) = 1 THEN pshift = 1

REM bezruch = grawitacja
IF lshift = 0 AND pshift = 0 AND alt = 0 THEN dy = 2: vert = 1: obrot = 0: przebiervert = 0: GOTO czy

POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury

IF lshift = 1 THEN dx = -4: dy = 2: obrot = -1: vert = 0
IF pshift = 1 THEN dx = 4: dy = 2: obrot = 1: vert = 0
IF alt = 1 THEN dy = -4: vert = 1
IF dx <> 0 AND dy <> 0 THEN skos = 1
czy:

REM ************ sprawdzenie czy jest przejscie do innej planszy

IF x + dx > 300 THEN x = 5: xs = 5: roomx = roomx + 1: GOTO rysuj
IF x + dx < 3 THEN x = 300: xs = 300: roomx = roomx - 1: GOTO rysuj
IF y + dy > 144 THEN y = 5: ys = 5: roomy = roomy + 1: GOTO rysuj
IF y + dy < 4 THEN y = 145: ys = 145: roomy = roomy - 1: GOTO rysuj

REM *********** sprawdzenie czy ruch jest mozliwy
REM sprawdzenie przeszkody. Przeszkoda sa kolory > 200

xmozliwy = 0: xniemozliwy = 0
ymozliwy = 0: yniemozliwy = 0

REM sprawdzenie sasiedztwa obok

IF dx > 0 THEN
FOR i = 0 TO 31: punkt = POINT(x + 19, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 198 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF

IF dx < 0 THEN
FOR i = 0 TO 31: punkt = POINT(x - 3, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 199 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF xniemozliwy = 0 THEN xmozliwy = 1
IF xniemozliwy = 1 THEN xmozliwy = 0

REM sprawdzenie sasiedztwa gora dol

IF dy > 0 THEN
FOR i = 0 TO 15:
IF POINT(x + i, y + 32) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y + 33) > 200 THEN yniemozliwy = 1: EXIT FOR

NEXT i
END IF

IF dy < 0 THEN
FOR i = 0 TO 15
IF POINT(x + i, y - 4) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y - 5) > 200 THEN yniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF yniemozliwy = 0 THEN ymozliwy = 1
IF yniemozliwy = 1 THEN ymozliwy = 0

REM ruch gdy oba mozliwe x oraz y
IF ymozliwy = 1 AND xmozliwy = 1 THEN IF dx <> 0 OR dy <> 0 THEN GOTO ruch

REM szczegolne przypadki gdy tylko x albo y mozliwy
IF ymozliwy = 0 AND xmozliwy = 1 THEN dy = 0: GOTO czy
IF ymozliwy = 1 AND xmozliwy = 0 THEN dx = 0: GOTO czy

REM ruch niemozliwy powrot petli glownej bez zmian pozostaja x y

x = xs: y = ys
GOTO petla

REM ***************** RUCH

ruch:

x = x + dx: y = y + dy
IF dy = 0 AND przebieranie = 0 AND alt = 0 THEN dzwiek (1): REM dzwiek chodzenia

REM ******************** czy jest wziatek
deltawx = ABS(x + 4 - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek

REM ************************************** operacja odswiezania tla
postaw:
REM punkt 1 zapamietanie nowego pola dzialania (brudnego)
REM w oparciu o nowe x,y

GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania

REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo

deltax = x - xs: deltay = y - ys
inversx = -1 * deltax: inversy = -1 * deltay
inver4 = INT(inversx / 4)
FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = (yt + inversy) * 6
FOR xt = 0 TO 3
index1 = 1 + (yt6 + 24) + (xt + inver4) + 1
index2 = 1 + yt4 + xt
poledzialania(index1) = pamiec(index2)
NEXT xt: NEXT yt

REM zmazanie serca z pola dzialania

IF liczsercaroom = 1 AND zrobione = 0 THEN
zrobione = 1
PUT (x - 4, y - 4), poledzialania, PSET
PUT (xserca, yserca), tlo, PSET
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
END IF

REM nowa mala pamiec

FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = yt * 6
FOR xt = 0 TO 3:
index1 = 1 + (yt6 + 24) + (xt + 1):
index2 = 1 + yt4 + xt:
pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt

REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU

REM aby nie rysowac dwoch postaci w przypadku skosu
IF skos = 1 THEN GOTO bezskosu:

REM ************************** ruch w dol lub gore

IF vert = 1 THEN wkleic = 7: GOTO wklej
bezskosu:
REM ************************** ruch w lewo

IF obrot = -1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1
IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 1: GOTO wklej
IF przebieranie = 1 THEN wkleic = 2: GOTO wklej
IF przebieranie = 2 THEN wkleic = 3: GOTO wklej
END IF

REM ****************** ruch w prawo

IF obrot = 1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1

IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 4: GOTO wklej
IF przebieranie = 1 THEN wkleic = 5: GOTO wklej
IF przebieranie = 2 THEN wkleic = 6: GOTO wklej
END IF

xs = x: ys = y

GOTO petla

wklej:

IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt
IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt
IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt
IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt
IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt
IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt
IF wkleic = 7 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)): NEXT xt: NEXT yt

REM wklejenie wyniku operacji na tablicy:
PUT (x - 4, y - 4), poledzialania, PSET

xs = x: ys = y
GOTO petla

REM GOSUB-RETURN****************************** obsluga wziatku

wziatek:
IF serca(roomx, roomy) = 0 THEN GOTO niemawziatku
IF liczsercaroom = 1 THEN GOTO niemawziatku
serca(roomx, roomy) = 0
liczserca = liczserca + 1
PUT (xserca, yserca), tlo, PSET

liczsercaroom = 1
dzwiekbrania = 1

LOCATE 1, 1: COLOR 6: PRINT liczserca;
niemawziatku:
RETURN

REM GOSUB-RETURN przejazd:
przejazd:
pietro = VAL(k$)
roomy = pozycjewind(pietro)

FOR i = 23 TO 0 STEP -1
LINE (xwindy + i, ywindy)-(xwindy + i, ywindy + 35), 255
FOR j = 1 TO 7500: NEXT j
NEXT i
CLS
FOR i = 1 TO 30000: NEXT i
przejechal = 1
RETURN

SUB cegly

BLOAD "bitmap1.scr"

REM INPUT a$
REM pobranie z ekranu tablic elementow
REM uwaga! wysokosc elementu to 9 lub 18 px

GET (0, 0)-(31, 8), ceg2
GET (0, 0)-(319, 8), ceg40
GET (0, 9)-(319, 17), ceg17plus17
GET (0, 18)-(319, 26), ceg13plus13
GET (0, 27)-(319, 35), ceg4plus20plus4
GET (0, 36)-(15, 53), szaretlo
GET (0, 36)-(31, 53), szaretlo2
GET (0, 36)-(63, 53), szaretlo4: REM 36+18=46+8=54

GET (16, 64)-(31, 79), palma
GET (32, 64)-(47, 81), blokp
GET (48, 64)-(63, 81), bloks
GET (64, 64)-(79, 81), blokk
GET (0, 156)-(31, 173), blok2
GET (0, 156)-(63, 173), blok4
GET (80, 64)-(111, 81), nieb

GET (0, 88)-(15, 119), znakl1
GET (16, 88)-(31, 119), znakp1
GET (32, 88)-(47, 119), znakl2
GET (48, 88)-(63, 119), znakp2
GET (64, 88)-(79, 119), znakl3
GET (80, 88)-(95, 119), znakp3
GET (96, 88)-(111, 119), vertd1

GET (0, 120)-(31, 139), window1
GET (32, 120)-(63, 139), window2
GET (64, 120)-(95, 139), window3
GET (0, 140)-(15, 155), wentylator
CLS
END SUB

SUB dzwiek (ktory)

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

REM DREPTANIE
IF ktory = 1 THEN

REM ewentualnie:
REM OUT 66, 30: OUT 66, 0
REM OUT 66, 164: OUT 66, 2
REM OUT 66, 130: OUT 66, 1
REM OUT 66, 74: OUT 66, 0
REM OUT 66, 220: OUT 66, 1

FOR i = 1 TO 10
OUT 66, 30: OUT 66, 0
OUT 66, 84: OUT 66, 2
OUT 66, 30: OUT 66, 0
OUT 66, 94: OUT 66, 2
OUT 66, 10: OUT 66, 0
OUT 66, 40: OUT 66, 2
OUT 66, 84: OUT 66, 0
OUT 66, 10: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
END IF

REM zabranie serca

IF ktory = 2 THEN
OUT 66, 32: OUT 66, 3
FOR i = 1 TO 6000: NEXT i
OUT 66, 204: OUT 66, 4
FOR i = 1 TO 6000: NEXT i
END IF

REM wylaczenie glosnika
OUT 97, stary.port

END SUB

SUB palety

REM palety kolorow *********************************
REM max koloru=3F

FOR i = 0 TO 255: kolor$(i) = "00 00 00 00"
PALETTE i, 31 + 31 * 256 + 31 * 65536: NEXT i

REM kolory za ludzikiem

kolor$(0) = "00 00 00 00": REM rejestr zero- wolny
kolor$(1) = "01 05 05 06": REM tlo plyta
kolor$(2) = "02 02 03 02": REM tlo fuga
kolor$(3) = "03 07 06 06": REM tlo krawedz
kolor$(4) = "04 00 22 00": REM liscie
kolor$(5) = "05 3F 08 00": REM serce
kolor$(6) = "06 30 30 30": REM framuga okna
kolor$(7) = "07 28 0A 00": REM doniczka drzewa
kolor$(8) = "08 00 21 39": REM niebo
kolor$(9) = "09 3F 3F 00": REM slonce
kolor$(10) = "0A 14 14 14": REM framuga zewnetrzna
kolor$(11) = "0B 00 00 00": REM wentylator faza 1
kolor$(12) = "0C 00 00 00": REM wentylator faza 2
kolor$(13) = "0D 00 00 00": REM wentylator faza 3
kolor$(14) = "0E 20 20 20": REM srednia szarosc
kolor$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza

REM rejestry przezroczyste gracza
kolor$(16) = "10 18 02 02": REM sweter + zero
kolor$(17) = "11 18 02 02": REM
kolor$(18) = "12 18 02 02": REM
kolor$(19) = "13 18 02 02": REM
kolor$(20) = "14 22 12 00": REM sweter + liscie
kolor$(21) = "15 3F 00 00": REM
kolor$(22) = "16 2F 09 09": REM sweter + framuga okna
kolor$(23) = "17 2B 08 00": REM sweter + doniczka drzewa
kolor$(24) = "18 25 16 24": REM sweter + niebo
kolor$(25) = "19 3F 3F 3F": REM sweter + slonce
kolor$(26) = "1A 16 0F 0F": REM sweter + framuga zew
kolor$(27) = "1B 3F 3F 3F": REM
kolor$(28) = "1C 3F 3F 3F": REM
kolor$(29) = "1D 3F 3F 3F": REM
kolor$(30) = "1E 20 10 10": REM sweter + przyciski
REM kolor 31 (1F) zastrzezony dla gracza
kolor$(32) = "20 0A 13 29": REM spodnie + zero
kolor$(33) = "21 0A 13 29": REM
kolor$(34) = "22 0A 13 29": REM
kolor$(35) = "23 0A 13 29": REM
kolor$(36) = "24 05 1D 24": REM spodnie+ liscie
kolor$(37) = "25 3F 3F 3F": REM
kolor$(38) = "26 1B 1B 32": REM spodnie + framuga okna
kolor$(39) = "27 1A 10 3F": REM spodnie + doniczka
kolor$(40) = "28 00 1A 3F": REM spodnie + niebo
kolor$(41) = "29 3F 3F 3F": REM spodnie +slonce
kolor$(42) = "2A 10 14 20": REM spodnie + framuga zew
kolor$(43) = "2B 3F 3F 3F": REM
kolor$(44) = "2C 3F 3F 3F": REM
kolor$(45) = "2D 3F 3F 3F": REM
kolor$(46) = "2E 3F 3F 3F": REM
REM rejestr 47 (2F) zastrzezony dla gracza

REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF)
REM rejestry nieprzezroczyste

kolor$(31) = "1F 2F 09 09": REM sweter
kolor$(47) = "2F 0D 1A 37": REM spodnie
kolor$(63) = "3F 1A 1A 1A": REM wlosy i buty
kolor$(79) = "4F 10 10 10": REM pasek2
kolor$(95) = "5F 3F 2F 0F":
kolor$(111) = "6F 3F 30 20": REM skora1
REM kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych
kolor$(143) = "8F 32 22 02": REM nos
REM kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych
REM kolor$(175) = "AF 22 02 02": REM sweter3
kolor$(191) = "BF 20 20 20": REM pasek
kolor$(207) = "CF 37 27 06": REM usta
REM FF- zarezerwowany dla przeslony

REM rejestry jednokierunkowe
kolor$(198) = "C6 20 20 20"
kolor$(199) = "C7 20 20 20"

REM bloczek

kolor$(224) = "E0 00 00 00": REM
kolor$(225) = "E1 04 04 04": REM
kolor$(226) = "E2 08 08 08": REM
kolor$(227) = "E3 0B 0B 0B": REM
kolor$(228) = "E4 10 10 10": REM
kolor$(229) = "E5 14 14 14": REM
kolor$(230) = "E6 18 18 18": REM
kolor$(231) = "E7 1B 1B 1B": REM
kolor$(232) = "E8 20 20 20": REM
kolor$(233) = "E9 24 24 24": REM
kolor$(234) = "EA 28 28 28": REM
kolor$(235) = "EB 2B 2B 2B": REM
kolor$(236) = "EC 30 30 30": REM
kolor$(237) = "ED 34 34 34": REM
kolor$(238) = "EE 38 38 38": REM
kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika

REM kolor 240 - przeslona
kolor$(240) = "F0 38 38 38"

REM cegly male niebieskie

kolor$(249) = "F9 22 27 30": REM krawedz
kolor$(250) = "FA 09 0E 14": REM fuga
kolor$(251) = "FB 11 17 1F": REM cegla

REM cegly male czerwone

kolor$(252) = "FC 30 27 27": REM krawedz
kolor$(253) = "FD 14 0E 0E": REM fuga
kolor$(254) = "FE 1F 17 17": REM cegla
kolor$(255) = "FF 28 28 28": REM przeslona

FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2)
red$ = "&H" + MID$(kolor$(i), 4, 2)
gre$ = "&H" + MID$(kolor$(i), 7, 2)
blu$ = "&H" + MID$(kolor$(i), 10, 2)
REM PRINT rej$; " "; red$; " "; gre$; " "; blu$
rej = VAL(rej$)
red = VAL(red$)
gre = VAL(gre$)
blu = VAL(blu$)
REM PRINT rej; " "; red; " "; gre; " "; blu

PALETTE rej, red + gre * 256 + blu * 65536
NEXT i

END SUB

SUB plansze

REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** roomy*16+roomx

REM kody plansz +++nr.po.ok.we.se_kw_dod
REM ************ plansze wiersza roomy=0

p$(0) = "h22233322d.0.UI.YO....GN________!"
p$(1) = "h000fff11h.1....MD....__________!"
p$(2) = "h11133333f.2.UI.HE....___EQ_____!"
p$(3) = "hh2223cchh.3..........SJ________!"
p$(4) = "h300033fff.4....ZK....__________!"
p$(5) = "h2001c333f.5....LG....______AQG_!"
p$(6) = "h111g3322f.6....LD....___EQ_F[Q_!"
p$(7) = "hh222ff11d.7.BE.......aH_ZI_MdO_!"
p$(8) = "hhDDDfCCCg.8..........__________!"
p$(9) = "hhhhhf111c.9..........__________!"
p$(10) = "hhhhhf222g.A..........GG_EQ_____!"
p$(11) = "hh333f111d.B....HG....__________!"
p$(12) = "hhffff333g.C..........__________!"
p$(13) = "h22233333c.D.UN.aK.DF.MK____AYC_!"
p$(14) = "h111ff22hh.E..........___aG_BLM_!"
p$(15) = "h3333311cc.F....ZK....aH____AIG_!"

REM ************ plansze wiersza roomy=1

p$(16) = "d333c2223h.0.......FN.__________!"
p$(17) = "h33330003h.1.WH.SO....dE____COM_!"
p$(18) = "ff333111ff.2.WJ.ML....__________!"
p$(19) = "hc222c333c.3..........___QQ_____!"
p$(20) = "f31113333h.4.UM.aI.aO.__________!"
p$(21) = "f333aa333h.5..........RN_GQ_____!"
p$(22) = "ffff333fff.6....DJ....aM____G[M_!"
p$(23) = "dd333a33hh.7..........__________!"
p$(24) = "gg333333ff.8.AK....IF.__________!"
p$(25) = "cc3322333c.9.WM.......eF________!"
p$(26) = "gg331133hh.A....LF....aO________!"
p$(27) = "ddaa22cccc.B..........__________!"
p$(28) = "g33300333h.C.AM....aO.__________!"
p$(29) = "c33311333c.D.0M.......ZK____AQO_!"
p$(30) = "h3322233dd.E.BE....aF.__________!"
p$(31) = "c33111333h.F.AM.bD....___QQ_COH_!"

REM ************* plansze wiersza roomy=2

p$(32) = "h333ff333c.0..........KE_WQ_____!"
p$(33) = "h33332222c.1....KD....UP____CGI_!"
p$(34) = "faaaa0000h.2....WO.VI.__________!"
p$(35) = "ccccc1111f.3....MM....___EQ_____!"
p$(36) = "h33333223h.4.WI.FP....SM________!"
p$(37) = "haa33200af.5.UJ....GL.______HIE_!"
p$(38) = "f333c111ah.6....aM....UP________!"
p$(39) = "hh333d333g.7....YP....___KQ_____!"
p$(40) = "ff3333333g.8.#I.......KK____CGN_!"
p$(41) = "c33g33d33c.9..........__________!"
p$(42) = "hh3333333g.A.WM.LI....__________!"
p$(43) = "cc333322cc.B.UJ.......__________!"
p$(44) = "hhaacc00hh.C.BE....JG.ZM____AQM_!"
p$(45) = "c333cc11gg.D....aN....______AQM_!"
p$(46) = "dd33cc22hh.E..........______AQE_!"
p$(47) = "hh3331113c.F.UK....VI.___EQ_____!"

REM ************ plansze wiersza roomy=3

p$(48) = "c33332222f.0....ZM.ZD.SF____COI_!"
p$(49) = "ccccc1111h.1..........__________!"
p$(50) = "ha3222333c.2.#F.LO....UO_SQ_____!"
p$(51) = "ff3111333f.3.WM.YI.VI.SJ_GQ_____!"
p$(52) = "h3333c333f.4..........NG____CKK_!"
p$(53) = "ff333c222f.5....ZO....SG________!"
p$(54) = "hhaaff000f.6.BE.......___KQ_____!"
p$(55) = "gggg33111f.7....LO.VJ.______IYM_!"
p$(56) = "gg3322ffff.8..........GG________!"
p$(57) = "cccc00hfff.9..........__________!"
p$(58) = "gg33DDffff.A..........___KK_CCH_!"
p$(59) = "cccccfffff.B.......TL.__________!"
p$(60) = "hh3333333f.C....KK....DP________!"
p$(61) = "g333333hhh.D.UJ....TF.______CKK_!"
p$(62) = "hh3222333f.E..........___GQ_____!"
p$(63) = "c331113hhh.F....ZK....__________!"

REM ****************** plansze wiersza roomy=4

p$(64) = "f22322322h.0....DD....SP_YQ_CKK_!"
p$(65) = "h00f00f00h.1..........__________!"
p$(66) = "c11311311f.2....aP.KP.__________!"
p$(67) = "ff3332223h.3.UJ.ML....___YQ_____!"
p$(68) = "f3333111hh.4.WJ.YL....__________!"
p$(69) = "ffaafaaaff.5.......VI.__________!"
p$(70) = "ffa333c33h.6....OG....SQ_YQ_____!"
p$(71) = "ff223c33cd.7....SN....GN_TI_MdM_!": REM startowa
p$(72) = "ff113cc33d.8..........MO____JVO_!"
p$(73) = "ff33cc33ff.9..........______COI_!"
p$(74) = "ff3333333d.A.WM.LI.ZP.PP________!"
p$(75) = "ff2233333f.B.UM.......___EQ_____!"
p$(76) = "ff11333hhh.C.......KH.__________!"
p$(77) = "h333333333.D.BE.SK....bF____CKK_!"
p$(78) = "ff22233hhh.E.UJ.......______FEE_!"
p$(79) = "h311133fff.F.WJ.......MM________!"

REM ******************* plansze wiersza roomy=5

p$(80) = "haf222faff.0.......VI.___KK_____!"
p$(81) = "hhf111222h.1..........SP____CKK_!"
p$(82) = "fa333c000h.2....GO....__________!"
p$(83) = "h222fa111f.3..........___YQ_____!"
p$(84) = "h111c2223h.4.0Q....EE.MM________!"
p$(85) = "ffffa111ff.5..........______GOE_!"
p$(86) = "h333c333af.6....DD....ZF_MQ_____!"
p$(87) = "dd333f333g.7.......VI.___aI_____!"
p$(88) = "dd3333333g.8.UN.KP....______COI_!"
p$(89) = "f32233f33f.9.......ED.KK________!"
p$(90) = "ddDDCC333h.A....ZK....KO________!"
p$(91) = "f33300f33f.B..........______COH_!"
p$(92) = "h33300333c.C....NN....__________!"
p$(93) = "333311333h.D.0M....TG.GG________!"
p$(94) = "h33222333c.E.AM.......__________!"
p$(95) = "ff3111333h.F.WM.FF....___YQ_____!"

REM ******************* plansze wiersza roomy=6

p$(96) = "fffa222hhh.0....EJ....___YM_____!"
p$(97) = "hhhf000bbb.1....SJ....ML____CMO_!"
p$(98) = "h222111hhh.2..........___KM_____!"
p$(99) = "f111aaafff.3....PH....ZJ________!"
p$(100) = "h222ahhhhh.4..........EE________!"
p$(101) = "f11133222h.5.0I.......___GQ_____!"
p$(102) = "ffffff000h.6....LO....__________!"
p$(103) = "gg333d111f.7....MO....aP________!"
p$(104) = "gg333hCCCh.8.......ZN.EG____HIE_!"
p$(105) = "ffffffDDDh.9..........__________!"
p$(106) = "hh333fCCCh.A.BE.......___KI_____!"
p$(107) = "ff3333111h.B.0I....KK.aP____CKK_!"
p$(108) = "cc22dd22ff.C..........__________!"
p$(109) = "hhDDffDDhh.D.......TJ.LN________!"
p$(110) = "ccc2222hhh.E..........__________!"
p$(111) = "hhhDDDDhhh.F..........TK_KM_____!"

REM ******************* plansze wiersza roomy=7

p$(112) = "hfaa222fff.0..........______COJ_!"
p$(113) = "bbbb000hhh.1....KK....__________!"
p$(114) = "h222111fff.2.BJ.......ZE____AIK_!"
p$(115) = "f000aaahhh.3..........___KM_____!"
p$(116) = "h000ahhhhh.4.......KF.__________!"
p$(117) = "h111hh222h.5..........KQ________!"
p$(118) = "hffaaa001f.6....KO....__________!"
p$(119) = "ff33ee00hh.7..........___KO_MdE_!"
p$(120) = "hh3333002h.8.BL.......______CCQ_!"
p$(121) = "hCCCffDDDh.9..........KO________!"
p$(122) = "hDDDccCCCh.A..........___MK_____!"
p$(123) = "hf333300Df.B.AL.......__________!"
p$(124) = "ffffff11hh.C....KN....______IOI_!"
p$(125) = "hhhhhf22fh.D.......TK.__________!"
p$(126) = "h33c3300ff.E..........KK____COG_!"
p$(127) = "hhheefDDhh.F....KN....__________!"

REM ***************** n/8 plansze wiersza roomy=8

p$(128) = "fffa222hhh.0..........KK________!"
p$(129) = "hbbb000hhh.1.UH.ZK....__________!"
p$(130) = "f222111fff.2.......KK.__________!"
p$(131) = "h000ccchhh.3..........______COI_!"
p$(132) = "h000afffhh.4.UK.......RN________!"
p$(133) = "h333ff222h.5....KO....__________!"
p$(134) = "ffffff000h.6.......aN.______DQK_!"
p$(135) = "hhhhha000h.7..........______ESK_!"
p$(136) = "hh3333000c.8....KG....______CKK_!"
p$(137) = "h33333111h.9..........KK________!"
p$(138) = "h33333222h.A.BG.......__________!"
p$(139) = "ffCCff00ff.B....KN....______KaE_!"
p$(140) = "hfDDff00hh.C.......TH.______JKM_!"
p$(141) = "hhhaac00fh.D.0L.......__________!"
p$(142) = "f3333300ff.E....SI....______COL_!"
p$(143) = "hhheefDDhh.F..........]H________!"

REM ***************** n/9 plansze wiersza roomy=9

p$(144) = "haaa222ffh.0....SD....______COH_!"
p$(145) = "heee000hhh.1.......DK.__________!"
p$(146) = "f222111hhh.2.AH.......KK________!"
p$(147) = "h000aaahhh.3..........______IOJ_!"
p$(148) = "h000ahhhhh.4....KH....__________!"
p$(149) = "h111hhhhhh.5..........___KG_____!"
p$(150) = "hhffaa222h.6.......ZK.______HEM_!"
p$(151) = "hhaaaa000h.7.UL.......__________!"
p$(152) = "ccc333000h.8.AL.......dI________!"
p$(153) = "h33333111h.9....SD....______GOK_!"
p$(154) = "h33333222h.A..........______FGH_!"
p$(155) = "ff223300Dh.B.BL.......__________!"
p$(156) = "hfDDff00hh.C.......SK.__________!"
p$(157) = "hhhaac00fh.D....KK....______DYK_!"
p$(158) = "f3333300hh.E..........KK____ECI_!"
p$(159) = "haa333DDhh.F.WL....DK.__________!"

REM tablica serc
FOR xr = 0 TO 15
FOR yr = 0 TO 9
s = xr + yr * 16
znak$ = MID$(p$(s), 23, 1)
IF znak$ <> "_" THEN serca(xr, yr) = 1
NEXT yr: NEXT xr

REM tablica wind
pozycjewind(1) = 0
pozycjewind(2) = 4
pozycjewind(3) = 7
END SUB

SUB rysowanie

FOR yw = 0 TO 9
el$ = MID$(kod$, yw + 1, 1)
y16 = yw * 18

REM tymczasowe sygnalizacje bledow:

IF el$ = "Q" OR el$ = "L" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "P" OR el$ = "W" OR el$ = "=" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "A" OR el$ = "B" OR el$ = "U" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "@" THEN COLOR 15: LINE (0, y16)-(200, y16)

REM elementy uzupelniajace

IF el$ = "C" THEN
PUT (128, y16), szaretlo4, PSET: PUT (192, y16), szaretlo4, PSET
PUT (256, y16), szaretlo4, PSET
PUT (0, y16), blok4, PSET: PUT (64, y16), blok2, PSET:
PUT (96, y16), bloks, PSET: PUT (112, y16), blokk, PSET
END IF

IF el$ = "D" THEN
PUT (0, y16), szaretlo4, PSET: PUT (64, y16), szaretlo4, PSET
PUT (128, y16), szaretlo4, PSET
PUT (192, y16), blokp, PSET: PUT (208, y16), blok4, PSET
PUT (272, y16), blok2, PSET: PUT (304, y16), bloks, PSET
END IF

REM czesc automatyczna, znaki a-h
ascii = ASC(el$)

IF ascii > 96 THEN
bity = ascii - 97
PUT (0, y16), blok4, PSET:
pop1 = 0
pop2 = 0
pop3 = 0

IF (bity AND 4) = 4 THEN PUT (64, y16), blok4, PSET: pop1 = 1
IF (bity AND 4) = 0 THEN PUT (48, y16), blokk, PSET: PUT (64, y16), szaretlo4, PSET: pop1 = 0
REM
IF (bity AND 2) = 2 THEN pop2 = 1: PUT (128, y16), blok4, PSET: IF pop1 = 0 THEN PUT (128, y16), blokp, PSET
IF (bity AND 2) = 0 THEN pop2 = 0: PUT (128, y16), szaretlo4, PSET: IF pop1 = 1 THEN PUT (112, y16), blokk, PSET
REM
IF (bity AND 1) = 1 THEN pop3 = 1: PUT (192, y16), blok4, PSET: IF pop2 = 0 THEN PUT (192, y16), blokp, PSET
IF (bity AND 1) = 0 THEN pop3 = 0: PUT (192, y16), szaretlo4, PSET: IF pop2 = 1 THEN PUT (176, y16), blokk, PSET
PUT (256, y16), blok4, PSET
IF pop3 = 0 THEN PUT (256, y16), blokp, PSET
END IF

REM znaki 0-3

IF ascii < 58 THEN
bity = ascii - 48
IF (bity AND 2) = 2 THEN PUT (0, y16), blokk, PSET
IF (bity AND 2) = 0 THEN PUT (0, y16), szaretlo, PSET
PUT (16, y16), szaretlo4, PSET
PUT (80, y16), szaretlo4, PSET
PUT (144, y16), szaretlo4, PSET
PUT (208, y16), szaretlo4, PSET
PUT (272, y16), szaretlo2, PSET

IF (bity AND 1) = 1 THEN PUT (304, y16), blokp, PSET
IF (bity AND 1) = 0 THEN PUT (304, y16), szaretlo, PSET
END IF

NEXT yw

REM rysowanie podestow

el$ = MID$(kod$, 14, 1)
IF el$ = "" OR el$ = "." THEN GOTO dodatek

el2$ = MID$(kod$, 15, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "#" THEN PUT (0, yo), ceg40, PSET
IF el$ = "W" THEN PUT (0, yo), ceg4plus20plus4, PSET
IF el$ = "U" THEN PUT (0, yo), ceg17plus17, PSET
IF el$ = "0" THEN PUT (0, yo), ceg13plus13, PSET
IF el$ = "A" THEN FOR xx = 0 TO 4: PUT (16 + xx * 64, yo), ceg2, PSET: NEXT xx
IF el$ = "B" THEN FOR xx = 0 TO 5: PUT (64 + xx * 32, yo), ceg2, PSET: NEXT xx

REM dodatkowy element
dodatek:

el$ = MID$(kod$, 29, 1)
IF el$ = "" OR el$ = "_" THEN GOTO okna
el2$ = MID$(kod$, 30, 1)
xo = (ASC(el2$) - 65) * 8
el2$ = MID$(kod$, 31, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "A" THEN
PUT (xo, yo), blokp, PSET: PUT (xo, yo + 18), blokp, PSET
PUT (xo + 16, yo), blok2, PSET: PUT (xo + 16, yo + 18), blok2, PSET
PUT (xo + 48, yo), blokk, PSET: PUT (xo + 48, yo + 18), blokk, PSET
END IF

IF el$ = "B" THEN COLOR 235: LINE (xo + 5, yo)-(xo + 9, yo + 35), , BF
IF el$ = "C" THEN PUT (xo, yo), ceg2, PSET: PUT (xo + 32, yo), ceg2, PSET: PUT (xo + 64, yo), ceg2, PSET
IF el$ = "D" THEN LINE (xo, yo)-(xo + 22, yo + 17), 235, BF: LINE (xo + 42, yo)-(xo + 63, yo + 17), 235, BF
IF el$ = "E" THEN LINE (xo, yo)-(xo + 5, yo + 35), 235, BF: LINE (xo + 26, yo + 36)-(xo + 31, yo + 72), 235, BF
REM niebieskie klocki
IF el$ = "F" THEN PUT (xo, yo), nieb, PSET
IF el$ = "G" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo), nieb, PSET
IF el$ = "H" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo + 36), nieb, PSET
IF el$ = "I" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo - 36), nieb, PSET
REM jednokierunkowe bramki
IF el$ = "J" THEN PSET (xo - 2, yo), 199: DRAW "R18 D35 L18 U35 F18 U1 G18"
IF el$ = "K" THEN PSET (xo - 2, yo), 198: DRAW "R18 D35 L18 U35 R18 G18 U1 F18"
REM zaslonka
IF el$ = "L" THEN LINE (xo, yo)-(xo + 15, yo + 35), 255, BF
REM winda
xwindy = -10: ywindy = -10
IF el$ = "M" THEN
LINE (xo, yo)-(xo + 23, yo + 35), 10, BF
LINE (xo, yo)-(xo, yo + 36), 6
LINE (xo + 3, yo + 7)-(xo + 5, yo + 17), 14, BF
LINE (xo + 1, yo)-(xo + 23, yo), 9
PSET (xo + 4, yo + 8), 12
PSET (xo + 4, yo + 10), 5: DRAW "D7 C14 R1 U2 L2 U2 R2 U2 L2"
xwindy = xo: ywindy = yo
COLOR 8: LOCATE (ywindy / 8) + 2, 34
IF roomy = 0 THEN PRINT "1"
IF roomy = 4 THEN PRINT "2"
IF roomy = 7 THEN PRINT "3"
END IF

okna:

REM rysowanie okien

el$ = MID$(kod$, 17, 1)
IF el$ = "" OR el$ = "." THEN GOTO serce
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 18, 1)
yo = (ASC(el$) - 65) * 9
IF roomy < 2 THEN PUT (xo, yo), window2, PSET
IF roomy > 1 AND roomy < 5 THEN PUT (xo, yo), window1, PSET
IF roomy > 4 THEN PUT (xo, yo), window3, PSET

serce:
REM serce
xserca = -20: yserca = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 23, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xserca = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 24, 1)
yserca = (ASC(el$) - 65) * 9
GET (xserca, yserca)-(xserca + 15, yserca + 7), tlo
PSET (xserca, yserca + 1), 5
DRAW "D2 F1 U4 R1 D5 F1 U5 E1 D5 E1 U4 F1 D2"

donica:
el$ = MID$(kod$, 26, 1)
IF el$ = "" OR el$ = "_" THEN GOTO wentyl
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 27, 1)
yo = (ASC(el$) - 65) * 9 + 2
PUT (xo, yo), palma, PSET

wentyl:
el$ = MID$(kod$, 20, 1)
IF el$ = "" OR el$ = "." THEN GOTO koniecrysowania
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 21, 1)
yo = (ASC(el$) - 65) * 9
PUT (xo, yo), wentylator, PSET

koniecrysowania:

COLOR 15

END SUB

Piotr-246 · Gość

DECLARE SUB dzwiek (ktory!)

REM Gra "Serca", UWAGA wersja gry wymaga
REM emulatora o predkosci 6075 cyklow
REM wymaga pliku bitmap1.scr utworzonego przez modul bsave.bas

DECLARE SUB animacja ()
DECLARE SUB rysowanie ()
DECLARE SUB palety ()
DECLARE SUB plansze ()
DECLARE SUB cegly ()

REM plansza startowa:
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
roomx = 7: roomy = 4

DIM SHARED kolor$(0 TO 255)
DIM pamiec(0 TO 128) AS LONG
DIM poledzialania(0 TO 240) AS LONG
DIM SHARED pozycjewind(1 TO 3) AS INTEGER
DIM SHARED p$(0 TO 159)
DIM SHARED kod$
DIM SHARED serca(0 TO 15, 0 TO 9) AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED xwindy AS INTEGER, ywindy AS INTEGER

REM pamiec tla pod wziatek

DIM SHARED tlo(0 TO 32) AS LONG

REM tlo

DIM SHARED szaretlo(0 TO 74) AS LONG
DIM SHARED szaretlo2(0 TO 148) AS LONG
DIM SHARED szaretlo4(0 TO 300) AS LONG
REM dane elementow planszy

DIM SHARED ceg2(0 TO 75) AS LONG
DIM SHARED ceg4(0 TO 144) AS LONG

DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED nieb(0 TO 145) AS LONG

DIM SHARED blokp(0 TO 74) AS LONG
DIM SHARED bloks(0 TO 74) AS LONG
DIM SHARED blokk(0 TO 74) AS LONG
DIM SHARED blok2(0 TO 158) AS LONG
DIM SHARED blok4(0 TO 296) AS LONG

REM ****************** DANE ANIMACJI

DIM SHARED znakp1(0 TO 128) AS LONG
DIM SHARED znakl1(0 TO 128) AS LONG
DIM SHARED znakp2(0 TO 128) AS LONG
DIM SHARED znakl2(0 TO 128) AS LONG
DIM SHARED znakp3(0 TO 128) AS LONG
DIM SHARED znakl3(0 TO 128) AS LONG
DIM SHARED vertd1(0 TO 128) AS LONG

REM matryce okien

DIM SHARED window1(0 TO 160) AS LONG
DIM SHARED window2(0 TO 160) AS LONG
DIM SHARED window3(0 TO 160) AS LONG

DIM SHARED wentylator(0 TO 64) AS LONG

REM ************************* DANE STARTOWE

SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci

x = 200: y = 35: xs = 200: ys = 35: REM wspol. pocz. gracza na ekr.
licz = -1: REM wartosc start. zegara
kolwent = 30 + 30 * 256 + 30 * 65536: REM kolor lopat wentylatora

REM ***** SUB palety - ustawienie nowych wartosci barw
palety

REM ***** SUB cegly - zapelnienie pozostalych tablic
cegly

REM SUB plansze - wypelnienie tablicy wygladu plansz
plansze

REM ************************* START POMIESZCZENIA

rysuj:

kod$ = p$(roomx + roomy * 16)

REM ******************** rysowanie pomieszczenia
t0 = PEEK(1132): REM pomiar czasu rysowania

REM SUB rysowanie - rysowanie planszy
rysowanie

IF przejechal = 1 THEN y = ywindy + 3: ys = ywindy + 3: przejechal = 0

REM pomiar czasu rysowania
t1 = PEEK(1132):

REM menu na dole
LINE (0, 180)-(319, 182), 234, BF
LOCATE 25, 15: PRINT "L-SHIFT ALT P-SHIFT";
LOCATE 24, 2: COLOR 3: PRINT "T:"; t0; "/"; t1; FRE(-2);
PRINT " ROOM:"; roomx; "/"; roomy; "--";

REM **************** zapamietanie pola pod graczem
GET (x, y)-(x + 15, y + 31), pamiec
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
REM PUT (x, y), vertd1, PSET
liczsercaroom = 0: zrobione = 0
GOTO postaw
REM *************************** PETLA GLOWNA

petla:
dx = 0: dy = 0
IF dzwiekbrania = 1 THEN dzwiekbrania = 0: dzwiek (2)

REM ******************* czas gry w sekundach

se$ = MID$(TIME$, 7, 2)
se = VAL(se$)
IF se <> ses THEN licz = licz + 1
ses = se
LOCATE 25, 2: COLOR 15: PRINT "Czas:"; licz;

REM ************************ petla opozniajaca
FOR delay = 1 TO 700: NEXT delay

REM faza wentylatora

komorka = PEEK(1132) / 1.5
faz = INT(komorka)
IF faz / 3 = INT(faz / 3) THEN faza = 0
IF (faz + 1) / 3 = INT((faz + 1) / 3) THEN faza = 1
IF (faz + 2) / 3 = INT((faz + 2) / 3) THEN faza = 2
FOR i = 0 TO 2: i16 = i * 16
IF faza = 0 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, 0
IF faza = 1 THEN PALETTE 11 + i16, 0: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, kolwent
IF faza = 2 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, 0: PALETTE 13 + i16, kolwent
NEXT i

REM ************************ sprawdzenie klawiszy

alt = 0: lshift = 0: pshift = 0: skos = 0

k$ = INKEY$
IF k$ = "f" THEN roomx = roomx - 1: GOTO rysuj
IF k$ = "h" THEN roomx = roomx + 1: GOTO rysuj
IF k$ = "t" THEN roomy = roomy - 1: GOTO rysuj
IF k$ = "b" THEN roomy = roomy + 1: GOTO rysuj
IF k$ = CHR$(27) THEN END

IF x >= xwindy AND y - ywindy < 10 THEN
IF k$ = "1" OR k$ = "2" THEN GOSUB przejazd: GOTO rysuj
IF k$ = "3" THEN GOSUB przejazd: GOTO rysuj
END IF

REM klawisz alt - wznoszenie sie
IF (PEEK(1047) AND 8) = 8 THEN alt = 1
IF (PEEK(1047) AND 2) = 2 THEN lshift = 1
IF (PEEK(1047) AND 1) = 1 THEN pshift = 1

REM bezruch = grawitacja
IF lshift = 0 AND pshift = 0 AND alt = 0 THEN dy = 2: vert = 1: obrot = 0: przebiervert = 0: GOTO czy

POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury

IF lshift = 1 THEN dx = -4: dy = 2: obrot = -1: vert = 0
IF pshift = 1 THEN dx = 4: dy = 2: obrot = 1: vert = 0
IF alt = 1 THEN dy = -4: vert = 1
IF dx <> 0 AND dy <> 0 THEN skos = 1
czy:

REM ************ sprawdzenie czy jest przejscie do innej planszy

IF x + dx > 300 THEN x = 5: xs = 5: roomx = roomx + 1: GOTO rysuj
IF x + dx < 3 THEN x = 300: xs = 300: roomx = roomx - 1: GOTO rysuj
IF y + dy > 144 THEN y = 5: ys = 5: roomy = roomy + 1: GOTO rysuj
IF y + dy < 4 THEN y = 145: ys = 145: roomy = roomy - 1: GOTO rysuj

REM *********** sprawdzenie czy ruch jest mozliwy
REM sprawdzenie przeszkody. Przeszkoda sa kolory > 200

xmozliwy = 0: xniemozliwy = 0
ymozliwy = 0: yniemozliwy = 0

REM sprawdzenie sasiedztwa obok

IF dx > 0 THEN
FOR i = 0 TO 31: punkt = POINT(x + 19, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 198 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF

IF dx < 0 THEN
FOR i = 0 TO 31: punkt = POINT(x - 3, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 199 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF xniemozliwy = 0 THEN xmozliwy = 1
IF xniemozliwy = 1 THEN xmozliwy = 0

REM sprawdzenie sasiedztwa gora dol

IF dy > 0 THEN
FOR i = 0 TO 15:
IF POINT(x + i, y + 32) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y + 33) > 200 THEN yniemozliwy = 1: EXIT FOR

NEXT i
END IF

IF dy < 0 THEN
FOR i = 0 TO 15
IF POINT(x + i, y - 4) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y - 5) > 200 THEN yniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF yniemozliwy = 0 THEN ymozliwy = 1
IF yniemozliwy = 1 THEN ymozliwy = 0

REM ruch gdy oba mozliwe x oraz y
IF ymozliwy = 1 AND xmozliwy = 1 THEN IF dx <> 0 OR dy <> 0 THEN GOTO ruch

REM szczegolne przypadki gdy tylko x albo y mozliwy
IF ymozliwy = 0 AND xmozliwy = 1 THEN dy = 0: GOTO czy
IF ymozliwy = 1 AND xmozliwy = 0 THEN dx = 0: GOTO czy

REM ruch niemozliwy powrot petli glownej bez zmian pozostaja x y

x = xs: y = ys
GOTO petla

REM ***************** RUCH

ruch:

x = x + dx: y = y + dy
IF dy = 0 AND przebieranie = 0 AND alt = 0 THEN dzwiek (1): REM dzwiek chodzenia

REM ******************** czy jest wziatek
deltawx = ABS(x + 4 - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek

REM ************************************** operacja odswiezania tla
postaw:
REM punkt 1 zapamietanie nowego pola dzialania (brudnego)
REM w oparciu o nowe x,y

GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania

REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo

deltax = x - xs: deltay = y - ys
inversx = -1 * deltax: inversy = -1 * deltay
inver4 = INT(inversx / 4)
FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = (yt + inversy) * 6
FOR xt = 0 TO 3
index1 = 1 + (yt6 + 24) + (xt + inver4) + 1
index2 = 1 + yt4 + xt
poledzialania(index1) = pamiec(index2)
NEXT xt: NEXT yt

REM zmazanie serca z pola dzialania

IF liczsercaroom = 1 AND zrobione = 0 THEN
zrobione = 1
PUT (x - 4, y - 4), poledzialania, PSET
PUT (xserca, yserca), tlo, PSET
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
END IF

REM nowa mala pamiec

FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = yt * 6
FOR xt = 0 TO 3:
index1 = 1 + (yt6 + 24) + (xt + 1):
index2 = 1 + yt4 + xt:
pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt

REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU

REM aby nie rysowac dwoch postaci w przypadku skosu
IF skos = 1 THEN GOTO bezskosu:

REM ************************** ruch w dol lub gore

IF vert = 1 THEN wkleic = 7: GOTO wklej
bezskosu:
REM ************************** ruch w lewo

IF obrot = -1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1
IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 1: GOTO wklej
IF przebieranie = 1 THEN wkleic = 2: GOTO wklej
IF przebieranie = 2 THEN wkleic = 3: GOTO wklej
END IF

REM ****************** ruch w prawo

IF obrot = 1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1

IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 4: GOTO wklej
IF przebieranie = 1 THEN wkleic = 5: GOTO wklej
IF przebieranie = 2 THEN wkleic = 6: GOTO wklej
END IF

xs = x: ys = y

GOTO petla

wklej:

IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt
IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt
IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt
IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt
IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt
IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt
IF wkleic = 7 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)): NEXT xt: NEXT yt

REM wklejenie wyniku operacji na tablicy:
PUT (x - 4, y - 4), poledzialania, PSET

xs = x: ys = y
GOTO petla

REM GOSUB-RETURN****************************** obsluga wziatku

wziatek:
IF serca(roomx, roomy) = 0 THEN GOTO niemawziatku
IF liczsercaroom = 1 THEN GOTO niemawziatku
serca(roomx, roomy) = 0
liczserca = liczserca + 1
PUT (xserca, yserca), tlo, PSET

liczsercaroom = 1
dzwiekbrania = 1

LOCATE 1, 1: COLOR 6: PRINT liczserca;
niemawziatku:
RETURN

REM GOSUB-RETURN przejazd:
przejazd:
pietro = VAL(k$)
roomy = pozycjewind(pietro)

FOR i = 23 TO 0 STEP -1
LINE (xwindy + i, ywindy)-(xwindy + i, ywindy + 35), 255
FOR j = 1 TO 7500: NEXT j
NEXT i
CLS
FOR i = 1 TO 30000: NEXT i
przejechal = 1
RETURN

SUB cegly

BLOAD "bitmap1.scr"

REM INPUT a$
REM pobranie z ekranu tablic elementow
REM uwaga! wysokosc elementu to 9 lub 18 px

GET (0, 0)-(31, 8), ceg2
GET (0, 0)-(63, 8), ceg4

GET (0, 36)-(15, 53), szaretlo
GET (0, 36)-(31, 53), szaretlo2
GET (0, 36)-(63, 53), szaretlo4

GET (16, 64)-(31, 79), palma
GET (32, 64)-(47, 81), blokp
GET (48, 64)-(63, 81), bloks
GET (64, 64)-(79, 81), blokk
GET (0, 156)-(31, 173), blok2
GET (0, 156)-(63, 173), blok4
GET (80, 64)-(111, 81), nieb

GET (0, 88)-(15, 119), znakl1
GET (16, 88)-(31, 119), znakp1
GET (32, 88)-(47, 119), znakl2
GET (48, 88)-(63, 119), znakp2
GET (64, 88)-(79, 119), znakl3
GET (80, 88)-(95, 119), znakp3
GET (96, 88)-(111, 119), vertd1

GET (0, 120)-(31, 139), window1
GET (32, 120)-(63, 139), window2
GET (64, 120)-(95, 139), window3
GET (0, 140)-(15, 155), wentylator
CLS
END SUB

SUB dzwiek (ktory)

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

REM DREPTANIE
IF ktory = 1 THEN

REM ewentualnie:
REM OUT 66, 30: OUT 66, 0
REM OUT 66, 164: OUT 66, 2
REM OUT 66, 130: OUT 66, 1
REM OUT 66, 74: OUT 66, 0
REM OUT 66, 220: OUT 66, 1

FOR i = 1 TO 10
OUT 66, 30: OUT 66, 0
OUT 66, 84: OUT 66, 2
OUT 66, 30: OUT 66, 0
OUT 66, 94: OUT 66, 2
OUT 66, 10: OUT 66, 0
OUT 66, 40: OUT 66, 2
OUT 66, 84: OUT 66, 0
OUT 66, 10: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
END IF

REM zabranie serca

IF ktory = 2 THEN
OUT 66, 32: OUT 66, 3
FOR i = 1 TO 6000: NEXT i
OUT 66, 204: OUT 66, 4
FOR i = 1 TO 6000: NEXT i
END IF

REM wylaczenie glosnika
OUT 97, stary.port

END SUB

SUB palety

REM palety kolorow *********************************
REM max koloru=3F

FOR i = 0 TO 255: kolor$(i) = "00 00 00 00"
PALETTE i, 31 + 31 * 256 + 31 * 65536: NEXT i

REM kolory za ludzikiem

kolor$(0) = "00 00 00 00": REM rejestr zero- wolny
kolor$(1) = "01 05 05 06": REM tlo plyta
kolor$(2) = "02 02 03 02": REM tlo fuga
kolor$(3) = "03 07 06 06": REM tlo krawedz
kolor$(4) = "04 00 22 00": REM liscie
kolor$(5) = "05 3F 08 00": REM serce
kolor$(6) = "06 30 30 30": REM framuga okna
kolor$(7) = "07 28 0A 00": REM doniczka drzewa
kolor$(8) = "08 00 21 39": REM niebo
kolor$(9) = "09 3F 3F 00": REM slonce
kolor$(10) = "0A 14 14 14": REM framuga zewnetrzna
kolor$(11) = "0B 00 00 00": REM wentylator faza 1
kolor$(12) = "0C 00 00 00": REM wentylator faza 2
kolor$(13) = "0D 00 00 00": REM wentylator faza 3
kolor$(14) = "0E 20 20 20": REM srednia szarosc
kolor$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza

REM rejestry przezroczyste gracza
kolor$(16) = "10 18 02 02": REM sweter + zero
kolor$(17) = "11 18 02 02": REM
kolor$(18) = "12 18 02 02": REM
kolor$(19) = "13 18 02 02": REM
kolor$(20) = "14 22 12 00": REM sweter + liscie
kolor$(21) = "15 3F 00 00": REM
kolor$(22) = "16 2F 09 09": REM sweter + framuga okna
kolor$(23) = "17 2B 08 00": REM sweter + doniczka drzewa
kolor$(24) = "18 25 16 24": REM sweter + niebo
kolor$(25) = "19 3F 3F 3F": REM sweter + slonce
kolor$(26) = "1A 16 0F 0F": REM sweter + framuga zew
kolor$(27) = "1B 3F 3F 3F": REM
kolor$(28) = "1C 3F 3F 3F": REM
kolor$(29) = "1D 3F 3F 3F": REM
kolor$(30) = "1E 20 10 10": REM sweter + przyciski
REM kolor 31 (1F) zastrzezony dla gracza
kolor$(32) = "20 0A 13 29": REM spodnie + zero
kolor$(33) = "21 0A 13 29": REM
kolor$(34) = "22 0A 13 29": REM
kolor$(35) = "23 0A 13 29": REM
kolor$(36) = "24 05 1D 24": REM spodnie+ liscie
kolor$(37) = "25 3F 3F 3F": REM
kolor$(38) = "26 1B 1B 32": REM spodnie + framuga okna
kolor$(39) = "27 1A 10 3F": REM spodnie + doniczka
kolor$(40) = "28 00 1A 3F": REM spodnie + niebo
kolor$(41) = "29 3F 3F 3F": REM spodnie +slonce
kolor$(42) = "2A 10 14 20": REM spodnie + framuga zew
kolor$(43) = "2B 3F 3F 3F": REM
kolor$(44) = "2C 3F 3F 3F": REM
kolor$(45) = "2D 3F 3F 3F": REM
kolor$(46) = "2E 3F 3F 3F": REM
REM rejestr 47 (2F) zastrzezony dla gracza

REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF)
REM rejestry nieprzezroczyste

kolor$(31) = "1F 2F 09 09": REM sweter
kolor$(47) = "2F 0D 1A 37": REM spodnie
kolor$(63) = "3F 1A 1A 1A": REM wlosy i buty
kolor$(79) = "4F 10 10 10": REM pasek2
kolor$(95) = "5F 3F 2F 0F":
kolor$(111) = "6F 3F 30 20": REM skora1
REM kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych
kolor$(143) = "8F 32 22 02": REM nos
REM kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych
REM kolor$(175) = "AF 22 02 02": REM sweter3
kolor$(191) = "BF 20 20 20": REM pasek
kolor$(207) = "CF 37 27 06": REM usta
REM FF- zarezerwowany dla przeslony

REM rejestry jednokierunkowe
kolor$(198) = "C6 20 20 20"
kolor$(199) = "C7 20 20 20"

REM bloczek

kolor$(224) = "E0 00 00 00": REM
kolor$(225) = "E1 04 04 04": REM
kolor$(226) = "E2 08 08 08": REM
kolor$(227) = "E3 0B 0B 0B": REM
kolor$(228) = "E4 10 10 10": REM
kolor$(229) = "E5 14 14 14": REM
kolor$(230) = "E6 18 18 18": REM
kolor$(231) = "E7 1B 1B 1B": REM
kolor$(232) = "E8 20 20 20": REM
kolor$(233) = "E9 24 24 24": REM
kolor$(234) = "EA 28 28 28": REM
kolor$(235) = "EB 2B 2B 2B": REM
kolor$(236) = "EC 30 30 30": REM
kolor$(237) = "ED 34 34 34": REM
kolor$(238) = "EE 38 38 38": REM
kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika

REM kolor 240 - przeslona
kolor$(240) = "F0 38 38 38"

REM cegly male niebieskie

kolor$(249) = "F9 22 27 30": REM krawedz
kolor$(250) = "FA 09 0E 14": REM fuga
kolor$(251) = "FB 11 17 1F": REM cegla

REM cegly male czerwone

kolor$(252) = "FC 30 27 27": REM krawedz
kolor$(253) = "FD 14 0E 0E": REM fuga
kolor$(254) = "FE 1F 17 17": REM cegla
kolor$(255) = "FF 28 28 28": REM przeslona

FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2)
red$ = "&H" + MID$(kolor$(i), 4, 2)
gre$ = "&H" + MID$(kolor$(i), 7, 2)
blu$ = "&H" + MID$(kolor$(i), 10, 2)
REM PRINT rej$; " "; red$; " "; gre$; " "; blu$
rej = VAL(rej$)
red = VAL(red$)
gre = VAL(gre$)
blu = VAL(blu$)
REM PRINT rej; " "; red; " "; gre; " "; blu

PALETTE rej, red + gre * 256 + blu * 65536
NEXT i

END SUB

SUB plansze

REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** roomy*16+roomx

REM kody plansz +++nr.po.ok.we.se_kw_dod
REM ************ plansze wiersza roomy=0

p$(0) = "h22233322d.0.UI.YO....GN________!"
p$(1) = "h000fff11h.1....MD....__________!"
p$(2) = "h11133333f.2.UI.HE....___EQ_____!"
p$(3) = "hh2223cchh.3..........SJ________!"
p$(4) = "h300033fff.4....ZK....__________!"
p$(5) = "h2001c333f.5....LG....______AQG_!"
p$(6) = "h111g3322f.6....LD....___EQ_F[Q_!"
p$(7) = "hh222ff11d.7.BE.......aH_ZI_MdO_!"
p$(8) = "hhDDDfCCCg.8..........______DQK_!"
p$(9) = "hhhhhf111c.9..........__________!"
p$(10) = "hhhhhf222g.A..........MO_EQ_____!"
p$(11) = "hh333f111d.B....HG....__________!"
p$(12) = "hhffff333g.C..........__________!"
p$(13) = "h22233333c.D.UN.aK.DF.MK____AYC_!"
p$(14) = "h111ff22hh.E..........___aG_BLM_!"
p$(15) = "h3333311cc.F....ZK....aH____AIG_!"

REM ************ plansze wiersza roomy=1

p$(16) = "d333c2223h.0.......FN.__________!"
p$(17) = "h33330003h.1.WH.SO....dE____COM_!"
p$(18) = "ff333111ff.2.WJ.ML....__________!"
p$(19) = "hc222c333c.3..........___QQ_____!"
p$(20) = "f31113333h.4.UM.aI.aO.__________!"
p$(21) = "f333aa333h.5..........RN_GQ_____!"
p$(22) = "ffff333fff.6....DJ....aM____G[M_!"
p$(23) = "dd333a33hh.7..........__________!"
p$(24) = "gg333333ff.8.AK....IF.__________!"
p$(25) = "cc3322333c.9.WM.......eF________!"
p$(26) = "gg331133hh.A....LF....aO________!"
p$(27) = "ddaa22cccc.B..........__________!"
p$(28) = "g33300333h.C.AM....aO.__________!"
p$(29) = "c33311333c.D.0M.......ZK____AQO_!"
p$(30) = "h3322233dd.E.BG....cE.__________!"
p$(31) = "c33111333h.F.AM.bD....___QQ_COH_!"

REM ************* plansze wiersza roomy=2

p$(32) = "h333ff333c.0..........KE_WQ_____!"
p$(33) = "h33332222c.1....KD....UP____CGI_!"
p$(34) = "faaaa0000h.2....WO.VI.__________!"
p$(35) = "ccccc1111f.3....MM....___EQ_____!"
p$(36) = "h33333223h.4.WI.FP....SM________!"
p$(37) = "haa33200af.5.UJ....GL.______HIE_!"
p$(38) = "f333c111ah.6....aM....UP________!"
p$(39) = "hh333d333g.7....YP....___KQ_____!"
p$(40) = "ff3333333g.8.#I.......KK____CGN_!"
p$(41) = "c33g33d33c.9..........__________!"
p$(42) = "hh3333333g.A.WM.LI....__________!"
p$(43) = "cc333322cc.B.UJ.......__________!"
p$(44) = "hhaacc00hh.C.BE....JG.ZM____AQM_!"
p$(45) = "c333cc11gg.D....aN....______AQM_!"
p$(46) = "dd33cc22hh.E..........___aG_AQE_!"
p$(47) = "hh3333113c.F.UJ....VI.___EQ_____!"

REM ************ plansze wiersza roomy=3

p$(48) = "c33332222f.0....ZM.ZD.SF____COI_!"
p$(49) = "ccccc1111h.1..........__________!"
p$(50) = "ha3222333c.2.#F.LO....UO_SQ_____!"
p$(51) = "ff3111333f.3.WM.YI.VI.SJ_GQ_____!"
p$(52) = "h3333c333f.4..........NG____CKK_!"
p$(53) = "ff333c222f.5....ZO....SG________!"
p$(54) = "hhaaff000f.6.BE.......___KQ_____!"
p$(55) = "gggg33111f.7....LO.VJ.______IYM_!"
p$(56) = "gg3322ffff.8..........GG________!"
p$(57) = "cccc00hfff.9..........__________!"
p$(58) = "gg33DDffff.A..........___KK_CCH_!"
p$(59) = "cccccfffff.B.......TL.__________!"
p$(60) = "hh3333333f.C....KK....DP________!"
p$(61) = "g333333hhh.D.UJ....TF.______CKK_!"
p$(62) = "hh3222333f.E..........___GQ_____!"
p$(63) = "c331113hhh.F....ZK....__________!"

REM ****************** plansze wiersza roomy=4

p$(64) = "f22322322h.0....DD....SP_YQ_CKK_!"
p$(65) = "h00f00f00h.1..........__________!"
p$(66) = "c11311311f.2....aP.KP.__________!"
p$(67) = "ff3332223h.3.UJ.ML....___YQ_____!"
p$(68) = "f3333111hh.4.WJ.YL....__________!"
p$(69) = "ffaafaaaff.5.......VI.__________!"
p$(70) = "ffa333c33h.6....OG....SQ_YQ_____!"
p$(71) = "ff223c33cd.7.0C.SN....GN_TI_MdM_!": REM startowa
p$(72) = "ff113cc33d.8..........MO____JVO_!"
p$(73) = "ff33cc33ff.9..........______COI_!"
p$(74) = "ff3333333d.A.WM.LI.ZP.PP________!"
p$(75) = "ff2233333f.B.UM.......___EQ_____!"
p$(76) = "ff11333hhh.C.......KH.__________!"
p$(77) = "h333333333.D.BE.SK....bF____CKK_!"
p$(78) = "ff222333hh.E.UK.......______FEE_!"
p$(79) = "h3111333ff.F.WK.......MM________!"

REM ******************* plansze wiersza roomy=5

p$(80) = "haf222faff.0.......VI.___KK_____!"
p$(81) = "hhf111222h.1..........SP____CKK_!"
p$(82) = "fa333c000h.2....GO....__________!"
p$(83) = "h222fa111f.3..........___YQ_____!"
p$(84) = "h111c2223h.4.0Q....EE.MM________!"
p$(85) = "ffffa111ff.5..........______GOE_!"
p$(86) = "h333c333af.6....DD....ZF_MQ_____!"
p$(87) = "dd333f333g.7.......VI.___aI_____!"
p$(88) = "dd3333333g.8.UN.KP....______COI_!"
p$(89) = "f32233f33f.9.......ED.KK________!"
p$(90) = "ddDDCC333h.A....ZK....KO________!"
p$(91) = "f33300f33f.B..........______COH_!"
p$(92) = "h33300333c.C....NN....__________!"
p$(93) = "333311333h.D.0M....TG.GG________!"
p$(94) = "h33222333c.E.AM.......__________!"
p$(95) = "ff3111333h.F.WM.FF....___YQ_____!"

REM ******************* plansze wiersza roomy=6

p$(96) = "fffa222hhh.0....EJ....___YM_____!"
p$(97) = "hhhf000bbb.1....SJ....ML____CMO_!"
p$(98) = "h333111hhh.2..........___KM_____!"
p$(99) = "f333aaafff.3....PH....ZJ________!"
p$(100) = "h222ahhhhh.4..........EE________!"
p$(101) = "f11133222h.5.0I.......___GQ_____!"
p$(102) = "ffffff000h.6....LO....__________!"
p$(103) = "gg333d111f.7....MO....aP________!"
p$(104) = "gg333hCCCh.8.......ZN.EG____HIE_!"
p$(105) = "ffffffDDDh.9..........______DQK_!"
p$(106) = "hh333fCCCh.A.BE.......___KI_____!"
p$(107) = "ff3333111h.B.0I....LK.aP____CON_!"
p$(108) = "cc22dd22ff.C..........__________!"
p$(109) = "hhDDffDDhh.D.......TJ.LN________!"
p$(110) = "ccc2222hhh.E..........__________!"
p$(111) = "hhhDDDDhhh.F..........TK_KM_____!"

REM ******************* plansze wiersza roomy=7

p$(112) = "hfaa222fff.0..........______COJ_!"
p$(113) = "bbbb000hhh.1....KK....__________!"
p$(114) = "h222111fff.2.BJ.......ZE____AIK_!"
p$(115) = "f000aaahhh.3..........___KM_____!"
p$(116) = "h000ahhhhh.4.......KF.__________!"
p$(117) = "h111hh222h.5..........KQ________!"
p$(118) = "hffaaa001f.6....KO....__________!"
p$(119) = "ff33ee00hh.7..........___KO_MdE_!"
p$(120) = "hh3333002h.8.BL.......______CCQ_!"
p$(121) = "hCCCffDDDh.9..........KO________!"
p$(122) = "hDDDccCCCh.A..........___MK_____!"
p$(123) = "hf333300Df.B.AL.......__________!"
p$(124) = "ffffff11hh.C....KN....______IOI_!"
p$(125) = "hhhhhf22fh.D.......TK.__________!"
p$(126) = "h33c3300ff.E..........KK____COG_!"
p$(127) = "hhheefDDhh.F....KN....__________!"

REM ***************** n/8 plansze wiersza roomy=8

p$(128) = "fffa222hhh.0..........KK________!"
p$(129) = "hbbb000hhh.1.UH.ZK....__________!"
p$(130) = "f222111fff.2.......KK.__________!"
p$(131) = "h000ccchhh.3..........______COI_!"
p$(132) = "h000afffhh.4.UK.......RN________!"
p$(133) = "h333ff222h.5....KO....__________!"
p$(134) = "ffffff000h.6.......aN.______DQK_!"
p$(135) = "hhhhha000h.7..........______ESK_!"
p$(136) = "hh3333000c.8....KG....______CKK_!"
p$(137) = "h33333111h.9..........KK________!"
p$(138) = "h33333222h.A.BG.......__________!"
p$(139) = "ffCCff00ff.B....KN....______KaE_!"
p$(140) = "hfDDff00hh.C.......TH.______JKM_!"
p$(141) = "hhhaac00fh.D.0L.......__________!"
p$(142) = "f3333300ff.E....SI....______COL_!"
p$(143) = "hhheefDDhh.F..........]H________!"

REM ***************** n/9 plansze wiersza roomy=9

p$(144) = "haaa222ffh.0....SD....______COH_!"
p$(145) = "heee000hhh.1.......DK.__________!"
p$(146) = "f222111hhh.2.AH.......KK________!"
p$(147) = "h000aaahhh.3..........______IOJ_!"
p$(148) = "h000ahhhhh.4....KH....__________!"
p$(149) = "h111hhhhhh.5..........___KG_____!"
p$(150) = "hhffaa222h.6.......ZK.______HEM_!"
p$(151) = "hhaaaa000h.7.UL.......__________!"
p$(152) = "ccc333000h.8.AL.......dI________!"
p$(153) = "h33333111h.9....SD....______GOK_!"
p$(154) = "h33333222h.A..........______FGH_!"
p$(155) = "ff223300Dh.B.BL.......__________!"
p$(156) = "hfDDff00hh.C.......SK.__________!"
p$(157) = "hhhaac00fh.D....KK....______DYK_!"
p$(158) = "f3333300hh.E..........KK____ECI_!"
p$(159) = "haa333DDhh.F.WL....DK.__________!"

REM tablica serc
FOR xr = 0 TO 15
FOR yr = 0 TO 9
s = xr + yr * 16
znak$ = MID$(p$(s), 23, 1)
IF znak$ <> "_" THEN serca(xr, yr) = 1
NEXT yr: NEXT xr

REM tablica wind
pozycjewind(1) = 0
pozycjewind(2) = 4
pozycjewind(3) = 7
END SUB

SUB rysowanie

FOR yw = 0 TO 9
el$ = MID$(kod$, yw + 1, 1)
y16 = yw * 18

REM tymczasowe sygnalizacje bledow:

IF el$ = "Q" OR el$ = "L" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "P" OR el$ = "W" OR el$ = "=" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "A" OR el$ = "B" OR el$ = "U" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "@" THEN COLOR 15: LINE (0, y16)-(200, y16)

REM elementy uzupelniajace

IF el$ = "C" THEN
PUT (128, y16), szaretlo4, PSET: PUT (192, y16), szaretlo4, PSET
PUT (256, y16), szaretlo4, PSET
PUT (0, y16), blok4, PSET: PUT (64, y16), blok2, PSET:
PUT (96, y16), bloks, PSET: PUT (112, y16), blokk, PSET
END IF

IF el$ = "D" THEN
PUT (0, y16), szaretlo4, PSET: PUT (64, y16), szaretlo4, PSET
PUT (128, y16), szaretlo4, PSET
PUT (192, y16), blokp, PSET: PUT (208, y16), blok4, PSET
PUT (272, y16), blok2, PSET: PUT (304, y16), bloks, PSET
END IF

REM czesc automatyczna, znaki a-h
ascii = ASC(el$)

IF ascii > 96 THEN
bity = ascii - 97
PUT (0, y16), blok4, PSET:
pop1 = 0
pop2 = 0
pop3 = 0

IF (bity AND 4) = 4 THEN PUT (64, y16), blok4, PSET: pop1 = 1
IF (bity AND 4) = 0 THEN PUT (48, y16), blokk, PSET: PUT (64, y16), szaretlo4, PSET: pop1 = 0
REM
IF (bity AND 2) = 2 THEN pop2 = 1: PUT (128, y16), blok4, PSET: IF pop1 = 0 THEN PUT (128, y16), blokp, PSET
IF (bity AND 2) = 0 THEN pop2 = 0: PUT (128, y16), szaretlo4, PSET: IF pop1 = 1 THEN PUT (112, y16), blokk, PSET
REM
IF (bity AND 1) = 1 THEN pop3 = 1: PUT (192, y16), blok4, PSET: IF pop2 = 0 THEN PUT (192, y16), blokp, PSET
IF (bity AND 1) = 0 THEN pop3 = 0: PUT (192, y16), szaretlo4, PSET: IF pop2 = 1 THEN PUT (176, y16), blokk, PSET
PUT (256, y16), blok4, PSET
IF pop3 = 0 THEN PUT (256, y16), blokp, PSET
END IF

REM znaki 0-3

IF ascii < 58 THEN
bity = ascii - 48
IF (bity AND 2) = 2 THEN PUT (0, y16), blokk, PSET
IF (bity AND 2) = 0 THEN PUT (0, y16), szaretlo, PSET
PUT (16, y16), szaretlo4, PSET
PUT (80, y16), szaretlo4, PSET
PUT (144, y16), szaretlo4, PSET
PUT (208, y16), szaretlo4, PSET
PUT (272, y16), szaretlo2, PSET

IF (bity AND 1) = 1 THEN PUT (304, y16), blokp, PSET
IF (bity AND 1) = 0 THEN PUT (304, y16), szaretlo, PSET
END IF

NEXT yw

REM rysowanie podestow

el$ = MID$(kod$, 14, 1)
IF el$ = "" OR el$ = "." THEN GOTO dodatek

el2$ = MID$(kod$, 15, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "#" THEN FOR xx = 0 TO 4: PUT (xx * 64, yo), ceg4, PSET: NEXT xx
IF el$ = "W" THEN
PUT (16, yo), ceg2, PSET: PUT (80, yo), ceg4, PSET
PUT (144, yo), ceg4, PSET: PUT (208, yo), ceg2, PSET: PUT (272, yo), ceg2, PSET
END IF
IF el$ = "U" THEN
PUT (16, yo), ceg4, PSET: PUT (64, yo), ceg4, PSET
PUT (192, yo), ceg4, PSET: PUT (240, yo), ceg4, PSET
END IF
IF el$ = "0" THEN PUT (16, yo), ceg4, PSET: PUT (240, yo), ceg4, PSET
IF el$ = "A" THEN FOR xx = 0 TO 4: PUT (16 + xx * 64, yo), ceg2, PSET: NEXT xx
IF el$ = "B" THEN FOR xx = 0 TO 5: PUT (64 + xx * 32, yo), ceg2, PSET: NEXT xx

REM dodatkowy element
dodatek:

el$ = MID$(kod$, 29, 1)
IF el$ = "" OR el$ = "_" THEN GOTO okna
el2$ = MID$(kod$, 30, 1)
xo = (ASC(el2$) - 65) * 8
el2$ = MID$(kod$, 31, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "A" THEN
PUT (xo, yo), blokp, PSET: PUT (xo, yo + 18), blokp, PSET
PUT (xo + 16, yo), blok2, PSET: PUT (xo + 16, yo + 18), blok2, PSET
PUT (xo + 48, yo), blokk, PSET: PUT (xo + 48, yo + 18), blokk, PSET
END IF

IF el$ = "B" THEN COLOR 235: LINE (xo + 5, yo)-(xo + 9, yo + 35), , BF
IF el$ = "C" THEN PUT (xo, yo), ceg2, PSET: PUT (xo + 32, yo), ceg2, PSET: PUT (xo + 64, yo), ceg2, PSET
IF el$ = "D" THEN LINE (xo, yo)-(xo + 22, yo + 17), 235, BF: LINE (xo + 42, yo)-(xo + 63, yo + 17), 235, BF
IF el$ = "E" THEN LINE (xo, yo)-(xo + 5, yo + 35), 235, BF: LINE (xo + 26, yo + 36)-(xo + 31, yo + 72), 235, BF
REM niebieskie klocki
IF el$ = "F" THEN PUT (xo, yo), nieb, PSET
IF el$ = "G" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo), nieb, PSET
IF el$ = "H" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo + 36), nieb, PSET
IF el$ = "I" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo - 36), nieb, PSET
REM jednokierunkowe bramki
IF el$ = "J" THEN PSET (xo - 2, yo), 199: DRAW "R18 D35 L18 U35 F18 U1 G18"
IF el$ = "K" THEN PSET (xo - 2, yo), 198: DRAW "R18 D35 L18 U35 R18 G18 U1 F18"
REM zaslonka
IF el$ = "L" THEN LINE (xo, yo)-(xo + 15, yo + 35), 255, BF
REM winda
xwindy = -10: ywindy = -10
IF el$ = "M" THEN
LINE (xo, yo)-(xo + 23, yo + 35), 10, BF
LINE (xo, yo)-(xo, yo + 36), 6
LINE (xo + 3, yo + 7)-(xo + 5, yo + 17), 14, BF
LINE (xo + 1, yo)-(xo + 23, yo), 9
PSET (xo + 4, yo + 8), 12
PSET (xo + 4, yo + 10), 5: DRAW "D7 C14 R1 U2 L2 U2 R2 U2 L2"
xwindy = xo: ywindy = yo
COLOR 8: LOCATE (ywindy / 8) + 2, 34
IF roomy = 0 THEN PRINT "1"
IF roomy = 4 THEN PRINT "2"
IF roomy = 7 THEN PRINT "3"
END IF

okna:

REM rysowanie okien

el$ = MID$(kod$, 17, 1)
IF el$ = "" OR el$ = "." THEN GOTO serce
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 18, 1)
yo = (ASC(el$) - 65) * 9
IF roomy < 2 THEN PUT (xo, yo), window2, PSET
IF roomy > 1 AND roomy < 5 THEN PUT (xo, yo), window1, PSET
IF roomy > 4 THEN PUT (xo, yo), window3, PSET

serce:
REM serce
xserca = -20: yserca = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 23, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xserca = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 24, 1)
yserca = (ASC(el$) - 65) * 9
GET (xserca, yserca)-(xserca + 15, yserca + 7), tlo
PSET (xserca, yserca + 1), 5
DRAW "D2 F1 U4 R1 D5 F1 U5 E1 D5 E1 U4 F1 D2"

donica:
el$ = MID$(kod$, 26, 1)
IF el$ = "" OR el$ = "_" THEN GOTO wentyl
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 27, 1)
yo = (ASC(el$) - 65) * 9 + 2
PUT (xo, yo), palma, PSET

wentyl:
el$ = MID$(kod$, 20, 1)
IF el$ = "" OR el$ = "." THEN GOTO koniecrysowania
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 21, 1)
yo = (ASC(el$) - 65) * 9
PUT (xo, yo), wentylator, PSET

koniecrysowania:

COLOR 15

END SUB

Piotr-246 · Gość

DECLARE SUB dzwiek (ktory!)

REM Gra "Serca", UWAGA wersja gry wymaga
REM emulatora o predkosci 6075 cyklow
REM wymaga pliku bitmap1.scr utworzonego przez modul bsave.bas

DECLARE SUB animacja ()
DECLARE SUB rysowanie ()
DECLARE SUB palety ()
DECLARE SUB plansze ()
DECLARE SUB cegly ()

REM plansza startowa:
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
roomx = 7: roomy = 4

DIM SHARED kolor$(0 TO 255)
DIM pamiec(0 TO 128) AS LONG
DIM poledzialania(0 TO 240) AS LONG
DIM SHARED pozycjewind(1 TO 3) AS INTEGER
DIM SHARED p$(0 TO 159)
DIM SHARED kod$
DIM SHARED serca(0 TO 15, 0 TO 9) AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED xwindy AS INTEGER, ywindy AS INTEGER

REM pamiec tla pod wziatek

DIM SHARED tlo(0 TO 32) AS LONG

REM tlo

DIM SHARED szaretlo(0 TO 74) AS LONG
DIM SHARED szaretlo2(0 TO 148) AS LONG
DIM SHARED szaretlo4(0 TO 300) AS LONG
REM dane elementow planszy

DIM SHARED ceg2(0 TO 75) AS LONG
DIM SHARED ceg4(0 TO 144) AS LONG

DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED nieb(0 TO 145) AS LONG

DIM SHARED blokp(0 TO 74) AS LONG
DIM SHARED bloks(0 TO 74) AS LONG
DIM SHARED blokk(0 TO 74) AS LONG
DIM SHARED blok2(0 TO 158) AS LONG
DIM SHARED blok4(0 TO 296) AS LONG

REM ****************** DANE ANIMACJI

DIM SHARED znakp1(0 TO 128) AS LONG
DIM SHARED znakl1(0 TO 128) AS LONG
DIM SHARED znakp2(0 TO 128) AS LONG
DIM SHARED znakl2(0 TO 128) AS LONG
DIM SHARED znakp3(0 TO 128) AS LONG
DIM SHARED znakl3(0 TO 128) AS LONG
DIM SHARED vertd1(0 TO 128) AS LONG

REM matryce okien

DIM SHARED window1(0 TO 160) AS LONG
DIM SHARED window2(0 TO 160) AS LONG
DIM SHARED window3(0 TO 160) AS LONG

DIM SHARED wentylator(0 TO 64) AS LONG

REM ************************* DANE STARTOWE

SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci

x = 200: y = 35: xs = 200: ys = 35: REM wspol. pocz. gracza na ekr.
licz = -1: REM wartosc start. zegara
kolwent = 30 + 30 * 256 + 30 * 65536: REM kolor lopat wentylatora

REM ***** SUB palety - ustawienie nowych wartosci barw
palety

REM ***** SUB cegly - zapelnienie pozostalych tablic
cegly

REM SUB plansze - wypelnienie tablicy wygladu plansz
plansze

REM ************************* START POMIESZCZENIA

rysuj:

kod$ = p$(roomx + roomy * 16)

REM ******************** rysowanie pomieszczenia
t0 = PEEK(1132): REM pomiar czasu rysowania

REM SUB rysowanie - rysowanie planszy
rysowanie

IF przejechal = 1 THEN y = ywindy + 3: ys = ywindy + 3: przejechal = 0

REM pomiar czasu rysowania
t1 = PEEK(1132):

REM menu na dole
LINE (0, 180)-(319, 182), 234, BF
LOCATE 25, 15: PRINT "L-SHIFT ALT P-SHIFT";
LOCATE 24, 2: COLOR 3: PRINT "T:"; t0; "/"; t1; FRE(-2);
PRINT " ROOM:"; roomx; "/"; roomy; "--";

REM **************** zapamietanie pola pod graczem
GET (x, y)-(x + 15, y + 31), pamiec
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
REM PUT (x, y), vertd1, PSET
liczsercaroom = 0: zrobione = 0
GOTO postaw
REM *************************** PETLA GLOWNA

petla:
dx = 0: dy = 0
IF dzwiekbrania = 1 THEN dzwiekbrania = 0: dzwiek (2)

REM ******************* czas gry w sekundach

se$ = MID$(TIME$, 7, 2)
se = VAL(se$)
IF se <> ses THEN licz = licz + 1
ses = se
LOCATE 25, 2: COLOR 15: PRINT "Czas:"; licz;

REM ************************ petla opozniajaca
FOR delay = 1 TO 700: NEXT delay

REM faza wentylatora

komorka = PEEK(1132) / 1.5
faz = INT(komorka)
IF faz / 3 = INT(faz / 3) THEN faza = 0
IF (faz + 1) / 3 = INT((faz + 1) / 3) THEN faza = 1
IF (faz + 2) / 3 = INT((faz + 2) / 3) THEN faza = 2
FOR i = 0 TO 2: i16 = i * 16
IF faza = 0 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, 0
IF faza = 1 THEN PALETTE 11 + i16, 0: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, kolwent
IF faza = 2 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, 0: PALETTE 13 + i16, kolwent
NEXT i

REM ************************ sprawdzenie klawiszy

alt = 0: lshift = 0: pshift = 0: skos = 0

k$ = INKEY$
IF k$ = "f" THEN roomx = roomx - 1: GOTO rysuj
IF k$ = "h" THEN roomx = roomx + 1: GOTO rysuj
IF k$ = "t" THEN roomy = roomy - 1: GOTO rysuj
IF k$ = "b" THEN roomy = roomy + 1: GOTO rysuj
IF k$ = CHR$(27) THEN END

IF x >= xwindy AND y - ywindy < 10 THEN
IF k$ = "1" OR k$ = "2" THEN GOSUB przejazd: GOTO rysuj
IF k$ = "3" THEN GOSUB przejazd: GOTO rysuj
END IF

REM klawisz alt - wznoszenie sie
IF (PEEK(1047) AND 8) = 8 THEN alt = 1
IF (PEEK(1047) AND 2) = 2 THEN lshift = 1
IF (PEEK(1047) AND 1) = 1 THEN pshift = 1

REM bezruch = grawitacja
IF lshift = 0 AND pshift = 0 AND alt = 0 THEN dy = 2: vert = 1: obrot = 0: przebiervert = 0: GOTO czy

POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury

IF lshift = 1 THEN dx = -4: dy = 2: obrot = -1: vert = 0
IF pshift = 1 THEN dx = 4: dy = 2: obrot = 1: vert = 0
IF alt = 1 THEN dy = -4: vert = 1
IF dx <> 0 AND dy <> 0 THEN skos = 1
czy:

REM ************ sprawdzenie czy jest przejscie do innej planszy

IF x + dx > 300 THEN x = 5: xs = 5: roomx = roomx + 1: GOTO rysuj
IF x + dx < 3 THEN x = 300: xs = 300: roomx = roomx - 1: GOTO rysuj
IF y + dy > 144 THEN y = 5: ys = 5: roomy = roomy + 1: GOTO rysuj
IF y + dy < 4 THEN y = 145: ys = 145: roomy = roomy - 1: GOTO rysuj

REM *********** sprawdzenie czy ruch jest mozliwy
REM sprawdzenie przeszkody. Przeszkoda sa kolory > 200

xmozliwy = 0: xniemozliwy = 0
ymozliwy = 0: yniemozliwy = 0

REM sprawdzenie sasiedztwa obok

IF dx > 0 THEN
FOR i = 0 TO 31: punkt = POINT(x + 19, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 198 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF

IF dx < 0 THEN
FOR i = 0 TO 31: punkt = POINT(x - 3, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 199 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF xniemozliwy = 0 THEN xmozliwy = 1
IF xniemozliwy = 1 THEN xmozliwy = 0

REM sprawdzenie sasiedztwa gora dol

IF dy > 0 THEN
FOR i = 0 TO 15:
IF POINT(x + i, y + 32) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y + 33) > 200 THEN yniemozliwy = 1: EXIT FOR

NEXT i
END IF

IF dy < 0 THEN
FOR i = 0 TO 15
IF POINT(x + i, y - 4) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y - 5) > 200 THEN yniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF yniemozliwy = 0 THEN ymozliwy = 1
IF yniemozliwy = 1 THEN ymozliwy = 0

REM ruch gdy oba mozliwe x oraz y
IF ymozliwy = 1 AND xmozliwy = 1 THEN IF dx <> 0 OR dy <> 0 THEN GOTO ruch

REM szczegolne przypadki gdy tylko x albo y mozliwy
IF ymozliwy = 0 AND xmozliwy = 1 THEN dy = 0: GOTO czy
IF ymozliwy = 1 AND xmozliwy = 0 THEN dx = 0: GOTO czy

REM ruch niemozliwy powrot petli glownej bez zmian pozostaja x y

x = xs: y = ys
GOTO petla

REM ***************** RUCH

ruch:

x = x + dx: y = y + dy
IF dy = 0 AND przebieranie = 0 AND alt = 0 THEN dzwiek (1): REM dzwiek chodzenia

REM ******************** czy jest wziatek
deltawx = ABS(x + 4 - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek

REM ************************************** operacja odswiezania tla
postaw:
REM punkt 1 zapamietanie nowego pola dzialania (brudnego)
REM w oparciu o nowe x,y

GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania

REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo

deltax = x - xs: deltay = y - ys
inversx = -1 * deltax: inversy = -1 * deltay
inver4 = INT(inversx / 4)
FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = (yt + inversy) * 6
FOR xt = 0 TO 3
index1 = 1 + (yt6 + 24) + (xt + inver4) + 1
index2 = 1 + yt4 + xt
poledzialania(index1) = pamiec(index2)
NEXT xt: NEXT yt

REM zmazanie serca z pola dzialania

IF liczsercaroom = 1 AND zrobione = 0 THEN
zrobione = 1
PUT (x - 4, y - 4), poledzialania, PSET
PUT (xserca, yserca), tlo, PSET
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
END IF

REM nowa mala pamiec

FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = yt * 6
FOR xt = 0 TO 3:
index1 = 1 + (yt6 + 24) + (xt + 1):
index2 = 1 + yt4 + xt:
pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt

REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU

REM aby nie rysowac dwoch postaci w przypadku skosu
IF skos = 1 THEN GOTO bezskosu:

REM ************************** ruch w dol lub gore

IF vert = 1 THEN wkleic = 7: GOTO wklej
bezskosu:
REM ************************** ruch w lewo

IF obrot = -1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1
IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 1: GOTO wklej
IF przebieranie = 1 THEN wkleic = 2: GOTO wklej
IF przebieranie = 2 THEN wkleic = 3: GOTO wklej
END IF

REM ****************** ruch w prawo

IF obrot = 1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1

IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 4: GOTO wklej
IF przebieranie = 1 THEN wkleic = 5: GOTO wklej
IF przebieranie = 2 THEN wkleic = 6: GOTO wklej
END IF

xs = x: ys = y

GOTO petla

wklej:

IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt
IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt
IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt
IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt
IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt
IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt
IF wkleic = 7 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)): NEXT xt: NEXT yt

REM wklejenie wyniku operacji na tablicy:
PUT (x - 4, y - 4), poledzialania, PSET

xs = x: ys = y
GOTO petla

REM GOSUB-RETURN****************************** obsluga wziatku

wziatek:
IF serca(roomx, roomy) = 0 THEN GOTO niemawziatku
IF liczsercaroom = 1 THEN GOTO niemawziatku
serca(roomx, roomy) = 0
liczserca = liczserca + 1
PUT (xserca, yserca), tlo, PSET

liczsercaroom = 1
dzwiekbrania = 1

LOCATE 1, 1: COLOR 6: PRINT liczserca;
niemawziatku:
RETURN

REM GOSUB-RETURN przejazd:
przejazd:
pietro = VAL(k$)
roomy = pozycjewind(pietro)

FOR i = 23 TO 0 STEP -1
LINE (xwindy + i, ywindy)-(xwindy + i, ywindy + 35), 255
FOR j = 1 TO 7500: NEXT j
NEXT i
CLS
FOR i = 1 TO 30000: NEXT i
przejechal = 1
RETURN

SUB cegly

BLOAD "bitmap1.scr"

REM INPUT a$
REM pobranie z ekranu tablic elementow
REM uwaga! wysokosc elementu to 9 lub 18 px

GET (0, 0)-(31, 8), ceg2
GET (0, 0)-(63, 8), ceg4

GET (0, 36)-(15, 53), szaretlo
GET (0, 36)-(31, 53), szaretlo2
GET (0, 36)-(63, 53), szaretlo4

GET (16, 64)-(31, 79), palma
GET (32, 64)-(47, 81), blokp
GET (48, 64)-(63, 81), bloks
GET (64, 64)-(79, 81), blokk
GET (0, 156)-(31, 173), blok2
GET (0, 156)-(63, 173), blok4
GET (80, 64)-(111, 81), nieb

GET (0, 88)-(15, 119), znakl1
GET (16, 88)-(31, 119), znakp1
GET (32, 88)-(47, 119), znakl2
GET (48, 88)-(63, 119), znakp2
GET (64, 88)-(79, 119), znakl3
GET (80, 88)-(95, 119), znakp3
GET (96, 88)-(111, 119), vertd1

GET (0, 120)-(31, 139), window1
GET (32, 120)-(63, 139), window2
GET (64, 120)-(95, 139), window3
GET (0, 140)-(15, 155), wentylator
CLS
END SUB

SUB dzwiek (ktory)

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

REM DREPTANIE
IF ktory = 1 THEN

REM ewentualnie:
REM OUT 66, 30: OUT 66, 0
REM OUT 66, 164: OUT 66, 2
REM OUT 66, 130: OUT 66, 1
REM OUT 66, 74: OUT 66, 0
REM OUT 66, 220: OUT 66, 1

FOR i = 1 TO 10
OUT 66, 30: OUT 66, 0
OUT 66, 84: OUT 66, 2
OUT 66, 30: OUT 66, 0
OUT 66, 94: OUT 66, 2
OUT 66, 10: OUT 66, 0
OUT 66, 40: OUT 66, 2
OUT 66, 84: OUT 66, 0
OUT 66, 10: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
END IF

REM zabranie serca

IF ktory = 2 THEN
OUT 66, 32: OUT 66, 3
FOR i = 1 TO 6000: NEXT i
OUT 66, 204: OUT 66, 4
FOR i = 1 TO 6000: NEXT i
END IF

REM wylaczenie glosnika
OUT 97, stary.port

END SUB

SUB palety

REM palety kolorow *********************************
REM max koloru=3F

FOR i = 0 TO 255: kolor$(i) = "00 00 00 00"
PALETTE i, 31 + 31 * 256 + 31 * 65536: NEXT i

REM kolory za ludzikiem

kolor$(0) = "00 00 00 00": REM rejestr zero- wolny
kolor$(1) = "01 05 05 06": REM tlo plyta
kolor$(2) = "02 02 03 02": REM tlo fuga
kolor$(3) = "03 07 06 06": REM tlo krawedz
kolor$(4) = "04 00 22 00": REM liscie
kolor$(5) = "05 3F 08 00": REM serce
kolor$(6) = "06 30 30 30": REM framuga okna
kolor$(7) = "07 28 0A 00": REM doniczka drzewa
kolor$(8) = "08 00 21 39": REM niebo
kolor$(9) = "09 3F 3F 00": REM slonce
kolor$(10) = "0A 14 14 14": REM framuga zewnetrzna
kolor$(11) = "0B 00 00 00": REM wentylator faza 1
kolor$(12) = "0C 00 00 00": REM wentylator faza 2
kolor$(13) = "0D 00 00 00": REM wentylator faza 3
kolor$(14) = "0E 20 20 20": REM srednia szarosc
kolor$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza

REM rejestry przezroczyste gracza
kolor$(16) = "10 18 02 02": REM sweter + zero
kolor$(17) = "11 18 02 02": REM
kolor$(18) = "12 18 02 02": REM
kolor$(19) = "13 18 02 02": REM
kolor$(20) = "14 22 12 00": REM sweter + liscie
kolor$(21) = "15 3F 00 00": REM
kolor$(22) = "16 2F 09 09": REM sweter + framuga okna
kolor$(23) = "17 2B 08 00": REM sweter + doniczka drzewa
kolor$(24) = "18 25 16 24": REM sweter + niebo
kolor$(25) = "19 3F 3F 3F": REM sweter + slonce
kolor$(26) = "1A 16 0F 0F": REM sweter + framuga zew
kolor$(27) = "1B 3F 3F 3F": REM
kolor$(28) = "1C 3F 3F 3F": REM
kolor$(29) = "1D 3F 3F 3F": REM
kolor$(30) = "1E 20 10 10": REM sweter + przyciski
REM kolor 31 (1F) zastrzezony dla gracza
kolor$(32) = "20 0A 13 29": REM spodnie + zero
kolor$(33) = "21 0A 13 29": REM
kolor$(34) = "22 0A 13 29": REM
kolor$(35) = "23 0A 13 29": REM
kolor$(36) = "24 05 1D 24": REM spodnie+ liscie
kolor$(37) = "25 3F 3F 3F": REM
kolor$(38) = "26 1B 1B 32": REM spodnie + framuga okna
kolor$(39) = "27 1A 10 3F": REM spodnie + doniczka
kolor$(40) = "28 00 1A 3F": REM spodnie + niebo
kolor$(41) = "29 3F 3F 3F": REM spodnie +slonce
kolor$(42) = "2A 10 14 20": REM spodnie + framuga zew
kolor$(43) = "2B 3F 3F 3F": REM
kolor$(44) = "2C 3F 3F 3F": REM
kolor$(45) = "2D 3F 3F 3F": REM
kolor$(46) = "2E 3F 3F 3F": REM
REM rejestr 47 (2F) zastrzezony dla gracza

REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF)
REM rejestry nieprzezroczyste

kolor$(31) = "1F 2F 09 09": REM sweter
kolor$(47) = "2F 0D 1A 37": REM spodnie
kolor$(63) = "3F 1A 1A 1A": REM wlosy i buty
kolor$(79) = "4F 10 10 10": REM pasek2
kolor$(95) = "5F 3F 2F 0F":
kolor$(111) = "6F 3F 30 20": REM skora1
REM kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych
kolor$(143) = "8F 32 22 02": REM nos
REM kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych
REM kolor$(175) = "AF 22 02 02": REM sweter3
kolor$(191) = "BF 20 20 20": REM pasek
kolor$(207) = "CF 37 27 06": REM usta
REM FF- zarezerwowany dla przeslony

REM rejestry jednokierunkowe
kolor$(198) = "C6 20 20 20"
kolor$(199) = "C7 20 20 20"

REM bloczek

kolor$(224) = "E0 00 00 00": REM
kolor$(225) = "E1 04 04 04": REM
kolor$(226) = "E2 08 08 08": REM
kolor$(227) = "E3 0B 0B 0B": REM
kolor$(228) = "E4 10 10 10": REM
kolor$(229) = "E5 14 14 14": REM
kolor$(230) = "E6 18 18 18": REM
kolor$(231) = "E7 1B 1B 1B": REM
kolor$(232) = "E8 20 20 20": REM
kolor$(233) = "E9 24 24 24": REM
kolor$(234) = "EA 28 28 28": REM
kolor$(235) = "EB 2B 2B 2B": REM
kolor$(236) = "EC 30 30 30": REM
kolor$(237) = "ED 34 34 34": REM
kolor$(238) = "EE 38 38 38": REM
kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika

REM kolor 240 - przeslona
kolor$(240) = "F0 38 38 38"

REM cegly male niebieskie

kolor$(249) = "F9 22 27 30": REM krawedz
kolor$(250) = "FA 09 0E 14": REM fuga
kolor$(251) = "FB 11 17 1F": REM cegla

REM cegly male czerwone

kolor$(252) = "FC 30 27 27": REM krawedz
kolor$(253) = "FD 14 0E 0E": REM fuga
kolor$(254) = "FE 1F 17 17": REM cegla
kolor$(255) = "FF 28 28 28": REM przeslona

FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2)
red$ = "&H" + MID$(kolor$(i), 4, 2)
gre$ = "&H" + MID$(kolor$(i), 7, 2)
blu$ = "&H" + MID$(kolor$(i), 10, 2)
REM PRINT rej$; " "; red$; " "; gre$; " "; blu$
rej = VAL(rej$)
red = VAL(red$)
gre = VAL(gre$)
blu = VAL(blu$)
REM PRINT rej; " "; red; " "; gre; " "; blu

PALETTE rej, red + gre * 256 + blu * 65536
NEXT i

END SUB

SUB plansze

REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** roomy*16+roomx

REM kody plansz +++nr.po.ok.we.se_kw_dod
REM ************ plansze wiersza roomy=0

p$(0) = "h22233322d.0.UI.YO....GN________!"
p$(1) = "h000fff11h.1....MD....__________!"
p$(2) = "h11133333f.2.UI.HE....___EQ_____!"
p$(3) = "hh2223cchh.3..........SJ________!"
p$(4) = "h300033fff.4....ZK....__________!"
p$(5) = "h2001c333f.5....LG....______AQG_!"
p$(6) = "h111g3322f.6....LD....___EQ_F[Q_!"
p$(7) = "hh222ff11d.7.BE.......aH_ZI_MdO_!"
p$(8) = "hhDDDfCCCg.8..........______DQK_!"
p$(9) = "hhhhhf111c.9..........__________!"
p$(10) = "hhhhhf222g.A..........MO_EQ_____!"
p$(11) = "hh333f111d.B....HG....__________!"
p$(12) = "hhffff333g.C..........__________!"
p$(13) = "h22233333c.D.UN.aK.DF.MK____AYC_!"
p$(14) = "h111ff22hh.E..........___aG_BLM_!"
p$(15) = "h3333311cc.F....ZK....aH____AIG_!"

REM ************ plansze wiersza roomy=1

p$(16) = "d333c2223h.0.......FN.__________!"
p$(17) = "h33330003h.1.WH.SO....dE____COM_!"
p$(18) = "ff333111ff.2.WJ.ML....__________!"
p$(19) = "hc222c333c.3..........___QQ_____!"
p$(20) = "f31113333h.4.UM.aI.aO.__________!"
p$(21) = "f333aa333h.5..........RN_GQ_____!"
p$(22) = "ffff333fff.6....DJ....aM____G[M_!"
p$(23) = "dd333a33hh.7..........__________!"
p$(24) = "gg333333ff.8.AK....IF.__________!"
p$(25) = "cc3322333c.9.WM.......eF________!"
p$(26) = "gg331133hh.A....LF....aO________!"
p$(27) = "ddaa22cccc.B..........__________!"
p$(28) = "g33300333h.C.AM....aO.__________!"
p$(29) = "c33311333c.D.0M.......ZK____AQO_!"
p$(30) = "h3322233dd.E.BG....cE.__________!"
p$(31) = "c33111333h.F.AM.bD....___QQ_COH_!"

REM ************* plansze wiersza roomy=2

p$(32) = "h333ff333c.0..........KE_WQ_____!"
p$(33) = "h33332222c.1....KD....UP____CGI_!"
p$(34) = "faaaa0000h.2....WO.VI.__________!"
p$(35) = "ccccc1111f.3....MM....___EQ_____!"
p$(36) = "h33333223h.4.WI.FP....SM________!"
p$(37) = "haa33200af.5.UJ....GL.______HIE_!"
p$(38) = "f333c111ah.6....aM....UP________!"
p$(39) = "hh333d333g.7....YP....___KQ_____!"
p$(40) = "ff3333333g.8.#I.......KK____CGN_!"
p$(41) = "c33g33d33c.9..........__________!"
p$(42) = "hh3333333g.A.WM.LI....__________!"
p$(43) = "cc333322cc.B.UJ.......__________!"
p$(44) = "hhaacc00hh.C.BD....JG.ZM____AQM_!"
p$(45) = "c333cc11gg.D....aN....______AQM_!"
p$(46) = "dd33cc22hh.E..........___aG_AQE_!"
p$(47) = "hh3333113c.F.UJ....VI.___EQ_____!"

REM ************ plansze wiersza roomy=3

p$(48) = "c33332222f.0....ZM.ZD.SF____COI_!"
p$(49) = "ccccc1111h.1..........__________!"
p$(50) = "ha3222333c.2.#F.LO....UO_SQ_____!"
p$(51) = "ff3111333f.3.WM.YI.VI.SJ_GQ_____!"
p$(52) = "h3333c333f.4..........NG____CKK_!"
p$(53) = "ff333c222f.5....ZO....SG________!"
p$(54) = "hhaaff000f.6.BE.......___KQ_____!"
p$(55) = "gggg33111f.7....LO.VJ.______IYM_!"
p$(56) = "gg3322ffff.8..........GG________!"
p$(57) = "cccc00hfff.9..........__________!"
p$(58) = "gg33DDffff.A..........___KK_CCH_!"
p$(59) = "cccccfffff.B.......TL.__________!"
p$(60) = "hh3333333f.C....KK....DP________!"
p$(61) = "g333333hhh.D.UJ....TF.______CKK_!"
p$(62) = "hh3222333f.E..........___GQ_____!"
p$(63) = "c331113hhh.F....ZK....__________!"

REM ****************** plansze wiersza roomy=4

p$(64) = "f22322322h.0....DD....SP_YQ_CKK_!"
p$(65) = "h00f00f00h.1..........__________!"
p$(66) = "c11311311f.2....aP.KP.__________!"
p$(67) = "ff3332223h.3.UJ.ML....___YQ_____!"
p$(68) = "f3333111hh.4.WJ.YL....__________!"
p$(69) = "ffaafaaaff.5.......VI.__________!"
p$(70) = "ffa333c33h.6....OG....SQ_YQ_____!"
p$(71) = "ff223c33cd.7.0C.SN....GN_TI_MdM_!": REM startowa
p$(72) = "ff113cc33d.8..........MO____JVO_!"
p$(73) = "ff33cc33ff.9..........______COI_!"
p$(74) = "ff3333333d.A.WM.LI.ZP.PP________!"
p$(75) = "ff2233333f.B.UM.......___EQ_____!"
p$(76) = "ff11333hhh.C.......KH.__________!"
p$(77) = "h333333333.D.BE.SK....bF____CKK_!"
p$(78) = "ff222333hh.E.UK.......______FEE_!"
p$(79) = "h3111333ff.F.WK.......MM________!"

REM ******************* plansze wiersza roomy=5

p$(80) = "haf222faff.0.......VI.___KK_____!"
p$(81) = "hhf111222h.1..........SP____CKK_!"
p$(82) = "fa333c000h.2....GO....__________!"
p$(83) = "h222fa111f.3..........___YQ_____!"
p$(84) = "h111c2223h.4.0Q....EE.MM________!"
p$(85) = "ffffa111ff.5..........______GOE_!"
p$(86) = "h333c333af.6....DD....ZF_MQ_____!"
p$(87) = "dd333f333g.7.......VI.___aI_____!"
p$(88) = "dd3333333g.8.UN.KP....______COI_!"
p$(89) = "f32233f33f.9.......ED.KK________!"
p$(90) = "ddDDCC333h.A....ZK....KO________!"
p$(91) = "f33300f33f.B..........______COH_!"
p$(92) = "h33300333c.C....NN....__________!"
p$(93) = "333311333h.D.0M....TG.GG________!"
p$(94) = "h33222333c.E.AM.......__________!"
p$(95) = "ff3111333h.F.WM.FF....___YQ_____!"

REM ******************* plansze wiersza roomy=6

p$(96) = "fffa222hhh.0....EJ....___YM_____!"
p$(97) = "hhhf000bbb.1....SJ....ML____CMO_!"
p$(98) = "h333111hhh.2..........___KM_____!"
p$(99) = "f333aaafff.3....PH....ZJ________!"
p$(100) = "h222ahhhhh.4..........EE________!"
p$(101) = "f11133222h.5.0I.......___GQ_____!"
p$(102) = "ffffff000h.6....LO....__________!"
p$(103) = "gg333d111f.7....MO....aP________!"
p$(104) = "gg333hCCCh.8.......ZN.EG____HIE_!"
p$(105) = "ffffffDDDh.9..........______DQK_!"
p$(106) = "hh333fCCCh.A.BE.......___KI_____!"
p$(107) = "ff3333111h.B.0I....LK.aP____CON_!"
p$(108) = "cc22dd22ff.C..........__________!"
p$(109) = "hhDDffDDhh.D.......TJ.LN________!"
p$(110) = "ccc2222hhh.E..........__________!"
p$(111) = "hhhDDDDhhh.F..........TK_KM_____!"

REM ******************* plansze wiersza roomy=7

p$(112) = "hfaa222fff.0..........______COJ_!"
p$(113) = "bbbb000hhh.1....KK....__________!"
p$(114) = "h222111fff.2.BJ.......ZE____AIK_!"
p$(115) = "f000aaahhh.3..........___KM_____!"
p$(116) = "h000ahhhhh.4.......KF.__________!"
p$(117) = "h111hh222h.5..........KQ________!"
p$(118) = "hffaaa001f.6....KO....__________!"
p$(119) = "ff33ee00hh.7..........___KO_MdE_!"
p$(120) = "hh3333002h.8.BL.......______CCQ_!"
p$(121) = "hCCCffDDDh.9..........KO________!"
p$(122) = "hDDDccCCCh.A..........___MK_____!"
p$(123) = "hf333300Df.B.AL.......__________!"
p$(124) = "ffffff11hh.C....KN....______IOI_!"
p$(125) = "hhhhhf22fh.D.......TK.__________!"
p$(126) = "h33c3300ff.E..........KK____COG_!"
p$(127) = "hhheefDDhh.F....KN....__________!"

REM ***************** n/8 plansze wiersza roomy=8

p$(128) = "fffa222hhh.0..........KK________!"
p$(129) = "hbbb000hhh.1.UH.ZK....__________!"
p$(130) = "f222111fff.2.......KK.__________!"
p$(131) = "h000ccchhh.3..........______COI_!"
p$(132) = "h111afffhh.4.UK.......RN________!"
p$(133) = "h333ff222h.5....KO....__________!"
p$(134) = "ffffff000h.6.......aN.______DQK_!"
p$(135) = "hhhhha000h.7..........______ESK_!"
p$(136) = "hh3333000c.8....KG....______CKK_!"
p$(137) = "h33333111h.9..........KK________!"
p$(138) = "h33333222h.A.BG.......__________!"
p$(139) = "ffCCff00ff.B....KN....______KaE_!"
p$(140) = "hfDDff00hh.C.......TH.______JKM_!"
p$(141) = "hhhaac00fh.D.0L.......__________!"
p$(142) = "f3333300ff.E....SI....______COL_!"
p$(143) = "hhheefDDhh.F..........]H________!"

REM ***************** n/9 plansze wiersza roomy=9

p$(144) = "haaa222ffh.0....SD....______COH_!"
p$(145) = "heee000hhh.1.......DK.__________!"
p$(146) = "f222311hhh.2.AI.......KK________!"
p$(147) = "h000aaahhh.3..........______IOJ_!"
p$(148) = "h000ahhhhh.4....KH....__________!"
p$(149) = "h111hhhhhh.5..........___KG_____!"
p$(150) = "hhffaa222h.6.......ZK.______HEM_!"
p$(151) = "hhaaaa000h.7.UL.......__________!"
p$(152) = "ccc333000h.8.AL.......dI________!"
p$(153) = "h33333111h.9....SD....______GOK_!"
p$(154) = "h33333222h.A..........______FGH_!"
p$(155) = "ff223300Dh.B.BL.......__________!"
p$(156) = "hfDDff00hh.C.......SK.__________!"
p$(157) = "hhhaac00fh.D....KK....______DYK_!"
p$(158) = "f3333300hh.E..........KK____ECI_!"
p$(159) = "haa333DDhh.F.WL....DK.__________!"

REM tablica serc
FOR xr = 0 TO 15
FOR yr = 0 TO 9
s = xr + yr * 16
znak$ = MID$(p$(s), 23, 1)
IF znak$ <> "_" THEN serca(xr, yr) = 1
NEXT yr: NEXT xr

REM tablica wind
pozycjewind(1) = 0
pozycjewind(2) = 4
pozycjewind(3) = 7
END SUB

SUB rysowanie

FOR yw = 0 TO 9
el$ = MID$(kod$, yw + 1, 1)
y16 = yw * 18

REM tymczasowe sygnalizacje bledow:

IF el$ = "Q" OR el$ = "L" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "P" OR el$ = "W" OR el$ = "=" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "A" OR el$ = "B" OR el$ = "U" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "@" THEN COLOR 15: LINE (0, y16)-(200, y16)

REM elementy uzupelniajace

IF el$ = "C" THEN
PUT (128, y16), szaretlo4, PSET: PUT (192, y16), szaretlo4, PSET
PUT (256, y16), szaretlo4, PSET
PUT (0, y16), blok4, PSET: PUT (64, y16), blok2, PSET:
PUT (96, y16), bloks, PSET: PUT (112, y16), blokk, PSET
END IF

IF el$ = "D" THEN
PUT (0, y16), szaretlo4, PSET: PUT (64, y16), szaretlo4, PSET
PUT (128, y16), szaretlo4, PSET
PUT (192, y16), blokp, PSET: PUT (208, y16), blok4, PSET
PUT (272, y16), blok2, PSET: PUT (304, y16), bloks, PSET
END IF

REM czesc automatyczna, znaki a-h
ascii = ASC(el$)

IF ascii > 96 THEN
bity = ascii - 97
PUT (0, y16), blok4, PSET:
pop1 = 0
pop2 = 0
pop3 = 0

IF (bity AND 4) = 4 THEN PUT (64, y16), blok4, PSET: pop1 = 1
IF (bity AND 4) = 0 THEN PUT (48, y16), blokk, PSET: PUT (64, y16), szaretlo4, PSET: pop1 = 0
REM
IF (bity AND 2) = 2 THEN pop2 = 1: PUT (128, y16), blok4, PSET: IF pop1 = 0 THEN PUT (128, y16), blokp, PSET
IF (bity AND 2) = 0 THEN pop2 = 0: PUT (128, y16), szaretlo4, PSET: IF pop1 = 1 THEN PUT (112, y16), blokk, PSET
REM
IF (bity AND 1) = 1 THEN pop3 = 1: PUT (192, y16), blok4, PSET: IF pop2 = 0 THEN PUT (192, y16), blokp, PSET
IF (bity AND 1) = 0 THEN pop3 = 0: PUT (192, y16), szaretlo4, PSET: IF pop2 = 1 THEN PUT (176, y16), blokk, PSET
PUT (256, y16), blok4, PSET
IF pop3 = 0 THEN PUT (256, y16), blokp, PSET
END IF

REM znaki 0-3

IF ascii < 58 THEN
bity = ascii - 48
IF (bity AND 2) = 2 THEN PUT (0, y16), blokk, PSET
IF (bity AND 2) = 0 THEN PUT (0, y16), szaretlo, PSET
PUT (16, y16), szaretlo4, PSET
PUT (80, y16), szaretlo4, PSET
PUT (144, y16), szaretlo4, PSET
PUT (208, y16), szaretlo4, PSET
PUT (272, y16), szaretlo2, PSET

IF (bity AND 1) = 1 THEN PUT (304, y16), blokp, PSET
IF (bity AND 1) = 0 THEN PUT (304, y16), szaretlo, PSET
END IF

NEXT yw

REM rysowanie podestow

el$ = MID$(kod$, 14, 1)
IF el$ = "" OR el$ = "." THEN GOTO dodatek

el2$ = MID$(kod$, 15, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "#" THEN FOR xx = 0 TO 4: PUT (xx * 64, yo), ceg4, PSET: NEXT xx
IF el$ = "W" THEN
PUT (16, yo), ceg2, PSET: PUT (80, yo), ceg4, PSET
PUT (144, yo), ceg4, PSET: PUT (208, yo), ceg2, PSET: PUT (272, yo), ceg2, PSET
END IF
IF el$ = "U" THEN
PUT (16, yo), ceg4, PSET: PUT (64, yo), ceg4, PSET
PUT (192, yo), ceg4, PSET: PUT (240, yo), ceg4, PSET
END IF
IF el$ = "0" THEN PUT (16, yo), ceg4, PSET: PUT (240, yo), ceg4, PSET
IF el$ = "A" THEN FOR xx = 0 TO 4: PUT (16 + xx * 64, yo), ceg2, PSET: NEXT xx
IF el$ = "B" THEN FOR xx = 0 TO 5: PUT (64 + xx * 32, yo), ceg2, PSET: NEXT xx

REM dodatkowy element
dodatek:

el$ = MID$(kod$, 29, 1)
IF el$ = "" OR el$ = "_" THEN GOTO okna
el2$ = MID$(kod$, 30, 1)
xo = (ASC(el2$) - 65) * 8
el2$ = MID$(kod$, 31, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "A" THEN
PUT (xo, yo), blokp, PSET: PUT (xo, yo + 18), blokp, PSET
PUT (xo + 16, yo), blok2, PSET: PUT (xo + 16, yo + 18), blok2, PSET
PUT (xo + 48, yo), blokk, PSET: PUT (xo + 48, yo + 18), blokk, PSET
END IF

IF el$ = "B" THEN COLOR 235: LINE (xo + 5, yo)-(xo + 9, yo + 35), , BF
IF el$ = "C" THEN PUT (xo, yo), ceg2, PSET: PUT (xo + 32, yo), ceg2, PSET: PUT (xo + 64, yo), ceg2, PSET
IF el$ = "D" THEN LINE (xo, yo)-(xo + 22, yo + 17), 235, BF: LINE (xo + 42, yo)-(xo + 63, yo + 17), 235, BF
IF el$ = "E" THEN LINE (xo, yo)-(xo + 5, yo + 35), 235, BF: LINE (xo + 26, yo + 36)-(xo + 31, yo + 72), 235, BF
REM niebieskie klocki
IF el$ = "F" THEN PUT (xo, yo), nieb, PSET
IF el$ = "G" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo), nieb, PSET
IF el$ = "H" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo + 36), nieb, PSET
IF el$ = "I" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo - 36), nieb, PSET
REM jednokierunkowe bramki
IF el$ = "J" THEN PSET (xo - 2, yo), 199: DRAW "R18 D35 L18 U35 F18 U1 G18"
IF el$ = "K" THEN PSET (xo - 2, yo), 198: DRAW "R18 D35 L18 U35 R18 G18 U1 F18"
REM zaslonka
IF el$ = "L" THEN LINE (xo, yo)-(xo + 15, yo + 35), 255, BF
REM winda
xwindy = -10: ywindy = -10
IF el$ = "M" THEN
LINE (xo, yo)-(xo + 23, yo + 35), 10, BF
LINE (xo, yo)-(xo, yo + 36), 6
LINE (xo + 3, yo + 7)-(xo + 5, yo + 17), 14, BF
LINE (xo + 1, yo)-(xo + 23, yo), 9
PSET (xo + 4, yo + 8), 12
PSET (xo + 4, yo + 10), 5: DRAW "D7 C14 R1 U2 L2 U2 R2 U2 L2"
xwindy = xo: ywindy = yo
COLOR 8: LOCATE (ywindy / 8) + 2, 34
IF roomy = 0 THEN PRINT "1"
IF roomy = 4 THEN PRINT "2"
IF roomy = 7 THEN PRINT "3"
END IF

okna:

REM rysowanie okien

el$ = MID$(kod$, 17, 1)
IF el$ = "" OR el$ = "." THEN GOTO serce
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 18, 1)
yo = (ASC(el$) - 65) * 9
IF roomy < 2 THEN PUT (xo, yo), window2, PSET
IF roomy > 1 AND roomy < 5 THEN PUT (xo, yo), window1, PSET
IF roomy > 4 THEN PUT (xo, yo), window3, PSET

serce:
REM serce
xserca = -20: yserca = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 23, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xserca = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 24, 1)
yserca = (ASC(el$) - 65) * 9
GET (xserca, yserca)-(xserca + 15, yserca + 7), tlo
PSET (xserca, yserca + 1), 5
DRAW "D2 F1 U4 R1 D5 F1 U5 E1 D5 E1 U4 F1 D2"

donica:
el$ = MID$(kod$, 26, 1)
IF el$ = "" OR el$ = "_" THEN GOTO wentyl
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 27, 1)
yo = (ASC(el$) - 65) * 9 + 2
PUT (xo, yo), palma, PSET

wentyl:
el$ = MID$(kod$, 20, 1)
IF el$ = "" OR el$ = "." THEN GOTO koniecrysowania
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 21, 1)
yo = (ASC(el$) - 65) * 9
PUT (xo, yo), wentylator, PSET

koniecrysowania:

COLOR 15

END SUB

Piotr-246 · Gość

REM modul BSAVE do gry "Serca"

SCREEN 13

DIM k$(0 TO 255)
DIM cegla(0 TO 42) AS LONG
DIM ceglaziel(0 TO 42) AS LONG

DIM tlo(0 TO 40) AS LONG
DIM poltlo(0 TO 16) AS LONG
DIM bitmap$(0 TO 31)
DIM b$(0 TO 31)
DIM blok(0 TO 74) AS LONG

REM palety kolorow *********************************
REM max koloru=3F

FOR i = 0 TO 255: k$(i) = "00 00 00 00": NEXT i

REM kolory za ludzikiem

k$(0) = "00 00 00 00": REM rejestr zero- wolny
k$(1) = "01 0A 0A 0A": REM tlo plyta
k$(2) = "02 06 06 06": REM tlo fuga
k$(3) = "03 10 10 10": REM tlo krawedz
k$(4) = "04 00 2F 00": REM liscie
k$(5) = "05 3F 3F 3F"
k$(6) = "06 3F 3F 3F"
k$(7) = "07 28 0A 00": REM doniczka
k$(8) = "08 00 00 3F": REM niebo
k$(9) = "09 3F 3F 00": REM slonce
k$(10) = "0A 20 20 20": REM framuga zewnetrzna
k$(11) = "0B 18 18 18": REM wentylator obudowa
k$(12) = "0C 3F 3F 3F": REM wentylator faza 1
k$(13) = "0D 2F 2F 2F": REM wentylator faza 2
k$(14) = "0E 1F 1F 1F": REM wentylator faza 3
k$(15) = "0F 3F 3F 3F": REM napis startowy

REM bloki przezroczystosci
k$(16) = "10 3F 3F 3F"
k$(32) = "20 3F 3F 3F"

REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF)

k$(31) = "1F 28 00 00": REM sweter
k$(47) = "2F 05 12 2F": REM spodnie
k$(63) = "3F 17 17 17": REM wlosy i buty
k$(79) = "4F 10 10 10": REM pasek2
k$(95) = "5F 3F 2F 0F":
k$(111) = "6F 3F 2C 17": REM skora1
k$(127) = "7F 18 00 00": REM sweter 2 przeniesiony do przezroczystych
k$(143) = "8F 30 20 00": REM nos
k$(159) = "9F 04 0D 23": REM spodnie2 przeniesiony do przezroczystych
k$(175) = "AF 20 00 00": REM sweter3
k$(191) = "BF 20 20 20": REM pasek
k$(207) = "CF 37 27 06": REM usta

REM bloczek

k$(224) = "E0 00 00 00": REM
k$(225) = "E1 04 04 04": REM
k$(226) = "E2 08 08 08": REM
k$(227) = "E3 0B 0B 0B": REM
k$(228) = "E4 10 10 10": REM
k$(229) = "E5 14 14 14": REM
k$(230) = "E6 18 18 18": REM
k$(231) = "E7 1B 1B 1B": REM
k$(232) = "E8 20 20 20": REM
k$(233) = "E9 24 2B 2B": REM
k$(234) = "EA 28 28 28": REM
k$(235) = "EB 2B 2B 2B": REM
k$(236) = "EC 30 30 30": REM
k$(237) = "ED 34 34 34": REM
k$(238) = "EE 38 38 38": REM
k$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika

REM cegly male ZIELONE

k$(246) = "F6 22 30 27": REM krawedz
k$(247) = "F7 09 14 0E": REM fuga
k$(248) = "F8 11 1f 17": REM cegla

REM cegly male niebieskie

k$(249) = "F9 22 27 30": REM krawedz
k$(250) = "FA 09 0E 14": REM fuga
k$(251) = "FB 11 17 1F": REM cegla

REM cegly male czerwone

k$(252) = "FC 30 27 27": REM krawedz
k$(253) = "FD 14 0E 0E": REM fuga
k$(254) = "FE 1F 17 17": REM cegla
k$(255) = "FF 3F 3F 3F": REM zarezerwowany dla ludzika

FOR i = 0 TO 255: rej$ = "&H" + MID$(k$(i), 1, 2)
red$ = "&H" + MID$(k$(i), 4, 2)
gre$ = "&H" + MID$(k$(i), 7, 2)
blu$ = "&H" + MID$(k$(i), 10, 2)
REM PRINT rej$; " "; red$; " "; gre$; " "; blu$
rej = VAL(rej$)
red = VAL(red$)
gre = VAL(gre$)
blu = VAL(blu$)
REM PRINT rej; " "; red; " "; gre; " "; blu

PALETTE rej, red + gre * 256 + blu * 65536
NEXT i

REM rysunki ****************************************

REM rysunek cegly

b$(0) = "DDDDDDDDDDDDDDDE" + "DDDDDDDE"
b$(1) = "DFFFFFFFFFFFFFFE" + "DFFFFFFE"
b$(2) = "DFFFFFFFFFFFFFFE" + "DFFFFFFE"
b$(3) = "DFFFFFFFFFFFFFFE" + "DFFFFFFE"
b$(4) = "DFFFFFFFFFFFFFFE" + "DFFFFFFE"
b$(5) = "DFFFFFFFFFFFFFFE" + "DFFFFFFE"
b$(6) = "DFFFFFFFFFFFFFFE" + "DFFFFFFE"
b$(7) = "DFFFFFFFFFFFFFFE" + "DFFFFFFE"
b$(8) = "EEEEEEEEEEEEEEEE" + "EEEEEEEE"

REM 250-A 251-B 252-C 253-D 254-E 255-F

FOR yd = 0 TO 8
FOR xd = 0 TO 15
COLOR ASC(MID$(b$(yd), xd + 1, 1)) - 65 - 1 + &HF0 + 10
PSET (xd, yd)
NEXT xd:
FOR xd = 0 TO 7
COLOR ASC(MID$(b$(yd), xd + 1 + 16, 1)) - 65 - 1 + &HF0 + 4
PSET (xd + 64, yd): PSET (xd + 64 + 8, yd)
NEXT xd:

NEXT yd
GET (0, 0)-(15, 8), cegla
GET (64, 0)-(79, 8), ceglaziel

REM komorka tla

REM tlo(0) = &H80040

bitmap$(0) = "0001200000012000"
bitmap$(1) = "1111200000011111"
bitmap$(2) = "2221200000012222"
bitmap$(3) = "0001200000012000"
bitmap$(4) = "0001200000012000"
bitmap$(5) = "0001111111112000"
bitmap$(6) = "0001222222212000"
bitmap$(7) = "0001200000012000"
bitmap$(8) = "0001200000012000"

FOR yd = 0 TO 8
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 48 + 1
PSET (xd, yd)
NEXT xd: NEXT yd

GET (0, 0)-(15, 8), tlo

REM przygotowanie tablic elementow wierszowych
CLS

FOR x = 0 TO 19
FOR y = 0 TO 8
PUT (x * 16, y * 9), tlo, PSET
NEXT y
NEXT x

REM cegly

FOR i = 0 TO 3
PUT (i * 16, 0), cegla, PSET
PUT (i * 16 + 64, 0), ceglaziel, PSET
NEXT i

REM RYSUNEK DONICZKI

bitmap$(0) = "DDDCBEEBBEECDDDD"
bitmap$(1) = "BBBCEEEEEEEEDBBB"
bitmap$(2) = "BBBEEEEEEEEEEBBB"
bitmap$(3) = "BBBEEEEEEEECEEBB"
bitmap$(4) = "BBEEDEDEEDECEEBB"
bitmap$(5) = "BBECBEBEEBECDEBB"
bitmap$(6) = "BBECEBBEEBBEDEBB"
bitmap$(7) = "BBECEBBEEBBEDEBB"
bitmap$(8) = "CCCCDBBEEBBCDCCC"
bitmap$(9) = "DDDCDBBEEBBCDDDD"
bitmap$(10) = "BBBCDBBEEBBCDBBB"
bitmap$(11) = "BBBCDHHHHHHCDBBB"
bitmap$(12) = "BBBCCHHHHHHCDBBB"
bitmap$(13) = "BBBCDDHHHHDCDBBB"
bitmap$(14) = "BBBCDBHHHHBCDBBB"
bitmap$(15) = "BBBCDBHHHHBCDBBB"

FOR yd = 0 TO 15
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65
: PSET (xd + 16, yd + 64)
NEXT xd: NEXT yd

REM rysunek bloku

bitmap$(0) = "KLKLKLKLKLKLKLKF" + "JJJJJJJJJJJJJJJF" + "KLKLKLKLKLKLKLKF"
bitmap$(1) = "LJJJJJJJJJJJJJJF" + "KHHHHHIHHGHHHHHF" + "LJJJJJJJJJJJJJJF"
bitmap$(2) = "MJKIJIJKJJKJJJJF" + "KHHHIHHHIHHGHHHF" + "MJJKJKJIJKJIJIJF"
bitmap$(3) = "LJJJJJJJJIJIJIJF" + "KHGHHHHIHHHHIHHF" + "LJJJIJJJIJJJJKJF"
bitmap$(4) = "MJJKJJJJJKJJJJJF" + "KHHHIHGHHIHHHHHF" + "MJJJJKJJJJJKJJJF"
bitmap$(5) = "MJJIJKJIJJIJKJJF" + "KHHHHHHIHHHHIHHF" + "MJKJJJJIJJJJJKJF"
bitmap$(6) = "LJKJIJJJKJJIJIJF" + "KHHGHHIHGHHIHGHF" + "LJKJIJJJKJJJIJJF"
bitmap$(7) = "MJJJJJJJJJJJJJJF" + "KHHHHHHHHHHHHHHF" + "MJJJJJJJJJIJJJJF"
bitmap$(8) = "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF"
bitmap$(9) = "KLKLKLKFJJJJJJJJ" + "JJJJJJJFJJJJJJJJ" + "JJJJJJJFKLKLKLKF"
bitmap$(10) = "LJJJJJJFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFLJJJJJJF"
bitmap$(11) = "MJJIJJJFKHIHHIHH" + "HIHIHHHFKHHGHGHH" + "HHGHIHHFMJKJIJJF"
bitmap$(12) = "LJJJKJJFKHHGHHHI" + "HHGHHGHFKHIHHHHI" + "HGHHHHHFLJJJKJJF"
bitmap$(13) = "MJIJJIJFKHIHHHHH" + "GHHHIHHFKHHHHHGH" + "HHIHHHHFMJKJJIJF"
bitmap$(14) = "MJJIJJJFKHHHIHHH" + "GHIHHHHFKHHHGHHH" + "HHHHHIHFMJJJJJJF"
bitmap$(15) = "LJKJKJJFKHIHHGHI" + "HHHIHGHFKHGHHIHG" + "HIHGHHHFLJKJIKJF"
bitmap$(16) = "MJJJJJJFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFMJJJJJJF"
bitmap$(17) = "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF"

FOR yd = 0 TO 17
FOR xd = 0 TO 47
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + 224
: PSET (xd + 32, yd + 64)
NEXT xd: NEXT yd

GET (48, 64)-(63, 81), blok
FOR i = 0 TO 19: PUT (i * 16, 156), blok, PSET
NEXT i

COLOR 15: LOCATE 10, 16: PRINT "SERCA 1.0"

REM animacja
REM 7,9 - rejestry przezroczyste

bitmap$(0) = "0000003333000000"
bitmap$(1) = "0000033333300000"
bitmap$(2) = "0000066663300000"
bitmap$(3) = "0000063663300000"
bitmap$(4) = "0000866666300000"
bitmap$(5) = "0000066666300000"
bitmap$(6) = "0000006666000000"
bitmap$(7) = "0000000661000000"
bitmap$(8) = "0000000711700000"
bitmap$(9) = "0000007111100000"

bitmap$(10) = "0000071111170000"
bitmap$(11) = "0000011111170000"
bitmap$(12) = "0000011111110000"
bitmap$(13) = "0000711111117000"
bitmap$(14) = "0000711111111000"
bitmap$(15) = "0000111111111000"
bitmap$(16) = "0001111333311000"
bitmap$(17) = "0006602222206600"
bitmap$(18) = "0006002222200600"
bitmap$(19) = "0000092222200000"
bitmap$(20) = "0000022222290000"
bitmap$(21) = "0000022222220000"
bitmap$(22) = "0000022202220000"
bitmap$(23) = "0000922202220000"
bitmap$(24) = "0000222202222000"
bitmap$(25) = "0000222009222000"
bitmap$(26) = "0000222000222000"
bitmap$(27) = "0000222000222000"
bitmap$(28) = "0009222000222300"
bitmap$(29) = "0002220000033300"
bitmap$(30) = "0003330000330000"
bitmap$(31) = "0033330000000000"

FOR yd = 0 TO 31
FOR xd = 0 TO 15
znak$ = MID$(bitmap$(yd), xd + 1, 1)
kolor = VAL("&H" + znak$ + "F")
IF znak$ <> "0" THEN COLOR kolor: PSET (xd, yd + 88): PSET (31 - xd, yd + 88)
IF znak$ = "7" THEN COLOR 16: PSET (xd, yd + 88): PSET (31 - xd, yd + 88)
IF znak$ = "A" THEN COLOR 16: PSET (xd, yd + 88): PSET (31 - xd, yd + 88)

IF znak$ = "9" THEN COLOR 32: PSET (xd, yd + 88): PSET (31 - xd, yd + 88)

NEXT xd
NEXT yd

REM ************************************ FAZA 2

bitmap$(0) = "0000003333000000"
bitmap$(1) = "0000033333300000"
bitmap$(2) = "0000066633300000"
bitmap$(3) = "0000063663300000"
bitmap$(4) = "0000866663300000"
bitmap$(5) = "0000066666300000"
bitmap$(6) = "0000006666000000"
bitmap$(7) = "0000000661000000"
bitmap$(8) = "0000000711700000"
bitmap$(9) = "0000007111100000"

bitmap$(10) = "0000001111100000"
bitmap$(11) = "0000001111100000"
bitmap$(12) = "0000001111100000"
bitmap$(13) = "0000001111100000"
bitmap$(14) = "0000071111100000"
bitmap$(15) = "0000071111100000"
bitmap$(16) = "0000071111300000"
bitmap$(17) = "0000028118200000"
bitmap$(18) = "0000022662200000"
bitmap$(19) = "0000022662200000"
bitmap$(20) = "0000022222000000"
bitmap$(21) = "0000922222000000"
bitmap$(22) = "0000222222000000"
bitmap$(23) = "0000922222000000"
bitmap$(24) = "0000022222000000"
bitmap$(25) = "0000022222300000"
bitmap$(26) = "0000002222300000"
bitmap$(27) = "0000000222330000"
bitmap$(28) = "0000000222033000"
bitmap$(29) = "0000000222000000"
bitmap$(30) = "0000000222000000"
bitmap$(31) = "0000033330000000"

FOR yd = 0 TO 31
FOR xd = 0 TO 15
znak$ = MID$(bitmap$(yd), xd + 1, 1)
kolor = VAL("&H" + znak$ + "F")
IF znak$ <> "0" THEN COLOR kolor: PSET (xd + 32, yd + 88): PSET (63 - xd, yd + 88)
IF znak$ = "7" THEN COLOR 16: PSET (xd + 32, yd + 88): PSET (63 - xd, yd + 88)
IF znak$ = "A" THEN COLOR 16: PSET (xd + 32, yd + 88): PSET (63 - xd, yd + 88)
IF znak$ = "9" THEN COLOR 32: PSET (xd + 32, yd + 88): PSET (63 - xd, yd + 88)

NEXT xd
NEXT yd

REM ************************ ruch poziomy FAZA 3

bitmap$(0) = "0000003333000000"
bitmap$(1) = "0000033333300000"
bitmap$(2) = "0000066633300000"
bitmap$(3) = "0000063663300000"
bitmap$(4) = "0000866663300000"
bitmap$(5) = "0000066666300000"
bitmap$(6) = "0000006666000000"
bitmap$(7) = "0000000661000000"
bitmap$(8) = "0000000711700000"
bitmap$(9) = "0000007111100000"

bitmap$(10) = "0000071111100000"
bitmap$(11) = "0000011111170000"
bitmap$(12) = "0000711111110000"
bitmap$(13) = "0000711111110000"
bitmap$(14) = "0000711111110000"
bitmap$(15) = "0000111111110000"
bitmap$(16) = "0000111333310000"
bitmap$(17) = "0000066222260000"
bitmap$(18) = "0000006222260000"
bitmap$(19) = "0000002222200000"
bitmap$(20) = "0000002222200000"
bitmap$(21) = "0000022222200000"
bitmap$(22) = "0000022222200000"
bitmap$(23) = "0000922222200000"
bitmap$(24) = "0000222022200000"
bitmap$(25) = "0000222022200000"
bitmap$(26) = "0000222092290000"
bitmap$(27) = "0000222002220000"
bitmap$(28) = "0000222002220000"
bitmap$(29) = "0003333002220000"
bitmap$(30) = "0000000000222000"
bitmap$(31) = "0000000033330000"

FOR yd = 0 TO 31
FOR xd = 0 TO 15
znak$ = MID$(bitmap$(yd), xd + 1, 1)
kolor = VAL("&H" + znak$ + "F")
IF znak$ <> "0" THEN COLOR kolor: PSET (xd + 64, yd + 88): PSET (95 - xd, yd + 88)
IF znak$ = "7" THEN COLOR 16: PSET (xd + 64, yd + 88): PSET (95 - xd, yd + 88)
IF znak$ = "A" THEN COLOR 16: PSET (xd + 64, yd + 88): PSET (95 - xd, yd + 88)

IF znak$ = "9" THEN COLOR 32: PSET (xd + 64, yd + 88): PSET (95 - xd, yd + 88)

NEXT xd
NEXT yd

REM ************************ fazy ruchu pionowego

REM Ludzik idacy w dol lub w gore

bitmap$(0) = "0000003330000000"
bitmap$(1) = "0000033333000000"
bitmap$(2) = "0000336663300000"
bitmap$(3) = "0000363636300000"
bitmap$(4) = "0000366666300000"
bitmap$(5) = "000006C8C6000000"
bitmap$(6) = "0000006860000000"
bitmap$(7) = "0000001610000000"
bitmap$(8) = "0000711111700000"
bitmap$(9) = "0001111111110000"

bitmap$(10) = "0071111111117000"
bitmap$(11) = "0071111111117000"
bitmap$(12) = "0011711111711000"
bitmap$(13) = "0711711111711700"
bitmap$(14) = "0A11711111711A00"
bitmap$(15) = "0117A11111A71100"
bitmap$(16) = "0117111111171100"
bitmap$(17) = "01104BBBBB401100"
bitmap$(18) = "0860922222906800"
bitmap$(19) = "0000922222900000"
bitmap$(20) = "0000929092900000"
bitmap$(21) = "0000929092900000"
bitmap$(22) = "0000929092900000"
bitmap$(23) = "0000929092900000"
bitmap$(24) = "0000929092900000"
bitmap$(25) = "0000929092900000"
bitmap$(26) = "0000929092900000"
bitmap$(27) = "0000929092900000"
bitmap$(28) = "0000929092900000"
bitmap$(29) = "0000929092900000"
bitmap$(30) = "0000333033300000"
bitmap$(31) = "0003330003330000"
FOR yd = 0 TO 31
FOR xd = 0 TO 15
znak$ = MID$(bitmap$(yd), xd + 1, 1)
kolor = VAL("&H" + znak$ + "F")
IF znak$ <> "0" THEN COLOR kolor: PSET (xd + 96, yd + 88)
IF znak$ = "7" THEN COLOR 16: PSET (xd + 96, yd + 88)
IF znak$ = "A" THEN COLOR 16: PSET (xd + 96, yd + 88)
IF znak$ = "4" THEN COLOR 32: PSET (xd + 96, yd + 88)

IF znak$ = "9" THEN COLOR 32: PSET (xd + 96, yd + 88)

NEXT xd
NEXT yd

REM RYSUNEK OKNA NIEBIESKO-ZIELONEGO
bitmap$(0) = "AAGGGGGGGGGGGGGGGGGGGGGGGGGGGGAA"
bitmap$(1) = "AAGKKKKKKKKGKKKKKKKKGKKKKKKKKGAA"
bitmap$(2) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(3) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(4) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(5) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(6) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(7) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(8) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(9) = "AAGKIEEEEIIGKIIEEIIIGKEEEIIIIGAA"
bitmap$(10) = "AAGKEEEEEEIGKIEEEEIEGKEEEEIIIGAA"
bitmap$(11) = "AAGKEEEEEEEGKEEEEEEEGKEEEEEEIGAA"
bitmap$(12) = "AAGKEHEEEEEGKEEEEEEEGKEEEEEEEGAA"
bitmap$(13) = "AAGKEHEHEEEGKEHEEEEEGKEEHEEEEGAA"
bitmap$(14) = "AAGKEEHEEEEGKEHEHEEEGKHEHEEHEGAA"
bitmap$(15) = "AAGKEEHEEEEGKEEHEEEEGKEHEEHEEGAA"
bitmap$(16) = "AAGKHEHEEEEGKHEHEHEEGKEEHEHEEGAA"
bitmap$(17) = "AAGKEHEEEHEGKEHEEEHEGKEEEHEEEGAA"
bitmap$(18) = "AAGKEHEEEHEGKEHEEEHEGKEEHEEEEGAA"
bitmap$(19) = "AGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGA"

FOR yd = 0 TO 19
FOR xd = 0 TO 31
color$ = MID$(bitmap$(yd), xd + 1, 1)

COLOR ASC(color$) - 65
PSET (xd, yd + 120)
NEXT xd: NEXT yd

REM RYSUNEK OKNA NIEBIESKIEGO
bitmap$(0) = "AAGGGGGGGGGGGGGGGGGGGGGGGGGGGGAA"
bitmap$(1) = "AAGKKKKKKKKGKKKKKKKKGKKKKKKKKGAA"
bitmap$(2) = "AAGKIIIIIIIGKIIIIIIIGKIIIJJJJGAA"
bitmap$(3) = "AAGKIIIIIIIGKIIIIIIIGKIIIJJJJGAA"
bitmap$(4) = "AAGKIIIIIIIGKIIIIIIIGKIIIIJJJGAA"
bitmap$(5) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIJJGAA"
bitmap$(6) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(7) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(8) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(9) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(10) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(11) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(12) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(13) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(14) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(15) = "AAGKIEEEEIIGKIIEEIIIGKEEEIIIIGAA"
bitmap$(16) = "AAGKEEEEEEIGKIEEEEIEGKEEEEIIIGAA"
bitmap$(17) = "AAGKEEEEEEEGKEEEEEEEGKEEEEEEIGAA"
bitmap$(18) = "AAGKEEEEEEEGKEEEEEEEGKEEEEEEEGAA"
bitmap$(19) = "AGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGA"

FOR yd = 0 TO 19
FOR xd = 0 TO 31
color$ = MID$(bitmap$(yd), xd + 1, 1)

COLOR ASC(color$) - 65
PSET (xd + 32, yd + 120)
NEXT xd: NEXT yd

REM RYSUNEK OKNA ZIELONEGO

bitmap$(0) = "AAGGGGGGGGGGGGGGGGGGGGGGGGGGGGAA"
bitmap$(1) = "AAGKKKKKKKKGKKKKKKKKGKKKKKKKKGAA"
bitmap$(2) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(3) = "AAGKIIIIIIIGKIIIIIIIGKIIIIIIIGAA"
bitmap$(4) = "AAGKIEEEEIIGKIIEEIIIGKEEEIIIIGAA"
bitmap$(5) = "AAGKEEEEEEIGKIEEEEIEGKEEEEIIIGAA"
bitmap$(6) = "AAGKEEEEEEEGKEEEEEEEGKEEEEEEIGAA"
bitmap$(7) = "AAGKEEHEEEEGKEEHEHEEGKEHEEEEEGAA"
bitmap$(8) = "AAGKEEHEHEEGKEEEHEEHGKEEHEEEEGAA"
bitmap$(9) = "AAGKEEEHEEEGKHEEHEHEGKHEHEEHEGAA"
bitmap$(10) = "AAGKHEEHEEEGKHEHEHEEGKEHEEHEEGAA"
bitmap$(11) = "AAGKEHEHEHEGKEHEEHEHGKEEHEHEEGAA"
bitmap$(12) = "AAGKEEHEEHEGKEHEEEHEGKEEHHEEEGAA"
bitmap$(13) = "AAGKEEHEHEEGKEHEHEHEGKEEHEEEEGAA"
bitmap$(14) = "AAGKEEHHEEEGKEHHEEHEGKEEHEEEEGAA"
bitmap$(15) = "AAGKEEHEEEEGKEHEEEHEGKEEHEEEEGAA"
bitmap$(16) = "AAGKEEHEEEEGKEHEEHHHGKEEHEEEEGAA"
bitmap$(17) = "AAGKEHHHEEEGKHHHEEEEGKEHHHEEEGAA"
bitmap$(18) = "AAGKEEEEEEEGKEEEEEEEGKEEEEEEEGAA"
bitmap$(19) = "AGGGGGGGGGGGGGGGGGGGGGGGGGGGGGGA"

FOR yd = 0 TO 19
FOR xd = 0 TO 31
color$ = MID$(bitmap$(yd), xd + 1, 1)

COLOR ASC(color$) - 65
PSET (xd + 64, yd + 120)
NEXT xd: NEXT yd

REM RYSUNEK wentylatora

bitmap$(0) = "KKKKKGGGGGKKKKKALLLLLGGGGGLLLLLA"
bitmap$(1) = "KKKGGNNLLLGGKKKALLLGGLLLLLGGLLLA"
bitmap$(2) = "KKGNNNNLLLLLGKKALLGALLLLLLLAGLLA"
bitmap$(3) = "KGMMNNNLLLLMMGKALGAALLLLLLLAAGLA"
bitmap$(4) = "KGMMMNNLLLMMMGKALGAAALLLLLAAAGLA"
bitmap$(5) = "GMMMMMNLLMMMMMGAGAAAALLLLLAAAAGA"
bitmap$(6) = "GMMMMMGGGMMMMNGAGAAAAALLLAAAAAGA"
bitmap$(7) = "GLLLLLGGGNNNNNGAGLLLAAALAAALLLGA"
bitmap$(8) = "GLLLLLGGGNNNNNGAGLLLLLLALLLLLLGA"
bitmap$(9) = "GLLLNNNMLLLNNNGAGLLLLLLALLLLLLGA"
bitmap$(10) = "KGNNNNMMMLLLNGKALGLLLLAAALLLLGLA"
bitmap$(11) = "KGNNNNMMMLLLLGKALGLLLAAAAALLLGLA"
bitmap$(12) = "KKGNNNMMMLLLGKKALLGLLAAAAALLGLLA"
bitmap$(13) = "KKKGGMMMMMGGKKKALLLGGAAAAAGGLLLA"
bitmap$(14) = "KKKKKGGGGGKKKKKALLLLLGGGGGLLLLLA"
bitmap$(15) = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"

FOR yd = 0 TO 15
FOR xd = 0 TO 31
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65
: PSET (xd, yd + 140)
NEXT xd: NEXT yd

REM rysunek bloku niebieskiego
REM 249-D 250-E 251-F

bitmap$(0) = "DDDDDDDDDDDDDDDE"
bitmap$(1) = "DFFFFFFFFFFFFFFE"
bitmap$(2) = "DFFFFFFFFFFFFFFE"
bitmap$(3) = "DFFFFFFFFFFFFFFE"
bitmap$(4) = "DFFFFFFFFFFFFFFE"
bitmap$(5) = "DFFFFFFFFFFFFFFE"
bitmap$(6) = "DFFFFFFFFFFFFFFE"
bitmap$(7) = "DFFFFFFFFFFFFFFE"
bitmap$(8) = "DFFFFFFFFFFFFFFE"
bitmap$(9) = "DFFFFFFFFFFFFFFE"
bitmap$(10) = "DFFFFFFFFFFFFFFE"
bitmap$(11) = "DFFFFFFFFFFFFFFE"
bitmap$(12) = "DFFFFFFFFFFFFFFE"
bitmap$(13) = "DFFFFFFFFFFFFFFE"
bitmap$(14) = "DFFFFFFFFFFFFFFE"
bitmap$(15) = "DFFFFFFFFFFFFFFE"
bitmap$(16) = "DFFFFFFFFFFFFFFE"
bitmap$(17) = "DEEEEEEEEEEEEEEE"
FOR yd = 0 TO 17
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + 246
PSET (80 + xd, 64 + yd)
PSET (96 + xd, 64 + yd)

NEXT xd: NEXT yd

REM zapis do pliku

DEF SEG = &HA000
BSAVE "bitmap1.scr", 0, 57000
COLOR 15: LOCATE 23, 1
INPUT a$
CLS

BLOAD "bitmap1.scr"

END

Piotr-246 · Gość

DECLARE SUB dzwiek (ktory!)

REM Gra "Serca", UWAGA wersja gry wymaga
REM emulatora o predkosci 6075 cyklow
REM wymaga pliku bitmap1.scr utworzonego przez modul bsave.bas

DECLARE SUB animacja ()
DECLARE SUB rysowanie ()
DECLARE SUB palety ()
DECLARE SUB plansze ()
DECLARE SUB cegly ()

REM plansza startowa:
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
roomx = 7: roomy = 4

DIM SHARED k$(0 TO 255): REM paleta kolorow
DIM pamiec(0 TO 128) AS LONG
DIM poledzialania(0 TO 240) AS LONG
DIM SHARED pozycjewind(1 TO 3) AS INTEGER
DIM SHARED p$(0 TO 159)
DIM SHARED kod$
DIM SHARED serca(0 TO 15, 0 TO 9) AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED xwindy AS INTEGER, ywindy AS INTEGER

REM pamiec tla pod wziatek

DIM SHARED tlo(0 TO 32) AS LONG

REM tlo

DIM SHARED szaretlo(0 TO 74) AS LONG
DIM SHARED szaretlo2(0 TO 148) AS LONG
DIM SHARED szaretlo4(0 TO 300) AS LONG
REM dane elementow planszy

DIM SHARED ceg2(0 TO 75) AS LONG
DIM SHARED ceg4(0 TO 144) AS LONG
DIM SHARED cegz2(0 TO 75) AS LONG

DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED nieb(0 TO 145) AS LONG

DIM SHARED blokp(0 TO 74) AS LONG
DIM SHARED bloks(0 TO 74) AS LONG
DIM SHARED blokk(0 TO 74) AS LONG
DIM SHARED blok2(0 TO 158) AS LONG
DIM SHARED blok4(0 TO 296) AS LONG

REM ****************** DANE ANIMACJI

DIM SHARED znakp1(0 TO 128) AS LONG
DIM SHARED znakl1(0 TO 128) AS LONG
DIM SHARED znakp2(0 TO 128) AS LONG
DIM SHARED znakl2(0 TO 128) AS LONG
DIM SHARED znakp3(0 TO 128) AS LONG
DIM SHARED znakl3(0 TO 128) AS LONG
DIM SHARED vertd1(0 TO 128) AS LONG

REM matryce okien

DIM SHARED window1(0 TO 160) AS LONG
DIM SHARED window2(0 TO 160) AS LONG
DIM SHARED window3(0 TO 160) AS LONG

DIM SHARED wentylator(0 TO 64) AS LONG

REM ************************* DANE STARTOWE

SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci

x = 200: y = 35: xs = 200: ys = 35: REM wspol. pocz. gracza na ekr.
licz = -1: REM wartosc start. zegara
kolwent = 30 + 30 * 256 + 30 * 65536: REM kolor lopat wentylatora

REM ***** SUB palety - ustawienie nowych wartosci barw
palety

REM ***** SUB cegly - zapelnienie pozostalych tablic
cegly

REM SUB plansze - wypelnienie tablicy wygladu plansz
plansze

REM ************************* START POMIESZCZENIA

rysuj:

kod$ = p$(roomx + roomy * 16)

REM ******************** rysowanie pomieszczenia
t0 = PEEK(1132): REM pomiar czasu rysowania

REM SUB rysowanie - rysowanie planszy
rysowanie

IF przejechal = 1 THEN y = ywindy + 3: ys = ywindy + 3: przejechal = 0

REM pomiar czasu rysowania
t1 = PEEK(1132):

REM menu na dole
LINE (0, 180)-(319, 182), 234, BF
LOCATE 25, 15: PRINT "L-SHIFT ALT P-SHIFT";
LOCATE 24, 2: COLOR 3: PRINT "T:"; t0; "/"; t1; FRE(-2);
PRINT " ROOM:"; roomx; "/"; roomy; "--";

REM **************** zapamietanie pola pod graczem
GET (x, y)-(x + 15, y + 31), pamiec
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
REM PUT (x, y), vertd1, PSET
liczsercaroom = 0: zrobione = 0
GOTO postaw
REM *************************** PETLA GLOWNA

petla:
dx = 0: dy = 0
IF dzwiekbrania = 1 THEN dzwiekbrania = 0: dzwiek (2)

REM ******************* czas gry w sekundach

se$ = MID$(TIME$, 7, 2)
se = VAL(se$)
IF se <> ses THEN licz = licz + 1
ses = se
LOCATE 25, 2: COLOR 15: PRINT "Czas:"; licz;

REM ************************ petla opozniajaca
FOR delay = 1 TO 700: NEXT delay

REM faza wentylatora

komorka = PEEK(1132) / 1.5
faz = INT(komorka)
IF faz / 3 = INT(faz / 3) THEN faza = 0
IF (faz + 1) / 3 = INT((faz + 1) / 3) THEN faza = 1
IF (faz + 2) / 3 = INT((faz + 2) / 3) THEN faza = 2
FOR i = 0 TO 2: i16 = i * 16
IF faza = 0 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, 0
IF faza = 1 THEN PALETTE 11 + i16, 0: PALETTE 12 + i16, kolwent: PALETTE 13 + i16, kolwent
IF faza = 2 THEN PALETTE 11 + i16, kolwent: PALETTE 12 + i16, 0: PALETTE 13 + i16, kolwent
NEXT i

REM ************************ sprawdzenie klawiszy

alt = 0: lshift = 0: pshift = 0: skos = 0

k$ = INKEY$
IF k$ = "f" THEN roomx = roomx - 1: GOTO rysuj
IF k$ = "h" THEN roomx = roomx + 1: GOTO rysuj
IF k$ = "t" THEN roomy = roomy - 1: GOTO rysuj
IF k$ = "b" THEN roomy = roomy + 1: GOTO rysuj
IF k$ = CHR$(27) THEN END

IF x >= xwindy AND y - ywindy < 10 THEN
IF k$ = "1" OR k$ = "2" THEN GOSUB przejazd: GOTO rysuj
IF k$ = "3" THEN GOSUB przejazd: GOTO rysuj
END IF

REM klawisz alt - wznoszenie sie
IF (PEEK(1047) AND 8) = 8 THEN alt = 1
IF (PEEK(1047) AND 2) = 2 THEN lshift = 1
IF (PEEK(1047) AND 1) = 1 THEN pshift = 1

REM bezruch = grawitacja
IF lshift = 0 AND pshift = 0 AND alt = 0 THEN dy = 2: vert = 1: obrot = 0: przebiervert = 0: GOTO czy

POKE 1050, PEEK(1052): REM czyszczenie bufora klawiatury

IF lshift = 1 THEN dx = -4: dy = 2: obrot = -1: vert = 0
IF pshift = 1 THEN dx = 4: dy = 2: obrot = 1: vert = 0
IF alt = 1 THEN dy = -4: vert = 1
IF dx <> 0 AND dy <> 0 THEN skos = 1
czy:

REM ************ sprawdzenie czy jest przejscie do innej planszy

IF x + dx > 300 THEN x = 5: xs = 5: roomx = roomx + 1: GOTO rysuj
IF x + dx < 3 THEN x = 300: xs = 300: roomx = roomx - 1: GOTO rysuj
IF y + dy > 144 THEN y = 5: ys = 5: roomy = roomy + 1: GOTO rysuj
IF y + dy < 4 THEN y = 145: ys = 145: roomy = roomy - 1: GOTO rysuj

REM *********** sprawdzenie czy ruch jest mozliwy
REM sprawdzenie przeszkody. Przeszkoda sa kolory > 200

xmozliwy = 0: xniemozliwy = 0
ymozliwy = 0: yniemozliwy = 0

REM sprawdzenie sasiedztwa obok

IF dx > 0 THEN
FOR i = 0 TO 31: punkt = POINT(x + 19, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 198 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF

IF dx < 0 THEN
FOR i = 0 TO 31: punkt = POINT(x - 3, y + i)
IF (punkt > 200 AND punkt <> 255) OR punkt = 199 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF xniemozliwy = 0 THEN xmozliwy = 1
IF xniemozliwy = 1 THEN xmozliwy = 0

REM sprawdzenie sasiedztwa gora dol

IF dy > 0 THEN
FOR i = 0 TO 15:
IF POINT(x + i, y + 32) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y + 33) > 200 THEN yniemozliwy = 1: EXIT FOR

NEXT i
END IF

IF dy < 0 THEN
FOR i = 0 TO 15
IF POINT(x + i, y - 4) > 200 THEN yniemozliwy = 1: EXIT FOR
IF POINT(x + i, y - 5) > 200 THEN yniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF yniemozliwy = 0 THEN ymozliwy = 1
IF yniemozliwy = 1 THEN ymozliwy = 0

REM ruch gdy oba mozliwe x oraz y
IF ymozliwy = 1 AND xmozliwy = 1 THEN IF dx <> 0 OR dy <> 0 THEN GOTO ruch

REM szczegolne przypadki gdy tylko x albo y mozliwy
IF ymozliwy = 0 AND xmozliwy = 1 THEN dy = 0: GOTO czy
IF ymozliwy = 1 AND xmozliwy = 0 THEN dx = 0: GOTO czy

REM ruch niemozliwy powrot petli glownej bez zmian pozostaja x y

x = xs: y = ys
GOTO petla

REM ***************** RUCH

ruch:

x = x + dx: y = y + dy
IF dy = 0 AND przebieranie = 0 AND alt = 0 THEN dzwiek (1): REM dzwiek chodzenia

REM ******************** czy jest wziatek
deltawx = ABS(x + 4 - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek

REM ************************************** operacja odswiezania tla
postaw:
REM punkt 1 zapamietanie nowego pola dzialania (brudnego)
REM w oparciu o nowe x,y

GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania

REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo

deltax = x - xs: deltay = y - ys
inversx = -1 * deltax: inversy = -1 * deltay
inver4 = INT(inversx / 4)
FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = (yt + inversy) * 6
FOR xt = 0 TO 3
index1 = 1 + (yt6 + 24) + (xt + inver4) + 1
index2 = 1 + yt4 + xt
poledzialania(index1) = pamiec(index2)
NEXT xt: NEXT yt

REM zmazanie serca z pola dzialania

IF liczsercaroom = 1 AND zrobione = 0 THEN
zrobione = 1
PUT (x - 4, y - 4), poledzialania, PSET
PUT (xserca, yserca), tlo, PSET
GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania
END IF

REM nowa mala pamiec

FOR yt = 0 TO 31:
yt4 = yt * 4
yt6 = yt * 6
FOR xt = 0 TO 3:
index1 = 1 + (yt6 + 24) + (xt + 1):
index2 = 1 + yt4 + xt:
pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt

REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU

REM aby nie rysowac dwoch postaci w przypadku skosu
IF skos = 1 THEN GOTO bezskosu:

REM ************************** ruch w dol lub gore

IF vert = 1 THEN wkleic = 7: GOTO wklej
bezskosu:
REM ************************** ruch w lewo

IF obrot = -1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1
IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 1: GOTO wklej
IF przebieranie = 1 THEN wkleic = 2: GOTO wklej
IF przebieranie = 2 THEN wkleic = 3: GOTO wklej
END IF

REM ****************** ruch w prawo

IF obrot = 1 THEN
IF dy = 0 THEN przebieranie = przebieranie + 1

IF przebieranie = 3 THEN przebieranie = 0
IF przebieranie = 0 THEN wkleic = 4: GOTO wklej
IF przebieranie = 1 THEN wkleic = 5: GOTO wklej
IF przebieranie = 2 THEN wkleic = 6: GOTO wklej
END IF

xs = x: ys = y

GOTO petla

wklej:

IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt
IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt
IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt
IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt
IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt
IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt
IF wkleic = 7 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)): NEXT xt: NEXT yt

REM wklejenie wyniku operacji na tablicy:
PUT (x - 4, y - 4), poledzialania, PSET

xs = x: ys = y
GOTO petla

REM GOSUB-RETURN****************************** obsluga wziatku

wziatek:
IF serca(roomx, roomy) = 0 THEN GOTO niemawziatku
IF liczsercaroom = 1 THEN GOTO niemawziatku
serca(roomx, roomy) = 0
liczserca = liczserca + 1
PUT (xserca, yserca), tlo, PSET

liczsercaroom = 1
dzwiekbrania = 1

LOCATE 1, 1: COLOR 6: PRINT liczserca;
niemawziatku:
RETURN

REM GOSUB-RETURN przejazd:
przejazd:
pietro = VAL(k$)
roomy = pozycjewind(pietro)

FOR i = 23 TO 0 STEP -1
LINE (xwindy + i, ywindy)-(xwindy + i, ywindy + 35), 255
FOR j = 1 TO 7500: NEXT j
NEXT i
CLS
FOR i = 1 TO 30000: NEXT i
przejechal = 1
RETURN

SUB cegly

BLOAD "bitmap1.scr"

REM INPUT a$
REM pobranie z ekranu tablic elementow
REM uwaga! wysokosc elementu to 9 lub 18 px

GET (0, 0)-(31, 8), ceg2
GET (0, 0)-(63, 8), ceg4
GET (64, 0)-(95, 8), cegz2

GET (0, 36)-(15, 53), szaretlo
GET (0, 36)-(31, 53), szaretlo2
GET (0, 36)-(63, 53), szaretlo4

GET (16, 64)-(31, 79), palma
GET (32, 64)-(47, 81), blokp
GET (48, 64)-(63, 81), bloks
GET (64, 64)-(79, 81), blokk
GET (0, 156)-(31, 173), blok2
GET (0, 156)-(63, 173), blok4
GET (80, 64)-(111, 81), nieb

GET (0, 88)-(15, 119), znakl1
GET (16, 88)-(31, 119), znakp1
GET (32, 88)-(47, 119), znakl2
GET (48, 88)-(63, 119), znakp2
GET (64, 88)-(79, 119), znakl3
GET (80, 88)-(95, 119), znakp3
GET (96, 88)-(111, 119), vertd1

GET (0, 120)-(31, 139), window1
GET (32, 120)-(63, 139), window2
GET (64, 120)-(95, 139), window3
GET (0, 140)-(15, 155), wentylator
CLS
END SUB

SUB dzwiek (ktory)

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

REM DREPTANIE
IF ktory = 1 THEN

REM ewentualnie:
REM OUT 66, 30: OUT 66, 0
REM OUT 66, 164: OUT 66, 2
REM OUT 66, 130: OUT 66, 1
REM OUT 66, 74: OUT 66, 0
REM OUT 66, 220: OUT 66, 1

FOR i = 1 TO 10
OUT 66, 30: OUT 66, 0
OUT 66, 84: OUT 66, 2
OUT 66, 30: OUT 66, 0
OUT 66, 94: OUT 66, 2
OUT 66, 10: OUT 66, 0
OUT 66, 40: OUT 66, 2
OUT 66, 84: OUT 66, 0
OUT 66, 10: OUT 66, 2
NEXT i
REM FOR i = 1 TO 150: NEXT i
END IF

REM zabranie serca

IF ktory = 2 THEN
OUT 66, 32: OUT 66, 3
FOR i = 1 TO 6000: NEXT i
OUT 66, 204: OUT 66, 4
FOR i = 1 TO 6000: NEXT i
END IF

REM wylaczenie glosnika
OUT 97, stary.port

END SUB

SUB palety

REM palety kolorow *********************************
REM max koloru=3F

FOR i = 0 TO 255: k$(i) = "00 00 00 00"
PALETTE i, 31 + 31 * 256 + 31 * 65536: NEXT i

REM kolory za ludzikiem

k$(0) = "00 00 00 00": REM rejestr zero- wolny
k$(1) = "01 05 05 06": REM tlo plyta
k$(2) = "02 02 03 02": REM tlo fuga
k$(3) = "03 07 06 06": REM tlo krawedz
k$(4) = "04 00 22 00": REM liscie
k$(5) = "05 3F 08 00": REM serce
k$(6) = "06 30 30 30": REM framuga okna
k$(7) = "07 28 0A 00": REM doniczka drzewa
k$(8) = "08 00 21 39": REM niebo
k$(9) = "09 3F 3F 00": REM slonce
k$(10) = "0A 14 14 14": REM framuga zewnetrzna
k$(11) = "0B 00 00 00": REM wentylator faza 1
k$(12) = "0C 00 00 00": REM wentylator faza 2
k$(13) = "0D 00 00 00": REM wentylator faza 3
k$(14) = "0E 20 20 20": REM srednia szarosc
k$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza

REM rejestry przezroczyste gracza
k$(16) = "10 18 02 02": REM sweter + zero
k$(17) = "11 18 02 02": REM
k$(18) = "12 18 02 02": REM
k$(19) = "13 18 02 02": REM
k$(20) = "14 22 12 00": REM sweter + liscie
k$(21) = "15 3F 00 00": REM
k$(22) = "16 2F 09 09": REM sweter + framuga okna
k$(23) = "17 2B 08 00": REM sweter + doniczka drzewa
k$(24) = "18 25 16 24": REM sweter + niebo
k$(25) = "19 3F 3F 3F": REM sweter + slonce
k$(26) = "1A 16 0F 0F": REM sweter + framuga zew
k$(27) = "1B 3F 3F 3F": REM
k$(28) = "1C 3F 3F 3F": REM
k$(29) = "1D 3F 3F 3F": REM
k$(30) = "1E 20 10 10": REM sweter + przyciski
REM kolor 31 (1F) zastrzezony dla gracza
k$(32) = "20 0A 13 29": REM spodnie + zero
k$(33) = "21 0A 13 29": REM
k$(34) = "22 0A 13 29": REM
k$(35) = "23 0A 13 29": REM
k$(36) = "24 05 1D 24": REM spodnie+ liscie
k$(37) = "25 3F 3F 3F": REM
k$(38) = "26 1B 1B 32": REM spodnie + framuga okna
k$(39) = "27 1A 10 3F": REM spodnie + doniczka
k$(40) = "28 00 1A 3F": REM spodnie + niebo
k$(41) = "29 3F 3F 3F": REM spodnie +slonce
k$(42) = "2A 10 14 20": REM spodnie + framuga zew
k$(43) = "2B 3F 3F 3F": REM
k$(44) = "2C 3F 3F 3F": REM
k$(45) = "2D 3F 3F 3F": REM
k$(46) = "2E 3F 3F 3F": REM
REM rejestr 47 (2F) zastrzezony dla gracza

REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF)
REM rejestry nieprzezroczyste

k$(31) = "1F 2F 09 09": REM sweter
k$(47) = "2F 0D 1A 37": REM spodnie
k$(63) = "3F 1A 1A 1A": REM wlosy i buty
k$(79) = "4F 10 10 10": REM pasek2
k$(95) = "5F 3F 2F 0F":
k$(111) = "6F 3F 30 20": REM skora1
REM kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych
k$(143) = "8F 32 22 02": REM nos
REM kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych
REM kolor$(175) = "AF 22 02 02": REM sweter3
k$(191) = "BF 20 20 20": REM pasek
k$(207) = "CF 37 27 06": REM usta
REM FF- zarezerwowany dla przeslony

REM rejestry jednokierunkowe
k$(198) = "C6 20 20 20"
k$(199) = "C7 20 20 20"

REM bloczek

k$(224) = "E0 00 00 00": REM
k$(225) = "E1 04 04 04": REM
k$(226) = "E2 08 08 08": REM
k$(227) = "E3 0B 0B 0B": REM
k$(228) = "E4 10 10 10": REM
k$(229) = "E5 14 14 14": REM
k$(230) = "E6 18 18 18": REM
k$(231) = "E7 1B 1B 1B": REM
k$(232) = "E8 20 20 20": REM
k$(233) = "E9 24 24 24": REM
k$(234) = "EA 28 28 28": REM
k$(235) = "EB 2B 2B 2B": REM
k$(236) = "EC 30 30 30": REM
k$(237) = "ED 34 34 34": REM
k$(238) = "EE 38 38 38": REM
k$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika

REM kolor 240 - przeslona
k$(240) = "F0 38 38 38"

REM cegly male zielone

k$(246) = "F6 22 30 27": REM krawedz
k$(247) = "F7 09 14 0E": REM fuga
k$(248) = "F8 11 1f 17": REM cegla

REM cegly male niebieskie

k$(249) = "F9 22 27 30": REM krawedz
k$(250) = "FA 09 0E 14": REM fuga
k$(251) = "FB 11 17 1F": REM cegla

REM cegly male czerwone

k$(252) = "FC 30 27 27": REM krawedz
k$(253) = "FD 14 0E 0E": REM fuga
k$(254) = "FE 1F 17 17": REM cegla
k$(255) = "FF 28 28 28": REM przeslona

FOR i = 0 TO 255: rej$ = "&H" + MID$(k$(i), 1, 2)
red$ = "&H" + MID$(k$(i), 4, 2)
gre$ = "&H" + MID$(k$(i), 7, 2)
blu$ = "&H" + MID$(k$(i), 10, 2)
REM PRINT rej$; " "; red$; " "; gre$; " "; blu$
rej = VAL(rej$)
red = VAL(red$)
gre = VAL(gre$)
blu = VAL(blu$)
REM PRINT rej; " "; red; " "; gre; " "; blu

PALETTE rej, red + gre * 256 + blu * 65536
NEXT i

END SUB

SUB plansze

REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** roomy*16+roomx

REM kody plansz +++nr.po.ok.we.se_kw_dod
REM ************ plansze wiersza roomy=0

p$(0) = "h22233322d.0.UI.YO....GN________!"
p$(1) = "h000fff11h.1....MD....__________!"
p$(2) = "h11133333f.2.UI.HE....___EQ_____!"
p$(3) = "hh2223cchh.3..........SJ________!"
p$(4) = "h300033fff.4....ZK....__________!"
p$(5) = "h2001c333f.5....LG....______AQG_!"
p$(6) = "h111g3322f.6....LD....___EQ_F[Q_!"
p$(7) = "hh222ff11d.7.BE.......aH_ZI_MdO_!"
p$(8) = "hhDDDfCCCg.8..........______DQK_!"
p$(9) = "hhhhhf111c.9..........__________!"
p$(10) = "hhhhhf222g.A..........MO_EQ_____!"
p$(11) = "hh333f111d.B....HG....__________!"
p$(12) = "hhffff333g.C..........__________!"
p$(13) = "h22233333c.D.UN.aK.DF.MK____AYC_!"
p$(14) = "h111ff22hh.E..........___aG_BLM_!"
p$(15) = "h3333311cc.F....ZK....aH____AIG_!"

REM ************ plansze wiersza roomy=1

p$(16) = "d333c2223h.0.......FN.__________!"
p$(17) = "h33330003h.1.WH.SO....dE____COM_!"
p$(18) = "ff333111ff.2.WJ.ML....__________!"
p$(19) = "hc222c333c.3..........___QQ_____!"
p$(20) = "f31113333h.4.UM.aI.aO.__________!"
p$(21) = "f333aa333h.5..........RN_GQ_____!"
p$(22) = "ffff333fff.6....DJ....aM____G[M_!"
p$(23) = "dd333a33hh.7..........__________!"
p$(24) = "gg333333ff.8.AK....IF.__________!"
p$(25) = "cc3322333c.9.WM.......eF________!"
p$(26) = "gg331133hh.A....LF....aO________!"
p$(27) = "ddaa22cccc.B..........__________!"
p$(28) = "g33300333h.C.AM....aO.__________!"
p$(29) = "c33311333c.D.0M.......ZK____AQO_!"
p$(30) = "h3322233dd.E.BG....cE.__________!"
p$(31) = "c33111333h.F.AM.bD....___QQ_COH_!"

REM ************* plansze wiersza roomy=2

p$(32) = "h333ff333c.0..........KE_WQ_____!"
p$(33) = "h33332222c.1....KD....UP____CGI_!"
p$(34) = "faaaa0000h.2....WO.VI.__________!"
p$(35) = "ccccc1111f.3....MM....___EQ_____!"
p$(36) = "h33333223h.4.WI.FP....SM________!"
p$(37) = "haa33200af.5.UJ....GL.______HIE_!"
p$(38) = "f333c111ah.6....aM....UP________!"
p$(39) = "hh333d333g.7....YP....___KQ_____!"
p$(40) = "ff3333333g.8.#I.......KK____CGN_!"
p$(41) = "c33g33d33c.9..........__________!"
p$(42) = "hh3333333g.A.WM.LI....__________!"
p$(43) = "cc333322cc.B.UJ.......__________!"
p$(44) = "hhaacc00hh.C.BD....JG.ZM____AQM_!"
p$(45) = "c333cc11gg.D....aN....______AQM_!"
p$(46) = "dd33cc22hh.E..........___aG_AQE_!"
p$(47) = "hh3333113c.F.UJ....VI.___EQ_____!"

REM ************ plansze wiersza roomy=3

p$(48) = "c33332222f.0....ZM.ZD.SF____COI_!"
p$(49) = "ccccc1111h.1..........__________!"
p$(50) = "ha3222333c.2.#F.LO....UO_SQ_____!"
p$(51) = "ff3111333f.3.WM.YI.VI.SJ_GQ_____!"
p$(52) = "h3333c333f.4..........NG____CKK_!"
p$(53) = "ff333c222f.5....ZO....SG________!"
p$(54) = "hhaaff000f.6.BE.......___KQ_____!"
p$(55) = "gggg33111f.7....LO.VJ.______IYM_!"
p$(56) = "gg3322ffff.8..........GG________!"
p$(57) = "cccc00hfff.9..........__________!"
p$(58) = "gg33DDffff.A..........___KK_CCH_!"
p$(59) = "cccccfffff.B.......TL.__________!"
p$(60) = "hh3333333f.C....KK....DP________!"
p$(61) = "g333333hhh.D.UJ....TF.______CKK_!"
p$(62) = "hh3222333f.E..........___GQ_____!"
p$(63) = "c331113hhh.F....ZK....__________!"

REM ****************** plansze wiersza roomy=4

p$(64) = "f22322322h.0....DD....SP_YQ_CKK_!"
p$(65) = "h00f00f00h.1..........__________!"
p$(66) = "c11311311f.2....aP.KP.__________!"
p$(67) = "ff3332223h.3.UJ.ML....___YQ_____!"
p$(68) = "f3333111hh.4.WJ.YL....__________!"
p$(69) = "ffaafaaaff.5.......VI.__________!"
p$(70) = "ffa333c33h.6....OG....SQ_YQ_____!"
p$(71) = "ff223c33cd.7.0C.SN....GN_TI_MdM_!": REM startowa
p$(72) = "ff113cc33d.8..........MO____JVO_!"
p$(73) = "ff33cc33ff.9..........______COI_!"
p$(74) = "ff3333333d.A.WM.LI.ZP.PP________!"
p$(75) = "ff2233333f.B.UM.......___EQ_____!"
p$(76) = "ff11333hhh.C.......KH.__________!"
p$(77) = "h333333333.D.BE.SK....bF____CKK_!"
p$(78) = "ff222333hh.E.UK.......______FEE_!"
p$(79) = "h3111333ff.F.WK.......MM________!"

REM ******************* plansze wiersza roomy=5

p$(80) = "haf222faff.0.......VI.___KK_____!"
p$(81) = "hhf111222h.1..........SP____CKK_!"
p$(82) = "fa333c000h.2....GO....__________!"
p$(83) = "h222fa111f.3..........___YQ_____!"
p$(84) = "h111c2223h.4.0Q....EE.MM________!"
p$(85) = "ffffa111ff.5..........______GOE_!"
p$(86) = "h333c333af.6....DD....ZF_MQ_____!"
p$(87) = "dd333f333g.7.......VI.___aI_____!"
p$(88) = "dd3333333g.8.UN.KP....______COI_!"
p$(89) = "f32233f33f.9.......ED.KK________!"
p$(90) = "ddDDCC333h.A....ZK....KO________!"
p$(91) = "f33300f33f.B..........______COH_!"
p$(92) = "h33300333c.C....NN....__________!"
p$(93) = "333311333h.D.0M....TG.GG________!"
p$(94) = "h33222333c.E.AM.......__________!"
p$(95) = "ff3111333h.F.WM.FF....___YQ_____!"

REM ******************* plansze wiersza roomy=6

p$(96) = "fffa222hhh.0....EJ....___YM_____!"
p$(97) = "hhhf000bbb.1....SJ....ML____CMO_!"
p$(98) = "h333111hhh.2..........___KM_____!"
p$(99) = "f333aaafff.3....PH....ZJ________!"
p$(100) = "h222ahhhhh.4..........EE________!"
p$(101) = "f11133222h.5.0I.......___GQ_____!"
p$(102) = "ffffff000h.6....LO....__________!"
p$(103) = "gg333d111f.7....MO....aP________!"
p$(104) = "gg333hCCCh.8.......ZN.EG____HIE_!"
p$(105) = "ffffffDDDh.9..........______DQK_!"
p$(106) = "hh333fCCCh.A.BE.......___KI_____!"
p$(107) = "ff3333111h.B.0I....LK.aP____CON_!"
p$(108) = "cc22dd22ff.C..........__________!"
p$(109) = "hhDDffDDhh.D.......TJ.LN________!"
p$(110) = "ccc2222hhh.E..........__________!"
p$(111) = "hhhDDDDhhh.F..........TK_KM_____!"

REM ******************* plansze wiersza roomy=7

p$(112) = "hfaa222fff.0..........______COJ_!"
p$(113) = "bbbb000hhh.1....KK....__________!"
p$(114) = "h222111fff.2.BJ.......ZE____AIK_!"
p$(115) = "f000aaahhh.3..........___KM_____!"
p$(116) = "h000ahhhhh.4.......KF.__________!"
p$(117) = "h111hh222h.5..........KQ________!"
p$(118) = "hffaaa001f.6....KO....__________!"
p$(119) = "ff33ee00hh.7..........___KO_MdE_!"
p$(120) = "hh3333002h.8.BL.......______CCQ_!"
p$(121) = "hCCCffDDDh.9..........KO________!"
p$(122) = "hDDDccCCCh.A..........___MK_____!"
p$(123) = "hf333300Df.B.AL.......__________!"
p$(124) = "ffffff11hh.C....KN....______IOI_!"
p$(125) = "hhhhhf22fh.D.......TK.__________!"
p$(126) = "h33c3300ff.E..........KK____COG_!"
p$(127) = "hhheefDDhh.F....KN....__________!"

REM ***************** n/8 plansze wiersza roomy=8

p$(128) = "fffa222hhh.0..........KK________!"
p$(129) = "hbbb000hhh.1.UH.ZK....__________!"
p$(130) = "f222111fff.2.......KK.__________!"
p$(131) = "h000ccchhh.3..........______COI_!"
p$(132) = "h111afffhh.4.UK.......RN________!"
p$(133) = "h333ff222h.5....KO....__________!"
p$(134) = "ffffff000h.6.......aN.______DQK_!"
p$(135) = "hhhhha000h.7..........______ESK_!"
p$(136) = "hh3333000c.8....KG....______CKK_!"
p$(137) = "h33333111h.9..........cD____OKK_!"
p$(138) = "h33333222h.A.BG.......__________!"
p$(139) = "ffCCff00ff.B....KN....______KaE_!"
p$(140) = "hfDDff00hh.C.......TH.______JKM_!"
p$(141) = "hhhaac00fh.D.0L.......__________!"
p$(142) = "f3333300ff.E....SI....______COL_!"
p$(143) = "hhheefDDhh.F..........]H________!"

REM ***************** n/9 plansze wiersza roomy=9

p$(144) = "haaa222ffh.0....SD....______COH_!"
p$(145) = "heee000hhh.1.......DK.__________!"
p$(146) = "f222311hhh.2.AI.......KK________!"
p$(147) = "h000aaahhh.3..........______IOJ_!"
p$(148) = "h000ahhhhh.4....KH....__________!"
p$(149) = "h111hhhhhh.5..........___KG_____!"
p$(150) = "hhffaa222h.6.......ZK.______HEM_!"
p$(151) = "hhaaaa000h.7.UL.......__________!"
p$(152) = "ccc333000h.8.AL.......dI________!"
p$(153) = "h33333111h.9....SD....______GOK_!"
p$(154) = "h33333222h.A..........______NKG_!"
p$(155) = "ff223300Dh.B.BL.......__________!"
p$(156) = "hfDDff00hh.C.......SK.__________!"
p$(157) = "hhhaac00fh.D....KK....______DYK_!"
p$(158) = "f3333300hh.E..........KK____ECI_!"
p$(159) = "haa333DDhh.F.WL....DK.__________!"

REM tablica serc
FOR xr = 0 TO 15
FOR yr = 0 TO 9
s = xr + yr * 16
znak$ = MID$(p$(s), 23, 1)
IF znak$ <> "_" THEN serca(xr, yr) = 1
NEXT yr: NEXT xr

REM tablica wind
pozycjewind(1) = 0
pozycjewind(2) = 4
pozycjewind(3) = 7
END SUB

SUB rysowanie

FOR yw = 0 TO 9
el$ = MID$(kod$, yw + 1, 1)
y16 = yw * 18

REM tymczasowe sygnalizacje bledow:

IF el$ = "Q" OR el$ = "L" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "P" OR el$ = "W" OR el$ = "=" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "A" OR el$ = "B" OR el$ = "U" THEN COLOR 15: LINE (0, y16)-(200, y16)
IF el$ = "@" THEN COLOR 15: LINE (0, y16)-(200, y16)

REM elementy uzupelniajace

IF el$ = "C" THEN
PUT (128, y16), szaretlo4, PSET: PUT (192, y16), szaretlo4, PSET
PUT (256, y16), szaretlo4, PSET
PUT (0, y16), blok4, PSET: PUT (64, y16), blok2, PSET:
PUT (96, y16), bloks, PSET: PUT (112, y16), blokk, PSET
END IF

IF el$ = "D" THEN
PUT (0, y16), szaretlo4, PSET: PUT (64, y16), szaretlo4, PSET
PUT (128, y16), szaretlo4, PSET
PUT (192, y16), blokp, PSET: PUT (208, y16), blok4, PSET
PUT (272, y16), blok2, PSET: PUT (304, y16), bloks, PSET
END IF

REM czesc automatyczna, znaki a-h
ascii = ASC(el$)

IF ascii > 96 THEN
bity = ascii - 97
PUT (0, y16), blok4, PSET:
pop1 = 0
pop2 = 0
pop3 = 0

IF (bity AND 4) = 4 THEN PUT (64, y16), blok4, PSET: pop1 = 1
IF (bity AND 4) = 0 THEN PUT (48, y16), blokk, PSET: PUT (64, y16), szaretlo4, PSET: pop1 = 0
REM
IF (bity AND 2) = 2 THEN pop2 = 1: PUT (128, y16), blok4, PSET: IF pop1 = 0 THEN PUT (128, y16), blokp, PSET
IF (bity AND 2) = 0 THEN pop2 = 0: PUT (128, y16), szaretlo4, PSET: IF pop1 = 1 THEN PUT (112, y16), blokk, PSET
REM
IF (bity AND 1) = 1 THEN pop3 = 1: PUT (192, y16), blok4, PSET: IF pop2 = 0 THEN PUT (192, y16), blokp, PSET
IF (bity AND 1) = 0 THEN pop3 = 0: PUT (192, y16), szaretlo4, PSET: IF pop2 = 1 THEN PUT (176, y16), blokk, PSET
PUT (256, y16), blok4, PSET
IF pop3 = 0 THEN PUT (256, y16), blokp, PSET
END IF

REM znaki 0-3

IF ascii < 58 THEN
bity = ascii - 48
IF (bity AND 2) = 2 THEN PUT (0, y16), blokk, PSET
IF (bity AND 2) = 0 THEN PUT (0, y16), szaretlo, PSET
PUT (16, y16), szaretlo4, PSET
PUT (80, y16), szaretlo4, PSET
PUT (144, y16), szaretlo4, PSET
PUT (208, y16), szaretlo4, PSET
PUT (272, y16), szaretlo2, PSET

IF (bity AND 1) = 1 THEN PUT (304, y16), blokp, PSET
IF (bity AND 1) = 0 THEN PUT (304, y16), szaretlo, PSET
END IF

NEXT yw

REM rysowanie podestow

el$ = MID$(kod$, 14, 1)
IF el$ = "" OR el$ = "." THEN GOTO dodatek

el2$ = MID$(kod$, 15, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "#" THEN FOR xx = 0 TO 4: PUT (xx * 64, yo), ceg4, PSET: NEXT xx
IF el$ = "W" THEN
PUT (16, yo), ceg2, PSET: PUT (80, yo), ceg4, PSET
PUT (144, yo), ceg4, PSET: PUT (208, yo), ceg2, PSET: PUT (272, yo), ceg2, PSET
END IF
IF el$ = "U" THEN
PUT (16, yo), ceg4, PSET: PUT (64, yo), ceg4, PSET
PUT (192, yo), ceg4, PSET: PUT (240, yo), ceg4, PSET
END IF
IF el$ = "0" THEN PUT (16, yo), ceg4, PSET: PUT (240, yo), ceg4, PSET
IF el$ = "A" THEN FOR xx = 0 TO 4: PUT (16 + xx * 64, yo), ceg2, PSET: NEXT xx
IF el$ = "B" THEN FOR xx = 0 TO 5: PUT (64 + xx * 32, yo), ceg2, PSET: NEXT xx

REM dodatkowy element
dodatek:

el$ = MID$(kod$, 29, 1)
IF el$ = "" OR el$ = "_" THEN GOTO okna
el2$ = MID$(kod$, 30, 1)
xo = (ASC(el2$) - 65) * 8
el2$ = MID$(kod$, 31, 1)
yo = (ASC(el2$) - 65) * 9
IF el$ = "A" THEN
PUT (xo, yo), blokp, PSET: PUT (xo, yo + 18), blokp, PSET
PUT (xo + 16, yo), blok2, PSET: PUT (xo + 16, yo + 18), blok2, PSET
PUT (xo + 48, yo), blokk, PSET: PUT (xo + 48, yo + 18), blokk, PSET
END IF

IF el$ = "B" THEN COLOR 235: LINE (xo + 5, yo)-(xo + 9, yo + 35), , BF
IF el$ = "C" THEN PUT (xo, yo), ceg2, PSET: PUT (xo + 32, yo), ceg2, PSET: PUT (xo + 64, yo), ceg2, PSET
IF el$ = "D" THEN LINE (xo, yo)-(xo + 22, yo + 17), 235, BF: LINE (xo + 42, yo)-(xo + 63, yo + 17), 235, BF
IF el$ = "E" THEN LINE (xo, yo)-(xo + 5, yo + 35), 235, BF: LINE (xo + 26, yo + 36)-(xo + 31, yo + 72), 235, BF
REM niebieskie klocki
IF el$ = "F" THEN PUT (xo, yo), nieb, PSET
IF el$ = "G" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo), nieb, PSET
IF el$ = "H" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo + 36), nieb, PSET
IF el$ = "I" THEN PUT (xo, yo), nieb, PSET: PUT (xo + 64, yo - 36), nieb, PSET
REM jednokierunkowe bramki
IF el$ = "J" THEN PSET (xo - 2, yo), 199: DRAW "R18 D35 L18 U35 F18 U1 G18"
IF el$ = "K" THEN PSET (xo - 2, yo), 198: DRAW "R18 D35 L18 U35 R18 G18 U1 F18"
REM zaslonka
IF el$ = "L" THEN LINE (xo, yo)-(xo + 15, yo + 35), 255, BF
REM winda
xwindy = -10: ywindy = -10
IF el$ = "M" THEN
LINE (xo, yo)-(xo + 23, yo + 35), 10, BF
LINE (xo, yo)-(xo, yo + 36), 6
LINE (xo + 3, yo + 7)-(xo + 5, yo + 17), 14, BF
LINE (xo + 1, yo)-(xo + 23, yo), 9
PSET (xo + 4, yo + 8), 12
PSET (xo + 4, yo + 10), 5: DRAW "D7 C14 R1 U2 L2 U2 R2 U2 L2"
xwindy = xo: ywindy = yo
COLOR 8: LOCATE (ywindy / 8) + 2, 34
IF roomy = 0 THEN PRINT "1"
IF roomy = 4 THEN PRINT "2"
IF roomy = 7 THEN PRINT "3"
END IF
IF el$ = "N" THEN
PUT (xo, yo), cegz2, PSET: PUT (xo + 64, yo), cegz2, PSET: PUT (xo + 128, yo), cegz2, PSET
PUT (xo, yo + 54), cegz2, PSET: PUT (xo + 64, yo + 54), cegz2, PSET: PUT (xo + 128, yo + 54), cegz2, PSET
END IF
IF el$ = "O" THEN
PUT (xo, yo), cegz2, PSET: PUT (xo + 64, yo), cegz2, PSET: PUT (xo + 128, yo), cegz2, PSET
END IF

okna:

REM rysowanie okien

el$ = MID$(kod$, 17, 1)
IF el$ = "" OR el$ = "." THEN GOTO serce
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 18, 1)
yo = (ASC(el$) - 65) * 9
IF roomy < 2 THEN PUT (xo, yo), window2, PSET
IF roomy > 1 AND roomy < 5 THEN PUT (xo, yo), window1, PSET
IF roomy > 4 THEN PUT (xo, yo), window3, PSET

serce:
REM serce
xserca = -20: yserca = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 23, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xserca = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 24, 1)
yserca = (ASC(el$) - 65) * 9
GET (xserca, yserca)-(xserca + 15, yserca + 7), tlo
PSET (xserca, yserca + 1), 5
DRAW "D2 F1 U4 R1 D5 F1 U5 E1 D5 E1 U4 F1 D2"

donica:
el$ = MID$(kod$, 26, 1)
IF el$ = "" OR el$ = "_" THEN GOTO wentyl
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 27, 1)
yo = (ASC(el$) - 65) * 9 + 2
PUT (xo, yo), palma, PSET

wentyl:
el$ = MID$(kod$, 20, 1)
IF el$ = "" OR el$ = "." THEN GOTO koniecrysowania
xo = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 21, 1)
yo = (ASC(el$) - 65) * 9
PUT (xo, yo), wentylator, PSET

koniecrysowania:

COLOR 15

END SUB