🚀 go-pugleaf

OK, here are the routines.  Admittedly, they aren't the world's best routines.
They are limited in what they can do, but they do handle a wide variety of
cases.  I apologize for not commenting it, but the routines were written
in assembly (not inline), and I spent last night converting them to
Turbo Pascal.

Known bugs:
  PutImage <- Don't let the length or width of the image be 0. 
  Scale    <- None that I can tell.
  Perspect <- Two bugs:  You'll find them.  I have come up with a solution
              for both, but haven't implemented it.

Acknowledgements:  The PCX loader comes from QuickC source from a Usenet
post about ModeX.  I can't remember the guy\s name who did it, but I'd
like to credit him anyway.

Please, unless its important, don't email me.  Lets talk about the source
on the net here.  I forbid any flame wars to start because of this.  You 
can knock the source as you will, but it works for me.

Speed up info:  To make it run faster, generate all possible combinations
of XDel and YDel ahead of time.

Runs with a mouse.  Left button exits.  the + and - keys change the 
perspective image.  You'll need a PCX file with a 64 by 64 image starting
at 0,0.  Change this size below in the GetMem, PutImages, and Scale and
Perspective calls.


Filename: Main.Pas

-------------------------------- Cut here -------------------------------------

(******************************************************************************)
(* I officially release the below routines into the public domain.            *)
(* Note that for size, certain lines have been squished together.             *)
(********************************************************* Joshua C. Jensen ***)
uses
  Crt,Scale;

const
  RowWidth : Word = 320;
  O_RDONLY = 0;
  O_WRONLY = 1;
  O_RDWR = 2;
  SEEK_SET = 0;
  SEEK_CUR = 1;
  SEEK_END = 2;

type
  (* PCX Header data type *)
  PCXHeader = record
    Manufacturer : Byte;
    Version : Byte;
    Encoding : Byte;
    BitsPerPixel : Byte;
    Xmin,Ymin,Xmax,Ymax,Hdpi,Vdpi : Integer;
    ColorMap : array[0..15,0..2] of Byte;
    Reserved : Byte;
    Nplanes : Byte;
    BytesPerLine : Integer;
    filler : array[0..59] of Byte;
  end;
  RGB = record
    red,green,blue : Byte;
  end;

var
  Pal : array[0..255] of RGB;
  Image,SImage : pointer;
  xs,ys : Word;

function F_Open(Filename : string; Access : Byte) : Integer; assembler;
asm
  push ds;
  lds dx,Filename;
  inc dx;
  mov ah,$3d;
  mov al,Access;
  int $21;
  jnb @@Exit;
  mov ax,-1;
@@Exit:
  pop ds;
end;

function F_Close(Handle : Integer) : Integer; assembler;
asm
  mov bx,Handle;
  mov ah,3eh;
  int $21;
  jnb @@Fix;
  mov ax,-1;
  jmp @@Done;
@@Fix:
  mov ax,0;
@@Done:
end;

function F_Read(Handle : Integer; var Buffer; Bytes : Word) : Integer; assembler;
asm
  push ds;
  mov ah,$3f;
  mov bx,Handle;
  mov cx,Bytes;
  lds dx,Buffer;
  int $21;
  jnb @@Fix;
  mov ax,-1;
  jmp @@Done;
@@Fix:
  mov ax,0;
@@Done:
  pop ds;
end;

function F_Seek(Handle : Integer; Distance : Longint; Code : Byte) : Longint; assembler;
asm
  mov ah,$42;
  mov al,Code;
  mov bx,Handle;
  mov cx,Word Ptr Distance+2;
  mov dx,Word Ptr Distance;
  int $21;
  jnb @@Done;
  mov ax,-1;
  mov dx,-1;
@@Done:
end;

function F_FileLength(Handle : Integer) : Longint; assembler;
var
	Small,Large : Word;
asm
  mov ax,$4201;
  mov bx,Handle;
  mov cx,0;
  mov dx,0;
  int $21;
  jb  @@Error;
  mov Small,ax;
  mov Large,dx;
  mov ax,$4202;
  mov bx,Handle;
  mov cx,0;
  mov dx,0;
  int $21;
  jb  @@Error;
  push ax;
  push dx;
  mov ax,$4200;
  mov bx,Handle;
  mov cx,Large;
  mov dx,Small;
  int $21;
  pop dx;
  pop ax;
  jnb @@Done;
@@Error:
  mov ax,-1;
  mov dx,-1;
@@Done:
end;

procedure pPutImage(source,destination : Longint; NumAcross,NumDown,RowWidth : Word); assembler;
asm
  push    ds
  mov     dx,RowWidth
  sub     dx,NumAcross
  lds     si,source
  les     di,destination
  mov     ax,0
  mov     bx,NumDown
@@CopyLoop:
  mov     cx,NumAcross
  rep     movsb
  add     di,dx
  dec     bx
  jnz     @@CopyLoop
  pop     ds
end;

procedure pGetImage(source,destination : Longint; NumAcross,NumDown,RowWidth : Word); assembler;
asm
  push    ds
  mov     dx,RowWidth
  sub     dx,NumAcross
  lds     si,source
  les     di,destination
  mov     ax,0
  mov     bx,NumDown
@@CopyLoop:
  mov     cx,NumAcross
  rep     movsb
  add     si,dx
  dec     bx
  jnz     @@CopyLoop
  pop     ds
end;

procedure SetPalBlock(Start,Number : Word; var Buffer); assembler;
asm
  push ds
  cli
  mov     dx, 3dah
@@l11:
  in      al, dx
  and     al, 8
  je      @@l11
  mov     ax,Start
  mov     dx,03c8h
  out     dx,al
  inc     dx
  lds     si,Buffer
  mov     cx,Number
@@Looper:
  lodsb
  out dx,al
  lodsb
  out dx,al
  lodsb
  out dx,al
  loop @@Looper
  sti
  pop ds
end;

procedure PCX_PutRow(row,col1,col2 : Word; var buffer); assembler;
asm
  push    ds
  push    es
  mov     ax, 0A000h          (* Point to current video page *)
  mov     es, ax              (* ES points to base memory *)
  mov     bx, col1            (* bx = x *)
  mov     ax, row             (* ax = ( row *)
  mul     RowWidth            (*           *bytesperrow) *)
  add     ax, bx              (*                        + x/4 *)
  mov     di, ax              (* ES:DI = pointer into video memory *)
  mov     cx, col2
  sub     cx, col1            (* cx = width in pixels across *)
  lds     si, buffer          (* DS:SI points to source *)
@@pixelloop:
  rep     movsb
  pop     es
  pop     ds
end;

procedure PCX_Display(Filename : string; var xsize,ysize : Word);
label
  PCX2VGAXerror;
type
  BArray = array[0..0] of Byte;
var
  header : ^PCXHeader;
  buffer : ^BArray;
  scanline : ^BArray;
  PCXFile : Integer;
  i,row,col,count : Integer;
  index,buffer_size,color : Word;
  max : Longint;
  data : Byte;
begin
  header := nil;
  buffer := nil;
  scanline := nil;
  PCXFile := -1;
  if(SizeOf(PCXHeader) > MaxAvail) then goto PCX2VGAXerror;
  GetMem(header,SizeOf(PCXHeader));
  PCXfile := F_Open(filename,O_RDONLY);
  if(PCXfile = -1) then goto PCX2VGAXerror;
  (* read 128 char PCX header *)
  if (F_Read(PCXfile,Header^,SizeOf(PCXHeader))=-1) then goto PCX2VGAXerror;
  (* Is it a 256 color PCX file? *)
  if((header^.Manufacturer <> 10) or (Header^.Encoding <> 1) or
     (header^.Nplanes <> 1) or (header^.BitsPerPixel <> 8) or
     (header^.Version <> 5)) then goto PCX2VGAXerror;
  (* Find the size of the image *)
  xsize := header^.Xmax - header^.Xmin + 1;
  ysize := header^.Ymax - header^.Ymin + 1;
  (* Done with header- deallocate it *)
  Dispose(header);
  header := nil;
  (* Move before the extended palette at the end of PCX file *)
  if(F_Seek(PCXFile,Longint(-769),SEEK_END) = Longint(-1)) then goto PCX2VGAXerror;
  (* Read in a character which should be 12 to be extended palette file *)
  if (F_Read(PCXFile,data,1)=-1) then goto PCX2VGAXerror;
  (* If there's an extended palette, then read it in *)
  if(data = 12) then
  begin
    if(F_Read(PCXFile,Pal,256*SizeOf(RGB))=-1) then goto PCX2VGAXerror;
    for i := 0 to 255 do
    begin
      Pal[i].red := Pal[i].red shr 2;
      Pal[i].green := pal[i].green shr 2;
      Pal[i].blue := Pal[i].blue shr 2;
    end;
  end;
  (* Move back up to where data starts *)
  if(F_seek(PCXfile, Longint(128), SEEK_SET) = -1) then goto PCX2VGAXerror;
  (* compute number of chars to display *)
  if(xsize > MaxAvail) then goto PCX2VGAXerror;
  GetMem(scanline,xsize);
  buffer_size := $ff00;
  max := F_FileLength(PCXfile)-128-(3*256);
  if(max < buffer_size) then buffer_size := max;
  if(buffer_size > MaxAvail) then buffer_size := MaxAvail;
  GetMem(buffer,buffer_size);
  index := 0;
  if(F_Read(PCXfile, buffer^, buffer_size) = -1) then goto PCX2VGAXerror;
  for row := 0 to ysize-1 do
  begin
    col:=0;
    while(col < xsize) do
    begin
      data := buffer^[index];
      index := index + 1;
      if(index >= buffer_size) then
      begin
        if(F_Read(PCXfile, buffer^, buffer_size) = -1) then goto PCX2VGAXerror;
        index := 0;
      end;
      if ((data and $C0) = $C0) then
      begin
        count := data and $3F;
        data := buffer^[index];
        index := index + 1;
        if(index >= buffer_size) then
        begin
          if(F_Read(PCXfile, buffer^, buffer_size) = -1) then goto PCX2VGAXerror;
          index := 0;
        end;
        FillChar(scanline^[col],count,data);
        col := col + count;
      end
      else
      begin
        scanline^[col] := data;
        col := col + 1;
      end;
    end;
    PCX_PutRow(row,0,xsize,scanline^);
  end;
  Dispose( scanline );
  Dispose( buffer );
  F_Close (PCXfile);
  Exit;

PCX2VGAXerror:
  if (scanline <> nil) then Dispose( scanline );
  if (buffer <> nil) then Dispose( buffer );
  if (header <> nil) then Dispose(header );
  if (PCXfile > -1) then F_Close (PCXfile);
end;

procedure MainScale;
var
  Sx,Sy : Integer;
  Button : Word;
begin
  asm mov ax,0; int 33h; end;     (* Initialize the mouse *)
  GetMem(Image,64*64);
  GetMem(SImage,65535);
  PCX_Display('TEST.PCX'+#0,xs,ys);
  SetPalBlock(0,256,Pal);
  pGetImage($A0000000,Longint(Image),64,64,320);
  ScaleImage(Longint(Image),Longint(SImage),64,64,64,64);
  Sx := 64;  Sy := 64;
  repeat
    ScaleImage(Longint(Image),Longint(SImage),64,64,Sx,Sy);
    pPutImage(Longint(SImage),$A0000000,Sx,Sy,320);
    asm
      mov ax,3;  int 33h;
      inc cx;  inc dx;
      mov Sx,cx;  mov Sy,dx;
      mov Button,bx
    end;
  until(Button=1);
end;

procedure MainPerspective;
var
	Sx,Sy : Integer;
	Button : Word;
	SHigh : Word;
begin
  asm mov ax,0; int 33h; end;     (* Initialize the mouse *)
  GetMem(Image,64*64);
  GetMem(SImage,65535);
  PCX_Display('TEST.PCX'+#0,xs,ys);
  SetPalBlock(0,256,Pal);
  pGetImage($A0000000,Longint(Image),64,64,320);
  Perspect(Longint(Image),Longint(SImage),64,64,64,64,20,0);
  Sx := 64;  Sy := 64;
  SHigh := 20;
  repeat
    Perspect(Longint(Image),Longint(SImage),64,64,Sy,Sx,SHigh,0);
    pPutImage(Longint(SImage),$A0000000,Sx,Sy,320);
    asm
      mov ax,3;  int 33h;
      inc cx;  inc dx;
      mov Sx,cx;  mov Sy,dx;
      mov Button,bx
    end;
    if(KeyPressed) then
    case ReadKey of
      '-' : Dec(SHigh);
      '=' : Inc(SHigh);
    end;
  until(Button=1);
end;

begin
  asm  mov ax,13h;  int 10h;  end;
  MainPerspective;
  asm  mov ax,3;  int 10h;  end;
end.

-------------------------------- Cut here -------------------------------------

Filename: Scale.pas

-------------------------------- Cut here -------------------------------------
{$G+,S-}
unit Scale;

interface

var
  XDel,YDel,OneRow,FromTop : array[0..319] of Byte;

procedure ScaleImage(Src,Dest : Longint; NX,NY : Word; NewSizeX,NewSizeY : Word);
procedure Perspect(Src,Dest : Longint; NX,NY : Word; NewSizeY,BigX,BigY,WhichWay : Word);

implementation

procedure CreateScaleTable(NX,NewX,WhichOne : Word); assembler;
var
  NumDone : Word;
asm
        push    ds
        push    es
        push    di
        push    bx
        mov     ax,seg XDel
        mov     es,ax
        mov     di,WhichOne
        mov     ax,0
        mov     cx,160
        rep     stosw
        mov     di,WhichOne
        mov     ax,NX
        cmp     ax,NewX
        jb      @@ScaleUpX
{ BX - Errorterm }
{ CX - DYx2Xx2 }
{ DX - DYx2 }
@@ScaleDownX:
        mov     bx,NewX               (* DeltaYx2 = DeltaY*2 *)
        shl     bx,1                  (* *2 *)
        mov     dx,bx
        mov     cx,ax                 (* DYx2MinusDXx2 = DYx2-DXx2 *)
        shl     cx,1                  (* X*2 *)
        sub     bx,cx                 (* Subtract *)
        mov     cx,bx
        mov     bx,dx                 (* ErrorTerm = DYx2 - DX *)
        sub     bx,ax
        mov     NumDone,0
@@ScaleDownLoop:
        mov     ax,NumDone
        cmp     ax,NewX
        jnb     @@Done
        cmp     bx,0                  (* if(ErrorTerm >= 0) *)
        js      @@AfterDownIf
        add     bx,cx
        mov     al,1
        stosb
        inc     NumDone
        jmp     @@ScaleDownLoop
@@AfterDownIf:
        add     bx,dx
        mov     al,0
        stosb
        jmp     @@ScaleDownLoop
(*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
; BX - Errorterm
; CX - DXx2Yx2
; DX - DXx2*)
@@ScaleUpX:
        mov     ax,NewX
        mov     bx,NX                 (* DeltaYx2 = DeltaY*2 *)
        shl     bx,1                  (* *2 *)
        mov     dx,bx
        mov     cx,ax                 (* DXx2MinusDYx2 = DXx2-DYx2 *)
        shl     cx,1                  (* X*2 *)
        sub     bx,cx                 (* Subtract *)
        mov     cx,bx
        mov     bx,dx                 (* ErrorTerm = DXx2 - DY *)
        sub     bx,ax
        inc     Byte Ptr es:[di]
        mov     NumDone,1
@@ScaleUpLoop:
        dec     NewX
        jz      @@BefDone
        cmp     bx,0                  (* if(ErrorTerm >= 0) *)
        js      @@AfterUpIf
        add     bx,cx
        inc     di
        inc     Byte Ptr es:[di]
        jmp     @@ScaleUpLoop
@@AfterUpIf:
        add     bx,dx
        inc     Byte Ptr es:[di]
        jmp     @@ScaleUpLoop
@@BefDone:
        mov     al,Byte Ptr es:[di]
        sub     di,WhichOne
        cmp     di,NX
        jl      @@Done
        mov     di,WhichOne
        add     Byte Ptr es:[di],al
@@Done:
        pop     bx
        pop     di
        pop     es
        pop     ds
end;

procedure ScaleImage(Src,Dest : Longint; NX,NY : Word; NewSizeX,NewSizeY : Word); assembler;
var
  YBX,XBX : Word;
  LastDI,LastSI,LastDS : Word;
asm
        push    ds
        push    NX                  { Same as CreateScaleTable(NX,NewSizeX,XDel); }
        push    NewSizeX
        push    offset XDel
        call    CreateScaleTable
        push    NY                  { Same as CreateScaleTable(NY,NewSizeY,YDel); }
        push    NewSizeY
        push    offset YDel
        call    CreateScaleTable
        les     di,Dest
        lds     si,Src
        mov     [YBX],offset YDel
        mov     [XBX],offset XDel
        mov     [LastSI],si
@@YLoop:
        dec     NY                    { Do we still have some rows to do? }
        js      @@Done
        mov     si,[LastSI]
        mov     cx,NX                 (* Copy one line *)
        push    ds                    (* Move one row from the image into a *)
        push    di                    (* local buffer                       *)
        push    es
        mov     ax,seg XDel
        mov     es,ax
        push    es
        mov     di,offset OneRow
        rep     movsb
        mov     LastSI,si
        pop     ds
        pop     es
        pop     di
        mov     bx,YBX
        mov     cl,[bx]
        xor     ch,ch
        inc     bx
        mov     YBX,bx
        cmp     cx,0
        jz      @@AfterAll
@@XLoopOuter:
        push    cx                    { Save rows }
        mov     si,offset OneRow
        mov     cx,NX
        mov     bx,offset XDel
        mov     LastDI,di
@@XLoop:
        push    cx
        lodsb
        mov     cl,[bx]
        xor     ch,ch
        inc     bx
        cmp     cx,0
        jz      @@SkipStore
        rep     stosb
@@SkipStore:
        pop     cx
        loop    @@XLoop
        pop     cx
        loop    @@CopyTheRows
@@AfterAll:
        pop     ds
        jmp     @@YLoop
@@CopyTheRows:
        push    ds
        push    es
        pop     ds
@@CopyIt:
        push    cx
        mov     si,[LastDI]
        mov     cx,[NewSizeX]
        rep     movsb
        pop     cx
        loop    @@CopyIt
        pop     ds
        jmp     @@AfterAll
@@Done:
        pop     ds
end;


procedure CreatePerspectiveTable(Y0,DeX,DeY,Up : Integer); assembler;
var
  NumDone : Word;
asm
        push    ds
        push    es
        mov     ax,seg FromTop
        mov     es,ax
        mov     ds,ax
        mov     si,offset FromTop
        mov     ax,DeX
        cmp     ax,DeY
        jnb     @@ScaleDownX
        mov     bx,[DeY]
        mov     DeX,bx
        mov     DeY,ax
(*ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
; BX - Errorterm
; CX - DeYx2Xx2
; DX - DeYx2*)
@@ScaleDownX:
        mov     ax,DeX
        mov     bx,DeY                { DeltaYx2 = DeltaY*2 }
        shl     bx,1                  {  *2  }
        mov     dx,bx
        mov     cx,ax                 {  DeYx2MinusDeXx2 = DeYx2-DeXx2 }
        shl     cx,1                  { X*2 }
        sub     bx,cx                 { Subtract }
        mov     cx,bx
        mov     bx,dx                 {; ErrorTerm = DeYx2 - DeX }
        sub     bx,ax
        mov     ax,Y0
        mov     [si],ax
        inc     si
@@ScaleDownLoop:
        dec     DeX
        cmp     DeX,0
        jz      @@Done
        cmp     bx,0                  { if(ErrorTerm >= 0) }
        js      @@AfterDownIf
        add     bx,cx
        mov     ax,Up
        add     Y0,ax
        mov     ax,Y0
        mov     [si],al
        inc     si
        jmp     @@ScaleDownLoop
@@AfterDownIf:
        add     bx,dx
        mov     ax,Y0
        mov     [si],al
        inc     si
        jmp     @@ScaleDownLoop
@@Done:
        pop     es
        pop     ds
end;

procedure Perspect(Src,Dest : Longint; NX,NY : Word; NewSizeY,BigX,BigY,WhichWay : Word); assembler;
var
  YBX,XBX : Word;
  LastDI,LastSI : Word;
  FBX,OntoEnd,RegX : Word;
  LastHeight : Word;
asm
        push    ds
        push    es
        mov     ax,NX
        mov     RegX,ax
        cmp     WhichWay,0
        jnz     @@OtherWay
        push    0
        push    BigX
        push    BigY
        push    1
        call    CreatePerspectiveTable
        jmp     @@PastIt
@@OtherWay:
        push    BigY
        push    BigX
        push    BigY
        push    -1
        call    CreatePerspectiveTable
@@PastIt:
        push    NX
        push    BigX
        push    offset XDel
        call    CreateScaleTable
        les     di,Dest
        lds     si,Src
        mov     YBX,offset YDel
        mov     XBX,offset XDel
        mov     FBX,offset FromTop
        mov     LastSI,si
        mov     LastDI,di
        mov     LastHeight,-1
@@YLoop:
        dec     NX
        js      @@Done
        mov     si,LastSI
        mov     cx,NY                 { Copy one vertical line }
        mov     dx,RegX
        dec     dx
        push    ds
        push    di
        push    es
        mov     ax,seg OneRow
        mov     es,ax
        push    es
        mov     di,offset OneRow
@@CopyVertRow:
        movsb
        add     si,dx
        loop    @@CopyVertRow
        inc     LastSI
        pop     ds
        pop     es
        pop     di

        mov     bx,XBX                { Do we do this line? }
        mov     cl,[bx]
        xor     ch,ch
        inc     bx
        mov     XBX,bx
        cmp     cx,0
        jz      @@AfterAll
        jmp     @@CopyTheRows

@@YLoopOuter:
        push    cx                    { Number of same row to copy. }
        mov     si,offset OneRow
        mov     di,LastDI
        inc     LastDI
        mov     cx,OntoEnd
        jcxz    @@AfterInitial
@@InitialBlanks:
        mov     Byte Ptr es:[di],0
        add     di,BigX
        loop    @@InitialBlanks
@@AfterInitial:
        mov     cx,NY
        mov     bx,offset YDel
@@XLoop:
        push    cx
        lodsb
        mov     cl,[bx]
        xor     ch,ch
        inc     bx
        jcxz    @@SkipStore
@@StoreTheRow:
        mov     Byte Ptr es:[di],al
        add     di,BigX
        loop    @@StoreTheRow
@@SkipStore:
        pop     cx
        loop    @@XLoop
        mov     cx,OntoEnd
        jcxz    @@AfterEndBlanks
@@EndBlanks:
        mov     Byte Ptr es:[di],0
        add     di,BigX
        loop    @@EndBlanks
@@AfterEndBlanks:
        mov     di,LastDI
        pop     cx
        loop    @@CopyTheRows
@@AfterAll:
        pop     ds
        jmp     @@YLoop



@@CopyTheRows:
        push    cx

        mov     bx,FBX
        mov     cl,[bx]
        xor     ch,ch
        inc     bx
        mov     FBX,bx
        mov     OntoEnd,cx
        mov     bx,NewSizeY
        mov     ax,bx
        shr     ax,1
        cmp     cx,ax
        jle     @@GoOn2
        mov     cx,ax
@@GoOn2:
        shl     cx,1
        sub     bx,cx
        cmp     LastHeight,bx
        jz      @@NoScaleTable
        push    NY
        push    bx
        push    offset YDel
        call    CreateScaleTable
        mov     LastHeight,bx
@@NoScaleTable:
        pop     cx
        jmp     @@YLoopOuter

@@Done:
        pop     es
        pop     ds
end;

end.
-------------------------------- Cut here -------------------------------------

In article <1992Jul29.175920.57643@cc.usu.edu>, sl8nl@cc.usu.edu writes:
>