Programowanie
C++
Turbo Pascal
Delphi
Ver. 1.0 Beta, Nie masz kompilatora? Teraz mo¿esz pisaæ skrypty ONLINE! Wersja podstawowa -nie zawiera wszystkich poleceñ Pascala. S³u¿y do nauki podstaw
MasterMind - Gra pamiêciowa w PascaluKod ¼ród³owy pokazuje jak budowaæ proste gry W grze trzeba zapamiêtaæ okre¶lony znak, potem odkrywaæ kolejne znaki. Ka¿de znaki wystêpuj± parami. Gdy znajdziesz 2 takie same znaki, ale jeden po drugim, komputer je odkrywa i uznaje za zapamiêtane przez ciebie. Musisz odkryæ ca³± planszê. Æwicz swoj± pamiêæ Z kodu ¼ród³owego gry mo¿esz nauczyæ siê jak budowaæ interfejs u¿ytkownika -jak ³±czyæ klawiaturê z zachowaniem kursora program MasterMind; uses Crt; { -------------------------------------------------------------- } { ------------------- Zmienne, typy i stale -------------------- } { -------------------------------------------------------------- } type TPole = record id : Byte; active : Boolean; found : Boolean; end; TPoint = record x : Byte; y : Byte; end; const MAX_PICTURES = 10; MAX_ROWS = 10; MAX_COLUMNS = 10; KEY_LEFT = 'A'; KEY_RIGHT = 'D'; KEY_UP = 'W'; KEY_DOWN = 'S'; KEY_CHOOSE = ' '; KEY_NEW_GAME = 'N'; KEY_ESCAPE = #27; { rodzaje obrazkow } pictures : array[1..MAX_PICTURES] of Char = ('*', '&', '^', '%', '#', '@', '!', '+', '-', '~'); var { plansza } lvl : array[1..MAX_ROWS, 1..MAX_COLUMNS] of TPole; { wspolrzedne poczatkowe planszy pomniejszone o 1 } sx, sy : Byte; { wspolrzedne aktualnego pola } px, py : Byte; { wymiary planszy } rows, columns : Byte; { poprzednio wybrane pole } wybPole : TPoint; { ilosc zaznaczonych pol } wybIle : Byte; { ilosc pol nieodgadnietych } ile : Byte; { czy to juz koniec gry } koniec : Boolean; { czy wyjsc z programu } quit : Boolean; { ilosc podejsc } ilePodejsc : Word; { -------------------------------------------------------------- } { ------------------- Procedury i funkcje ---------------------- } { -------------------------------------------------------------- } function Min(a, b : Integer) : Integer; begin if (a > b) then Min := b else Min := a; end; function Max(a, b : Integer) : Integer; begin if (a < b) then Max := b else Max := a; end; procedure WriteXY(x, y, fg, bg : Byte; const txt : string); begin GotoXY(x, y); TextColor(fg); TextBackground(bg); Write(txt); end; procedure CreateLevel(r, c : Integer); var i, j : Byte; mp : Word; { maksymalna liczba obrazkow } rx, ry : Byte; { losowe wspolrzedne pol } cp : Byte; { biezacy obrazek } begin rows := Max(Min(r, MAX_ROWS), 2); columns := Max(Min(c, MAX_COLUMNS), 2); if (rows and 1<>0) and (columns and 1<>0) then Dec(rows); for i:=1 to rows do for j:=1 to columns do begin lvl[i, j].id := 0; lvl[i, j].active := FALSE; lvl[i, j].found := FALSE; end; mp := rows*columns; ile := mp div 2; cp := 0; while (mp > 0) do begin Inc(cp); if (cp > MAX_PICTURES) then cp := 1; for i:=1 to 2 do begin repeat rx := Random(columns)+1; ry := Random(rows)+1; until (lvl[ry, rx].id = 0); lvl[ry, rx].id := cp; end; Dec(mp, 2); end; sx := 40-(columns div 2); sy := 13-(rows div 2); px := 1; py := 1; wybIle := 0; koniec := FALSE; ilePodejsc := 0; end; procedure Show; var i, j : Byte; s : string; begin TextBackground(BLACK); ClrScr; for i:=1 to rows do for j:=1 to columns do if (lvl[i, j].found) then WriteXY(sx+j-1, sy+i-1, YELLOW, BLACK, pictures[lvl[i, j].id]) else if (lvl[i, j].active) then WriteXY(sx+j-1, sy+i-1, RED, BLACK, pictures[lvl[i, j].id]) else WriteXY(sx+j-1, sy+i-1, DARKGRAY, BLACK, '?'); Str(ilePodejsc:5, s); WriteXY(80-5, 1, WHITE, BLUE, s); GotoXY(sx+px-1, sy+py-1); end; procedure Choose; begin if (lvl[py, px].found) or (lvl[py, px].active) then Exit; Inc(ilePodejsc); lvl[py, px].active := TRUE; if (wybIle = 1) then begin if (lvl[wybPole.y, wybPole.x].id = lvl[py, px].id) then begin lvl[wybPole.y, wybPole.x].found := TRUE; lvl[py, px].found := TRUE; lvl[wybPole.y, wybPole.x].active := FALSE; lvl[py, px].active := FALSE; Dec(ile); if (ile = 0) then koniec := TRUE; end else begin Show; lvl[wybPole.y, wybPole.x].active := FALSE; lvl[py, px].active := FALSE; Delay(500); Show; end; wybIle := 0; end else begin Inc(wybIle); wybPole.x := px; wybPole.y := py; end; end; procedure Init; forward; procedure KeyHandle(c : Char); begin case (c) of KEY_LEFT: px := Max(px-1, 1); KEY_RIGHT: px := Min(px+1, columns); KEY_UP: py := Max(py-1, 1); KEY_DOWN: py := Min(py+1, rows); KEY_CHOOSE: Choose; KEY_NEW_GAME: Init; KEY_ESCAPE: quit := TRUE; else Exit; end; Show; end; procedure Init; begin CreateLevel(Random(MAX_ROWS)+2, Random(MAX_COLUMNS)+2); Show; end; procedure Done; begin TextColor(LIGHTGRAY); TextBackground(BLACK); ClrScr; WriteLn('Master Mind 2005 - by Silent (text mode rulez !!!)'); Delay(3000); end; procedure Play; var c : Char; begin quit := FALSE; while (not quit) do begin if (KeyPressed) then KeyHandle(UpCase(ReadKey)); if (koniec) then begin WriteXY(1, 1, LIGHTGRAY, BLACK, 'Czy chcesz zagrac jeszcze raz ? [T/N] '); repeat c := UpCase(ReadKey); until (c = 'T') or (c = 'N'); if (c = 'N') then Break; Init; end; end; end; procedure Run; begin Play; end; { -------------------------------------------------------------- } { --------------------- Program glowny ------------------------- } { -------------------------------------------------------------- } begin Randomize; TextMode(CO80); Init; Run; Done; end. |
Programy ON-LINE!