Subversion Repositories Kolibri OS

(*

    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 .

*)

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.winColor);

	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.