Unit DMAid_U;



interface

{***************************************************************************}

{***************************************************************************}

Uses

  DMAid_G;



Procedure Border;

Function  CheckFreq: boolean;

Procedure HaltProg;

Procedure InitFreq;

Procedure MainLoop;

Procedure Menu;

Procedure ModeFlip(NewMode: ModeType);

Function  ModeInput(InChar: char): boolean;

Procedure RollDiceWin;

Procedure SetFreq;

Procedure SetUpScreen;

Procedure ShowFreq;

Procedure ShowTime;

Procedure StartUp;

Procedure TimeDec(NumSecs: longint);

Procedure TimeInc(NumSecs: longint);

Procedure TimeReal;



implementation

{***************************************************************************}

{***************************************************************************}



uses

  Crt,

  Dos,

  Globals,

  PC,

  Monsters,

  Subprogs;



Procedure Border;

{***************************************************************************}

var

  y: integer;

begin

  BorderTop(3);

  for y := 4 to 23 do

    begin

      GotoXY(1, y);

      write(DoubleVertical);

      GotoXY(80, y);

      write(DoubleVertical);

    end;

  BorderBottom(24);

  BorderConnectHorizontal(11, 1, 80);

  BorderConnectHorizontal(21, 1, 80);

  BorderConnectVertical(31, 3, 11);

  BorderConnectVertical(53, 3, 11);

  BorderConnectHorizontal(6, 31, 53);

end;



Function CheckFreq: boolean;

{***************************************************************************}

begin

  CheckFreq := DiceRoll(1, Die, 0) <= Chance;

end;



Procedure HaltProg;

{***************************************************************************}

begin

  GotoXY(24, 80);

  halt;

end;



Procedure InitFreq;

{***************************************************************************}

begin

  Chance := 1;

  Die := 6;

  Ink := 3;

  TimeUnit := 'Turn';

  TimeInk := Ink*600;

end;



Procedure MainLoop;

{***************************************************************************}

var

  InChar: char;

  NewSec: word;

begin

  GetTime(DumWord, DumWord, NewSec, DumWord);

  if NewSec <> OldSec then

    begin

      OldSec := NewSec;

      if RealTime then

        TimeInc(1);

      TimeReal;

    end;

  if not(keypressed) then

    exit;

  InChar := readkey;

  if ModeInput(InChar) then

    exit;

  case InChar of

    Esc: Menu;

    ' ': RollDiceWin;

    '+': TimeInc(1);

    '-': TimeDec(1);

    #0 :

      begin

        InChar := readkey;

        case InChar of

          AltC: RealTime := not(RealTime);

          AltM: ModeFlip(ModeMonster);

          AltP: ModeFlip(ModePC);

          AltQ: HaltProg;

          F1: TimeInc(6);

          F2: SetFreq;

          F3: TimeInc(60);

          F5: TimeInc(600);

          F7: TimeInc(3600);

          F9: TimeInc(86400);

          ShF1: TimeDec(6);

          ShF3: TimeDec(60);

          ShF5: TimeDec(600);

          ShF7: TimeDec(3600);

          ShF9: TimeDec(86400);

          else

            write(#7);

        end; {case}

      end;

    else

      write(#7);

  end; {case}

end;



Procedure Menu;

{***************************************************************************}

begin

  WinIn(WinMenu);

  ReverseVideo;

  write('Monsters');

  NormVideo;

  WinOut(WinMenu);

end;



Procedure ModeFlip(NewMode: ModeType);

{***************************************************************************}

begin

  Mode := NewMode;

  case Mode of

    ModeMonster:  MonsterMenu;

    ModePC:       PCMenu;

  end; {case}

end;



Function ModeInput(InChar: char): boolean;

{***************************************************************************}

var

  Temp: boolean;

begin

  Temp := false;

  case Mode of

    ModeMonster:  Temp := MonsterInput(InChar);

    ModePC:       Temp := PCInput(InChar);

  end;

  ModeInput := Temp;

end;



Procedure RollDiceWin;

{***************************************************************************}

begin

  WinIn(WinRoll);

  randomize;

  if WinRoll[5] <> 1 then

    writeln;

  write(random(4)+1:2,

          random(6)+1:3,

          random(8)+1:3,

          random(10)+1:4,

          random(12)+1:4,

          random(20)+1:4,

          random(100)+1:5);

  WinOut(WinRoll);

end;



Procedure SetFreq;

{***************************************************************************}

begin

  WinIn(WinFreq);

  Chance := AskIntDef('Please enter initial chance', 0, MaxInt, Chance);

  Die := AskIntDef('Please enter die to use', Chance, MaxInt, Die);

  Ink := AskIntDef('Please enter the frequency to check', 1, MaxInt, Ink);

  WinOut(WinFreq);

  TimeInk := Ink*600;

  ShowFreq;

end;



Procedure SetUpScreen;

{***************************************************************************}

begin

  clrscr;

  Writeln('Dungeon Master Aid (DMAID) for use with Advanced Dungeons and Dragons');

  writeln('A Deadliner Cognomen Product.  Copyright 1990, 1991.');

  Border;

  WinFreq := WinFreqInit;

  WinRoll := WinRollInit;

  WinIn(WinRoll);

  writeln('Spacebar rolls the dice.');

  writeln('D4 D6 D8 D10 D12 D20 D100');

  WinRoll[2] := WinRoll[2] + 2;

  GotoXY(1, 1);

  WinOut(WinRoll);

  WinTime := WinTimeInit;

  WinRealTime := WinRealTimeInit;

  ShowTime;

  RollDiceWin;

  ShowFreq;

  WinMenu := WinMenuInit;

  WinIn(WinMenu);

  writeln('Monsters (Alt-M)   PCs/NPCs (Alt-P)   Quit (Alt-Q)');

  write('ESCAPE to enter/exit Menu Box.  Use ',ArrowLeft,', ',ArrowRight,

    ', first letter, and ENTER to select.');

  WinOut(WinMenu);

  WinMenu[4] := 22;

  WinMon := WinMonInit;

end;



Procedure ShowFreq;

{***************************************************************************}

begin

  WinIn(WinFreq);

  Clr;

  writeln('(F2) Encounters');

  writeln(Chance,' in ',Die,' every ',Ink, ' ',TimeUnit,'(s).');

  WinOut(WinFreq);

end;



Procedure ShowTime;

{***************************************************************************}

var

  Day,

  Hour,

  Turn,

  Minute,

  Round,

  Segment,

  Sec,

  Second: longint;

begin

  TimeSecSplit(Time_G, Day, Hour, Minute, Second);

  Turn := Minute div 10;

  Round := Minute mod 10;

  Segment := Second div 6;

  Sec := Second mod 6;

  WinIn(WinTime);

  Clr;

  writeln('(F9/Shift-F9) Day    : ',Day);

  writeln('(F7/Shift-F7) Hour   : ',Hour);

  writeln('(F5/Shift-F5) Turn   : ',Turn);

  writeln('(F3/Shift-F3) Round  : ',Round);

  writeln('(F1/Shift-F1) Segment: ',Segment);

  writeln('(+/-)         Second : ',Sec);

  write('Day: ', Day,

        '  Time: ',StrIntZer(Hour,2),

        ':',       StrIntZer(Minute,2),

        ':',       StrIntZer(Second,2));

  WinOut(WinTime);

end;



Procedure StartUp;

{***************************************************************************}

begin

  OldSec := 0;

  Time_G := 0;

  LastCheck := 0;

  RealTime := false;

  ModeFlip(ModeMonster);

  InitFreq;

  SetUpScreen;

  repeat

    MainLoop;

  until false;

end;



Procedure TimeDec(NumSecs: longint);

{***************************************************************************}

begin

  Dec(Time_G, NumSecs);

  if Time_G <= -86400*10000 then

    begin

      WinIn(WinFreq);

      writeln('Time flipped at -10000 days!');

      WinOut(WinFreq);

      Time_G := Time_G + 86400*10000;

      write(#7);

    end;

  LastCheck := Time_G;

  ShowTime;

end;



Procedure TimeInc(NumSecs: longint);

{***************************************************************************}

var

  NewTime: longint;

begin

  NewTime := Time_G + NumSecs;

  if NewTime >= 86400*10000 then

    begin

      WinIn(WinFreq);

      writeln('Time flipped at 10000 days!');

      WinOut(WinFreq);

      NewTime := NewTime - 86400*10000;

      LastCheck := LastCheck - 86400*10000;

      write(#7);

    end;

  if Chance = 0 then

    begin

      Time_G := NewTime;

      ShowTime;

      exit;

    end;

  while LastCheck + TimeInk <= NewTime do

    begin

      LastCheck := LastCheck + TimeInk;

      Time_G := LastCheck;

      ShowTime;

      if CheckFreq then

        begin

          WinIn(WinFreq);

          Writeln(Beep+'Encounter!');

          write('Press S to stop or any other key to continue...');

          if keypressed then

            DumChar := readkey;

          if upcase(readkey) = 'S' then

            NewTime := LastCheck;

          WinOut(WinFreq);

          ShowFreq;

        end;

    end;

  Time_G := NewTime;

  ShowTime;

end;



Procedure TimeReal;

{***************************************************************************}

var

  Hour,

  Min,

  Sec: word;

begin

  GetTime(Hour, Min, Sec, DumWord);

  WinIn(WinRealTime);

  Clr;

  writeln('Real Time ALT-C');

  write('   ',StrIntZer(Hour, 2),':',StrIntZer(Min,2),':',StrIntZer(Sec,2));

  WinOut(WinRealTime);

end;



{***************************************************************************}

{***************************************************************************}

{***************************************************************************}

begin

end.