backgr.pas

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

unit BackGr;

interface

  uses
    Buffers,
    Vga256,
    Palettes;

  const
    Left = 0;
    Right = 1;
    Shift = 16;

  var
    BackGround: Byte;

  procedure InitBackGr (NewBackGr, bClouds: Byte);
  procedure DrawBackGr (FirstTime: Boolean);
  procedure DrawBackGrMap (Y1, Y2, Shift: Integer; C: Byte);
  procedure StartClouds;
  procedure DrawPalBackGr;
  procedure ReadColorMap;
  procedure DrawBricks (X, Y, W, H: Integer);
  procedure LargeBricks (X, Y, W, H: Integer);
  procedure Pillar (X, Y, W, H: Integer);
  procedure Windows (X, Y, W, H: Integer);
  procedure DrawBackGrBlock (X, Y, W, H: Integer);
  procedure SmoothFill (X, Y, W, H: Integer);

implementation

  {$I PALBRICK.$00}
  {$I PALPILL.$00}
  {$I PALPILL.$01}
  {$I PALPILL.$02}

  {$I BOGEN.BK}
  {$I BOGEN7.BK}
  {$I BOGEN26.BK}
  {$I MOUNT.BK}

  const
    Speed = 3;
    BrickSpeed = 2;
    Max = (MaxWorldSize div Speed) * W;
    Height = 26;  { 7, 15, 20, 21, 23, 24, 26 }
    CloudSpeed = 4;
    MaxClouds = 7;
    MinCloudSize = 30;
    MaxCloudSize = 70;
    CloudHeight = 19;

  var
    BackGrMap: array [0 .. Max] of Byte;
    ColorMap: array [0 .. NV * H - 1] of Word;
    CloudMap: array [1 .. 2 * MaxClouds, 0 .. 1] of Integer;
    Clouds: Byte;


  procedure InitClouds;
  var
    i, j, Tmp0, Tmp1: Integer;
  begin
  {
    RandSeed := 18;
    for i := 1 to MaxClouds do
      CloudMap [i, 0] := Random (W * (MaxWorldSize div CloudSpeed) - MaxCloudSize);
    RandSeed := 2;
    for i := 1 to MaxClouds do
      CloudMap [i, 1] := Random (Options.Horizon - Height - CloudHeight);
    for i := 1 to MaxClouds do
      for j := i to MaxClouds do
      if CloudMap [j, 0] < CloudMap [i, 0] then
      begin
        Tmp0 := CloudMap [i, 0];
        Tmp1 := CloudMap [i, 1];
        CloudMap [i] := CloudMap [j];
        CloudMap [j, 0] := Tmp0;
        CloudMap [j, 1] := Tmp1;
      end;
    RandSeed := 6;
    for i := 1 to MaxClouds do
    begin
      CloudMap [i + MaxClouds, 0] := CloudMap [i, 0] + MinCloudSize +
        Random (MaxCloudSize - MinCloudSize);
      CloudMap [i + MaxClouds, 1] := CloudMap [i, 1];
    end;
  }
    CloudMap [1, 0] :=   50; CloudMap [1, 1] :=  58; CloudMap [MaxClouds + 1, 0] :=   92;
    CloudMap [2, 0] :=  180; CloudMap [2, 1] :=  20; CloudMap [MaxClouds + 2, 0] :=  228;
    CloudMap [3, 0] :=  430; CloudMap [3, 1] :=  40; CloudMap [MaxClouds + 3, 0] :=  484;
    CloudMap [4, 0] :=  570; CloudMap [4, 1] :=  15; CloudMap [MaxClouds + 4, 0] :=  600;
    CloudMap [5, 0] :=  840; CloudMap [5, 1] :=  30; CloudMap [MaxClouds + 5, 0] :=  900;
    CloudMap [6, 0] :=  980; CloudMap [6, 1] :=  60; CloudMap [MaxClouds + 6, 0] := 1040;
    CloudMap [7, 0] := 1200; CloudMap [7, 1] :=  20; CloudMap [MaxClouds + 7, 0] := 1240;
  end;

  procedure TraceCloud (X, Y, N: Integer; Dir, Attr, Ovr: Byte);
  var
    Min,
    Max: Integer;
    Ok: Byte;
  begin
    asm
          jmp     @Start

    @PutList:     { SI = Offset, AH = Count }
          mov     Ok, 0
          push    ax
          segcs   lodsw
          add     di, ax
          push    cx
          push    di
    @@0:  seges   mov     al, [di]
          cmp     al, bl
          jnz     @@1
          cmp     di, Min
          jb      @@2
          cmp     di, Max
          ja      @@2
          seges   mov     [di], dl
          mov     Ok, 1
          jmp     @@1
    @@2:  cmp     Ok, 1
          jnz     @@1
          jmp     @@3
    @@1:  inc     di
          dec     cx
          jnz     @@0
    @@3:  pop     di
          add     di, 320
          pop     cx
          pop     ax
          add     Min, 320
          add     Max, 320
          dec     ah
          jnz     @PutList
          retn

    @Start:
          push    es
          mov     ax, VGA_SEGMENT
          mov     es, ax
          cld
          mov     bx, 320
          mov     ax, Y
  {        add     ax, WindowY }
          mul     bx
          push    ax
          add     ax, XView
          mov     Min, ax
          mov     Max, ax
          pop     ax
          add     Max, 320 - 1
          add     ax, X
          mov     di, ax
          mov     dl, Attr

          cmp     Dir, Right
          jz      @Right
    @Left:
          call    @GetLeftList

          dw      9, -3, -2, -1, -1, -1, 0, -1, 0, 0, 0, 0, 1
          dw      0, 1, 1, 1, 2, 3

    @GetLeftList:
          pop     si
          mov     ah, 19
          mov     bl, Ovr
          mov     cx, N
          jcxz    @End
          call    @PutList
          jmp     @End

    @Right:
          call    @GetRightList

          dw      0, 3, 2, 1, 1, 1, 0, 1, 0, 0, 0, 0, -1, 0, -1
          dw      -1, -1, -2, -3

    @GetRightList:
          pop     si
          mov     ah, 19
          mov     bl, Ovr
          mov     cx, N
          jcxz    @End
          call    @PutList
    @End:
          pop     es
    end;
  end;

  procedure PutClouds (Offset, N: Integer);
  var
    i, X1, X2, Y: Integer;
    Attr, Ovr, Size, XSize: Byte;
  begin
    if Clouds = 0 then Exit;
    i := 1;
    repeat
      Attr := Clouds;
      Ovr := $E0;
      X1 := XView - Offset + CloudMap [i, 0];
      X2 := XView - Offset + CloudMap [i + MaxClouds, 0];
      XSize := X2 - X1 + 1;
      Y := CloudMap [i, 1];

      if N > 0 then
      begin
        Size := 0;
        if X2 + 10 >= XView + NH * W then Size := 10;
        if (X2 + 10 > XView) and (X2 < XView + NH * W + 10) then
          TraceCloud (X2 - N - Size, Y, N + Size, Right, Attr, Ovr);
        if (X1 + 10 > XView) and (X1 < XView + NH * W) then
        begin
          TraceCloud (X1 - N, Y, N, Left, Ovr, Attr);
          if not (X2 < XView + NH * W) then
            TraceCloud (X1, Y, XSize, Left, Attr, Ovr);
        end;
      end;
      if N < 0 then
      begin
        if (X2 + 10 > XView) and (X2 < XView + NH * W + 10) then
        begin
          TraceCloud (X2, Y, - N, Right, Ovr, Attr);
          if not (X1 > XView - 10) then
            TraceCloud (X2 - XSize, Y, XSize, Right, Attr, Ovr);
        end;
        Size := 0;
        if X1 < XView + 10 then Size := 10;
        if (X1 + 10 > XView) and (X1 < XView + NH * W + 10) then
          TraceCloud (X1, Y, - N + Size, Left, Attr, Ovr);
      end;

      Inc (i);
    until (i > MaxClouds);
  end;

  procedure StartClouds;
  var
    i: Integer;
  begin
    if Clouds = 0 then Exit;
    for i := XView + MaxCloudSize downto XView do
    begin
      XView := i;
      PutClouds (i div CloudSpeed, -CloudSpeed);
    end;
  end;

  procedure InitBackGr (NewBackGr, bClouds: Byte);
  var
    i, j, h: Integer;
    X, Y, Z: Real;
    F: Text;
  begin
    BackGround := NewBackGr;
    case BackGround of
      1, 2:
         begin

  {         RandSeed := 0;
           FillChar (BackGrMap, SizeOf (BackGrMap), 0);
           X := Pi / 4;
           h := 6 + Random (Height - 5);
           for i := 0 to Max do
           begin
             j := Round (Sqrt (H) * Sqrt (Abs (Round (h * Sin (X)))));
             if BackGrMap [i] < j then
               BackGrMap [i] := j;
             if j = 0 then
             begin
               h := 5 + Random (Height - 4);
               Dec (i, 1 + Random (Round (0.5 * Height)));
               if i < 0 then i := 0;
             end;
             X := X + (Pi / (2.75 * h));
           end;

           assign (F, 'BOGEN26');
           rewrite (F);
           write (F, 'A'#24);
           for i := 0 to Max do
             Write (F, chr (BackGrMap[i]));
           close (F); }

           move (@BOGEN^, BackGrMap, SizeOf (BackGrMap));
         end;
      3: begin
         {
           RandSeed := $FF;
           FillChar (BackGrMap, SizeOf (BackGrMap), #0);
           j := 0;
           Y := 1/3;
           X := Height / 2;
           for i := 0 to Max do
           begin
             X := X + Y;
             if Y <> 0 then
               if (X + Y >= Height) or (X + Y <= 1) or (Random (100) > 94) then
               begin
                 j := Random (3) + 3;
                 Z := - Y * (10 + Random (1)) / ((10 + Random (1)));
                 Y := 0;
               end;
             if j > 0 then
             begin
               Dec (j);
               if j = 0 then
                 Y := Z;
             end;
             BackGrMap [i] := Round (X);
           end;
         }
           move (@MOUNT^, BackGrMap, SizeOf (BackGrMap));
         end;
      9: move (@BOGEN7^, BackGrMap, SizeOf (BackGrMap));
     10: move (@BOGEN26^, BackGrMap, SizeOf (BackGrMap));


    end;
    if BackGround in [1, 9, 10] then
      for i := 0 to Max do
        BackGrMap [i] := Height - BackGrMap [i] + 1;

    Clouds := bClouds;
    if Clouds <> 0 then
      InitClouds;
  end;

  procedure PutBackGr (var Map; Fill: Boolean);
    var
      Y,
      PageOffset,
      X1, X2, XPos, X1Pos, X2Pos,
      DX,
      OldXView,
      XStart, OldXStart,
      Count: Integer;
      Bank: Byte;

  begin
    PageOffset := GetPageOffset;
    OldXView := LastXView[CurrentPage];
    Y := PageOffset + (Options.Horizon - HEIGHT) * BYTES_PER_LINE;
    X1 := Y + XView div 4;
    X2 := Y + (XView + NH * W) div 4;
    Bank := XView and 3;
    DX := XView - OldXView;
    XPos := XView;
    X1Pos := XView;
    X2Pos := OldXView + NH * W - 1;
    if DX < 0 then
    begin
      X1Pos := OldXView;
      X2Pos := XView + NH * W - 1;
    end;
    XStart := XView div Speed;
    OldXStart := OldXView div Speed + DX;
    asm
          push    ds
          push    es
          mov     ax, VGA_SEGMENT
          mov     es, ax
          lds     si, Map
          cld
          mov     Count, 4
    @1:   mov     cl, Bank
          mov     ah, 1
          shl     ah, cl
          mov     al, MAP_MASK
          mov     dx, SC_INDEX
          out     dx, ax
          mov     ah, cl
          mov     al, READ_MAP
          mov     dx, GC_INDEX
          out     dx, ax
          mov     dx, XPos
          mov     al, $F0
          mov     di, X1
          mov     cx, OldXStart
          mov     bx, XStart
    @4:   push    bx
          push    cx
          push    dx
          push    di
          mov     ah, [bx + si]  { new position }
          mov     bx, cx
          mov     cl, [bx + si]  { old position }
          mov     ch, 0
          cmp     Fill, 0
          jnz     @Fill
          cmp     dx, X1Pos
          jb      @Fill
          cmp     dx, X2Pos
          ja      @Fill
          cmp     ah, cl
          jz      @5
          jl      @8
    @6:   push    ax
          mov     ax, BYTES_PER_LINE
          mul     cx
          add     di, ax
          pop     ax
    @7:   seges   cmp     [di], al
          jnz     @@2
          sub     al, $10
          seges   mov     [di], al
          add     al, $10
    @@2:  add     di, BYTES_PER_LINE
          inc     cl
          cmp     cl, ah
          jb      @7
          jmp     @5
    @8:   push    ax
          mov     bx, BYTES_PER_LINE
          mov     al, ah
          mov     ah, 0
          mul     bx
          add     di, ax
          pop     ax
    @9:   sub     al, $10
          seges   cmp     [di], al
          pushf
          add     al, $10
          popf
          jnz     @@1
          seges   mov     [di], al
    @@1:  add     di, BYTES_PER_LINE
          inc     ah
          cmp     ah, cl
          jb      @9
    @5:   pop     di
          pop     dx
          pop     cx
          pop     bx
          add     bx, 4
          add     cx, 4
          add     dx, 4
          inc     di
          cmp     di, X2
          jb      @4
    @2:   inc     Bank
          cmp     Bank, 4
          jnz     @3
          and     Bank, 3
          inc     X1
          inc     X2
    @3:   inc     OldXStart
          inc     XStart
          inc     XPos
          dec     Count
          jnz     @1
          pop     es
          pop     ds
          jmp     @Exit

    @Fill:
          push    bx
          push    cx
          mov     cl, ch
          mov     ch, 0
          mov     bl, ah
          mov     bh, 0
    @@5:  cmp     cx, HEIGHT
          ja      @@3
          cmp     cx, bx
          jb      @@4
          sub     al, $10
          seges   cmp     [di], al
          pushf
          add     al, $10
          popf
          jnz     @@7
          seges   mov     [di], al
    @@7:  add     di, BYTES_PER_LINE
          inc     cx
          jmp     @@5
    @@4:  seges   cmp     [di], al
          jnz     @@6
          sub     al, $10
          seges   mov     [di], al
          add     al, $10
    @@6:  add     di, BYTES_PER_LINE
          inc     cx
          jmp     @@5
    @@3:  pop     cx
          pop     bx
          jmp     @5

    @Exit:
    end;
  end;

  (*
  const
    CheckCode = 16;  { Don't draw background where this code is found }
  var
    Top,
    Check: Word;
  begin
    Exit;
    Top := Options.Horizon - Height;
    Check := XView + (NV * H {+ WindowY}) * 320;  { Check code here }
    asm
          push    es
          push    ds
          mov     bx, 320
          mov     ax, Top
  {        add     ax, WindowY }
          mul     bx
          add     ax, XView
          mov     di, ax
          mov     ax, VidMemSeg
          mov     es, ax
          lds     si, Image
          cld
          mov     cx, 320
          mov     bx, Check

    @1:   push    cx
          push    di

          lodsb
          push    si
          push    bx

          seges
          cmp     Byte Ptr [bx], 0
          jnz     @5

          mov     ch, al
          mov     cl, Height
          sub     cl, ch       { cl: sky }
          mov     bl, Height
          sub     bl, al
          mov     ax, 320