forked from dzach/nrfmon
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathnrfmon.tcl
executable file
·3474 lines (3226 loc) · 108 KB
/
nrfmon.tcl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
#!/usr/bin/env tclsh8.6
## ------------------------------------------------------
## A software spectrum analyzer for the RF12B radio module
## For the latest code, visit https://github.com/dzach/nrfmon
## (C) 2013, D.Zachariadis
## Licensed under the GPLv3
## ------------------------------------------------------
# The transceiver can be in one of the following states:
# 0. Disconnected
# 1. Port open
# 2. Connected, Scanning
# 3. Receiving data
# 4. Transmitting
# Special symbols used:
# ●\u25CF Anouncement
# ■\u25A0
# ♦\u2666
# █\u2588 Error
# ▼\u25BC
# ▲\u25B2
# ►\u25BA prompt
# ◄\u25C4
# ϟ\u03DF user action
# Δ\u0394
# ÷\u00F7
#
proc ::init {} {
if {[catch {
package req Tk
}]} {
exit
}
wm withdraw .
if {[file tail $::argv0] eq "main.tcl"} {
# we are running inside a tclkit
cd [file dir [file dir $::argv0]]
} elseif {[info script] ne ""} {
# we are running as script
cd [file dir [info script]]
} else {
cd [file dir [pwd]]
}
}
#
init
namespace eval ::mon {
# namespace ::mon
proc advanceLine {} {
variable var
set var(r) [expr {($var(r) + 1) % $var(wf,H)}]
$var(wfi) put #000 -to 0 $var(r) $var(wf,W) $var(r)
}
# namespace ::mon
proc avgList list {
expr double([::tcl::mathop::+ {*}$list])/[llength $list]
}
# namespace ::mon
proc buildBinds {} {
variable var
set W $var(scr)
bind $W <Motion> [list [namespace current]::onEvent Motion %x %y %s]
bind $W <1> [list [namespace current]::onEvent B1 %x %y %X %Y %s]
bind $W <3> [list [namespace current]::onEvent B3 %x %y %X %Y %s]
bind $W <ButtonRelease-1> [list [namespace current]::onEvent B1R %x %y %s]
bind $W <Button-4> {
event generate %W <<MouseWheel>> -data 120 -x %x -y %y -state %s
break
}
bind $W <Button-5> {
event generate %W <<MouseWheel>> -data -120 -x %x -y %y -state %s
break
}
bind $W <<MouseWheel>> "
[namespace current]::onEvent Wheel %x %y %s %d
break
"
$W bind M <Button-4> {
event generate %W <<MouseWheel>> -data 120 -x %x -y %y -state %s
break
}
$W bind M <Button-5> {
event generate %W <<MouseWheel>> -data -120 -x %x -y %y -state %s
break
}
$W bind M <<MouseWheel>> "
[namespace current]::onEvent MarkWheel %x %y %s %d
break
"
bind $var(evente) <Key> "
if {\"%K\" eq \"Return\" || \"%K\" eq \"KP_Enter\"} {
[namespace current]::setEventText
}
"
bind $W <<ValueChanged>> "[namespace current]::onValueChange %d"
bind $var(top) <<PortChanged>> [list [namespace current]::onChange port %d]
bind $var(top) <<SettingsChanged>> [list [namespace current]::onChange %d]
bind $var(top) <Control-Key-1> [list [namespace current]::zoneSelect reset]
}
# namespace ::mon
proc buildCmdFieldWidget {W f data} {
## builds a command field widget
variable var
set uw 4
set fw 16
set i 1
set cnt 0
lassign [split $f ,] field ctl
pack [set w [::ttk::frame $W.f$f -padding {0 0}]] -anchor w -side top -fill x
switch -glob -nocase -- [dict get $data type] {
cho* {
set vw 0
set opts [dict keys [dict get $data opts]]
# calculate width of combobutton
foreach op $opts {
if {[string match -* $op]} continue
if {[string length $op] > $vw} {
set vw [string length $op]
}
}
set valwidg [::ttk::combobox $w.cb$f -textvariable [namespace current]::var(xcvr,$f) -values $opts -justify right -validate key -validatecommand {expr 0}]
set vw [expr {$vw * 0.7}]
if {$vw < 4} {set vw 4}
}
bool* {
set vw 0
set valwidg [::ttk::checkbutton $w.cbt$f -variable [namespace current]::var(xcvr,$f) -padding 0 -width 0]
}
scal* - entr* {
set vw [string length [dict get $data def]]
if {[string match "entr*" [dict get $data type]]} {
set state "normal"
} else {
set state "readonly"
}
set valwidg [::ttk::spinbox $w.sb$f -textvariable [namespace current]::var(xcvr,$f) -from [dict get $data from] -to [dict get $data to] -increment [dict get $data incr] -justify right -validate key -validatecommand "
[namespace current]::validateScalar %P
" -state $state]
}
func* {
set valwidg [::ttk::label $w.t$f -anchor e -textvariable [namespace current]::var(xcvr,$f)]
set vw [expr {21 - [string length [dict get $data desc]]}]
}
}
set val [dict get $data def]
if {[dict exists $data format]} {
set var(xcvr,$f) [format [dict get $data format] $val]
} else {
set var(xcvr,$f) $val
}
# auto calculate widget widths
pack [::ttk::label $w.l$f -text "[dict get $data desc]:" -anchor w] -side left -anchor w
pack [::ttk::label $w.u$f -text "[dict get $data units]" -width $uw -anchor w] -side right -anchor w
$valwidg config -width [expr {round(([dict exists $data width] ? [dict get $data width] : $vw) * 0.9)}] -state [expr {[dict exists $data state]? [dict get $data state] : {}}]
pack $valwidg -anchor w -side right
incr cnt
}
# namespace ::mon
proc buildCmdWidget {W datavar ctl args} {
# builds a widget in a labeled frame. The expected structure of the data is:
# set var($var) {
# $ctl {
# cmd 0xdddd desc <string> def <value>
# field0 {
# lsb <n>
# type ?choice | boolean | analog?
# opts {name idx}
# }
# field1 {...}
# }
# }
variable var
upvar $datavar data
# we just need this control word, not all
set control [dict get $data cmds $ctl]
set uw 4
set fw 16
set i 1
set cnt 0
pack [set W [::ttk::frame $W.f$ctl -padding {5 5} -borderwidth 1 -relief ridge]] -anchor nw -padx 0 -side top -fill x -expand 1
# choose only actual xcvr fields, in title format, not other data.
foreach field [dict keys $control "\[A-Z]*"] {
pack [set w [::ttk::frame $W.f$field -padding {0 0}]] -anchor w -side top -fill x
switch -glob -nocase -- [dict get $control $field type] {
cho* {
set vw 0
set opts [dict keys [dict get $control $field opts]]
# calculate width of combobutton
foreach op $opts {
if {[string match -* $op]} continue
if {[string length $op] > $vw} {
set vw [string length $op]
}
}
set valwidg [::ttk::combobox $w.cb$field -textvariable [namespace current]::var(xcvr,$ctl,$field) -values $opts -justify right -validate key -validatecommand {expr 0}]
set vw [expr {$vw * 0.7}]
if {$vw < 4} {set vw 4}
}
bool* {
set vw 0
set valwidg [::ttk::checkbutton $w.cbt$field -variable [namespace current]::var(xcvr,$ctl,$field) -padding 0 -width 0]
}
scal* - entr* {
set vw [string length [dict get $control $field def]]
if {[string match "entr*" [dict get $control $field type]]} {
set state "normal"
} else {
set state "readonly"
}
set valwidg [::ttk::spinbox $w.sb$field -textvariable [namespace current]::var(xcvr,$ctl,$field) -from [dict get $control $field from] -to [dict get $control $field to] -validate key -validatecommand "
[namespace current]::validateScalar %P
" -state $state]
}
func* {
set valwidg [::ttk::label $w.t$field -anchor e -textvariable [namespace current]::var(xcvr,$ctl,$field)]
set vw [expr {21 - [string length [dict get $control $field desc]]}]
}
}
set val [dict get $control $field def]
if {[dict exists $control $field format]} {
set var(xcvr,$ctl,$field) [format [dict get $control $field format] $val]
} else {
set var(xcvr,$ctl,$field) $val
}
# auto calculate widget widths
pack [::ttk::label $w.l$field -text "[dict get $control $field desc]:" -anchor w] -side left -anchor w
pack [::ttk::label $w.u$field -text "[dict get $control $field units]" -width $uw -anchor w] -side right -anchor w
$valwidg config -width [expr {round($vw * 0.9)}]
pack $valwidg -anchor w -side right
incr cnt
}
update
return $cnt
}
# namespace ::mon
proc buildColorField {W field desc} {
variable var
lassign [split [string tolower $field] ,] f f t
# set t [string range $t 0 2]
pack [set w [::ttk::frame $W.${t}[string index $f 0]f]] -side top -anchor nw -fill x
pack [::ttk::label $w.${t}l -text $desc] -side left -anchor w -fill x -expand 1
set var(tmp,$field) $var($field)
pack [::ttk::entry $w.${t}e -width 7 -textvariable [namespace current]::var(tmp,$field) -validate key -validatecommand [list [namespace current]::onMonEntry %W %P]] -side left
}
# namespace ::mon
proc buildCon W {
variable var
# the console widget
pack [set var(con) [text $W.con -highlightcolor #246 -highlightthickness 1 -font {TkFixedFont -10} -height 1 -background #fff]] -fill both -side bottom -expand 1
bind $var(con) <Key> [list [namespace current]::onConKey %K %s]
$var(con) tag config resp -foreground #058
$var(con) tag config send -foreground #b74
$var(con) tag config user -foreground #7b4 -font {TkFixedFont -10 bold}
$var(con) tag config state -foreground #000
$var(con) tag config error -foreground #800
pack [::ttk::frame $W.f1] -anchor nw -side bottom -fill x
pack [::ttk::checkbutton $W.f1.trfvcb -text "Traffic" -variable [namespace current]::var(traffic,on)] -side left
pack [::ttk::checkbutton $W.f1.usrcb -text "User actions" -variable [namespace current]::var(user,on)] -side left -padx 5
pack [::ttk::button $W.f1.clrb -text "Clear" -image [namespace current]::clear_img -style nobd.TButton -command "
$var(con) delete 0.0 end
[namespace current]::prompt
after 10 [list focus $var(con)]
" -padding 0] -side right
}
# namespace ::mon
proc buildControls W {
variable var
# create controls
pack [::ttk::frame $W.pf] -fill x
pack [::ttk::label $W.pf.portl -text "Port:" -padding 0] -anchor w -side left
pack [::ttk::label $W.pf.hwl -text "" -textvariable [namespace current]::var(hw)] -side right -fill x
pack [set var(port,wg) [::ttk::combobox $W.portcb -textvariable [namespace current]::var(portname) -values [enumerate ports] -postcommand "
$W.portcb config -values \[[namespace current]::enumerate ports]
"]] -anchor nw -fill x
bind $W.portcb <<ComboboxSelected>> [namespace current]::portSetup
bind $W.portcb <Return> [namespace current]::portSetup
bind $W.portcb <KP_Enter> [namespace current]::portSetup
pack [set w [::ttk::frame $W.scf -padding {2 5}]] -anchor nw
pack [set ww [::ttk::frame $w.row1 -padding {0 2}]] -anchor nw
pack [set var(scanb) [::ttk::radiobutton $ww.scanb -style bold.TButton -text "Scan" -variable [namespace current]::var(bstate) -value "2" -command [namespace current]::toggleCmdButton -width 8 -padding {0 3}]] -anchor w -fill x -side left -padx 2
pack [set var(lisnb) [::ttk::radiobutton $ww.lisnb -style bold.TButton -text "Listen" -variable [namespace current]::var(bstate) -value "3" -command [namespace current]::toggleCmdButton -width 8 -padding {0 3}]] -anchor w -fill x -side left -padx 2
pack [set ww [::ttk::frame $w.row2 -padding {0 2}]] -anchor nw
pack [set var(xmitb) [::ttk::radiobutton $ww.bertb -style bold.TButton -text "Xmit" -variable [namespace current]::var(bstate) -value "4" -command [namespace current]::toggleCmdButton -width 8 -padding {0 3}]] -anchor w -fill x -side left -padx 2
pack [::ttk::button $ww.clrb -text "Clear scr" -command [list [namespace current]::clear screen] -width 11 -padding {1 2}] -anchor w -fill x -side left -padx 2
pack [set ww [::ttk::frame $w.row3 -padding {0 2}]] -anchor nw
set var(quietrb) $ww.quietrb
pack [::ttk::checkbutton $ww.quietrb -text "Quiet Rx" -style norm.TButton -padding {1 4} -variable [namespace current]::var(quiet,on) -width 11 -command "
[namespace current]::setQuiet $ww.quietrb
"] -anchor w -fill x -side left -padx 2
pack [::ttk::checkbutton $ww.pausrb -text "Pause Rx" -style norm.TButton -variable [namespace current]::var(pause,on) -width 11 -padding {1 4} -command "
[namespace current]::Pause $ww.pausrb
"] -anchor w -fill x -side left -padx 2
set w [::ttk::labelframe $W.spf -text "Spectrum:" -padding {5 2}]
pack $w -side top -fill x -pady 0 -anchor nw
pack [set f [::ttk::frame $w.cstf]] -fill x
pack [::ttk::checkbutton $f.alcb -text "Auto contrast" -onvalue on -offvalue off -variable [namespace current]::var(alc,on) -command "
if {\$[namespace current]::var(evealc,on)} {
[namespace current]::drawMark \"Auto contrast \$[namespace current]::var(alc,on)\" -tag 1
set [namespace current]::var(maxrssi) 1
}
" -padding {0 0}] -anchor w -side left -fill x -expand 1
pack [::ttk::label $f.cstl -text "Exp:"] -side left -anchor w
pack [::ttk::spinbox $f.csts -width 3 -from 0.1 -to 5.0 -incr 0.1 -textvariable [namespace current]::var(xcvr,nRfMon,Cst)] -side left -anchor w
set wf [::ttk::frame $w.f1]
pack $wf -anchor w -fill x
pack [::ttk::label $wf.avgsl -text "Spectrum averaging:" -padding 0] -anchor w -side left
pack [::ttk::spinbox $wf.avgsb -width 3 -from 1 -to 99 -increment 1 -textvariable [namespace current]::var(spec,avgln)] -anchor e -side right
pack [::ttk::frame $w.mxf] -anchor w
pack [::ttk::checkbutton $w.mxf.pkcb -text "Show peak" -width 10 -padding 0 -variable [namespace current]::var(peak,on) -command "
if {\$[namespace current]::var(peak,on)} {
\$[namespace current]::var(scr) itemconfig maxrssi -state normal
} else {
\$[namespace current]::var(scr) itemconfig maxrssi -state hidden
}
"] -anchor w -side left
pack [::ttk::checkbutton $w.mxf.mxcb -text "Hold max" -padding 0 -variable [namespace current]::var(maxs,on) -command "
[namespace current]::resetMaxs
"] -anchor w -side left
pack [::ttk::frame $w.rxf] -anchor w
pack [::ttk::checkbutton $w.rxf.bwcb -text "Rx Bw" -padding 0 -variable [namespace current]::var(bw,on) -command "
if {\$[namespace current]::var(bw,on)} {
\$[namespace current]::var(scr) itemconfig BWr -state normal
} else {
\$[namespace current]::var(scr) itemconfig BWr -state hidden
}
" -width 10] -anchor w -side left
pack [::ttk::checkbutton $w.rxf.spcb -text "Spectrum" -padding 0 -variable [namespace current]::var(SP,on) -command "
if {\$[namespace current]::var(SP,on)} {
\$[namespace current]::var(scr) itemconfig SP -state normal
} else {
\$[namespace current]::var(scr) itemconfig SP -state hidden
}
"] -anchor w -side left
set wdth 7
pack [::ttk::label $w.sll -text "Show signal strength:"] -anchor w -side top
pack [::ttk::frame $w.of] -anchor w
pack [::ttk::radiobutton $w.of.noslrb -text "Off" -value 0 -width $wdth -padding {8 0} -variable [namespace current]::var(sl,on)] -anchor w -side left
pack [::ttk::radiobutton $w.of.cucb -text "Cursor" -value 1 -width $wdth -padding {8 0} -variable [namespace current]::var(sl,on)] -anchor w -side top
pack [::ttk::frame $w.zo] -anchor w
pack [::ttk::radiobutton $w.zo.chrb -text "Channel" -value 2 -width $wdth -padding {8 0} -variable [namespace current]::var(sl,on)] -anchor w -side left
pack [::ttk::radiobutton $w.zo.zorb -text "Zone" -value 3 -width $wdth -padding {8 0} -variable [namespace current]::var(sl,on)] -anchor w -side left
set w $W.mrkf
pack [::ttk::labelframe $w -text "Marks:" -padding {5 2}] -side top -fill x -pady 5 -anchor nw
pack [::ttk::checkbutton $w.mklncb -text "Show mark lines" -variable [namespace current]::var(marklines,on) -command "
if {\$[namespace current]::var(marklines,on)} {
$var(scr) itemconfig Ml -state normal
} else {
$var(scr) itemconfig Ml -state hidden
}
" -padding 0] -anchor w
pack [::ttk::label $w.automl -text "Auto mark changes of:" -padding {0 0}] -anchor nw
pack [::ttk::checkbutton $w.pchcb -text "transceiver settings" -variable [namespace current]::var(evepch,on) -padding {15 0}] -anchor w
pack [::ttk::checkbutton $w.alccb -text "auto contrast setting" -variable [namespace current]::var(evealc,on) -padding {15 0}] -anchor w
buildCon $W
}
# namespace ::mon
proc buildImages {} {
variable var
# create event deleting widget image
catch {image delete [namespace current]::x_img}
image create photo [namespace current]::x_img -data {
R0lGODlhDQAMAIQQAAABABIUESYoJU9RTlhaV2RlY3Z4dY2PjJWXlJ2fnKWn
pNTX0+Di3+bo5efp5vz++///////////////////////////////////////
/////////////////////////yH5BAEKAAwALAAAAAANAAwAAAVCIPOITFmO
Y7kUCaoUi/kMANAm9ZA+Rg0cPkNKRPDVCMMTLZdU+nSmU9GIlBV8wFohtfAp
HgpfTCT4oYCC4aOhdqRCADs=
}
# create cursor image
catch {image delete [namespace current]::cross_img}
image create photo [namespace current]::cross_img -data {
R0lGODlhDwAPAIABAMzMzAAAACH5BAEKAAEALAAAAAAPAA8AAAIYjI+pAbvt
Eoxn0osN2JbxDF5dNDrlEy4FADs=
}
catch {image delete [namespace current]::clear_img}
image create photo [namespace current]::clear_img -data {
R0lGODlhEwATAMIEAAAAAAEBATNmM+fn5////////////////yH5BAEKAAcA
LAEAAQARABEAAAMveAHc3kENQqutY91tGf/et4ViB5QXiRIq2pavGIMnIdw3
TeE5N/uBySqjeBgZkQQAOw==
}
catch {image delete [namespace current]::nrfmon_img}
image create photo [namespace current]::nrfmon_img -data {
R0lGODdhTwAXAOMQAAABAAkJEyESAD0hACQlRXA7AEVHg1RTnpdQAK9cAGBj
uXBy19dyAO1+AIaF+v+GACwAAAAATwAXAAAE/hDISau9OOvNu/9gKI5kaZ5o
qq5s676ZsTgOAbsKrSu2RNCKQ+DWyuloi4mBRizNDjLHYWKUHGhDo07CeCAQ
jUYBkGgwxpNCt5EYTLoJMHs0Q9IMkirg6hge6gtJAGsPhQ9dhgISCIUMDYVu
g4VmhQgidVkOgkZ1NUpMbw8NAgKTpIVjpV4SjwxcohIJh5cOClaaeUeaQxJL
DhRwrKsAqAAFkIuFrwnJriFPt5tMP7i9oK+WAI/ZxccPkYwP2MkNtFN71Xq+
Pb7Aw9sSxarZreMAjOXPUtG5vwABSKz5sweP2AM04Rwhk5QNnzl+APQAWDfx
GkNh3A6mWdMmVENYD01CihxJsqTJkyhTqjwZAQA7
}
}
# namespace ::mon
proc buildPopup {{W .mon}} {
variable var
#popup window
catch {
destroy $W.popup
}
set var(popup) [menu $W.popup -bg #f0f0f0 -bd 1 -tearoff 0 -activeborderwidth 0 -font {TkDefaultFont -11} -postcommand {} -relief raised -tearoff 0 -title "Commands"]
$var(popup) add command -label "Mark time" -command "
lassign \$[namespace current]::var(popup,xy) x y
[namespace current]::mark TMark \$x \$y
"
$var(popup) add command -label "Mark freq." -command "
lassign \$[namespace current]::var(popup,xy) x y
[namespace current]::mark FMark \$x \$y
"
$var(popup) add command -label "Mark event" -command "
lassign \$[namespace current]::var(popup,xy) x y
[namespace current]::mark Event \$x \$y
"
$var(popup) add command -label "Mark port" -command "
lassign \$[namespace current]::var(popup,xy) x y
[namespace current]::mark Port \$x \$y
"
$var(popup) add separator
$var(popup) add command -label "Limit scan width" -command [list [namespace current]::zoneSelect start]
$var(popup) add command -label "Full scan width" -command [list [namespace current]::zoneSelect reset]
$var(popup) add separator
$var(popup) add command -label "Clear mark" -command [list [namespace current]::editMark Delete]
$var(popup) add command -label "Clear marks" -command [list [namespace current]::clear marks]
$var(popup) add command -label "Clear all" -command [list [namespace current]::clear all]
}
# namespace ::mon
proc buildPrefs {{W .prefs}} {
variable var
destroy $W
toplevel $W
#wm geometry $W 480x320
wm title $W "rf12mon preferences"
set w $W.nb
pack [::ttk::notebook $w] -fill both -expand 1
# build tabs
foreach f {ports controls colors} {
set fw [::ttk::frame $w.[string range $f 0 2]f]
$w add $fw -text [string totitle $f]
}
# build lines
set w $w.porf
pack [::ttk::frame $w.tf]
foreach {p ww} {name 15 speed 8 desc 20 use 0} {
pack [::ttk::label $w.tf.[string range $p 0 1]l -text $p -width $ww] -side left -anchor w
}
set i 1
foreach p [enumerate ports] {
pack [::ttk::frame $w.line$i] -fill x
pack [::ttk::label $w.line$i.pl -text $p -width 15] -side left
pack [::ttk::combobox $w.line$i.cb -textvariable [namespace current]::var(portspeed) -values [set [namespace current]::var(portspeeds)] -width 6] -anchor w -side left
pack [::ttk::entry $w.line$i.pe -width 20 -textvariable [namespace current]::var(port,desc,$p)] -side left
set [namespace current]::var(port,use,$p) 1
pack [::ttk::checkbutton $w.line$i.pu -variable [namespace current]::var(port,use,$p) -padding 2] -side left -anchor c
incr i
}
}
# namespace ::mon
proc buildQuickSettings W {
variable var
set w $W.qf
::ttk::frame $w -style light.TFrame
$W add $w -text "Quick settings"
## the Quick Settings pane contains selected fields from various commands
set i 0
set x 0
foreach {t fs} {
Receiver {FSC,Freq FSC,F CSC,FB RCC,BW RCC,LNA RCC,RSSI}
Transmitter {TXC,Pwr TXC,M DRC,R DRC,BR }
{AFC} {AFC,A AFC,Rl AFC,Fi}
} {
## create a container for the fields
place [set lf [::ttk::frame $w.f$i-$x -borderwidth 1 -relief ridge -padding 5]] -x $x -y 0 -width 210 -height 132
## insert the fields in the container
foreach f $fs {
lassign [split $f ,] C field
buildCmdFieldWidget $lf $f [dict get $var(rf12b) cmds $C $field]
}
incr x 210
}
place [set lf [::ttk::frame $w.f$i-$x -borderwidth 1 -relief ridge -padding 5]] -x $x -y 0 -width 210 -height 132
set w $lf.txset
pack [::ttk::frame $w -padding 0] -side top -fill x
pack [::ttk::button $w.prnb -text "Print RFM12B cmds" -padding {4 4} -command "
[namespace current]::print
"] -anchor w -padx 5 -pady 0 -side left
set w $lf.datf
pack [::ttk::frame $w -padding 0] -fill x -pady 5
pack [::ttk::label $w.datl -text "Print packet data as:" -padding {}] -anchor w -side left
pack [::ttk::combobox $w.datcb -textvariable [namespace current]::var(data,prnt) -values $var(data,prntvals) -width 4 -justify right] -anchor w -side left -padx 5
}
# namespace ::mon
proc buildRfMonSettings W {
variable var
set f [::ttk::frame $W.rfmf -padding 0]
$W add $f -text "nRfMon settings"
set width 168
set x 0
place [set ff [::ttk::frame $f.wff -borderwidth 1 -relief ridge -padding 5]] -x [expr {$width * $x}] -y 0 -width $width -height 132
pack [set w [::ttk::frame $ff.expf]] -side top -anchor nw -fill x
pack [::ttk::label $w.cstl -text "Waterf. color exp.:"] -side left -anchor w -fill x -expand 1
pack [::ttk::spinbox $w.csts -width 3 -from 0.1 -to 5.0 -incr 0.1 -textvariable [namespace current]::var(xcvr,nRfMon,Cst)] -side left -anchor w
pack [set w [::ttk::frame $ff.whtf]] -side top -anchor nw -fill x
pack [::ttk::label $w.whtl -text "Waterfall white:"] -side left -anchor w -fill x -expand 1
pack [::ttk::spinbox $w.whts -width 3 -from 0 -to 255 -incr 1 -textvariable [namespace current]::var(xcvr,nRfMon,Wht)] -side left -anchor w
foreach {field desc} {
color,fill,cscl "Scan line:"
color,fill,SL "Signal:"
color,fill,SP "Spectrum fill:"
color,outline,SP "Spectr. outline:"
} {
buildColorField $ff $field $desc
}
incr x
place [set ff [::ttk::frame $f.spf -borderwidth 1 -relief ridge -padding 5]] -x [expr {$width * $x}] -y 0 -width $width -height 132
foreach {field desc} {
color,fill,fl "Frame line:"
color,fill,gl "Grid line:"
color,fill,gt "Grid text:"
color,fill,curs "Cursor lines:"
color,fill,BWr "Freq. cursor:"
color,fill,BWa "Freq. indicator:"
} {
buildColorField $ff $field $desc
}
incr x
place [set ff [::ttk::frame $f.mf -borderwidth 1 -relief ridge -padding 5]] -x [expr {$width * $x}] -y 0 -width $width -height 132
foreach {field desc} {
color,fill,SPM "Hold max:"
color,fill,SZ "Scan zone:"
color,outline,maxrssir "Peak marker:"
color,outline,xmit "Xmit outline:"
color,fill,xmit "Xmit fill:"
color,fill,PER "BER line:"
} {
buildColorField $ff $field $desc
}
incr x
place [set ff [::ttk::frame $f.ber -borderwidth 1 -relief ridge -padding 5]] -x [expr {$width * $x}] -y 0 -width $width -height 132
foreach {field desc} {
color,fill,ber000 "BER 0:"
color,fill,ber001 "BER 1:"
color,fill,ber010 "BER crc 0:"
color,fill,ber011 "BER crc 1:"
color,fill,ber100 "BER err. 0:"
color,fill,ber101 "BER err. 1:"
} {
buildColorField $ff $field $desc
}
incr x
place [set ff [::ttk::frame $f.rest -borderwidth 1 -relief ridge -padding 5]] -x [expr {$width * $x}] -y 0 -width $width -height 132
foreach {field desc} {
color,fill,mspl "Data text color:"
} {
buildColorField $ff $field $desc
}
}
# namespace ::mon
proc buildScreen W {
# variable var
variable var
pack [canvas $W -background black -width $var(c,W) -height $var(c,H) -xscrollincrement 1 -yscrollincrement 1] -side top -anchor nw -fill x
# to ease positioning on the canvas, we'll keep the upper left origin and create the margins by shifting the canvas down and to the right
$W xview scroll -$var(left,margin) u
$W yview scroll -$var(top,margin) u
# mark editing entry widget, initially hidden
::ttk::frame $W.edf
set var(evente) [::ttk::entry $W.edf.ede -width 15 -font {TkDefaultFOnt -9} -textvariable [namespace current]::var(edetxt)]
pack $var(evente) -side left -anchor w
pack [::ttk::button $W.edf.clr -image [namespace current]::x_img -padding 0 -command "
[namespace current]::editMark delete
"] -side left -anchor w
set var(eventi) [$W create window 0 480 -window $W.edf -tags {EE fx NO} -state hidden -anchor w]
# waterfall blank image
set var(wfi) [image create photo [namespace current]::wf]
$var(wfi) config -width $var(wf,W) -height $var(wf,H)
# black backround
$var(wfi) put #000 -to 0 0 $var(wf,W) $var(wf,H)
# put waterfall image on the screen canvas
$W create image 0 0 -image $var(wfi) -anchor nw -tags {wfi fx NO}
# put the image cursor on the canvas but hide it
$W create image 0 0 -image [namespace current]::cross_img -anchor center -tags {cross fx NO}
# logo
$W create image 0 0 -image ::mon::nrfmon_img -tags nrfmon -anchor se -tags {nrfmon fx NO}
# create the specraline
$W create line 0 0 0 0 -fill $var(color,fill,SL) -tags {SL fx NO}
drawScreen $W
drawBER $W
}
# namespace ::mon
proc buildSettings W {
variable var
buildXcvrSettings $W
buildQuickSettings $W
buildRfMonSettings $W
# select the 'quick settings' panel
$W select 1
}
# namespace ::mon
proc buildTop {{W .mon}} {
variable var
destroy $W
catch {
image delete [namespace current]::wf
}
if {$W eq "."} {
set W ""
} else {
destroy $W
toplevel $W
}
buildImages
set var(top) $W
wm title $W $var(title)
wm geometry $W $var(win,W)x$var(win,H)
wm protocol $W WM_DELETE_WINDOW [namespace current]::quit
wm resizable $W 0 1
::ttk::style theme use clam
::ttk::style configure bold.TButton -font {TkDefaultFont -14 bold} -foreground #444 -bordercolor #888
::ttk::style map bold.TButton -foreground {active #f22}
::ttk::style configure active.bold.TButton -foreground #f22
::ttk::style map active.bold.TButton -foreground {active #444}
::ttk::style configure norm.TButton -foreground #444 -bordercolor #888 -font {TkDefaultFont -11}
::ttk::style map norm.TButton -foreground {active #088}
::ttk::style configure active.norm.TButton -foreground #088 -font {TkDefaultFont -11}
::ttk::style map active.norm.TButton -foreground {active #444}
::ttk::style configure TCombobox -foreground #00f
::ttk::style configure TEntry -foreground #00f
::ttk::style config TSpinbox -padding {4 0 4 0} -arrowsize 8 -foreground #00f
::ttk::style config TCheckbutton -padding 0
::ttk::style config smallBold.TLabel -font {TkDefaultFont -10 bold}
::ttk::style config bold.TLabel -font {TkDefaultFont -11 bold}
::ttk::style config light.TFrame -background #eee
::ttk::style config red.TCombobox -fieldbackground #f88
::ttk::style config green.TCombobox -fieldbackground #8f8
::ttk::style config cyan.TCombobox -fieldbackground #8ff
::ttk::style config orange.TCombobox -fieldbackground #fc8
::ttk::style configure nobd.TButton -relief flat -padding 0 -border 0
font configure TkDefaultFont -size -11
font configure TkTextFont -size -11
# main sections of top window
# left section
pack [::ttk::frame $W.lf] -side left -expand 1 -fill both -anchor nw
# top left section, the screen canvas
set var(scr) $W.lf.c
buildScreen $var(scr)
# bottom top section, the settings
pack [set var(setnb) [::ttk::notebook $W.lf.setnb]] -fill both -expand 1
# general tools and parameters
buildSettings $var(setnb)
# right section
pack [::ttk::frame $W.rf -relief ridge -borderwidth 1 -padding 3] -side top -expand 1 -fill both
# screen controls and command/log window
buildControls $W.rf
update
# other necessities
buildPopup
buildBinds
catch {
wm geometry $W $var(geometry)
}
}
# namespace ::mon
proc buildXcvrSettings W {
variable var
set w [::ttk::frame $W.xcvrsetf]
$W add $w -text "Transceiver settings"
pack [::ttk::scrollbar $w.vsb -orient vertical -command [list $w.xcvrf yview]] -side right -fill y
pack [set c [canvas $w.xcvrf -background #eceae5 -yscrollcommand [list $w.vsb set] -xscrollincrement 1 -yscrollincrement 1]] -fill both -expand 1
bind $w.vsb <Button-4> {event generate %W <<MouseWheel>> -data 120 -x %x -y %y -state %s; break}
bind $w.vsb <Button-5> {event generate %W <<MouseWheel>> -data -120 -x %x -y %y -state %s; break}
bind $w.vsb <<MouseWheel>> "[namespace current]::onPanelEvent %W $c Wheel %x %y %s %d; break"
# position widgets on the 'Transceiver Settings' panel
lassign {0 0 0} x y curcol
array set col {x,0 0 x,1 205 x,2 410 x,3 615 y,0 0 y,1 0 y,2 0 y,3 0}
foreach C [dict keys [dict get $var(rf12b) cmds]] {
if {![string match "\[A-Z]*" $C] || [dict keys [dict get $var(rf12b) cmds $C] "\[A-Z]*"] eq {}} continue
pack [set lf [::ttk::frame $c.f$C -borderwidth 1 -relief ridge -padding 0]]
pack [::ttk::frame $lf.tf -padding 0] -fill x
pack [::ttk::label $lf.tf.lfl -text [dict get $var(rf12b) cmds $C desc] -width 21 -anchor w] -anchor nw -side left
pack [::ttk::button $lf.tf.lcmd -textvariable [namespace current]::var(xcvr,$C) -width 6 -style smallBold.TLabel -padding 0 -command "
[namespace current]::send \"\[scan \$[namespace current]::var(xcvr,$C) %x]r\"
"] -anchor sw -side right
foreach wg {.tf .tf.lfl .tf.lcmd} {
bind $lf$wg <Button-1> "[namespace current]::onPanelEvent %W $c B1 %x %y %s $C"
bind $lf$wg <Button1-Motion> "[namespace current]::onPanelEvent %W $c B1M %x %y %s $C"
bind $lf$wg <ButtonRelease-1> "+[namespace current]::onPanelEvent %W $c B1R %x %y %s $C"
}
buildCmdWidget $lf [namespace current]::var(rf12b) $C horiz
# find the shortest column and its y size
set curcol 0
for {set i 1} {$i < 4} {incr i} {
if {$col(y,$curcol) > $col(y,$i)} {set curcol $i}
}
# lassign [split [lindex [lsort -integer -stride 2 -index 1 [array get col y,*]] 0] ,] _ curcol
set y $col(y,$curcol)
incr y 5
lassign [split [winfo geo $lf] x+] width height
$c create window $col(x,$curcol) $col(y,$curcol) -anchor nw -window $lf -tags [list W $C $lf]
update
set col(y,$curcol) [expr {$col(y,$curcol) + $height + 5}]
set curcol [expr {($curcol + 1) % 4}]
}
set var(panel) $c
lassign [$w.xcvrf bbox all] x y e s
$w.xcvrf configure -scrollregion [list -3 -5 $e $s]
$w.xcvrf yview moveto 0.0
}
# namespace ::mon
proc chan2freq {ch {b {}}} {
variable var
if {$b eq ""} {
set b $var(xcvr,band)
}
expr {10 * [dict get $var(rf12b) bands $b c1] * ([dict get $var(rf12b) bands $b c2] + $ch/4000.0)}
}
# namespace ::mon
proc chan2scr {ch {b {}}} {
variable var
freq2scr [chan2freq $ch $b]
}
# namespace ::mon
proc clear what {
variable var
switch -glob -- $what {
"scr*" - "all" {
$var(wfi) put #000 -to 0 0 480 300
$var(scr) coords csal -1000 0 -1000 0
$var(scr) coords SP -1000 0 -1000 0
$var(scr) coords SPM -1000 0 -1000 0
$var(scr) delete M E
initFreqArray
}
"marks" {
$var(scr) delete M E
}
}
}
# namespace ::mon
proc colors {colors args} {
## given the number of desired colors, return a palette of colors, given a series of coordinates for an intensity curve
## we assume a 255 color palette
set step [expr {round(255.0 / $colors)}]
set palette {}
set args [lassign $args x1 y1]
foreach {x2 y2} $args {
set dn [expr {$x2 == $x1 ? 1 : $x2 - $x1}]
set a [expr {double($y2-$y1)/ $dn}]
for {set x $x1} {$x1 <= $x && $x <= $x2} {incr x $step} {
set y [expr {round($a * ($x - $x1) + $y1)}]
lappend palette $y
}
set x1 $x2
set y1 $y2
}
# lappend palette [format %02x $y2]
return $palette
}
# namespace ::mon
proc con {s {check 0}} {
variable var
set p [string index $s 0]
if {(! $var(traffic,on) && $p in "> < \u25BA") ||
(! $var(user,on) && $p eq "\u03df")
} {
return
}
$var(con) insert end-1line "$s\n"
set var(con,inputLine) [expr {int([$var(con) index "end-1line linestart"])}]
$var(con) see end
}
# namespace ::mon
proc createDimensions wfw {
# calculate screen dimensions depending on waterfall width
variable var
# the golden rule
set gr 1.618
# waterfall height
set wfh [expr {round($wfw / $gr)}]
# canvas height
set ch [expr {$wfw + $var(top,margin) + $var(bottom,margin)}]
# spactrum plot height (width is the same with waterfall)
set sah [expr {$wfw - $wfh}]
# canvas width
set cw [expr {round($wfw + $wfh + $var(mark,margin))}]
# window height
set toph [expr {$ch + $var(mark,margin)}]
# window width follows the golden rule, based on window height
return [list wf,W $wfw wf,H $wfh sa,H $sah sa,base $wfw c,W $cw c,H $ch win,W [expr {round($toph * $gr)}] win,H $toph sl,end [expr {$wfw + $sah + $var(sl,left)}]]
}
# namespace ::mon
proc createExpColors {{pow 1.5} {B 127} {colors 255}} {
variable var
for {set i 0} {$i <= $colors } {incr i} {
set c [expr {round($colors * double(pow($i,$pow)) / pow($colors,$pow))}]
if {$c <= $B} {
set b [expr {round($c * double($colors) / $B)}]
} else {
set b [expr {round($colors - ($c - $B) * $colors / double($colors - $B))}]
}
set c [format #%02x%02x%02x $c $c $b]
set var(wfcolor,$i) $c
set var(wfcol2sig,$c) $i
}
}
# namespace ::mon
proc cursor2event {tag tags} {
variable var
# arrow
$var(scr) create line [$var(scr) coords ${tag}a] {*}[dict merge [opts2dict $var(scr) ${tag}a] [list -tags [concat $tags Mal] -fill #fff]]
# frequency
set coords [$var(scr) coords ${tag}t]
$var(scr) create text $coords {*}[dict merge [opts2dict $var(scr) ${tag}t] [list -tags [concat $tags Mt] -fill #fff]]
if {$tag eq "tc"} {
$var(scr) create text $var(mark,start) [lindex $coords 1] {*}[dict merge [opts2dict $var(scr) ${tag}t] [list -tags [concat $tags Met] -fill #fff -text "Mark $var(markcnt)" -anchor w]]
}
# frequency line
$var(scr) create line [$var(scr) coords ${tag}l] {*}[dict merge [opts2dict $var(scr) ${tag}l] [list -tags [concat $tags Ml] -fill #222]] -state [expr {$var(marklines,on) ? "normal" : "hidden"}]
}
# namespace ::mon
proc decodeStatus status {
set out {}
dict set out OFFS [expr {((($status & 0x10)>>4) ? -16 : 0) + ($status & 0xF)}]
dict set out ATGL [expr {($status & 0x20) >> 5}]
dict set out RSSI [expr {($status & 0x100) >> 8}]
dict set out ATS [expr {($status & 0x200) >> 9}]
dict set out EXT [expr {($status & 0x1000) >> 12}]
return $out
dict set out CRL [expr {($status & 0x40) >> 6}]
dict set out DQD [expr {($status & 0x80) >> 7}]
dict set out FFEM [expr {($status & 0x400) >> 10}]
}
# namespace ::mon
proc deleteMark r {
variable var
unset -nocomplain var(M,mark)
$var(scr) del r$var(r)
}
# namespace ::mon
proc disableTrace avar {
variable var
if {$avar eq {}} {
}
}
# namespace ::mon
proc drawAxis {W args} {
# draw an axis on canvas W, data is canvas related except for -startval and -endval
set data [dict merge {-axisx 0 -axisy 0 -minsep 25 -orient horizontal -size 300 -startval 0 -endval 300 -stepval 1} $args]
if {[string match -nocase "h*" [dict get $data -orient]]} {
set axs [dict get $data -axisx]
} else {
set axs [dict get $data -axisy]
}
set dp $axs
}
# namespace ::mon
proc drawBER {W {minxsep 25}} {
variable var
$W delete gber
# y axis dB
set dp $var(sa,base)
for {set ber 0} {$ber <= 100} {incr ber 20} {
set d [expr {$var(sa,base) - $var(ber,scale) / 100.0 * $ber}]
if {$d <= ($dp - $minxsep)} {
$W create line 0 $d $var(wf,W) $d -fill $var(color,fill,gl) -tags [list g ber gberl g$d fx] -dash {2 2}
$W create text -5 $d -anchor e -text [expr {$ber/100.0}] -tags [list g gt ber gbert fx] -fill $var(color,fill,gt) -font {TkDefaultFont -10}
set dp $d
}
$W create line 0 $d -5 $d -fill $var(color,fill,gl) -tags [list g gl ber gberl gbertc g$d fx]
}
# PER line
$W create line 0 0 0 0 -fill $var(color,fill,PER) -tags [list ber PER]
$W itemconfig ber -state hidden
}
# namespace ::mon
proc drawEvent args {
variable var
# args are x, y, mark
lassign $args x y mark
if {$mark ne {}} {
# set the center of the circle. It will also tell the event parsing proc that we are in the middle of drawing an event circle
set var(B1) $args
return
}
# the mouse is moving, draw the new circle
lassign $var(B1) x0 y0 mark
set dx [expr {abs($x - $x0)}]
set dy [expr {abs($y - $y0)}]
$var(scr) coords [list $mark && Mo] [expr {$x0 - $dx}] [expr {$y0 - $dy}] [expr {$x0 + $dx}] [expr {$y0 + $dy}]
}
# namespace ::mon
proc drawFreqGrid {W y {minxsep 25}} {
variable var
set lf [expr {int(ceil([chan2freq [dict get $var(rf12b) lch]]))}]
set uf [expr {int(floor([chan2freq [dict get $var(rf12b) uch]]))}]
set fs 1 ; # frequency step
$W delete {gxl || gxt}
set dp 0
for {set f $lf} {$f <= $uf} {incr f $fs} {
set d [freq2scr $f]
# don't draw grid outside of waterfall
if {$d > $var(wf,W)} break
if {$d >= ($dp + $minxsep)} {
$W create line $d 0 $d $y -fill $var(color,fill,gl) -tags [list g gl gxl g$d fx] -dash {2 2}
set ti [$W create text $d [expr {$y + 7}] -anchor n -text $f -tags [list g gt gxt g$d fx] -fill $var(color,fill,gt) -font {TkDefaultFont -10}]
# if despite our efforts our new grid text overlaps with something, then delete it
if {[$W find overlapping {*}[$W bbox $ti]] ne $ti} {
$W delete $ti
}
set dp $d
}
$W create line $d $y $d [expr {$y + 5}] -fill $var(color,fill,gl) -tags [list g gl gxl gxtc g$d fx]
}
}
# namespace ::mon
proc drawGrid W {
variable var
# minimum separation of grid lines to be readable
set minxsep 25
# hide items that may interfere with grid
$W itemconfig BW -state hidden
$W delete {g && !ber}
drawFreqGrid $W $var(sa,base) $minxsep