program trainer;





procedure lock;

var unlock: boolean;

    key: string[9];

begin

unlock := false;

repeat;

clrscr;

writeln('TRAINER - First question, who wrote this program?');

readln(key);

if (key = 'DEADLINER') or (key = 'Deadliner') or (key = 'deadliner') then

  unlock := true;

until unlock;

end;



procedure pause;

begin;

writeln;

writeln;

write('Please <Enter> when you are ready to continue...');

readln;

end;



procedure add;

var category,

    addfile: text;

    available: string[70];

    fileout: string[8];

    dummy: char;

    count,

    choice,

    loop,

    quitcount: integer;

    quitone: boolean;

    question,

    answer: string[79];

begin;

clrscr;

assign(category,'category.tra');

reset(category);

count := 0;

repeat

count := count + 1;

readln(category,available);

readln(category,dummy);

writeln(count,':  ',available);

until eof(category);

writeln;

repeat

writeln('Please enter the number of your selection.');

readln(choice);

until choice in [1..count];

close(category);

assign(category,'category.tra');

reset(category);

for loop := 1 to choice do

 begin

 readln(category, dummy);

 readln(category, fileout);

 end;

close(category);

assign(addfile,fileout+'.tra');

append(addfile);

repeat

clrscr;

writeln('Please enter a question to be added.');

writeln('<Enter> after each line, <Enter> on a blank line to end.');

writeln('(Do not go past the edge of the screen without <Enter>ing.)');

writeln('<Enter> on the first blank line to quit adding questions.');

writeln;

quitone := false;

quitcount := 0;

repeat

quitcount := quitcount + 1;

readln(question);

if (quitcount = 1) and (question = '') then quitone := true;

if not(question = '') then writeln(addfile, question);

until question = '';

writeln(addfile,'*');

if (quitone = false) then

 begin

 writeln('Please enter the answer.');

 writeln('<Enter> after each line, <Enter> on a blank line to end.');

 writeln('(Do not go past the edge of the screen without <Enter>ing.)');

 writeln;

 repeat

 readln(answer);

 if not(answer = '') then writeln(addfile, answer);

 until answer = '';

 writeln(addfile,'**');

 end;

until quitone;

close(addfile);

end;



procedure new;

var check: char;

    namein: string[70];

    nameout: string[8];

    category,

    newfile: text;

begin;

repeat;

clrscr;

writeln('This option makes a new category by writing a new file to the disk.');

writeln('You will need to enter a new file name for your category.');

writeln('It is important that the file does not already exist.');

writeln('Do you know for sure that the file name you have in mind does not');

writeln('already exist on the disk?');

readln(check);

until upcase(check) in ['Y','N'];

if upcase(check) = 'N' then

 begin

 writeln('Please quit the program and list your directory to see if the');

 writeln('file already exists or not.');

 pause;

 end

else

begin

writeln('Please enter the name to go on disk (8 letters max, no extension).');

readln(nameout);

writeln('Please enter the category name.');

readln(namein);

assign(category, 'category.tra');

append(category);

writeln(category, namein);

writeln(category, nameout);

close(category);

assign(newfile, nameout+'.tra');

rewrite(newfile);

writeln(newfile);

close(newfile);

writeln;

writeln('Please choose the "1) Add questions to category" option to');

writeln('fill your new category.');

pause;

end;

end;



procedure setup;

var goforit: char;

    category,

    trainfile: text;

begin;

repeat

clrscr;

writeln('This option writes a new "category.tra" file to the disk.');

writeln('If you already have a "category.tra" file on the disk and you');

writeln('use this function, you will wipe out your current list of');

writeln('available categories.');

writeln('This option also creates the category TRAINER as the first');

writeln('category to go on "category.tra".');

writeln;

writeln('Do you want to continue with the setup?');

readln(goforit);

until upcase(goforit) in ['Y','N'];

if upcase(goforit) = 'Y' then

 begin

 assign(category,'category.tra');

 rewrite(category);

 writeln(category,'TRAINER');

 writeln(category,'trainer');

 close(category);

 assign(trainfile,'trainer.tra');

 rewrite(trainfile);

 writeln(trainfile,'What do you need to know about Trainer?');

 writeln(trainfile,'*');

 writeln(trainfile,'You need to know that it works best in the A drive.');

 writeln(trainfile,'**');

 close(trainfile);

 end;

end;





procedure train;

var count,

    choice,

    loop,

    numquest,

    usedcount,

    luckyint,

    usedint: integer;

    usedstr: string[255];

    category,

    trainfile: text;

    available: string[70];

    question,

    answer: string[79];

    asterik,

    usedstrpart: string[2];

    dummy: char;

    fileout: string[8];

    usedboo: boolean;

begin;

clrscr;

assign(category,'category.tra');

reset(category);

count := 0;

repeat

count := count + 1;

readln(category,available);

readln(category,dummy);

writeln(count,':  ',available);

until eof(category);

writeln;

repeat

writeln('Please enter the number of your selection.');

readln(choice);

until choice in [1..count];

close(category);

assign(category,'category.tra');

reset(category);

for loop := 1 to choice do

 begin

 readln(category, dummy);

 readln(category, fileout);

 end;

close(category);

assign(trainfile,fileout+'.tra');

reset(trainfile);

numquest := 0;

repeat

readln(trainfile,asterik);

if asterik = '**' then numquest := numquest + 1;

until eof(trainfile);

usedcount := 0;

usedstr := '';

repeat

usedboo := false;

repeat

randomize;

luckyint := random(numquest) +1;

str(luckyint,usedstrpart);

usedint := pos(usedstrpart+'*',usedstr);

if usedint = 0 then usedboo := true;

until usedboo;

usedcount := usedcount + 1;

usedstr := usedstr + usedstrpart + '*';

reset(trainfile);

if luckyint <> 1 then for loop := 1 to luckyint-1 do

 begin

 repeat

 readln(trainfile, asterik);

 until asterik = '**';

 end;

clrscr;

repeat

readln(trainfile,question);

if question <> '*' then writeln(question);

until question = '*';

writeln;

writeln('What is your answer?');

readln;

repeat

readln(trainfile,answer);

if answer <> '**' then writeln(answer);

until answer = '**';

pause;

until usedcount = numquest;

end;



procedure menu;

var option: integer;

    quit: boolean;

begin

quit := false;

repeat

repeat

clrscr;

writeln('1) Add question to category');

writeln('2) Make new category');

writeln('3) Set up category file');

writeln('4) Train');

writeln('5) Quit');

writeln;

readln(option);

until option in [1..5];

case option of

 1: Add;

 2: New;

 3: Setup;

 4: Train;

 5: quit := true;

end;

until quit;

end;





begin (* main *)

lock;

menu;

end. (* main *)