home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
MBUG
/
MBUG121.ARC
/
FRENCH.ARK
/
FRENCH1.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-08-07
|
6KB
|
200 lines
(* French vocabulary test program *)
(* by Jon Dart, 1866 Diamond St., San Diego, CA 92109 *)
(* Version 1.9, 10-JUL-85 *)
const
maxquestions = 50; (* max. num of questions/quiz *)
type
quiztype = (FRENCHTOENGLISH,ENGLISHTOFRENCH,GENDER);
repeatoption = (SAMEWORDS,WRONGWORDS,NEWQUIZ,EXIT);
stringarray = array[1..maxquestions] of textline;
integerarray = array[1..maxquestions] of integer;
booleanarray = array[1..maxquestions] of boolean;
var
nounfile, nonounfile :filedesc;
numquizquestions :integer;
numquestions :integer;
numnouns,numnonouns :integer;
numwrong :integer;
maxitems,k :integer;
quizitems :stringarray;
order :integerarray;
wrong :booleanarray;
quit :boolean;
quiz :quiztype;
option :repeatoption;
procedure openfiles(var nounfile,nonounfile:filedesc);
var
name1,name2 :textline;
begin
setstring(name1,'FRNOUN.DAT');
nounfile := open(name1,IOREAD);
if nounfile = IOERROR then
error('Can''t Open FRNOUN.DAT');
setstring(name2,'FRNONOUN.DAT');
nonounfile := open(name2,IOREAD);
if nonounfile = IOERROR then
error('Can''t Open FRNONOUN.DAT');
end;
procedure readsizes(var numnouns,numnonouns: integer);
(* read the first lines of NOUN.DAT and NONOUN.DAT, which should contain
the num of lines in each file *)
var
s :textline;
c :character;
i :integer;
begin
if getline(s,nounfile,MAXSTR) then
begin
i:=1;
numnouns := ctoi(s,i);
end;
if getline(s,nonounfile,MAXSTR) then
begin
i := 1;
numnonouns := ctoi(s,i);
end;
end;
procedure getquiztype(var quiz:quiztype);
var c :character;
junk :character;
j,k :integer;
begin
writeln;
writeln('SELECT ONE:');
writeln;
writeln('1 - WORD QUIZ: FRENCH TO ENGLISH');
writeln('2 - WORD QUIZ: ENGLISH TO FRENCH');
writeln('3 - GENDER QUIZ (NOUNS ONLY)');
writeln;
repeat
write('? ');
junk := getc(c);
if not (c in [ord('1'),ord('2'),ord('3')]) then writeln;
until c in [ord('1'),ord('2'),ord('3')];
j := c-ord('1');
quiz := FRENCHTOENGLISH;
for k:=1 to j do quiz := succ(quiz);
writeln;
end;
procedure getnumquestions(var quiz:quiztype; var numquestions,
maxitems:integer);
var
ok :boolean;
s :textline;
i :integer;
begin
repeat
write('HOW MANY QUESTIONS (50 MAX.)? ');
if getline(s,TRMIN,MAXSTR) then
begin
i := 1;
numquestions := ctoi(s,i);
end;
if not numquestions in [0..50] then
begin
writeln('ERROR - MUST BE 0-50');
ok := false;
end
else if numquestions > maxitems then
begin
writeln('ONLY ',maxitems,' AVAILABLE.');
ok := false;
end
else ok:=true;
until ok;
end (* getnumquestions *);
procedure ucline(var s:textline);
{ makes line upper-case }
var
k :integer;
begin
k := 1;
while s[k] <> EOS do
begin
s[k] := toupper(s[k]);
k := k + 1;
end;
end;
procedure fillarray(var quiz:quiztype;var quizitems:stringarray;
numquestions,numnouns,numnonouns,
maxitems :integer);
var
line :textline;
t,k,numfilled :integer;
endoffile :boolean;
begin
writeln;
writeln('READING DATA FILES');
numfilled := 0;
if quiz <> GENDER then
begin
t := (numquestions*numnonouns) div maxitems;
k := 0; endoffile := false;
while (t > 0) and (k < numnonouns) and (not endoffile) do
begin
if getline(line,nonounfile,MAXSTR) then
begin
k := k + 1;
if random <= (t/(numnonouns - k + 1)) then
begin
numfilled := numfilled + 1;
ucline(line);
quizitems[numfilled] := line;
write('.');
t := t - 1;
end;
end
else endoffile := true;
end;
end;
t := numquestions - numfilled;
k := 0; endoffile := false;
while (t > 0) and (k < numnouns) and (not endoffile) do
begin
if getline(line,nounfile,MAXSTR) then
begin
k := k + 1;
if random <= (t/(numnouns - k + 1)) then
begin
numfilled := numfilled + 1;
ucline(line);
quizitems[numfilled] := line;
write('.');
t := t - 1;
end;
end
else endoffile := true;
end;
writeln;
end (* fillarray *);
procedure scramble(var order:integerarray; numquestions: integer);
var k,k1,k2,temp :integer;
begin
for k:=1 to numquestions*3 do
begin
k1 := random(numquestions) + 1;
k2 := random(numquestions) + 1;
temp := order[k1]; order[k1] := order[k2]; order[k2] := temp;
end;
end;