kolibrios/programs/develop/cedit/SRC/Graph.ob07

(*
    Copyright 2021 Anton Krotov

    This file is part of CEdit.

    CEdit 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.

    CEdit 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 CEdit. If not, see <http://www.gnu.org/licenses/>.
*)

MODULE Graph;

IMPORT SYSTEM, K := KOSAPI;

CONST

    modeCOPY = 0;
    modeNOT  = 1;
    modeXOR  = 2;

TYPE

    tFont* = POINTER TO RECORD
        handle*: INTEGER;
        height*: INTEGER;
        width*:  INTEGER;
        size:    INTEGER;
        name*:   ARRAY 256 OF WCHAR
    END;

    tCanvas* = POINTER TO RECORD
        bitmap: INTEGER;
        width*, height*: INTEGER;
        color, backColor, textColor: INTEGER;
        font*: tFont;
        mode: INTEGER
    END;


PROCEDURE DrawCanvas* (canvas: tCanvas; x, y: INTEGER);
BEGIN
    K.sysfunc7(65, canvas.bitmap, canvas.width*65536 + canvas.height, x*65536 + y, 32, 0, 0);
END DrawCanvas;


PROCEDURE SetColor* (canvas: tCanvas; color: INTEGER);
BEGIN
    canvas.color := color
END SetColor;


PROCEDURE SetTextColor* (canvas: tCanvas; color: INTEGER);
BEGIN
    canvas.textColor := color
END SetTextColor;


PROCEDURE SetBkColor* (canvas: tCanvas; color: INTEGER);
BEGIN
    canvas.backColor := color
END SetBkColor;


PROCEDURE CreateFont* (height: INTEGER; name: ARRAY OF WCHAR; attr: SET): tFont;
VAR
    font: tFont;
BEGIN
    NEW(font);
    font.size := MAX(MIN(height, 8), 1);
    font.width := font.size*8;
    font.height := font.size*16;
    DEC(font.size);
    font.name := name
    RETURN font
END CreateFont;


PROCEDURE SetFont* (canvas: tCanvas; font: tFont);
BEGIN
    canvas.font := font
END SetFont;


PROCEDURE HLine* (canvas: tCanvas; y, x1, x2: INTEGER);
VAR
    X1, X2, i: INTEGER;
    ptr: INTEGER;
    color: INTEGER;
BEGIN
    X1 := MAX(MIN(x1, x2), 0);
    X2 := MIN(MAX(x1, x2), canvas.width - 1);
    IF (0 <= y) & (y < canvas.height) THEN
        color := canvas.color;
        ptr := canvas.bitmap + y*canvas.width*4 + X1*4;
        FOR i := X1 TO X2 DO
            SYSTEM.PUT32(ptr, color);
            INC(ptr, 4)
        END
    END
END HLine;


PROCEDURE VLine* (canvas: tCanvas; x, y1, y2: INTEGER);
VAR
    Y1, Y2, i: INTEGER;
    ptr: INTEGER;
    color: INTEGER;
BEGIN
    Y1 := MAX(MIN(y1, y2), 0);
    Y2 := MIN(MAX(y1, y2), canvas.height - 1);
    IF (0 <= x) & (x < canvas.width) THEN
        color := canvas.color;
        ptr := canvas.bitmap + Y1*canvas.width*4 + x*4;
        FOR i := Y1 TO Y2 DO
            IF canvas.mode = modeNOT THEN
                SYSTEM.GET32(ptr, color);
                color := ORD(-BITS(color)*{0..23})
            ELSIF canvas.mode = modeXOR THEN
                SYSTEM.GET32(ptr, color);
                color := ORD((BITS(color)/BITS(canvas.color))*{0..23})
            END;
            SYSTEM.PUT32(ptr, color);
            INC(ptr, canvas.width*4)
        END
    END
END VLine;


PROCEDURE notVLine* (canvas: tCanvas; x, y1, y2: INTEGER);
BEGIN
    IF (0 <= y1) & (y1 < canvas.height) & (0 <= y2) & (y2 < canvas.height) THEN
        canvas.mode := modeNOT;
        VLine(canvas, x, y1, y2);
        canvas.mode := modeCOPY
    END
END notVLine;


PROCEDURE xorVLine* (canvas: tCanvas; x, y1, y2: INTEGER);
BEGIN
    IF (0 <= y1) & (y1 < canvas.height) & (0 <= y2) & (y2 < canvas.height) THEN
        canvas.mode := modeXOR;
        SetColor(canvas, 0FF0000H);
        VLine(canvas, x, y1, y2);
        canvas.mode := modeCOPY
    END
END xorVLine;


PROCEDURE DLine* (canvas: tCanvas; x1, x2, y: INTEGER; k: INTEGER);
VAR
    ptr: INTEGER;
    color: INTEGER;
    d: INTEGER;
BEGIN
    color := canvas.color;
    ptr := canvas.bitmap + y*canvas.width*4 + x1*4;
    IF k = -1 THEN
        d := canvas.width*4 + 4
    ELSIF k = 1 THEN
        d := 4 - canvas.width*4
    END;
    WHILE x1 <= x2 DO
        SYSTEM.PUT32(ptr, color);
        INC(ptr, d);
        INC(x1)
    END
END DLine;


PROCEDURE FillRect* (canvas: tCanvas; left, top, right, bottom: INTEGER);
VAR
    y: INTEGER;
BEGIN
    FOR y := top TO bottom DO
        HLine(canvas, y, left, right)
    END
END FillRect;


PROCEDURE Rect* (canvas: tCanvas; left, top, right, bottom: INTEGER);
BEGIN
    HLine(canvas, top, left, right);
    HLine(canvas, bottom, left, right);
    VLine(canvas, left, top, bottom);
    VLine(canvas, right, top, bottom)
END Rect;


PROCEDURE clear* (canvas: tCanvas);
VAR
    ptr, ptr2, w, i: INTEGER;
BEGIN
    HLine(canvas, 0, 0, canvas.width - 1);
    w := canvas.width*4;
    ptr := canvas.bitmap;
    ptr2 := ptr;
    i := canvas.height - 1;
    WHILE i > 0 DO
        INC(ptr2, w);
        SYSTEM.MOVE(ptr, ptr2, w);
        DEC(i)
    END
END clear;


PROCEDURE TextOut* (canvas: tCanvas; x, y: INTEGER; text: INTEGER; n: INTEGER);
CONST
    WCHAR_SIZE = 2;
VAR
    color, i: INTEGER;
BEGIN
    IF (0 <= y) & (y <= canvas.height - canvas.font.height - 1) THEN
        IF x < 0 THEN
            i := -(x DIV canvas.font.width);
            INC(x, i*canvas.font.width);
            DEC(n, i)
        ELSE
            i := 0
        END;
        IF n > 0 THEN
            n := MAX(MIN(n, (canvas.width - x) DIV canvas.font.width), 0);
            color := canvas.color;
            canvas.color := canvas.backColor;
            FillRect(canvas, x, y, x + n*canvas.font.width, y + canvas.font.height);
            canvas.color := color;
(*            WHILE n > 0 DO
                K.sysfunc6(4, x*65536 + y, LSL(28H + canvas.font.size, 24) + canvas.textColor, text + i*WCHAR_SIZE, 1, canvas.bitmap - 8);
                INC(x, canvas.font.width);
                INC(i);
                DEC(n)
            END*)
            K.sysfunc6(4, x*65536 + y, LSL(28H + canvas.font.size, 24) + canvas.textColor, text + i*WCHAR_SIZE, n, canvas.bitmap - 8)
        END
    END
END TextOut;


PROCEDURE TextOut2* (canvas: tCanvas; x, y: INTEGER; text: ARRAY OF WCHAR; n: INTEGER);
BEGIN
    TextOut(canvas, x, y, SYSTEM.ADR(text[0]), n)
END TextOut2;


PROCEDURE CreateCanvas* (width, height: INTEGER): tCanvas;
VAR
    canvas: tCanvas;
BEGIN
    NEW(canvas);
    canvas.bitmap := K.malloc(width*height*4 + 8);
    ASSERT(canvas.bitmap # 0);
    SYSTEM.PUT32(canvas.bitmap, width);
    SYSTEM.PUT32(canvas.bitmap + 4, height);
    INC(canvas.bitmap, 8);
    canvas.width := width;
    canvas.height := height;
    canvas.mode := modeCOPY
    RETURN canvas
END CreateCanvas;


PROCEDURE destroy* (VAR canvas: tCanvas);
BEGIN
    IF canvas # NIL THEN
        canvas.bitmap := K.free(canvas.bitmap);
        DISPOSE(canvas)
    END
END destroy;


END Graph.