(*
    Copyright 2016-2020, 2022, 2023 Anton Krotov

    This file is part of fb2read.

    fb2read is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    fb2read 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 General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with fb2read. If not, see <http://www.gnu.org/licenses/>.
*)

MODULE Graph;

IMPORT K := KOSAPI, sys := SYSTEM, SU := SysUtils;


TYPE

  tBuffer* = POINTER TO RECORD Width*, Height*, bitmap*, Color: INTEGER END;


VAR

  Buffer*, BackImg*: tBuffer;
  Width0, Height0: INTEGER;


PROCEDURE [stdcall-, "rasterworks.obj", ""] drawText (canvas, x, y, string, charQuantity, fontColor, params: INTEGER): INTEGER; END;

PROCEDURE Destroy*(VAR Buffer: tBuffer);
BEGIN
  IF Buffer # NIL THEN
    IF Buffer.bitmap # 0 THEN
      DEC(Buffer.bitmap, 8);
      Buffer.bitmap := K.free(Buffer.bitmap)
    END;
    DISPOSE(Buffer)
  END
END Destroy;


PROCEDURE Create*(Width, Height: INTEGER): tBuffer;
VAR res: tBuffer;
BEGIN
  NEW(res);
  res.bitmap := K.malloc(Width * Height * 4 + 8);
  sys.PUT(res.bitmap, Width);
  sys.PUT(res.bitmap + 4, Height);
  res.Width := Width;
  res.Height := Height;
  INC(res.bitmap, 8);
  RETURN res
END Create;


PROCEDURE getRGB* (color: INTEGER; VAR r, g, b: BYTE);
BEGIN
	b := color MOD 256;
	g := color DIV 256 MOD 256;
	r := color DIV 65536 MOD 256
END getRGB;


PROCEDURE Fill* (Buffer: tBuffer; Color: INTEGER);
VAR p, n, i: INTEGER;
BEGIN
	p := Buffer.bitmap;
	n := Buffer.Width * Buffer.Height;
	FOR i := 1 TO n DO
    	sys.PUT(p, Color);
		INC(p, 4)
	END
END Fill;


PROCEDURE HLine*(X1, X2, Y: INTEGER);
VAR
    p1, p2, i, color: INTEGER;

BEGIN
    IF X1 <= X2 THEN
        SU.MinMax(Y, 0, Buffer.Height - 1);
        color := Buffer.Color;
        p1 := Buffer.bitmap + 4 * (Y * Buffer.Width + X1);
        p2 := p1 + (X2 - X1) * 4;
        FOR i := p1 TO p2 BY 4 DO
            sys.PUT(i, color)
        END
    END
END HLine;


PROCEDURE HLineNotXOR (X1, X2, Y, color: INTEGER);
VAR
    p1, p2, i: INTEGER;
    pix: SET;

BEGIN
    IF X1 <= X2 THEN
        SU.MinMax(Y, 0, Buffer.Height - 1);
        p1 := Buffer.bitmap + 4 * (Y * Buffer.Width + X1);
        p2 := p1 + (X2 - X1) * 4;
        FOR i := p1 TO p2 BY 4 DO
            sys.GET(i, pix);
            pix := (-pix) / BITS(color) - {24..31};
            sys.PUT(i, pix)
        END
    END
END HLineNotXOR;


PROCEDURE VLine*(X, Y1, Y2: INTEGER);
VAR p1, p2, line_size, color: INTEGER;
BEGIN
  ASSERT(Y1 <= Y2);
  SU.MinMax(Y1, 0, Buffer.Height - 1);
  SU.MinMax(Y2, 0, Buffer.Height - 1);
  color := Buffer.Color;
  line_size := Buffer.Width * 4;
  p1 := Buffer.bitmap + line_size * Y1 + 4 * X;
  p2 := p1 + (Y2 - Y1) * line_size;
  WHILE p1 <= p2 DO
    sys.PUT(p1, color);
    p1 := p1 + line_size
  END
END VLine;


PROCEDURE Box(X1, Y1, X2, Y2: INTEGER);
VAR y: INTEGER;
BEGIN
  FOR y := Y1 TO Y2 DO
    HLine(X1, X2, y)
  END
END Box;


PROCEDURE BoxNotXOR* (X1, Y1, X2, Y2, color: INTEGER);
VAR y: INTEGER;
BEGIN
    FOR y := Y1 TO Y2 DO
        HLineNotXOR(X1, X2, y, color)
    END
END BoxNotXOR;


PROCEDURE SetColor*(color: INTEGER);
BEGIN
  Buffer.Color := color
END SetColor;


PROCEDURE GetColor*(): INTEGER;
  RETURN Buffer.Color
END GetColor;


PROCEDURE TextOut*(X, Y: INTEGER; Text: INTEGER; length: INTEGER; size, params: INTEGER);
BEGIN
	drawText(Buffer.bitmap - 8, X, Y, Text, length, 0FF000000H + Buffer.Color, params)
END TextOut;


PROCEDURE InitSize* (Width, Height: INTEGER);
BEGIN
	Width0 := Width;
	Height0 := Height;
END InitSize;


PROCEDURE Image* (X, Y, sizeX, sizeY, ptr, Ymin, Ymax: INTEGER);
VAR
	y: INTEGER;
BEGIN
	ASSERT(sizeX <= Buffer.Width);
	FOR y := 0 TO sizeY - 1 DO
		IF (Ymin <= Y) & (Y < Ymax) THEN
			sys.MOVE(ptr + sizeX*4*y, Buffer.bitmap + (Buffer.Width*Y + X)*4, sizeX*4)
		END;
		INC(Y)
	END
END Image;


PROCEDURE Image2(Buffer: tBuffer; X, Y, sizeX, sizeY, ptr: INTEGER);
VAR x, y, pix, left: INTEGER;
BEGIN
  left := X;
  FOR y := 0 TO sizeY - 1 DO
      X := left;
      FOR x := 0 TO sizeX - 1 DO
        sys.GET32(ptr + (y*sizeX + x)*4, pix);
        IF (X < Buffer.Width) & (Y < Buffer.Height) THEN
          sys.PUT32(Buffer.bitmap + (Buffer.Width*Y + X)*4, pix)
        END;
        INC(X)
      END;
    INC(Y)
  END
END Image2;


PROCEDURE BackImage*(sizeX, sizeY, ptr: INTEGER);
VAR x, y: INTEGER;
BEGIN
  IF ptr # 0 THEN
    y := 0;
    WHILE y < BackImg.Height DO
      x := 0;
      WHILE x < BackImg.Width DO
        Image2(BackImg, x, y, sizeX, sizeY, ptr);
        INC(x, sizeX)
      END;
      INC(y, sizeY)
    END
  END
END BackImage;


PROCEDURE Copy*(src, dst: tBuffer; y_src, lines, y_dst: INTEGER);
BEGIN
  sys.MOVE(src.bitmap + y_src * src.Width * 4, dst.bitmap + y_dst * dst.Width * 4, lines * dst.Width * 4)
END Copy;


PROCEDURE Draw*(X, Y: INTEGER);
BEGIN
  K.sysfunc7(65, Buffer.bitmap, Buffer.Width * 65536 + Buffer.Height, X * 65536 + Y, 32, 0, 0)
END Draw;


PROCEDURE Rect*(X1, Y1, X2, Y2: INTEGER);
BEGIN
  VLine(X1, Y1, Y2);
  VLine(X2, Y1, Y2);
  HLine(X1, X2, Y1);
  HLine(X1, X2, Y2)
END Rect;


PROCEDURE Progress*(value: REAL);
VAR W4, W2, H2: INTEGER;
BEGIN
  W2 := Width0 DIV 2;
  W4 := W2 DIV 2;
  H2 := Height0 DIV 2;
  Fill(Buffer, 0FFFFFFH);
  SetColor(0);
  Rect(W4, H2 - 50, 3 * W4, H2 + 30);
  TextOut(W2 - 10 * 8 DIV 2, H2 - 50 + 15, sys.SADR("Loading..."), 10, 1, 16 + 0 + LSL(3, 16) + LSL(128, 24));
  SetColor(000000FFH);
  Box(W4 + 10, H2, W4 + 10 + FLOOR( FLT(W2 - 20) * value ), H2 + 15);
END Progress;


PROCEDURE _resize (Buffer: tBuffer; Width, Height: INTEGER);
BEGIN
  IF Buffer.bitmap # 0 THEN
    DEC(Buffer.bitmap, 8)
  END;
  Buffer.bitmap := K.realloc(Buffer.bitmap, Width * Height * 4 + 8);
  SU.MemError(Buffer.bitmap = 0);
  sys.PUT(Buffer.bitmap, Width);
  sys.PUT(Buffer.bitmap + 4, Height);
  INC(Buffer.bitmap, 8);
  Buffer.Width  := Width;
  Buffer.Height := Height
END _resize;


PROCEDURE Resize*(Width, Height: INTEGER);
BEGIN
	_resize(Buffer,  Width, Height);
	IF BackImg # NIL THEN
		_resize(BackImg, Width, Height)
	END
END Resize;


PROCEDURE Init;
VAR Width, Height: INTEGER;
BEGIN
	BackImg := NIL;
	NEW(Buffer);
	SU.GetScreenSize(Width, Height);
	Resize(Width, Height)
END Init;


PROCEDURE CreateBackImg*;
BEGIN
	IF BackImg = NIL THEN
		BackImg := Create(Buffer.Width, Buffer.Height)
	END
END CreateBackImg;


PROCEDURE DestroyBackImg*;
BEGIN
	Destroy(BackImg)
END DestroyBackImg;


BEGIN
  Init
END Graph.