Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/BOI120.ZIP/HILO.PAS

Pascal/Delphi Source File | 1990-12-12 | 7.1 KB | 248 lines

{$D-}
{$S-}
{$V-}

program HiLo;
{ Copyright (C) 1990 Andrew J. Mead
  All Rights Reserved.
  Contact POB 1155 Chapel Hill, NC 27514-1155 }

{ Version 0.1  beta dated 12/12/90 using BBS Onliner Interface 1.20
  Version 1.07 12/11/90 BOI 1.20

}

Uses
  dos,
  boidecl,
  getcmbbs,
  iolib,
  support;

Const
  version    = '1.00';
  regnum     = '';
  regstr     = 'Unregistered Version';
  registered = false;

{  registered users
}

Const
  hoffile    = 'Hilohof.dat';

Var
  hilonum    : word;        {  computer's number  }

  gotit      : boolean;     {  player success indicator  }
  quit       : boolean;     {  player quit indicator     }
  inchar     : char;        {  standard input variable   }

Procedure GETINSTRUCTIONS;
  begin {* GetInstructions *}
    PortWindow(1,1,80,pagelength);
    ClrPortScr;
    PortColor(yellow,white);
    SendString('HI-LO',false);
    PortColor(cyan,lightgray);
    SendString('',true);
    SendString('The object of Hi-Lo is to guess the correct number in as few as a turns as',true);
    SendString('necessary.  The computer has chosen a number from 1 to 1024.  After each',true);
    SendString('guess, you''ll be told whether the guess was correct, too high, or too low.',true);

    SendString('The other commands are ''Q'' to quit the game,''I'' to review these',true);
    SendString('instructions, or ''T'' to check time remaining (if it is available.',true);
    SendString('',true);
    PortColor(yellow,white);
    SendString('',true);
    SendString('Press almost any key to continue game.',false);
    ClearBuffers;
    inchar := ReadPortKey
  end;  {* GetInstructions *}

Procedure INITIALIZE;
  begin {* Initialize *}
    randomize;
    hilonum := random(1024) + 1;
    quit := false;
    playerpoints := 0;
    gotit := false
  end;  {* Initialize *}

Procedure PLAYGAME;
  var
    moved : boolean;
    linein : string;

  Procedure SHOWSCREEN;
    begin {* PlayGame,ShowScreen *}
      PortWindow(1,1,80,pagelength);
      ClrPortScr;
      PortColor(cyan,lightgray);
      SendString('Hi-Lo Guessing Game',false);
      GotoPortXY(1,18);
      TextPortColor(lightgray);
      SendString('Hi-Lo options: ',false);
      LineWrite('[I]nstructions   ',true);
      LineWrite('[T]ime   ',usetime);
      LineWrite('[Q]uit',true)
    end;  {* PlayGame,ShowScreen *}

  Procedure WRITELINE;
    begin {* PlayGame,WriteLine *}
      ClrPortScr;
      TextPortColor(lightgray);
      if usetime then
        begin
          If LeftTime <= 0 then
            begin
              SendString('Your time limit has expired.  Game is being exited.',true);
              timexp := true;
              exit
            end
          else if LeftTime < 4 then SendString(#7 + 'You have less than ' +
              IntStr(LeftTime,0) + ' minutes left.',true)
        end;
      SendString('You have made '+ IntStr(playerpoints,0) + ' guesses. ',true);
      PortColor(yellow,lightgray);
      SendString('Enter your guess: ',false)
    end;  {* PlayGame,WriteLine *}

  Procedure GETINPUT;
    begin {* PlayGame,GetInput *}
      repeat
        begin
          inchar := ReadPortKey;
          if not (upcase(inchar) in ['1'..'9','Q','I','T']) then
              SendString(#7,false)
        end
      until upcase(inchar) in ['1'..'9','Q','I','T'];
      TextPortColor(white);
      case upcase(inchar) of
          'Q' :
            begin
              SendString('Quit',true);
              SendString('Do you really want to quit? [Y/N] ',false);
              repeat inchar := upcase(ReadPortKey) until inchar in ['Y','N'];
              if inchar = 'Y' then
                begin
                  quit := true;
                  SendString('Yes',true)
                end
              else SendString('No',false)
            end;
          'I' :
            begin
              GetInstructions;
              ShowScreen;
              PortWindow(1,20,80,pagelength)
            end;
          'T' :
            begin
              PortWindow(1,20,80,pagelength);
              ClrPortScr;
              GotoPortXY(1,1);
              if usetime then SendString('You have less than ' +
                  IntStr(LeftTime,0) + ' minutes remaining.',false)
              else SendString('This function is not operational.',false);
              GotoPortXY(1,2);
              SendString('Press almost any key to continue. ',false);
              ClearBuffers;
              inchar := ReadPortKey;
              ClrPortScr
            end
          else
            begin
              SendString(inchar,false);
              GetString(linein);
              linein := inchar + linein;
              moved := true
            end
        end
    end;  {* PlayGame,GetInput *}

  Procedure PROCESSGUESS;
    var
      guessamount : word;
      dummy       : word;

    begin {* PlayGame,ProcessGuess *}
      Val(linein,guessamount,dummy);
      PortWindow(1,1,80,pagelength);
      if (dummy = 0) and (guessamount > 0) and (guessamount < 1024) then
        begin
          Inc(playerpoints);
          GotoPortXY(1,12);
          ClrPortEOL;
          if guessamount = hilonum then
            begin
              PortColor(lightred + blink,white + blink);
              SendString('Congratulations!!!',false);
              PortColor(lightgreen,white);
              SendString('  You''ve Done It!!!',false);
              gotit := true
            end
          else
            begin
              TextPortColor(lightgray);
              SendString('Your guess is ',false);
              if guessamount < hilonum then
                begin
                  PortColor(lightblue,lightgray);
                  SendString('Too Low',false)
                end
              else
                begin
                  PortColor(yellow,lightgray);
                  SendString('Too High',false)
                end
            end
        end
      else SendString(#7#7#7,false)
    end;  {* PlayGame,ProcessGuess *}

  begin {* PlayGame *}
    ShowScreen;
    repeat
      begin
        PortWindow(1,20,80,pagelength);
        moved := false;
        repeat
          begin
            WriteLine;
            if not timexp then GetInput
          end
        until moved or quit or timexp;
        if not (quit or timexp) then ProcessGuess
      end;
    until quit or gotit or timexp;
    PortWindow(1,20,80,pagelength);
    ClrPortScr;
    TextPortColor(lightgray)
  end;  {* PlayGame *}

begin
  GetCommand('BBSNOTES.DOC','HiLoHOF.Txt','HiLoErr.Log','Hi-Lo',version,[]);
  SetPort;
  If pagelength < 23 then AbortGame(23);
  QueryUser;
  if WriteCopy('HiLo',version,regnum,regstr,'',registered,false,true) then GetInstructions;
  repeat
    begin
      Initialize;
      PlayGame;
      EndGame('HiLo','Guessers',regstr,hoffile,registered,gotit,false,false)
    end
  until not doagain;
  EndPort
end.

Copyright (C) 1990 Andrew J. Mead
All Rights Reserved.

For further information, contact:
The Mad Programmer
Andrew J. Mead
POB 1155
Chapel Hill, NC 27514-1155