home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG133.ARC / VILLAGE2.ARC / VILLAGER.PAS < prev    next >
Pascal/Delphi Source File  |  1988-08-07  |  13KB  |  382 lines
  1. program Villager;
  2. { A multi-user game written by Andrew Scott. This version: 2
  3.   Needs: VILLAGER.INC - Include file. }
  4.  
  5. const
  6.   version = 'Version 2'; { Villager version no. }
  7.   movelimit = 30; { Maximum moves. }
  8.   xvill = 7; { X and Y co-indinates for }
  9.   yvill = 7; { village and start pos.   }
  10.   xmax = 15; { Maximum X and Y }
  11.   ymax = 15; { co-ordinates.   }
  12.   foodneeded = 10; { Food to complete game }
  13.   price = 2; { Price to hire a scout }
  14.   bonuspoints = 2500; { Bonus points gained when game completed }
  15.   fightbonus = 150; { Bonus points gained when a fight won }
  16.  
  17. type
  18.   strng = string[80];
  19.   people = record { Data for players }
  20.     name: strng;
  21.     xpos, ypos, gold, foodheld, foodrtrn, scouts, bonus: integer;
  22.     dead, expert, played: boolean;
  23.     end;
  24.   others = record { Data for computer players }
  25.     name: strng;
  26.     xpos, ypos, gold, foodheld: integer;
  27.     villager, friendly: boolean;
  28.     end;
  29.   pozzis = array[1..xmax,1..ymax]of integer; { Data for grid }
  30.  
  31. var
  32.   personfile: file of people; { File with players on it }
  33.   person: people; { A player }
  34.   player: people; { The player }
  35.   otherfile: file of others; { File with computer players on it }
  36.   other: others; { A computer player }
  37.   grid: pozzis; { Grid Map }
  38.   i, { Misc. uses }
  39.   turns: integer; { Turns used }
  40.   occupied: boolean;
  41.   inp: strng; { Player input stack }
  42.   lucky: array[1..2]of integer; { Position of random gold }
  43.   newspaper: file of strng; { Newspaper file }
  44.  
  45. {$I VILLAGER.INC} { Include File }
  46.  
  47. procedure instructions; { Displays instructions on run }
  48. var
  49.   inp: strng;
  50.  
  51.   begin
  52.     write('Do you want instructions [Y,n] ? ');
  53.     inp:=getinput;
  54.     if inp='' then inp:='Y';
  55.     if inp='Y' then begin
  56.       writeln('Villager  -  Instructions');
  57.       writeln;
  58.       writeln('  You are a villager from an African tribe, the one of the');
  59.       writeln('tribes to cease being hunters and gatherers. But.. after a');
  60.       writeln('long drought, your herds have died and with them most of your');
  61.       writeln('people.');
  62.       writeln('  You have been sent out to roam the land, gathering enough');
  63.       writeln('food for your village, but a few things make it harder than');
  64.       writeln('it seems. Firstly, most of the other tribes are savages, and');
  65.       writeln('would kill you for your insolence.. tresspassing on their');
  66.       writeln('hunting grounds. There are also strangers wandering the land,');
  67.       writeln('eager to capture your gold.. for there is gold out in the land.');
  68.       writeln('But the people you meet may care to swap, so your job is not');
  69.       writeln('too difficult. You might find some wealth lying on the ground!');
  70.       writeln('  You can wander the land on a ',xmax,' x ',ymax,
  71.         ' grid, where there are');
  72.       writeln('3 other tribes hunting. Your village is at position ',
  73.         xvill,',',yvill,' and');
  74.       writeln('when you gather food, you can return there to leave it, otherwise');
  75.       writeln('others may steal it from you when you rest. For you can only');
  76.       writeln('move ',movelimit,
  77.         ' spaces per day. You may use scouts to check possible directions,');
  78.       writeln('and then go that direction. When you have collected (then');
  79.       writeln('deposited) ',foodneeded,
  80.         ' loads of food, you have won. Good luck!!');
  81.       writeln; write('Press RETURN to continue. ');
  82.       inp:=getinput
  83.     end;
  84.   end;
  85.  
  86. procedure initialise; { Initialises files first time and sets grid }
  87. var
  88.   i, j: integer;
  89.   inp: strng;
  90.  
  91.   begin
  92.     for i:=1 to ymax do begin for j:=1 to xmax do begin
  93.       grid[j,i]:=0
  94.     end; end;
  95.     {$I-} reset(otherfile); {$I+}
  96.     if IOresult<>0 then begin
  97.       rewrite(otherfile);
  98.       with other do begin
  99.         name:='An unfamiliar tribesman';
  100.         xpos:=random(xmax)+1; ypos:=random(ymax)+1; gold:=0; foodheld:=1;
  101.         villager:=true; friendly:= false;
  102.       end;
  103.       write(otherfile,other);
  104.       with other do begin
  105.         name:='A wandering stranger';
  106.         xpos:=random(xmax)+1; ypos:=random(ymax)+1; gold:=0; foodheld:=1;
  107.         villager:=false; friendly:= true;
  108.       end;
  109.       write(otherfile,other);
  110.       with other do begin
  111.         name:='A skillful warrior';
  112.         xpos:=random(xmax)+1; ypos:=random(ymax)+1; gold:=1; foodheld:=0;
  113.         villager:=true; friendly:= false;
  114.       end;
  115.       write(otherfile,other);
  116.       with other do begin
  117.         name:='Another tribesman';
  118.         xpos:=random(xmax)+1; ypos:=random(ymax)+1; gold:=1; foodheld:=1;
  119.         villager:=true; friendly:=true;
  120.       end;
  121.       write(otherfile,other);
  122.       with other do begin
  123.         name:='A strange person';
  124.         xpos:=random(xmax)+1; ypos:=random(ymax)+1; gold:=0; foodheld:=0;
  125.         villager:=false; friendly:=false;
  126.       end;
  127.       write(otherfile,other);
  128.       reset(otherfile);
  129.     end;
  130.     for i:=1 to 5 do begin
  131.       read(otherfile,other);
  132.       grid[other.xpos,other.ypos]:= grid[other.xpos,other.ypos]+1;
  133.     end;
  134.     close(otherfile);
  135.     reset(personfile);
  136.     while not eof(personfile) do begin
  137.       read(personfile,person);
  138.       if (player.name<>person.name) and (not person.dead) then
  139.         grid[person.xpos,person.ypos]:= grid[person.xpos,person.ypos]+1;
  140.     end;
  141.     close(personfile);
  142.   end;
  143.  
  144. function personnum(line: strng): integer; { Checks for player & loads it }
  145. var
  146.   i: integer;
  147.  
  148.   begin
  149.     i:=0;
  150.     {$I-} reset(personfile); {$I+}
  151.     if IOresult<>0 then begin
  152.       rewrite(personfile);
  153.       person:=player;
  154.       write(personfile,person);
  155.       i:=-1;
  156.     end
  157.     else begin
  158.       person.name:='';
  159.       while (person.name<>line) and not eof(personfile) do begin
  160.         read(personfile,person);
  161.         i:=i+1
  162.       end;
  163.       if eof(personfile) and (person.name<>line) then begin
  164.         person:=player;
  165.         write(personfile,person);
  166.         i:=0-i;
  167.       end;
  168.     end;
  169.     close(personfile);
  170.     if i<0 then setpaper('New player '+player.name+' plays game.') else
  171.       setpaper(player.name+' plays game.');
  172.     player:=person;
  173.     personnum:=i
  174.   end;
  175.  
  176. procedure save; { Saves player and erases mistakes in file }
  177. var
  178.   afile: file of people;
  179.   bfile: file of others;
  180.   a: people;
  181.  
  182.   begin
  183.     assign(afile,'VILL3.DAT');
  184.     assign(bfile,'VILL3.DAT');
  185.     rewrite(afile);
  186.     reset(personfile);
  187.     a.name:='';
  188.     while not eof(personfile) do begin
  189.       read(personfile,person);
  190.       if person.name<>a.name then begin
  191.         if person.name=player.name then write(afile,player)
  192.           else write(afile,person);
  193.       end;
  194.       a:= person;
  195.     end;
  196.     rewrite(personfile);
  197.     reset(afile);
  198.     while not eof(afile) do begin
  199.       read(afile,person);
  200.       write(personfile,person);
  201.     end;
  202.     close(personfile);
  203.     close(afile); erase(afile);
  204.     reset(otherfile);
  205.     rewrite(bfile);
  206.     for i:=1 to 5 do begin
  207.       read(otherfile,other);
  208.       other.xpos:=other.xpos+i;
  209.       if other.xpos>xmax then other.xpos:=other.xpos-xmax;
  210.       other.ypos:=other.ypos-i+1;
  211.       if other.ypos<1 then other.ypos:=other.ypos+ymax;
  212.       write(bfile,other);
  213.     end;
  214.     reset(bfile);
  215.     rewrite(otherfile);
  216.     for i:=1 to 5 do begin read(bfile,other); write(otherfile,other) end;
  217.     close(otherfile);
  218.     close(bfile); erase(bfile);
  219.   end;
  220.  
  221. procedure leave; { Leave/Take food at/from village }
  222. var
  223.   i: integer;
  224.   inp: strng;
  225.  
  226.   begin
  227.     if (player.xpos<>xvill) or (player.ypos<>yvill)
  228.       then writeln('You can only leave food at your tribe.') else begin
  229.       writeln('You have ',player.foodheld,' amounts of food on you..');
  230.       writeln('The tribe has ',player.foodrtrn,' amounts of food.');
  231.       writeln;
  232.       repeat
  233.         write('Options: Give or Take food, or Quit [g,t,Q]? ');
  234.         inp:=getinput;
  235.       until (inp='G') or (inp='T') or (inp='Q') or (inp='');
  236.       if inp='G' then begin
  237.         repeat
  238.           write('How much food will you give? ');
  239.           i:= strint(getinput);
  240.         until (i>=0) and (i<=player.foodheld);
  241.         player.foodrtrn:=player.foodrtrn+i;
  242.         player.foodheld:=player.foodheld-i;
  243.         case i of
  244.           0: writeln('Your tribe is confused.');
  245.           1: writeln('Your tribe is grateful.');
  246.           else writeln('Your tribe rejoices!');
  247.         end;
  248.         if player.foodrtrn>foodneeded-1 then begin
  249.            setpaper(player.name+' completes game!');
  250.            writeln('You have completed the game!!',#7,#7);
  251.            player.bonus:=player.bonus+bonuspoints;
  252.            player.foodrtrn:=0;
  253.         end;
  254.       end else if inp='T' then begin
  255.         repeat
  256.           write('How much food will you take? ');
  257.           i:= strint(getinput);
  258.         until (i>=0) and (i<=player.foodrtrn);
  259.         player.foodrtrn:=player.foodrtrn-i;
  260.         player.foodheld:=player.foodheld+i;
  261.         case i of
  262.           0: writeln('Your tribe is confused.');
  263.           1: writeln('Your tribe doesn''t like this.');
  264.           else writeln('Your tribe is very angry!');
  265.         end;
  266.       end;
  267.     end;
  268.   end;
  269.  
  270. function confirmed:boolean;
  271. var
  272.   i: strng;
  273.  
  274.   begin
  275.     if inp[1]='Q'then begin
  276.       repeat
  277.         write('Quit. Are you sure [y,N] ? ');
  278.         inp:=getinput;
  279.       until (inp='Y') or (inp='N') or (inp='');
  280.       if inp='Y' then confirmed:=true else confirmed:=false;
  281.     end;
  282.   end;
  283.  
  284. procedure help; { Immediate help on commands }
  285. var
  286.   inp: strng;
  287.  
  288.   begin
  289.     writeln('Villager  -  Help'); writeln;
  290.     writeln('N - Travel North,                      S - Travel South,');
  291.     writeln('E - Travel East,                       W - Travel West,');
  292.     writeln('A - Attack person,                     T - Trade with person,');
  293.     writeln('L - Leave/pick-up food at/from tribe,  P - Display points,');
  294.     writeln('H - This HELP,                         X - Expert mode toggle,');
  295.     writeln('B - Borrow scouts from village,        U - Use scouts,');
  296.     writeln('D - Listen/Use Drums,                  Q - Quit the game.');
  297.     writeln('* Note: You can''t do anything if you lose an attack.'); writeln;
  298.     write('Press RETURN to continue...');
  299.     inp:=getinput; writeln;
  300.   end;
  301.  
  302. begin { Main program }
  303.   writeln('Villager, ',version);
  304.   writeln('A multi-player game by Andrew Scott.'); writeln;
  305.   assign(personfile,'VILL1.DAT');
  306.   assign(otherfile,'VILL2.DAT');
  307.   assign(newspaper,'VILPAPER.DAT');
  308.   instructions; inp:=''; turns:=1;
  309.   with player do begin
  310.   name:=''; gold:=0; xpos:=xvill; ypos:=yvill; foodheld:=0; foodrtrn:=0;
  311.   scouts:=0; bonus:=0; dead:=false; expert:=false;
  312.   end;
  313.   repeat
  314.     write('What is your name or alias? ');
  315.     player.name:= getinput;
  316.   until player.name<>'';
  317.   i:= personnum(player.name);
  318.   if i<0 then writeln('Ah ha! A new player..');
  319.   if player.played then writeln('You have already played today!') else begin
  320.     if player.dead=true then begin
  321.       writeln('You lost a fight, but you are now healed.');
  322.       player.dead:=false;
  323.     end;
  324.     initialise;
  325.     randomize; randomize; lucky[1]:=random(xmax)+1; lucky[2]:=random(ymax)+1;
  326.     repeat
  327.       showgrid(player.xpos,player.ypos);
  328.       if inp='' then
  329.         repeat
  330.           inp:= getinput;
  331.           if inp='' then showgrid(player.xpos,player.ypos);
  332.         until inp<>'';
  333.       if inp[1] in ['N','S','E','W','A','T','L','B','U'] then turns:=turns+1;
  334.       if ((not occupied) and (inp[1] in ['A','T'])) or (((inp[1]='L') or
  335.         (inp[1]='B')) and ((player.xpos<>xvill) or (player.ypos<>yvill))) then
  336.         turns:=turns-1;
  337.       if (not player.dead) and (turns<movelimit+2) then case inp[1] of
  338.         'N': begin
  339.                player.ypos:= player.ypos+1;
  340.                if player.ypos>ymax then player.ypos:=player.ypos-ymax;
  341.              end;
  342.         'S': begin
  343.                player.ypos:= player.ypos-1;
  344.                if player.ypos<1 then player.ypos:=player.ypos+ymax;
  345.              end;
  346.         'E': begin
  347.                player.xpos:= player.xpos+1;
  348.                if player.xpos>xmax then player.xpos:=player.xpos-xmax;
  349.              end;
  350.         'W': begin
  351.                player.xpos:= player.xpos-1;
  352.                if player.xpos<1 then player.xpos:=player.xpos+xmax;
  353.              end;
  354.         'L': leave;
  355.         'A': action(1);
  356.         'T': action(2);
  357.         'B': begin
  358.                if (player.xpos<>xvill) or (player.ypos<>yvill) then
  359.                  writeln('You need to be at your village.')
  360.                else getscout;
  361.              end;
  362.         'U': usescout;
  363.       end;
  364.       if inp[1]='H' then help;
  365.       if inp[1]='P' then points;
  366.       if inp[1]='X' then player.expert:=not player.expert;
  367.       if inp[1]='D' then drums;
  368.       if player.dead and not(inp[1]='Q') then
  369.         writeln('You are injured. When you play again you will be healed.');
  370.       if (turns>movelimit+1) and not(inp[1]='Q') then begin
  371.         writeln('You have expired all ',movelimit,' of your moves.');
  372.         if inp[1] in ['N','S','E','W','L','A','T','B','U'] then turns:=turns-1;
  373.         end;
  374.       if length(inp)>1 then inp:=copy(inp,2,length(inp)-1) else if inp<>'Q' then
  375.         inp:='';
  376.     until (inp='Q') and confirmed;
  377.     writeln('Leaving Villager...');
  378.     player.played:=true;
  379.     save;
  380.   end;
  381. end.
  382.