W ramach przedmiotu „Programowanie strukturalne” zostało mi zlecone napisanie prostej gry w Turbo Pascalu 7 wykorzystującej podstawowe biblioteki, takie jak CRT czy GRAPH.
Choć na co dzień nie programuję w tym języku, zgodziłem się pomóc. W poście tym znajdziesz sposób, w jaki gra została stworzona. Być może przyda się potomnym na zaliczenie ww. przedmiotu. Więc do dzieła!
Kod źródłowy
Nie będę omawiał każdej linijki kodu, krok po kroku. Kod jest na tyle prosty, iż nie wymaga większych opisów. Jakkolwiek, zawsze można zadać pytanie o działanie programu w komentarzu, a postaram się odpowiedzieć :)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 | Program MyGame; Uses CRT, GRAPH; Var c1,c2 : char; belka_x, ptk : integer; fail : boolean; {pozycja kulki} kier : shortint; kulka_x, kulka_y : integer; Procedure Grafika; Var k:integer; Begin k:=detect; InitGraph(k, k, '\BGI'); End; Procedure RysujPlansze; Begin Rectangle(20, 20, 400, 300); End; Procedure Belka(x:shortint); Begin { wymaz wczesniejsza belke } SetColor(0); Line(21, 290, 399, 290); { pozycja belki } if x=0 then belka_x := 25 else belka_x := belka_x + x; { granice belki } if belka_x<21 then belka_x := 21; if belka_x>379 then belka_x := 379; { rysunek } SetColor(12); Line(belka_x, 290, belka_x + 20, 290); End; Procedure LicznikPunktow; Var result : string; Begin if ptk<0 then ptk:=0; {Wymaz wczesniejsze pole} SetColor(0); SetFillStyle(1, 0); Bar(412, 22, 462, 52); { utworz string z wynikiem } Str(ptk, result); SetColor(15); Rectangle(410, 20, 460, 50); OutTextXY(413, 24, 'WYNIK:'); OutTextXY(430, 40, result); End; Procedure Kulka; Var x,y : word; Begin {Wymaz wczesniejsze pole} SetColor(0); SetFillStyle(1, 0); Bar(21, 21, 399, 289); {Losuj polozenie kulki} Randomize; x := Random(358); {Rysuj kulke} SetColor(12); Circle(x+22, 40, 3); kulka_x := x+23; kulka_y := 40; End; Procedure LatajacaKulka; Var tempo:integer; Begin if KeyPressed then Begin {sterowanie} c1 := ReadKey; if c1=chr(0) then c2 := ReadKey; if c2='M' then Belka(5); if c2='K' then Belka(-5); end else Begin if fail=true then exit; {Wymaz wczesniejsze pole} SetColor(0); SetFillStyle(1, 0); Bar(21, 21, 399, 289); {Zwieksz poziom trudnosci z czasem} if ptk<5 then tempo := 1 else if ptk<10 then tempo := 2 else if ptk<15 then tempo := 3 else if ptk<20 then tempo := 4 else if ptk<30 then tempo := 5 else if ptk<40 then tempo := 6 else if ptk<50 then tempo := 7 else tempo := 10; {Nowa pozycja kulki} kulka_x := kulka_x; kulka_y := kulka_y + tempo; {Rysuj kulke} SetColor(12); Circle(kulka_x, kulka_y, 3); if (kulka_y < 285) AND (kulka_y >= 283) then begin {Exit;} end; Delay(50); end; End; Procedure EndGame; Var str_result : string; Begin {Wymaz wczesniejsze pole} SetColor(0); SetFillStyle(1, 0); Bar(21, 21, 399, 289); Str(ptk, str_result); {Game over} SetColor(15); OutTextXY(140, 150, 'Koniec gry.'); OutTextXY(140, 170, 'Uzyskany wynik:'); SetColor(12); OutTextXY(140, 180, str_result); SetColor(15); OutTextXY(160, 180, 'ptk'); {dzwiek} Sound(400); Delay(500); NoSound; {Zakonczenie programu} Readln; End; Begin fail := false; {grafika + czystka} Grafika; ClearDevice; {opakowanie gry} RysujPlansze; Belka(0); LicznikPunktow; {latajaca pileczka} Kulka; Repeat {latajaca kulka} LatajacaKulka; if (kulka_y < 285) AND (kulka_y >= 283) then begin if (belka_x+20 > kulka_x) AND (kulka_x >= belka_x) then begin kulka_y := 40; kulka_x := Random(358) + 23; LatajacaKulka; inc(ptk); LicznikPunktow; {dzwiek} Sound(2200); Delay(80); NoSound; end else begin fail := true; {EndGame;} end; end; Until (c1=chr(27)) OR (fail=true); EndGame; End. |
Ogólna koncepcja jest taka, iż sterujemy belką i zbieramy spadające z góry ekranu kulki. Im więcej mamy punktów, tym wyższy poziom trudności i kulki spadają szybciej.
Oczywiście ta gra mogłaby zostać rozsądniej napisana, jednak w obecnym stanie wystarczyła na zaliczenie przedmiotu.
Do pobrania
Ps. do prawidłowego działania gry wymagane jest, aby folder BGI (biblioteka graficzna), był w tym samym folderze co skompilowany plik.
Zarąbista gierka :D
Mam male pytanie. Dlaczego w tej grze nie dziala mi sterowanie?? I na jakich ono niby ma byc klawiszach??
@henza: poruszasz się na strzałkach klawiatury – w prawo i lewo :-)
własnie to mi nie dziala, nic sie nie porusza
Niestety nie potrafię Ci pomóc – na moim komputerze działa, u znajomych którzy zlecili działa, na uczelni działało. Pascal to była dla mnie kilkudniowa przygoda i do widzenia, nie korzystam z tego języka na co dzień.
Ja ci odpowiem – w nowszych komputerach z nieznanej mi przyczyny nie działa procedura KeyPressed w trybie graficznym, więc aby grać musisz wyciągnąć sobie tryb tekstowy na wierzch i w nim naciskać przyciski
@henza @vulpes
Rozwiązaniem tego problemu jest zastąpienie modułu CRT modułem winCRT. Zbiera on zdarzenia z okna, a nie z konsoli.
Część deklaracyjna powinna więc wyglądać tak :