[PO] 2010/11/28 Test suite for the [poPhotoUtil] package for image processing with pure Tk commands. Screenshots from the test suite: [poPhotoUtil_FlipVert] ======tcl package require Tk package require poPhotoUtil package require Img proc bmpFirst {} { return { #define first_width 16 #define first_height 16 static unsigned char first_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1c, 0x04, 0x1c, 0x06, 0x1c, 0x07, 0x9c, 0x3f, 0xdc, 0x3f, 0x9c, 0x3f, 0x1c, 0x07, 0x1c, 0x06, 0x1c, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; } } proc bmpLast {} { return { #define last_width 16 #define last_height 16 static unsigned char last_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x20, 0x38, 0x60, 0x38, 0xe0, 0x38, 0xfc, 0x39, 0xfc, 0x3b, 0xfc, 0x39, 0xe0, 0x38, 0x60, 0x38, 0x20, 0x38, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; } } proc bmpLeft {} { return { #define left_width 16 #define left_height 16 static unsigned char left_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, 0x80, 0x01, 0xc0, 0x01, 0xe0, 0x0f, 0xf0, 0x0f, 0xe0, 0x0f, 0xc0, 0x01, 0x80, 0x01, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; } } proc bmpRight {} { return { #define right_width 16 #define right_height 16 static unsigned char right_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, 0x80, 0x01, 0x80, 0x03, 0xf0, 0x07, 0xf0, 0x0f, 0xf0, 0x07, 0x80, 0x03, 0x80, 0x01, 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; } } proc bmpPlay {} { return { #define play_width 16 #define play_height 16 static unsigned char play_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x60, 0x00, 0xe0, 0x00, 0xe0, 0x01, 0xe0, 0x03, 0xe0, 0x07, 0xe0, 0x03, 0xe0, 0x01, 0xe0, 0x00, 0x60, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; } } proc bmpHalt {} { return { #define halt_width 16 #define halt_height 16 static unsigned char halt_bits[] = { 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x18, 0x18, 0x30, 0x0c, 0x60, 0x06, 0xc0, 0x03, 0x80, 0x01, 0xc0, 0x03, 0x60, 0x06, 0x30, 0x0c, 0x18, 0x18, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; } } proc ui_initToolhelp { w { bgColor yellow } { fgColor black } } { global ui_helpWidget # Create Toolbar help window with a simple label in it. if { [winfo exists $w] } { destroy $w } toplevel $w set ui_helpWidget $w label $w.l -text "??" -bg $bgColor -fg $fgColor -relief ridge pack $w.l wm overrideredirect $w true if {[string equal [tk windowingsystem] aqua]} { ::tk::unsupported::MacWindowStyle style $w help none } wm geometry $w [format "+%d+%d" -100 -100] } proc ui_showToolhelp { x y str } { global ui_helpWidget $ui_helpWidget.l configure -text $str raise $ui_helpWidget wm geometry $ui_helpWidget [format "+%d+%d" $x [expr $y +10]] } proc ui_hideToolhelp {} { global ui_helpWidget wm geometry $ui_helpWidget [format "+%d+%d" -100 -100] } proc ui_button { btnName bmpData cmd helpStr } { set imgData [image create bitmap -data $bmpData] eval button $btnName -image $imgData -command [list $cmd] -relief flat bind $btnName "ui_showToolhelp %X %Y [list $helpStr]" bind $btnName { ui_hideToolhelp } bind $btnName