Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MCGA#07.ZIP/MCGA07.PAS

Pascal/Delphi Source File | 1992-06-12 | 9.5 KB | 493 lines

Unit MCGA07;

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  :  Word;

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);
Procedure GetImageAsm  (X1,Y1,X2,Y2:Integer;P:Pointer);
Procedure PutImageAsm  (X1,Y1:Integer;P:Pointer);

implementation

var
  ScreenAddr  :  Word;

Procedure Move (Var Source,Dest;Count:Word);
begin
  asm
    push ds
    cld
    lds  si,Source
    les  di,Dest
    mov  cx,Count
    shr  cx,1
    rep  movsw

    mov  cx,Count
    test cl,1
    jz   @@EvenCount
    movsb

  @@EvenCount:
    pop  ds
  end;
end;

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 }

    cld

    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 }

    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

    cld

    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

  @@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;

  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 GetImagePas (X1,Y1,X2,Y2:Integer;P:Pointer);
var
  I           :  Integer;
  Count,
  ScnPos,
  Wide,High   :  Word;
  Buf         :  NewPointer absolute P;
begin
  Wide   := (X2 - X1) + 1;
  High   := (Y2 - Y1) + 1;
  ScnPos := (Y1 * 320) + X1;
  Count  := 4;

  Move (Wide,Buf^[0],SizeOf(Wide));
  Move (High,Buf^[2],SizeOf(High));

  For I := Y1 to Y2 do begin
    Move (Mem[$A000:ScnPos],Buf^[Count],Wide);
    Inc (ScnPos,ScreenWide);
    Inc ( Count,Wide);
    end;
end;

Procedure PutImagePas (X1,Y1:Integer;P:Pointer);
var
  I           :  Integer;
  Count,
  ScnPos,
  Wide,High   :  Word;
  Buf         :  NewPointer absolute P;
begin
  ScnPos := (Word(Y1) * 320) + Word(X1);
  Count  := 4;

  Move (Buf^[0],Wide,SizeOf(Wide));
  Move (Buf^[2],High,SizeOf(High));

  For I := 1 to High do begin
    Move (Buf^[Count],Mem[$A000:ScnPos],Wide);
    Inc (ScnPos,ScreenWide);
    Inc ( Count,Wide);
    end;
end;

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

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

    cld

    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

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

    cld

    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.