29 October 2008

SLALOM R1.0


(* --------------------------------------------------- *)
(* Program Name : SLALOM R1.0 *)
(* Program Type : Game (And Demo too...) *)
(* Programmer : Kutu Busuk *)
(* ZeroBit Tech. Research & Dev. *)
(* Compiler : Turbo Pascal 5.50 *)
(* Program Code : #M04.93E02.93E04.16.$05.**** *)
(* Hardware Config. : AT/286-16MHz, CGA *)
(* --------------------------------------------------- *)

{$M 65520,0,0,R-}

Program Slalom;

Uses Dos, Crt;

Const
Passed : Boolean = False;
Noise : Boolean = True;
HighScr : Word = 0;
RgArrow = 77; { Scan Code }
LfArrow = 75;
UpArrow = 72;
DnArrow = 80;
F1 = 59;
Esc = 1;
Width = 57; { Lebar Area }
Road = 12; { Lebar Jalan }
MaxDly = 100;
MinDly = 15;
StepDly = 5; { Pakemnya Rem }

Var
Int1Ch : Pointer;
Dly,
Pos,
XPos,
Tree,
Inp,
Scan : Byte;
Quit,
RgArrP,
LfArrP,
UpArrP,
DnArrP,
F1P,
EscP,
Press : Boolean;
Dummy : Char;
H,
M,
S,
SD,
Score : Word;
Start,
Stop : Real;

Procedure KeyBoardHandler; Interrupt;
Begin
Inp := Port[$60];
Scan := Inp AND $7F;
Press := Inp < $80;
Case Scan of
RgArrow : RgArrP := Press;
LfArrow : LfArrP := Press;
UpArrow : UpArrP := Press;
DnArrow : DnArrP := Press;
F1 : F1P := Press;
Esc : EscP := Press;
End;
While KeyPressed do Dummy := ReadKey;
If EscP then Quit := True;
If F1P then
Begin
NoSound;
Noise := NOT Noise;
End;
End;

Procedure Init;
Begin
DirectVideo := False;
CheckBreak := False;
GetIntVec($1C,Int1Ch);
SetIntVec($1C,@KeyBoardHandler);
If Mem[0:$449] <> CO80 then TextMode(CO80);
TextAttr := $1F;
ClrScr;
InLine($b4/1/ { mov ah,1 ; kursor hilang }
$b9/32/32/ { mov cx,2020h }
$cd/$10); { int 10h }
Randomize;
End;

Procedure Done;
Begin
SetIntVec($1C,Int1Ch);
NoSound;
Window(01,01,80,25);
TextAttr := $1F;
ClrScr;
InLine($b4/1/ { mov ah,1 ; kursor ada lagi }
$b9/7/0/ { mov cx,7 }
$cd/$10); { int 10h }
End;

Procedure WriteXY(X, Y : Byte; St : String);
Begin
GotoXY(X,Y);
Write(St);
End;

Procedure Box(X1, Y1, X2, Y2, Attr, Back : Byte);
Begin
Window(X1+2,Y1+1,X2+2,Y2+1);
TextAttr := Back;
ClrScr;
Window(X1,Y1,X2,Y2);
TextAttr := Attr;
ClrScr;
Window(01,01,80,25);
End;

Procedure Draw;
Var X : Byte;
Begin
Port[985] := Blue; { BORDER Biru pada CGA }
Box(60,02,78,13,$2F,$07);
WriteXY(62,04,'TOMBOL-TOMBOL :');
WriteXY(64,06,#27' : KIRI');
WriteXY(64,07,#26' : KANAN');
WriteXY(64,08,#24' : GAS');
WriteXY(64,09,#25' : REM');
WriteXY(64,10,'F1 : SUARA');
WriteXY(64,11,'Esc : KELUAR');
Box(60,17,78,24,$4E,$07);
WriteXY(62,18,'® SLALOM R1.0 ¯');
WriteXY(63,20,'NTT :'); Write(HighScr:6);
WriteXY(63,21,'WAKTU :'); Write(20.0:6:1);
WriteXY(63,22,'LAJU :'); Write(0:6);
WriteXY(63,23,'NILAI :'); Write(0:6);
Window(01,01,Width+1,25);
TextAttr := $F;
ClrScr;
Window(01,01,80,25);
For X := 1 to 25 do
Begin
WriteXY(20,X,#178#178);
WriteXY(19+Road,X,#178#178);
End;
WriteXY(22,15,#234);
WriteXY(01,15,'SIAP ?');
For X := 3 downto 1 do
Begin
If Noise then Sound(1000);
Delay(100); NoSound; Delay(900);
GotoXY(01,15); Write('....',X:2);
End;
If Noise then Sound(1000);
Delay(1000);
WriteXY(06,15,'GO !!!');
NoSound;
End;

Procedure WriteInfo(Score, Gas : Word);
Var T : Byte;
Begin
T := TextAttr;
TextAttr := $4E;
GotoXY(72,21); Write(20.0 + Start - Stop:4:1);
GotoXY(70,22); Write(Gas:6);
GotoXY(70,23); Write(Score:6);
TextAttr := T;
End;

Function Enough : Boolean;
Var C : Char;
Begin
Box(07,08,51,12,$4F,$1E);
WriteXY(10,10,'ENTER UNTUK MAIN LAGI, ESC UNTUK KELUAR');
While KeyPressed do C := ReadKey;
Repeat
C := ReadKey;
Until C IN [#13,#27];
Enough := C = #27;
End;

Procedure Run;
Begin
Draw;
Dly := 50;
Pos := 20;
XPos := 22;
Score := 0;
Quit := False;
RgArrP := False;
LfArrP := False;
UpArrP := False;
DnArrP := False;
F1P := False;
EscP := False;
GetTime(H,M,S,SD);
Start := 3600*H+60*M+S+SD/100;
Repeat
GetTime(H,M,S,SD);
Stop := 3600*H+60*M+S+SD/100;
Passed := ((Stop - Start) > 20.0);
If NOT ((Stop - Start) > 19.0) then
Case Random(20) of
0..7 : If (Pos > 1) then Dec(Pos);
8..16 : If (Pos < (Width-Road)) then Inc(Pos);
End;
WriteXY(Pos,1,#178#178);
WriteXY(Pos+Road-1,1,#178#178);
Tree := Random(Width);
If (Tree < Pos) OR (Tree > (Pos+Road)) then
Begin
TextAttr := 9+Random(7);
WriteXY(Tree,1,#177);
TextAttr := $F;
End;
If UpArrP then
Begin
If (Dly > MinDly) then Dec(Dly)
End
else
If (Dly < MaxDly) then Inc(Dly);
If DnArrP AND (Dly < (MaxDly-StepDly)) then
Begin
Inc(Dly,StepDly);
If Noise then Sound(3951); { Suara Rem }
End;
WriteXY(XPos,15,#32);
If (LfArrP AND (XPos > 1)) then Dec(XPos);
If (RgArrP AND (XPos < Width)) then Inc(XPos);
InLine($B8/1/7/ { mov ax,701h ; scroll down }
$31/$C9/ { xor cx,cx }
$B6/24/ { mov dh,24 }
$B2/ $B7/$f/ { mov bh,0fh }
$cd/$10); { int 10h }
WriteXY(XPos,15,#234);
If Noise then Sound(20+(MaxDly-Dly)*2); { Suara Mesin }
Delay(Dly);
Inc(Score);
WriteInfo(Score,MinDly+MaxDly-Dly);
If Passed then
Begin
Box(17,18,40,22,$4E,$2F);
GotoXY(72,21); Write(0.0:4:1);
If Score > 200 then
Begin
WriteXY(20,20,'SUKSES ! NILAI ');
Write(Score);
End
else
WriteXY(20,20,'TERLALU LAMBAT !');
If Score > HighScr then
Begin
If HighScr <> 0 then
Begin
Sound(500); Delay(200);
WriteXY(20,21,'NILAI TERTINGGI !!!');
Sound(200); Delay(200);
End;
HighScr := Score;
End;
Sound(500); Delay(200);
Sound(200); Delay(500);
NoSound;
End;
If (Mem[$B800:(XPos-1)*2+13*160] <> 32) then
Begin
Mem[$B800:(XPos-1)*2+14*160+1] := $8C;
Box(17,18,40,22,$4E,$2F);
WriteXY(23,20,'TABRAKAN !!!');
For Dly := 1 to 150 do
Begin
If Noise then Sound(50+Random(700));
Delay(5);
End; { Mobil Meledak ! }
Quit := True;
NoSound;
End;
Until Quit OR Passed;
End;

BEGIN
Init;
Repeat
Run
Until Enough;
Done;
END.

No comments: