Programalama > PASCAL

Etiketler: türk, mario

Ort. 0
Puan ver:
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&#8221;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&#376;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&#8221;netime sokuyorum ana blok icra b&#8221;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&#8221;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


Yorumlar                 Yorum Yaz
Bu hazır kod'a ilk yorumu siz yapın!
KATEGORİLER
ASP - 240
ASP.NET - 24
C# - 75
C++ - 174
CGI - 8
DELPHI - 247
FLASH - 49
HTML - 536
PASCAL - 246
PERL - 11
PHP - 160
WML - 9
XML - 2
Copyright © 2002 - 2024 Hazır Kod - Tüm Hakları Saklıdır.
Siteden yararlanırken gizlilik ilkelerini okumanızı tavsiye ederiz.
hazirkod.com bir İSOBİL projesidir.