Autor	Wiadomość
Piotr-246	Wysłany: Nie 18:20, 05 Wrz 2021    Temat postu: DECLARE SUB zabranie () REM Gra "Serca" UWAGA wersaj gry wymaga REM emulatora o predkosci 6075 cyklow REM wymaga pliku bitmap1.scr utworzonego przez modul bsave.bas DECLARE SUB dreptanie () DECLARE SUB animacja () DECLARE SUB rysowanie () DECLARE SUB palety () DECLARE SUB plansze () DECLARE SUB cegly () DIM SHARED kolor$(0 TO 255) DIM pamiec(0 TO 128) AS LONG DIM poledzialania(0 TO 240) 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 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 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 matryce okien DIM SHARED window1(0 TO 160) AS LONG DIM SHARED window2(0 TO 160) AS LONG DIM SHARED window3(0 TO 160) AS LONG REM ************************* DANE STARTOWE SCREEN 13 REM PRINT FRE(-2): END 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 3: PRINT "T:"; t0; "/"; t1; FRE(-2); PRINT " ROOM:"; roomx; "/"; roomy; "--"; REM **************** zapamietanie pola pod graczem GET (x, y)-(x + 15, y + 31), pamiec GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania liczsercaroom = 0: zrobione = 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 1000: 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 > 300 THEN x = 5: xs = 5: roomx = roomx + 1: GOTO rysuj IF x + dx < 3 THEN x = 300: xs = 300: roomx = roomx - 1: GOTO rysuj IF y + dy > 149 THEN y = 4: ys = 4: roomy = roomy + 1: GOTO rysuj IF y + dy < 3 THEN y = 146: ys = 146: 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 ******************** czy jest wziatek deltawx = ABS(x - xserca) deltawy = ABS(y + 16 - yserca) IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek REM ************************************** operacja odswiezania tla REM punkt 1 zapamietanie nowego pola dzialania (brudnego) REM w oparciu o nowe x,y GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo deltax = x - xs: deltay = y - ys inversx = -1 * deltax: inversy = -1 * deltay inver4 = INT(inversx / 4) FOR yt = 0 TO 31: yt4 = yt * 4 yt6 = (yt + inversy) * 6 FOR xt = 0 TO 3 index1 = 1 + (yt6 + 24) + (xt + inver4) + 1 index2 = 1 + yt4 + xt poledzialania(index1) = pamiec(index2) NEXT xt: NEXT yt REM zmazanie serca z pola dzialania IF liczsercaroom = 1 AND zrobione = 0 THEN zrobione = 1 PUT (x - 4, y - 4), poledzialania, PSET PUT (xserca, yserca), tlo, PSET GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania END IF REM nowa mala pamiec FOR yt = 0 TO 31: yt4 = yt * 4 yt6 = yt * 6 FOR xt = 0 TO 3: index1 = 1 + (yt6 + 24) + (xt + 1): index2 = 1 + yt4 + xt: pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU REM aby nie rysowac dwoch postaci w przypadku skosu IF skos = 1 THEN GOTO bezskosu: REM ************************** ruch w dol lub gore IF vert = 1 THEN wkleic = 7: GOTO wklej bezskosu: REM ************************** ruch w lewo IF obrot = -1 THEN IF dy = 0 THEN przebieranie = przebieranie + 1 IF przebieranie = 3 THEN przebieranie = 0 IF przebieranie = 0 THEN wkleic = 1: GOTO wklej IF przebieranie = 1 THEN wkleic = 2: GOTO wklej IF przebieranie = 2 THEN wkleic = 3: GOTO wklej END IF REM ****************** ruch w prawo IF obrot = 1 THEN IF dy = 0 THEN przebieranie = przebieranie + 1 IF przebieranie = 3 THEN przebieranie = 0 IF przebieranie = 0 THEN wkleic = 4: GOTO wklej IF przebieranie = 1 THEN wkleic = 5: GOTO wklej IF przebieranie = 2 THEN wkleic = 6: GOTO wklej END IF xs = x: ys = y GOTO petla wklej: IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt IF wkleic = 7 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)): NEXT xt: NEXT yt REM wklejenie wyniku operacji na tablicy: PUT (x - 4, y - 4), poledzialania, PSET xs = x: ys = y GOTO petla REM GOSUB-RETURN****************************** obsluga wziatku wziatek: IF serca(roomx, roomy) = 0 THEN GOTO niemawziatku IF liczsercaroom = 1 THEN GOTO niemawziatku serca(roomx, roomy) = 0 liczserca = liczserca + 1 PUT (xserca, yserca), tlo, PSET liczsercaroom = 1 dzwiekbrania = 1 LOCATE 1, 1: COLOR 6: PRINT liczserca; niemawziatku: RETURN SUB animacja REM ************************ znaczek - glowny bohater REM ****************** DANE ANIMACJI REM ten SUB jest do skasowania END SUB SUB cegly BLOAD "bitmap1.scr" REM INPUT a$ REM pobranie z ekranu tablic elementow 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)-(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 GET (0, 120)-(31, 139), window1 GET (32, 120)-(63, 139), window2 GET (64, 120)-(95, 139), window3 END SUB SUB dreptanie DEF SEG = 0 REM wlaczene zegara OUT 67, 182 REM odczytanie wartosci portu 97 stary.port = INP(97) REM ustawienie wartosci "1" dla bitow 1 i 0 nowy.port = (stary.port OR 3) REM wlaczenie glosnika OUT 97, nowy.port REM najpierw mlodszy potem starszy bajt t0 = PEEK(1132) REM ewentualnie: REM OUT 66, 30: OUT 66, 0 REM OUT 66, 164: OUT 66, 2 REM OUT 66, 130: OUT 66, 1 REM OUT 66, 74: OUT 66, 0 REM OUT 66, 220: OUT 66, 1 FOR i = 1 TO 10 OUT 66, 30: OUT 66, 0 OUT 66, 164: OUT 66, 2 OUT 66, 130: OUT 66, 1 OUT 66, 74: OUT 66, 0 OUT 66, 220: OUT 66, 1 NEXT i REM FOR i = 1 TO 150: NEXT i t1 = PEEK(1132) REM wylaczenie glosnika OUT 97, stary.port END SUB SUB palety REM palety kolorow ********************************* REM max koloru=3F FOR i = 0 TO 255: kolor$(i) = "00 00 00 00": NEXT i REM kolory za ludzikiem kolor$(0) = "00 00 00 00": REM rejestr zero- wolny kolor$(1) = "01 05 05 06": REM tlo plyta kolor$(2) = "02 02 03 02": REM tlo fuga kolor$(3) = "03 07 06 06": REM tlo krawedz kolor$(4) = "04 00 22 00": REM liscie kolor$(5) = "05 3F 08 00": REM serce kolor$(6) = "06 30 30 30": REM framuga okna kolor$(7) = "07 28 0A 00": REM doniczka drzewa kolor$(8) = "08 00 21 39": REM niebo kolor$(9) = "09 3F 3F 00": REM slonce kolor$(10) = "0A 3F 3F 3F": REM niezdef kolor$(11) = "0B 3F 3F 3F" kolor$(12) = "0C 3F 3F 3F" kolor$(13) = "0D 3F 3F 3F" kolor$(14) = "0E 3F 3F 3F" kolor$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza REM rejestry przezroczyste gracza kolor$(16) = "10 18 02 02": REM sweter + zero kolor$(17) = "11 18 02 02": REM kolor$(18) = "12 18 02 02": REM kolor$(19) = "13 18 02 02": REM kolor$(20) = "14 22 12 00": REM sweter + liscie kolor$(21) = "15 3F 00 00": REM kolor$(22) = "16 2F 09 09": REM sweter + framuga okna kolor$(23) = "17 2B 08 00": REM sweter + doniczka drzewa kolor$(24) = "18 25 16 24": REM sweter + niebo kolor$(25) = "19 3F 3F 3F": REM niezdef kolor$(26) = "1A 3F 3F 3F": REM kolor$(27) = "1B 3F 3F 3F": REM kolor$(28) = "1C 3F 3F 3F": REM kolor$(29) = "1D 3F 3F 3F": REM kolor$(30) = "1E 3F 3F 3F": REM REM kolor 31 1F zastrzezony dla gracza kolor$(32) = "20 0A 13 29": REM spodnie + zero kolor$(33) = "21 0A 13 29": REM kolor$(34) = "22 0A 13 29": REM kolor$(35) = "23 0A 13 29": REM kolor$(36) = "24 05 1D 24": REM spodnie+ liscie kolor$(37) = "25 3F 3F 3F": REM kolor$(38) = "26 1B 1B 32": REM spodnie + framuga okna kolor$(39) = "27 1A 10 3F": REM spodnie + doniczka kolor$(40) = "28 00 1A 3F": REM spodnie + niebo kolor$(41) = "29 3F 3F 3F": REM niezdef kolor$(42) = "2A 3F 3F 3F": REM kolor$(43) = "2B 3F 3F 3F": REM kolor$(44) = "2C 3F 3F 3F": REM kolor$(45) = "2D 3F 3F 3F": REM kolor$(46) = "2E 3F 3F 3F": REM REM rejestr 47 2F zastrzezony dla gracza REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF) REM rejestry nieprzezroczyste kolor$(31) = "1F 2F 09 09": REM sweter kolor$(47) = "2F 0D 1A 37": REM spodnie kolor$(63) = "3F 1A 1A 1A": REM wlosy i buty kolor$(79) = "4F 10 10 10": REM pasek2 kolor$(95) = "5F 3F 2F 0F": kolor$(111) = "6F 3F 30 20": REM skora1 kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych kolor$(143) = "8F 32 22 02": REM nos kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych kolor$(175) = "AF 22 02 02": REM sweter3 kolor$(191) = "BF 20 20 20": REM pasek kolor$(207) = "CF 37 27 06": REM usta REM bloczek kolor$(224) = "E0 00 00 00": REM kolor$(225) = "E1 04 04 04": REM kolor$(226) = "E2 08 08 08": REM kolor$(227) = "E3 0B 0B 0B": REM kolor$(228) = "E4 10 10 10": REM kolor$(229) = "E5 14 14 14": REM kolor$(230) = "E6 18 18 18": REM kolor$(231) = "E7 1B 1B 1B": REM kolor$(232) = "E8 20 20 20": REM kolor$(233) = "E9 24 24 24": REM kolor$(234) = "EA 28 28 28": REM kolor$(235) = "EB 2B 2B 2B": REM kolor$(236) = "EC 30 30 30": REM kolor$(237) = "ED 34 34 34": REM kolor$(238) = "EE 38 38 38": REM kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika REM cegly male kolor$(252) = "FC 30 27 27": REM krawedz kolor$(253) = "FD 14 0E 0E": REM fuga kolor$(254) = "FE 1F 17 17": REM cegla kolor$(255) = "FF 3F 3F 3F": REM zarezerwowany dla ludzika FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2) red$ = "&H" + MID$(kolor$(i), 4, 2) gre$ = "&H" + MID$(kolor$(i), 7, 2) blu$ = "&H" + MID$(kolor$(i), 10, 2) REM PRINT rej$; " "; red$; " "; gre$; " "; blu$ rej = VAL(rej$) red = VAL(red$) gre = VAL(gre$) blu = VAL(blu$) REM PRINT rej; " "; red; " "; gre; " "; blu PALETTE rej, red + gre * 256 + blu * 65536 NEXT i 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) = "......................._LD__________FQ_________#PPPWQQQQUU" REM ************ plansze wiersza roomy=2 plansza$(7) = ".......................________________________UQQQWLLLQQ#" plansza$(8) = "......................._______YQ_RN_________WH_#QQQQ...QQ#" plansza$(9) = ".......................____ML__________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) = "......................._MD_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) = "......................._______LQ_UQ_YS_RU3__#F_#0QLLLQQQQW" plansza$(24) = ".......................____YI____SK_GS_GB5__WM_UUQPPPQQQQU": REM startowa MaX=dU plansza$(25) = ".......................__________NG____________#QQQQWQQQQU" plansza$(26) = "......................._______ZQ_SG____________UUQQQWLLLLU" plansza$(27) = "......................._____________LS_KK1_____##00UUPPPPU" REM ****************** plansze wiersza roomy=5 plansza$(28) = "......................._DD____aQ_SS_YS_________ULLLWWWLLL#" plansza$(29) = ".......................________________II4_YI4_#...UUU...#" plansza$(30) = "......................._______aQ_______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) = "......................._____________YS_________#LLLU00PPP#" plansza$(39) = ".......................__________MM_________0Q_#PPPWLLLQQ#" plansza$(40) = ".......................________________KO3_YO3_UUUU0PPPUUU" plansza$(41) = "......................._DD_______ZF_MS_________#QQQWQQQ00U" REM ******************* plansze wiersza roomy=7 plansza$(42) = "......................._EJ__________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 PUT (xokna, yokna), window2, PSET 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 PUT (xokna, yokna), window1, PSET oknoziel: REM okno 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 PUT (xokna, yokna), window3, PSET 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 4000: NEXT i OUT 66, 204: OUT 66, 4 FOR i = 1 TO 4000: NEXT i t1 = PEEK(1132) REM wylaczenie glosnika OUT 97, stary.port END SUB
Piotr-246	Wysłany: Nie 16:31, 05 Wrz 2021    Temat postu: DECLARE SUB zabranie () REM Gra "Serca" UWAGA wersaj gry wymaga REM emulatora o predkosci 6075 cyklow REM wymaga pliku bitmap1.scr utworzonego przez modul bsave.bas DECLARE SUB dreptanie () DECLARE SUB animacja () DECLARE SUB rysowanie () DECLARE SUB palety () DECLARE SUB plansze () DECLARE SUB cegly () DIM SHARED kolor$(0 TO 255) DIM pamiec(0 TO 128) AS LONG DIM poledzialania(0 TO 240) 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 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 REM 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 matryce okien DIM SHARED window1(0 TO 160) AS LONG DIM SHARED window2(0 TO 160) AS LONG DIM SHARED window3(0 TO 160) AS LONG REM ************************* DANE STARTOWE SCREEN 13 REM PRINT FRE(-2): END 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 3: PRINT "T:"; t0; "/"; t1; PRINT " ROOM:"; roomx; "/"; roomy; "--"; REM **************** zapamietanie pola pod graczem GET (x, y)-(x + 15, y + 31), pamiec GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania liczsercaroom = 0: zrobione = 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 1000: 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 > 300 THEN x = 5: xs = 5: roomx = roomx + 1: GOTO rysuj IF x + dx < 3 THEN x = 300: xs = 300: roomx = roomx - 1: GOTO rysuj IF y + dy > 149 THEN y = 4: ys = 4: roomy = roomy + 1: GOTO rysuj IF y + dy < 3 THEN y = 146: ys = 146: 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 ******************** czy jest wziatek deltawx = ABS(x - xserca) deltawy = ABS(y + 16 - yserca) IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek REM ************************************** operacja odswiezania tla REM punkt 1 zapamietanie nowego pola dzialania (brudnego) REM w oparciu o nowe x,y GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo deltax = x - xs: deltay = y - ys inversx = -1 * deltax: inversy = -1 * deltay inver4 = INT(inversx / 4) FOR yt = 0 TO 31: yt4 = yt * 4 yt6 = (yt + inversy) * 6 FOR xt = 0 TO 3 index1 = 1 + (yt6 + 24) + (xt + inver4) + 1 index2 = 1 + yt4 + xt poledzialania(index1) = pamiec(index2) NEXT xt: NEXT yt REM zmazanie serca z pola dzialania IF liczsercaroom = 1 AND zrobione = 0 THEN zrobione = 1 PUT (x - 4, y - 4), poledzialania, PSET PUT (xserca, yserca), tlo, PSET GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania END IF REM nowa mala pamiec FOR yt = 0 TO 31: yt4 = yt * 4 yt6 = yt * 6 FOR xt = 0 TO 3: index1 = 1 + (yt6 + 24) + (xt + 1): index2 = 1 + yt4 + xt: pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU REM aby nie rysowac dwoch postaci w przypadku skosu IF skos = 1 THEN GOTO bezskosu: REM ************************** ruch w dol lub gore IF vert = 1 THEN wkleic = 7: GOTO wklej bezskosu: REM ************************** ruch w lewo IF obrot = -1 THEN IF dy = 0 THEN przebieranie = przebieranie + 1 IF przebieranie = 3 THEN przebieranie = 0 IF przebieranie = 0 THEN wkleic = 1: GOTO wklej IF przebieranie = 1 THEN wkleic = 2: GOTO wklej IF przebieranie = 2 THEN wkleic = 3: GOTO wklej END IF REM ****************** ruch w prawo IF obrot = 1 THEN IF dy = 0 THEN przebieranie = przebieranie + 1 IF przebieranie = 3 THEN przebieranie = 0 IF przebieranie = 0 THEN wkleic = 4: GOTO wklej IF przebieranie = 1 THEN wkleic = 5: GOTO wklej IF przebieranie = 2 THEN wkleic = 6: GOTO wklej END IF xs = x: ys = y GOTO petla wklej: IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt IF wkleic = 7 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)): NEXT xt: NEXT yt REM wklejenie wyniku operacji na tablicy: PUT (x - 4, y - 4), poledzialania, PSET xs = x: ys = y GOTO petla REM GOSUB-RETURN****************************** obsluga wziatku wziatek: IF serca(roomx, roomy) = 0 THEN GOTO niemawziatku IF liczsercaroom = 1 THEN GOTO niemawziatku serca(roomx, roomy) = 0 liczserca = liczserca + 1 PUT (xserca, yserca), tlo, PSET liczsercaroom = 1 dzwiekbrania = 1 LOCATE 1, 1: COLOR 6: PRINT liczserca; niemawziatku: RETURN SUB animacja REM ************************ znaczek - glowny bohater REM ****************** DANE ANIMACJI REM ten SUB jest do skasowania END SUB SUB cegly BLOAD "bitmap1.scr" REM INPUT a$ REM pobranie z ekranu tablic elementow 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)-(15, 63), szaretlo GET (0, 48)-(31, 63), szaretlo2 GET (0, 48)-(63, 63), szaretlo4 REM 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 GET (0, 120)-(31, 139), window1 GET (32, 120)-(63, 139), window2 GET (64, 120)-(95, 139), window3 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, 200: OUT 66, 0 OUT 66, 32: OUT 66, 1 OUT 66, 62: OUT 66, 0 OUT 66, 104: OUT 66, 2 OUT 66, 48: OUT 66, 0 OUT 66, 150: OUT 66, 2 OUT 66, 42: OUT 66, 1 NEXT i REM FOR i = 1 TO 150: NEXT i t1 = PEEK(1132) REM wylaczenie glosnika OUT 97, stary.port END SUB SUB palety REM palety kolorow ********************************* REM max koloru=3F FOR i = 0 TO 255: kolor$(i) = "00 00 00 00": NEXT i REM kolory za ludzikiem kolor$(0) = "00 00 00 00": REM rejestr zero- wolny kolor$(1) = "01 05 05 06": REM tlo plyta kolor$(2) = "02 02 03 02": REM tlo fuga kolor$(3) = "03 07 06 06": REM tlo krawedz kolor$(4) = "04 00 22 00": REM liscie kolor$(5) = "05 3F 08 00": REM serce kolor$(6) = "06 30 30 30": REM framuga okna kolor$(7) = "07 28 0A 00": REM doniczka drzewa kolor$(8) = "08 00 21 39": REM niebo kolor$(9) = "09 3F 3F 00": REM slonce kolor$(10) = "0A 3F 3F 3F": REM niezdef kolor$(11) = "0B 3F 3F 3F" kolor$(12) = "0C 3F 3F 3F" kolor$(13) = "0D 3F 3F 3F" kolor$(14) = "0E 3F 3F 3F" kolor$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza REM rejestry przezroczyste gracza kolor$(16) = "10 18 02 02": REM sweter + zero kolor$(17) = "11 18 02 02": REM kolor$(18) = "12 18 02 02": REM kolor$(19) = "13 18 02 02": REM kolor$(20) = "14 22 12 00": REM sweter + liscie kolor$(21) = "15 3F 00 00": REM kolor$(22) = "16 2F 09 09": REM sweter + framuga okna kolor$(23) = "17 2B 08 00": REM sweter + doniczka drzewa kolor$(24) = "18 25 16 24": REM sweter + niebo kolor$(25) = "19 3F 3F 3F": REM niezdef kolor$(26) = "1A 3F 3F 3F": REM kolor$(27) = "1B 3F 3F 3F": REM kolor$(28) = "1C 3F 3F 3F": REM kolor$(29) = "1D 3F 3F 3F": REM kolor$(30) = "1E 3F 3F 3F": REM REM kolor 31 1F zastrzezony dla gracza kolor$(32) = "20 0A 13 29": REM spodnie + zero kolor$(33) = "21 0A 13 29": REM kolor$(34) = "22 0A 13 29": REM kolor$(35) = "23 0A 13 29": REM kolor$(36) = "24 05 1D 24": REM spodnie+ liscie kolor$(37) = "25 3F 3F 3F": REM kolor$(38) = "26 1B 1B 32": REM spodnie + framuga okna kolor$(39) = "27 1A 10 3F": REM spodnie + doniczka kolor$(40) = "28 00 1A 3F": REM spodnie + niebo kolor$(41) = "29 3F 3F 3F": REM niezdef kolor$(42) = "2A 3F 3F 3F": REM kolor$(43) = "2B 3F 3F 3F": REM kolor$(44) = "2C 3F 3F 3F": REM kolor$(45) = "2D 3F 3F 3F": REM kolor$(46) = "2E 3F 3F 3F": REM REM rejestr 47 2F zastrzezony dla gracza REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF) REM rejestry nieprzezroczyste kolor$(31) = "1F 2F 09 09": REM sweter kolor$(47) = "2F 0D 1A 37": REM spodnie kolor$(63) = "3F 1A 1A 1A": REM wlosy i buty kolor$(79) = "4F 10 10 10": REM pasek2 kolor$(95) = "5F 3F 2F 0F": kolor$(111) = "6F 3F 30 20": REM skora1 kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych kolor$(143) = "8F 32 22 02": REM nos kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych kolor$(175) = "AF 22 02 02": REM sweter3 kolor$(191) = "BF 20 20 20": REM pasek kolor$(207) = "CF 37 27 06": REM usta REM bloczek kolor$(224) = "E0 00 00 00": REM kolor$(225) = "E1 04 04 04": REM kolor$(226) = "E2 08 08 08": REM kolor$(227) = "E3 0B 0B 0B": REM kolor$(228) = "E4 10 10 10": REM kolor$(229) = "E5 14 14 14": REM kolor$(230) = "E6 18 18 18": REM kolor$(231) = "E7 1B 1B 1B": REM kolor$(232) = "E8 20 20 20": REM kolor$(233) = "E9 24 24 24": REM kolor$(234) = "EA 28 28 28": REM kolor$(235) = "EB 2B 2B 2B": REM kolor$(236) = "EC 30 30 30": REM kolor$(237) = "ED 34 34 34": REM kolor$(238) = "EE 38 38 38": REM kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika REM cegly male kolor$(252) = "FC 30 27 27": REM krawedz kolor$(253) = "FD 14 0E 0E": REM fuga kolor$(254) = "FE 1F 17 17": REM cegla kolor$(255) = "FF 3F 3F 3F": REM zarezerwowany dla ludzika FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2) red$ = "&H" + MID$(kolor$(i), 4, 2) gre$ = "&H" + MID$(kolor$(i), 7, 2) blu$ = "&H" + MID$(kolor$(i), 10, 2) REM PRINT rej$; " "; red$; " "; gre$; " "; blu$ rej = VAL(rej$) red = VAL(red$) gre = VAL(gre$) blu = VAL(blu$) REM PRINT rej; " "; red; " "; gre; " "; blu PALETTE rej, red + gre * 256 + blu * 65536 NEXT i 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) = "......................._LD__________FQ_________#PPPWQQQQUU" REM ************ plansze wiersza roomy=2 plansza$(7) = ".......................________________________UQQQWLLLQQ#" plansza$(8) = "......................._______YQ_RN_________WH_#QQQQ...QQ#" plansza$(9) = ".......................____ML__________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) = "......................._MD_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) = "......................._______LQ_UQ_YS_RU3__#F_#0QLLLQQQQW" plansza$(24) = ".......................____YI____SK_GS_GB5__WM_UUQPPPQQQQU": REM startowa MaX=dU plansza$(25) = ".......................__________NG____________#QQQQWQQQQU" plansza$(26) = "......................._______ZQ_SG____________UUQQQWLLLLU" plansza$(27) = "......................._____________LS_KK1_____##00UUPPPPU" REM ****************** plansze wiersza roomy=5 plansza$(28) = "......................._DD____aQ_SS_YS_________ULLLWWWLLL#" plansza$(29) = ".......................________________II4_YI4_#...UUU...#" plansza$(30) = "......................._______aQ_______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) = "......................._____________YS_________#LLLU00PPP#" plansza$(39) = ".......................__________MM_________0Q_#PPPWLLLQQ#" plansza$(40) = ".......................________________KO3_YO3_UUUU0PPPUUU" plansza$(41) = "......................._DD_______ZF_MS_________#QQQWQQQ00U" REM ******************* plansze wiersza roomy=7 plansza$(42) = "......................._EJ__________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 PUT (xokna, yokna), window2, PSET 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 PUT (xokna, yokna), window1, PSET oknoziel: REM okno 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 PUT (xokna, yokna), window3, PSET 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: REM el$ = MID$(kod$, 37, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO koniecrysowania REM xokna = (ASC(el$) - 65) * 8 REM el$ = MID$(kod$, 38, 1) REM yokna = (ASC(el$) - 65) * 8 REM 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 4000: NEXT i OUT 66, 204: OUT 66, 4 FOR i = 1 TO 4000: NEXT i t1 = PEEK(1132) REM wylaczenie glosnika OUT 97, stary.port END SUB
Piotr-246	Wysłany: Nie 15:56, 05 Wrz 2021    Temat postu: DECLARE SUB zabranie () REM Gra "Serca" UWAGA wersaj gry wymaga REM emulatora o predkosci 6075 cyklow REM wymaga pliku bitmap1.scr utworzonego przez modul bsave.bas DECLARE SUB dreptanie () DECLARE SUB animacja () DECLARE SUB rysowanie () DECLARE SUB palety () DECLARE SUB plansze () DECLARE SUB cegly () DIM SHARED kolor$(0 TO 255) DIM pamiec(0 TO 128) AS LONG DIM poledzialania(0 TO 240) 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 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 REM DIM SHARED spc40(0 TO 640) AS LONG REM 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 matryce okien REM DIM SHARED window1(0 TO 160) AS LONG REM DIM SHARED window2(0 TO 160) AS LONG REM DIM SHARED window3(0 TO 160) AS LONG REM ************************* DANE STARTOWE SCREEN 13 REM PRINT FRE(-2): END 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 3: PRINT "T:"; t0; "/"; t1; PRINT " ROOM:"; roomx; "/"; roomy; "--"; REM **************** ustawienie gracza na planszy GET (x, y)-(x + 15, y + 31), pamiec GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania liczsercaroom = 0: zrobione = 0 REM *************************** PETLA GLOWNA petla: REM LINE (0, 0)-(250, 40), 5, BF REM kontrolne wyswietlenia REM PUT (200, 0), poledzialania, PSET REM PUT (30, 4), pamiec, PSET 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 1000: 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 > 300 THEN x = 5: xs = 5: roomx = roomx + 1: GOTO rysuj IF x + dx < 3 THEN x = 300: xs = 300: roomx = roomx - 1: GOTO rysuj IF y + dy > 149 THEN y = 4: ys = 4: roomy = roomy + 1: GOTO rysuj IF y + dy < 3 THEN y = 146: ys = 146: 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 ******************** czy jest wziatek deltawx = ABS(x - xserca) deltawy = ABS(y + 16 - yserca) IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek REM ************************************** operacja odswiezania tla REM 1 zapamietanie nowego pola dzialania (brudnego) REM w oparciu o nowe x,y GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania REM kontrolne wyswietlenie brudnego tla REM PUT (100, 0), poledzialania, PSET REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo deltax = x - xs: deltay = y - ys inversx = -1 * deltax: inversy = -1 * deltay inver4 = INT(inversx / 4) FOR yt = 0 TO 31: yt4 = yt * 4 yt6 = (yt + inversy) * 6 FOR xt = 0 TO 3 index1 = 1 + (yt6 + 24) + (xt + inver4) + 1 index2 = 1 + yt4 + xt poledzialania(index1) = pamiec(index2) NEXT xt: NEXT yt REM zmazanie serca z pola dzialania IF liczsercaroom = 1 AND zrobione = 0 THEN zrobione = 1 PUT (x - 4, y - 4), poledzialania, PSET PUT (xserca, yserca), tlo, PSET GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania END IF REM kontrolne wyswietlenie odnowionego tla REM PUT (150, 0), poledzialania, PSET REM nowa mala pamiec FOR yt = 0 TO 31: yt4 = yt * 4 yt6 = yt * 6 FOR xt = 0 TO 3: index1 = 1 + (yt6 + 24) + (xt + 1): index2 = 1 + yt4 + xt: pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU REM aby nie rysowac dwoch postaci w przypadku skosu IF skos = 1 THEN GOTO bezskosu: REM ************************** ruch w dol lub gore IF vert = 1 THEN wkleic = 7: GOTO wklej bezskosu: REM ************************** ruch w lewo IF obrot = -1 THEN IF dy = 0 THEN przebieranie = przebieranie + 1 IF przebieranie = 3 THEN przebieranie = 0 IF przebieranie = 0 THEN wkleic = 1: GOTO wklej IF przebieranie = 1 THEN wkleic = 2: GOTO wklej IF przebieranie = 2 THEN wkleic = 3: GOTO wklej END IF REM ****************** ruch w prawo IF obrot = 1 THEN IF dy = 0 THEN przebieranie = przebieranie + 1 IF przebieranie = 3 THEN przebieranie = 0 IF przebieranie = 0 THEN wkleic = 4: GOTO wklej IF przebieranie = 1 THEN wkleic = 5: GOTO wklej IF przebieranie = 2 THEN wkleic = 6: GOTO wklej END IF xs = x: ys = y GOTO petla wklej: REM IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt IF wkleic = 7 THEN FOR yt = 0 TO 31 yt4 = yt * 4 yt6 = yt * 6 FOR xt = 0 TO 3 index1 = 1 + yt6 + xt + 1 + 24 index2 = 1 + yt4 + xt poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)) NEXT xt: NEXT yt END IF REM wklejenie wyniku operacji na tablicy: PUT (x - 4, y - 4), poledzialania, PSET wstrzymaj: REM IF INKEY$ <> "q" THEN GOTO wstrzymaj 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 REM LINE (xserca, yserca)-(xserca + 7, yserca + 7), 6, BF REM GET (x, y)-(x + 15, y + 31), pamiec REM GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania 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 REM GET (0, 48)-(319, 55), spc40 GET (0, 48)-(15, 63), szaretlo GET (0, 48)-(31, 63), szaretlo2 GET (0, 48)-(63, 63), szaretlo4 REM 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 REM GET (0, 120)-(31, 139), window1 REM GET (32, 120)-(63, 139), window2 REM GET (64, 120)-(95, 139), window3 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, 200: OUT 66, 0 OUT 66, 32: OUT 66, 1 OUT 66, 62: OUT 66, 0 OUT 66, 104: OUT 66, 2 OUT 66, 48: OUT 66, 0 OUT 66, 150: OUT 66, 2 OUT 66, 42: OUT 66, 1 NEXT i REM FOR i = 1 TO 150: NEXT i t1 = PEEK(1132) REM wylaczenie glosnika OUT 97, stary.port END SUB SUB palety REM palety kolorow ********************************* REM max koloru=3F FOR i = 0 TO 255: kolor$(i) = "00 00 00 00": NEXT i REM kolory za ludzikiem kolor$(0) = "00 00 00 00": REM rejestr zero- wolny kolor$(1) = "01 05 05 06": REM tlo plyta kolor$(2) = "02 02 03 02": REM tlo fuga kolor$(3) = "03 07 06 06": REM tlo krawedz kolor$(4) = "04 00 22 00": REM liscie kolor$(5) = "05 3F 08 00": REM serce kolor$(6) = "06 30 30 30": REM framuga okna kolor$(7) = "07 28 0A 00": REM doniczka drzewa kolor$(8) = "08 00 21 39": REM niebo kolor$(9) = "09 3F 3F 00": REM slonce kolor$(10) = "0A 3F 3F 3F": REM niezdef kolor$(11) = "0B 3F 3F 3F" kolor$(12) = "0C 3F 3F 3F" kolor$(13) = "0D 3F 3F 3F" kolor$(14) = "0E 3F 3F 3F" kolor$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza REM rejestry przezroczyste gracza kolor$(16) = "10 18 02 02": REM sweter + zero kolor$(17) = "11 18 02 02": REM kolor$(18) = "12 18 02 02": REM kolor$(19) = "13 18 02 02": REM kolor$(20) = "14 22 12 00": REM sweter + liscie kolor$(21) = "15 3F 00 00": REM kolor$(22) = "16 2F 09 09": REM sweter + framuga okna kolor$(23) = "17 2B 08 00": REM sweter + doniczka drzewa kolor$(24) = "18 25 16 24": REM sweter + niebo kolor$(25) = "19 3F 3F 3F": REM niezdef kolor$(26) = "1A 3F 3F 3F": REM kolor$(27) = "1B 3F 3F 3F": REM kolor$(28) = "1C 3F 3F 3F": REM kolor$(29) = "1D 3F 3F 3F": REM kolor$(30) = "1E 3F 3F 3F": REM REM kolor 31 1F zastrzezony dla gracza kolor$(32) = "20 0A 13 29": REM spodnie + zero kolor$(33) = "21 0A 13 29": REM kolor$(34) = "22 0A 13 29": REM kolor$(35) = "23 0A 13 29": REM kolor$(36) = "24 05 1D 24": REM spodnie+ liscie kolor$(37) = "25 3F 3F 3F": REM kolor$(38) = "26 1B 1B 32": REM spodnie + framuga okna kolor$(39) = "27 1A 10 3F": REM spodnie + doniczka kolor$(40) = "28 00 1A 3F": REM spodnie + niebo kolor$(41) = "29 3F 3F 3F": REM niezdef kolor$(42) = "2A 3F 3F 3F": REM kolor$(43) = "2B 3F 3F 3F": REM kolor$(44) = "2C 3F 3F 3F": REM kolor$(45) = "2D 3F 3F 3F": REM kolor$(46) = "2E 3F 3F 3F": REM REM rejestr 47 2F zastrzezony dla gracza REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF) REM rejestry nieprzezroczyste kolor$(31) = "1F 2F 09 09": REM sweter kolor$(47) = "2F 0D 1A 37": REM spodnie kolor$(63) = "3F 1A 1A 1A": REM wlosy i buty kolor$(79) = "4F 10 10 10": REM pasek2 kolor$(95) = "5F 3F 2F 0F": kolor$(111) = "6F 3F 30 20": REM skora1 kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych kolor$(143) = "8F 32 22 02": REM nos kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych kolor$(175) = "AF 22 02 02": REM sweter3 kolor$(191) = "BF 20 20 20": REM pasek kolor$(207) = "CF 37 27 06": REM usta REM bloczek kolor$(224) = "E0 00 00 00": REM kolor$(225) = "E1 04 04 04": REM kolor$(226) = "E2 08 08 08": REM kolor$(227) = "E3 0B 0B 0B": REM kolor$(228) = "E4 10 10 10": REM kolor$(229) = "E5 14 14 14": REM kolor$(230) = "E6 18 18 18": REM kolor$(231) = "E7 1B 1B 1B": REM kolor$(232) = "E8 20 20 20": REM kolor$(233) = "E9 24 24 24": REM kolor$(234) = "EA 28 28 28": REM kolor$(235) = "EB 2B 2B 2B": REM kolor$(236) = "EC 30 30 30": REM kolor$(237) = "ED 34 34 34": REM kolor$(238) = "EE 38 38 38": REM kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika REM cegly male kolor$(252) = "FC 30 27 27": REM krawedz kolor$(253) = "FD 14 0E 0E": REM fuga kolor$(254) = "FE 1F 17 17": REM cegla kolor$(255) = "FF 3F 3F 3F": REM zarezerwowany dla ludzika FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2) red$ = "&H" + MID$(kolor$(i), 4, 2) gre$ = "&H" + MID$(kolor$(i), 7, 2) blu$ = "&H" + MID$(kolor$(i), 10, 2) REM PRINT rej$; " "; red$; " "; gre$; " "; blu$ rej = VAL(rej$) red = VAL(red$) gre = VAL(gre$) blu = VAL(blu$) REM PRINT rej; " "; red; " "; gre; " "; blu PALETTE rej, red + gre * 256 + blu * 65536 NEXT i 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) = "......................._LD__________FQ_________#PPPWQQQQUU" REM ************ plansze wiersza roomy=2 plansza$(7) = ".......................________________________UQQQWLLLQQ#" plansza$(8) = "......................._______YQ_RN_________WH_#QQQQ...QQ#" plansza$(9) = ".......................____ML__________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) = "......................._MD_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) = "......................._______LQ_UQ_YS_RU3__#F_#0QLLLQQQQW" plansza$(24) = ".......................____YI____SK_GS_GB5__WM_UUQPPPQQQQU": REM startowa MaX=dU plansza$(25) = ".......................__________NG____________#QQQQWQQQQU" plansza$(26) = "......................._______ZQ_SG____________UUQQQWLLLLU" plansza$(27) = "......................._____________LS_KK1_____##00UUPPPPU" REM ****************** plansze wiersza roomy=5 plansza$(28) = "......................._DD____aQ_SS_YS_________ULLLWWWLLL#" plansza$(29) = ".......................________________II4_YI4_#...UUU...#" plansza$(30) = "......................._______aQ_______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) = "......................._____________YS_________#LLLU00PPP#" plansza$(39) = ".......................__________MM_________0Q_#PPPWLLLQQ#" plansza$(40) = ".......................________________KO3_YO3_UUUU0PPPUUU" plansza$(41) = "......................._DD_______ZF_MS_________#QQQWQQQ00U" REM ******************* plansze wiersza roomy=7 plansza$(42) = "......................._EJ__________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 REM el$ = MID$(kod$, 25, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO oknonz REM xokna = (ASC(el$) - 65) * 8 REM el$ = MID$(kod$, 26, 1) REM yokna = (ASC(el$) - 65) * 8 REM PUT (xokna, yokna), window2, PSET oknonz: REM okno niebiesko-zielone REM el$ = MID$(kod$, 28, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO oknoziel REM xokna = (ASC(el$) - 65) * 8 REM el$ = MID$(kod$, 29, 1) REM yokna = (ASC(el$) - 65) * 8 REM PUT (xokna, yokna), window1, PSET oknoziel: REM okno zielone REM REM el$ = MID$(kod$, 31, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO serce REM xokna = (ASC(el$) - 65) * 8 REM el$ = MID$(kod$, 32, 1) REM yokna = (ASC(el$) - 65) * 8 REM PUT (xokna, yokna), window3, PSET 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: REM el$ = MID$(kod$, 37, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO koniecrysowania REM xokna = (ASC(el$) - 65) * 8 REM el$ = MID$(kod$, 38, 1) REM yokna = (ASC(el$) - 65) * 8 REM 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 4000: NEXT i OUT 66, 204: OUT 66, 4 FOR i = 1 TO 4000: NEXT i t1 = PEEK(1132) REM wylaczenie glosnika OUT 97, stary.port END SUB
Piotr-246	Wysłany: Nie 15:30, 05 Wrz 2021    Temat postu: DECLARE SUB zabranie () REM Gra "Serca" UWAGA wersaj gry wymaga REM emulatora o predkosci 6075 cyklow REM wymaga pliku bitmap1.scr utworzonego przez modul bsave.bas DECLARE SUB dreptanie () DECLARE SUB animacja () DECLARE SUB rysowanie () DECLARE SUB palety () DECLARE SUB plansze () DECLARE SUB cegly () DIM SHARED kolor$(0 TO 255) DIM pamiec(0 TO 128) AS LONG DIM poledzialania(0 TO 240) 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 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 REM DIM SHARED ceg40(0 TO 640) AS LONG REM DIM SHARED ceg17plus17(0 TO 640) AS LONG REM DIM SHARED ceg13plus13(0 TO 640) AS LONG REM DIM SHARED ceg4plus20plus4(0 TO 640) AS LONG REM DIM SHARED spc40(0 TO 640) AS LONG REM 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 matryce okien REM DIM SHARED window1(0 TO 160) AS LONG REM DIM SHARED window2(0 TO 160) AS LONG REM DIM SHARED window3(0 TO 160) AS LONG REM ************************* DANE STARTOWE SCREEN 13 REM PRINT FRE(-2): END 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 3: PRINT "T:"; t0; "/"; t1; PRINT " ROOM:"; roomx; "/"; roomy; "--"; REM **************** ustawienie gracza na planszy GET (x, y)-(x + 15, y + 31), pamiec GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania liczsercaroom = 0: zrobione = 0 REM *************************** PETLA GLOWNA petla: REM LINE (0, 0)-(250, 40), 5, BF REM kontrolne wyswietlenia REM PUT (200, 0), poledzialania, PSET REM PUT (30, 4), pamiec, PSET 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 1000: 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 > 300 THEN x = 5: xs = 5: roomx = roomx + 1: GOTO rysuj IF x + dx < 3 THEN x = 300: xs = 300: roomx = roomx - 1: GOTO rysuj IF y + dy > 149 THEN y = 4: ys = 4: roomy = roomy + 1: GOTO rysuj IF y + dy < 3 THEN y = 146: ys = 146: 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 ******************** czy jest wziatek deltawx = ABS(x - xserca) deltawy = ABS(y + 16 - yserca) IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek REM ************************************** operacja odswiezania tla REM 1 zapamietanie nowego pola dzialania (brudnego) REM w oparciu o nowe x,y IF liczsercaroom = 1 AND zrobione = 0 THEN PUT (xserca, yserca), tlo, PSET: zrobione = 1 GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania REM kontrolne wyswietlenie brudnego tla REM PUT (100, 0), poledzialania, PSET REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo deltax = x - xs: deltay = y - ys inversx = -1 * deltax: inversy = -1 * deltay inver4 = INT(inversx / 4) FOR yt = 0 TO 31: yt4 = yt * 4 yt6 = (yt + inversy) * 6 FOR xt = 0 TO 3 index1 = 1 + (yt6 + 24) + (xt + inver4) + 1 index2 = 1 + yt4 + xt poledzialania(index1) = pamiec(index2) NEXT xt: NEXT yt REM kontrolne wyswietlenie odnowionego tla REM PUT (150, 0), poledzialania, PSET REM nowa mala pamiec FOR yt = 0 TO 31: yt4 = yt * 4 yt6 = yt * 6 FOR xt = 0 TO 3: index1 = 1 + (yt6 + 24) + (xt + 1): index2 = 1 + yt4 + xt: pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU REM aby nie rysowac dwoch postaci w przypadku skosu IF skos = 1 THEN GOTO bezskosu: REM ************************** ruch w dol lub gore IF vert = 1 THEN wkleic = 7: GOTO wklej bezskosu: REM ************************** ruch w lewo IF obrot = -1 THEN IF dy = 0 THEN przebieranie = przebieranie + 1 IF przebieranie = 3 THEN przebieranie = 0 IF przebieranie = 0 THEN wkleic = 1: GOTO wklej IF przebieranie = 1 THEN wkleic = 2: GOTO wklej IF przebieranie = 2 THEN wkleic = 3: GOTO wklej END IF REM ****************** ruch w prawo IF obrot = 1 THEN IF dy = 0 THEN przebieranie = przebieranie + 1 IF przebieranie = 3 THEN przebieranie = 0 IF przebieranie = 0 THEN wkleic = 4: GOTO wklej IF przebieranie = 1 THEN wkleic = 5: GOTO wklej IF przebieranie = 2 THEN wkleic = 6: GOTO wklej END IF xs = x: ys = y GOTO petla wklej: REM IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt IF wkleic = 7 THEN FOR yt = 0 TO 31 yt4 = yt * 4 yt6 = yt * 6 FOR xt = 0 TO 3 index1 = 1 + yt6 + xt + 1 + 24 index2 = 1 + yt4 + xt poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)) NEXT xt: NEXT yt END IF REM wklejenie wyniku operacji na tablicy: PUT (x - 4, y - 4), poledzialania, PSET wstrzymaj: REM IF INKEY$ <> "q" THEN GOTO wstrzymaj 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 REM GET (0, 0)-(319, 7), ceg40 REM GET (0, 8)-(319, 15), ceg17plus17 REM GET (0, 16)-(319, 23), ceg13plus13 REM GET (0, 24)-(319, 31), ceg4plus20plus4 REM GET (0, 48)-(319, 55), spc40 GET (0, 48)-(15, 63), szaretlo GET (0, 48)-(31, 63), szaretlo2 GET (0, 48)-(63, 63), szaretlo4 REM 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 REM GET (0, 120)-(31, 139), window1 REM GET (32, 120)-(63, 139), window2 REM GET (64, 120)-(95, 139), window3 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, 200: OUT 66, 0 OUT 66, 32: OUT 66, 1 OUT 66, 62: OUT 66, 0 OUT 66, 104: OUT 66, 2 OUT 66, 48: OUT 66, 0 OUT 66, 150: OUT 66, 2 OUT 66, 42: OUT 66, 1 NEXT i REM FOR i = 1 TO 150: NEXT i t1 = PEEK(1132) REM wylaczenie glosnika OUT 97, stary.port END SUB SUB palety REM palety kolorow ********************************* REM max koloru=3F FOR i = 0 TO 255: kolor$(i) = "00 00 00 00": NEXT i REM kolory za ludzikiem kolor$(0) = "00 00 00 00": REM rejestr zero- wolny kolor$(1) = "01 05 05 06": REM tlo plyta kolor$(2) = "02 02 03 02": REM tlo fuga kolor$(3) = "03 07 06 06": REM tlo krawedz kolor$(4) = "04 00 22 00": REM liscie kolor$(5) = "05 3F 08 00": REM serce kolor$(6) = "06 30 30 30": REM framuga okna kolor$(7) = "07 28 0A 00": REM doniczka drzewa kolor$(8) = "08 00 21 39": REM niebo kolor$(9) = "09 3F 3F 00": REM slonce kolor$(10) = "0A 3F 3F 3F": REM niezdef kolor$(11) = "0B 3F 3F 3F" kolor$(12) = "0C 3F 3F 3F" kolor$(13) = "0D 3F 3F 3F" kolor$(14) = "0E 3F 3F 3F" kolor$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza REM rejestry przezroczyste gracza kolor$(16) = "10 18 02 02": REM sweter + zero kolor$(17) = "11 18 02 02": REM kolor$(18) = "12 18 02 02": REM kolor$(19) = "13 18 02 02": REM kolor$(20) = "14 22 12 00": REM sweter + liscie kolor$(21) = "15 3F 00 00": REM kolor$(22) = "16 2F 09 09": REM sweter + framuga okna kolor$(23) = "17 2B 08 00": REM sweter + doniczka drzewa kolor$(24) = "18 25 16 24": REM sweter + niebo kolor$(25) = "19 3F 3F 3F": REM niezdef kolor$(26) = "1A 3F 3F 3F": REM kolor$(27) = "1B 3F 3F 3F": REM kolor$(28) = "1C 3F 3F 3F": REM kolor$(29) = "1D 3F 3F 3F": REM kolor$(30) = "1E 3F 3F 3F": REM REM kolor 31 1F zastrzezony dla gracza kolor$(32) = "20 0A 13 29": REM spodnie + zero kolor$(33) = "21 0A 13 29": REM kolor$(34) = "22 0A 13 29": REM kolor$(35) = "23 0A 13 29": REM kolor$(36) = "24 05 1D 24": REM spodnie+ liscie kolor$(37) = "25 3F 3F 3F": REM kolor$(38) = "26 1B 1B 32": REM spodnie + framuga okna kolor$(39) = "27 1A 10 3F": REM spodnie + doniczka kolor$(40) = "28 00 1A 3F": REM spodnie + niebo kolor$(41) = "29 3F 3F 3F": REM niezdef kolor$(42) = "2A 3F 3F 3F": REM kolor$(43) = "2B 3F 3F 3F": REM kolor$(44) = "2C 3F 3F 3F": REM kolor$(45) = "2D 3F 3F 3F": REM kolor$(46) = "2E 3F 3F 3F": REM REM rejestr 47 2F zastrzezony dla gracza REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF) REM rejestry nieprzezroczyste kolor$(31) = "1F 2F 09 09": REM sweter kolor$(47) = "2F 0D 1A 37": REM spodnie kolor$(63) = "3F 1A 1A 1A": REM wlosy i buty kolor$(79) = "4F 10 10 10": REM pasek2 kolor$(95) = "5F 3F 2F 0F": kolor$(111) = "6F 3F 30 20": REM skora1 kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych kolor$(143) = "8F 32 22 02": REM nos kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych kolor$(175) = "AF 22 02 02": REM sweter3 kolor$(191) = "BF 20 20 20": REM pasek kolor$(207) = "CF 37 27 06": REM usta REM bloczek kolor$(224) = "E0 00 00 00": REM kolor$(225) = "E1 04 04 04": REM kolor$(226) = "E2 08 08 08": REM kolor$(227) = "E3 0B 0B 0B": REM kolor$(228) = "E4 10 10 10": REM kolor$(229) = "E5 14 14 14": REM kolor$(230) = "E6 18 18 18": REM kolor$(231) = "E7 1B 1B 1B": REM kolor$(232) = "E8 20 20 20": REM kolor$(233) = "E9 24 24 24": REM kolor$(234) = "EA 28 28 28": REM kolor$(235) = "EB 2B 2B 2B": REM kolor$(236) = "EC 30 30 30": REM kolor$(237) = "ED 34 34 34": REM kolor$(238) = "EE 38 38 38": REM kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika REM cegly male kolor$(252) = "FC 30 27 27": REM krawedz kolor$(253) = "FD 14 0E 0E": REM fuga kolor$(254) = "FE 1F 17 17": REM cegla kolor$(255) = "FF 3F 3F 3F": REM zarezerwowany dla ludzika FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2) red$ = "&H" + MID$(kolor$(i), 4, 2) gre$ = "&H" + MID$(kolor$(i), 7, 2) blu$ = "&H" + MID$(kolor$(i), 10, 2) REM PRINT rej$; " "; red$; " "; gre$; " "; blu$ rej = VAL(rej$) red = VAL(red$) gre = VAL(gre$) blu = VAL(blu$) REM PRINT rej; " "; red; " "; gre; " "; blu PALETTE rej, red + gre * 256 + blu * 65536 NEXT i 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) = "......................._LD__________FQ_________#PPPWQQQQUU" REM ************ plansze wiersza roomy=2 plansza$(7) = ".......................________________________UQQQWLLLQQ#" plansza$(8) = "......................._______YQ_RN_________WH_#QQQQ...QQ#" plansza$(9) = ".......................____ML__________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) = "......................._MD_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) = "......................._______LQ_UQ_YS_RU3__#F_#0QLLLQQQQW" plansza$(24) = ".......................____YI____SK_GS_GB5__WM_UUQPPPQQQQU": REM startowa MaX=dU plansza$(25) = ".......................__________NG____________#QQQQWQQQQU" plansza$(26) = "......................._______ZQ_SG____________UUQQQWLLLLU" plansza$(27) = "......................._____________LS_KK1_____##00UUPPPPU" REM ****************** plansze wiersza roomy=5 plansza$(28) = "......................._DD____aQ_SS_YS_________ULLLWWWLLL#" plansza$(29) = ".......................________________II4_YI4_#...UUU...#" plansza$(30) = "......................._______aQ_______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) = "......................._____________YS_________#LLLU00PPP#" plansza$(39) = ".......................__________MM_________0Q_#PPPWLLLQQ#" plansza$(40) = ".......................________________KO3_YO3_UUUU0PPPUUU" plansza$(41) = "......................._DD_______ZF_MS_________#QQQWQQQ00U" REM ******************* plansze wiersza roomy=7 plansza$(42) = "......................._EJ__________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 REM el$ = MID$(kod$, 45, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO okna REM REM el2$ = MID$(kod$, 46, 1) REM yokna = (ASC(el2$) - 65) * 8 REM IF el$ = "#" THEN PUT (0, yokna), ceg40, PSET REM IF el$ = "W" THEN PUT (0, yokna), ceg4plus20plus4, PSET REM IF el$ = "U" THEN PUT (0, yokna), ceg17plus17, PSET REM IF el$ = "0" THEN PUT (0, yokna), ceg13plus13, PSET okna: REM rysowanie okien REM el$ = MID$(kod$, 25, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO oknonz REM xokna = (ASC(el$) - 65) * 8 REM el$ = MID$(kod$, 26, 1) REM yokna = (ASC(el$) - 65) * 8 REM PUT (xokna, yokna), window2, PSET oknonz: REM okno niebiesko-zielone REM el$ = MID$(kod$, 28, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO oknoziel REM xokna = (ASC(el$) - 65) * 8 REM el$ = MID$(kod$, 29, 1) REM yokna = (ASC(el$) - 65) * 8 REM PUT (xokna, yokna), window1, PSET oknoziel: REM okno zielone REM REM el$ = MID$(kod$, 31, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO serce REM xokna = (ASC(el$) - 65) * 8 REM el$ = MID$(kod$, 32, 1) REM yokna = (ASC(el$) - 65) * 8 REM PUT (xokna, yokna), window3, PSET 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: REM el$ = MID$(kod$, 37, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO koniecrysowania REM xokna = (ASC(el$) - 65) * 8 REM el$ = MID$(kod$, 38, 1) REM yokna = (ASC(el$) - 65) * 8 REM 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 4000: NEXT i OUT 66, 204: OUT 66, 4 FOR i = 1 TO 4000: NEXT i t1 = PEEK(1132) REM wylaczenie glosnika OUT 97, stary.port END SUB
Piotr-246	Wysłany: Nie 14:56, 05 Wrz 2021    Temat postu: DECLARE SUB zabranie () REM Gra "Serca" UWAGA wersaj gry wymaga REM emulatora o predkosci 6075 cyklow REM wymaga pliku bitmap1.scr utworzonego przez modul bsave.bas DECLARE SUB dreptanie () DECLARE SUB animacja () DECLARE SUB rysowanie () DECLARE SUB palety () DECLARE SUB plansze () DECLARE SUB cegly () DIM SHARED kolor$(0 TO 255) DIM pamiec(0 TO 128) AS LONG DIM poledzialania(0 TO 240) 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 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 REM DIM SHARED ceg40(0 TO 640) AS LONG REM DIM SHARED ceg17plus17(0 TO 640) AS LONG REM DIM SHARED ceg13plus13(0 TO 640) AS LONG REM DIM SHARED ceg4plus20plus4(0 TO 640) AS LONG REM DIM SHARED spc40(0 TO 640) AS LONG REM 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 matryce okien REM DIM SHARED window1(0 TO 160) AS LONG REM DIM SHARED window2(0 TO 160) AS LONG REM DIM SHARED window3(0 TO 160) AS LONG REM ************************* DANE STARTOWE SCREEN 13 REM PRINT FRE(-2): END 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 3: PRINT "T:"; t0; "/"; t1; PRINT " ROOM:"; roomx; "/"; roomy; "--"; REM **************** ustawienie gracza na planszy GET (x, y)-(x + 15, y + 31), pamiec GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania liczsercaroom = 0 REM *************************** PETLA GLOWNA petla: REM LINE (0, 0)-(250, 40), 5, BF REM kontrolne wyswietlenia REM PUT (200, 0), poledzialania, PSET REM PUT (30, 4), pamiec, PSET 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 1000: 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 > 300 THEN x = 5: xs = 5: roomx = roomx + 1: GOTO rysuj IF x + dx < 3 THEN x = 300: xs = 300: roomx = roomx - 1: GOTO rysuj IF y + dy > 149 THEN y = 4: ys = 4: roomy = roomy + 1: GOTO rysuj IF y + dy < 3 THEN y = 146: ys = 146: 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 ******************** czy jest wziatek deltawx = ABS(x - xserca) deltawy = ABS(y + 16 - yserca) IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek REM ************************************** operacja odswiezania tla REM 1 zapamietanie nowego pola dzialania (brudnego) REM w oparciu o nowe x,y GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania REM kontrolne wyswietlenie brudnego tla REM PUT (100, 0), poledzialania, PSET REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo deltax = x - xs: deltay = y - ys inversx = -1 * deltax: inversy = -1 * deltay inver4 = INT(inversx / 4) FOR yt = 0 TO 31: yt4 = yt * 4 yt6 = (yt + inversy) * 6 FOR xt = 0 TO 3 index1 = 1 + (yt6 + 24) + (xt + inver4) + 1 index2 = 1 + yt4 + xt poledzialania(index1) = pamiec(index2) NEXT xt: NEXT yt REM kontrolne wyswietlenie odnowionego tla REM PUT (150, 0), poledzialania, PSET REM nowa mala pamiec FOR yt = 0 TO 31: yt4 = yt * 4 yt6 = yt * 6 FOR xt = 0 TO 3: index1 = 1 + (yt6 + 24) + (xt + 1): index2 = 1 + yt4 + xt: pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU REM aby nie rysowac dwoch postaci w przypadku skosu IF skos = 1 THEN GOTO bezskosu: REM ************************** ruch w dol lub gore IF vert = 1 THEN wkleic = 7: GOTO wklej bezskosu: REM ************************** ruch w lewo IF obrot = -1 THEN IF dy = 0 THEN przebieranie = przebieranie + 1 IF przebieranie = 3 THEN przebieranie = 0 IF przebieranie = 0 THEN wkleic = 1: GOTO wklej IF przebieranie = 1 THEN wkleic = 2: GOTO wklej IF przebieranie = 2 THEN wkleic = 3: GOTO wklej END IF REM ****************** ruch w prawo IF obrot = 1 THEN IF dy = 0 THEN przebieranie = przebieranie + 1 IF przebieranie = 3 THEN przebieranie = 0 IF przebieranie = 0 THEN wkleic = 4: GOTO wklej IF przebieranie = 1 THEN wkleic = 5: GOTO wklej IF przebieranie = 2 THEN wkleic = 6: GOTO wklej END IF xs = x: ys = y GOTO petla wklej: REM IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt IF wkleic = 7 THEN FOR yt = 0 TO 31 yt4 = yt * 4 yt6 = yt * 6 FOR xt = 0 TO 3 index1 = 1 + yt6 + xt + 1 + 24 index2 = 1 + yt4 + xt poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)) NEXT xt: NEXT yt END IF REM wklejenie wyniku operacji na tablicy: PUT (x - 4, y - 4), poledzialania, PSET wstrzymaj: REM IF INKEY$ <> "q" THEN GOTO wstrzymaj 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 REM GET (0, 0)-(319, 7), ceg40 REM GET (0, 8)-(319, 15), ceg17plus17 REM GET (0, 16)-(319, 23), ceg13plus13 REM GET (0, 24)-(319, 31), ceg4plus20plus4 REM GET (0, 48)-(319, 55), spc40 GET (0, 48)-(15, 63), szaretlo GET (0, 48)-(31, 63), szaretlo2 GET (0, 48)-(63, 63), szaretlo4 REM 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 REM GET (0, 120)-(31, 139), window1 REM GET (32, 120)-(63, 139), window2 REM GET (64, 120)-(95, 139), window3 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 palety kolorow ********************************* REM max koloru=3F FOR i = 0 TO 255: kolor$(i) = "00 00 00 00": NEXT i REM kolory za ludzikiem kolor$(0) = "00 00 00 00": REM rejestr zero- wolny kolor$(1) = "01 05 05 06": REM tlo plyta kolor$(2) = "02 02 03 02": REM tlo fuga kolor$(3) = "03 07 06 06": REM tlo krawedz kolor$(4) = "04 00 22 00": REM liscie kolor$(5) = "05 3F 08 00": REM serce kolor$(6) = "06 30 30 30": REM framuga okna kolor$(7) = "07 28 0A 00": REM doniczka drzewa kolor$(8) = "08 00 21 39": REM niebo kolor$(9) = "09 3F 3F 00": REM slonce kolor$(10) = "0A 3F 3F 3F": REM niezdef kolor$(11) = "0B 3F 3F 3F" kolor$(12) = "0C 3F 3F 3F" kolor$(13) = "0D 3F 3F 3F" kolor$(14) = "0E 3F 3F 3F" kolor$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza REM rejestry przezroczyste gracza kolor$(16) = "10 18 02 02": REM sweter + zero kolor$(17) = "11 18 02 02": REM kolor$(18) = "12 18 02 02": REM kolor$(19) = "13 18 02 02": REM kolor$(20) = "14 22 12 00": REM sweter + liscie kolor$(21) = "15 3F 00 00": REM kolor$(22) = "16 2F 09 09": REM sweter + framuga okna kolor$(23) = "17 2B 08 00": REM sweter + doniczka drzewa kolor$(24) = "18 25 16 24": REM sweter + niebo kolor$(25) = "19 3F 3F 3F": REM niezdef kolor$(26) = "1A 3F 3F 3F": REM kolor$(27) = "1B 3F 3F 3F": REM kolor$(28) = "1C 3F 3F 3F": REM kolor$(29) = "1D 3F 3F 3F": REM kolor$(30) = "1E 3F 3F 3F": REM REM kolor 31 1F zastrzezony dla gracza kolor$(32) = "20 0A 13 29": REM spodnie + zero kolor$(33) = "21 0A 13 29": REM kolor$(34) = "22 0A 13 29": REM kolor$(35) = "23 0A 13 29": REM kolor$(36) = "24 05 1D 24": REM spodnie+ liscie kolor$(37) = "25 3F 3F 3F": REM kolor$(38) = "26 1B 1B 32": REM spodnie + framuga okna kolor$(39) = "27 1A 10 3F": REM spodnie + doniczka kolor$(40) = "28 00 1A 3F": REM spodnie + niebo kolor$(41) = "29 3F 3F 3F": REM niezdef kolor$(42) = "2A 3F 3F 3F": REM kolor$(43) = "2B 3F 3F 3F": REM kolor$(44) = "2C 3F 3F 3F": REM kolor$(45) = "2D 3F 3F 3F": REM kolor$(46) = "2E 3F 3F 3F": REM REM rejestr 47 2F zastrzezony dla gracza REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF) REM rejestry nieprzezroczyste kolor$(31) = "1F 2F 09 09": REM sweter kolor$(47) = "2F 0D 1A 37": REM spodnie kolor$(63) = "3F 1A 1A 1A": REM wlosy i buty kolor$(79) = "4F 10 10 10": REM pasek2 kolor$(95) = "5F 3F 2F 0F": kolor$(111) = "6F 3F 30 20": REM skora1 kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych kolor$(143) = "8F 32 22 02": REM nos kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych kolor$(175) = "AF 22 02 02": REM sweter3 kolor$(191) = "BF 20 20 20": REM pasek kolor$(207) = "CF 37 27 06": REM usta REM bloczek kolor$(224) = "E0 00 00 00": REM kolor$(225) = "E1 04 04 04": REM kolor$(226) = "E2 08 08 08": REM kolor$(227) = "E3 0B 0B 0B": REM kolor$(228) = "E4 10 10 10": REM kolor$(229) = "E5 14 14 14": REM kolor$(230) = "E6 18 18 18": REM kolor$(231) = "E7 1B 1B 1B": REM kolor$(232) = "E8 20 20 20": REM kolor$(233) = "E9 24 24 24": REM kolor$(234) = "EA 28 28 28": REM kolor$(235) = "EB 2B 2B 2B": REM kolor$(236) = "EC 30 30 30": REM kolor$(237) = "ED 34 34 34": REM kolor$(238) = "EE 38 38 38": REM kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika REM cegly male kolor$(252) = "FC 30 27 27": REM krawedz kolor$(253) = "FD 14 0E 0E": REM fuga kolor$(254) = "FE 1F 17 17": REM cegla kolor$(255) = "FF 3F 3F 3F": REM zarezerwowany dla ludzika FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2) red$ = "&H" + MID$(kolor$(i), 4, 2) gre$ = "&H" + MID$(kolor$(i), 7, 2) blu$ = "&H" + MID$(kolor$(i), 10, 2) REM PRINT rej$; " "; red$; " "; gre$; " "; blu$ rej = VAL(rej$) red = VAL(red$) gre = VAL(gre$) blu = VAL(blu$) REM PRINT rej; " "; red; " "; gre; " "; blu PALETTE rej, red + gre * 256 + blu * 65536 NEXT i 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) = "......................._LD__________FQ_________#PPPWQQQQUU" REM ************ plansze wiersza roomy=2 plansza$(7) = ".......................________________________UQQQWLLLQQ#" plansza$(8) = "......................._______YQ_RN_________WH_#QQQQ...QQ#" plansza$(9) = ".......................____ML__________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) = "......................._MD_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) = "......................._______LQ_UQ_YS_RU3__#F_#0QLLLQQQQW" plansza$(24) = ".......................____YI____SK_GS_GB5__WM_UUQPPPQQQQU": REM startowa MaX=dU plansza$(25) = ".......................__________NG____________#QQQQWQQQQU" plansza$(26) = "......................._______ZQ_SG____________UUQQQWLLLLU" plansza$(27) = "......................._____________LS_KK1_____##00UUPPPPU" REM ****************** plansze wiersza roomy=5 plansza$(28) = "......................._DD____aQ_SS_YS_________ULLLWWWLLL#" plansza$(29) = ".......................________________II4_YI4_#...UUU...#" plansza$(30) = "......................._______aQ_______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) = "......................._____________YS_________#LLLU00PPP#" plansza$(39) = ".......................__________MM_________0Q_#PPPWLLLQQ#" plansza$(40) = ".......................________________KO3_YO3_UUUU0PPPUUU" plansza$(41) = "......................._DD_______ZF_MS_________#QQQWQQQ00U" REM ******************* plansze wiersza roomy=7 plansza$(42) = "......................._EJ__________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 REM el$ = MID$(kod$, 45, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO okna REM REM el2$ = MID$(kod$, 46, 1) REM yokna = (ASC(el2$) - 65) * 8 REM IF el$ = "#" THEN PUT (0, yokna), ceg40, PSET REM IF el$ = "W" THEN PUT (0, yokna), ceg4plus20plus4, PSET REM IF el$ = "U" THEN PUT (0, yokna), ceg17plus17, PSET REM IF el$ = "0" THEN PUT (0, yokna), ceg13plus13, PSET okna: REM rysowanie okien REM el$ = MID$(kod$, 25, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO oknonz REM xokna = (ASC(el$) - 65) * 8 REM el$ = MID$(kod$, 26, 1) REM yokna = (ASC(el$) - 65) * 8 REM PUT (xokna, yokna), window2, PSET oknonz: REM okno niebiesko-zielone REM el$ = MID$(kod$, 28, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO oknoziel REM xokna = (ASC(el$) - 65) * 8 REM el$ = MID$(kod$, 29, 1) REM yokna = (ASC(el$) - 65) * 8 REM PUT (xokna, yokna), window1, PSET oknoziel: REM okno zielone REM REM el$ = MID$(kod$, 31, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO serce REM xokna = (ASC(el$) - 65) * 8 REM el$ = MID$(kod$, 32, 1) REM yokna = (ASC(el$) - 65) * 8 REM PUT (xokna, yokna), window3, PSET 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: REM el$ = MID$(kod$, 37, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO koniecrysowania REM xokna = (ASC(el$) - 65) * 8 REM el$ = MID$(kod$, 38, 1) REM yokna = (ASC(el$) - 65) * 8 REM 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: Nie 14:45, 05 Wrz 2021    Temat postu: Temat Antymiganie Rem operacje zapamietania tla wykonane sa w tablicach 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 kolor$(0 TO 255) DIM pamiec(0 TO 128) AS LONG DIM poledzialania(0 TO 240) 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 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 REM DIM SHARED ceg40(0 TO 640) AS LONG REM DIM SHARED ceg17plus17(0 TO 640) AS LONG REM DIM SHARED ceg13plus13(0 TO 640) AS LONG REM DIM SHARED ceg4plus20plus4(0 TO 640) AS LONG REM DIM SHARED spc40(0 TO 640) AS LONG REM 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 matryce okien REM DIM SHARED window1(0 TO 160) AS LONG REM DIM SHARED window2(0 TO 160) AS LONG REM DIM SHARED window3(0 TO 160) AS LONG REM ************************* DANE STARTOWE SCREEN 13 REM PRINT FRE(-2): END 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 3: PRINT "T:"; t0; "/"; t1; PRINT " ROOM:"; roomx; "/"; roomy; "--"; REM **************** ustawienie gracza na planszy GET (x, y)-(x + 15, y + 31), pamiec GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania liczsercaroom = 0 REM *************************** PETLA GLOWNA petla: LINE (0, 0)-(250, 40), 5, BF REM kontrolne wyswietlenia PUT (200, 0), poledzialania, PSET PUT (30, 4), pamiec, PSET 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 REM 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 ******************** czy jest wziatek deltawx = ABS(x - xserca) deltawy = ABS(y + 16 - yserca) IF deltawx < 10 AND deltawy < 22 THEN GOSUB wziatek REM ************************************** operacja odswiezania tla REM 1 zapamietanie nowego pola dzialania (brudnego) REM w oparciu o nowe x,y GET (x - 4, y - 4)-(x + 19, y + 35), poledzialania REM kontrolne wyswietlenie brudnego tla PUT (100, 0), poledzialania, PSET REM************ 2 odnowienie pola dzialania uwzgledniajac dawne tlo deltax = x - xs: deltay = y - ys inversx = -1 * deltax: inversy = -1 * deltay inver4 = INT(inversx / 4) FOR yt = 0 TO 31: yt4 = yt * 4 yt6 = (yt + inversy) * 6 FOR xt = 0 TO 3 index1 = 1 + (yt6 + 24) + (xt + inver4) + 1 index2 = 1 + yt4 + xt poledzialania(index1) = pamiec(index2) NEXT xt: NEXT yt REM kontrolne wyswietlenie odnowionego tla PUT (150, 0), poledzialania, PSET REM nowa mala pamiec FOR yt = 0 TO 31: yt4 = yt * 4 yt6 = yt * 6 FOR xt = 0 TO 3: index1 = 1 + (yt6 + 24) + (xt + 1): index2 = 1 + yt4 + xt: pamiec(index2) = poledzialania(index1): NEXT xt: NEXT yt REM ************* rysowanie nowej postaci WEDLUG FAZY RUCHU REM aby nie rysowac dwoch postaci w przypadku skosu IF skos = 1 THEN GOTO bezskosu: REM ************************** ruch w dol lub gore IF vert = 1 THEN wkleic = 7: GOTO wklej bezskosu: REM ************************** ruch w lewo IF obrot = -1 THEN IF dy = 0 THEN przebieranie = przebieranie + 1 IF przebieranie = 3 THEN przebieranie = 0 IF przebieranie = 0 THEN wkleic = 1: GOTO wklej IF przebieranie = 1 THEN wkleic = 2: GOTO wklej IF przebieranie = 2 THEN wkleic = 3: GOTO wklej END IF REM ****************** ruch w prawo IF obrot = 1 THEN IF dy = 0 THEN przebieranie = przebieranie + 1 IF przebieranie = 3 THEN przebieranie = 0 IF przebieranie = 0 THEN wkleic = 4: GOTO wklej IF przebieranie = 1 THEN wkleic = 5: GOTO wklej IF przebieranie = 2 THEN wkleic = 6: GOTO wklej END IF xs = x: ys = y GOTO petla wklej: REM IF wkleic = 1 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl1(index2)): NEXT xt: NEXT yt IF wkleic = 2 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl2(index2)): NEXT xt: NEXT yt IF wkleic = 3 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakl3(index2)): NEXT xt: NEXT yt IF wkleic = 4 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp1(index2)): NEXT xt: NEXT yt IF wkleic = 5 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp2(index2)): NEXT xt: NEXT yt IF wkleic = 6 THEN FOR yt = 0 TO 31: yt4 = yt * 4: yt6 = yt * 6: FOR xt = 0 TO 3: index1 = 1 + yt6 + xt + 1 + 24: index2 = 1 + yt4 + xt: poledzialania(index1) = (poledzialania(index1) OR znakp3(index2)): NEXT xt: NEXT yt IF wkleic = 7 THEN FOR yt = 0 TO 31 yt4 = yt * 4 yt6 = yt * 6 FOR xt = 0 TO 3 index1 = 1 + yt6 + xt + 1 + 24 index2 = 1 + yt4 + xt poledzialania(index1) = (poledzialania(index1) OR vertd1(index2)) NEXT xt: NEXT yt END IF REM wklejenie wyniku operacji na tablicy: PUT (x - 4, y - 4), poledzialania, PSET wstrzymaj: REM IF INKEY$ <> "q" THEN GOTO wstrzymaj 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 REM GET (0, 0)-(319, 7), ceg40 REM GET (0, 8)-(319, 15), ceg17plus17 REM GET (0, 16)-(319, 23), ceg13plus13 REM GET (0, 24)-(319, 31), ceg4plus20plus4 REM GET (0, 48)-(319, 55), spc40 GET (0, 48)-(15, 63), szaretlo GET (0, 48)-(31, 63), szaretlo2 GET (0, 48)-(63, 63), szaretlo4 REM 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 REM GET (0, 120)-(31, 139), window1 REM GET (32, 120)-(63, 139), window2 REM GET (64, 120)-(95, 139), window3 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 palety kolorow ********************************* REM max koloru=3F FOR i = 0 TO 255: kolor$(i) = "00 00 00 00": NEXT i REM kolory za ludzikiem kolor$(0) = "00 00 00 00": REM rejestr zero- wolny kolor$(1) = "01 15 05 06": REM tlo plyta kolor$(2) = "02 12 03 02": REM tlo fuga kolor$(3) = "03 17 06 06": REM tlo krawedz kolor$(4) = "04 00 22 00": REM liscie kolor$(5) = "05 3F 08 00": REM serce kolor$(6) = "06 30 30 30": REM framuga okna kolor$(7) = "07 28 0A 00": REM doniczka drzewa kolor$(8) = "08 00 21 39": REM niebo kolor$(9) = "09 3F 3F 00": REM slonce kolor$(10) = "0A 3F 3F 3F": REM niezdef kolor$(11) = "0B 3F 3F 3F" kolor$(12) = "0C 3F 3F 3F" kolor$(13) = "0D 3F 3F 3F" kolor$(14) = "0E 3F 3F 3F" kolor$(15) = "0F 3F 3F 3F": REM napis startowy / zastrzezony dla gracza REM rejestry przezroczyste gracza kolor$(16) = "10 18 02 02": REM sweter + zero kolor$(17) = "11 18 02 02": REM kolor$(18) = "12 18 02 02": REM kolor$(19) = "13 18 02 02": REM kolor$(20) = "14 22 12 00": REM sweter + liscie kolor$(21) = "15 3F 00 00": REM kolor$(22) = "16 2F 09 09": REM sweter + framuga okna kolor$(23) = "17 2B 08 00": REM sweter + doniczka drzewa kolor$(24) = "18 25 16 24": REM sweter + niebo kolor$(25) = "19 3F 3F 3F": REM niezdef kolor$(26) = "1A 3F 3F 3F": REM kolor$(27) = "1B 3F 3F 3F": REM kolor$(28) = "1C 3F 3F 3F": REM kolor$(29) = "1D 3F 3F 3F": REM kolor$(30) = "1E 3F 3F 3F": REM REM kolor 31 1F zastrzezony dla gracza kolor$(32) = "20 0A 13 29": REM spodnie + zero kolor$(33) = "21 0A 13 29": REM kolor$(34) = "22 0A 13 29": REM kolor$(35) = "23 0A 13 29": REM kolor$(36) = "24 05 1D 24": REM spodnie+ liscie kolor$(37) = "25 3F 3F 3F": REM kolor$(38) = "26 1B 1B 32": REM spodnie + framuga okna kolor$(39) = "27 1A 10 3F": REM spodnie + doniczka kolor$(40) = "28 00 1A 3F": REM spodnie + niebo kolor$(41) = "29 3F 3F 3F": REM niezdef kolor$(42) = "2A 3F 3F 3F": REM kolor$(43) = "2B 3F 3F 3F": REM kolor$(44) = "2C 3F 3F 3F": REM kolor$(45) = "2D 3F 3F 3F": REM kolor$(46) = "2E 3F 3F 3F": REM REM rejestr 47 2F zastrzezony dla gracza REM ******* ludzik - uwaga rejestry sa rozrzucone nF (1F-FF) REM rejestry nieprzezroczyste kolor$(31) = "1F 2F 09 09": REM sweter kolor$(47) = "2F 0D 1A 37": REM spodnie kolor$(63) = "3F 1A 1A 1A": REM wlosy i buty kolor$(79) = "4F 10 10 10": REM pasek2 kolor$(95) = "5F 3F 2F 0F": kolor$(111) = "6F 3F 30 20": REM skora1 kolor$(127) = "7F 1A 02 02": REM sweter 2 przeniesiony do przezroczystych kolor$(143) = "8F 32 22 02": REM nos kolor$(159) = "9F 0A 13 29": REM spodnie2 przeniesiony do przezroczystych kolor$(175) = "AF 22 02 02": REM sweter3 kolor$(191) = "BF 20 20 20": REM pasek kolor$(207) = "CF 37 27 06": REM usta REM bloczek kolor$(224) = "E0 00 00 00": REM kolor$(225) = "E1 04 04 04": REM kolor$(226) = "E2 08 08 08": REM kolor$(227) = "E3 0B 0B 0B": REM kolor$(228) = "E4 10 10 10": REM kolor$(229) = "E5 14 14 14": REM kolor$(230) = "E6 18 18 18": REM kolor$(231) = "E7 1B 1B 1B": REM kolor$(232) = "E8 20 20 20": REM kolor$(233) = "E9 24 24 24": REM kolor$(234) = "EA 28 28 28": REM kolor$(235) = "EB 2B 2B 2B": REM kolor$(236) = "EC 30 30 30": REM kolor$(237) = "ED 34 34 34": REM kolor$(238) = "EE 38 38 38": REM kolor$(239) = "EF 3F 3F 3F": REM zarezerwowany dla ludzika REM cegly male kolor$(252) = "FC 30 27 27": REM krawedz kolor$(253) = "FD 14 0E 0E": REM fuga kolor$(254) = "FE 1F 17 17": REM cegla kolor$(255) = "FF 3F 3F 3F": REM zarezerwowany dla ludzika FOR i = 0 TO 255: rej$ = "&H" + MID$(kolor$(i), 1, 2) red$ = "&H" + MID$(kolor$(i), 4, 2) gre$ = "&H" + MID$(kolor$(i), 7, 2) blu$ = "&H" + MID$(kolor$(i), 10, 2) REM PRINT rej$; " "; red$; " "; gre$; " "; blu$ rej = VAL(rej$) red = VAL(red$) gre = VAL(gre$) blu = VAL(blu$) REM PRINT rej; " "; red; " "; gre; " "; blu PALETTE rej, red + gre * 256 + blu * 65536 NEXT i 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) = "......................._LD__________FQ_________#PPPWQQQQUU" REM ************ plansze wiersza roomy=2 plansza$(7) = ".......................________________________UQQQWLLLQQ#" plansza$(8) = "......................._______YQ_RN_________WH_#QQQQ...QQ#" plansza$(9) = ".......................____ML__________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) = "......................._MD_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) = "......................._______LQ_UQ_YS_RU3__#F_#0QLLLQQQQW" plansza$(24) = ".......................____YI____SK_GS_GB5__WM_UUQPPPQQQQU": REM startowa MaX=dU plansza$(25) = ".......................__________NG____________#QQQQWQQQQU" plansza$(26) = "......................._______ZQ_SG____________UUQQQWLLLLU" plansza$(27) = "......................._____________LS_KK1_____##00UUPPPPU" REM ****************** plansze wiersza roomy=5 plansza$(28) = "......................._DD____aQ_SS_YS_________ULLLWWWLLL#" plansza$(29) = ".......................________________II4_YI4_#...UUU...#" plansza$(30) = "......................._______aQ_______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) = "......................._____________YS_________#LLLU00PPP#" plansza$(39) = ".......................__________MM_________0Q_#PPPWLLLQQ#" plansza$(40) = ".......................________________KO3_YO3_UUUU0PPPUUU" plansza$(41) = "......................._DD_______ZF_MS_________#QQQWQQQ00U" REM ******************* plansze wiersza roomy=7 plansza$(42) = "......................._EJ__________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 REM el$ = MID$(kod$, 45, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO okna REM REM el2$ = MID$(kod$, 46, 1) REM yokna = (ASC(el2$) - 65) * 8 REM IF el$ = "#" THEN PUT (0, yokna), ceg40, PSET REM IF el$ = "W" THEN PUT (0, yokna), ceg4plus20plus4, PSET REM IF el$ = "U" THEN PUT (0, yokna), ceg17plus17, PSET REM IF el$ = "0" THEN PUT (0, yokna), ceg13plus13, PSET okna: REM rysowanie okien REM el$ = MID$(kod$, 25, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO oknonz REM xokna = (ASC(el$) - 65) * 8 REM el$ = MID$(kod$, 26, 1) REM yokna = (ASC(el$) - 65) * 8 REM PUT (xokna, yokna), window2, PSET oknonz: REM okno niebiesko-zielone REM el$ = MID$(kod$, 28, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO oknoziel REM xokna = (ASC(el$) - 65) * 8 REM el$ = MID$(kod$, 29, 1) REM yokna = (ASC(el$) - 65) * 8 REM PUT (xokna, yokna), window1, PSET oknoziel: REM okno zielone REM REM el$ = MID$(kod$, 31, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO serce REM xokna = (ASC(el$) - 65) * 8 REM el$ = MID$(kod$, 32, 1) REM yokna = (ASC(el$) - 65) * 8 REM PUT (xokna, yokna), window3, PSET 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: REM el$ = MID$(kod$, 37, 1) REM IF el$ = "" OR el$ = "_" THEN GOTO koniecrysowania REM xokna = (ASC(el$) - 65) * 8 REM el$ = MID$(kod$, 38, 1) REM yokna = (ASC(el$) - 65) * 8 REM 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

Powered by phpBB © 2001, 2005 phpBB Group