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

Welcome to the new platform of Programmer's Heaven! We apologize for the inconvenience caused, if you visited us from a broken link of the previous version. The main reason to move to a new platform is to provide more effective and collaborative experience to you all. Please feel free to experience the new platform and use its exciting features. Contact us for any issue that you need to get clarified. We are more than happy to help you.

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.