(********************************************************************)
(*                                                                  *)
(*  graph.s7i     Basic graphic library                             *)
(*  Copyright (C) 1994, 1995, 2004, 2005, 2007  Thomas Mertes       *)
(*                2009 - 2013, 2017, 2018, 2020, 2021 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 "float.s7i";
include "bstring.s7i";


const type: PRIMITIVE_WINDOW is newtype;

IN_PARAM_IS_REFERENCE(PRIMITIVE_WINDOW);

const proc: (ref PRIMITIVE_WINDOW: dest) ::= (in PRIMITIVE_WINDOW: source)     is action "DRW_CREATE";
const proc: destroy (ref PRIMITIVE_WINDOW: aValue)                             is action "DRW_DESTR";
const proc: (inout PRIMITIVE_WINDOW: dest) := (in PRIMITIVE_WINDOW: source)    is action "DRW_CPY";
const func boolean: (in PRIMITIVE_WINDOW: win1) = (in PRIMITIVE_WINDOW: win2)  is action "DRW_EQ";
const func boolean: (in PRIMITIVE_WINDOW: win1) <> (in PRIMITIVE_WINDOW: win2) is action "DRW_NE";
const func PRIMITIVE_WINDOW: _GENERATE_EMPTY_WINDOW                            is action "DRW_EMPTY";
const PRIMITIVE_WINDOW: (attr PRIMITIVE_WINDOW) . value                        is _GENERATE_EMPTY_WINDOW;

const type: pixel is newtype;

IN_PARAM_IS_VALUE(pixel);

const proc: (ref pixel: dest) ::= (in pixel: source)       is action "INT_CREATE";
const proc: destroy (ref pixel: aValue)                    is action "GEN_DESTR";
const proc: (inout pixel: dest) := (in pixel: source)      is action "INT_CPY";
const func boolean: (in pixel: pix1) = (in pixel: pix2)    is action "INT_EQ";
const func boolean: (in pixel: pix1) <> (in pixel: pix2)   is action "INT_NE";
const func pixel: (attr pixel) conv (in integer: num)      is action "INT_ICONV3";
const func pixel: pixel (in integer: num)                  is action "INT_ICONV1";
const func integer: (attr integer) conv (in pixel: aPixel) is action "INT_ICONV3";
const func integer: ord (in pixel: aPixel)                 is action "INT_ICONV1";
const pixel: (attr pixel) . value                          is pixel conv 0;

const type: colorLookupTable is array [0 ..] pixel;

const proc: DRAW_POINT (inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y)                   is action "DRW_POINT";
const proc: DRAW_PPOINT (inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y,
    in pixel: col)                                  is action "DRW_PPOINT";
const proc: DRAW_LINE (inout PRIMITIVE_WINDOW: aWindow,
    in integer: x1, in integer: y1,
    in integer: x2, in integer: y2)                 is action "DRW_LINE";
const proc: DRAW_PLINE (inout PRIMITIVE_WINDOW: aWindow,
    in integer: x1, in integer: y1,
    in integer: x2, in integer: y2,
    in pixel: col)                                  is action "DRW_PLINE";
const proc: DRAW_RECT (inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y,
    in integer: width, in integer: height)          is action "DRW_RECT";
const proc: DRAW_PRECT (inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y,
    in integer: width, in integer: height,
    in pixel: col)                                  is action "DRW_PRECT";
const proc: DRAW_CIRCLE(inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y,
    in integer: radius)                             is action "DRW_CIRCLE";
const proc: DRAW_CIRCLE(inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y,
    in integer: radius, in pixel: col)              is action "DRW_PCIRCLE";
const proc: DRAW_CLEAR(inout PRIMITIVE_WINDOW: aWindow,
    in pixel: col)                                  is action "DRW_CLEAR";
const proc: FILL_CIRCLE(inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y,
    in integer: radius)                             is action "DRW_FCIRCLE";
const proc: FILL_CIRCLE(inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y,
    in integer: radius, in pixel: col)              is action "DRW_PFCIRCLE";
const proc: DRAW_ARC(inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y, in integer: radius,
    in float: startAngle, in float: sweepAngle)     is action "DRW_ARC";
const proc: DRAW_ARC(inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y, in integer: radius,
    in float: startAngle, in float: sweepAngle,
    in pixel: col)                                  is action "DRW_PARC";
const proc: FILL_ARCCHORD(inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y, in integer: radius,
    in float: startAngle, in float: sweepAngle)     is action "DRW_FARCCHORD";
const proc: DRAW_ARC(inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y, in integer: radius,
    in float: startAngle, in float: sweepAngle,
    in integer: width, in pixel: col)               is action "DRW_PFARC";
const proc: FILL_ARCCHORD(inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y, in integer: radius,
    in float: startAngle, in float: sweepAngle,
    in pixel: col)                                  is action "DRW_PFARCCHORD";
const proc: FILL_ARCPIESLICE(inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y, in integer: radius,
    in float: startAngle, in float: sweepAngle)     is action "DRW_FARCPIESLICE";
const proc: FILL_ARCPIESLICE(inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y, in integer: radius,
    in float: startAngle, in float: sweepAngle,
    in pixel: col)                                  is action "DRW_PFARCPIESLICE";
const proc: DRAW_ARC2(inout PRIMITIVE_WINDOW: aWindow,
    in integer: x1, in integer: y1, in integer: x2,
    in integer: y2, in integer: radius)             is action "DRW_ARC2";
const proc: FILL_ELLIPSE(inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y,
    in integer: width, in integer: height)          is action "DRW_FELLIPSE";
const proc: FILL_ELLIPSE(inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y,
    in integer: width, in integer: height,
    in pixel: col)                                  is action "DRW_PFELLIPSE";
const func PRIMITIVE_WINDOW: PRIMITIVE_GRAPHIC_OPEN (
    ref integer: xPos, ref integer: yPos,
    ref integer: width, ref integer: height,
    ref string: window_name)                        is action "DRW_OPEN";


(**
 *  Flush graphic commands such that the contents of all windows is up to date.
 *  An animation can be created by using ''flushGrapic'' every time before
 *  the program waits for a fraction of a second.
 *)
const proc: flushGraphic                            is action "DRW_FLUSH";


# The function DRAW_FLUSH is deprecated. Use flushGraphic instead.
const proc: DRAW_FLUSH                              is action "DRW_FLUSH";


(**
 *  Create a sub window inside of ''parent_window''.
 *  The new sub window has no window decorations and is not managed by
 *  the window manager. If the empty window is used as ''parent_window''
 *  an unmanaged top level window without window decorations is generated.
 *  The coordinates ''xPos'' and ''yPos'' are measured relative to the top
 *  left corner of the ''parent_window'' drawing area (inside of the window
 *  decorations). If the empty window is used as ''parent_window'' the
 *  coordinates ''xPos'' and ''yPos'' are measured relative to the top left
 *  corner of the screen.
 *  @param parent-window Parent window (can be the empty window).
 *  @param xPos X-position of the left corner of the new window.
 *  @param yPos Y-position of the left corner of the new window.
 *  @param width Width of the new window.
 *  @param height Height of the new window.
 *  @return the new generated window.
 *)
const func PRIMITIVE_WINDOW: openSubWindow (
    in PRIMITIVE_WINDOW: aWindow,
    ref integer: xPos, ref integer: yPos,
    ref integer: width, ref integer: height)        is action "DRW_OPEN_SUB_WINDOW";

(**
 *  Set the window name (title) of ''aWindow''.
 *  @param aWindow Window for which the name should be set.
 *  @param windowName New name (title) of the window.
 *)
const proc: setWindowName (in PRIMITIVE_WINDOW: aWindow,
                           in string: windowName)   is action "DRW_SET_WINDOW_NAME";

(**
 *  Set the visibility of the mouse cursor in ''aWindow''.
 *  @param aWindow Window for which the mouse cursor visibility is set.
 *  @param visible TRUE, if the mouse cursor should be visible in ''aWindow'', or
 *                 FALSE, if the mouse curser should be invisible in ''aWindow''.
 *)
const proc: setCursorVisible (in PRIMITIVE_WINDOW: aWindow,
                              in boolean: visible)  is action "DRW_SET_CURSOR_VISIBLE";

(**
 *  Capture a rectangular area from the screen.
 *  The function takes a screenshot of the rectangular area.
 *  The ''left'' and ''upper'' coordinates are measured relative to
 *  the top left corner of the screen.
 *  @param left X-position of the upper left corner of the capture area.
 *  @param upper Y-position of the upper left corner of the capture area.
 *  @param width Width of the capture area.
 *  @param height Height of the capture area.
 *  @return the content of the rectangular screen area as pixmap.
 *  @exception RANGE_ERROR If ''height'' or ''width'' are negative.
 *)
const func PRIMITIVE_WINDOW: capturePixmap (
    ref integer: left, ref integer: upper,
    ref integer: width, ref integer: height)        is action "DRW_CAPTURE";

const type: pixelArray2d is array array pixel;

const func bstring: getPixelData (
    in PRIMITIVE_WINDOW: aWindow)                   is action "DRW_GET_PIXEL_DATA";
const func bstring: getPixelData (
    ref array array pixel: image)                   is action "DRW_GET_PIXEL_DATA_FROM_ARRAY";
const func pixel: getPixel (
    in PRIMITIVE_WINDOW: aWindow,
    ref integer: x, ref integer: y)                 is action "DRW_GET_PIXEL";
const func pixel: getPixel (
    in bstring: bImage, in integer: width,
    in integer: height, in integer: x,
    in integer: y)                                  is action "DRW_GET_IMAGE_PIXEL";

(**
 *  Copy a rectangular area from ''sourceWindow'' to ''destWindow''.
 *  Coordinates are measured relative to the top left corner of the
 *  corresponding window drawing area (inside of the window decorations).
 *  @param sourceWindow Source window.
 *  @param destWindow Destination window.
 *  @param src_x X-position of the top left corner of the source area.
 *  @param src_y Y-position of the top left corner of the source area.
 *  @param width Width of the rectangular area.
 *  @param height Height of the rectangular area.
 *  @param dest_x X-position of the top left corner of the destination area.
 *  @param dest_y Y-position of the top left corner of the destination area.
 *)
const proc: copyArea (in PRIMITIVE_WINDOW: sourceWindow,
    inout PRIMITIVE_WINDOW: destWindow,
    ref integer: src_x, ref integer: src_y,
    ref integer: width, ref integer: height,
    ref integer: dest_x, ref integer: dest_y)       is action "DRW_COPYAREA";

const proc: SET_TRANSPARENTCOLOR (in PRIMITIVE_WINDOW: pixmap,
    ref pixel: col)                                 is action "DRW_SET_TRANSPARENT_COLOR";
const func integer: hashCode (in PRIMITIVE_WINDOW: aWindow) is action "DRW_HASHCODE";
const func integer: compare (in PRIMITIVE_WINDOW: window1,
                             in PRIMITIVE_WINDOW: window2)  is action "DRW_CMP";
const proc: setContent (inout PRIMITIVE_WINDOW: aWindow,
    in PRIMITIVE_WINDOW: pixmap)                            is action "DRW_SET_CONTENT";


(**
 *  Create a pixel from the ''red'', ''green'' and ''blue'' colors of light.
 *  The range for ''red'', ''green'' and ''blue'' is from 0 to 65535.
 *)
const func pixel: rgbPixel (ref integer: red,
    ref integer: green, ref integer: blue)          is action "DRW_RGBCOL";


const proc: DRAW_PIXEL_TO_RGB (
    in pixel: col, inout integer: red,
    inout integer: green, inout integer: blue)      is action "DRW_PIXEL_TO_RGB";
const proc: SET_COLOR (ref pixel: aWindow)          is action "DRW_COLOR";
const proc: SET_BACKGROUND (ref pixel: aWindow)     is action "DRW_BACKGROUND";
const proc: DRAW_TEXT (inout PRIMITIVE_WINDOW: aWindow,
    ref integer: x, ref integer: y, in string: stri,
    ref pixel: col, ref pixel: bkcol)               is action "DRW_TEXT";

(**
 *  Determine the height of the screen in pixels.
 *)
const func integer: screenHeight                    is action "DRW_SCREEN_HEIGHT";

(**
 *  Determine the width of the screen in pixels.
 *)
const func integer: screenWidth                     is action "DRW_SCREEN_WIDTH";

(**
 *  Determine the height of the window drawing area in pixels.
 *  This excludes window decorations at top and bottom. Add top and bottom
 *  border widths to get the height inclusive window decorations.
 *)
const func integer: height (in PRIMITIVE_WINDOW: aWindow)   is action "DRW_HEIGHT";

(**
 *  Determine the width of the window drawing area in pixels.
 *  This excludes window declarations left and right. Add left and right
 *  border widths to get the width inclusive window decorations.
 *)
const func integer: width (in PRIMITIVE_WINDOW: aWindow)    is action "DRW_WIDTH";

(**
 *  Determine the X position of the top left corner of a window in pixels.
 *  If window decorations are present this uses the top left corner of
 *  the window decorations. For a sub window the X position is relative
 *  to the top left corner of the parent window drawing area (inside of
 *  the window decorations). For top level windows the X position is
 *  relative to the top left corner of the screen.
 *  @exception RANGE_ERROR If ''actual_window'' is a pixmap.
 *)
const func integer: xPos (in PRIMITIVE_WINDOW: aWindow)     is action "DRW_XPOS";

(**
 *  Determine the Y position of the top left corner of a window in pixels.
 *  If window decorations are present this uses the top left corner of
 *  the window decorations. For a sub window the Y position is relative
 *  to the top left corner of the parent window drawing area (inside of
 *  the window decorations). For top level windows the Y position is
 *  relative to the top left corner of the screen.
 *  @exception RANGE_ERROR If ''actual_window'' is a pixmap.
 *)
const func integer: yPos (in PRIMITIVE_WINDOW: aWindow)     is action "DRW_YPOS";

(**
 *  Move the top left corner of a window to the coordinates x/y.
 *  If window decorations are present the top left corner of the
 *  window decorations will be at the position x/y. For a sub window
 *  the position is relative to the top left corner of the parent window
 *  drawing area (inside of the window decorations). For top level windows
 *  the position is relative to the top left corner of the screen.
 *)
const proc: setPos (in PRIMITIVE_WINDOW: aWindow,
    in integer: xPos, in integer: yPos)                     is action "DRW_SET_POS";

(**
 *  Set the size of the window ''aWindow'' to ''width'' and ''height''.
 *)
const proc: setSize (in PRIMITIVE_WINDOW: aWindow,
    in integer: width, in integer: height)                  is action "DRW_SET_SIZE";

(**
 *  Lower a window to the bottom so that it does not obscure any other window.
 *)
const proc: toBottom (in PRIMITIVE_WINDOW: aWindow) is action "DRW_TO_BOTTOM";

(**
 *  Raise a window to the top so that no other window obscures it.
 *)
const proc: toTop (in PRIMITIVE_WINDOW: aWindow)    is action "DRW_TO_TOP";

(**
 *  Determine the border widths of a window in pixels.
 *  These are the widths of the window decorations in the succession
 *  top, right, bottom, left.
 *  @return an array with border widths (top, right, bottom, left).
 *)
const func array integer: getBorder (in PRIMITIVE_WINDOW: aWindow) is action "DRW_BORDER";

(**
 *  Return the X position of the pointer relative to the specified window.
 *  The point of origin is the top left corner of the drawing area
 *  of the given 'aWindow' (inside of the window decorations).
 *  If 'aWindow' is the empty window the pointer X position is
 *  relative to the top left corner of the screen.
 *)
const func integer: pointerXPos (in PRIMITIVE_WINDOW: aWindow) is action "DRW_POINTER_XPOS";

(**
 *  Return the Y position of the pointer relative to the specified window.
 *  The point of origin is the top left corner of the drawing area
 *  of the given 'aWindow' (inside of the window decorations).
 *  If 'aWindow' is the empty window the pointer Y position is
 *  relative to the top left corner of the screen.
 *)
const func integer: pointerYPos (in PRIMITIVE_WINDOW: aWindow) is action "DRW_POINTER_YPOS";

(**
 *  Set the pointer x and y position relative to ''aWindow''.
 *  The point of origin is the top left corner of the drawing area
 *  of the given ''aWindow'' (inside of the window decorations).
 *  If ''aWindow'' is the empty window the pointer x and y position
 *  is relative to the top left corner of the screen.
 *)
const proc: setPointerPos (in PRIMITIVE_WINDOW: aWindow,
                           in integer: xPos, in integer: yPos) is action "DRW_SET_POINTER_POS";

const proc: SET_CLOSE_ACTION (in PRIMITIVE_WINDOW: aWindow, in integer: closeAction) is action "DRW_SET_CLOSE_ACTION";

const type: windowCloseAction is new enum
    CLOSE_PROGRAM, RETURN_KEY, RAISE_EXCEPTION
  end enum;

# The function setCloseAction() is deprecated. Use selectInput() instead.
# Replace setCloseAction(aWindow, RETURN_KEY) with selectInput(aWindow, KEY_CLOSE, TRUE).
# The possibility to raise an exception is not supported by selectInput().
const proc: setCloseAction (in PRIMITIVE_WINDOW: aWindow, in windowCloseAction: closeAction) is
  return SET_CLOSE_ACTION(aWindow, ord(closeAction));


(**
 *  Select if ''aKey'' is returned as key, or if it triggers a default action.
 *  A program might be notified when a window is resized.
 *  By default, this notification is switched off. It can be switched on with:
 *   selectInput(curr_win, KEY_RESIZE, TRUE);
 *  By default, closing a window terminates the program.
 *  To get a notification for a window close (instead of a program termination) do:
 *   selectInput(curr_win, KEY_CLOSE, TRUE);
 *  If the notification is turned on the function getc(GRAPH_KEYBOARD)
 *  might return the corresponding notification character (KEY_RESIZE or KEY_CLOSE).
 *  @param aWindow Window for which the key behavior is specified.
 *  @param aKey KEY_CLOSE or KEY_RESIZE.
 *  @param active TRUE if reading from the KEYBOARD returns ''aKey'', or
 *                FALSE if ''aKey'' triggers a default action.
 *)
const proc: selectInput (in PRIMITIVE_WINDOW: aWindow, in char: aKey,
                         in boolean: active)                      is action "GKB_SELECT_INPUT";


const type: pointList is newtype;

IN_PARAM_IS_REFERENCE(pointList);

const proc: destroy (ref pointList: aValue)                       is action "PLT_DESTR";
const proc: (ref pointList: dest) ::= (in pointList: source)      is action "PLT_CREATE";
const proc: (inout pointList: dest) := (in pointList: source)     is action "PLT_CPY";

const func pointList: _GENERATE_EMPTY_POINT_LIST                  is action "PLT_EMPTY";
const pointList: (attr pointList) . value                         is _GENERATE_EMPTY_POINT_LIST;

const func bstring: bstring (in pointList: aPointList)            is action "PLT_BSTRING";
const func pointList: pointList (in bstring: bstri)               is action "PLT_POINT_LIST";

const func boolean: (in pointList: pointList1) = (in pointList: pointList2)   is action "PLT_EQ";
const func boolean: (in pointList: pointList1) <> (in pointList: pointList2)  is action "PLT_NE";

const func integer: hashCode (in pointList: aPointList)           is action "PLT_HASHCODE";
const func integer: compare (in pointList: pointList1,
                             in pointList: pointList2)            is action "PLT_CMP";

(**
 *  The function 'genPointList' creates a 'pointList'.
 *  It converts an array of alternate x and y values to a 'pointList'.
 *  @return a pointList with the points from the array.
 *  @exception RANGE_ERROR If the length of the array is odd.
 *)
const func pointList: genPointList (ref array integer: coordinates) is action "DRW_GEN_POINT_LIST";

(**
 *  Converts a 'pointList' to an array of (X,Y) coordinates.
 *  @return an array of alternate x and y values.
 *)
const func array integer: xyArray (ref pointList: aPointList)     is action "DRW_CONV_POINT_LIST";

const func pointList: scale (in pointList: basePoints, in integer: scale) is func
  result
    var pointList: scaledPoints is pointList.value;
  local
    var array integer: coordinates is 0 times 0;
    var integer: index is 0;
  begin
    coordinates := xyArray(basePoints);
    for key index range coordinates do
      coordinates[index] *:= scale;
    end for;
    scaledPoints := genPointList(coordinates);
  end func;

const proc: DRAW_POLYLINE (inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y, in pointList: point_list,
    ref pixel: col)                                               is action "DRW_POLY_LINE";
const proc: FILL_POLYLINE (inout PRIMITIVE_WINDOW: aWindow,
    in integer: x, in integer: y, in pointList: point_list,
    ref pixel: col)                                               is action "DRW_FPOLY_LINE";