Autor |
Wiadomość |
Piotr-246 |
Wysłany: Śro 20:26, 01 Wrz 2021 Temat postu: |
|
DECLARE SUB zabranie ()
REM Gra "Serca"
REM wymaga emulatora o predkosci 3300 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 ()
DIM SHARED pomoc$(0 TO 31)
DIM pamiec(0 TO 128) AS LONG
DIM SHARED plansza$(0 TO 48)
DIM SHARED kod$
DIM SHARED serca(1 TO 7, 1 TO 7) AS INTEGER
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED bitmap$(0 TO 15)
REM pamiec tla pod wziatek
DIM SHARED tlo(0 TO 32) AS LONG
REM tlo
DIM SHARED szaretlo(0 TO 64) AS LONG
DIM SHARED szaretlo2(0 TO 128) AS LONG
DIM SHARED szaretlo4(0 TO 256) AS LONG
REM dane elementow planszy
DIM SHARED ceg40(0 TO 640) AS LONG
DIM SHARED ceg17plus17(0 TO 640) AS LONG
DIM SHARED ceg13plus13(0 TO 640) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 640) AS LONG
DIM SHARED spc40(0 TO 640) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED blokp(0 TO 64) AS LONG
DIM SHARED bloks(0 TO 64) AS LONG
DIM SHARED blokk(0 TO 64) AS LONG
DIM SHARED blok2(0 TO 128) AS LONG
DIM SHARED blok4(0 TO 256) 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 ************************* DANE STARTOWE
SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci
x = 100: y = 60: XS = 100: YS = 60: REM wspolrzedne poczatkowe gracza na ekranie
licz = -1: REM wartosc startowa zegara
roomx = 4: roomy = 4: REM plansza startowa
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$ = plansza$(roomx - 1 + (roomy - 1) * 7)
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 28
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 225: PRINT "T:"; t0; "/"; t1;
PRINT " ROOM:"; roomx; "/"; roomy; "--";
REM **************** ustawienie gracza na planszy
GET (x, y)-(x + 15, y + 31), pamiec
PUT (x, y), vertd1, PSET
liczsercaroom = 0
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 1800: NEXT delay
REM ************************ sprawdzenie klawiszy
alt = 0: lshift = 0: pshift = 0: skos = 0
k$ = INKEY$
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 > 301 THEN x = 4: XS = 4: roomx = roomx + 1: GOTO rysuj
IF x + dx < 2 THEN x = 301: XS = 301: roomx = roomx - 1: GOTO rysuj
IF y + dy > 149 THEN y = 4: YS = 4: roomy = roomy + 1: GOTO rysuj
IF y + dy < 2 THEN y = 147: YS = 147: 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: IF POINT(x + 19, y + i) > 200 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF dx < 0 THEN
FOR i = 0 TO 31: IF POINT(x - 3, y + i) > 200 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 ************* otworzenie tego, co bylo za ludzikiem
PUT (XS, YS), pamiec, PSET
REM ******************** czy jest wziatek
deltawx = ABS(x - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek
REM ********************* zapamietanie tego co za ludzikiem
GET (x, y)-(x + 15, y + 31), pamiec
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 PUT (x, y), vertd1, OR: XS = x: YS = y: GOTO PETLA
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 PUT (x, y), znakl1, OR
IF przebieranie = 1 THEN PUT (x, y), znakl2, OR
IF przebieranie = 2 THEN PUT (x, y), znakl3, OR
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 PUT (x, y), znakp1, OR
IF przebieranie = 1 THEN PUT (x, y), znakp2, OR
IF przebieranie = 2 THEN PUT (x, y), znakp3, OR
END IF
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
REM zabranie
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
GET (0, 0)-(319, 7), ceg40
GET (0, 8)-(319, 15), ceg17plus17
GET (0, 16)-(319, 23), ceg13plus13
GET (0, 24)-(319, 31), ceg4plus20plus4
GET (0, 48)-(319, 55), spc40
GET (0, 48)-(15, 63), szaretlo
GET (0, 48)-(31, 63), szaretlo2
GET (0, 48)-(63, 63), szaretlo4
GET (16, 64)-(31, 79), palma
GET (32, 64)-(47, 79), blokp
GET (48, 64)-(63, 79), bloks
GET (64, 64)-(79, 79), blokk
GET (0, 32)-(31, 47), blok2
GET (0, 32)-(63, 47), blok4
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
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)
FOR i = 1 TO 10
OUT 66, 32: OUT 66, 2
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 32: OUT 66, 1
OUT 66, 32: OUT 66, 0
OUT 66, 104: OUT 66, 2
OUT 66, 48: OUT 66, 0
OUT 66, 250: OUT 66, 2
OUT 66, 32: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB palety
REM ****************** Ustawienie wlasnej wartosci barw
REM **************** kolejno, blue green red, kazdy max=6
REM rejestry tla - zaczyna od &H0
PALETTE 0, 10 * 65536 + 10 * 256 + 10: REM tlo sciany
PALETTE 1, 9 * 65536 + 9 * 256 + 9: REM tlo sciany
PALETTE 2, 11 * 65536 + 11 * 256 + 11: REM tlo sciany
PALETTE 3, 63 * 65536 + 31 * 256 + 0: REM blekit za oknem
PALETTE 4, 0 * 65536 + 31 * 256 + 0: REM zielen za oknem
PALETTE 5, 0 * 65536 + 0 * 256 + 63: REM czerwien serca
PALETTE 6, 47 * 65536 + 47 * 256 + 47: REM rama okienna
PALETTE 7, 3 * 65536 + 12 * 256 + 35: REM doniczka
REM rejestry gracza powinny byc kodowane &HnF od 1F
REM ze wzgledu na funkce PUT-OR
PALETTE &H1F, 0 * 65536 + 0 * 256 + 48: REM sweter
PALETTE &H2F, 63 * 65536 + 47 * 256 + 0: REM SPODNIE
PALETTE &H3F, 31 * 65536 + 31 * 256 + 31: REM SREDNIA SZAROSC
PALETTE &H4F, 15 * 65536 + 15 * 256 + 15: REM 1/4 SZAROSCI
PALETTE &H5F, 47 * 65536 + 47 * 256 + 47: REM 3/4 SZAROSCI
PALETTE &H6F, 46 * 65536 + 55 * 256 + 63: REM SKORA
PALETTE &H7F, 0 + 65536 + 0 * 256 + 31: REM pol sweter
PALETTE &H8F, 34 * 65536 + 40 * 256 + 46: REM 3/4 skora
PALETTE &H9F, 47 * 65536 + 38 * 256 + 0: REM 7/8 SPODNI
PALETTE &HAF, 0 * 65536 + 0 * 256 + 40: REM 3/4 swetra
PALETTE &HBF, 23 * 65536 + 23 * 256 + 23: REM 3/8 szarosci
PALETTE &HCF, 43 * 65536 + 43 * 256 + 51: REM 7/8 skora
REM rejestry przeszkod - powinny byc od &HFF wstecz
PALETTE &HFF, 18 * 65536 + 19 * 256 + 33: REM cegly
PALETTE &HFE, 19 * 65536 + 19 * 256 + 19: REM fugi
PALETTE &HFD, 28 * 65536 + 28 * 256 + 28: REM krawedz
FOR i = 0 TO 15
PALETTE 230 + i, i * 4 * 65536 + i * 4 * 256 + i * 4: REM kamien
NEXT i
END SUB
SUB plansze
REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** (roomy-1)*7+(roomx-1)
REM kodowanie _+++++++++++++++++++++++_okna++++_se_kw_se1_se2_nowy11+++++
REM ************ plansze wiersza roomy=1
plansza$(0) = "......................._______YQ_GN_________UI_#LLLQQQLLLU"
plansza$(1) = ".......................____MD__________________#...UUUPPP#"
plansza$(2) = "......................._HE__________ES______UI_#PPPQQQQQQU"
plansza$(3) = ".......................__________SK____BB1_fB1_##LLLQWWWQ#"
plansza$(4) = "......................._______ZK_______________#QPPPQQUQQU"
plansza$(5) = ".......................____MG__________LK5_____#LLLQWWQQQU"
plansza$(6) = "......................._LC__________FQ_________#PPPWQQQQUU"
REM ************ plansze wiersza roomy=2
plansza$(7) = ".......................________________________UQQQWLLLQQ#"
plansza$(8) = "......................._______YQ_RN_________WH_#QQQQ...QQ#"
plansza$(9) = ".......................____MK__________KK1__WJ_UUQQQPPPUQU"
plansza$(10) = "......................._____________MS_________#WLLLWQQQQW"
plansza$(11) = "......................._aI__________________UM_UQPPPQQQQQ#"
plansza$(12) = ".......................__________RN_GS_________UQQQ000QQQ#"
plansza$(13) = ".......................____DJ____aM____________UUUUQQQUUUU"
REM ************* plansze wiersza roomy=3
plansza$(14) = ".......................__________NG_YS_________#QQQWQWQQQW"
plansza$(15) = "......................._MC_YP____UP____________#QQQWLLLLQW"
plansza$(16) = "......................._WQ_____________DI3_`I3_U0000....0#"
plansza$(17) = "......................._MM__________YQ_________WWWWWPPPPUU"
plansza$(18) = "......................._______NP_SM_________WO_#QQQQMWMQQW"
plansza$(19) = ".......................________________EB1__UJ_#00QQLLL0QU"
plansza$(20) = ".......................____aM____UP____________UQQQWPPP0##"
REM ************ plansze wiersza roomy=4
plansza$(21) = ".......................____ZM____SG____________WQQQWLLLLUU"
plansza$(22) = ".......................________________________WPPPWPPPP##"
plansza$(23) = "......................._______NP_UQ_YS_RU3__#F_#0QLLLQQQQW"
plansza$(24) = "......................._YF_YJ_YO_SK_GS_GB5__WM_UUQPPPQQQQU": REM startowa MaX=dU
plansza$(25) = ".......................__________NG____________#QQQQWQQQQU"
plansza$(26) = "......................._______YR_SG____________UUQQQWLLLLU"
plansza$(27) = "......................._____________LS_KK1_____##00UUPPPPU"
REM ****************** plansze wiersza roomy=5
plansza$(28) = "......................._DD____aR_SS_YS_________ULLLWWWLLL#"
plansza$(29) = ".......................________________II4_YI4_#...UUU...#"
plansza$(30) = "......................._______aR_______GL5_YL5_WPPPQUUPPPU"
plansza$(31) = ".......................____ML_______YS______UJ_UUQQQLLLQQ#"
plansza$(32) = ".......................____YL_______________WJ_UQQQQPPP###"
plansza$(33) = ".......................________________KR1_____UU00U000UUU"
plansza$(34) = ".......................____OG____SR_YS_________UU0QQQWQQQ#"
REM ******************* plansze wiersza roomy=6
plansza$(35) = "......................._____________KM_________#00ULLLU0UU"
plansza$(36) = ".......................__________SR____MH2_YH2_###UPPPLLL#"
plansza$(37) = "......................._______GQ_______________U0QQQQW...#"
plansza$(38) = "......................._____________ZS_________#LLLU00PPP#"
plansza$(39) = ".......................__________MM_________0Q_#PPPWLLLQQ#"
plansza$(40) = ".......................________________KO3_YO3_UUUU0PPPUUU"
plansza$(41) = "......................._CC_______ZF_MS_________#QQQWQQQ00U"
REM ******************* plansze wiersza roomy=7
plansza$(42) = "......................._EI__________YM_________UUU0LLL####"
plansza$(43) = ".......................____SJ____ML____________###U...####"
plansza$(44) = "......................._____________KM_________#LLLPPP####"
plansza$(45) = ".......................____PH____ZJ____________#PPP000####"
plansza$(46) = ".......................__________EE____________#LLL0######"
plansza$(47) = "......................._____________GS______0I_UPPPQQQLLL#"
plansza$(48) = "......................._LQ_____________________UUUUUUUPPP#"
REM lokalizacja serc
REM serca wiersza 1
serca(1, 1) = 1
serca(4, 1) = 1
REM serca wiersza 2
serca(2, 2) = 1
serca(6, 2) = 1
serca(7, 2) = 1
REM serca wiersza 3
serca(1, 3) = 1
serca(2, 3) = 1
serca(5, 3) = 1
serca(7, 3) = 1
REM serca wiersza 4
serca(1, 4) = 1
serca(3, 4) = 1
serca(4, 4) = 1
serca(5, 4) = 1
serca(6, 4) = 1
REM serca wiersza 5
serca(1, 5) = 1
serca(7, 5) = 1
REM serca wiersza 6
serca(2, 6) = 1
serca(5, 6) = 1
serca(7, 6) = 1
REM serca wiersza 7
serca(2, 7) = 1
serca(4, 7) = 1
serca(5, 7) = 1
END SUB
SUB rysowanie
FOR yw = 0 TO 10
el$ = MID$(kod$, yw + 48, 1)
y16 = yw * 16
IF el$ = "U" THEN
PUT (128, y16), szaretlo4, PSET
PUT (0, y16), blok4, PSET
PUT (64, y16), blok2, PSET
PUT (96, y16), bloks, PSET
PUT (112, y16), blokk, PSET
PUT (192, y16), blokp, PSET
PUT (208, y16), blok4, PSET
PUT (272, y16), blok2, PSET
PUT (304, y16), bloks, PSET
END IF
IF el$ = "L" THEN
FOR xw = 0 TO 4: PUT (xw * 64, y16), szaretlo4, PSET: NEXT xw
PUT (0, y16), blokk, PSET
END IF
IF el$ = "P" THEN
FOR xw = 0 TO 4: PUT (xw * 64, y16), szaretlo4, PSET: NEXT xw
PUT (304, y16), blokp, PSET
END IF
IF el$ = "." THEN
FOR xw = 0 TO 4: PUT (xw * 64, y16), szaretlo4, PSET: NEXT xw
END IF
IF el$ = "#" THEN
FOR xw = 0 TO 4: PUT (xw * 64, y16), blok4, PSET: NEXT xw
END IF
IF el$ = "0" THEN
PUT (80, y16), szaretlo4, PSET
PUT (144, y16), szaretlo4, PSET
PUT (208, y16), szaretlo2, PSET
PUT (0, y16), blok4, PSET
PUT (64, y16), blokk, PSET
PUT (240, y16), blokp, PSET
PUT (256, y16), blok4, PSET
END IF
IF el$ = "W" THEN
PUT (32, y16), szaretlo4, PSET
PUT (224, y16), szaretlo4, PSET
PUT (0, y16), bloks, PSET
PUT (16, y16), blokk, PSET
PUT (80, y16), blokp, PSET
PUT (96, y16), blok4, PSET
PUT (160, y16), blok4, PSET
PUT (224, y16), blokk, PSET
PUT (288, y16), blokp, PSET
PUT (304, y16), bloks, PSET
END IF
IF el$ = "Q" THEN
FOR xw = 0 TO 3: PUT (xw * 64 + 16, y16), szaretlo4, PSET: NEXT xw
PUT (272, y16), szaretlo2, PSET
PUT (0, y16), blokk, PSET
PUT (304, y16), blokp, PSET
END IF
NEXT yw
REM rysowanie podestow
el$ = MID$(kod$, 45, 1)
IF el$ = "" OR el$ = "_" THEN GOTO okna
el2$ = MID$(kod$, 46, 1)
yokna = (ASC(el2$) - 65) * 8
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
okna:
REM rysowanie okien
el$ = MID$(kod$, 25, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknonz
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 26, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 3, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknonz:
REM okno niebiesko-zielone
el$ = MID$(kod$, 28, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknoziel
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 29, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 11), 3, BF
LINE (xokna + 2, yokna + 12)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknoziel:
REM okno niebiesko-zielone
el$ = MID$(kod$, 31, 1)
IF el$ = "" OR el$ = "_" THEN GOTO serce
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 32, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
serce:
REM serce
xserca = -20
yokna = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 34, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 35, 1)
yokna = (ASC(el$) - 65) * 8
GET (xokna + 8, yokna + 8)-(xokna + 15 + 8, yokna + 7 + 8), tlo
COLOR 5: LOCATE yokna / 8, xokna / 8: PRINT CHR$(3);
xserca = xokna - 8
yserca = yokna - 8
donica:
el$ = MID$(kod$, 37, 1)
IF el$ = "" OR el$ = "_" THEN GOTO koniecrysowania
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 38, 1)
yokna = (ASC(el$) - 65) * 8
PUT (xokna, yokna), palma, 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 3000: NEXT i
OUT 66, 204: OUT 66, 4
FOR i = 1 TO 3000: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB |
|
|
Piotr-246 |
Wysłany: Śro 18:44, 01 Wrz 2021 Temat postu: |
|
DECLARE SUB zabranie ()
REM Gra "Serca"
REM wymaga emulatora o predkosci 3300 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 ()
DIM SHARED pomoc$(0 TO 31)
DIM pamiec(0 TO 128) AS LONG
DIM SHARED plansza$(0 TO 48)
DIM SHARED kod$
DIM SHARED serca(1 TO 7, 1 TO 7) AS INTEGER
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED bitmap$(0 TO 15)
REM pamiec tla pod wziatek
DIM SHARED tlo(0 TO 32) AS LONG
REM tlo
DIM SHARED szaretlo(0 TO 64) AS LONG
DIM SHARED szaretlo2(0 TO 128) AS LONG
DIM SHARED szaretlo4(0 TO 256) AS LONG
REM dane elementow planszy
DIM SHARED ceg40(0 TO 640) AS LONG
DIM SHARED ceg17plus17(0 TO 640) AS LONG
DIM SHARED ceg13plus13(0 TO 640) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 640) AS LONG
DIM SHARED spc40(0 TO 640) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED blokp(0 TO 64) AS LONG
DIM SHARED bloks(0 TO 64) AS LONG
DIM SHARED blokk(0 TO 64) AS LONG
DIM SHARED blok2(0 TO 128) AS LONG
DIM SHARED blok4(0 TO 256) 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 ************************* DANE STARTOWE
SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci
x = 100: y = 60: XS = 100: YS = 60: REM wspolrzedne poczatkowe gracza na ekranie
licz = -1: REM wartosc startowa zegara
roomx = 4: roomy = 4: REM plansza startowa
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$ = plansza$(roomx - 1 + (roomy - 1) * 7)
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 28
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 225: PRINT "T:"; t0; "/"; t1;
PRINT " ROOM:"; roomx; "/"; roomy; "--";
REM **************** ustawienie gracza na planszy
GET (x, y)-(x + 15, y + 31), pamiec
PUT (x, y), vertd1, PSET
liczsercaroom = 0
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 1800: NEXT delay
REM ************************ sprawdzenie klawiszy
alt = 0: lshift = 0: pshift = 0: skos = 0
k$ = INKEY$
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 > 301 THEN x = 4: XS = 4: roomx = roomx + 1: GOTO rysuj
IF x + dx < 2 THEN x = 301: XS = 301: roomx = roomx - 1: GOTO rysuj
IF y + dy > 149 THEN y = 4: YS = 4: roomy = roomy + 1: GOTO rysuj
IF y + dy < 2 THEN y = 147: YS = 147: 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: IF POINT(x + 19, y + i) > 200 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF dx < 0 THEN
FOR i = 0 TO 31: IF POINT(x - 3, y + i) > 200 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 ************* otworzenie tego, co bylo za ludzikiem
PUT (XS, YS), pamiec, PSET
REM ******************** czy jest wziatek
deltawx = ABS(x - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek
REM ********************* zapamietanie tego co za ludzikiem
GET (x, y)-(x + 15, y + 31), pamiec
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 PUT (x, y), vertd1, OR: XS = x: YS = y: GOTO PETLA
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 PUT (x, y), znakl1, OR
IF przebieranie = 1 THEN PUT (x, y), znakl2, OR
IF przebieranie = 2 THEN PUT (x, y), znakl3, OR
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 PUT (x, y), znakp1, OR
IF przebieranie = 1 THEN PUT (x, y), znakp2, OR
IF przebieranie = 2 THEN PUT (x, y), znakp3, OR
END IF
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
REM zabranie
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
GET (0, 0)-(319, 7), ceg40
GET (0, 8)-(319, 15), ceg17plus17
GET (0, 16)-(319, 23), ceg13plus13
GET (0, 24)-(319, 31), ceg4plus20plus4
GET (0, 48)-(319, 55), spc40
GET (0, 48)-(15, 63), szaretlo
GET (0, 48)-(31, 63), szaretlo2
GET (0, 48)-(63, 63), szaretlo4
GET (16, 64)-(31, 79), palma
GET (32, 64)-(47, 79), blokp
GET (48, 64)-(63, 79), bloks
GET (64, 64)-(79, 79), blokk
GET (0, 32)-(31, 47), blok2
GET (0, 32)-(63, 47), blok4
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
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)
FOR i = 1 TO 10
OUT 66, 32: OUT 66, 2
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 32: OUT 66, 1
OUT 66, 32: OUT 66, 0
OUT 66, 104: OUT 66, 2
OUT 66, 48: OUT 66, 0
OUT 66, 250: OUT 66, 2
OUT 66, 32: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB palety
REM ****************** Ustawienie wlasnej wartosci barw
REM **************** kolejno, blue green red, kazdy max=6
REM rejestry tla - zaczyna od &H0
PALETTE 0, 10 * 65536 + 10 * 256 + 10: REM tlo sciany
PALETTE 1, 9 * 65536 + 9 * 256 + 9: REM tlo sciany
PALETTE 2, 11 * 65536 + 11 * 256 + 11: REM tlo sciany
PALETTE 3, 63 * 65536 + 31 * 256 + 0: REM blekit za oknem
PALETTE 4, 0 * 65536 + 31 * 256 + 0: REM zielen za oknem
PALETTE 5, 0 * 65536 + 0 * 256 + 63: REM czerwien serca
PALETTE 6, 47 * 65536 + 47 * 256 + 47: REM rama okienna
PALETTE 7, 3 * 65536 + 12 * 256 + 35: REM doniczka
REM rejestry gracza powinny byc kodowane &HnF od 1F
REM ze wzgledu na funkce PUT-OR
PALETTE &H1F, 0 * 65536 + 0 * 256 + 48: REM sweter
PALETTE &H2F, 63 * 65536 + 47 * 256 + 0: REM SPODNIE
PALETTE &H3F, 31 * 65536 + 31 * 256 + 31: REM SREDNIA SZAROSC
PALETTE &H4F, 15 * 65536 + 15 * 256 + 15: REM 1/4 SZAROSCI
PALETTE &H5F, 47 * 65536 + 47 * 256 + 47: REM 3/4 SZAROSCI
PALETTE &H6F, 46 * 65536 + 55 * 256 + 63: REM SKORA
PALETTE &H7F, 0 + 65536 + 0 * 256 + 31: REM pol sweter
PALETTE &H8F, 34 * 65536 + 40 * 256 + 46: REM 3/4 skora
PALETTE &H9F, 47 * 65536 + 38 * 256 + 0: REM 7/8 SPODNI
PALETTE &HAF, 0 * 65536 + 0 * 256 + 40: REM 3/4 swetra
PALETTE &HBF, 23 * 65536 + 23 * 256 + 23: REM 3/8 szarosci
PALETTE &HCF, 43 * 65536 + 43 * 256 + 51: REM 7/8 skora
REM rejestry przeszkod - powinny byc od &HFF wstecz
PALETTE &HFF, 18 * 65536 + 19 * 256 + 33: REM cegly
PALETTE &HFE, 19 * 65536 + 19 * 256 + 19: REM fugi
PALETTE &HFD, 28 * 65536 + 28 * 256 + 28: REM krawedz
FOR i = 0 TO 15
PALETTE 230 + i, i * 4 * 65536 + i * 4 * 256 + i * 4: REM kamien
NEXT i
END SUB
SUB plansze
REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** (roomy-1)*7+(roomx-1)
REM kodowanie _+++++++++++++++++++++++_okna++++_se_kw_se1_se2_nowy11+++++
REM ************ plansze wiersza roomy=1
plansza$(0) = "......................._______YQ_GN_________UI_#LLLQQQLLLU"
plansza$(1) = ".......................____MD__________________#...UUUPPP#"
plansza$(2) = "......................._HE__________ES______UI_#PPPQQQQQQU"
plansza$(3) = ".......................__________SK____BB1_fB1_##LLLQWWWQ#"
plansza$(4) = "......................._______ZK_______________#QPPPQQUQQU"
plansza$(5) = ".......................____MG__________LK5_____#LLLQWWQQQU"
plansza$(6) = "......................._LC__________FQ_________#PPPWQQQQUU"
REM ************ plansze wiersza roomy=2
plansza$(7) = ".......................________________________UQQQWLLLQQ#"
plansza$(8) = "......................._______YQ_RN_________WH_#QQQQ...QQ#"
plansza$(9) = ".......................____MK__________KK1__WJ_UUQQQPPPUQU"
plansza$(10) = "......................._____________MS_________#WLLLWQQQQW"
plansza$(11) = "......................._aI__________________UM_UQPPPQQQQQ#"
plansza$(12) = ".......................__________RN_GS_________UQQQ000QQQ#"
plansza$(13) = ".......................____DJ____aM____________UUUUQQQUUUU"
REM ************* plansze wiersza roomy=3
plansza$(14) = ".......................__________NG_YS_________#QQQWQWQQQW"
plansza$(15) = "......................._MC_YP____UP____________#QQQWLLLLQW"
plansza$(16) = "......................._WQ_____________DI3_`I3_U0000....0#"
plansza$(17) = "......................._MM__________YQ_________WWWWWPPPPUU"
plansza$(18) = "......................._______NP_SM_________WO_#QQQQMWMQQW"
plansza$(19) = ".......................________________EB1__UJ_#00QQLLL0QU"
plansza$(20) = ".......................____aM____UP____________UQQQWPPP0##"
REM ************ plansze wiersza roomy=4
plansza$(21) = ".......................____ZM____SG____________WQQQWLLLLUU"
plansza$(22) = ".......................________________________WPPPWPPPP##"
plansza$(23) = "......................._______NP_UQ_YS_RU3__#F_#0QLLLQQQQW"
plansza$(24) = "......................._YF_YJ_YO_SK_GS_GB5__WM_UUQPPPQQQQU": REM startowa MaX=dU
plansza$(25) = ".......................__________NG____________#QQQQWQQQQU"
plansza$(26) = "......................._______YR_SG____________UUQQQWLLLLU"
plansza$(27) = "......................._____________LS_KK1_____##00UUPPPPU"
REM ****************** plansze wiersza roomy=5
plansza$(28) = "......................._DD____aR_SS_YS_________ULLLWWWLLL#"
plansza$(29) = ".......................________________II4_YI4_#...UUU...#"
plansza$(30) = "......................._______aR_______GL5_YL5_WPPPQUUPPPU"
plansza$(31) = ".......................____ML_______YS______UJ_UUQQQLLLQQ#"
plansza$(32) = ".......................____YL_______________WJ_UQQQQPPP###"
plansza$(33) = ".......................________________KR1_____UU00U000UUU"
plansza$(34) = ".......................____OG____SR_YS_________UU0QQQWQQQ#"
REM ******************* plansze wiersza roomy=6
plansza$(35) = "......................._____________KM_________#00ULLLU0UU"
plansza$(36) = ".......................__________SR____MH2_YH2_###UPPPLLL#"
plansza$(37) = "......................._______GQ_______________U0QQQQW...#"
plansza$(38) = "......................._____________ZS_________#LLLU00PPP#"
plansza$(39) = ".......................__________MM_________0Q_#PPPWLLLQQ#"
plansza$(40) = ".......................________________KO3_YO3_UUUU0PPPUUU"
plansza$(41) = "......................._CC_______ZF_MS_________#QQQWQQQ00U"
REM ******************* plansze wiersza roomy=7
plansza$(42) = "......................._EI__________YM_________UUU0LLL####"
plansza$(43) = ".......................____SJ____ML____________###U...####"
plansza$(44) = "......................._____________KM_________#LLLPPP####"
plansza$(45) = ".......................____PH____ZJ____________#PPP000####"
plansza$(46) = ".......................__________EE____________#LLL0######"
plansza$(47) = "......................._____________GS______0I_UPPPQQQLLL#"
plansza$(48) = "......................._LQ_____________________UUUUUUUPPP#"
REM lokalizacja serc
REM serca wiersza 1
serca(1, 1) = 1
serca(4, 1) = 1
REM serca wiersza 2
serca(2, 2) = 1
serca(6, 2) = 1
serca(7, 2) = 1
REM serca wiersza 3
serca(1, 3) = 1
serca(2, 3) = 1
serca(5, 3) = 1
serca(7, 3) = 1
REM serca wiersza 4
serca(1, 4) = 1
serca(3, 4) = 1
serca(4, 4) = 1
serca(5, 4) = 1
serca(6, 4) = 1
REM serca wiersza 5
serca(1, 5) = 1
serca(7, 5) = 1
REM serca wiersza 6
serca(2, 6) = 1
serca(5, 6) = 1
serca(7, 6) = 1
REM serca wiersza 7
serca(2, 7) = 1
serca(4, 7) = 1
serca(5, 7) = 1
END SUB
SUB rysowanie
REM rysowanie tla
FOR yw = 0 TO 10
el$ = MID$(kod$, yw + 48, 1)
y16 = yw * 16
IF el$ = "U" THEN PUT (128, y16), szaretlo4, PSET
IF el$ = "0" THEN
PUT (80, y16), szaretlo4, PSET
PUT (144, y16), szaretlo4, PSET
PUT (208, y16), szaretlo2, PSET
END IF
IF el$ = "W" THEN
PUT (32, y16), szaretlo4, PSET
PUT (224, y16), szaretlo4, PSET
END IF
IF el$ = "Q" THEN
FOR xw = 0 TO 3: PUT (xw * 64 + 16, y16), szaretlo4, PSET: NEXT xw
PUT (272, y16), szaretlo2, PSET
END IF
IF el$ = "L" THEN
FOR xw = 0 TO 4: PUT (xw * 64, y16), szaretlo4, PSET: NEXT xw
END IF
IF el$ = "P" THEN
FOR xw = 0 TO 4: PUT (xw * 64, y16), szaretlo4, PSET: NEXT xw
END IF
IF el$ = "." THEN
FOR xw = 0 TO 4: PUT (xw * 64, y16), szaretlo4, PSET: NEXT xw
END IF
bloki:
REM rysowanie blokow
IF el$ = "#" THEN
FOR xw = 0 TO 4: PUT (xw * 64, y16), blok4, PSET: NEXT xw
END IF
IF el$ = "U" THEN
PUT (0, y16), blok4, PSET
PUT (64, y16), blok2, PSET
PUT (96, y16), bloks, PSET
PUT (112, y16), blokk, PSET
PUT (192, y16), blokp, PSET
PUT (208, y16), blok4, PSET
PUT (272, y16), blok2, PSET
PUT (304, y16), bloks, PSET
END IF
IF el$ = "0" THEN
REM FOR xw = 0 TO 1:
PUT (0, y16), blok4, PSET
REM NEXT xw
PUT (64, y16), blokk, PSET
PUT (240, y16), blokp, PSET
REM FOR xw = 0 TO 1
PUT (256, y16), blok4, PSET
REM NEXT xw
END IF
IF el$ = "W" THEN
PUT (0, y16), bloks, PSET
PUT (16, y16), blokk, PSET
PUT (80, y16), blokp, PSET
REM FOR xw = 0 TO 3:
PUT (96, y16), blok4, PSET
PUT (160, y16), blok4, PSET
REM : NEXT xw
PUT (224, y16), blokk, PSET
PUT (288, y16), blokp, PSET
PUT (304, y16), bloks, PSET
END IF
IF el$ = "Q" THEN PUT (0, y16), blokk, PSET: PUT (304, y16), blokp, PSET
IF el$ = "L" THEN PUT (0, y16), blokk, PSET
IF el$ = "P" THEN PUT (304, y16), blokp, PSET
NEXT yw
REM rysowanie podestow
el$ = MID$(kod$, 45, 1)
IF el$ = "" OR el$ = "_" THEN GOTO okna
el2$ = MID$(kod$, 46, 1)
yokna = (ASC(el2$) - 65) * 8
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
okna:
REM rysowanie okien
el$ = MID$(kod$, 25, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknonz
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 26, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 3, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknonz:
REM okno niebiesko-zielone
el$ = MID$(kod$, 28, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknoziel
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 29, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 11), 3, BF
LINE (xokna + 2, yokna + 12)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknoziel:
REM okno niebiesko-zielone
el$ = MID$(kod$, 31, 1)
IF el$ = "" OR el$ = "_" THEN GOTO serce
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 32, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
serce:
REM serce
xserca = -20
yokna = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 34, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 35, 1)
yokna = (ASC(el$) - 65) * 8
GET (xokna + 8, yokna + 8)-(xokna + 15 + 8, yokna + 7 + 8), tlo
COLOR 5: LOCATE yokna / 8, xokna / 8: PRINT CHR$(3);
xserca = xokna - 8
yserca = yokna - 8
donica:
el$ = MID$(kod$, 37, 1)
IF el$ = "" OR el$ = "_" THEN GOTO koniecrysowania
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 38, 1)
yokna = (ASC(el$) - 65) * 8
PUT (xokna, yokna), palma, 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 3000: NEXT i
OUT 66, 204: OUT 66, 4
FOR i = 1 TO 3000: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB |
|
|
Piotr-246 |
Wysłany: Śro 18:01, 01 Wrz 2021 Temat postu: |
|
DECLARE SUB zabranie ()
REM Gra "Serca"
REM wymaga emulatora o predkosci 3300 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 ()
DIM SHARED pomoc$(0 TO 31)
DIM pamiec(0 TO 128) AS LONG
DIM SHARED plansza$(0 TO 48)
DIM SHARED kod$
DIM SHARED serca(1 TO 7, 1 TO 7) AS INTEGER
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED bitmap$(0 TO 15)
REM pamiec tla pod wziatek
DIM SHARED tlo(0 TO 32) AS LONG
REM tlo
DIM SHARED szaretlo(0 TO 64) AS LONG
DIM SHARED szaretlo2(0 TO 128) AS LONG
REM dane elementow planszy
DIM SHARED ceg40(0 TO 640) AS LONG
DIM SHARED ceg17plus17(0 TO 640) AS LONG
DIM SHARED ceg13plus13(0 TO 640) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 640) AS LONG
DIM SHARED spc40(0 TO 640) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED blokp(0 TO 64) AS LONG
DIM SHARED bloks(0 TO 64) AS LONG
DIM SHARED blokk(0 TO 64) AS LONG
DIM SHARED blok2(0 TO 128) 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 ************************* DANE STARTOWE
SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci
x = 100: y = 60: XS = 100: YS = 60: REM wspolrzedne poczatkowe gracza na ekranie
licz = -1: REM wartosc startowa zegara
roomx = 4: roomy = 4: REM plansza startowa
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$ = plansza$(roomx - 1 + (roomy - 1) * 7)
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 28
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 225: PRINT "T:"; t0; "/"; t1;
PRINT " ROOM:"; roomx; "/"; roomy; "--";
REM **************** ustawienie gracza na planszy
GET (x, y)-(x + 15, y + 31), pamiec
PUT (x, y), vertd1, PSET
liczsercaroom = 0
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 1800: NEXT delay
REM ************************ sprawdzenie klawiszy
alt = 0: lshift = 0: pshift = 0: skos = 0
k$ = INKEY$
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 > 301 THEN x = 4: XS = 4: roomx = roomx + 1: GOTO rysuj
IF x + dx < 2 THEN x = 301: XS = 301: roomx = roomx - 1: GOTO rysuj
IF y + dy > 149 THEN y = 4: YS = 4: roomy = roomy + 1: GOTO rysuj
IF y + dy < 2 THEN y = 147: YS = 147: 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: IF POINT(x + 19, y + i) > 200 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF dx < 0 THEN
FOR i = 0 TO 31: IF POINT(x - 3, y + i) > 200 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 ************* otworzenie tego, co bylo za ludzikiem
PUT (XS, YS), pamiec, PSET
REM ******************** czy jest wziatek
deltawx = ABS(x - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek
REM ********************* zapamietanie tego co za ludzikiem
GET (x, y)-(x + 15, y + 31), pamiec
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 PUT (x, y), vertd1, OR: XS = x: YS = y: GOTO PETLA
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 PUT (x, y), znakl1, OR
IF przebieranie = 1 THEN PUT (x, y), znakl2, OR
IF przebieranie = 2 THEN PUT (x, y), znakl3, OR
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 PUT (x, y), znakp1, OR
IF przebieranie = 1 THEN PUT (x, y), znakp2, OR
IF przebieranie = 2 THEN PUT (x, y), znakp3, OR
END IF
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
REM zabranie
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
GET (0, 0)-(319, 7), ceg40
GET (0, 8)-(319, 15), ceg17plus17
GET (0, 16)-(319, 23), ceg13plus13
GET (0, 24)-(319, 31), ceg4plus20plus4
GET (0, 48)-(319, 55), spc40
GET (0, 48)-(15, 63), szaretlo
GET (0, 48)-(31, 63), szaretlo2
GET (16, 64)-(31, 79), palma
GET (32, 64)-(47, 79), blokp
GET (48, 64)-(63, 79), bloks
GET (64, 64)-(79, 79), blokk
GET (0, 32)-(31, 47), blok2
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
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)
FOR i = 1 TO 10
OUT 66, 32: OUT 66, 2
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 32: OUT 66, 1
OUT 66, 32: OUT 66, 0
OUT 66, 104: OUT 66, 2
OUT 66, 48: OUT 66, 0
OUT 66, 250: OUT 66, 2
OUT 66, 32: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB palety
REM ****************** Ustawienie wlasnej wartosci barw
REM **************** kolejno, blue green red, kazdy max=6
REM rejestry tla - zaczyna od &H0
PALETTE 0, 10 * 65536 + 10 * 256 + 10: REM tlo sciany
PALETTE 1, 9 * 65536 + 9 * 256 + 9: REM tlo sciany
PALETTE 2, 11 * 65536 + 11 * 256 + 11: REM tlo sciany
PALETTE 3, 63 * 65536 + 31 * 256 + 0: REM blekit za oknem
PALETTE 4, 0 * 65536 + 31 * 256 + 0: REM zielen za oknem
PALETTE 5, 0 * 65536 + 0 * 256 + 63: REM czerwien serca
PALETTE 6, 47 * 65536 + 47 * 256 + 47: REM rama okienna
PALETTE 7, 3 * 65536 + 12 * 256 + 35: REM doniczka
REM rejestry gracza powinny byc kodowane &HnF od 1F
REM ze wzgledu na funkce PUT-OR
PALETTE &H1F, 0 * 65536 + 0 * 256 + 48: REM sweter
PALETTE &H2F, 63 * 65536 + 47 * 256 + 0: REM SPODNIE
PALETTE &H3F, 31 * 65536 + 31 * 256 + 31: REM SREDNIA SZAROSC
PALETTE &H4F, 15 * 65536 + 15 * 256 + 15: REM 1/4 SZAROSCI
PALETTE &H5F, 47 * 65536 + 47 * 256 + 47: REM 3/4 SZAROSCI
PALETTE &H6F, 46 * 65536 + 55 * 256 + 63: REM SKORA
PALETTE &H7F, 0 + 65536 + 0 * 256 + 31: REM pol sweter
PALETTE &H8F, 34 * 65536 + 40 * 256 + 46: REM 3/4 skora
PALETTE &H9F, 47 * 65536 + 38 * 256 + 0: REM 7/8 SPODNI
PALETTE &HAF, 0 * 65536 + 0 * 256 + 40: REM 3/4 swetra
PALETTE &HBF, 23 * 65536 + 23 * 256 + 23: REM 3/8 szarosci
PALETTE &HCF, 43 * 65536 + 43 * 256 + 51: REM 7/8 skora
REM rejestry przeszkod - powinny byc od &HFF wstecz
PALETTE &HFF, 18 * 65536 + 19 * 256 + 33: REM cegly
PALETTE &HFE, 19 * 65536 + 19 * 256 + 19: REM fugi
PALETTE &HFD, 28 * 65536 + 28 * 256 + 28: REM krawedz
FOR i = 0 TO 15
PALETTE 230 + i, i * 4 * 65536 + i * 4 * 256 + i * 4: REM kamien
NEXT i
END SUB
SUB plansze
REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** (roomy-1)*7+(roomx-1)
REM kodowanie _+++++++++++++++++++++++_okna++++_se_kw_se1_se2_nowy11+++++
REM ************ plansze wiersza roomy=1
plansza$(0) = "......................._______YQ_GN_________UI_#LLLQQQLLLU"
plansza$(1) = ".......................____MD__________________#...UUUPPP#"
plansza$(2) = "......................._HE__________ES______UI_#PPPQQQQQQU"
plansza$(3) = ".......................__________SK____BB1_fB1_##LLLQWWWQ#"
plansza$(4) = "......................._______ZK_______________#QPPPQQUQQU"
plansza$(5) = ".......................____MG__________LK5_____#LLLQWWQQQU"
plansza$(6) = "......................._LC__________FQ_________#PPPWQQQQUU"
REM ************ plansze wiersza roomy=2
plansza$(7) = ".......................________________________UQQQWLLLQQ#"
plansza$(8) = "......................._______YQ_RN_________WH_#QQQQ...QQ#"
plansza$(9) = ".......................____MK__________KK1__WJ_UUQQQPPPUQU"
plansza$(10) = "......................._____________MS_________#WLLLWQQQQW"
plansza$(11) = "......................._aI__________________UM_UQPPPQQQQQ#"
plansza$(12) = ".......................__________RN_GS_________UQQQ000QQQ#"
plansza$(13) = ".......................____DJ____aM____________UUUUQQQUUUU"
REM ************* plansze wiersza roomy=3
plansza$(14) = ".......................__________NG_YS_________#QQQWQWQQQW"
plansza$(15) = "......................._MC_YP____UP____________#QQQWLLLLQW"
plansza$(16) = "......................._WQ_____________DI3_`I3_U0000....0#"
plansza$(17) = "......................._MM__________YQ_________WWWWWPPPPUU"
plansza$(18) = "......................._______NP_SM_________WO_#QQQQMWMQQW"
plansza$(19) = ".......................________________EB1__UJ_#00QQLLL0QU"
plansza$(20) = ".......................____aM____UP____________UQQQWPPP0##"
REM ************ plansze wiersza roomy=4
plansza$(21) = ".......................____ZM____SG____________WQQQWLLLLUU"
plansza$(22) = ".......................________________________WPPPWPPPP##"
plansza$(23) = "......................._______NP_UQ_YS_RU3__#F_#0QLLLQQQQW"
plansza$(24) = "......................._YF_YJ_YO_SK_GS_GB5__WM_UUQPPPQQQQU": REM startowa MaX=dU
plansza$(25) = ".......................__________NG____________#QQQQWQQQQU"
plansza$(26) = "......................._______YR_SG____________UUQQQWLLLLU"
plansza$(27) = "......................._____________LS_KK1_____##00UUPPPPU"
REM ****************** plansze wiersza roomy=5
plansza$(28) = "......................._DD____aR_SS_YS_________ULLLWWWLLL#"
plansza$(29) = ".......................________________II4_YI4_#...UUU...#"
plansza$(30) = "......................._______aR_______GL5_YL5_WPPPQUUPPPU"
plansza$(31) = ".......................____ML_______YS______UJ_UUQQQLLLQQ#"
plansza$(32) = ".......................____YL_______________WJ_UQQQQPPP###"
plansza$(33) = ".......................________________KR1_____UU00U000UUU"
plansza$(34) = ".......................____OG____SR_YS_________UU0QQQWQQQ#"
REM ******************* plansze wiersza roomy=6
plansza$(35) = "......................._____________KM_________#00ULLLU0UU"
plansza$(36) = ".......................__________SR____MH2_YH2_###UPPPLLL#"
plansza$(37) = "......................._______GQ_______________U0QQQQW...#"
plansza$(38) = "......................._____________ZS_________#LLLU00PPP#"
plansza$(39) = ".......................__________MM_________0Q_#PPPWLLLQQ#"
plansza$(40) = ".......................________________KO3_YO3_UUUU0PPPUUU"
plansza$(41) = "......................._CC_______ZF_MS_________#QQQWQQQ00U"
REM ******************* plansze wiersza roomy=7
plansza$(42) = "......................._EI__________YM_________UUU0LLL####"
plansza$(43) = ".......................____SJ____ML____________###U...####"
plansza$(44) = "......................._____________KM_________#LLLPPP####"
plansza$(45) = ".......................____PH____ZJ____________#PPP000####"
plansza$(46) = ".......................__________EE____________#LLL0######"
plansza$(47) = "......................._____________GS______0I_UPPPQQQLLL#"
plansza$(48) = "......................._LQ_____________________UUUUUUUPPP#"
REM lokalizacja serc
REM serca wiersza 1
serca(1, 1) = 1
serca(4, 1) = 1
REM serca wiersza 2
serca(2, 2) = 1
serca(6, 2) = 1
serca(7, 2) = 1
REM serca wiersza 3
serca(1, 3) = 1
serca(2, 3) = 1
serca(5, 3) = 1
serca(7, 3) = 1
REM serca wiersza 4
serca(1, 4) = 1
serca(3, 4) = 1
serca(4, 4) = 1
serca(5, 4) = 1
serca(6, 4) = 1
REM serca wiersza 5
serca(1, 5) = 1
serca(7, 5) = 1
REM serca wiersza 6
serca(2, 6) = 1
serca(5, 6) = 1
serca(7, 6) = 1
REM serca wiersza 7
serca(2, 7) = 1
serca(4, 7) = 1
serca(5, 7) = 1
END SUB
SUB rysowanie
REM rysowanie tla
FOR yw = 0 TO 10
el$ = MID$(kod$, yw + 48, 1)
y16 = yw * 16
IF el$ = "U" THEN
FOR xw = 0 TO 1: PUT (xw * 32 + 128, y16), szaretlo2, PSET: NEXT xw
END IF
IF el$ = "0" THEN
FOR xw = 0 TO 5: PUT (xw * 32 + 64, y16), szaretlo2, PSET: NEXT xw
END IF
IF el$ = "W" THEN
FOR xw = 0 TO 1: PUT (xw * 32 + 32, y16), szaretlo2, PSET: NEXT xw
FOR xw = 0 TO 1: PUT (xw * 32 + 224, y16), szaretlo2, PSET: NEXT xw
END IF
IF el$ = "Q" THEN
FOR xw = 0 TO 8: PUT (xw * 32 + 16, y16), szaretlo2, PSET: NEXT xw
END IF
IF el$ = "L" THEN
FOR xw = 0 TO 9: PUT (xw * 32, y16), szaretlo2, PSET: NEXT xw
END IF
IF el$ = "P" THEN
FOR xw = 0 TO 9: PUT (xw * 32, y16), szaretlo2, PSET: NEXT xw
END IF
IF el$ = "." THEN
FOR xw = 0 TO 9: PUT (xw * 32, y16), szaretlo2, PSET: NEXT xw
END IF
bloki:
REM rysowanie blokow
REM el$ = MID$(kod$, yw + 48, 1)
REM y16 = yw * 16
IF el$ = "#" THEN
FOR xw = 0 TO 9: PUT (xw * 32, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "U" THEN
FOR xw = 0 TO 2: PUT (xw * 32, y16), blok2, PSET: NEXT xw
PUT (3 * 32, y16), bloks, PSET
PUT (112, y16), blokk, PSET
PUT (192, y16), blokp, PSET
FOR xw = 0 TO 2: PUT (208 + xw * 32, y16), blok2, PSET: NEXT xw
PUT (208 + 3 * 32, y16), bloks, PSET
END IF
IF el$ = "0" THEN
FOR xw = 0 TO 1: PUT (xw * 32, y16), blok2, PSET: NEXT xw
PUT (64, y16), blokk, PSET
PUT (240, y16), blokp, PSET
FOR xw = 0 TO 1: PUT (256 + xw * 32, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "W" THEN
PUT (0, y16), bloks, PSET
PUT (16, y16), blokk, PSET
PUT (80, y16), blokp, PSET
FOR xw = 0 TO 3: PUT (xw * 32 + 96, y16), blok2, PSET: NEXT xw
PUT (224, y16), blokk, PSET
PUT (288, y16), blokp, PSET
PUT (304, y16), bloks, PSET
END IF
IF el$ = "Q" THEN PUT (0, y16), blokk, PSET: PUT (304, y16), blokp, PSET
IF el$ = "L" THEN PUT (0, y16), blokk, PSET
IF el$ = "P" THEN PUT (304, y16), blokp, PSET
NEXT yw
REM rysowanie podestow
el$ = MID$(kod$, 45, 1)
IF el$ = "" OR el$ = "_" THEN GOTO okna
el2$ = MID$(kod$, 46, 1)
yokna = (ASC(el2$) - 65) * 8
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
okna:
REM rysowanie okien
el$ = MID$(kod$, 25, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknonz
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 26, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 3, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknonz:
REM okno niebiesko-zielone
el$ = MID$(kod$, 28, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknoziel
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 29, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 11), 3, BF
LINE (xokna + 2, yokna + 12)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknoziel:
REM okno niebiesko-zielone
el$ = MID$(kod$, 31, 1)
IF el$ = "" OR el$ = "_" THEN GOTO serce
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 32, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
serce:
REM serce
xserca = -20
yokna = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 34, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 35, 1)
yokna = (ASC(el$) - 65) * 8
GET (xokna + 8, yokna + 8)-(xokna + 15 + 8, yokna + 7 + 8), tlo
COLOR 5: LOCATE yokna / 8, xokna / 8: PRINT CHR$(3);
xserca = xokna - 8
yserca = yokna - 8
donica:
el$ = MID$(kod$, 37, 1)
IF el$ = "" OR el$ = "_" THEN GOTO koniecrysowania
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 38, 1)
yokna = (ASC(el$) - 65) * 8
PUT (xokna, yokna), palma, 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 3000: NEXT i
OUT 66, 204: OUT 66, 4
FOR i = 1 TO 3000: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB |
|
|
Piotr-246 |
Wysłany: Śro 12:25, 01 Wrz 2021 Temat postu: |
|
DECLARE SUB zabranie ()
REM Gra "Serca"
REM wymaga emulatora o predkosci 3300 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 ()
DIM SHARED pomoc$(0 TO 31)
DIM pamiec(0 TO 128) AS LONG
DIM SHARED plansza$(0 TO 48)
DIM SHARED kod$
DIM SHARED serca(1 TO 7, 1 TO 7) AS INTEGER
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED bitmap$(0 TO 15)
REM pamiec tla pod wziatek
DIM SHARED tlo(0 TO 32) AS LONG
DIM SHARED szaretlo(0 TO 64) AS LONG
REM dane elementow planszy
DIM SHARED ceg40(0 TO 640) AS LONG
DIM SHARED ceg17plus17(0 TO 640) AS LONG
DIM SHARED ceg13plus13(0 TO 640) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 640) AS LONG
DIM SHARED spc40(0 TO 640) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED blok1(0 TO 64) AS LONG
DIM SHARED blok2(0 TO 64) AS LONG
DIM SHARED blok3(0 TO 64) 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 ************************* DANE STARTOWE
SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci
x = 100: y = 60: XS = 100: YS = 60: REM wspolrzedne poczatkowe gracza na ekranie
licz = -1: REM wartosc startowa zegara
roomx = 4: roomy = 4: REM plansza startowa
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$ = plansza$(roomx - 1 + (roomy - 1) * 7)
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 28
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 225: PRINT "T:"; t0; "/"; t1;
PRINT " ROOM:"; roomx; "/"; roomy; "--";
REM **************** ustawienie gracza na planszy
GET (x, y)-(x + 15, y + 31), pamiec
PUT (x, y), vertd1, PSET
liczsercaroom = 0
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 1800: NEXT delay
REM ************************ sprawdzenie klawiszy
alt = 0: lshift = 0: pshift = 0: skos = 0
k$ = INKEY$
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 > 301 THEN x = 4: XS = 4: roomx = roomx + 1: GOTO rysuj
IF x + dx < 2 THEN x = 301: XS = 301: roomx = roomx - 1: GOTO rysuj
IF y + dy > 149 THEN y = 4: YS = 4: roomy = roomy + 1: GOTO rysuj
IF y + dy < 2 THEN y = 147: YS = 147: 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: IF POINT(x + 19, y + i) > 200 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF dx < 0 THEN
FOR i = 0 TO 31: IF POINT(x - 3, y + i) > 200 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 ************* otworzenie tego, co bylo za ludzikiem
PUT (XS, YS), pamiec, PSET
REM ******************** czy jest wziatek
deltawx = ABS(x - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek
REM ********************* zapamietanie tego co za ludzikiem
GET (x, y)-(x + 15, y + 31), pamiec
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 PUT (x, y), vertd1, OR: XS = x: YS = y: GOTO PETLA
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 PUT (x, y), znakl1, OR
IF przebieranie = 1 THEN PUT (x, y), znakl2, OR
IF przebieranie = 2 THEN PUT (x, y), znakl3, OR
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 PUT (x, y), znakp1, OR
IF przebieranie = 1 THEN PUT (x, y), znakp2, OR
IF przebieranie = 2 THEN PUT (x, y), znakp3, OR
END IF
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
REM zabranie
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
GET (0, 0)-(319, 7), ceg40
GET (0, 8)-(319, 15), ceg17plus17
GET (0, 16)-(319, 23), ceg13plus13
GET (0, 24)-(319, 31), ceg4plus20plus4
GET (0, 48)-(319, 55), spc40
GET (48, 48)-(63, 63), szaretlo
GET (16, 64)-(31, 79), palma
GET (32, 64)-(47, 79), blok1
GET (48, 64)-(63, 79), blok2
GET (64, 64)-(79, 79), blok3
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
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)
FOR i = 1 TO 10
OUT 66, 32: OUT 66, 2
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 32: OUT 66, 1
OUT 66, 32: OUT 66, 0
OUT 66, 104: OUT 66, 2
OUT 66, 48: OUT 66, 0
OUT 66, 250: OUT 66, 2
OUT 66, 32: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB palety
REM ****************** Ustawienie wlasnej wartosci barw
REM **************** kolejno, blue green red, kazdy max=6
REM rejestry tla - zaczyna od &H0
PALETTE 0, 10 * 65536 + 10 * 256 + 10: REM tlo sciany
PALETTE 1, 9 * 65536 + 9 * 256 + 9: REM tlo sciany
PALETTE 2, 11 * 65536 + 11 * 256 + 11: REM tlo sciany
PALETTE 3, 63 * 65536 + 31 * 256 + 0: REM blekit za oknem
PALETTE 4, 0 * 65536 + 31 * 256 + 0: REM zielen za oknem
PALETTE 5, 0 * 65536 + 0 * 256 + 63: REM czerwien serca
PALETTE 6, 47 * 65536 + 47 * 256 + 47: REM rama okienna
PALETTE 7, 3 * 65536 + 12 * 256 + 35: REM doniczka
REM rejestry gracza powinny byc kodowane &HnF od 1F
REM ze wzgledu na funkce PUT-OR
PALETTE &H1F, 0 * 65536 + 0 * 256 + 48: REM sweter
PALETTE &H2F, 63 * 65536 + 47 * 256 + 0: REM SPODNIE
PALETTE &H3F, 31 * 65536 + 31 * 256 + 31: REM SREDNIA SZAROSC
PALETTE &H4F, 15 * 65536 + 15 * 256 + 15: REM 1/4 SZAROSCI
PALETTE &H5F, 47 * 65536 + 47 * 256 + 47: REM 3/4 SZAROSCI
PALETTE &H6F, 46 * 65536 + 55 * 256 + 63: REM SKORA
PALETTE &H7F, 0 + 65536 + 0 * 256 + 31: REM pol sweter
PALETTE &H8F, 34 * 65536 + 40 * 256 + 46: REM 3/4 skora
PALETTE &H9F, 47 * 65536 + 38 * 256 + 0: REM 7/8 SPODNI
PALETTE &HAF, 0 * 65536 + 0 * 256 + 40: REM 3/4 swetra
PALETTE &HBF, 23 * 65536 + 23 * 256 + 23: REM 3/8 szarosci
PALETTE &HCF, 43 * 65536 + 43 * 256 + 51: REM 7/8 skora
REM rejestry przeszkod - powinny byc od &HFF wstecz
PALETTE &HFF, 18 * 65536 + 19 * 256 + 33: REM cegly
PALETTE &HFE, 19 * 65536 + 19 * 256 + 19: REM fugi
PALETTE &HFD, 28 * 65536 + 28 * 256 + 28: REM krawedz
FOR i = 0 TO 15
PALETTE 230 + i, i * 4 * 65536 + i * 4 * 256 + i * 4: REM kamien
NEXT i
END SUB
SUB plansze
REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** (roomy-1)*7+(roomx-1)
REM kodowanie _+++++++++++++++++++++++_okna++++_se_kw_se1_se2_nowy11+++++
REM ************ plansze wiersza roomy=1
plansza$(0) = "......................._______YQ_GN_________UI_#LLLQQQLLLU"
plansza$(1) = ".......................____MD__________________#...UUUPPP#"
plansza$(2) = "......................._HE__________ES______UI_#PPPQQQQQQU"
plansza$(3) = ".......................__________SK____BB1_fB1_##LLLQWWWQ#"
plansza$(4) = "......................._______ZK_______________#QPPPQQUQQU"
plansza$(5) = ".......................____MG__________LK5_____#LLLQWWQQQU"
plansza$(6) = "......................._LC__________FQ_________#PPPWQQQQUU"
REM ************ plansze wiersza roomy=2
plansza$(7) = ".......................________________________UQQQWLLLQQ#"
plansza$(8) = "......................._______YQ_RN_________WH_#QQQQ...QQ#"
plansza$(9) = ".......................____MK__________KK1__WJ_UUQQQPPPUQU"
plansza$(10) = "......................._____________MS_________#WLLLWQQQQW"
plansza$(11) = "......................._aI__________________UM_UQPPPQQQQQ#"
plansza$(12) = ".......................__________RN_GS_________UQQQ000QQQ#"
plansza$(13) = ".......................____DJ____aM____________UUUUQQQUUUU"
REM ************* plansze wiersza roomy=3
plansza$(14) = ".......................__________NG_YS_________#QQQWQWQQQW"
plansza$(15) = "......................._MC_YP____UP____________#QQQWLLLLQW"
plansza$(16) = "......................._WQ_____________DI3_`I3_U0000....0#"
plansza$(17) = "......................._MM__________YQ_________WWWWWPPPPUU"
plansza$(18) = "......................._______NP_SM_________WO_#QQQQMWMQQW"
plansza$(19) = ".......................________________EB1__UJ_#00QQLLL0QU"
plansza$(20) = ".......................____aM____UP____________UQQQWPPP0##"
REM ************ plansze wiersza roomy=4
plansza$(21) = ".......................____ZM____SG____________WQQQWLLLLUU"
plansza$(22) = ".......................________________________WPPPWPPPP##"
plansza$(23) = "......................._______NP_UQ_YS_RU3__#F_#0QLLLQQQQW"
plansza$(24) = "......................._YF_YJ_YO_SK_GS_GB5__WM_UUQPPPQQQQU": REM startowa MaX=dU
plansza$(25) = ".......................__________NG____________#QQQQWQQQQU"
plansza$(26) = "......................._______YR_SG____________UUQQQWLLLLU"
plansza$(27) = "......................._____________LS_KK1_____##00UUPPPPU"
REM ****************** plansze wiersza roomy=5
plansza$(28) = "......................._DD____aR_SS_YS_________ULLLWWWLLL#"
plansza$(29) = ".......................________________II4_YI4_#...UUU...#"
plansza$(30) = "......................._______aR_______GL5_YL5_WPPPQUUPPPU"
plansza$(31) = ".......................____ML_______YS______UJ_UUQQQLLLQQ#"
plansza$(32) = ".......................____YL_______________WJ_UQQQQPPP###"
plansza$(33) = ".......................________________KR1_____UU00U000UUU"
plansza$(34) = ".......................____OG____SR_YS_________UU0QQQWQQQ#"
REM ******************* plansze wiersza roomy=6
plansza$(35) = "......................._____________KM_________#00ULLLU0UU"
plansza$(36) = ".......................__________SR____MH2_YH2_###UPPPLLL#"
plansza$(37) = "......................._______GQ_______________U0QQQQW...#"
plansza$(38) = "......................._____________ZS_________#LLLU00PPP#"
plansza$(39) = ".......................__________MM_________0Q_#PPPWLLLQQ#"
plansza$(40) = ".......................________________KO3_YO3_UUUU0PPPUUU"
plansza$(41) = "......................._CC_______ZF_MS_________#QQQWQQQ00U"
REM ******************* plansze wiersza roomy=7
plansza$(42) = "......................._EI__________YM_________UUU0LLL####"
plansza$(43) = ".......................____SJ____ML____________###U...####"
plansza$(44) = "......................._____________KM_________#LLLPPP####"
plansza$(45) = ".......................____PH____ZJ____________#PPP000####"
plansza$(46) = ".......................__________EE____________#LLL0######"
plansza$(47) = "......................._____________GS______0I_UPPPQQQLLL#"
plansza$(48) = "......................._LQ_____________________UUUUUUUPPP#"
REM lokalizacja serc
REM serca wiersza 1
serca(1, 1) = 1
serca(4, 1) = 1
REM serca wiersza 2
serca(2, 2) = 1
serca(6, 2) = 1
serca(7, 2) = 1
REM serca wiersza 3
serca(1, 3) = 1
serca(2, 3) = 1
serca(5, 3) = 1
serca(7, 3) = 1
REM serca wiersza 4
serca(1, 4) = 1
serca(3, 4) = 1
serca(4, 4) = 1
serca(5, 4) = 1
serca(6, 4) = 1
REM serca wiersza 5
serca(1, 5) = 1
serca(7, 5) = 1
REM serca wiersza 6
serca(2, 6) = 1
serca(5, 6) = 1
serca(7, 6) = 1
REM serca wiersza 7
serca(2, 7) = 1
serca(4, 7) = 1
serca(5, 7) = 1
END SUB
SUB rysowanie
REM rysowanie tla
FOR yw = 0 TO 10
el$ = MID$(kod$, yw + 48, 1)
y16 = yw * 16
IF el$ = "U" THEN
FOR xw = 0 TO 3: PUT (xw * 16 + 128, y16), szaretlo, PSET: NEXT xw
END IF
IF el$ = "0" THEN
FOR xw = 0 TO 10: PUT (xw * 16 + 64, y16), szaretlo, PSET: NEXT xw
END IF
IF el$ = "W" THEN
FOR xw = 0 TO 2: PUT (xw * 16 + 32, y16), szaretlo, PSET: NEXT xw
FOR xw = 0 TO 3: PUT (xw * 16 + 224, y16), szaretlo, PSET: NEXT xw
END IF
IF el$ = "Q" THEN
FOR xw = 0 TO 17: PUT (xw * 16 + 16, y16), szaretlo, PSET: NEXT xw
END IF
IF el$ = "L" THEN
FOR xw = 0 TO 18: PUT (xw * 16 + 16, y16), szaretlo, PSET: NEXT xw
END IF
IF el$ = "P" THEN
FOR xw = 0 TO 18: PUT (xw * 16, y16), szaretlo, PSET: NEXT xw
END IF
IF el$ = "." THEN
FOR xw = 0 TO 19: PUT (xw * 16, y16), szaretlo, PSET: NEXT xw
END IF
NEXT yw
REM rysowanie podestow
el$ = MID$(kod$, 45, 1)
IF el$ = "" OR el$ = "_" THEN GOTO bloki
el2$ = MID$(kod$, 46, 1)
yokna = (ASC(el2$) - 65) * 8
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
bloki:
REM rysowanie blokow
FOR yw = 0 TO 10
el$ = MID$(kod$, yw + 48, 1)
y16 = yw * 16
IF el$ = "#" THEN
FOR xw = 0 TO 19: PUT (xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "U" THEN
FOR xw = 0 TO 6: PUT (xw * 16, y16), blok2, PSET: NEXT xw
PUT (112, y16), blok3, PSET
PUT (192, y16), blok1, PSET
FOR xw = 0 TO 6: PUT (208 + xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "0" THEN
FOR xw = 0 TO 3: PUT (xw * 16, y16), blok2, PSET: NEXT xw
PUT (64, y16), blok3, PSET
PUT (240, y16), blok1, PSET
FOR xw = 0 TO 3: PUT (256 + xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "W" THEN
PUT (0, y16), blok2, PSET
PUT (16, y16), blok3, PSET
FOR xw = 0 TO 8: PUT (xw * 16 + 88, y16), blok2, PSET: NEXT xw
PUT (72, y16), blok1, PSET
PUT (232, y16), blok3, PSET
PUT (288, y16), blok1, PSET
PUT (304, y16), blok2, PSET
END IF
IF el$ = "Q" THEN PUT (0, y16), blok3, PSET: PUT (304, y16), blok1, PSET
REM wycofane IF el$ = "H" THEN PUT (0, y16), blok1, PSET
IF el$ = "L" THEN PUT (0, y16), blok3, PSET
IF el$ = "P" THEN PUT (304, y16), blok1, PSET
IF el$ = "." THEN REM PUT (0, y16), spc40, PSET
NEXT yw
REM rysowanie okien
el$ = MID$(kod$, 25, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknonz
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 26, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 3, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknonz:
REM okno niebiesko-zielone
el$ = MID$(kod$, 28, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknoziel
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 29, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 11), 3, BF
LINE (xokna + 2, yokna + 12)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknoziel:
REM okno niebiesko-zielone
el$ = MID$(kod$, 31, 1)
IF el$ = "" OR el$ = "_" THEN GOTO serce
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 32, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
serce:
REM serce
xserca = -20
yokna = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 34, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 35, 1)
yokna = (ASC(el$) - 65) * 8
GET (xokna + 8, yokna + 8)-(xokna + 15 + 8, yokna + 7 + 8), tlo
COLOR 5: LOCATE yokna / 8, xokna / 8: PRINT CHR$(3);
xserca = xokna - 8
yserca = yokna - 8
donica:
el$ = MID$(kod$, 37, 1)
IF el$ = "" OR el$ = "_" THEN GOTO koniecrysowania
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 38, 1)
yokna = (ASC(el$) - 65) * 8
PUT (xokna, yokna), palma, 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 3000: NEXT i
OUT 66, 204: OUT 66, 4
FOR i = 1 TO 3000: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB |
|
|
Piotr-246 |
Wysłany: Śro 10:55, 01 Wrz 2021 Temat postu: |
|
DECLARE SUB zabranie ()
REM Gra "Serca"
REM wymaga emulatora o predkosci 3300 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 ()
DIM SHARED pomoc$(0 TO 31)
DIM pamiec(0 TO 128) AS LONG
DIM SHARED plansza$(0 TO 48)
DIM SHARED kod$
DIM SHARED serca(1 TO 7, 1 TO 7) AS INTEGER
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED bitmap$(0 TO 15)
REM pamiec tla pod wziatek
DIM SHARED tlo(0 TO 32) AS LONG
REM dane elementow planszy
DIM SHARED ceg40(0 TO 640) AS LONG
DIM SHARED ceg17plus17(0 TO 640) AS LONG
DIM SHARED ceg13plus13(0 TO 640) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 640) AS LONG
DIM SHARED spc40(0 TO 640) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED blok1(0 TO 64) AS LONG
DIM SHARED blok2(0 TO 64) AS LONG
DIM SHARED blok3(0 TO 64) 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 ************************* DANE STARTOWE
SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci
x = 100: y = 60: XS = 100: YS = 60: REM wspolrzedne poczatkowe gracza na ekranie
licz = -1: REM wartosc startowa zegara
roomx = 4: roomy = 4: REM plansza startowa
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$ = plansza$(roomx - 1 + (roomy - 1) * 7)
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 15
LOCATE 25, 15: PRINT "L-SHIFT ALT P-SHIFT";
LOCATE 24, 2: COLOR 225: PRINT "T:"; t0; "/"; t1;
PRINT " ROOM:"; roomx; "/"; roomy; "--";
REM **************** ustawienie gracza na planszy
GET (x, y)-(x + 15, y + 31), pamiec
PUT (x, y), vertd1, PSET
liczsercaroom = 0
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 1800: NEXT delay
REM ************************ sprawdzenie klawiszy
alt = 0: lshift = 0: pshift = 0: skos = 0
k$ = INKEY$
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 > 301 THEN x = 4: XS = 4: roomx = roomx + 1: GOTO rysuj
IF x + dx < 2 THEN x = 301: XS = 301: roomx = roomx - 1: GOTO rysuj
IF y + dy > 149 THEN y = 4: YS = 4: roomy = roomy + 1: GOTO rysuj
IF y + dy < 2 THEN y = 147: YS = 147: 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: IF POINT(x + 19, y + i) > 200 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF dx < 0 THEN
FOR i = 0 TO 31: IF POINT(x - 3, y + i) > 200 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 ************* otworzenie tego, co bylo za ludzikiem
PUT (XS, YS), pamiec, PSET
REM ******************** czy jest wziatek
deltawx = ABS(x - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek
REM ********************* zapamietanie tego co za ludzikiem
GET (x, y)-(x + 15, y + 31), pamiec
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 PUT (x, y), vertd1, OR: XS = x: YS = y: GOTO PETLA
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 PUT (x, y), znakl1, OR
IF przebieranie = 1 THEN PUT (x, y), znakl2, OR
IF przebieranie = 2 THEN PUT (x, y), znakl3, OR
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 PUT (x, y), znakp1, OR
IF przebieranie = 1 THEN PUT (x, y), znakp2, OR
IF przebieranie = 2 THEN PUT (x, y), znakp3, OR
END IF
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
REM zabranie
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
GET (0, 0)-(319, 7), ceg40
GET (0, 8)-(319, 15), ceg17plus17
GET (0, 16)-(319, 23), ceg13plus13
GET (0, 24)-(319, 31), ceg4plus20plus4
GET (0, 48)-(319, 55), spc40
GET (40, 40)-(47, 47), tlo
GET (16, 64)-(31, 79), palma
GET (32, 64)-(47, 79), blok1
GET (48, 64)-(63, 79), blok2
GET (64, 64)-(79, 79), blok3
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
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)
FOR i = 1 TO 10
OUT 66, 32: OUT 66, 2
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 32: OUT 66, 1
OUT 66, 32: OUT 66, 0
OUT 66, 104: OUT 66, 2
OUT 66, 48: OUT 66, 0
OUT 66, 250: OUT 66, 2
OUT 66, 32: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB palety
REM ****************** Ustawienie wlasnej wartosci barw
REM **************** kolejno, blue green red, kazdy max=6
REM rejestry tla - zaczyna od &H0
PALETTE 0, 10 * 65536 + 10 * 256 + 10: REM tlo sciany
PALETTE 1, 9 * 65536 + 9 * 256 + 9: REM tlo sciany
PALETTE 2, 11 * 65536 + 11 * 256 + 11: REM tlo sciany
PALETTE 3, 63 * 65536 + 31 * 256 + 0: REM blekit za oknem
PALETTE 4, 0 * 65536 + 31 * 256 + 0: REM zielen za oknem
PALETTE 5, 0 * 65536 + 0 * 256 + 63: REM czerwien serca
PALETTE 6, 47 * 65536 + 47 * 256 + 47: REM rama okienna
PALETTE 7, 3 * 65536 + 12 * 256 + 35: REM doniczka
REM rejestry gracza powinny byc kodowane &HnF od 1F
REM ze wzgledu na funkce PUT-OR
PALETTE &H1F, 0 * 65536 + 0 * 256 + 48: REM sweter
PALETTE &H2F, 63 * 65536 + 47 * 256 + 0: REM SPODNIE
PALETTE &H3F, 31 * 65536 + 31 * 256 + 31: REM SREDNIA SZAROSC
PALETTE &H4F, 15 * 65536 + 15 * 256 + 15: REM 1/4 SZAROSCI
PALETTE &H5F, 47 * 65536 + 47 * 256 + 47: REM 3/4 SZAROSCI
PALETTE &H6F, 46 * 65536 + 55 * 256 + 63: REM SKORA
PALETTE &H7F, 0 + 65536 + 0 * 256 + 31: REM pol sweter
PALETTE &H8F, 34 * 65536 + 40 * 256 + 46: REM 3/4 skora
PALETTE &H9F, 47 * 65536 + 38 * 256 + 0: REM 7/8 SPODNI
PALETTE &HAF, 0 * 65536 + 0 * 256 + 40: REM 3/4 swetra
PALETTE &HBF, 23 * 65536 + 23 * 256 + 23: REM 3/8 szarosci
PALETTE &HCF, 43 * 65536 + 43 * 256 + 51: REM 7/8 skora
REM rejestry przeszkod - powinny byc od &HFF wstecz
PALETTE &HFF, 18 * 65536 + 19 * 256 + 33: REM cegly
PALETTE &HFE, 19 * 65536 + 19 * 256 + 19: REM fugi
PALETTE &HFD, 28 * 65536 + 28 * 256 + 28: REM krawedz
FOR i = 0 TO 15
PALETTE 230 + i, i * 4 * 65536 + i * 4 * 256 + i * 4: REM kamien
NEXT i
END SUB
SUB plansze
REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** (roomy-1)*7+(roomx-1)
REM kodowanie _+++++++++++++++++++++++_okna++++_se_kw_se1_se2_nowy11+++++
REM ************ plansze wiersza roomy=1
plansza$(0) = "......................._______YQ_GN_________UI_#LLLQQQLLLU"
plansza$(1) = ".......................____MD__________________#...UUUPPP#"
plansza$(2) = "......................._HE__________ES______UI_#PPPQQQQQQU"
plansza$(3) = ".......................__________SK____BB1_fB1_##LLLQWWWQ#"
plansza$(4) = "......................._______ZK_______________#QPPPQQUQQU"
plansza$(5) = ".......................____MG__________LK5_____#LLLQWWQQQU"
plansza$(6) = "......................._LC__________FQ_________#PPPWQQQQUU"
REM ************ plansze wiersza roomy=2
plansza$(7) = ".......................________________________UQQQWLLLQQ#"
plansza$(8) = "......................._______YQ_RN_________WH_#QQQQ...QQ#"
plansza$(9) = ".......................____MK__________KK1__WJ_UUQQQPPPUQU"
plansza$(10) = "......................._____________MS_________#WLLLWQQQQW"
plansza$(11) = "......................._aI__________________UM_UQPPPQQQQQ#"
plansza$(12) = ".......................__________RN_GS_________UQQQ000QQQ#"
plansza$(13) = ".......................____DJ____aM____________UUUUQQQUUUU"
REM ************* plansze wiersza roomy=3
plansza$(14) = ".......................__________NG_YS_________#QQQWQWQQQW"
plansza$(15) = "......................._MC_YP____UP____________#QQQWLLLLQW"
plansza$(16) = "......................._WQ_____________DI3_`I3_U0000....0#"
plansza$(17) = "......................._MM__________YQ_________WWWWWPPPPUU"
plansza$(18) = "......................._______NP_SM_________WO_#QQQQMWMQQW"
plansza$(19) = ".......................________________EB1__UJ_#00QQLLL0QU"
plansza$(20) = ".......................____aM____UP____________UQQQWPPP0##"
REM ************ plansze wiersza roomy=4
plansza$(21) = ".......................____ZM____SG____________WQQQWLLLLUU"
plansza$(22) = ".......................________________________WPPPWPPPP##"
plansza$(23) = "......................._______NP_UQ_YS_RU3__#F_#0QLLLQQQQW"
plansza$(24) = "......................._YF_YJ_YO_SK_GS_GB5__WM_UUQPPPQQQQU": REM startowa MaX=dU
plansza$(25) = ".......................__________NG____________#QQQQWQQQQU"
plansza$(26) = "......................._______YR_SG____________UUQQQWLLLLU"
plansza$(27) = "......................._____________LS_KK1_____##00UUPPPPU"
REM ****************** plansze wiersza roomy=5
plansza$(28) = "......................._DD____aR_SS_YS_________ULLLWWWLLL#"
plansza$(29) = ".......................________________II4_YI4_#...UUU...#"
plansza$(30) = "......................._______aR_______GL5_YL5_WPPPQUUPPPU"
plansza$(31) = ".......................____ML_______YS______UJ_UUQQQLLLQQ#"
plansza$(32) = ".......................____YL_______________WJ_UQQQQPPP###"
plansza$(33) = ".......................________________KR1_____UU00U000UUU"
plansza$(34) = ".......................____OG____SR_YS_________UU0QQQWQQQ#"
REM ******************* plansze wiersza roomy=6
plansza$(35) = "......................._____________KM_________#00ULLLU0UU"
plansza$(36) = ".......................__________SR____MH2_YH2_###UPPPLLL#"
plansza$(37) = "......................._______GQ_______________U0QQQQW...#"
plansza$(38) = "......................._____________ZS_________#LLLU00PPP#"
plansza$(39) = ".......................__________MM_________0Q_#PPPWLLLQQ#"
plansza$(40) = ".......................________________KO3_YO3_UUUU0PPPUUU"
plansza$(41) = "......................._CC_______ZF_MS_________#QQQWQQQ00U"
REM ******************* plansze wiersza roomy=7
plansza$(42) = "......................._EI__________YM_________UUU0LLL####"
plansza$(43) = ".......................____SJ____ML____________###U...####"
plansza$(44) = "......................._____________KM_________#LLLPPP####"
plansza$(45) = ".......................____PH____ZJ____________#PPP000####"
plansza$(46) = ".......................__________EE____________#LLL0######"
plansza$(47) = "......................._____________GS______0I_UPPPQQQLLL#"
plansza$(48) = "......................._LQ_____________________UUUUUUUPPP#"
REM lokalizacja serc
REM serca wiersza 1
serca(1, 1) = 1
serca(4, 1) = 1
REM serca wiersza 2
serca(2, 2) = 1
serca(6, 2) = 1
serca(7, 2) = 1
REM serca wiersza 3
serca(1, 3) = 1
serca(2, 3) = 1
serca(5, 3) = 1
serca(7, 3) = 1
REM serca wiersza 4
serca(1, 4) = 1
serca(3, 4) = 1
serca(4, 4) = 1
serca(5, 4) = 1
serca(6, 4) = 1
REM serca wiersza 5
serca(1, 5) = 1
serca(7, 5) = 1
REM serca wiersza 6
serca(2, 6) = 1
serca(5, 6) = 1
serca(7, 6) = 1
REM serca wiersza 7
serca(2, 7) = 1
serca(4, 7) = 1
serca(5, 7) = 1
END SUB
SUB rysowanie
REM rysowanie tla
FOR i = 0 TO 22
PUT (0, i * 8), spc40, PSET
NEXT i
REM rysowanie podestow
el$ = MID$(kod$, 45, 1)
IF el$ = "" OR el$ = "_" THEN GOTO bloki
el2$ = MID$(kod$, 46, 1)
yokna = (ASC(el2$) - 65) * 8
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
bloki:
REM rysowanie blokow
FOR yw = 0 TO 10
el$ = MID$(kod$, yw + 48, 1)
y16 = yw * 16
IF el$ = "#" THEN
FOR xw = 0 TO 19: PUT (xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "U" THEN
FOR xw = 0 TO 6: PUT (xw * 16, y16), blok2, PSET: NEXT xw
PUT (112, y16), blok3, PSET
PUT (192, y16), blok1, PSET
FOR xw = 0 TO 6: PUT (208 + xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "0" THEN
FOR xw = 0 TO 3: PUT (xw * 16, y16), blok2, PSET: NEXT xw
PUT (64, y16), blok3, PSET
PUT (240, y16), blok1, PSET
FOR xw = 0 TO 3: PUT (256 + xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "W" THEN
PUT (0, y16), blok2, PSET
PUT (16, y16), blok3, PSET
FOR xw = 0 TO 8: PUT (xw * 16 + 88, y16), blok2, PSET: NEXT xw
PUT (72, y16), blok1, PSET
PUT (232, y16), blok3, PSET
PUT (288, y16), blok1, PSET
PUT (304, y16), blok2, PSET
END IF
IF el$ = "Q" THEN PUT (0, y16), blok3, PSET: PUT (304, y16), blok1, PSET
REM wycofane IF el$ = "H" THEN PUT (0, y16), blok1, PSET
IF el$ = "L" THEN PUT (0, y16), blok3, PSET
IF el$ = "P" THEN PUT (304, y16), blok1, PSET
IF el$ = "." THEN REM PUT (0, y16), spc40, PSET
NEXT yw
REM rysowanie okien
el$ = MID$(kod$, 25, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknonz
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 26, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 3, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknonz:
REM okno niebiesko-zielone
el$ = MID$(kod$, 28, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknoziel
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 29, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 11), 3, BF
LINE (xokna + 2, yokna + 12)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknoziel:
REM okno niebiesko-zielone
el$ = MID$(kod$, 31, 1)
IF el$ = "" OR el$ = "_" THEN GOTO serce
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 32, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
serce:
REM serce
xserca = -20
yokna = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 34, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 35, 1)
yokna = (ASC(el$) - 65) * 8
GET (xokna + 8, yokna + 8)-(xokna + 15 + 8, yokna + 7 + 8), tlo
COLOR 5: LOCATE yokna / 8, xokna / 8: PRINT CHR$(3);
xserca = xokna - 8
yserca = yokna - 8
donica:
el$ = MID$(kod$, 37, 1)
IF el$ = "" OR el$ = "_" THEN GOTO koniecrysowania
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 38, 1)
yokna = (ASC(el$) - 65) * 8
PUT (xokna, yokna), palma, 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 3000: NEXT i
OUT 66, 204: OUT 66, 4
FOR i = 1 TO 3000: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB |
|
|
Piotr-246 |
Wysłany: Śro 10:55, 01 Wrz 2021 Temat postu: |
|
REM modul BSAVE do gry "Serca"
SCREEN 13
FOR j = 0 TO 15
FOR i = 0 TO 15
PALETTE i + j * 16, INT(RND(1) * 63) + 256 * INT(RND(1) * 63)
NEXT i: NEXT j
DIM cegla(0 TO 32) AS LONG
DIM tlo(0 TO 32) AS LONG
DIM poltlo(0 TO 16) AS LONG
DIM bitmap$(0 TO 31)
DIM blok(0 TO 64) AS LONG
REM rysunek cegly
bitmap$(0) = "DDDDDDDEDDDDDDDE"
bitmap$(1) = "DFFFFFFEDFFFFFFE"
bitmap$(2) = "DFFFFFFEDFFFFFFE"
bitmap$(3) = "EEEEEEEEEEEEEEEE"
bitmap$(4) = "DDDEDDDDDDDDDDDD"
bitmap$(5) = "FFFEDFFFFFFFFFFF"
bitmap$(6) = "FFFEDFFFFFFFFFFF"
bitmap$(7) = "EEEEEEEEEEEEEEEE"
REM 250-A 251-B 252-C 253-D 254-E 255-F
FOR yd = 0 TO 7
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + &HF0 + 10
: PSET (xd, yd)
NEXT xd: NEXT yd
GET (0, 0)-(15, 7), 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"
FOR yd = 0 TO 7
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 48
: PSET (xd, yd)
NEXT xd: NEXT yd
GET (0, 0)-(15, 7), tlo
REM przygotowanie tablic elementow wierszowych
CLS
FOR x = 0 TO 19
FOR y = 0 TO 10
PUT (x * 16, y * 8), 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 8
PUT (i * 16, 8), cegla, PSET
PUT (304 - i * 16, 8), cegla, PSET
NEXT i
FOR i = 0 TO 4
PUT (i * 16, 16), cegla, PSET
PUT (304 - i * 16, 16), cegla, PSET
NEXT i
FOR i = 0 TO 2
PUT (i * 16, 24), cegla, PSET
PUT (304 - i * 16, 24), cegla, PSET
NEXT i
FOR i = 0 TO 9
PUT (i * 16 + 80, 24), cegla, PSET
NEXT i
REM poszerzenie przejsc pionowych
GET (8, 64)-(15, 71), poltlo
PUT (136, 8), poltlo, PSET
PUT (40, 24), poltlo, PSET
GET (0, 64)-(7, 71), poltlo
PUT (176, 8), poltlo, PSET
PUT (272, 24), poltlo, PSET
REM wykonczenie cegiel
COLOR 254: REM szczeliny
LINE (135, 8)-(135, 15)
LINE (79, 16)-(79, 23)
LINE (39, 24)-(39, 31)
LINE (239, 24)-(239, 31)
COLOR 253: REM krawedzie
LINE (184, 12)-(184, 14)
LINE (240, 21)-(240, 22)
LINE (80, 28)-(80, 30)
LINE (280, 28)-(280, 30)
REM RYSUNEK kamienia
bitmap$(0) = "JJJJJJJJJJJJJJJJ"
bitmap$(1) = "JJNNNNNNNNNNNNJJ"
bitmap$(2) = "JJNAAAKJPKAAANJJ"
bitmap$(3) = "JJNAKONPNKPKANJJ"
bitmap$(4) = "JJNAPMKLGLMPANJJ"
bitmap$(5) = "JJNKJOJKPJPKMNJJ"
bitmap$(6) = "JJNOLJKJJMKMJNJJ"
bitmap$(7) = "JJNJFMJOHKNIPNJJ"
bitmap$(8) = "JJNJILJLJHIJHNJJ"
bitmap$(9) = "JJNIHJNOHOJJKNJJ"
bitmap$(10) = "JJNAJIIHJOMPANJJ"
bitmap$(11) = "JJNAINNJLJOKANJJ"
bitmap$(12) = "JJNAAAIKJKAAANJJ"
bitmap$(13) = "JJNNNNNNNNNNNNJJ"
bitmap$(14) = "JJJJJJJJJJJJJJJJ"
bitmap$(15) = "JJJJJJJJJJJJJJJJ"
FOR yd = 0 TO 15
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + 230
: PSET (xd, yd + 64)
NEXT xd: NEXT yd
REM RYSUNEK DONICZKI
bitmap$(0) = "AAABCEEAAEEBCAAA"
bitmap$(1) = "BBBBEEEEEEEECBBB"
bitmap$(2) = "CCCEEEEEEEEEECCC"
bitmap$(3) = "AAAEEEEEEEEBEEAA"
bitmap$(4) = "AAEEAEAEEAEBEEAA"
bitmap$(5) = "AAEBCEBEEBEBCEAA"
bitmap$(6) = "AAEBECCEECCECEAA"
bitmap$(7) = "AAEBEAAEEAAECEAA"
bitmap$(8) = "AAABCAAEEAABCAAA"
bitmap$(9) = "BBBBCAAEEAABBBBB"
bitmap$(10) = "CCCBAAAEEAABCCCC"
bitmap$(11) = "AAABCHHHHHHBCAAA"
bitmap$(12) = "AAABCHHHHHHBCAAA"
bitmap$(13) = "AAABBBHHHHBBCAAA"
bitmap$(14) = "AAABCCHHHHCBCAAA"
bitmap$(15) = "AAABCAHHHHABCAAA"
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) = "JJJJJJJJJJJJJJJF" + "JJJJJJJJJJJJJJJF" + "JJJJJJJJJJJJJJJF"
bitmap$(1) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(2) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(3) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(4) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(5) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(6) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(7) = "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF"
bitmap$(8) = "JJJJJJJFJJJJJJJJ" + "JJJJJJJFJJJJJJJJ" + "JJJJJJJFJJJJJJJF"
bitmap$(9) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(10) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(11) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(12) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(13) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(14) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(15) = "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF"
FOR yd = 0 TO 15
FOR xd = 0 TO 47
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + 230
: PSET (xd + 32, yd + 64)
NEXT xd: NEXT yd
GET (48, 64)-(63, 79), blok
FOR i = 0 TO 19: PUT (i * 16, 32), blok, PSET
NEXT i
COLOR 15: LOCATE 10, 16: PRINT "SERCA 1.0"
REM animacja
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)
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) = "0000088118200000" + "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)
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)
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) = "0A1A7111117A1A00"
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)
NEXT xd
NEXT yd
REM zapis do pliku
DEF SEG = &HA000
BSAVE "bitmap1.scr", 0, 50000
INPUT a$
CLS
BLOAD "bitmap1.scr"
END |
|
|
Piotr-246 |
Wysłany: Śro 6:16, 01 Wrz 2021 Temat postu: |
|
DECLARE SUB zabranie ()
REM Gra "Serca"
REM wymaga emulatora o predkosci 3300 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 ()
DIM SHARED pomoc$(0 TO 31)
DIM pamiec(0 TO 128) AS LONG
DIM SHARED plansza$(0 TO 48)
DIM SHARED kod$
DIM SHARED serca(1 TO 7, 1 TO 7) AS INTEGER
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED bitmap$(0 TO 15)
REM pamiec tla pod wziatek
DIM SHARED tlo(0 TO 32) AS LONG
REM dane elementow planszy
DIM SHARED ceg40(0 TO 640) AS LONG
DIM SHARED ceg17plus17(0 TO 640) AS LONG
DIM SHARED ceg13plus13(0 TO 640) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 640) AS LONG
DIM SHARED spc40(0 TO 640) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED blok1(0 TO 64) AS LONG
DIM SHARED blok2(0 TO 64) AS LONG
DIM SHARED blok3(0 TO 64) 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 ************************* DANE STARTOWE
SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci
x = 100: y = 60: XS = 100: YS = 60: REM wspolrzedne poczatkowe gracza na ekranie
licz = -1: REM wartosc startowa zegara
roomx = 4: roomy = 4: REM plansza startowa
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$ = plansza$(roomx - 1 + (roomy - 1) * 7)
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 15
LOCATE 25, 15: PRINT "L-SHIFT ALT P-SHIFT";
LOCATE 24, 2: COLOR 225: PRINT "T:"; t0; "/"; t1;
PRINT " ROOM:"; roomx; "/"; roomy; "--";
REM **************** ustawienie gracza na planszy
GET (x, y)-(x + 15, y + 31), pamiec
PUT (x, y), vertd1, PSET
liczsercaroom = 0
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 1800: NEXT delay
REM ************************ sprawdzenie klawiszy
alt = 0: lshift = 0: pshift = 0: skos = 0
k$ = INKEY$
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 > 301 THEN x = 4: XS = 4: roomx = roomx + 1: GOTO rysuj
IF x + dx < 2 THEN x = 301: XS = 301: roomx = roomx - 1: GOTO rysuj
IF y + dy > 149 THEN y = 4: YS = 4: roomy = roomy + 1: GOTO rysuj
IF y + dy < 2 THEN y = 147: YS = 147: 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: IF POINT(x + 19, y + i) > 200 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF dx < 0 THEN
FOR i = 0 TO 31: IF POINT(x - 3, y + i) > 200 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 ************* otworzenie tego, co bylo za ludzikiem
PUT (XS, YS), pamiec, PSET
REM ******************** czy jest wziatek
deltawx = ABS(x - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek
REM ********************* zapamietanie tego co za ludzikiem
GET (x, y)-(x + 15, y + 31), pamiec
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 PUT (x, y), vertd1, OR: XS = x: YS = y: GOTO PETLA
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 PUT (x, y), znakl1, OR
IF przebieranie = 1 THEN PUT (x, y), znakl2, OR
IF przebieranie = 2 THEN PUT (x, y), znakl3, OR
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 PUT (x, y), znakp1, OR
IF przebieranie = 1 THEN PUT (x, y), znakp2, OR
IF przebieranie = 2 THEN PUT (x, y), znakp3, OR
END IF
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
REM zabranie
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
GET (0, 0)-(319, 7), ceg40
GET (0, 8)-(319, 15), ceg17plus17
GET (0, 16)-(319, 23), ceg13plus13
GET (0, 24)-(319, 31), ceg4plus20plus4
GET (0, 64)-(319, 71), spc40
GET (40, 40)-(47, 47), tlo
GET (16, 72)-(31, 87), palma
GET (32, 72)-(47, 87), blok1
GET (48, 72)-(63, 87), blok2
GET (64, 72)-(79, 87), blok3
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
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)
FOR i = 1 TO 10
OUT 66, 32: OUT 66, 2
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 32: OUT 66, 1
OUT 66, 32: OUT 66, 0
OUT 66, 104: OUT 66, 2
OUT 66, 48: OUT 66, 0
OUT 66, 250: OUT 66, 2
OUT 66, 32: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB palety
REM ****************** Ustawienie wlasnej wartosci barw
REM **************** kolejno, blue green red, kazdy max=6
REM rejestry tla - zaczyna od &H0
PALETTE 0, 10 * 65536 + 10 * 256 + 10: REM tlo sciany
PALETTE 1, 9 * 65536 + 9 * 256 + 9: REM tlo sciany
PALETTE 2, 11 * 65536 + 11 * 256 + 11: REM tlo sciany
PALETTE 3, 63 * 65536 + 31 * 256 + 0: REM blekit za oknem
PALETTE 4, 0 * 65536 + 31 * 256 + 0: REM zielen za oknem
PALETTE 5, 0 * 65536 + 0 * 256 + 63: REM czerwien serca
PALETTE 6, 47 * 65536 + 47 * 256 + 47: REM rama okienna
PALETTE 7, 3 * 65536 + 12 * 256 + 35: REM doniczka
REM rejestry gracza powinny byc kodowane &HnF od 1F
REM ze wzgledu na funkce PUT-OR
PALETTE &H1F, 0 * 65536 + 0 * 256 + 48: REM sweter
PALETTE &H2F, 63 * 65536 + 47 * 256 + 0: REM SPODNIE
PALETTE &H3F, 31 * 65536 + 31 * 256 + 31: REM SREDNIA SZAROSC
PALETTE &H4F, 15 * 65536 + 15 * 256 + 15: REM 1/4 SZAROSCI
PALETTE &H5F, 47 * 65536 + 47 * 256 + 47: REM 3/4 SZAROSCI
PALETTE &H6F, 46 * 65536 + 55 * 256 + 63: REM SKORA
PALETTE &H7F, 0 + 65536 + 0 * 256 + 31: REM pol sweter
PALETTE &H8F, 34 * 65536 + 40 * 256 + 46: REM 3/4 skora
PALETTE &H9F, 47 * 65536 + 38 * 256 + 0: REM 7/8 SPODNI
PALETTE &HAF, 0 * 65536 + 0 * 256 + 40: REM 3/4 swetra
PALETTE &HBF, 23 * 65536 + 23 * 256 + 23: REM 3/8 szarosci
PALETTE &HCF, 43 * 65536 + 43 * 256 + 51: REM 7/8 skora
REM rejestry przeszkod - powinny byc od &HFF wstecz
PALETTE &HFF, 18 * 65536 + 19 * 256 + 33: REM cegly
PALETTE &HFE, 19 * 65536 + 19 * 256 + 19: REM fugi
PALETTE &HFD, 28 * 65536 + 28 * 256 + 28: REM krawedz
FOR i = 0 TO 15
PALETTE 230 + i, i * 4 * 65536 + i * 4 * 256 + i * 4: REM kamien
NEXT i
END SUB
SUB plansze
REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** (roomy-1)*7+(roomx-1)
REM kodowanie _+++++++++++++++++++++++_okna++++_se_kw_se1_se2_nowy11+++++
REM ************ plansze wiersza roomy=1
plansza$(0) = "......................._______YQ_GN____________#LLLUQQLLLU"
plansza$(1) = ".......................____MD__________________#...UUUPPP#"
plansza$(2) = "......................._HE__________ES_________#PPPQUQQQQU"
plansza$(3) = ".......................__________SK____BB1_fB1_##LLLQWWWQ#"
plansza$(4) = "......................._______YR_______________#QPPPQQUQQU"
plansza$(5) = ".......................____MG__________LK5_____#LLLQWWQQQU"
plansza$(6) = "......................._LC__________FQ_________#PPPWQQQQUU"
REM ************ plansze wiersza roomy=2
plansza$(7) = ".......................________________________UQQQWLLLQQ#"
plansza$(8) = "......................._______YQ_RN_________WH_#QQQQ...QQ#"
plansza$(9) = ".......................____MK__________KK1__WJ_UUQQQPPPUQU"
plansza$(10) = "......................._____________MS_________#WLLLWQQQQW"
plansza$(11) = "......................._aI__________________UM_UQPPPQQQQQ#"
plansza$(12) = ".......................__________RN_FS_________UQQQ000QQQ#"
plansza$(13) = ".......................____DJ____aM____________UUUUQQQUUUU"
REM ************* plansze wiersza roomy=3
plansza$(14) = ".......................__________NG_YS_________#QQQWQWQQQW"
plansza$(15) = "......................._MC_YP____UP____________#QQQWLLLLQW"
plansza$(16) = "......................._WR_____________DI3_`I3_U0000....0#"
plansza$(17) = "......................._MM__________YQ_________WWWWWPPPPUU"
plansza$(18) = "......................._______NP_SM_________WO_#QQQQMWMQQW"
plansza$(19) = ".......................________________EB1__UJ_#00QQLLL0QU"
plansza$(20) = ".......................____aM____UP____________UQQQWPPP0##"
REM ************ plansze wiersza roomy=4
plansza$(21) = ".......................____YK____SG____________WQQQWLLLLUU"
plansza$(22) = ".......................________________________WHHHWPPPP##"
plansza$(23) = "......................._______NP_UQ_YS_RU3__#F_#0QLLLQQQQW"
plansza$(24) = "......................._YF_YJ_YO_SK_GS_GB5__WM_UUQPPPQQQQU": REM startowa MaX=dU
plansza$(25) = ".......................__________NG____________#QQQQWQQQQU"
plansza$(26) = "......................._______YR_SG____________UUQQQWLLLLU"
plansza$(27) = "......................._____________LS_KK1_____##00UUPPPPU"
REM ****************** plansze wiersza roomy=5
plansza$(28) = "......................._DD____aR_SS_YS_________ULLLWWWLLL#"
plansza$(29) = ".......................________________II4_YI4_#...UUU...#"
plansza$(30) = "......................._______aR_______GL5_YL5_WPPPQUUPPPU"
plansza$(31) = ".......................____ML_______OS_________UUQQULLLQQ#"
plansza$(32) = ".......................____YL__________________UQQQWPPP###"
plansza$(33) = ".......................________________KR1_____UU00U000UUU"
plansza$(34) = ".......................____OG____SR_FS_________UU0QQQWQQQ#"
REM ******************* plansze wiersza roomy=6
plansza$(35) = "......................._____________KM_________#00ULLLU0UU"
plansza$(36) = ".......................__________SR____MH2_YH2_###UPPPLLL#"
plansza$(37) = "......................._______GQ_______________U0QQQQW...#"
plansza$(38) = "......................._____________ZS_________#LLLU00PPP#"
plansza$(39) = ".......................__________MM_________0Q_#PPPWLLLQQ#"
plansza$(40) = ".......................________________KO3_YO3_UUUU0PPPUUU"
plansza$(41) = "......................._CC_______ZF_MS_________#QQQWQQQ00U"
REM ******************* plansze wiersza roomy=7
plansza$(42) = "......................._EI__________YM_________UUU0LLL####"
plansza$(43) = ".......................____SJ____ML____________###U...####"
plansza$(44) = "......................._____________KM_________#LLLPPP####"
plansza$(45) = ".......................____PH____ZJ____________#PPP000####"
plansza$(46) = ".......................__________EE____________#LLL0######"
plansza$(47) = "......................._____________FT______0I_UPPPQQQLLL#"
plansza$(48) = "......................._LR_____________________UUUUUUUPPP#"
REM lokalizacja serc
REM serca wiersza 1
serca(1, 1) = 1
serca(4, 1) = 1
REM serca wiersza 2
serca(2, 2) = 1
serca(6, 2) = 1
serca(7, 2) = 1
REM serca wiersza 3
serca(1, 3) = 1
serca(2, 3) = 1
serca(5, 3) = 1
serca(7, 3) = 1
REM serca wiersza 4
serca(1, 4) = 1
serca(3, 4) = 1
serca(4, 4) = 1
serca(5, 4) = 1
serca(6, 4) = 1
REM serca wiersza 5
serca(1, 5) = 1
serca(7, 5) = 1
REM serca wiersza 6
serca(2, 6) = 1
serca(5, 6) = 1
serca(7, 6) = 1
REM serca wiersza 7
serca(2, 7) = 1
serca(4, 7) = 1
serca(5, 7) = 1
END SUB
SUB rysowanie
REM rysowanie tla
FOR i = 0 TO 22
PUT (0, i * 8), spc40, PSET
NEXT i
REM rysowanie podestow
el$ = MID$(kod$, 45, 1)
IF el$ = "" OR el$ = "_" THEN GOTO bloki
el2$ = MID$(kod$, 46, 1)
yokna = (ASC(el2$) - 65) * 8
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
bloki:
REM rysowanie blokow
FOR yw = 0 TO 10
el$ = MID$(kod$, yw + 48, 1)
y16 = yw * 16
IF el$ = "#" THEN
FOR xw = 0 TO 19: PUT (xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "U" THEN
FOR xw = 0 TO 6: PUT (xw * 16, y16), blok2, PSET: NEXT xw
PUT (112, y16), blok3, PSET
PUT (192, y16), blok1, PSET
FOR xw = 0 TO 6: PUT (208 + xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "0" THEN
FOR xw = 0 TO 3: PUT (xw * 16, y16), blok2, PSET: NEXT xw
PUT (64, y16), blok3, PSET
PUT (240, y16), blok1, PSET
FOR xw = 0 TO 3: PUT (256 + xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "W" THEN
PUT (0, y16), blok2, PSET
PUT (16, y16), blok3, PSET
FOR xw = 0 TO 8: PUT (xw * 16 + 88, y16), blok2, PSET: NEXT xw
PUT (72, y16), blok1, PSET
PUT (232, y16), blok3, PSET
PUT (288, y16), blok1, PSET
PUT (304, y16), blok2, PSET
END IF
IF el$ = "Q" THEN PUT (0, y16), blok3, PSET: PUT (304, y16), blok1, PSET
REM wycofane IF el$ = "H" THEN PUT (0, y16), blok1, PSET
IF el$ = "L" THEN PUT (0, y16), blok3, PSET
IF el$ = "P" THEN PUT (304, y16), blok1, PSET
IF el$ = "." THEN REM PUT (0, y16), spc40, PSET
NEXT yw
REM rysowanie okien
el$ = MID$(kod$, 25, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknonz
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 26, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 3, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknonz:
REM okno niebiesko-zielone
el$ = MID$(kod$, 28, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknoziel
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 29, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 11), 3, BF
LINE (xokna + 2, yokna + 12)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknoziel:
REM okno niebiesko-zielone
el$ = MID$(kod$, 31, 1)
IF el$ = "" OR el$ = "_" THEN GOTO serce
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 32, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
serce:
REM serce
xserca = -20
yokna = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 34, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 35, 1)
yokna = (ASC(el$) - 65) * 8
GET (xokna + 8, yokna + 8)-(xokna + 15 + 8, yokna + 7 + 8), tlo
COLOR 5: LOCATE yokna / 8, xokna / 8: PRINT CHR$(3);
xserca = xokna - 8
yserca = yokna - 8
donica:
el$ = MID$(kod$, 37, 1)
IF el$ = "" OR el$ = "_" THEN GOTO koniecrysowania
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 38, 1)
yokna = (ASC(el$) - 65) * 8
PUT (xokna, yokna), palma, 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 3000: NEXT i
OUT 66, 204: OUT 66, 4
FOR i = 1 TO 3000: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB |
|
|
Piotr-246 |
Wysłany: Śro 6:15, 01 Wrz 2021 Temat postu: |
|
REM modul BSAVE do gry "Serca"
SCREEN 13
FOR j = 0 TO 15
FOR i = 0 TO 15
PALETTE i + j * 16, INT(RND(1) * 63) + 256 * INT(RND(1) * 63)
NEXT i: NEXT j
DIM cegla(0 TO 32) AS LONG
DIM tlo(0 TO 32) AS LONG
DIM poltlo(0 TO 16) AS LONG
DIM bitmap$(0 TO 31)
REM rysunek cegly
bitmap$(0) = "DDDDDDDEDDDDDDDE"
bitmap$(1) = "DFFFFFFEDFFFFFFE"
bitmap$(2) = "DFFFFFFEDFFFFFFE"
bitmap$(3) = "EEEEEEEEEEEEEEEE"
bitmap$(4) = "DDDEDDDDDDDDDDDD"
bitmap$(5) = "FFFEDFFFFFFFFFFF"
bitmap$(6) = "FFFEDFFFFFFFFFFF"
bitmap$(7) = "EEEEEEEEEEEEEEEE"
REM 250-A 251-B 252-C 253-D 254-E 255-F
FOR yd = 0 TO 7
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + &HF0 + 10
: PSET (xd, yd)
NEXT xd: NEXT yd
GET (0, 0)-(15, 7), 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"
FOR yd = 0 TO 7
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 48
: PSET (xd, yd)
NEXT xd: NEXT yd
GET (0, 0)-(15, 7), tlo
REM przygotowanie tablic elementow wierszowych
CLS
FOR x = 0 TO 19
FOR y = 0 TO 10
PUT (x * 16, y * 8), 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 8
PUT (i * 16, 8), cegla, PSET
PUT (304 - i * 16, 8), cegla, PSET
NEXT i
FOR i = 0 TO 4
PUT (i * 16, 16), cegla, PSET
PUT (304 - i * 16, 16), cegla, PSET
NEXT i
FOR i = 0 TO 2
PUT (i * 16, 24), cegla, PSET
PUT (304 - i * 16, 24), cegla, PSET
NEXT i
FOR i = 0 TO 9
PUT (i * 16 + 80, 24), cegla, PSET
NEXT i
REM poszerzenie przejsc pionowych
GET (8, 64)-(15, 71), poltlo
PUT (136, 8), poltlo, PSET
PUT (40, 24), poltlo, PSET
GET (0, 64)-(7, 71), poltlo
PUT (176, 8), poltlo, PSET
PUT (272, 24), poltlo, PSET
REM wykonczenie cegiel
COLOR 254: REM szczeliny
LINE (135, 8)-(135, 15)
LINE (79, 16)-(79, 23)
LINE (39, 24)-(39, 31)
LINE (239, 24)-(239, 31)
COLOR 253: REM krawedzie
LINE (184, 12)-(184, 14)
LINE (240, 21)-(240, 22)
LINE (80, 28)-(80, 30)
LINE (280, 28)-(280, 30)
REM RYSUNEK kamienia
bitmap$(0) = "JJJJJJJJJJJJJJJJ"
bitmap$(1) = "JJNNNNNNNNNNNNJJ"
bitmap$(2) = "JJNAAAKJPKAAANJJ"
bitmap$(3) = "JJNAKONPNKPKANJJ"
bitmap$(4) = "JJNAPMKLGLMPANJJ"
bitmap$(5) = "JJNKJOJKPJPKMNJJ"
bitmap$(6) = "JJNOLJKJJMKMJNJJ"
bitmap$(7) = "JJNJFMJOHKNIPNJJ"
bitmap$(8) = "JJNJILJLJHIJHNJJ"
bitmap$(9) = "JJNIHJNOHOJJKNJJ"
bitmap$(10) = "JJNAJIIHJOMPANJJ"
bitmap$(11) = "JJNAINNJLJOKANJJ"
bitmap$(12) = "JJNAAAIKJKAAANJJ"
bitmap$(13) = "JJNNNNNNNNNNNNJJ"
bitmap$(14) = "JJJJJJJJJJJJJJJJ"
bitmap$(15) = "JJJJJJJJJJJJJJJJ"
FOR yd = 0 TO 15
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + 230
: PSET (xd, yd + 72)
NEXT xd: NEXT yd
REM RYSUNEK DONICZKI
bitmap$(0) = "AAABCEEAAEEBCAAA"
bitmap$(1) = "BBBBEEEEEEEECBBB"
bitmap$(2) = "CCCEEEEEEEEEECCC"
bitmap$(3) = "AAAEEEEEEEEBEEAA"
bitmap$(4) = "AAEEAEAEEAEBEEAA"
bitmap$(5) = "AAEBCEBEEBEBCEAA"
bitmap$(6) = "AAEBECCEECCECEAA"
bitmap$(7) = "AAEBEAAEEAAECEAA"
bitmap$(8) = "AAABCAAEEAABCAAA"
bitmap$(9) = "BBBBCAAEEAABBBBB"
bitmap$(10) = "CCCBAAAEEAABCCCC"
bitmap$(11) = "AAABCHHHHHHBCAAA"
bitmap$(12) = "AAABCHHHHHHBCAAA"
bitmap$(13) = "AAABBBHHHHBBCAAA"
bitmap$(14) = "AAABCCHHHHCBCAAA"
bitmap$(15) = "AAABCAHHHHABCAAA"
FOR yd = 0 TO 15
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65
: PSET (xd + 16, yd + 72)
NEXT xd: NEXT yd
REM rysunek bloku
bitmap$(0) = "JJJJJJJJJJJJJJJF" + "JJJJJJJJJJJJJJJF" + "JJJJJJJJJJJJJJJF"
bitmap$(1) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(2) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(3) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(4) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(5) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(6) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(7) = "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF"
bitmap$(8) = "JJJJJJJFJJJJJJJJ" + "JJJJJJJFJJJJJJJJ" + "JJJJJJJFJJJJJJJF"
bitmap$(9) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(10) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(11) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(12) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(13) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(14) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(15) = "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF"
FOR yd = 0 TO 15
FOR xd = 0 TO 47
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + 230
: PSET (xd + 32, yd + 72)
NEXT xd: NEXT yd
COLOR 15: LOCATE 10, 16: PRINT "SERCA 1.0"
REM animacja
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)
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) = "0000088118200000" + "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)
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)
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) = "0A1A7111117A1A00"
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)
NEXT xd
NEXT yd
REM zapis do pliku
DEF SEG = &HA000
BSAVE "bitmap1.scr", 0, 50000
INPUT a$
CLS
BLOAD "bitmap1.scr"
END |
|
|
Piotr-246 |
Wysłany: Śro 4:10, 01 Wrz 2021 Temat postu: |
|
DECLARE SUB zabranie ()
REM Gra "Serca"
REM wymaga emulatora o predkosci 3300 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 ()
DIM SHARED pomoc$(0 TO 31)
DIM pamiec(0 TO 128) AS LONG
DIM SHARED plansza$(0 TO 48)
DIM SHARED kod$
DIM SHARED serca(1 TO 7, 1 TO 7) AS INTEGER
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED bitmap$(0 TO 15)
REM pamiec tla pod wziatek
DIM SHARED tlo(0 TO 32) AS LONG
REM dane elementow planszy
DIM SHARED ceg40(0 TO 640) AS LONG
DIM SHARED ceg17plus17(0 TO 640) AS LONG
DIM SHARED ceg13plus13(0 TO 640) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 640) AS LONG
DIM SHARED ceg4spc32plus4(0 TO 640) AS LONG
DIM SHARED ceg1spc38ceg1(0 TO 640) AS LONG
DIM SHARED ceg1spc39(0 TO 640) AS LONG
DIM SHARED spc39ceg1(0 TO 640) AS LONG
DIM SHARED spc40(0 TO 640) AS LONG
DIM SHARED kamienie(0 TO 64) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED blok1(0 TO 64) AS LONG
DIM SHARED blok2(0 TO 64) AS LONG
DIM SHARED blok3(0 TO 64) 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 ************************* DANE STARTOWE
SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci
x = 100: y = 60: XS = 100: YS = 60: REM wspolrzedne poczatkowe gracza na ekranie
licz = -1: REM wartosc startowa zegara
roomx = 4: roomy = 4: REM plansza startowa
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$ = plansza$(roomx - 1 + (roomy - 1) * 7)
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 15
LOCATE 25, 15: PRINT "L-SHIFT ALT P-SHIFT";
LOCATE 24, 2: COLOR 225: PRINT "T:"; t0; "/"; t1;
PRINT " ROOM:"; roomx; "/"; roomy; "--";
REM **************** ustawienie gracza na planszy
GET (x, y)-(x + 15, y + 31), pamiec
PUT (x, y), vertd1, PSET
liczsercaroom = 0
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 1800: NEXT delay
REM ************************ sprawdzenie klawiszy
alt = 0: lshift = 0: pshift = 0: skos = 0
k$ = INKEY$
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 > 301 THEN x = 4: XS = 4: roomx = roomx + 1: GOTO rysuj
IF x + dx < 2 THEN x = 301: XS = 301: roomx = roomx - 1: GOTO rysuj
IF y + dy > 149 THEN y = 4: YS = 4: roomy = roomy + 1: GOTO rysuj
IF y + dy < 2 THEN y = 147: YS = 147: 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: IF POINT(x + 19, y + i) > 200 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF dx < 0 THEN
FOR i = 0 TO 31: IF POINT(x - 3, y + i) > 200 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 ************* otworzenie tego, co bylo za ludzikiem
PUT (XS, YS), pamiec, PSET
REM ******************** czy jest wziatek
deltawx = ABS(x - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek
REM ********************* zapamietanie tego co za ludzikiem
GET (x, y)-(x + 15, y + 31), pamiec
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 PUT (x, y), vertd1, OR: XS = x: YS = y: GOTO PETLA
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 PUT (x, y), znakl1, OR
IF przebieranie = 1 THEN PUT (x, y), znakl2, OR
IF przebieranie = 2 THEN PUT (x, y), znakl3, OR
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 PUT (x, y), znakp1, OR
IF przebieranie = 1 THEN PUT (x, y), znakp2, OR
IF przebieranie = 2 THEN PUT (x, y), znakp3, OR
END IF
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
REM zabranie
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
GET (0, 0)-(319, 7), ceg40
GET (0, 8)-(319, 15), ceg17plus17
GET (0, 16)-(319, 23), ceg13plus13
GET (0, 24)-(319, 31), ceg4spc32plus4
GET (0, 32)-(319, 39), ceg4plus20plus4
GET (0, 40)-(319, 47), ceg1spc38ceg1
GET (0, 48)-(319, 55), ceg1spc39
GET (0, 56)-(319, 63), spc39ceg1
GET (0, 64)-(319, 71), spc40
GET (40, 40)-(47, 47), tlo
GET (0, 72)-(15, 87), kamienie
GET (16, 72)-(31, 87), palma
GET (32, 72)-(47, 87), blok1
GET (48, 72)-(63, 87), blok2
GET (64, 72)-(79, 87), blok3
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
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)
FOR i = 1 TO 10
OUT 66, 32: OUT 66, 2
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 32: OUT 66, 1
OUT 66, 32: OUT 66, 0
OUT 66, 104: OUT 66, 2
OUT 66, 48: OUT 66, 0
OUT 66, 250: OUT 66, 2
OUT 66, 32: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB palety
REM ****************** Ustawienie wlasnej wartosci barw
REM **************** kolejno, blue green red, kazdy max=6
REM rejestry tla - zaczyna od &H0
PALETTE 0, 10 * 65536 + 10 * 256 + 10: REM tlo sciany
PALETTE 1, 9 * 65536 + 9 * 256 + 9: REM tlo sciany
PALETTE 2, 11 * 65536 + 11 * 256 + 11: REM tlo sciany
PALETTE 3, 63 * 65536 + 31 * 256 + 0: REM blekit za oknem
PALETTE 4, 0 * 65536 + 31 * 256 + 0: REM zielen za oknem
PALETTE 5, 0 * 65536 + 0 * 256 + 63: REM czerwien serca
PALETTE 6, 47 * 65536 + 47 * 256 + 47: REM rama okienna
PALETTE 7, 3 * 65536 + 12 * 256 + 35: REM doniczka
REM rejestry gracza powinny byc kodowane &HnF od 1F
REM ze wzgledu na funkce PUT-OR
PALETTE &H1F, 0 * 65536 + 0 * 256 + 48: REM sweter
PALETTE &H2F, 63 * 65536 + 47 * 256 + 0: REM SPODNIE
PALETTE &H3F, 31 * 65536 + 31 * 256 + 31: REM SREDNIA SZAROSC
PALETTE &H4F, 15 * 65536 + 15 * 256 + 15: REM 1/4 SZAROSCI
PALETTE &H5F, 47 * 65536 + 47 * 256 + 47: REM 3/4 SZAROSCI
PALETTE &H6F, 46 * 65536 + 55 * 256 + 63: REM SKORA
PALETTE &H7F, 0 + 65536 + 0 * 256 + 31: REM pol sweter
PALETTE &H8F, 34 * 65536 + 40 * 256 + 46: REM 3/4 skora
PALETTE &H9F, 47 * 65536 + 38 * 256 + 0: REM 7/8 SPODNI
PALETTE &HAF, 0 * 65536 + 0 * 256 + 40: REM 3/4 swetra
PALETTE &HBF, 23 * 65536 + 23 * 256 + 23: REM 3/8 szarosci
PALETTE &HCF, 43 * 65536 + 43 * 256 + 51: REM 7/8 skora
REM rejestry przeszkod - powinny byc od &HFF wstecz
PALETTE &HFF, 18 * 65536 + 19 * 256 + 33: REM cegly
PALETTE &HFE, 19 * 65536 + 19 * 256 + 19: REM fugi
PALETTE &HFD, 28 * 65536 + 28 * 256 + 28: REM krawedz
FOR i = 0 TO 15
PALETTE 230 + i, i * 4 * 65536 + i * 4 * 256 + i * 4: REM kamien
NEXT i
END SUB
SUB plansze
REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** (roomy-1)*7+(roomx-1)
REM kodowanie _+++++++++++++++++++++++_okna++++_se_kw_se1_se2_nowy11+++++
REM ************ plansze wiersza roomy=1
plansza$(0) = "......................._______YQ_GN____________#LLLUQQLLLU"
plansza$(1) = ".......................____MD__________________#...UUUPPP#"
plansza$(2) = "......................._HE__________ES_________#PPPQUQQQQU"
plansza$(3) = ".......................__________SK____BB1_fB1_##LLLQWWWQ#"
plansza$(4) = "......................._______YR_______________#QPPPQQUQQU"
plansza$(5) = ".......................____MG__________LK5_____#LLLQWWQQQU"
plansza$(6) = "......................._LC__________FQ_________#PPPWQQQQUU"
REM ************ plansze wiersza roomy=2
plansza$(7) = ".......................________________________UQQQWLLLQQ#"
plansza$(8) = "......................._______YQ_RN_________WH_#QQQQ...QQ#"
plansza$(9) = ".......................____MK__________KK1__WJ_UUQQQPPPUQU"
plansza$(10) = "......................._____________MS_________#WLLLWQQQQW"
plansza$(11) = "......................._aI__________________UM_UQPPPQQQQQ#"
plansza$(12) = ".......................__________RN_FS_________UQQQ000QQQ#"
plansza$(13) = ".......................____DJ____aM____________UUUUQQQUUUU"
REM ************* plansze wiersza roomy=3
plansza$(14) = ".......................__________NG_YS_________#QQQWQWQQQW"
plansza$(15) = "......................._MC_YP____UP____________#QQQWLLLLQW"
plansza$(16) = "......................._WR_____________DI3_`I3_U0000....0#"
plansza$(17) = "......................._MM__________YQ_________WWWWWPPPPUU"
plansza$(18) = "......................._______NP_SM_________WO_#QQQQMWMQQW"
plansza$(19) = ".......................________________EB1__UJ_#00QQLLL0QU"
plansza$(20) = ".......................____aM____UP____________UQQQWPPP0##"
REM ************ plansze wiersza roomy=4
plansza$(21) = ".......................____YK____SG____________WQQQWLLLLUU"
plansza$(22) = ".......................________________________WHHHWPPPP##"
plansza$(23) = "......................._______NP_UQ_YS_RU3_____#0QLLLQQQQW"
plansza$(24) = "......................._YF_YJ_YO_SK_GS_GB5__WM_UUQPPPQQQQU": REM startowa MaX=dU
plansza$(25) = ".......................__________NG____________#QQQQWQQQQU"
plansza$(26) = "......................._______YR_SG____________UUQQQWLLLLU"
plansza$(27) = "......................._____________LS_KK1_____##00UUPPPPU"
REM ****************** plansze wiersza roomy=5
plansza$(28) = "......................._DD____aR_SS_YS_________ULLLWWWLLL#"
plansza$(29) = ".......................________________II4_YI4_#...UUU...#"
plansza$(30) = "......................._______aR_______GL5_YL5_WPPPQUUPPPU"
plansza$(31) = ".......................____ML_______OS_________UUQQULLLQQ#"
plansza$(32) = ".......................____YL__________________UQQQWPPP###"
plansza$(33) = ".......................________________KR1_____UU00U000UUU"
plansza$(34) = ".......................____OG____SR_FS_________UU0QQQWQQQ#"
REM ******************* plansze wiersza roomy=6
plansza$(35) = "......................._____________KM_________#00ULLLU0UU"
plansza$(36) = ".......................__________SR____MH2_YH2_###UPPPLLL#"
plansza$(37) = "......................._______GQ_______________U0QQQQW...#"
plansza$(38) = "......................._____________ZS_________#LLLU00PPP#"
plansza$(39) = ".......................__________MM_________0Q_#PPPWLLLQQ#"
plansza$(40) = ".......................________________KO3_YO3_UUUU0PPPUUU"
plansza$(41) = "......................._CC_______ZF_MS_________#QQQWQQQ00U"
REM ******************* plansze wiersza roomy=7
plansza$(42) = "......................._EI__________YM_________UUU0LLL####"
plansza$(43) = ".......................____SJ____ML____________###U...####"
plansza$(44) = "......................._____________KM_________#LLLPPP####"
plansza$(45) = ".......................____PH____ZJ____________#PPP000####"
plansza$(46) = ".......................__________EE____________#LLL0######"
plansza$(47) = "......................._____________FT______0I_UPPPQQQLLL#"
plansza$(48) = "......................._LR_____________________UUUUUUUPPP#"
REM lokalizacja serc
REM serca wiersza 1
serca(1, 1) = 1
serca(4, 1) = 1
REM serca wiersza 2
serca(2, 2) = 1
serca(6, 2) = 1
serca(7, 2) = 1
REM serca wiersza 3
serca(1, 3) = 1
serca(2, 3) = 1
serca(5, 3) = 1
serca(7, 3) = 1
REM serca wiersza 4
serca(1, 4) = 1
serca(3, 4) = 1
serca(4, 4) = 1
serca(5, 4) = 1
serca(6, 4) = 1
REM serca wiersza 5
serca(1, 5) = 1
serca(7, 5) = 1
REM serca wiersza 6
serca(2, 6) = 1
serca(5, 6) = 1
serca(7, 6) = 1
REM serca wiersza 7
serca(2, 7) = 1
serca(4, 7) = 1
serca(5, 7) = 1
END SUB
SUB rysowanie
REM rysowanie tla
FOR i = 0 TO 22
PUT (0, i * 8), spc40, PSET
NEXT i
REM rysowanie podestow
el$ = MID$(kod$, 45, 1)
IF el$ = "" OR el$ = "_" THEN GOTO bloki
el2$ = MID$(kod$, 46, 1)
yokna = (ASC(el2$) - 65) * 8
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
bloki:
REM rysowanie blokow
FOR yw = 0 TO 10
el$ = MID$(kod$, yw + 48, 1)
y16 = yw * 16
IF el$ = "#" THEN
FOR xw = 0 TO 19: PUT (xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "U" THEN
FOR xw = 0 TO 6: PUT (xw * 16, y16), blok2, PSET: NEXT xw
PUT (112, y16), blok3, PSET
PUT (192, y16), blok1, PSET
FOR xw = 0 TO 6: PUT (208 + xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "0" THEN
FOR xw = 0 TO 3: PUT (xw * 16, y16), blok2, PSET: NEXT xw
PUT (64, y16), blok3, PSET
PUT (240, y16), blok1, PSET
FOR xw = 0 TO 3: PUT (256 + xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "W" THEN
PUT (0, y16), blok2, PSET
PUT (16, y16), blok3, PSET
FOR xw = 0 TO 8: PUT (xw * 16 + 88, y16), blok2, PSET: NEXT xw
PUT (72, y16), blok1, PSET
PUT (232, y16), blok3, PSET
PUT (288, y16), blok1, PSET
PUT (304, y16), blok2, PSET
END IF
IF el$ = "Q" THEN PUT (0, y16), blok3, PSET: PUT (304, y16), blok1, PSET
REM wycofane IF el$ = "H" THEN PUT (0, y16), blok1, PSET
IF el$ = "L" THEN PUT (0, y16), blok3, PSET
IF el$ = "P" THEN PUT (304, y16), blok1, PSET
IF el$ = "." THEN REM PUT (0, y16), spc40, PSET
NEXT yw
REM rysowanie okien
el$ = MID$(kod$, 25, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknonz
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 26, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 3, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknonz:
REM okno niebiesko-zielone
el$ = MID$(kod$, 28, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknoziel
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 29, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 11), 3, BF
LINE (xokna + 2, yokna + 12)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknoziel:
REM okno niebiesko-zielone
el$ = MID$(kod$, 31, 1)
IF el$ = "" OR el$ = "_" THEN GOTO serce
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 32, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
serce:
REM serce
xserca = -20
yokna = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 34, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 35, 1)
yokna = (ASC(el$) - 65) * 8
GET (xokna + 8, yokna + 8)-(xokna + 15 + 8, yokna + 7 + 8), tlo
COLOR 5: LOCATE yokna / 8, xokna / 8: PRINT CHR$(3);
xserca = xokna - 8
yserca = yokna - 8
donica:
el$ = MID$(kod$, 37, 1)
IF el$ = "" OR el$ = "_" THEN GOTO koniecrysowania
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 38, 1)
yokna = (ASC(el$) - 65) * 8
PUT (xokna, yokna), palma, 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 3000: NEXT i
OUT 66, 204: OUT 66, 4
FOR i = 1 TO 3000: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB |
|
|
Piotr-246 |
Wysłany: Wto 20:39, 31 Sie 2021 Temat postu: |
|
DECLARE SUB zabranie ()
REM Gra "Serca"
REM wymaga emulatora o predkosci 3300 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 ()
DIM SHARED pomoc$(0 TO 31)
DIM pamiec(0 TO 128) AS LONG
DIM SHARED plansza$(0 TO 48)
DIM SHARED kod$
DIM SHARED serca(1 TO 7, 1 TO 7) AS INTEGER
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED bitmap$(0 TO 15)
REM pamiec tla pod wziatek
DIM SHARED tlo(0 TO 32) AS LONG
REM dane elementow planszy
DIM SHARED ceg40(0 TO 640) AS LONG
DIM SHARED ceg17plus17(0 TO 640) AS LONG
DIM SHARED ceg13plus13(0 TO 640) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 640) AS LONG
DIM SHARED ceg4spc32plus4(0 TO 640) AS LONG
DIM SHARED ceg1spc38ceg1(0 TO 640) AS LONG
DIM SHARED ceg1spc39(0 TO 640) AS LONG
DIM SHARED spc39ceg1(0 TO 640) AS LONG
DIM SHARED spc40(0 TO 640) AS LONG
DIM SHARED kamienie(0 TO 64) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED blok1(0 TO 64) AS LONG
DIM SHARED blok2(0 TO 64) AS LONG
DIM SHARED blok3(0 TO 64) 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 ************************* DANE STARTOWE
SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci
x = 100: y = 60: XS = 100: YS = 60: REM wspolrzedne poczatkowe gracza na ekranie
licz = -1: REM wartosc startowa zegara
roomx = 4: roomy = 4: REM plansza startowa
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$ = plansza$(roomx - 1 + (roomy - 1) * 7)
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 15
LOCATE 25, 15: PRINT "L-SHIFT ALT P-SHIFT";
LOCATE 24, 2: COLOR 225: PRINT "T:"; t0; "/"; t1;
PRINT " ROOM:"; roomx; "/"; roomy; "--";
REM **************** ustawienie gracza na planszy
GET (x, y)-(x + 15, y + 31), pamiec
PUT (x, y), vertd1, PSET
liczsercaroom = 0
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 1800: NEXT delay
REM ************************ sprawdzenie klawiszy
alt = 0: lshift = 0: pshift = 0: skos = 0
k$ = INKEY$
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 > 301 THEN x = 4: XS = 4: roomx = roomx + 1: GOTO rysuj
IF x + dx < 2 THEN x = 301: XS = 301: roomx = roomx - 1: GOTO rysuj
IF y + dy > 149 THEN y = 4: YS = 4: roomy = roomy + 1: GOTO rysuj
IF y + dy < 2 THEN y = 147: YS = 147: 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: IF POINT(x + 19, y + i) > 200 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF dx < 0 THEN
FOR i = 0 TO 31: IF POINT(x - 3, y + i) > 200 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 ************* otworzenie tego, co bylo za ludzikiem
PUT (XS, YS), pamiec, PSET
REM ******************** czy jest wziatek
deltawx = ABS(x - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek
REM ********************* zapamietanie tego co za ludzikiem
GET (x, y)-(x + 15, y + 31), pamiec
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 PUT (x, y), vertd1, OR: XS = x: YS = y: GOTO PETLA
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 PUT (x, y), znakl1, OR
IF przebieranie = 1 THEN PUT (x, y), znakl2, OR
IF przebieranie = 2 THEN PUT (x, y), znakl3, OR
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 PUT (x, y), znakp1, OR
IF przebieranie = 1 THEN PUT (x, y), znakp2, OR
IF przebieranie = 2 THEN PUT (x, y), znakp3, OR
END IF
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
REM zabranie
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
GET (0, 0)-(319, 7), ceg40
GET (0, 8)-(319, 15), ceg17plus17
GET (0, 16)-(319, 23), ceg13plus13
GET (0, 24)-(319, 31), ceg4spc32plus4
GET (0, 32)-(319, 39), ceg4plus20plus4
GET (0, 40)-(319, 47), ceg1spc38ceg1
GET (0, 48)-(319, 55), ceg1spc39
GET (0, 56)-(319, 63), spc39ceg1
GET (0, 64)-(319, 71), spc40
GET (40, 40)-(47, 47), tlo
GET (0, 72)-(15, 87), kamienie
GET (16, 72)-(31, 87), palma
GET (32, 72)-(47, 87), blok1
GET (48, 72)-(63, 87), blok2
GET (64, 72)-(79, 87), blok3
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
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)
FOR i = 1 TO 10
OUT 66, 32: OUT 66, 2
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 32: OUT 66, 1
OUT 66, 32: OUT 66, 0
OUT 66, 104: OUT 66, 2
OUT 66, 48: OUT 66, 0
OUT 66, 250: OUT 66, 2
OUT 66, 32: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB palety
REM ****************** Ustawienie wlasnej wartosci barw
REM **************** kolejno, blue green red, kazdy max=6
REM rejestry tla - zaczyna od &H0
PALETTE 0, 10 * 65536 + 10 * 256 + 10: REM tlo sciany
PALETTE 1, 9 * 65536 + 9 * 256 + 9: REM tlo sciany
PALETTE 2, 11 * 65536 + 11 * 256 + 11: REM tlo sciany
PALETTE 3, 63 * 65536 + 31 * 256 + 0: REM blekit za oknem
PALETTE 4, 0 * 65536 + 31 * 256 + 0: REM zielen za oknem
PALETTE 5, 0 * 65536 + 0 * 256 + 63: REM czerwien serca
PALETTE 6, 47 * 65536 + 47 * 256 + 47: REM rama okienna
PALETTE 7, 3 * 65536 + 12 * 256 + 35: REM doniczka
REM rejestry gracza powinny byc kodowane &HnF od 1F
REM ze wzgledu na funkce PUT-OR
PALETTE &H1F, 0 * 65536 + 0 * 256 + 48: REM sweter
PALETTE &H2F, 63 * 65536 + 47 * 256 + 0: REM SPODNIE
PALETTE &H3F, 31 * 65536 + 31 * 256 + 31: REM SREDNIA SZAROSC
PALETTE &H4F, 15 * 65536 + 15 * 256 + 15: REM 1/4 SZAROSCI
PALETTE &H5F, 47 * 65536 + 47 * 256 + 47: REM 3/4 SZAROSCI
PALETTE &H6F, 46 * 65536 + 55 * 256 + 63: REM SKORA
PALETTE &H7F, 0 + 65536 + 0 * 256 + 31: REM pol sweter
PALETTE &H8F, 34 * 65536 + 40 * 256 + 46: REM 3/4 skora
PALETTE &H9F, 47 * 65536 + 38 * 256 + 0: REM 7/8 SPODNI
PALETTE &HAF, 0 * 65536 + 0 * 256 + 40: REM 3/4 swetra
PALETTE &HBF, 23 * 65536 + 23 * 256 + 23: REM 3/8 szarosci
PALETTE &HCF, 43 * 65536 + 43 * 256 + 51: REM 7/8 skora
REM rejestry przeszkod - powinny byc od &HFF wstecz
PALETTE &HFF, 18 * 65536 + 19 * 256 + 33: REM cegly
PALETTE &HFE, 19 * 65536 + 19 * 256 + 19: REM fugi
PALETTE &HFD, 28 * 65536 + 28 * 256 + 28: REM krawedz
FOR i = 0 TO 15
PALETTE 230 + i, i * 4 * 65536 + i * 4 * 256 + i * 4: REM kamien
NEXT i
END SUB
SUB plansze
REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** (roomy-1)*7+(roomx-1)
REM kodowanie _+++++++++++++++++++++++_okna++++_se_kw_se1_se2_nowy11+++++
REM ************ plansze wiersza roomy=1
plansza$(0) = "......................._______YQ_GN____________#LLLUQQLLLU"
plansza$(1) = ".......................____MD__________________#...UUUPPP#"
plansza$(2) = "......................._HE__________ES_________#PPPQUQQQQU"
plansza$(3) = ".......................__________SK____BB1_fB1_##LLLQWWWQ#"
plansza$(4) = "......................._______YR_______________#QPPPQQUQQU"
plansza$(5) = ".......................____MG__________LK5_____#LLLQWWQQQU"
plansza$(6) = "......................._LC__________FQ_________#PPPWQQQQUU"
REM ************ plansze wiersza roomy=2
plansza$(7) = ".......................________________________UQQQWLLLQQ#"
plansza$(8) = ".......W..............._______YQ_RN____________#QQQQ...QQ#"
plansza$(9) = ".........W.............____MK__________KK1_____UUQQQPPPUQU"
plansza$(10) = "......................._____________MS_________#WLLLWQQQQW"
plansza$(11) = "............U.........._aI_____________________UQPPPQQQQQ#"
plansza$(12) = ".......................__________RN_FS_________UQQQ000QQQ#"
plansza$(13) = ".......................____DJ____aM____________UUUUQQQUUUU"
REM ************* plansze wiersza roomy=3
plansza$(14) = ".......................__________NG_YS_________#QQQWQWQQQW"
plansza$(15) = "......................._MC_YP____UP____________#QQQWLLLLQW"
plansza$(16) = "......................._WR_____________DI3_`I3_U0000....0#"
plansza$(17) = "......................._MM__________YQ_________WWWWWPPPPUU"
plansza$(18) = "..............W........_______NP_SM____________#QQQQMWMQQW"
plansza$(19) = ".........U.............________________EB1_____#00QQLLL0QU"
plansza$(20) = ".......................____aM____UP____________UQQQWPPP0##"
REM ************ plansze wiersza roomy=4
plansza$(21) = ".......................____YK____SG____________WQQQWLLLLUU"
plansza$(22) = ".......................________________________WHHHWPPPP##"
plansza$(23) = "......................._______NP_UQ_YS_RU3_____#0QLLLQQQQW"
plansza$(24) = "............W.........._YF_YJ_YO_SK_GS_GB5_YB5_UUQPPPQQQQU": REM startowa MaX=dU
plansza$(25) = ".......................__________NG____________#QQQQWQQQQU"
plansza$(26) = "......................._______YR_SG____________UUQQQWLLLLU"
plansza$(27) = "......................._____________LS_KK1_____##00UUPPPPU"
REM ****************** plansze wiersza roomy=5
plansza$(28) = "......................._DD____aR_SS_YS_________ULLLWWWLLL#"
plansza$(29) = ".......................________________II4_YI4_#...UUU...#"
plansza$(30) = "......................._______aR_______GL5_YL5_WPPPQUUPPPU"
plansza$(31) = ".......................____ML_______OS_________UUQQULLLQQ#"
plansza$(32) = ".......................____YL__________________UQQQWPPP###"
plansza$(33) = ".......................________________KR1_____UU00U000UUU"
plansza$(34) = ".......................____OG____SR_FS_________UU0QQQWQQQ#"
REM ******************* plansze wiersza roomy=6
plansza$(35) = "......................._____________KM_________#00ULLLU0UU"
plansza$(36) = ".......................__________SR____MH2_YH2_###UPPPLLL#"
plansza$(37) = "......................._______GQ_______________U0QQQQW...#"
plansza$(38) = "......................._____________ZS_________#LLLU00PPP#"
plansza$(39) = "................0......__________MM____________#PPPWLLLQQ#"
plansza$(40) = ".......................________________KO3_YO3_UUUU0PPPUUU"
plansza$(41) = "......................._CC_______ZF_MS_________#QQQWQQQ00U"
REM ******************* plansze wiersza roomy=7
plansza$(42) = "......................._EI__________YM_________UUU0LLL####"
plansza$(43) = ".......................____SJ____ML____________###U...####"
plansza$(44) = "......................._____________KM_________#LLLPPP####"
plansza$(45) = ".......................____PH____ZJ____________#PPP000####"
plansza$(46) = ".......................__________EE____________#LLL0######"
plansza$(47) = "........0.............._____________FT_________UPPPQQQLLL#"
plansza$(48) = "......................._LR_____________________UUUUUUUPPP#"
REM lokalizacja serc
REM serca wiersza 1
serca(1, 1) = 1
serca(4, 1) = 1
REM serca wiersza 2
serca(2, 2) = 1
serca(6, 2) = 1
serca(7, 2) = 1
REM serca wiersza 3
serca(1, 3) = 1
serca(2, 3) = 1
serca(5, 3) = 1
serca(7, 3) = 1
REM serca wiersza 4
serca(1, 4) = 1
serca(3, 4) = 1
serca(4, 4) = 1
serca(5, 4) = 1
serca(6, 4) = 1
REM serca wiersza 5
serca(1, 5) = 1
serca(7, 5) = 1
REM serca wiersza 6
serca(2, 6) = 1
serca(5, 6) = 1
serca(7, 6) = 1
REM serca wiersza 7
serca(2, 7) = 1
serca(4, 7) = 1
serca(5, 7) = 1
END SUB
SUB rysowanie
FOR i = 0 TO 22
el$ = MID$(kod$, i + 1, 1)
IF el$ = "#" THEN PUT (0, i * 8), ceg40, PSET
IF el$ = "U" THEN PUT (0, i * 8), ceg17plus17, PSET
IF el$ = "0" THEN PUT (0, i * 8), ceg13plus13, PSET
IF el$ = "W" THEN PUT (0, i * 8), ceg4plus20plus4, PSET
IF el$ = "Q" THEN PUT (0, i * 8), ceg4spc32plus4, PSET
IF el$ = "H" THEN PUT (0, i * 8), ceg1spc38ceg1, PSET
IF el$ = "L" THEN PUT (0, i * 8), ceg1spc39, PSET
IF el$ = "P" THEN PUT (0, i * 8), spc39ceg1, PSET
IF el$ = "." THEN PUT (0, i * 8), spc40, PSET
NEXT i
FOR yw = 0 TO 10
el$ = MID$(kod$, yw + 48, 1)
y16 = yw * 16
IF el$ = "#" THEN
FOR xw = 0 TO 19: PUT (xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "U" THEN
FOR xw = 0 TO 6: PUT (xw * 16, y16), blok2, PSET: NEXT xw
PUT (112, y16), blok3, PSET
PUT (192, y16), blok1, PSET
FOR xw = 0 TO 6: PUT (208 + xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "0" THEN
FOR xw = 0 TO 3: PUT (xw * 16, y16), blok2, PSET: NEXT xw
PUT (64, y16), blok3, PSET
PUT (240, y16), blok1, PSET
FOR xw = 0 TO 3: PUT (256 + xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "W" THEN
PUT (0, y16), blok2, PSET
PUT (16, y16), blok3, PSET
FOR xw = 0 TO 8: PUT (xw * 16 + 88, y16), blok2, PSET: NEXT xw
PUT (72, y16), blok1, PSET
PUT (232, y16), blok3, PSET
PUT (288, y16), blok1, PSET
PUT (304, y16), blok2, PSET
END IF
IF el$ = "Q" THEN PUT (0, y16), blok3, PSET: PUT (304, y16), blok1, PSET
REM wycofane IF el$ = "H" THEN PUT (0, y16), blok1, PSET
IF el$ = "L" THEN PUT (0, y16), blok3, PSET
IF el$ = "P" THEN PUT (304, y16), blok1, PSET
IF el$ = "." THEN REM PUT (0, y16), spc40, PSET
NEXT yw
REM rysowanie okien
el$ = MID$(kod$, 25, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknonz
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 26, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 3, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknonz:
REM okno niebiesko-zielone
el$ = MID$(kod$, 28, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknoziel
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 29, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 11), 3, BF
LINE (xokna + 2, yokna + 12)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknoziel:
REM okno niebiesko-zielone
el$ = MID$(kod$, 31, 1)
IF el$ = "" OR el$ = "_" THEN GOTO serce
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 32, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
serce:
REM serce
xserca = -20
yokna = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 34, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 35, 1)
yokna = (ASC(el$) - 65) * 8
GET (xokna + 8, yokna + 8)-(xokna + 15 + 8, yokna + 7 + 8), tlo
COLOR 5: LOCATE yokna / 8, xokna / 8: PRINT CHR$(3);
xserca = xokna - 8
yserca = yokna - 8
donica:
el$ = MID$(kod$, 37, 1)
IF el$ = "" OR el$ = "_" THEN GOTO kamien
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 38, 1)
yokna = (ASC(el$) - 65) * 8
PUT (xokna, yokna), palma, PSET
kamien:
el$ = MID$(kod$, 40, 1)
IF el$ = "" OR el$ = "_" THEN GOTO drugaseria
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 41, 1)
yokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 42, 1)
ilex = (ASC(el$) - 48)
REM FOR i = 1 TO ilex
REM IF i = 1 AND ilex > 1 THEN PUT (xokna + 16 * (i - 1), yokna), blok1, PSET
REM IF i = ilex AND ilex > 1 THEN PUT (xokna + 16 * (i - 1), yokna), blok3, PSET
REM IF i <> 1 AND i <> ilex THEN PUT (xokna + 16 * (i - 1), yokna), blok2, PSET
REM NEXT i
drugaseria:
el$ = MID$(kod$, 44, 1)
IF el$ = "" OR el$ = "_" THEN GOTO koniecrysowania
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 45, 1)
yokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 46, 1)
ilex = (ASC(el$) - 48)
REM FOR i = 1 TO ilex
REM PUT (xokna + 16 * (i - 1), yokna), kamienie, PSET
REM NEXT i
REM FOR i = 1 TO ilex
REM IF i = 1 AND ilex > 1 THEN PUT (xokna + 16 * (i - 1), yokna), blok1, PSET
REM IF i = ilex AND ilex > 1 THEN PUT (xokna + 16 * (i - 1), yokna), blok3, PSET
REM IF i <> 1 AND i <> ilex THEN PUT (xokna + 16 * (i - 1), yokna), blok2, PSET
REM NEXT i
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 3000: NEXT i
OUT 66, 204: OUT 66, 4
FOR i = 1 TO 3000: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB |
|
|
Piotr-246 |
Wysłany: Wto 20:39, 31 Sie 2021 Temat postu: |
|
REM modul BSAVE do gry "Serca"
SCREEN 13
FOR j = 0 TO 15
FOR i = 0 TO 15
PALETTE i + j * 16, INT(RND(1) * 63) + 256 * INT(RND(1) * 63)
NEXT i: NEXT j
DIM cegla(0 TO 32) AS LONG
DIM tlo(0 TO 32) AS LONG
DIM poltlo(0 TO 16) AS LONG
DIM bitmap$(0 TO 31)
REM rysunek cegly
bitmap$(0) = "DDDDDDDEDDDDDDDE"
bitmap$(1) = "DFFFFFFEDFFFFFFE"
bitmap$(2) = "DFFFFFFEDFFFFFFE"
bitmap$(3) = "EEEEEEEEEEEEEEEE"
bitmap$(4) = "DDDEDDDDDDDDDDDD"
bitmap$(5) = "FFFEDFFFFFFFFFFF"
bitmap$(6) = "FFFEDFFFFFFFFFFF"
bitmap$(7) = "EEEEEEEEEEEEEEEE"
REM 250-A 251-B 252-C 253-D 254-E 255-F
FOR yd = 0 TO 7
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + &HF0 + 10
: PSET (xd, yd)
NEXT xd: NEXT yd
GET (0, 0)-(15, 7), 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"
FOR yd = 0 TO 7
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 48
: PSET (xd, yd)
NEXT xd: NEXT yd
GET (0, 0)-(15, 7), tlo
REM przygotowanie tablic elementow wierszowych
CLS
FOR x = 0 TO 19
FOR y = 0 TO 10
PUT (x * 16, y * 8), 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 8
PUT (i * 16, 8), cegla, PSET
PUT (304 - i * 16, 8), cegla, PSET
NEXT i
FOR i = 0 TO 4
PUT (i * 16, 16), cegla, PSET
PUT (304 - i * 16, 16), cegla, PSET
NEXT i
FOR i = 0 TO 0
PUT (i * 16, 24), cegla, PSET
PUT (304 - i * 16, 24), cegla, PSET
NEXT i
FOR i = 0 TO 2
PUT (i * 16, 32), cegla, PSET
PUT (304 - i * 16, 32), cegla, PSET
NEXT i
FOR i = 0 TO 9
PUT (i * 16 + 80, 32), cegla, PSET
NEXT i
PUT (0, 40), cegla, PSET
PUT (304, 40), cegla, PSET
PUT (0, 48), cegla, PSET
PUT (304, 56), cegla, PSET
REM poszerzenie przejsc pionowych
GET (8, 64)-(15, 71), poltlo
PUT (136, 8), poltlo, PSET
PUT (40, 32), poltlo, PSET
GET (0, 64)-(7, 71), poltlo
PUT (176, 8), poltlo, PSET
PUT (272, 32), poltlo, PSET
REM wykonczenie cegiel
COLOR 254: REM szczeliny
LINE (135, 8)-(135, 15)
LINE (79, 16)-(79, 23)
LINE (15, 24)-(15, 31)
LINE (39, 32)-(39, 39)
LINE (239, 32)-(239, 39)
LINE (15, 40)-(15, 47)
LINE (15, 48)-(15, 55)
COLOR 253: REM krawedzie
LINE (184, 12)-(184, 14)
LINE (240, 21)-(240, 22)
LINE (304, 28)-(304, 30)
LINE (80, 36)-(80, 38)
LINE (280, 36)-(280, 38)
LINE (304, 44)-(304, 46)
LINE (304, 62)-(304, 60)
REM RYSUNEK kamienia
bitmap$(0) = "JJJJJJJJJJJJJJJJ"
bitmap$(1) = "JJNNNNNNNNNNNNJJ"
bitmap$(2) = "JJNAAAKJPKAAANJJ"
bitmap$(3) = "JJNAKONPNKPKANJJ"
bitmap$(4) = "JJNAPMKLGLMPANJJ"
bitmap$(5) = "JJNKJOJKPJPKMNJJ"
bitmap$(6) = "JJNOLJKJJMKMJNJJ"
bitmap$(7) = "JJNJFMJOHKNIPNJJ"
bitmap$(8) = "JJNJILJLJHIJHNJJ"
bitmap$(9) = "JJNIHJNOHOJJKNJJ"
bitmap$(10) = "JJNAJIIHJOMPANJJ"
bitmap$(11) = "JJNAINNJLJOKANJJ"
bitmap$(12) = "JJNAAAIKJKAAANJJ"
bitmap$(13) = "JJNNNNNNNNNNNNJJ"
bitmap$(14) = "JJJJJJJJJJJJJJJJ"
bitmap$(15) = "JJJJJJJJJJJJJJJJ"
FOR yd = 0 TO 15
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + 230
: PSET (xd, yd + 72)
NEXT xd: NEXT yd
REM RYSUNEK DONICZKI
bitmap$(0) = "AAABCEEAAEEBCAAA"
bitmap$(1) = "BBBBEEEEEEEECBBB"
bitmap$(2) = "CCCEEEEEEEEEECCC"
bitmap$(3) = "AAAEEEEEEEEBEEAA"
bitmap$(4) = "AAEEAEAEEAEBEEAA"
bitmap$(5) = "AAEBCEBEEBEBCEAA"
bitmap$(6) = "AAEBECCEECCECEAA"
bitmap$(7) = "AAEBEAAEEAAECEAA"
bitmap$(8) = "AAABCAAEEAABCAAA"
bitmap$(9) = "BBBBCAAEEAABBBBB"
bitmap$(10) = "CCCBAAAEEAABCCCC"
bitmap$(11) = "AAABCHHHHHHBCAAA"
bitmap$(12) = "AAABCHHHHHHBCAAA"
bitmap$(13) = "AAABBBHHHHBBCAAA"
bitmap$(14) = "AAABCCHHHHCBCAAA"
bitmap$(15) = "AAABCAHHHHABCAAA"
FOR yd = 0 TO 15
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65
: PSET (xd + 16, yd + 72)
NEXT xd: NEXT yd
REM rysunek bloku
bitmap$(0) = "JJJJJJJJJJJJJJJF" + "JJJJJJJJJJJJJJJF" + "JJJJJJJJJJJJJJJF"
bitmap$(1) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(2) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(3) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(4) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(5) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(6) = "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF" + "KHHHHHHHHHHHHHHF"
bitmap$(7) = "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF"
bitmap$(8) = "JJJJJJJFJJJJJJJJ" + "JJJJJJJFJJJJJJJJ" + "JJJJJJJFJJJJJJJF"
bitmap$(9) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(10) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(11) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(12) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(13) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(14) = "KHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHH" + "HHHHHHHFKHHHHHHF"
bitmap$(15) = "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF"
FOR yd = 0 TO 15
FOR xd = 0 TO 47
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + 230
: PSET (xd + 32, yd + 72)
NEXT xd: NEXT yd
COLOR 15: LOCATE 10, 16: PRINT "SERCA 1.0"
REM animacja
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)
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) = "0000088118200000" + "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)
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)
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) = "0A1A7111117A1A00"
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)
NEXT xd
NEXT yd
REM zapis do pliku
DEF SEG = &HA000
BSAVE "bitmap1.scr", 0, 50000
INPUT a$
CLS
BLOAD "bitmap1.scr"
END |
|
|
Piotr-246 |
Wysłany: Wto 17:58, 31 Sie 2021 Temat postu: |
|
DECLARE SUB zabranie ()
REM Gra "Serca"
REM wymaga emulatora o predkosci 3300 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 ()
DIM SHARED pomoc$(0 TO 31)
DIM pamiec(0 TO 128) AS LONG
DIM SHARED plansza$(0 TO 48)
DIM SHARED kod$
DIM SHARED serca(1 TO 7, 1 TO 7) AS INTEGER
DIM SHARED roomx AS INTEGER, roomy AS INTEGER
DIM SHARED xserca AS INTEGER, yserca AS INTEGER
DIM SHARED bitmap$(0 TO 15)
REM pamiec tla pod wziatek
DIM SHARED tlo(0 TO 32) AS LONG
REM dane elementow planszy
DIM SHARED ceg40(0 TO 640) AS LONG
DIM SHARED ceg17plus17(0 TO 640) AS LONG
DIM SHARED ceg13plus13(0 TO 640) AS LONG
DIM SHARED ceg4plus20plus4(0 TO 640) AS LONG
DIM SHARED ceg4spc32plus4(0 TO 640) AS LONG
DIM SHARED ceg1spc38ceg1(0 TO 640) AS LONG
DIM SHARED ceg1spc39(0 TO 640) AS LONG
DIM SHARED spc39ceg1(0 TO 640) AS LONG
DIM SHARED spc40(0 TO 640) AS LONG
DIM SHARED kamienie(0 TO 64) AS LONG
DIM SHARED palma(0 TO 64) AS LONG
DIM SHARED blok1(0 TO 64) AS LONG
DIM SHARED blok2(0 TO 64) AS LONG
DIM SHARED blok3(0 TO 64) 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 ************************* DANE STARTOWE
SCREEN 13
DEF SEG = 0: REM - to dla pomiaru predkosci
x = 100: y = 60: XS = 100: YS = 60: REM wspolrzedne poczatkowe gracza na ekranie
licz = -1: REM wartosc startowa zegara
roomx = 4: roomy = 4: REM plansza startowa
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$ = plansza$(roomx - 1 + (roomy - 1) * 7)
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 15
LOCATE 25, 15: PRINT "L-SHIFT ALT P-SHIFT";
LOCATE 24, 2: COLOR 225: PRINT "T:"; t0; "/"; t1;
PRINT " ROOM:"; roomx; "/"; roomy; "--";
REM **************** ustawienie gracza na planszy
GET (x, y)-(x + 15, y + 31), pamiec
PUT (x, y), vertd1, PSET
liczsercaroom = 0
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 1800: NEXT delay
REM ************************ sprawdzenie klawiszy
alt = 0: lshift = 0: pshift = 0: skos = 0
k$ = INKEY$
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 > 301 THEN x = 4: XS = 4: roomx = roomx + 1: GOTO rysuj
IF x + dx < 2 THEN x = 301: XS = 301: roomx = roomx - 1: GOTO rysuj
IF y + dy > 149 THEN y = 4: YS = 4: roomy = roomy + 1: GOTO rysuj
IF y + dy < 2 THEN y = 147: YS = 147: 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: IF POINT(x + 19, y + i) > 200 THEN xniemozliwy = 1: EXIT FOR
NEXT i
END IF
IF dx < 0 THEN
FOR i = 0 TO 31: IF POINT(x - 3, y + i) > 200 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 ************* otworzenie tego, co bylo za ludzikiem
PUT (XS, YS), pamiec, PSET
REM ******************** czy jest wziatek
deltawx = ABS(x - xserca)
deltawy = ABS(y + 16 - yserca)
IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek
REM ********************* zapamietanie tego co za ludzikiem
GET (x, y)-(x + 15, y + 31), pamiec
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 PUT (x, y), vertd1, OR: XS = x: YS = y: GOTO PETLA
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 PUT (x, y), znakl1, OR
IF przebieranie = 1 THEN PUT (x, y), znakl2, OR
IF przebieranie = 2 THEN PUT (x, y), znakl3, OR
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 PUT (x, y), znakp1, OR
IF przebieranie = 1 THEN PUT (x, y), znakp2, OR
IF przebieranie = 2 THEN PUT (x, y), znakp3, OR
END IF
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
REM zabranie
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
GET (0, 0)-(319, 7), ceg40
GET (0, 8)-(319, 15), ceg17plus17
GET (0, 16)-(319, 23), ceg13plus13
GET (0, 24)-(319, 31), ceg4spc32plus4
GET (0, 32)-(319, 39), ceg4plus20plus4
GET (0, 40)-(319, 47), ceg1spc38ceg1
GET (0, 48)-(319, 55), ceg1spc39
GET (0, 56)-(319, 63), spc39ceg1
GET (0, 64)-(319, 71), spc40
GET (40, 40)-(47, 47), tlo
GET (0, 72)-(15, 87), kamienie
GET (16, 72)-(31, 87), palma
GET (32, 72)-(47, 87), blok1
GET (48, 72)-(63, 87), blok2
GET (64, 72)-(79, 87), blok3
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
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)
FOR i = 1 TO 10
OUT 66, 32: OUT 66, 2
OUT 66, 64: OUT 66, 1
OUT 66, 250: OUT 66, 0
OUT 66, 32: OUT 66, 1
OUT 66, 32: OUT 66, 0
OUT 66, 104: OUT 66, 2
OUT 66, 48: OUT 66, 0
OUT 66, 250: OUT 66, 2
OUT 66, 32: OUT 66, 0
NEXT i
REM FOR i = 1 TO 150: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB
SUB palety
REM ****************** Ustawienie wlasnej wartosci barw
REM **************** kolejno, blue green red, kazdy max=6
REM rejestry tla - zaczyna od &H0
PALETTE 0, 10 * 65536 + 10 * 256 + 10: REM tlo sciany
PALETTE 1, 9 * 65536 + 9 * 256 + 9: REM tlo sciany
PALETTE 2, 11 * 65536 + 11 * 256 + 11: REM tlo sciany
PALETTE 3, 63 * 65536 + 31 * 256 + 0: REM blekit za oknem
PALETTE 4, 0 * 65536 + 31 * 256 + 0: REM zielen za oknem
PALETTE 5, 0 * 65536 + 0 * 256 + 63: REM czerwien serca
PALETTE 6, 47 * 65536 + 47 * 256 + 47: REM rama okienna
PALETTE 7, 3 * 65536 + 12 * 256 + 35: REM doniczka
REM rejestry gracza powinny byc kodowane &HnF od 1F
REM ze wzgledu na funkce PUT-OR
PALETTE &H1F, 0 * 65536 + 0 * 256 + 48: REM sweter
PALETTE &H2F, 63 * 65536 + 47 * 256 + 0: REM SPODNIE
PALETTE &H3F, 31 * 65536 + 31 * 256 + 31: REM SREDNIA SZAROSC
PALETTE &H4F, 15 * 65536 + 15 * 256 + 15: REM 1/4 SZAROSCI
PALETTE &H5F, 47 * 65536 + 47 * 256 + 47: REM 3/4 SZAROSCI
PALETTE &H6F, 46 * 65536 + 55 * 256 + 63: REM SKORA
PALETTE &H7F, 0 + 65536 + 0 * 256 + 31: REM pol sweter
PALETTE &H8F, 34 * 65536 + 40 * 256 + 46: REM 3/4 skora
PALETTE &H9F, 47 * 65536 + 38 * 256 + 0: REM 7/8 SPODNI
PALETTE &HAF, 0 * 65536 + 0 * 256 + 40: REM 3/4 swetra
PALETTE &HBF, 23 * 65536 + 23 * 256 + 23: REM 3/8 szarosci
PALETTE &HCF, 43 * 65536 + 43 * 256 + 51: REM 7/8 skora
REM rejestry przeszkod - powinny byc od &HFF wstecz
PALETTE &HFF, 18 * 65536 + 19 * 256 + 33: REM cegly
PALETTE &HFE, 19 * 65536 + 19 * 256 + 19: REM fugi
PALETTE &HFD, 28 * 65536 + 28 * 256 + 28: REM krawedz
FOR i = 0 TO 15
PALETTE 230 + i, i * 4 * 65536 + i * 4 * 256 + i * 4: REM kamien
NEXT i
END SUB
SUB plansze
REM ************************** DANE pomieszczen
REM ***************** obliczane od roomx=1,roomy=1
REM ***************** (roomy-1)*7+(roomx-1)
REM kodowanie _+++++++++++++++++++++++_okna++++_se_kw_se1_se2_nowy11+++++
REM ************ plansze wiersza roomy=1
plansza$(0) = "##LLLLLUHHHHQQLLLLLLLUU_______YQ_GN____________#LLLUQQLLLU"
plansza$(1) = "##.....UHHHHHHPPPPPPP##____MD__________________#...UUUPPP#"
plansza$(2) = "##PPPPPHHUHHHHHHHHHHHUU_HE__________ZT_________#PPPQUQQQQU"
plansza$(3) = "####HLLLLLHHHHWHHHHQQ##__________SM____BB1_fB1_##LLLQWWWQ#"
plansza$(4) = "##HHHPPPPPHHHHHUHHHHHUU_______YR_______________#QPPPQQUQQU"
plansza$(5) = "##LLLLLLHHWWWWWWHHHHHUU____MG__________LK5_____#LLLQWWQQQU"
plansza$(6) = "##PPPPPPHHHHHH0HHHH00UU_LC__________FR_________#PPPWQQQQUU"
REM ************ plansze wiersza roomy=2
plansza$(7) = "UHHHHHHHHHLLLLLHHHHHH##_LC_____________________UQQQWLLLQQ#"
plansza$(8) = "#HHHHHHHHH.....WHHHHH##_______YQ_RN____________#QQQQ...QQ#"
plansza$(9) = "UUUHHHHHHWPPPPPUUHHHHUU____MK__________KK1_____UUQQQPPPUQU"
plansza$(10) = "#WWWLLLLLLHHWWWHHHHHWWW_____________ZS_________#WLLLWQQQQW"
plansza$(11) = "UUQQHPPPPPHHUHHHHHWWW##_aI_____________________UQPPPQQQQQ#"
plansza$(12) = "UUHHHHHHHHH00HHHHHHH###__________RN_FS_________UQQQ000QQQ#"
plansza$(13) = "UUUUUUUUUHHHHHUUUUUUUUU____DJ____aM____________UUUUQQQUUUU"
REM ************* plansze wiersza roomy=3
plansza$(14) = "##HHHHHHHHHHHHHHHHHHWWW__________NG_ZS_________#QQQWQWQQQW"
plansza$(15) = "##HHHHHHHWWHLLLLLHHHHHW_MC_YP____UP____________#QQQWLLLLQW"
plansza$(16) = "UU000000000......0000##_WR_____________DI3_`I3_U0000....0#"
plansza$(17) = "WWWWWWWWWWWPPPPPPUUUUUU_MM__________ZP_________WWWWWPPPPUU"
plansza$(18) = "#HHHHHHHHHHHHMWWMHHHHWW_______NP_SM____________#QQQQMWMQQW"
plansza$(19) = "##000HHHHHULLLLL000HHUU________________EB1_____#00QQLLL0HU"
plansza$(20) = "UU00HHHHHWHPPPPP000####____aM____UP____________U0QQWPPP0##"
REM ************ plansze wiersza roomy=4
plansza$(21) = "WWWHHHHHWWLLLLLUUUUUUUU____YK____SG____________WQQQWLLLLUU"
plansza$(22) = "WHHHHHWWHHPPPPPWHHHHH##________________________WHHHWPPPP##"
plansza$(23) = "##00HHHLLLLLHHHHHHHWWWW_______NP_UQ_ZR_RU3_____#0QLLLQQQQW"
plansza$(24) = "UUUUQQQPPPPPQWQQQQQUUUU_YF_YJ_YO_SL_FR_GB5_YB5_UUQPPPQQQQU": REM startowa MaX=dU
plansza$(25) = "##HHHHHHHHHWWWHHHHHUUUU__________NG____________#QQQQWQQQQU"
plansza$(26) = "UUUUHHHHHWWWWHHLLLLLUUU_______YR_SG____________UUQQQWLLLLU"
plansza$(27) = "####00000UUUUUUPPPPPUUU_____________PS_KK1_____##00UUPPPPU"
REM ****************** plansze wiersza roomy=5
plansza$(28) = "UULLLLLHWWWWWHHHLLLLL##_DD____aR_SS_ZT_________ULLLWWWLLL#"
plansza$(29) = "##......UUUUUUU.....###________________II4_YI4_#...UUU...#"
plansza$(30) = "WWPPPPPPHHUUUUHPPPPPUUU_______aR_______GL5_YL5_WPPPQUUPPPU"
plansza$(31) = "UUUUHHHUUULLLLLWHHHHH##____ML_______PS_________UUQQULLLQQ#"
plansza$(32) = "UHHHHHHHHHPPPPP########____YL__________________UQQQWPPP###"
plansza$(33) = "UUUU00000UU00000UUUUUUU________________KR1_____UU00U000UUU"
plansza$(34) = "UUUU000HHHHHWHHHHH000##____OG____SR_FQ_________UU0QQQWQQQ#"
REM ******************* plansze wiersza roomy=6
plansza$(35) = "###00000UULLLLLUUU00UUU_____________KN_________#00ULLLU0UU"
plansza$(36) = "#######UPPPPPPLLLLLLL##__________SR____MH2_YH2_###UPPPLLL#"
plansza$(37) = "UU0HHHHHHHHHHH.......H#_______GQ_______________U0QQQQW...#"
plansza$(38) = "##LLLLLU0000000PPPPPP##_EC__________ZT_________#LLLU00PPP#"
plansza$(39) = "##PPPPPWLLLLLLL000HH###__________MM____________#PPPWLLLQQ#"
plansza$(40) = "UUUUUU00PPPPPPPUUUUUUUU________________KO3_YO3_UUUU0PPPUUU"
plansza$(41) = "##HHHHHHHHHHHHH00000UUU_CC_______ZF_PS_________#QQQWQQQ00U"
REM ******************* plansze wiersza roomy=7
plansza$(42) = "UUUUUU00LLLLL##########_EI__________ZL_________UUU0LLL####"
plansza$(43) = "######UU.....##########____SJ____ML____________###U...####"
plansza$(44) = "##LLLLL0PPPPP##########_____________KL_________#LLLPPP####"
plansza$(45) = "##PPPPP000#############____PH____ZJ____________#PPP000####"
plansza$(46) = "##LLLLL000#############__________EE____________#LLL0######"
plansza$(47) = "UUPPPPP0HHHHHHHLLLLLL##_____________FT_________UPPPQQQLLL#"
plansza$(48) = "UUUUUUUUUUUUUUUPPPPPP##_LR_____________________UUUUUUUPPP#"
REM lokalizacja serc
REM serca wiersza 1
serca(1, 1) = 1
serca(4, 1) = 1
REM serca wiersza 2
serca(2, 2) = 1
serca(6, 2) = 1
serca(7, 2) = 1
REM serca wiersza 3
serca(1, 3) = 1
serca(2, 3) = 1
serca(5, 3) = 1
serca(7, 3) = 1
REM serca wiersza 4
serca(1, 4) = 1
serca(3, 4) = 1
serca(4, 4) = 1
serca(5, 4) = 1
serca(6, 4) = 1
REM serca wiersza 5
serca(1, 5) = 1
serca(7, 5) = 1
REM serca wiersza 6
serca(2, 6) = 1
serca(5, 6) = 1
serca(7, 6) = 1
REM serca wiersza 7
serca(2, 7) = 1
serca(4, 7) = 1
serca(5, 7) = 1
END SUB
SUB rysowanie
FOR i = 0 TO 22
el$ = MID$(kod$, i + 1, 1)
IF el$ = "#" THEN PUT (0, i * 8), ceg40, PSET
IF el$ = "U" THEN PUT (0, i * 8), ceg17plus17, PSET
IF el$ = "0" THEN PUT (0, i * 8), ceg13plus13, PSET
IF el$ = "W" THEN PUT (0, i * 8), ceg4plus20plus4, PSET
IF el$ = "Q" THEN PUT (0, i * 8), ceg4spc32plus4, PSET
IF el$ = "H" THEN PUT (0, i * 8), ceg1spc38ceg1, PSET
IF el$ = "L" THEN PUT (0, i * 8), ceg1spc39, PSET
IF el$ = "P" THEN PUT (0, i * 8), spc39ceg1, PSET
IF el$ = "." THEN PUT (0, i * 8), spc40, PSET
NEXT i
FOR yw = 0 TO 10
el$ = MID$(kod$, yw + 48, 1)
y16 = yw * 16
IF el$ = "#" THEN
FOR xw = 0 TO 19: PUT (xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "U" THEN
FOR xw = 0 TO 6: PUT (xw * 16, y16), blok2, PSET: NEXT xw
PUT (112, y16), blok3, PSET
PUT (192, y16), blok1, PSET
FOR xw = 0 TO 6: PUT (208 + xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "0" THEN
FOR xw = 0 TO 3: PUT (xw * 16, y16), blok2, PSET: NEXT xw
PUT (64, y16), blok3, PSET
PUT (240, y16), blok1, PSET
FOR xw = 0 TO 3: PUT (256 + xw * 16, y16), blok2, PSET: NEXT xw
END IF
IF el$ = "W" THEN
PUT (0, y16), blok2, PSET
PUT (16, y16), blok3, PSET
FOR xw = 0 TO 8: PUT (xw * 16 + 88, y16), blok2, PSET: NEXT xw
PUT (72, y16), blok1, PSET
PUT (232, y16), blok3, PSET
PUT (288, y16), blok1, PSET
PUT (304, y16), blok2, PSET
END IF
IF el$ = "Q" THEN PUT (0, y16), blok3, PSET: PUT (304, y16), blok1, PSET
REM wycofane IF el$ = "H" THEN PUT (0, y16), blok1, PSET
IF el$ = "L" THEN PUT (0, y16), blok3, PSET
IF el$ = "P" THEN PUT (304, y16), blok1, PSET
IF el$ = "." THEN REM PUT (0, y16), spc40, PSET
NEXT yw
REM rysowanie okien
el$ = MID$(kod$, 25, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknonz
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 26, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 3, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknonz:
REM okno niebiesko-zielone
el$ = MID$(kod$, 28, 1)
IF el$ = "" OR el$ = "_" THEN GOTO oknoziel
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 29, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 11), 3, BF
LINE (xokna + 2, yokna + 12)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
oknoziel:
REM okno niebiesko-zielone
el$ = MID$(kod$, 31, 1)
IF el$ = "" OR el$ = "_" THEN GOTO serce
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 32, 1)
yokna = (ASC(el$) - 65) * 8
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 21), 4, BF
LINE (xokna + 2, yokna + 2)-(xokna + 32, yokna + 2), 6
LINE (xokna + 2, yokna + 21)-(xokna + 32, yokna + 21), 6
LINE (xokna + 2, yokna + 2)-(xokna + 2, yokna + 21), 6
LINE (xokna + 12, yokna + 2)-(xokna + 12, yokna + 21), 6
LINE (xokna + 22, yokna + 2)-(xokna + 22, yokna + 21), 6
LINE (xokna + 32, yokna + 2)-(xokna + 32, yokna + 21), 6
serce:
REM serce
xserca = -20
yokna = -20
IF serca(roomx, roomy) = 0 THEN GOTO donica
el$ = MID$(kod$, 34, 1)
IF el$ = "" OR el$ = "_" THEN GOTO donica
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 35, 1)
yokna = (ASC(el$) - 65) * 8
GET (xokna + 8, yokna + 8)-(xokna + 15 + 8, yokna + 7 + 8), tlo
COLOR 5: LOCATE yokna / 8, xokna / 8: PRINT CHR$(3);
xserca = xokna - 8
yserca = yokna - 8
donica:
el$ = MID$(kod$, 37, 1)
IF el$ = "" OR el$ = "_" THEN GOTO kamien
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 38, 1)
yokna = (ASC(el$) - 65) * 8
PUT (xokna, yokna), palma, PSET
kamien:
el$ = MID$(kod$, 40, 1)
IF el$ = "" OR el$ = "_" THEN GOTO drugaseria
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 41, 1)
yokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 42, 1)
ilex = (ASC(el$) - 48)
REM FOR i = 1 TO ilex
REM IF i = 1 AND ilex > 1 THEN PUT (xokna + 16 * (i - 1), yokna), blok1, PSET
REM IF i = ilex AND ilex > 1 THEN PUT (xokna + 16 * (i - 1), yokna), blok3, PSET
REM IF i <> 1 AND i <> ilex THEN PUT (xokna + 16 * (i - 1), yokna), blok2, PSET
REM NEXT i
drugaseria:
el$ = MID$(kod$, 44, 1)
IF el$ = "" OR el$ = "_" THEN GOTO koniecrysowania
xokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 45, 1)
yokna = (ASC(el$) - 65) * 8
el$ = MID$(kod$, 46, 1)
ilex = (ASC(el$) - 48)
REM FOR i = 1 TO ilex
REM PUT (xokna + 16 * (i - 1), yokna), kamienie, PSET
REM NEXT i
REM FOR i = 1 TO ilex
REM IF i = 1 AND ilex > 1 THEN PUT (xokna + 16 * (i - 1), yokna), blok1, PSET
REM IF i = ilex AND ilex > 1 THEN PUT (xokna + 16 * (i - 1), yokna), blok3, PSET
REM IF i <> 1 AND i <> ilex THEN PUT (xokna + 16 * (i - 1), yokna), blok2, PSET
REM NEXT i
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 3000: NEXT i
OUT 66, 204: OUT 66, 4
FOR i = 1 TO 3000: NEXT i
t1 = PEEK(1132)
REM wylaczenie glosnika
OUT 97, stary.port
END SUB |
|
|
Piotr-246 |
Wysłany: Wto 17:58, 31 Sie 2021 Temat postu: Test gry |
|
REM modul BSAVE do gry "Serca"
SCREEN 13
FOR j = 0 TO 15
FOR i = 0 TO 15
PALETTE i + j * 16, INT(RND(1) * 63) + 256 * INT(RND(1) * 63)
NEXT i: NEXT j
DIM cegla(0 TO 32) AS LONG
DIM tlo(0 TO 32) AS LONG
DIM poltlo(0 TO 16) AS LONG
DIM bitmap$(0 TO 31)
REM rysunek cegly
bitmap$(0) = "DDDDDDDEDDDDDDDE"
bitmap$(1) = "DFFFFFFEDFFFFFFE"
bitmap$(2) = "DFFFFFFEDFFFFFFE"
bitmap$(3) = "EEEEEEEEEEEEEEEE"
bitmap$(4) = "DDDEDDDDDDDDDDDD"
bitmap$(5) = "FFFEDFFFFFFFFFFF"
bitmap$(6) = "FFFEDFFFFFFFFFFF"
bitmap$(7) = "EEEEEEEEEEEEEEEE"
REM 250-A 251-B 252-C 253-D 254-E 255-F
FOR yd = 0 TO 7
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + &HF0 + 10
: PSET (xd, yd)
NEXT xd: NEXT yd
GET (0, 0)-(15, 7), cegla
REM komorka tla
REM tlo(0) = &H80040
bitmap$(0) = "0001200000012000"
bitmap$(1) = "0001200000012000"
bitmap$(2) = "1111200000011111"
bitmap$(3) = "2221200000012222"
bitmap$(4) = "0001200000012000"
bitmap$(5) = "0001111111112000"
bitmap$(6) = "0001222222212000"
bitmap$(7) = "0001200000012000"
FOR yd = 0 TO 7
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 48
: PSET (xd, yd)
NEXT xd: NEXT yd
GET (0, 0)-(15, 7), tlo
REM przygotowanie tablic elementow wierszowych
CLS
FOR x = 0 TO 19
FOR y = 0 TO 10
PUT (x * 16, y * 8), 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 8
PUT (i * 16, 8), cegla, PSET
PUT (304 - i * 16, 8), cegla, PSET
NEXT i
FOR i = 0 TO 4
PUT (i * 16, 16), cegla, PSET
PUT (304 - i * 16, 16), cegla, PSET
NEXT i
FOR i = 0 TO 0
PUT (i * 16, 24), cegla, PSET
PUT (304 - i * 16, 24), cegla, PSET
NEXT i
FOR i = 0 TO 2
PUT (i * 16, 32), cegla, PSET
PUT (304 - i * 16, 32), cegla, PSET
NEXT i
FOR i = 0 TO 9
PUT (i * 16 + 80, 32), cegla, PSET
NEXT i
PUT (0, 40), cegla, PSET
PUT (304, 40), cegla, PSET
PUT (0, 48), cegla, PSET
PUT (304, 56), cegla, PSET
REM poszerzenie przejsc pionowych
GET (8, 64)-(15, 71), poltlo
PUT (136, 8), poltlo, PSET
PUT (40, 32), poltlo, PSET
GET (0, 64)-(7, 71), poltlo
PUT (176, 8), poltlo, PSET
PUT (272, 32), poltlo, PSET
REM wykonczenie cegiel
COLOR 254: REM szczeliny
LINE (135, 8)-(135, 15)
LINE (79, 16)-(79, 23)
LINE (15, 24)-(15, 31)
LINE (39, 32)-(39, 39)
LINE (239, 32)-(239, 39)
LINE (15, 40)-(15, 47)
LINE (15, 48)-(15, 55)
COLOR 253: REM krawedzie
LINE (184, 12)-(184, 14)
LINE (240, 21)-(240, 22)
LINE (304, 28)-(304, 30)
LINE (80, 36)-(80, 38)
LINE (280, 36)-(280, 38)
LINE (304, 44)-(304, 46)
LINE (304, 62)-(304, 60)
REM RYSUNEK kamienia
bitmap$(0) = "JJJJJJJJJJJJJJJJ"
bitmap$(1) = "JJNNNNNNNNNNNNJJ"
bitmap$(2) = "JJNAAAKJPKAAANJJ"
bitmap$(3) = "JJNAKONPNKPKANJJ"
bitmap$(4) = "JJNAPMKLGLMPANJJ"
bitmap$(5) = "JJNKJOJKPJPKMNJJ"
bitmap$(6) = "JJNOLJKJJMKMJNJJ"
bitmap$(7) = "JJNJFMJOHKNIPNJJ"
bitmap$(8) = "JJNJILJLJHIJHNJJ"
bitmap$(9) = "JJNIHJNOHOJJKNJJ"
bitmap$(10) = "JJNAJIIHJOMPANJJ"
bitmap$(11) = "JJNAINNJLJOKANJJ"
bitmap$(12) = "JJNAAAIKJKAAANJJ"
bitmap$(13) = "JJNNNNNNNNNNNNJJ"
bitmap$(14) = "JJJJJJJJJJJJJJJJ"
bitmap$(15) = "JJJJJJJJJJJJJJJJ"
FOR yd = 0 TO 15
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + 230
: PSET (xd, yd + 72)
NEXT xd: NEXT yd
REM RYSUNEK DONICZKI
bitmap$(0) = "AAABCEEAAEEBCAAA"
bitmap$(1) = "AAABEEEEEEEECAAA"
bitmap$(2) = "BBBEEEEEEEEEEBBB"
bitmap$(3) = "CCCEEEEEEEEBEECC"
bitmap$(4) = "AAEEAEAEEAEBEEAA"
bitmap$(5) = "AAEBCEAEEAEBCEAA"
bitmap$(6) = "AAEBEAAEEAAECEAA"
bitmap$(7) = "AAEBEAAEEAAECEAA"
bitmap$(8) = "AAABCAAEEAABCAAA"
bitmap$(9) = "AAABCAAEEAABCAAA"
bitmap$(10) = "BBBBBBBEEBBBBBBB"
bitmap$(11) = "CCCBCHHHHHHBCCCC"
bitmap$(12) = "AAABCHHHHHHBCAAA"
bitmap$(13) = "AAABCAHHHHABCAAA"
bitmap$(14) = "AAABCAHHHHABCAAA"
bitmap$(15) = "AAABCAHHHHABCAAA"
FOR yd = 0 TO 15
FOR xd = 0 TO 15
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65
: PSET (xd + 16, yd + 72)
NEXT xd: NEXT yd
REM rysunek bloku
bitmap$(0) = "JJJJJJJJJJJJJJJF" + "JJJJJJJJJJJJJJJF" + "JJJJJJJJJJJJJJJF"
bitmap$(1) = "JJJJJJJJJJJJJJJF" + "JJJJJJJJJJJJJJJF" + "JJJJJJJJJJJJJJJF"
bitmap$(2) = "JJHHHHHHHHHHHHHF" + "JJHHHHHHHHHHHHHF" + "JJHHHHHHHHHHHHHF"
bitmap$(3) = "JJHHHHHHHHHHHHHF" + "JJHHHHHHHHHHHHHF" + "JJHHHHHHHHHHHHHF"
bitmap$(4) = "JJHHHHHHHHHHHHHF" + "JJHHHHHHHHHHHHHF" + "JJHHHHHHHHHHHHHF"
bitmap$(5) = "JJHHHHHHHHHHHHHF" + "JJHHHHHHHHHHHHHF" + "JJHHHHHHHHHHHHHF"
bitmap$(6) = "JJHHHHHHHHHHHHHF" + "JJHHHHHHHHHHHHHF" + "JJHHHHHHHHHHHHHF"
bitmap$(7) = "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF"
bitmap$(8) = "JJJJJJJFJJJJJJJJ" + "JJJJJJJFJJJJJJJJ" + "JJJJJJJFJJJJJJJF"
bitmap$(9) = "JJJJJJJFJJJJJJJJ" + "JJJJJJJFJJJJJJJJ" + "JJJJJJJFJJJJJJJF"
bitmap$(10) = "JJHHHHHFJJHHHHHH" + "HHHHHHHFJJHHHHHH" + "HHHHHHHFJJHHHHHF"
bitmap$(11) = "JJHHHHHFJJHHHHHH" + "HHHHHHHFJJHHHHHH" + "HHHHHHHFJJHHHHHF"
bitmap$(12) = "JJHHHHHFJJHHHHHH" + "HHHHHHHFJJHHHHHH" + "HHHHHHHFJJHHHHHF"
bitmap$(13) = "JJHHHHHFJJHHHHHH" + "HHHHHHHFJJHHHHHH" + "HHHHHHHFJJHHHHHF"
bitmap$(14) = "JJHHHHHFJJHHHHHH" + "HHHHHHHFJJHHHHHH" + "HHHHHHHFJJHHHHHF"
bitmap$(15) = "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF" + "FFFFFFFFFFFFFFFF"
FOR yd = 0 TO 15
FOR xd = 0 TO 47
COLOR ASC(MID$(bitmap$(yd), xd + 1, 1)) - 65 + 230
: PSET (xd + 32, yd + 72)
NEXT xd: NEXT yd
COLOR 15: LOCATE 10, 16: PRINT "SERCA 1.0"
REM animacja
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)
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) = "0000088118200000" + "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)
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)
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) = "0A1A7111117A1A00"
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)
NEXT xd
NEXT yd
REM zapis do pliku
DEF SEG = &HA000
BSAVE "bitmap1.scr", 0, 50000
INPUT a$
CLS
BLOAD "bitmap1.scr"
END |
|
|