# photo.tcl --
#
#	Displays an snapshot of a Widget and allows the user to save it
#	to a file.
#

namespace eval NSPhoto {

variable Priv

# NSPhoto::InitModule --
#
#	One-time-only-ever initialization.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc InitModule {} {

	variable Priv

	set Priv(count) 0
}

# NSPhoto::NSPhoto --
#
#	Object constructor called by NSObject::New().
#
# Arguments:
#	oop					OOP ID. See above.
#
# Results:
#	.

proc NSPhoto {oop widget} {

	variable Priv

	incr Priv(count)

	Info $oop widget $widget
	Info $oop index $Priv(count)

	InitWindow $oop

	# Position and display the window
	set win [Info $oop win]
	NSToplevel::NaturalSize $win ""
	wm resizable $win no no
    set x2 [expr ([winfo screenwidth $win] - [winfo reqwidth $win])/2 \
	    - [winfo vrootx $win]]
    set y2 [expr ([winfo screenheight $win] - [winfo reqheight $win])/3 \
	    - [winfo vrooty $win]]
    wm geometry $win +$x2+$y2
	focus $win
	update

	# Set the image data
	SetImage $oop

	# Remove "Please Wait..." label
	destroy $win.wait
}

# NSPhoto::Info --
#
#	Query and modify info.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc Info {oop info args} {

	global NSPhoto

	# Set info
	if {[llength $args]} {
		switch -- $info {
			default {
				set NSPhoto($oop,$info) [lindex $args 0]
			}
		}

	# Get info
	} else {
		switch -- $info {
			default {
				return $NSPhoto($oop,$info)
			}
		}
	}
}

# NSPhoto::InitWindow --
#
#	Create a help window.
#
# Arguments:
#	oop					OOP ID. See above.
#
# Results:
#	.

proc InitWindow oop {

	global Angband
	variable Priv

	set widget [Info $oop widget]

	set win .photo$oop
	toplevel $win
	wm title $win "Photo #$Priv(count) - $Angband(name)"
	wm resizable $win no no
 
	# Do stuff when window closes
	wm protocol $win WM_DELETE_WINDOW "NSPhoto::Close $oop"

	# Set instance variables
	Info $oop win $win

	# Create menus
	InitMenus $oop

	# Create the (empty) image
	set image Image_Photo$Priv(count)
	set width [winfo width $widget]
	set height [winfo height $widget]
	image create photo $image -width $width -height $height
	Info $oop image $image

	label $win.image -relief sunken -borderwidth 1 -image $image
	pack $win.image

	# "Please Wait" label
	label $win.wait \
		-font "Times 18 bold" -text "Please Wait..."
	place $win.wait \
		-in $win.image -relx 0.5 -rely 0.4 -anchor center
	
	bind $win <Control-w> "NSPhoto::Close $oop"
}

# NSPhoto::InitMenus --
#
#	Create the menus for a new editor window.
#
# Arguments:
#	oop					OOP ID. See above.
#
# Results:
#

proc InitMenus oop {

	global NSMenu

	# Default accelerator modifier
	set mod "Ctrl"

	set win [Info $oop win]

	#
	# Menu bar
	#

	set menuDef "-tearoff 0 -postcommand \"NSPhoto::SetupMenus $oop\" \
		-identifier MENUBAR"
	Info $oop mbar [NSObject::New NSMenu $win $menuDef]
	set mbar [Info $oop mbar]

	#
	# Photo Menu
	#

	NSObject::New NSMenu $mbar {-tearoff 0 -identifier MENU_PHOTO}
	NSMenu::MenuInsertEntry $mbar -end MENUBAR {-type cascade \
		-menu MENU_PHOTO -label "Photo" -underline 0 -identifier M_PHOTO}

	lappend entries "-type command -label \"Save As...\" \
		-command \"NSPhoto::SaveAs $oop\" \
		-underline 5 -identifier E_SAVEAS"
	lappend entries "-type separator"
	lappend entries "-type command -label \"Close\" \
		-command \"NSPhoto::Close $oop\" -underline 0 \
		-accelerator $mod+W -identifier E_CLOSE"

	NSMenu::MenuInsertEntries $mbar -end MENU_PHOTO $entries
}

# NSPhoto::SetupMenus --
#
#	Description
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc SetupMenus {oop mbarId} {

	global Angband

	lappend identList E_SAVEAS E_CLOSE

	NSMenu::MenuEnable $mbarId $identList
}

# NSPhoto::Close --
#
#	Description.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc Close oop {

	image delete [Info $oop image]
	destroy [Info $oop win]
	NSObject::Delete NSPhoto $oop
}

# NSPhoto::SetImage --
#
#	Description.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc SetImage oop {

	set image [Info $oop image]
	set widget [Info $oop widget]
	$widget photo $image

	# Gamma correction. Looks okay on my monitor anyways.
	$image configure -gamma 0.9
}

# NSPhoto::SaveAs --
#
#	Description.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc SaveAs oop {

	global Angband

	set image [Info $oop image]
	set win [Info $oop win]

	if {[lsearch -exact [package names] Img] == -1} {
		tk_messageBox -icon info -title "Missing Img Package" -parent $win \
			-message "The Img package is required for saving photo images.\nSee\
			the file ReadMe_Img for more information."
		return
	}
	package require Img

	### TIFF format seems busted (infinite loop) ###

	set types {
		{{CompuServe GIF} {.gif}}
		{{JPEG} {.jpg .jpeg}}
		{{PiNG} {.png}}
		{{All files} {*}}
	}
	set fileName [tk_getSaveFile -initialfile photo[Info $oop index].gif \
		-initialdir [file join $Angband(dir) lib user] -filetypes $types \
		-parent $win]
	if {![string length $fileName]} return

	switch -- [file extension $fileName] {
		.gif {set format "gif gif89a"}
		.jpg -
		.jpeg {set format "jpeg"}
		.png {set format "png color"}
		default {
			tk_messageBox -icon info -message "Unrecognized file type." \
				-title "Save Photo Error" -parent $win
			return
		}
	}

	# If I was a real keener, I'd allow the user to configure the
	# file format more exactly (JPEG quality, etc)

	$image write $fileName -format $format
}

# namespace eval NSPhoto
}
