API tools faq
paste
Advertisement
Coriic

STATKI 04.01 15.10

Coriic
Jan 4th, 2016
80
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 33.86 KB | None | 0 0
raw download clone embed print report
  1. program statki;
  2.  
  3. uses allegro, crt, dos;
  4.  
  5. type
  6. tablica=ARRAY[-1..11,-1..11] of integer;
  7.  
  8. const
  9. ScreenWidth= 1200;
  10. ScreenHeight= 720;
  11.  
  12. var
  13. tab1, tab2, tab1_c, tab2_c : tablica;
  14. litery : ARRAY [1..20] of string;
  15. mx, my, mb, tryb : integer;
  16.  
  17. procedure inicjalizuj();
  18. var
  19. i, j: integer;
  20. begin
  21. al_init;
  22. al_install_keyboard;
  23. al_install_mouse;
  24. al_set_color_depth(32);
  25. al_set_gfx_mode(Al_GFX_AUTODETECT_WINDOWED,ScreenWidth,ScreenHeight,0,0);
  26. al_show_mouse( al_screen );
  27. al_unscare_mouse();
  28. for i:=0 to 11 do
  29. begin
  30. for j:=0 to 11 do
  31. begin
  32. tab1[i][j]:=0;
  33. tab2[i][j]:=0;
  34. tab1_c[i][j]:=0;
  35. tab2_c[i][j]:=0;
  36. end;
  37. end;
  38. litery[1]:='A';
  39. litery[2]:='B';
  40. litery[3]:='C';
  41. litery[4]:='D';
  42. litery[5]:='E';
  43. litery[6]:='F';
  44. litery[7]:='G';
  45. litery[8]:='H';
  46. litery[9]:='I';
  47. litery[10]:='J';
  48. litery[11]:='1';
  49. litery[12]:='2';
  50. litery[13]:='3';
  51. litery[14]:='4';
  52. litery[15]:='5';
  53. litery[16]:='6';
  54. litery[17]:='7';
  55. litery[18]:='8';
  56. litery[19]:='9';
  57. litery[20]:='10';
  58. end;
  59.  
  60. procedure pozycja_myszki();
  61. begin
  62. if ((mx <> al_mouse_x) AND (my <> al_mouse_y) AND (mb <> al_mouse_b)) then
  63. begin
  64. mx:=al_mouse_x;
  65. my:=al_mouse_y;
  66. mb:=al_mouse_b;
  67. end;
  68. end;
  69.  
  70. procedure clear ();
  71. begin
  72. al_clear_to_color( al_screen, al_makecol( 0, 0, 0 ) );
  73. end;
  74.  
  75. procedure wyswietl_c (var tab : tablica);
  76. var
  77. i, j : integer;
  78. begin
  79. for i:=1 to 10 do
  80. begin
  81. for j:=1 to 10 do
  82. begin
  83. if (tab[i][j]>0) then
  84. begin
  85. al_rectfill( al_screen, (j-1)*30+435, (i-1)*30+65, j*30+430, i*30+60, al_makecol( 200, 30, 30 ) );
  86. al_rect( al_screen, (j-1)*30+435, (i-1)*30+65, j*30+430, i*30+60, al_makecol( 200, 30, 30 ) );
  87. end;
  88. end;
  89. end;
  90. end;
  91.  
  92. procedure wyswietl (var tab : tablica; var tab_c:tablica; gracz : string; parametr : integer);
  93. var
  94. i, j : integer;
  95. begin
  96. al_textout_ex(al_screen, al_font,gracz, 350, 10, al_makecol(200,200,200), -1);
  97. for i:=1 to 10 do
  98. begin
  99. for j:=1 to 10 do
  100. begin
  101. if (tab_c[i][j]=0) then
  102. begin
  103. al_rectfill( al_screen, (j-1)*30+35, (i-1)*30+65, j*30+30, i*30+60, al_makecol( 128, 30, 30 ) );
  104. al_rect( al_screen, (j-1)*30+35, (i-1)*30+65, j*30+30, i*30+60, al_makecol( 128, 30, 30 ) );
  105. end;
  106. if (tab_c[i][j]=-1) then
  107. begin
  108. al_rectfill( al_screen, (j-1)*30+35, (i-1)*30+65, j*30+30, i*30+60, al_makecol( 0, 0, 0 ) );
  109. al_rect( al_screen, (j-1)*30+35, (i-1)*30+65, j*30+30, i*30+60, al_makecol( 200, 200, 200 ) );
  110. end;
  111. if (tab_c[i][j]=-2) then
  112. begin
  113. al_rectfill( al_screen, (j-1)*30+35, (i-1)*30+65, j*30+30, i*30+60, al_makecol( 200, 200, 200 ) );
  114. al_rect( al_screen, (j-1)*30+35, (i-1)*30+65, j*30+30, i*30+60, al_makecol( 200, 200, 200 ) );
  115. end;
  116. if (tab_c[i][j]=-3) then
  117. begin
  118. al_rectfill( al_screen, (j-1)*30+35, (i-1)*30+65, j*30+30, i*30+60, al_makecol( 255, 255, 0 ) );
  119. al_rect( al_screen, (j-1)*30+35, (i-1)*30+65, j*30+30, i*30+60, al_makecol( 200, 200, 200 ) );
  120. end;
  121. end;
  122. end;
  123. for i:=1 to 10 do
  124. begin
  125. for j:=1 to 10 do
  126. begin
  127. if (tab[i][j]=0) then
  128. begin
  129. al_rectfill( al_screen, (j-1)*30+435, (i-1)*30+65, j*30+430, i*30+60, al_makecol( 128, 30, 30 ) );
  130. al_rect( al_screen, (j-1)*30+435, (i-1)*30+65, j*30+430, i*30+60, al_makecol( 128, 30, 30 ) );
  131. end;
  132. if (tab[i][j]>0) then
  133. begin
  134. al_rectfill( al_screen, (j-1)*30+435, (i-1)*30+65, j*30+430, i*30+60, al_makecol( 200, 30, 30 ) );
  135. al_rect( al_screen, (j-1)*30+435, (i-1)*30+65, j*30+430, i*30+60, al_makecol( 200, 30, 30 ) );
  136. end;
  137. if (tab[i][j]=-1) then
  138. begin
  139. al_rectfill( al_screen, (j-1)*30+435, (i-1)*30+65, j*30+430, i*30+60, al_makecol( 0, 0, 0 ) );
  140. al_rect( al_screen, (j-1)*30+435, (i-1)*30+65, j*30+430, i*30+60, al_makecol( 200, 200, 200 ) );
  141. end;
  142. if ((tab[i][j]=-10) OR (tab[i][j]=-11) OR (tab[i][j]=-9)) then
  143. begin
  144. al_rectfill( al_screen, (j-1)*30+435, (i-1)*30+65, j*30+430, i*30+60, al_makecol( 0, 0, 0 ) );
  145. al_rect( al_screen, (j-1)*30+435, (i-1)*30+65, j*30+430, i*30+60, al_makecol( 200, 200, 200 ) );
  146. al_line( al_screen, (j-1)*30+435, (i-1)*30+65, j*30+430, i*30+60, al_makecol( 200, 200, 200 ) );
  147. al_line( al_screen, (j-1)*30+435, (i-1)*30+90, j*30+430, i*30+35, al_makecol( 200, 200, 200 ) );
  148. end;
  149. end;
  150. end;
  151. al_textout_ex(al_screen, al_font,'Twoje statki', 540, 30, al_makecol(200,200,200), -1);
  152. al_textout_ex(al_screen, al_font,'Twoje strzaly', 130, 30, al_makecol(200,200,200), -1);
  153. for i:=1 to 10 do
  154. begin
  155. al_textout_ex(al_screen, al_font,litery[i], (i-1)*30+44, 50, al_makecol(200,200,200), -1);
  156. al_textout_ex(al_screen, al_font,litery[i], (i-1)*30+444, 50, al_makecol(200,200,200), -1);
  157. end;
  158. for i:=11 to 20 do
  159. begin
  160. al_textout_ex(al_screen, al_font, litery[i], 15, (i-11)*30+73, al_makecol(200,200,200), -1);
  161. al_textout_ex(al_screen, al_font, litery[i], 415, (i-11)*30+73, al_makecol(200,200,200), -1);
  162. end;
  163. if (parametr>=-1) then
  164. begin
  165. al_textout_ex(al_screen, al_font,'Stworz:', 750, 50, al_makecol(200,200,200), -1);
  166. al_textout_ex(al_screen, al_font,'1x czteromasztowiec', 750, 70, al_makecol(200,200,200), -1);
  167. al_textout_ex(al_screen, al_font,'2x trojmasztowiec', 750, 90, al_makecol(200,200,200), -1);
  168. al_textout_ex(al_screen, al_font,'3x dwumasztowiec', 750, 110, al_makecol(200,200,200), -1);
  169. al_textout_ex(al_screen, al_font,'4x jednomasztowiec', 750, 130, al_makecol(200,200,200), -1);
  170. end;
  171. if (parametr>=0) then
  172. begin
  173. al_line( al_screen, 750, (parametr*20)+75, 900, (parametr*20)+75, al_makecol( 200, 200, 200 ) );
  174. end;
  175. if (parametr=-2) then
  176. begin
  177. al_textout_ex(al_screen, al_font,'Legenda:', 750, 70, al_makecol(200,200,200), -1);
  178. al_rectfill( al_screen, 750, 90 , 780, 120, al_makecol( 0, 0, 0 ) );
  179. al_rect( al_screen, 750, 90, 780, 120, al_makecol( 200, 200, 200 ) );
  180. al_textout_ex(al_screen, al_font,'-pudlo', 790, 105, al_makecol(200,200,200), -1);
  181. al_rectfill( al_screen, 750, 130 , 780, 160, al_makecol( 200, 200, 200 ) );
  182. al_rect( al_screen, 750, 130, 780, 160, al_makecol( 200, 200, 200 ) );
  183. al_textout_ex(al_screen, al_font,'-trafiony, niezatopiony', 790, 145, al_makecol(200,200,200), -1);
  184. al_rectfill( al_screen, 750, 170 , 780, 200, al_makecol( 255, 255 , 0 ) );
  185. al_rect( al_screen, 750, 170, 780, 200, al_makecol( 200, 200, 200 ) );
  186. al_textout_ex(al_screen, al_font,'-trafiony, zatopiony', 790, 185, al_makecol(200,200,200), -1);
  187. al_rectfill( al_screen, 750, 210 , 780, 240, al_makecol( 200, 30 , 30 ) );
  188. al_rect( al_screen, 750, 210, 780, 240, al_makecol( 200, 200, 200 ) );
  189. al_textout_ex(al_screen, al_font,'-twoj statek', 790, 225, al_makecol(200,200,200), -1);
  190. al_rectfill( al_screen, 750, 250, 780, 280, al_makecol( 0, 0, 0 ) );
  191. al_rect( al_screen, 750, 250, 780, 280, al_makecol( 200, 200, 200 ) );
  192. al_line( al_screen, 750, 250, 780, 280, al_makecol( 200, 200, 200 ) );
  193. al_line( al_screen, 750, 280, 780, 250, al_makecol( 200, 200, 200 ) );
  194. al_textout_ex(al_screen, al_font,'-strzaly przeciwnika', 790, 265, al_makecol(200,200,200), -1);
  195. end;
  196. al_rectfill( al_screen, 10, 660 , 100, 710, al_makecol( 0, 0, 0 ) );
  197. al_rect( al_screen, 10, 660, 100, 710, al_makecol( 200, 200, 200 ) );
  198. al_textout_ex(al_screen, al_font,'Wyjdz', 35, 685, al_makecol(200,200,200), -1);
  199. end;
  200.  
  201. function warunek_tworzenia_1(var tab : tablica; d : integer) : boolean;
  202. begin
  203. if (((tab[((my-65)DIV 30)+2][((mx-435)DIV 30)]=d) OR (tab[((my-65)DIV 30)+2][((mx-435)DIV 30)]=0)) AND ((tab[((my-65)DIV 30)+2][((mx-435)DIV 30)+1]=d) OR (tab[((my-65)DIV 30)+2][((mx-435)DIV 30)+1]=0)) AND ((tab[((my-65)DIV 30)+2][((mx-435)DIV 30)+2]=d) OR (tab[((my-65)DIV 30)+2][((mx-435)DIV 30)+2]=0)) AND ((tab[((my-65)DIV 30)+1][((mx-435)DIV 30)+2]=d) OR (tab[((my-65)DIV 30)+1][((mx-435)DIV 30)+2]=0)) AND ((tab[((my-65)DIV 30)+1][((mx-435)DIV 30)]=d) OR (tab[((my-65)DIV 30)+1][((mx-435)DIV 30)]=0)) AND ((tab[((my-65)DIV 30)][((mx-435)DIV 30)]=d) OR (tab[((my-65)DIV 30)][((mx-435)DIV 30)]=0)) AND ((tab[((my-65)DIV 30)][((mx-435)DIV 30)+1]=d) OR (tab[((my-65)DIV 30)][((mx-435)DIV 30)+1]=0)) AND ((tab[((my-65)DIV 30)][((mx-435)DIV 30)+2]=d)OR (tab[((my-65)DIV 30)][((mx-435)DIV 30)+2]=0))AND (tab[((my-65)DIV 30)+1][((mx-435)DIV 30)+1]=0))then
  204. warunek_tworzenia_1:=true
  205. else
  206. warunek_tworzenia_1:=false;
  207. end;
  208.  
  209. function warunek_tworzenia_2 (var tab:tablica; i : integer) : boolean;
  210. begin
  211. if (((tab[((my-65)DIV 30)+2][((mx-435)DIV 30)+1]=i) OR (tab[((my-65)DIV 30)+1][((mx-435)DIV 30)+2]=i) OR (tab[((my-65)DIV 30)+1][((mx-435)DIV 30)]=i) OR (tab[((my-65)DIV 30)][((mx-435)DIV 30)+1]=i))AND (tab[((my-65)DIV 30)+1][((mx-435)DIV 30)+1]=0)) then
  212. warunek_tworzenia_2:=true
  213. else
  214. warunek_tworzenia_2:=false;
  215. end;
  216.  
  217. procedure koniec(wygrany : string);
  218. begin
  219. al_textout_centre_ex(al_screen,al_font,'KONIEC GRY', ScreenWidth div 2, ScreenHeight div 3, al_makecol(200,200,200), -1);
  220. al_textout_centre_ex(al_screen,al_font,'Wygral:', ScreenWidth div 2-30, ScreenHeight div 3+15, al_makecol(200,200,200), -1);
  221. al_textout_centre_ex(al_screen,al_font,wygrany, (ScreenWidth div 2)+42, ScreenHeight div 3+15, al_makecol(200,200,200), -1);
  222. al_readkey;
  223. halt;
  224. end;
  225.  
  226. function przekroczenie_1( a: integer; b: integer; c: integer; d: integer):boolean;
  227. begin
  228. if ((mb=1) AND (((mx<a) OR (mx>b)) OR ((my<c) OR (my>d)))) then
  229. begin
  230. al_textout_ex(al_screen, al_font, 'Jestes poza plansza', 310, 450, al_makecol(200,200,200), -1);
  231. przekroczenie_1 :=true;
  232. if ((mx>10) AND (mx<100) AND(my>660) AND (my<710)) then
  233. begin
  234. al_rectfill( al_screen, 10, 660 , 100, 710, al_makecol( 200, 200, 200 ) );
  235. al_rect( al_screen, 10, 660, 100, 710, al_makecol( 200, 200, 200 ) );
  236. al_textout_ex(al_screen, al_font,'Wyjdz', 35, 685, al_makecol(0,0,0), -1);
  237. delay(500);
  238. clear();
  239. koniec('pies');
  240. end;
  241. end
  242. else
  243. begin
  244. al_textout_ex(al_screen, al_font, 'Jestes poza plansza', 310, 450, al_makecol(0,0,0), -1);
  245. przekroczenie_1:=false;
  246. end;
  247. end;
  248.  
  249. procedure tworzenie_4(var tab : tablica;var tab_c :tablica; gracz : string);
  250. var
  251. m : integer;
  252. begin
  253. m:=0;
  254. al_textout_ex(al_screen, al_font, 'Stworz 4 masztowiec', 310, 400, al_makecol(200,200,200), -1);
  255. wyswietl(tab,tab_c, gracz, -1);
  256. repeat
  257. begin
  258. mb:=0;
  259. repeat
  260. pozycja_myszki();
  261. przekroczenie_1(435,750,65,360);
  262. until ((mb=1)AND (przekroczenie_1(435,750,65,360)=false));
  263. if (m=0) then
  264. begin
  265. tab[((my-65)DIV 30)+1][((mx-435)DIV 30)+1]:=10;
  266. m:=m+1;
  267. al_rectfill( al_screen, 240, 415 , 1000, 440, al_makecol( 0, 0, 0 ) );
  268. end
  269. else
  270. begin
  271. if (warunek_tworzenia_2(tab, 10)=true) then
  272. begin
  273. tab[((my-65)DIV 30)+1][((mx-435)DIV 30)+1]:=10;
  274. m:=m+1;
  275. al_rectfill( al_screen, 240, 415 , 1000, 440, al_makecol( 0, 0, 0 ) );
  276. end
  277. else if (warunek_tworzenia_2(tab, 10)=false) then
  278. begin
  279. al_textout_ex(al_screen, al_font, 'Statek musi byc polaczony', 250, 420, al_makecol(200,200,200), -1);
  280. end;
  281. end;
  282. end;
  283. wyswietl_c(tab);
  284. until (m=4);
  285. wyswietl_c(tab);
  286. end;
  287.  
  288. procedure tworzenie_3(var tab: tablica; var tab_c :tablica; gracz : string);
  289. var
  290. m, d, p : integer;
  291. begin
  292. al_textout_ex(al_screen, al_font, 'Stworz 4 masztowiec', 310, 400, al_makecol(0,0,0), -1);
  293. for d:=8 to 9 do
  294. begin
  295. wyswietl(tab,tab_c, gracz,0);
  296. m:=0;
  297. al_textout_ex(al_screen, al_font, 'Stworz 3 masztowiec', 310, 400, al_makecol(200,200,200), -1);
  298. wyswietl_c(tab);
  299. repeat
  300. begin
  301. mb:=0;
  302. repeat
  303. pozycja_myszki();
  304. przekroczenie_1(435,750,65,360);
  305. until ((mb=1) AND (przekroczenie_1(435,750,65,360)=false));
  306. if (warunek_tworzenia_1(tab, d)=true) then
  307. begin
  308. if (m>=1) then
  309. begin
  310. if (warunek_tworzenia_2(tab,d)=true) then
  311. begin
  312. tab[((my-65)DIV 30)+1][((mx-435)DIV 30)+1]:=d;
  313. m:=m+1;
  314. p:=1;
  315. end
  316. else
  317. begin
  318. al_textout_ex(al_screen, al_font, 'Statek musi byc polaczony', 250, 420, al_makecol(200,200,200), -1);
  319. end;
  320. end
  321. else
  322. begin
  323. tab[((my-65)DIV 30)+1][((mx-435)DIV 30)+1]:=d;
  324. m:=m+1;
  325. p:=1;
  326. end;
  327. al_rectfill( al_screen, 240, 415 , 1000, 440, al_makecol( 0, 0, 0 ) );
  328. end
  329. else if(warunek_tworzenia_1(tab, d)=false) then
  330. begin
  331. al_textout_ex(al_screen, al_font, 'Nowo utworzony statek nie moze dotykac statku wczesniej utworzonego', 310, 420, al_makecol(200,200,200), -1);
  332. p:=1;
  333. end;
  334. if(p=0) then
  335. begin
  336. if (warunek_tworzenia_2(tab, d)=true) then
  337. begin
  338. tab[((my-65)DIV 30)+1][((mx-435)DIV 30)+1]:=d;
  339. al_rectfill( al_screen, 240, 415 , 1000, 440, al_makecol( 0, 0, 0 ) );
  340. m:=m+1;
  341. end
  342. else if(warunek_tworzenia_2(tab, d)=false) then
  343. begin
  344. al_textout_ex(al_screen, al_font, 'Statek musi byc polaczony', 250, 420, al_makecol(200,200,200), -1);
  345.  
  346. end;
  347. end;
  348. wyswietl_c(tab);
  349. end;
  350. p:=0;
  351. until (m=3);
  352. wyswietl_c(tab);
  353. end;
  354. end;
  355.  
  356. procedure tworzenie_2(var tab:tablica; var tab_c : tablica; gracz:string);
  357. var
  358. m, p, b : integer;
  359. begin
  360. al_textout_ex(al_screen, al_font, 'Stworz 3 masztowiec', 310, 400, al_makecol(0,0,0), -1);
  361. for b:=5 to 7 do
  362. begin
  363. wyswietl(tab,tab_c, gracz,1);
  364. m:=0;
  365. al_textout_ex(al_screen, al_font, 'Stworz 2 masztowiec', 310, 400, al_makecol(200,200,200), -1);
  366. wyswietl_c(tab);
  367. repeat
  368. begin
  369. mb:=0;
  370. repeat
  371. pozycja_myszki();
  372. przekroczenie_1(435,750,65,360);
  373. until ((mb=1)AND(przekroczenie_1(435,750,65,360)=false));
  374. if(warunek_tworzenia_1(tab, b)=true) then
  375. begin
  376. if (m>0) then
  377. begin
  378. if (warunek_tworzenia_2(tab,b)=true) then
  379. begin
  380. tab[((my-65)DIV 30)+1][((mx-435)DIV 30)+1]:=b;
  381. end
  382. else if (warunek_tworzenia_2(tab,b)=false) then
  383. begin
  384. al_textout_ex(al_screen, al_font, 'Statek musi byc polaczony', 250, 420, al_makecol(200,200,200), -1);
  385. end;
  386. end
  387. else
  388. begin
  389. tab[((my-65)DIV 30)+1][((mx-435)DIV 30)+1]:=b;
  390. end;
  391. al_rectfill( al_screen, 240, 415 , 1000, 440, al_makecol( 0, 0, 0 ) );
  392. m:=m+1;
  393. p:=1;
  394. end
  395. else if(warunek_tworzenia_1(tab, b)=false) then
  396. begin
  397. al_textout_ex(al_screen, al_font, 'Nowo utworzony statek nie moze dotykac statku wczesniej utworzonego', 310, 420, al_makecol(200,200,200), -1);
  398. p:=1;
  399. end;
  400. if (p=0) then
  401. begin
  402. if(warunek_tworzenia_2(tab, b)=true)then
  403. begin
  404. tab[((my-65)DIV 30)+1][((mx-435)DIV 30)+1]:=b;
  405. al_rectfill( al_screen, 240, 415 , 1000, 440, al_makecol( 0, 0, 0 ) );
  406. m:=m+1;
  407. p:=1;
  408. end
  409. else if (warunek_tworzenia_2(tab, b)=false) then
  410. begin
  411. al_textout_ex(al_screen, al_font, 'Statek musi byc polaczony', 250, 420, al_makecol(200,200,200), -1);
  412. end;
  413. end;
  414. wyswietl_c(tab);
  415. end;
  416. p:=1;
  417. until (m=2);
  418. wyswietl_c(tab);
  419. end;
  420. end;
  421.  
  422. procedure tworzenie_1(var tab:tablica; var tab_c : tablica; gracz:string);
  423. var
  424. m, a : integer;
  425. begin
  426. al_textout_ex(al_screen, al_font, 'Stworz 2 masztowiec', 310, 400, al_makecol(0,0,0), -1);
  427. for a:=1 to 4 do
  428. begin
  429. wyswietl(tab,tab_c, gracz,2);
  430. m:=0;
  431. al_textout_ex(al_screen, al_font, 'Stworz 1 masztowiec', 310, 400, al_makecol(200,200,200), -1);
  432. wyswietl_c(tab);
  433. repeat
  434. begin
  435. mb:=0;
  436. repeat
  437. pozycja_myszki();
  438. przekroczenie_1(435,750,65,360);
  439. until ((mb=1) AND (przekroczenie_1(435,750,65,360)=false));
  440. if((warunek_tworzenia_1(tab,a)=true) AND (tab[((my-65)DIV 30)+1][((mx-435)DIV 30)+1]=0))then
  441. begin
  442. tab[((my-65)DIV 30)+1][((mx-435)DIV 30)+1]:=a;
  443. al_rectfill( al_screen, 240, 415 , 1000, 440, al_makecol( 0, 0, 0 ) );
  444. m:=m+1;
  445. end
  446. else if(warunek_tworzenia_1(tab,a)=false) then
  447. begin
  448. al_textout_ex(al_screen, al_font, 'Nowo utworzony statek nie moze dotykac statku wczesniej utworzonego', 310, 420, al_makecol(200,200,200), -1);
  449. end
  450. else if (tab[((my-65)DIV 30)+1][((mx-435)DIV 30)+1]<>0) then
  451. begin
  452. al_textout_ex(al_screen, al_font, 'Tu jest statek', 310, 420, al_makecol(200,200,200), -1);
  453. end
  454. end;
  455. wyswietl_c(tab);
  456. until (m=1);
  457. wyswietl_c(tab);
  458. end;
  459. wyswietl_c(tab);
  460. delay(1000);
  461. end;
  462.  
  463. procedure tworzenie_4_k;
  464. var
  465. typ_statku, x, y, stw : integer;
  466. begin
  467. stw:=0;
  468. repeat
  469. randomize();
  470. typ_statku:=random(13)+1;
  471. if(typ_statku=1) then
  472. begin
  473. y:=random(8)+1;
  474. x:=random(9)+2;
  475. tab2[y][x]:=10;
  476. tab2[y+1][x]:=10;
  477. tab2[y+2][x]:=10;
  478. tab2[y+2][x-1]:=10;
  479. break;
  480. end;
  481. if(typ_statku=2) then
  482. begin
  483. y:=random(8)+1;
  484. x:=random(9)+1;
  485. tab2[y][x]:=10;
  486. tab2[y+1][x]:=10;
  487. tab2[y+2][x]:=10;
  488. tab2[y+2][x+1]:=10;
  489. break;
  490. end;
  491. if(typ_statku=3) then
  492. begin
  493. y:=random(7)+1;
  494. x:=random(10)+1;
  495. tab2[y][x]:=10;
  496. tab2[y+1][x]:=10;
  497. tab2[y+2][x]:=10;
  498. tab2[y+3][x]:=10;
  499. break;
  500. end;
  501. if(typ_statku=4) then
  502. begin
  503. y:=random(10)+1;
  504. x:=random(7)+1;
  505. tab2[y][x]:=10;
  506. tab2[y][x+1]:=10;
  507. tab2[y][x+2]:=10;
  508. tab2[y][x+3]:=10;
  509. break;
  510. end;
  511. if(typ_statku=5) then
  512. begin
  513. y:=random(9)+1;
  514. x:=random(8)+1;
  515. tab2[y][x]:=10;
  516. tab2[y][x+1]:=10;
  517. tab2[y][x+2]:=10;
  518. tab2[y+1][x+1]:=10;
  519. break;
  520. end;
  521. if(typ_statku=6) then
  522. begin
  523. y:=random(9)+2;
  524. x:=random(8)+1;
  525. tab2[y][x]:=10;
  526. tab2[y][x+1]:=10;
  527. tab2[y][x+2]:=10;
  528. tab2[y-1][x+2]:=10;
  529. break;
  530. end;
  531. if(typ_statku=7) then
  532. begin
  533. y:=random(9)+2;
  534. x:=random(8)+1;
  535. tab2[y][x]:=10;
  536. tab2[y][x+1]:=10;
  537. tab2[y][x+2]:=10;
  538. tab2[y-1][x]:=10;
  539. break;
  540. end;
  541. if(typ_statku=8) then
  542. begin
  543. y:=random(9)+2;
  544. x:=random(8)+1;
  545. tab2[y][x]:=10;
  546. tab2[y][x+1]:=10;
  547. tab2[y][x+2]:=10;
  548. tab2[y-1][x+1]:=10;
  549. break;
  550. end;
  551. if(typ_statku=9) then
  552. begin
  553. y:=random(9)+1;
  554. x:=random(8)+1;
  555. tab2[y][x]:=10;
  556. tab2[y+1][x]:=10;
  557. tab2[y][x+1]:=10;
  558. tab2[y][x+2]:=10;
  559. break;
  560. end;
  561. if(typ_statku=10) then
  562. begin
  563. y:=random(9)+1;
  564. x:=random(8)+1;
  565. tab2[y][x]:=10;
  566. tab2[y][x+1]:=10;
  567. tab2[y][x+2]:=10;
  568. tab2[y+1][x+2]:=10;
  569. break;
  570. end;
  571. if(typ_statku=11) then
  572. begin
  573. y:=random(9)+1;
  574. x:=random(9)+1;
  575. tab2[y][x]:=10;
  576. tab2[y+1][x+1]:=10;
  577. tab2[y][x+1]:=10;
  578. tab2[y+1][x]:=10;
  579. break;
  580. end;
  581. if(typ_statku=12) then
  582. begin
  583. y:=random(8)+1;
  584. x:=random(9)+2;
  585. tab2[y][x]:=10;
  586. tab2[y+1][x]:=10;
  587. tab2[y+2][x]:=10;
  588. tab2[y][x-1]:=10;
  589. break;
  590. end;
  591. if(typ_statku=13) then
  592. begin
  593. y:=random(8)+1;
  594. x:=random(9)+1;
  595. tab2[y][x]:=10;
  596. tab2[y+1][x]:=10;
  597. tab2[y+2][x]:=10;
  598. tab2[y][x+1]:=10;
  599. break;
  600. end;
  601. until (stw=1);
  602. end;
  603.  
  604. procedure tworzenie_3_k();
  605. var
  606. typ_statku, it1, it2, x, y, stw, a, war : integer;
  607. begin
  608. stw:=0;
  609. for a:=8 to 9 do
  610. begin
  611. war:=0;
  612. repeat
  613. randomize();
  614. typ_statku:=random(6)+1;
  615. if (typ_statku=1)then
  616. begin
  617. y:=random(10)+1;
  618. x:=random(8)+1;
  619. for it1:=-1 to 1 do
  620. begin
  621. for it2:=-1 to 1 do
  622. begin
  623. if ((it1=0) AND (it2=0)) then continue;
  624. if ((tab2[y+it1][x+it2]=0) AND (tab2[y+it1][x+1+it2]=0) AND (tab2[y+it1][x+2+it2]=0))then
  625. begin
  626. war:=war+1;
  627. end;
  628. end;
  629. end;
  630. if (war=8) then
  631. begin
  632. tab2[y][x]:=a;
  633. tab2[y][x+1]:=a;
  634. tab2[y][x+2]:=a;
  635. break;
  636. end;
  637. war:=0;
  638. end;
  639. if (typ_statku=2)then
  640. begin
  641. y:=random(9)+1;
  642. x:=random(9)+1;
  643. for it1:=-1 to 1 do
  644. begin
  645. for it2:=-1 to 1 do
  646. begin
  647. if ((it1=0) AND (it2=0)) then continue;
  648. if ((tab2[y+it1][x+it2]=0) AND (tab2[y+it1][x+1+it2]=0) AND (tab2[y+1+it1][x+1+it2]=0))then
  649. begin
  650. war:=war+1;
  651. end;
  652. end;
  653. end;
  654. if (war=8) then
  655. begin
  656. tab2[y][x]:=a;
  657. tab2[y][x+1]:=a;
  658. tab2[y+1][x+1]:=a;
  659. break;
  660. end;
  661. war:=0;
  662. end;
  663. if (typ_statku=3)then
  664. begin
  665. y:=random(9)+1;
  666. x:=random(9)+1;
  667. for it1:=-1 to 1 do
  668. begin
  669. for it2:=-1 to 1 do
  670. begin
  671. if ((it1=0) AND (it2=0)) then continue;
  672. if ((tab2[y+it1][x+it2]=0) AND (tab2[y+it1][x+1+it2]=0) AND (tab2[y+1+it1][x+it2]=0))then
  673. begin
  674. war:=war+1;
  675. end;
  676. end;
  677. end;
  678. if (war=8) then
  679. begin
  680. tab2[y][x]:=a;
  681. tab2[y][x+1]:=a;
  682. tab2[y+1][x]:=a;
  683. break;
  684. end;
  685. war:=0;
  686. end;
  687. if (typ_statku=4)then
  688. begin
  689. y:=random(9)+1;
  690. x:=random(9)+1;
  691. for it1:=-1 to 1 do
  692. begin
  693. for it2:=-1 to 1 do
  694. begin
  695. if ((it1=0) AND (it2=0)) then continue;
  696. if ((tab2[y+it1][x+it2]=0) AND (tab2[y+1+it1][x+1+it2]=0) AND (tab2[y+1+it1][x+it2]=0))then
  697. begin
  698. war:=war+1;
  699. end;
  700. end;
  701. end;
  702. if (war=8) then
  703. begin
  704. tab2[y][x]:=a;
  705. tab2[y+1][x]:=a;
  706. tab2[y+1][x+1]:=a;
  707. break;
  708. end;
  709. war:=0;
  710. end;
  711. if (typ_statku=5)then
  712. begin
  713. y:=random(10)+1;
  714. x:=random(9)+1;
  715. for it1:=-1 to 1 do
  716. begin
  717. for it2:=-1 to 1 do
  718. begin
  719. if ((it1=0) AND (it2=0)) then continue;
  720. if ((tab2[y+it1][x+it2]=0) AND (tab2[y+it1][x+1+it2]=0) AND (tab2[y-1+it1][x+1+it2]=0))then
  721. begin
  722. war:=war+1;
  723. end;
  724. end;
  725. end;
  726. if (war=8) then
  727. begin
  728. tab2[y][x]:=a;
  729. tab2[y][x+1]:=a;
  730. tab2[y-1][x+1]:=a;
  731. break;
  732. end;
  733. war:=0;
  734. end;
  735. if (typ_statku=6)then
  736. begin
  737. y:=random(8)+1;
  738. x:=random(10)+1;
  739. for it1:=-1 to 1 do
  740. begin
  741. for it2:=-1 to 1 do
  742. begin
  743. if ((it1=0) AND (it2=0)) then continue;
  744. if ((tab2[y+it1][x+it2]=0) AND (tab2[y+1+it1][x+it2]=0) AND (tab2[y+2+it1][x+it2]=0))then
  745. begin
  746. war:=war+1;
  747. end;
  748. end;
  749. end;
  750. if (war=8) then
  751. begin
  752. tab2[y][x]:=a;
  753. tab2[y+1][x]:=a;
  754. tab2[y+2][x]:=a;
  755. break;
  756. end;
  757. war:=0;
  758. end;
  759. until (stw=1) ;
  760. end;
  761. end;
  762.  
  763. procedure tworzenie_2_k();
  764. var
  765. stw, typ_statku, it1, it2, war, a, x, y : integer;
  766. begin
  767. stw:=0;
  768. for a:=5 to 7 do
  769. begin
  770. war:=0;
  771. repeat
  772. randomize();
  773. typ_statku:=random(2)+1;
  774. if (typ_statku=1)then
  775. begin
  776. y:=random(10)+1;
  777. x:=random(9)+1;
  778. for it1:=-1 to 1 do
  779. begin
  780. for it2:=-1 to 1 do
  781. begin
  782. if ((it1=0) AND (it2=0)) then continue;
  783. if ((tab2[y+it1][x+it2]=0) AND (tab2[y+it1][x+1+it2]=0))then
  784. begin
  785. war:=war+1;
  786. end;
  787. end;
  788. end;
  789. if (war=8) then
  790. begin
  791. tab2[y][x]:=a;
  792. tab2[y][x+1]:=a;
  793. break;
  794. end;
  795. war:=0;
  796. end;
  797. if (typ_statku=2)then
  798. begin
  799. y:=random(9)+1;
  800. x:=random(10)+1;
  801. for it1:=-1 to 1 do
  802. begin
  803. for it2:=-1 to 1 do
  804. begin
  805. if ((it1=0) AND (it2=0)) then continue;
  806. if ((tab2[y+it1][x+it2]=0) AND (tab2[y+1+it1][x+it2]=0))then
  807. begin
  808. war:=war+1;
  809. end;
  810. end;
  811. end;
  812. if (war=8) then
  813. begin
  814. tab2[y][x]:=a;
  815. tab2[y+1][x]:=a;
  816. break;
  817. end;
  818. war:=0;
  819. end;
  820. until (stw=1);
  821. end;
  822. end;
  823.  
  824. procedure tworzenie_1_k();
  825. var
  826. it1, it2, b, war, stw,x, y :integer;
  827. begin
  828. stw:=0;
  829. for b:=1 to 4 do
  830. begin
  831. war:=0;
  832. repeat
  833. y:=random(10)+1;
  834. x:=random(10)+1;
  835. for it1:=-1 to 1 do
  836. begin
  837. for it2:=-1 to 1 do
  838. begin
  839. if ((it1=0) AND (it2=0)) then continue;
  840. if (tab2[y+it1][x+it2]=0) then
  841. begin
  842. war:=war+1;
  843. end;
  844. end;
  845. end;
  846. if (war=8) then
  847. begin
  848. tab2[y][x]:=b;
  849. break;
  850. end;
  851. war:=0;
  852. until (stw=1);
  853. end;
  854. end;
  855.  
  856. procedure tworzenie(var tab:tablica; var tab_c : tablica; gracz : string);
  857. begin
  858. tworzenie_4(tab,tab_c, gracz);
  859. tworzenie_3(tab,tab_c, gracz);
  860. tworzenie_2(tab,tab_c, gracz);
  861. tworzenie_1(tab,tab_c, gracz);
  862. end;
  863.  
  864. procedure tworzenie_k ();
  865. begin
  866. tworzenie_4_k();
  867. tworzenie_3_k();
  868. tworzenie_2_k();
  869. tworzenie_1_k();
  870. end;
  871.  
  872. procedure przerwa();
  873. var
  874. m: integer;
  875. begin
  876. al_clear_to_color( al_screen, al_makecol( 0, 0, 0 ) );
  877. for m:=15 downto 11 do
  878. begin
  879. al_textout_ex(al_screen, al_font, 'Zmiana zawodnika, masz sekund', 310, 300, al_makecol(200,200,200), -1);
  880. al_textout_ex(al_screen, al_font, litery[m], 500, 300, al_makecol(200,200,200), -1);
  881. delay(1000);
  882. al_clear_to_color( al_screen, al_makecol( 0, 0, 0 ) );
  883. end;
  884. al_clear_to_color( al_screen, al_makecol( 0, 0, 0 ) );
  885. end;
  886.  
  887. function powitalny() : byte;
  888. begin
  889. al_textout_centre_ex(al_screen,al_font,'WITAJ W GRZE W STATKI', ScreenWidth div 2, ScreenHeight div 3, al_makecol(200,200,200), -1);
  890. al_textout_ex(al_screen, al_font, 'Wykonal: Kamil Sobolewski Informatyka EAIIB 2015', 800, 700, al_makecol(200,200,200), -1);
  891. al_rectfill( al_screen, 470, 270 , 730, 320, al_makecol( 0, 0, 0 ) );
  892. al_rect( al_screen, 470, 270, 730, 320, al_makecol( 200, 200, 200 ) );
  893. al_textout_ex(al_screen, al_font, 'Gra z innym uzytkownikiem', 500, 295, al_makecol(200,200,200), -1);
  894. al_rectfill( al_screen, 470, 330 , 730, 380, al_makecol( 0, 0, 0 ) );
  895. al_rect( al_screen, 470, 330, 730, 390, al_makecol( 200, 200, 200 ) );
  896. al_textout_ex(al_screen, al_font, 'Gra z komputerem', 540, 360, al_makecol(200,200,200), -1);
  897. repeat
  898. pozycja_myszki();
  899. if((mx>470) AND (mx<730) AND (my<320) AND (my>270))then
  900. begin
  901. al_rectfill( al_screen, 470, 270 , 730, 320, al_makecol( 200, 200, 200 ) );
  902. al_rect( al_screen, 470, 270, 730, 320, al_makecol( 200, 200, 200 ) );
  903. al_textout_ex(al_screen, al_font, 'Gra z innym uzytkownikiem', 500, 295, al_makecol(0,0,0), -1);
  904. end;
  905. if((mx>470) AND (mx<730) AND (my<390) AND (my>330))then
  906. begin
  907. al_rectfill( al_screen, 470, 330 , 730, 390, al_makecol( 200, 200, 200 ) );
  908. al_rect( al_screen, 470, 330, 730, 390, al_makecol( 200, 200, 200 ) );
  909. al_textout_ex(al_screen, al_font, 'Gra z komputerem', 540, 360, al_makecol(0,0,0), -1);
  910. end;
  911. until (mb=1);
  912. if((mx>470) AND (mx<730) AND (my<390) AND (my>330))then
  913. begin
  914. powitalny:=2;
  915. end;
  916. if((mx>470) AND (mx<730) AND (my<320) AND (my>270))then
  917. begin
  918. powitalny:=1;
  919. end;
  920. end;
  921.  
  922. function sprawdzenie ( var tab : tablica; a: integer; b: integer) : integer;
  923. begin
  924. if (tab[a][b]>0) then
  925. begin
  926. if (((tab[a+1][b]=0) OR (tab[a+1][b]=-10)OR (tab[a+1][b]=-9)) AND ((tab[a-1][b]=0) OR (tab[a-1][b]=-10)OR (tab[a-1][b]=-9)) AND ((tab[a][b+1]=0) OR (tab[a][b+1]=-10)OR (tab[a][b+1]=-9)) AND ((tab[a][b-1]=0)OR (tab[a][b-1]=-10)OR (tab[a][b-1]=-9)))then
  927. begin
  928. al_rectfill( al_screen, 240, 415 , 1000, 440, al_makecol( 0, 0, 0 ) );
  929. al_textout_ex(al_screen, al_font, 'Trafiony, zatopiony!', 310, 420, al_makecol(200,200,200), -1);
  930. tab[a][b]:=-11;
  931. sprawdzenie:=1;
  932. end
  933. else
  934. begin
  935. al_rectfill( al_screen, 240, 415 , 1000, 440, al_makecol( 0, 0, 0 ) );
  936. al_textout_ex(al_screen, al_font, 'Trafiony, niezatapiony!', 310, 420, al_makecol(200,200,200), -1);
  937. tab[a][b]:=-10;
  938. sprawdzenie:=2;
  939. end;
  940. end
  941. else
  942. begin
  943. tab[a][b]:=-9;
  944. sprawdzenie:=3;
  945. al_rectfill( al_screen, 240, 415 , 1000, 440, al_makecol( 0, 0, 0 ) );
  946. al_textout_ex(al_screen, al_font, 'Pudlo!', 310, 420, al_makecol(200,200,200), -1);
  947. end;
  948. end;
  949.  
  950. procedure ruch ( var tab : tablica; var tab_c : tablica; var tab_wys : tablica;gracz: string);
  951. var
  952. m, a, b, i, iterator1,iterator2, check : integer;
  953. begin
  954. clear();
  955. m:=0;
  956. i:=0;
  957. wyswietl(tab_wys, tab_c, gracz,-2);
  958. al_textout_ex(al_screen, al_font, 'Twoj ruch, wybierz pole i strzelaj', 310, 400, al_makecol(200,200,200), -1);
  959. repeat
  960. begin
  961. mb:=0;
  962. repeat
  963. pozycja_myszki();
  964. przekroczenie_1(35, 350, 65, 360);
  965. until ((mb=1) AND (przekroczenie_1(35,350,65,360)=false));
  966. if ((tab_c[((my-65)DIV 30)+1][((mx-35)DIV 30)+1]<>-1) AND (tab_c[((my-65)DIV 30)+1][((mx-35) DIV 30)+1]<>-2) AND (tab_c[((my-65)DIV 30)+1][((mx-35) DIV 30)+1]<>-3)) then
  967. begin
  968. a:=((my-65)DIV 30)+1;
  969. b:=((mx-35) DIV 30)+1;
  970. check:=sprawdzenie(tab,a,b);
  971. if (check=1) then
  972. begin
  973. tab_c[a][b]:=-3;
  974. for iterator1:=-3 to 3 do
  975. begin
  976. for iterator2:=-3 to 3 do
  977. begin
  978. if((iterator1=0) AND (iterator2=0)) then break;
  979. if(tab[a+iterator1][b+iterator2]=-10) then
  980. begin
  981. if ((a+iterator1>11) OR (a+iterator1<0) OR (b+iterator2>11) OR (b+iterator2<0)) then
  982. break;
  983. tab[a+iterator1][b+iterator2]:=-11;
  984. tab_c[a+iterator1][b+iterator2]:=-3;
  985. end;
  986. end;
  987. end;
  988. end;
  989. if (check=2) then tab_c[a][b]:=-2;;
  990. if (check=3) then tab_c[a][b]:=-1;
  991. m:=1;
  992. if (i<>0) then
  993. begin
  994. al_textout_ex(al_screen, al_font, 'To pole bylo wybrane wczesniej', 310, 420, al_makecol(0,0,0), -1);
  995. end;
  996. end
  997. else
  998. begin
  999. al_textout_ex(al_screen, al_font, 'To pole bylo wybrane wczesniej', 310, 420, al_makecol(200,200,200), -1);
  1000. end;
  1001. i:=i+1;
  1002. end;
  1003. until (m=1);
  1004. wyswietl(tab_wys, tab_c, gracz,-2);
  1005. delay(1000);
  1006. end;
  1007.  
  1008. function warunek_gry (tab1 : tablica; tab2 : tablica) : integer;
  1009. var
  1010. i, j : integer;
  1011. licznik1, licznik2 : integer;
  1012. begin
  1013. licznik1:=0;
  1014. licznik2:=0;
  1015. for i:=1 to 10 do
  1016. begin
  1017. for j:=1 to 10 do
  1018. begin
  1019. if (tab1[i][j]<=0) then licznik1:=licznik1+1;
  1020. if (tab2[i][j]<=0) then licznik2:=licznik2+1;
  1021. end;
  1022. end;
  1023. if (licznik1=100) then warunek_gry:=0;
  1024. if (licznik2=100) then warunek_gry:=1;
  1025. if((licznik1<>100) AND (licznik2<>100))then warunek_gry:=2;
  1026. end;
  1027.  
  1028. procedure dwoch_graczy ();
  1029. var
  1030. wygrany : string;
  1031. warunek : integer;
  1032. begin
  1033. wyswietl(tab1,tab1_c, 'Gracz 1.',-1);
  1034. tworzenie(tab1,tab1_c, 'Gracz 1.');
  1035. przerwa();
  1036. wyswietl(tab2,tab2_c, 'Gracz 2.', -1);
  1037. tworzenie(tab2,tab2_c, 'Gracz 2.');
  1038. przerwa();
  1039. warunek:=5;
  1040. repeat
  1041. ruch(tab2, tab1_c, tab1, 'Gracz 1.');
  1042. warunek:=warunek_gry(tab1,tab2);
  1043. if((warunek=0) OR (warunek=1)) then break;
  1044. delay(1500);
  1045. przerwa();
  1046. clear();
  1047. ruch(tab1, tab2_c, tab2, 'Gracz 2.');
  1048. delay(1500);
  1049. warunek:=warunek_gry(tab1,tab2);
  1050. if((warunek=0) OR (warunek=1)) then break;
  1051. przerwa();
  1052. clear();
  1053. until ((warunek=0) OR (warunek=1));
  1054. if (warunek_gry(tab1, tab2)=0) then wygrany:='Gracz 2.';
  1055. if (warunek_gry(tab1, tab2)=1) then wygrany:='Gracz 1.';
  1056. clear();
  1057. koniec(wygrany);
  1058. end;
  1059.  
  1060. procedure komputer ();
  1061. begin
  1062. wyswietl(tab2,tab2_c, 'Komputer',-1);
  1063. tworzenie_k();
  1064. wyswietl(tab2,tab2_c, 'Komputer',-1);
  1065. end;
  1066.  
  1067. begin
  1068. inicjalizuj();
  1069. tryb:=powitalny();
  1070. delay(500);
  1071. clear();
  1072. case tryb of
  1073. 1 : dwoch_graczy();
  1074. 2 : komputer();
  1075. end;
  1076. al_readkey;
  1077. al_exit();
  1078. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!