Solved

bowling scoring utility

Posted on 1998-12-18
36
467 Views
Last Modified: 2008-03-17
i need a simple bowling scoring (U.S. standard ten pin)
for use on lap top for league bowling.  ** this is worth 500 points to the person who does this. **

options should be just simple scoring for one team upto five players.  option for printing if possible.  just the standard ten frames (w/ bonus of tenth frame if mark)  i need to input frame by player.  should have smarts, like if X or /, it will go to next player.  Addition should be standardized scoring method.  game shouldnt abort when done. saving could be option if programmer desires, also averaging more than one game could be as well.  but a simple stripped down scoring is all i need.  thank you very much.....
0
Comment
Question by:weinrj
  • 10
  • 9
  • 8
  • +2
36 Comments
 
LVL 4

Expert Comment

by:davidmwilliams
ID: 1216579
 Do you require source code, or just an .exe?  If you want source code, is Delphi fine, or must it be a specific version of Pascal?
0
 

Author Comment

by:weinrj
ID: 1216580
delphi is windows, correct?  if so, would it work in win98?  Actually, I would prefer a windows based system...i would like to see the source code so i can learn how you did it. i say 500 points is certainly worth it.  i am desperately in need of this.  thank you...[for delphi, since i only have 7.0 DOS, please email it to jwnrb@cybernex.net.  Thank you !

~jw
0
 
LVL 4

Expert Comment

by:davidmwilliams
ID: 1216581
 Delphi programs are Windows based, and yes, it would certainly
work in Win '98.
  I'll set to work on this, and mail you both the source code, and the executable program.  I think I should be able to do this by the end of the weekend.
0
 

Author Comment

by:weinrj
ID: 1216582
thank you ... i will reward you the 500 points upon receiving.  thank you
0
 
LVL 5

Expert Comment

by:scrapdog
ID: 1216583
I will have it tonight (within 2 hours).

It is almost finished.  Please reject previous answer...
0
 
LVL 5

Expert Comment

by:scrapdog
ID: 1216584
I have spent last 2 1/2 hours working on TP 7.0 version.

davidmwilliams do not lock it until you are FINISHED!!!!!
0
 
LVL 5

Expert Comment

by:scrapdog
ID: 1216585
Just to show you I am SERIOUS, here is the code I have so far:

uses crt;

const
  pSTRIKE = 10;
  pSKIP   = -1;

type
  tplayer = record
              frame :array[1..21] of integer;
              turn  :integer;
              score :array[1..10] of integer;
            end;
  tteam = record
            games   :integer;
            players :integer;
            names   :array[1..5] of string[10];
            player  :array[1..5, 1..5] of tplayer;
          end;


procedure display_player(var player :tplayer; name :string);
var a,b,c,s  :string;
    i  :integer;
begin
  with player do begin
    for i := 1 to 80 do write('-');
    write('|           ');
    for i := 1 to 21 do begin
      case player.frame[i] of
        pSTRIKE:  s := 'X';
        pSKIP:    s := ' ';
      else begin
        if (((i mod 2) = 0) and (frame[i]+frame[i-1]=10)) or
          ((i=21) and (frame[20] <> 10) and (frame[20]+frame[21]=10)) then
          s := '/'
        else str(player.frame[i]:1,s);
      end;
      end; (*case*)
      write('|',s);
    end;
    writeln('|');
    write('|',name,' ');
    for i := 1 to 9 do write('|   ');
    writeln('|     |');
    write('|           ');
    for i := 1 to 9 do begin
      if player.score[i] > 0 then str(player.frame[i]:3,s)
      else s := '   ';
      write('|',s);
    end;
    if player.score[10] < 0 then s := '     '
      else str(player.score[10]:5,s);
    writeln('|',s,'|');
  end;
end;






procedure display_score(var team :tteam; game :integer);
var i :integer;
begin
  clrscr;
  for i := 1 to team.players do
    display_player(team.player[game, i], team.names[i]);
  for i := 1 to 80 do write('-');
end;

procedure display_stats(var team :tteam);
var i,j,x,y :integer;
begin
  for i := 1 to team.players do begin
    write(team.names[i],'   ');
    y := 0;
    for j := 1 to team.games do begin
      x := team.player[j,i].score[10];
      write(x:5);
      y := y + x;
    end;
    if team.games > 0 then write('   avg ',(y div team.games):6);
    writeln;
  end;
  writeln;
end;

function main_menu(var team :tteam) :integer;
var
  ch :char;
  keys :set of char;
begin
  clrscr;

  keys := ['7'];
  if team.players > 0 then display_stats(team);
  if team.games > 0 then begin keys := keys + ['3', '6']; end;
  if team.players > 0 then keys := keys + ['2'];
  if team.players < 5 then keys := keys + ['1'];
  if (team.games < 5) and (team.players > 0) then keys := keys + ['5'];
  writeln;
  if '1' in keys then writeln('1.  Add a player');
  if '2' in keys then writeln('2.  Remove a player');
  if '3' in keys then writeln('3.  Save games');
  writeln('4.  Load existing games');
  if '5' in keys then writeln('5.  New game');
  if '6' in keys then writeln ('6.  Print game');
  writeln('7.  Exit');
  writeln('------------------');
  ch := ' ';
  while not (ch in keys) do ch := readkey;
  main_menu := ord(ch)-48;
end;


function get_pins(p :integer; name :string) :integer;
var
  keys :set of char;
  ch :char;
  c,i :integer;
begin
  keys := [];
  if p = 255 then keys := ['0','1','2','3','4','5','6','7','8','9','/']
  else begin
    if p = 0 then keys := ['0','1','2','3','4','5','6','7','8','9','x']
    else begin
      for i := 1 to 9-p do keys := keys + [chr(i+48)];
      keys := keys + ['/'];
    end;
  end;
  writeln;
  write(name,':  ');
  while not (ch in keys) do ch := readkey;
  if ch = '/' then c := 10-p
  else if ch = 'x' then c := 10
  else c := ord(c)-48;
  get_pins := c;
end;

function get_next_ball(var player :tplayer; frame, num :integer;
                       var return :integer) :boolean;
var
  t :integer;
  resolved : boolean;
begin
  t := 1;
  resolved := false;
  while (not resolved) and (frame + t < 21) do
    if player.frame[frame + t] <> pSKIP then begin
      return := return + player.frame[frame+t];
      dec(num);
      if num=0 then resolved := true;
      t := t + 1;
    end;
  get_next_ball := resolved;
end;

procedure compute_scores(var team :tteam; game :integer);
var
  i,c,j,x :integer;
  stop, noscore :boolean;
begin
  for i := 1 to team.players do begin
    with team.player[game,i] do begin
      c := 0;
      stop := false;
      j := 0;
      while (not stop) and (j<=8) do begin
        if frame[j*2+1] = pSTRIKE then begin
          noscore := get_next_ball(team.player[game,i], j*2+1, 2, x);
          if noscore then begin
            stop := true;
            score[j+1] := -1;
          end else begin
            score[j+1] := c + x + 10;
            c := c + x + 10;
          end;
        end else if frame[j*2+1] + frame[j*2+2] = 10 then begin
          noscore := get_next_ball(team.player[game,i], j*2+2, 1, x);
          if noscore then begin
            stop := true;
            score[j+1] := -1;
          end else begin
            score[j+1] := c + x + 10;
            c := c + x + 10;
          end;
        end else begin
          c := frame[j*2+1] + frame[j*2+2] + c;
          score[j+1] := c;
        end;
        j := j + 1;
      end;
      if not stop then begin
        if frame[19] = pSTRIKE then
          c := frame[19] + frame[20] + frame[21] + c
        else if frame[19]+frame[20] = 10 then
          c := 10 + frame[21] + c
        else c := frame[19] + frame[20] + c;
        score[10] := c;
      end;
    end;
  end;
end;






procedure bowl(var team :tteam);
var
  game,p,t,f,pins,prev_pins :integer;
  gameon, turnover, bonus :boolean;
begin
  with team do begin
    games := games + 1;
    game := games;
    gameon := true;
    f := 1;
    while gameon do begin
      for p := 1 to team.players do begin
        turnover := false;
        t := 0;
        prev_pins := 0;
        while not turnover do begin
          bonus := false;
          display_score(team, game);
          pins := get_pins(prev_pins, team.names[p]);
          player[game, p].frame[f+t] := pins;
          if pins = pSTRIKE then begin
            if f=19 then bonus := true
            else begin
              turnover := true;
              player[game,p].frame[f+t+1] := pSKIP;
            end;
          end;
          t := t + 1;
          if pins=0 then prev_pins := 255
          else prev_pins := pins;
          if ((f<>19) or (not bonus)) and (t>1) then turnover := true
          else if t>2 then turnover := true;
        end;
        compute_scores(team, game);
        display_score(team, game);
      end;
      f := f + 2;
      if f>19 then gameon := false;
    end;
  end;
end;







procedure reset_player(var player :tplayer);
var i :integer;
begin
  with player do begin
    for i := 1 to 21 do begin
      frame[i] := pSKIP;
      if i <= 10 then score[i] := pSKIP;
    end;
  end;
end;

procedure reset_game(var team :tteam;  game :integer);
var i :integer;
begin
  for i := 1 to 5 do reset_player(team.player[game,i]);
end;

procedure reset_team(var team :tteam);
var i :integer;
begin
  team.games := 0;
  team.players := 0;
  for i := 1 to 5 do reset_game(team, i);
end;


procedure add_player(var team :tteam);
var s :string;
begin
  writeln;
  write('Enter player''s name (1-10 chars): ');
  readln(s);
  s := copy(s+'          ',1,10);
  inc(team.players);
  team.names[team.players] := s;
end;

procedure remove_player(var team :tteam);
begin
end;

procedure save_game(var team :tteam);
begin
end;

procedure load_game(var team :tteam);
begin
end;

procedure print_game(var team :tteam);
begin
end;

var
  team :tteam;
  choice :integer;
  done :boolean;

begin
  reset_team(team);
  done := false;
  while not done do begin
    choice := main_menu(team);
    case choice of
      1:  add_player(team);
      2:  remove_player(team);
      3:  save_game(team);
      4:  load_game(team);
      5:  bowl(team);
      6:  print_game(team);
      7:  done := true;
    end;
  end;
end.







0
 
LVL 10

Expert Comment

by:viktornet
ID: 1216586
David Williams. Scrapdog is right. You should not lock a question till you're sure you have got the answer so other people can answer it. E-E is not all about point, but it's for people to get the  best and correct answer.

My opinion is that weinrj should reject David William's answer and accept scrapdog's since he's done all the coding...

David William: Never lock a q'n until you've got the answer.

Regards,
Viktor Ivanov
0
 
LVL 4

Expert Comment

by:davidmwilliams
ID: 1216587
 Oh well, if ScrapDog really does finish it soon, and his solution meets Weinrj needs, then he should get the points.
  Mind you, he is only implementing a crude command-line based program, which seems pretty rushed.  Though, having said that, he seems to have spent over five hours on it now, which is a bit excessive for what he's produced.
  Viktornet: Scrapdog hasn't done 'all the coding' -- he's done his own coding, just like I've done mine.  You point out EE is for the 'best' answer -- and Weinrj did say he would prefer a Windows-based program.
  Anyway, Scrapdog, keep us informed on your progress ...
0
 
LVL 10

Expert Comment

by:viktornet
ID: 1216588
Once implemented for TP (DOS) it's very easy to do it in Delphi (Windows).
0
 
LVL 4

Expert Comment

by:davidmwilliams
ID: 1216589
 Depends if you do it properly or not.  Anyone can just throw a Windows wrapper around a text based program ... but what about a clean UI, switching from procedural to event-based paradigms, general issues of robustness, using the registry instead of .ini files, resizing windows tidily ... ?
  Anyway ... ScrapDog said he'd finish his program 6 hours ago !
0
 
LVL 10

Expert Comment

by:viktornet
ID: 1216590
ScrapDog is sleeping at the moment since it's 6:30 am in his time zone... he said he'd finish it late in the night at about 1:00am or so...

It's not as bad as you think... It can be converted in about 10 to 20 minutes... no more... the thing is that the code in TP should be completed... After that it's quite easy... It doesn't matter that Delphi uses Events and stuff... YOu'll have a few buttons and a few edit boxes and that's all you need... Just use the procedures and functions supported...

Cheers,
Viktor
0
 
LVL 10

Expert Comment

by:viktornet
ID: 1216591
Well, David I don't mean to be sarcastic, but how much coding have you done?
0
 
LVL 4

Expert Comment

by:davidmwilliams
ID: 1216592
 I'm not sure why you have such a bee in your bonnet about this, or why you feel you want to argue over this forum.  Where were you guys when the question was first posed, or when Wienj and I discussed what he wanted?
  Scrapdog's last word on the matter was he'd have it finished 'within 2 hours', and that was some time ago.
  As to your casual attitude to porting environments -- sure, you can do things like you say, but are we talking about quality and professional code here, or just something hacked by hobbyists and amateurs.
  As to how much coding have I done - I hardly see it's relevant, but I'm a professional software developer, and I teach software engineering.  So, your answer is a good many years.
  As I said, ScrapDog is free to advise us when he's finished, and if Wienj accepts his answer, then all is fine by me.  Why are you bugging me about this?  What is your problem?
0
 
LVL 10

Expert Comment

by:viktornet
ID: 1216593
I ain't bugging you about anything... and i don't see much of a discussion over the subject between you and the individual that asked the question. The only thing is that I hate to see is what you did some time ago... You simply locked the question because you saw weinrj is giving away so many points. I agree with ScrapDog because he has tried to help the person and I don't know what you've done for him/her other than disabling his option to get other people's responses and decide which one best answers his questions. I see that you're talking about quality in your professional development skills. Why don't you really show your expertize and not show off.

¤¤¤¤¤† Viktor Ivanov †¤¤¤¤¤
0
 
LVL 4

Expert Comment

by:davidmwilliams
ID: 1216594
 This really isn't the appropriate forum for you to waste everyone's time ... take it to email, if you really have a point.  And what's this 'some time ago' stuff - give a reference.
  I can't see ScrapDog is doing any more than I am ... I saw this question, corresponded with Weinj a couple of times, and then told him I'd supply a program.  Where were you guys?
  Anyway, what's your problem?  What do you want me to do?  I can't unlock the question.  I've already said THREE times that ScrapDog is entirely welcome to the points if he comes along first, with an acceptable answer.
  Kindly stop filling up this database with your invalid opinions.
0
 
LVL 10

Expert Comment

by:viktornet
ID: 1216595
Man, did you listen to a word I said? If you did not, better read the last comment I left very careffuly... If you still can't see my point then i have nothing more to say to you...

Regards,
Viktor Ivanov
0
 
LVL 4

Expert Comment

by:davidmwilliams
ID: 1216596
 I'm glad to hear you have nothing more to say, because your petulance is tiring, and your opinions dull.
  For what it's worth, I've already mailed Weinj a program that does all the scoring, is fast, efficient and robust, and Windows based and event-driven, with scoring all calculated automatically, and all information immediately accessible and visible.
  And it certainly didn't take as long to write as ScrapDog's program ...
  Now, good day, Viktor .......
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 1

Expert Comment

by:The_Brain
ID: 1216597
Sad, really sad, I hate to see grown men fight over $%!^.  Why don't you get someone to do it in C++?  I could do it  Pity though, that I don't know bolwing very well, I do know a enough,but never a team.  If I were you I would try out each ones program and see which one is more user friendly.  (I suggest testing this very efficiently since programmers DO make mistakes.  So do test it.  But if I were you guys, I would apologise to each other.  this is a proffesional service not IRC.  OK?  so come on, settle this like REAL men and apologise, If none of you guys get this, please Weinj, post them This message Thanks.  The Brain...
0
 
LVL 1

Expert Comment

by:The_Brain
ID: 1216598
with correction on bolwing as Bowling. oops.
0
 

Author Comment

by:weinrj
ID: 1216599
sent reason in email
0
 

Author Comment

by:weinrj
ID: 1216600
the program could be done in windows C++, pascal, assembler fortran cobol, i dont care which language...i said pascal since it is the only compiler i have.  i do have C++ 4.0 professional on CD i got with school since i learning C++ but not enough yet...

Mr. Williams, the code u gave me did not score correctly.  Forr user friendlyness, it would be easier if done like writing it down....

-----------
|   |     |
| 9|_/_ |
|    ## |
-----------

to all: what ever u would like to make this down easiest would be fine...saving would be nice, printing would be the only thing that i would need...[if saving, make the frames with it, same w/ printing...] i know this is asking a lot, but i spent a week looking for a commercial product and i found nothing...i figured a custom program would do...i thank you all ~ looking forward to next responses from u all...
0
 

Author Comment

by:weinrj
ID: 1216601
mr williams: i also put in all strikes to get a perfect game of 300 and it gave me 550....
in your code it adds before i get the next ball...

if u get a X, u have to wait for next two shots, if / u have to wait for next one shot, then add next frame(s).
0
 
LVL 10

Expert Comment

by:viktornet
ID: 1216602
Ok, I'm happy to hear that Mr. David Williams has sent the program and I want to apologize to David Williams and all others for anything that I've said or done. Thanks Brain.

Take care...

Regards,
Viktor Ivanov
0
 
LVL 5

Expert Comment

by:scrapdog
ID: 1216603
David Williams:

I apologize for blowing up like that...

I assumed that the program was to be written in Pascal.  I knew that it would be easier to write in Delphi (for the interface and all).  Being on the Pascal board, I also assumed that this wasn't an option.  So I went to go work on it in TP 7.0 for a while, and came back and saw the little discussion you had w/ weinrj about doing it in Delphi...you can understand I was a little frustrated. :)  It was never my intention to start a flame war, and I hope one doesn't start (or continue) :).

I have made a few updates to my code, and it works a *little* better now, but it is far from being perfect.  I was thinking of moving it over to Delphi, but that would be a waste of time since you have already done a version in Delphi.  

I will let you take this one over...I feel kind of bad out being such an a**h*le about it.  If you want, you can integrate any of my code into it (if you feel it will help).
0
 
LVL 5

Expert Comment

by:scrapdog
ID: 1216604
By the way DWM, it wasn't 5 hours that I spent...it was roughly 2 1/2 to 3...I'm not THAT slow. :)  I also had to rewrite it once.  Most of the time went into figuring out how to display everything...in Delphi, almost no time at all needs to go into that part.  Did you use a TStringGrid?
0
 

Author Comment

by:weinrj
ID: 1216605
i would also like to apologize .  i should have put this in a more apporpiate group, but this is working well.  I wouldnt mind TP7 DOS, but if Delphi was an option, that would be fine. (or C++ as well).  I dont care if it is DOS or WIN98 compatible.  i appreciate any ones efforts.  I can say, scratch save or print, at least for now...make it simple as possible...just add scores that is it for a maximum of five players...(i guess it is a 2-D array)  i think this may help
0
 
LVL 5

Expert Comment

by:scrapdog
ID: 1216606
I suppose I could play with mine a bit more...I'll get back to you.
0
 

Author Comment

by:weinrj
ID: 1216607
okay!  i guess if u r doing it in TP7, i guess adding textcolor(); might be neat....(i did take elementary TP7, but what i know is write/textcolor/clrscr that is about it...
0
 
LVL 5

Accepted Solution

by:
scrapdog earned 500 total points
ID: 1216608
OK, I changed my mind about giving up on it (sorry dmw), because I actually got this puppy to score correctly without too much additional work.  Here is the final source code.  If you want anything changed, or additional features (color????), or encounter a bug in the scoring that I didn't catch (I thoroughly tested it), let me know.  

Some features in the main menu (such as print/save/load) do not do anything because of your specification to leave them out for now.  The player's averages are calculated and displayed at the main menu.  The remove player main menu function does nothing for now, but if you feel that at some point you will need to remove a player, I can implement it.  Press the x key for a strike or the / key for a spare (keys available are listed after the player's name under the scorecard).

If you feel that it doesn't serve your purpose, or that dmw's program worked better, then reject!!


uses crt;

const
  pSTRIKE = 11;
  pSKIP   = -1;
  pBONUS  = 254;

type
  tplayer = record
              frame :array[1..21] of integer;
              turn  :integer;
              score :array[1..10] of integer;
            end;
  tteam = record
            games   :integer;
            players :integer;
            names   :array[1..5] of string[10];
            player  :array[1..5, 1..5] of tplayer;
          end;


procedure display_player(var player :tplayer; name :string);
var a,b,c,s  :string;
    i  :integer;
begin
  with player do begin
    for i := 1 to 80 do write('-');
    write('|           ');
    for i := 1 to 21 do begin
      case player.frame[i] of
        pSTRIKE:  s := 'X';
        pSKIP:    s := ' ';
      else begin
        if (((i mod 2) = 0) and (frame[i]+frame[i-1]=10)) or
          ((i=21) and (frame[20] <> 10) and (frame[20]+frame[21]=10)) then
          s := '/'
        else str(player.frame[i]:1,s);
      end;
      end; (*case*)
      write('|',s);
    end;
    writeln('|');
    write('|',name,' ');
    for i := 1 to 9 do write('|   ');
    writeln('|     |');
    write('|           ');
    for i := 1 to 9 do begin
      if player.score[i] >= 0 then str(player.score[i]:3,s)
      else s := '   ';
      write('|',s);
    end;
    if player.score[10] < 0 then s := '     '
      else str(player.score[10]:5,s);
    writeln('|',s,'|');
  end;
end;






procedure display_score(var team :tteam; game :integer);
var i :integer;
begin
  clrscr;
  for i := 1 to team.players do
    display_player(team.player[game, i], team.names[i]);
  for i := 1 to 80 do write('-');
end;

procedure display_stats(var team :tteam);
var i,j,x,y :integer;
begin
  for i := 1 to team.players do begin
    write(team.names[i],'   ');
    y := 0;
    for j := 1 to team.games do begin
      x := team.player[j,i].score[10];
      write(x:5);
      y := y + x;
    end;
    if team.games > 0 then write('   avg ',(y div team.games):6);
    writeln;
  end;
  writeln;
end;

function main_menu(var team :tteam) :integer;
var
  ch :char;
  keys :set of char;
begin
  clrscr;

  keys := ['7'];
  if team.players > 0 then display_stats(team);
  if team.games > 0 then begin keys := keys + ['3', '6']; end;
  if team.players > 0 then keys := keys + ['2'];
  if team.players < 5 then keys := keys + ['1'];
  if (team.games < 5) and (team.players > 0) then keys := keys + ['5'];
  writeln;
  if '1' in keys then writeln('1.  Add a player');
  if '2' in keys then writeln('2.  Remove a player');
  if '3' in keys then writeln('3.  Save games');
  writeln('4.  Load existing games');
  if '5' in keys then writeln('5.  New game');
  if '6' in keys then writeln ('6.  Print game');
  writeln('7.  Exit');
  writeln('------------------');
  ch := ' ';
  while not (ch in keys) do ch := readkey;
  main_menu := ord(ch)-48;
end;


function get_pins(p :integer; name :string) :integer;
var
  keys :set of char;
  ch :char;
  c,i :integer;
begin
  keys := [];
  if p = 255 then keys := ['0','1','2','3','4','5','6','7','8','9','/']
  else begin
    if (p = 0) or (p=pBONUS) then keys := ['0','1','2','3','4','5','6','7','8','9','x']
    else begin
      for i := 0 to 9-p do keys := keys + [chr(i+48)];
      keys := keys + ['/'];
    end;
  end;
  writeln;
  write(name,':  ');
  for ch := '0' to '9' do if ch in keys then write(ch);
  for ch := chr(0) to chr(255) do if (ch in keys) and not (ch in ['0'..'9'])
    then write(ch);
  ch := ' ';
  while not (ch in keys) do ch := readkey;
  if ch = '/' then begin
    if (p=255) or (p=pBONUS) then p := 0;
    c := 10-p;
  end
  else if ch = 'x' then c := pSTRIKE
  else c := ord(ch)-48;
  get_pins := c;
end;

function pin_value(p :integer) :integer;
begin
  if p = pSTRIKE then pin_value := 10 else pin_value := p;
end;

function get_next_ball(var player :tplayer; f, num :integer;
                       var return :integer) :boolean;
var
  t :integer;
  resolved : boolean;
begin
  t := 1;
  resolved := false;
  return := 0;
  while (not resolved) and (f + t < 21) do begin
    if player.frame[f + t] <> pSKIP then begin
      return := return + pin_value(player.frame[f+t]);
      dec(num);
      if num=0 then resolved := true;
    end;
    t := t + 1;
  end;
  get_next_ball := resolved;
end;

procedure compute_scores(var team :tteam; game :integer);
var
  i,c,j,x :integer;
  stop, noscore :boolean;
begin
  for i := 1 to team.players do begin
    with team.player[game,i] do begin
      c := 0;
      stop := false;
      j := 0;
      while (not stop) and (j<=8) do begin
        if frame[j*2+1] = pSTRIKE then begin
          noscore := not get_next_ball(team.player[game,i], j*2+1, 2, x);
          if noscore then begin
            stop := true;
            score[j+1] := -1;
          end else begin
            score[j+1] := c + x + 10;
            c := c + x + 10;
          end;
        end else if pin_value(frame[j*2+1]) + pin_value(frame[j*2+2]) = 10 then begin
          noscore := not get_next_ball(team.player[game,i], j*2+2, 1, x);
          if noscore then begin
            stop := true;
            score[j+1] := -1;
          end else begin
            score[j+1] := c + x + 10;
            c := c + x + 10;
          end;
        end else if frame[j*2+1] = pSKIP then begin
          stop := true;
          score[j+1] := -1;
        end else begin
          c := frame[j*2+1] + frame[j*2+2] + c;
          score[j+1] := c;
        end;
        j := j + 1;
      end;
      if not stop then begin
        if frame[19] = pSTRIKE then
          c := pin_value(frame[19]) + pin_value(frame[20]) + pin_value(frame[21]) + c
        else if pin_value(frame[19]) + pin_value(frame[20]) = 10 then
          c := 10 + pin_value(frame[21]) + c
        else c := frame[19] + frame[20] + c;
        score[10] := c;
      end;
    end;
  end;
end;






procedure bowl(var team :tteam);
var
  game,p,t,f,pins,prev_pins :integer;
  gameon, turnover, bonus :boolean;
begin
  with team do begin
    games := games + 1;
    game := games;
    gameon := true;
    f := 1;
    while gameon do begin
      for p := 1 to team.players do begin
        turnover := false;
        t := 0;
        prev_pins := 0;
        bonus := false;
        while not turnover do begin
          display_score(team, game);
          pins := get_pins(prev_pins, team.names[p]);
          player[game, p].frame[f+t] := pins;
          if pins = pSTRIKE then begin
            if f=19 then begin
              bonus := true;
              pins := pBONUS;
            end
            else if not bonus then begin
              turnover := true;
              player[game,p].frame[f+t+1] := pSKIP;
            end;
          end else if (pins+prev_pins = 10) and (f+t=20) then begin
            bonus := true;
            pins := pBONUS;
          end;
          t := t + 1;
          if pins=0 then prev_pins := 255
          else prev_pins := pins;
          if ((f<>19) or (not bonus)) and (t>1) then turnover := true
          else if t>2 then turnover := true;
        end;
        compute_scores(team, game);
        display_score(team, game);
      end;
      f := f + 2;
      if f>19 then gameon := false;
    end;
  end;
  write('press enter');
  readln;
end;







procedure reset_player(var player :tplayer);
var i :integer;
begin
  with player do begin
    for i := 1 to 21 do begin
      frame[i] := pSKIP;
      if i <= 10 then score[i] := pSKIP;
    end;
  end;
end;

procedure reset_game(var team :tteam;  game :integer);
var i :integer;
begin
  for i := 1 to 5 do reset_player(team.player[game,i]);
end;

procedure reset_team(var team :tteam);
var i :integer;
begin
  team.games := 0;
  team.players := 0;
  for i := 1 to 5 do reset_game(team, i);
end;


procedure add_player(var team :tteam);
var s :string;
begin
  writeln;
  write('Enter player''s name (1-10 chars): ');
  readln(s);
  s := copy(s+'          ',1,10);
  inc(team.players);
  team.names[team.players] := s;
end;

procedure remove_player(var team :tteam);
begin
end;

procedure save_game(var team :tteam);
begin
end;

procedure load_game(var team :tteam);
begin
end;

procedure print_game(var team :tteam);
begin
end;

var
  team :tteam;
  choice :integer;
  done :boolean;

begin
  reset_team(team);
  done := false;
  while not done do begin
    choice := main_menu(team);
    case choice of
      1:  add_player(team);
      2:  remove_player(team);
      3:  save_game(team);
      4:  load_game(team);
      5:  bowl(team);
      6:  print_game(team);
      7:  done := true;
    end;
  end;
end.







0
 
LVL 4

Expert Comment

by:davidmwilliams
ID: 1216609
 My, it's amazing how the world works.  While I was sleeping over in my little time zone, you guys have posted lots of messages and done lots of work.
  I'm glad we're all getting on much better now :)
  I will be happy to hear how ScrapDog's program works, because I do agree that the idea is to give the 'customer' the best solution, not just the 'first' solution.  Clearly mine has a problem with calculating scoring, which I need to look into.  I'll leave working on mine for the moment, until I hear the success or otherwise of ScrapDog's program.
  ScrapDog - actually, I was initially thinking of using a StringGrid, but I then decided not to because it didn't make the two bowls for each frame clear enough (in my opinion).  I actually ended up using two small edit boxes for each frame.  Each edit box has the tag value set to the player number, and every edit box has the same 'onChange' event handler, which uses the tag value to work out which values to use when calculating the score.  The score is worked out using a 'downto' loop, to ease calculating what must be added when a strike or spare is received -- however, clearly, my code here is being too generous if multiple successive strikes are given.
  I haven't yet implemented printing (for the same reasons as you) but I was thinking this could be done pretty quickly using QuickReports.
0
 

Author Comment

by:weinrj
ID: 1216610
i will give you an 'a' and will award you 500 points for this....it does everything i need it to do.  However, on the screen before i put in my scores, it has a string of garbage

0123456790X (is that supposed to be there)  anyyways, thank you very much!

[and all of you...sorry Mr. Williams, you would of got the points if the scoring was working, but scrapdog did do the program correctly first.  if any of you make a windows version, i would appreciate it, but this all i need!
0
 
LVL 5

Expert Comment

by:scrapdog
ID: 1216611
0123456790X is meant to tell you which keys you are allowed to press...  this means that you can enter 0-9, or x.  For example, you can't enter and spare for the first half of the frame, you can't knock down 5 pins if you already got 6, etc...

DWM:  my program works by using 21 frames instead of 10...it makes the calculation of strikes and spares much easier.  The first time I wrote it, I made a massive data structure for each frame for each player (such as a boolean for whether for strike/spare), and it just got too complicated.  I rewrote it to include a simple array of 21 integers, where 11 indicates a strike, and -1 indicates a frame not bowled yet.  Good luck trying to read my source code, it is kind of a mess :)
0
 
LVL 5

Expert Comment

by:scrapdog
ID: 1216612
DWM = DMW
0
 

Author Comment

by:weinrj
ID: 1216613
where can i add this to it '>> ' after the allowable code, to make it clearer a bit?  thanks
0
 
LVL 5

Expert Comment

by:scrapdog
ID: 1216614
The updated version is in the mail.  Let me know of anything else you need.
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Find out what Office 365 Transport Rules are, how they work and their limitations managing Office 365 signatures.
In  today’s increasingly digital world, managed service providers (MSPs) fight for their customers’ attention, looking for ways to make them stay and purchase more services. One way to encourage that behavior is to develop a dependable brand of prod…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…
This video explains how to create simple products associated to Magento configurable product and offers fast way of their generation with Store Manager for Magento tool.

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now