Check-in [2484e9629e]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:(no comment)
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:2484e9629ee1ecf5e9f42f8c344ea785512aeefc
User & Date: gwlester 2016-05-30 04:26:11
Context
2016-05-30
19:13
Add comments check-in: 7ac59f698c user: gwlester tags: trunk
04:26
(no comment) check-in: 2484e9629e user: gwlester tags: trunk
2014-12-10
18:24
Really fixed typos. check-in: 2ba9a5699a user: gwlester tags: trunk
Changes

Changes to CreateShortCuts.tcl.

91
92
93
94
95
96
97
98
99
100
101
102
103
104
105

if  {[string is boolean -strict $ans] && $ans} {
    package require udp
    package require http

    set filesDownloaded 0
    set group 224.5.1.21
    set port  7771
    set socket [udp_open $port]
    fconfigure $socket -mcastadd $group
    set afterId [after [expr {1000 * 60}] Timeout]
    fileevent $socket readable [list ListenForServer $socket]
    listbox .downloads -listvariable downloadedList
    label .status \
        -textvariable status







|







91
92
93
94
95
96
97
98
99
100
101
102
103
104
105

if  {[string is boolean -strict $ans] && $ans} {
    package require udp
    package require http

    set filesDownloaded 0
    set group 224.5.1.21
    set port  7770
    set socket [udp_open $port]
    fconfigure $socket -mcastadd $group
    set afterId [after [expr {1000 * 60}] Timeout]
    fileevent $socket readable [list ListenForServer $socket]
    listbox .downloads -listvariable downloadedList
    label .status \
        -textvariable status

Added ReadMessages.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
################################################################################
#                                                                              #
#  This program verbally notifies you when a new SMS comes in.  If the phone   #
#  number is in the address book, it will say who the SMS is from. Otherwise,  #
#  it will just read the phone number.  In either case, it will ask you if you #
#  want the SMS read to you.                                                   #
#                                                                              #
#  You must respond with a valid boolean (yes/no).                             #
#                                                                              #
#  If you say yes, it will read the SMS to you.                                #
#                                                                              #
#  In either case it will mark the SMS as viewed (this does not work currently)#
#                                                                              #
#  To Do List:                                                                 #
#       - Get the marking of the SMS as viewed working                         #
#       - Replace the polling with receipt of notification                     #
#       - Replace hard coded messages with a message catalog to make it easier #
#           to localize the code                                               #
#                                                                              #
################################################################################
package require uri::urn

array set content {
    sms,uri {content://sms/inbox}
    phonelookup,uri {content://com.android.contacts/phone_lookup}
}

set processingMessages no
set promptFmt {You have a new message from %1$s. Do you want me to read it to you?}

##
## The viewed array is a to remember what we have seen and will go away when the
## update of the "seen" column is working
##
array set viewed {}

##
## Translate the phone number to a name if the phone number is in the phone book
##
proc lookupName {phoneNumber} {
    global content

    ##
    ## Make the phone number the "default" result
    ##
    set results $phoneNumber

    ##
    ## Do the query
    ##
    set provider phonelookup
    set uri $content($provider,uri)
    append uri "/" [::uri::urn::quote $phoneNumber]
    set cursor {}
    catch {set cursor [borg content query $uri {display_name}]}
    if {$cursor ne {}} {
        ##
        ## Found a match, so just use the first name found
        ##
        $cursor moveto 0
        set results [dict get [$cursor getrow] display_name]
        $cursor close
    }

    return $results;
}

##
## Get all the new messages
##
proc getNewMessages {} {
    global content
    global viewed

    ##
    ## Query for unseen messages
    ##
    set provider sms
    set cursor [borg content query $content($provider,uri) \
                    {address,date_sent,body} \
                    {seen = ?} \
                    {0}]
    set results {}
    if {$cursor ne {}} {
        ##
        ## Some unseen ones were found, so loop through them getting the
        ## information
        ##
        set cnt [$cursor count]
        for {set idx 0} {$idx < $cnt} {incr idx} {
            $cursor moveto $idx
            set rowDict [$cursor getrow]
            set address [dict get $rowDict address]
            set date_sent [dict get $rowDict date_sent]

            ##
            ## Only return the row if it has not been viewed -- this will be
            ## replaced with always returning the row once the update of the
            ## seen column is working
            ##
            if {![info exists viewed($address,$date_sent)]} {
                lappend results $rowDict
                set viewed($address,$date_sent) 1
            }
        }
        $cursor close
    }

    return $results;

}

##
## Process all new messages
##
proc processNewMessages {} {
    global content
    global messageDone
    global processingMessages

    ##
    ## Mark that we are processing messages
    ##
    set processingMessages yes
    set provider sms; # this is for the update which is inside the loop

    ##
    ## Get the list of unviewed messages and process them
    ##
    set messageList [getNewMessages]
    foreach messageDict $messageList {
        set address [dict get $messageDict address]
        set date_sent [dict get $messageDict date_sent]
        set body [dict get $messageDict body]

        ##
        ## See if we are to read the particular message
        ##
        if {[askToRead $address]} {
            ##
            ## Yes, so read it out
            ##
            set messageDone no
            speak $body
            vwait messageDone
        }

        ##
        ## Mark the message as seen -- this does not currently work but does not
        ## cause an error
        ##
        borg content update $content($provider,uri) \
            {seen 1} \
            {address = ? and date_sent = ?} \
            [list $address $date_sent]
    }

    ##
    ## Mark that we are no longer processing messages
    ##
    set processingMessages no
    return
}

##
## See if they want us to read them the message
##
proc askToRead {fromPhoneNumber} {
    global waitingForAnswer
    global answer
    global promptFmt

    ##
    ## Translate the name to a number if possible
    ##
    set from [lookupName $fromPhoneNumber]

    ##
    ## Prompt them for what they want done and "wait" for the answer
    ##
    set answer waiting
    speak [format $promptFmt $from]
    vwait answer

    return $answer
}

##
## The person finished speaking, so lets see what they said -- this routine
## was "borrowed" from the AndroWish examples, I'm not sure about all of it.
##
proc processInputText {returnCode data} {
    global answer

    array set recog $data
    if {![info exists recog(type)]} {
	return
    }
    switch -exact $recog(type) {
	error {
	    after cancel waitendspeak
	    after 250 waitendspeak
	    return
	}
	result {
            ##
            ## Got a result, lets see if it is a valid response.
            ##
            if {![info exists recog(results_recognition)]} {
                set recog(results_recognition) {}
            }
            set input [lindex $recog(results_recognition) 0]
            if {[string is boolean -strict $input]} {
                set answer $input
            } else {
                ##
                ## Not a valid response, so ask them to try again.
                ##
                speak {I'm sorry, I did not understand.  Please say yes or no.}
            }
	}
	default {
	    return
	}
    }
}


proc speak {data {pitch 1.0} {speed 1.0}} {
    borg speak $data en_US $pitch $speed
    after cancel waitendspeak
    after 100 waitendspeak
}

##
## This routine is schedule by speaking.  It checks to see if the device has
## finished delivering the message and moves on to the next thing (which may be
## listening).  If the device is still delivering the message, it schedules
## itself to check again in a tenth of a second.
##
proc waitendspeak {} {
    global answer
    global messageDone

    if {[borg isspeaking]} {
        ##
        ##  Still delivering the message, so schedule another check
        ##
	after cancel waitendspeak
	after 100 waitendspeak
	return
    }

    ##
    ## Message delivered, so see what our next state is
    ##
    if {$answer eq "waiting"} {
        ##
        ## We are waiting for an answer, so start speech recognition
        ##
        borg speechrecognition start {
            android.speech.extra.LANGUAGE en_US
            android.speech.extra.LANGUAGE_MODEL free_form
        }
    } else {
        ##
        ## No response needed, so just mark that we are done with the message
        ##
        set messageDone yes
    }
    return;
}

##
## Schedule another poll a minue later
##
proc check {} {
    after 60000 check
    if {!$::processingMessages} {
        ##
        ## Not currently processing messages, so process them
        ##
        processNewMessages
    }
}

##
## Register the speach recognition handler
##
borg speechrecognition callback processInputText

##
## Create the GUI
##
wm title . {Read SMS Text Messages}
wm minsize . 1000 1000
::ttk::button .exitButton \
    -text {Exit} \
    -command {
        after 1 {destroy .}
        after 2 {exit}
    }
grid configure .exitButton -sticky nsew
grid columnconfigure . .exitButton -weight 1
grid rowconfigure . .exitButton -weight 1

##
## Start checking for messages after the GUi builds
##
after idle check

Changes to ServeScripts.tcl.

466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
...
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
...
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
            }
            if {![regexp {^([^ ]+) +([^ ]+) ([^ ]+)$} $line -> method url version]} {
                return
            }
 
            switch -exact -- $method {
                POST { 
                    #
                    ## This is all broken and needs to be fixed
                    ##
                    set data ""
                    if {[dict exists $request header transfer-encoding]
                        && [dict get $request header transfer-encoding] eq "chunked"} {
                        # Receive chunked request body.
                        while {[scan [gets $sock line] %x length] == 1 && $length > 0} {
                            chan configure $sock -translation binary
                            append data [read $sock $length]
                            chan configure $sock -translation crlf
                        }
................................................................................
    set requestArr(reply) $replyDict
    return;
}

proc GetMyIp {} {
    variable serverInfo

    if { [ catch {
        set ip 127.0.0.1
        set sid [ socket -async [ info hostname ] 22 ]
	update idletask

        set serverInfo(ipAddr) [ lindex [ fconfigure $sid -sockname ] 0 ]
        ::close $sid
    } err ] } {
        catch { ::close $sid }
        puts stderr "myIP error: '$err' on port 22 (sshd). using 127.0.0.1"
    }
    return
}







proc GetFileList {} {
    set results [list]
    foreach file [glob -nocomplain *.tcl] {
        lappend results $file [file mtime $file]
    }
    foreach file [glob -nocomplain *.png] {
................................................................................

httpd addHandler $port /ScriptSever HandleRequest
httpd listen $port

GetMyIp
set serverInfo(datagram) [dict create port $port host $serverInfo(ipAddr)]
set group 224.5.1.21
set port  7771
set udpSocket [udp_open $port]
fconfigure $udpSocket -buffering none -blocking 0
fconfigure $udpSocket -mcastadd $group -remote [list $group $port]
set afterId [after 5000 Broadcast]


set forever 0
vwait forever







<
<
<
<
|







 







|
|
|
|
>
|
|
<
|
|
|
<
|
>
>
>
>
>
>







 







|








466
467
468
469
470
471
472




473
474
475
476
477
478
479
480
...
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
...
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
            }
            if {![regexp {^([^ ]+) +([^ ]+) ([^ ]+)$} $line -> method url version]} {
                return
            }
 
            switch -exact -- $method {
                POST { 




                    if {[dict exists $request header transfer-encoding
                        && [dict get $request header transfer-encoding] eq "chunked"} {
                        # Receive chunked request body.
                        while {[scan [gets $sock line] %x length] == 1 && $length > 0} {
                            chan configure $sock -translation binary
                            append data [read $sock $length]
                            chan configure $sock -translation crlf
                        }
................................................................................
    set requestArr(reply) $replyDict
    return;
}

proc GetMyIp {} {
    variable serverInfo

    set serverInfo(ipAddr) {}
    set serverSocket [socket -server GetMyIpPart2 0]
    puts  [fconfigure $serverSocket -sockname]
    set serverPort [lindex [fconfigure $serverSocket -sockname] 2]
    set sid [socket -async [info hostname] $serverPort]
    vwait serverInfo(ipAddr)
    close $sid

    close $serverSocket
    return
}


proc GetMyIpPart2 {socket ipAddr port} {
    variable serverInfo

    set serverInfo(ipAddr) [lindex [fconfigure $socket -sockname] 0]
    close $socket
}

proc GetFileList {} {
    set results [list]
    foreach file [glob -nocomplain *.tcl] {
        lappend results $file [file mtime $file]
    }
    foreach file [glob -nocomplain *.png] {
................................................................................

httpd addHandler $port /ScriptSever HandleRequest
httpd listen $port

GetMyIp
set serverInfo(datagram) [dict create port $port host $serverInfo(ipAddr)]
set group 224.5.1.21
set port  7773
set udpSocket [udp_open $port]
fconfigure $udpSocket -buffering none -blocking 0
fconfigure $udpSocket -mcastadd $group -remote [list $group $port]
set afterId [after 5000 Broadcast]


set forever 0
vwait forever

Changes to TkGems.tcl.

32
33
34
35
36
37
38

39
40
41
42
43
44
45
 # * Robot/Sortkey: calc. number of exploding gems for move --> optimize play
 # * Random seed --> Robot-Benchmark
 # * detect "triple play" in either direction
 # * "Last chance" - prompt for "triple play" before gameover

 package require Tk 8.3


 array set S {title "Gem Game" version 1.5.7 cols 10 rows 10 cell 30 jewels 7}
 set S(w) [expr {$S(cell) * $S(cols) + 10}]
 set S(h) [expr {$S(cell) * $S(rows) + 10}]
 set S(delay) 10
 set S(mute) 0
 set S(lvl) 2
 #set S(strlvl) "Level 2"







>







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
 # * Robot/Sortkey: calc. number of exploding gems for move --> optimize play
 # * Random seed --> Robot-Benchmark
 # * detect "triple play" in either direction
 # * "Last chance" - prompt for "triple play" before gameover

 package require Tk 8.3

 set targetDpi 100
 array set S {title "Gem Game" version 1.5.7 cols 10 rows 10 cell 30 jewels 7}
 set S(w) [expr {$S(cell) * $S(cols) + 10}]
 set S(h) [expr {$S(cell) * $S(rows) + 10}]
 set S(delay) 10
 set S(mute) 0
 set S(lvl) 2
 #set S(strlvl) "Level 2"