tcltk/encoder.tcl

   1
   2 namespace eval VMEncoder {
   3         variable var
   4         variable JP3Dencoder "../bin/jp3d_vm_enc.exe"
   5 }
   6
   7 proc VMEncoder::create { nb } {
   8
   9         set frame [$nb insert end VMEncoder -text "Encoder"]
  10         set topf        [frame $frame.topf]
  11         set midf        [frame $frame.midf]
  12         set bottomf     [frame $frame.bottomf]
  13         set srcf [TitleFrame $topf.srcf -text "Source"]
  14         set dstf [TitleFrame $topf.dstf -text "Destination"]
  15         set Tparf [TitleFrame $midf.parfT -text "Transform Parameters"]
  16         set Cparf [TitleFrame $midf.parfC -text "Coding Parameters"]
  17
  18         set frame1 [$srcf getframe]
  19                 VMEncoder::_sourceE  $frame1
  20
  21         set frame2  [$dstf getframe]
  22                 VMEncoder::_destinationE  $frame2
  23
  24         set frame3  [$Tparf getframe]
  25                 VMEncoder::_transformE $frame3
  26
  27         set frame4  [$Cparf getframe]
  28                 VMEncoder::_codingE $frame4
  29
  30         set butE  [Button $bottomf.butE -text "Encode!" \
  31                    -command  "VMEncoder::_encode $frame1 $frame2" \
  32                    -helptext "Encoding trigger button"]
  33         set butR  [Button $bottomf.butR -text "Restore defaults" \
  34                    -command  "VMEncoder::_reset $frame1 $frame2 $frame3 $frame4" \
  35                    -helptext "Reset to default values"]
  36
  37         pack $srcf $dstf -side left -fill y -padx 4 -expand yes
  38         pack $topf -pady 2 -fill x
  39
  40         pack $Tparf $Cparf -side left -fill both -padx 4 -expand yes
  41         pack $midf -pady 2 -fill x
  42
  43         pack $butE $butR -side left -padx 40 -pady 5 -fill y -expand yes
  44         pack $bottomf -pady 2 -fill x
  45
  46         return $frame
  47 }
  48
  49 proc VMEncoder::_sourceE { parent } {
  50
  51         variable var
  52
  53         set labsrc [LabelFrame $parent.labsrc -text "Select volume file to encode: " -side top \
  54                         -anchor w -relief flat -borderwidth 0]
  55         set subsrc [$labsrc getframe]
  56         set list [entry $subsrc.entrysrc -width 30 -textvariable VMDecoder::var(source)]
  57
  58         set labbrw [LabelFrame $parent.labbrw -side top -anchor w -relief flat -borderwidth 0]
  59         set subbrw [$labbrw getframe]
  60         set butbrw [button $subbrw.butbrw -image [Bitmap::get open] \
  61                 -relief raised -borderwidth 1 -padx 1 -pady 1 \
  62                 -command "fileDialogE . $subsrc.entrysrc open"]
  63
  64         pack $list -side top
  65         pack $butbrw -side top
  66         pack $labsrc $labbrw -side left -fill both -expand yes
  67 }
  68
  69 proc VMEncoder::_destinationE { parent } {
  70
  71         variable var
  72
  73         set labdst [LabelFrame $parent.labdst -text "Save compressed volume as: " -side top \
  74                         -anchor w -relief flat -borderwidth 0]
  75         set subdst [$labdst getframe]
  76         set list [entry $subdst.entrydst -width 30 -textvariable VMDecoder::var(destination)]
  77
  78         set labbrw [LabelFrame $parent.labbrw -side top -anchor w -relief flat -borderwidth 0]
  79         set subbrw [$labbrw getframe]
  80         set butbrw [button $subbrw.butbrw -image [Bitmap::get save] \
  81                 -relief raised -borderwidth 1 -padx 1 -pady 1 \
  82                 -command "fileDialogE . $subdst.entrydst save"]
  83
  84         pack $list -side top
  85         pack $butbrw -side top
  86         pack $labdst $labbrw -side left -fill both -expand yes
  87 }
  88
  89 proc VMEncoder::_codingE { parent } {
  90
  91
  92         ########### CODING  #############
  93         set labcod [LabelFrame $parent.labcod -side top -anchor w -relief sunken -borderwidth 1]
  94         set subcod  [$labcod getframe]
  95
  96                 set framerate [frame $subcod.framerate -borderwidth 1]
  97                 set labrate [LabelEntry $framerate.labrate -label "Rates: " -labelwidth 9 -labelanchor w \
  98                    -textvariable VMEncoder::var(rate) -editable 1 \
  99                    -helptext "Compression ratios for different layers (R1, R2, R3,...). If R=1, lossless coding" ]
 100         set VMEncoder::var(rate) "1"
 101
 102                 set framecblk [frame $subcod.framecblk -borderwidth 1]
 103                 set labcblk [LabelEntry $framecblk.labcblk -label "Codeblock: " -labelwidth 9 -labelanchor w \
 104                    -textvariable VMEncoder::var(cblksize) -editable 1 \
 105                    -helptext "Codeblock size (X, Y, Z)" ]
 106         set VMEncoder::var(cblksize) "64,64,64"
 107
 108                 set frametile [frame $subcod.frametile -borderwidth 1]
 109                 set labtile [LabelEntry $frametile.labtile -label "Tile size: " -labelwidth 9 -labelanchor w \
 110                    -textvariable VMEncoder::var(tilesize) -editable 1 \
 111                    -helptext "Tile size (X, Y, Z)" ]
 112         set VMEncoder::var(tilesize) "512,512,512"
 113
 114                 set framesop [frame $subcod.framesop -borderwidth 1]
 115                 set chksop [checkbutton $framesop.chksop -text "Write SOP marker" \
 116                            -variable VMEncoder::var(sop) -onvalue 1 -offvalue 0 ]
 117                 set frameeph [frame $subcod.frameeph -borderwidth 1]
 118                 set chkeph [checkbutton $frameeph.chkeph -text "Write EPH marker" \
 119                            -variable VMEncoder::var(eph) -onvalue 1 -offvalue 0 ]
 120
 121                 set framepoc [frame $subcod.framepoc -borderwidth 1]
 122                 set labpoc [label $framepoc.labpoc -text "Progression order: " ]
 123                 set progorder [ComboBox $framepoc.progorder \
 124                            -text {Choose a progression order} \
 125                            -width 10 \
 126                            -textvariable VMEncoder::var(progorder) \
 127                            -values {"LRCP" "RLCP" "RPCL" "PCRL" "CPRL"} \
 128                            -helptext "Progression order"]
 129                 set VMEncoder::var(progorder) "LRCP"
 130
 131                 pack $labrate -side left -padx 2 -anchor n
 132                 pack $labcblk -side left -padx 2 -anchor n
 133                 pack $labpoc $progorder -side left -padx 2 -anchor w
 134                 #pack $labtile -side left -padx 2 -anchor n
 135                 pack $chksop -side left -padx 2 -anchor w
 136                 pack $chkeph -side left -padx 2 -anchor w
 137         ########### ENTROPY CODING  #############
 138         set labent [LabelFrame $parent.labent -text "Entropy Coding" -side top -anchor w -relief sunken -borderwidth 1]
 139         set subent  [$labent getframe]
 140                 foreach entval {2EB 3EB} entropy {2D_EBCOT 3D_EBCOT} {
 141                         set rad [radiobutton $subent.$entval \
 142                                 -text $entropy \
 143                                 -variable VMEncoder::var(encoding) \
 144                                 -command "disableGR $entval $labcblk $progorder $labrate $chksop $chkeph" \
 145                                 -value $entval ]
 146                         pack $rad -anchor w
 147                 }
 148                 $subent.2EB select
 149
 150         pack $subent -padx 2 -anchor n
 151
 152         pack $framerate $framecblk $framepoc $framesop $frameeph -side top -anchor w
 153         pack $subcod -anchor n
 154
 155         pack $labent $labcod -side left -fill both -padx 4 -expand yes
 156
 157
 158 }
 159
 160 proc VMEncoder::_transformE { parent } {
 161
 162         variable var
 163
 164         ########### TRANSFORM  #############
 165         set labtrf [LabelFrame $parent.labtrf -text "Transform" -side top -anchor w -relief sunken -borderwidth 1]
 166         set subtrf  [$labtrf getframe]
 167         set labres [LabelFrame $parent.labres -side top -anchor w -relief sunken -borderwidth 1]
 168         set subres [$labres getframe]
 169
 170                 ########### ATK #############
 171                 set frameatk [frame $subres.frameatk -borderwidth 1]
 172                 set labatk [label $frameatk.labatk -text "Wavelet kernel:  " -anchor w]
 173                 set atk [ComboBox $frameatk.atk \
 174                                 -textvariable VMEncoder::var(atk) \
 175                                 -width 20 \
 176                                 -text {Choose a wavelet kernel} \
 177                                 -editable false \
 178                                 -values {"R5.3" "I9.7"} ]
 179                 set VMEncoder::var(atk) "R5.3"
 180                 pack $labatk $atk -side left -anchor w
 181                 ########### RESOLUTIONS #############
 182                 set frameres1 [frame $subres.frameres1 -borderwidth 1]
 183                 set labresolution [label $frameres1.labresol -text "Resolutions: " -anchor w ]
 184                 set frameres2 [frame $subres.frameres2 -borderwidth 1]
 185                 set labresX [label $frameres2.labresX -text "  X" -anchor w ]
 186                 set labresY [label $frameres2.labresY -text "  Y" -anchor w ]
 187                 set labresZ [label $frameres2.labresZ -text "  Z" -anchor w ]
 188
 189
 190                 set resX [SpinBox $frameres2.spinresX \
 191                                 -range {1 6 1} -textvariable VMEncoder::var(resX) \
 192                                 -helptext "Number of resolutions in X" \
 193                                 -width 3 \
 194                                 -editable false ]
 195                 set resY [SpinBox $frameres2.spinresY \
 196                                 -range {1 6 1} -textvariable VMEncoder::var(resY) \
 197                                 -helptext "Number of resolutions in Y" \
 198                                 -width 3 \
 199                                 -editable false ]
 200                 set resZ [SpinBox $frameres2.spinresZ \
 201                                 -range {1 6 1} -textvariable VMEncoder::var(resZ) \
 202                                 -helptext "Number of resolutions in Z" \
 203                                 -width 3 \
 204                                 -editable false \
 205                                 -state disabled ]
 206                 set VMEncoder::var(resX) 3
 207                 set VMEncoder::var(resY) 3
 208                 set VMEncoder::var(resZ) 3
 209
 210                 ########### TRF  #############
 211                 foreach trfval {2DWT 3DWT} trf {2D-DWT 3D-DWT} {
 212                         set rad [radiobutton $subtrf.$trfval -text $trf \
 213                                         -variable VMEncoder::var(transform) \
 214                                         -command "disable3RLS $trfval $atk $resX $resY $resZ"\
 215                                         -value $trfval ]
 216                         pack $rad -anchor w
 217                 }
 218                 $subtrf.2DWT select
 219
 220         pack $subtrf -side left -padx 2 -pady 4
 221
 222                 pack $labresolution -padx 2 -side left -anchor w
 223                 pack $labresX $resX -padx 2 -side left -anchor w
 224                 pack $labresY $resY -padx 2 -side left -anchor w
 225                 pack $labresZ $resZ -padx 2 -side left -anchor w
 226
 227                 pack $frameres1 -side top -fill x
 228                 pack $frameres2 $frameatk -side top -padx 2 -pady 4 -anchor n
 229
 230         pack $subres -side left -padx 2 -pady 4
 231         pack $labtrf $labres -side left -fill both -padx 4 -expand yes
 232 }
 233
 234
 235 proc VMEncoder::_encode { framesrc framedst } {
 236
 237         variable var
 238
 239         set source [$framesrc.labsrc.f.entrysrc get ]
 240         set destination [$framedst.labdst.f.entrydst get ]
 241         set cond1 [string match *.pgx [string tolower $source]]
 242         set cond2 [string match *-*.pgx [string tolower $source]]
 243         set cond3 [string match *.bin [string tolower $source]]
 244
 245         set img ".img"
 246         set pattern [string range $source 0 [expr [string length $source]-5]]
 247         set pattern $pattern$img
 248         set exist [file exists $pattern]
 249
 250         #comprobamos datos son correctos
 251         if {($cond1 == 1) && ($cond2 == 0)} {
 252           MessageDlg .msgdlg -parent . -message "Info : Really want to encode an slice instead of a volume?.\n For a group of .pgx slices, name must contain a - denoting a sequential index!" -type ok -icon info
 253         }
 254
 255         if {$source == ""} {
 256           MessageDlg .msgdlg -parent . -message "Error : Source file is not defined !" -type ok -icon error
 257         } elseif {$destination == ""} {
 258           MessageDlg .msgdlg -parent . -message "Error : Destination file is not defined !" -type ok -icon error
 259         } elseif { ($VMEncoder::var(transform) != "3RLS") && ($VMEncoder::var(atk) == "Choose a wavelet transformation kernel") } {
 260           MessageDlg .msgdlg -parent . -title "Info" -message "Please choose a wavelet transformation kernel"\
 261                         -type ok -icon warning
 262         } elseif {($exist == 0) && ($cond1 == 0) && ($cond3 == 1)} {
 263                   MessageDlg .msgdlg -parent . -message "Error : IMG file associated to BIN volume file not found in same directory !" -type ok -icon info
 264         } else {
 265
 266                 #creamos datain a partir de los parametros de entrada
 267 #               set dirJP3Dencoder [mk_relativepath $VMEncoder::JP3Dencoder]
 268                 set dirJP3Dencoder $VMEncoder::JP3Dencoder
 269                 set datain [concat " $dirJP3Dencoder -i [mk_relativepath $source] "]
 270                 if {$cond3 == 1} {
 271                    set datain [concat " $datain -m [mk_relativepath $pattern] "]
 272                 }
 273                 set datain [concat " $datain -o [mk_relativepath $destination] "]
 274                 if {$VMEncoder::var(encoding) != "2EB"} {
 275                         set datain [concat " $datain -C $VMEncoder::var(encoding) "]
 276                 }
 277                 if {$VMEncoder::var(transform) == "2DWT"} {
 278                         set datain [concat " $datain -n $VMEncoder::var(resX),$VMEncoder::var(resY) "]
 279                 } elseif {$VMEncoder::var(transform) == "3DWT"} {
 280                         set datain [concat " $datain -n $VMEncoder::var(resX),$VMEncoder::var(resY),$VMEncoder::var(resZ) "]
 281                 }
 282
 283                 set datain [concat " $datain -r $VMEncoder::var(rate) "]
 284
 285                 if {$VMEncoder::var(atk) == "I9.7"} {
 286                         set datain [concat " $datain -I "]
 287                 }
 288                 if {$VMEncoder::var(sop) == 1} {
 289                         set datain [concat " $datain -SOP "]
 290                 }
 291                 if {$VMEncoder::var(eph) == 1} {
 292                         set datain [concat " $datain -EPH "]
 293                 }
 294                 if {$VMEncoder::var(progorder) != "LRCP"} {
 295                         set datain [concat " $datain -p $VMEncoder::var(progorder) "]
 296                 }
 297                 if {$VMEncoder::var(cblksize) != "64,64,64"} {
 298                         set datain [concat " $datain -b $VMEncoder::var(cblksize) "]
 299                 }
 300
 301
 302                 #Making this work would be great !!!
 303                 set VMEncoder::var(progval) 10
 304                 ProgressDlg .progress -parent . -title "Wait..." \
 305                         -type         infinite \
 306                         -width        20 \
 307                         -textvariable "Compute in progress..."\
 308                         -variable     VMEncoder::progval \
 309                         -stop         "Stop" \
 310                         -command      {destroy .progress}
 311                 after 200 set VMEncoder::var(progval) 2
 312                 set fp [open "| $datain " r+]
 313                 fconfigure $fp -buffering line
 314                 set jp3dVM::dataout [concat "EXECUTED PROGRAM:\n\t$datain"]
 315                 while {-1 != [gets $fp tmp]} {
 316                         set jp3dVM::dataout [concat "$jp3dVM::dataout\n$tmp"]
 317                 }
 318                 destroy .progress
 319                 set cond [string first "ERROR" $jp3dVM::dataout]
 320                 set cond2 [string first "RESULT" $jp3dVM::dataout]
 321                 if {$cond != -1} {
 322                    MessageDlg .msgdlg -parent . -message [string range $jp3dVM::dataout [expr $cond-1] end] -type ok -icon error
 323                 } elseif {$cond2 != -1} {
 324                    MessageDlg .msgdlg -parent . -message [string range $jp3dVM::dataout [expr $cond2+7] end] -type ok -icon info
 325                    close $fp
 326                 } else {
 327                    #Must do something with this !!! [pid $fp]
 328                    close $fp
 329                 }
 330         }
 331 }
 332
 333 proc VMEncoder::_reset { framesrc framedst frametrf framecod} {
 334
 335         variable var
 336
 337         #Restore defaults values
 338         set VMEncoder::var(transform) 2DWT
 339         set VMEncoder::var(encoding) 2EB
 340         set VMEncoder::var(atk) "R5.3"
 341         set VMEncoder::var(progorder) "LRCP"
 342         set atk $frametrf.labres.f.frameatk.atk
 343         set resX $frametrf.labres.f.frameres2.spinresX
 344         set resY $frametrf.labres.f.frameres2.spinresY
 345         set resZ $frametrf.labres.f.frameres2.spinresZ
 346         disable3RLS 2DWT $atk $resX $resY $resZ
 347         set labcblk $framecod.labcod.f.framecblk.labcblk
 348         set progorder $framecod.labcod.f.framepoc.progorder
 349         set labrate $framecod.labcod.f.framerate.labrate
 350         set chksop $framecod.labcod.f.framesop.chksop
 351         set chkeph $framecod.labcod.f.frameeph.chkeph
 352         disableGR 3EB $labcblk $progorder $labrate $chksop $chkeph
 353
 354         $framesrc.labsrc.f.entrysrc delete 0 end
 355         $framedst.labdst.f.entrydst delete 0 end
 356 }
 357
 358 proc fileDialogE {w ent operation} {
 359
 360         variable file
 361         variable i j
 362
 363         if {$operation == "open"} {
 364                 set types {
 365                         {"Source Image Files"   {.pgx .bin}     }
 366                         {"All files"            *}
 367                 }
 368                 set file [tk_getOpenFile -filetypes $types -parent $w]
 369                 if {[string compare $file ""]} {
 370                         $ent delete 0 end
 371                         $ent insert end $file
 372                         $ent xview moveto 1
 373                 }
 374         } else {
 375                 set types {
 376                         {"JP3D Files"              {.jp3d}      }
 377                         {"JPEG2000 Files"          {.j2k}       }
 378                         {"All files"            *}
 379                 }
 380                 set file [tk_getSaveFile -filetypes $types -parent $w \
 381                         -initialfile Untitled -defaultextension .jp3d]
 382                 if {[string compare $file ""]} {
 383                         $ent delete 0 end
 384                         $ent insert end $file
 385                         $ent xview moveto 1
 386                 }
 387         }
 388 }
 389
 390 proc mk_relativepath {abspath} {
 391
 392         set mydir [split [string trimleft [pwd] {/}] {/}]
 393         set abspathcomps [split [string trimleft $abspath {/}] {/}]
 394
 395         set i 0
 396         while {$i<[llength $mydir]} {
 397                 if {![string compare [lindex $abspathcomps $i] [lindex $mydir $i]]} {
 398                         incr i
 399                 } else {
 400                         break
 401                 }
 402         }
 403         set h [expr [llength $mydir]-$i]
 404         set j [expr [llength $abspathcomps]-$i]
 405
 406         if {!$h} {
 407                 set relpath "./"
 408         } else {
 409                 set relpath ""
 410                 while { $h > 0 } {
 411                         set relpath "../$relpath"
 412                         incr h -1
 413                 }
 414         }
 415
 416         set h [llength $abspathcomps]
 417         while { $h > $i } {
 418                 set relpath [concat $relpath[lindex $abspathcomps [expr [llength $abspathcomps]-$j]]/]
 419                 incr h -1
 420                 incr j -1
 421         }
 422         return [string trim $relpath {/}]
 423 }
 424
 425 proc disable3RLS {flag atk resX resY resZ}  {
 426
 427         if {$flag == "3RLS"} {
 428                 $atk configure -state disabled
 429                 $resX configure -state disabled
 430                 $resY configure -state disabled
 431                 $resZ configure -state disabled
 432         } elseif {$flag == "2DWT"} {
 433                 $atk configure -state normal
 434                 $resX configure -state normal
 435                 $resY configure -state normal
 436                 $resZ configure -state disabled
 437         } elseif {$flag == "3DWT"} {
 438                 $atk configure -state normal
 439                 $resX configure -state normal
 440                 $resY configure -state normal
 441                 $resZ configure -state normal
 442         }
 443 }
 444
 445 proc disableGR {flag labcblk progorder labrate chksop chkeph} {
 446
 447         if {$flag == "2EB"} {
 448                 $labcblk configure -state normal
 449                 $progorder configure -state normal
 450                 $labrate configure -state normal
 451                 $chksop configure -state normal
 452                 $chkeph configure -state normal
 453                 set VMEncoder::var(cblksize) "64,64,64"
 454                 set VMEncoder::var(tilesize) "512,512,512"
 455         } elseif {$flag == "3EB"} {
 456                 $labcblk configure -state normal
 457                 $progorder configure -state normal
 458                 $labrate configure -state normal
 459                 $chksop configure -state normal
 460                 $chkeph configure -state normal
 461                 set VMEncoder::var(cblksize) "64,64,64"
 462                 set VMEncoder::var(tilesize) "512,512,512"
 463         } else {
 464                 $labcblk configure -state disabled
 465                 $progorder configure -state disabled
 466                 $labrate configure -state disabled
 467                 $chksop configure -state disabled
 468                 $chkeph configure -state disabled
 469         }
 470 }