Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MCGA#06.ZIP/LESSON06.TXT

Text File | 1992-06-09 | 8.5 KB | 432 lines

                           MCGA Graphics Tutorial
                                 Lesson #6
                                by Jim Cook

I am including the MCGALIB source we have developed so far in this
tutorial.

Unit MCGALib;

interface

type
  PCXHeaderPtr=  ^PCXHeader;
  PCXHeader   =  record
                   Signature      :  Char;
                   Version        :  Char;
                   Encoding       :  Char;
                   BitsPerPixel   :  Char;
                   XMin,YMin,
                   XMax,YMax      :  Integer;
                   HRes,VRes      :  Integer;
                   Palette        :  Array [0..47] of byte;
                   Reserved       :  Char;
                   Planes         :  Char;
                   BytesPerLine   :  Integer;
                   PaletteType    :  Integer;
                   Filler         :  Array [0..57] of byte;
                 end;

  PointerType =  array [0..65500] of byte;
  NewPointer  =  ^PointerType;

var
  ScreenWide  :  Integer;

Procedure SetGraphMode (Num:Byte);
Procedure SetPixel     (X,Y:Integer;Color:Byte);
Function  GetPixel     (X,Y:Integer) : Word;
Procedure ClearScreen  (Color:Byte);
Procedure Line         (X1,Y1,X2,Y2:Integer;Color:Byte);
Procedure Box          (X1,Y1,X2,Y2:Integer;Color:Byte);

Procedure DisplayPCX   (X,Y:Integer;Buf:Pointer);

Function  ImageSize    (X1,Y1,X2,Y2:Integer) : Word;
Procedure GetImagePas  (X1,Y1,X2,Y2:Integer;P:Pointer);
Procedure PutImagePas  (X1,Y1:Integer;P:Pointer);

implementation

var
  ScreenAddr  :  Word;

Procedure SetGraphMode (Num:Byte);
begin
  asm
    mov al,Num
    mov ah,0
    int 10h
    end;
  Case Num of
    $13 : ScreenWide := 320;
    end;
  ScreenAddr := $A000;
end;

Procedure SetPixel (X,Y:Integer;Color:Byte);
begin
  asm
    push ds
    mov  ax,ScreenAddr
    mov  ds,ax

    mov  ax,Y
    mov  bx,320
    mul  bx
    mov  bx,X
    add  bx,ax

    mov  al,Color
    mov  byte ptr ds:[bx],al
    pop  ds
    end;
end;

Function GetPixel (X,Y:Integer) : Word;
begin
  asm
    push ds
    mov  ax,ScreenAddr
    mov  ds,ax

    mov  ax,Y
    mov  bx,320
    mul  bx
    mov  bx,X
    add  bx,ax

    xor  ax,ax
    mov  al,byte ptr ds:[bx]
    mov  @Result,ax
    pop  ds
    end;
end;

Procedure ClearScreen (Color:Byte);
begin
  asm
    push es
    mov  ax,ScreenAddr
    mov  es,ax

    xor  di,di

    cld

    mov  al,Color
    mov  cx,320*200

    rep  stosb

    pop  es
    end;
end;

Procedure HorzLine (X1,X2,Y1:Integer;Color:Byte);
var
  Temp   :  Integer;
begin
  If X1 > X2 then begin
    Temp := X1;
    X1   := X2;
    X2   := Temp;
    end;
  asm
    push es
    mov  ax,ScreenAddr
    mov  es,ax               { Point es to screen segment }

    mov  ax,Y1               { Calculate starting video memory location }
    mov  di,ScreenWide
    mul  di                  { Multiply row number by width of screen }
    mov  di,X1
    add  di,ax               { Add to that result the X value }
                             { Result: es:di -> first pixel to draw }
    mov  cx,X2
    sub  cx,X1
    inc  cx                  { cx = number of pixels to draw }

    cld
    mov  al,Color            { put the color in al }

    rep  stosb               { use a fast 8088 instruction to store al }

    pop  es
    end;
end;

Procedure VertLine (X1,Y1,Y2:Integer;Color:Byte);
var
  Temp   :  Integer;
begin
  If Y1 > Y2 then begin
    Temp := Y1;
    Y1   := Y2;
    Y2   := Temp;
    end;
  asm
    push es
    mov  ax,ScreenAddr
    mov  es,ax               { Point es to screen segment }

    mov  ax,Y1               { Calculate starting video memory location }
    mov  di,ScreenWide
    mul  di                  { Multiply row number by width of screen }
    mov  di,X1
    add  di,ax               { Add to that result the X value }
                             { Result: es:di -> first pixel to draw }
    mov  cx,Y2
    sub  cx,Y1
    inc  cx                  { cx = number of pixels to draw }

    mov  al,Color            { put the color in al }

@Loop1:
    mov  es:[di],al
    add  di,ScreenWide
    loop @Loop1

    pop  es
    end;
end;

Procedure Line (X1,Y1,X2,Y2:Integer;Color:Byte);
var
  I,
  YIncr,
  D,DX,DY,
  AIncr,BIncr :  Integer;
  Ofs         :  Word;
begin                                  { uses Bresenham's algorithm for }
  If X1 = X2 then begin                { drawing a line.  Very fast for }
    VertLine (X1,Y1,Y2,Color);         { little ol' Pascal              }
    Exit;
    end;
  If Y1 = Y2 then begin
    HorzLine (X1,X2,Y2,Color);
    Exit;
    end;
  If X1 > X2 then begin
    D  := X1;
    X1 := X2;
    X2 := D;
    D  := Y1;
    Y1 := Y2;
    Y2 := D;
    end;
  If Y2 > Y1 then YIncr :=  320
             else YIncr := -320;
  DX := X2 - X1;
  DY := Abs (Y2-Y1);
  D := 2 * DY - DX;
  AIncr := 2 * (DY - DX);
  BIncr := 2 * DY;


  Ofs := Word(Y1) * 320 + Word(X1);

  Mem [$A000:Ofs] := Color;

  For I := X1 + 1 to X2 do begin
    If D >= 0 then begin
      Inc (Ofs,YIncr);
      Inc (D,AIncr);
      end
    Else Inc (D,BIncr);
    Inc (Ofs);
    Mem [$A000:Ofs] := Color;
    end;
end;

Procedure Box (X1,Y1,X2,Y2:Integer;Color:Byte);
var
  Y :  Integer;
begin
  For Y := Y1 to Y2 do
    HorzLine (X1,X2,Y,Color);
end;

Procedure ExtractLineASM (BytesWide:Integer;Var Source,Dest:Pointer);
var
  DestSeg,
  DestOfs,
  SourceSeg,
  SourceOfs   :  Word;
begin
  SourceSeg := Seg (Source^);
  SourceOfs := Ofs (Source^);
  DestSeg   := Seg (Dest^);
  DestOfs   := Ofs (Dest^);

  asm
    push  ds
    push  si

    mov   ax,DestSeg
    mov   es,ax
    mov   di,DestOfs     { es:di -> destination pointer }
    mov   ax,SourceSeg
    mov   ds,ax
    mov   si,SourceOfs   { ds:si -> source buffer }

    mov   bx,di
    add   bx,BytesWide   { bx holds position to stop for this row }
    xor   cx,cx

    cld

  @@GetNextByte:
    cmp   bx,di          { are we done with the line }
    jbe   @@ExitHere

    lodsb                { al contains next byte }

    mov   ah,al
    and   ah,0C0h
    cmp   ah,0C0h
    jne   @@SingleByte
                         { must be a run of bytes }
    mov   cl,al
    and   cl,3Fh
    lodsb
    rep   stosb
    jmp   @@GetNextByte

  @@SingleByte:
    stosb
    jmp   @@GetNextByte

  @@ExitHere:
    mov   SourceSeg,ds
    mov   SourceOfs,si
    mov   DestSeg,es
    mov   DestOfs,di

    pop   si
    pop   ds
  end;

  If Odd(BytesWide) then Source := Ptr (SourceSeg,SourceOfs+2)
                    else Source := Ptr (SourceSeg,SourceOfs);

  Dest := Ptr (DestSeg,DestOfs);
end;

Procedure DisplayPCX (X,Y:Integer;Buf:Pointer);
var
  I,NumRows,
  BytesWide   :  Integer;
  Header      :  PCXHeaderPtr;
  DestPtr     :  Pointer;
  Offset      :  Word;
begin
  Header    := Ptr (Seg(Buf^),Ofs(Buf^));
  Buf       := Ptr (Seg(Buf^),Ofs(Buf^)+128);
  Offset    := Y * 320 + X;
  NumRows   := Header^.YMax - Header^.YMin + 1;
  BytesWide := Header^.XMax - Header^.XMin + 1;
  If Odd (BytesWide) then Inc (BytesWide);

  For I := 1 to NumRows do begin
    DestPtr := Ptr ($A000,Offset);
    ExtractLineASM (BytesWide,Buf,DestPtr);
    Inc (Offset,320);
    end;
end;

Function ImageSize (X1,Y1,X2,Y2:Integer) : Word;
begin
  ImageSize := Word(Y2 - Y1 + 1) * Word(X2 - X1 + 1) + 4;
end;

Procedure GetImageAsm (X1,Y1,X2,Y2:Integer;P:Pointer); assembler;
asm
    mov  bx,ScreenWide
    push ds
    les  di,P

    cld

    mov  ax,0A000h
    mov  ds,ax
    mov  ax,Y1
    mov  dx,320
    mul  dx
    add  ax,X1
    mov  si,ax

    mov  ax,X2
    sub  ax,X1
    inc  ax
    mov  dx,ax
    stosw

    mov  ax,Y2
    sub  ax,Y1
    inc  ax
    stosw
    mov  cx,ax

  @@1:
    mov  cx,dx

    shr  cx,1
    rep  movsw

    test dx,1
    jz   @@2
    movsb
  @@2:
    add  si,bx
    sub  si,dx

    dec  ax
    jnz  @@1

    pop  ds
end;

Procedure PutImageAsm (X1,Y1:Integer;P:Pointer); assembler;
asm
    mov  bx,ScreenWide
    push ds
    lds  si,P

    cld

    mov  ax,0A000h
    mov  es,ax
    mov  ax,Y1
    mov  dx,320
    mul  dx
    add  ax,X1
    mov  di,ax

    lodsw
    mov  dx,ax

    lodsw

  @@1:
    mov  cx,dx

    shr  cx,1
    rep  movsw

    test dx,1
    jz   @@2
    movsb
  @@2:
    add  di,bx
    sub  di,dx

    dec  ax
    jnz  @@1

    pop  ds
end;

Begin
End.