program TriviaDoor (Input, Output, Diskfile);

uses rmdoor, crt, desqview, dos, equipment;

{$M $4000,0,0}

label 1;

{*DISPLAYCENTER*---------------------------------------------*DISPLAYCENTER*}
Procedure DisplayCenter(st_Temp : String; by_Yaxis : Byte; LN:integer);
Var
  by_OldAttr : Byte;
begin
  rmGotoXY(((Succ(Lo(WindMax)) - Length(st_Temp)) div 2), by_Yaxis);
  if LN = 1
    then rmWriteln(st_Temp)
    else rmwrite(st_Temp);
end; {DisplayCenter. }

{*PLAYGAME*-------------------------------------------------------*PLAYGAME*}

procedure playgame;
const
  filename = 'Trivia.dat';
var
  number    :integer;
  diskfile  :text;
  Counter   :integer;
  x         :string;
  answer    :integer;
  userans   :integer;
  maxline   :integer;
  numcorrect:real;
  numanswer :integer;
begin {playgame}
  rmclrscr;
  assign (diskfile, filename);
  reset (diskfile);
  readLn (diskfile, maxline);
  repeat
    rmsetcolor (green, black);
    for counter := 1 to maxline do
      begin
        readLn (diskfile, X);
        if counter = 1
          then rmsetcolor (yellow, black)
          else rmsetcolor (cyan, 0);
        rmwriteLn (x);
      end;
    readLn (diskfile, answer);
    readLn (diskfile);
    rmsetcolor (white,0);
    rmwrite('What is your answer? ');
    rmsetcolor (9,0);
    numanswer := maxline - 1;
    {$I-}
    userans := rmreadi;
    {$I+}
    while (IOResult <> 0) or (userans < 1) or (userans > numanswer) do
      begin {error}
        rmsetcolor (white,0);
        rmwrite('What is your answer? ');
        rmsetcolor (9,0);
        {$I-}
        userans := rmreadi;
        {$I+}
      end;  {error}
    if userans = answer
      then
        begin {correct answer}
          rmsetcolor (2,0);
          rmwriteLn ('Correct!!!!');
          numcorrect:=numcorrect+1;
        end  {correct answer}
      else
      begin {wrong answer}
        rmsetcolor (15,0);
        rmwriteLn ('Nope maybe you can do better next time...');
      end;  {wrong answer}
    {$I-}
    readLn (diskfile, maxline);
    {$I+}
    If IOResult <> 0
      then maxline := 0;
    rmwriteLn('');
  until Maxline = 0;
  close (diskfile);
  rmreadkey;
end;  {playgame}

procedure addtrivia;
forward;

{*MENU*---------------------------------------------------------------*MENU*}

Procedure Menu;
label 1;
var
  choice: char;
begin {menu}
  rmclrscr;
  rmsetcolor (5,0);  rmgotoxy (26,6);
  rmwriteLn('ллллллллллллллллллллллллл');
  rmsetcolor (10,0); rmgotoxy (26,7);
  rmwriteLn('л A.  Play Trivia Door  л ');
  rmsetcolor (11,0); rmgotoxy (26,8);
  rmwriteLn('л B.  View Instructions л');
  rmsetcolor (14,0);  rmgotoxy (26,9);
  rmwriteLn('л C.  Add Questions     л');
  rmsetcolor (12,0); rmgotoxy (26,10);
  rmwriteLn('л Q.  Quit              л');
  rmsetcolor (5,0);  rmgotoxy (26,11);
  rmwriteLn('ллллллллллллллллллллллллл');
1:rmsetcolor (15,3);
  rmgotoxy (20, 12);
  rmwrite ('You have ');
  rmwriteI (minutesleft);
  rmwriteLn(' minutes remaining today.');
  rmsetcolor (0, 4); rmgotoxy (29, 13);
  rmwrite ('Enter your choice:');
  choice:=rmreadkey;
  if (choice = 'a') or (choice = 'A')
    then
      begin {play the game}
        rmsetcolor (random(15)+1,0);
        rmwrite (' Play Game!');
        rmwriteLn('');
        rmsetcolor (random(15)+1,0);
        rmwriteLn ('Loading game.....');
        delay (2000);
        playgame;
      end   {play the game}
  else
  if (choice = 'b') or (choice = 'B')
    then
      begin {view the instructions}
        rmsetcolor (3,0);
        rmwriteLn (' View the instructions');
        rmsetcolor (4,0);
        rmdisplayfilelines('read.me', 12);
        menu;
      end   {view the instructions}
  else
  if (choice = 'c') or (choice = 'C')
    then
      begin {add questions}
        rmsetcolor (4,0);
        rmwriteLn (' Add Questions');
        delay (500);
        addtrivia;
      end  {addquestions}
  else
  if (choice = 'q') or (choice = 'Q')
    then
      begin {quit}
        rmsetcolor (3, 0);
        rmwriteLn (' Quit');
        halt
      end
  else goto 1;
end;  {menu}

{*ADDTRIVIA*-----------------------------------------------------*ADDTRIVIA*}
procedure addtrivia;
const
  filename = 'trivia.dat';
  max      = 30;
var
  diskfile     :text;
  loop, length :integer;
  choice       :array [1..max] of string[79];
  question     :string [80];
  answer       :integer;
begin {addtrivia}
  assign (diskfile, filename);
  append (diskfile);
  rmsetcolor (9,0);
  rmwriteLn ('What is your Question? (Max 80 Characters)');
  question := rmreadssize (79);
  rmsetcolor (0,1);
  rmwriteLn ('How many possible answers do you want? ');
  rmsetcolor (3,0);
  {$I-}
  (length) := rmreadi;
  {$I+}
  While (IOResult <> 0) or (length > Max) or (length < 2) do
    begin {error}
      rmsetcolor (15,0);
      rmwriteLn ('How many possible answers do you want? ');
      rmsetcolor (7,0);
      {$I-}
      (length) := rmreadi;
      {$I+}
    end;  {error}
  rmwriteLn ('Enter possible choices.  (Max 75 Characters)');
  for loop := 1 to length do
    begin {get data}
    rmsetcolor (9,0);
    rmwritei (loop);
    rmwrite (':');
    rmsetcolor (8,0);
    (choice[loop]) := rmreadssize (75);
    end;  {get data}
  rmwrite ('What is the correct answer? ');
  answer := rmreadi;
  loop := 0;
  writeLn (diskfile);
  writeLn (diskfile, (length+1),' (Question by: ',username,')');
  writeLn (diskfile, question);
  for loop := 1 to length do
    writeLn (diskfile, loop, '.  ',choice[loop]);
  writeLn (diskfile, answer,' (Answer)');
  close (diskfile);
  rmreadkey;
  menu;
end;  {addtrivia}

{*START*-------------------------------------------------------------*START*}

procedure start;
var
  Long1, Long2: LongInt;
  Bool1: Boolean;
begin {menu}
  rmdisplayfilelines('title.ans',22);
  rmclrscr;
  rmsetcolor (15,3);
  rmwrite('Welcome ');
  rmwrite(useralias);
  rmwrite(' to Enter at your own risk!');
  rmwriteLn('');
  rmsetcolor (random(15)+1, 0);
  rmwrite ('Tell ');
  rmwrite (sysopname);
  rmwrite (' to register or register it for them.');
  rmwriteLn('');
  rmsetcolor (9,0);
  rmwrite('Your baudrate: ');
  rmwritel(baudrate);
  rmwriteLn('');
  rmsetcolor (3, 0);
  rmwrite ('This BBS runs DOS ');
  rmwriteLnI (dosversion);
  rmWrite('Running on a ');
   Case Processor of
      0: rmWriteLn('What?');
      1: rmWriteLn('8088 or 8086');
      2: rmWriteLn('80186');
      3: rmWriteLn('80286');
      4: rmWriteLn('80386');
      5: rmWriteLn('80486');
      else rmWriteLn('Unknown');
   End;
  rmWriteLn('');
  Write('COM ports: ');
  writeLn(CommPorts);
  Write('LPT ports: ');
  write(PrtPorts);
  WriteLn('');
  if errorcorrecting
    then
      begin {errorcorrecting}
        rmsetcolor (random(15)+1, 0);
        rmwriteLn ('Error correcting modem detected!');
      end;  {errorcorrecting}
  if dv_loaded
    then
      begin {desqview?}
        dv_there;
        rmsetcolor (3,0);
        rmwrite('DesqView ');
        write(Hi(Dv_Version)+Lo(Dv_Version)/100:4:2);
        rmwrite(' detected!');
      end;  {desqview?}
  rmsetcolor (5,0);
  rmwrite ('Your security level: ');
  rmsetcolor (2,0);
  rmwritel (seclevel);
  rmwriteLn ('');
  rmsetcolor (2,0);
  rmwrite ('You have ');
  rmsetcolor (4,8);
  rmwritei (minutesleft);
  rmsetcolor (2,0);
  rmwrite (' minutes left to play today!');
  rmwriteLn('');
  rmsetcolor(random(15)+1, 0);
  rmgotoxy (23, 23);
  rmwrite ('Please press any key to continue...');
  rmreadkey;
end;  {start}

{*MAIN*===============================================================*MAIN*}

Begin {main}
randomize;
doorname := 'Trivia Test 1.00';
start;
1:menu;
goto 1;
End.  {main}