mario (1.bölüm)
 

program Turk_Mario; (* Ctrl+F9 yaparak calistirabilirisniz *)



{$A+} {$B-} {$F-} {$G+} {$I-} {$N-} {$O-} {$R-} {$S+} {$V-} {$X+}

{$DEFINE DEBUG} { Mouseye bas oyna veya ‡ik }
{$DEFINE MENU}

uses
CPU286,
Play,
Players,
Enemies,
Buffers,
VGA256,
Worlds,
BackGr,
KeyBoard,
Joystick,
Figures,
Palettes,
Txt,
Crt,
Dos;

const
numfatih = 6;
fatihlev = 2 * numfatih - 1;
fatihmax = 3;
demofatih = 500;

type
ayarverisi = record
Sound: Boolean;
SLine: Boolean;
Games: array[0..fatihmax - 1] of GameData;
UseJS: Boolean;
JSDat: JoyRec;
end;

ConfigFile = file of ayarverisi;

var
oyunnumarasi: Integer;

var
hadioyuncu: Integer;
Durdur,oyunbitti: Boolean;
Config: ayarverisi;

{$IFDEF DEBUG}
{$F+}
procedure MouseHalt;
begin
Halt (255);
end;

{$F-} (*Compiler Islevlerim*)

var MouseHaltAddr: Pointer;

{$ENDIF} (*Direktiflerime izin ver Emri*)

{$I Block.$00} (*Dosyada yazd?g?m asembly kodumu ‡ag?r?yorum Tas €erceve*)

{$I Intro.$00} (*Dosyada yazd?g?m asembly kodumu ‡ag?r?yorum MARIO kelimesi*)
{$I Intro.$01} (*Dosyada yazd?g?m asembly kodumu ‡ag?r?yorum & isareti*)
{$I Intro.$02} (*Dosyada yazd?g?m asembly kodumu ‡ag?r?yorum LUIGI kelimesi*)

{$I Start.$00} (*Dosyada yazd?g?m asembly kodumu ‡ag?r?yorum MARIO START kelimesi*)
{$I Start.$01} (*Dosyada yazd?g?m asembly kodumu ‡ag?r?yorum LUIGI START kelimesi*)

procedure NewData;
begin
with Data do
begin
Lives [Deha] := 3;
Lives [Fatih] := 3;
Coins [Deha] := 0;
Coins [Fatih] := 0;
Score [Deha] := 0;
Score [Fatih] := 0;
Progress [Deha] := 0;
Progress [Fatih] := 0;
Mode [Deha] := mdSmall;
Mode [Fatih] := mdSmall;
end;
end;

function GetConfigName: string;
var
S: string;
Len: byte absolute S;
begin
S := ParamStr (0);
S[Len - 2] := 'C';
S[Len - 1] := 'F';
S[Len - 0] := 'G';
GetConfigName := S;
end;

procedure ReadConfig;
var
i, j: Integer;
F: ConfigFile;
Name: string;
begin
{$IFDEF MENU}
Assign (F, GetConfigName);
Reset (F);
Read (F, Config);
Close (F);
if IOResult <> 0 then
{$ENDIF}
begin
NewData;
for i := 0 to fatihmax - 1 do
Config.Games[i] := Data;
with Config do
begin
SLine := TRUE;
Sound := TRUE;
UseJS := FALSE;
end;
oyunnumarasi := -1;
end;

with Config do
begin
Play.Stat := SLine;
Buffers.BeeperSound := Sound;
end;

Name := ParamStr (0);
j := 0;
if Length (Name) > 9 then
Delete (Name, 1, Length (Name) - 9);
for i := 1 to Length (Name) do
Inc (j, Ord (UpCase (Name[i])));
if j <> 648 then
RunError (201);
end;

procedure WriteConfig;
var
F: ConfigFile;
begin
with Config do
begin
SLine := Play.Stat;
Sound := Buffers.BeeperSound;
end;
{$IFDEF MENU}
Assign (F, GetConfigName);
ReWrite (F);
if IOResult = 0 then
begin
Write (F, Config);
Close (F);
end;
{$ENDIF}
end;

procedure CalibrateJoystick;
begin
Delay (100);
WriteLn ('joysticki d”nd?r ve butona bas');
WriteLn ('veya klavyeden uygun tuslari kullan...');
Delay (100);
Key := #0;
repeat
Calibrate;
Write (#13, 'X = ', Byte (jsRight) - Byte (jsLeft): 2,
' Y = ', Byte (jsDown) - Byte (jsUp): 2);
until jsButton1 or jsButton2 or (Key <> #0);
WriteLn;
if (Key <> #0) then
begin
jsEnabled := FALSE;
ReadJoystick;
end;
Config.UseJS := jsEnabled;
Config.JSDat := jr;
Key := #0;
end;

procedure ReadCmdLine;
var
i, j: Integer;
S: String;
begin
for i := 1 to ParamCount do
begin
S := ParamStr (i);
while S <> '' do
begin
if (Length (S) >= 2) and (S[1] in ['/', '-'])
then
begin
case UpCase (S[2]) of
'S': Play.Stat := TRUE;
'Q': BeeperOff;
'J': CalibrateJoystick;

end;
Delete (S, 1, 2);
end
else
Delete (S, 1, 1);
end;
end;
end;

procedure Demo;
begin
NewData;
Turbo := FALSE;
Data.Progress [Deha] := 5;
PlayMacro;
PlayWorld (' ', ' ', @Level_6a^, @Options_6a^, @Options_6a^,
@Level_6b^, @Options_6b^, @Options_6b^, Deha);
StopMacro;
end;

procedure Intro;
var
P, i, j, k, l, wd, ht, xp: Integer;
NextNumPlayers,
Selected: Integer;
IntroDone,
TestVGAMode,
Update: Boolean;
Counter: Integer;
MacroKey: Char;
Status,
OldStatus,
LastStatus: (ST_NONE,
ST_MENU,
ST_START,
ST_LOAD,
ST_ERASE,
ST_OPTIONS,
ST_NUMPLAYERS);
Menu: array[1..5] of string[40];
BG: array[0..MAX_PAGE, 1..5] of Word;
NumOptions: Integer;
Page: Byte;

procedure Up;
begin
if Selected = 1 then
begin
if Status = ST_MENU then
Selected := NumOptions
else
MacroKey := kbEsc;
end
else
Dec (Selected);
end;

procedure Down;
begin
if Selected = NumOptions then
begin
if Status = ST_MENU then
Selected := 1
else
MacroKey := kbEsc;
end
else
Inc (Selected);
end;

begin
Page := CurrentPage;
Status := ST_NONE;
TestVGAMode := FALSE;
oyunnumarasi := -1;
NextNumPlayers := Data.NumPlayers;

repeat
if TestVGAMode then
InitVGA;
TestVGAMode := FALSE;
IntroDone := FALSE;
NewData;

PlayWorld (#0, #0, @Intro_0^, @Options_0^, @Options_0^,
@Intro_0^, @Options_0^, @Options_0^, Deha);
InitBackGr (3, 0);

OutPalette ($A0, 35, 45, 50);
OutPalette ($A1, 45, 55, 60);

OutPalette ($EF, 30, 40, 30);
OutPalette ($18, 10, 15, 25);

OutPalette ($8D, 28, 38, 50);
OutPalette ($8F, 40, 50, 63);

for i := 1 to 50 do
BlinkPalette;

for P := 0 to MAX_PAGE do
begin
for i := 1 downto 0 do
for j := 1 downto 0 do
for k := 1 downto 0 do
begin
(*MARIO Yaz?yorum*)
DrawImage (38 + i + j, 29 + i + k, 108, 28, @Intro000^);
(* & iŸaretini yazd?m*)
DrawImage (159 + i + j, 29 + i + k, 24, 28, @Intro001^);
(*LUIGI Yaz?yorum*)
DrawImage (198 + i + j, 29 + i + k, 84, 28, @Intro002^);
end;

DrawBackGrMap (10 * H + 6, 11 * H - 1, 54, $A0);
DrawBackGrMap (10 * H + 6, 11 * H - 1, 55, $A1);
DrawBackGrMap (10 * H + 6, 11 * H - 1, 53, $A1);
for i := 0 to NH - 1 do
for j := 0 to NV - 1 do
if (i in [0, NH - 1]) or (j in [0, NV - 1]) then
DrawImage (i * W, j * H, W, H, @Block000^);
DrawPlayer;
ShowPage;
end;
UnlockPal;
Key := #0;
FadeUp (64);
ResetStack;

FillChar (BG, SizeOf (BG), 0);
FillChar (Menu, SizeOf (Menu), 0);
Fontkur (0, Kalin + Golge);

if Status <> ST_OPTIONS then
begin
OldStatus := ST_NONE;
LastStatus := ST_NONE;
Status := ST_MENU;
Selected := 1;
end;
UpDate := TRUE;

Counter := 1;
repeat

if UpDate or (Status <> OldStatus) then
begin
if (Status <> OldStatus) then
Selected := 1;
case Status of
ST_MENU:
begin
Menu[1] := 'BASLAT';
Menu[2] := 'SECENEK';
Menu[3] := 'SONLANDIR';
Menu[4] := '';
Menu[5] := 'FATIH TANSALIC';
NumOptions := 3;
LastStatus := ST_MENU;
end;
ST_OPTIONS:
begin
if BeeperSound then
Menu[1] := 'SESI AC '
else
Menu[1] := 'SESI KAPAT';
if Play.Stat then
Menu[2] := 'DURUM SATIRI ACIK '
else
Menu[2] := 'DURUM SATIRI KAPALI ';
Menu[3] := '';
Menu[4] := '';
Menu[5] := '';
NumOptions := 2;
LastStatus := ST_MENU;
end;
ST_START:
begin
Menu[1] := 'KAC OYUNCULU';
Menu[2] := 'OYUNU KAYDET';
Menu[3] := 'SIL';
Menu[4] := '';
Menu[5] := '';
NumOptions := 3;
LastStatus := ST_MENU;
end;
ST_NUMPLAYERS:
begin
Menu[1] := 'BIR OYUNCU';
Menu[2] := 'IKI OYUNCU';
Menu[3] := '';
Menu[4] := '';
Menu[5] := '';
if (Status <> OldStatus) then
Selected := Data.NumPlayers;
NumOptions := 2;
LastStatus := ST_START;
end;
ST_LOAD,
ST_ERASE:
begin
Menu[1] := 'OYUN #1 '#7' ';
Menu[2] := 'OYUN #2 '#7' ';
Menu[3] := 'OYUN #3 '#7' ';
Menu[4] := '';
Menu[5] := '';
for i := 1 to 3 do
with Config.Games[i - 1] do
if (Progress[Deha] = 0) and (Progress[Fatih] = 0) then
Menu[i] := Menu[i] + 'BOS'
else
begin
j := Progress[Deha];
k := Byte (Progress [hadioyuncu] >= numfatih);
if k > 0 then
Dec (j, numfatih);
if Progress[Fatih] > j then
begin
j := Progress[Fatih];
Progress[Deha] := j;
end;
Menu[i] := Menu[i] +
'LEVEL ' + Chr (j + Ord ('0') + 1) + ' ';
if k = 0 then
Menu[i] := Menu[i] + #7' '
else
Menu[i] := Menu[i] + '* ';
Menu[i] := Menu[i] +
Chr (NumPlayers + Ord ('0')) + 'P';
end;
NumOptions := 3;
LastStatus := ST_START;
end;


end;
wd := 0;
xp := 0;
for i := 1 to 5 do
begin
j := TextGenis (Menu[i]);
if j > wd then
begin
wd := j;
xp := CenterX (Menu[i]) div 4 * 4;
end;
ht := 8;
end;
OldStatus := Status;
Update := FALSE;
end;

MacroKey := #0;
case Key of
kbEsc:
if Status = ST_MENU then
begin
IntroDone := TRUE;
QuitGame := TRUE;
end
else
Status := LastStatus;
kbUpArrow:
Up;
kbDownArrow:
Down;
kbSP,
kbEnter:
case Status of

ST_MENU:
case Selected of
1: Status := ST_START;
2: Status := ST_OPTIONS;
3: begin
IntroDone := TRUE;
QuitGame := TRUE;
end;
end;

ST_START:
case Selected of
1: Status := ST_NUMPLAYERS;
2: Status := ST_LOAD;
3: Status := ST_ERASE;
end;

ST_OPTIONS:
case Selected of
1: if BeeperSound then
BeeperOff
else
BeeperOn;
2: Play.Stat := not Play.Stat;
end;

ST_NUMPLAYERS:
case Selected of
1: begin
NextNumPlayers := 1;
IntroDone := TRUE;
end;
2: begin
NextNumPlayers := 2;
IntroDone := TRUE;
end;
end;

ST_LOAD:
begin
oyunnumarasi := Selected - 1;
Config.Games[oyunnumarasi].NumPlayers := 1;
with Config.Games[oyunnumarasi] do
if (Progress[Deha] = 0) and (Progress[Fatih] = 0) then
Status := ST_NUMPLAYERS
else
begin
IntroDone := TRUE;
NextNumPlayers := Config.Games[oyunnumarasi].NumPlayers;
end;
end;

ST_ERASE:
begin
NewData;
Config.Games[Selected - 1] := Data;
Config.Games[Selected - 1].NumPlayers := 1;
oyunnumarasi := -1;
end;

end;
end;
if Key <> #0 then
begin
Counter := 0;
Key := MacroKey;
Update := TRUE;
end;

for k := 1 to 5 do
begin
if BG[Page, k] <> 0 then
PopBackGr (BG[Page, k]);
end;

for k := 1 to 5 do
begin
if Menu[k] <> '' then
begin
i := xp;
j := 56 + 14 * k;
BG[Page, k] := PushBackGr (50, j, 220, ht);
if k = Selected then
TextYaz (i - 12, j, #16, 5);
l := 15;
if (Length (Menu[k]) > 19) and (Menu[k][19] = '*') then
l := 14 + (Counter and 1);
SetPalette (14, 63, 61, 31);
TextYaz (i + 8, j, Menu[k], l);
end;
end;

ShowPage;
BlinkPalette;
ResetStack;

Inc (Counter);
until IntroDone or (Counter = demofatih);
FadeDown (64);

if not IntroDone then
Demo;
until IntroDone and (not TestVGAMode);

if oyunnumarasi <> -1 then
Data := Config.Games[oyunnumarasi];
Data.NumPlayers := NextNumPlayers;
end; { IntroYA geciyorum }


procedure ShowPlayerName (Player: Byte);
var
iW, iH, i: Integer;
begin
ClearPalette;
LockPal;
ClearVGAMem;
SetView (0, 0);
iH := 13;
for i := 0 to MAX_PAGE do
begin
case Player of
Deha:
begin
iW := 116;
DrawImage (160 - iW div 2, 85 - iH div 2, iW, iH, @Start000^);
end;
Fatih:
begin
iW := 108;
DrawImage (160 - iW div 2, 85 - iH div 2, iW, iH, @Start001^);
end;
end;
ShowPage;
end;
NewPalette (P256^);
UnLockPal;
Palettes.ReadPalette (Palette);
for i := 1 to 100 do
ShowPage;
ClearPalette;
ClearVGAMem;
end;

begin { Marioyu y”netime sokuyorum ana blok icra b”l?m?m }
InitKeyBoard;
Data.NumPlayers := 1;
ReadConfig;
ReadCmdLine;

jr := Config.JSDat;
jsEnabled := jsDetected and Config.UseJS;

{$IFDEF DEBUG}
MouseHaltAddr := @MouseHalt;
asm
xor ax, ax
int 33h
inc ax
jnz @End
mov al, 0Ch
mov cx, 0Ah
les dx, MouseHaltAddr
int 33h
@End:
end;
{$ENDIF}

if not DetectVga then
begin
System.WriteLn ('VGA grafik adapt”r? gerekli');
Halt (1)
end;

ResetKeyBoard;

if not InGraphicsMode then
InitVGA;

{$IFDEF MENU}
repeat
{$ENDIF}

ClearVGAMem;

InitPlayerFigures;
InitEnemyFigures;

oyunbitti := FALSE;
{$IFDEF MENU}
Intro;
{$ENDIF}

Randomize;

with Data do
begin
if NumPlayers = 2 then
if Progress [Deha] > Progress [Fatih] then
Progress [Fatih] := Progress [Deha]
else
Progress [Deha] := Progress [Fatih];

Lives [Deha] := 3;
Lives [Fatih] := 3;
Coins [Deha] := 0;
Coins [Fatih] := 0;
Score [Deha] := 0;
Score [Fatih] := 0;
Mode [Deha] := mdSmall;
Mode [Fatih] := mdSmall;
end;

repeat
if Data.NumPlayers = 1 then
Data.Lives [Fatih] := 0;
for hadioyuncu := Deha to Data.NumPlayers - 1 do
begin
if not (oyunbitti or QuitGame) then
if Data.Lives [hadioyuncu] >= 1 then
begin
with Data do
begin
Turbo := (Progress [hadioyuncu] >= numfatih);
if Progress [hadioyuncu] > fatihlev then
Progress [hadioyuncu] := numfatih;
end;
{$IFDEF MENU}
ShowPlayerName (hadioyuncu);
{$ENDIF}
case Data.Progress [hadioyuncu] mod numfatih of
0: Durdur := PlayWorld ('x', '1', @Level_1a^, @Options_1a^, @Opt_1a^,
@Level_1b^, @Options_1b^, @Options_1b^, hadioyuncu);
1: Durdur := PlayWorld ('x', '2', @Level_2a^, @Options_2a^, @Opt_2a^,
@Level_2b^, @Options_2b^, @Options_2b^, hadioyuncu);
2: Durdur := PlayWorld ('x', '3', @Level_3a^, @Options_3a^, @Opt_3a^,
@Level_3b^, @Options_3b^, @Options_3b^, hadioyuncu);
3: Durdur := PlayWorld ('x', '4', @Level_5a^, @Options_5a^, @Opt_5a^,
@Level_5b^, @Options_5b^, @Options_5b^, hadioyuncu);
4: Durdur := PlayWorld ('x', '5', @Level_6a^, @Options_6a^, @Opt_6a^,
@Level_6b^, @Options_6b^, @Options_6b^, hadioyuncu);
5: Durdur := PlayWorld ('x', '6', @Level_4a^, @Options_4a^, @Opt_4a^,
@Level_4b^, @Options_4b^, @Options_4b^, hadioyuncu);
else
oyunbitti := TRUE;
end;

if Durdur then
Inc (Data.Progress [hadioyuncu]);
if QuitGame then
begin
oyunbitti := TRUE;
{$IFDEF MENU}
QuitGame := FALSE;
{$ENDIF}
end;
end;

end;
until oyunbitti or QuitGame or
(Data.Lives [Deha] + Data.Lives [Fatih] = 0);

if oyunnumarasi <> -1 then
Config.Games[oyunnumarasi] := Data;

{$IFDEF MENU}
until QuitGame;
{$ENDIF}
WriteConfig;
end.


kadir göksu 0 537 714 57 25
0 537 714 57 25

emeğe saygı