Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #25102

Re: Dice problem

Show all headers | View raw

(  # win32forth # )

create die 0 , 0 , 0 , 0 , 0 ,         5 constant ndie

: cpStackToDie 0 ndie 1- do die i cells + ! -1 +loop ;
: cpDieToStack ndie 0 do die i cells + @ loop ;

: countdie (  a b c d e x -- N ) 0 ndie 0 do -rot tuck = if swap 1+ else swap then loop nip ;

: score ( -- sc )
     cpStackToDie

     6 1+ 1 do cpDieToStack i countdie loop ( -- a1 a2 a3 a4 a5 a6 )

     3 = if 600 else 0 then >r

     dup 1 = if drop 50
     else 3 = if  500
     else 0 then then >r

     3 = if  400 else 0 then >r
     3 = if  300 else 0 then >r
     3 = if  200 else 0 then >r

     dup  1 = if drop 100
     else 3 = if 1000
     else 0
     then then

     r> r> r> r> r> + + + + + ;

: test1 ." [ " ndie 0 do 6 random 1+ dup . ." " loop ." ] ==> " score . ;
: test2 ( a b c d e -- f ) ." scores " score . ;
: help ( -- ) cls
." Roll 5 dice , score as follows :-        " cr
." If you get a single 1  add 100  to score " cr
." If you get a single 5  add 50   to score " cr
." All other singles      add 0    to score " cr
." If you get triple 1    add 1000 to score " cr
." Any other triple is 100 times the number to score" cr cr cr
." To use : " cr cr
." Type: help <cr>             to see this message" cr
." Type: test1 <cr>            generate 5 random numbers and score them " cr
." Type: 2 2 1 2 5  test2 <cr> to enter numbers manually and score them " cr
." NOTE: test2 expects 5 numbers and there is no check to see if the values are between 1 & 6" cr
." or if you enter less than 5 numbers !!! " cr cr
cr cr cr ; help

Back to comp.lang.forth | Previous | Next — Previous in thread | Next in thread | Find similar | Unroll thread

Thread

Dice problem "WJ" <w_a_x_man@yahoo.com> - 2013-06-11 15:34 +0000
  Re: Dice problem Ron Aaron <rambamist@gmail.com> - 2013-06-11 20:04 +0300
  Re: Dice problem november.nihal@gmail.com - 2013-08-11 05:11 -0700
  Re: Dice problem Paul Rubin <no.email@nospam.invalid> - 2013-08-11 16:32 -0700
    Re: Dice problem Paul Rubin <no.email@nospam.invalid> - 2013-08-11 16:42 -0700
    Re: Dice problem Coos Haak <chforth@hccnet.nl> - 2013-08-12 02:25 +0200
      Re: Dice problem Paul Rubin <no.email@nospam.invalid> - 2013-08-11 18:02 -0700
      Re: Dice problem Paul Rubin <no.email@nospam.invalid> - 2013-08-11 23:58 -0700
  Re: Dice problem hughaguilar96@yahoo.com - 2013-08-12 00:13 -0700

csiph-web