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.INC

Text File | 1988-08-07 | 19KB | 532 lines

{ Include file for Villager.Pas - Multi-User game }

procedure setpaper(title: strng); { Writes a title to beginning of paper }
var
  inp: strng;

  begin
    {$I-} reset(newspaper); {$I+}
    if ioresult<>0 then rewrite(newspaper);
    while not eof(newspaper) do read(newspaper,inp);
    write(newspaper,title);
    close(newspaper);
  end;

function getinput: strng; { Gets input and converts to upper case }
var
  i, j: integer;
  inp: strng;

  begin
    readln(inp);
    if inp<>'' then begin
      for i:=1 to length(inp) do inp[i]:=upcase(inp[i]);
    end;
    getinput:= inp;
  end;

procedure showgrid(x, y: integer); { Displays info }
var
  i: integer;

  begin
    if inp='' then writeln;
    if (not player.expert) and (inp='') then begin
      writeln('Villager.');
      if player.foodrtrn>foodneeded-1 then
        writeln('You have completed the game!!');
      writeln('You have ',player.foodheld,' amounts of food,');
      writeln(' (',player.foodrtrn,' back at the tribe)');
      writeln(' and ',player.gold,' gold.'); writeln;
      write('You are at position (',x,',',y,') with ',player.scouts,' scouts');
      if (x=xvill) and (y=yvill) then write(' - at your tribe');
      writeln('. ',movelimit+1-turns,' moves left.');
    end else if player.expert and (inp='') then begin
      if player.foodrtrn>foodneeded-1 then writeln('Game completed.');
      writeln('Food.. Held: ',player.foodheld,' and Left: '
        ,player.foodrtrn);
      writeln('Gold: ',player.gold,'. Position: (',x,',',y,') Moves: ',
        movelimit+1-turns);
      writeln('You have ',player.scouts,' scouts.');
    end;
    writeln('You can see:');
    occupied:= false;
    if grid[x,y]<>0 then begin
      occupied:= true;
      reset(otherfile);
      for i:=1 to 5 do begin;
        read(otherfile,other);
        if (other.xpos=x) and (other.ypos=y) then writeln(other.name);
      end;
      close(otherfile);
      reset(personfile);
      i:=0;
      while not eof(personfile) do begin
        read(personfile,person);
        if (person.xpos=x) and (person.ypos=y) and (person.name<>player.name)
          and (not person.dead) then writeln(person.name);
      end;
      close(personfile);
    end;
    writeln('Yourself');
    if (lucky[1]=x) and (lucky[2]=y) then begin
      writeln('.. and some Gold!');
      lucky[1]:=0; lucky[2]:=0; player.gold:=player.gold+1;
    end;
    writeln;
    if inp='' then begin
      write('Enter command: N, S, E, W, ');
      if occupied then write('A, T, ');
      if (x=xvill) and (y=yvill) then write('L, B, ');
      write('U, P, X, D, Help, Q: ');
    end;
  end;

function ten(i: integer):integer; { Makes power of ten }
var
  j, k: integer;

  begin
    j:=1;
    if i<>1 then for k:=1 to i-1 do j:=j*10;
    ten:=j;
  end;

function strint(line: strng):integer; { Converts STRing to INTeger }
var
  i, j: integer;

  begin
    j:=0;
    if line<>'' then begin
      for i:=1 to length(line) do begin
        j:=j+(ord(line[i])-48)*ten(length(line)-i+1);
      end;
    end;
    strint:=j;
  end;

procedure action(opt: integer); { Decides whether to attack or trade }
var
  i: integer;
  who: strng;

  procedure fight(num, datafile: integer); { Fight someone }
  var
    i, j, str1, str2: integer;
    afile: file of people;
    bfile: file of others;
    a: people;
    b: others;

    begin
      str1:=10+player.scouts; str2:=10; j:=1;
      assign(afile,'VILL3.DAT'); assign(bfile,'VILL3.DAT');
      if datafile=2 then begin
        other.gold:=person.gold; other.foodheld:=person.foodheld;
        other.friendly:= false; str2:=str2+person.scouts; end;
      if other.friendly then begin
        writeln('He is astonished at your barbarianism, and you sock him hard.');
        str2:=str2-random(2)-2;
      end;
      if (player.foodheld+player.gold) > (other.foodheld+other.gold)
         then i:=1 else i:=0;
      repeat
        if i=0 then begin
          case random(10)+1 of
            1: writeln('You hurl a rock!');
            2: writeln('He is bleeding.');
            3: writeln('The fool yowls in pain.');
            4: writeln('Another hit!');
            5: writeln('You could be winning...');
            6: writeln('A good blow!');
            7: writeln('You hit him hard!');
            8: writeln('You are gaining ground.');
            9: writeln('You are amazing!');
           10: writeln('A great hit!');
          end;
          str2:=str2-random(3)-1;
        end else begin
          case random(10)+1 of
            1: writeln('You are almost gone!');
            2: writeln('He has almost bettered you!');
            3: writeln('Oh no!');
            4: writeln('You are injured...');
            5: writeln('I think you are losing.');
            6: writeln('You are hit when not looking.');
            7: writeln('You are losing ground.');
            8: writeln('Argh!');
            9: writeln('I hope you beat him.');
           10: writeln('He has got in a good blow!');
          end;
          str1:=str1-random(3)-1;
        end;
        if j=1 then begin i:=i-1; j:=2 end else begin i:=random(2); j:=1 end;
        delay(1400);
      until (str1<1) or (str2<1);
      if str2<1 then begin
        writeln('You''ve won the fight!');
        setpaper(player.name+' fought '+other.name+' and won!');
        player.bonus:=player.bonus+fightbonus;
        grid[player.xpos,player.ypos]:= grid[player.xpos,player.ypos]-1;
        if datafile=1 then begin
          player.gold:=player.gold+other.gold;
          player.foodheld:=player.foodheld+other.foodheld;
          case num of
            1: begin other.gold:=0; other.foodheld:=1 end;
            2: begin other.gold:=0; other.foodheld:=1 end;
            3: begin other.gold:=1; other.foodheld:=0 end;
            4: begin other.gold:=1; other.foodheld:=1 end;
            5: begin other.gold:=0; other.foodheld:=0 end;
          end;
          other.xpos:=random(xmax)+1; other.ypos:=random(ymax)+1;
          grid[other.xpos,other.ypos]:=grid[other.xpos,other.ypos]+1;
          reset(otherfile); rewrite(bfile);
          for i:=1 to 5 do begin
            read(otherfile,b);
            if b.name=other.name then write(bfile,other) else write(bfile,b);
          end;
          reset(bfile); rewrite(otherfile);
          while not eof(bfile) do begin
            read(bfile,b); write(otherfile,b);
          end;
          close(bfile); erase(bfile);
        end else begin
          player.gold:=player.gold+person.gold;
          player.foodheld:=player.foodheld+person.foodheld;
          person.gold:=0; person.foodheld:=0;
          reset(personfile); rewrite(afile);
          while not eof(personfile) do begin
            read(personfile,a);
            if a.name=person.name then write(afile,person) else write(afile,a);
          end;
          reset(afile); rewrite(personfile);
          while not eof(afile) do begin
            read(afile,a); write(personfile,a);
          end;
          close(afile); erase(afile);
        end;
        end else begin
          writeln('You''re unconsious!');
          setpaper(player.name+' fought '+other.name+' and lost!');
          if player.scouts>0 then begin
            player.scouts:=player.scouts-1;
            writeln('One of your scouts got killed!');
          end;
          player.dead:=true;
          if datafile=1 then begin
            other.gold:=other.gold+player.gold;
            other.foodheld:=other.foodheld+player.foodheld;
            player.gold:=0; player.foodheld:=0;
            reset(otherfile); rewrite(bfile);
            for i:=1 to 5 do begin
              read(otherfile,b);
              if b.name=other.name then write(bfile,other) else write(bfile,b);
            end;
            reset(bfile); rewrite(otherfile);
            while not eof(bfile) do begin
              read(bfile,b); write(otherfile,b);
            end;
            close(bfile); erase(bfile);
          end else begin
            person.gold:=person.gold+player.gold;
            person.foodheld:=person.foodheld+player.foodheld;
            player.gold:=0; player.foodheld:=0;
            person.bonus:=person.bonus+fightbonus;
            reset(personfile); rewrite(afile);
            while not eof(personfile) do begin
              read(personfile,a);
              if a.name=person.name then write(afile,person) else write(afile,a);
            end;
            reset(afile); rewrite(personfile);
            while not eof(afile) do begin
              read(afile,a); write(personfile,a);
            end;
            close(afile); erase(afile);
          end;
        end;
    end;

  procedure trade(num, datafile: integer); { Trade with someone }
  var
    i, j: integer;
    afile: file of others;
    a: others;

    begin
      if datafile=2 then writeln('That person doesn''t want to trade with you.')
        else begin
          assign(afile,'VILL3.DAT');
          if not other.friendly
            then writeln('That person doesn''t want to trade with you.')
            else begin
              writeln('Trade what?');
              writeln('1.. Food for Gold');
              writeln('2.. Gold for Food');
              writeln;
              repeat
                write('Enter 1 or 2: ');
                i:=strint(getinput);
              until (i=1) or (i=2);
              if i=1 then begin
                writeln('You have ',player.foodheld,' amounts of food.');
                writeln('He has ',other.gold,' gold.'); writeln;
                repeat
                  write('How much food will you trade? ');
                  j:=strint(getinput);
                until (j>=0) and (j<=player.foodheld);
                player.foodheld:=player.foodheld-j;
                other.foodheld:=other.foodheld+j;
                if j>other.gold then begin
                  writeln('He is VERY grateful!');
                  player.gold:=player.gold+other.gold;
                  other.gold:=0;
                end
                else begin
                  player.gold:=player.gold+j;
                  other.gold:=other.gold-j;
                end;
              end
              else begin
                writeln('You have ',player.gold,' amounts of gold.');
                writeln('He has ',other.foodheld,' food.'); writeln;
                repeat
                  write('How much gold will you trade? ');
                  j:=strint(getinput);
                until (j>=0) and (j<=player.gold);
                player.gold:=player.gold-j;
                other.gold:=other.gold+j;
                if j>other.foodheld then begin
                  writeln('He is VERY happy!');
                  player.foodheld:=player.foodheld+other.foodheld;
                  other.foodheld:=0;
                end
                else begin
                  player.foodheld:=player.foodheld+j;
                  other.foodheld:=other.foodheld-j;
                end;
              end;
              if j<>0 then begin
                reset(otherfile); rewrite(afile);
                for i:=1 to 5 do begin
                  read(otherfile,a);
                  if a.name=other.name then write(afile,other) else write(afile,a);
                end;
                reset(afile); rewrite(otherfile);
                while not eof(afile) do begin
                  read(afile,a); write(otherfile,a);
                end;
                close(afile); erase(afile);
              end;
            end;
        end;
    end;

  begin
    if occupied=false then writeln('There''s no-one here!')
      else begin
        who:=''; i:=0;
        reset(otherfile);
        while (who<>'Y') and not eof(otherfile) do begin
          i:=i+1;
          read(otherfile,other);
          if inp<>'Y' then begin
            if (other.xpos=player.xpos) and (other.ypos=player.ypos) then begin
              writeln(other.name);
              if opt=1 then write('Attack [y,N] ? ')
                else write('Trade with [y,N] ? ');
              who:=getinput;
              if who='Y' then begin
                if opt=1 then fight(i,1) else trade(i,1);
              end;
            end;
          end;
        end;
        close(otherfile); i:=0;
        reset(personfile);
        while (who<>'Y') and not eof(personfile) do begin
          i:=i+1;
          read(personfile,person);
          if inp<>'Y' then begin
            if (person.xpos=player.xpos) and (person.ypos=player.ypos)
              and (person.name<>player.name) and (not person.dead) then begin
                writeln(person.name);
                if opt=1 then write('Attack [y,N] ? ')
                  else write('Trade with [y,N] ? ');
                who:=getinput;
                if who='Y' then begin
                  if opt=1 then fight(i,2) else trade(i,2);
                end;
              end;
          end;
        end;
        close(personfile);
      end;
  end;

procedure points; { Creates score-board }
var
  inp: strng;
  score, i, j, k, l: integer;
  tops: array[1..5] of strng;
  topi: array[1..5] of integer;

  begin
    writeln('Display points.');
    write('Enter name, return for all, or * for top five: ');
    inp:=getinput;
    for k:=1 to 5 do begin tops[k]:=''; topi[k]:=0 end;
    reset(personfile);
    writeln; i:=0;
    writeln('Name                         Score');
    while not eof(personfile) do begin
      read(personfile,person);
      if (person.name = inp) or (inp = '') or (inp = '*') then begin
        if person.name=player.name then person:=player;
        score:= person.scouts*25 + person.gold*50
          + person.foodheld*100 + person.foodrtrn*200 + person.bonus;
        j:=34 - length(person.name);
        if inp<>'*' then writeln(person.name,score:j)
        else
          if topi[1]<score then begin
            for l:=5 downto 2 do begin
              topi[l]:=topi[l-1]; tops[l]:=tops[l-1];
            end;
            tops[1]:=person.name; topi[1]:=score;
          end else if topi[2]<score then begin
            for l:=5 downto 3 do begin
              topi[l]:=topi[l-1]; tops[l]:=tops[l-1];
            end;
            tops[2]:=person.name; topi[2]:=score;
          end else if topi[3]<score then begin
            for l:=5 downto 4 do begin
              topi[l]:=topi[l-1]; tops[l]:=tops[l-1];
            end;
            tops[3]:=person.name; topi[3]:=score;
          end else if topi[4]<score then begin
            topi[5]:=topi[4]; tops[5]:=tops[4];
            tops[4]:=person.name; topi[4]:=score;
          end else if topi[5]<score then begin
            tops[5]:=person.name; topi[5]:=score;
          end;
        i:=i+1;
      end;
    end;
    if inp='*' then
      for j:=1 to 5 do
        if tops[j]<>'' then begin
          k:=34 - length(tops[j]);
          writeln(tops[j],topi[j]:k);
        end;
    close(personfile);
    if i = 0 then writeln('Person not found.');
    writeln;
    write('Press <RETURN> to continue... ');
    inp:=getinput; writeln;
  end;

procedure getscout; { Adds scout to player's inventory }
var
  i: integer;

  begin
    writeln('The tribe is currently charging ',price,' gold for the rent of a');
    writeln('scout. You have ',player.gold,' gold.'); writeln;
    repeat
      write('How many will you borrow? ');
      i:=strint(getinput);
    until (i>=0) and (i<=(player.gold div price));
    player.gold:=player.gold - i*price;
    player.scouts:=player.scouts + i;
    if i>0 then writeln('You now have ',player.scouts,' scouts.');
  end;

procedure usescout; { Procedure to control the scout }
var
  inp: strng;
  encounter, x, y, i: integer;

  begin
    if player.scouts>0 then begin
      if not player.expert then begin
        writeln('You can send a scout out in either of the two directions:');
        writeln('[N]orth/South, or [E]ast/West. He will then return, and');
        writeln('report to you what he found in that direction before returning');
        writeln('to the village.');
      end else writeln('You can send a scout [N]orth/South, or [E]ast/West.');
      writeln('Use [Q] to quit.');
      repeat
        write('Which diection [n,e,Q] ? ');
        inp:=getinput;
      until (inp='N') or (inp='E') or (inp='Q') or (inp='');
      x:=0; y:=0; player.scouts:=player.scouts-1; encounter:=0;
      case inp[1] of
        'N': for i:=1 to ymax do begin
               player.ypos:=player.ypos+1;
               if player.ypos>ymax then player.ypos:=1;
               encounter:=encounter+grid[player.xpos,player.ypos];
             end;
        'E': for i:=1 to xmax do begin
               player.xpos:=player.xpos+1;
               if player.xpos>xmax then player.xpos:=1;
               encounter:=encounter+grid[player.xpos,player.ypos];
             end;
        else player.scouts:=player.scouts+1;
      end;
      if (inp<>'Q') and (inp<>'') then
        writeln('The scout reports that he encountered ',encounter,' people.');
    end else writeln('You don''t have any scouts.');
  end;

procedure drums; { Communications procedure }
var
  inp: strng;
  message: array[1..10] of strng;
  i, j: integer;

  begin
    writeln('You can [L]isten to the drums, or [H]it them to communicate.');
    writeln('Enter [Q] to Quit..');
    repeat
      write('What is your choice [l,h,Q] ? ');
      inp:=getinput;
    until (inp='L') or (inp='H') or (inp='Q') or (inp='');
    if inp='L' then begin
      reset(newspaper);
      i:=1;
      while not eof(newspaper) do begin
        if i=23 then begin
          writeln('--- Press ENTER for More ---');
          message[1]:=getinput;
          i:=1;
        end;
        read(newspaper,message[1]);
        writeln(message[1]);
        i:=i+1;
      end;
      close(newspaper);
    end else if inp='H' then begin
      writeln;
      writeln('You can enter up to 10 lines, 75 characters per line.');
      writeln('[-------------------------------------------------------------------------]');
      for i:=1 to 10 do message[i]:='';
      i:=1;
      repeat
        readln(message[i]);
        if length(message[i])>75 then writeln('Line too long.') else begin
          if message[i]<>'' then writeln('Press ENTER to finish..');
          i:=i+1;
        end;
      until (message[i-1]='') or (i=11);
      j:=0;
      repeat
        j:=j+1;
      until (message[j]='') or (j=10);
      if message[1]<>''then begin
        for i:=1 to j do setpaper('*** '+message[i]);
        setpaper('*** Message by: '+player.name);
      end;
      writeln('Message hit on drums..');
    end;
  end;