(********************************************************************)
(* *)
(* 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 'beginAngle' and ends at 'endAngle'.
*)
const proc: arc (inout PRIMITIVE_WINDOW: win,
in integer: x, in integer: y, in integer: radius,
in float: beginAngle, in float: endAngle, in color: col) is func
begin
DRAW_ARC(win, x, y, radius, beginAngle, endAngle, 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 'beginAngle' and ends at 'endAngle'.
*)
const proc: arc (in integer: x, in integer: y, in integer: radius,
in float: beginAngle, in float: endAngle, in color: col) is func
begin
DRAW_ARC(curr_win, x, y, radius, beginAngle, endAngle, colorPixel(col));
end func;
const proc: chord (in integer: x, in integer: y, in integer: radius,
in float: cstart, in float: cend, in color: col) is func
begin
FILL_ARCCHORD(curr_win, x, y, radius, cstart, cend, colorPixel(col));
end func;
const proc: pieslice (in integer: x, in integer: y, in integer: r,
in float: cstart, in float: cend, in color: col) is func
begin
FILL_ARCPIESLICE(curr_win, x, y, r, cstart, cend, 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;
var pixel: pix is pixel.value;
var char: ch is ' ';
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;
(*
write("size: "); writeln(size);
write("offset: "); writeln(offset);
write("width: "); writeln(width);
write("height: "); writeln(height);
write("planes: "); writeln(planes);
write("bits: "); writeln(bits);
write("padding: "); writeln(padding);
for width range 15 to 20 do
write(width lpad 3);
write(":");
write(3 * width lpad 4);
write((3 * width) div 4 * 4 + 4 lpad 4);
write(-(3 * width) mod 4 lpad 4);
write(-((3 * width) mod -4) lpad 4);
writeln;
end for;
for line range 50 to 60 do
write(line lpad 3);
write(":");
write(line div 4 lpad 4);
write(line rem 4 lpad 4);
write(line div -4 lpad 4);
write(line rem -4 lpad 4);
write(line mdiv 4 lpad 4);
write(line mod 4 lpad 4);
write(line mdiv -4 lpad 4);
write(line mod -4 lpad 4);
writeln;
end for;
for line range -60 to -50 do
write(line lpad 3);
write(":");
write(line div 4 lpad 4);
write(line rem 4 lpad 4);
write(line div -4 lpad 4);
write(line rem -4 lpad 4);
write(line mdiv 4 lpad 4);
write(line mod 4 lpad 4);
write(line mdiv -4 lpad 4);
write(line mod -4 lpad 4);
writeln;
end for;
*)
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;