include "stdio.s7i";
include "graph.s7i";
include "bytedata.s7i";
include "color.s7i";
include "float.s7i";
include "math.s7i";
var PRIMITIVE_WINDOW: curr_win is PRIMITIVE_WINDOW.value;
const func pixel: colorPixel (in color: col) is
return rgbPixel(col.redLight, col.greenLight, col.blueLight);
const func color: pixelToColor (in pixel: pix) is func
result
var color: col is color.value;
begin
DRAW_PIXEL_TO_RGB(pix, col.redLight, col.greenLight, col.blueLight);
end func;
const proc: screen (in integer: width, in integer: height) is func
begin
curr_win := PRIMITIVE_GRAPHIC_OPEN(0, 0, width, height, name(PROGRAM));
end func;
const proc: color (in color: col) is func
begin
SET_COLOR(colorPixel(col));
end func;
const proc: color (in color: col1, in color: col2) is func
begin
SET_COLOR(colorPixel(col1));
SET_BACKGROUND(colorPixel(col2));
end func;
const proc: point (inout PRIMITIVE_WINDOW: win,
in integer: x, in integer: y, in color: col) is func
begin
DRAW_PPOINT(win, x, y, colorPixel(col));
end func;
const proc: point (in integer: x, in integer: y, in color: col) is func
begin
DRAW_PPOINT(curr_win, x, y, colorPixel(col));
end func;
const proc: line (inout PRIMITIVE_WINDOW: win,
in integer: x, in integer: y,
in integer: delta_x, in integer: delta_y, in color: col) is func
begin
DRAW_PLINE(win, x, y, x + delta_x, y + delta_y, colorPixel(col));
end func;
const proc: line (in integer: x, in integer: y,
in integer: delta_x, in integer: delta_y, in color: col) is func
begin
DRAW_PLINE(curr_win, x, y, x + delta_x, y + delta_y, colorPixel(col));
end func;
const proc: lineTo (inout PRIMITIVE_WINDOW: win,
in integer: x1, in integer: y1,
in integer: x2, in integer: y2, in color: col) is func
begin
DRAW_PLINE(win, x1, y1, x2, y2, colorPixel(col));
end func;
const proc: lineTo (in integer: x1, in integer: y1,
in integer: x2, in integer: y2, in color: col) is func
begin
DRAW_PLINE(curr_win, x1, y1, x2, y2, colorPixel(col));
end func;
const proc: lineToAngle (inout PRIMITIVE_WINDOW: win,
in integer: x, in integer: y,
in integer: length, in float: angle, in color: col) is func
begin
DRAW_PLINE(win, x, y,
x + round(flt(length) * sin(angle)),
y + round(flt(length) * -cos(angle)), colorPixel(col));
end func;
const proc: lineToAngle (in integer: x, in integer: y,
in integer: length, in float: angle, in color: col) is func
begin
DRAW_PLINE(curr_win, x, y,
x + round(flt(length) * sin(angle)),
y + round(flt(length) * -cos(angle)), colorPixel(col));
end func;
const proc: hline (inout PRIMITIVE_WINDOW: win,
in integer: x1, in integer: y1,
in integer: x2, in color: col) is func
begin
DRAW_PLINE(win, x1, y1, x2, y1, colorPixel(col));
end func;
const proc: hline (in integer: x1, in integer: y1,
in integer: x2, in color: col) is func
begin
DRAW_PLINE(curr_win, x1, y1, x2, y1, colorPixel(col));
end func;
const proc: vline (inout PRIMITIVE_WINDOW: win,
in integer: x1, in integer: y1,
in integer: y2, in color: col) is func
begin
DRAW_PLINE(win, x1, y1, x1, y2, colorPixel(col));
end func;
const proc: vline (in integer: x1, in integer: y1,
in integer: y2, in color: col) is func
begin
DRAW_PLINE(curr_win, x1, y1, x1, y2, colorPixel(col));
end func;
const proc: rect (inout PRIMITIVE_WINDOW: win,
in integer: x1, in integer: y1,
in integer: width, in integer: height, in color: col) is func
begin
DRAW_PRECT(win, x1, y1, width, height, colorPixel(col));
end func;
const proc: rect (in integer: x, in integer: y,
in integer: width, in integer: height, in color: col) is func
begin
DRAW_PRECT(curr_win, x, y, width, height, colorPixel(col));
end func;
const proc: rect (inout array array pixel: image,
in integer: x1, in integer: y1,
in integer: width, in integer: height, in color: col) is func
local
var pixel: pix is pixel.value;
var integer: line is 0;
var integer: column is 0;
begin
pix := colorPixel(col);
for line range 1 to height do
for column range 1 to width do
image[y1 + line][x1 + column] := pix;
end for;
end for;
end func;
const proc: rectTo (inout PRIMITIVE_WINDOW: win,
in integer: x1, in integer: y1,
in integer: x2, in integer: y2, in color: col) is func
begin
DRAW_PRECT(win, x1, y1, x2 - x1 + 1, y2 - y1 + 1, colorPixel(col));
end func;
const proc: rectTo (in integer: x1, in integer: y1,
in integer: x2, in integer: y2, in color: col) is func
begin
DRAW_PRECT(curr_win, x1, y1, x2 - x1 + 1, y2 - y1 + 1, colorPixel(col));
end func;
const proc: box (inout PRIMITIVE_WINDOW: win,
in integer: x, in integer: y,
in integer: width, in integer: height, in color: col) is func
local
var pixel: pix is pixel.value;
begin
pix := colorPixel(col);
DRAW_PLINE(win, x, y, pred(x + width), y, pix);
DRAW_PLINE(win, pred(x + width), y, pred(x + width), pred(y + height), pix);
DRAW_PLINE(win, pred(x + width), pred(y + height), x, pred(y + height), pix);
DRAW_PLINE(win, x, pred(y + height), x, y, pix);
end func;
const proc: box (in integer: x, in integer: y,
in integer: width, in integer: height, in color: col) is func
local
var pixel: pix is pixel.value;
begin
pix := colorPixel(col);
DRAW_PLINE(curr_win, x, y, pred(x + width), y, pix);
DRAW_PLINE(curr_win, pred(x + width), y, pred(x + width), pred(y + height), pix);
DRAW_PLINE(curr_win, pred(x + width), pred(y + height), x, pred(y + height), pix);
DRAW_PLINE(curr_win, x, pred(y + height), x, y, pix);
end func;
const proc: boxTo (inout PRIMITIVE_WINDOW: win,
in integer: x1, in integer: y1,
in integer: x2, in integer: y2, in color: col) is func
local
var pixel: pix is pixel.value;
begin
pix := colorPixel(col);
DRAW_PLINE(win, x1, y1, x2, y1, pix);
DRAW_PLINE(win, x2, y1, x2, y2, pix);
DRAW_PLINE(win, x2, y2, x1, y2, pix);
DRAW_PLINE(win, x1, y2, x1, y1, pix);
end func;
const proc: boxTo (in integer: x1, in integer: y1,
in integer: x2, in integer: y2, in color: col) is func
local
var pixel: pix is pixel.value;
begin
pix := colorPixel(col);
DRAW_PLINE(curr_win, x1, y1, x2, y1, pix);
DRAW_PLINE(curr_win, x2, y1, x2, y2, pix);
DRAW_PLINE(curr_win, x2, y2, x1, y2, pix);
DRAW_PLINE(curr_win, x1, y2, x1, y1, pix);
end func;
const proc: circle (inout PRIMITIVE_WINDOW: win,
in integer: x, in integer: y, in integer: radius, in color: col) is func
begin
DRAW_CIRCLE(win, x, y, radius, colorPixel(col));
end func;
const proc: circle (in integer: x, in integer: y, in integer: radius, in color: col) is func
begin
DRAW_CIRCLE(curr_win, x, y, radius, colorPixel(col));
end func;
const proc: fcircle (inout PRIMITIVE_WINDOW: win,
in integer: x, in integer: y, in integer: radius, in color: col) is func
begin
FILL_CIRCLE(win, x, y, radius, colorPixel(col));
end func;
const proc: fcircle (in integer: x, in integer: y, in integer: radius, in color: col) is func
begin
FILL_CIRCLE(curr_win, x, y, radius, colorPixel(col));
end func;
const proc: arc (inout PRIMITIVE_WINDOW: win,
in integer: x, in integer: y, in integer: radius,
in float: startAngle, in float: sweepAngle, in color: col) is func
begin
DRAW_ARC(win, x, y, radius, startAngle, sweepAngle, colorPixel(col));
end func;
const proc: arc (in integer: x, in integer: y, in integer: radius,
in float: startAngle, in float: sweepAngle, in color: col) is func
begin
DRAW_ARC(curr_win, x, y, radius, startAngle, sweepAngle, colorPixel(col));
end func;
const proc: arc (inout PRIMITIVE_WINDOW: win,
in integer: x, in integer: y, in integer: radius,
in float: startAngle, in float: sweepAngle, in integer: width,
in color: col) is func
begin
DRAW_ARC(win, x, y, radius, startAngle, sweepAngle, width, colorPixel(col));
end func;
const proc: arc (in integer: x, in integer: y, in integer: radius,
in float: startAngle, in float: sweepAngle, in integer: width,
in color: col) is func
begin
DRAW_ARC(curr_win, x, y, radius, startAngle, sweepAngle, width, colorPixel(col));
end func;
const proc: chord (in integer: x, in integer: y, in integer: radius,
in float: startAngle, in float: sweepAngle, in color: col) is func
begin
FILL_ARCCHORD(curr_win, x, y, radius, startAngle, sweepAngle, colorPixel(col));
end func;
const proc: pieslice (in integer: x, in integer: y, in integer: radius,
in float: startAngle, in float: sweepAngle, in color: col) is func
begin
FILL_ARCPIESLICE(curr_win, x, y, radius, startAngle, sweepAngle, colorPixel(col));
end func;
const proc: fellipse (inout PRIMITIVE_WINDOW: win,
in integer: x, in integer: y,
in integer: width, in integer: height, in color: col) is func
begin
FILL_ELLIPSE(win, x, y, width, height, colorPixel(col));
end func;
const proc: fellipse (in integer: x, in integer: y,
in integer: width, in integer: height, in color: col) is func
begin
FILL_ELLIPSE(curr_win, x, y, width, height, colorPixel(col));
end func;
const proc: clear (inout PRIMITIVE_WINDOW: win, in color: col) is func
begin
DRAW_CLEAR(win, colorPixel(col));
end func;
const proc: clear (inout PRIMITIVE_WINDOW: win) is func
begin
DRAW_CLEAR(win, colorPixel(black));
end func;
const proc: clear (in color: col) is func
begin
DRAW_CLEAR(curr_win, colorPixel(col));
end func;
const proc: polyLine (inout PRIMITIVE_WINDOW: win,
in integer: x, in integer: y, in pointList: points, in color: col) is func
begin
DRAW_POLYLINE(win, x, y, points, colorPixel(col));
end func;
const proc: polyLine (in integer: x, in integer: y, in pointList: points, in color: col) is func
begin
DRAW_POLYLINE(curr_win, x, y, points, colorPixel(col));
end func;
const proc: fpolyLine (inout PRIMITIVE_WINDOW: win,
in integer: x, in integer: y, in pointList: points, in color: col) is func
begin
FILL_POLYLINE(win, x, y, points, colorPixel(col));
end func;
const proc: fpolyLine (in integer: x, in integer: y, in pointList: points, in color: col) is func
begin
FILL_POLYLINE(curr_win, x, y, points, colorPixel(col));
end func;
const proc: paint (in integer: x, in integer: y, in integer: col) is func
begin
write("PAINT");
end func;
const proc: put (inout PRIMITIVE_WINDOW: destWindow, in integer: xDest,
in integer: yDest, in PRIMITIVE_WINDOW: pixmap) is action "DRW_PUT";
const proc: put (in integer: xDest, in integer: yDest,
in PRIMITIVE_WINDOW: pixmap) is func
begin
put(curr_win, xDest, yDest, pixmap);
end func;
const proc: put (inout PRIMITIVE_WINDOW: win,
in integer: x, in integer: y,
in PRIMITIVE_WINDOW: pixmap, PSET) is func
begin
put(win, x, y, pixmap);
end func;
const proc: put (inout PRIMITIVE_WINDOW: win,
in integer: x, in integer: y,
in PRIMITIVE_WINDOW: pixmap, XOR) is func
begin
put(win, x, y, pixmap);
end func;
const proc: put (in integer: x, in integer: y,
in PRIMITIVE_WINDOW: pixmap, PSET) is func
begin
put(curr_win, x, y, pixmap);
end func;
const proc: put (in integer: x, in integer: y,
in PRIMITIVE_WINDOW: pixmap, XOR) is func
begin
put(curr_win, x, y, pixmap);
end func;
const proc: put (inout PRIMITIVE_WINDOW: destWindow, in integer: xDest,
in integer: yDest, in integer: width, in integer: height,
in PRIMITIVE_WINDOW: pixmap) is action "DRW_PUT_SCALED";
const func PRIMITIVE_WINDOW: newPixmap (in integer: width, in integer: height) is action "DRW_NEW_PIXMAP";
const func PRIMITIVE_WINDOW: getPixmap (in PRIMITIVE_WINDOW: sourceWin,
in integer: left, in integer: upper, in integer: width, in integer: height) is action "DRW_GET_PIXMAP";
const func PRIMITIVE_WINDOW: getPixmap (in integer: left, in integer: upper,
in integer: width, in integer: height) is
return getPixmap(curr_win, left, upper, width, height);
const func PRIMITIVE_WINDOW: getPixmap (in PRIMITIVE_WINDOW: sourceWin) is
return getPixmap(sourceWin, 0, 0, width(sourceWin), height(sourceWin));
const func PRIMITIVE_WINDOW: getPixmap (in PRIMITIVE_WINDOW: sourceWin,
in integer: left, in integer: upper, in integer: width, in integer: height,
in color: background) is func
result
var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
local
var integer: sourceLeft is 0;
var integer: sourceUpper is 0;
var integer: copyWidth is 0;
var integer: copyHeight is 0;
var integer: destLeft is 0;
var integer: destUpper is 0;
var PRIMITIVE_WINDOW: sourceToCopy is PRIMITIVE_WINDOW.value;
begin
pixmap := newPixmap(width, height);
if left + width <= 0 or left >= width(sourceWin) or
upper + height <= 0 or upper >= height(sourceWin) then
clear(pixmap, background);
else
sourceLeft := left;
copyWidth := width;
if left < 0 then
rect(pixmap, 0, 0, -left, height, background);
sourceLeft := 0;
copyWidth +:= left;
destLeft := -left;
end if;
if left + width > width(sourceWin) then
rect(pixmap, width(sourceWin) - left, 0, left + width - width(sourceWin), height, background);
copyWidth -:= left + width - width(sourceWin);
end if;
sourceUpper := upper;
copyHeight := height;
if upper < 0 then
rect(pixmap, 0, 0, width, -upper, background);
sourceUpper := 0;
copyHeight +:= upper;
destUpper := -upper;
end if;
if upper + height > height(sourceWin) then
rect(pixmap, 0, height(sourceWin) - upper, width, upper + height - height(sourceWin), background);
copyHeight -:= upper + height - height(sourceWin);
end if;
sourceToCopy := getPixmap(sourceWin, sourceLeft, sourceUpper, copyWidth, copyHeight);
put(pixmap, destLeft, destUpper, sourceToCopy);
end if;
end func;
const func PRIMITIVE_WINDOW: getPixmap (in PRIMITIVE_WINDOW: sourceWin,
in integer: left, in integer: upper, in integer: width, in integer: height,
in integer: resultWidth, in integer: resultHeight, in color: background) is func
result
var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
local
var integer: sourceLeft is 0;
var integer: sourceUpper is 0;
var integer: copyWidth is 0;
var integer: copyHeight is 0;
var integer: destLeft is 0;
var integer: destUpper is 0;
var PRIMITIVE_WINDOW: sourceToCopy is PRIMITIVE_WINDOW.value;
begin
pixmap := newPixmap(resultWidth, resultHeight);
clear(pixmap, background);
if left + width > 0 and left < width(sourceWin) and
upper + height > 0 and upper < height(sourceWin) then
sourceLeft := left;
copyWidth := width;
if left < 0 then
sourceLeft := 0;
copyWidth +:= left;
destLeft := -left;
end if;
if left + width > width(sourceWin) then
copyWidth -:= left + width - width(sourceWin);
end if;
sourceUpper := upper;
copyHeight := height;
if upper < 0 then
sourceUpper := 0;
copyHeight +:= upper;
destUpper := -upper;
end if;
if upper + height > height(sourceWin) then
copyHeight -:= upper + height - height(sourceWin);
end if;
sourceToCopy := getPixmap(sourceWin, sourceLeft, sourceUpper, copyWidth, copyHeight);
put(pixmap, destLeft * resultWidth mdiv width, destUpper * resultHeight mdiv height,
copyWidth * resultWidth mdiv width, copyHeight * resultHeight mdiv height, sourceToCopy);
end if;
end func;
const func PRIMITIVE_WINDOW: getPixmap (ref array array pixel: image) is action "DRW_GET_PIXMAP_FROM_PIXELS";
const func array array pixel: getPixelArray (in PRIMITIVE_WINDOW: aWindow) is action "DRW_GET_PIXEL_ARRAY";
const proc: setTransparentColor (in PRIMITIVE_WINDOW: pixmap, in color: col) is func
begin
SET_TRANSPARENTCOLOR(pixmap, colorPixel(col));
end func;
const func color: getPixelColor (in PRIMITIVE_WINDOW: aWindow,
in integer: x, in integer: y) is func
result
var color: col is color.value;
local
var pixel: pix is pixel.value;
begin
pix := getPixel(aWindow, x, y);
DRAW_PIXEL_TO_RGB(pix, col.redLight, col.greenLight, col.blueLight);
end func;
const func color: getPixelColor (in bstring: bImage, in integer: width,
in integer: height, in integer: x, in integer: y) is func
result
var color: col is color.value;
local
var pixel: pix is pixel.value;
begin
pix := getPixel(bImage, width, height, x, y);
DRAW_PIXEL_TO_RGB(pix, col.redLight, col.greenLight, col.blueLight);
end func;
const proc: palette (in integer: col, in integer: pal) is func
begin
write("PALETTE");
end func;
const proc: palette is func
begin
write("PALETTE");
end func;
const proc: sound (in integer: freq, in integer: dur) is func
begin
write("SOUND");
end func;