[INHERIT ('GCLICMD','mplot','TPARSE')]
PROGRAM mdraw(input,output);
(*	CMS Generation: 26                       1-MAY-90
*)

CONST
	MAX_X	 = 799;
	MAX_Y	 = 479;

(* object types *)
	OBJ_UNKNOWN	= -1;
	OBJ_BOX		= 1;
	OBJ_LINE	= 2;
	OBJ_TEXT	= 3;
	OBJ_CIRCLE	= 4;
	OBJ_SPLINE	= 5;
	OBJ_GATE	= 6;
	OBJ_ARC		= 7;
	OBJ_JOINED	= 8;

TYPE
	ustr = [UNSAFE] PACKED ARRAY [1..255] OF CHAR;	{ Used by command line parser routines }
	ustr_ptr = ^ustr;

(*
 * Actually used in the help screen to hold lines of info
 *)
	menu_lines = packed array [1..10] of str20;

	hex_pair = varying [2] of char;
	command_line = varying[64] of char;

var

	command,filename : STRING;
	cmd_ok	: boolean;	
	CMD_STATE,CMD_KEY: [EXTERNAL] Table_type;	{ Used with command line parser routines }


(**************** object tree stuff ************)
	(** Current object *)
	part,

	(** delineates the linked list of objects *)
	head,tail,

	(** pointers to cut and pasted objects *)
	paste_part,cut_part,

	(** generic temp pointers *)
	temp,temp2 : ptr;

	(** name of file to zoom up to if necessary *)
	note_file,zoom_file :str80;

	(** name of current file *)
	loaded_file :str80;

	(** current file extension for saveing and loading files *)
	save_ext : str20;


(********** generic strings and booleans *************)
	new_icon : str20;
	gtext : string;		(* actual text *)
	dummy_s :str80;
	dummy_b,done : boolean := false;
	do_again : boolean := false;	(* #3 button repeat command *)

	

(***********  characters returned by the terminal **********)
	txy	:string;
	key	: char := ' ';		(* key just hit *)
	last_key : char := ' ';		(* key last hit *)
	key2	: char := ' ';
	hex	 : packed array [1..10] of hex_pair;

(************  spline arrays ***************)
	x_array,y_array : intarray; 

(************ standard all purpose integers *********)
	ix,iy,ic,input_cursor: integer;                       
	again_item	: integer := -1;
	last_item	: integer := -1;
(*
 * maximum x in grect list, maximum y in grect list, minimums too
 *)
	maxx,may,mix,miy,
(*
 * temp x,y coords
 *)
	tx,ty,
(*
 * temp delta x,y vectors
 *)
	cx,cy,rad1,rad2,angle2,angle,dx,dy,i,j : integer;
	trect :grect;

(************* save file for ReGIS/sixel data ****************)
	pic_file : TEXT;                               
	object_file : TEXT;

(*        ============================================= *)


(************   spawn a command line ie   sixel screen capture command **)
[EXTERNAL(LIB$SPAWN)] Function Spawn_command_line
	(%DESCR command:command_line):boolean;external;


{ *************************************************************************** }
{ Command line parser routines }

[GLOBAL] FUNCTION GET_FILENAME : UNSIGNED;

VAR             
    stat : UNSIGNED;
    file_name : STRING;
    file_str : RECORD
                 CASE INTEGER OF
                   1 : ( address : UNSIGNED; );
                   2 : ( ptr : ustr_ptr; );
               END;              

BEGIN

    stat := 1;
    file_str.address := TPA.TPA$L_TOKENPTR;
    file_name := substr(file_str.ptr^,1,TPA.TPA$L_TOKENCNT);
    case int(TPA.TPA$L_PARAM) of
	1 : begin
		filename := file_name;
		end;
	2 : begin
		regis_off;
		writeln('file_name =',file_name);
		regis_on;
		end;

    end; { case }
		

    GET_FILENAME := stat;
end;

[GLOBAL] PROCEDURE GET_OPTIONS;

VAR
    stat : UNSIGNED;
    file_name : STRING;
    file_str : RECORD
                 CASE INTEGER OF
                   1 : ( address : UNSIGNED; );
                   2 : ( ptr : ustr_ptr; );
               END;              

BEGIN

    stat := 1;
    file_str.address := TPA.TPA$L_TOKENPTR;
    file_name := substr(file_str.ptr^,1,TPA.TPA$L_TOKENCNT);

	using_pc := true;

END; { NO_FILE }

[GLOBAL] PROCEDURE NO_FILE;

BEGIN

	writeln('No Filename given...');


END; { NO_FILE }

FUNCTION Parse_Command_Line( VAR command : varying[u1] of char ) : BOOLEAN;
VAR
    i : INTEGER;
    Parse_Stat : TPA_Stat_Type;

BEGIN
    TPA.TPA$B_MCOUNT := 3;
    TPA.TPA$V_BLANKS := TRUE;
    Parse_Stat := Table_Parse(command,CMD_STATE,CMD_KEY);
    Parse_Command_Line := (Parse_Stat = NORMAL);
END; { Parse_Command_Line }


	
(***** flip horizontally ***)
procedure flip_h(part: ptr;bigx:integer);
var draw : string;
	dummy,sign,sign2 : char;
	i,x_pos,y_pos : integer;
	point : str20;
	x,y,w,h : integer;
begin

	draw := part^.draw;
	w := bigx;

	i :=0;	                             
	repeat
	 i := i+1;
	until draw[i]<> ' ';

	case ( draw[i] )of
       		'P'	: begin (* get coords of start *)
       			 point := substr(part^.draw,i,index(part^.draw,']')-i+1);
	  		readv(point,dummy,dummy,sign,x_pos,dummy,sign2,y_pos);
	  		 if (sign = '-') then 
				x_pos := -x_pos;
			 x_pos := w-x_pos;
			 if (x_pos <0) then sign := '-' else sign := '+';
                          
			 writev(point,' P[',sign,abs(x_pos):1,',',sign2,y_pos:1,']');
			 part^.draw := point;

			 for i := (1+index(draw,']')) to length(draw) do begin
			  if ((draw[i] = '+') and 
				((draw[i-1]='[')or(draw[i-1]='A') )) then
	  			draw[i]:= '-' 
			  else
			  if ((draw[i] = '-') and 
				( (draw[i-1]='[') or (draw[i-1]='A'))) then
				draw[i]:= '+';
			  part^.draw := part^.draw+ (draw[i]);
	  		  end; (* of for loop *)

       			 end;
	  	'V'	: begin
			if ((draw[i+1] <> '(') ) then begin
			 point := substr(part^.draw,i,index(part^.draw,']')-i+1);
			readv(point,dummy,dummy,sign,x_pos,dummy,sign2,y_pos);
			 if (sign = '-') then 
				x_pos := -x_pos;
			 x_pos := -x_pos;
			 if (x_pos <0) then sign := '-' else sign := '+';
                          
			 writev(point,' V[',sign,abs(x_pos):1,
				',',sign2,abs(y_pos):1,']');
			 part^.draw := point;           

			 for i := (1+index(draw,']')) to length(draw) do begin
			  if ((draw[i] = '+') and ((draw[i-1]='[') or
						(draw[i-1]='A')) )then
	  			draw[i]:= '-'                     
			  else
			  if ((draw[i] = '-') and ((draw[i-1]='[') or 
						(draw[i-1]='A')) )then
				draw[i]:= '+';

	  		  part^.draw := part^.draw+ (draw[i]);
	  		  end; (* of for loop *)


			 part^.bounds.x := part^.bounds.x + w;
			 part^.bounds.w := -part^.bounds.w ;

		  end;(* of no '(' found *)
		end; (* end of 'V' *)
       	end; (* end of case *)

end;

(***** flip verticaltally ***)
procedure flip_v(part: ptr;bigy :integer);
var draw : string;
	dummy,sign,sign2 : char;
	i,x_pos,y_pos : integer;
	point : str20;
	w,h : integer;
begin

	draw := part^.draw;
	h := bigy;	

	i :=0;	
	repeat
	 i := i+1;                                                      
	until draw[i]<> ' ';

	case ( draw[i] )of
       		'P'	: begin (* get coords of start *)
       		    	 point := substr(part^.draw,i,index(part^.draw,']')-i+1);
			readv(point,dummy,dummy,sign,x_pos,dummy,sign2,y_pos);
			 if (sign2 = '-') then 
				y_pos := -y_pos;
			 y_pos := h-y_pos;
			 if (y_pos < 0) then sign2 := '-' else sign2 := '+';
			 writev(point,'P[',sign,abs(x_pos):1,',',sign2,abs(y_pos):1,']');
			 part^.draw := point;

			 for i := (1+index(draw,']')) to length(draw) do begin
			  if ((draw[i] = '+') and 
				( (draw[i-1]=',')or(draw[i-1]='A'))) then
	  			draw[i]:= '-' 
			  else                                           
			  if ((draw[i] = '-') and 
				((draw[i-1]=',')or(draw[i-1]='A')) ) then
				draw[i]:= '+';
			  part^.draw := part^.draw+ (draw[i]);
			  end; (* of for loop *)

			 end;
		'V'	: begin
			if ((draw[i+1] <> '('))  then begin
			 point := substr(part^.draw,i,index(part^.draw,']')-i+1);
			readv(point,dummy,dummy,sign,x_pos,dummy,sign2,y_pos);
			 if (sign2 = '-') then 
				y_pos := -y_pos;
			 y_pos := -y_pos;                    
			 if (y_pos <0) then sign2 := '-' else sign2 := '+';
                                               
			 writev(point,' V[',sign,abs(x_pos):1,
				',',sign2,abs(y_pos):1,']');
			 part^.draw := point;              

			 for i := (1+index(draw,']')) to length(draw) do begin
			  if ((draw[i] = '+') and ((draw[i-1]=',') or
							(draw[i-1]='A')) )then
	  			draw[i]:= '-' 
			  else                                           
			  if ((draw[i] = '-') and ((draw[i-1]=',') or
						(draw[i-1]='A')) )then
				draw[i]:= '+';
			  part^.draw := part^.draw+ (draw[i]);
			  end; (* of for loop *)
          
			 part^.bounds.y := part^.bounds.y + h;
			 part^.bounds.h := -part^.bounds.h ;
			 end; (* end of no '(' found *)
		end;

	end; (* end of case *)

end;   

procedure flip_sub(part:ptr; x,y: integer; direction :char);
var
	tnext,temp :ptr;
begin

	        temp := part^.sub;
	        if(temp = nil) then
                begin (* real object here *)
		 if direction = 'h' then flip_h(part,x) 
			else flip_v(part,y);
                end (* real object here *)
 	        else 
		 begin (* sub-object *)
	                tnext := temp;

	                while (tnext <> nil) do 
	                  begin
				if (direction = 'h') then
				 begin
 			  tnext^.bounds.x := x-tnext^.bounds.x-tnext^.bounds.w;
				 end
				else
				 begin
		tnext^.bounds.y := y-tnext^.bounds.y-tnext^.bounds.h;
				 end;

				flip_sub(tnext,tnext^.bounds.w,tnext^.bounds.h,direction);
	                        tnext := tnext^.next;
	                  end; (* while *)
                end; (* sub-object *)

end;


(******** return pointer, or nil, of first object under (x,y) *****)
function find(x,y:integer):ptr;
var
    	p : ptr;
	done : boolean;
begin
	done := false;
	p := head;

(*
 * If empty object tree then return nil
 *)
	if (p= nil) then done := true;

	while (not done ) do
	 begin
(*
 * if cursor pointing to this object return address of object record
 *)
		if(within(x,y,p^.bounds)) then
	 	 done := true
(*
 * if more objects left to search go for it
 *)
		else if (p <> tail) then
		 p := p^.next
(*
 * no objects left, return nil
 *)
		else
		 begin
			p := nil;
			done := true;
		 end;
	 end;
	                                                            
	find := p;

end;
(***********   find next object under current object which is under pointer *****)
(*
 * x,y : coord of cursor 	p: pointer to selected object (in the list)
 *)

function find_next(x,y:integer;p:ptr):ptr;
var
	temp : ptr;
	done : boolean;
begin
	done := false;         

	temp := p;
	if(temp = nil) then
		begin
		 done := true;
		 temp := nil;
		end;

	while (not done ) do
	 begin
		if(within(x,y,temp^.bounds)) then
		 done := true
		else if (temp <> tail) then
		 temp := temp^.next
		else
		 begin
			temp := nil; 	
    			done := true;
		 end;
	 end;                                
	find_next := temp;

end;

(******* find object above current object which is under cursor ***)
(*
 * x,y: coord of cursor		p: pointer to selected object (in list)
 *)
function find_prev(x,y:integer; p:ptr):ptr;
var
	temp : ptr;
	done : boolean;
begin                            

	done := false;

	temp := p;

	if (temp= nil) then 
	 begin
		done := true;          
		temp := nil;
	 end;
	while (not done ) do
	 begin
		if(within(x,y,temp^.bounds)) then
		 done := true
	  	else if (temp <> head) then                
		 temp := temp^.prev
		else
		 begin
			temp := nil;
    			done := true;
		 end;
	 end;
	           
	find_prev := temp;                                                

end;

(*********  remove from linked list **********)
(*
 * part: pointer to object to remove from object list pointed to by 'head'
 * 		and 'tail'
 *)

procedure cut(part:ptr);                         
var
	temp : ptr;
begin
	if (part <> nil) then			(* got something to cut *)
	if (part <> head) then			
	 if (part <> tail) then 		(* in the middle of list *)
	 begin
(*
 * Remove object from doubly linked list.    prev <=> part <=> next  is now
 *						prev <=> next
 *)
		part^.prev^.next := part^.next;
		part^.next^.prev := part^.prev;
		part^.prev := nil;
		part^.next := nil;

	 end
	else (* part = tail *)
	 begin
(*
 * move tail of doubly linked list up one object
 * part already points to correct object
 *)
		tail := tail^.prev;
		tail^.next := nil;
		part^.prev := nil;
		part^.next := nil;
	 end
	else (* part = head *)
	 begin
	if (head = tail) then
	 begin
	 	 head := nil;		(* list now is empty *)
		 tail := nil;
	 end
	else
	 begin				(* move head down one object *)
		 head := head^.next;
		 head^.prev := nil;
	 end;
(*
 * remove any links to list of workspace objects
 *)
	part^.prev := nil;
	part^.next := nil;
	 end;

end;


(*************   give new pointer and initialize it a bit ********)
procedure gimme(var part:ptr);

begin
	new(part);
	part^.next := nil;
	part^.sub := nil;
	part^.prev := nil;

	part^.draw := ' ';
	part^.l_style := l_style;
	part^.n_file := ' ';
	part^.note_file := ' ';
end;


    (*********  duplicate object tree and sub trees *******)
procedure copy_tree(from,to_obj:ptr);
     var 
             prev,next,subs,temp:ptr;
     begin
(*
 * copy data for this object
 *)
             to_obj^.bounds := from^.bounds;
             to_obj^.draw := from^.draw;
	     to_obj^.l_style := from^.l_style;
	     to_obj^.species := from^.species;
	     to_obj^.n_file := from^.n_file;
	     to_obj^.note_file := from^.note_file;
(*
 * copy any sub tree that exists
 *)
             temp:= from^.sub;
             if(temp <> nil) then
              begin
                             gimme(subs);
                             to_obj^.sub:=subs;
                     next:=temp;
                     while(next<> nil) do
                      begin
                             copy_tree(next,subs);
                             next:= next^.next;
                             prev:= subs;
                             if(next <> nil) then
                              begin
                                     gimme(subs);
                                     prev^.next := subs;
                                     subs^.prev := prev;
                              end;
                      end;
                     
              end
             else to_obj^.sub := nil;
     end;
  
(************ insert in linked list before 'at' ********)
procedure insert(var part: ptr; at:ptr);
var
	new_part : ptr;
begin

                   gimme(new_part);	(* new space so no weird pointer stuff *)
                   copy_tree(part,new_part); (* can't have two objects with *)
						(* the same sub-tree pointers *)
		  dispose(part);
                   part := new_part;

	if (at <> head) then
	 begin
		at^.prev^.next := part; (* redirect front half of list *)
		part^.prev := at^.prev; (* point back to list *)
		part^.next := at;	(* point to next object *)
		at^.prev := part;	(* point back to inserted object *)
	 end
	else (* part becomes new head *)
	begin
	 part^.next := head;
	 if (head <> nil) then (* establish back pointer *)
	  head^.prev := part
	 else	(* empty list *)
	  tail := part;

	 head := part;
	end; (* part becomes new head *)



end;


procedure draw(x,y:integer; part : ptr);
var
        temp,tnext : ptr;
        outbuf : str20;
        dx,dy:integer;
	dw,dh: integer;
	clip : boolean;
begin   
        if (part <> nil) then 
	begin 					(* have a part *)
		clip := true;
	        dx:=x+part^.bounds.x;	(* absolute coords *)
	        dy:=y+part^.bounds.y;	
		dw:= dx + part^.bounds.w; (* absolute coords *)
		dh:= dy + part^.bounds.h;
	if ((dx > 0) and (dy>0) and (dw>0) and (dh>0)) then
	 clip := false;
	if ((dx > MAX_X) and (dw>MAX_X) ) or ((dy>MAX_Y) and (dh>MAX_Y)) then
	 clip := true;

	if (not clip) then 
           begin (* not clipped out *)
                record_on := false;
	        temp := part^.sub;
	        if(temp = nil) then	(* not a grouped object *)
                begin (* real object here *)
	                regis_move(dx,dy);
			set_linestyle(part^.l_style);
	                squirt(part^.draw);	(* do the ReGis command *)
			set_linestyle(l_style);
                end (* real object here *)
 	        else 
		 begin (* sub-object *)
	                tnext := temp;
	                while (tnext <> nil) do 
	                  begin
	                        draw(dx,dy,tnext);
	                        tnext := tnext^.next;
	                  end; (* while *)
                end; (* sub-object *)
	   end; (* clip check *)
        end; (* have a part *)


end;

(*
 * Redraw in invisible ink
 *)

procedure undraw(x,y:integer; part : ptr);
var
	outbuf : str20;
begin
   	if (part <> nil) then begin
		record_on := false;
	    	writev(outbuf,'W(E)');
		squirt(outbuf);

                draw(x,y,part);
                writev(outbuf,'W(R)');
		squirt(outbuf);
	end;
end;
                     
(* stuff goes here *)

procedure undraw_box(box : grect);
var                               
	outbuf : str20;
	temp : boolean;
begin
	temp := record_on;
	record_on := false;
	regis_move(box.x,box.y);
	record_on := temp;

	writev(outbuf,'W(E)');
		squirt(outbuf);
	x_array[1] := box.w;
	y_array[1] := 0;
	x_array[2] := 0;
	y_array[2] := box.h;
	x_array[3] := -box.w;
	y_array[3] := 0;
	regis_poly(x_array,y_array,3,closed_spline);

		writev(outbuf,'W(R)');
		squirt(outbuf);

end;

procedure draw_box(box : grect);
var
	temp : boolean;
begin
	temp := record_on; 
	record_on := false;
	regis_move(box.x,box.y);
	record_on := temp;

	x_array[1] := box.w;
	y_array[1] := 0;
	x_array[2] := 0;
	y_array[2] := box.h;
	x_array[3] := -box.w;
	y_array[3] := 0;
	regis_poly(x_array,y_array,3,closed_spline);

end;

procedure draw_box_filled(box : grect);
var
	outbuf : str20;
	temp : boolean;
begin
	temp := record_on;
	record_on := false;
	regis_move(box.x,box.y);
	record_on := temp;

	squirt('F(');
	x_array[1] := box.w;
	y_array[1] := 0;
	x_array[2] := 0;
	y_array[2] := box.h;
	x_array[3] := -box.w;
	y_array[3] := 0;
	regis_poly(x_array,y_array,3,closed_spline);
	squirt(')');
                   
end;           


procedure brighten( part: ptr);
var x :integer;
begin

	x := 3;
	if (length(part^.n_file) = 0) then x := 2;
	if( index(part^.draw,'T(W(F') <>0) then
		part^.draw[7] := chr(48+x);

end;

procedure unbrighten( part: ptr);
var x :integer;
begin

	x := 3;
	if (length(part^.n_file) = 0) then x := 2;
	if( index(part^.draw,'T(W(F') <>0) then
		part^.draw[7] := chr(48+x);

end;

procedure light_menu(x:integer);
var ix,tx,y,iy : integer;
begin
if(x<10) and (x>-1) then  (* valid icon number *)
begin
	ix:= menu^.bounds.x+round((menu^.bounds.w-16)/2);
	y:= (menu^.bounds.h div 10);
	tx := round(( y -20 )/2);

	 draw_box_filled(menu_array[x]);
	iy:=menu^.bounds.y+ (x*y) + tx;
	 regis_move(ix,iy);            
	 regis_text(icon[x],2,2);
end;
end;        

procedure unlight_menu(x:integer);
var ix,tx,y,iy : integer;
begin

if(x<10) and (x>-1) then  (* valid icon number *)
begin
	ix:= menu^.bounds.x+round((menu^.bounds.w-16)/2);
	y:= (menu^.bounds.h div 10);
	tx := round(( y -20 )/2);
             
		squirt('W(E)');
	 draw_box_filled(menu_array[x]);
		squirt('W(R)');
	 draw_box(menu_array[x]);

	iy:=menu^.bounds.y+ (x*y) + tx;
	 regis_move(ix,iy);            
	 regis_text(icon[x],2,2);
end;
end;

procedure clear_plane(plane : integer);
var g1 : grect;
	outbuf :str20;
begin
	g1.x := 0;
	g1.y := 0;
	g1.w := 800;
	g1.h := 480;

	outbuf := 'W(F1)W(E)';
	outbuf[4] := chr(48+plane);
	squirt(outbuf);
        draw_box_filled(g1);
	squirt('W(F2)W(R)');

end;      

procedure draw_grid;
var ix,iy,i : integer;
	temp : integer;
begin
	squirt('W(F1)W(R)W(P1)');
	for i:= 0 to trunc(800/grid_size)  do 
	begin
	 temp := i*grid_size;
	 regis_line(temp,0,temp,480);
	 regis_line(0,temp,800,temp );

	end;

	squirt('W(F2)W(R)');

end;	(* of draw_grid *)

procedure draw_menu;
var x,ix,iy,y:integer;
 tx :integer;
begin
	draw_box(menu^.bounds);
                                        
	ix:= menu^.bounds.x+round((menu^.bounds.w-16)/2);
	y:= (menu^.bounds.h div 10);
	tx := round(( y -20 )/2);

	for x := 0 to 9 do begin
	 draw_box(menu_array[x]);
	iy:=menu^.bounds.y+ (x*y) + tx;
	 regis_move(ix,iy);            
	 regis_text(icon[x],2,2);
	end;    

	regis_move(ix-10,iy+y);
	if(grid_on) then regis_text('grid',1,2)
	 else 	regis_text('    ',1,2);

	regis_move(ix-10,iy+y+20);
	if(fill_on) then regis_text('fill',1,2)
	 else 	regis_text('    ',1,2);

	regis_move(ix-10,iy+y+40);
	if(arrow_on) then regis_text('arrows',1,2)
	 else 	regis_text('      ',1,2);


end;      

procedure undraw_menu;
var
	outbuf :str20;
begin                              
	outbuf := 'W(E)';
    	squirt(outbuf);
	draw_menu;

	outbuf := 'W(R)';
    	squirt(outbuf);
end;


procedure re_draw;
var
	part :ptr;
	outbuf :str20;
begin

	part := head;

	if (menu_draw) then 
	 draw_menu;

	while (part <> nil) do 
	 begin
		draw(0,0,part);
		part := part^.next;
	 end; (* while looping *)
end;

procedure re_draw_screen;
var       
	outbuf :str20;
begin
	if (using_pc) then
	 begin
		
		regis_reset;
		if (grid_draw) then
		 draw_grid;
	 end
	else
	 begin
		clear_plane(2);
		clear_plane(14);
	 end;

	regis_off;

	outbuf := '*1;1H';  (* erase screen ,home cursors *)
	outbuf[1] := chr(155);
	squirt(outbuf);

	regis_on;

	re_draw;
end;


procedure s_logo;
	
 begin
	x_array[1] := 0;
	y_array[1] := 0;
                               
	x_array[2] := 10;
	y_array[2] := -10;

	x_array[3] := 0;
	y_array[3] := -20;
	
	x_array[4] := -10;
	y_array[4] := -40;
	
	x_array[5] := 30;
	y_array[5] := -10;

	x_array[6] := 20;
	y_array[6] := -30;
                                             
	regis_vspline(x_array,y_array,6,open_spline);
            
end;
procedure h_and(x,y,dx,dy:integer);
begin

				REGIS_vector(DX,0);
				REGIS_dMOVE(0,round(DY/2 ));
				REGIS_dARC(0,round(dY/2), 180);
				REGIS_dMOVE(0,round(DY/2));
				REGIS_vector(-dX, 0);
				REGIS_vector(0, -dY);

end;
procedure v_and(ix,iy,dx,dy:integer);
begin
            REGIS_vector(0,-DX);
            REGIS_dMOVE(round(DY/2),0);
	            REGIS_dARC(round(dy/2),0,180);
            REGIS_dMOVE(round(Dy/2),0);
            REGIS_vector(0, dx);
            REGIS_vector(-dy,0);
           
end;
procedure h_or(x,y,dx,dy:integer);
begin

		regis_vector(trunc(dx/2),0);
		regis_darc(0,dy,60);

	        REGIS_dMOVE(-dx,trunc(DY/2));
		REGIS_dARC(trunc(dx/2),trunc(dY/2), 105);
		REGIS_dMOVE(trunc(dx/2),trunc(DY/2));

		regis_vector(trunc(dx/2),0);
		regis_darc(0,-dy,-60);


end;
procedure v_or(ix,iy,dx,dy:integer);
begin
		
		regis_vector(0,-trunc(dx/2));
		regis_darc(dy,0,60);

            REGIS_dMOVE(trunc(DY/2),dx);
	    REGIS_dARC(trunc(dy/2),-trunc(dx/2),105);
            REGIS_dMOVE(trunc(Dy/2),-trunc(dx/2));

		regis_vector(0,-trunc(dx/2));
		regis_darc(-dy,0,-60);

           
end;

procedure all_delete;
begin
	while (tail <> nil) do
	begin
	 temp := tail^.prev;
	dispose(tail);
	 tail := temp;
 	end;
	head := nil;
end;
procedure move_sub(part:ptr;dx,dy:integer); (* move all objects in tree *)
    var
            temp : ptr;
            done : boolean;
    begin
            temp := part^.sub;
    
            while(temp <> nil) do begin
                    temp^.bounds.x:= temp^.bounds.x-dx;
                    temp^.bounds.y:= temp^.bounds.y-dy;
                    temp := temp^.next;
            end; (* while next *)
    
    end;

procedure sub_insert(part,at:ptr);
var 
	new_part,temp : ptr;
begin       
            temp := at^.sub;

            if(temp = nil) then
             begin
                    at^.sub := part;
             end
            else
             begin (* objects present *)
			part^.next := temp;
			temp^.prev := part;
			at^.sub := part;
             end; (* objects present *)             
	
end;            
function rsect(r1,r2:grect):boolean;
var           
	x1,y1,x2,y2 :integer;
	temp :boolean;
begin

	x1 := r1.x;
	y1 := r1.y;
	temp := true;

	if (not within(x1,y1,r2) ) then
	begin
		x1 := r1.x+r1.w;
		if (not within(x1,y1,r2) ) then
		begin
			y1 := r1.y+r1.h;
			if (not within(x1,y1,r2) ) then
			begin
				x1 := r1.x;
				if (not within(x1,y1,r2) ) then
				begin
				 temp := false;			
				end;
			end;
		end;
	end;

	rsect := temp;
end;

function find_under(under:grect; except,at:ptr):ptr;
var 
	temp : ptr;
	done : boolean;
begin
	done := false;
	temp := at;
                
	while ((not done) and (temp <> nil)) do
	begin
		if (temp <> except) then	(* if not the top object *)
		begin
		 if (rsect(temp^.bounds,under) ) then  (* inside bound *)
			done := true
		 else 
			 if (rsect(under,temp^.bounds) ) then (* encompasses it*)
				done := true
	 		 else 
				temp := temp^.next;
		end
		else
		 temp := temp^.next;

	end; (* looking *)

	find_under := temp;
end; (* of find_under *)

procedure un_join(part:ptr);
var 
	x,y: integer;
	front,back,temp :ptr;
begin
	x:= part^.bounds.x;
	y := part^.bounds.y;

	move_sub(part,-x,-y);
	temp := part^.sub;
	if (temp <> nil) then
	begin
	 temp^.prev := part^.prev;
	 if (temp^.prev = nil) then	(* new head *)
	 begin
		head := temp;
	 end (* new head *)
	 else
		part^.prev^.next := temp;

	while (temp^.next <> nil) do
	 temp := temp^.next;

	temp^.next := part^.next;
	if (temp^.next = nil) then
	 begin
		tail := temp;
	 end
	else
		part^.next^.prev := temp;

	dispose(part);
	end; (* of temp <> nil *)
	

end;

function join(under:grect):ptr;
var
	top_object,temp,temp2 : ptr;
	tw,th,tx,ty : integer;
	mx,my : integer;
begin
	top_object := nil;
	temp2 := nil;

	temp := find_under(under,nil,head);
	if (temp <> nil) then
	temp2 := find_under(under,temp,temp^.next);

	if ((temp <> nil) and (temp2 <> nil)) then
	 begin
		(* make new top object as big as the one we found *)
	  gimme(top_object);
	  insert(top_object,head);

	  top_object^.bounds := temp^.bounds;

		(* if we have an object *)
         
	  while (temp <> nil) do
	  begin		(* put found object under top object *)
	      	temp2:= temp^.next;		
		cut(temp);
		
		tx := min(temp^.bounds.x,temp^.bounds.x+temp^.bounds.w);
		ty := min(temp^.bounds.y,temp^.bounds.y+temp^.bounds.h);
		tw := abs(temp^.bounds.w);
		th := abs(temp^.bounds.h);

		mx := max(tx+tw,top_object^.bounds.x +top_object^.bounds.w );
		my := max(ty+th,top_object^.bounds.y +top_object^.bounds.h  );

	  	top_object^.bounds.x := min(top_object^.bounds.x,tx);
	  	top_object^.bounds.y := min(top_object^.bounds.y,ty);
		top_object^.bounds.w := (mx-top_object^.bounds.x);
		top_object^.bounds.h := (my-top_object^.bounds.y);

		sub_insert(temp,top_object);

		temp := find_under(under,top_object,temp2);	(* find more objects *)

	  end;	(* of looking for more under here *)
	move_sub(top_object,top_object^.bounds.x,top_object^.bounds.y);
	join := top_object;

	 end (* nothing under here *)
	else join := nil;

end;

                                       
(* trim blanks from end of string *)
procedure trim(var line : string);
var
	i : integer;
begin
	i := index(line,' ');	(* trim trailing blanks *)
	if (i>0) then line := substr(line,1,i);

end;

(* trim blanks from end of string *)
procedure trim80(var line : str80);
var
	i,j : integer;
	temp : str80;
begin
	j := 1;
	temp := line;
	FOR i := 1 TO (LENGTH( line )) DO
	begin
		if line[i] <> ' ' then 
		begin 
			temp[j]  := line[i];
			j := j+1;
		end;
	end;

	for  j := j to (length(line) ) do
		temp[j] := ' ';

	line := temp;
end;

    
procedure read_sub( at_ptr:ptr);
var     done :boolean;
            line :string;
            temp,part : ptr;
begin
            done := false;
    
    while (not done) do
     begin
		readln(object_file,line); (* bounds of first sub-object *)
    
    if (line <> '') then 
    begin
            gimme(part);
            if(line[1]='[') then 
             begin (* start group *)                                      
		    line[1] := ' ';
		    if (line <> '') then	(* if it isn't blank, get it *)
		     begin
			part^.n_file := line;
			line := '';
		     end;

                    readln(object_file,line);
                    readv(line,part^.bounds.x,part^.bounds.y,
                            part^.bounds.w,part^.bounds.h);
                    read_sub(part);
		    part^.species := OBJ_JOINED;

                    readln(object_file,line); (* blank line terminator *)

             end (* of start group *)

            else if(line[1]=']') then (* end of this sub object *)
		  begin
		    line[1] := ' ';
		    readv(line,at_ptr^.note_file,ERROR:=CONTINUE);        
			trim80(at_ptr^.note_file);

		    if (STATUSV <> 0) then (* error *)
		    begin
			at_ptr^.note_file := '';
		    end; (* error reading note file *)
			
                    done:= true;
		  end
        
               else
                begin (* object on line *)

	 readv(line,part^.bounds.x,part^.bounds.y,part^.bounds.w,part^.bounds.h,
		part^.species,part^.note_file,ERROR:=CONTINUE);
	 trim80(part^.note_file);

(*+*)		
		 if ( index(part^.note_file,'.')=0) then part^.note_file := '';
	readln(object_file,part^.draw);

		if (STATUSV <> 0 ) then (* try to find out type *)
		begin
			part^.note_file := '';	(* no note file *)
			case (part^.draw[2] ) of
				'T'	: part^.species := OBJ_TEXT;
				'P'	: if (index(part^.draw,']C[') >0) then
						part^.species := OBJ_CIRCLE
					 else
					  if (index(part^.draw,'C(S)')>0) then
						part^.species := OBJ_SPLINE
					 else
					  if (index(part^.draw,']C(A')>0) then
						part^.species := OBJ_ARC;
					  
				'F'	: case (part^.draw[4] ) of
					'P' : part^.species := OBJ_CIRCLE;
					'V' : part^.species := OBJ_BOX;
					  end; (* filled case *)
				'V'	: if (part^.draw[4] = 'B') then
						part^.species := OBJ_BOX
					  else 
					if (index(part^.draw,']C(A')>0)
					   then part^.species := OBJ_GATE
						else part^.species := OBJ_LINE;

				OTHERWISE 
					part^.species := OBJ_UNKNOWN;
			end; (* case *)       
		end; (* of old format *)

		 readln(object_file,line); (* line style *)
		 if(index(line,'style')>0)  then (* mdraw 1.0 format *)
	     	  begin
			 line := substr(line,8,line.length-7);
			 readv(line,part^.l_style);
	  		 readln(object_file,part^.n_file);

		   end; (* mdraw 1.0 format *)


                end; (* object on line *)

    end   (* of if not blank line *)
    else (* blank line *)
             begin
		sub_insert(part,at_ptr);
             end;    (* end blank line *)
    
    
    end; (*  do while *)
                                                      
                 
    end;

procedure get_file(load_file : string;load_choice : char);
var
	x,y,w,h : integer;
	i:integer;
	line,draw : string;         
	dummy : str80;
	at_ptr,part	: ptr;
	sub_found,done : boolean;                       
begin   
   	done := false;
	sub_found := false;
	open(object_file,load_file,HISTORY := OLD,ERROR := CONTINUE);
                 
	if (status(object_file) >0 ) then
	begin
		regis_off;
		writeln('File ',load_file:10,' not found!');
		regis_on;
	end
          
	else (* file found *)
	begin
                        
	if(load_choice = 'l') then all_delete;
	reset(object_file);
                           
                      
	at_ptr := head;
	gimme(part);       

        readln(object_file,line);	(* zoom_file & note file *)
	i := index(line,'-');

	if (i > 0) then
	begin
		zoom_file := substr(line,1,i-1);
		note_file := substr(line,i+1,length(line)-i);

		trim80(zoom_file);
		trim80(note_file);

      	end                 
	else	(* old format *)
	begin
		zoom_file := line;
		note_file := '';
	end;    

        readln(object_file,line);	(* first object *)
	          
	while (not EOF(object_file) ) do
	begin

	if (line <> '') then 
	begin       
           if(line[1]='[') then 
            begin (* start group *)
		  line[1] := ' ';
		  if (line <> ' ') then  (* if it isn't blank, get it *)
		     begin
			trim(line);
			part^.n_file := line;
		     end;

                   readln(object_file,line);
                   readv(line,part^.bounds.x,part^.bounds.y,part^.bounds.w,part^.bounds.h);
                   read_sub(part);

                   readln(object_file,line); (* blank line object terminator *)
                 
		   part^.species := OBJ_JOINED;

		   sub_found := true;
   
            end (* of start group *)
           else 
		if(line[1] = ']') then 
                   begin (* end group *)
		   line[1] := ' ';
		    readv(line,part^.note_file,ERROR:=CONTINUE);
			trim80(part^.note_file);
          
		    if (STATUSV <> 0) then (* error *)
		    begin
			part^.note_file := '';
		    end; (* error reading note file *)

                   readln(object_file,line); 

                   end (* of end group *)

           else (* normal object *)
		begin
		readv(line,part^.bounds.x,part^.bounds.y,part^.bounds.w,part^.bounds.h,
			part^.species,part^.note_file,ERROR:=CONTINUE);
(*+*)
		if ( index(part^.note_file,'.')=0) then part^.note_file := '';
		trim80(part^.note_file);

		readln(object_file,part^.draw);
		if (length(part^.draw) <2) then
		 part^.draw := '    '
		else
		if (STATUSV <> 0 ) then (* try to find out type *)
	  	begin
			part^.note_file	:= '';	(* no note file *)
			case (part^.draw[2] ) of
				'T'	: part^.species := OBJ_TEXT;
				'P'	: if (index(part^.draw,']C[') >0) then
						part^.species := OBJ_CIRCLE
					 else
					  if (index(part^.draw,'C(S)')>0) then
						part^.species := OBJ_SPLINE
					 else
					  if (index(part^.draw,']C(A')>0) then
						part^.species := OBJ_ARC;
					  
				'F'	: case (part^.draw[4] ) of
					'P' : part^.species := OBJ_CIRCLE;
					'V' : part^.species := OBJ_BOX;
		 			  end; (* filled case *)
				'V'	: if (part^.draw[4] = 'B') then
						part^.species := OBJ_BOX
					  else 
					if (index(part^.draw,']C(A')>0)
					   then part^.species := OBJ_GATE
						else part^.species := OBJ_LINE;

				OTHERWISE 
					part^.species := OBJ_UNKNOWN;
			end; (* case *)       
		end; (* of old format *)

		 readln(object_file,line);  (* line style *)
		 if(index(line,'style')>0)  then
	     	  begin
		       	 line := substr(line,8,line.length-7);
			 readv(line,part^.l_style);
			 readln(object_file,part^.n_file);
			 trim80(part^.n_file);
			readln(object_file,line);
	 	  end;                                                  
		end;
	end
	else (* blank line *)
		begin
		if (not sub_found) then
		begin
		 insert(part,head);
		 gimme(part);
		end
		else sub_found := false;

		 readln(object_file,line); (* blank line seperator *)
		end;

	end; (*  do while *)

	 insert(part,head);

	close(object_file);
	loaded_file := load_file;

	end; (* of file found *)

end;

procedure load(load_choice : char);
var	
	x,y,w,h : integer;
	line,draw : string;         
	path,load_file : string;
	dummy : str20;
	at_ptr,part,temp	: ptr;
	done : boolean;
begin
	path := '';
	at_ptr := head;
	done := false;
	regis_off;
	
	write('Load file:');
	readln(load_file);
                                           
	while (index(load_file,'*')>0)  or (index(load_file,'?')>0)  do 
	begin
		x := index(load_file,']');
		if (x <> 0) then 
		begin		(* getting path and name *)
	 	path:=substr(load_file,1,x);
	      	 load_file:=substr(load_file,x+1,length(load_file)-x);

		end;
		            
		x := index(load_file,'.');
	     	if (x <> 0) then                  
		 save_ext:=substr(load_file,x,length(load_file)-x+1);
                           
		dummy_b := spawn_command_line('dir '+path+'*'+save_ext);
		write('name of load file?');
		readln(load_file);
				            
	 end; (* end while *)

		x := index(load_file,']');
		if (x <> 0) then 
		begin		(* getting path and name *)
	 	path:=substr(load_file,1,x);
		 load_file:=substr(load_file,x+1,length(load_file)-x);

		end;

	x := index(load_file,'.');	(* probably valid if it has a "." *)
	if (x <> 0) then                                            
	 save_ext:=substr(load_file,x,length(load_file)-x+1)
	else
	 load_file := path+load_file+save_ext;
	
        
	if(load_file <> save_ext) then  (* didnt hit return *)
	begin       
		get_file(load_file,load_choice);
	end; (* hit return just exit *)
	regis_on;
end;      
                               


procedure sub_save(obj:ptr);
var part:ptr;
begin
        part:=obj^.sub;
	while(part^.next <> nil) do part := part^.next;

        repeat                                                  
         begin (* repeating *)
                if(part^.sub <> nil) then
                 begin  (* sub tree *)
	                writeln(object_file,'[',part^.n_file);
	                writeln(object_file,part^.bounds.x:5,part^.bounds.y:5,
                                part^.bounds.w:5,part^.bounds.h:5);
 	                sub_save(part);
	                write(object_file,']');
	                writeln(object_file,part^.note_file);	(* note file *)
			writeln(object_file);	(* blank terminator *)
	                writeln(object_file);   
                 end (* of sub-subtree *)
                else
                 begin (* normal object *)

			if (length(part^.draw) >1) then (* good object *)
			begin
	 	      write(object_file,part^.bounds.x:5,part^.bounds.y:5,
                                part^.bounds.w:5,part^.bounds.h:5);
			writeln(object_file,part^.species,' ',part^.note_file);
		  	writeln(object_file,part^.draw);
			writeln(object_file,' style= ',part^.l_style:3);
			writeln(object_file,part^.n_file);

	  	       writeln(object_file);
			end; (* real draw command *)
                 end;
	        part := part^.prev;
         end; (* repeating *)
        until (part= nil);
                                                             
end;

procedure save_file(filename:string);
var
	part : ptr;
begin

	open(object_file,filename,HISTORY := NEW);
	rewrite(object_file);


	writeln(object_file,zoom_file,' - ',note_file);
	part := tail;
(* write objects to file *)
	if (part = nil) then writeln(object_file);

	while(part <> nil) do
	begin
          if(part^.sub <> nil) then 
           begin (* sub tree *)
                  writeln(object_file,'[',part^.n_file);
                   writeln(object_file,part^.bounds.x:5,part^.bounds.y:5,
                                  part^.bounds.w:5,part^.bounds.h:5);
                    sub_save(part);
                  write(object_file,']');
	                writeln(object_file,part^.note_file);	(* note file *)
                  writeln(object_file); (* blank terminator *)
                  writeln(object_file);
           end   (* sub tree *)
          else
           begin (* normal object *)
		if ( length(part^.draw) >1) then (* good object *)
		begin
			write(object_file,part^.bounds.x:5,part^.bounds.y:5,
				part^.bounds.w:5,part^.bounds.h:5);
(*+*)			writeln(object_file,part^.species,' ',part^.note_file);
			writeln(object_file,part^.draw);
			writeln(object_file,' style= ',part^.l_style:2);
			writeln(object_file,part^.n_file);
			writeln(object_file);
		end; (* good object *)

	end; (* normal object *)

	part := part^.prev;	(* get the next object *)
                                          
	end;

	close(object_file);


end;

procedure save;
var
	x : integer;
	path,filename: string;
	part : ptr;
	dummy : boolean;
begin
	regis_off;
	path:= '';
	write('Save to: [',loaded_file,']');
	readln(filename);                             
	if(length(filename) = 0) then filename := loaded_file;

	while(index(filename,'*')>0 ) or (index(filename,'?')>0)   do
	 begin
(*
 * Find the path 
 *)      

		x := index(filename,']');
		if (x <> 0) then 
		begin		(* getting path and name *)
	 	path:=substr(filename,1,x);
		 filename:=substr(filename,x+1,length(filename)-x);

		end;

		x := index(filename,'.');   
		if (x <> 0) then 
		 save_ext:=substr(filename,x,length(filename)-x+1);
	                        
		dummy:=spawn_command_line('dir '+path+'*'+save_ext);
		write('name of file? ');
		readln(filename);

	 end; (* end while *)

(*
 * Find the path 
 *)
                  
		x := index(filename,']');
		if (x <> 0) then 
		begin		(* getting path and name *)
	 	path:=substr(filename,1,x);
		 filename:=substr(filename,x+1,length(filename)-x);

		end;
(*
 * Check for new file extender
 *)
	x := index(filename,'.');
	if (x <> 0) then 
	 save_ext:=substr(filename,x,length(filename)-x+1)
	else
	 filename := path + filename + save_ext;

	if(filename <> save_ext) then
	begin
	 save_file(filename);
	loaded_file := filename;

	
	end; (* hit return just exit *)
	regis_on;
end;

(******** blow up a bubble, saving this file, and initializing the
	next if it doesn't exist ****)
procedure blow_up(part,temp: ptr);
begin                   

	if (part^.n_file <> '') then
	begin
		get_file(part^.n_file,'l');
		re_draw_screen;
				 
		part := nil;
	end (* associated already *)
	else
	begin
		brighten(part);
		part := temp; (* get original part *)
		regis_off;
		write('File name for next file: ');
		readln(part^.n_file); 
		if (index(part^.n_file,'.') = 0 ) then
		 part^.n_file := part^.n_file+save_ext;
		writeln;
	  	regis_on;

		(* save file *)

	  	if (loaded_file = '') then
		begin
		       regis_off;
		       write('File name for this picture? ');
		       readln(loaded_file); 
			if (index(loaded_file,'.') = 0 ) then
			 loaded_file := loaded_file+save_ext;
		       writeln;
		       regis_on;

		end;
		save_file(loaded_file);

		(* get new file *)

		all_delete;
		re_draw_screen;
		zoom_file := loaded_file;
		loaded_file := part^.n_file;
		note_file := '';
		part:=nil;

		(* save THIS new file *)

		save_file(loaded_file);


	end; (* empty part *)

end;


procedure move_all(dx,dy : integer);
var
	p : ptr;                        
begin
	p := head;
	while (p <> nil) do
	begin
		p^.bounds.x := p^.bounds.x + dx;
		p^.bounds.y := p^.bounds.y + dy;
		p := p^.next;
	end;

end;

(*********   ***********)
procedure help_screen;
begin
	regis_reset;
	regis_off;                                 

	writeln('Any key exits.....');
	writeln;
	writeln('  OBJECTS....');
	writeln('0: circle	4: rectangle	s: spline');
	writeln('1: line         a: arc		t: text');
	writeln;
	writeln(' FOR SELECTED OBJECTS....');
	writeln('c: cut		p: paste	d: duplicate');
	writeln('m: move         u: undo  	U: undo undo');
	writeln('_: linestyle	v: flip up/down	h: flip left/right');
	writeln('A: associate	n: edit note	x: explode object');
	writeln;

	writeln(' FOR WORKSPACE....');
	writeln('X: delete all	C: recenter	');
	writeln('L: load file	S: save file	M: merge file');
	writeln('G: grid size	T: text size	_: linestyle');
	writeln('g: grid on	F: fill on	k: arrowheads');
	writeln('F20: menu 	@: new menu 	l: grid lines');
	writeln('z: zoom up	N: attach note	');
	writeln;

writeln('FIND OBJECT...			DEC MOUSE...		PC MOUSE...');
writeln('f,<find>,<select>		left: move object	left: select object');
writeln('[: next object			middle: select object	right: move object');
writeln(']: prev object			right: do again');

	regis_on;

end;


procedure columns(ix,iy: integer;line : menu_lines; times,size:integer); 
var
	i : integer;
begin
	regis_move(ix*9*size,iy*15*size);
    	for i:=1 to times do
	begin
	regis_move(ix*9*size,15*size*(iy+(i-1)));
	 regis_text(line[i],size,2);
	end;

end;



procedure help_menu;
var
	cs,ch,co,cw,ts :integer;
 	menu_line : menu_lines;
begin
	ts := 1;		(* text size *)
	co := 1;     (* col offset *)
	cw := 21;   (* col width *)
	ch := 4;    (* lines per column *)
	cs := 2; (* spacing within column *)

	menu_line[1] := 'Any key exits...';
	columns(1,0,menu_line,1,ts);

	menu_line[1] := 'To Select Object ';
	menu_line[2] := ']: under current';
	menu_line[3] := '[: above current';
	columns(co,cs,menu_line,3,ts);

	menu_line[1] := 'c: cut';     
	menu_line[2] := 'p: paste';
	menu_line[3] := 'm: move';
	columns(co + cw,cs,menu_line,3,ts);

	menu_line[1] := 'S: Save';
	menu_line[2] := 'L: Load  (* = dir)'; 
	menu_line[3] := 'M: Merge';
	columns(co,ch+cs,menu_line,3,ts);

	menu_line[1] := '0: circle';
	menu_line[2] := '1: line';
	menu_line[3] := '4: box';
	menu_line[4] := 's: spline (4 points)';
 	columns(co + cw,ch+cs,menu_line,4,ts);

	menu_line[1] := 'r: redraw';     
	menu_line[2] := 'g: Grid on/off';
	menu_line[3] := 'F: Fill on/off';
 	menu_line[4] := 'Q: Quit';
 	columns(co ,ch*2+cs,menu_line,4,ts);

	menu_line[1] := 'T: Text size';
	menu_line[2] := 'G: Grid Size';
	menu_line[3] := 'X: delete all';
	menu_line[4] := '_: line style';      
 	columns(co + cw,ch*2+cs+1,menu_line,4,ts);
end;

function menu_chosen(ix,iy:integer):integer;
begin
	menu_chosen :=((iy-menu^.bounds.y)div(menu^.bounds.h div 10)) ;
end;

procedure let_go(var part:ptr);
begin
	  if(part <> nil) then
		begin
		 undraw_box(part^.bounds);
		 draw(0,0,part);		 
		 part:= nil;
		end;
end;

procedure draw_title;

begin

	regis_move(225,355);
	squirt('F(V(B)[+350,+0][+0,+10][-350,+0](E))');
	regis_move(225,125);
	squirt('F(V(B)[+350,+0][+0,+10][-350,+0](E))');
	regis_move(575,125);
	squirt('F(V(B)[+10,+0][+0,+240][-10,+0](E))');
 	regis_move(215,125);
	squirt('F(V(B)[+10,+0][+0,+240][-10,+0](E))');


	regis_move(335,155);
	regis_text('mdraw',3,2);
	regis_move(295,225);
	regis_text('Object Oriented Drawing',1,2);
	regis_move(355,285);
	regis_text('Written by:',1,2);
	regis_move(315,305);
	regis_text('S. Michael Dierken',1,2);

	regis_move(305,245);
	regis_text('For the masses',1,2);
	regis_text(' V2.5',1,2);

end;

{main}
begin                               
	save_ext := '.mdr';
	control_hit := false;
	control_hit := false;
	fill_on	:= false;
	arrow_on := false;
	l_style := 1; (* linestyle *)

	icon[0] := '0';
	icon[1] := '1';
	icon[2] := '4';
	icon[3] := 's';
        icon[4] := 't';
        icon[5] := 'c';         
        icon[6] := 'p';  
        icon[7] := 'd';  
        icon[8] := 'j';  
        icon[9] := 'Q'; 	
 
	gimme(menu);
	menu^.l_style := 1;
 	menu^.bounds.x:=730;
 	menu^.bounds.y:=10;
 	menu^.bounds.w:=60;
 	menu^.bounds.h:=400;

	for i:= 0 to 9 do begin
	 menu_array[i].x:=menu^.bounds.x;
	 menu_array[i].w:=menu^.bounds.w;
	 menu_array[i].h:= (menu^.bounds.h div 10);
	 menu_array[i].y:=menu^.bounds.y+(i*menu_array[i].h);
	end;

	part := nil;
	cut_part := nil;
	paste_part := nil;
 	head := nil;
	tail := head;
	text_size := 1;
	rec_num := 0;                              
 	record_on := false;
	zoom_file := ' ';
	note_file := '';
	loaded_file := ' ';
                       
(*********************************************)
 	regis_init(false,false,'TT:');
	regis_on;
	regis_reset;

	ix:=100;
	iy:=100;
	input_cursor:=2;
	grid_on := false;
	grid_draw := false;
	grid_size := 10;
	done := false;
 	key := ' ';

	writeln(chr(27),' G');
	regis_reset;
 	regis_on;
        
(** get command line file, if any **)
   Get_CLI_Command_Line(Command);
   Cmd_OK:= Parse_Command_Line(Command);            

   if (length(filename) <> 0) then
	begin
		if (index(filename,'.') = 0) then
		  get_file(filename+save_ext,'l')
		else
		  get_file(filename,'l');	(* load file *)
		  re_draw_screen;
	end
   else
	begin
		(*******	put up title screen 	v2.0 ****)
		regis_reset;
		draw_title;
		regis_move(0,0);
		regis_gin(ix,iy,key,input_cursor);	(** wait for button *)
	 	
		regis_reset;
	end;

 
(****	main loop here ***)

 	while (not done) do
	 begin
	if( menu_draw) then
	begin
	unlight_menu(last_item);	(* done with command, so unlight menu *)
	end;

	regis_move(ix,iy);		(* move to where user expects cursor *)

if (do_again) then			(* repeat last menu command *)
begin
	key := last_key;
	do_again := false;

	if(menu_draw) then	light_menu(again_item);
	last_item:= again_item;
end
else
begin  (*** not do-again  ***)
 regis_gin(ix,iy,key,input_cursor); (* get input from cursor *)

(****** menu item chosen *****)
 if(mouse_hit and menu_draw and within(ix,iy,menu^.bounds))then
	begin
	 last_item := menu_chosen(ix,iy);
	 again_item := last_item;
	 light_menu(last_item);
 	 key:= icon[last_item][1];
	 regis_move(ix,iy);

	 case key of 
	  'd','j','0','1','4','t','s','8','7','p' :	begin
						temp_draw := menu_draw;
						menu_draw := false;
						regis_gin(ix,iy,key2,input_cursor); (* get input from cursor *)
						menu_draw := temp_draw;
						end;
	 end; (* case *)

	if (key = 'Q') then 
		begin
		 regis_off;
		 write('Really Quit?');
		 readln(key2);
		 if (key2<>'y') and (key2 <>'Y') then key:=' ';
		 regis_on;
		end;
	last_key := key;
	end (* of menu hit *)

	else last_item := -1;	(* menu not hit, don't unlight it *)

end; (* of not do-again *)

	if(not control_hit) then
	case key of      

		'0'	: begin		(**** circle ****)
				let_go(part);
	     			record_on := false;
				regis_move(ix,iy);

				temp_draw := menu_draw;
				menu_draw := false;
				regis_gin(dx,dy,key,3);	(** get radius point *)
				menu_draw := temp_draw;

				gimme(part);		(** new object **)
				tx := dx - ix;
				ty := dy - iy;
				ic := round(sqrt( (tx*tx) + (ty*ty) )); (* radius *)

				part^.l_style := l_style; (** set attributes **)
				part^.bounds.x := ix-ic;
				part^.bounds.w := ic+ic;
				part^.bounds.y := iy-ic;
				part^.bounds.h := ic+ic;
				part^.species := OBJ_CIRCLE;
                                
	if(ic > ix) then 		(** deal with hitting edge of screen **)
	begin
		part^.bounds.x := ix+ic;
		part^.bounds.w := -(ic+ic);
	end;
	if(ic > iy) then 
	begin
		part^.bounds.y := iy+ic;
		part^.bounds.h := -(ic+ic);
	end;
	
				regis_move(part^.bounds.x,part^.bounds.y);

				record_buf[rec_num] := ' ';

				record_on := true;

				if (fill_on) then squirt('F(');
				regis_dmove(round(part^.bounds.w/2),round(part^.bounds.h/2));
				regis_dcircle(dx-ix,dy-iy);
				if (fill_on) then squirt(')');
                
				record_on := false;

		    		part^.draw := record_buf[rec_num];
				insert(part,head);  
				rec_num := (rec_num+1)mod 10;
				
		set_linestyle(4);		(** outline as selected **)
		draw_box(part^.bounds);
		ix:= part^.bounds.x;
		iy:= part^.bounds.y;
		set_linestyle(l_style);
			  end;

		'a'	: begin		(**** arc ****)
				let_go(part);
	     			record_on := false;
				regis_move(ix,iy);

				temp_draw := menu_draw;
				menu_draw := false;
				regis_gin(dx,dy,key,3);	(** get radius point *)
				menu_draw := temp_draw;

				tx := dx - ix;
				ty := dy - iy;

				if (tx = 0)
				then if (ty <0) then angle := 270
						else angle := 90
				else                            
				angle := round((180.0/3.141592 )*arctan(ty/tx));

				if ( tx <0 ) then angle := angle+180;
				if (angle < 0) then angle := angle+360;

				rad1 :=round(sqrt( (tx*tx) + (ty*ty) )); (* radius *) 


				gimme(part);		(** new object **)
				part^.l_style := l_style; (** set attributes **)
				part^.bounds.x := ix-rad1;
				part^.bounds.w := rad1+rad1;
				part^.bounds.y := iy-rad1;
				part^.bounds.h := rad1+rad1;
                                
	if(rad1 > ix) then 		(** deal with hitting edge of screen **)
	begin
		part^.bounds.x := ix+rad1;
		part^.bounds.w := -(rad1+rad1);
	end;
	if(rad1 > iy) then 
	begin
		part^.bounds.y := iy+rad1;
		part^.bounds.h := -(rad1+rad1);
	end;
	
				regis_move(part^.bounds.x,part^.bounds.y);
				regis_dmove(round(part^.bounds.w/2),round(part^.bounds.h/2));
		set_linestyle(4);		(** outline as selected **)
				regis_dcircle(tx,ty);
		set_linestyle(l_style);		(** outline as selected **)
                
				temp_draw := menu_draw;
				menu_draw := false;

				repeat
				regis_gin(cx,cy,key,3);	(** get radius point *)
				until (( cx <> ix) or (cy <> iy));

				menu_draw := temp_draw;
				(* undraw circle *)
				regis_move(part^.bounds.x,part^.bounds.y);
				regis_dmove(round(part^.bounds.w/2),round(part^.bounds.h/2));
		set_linestyle(0);		(** outline as selected **)
				regis_dcircle(dx-ix,dy-iy);
		set_linestyle(l_style);		(** outline as selected **)


				tx := cx - ix;
				ty := cy - iy;
				rad2 :=round(sqrt( (tx*tx) + (ty*ty) )); (* radius *) 

				if (tx = 0)
				then if (ty <0) then angle2 := 270
						else angle2 := 90
				else
				angle2 := round((180.0/3.141592 )*arctan(ty/tx));

				if ( tx <0 ) then angle2 := angle2+180;
				if (angle2 < 0) then angle2 := angle2+360;

				angle := 360-(angle-angle2);
				if (angle >360) then angle := angle-360;

				record_buf[rec_num] := ' ';

				regis_move(part^.bounds.x,part^.bounds.y);

				record_on := true;
				regis_dmove(round(part^.bounds.w/2),round(part^.bounds.h/2));
				regis_darc(dx-ix,dy-iy,-angle);
                
				record_on := false;

		    		part^.draw := record_buf[rec_num];
				insert(part,head);  
				rec_num := (rec_num+1)mod 10;
				
		set_linestyle(4);		(** outline as selected **)
		draw_box(part^.bounds);
		ix:= part^.bounds.x;
		iy:= part^.bounds.y;
		set_linestyle(l_style);
			  end;


		'1'	: begin		(**** line ****)
				let_go(part);

				regis_move(ix,iy);
				temp_draw := menu_draw;
				menu_draw := false;
 				regis_gin(dx,dy,key,3);
				menu_draw := temp_draw;
				
				record_buf[rec_num] := ' ';
				gimme(part);

				part^.l_style := l_style;
				part^.bounds.x := ix;
				part^.bounds.y := iy;
				part^.bounds.w := (dx-ix);
				part^.bounds.h := (dy-iy);
				part^.species := OBJ_LINE;

				regis_move(part^.bounds.x,part^.bounds.y);
				record_on := true;
				regis_vector(part^.bounds.w,part^.bounds.h); 
		part^.draw := record_buf[rec_num];
				record_on := false;
				rec_num := (rec_num+1)mod 10;

		insert(part,head);

		set_linestyle(4);
		draw_box(part^.bounds);
		set_linestyle(l_style);
		ix := dx;
		iy := dy;
			  end;  
		'4','÷'	: begin		(**** box ****)
				let_go(part);
				regis_move(ix,iy);
				temp_draw := menu_draw;
				menu_draw := false;
				regis_gin(dx,dy,key,4);                  
				menu_draw := temp_draw;
				gimme(part);

		part^.l_style := l_style;
		part^.bounds.x := ix;                           
		part^.bounds.y := iy;
		part^.bounds.w := (dx-ix);
		part^.bounds.h := (dy-iy);
		part^.species := OBJ_BOX;


			    record_buf[rec_num] := ' ';
				record_on := true;     
				if (fill_on) then draw_box_filled(part^.bounds)
				else draw_box(part^.bounds);
				record_on := false;

				part^.draw := record_buf[rec_num];
				insert(part,head);

				rec_num := (rec_num+1)mod 10;

		set_linestyle(4);
		draw_box(part^.bounds);
		ix:= part^.bounds.x;
		iy:= part^.bounds.y;
		set_linestyle(l_style);
			  end;

		'7'	: begin		(**** and gate ****)

			let_go(part);
			gimme(part);
			
				temp_draw := menu_draw;
				menu_draw := false;
			regis_move(ix,iy);
			regis_gin(dx,dy,key,input_cursor);
				menu_draw := temp_draw;
				part^.l_style := l_style;
		part^.bounds.x := ix;
		part^.bounds.y := iy;
		part^.species := OBJ_GATE;
			
			regis_move(part^.bounds.x,part^.bounds.y);

				record_buf[rec_num] := ' ';
				record_on := true;

			dx := 30;
			dy := 40;
			if(key = '4' ) or(key = '2') then
			 begin
				dx := -dx;
				dy := -dy;
			 end;
			if (key = '4' ) or(key = '6') then
				begin
				h_and(ix,iy,dx,dy);
				part^.bounds.w := round(dx+dy/2);
				part^.bounds.h := dy;
				end;
			if (key = '2') or(key = '8') then
				begin
				part^.bounds.w := dy;
				part^.bounds.h := -round(dx+dy/2);
				v_and(ix,iy,dx,dy);
         			end;                          

				record_on := false;
				insert(part,head);
				part^.draw := record_buf[rec_num];
				rec_num := (rec_num+1)mod 10;
		set_linestyle(4);
		draw_box(part^.bounds);
		ix:= part^.bounds.x;
		iy:= part^.bounds.y;
		set_linestyle(l_style);
			  end;
		'8'	: begin		(**** or gate ****)
			let_go(part);
			gimme(part);
			
				temp_draw := menu_draw;
				menu_draw := false;
			regis_move(ix,iy);
			regis_gin(dx,dy,key,input_cursor);
				menu_draw := temp_draw;
				part^.l_style := l_style;
		part^.bounds.x := ix;
		part^.bounds.y := iy;
		part^.species := OBJ_GATE;
			
			regis_move(part^.bounds.x,part^.bounds.y);

				record_buf[rec_num] := ' ';
				record_on := true;
                  
			dx := 30;
			dy := 40;
			if(key = '4' ) or(key = '2') then
			 begin
				dx := -dx;
				dy := -dy;
			 end;
			if (key = '4' ) or(key = '6') then
				begin
				h_or(ix,iy,dx,dy);
				part^.bounds.w := round(dx+dy/2);
				part^.bounds.h := dy;
				end;
			if (key = '2') or(key = '8') then
				begin
				part^.bounds.w := dy;
				part^.bounds.h := -round(dx+dy/2);
				v_or(ix,iy,dx,dy);
         			end;                          

				record_on := false;
				insert(part,head);
				part^.draw := record_buf[rec_num];
				rec_num := (rec_num+1)mod 10;
		set_linestyle(4);
		draw_box(part^.bounds);
		ix:= part^.bounds.x;
		iy:= part^.bounds.y;
		set_linestyle(l_style);
			  end;

		'c'	: begin			(**** cut object ****)
				if (part <> nil) then 
				begin
				 cut(part);
				 undraw(0,0,part);
				 undraw_box(part^.bounds);
				 paste_part :=part;
				part := nil;
				end;
			  end;

		'p'	: begin			(**** paste object ****)
				if (paste_part <> nil )then 
				begin
					gimme(temp);
					copy_tree(paste_part,temp);
					temp^.bounds.x := ix;
					temp^.bounds.y := iy;
					draw(0,0,temp);
				   	insert(temp,head);
					ix:= temp^.bounds.x;
					iy:= temp^.bounds.y;
				end;
			 end;
		'd'	: begin			(**** duplicate object ****)
				if (part <> nil) then 
				begin
                   gimme(paste_part);	(* new space so no weird pointer stuff *)
                   copy_tree(part,paste_part); (* can't have two objects with *)

					gimme(temp);
					copy_tree(paste_part,temp);
					temp^.bounds.x := ix;
					temp^.bounds.y := iy;
					draw(0,0,temp);
				   	insert(temp,head);
					ix:= temp^.bounds.x;
					iy:= temp^.bounds.y;
			 end;
			 end; (* of clone *)
		'f','ó'	: begin   (*  button #2 down *)
                     
		 regis_move(ix,iy);
		if(part <> nil) then
		begin
		 undraw_box(part^.bounds);
		 draw(0,0,part);		 
		 temp := part;
		 part := find_next(ix,iy,part^.next);
		 if (part = nil) then part:=find_next(ix,iy,head);
		  if (part = temp) then part := nil;
		end

		else part := find_next(ix,iy,head);

		if (part <> nil) then 
	    begin 		(* if something there *)
				set_linestyle(4); (* redraw as dotted *)
				draw_box(part^.bounds);
				set_linestyle(l_style);
		end; (* of something there *)
		end;
                
		'[' 	: begin (* find previous *)
		if(part <> nil) then
		begin
		 undraw_box(part^.bounds);
		 draw(0,0,part);		 
		 part := find_prev(ix,iy,part^.prev);
			regis_move(ix,iy);
		end
		else part := find_prev(ix,iy,tail);

		if (part <> nil) then
		begin
		 set_linestyle(4);
		 draw_box(part^.bounds);
		 set_linestyle(l_style);
		end;
	end;
		']' 	: begin (* find next *)
		if(part <> nil) then               
		begin
		 undraw_box(part^.bounds);
		 draw(0,0,part);		 
		 part := find_next(ix,iy,part^.next);
			regis_move(ix,iy);
		end
		else part := find_next(ix,iy,head);

		if (part <> nil) then
		begin
		 set_linestyle(4);
		 draw_box(part^.bounds);
		 set_linestyle(l_style);
		end;
		end;
                
		'm','ñ'		: begin (* button #1 up or down *)
				if (part <> nil )then 
				begin
					undraw_box(part^.bounds);
					undraw(0,0,part);
					part^.bounds.x := ix;
					part^.bounds.y := iy;
					draw(0,0,part);
					regis_move(ix,iy);

					set_linestyle(4);
					draw_box(part^.bounds);
					set_linestyle(l_style);
				end;

			  end;
                                         
		'r'	: begin		(**** redraw workspace ****)
				re_draw_screen;
				if(part <> nil) then
				begin
				 set_linestyle(4);
				 draw_box(part^.bounds);
				 set_linestyle(l_style);
				end;
  			  end;
		'R'	: begin		(**** redraw grid ****)
				if (grid_draw ) then draw_grid;
  			  end;
		'M'	: begin		(**** merge files ****)
				load('m');
				re_draw_screen;
				if(part <> nil) then
				begin
				 set_linestyle(4);
				 draw_box(part^.bounds);
				 set_linestyle(l_style);
				end;
			  end;
		'F'	: begin		(**** filled objects on ****)
				fill_on := not fill_on;
				if (menu_draw) then draw_menu;
			  end;
		'g'	: begin		(**** grid on ****)
				grid_on := not grid_on;
				if( not grid_on and grid_draw) then clear_plane(1);
				if (not grid_on) then grid_draw := false;
				if (menu_draw) then draw_menu;
			
			  end;
		'G'	: begin		(**** grid size ****)
				regis_off;                  
				write('Grid Size? [',grid_size:2,']');
				readln(dummy_s);
				writeln;
				readv(dummy_s,grid_size,ERROR := CONTINUE);
				if (grid_size <= 0) then grid_size := 1;
				regis_on;
				if(grid_draw) then
				 begin
				 clear_plane(1);
				 draw_grid;
				 end;
			  end;
		'I'	: begin
				input_cursor:=1+(input_cursor mod 2);
			  end;
		'L'	: begin
				load('l');
				
				re_draw_screen;
				part := nil;
				 end;
		'S'	: begin
				save;
				re_draw_screen;
				if(part <> nil) then
				begin
				 set_linestyle(4);
				 draw_box(part^.bounds);
				 set_linestyle(l_style);
				end;
			  end;
		'J'	: begin
			  if (part <> nil) then
			  begin
				undraw_box(part^.bounds);
				draw(0,0,part);
				un_join(part);			
				part  := nil;
			  end;
			 end; (* of unjoin *)

		'j'	: begin	(* join objects *)
			let_go(part);
			trect.x := ix;
			trect.y := iy;
			regis_move(ix,iy);
			regis_gin(dx,dy,key,4);
			trect.w := dx-ix;
			trect.h := dy-iy;

			part := join(trect);  (* make new part *)
			if (part <> nil) then (* outline new part *)
			 begin
				 set_linestyle(4);
				 draw_box(part^.bounds);
				 set_linestyle(l_style);
			 end;
			end;

		'k'	: begin
				arrow_on := not arrow_on;
				if (menu_draw) then draw_menu;
			 end;
		's'	: begin                               
				let_go(part);
				regis_move(ix,iy);
				gimme(part);
				part^.l_style := l_style;
				part^.species := OBJ_SPLINE;
				mix:= ix;
				maxx:= ix;
				miy := iy;
				may := iy;
                                
				x_array[1] := 0;
				y_array[1] := 0;
	 				tx := ix; ty := iy;      
				i := 2;
				while (key <> ' ') and (key <> 'ñ' )and (i < 20) do 
				begin
                
				temp_draw := menu_draw;
				menu_draw := false;
				    regis_gin(dx,dy,key,3);
				menu_draw := temp_draw;
					regis_move(dx,dy);
					
					mix := min(mix,dx);        
					maxx := max(maxx,dx);
					miy := min(miy,dy);
					may := max(may,dy);

					x_array[i] := dx-tx;
					y_array[i] := dy-ty;
	  				tx := dx; ty := dy;      
					i:= i+1;
			
				end;
			part^.bounds.x := mix;
			part^.bounds.y := miy;
			part^.bounds.w := maxx - mix;
			part^.bounds.h := may - miy;
                
				record_buf[rec_num] := ' ';
				regis_move(mix,miy);
				record_on := true;
				regis_dmove(ix-mix,iy-miy);
				regis_spline(x_array,y_array,i-1,open_spline);
				record_on := false;
                                                       
			part^.draw := record_buf[rec_num];
			insert(part,head);
			rec_num := (rec_num+1)mod 10;

		set_linestyle(4);
		draw_box(part^.bounds);
		ix:= dx;
		iy:= dy;
		set_linestyle(l_style);
			  end;
		't'	: begin
				let_go(part);
				regis_off;		(** get text **)
				readln(gtext); 
				regis_on;

			gimme(part);
			part^.l_style := l_style;

			part^.bounds.x := ix;
			part^.bounds.y := iy;
			part^.species := OBJ_TEXT;

			if(text_size = 0) then
			begin
			 part^.bounds.w := (length(gtext))*9;
			 part^.bounds.h := 10;
			end                     
			else
			if(text_size=1) then
			begin
			 part^.bounds.w := (length(gtext))*9*text_size;
			 part^.bounds.h := 20;
			end
			else
			begin
			 part^.bounds.w := (length(gtext))*9*text_size;
			 part^.bounds.h := 15*text_size;
			end;

				record_buf[rec_num] := ' ';
				regis_move(ix,iy);
				record_on := true;
				regis_text(gtext,text_size,2);
				record_on := false;
                
			part^.draw := record_buf[rec_num];
			insert(part,head);

				rec_num := (rec_num+1)mod 10;
		set_linestyle(4);
		draw_box(part^.bounds);
		set_linestyle(l_style);
		ix:= part^.bounds.x;
		iy:= part^.bounds.y+part^.bounds.h;
			  end;
                                        
		'_'	: begin
				regis_off;

				if(part <> nil) then 	(** global style **)
				write('Line Style? (1-9) [',
					part^.l_style:2,']')
				else
				write('Line Style? (1-9) [',
					l_style:2,']');

				readln(dummy_s);
				readv(dummy_s,i,ERROR := CONTINUE);
				writeln;
				regis_on;

				if(part <> nil) then 	(** global style **)
				begin

				 part^.l_style := i;

				 if(i<0) then part^.l_style := 0;
				 if(i>9) then part^.l_style := 9;

				 draw(0,0,part);
				 set_linestyle(4);
				 draw_box(part^.bounds);
				 set_linestyle(l_style);
				        
				end
				else
				 begin

				 l_style := i;
				 if(l_style<0) then l_style := 0;
				 if(l_style>9) then l_style := 9;
				 set_linestyle(l_style);
				 if (menu_draw) then 
					draw_menu;
				
				 end;
		

			  end;
		'T'	: begin
				regis_off;
				write('Text Size (0-16)? [',text_size:2,']');
				readln(dummy_s);
				readv(dummy_s,text_size,ERROR := CONTINUE);
				 if(text_size<0) then text_size := 0;
				writeln;
				regis_on;


			  end;


		'U'	: begin 
				let_go(part);
				if (temp2 <> nil) then
				begin
				 insert(temp2,head);
				 draw(0,0,temp2);
				 temp2 := nil;
				end;
			  end;
		'u'	: begin
				let_go(part);
				temp2 := head;
				undraw(0,0,head);
				cut(head);  
				rec_num := (rec_num +9 ) mod 10;
				
			  end;
                                                   
		'A'	: begin	(* associate file with object *)
		  if(part <> nil) then
			begin
				regis_off;
				write('Associate with file [',part^.n_file,'] ');
				readln(dummy_s); 
				writeln;
				regis_on;

				part^.n_file := dummy_s;
				brighten(part);

				draw(0,0,part);
				set_linestyle(4);
				draw_box(part^.bounds);
				set_linestyle(l_style);
			
			end; (* have a part *)
			end; (* associate file *)

		'b'	: begin		(* blow up bubble *)
			  temp := part;
			  if (part <> nil) then (* have one *)
			  if (part^.n_file = '') then (* no link file *)
			  if (part^.sub <> nil) then  (* we have group *)
			   begin
			 	part := part^.sub;
			 	while ((part <> nil) and ( (part^.n_file = '') or
						    (part^.n_file = ' '))) do
				part := part^.next;        
			   end; (* if grouped object *)

			  if (part <> nil) then (* have one *)
			   begin
				blow_up(part,temp);
				part:=nil;
			   end; (* we have a part to blow up *)
			  end;
		'n'	:begin	(* edit note file *)
				(* check for part = nil *)
			 if (part <> nil) then     
			 begin
				(* edit if note file has been attached *)
				trim80(part^.note_file);
				if (length (part^.note_file) >2) then
				begin

					(* spawn editor using part^.note_file *)
					regis_off;      
					dummy_b := spawn_command_line('ed '+part^.note_File);
					regis_on;
	
					re_draw_screen;
					set_linestyle(4);
					draw_box(part^.bounds);
					set_linestyle(l_style);
				end; (* no note file *)

			end (* part <> nil *)
			else	(* use workspace note file *)
			 begin
				trim80(note_file);
			if (length(note_file) >1) then
			begin
				(* spawn editor using note_file *)
				regis_off;
				dummy_b := spawn_command_line('ed '+note_file);
				regis_on;

				re_draw_screen;

				if (part <> nil) then 
				 begin
					set_linestyle(4);
					draw_box(part^.bounds);
					set_linestyle(l_style);
				 end;
			end; (* note file > 1 *)

			 end;
			end;
		'N'	:begin	(* add note file name to object/workspace *)

			if (part <> nil) then
			begin
				regis_off;
				trim80(part^.note_file);
			write('Note file for OBJECT: [',part^.note_file,'] ');
				readln(dummy_s);
				writeln;
				regis_on;

					part^.note_file := dummy_s;
					trim80(part^.note_file);
					save_file(loaded_file);

				if (length (part^.note_file) >2) then
				begin                           

					(* spawn editor using part^.note_file *)
					regis_off;      
					dummy_b := spawn_command_line('ed '+part^.note_File);
					regis_on;
	
					re_draw_screen;
					set_linestyle(4);
					draw_box(part^.bounds);
					set_linestyle(l_style);
				end; (* no note file *)

			end
			else
			begin
				regis_off;
				write('Note file for WORKSPACE: [',note_File,'] ');
				readln(dummy_s);
				writeln;
				regis_on;

					note_file := dummy_s;
					save_file(loaded_file);
				if (length (note_file) >1) then
				begin
					(* spawn editor using note_file *)
					regis_off;      
			dummy_b := spawn_command_line('ed '+note_File);
					regis_on;
					re_draw_screen;	
				end; (* no note file *)

			end;
		end;

		'x'	: begin		(* explode object *)
			  if(part <> nil) then
			       if (part^.n_file = '') then (* no link file *)
				if (part^.sub <> nil) then  (* we have group *)
				 begin
				   temp := part;
				   part := part^.sub;
				   while ((part <> nil) and ( (part^.n_file = '') or
							    (part^.n_file = ' '))) do
					part := part^.next; 
				 end; (* if grouped object *)
	
				if(part <> nil) then   (* we have a part here *)
				  begin
					if (part^.n_file <> ' ') and (part^.n_file<>'') then
					 begin
						get_file(part^.n_file,'l');
						re_draw_screen;
						part := nil;
					 end; (* associated part *)
				  end (* have a part *)
				else 
				  part := temp;
				end;		

		'z'	: begin
				 if(zoom_file <> '')and(zoom_file <> ' ')
				 and(zoom_file <> '-') then 
				 begin
				  get_file(zoom_file,'l');
				
				 re_draw_screen;
				 part := nil;
				 end;
			 end;		
		'Z'	: begin
				regis_off;
				write('Zoom up file= [',zoom_file,']');
				readln(zoom_file); 
				writeln;
				regis_on;
				if (length(loaded_file) > 0) then
				save_file(loaded_file);
			  end;
		'X'	: begin
				all_delete;

				re_draw_screen;
				zoom_file := loaded_file;
				loaded_file := '';
				part := nil;
			  end;
		'Q'	: 	done := true;
		'W'	: begin
				regis_off;
		if(part <> nil) then
		begin                                   
		writeln('Line style of part=',part^.l_style:2);
		writeln('Associated file= ',part^.n_file);
		writeln('Note file= ',part^.note_file);
		end
		else 
		begin
		writeln('Default extender = ',save_ext);
		writeln('Loaded file=',loaded_file);
		writeln('Zoom file=',zoom_file,'  Note file=',note_file);
		writeln('Line style= ',l_style:2,' Text Size= ',text_size:2);
		writeln('Grid Size = ',grid_size:3,' Grid on: ',grid_draw);
		writeln('using_pc = ',using_pc);
		writeln('Filled shapes: ',fill_on);
		end;
	if(paste_part <> nil) then writeln('Paste buffer full');
				regis_on;

			 end;	
	
		'P'	: begin                                   

			  end;
		'l'	: begin	(* draw grid lines *)
				if (grid_on) then 
				begin
				grid_draw := not grid_draw;
				if( not grid_draw) then clear_plane(1);
				if (grid_draw ) then draw_grid;
				if (menu_draw) then draw_menu;
				end;
			  end;
		'C'	: begin
				if (not grid_draw) then
				move_all(400-ix,240-iy)
				else
				begin	(* move constrained to grid *)
				dx := 400-(400 mod grid_size);
				dy := 240-(240 mod grid_size);
				move_all(dx-ix,dx-iy);
				end;
				re_draw_screen;
			  if(part <> nil) then
				begin
				 draw(0,0,part);   		 
				set_linestyle(4);
				 draw_box(part^.bounds);   
				set_linestyle(l_style);
				end;
			  end;
		'@'	: begin
				regis_off;
				write('New menu (10 items):');
				readln(new_icon);
				writeln;
				if (length(new_icon)=10) then
				for i:= 0 to 9 do
				 begin
				 icon[i] := new_icon[i+1];
				 end;
				regis_on;
				re_draw_screen;
			 end;
		'h' : begin (* flip horizontally *)
			if (part <> nil) then
			  begin
				 undraw(0,0,part);
			flip_sub(part,part^.bounds.w,part^.bounds.h,'h');
				 draw(0,0,part);
			  end;                                               
			end;
		'v' : begin (* flip horizontally *)
			if (part <> nil) then
			  begin
				 undraw(0,0,part);
				 flip_sub(part,part^.bounds.w,part^.bounds.h,'v');
				 draw(0,0,part);
			  end;
			end;
				
		'H' : begin
			   	regis_reset;
				help_screen;
			   	regis_gin(ix,iy,key,input_cursor);
			   	re_draw_screen;
	  if(part <> nil) then
		begin
		 draw(0,0,part);		 
		 draw_box(part^.bounds);
		end;
			     end;
	
		'`','õ','ö'		: begin  (* #3 mouse button *)
				do_again := true;
			  end;

	  end; (* case *)
	if(control_hit) then
	begin   

	 case key of
		chr(34+96)	: begin
				menu_draw := not menu_draw;
			if(menu_draw ) then draw_menu
			else undraw_menu;

(*				   re_draw_screen;
			 if (part <> nil) then
			  begin
				 draw(0,0,part);
				 set_linestyle(4);
				 draw_box(part^.bounds);
				 set_linestyle(l_style);
			  end; 
*)
			  end;

		'a'	: begin (* find key *)
		 regis_move(ix,iy);
		if(part <> nil) then
		begin
		 undraw_box(part^.bounds);
		 draw(0,0,part);		 
		 part := find_next(ix,iy,part^.next);
		end                  
		else part := find_next(ix,iy,head);

		if (part <> nil) then
		begin
		 set_linestyle(4);
		 draw_box(part^.bounds);
		 set_linestyle(l_style);
		end;
			  end;
		'b'	: begin (* insert here key *)
				if (paste_part <> nil )then 
				begin
					gimme(temp);
					copy_tree(paste_part,temp);
					temp^.bounds.x := ix;
					temp^.bounds.y := iy;
					draw(0,0,temp);
				   	insert(temp,head);
					ix:= temp^.bounds.x;
					iy:= temp^.bounds.y;
				end;
			  end;
		'c'	: begin (* remove key *)
				if (part <> nil) then 
				begin
				 cut(part);
				 undraw(0,0,part);
				 undraw_box(part^.bounds);
				 paste_part :=part;
				 ix := part^.bounds.x;
				 iy := part^.bounds.y;
				part := nil;
				end;

			 end;
		'd'	: begin (* Select key *)
		if(part <> nil) then
		begin
		 undraw_box(part^.bounds);
		 draw(0,0,part);		 
		 part := nil;
		end;

				part:=find(ix,iy);

		if (part <> nil) then 
	    begin 		(* if something there *)
				set_linestyle(4); (* redraw as dotted *)
				draw_box(part^.bounds);
				set_linestyle(l_style);
		end; (* of something there *)
				
			  end;
		'|'		: begin (* help key *)
			   	regis_reset;
				help_screen;
			   	regis_gin(ix,iy,key,1);
			   	re_draw_screen;
			     end;
		'e'	: begin  (* prev screen *)
				move_all(0,240);
				re_draw_screen;
				if(part <> nil) then
				begin
				 set_linestyle(4);
				 draw_box(part^.bounds);
				 set_linestyle(l_style);
				end;
			   end;

		'f'	: begin (* next screen *)
				move_all(0,-240);
				re_draw_screen;
				if(part <> nil) then
				begin
				 set_linestyle(4);
				 draw_box(part^.bounds);
				 set_linestyle(l_style);
				end;
				   end;
		end;

	end;


	 end; (* while *)
	regis_reset;
	regis_off;              
	regis_exit;
	all_delete;	
	
	writeln(chr(27),' F');

end.