Module -- debug output event constant names in realtime

Developed or developing a new product in PureBasic? Tell the world about it.
User avatar
Zebuddi123
Enthusiast
Enthusiast
Posts: 794
Joined: Wed Feb 01, 2012 3:30 pm
Location: Nottinghamshire UK
Contact:

Module -- debug output event constant names in realtime

Post by Zebuddi123 »

Hi to all. As a bit of an experiment and passing some time. I wondered as events are received in the event loop it might be good to see what the event constant names are in realtime, knowing that multiple constants have the same value and a lot of data could be generated in a short time, but with a breakpoint after the event you could quickly see what event constant names were generated.

It`s module based. uses a constant.txt file placed in the same directory as the module itself. (from Danilo`s GetPBInfo Constant part incorporated into the module) if the constants.txt file is missing or older than the current compiler version then a new constants.txt file is generated. On failure of those two condition

Code: Select all

InitPBConstants()
returns false.

1. call

Code: Select all

IdentifyPBConstants::InitPBConstants()
check if return is true.
2. call

Code: Select all

IdentifyPBConstants::ComparePBConstant(value)
with eventid.
3. call

Code: Select all

IdentifyPBConstants::DestroyPBConstants()
to freelists when done

Code: Select all

EnableExplicit

DeclareModule IdentifyPBConstants
	
	Structure PBCONSTANTS_DATA
		constant.s
		value.i
	EndStructure
	
	Global NewList _llPBConstants.PBCONSTANTS_DATA()
	Global NewList _llResults.s()
	
	Declare.b InitPBConstants()
	Declare.s ComparePBConstant(value.i)
	Declare DestroyPBConstants()
	
EndDeclareModule

Module IdentifyPbConstants
	;-------------------------------------------------------------------------------------	
	;-------------------------------------------------------------------------------------
	; GetPBInfo.pb
	;
	; Thanks to Danilo --- 
	
	#Compiler = #PB_Compiler_Home+"compilers\pbcompiler.exe"
	
	Procedure StartCompiler()
		ProcedureReturn RunProgram(#Compiler,"/STANDBY","",#PB_Program_Open|#PB_Program_Read|#PB_Program_Write|#PB_Program_Hide)
	EndProcedure
	
	Procedure StopCompiler(compiler)
		WriteProgramStringN(compiler, "END")
		WaitProgram(compiler,5000)
		CloseProgram(compiler)
	EndProcedure
	
	Procedure SendCompilerCommand(compiler,command$)
		If ProgramRunning(compiler)
			WriteProgramStringN(compiler, command$)
		EndIf
	EndProcedure
	
	Procedure.s GetCompilerOutput(compiler)
		Protected  x$
		If AvailableProgramOutput(compiler)
			x$ =  ReadProgramString(compiler)
			ProcedureReturn x$
		EndIf
	EndProcedure
	
	Procedure FillList(compiler,List out.s(),space=0)
		Protected out$
		Protected space$=Space(space)
		While out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR"
			out$=GetCompilerOutput(compiler)
			If out$ And out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR" And FindString("0123456789",Mid(out$,1,1))=0
				AddElement(out())
				out()=space$+out$
			EndIf
		Wend
	EndProcedure
	
	Procedure FillConstantList(compiler,List out.s(),space=0)
		Protected out$
		Protected space$=Space(space)
		While out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR"
			out$=GetCompilerOutput(compiler)
			If out$<>"" And out$<>"OUTPUT"+#TAB$+"COMPLETE" And Left(out$,5)<>"ERROR" And FindString("0123456789",Mid(out$,2,1))=0
				If FindString("01",Mid(out$,1,1))
					out$ = "#"+Mid(out$,2,Len(out$)-1)
					out$ = ReplaceString(out$,#TAB$," = ")
					out$ = ReplaceString(out$,"# = ","#")
				ElseIf FindString("2",Mid(out$,1,1))
					Protected i, found_non_printable = #False
					Protected oldout$ = out$
					Protected sconst_value$  = StringField(oldout$,3,Chr(9))
					out$ = "#"+StringField(oldout$,2,#TAB$)
					For i = 1 To Len(sconst_value$)
						If Asc(Mid(sconst_value$,i)) < 32 Or Asc(Mid(sconst_value$,i)) > 126
							found_non_printable = #True
						EndIf
					Next i
					If out$ = "#TAB$"
						out$ + " = Chr(9)"
					ElseIf out$ = "#HT$"
						out$ + " = Chr(9)"
					ElseIf out$ = "#CRLF$"
						out$ + " = Chr(13) + Chr(10)"
					ElseIf out$ = "#LFCR$"
						out$ + " = Chr(10) + Chr(13)"
					ElseIf out$ = "#LF$"
						out$ + " = Chr(10)"
					ElseIf out$ = "#CR$"
						out$ + " = Chr(13)"
					ElseIf out$ = "#DOUBLEQUOTE$"
						out$ + " = Chr(34)"
					ElseIf out$ = "#DQUOTE$"
						out$ + " = Chr(34)"
					ElseIf found_non_printable = #False
						out$ + " = " + #DQUOTE$ + StringField(oldout$,3,#TAB$) + #DQUOTE$
					Else
						out$ + " ="
						Protected temp$ = StringField(oldout$,3,#TAB$)
						For i = 0 To Len(sconst_value$)-1
							out$ + " Chr("+Str(PeekB(@temp$+(i*SizeOf(Character)))) + ") +"
						Next
					EndIf
					out$ = RTrim(out$,"+")
					out$ = Trim(out$)
				EndIf
				out$ = Trim(out$)
				If out$
					AddElement(out())
					out()=space$+out$
				EndIf
			EndIf
		Wend
	EndProcedure
	
	
	Procedure GetConstantsList(compiler,List out.s())
		If ProgramRunning(compiler)
			SendCompilerCommand(compiler,"CONSTANTLIST")
			FillConstantList(compiler,out())
		EndIf
	EndProcedure
	
	
	Procedure WaitCompilerReady(compiler)
		Protected out$
		While out$<>"READY" And Left(out$,5)<>"ERROR"
			out$ = GetCompilerOutput(compiler)
		Wend
	EndProcedure
	;-------------------------------------------------------------------------------------	
	;-------------------------------------------------------------------------------------	
	
	; zebuddi ----------------------------------------------------------------------	
	
	Procedure.b _InternalCreatePBCFile()
		Define  pb, out$, bFileOK.b
		NewList constants.s()
		
		pb = StartCompiler()
		If pb
			WaitCompilerReady(pb)
			GetConstantsList(pb,constants())
			SortList(constants(),#PB_Sort_Ascending|#PB_Sort_NoCase)
			
			If CreateFile(0, GetCurrentDirectory()+"\Constants.txt")
				WriteStringN(0, Str(#PB_Compiler_Version))
				WriteStringN(0, Str(ListSize(constants())))
				ForEach constants()
					WriteStringN(0,constants())
				Next
				CloseFile(0)
				FreeList(constants())
				bFileOK = #True
			EndIf
		EndIf
		StopCompiler(pb)
		
		If bFileOK
			ProcedureReturn #True
		Else
			ProcedureReturn #False
		EndIf	
	EndProcedure
	
	Procedure.s GetVersion(iFileID.i)
		ProcedureReturn ReadString(iFileID)	
	EndProcedure
	
	Procedure.b InitPBConstants() ; must be called first to check if Linked list and data initialised 
		Protected  sData.s, version$, iVersionCurrent.i, iContantCount.i, bFileOK.b, bMakePBCFile.b
		#File = 0
		If ReadFile(#File, "constants.txt") And  Val(GetVersion(#File)) = #PB_Compiler_Version  ; check to see if constant file is valid. If not try to created new constants file
			FileSeek(#File, 0)
			version$ = GetVersion(#File)
			bFileOK = #True
				
		ElseIf ReadFile(#File, "constants.txt") And Val(GetVersion(#File)) <> #PB_Compiler_Version  ; readfile ok version different
			bFileOK =  _InternalCreatePBCFile()	    ; try to create new constants file
			If bFileOK = #True
				ReadFile(#File, "Constants.txt")
				version$ = GetVersion(#File)
			Else
				bFileOK = #False
			EndIf
		
		ElseIf Not ReadFile(#File, "constants") ; try create if dont exist
			bFileOK =  _InternalCreatePBCFile() ; try to create new constants file
			If bFileOK
			ReadFile(#File, "Constants.txt")
			version$ = GetVersion(#File)	
			Else
				bFileOK = #False
			EndIf
		EndIf
		
		If bFileOK  ; constants file is ok 
			
			iContantCount = Val(ReadString(0))
			While Not  Eof(#File)
				sData = ReadString(#File)
				AddElement(_llPBConstants())
				With _llPBConstants()
					\constant 	= Trim(StringField(sData, 1, Chr(61)))
					sData 		= Trim(RemoveString(sData, \constant + " = "))
					\value		= Val(StringField(sData, 1, #CRLF$))
				EndWith
			Wend
			CloseFile(#File)
			
			If (Val(version$) = #PB_Compiler_Version) And (ListSize(_llPBConstants()) = iContantCount)
				iVersionCurrent = #True
				ProcedureReturn #True
			Else
				iVersionCurrent = #False
			EndIf
		Else
			MessageRequester("file Error", "Unable to read or create PBConstant`s file")
		EndIf
	EndProcedure
	
	Procedure.s ComparePBConstant(value.i)
		Protected sPBC.s
		With _llPBConstants()
			ForEach _llPBConstants()
				If 	\value = value
					AddElement(_llResults())
					_llResults() = \constant
				EndIf
			Next	
			
			SortList(_llResults(), #PB_Sort_Ascending)
			
			ForEach _llResults()
				sPBC + _llResults() + #CRLF$
			Next
			
			ClearList(_llResults())
			
			ProcedureReturn sPBC
		EndWith	
	EndProcedure
	
	Procedure DestroyPBConstants()
		FreeList(_llPBConstants())
		FreeList(_llResults())
	EndProcedure
	
EndModule



CompilerIf #PB_Compiler_IsMainFile
	UseModule  IdentifyPBConstants
		
		Procedure WinCallback(hWnd, uMsg, WParam, LParam) 
			Debug uMsg
			Debug IdentifyPBConstants::ComparePBConstant(uMsg)
			Debug  "     "
			ProcedureReturn #PB_ProcessPureBasicEvents 
		EndProcedure 
		
		
		If OpenWindow(0, 0, 0, 200, 100, "Messages", #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget) 
			If IdentifyPBConstants::InitPBConstants()
				SetWindowCallback(@WinCallback())    ; activate the callback
			EndIf
			
			Repeat 
				Select WaitWindowEvent() 
					Case #PB_Event_CloseWindow 
						End 
				EndSelect 
			ForEver 
			
		EndIf 	
		IdentifyPBConstants::DestroyPBConstants()
	UnuseModule IdentifyPBConstants
CompilerEndIf


malleo, caput, bang. Ego, comprehendunt in tempore