2006-10-30 16:32:50 +01:00
namespace eval VMEncoder {
variable var
2011-04-13 17:24:36 +02:00
variable JP3Dencoder " . . / b i n / v o l u m e _ t o _ j p 3 d . e x e "
2006-10-30 16:32:50 +01:00
}
proc VMEncoder::create { nb } {
set frame [ $nb insert end VMEncoder - text " E n c o d e r " ]
set topf [ frame $frame.topf ]
set midf [ frame $frame.midf ]
set bottomf [ frame $frame.bottomf ]
set srcf [ TitleFrame $topf.srcf - text " S o u r c e " ]
set dstf [ TitleFrame $topf.dstf - text " D e s t i n a t i o n " ]
set Tparf [ TitleFrame $midf.parfT - text " T r a n s f o r m P a r a m e t e r s " ]
set Cparf [ TitleFrame $midf.parfC - text " C o d i n g P a r a m e t e r s " ]
set frame1 [ $srcf getframe ]
VMEncoder : : _sourceE $frame1
set frame2 [ $dstf getframe ]
VMEncoder : : _destinationE $frame2
set frame3 [ $Tparf getframe ]
VMEncoder : : _transformE $frame3
set frame4 [ $Cparf getframe ]
VMEncoder : : _codingE $frame4
set butE [ Button $bottomf.butE - text " E n c o d e ! " \
-command " V M E n c o d e r : : _ e n c o d e $ f r a m e 1 $ f r a m e 2 " \
-helptext " E n c o d i n g t r i g g e r b u t t o n " ]
set butR [ Button $bottomf.butR - text " R e s t o r e d e f a u l t s " \
-command " V M E n c o d e r : : _ r e s e t $ f r a m e 1 $ f r a m e 2 $ f r a m e 3 $ f r a m e 4 " \
-helptext " R e s e t t o d e f a u l t v a l u e s " ]
pack $srcf $dstf - side left - fill y - padx 4 - expand yes
pack $topf - pady 2 - fill x
pack $Tparf $Cparf - side left - fill both - padx 4 - expand yes
pack $midf - pady 2 - fill x
pack $butE $butR - side left - padx 40 - pady 5 - fill y - expand yes
pack $bottomf - pady 2 - fill x
return $frame
}
proc VMEncoder::_sourceE { parent } {
variable var
set labsrc [ LabelFrame $parent.labsrc - text " S e l e c t v o l u m e f i l e t o e n c o d e : " - side top \
-anchor w - relief flat - borderwidth 0 ]
set subsrc [ $labsrc getframe ]
set list [ entry $subsrc.entrysrc - width 30 - textvariable VMDecoder::var( source ) ]
set labbrw [ LabelFrame $parent.labbrw - side top - anchor w - relief flat - borderwidth 0 ]
set subbrw [ $labbrw getframe ]
set butbrw [ button $subbrw.butbrw - image [ Bitmap : : get open] \
-relief raised - borderwidth 1 - padx 1 - pady 1 \
-command " f i l e D i a l o g E . $ s u b s r c . e n t r y s r c o p e n " ]
pack $list - side top
pack $butbrw - side top
pack $labsrc $labbrw - side left - fill both - expand yes
}
proc VMEncoder::_destinationE { parent } {
variable var
set labdst [ LabelFrame $parent.labdst - text " S a v e c o m p r e s s e d v o l u m e a s : " - side top \
-anchor w - relief flat - borderwidth 0 ]
set subdst [ $labdst getframe ]
set list [ entry $subdst.entrydst - width 30 - textvariable VMDecoder::var( destination ) ]
set labbrw [ LabelFrame $parent.labbrw - side top - anchor w - relief flat - borderwidth 0 ]
set subbrw [ $labbrw getframe ]
set butbrw [ button $subbrw.butbrw - image [ Bitmap : : get save] \
-relief raised - borderwidth 1 - padx 1 - pady 1 \
-command " f i l e D i a l o g E . $ s u b d s t . e n t r y d s t s a v e " ]
pack $list - side top
pack $butbrw - side top
pack $labdst $labbrw - side left - fill both - expand yes
}
proc VMEncoder::_codingE { parent } {
# ########## CODING #############
set labcod [ LabelFrame $parent.labcod - side top - anchor w - relief sunken - borderwidth 1 ]
set subcod [ $labcod getframe ]
set framerate [ frame $subcod.framerate - borderwidth 1 ]
set labrate [ LabelEntry $framerate.labrate - label " R a t e s : " - labelwidth 9 - labelanchor w \
-textvariable VMEncoder::var( rate ) - editable 1 \
-helptext " C o m p r e s s i o n r a t i o s f o r d i f f e r e n t l a y e r s ( R 1 , R 2 , R 3 , . . . ) . I f R = 1 , l o s s l e s s c o d i n g " ]
set VMEncoder::var( rate ) " 1 "
set framecblk [ frame $subcod.framecblk - borderwidth 1 ]
set labcblk [ LabelEntry $framecblk.labcblk - label " C o d e b l o c k : " - labelwidth 9 - labelanchor w \
-textvariable VMEncoder::var( cblksize ) - editable 1 \
-helptext " C o d e b l o c k s i z e ( X , Y , Z ) " ]
set VMEncoder::var( cblksize ) " 6 4 , 6 4 , 6 4 "
set frametile [ frame $subcod.frametile - borderwidth 1 ]
set labtile [ LabelEntry $frametile.labtile - label " T i l e s i z e : " - labelwidth 9 - labelanchor w \
-textvariable VMEncoder::var( tilesize ) - editable 1 \
-helptext " T i l e s i z e ( X , Y , Z ) " ]
set VMEncoder::var( tilesize ) " 5 1 2 , 5 1 2 , 5 1 2 "
set framesop [ frame $subcod.framesop - borderwidth 1 ]
set chksop [ checkbutton $framesop.chksop - text " W r i t e S O P m a r k e r " \
-variable VMEncoder::var( sop ) - onvalue 1 - offvalue 0 ]
set frameeph [ frame $subcod.frameeph - borderwidth 1 ]
set chkeph [ checkbutton $frameeph.chkeph - text " W r i t e E P H m a r k e r " \
-variable VMEncoder::var( eph ) - onvalue 1 - offvalue 0 ]
set framepoc [ frame $subcod.framepoc - borderwidth 1 ]
set labpoc [ label $framepoc.labpoc - text " P r o g r e s s i o n o r d e r : " ]
set progorder [ ComboBox $framepoc.progorder \
-text { Choose a progression order} \
-width 10 \
-textvariable VMEncoder::var( progorder ) \
-values { " L R C P " " R L C P " " R P C L " " P C R L " " C P R L " } \
-helptext " P r o g r e s s i o n o r d e r " ]
set VMEncoder::var( progorder ) " L R C P "
pack $labrate - side left - padx 2 - anchor n
pack $labcblk - side left - padx 2 - anchor n
pack $labpoc $progorder - side left - padx 2 - anchor w
# pack $labtile -side left -padx 2 -anchor n
pack $chksop - side left - padx 2 - anchor w
pack $chkeph - side left - padx 2 - anchor w
# ########## ENTROPY CODING #############
set labent [ LabelFrame $parent.labent - text " E n t r o p y C o d i n g " - side top - anchor w - relief sunken - borderwidth 1 ]
set subent [ $labent getframe ]
foreach entval { 2EB 3 EB} entropy { 2D_EBCOT 3 D_EBCOT} {
set rad [ radiobutton $subent. $entval \
-text $entropy \
-variable VMEncoder::var( encoding ) \
-command " d i s a b l e G R $ e n t v a l $ l a b c b l k $ p r o g o r d e r $ l a b r a t e $ c h k s o p $ c h k e p h " \
-value $entval ]
pack $rad - anchor w
}
$subent.2EB select
pack $subent - padx 2 - anchor n
pack $framerate $framecblk $framepoc $framesop $frameeph - side top - anchor w
pack $subcod - anchor n
pack $labent $labcod - side left - fill both - padx 4 - expand yes
}
proc VMEncoder::_transformE { parent } {
variable var
# ########## TRANSFORM #############
set labtrf [ LabelFrame $parent.labtrf - text " T r a n s f o r m " - side top - anchor w - relief sunken - borderwidth 1 ]
set subtrf [ $labtrf getframe ]
set labres [ LabelFrame $parent.labres - side top - anchor w - relief sunken - borderwidth 1 ]
set subres [ $labres getframe ]
# ########## ATK #############
set frameatk [ frame $subres.frameatk - borderwidth 1 ]
set labatk [ label $frameatk.labatk - text " W a v e l e t k e r n e l : " - anchor w]
set atk [ ComboBox $frameatk.atk \
-textvariable VMEncoder::var( atk ) \
-width 20 \
-text { Choose a wavelet kernel} \
-editable false \
-values { " R 5 . 3 " " I 9 . 7 " } ]
set VMEncoder::var( atk ) " R 5 . 3 "
pack $labatk $atk - side left - anchor w
# ########## RESOLUTIONS #############
set frameres1 [ frame $subres.frameres1 - borderwidth 1 ]
set labresolution [ label $frameres1.labresol - text " R e s o l u t i o n s : " - anchor w ]
set frameres2 [ frame $subres.frameres2 - borderwidth 1 ]
set labresX [ label $frameres2.labresX - text " X " - anchor w ]
set labresY [ label $frameres2.labresY - text " Y " - anchor w ]
set labresZ [ label $frameres2.labresZ - text " Z " - anchor w ]
set resX [ SpinBox $frameres2.spinresX \
-range { 1 6 1 } - textvariable VMEncoder::var( resX ) \
-helptext " N u m b e r o f r e s o l u t i o n s i n X " \
-width 3 \
-editable false ]
set resY [ SpinBox $frameres2.spinresY \
-range { 1 6 1 } - textvariable VMEncoder::var( resY ) \
-helptext " N u m b e r o f r e s o l u t i o n s i n Y " \
-width 3 \
-editable false ]
set resZ [ SpinBox $frameres2.spinresZ \
-range { 1 6 1 } - textvariable VMEncoder::var( resZ ) \
-helptext " N u m b e r o f r e s o l u t i o n s i n Z " \
-width 3 \
-editable false \
-state disabled ]
set VMEncoder::var( resX ) 3
set VMEncoder::var( resY ) 3
set VMEncoder::var( resZ ) 3
# ########## TRF #############
foreach trfval { 2DWT 3 DWT} trf { 2D-DWT 3 D-DWT} {
set rad [ radiobutton $subtrf. $trfval - text $trf \
-variable VMEncoder::var( transform ) \
-command " d i s a b l e 3 R L S $ t r f v a l $ a t k $ r e s X $ r e s Y $ r e s Z " \
-value $trfval ]
pack $rad - anchor w
}
$subtrf.2DWT select
pack $subtrf - side left - padx 2 - pady 4
pack $labresolution - padx 2 - side left - anchor w
pack $labresX $resX - padx 2 - side left - anchor w
pack $labresY $resY - padx 2 - side left - anchor w
pack $labresZ $resZ - padx 2 - side left - anchor w
pack $frameres1 - side top - fill x
pack $frameres2 $frameatk - side top - padx 2 - pady 4 - anchor n
pack $subres - side left - padx 2 - pady 4
pack $labtrf $labres - side left - fill both - padx 4 - expand yes
}
proc VMEncoder::_encode { framesrc framedst } {
variable var
set source [ $framesrc.labsrc.f.entrysrc get ]
set destination [ $framedst.labdst.f.entrydst get ]
set cond1 [ string match * .pgx [ string tolower $source ] ]
set cond2 [ string match * - * .pgx [ string tolower $source ] ]
set cond3 [ string match * .bin [ string tolower $source ] ]
set img " . i m g "
set pattern [ string range $source 0 [ expr [ string length $source ] - 5 ] ]
set pattern $pattern $img
set exist [ file exists $pattern ]
# comprobamos datos son correctos
if { ( $cond1 == 1 ) && ( $cond2 == 0 ) } {
MessageDlg .msgdlg - parent . - message " I n f o : R e a l l y w a n t t o e n c o d e a n s l i c e i n s t e a d o f a v o l u m e ? . \n F o r a g r o u p o f . p g x s l i c e s , n a m e m u s t c o n t a i n a - d e n o t i n g a s e q u e n t i a l i n d e x ! " - type ok - icon info
}
if { $source == " " } {
MessageDlg .msgdlg - parent . - message " E r r o r : S o u r c e f i l e i s n o t d e f i n e d ! " - type ok - icon error
} elseif { $destination == " " } {
MessageDlg .msgdlg - parent . - message " E r r o r : D e s t i n a t i o n f i l e i s n o t d e f i n e d ! " - type ok - icon error
} elseif { ( $VMEncoder::var ( transform ) != " 3 R L S " ) && ( $VMEncoder::var ( atk ) == " C h o o s e a w a v e l e t t r a n s f o r m a t i o n k e r n e l " ) } {
MessageDlg .msgdlg - parent . - title " I n f o " - message " P l e a s e c h o o s e a w a v e l e t t r a n s f o r m a t i o n k e r n e l " \
-type ok - icon warning
} elseif { ( $exist == 0 ) && ( $cond1 == 0 ) && ( $cond3 == 1 ) } {
MessageDlg .msgdlg - parent . - message " E r r o r : I M G f i l e a s s o c i a t e d t o B I N v o l u m e f i l e n o t f o u n d i n s a m e d i r e c t o r y ! " - type ok - icon info
} else {
# creamos datain a partir de los parametros de entrada
# set dirJP3Dencoder [mk_relativepath $VMEncoder::JP3Dencoder]
set dirJP3Dencoder $VMEncoder::JP3Dencoder
set datain [ concat " $ d i r J P 3 D e n c o d e r - i [ m k _ r e l a t i v e p a t h $ s o u r c e ] " ]
if { $cond3 == 1 } {
set datain [ concat " $ d a t a i n - m [ m k _ r e l a t i v e p a t h $ p a t t e r n ] " ]
}
set datain [ concat " $ d a t a i n - o [ m k _ r e l a t i v e p a t h $ d e s t i n a t i o n ] " ]
if { $VMEncoder::var ( encoding ) != " 2 E B " } {
set datain [ concat " $ d a t a i n - C $ V M E n c o d e r : : v a r ( e n c o d i n g ) " ]
}
if { $VMEncoder::var ( transform ) == " 2 D W T " } {
set datain [ concat " $ d a t a i n - n $ V M E n c o d e r : : v a r ( r e s X ) , $ V M E n c o d e r : : v a r ( r e s Y ) " ]
} elseif { $VMEncoder::var ( transform ) == " 3 D W T " } {
set datain [ concat " $ d a t a i n - n $ V M E n c o d e r : : v a r ( r e s X ) , $ V M E n c o d e r : : v a r ( r e s Y ) , $ V M E n c o d e r : : v a r ( r e s Z ) " ]
}
set datain [ concat " $ d a t a i n - r $ V M E n c o d e r : : v a r ( r a t e ) " ]
if { $VMEncoder::var ( atk ) == " I 9 . 7 " } {
set datain [ concat " $ d a t a i n - I " ]
}
if { $VMEncoder::var ( sop ) == 1 } {
set datain [ concat " $ d a t a i n - S O P " ]
}
if { $VMEncoder::var ( eph ) == 1 } {
set datain [ concat " $ d a t a i n - E P H " ]
}
if { $VMEncoder::var ( progorder ) != " L R C P " } {
set datain [ concat " $ d a t a i n - p $ V M E n c o d e r : : v a r ( p r o g o r d e r ) " ]
}
if { $VMEncoder::var ( cblksize ) != " 6 4 , 6 4 , 6 4 " } {
set datain [ concat " $ d a t a i n - b $ V M E n c o d e r : : v a r ( c b l k s i z e ) " ]
}
# Making this work would be great !!!
set VMEncoder::var( progval ) 10
ProgressDlg .progress - parent . - title " W a i t . . . " \
-type infinite \
-width 20 \
-textvariable " C o m p u t e i n p r o g r e s s . . . " \
-variable VMEncoder::progval \
-stop " S t o p " \
-command { destroy .progress}
after 200 set VMEncoder::var( progval ) 2
set fp [ open " | $ d a t a i n " r+ ]
fconfigure $fp - buffering line
set jp3dVM::dataout [ concat " E X E C U T E D P R O G R A M : \n \t $ d a t a i n " ]
while { -1 != [ gets $fp tmp] } {
set jp3dVM::dataout [ concat " $ j p 3 d V M : : d a t a o u t \n $ t m p " ]
}
destroy .progress
set cond [ string first " E R R O R " $jp3dVM::dataout ]
set cond2 [ string first " R E S U L T " $jp3dVM::dataout ]
if { $cond != -1 } {
MessageDlg .msgdlg - parent . - message [ string range $jp3dVM::dataout [ expr $cond-1 ] end] - type ok - icon error
} elseif { $cond2 != -1 } {
MessageDlg .msgdlg - parent . - message [ string range $jp3dVM::dataout [ expr $cond2 + 7 ] end] - type ok - icon info
close $fp
} else {
# Must do something with this !!! [pid $fp]
close $fp
}
}
}
proc VMEncoder::_reset { framesrc framedst frametrf framecod} {
variable var
# Restore defaults values
set VMEncoder::var( transform ) 2 DWT
set VMEncoder::var( encoding ) 2 EB
set VMEncoder::var( atk ) " R 5 . 3 "
set VMEncoder::var( progorder ) " L R C P "
set atk $frametrf.labres.f.frameatk.atk
set resX $frametrf.labres.f.frameres2.spinresX
set resY $frametrf.labres.f.frameres2.spinresY
set resZ $frametrf.labres.f.frameres2.spinresZ
disable3RLS 2 DWT $atk $resX $resY $resZ
set labcblk $framecod.labcod.f.framecblk.labcblk
set progorder $framecod.labcod.f.framepoc.progorder
set labrate $framecod.labcod.f.framerate.labrate
set chksop $framecod.labcod.f.framesop.chksop
set chkeph $framecod.labcod.f.frameeph.chkeph
disableGR 3 EB $labcblk $progorder $labrate $chksop $chkeph
$framesrc.labsrc.f.entrysrc delete 0 end
$framedst.labdst.f.entrydst delete 0 end
}
proc fileDialogE { w ent operation} {
variable file
variable i j
if { $operation == " o p e n " } {
set types {
{ " S o u r c e I m a g e F i l e s " { .pgx .bin} }
{ " A l l f i l e s " * }
}
set file [ tk_getOpenFile - filetypes $types - parent $w ]
if { [ string compare $file " " ] } {
$ent delete 0 end
$ent insert end $file
$ent xview moveto 1
}
} else {
set types {
{ " J P 3 D F i l e s " { .jp3d } }
{ " J P E G 2 0 0 0 F i l e s " { .j2k } }
{ " A l l f i l e s " * }
}
set file [ tk_getSaveFile - filetypes $types - parent $w \
-initialfile Untitled - defaultextension .jp3d]
if { [ string compare $file " " ] } {
$ent delete 0 end
$ent insert end $file
$ent xview moveto 1
}
}
}
proc mk_relativepath { abspath } {
set mydir [ split [ string trimleft [ pwd ] { / } ] { / } ]
set abspathcomps [ split [ string trimleft $abspath { / } ] { / } ]
set i 0
while { $i < [ llength $mydir ] } {
if { ! [ string compare [ lindex $abspathcomps $i ] [ lindex $mydir $i ] ] } {
incr i
} else {
break
}
}
set h [ expr [ llength $mydir ] - $i ]
set j [ expr [ llength $abspathcomps ] - $i ]
if { ! $h } {
set relpath " . / "
} else {
set relpath " "
while { $h > 0 } {
set relpath " . . / $ r e l p a t h "
incr h - 1
}
}
set h [ llength $abspathcomps ]
while { $h > $i } {
set relpath [ concat $relpath [ lindex $abspathcomps [ expr [ llength $abspathcomps ] - $j ] ] / ]
incr h - 1
incr j - 1
}
return [ string trim $relpath { / } ]
}
proc disable3RLS { flag atk resX resY resZ} {
if { $flag == " 3 R L S " } {
$atk configure - state disabled
$resX configure - state disabled
$resY configure - state disabled
$resZ configure - state disabled
} elseif { $flag == " 2 D W T " } {
$atk configure - state normal
$resX configure - state normal
$resY configure - state normal
$resZ configure - state disabled
} elseif { $flag == " 3 D W T " } {
$atk configure - state normal
$resX configure - state normal
$resY configure - state normal
$resZ configure - state normal
}
}
proc disableGR { flag labcblk progorder labrate chksop chkeph} {
if { $flag == " 2 E B " } {
$labcblk configure - state normal
$progorder configure - state normal
$labrate configure - state normal
$chksop configure - state normal
$chkeph configure - state normal
set VMEncoder::var( cblksize ) " 6 4 , 6 4 , 6 4 "
set VMEncoder::var( tilesize ) " 5 1 2 , 5 1 2 , 5 1 2 "
} elseif { $flag == " 3 E B " } {
$labcblk configure - state normal
$progorder configure - state normal
$labrate configure - state normal
$chksop configure - state normal
$chkeph configure - state normal
set VMEncoder::var( cblksize ) " 6 4 , 6 4 , 6 4 "
set VMEncoder::var( tilesize ) " 5 1 2 , 5 1 2 , 5 1 2 "
} else {
$labcblk configure - state disabled
$progorder configure - state disabled
$labrate configure - state disabled
$chksop configure - state disabled
$chkeph configure - state disabled
}
}
