\ ppt.fs \ Piedra, papel, tijeras \ Copyright (C) 2010,2012 Marcos Cruz (programandala.net) \ Licencia/Permesilo/License: \ http://programandala.net/license \ Written in ANS Forth \ Tested with Gforth and Forth 5mx \ Inspired by a program written in BASIC \ by Peter Shaw for the Oric Atmos computer, \ published in "Home Computer Course" \ (volume 8, page 1760 of its Spanish version, \ called "mi computer"). \ History \ 2010-01-16 First draft for Forth 5mx. \ 2010-01-17 Finished. Works also under Gforth (source in utf-8 encoding). \ 2012-03-30 Some formatting in the source code. forth [defined] environment [if] environment \ wordlist used by some Forth systems to keep the environment queries [then] [defined] gforth constant gforth? [defined] forth5mx constant forth5mx? \ my own Forth system only forth [defined] vocabulary [if] vocabulary ppt also ppt [then] definitions decimal [undefined] d= [if] : d= ( d1 d2 -- f ) rot = >r = r> and ; [THEN] gforth? [undefined] random and [if] include random.fs \ Gforth standard extension [then] forth5mx? [if] ' rnd alias random [then] 1 constant stone 2 constant paper 3 constant scissors 10 constant max-score variable human-choice variable human-score variable computer-choice variable computer-score : .title ( -- ) ." Piedra, papel, tijeras" ; : .run ( -- ) ." Escribe RUN para jugar." ; : pause ( -- ) key drop ; : any-key ( -- ) cr ." Pulsa una tecla para continuar." pause ; : .scores ( -- ) ." Tu puntuación: " human-score @ . cr ." Mi puntuación: " computer-score @ . ; : .choice ( u -- ) case stone of ." piedra" endof paper of ." papel" endof scissors of ." tijeras" endof endcase [char] . emit ; : .about ( -- ) cr ." Copyright (C) 2010,2012 Marcos Cruz (programandala.net)" cr ." Licencia/Permesilo/License:" cr ." http://programandala.net/licencia" cr cr ." Inspirado en un programa escrito en BASIC" cr ." por Peter Shaw para la computadora Oric Atmos," cr ." publicado en la enciclopedia" cr ." 'mi computer', volumen 8, página 1760." ; : init ( -- ) page .title cr .about cr 0 human-score ! 0 computer-score ! ; : computer ( -- u ) 3 random 1+ ; : valid-key? ( c -- f ) dup [char] 0 > swap [char] 4 < and ; : human-key ( -- c ) 0 begin drop key dup valid-key? until ; : .human-option ( u -- ) dup . ." = " .choice ; : .human-options ( -- ) ." Es tu turno. Elige:" cr cr stone .human-option cr paper .human-option cr scissors .human-option ; : human-option ( -- u ) human-key [char] 0 - ; : human ( -- u) .human-options human-option ; : choices ( -- u1 u2 ) computer-choice @ human-choice @ ; : .computer-choice ( -- ) ." Yo tengo " computer-choice @ .choice ; : .human-choice ( -- ) ." Tú tienes " human-choice @ .choice ; : .choices ( -- ) .computer-choice cr .human-choice ; : computer-wins-round? ( -- f ) choices stone scissors d= choices scissors paper d= or choices paper stone d= or ; : human-wins-game? ( -- f ) human-score @ max-score = ; : computer-wins-game? ( -- f ) computer-score @ max-score = ; : game-over? ( -- f ) human-wins-game? computer-wins-game? or ; : i-win-round ( -- ) ." Yo gano." 1 computer-score +! ; : you-win-round ( -- ) ." Tú ganas." 1 human-score +! ; : combined ( u1 u2 -- u3 ) 2dup min 16 * >r max r> + ; : tie? ( -- f ) choices = ; : choices-combination ( -- true | u ) tie? ?dup 0= if choices combined then ; : .explanation ( -- ) choices-combination case true of ." Empate." endof stone paper combined of ." El papel envuelve la piedra." endof stone scissors combined of ." La piedra rompe las tijeras." endof paper scissors combined of ." Las tijeras cortan el papel." endof endcase ; : .round-winner ( -- ) tie? 0= if computer-wins-round? if i-win-round else you-win-round then then ; : result ( -- ) page .choices cr cr .explanation space .round-winner cr cr .scores cr any-key ; : .game-winner ( -- ) human-wins-game? if ." Has" else ." He" then ." ganado la partida." ; : game-over ( -- ) page .game-winner cr cr .scores cr cr .run ; : round ( -- ) page computer computer-choice ! human human-choice ! result ; : run ( -- ) init any-key begin round game-over? until game-over ; cr cr .title cr cr .run