Subversion Repositories Kolibri OS

(*

    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 .

*)

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.