Program AntiAliasPrototyper;
{
  This is an scaling/rotation/antialiasing prototyping program
  by Lewis A. Sellers, ie Minimalist of The Minimalist Group
  (http://www.1stresource.com/l/lsellers/),
  and the MOSOCI Grail Project (http://www.dwc.edu/grail).

  Written 1995-1996 A.D.

  You can use it and the code involved if you wish as long as
  you include the standard greetings to me somewhere in your
  program, say in the credits.

  It was originally a Turbo Borland C/ASM DOS 16-bit program,
  but I recoded it into Pascal 7.0.
  My first pascal program ever on the IBM platform actually. :-)
  Frankly, it is a lot cleaner looking than the original. Hmmm...

  The Keys:
	'1' is no antialiasing.
	'2' is bilinear.
	'3' is trilinear.
	'4' is... something I was playing with.
  The left/right arrows change rotation.
  The - + [ and ] keys zoom.
  Press any key to stop zooming.
  ESC and Space stop the program.

  You must supply a BMP filename as an argument such as:
  C:> ALIAS DEATH.BMP

  The BMP it uses must be a 320x200 256 color grayscale image.

  This is by no means fast. If I want something fast I do it in pure
  assembly.

  GREETS:
  Thanks to __Elendil and Lumpy (and Hugh and Bimba) for the impromptu
  Pascal hints. :)

  And JMX/Opiate for the incentive to learn pascal.
}


{$R-}
{$X+} { use FPU }
{$M 16384,196608,196608} {probably too much... but tired of crashes while experimenting }

USES
   Crt, DOS;

const
	{screen constants}
	WIDTH = 320;
	HEIGHT = 200;
	SCREENSIZE = WIDTH*HEIGHT;
	PALETTESIZE = 256*3;
	VGA : Word = $a000;
	FAILURE = 0;
	SUCCESS = 1;
	PI = 3.14159;

type
	pScreen = ^pScreenType;
	pScreenType = array[0..SCREENSIZE] of byte;

VAR
	texture : pScreen;
	composite :pScreen;
	y320 : array[0..HEIGHT] of word;


{ switch to 320x200 256 straight VGA }
Procedure SetGraphicsMode; assembler;
Asm
	mov ax,13h
	int 10h
	mov dx,3c2h
	mov al,0e3h
	out dx,al
End;


{ back to 80x25 text mode }
Procedure SetTextMode; assembler;
Asm
	mov ax,03h
	int 10h
End;


{ load the 320x200 grayscale bitmap into memory }
Function LoadImage(filename : string) : byte;
type
	pPalette = ^PaletteType;
	PaletteType = array[0..PALETTESIZE] of byte;

Var
	pFileMem : pScreen;
	FileHandle : file;
	thrash : pScreen;
	palette : pPalette;
	result : word;

Begin
	Assign(FileHandle, filename);
	Reset(FileHandle, 1);
	GetMem(thrash, 320*200);
	GetMem(palette, 1024);
	Seek(FileHandle, 54);
	BlockRead(FileHandle, palette^, 1024, result);
	BlockRead(FileHandle, thrash^, 320*200, result);
	Close(FileHandle);

	{ fake thrash for testing }
{	Asm
		les di, thrash
		mov cx,320*200
		sub al,al
@xyloop:
		mov es:[di],al
		inc al
		inc di
		dec cx
		cmp cx,0
		jne @xyloop
	End; }


	{ MS uses funky file formats.
	  Change from b-g-r-unused dword format to proper RGB 3byte and write
	  it to the video card as we do so. }

	port[$3c6]:=$0ff;
	port[$3c8]:=0;
	Asm

		les si,palette
		mov cx,256
		cld
		mov dx,$3c9
@ploop:
		mov al,es:[si+2]
		shr al,2
		out dx,al

		mov al,es:[si+1]
		shr al,2
		out dx,al

		mov al,es:[si]
		shr al,2
		out dx,al

		add si,4
		dec cx
		jne @ploop
	End;


	{ Thrash the dumb MS format... The image is stored uncompressed
	UPSIDE-DOWN, each line being on a 32-bit DWORD boundry. Hmm. }
	Begin
		Asm
		  push ds

		  cld
		  mov cx, HEIGHT

		  les di, texture
		  lds si, thrash
		  add di, (HEIGHT-1)*WIDTH
@tloop:
		  push cx
		  push si
		  push di
		  mov cx, WIDTH/2
		  rep movsw
		  pop di
		  pop si
		  pop cx

		  add si, WIDTH
		  sub di, WIDTH

		  dec cx
		  cmp cx,0
		  jne @tloop

		  pop ds
		End;
	End;

	FreeMem(palette, 1024);
	FreeMem(thrash, 320*200);
	LoadImage:=SUCCESS;
End;


{ This is it. This rotates and scales the image into a 200x200 window. }
Procedure FastRotate(scale, ang : Real);
VAR
	xscale,
	yscale,
	xc,
	yc : Longint;

	scanline : word;
	x, y : Integer;
	tempx, tempy : word;
	xlong, ylong : Longint;

	tseg, toff : word;
	hseg, hoff : word;
	texel : byte;

Begin
	xscale := round ( (sin(ang)*65536.0)*scale);
	yscale := round ( (cos(ang)*65536.0)*scale);
	xc := 160*65536 - (100*(yscale+xscale));
	yc := 100*65536 - (100*(yscale-xscale));
	scanline:=0;

	tseg:=seg(texture^);
	toff:=ofs(texture^);
	hseg:=seg(composite^);
	hoff:=ofs(composite^);

	for y:=0 to 199 do
	Begin
		xlong:=xc;
		ylong:=yc; { init x/ylong to topleft of square }
		for x:=60 to 60+200 do
		Begin { normally from 0 to 319 }
			tempx:=xlong SHR 16;
			tempy:=ylong SHR 16;

			if (tempx<0) OR (tempx>=WIDTH) OR (tempy<0) OR (tempy>=HEIGHT) then
			Begin
				Mem[hseg:hoff+scanline+x]:=0;
			End
			else
			Begin
				texel:=Mem[tseg:toff+y320[tempy]+tempx];
				Mem[hseg:hoff+scanline+x]:=texel;
			End;

			inc(xlong,yscale);
			dec(ylong,xscale);
		End;
		inc(scanline,WIDTH);
		inc(xc,xscale);
		inc(yc,yscale);
	End;
End;


{ The bilinear antialiasing is post rotation/scaling here.
  We perform the operation on the HOLDing texture which is then blitted
  to video memory elsewhere in the program. }
Procedure Bilinear; assembler;
Asm
		push ds
		lds di, composite
		add di, (WIDTH+1) + 60
		mov cx, 198
@yloop:
		push cx
		push di
		mov cx, (WIDTH-2) - 120
@xloop:
		sub ax,ax
		sub bx,bx
		mov al,[di-1]
		add bx,ax
		mov al,[di+1]
		add bx,ax
		mov al,[di-WIDTH]
		add bx,ax
		mov al,[di+WIDTH]
		add bx,ax

		shr bx,2

		mov al,[di]
		add bx,ax
		shr bx,1

		mov [di],bl
		inc di
		dec cx
		cmp cx,0
		jne @xloop

		pop di
		pop cx
		add di,WIDTH
		dec cx
		cmp cx,0
		jne @yloop
		pop ds
End;


{ The trilinear antialiasing is post rotation/scaling here. }
Procedure Trilinear; assembler;
Asm
		push ds
		lds di, composite
		add di, (WIDTH+1) + 60
		mov cx, (HEIGHT-2)
@yloop:
		push cx
		push di
		mov cx, (WIDTH-2) - 120
@xloop:
		mov ax,0
		mov bx,0
		mov al,[di-1]
		add bx,ax
		mov al,[di+1]
		add bx,ax
		mov al,[di-WIDTH]
		add bx,ax
		mov al,[di+WIDTH]
		add bx,ax
		mov al,[di-(WIDTH-1)]
		add bx,ax
		mov al,[di-(WIDTH-1)]
		add bx,ax
		mov al,[di+(WIDTH+1)]
		add bx,ax
		mov al,[di+(WIDTH-1)]
		add bx,ax
		shr bx,3
		mov al,[di]
		add bx,ax
		shr bx,1
		mov [di],bl
		inc di
		dec cx
		cmp cx,0
		jne @xloop
		pop di
		pop cx
		add di,WIDTH
		dec cx
		cmp cx,0
		jne @yloop
		pop ds
End;


{ The hyper-linear? antialiasing is post rotation/scaling here.
  If you're playing with antialiasing, do it here. This is the most
  interesting of effects I ran across while playing with antialiasing.
  Produces a short of fuzzy-ghosting afterimage. }
Procedure Hyperlinear; assembler;
Asm
		push ds

		lds di, composite
		add di, (WIDTH+1)+60
		mov cx, (HEIGHT-2)
@yloop:
		push cx
		push di
		mov cx, (WIDTH-1) - 60*2
@xloop:
		sub ax,ax
		sub dx,dx
		mov al,[di-1]
		add dx,ax
		mov al,[di+1]
		add dx,ax
		mov al,[di-WIDTH]
		add dx,ax
		mov al,[di+WIDTH]
		add dx,ax

		mov al,[di-(WIDTH+1)]
		add dx,ax
		mov al,[di-(WIDTH-1)]
		add dx,ax
		mov al,[di+(WIDTH+1)]
		add dx,ax
		mov al,[di+(WIDTH-1)]
		add dx,ax

		shr dx,3

		mov al,[di]
		add dx,ax
		shr dx,1

		mov [di-(WIDTH+1)],dl
		mov [di+(WIDTH+1)],dl
		mov [di-(WIDTH-1)],dl
		mov [di+(WIDTH-1)],dl

		inc di
		dec cx
		cmp cx,0
		jg @xloop

		pop di
		pop cx

		add di, WIDTH
		dec cx
		cmp cx,0
		jg @yloop
		pop ds
End;


{ copy the composition texture to the VGA screen memory. }
Procedure Copycomposite; assembler;
Asm
	push ds
	mov di, VGA
	mov es,di
	sub di,di
	lds	si,composite
	mov cx,320*200/2
	cld
	rep movsw
	pop ds
End;


{ clear the composition texture }
Procedure Clearcomposite; assembler;
Asm
	les di, composite
	mov cx,320*200/2
	sub ax,ax
	cld
	rep stosw
End;


{ the main }
VAR
	angle,
	angle_v,
	scale : Real;
	n,
	alias: Integer;
	key : Char;

Begin
	ClrScr;
	Writeln('Antialiasing Prototyper by Minimalist 1995-1996.');
	Writeln;

	if ParamCount=0 then
	Begin
		writeln('Use: ALIAS filename.bmp');
		halt(1);
	End;

	Writeln('This is the PASCAL version of the original C prototyper written the week of');
	Writeln('March 13-14th in preparation for NAID 96. It is also the very first PASCAL');
	Writeln('program I have written for the IBM PC.');
	Writeln('The BMP must be 320x200 256 grayscale.');

	Writeln;

	Writeln('You may use any of the following keys:');
	Writeln(' ESC will exit the program.');
	Writeln(' 1   no antialiasing');
	Writeln(' 2   post Bilinear antialising');
	Writeln(' 3   post Trilinear antialiasing');
	Writeln(' 4   post um... hyperlinear antialiasing? :-)');
	Writeln(' Use left/right arrows to change rotation.');
	Writeln(' Zoom with the - + [ and ] keys. Press any other to stop.');

{	Writeln;
	Writeln('=texture=');

	Writeln('memory ',MaxAvail);
}
	if MaxAvail < 64000 then
	Begin
		Writeln('Low Memory ',MaxAvail);
		Halt(1);
	End;
	GetMem(texture, 64000);
{
	Writeln('texture ',seg(texture),':',ofs(texture));
	Writeln('texture^ ',seg(texture^),':',ofs(texture^));
	Writeln('texture^ seg ',seg(texture^), ' texture^ off', ofs(texture^));


	Writeln;
	Writeln('=composite=');

	Writeln('memory ',MaxAvail);
}
	if MaxAvail < 64000 then
	Begin
		Writeln('Low Memory ',MaxAvail);
		Halt(1);
	End;
	GetMem(composite, 64000);
{
	Writeln('composite ',seg(composite),':',ofs(composite));
	Writeln('composite^ ',seg(composite^),':',ofs(composite^));
	Writeln('composite^ seg ',seg(composite^), ' composite^ off', ofs(composite^));
}

	Writeln;
	Writeln('Press any key to begin....');
	Readkey;

	for n:=0 to 199 do y320[n]:=n*320;

	SetGraphicsMode;
	if LoadImage(ParamStr(1)) = FAILURE then
	Begin
		SetTextMode;
		writeln('The file ', ParamStr(1),' does not exist.');
		halt(2);
	End;

	clearcomposite;

	angle:=PI/256;
	angle_v:=-PI/128;
	scale:=1.05;
	alias:=0;

	key:=#1;
	while key<>#27 do
	Begin
		if keyPressed then key:=ReadKey;

		case key of
			   '1': alias:=1;
			   '2': alias:=2;
			   '3': alias:=3;
			   '4': alias:=4;
			   '5': alias:=5;

			   '-': scale:=scale-0.05;
			   '=': scale:=scale+0.05;
			   '[': scale:=scale-0.5;
			   ']': scale:=scale+0.5;
		End;

		if key=#0 then
		Begin
			key:=ReadKey;
			case key of
				#75: angle_v:=angle_v-PI/128;
				#77: angle_v:=angle_v+PI/128;
			End;
		End;

		Begin
			Gotoxy(1,1);
			Write('Scale:=',scale,'  ');
			Gotoxy(1,2);
			Write('Angle:=',angle,'  ');
			FastRotate(scale,angle);
			case alias of
				2: bilinear;
				3: trilinear;
				4: hyperlinear;
			End;
		End;

		copycomposite;
		angle:=angle+angle_v;
	End;

	SetTextMode;

	Writeln('By Minimalist (Lewis A. Sellers) 1996. Part of the C/Pascal/Asm package.');
	Writeln('To contact, email: lsellers@1stresource.com (shortly to be lsellers@usit.net).');
	Writeln('or drop by http://www.dwc.edu/grail, site of the Grail Operating System Project.');
	FreeMem(composite,64000);
	FreeMem(texture,64000);
End.