324 lines
10 KiB
Plaintext
324 lines
10 KiB
Plaintext
! Creates a simple 54x50 image and writes to stdout (it pgm format).
|
|
! usage:
|
|
! java TAM.Interpreter obj.tam | grep -v "\*" > out.pgm
|
|
! xv out.pgm
|
|
|
|
let
|
|
|
|
type PackedPixel ~ Integer; !three pixels packed into an int
|
|
type Byte ~ Integer; !one pixel
|
|
|
|
! The Triangle code emitter is a bit strange: A single record
|
|
! may not be larger than 255 words. Thus, if we would define
|
|
! an Image record consisting of an Integer for width and
|
|
! height and a data array, the data array could contain 254 elements
|
|
! at most -- barely enough for a 15x15 image.
|
|
! Because of this, the following records are needed to support
|
|
! images with somewhat larger dimensions.
|
|
! [For even larget images, some more records could be used (a Tile
|
|
! is an array of Scanlines, an Image is an array of Tiles), but
|
|
! the stupid Triangle interpreter has a maximal data store size of
|
|
! 1024 words (!!) anyways and segfaults if our image data is larger
|
|
! than that.]
|
|
! To leave room for 32 local variables, the image data
|
|
! size is maximal 4*225 = 900 bytes -- 30x30 pixels, not *that* much better...
|
|
! (this has at least the benefit that we don't have to fear overflow
|
|
! in expressions like y*width + x :-P )
|
|
! A Triangle integer is 16 bit - because they are signed, using only
|
|
! the lower 15 bits is easier (this way, they are always non-negative).
|
|
! To increase the maximal image size a bit more, we store three 5bit pixels
|
|
! in one Integer (this gives us only 32 gray levels, but that's worth it).
|
|
! This way we get 900*3 = 2700 pixels - a 54x50 image.
|
|
|
|
const BUFFERSIZE ~ 225;
|
|
const PIXSIZE ~ 3*BUFFERSIZE; !3 values in one "pixel"
|
|
|
|
type Buffer ~ record
|
|
! size should match BUFFERSIZE (Triangle needs an integer literal,
|
|
! I can't use BUFFERSIZE here :-( )
|
|
data : array 225 of PackedPixel
|
|
end;
|
|
|
|
type Image ~ record
|
|
! grayscale image
|
|
|
|
buffer : array 4 of Buffer,
|
|
width : Integer,
|
|
height: Integer
|
|
end;
|
|
|
|
proc createImage(var image : Image, w : Integer, h : Integer) ~
|
|
begin
|
|
!check if it fits into mem, halt program if not
|
|
if w*h > (4*PIXSIZE) then
|
|
let
|
|
var bla : Integer
|
|
in begin
|
|
put('x'); puteol();
|
|
bla := 30000;
|
|
bla := 30000*bla; !integer overflow will halt program
|
|
end else ;
|
|
|
|
image.width := w;
|
|
image.height := h;
|
|
end;
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
!! bit fiddling stuff
|
|
func pow2(v : Integer) : Integer ~
|
|
if v = 0 then 1 else 2*pow2(v - 1);
|
|
|
|
! g is 0, 1 or 2 to select one of the three pixels
|
|
func getGroup(p : PackedPixel, g : Integer) : Byte ~
|
|
(p / pow2(g*5)) // 32;
|
|
|
|
! v has to be < 32
|
|
!func setGroup(p : Pixel, v : Byte, g : Integer) : Pixel ~
|
|
! ! don't factor pow2(g*5) to prevent negative numbers
|
|
! (p - getGroup(p, g)*pow2(g*5)) + v*pow2(g*5);
|
|
|
|
!for whatever reasons the above code gives an overflow all the time.
|
|
!it works with a local variable, though. Triangle rocks.
|
|
|
|
proc setGroup(var p : PackedPixel, v : Byte, g : Integer) ~
|
|
let
|
|
! required to work around some Triangle bug...
|
|
var tmp : Integer
|
|
in begin
|
|
! clear old bits
|
|
tmp := getGroup(p, g)*pow2(g*5);
|
|
p := p - tmp;
|
|
|
|
! set new bits
|
|
if v < 31 then tmp := v else tmp := 31;
|
|
tmp := tmp*pow2(g*5);
|
|
p := p + tmp
|
|
end;
|
|
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
!! set/get a single pixel
|
|
|
|
! proc setPixel(var image : Image, x : Integer, y : Integer, value : Integer) ~
|
|
! let
|
|
! var address : Integer
|
|
! in begin
|
|
! address := y*image.width + x;
|
|
! image.buffer[address / BUFFERSIZE].data[address // BUFFERSIZE] := value;
|
|
! end;
|
|
!
|
|
! func getPixel(image : Image, x : Integer, y : Integer) : Pixel ~
|
|
! image.buffer[ (y*image.width + x) / BUFFERSIZE ].
|
|
! data[ (y*image.width + x) // BUFFERSIZE ];
|
|
|
|
! MIST: das da oben geht nicht, weil Triangle nicht will, das einzelne
|
|
! Argumente groesser als 255 Woerter sind. Also so:
|
|
|
|
proc setPixel(x : Integer, y : Integer, w : Integer,
|
|
var buff0 : Buffer, var buff1 : Buffer,
|
|
var buff2 : Buffer, var buff3 : Buffer, value : Byte) ~
|
|
let
|
|
var address : Integer
|
|
in begin
|
|
address := y*w + x;
|
|
if address / PIXSIZE = 0 then
|
|
setGroup(var buff0.data[(address // PIXSIZE) / 3], value,
|
|
(address // PIXSIZE) // 3)
|
|
else if address / PIXSIZE = 1 then
|
|
setGroup(var buff1.data[(address // PIXSIZE) / 3], value,
|
|
(address // PIXSIZE) // 3)
|
|
else if address / PIXSIZE = 2 then
|
|
setGroup(var buff2.data[(address // PIXSIZE) / 3], value,
|
|
(address // PIXSIZE) // 3)
|
|
else if address / PIXSIZE = 3 then
|
|
setGroup(var buff3.data[(address // PIXSIZE) / 3], value,
|
|
(address // PIXSIZE) // 3)
|
|
else
|
|
end;
|
|
|
|
! the buffn's aren't changed, but if we don't pass them by reference,
|
|
! Triangle tries to copy them before passing them to the function.
|
|
! This overflows the data store, so we pass by reference to avoid
|
|
! the copy
|
|
func getPixel(x : Integer, y : Integer, w : Integer,
|
|
var buff0 : Buffer, var buff1 : Buffer,
|
|
var buff2 : Buffer, var buff3 : Buffer) : Byte ~
|
|
if (y*w + x) / PIXSIZE = 0 then
|
|
getGroup(buff0.data[((y*w + x) // PIXSIZE) / 3],
|
|
((y*w + x) // PIXSIZE) // 3)
|
|
else if (y*w + x) / PIXSIZE = 1 then
|
|
getGroup(buff1.data[((y*w + x) // PIXSIZE) / 3],
|
|
((y*w + x) // PIXSIZE) // 3)
|
|
else if (y*w + x) / PIXSIZE = 2 then
|
|
getGroup(buff2.data[((y*w + x) // PIXSIZE) / 3],
|
|
((y*w + x) // PIXSIZE) // 3)
|
|
else if (y*w + x) / PIXSIZE = 3 then
|
|
getGroup(buff3.data[((y*w + x) // PIXSIZE) / 3],
|
|
((y*w + x) // PIXSIZE) // 3)
|
|
else
|
|
0;
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
!! save image
|
|
|
|
proc writePbmAscii(w : Integer, h : Integer,
|
|
var buff0 : Buffer, var buff1 : Buffer,
|
|
var buff2 : Buffer, var buff3 : Buffer) ~
|
|
let
|
|
var x : Integer;
|
|
var y : Integer
|
|
in begin
|
|
!write header
|
|
put('P'); put('2'); puteol(); !format id
|
|
putint(w); put(' '); putint(h); puteol(); !size
|
|
putint(31); puteol(); !maximum gray value
|
|
|
|
!write data
|
|
y := 0;
|
|
while y < h do begin
|
|
|
|
x := 0;
|
|
while x < w do begin
|
|
putint(getPixel(x, y, w, var buff0, var buff1, var buff2, var buff3));
|
|
put(' ');
|
|
x := x + 1
|
|
end;
|
|
|
|
puteol();
|
|
y := y + 1
|
|
end;
|
|
end;
|
|
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
!! line drawing
|
|
|
|
proc incPixel(x : Integer, y : Integer, w : Integer,
|
|
var buff0 : Buffer, var buff1 : Buffer,
|
|
var buff2 : Buffer, var buff3 : Buffer) ~
|
|
setPixel(x, y, w, var buff0, var buff1, var buff2, var buff3,
|
|
getPixel(x, y, w, var buff0, var buff1, var buff2, var buff3) + 9);
|
|
|
|
! draws a line with the bresenham algorithm. increments pixels drawn.
|
|
! doesn't clip the line, so pass only valid coords!
|
|
! start and end points are both inclusive.
|
|
proc drawLine(x1 : Integer, y1 : Integer, x2 : Integer, y2 : Integer,
|
|
w : Integer, var buff0 : Buffer, var buff1 : Buffer,
|
|
var buff2 : Buffer, var buff3 : Buffer) ~
|
|
let
|
|
var xLength : Integer;
|
|
var yLength : Integer;
|
|
var dx : Integer;
|
|
var dy : Integer;
|
|
var error : Integer;
|
|
var i : Integer;
|
|
var xCoord : Integer;
|
|
var yCoord : Integer
|
|
in begin
|
|
|
|
xCoord := x1;
|
|
yCoord := y1;
|
|
error := 0;
|
|
xLength := x2 - x1;
|
|
if xLength < 0 then
|
|
begin
|
|
xLength := 0 - xLength;
|
|
dx := 0 - 1;
|
|
end
|
|
else
|
|
dx := 1;
|
|
|
|
yLength := y2 - y1;
|
|
if yLength < 0 then
|
|
begin
|
|
yLength := 0 - yLength;
|
|
dy := 0 - 1;
|
|
end
|
|
else
|
|
dy := 1;
|
|
|
|
if xLength < yLength then !m > 1
|
|
begin
|
|
i := 0;
|
|
while i <= yLength do
|
|
begin
|
|
incPixel(xCoord, yCoord, w, var buff0, var buff1, var buff2, var buff3);
|
|
yCoord := yCoord + dy;
|
|
error := error + xLength;
|
|
if error >= yLength then
|
|
begin
|
|
xCoord := xCoord + dx;
|
|
error := error - yLength;
|
|
end else;
|
|
i := i + 1
|
|
end;
|
|
end
|
|
else !m <= 1
|
|
begin
|
|
i := 0;
|
|
while i <= xLength do
|
|
begin
|
|
incPixel(xCoord, yCoord, w, var buff0, var buff1, var buff2, var buff3);
|
|
xCoord := xCoord + dx;
|
|
error := error + yLength;
|
|
if error >= xLength then
|
|
begin
|
|
yCoord := yCoord + dy;
|
|
error := error - xLength;
|
|
end else;
|
|
i := i + 1
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
const STEPS ~ 10;
|
|
var image : Image;
|
|
var i : Integer;
|
|
var j : Integer
|
|
|
|
in begin
|
|
|
|
|
|
! draw a fancy image
|
|
createImage(var image, 54, 50);
|
|
i := 0;
|
|
while i < STEPS do begin
|
|
drawLine((i*image.width)/STEPS, 0,
|
|
0, image.height - 1 - ((i*image.height)/STEPS),
|
|
image.width,
|
|
var image.buffer[0], var image.buffer[1],
|
|
var image.buffer[2], var image.buffer[3]);
|
|
drawLine((i*image.width)/STEPS, 0,
|
|
image.width - 1, (i*image.height)/STEPS,
|
|
image.width,
|
|
var image.buffer[0], var image.buffer[1],
|
|
var image.buffer[2], var image.buffer[3]);
|
|
|
|
drawLine((i*image.width)/STEPS, image.height - 1,
|
|
image.width - 1, image.height - 1 - ((i*image.height)/STEPS),
|
|
image.width,
|
|
var image.buffer[0], var image.buffer[1],
|
|
var image.buffer[2], var image.buffer[3]);
|
|
drawLine((i*image.width)/STEPS, image.height - 1,
|
|
0, (i*image.height)/STEPS,
|
|
image.width,
|
|
var image.buffer[0], var image.buffer[1],
|
|
var image.buffer[2], var image.buffer[3]);
|
|
i := i + 1
|
|
end;
|
|
|
|
writePbmAscii(image.width, image.height,
|
|
var image.buffer[0], var image.buffer[1],
|
|
var image.buffer[2], var image.buffer[3])
|
|
|
|
! testing code:
|
|
!setPixel(50, 48, image.width, var image.buffer[0], var image.buffer[1], var image.buffer[2], var image.buffer[3], 15);
|
|
!putint(getPixel(50, 48, image.width, var image.buffer[0], var image.buffer[1], var image.buffer[2], var image.buffer[3]));
|
|
|
|
! i := 30000;
|
|
! setGroup(var i, 31, 2);
|
|
! putint(getGroup(i, 2));
|
|
|
|
end
|
|
|