Module -- debug output event constant names in realtime
Posted: Sun Jan 29, 2017 2:36 am
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 returns false.
1. call check if return is true.
2. call with eventid.
3. call to freelists when done
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()1. call
Code: Select all
IdentifyPBConstants::InitPBConstants()2. call
Code: Select all
IdentifyPBConstants::ComparePBConstant(value)3. call
Code: Select all
IdentifyPBConstants::DestroyPBConstants()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