PureBasic Forum
https://www.purebasic.fr/english/

Constant Viewer
https://www.purebasic.fr/english/viewtopic.php?f=27&t=69984
Page 1 of 1

Author:  #NULL [ Fri Jan 19, 2018 9:09 pm ]
Post subject:  Constant Viewer

Another Constant Viewer.
Only tested on Linux
Code:
; fetches CONSTANTLIST from pbcompiler and displays it in search form.
; - use spaces to search multiple words in column (AND-combined), i.e. name 'event type_ pb'
; - search exact phrase using '[x] equals', i.e. '32' won't show results like '32768'


EnableExplicit

Enumeration
  #stateNone
  #stateStartup
  #stateFetchConstList
  #stateClose
EndEnumeration

Enumeration
  #constTypeNone
  #constTypeQuad
  #constTypeDouble
  #constTypeString
EndEnumeration

Structure sConstInfo
  name.s
  typeId.i
  typeName.s
  valueQ.q
  valueD.d
  valueS.s
  show.i
EndStructure

Global.s compiler = #PB_Compiler_Home + "/compilers/pbcompiler"

Global NewList constants.sConstInfo()

Global font
Global win, panel, editor, listicon, link, debugFormat
Global Dim field(4)
Global Dim equals(4)

Procedure getConstantList()
  Define prog, state
  Define.s line
  Define.s output
  output = ""
  state = #stateNone
  prog = RunProgram(compiler, "--standby", GetPathPart(compiler), #PB_Program_Open | #PB_Program_Read | #PB_Program_Write)
  Debug "prog: " + prog
  If prog
    state = #stateStartup
    While ProgramRunning(prog)
      If AvailableProgramOutput(prog)
        line = ReadProgramString(prog)
        ;Debug line
        output + line + #CRLF$
        Select state
          Case #stateStartup
            If line = "READY"
              Debug "compiler: " + line
              state = #stateFetchConstList
              WriteProgramStringN(prog, "CONSTANTLIST")
            EndIf
          Case #stateFetchConstList
            If line = "OUTPUT" + #TAB$ + "COMPLETE"
              Debug "compiler: " + line
              state = #stateClose
              WriteProgramStringN(prog, "END")
            Else
              Define type.i, name.s, valS.s
              type = Val(StringField(line, 1, #TAB$))
              name =     StringField(line, 2, #TAB$)
              valS =     StringField(line, 3, #TAB$)
              AddElement(constants())
              constants()\name = name
              constants()\typeId = #constTypeNone
              constants()\typeName = ""
              constants()\valueQ = 0
              constants()\valueD = 0.0
              constants()\valueS = valS
              Select type
                Case 0
                  constants()\typeId = #constTypeQuad
                  constants()\typeName = "Quad"
                  constants()\valueQ = Val(valS)
                Case 1
                  constants()\typeId = #constTypeDouble
                  constants()\typeName = "Double"
                  constants()\valueD = ValD(valS)
                Case 2
                  constants()\typeId = #constTypeString
                  constants()\typeName = "String"
                  ;constants()\valueS = valS
              EndSelect
            EndIf
        EndSelect
      EndIf
    Wend
    Debug "exit code: " + ProgramExitCode(prog)
    CloseProgram(prog)
  EndIf
  ;Debug "output: " + output
EndProcedure

Procedure populateGui()
  Define show
  Define Dim entryCol.s(4)
  Define Dim searchCol.s(4)
  Define Dim equalsChecked(4)
  Define Dim colCharLen(4)
  Define debugFormatChecked
  Define i, w, word.s, l, item.s, colTitle.s
 
  For i=0 To 4
    searchCol(i) = GetGadgetText(field(i))
    colCharLen(i) = 0
    equalsChecked(i) = Bool(GetGadgetState(equals(i)) = #PB_Checkbox_Checked)
  Next
 
  debugFormatChecked = Bool(GetGadgetState(debugFormat) = #PB_Checkbox_Checked)
 
  ClearGadgetItems(listicon)
  ClearGadgetItems(editor)
  ForEach constants()
    entryCol(0) = constants()\name
    entryCol(1) = Str(constants()\typeId) + " (" + constants()\typeName + ")"
    entryCol(2) = ""
    entryCol(3) = ""
    If constants()\typeId = #constTypeQuad
      entryCol(2) = Str(constants()\valueQ)
    ElseIf constants()\typeId = #constTypeDouble
      entryCol(3) = StrD(constants()\valueD)
    EndIf
    entryCol(4) = constants()\valueS
   
    constants()\show = #True
    For i=0 To 4                                     ; each column/input field
      If equalsChecked(i)
        word = searchCol(i)
        If Len(word) And Not (LCase(entryCol(i)) = LCase(word)) ; exact match (case insensitive)
          constants()\show = #False
        EndIf
      Else
        For w=1 To CountString(searchCol(i), " ") + 1  ; each word in current input field
          word = StringField(searchCol(i), w, " ")
          If Len(word) And Not (FindString(entryCol(i), word, 1, #PB_String_NoCase)) ; find word
            constants()\show = #False
          EndIf
        Next
      EndIf
    Next
   
    If constants()\show
      ; get column char length for formatting in tab 'text'
      For i=0 To 4
        l = Len(entryCol(i))
        If l > colCharLen(i)
          colCharLen(i) = l
        EndIf
      Next
    EndIf
  Next
 
  ; column titles/header for tab 'text'
  item = ""
  For i=0 To 4
    colTitle = "[" + GetGadgetItemText(listicon, -1, i) + "]"
    l = Len(colTitle)
    If l > colCharLen(i)
      colCharLen(i) = l
    EndIf
    If debugFormatChecked And i=0
      item + ";      " + LSet(colTitle,   colCharLen(i) + 3,   " ") + " ;  "
    Else
      item + LSet(colTitle,   colCharLen(i) + 3,   " ")
    EndIf
  Next
  AddGadgetItem(editor,   -1, item)
 
  ForEach constants()
    If constants()\show
      entryCol(0) = constants()\name
      entryCol(1) = Str(constants()\typeId) + " (" + constants()\typeName + ")"
      entryCol(2) = ""
      entryCol(3) = ""
      If constants()\typeId = #constTypeQuad
        entryCol(2) = Str(constants()\valueQ)
      ElseIf constants()\typeId = #constTypeDouble
        entryCol(3) = StrD(constants()\valueD)
      EndIf
      entryCol(4) = constants()\valueS
     
      item = ""
      For i=0 To 4
        item + entryCol(i) + #LF$
      Next
      AddGadgetItem(listicon, -1, item)
     
      item = ""
      For i=0 To 4
        If debugFormatChecked And i=0
          item + "Debug #" + LSet(entryCol(i),   colCharLen(i) + 3,   " ") + " ;  "
        Else
          item + LSet(entryCol(i),   colCharLen(i) + 3,   " ")
        EndIf
      Next
      AddGadgetItem(editor,   -1, item)
    EndIf
  Next
EndProcedure

Procedure SizeWindowHandler()
  Define w, h, wLink, hLink
  w = WindowWidth(win, #PB_Window_InnerCoordinate)
  h = WindowHeight(win, #PB_Window_InnerCoordinate)
  wLink = GadgetWidth(link)
  hLink = GadgetHeight(link)
  ResizeGadget(link, w-wLink, 2      , #PB_Ignore, #PB_Ignore)
  ResizeGadget(panel,      0, 2+hLink,          w, h-(2+hLink))
EndProcedure

Procedure SizePanelHandler()
  Define w, h, colx, colw, hInput, i
  w  = GetGadgetAttribute(panel, #PB_Panel_ItemWidth)
  h  = GetGadgetAttribute(panel, #PB_Panel_ItemHeight)
  hInput = 30
 
  colx = 0
  For i=0 To 4
    colw = GetGadgetItemAttribute(listicon, #Null, #PB_ListIcon_ColumnWidth, i)
    ResizeGadget(field(i),  colx,      0, colw, hInput)
    ResizeGadget(equals(i), colx, hInput, colw, hInput)
    colx + colw
  Next
 
  ResizeGadget(listicon, 0, 2*hInput, w, h-2*hInput)
 
  ResizeGadget(debugFormat,  0,      0, w, hInput)
  ResizeGadget(editor,       0, hInput, w, h-hInput)
EndProcedure

Procedure ColSizeHandler()
  Define colx, colw, hInput, i
  hInput = 30
  colx = 0
  For i=0 To 4
    colw = GetGadgetItemAttribute(listicon, #Null, #PB_ListIcon_ColumnWidth, i)
    ResizeGadget(field(i),  colx,      0, colw, hInput)
    ResizeGadget(equals(i), colx, hInput, colw, hInput)
    colx + colw
  Next
EndProcedure

Procedure inputHandler()
  populateGui()
EndProcedure

Procedure openGui()
 
  If #PB_Compiler_OS = #PB_OS_Linux
    font = LoadFont(#PB_Any, "monospace", 8)
  Else
    font = LoadFont(#PB_Any, "courier", 8)
  EndIf
 
  win = OpenWindow(#PB_Any, 100, 100, 800, 600, #PB_Compiler_Filename, #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
  link = HyperLinkGadget(#PB_Any, 800-450, 0, 450,20, "https://www.purebasic.com/documentation/reference/pbconstants.html", #Blue)
  panel = PanelGadget(#PB_Any, 0, 0, 10, 10) ;>
    AddGadgetItem(panel, -1, "table")        ;>
      Define i
      For i=0 To 4
        field(i) = StringGadget(#PB_Any,   0, 0, 10, 10, "")
        BindGadgetEvent(field(i), @ inputHandler(), #PB_EventType_Change)
        equals(i) = CheckBoxGadget(#PB_Any,   0, 0, 10, 10, "equals")
        BindGadgetEvent(equals(i), @ inputHandler(), #PB_EventType_LeftClick)
      Next
      listicon = ListIconGadget(#PB_Any, 0, 0, 10, 10, "Name",   300)
      AddGadgetColumn(listicon, 1,                     "Type",   100)
      AddGadgetColumn(listicon, 2,                     "as Quad",   100)
      AddGadgetColumn(listicon, 3,                     "as Double", 100)
      AddGadgetColumn(listicon, 4,                     "as String", 100)
    ;<
    AddGadgetItem(panel, -1, "text")                                   ;>
      editor = EditorGadget(#PB_Any, 0, 0, 10, 10)
      debugFormat = CheckBoxGadget(#PB_Any,   0, 0, 10, 10, "Debug Format")
      BindGadgetEvent(debugFormat, @ inputHandler(), #PB_EventType_LeftClick)
      SetGadgetFont(editor, FontID(font))
    ;<
  CloseGadgetList()                     ;<
 
  AddKeyboardShortcut(win, #PB_Shortcut_Escape, 10)
  SetActiveGadget(field(0))
  PostEvent(#PB_Event_SizeWindow)                                     ; trigger gui sizing
  ;PostEvent(#PB_Event_Gadget, win, field(0), #PB_EventType_Change)   ; trigger populate
EndProcedure

Procedure main()
 
  Debug "fetching.."
  getConstantList()
  Debug "sorting.."
  SortStructuredList(constants(), #PB_Sort_Ascending | #PB_Sort_NoCase, OffsetOf(sConstInfo\name), #PB_String)
  Debug "opening gui.."
  openGui()
  Debug "populating.."
  populateGui()
  Debug "entering main loop"
 
  Repeat
    WaitWindowEvent()
    If Event() = #PB_Event_SizeWindow
      SizeWindowHandler()
    ElseIf Event() = #PB_Event_Gadget And EventGadget() = panel And EventType() = #PB_EventType_Resize
      SizePanelHandler()
    ElseIf Event() = #PB_Event_Gadget And EventGadget() = listicon And EventType() = #PB_EventType_LeftClick
      ColSizeHandler()
    ElseIf Event() = #PB_Event_Gadget And EventGadget() = link And EventType() = #PB_EventType_LeftClick
      If #PB_Compiler_OS = #PB_OS_Linux
        RunProgram("xdg-open", GetGadgetText(link), "")
      Else
        RunProgram(GetGadgetText(link))
      EndIf
    EndIf
  Until (Event() = #PB_Event_CloseWindow) Or (Event() = #PB_Event_Menu And EventMenu() = 10)
EndProcedure

main()
;

Author:  davido [ Fri Jan 19, 2018 10:47 pm ]
Post subject:  Re: Constant Viewer

@NULL,

Tried it on my MacBook.
Appears to work ok.

Page 1 of 1 All times are UTC + 1 hour
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/