fpc/rtl/dos/ppi/image.ppi

{
    $Id$
    This file is part of the Free Pascal run time library.
    Copyright (c) 1993,97 by the Free Pascal development team.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

procedure GetImage(x1,y1,x2,y2 : integer;var BitMap);

var
  i,linesize,target  : longint;
  ofs1,ofs2,bank1,bank2,diff : longint;
begin
  _graphresult:=grOk;
  if not isgraphmode then
  begin
    _graphresult:=grnoinitgraph;
    exit;
  end;         

x1:=x1+aktviewport.x1;
y1:=y1+aktviewport.y1;
x2:=x2+aktviewport.x1;
y2:=y2+aktviewport.y1;

if (x1>_maxx) or (y1>_maxy) or (x2<0) or (y2<0) then exit;

target:=longint(@bitmap)+4;
pinteger(@bitmap)^:=x2-x1+1;
pinteger(@bitmap+2)^:=y2-y1+1;
linesize:=(x2-x1+1)*BytesPerPixel;

for i:=y1 to y2 do
  begin
    ofs1:=Y_ARRAY[i]+X_ARRAY[x1];
    ofs2:=Y_ARRAY[i]+X_ARRAY[x2];
    bank1:=ofs1 shr WinShift;
    bank2:=ofs2 shr WinShift;
    if bank1 <> A_BANK then
      begin
        Switchbank(bank1);
      end;
    if bank1=bank2
      then ScreenToMem(ofs1 and WinLoMask,target,linesize)
      else begin
        diff:=(bank2 shl winshift)-ofs2;
        ScreenToMem(ofs1 and WinLoMask,target,diff-BytesPerPixel);
        Switchbank(bank2);
        ScreenToMem((ofs1+diff) and WinLoMask,target+diff,linesize-diff);
      end; 
    target:=target+linesize;
  end;
end;

procedure PutImage(x,y : integer;var BitMap;BitBlt : word);

      var
         height,width : integer;
         diff         : integer;
         increment,i  : longint;
         source,o1,o2 : longint;
         offset       : longint;
         viewport     : viewporttype;
      begin
         _graphresult:=grOk;
         if not isgraphmode then
           begin
              _graphresult:=grnoinitgraph;
              exit;
           end;
         
         source:=longint(@bitmap)+4;
         Width:=pinteger(@bitmap)^;
         Increment:=longint(Width);
         height:=pinteger(@bitmap+2)^;
         { wenn ausserhalb des Screens Procedur verlassen }
         x:=x+aktviewport.x1;
         y:=y+aktviewport.y1;
         
         if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen; 
         if (x > viewport.x2 ) or 
             (y > viewport.y2 ) or
              (x+Increment < viewport.x1) or 
               (y+height < viewport.y1) then exit;
  
           { Clip oben }
           if y < viewport.y1 then 
             begin
               diff:=viewport.y1-y;
               height:=height-diff;
               source:=source+Increment*diff;
               y:=viewport.y1;
             end;
           { Clip unten }
           
           if y+height > viewport.y2 then
               height:=viewport.y2-y;
           
           { Clip links }
           if x < viewport.x1 then 
             begin
               diff:=viewport.x1-x;
               Width:=Increment-diff;
               source:=source+diff;
               x:=viewport.x1;
             end;
           
           { clip rechts }
           if x+width > viewport.x2 then 
             begin
               diff:=x+width-viewport.x2;
               Width:=Increment-diff;
             end;
          
 Increment:=Increment*BytesPerPixel;
 Width:=Width*BytesPerPixel;  
 for i:=y to y+height-1 do
   begin
     offset:=Y_ARRAY[i] + X_ARRAY[x];
     o1:=offset shr winshift;
     o2:=( offset + width ) shr winshift;
     if o1 <> A_BANK then
       begin
         Switchbank(o1);
       end;
     if o1 = o2 then
     begin  
       case bitblt of
         normalput : MemToScreen (source,offset and WinLoMask,width);
         andput    : MemAndScreen(source,offset and WinLoMask,width);
         orput     : MemOrScreen (source,offset and WinLoMask,width);
         xorput    : MemXorScreen(source,offset and WinLoMask,width);
         notput    : MemNotScreen(source,offset and WinLoMask,width);
       end;
     end else begin
     { Bankswitching }
       diff:=((o2 shl winshift)-offset);
       case bitblt of
         normalput : begin
                      MemToScreen (source,offset and WinLoMask,diff-BytesPerPixel);
                      Switchbank(o2);
                      MemToScreen (source+diff,(offset+diff) and WinLoMask,width-diff);
                     end;
         andput    : begin
                      MemAndScreen (source,offset and WinLoMask,diff-BytesPerPixel);
                      Switchbank(o2);
                      MemAndScreen (source+diff,(offset+diff) and WinLoMask,width-diff);
                     end;
         orput     : begin
                      MemOrScreen (source,offset and WinLoMask,diff-BytesPerPixel);
                      Switchbank(o2);
                      MemOrScreen (source++diff,(offset+diff) and WinLoMask,width-diff);
                     end;
         xorput    : begin
                      MemXorScreen(source,offset and WinLoMask,diff-BytesPerPixel);
                      Switchbank(o2);
                      MemXorScreen(source+diff,(offset+diff) and WinLoMask,width-diff);
                     end;
         notput    : begin
                      MemNotScreen(source,offset and WinLoMask,diff-BytesPerPixel);
                      Switchbank(o2);
                      MemNotScreen(source+diff,(offset+diff) and WinLoMask,width-diff);
                     end;
       end; { case }
     end; { else }
     source:=source+Increment;
 end; { for i }
 { clear the mmx state }
 if is_mmx_cpu then
   emms;
end;
    
    
    function ImageSize(x1,y1,x2,y2 : integer) : longint;

      begin
         _graphresult:=grOk;
         ImageSize:=(x2-x1+1)*(y2-y1+1)*BytesPerPixel+4;
         { 4 bytes for Height and width in words at the beginning }
      end;

 

{
  $Log$
  Revision 1.2  1998-11-18 09:31:36  pierre
    * changed color scheme
      all colors are in RGB format if more than 256 colors
    + added 24 and 32 bits per pixel mode
      (compile with -dDEBUG)
      24 bit mode with banked still as problems on pixels across
      the bank boundary, but works in LinearFrameBufferMode
      Look at install/demo/nmandel.pp

  Revision 1.1.1.1  1998/03/25 11:18:42  root
  * Restored version

  Revision 1.5  1998/03/03 22:48:42  florian
    + graph.drawpoly procedure
    + putimage with xorput uses mmx if available

  Revision 1.4  1998/01/26 11:58:14  michael
  + Added log at the end


  
  Working file: rtl/dos/ppi/image.ppi
  description:
  ----------------------------
  revision 1.3
  date: 1997/12/19 11:47:08;  author: florian;  state: Exp;  lines: +3 -3
  *** empty log message ***
  ----------------------------
  revision 1.2
  date: 1997/12/01 12:21:30;  author: michael;  state: Exp;  lines: +13 -1
  + added copyright reference in header.
  ----------------------------
  revision 1.1
  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
  Initial revision
  ----------------------------
  revision 1.1.1.1
  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
  FPC RTL CVS start
  =============================================================================
}