~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

Open Mash Cross Reference
mash/tcl/psvp/effects/titling-ps-alpha2.tcl

Component: ~ [ mash ] ~ [ apps ] ~ [ gsm ] ~ [ lib ] ~ [ otcl ] ~ [ srm ] ~ [ tcl8.3 ] ~ [ tclcl ] ~ [ tk8.3 ] ~ [ tutorials ] ~

  1 # titling-ps-alpha2.tcl --
  2 #
  3 #       FIXME: This file needs a description here.
  4 #
  5 # Copyright (c) 1999-2002 The Regents of the University of California.
  6 # All rights reserved.
  7 #
  8 # Redistribution and use in source and binary forms, with or without
  9 # modification, are permitted provided that the following conditions are met:
 10 #
 11 # A. Redistributions of source code must retain the above copyright notice,
 12 #    this list of conditions and the following disclaimer.
 13 # B. Redistributions in binary form must reproduce the above copyright notice,
 14 #    this list of conditions and the following disclaimer in the documentation
 15 #    and/or other materials provided with the distribution.
 16 # C. Neither the names of the copyright holders nor the names of its
 17 #    contributors may be used to endorse or promote products derived from this
 18 #    software without specific prior written permission.
 19 #
 20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
 21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 23 # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
 24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
 26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 30 
 31 import DaliSubprogram
 32 import RealParameter
 33 import TextParameter
 34 import IntParameter
 35 
 36 Class TitleSubprogram -superclass DaliSubprogram
 37 
 38 TitleSubprogram instproc init {args} {
 39     eval $self next $args;
 40 
 41     # Set up inputs
 42 
 43     $self instvar input_id_list_;
 44     $self instvar input_info_;
 45 
 46     lappend input_id_list_ i1
 47 
 48     set input_info_(i1,spec) "";
 49     set input_info_(i1,trigger) 0;
 50     set input_info_(i1,buffertype) Uncompressed;
 51     set input_info_(i1,buffername) [new VidRep/Uncompressed];
 52     set input_info_(i1,decoder) "";
 53 
 54     # Set up outputs
 55 
 56     $self instvar output_id_list_;
 57     $self instvar output_info_;
 58 
 59     lappend output_id_list_ o1;
 60 
 61     set output_info_(o1,spec) "";
 62     set output_info_(o1,buffertype) Uncompressed;
 63     set output_info_(o1,buffername) [new VidRep/Uncompressed];
 64     set output_info_(o1,encoder) "";
 65     set output_info_(o1,format) JPEG;
 66     set output_info_(o1,vagent) "";
 67 
 68     # Set up which input will drive each output's synchronization
 69     $self set_ntp_reference i1 o1
 70 
 71     # Set up parameters
 72 
 73     $self instvar parameter_id_list_;
 74     $self instvar parameter_info_;
 75 
 76     lappend parameter_id_list_ text
 77     set pobj [new TextParameter];
 78     set parameter_info_(text,oname) $pobj;
 79     $pobj set "";
 80 
 81     lappend parameter_id_list_ xpos
 82     set pobj [new IntParameter];
 83     set parameter_info_(xpos,oname) $pobj;
 84     $pobj from 0
 85     $pobj to 320
 86     $pobj set 0
 87 
 88     lappend parameter_id_list_ ypos
 89     set pobj [new IntParameter];
 90     set parameter_info_(ypos,oname) $pobj;
 91     $pobj from 0
 92     $pobj to 240
 93     $pobj set 0
 94 
 95     lappend parameter_id_list_ back_lum
 96     set pobj [new IntParameter];
 97     set parameter_info_(back_lum,oname) $pobj;
 98     $pobj from 0;
 99     $pobj to 255;
100     $pobj set 128;
101 
102     lappend parameter_id_list_ back_cr
103     set pobj [new IntParameter];
104     set parameter_info_(back_cr,oname) $pobj;
105     $pobj from 0;
106     $pobj to 255;
107     $pobj set 128;
108 
109     lappend parameter_id_list_ back_cb
110     set pobj [new IntParameter];
111     set parameter_info_(back_cb,oname) $pobj;
112     $pobj from 0;
113     $pobj to 255;
114     $pobj set 128;
115 
116     lappend parameter_id_list_ point_size;
117     set pobj [new IntParameter];
118     set parameter_info_(point_size,oname) $pobj;
119     $pobj from 5
120     $pobj to 40
121     $pobj set 30
122 
123     lappend parameter_id_list_ font
124     set pobj [new ExclusiveChoiceParameter];
125     set parameter_info_(font,oname) $pobj;
126     $pobj add "Times-Roman"
127     $pobj add "Times-Bold"
128     $pobj add "Times-Italic"
129     $pobj add "Helvetica"
130     $pobj add "Helvetica-Bold"
131     $pobj add "Helvetica-Narrow"
132     $pobj set "Times-Roman"
133 
134     lappend parameter_id_list_ back_alpha
135     set pobj [new RealParameter];
136     set parameter_info_(back_alpha,oname) $pobj;
137     $pobj from 0.0
138     $pobj to 1.0
139     $pobj set 0.5
140 
141     lappend parameter_id_list_ master_alpha
142     set pobj [new RealParameter];
143     set parameter_info_(master_alpha,oname) $pobj;
144     $pobj from 0.0
145     $pobj to 1.0
146     $pobj set 0.0
147 
148     $self instvar comm_obj_;
149     $comm_obj_ setup;
150 }
151 
152 TitleSubprogram instproc trigger {} {
153     $self instvar comm_obj_;
154 
155     $self instvar parameter_id_list_;
156 
157     foreach p $parameter_id_list_ {
158         if {![$comm_obj_  parameter_attr_has_value $p value]} {
159             return;
160         }
161     }
162 
163     $self instvar init_done_;
164     $self instvar input_info_ output_info_
165 
166     $self instvar old_xpos_ old_ypos_ old_text_ old_sz_ old_font_
167     $self instvar old_balpha_ old_malpha_;
168 
169     set in_frame $input_info_(i1,buffername);
170     set out_frame $output_info_(o1,buffername);
171 
172     if {![info exists init_done_]} {
173         # Stuff to do only the first time
174         if {[$in_frame set w_] == 0} {
175             return;
176         }
177         $out_frame copy_geometry $in_frame;
178         if {$output_info_(o1,format) == "JPEG"} {
179             $out_frame set h_subsample_ 2;
180             $out_frame set v_subsample_ 1;
181         } else {
182             $out_frame set h_subsample_ 2;
183             $out_frame set v_subsample_ 2;
184         }
185         $out_frame allocate;
186 
187         set old_xpos_ "";
188         set old_ypos_ "";
189         set old_text_ "";
190         set old_sz_ "";
191         set old_font_ "";
192         set old_balpha_ "";
193         set old_malpha_ "";
194         set init_done_ 1;
195     }
196 
197     $self instvar parameter_info_;
198 
199     set xpos [$parameter_info_(xpos,oname) get];
200     set ypos [$parameter_info_(ypos,oname) get];
201     set text [$parameter_info_(text,oname) get];
202     set sz [$parameter_info_(point_size,oname) get];
203     set font [$parameter_info_(font,oname) get];
204     set balpha [$parameter_info_(back_alpha,oname) get];
205     set malpha [$parameter_info_(master_alpha,oname) get];
206     set blum [$parameter_info_(back_lum,oname) get];
207     set bcr [$parameter_info_(back_cr,oname) get];
208     set bcb [$parameter_info_(back_cb,oname) get];
209 
210     $self instvar y_clip_ cr_clip_ cb_clip_;
211     $self instvar text_mask_ inv_text_mask_;
212     $self instvar alpha_text_mask_ alpha_inv_text_mask_;
213     $self instvar subsamp_alpha_text_mask_ subsamp_alpha_inv_text_mask_;
214 
215     set recalc_alphas 0;
216 
217     if {$old_xpos_ != $xpos || $old_ypos_ != $ypos || $old_text_ != $text || $old_sz_ != $sz || $old_font_ != $font} {
218         # Do changes associated with xpos, ypos and text
219 
220         if {($old_sz_ != $sz) || ($old_text_ != $text) || ($old_font_ != $font)} {
221 
222             if {[info exists text_mask_]} {
223                 byte_free $text_mask_;
224             }
225             if {[info exists inv_text_mask_]} {
226                 byte_free $inv_text_mask_;
227             }
228             if {[info exists alpha_text_mask_]} {
229                 byte_free $alpha_text_mask_;
230             }
231             if {[info exists alpha_inv_text_mask_]} {
232                 byte_free $alpha_inv_text_mask_;
233             }
234             if {[info exists subsamp_alpha_text_mask_]} {
235                 byte_free $subsamp_alpha_text_mask_;
236             }
237             if {[info exists subsamp_alpha_inv_text_mask_]} {
238                 byte_free $subsamp_alpha_inv_text_mask_;
239             }
240 
241             set text_mask_ [$self DrawString $text $sz $font];
242             set old_text_ $text;
243             set old_sz_ $sz;
244             set old_font_ $font;
245 
246             set inv_text_mask_ [byte_new [byte_get_width $text_mask_] [byte_get_height $text_mask_]];
247             byte_not $text_mask_ $inv_text_mask_
248 
249             set alpha_text_mask_ [byte_new [byte_get_width $text_mask_] [byte_get_height $text_mask_]];
250             set alpha_inv_text_mask_ [byte_new [byte_get_width $text_mask_] [byte_get_height $text_mask_]];
251 
252             set subsamp_alpha_text_mask_ [byte_new [expr [byte_get_width $text_mask_] / [$out_frame set h_subsample_]] [expr [byte_get_height $text_mask_] / [$out_frame set v_subsample_]]];
253 
254             set subsamp_alpha_inv_text_mask_ [byte_new [expr [byte_get_width $text_mask_] / [$out_frame set h_subsample_]] [expr [byte_get_height $text_mask_] / [$out_frame set v_subsample_]]];
255 
256             set recalc_alphas 1;
257         }
258 
259         set old_xpos_ $xpos;
260         set old_ypos_ $ypos;
261 
262         set str_width [byte_get_width $text_mask_];
263         set str_height [byte_get_height $text_mask_];
264 
265         set left $xpos;
266         set right [expr $xpos + $str_width - 1];
267         set top $ypos;
268         set bottom [expr $ypos + $str_height - 1];
269 
270         if {$left < 0} {set left 0};
271         if {$right > [$out_frame set w_]} {set right [$out_frame set w_]};
272         if {$top < 0} {set top 0};
273         if {$bottom > [$out_frame set h_]} {set bottom [$out_frame set h_]};
274 
275         if {[info exists y_clip_]} {
276             byte_free $y_clip_;
277             unset y_clip_;
278         }
279         if {[info exists cr_clip_]} {
280             byte_free $cr_clip_;
281             unset cr_clip_;
282         }
283         if {[info exists cb_clip_]} {
284             byte_free $cb_clip_;
285             unset cb_clip_;
286         }
287 
288         set cwidth [expr $right - $left + 1];
289         set cheight [expr $bottom - $top + 1];
290 
291         set y_clip_ [byte_clip [$out_frame get_lum_name] $left $top $cwidth $cheight];
292         set cr_clip_ [byte_clip [$out_frame get_cr_name] [expr $left / [$out_frame set h_subsample_]] [expr $top / [$out_frame set v_subsample_]] [expr $cwidth / [$out_frame set h_subsample_]] [expr $cheight / [$out_frame set v_subsample_]]];
293         set cb_clip_ [byte_clip [$out_frame get_cb_name] [expr $left / [$out_frame set h_subsample_]] [expr $top / [$out_frame set v_subsample_]] [expr $cwidth / [$out_frame set h_subsample_]] [expr $cheight / [$out_frame set v_subsample_]]];
294     }
295 
296     if {$old_balpha_ != $balpha || $old_malpha_ != $malpha || $recalc_alphas == 1} {
297         set old_balpha_ $balpha;
298         set old_malpha_ $malpha;
299 
300         byte_scalar_mult $inv_text_mask_ $alpha_inv_text_mask_ [expr $balpha * $malpha];
301         byte_scalar_add $alpha_inv_text_mask_ $alpha_inv_text_mask_ [expr int(((1.0 - $balpha) * $malpha * 255) + ((1.0 - $malpha) * 255))];
302 
303         byte_scalar_mult $text_mask_ $alpha_text_mask_ $malpha;
304         byte_scalar_add $alpha_text_mask_ $alpha_text_mask_ [expr int(255 * (1.0 - $malpha))];
305 
306         if {[$out_frame set h_subsample_] == 2} {
307             if {[$out_frame set v_subsample_] == 2} {
308                 byte_shrink_2x2 $alpha_text_mask_ $subsamp_alpha_text_mask_;
309                 byte_shrink_2x2 $alpha_inv_text_mask_ $subsamp_alpha_inv_text_mask_;
310             } else {
311                 byte_shrink_2x1 $alpha_text_mask_ $subsamp_alpha_text_mask_;
312                 byte_shrink_2x1 $alpha_inv_text_mask_ $subsamp_alpha_inv_text_mask_;
313             }
314         } else {
315             if {[$out_frame set v_subsample_] == 2} {
316                 byte_shrink_1x2 $alpha_text_mask_ $subsamp_alpha_text_mask_;
317                 byte_shrink_1x2 $alpha_inv_text_mask_ $subsamp_alpha_inv_text_mask_;
318             } else {
319                 byte_copy $alpha_text_mask_ $subsamp_alpha_text_mask_;
320                 byte_copy $alpha_inv_text_mask_ $subsamp_alpha_inv_text_mask_;
321             }
322         }
323     }
324 
325     byte_copy [$in_frame get_lum_name] [$out_frame get_lum_name];
326     byte_copy [$in_frame get_cr_name] [$out_frame get_cr_name];
327     byte_copy [$in_frame get_cb_name] [$out_frame get_cb_name];
328 
329     byte_set_with_alpha_mask $y_clip_ $alpha_inv_text_mask_ $blum;
330     byte_set_with_alpha_mask $cr_clip_ $subsamp_alpha_inv_text_mask_ $bcr;
331     byte_set_with_alpha_mask $cb_clip_ $subsamp_alpha_inv_text_mask_ $bcb;
332 
333     byte_set_with_alpha_mask $y_clip_ $alpha_text_mask_ 255
334     byte_set_with_alpha_mask $cr_clip_ $subsamp_alpha_text_mask_ 128
335     byte_set_with_alpha_mask $cb_clip_ $subsamp_alpha_text_mask_ 128
336 
337     $out_frame set ts_ [$in_frame set ts_];
338 
339     set encoder $output_info_(o1,encoder);
340 
341     if {$encoder != ""} {
342         $encoder recv $out_frame;
343     }
344 
345     $self send_completion_token
346 
347     [[[[$input_info_(i1,decoder) set agent_] set network_] set net_(0)] set dn_] recv_flush
348 
349 }
350 
351 
352 TitleSubprogram instproc DrawString {str sz font} {
353     $self instvar id_;
354 
355     set coord_file "gs_${id_}.out";
356     set pgm_file "gs_${id_}.pgm";
357     set cut_file "gs_${id_}_cut.pgm";
358 
359     exec rm -f $coord_file
360     exec rm -f $pgm_file
361     set gs_fp [open "| gs -q -sDEVICE=pgmraw -dTextAlphaBits=4 -dGraphicsAlphaBits=4 -sOutputFile=$pgm_file > $coord_file" w];
362 
363     puts $gs_fp "/$font findfont $sz scalefont setfont"
364     puts $gs_fp "0 0 moveto"
365     puts $gs_fp "($str) true charpath flattenpath pathbbox"
366     puts $gs_fp "(\\ncoords\\n) print stack"
367     puts $gs_fp "pop"
368     puts $gs_fp "pop"
369     puts $gs_fp "-1 mul"
370     puts $gs_fp "2 1 roll"
371     puts $gs_fp "-1 mul"
372     puts $gs_fp "2 1 roll"
373     puts $gs_fp "translate"
374     puts $gs_fp "0 0 moveto"
375     puts $gs_fp "($str) show"
376     puts $gs_fp "showpage";
377     close $gs_fp;
378 
379     set fp [open "$coord_file" r];
380     set nline [gets $fp];
381     while {$nline != "coords"} {
382         set nline [gets $fp];
383     }
384     set y2 [gets $fp];
385     set x2 [gets $fp];
386     set y1 [gets $fp];
387     set x1 [gets $fp];
388 
389     close $fp;
390 
391     set width [expr int($x2 - $x1 + 0.5)];
392     set height [expr int($y2 - $y1 + 0.5)];
393 
394     exec rm -f $cut_file
395     exec pnmcut 0 [expr -1 * $height] $width $height $pgm_file > $cut_file
396     exec mv $cut_file $pgm_file
397 
398     set bs [bitstream_mmap_read_new $pgm_file];
399     set bp [bitparser_new];
400     bitparser_wrap $bp $bs;
401 
402     set hdr [pnm_hdr_new];
403 
404     pnm_hdr_parse $bp $hdr;
405 
406     set bimage [byte_new [pnm_hdr_get_width $hdr] [pnm_hdr_get_height $hdr]];
407     pgm_parse $bp $bimage;
408 
409     bitparser_free $bp
410     bitstream_mmap_read_free $bs
411     pnm_hdr_free $hdr
412 
413     return $bimage
414 }
415 
416 

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

This page was automatically generated by the LXR engine.
Visit the LXR main site for more information.