mario.pas

dos下经典游戏超级马力的完整源代码

program Mario;

  { Mario game for the PC by Mike Wiering, 1994-95 }

  {  web site: http://home.wxs.nl/~mike.wiering/mario/
     e-mail:   [e-mail]
  }

  { Compile with Borland Turbo Pascal 6/7 }

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

  { $DEFINE DEBUG}  { halt the game by pressing mouse button }
  {$DEFINE MENU}

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

  const
    NUM_LEV = 6;
    LAST_LEV = 2 * NUM_LEV - 1;
    MAX_SAVE = 3;
    WAIT_BEFORE_DEMO = 500;

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

    ConfigFile = file of ConfigData;

  var
    GameNumber: Integer;

  var
    CurPlayer: Integer;
    Passed,
    EndGame: Boolean;
    Config: ConfigData;

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

  var MouseHaltAddr: Pointer;
  {$ENDIF}

  {$I Block.$00}

  {$I Intro.$00}
  {$I Intro.$01}
  {$I Intro.$02}

  {$I Start.$00}
  {$I Start.$01}

  procedure NewData;
  begin
    with Data do
    begin
      Lives [plMario] := 3;
      Lives [plLuigi] := 3;
      Coins [plMario] := 0;
      Coins [plLuigi] := 0;
      Score [plMario] := 0;
      Score [plLuigi] := 0;
      Progress [plMario] := 0;
      Progress [plLuigi] := 0;
      Mode [plMario] := mdSmall;
      Mode [plLuigi] := 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 MAX_SAVE - 1 do
        Config.Games[i] := Data;
      with Config do
      begin
        SLine := TRUE;
        Sound := TRUE;
        UseJS := FALSE;
      end;
      GameNumber := -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 ('Rotate joystick and press button');
    WriteLn ('or press any key to use keyboard...');
    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 [plMario] := 5;
    PlayMacro;
    PlayWorld (' ', ' ', @Level_6a^, @Options_6a^, @Options_6a^,
      @Level_6b^, @Options_6b^, @Options_6b^, plMario);
    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;
    GameNumber := -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^, plMario);
      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
              DrawImage (38 + i + j, 29 + i + k, 108, 28, @Intro000^);
              DrawImage (159 + i + j, 29 + i + k, 24, 28, @Intro001^);
              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);
      SetFont (0, Bold + Shadow);

      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] := 'START';
                 Menu[2] := 'OPTIONS';
                 Menu[3] := 'END';
                 Menu[4] := '';
                 Menu[5] := '';
                 NumOptions := 3;
                 LastStatus := ST_MENU;
               end;
            ST_OPTIONS:
              begin
                 if BeeperSound then
                   Menu[1] := 'SOUND ON '
                 else
                   Menu[1] := 'SOUND OFF';
                 if Play.Stat then