kolibrios-gitea/programs/develop/cedit/SRC/scroll.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 Scroll;

IMPORT G := Graph, K := KolibriOS, U := Utils;

CONST

	ScrollIPC* = 0;
	DELAY = 40;

TYPE

	tScroll* = RECORD
		vertical, Inc*, Dec*, mouse: BOOLEAN;
		top*, left*,
		width*, height*: INTEGER; (* read only *)
		btnSize, sliderSize: INTEGER;
		pos, Slider, pos0, maxVal*, value*: INTEGER;
		canvas*: G.tCanvas
	END;

	tProcedure* = PROCEDURE;

VAR

	ScrollChange: tProcedure;
	delay: INTEGER;


PROCEDURE MouseUp (VAR scroll: tScroll);
BEGIN
	scroll.Slider := -1;
	scroll.Inc := FALSE;
	scroll.Dec := FALSE;
	scroll.mouse := FALSE;
END MouseUp;


PROCEDURE create* (vertical: BOOLEAN; width, height: INTEGER; btnSize, sliderSize: INTEGER; VAR scroll: tScroll);
VAR
	res: tScroll;
BEGIN
	MouseUp(res);
	res.vertical := vertical;
	res.left := 0;
	res.top := 0;
	res.width := width;
	res.height := height;
	res.btnSize := btnSize;
	res.sliderSize := sliderSize;
	res.pos := 0;
	res.maxVal := 0;
	res.canvas := G.CreateCanvas(width, height);
	scroll := res
END create;


PROCEDURE Rect (canvas: G.tCanvas; left, top, right, bottom: INTEGER);
BEGIN
	G.FillRect(canvas, left, top, right, bottom);
	G.SetColor(canvas, K.borderColor);
	G.Rect(canvas, left, top, right, bottom);
END Rect;


PROCEDURE _paint (scroll: tScroll);
VAR
	canvas: G.tCanvas;
	x, y, d, x1, x2, y1, y2,
	width, height, btn: INTEGER;


	PROCEDURE SetColor (canvas: G.tCanvas; c: BOOLEAN);
	VAR
		color: INTEGER;
	BEGIN
		IF c THEN
			color := K.btnColor
		ELSE
			color := K.btnTextColor
		END;
		G.SetColor(canvas, color)
	END SetColor;


BEGIN
	btn := scroll.btnSize;
	width := scroll.width;
	height := scroll.height;
	canvas := scroll.canvas;
	G.SetColor(canvas, K.lightColor);
	G.clear(canvas);
	G.SetColor(canvas, K.borderColor);
	G.Rect(canvas, 0, 0, width - 1, height - 1);
	IF scroll.vertical THEN
		SetColor(canvas, ~scroll.Dec);
		Rect(canvas, 0, 0, width - 1, btn - 1);
		SetColor(canvas, ~scroll.Inc);
		Rect(canvas, 0, height - btn, width - 1, height - 1);
		G.SetColor(canvas, K.btnColor);
		Rect(canvas, 0, btn + scroll.pos - 1, width - 1, btn + scroll.pos + scroll.sliderSize - 1);

		G.SetColor(canvas, K.btnTextColor);

		y := btn + scroll.pos + scroll.sliderSize DIV 2 - 1;
		G.HLine(canvas, y, width DIV 4, 3*width DIV 4);
		G.HLine(canvas, y - 3, width DIV 3, 2*width DIV 3);
		G.HLine(canvas, y + 3, width DIV 3, 2*width DIV 3);

		d := 4*width DIV 10;
		x1 := (width - d) DIV 2;
		x2 := x1 + d;

		SetColor(canvas, scroll.Dec);
		y := (btn - d DIV 2) DIV 2 + d DIV 2 - 1;
		G.Triangle(canvas, x1 - 1, y, x2, y, G.triUp);

		SetColor(canvas, scroll.Inc);
		y := y + height - btn - d DIV 2 + 1;
		G.Triangle(canvas, x1 - 1, y, x2, y, G.triDown);
	ELSE
		SetColor(canvas, ~scroll.Dec);
		Rect(canvas, 0, 0, btn - 1, height - 1);
		SetColor(canvas, ~scroll.Inc);
		Rect(canvas, width - btn, 0, width - 1, height - 1);
		G.SetColor(canvas, K.btnColor);
		Rect(canvas, btn + scroll.pos - 1, 0, btn + scroll.pos + scroll.sliderSize - 1, height - 1);

		G.SetColor(canvas, K.btnTextColor);

		x := btn + scroll.pos + scroll.sliderSize DIV 2 - 1;
		G.VLine(canvas, x, height DIV 4, 3*height DIV 4);
		G.VLine(canvas, x - 3, height DIV 3, 2*height DIV 3);
		G.VLine(canvas, x + 3, height DIV 3, 2*height DIV 3);

		d := 4*height DIV 10;
		y1 := (height - d) DIV 2;
		y2 := y1 + d;

		SetColor(canvas, scroll.Dec);
		x := (btn - d DIV 2) DIV 2 + d DIV 2 - 1;
		G.Triangle(canvas, x, y1 - 1, x, y2, G.triLeft);

		SetColor(canvas, scroll.Inc);
		x := x + width - btn - d DIV 2 + 1;
		G.Triangle(canvas, x, y1 - 1, x, y2, G.triRight);
	END;
	G.DrawCanvas(scroll.canvas, scroll.left, scroll.top)
END _paint;


PROCEDURE paint* (scroll: tScroll);
BEGIN
	IF scroll.canvas # NIL THEN
		_paint(scroll)
	END
END paint;


PROCEDURE resize* (VAR scroll: tScroll; width, height: INTEGER);
BEGIN
	G.destroy(scroll.canvas);
	scroll.canvas := G.CreateCanvas(width, height);
	scroll.width := width;
	scroll.height := height;
	paint(scroll)
END resize;


PROCEDURE setValue* (VAR scroll: tScroll; value: INTEGER);
VAR
	pos, maxPos, n, m: INTEGER;
BEGIN
	IF scroll.vertical THEN
		maxPos := scroll.height
	ELSE
		maxPos := scroll.width
	END;
	maxPos := maxPos - scroll.btnSize*2 - scroll.sliderSize + 1;
	IF (value < 0) OR (scroll.maxVal <= 0) THEN
		value := 0;
		pos := 0
	ELSIF value > scroll.maxVal THEN
		value := scroll.maxVal;
		pos := maxPos
	ELSE
		IF (maxPos + 1) >= scroll.maxVal THEN
			n := (maxPos + 1) DIV scroll.maxVal;
			m := (maxPos + 1) MOD scroll.maxVal;
			pos := value*n + MIN(value, m)
		ELSE
			pos := FLOOR(FLT(value)*FLT(maxPos + 1)/FLT(scroll.maxVal))
		END;
		IF pos > maxPos THEN
			pos := maxPos;
			value := scroll.maxVal
		END
	END;
	scroll.pos := pos;
	scroll.value := value
END setValue;


PROCEDURE change* (VAR scroll: tScroll);
BEGIN
	IF scroll.Inc THEN
		setValue(scroll, scroll.value + 1)
	ELSIF scroll.Dec THEN
		setValue(scroll, scroll.value - 1)
	END;
	paint(scroll)
END change;


PROCEDURE ceil (p, q: INTEGER): INTEGER;
	RETURN p DIV q + ORD(p MOD q # 0)
END ceil;


PROCEDURE setPos (VAR scroll: tScroll; pos: INTEGER);
VAR
	maxPos, value, n, m, x, x0, q: INTEGER;
BEGIN
	IF scroll.maxVal > 0 THEN
		IF scroll.vertical THEN
			maxPos := scroll.height
		ELSE
			maxPos := scroll.width
		END;
		maxPos := maxPos - scroll.btnSize*2 - scroll.sliderSize + 1;
		IF pos <= 0 THEN
			pos := 0;
			value := 0
		ELSIF pos >= maxPos THEN
			pos := maxPos;
			value := scroll.maxVal
		ELSE
			IF scroll.maxVal <= maxPos + 1 THEN
				n := (maxPos + 1) DIV scroll.maxVal;
				m := (maxPos + 1) MOD scroll.maxVal;

				q := m*(n + 1);
				IF q < pos THEN
					value := ceil(pos - m, n)
				ELSIF q > pos THEN
					value := ceil(pos, n + 1)
				ELSE
					value := m
				END;

				x := value*n + MIN(value, m);
				x0 := (value - 1)*n + MIN(value - 1, m);

				IF x - pos > pos - x0 THEN
					pos := x0;
					DEC(value)
				ELSE
					pos := x;
					IF pos > maxPos THEN
						pos := maxPos;
						value := scroll.maxVal
					END
				END
			ELSE
				value := FLOOR(FLT(scroll.maxVal)*FLT(pos)/FLT(maxPos + 1))
			END
		END
	ELSE
		pos := 0;
		scroll.value := 0
	END;
	scroll.pos := pos;
	scroll.value := value
END setPos;


PROCEDURE MouseMove (VAR scroll: tScroll; x, y: INTEGER);
VAR
	c: INTEGER;
BEGIN
	IF scroll.vertical THEN
		c := y - scroll.top
	ELSE
		c := x - scroll.left
	END;
	setPos(scroll, scroll.pos0 + c - scroll.Slider);
	paint(scroll)
END MouseMove;


PROCEDURE SendIPC;
VAR
	msg: ARRAY 2 OF INTEGER;
BEGIN
	msg[0] := ScrollIPC;
	msg[1] := 8;
	K.SendIPC(K.ThreadID(), msg)
END SendIPC;


PROCEDURE receiveIPC* (VAR IPC: ARRAY OF INTEGER; VAR scrollIPC: BOOLEAN);
BEGIN
	scrollIPC := FALSE;
	ScrollChange;
	IF 0 IN K.MouseState() THEN
		WHILE (0 IN K.MouseState()) & (delay > 0) DO
			K.Pause(1);
    		DEC(delay)
		END;
		IF delay = 0 THEN
			IPC[0] := 0;
			IPC[1] := 0;
			scrollIPC := TRUE;
    		SendIPC;
    		delay := 4
		ELSE
			delay := DELAY
		END
	ELSE
		delay := DELAY
	END
END receiveIPC;


PROCEDURE MouseDown (VAR scroll: tScroll; x, y: INTEGER);
VAR
	c, size: INTEGER;
BEGIN
	DEC(x, scroll.left);
	DEC(y, scroll.top);
	scroll.mouse := TRUE;
	IF U.between(1, x, scroll.width - 2) & U.between(1, y, scroll.height - 2) THEN
		IF scroll.vertical THEN
			c := y;
			size := scroll.height
		ELSE
			c := x;
			size := scroll.width
		END;
		IF U.between(scroll.btnSize + scroll.pos - 1, c, scroll.btnSize + scroll.pos + scroll.sliderSize - 1) THEN
			scroll.pos0 := scroll.pos;
			scroll.Slider := c
		ELSIF U.between(0, c, scroll.btnSize - 1) THEN
			scroll.Dec := TRUE;
			SendIPC
		ELSIF U.between(size - scroll.btnSize, c, size - 1) THEN
			scroll.Inc := TRUE;
			SendIPC
		ELSE
			setPos(scroll, c - scroll.btnSize - scroll.sliderSize DIV 2);
			scroll.pos0 := scroll.pos;
			scroll.Slider := c;
			paint(scroll)
		END
	END
END MouseDown;


PROCEDURE mouse* (VAR scroll: tScroll);
VAR
	msState: SET;
	x, y: INTEGER;
BEGIN
	K.mouse(msState, x, y);
	IF 0 IN msState THEN
		IF ~scroll.mouse THEN
			MouseDown(scroll, x, y)
		ELSIF scroll.Slider # -1 THEN
			MouseMove(scroll, x, y)
		END
	ELSIF scroll.mouse THEN
		MouseUp(scroll);
		paint(scroll)
	END
END mouse;


PROCEDURE init* (_ScrollChange: tProcedure);
BEGIN
	delay := DELAY;
	ScrollChange := _ScrollChange
END init;


END Scroll.