Family Day update

This commit is contained in:
Ingy döt Net 2020-02-17 23:21:07 -08:00
parent aac6731f2c
commit 9ad63ea473
2442 changed files with 39761 additions and 8255 deletions

View file

@ -28,12 +28,12 @@ extension op
public program()
{
var blocks := new object[] {"BO", "XK", "DQ", "CP", "NA",
var blocks := new string[]{"BO", "XK", "DQ", "CP", "NA",
"GT", "RE", "TG", "QD", "FS",
"JW", "HU", "VI", "AN", "OB",
"ER", "FS", "LY", "PC", "ZM"};
var words := new object[] {"", "A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse"};
var words := new string[]{"", "A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse"};
Enumerator e := words.enumerator();
e.next();

View file

@ -1,3 +1,5 @@
using Printf
function abc(str::AbstractString, list)
isempty(str) && return true
for i in eachindex(list)

View file

@ -7,15 +7,15 @@ blocks= 'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
spell: procedure expose blocks; arg x /*ARG uppercases the word to be spelt.*/
L=length(x); @.=0 /*get length of the word to be spelt. */
do try=1 for L; z=blocks; upper z /*use a fresh copy of the "Z" blocks.*/
do n=1 for L; y=substr(x, n, 1) /*attempt another letter in the word. */
@.n=pos(y, z, 1 + @.n); if @.n==0 then leave /*not found? Try again*/
z=overlay(' ', z, @.n) /*mutate the toy block ───► a onesy. */
do q=1 for words(z); if length(word(z, q))==1 then z=delword(z, q, 1)
L= length(x); @.= 0 /*get length of the word to be spelt. */
do try=1 for L; z= blocks; upper z /*use a fresh copy of the "Z" blocks.*/
do n=1 for L; y= substr(x, n, 1) /*attempt another letter in the word. */
@.n= pos(y, z, 1 + @.n); if @.n==0 then leave /*not found? Try again*/
z= overlay(' ', z, @.n) /*mutate the toy block ───► a onesy. */
do q=1 for words(z); if length(word(z,q))==1 then z= delword(z, q, 1)
end /*q*/ /* [↑] elide any existing onesy block.*/
if n==L then leave try /*was last letter used in the spelling?*/
end /*n*/ /* [↑] end of a toy block usage. */
end /*try*/ /* [↑] end of a "TRY" permute. */
say right(arg(1), 30) right( word( "can't can", (n==L) +1), 6) 'be spelt.'
say right( arg(1), 30) right( word( "can't can", (n==L) + 1), 6) 'be spelt.'
return

View file

@ -0,0 +1,29 @@
string 0;
char Side1, Side2;
def Size = 20;
char Avail(Size);
func CanMakeWord(Word); \returns 'true' if blocks can make Word
char Word;
int I, Let;
[Let:= Word(0) & $5F; \get letter and make sure it's uppercase
if Let = 0 then return true; \if 0 then end of word; return successful
for I:= 0 to Size-1 do \scan for block that contains letter
if Avail(I) and (Side1(I) = Let or Side2(I) = Let) then
[Avail(I):= false;
if CanMakeWord(Word+1) then return true;
];
return false;
];
int I, J, Words;
[Side1:= "BXDCNGRTQFJHVAOEFLPZ";
Side2:= "OKQPATEGDSWUINBRSYCM";
Words:= ["A", "bark", "Book", "Treat", "Common", "Squad", "conFuse"];
for J:= 0 to 6 do
[Text(0, "Can make ^""); Text(0, Words(J)); Text(0, "^": ");
for I:= 0 to Size-1 do Avail(I):= true;
Text(0, if CanMakeWord(Words(J)) then "True" else "False"); CrLf(0);
];
]