(********************************************************************)
(*                                                                  *)
(*  pixmap_file.s7i  Text implementation type to use a pixmap font  *)
(*  Copyright (C) 2010 - 2013  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 "draw.s7i";
include "font.s7i";
include "pixmapfont.s7i";
include "text.s7i";
include "null_file.s7i";


(**
 *  [[text|Text]] implementation type to write with a pixmap font.
 *  This type allows writing text to graphic windows.
 *  This is done with the portable [[font|fonts]] of Seed7.
 *)
const type: pixmapFontFile is sub null_file struct
    var PRIMITIVE_WINDOW: win is PRIMITIVE_WINDOW.value;
    var activeFont: font is activeFont.value;
    var integer: height is 0;
    var integer: width is 0;
    var integer: line is 0;
    var integer: column is 0;
    var integer: minX is 0;
    var integer: minY is 0;
    var integer: lineStartX is 0;
    var integer: currLeftX is 0;
    var integer: currTopY is 0;
    var integer: currBaseY is 0;
    var boolean: useBaseY is FALSE;
  end struct;


type_implements_interface(pixmapFontFile, text);


(**
 *  Creates a ''pixmapFontFile'' at the upper left corner of ''win''.
 *  The ''pixmapFontFile'' extends over the whole ''win''.
 *  @return the file opened.
 *)
const func text: openPixmapFontFile (in PRIMITIVE_WINDOW: win) is func
  result
    var text: newFile is STD_NULL;
  local
    var pixmapFontFile: new_file is pixmapFontFile.value;
  begin
    new_file.win := win;
    new_file.font.baseFont := fontProperties.value;
    newFile := toInterface(new_file);
  end func;


(**
 *  Creates a ''pixmapFontFile'' at (''minX'', ''minY'') in ''win''.
 *  The ''pixmapFontFile'' extends to the lower right edge of ''win''.
 *  @return the file opened.
 *)
const func text: openPixmapFontFile (in PRIMITIVE_WINDOW: win,
    in integer: minX, in integer: minY) is func
  result
    var text: newFile is STD_NULL;
  local
    var pixmapFontFile: new_file is pixmapFontFile.value;
  begin
    new_file.win := win;
    new_file.font.baseFont := fontProperties.value;
    new_file.minX := minX;
    new_file.minY := minY;
    new_file.lineStartX := minX;
    new_file.currLeftX := minX;
    new_file.currTopY := minY;
    newFile := toInterface(new_file);
  end func;


(**
 *  Forces that all buffered data is sent to its destination.
 *  Flushing a ''null_file'' has no effect.
 *)
const proc: flush (inout pixmapFontFile: aFile) is func
  begin
    flushGraphic;
  end func;


(**
 *  Set the current font of ''aText'' to ''aFont''.
 *)
const proc: setFont (inout text: aText, in font: aFont) is DYNAMIC;


(**
 *  Get the current font of ''aText''.
 *)
const func font: getFont (in text: aText) is DYNAMIC;


const func font: getFont (in pixmapFontFile: fontFile) is
  return fontFile.font.baseFont;


const proc: cursor (ref pixmapFontFile: fontFile, ref boolean: active) is noop;


(**
 *  Get the height of ''fontFile''.
 *  @return the height of ''fontFile''.
 *)
const func integer: height (in pixmapFontFile: fontFile) is
  return fontFile.height;


(**
 *  Get the width of ''fontFile''.
 *  @return the width of ''fontFile''.
 *)
const func integer: width (in pixmapFontFile: fontFile) is
  return fontFile.width;


(**
 *  Get the current line of ''fontFile''.
 *  @return the current line of ''fontFile''.
 *)
const func integer: line (in pixmapFontFile: fontFile) is
  return fontFile.line;


(**
 *  Get the current column of ''fontFile''.
 *  @return the current column of ''fontFile''.
 *)
const func integer: column (in pixmapFontFile: fontFile) is
  return fontFile.column;


(**
 *  Clear an area of ''fontFile'' with the background color.
 *  The area is specified in (line, column) coordinates and is
 *  between the (''upper'', ''left'') and (''lower'', ''right'').
 *)
const proc: clear (inout pixmapFontFile: fontFile,
    in integer: upper, in integer: left, in integer: lower, in integer: right) is func
  begin
    rectTo(fontFile.win,
        fontFile.minX + column_delta(fontFile.font) * pred(left),
        fontFile.minY + line_delta(fontFile.font) * pred(upper),
        fontFile.minX + pred(column_delta(fontFile.font) * right),
        fontFile.minY + pred(line_delta(fontFile.font) * lower),
        background(fontFile.font));
    fontFile.lineStartX := fontFile.minX;
    fontFile.currTopY := fontFile.minY + line_delta(fontFile.font) * pred(upper);
    fontFile.currLeftX := fontFile.minX + column_delta(fontFile.font) * pred(left);
    fontFile.useBaseY := FALSE;
  end func;


(**
 *  Clear the area of ''fontFile'' with the background color.
 *)
const proc: clear (inout pixmapFontFile: fontFile) is func
  begin
    rectTo(fontFile.win,
        fontFile.minX,
        fontFile.minY,
        pred(width(fontFile.win)),
        pred(height(fontFile.win)),
        background(fontFile.font));
    fontFile.lineStartX := fontFile.minX;
    fontFile.currTopY := fontFile.minY;
    fontFile.currLeftX := fontFile.minX;
    fontFile.useBaseY := FALSE;
  end func;


const proc: v_scroll (inout pixmapFontFile: fontFile,
    in integer: upper, in integer: left, in integer: lower, in integer: right,
    in integer: count) is func
  begin
    if count > 0 then
      copyArea(fontFile.win, fontFile.win,
          fontFile.minX + column_delta(fontFile.font) * pred(left),
          fontFile.minY + line_delta(fontFile.font) * pred(upper + count),
          column_delta(fontFile.font) * succ(right - left),
          line_delta(fontFile.font) * succ(lower - upper - count),
          fontFile.minX + column_delta(fontFile.font) * pred(left),
          fontFile.minY + line_delta(fontFile.font) * pred(upper));
      rect(fontFile.win,
          fontFile.minX + column_delta(fontFile.font) * pred(left),
          fontFile.minY + line_delta(fontFile.font) * (lower - count),
          column_delta(fontFile.font) * succ(right - left),
          line_delta(fontFile.font) * count,
          black);
    elsif count < 0 then
      copyArea(fontFile.win, fontFile.win,
          fontFile.minX + column_delta(fontFile.font) * pred(left),
          fontFile.minY + line_delta(fontFile.font) * pred(upper),
          column_delta(fontFile.font) * succ(right - left),
          line_delta(fontFile.font) * succ(lower - upper + count),
          fontFile.minX + column_delta(fontFile.font) * pred(left),
          fontFile.minY + line_delta(fontFile.font) * pred(upper - count));
    end if;
  end func;


(**
 *  Set the current position of ''fontFile'' to ''line'' and ''column''.
 *)
const proc: setPos (inout pixmapFontFile: fontFile,
    in integer: line, in integer: column) is func
  begin
    if fontFile.line <> line or fontFile.column <> column then
      fontFile.lineStartX := fontFile.minX;
      fontFile.currTopY := fontFile.minY + line_delta(fontFile.font) * pred(line);
      fontFile.currLeftX := fontFile.minX + column_delta(fontFile.font) * pred(column);
      fontFile.useBaseY := FALSE;
      fontFile.line := line;
      fontFile.column := column;
    end if;
  end func;


(**
 *  Set the current position of ''fontFile'' to the coordinates (xPos, yPos).
 *  The coordinates are from the graphic window which belongs to ''fontFile''.
 *)
const proc: setPosXY (inout pixmapFontFile: fontFile, in integer: xPos, in integer: yPos) is func
  begin
    fontFile.lineStartX := fontFile.minX + xPos;
    fontFile.currLeftX := fontFile.minX + xPos;
    fontFile.currBaseY := fontFile.minY + yPos;
    fontFile.useBaseY := TRUE;
    if line_delta(fontFile.font) <> 0 then
      fontFile.line := yPos div line_delta(fontFile.font);
    end if;
    if column_delta(fontFile.font) <> 0 then
      fontFile.column := xPos div column_delta(fontFile.font);
    end if;
  end func;


(**
 *  Set the ''line'' of the current position of ''fontFile''.
 *)
const proc: setLine (inout pixmapFontFile: fontFile, in integer: line) is func
  begin
    fontFile.currTopY := fontFile.minY + line_delta(fontFile.font) * pred(line);
    fontFile.useBaseY := FALSE;
    fontFile.line := line;
  end func;


(**
 *  Set the ''column'' of the current position of ''fontFile''.
 *)
const proc: setColumn (inout pixmapFontFile: fontFile, in integer: column) is func
  begin
    fontFile.lineStartX := fontFile.minX;
    fontFile.currLeftX := fontFile.minX + column_delta(fontFile.font) * pred(column);
    fontFile.column := column;
  end func;


(**
 *  Set the current foreground color of ''fontFile''.
 *)
const proc: color (inout pixmapFontFile: fontFile, in color: col) is func
  begin
    fontFile.font := getFont(fontFile.font.baseFont, fontSize(fontFile.font),
        scale(fontFile.font), col, background(fontFile.font));
  end func;


(**
 *  Set the current foreground and background color of ''fontFile''.
 *)
const proc: color (inout pixmapFontFile: fontFile, in color: col, in color: backgr) is func
  begin
    fontFile.font := getFont(fontFile.font.baseFont, fontSize(fontFile.font),
        scale(fontFile.font), col, backgr);
  end func;


const proc: scale (inout text: aText, in integer: scale) is DYNAMIC;


const proc: scale (inout pixmapFontFile: fontFile, in integer: scale) is func
  begin
    fontFile.font := getFont(fontFile.font.baseFont, fontSize(fontFile.font),
        scale, foreground(fontFile.font), background(fontFile.font));
  end func;


(**
 *  Write a string to a ''pixmapFontFile''.
 *)
const proc: write (inout pixmapFontFile: fontFile, in string: stri) is func
  local
    var char: ch is ' ';
    var PRIMITIVE_WINDOW: charPixmap is PRIMITIVE_WINDOW.value;
  begin
    if fontFile.useBaseY then
      fontFile.currTopY := fontFile.currBaseY - baseLineDelta(fontFile.font);
    else
      fontFile.currBaseY := fontFile.currTopY + baseLineDelta(fontFile.font);
      fontFile.useBaseY := TRUE;
    end if;
    for ch range stri do
      if ch in fontFile.font.pixmap then
        charPixmap := fontFile.font.pixmap[ch];
      else
        charPixmap := getFontCharPixmap(fontFile.font, ch);
      end if;
      put(fontFile.win, fontFile.currLeftX, fontFile.currTopY, charPixmap);
      fontFile.currLeftX +:= width(charPixmap);
      if characterSpacing(fontFile.font) <> 0 then
        rect(fontFile.win, fontFile.currLeftX, fontFile.currTopY,
            characterSpacing(fontFile.font), height(charPixmap), background(fontFile.font));
        fontFile.currLeftX +:= characterSpacing(fontFile.font);
      end if;
    end for;
    fontFile.column +:= length(stri);
  end func;


(**
 *  Write end-of-line to ''pixmapFontFile''.
 *  Set the current position to the beginning of the next line.
 *)
const proc: writeln (inout pixmapFontFile: fontFile) is func
  begin
    incr(fontFile.line);
    fontFile.column := 1;
    fontFile.currLeftX := fontFile.lineStartX;
    if fontFile.useBaseY then
      fontFile.currTopY := fontFile.currBaseY - baseLineDelta(fontFile.font) + line_delta(fontFile.font);
      fontFile.useBaseY := FALSE;
    else
      fontFile.currTopY +:= line_delta(fontFile.font);
    end if;
  end func;


const proc: moveLeft (inout pixmapFontFile: fontFile, in string: stri) is func
  local
    var char: ch is ' ';
    var PRIMITIVE_WINDOW: charPixmap is PRIMITIVE_WINDOW.value;
  begin
    for ch range stri do
      # Actually the reverse order should be used, but
      # the sequence of characters is not significant.
      if ch in fontFile.font.pixmap then
        charPixmap := fontFile.font.pixmap[ch];
      else
        charPixmap := getFontCharPixmap(fontFile.font, ch);
      end if;
      fontFile.currLeftX -:= width(charPixmap) + characterSpacing(fontFile.font);
    end for;
  end func;


const proc: erase (inout pixmapFontFile: fontFile, in string: stri) is func
  local
    var char: ch is ' ';
    var PRIMITIVE_WINDOW: charPixmap is PRIMITIVE_WINDOW.value;
    var integer: width is 0;
    var integer: height is 0;
  begin
    if stri <> "" then
      if fontFile.useBaseY then
        fontFile.currTopY := fontFile.currBaseY - baseLineDelta(fontFile.font);
      else
        fontFile.currBaseY := fontFile.currTopY + baseLineDelta(fontFile.font);
        fontFile.useBaseY := TRUE;
      end if;
      for ch range stri do
        if ch in fontFile.font.pixmap then
          charPixmap := fontFile.font.pixmap[ch];
        else
          charPixmap := getFontCharPixmap(fontFile.font, ch);
        end if;
        width +:= width(charPixmap);
        height := max(height, height(charPixmap));
      end for;
      width +:= characterSpacing(fontFile.font) * length(stri);
      rect(fontFile.win, fontFile.currLeftX, fontFile.currTopY, width, height,
          background(fontFile.font));
      fontFile.currLeftX +:= width;
    end if;
  end func;


const proc: cursorOn (inout pixmapFontFile: fontFile, in char: cursorChar) is func
  local
    var activeFont: font is activeFont.value;
    var PRIMITIVE_WINDOW: charPixmap is PRIMITIVE_WINDOW.value;
  begin
    if fontFile.useBaseY then
      fontFile.currTopY := fontFile.currBaseY - baseLineDelta(fontFile.font);
    else
      fontFile.currBaseY := fontFile.currTopY + baseLineDelta(fontFile.font);
      fontFile.useBaseY := TRUE;
    end if;
    font := getFont(fontFile.font.baseFont, fontSize(fontFile.font),
        scale(fontFile.font), background(fontFile.font), foreground(fontFile.font));
    if cursorChar in font.pixmap then
      charPixmap := font.pixmap[cursorChar];
    else
      charPixmap := getFontCharPixmap(font, cursorChar);
    end if;
    put(fontFile.win, fontFile.currLeftX, fontFile.currTopY, charPixmap);
  end func;


const proc: cursorOff (inout pixmapFontFile: fontFile, in char: cursorChar) is func
  local
    var PRIMITIVE_WINDOW: charPixmap is PRIMITIVE_WINDOW.value;
  begin
    if fontFile.useBaseY then
      fontFile.currTopY := fontFile.currBaseY - baseLineDelta(fontFile.font);
    else
      fontFile.currBaseY := fontFile.currTopY + baseLineDelta(fontFile.font);
      fontFile.useBaseY := TRUE;
    end if;
    if cursorChar in fontFile.font.pixmap then
      charPixmap := fontFile.font.pixmap[cursorChar];
    else
      charPixmap := getFontCharPixmap(fontFile.font, cursorChar);
    end if;
    put(fontFile.win, fontFile.currLeftX, fontFile.currTopY, charPixmap);
  end func;