/* --- Copyright University of Sussex 1992.  All rights reserved. ---------
 > File:           C.all/lib/flavours/instrument_flavours.p
 > Purpose:        LOOPS LIKE INSTRUMENTS.
 > Author:         Mark Rubinstein, Jul  8 1986 (see revisions)
 > Documentation:  HELP * INSTRUMENT_FLAVOURS
 > Related Files:  LIB * FLAVOURS, * WINDOW_FLAVOURS
 */

section;

uses window_flavours;
vars instrument_window = false;

flavour instrument_window isa part_graphics_window;
ivars instrument = false;
divars size = {150 150};
	defmethod before updaterof size(v);
	lvars v, ov = ^size;
		{% max(v(1), ov(1)), max(v(2), ov(2)) %}
	enddefmethod;
	defmethod after updaterof size;
		size -> hostwindow <- size;
	enddefmethod;
	defmethod middle_button_pushed(x, y);
	lvars x y p;
		instrument <- middle_button_pushed(x, y);
	enddefmethod;
	defmethod refreshself;
		if instrument then instrument <- refreshself endif;
	enddefmethod;
endflavour;

;;; -- INSTRUMENT ----------------------------------------------------------
flavour instrument a mixin isa ivalofinit named_object;
divars value hostwindow minvalue = 0, range = 100, instrument_size;
ivars x_offset = 10, y_offset = 10, name = '';
	defmethod refreshself;
		;;; hostwindow <- clearself;
		^makeself;
	enddefmethod;
	defmethod before updaterof value(v) -> v;
	lvars v;
		unless v >= minvalue and v <= (minvalue + range) do
			mishap('ATTEMPT TO MOVE VALUE OUTSIDE INSTRUMENT GUAGE',
				[^v range ^minvalue to ^(minvalue + range)])
		endunless;
	enddefmethod;
	defmethod writename;
		if isstring(name) and name /= '' then
			hostwindow <- writetext(1,
				(hostwindow<-size)(2) - (1 + hostwindow<-char_base), name);
		endif;
	enddefmethod;
	defmethod makeself;
		^draw_instrument_border;
		^paintvalue;
		^writename;
	enddefmethod;
	defmethod before paintvalue;
		if value == minvalue or value == minvalue + range then
			quitmessage;
		endif;
	enddefmethod;
	defmethod after initialise;
		if value == undef then minvalue -> value endif;
		unless isinstance(hostwindow, window_type_flavour) do
			unless isinstance(instrument_window, partitioned_window_flavour) do
				make_instance([partitioned_window
					name 'instrument window'
					size {400 400} position {750 150}
					contents [] ]) -> instrument_window;
			endunless;
			make_instance([instrument_window
							name %gensym("instrument")%
							hostwindow ^instrument_window
							instrument ^self]) -> hostwindow;
		endunless;
		^adjust_host_size;
		^makeself;
		if bordering then hostwindow <- borderself endif;
	enddefmethod;
	defmethod position;
		hostwindow<-position;
	enddefmethod;
	defmethod updaterof position(newv);
	lvars newv;
		newv -> hostwindow<-position;
	enddefmethod;
	defmethod before updaterof range(r) -> r;
	lvars r;
		if isinteger(value) and value > minvalue + r do
			mishap(r, value, 2, 'RANGE WILL NOT INCLUDE CURRENT VALUE');
		endif;
	enddefmethod;
	defmethod after updaterof range;
		^refreshself;
	enddefmethod;
	defmethod before updaterof minvalue(m) -> m;
	lvars m;
		if isinteger(value) and (value < m or value > m + range) do
			mishap(m, value, 2, 'MINVALUE WILL NOT INCLUDE CURRENT VALUE');
		endif;
	enddefmethod;
	defmethod after updaterof minvalue;
		^refreshself;
	enddefmethod;
	defmethod middle_button_pushed(x, y);
	lvars x y;
		;;; default method -- do nothing
	enddefmethod;
	defmethod after updaterof instrument_size;
		^adjust_host_size;
		^refreshself;
	enddefmethod;
endflavour;
instrument_flavour <- subclass_responsibility([draw_instrument_border
	paintvalue adjust_host_size]);

;;; -- SCALED_INSTRUTMENT --------------------------------------------------
flavour scaled_instrument a mixin isa instrument;
ivars graduation_frequency = 10, label_frequency = 2;
	defmethod after draw_instrument_border;
		^writescale
	enddefmethod;
endflavour;
scaled_instrument_flavour <- subclass_responsibility("writescale");

;;; -- BAR_GAUGE -----------------------------------------------------------
flavour bar_gauge a mixin isa instrument;
divars instrument_size = 100;
ivars gauge_length gauge_width x_offset = 10, y_offset = 10;
	defmethod after updaterof gauge_width;
		(hostwindow<-size)(2) - (gauge_width + 25) -> y_offset;
	enddefmethod;
	defmethod draw_instrument_border;
		hostwindow <- drawline([% x_offset, y_offset,
			gauge_length + x_offset, y_offset,
			gauge_length + x_offset, y_offset + gauge_width,
			x_offset, y_offset + gauge_width, x_offset, y_offset %]);
	enddefmethod;
	defmethod offset_for_value(v);
	lvars v;
		round(instrument_size * ((v - minvalue) / range))
	enddefmethod;
	defmethod before updaterof gauge_width;
		hostwindow <- wipeself;
	enddefmethod;
	defmethod after updaterof gauge_width;
		^makeself;
	enddefmethod;
	defmethod before updaterof gauge_length;
		hostwindow <- wipeself;
	enddefmethod;
endflavour;

;;; -- HORIZONTAL_BAR_GAUGE ------------------------------------------------
flavour horizontal_bar_gauge isa bar_gauge;
ivars gauge_length = 100, gauge_width = 10, y_offset = 30;
	defmethod adjust_host_size;
		{% gauge_length + x_offset +25,
		   gauge_width + y_offset + 25 %} -> hostwindow <- size;
	enddefmethod;
	defmethod after updaterof gauge_length;
		gauge_length -> instrument_size;
	enddefmethod;
	defmethod after updaterof instrument_size;
		instrument_size -> gauge_length;
	enddefmethod;
	defmethod paintvalue;
	lvars x;
		^offset_for_value(value) -> x;
		hostwindow <- paintarea(x_offset, y_offset + 1, x,
			gauge_width - 1, PWM_SET);
	enddefmethod;
	defmethod before updaterof value(v) -> v;
	lvars oldv newv oldx newx v;
		value -> oldv;
		v -> newv;
		;;; don't erase parts of the border
		if oldv == minvalue then oldv + 1 -> oldv endif;
		if oldv == minvalue + range then oldv - 1 -> oldv endif;
		if newv == minvalue then newv + 1 -> newv endif;
		if newv == minvalue + range then newv - 1 -> newv endif;
		;;; find out the x values for old and new
		^offset_for_value(oldv) -> oldx;
		^offset_for_value(newv) -> newx;
		if newv > oldv then
			hostwindow <- paintarea(x_offset + oldx, y_offset + 1,
				newx - oldx, gauge_width - 1, PWM_NOTDST);
		elseif newv < oldv then
			hostwindow <- paintarea(x_offset + newx, y_offset + 1,
				oldx - newx, gauge_width - 1, PWM_NOTDST);
		endif;
	enddefmethod;
endflavour;
syssynonym("hbg_flavour", "horizontal_bar_gauge_flavour");

;;; -- VERTICAL_BAR_GAUGE --------------------------------------------------
flavour vertical_bar_gauge isa bar_gauge;
ivars gauge_length = 10, gauge_width = 100, y_offset = 20;
	defmethod adjust_host_size;
		{% gauge_length + x_offset + 25,
		   gauge_width + y_offset + 25 %} -> hostwindow <- size;
	enddefmethod;
	defmethod after updaterof gauge_width;
		gauge_width -> ^instrument_size;
	enddefmethod;
	defmethod after updaterof instrument_size;
		instrument_size -> gauge_width;
	enddefmethod;
	defmethod paintvalue;
	lvars y;
		^offset_for_value(value) -> y;
		hostwindow <- paintarea(x_offset + 1, y_offset, gauge_length - 1,
			y, PWM_SET);
	enddefmethod;
	defmethod before updaterof value(v) -> v;
	lvars newv oldy newy oldv v;
		value -> oldv;
		v -> newv;
		;;; don't erase parts of the border
		if oldv == minvalue then oldv + 1 -> oldv endif;
		if oldv == minvalue + range then oldv - 1 -> oldv endif;
		if newv == minvalue then newv + 1 -> newv endif;
		if newv == minvalue + range then newv - 1 -> newv endif;
		;;; find out the y values for old and new
		^offset_for_value(oldv) -> oldy;
		^offset_for_value(newv) -> newy;
		if newv > oldv then
			hostwindow <- paintarea(x_offset + 1, y_offset + oldy,
				gauge_length - 1, newy - oldy, PWM_NOTDST);
		elseif newv < oldv then
			hostwindow <- paintarea(x_offset + 1, y_offset + newy,
				gauge_length - 1, oldy - newy, PWM_NOTDST);
		endif;
	enddefmethod;
endflavour;
syssynonym("vbg_flavour", "vertical_bar_gauge_flavour");

;;; -- SCALED_HORIZONTAL_BAR_GAUGE -----------------------------------------
flavour scaled_horizontal_bar_gauge isa horizontal_bar_gauge scaled_instrument;
	defmethod writescale;
	lvars x tmp;
		;;; draw little lines every -graduation_frequency- of the way
		for x from x_offset
		by instrument_size div graduation_frequency
		to x_offset + instrument_size do
			hostwindow <- drawline([% x, y_offset, x, y_offset - 5 %])
		endfor;
		;;; draw the bigger lines and numbers
		for x from x_offset
		by instrument_size div label_frequency
		to x_offset + instrument_size do
			hostwindow <- drawline([% x, y_offset - 10, x, y_offset %]);
		endfor;
		for x from minvalue
		by range div label_frequency
		to minvalue + range do
			min(x_offset - 5 + ^offset_for_value(x),
				(hostwindow<-size)(1) -
					(datalength(x >< '') * (hostwindow<-char_width))) -> tmp;
			hostwindow <- writetext(tmp, y_offset - 15, '' >< x);
		endfor;
	enddefmethod;
endflavour;
syssynonym("shbg_flavour", "scaled_horizontal_bar_gauge_flavour");

;;; -- SCALED_VERTICAL_BAR_GAUGE -------------------------------------------
flavour scaled_vertical_bar_gauge isa vertical_bar_gauge scaled_instrument;
	defmethod writescale;
	lvars x y;
		x_offset + gauge_length -> x;
		;;; draw little lines every tenth of the way
		for y from y_offset by instrument_size div 10 to y_offset + instrument_size do
			hostwindow <- drawline([% x, y, x + 5, y %])
		endfor;
		;;; draw the bigger lines and numbers
		for y from y_offset by instrument_size div 2 to y_offset + instrument_size do
			hostwindow <- drawline([% x, y, x + 10, y %]);
		endfor;
		x + 10 -> x;
		for y from minvalue by range div 2 to minvalue + range do
			hostwindow <- writetext(x, y_offset + ^offset_for_value(y),
				'' >< y);
		endfor;
	enddefmethod;
endflavour;
syssynonym("svbg_flavour", "scaled_vertical_bar_gauge_flavour");

;;; -- RECEIVING_BAR_GAUGE -------------------------------------------------
flavour receiving_bar_gauge isa bar_gauge;
	defmethod after initialise;
		;;; receive inputs if there is a method to handle it.
			window_input(% report_or_send(% self, myflavour, false %) %)
				-> pwm_itemhandler(^hostwindow<-hostwindow<-window_id, false,
				false, [% x_offset, y_offset, gauge_length, gauge_width %])
	enddefmethod;
	defmethod value_for_offset(o);
	lvars o;
		((o / instrument_size) * range) + minvalue
	enddefmethod;
	defmethod left_button_pushed(x, y);
		lvars   x y;
		max(^value - (range / 100), minvalue) -> ^value
	enddefmethod;
	defmethod right_button_pushed(x, y);
		lvars   x y;
		min(^value + (range / 100), minvalue + range) -> ^value
	enddefmethod;
endflavour;

;;; -- RECEIVING_HORIZONTAL_BAR_GAUGE --------------------------------------

flavour receiving_horizontal_bar_gauge isa hbg receiving_bar_gauge;
	defmethod middle_button_pushed(x, y);
	lvars x y;
		^value_for_offset(x - x_offset) -> y;
		unless y < minvalue or y > minvalue + range do y -> ^value endunless;
	enddefmethod;
endflavour;
syssynonym("rhbg_flavour", "receiving_horizontal_bar_gauge_flavour");

;;; -- RECEIVING_VERTICAL_BAR_GAUGE ----------------------------------------
flavour receiving_vertical_bar_gauge isa vbg receiving_bar_gauge;
	defmethod middle_button_pushed(x, y);
	lvars x y;
		^value_for_offset(y - y_offset) -> y;
		unless y < minvalue or y > minvalue + range do y -> ^value endunless;
	enddefmethod;
endflavour;
syssynonym("rvbg_flavour", "receiving_vertical_bar_gauge_flavour");

;;; -- SCALED_RECEIVING_HORIZONTAL_BAR_GAUGE -------------------------------
flavour scaled_receiving_horizontal_bar_gauge isa shbg rhbg;
endflavour;
syssynonym("srhbg_flavour", "scaled_receiving_horizontal_bar_gauge_flavour");

;;; -- SCALED_RECEIVING_VERTICAL_BAR_GAUGE ---------------------------------
flavour scaled_receiving_vertical_bar_gauge isa svbg rvbg;
endflavour;
syssynonym("srvbg_flavour", "scaled_receiving_vertical_bar_gauge_flavour");

;;; -- DIAL ----------------------------------------------------------------

flavour dial isa instrument;
divars instrument_size = 50;
ivars x_offset = 75, y_offset = 90, centre_radius = 10;
	defmethod draw_instrument_border;
		hostwindow <- upper_hemisphere(x_offset, y_offset, instrument_size);
		hostwindow <- filled_upper_hemisphere(x_offset, y_offset, centre_radius);
	enddefmethod;
	defmethod before updaterof instrument_size(n) -> n;
	lvars n;
		(y_offset - instrument_size) + n -> y_offset;
		hostwindow <- wipeself;
	enddefmethod;
	;;; co-ord on circumference for value v given radius r
	defmethod circ_for_value_at(v, r);
	lvars v r angle;
		180 * ((v - minvalue) / range) -> angle;
		{% round(x_offset - (cos(angle) * r)),
			round(y_offset - (sin(angle) * r)) %}
	enddefmethod;
	defmethod adjust_host_size;
		max(x_offset,instrument_size + 10) -> x_offset;
		max(y_offset,instrument_size + 10) -> y_offset;
		{% x_offset + instrument_size + 10, y_offset + 25 %}
			-> hostwindow <- size;
	enddefmethod;
	defmethod paintvalue;
		hostwindow <- drawline(^circ_for_value_at(value, centre_radius + 1),
								^circ_for_value_at(value, instrument_size - 3), 2);
	enddefmethod;
	defmethod before updaterof value;
		unless intof(value) == minvalue or intof(value) = minvalue + range do
			hostwindow<-paint ||/& 1 -> hostwindow<-paint;
			^paintvalue;
			hostwindow<-paint ||/& 1 -> hostwindow<-paint;
		endunless;
	enddefmethod;
	defmethod after updaterof value;
		^paintvalue;
	enddefmethod;
endflavour;

flavour receiving_dial isa dial;
	defmethod after initialise;
		;;; receive inputs if there is a method to handle it.
			window_input(% report_or_send(% self, myflavour, false %) %)
				-> pwm_itemhandler(^hostwindow<-hostwindow<-window_id, false,
				false, [% x_offset - instrument_size, y_offset - instrument_size,
						2*instrument_size, instrument_size %])
	enddefmethod;
	defmethod middle_button_pushed(x,y);
		lvars x y val ang;
		arctan2(x_offset - x,y_offset - y) -> ang;
		abs(ang)/180*range+minvalue -> val;
		if val >= minvalue and val <= (minvalue + range) then
			val -> ^value;
		endif;
	enddefmethod;
	defmethod left_button_pushed(x, y);
		lvars   x y;
		max(^value - (range / 100), minvalue) -> ^value
	enddefmethod;
	defmethod right_button_pushed(x, y);
		lvars   x y;
		min(^value + (range / 100), minvalue + range) -> ^value
	enddefmethod;
endflavour;

flavour scaled_dial isa dial scaled_instrument;
ivars x_offset = 70;
	defmethod adjust_host_size;
	lvars inc;
		datalength(range + minvalue >< '') * (hostwindow <- char_width) -> inc;
		max(y_offset,instrument_size + 30) -> y_offset;
		max(x_offset,instrument_size + max(30, inc + 10)) -> x_offset;
		{% x_offset + instrument_size + 50, y_offset + 25 %}
			-> hostwindow <- size;
	enddefmethod;
	defmethod writescale;
	lvars v x y;
		;;; draw little lines every tenth of the way
		for v from minvalue

		by range div graduation_frequency
		to minvalue + range do
			hostwindow <- drawline(^circ_for_value_at(v, instrument_size),
							^circ_for_value_at(v, instrument_size + 5), 2);
		endfor;
		;;; draw bigger lines and numbers
		for v from minvalue
		by range div label_frequency
		to minvalue + range do
			hostwindow <- drawline(^circ_for_value_at(v, instrument_size),
				^circ_for_value_at(v, instrument_size + 10), 2);
			^circ_for_value_at(v, instrument_size + 15) -> y;
			max(0, min(y(1),
				(hostwindow<-size)(1) -
					((hostwindow<-char_width) * datalength(v >< '')))) -> x;
			max(hostwindow<-char_height, min(y(2), (hostwindow<-size)(2)))
				-> y;
			hostwindow <- writetext(x, y, v >< '');
		endfor;
	enddefmethod
endflavour;

flavour receiving_scaled_dial isa receiving_dial scaled_dial; endflavour;

endsection;

;;; makes uses happy
vars instrument_flavours = true;


/* --- Revision History ---------------------------------------------------
--- Gareth Palmer, Aug 29 1989
	Altered for new name -pwm_itemhandler- replacing -pwmitemhandler-
--- Ian Rogers, Jun 20 1988
	Added borderself check to the after initialise method of instrument
	flavour.
--- Nic Ford, Aug 20 1987
	Changed gauge and dial mouse input:
		Left button		=	decrease value by range/100
		Middle button	= 		mouse position -> value
		Right button	=	increase vale by range/100
--- Ian Rogers - Nic Ford, Jul 20-21 1987
	Added before updaterof size method in instrument_window flavour, ensures
		that the window is never shrunk - only grown
	Added after updaterof size method in instrument_window flavour, ensures
		that the window LOOKS as if it has been resized.
	Changed the calculations of adjust_host_size in horizontal_bar_gauge.
	Changed the calculations of adjust_host_size in vertical_bar_gauge.
	Added the after initialise demon in receiving_bar_gauge to set up the
		mouse event area for that gauge.
	Changed adjust_host_size in dial flavour to take into account any
		previous values of x_offset and y_offset
	Added receiving_dial flavour
	Changed adjust_host_size in scaled_dial flavour to take into account any
		previous values of x_offset and y_offset
	Added receiving_scaled_dial flavour.
 */
