Beijing Paradise BBS Backup/PARADISE.ISO/software/BBSDOORW/RADOOR30.ZIP/REVERCE.ZIP/REVERCE.PAS

Pascal/Delphi Source File | 1994-04-12 | 19.7 KB | 646 lines

{$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S+,V-}
{$M 10000,0,0}
{╔═════════════════════════════════════════════════════════════════════════╗
 ║                                                                         ║
 ║                   (c) CopyRight LiveSystems 1990, 1994                  ║
 ║                                                                         ║
 ║ Author    : Gerhard Hoogterp                                            ║
 ║ FidoNet   : 2:282/100.5   2:283/7.33                                    ║
 ║ BitNet    : [e-mail]                                     ║
 ║                                                                         ║
 ║ SnailMail : Kremersmaten 108                                            ║
 ║             7511 LC Enschede                                            ║
 ║             The Netherlands                                             ║
 ║                                                                         ║
 ║        This module is part of the RADoor BBS doorwriters toolbox.       ║
 ║                                                                         ║
 ╚═════════════════════════════════════════════════════════════════════════╝}
Program ReverceGame;
Uses DOS,
     CRT,
     UOSys,      { UserOn Support                                }
     Online,     { Online msgs support                           }
     BBSTypes,   { Autodetect BBS Type. Default RA               }
     UserHook,   { Demo/default userhook procedures              }
     Filter,     { The default output filter                     }
     LowLevel,   { The lowlevel stuff                            }
     DoorSys,    { Misc. Door routines.                          }
     GlobInfo,   { the global record with all the nessecary info }
     RA,         { The RA init code                              }
     SuperBBS,   { The SBBS init Code                            }
     QuickBBS,   { The QBBS init code                            }
     Fossil;     { The fossil routines + Timing. This is the     }
                 {  body of the door!                            }


{----------------------------------------------------------------------------|
  The name and the version of the program together with the FossilObject
  variable which every door needs.
|----------------------------------------------------------------------------}


Const  ProgramName    = 'REVERCE';
       ProgramVersion = '1.0';
       LastUpdate     = '10 May 1992';

       HelpFileName   = 'REVERCE.HLP';
       Introfile      = 'Hi';
       FinalFile      = 'Bye';

Var Foss       : FossilObject;
    DoIt       : UserDoesObject;

{----------------------------------------------------------------------------|
 Start here your own variables, procedures and functions.
|----------------------------------------------------------------------------}

Type FieldType = Array[1..20] Of Byte;
     FameRec   = Record
                   Name  : String[35];
                   Score : LongInt;
                 End;

Var  StopGame : Boolean;
     Key      : Char;
     ErrorStr : String[40];

     PlayField : FieldType;
     HowMany   : Byte;
     LastScore : Integer;
     TotalScore: LongInt;
     Games     : Word;

{----------------------------------------------------------------------------|
 Hall of fame procedure
|----------------------------------------------------------------------------}

Var Hof     : Array[1..15] Of FameRec;
    MaxHof  : Byte;

Procedure ReadHallOfFame;
Var Inp : File;
Begin
FillChar(HOF,SizeOf(HOF),#00);

FileMode:=$42;
Assign(Inp,GlobalInfo.HomeDir+'REVERCE.HOF');
Reset(Inp,1);
If IoResult<>0
   Then Begin
        Rewrite(Inp,1);
        BlockWrite(Inp,HOF,SizeOf(HOF));
        Seek(Inp,0);
        End;
BlockRead(Inp,HOF,SizeOf(Hof));
Close(Inp);
If IoResult<>0
   Then;
End;


Procedure ShowHallOfFame(Var Foss : FossilObject);
Var Count : Byte;
Begin
With Foss Do
 Begin
 ClrScrF;
 WriteLnF('^4^!'+Center('-=( REVERCE Hall of Fame )=-')+'^0');

 WriteLnF('');
 WriteF('^1'+MakeString(80,'─'));
 WriteF('^4^!  1 '+Hof[1].Name+MakeString(60-Length(Hof[1].Name),' '));
 WriteLnF(' ^4'+SL(HOF[1].Score,10));
 WriteF('^1'+MakeString(80,'─')+'^0');

 For Count:=2 To 15 Do
  Begin
  WriteF(' ^2'+S(Count,2)+' ^3'+Hof[Count].Name+MakeString(60-Length(Hof[Count].Name),' '));
  WriteLnF(' ^2'+SL(HOF[Count].Score,10));
  End;

 For Count:=1 To GlobalInfo.ScreenLength-21 Do
   WriteLnF('');

 WriteF('^1'+MakeString(80,'─'));
 PressEnter;
 End;
End;

Function AddToHallOfFame(Name : RANameString;Score : LongInt):Boolean;
Var Count : Byte;
    Inp   : File;
Begin
AddToHallOfFame:=False;
FileMode:=$42;
Assign(Inp,GlobalInfo.HomeDir+'REVERCE.HOF');
Reset(Inp,1);
If IoResult<>0
   Then FillChar(HOF,SizeOf(Hof),#00)
   Else BlockRead(Inp,HOF,SizeOf(Hof));

Count:=1;
While (HOF[Count].Score>Score) And (Count<=15) Do
 Inc(Count);

If Count<=15
   Then Begin
        Move(HOF[COUNT],HOF[Count+1],((15-Count)-1)*SizeOf(HOF[1]));
        HOF[Count].Name:=Name;
        HOF[Count].Score:=Score;
        AddToHallOfFame:=True;
        Seek(Inp,0);
        BlockWrite(Inp,HOF,SizeOf(Hof));
        End;

Close(Inp);
If IoResult<>0
   Then { Nope.. Let's keep it simple }
End;

{----------------------------------------------------------------------------|
  Win and Lose sequences
|----------------------------------------------------------------------------}

Procedure WinSequence(Var Foss : FossilObject;Turns : Word);
Begin
With Foss Do
 Begin
 ClrScrF;
 WriteLnF('^4^!'+Center('-=( YOU HAVE WON! )=-')+'^0');

 WriteLnF('');
 WriteLnF('');
 WriteLnF('');
 WriteLnF('^0Well.. let me see..');
 WriteLnF('');
 WriteLnF('    Numbers    : ^3 '+S(HowMany,0)+'^0');
 WriteLnF('    Turns      : ^3 '+S(Turns,0)+'^0');
 WriteLnF('');
 WriteLnF('    Max score :  ^3 '+S(HowMany*10,0)+'^0');
 WriteLnF('    Minus     :  ^3 '+S(Turns*5,0)+'^0');

 LastScore:=(HowMany*10) - (Turns*5);
 WriteLnF('    Score     :  ^3 '+I(LastScore,0)+'^0');
 WriteLnF('');
 WriteLnF('^0Your previouse total was: ^3'+SL(TotalScore,0));
 WriteLnF('^0Number of Games         : ^3'+S(Games,0));
 TotalScore:=(TotalScore+LastScore);
 WriteLnF('^0Which becomes (total+Score) = ^3'+SL(TotalScore,0));
 WriteLnF('');
 If TotalScore<0
    Then WriteLn('Oh well.. keep on practicing...');
 WriteLnF('');
 PressEnter;
 End;
End;

Procedure LostSequence(Var Foss : FossilObject;Turns : Word);
Begin
With Foss Do
 Begin
 ClrScrF;
 WriteLnF('^4^!'+Center('-=( you lost.. )=-')+'^0');

 WriteLnF('');
 WriteLnF('');
 WriteLnF('');
 WriteLnF('^0Sorry, This is going to cost you points....');
 WriteLnF('');
 WriteLnF('    Max score :  ^3 '+S(HowMany*10,0)+'^0');
 LastScore:=(HowMany*5)*-1;
 WriteLnF('    Score     :  ^3 '+SL(LastScore,0)+'^0');

 WriteLnF('');
 WriteLnF('^0Your previouse total was: ^3'+SL(TotalScore,0));
 WriteLnF('^0Number of Games         : ^3'+S(Games,0));
 TotalScore:=(TotalScore+LastScore);
 WriteLnF('^0Which becomes total+Score = ^3'+SL(TotalScore,0));
 WriteLnF('');
 If TotalScore>0
    Then WriteLn('Hmm.. Still a positive score!? WOW!');
 WriteLnF('');
 PressEnter;
 End;
End;


{----------------------------------------------------------------------------|
  Play Reverce procedures
|----------------------------------------------------------------------------}


Function AskNumberToPlay:Byte;
Var NumberStr : String[2];
    Number    : Byte;
Begin
Foss.InitInputFilter(NumCharSet);

Repeat
  NumberStr:='';
  Foss.WriteF('^3  How many numbers do you like to try? (5..20): ^6');
  Foss.ReadLnF(NumberStr,2);
  Number:=Str2Nr(NumberStr);
  If Number in [0,5..20]
     Then Foss.WriteLnF('^0')
     Else Foss.WriteF(#13);

Until    Foss.Emergency
      Or (Number=0)
      Or (Number in [5..20]);

Foss.InitInputFilter(AllCharSet);
AskNumberToPlay:=Number;
End;

Function AskNumber:Byte;
Var NumberStr : String[2];
    Number    : Byte;
Begin
Foss.InitInputFilter(NumCharSet);

Repeat
  NumberStr:='';
  Foss.WriteF('^0 How many to reverce? (99 to quit): ^6');
  Foss.ReadLnF(NumberStr,2);
  Number:=Str2Nr(NumberStr);
  If (Number<>99)
     And (
             (Number=0)
          OR (Number>HowMany)
         )
     Then Foss.WriteF(#13)
     Else Foss.WriteLnF('^0');
Until    Foss.Emergency
      Or (Number=99)
      Or (    (Number>0)
          And (Number<=HowMany)
         );
Foss.InitInputFilter(AllCharSet);
AskNumber:=Number;
End;

Procedure Reverce(Var Field : FieldType; Amount : Byte);
Var TempField : FieldType;
    Count     : Byte;
Begin
TempField:=Field;
For Count:=1 To Amount Do
 Field[Count]:=TempField[Amount-Count+1];
End;

Procedure Shake(Var Field : FieldType);
Var Count : Byte;
Begin
For Count:=1 To 50 Do
 Reverce(Field,Random(HowMany)+1);
End;

Procedure ShowField(Field : FieldType);
Var Count : Byte;
Begin
Foss.WriteF('^2');
For Count:=1 To HowMany Do
 Foss.WriteF(S(Field[Count],2)+' ');
End;

Function Win(Field : FieldType):Boolean;
Var Temp : Boolean;
    Count: Byte;
Begin
Temp:=True;
Count:=0;
Repeat
  Inc(Count);
  Temp:=Field[Count]=Count;
Until (Not Temp)
   Or (Count=HowMany);
Win:=Temp;
End;


Procedure PlayReverce(Var Foss : FossilObject);
Var Count     : Byte;
    DoReverce : Byte;
    Stop      : Boolean;
    Skip      : Byte;
    Turns     : Word;
Begin
With Foss Do
 Begin
 WriteLnF('');
 WriteLnF('');
 HowMany:=AskNumberToPlay;
 If HowMany=0
    Then Exit;

 ClrScrF;
 WriteLnF('^4^!'+Center('-=( Play reverce )=-')+'^0');
 WriteLnF('');
 WriteLnF('');

 For Count:=1 To HowMany Do
  PlayField[Count]:=Count;

 Shake(PlayField);

 Skip:=(80-(HowMany*3)) Div 2;
 Turns:=0;
 Inc(Games);

 Repeat
  Case GlobalInfo.UseGraphics
    OR GlobalInfo.UseAvatar   Of
    True   : Begin
             GotoXyF(Skip,7);
             ShowField(PlayField);
             GotoXyF(1,12);
             WriteLnF('^!^0 Turn: ^3'+S(Turns+1,2));
             DoReverce:=AskNumber;
             End;
    False  : Begin
             ClrScrF;
             WriteLnF('^4^!'+Center('-=( Play reverce )=-')+'^0');
             For Count:=1 To 7 Do
             WriteLnF('');
             WriteF(MakeString(Skip,' '));
             ShowField(PlayField);
             For Count:=1 To 4 Do
                WriteLnF('');
             WriteLnF(' Turn: '+S(Turns+1,2));
             DoReverce:=AskNumber;
             End;
  End; {Case}

 Inc(Turns);
 Stop:=(DoReverce=99);
 If Not Stop
    Then Reverce(PlayField,DoReverce);
 Until Stop Or Win(PlayField) Or (Turns>(5*HowMany));

 If Not Stop
    Then Begin
         Case GlobalInfo.UseGraphics
           OR GlobalInfo.UseAvatar   Of
           True   : Begin
                    GotoXyF(Skip,7);
                    ShowField(PlayField);
                    GotoXyF(1,13);
                    WriteF('^!');
                    End;
           False  : Begin
                    ClrScrF;
                    WriteLnF('^4^!'+Center('-=( Play reverce )=-')+'^0');
                    For Count:=1 To 7 Do
                    WriteLnF('');
                    WriteF(MakeString(Skip,' '));
                    ShowField(PlayField);
                    For Count:=1 To 5 Do
                       WriteLnF('');
                    End;
         End; {Case}
         End;

 IF Win(PlayField)
    Then Begin
         Foss.PressEnter;
         WinSequence(Foss,Turns);
         End
    Else LostSequence(Foss,Turns);

 End; {With Foss}
End;

Procedure HandleMail(Var Foss : FossilObject);
Begin
With Foss Do
 Begin
 ClrScrF;
 WriteLnF('^4^!'+Center('-=( There''s mail for your )=-')+'^0');
 WriteLnF('');
 ReadMsg(Foss);
 PressEnter;
 End;
End;




{----------------------------------------------------------------------------|
 Start of main module
|----------------------------------------------------------------------------}
Begin

WriteLn(ProgramName,' ',ProgramVersion,' (c) LiveSystems 1990,1991   ALL RIGHTS RESERVED,  NO GUARANTEES');
WriteLn('Written by G.Hoogterp. E-mail address 2:283/1.2 Last Revision '+LastUpdate);
WriteLn('Use Reverce -? to see commandline parameter summary.');

If ExistParameter('?')
   Then Begin
        WriteLn('Usage: ');
        WriteLn;
        WriteLn(' REVERCE.EXE [-T:<TimeLimit>] [-N:*N] [-P:*P] [-NOS]');
        WriteLn;
        WriteLn(' -T:     Limit the time available in the door.');
        WriteLn(' -N:     Give nodenumber for multiline setups.');
        WriteLn(' -P:     Give ComPort to use.');
        WriteLn(' -NOS    Turn local sounds OFF for default.');
        Halt;
        End;

{ The parameters mentioned here are read in the RA.PAS unit as they are more
  or less RA dependend and the result has to be stuffed into the global info
  record. }

{----------------------------------------------------------------------------|
 Grab the BBS specific stuff into the GlobalInfo record
|----------------------------------------------------------------------------}

Case CurrentBBStype Of
 RA_BBS : InitRA;
 S_BBS  : InitSBBS;
 Q_BBS  : InitQBBS;
End;

{----------------------------------------------------------------------------|
 And let the LOGfile know who's talking.
|----------------------------------------------------------------------------}

LogIt('Started: '+ProgramName+' '+ProgramVersion+' under '+GlobalInfo.BBSName);

{----------------------------------------------------------------------------|
  Initialize the userhooks, Timeout detection etc.
|----------------------------------------------------------------------------}

With GlobalInfo Do
 Begin
 Foss.AssignF(ComPort-1,BaudRate);   { Inti the fossil }
 If Foss.Error<>0
    Then Begin
         WriteLn(#254' Couldn''t initialize fossil!');
         LogIt('Couldn''t init fossil!');
         Halt;
         End;

 Foss.InitTimer(    { Init the timeout procedures              }
                3,  { Warning before pushed back to the BBS    }
                3   { Timeout time before and between warnings }
                );


 Foss.InitOutputFilter(UsedFilter); { Set the output filter            }
 Foss.InitInputFilter(AllCharSet);  { Set the input filter for ReadLnF }

 Foss.InitSysopKeys(SysopKeys);     { Set the SYSOP keys procedure     }
 Foss.InitStatLine(StatusLine);     { Set the statusline procedure     }

 { Initialize the output filter using the info in the GlobalInfo record}

 InitUsedFilter(UseGraphics,UseAVATAR,LeftBracket,RightBracket,'^');
 End;


{ Initialize the colortable, I only use these colors in ALL my programs}

ColorTable[0]:=LightCyan;           { Normal text color            }
ColorTable[1]:=LightRed;            { Hotkey's                     }
ColorTable[2]:=White;               { Userinput and info highlight }
ColorTable[3]:=Yellow;              { Info                         }
ColorTable[4]:=(Blue Shl 4)+White;  { Statusline color             }
ColorTable[5]:=LightRed;            { Frames and lines             }
ColorTable[6]:=(Red Shl 4)+White;   { Input fields                 }


{ and init the strings in the FOSSIL.PAS unit }

PressEnterOrStopString := '^0Press ^[^1ENTER^0^] to continue, ^[^1S^0^] to Stop: ^2';
PressEnterString       := '^0Press ^[^1ENTER^0^] to continue: ^2';
Warning1String         := '^1^[^2 You have only 2 minutes left!^1^]^2';
Warning2String         := '^1^[^2 You have only 1 minute left! ^1^]^2';
AttentionString        := 'HELLO???';
LockOutString          := '^1--- You''ve been locked out of the system! Don''t call back..';
HangUpString           := '^1--- The Sysop hungup the phone, call back an other time.';
TimeUpString           := '^1Sorry, you reached your daily timelimit. Hope to see you back an other time.';
UsedStopKey            := 'S';


{----------------------------------------------------------------------------|
  The mainbody of the DOOR goes here.
|----------------------------------------------------------------------------}

Randomize;
StopGame:=False;
TotalScore:=0;
LastScore:=0;
Games:=0;

{ UserOn support }

DoIt.Init('Is playing LiveSystems REVERCE.');
DoIt.Setit;

{ Read the hall of fame }
ReadHallOfFame;


{ Start the main menu }

ErrorStr:='';

With Foss Do
 Begin
 Repeat
   If ChkForMsg                { Check for online message }
      Then HandleMail(Foss);

   ClrScrF;
   WriteLnF('^4^!'+Center('-=( LiveSystems '+ProgramName+' '+ProgramVersion+' )=-'));
   WriteLnF('^!'+Center('-=( Running at '+GlobalInfo.Systemname+' Node '+S(GlobalInfo.Node,0)+' )=-')+'^0');
   WriteLnF('');

   If     (Games>0)
      And (ErrorStr='')
      Then WriteLnF('^3'+Center('--- Your score today: '+SL(TotalScore,0)+' ---')+'^0')
      Else Begin
           If ErrorStr<>''
              Then WriteLnF('^1'+Center(ErrorStr)+'^0')
              Else WriteLnF('');
           ErrorStr:='';
           End;

   WriteLnF('');
   WriteLnF('');
   WriteLnF('                          ^0^[^1F^0^] see the hall of Fame');
   WriteLnF('                          ^0^[^1P^0^] Play the game');
   WriteLnF('                          ^0^[^1H^0^] Help');
   WriteLnF('                          ^0^[^1Q^0^] Quit back to BBS');
   WriteLnF('');
   WriteLnF('');
     WriteF('  ^0Your choice: ^6');
   Key:=Upcase(AskKey('FPHQ'#13,'Q'));
   WriteLnF('^0');

   Case Key Of
    'H'   : Begin { Help }
            ClrScrF;
            If ExistFile(GlobalInfo.HomeDir+HelpFileName)
               Then ShowHelpFile(Foss,GlobalInfo.HomeDir+HelpFileName,
                             '^4^!'+Center('-=( REVERCE help )=-')+'^0')
               Else ErrorStr:='-- Sorry, no help available ---';
            End;

    'P'   : Begin { Play }
            PlayReverce(Foss);
            If Games>=1
               Then DoIt.ResetIt('Is playing LiveSystems REVERCE. (Score: '+SL(TotalScore,0)+')');
            End;

    'Q'   : Begin { Quit }
            If (Games>0) And AddToHallOfFame(GlobalInfo.UserName,TotalScore)
               Then ShowHallOfFame(Foss);
            StopGame:=True;
            End;

    'F'   : ShowHallOfFame(Foss);
   End; {Case}
 Until StopGame;
 End; {With Foss}

{----------------------------------------------------------------------------|
  Finalize the DOOR and say a nice thank you to the user for spending his
  online time and money on your door..
|----------------------------------------------------------------------------}

Case CurrentBBSType Of
 RA_BBS : If Not RAUpdateExitInfo
             Then LogIt('Couldn''t update the EXITINFO.BBS!');
 S_BBS  : If Not SBBSUpdateExitInfo
             Then LogIt('Couldn''t update the EXITINFO.BBS!');
 Q_BBS  : If Not QBBSUpdateExitInfo
             Then LogIt('Couldn''t update the EXITINFO.BBS!');
End;

Foss.ClrScrF;  { Clear the screen }
Foss.WriteLnF('^2Thanks for using LiveSystems '+ProgramName+' '+ProgramVersion+'.');
DoIt.ClearIt;
Delay(1000);

{----------------------------------------------------------------------------|
  Tell the LogFile that we're finished. Gives the fossil some extra time
  to get the ThankYou out of it's mouth....
|----------------------------------------------------------------------------}

LogIt('Stopped: '+ProgramName+' '+ProgramVersion);

{----------------------------------------------------------------------------|
 And close the fossil again..
|----------------------------------------------------------------------------}

Foss.CloseF;
End.

{----------------------------------------------------------------------------|
   And that's it! That's all.. I can't make things simpler..
   Oh well, actualy I could, but not without giving up flexability and
   usability.....
|----------------------------------------------------------------------------}