Looking for work? Check out our jobs area.

View \HILO.PAS

BBS Onliner Interface (BOI) 1.20

Submitted By: WEBMASTER
Rating: starstarstarstarstar (Rate It)


{$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
 
corner
© 1996-2008. All rights reserved. Reproduction in whole or in part, in any form or medium without express written permission is prohibited.
Violators of this policy may be subject to legal action. Please read our Terms Of Use and Privacy Statement for more information.
Publisher: Lars Hagelin.
bootstrapLabs Logo A bootstrapLabs project.