API tools faq
paste
asmodeus94

samochodzikLaczone

asmodeus94
Jun 5th, 2012
113
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 19.43 KB | None | 0 0
raw download clone embed print report
  1. program grafika;
  2. uses graph,crt;
  3.  
  4. type
  5.  podKropki = record
  6.  x,y,kolor : integer;
  7.  end;
  8.  wspIKolSam = record
  9.  x,y,kolor : integer;
  10.  end;
  11.  all = record
  12.  x,y,posx,posy,spd,cp1,cp2,cp3,cp4,li: integer;
  13.  tabKrop : array [1..3,1..3] of podKropki;
  14.  samoInf : array [1..10,1..10] of wspIKolSam;
  15.  end;
  16.  
  17. var
  18. ster,tryb:smallint;
  19. a:char;
  20. tab:array [1..4] of all;
  21. car:array [1..10,1..10,1..8] of byte; {grafika samochodzikow}
  22. flaga,fora,flaga2:integer;
  23. s,t:integer;
  24. tmp,tmp1,tmp2,licz,barx,samx,samy : integer;
  25. gr,ilgr: byte;
  26. ostRuch : char;
  27.  
  28.  
  29. label resetuje;
  30. const
  31. odstTex = 55; {odstep w poziomie miedzy menu i podmenu}
  32. dlT = 4;
  33.  
  34. pozx_b = 100;
  35. pozy_b = 100;           {wywalic}
  36. pozx_o = 300;
  37. pozy_o = 100;
  38. pozx_d = 500;
  39. pozy_d = 100;
  40. pozx_d2 = 300;
  41. pozy_d2 = 300;
  42.  
  43. var
  44. tabMenuT : array [1..dlT,1..2] of string; {menuowska tablica}
  45.  
  46. {-------------------------intro}
  47.  
  48. function obetnij(lancuch:string;aktProc:real):string;
  49. var c : byte;wyn : string;
  50. begin
  51. wyn:='';
  52. for c:=1 to 4 do begin
  53.     if lancuch[c]<>'.' then wyn:=wyn+lancuch[c];
  54. end;if aktProc<10 then wyn:=lancuch[1]+lancuch[2];if aktProc=100 then wyn:=wyn+'0';
  55. wyn:=wyn+'%';
  56. obetnij:=wyn;
  57. end;
  58.  
  59. procedure samd(samx,samy:integer);
  60. begin
  61.       putpixel(samx,samy,white);
  62.       putpixel(samx+1,samy,white);
  63.       putpixel(samx+1,samy+1,white);
  64.       putpixel(samx,samy+1,white);
  65.       putpixel(samx-1,samy-1,white);
  66.       putpixel(samx-1,samy+2,white);
  67.       putpixel(samx+2,samy+2,white);
  68.       putpixel(samx+2,samy-1,white);
  69.       putpixel(samx+2,samy+4,white);
  70.       putpixel(samx+2,samy-3,white);
  71.       putpixel(samx-2,samy-3,white);
  72.       putpixel(samx-2,samy+4,white);
  73.       line(samx-4,samy-2,samx+4,samy-2);
  74.       line(samx-4,samy+3,samx+4,samy+3);
  75.       line(samx-3,samy-3,samx-3,samy+4);
  76.       line(samx-4,samy-3,samx-4,samy+4);
  77.       line(samx+3,samy-3,samx+3,samy+4);
  78.       line(samx+4,samy-2,samx+4,samy+3);
  79. end;
  80.  
  81.  
  82. procedure pasek;
  83. var
  84. proc : real; dx:integer;st : string;bylEnter : byte;
  85. begin
  86. dx:=0;bylEnter:=0;
  87. REPEAT
  88. setlinestyle(1,1,3);setfillstyle(9,blue);
  89. bar3d((getmaxx-500)div 2,getmaxy div 2,(getmaxx-500)div 2+dx,getmaxy div 2-50,10,true);
  90. dx:=dx+1;
  91. proc:=(dx / 500*100);
  92. str(proc,st);
  93. setlinestyle(0,1,1);bar((getmaxx+4) div 2,getmaxy div 2-25,(getmaxx+55) div 2,getmaxy div 2-17);
  94. outTextxy((getmaxx-3) div 2,(getmaxy-50) div 2,obetnij(st,proc));
  95. delay(5);
  96. samx:=((getmaxx-500)div 2);
  97. barx:=((getmaxx-500)div 2)-5;
  98. repeat
  99. setlinestyle(0,1,1);setfillstyle(9,black);
  100. samx:=samx+10;
  101. barx:=barx+10;
  102. samd(samx,300);
  103. bar(((getmaxx-500)div 2),295,barx,305);
  104. until samx>=((getmaxx-500)div 2+dx);
  105. if keypressed then bylEnter:=1;
  106. UNTIL (dx=500)OR(keypressed);
  107. if bylEnter=0 then delay(3000);cleardevice;
  108. end;
  109. {/ ---------------------------intro}
  110.  
  111. {***GRAFIKA***}
  112.  
  113. procedure beczka(pozx_b,pozy_b:integer);
  114. begin
  115.  setlinestyle(0,0,1);
  116.  SetColor(yellow);
  117.  SetFillStyle(1,red);
  118.  FillEllipse(pozx_b,pozy_b, 5, 3);
  119.  Line(pozx_b-5,pozy_b,pozx_b-5,pozy_b+8);
  120.  Line(pozx_b+5,pozy_b,pozx_b+5,pozy_b+8);
  121.  FillEllipse(pozx_b,pozy_b+8, 5, 3);
  122.  SetColor(red);
  123.  Line(pozx_b-4,pozy_b+2,pozx_b-4,pozy_b+9);
  124.  Line(pozx_b-3,pozy_b+3,pozx_b-3,pozy_b+9);
  125.  Line(pozx_b-2,pozy_b+4,pozx_b-2,pozy_b+9);
  126.  Line(pozx_b-1,pozy_b+4,pozx_b-1,pozy_b+9);
  127.  Line(pozx_b,pozy_b+4,pozx_b,pozy_b+9);
  128.  Line(pozx_b+1,pozy_b+4,pozx_b+1,pozy_b+9);
  129.  Line(pozx_b+2,pozy_b+4,pozx_b+2,pozy_b+9);
  130.  Line(pozx_b+3,pozy_b+3,pozx_b+3,pozy_b+9);
  131.  Line(pozx_b+4,pozy_b+2,pozx_b+4,pozy_b+9);
  132.  PutPixel(pozx_b,pozy_b+9,LightRed);
  133.  PutPixel(pozx_b-1,pozy_b+9,LightRed);
  134.  PutPixel(pozx_b-2,pozy_b+9,LightRed);
  135.  PutPixel(pozx_b-3,pozy_b+8,LightRed);
  136.  PutPixel(pozx_b-4,pozy_b+7,LightRed);
  137.  PutPixel(pozx_b+1,pozy_b+9,LightRed);
  138.  PutPixel(pozx_b+2,pozy_b+9,LightRed);
  139.  PutPixel(pozx_b+3,pozy_b+8,LightRed);
  140.  PutPixel(pozx_b+4,pozy_b+7,LightRed);
  141.  PutPixel(pozx_b,pozy_b+8,LightRed);
  142.  PutPixel(pozx_b-1,pozy_b+8,LightRed);
  143.  PutPixel(pozx_b-2,pozy_b+8,LightRed);
  144.  PutPixel(pozx_b-3,pozy_b+7,LightRed);
  145.  PutPixel(pozx_b-4,pozy_b+6,LightRed);
  146.  PutPixel(pozx_b+1,pozy_b+8,LightRed);
  147.  PutPixel(pozx_b+2,pozy_b+8,LightRed);
  148.  PutPixel(pozx_b+3,pozy_b+7,LightRed);
  149.  PutPixel(pozx_b+4,pozy_b+6,LightRed);
  150.  PutPixel(pozx_b+2,pozy_b,255);
  151.  {PutPixel(pozx_b+2,pozy_b-1,black); }
  152.  PutPixel(pozx_b+1,pozy_b-1,255);
  153.  PutPixel(pozx_b+1,pozy_b,255);
  154. end;
  155.  
  156. procedure odblask(pozx_o,pozy_o:integer);
  157. begin
  158.  PutPixel(pozx_o-2+licz,pozy_o-2+licz,lightgray);
  159.  PutPixel(pozx_o-3+licz,pozy_o-1+licz,lightgray);
  160.  PutPixel(pozx_o-4+licz,pozy_o-1+licz,lightgray);
  161.  PutPixel(pozx_o-5+licz,pozy_o-1+licz,lightgray);
  162. end;
  163.  
  164. procedure olej_1(pozx_o,pozy_o:integer);
  165. begin randomize;
  166.  SetColor(blue);
  167.  SetFillStyle(1,blue);
  168.  FillEllipse(pozx_o,pozy_o, 5, 3);
  169.  for tmp:=1 to 10 do
  170.  begin
  171.   FillEllipse(pozx_o+(random(15)),pozy_o+(random(15)), 5, 3);
  172.  end;
  173.  for tmp:=1 to 3 do
  174.  begin
  175.   licz:=licz+random(8);
  176.   odblask(pozx_o,pozy_o);
  177.  end;
  178. end;
  179.  
  180. procedure drzewo_1(pozx_d,pozy_d:integer);
  181. begin
  182.  SetColor(yellow);
  183.  Line(pozx_d,pozy_d+6,pozx_d+10,pozy_d+16);
  184.  Line(pozx_d,pozy_d+6,pozx_d-10,pozy_d+16);
  185.  Line(pozx_d+10,pozy_d+16,pozx_d-10,pozy_d+16);
  186.  {floodfill(pozx_d,pozy_d+8,green);}
  187.  Line(pozx_d,pozy_d+16,pozx_d+12,pozy_d+26);
  188.  Line(pozx_d,pozy_d+16,pozx_d-12,pozy_d+26);
  189.  Line(pozx_d-12,pozy_d+26,pozx_d+12,pozy_d+26);
  190.  Line(pozx_d,pozy_d+26,pozx_d+16,pozy_d+36);
  191.  Line(pozx_d,pozy_d+26,pozx_d-16,pozy_d+36);
  192.  Line(pozx_d-16,pozy_d+36,pozx_d+16,pozy_d+36);
  193.  Rectangle(pozx_d-2,pozy_d+36,pozx_d+2,pozy_d+44);
  194.  SetFillStyle(1,brown);
  195.  {floodfill(pozx_d,pozy_d+40,brown);}
  196. end;
  197.  
  198. procedure drzewo_2(pozx_d,pozy_d:integer);
  199. begin
  200.  SetColor(green);
  201.  SetFillStyle(6{6},green);
  202.  FillEllipse(pozx_d2,pozy_d2, 8, 4);
  203.  FillEllipse(pozx_d2-4,pozy_d2+2, 8, 4);
  204.  FillEllipse(pozx_d2+4,pozy_d2+2, 8, 4);
  205.  FillEllipse(pozx_d2,pozy_d2+4, 8, 4);
  206.  FillEllipse(pozx_d2-6,pozy_d2+5, 8, 4);
  207.  FillEllipse(pozx_d2+6,pozy_d2+6, 8, 4);
  208.  FillEllipse(pozx_d2-8,pozy_d2+10, 8, 4);
  209.  FillEllipse(pozx_d2+9,pozy_d2+10, 8, 4);
  210.  FillEllipse(pozx_d2,pozy_d2+13, 8, 4);
  211.  FillEllipse(pozx_d2+9,pozy_d2+18, 8, 4);
  212.  FillEllipse(pozx_d2-9,pozy_d2+17, 8, 4);
  213.  FillEllipse(pozx_d2-2,pozy_d2+17, 8, 4);
  214.  FillEllipse(pozx_d2-7,pozy_d2+22, 8, 4);
  215.  FillEllipse(pozx_d2+7,pozy_d2+23, 8, 4);
  216.  FillEllipse(pozx_d2+8,pozy_d2+25, 8, 4);
  217.  FillEllipse(pozx_d2+5,pozy_d2+28, 8, 4);
  218.  FillEllipse(pozx_d2-6,pozy_d2+25, 8, 4);
  219.  FillEllipse(pozx_d2-4,pozy_d2+28, 8, 4);
  220.  FillEllipse(pozx_d2-3,pozy_d2+30, 8, 4);
  221.  FillEllipse(pozx_d2+3,pozy_d2+30, 8, 4);
  222.  SetFillStyle(1,brown);
  223.  SetColor(brown);
  224.  Rectangle(pozx_d2-2,pozy_d2+34,pozx_d2+2,pozy_d2+45);
  225.  {floodfill(pozx_d2,pozy_d2+40,brown);}
  226. end;
  227.  
  228. procedure mapa(ktoraMapa:byte);
  229. begin
  230.  case ktoraMapa of
  231.   1: begin {elipsa}
  232.       ellipse(300,240,0,360,180,220);
  233.       ellipse(300,240,0,360,100,120);
  234.       setfillstyle(1,green);
  235.       floodfill(320,240,white);
  236.       floodfill(1,1,white);
  237.       line(120,240,200,240);
  238.      end;
  239.   2:
  240.   begin {kffiatek}
  241.    setfillstyle(1,green);
  242.    bar(0,0,640,480);
  243.  
  244.    setcolor(white);
  245.    ellipse(320,240,30,150,70,220);
  246.    ellipse(320,240,210,330,70,220);
  247.  
  248.    ellipse(320,240,45,135,30,140);
  249.    ellipse(320,240,225,315,30,140);
  250.  
  251.    ellipse(320,240,0,60,220,70);
  252.    ellipse(320,240,300,360,220,70);
  253.    ellipse(320,240,120,240,220,70);
  254.  
  255.    ellipse(320,240,0,45,140,30);
  256.    ellipse(320,240,315,360,140,30);
  257.    ellipse(320,240,135,225,140,30);
  258.  
  259.    ellipse(200,120,277,353,101,101);
  260.    ellipse(200,120,275,355,60,60);
  261.  
  262.    ellipse(440,120,187,263,101,101);
  263.    ellipse(440,120,185,265,60,60);
  264.  
  265.    ellipse(200,360,7,83,101,101);
  266.    ellipse(200,360,5,85,60,60);
  267.  
  268.    ellipse(440,360,97,173,101,101);
  269.    ellipse(440,360,95,175,60,60);
  270.  
  271.    setfillstyle(1,0);
  272.    floodfill(180,240,white);
  273.  
  274.    setlinestyle(dashedln,0,3);
  275.  
  276.    for tmp1:=45 to 135 do
  277.    begin
  278.     if tmp1 mod 6 = 0 then
  279.     begin
  280.      tmp2:=tmp2+1;
  281.      if tmp2 mod 2 = 0 then setcolor(red) else setcolor(white);
  282.      ellipse(320,240,tmp1,tmp1+5,30,140);
  283.     end;
  284.     {setlinestyle(0,0,3);}
  285.    end;
  286.   end;
  287.  end;
  288. end;
  289. {samochodziki}
  290. procedure wzorSam(samx,samy:integer;wybor:char);
  291. begin
  292. case wybor of
  293. 'w' : begin      {gora}
  294.       putpixel(samx,samy,white);
  295.       putpixel(samx+1,samy,white);
  296.       putpixel(samx,samy+1,white);
  297.       putpixel(samx+1,samy+1,white);
  298.       putpixel(samx-1,samy-1,white);
  299.       putpixel(samx-1,samy+2,white);
  300.       putpixel(samx+2,samy-1,white);
  301.       putpixel(samx+2,samy+2,white);
  302.       putpixel(samx-3,samy+3,white);
  303.       putpixel(samx+4,samy+3,white);
  304.       putpixel(samx-3,samy-1,white);
  305.       putpixel(samx+4,samy-1,white);
  306.       line(samx-3,samy-2,samx+4,samy-2);
  307.       line(samx-2,samy-3,samx+3,samy-3);
  308.       line(samx-2,samy-4,samx+3,samy-4);
  309.       line(samx-2,samy+5,samx-2,samy-4);
  310.       line(samx+3,samy+5,samx+3,samy-4);
  311.       line(samx-3,samy+4,samx+4,samy+4);
  312.       line(samx-3,samy+5,samx+4,samy+5);
  313.       end;
  314.  
  315. 'q' : begin
  316.       putpixel(samx-2,samy-2,white);
  317.       putpixel(samx+1,samy+1,white);
  318.       putpixel(samx-2,samy+2,white);
  319.       putpixel(samx-1,samy+2,white);
  320.       putpixel(samx+2,samy-2,white);
  321.       putpixel(samx+2,samy-1,white);
  322.       putpixel(samx-4,samy-1,white);
  323.       putpixel(samx-1,samy-4,white);
  324.       line(samx-3,samy,samx+4,samy);
  325.       line(samx,samy-3,samx,samy+4);
  326.       line(samx-3,samy-2,samx-3,samy+1);
  327.       line(samx-2,samy-3,samx+1,samy-3);
  328.       line(samx+1,samy+4,samx+4,samy+1);
  329.       line(samx+1,samy+5,samx+5,samy+1);
  330.       line(samx+2,samy+5,samx+5,samy+2);
  331.       end;
  332.       end;
  333. end;
  334. procedure macheSamo(ktory : byte);{ktory samochod i wsplorzedne}
  335. var i,j,m1,m2,kolor,getKolor : integer;
  336. begin
  337. m1:=tab[gr].posx-4;m2:=tab[gr].posy-4;
  338. for i:=1 to 10 do begin
  339.     for j:=1 to 10 do begin
  340.         if car[i,j,ktory]=1 then
  341.         begin
  342.          if gr=1 then kolor:=cyan;
  343.          if gr=2 then kolor:=yellow;
  344.          if gr=3 then kolor:=red;
  345.          if gr=4 then kolor:=lightgreen;
  346.          getKolor:=getpixel(i+m1,j+m2);
  347.          if (getKolor<>cyan)AND(getKolor<>yellow)AND(getKolor<>red)AND(getKolor<>lightgreen) then begin
  348.          tab[gr].samoInf[i,j].kolor:=getKolor;
  349.          tab[gr].samoInf[i,j].x:=i+m1;tab[gr].samoInf[i,j].y:=j+m2;
  350.          end;
  351.          putpixel(i+m1,j+m2,kolor);
  352.         end;
  353.     end;
  354. end;
  355. end;
  356. procedure sprzSamo;
  357. var i,j,m1,m2 : integer;
  358. begin
  359. for i:=1 to 10 do begin
  360.     for j:=1 to 10 do begin
  361.          putpixel(tab[gr].samoInf[i,j].x,tab[gr].samoInf[i,j].y,tab[gr].samoInf[i,j].kolor);
  362.         end;
  363.     end;
  364. end;
  365. procedure doTaba(ktoreCar : byte); {zapisanie wszystkich samochodow do car}
  366. var x,y,x1,y1,z : integer;
  367. f : text;
  368. begin
  369. case ktoreCar of
  370. 1:begin {prosty}
  371.   Assign(F, 'sam.txt');
  372.   Rewrite(F);
  373.       for x:=1 to 10 do begin
  374.           for y:=1 to 10 do begin
  375.               if getpixel(x,y)=white then car[x,y,1]:=1 else car[x,y,1]:=0;
  376.               Write(F, car[x,y,1],' ');
  377.               end;
  378.               writeln(F,'');
  379.           end;
  380.       Close(F);
  381.       cleardevice;
  382.       Assign(F, 'sam.txt');
  383.       Reset(F);
  384.       for x:=1 to 10 do begin
  385.           for y:=10 downto 1 do begin
  386.               Read(F,car[x,y,2]);
  387.               end;
  388.               readln(F);
  389.           end;
  390.  
  391.       reset(F);
  392.       for x:=1 to 10 do begin
  393.           for y:=10 downto 1 do begin
  394.               read(F,car[y,x,3]);
  395.               end;
  396.       readln(F);
  397.           end;
  398.       reset(f);
  399.       for x:=1 to 10 do begin
  400.           for y:=1 to 10 do begin
  401.               read(f,car[y,x,4]);
  402.               end;
  403.       readln(f);
  404.           end;
  405.       Close(F);
  406.       end;
  407. 2:begin {ukos}
  408.   Assign(F, 'sam1.txt');
  409.   Rewrite(F);
  410.       for x:=1 to 10 do begin
  411.           for y:=1 to 10 do begin
  412.               if getpixel(x,y)=white then car[x,y,5]:=1 else car[x,y,5]:=0;
  413.               Write(F, car[x,y,5],' ');
  414.               end;
  415.               writeln(F,'');
  416.           end;
  417.           Close(F);
  418.       Assign(F, 'sam1.txt');
  419.       Reset(F);
  420.       Begin
  421.       for x:=1 to 10 do begin
  422.           for y:=10 downto 1 do begin
  423.               Read(F,car[x,y,6]);
  424.               end;
  425.           end;
  426.       readln(F);
  427.       end;
  428.       reset(f);
  429.       for x:=1 to 10 do begin
  430.           for y:=10 downto 1 do begin
  431.               read(f,car[y,x,7]);
  432.               end;
  433.       readln(f);
  434.           end;
  435.       reset(f);
  436.       for x:=10 downto 1 do begin
  437.           for y:=10 downto 1 do begin
  438.               read(f,car[x,y,8]);
  439.               end;
  440.       readln(f);
  441.           end;
  442.       Close(F);
  443. end;
  444. end;
  445. end;
  446. procedure genSam(ruch:char);
  447. var i : byte;st : string;
  448. begin
  449. st:='wxdaqzec';
  450. for i:=1 to length(st) do begin
  451.   if ruch = st[i] then macheSamo(i);
  452. end;
  453. end;
  454. procedure zaladujSamochody;
  455. begin
  456. wzorSam(5,5,'w');doTaba(1);cleardevice;wzorSam(5,5,'q'); doTaba(2); cleardevice;
  457.  
  458. end;
  459. {***KONIEC GRAFIKI***}
  460.  
  461. procedure mozliwe(s,t : integer;wypCzys : byte);
  462. var i,j : byte;
  463. begin i:=0;
  464. s:=tab[gr].posx-tab[gr].x-9;
  465. REPEAT
  466. i:=i+1;j:=0;t:=tab[gr].posy-tab[gr].y-9;
  467.        REPEAT
  468.        j:=j+1;
  469.        if wypCzys=1 then begin {przed ruchem}
  470.        tab[gr].tabKrop[i,j].x:=s;
  471.        tab[gr].tabKrop[i,j].y:=t;
  472.        tab[gr].tabKrop[i,j].kolor:=getpixel(s,t);
  473.        if gr=1 then putpixel(s,t,cyan);
  474.        if gr=2 then putpixel(s,t,yellow);
  475.        if gr=3 then putpixel(s,t,red);
  476.        if gr=4 then putpixel(s,t,lightgreen);
  477.        {putpixel(s,t,15);} {po ruchu}
  478.        end ELSE putpixel(tab[gr].tabKrop[i,j].x,tab[gr].tabKrop[i,j].y,tab[gr].tabKrop[i,j].kolor);
  479.        t:=t+9;
  480.        UNTIL j=3;
  481. s:=s+9;
  482. UNTIL i=3;
  483. end;
  484. {*** sekcja menu ***}
  485. procedure wysAktMenu(wybor,ktoreMenu : byte); {do wyswietlania menu}
  486. var i,j : byte;
  487. begin
  488. j:=3;
  489. for i:=1 to dlT do begin
  490.    setColor(white);
  491.        if wybor=i then begin
  492.           setColor(red);
  493.        end;
  494.        outTextXY((getmaxx-length(tabMenuT[i,ktoreMenu])) div 2+(ktoreMenu-1)*odstTex,getmaxy div 2-j*10,tabMenuT[i,ktoreMenu]);
  495.        j:=j-1;
  496.    end;
  497. end;
  498. procedure menuTablica; {optymalizacja, zeby rekurencyjnie}
  499. begin                  {nie nadpisywal tablicy pare raz}
  500.  {glowneMenu}
  501.  tabMenuT[1,1]:='Start';
  502.  tabMenuT[2,1]:='Opcje';
  503.  tabMenuT[3,1]:='About';
  504.  tabMenuT[4,1]:='Koniec';
  505.  {podMenu}
  506.  tabMenuT[1,2]:='1 gracz';
  507.  tabMenuT[2,2]:='2 graczy';
  508.  tabMenuT[3,2]:='3 graczy';
  509.  tabMenuT[4,2]:='4 graczy';
  510. end;
  511. procedure menu(menuPod : byte); {interakcja z uzytkownikiem (tyko zmiana wartosci)}
  512. var wyborMenu : char;wyborLicz : shortint;wyborLicz1,wyborLicz2,przed1,przed2,i,j : byte;
  513. {tabMenuT : array [1..3] of string;}
  514. begin
  515.  wyborLicz:=1;
  516.  wysAktMenu(1,menuPod);
  517.  REPEAT
  518.  wyborMenu:=readkey;
  519.  case wyborMenu of
  520.   'w','W':begin wyborLicz:=wyborLicz-1; end;
  521.   's','S':begin wyborLicz:=wyborLicz+1; end;
  522.   'a','A':begin menuPod:=menuPod-1;
  523.   if menuPod=0 then menuPod:=1;
  524.   cleardevice;
  525.   for i:=1 to menuPod do begin wysAktMenu(1,i);end;menu(menuPod);break;end;
  526.   end;
  527.  if wyborLicz=0 then wyborLicz:=4;
  528.  if wyborLicz=5 then wyborLicz:=1;
  529.  case menuPod of
  530.   1:begin wyborLicz1:=wyborLicz; end;{glowne}
  531.   2:begin wyborLicz2:=wyborLicz; end;
  532.  end;
  533.  wysAktMenu(wyborLicz,menuPod);
  534.  UNTIL (wyborMenu=#13)OR(wyborMenu='a')OR(wyborMenu='D')OR(wyborMenu='d');
  535. if menuPod = 1 then begin
  536.  if wyborLicz1 = 1 then begin cleardevice;{mapa(2);}end;
  537.  if wyborLicz1 = 2 then begin menu(2);end;
  538.  if wyborLicz1 = 3 then begin outtextxy(1,1,'Autorzy');readkey;cleardevice;menu(1);end;
  539.  if wyborLicz1 = 4 then halt;
  540. end;
  541. if menuPod = 2 then begin
  542.  if wyborLicz2 = 1 then ilGr:=1;
  543.  if wyborLicz2 = 2 then ilGr:=2;
  544.  if wyborLicz2 = 3 then ilGr:=3;
  545.  if wyborlicz2 = 4 then ilGr:=4;
  546.  menuPod:=menuPod-1;
  547.  cleardevice;
  548.  menu(menuPod);
  549. end;
  550. end;
  551. {/ menu}
  552.  
  553. procedure dane;
  554. var
  555.  st:string;
  556. begin
  557.  settextstyle(1,0,1); outtextxy(513,420,'SPEED:'); str(tab[gr].spd,st); outtextxy(605,420,st);
  558.  outtextxy(513,435,'RUCH NR:'); str(tab[gr].li,st); outtextxy(605,435,st);
  559. end;
  560.  
  561. procedure hud(gr:byte);
  562. var st,st1 : string;
  563. begin
  564.  setfillstyle(1,0);
  565.  bar(500,390,630,470);
  566.  settextstyle(1,0,2);
  567.  if gr=1 then setcolor(cyan);
  568.  if gr=2 then setcolor(yellow);
  569.  if gr=3 then setcolor(red);
  570.  if gr=4 then setcolor(lightgreen);
  571.  st:='GRACZ';str(gr,st1);
  572.  st:=st+' '+st1;
  573.  outtextxy(513,395,st);dane;
  574. end;
  575.  
  576.  
  577.  
  578. procedure sprawdzcp;
  579. var tmp1:byte;
  580. begin
  581.  if (tab[gr].posx>460) and (tab[gr].posx<540) and (tab[gr].posy>180) and (tab[gr].posy<300) then tab[gr].cp1:=tab[gr].cp1+1;
  582.  if (tab[gr].posx>100) and (tab[gr].posx<180) and (tab[gr].posy>180) and (tab[gr].posy<240) then tab[gr].cp2:=tab[gr].cp2+1;
  583.  if (tab[gr].posx>260) and (tab[gr].posx<380) and (tab[gr].posy>380) and (tab[gr].posy<460) then tab[gr].cp3:=tab[gr].cp3+1;
  584.  if (tab[gr].posx>260) and (tab[gr].posx<380) and (tab[gr].posy>20)  and (tab[gr].posy<100) then
  585.  begin
  586.   tab[gr].cp4:=tab[gr].cp4+1;
  587.   tab[gr].cp1:=0;
  588.  end;
  589. { writeln(tab[gr].cp1,' ',tab[gr].cp2,' ',tab[gr].cp3,' ',tab[gr].cp4);} {na off bo sprawdzam samochody}
  590.  {bar(460,180,540,300);
  591.  bar(100,180,180,240);      pozycje cp
  592.  bar(260,380,380,460);
  593.  bar(260,20,380,100);}
  594.  if (tab[gr].cp1>0) and (tab[gr].cp2>0) and (tab[gr].cp3>0) and (tab[gr].cp4>0) then
  595.  outtextxy(20,20,'PANIE KMIE CHECKPOINTY DZIALAJA, BEZ ODBIORU');
  596. end;
  597.  
  598. {***GLOWNY BEGIN***}
  599.  
  600. begin
  601.  ster:=VGA;  tryb:=VGAHi; gr:=1;
  602.  InitGraph(ster, tryb, '');
  603.  ilGr:=2; ostRuch:='w';
  604.  resetuje:
  605.  pasek;readkey;                {pasek ladowania - mozna rypnac intro}
  606.  zaladujSamochody;menuTablica;
  607.  menu(1);
  608.  tab[1].posx:=170; tab[1].posy:=240;
  609.  tab[2].posx:=150; tab[2].posy:=240;   {pozycja startowa}
  610.  tab[3].posx:=130; tab[3].posy:=240;
  611.  tab[4].posx:=110; tab[4].posy:=240;
  612.  tab[1].li:=1;
  613.  tab[2].li:=1;
  614.  tab[3].li:=1;
  615.  tab[4].li:=1;
  616.  mapa(2);
  617.  hud(gr);
  618.  gr:=1;
  619.  olej_1(pozx_o,pozy_o); beczka(pozx_b,pozy_b);
  620.  drzewo_1(pozx_d,pozy_d);drzewo_2(pozx_d2,pozy_d2);
  621.  
  622.  flaga:=0;
  623.  REPEAT
  624.   hud(gr);
  625.   mozliwe(tab[gr].posx-tab[gr].x,tab[gr].posy-tab[gr].y,1); {rysuj kropki}
  626.   a:=readkey;
  627.   sprzSamo;
  628.   case a of
  629.    'q','Q':begin tab[gr].y:=tab[gr].y+10; tab[gr].x:=tab[gr].x+10; flaga2:=1; end;
  630.    'w','W':begin tab[gr].y:=tab[gr].y+10; flaga2:=1; end;
  631.    'e','E':begin tab[gr].y:=tab[gr].y+10; tab[gr].x:=tab[gr].x-10; flaga2:=1; end;
  632.    'a','A':begin tab[gr].x:=tab[gr].x+10; flaga2:=1; end;
  633.    's','S':begin tab[gr].y:=tab[gr].y+0;  tab[gr].x:=tab[gr].x+0;  flaga2:=1; end;
  634.    'd','D':begin tab[gr].x:=tab[gr].x-10; flaga2:=1; end;
  635.    'z','Z':begin tab[gr].y:=tab[gr].y-10; tab[gr].x:=tab[gr].x+10; flaga2:=1; end;
  636.    'x','X':begin tab[gr].y:=tab[gr].y-10; flaga2:=1; end;
  637.    'c','C':begin tab[gr].y:=tab[gr].y-10; tab[gr].x:=tab[gr].x-10; flaga2:=1; end;
  638.    'l':begin cleardevice; goto resetuje; end;
  639.   end;
  640.   if flaga2=1 then
  641.   begin
  642.    if getpixel(tab[gr].posx-tab[gr].x,tab[gr].posy-tab[gr].y)=green then flaga:=1;
  643.    if gr=1 then setcolor(cyan);
  644.    if gr=2 then setcolor(yellow);
  645.    if gr=3 then setcolor(red);
  646.    if gr=4 then setcolor(lightgreen);
  647.    setlinestyle(dottedln,0,1);
  648.    line(tab[gr].posx,tab[gr].posy,tab[gr].posx-tab[gr].x,tab[gr].posy-tab[gr].y);
  649.    tab[gr].posx:=tab[gr].posx-tab[gr].x;
  650.    tab[gr].posy:=tab[gr].posy-tab[gr].y;
  651.  
  652.    if flaga=1 then   {wjazd na pobocze}
  653.    begin
  654.     tab[gr].x:=0;
  655.     tab[gr].y:=0;
  656.     flaga:=0;
  657.    end;
  658.    if tab[gr].x>tab[gr].y then tab[gr].spd:=tab[gr].x else tab[gr].spd:=tab[gr].y; {szybkosc}
  659.  
  660.    {setlinestyle(0,0,1);
  661.    circle(tab[gr].posx,tab[gr].posy,3);}
  662.    if a<>'s' then ostRuch:=a ELSE a:=ostRuch;
  663.    genSam(a);
  664.    sprawdzcp;
  665.    mozliwe(tab[gr].posx-tab[gr].x,tab[gr].posy-tab[gr].y,2);
  666.    tab[gr].li:=tab[gr].li+1;
  667.    gr:=gr+1;
  668.    if gr=ilgr+1 then gr:=1;
  669.    flaga2:=0;
  670.    hud(gr);
  671.   end;
  672.  
  673.  UNTIL (a='b') or (a='B');
  674.  
  675. closegraph;
  676. end.
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
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!