Working Crossword Puzzle Example - Programmers Heaven

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories

Working Crossword Puzzle Example

zibadianzibadian Posts: 6,349Member
[b][red]This message was edited by zibadian at 2004-12-12 9:16:38[/red][/b][hr]
Here is a working crossword puzzle. It has been tested in both Delphi 5 as well as Turbo Pascal 7.0 for DOS. It is uncommented and quite advanced, but you can learn a lot from it:
[code]
unit CwUtils;

interface

const
NumberOfWords = 3;
type
TWord = record
Answer: string;
Hint: string;
Location: record
X, Y: integer;
end;
IsVertical: boolean;
end;
TWordsList = array[0..NumberOfWords-1] of TWord;

TDisplay = record
Size: record
X, Y: integer;
end;
Display: array[1..20] of string;
end;

TShowError = procedure(Message: string);

var
ShowError: TShowError;

procedure StrToTWord(s: string; var Result: TWord);
procedure LoadFromFile(Filename: string; var List: TWordsList);
procedure SaveToFile(Filename: string; List: TWordsList);
procedure BuildDisplay(List: TWordsList; var Display: TDisplay);
procedure AddWordToDisplay(List: TWordsList; WordIndex: integer;
var Display: TDisplay);
function CheckAnswer(Answer: string; List: TWordsList; WordIndex: integer;
var Display: TDisplay): boolean;
function CreateHint(List: TWordsList; WordIndex: integer): string;

implementation

function StringSplit(Source: string; p: integer; separator: char): string;
var
i: integer;
s,s1: string;
begin
s:= Source + separator;
for i := 0 to p do begin
s1 := Copy(s, 1, Pos(separator, s)-1);
s := Copy(s, Pos(separator, s)+1, Length(Source));
end;
StringSplit := s1;
end;

procedure StrToTWord(s: string; var Result: TWord);
var
e: integer;
begin
with Result do
begin
Answer := StringSplit(s, 0, '|');
Hint := StringSplit(s, 1, '|');
Val(StringSplit(StringSplit(s, 2, '|'), 0, ','), Location.X, e);
Val(StringSplit(StringSplit(s, 2, '|'), 1, ','), Location.Y, e);
IsVertical := StringSplit(s, 3, '|') = 'V';
end;
end;

procedure LoadFromFile(Filename: string; var List: TWordsList);
var
f: text;
l: string;
i: integer;
begin
Assign(f, Filename);
Reset(f);
for i := 0 to NumberOfWords-1 do
if eof(f) then
Break
else
begin
Readln(f, l);
StrToTWord(l, List[i]);
end;
Close(f);
end;

procedure SaveToFile(Filename: string; List: TWordsList);
var
f: text;
i: integer;
begin
Assign(f, Filename);
Rewrite(f);
for i := 0 to NumberOfWords-1 do
with List[i] do
begin
write(f, Answer, '|', Hint, '|', Location.X, ',', Location.Y, '|');
if IsVertical then
writeln(f, 'V')
else
writeln(f, 'H');
end;
Close(f);
end;

procedure BuildDisplay(List: TWordsList; var Display: TDisplay);
var
i: integer;
x, y: integer;
begin
with Display do
begin
Size.X := 1;
Size.Y := 1;
for i := 0 to NumberOfWords-1 do
with List[i] do
begin
if IsVertical then
begin
if Location.Y+Length(Answer)-1 > Size.Y then
Size.Y := Location.Y+Length(Answer)-1;
end else begin
if Location.X+Length(Answer)-1 > Size.X then
Size.X := Location.X+Length(Answer)-1;
end;
end;
if Size.X > 70 then
begin
ShowError('Display too large (Horizontal size larger than 70)');
Exit;
end;
if Size.Y > 20 then
begin
ShowError('Display too large (Vertical size larger than 20)');
Exit;
end;
for y := 1 to Size.Y do
begin
Display[y] := '';
for x := 1 to Size.X do
Display[y] := Display[y] + '*';
end;
for i := 0 to NumberOfWords-1 do
with List[i] do
begin
if IsVertical then
for x := 1 to Length(Answer)-1 do
Display[Location.Y+x][Location.X] := '?'
else
for x := 1 to Length(Answer)-1 do
Display[Location.Y][Location.X+x] := '?';
end;
for i := 0 to NumberOfWords-1 do
with List[i] do
Display[Location.Y][Location.X] := Char(i+byte('1'));
end;
end;

function Uppercase(s: string): string;
var
i: integer;
begin
if Length(s) > 0 then
for i := 1 to Length(s) do
s[i] := Upcase(s[i]);
Uppercase := s;
end;

procedure AddWordToDisplay(List: TWordsList; WordIndex: integer;
var Display: TDisplay);
var
i: integer;
begin
with List[WordIndex] do
begin
if IsVertical then
for i := 1 to Length(Answer) do
Display.Display[Location.Y+i-1][Location.X] := Upcase(Answer[i])
else
for i := 1 to Length(Answer) do
Display.Display[Location.Y][Location.X+i-1] := Upcase(Answer[i]);
end;
end;

function CheckAnswer(Answer: string; List: TWordsList; WordIndex: integer;
var Display: TDisplay): boolean;
var
b: boolean;
begin
b := Uppercase(Answer) = Uppercase(List[WordIndex].Answer);
if b then
AddWordToDisplay(List, WordIndex, Display);
CheckAnswer := b;
end;

function CreateHint(List: TWordsList; WordIndex: integer): string;
var
s: string;
begin
with List[WordIndex] do
begin
Str(Length(Answer), s);
s := Hint+' ('+s+' letters)';
end;
CreateHint := s;
end;

procedure DummyShowError(Message: string); far;
begin
end;

begin
ShowError := DummyShowError;
end.
[/code]

[code]
program TP7CW;

uses
Crt, CwUtils;

procedure TPShowError(Message: string); far;
begin
writeln(Message);
writeln('Stopping program!');
writeln('Press ENTER...');
readln;
Halt(1);
end;

var
FList: TWordsList;
FDisplay: TDisplay;
i: integer;
UserInput: string;
begin
ShowError := TPShowError;
StrToTWord('Pascal|Programming Language named after a mathmatician|1,1|H', FList[0]);
StrToTWord('Car|Means of personal transportation on four wheels|4,1|V', FList[2]);
StrToTWord('Answer|A response to a question|2,1|V', FList[1]);
BuildDisplay(FList, FDisplay);
ClrScr;
repeat
with FDisplay do
for i := 1 to Size.Y do
writeln(Display[i]);
writeln;
for i := 0 to NumberOfWords-1 do
writeln(i+1, ': ', CreateHint(FList, i));
writeln;
writeln('0: Exit Program');
write('Enter Number: ');
readln(i);
if i in [1..NumberOfWords] then
begin
writeln('Hint: ', CreateHint(FList, i-1));
write('Enter answer: ');
readln(UserInput);
ClrScr;
if CheckAnswer(UserInput, FList, i-1, FDisplay) then
writeln('Correct answer')
else
writeln('Wrong answer');
writeln;
end;
until i = 0;
end.
[/code]
Beware, if you directly copy-paste this code and hand it in, you might fail the assignment, because your teacher will probably see that it is not your work.


Comments

  • anymananyman Posts: 19Member
    : [code]

    : procedure LoadFromFile(Filename: string; var List: TWordsList);
    : var
    : f: text;
    : l: string;
    : i: integer;
    : begin
    : Assign(f, Filename);
    : Reset(f);
    : for i := 0 to NumberOfWords-1 do
    : if eof(f) then
    : Break
    : else
    : begin
    : Readln(f, l);
    : StrToTWord(l, List[i]);
    : end;
    : Close(f);
    : end;
    :
    How can I run the program
    I just wanna find out how the struture is
    but It have a problem in "Break"---Unknown idenifier

  • zibadianzibadian Posts: 6,349Member
    : : [code]
    :
    : : procedure LoadFromFile(Filename: string; var List: TWordsList);
    : : var
    : : f: text;
    : : l: string;
    : : i: integer;
    : : begin
    : : Assign(f, Filename);
    : : Reset(f);
    : : for i := 0 to NumberOfWords-1 do
    : : if eof(f) then
    : : Break
    : : else
    : : begin
    : : Readln(f, l);
    : : StrToTWord(l, List[i]);
    : : end;
    : : Close(f);
    : : end;
    : :
    : How can I run the program
    : I just wanna find out how the struture is
    : but It have a problem in "Break"---Unknown idenifier
    :
    :
    The program currently does not use the LoadFromFile(), so you can comment that out.
Sign In or Register to comment.