(********************************************************************)
(*                                                                  *)
(*  draw.s7i      Portable graphic library                          *)
(*  Copyright (C) 2001, 2005, 2007, 2011  Thomas Mertes             *)
(*                                                                  *)
(*  This file is part of the Seed7 Runtime Library.                 *)
(*                                                                  *)
(*  The Seed7 Runtime Library is free software; you can             *)
(*  redistribute it and/or modify it under the terms of the GNU     *)
(*  Lesser General Public License as published by the Free Software *)
(*  Foundation; either version 2.1 of the License, or (at your      *)
(*  option) any later version.                                      *)
(*                                                                  *)
(*  The Seed7 Runtime Library is distributed in the hope that it    *)
(*  will be useful, but WITHOUT ANY WARRANTY; without even the      *)
(*  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR *)
(*  PURPOSE.  See the GNU Lesser General Public License for more    *)
(*  details.                                                        *)
(*                                                                  *)
(*  You should have received a copy of the GNU Lesser General       *)
(*  Public License along with this program; if not, write to the    *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


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;


(**
 *  Convert a [[color]] to a pixel.
 *)
const func pixel: colorPixel (in color: col) is
  return rgbPixel(col.redLight, col.greenLight, col.blueLight);


(**
 *  Convert a pixel to a [[color]].
 *)
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;


(**
 *  Open the default window (''curr_win'') with the given ''width'' and ''height''.
 *)
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;


(**
 *  Draws a point with the color ''col'' to the window ''win'' at the
 *  position (x, y).
 *)
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;


(**
 *  Draws a point with the color ''col'' to the current window ''curr_win''
 *  at the position (x, y).
 *)
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;


(**
 *  Draws a line with the color ''col'' to the window ''win''.
 *  The line starts at (x, y) and ends at (delta_x, delta_y).
 *  The coordinates of the endpoint are measured relative to x, y.
 *)
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;


(**
 *  Draws a line with the color ''col'' to the current window ''curr_win''.
 *  The line starts at (x, y) and ends at (delta_x, delta_y).
 *  The coordinates of the endpoint are measured relative to x, y.
 *)
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;


(**
 *  Draws a line with the color ''col'' to the window ''win''.
 *  The line starts at (x1, y1) and ends at (x2, y2).
 *  The coordinates of the endpoint are measured in absolute
 *  window coordinates.
 *)
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;


(**
 *  Draws a line with the color ''col'' to the current window ''curr_win''.
 *  The line starts at (x1, y1) and ends at (x2, y2).
 *  The coordinates of the endpoint are measured in absolute
 *  window coordinates.
 *)
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;


(**
 *  Draws a line with the color ''col'' to the window ''win''.
 *  The line starts at (x, y), has the given ''length'' and extends
 *  in the given ''angle''.
 *)
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;


(**
 *  Draws a line with the color ''col'' to the current window ''curr_win''.
 *  The line starts at (x, y), has the given ''length'' and extends
 *  in the given ''angle''.
 *)
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;


(**
 *  Draws a filled rectangle with the color ''col'' to the window ''win''.
 *  The top left edge of the rectangle is at (x1, y1). The size of the
 *  rectangle is specified with ''width'' and ''height''.
 *)
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;


(**
 *  Draws a filled rectangle with the color ''col'' to the current window ''curr_win''.
 *  The top left edge of the rectangle is at (x, y). The size of the
 *  rectangle is specified with ''width'' and ''height''.
 *)
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;


(**
 *  Draws a filled rectangle with the color ''col'' to the window ''win''.
 *  The top left edge of the rectangle is at (x1, y1) and the lower right
 *  edge is at (x2, y2).
 *)
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;


(**
 *  Draws a filled rectangle with the color ''col'' to the current window ''curr_win''.
 *  The top left edge of the rectangle is at (x1, y1) and the lower right
 *  edge is at (x2, y2).
 *)
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;


(**
 *  Draws an empty rectangle with the color ''col'' to the window ''win''.
 *  The top left edge of the rectangle is at (x, y). The size of the
 *  rectangle is specified with ''width'' and ''height''.
 *)
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;


(**
 *  Draws an empty rectangle with the color ''col'' to the current window ''curr_win''.
 *  The top left edge of the rectangle is at (x, y). The size of the
 *  rectangle is specified with ''width'' and ''height''.
 *)
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;


(**
 *  Draws an empty rectangle with the color ''col'' to the window ''win''.
 *  The top left edge of the rectangle is at (x1, y1) and the lower right
 *  edge is at (x2, y2).
 *)
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;


(**
 *  Draws an empty rectangle with the color ''col'' to the current window ''curr_win''.
 *  The top left edge of the rectangle is at (x1, y1) and the lower right
 *  edge is at (x2, y2).
 *)
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;


(**
 *  Draws a circle with the color ''col'' to the window ''win''.
 *  The circle has the given ''radius'' and its center is at (x, y).
 *)
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;


(**
 *  Draws a circle with the color ''col'' to the current window ''curr_win''.
 *  The circle has the given ''radius'' and its center is at (x, y).
 *)
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;


(**
 *  Draws a filled circle with the color ''col'' to the window ''win''.
 *  The circle has the given ''radius'' and its center is at (x, y).
 *)
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;


(**
 *  Draws a filled circle with the color ''col'' to the current window ''curr_win''.
 *  The circle has the given ''radius'' and its center is at (x, y).
 *)
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;


(**
 *  Draws an arc with the color ''col'' to the window ''win''.
 *  The arc has the given ''radius'' and its center is at (x, y).
 *  The arc begins at ''startAngle'' and spans over ''sweepAngle''.
 *)
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;


(**
 *  Draws an arc with the color ''col'' to the current window ''curr_win''.
 *  The arc has the given ''radius'' and its center is at (x, y).
 *  The arc begins at ''startAngle'' and spans over ''sweepAngle''.
 *)
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;


(**
 *  Draws an arc with the color ''col'' to the window ''win''.
 *  The arc has the given ''radius'' and its center is at (x, y).
 *  The arc begins at ''startAngle'' and spans over ''sweepAngle''.
 *)
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;


(**
 *  Draws an arc with the color ''col'' to the current window ''curr_win''.
 *  The arc has the given ''radius'' and its center is at (x, y).
 *  The arc begins at ''startAngle'' and spans over ''sweepAngle''.
 *)
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;


(**
 *  Draws a filled sector with color ''col'' to ''curr_win''.
 *  The sector has the given ''radius'' and its center is at (x, y).
 *  The sector begins at ''startAngle'' and spans over ''sweepAngle''.
 *)
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;


(**
 *  Clears the window ''win'' with the color ''col''.
 *)
const proc: clear (inout PRIMITIVE_WINDOW: win, in color: col) is func
  begin
    DRAW_CLEAR(win, colorPixel(col));
  end func;


(**
 *  Clears the window ''win'' with the color black.
 *)
const proc: clear (inout PRIMITIVE_WINDOW: win) is func
  begin
    DRAW_CLEAR(win, colorPixel(black));
  end func;


(**
 *  Clears the current window ''curr_win'' with the color ''col''.
 *)
const proc: clear (in color: col) is func
  begin
    DRAW_CLEAR(curr_win, colorPixel(col));
  end func;


(**
 *  Draws lines with the color ''col'' to the window ''win''.
 *  The lines connect the ''points'' and are drawn at the position (x, y).
 *)
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;


(**
 *  Draws lines with the color ''col'' to the current window ''curr_win''.
 *  The lines connect the ''points'' and are drawn at the position (x, y).
 *)
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;


(**
 *  Draws a filled polygon with the color ''col'' to the window ''win''.
 *  The corners of the polygon are given with ''points''.
 *  The polygon is drawn at the position (x, y).
 *)
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;


(**
 *  Draws a filled polygon with the color ''col'' to the current window ''curr_win''.
 *  The corners of the polygon are given with ''points''.
 *  The polygon is drawn at the position (x, y).
 *)
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;


(**
 *  Put ''pixmap'' to the given position at ''destWindow''.
 *  The top left edge of ''pixmap'' is put at (''xDest'', ''yDest'').
 *  @param destWindow Destination Window.
 *  @param xDest X-coordinate of the destination position.
 *  @param yDest Y-coordinate of the destination position.
 *  @param pixmap Source window to be put to the destination.
 *)
const proc: put (inout PRIMITIVE_WINDOW: destWindow, in integer: xDest,
    in integer: yDest, in PRIMITIVE_WINDOW: pixmap) is action "DRW_PUT";


(**
 *  Put ''pixmap'' to the given position at the current window 'curr_win'.
 *  The top left edge of ''pixmap'' is put at (''xDest'', ''yDest'').
 *  @param xDest X-coordinate of the destination position.
 *  @param yDest Y-coordinate of the destination position.
 *  @param pixmap Source window to be put to the destination.
 *)
const proc: put (in integer: xDest, in integer: yDest,
    in PRIMITIVE_WINDOW: pixmap) is func
  begin
    put(curr_win, xDest, yDest, pixmap);
  end func;


(**
 *  Put a scaled ''pixmap'' to the given rectangle at ''destWindow''.
 *  The top left edge of the destination rectangle is at (''xDest'', ''yDest'').
 *  @param destWindow Destination Window.
 *  @param xDest X-coordinate of the destination rectangle.
 *  @param yDest Y-coordinate of the destination rectangle.
 *  @param width Width of the destination rectangle.
 *  @param height Height of the destination rectangle.
 *  @param pixmap Source window to be scaled to the rectangle.
 *)
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";


(**
 *  Create a new pixmap with the given ''width'' and ''height''.
 *  @return the created pixmap.
 *)
const func PRIMITIVE_WINDOW: newPixmap (in integer: width, in integer: height) is action "DRW_NEW_PIXMAP";


(**
 *  Create a new pixmap with the given ''width'' and ''height'' from ''sourceWin''.
 *  A rectangle with the upper left corner at (''left'', ''upper'') and the given
 *  ''width'' and ''height'' is copied from ''sourceWin'' to the new pixmap.
 *  The rectangle may extend to areas outside of ''sourceWin''. The rectangle
 *  areas outside of ''sourceWin'' are colored with black.
 *  @return the created 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";


(**
 *  Create a new pixmap with the given ''width'' and ''height'' from ''curr_win''.
 *  A rectangle with the upper left corner at (''left'', ''upper'') and the given
 *  ''width'' and ''height'' is copied from ''curr_win'' to the new pixmap.
 *  The rectangle may extend to areas outside of ''sourceWin''. The rectangle
 *  areas outside of ''sourceWin'' are colored with black.
 *  @return the created 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);


(**
 *  Create a new pixmap with the contents of ''sourceWin''.
 *  The content of ''sourceWin'' is copied the new pixmap.
 *  @return the created pixmap.
 *)
const func PRIMITIVE_WINDOW: getPixmap (in PRIMITIVE_WINDOW: sourceWin) is
  return getPixmap(sourceWin, 0, 0, width(sourceWin), height(sourceWin));


(**
 *  Create a new pixmap with the given ''width'' and ''height'' from ''sourceWin''.
 *  A rectangle with the upper left corner at (''left'', ''upper'') and the given
 *  ''width'' and ''height'' is copied from ''sourceWin'' to the new pixmap.
 *  The rectangle may extend to areas outside of ''sourceWin''. The rectangle
 *  areas outside of ''sourceWin'' are colored with the given ''background'' color.
 *  @return the created pixmap.
 *)
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;


(**
 *  Create a new pixmap with the given ''resultWidth'' and ''resultHeight'' from ''sourceWin''.
 *  A rectangle with the upper left corner at (''left'', ''upper'') and the given
 *  ''width'' and ''height'' is copied from ''sourceWin''. The rectangle may extend
 *  to areas outside of ''sourceWin''. The rectangle areas outside of ''sourceWin'' are
 *  colored with the given ''background'' color. The copied rectangle is
 *  scaled to ''resultWidth'' and ''resultHeight'' and returned as new pixmap.
 *  @return the created pixmap.
 *)
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;


(**
 *  Create a new pixmap from a two-dimensional array of pixels.
 *  The array of pixels might come from a image file.
 *  @param image Pixel array with lines from top downward and columns from left to right.
 *  @return the created pixmap.
 *)
const func PRIMITIVE_WINDOW: getPixmap (ref array array pixel: image) is action "DRW_GET_PIXMAP_FROM_PIXELS";


(**
 *  Get a two-dimensional array of pixels from ''aWindow''.
 *  The array of pixels can be used to write the image to a file.
 *  This is used by the function str(aWindow, PPM):
 *   image := getPixelArray(pixmap);
 *   for line range 1 to height do
 *     for pix range image[line] do
 *       col := pixelToColor(pix);
 *       stri &:= chr(col.redLight   mdiv 256);
 *       stri &:= chr(col.greenLight mdiv 256);
 *       stri &:= chr(col.blueLight  mdiv 256);
 *     end for;
 *   end for;
 *  @param aWindow Window or pixmap source to create the array of pixels.
 *  @return a pixel array with lines from top downward and columns from left to right.
 *)
const func array array pixel: getPixelArray (in PRIMITIVE_WINDOW: aWindow) is action "DRW_GET_PIXEL_ARRAY";


(**
 *  Sets the transparent color of a pixmap.
 *)
const proc: setTransparentColor (in PRIMITIVE_WINDOW: pixmap, in color: col) is func
  begin
    SET_TRANSPARENTCOLOR(pixmap, colorPixel(col));
  end func;


(**
 *  Retrieve the color at pixel position (''x'', ''y'') from ''aWindow''.
 *  @return the pixel color at position (''x'', ''y'').
 *)
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;