module dumpDynamic

import StdEnv, StdIO
import StdPathname
import ArgEnv
//import Directory
import MarkUpText
import UtilStrictLists, expand_8_3_names_in_path
// Time
//import dump_switches
import link_switches

from StdDebug import trace_n
import RWSDebugChoice
//trace_n m f :== f

import ddState, write_dynamic, dynamics, ExtInt, ExtFile;

graph_window_background_colour	:== PastyGreen;

:: *GState 
	= {
		ddstate			:: !*DDState
	,	gs_file_name	:: !String
	};
	
//DefaultGState :: *DDState -> !*GState;
DefaultGState ddstate
	= { GState |
		ddstate 		= ddstate
	,	gs_file_name	= ""
	};
	
//Start :: *World -> *World
Start world
		
// MV ...
	#! (mem,world)
		= getMemory world;
	#! (quit,initial_dynamic_list,ddState,world)
		= InitialDDState mem graph_window_background_colour world;	
// ... MV

	| IS_TEXT_DUMP_DYNAMIC 
		#! file_name
			= "C:\\Documents and Settings\\MIJN_COMPUTER\\Desktop\\Clean\\cvs\\dynamic\\dynamics\\Examples\\Apply\\non-predefined result type\\bool.dyn";
//			= "C:\\arjen.dyn";
		#! ddState
			= { DDState|  ddState & file_name = file_name };
		#! txt_file_name
			= file_name +++ ".txt";
		#! (ok1,file,world)
			= fopen txt_file_name FWriteText world;	
		| not ok1
			#! (_,world)
				= fclose file world;
			= ("error",world);
	
		#! (dynamic_info=:{header},ddState,file,world,_)
			= do_dynamic ddState file world;
			
		#! (ok2,world)
			= fclose file world;
		= ("ok",world)
	
		# (lid,world) = openId world
		= ("",startIO MDI (DefaultGState ddState) (init lid initial_dynamic_list) [ProcessClose (closeProcess),ProcessOpenFiles (dropfun lid)] world)
where
	init lid initial_dynamic_list ps	
		# (h`,ps)	= accPIO (accScreenPicture (lines_height ("":!Nil))) ps
		# (h,ps)	= accPIO (accScreenPicture (lines_height Nil)) ps
		# h = max h 1
		# ((ok,font),ps)	= accPIO (accScreenPicture (openFont {fName = "Courier", fStyles = [], fSize = 10})) ps

		# ((file_name,project_name),ps)
			= accPLoc (\ls=:{ddstate={file_name,project_name}}->((file_name,project_name),ls)) ps
		#! (ok1,p)
			= GetFullPathName project_name;
		// TEST		
//		#! ps
//			= dropfun lid ["C:\\Documents and Settings\\MIJN_COMPUTER\\Desktop\\Clean\\cvs\\dynamic\\dynamics\\Examples\\Apply\\non-predefined result type\\test_dynamic.dyn"] ps
			
		# ps
			= dropfun lid initial_dynamic_list ps;
		= ps;

// MV ...
event_handler1 :: !(MarkUpEvent String) *(PSt .ps) -> *PSt .ps
event_handler1 event pstate
	| event.meSelectEvent					= pstate
	= jumpToMarkUpLabel event.meOwnRId event.meLink pstate
//event_handler1 (MarkUpLinkClicked nr name) id rid state
//	= jumpToMarkUpLabel rid name state
//event_handler1 other id rid state
//	= state
// ... MV

handle_command_line lid ps
	| size commandline == 1
		= ps
		= dropfun lid [expand_8_3_names_in_path commandline.[1]] ps
where
	commandline
		= getCommandLine

import DebugUtilities;

from utilities import foldSt;
	
dropfun :: a ![{#.Char}] !*(PSt *GState) -> *(PSt *GState)
dropfun lid list ps
	= foldSt (\file_name ps -> new_file lid file_name "dummy_project_name" ps) list ps;

valid_drop :: [String] -> (!Bool,!String,!String);
valid_drop [f1,f2]
	| (snd (ExtractPathFileAndExtension f1)) == "prj"
		= F "valid drop" (True,f2,f1);
	| (snd (ExtractPathFileAndExtension f2)) == "prj"
		= F "valid_drop" (True,f1,f2);

	= F "ignoring dropped files" (False,"","");

valid_drop _
	= (False,"","");
		
new_file lid file_name project_name ps
	| True ->> ("new_file",file_name,project_name)
	#! (ddState,ps)	= accPLoc (\ls=:{ddstate}->(ddstate,{ls & ddstate = DefaultDDState Mem})) ps
	
	#! ddState
		= { ddState &
			file_name		= file_name
		,	project_name	= project_name
		,	first_time		= True
		};
		
	#! txt_file_name
		= file_name +++ ".txt";
	#! (ok1,file,ps)
		= fopen txt_file_name FWriteText ps;	
	| not ok1
		= trace_n ("could not open: " +++ txt_file_name) snd (fclose file ps);

	#! (dynamic_info=:{header},ddState,file,ps,markup_commands)
		= do_dynamic ddState file ps;
		
	#! file1
		= markup_commands;

/*
	// MarkUpWindow ...
	// recalculation is necessary because of cyclic dependencies between modules
	#! (max_desc_name,max_mod_name,desc_table)
		= BuildDescriptorAddressTable dynamic_info;
	#! (nodes,desc_table,ddState)
		= compute_nodes desc_table dynamic_info ddState;	

	#! (nodes,file1,desc_table)
		= case (DYNAMIC_CONTAINS_BLOCKTABLE header) of {
			True	-> (nodes,[],desc_table);
			False	-> WriteGraph2 desc_table dynamic_info nodes [];
		};
*/


	# ps = MarkUpWindow ("Value graph of " +++ file_name) file1 //ListExample1
		[ MarkUpBackgroundColour		graph_window_background_colour //PastyGreen
		, MarkUpTextColour				Black
		, MarkUpTextSize				10
		, MarkUpFontFace				"Courier"
		, MarkUpWidth					400
		, MarkUpHeight					400
		, MarkUpLinkStyle				False Blue PastyGreen True Blue PastyGreen
		, MarkUpLinkStyle				False Red PastyGreen True Red PastyGreen
		, MarkUpEventHandler			event_handler1		// MV
		] [WindowClose (noLS closeProcess), WindowPos (Fix, OffsetVector {vx=500,vy=100})] ps

	// ... MarkUpWindow
		
	#! ps
		= appPLoc (\ls -> {ls & ddstate = ddState}) ps
		
	#! (ok2,ps)
		= fclose file ps;
		
	| not ok2
		= trace_n ("could not close: " +++ file_name +++ ".txt") ps;
	
	
	#! (l,ps)
		= read_file txt_file_name ps;


	# ((ok,font),ps)	= accPIO (accScreenPicture (openFont {fName = "Courier", fStyles = [], fSize = 10})) ps
//	# (h`,ps)	= accPIO (accScreenPicture (lines_height l)) ps
//	# (h,ps)	= accPIO (accScreenPicture (lines_height Nil)) ps
	# (h`,ps)	= accPIO (accScreenPicture (lines_height ("":!Nil))) ps
	# (h,ps)	= accPIO (accScreenPicture (lines_height Nil)) ps

	# (total_height, ps) = accPIO (accScreenPicture (lines_height l)) ps

	# h = max h 1
	# (err,ps) = openWindow 0
					( Window txt_file_name
					(NilLS)
					[ WindowHMargin 0 0
					, WindowVMargin 0 0
					, WindowViewSize {w=400,h=400}
					, WindowViewDomain {corner1=zero, corner2={x=640,y=total_height}}
					, WindowVScroll (stdScrollFunction Vertical ((h`-h)))
					, WindowClose (noLS closeProcess)
					, WindowLook True (lines_look l) 
	//				, WindowId lid
					, WindowPen [PenFont font]
					]) ps			
	
/*		
	# (h,ps)	= accPIO (accScreenPicture (lines_height l)) ps
	# ps		= appPIO (setWindowViewDomain lid {zero&corner2={x=640,y=h}}) ps
	# ps		= appPIO (setWindowLook lid True (True,(lines_look l))) ps	
*/
	= ps;
where 
	read_file file_name ps
		#! (ok1,file,ps)
			= fopen file_name FReadText ps;
		| not ok1
			= (Nil,snd (fclose file ps));
			
		#! (l,file)
			= read_file_loop file;
		#! (_,file)
			= fclose file ps;
		= (l,ps);	
	where
		read_file_loop :: !*File -> (List String,!*File); 
		read_file_loop file
			#! (end_of_file,file)
				= fend file;
			| end_of_file
				= (Nil,file);
				
			#! (l,file)
				= freadline file;
			#! l
				= case (l.[dec (size l)] == '\n') of 
					True
						-> (l % (0, (size l) - 2))
					False
						-> l
			#! (l2,file)
				= read_file_loop file;
			= (l:! l2,file);
	

	
PastyGreen = RGB {r = 215, g = 255, b = 215}

lines_look :: (List String) SelectState UpdateState *Picture -> *Picture
lines_look l _ {newFrame} p
	# (s,p)	= lines_height l p
//	# ps = setControlViewDomain lid {zero&corner2={x=640,y=s}} ps

	# p = setPenColour PastyGreen p
	# p = fill newFrame p
	# p = setPenColour Black p
	# (fm,p) = getPenFontMetrics p
	# fst = fm.fLeading + fm.fAscent
	# hgt = fontLineHeight fm
	= lines l fst hgt p
where
	lines Nil s _ p = p
	lines (l:!ls) s n p
		# p = drawAt {x=10,y=s} l p
		= lines ls (s+n) n p

lines_height l p
	# ((ok,font),p) = openFont {fName = "Courier", fStyles = [], fSize = 10} p
	# (fm,p) = getFontMetrics font p
	# fst = fm.fLeading //+ fm.fAscent
	# hgt = fontLineHeight fm
	= lines l fst hgt p
where
	lines Nil s _ p = (s,p)
	lines (l:!ls) s n p
		= lines ls (s+n) n p

WriteGraph2 :: *DescriptorAddressTable !.BinaryDynamic *(Nodes NodeKind) u:[w:MarkUpCommand {#.Char}] -> *(*Nodes NodeKind,v:[x:MarkUpCommand {#Char}],*DescriptorAddressTable), [w <= x, u <= v];		
WriteGraph2 desc_table dynamic_info nodes file
/*
	#! file
		= fwrites ("ENCODED GRAPH\n") file;

	#! file
		= write_entry2 graph_s "total size" file;
	#! file
		= write_entry2 graph_i "relative file pointer" file;
	#! file
		= write_entry2 (start_fp + graph_i) "absolute file pointer" file;
		
	#! file
		= fwritec '\n' file;
*/

//	#! (desc_table,nodes,file)
//		= write_graph desc_table nodes file;
	= (nodes,file,desc_table);


//	= (nodes,[],desc_table);

where // {	 

	write_graph desc_table nodes file
		#! (nodes,desc_table,file)
			= write_node 0 1 nodes desc_table file;
		= (desc_table,nodes,file);
	where // {
		write_node stringP node_i nodes desc_table file
			| /*F ("node_i: " +++ toString node_i)*/ stringP == graph_s
				= (nodes,desc_table,file);
	
			| node_i == (inc n_nodes)
			
			/* CALLBACK
				// an indirection; last node has been read but is followed by at least one indirection
				#! (_,file)
					= write_one_line True stringP file;
				#! file
					= fwrites "indirection\n" file;
			*/
				= write_node (stringP + 4) node_i nodes desc_table file	
		
			#! (graph_i,nodes)
				= nodes!nodes.[node_i].graph_index
			#! is_indirection_line
				= graph_i <> stringP;	
			#! (expanded_desc_table_o,file)
				= write_one_line is_indirection_line stringP file				
			
			| is_indirection_line
			/*
				// an indirection
				#! file
					= fwrites "indirection\n" file;
			*/
				= write_node (stringP + 4) node_i nodes desc_table file

			// Main comment				
			#! (s,nodes,desc_table,file)
				= make_string node_i expanded_desc_table_o nodes desc_table file

/*
			#! file
				= fwrites s file
			#! file
				= fwritec '\n' file
*/
				
			// Sub comments
			#! (stringP,nodes,file)
				= write_node_info (stringP + 4) node_i 0 nodes file
	//		#! file
	//			= file ++ [CmText " test "]
	//		#! file
	//			= file ++ [CmEndScope]
			= write_node stringP (inc node_i) nodes desc_table file
			
		write_node_info stringP node_i j nodes file
			#! (info,nodes)
				= nodes!nodes.[node_i].Node.info
			| more_info j info
				#! (_,file)
					= write_one_line True stringP file
				
				#! file
					= file ++ [CmAlign "1", CmText (get_more_info j info graph),CmNewline]
				/*
				#! file
					= fwrites (get_more_info j info graph) file
				#! file
					= fwritec '\n' file;
				*/
				= write_node_info (stringP + 4) node_i (inc j) nodes file
				= (stringP,nodes,file)
						
		make_string node_i expanded_desc_table_o nodes desc_table file
			#! (info,nodes)
				= nodes!nodes.[node_i].Node.info
			#! is_definition
				= is_definition_node info
			| is_definition
				#! (children,nodes)
					= nodes!nodes.[node_i].children
					
				#! (desc_addr_table_i,desc_table)
					= desc_table!expanded_desc_table.[expanded_desc_table_o]
				#! (descriptor_name,desc_table)
					= desc_table!desc_addr_table.[desc_addr_table_i].descriptor_name
					
//				#! s
//					= "@" +++ toString node_i +++ ": Node" +++ (convert_args children);
//					= "@" +++ toString node_i +++ ": " +++ (descriptor_name) +++ x

				#! (info,nodes)
					= nodes!nodes.[node_i].Node.info
//			| more_info j info


				#! file
					=  file ++ [CmLabel (toString node_i),CmText ("@" +++ toString node_i +++ ":  "), CmAlign "1",/*CmScope,*/ /* +++ "  "+++ descriptor_name),*/ CmText descriptor_name]
			// CmScope
				#! l1
					= (convert_args children [])

				#! file
					= file ++ l1
				#! s
					= "";
				= (s,nodes,desc_table,file)
				= ("ref",nodes,desc_table,file)

		where // {

			convert_args [] f
				= f ++ [CmNewline]
			convert_args [x:xs] f
				#! link
					= CmLink ("@" +++ (toString x)) (toString x)
				= convert_args xs [CmText " ",link:f]


		/*
				#! f
					= convert_args xs f 
				= [:file]
			*/	
				
			//	= [CmLink (" @" +++ (toString x)) (toString x): convert_args xs]
			
			
		/*
			convert_args []
				= ""
			convert_args [x:xs]
				#! new_s
					= convert_args xs
				=  new_s +++ (" @" +++ toString x)	
		*/
//		} 
			
		write_one_line is_indirection_line i file
			#! (prefix,partial_arity,expanded_desc_table_o)
				= decode_descriptor_offset2 i graph

			= (expanded_desc_table_o,file)
				
	(binary_dynamic=:{header={n_nodes,graph_s,graph_i,stringtable_i,stringtable_s,descriptortable_i,descriptortable_s},stringtable,descriptortable,graph})
		= dynamic_info