[Back to MISC SWAG index] [Back to Main SWAG index] [Original]

    {$IFDEF DEBUG}
    {$A+,B-,D+,F-,G-,I-,K-,L-,N-,E-,P-,Q+,R+,S+,T-,V-,W+,X+,Y-}
    {$ELSE}
    {$A+,B-,D-,F-,G-,I-,K-,L-,N-,E-,P-,Q-,R-,S-,T-,V-,W+,X+,Y-}
    {$ENDIf}

    {************************************************}
    {                                                }
    {   SNAiL ViSiON Demo  v1.00.00                  }
    {   Strange Logic Software <=> Brad Zavitsky     }
    {   All Rights Reserved (1995)                   }
    {                                                }
    {************************************************}

    {
     | NOTES:
     \-------

      There are no known bugs.

      Some people have been wondering about computer games so-called AI,
      this is a demo of PAI (Psuedo Artificial Inteligence <g>)

      Sorry, no graphics :-), this is just ascii.

      I have made most of the games settings constants for changing various
      things around.

      If compiling in G+ mode, change COMPSPEED accordingly the enemies
      go MUCH faster.

      This will even work on a 8088 in REAL TIME! It has been pretty optimized
      for speed and size, notice, it does not use any units, cut back in a
      ton of linking.

      SWAG use it allowed (that is really the goal)

    VERSIONS --
       1.00.00 : First public release. Since I first posted this in the
                 PASCAL LESSONS confrence I have made MANY changes to make
                 it more of a game/run faster/ and have more configurable
                 settings.  Est.. *OPERATING Speed is 200%-500% faster.

      * I do have a delay which slows things down to regulate speeds.

    }

    Program Snaildemo;
    {$M $400,0,0}

    Const
     Top       = 3;  {Specs of your screen -2/+2}
     Bottom    = 22; {""}
     RtSide    = 77; {""}
     LftSide   = 3;  {""}

     Version        : string[7] = '1.00.00';
     CompSpeed      : word = 6; {Higher = easier|Even = Easier}
     MaxEnemy              = 68;  {Should greater or equal to NumEnemy}
     NumEnemy       : word = 30;  {Number of enemies}
     AI             : Byte = 60; {random move chance}
     Rep            : Byte = 3;  {Energy replenish}
     JumpChance     : Byte = 90; {chance to make a jump}
     BadScore       : Integer = -5;  {Happens when a jump is failed}
     BadEnergy      : Integer = -75; {Happens after a jump is failed}
     MaxEnergy      : Word = 5000; {Max amount of energy}
     MaxScore       : Word = 65500;
     Drain          : Word = 2;    {Amount drained per keypress}
     StartingEnergy : Word = 200;  {Amount of starting energy}
     Scost          : Word = 2; {Shield Usage Cost, if half}
                                {then energy wont go down unless moving}
     SNeed          : Word = 10; {Energy needed mantain shields}
     StatUpDate     : Byte = 5; {When to update stats}
     ENeed          : Word = 2; {Energy needed to move}
     JNeed          : Word = 100; {Energy needed for hyper jump}
     SnailMan   : Char = '@'; {Our hero}
     Langolier  : Char = '#'; {Bad Guys}
     SoundOn    : Boolean = True; {Turn this off if you don't like noise}

    Type
         {Directions used by MOVE}
         Dirtype = (North, East, West, South);

         {These are actually player/enemy records, you could probally
         add such things as hitpoints pretty easily}
         CursorRec = Record
                     X,Y:Byte;
                     End;

        { All the possible enemies, I have personally gone up
          to 1000 w/out changing memory! }
         AllEnemy = array[1..MaxEnemy] of CursorRec;

    Var
        Dead   : Boolean; {Gee...what could this mean}
        Round, {Used to regulate stats updates}
        Turn   : Byte; {This regulates enemy movement}
        Temp   : AllEnemy; {BadGuy location, just what snailman needs to avoid}
        Loc    : CursorRec; {Snailmans Location}
        I      : Integer; {All purpose integer}
        Len    : Byte; {Stores length of previous string for status line}
        Score, { player score}
        Energy : integer; {players current energy}
        OneMs  : Word; {Used by delays, DO NOT TOUCH <g>}
        Ch     : Char; {IO char}
        ShieldOn : Boolean; {True if shields are on}
        PlayAnother : Boolean; {Play another game?}

    Procedure CB;Inline($CD/$33); {Simulate a ^C}

    Procedure DelayOneMS; assembler; {Better delay for 1ms}
      asm
         PUSH CX         { Save CX }
         MOV  CX, OneMS  { Loop count into CX }
      @1:
         LOOP @1         { Wait one millisecond }
         POP  CX         { Restore CX }
      end;

    Procedure Delay(ms:Word); assembler; {better delay}
      asm
         MOV  CX, ms
         JCXZ @2
      @1:
         CALL DelayOneMS
         LOOP @1
      @2:
      end;

    Procedure Calibrate_Delay; assembler; {makes delay accurate}
      asm
         MOV  AX,40h
         MOV  ES,AX
         MOV  DI,6Ch          { ES:DI is the low word of BIOS timer count }
         MOV  OneMS,55        { Initial value for One MS's time }
         XOR  DX,DX           { DX = 0 }
         MOV  AX,ES:[DI]      { AX = low word of timer }
      @1:
         CMP  AX,ES:[DI]      { Keep looking at low word of timer }
         JE   @1              { until its value changes... }
         MOV  AX,ES:[DI]      { ...then save it }
      @2:
         CAll DelayOneMs      { Delay for a count of OneMS (55) }
         INC  DX              { Increment loop counter }
         CMP  AX,ES:[DI]      { Keep looping until the low word }
         JE   @2              { of the timer count changes again }
         MOV  OneMS, DX       { DX has new OneMS }
      end;

    Procedure Beep(Hz, MS:Word); assembler;
         { Make the Sound at Frequency Hz for MS milliseconds }
      ASM
        MOV  BX,Hz
        MOV  AX,34DDH
        MOV  DX,0012H
        CMP  DX,BX
        JNC  @Stop
        DIV  BX
        MOV  BX,AX
        IN          AL,61H
        TEST AL,3
        JNZ  @99
        OR          AL,3
        OUT  61H,AL
        MOV  AL,0B6H
        OUT  43H,AL
     @99:
        MOV  AL,BL
        OUT  42H,AL
        MOV  AL,BH
        OUT  42H,AL
     @Stop:
     {$IFOPT G+}
        PUSH MS
     {$ELSE }
        MOV  AX, MS   { push delay time }
        PUSH AX
      {$ENDIF }
        CALL Delay    { and wait... }

        IN   AL, $61  { Now turn off the speaker }
        AND  AL, $FC
        OUT  $61, AL
      end;

    Procedure BoundsBeep; assembler; {Means you are touching an enemy}
      asm
      {$IFOPT G+ }
         PUSH 1234      { Pass the Frequency }
         PUSH 10        { Pass the delay time }
      {$ELSE}
         MOV  AX, 1234  { Pass the Frequency }
         PUSH AX
         MOV  AX, 10    { Pass the delay time }
         PUSH AX
       {$ENDIF }
         CALL Beep
      end;

    Procedure ErrorBeep; assembler;{Means you have touched an enemy and died}
      asm
      {$IFOPT G+ }
         PUSH 800   { Pass the Frequency }
         PUSH 75    { Pass the delay time }
      {$ELSE}
         MOV  AX, 800  { Pass the Frequency }
         PUSH AX
         MOV  AX, 75   { Pass the delay time }
         PUSH AX
      {$ENDIF }
         CALL Beep
      end;

    Procedure AttentionBeep; assembler; {Status Update beep}
      asm
      {$IFOPT G+ }
         PUSH 660   { Pass the Frequency }
         PUSH 50    { Pass the delay time }
      {$ELSE}
         MOV  AX, 660  { Pass the Frequency }
         PUSH AX
         MOV  AX, 50   { Pass the delay time }
         PUSH AX
      {$ENDIF }
         CALL Beep
      end;

    Procedure WarpSound; {Attemped warp sound}
     Var I:Word;
      Begin
        For I:= 500 to 600 do Beep(I,10);
      End;

    Procedure WarpDown; {Completed warp sound}
     Var I:Word;
      Begin
        For I:= 600 downto 500 do Beep(I,10);
        Delay(200);
        Beep(1000,10);
        Delay(200);
        Beep(1000,10);
      End;

    Procedure FClr;Assembler; {ClrScr}
      Asm
       MOV AH,0Fh
       Int 10h
       MOV AH,0
       Int 10h
      End;

    Procedure GotoXY(X,Y : Byte); Assembler;
    Asm
      MOV DH, Y    { DH = Row (Y) }
      MOV DL, X    { DL = Column (X) }
      DEC DH       { Adjust For Zero-based Bios routines }
      DEC DL       { Turbo Crt.GotoXY is 1-based }
      MOV BH,0     { Display page 0 }
      MOV AH,2     { Call For SET CURSOR POSITION }
      INT 10h
    end;

    Function Int2Str(Number : LongInt): String;
    Var
    Temp : String[64];
    Begin
       Str(Number,Temp);
       Int2Str := Temp;
    End;

    Procedure SetXY(x,y:byte;var A:CursorRec);
     Begin
      If (X > 0) and (X < 80) then A.x := x;
      If (Y > 0) and (Y < 25) then A.y := y;
     End;

    Procedure ClearKeyBoard;{Fast key clearer}
    Begin
     ASM CLI End;
     MemW[$40:$1A] := MemW[$40:$1C];
     ASM STI End;
    End;

    Procedure GoXY(A:CursorRec); {moves cursorrec to its position}
     Begin
      Gotoxy(a.x,a.y);
     End;

    Procedure HideCursor; Assembler;
    Asm
      MOV   ax,$0100
      MOV   cx,$2607
      INT   $10
    end;

    Procedure ShowCursor; Assembler;
    Asm
      MOV   ax,$0100
      MOV   cx,$0506
      INT   $10
    end;

    Function WhereX : Byte;  Assembler;
    Asm
      MOV     AH,3      {Ask For current cursor position}
      MOV     BH,0      { On page 0 }
      INT     10h       { Return inFormation in DX }
      INC     DL        { Bios Assumes Zero-based. Crt.WhereX Uses 1 based }
      MOV     AL, DL    { Return X position in AL For use in Byte Result }
    end;

    Function WhereY : Byte; Assembler;
    Asm
      MOV     AH,3     {Ask For current cursor position}
      MOV     BH,0     { On page 0 }
      INT     10h      { Return inFormation in DX }
      INC     DH       { Bios Assumes Zero-based. Crt.WhereY Uses 1 based }
      MOV     AL, DH   { Return Y position in AL For use in Byte Result }
    end;

    Procedure GETXY(A:CursorRec); {set cursorrec}
     Begin
      A.x := WhereX;
      A.y := WhereY;
     End;

    Procedure StatusBeep; {Look up, status line has been updated}
     Begin
      AttentionBeep;
      Delay(50);
      AttentionBeep;
     End;

    Function Readkey:char;Inline($B4/$07/$CD/$21);

    function KeyPressed:boolean;assembler;
     asm
     mov ah,$B;
     int $21;
     and al,$FE;
    end;

    Procedure ClrBox(X1,Y1,X2,Y2:Byte);
     Var
       OldX :Byte; AnyBt:Byte;
       OldY :Byte; AnyBt2:Byte;

     Begin
      OldX := WhereX;
      OldY := WhereY;
      gotoxy(x1,y1);
      For Anybt :=1 to Y2 do begin
       For AnyBt2 :=1 to X2 do write(#0);
       gotoxy(X1,Y1+AnyBt);
      End{For Loop};
      gotoxy(oldX,OldY);
      End;

    Procedure Status(S:String;Clear:Boolean;UseSound:Boolean);
    {Gives messages on first line}
     Begin
     If (Clear) and (SoundOn) and (UseSound) then StatusBeep;
     Gotoxy(1,1);
     If Clear then ClrBox(1,1,Len,1) else gotoxy(len,1);
     Write(S);
     If Clear then Len:= Length(S) else Len:= Len + Length(S)+1;
     inc(len);
     Goxy(Loc);
     End;

    Function P100(Percent:Word):Boolean;  {Percentage 100}
      Begin
       P100 := False;
       If Random(100)+1 <= Percent then P100 := True;
      End;

    Procedure StatInit; {Set up status bar |not status line|}
    Begin
    gotoxy(1,2);
    Write('[ STATUS ]   ENERGY:            SHIELDS:            SCORE:');
    End;

    {The following procedure update the status bar}

    Procedure UpDateEnergy;
     Var i:Byte;
     Begin
     Gotoxy(21,2);
     For I:=1 to 5 do write(#32);
     Gotoxy(21,2);
     Write(Energy);
     Goxy(Loc);
     End;

    Procedure UpDateShields;
     Var i:Byte;
     Begin
     StatusBeep;
     Gotoxy(41,2);
     For I:=1 to 5 do write(#32);
     Gotoxy(41,2);
     Write(ShieldOn);
     Goxy(Loc);
     End;

    Procedure UpDateScore;
     Var i:Byte;
     Begin
     Gotoxy(59,2);
     For I:=1 to Length(int2str(Energy))+2 do write(#32);
     gotoxy(59,2);
     Write(Score);
     Goxy(Loc);
     End;

    Procedure EngageShields; {Change shield status}
    Begin
     ShieldOn := not ShieldOn;
     UpDateShields;
    End;

    procedure Firephasers(A:CursorRec); {Check for collisions}
         begin
           If (A.x = Loc.x) and (A.Y = Loc.Y) then
           begin
            BoundsBeep;
            GoXy(A);
            Write(Langolier);
            If not shieldOn then
            begin
             If SoundOn then ErrorBeep;
             Dead := True;
            End;{ShieldOn}
          end;{If Locs match}
         End;{Fire}

    Procedure CheckHits;  {Check for collisions}
     Var I:word;
      Begin
       While not dead and (I <> NumEnemy) do
        For I:= 1 to NumEnemy do Firephasers(Temp[I]);
      End;

    Function Move(Dir:DirType;Var A:CursorRec;Ch:Char):Boolean;
    {Move player/enemies}
     Begin
     Move := True;
     Case Dir of
      North: Begin
               If A.Y <= top then Move := False else
               begin
                goxy(A);
                Write(#0);
                Dec(A.Y);
                GoXY(A);
                Write(Ch);
               End;{If wherey}
               End;{K_Up}

      South: Begin
             If A.Y >= bottom then Move := False else
              begin
              goxy(A);
              Write(#0);
              Inc(A.Y);
              GoXY(A);
              Write(ch);
              End;{If wherey}
              End;{K_Down}

      East: Begin
               If A.X >= rtside then Move := False else
               begin
                goxy(A);
                Write(#0);
                Inc(A.X);
                GoXY(A);
                Write(Ch);
                End;{If wherex}
                End;{K_Right}

      West: Begin
             If A.X <= lftside then Move := False else
              begin
              goxy(A);
              write(#0);
              Dec(A.X);
              GoXY(A);
              Write(Ch);
              End;{If wherex}
              End;{K_Left}

     End;{Case}
     CheckHits;
     End;{Move}

    Procedure Jump; {Hyper Jump}
     Begin
      Status('Attempting Jump...',True,False);
      If SoundOn then WarpSound;
      If Energy >= Jneed then
      begin
      If P100(JumpChance) then {If you don't fail...}
      begin
       Goxy(Loc);
       Write(#0);
       SetXy((random(rtside-lftside)+lftside+1),(random(bottom-top)+top+1)
       ,Loc);
       goxy(Loc);
       Write(snailman);
       Dec(Energy, Jneed); {Get rid of used energy}
       Status('successfull',false,True);
       If SoundOn then WarpDown; {make some noise}
      End Else
       Begin
       Delay(200);    {Failed Warp Noise}
       Beep(1500,20);
       Delay(200);
       Beep(1500,20);
       Delay(200);
       Beep(1500,20);
       Delay(200);
       Beep(1500,20);
       Status('Failed',False,True);
       Energy := BadEnergy; {Pay the price of a blown engine}
       Score := BadScore;   {""}
       End;
      End else Begin
        status('not enough energy!',false,True);
        Delay(200);
        Beep(1000,10);
       End;
     End;

    procedure Movefoes; {The enemy is on the move}
         Var I:Word;
         begin
         Turn := 0; {reset turns}
         For I:=1 to numenemy do
         Begin

         If Temp[I].X > Loc.X then Move(West,Temp[I],langolier) else
         If Temp[I].X < Loc.X then Move(East,Temp[I],langolier);

         If Temp[I].Y > Loc.Y then Move(North,Temp[I],langolier) else
         If Temp[I].Y < Loc.Y then Move(South,Temp[I],langolier);

         If P100(AI) then {do they move on their own?}
         begin
          case (random(4)+1) of
           1: Move(North,Temp[I],langolier);
           2: Move(South,Temp[I],langolier);
           3: Move(West,Temp[I],langolier);
           4: Move(East,Temp[I],langolier);
           End;{Case}
          End;{Begin}
         end;{for to do}
         {EnemySave;}
         end;

    procedure Addscore; {regulates energy use, this could use some work}
     begin
       if (energy < MaxEnergy) and (odd(turn)) then inc(energy,rep);
       if (score < MaxScore) and (turn = compspeed-1) then inc(score);
      end;

    procedure Playgame; {Let the games begin}
         Var i:Word;
         begin
         For I:=1 to numenemy do {set up starting positions}
         begin
         SetXy((random(rtside-lftside)+lftside+1),(random(bottom-top)+top+1)
               ,Temp[I]);
         goxy(Temp[I]);
         Write(langolier);
         end;

         SetXy(3,5,Loc);
         goxy(loc);
         Write(snailman);
         repeat {begin}
            While keypressed do {MUCH faster than "If Keyressed"}
               Begin
                Ch := readkey;
                If (CH = #0) and (ENergy > ENeed) then
              {a function key means they are moving}
                BEGIN
                Dec(Energy, Drain);
                Ch := Readkey;
                Case CH of
       { left }   #75 : Move(West,Loc,snailman);
       { rite }   #77 : Move(East,Loc,snailman);
       {  Up  }   #72 : Move(North, Loc, snailman);
       { Down }   #80 : Move(South, Loc,snailman);
       { PGup }   #73 : Begin
                         Move(North, Loc, snailman);
                         Move(East,Loc,snailman);
                        End;

       { PDdn }   #81 : Begin
                         Move(South, Loc,snailman);
                         Move(East,Loc,snailman);
                        End;

       { Home }   #71 : Begin
                         Move(North, Loc, snailman);
                         Move(West,Loc,snailman);
                        End;

       { End  }   #79 : Begin
                         Move(South, Loc, snailman);
                         Move(West,Loc,snailman);
                        End;

                End;{Case}
                END ELSE
                Case Ch of
               'Q','q' : Dead := True;{Quit}
               'J','j' : Jump;  {Jump}
               'S','s' : EngageShields;{Engage/disEngage shields}
               'P','p' : Begin
                         Inc(Energy, Drain); {Reimburse energy}
                         Status('Paused... press <ENTER>',true,True);
                         repeat until readkey = #13;
                         Status('',True,True);
                         End;

                   #3 :  CB;  {^C}
               End;{case}
               End;{While}

              If (Energy < SNeed) and (ShieldOn) then
               Begin
                ShieldOn := False;
                UpDateShields;
               End;

              If ShieldOn then Dec(Energy, SCost);
              ClearKeyBoard;

              If Round = StatUpDate then
               Begin
                GoXy(Loc);
                Write(SnailMan);
                UpDateEnergy;
                UpDateScore;
                Round := 0;
               End;
              inc(Round);

              If turn >= compspeed then movefoes;
              inc(turn);

              addscore;
              Delay(100);
              {end} until dead;
         end;

    Procedure SayHi; {Internal Instructions}
    Begin
    Writeln('Welcome to SNAiL ViSiON -- The virtual snail network -- ');
    Writeln('and only on channel 3031.  Tonight we bring you, once again,');
    Writeln('SNAiL MAN!  Can the not-so-brave-and-not-too-tough SNAiLMAN');
    Writeln('save the day?  Well, as you know, with ViRTUAL SNAiL REALiTY');
    Writeln('you will decide.  And just how do you win you ask?  Well the');
    Writeln('snail isn''t known for it''s ninja-like karate skills, so');
    Writeln('you just have to run as only a snail can.');
    Writeln('');
    Writeln('Advice --');
    Writeln(' When you here two beeps, look up, it means something has');
    Writeln(' just been updated.  Also, be carefull when using');
    Writeln(' HyperJump,if you fail you loose energy and points');
    Writeln('');
    Writeln('Instructions --');
    Writeln(' Arrow keys move you in corresponding directions.');
    Writeln(' PgUp, PgDn, Home, and End move diagonaly.');
    Writeln(' P - Pause   Q - Commit Sucicide   S - Engage Snail Shields');
    Writeln(' J - Snail HyperJump!');
    Writeln('');
    Writeln('Symbols --');
    Writeln(' ',SnailMan,' - Snailman   ',Langolier,' - Langolier');
    Writeln('');
    Write('<Press Enter> [ ]'#8#8);
    Repeat until readkey = #13;
    Fclr;
    End;

    begin {main program}
    (***********************************************************************)
     Calibrate_Delay;
     Delay(0);
     PlayAnother := True;

    Repeat
     randomize;
     NumEnemy := Random(16)+15;
     Dead := False;
     Score := 0;
     Turn := 0;
     Fclr;
     SayHi;
     HideCursor;
     ClearKeyBoard;
     Energy := StartingEnergy;
     ShieldOn := False;
     StatInit;
     UpDateShields;
    (***********************************************************************)

     Status('Welcome to SNAiL ViSiON v'+version+' ...',True,False);

     Playgame;

    (***********************************************************************)
     ShowCursor;
     FCLR; {Not only clears the screen, but resets some things as well}
     Writeln('Score: ',Score);
     Write('Play again? (Y/n)');
     Repeat
     Ch := UpCase(Readkey);
     Until (Ch = 'Y') or (CH = 'N');
     If Ch = 'N' then playanother := False;
     Until not PlayAnother;
     Fclr;
    (***********************************************************************)
    end.

    :::

[Back to MISC SWAG index] [Back to Main SWAG index] [Original]