Contributor: BRAD ZAVITSKY
{$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 )
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 }
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 ',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(' [ ]'#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.
:::