luxferre/StreamGoose
1
0
Fork 0
Code Actions Activity

Implemented basic GUI config in Tcl/Tk

Browse Source
This commit is contained in:
Luxferre
2024-09-30 20:22:49 +03:00
parent ff520f5dfb
commit 6b74664f6d
2 changed files with 3 additions and 195 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Makefile
+3 -3
View File
@@ -39,7 +39,7 @@ config-linux:
cd $(TCLDIR) && ./tclkit-linux64 ./sdx.kit qwrap conf.tcl -runtime tclruntime cd $(TCLDIR) && ./tclkit-linux64 ./sdx.kit qwrap conf.tcl -runtime tclruntime
mkdir -p $(DIST) mkdir -p $(DIST)
mv $(TCLDIR)/conf $(DIST)/$(CONFIGBINNAME) mv $(TCLDIR)/conf $(DIST)/$(CONFIGBINNAME)
rm $(TCLDIR)/tclruntime rm $(TCLDIR)/tclruntime $(TCLDIR)/conf.tcl
config-win64: config-win64:
cp $(SRC)/conf.tcl $(TCLDIR)/conf.tcl cp $(SRC)/conf.tcl $(TCLDIR)/conf.tcl
@@ -47,7 +47,7 @@ config-win64:
cd $(TCLDIR) && ./tclkit-win64.exe ./sdx.kit qwrap conf.tcl -runtime tclruntime.exe cd $(TCLDIR) && ./tclkit-win64.exe ./sdx.kit qwrap conf.tcl -runtime tclruntime.exe
mkdir -p $(DIST) mkdir -p $(DIST)
mv $(TCLDIR)/conf $(DIST)/$(CONFIGBINNAME).exe mv $(TCLDIR)/conf $(DIST)/$(CONFIGBINNAME).exe
rm $(TCLDIR)/tclruntime.exe rm $(TCLDIR)/tclruntime.exe $(TCLDIR)/conf.tcl
config-win64-cross: config-win64-cross:
cp $(SRC)/conf.tcl $(TCLDIR)/conf.tcl cp $(SRC)/conf.tcl $(TCLDIR)/conf.tcl
@@ -55,7 +55,7 @@ config-win64-cross:
cd $(TCLDIR) && ./tclkit-linux64 ./sdx.kit qwrap conf.tcl -runtime tclruntime.exe cd $(TCLDIR) && ./tclkit-linux64 ./sdx.kit qwrap conf.tcl -runtime tclruntime.exe
mkdir -p $(DIST) mkdir -p $(DIST)
mv $(TCLDIR)/conf $(DIST)/$(CONFIGBINNAME).exe mv $(TCLDIR)/conf $(DIST)/$(CONFIGBINNAME).exe
rm $(TCLDIR)/tclruntime.exe rm $(TCLDIR)/tclruntime.exe $(TCLDIR)/conf.tcl
dist: dist:
mkdir -p $(DIST) mkdir -p $(DIST)
tcldep/conf.tcl
-192
View File
@@ -1,192 +0,0 @@
#!/usr/bin/env tclsh
package require Tk
package require json
package require json::write
package require inifile
# overall vars
set appdir [ file dirname [ file normalize [ info script ] ] ]
# check if we're running from a starpack
if [string match *app-conf $appdir] {
set appdir [ file normalize [ file join $appdir ".." ".." ".." ] ]
}
puts "Working directory: $appdir"
set conffile [ file join $appdir "config.json" ]
set labelfile [ file join $appdir "labels.ini" ]
# main configuration read/write procedures
proc readrawjson {fname} {
# read the JSON contents
set fp [open $fname r]
set rawdata [read $fp]
close $fp
# parse the JSON contents
set confdict [::json::json2dict $rawdata]
return $confdict
}
proc readjson {fname} {
set confdict [readrawjson $fname]
# update the controls according to the configuration
dict for {vname vval} $confdict {
global conf_$vname
set conf_$vname $vval
}
return $confdict
}
proc dict2json {dictToEncode} {
::json::write object {*}[dict map {k v} $dictToEncode {
if [string is boolean -strict $v] {
set v $v
} elseif [string is integer -strict $v] {
set v $v
} else {
set v [::json::write string $v]
}
}]
}
proc writejson {fname} {
set confdict [readrawjson $fname]
dict for {vname vval} $confdict {
global conf_$vname
dict set confdict $vname [set conf_$vname]
}
set fdata [dict2json $confdict]
set fp [open $fname w]
puts $fp $fdata
close $fp
}
# dialog button helpers
proc rereadconfig {fname msg} {
set answer [tk_messageBox -message $msg -icon question -type yesno]
switch -- $answer {
yes {readjson $fname}
no {}
}
}
proc saveconfig {fname msg} {
set answer [tk_messageBox -message $msg -icon question -type yesno]
switch -- $answer {
yes {writejson $fname}
no {}
}
}
proc exitapp {fname msg} {
saveconfig $fname $msg
exit
}
# read GUI labels ini file
set lbls [::ini::open $labelfile r]
set backends [::ini::value $lbls general backends]
# overall provider tab layout
ttk::notebook .prov
foreach back $backends {
set framename .prov.$back
set tabname [::ini::value $lbls config.gui.$back tabtitle]
ttk::frame $framename
.prov add $framename -text $tabname
}
# General controls (need to be hardcoded)
set dbglbl [::ini::value $lbls config.gui.general debug]
set iplbl [::ini::value $lbls config.gui.general server_listen_ip]
set portlbl [::ini::value $lbls config.gui.general server_port]
set ualbl [::ini::value $lbls config.gui.general useragent]
ttk::checkbutton .prov.general.debugchk -text $dbglbl -variable conf_debug -onvalue true -offvalue false
ttk::label .prov.general.serviplbl -text $iplbl
ttk::entry .prov.general.serviptxt -textvariable conf_server_listen_ip -width 16
ttk::label .prov.general.servportlbl -text $portlbl
ttk::entry .prov.general.servporttxt -textvariable conf_server_port -width 5
ttk::label .prov.general.ualbl -text $ualbl
ttk::entry .prov.general.uatxt -textvariable conf_useragent -width 60
grid .prov.general.debugchk -column 0 -row 0 -sticky ne -ipadx 5 -ipady 5
grid .prov.general.serviplbl -column 1 -row 0 -sticky ne -ipadx 5 -ipady 5
grid .prov.general.serviptxt -column 2 -row 0 -sticky ew -padx 5 -pady 5
grid .prov.general.servportlbl -column 3 -row 0 -sticky ne -ipadx 5 -ipady 5
grid .prov.general.servporttxt -column 4 -row 0 -sticky ew -padx 5 -pady 5
grid .prov.general.ualbl -column 0 -row 2 -sticky ne -ipadx 5 -ipady 5
grid .prov.general.uatxt -column 1 -row 2 -sticky ew -columnspan 4 -padx 5 -pady 5
# backend config controls
foreach back $backends {
if {$back ne "general"} {
set section config.gui.$back
set params [::ini::keys $lbls $section]
set rowidx 1
foreach key $params {
if {$key ne "tabtitle"} {
set lbltext [::ini::value $lbls $section $key]
set cvarname [string cat conf_ $key]
set guiname .prov.$back.$key
if {$key eq [string cat $back _backend_enabled]} {
set chkname [string cat $guiname chk]
ttk::checkbutton $chkname -text $lbltext \
-variable $cvarname -onvalue true -offvalue false
grid $chkname -column 0 -row 0 -sticky ne -ipadx 5 -ipady 5
} else {
set ewidth 40
set lblname [string cat $guiname lbl]
set txtname [string cat $guiname txt]
ttk::label $lblname -text $lbltext
ttk::entry $txtname -textvariable $cvarname -width $ewidth
grid $lblname -column 0 -row $rowidx -sticky ne -ipadx 5 -ipady 5
grid $txtname -column 1 -row $rowidx -sticky ew -padx 5 -pady 5
}
incr rowidx
}
}
}
}
# lower button row
foreach lname {reset exit save credits savemodal resetmodal} {
set vname [string cat $lname lbl]
set $vname [::ini::value $lbls config.gui.general $lname]
}
ttk::frame .btns -padding 4
ttk::button .btns.reset -text $resetlbl -command {rereadconfig $conffile $resetmodallbl}
ttk::button .btns.exit -text $exitlbl -command {exitapp $conffile $savemodallbl}
ttk::button .btns.save -text $savelbl -command {saveconfig $conffile $savemodallbl}
ttk::label .btns.lbl -text $creditslbl
pack .btns.save -side right -padx 3 -pady 3
pack .btns.exit -side right -padx 3 -pady 3
pack .btns.reset -side right -padx 3 -pady 3
pack .btns.lbl -side left -padx 3 -pady 3
# place the tabs and buttons
grid .prov -column 0 -row 0 -sticky nsew
grid .btns -column 0 -row 1 -sticky sew
# root grid geometry: don't resize the button row
grid columnconfigure . 0 -weight 1
grid rowconfigure . 0 -weight 1
grid rowconfigure . 1 -weight 0
# iterate over available platform-dependent themes, apply "clam" if none found
ttk::style theme use clam
catch {ttk::style theme use gtkTtk}
catch {ttk::style theme use aqua}
catch {ttk::style theme use winnative}
catch {ttk::style theme use vista}
wm title . "StreamGoose config"
catch {wm title . [::ini::value $lbls config.gui.general windowtitle]}
# stop working with the labels file
::ini::close $lbls
# read the initial config
readjson $conffile