figures.pas

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

      4: begin
           Move (@Grass000^, FigList [N,  1], SizeOf (FigList [N,  1]));
           Move (@Grass001^, FigList [N,  2], SizeOf (FigList [N,  2]));
           Move (@Grass002^, FigList [N,  4], SizeOf (FigList [N,  4]));
           Move (@Grass003^, FigList [N,  5], SizeOf (FigList [N,  5]));
           Move (@Grass004^, FigList [N, 10], SizeOf (FigList [N, 10]));
         end;
      5: begin
           Move (@Des000^, FigList [N,  1], SizeOf (FigList [N,  1]));
           Move (@Des001^, FigList [N,  2], SizeOf (FigList [N,  2]));
           Move (@Des002^, FigList [N,  4], SizeOf (FigList [N,  4]));
           Move (@Des003^, FigList [N,  5], SizeOf (FigList [N,  5]));
           Move (@Des004^, FigList [N, 10], SizeOf (FigList [N, 10]));
         end;

    end;

    Mirror (@FigList [N,  1], @FigList [N,  3]);
    Rotate (@FigList [N,  4], @FigList [N,  6]);
    Rotate (@FigList [N,  1], @FigList [N,  9]);
    Rotate (@FigList [N,  2], @FigList [N,  8]);
    Rotate (@FigList [N,  3], @FigList [N,  7]);
    Mirror (@FigList [N, 10], @FigList [N, 11]);
    Rotate (@FigList [N, 11], @FigList [N, 12]);
    Mirror (@FigList [N, 12], @FigList [N, 13]);

  end;

  begin  { InitWalls }
    InitWall (1, W1);
    InitWall (2, W2);
    InitWall (3, W3);
  end;

  procedure SetSkyPalette;
  var
    i, j: Integer;
  begin
    case Sky of
      0:
        begin
           ChangePalette ($E0, 35, 45, 63);
           ChangePalette ($F0, 20, 38, 48);
           ChangePalette ($FF, 54, 57, 60);
         end;
      1:
         begin
           ChangePalette ($E0, 52, 55, 55);
           ChangePalette ($F0, 42, 48, 45);
           ChangePalette ($FF, 61, 61, 61);
         end;
      2:
        begin
          for i := $E0 to $EF do
          begin
            j := i - $E0;
          { ChangePalette (i, 25 - j, 20 - j, 63 - j); }
            ChangePalette (i, 48 - 2 * j, 58 - j, 58);
          end;
        { ChangePalette ($F0, 17, 14, 34); }
          ChangePalette ($F0, 35, 48, 46);
        end;
      3:
         begin
           ChangePalette ($E0,  0,  5,  3);
           ChangePalette ($F0,  8, 12, 10);
           ChangePalette ($FF,  8, 13, 13);
         end;
      4:
         begin
           ChangePalette ($E0, 35, 45, 53);
         { ChangePalette ($F0, 53, 63, 63); }
           ChangePalette ($F0, 23, 39, 43);
           ChangePalette ($FF, 58, 60, 60);
         end;
      5:
        begin
          for i := $E0 to $EF do
          begin
            j := i - $E0;
            ChangePalette (i, 58 - j div 2, 56 - j, 38 - j);
          end;
          ChangePalette ($F0, 52, 49, 32);
        end;
      6: { Brown bricks }
        if Options.BackGrType = 4 then
        begin
          for i := $E0 to $EF do
            ChangePalette (i, 22, 15, 11);
          ChangePalette ($FD, 22, 15, 11);
          ChangePalette ($FE, 19, 12,  8);
          ChangePalette ($FF, 25, 18, 14);
        end
        else
        begin
          for i := $E0 to $FF do
            ChangePalette (i, 19,  9,  8);
          ChangePalette ($D1, 19,  9,  8);
          ChangePalette ($D6, 21, 11, 10);
          ChangePalette ($D4, 17,  7,  6);
        end;
      7: { Gray bricks }
        if Options.BackGrType = 4 then
        begin
          for i := $E0 to $EF do
            ChangePalette (i, 18, 18, 22);
          ChangePalette ($FD, 18, 18, 22);
          ChangePalette ($FF, 23, 23, 27);
          ChangePalette ($FE, 13, 13, 17);
        end
        else
        begin
          for i := $E0 to $FF do
            ChangePalette (i, 15, 15, 18);
          ChangePalette ($D1, 15, 15, 18);
          ChangePalette ($D4, 18, 18, 21);
          ChangePalette ($D6, 12, 12, 15);
        end;
      8: { Dark brown bricks }
        if Options.BackGrType = 4 then
        begin
          for i := $E0 to $EF do
            ChangePalette (i, 17, 10, 10);
          ChangePalette ($FD, 17, 10, 10);
          ChangePalette ($FE, 11,  5,  5);
          ChangePalette ($FF, 20, 14, 14);
        end
        else
        begin
          for i := $E0 to $FF do
            ChangePalette (i, 15,  5,  5);
          ChangePalette ($D1, 15,  5,  5);
          ChangePalette ($D4, 20, 10, 10);
          ChangePalette ($D6, 10,  0,  0);
        end;
      9:
        begin
          for i := $E0 to $EF do
          begin
            j := i - $E0;
            ChangePalette (i, 63 - j div 3, 50 - j, 25 - j);
          end;
          ChangePalette ($F0, 48, 35, 18);
        end;
      10:
        begin
          for i := $E0 to $EF do
          begin
            j := i - $E0;
            ChangePalette (i, 27 - j, 43 - j, 63 - j);
          end;
          ChangePalette ($F0, 58, 58, 63);
        end;
      11:
        begin
        {  ChangePalette ($E0, 52, 55, 55); }
          for i := $E0 to $EF do
          begin
            j := i - $E0;
            ChangePalette (i, 60 - j, 63 - j, 63 - j);
          end;
          ChangePalette ($F0, 42, 48, 45);
        {  ChangePalette ($FF, 61, 61, 61); }
        end;
      12:
        begin
          for i := $E0 to $EF do
          begin
            j := i - $E0;
            ChangePalette (i, 55 - j, 63 - j, 63);
          end;
          ChangePalette ($F0, 30, 50, 58);
          ChangePalette ($F0, 36, 45, 41);
        end;
    end;
  end;

  procedure DrawSky (X, Y, W, H: Integer);
  const
    Y1 = 0;
    Y2 = Y1 + 96;
    YStep = (Y2 - Y1) div 16;  { = 6 }
  var
    i, j, k: Integer;
    Mix: Word;
  begin
    if Options.BackGrType = 0 then
      Fill (X, Y, W, H, $E0)
    else
    case Sky of
      0, 1, 3, 4:
        begin
          i := Options.Horizon;
          j := i - Y;
          if (i < Y) then
            Fill (X, Y, W, H, $F0)
          else
            if (i > Y + H - 1) then
              Fill (X, Y, W, H, $E0)
            else
            begin
              Fill (X, Y, W, j, $E0);
              Fill (X, i, W, H - j, $F0);
            end;
        end;
      2, 5, 9, 10, 11, 12:
        SmoothFill (X, Y, W, H);
      6, 7, 8:
        case Options.BackGrType of
          4: DrawBricks (X, Y, W, H);
          5: LargeBricks (X, Y, W, H);
          6: Pillar (X, Y, W, H);
          7: Windows (X, Y, W, H);
        end;
    end;
  end;

  procedure Redraw (X, Y: Integer);
  var
    Ch: Char;
    Fig: Pointer;
    L, R, LS, RS: Boolean;
    XPos, YPos: Integer;
  begin
    XPos := X * W;
    YPos := Y * H;
    Ch := WorldMap^ [X, Y];
    if (X >= 0) and (Y >= 0) and (Y < NV) then
    begin
      if (not (Ch in [#0])) then
        if (Ch = '%') and (Options.Design = 4) then
          DrawSky (XPos, YPos, W, H div 2)
        else
          DrawSky (XPos, YPos, W, H);
      if Ch = ' ' then Exit;
      if WorldMap^ [X, Y - 1] = #18 then
      begin
        Fig := @FigList [1, 5];
        PutImage (XPos, YPos, W, H, Fig^);
      end;
      Fig := Nil;
      case Ch of

        #1 .. #26:
          begin
            if Ch > #13 then
              Ch := Chr (Ord (Ch) - 13)
            else
              if WorldMap^ [X - 1, Y] in [#14..#26] then
              begin
                if Ch in [#1, #4, #7] then
                begin
                  Fig := @FigList [1, Ord (WorldMap^ [X - 1, Y]) - 13];
                  PutImage (XPos, YPos, W, H, Fig^);
                end;
              end
              else
                if WorldMap^ [X + 1, Y] in [#14..#26] then
                  if Ch in [#3, #6, #9] then
                  begin
                    Fig := @FigList [1, Ord (WorldMap^ [X + 1, Y]) - 13];
                    PutImage (XPos, YPos, W, H, Fig^);
                  end;

            Fig := @FigList [1, Ord (Ch)];
            if not (Ch in [#1, #3, #4, #6, #7, #9]) then
            begin
              PutImage (XPos, YPos, W, H, Fig^);
              Fig := Nil;
            end;
          end;

        '?': Fig := @Quest000;
        '@': Fig := @Quest001;

        'A': begin
               L := WorldMap^ [X - 1, Y] = 'A';
               R := WorldMap^ [X + 1, Y] = 'A';
               if Odd (X + Y) then
               begin
                 RS := True;
                 LS := False;
               end
               else
               begin
                 LS := True;
                 RS := False;
               end;
               if (LS and R) then
                 Fig := @Bricks [1]
               else
                 if (RS and L) then
                   Fig := @Bricks [2]
                 else
                   Fig := @Bricks [0]
             end;


        'I': Fig := @Block000;
        'J': Fig := @Block001;
        'K': Fig := @Note000;

        'X': Fig := @XBlock000;

        'W': Fig := @Wood000;
        '=': begin
               Fig := @Pin000;
               if WorldMap^ [X, Y + 1] in CanHoldYou then
                 DrawImage (XPos, YPos, W, H, Fig^)
               else
                 UpSideDown (XPos, YPos, W, H, Fig^);
               Fig := NIL;
             end;

        '0': Fig := @Pipe000;
        '1': Fig := @Pipe001;
        '2': Fig := @Pipe002;
        '3': Fig := @Pipe003;

        '*': Fig := @Coin000;

        '