[ENVIRONMENT('mplot.pen')] MODULE mplot (INPUT,OUTPUT);

(*	CMS Generation: 3                       12-SEP-89
*)

(*
 * Used when drawing an open or closed spline (surprise)
 *)
const	
	open_spline	= true;
	closed_spline  = false;	


TYPE
(***************   bit byte types for I/O stuff ********)
	$ubyte  = [byte] 0..255;
	$quad	= [quad,unsafe] record
		ts,term,len,l2:$ubyte; end;
	$UQUAD = [QUAD,UNSAFE] RECORD
		L0,L1:UNSIGNED; END;
	$UWORD = [WORD] 0..65535;
(*
 * varying strings for input and output and for storing ascii ReGIS commands
 *)
	char1 = varying [1] of char;

	STRING 	= VARYING[210] OF CHAR;         
	str80 = varying[80] of char;
	str20 = varying[20] of char;
(*
 * used for splines and stuff
 *)
	intarray = array [1..200] of integer;

(****     graphics rectangle record ******)
(*
 * x,y coordinates of a corner (usually upper left) w,h width and height
 *)
		grect	= record
				x:integer;	
				y: integer;
				w: integer;
   				h: integer;
			  end;
(*** object ***)
(*
 * linked list of objects with pointers to sub-tree of objects
 *)
	object = record
				bounds : grect;  (* bounding rectangle*)
				sub		: ^object; (*sub tree of objects*)
				species :integer;
				l_style: integer;	 (* line style *)
				draw	: string;	  (* ReGis commands *)
				next 	: ^object;	  (* linked list ptr *)
				prev	: ^object;
				n_file : str80;		 (* next file to expand to*)
				note_file : str80;
			 end;
	ptr	= ^object;


VAR 
(*************** stuff for draw buffer *******)
	rec_num : integer;
	record_on : boolean;
	record_buf : array [0..9] of string;

(*********** io channel ********)
	channel	: $uword;

(******* status constants for I/O routines ***********)
	IOREADP,IOREADT,IOREADPT,IOWRITE,IOWRITEB,ioread  : unsigned;
	port	: str20;

(*************** you tell me ****************)
	term_spec : array [1..2] of integer := (0,-1);

	fill_on	:boolean := false;
	arrow_on : boolean := false;
	l_style : integer := 1; (* linestyle *)
	text_size : integer;	(* text size *)

(************** menu stuff ***********)
	icon : array [0..10] of char1;		(* on screen commands *)
	menu: ptr;				(* on screen menu object *)
	menu_array : array [0..10] of grect;	(* array of 'hot' rectangles *)
(*
 * whether we should draw menu or not on screen redraws
 *)
	menu_draw : boolean;
	temp_draw: boolean;
	menu_w :integer;

	control_hit,mouse_hit : boolean;
(*
 * Workspace parameters
 *)
	grid_on	:boolean := false;
	grid_draw : boolean := false;
	grid_size : integer;

	using_pc : boolean := false;

(* ++++++++++++++++++++++++++++++++++++++++++++++++++ *)

(*  $WAITFR                                                                 *)
(*                                                                          *)
(*    Wait for Single Event Flag                                            *)
(*                                                                          *)
(*     $WAITFR  efn                                                         *)
(*                                                                          *)
(*     efn    = event flag number to wait for                               *)
(*                                                                          *)
 
[ASYNCHRONOUS,EXTERNAL(SYS$WAITFR)] FUNCTION $WAITFR (
	%IMMED EFN : UNSIGNED) : INTEGER; EXTERNAL;
 
(*  $QIO                                                                    *)
(*                                                                          *)
(*    Queue I/O Request                                                     *)
(*                                                                          *)
(*     $QIO     [efn] ,chan ,func ,[iosb] ,[astadr] ,[astprm]               *)
(*     ($QIOW)  ,[p1] ,[p2] ,[p3] ,[p4] ,[p5] ,[p6]                         *)
(*                                                                          *)
(*     efn    = number of event flag to set on completion                   *)
(*                                                                          *)
(*     chan   = number of channel on which I/O is directed                  *)
(*                                                                          *)
(*     func   = function code specifying action to be performed             *)
(*                                                                          *)
(*     iosb   = address of quadword I/O status block to receive final       *)
(*              completion status                                           *)
(*                                                                          *)
(*     astadr = address of entry mask of AST routine                        *)
(*                                                                          *)
(*     astprm = value to be passed to AST routine as argument               *)
(*                                                                          *)
(*     p1...  = optional device- and function-specific parameters           *)
(*                                                                          *)
 
[ASYNCHRONOUS,EXTERNAL(SYS$QIO)] FUNCTION $QIO (
	%IMMED EFN : UNSIGNED := %IMMED 0;
	%IMMED CHAN : INTEGER;
	%IMMED FUNC : INTEGER;
	VAR IOSB : [VOLATILE]$UQUAD := %IMMED 0;
	%IMMED [UNBOUND, ASYNCHRONOUS] PROCEDURE ASTADR := %IMMED 0;
	%IMMED ASTPRM : UNSIGNED := %IMMED 0;
	%REF P1 : [UNSAFE] ARRAY [$l7..$u7:INTEGER] OF $UBYTE := %IMMED 0;
	%IMMED P2 : INTEGER := %IMMED 0;
	%IMMED P3 : INTEGER := %IMMED 0;
	%IMMED P4 : INTEGER := %IMMED 0;
	%IMMED P5 : INTEGER := %IMMED 0;
	%IMMED P6 : INTEGER := %IMMED 0) : INTEGER; EXTERNAL;
 
[ASYNCHRONOUS,EXTERNAL(SYS$QIOW)] FUNCTION $QIOW (
	%IMMED EFN : UNSIGNED := %IMMED 0;
	%IMMED CHAN : INTEGER;
	%IMMED FUNC : INTEGER;
	VAR IOSB : [VOLATILE]$UQUAD := %IMMED 0;
	%IMMED [UNBOUND, ASYNCHRONOUS] PROCEDURE ASTADR := %IMMED 0;
	%IMMED ASTPRM : UNSIGNED := %IMMED 0;
	%REF P1 : [UNSAFE] ARRAY [$l7..$u7:INTEGER] OF $UBYTE := %IMMED 0;
	%IMMED P2 : INTEGER := %IMMED 0;
	%IMMED P3 : INTEGER := %IMMED 0;
	%IMMED P4 : INTEGER := %IMMED 0;
	%IMMED P5 : INTEGER := %IMMED 0;
	%IMMED P6 : INTEGER := %IMMED 0) : INTEGER; EXTERNAL;

(*  $DASSGN                                                                 *)
(*                                                                          *)
(*    Deassign I/O Channel                                                  *)
(*                                                                          *)
(*     $DASSGN  chan                                                        *)
(*                                                                          *)
(*     chan   = number of channel to be deassigned                          *)
(*                                                                          *)
 
[ASYNCHRONOUS,EXTERNAL(SYS$DASSGN)] FUNCTION $DASSGN (
	%IMMED CHAN : INTEGER) : INTEGER; EXTERNAL;
 
(*                                                                          *)
(*  $ASSIGN                                                                 *)
(*                                                                          *)
(*    Assign I/O Channel                                                    *)
(*                                                                          *)
(*      $ASSIGN  devnam ,chan ,[acmode]  ,[mbxnam]                          *)
(*                                                                          *)
(*      devnam = address  of  device  name  or  logical  name   string      *)
(*               descriptor                                                 *)
(*      chan   = address of word to receive channel number assigned         *)
(*      acmode = access mode associated with channel                        *)
(*      mbxnam = address of mailbox logical name string descriptor, if      *)
(*               mailbox associated with device                             *)
(*                                                                          *)
 
[ASYNCHRONOUS,EXTERNAL(SYS$ASSIGN)] FUNCTION $ASSIGN (
	DEVNAM : [CLASS_S] PACKED ARRAY [$l1..$u1:INTEGER] OF CHAR;
	VAR CHAN : [VOLATILE]$UWORD;
	%IMMED ACMODE : UNSIGNED := %IMMED 0;
	MBXNAM : [CLASS_S] PACKED ARRAY [$l4..$u4:INTEGER] OF CHAR := %IMMED 0) : INTEGER; EXTERNAL;
 
CONST	IO$_READPBLK = 12;              (*READ PHYSICAL BLOCK               *)
	IO$_READPROMPT = 55;            (*READ TERMINAL WITH PROMPT         *)
	IO$_READLBLK = 33;              (*READ LOGICAL BLOCK                *)
	IO$_WRITELBLK = 32;             (*WRITE LOGICAL BLOCK               *)
	IO$M_PURGE = 2048;
	IO$M_NOECHO = 64;
	IO$M_NOFILTR = 512;
	IO$M_NOFORMAT = 256;
	IO$M_BREAKTHRU = 512;
	IO$M_TIMED = 128;


function waitfr(evnt : integer):integer;
begin
	waitfr := $waitfr(evnt::unsigned);
end;

(*
 * output command to the ReGIS terminal
 *)
PROCEDURE SQUIRT(BUF :varying[len] of char);
VAR
  	IOSTAT1	:	$UQUAD;
	SYSSTAT	: DOUBLE;  
	EFLAG1	: UNSIGNED;
	count : integer;
	temp : string;
BEGIN
		
	
(*
 * put commands into a save buffer to eventually go into object record in
 * the linked list
 *)
	if (record_on) then begin
	record_buf[rec_num] := record_buf[rec_num] + buf;
	end;

	$QIOW(chan := CHANNEL,func := IOWRITEB::integer,
		iosb:= IOSTAT1,p1:= BUF.body,p2:= BUF.length);
                                           
end;                            

PROCEDURE qwrite(BUF : STRING;flag:unsigned);
VAR
	IOSTAT1	:	$UQUAD;
	SYSSTAT,LENGTH : DOUBLE;
	EFLAG1	: UNSIGNED;
BEGIN

	$QIO(efn := flag,chan:=CHANNEL,func:=IOWRITE::integer,
		iosb:=IOSTAT1,p1:= BUF.body,p2:= BUF.LENGTH);
                                           
                                           
end;                      

(*
 * Read in terminal response to command, usually from a cursor input command
 * that will return the key pressed and coords. Parsed in regis_gin
 *)
PROCEDURE SLURP(var bod: packed array [l..u:integer]of char;
		len:integer);
VAR
	IOSTAT1	:	$QUAD;             
BEGIN

    $QIOW(chan:= CHANNEL,func:=IOREAD::integer,
		iosb:=IOSTAT1,p1:= bod,p2:= LEN,p4:=%ref term_spec );
end;

PROCEDURE QREAD(var bod: packed array [l..u:integer] of char;
		len:integer;flag:unsigned);
VAR
	IOSTAT1	:	$QUAD;
BEGIN

    $QIOW(efn:= flag, chan:= CHANNEL,func:=IOREADP::integer,
		iosb:=IOSTAT1,p1:= bod,p2:= LEN,p4:=%ref term_spec );
                               
end;

(*
 * Move by absolute coordinates
 *)

procedure regis_move(ix,iy: integer);
var 
	outbuf : str80;
begin
 	writev(outbuf,'P[',ix:3,',',iy:3,']');		{   "P[x,y]"   }
	squirt(outbuf);

end;

(*
 * Change drawing style of lines
 *)
procedure set_linestyle(style : integer);
var
	temp : boolean;
	outbuf : str20;
begin
	temp := record_on;
	record_on := false;
	outbuf := 'W(P1)';
	outbuf[4] := chr(48+style);
	squirt(outbuf);
	record_on := temp;

(*	0: blank
	1: solid
	2: dash
	3: dash_dot
	4: close_dot
	5: dash_dot_dot
	6: dot
	7: wide_dot
	8: wide_dash_dot
	9: wide_dot_dash
*)
end;

(*
 * draw the object on the screen, and all sub-objects
 * move to grect origin, all drawing commands are deltas off this
 * 
 *)

procedure regis_dmove(ix,iy: integer);
var 
	outbuf : str20;
	signx,signy : char;
begin
	signx := '+';
	signy := '+';

	if (ix <0 ) then signx := '-';
	if (iy <0 ) then signy := '-';

 	writev(outbuf,'P[',signx,abs(ix):1,',',signy,abs(iy):1,']');
							{   "P[x,y]"   }
	squirt(outbuf);

end;
procedure regis_vector(dx,dy: integer);
var 
	signx,signy :char;
	sx,sy: str20;
	outbuf : string;
begin                                
	signx := '+';
	signy := '+';

	if (dx < 0) then 
	 signx := '-';

	if (dy < 0) then 
	 signy := '-';

	writev(sx,dx:3);
	writev(sy,dy:3);
	
 	writev(outbuf,'V[',signx,abs(dx):1,',',signy,abs(dy):1,']');		{   "V[x,y]"   }
	squirt(outbuf);
	
end;

procedure regis_draw(ix,iy: integer);
var 
	outbuf : string;
begin
 	writev(outbuf,'V[',ix:3,',',iy:3,']');		{   "V[x,y]"   }
	squirt(outbuf);
	
end;

procedure regis_line(x1,y1,x2,y2: integer);
var 
	outbuf : str20;
begin					{ "P[x,y]V[x,y]" }
 	writev(outbuf,'P[',x1:3,',',y1:3,']V[',x2:3,',',y2:3,']');  
	squirt(outbuf);			
	
end;

procedure regis_poly(ix,iy: intarray ; count : integer;open:boolean);
var
	i : integer;
	outbuf : str20;
	signx,signy :char;

begin                  
	                             
	if (not open) then	
	 outbuf := 'V(B)'
	else                                      
	 outbuf := 'V(S)';

	squirt(outbuf);

	for i := 1 to count do
	 begin
	signx := '+';
	signy := '+';
              
	if (ix[i] < 0) then 
	 signx := '-';

	if (iy[i] < 0) then 
	 signy := '-';

		writev(outbuf,'[',signx,abs(ix[i]):1,',',signy,abs(iy[i]):1,']');

{		outbuf := '['+dec(ix)+','+dec(iy)+']';		}
                           
		squirt(outbuf);


	 end; (* of for loop *)
	outbuf := '(E)';
	squirt(outbuf);

end;

procedure regis_spline(ix,iy: intarray ; count : integer;open:boolean);
var
	i : integer;
	x_array,y_array : intarray;
	sint,cost : real;
	dx,dy : integer;
	outbuf : string;
	signx,signy : char;

begin
	
	if (not open) then	
	 outbuf := 'C(B)'
	else
	 outbuf := 'C(S)';

	squirt(outbuf);

	for i := 1 to count do
	 begin

	signx := '+';
	signy := '+';

	if (ix[i] < 0) then 
	 signx := '-';  
                       
	if (iy[i] < 0) then 
	 signy := '-';
	writev(outbuf,'[',signx,abs(ix[i]):1,',',signy,abs(iy[i]):1,']');

		squirt(outbuf);

	 end; (* of for loop *)

	outbuf := '[](E)';
	squirt(outbuf);


	if( arrow_on )then 
	begin		(* arrow on *)

		dx := round(ix[count]-ix[count-1]/5 );
		dy := round(iy[count]-iy[count-1]/5 );

		if ((dx<>0)or(dy<>0)) then 
		begin 				(* non zero *)
	
			sint := dy/(sqrt(dx*dx+dy*dy));
			cost := dx/(sqrt(dx*dx+dy*dy));

			squirt('F(');   
			x_array[1] := round(-(16* cost)+(3.0*sint));
			y_array[1] := round(-(16* sint)-(3.0*cost));

			x_array[2] := round(-6 * sint );
			y_array[2] := round(6 * cost );

			regis_poly(x_array,y_array,2,closed_spline);
			squirt(')');	 
		end; 				(* of non zero deltas *)

	end; (* of arrow draw *)                      
	

end;      

procedure regis_vspline(ix,iy: intarray ; count : integer;open:boolean);
var
	i : integer;
	outbuf : str20;
	signx,signy : char;
begin
	
	if (not open) then	
	 outbuf := 'C(B)'
	else
	 outbuf := 'C(S)';

	squirt(outbuf);

	for i := 1 to count do
	 begin
		if (ix[i] > 0) then
		signx := '+'
		else
	       	signx := '-';
   		if (iy[i] > 0) then
		signy := '+'
		else       
		signy := '-';

	writev(outbuf,'[',signx,abs(ix[i]):1,',',signy,abs(iy[i]):1,']');

{		outbuf := '['+dec(ix)+','+dec(iy)+']';		}

		squirt(outbuf);


	 end; (* of for loop *)
	outbuf := '(E)';
	squirt(outbuf);

end;

PROCEDURE REGIS_CIRCLE(IX,IY: INTEGER);
VAR
	OUTBUF :	STR20;
                      
BEGIN
	
 	writev(outbuf,'C[',ix:3,',',iy:3,']');		{   "C[x,y]"   }
	squirt(outbuf);
		

END;
PROCEDURE REGIS_dCIRCLE(IX,IY: INTEGER);
VAR
	OUTBUF :	STR20;
        signx,signy : char;      
BEGIN
	
	signx := '+';
	signy := '+';

	if (ix < 0) then signx := '-';
	if (iy < 0) then signy := '-';
 	writev(outbuf,'C[',signx,abs(ix):1,',',signy,abs(iy):1,']');	
	squirt(outbuf);
		

END;

PROCEDURE REGIS_arc(IX,IY,angle: INTEGER);
VAR
	OUTBUF :	STR20;
	signa : char;
BEGIN
	if (angle <0) then signa := '-' else signa := '+';
						{   "C(A+-deg)[x,y]"   }

 	writev(outbuf,'C(A',signa,abs(angle):3,')[',ix:3,',',iy:3,']');	
	squirt(outbuf);
		                            

END;

PROCEDURE REGIS_darc(IX,IY,angle: INTEGER);
VAR
	OUTBUF :	STR20;
        signx,signy : str20;
	signa: char;
BEGIN
	signx := '+';
	signy := '+';

	if (ix < 0) then signx := '-';
	if (iy < 0) then signy := '-';
	if (angle < 0) then signa := '-' else signa := '+';

					     	{   "C(A+-deg)[x,y]"   }

 	writev(outbuf,'C(A',signa,abs(angle):1,')[',signx,abs(ix):1,
				 	',',signy,abs(iy):1,']');	
	squirt(outbuf);
		

END;



PROCEDURE REGIS_text(Text: varying[len] of char;
	text_size,intensity : integer);
VAR
	OUTBUF :	STR20;
                      
BEGIN                          


	outbuf := 'T(W(F2),S00)';
	outbuf[10] := chr(48+(text_size div 10));
	outbuf[11] := chr(48+(text_size mod 10));
	outbuf[6] := chr( 48+ intensity );
	squirt(outbuf);

	outbuf := '"';
	squirt(outbuf);

	squirt(text);

	outbuf := '"';
	squirt(outbuf);	


END;




procedure regis_on;
var
	outbuf : str20;
begin
	outbuf := chr(144) + 'p';
	squirt(outbuf);		{ enter ReGIS mode}

end;

procedure regis_off;
var
	buf : str20;
begin
	buf := chr(156);

	squirt(buf);		    	{ exit ReGIS mode}

end;


procedure regis_exit;     
var
	outbuf : str20;

begin
	regis_off;
	$dassgn(channel);
	channel := 0;

end;           

procedure set_output_cursor(cursor : integer);
var
	outbuf : str20;
begin                                        
        (*  1: diamond  *)  	
        (*    2: cross  *)  
        (*    0: off *)     

	outbuf := 'S(C(H1))';
        outbuf[6] := chr(48+cursor);         
        squirt(outbuf);                 

end;
               
procedure set_input_cursor(cursor : integer);
var	
	outbuf	: str20;
begin
	outbuf := 'S(C(I3))';
	outbuf[6] := chr(48+cursor);
	squirt(outbuf);
   
(*	1: diamond
	2: crosshair
	3: rb_line
	4: rb_box *)
end;              
procedure self_input_cursor;      
var	
	i :integer;
	outbuf	: string;
begin
	outbuf := 'L(A1)S(C(I[+0,+0]"XO"))';
	squirt(outbuf);
   
(*	1: diamond
	2: crosshair
	3: rb_line
	4: rb_box *)
end;              



procedure regis_init(signal_error,check_ranges:boolean;port_name:str20);
var
	inbuf	:	str20;
	outbuf	:	str20;
	sysstat : integer;

begin
  
{IOREAD := uor(uor(IO$_READLBLK,IO$M_NOECHO ),IO$M_NOFILTR); }
 ioread := uor(uor(IO$_READLBLK,IO$M_PURGE),IO$M_NOECHO);
 	
IOREADP  := uor(uor(uor(IO$_READPROMPT,IO$M_NOECHO),IO$M_NOFILTR),
				IO$M_NOFORMAT);

IOREADT   := uor(uor(uor(IO$_READLBLK,IO$M_NOECHO),IO$M_NOFILTR),IO$M_TIMED);

IOREADPT  := uor(uor(uor(uor(IO$_READPROMPT,IO$M_NOECHO),
	     	IO$M_NOFILTR),IO$M_NOFORMAT),IO$M_TIMED);

IOWRITE := uor(IO$_WRITELBLK,IO$M_NOFORMAT);
 
IOWRITEB := uor(uor(IO$_WRITELBLK,IO$M_BREAKTHRU),IO$M_NOFORMAT);
      

	port := 'TT';

	SYSSTAT := $ASSIGN('TT',CHANNEL,,);
	
		regis_on;                
		outbuf := 'S(C0)W(R)';	{ turn off output cursor, overlay mode}
		squirt(outbuf);	
		set_linestyle(1);	{ set line style}
					{ determine terminal type}
		regis_off;	
                          
	
end;
procedure regis_reset;
var
	outbuf : str20;

begin
	regis_init(false,false,'TT:');
	regis_on;

	outbuf := 'S(E)P[0,0]W(P1)';
	squirt(outbuf);

	regis_off;
	outbuf := '*1;1H';  (* erase screen ,home cursors *)
	outbuf[1] := chr(155);
	squirt(outbuf);
	regis_on;
	
	set_linestyle(l_style);		(* solid line *)
	

end;      


(********* is (x,y) within the rectangle? *********)
         
function within(x,y:integer;bounds:grect):boolean;
var
	a,b : integer;
begin
(*
 * find distance away for x and y dimensions
 *)
	a := x-bounds.x;
	b := y-bounds.y;

	if (((bounds.w >=0) and(a<=bounds.w) and (a >= 0)) 
	    or ((bounds.w <=0) and( a>=bounds.w) and (a<=0) ) )
	and  (((bounds.h >=0) and(b<=bounds.h) and (b >= 0)) 
	    or ((bounds.h <=0) and( b>=bounds.h) and (b<=0) ) ) then
	 within := true
	else 
	 within := false;

end;


procedure regis_gin(var ix,iy:integer;var key:char; ic:integer);
var                                 
	outbuf : str20;
	dumbuf,inbuf	: str20;	
 	dummy,dummy2,d3,d4,d5	: char;
	start,stat,junk1,junk2	: integer;
	temp_record_on : boolean;
begin
	inbuf :='               ';	
	outbuf := 'S(C(I ))R(P(I))';
	outbuf[6] := chr(48+ic);

	control_hit := false;	
	mouse_hit := false;	
	temp_record_on := record_on;
	record_on := false;                                
       	squirt(outbuf);			(* queue a write & wait *)
	slurp(inbuf.body,inbuf.length);	(* queue a read & wait *)

	start := index(inbuf,'[');
	while (inbuf[start+1] = '[') do start:=start+1;

	while ( ord(inbuf[1]) =13) do 
	 begin 
	      	junk1 := 1;
		slurp(inbuf.body,junk1);
                    
	       	squirt(outbuf);		(* queue a write & wait *)
		slurp(inbuf.body,inbuf.length);
	 end;

	start := index(inbuf,'[');
	while (inbuf[start+1] = '[') do start:=start+1;
	if (start=0) then begin
		slurp(inbuf.body,inbuf.length);
		inbuf := 'S[0,0]';
		start := 2;
		end;
          
	 if (ord(inbuf[1]) =155) then   (* function keys & help *)
	  begin
		dumbuf:=substr(inbuf,start,length(inbuf)-start+1);
		readv(dumbuf,d4,ix,d5,iy);
		readv(inbuf,dummy,d3); (* get raw character *)
		if (( ord(d3)<48 ) or (ord(d3)>57)) then (* if char *)
		key := d3 	(* use character as key pressed *)
		else (* its a number, so read it in *)
		begin
			readv(inbuf,dummy,junk1); (* error here *)

			(****)
			if (junk1 > 34) then (* mouse button *)
		       	begin
				key := chr(junk1);
				mouse_hit := true;
				if (using_pc) then
				 if (key = 'ñ') then key := 'ó'
				 else if (key = 'ó') then key := 'ñ';
			 end
			else 
			begin
			 control_hit := true;
	       		 key := chr(junk1 + 96);
			end;
			(****)
		end;
	 end
	else if ((inbuf[1])=chr(27) ) then (* escape *)
	  begin
		regis_off;
	      	writeln(' Hey! use 8-bit mode in the General Set Up');
		regis_on;
	 end
	 else
	begin
		dumbuf:=substr(inbuf,start,length(inbuf)-start+1);

	       	readv(dumbuf,d4,ix,d5,iy);
		readv(inbuf,key);

	end;

	if(grid_on) then 
	 begin
 if(not (menu_draw and within(ix,iy,menu^.bounds)) )then
	  begin
		ix := (ix+ (grid_size div 2)) -((ix+ (grid_size div 2)) mod grid_size);
		iy := (iy+ (grid_size div 2)) -((iy+ (grid_size div 2)) mod grid_size) ;

(*		ix := ix- (ix mod grid_size)+ (grid_size div 2);
		iy := iy- (iy mod grid_size) + (grid_size div 2);
*)	  end;
	 end;
	record_on := temp_record_on;
end;

end.