Turbo Pascal
Twoje źródło wiedzy o Turbo Pascalu.
  
Szukanie zaawansowane
    
 
Home Rejestracja FAQ Użytkownicy Grupy Galerie  
  Zaloguj się, by sprawdzić wiadomości Zaloguj  
   
 


Forum Turbo Pascal Strona Główna Kody źródłowe War [wersja testowa]
Wyświetl posty z ostatnich:   
       
Napisz nowy temat  Odpowiedz do tematu

Śro 18:59, 05 Kwi 2006
Autor Wiadomość
rafael
Administrator



Dołączył: 07 Lut 2006
Posty: 72
Przeczytał: 0 tematów

Ostrzeżeń: 0/3
Skąd: Pszczyna
Temat postu: War [wersja testowa]
TESTOWA GRA WAR. PROSZĘ WAS O PODAWANIE BŁĘDÓW, KTÓRE ZNAJDZIECIE W GRZE, LUB SWOJE POMYSŁY JAK JĄ UROZMAICIĆ. Z GÓRY DZIĘKUJE!

NIE DZIAŁAJĄCE FUNKCJE:
-wczytaj grę
-niedostępna postać zakapturzonego człowieka w karczmie
-brak ograniczenia ruchu (można chodzić np. po lesie lub wychodzić poza mape)
-niedostępna pomoc


Kod:
program war;

{$APPTYPE CONSOLE}

uses
  crt;


type
  Tgracz=record
    imie: string;
    wojsko: integer;
    doswiadczenie: integer;
    wytrzymalosc: integer;
    obwarowanie: boolean;
    zloto: integer;
  end;

procedure losuj_wydarzenie(var czlowiek: Tgracz; var komputer: Tgracz; tura: integer);forward;

procedure start(var czlowiek: Tgracz);
begin
  czlowiek.wojsko := 300;
  czlowiek.doswiadczenie := 10;
  czlowiek.wytrzymalosc := 100;
end;

function losuj_imie: string;
var
  imie: array[1..20] of string;
  x: byte;
begin
  imie[1] := 'Valhari';
  imie[2] := 'Rafael';
  imie[3] := 'EL Polaco';
  imie[4] := 'Tommus';
  imie[5] := 'Meshif';
  imie[6] := 'Quaran';
  imie[7] := 'Felix';
  imie[8] := 'Hannibal';
  imie[9] := 'Spartakus';
  imie[10] := 'Pompejusz';
  imie[11] := 'Xay';
  imie[12] := 'Tuxer';
  imie[13] := 'Alibaba';
  imie[14] := 'Elzix';
  imie[15] := 'Szymonson';
  imie[16] := 'Bolbin';
  imie[17] := 'Helmut';
  imie[18] := 'Weron';
  imie[19] := 'Zygzan';
  imie[20] := 'Traton';
  randomize;
  x := random(20)+1;
  losuj_imie := imie[x];
end;

procedure losuj_przeciwnika(var czlowiek: Tgracz; var komputer: Tgracz);
var
  y: byte;
begin
  randomize;
  komputer.wojsko := random(czlowiek.wojsko)+200;
  komputer.doswiadczenie := random(czlowiek.doswiadczenie)+random(czlowiek.doswiadczenie)+1;
  komputer.wytrzymalosc := random(50)+51;
  komputer.imie := losuj_imie;
  y := random(2)+1;
    if y = 1 then komputer.obwarowanie := true;
    if y = 2 then komputer.obwarowanie := false;
end;

procedure przegrana;
begin
  window(1,1,80,80);
  textbackground(black);
  clrscr;
  gotoxy(30,10);
  textcolor(white);
  writeln('G A M E   O V E R');
  gotoxy(28,12);
  writeln('www.turbopascal.cba.pl');
  delay(5000);
  halt;
end;

procedure bitwa(var czlowiek: Tgracz; var komputer: Tgracz);
var
  sila: array[1..2] of real;
  x: integer;
  odpowiedz: char;
  zdobyte_dos: real;
begin
  randomize;
  writeln('WALKA!!!');
  losuj_przeciwnika(czlowiek,komputer);
  writeln('Imie: ',komputer.imie);
  x:=random(50);
  writeln('Wojsko ok. ',komputer.wojsko-x);
  write('Obwarowanie: ');
    if komputer.obwarowanie = true then writeln('jest')
      else
        writeln('nie ma');
  x := random(10);
    if komputer.doswiadczenie < x then x := 0;
  writeln('Przypuszczalne doswiadczenie: ',komputer.doswiadczenie-x);
  writeln;
  write('Walczysz? (T)ak / (N)ie: ');
  repeat
    odpowiedz:=readkey;
  until odpowiedz in ['T','t','N','n'];
    if odpowiedz in ['N','n'] then
      begin
        clrscr;
        x:=random(czlowiek.wojsko);
        writeln('Podczas ucieczki straciles ',x,' zolnierzy');
        czlowiek.wojsko := czlowiek.wojsko - x;
          if czlowiek.wojsko <= 0 then przegrana;
      end;
    if odpowiedz in ['T','t'] then
      begin
          if czlowiek.obwarowanie = true then czlowiek.doswiadczenie := czlowiek.doswiadczenie + 10;
        sila[1] := czlowiek.doswiadczenie * czlowiek.wytrzymalosc/100;
          if komputer.obwarowanie = true then komputer.doswiadczenie := komputer.doswiadczenie + 10;
        sila[2] := komputer.doswiadczenie * komputer.wytrzymalosc/100;
          repeat
            clrscr;
            writeln('B I T W A ! ! !');
            komputer.wojsko := komputer.wojsko - round(sila[1]);
              if komputer.wojsko < 0 then komputer.wojsko := 0;
            czlowiek.wojsko := czlowiek.wojsko - round(sila[2]);
              if czlowiek.wojsko < 0 then czlowiek.wojsko := 0;
            writeln('Twoja armia: ',czlowiek.wojsko);
            writeln('Armia ',komputer.imie,': ',komputer.wojsko);
            delay(300);
          until (komputer.wojsko <= 0) or (czlowiek.wojsko <= 0);
          delay(1000);
          if czlowiek.wojsko <= 0 then przegrana;
          if komputer.wojsko <= 0 then
            begin
              clrscr;
              x:=random(5)+1;
              writeln('Zdobyles ',x,' skrzynie zlota');
              czlowiek.zloto := czlowiek.zloto + x;
              zdobyte_dos := komputer.doswiadczenie / 5;
              writeln('Zdobyles ',round(zdobyte_dos),' punkty doswiadczenia');
              czlowiek.doswiadczenie := czlowiek.doswiadczenie + round(zdobyte_dos);
            end;
      end;
end;

procedure najemnicy(var czlowiek: Tgracz);
var
  ilu, koszt: integer;
  znak: char;
begin
  koszt:=0;
  ilu:=0;
  repeat
    clrscr;
    writeln('Witaj w gildi najemnikow! ESC-wyjscie;');
    writeln;
    writeln('Ilu najemnikow ma dolaczyc do Twojej armii?');
    writeln('                <- ',ilu,' ->');
    writeln('        Koszt: ',koszt,' - skrzynie zlota');
    znak := readkey;
    if znak=#75 then
      if ilu >= 100 then
        begin
          ilu := ilu-100;
          koszt := koszt-2;
        end;
    if znak=#77 then
      begin
        ilu := ilu+100;
        koszt := koszt+2;
      end;
    if znak=#13 then
      begin
        if (czlowiek.zloto < koszt) or (czlowiek.zloto = 0) then
          writeln('Niestety nie masz wystarczajacych funduszy.');
        if (czlowiek.zloto >= koszt) and (czlowiek.zloto <> 0) then
          begin
            czlowiek.zloto := czlowiek.zloto - koszt;
            czlowiek.wojsko := czlowiek.wojsko + ilu;
            writeln('Do twojej armi dolaczylo ',ilu,' najemnikow.');
          end;
        delay(3000);
      end;
  until znak=#27;
end;

procedure karczma(var czlowiek: Tgracz);
var
  ile, koszt: integer;
  znak: char;
  x: byte;
begin
  koszt:=0;
  ile:=0;
  x:=1;
    repeat
      clrscr;
      textcolor(white);
      writeln('Dzien dobry! Znajdujesz sie w karczmie ESC-wyjscie;');
        if znak=#72 then x := x-1;
        if znak=#80 then x := x+1;
        if x=0 then x := 3;
        if x=4 then x := 1;
          if x=1 then
            textcolor(yellow)
              else
                textcolor(white);
        gotoxy(1,3);
        writeln('Porozmawiaj z zakapturzonym czlowiekiem');
          if x=2 then
            textcolor(yellow)
              else
                textcolor(white);
        gotoxy(9,4);
        writeln('Kup zolnierzom piwo');
          if x=3 then
            textcolor(yellow)
              else
                textcolor(white);
        gotoxy(15,5);
        writeln('Wjscie');
        znak:=readkey;
      if znak=#13 then
        if x=4 then break;
        if x=2 then
          begin
            repeat
              clrscr;
              writeln('Beczki (1 beczka = + 20 wytrzymalosci:');
              writeln('              <- ',ile,' ->');
              writeln('      Koszt: ',koszt,' - skrzynie zlota');
              znak := readkey;
                if znak=#75 then
                  if ile >= 1 then
                    begin
                      ile := ile-1;
                      koszt := koszt-1;
                    end;
                if znak=#77 then
                  begin
                    ile := ile+1;
                    koszt := koszt+1;
                  end;
                if znak=#13 then
                  begin
                    if (czlowiek.zloto >= koszt) and (czlowiek.zloto <> 0) then
                      begin
                        czlowiek.zloto := czlowiek.zloto - koszt;
                        ile := ile * 20;
                        czlowiek.wytrzymalosc := czlowiek.wytrzymalosc + ile;
                          if czlowiek.wytrzymalosc > 100 then czlowiek.wytrzymalosc := 100;
                        writeln('Pomyslnie zakonczyles transakcje! Twoja obecna wytrzymalosc: ',czlowiek.wytrzymalosc);
                        delay(3000);
                        break;
                      end;
                    if (czlowiek.zloto < koszt) or (czlowiek.zloto = 0) then
                      writeln('Niestety nie masz wystarczajacych funduszy.');
                    delay(3000);
                  end;
              until znak=#27;
            end;
          if x=1 then
            begin
              {czlowiek dajacy questy}
            end;
    until znak=#27;
end;

procedure uniwersytet(var czlowiek: Tgracz);
var
  ile, koszt: integer;
  znak: char;
begin
  koszt:=0;
  ile:=0;
  repeat
    clrscr;
    writeln('Wchodzac tu masz nadziejie, ze zdolasz sie czegos nauczyc; ESC-wyjscie;');
    writeln;
    writeln('O ile chcesz podniesc swoje doswiadczenie?');
    writeln('                <- ',ile,' ->');
    writeln('        Koszt: ',koszt,' skrzynie zlota');
    znak := readkey;
    if znak=#75 then
      if ile >= 1 then
        begin
          ile := ile-1;
          koszt := koszt-2;
        end;
    if znak=#77 then
      begin
        ile := ile+1;
        koszt := koszt+2;
      end;
    if znak=#13 then
      begin
        if (czlowiek.zloto < koszt) or (czlowiek.zloto = 0) then
          writeln('Niestety nie masz wystarczajacych funduszy.');
        if (czlowiek.zloto >= koszt) and (czlowiek.zloto <> 0) then
          begin
            czlowiek.zloto := czlowiek.zloto - koszt;
            czlowiek.doswiadczenie := czlowiek.doswiadczenie + ile;
            writeln('Twoje doswiadczenie wzroslo o ',ile,' punktow.');
          end;
        delay(3000);
      end;
  until znak=#27;
end;


procedure miasto (var czlowiek: Tgracz);
var
  znak: char;
  x: byte;
begin
  window(1,1,55,55);
  textbackground(black);
  clrscr;
  x:=1;
    repeat
      clrscr;
      if znak=#72 then x := x-1;
      if znak=#80 then x := x+1;
      if x=0 then x := 4;
      if x=5 then x := 1;
      textcolor(white);
      gotoxy(11,1);
      writeln('MIASTO');
        if x=1 then
          textcolor(yellow)
            else
              textcolor(white);
      gotoxy(7,3);
      writeln('Gildia najemnikow');
        if x=2 then
          textcolor(yellow)
            else
              textcolor(white);
      gotoxy(11,4);
      writeln('Karczma');
        if x=3 then
          textcolor(yellow)
            else
              textcolor(white);
      gotoxy(9,5);
      writeln('Uniwersytet');
        if x=4 then
          textcolor(yellow)
            else
              textcolor(white);
      gotoxy(11,6);
      writeln('Wyjscie');
        znak := readkey;
      if znak=#13 then
        begin
          if x=1 then najemnicy(czlowiek);
          if x=2 then karczma(czlowiek);
          if x=3 then uniwersytet(czlowiek);
          if x=4 then break;
        end;
    until znak=#27;
end;






procedure losuj_wydarzenie(var czlowiek: Tgracz; var komputer: Tgracz; tura:integer);
var
  wydarzenie: byte;
  liczba: integer;
  y: real;
  znak: char;
begin
  window(1,1,55,55);
  textbackground(black);
  clrscr;
  czlowiek.obwarowanie := false;
  writeln('Chcesz wybudowac umocnienia wokol twojego obozu?');
  writeln('Koszty: 5 pkt wytrzymalosci; 1 skrzynia zlota;');
  writeln('(T)ak / (N)ie: ');
  repeat
    znak := readkey;
  until znak in['T','t','N','n'];
    if znak in ['T','t'] then
      begin
          if (czlowiek.wytrzymalosc < 5) or (czlowiek.zloto < 1) then
            writeln('Masz za malo zlota lub punktow wytrzymalosci!');
          if (czlowiek.wytrzymalosc >= 5) and (czlowiek.zloto >= 1) then
            begin
              czlowiek.wytrzymalosc := czlowiek.wytrzymalosc - 5;
              czlowiek.zloto := czlowiek.zloto - 1;
              czlowiek.obwarowanie := true;
              writeln('Wybudowales umocnienia!');
            end;
      end;
    if znak in ['N','n'] then writeln('Twoj oboz pozostal bez umocnien');
  delay(2000);
  clrscr;
  writeln('DZIEN: ',tura);
  randomize;
  wydarzenie := random(5)+1;
    if wydarzenie = 1 then
      begin
        y := random(czlowiek.wojsko)/2;
        liczba := round(y);
        writeln('Do twojej armii dolacza ',liczba,' zolnierzy');
        czlowiek.wojsko := czlowiek.wojsko + liczba;
        writeln('Obecnie posiadasz: ',czlowiek.wojsko, ' zolnierzy');
      end;
    if wydarzenie = 2 then
      begin
        liczba := random(30)+1;
        writeln('Twoi zolnierze napotkali przeszkode na drodze');
        writeln('ominiecie jej kosztuje twoje wojsko ',liczba,' wytrzymalosci');
        czlowiek.wytrzymalosc := czlowiek.wytrzymalosc-liczba;
        writeln('Wytrzymalosc wojska: ',czlowiek.wytrzymalosc);
      end;
    if wydarzenie = 3 then
      begin
        writeln('Podroz przebiega bez przeszkod');
        czlowiek.wytrzymalosc := 100;
        writeln('Wytrzymalosc twojego wojska sie odnowila.');
      end;
    if wydarzenie in [4,5,6] then
      begin
        bitwa(czlowiek, komputer);
      end;
end;

procedure ugruntowanie;
var
  pos1,pos2,i, k: byte;
begin
  window(60,5,75,20);
  textbackground(brown);
  clrscr;
  pos1:=16;
  pos2:=16;
  gotoxy(pos1,pos2);
  write('M');
  textbackground(green);
  for k := 1 to 14 do
    for i := 4+k to 16 do
      writexy('L',i,k);
  for k := 14 downto 1 do
    for i :=  1 to 14-k do
      writexy('L',i,k);
  textbackground(lightcyan);
    writexy('Z',9,6);
  textbackground(green);
end;

procedure mapa(var czlowiek: Tgracz; var komputer: Tgracz);
var
  x,y: byte;
  znak: char;
  tura: integer;
begin
  ugruntowanie;
  x:=14;
  y:=15;
  gotoxy(x,y);
  write('@');
  tura:=0;
  repeat
  ugruntowanie;
  textbackground(brown);
  textcolor(black);
  gotoxy(x,y);
  write('@');
    repeat
      znak := readkey;
    until znak in [#75,#72,#80,#77];
    if znak=#80 then
      begin
        y := y + 1;
        gotoxy(x,y-1);
        write (' ');
        gotoxy(x,y);
        write('@');
      end;
    if znak=#72 then
      begin
        y := y - 1;
        gotoxy(x,y+1);
        write (' ');
        gotoxy(x,y);
        write('@');
      end;
    if znak=#77 then
      begin
        x := x + 1;
        gotoxy(x-1,y);
        write (' ');
        gotoxy(x,y);
        write('@');
      end;
    if znak=#75 then
      begin
        x := x - 1;
        gotoxy(x+1,y);
        write (' ');
        gotoxy(x,y);
        write('@');
      end;
    textcolor(white);
    if (x=16) and (y=15) then miasto(czlowiek)
      else
        begin
          tura:=tura+1;
          losuj_wydarzenie(czlowiek,komputer,tura);
        end;
    textcolor(white);
    until znak=#27;
end;


procedure menu(var czlowiek: Tgracz; var komputer: Tgracz);
var
  znak: char;
  x: byte;
begin
  x:=1;
  repeat
      if znak = #72 then x := x-1;
      if znak = #80 then x := x+1;
      if x = 0 then x := 4;
      if x = 5 then x := 1;
    if x=1 then textcolor(yellow)
      else
        textcolor(white);
    gotoxy(35,10);
    writeln('NOWA GRA');
    if x=2 then textcolor(yellow)
      else
        textcolor(white);
    gotoxy(34,11);
    writeln('WCZYTAJ GRE');
    if x=3 then textcolor(yellow)
      else
        textcolor(white);
    gotoxy(36,12);
    writeln('POMOC');
    if x=4 then textcolor(yellow)
      else
        textcolor(white);
    gotoxy(35,13);
    writeln('WYJSCIE');
    znak := readkey;
  until znak in [#13,#27];
  clrscr;
    if x = 1 then
      begin
        start(czlowiek);
        mapa(czlowiek,komputer);
      end;
end;

procedure logo;
begin
  textcolor(lightred);
  gotoxy(29,2);
  write('#   #    ###    ####');
  gotoxy(29,3);
  write('#   #   #   #   #   #');
  gotoxy(29,4);
  write('# # #   #####   #### ');
  gotoxy(29,5);
  write('# # #   #   #   # #  ');
  gotoxy(29,6);
  write(' ###    #   #   #  # ');
  gotoxy(28,7);
  write('-----------------------');
  gotoxy(33,15);
  WRITE('AUTOR: RAFAEL');
  gotoxy(26,16);
  WRITE('WSZYSTKIE PRAWA ZASTRZEZONE.');
end;

var
  czlowiek: Tgracz;
  komputer: Tgracz;

begin
  logo;
  menu(czlowiek,komputer);
end.


:arrow: Plik *.exe [link widoczny dla zalogowanych]

Post został pochwalony 0 razy
 
Zobacz profil autora
      Do góry  
Śro 0:00, 24 Maj 2006
Autor Wiadomość
PoOm
Początkujący



Dołączył: 23 Maj 2006
Posty: 15
Przeczytał: 0 tematów

Ostrzeżeń: 2/3
Skąd: Thousand thousand miles away..
Temat postu:
NIe wnikam w kod ;s ale gierka mało ciekawa ;s

Post został pochwalony 0 razy
 
Zobacz profil autora
      Do góry  

Śro 12:56, 24 Maj 2006
Autor Wiadomość
rafael
Administrator



Dołączył: 07 Lut 2006
Posty: 72
Przeczytał: 0 tematów

Ostrzeżeń: 0/3
Skąd: Pszczyna
Temat postu:
Zrób lepszą i zaprezentuj ją nam Blue_Light_Colorz_PDT_25 . I najlepiej gdyby miała te 5 tysięcy linijek kodu o których wspominałeś w jednym z Twoich postów Blue_Light_Colorz_PDT_02 .

Post został pochwalony 0 razy
 
Zobacz profil autora
      Do góry  

Śro 14:00, 24 Maj 2006
Autor Wiadomość
PoOm
Początkujący



Dołączył: 23 Maj 2006
Posty: 15
Przeczytał: 0 tematów

Ostrzeżeń: 2/3
Skąd: Thousand thousand miles away..
Temat postu:
Co do gierek to moge ci udostępnic moje projekty gier....
"Pech chciał" ze pisane sa w C++ i OpenGL z wykozystaniem WinApi.
(i nie maja 5k linijek kodu około 5 tysiecy ma baza danch).
Ofcoze umieszczam tylko exeki. ( do projektow napisanych w c++).
Mam równiez nadzieje, ze skaczą sie wtedy twoje sarkastyczne komenty
w stylu "no to pokaz". Zaczołem pisac na tym forum by pomagac innym i
sie od nich uczyć a nie sie przechwalac itd....
Moje programy umieszcze w nowym poscie w projektach.
PoOm project.

Post został pochwalony 0 razy
 
Zobacz profil autora
      Do góry  

Śro 14:36, 24 Maj 2006
Autor Wiadomość
rafael
Administrator



Dołączył: 07 Lut 2006
Posty: 72
Przeczytał: 0 tematów

Ostrzeżeń: 0/3
Skąd: Pszczyna
Temat postu:
Przepraszam jeśli Cię uraziłem Blue_Light_Colorz_PDT_17 . Nie chodzi mi o C++ czy OpenGL tylko o gre napisaną w Pascalu Blue_Light_Colorz_PDT_15 I cieszę się, że w końcu ktoś zaczął pisać na forum Blue_Light_Colorz_PDT_18

Post został pochwalony 0 razy
 
Zobacz profil autora
      Do góry  

Śro 15:27, 24 Maj 2006
Autor Wiadomość
PoOm
Początkujący



Dołączył: 23 Maj 2006
Posty: 15
Przeczytał: 0 tematów

Ostrzeżeń: 2/3
Skąd: Thousand thousand miles away..
Temat postu:
Ja tez musze cos przeprosic w koncu chodzi tu o programowanie a nie
o to czy gierka jest ciekawa czy nie ;s

Gierek w pascalu nie pisalem(nie mam czasu). Uzywanie pascala
wymuszał na mnie los a ze wymuszał dlugo i systematycznie to troche
sie nauczyłem.....wiec cos z tym chce robic....

Spis projektow i tych w opengl /c++ i tych w pascalu umiescilem w dziale
projekty. ( takze linki do .exe-ków (rarów))

Post został pochwalony 0 razy
 
Zobacz profil autora
      Do góry  

Czw 1:59, 26 Kwi 2007
Autor Wiadomość
Doendedes52
Początkujący



Dołączył: 26 Kwi 2007
Posty: 6
Przeczytał: 0 tematów

Ostrzeżeń: 0/3
Temat postu:
Doendedes52's free adult video storage:
[link widoczny dla zalogowanych]

Post został pochwalony 0 razy
 
Zobacz profil autora
      Do góry  

Pon 0:52, 30 Kwi 2007
Autor Wiadomość
Xhard
Początkujący



Dołączył: 30 Kwi 2007
Posty: 9
Przeczytał: 0 tematów

Ostrzeżeń: 0/3
Temat postu:
wow, look at that!
[link widoczny dla zalogowanych]

Post został pochwalony 0 razy
 
Zobacz profil autora
      Do góry  
Napisz nowy temat  Odpowiedz do tematu

 
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach

      Do góry  

Strona 1 z 1
Skocz do:  


fora.pl - załóż własne forum dyskusyjne za darmo
Powered by phpBB © 2001, 2002 phpBB Group
Avalanche style by What Is Real © 2004
             
Regulamin
Na skróty:Turbo PascalStrona wwwInnePytaniaKody źródłoweHydeParkPropozycjeBłędyWasze projektyOgłoszeniaNewsy