head	1.4;
access;
symbols
	core-8-5-9:1.4
	core-8-5-8:1.4
	macosx-cocoa-merge:1.4
	macosx-cocoa-premerge:1.4
	macosx-carbon-freeze:1.4
	core-8-5-7:1.4
	core-8-5-6:1.4
	core-8-6-b1:1.4
	core-8-6-a3:1.4
	core-8-5-5:1.4
	core-8-6-a2:1.4
	core-8-5-4:1.4
	core-8-5-3:1.4
	core-8-6-a1:1.4
	core-8-4-19:1.2
	core-8-5-branch:1.4.0.4
	core-8-5-2:1.4
	core-8-4-18:1.2
	core-8-5-1:1.4
	core-8-4-17:1.2
	core-8-5-0:1.4
	core-8-5-b3:1.4
	core-8-5-b2:1.4
	core-8-4-16:1.2
	core-8-5-b1:1.4
	core-stablilizer-merge:1.4
	core-stabilizer-branch:1.4.0.2
	core-stabilizer-merge:1.4
	core-8-4-15:1.2
	core-8-5-a6:1.4
	core-8-5-a5:1.4
	core-8-4-14:1.2
	core-8-5-a4:1.4
	core-8-4-13:1.2
	core-8-4-12:1.2
	core-8-4-11:1.2
	core-8-5-a3:1.3
	core-8-4-10:1.2
	core-8-4-9-branch:1.2.0.6
	core-8-5-a2:1.3
	core-8-4-9:1.2
	core-8-4-8:1.2
	core-8-4-7:1.2
	core-8-5-a1:1.2
	core-8-4-6:1.2
	core-8-4-5:1.2
	mistachkin-dev-branch:1.2.0.4
	core-8-4-4:1.2
	core-8-4-3:1.2
	core-8-4-branch:1.2.0.2
	core-8-4-2:1.2
	core-8-4-1:1.2
	core-8-3-5:1.1
	core-8-4-0:1.2
	macosx-8-4-merge-2002-08-31-trunk:1.2
	macosx-8-4-premerge-2002-08-31-branch:1.1.8.1
	macosx-8-4-premerge-2002-08-31-trunk:1.2
	macosx-8-4-merge-2002-08-30-branch:1.1.8.1
	macosx-8-4-merge-2002-08-30-trunk:1.2
	macosx-8-4-merge-2002-08-20-branch:1.1.8.1
	macosx-8-4-merge-2002-08-20-trunk:1.2
	core-8-4-b2:1.2
	core-8-4-b1:1.1
	macosx-premerge-6-9-02:1.1
	core-8-4-a4:1.1
	core-8-3-4:1.1
	macosx-8-4-branch:1.1.0.8
	macosx-8-4-branchpoint:1.1
	core-8-4-a3:1.1
	core-8-3-3:1.1
	dgp-privates-into-namespace:1.1.0.6
	tclpro-1-5-0:1.1
	core-8-4-win-speedup:1.1.0.4
	core-8-4-a2:1.1
	tclpro-1-4-1:1.1
	tclpro-1-4-0:1.1
	core-8-3-2:1.1
	ajuba-ajuba2-2-1-base:1.1
	ajuba-ajuba2-2-0:1.1
	core-8-4-a1:1.1
	core-8-3-1-branch:1.1.0.2
	core-8-3-1:1.1
	scriptics-sc-2-0-b5:1.1
	scriptics-sc-2-0-fixed:1.1
	scriptics-sc-2-0-b2:1.1
	scriptics-sc-2-0-b1:1.1
	core-8-3-0:1.1
	core-8-3-b2:1.1
	core-8-3-b1:1.1;
locks; strict;
comment	@# @;


1.4
date	2005.10.12.09.29.21;	author dkf;	state Exp;
branches;
next	1.3;

1.3
date	2004.10.19.15.25.08;	author dkf;	state Exp;
branches;
next	1.2;

1.2
date	2002.07.12.13.40.59;	author dgp;	state Exp;
branches;
next	1.1;

1.1
date	99.12.14.06.53.12;	author hobbs;	state Exp;
branches
	1.1.8.1;
next	;

1.1.8.1
date	2002.08.20.20.27.13;	author das;	state Exp;
branches;
next	;


desc
@@


1.4
log
@Arrange the test suite so that it only accesses images in the same directory.
This enables packaging of the test suite as a starkit.
@
text
@# This file creates a screen to exercise Postscript generation
# for images in canvases.  It is part of the Tk visual test suite,
# which is invoked via the "visual" script.
#
# RCS: @@(#) $Id: canvPsImg.tcl,v 1.3 2004/10/19 15:25:08 dkf Exp $

# Build a test image in a canvas
proc BuildTestImage {} {
    global BitmapImage PhotoImage visual level
    catch {destroy .t.f}
    frame .t.f -visual $visual -colormap new
    pack .t.f -side top -after .t.top
    bind .t.f <Enter> {wm colormapwindows .t {.t.f .t}}
    bind .t.f <Leave> {wm colormapwindows .t {.t .t.f}}
    canvas .t.f.c -width 550 -height 350 -borderwidth 2 -relief raised
    pack .t.f.c
    .t.f.c create rectangle 25 25 525 325 -fill {} -outline black
    .t.f.c create image 50 50 -anchor nw -image $BitmapImage
    .t.f.c create image 250 50 -anchor nw -image $PhotoImage
}

# Put postscript in a file
proc FilePostscript { canvas } {
    global level
    $canvas postscript -file /tmp/test.ps -colormode $level
}

# Send postscript output to printer
proc PrintPostcript { canvas } {
    global level
    $canvas postscript -file tmp.ps -colormode $level
    exec lpr tmp.ps
}

catch {destroy .t}
toplevel .t
wm title .t "Postscript Tests for Canvases: Images"
wm iconname .t "Postscript"

message .t.m -text {This screen exercises the Postscript-generation abilities of Tk canvas widgets for images.  Click the buttons below to select a Visual type for the canvas and colormode for the Postscript output.  Then click "Print" to send the results to the default printer, or "Print to file" to put the Postscript output in a file called "/tmp/test.ps".  You can also click on items in the canvas to delete them.  
NOTE: Some Postscript printers may not be able to handle Postscript generated in color mode.} -width 6i
pack .t.m -side top -fill both

frame .t.top
pack .t.top -side top
frame .t.top.l -relief raised -borderwidth 2
frame .t.top.r -relief raised -borderwidth 2
pack .t.top.l .t.top.r -side left -fill both -expand 1

label .t.visuals -text "Visuals"
pack .t.visuals -in .t.top.l

set visual [lindex [winfo visualsavailable .] 0]
foreach v [winfo visualsavailable .] {
    # The hack below is necessary for some systems, which have more than one
    # visual of the same type...
    if {![winfo exists .t.$v]} {
        radiobutton .t.$v -text $v -variable visual -value $v \
		-command BuildTestImage
        pack .t.$v -in .t.top.l -anchor w
    }
}

label .t.levels -text "Color Levels"
pack .t.levels -in .t.top.r
set level monochrome
foreach l { monochrome gray color } {
    radiobutton .t.$l -text $l -variable level -value $l
    pack .t.$l -in .t.top.r -anchor w
}

set BitmapImage [image create bitmap \
	-file [file join [file dirname [info script]] face.xbm] \
	-background white -foreground black]
set PhotoImage [image create photo \
	-file [file join [file dirname [info script]] teapot.ppm]]

BuildTestImage

frame .t.bot
pack .t.bot -side top -fill x -expand 1

button .t.file -text "Print to File" -command { FilePostscript .t.f.c }
button .t.print -text "Print" -command { PrintPostscript .t.f.c }
button .t.quit -text "Quit" -command { destroy .t }
pack .t.file .t.print .t.quit -in .t.bot -side left -fill x -expand 1
@


1.3
log
@Rename all XBM format files to be called *.xbm instead of *.bmp [Bug 733835]
@
text
@d5 1
a5 1
# RCS: @@(#) $Id: canvPsImg.tcl,v 1.2 2002/07/12 13:40:59 dgp Exp $
d72 2
a73 1
set BitmapImage [image create bitmap -file $tk_library/demos/images/face.xbm \
d75 2
a76 1
set PhotoImage [image create photo -file $tk_library/demos/images/teapot.ppm]
@


1.2
log
@	* Converted several files in the Tk test suite for testing by
	tcltest 2.1.
@
text
@d5 1
a5 1
# RCS: @@(#) $Id: canvPsImg.tcl,v 1.1 1999/12/14 06:53:12 hobbs Exp $
d72 1
a72 1
set BitmapImage [image create bitmap -file $tk_library/demos/images/face.bmp \
@


1.1
log
@	* tests/bind.test:
	* tests/canvImg.test:
	* tests/canvPsArc.tcl:
	* tests/canvPsImg.tcl: (new file)
	* tests/canvRect.test:
	* tests/canvText.test:
	* tests/canvas.test:
	* tests/defs.tcl:
	* tests/entry.test:
	* tests/event.test:
	* tests/font.test:
	* tests/frame.test:
	* tests/imgPhoto.test:
	* tests/safe.test:
	* tests/scale.test:
	* tests/scrollbar.test:
	* tests/select.test:
	* tests/text.test:
	* tests/textDisp.test:
	* tests/textTag.test:
	* tests/unixFont.test:
	* tests/unixWm.test:
	* tests/visual_bb.test:
	* tests/winClipboard.test: tests for the dash patch changes
@
text
@d5 1
a5 1
# RCS: @@(#) $Id: canvPsImg.tcl,v $
d72 1
a72 1
set BitmapImage [image create bitmap -file $tk_library/demos/images/face \
@


1.1.8.1
log
@merged with trunk at tag macosx-8-4-merge-2002-08-20-trunk
@
text
@d5 1
a5 1
# RCS: @@(#) $Id$
d72 1
a72 1
set BitmapImage [image create bitmap -file $tk_library/demos/images/face.bmp \
@


