vga256.pas

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

unit VGA256;

  {  (C) Copyright 1994-2001, Mike Wiering, e-mail: [e-mail]  }

  {
     Turbo Pascal VGA unit (Mode 13h, 320x200 256 colors), designed
     for side-scrolling games, uses planar mode, page-flipping (2 pages),
     statusline
  }

  {$DEFINE DEBUG}

  {$R-}  { no range-checking }
  {$I-}  { no I/O-checking }
  {$G+}  { allow 286 instructions }

interface

  const
    VGA_SEGMENT           = $A000;

    WINDOWHEIGHT        = 13 * 14;
    WINDOWWIDTH         = 16 * 20;

    SCREEN_WIDTH        = 320;
    SCREEN_HEIGHT       = 200;

    VIR_SCREEN_WIDTH    = SCREEN_WIDTH + 2 * 20;
    VIR_SCREEN_HEIGHT   = 182;
    BYTES_PER_LINE      = VIR_SCREEN_WIDTH div 4;

    MISC_OUTPUT         = $03C2;
    SC_INDEX            = $03C4;
    GC_INDEX            = $03CE;
    CRTC_INDEX          = $03D4;
    VERT_RESCAN         = $03DA;

    MAP_MASK            = 2;
    MEMORY_MODE         = 4;

    VERT_RETRACE_MASK   = 8;

    MAX_SCAN_LINE       = 9;
    START_ADDRESS_HIGH  = $C;
    START_ADDRESS_LOW   = $D;
    UNDERLINE           = $14;
    MODE_CONTROL        = $17;

    READ_MAP            = 4;
    GRAPHICS_MODE       = 5;
    MISCELLANEOUS       = 6;

    MAX_SCREENS         = 24;
    MAX_PAGE            = 1;
    PAGE_SIZE           = (VIR_SCREEN_HEIGHT + MAX_SCREENS) * BYTES_PER_LINE;
    PAGE_0              = 0;
    PAGE_1              = $8000;

    YBASE               = 9;

  function DetectVGA: Boolean;
  procedure InitVGA;
  procedure OldMode;
  function GetMode: Byte;
  procedure SetMode (NewMode: Byte);
  procedure ClearVGAMem;
  procedure WaitDisplay;
  procedure WaitRetrace;
  procedure SetView (X, Y: Integer);
  procedure SetViewport (X, Y: Integer; PageNr: Byte);
  procedure SwapPages;
  procedure ShowPage;
  procedure Border (Attr: Byte);
  procedure SetYStart (NewYStart: Integer);
  procedure SetYEnd (NewYEnd: Integer);
  procedure SetYOffset (NewYOffset: Integer);
  function GetYOffset: Integer;
  procedure PutPixel (X, Y: Integer; Attr: Byte);
  function GetPixel (X, Y: Integer): Byte;
  procedure DrawImage (XPos, YPos, Width, Height: Integer; var BitMap);
  procedure RecolorImage (XPos, YPos, Width, Height: Integer; var BitMap; Diff: Byte);
  procedure DrawPart (XPos, YPos, Width, Height, Y1, Y2: Integer; var BitMap);
  procedure UpSideDown (XPos, YPos, Width, Height: Integer; var BitMap);
  procedure PutImage (XPos, YPos, Width, Height: Integer; var BitMap);
  procedure GetImage (XPos, YPos, Width, Height: Integer; var BitMap);
  procedure Fill (X, Y, W, H: Integer; Attr: Integer);
  procedure SetPalette (Color, Red, Green, Blue: Byte);
  procedure ReadPalette (var NewPalette);
  procedure ClearPalette;
  function CurrentPage: Integer;
  function GetPageOffset: Word;
  procedure ResetStack;
  function PushBackGr (X, Y, W, H: Integer): Word;
  procedure PopBackGr (Address: Word);
  procedure DrawBitmap (X, Y: Integer; var BitMap; Attr: Byte);

  const
    InGraphicsMode: Boolean = FALSE;

implementation

  var
    OldExitProc: Pointer;
    OldScreenMode: Byte;

  const
    XView: Integer = 0;
    YView: Integer = 0;

    Page: Integer = 0;
    PageOffset: Word = 0;

    YOffset: Integer = 0;

    SAFE = 34 * BYTES_PER_LINE;

    Stack: array[0..MAX_PAGE] of Word =
      (PAGE_0 + PAGE_SIZE + SAFE,
       PAGE_1 + PAGE_SIZE + SAFE);


  {$F+}
  procedure NewExitProc;
    { Be sure to return to textmode if program is halted }
  begin
    OldMode;
    ExitProc := OldExitProc;
  end;
  {$F-}

  function GetMode: Byte;
    { Get video mode }
  begin
    asm
        push    bp
        mov     ah, 0Fh
        int     10h
        mov     @Result, al
        pop     bp
    end;
  end;

  procedure SetMode (NewMode: Byte);
    { Set video mode }
  begin
    asm
        push    bp
        xor     ah, ah
        mov     al, NewMode
        int     10h
        pop     bp
    end;
  end;

  procedure SetWidth (NewWidth: Word);
    { Set screen width (NewWidth >= 40) }
  begin
    asm
        mov     ax, NewWidth
        push    ax
        mov     dx, CRTC_INDEX
        mov     ax, 13h
        out     dx, al
        pop     ax
        inc     dx
        out     dx, al
    end;
  end;

  function DetectVGA: Boolean;
    var
      VGADetected: Boolean;
  begin
    VGADetected := False;
    asm
        push    bp
        mov     ax, 1A00h
        int     10h
        cmp     al, 1Ah
        jnz     @NoVGA
        inc     VGADetected
    @NoVGA:
        pop     bp
    end;
    DetectVGA := VGADetected;
  end;

  procedure InitVGA;
    { Start graphics mode 320x200 256 colors }
  begin
    ClearPalette;
    SetMode ($13);
    ClearPalette;
    SetWidth (BYTES_PER_LINE shr 1);
    asm
        mov     dx, SC_INDEX
        mov     al, MEMORY_MODE
        out     dx, al
        inc     dx
        in      al, dx
        and     al, not 8
        or      al, 4
        out     dx, al
        mov     dx, GC_INDEX
        mov     al, GRAPHICS_MODE
        out     dx, al
        inc     dx
        in      al, dx
        and     al, not 10h
        out     dx, al
        dec     dx
        mov     al, MISCELLANEOUS
        out     dx, al
        inc     dx
        in      al, dx
        and     al, not 2
        out     dx, al
    end;
    ClearVGAMem;
    asm
        mov     dx, CRTC_INDEX
        mov     al, UNDERLINE
        out     dx, al
        inc     dx
        in      al, dx
        and     al, not 40h
        out     dx, al
        dec     dx
        mov     al, MODE_CONTROL
        out     dx, al
        inc     dx
        in      al, dx
        or      al, 40h
        out     dx, al
    end;
    if not InGraphicsMode then
    begin
      OldExitProc := ExitProc;
      ExitProc := @NewExitProc;
    end;
    InGraphicsMode := TRUE;
  end;

  procedure OldMode;
    { Return to the original screenmode }
  begin
    if InGraphicsMode then
    begin
      ClearVGAMem;
      ClearPalette;
      ShowPage;
    end;
    SetMode (OldScreenMode);
    InGraphicsMode := FALSE;
    ExitProc := OldExitProc;
  end;

  procedure ClearVGAMem;
  begin
    asm
        push    es
        mov     dx, SC_INDEX
        mov     ax, 0F00h + MAP_MASK
        out     dx, ax
        mov     ax, VGA_SEGMENT
        mov     es, ax
        xor     ax, ax
        mov     di, ax
        mov     cx, 8000h
        cld
        rep     stosw
        pop     es
    end;
  end;

  procedure WaitDisplay;
  begin
    asm
          mov     dx, VERT_RESCAN
  @1:     in      al, dx
          test    al, VERT_RETRACE_MASK
          jnz     @1
    end;
  end;

  procedure WaitRetrace;
  begin
    asm
          mov     dx, VERT_RESCAN
  @1:     in      al, dx
          test    al, VERT_RETRACE_MASK
          jz      @1
    end;
  end;

  procedure SetView (X, Y: Integer);
  begin
    XView := X;
    YView := Y;
  end;

  procedure SetViewport (X, Y: Integer; PageNr: Byte);
    { Set the offset of video memory }
  var
    i: Integer;
  begin
    asm
          cli

          mov     dx, VERT_RESCAN               { wait for display }
  @1:     in      al, dx
          test    al, VERT_RETRACE_MASK
          jnz     @1

          shl     X, 1
          shl     Y, 1
          mov     ax, Y
          mov     bx, BYTES_PER_LINE / 2
          mul     bx
          mov     bx, X
          mov     cl, 3
          shr     bx, cl
          add     bx, ax
          mov     al, START_ADDRESS_HIGH
          mov     ah, PageNr
          ror     ah, 1
          add     ah, bh
          mov     dx, CRTC_INDEX
          out     dx, ax
          mov     al, START_ADDRESS_LOW
          mov     ah, bl
          out     dx, ax

          mov     dx, VERT_RESCAN               { wait for retrace }
  @2:     in      al, dx
          test    al, VERT_RETRACE_MASK
          jz      @2

          mov     ax, X
          and     ax, 7
          add     al, 10h
          mov     dx, 3c0h
          mov     ah, al
          mov     al, 33h
          out     dx, al
          xchg    ah, al
          out     dx, al
          sti
    end;
  end;

  procedure SwapPages;
  begin
    case Page of
      0: begin
           Page := 1;
           PageOffset := PAGE_1 + YOffset * BYTES_PER_LINE;
         end;
      1: begin
           Page := 0;
           PageOffset := PAGE_0 + YOffset * BYTES_PER_LINE;
         end;
    end;
  end;

  procedure ShowPage;
  begin
    SetViewport (XView, YView, Page);
    SwapPages;
  end;

  procedure Border (Attr: Byte);
    { Draw a border around the screen }
  begin
    asm
          push    bp
          mov     ax, 1001h
          mov     bh, Attr
          int     10h
          pop     bp
    end;
  end;

  procedure SetYStart (NewYStart: Integer);
  begin
    asm
          mov     dx, CRTC_INDEX
          mov     al, 16h
          mov     ah, Byte Ptr [NewYStart]
          and     ah, 7Fh
          out     dx, ax
    end;
  end;

  procedure SetYEnd (NewYEnd: Integer);
  begin
    asm
          mov     dx, CRTC_INDEX
          mov     al, 15h
          mov     ah, Byte Ptr [NewYEnd]
          out     dx, ax
    end;
  end;

  procedure SetYOffset (NewYOffset: Integer);
  begin
    YOffset := NewYOffset;
  end;

  function GetYOffset: Integer;
  begin
    GetYOffset := YOffset;
  end;

  procedure PutPixel (X, Y: Integer; Attr: Byte);
    { Draw a single pixel at (X, Y) with color Attr }
  begin
    asm
        push    es
        mov     ax, VGA_SEGMENT
        mov     es, ax
        mov     dx, Y
        mov     ax, BYTES_PER_LINE
        mul     dx
        mov     cx, X
        push    cx
        shr     cx, 1
        shr     cx, 1
        add     ax, cx
        mov     di, ax
        add     di, PageOffset
        pop     cx
        and     cl, 3
        mov     ah, 1
        shl     ah, cl
        mov     al, MAP_MASK
        mov     dx, SC_INDEX
        out     dx, ax
        mov     al, Attr
        stosb
        pop     es
    end;
  end;

  function GetPixel (X, Y: Integer): Byte;
    { Get color of pixel at (X, Y) }
  begin
    asm
        push    es
        mov     ax, VGA_SEGMENT
        mov     es, ax
        mov     dx, Y
        mov     ax, BYTES_PER_LINE
        mul     dx
        mov     cx, X
        push    cx
        shr     cx, 1
        shr     cx, 1
        add     ax, cx
        mov     si, ax
        add     si, PageOffset
        pop     ax
        and     al, 3
        mov     ah, al
        mov     al, READ_MAP
        mov     dx, GC_INDEX
        out     dx, ax
        seges   mov al, [si]
        pop     es
        mov     @Result, al
    end;
  end;

  procedure DrawImage (XPos, YPos, Width, Height: Integer; var BitMap);
    { Draw an image on the screen (NULL-bytes are ignored) }
  begin
    asm
        push    ds

        mov     ax, VGA_SEGMENT
        mov     es, ax

        mov     ax, YPos
        cmp     ax, VIR_SCREEN_HEIGHT
        jb      @NotNeg
        jg      @End
        mov     bx, ax
        add     bx, Height
        jnc     @End
  @NotNeg:
        mov     bx, BYTES_PER_LINE
        mul     bx
        mov     di, XPos
        mov     bx, di
        shr     di, 1
        shr     di, 1
        add     di, ax                  { DI = (YPos * 80) + XPos / 4 }
        add     di, PageOffset

        lds     si, BitMap              { Point to bitmap }

        and     bl, 3
        mov     cl, bl
        mov     ah, 1
        shl     ah, cl
        sub     bl, 4
        mov     cx, 4                   { 4 planes }

  @Plane:
        push    bx
        push    cx                      { Planes to go }
        push    ax                      { Mask in AH }