-- MakePuzzle.mesa
-- Edited by Sweet, 21-Sep-82 9:59:19
DIRECTORY
Ascii,
Inline,
IODefs,
PressDefs,
PressUtilities,
Random,
Segments,
Storage,
Streams,
String;
MakePuzzle: PROGRAM
IMPORTS Inline, IODefs, PressDefs, PressUtilities, Random, Segments, Storage, Streams, String =
BEGIN OPEN PressDefs;
pfdBody: PressFileDescriptor;
pfd: POINTER TO PressFileDescriptor = @pfdBody;
Mica: TYPE = CARDINAL;
MBox: TYPE = RECORD [x,y,w,h: Mica];
P3: Mica = PointsToMicas[3];
M1: Mica = MicasPerInch;
M12: Mica = MicasPerInch/2;
M14: Mica = MicasPerInch/4;
M34: Mica = (3*MicasPerInch)/4;
M38: Mica = (3*MicasPerInch)/8;
bw: Mica;
PointsToMicas: PROC [points: CARDINAL] RETURNS [Mica] =
{RETURN [Inline.LongDiv[Inline.LongMult[points, MicasPerInch],72]]};
CenterChar: PROC [c: CHARACTER, box: POINTER TO MBox] =
BEGIN
w: Mica;
ns: STRING ← [2];
ns.length ← 1; ns[0] ← c;
w ← CharWidth[c];
PutText[pfd, ns, box.x + (box.w-w)/2, box.y + P3 + (box.h-CharHeight)/2];
END;
Sort: PUBLIC PROCEDURE [
a: DESCRIPTOR FOR ARRAY OF UNSPECIFIED,
Greater: PROC[UNSPECIFIED, UNSPECIFIED] RETURNS [BOOLEAN]] =
BEGIN
n: CARDINAL = LENGTH[a];
i: CARDINAL;
temp: CARDINAL;
SiftUp: PROC [l, u: CARDINAL] =
BEGIN
s: CARDINAL;
key: CARDINAL ← a[l-1];
DO
s ← l*2;
IF s > u THEN EXIT;
IF s < u AND Greater[a[s+1-1], a[s-1]] THEN s ← s+1;
IF Greater[key, a[s-1]] THEN EXIT;
a[l-1] ← a[s-1];
l ← s;
ENDLOOP;
a[l-1] ← key;
END;
FOR i DECREASING IN [2..n/2] DO SiftUp[i, n]; ENDLOOP;
FOR i DECREASING IN [2..n] DO
SiftUp[1, i];
temp ← a[1-1];
a[1-1] ← a[i-1];
a[i-1] ← temp;
ENDLOOP;
END;
iRandom: ARRAY [0..32) OF CARDINAL;
jRandom: ARRAY [0..32) OF CARDINAL;
RandomizeRows: PROC =
BEGIN
r: ARRAY [0..32) OF CARDINAL;
rGreater: PROC [x, y: CARDINAL] RETURNS [BOOLEAN] =
{RETURN [r[x] > r[y]]};
i: CARDINAL;
FOR i IN [0..nRows) DO
r[i] ← Random.InRange[0, 1000];
iRandom[i] ← i;
ENDLOOP;
Sort[DESCRIPTOR[@iRandom, nRows], rGreater ];
END;
RandomizeColumns: PROC =
BEGIN
r: ARRAY [0..32) OF CARDINAL;
rGreater: PROC [x, y: CARDINAL] RETURNS [BOOLEAN] =
{RETURN [r[x] > r[y]]};
i: CARDINAL;
FOR i IN [0..nCols) DO
r[i] ← Random.InRange[0, 1000];
jRandom[i] ← nCols-1-i;
ENDLOOP;
Sort[DESCRIPTOR[@jRandom, nCols], rGreater ];
END;
nRows, nCols: CARDINAL ← 20;
textX, textY: Mica;
ComputeMargins: PROC =
BEGIN
rMax, cMax: Mica;
cMax ← (13*M1)/2*nCols;
rMax ← (9*M1)/nRows;
bw ← MIN [rMax, cMax, M38];
bottomMargin ← 10*M1 - nRows*bw;
leftMargin ← ((17*M1)/2 - nCols * bw)/2;
END;
Alpha: TYPE = CHARACTER ['a..'z];
-- from Gaines, Cryptanalysis
CharWeight: ARRAY Alpha OF CARDINAL = [
-- a, b, c, d, e, f, g, h, i, j, k, l, m,
805, 162, 320, 365,1231, 228, 161, 514, 718, 10, 52, 403, 225,
-- n, o, p, q, r, s, t, u, v, w, x, y, z
719, 794, 229, 20, 603, 659, 959, 310, 93, 203, 20, 188, 9];
totalWeight: CARDINAL;
RandomChar: PROC RETURNS [ch: Alpha] =
BEGIN
choice: CARDINAL ← Random.InRange[1, totalWeight];
FOR ch IN Alpha DO
IF choice < CharWeight[ch] THEN {
ch ← ch + ('A - 'a);
RETURN};
choice ← choice - CharWeight[ch];
ENDLOOP;
END;
Mode: TYPE = {horiz, vert, slopedown, slopeup, revhoriz, revvert, revslopedown, revslopeup};
modeWeight: ARRAY Mode OF CARDINAL ← [30, 20, 7, 7, 0, 0, 0, 0];
totalmodeWeight: CARDINAL;
RandomMode: PROC RETURNS [m: Mode] =
BEGIN
choice: CARDINAL ← Random.InRange[0, totalmodeWeight-1];
FOR m IN Mode DO
IF choice < modeWeight[m] THEN RETURN;
choice ← choice - modeWeight[m];
ENDLOOP;
END;
Match: PROC [s: STRING, r, c: CARDINAL, mode: Mode] RETURNS [BOOLEAN] =
BEGIN
j: CARDINAL;
ch: CHARACTER;
SELECT mode FROM
horiz => {
IF c + s.length >= nCols THEN RETURN[FALSE];
FOR j IN [0..s.length) DO
IF (ch ← node[r][c+j]) # 0C AND ch # s[j] THEN RETURN[FALSE];
ENDLOOP;
FOR j IN [0..s.length) DO node[r][c+j] ← s[j]; ENDLOOP;
RETURN[TRUE]};
vert => {
IF r + s.length >= nRows THEN RETURN[FALSE];
FOR j IN [0..s.length) DO
IF (ch ← node[r+j][c]) # 0C AND ch # s[j] THEN RETURN[FALSE];
ENDLOOP;
FOR j IN [0..s.length) DO node[r+j][c] ← s[j]; ENDLOOP;
RETURN[TRUE]};
slopedown => {
IF r + s.length >= nRows OR c + s.length >= nCols THEN RETURN[FALSE];
FOR j IN [0..s.length) DO
IF (ch ← node[r+j][c+j]) # 0C AND ch # s[j] THEN RETURN[FALSE];
ENDLOOP;
FOR j IN [0..s.length) DO node[r+j][c+j] ← s[j]; ENDLOOP;
RETURN[TRUE]};
slopeup => {
IF r < s.length-1 OR c + s.length >= nCols THEN RETURN[FALSE];
FOR j IN [0..s.length) DO
IF (ch ← node[r-j][c+j]) # 0C AND ch # s[j] THEN RETURN[FALSE];
ENDLOOP;
FOR j IN [0..s.length) DO node[r-j][c+j] ← s[j]; ENDLOOP;
RETURN[TRUE]};
revhoriz => {
IF c < s.length-1 THEN RETURN[FALSE];
FOR j IN [0..s.length) DO
IF (ch ← node[r][c-j]) # 0C AND ch # s[j] THEN RETURN[FALSE];
ENDLOOP;
FOR j IN [0..s.length) DO node[r][c-j] ← s[j]; ENDLOOP;
RETURN[TRUE]};
revvert => {
IF r < s.length-1 THEN RETURN[FALSE];
FOR j IN [0..s.length) DO
IF (ch ← node[r-j][c]) # 0C AND ch # s[j] THEN RETURN[FALSE];
ENDLOOP;
FOR j IN [0..s.length) DO node[r-j][c] ← s[j]; ENDLOOP;
RETURN[TRUE]};
revslopedown => {
IF r < s.length-1 OR c < s.length-1 THEN RETURN[FALSE];
FOR j IN [0..s.length) DO
IF (ch ← node[r-j][c-j]) # 0C AND ch # s[j] THEN RETURN[FALSE];
ENDLOOP;
FOR j IN [0..s.length) DO node[r-j][c-j] ← s[j]; ENDLOOP;
RETURN[TRUE]};
revslopeup => {
IF r + s.length-1 >= nRows OR c < s.length-1 THEN RETURN[FALSE];
FOR j IN [0..s.length) DO
IF (ch ← node[r+j][c-j]) # 0C AND ch # s[j] THEN RETURN[FALSE];
ENDLOOP;
FOR j IN [0..s.length) DO node[r+j][c-j] ← s[j]; ENDLOOP;
RETURN[TRUE]};
ENDCASE => ERROR;
END;
AddWord: PROC [s: STRING] =
BEGIN
tried: ARRAY Mode OF BOOLEAN ← ALL[FALSE];
key: STRING ← [40];
i, j: CARDINAL;
mode: Mode ← RandomMode[];
AddInMode: PROC RETURNS [BOOLEAN] =
BEGIN
FOR r: CARDINAL IN [0..nRows) DO
i ← iRandom[r];
FOR c: CARDINAL IN [0..nCols) DO
j ← jRandom[c];
IF Match[key, i, j, mode] THEN RETURN[TRUE];
ENDLOOP;
ENDLOOP;
RETURN[FALSE];
END;
RandomizeRows[];
RandomizeColumns[];
FOR i IN [0..s.length) DO
key[i] ← (IF s[i] IN ['a..'z] THEN s[i] + ('A - 'a) ELSE s[i]);
ENDLOOP;
key.length ← s.length;
IF AddInMode[] THEN RETURN;
mode ← vert; IF modeWeight[mode] # 0 AND AddInMode[] THEN RETURN;
mode ← horiz; IF modeWeight[mode] # 0 AND AddInMode[] THEN RETURN;
FOR mode IN [slopedown..revslopeup] DO
IF modeWeight[mode] # 0 AND AddInMode[] THEN RETURN;
ENDLOOP;
SIGNAL CantDoIt;
END;
CantDoIt: SIGNAL = CODE;
leftMargin, bottomMargin: Mica;
node: POINTER TO ARRAY [0..32) OF PACKED ARRAY [0..32) OF CHARACTER;
badData: SIGNAL = CODE;
ReadDataFile: PROC [in: Streams.Handle] =
BEGIN
dataEnd: BOOLEAN ← FALSE;
name: STRING = [40];
number: STRING = [20];
ch: CHARACTER;
GetToken: PROC [token: STRING, spaceOK: BOOLEAN ← FALSE] =
BEGIN ENABLE Streams.End[] => {dataEnd ← TRUE; GO TO done};
token.length ← 0;
IF dataEnd THEN RETURN;
WHILE ch = Ascii.CR OR (~spaceOK AND ch = Ascii.SP) DO
ch ← Streams.GetChar[in];
ENDLOOP;
IF ch = '; THEN {dataEnd ← TRUE; RETURN};
WHILE (ch IN ['A..'Z]) OR (ch IN ['a..'z]) OR (ch IN ['0..'9])
OR (spaceOK AND ch = Ascii.SP) DO
String.AppendChar[token, ch];
ch ← Streams.GetChar[in];
ENDLOOP;
IF token.length = 0 AND ~dataEnd THEN SIGNAL badData;
IF ch = '; THEN dataEnd ← TRUE;
EXITS
done => RETURN;
END;
BEGIN
ENABLE {
badData => GO TO badFormat;
String.StringBoundsFault => GO TO tooLong;
String.InvalidNumber => GO TO badNumber};
nRows ← nCols ← 0; nS ← 0;
ch ← Streams.GetChar[in ! Streams.End[] => GO TO done];
GetToken[number];
nRows ← String.StringToDecimal[number];
IF nRows > 32 THEN GO TO tooManyRows;
GetToken[number];
nCols ← String.StringToDecimal[number];
IF nCols > 32 THEN GO TO tooManyRows;
DO
GetToken[name, TRUE];
IF name.length = 0 THEN EXIT;
IF nS = 40 THEN GO TO tooManyStrings;
input[nS] ← Storage.CopyString[name];
sortedInput[nS] ← NoBlanks[name];
nS ← nS + 1;
ENDLOOP;
EXITS
tooLong => {
IODefs.WriteString["token too long at "L];
WriteLongNumber[Streams.GetIndex[in]]};
tooManyRows => {
IODefs.WriteString["max of 32 rows or columns"L]};
tooManyStrings => {
IODefs.WriteString["max of 40 words"L]};
badNumber => {
IODefs.WriteString["invalid number at "L];
WriteLongNumber[Streams.GetIndex[in]]};
badFormat => {
IODefs.WriteString["invalid format at "L];
WriteLongNumber[Streams.GetIndex[in]]};
done => NULL;
END;
END;
input, sortedInput: ARRAY [0..40] OF STRING;
nS: CARDINAL ← 0;
NoBlanks: PROC [s: STRING] RETURNS [ns: STRING] =
BEGIN
ns ← Storage.String[s.length];
FOR i: CARDINAL IN [0..s.length) DO
IF s[i] # Ascii.SP THEN String.AppendChar[ns, s[i]];
ENDLOOP;
END;
FreeData: PROC = {
FOR i: CARDINAL IN [0..nS) DO
Storage.Free[input[i]]; Storage.Free[sortedInput[i]] ENDLOOP;
nS ← 0};
GenPuzzle: PROC =
BEGIN
ComputeMargins[];
node↑ ← ALL[ALL[0C]];
FOR i: CARDINAL IN [0..nS) DO
AddWord[sortedInput[i]];
ENDLOOP;
END;
GeneratePuzzle: PROC =
BEGIN
GenPuzzle[ ! CantDoIt => {IODefs.WriteChar['?]; RETRY}];
IODefs.WriteChar['!];
END;
PrintWords: PROC =
BEGIN
Helvetica18[];
textX ← M1;
textY ← bottomMargin - M1;
FOR i: CARDINAL IN [0..nS) DO
PutText[pfd, input[i], textX, textY];
textY ← textY - CharHeight - P3;
IF textY < M1 THEN
{textX ← textX + M1 + 3*M1/4; textY ← bottomMargin - M1};
ENDLOOP;
END;
WriteLongNumber: PROC [ln: LONG CARDINAL] =
BEGIN
ls: STRING = [20];
String.AppendLongNumber[ls, ln, 10];
IODefs.WriteString[ls];
END;
CharHeight: Mica;
CharWidth: POINTER TO ARRAY CHARACTER OF Mica;
HCharWidth: ARRAY CHARACTER OF Mica;
H14CharWidth: ARRAY CHARACTER OF Mica;
Helvetica18: PROC =
BEGIN
SetFont[p: pfd, Name: "Helvetica", PointSize: 18, Face: 2];
CharWidth ← @HCharWidth;
CharHeight ← PointsToMicas[18];
END;
Helvetica14: PROC =
BEGIN
SetFont[p: pfd, Name: "Helvetica", PointSize: 14, Face: 2];
CharWidth ← @HCharWidth;
CharHeight ← PointsToMicas[14];
END;
DigestFonts: PROC =
BEGIN
[] ← PressUtilities.FindFontWidths[
family: "Helvetica"L,
points: 18,
weight: bold,
slope: regular,
widths: LOOPHOLE[@HCharWidth]];
[] ← PressUtilities.FindFontWidths[
family: "Helvetica"L,
points: 14,
weight: bold,
slope: regular,
widths: LOOPHOLE[@H14CharWidth]];
CharHeight ← PointsToMicas[18];
END;
WriteMatrix: PROC =
BEGIN
box: MBox ← [
x: leftMargin, y: bottomMargin + (nRows-1)*bw, w: bw, h: bw];
Helvetica18[];
FOR r: CARDINAL IN [0..nRows) DO
box.x ← leftMargin;
FOR c: CARDINAL IN [0..nCols) DO
ch: CHARACTER = node[r][c];
CenterChar[(IF ch = 0C THEN RandomChar[] ELSE ch), @box];
box.x ← box.x + bw;
ENDLOOP;
box.y ← box.y - bw;
ENDLOOP;
END;
nP: CARDINAL;
OneOrMore: PROC [inputFile: STRING] =
BEGIN OPEN IODefs;
Shorter: PROC [s1, s2: STRING] RETURNS [BOOLEAN] = {
RETURN[s1.length < s2.length]};
Alpha: PROC [s1, s2: STRING] RETURNS [BOOLEAN] = {
RETURN[String.CompareStrings[s1, s2] > 0]};
in: Streams.Handle ← NIL;
node↑ ← ALL[ALL[0C]];
in ← Streams.NewStream [inputFile, Streams.Read !
Segments.FileNameProblem[] => GO TO notFound];
DO
ReadDataFile[in];
IF nRows = 0 THEN EXIT;
Sort[DESCRIPTOR[BASE[sortedInput], nS], Shorter];
THROUGH [0..nP) DO
GeneratePuzzle[];
Sort[DESCRIPTOR[BASE[input], nS], Alpha];
PrintWords[];
WriteMatrix[];
WritePage[pfd];
ENDLOOP;
FreeData[];
ENDLOOP;
IF in # NIL THEN Streams.Destroy[in];
EXITS
notFound => {
IODefs.WriteString[inputFile];
IODefs.WriteLine[" not found."L]};
END;
Yes: PROC RETURNS [BOOLEAN] =
BEGIN OPEN IODefs;
SELECT ReadChar[] FROM
'y, 'Y, CR => {WriteLine["yes"]; RETURN[TRUE]};
ENDCASE => {WriteLine["no"]; RETURN[FALSE]};
END;
Driver: PROC =
BEGIN OPEN IODefs;
inputFile: STRING ← [40];
ws: Streams.Handle;
modeName: ARRAY Mode OF STRING ← [
"left to right"L, "top to bottom"L,
"upper left to lower right"L, "lower left to upper right"L,
"right to left"L, "bottom to top"L,
"lower right to upper left"L, "upper right to lower left"L];
node ← Storage.Words[32*32];
WriteString["New weights? "];
IF Yes[] THEN
BEGIN
ws ← Streams.NewStream["puzzle.weights"L, Streams.Write];
FOR m: Mode IN Mode DO
modeWeight[m] ← 0;
WriteString[modeName[m]]; WriteString[": "L];
modeWeight[m] ← ReadDecimal[ ! String.InvalidNumber => CONTINUE];
Streams.PutWord[ws, modeWeight[m]];
WriteChar[CR];
ENDLOOP;
Streams.Destroy[ws];
END
ELSE
BEGIN
ws ← Streams.NewStream["puzzle.weights"L, Streams.Read !
Segments.FileNameProblem[] => GO TO noWeights];
FOR m: Mode IN Mode DO
modeWeight[m] ← Streams.GetWord[ws ! Streams.End[] => GO TO badWeights];
ENDLOOP;
Streams.Destroy[ws];
END;
Init[];
DigestFonts[];
InitPressFileDescriptor[pfd, "Puzzle.press"L];
DO
WriteString["Input data: "L];
inputFile.length ← 0;
ReadID[inputFile]; WriteChar[CR];
IF inputFile.length = 0 THEN EXIT;
WriteString["pages: "L];
nP ← ReadDecimal[]; WriteChar[CR];
OneOrMore[inputFile];
ENDLOOP;
ClosePressFile[pfd];
Storage.FreeWords[node];
EXITS
noWeights => WriteLine["No weights available"L];
badWeights => WriteLine["Insufficient weights"L];
END;
Init: PROC =
BEGIN
totalWeight ← 0;
FOR a: Alpha IN Alpha DO
totalWeight ← totalWeight + CharWeight[a];
ENDLOOP;
totalmodeWeight ← 0;
FOR m: Mode IN Mode DO
totalmodeWeight ← totalmodeWeight + modeWeight[m];
ENDLOOP;
END;
Driver[];
END.