RosettaCodeData/Task/Mastermind/APL/mastermind.apl

132 lines
4.5 KiB
APL
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

#!/usr/local/bin/apl -s -f --
⍝ Define the alphabet
A'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
⍝ Make ASCII values upper case
nAscUp c
nc-32×(c97)(c122)
⍝ Does a list have repeated values?
rRpts l
r(ll)l
⍝ Keyboard input using ⎕ and ⍞ doesn't work well using GNU APL in script mode,
⍝ so you kind of have to write your own.
⍝ Read a line of text from the keyboard
lReadLine up;k;z;data
data'' csr0 ⍝ Start out with empty string and cursor at 0
⍝⍝⍝ Keyboard input
in: k1⎕fio[41]1 ⍝ Read byte from stdin
handle: (k>127)/skip ⍝ Unicode is not supported (Wumpus doesn't need it)
(k8 127)/back ⍝ Handle backspace
(k=10)/done ⍝ Newline = Enter key pressed
(k<32)/in ⍝ For simplicity, disregard terminal control entirely
k(AscUpup)k ⍝ Make key uppercase if necessary
zk⎕fio[42]0 ⍝ Echo key to stdout
datadata,k ⍝ Insert key into data
in ⍝ Go get next key
⍝⍝⍝ Skip UTF-8 input (read until byte ≤ 127)
skip: k1⎕fio[41]1 (k>127)/skip handle
⍝⍝ Backspace
back: (0=data)/in ⍝ If already at beginning, ignore
zk⎕fio[42]0 ⍝ Backspace to terminal
data¯1data ⍝ Remove character
in ⍝ Get next key
⍝⍝ We are done, return the line as text
done: l⎕UCS data
⍝ Read a positive number from the keyboard in the range [min...max]
nmin ReadNum max;l;z
in: lReadLine 0
z10⎕fio[42]0
(~l.'0123456789')/no
((minn)maxnl)/0
no: 'Please enter a number between ',(min),' and ',(max),': '
in
⍝ Ask a numeric question
nq Question lim;min;max
(min max)lim
q,' [',(min),'..',(max),']? '
nmin ReadNum max
⍝ Read a choice from the keyboard
cChoice cs;ks;k;z
ksAscUp ⎕UCS ¨cs ⍝ User should press first letter of choice
in: (~(kAscUp 1⎕fio[41]1)ks)/in ⍝ Wait for user to make choice
z(ccs[ksk])⎕fio[42]0 ⍝ Select and output correspoinding choice
⍝ Ask the user for game parameters
parmsInitGame;clrs;len;gss;rpts
'∘∘∘ MASTERMIND ∘∘∘' ''
clrs'How many colors' Question 2 20
len'Code length' Question 4 10
gss'Maximum amount of guesses' Question 7 20
'Allow repeated colors in code (Y/N)? '
rpts'Yes'Choice 'Yes' 'No'
parmsclrs len gss rpts
⍝ Generate a code.
crpts MakeCode parms;clrs;len
(clrs len)parms
cA[(1+rpts)(len?clrs)(?len/clrs)]
⍝ Let user make a guess and handle errors
gparms Guess code;clrs;rpts;l;right;in
(clrs rpts num)parms
guess: 'Guess ',(¯2num),': ' gReadLine 1 ⍝ Read a guess from the keyboard
⍝ Don't count obvously invalid input against the user
((code)g)/len ⍝ Length is wrong
(~g.A[clrs])/inv ⍝ Invalid code in input
((~rpts)Rpts g)/rpt ⍝ No repeats allowed
⍝ Give feedback
rightg=code ⍝ Colors in right position
ingcode ⍝ Colors not in right position
fb(+/right)/'X' ⍝ X = amount of matching ones
fbfb,(+/in~right)/'O' ⍝ O = amount of non-matching ones
fbfb,(+/~in)/'-' ⍝ - = amount of colors not in code
' --→ ',fb,⎕UCS 10
0
len: 'Invalid length.' guess
inv: 'Invalid color.' guess
rpt: 'No repeats allowed.' guess
⍝ Play the game
Mastermind;clrs;len;gsmax;rpts;code;gs
⎕rl(2*32)|×/⎕ts ⍝ initialize random seed
(clrs len gsmax rpts)InitGame
coderpts MakeCode clrs len
2 0''
'The code consists of: ',A[clrs]
gs0
loop: gsgs+1
(gs>gsmax)/lose
(code(clrs rpts gs)Guess code)/loop
'○○○ Congratulations! ○○○'
'You won in ',(gs),' guesses.'
0
lose: 'Alas, you are out of guesses.'
'The code was: ',code
Mastermind
)OFF