-
Notifications
You must be signed in to change notification settings - Fork 2
/
scdscan.tin
216 lines (185 loc) · 10.4 KB
/
scdscan.tin
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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defnet scdscan (th-main name av pix default-info which @v)
(deflocal key)
(pix-wip pix)
(opt (gui-draw-image-th th-main))
(sendbuf 100 (cons "p2" "scanning ") to th-main)
(sendbuf 100 (cons "p2c" (cons (blue) name)) to th-main)
(sendbuf 100 (cons "p2" "...\n") to th-main)
(set key (key-scd av name))
(set @v (cfg-get key))
(if (<> @v undef)
then (set @v <@v 4>)
else (set @v (array default 0 (- (av-approximated-number-of-frames av) 1)))
(if (and (cmingw) (= (csysbits) 32))
then (scdscan-low-alternate th-main name av pix default-info (my-av-par which av) @v)
else (scdscan-low th-main name av pix default-info (my-av-par which av) @v) )
(cfg-set key (list (width av) (height av) (av-approximated-number-of-frames av) name @v)) ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defnet scdscan-low (th-main name av pix default-info par v)
(deflocal path nthreads nframes t d threads th tot msg i)
(set path (av-path av))
(set nthreads (cfg-get-or-default-num "scd-threads" default-info))
(set nframes (+ (length v) 1))
(set t (now))
(repeat (set d (/ (- (length v) 1) nthreads))
until (= nthreads 1)
until (>= d 10)
(dec nthreads) )
(set threads (array nthreads))
(for i in 1 .. nthreads do
(set <threads (for-pos)> (thread-create (netptr scdscan-segment-th)
(thread-self)
path
(floor (* d (for-pos)))
(+ (ceil (* d i)) 1) v )))
(sendbuf 100 (cons "p2" "scanning threads: ") to th-main)
(sendbuf 100 (cons "p2c" (cons (blue) (sprint nthreads nl))) to th-main)
(set tot 0)
(while (> (length threads) 0) do
(receive msg from th in threads)
(alt (seq (integerp msg)
(set tot (min (+ tot msg) nframes))
(sendbuf 100 (cons "c1" (+ "frame " tot "/" nframes
" (" (rint (/ tot (- (now) t))) " fps) ("
(rint (/ tot nframes 0.01)) "%)" ))
to th-main ))
(seq (or (= msg "q") (= (car msg) "e"))
(if (= (car msg) "e")
then (if (integerp (cdr msg))
then (sendbuf 100 (cons "p2"
(+ $"frame # " (cdr msg) $" is not recoverable by a seek" nl) )
to th-main )
(sendbuf 100 (cons "p2c" (cons (red)
(+ $"too irregular timestamps not supported\n(more info in the guide)" nl) ))
to th-main ))
(set <_abort 0> true) )
(in th threads i)
(array-remove threads i)
(thread-join th) )
(success) ))
(not <_abort 0>)
(sendbuf 100 (cons "c1" (+ "frame " nframes "/" nframes
" (" (rint (/ tot (- (now) t))) " fps) (100%)")) to th-main ))
(defnet scdscan-segment-th (th path beg end v)
(deflocal res)
(set res (array 1))
(alt (seq (scdscan-segment-low th path beg end v res)
(send "q" to th) )
(send (cons "e" <res 0>) to th) ))
(defnet scdscan-segment-low (th path beg end v res)
(deflocal av frm hst frameno cnt prv)
(set av (av-avformat-open-input path))
(<> av undef)
(set frm (pix-create (width av) (height av)))
(pixp frm)
(set hst (array 2))
(set <hst 0> (raw 256))
(rawp <hst 0>)
(set <hst 1> (raw 256))
(rawp <hst 1>)
(set end (min end (- (length v) 1)))
(set frameno beg)
(set cnt 0)
(set prv 0)
(alt (seq (av-read-frame av frm frameno)
(= (av-frameno av) frameno)
(truep (av-is-frame-recoverable av))
(pix-scd-histogram-set frm <hst (% cnt 2)>) )
(seq (close av frm <hst 0> <hst 1>)
(set <res 0> frameno)
(fail) ))
(while (not <_abort 0>) do
(inc frameno)
until (> frameno end)
(inc cnt)
(alt (seq (av-read-frame av frm frameno)
(= (av-frameno av) frameno)
(truep (av-is-frame-recoverable av))
(pix-scd-histogram-set frm <hst (% cnt 2)>)
(set <v frameno> (pix-scd-histogram-dist <hst 0> <hst 1>))
(if (= (% cnt 100) 0)
then (sendbuf 30 (- cnt prv) to th)
(set prv cnt) ))
(seq ; hack che rende tollerabile l'illeggibilità
; di (pochi) ultimi frame
(< (- (length v) frameno) 150)
(set frameno end) )
(seq (close av frm <hst 0> <hst 1>)
(set <res 0> frameno)
(fail) )))
(close av frm <hst 0> <hst 1>)
(not <_abort 0>)
(if (> cnt prv)
then (send (- cnt prv) to th) ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defnet scdscan-low-alternate (th-main name av pix default-info par v)
(deflocal done abort l l1 hst idx frameno t)
(av-rewind av)
(set l1 (length v))
(set l (+ l1 1))
(set hst (array 2))
(set <hst 0> (raw 256))
(set <hst 1> (raw 256))
(set t (now))
(av-read-scd-histogram-set av <hst 0>)
(set idx 1)
(set done false)
(set abort false)
(repeat (alt (av-read-scd-histogram-set av <hst idx>)
(set done true) )
until done
(set frameno (av-frameno av))
until (>= frameno l1)
(if (not (av-is-frame-recoverable av))
then (sendbuf 100 (cons "p2" (+ $"frame # " frameno $" is not recoverable by a seek" nl
$"expected timestamp" ": " (approx4 (av-frameno2ts av frameno)) " s" nl
$"detected timestamp" ": " (approx4 (* (av-ts av) (av-time-base av (av-video-stream-idx av)))) " s"
nl )) to th-main )
(sendbuf 100 (cons "p2c" (cons (red) (+ $"too irregular timestamps not supported\n(more info in the guide)" nl ))) to th-main)
(set abort true) )
(if <_abort 0>
then (set abort true) )
until abort
(set <v frameno> (pix-scd-histogram-dist <hst 0> <hst 1>))
(if (= (% frameno 100) 0)
then (sendbuf 100 (cons "c1" (+ "frame " frameno "/" l " (" (rint (/ frameno (- (now) t)))
" fps) (" (rint (/ frameno l 0.01)) "%)" ))
to th-main ))
(set idx (- 1 idx)) )
(close <hst 0> <hst 1>)
(not abort)
(sendbuf 100 (cons "c1" (+ "frame " l "/" l " (" (rint (/ frameno (- (now) t))) " fps) (100%)")) to th-main) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;; ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;