
(********************************************************************)
(*                                                                  *)
(*  draw.s7i      Graphic library                                   *)
(*  Copyright (C) 2001, 2005, 2007  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 "graph.s7i";
include "math.s7i";
include "binary.s7i";


var PRIMITIVE_WINDOW: curr_win is PRIMITIVE_WINDOW.value;

const color: black         is color(0, 0, 0);             (* Black     *)
const color: dark_red      is color(32768, 0, 0);         (* Maroon  r *)
const color: dark_green    is color(0, 32768, 0);         (* Green   g *)
const color: brown         is color(32768, 16384, 0);     (*         b *)
const color: dark_blue     is color(0, 0, 32768);         (* Navy    N *)
const color: dark_magenta  is color(32768, 0, 32768);     (* Purple    *)
const color: dark_cyan     is color(0, 65535, 65535);     (* Aqua      *)
const color: light_gray    is color(49152, 49152, 49152); (* Silver  x *)
const color: middle_gray   is color(32768, 32768, 32768);
const color: dark_gray     is color(16384, 16384, 16384);
const color: light_red     is color(65535, 0, 0);         (* Red     R *)
const color: light_green   is color(0, 65535, 0);         (* Lime    G *)
const color: yellow        is color(65535, 65535, 0);     (* Yellow  Y *)
const color: light_blue    is color(0, 0, 65535);         (* Blue    B *)
const color: light_magenta is color(65535, 0, 65535);     (* Fuchsia M *)
const color: light_cyan    is color(32768, 65535, 65535); (*         c *)
const color: white         is color(65535, 65535, 65535); (* White   X *)
const color: orange        is color(65535, 32768, 0);     (*         O *)
const color: amber         is color(49152, 32768, 16384);
const color: pink          is color(65535, 32768, 32768);
const color: forestgreen   is color(8704, 35584, 8704);

(* Basic HTML colors: *)

const color: Black         is color(0, 0, 0);
const color: Maroon        is color(32768, 0, 0);
const color: Green         is color(0, 32768, 0);
const color: Navy          is color(0, 0, 32768);
const color: Silver        is color(49152, 49152, 49152);
const color: Red           is color(65535, 0, 0);
const color: Lime          is color(0, 65535, 0);
const color: Blue          is color(0, 0, 65535);
const color: Gray          is color(32768, 32768, 32768);
const color: Purple        is color(32768, 0, 32768);
const color: Olive         is color(32768, 32768, 0);
const color: Teal          is color(0, 32768, 32768);
const color: White         is color(65535, 65535, 65535);
const color: Fuchsia       is color(65535, 0, 65535);
const color: Yellow        is color(65535, 65535, 0);
const color: Aqua          is color(0, 65535, 65535);


const func pixel: colorPixel (in color: col) is
  return rgbPixel(col.red_part, col.green_part, col.blue_part);


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 (x1, y1).
 *)
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 (x1, y1).
 *)
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 (x1, y1) and ends at (delta_x, delta_y).
 *  The coordinates of the endpoint are measured relative to x1, y1.
 *)
const proc: line (inout PRIMITIVE_WINDOW: win,
    in integer: x1, in integer: y1,
    in integer: delta_x, in integer: delta_y, in color: col) is func
  begin
    DRAW_PLINE(win, x1, y1, x1 + delta_x, y1 + delta_y, 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 (delta_x, delta_y).
 *  The coordinates of the endpoint are measured relative to x1, y1.
 *)
const proc: line (in integer: x1, in integer: y1,
    in integer: delta_x, in integer: delta_y, in color: col) is func
  begin
    DRAW_PLINE(curr_win, x1, y1, x1 + delta_x, y1 + 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 (x1, y1), 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 (x1, y1), 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 (x1, y1). The size of the
 *  rectangle is specified with 'width' and 'height'.
 *)
const proc: rect (in integer: x1, in integer: y1,
    in integer: width, in integer: height, in color: col) is func
  begin
    DRAW_PRECT(curr_win, x1, y1, 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 (x1, y1). The size of the
 *  rectangle is specified with 'width' and 'height'.
 *)
const proc: box (inout PRIMITIVE_WINDOW: win,
    in integer: x1, in integer: y1,
    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, x1, y1, pred(x1 + width), y1, pix);
    DRAW_PLINE(win, pred(x1 + width), y1, pred(x1 + width), pred(y1 + height), pix);
    DRAW_PLINE(win, pred(x1 + width), pred(y1 + height), x1, pred(y1 + height), pix);
    DRAW_PLINE(win, x1, pred(y1 + height), 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). The size of the
 *  rectangle is specified with 'width' and 'height'.
 *)
const proc: box (in integer: x1, in integer: y1,
    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, x1, y1, pred(x1 + width), y1, pix);
    DRAW_PLINE(curr_win, pred(x1 + width), y1, pred(x1 + width), pred(y1 + height), pix);
    DRAW_PLINE(curr_win, pred(x1 + width), pred(y1 + height), x1, pred(y1 + height), pix);
    DRAW_PLINE(curr_win, x1, pred(y1 + height), x1, y1, 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 it's 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 it's 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 it's 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 it's 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 it's 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 it's 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;


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: r,
    in float: startAngle, in float: sweepAngle, in color: col) is func
  begin
    FILL_ARCPIESLICE(curr_win, x, y, r, 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;


(**
 *  Clears the current window 'curr_win' with black.
 *)
const proc: clear is func
  begin
    DRAW_CLEAR(curr_win, colorPixel(black));
  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;


const proc: put (inout PRIMITIVE_WINDOW: win,
    in integer: x, in integer: y,
    in PRIMITIVE_WINDOW: pixmap, PSET) is func
  begin
    DRAW_PUT(win, pixmap, x, y);
  end func;


const proc: put (inout PRIMITIVE_WINDOW: win,
    in integer: x, in integer: y,
    in PRIMITIVE_WINDOW: pixmap, XOR) is func
  begin
    DRAW_PUT(win, pixmap, x, y);
  end func;


const proc: put (in integer: x, in integer: y,
    in PRIMITIVE_WINDOW: pixmap, PSET) is func
  begin
    DRAW_PUT(curr_win, pixmap, x, y);
  end func;


const proc: put (in integer: x, in integer: y,
    in PRIMITIVE_WINDOW: pixmap, XOR) is func
  begin
    DRAW_PUT(curr_win, pixmap, x, y);
  end func;


(**
 *  Creates a new pixmap with the given 'width' and 'height'.
 *  A rectangle with the upper left corner at (x1, y1) and the given
 *  'width' and 'height' is copied from 'curr_win' to the new pixmap.
 *  @return the new pixmap.
 *)
const func PRIMITIVE_WINDOW: getPixmap (in integer: x1, in integer: y1,
    in integer: width, in integer: height) is func
  result
    var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
  begin
    pixmap := DRAW_GET(curr_win, x1, y1, width, height);
  end func;


(**
 *  Creates a new pixmap with the given 'width' and 'height'.
 *  A rectangle with the upper left corner at (x1, y1) and the given
 *  'width' and 'height' is copied from 'source_win' to the new pixmap.
 *  @return the new pixmap.
 *)
const func PRIMITIVE_WINDOW: getPixmap (in PRIMITIVE_WINDOW: source_win,
    in integer: x1, in integer: y1, in integer: width, in integer: height) is func
  result
    var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
  begin
    pixmap := DRAW_GET(source_win, x1, y1, width, height);
  end func;


(**
 *  Creates a new pixmap which is a copy from 'source_win'.
 *  The content of 'source_win' is copied the new pixmap.
 *  @return the new pixmap.
 *)
const func PRIMITIVE_WINDOW: getPixmap (in PRIMITIVE_WINDOW: source_win) is func
  result
    var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
  begin
    pixmap := DRAW_GET(source_win, 0, 0, width(source_win), height(source_win));
  end func;


(**
 *  Creates a new pixmap with the given 'width' and 'height'.
 *  @return the new pixmap.
 *)
const func PRIMITIVE_WINDOW: newPixmap (in integer: width, in integer: height) is func
  result
    var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
  begin
    pixmap := newPixmap(curr_win, width, height);
  end func;


const func PRIMITIVE_WINDOW: imagePixmap (ref array array pixel: image) is func
  result
    var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
  begin
    pixmap := DRAW_IMAGE(curr_win, image);
  end func;


const proc: setTransparentColor (in PRIMITIVE_WINDOW: pixmap, in color: col) is func
  begin
    SET_TRANSPARENTCOLOR(pixmap, colorPixel(col));
  end func;


(**
 *  Reads a bitmap file (extension bmp) into a pixmap.
 *)
const func PRIMITIVE_WINDOW: read_bmp (in string: file_name) is func
  result
    var PRIMITIVE_WINDOW: image is PRIMITIVE_WINDOW.value;
  local
    var file: bmp_file is STD_NULL;
    var string: stri is "";
    var integer: size is 0;
    var integer: offset is 0;
    var integer: width is 0;
    var integer: height is 0;
    var integer: planes is 0;
    var integer: bits is 0;
    var integer: padding is 0;
    var integer: line is 0;
    var integer: column is 0;
  begin
    bmp_file := open(file_name, "r");
    if bmp_file <> STD_NULL then
      stri := gets(bmp_file, 2);
      if stri = "BM" then
        size :=   get_uint32_le(bmp_file);
        stri :=   gets(bmp_file, 4);        (* reserved1, reserved2 *)
        offset := get_uint32_le(bmp_file);
        stri :=   gets(bmp_file, 4);        (* header size *)
        width :=  get_uint32_le(bmp_file);
        height := get_uint32_le(bmp_file);
        planes := get_uint16_le(bmp_file);
        bits :=   get_uint16_le(bmp_file);
        stri :=   gets(bmp_file, 26);
        padding := -(3 * width) mod 4;
        image := newPixmap(width, height);
        seek(bmp_file, offset + 1);
        for line range pred(height) downto 0 do
          for column range 0 to pred(width) do
            stri := gets(bmp_file, 3);
            DRAW_PPOINT(image, column, line,
                rgbPixel(ord(stri[3]) * 256, ord(stri[2]) * 256, ord(stri[1]) * 256));
          end for;
          ignore(gets(bmp_file, padding));
        end for;
      end if;
      close(bmp_file);
    end if;
  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;


const type: graph_file is sub null_file struct
    var PRIMITIVE_WINDOW: win is PRIMITIVE_WINDOW.value;
    var integer: line_delta is 0;
    var integer: column_delta is 0;
    var integer: height is 0;
    var integer: width is 0;
    var integer: line is 0;
    var integer: column is 0;
    var integer: min_x is 0;
    var integer: min_y is 0;
    var integer: curr_x is 0;
    var integer: curr_y is 0;
    var color: foreground is white;
    var color: background is black;
  end struct;


type_implements_interface(graph_file, text);


(**
 *  Creates a graph_file which is placed at the upper left corner
 *  of the 'graph_win'.
 *)
const func graph_file: open (in PRIMITIVE_WINDOW: graph_win) is func
  result
    var graph_file: graphFile is graph_file.value;
  begin
    graphFile.win := graph_win;
    graphFile.line_delta := 13;
    graphFile.column_delta := 6;
    graphFile.height := height(graph_win) div graphFile.line_delta;
    graphFile.width := width(graph_win) div graphFile.column_delta;
    graphFile.line := 1;
    graphFile.column := 1;
    graphFile.min_x := 0;
    graphFile.min_y := 0;
    graphFile.curr_x := 0;
    graphFile.curr_y := 11;
  end func;


(**
 *  Creates a graph_file which is placed at (min_x, min_y)
 *  in the 'graph_win'.
 *)
const func graph_file: open (in PRIMITIVE_WINDOW: graph_win,
    in integer: min_x, in integer: min_y) is func
  result
    var graph_file: graphFile is graph_file.value;
  begin
    graphFile.win := graph_win;
    graphFile.line_delta := 13;
    graphFile.column_delta := 6;
    graphFile.height := (height(graph_win) - min_y) div graphFile.line_delta;
    graphFile.width := (width(graph_win) - min_x) div graphFile.column_delta;
    graphFile.line := 1;
    graphFile.column := 1;
    graphFile.min_x := min_x;
    graphFile.min_y := min_y;
    graphFile.curr_x := 0;
    graphFile.curr_y := 11;
  end func;


const func graph_file: open (in PRIMITIVE_WINDOW: graph_win,
    in integer: min_x, in integer: min_y, in integer: width, in integer: height) is func
  result
    var graph_file: graphFile is graph_file.value;
  begin
    graphFile.win := graph_win;
    graphFile.line_delta := 13;
    graphFile.column_delta := 6;
    graphFile.height := height div graphFile.line_delta;
    graphFile.width := width div graphFile.column_delta;
    graphFile.line := 1;
    graphFile.column := 1;
    graphFile.min_x := min_x;
    graphFile.min_y := min_y;
    graphFile.curr_x := 0;
    graphFile.curr_y := 11;
  end func;


const func graph_file: open (in PRIMITIVE_WINDOW: graph_win, in integer: lin_delta) is func
  result
    var graph_file: graphFile is graph_file.value;
  begin
    graphFile.win := graph_win;
    graphFile.line_delta := lin_delta;
    graphFile.column_delta := 6;
    graphFile.height := height(graph_win) div graphFile.line_delta;
    graphFile.width := width(graph_win) div graphFile.column_delta;
    graphFile.line := 1;
    graphFile.column := 1;
    graphFile.min_x := 0;
    graphFile.min_y := 0;
    graphFile.curr_x := 0;
    graphFile.curr_y := 11;
  end func;


const proc: close (inout graph_file: graphFile) is func
  begin
    graphFile.win := PRIMITIVE_WINDOW.value;
  end func;


const proc: flush (in graph_file: graphFile) is func
  begin
    DRAW_FLUSH;
  end func;


(**
 *  Set the foreground color of the 'graphFile'.
 *)
const proc: color (inout graph_file: graphFile, in color: col) is func
  begin
    graphFile.foreground := col;
  end func;


(**
 *  Set the foreground and background color of the 'graphFile'.
 *)
const proc: color (inout graph_file: graphFile, in color: col1, in color: col2) is func
  begin
    graphFile.foreground := col1;
    graphFile.background := col2;
  end func;


(**
 *  Get the height of the 'graphFile'.
 *)
const func integer: height (in graph_file: graphFile) is
  return graphFile.height;


(**
 *  Get the width of the 'graphFile'.
 *)
const func integer: width (in graph_file: graphFile) is
  return graphFile.width;


(**
 *  Get the current line of the 'graphFile'.
 *)
const func integer: line (in graph_file: graphFile) is
  return graphFile.line;


(**
 *  Get the current column of the 'graphFile'.
 *)
const func integer: column (in graph_file: graphFile) is
  return graphFile.column;


(**
 *  Clear an area of the 'graphFile' with the background color.
 *  The area is specified in (line, column) coordinates and is
 *  between the ('upper', 'left') and ('lower', 'right').
 *)
const proc: clear (in graph_file: graphFile,
    in integer: upper, in integer: left, in integer: lower, in integer: right) is func
  begin
    rectTo(curr_win,
        graphFile.min_x + graphFile.column_delta * pred(left),
        graphFile.min_y + graphFile.line_delta * pred(upper),
        graphFile.min_x + pred(graphFile.column_delta * right),
        graphFile.min_y + pred(graphFile.line_delta * lower),
        graphFile.background);
  end func;


(**
 *  Clear the area of the 'graphFile' with the background color.
 *)
const proc: clear (in graph_file: graphFile) is func
  begin
    clear(graphFile, 1, 1, height(graphFile), width(graphFile));
  end func;


const proc: cursor (ref graph_file: graphFile, ref boolean: active) is noop;


const proc: v_scroll (inout graph_file: graphFile,
    in integer: upper, in integer: left, in integer: lower, in integer: right,
    in integer: count) is func
  begin
    if count > 0 then
      copyArea(graphFile.win, graphFile.win,
          graphFile.column_delta * pred(left),
          graphFile.line_delta * pred(upper + count),
          graphFile.column_delta * succ(right - left),
          graphFile.line_delta * succ(lower - upper - count),
          graphFile.column_delta * pred(left),
          graphFile.line_delta * pred(upper));
      rect(graphFile.column_delta * pred(left),
          graphFile.line_delta * (lower - count),
          graphFile.column_delta * succ(right - left),
          graphFile.line_delta * count,
          black);

(*
      line(graphFile.column_delta * pred(left),
          graphFile.line_delta * pred(upper + count),
          graphFile.column_delta * succ(right - left),
          graphFile.line_delta * succ(lower - upper - count),
          light_red);
*)
    elsif count < 0 then
      copyArea(graphFile.win, graphFile.win,
          graphFile.column_delta * pred(left),
          graphFile.line_delta * pred(upper),
          graphFile.column_delta * succ(right - left),
          graphFile.line_delta * succ(lower - upper + count),
          graphFile.column_delta * pred(left),
          graphFile.line_delta * pred(upper - count));
(*
      line(graphFile.column_delta * pred(left),
          graphFile.line_delta * pred(upper),
          graphFile.column_delta * succ(right - left),
          graphFile.line_delta * succ(lower - upper + count),
          light_green);
*)
    end if;
  end func;


const proc: h_scroll (ref graph_file: graphFile,
    in integer: upper, in integer: left, in integer: lower, in integer: right,
    in integer: count) is func
  begin
    noop;
  end func;


(**
 *  Set the current position of the 'graphFile' to the given 'line' and 'column'.
 *)
const proc: setPos (inout graph_file: graphFile, in integer: line, in integer: column) is func
  begin
    graphFile.line := line;
    graphFile.column := column;
    graphFile.curr_x := graphFile.min_x + graphFile.column_delta * column - 6;
    graphFile.curr_y := graphFile.min_y + graphFile.line_delta * line - 2;
  end func;


(**
 *  Set the current position of the 'graphFile' to the coordinates (xPos, yPos).
 *  The coordinates are from the graphic window which belongs to the 'graphFile'.
 *)
const proc: setPosXY (inout graph_file: graphFile, in integer: xPos, in integer: yPos) is func
  begin
    graphFile.curr_x := graphFile.min_x + xPos;
    graphFile.curr_y := graphFile.min_y + yPos;
    graphFile.line := (graphFile.curr_y + 2) div graphFile.line_delta;
    graphFile.column := (graphFile.curr_x + 6) div graphFile.column_delta;
  end func;


(**
 *  Set the 'line' of the current position of the 'graphFile'.
 *)
const proc: setLine (inout graph_file: graphFile, in integer: line) is func
  begin
    graphFile.line := line;
    graphFile.curr_y := graphFile.min_y + graphFile.line_delta * line - 2;
  end func;


(**
 *  Set the 'column' of the current position of the 'graphFile'.
 *)
const proc: setColumn (inout graph_file: graphFile, in integer: column) is func
  begin
    graphFile.column := column;
    graphFile.curr_x := graphFile.min_x + graphFile.column_delta * column - 6;
  end func;


const proc: setXY (inout graph_file: graphFile, in integer: xPos, in integer: yPos) is func
  begin
    graphFile.curr_x := graphFile.min_x + xPos;
    graphFile.curr_y := graphFile.min_y + yPos;
  end func;


(**
 *  Write a string to the current position of the 'graphFile'.
 *)
const proc: write (inout graph_file: graphFile, in string: stri) is func
  begin
    DRAW_TEXT(graphFile.win, graphFile.curr_x, graphFile.curr_y, stri,
        colorPixel(graphFile.foreground), colorPixel(graphFile.background));
    graphFile.column +:= length(stri);
    graphFile.curr_x +:= graphFile.column_delta * length(stri);
  end func;


(**
 *  Write a character to the current position of the 'graphFile'.
 *)
const proc: write (inout graph_file: graphFile, in char: ch) is func
  begin
    write(graphFile, str(ch));
  end func;


(**
 *  Set the current position of the 'graphFile' to the beginning of the next line.
 *)
const proc: writeln (inout graph_file: graphFile) is func
  begin
    incr(graphFile.line);
    graphFile.column := 1;
    graphFile.curr_x := graphFile.min_x + graphFile.column_delta - 6;
    graphFile.curr_y +:= graphFile.line_delta;
  end func;


const proc: cursor_on (inout graph_file: graphFile) is func
  begin
    write(graphFile, "_");
  end func;


const proc: cursor_off (inout graph_file: graphFile) is func
  begin
    write(graphFile, " ");
  end func;
