Spock!
Priskribo de la ĉi-paĝa enhavo
Plurlingva versio de la ludo Ŝtono, papero, tondilo, lacerto, Spock!, verkita en Fortho por unu ludanto.
Etikedoj:
Ĉi ludo estas versio de Ŝtono, papero, tondilo, lacerto, Spock. Ĝia kodo estas bazita sur hispanlingva versio de la klasika ludo Ŝtono, papero, tondilo) kiun mi jam verkis en Fortho.
Ĉiuj tekstoj estas plurlingvaj (en la hispana, en Esperanto, kaj en la usona kaj brita anglaj); la lingvon oni povas ŝanĝi dum la ludo. Ĝis nun ambaj anglaj dialektoj uzas samajn tekstojn — krom unu vorto.
Celo
La unua celo de ĉi projekto estis provi la programlingvon 4tH, kiu estas proksima parenco de Fortho kaj tamen ene tre malsimila al ĝi. Sed verki la programon kaj samtempe familiariĝi kun 4tH tuj estiĝis malpraktika. Mi decidis finverki la ludon por Gforth kaj poste fari version por 4tH: Spock IV.
Ontaj plibonigoj
Tri interesaj ecoj restis nerealigitaj:
- Senmenua teksta interfaco, simila al tiu de tekstaj aventuroj.
- Abundaj kaj hazarde kreitaj tekstoj.
- Malsama teksto por ĉiu remis-kombino.
Eble ili estos programitaj en onta versio de la programo.
Fontkodo
#! /usr/bin/env gforth
\ spock.fs
\ "Spock!"
\ Version 0.4.0+202001192042
\ (http://programandala.net/en.program.spock.html)
\ A multilingual (English, Esperanto, Interlingue and Spanish)
\ implementation of "Rock, paper, scissors, lizard, Spock",
\ written in the Forth programming language with Gforth
\ (http://gnu.org/software/gforth).
\ Based on the Spanish version of
\ "Rock, paper, scissors"
\ by the same author:
\ http://programandala.net/es.programa.piedra_papel_tijeras.html
\ Copyright (C) 2012,2019,2020 Marcos Cruz (programandala.net)
\ Spock! is free software; you can redistribute it and/or
\ modify it under the terms of the GNU General Public
\ License as published by the Free Software Foundation; either
\ version 2 of the License, or (at your option) any later version.
\ Spock! is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
\ General Public License for more details.
\ You should have received a copy of the GNU General Public License
\ along with this program; if not, see http://www.gnu.org/licenses .
\ ==============================================================
\ Stack notation
\ a = memory address
\ a len = memory region
\ c = character
\ ca = character-aligned memory address
\ ca len = character string
\ f = flag: 0|-1
\ fn = flag: 0|non-zero
\ len = length: unsigned 32-bit number
\ max = signed 32-bit number
\ min = signed 32-bit number
\ n = signed 32-bit number
\ u = unsigned 32-bit number
\ x = undefined element
\ .. = range
\ "name" = space delimited text in the input stream
\ "text" = text in the input stream
\ ==============================================================
\ Requirements
s" random.fs" required \ Gforth's 'random' and 'seed'.
require galope/begin-translation.fs \ `begin-translation`
require galope/between.fs \ `between`
require galope/enum.fs \ `enum`
require galope/n-comma.fs \ `n,`
require galope/one-plus-store.fs \ `1+!`
require galope/randomize.fs \ `randomize`
require galope/seconds.fs \ `seconds`
require galope/th.fs \ `th`
: at ( n a1 -- a2 ) swap th ;
\ Return address _a2_ of item (cell offset) _n_ in table _a1_.
: h" ( "text<quotes>" -- a ) here ," ; immediate \ "
\ Parse "text", delimited by ending quotes, compile it in data space
\ as a counted string and return its address _a_.
: s@ ( a -- ca len ) @ count ;
\ Return string _ca len_, whose address is stored in _a_.
\ ==============================================================
\ Languages
0 enum american-english \ en-US
enum british-english \ en-GB
enum esperanto \ eo
enum interlingue \ ie
enum spanish \ es
to langs \ Number of languages.
\ `langs` is provided by Galope's `begin-translation` module.
american-english value language
:noname ( -- n ) language ; is lang
\ `lang` is provided by Galope's `begin-translation` module.
\ Menu option to change the current language.
begin-translation not_in_language$ ( -- ca len )
american-english s" Not in American English."
british-english s" Not in British English."
esperanto s" Ne en Esperanto."
interlingue s" Ne in Interlingue"
spanish s" No en español."
end-translation
'+' constant language_key \ Key that changes the current language.
: next_language ( u1 -- u2 ) 1+ dup langs < and ;
: language++ ( -- ) language next_language to language ;
\ ==============================================================
\ Pauses and keyboard
: wait ( -- ) key drop ;
: .prompt ( -- ) cr cr ." > " ;
begin-translation press_key$ ( -- ca len )
american-english s" Press any key to continue."
british-english s" Press any key to continue."
esperanto s" Premu iun klavon por plui."
interlingue s" Presse alquel taste por continuar."
spanish s" Pulsa cualquier tecla para continuar."
end-translation
: press_key ( -- ) cr press_key$ type .prompt wait ;
\ ==============================================================
\ About
create (title$) ," Spock!"
: title$ ( -- ca len ) (title$) count ;
: .title ( -- ) title$ type cr cr ;
begin-translation long_title$ ( -- ca len )
american-english s" Rock, paper, scissors, lizard, Spock!"
british-english s" Rock, paper, scissors, lizard, Spock!"
esperanto s" Ŝtono, papero, tondilo, lacerto, Spock!"
interlingue s" Rocca, papere, cisores, lacerte, Spock!"
spanish s" ¡Piedra, papel, tijera, lagarto, Spock!"
end-translation
: copyright ( -- )
." Copyright (C) 2012 Marcos Cruz (programandala.net)" cr cr ;
: the_license ( -- )
." Spock! is free software; you can redistribute it and/or" cr
." modify it under the terms of the GNU General Public" cr
." License as published by the Free Software Foundation; either" cr
." version 2 of the License, or (at your option) any later version." cr ;
: about ( -- ) copyright 1 seconds the_license 3 seconds ;
: splash ( -- ) page .title about press_key ;
\ ==============================================================
\ Commands
0 enum rock \ First command.
enum paper
enum scissors
enum lizard
enum spock \ Last command.
constant commands \ Number of commands.
\ Compile the command names and leave the addresses of their counted
\ strings on the stack:
\ Last lang: First lang:
\ es ie eo en-GB en-US
\ ---------- ----------- ----------- ------------ -----------
h" Spock" dup dup dup dup \ Last command.
h" lagarto" h" lacerte" h" lacerto" h" lizard" dup
h" tijeras" h" cisores" h" tondilo" h" scissors" dup
h" papel" h" papere" h" papero" h" paper" dup
h" piedra" h" rocca" h" ŝtono" h" rock" dup \ First command.
create command-names
\ A 2-dimensional table to store the addresses of the strings.
langs commands * n,
\ Fill the table compiling the data from the stack.
: >command$ ( u -- ca len )
langs * language + command-names at s@ ;
\ Convert command number _u_ to command name _ca len_.
\ ==============================================================
\ Score
10 constant max_score
variable your_score
variable my_score
begin-translation your_score$ ( -- ca len )
american-english s" Your score"
british-english s" Your score"
esperanto s" Viaj poentoj"
interlingue s" Vor puntes"
spanish s" Tu puntuación"
end-translation
begin-translation my_score$ ( -- ca len )
american-english s" My score"
british-english s" My score"
esperanto s" Miaj poentoj"
interlingue s" Mi puntes"
spanish s" Mi puntuación"
end-translation
: .score ( ca len -- ) type s" : " type ;
: .your_score ( -- ) your_score$ .score your_score ? ;
: .my_score ( -- ) my_score$ .score my_score ? ;
: .scores ( -- ) cr cr .your_score cr .my_score cr ;
: max? ( a -- f ) @ max_score = ;
: you_win_game? ( -- f ) your_score max? ;
: i_win_game? ( -- f ) my_score max? ;
\ ==============================================================
\ Command selection
variable your_command
variable my_command
: choices ( -- u1 u2 ) my_command @ your_command @ ;
'0' constant "0"
: digit ( u -- c ) "0" + ;
: option ( c -- u ) "0" - ;
: command_key? ( c -- f ) "0" commands 1- digit between ;
: language_key? ( c -- f ) language_key = dup if language++ then ;
: valid_key? ( c -- f ) dup language_key? swap command_key? or ;
: your_key ( -- c ) 0 begin drop key dup valid_key? until ;
variable accusative \ Show the Esperanto commands in accusative?
: esperanto? ( -- f ) language esperanto = ;
: accusative? ( -- f ) esperanto? accusative @ and ;
: (.accusative) ( u -- ) spock = if ." -on" else ." n" then ;
: .accusative ( u -- ) accusative? if (.accusative) else drop then ;
: .choice ( u -- ) dup >command$ type .accusative '.' emit ;
: .command_option ( u -- ) dup cr . ." = " .choice ;
: .command_options ( -- ) commands 0 do i .command_option loop ;
: .language_option ( -- )
cr cr language_key emit ." = " not_in_language$ type ;
: .options ( -- ) cr accusative off .command_options .language_option ;
begin-translation choose$ ( -- ca len )
american-english s" Choose:"
british-english s" Choose:"
esperanto s" Elektu:"
interlingue s" Selecte:"
spanish s" Elige:"
end-translation
: menu ( -- )
page long_title$ type cr cr choose$ type .options .prompt ;
: your_choice ( -- u)
0 begin drop menu your_key
dup command_key? until option ;
: my_choice ( -- u ) commands random ;
begin-translation you_choosed$ ( -- ca len )
american-english s" You choosed"
british-english s" You choosed"
esperanto s" Vi elektis"
interlingue s" Vu selectet"
spanish s" Has sacado"
end-translation
: .you_choosed ( -- ) you_choosed$ type space ;
begin-translation i_choosed$ ( -- ca len )
american-english s" I choosed"
british-english s" I choosed"
esperanto s" Mi elektis"
interlingue s" Yo selectet"
spanish s" Yo he sacado"
end-translation
: .i_choosed ( -- ) i_choosed$ type space ;
: .your_choice ( -- ) .you_choosed your_command @ accusative on .choice ;
: .my_choice ( -- ) .i_choosed my_command @ .choice ;
: .choices ( -- ) .your_choice cr .my_choice ;
\ ==============================================================
\ Versus
commands dup * constant command_combinations
command_combinations cells constant /winners
create winners /winners allot
winners /winners erase
: >winner ( u1 u2 -- a ) commands * + winners at ;
\ Point to an element of the `winners` table.
\ u1 = Computer's command.
\ u2 = Human's command.
: winner ( u1 u2 -- ) >winner on ;
\ Mark a winner combination of commands (the computer wins).
\ u1 = Computer's command.
\ u2 = Human's command.
: winner? ( u1 u2 -- f ) >winner @ ;
\ Is the computer the winner in the given command combination?
\ u1 = Computer's command.
\ u2 = Human's command.
begin-translation i_win$ ( -- ca len )
american-english s" I win."
british-english s" I win."
esperanto s" Mi venkas."
interlingue s" Yo gania."
spanish s" Yo gano."
end-translation
begin-translation you_win$ ( -- ca len )
american-english s" You win."
british-english s" You win."
esperanto s" Vi venkas."
interlingue s" Vu gania."
spanish s" Tú ganas."
end-translation
: i_win_round ( -- ) i_win$ type my_score 1+! ;
: you_win_round ( -- ) you_win$ type your_score 1+! ;
: (versus) ( u1 u2 | u2 u1 -- u3 )
2dup min commands * >r max r> + 1+ ;
\ u1 u2 = Commands.
\ u3 = Identifier of the commands combination.
: versus ( u1 u2 | u2 u1 | u1 u1 -- u3 )
2dup = if 2drop 0 else (versus) then ;
\ u1 u2 = Commands.
\ u3 = Identifier of the commands combination.
commands 1- dup 1- versus constant max_versus
create explanations max_versus langs * cells allot
variable >explanations
\ Pointer in the 'explanations' table.
: explanations: ( u1 u2 -- )
versus >explanations ! ;
\ u1 u2 = Commands the following explanations definitions refers to.
: tie_explanations: ( -- ) 0 dup explanations: ;
: winner_explanations: ( u1 u2 -- )
2dup winner explanations: ;
\ u1 u2 = Commands the following explanations definitions refers to.
: explanation! ( a u -- )
>explanations @ langs * + explanations at ! ;
\ a = Address of the explanation string.
\ u = Language of the explanation string.
: english_explanations! ( a -- )
dup american-english explanation!
british-english explanation! ;
\ a = Address of the explanation string in both dialects of English.
: explanation ( u -- a1 u1 )
langs * language + explanations at s@ ;
\ u = Identifier of a commands combination.
\ a1 u1 = Explanation in the current language.
tie_explanations:
h" Empate." spanish explanation!
h" Remiso." esperanto explanation!
h" Tie." american-english explanation!
h" Draw." british-english explanation!
h" Egales." interlingue explanation! \ XXX TODO -- Translation.
rock scissors winner_explanations:
h" La piedra rompe la tijera." spanish explanation!
h" La ŝtono rompas la tondilon." esperanto explanation!
h" The rock crushes the scissors." english_explanations!
h" Li rocca aplasta li cisores." interlingue explanation!
paper rock winner_explanations:
h" El papel envuelve la piedra." spanish explanation!
h" La papero envolvas la ŝtonon." esperanto explanation!
h" The paper covers the rock." english_explanations!
h" Li papere covri li rocca." interlingue explanation!
scissors paper winner_explanations:
h" La tijera corta el papel." spanish explanation!
h" La tondilo tondas la paperon." esperanto explanation!
h" The scissors cut the paper." english_explanations!
h" Li cisores tonde li papere." interlingue explanation!
lizard spock winner_explanations:
h" El lagarto envenena a Spock." spanish explanation!
h" La lacerto venenas Spock-on." esperanto explanation!
h" The lizard poisons Spock." english_explanations!
h" Li lacerte venena Spock." interlingue explanation!
rock lizard winner_explanations:
h" La piedra aplasta el lagarto." spanish explanation!
h" La ŝtono premplatigas la lacerton." esperanto explanation!
h" The rock crushes the lizard." english_explanations!
h" Li rocca aplasta li lacerte." interlingue explanation!
scissors lizard winner_explanations:
h" La tijera decapita el lagarto." spanish explanation!
h" La tondilo senkapigas la lacerton." esperanto explanation!
h" The scissors decapitate the lizard." english_explanations!
h" Li cisores decapa li lacerte." interlingue explanation!
lizard paper winner_explanations:
h" El lagarto come el papel." spanish explanation!
h" La lacerto manĝas la paperon." esperanto explanation!
h" The lizard eats the paper." english_explanations!
h" Li lacerte manja li papere." interlingue explanation!
spock rock winner_explanations:
h" Spock vaporiza la piedra." spanish explanation!
h" Spock vaporigas la ŝtonon." esperanto explanation!
h" Spock vaporizes the rock." english_explanations!
h" Spock vaporisa li rocca." interlingue explanation!
paper spock winner_explanations:
h" El papel refuta a Spock." spanish explanation!
h" La papero senpravigas Spock-on." esperanto explanation!
h" The paper disproves Spock." english_explanations!
h" Li papere refuta Spock." interlingue explanation!
spock scissors winner_explanations:
h" Spock rompe la tijera." spanish explanation!
h" Spock rompas la tondilon." esperanto explanation!
h" Spock smashes the scissors." english_explanations!
h" Spock dispezza li cisores." interlingue explanation!
: i_win_round? ( -- f ) choices winner? ;
: (.round_winner) ( -- )
i_win_round? if i_win_round else you_win_round then ;
: tie? ( -- f ) choices = ;
: .round_winner ( -- ) tie? 0= if (.round_winner) then ;
: .result ( -- )
choices versus explanation type space .round_winner ;
: .results ( -- ) page .choices cr cr .result .scores press_key ;
\ ==============================================================
\ The end
begin-translation i_won_game$ ( -- ca len )
american-english s" I won the game."
british-english s" I won the game."
esperanto s" Mi venkis la ludon."
interlingue s" Yo ganiat li lude."
spanish s" He ganado la partida."
end-translation
begin-translation you_won_game$ ( -- ca len )
american-english s" You won the game."
british-english s" You won the game."
esperanto s" Vi venkis la ludon."
interlingue s" Vu ganiat li lude."
spanish s" Has ganado la partida."
end-translation
: game_winner$ ( -- ca len )
you_win_game? if you_won_game$ else i_won_game$ then ;
: game_over ( -- ) page game_winner$ type .scores ;
: game_over? ( -- f ) you_win_game? i_win_game? or ;
begin-translation press_space$ ( -- ca len )
american-english s" Press space to play again; any other key to finish."
british-english s" Press space to play again; any other key to finish."
esperanto s" Premu spacon por reludi; alian klavon por fini."
interlingue s" Presse spacie por reluder; altri taste por finir."
spanish s" Pulsa espacio para jugar de nuevo; otra tecla para terminar."
end-translation
begin-translation good_bye$ ( -- ca len )
american-english s" Bye!"
british-english s" Bye!"
esperanto s" Adiaŭ!"
interlingue s" Adio!"
spanish s" ¡Adiós!"
end-translation
: enough? ( -- f ) cr press_space$ type .prompt key bl <> ;
: final_pause ( -- ) 2 seconds ;
: farewell ( -- ) page good_bye$ type cr final_pause page bye ;
\ ==============================================================
\ Init
: init_game ( -- ) your_score off my_score off ;
: init_once ( -- ) randomize american-english to language ;
\ ==============================================================
\ Game
: i_play ( -- ) my_choice my_command ! ;
: you_play ( -- ) your_choice your_command ! ;
: turn ( -- ) i_play you_play .results ;
: game ( -- ) init_game begin turn game_over? until game_over ;
: run ( -- ) init_once splash begin game enough? until farewell ;
run
\ ==============================================================
\ Debugging tools
true [if]
: (.) ( n -- ) dup ." (" 0 .r ." )" ;
: check_explanations
page
langs 0 do i to language
commands 0 do
commands 0 do
i dup >command$ type (.)
." vs "
j dup >command$ type (.) ." = "
i j versus dup . ." -> "
explanation type cr
loop cr press_key page
loop
loop ;
[then]
\ ==============================================================
\ Change log
\ 2012-03-30 Version A-00. Start. Code for 4tH and Gforth.
\
\ 2012-04-01 Version A-01. Gforth only.
\
\ 2012-04-02 Version A-02. First working version. Spanish interface
\ only.
\
\ 2012-04-07 Version A-03. Multilingual interface.
\
\ 2012-04-08 Version A-04. Language selection.
\
\ 2012-04-10 Version B-00. General revision of the code.
\
\ 2012-04-14 Simpler method for showing the winner.
\
\ 2012-04-15 'init_once' moved to 'main'. A bit simpler game loop.
\ 'about' completed with GPL.
\
\ 2012-04-16 Changed the name format of all multilingual strings.
\ Pauses modified in 'about'.
\
\ 2012-06-15 Some little internal changes.
\
\ 2019-12-27: Update the URLs, the source style and the stack
\ notation. Change the version number after Semantic Versioning. Use
\ the Galope library. Rewrite the definiton of multilingual texts
\ using `begin-translation`. Remove old unused code. Add Interlingue.
\ Improve comments. Version 0.4.0.
\
\ 2020-01-19: Improve the program description in the header.
Deŝutoj
Instrukcioj
Unue, instalu Gforth -on en vian sistemon. Poste startu konzolon, eniru la dosierujon kie situas la ludo-dosiero kaj startu Gforth -on jene: gforth spock.fs.
Alia eblo estas malfermi la programon ene de Gforth mem, per iu el jenaj sam-efikaj ordonoj:
s" spock.fs" included
Aŭ:
include spock.fs