Thread View: rec.games.programmer
3 messages
3 total messages
Started by sl8nl
Sat, 01 Aug 1992 01:36
Perspective Mapper and Scaler Code...
Author: sl8nl
Date: Sat, 01 Aug 1992 01:36
Date: Sat, 01 Aug 1992 01:36
823 lines
21917 bytes
21917 bytes
Due to the fact that many people have emailed me saying "Where is the code?",
I'm reposting it again. I posted it several days ago. Maybe I'll have to
split the message into four parts or something. - Josh
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 -------------------------------------
Re: Perspective Mapper and Scaler Code...
Author: Dixie Cup
Date: Sat, 01 Aug 1992 14:50
Date: Sat, 01 Aug 1992 14:50
8 lines
964 bytes
964 bytes
In article <1992Jul31.193651.57747@cc.usu.edu> sl8nl@cc.usu.edu writes: >Due to the fact that many people have emailed me saying "Where is the code?", >I'm reposting it again. I posted it several days ago. Maybe I'll have to >split the message into four parts or something. - Josh They probably meant the TADS clone. That's what all the hoopla seemed to be about. Whether or not it really was 18k etc. I'm sure some of your doubters would like to at least play around with the executable.
Re: Perspective Mapper and Scaler Code...
Author: sl8nl
Date: Sat, 01 Aug 1992 18:22
Date: Sat, 01 Aug 1992 18:22
15 lines
1082 bytes
1082 bytes
>>Due to the fact that many people have emailed me saying "Where is the code?", >>I'm reposting it again. I posted it several days ago. Maybe I'll have to >>split the message into four parts or something. - Josh > > They probably meant the TADS clone. That's what all the hoopla seemed to > be about. Whether or not it really was 18k etc. I'm sure some of > your doubters would like to at least play around with the executable. No, I got a lot of email asking where it was. Maybe this time it made it to them. Actually, I looked at the ADVSYS compiler and interpreter. David Betz's compiler .EXE was 18k. The interpreter .EXE was 13k. Josh
Thread Navigation
This is a paginated view of messages in the thread with full content displayed inline.
Messages are displayed in chronological order, with the original post highlighted in green.
Use pagination controls to navigate through all messages in large threads.
Back to All Threads