-
Notifications
You must be signed in to change notification settings - Fork 7
/
utils.tcl
2532 lines (2149 loc) · 92 KB
/
utils.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
package provide de1_utils 1.1
package require de1_logging 1.0
package require de1_metadata 1.0
proc setup_environment {} {
global android
global undroid
global settings
global fontm
# Set DUI settings from the app stored settings
foreach s {default_font_calibration use_finger_down_for_tap disable_long_press timer_interval enable_spoken_prompts
speaking_pitch speaking_rate } {
if { [info exists settings($s)] } {
dui config $s $settings($s)
}
}
dui config language [language]
dui font add_dirs "[homedir]/fonts/"
dui config preload_images $::settings(preload_all_page_images)
dui sound set button_in "[homedir]/sounds/KeypressStandard_120.ogg" \
button_out "[homedir]/sounds/KeypressDelete_120.ogg" \
page_change "[homedir]/sounds/KeypressDelete_120.ogg"
dui init $settings(screen_size_width) $settings(screen_size_height) $settings(orientation)
# Do this after dui init, so if the same image is on the current skin and in default, the one in the skin directory takes precedence
dui image add_dirs "[homedir]/skins/default/"
source "bluetooth.tcl"
# Configure actions on specific pages (this was previously hardcoded on page_display_change, and should be moved
# later to the part of the GUI that builds those pages).
dui page add_action off load ::off_page_onload
dui page add_action saver load ::saver_page_onload
dui page add_action {} load ::adjust_machine_nextpage
dui page add_action {} load ::page_onload
if { $::android == 0 } {
dui page add_action {} update_vars ::set_dummy_espresso_vars
}
# only calculate the tablet's dimensions once, then save it in settings for a faster app startup
set ::screen_size_width [dui cget screen_size_width]
set ::screen_size_height [dui cget screen_size_height]
if { $settings(screen_size_width) != $::screen_size_width || $settings(screen_size_height) != $::screen_size_height } {
set settings(screen_size_width) $::screen_size_width
set settings(screen_size_height) $::screen_size_height
save_settings
# }
# Enrique: This shouldn't be necessary anymore but still the $::rescale_*_ratio vars are used in a couple of procs
if { ![file exists "skins/default/${::screen_size_width}x${::screen_size_height}"] } {
set ::rescale_images_x_ratio [expr {$::screen_size_height / $::dui::_base_screen_height}]
set ::rescale_images_y_ratio [expr {$::screen_size_width / $::dui::_base_screen_width}]
}
# Re-store what are now DUI namespace variables into the original global variables to ensure backwards-compatibility
# with existing code, until all code is migrated.
set ::globals(listbox_global_width_multiplier) [dui cget listbox_global_width_multiplier]
set ::globals(listbox_length_multiplier) [dui cget listbox_length_multiplier]
set ::globals(entry_length_multiplier) [dui cget entry_length_multiplier]
set fontm [dui cget fontm]
#set ::fontw [dui cget fontw]
# Create hardcoded fonts used in default and Insight skins. These should be replaced by DUI aspects in the future,
# but are left at the moment to guarantee backwards-compatibility.
set helvetica_font [dui aspect get dtext font_family -theme default]
set helvetica_bold_font [dui aspect get dtext font_family -theme default -style bold]
set global_font_name [dui aspect get dtext font_family -theme default -style global]
set global_font_size [dui aspect get dtext font_size -theme default -style global]
set fontawesome_brands [dui aspect get symbol font_family -theme default -style brands]
if {$android == 1 || $undroid == 1} {
font create Fontawesome_brands_11 -family $fontawesome_brands -size [expr {int($fontm * 20)}]
font create global_font -family $global_font_name -size [expr {int($fontm * $global_font_size)}]
font create Helv_12_bold -family $helvetica_bold_font -size [expr {int($fontm * 22)}]
font create Helv_12 -family $helvetica_font -size [expr {int($fontm * 22)}]
font create Helv_11_bold -family $helvetica_bold_font -size [expr {int($fontm * 20)}]
font create Helv_11 -family $helvetica_font -size [expr {int($fontm * 20)}]
font create Helv_10_bold -family $helvetica_bold_font -size [expr {int($fontm * 19)}]
font create Helv_10 -family $helvetica_font -size [expr {int($fontm * 19)}]
font create Helv_1 -family $helvetica_font -size 1
font create Helv_4 -family $helvetica_font -size [expr {int($fontm * 8)}]
font create Helv_5 -family $helvetica_font -size [expr {int($fontm * 10)}]
font create Helv_6 -family $helvetica_font -size [expr {int($fontm * 12)}]
font create Helv_6_bold -family $helvetica_bold_font -size [expr {int($fontm * 12)}]
font create Helv_7 -family $helvetica_font -size [expr {int($fontm * 14)}]
font create Helv_7_bold -family $helvetica_bold_font -size [expr {int($fontm * 14)}]
font create Helv_8 -family $helvetica_font -size [expr {int($fontm * 16)}]
font create Helv_8_bold -family $helvetica_bold_font -size [expr {int($fontm * 16)}]
font create Helv_9 -family $helvetica_font -size [expr {int($fontm * 18)}]
font create Helv_9_bold -family $helvetica_bold_font -size [expr {int($fontm * 18)}]
font create Helv_15 -family $helvetica_font -size [expr {int($fontm * 24)}]
font create Helv_15_bold -family $helvetica_bold_font -size [expr {int($fontm * 24)}]
font create Helv_16_bold -family $helvetica_bold_font -size [expr {int($fontm * 27)}]
font create Helv_17_bold -family $helvetica_bold_font -size [expr {int($fontm * 30)}]
font create Helv_18_bold -family $helvetica_bold_font -size [expr {int($fontm * 32)}]
font create Helv_19_bold -family $helvetica_bold_font -size [expr {int($fontm * 35)}]
font create Helv_20_bold -family $helvetica_bold_font -size [expr {int($fontm * 37)}]
font create Helv_30_bold -family $helvetica_bold_font -size [expr {int($fontm * 54)}]
font create Helv_30 -family $helvetica_font -size [expr {int($fontm * 56)}]
} else {
set regularfont $helvetica_font
set boldfont $helvetica_bold_font
font create Fontawesome_brands_11 -family $fontawesome_brands -size [expr {int($fontm * 25)}]
font create global_font -family $global_font_name -size [expr {int($fontm * 23)}]
set regularfont $helvetica_font
set boldfont $helvetica_bold_font
font create Helv_1 -family $regularfont -size 1
font create Helv_4 -family $regularfont -size 10
font create Helv_5 -family $regularfont -size 12
font create Helv_6 -family $regularfont -size [expr {int($fontm * 14)}]
font create Helv_6_bold -family $boldfont -size [expr {int($fontm * 14)}]
font create Helv_7 -family $regularfont -size [expr {int($fontm * 16)}]
font create Helv_7_bold -family $boldfont -size [expr {int($fontm * 16)}]
font create Helv_8 -family $regularfont -size [expr {int($fontm * 19)}]
font create Helv_8_bold_underline -family $boldfont -size [expr {int($fontm * 19)}] -underline 1
font create Helv_8_bold -family $boldfont -size [expr {int($fontm * 19)}]
font create Helv_9 -family $regularfont -size [expr {int($fontm * 23)}]
font create Helv_9_bold -family $boldfont -size [expr {int($fontm * 21)}]
font create Helv_10 -family $regularfont -size [expr {int($fontm * 23)}]
font create Helv_10_bold -family $boldfont -size [expr {int($fontm * 23)}]
font create Helv_11 -family $regularfont -size [expr {int($fontm * 25)}]
font create Helv_11_bold -family $boldfont -size [expr {int($fontm * 25)}]
font create Helv_12 -family $regularfont -size [expr {int($fontm * 27)}]
font create Helv_12_bold -family $boldfont -size [expr {int($fontm * 30)}]
font create Helv_15 -family $regularfont -size [expr {int($fontm * 30)}]
font create Helv_15_bold -family $boldfont -size [expr {int($fontm * 30)}]
font create Helv_16_bold -family $boldfont -size [expr {int($fontm * 33)}]
font create Helv_17_bold -family $boldfont -size [expr {int($fontm * 37)}]
font create Helv_18_bold -family $boldfont -size [expr {int($fontm * 40)}]
font create Helv_19_bold -family $boldfont -size [expr {int($fontm * 45)}]
font create Helv_20_bold -family $boldfont -size [expr {int($fontm * 48)}]
font create Helv_30_bold -family $boldfont -size [expr {int($fontm * 69)}]
font create Helv_30 -family $regularfont -size [expr {int($fontm * 72)}]
}
metadata init
source "app_metadata.tcl"
init_app_metadata
after 60000 schedule_minute_task
return
# #puts "setup_environment"
# global screen_size_width
# global screen_size_height
# global fontm
# global android
# global undroid
#
# set ::globals(listbox_length_multiplier) 1
# set ::globals(listbox_global_width_multiplier) 1
#
# set ::globals(entry_length_multiplier) 1
#
# if {$android == 1 || $undroid == 1} {
#
# # hide the android keyboard that pops up when you power back on
# bind . <<DidEnterForeground>> hide_android_keyboard
#
# # this causes the app to exit if the main window is closed
# wm protocol . WM_DELETE_WINDOW exit
#
# # set the window title of the app. Only visible when casting the app via jsmpeg, and when running the app in a window using undroidwish
# wm title . "Decent"
#
# # force the screen into landscape if it isn't yet
# msg "orientation: [borg screenorientation]"
# if {[borg screenorientation] != "landscape" && [borg screenorientation] != "reverselandscape"} {
# borg screenorientation $::settings(orientation)
# }
#
# sdltk screensaver off
#
#
# if {$::settings(screen_size_width) != "" && $::settings(screen_size_height) != ""} {
# set screen_size_width $::settings(screen_size_width)
# set screen_size_height $::settings(screen_size_height)
#
# } else {
#
#
# # A better approach than a pause to wait for the lower panel to move away might be to "bind . <<ViewportUpdate>>" or (when your toplevel is in fullscreen mode) to "bind . <Configure>" and to watch out for "winfo screenheight" in the bound code.
# if {$android == 1} {
# pause 500
# }
#
# set width [winfo screenwidth .]
# set height [winfo screenheight .]
#
# if {$width > 2300} {
# set screen_size_width 2560
# if {$height > 1450} {
# set screen_size_height 1600
# } else {
# set screen_size_height 1440
# }
# } elseif {$height > 2300} {
# set screen_size_width 2560
# if {$width > 1440} {
# set screen_size_height 1600
# } else {
# set screen_size_height 1440
# }
# } elseif {$width == 2048 && $height == 1440} {
# set screen_size_width 2048
# set screen_size_height 1440
# #set fontm 2
# } elseif {$width == 2048 && $height == 1536} {
# set screen_size_width 2048
# set screen_size_height 1536
# #set fontm 2
# } elseif {$width == 1920} {
# set screen_size_width 1920
# set screen_size_height 1080
# if {$width > 1080} {
# set screen_size_height 1200
# }
#
# } elseif {$width == 1280} {
# set screen_size_width 1280
# set screen_size_height 800
# if {$width >= 720} {
# set screen_size_height 800
# } else {
# set screen_size_height 720
# }
# } else {
# # unknown resolution type, go with smallest
# set screen_size_width 1280
# set screen_size_height 800
# }
#
# # only calculate the tablet's dimensions once, then save it in settings for a faster app startup
# set ::settings(screen_size_width) $screen_size_width
# set ::settings(screen_size_height) $screen_size_height
# save_settings
# }
#
# # Android seems to automatically resize fonts appropriately to the current resolution
# set fontm $::settings(default_font_calibration)
# set ::fontw 1
#
# if {$::undroid == 1} {
# # undroid does not resize fonts appropriately for the current resolution, it assumes a 1024 resolution
# set fontm [expr {($screen_size_width / 1024.0)}]
# set ::fontw 2
# }
#
# if {[file exists "skins/default/${screen_size_width}x${screen_size_height}"] != 1} {
# set ::rescale_images_x_ratio [expr {$screen_size_height / 1600.0}]
# set ::rescale_images_y_ratio [expr {$screen_size_width / 2560.0}]
# }
#
# global helvetica_bold_font
# global helvetica_font
# set global_font_size 18
# #puts "setting up fonts for language [language]"
# if {[language] == "th"} {
# set helvetica_font [sdltk addfont "fonts/sarabun.ttf"]
# set helvetica_bold_font [sdltk addfont "fonts/sarabunbold.ttf"]
# set fontm [expr {($fontm * 1.2)}]
# set global_font_name [lindex [sdltk addfont "fonts/NotoSansCJKjp-Regular.otf"] 0]
# set global_font_size 16
# } elseif {[language] == "ar" || [language] == "arb"} {
# set helvetica_font [sdltk addfont "fonts/Dubai-Regular.otf"]
# set helvetica_bold_font [sdltk addfont "fonts/Dubai-Bold.otf"]
# set global_font_name [lindex [sdltk addfont "fonts/NotoSansCJKjp-Regular.otf"] 0]
# } elseif {[language] == "he" || [language] == "heb"} {
# set ::globals(listbox_length_multiplier) 1.35
# set ::globals(entry_length_multiplier) 0.86
# set helvetica_font [sdltk addfont "fonts/hebrew-regular.ttf"]
# set helvetica_bold_font [sdltk addfont "fonts/hebrew-bold.ttf"]
# set global_font_name [lindex [sdltk addfont "fonts/NotoSansCJKjp-Regular.otf"] 0]
# } elseif {[language] == "zh-hant" || [language] == "zh-hans" || [language] == "kr"} {
# set helvetica_font [lindex [sdltk addfont "fonts/NotoSansCJKjp-Regular.otf"] 0]
# set helvetica_bold_font [lindex [sdltk addfont "fonts/NotoSansCJKjp-Bold.otf"] 0]
# set global_font_name $helvetica_font
#
# set fontm [expr {($fontm * .94)}]
# } else {
# # we use the immense google font so that we can handle virtually all of the world's languages with consistency
# set helvetica_font [sdltk addfont "fonts/notosansuiregular.ttf"]
# set helvetica_bold_font [sdltk addfont "fonts/notosansuibold.ttf"]
# set global_font_name [lindex [sdltk addfont "fonts/NotoSansCJKjp-Regular.otf"] 0]
#
# }
#
# set fontawesome_brands [lindex [sdltk addfont "fonts/Font Awesome 5 Brands-Regular-400.otf"] 0]
# font create Fontawesome_brands_11 -family $fontawesome_brands -size [expr {int($fontm * 20)}]
#
# font create global_font -family $global_font_name -size [expr {int($fontm * $global_font_size)}]
#
# font create Helv_12_bold -family $helvetica_bold_font -size [expr {int($fontm * 22)}]
# font create Helv_12 -family $helvetica_font -size [expr {int($fontm * 22)}]
# font create Helv_11_bold -family $helvetica_bold_font -size [expr {int($fontm * 20)}]
# font create Helv_11 -family $helvetica_font -size [expr {int($fontm * 20)}]
# font create Helv_10_bold -family $helvetica_bold_font -size [expr {int($fontm * 19)}]
# font create Helv_10 -family $helvetica_font -size [expr {int($fontm * 19)}]
# font create Helv_1 -family $helvetica_font -size 1
# font create Helv_4 -family $helvetica_font -size [expr {int($fontm * 8)}]
# font create Helv_5 -family $helvetica_font -size [expr {int($fontm * 10)}]
# font create Helv_6 -family $helvetica_font -size [expr {int($fontm * 12)}]
# font create Helv_6_bold -family $helvetica_bold_font -size [expr {int($fontm * 12)}]
# font create Helv_7 -family $helvetica_font -size [expr {int($fontm * 14)}]
# font create Helv_7_bold -family $helvetica_bold_font -size [expr {int($fontm * 14)}]
# font create Helv_8 -family $helvetica_font -size [expr {int($fontm * 16)}]
# font create Helv_8_bold -family $helvetica_bold_font -size [expr {int($fontm * 16)}]
#
# font create Helv_9 -family $helvetica_font -size [expr {int($fontm * 18)}]
# font create Helv_9_bold -family $helvetica_bold_font -size [expr {int($fontm * 18)}]
# font create Helv_15 -family $helvetica_font -size [expr {int($fontm * 24)}]
# font create Helv_15_bold -family $helvetica_bold_font -size [expr {int($fontm * 24)}]
# font create Helv_16_bold -family $helvetica_bold_font -size [expr {int($fontm * 27)}]
# font create Helv_17_bold -family $helvetica_bold_font -size [expr {int($fontm * 30)}]
# font create Helv_18_bold -family $helvetica_bold_font -size [expr {int($fontm * 32)}]
# font create Helv_19_bold -family $helvetica_bold_font -size [expr {int($fontm * 35)}]
# font create Helv_20_bold -family $helvetica_bold_font -size [expr {int($fontm * 37)}]
# font create Helv_30_bold -family $helvetica_bold_font -size [expr {int($fontm * 54)}]
# font create Helv_30 -family $helvetica_font -size [expr {int($fontm * 56)}]
#
# # enable swipe gesture translating, to scroll through listboxes
# # sdltk touchtranslate 1
# # disable touch translating as it does not feel native on tablets and is thus confusing
# if {$::settings(disable_long_press) != 1 } {
# sdltk touchtranslate 1
# } else {
# sdltk touchtranslate 0
# }
#
# wm maxsize . $screen_size_width $screen_size_height
# wm minsize . $screen_size_width $screen_size_height
# wm attributes . -fullscreen 1
#
# # flight mode, not yet debugged
# #if {$::settings(flight_mode_enable) == 1 } {
# # if {[package require de1plus] > 1} {
# # borg sensor enable 0
# # sdltk accelerometer 1
# # after 200 accelerometer_check
# # }
# #}
#
# # preload the speaking engine
# # john 2/12/18 re-enable this when TTS feature is enabled
# # borg speak { }
#
# source "bluetooth.tcl"
#
# } else {
#
# # global font is wider on non-android
# set ::globals(listbox_global_width_multiplier) .8
# set ::globals(listbox_length_multiplier) 1
#
#
# expr {srand([clock milliseconds])}
#
# if {$::settings(screen_size_width) != "" && $::settings(screen_size_height) != ""} {
# set screen_size_width $::settings(screen_size_width)
# set screen_size_height $::settings(screen_size_height)
# } else {
# # if this is the first time running on Tk, then use a default 1280x800 resolution, and allow changing resolution by editing settings file
# set screen_size_width 1280
# set screen_size_height 800
#
# set ::settings(screen_size_width) $screen_size_width
# set ::settings(screen_size_height) $screen_size_height
# save_settings
#
# }
#
# set fontm [expr {$screen_size_width / 1280.0}]
# set ::fontw 2
#
# package require Tk
# catch {
# # tkblt has replaced BLT in current TK distributions, not on Androwish, they still use BLT and it is preloaded
# package require tkblt
# namespace import blt::*
# }
#
# wm maxsize . $screen_size_width $screen_size_height
# wm minsize . $screen_size_width $screen_size_height
#
# if {[file exists "skins/default/${screen_size_width}x${screen_size_height}"] != 1} {
# set ::rescale_images_x_ratio [expr {$screen_size_height / 1600.0}]
# set ::rescale_images_y_ratio [expr {$screen_size_width / 2560.0}]
# }
#
# set regularfont "notosansuiregular"
# set boldfont "notosansuibold"
#
# if {[language] == "th"} {
# set regularfont "sarabun"
# set boldfont "sarabunbold"
# #set fontm [expr {($fontm * 1.20)}]
# } elseif {[language] == "zh-hant" || [language] == "zh-hans"} {
# set regularfont "notosansuiregular"
# set boldfont "notosansuibold"
# }
#
# set ::helvetica_font $regularfont
# font create Helv_1 -family $regularfont -size 1
# font create Helv_4 -family $regularfont -size 10
# font create Helv_5 -family $regularfont -size 12
# font create Helv_6 -family $regularfont -size [expr {int($fontm * 14)}]
# font create Helv_6_bold -family $boldfont -size [expr {int($fontm * 14)}]
# font create Helv_7 -family $regularfont -size [expr {int($fontm * 16)}]
# font create Helv_7_bold -family $boldfont -size [expr {int($fontm * 16)}]
# font create Helv_8 -family $regularfont -size [expr {int($fontm * 19)}]
# font create Helv_8_bold_underline -family $boldfont -size [expr {int($fontm * 19)}] -underline 1
# font create Helv_8_bold -family $boldfont -size [expr {int($fontm * 19)}]
# font create Helv_9 -family $regularfont -size [expr {int($fontm * 23)}]
# font create Helv_9_bold -family $boldfont -size [expr {int($fontm * 21)}]
# font create Helv_10 -family $regularfont -size [expr {int($fontm * 23)}]
# font create Helv_10_bold -family $boldfont -size [expr {int($fontm * 23)}]
# font create Helv_11 -family $regularfont -size [expr {int($fontm * 25)}]
# font create Helv_11_bold -family $boldfont -size [expr {int($fontm * 25)}]
# font create Helv_12 -family $regularfont -size [expr {int($fontm * 27)}]
# font create Helv_12_bold -family $boldfont -size [expr {int($fontm * 30)}]
# font create Helv_15 -family $regularfont -size [expr {int($fontm * 30)}]
# font create Helv_15_bold -family $boldfont -size [expr {int($fontm * 30)}]
# font create Helv_16_bold -family $boldfont -size [expr {int($fontm * 33)}]
# font create Helv_17_bold -family $boldfont -size [expr {int($fontm * 37)}]
# font create Helv_18_bold -family $boldfont -size [expr {int($fontm * 40)}]
# font create Helv_19_bold -family $boldfont -size [expr {int($fontm * 45)}]
# font create Helv_20_bold -family $boldfont -size [expr {int($fontm * 48)}]
# font create Helv_30_bold -family $boldfont -size [expr {int($fontm * 69)}]
# font create Helv_30 -family $regularfont -size [expr {int($fontm * 72)}]
#
#
# font create Fontawesome_brands_11 -family "Font Awesome 5 Brands Regular" -size [expr {int($fontm * 25)}]
#
#
# font create global_font -family "Noto Sans CJK JP" -size [expr {int($fontm * 23)}]
# android_specific_stubs
# source "bluetooth.tcl"
# }
#
# # define the canvas
# . configure -bg black
# canvas .can -width $screen_size_width -height $screen_size_height -borderwidth 0 -highlightthickness 0
#
# after 60000 schedule_minute_task
# #after 1000 schedule_minute_task
#
# ############################################
# # future feature: flight mode
# #if {$::settings(flight_mode_enable) == 1} {
# #if {$android == 1} {
# # .can bind . "<<SensorUpdate>>" [accelerometer_data_read]
# #}
# #after 250 accelerometer_check
# #}
#
# ############################################
}
proc off_page_onload { page_to_hide page_to_show } {
if {$page_to_hide == "sleep" && $page_to_show == "off"} {
msg [namespace current] "discarding intermediate sleep/off state msg"
return 0
}
}
proc saver_page_onload { page_to_hide page_to_show } {
if {[ifexists ::exit_app_on_sleep] == 1} {
get_set_tablet_brightness 0
close_all_ble_and_exit
} else {
if {$::settings(screen_saver_change_interval) == 0} {
# black screen saver
display_brightness 0
} else {
display_brightness $::settings(saver_brightness)
}
borg systemui $::android_full_screen_flags
}
}
proc page_onload { page_to_hide page_to_show } {
if {$page_to_show ne "saver" } {
display_brightness $::settings(app_brightness)
}
if {$::settings(stress_test) == 1 && $::de1_num_state($::de1(state)) == "Idle" && [info exists ::idle_next_step] == 1} {
msg "Doing next stress test step: '$::idle_next_step '"
set todo $::idle_next_step
unset -nocomplain ::idle_next_step
eval $todo
}
}
proc check_if_battery_low_and_give_message {} {
if {[battery_percent] < 10 && $::android == 1} {
info_page [subst {[translate "We noticed that your battery power is very low."]\n\n[translate "Maybe you are turning your DE1 off using the power switch on the back?"]\n\n[translate "If so, that prevents the tablet from charging."]\n\n[translate "Instead, put the DE1 to sleep by tapping the power icon in the App."]}] [translate "Ok"]
}
}
proc battery_percent {} {
array set powerinfo [sdltk powerinfo]
set percent [ifexists powerinfo(percent)]
if {$percent == ""} {
set percent 100
}
return $percent
}
# dim the screen automaticaly if the battery is low
proc check_battery_low {brightness_to_use} {
set current_brightness [get_set_tablet_brightness]
if {$current_brightness == ""} {
set current_brightness 100
} else {
set current_brightness [expr {abs($current_brightness)}]
}
#return 100
set percent [battery_percent]
if {$percent < $::settings(battery_very_low_trigger)} {
if {$current_brightness > $::settings(battery_very_low_brightness)} {
get_set_tablet_brightness $::settings(battery_very_low_brightness)
msg -WARNING "Battery is very low ($percent < $::settings(battery_very_low_trigger)) so lowering screen to $::settings(battery_very_low_brightness)"
}
if {$brightness_to_use > $::settings(battery_very_low_brightness)} {
return $::settings(battery_very_low_brightness)
}
} elseif {$percent < $::settings(battery_low_trigger)} {
if {$current_brightness > $::settings(battery_low_brightness)} {
get_set_tablet_brightness $::settings(battery_low_brightness)
msg -WARNING "Battery is low ($percent < $::settings(battery_low_trigger)) so lowering screen to $::settings(battery_low_brightness)"
}
if {$brightness_to_use > $::settings(battery_low_brightness)} {
return $::settings(battery_low_brightness)
}
#return $brightness_to_use
} elseif {$percent < $::settings(battery_medium_trigger)} {
if {$current_brightness > $::settings(battery_medium_brightness)} {
get_set_tablet_brightness $::settings(battery_medium_brightness)
msg -NOTICE "Battery is medium ($percent < $::settings(battery_medium_trigger)) so lowering screen to $::settings(battery_medium_brightness)"
}
if {$brightness_to_use > $::settings(battery_medium_brightness)} {
return $::settings(battery_medium_brightness)
}
#return $brightness_to_use
}
return $brightness_to_use
}
proc schedule_minute_task {} {
check_battery_low 100
after 60000 schedule_minute_task
#after 1000 schedule_minute_task
}
proc reverse_array {arrname} {
upvar $arrname arr
foreach {k v} [array get arr] {
set newarr($v) $k
}
return [array get newarr]
}
# name the procs in the stack
proc stackprocs {} {
set stack {}
for {set i 1} {$i < [info level]} {incr i} {
set lvl [info level -$i]
set pname [lindex $lvl 0]
lappend stack $pname
#foreach value [lrange $lvl 1 end] arg [info args $pname] {
# if {$value eq ""} {
# info default $pname $arg value
# }
# append stack " $arg='$value'"
#}
#append stack \n
}
return $stack
}
proc stacktrace {args} {
set label_args [expr { "-label_args" in $args }]
# Original code apparently from https://wiki.tcl-lang.org/page/List+the+call+stack
# Notes there suggest that there are also problems with namespaces with the implementation
# (This concern is not resolved at this time)
set stack "Stack trace:\n"
for {set i 1} {$i < [info level]} {incr i} {
set level [info level -$i]
set frame [info frame -$i]
append stack [string repeat " " $i]
if { ! $label_args } {
append stack $level
} else {
set pname [lindex $lvl 0]
if { [info proc $pname] } {
append stack $pname
foreach value [lrange $lvl 1 end] arg [info args $pname] {
catch {
if {$value eq ""} {
info default $pname $arg value
}
append stack " $arg='$value'"
}
}
} else {
append stack $lvl
}
}
append stack \n
}
return $stack
}
proc random_saver_file {} {
if {[info exists ::saver_files_cache] != 1} {
set ::saver_files_cache {}
set savers {}
catch {
set savers [glob -nocomplain "[saver_directory]/${::screen_size_width}x${::screen_size_height}/*.jpg"]
}
if {$savers == ""} {
catch {
file mkdir "[saver_directory]/${::screen_size_width}x${::screen_size_height}/"
}
set rescale_images_x_ratio [expr {$::screen_size_height / 1600.0}]
set rescale_images_y_ratio [expr {$::screen_size_width / 2560.0}]
foreach fn [glob -nocomplain "[saver_directory]/2560x1600/*.jpg"] {
borg toast [subst {[translate "Resizing image"]\n\n[file tail $fn]}]
borg spinner on
msg -DEBUG "random_saver_file image create photo saver -file $fn"
image create photo saver -file $fn
photoscale saver $rescale_images_y_ratio $rescale_images_x_ratio
set resized_filename "[saver_directory]/${::screen_size_width}x${::screen_size_height}/[file tail $fn]"
msg -DEBUG "saving resized image to: $resized_filename"
borg spinner off
saver write $resized_filename -format {jpeg -quality 50}
}
}
set saver_path "[saver_directory]/${::screen_size_width}x${::screen_size_height}/"
set ::saver_files_cache [glob -nocomplain -path $saver_path {*.[Jj][Pp][Gg]}]
if {$::settings(screen_saver_change_interval) == 0} {
# remove all other savers if we are only showing the black one
set ::saver_files_cache [glob -nocomplain "[saver_directory]/${::screen_size_width}x${::screen_size_height}/black_saver.jpg"]
} else {
# remove the black saver if we are not needing it
set ::saver_files_cache [lsearch -inline -all -not -exact $::saver_files_cache "[saver_directory]/${::screen_size_width}x${::screen_size_height}/black_saver.jpg"]
}
}
return [random_pick $::saver_files_cache]
}
proc tcl_introspection {} {
catch {
set txt ""
append txt "Commands available: [llength [info commands]]\nInstructions run: [info cmdcount]\nGlobals: [llength [info globals]]\nProcs: [llength [info procs]]\nAfter commands: [llength [after info]]\n"
set show_after_command_detail 0
if {$show_after_command_detail == 1} {
set acnt 0
foreach a [after info] {
incr acnt
append txt "$acnt - [after info $a]\n"
}
}
append txt "Canvas objects: [llength [.can find all]]\n"
append txt "Images loaded: [llength [image names]]\n"
append txt "BLE queue: [llength $::de1(cmdstack)]\n"
set show_image_detail 0
if {$show_image_detail == 1} {
set cnt 0
foreach i [image names] {
append txt "[incr cnt]. $i [image height $i]x[image width $i] in use:[image inuse $i]\n"
}
append txt \n
}
set vs [vector names]
append txt "Vectors: [llength $vs]"
set total 0
foreach v $vs {
set sz [$v length]
set total [expr {$total + $sz}]
}
append txt "\nTOTAL vector length: $total bytes\n"
set globs [info globals]
append txt "Globals [llength $globs]:\n"
set txt2 ""
set total 0
set cnt 0
foreach g $globs {
if {[array exists $g] == 1} {
set sz [string length [array get $g]]
if {$sz > 100} {
append txt "[incr cnt]. array $g : $sz\n"
}
set total [expr {$total + $sz}]
} else {
set sz [string length $g]
if {$sz > 100} {
append txt "[incr cnt]. string $g : $sz\n"
}
set total [expr {$total + $sz}]
}
}
append txt "TOTAL global variable memory used: $total bytes\n\n"
if {$::enable_profiling == 1} {
# this loads the overall app info
append txt [profilerdata]
# this gives you profiled run information about individual functions
# feel free to change these to those you are investigating
append txt [profilerdata ::load_skin]
append txt [profilerdata ::add_de1_text]
append txt [profilerdata ::add_de1_variable]
append txt [profilerdata ::de1_ble_handler]
append txt [profilerdata ::device::scale::process_weight_update]
}
msg -INFO $txt
}
after [expr {60 * 60 * 1000}] tcl_introspection
#after [expr {1000}] tcl_introspection
}
proc add_commas_to_number { number } {
regsub -all \\d(?=(\\d{3})+([regexp -inline {\.\d*$} $number]$)) $number {\0,}
}
proc array_keys_decr_sorted_by_number_val {arrname {sort_order -decreasing}} {
upvar $arrname arr
foreach k [array names arr] {
#puts " $arr($k) "
set k2 "[format {"%0.12i"} $arr($k)] $k"
#puts "k2: $k2"
set t($k2) $k
}
set toreturn {}
foreach k [lsort -dictionary $sort_order [array names t]] {
set v $t($k)
lappend toreturn $v
}
return $toreturn
}
proc random_splash_file {} {
if {[info exists ::splash_files_cache] != 1} {
set ::splash_files_cache {}
set savers {}
catch {
set savers [glob -nocomplain "[splash_directory]/${::screen_size_width}x${::screen_size_height}/*.jpg"]
}
if {$savers == ""} {
catch {
file mkdir "[splash_directory]/${::screen_size_width}x${::screen_size_height}/"
}
set rescale_images_x_ratio [expr {$::screen_size_height / 1600.0}]
set rescale_images_y_ratio [expr {$::screen_size_width / 2560.0}]
foreach fn [glob -nocomplain "[splash_directory]/2560x1600/*.jpg"] {
borg toast [subst {[translate "Resizing image"]\n\n[file tail $fn]}]
borg spinner on
msg -DEBUG "random_splash_file image create photo saver -file $fn"
image create photo saver -file $fn
photoscale saver $rescale_images_y_ratio $rescale_images_x_ratio
set resized_filename "[splash_directory]/${::screen_size_width}x${::screen_size_height}/[file tail $fn]"
msg -DEBUG "saving resized image to: $resized_filename"
borg spinner off
saver write $resized_filename -format {jpeg -quality 50}
}
}
set ::splash_files_cache [glob -nocomplain "[splash_directory]/${::screen_size_width}x${::screen_size_height}/*.jpg"]
}
return [random_pick $::splash_files_cache]
}
proc random_splash_file_obs {} {
if {[info exists ::splash_files_cache] != 1} {
msg -DEBUG "building splash_files_cache"
set ::splash_files_cache {}
if {[file exists "[splash_directory]/${::screen_size_width}x${::screen_size_height}/"] == 1} {
set files [glob -nocomplain "[splash_directory]/${::screen_size_width}x${::screen_size_height}/*.jpg"]
} else {
set files [glob -nocomplain "[splash_directory]/2560x1600/*.jpg"]
}
borg spinner on
foreach file $files {
if {[string first $file resized] == -1} {
lappend ::splash_files_cache $file
}
}
borg spinner off
msg -INFO "savers: $::splash_files_cache"
}
return [random_pick $::splash_files_cache]
}
proc language {} {
global current_language
if {[ifexists ::settings(language)] != "--" && [ifexists ::settings(language)] != ""} {
return [ifexists ::settings(language)]
}
if {$::android != 1} {
# on non-android OS, we don't know the system language so use english if nothing else is set
return "en"
}
# otherwise use the Android system language, if we can
# the UI language for Decent Espresso is set as the UI language that Android is currently operating in
if {[info exists current_language] == 0} {
array set loc [borg locale]
set current_language $loc(language)
if {$loc(language) == "zh"} {
# chinese traditional vs simplified is only differentiated by the country associated with it
if {$loc(country) == "TW"} {
set current_language "zh-hant"
} else {
set current_language "zh-hans"
}
} elseif {$loc(language) == "ko"} {
# not sure why Android deviates from KR standard for korean
set current_language "kr"
}
}
return $current_language
}
proc translation_langs {} {
set l {}
foreach {k v} [translation_langs_array] {
lappend l $k
}
return $l
}
# from wikipedia https://en.wikipedia.org/wiki/List_of_ISO_639-2_codes
# converted UTF8 chars to unicode with http://ratfactor.com/utf-8-to-unicode to avoid problems with this source being loaded on Windows (where UTF8 is not the default).
# new url: https://mothereff.in/js-escapes
# note that "Arabic" is the descriptor for that language because can make the correct arabic text render with this same font.
proc translation_langs_array {} {
return [list \
en English \
kr "\uD55C\uAD6D\uC5B4" \
fr "\u0066\u0072\u0061\u006E\u00E7\u0061\u0069\u0073" \
de Deutsch \
de-ch Schwiizerd\u00FCtsch \
it italiano \
ar "Arabic (with Dubai font)" \
da "dansk" \
sv "svenska" \
no "Nynorsk" \
he "\u05E2\u05D1\u05E8\u05D9\u05EA" \
es "\u0065\u0073\u0070\u0061\u00F1\u006F\u006C" \
pt "\u0070\u006F\u0072\u0074\u0075\u0067\u0075\u00EA\u0073" \
pl "\u004A\u119\u007A\u0079\u006B\u0020\u0070\u006F\u006C\u0073\u006B\u0069" \
fi "suomen kieli" \
zh-hans "\u7C21\u9AD4" \
zh-hant "\u7E41\u9AD4" \
th "\uE20\uE32\uE29\uE32\uE44\uE17\uE22" \
jp "\u65E5\u672C\u8A9E" \
el "\u39D\u3AD\u3B1\u0020\u395\u3BB\u3BB\u3B7\u3BD\u3B9\u3BA\u3AC" \
sk "\u0073\u006C\u006F\u0076\u0065\u006E\u10D\u0069\u006E\u0061" \
cs "\u10D\u0065\u161\u0074\u0069\u006E\u0061" \
hu "magyar nyelv" \
tr "\u0054\u00FC\u0072\u006B\u00E7\u0065" \
ro "\u006C\u0069\u006D\u0062\u0061\u0020\u0072\u006F\u006D\u00E2\u006E\u103" \
hi "\u939\u93F\u928\u94D\u926\u940" \
nl "Nederlands" \
ru "русский"
]
}
proc translate {english} {
if {$english == ""} {
return ""
}
if {[language] == "en"} {
return $english
}
global translation
if {[info exists translation($english)] == 1} {
# this word has been translated
array set available $translation($english)
if {[info exists available([language])] == 1} {
# this word has been translated into the desired non-english language
if {[ifexists available([language])] != ""} {
# if the translated version of the English is NOT blank, return it
if {[language] == "ar" && ($::android == 1 || $::undroid == 1)} {
# use the "arb" column on Android/Undroid because they do not correctly right-to-left text like OSX does
if {[ifexists available(arb)] != ""} {
return $available(arb)
}
}
if {[language] == "he" && ($::android == 1 || $::undroid == 1)} {
# use the "heb" column on Android/Undroid because they do not correctly right-to-left text like OSX does
if {[ifexists available(heb)] != ""} {
return $available(heb)
}
}
return $available([language])
} else {
# if the translation is blank, show the English instead
return $english
}
}
}
# if no translation found, return the english text
if {$::android != 1} {
if {[info exists ::already_shown_trans($english)] != 1} {
set t [subst {"$english" \{}]
foreach {l d} [translation_langs_array] {
set translation($l) $english
append t [subst {$l "$english" }]