specht/ROTOZOO2.PAS

## ROTOZOO2.PAS
uses Crt, Dos, VGA;

var phi, rho, tau, scale, x, y: Real;
    ix, iy: Integer;
    tx, ty, sx, sy, i: Integer;
    u, v, ul, vl: LongInt;
    ut, vt: LongInt;
    dxu, dyu, dxv, dyv: LongInt;
    offset: Word;
    color: Integer;
    texture: Pointer;
    texseg: Word;

{ This is a rotozoomer. The procedure calc_uv returns u and v texture
  coordinates for a given screen space pixel x, y, using three angles
  phi, rho and tau. }

procedure calc_uv(x, y: Integer; phi, rho, tau: Real; var u, v: LongInt);
var ru, rv, tu, tv: Real;
    scale: Real;
begin
  { transform to center of screen }
  ru := x - 160;
  rv := y - 100;
  { moving center }
  { move the center around}
  ru := ru - cos(tau) * 40;
  rv := rv - sin(tau) * 40;
  { scale }
  { scale according to some sine function value }
  scale := (((sin(rho) + 1.0) * 0.5) * 0.7 + 1.3);
  ru := ru / scale;
  rv := rv / scale;
  { rotate }
  { rotate by -phi }
  tu := ru; tv := rv;
  ru := tu * cos(-phi) - tv * sin(-phi);
  rv := tv * cos(-phi) + tu * sin(-phi);
  { convert to fixed point }
  { up to here, we have dealt with real numbers, let's convert them
    to fixed point (15.16)! }
  u := Trunc(ru * 65536);
  v := Trunc(rv * 65536);
end;

{ This procedure loads a PCX file. }
procedure LoadPCX(filename: String);
var f: File;
    header: array[0..127] of Byte;
    count, i: Byte;
    color: array[0..2] of Byte;
    offset: LongInt;
begin
  Assign(f, filename);
  Reset(f, 1);
  BlockRead(f, header, 128);
  { Basically we just skip the 128 header bytes and read the pixel
    values. }
  repeat
    { Read a pixel. }
    BlockRead(f, i, 1);
    { RLE compression: if the value is >= 192 (bits 6 and 7 are set),
      this is not a single pixel, but a span of pixels. To obtain the
      span length, subtract 192 (clear bits 6 and 7) and read the next
      byte in the file to obtain the pixel color. }
    if i >= 192 then begin
      count := i - 192;
      BlockRead(f, i, 1);
      { Draw the pixel count times. }
      while count > 0 do begin
        Mem[texseg:offset] := i;
        Inc(offset);
        Dec(count);
      end;
    end else begin
      { Not a span, just a plain old pixel. }
      Mem[texseg:offset] := i;
      Inc(offset);
    end;
    { We know our image is 128 x 128 pixels big. }
  until offset > 128 * 128;
  { Finally, read the palette. }
  Seek(f, FileSize(f) - 768);
  for i := 0 to 255 do begin
    BlockRead(f, color, 3);
    { RGB values are encoded with 8 bits in the PCX file, but
      our VGA mode requires 6 bits (0..63 only), so we shift
      values right by 2. }
    SetPalette(i, color[0] shr 2, color[1] shr 2, color[2] shr 2);
  end;
  Close(f);
end;

begin
  SetMode($13);
  { Allocate 16k of Heap memory }
  GetMem(texture, 128 * 128);
  texseg := Seg(texture^);
  { Load the texture. }
  LoadPCX('tex1.pcx');

  { Initialize angles to zero. }
  phi := 0; rho := 0; tau := 0;
  repeat
    { Calculate u and v for the pixel in the upper left screen corner
      at 0, 0. }
    calc_uv(0, 0, phi, rho, tau, ul, vl);
    { Now we calculate the rate of change for u and v in regard to
      a step of one pixel to the right (dxu and dxv). To get the value,
      we calculate u and v for the pixel at 1, 0 and subtract the
      u and v values. }
    calc_uv(1, 0, phi, rho, tau, ut, vt);
    dxu := ut - ul;
    dxv := vt - vl;
    { Do the same for y increase: dyu, dyv. }
    calc_uv(0, 1, phi, rho, tau, ut, vt);
    dyu := ut - ul;
    dyv := vt - vl;
    offset := 0;
    { Wait for v blank! }
    WaitSync;
    { Now iterate through every screen line... }
    for sy := 0 to 199 do begin
      { Reset u and v to the values we calculated initially
        (they will later be increased by dyu and dyv). }
      u := ul; v := vl;
      { Iterate through every pixel in the screen line... }
      for sx := 0 to 319 do begin
        { Increase u and v. }
        u := u + dxu; v := v + dxv;
        { Calculate texture coordinates from u and v by shifting
          right by 16 (remember we had 16 bits decimal precision)
          and clamping the result to the texture range of 0..127.
          AND 0x7F means zero out all bits except the lowest 7. }
        tx := (u shr 16) and $7f;
        ty := (v shr 16) and $7f;
        { Fetch the color from the texture. }
        color := Mem[texseg:(ty shl 7 or tx)];
        { Draw the pixel to the screen. }
        Mem[$A000:offset] := color;
        offset := offset + 1;
      end;
      { Advance ul and vl by one step in the y direction. }
      ul := ul + dyu; vl := vl + dyv;
    end;

    { Advance the angles. }
    phi := phi + (sin(rho + tau * 0.1) + 0.2) * 0.02;
    rho := rho + 0.0134;
    tau := tau + 0.03;
  until KeyPressed;
  SetMode(3);
  FreeMem(texture, 128 * 128);
  { That's all folks! }
  { Now let's try this thing out... :-) }
end.

## VGA.PAS
unit VGA;

Interface

procedure SetMode(mode: Integer);
procedure Clear;
procedure SetPixel(x, y: Integer; color: Byte);
function GetPixel(x, y: Integer): Byte;
procedure SetPalette(num,r,g,b: Byte);
procedure GetPalette(num: Byte; var r,g,b: Byte);
procedure WaitSync;
procedure DrawLine(x1,y1,x2,y2: Integer; col: Byte);

Implementation

procedure SetMode(mode: Integer); Assembler;
asm
  mov ax, mode
  int 10h
end;

procedure Clear; Assembler;
asm
  push 0A000h
  pop  es
  xor  di, di
  mov  cx, 16000
  db   66h
  xor  ax, ax
  db   66h
  rep  stosw
end;

procedure SetPixel(x, y: Integer; color: Byte); Assembler;
asm
  mov  di, y
  mov  bx, di
  shl  di, 6
  shl  bx, 8
  add  di, bx
  add  di, x
  mov  al, color
  push 0A000h
  pop  es
  stosb
end;

function GetPixel(x, y: Integer): Byte; Assembler;
asm
  mov  di, y
  mov  bx, di
  shl  di, 6
  shl  bx, 8
  add  di, bx
  add  di, x
  push 0A000h
  pop  es
  mov  al, es:[di]
end;

procedure SetPalette(num,r,g,b: Byte); Assembler;
asm
  mov dx,3C8h
  mov al,num
  out dx,al
  cli
  mov dx,3C9h
  mov al,r
  out dx,al
  mov al,g
  out dx,al
  mov al,b
  out dx,al
  sti
end;

procedure GetPalette(num: Byte; var r,g,b: Byte); Assembler;
asm
  mov dx,3C7h
  mov al,num
  out dx,al
  cli
  mov dx,3C9h
  in  al,dx
  les bx,r
  mov es:[bx],al
  in  al,dx
  les bx,g
  mov es:[bx],al
  in  al,dx
  les bx,b
  mov es:[bx],al
  sti
end;

procedure WaitSync; Assembler;
asm
  mov  dx,3DAh
@l1:
  in   al,dx
  test al,1
  jnz  @l1
@l2:
  in   al,dx
  test al,8
  jz   @l2
end;

procedure Swap(var x, y: Integer);
var t: Integer;
begin
  t := x;
  x := y;
  y := t;
end;

procedure DrawLine(x1, y1, x2, y2: Integer; col: Byte);
var dx, dy, dab, inca, incb, x, y, h1, h2: Integer;
begin
  if (x1 = x2) and (y1 = y2) then SetPixel(x1, y1, col) else begin
    if x1 > x2 then begin
      Swap(x1, x2);
      Swap(y1, y2);
    end;
    dx := x2 - x1;
    dy := y2 - y1;
    h1 := dx;
    h2 := dy;
    if (dx < -dy) and (dy < 0) then begin
      y1 := -y1;
      y2 := -y2;
      Swap(x1, y1);
      Swap(x2, y2);
    end;
    if (dx >= -dy) and (dy < 0) then begin
      y1 := -y1;
      y2 := -y2;
    end;
    if (dx <= dy) and (dy > 0) then begin
      Swap(x1, y1);
      Swap(x2, y2);
    end;
    dx := x2 - x1;
    dy := y2 - y1;
    dab := 2 * dy - dx;
    inca:=2 * (dy - dx);
    incb:=2 * dy;
    x := x1;
    y := y1;
    if (h1 < -h2) and (h2 < 0) then SetPixel(y, -x, col);
    if (h1 >= -h2) and (h2 < 0) then SetPixel(x, -y, col);
    if (h1 > h2) and (h2 >= 0) then SetPixel(x, y, col);
    if (h1 <= h2) and (h2 > 0) then SetPixel(y, x, col);
    for x:=x1 + 1 to x2 do begin
      if dab < 0 then Inc(dab, incb) else begin
        Inc(dab, inca);
        Inc(y);
      end;
      if (h1 < -h2) and (h2 < 0) then SetPixel(y, -x, col);
      if (h1 >= -h2) and (h2 < 0) then SetPixel(x, -y, col);
      if (h1 > h2) and (h2 >= 0) then SetPixel(x, y, col);
      if (h1 <= h2) and (h2 > 0) then SetPixel(y, x, col);
    end;
  end;
end;

end.
	uses Crt, Dos, VGA;

	var phi, rho, tau, scale, x, y: Real;
	ix, iy: Integer;
	tx, ty, sx, sy, i: Integer;
	u, v, ul, vl: LongInt;
	ut, vt: LongInt;
	dxu, dyu, dxv, dyv: LongInt;
	offset: Word;
	color: Integer;
	texture: Pointer;
	texseg: Word;

	{ This is a rotozoomer. The procedure calc_uv returns u and v texture
	coordinates for a given screen space pixel x, y, using three angles
	phi, rho and tau. }

	procedure calc_uv(x, y: Integer; phi, rho, tau: Real; var u, v: LongInt);
	var ru, rv, tu, tv: Real;
	scale: Real;
	begin
	{ transform to center of screen }
	ru := x - 160;
	rv := y - 100;
	{ moving center }
	{ move the center around}
	ru := ru - cos(tau) * 40;
	rv := rv - sin(tau) * 40;
	{ scale }
	{ scale according to some sine function value }
	scale := (((sin(rho) + 1.0) * 0.5) * 0.7 + 1.3);
	ru := ru / scale;
	rv := rv / scale;
	{ rotate }
	{ rotate by -phi }
	tu := ru; tv := rv;
	ru := tu * cos(-phi) - tv * sin(-phi);
	rv := tv * cos(-phi) + tu * sin(-phi);
	{ convert to fixed point }
	{ up to here, we have dealt with real numbers, let's convert them
	to fixed point (15.16)! }
	u := Trunc(ru * 65536);
	v := Trunc(rv * 65536);
	end;

	{ This procedure loads a PCX file. }
	procedure LoadPCX(filename: String);
	var f: File;
	header: array[0..127] of Byte;
	count, i: Byte;
	color: array[0..2] of Byte;
	offset: LongInt;
	begin
	Assign(f, filename);
	Reset(f, 1);
	BlockRead(f, header, 128);
	{ Basically we just skip the 128 header bytes and read the pixel
	values. }
	repeat
	{ Read a pixel. }
	BlockRead(f, i, 1);
	{ RLE compression: if the value is >= 192 (bits 6 and 7 are set),
	this is not a single pixel, but a span of pixels. To obtain the
	span length, subtract 192 (clear bits 6 and 7) and read the next
	byte in the file to obtain the pixel color. }
	if i >= 192 then begin
	count := i - 192;
	BlockRead(f, i, 1);
	{ Draw the pixel count times. }
	while count > 0 do begin
	Mem[texseg:offset] := i;
	Inc(offset);
	Dec(count);
	end;
	end else begin
	{ Not a span, just a plain old pixel. }
	Mem[texseg:offset] := i;
	Inc(offset);
	end;
	{ We know our image is 128 x 128 pixels big. }
	until offset > 128 * 128;
	{ Finally, read the palette. }
	Seek(f, FileSize(f) - 768);
	for i := 0 to 255 do begin
	BlockRead(f, color, 3);
	{ RGB values are encoded with 8 bits in the PCX file, but
	our VGA mode requires 6 bits (0..63 only), so we shift
	values right by 2. }
	SetPalette(i, color[0] shr 2, color[1] shr 2, color[2] shr 2);
	end;
	Close(f);
	end;

	begin
	SetMode($13);
	{ Allocate 16k of Heap memory }
	GetMem(texture, 128 * 128);
	texseg := Seg(texture^);
	{ Load the texture. }
	LoadPCX('tex1.pcx');

	{ Initialize angles to zero. }
	phi := 0; rho := 0; tau := 0;
	repeat
	{ Calculate u and v for the pixel in the upper left screen corner
	at 0, 0. }
	calc_uv(0, 0, phi, rho, tau, ul, vl);
	{ Now we calculate the rate of change for u and v in regard to
	a step of one pixel to the right (dxu and dxv). To get the value,
	we calculate u and v for the pixel at 1, 0 and subtract the
	u and v values. }
	calc_uv(1, 0, phi, rho, tau, ut, vt);
	dxu := ut - ul;
	dxv := vt - vl;
	{ Do the same for y increase: dyu, dyv. }
	calc_uv(0, 1, phi, rho, tau, ut, vt);
	dyu := ut - ul;
	dyv := vt - vl;
	offset := 0;
	{ Wait for v blank! }
	WaitSync;
	{ Now iterate through every screen line... }
	for sy := 0 to 199 do begin
	{ Reset u and v to the values we calculated initially
	(they will later be increased by dyu and dyv). }
	u := ul; v := vl;
	{ Iterate through every pixel in the screen line... }
	for sx := 0 to 319 do begin
	{ Increase u and v. }
	u := u + dxu; v := v + dxv;
	{ Calculate texture coordinates from u and v by shifting
	right by 16 (remember we had 16 bits decimal precision)
	and clamping the result to the texture range of 0..127.
	AND 0x7F means zero out all bits except the lowest 7. }
	tx := (u shr 16) and $7f;
	ty := (v shr 16) and $7f;
	{ Fetch the color from the texture. }
	color := Mem[texseg:(ty shl 7 or tx)];
	{ Draw the pixel to the screen. }
	Mem[$A000:offset] := color;
	offset := offset + 1;
	end;
	{ Advance ul and vl by one step in the y direction. }
	ul := ul + dyu; vl := vl + dyv;
	end;

	{ Advance the angles. }
	phi := phi + (sin(rho + tau * 0.1) + 0.2) * 0.02;
	rho := rho + 0.0134;
	tau := tau + 0.03;
	until KeyPressed;
	SetMode(3);
	FreeMem(texture, 128 * 128);
	{ That's all folks! }
	{ Now let's try this thing out... :-) }
	end.
	unit VGA;

	Interface

	procedure SetMode(mode: Integer);
	procedure Clear;
	procedure SetPixel(x, y: Integer; color: Byte);
	function GetPixel(x, y: Integer): Byte;
	procedure SetPalette(num,r,g,b: Byte);
	procedure GetPalette(num: Byte; var r,g,b: Byte);
	procedure WaitSync;
	procedure DrawLine(x1,y1,x2,y2: Integer; col: Byte);

	Implementation

	procedure SetMode(mode: Integer); Assembler;
	asm
	mov ax, mode
	int 10h
	end;

	procedure Clear; Assembler;
	asm
	push 0A000h
	pop es
	xor di, di
	mov cx, 16000
	db 66h
	xor ax, ax
	db 66h
	rep stosw
	end;

	procedure SetPixel(x, y: Integer; color: Byte); Assembler;
	asm
	mov di, y
	mov bx, di
	shl di, 6
	shl bx, 8
	add di, bx
	add di, x
	mov al, color
	push 0A000h
	pop es
	stosb
	end;

	function GetPixel(x, y: Integer): Byte; Assembler;
	asm
	mov di, y
	mov bx, di
	shl di, 6
	shl bx, 8
	add di, bx
	add di, x
	push 0A000h
	pop es
	mov al, es:[di]
	end;

	procedure SetPalette(num,r,g,b: Byte); Assembler;
	asm
	mov dx,3C8h
	mov al,num
	out dx,al
	cli
	mov dx,3C9h
	mov al,r
	out dx,al
	mov al,g
	out dx,al
	mov al,b
	out dx,al
	sti
	end;

	procedure GetPalette(num: Byte; var r,g,b: Byte); Assembler;
	asm
	mov dx,3C7h
	mov al,num
	out dx,al
	cli
	mov dx,3C9h
	in al,dx
	les bx,r
	mov es:[bx],al
	in al,dx
	les bx,g
	mov es:[bx],al
	in al,dx
	les bx,b
	mov es:[bx],al
	sti
	end;

	procedure WaitSync; Assembler;
	asm
	mov dx,3DAh
	@l1:
	in al,dx
	test al,1
	jnz @l1
	@l2:
	in al,dx
	test al,8
	jz @l2
	end;

	procedure Swap(var x, y: Integer);
	var t: Integer;
	begin
	t := x;
	x := y;
	y := t;
	end;

	procedure DrawLine(x1, y1, x2, y2: Integer; col: Byte);
	var dx, dy, dab, inca, incb, x, y, h1, h2: Integer;
	begin
	if (x1 = x2) and (y1 = y2) then SetPixel(x1, y1, col) else begin
	if x1 > x2 then begin
	Swap(x1, x2);
	Swap(y1, y2);
	end;
	dx := x2 - x1;
	dy := y2 - y1;
	h1 := dx;
	h2 := dy;
	if (dx < -dy) and (dy < 0) then begin
	y1 := -y1;
	y2 := -y2;
	Swap(x1, y1);
	Swap(x2, y2);
	end;
	if (dx >= -dy) and (dy < 0) then begin
	y1 := -y1;
	y2 := -y2;
	end;
	if (dx <= dy) and (dy > 0) then begin
	Swap(x1, y1);
	Swap(x2, y2);
	end;
	dx := x2 - x1;
	dy := y2 - y1;
	dab := 2 * dy - dx;
	inca:=2 * (dy - dx);
	incb:=2 * dy;
	x := x1;
	y := y1;
	if (h1 < -h2) and (h2 < 0) then SetPixel(y, -x, col);
	if (h1 >= -h2) and (h2 < 0) then SetPixel(x, -y, col);
	if (h1 > h2) and (h2 >= 0) then SetPixel(x, y, col);
	if (h1 <= h2) and (h2 > 0) then SetPixel(y, x, col);
	for x:=x1 + 1 to x2 do begin
	if dab < 0 then Inc(dab, incb) else begin
	Inc(dab, inca);
	Inc(y);
	end;
	if (h1 < -h2) and (h2 < 0) then SetPixel(y, -x, col);
	if (h1 >= -h2) and (h2 < 0) then SetPixel(x, -y, col);
	if (h1 > h2) and (h2 >= 0) then SetPixel(x, y, col);
	if (h1 <= h2) and (h2 > 0) then SetPixel(y, x, col);
	end;
	end;
	end;

	end.