#                      F B P A G E . I T K
# BRL-CAD
#
# Copyright (c) 2004-2016 United States Government as represented by
# the U.S. Army Research Laboratory.
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public License
# version 2.1 as published by the Free Software Foundation.
#
# This library is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this file; see the file named COPYING for more
# information.
#
###
#
# FbPage.itk
#
# This file provides a page for specifying framebuffer parameters
# such as device, width, depth, and background color.
#

package require Itcl
package require Itk
package require Iwidgets

namespace eval RtWizard {

    package provide FbPage 1.0

    #
    # fbpage - Provides a lowercased access method for the
    #          FbPage class
    #
    proc fbpage {pathName args} {
	uplevel FbPage $pathName $args
    }

    #
    # Add options
    #
    option add *FbPage.borderWidth 2 widgetDefault
    option add *FbPage.labelPos wn widgetDefault
    option add *FbPage.listHeight 150 widgetDefault
    option add *FbPage.hscrollMode dynamic widgetDefault
    option add *FbPage.vscrollMode dynamic widgetDefault
    option add *FbPage.textBackground seashell

    #
    # Define the usual options
    #
    ::itk::usual FbPage {
	keep -activebackground \
	    -activerelief \
	    -background \
	    -borderwidth \
	    -cursor \
	    -elementborderwidth \
	    -foreground \
	    -highlightcolor \
	    -highlightthickness \
	    -insertbackground \
	    -insertborderwidth \
	    -insertofftime \
	    -insertontime \
	    -insertwidth \
	    -jump \
	    -labelfont \
	    -selectbackground \
	    -selectborderwidth \
	    -textbackground \
	    -textfont \
	    -troughcolor
    }

    #
    # FbPage
    #
    # The FbPage contains some entryfields.
    #
    ::itcl::class FbPage {
	inherit ::iwidgets::Labeledwidget

	#
	# Configuration variables
	#

	# None!

	public {
	    #
	    # methods
	    #
	    constructor {args} {};

	    method onSelect {}
	    method onDeselect {}
	    method getStepInfo {}
	    method getWidth {}
	    method getHeight {}
	    method getFrameBuffer {width height {screenOnly false}}
	}

	private {
	    #
	    # methods
	    #
	    method loadHelpText {widget}
	    method onOK {}
	    method selectFbFile {}

	    method onToScreen {}
	    method onToFile {}

	    method updateWidth {}
	    method incrWidth {}
	    method decrWidth {}

	    method updateHeight {}
	    method incrHeight {}
	    method decrHeight {}

	    #
	    # variables
	    #
	    common sizes { 256 480 512 640 768 1024 1200 1600 2048 }
	    common topSpot 8
	    variable rbvar

	    variable width
	    variable height

	    variable widthIndex
	    variable heightIndex

	    variable lastPort 0

	}
    }

    #--------------------#
    #   Public Methods   #
    #--------------------#
    #
    # constructor - builds the Framebuffer Page
    #
    ::itcl::body FbPage::constructor {args} {

	#
	# Set up the childsite
	#
	set cs [ $this childsite ]
	$cs configure -relief groove -bd 2

	#
	# Create the help panel
	#
	itk_component add helpPanel {
	    ::iwidgets::scrolledtext $cs.#auto \
		-hscrollmode none \
		-vscrollmode none \
		-visibleitems 80x3 \
		-wrap word \
		-relief flat \
		-textfont {avantgarde 12 italic}
	} {
	    usual
	    ignore -textbackground
	}
	loadHelpText $itk_component(helpPanel);

	pack $itk_component(helpPanel) \
	    -side top

	#
	# Add a frame to facilitate packing the remainder of the
	# contents.
	#
	itk_component add sfm {
	    frame $cs.fm \
		-relief flat
	} {
	    usual
	}

	#
	# Create two frames, the left frame will hold the size and
	# color stuff, the right will hold the device stuff.
	#
	itk_component add ltFrame {
	    frame $itk_component(sfm).ltFrame
	} {
	    usual
	}

	itk_component add rtFrame {
	    frame $itk_component(sfm).rtFrame
	} {
	    usual
	}

	#
	# Build the contents of the left-hand-side
	#
	itk_component add szFrame {
	    iwidgets::labeledframe $itk_component(ltFrame).szFrame \
		-labeltext "Size" \
		-labelpos nw \
		-relief groove
	}

	set szCs [$itk_component(szFrame) childsite]

	itk_component add width {
	    iwidgets::spinner $szCs.width \
		-labeltext "Width:" \
		-width 6 \
		-labelmargin 2 \
		-increment "[::itcl::code $this incrWidth]" \
		-decrement "[::itcl::code $this decrWidth]"
	} {
	    ignore -textfont
	    keep -textbackground
	}

	set widthIndex 5
	updateWidth

	itk_component add height {
	    iwidgets::spinint $szCs.height \
		-labeltext "Height:" \
		-width 6 \
		-increment "[::itcl::code $this incrHeight]" \
		-decrement "[::itcl::code $this decrHeight]"
	} {
	    ignore -textfont
	    keep -textbackground
	}

	set heightIndex 5
	updateHeight

	#
	# Build the contents of the right-hand-size
	#
	itk_component add devFrame {
	    iwidgets::labeledframe $itk_component(rtFrame).devFrame \
		-labeltext "Device" \
		-labelpos nw \
		-relief groove

	} {
	    usual
	}
	set devCs [$itk_component(devFrame) childsite]

	itk_component add radBox {
	    iwidgets::radiobox $devCs.radBox \
		-relief flat
	} {
	    usual
	}

	$itk_component(radBox) add toScreen \
	    -text "Display on Screen" \
	    -selectcolor green \
	    -command "[::itcl::code $this onToScreen]"

	$itk_component(radBox) add toFile \
	    -text "Write to File" \
	    -selectcolor green \
	    -command "[::itcl::code $this onToFile]"

	itk_component add fileName {
	    iwidgets::entryfield $devCs.fileName \
		-labeltext "File:" -width 48 \
		-textvariable ::RtWizard::wizard_state(output_filename)
	} {
	    usual
	}

	itk_component add browse {
	    button $devCs.browse \
		-text "Browse" \
		-command "[::itcl::code $this selectFbFile]"
	} {
	    usual
	}

	#
	# Add a buttonbox
	#
	itk_component add bbox {
	    iwidgets::buttonbox $cs.bbox
	} {
	    usual
	}

	$itk_component(bbox) add OK \
	    -text "OK" \
	    -command "[::itcl::code $::wizardInstance] selectPrev"

	#
	# Pack the items
	#

	#
	# Pack the contents of the szFrame
	#
	pack $itk_component(width)
	pack $itk_component(height)

	eval iwidgets::Labeledwidget::alignlabels \
	    $itk_component(height) \
	    $itk_component(width)

	#
	# Pack the contents of the devFrame
	#
	pack $itk_component(radBox) -anchor w
	pack $itk_component(fileName) -anchor w
	pack $itk_component(browse)  -anchor e

	#
	# Pack the size frame and dev frame
	#
	pack $itk_component(szFrame) -fill y -expand 1
	pack $itk_component(devFrame) -fill y -expand 1

	#
	# Pack the lhs and rhs frame into the middle
	#
	pack $itk_component(ltFrame) -side left
	pack $itk_component(rtFrame) -side right

	#
	# Now pack the top-level widgets.
	#
	pack $itk_component(helpPanel) -side top
	pack $itk_component(sfm)
	pack $itk_component(bbox) -side right


	#
	# Configure the labeledframe
	#
	configure -labelpos nw
	configure -labeltext "Configure the Framebuffer"

	#
	# Select to screen
	#
	$itk_component(radBox) select 0

	#
	# Evaluate any other args
	#
	eval itk_initialize $args
    }

    #
    # onSelect
    #
    # Makes any necessary changes to the Wizard configuration
    # when this page is selected.
    #
    ::itcl::body FbPage::onSelect {} {
	#
	# Nothing yet!
	#
    }

    #
    # onDeselect
    #
    # Cleans up when the page is deselected
    #
    ::itcl::body FbPage::onDeselect {} {
	#
	# Nothing yet!
	#
    }

    #
    # getStepInfo
    #
    # In principal, returns a name for the step, and a variable that
    # can be queried for state. The framebuffer page is not a 'step',
    # so it returns "No Step"
    #
    ::itcl::body FbPage::getStepInfo {} {
	set a "No Step"
	set b "banana"
	return [list $a $b]
    }

    #
    # getWidth - returns the current width
    #
    ::itcl::body FbPage::getWidth {} {
	return [$itk_component(width) get]
    }

    #
    # getHeight - returns the current height
    #
    ::itcl::body FbPage::getHeight {} {
	return [$itk_component(height) get]
    }

    #
    # getFrameBuffer - opens frame buffer and returns the port.
    #
    ::itcl::body FbPage::getFrameBuffer { width height {screenOnly false} } {
	global tcl_platform
	#
	# If the user specified a framebuffer file and it is
	# not null, return the name. Otherwise, open an on-screen
	# buffer.
	#
	set mode [$itk_component(radBox) get]
	if { [string match $mode "toFile"] && \
		 [string length $::RtWizard::wizard_state(output_filename)] > 0 && \
		 [string match $screenOnly "false"] } {
	    # Will be generating a file - need in-memory fb
	    set port 0
	    while { ! [catch {exec [file join [bu_brlcad_root bin] fbclear] -F $port } error ] } {
		if {$::RtWizard::wizard_state(verbose)} {puts "fbserv port $fbserv_port is already in use."}
		incr port
	    }
	    catch {exec [file join [bu_brlcad_root bin] fbserv] -w $width -n $height $port /dev/mem &} pid
	    # Give the fbserv time to fire up
	    after 1000
	    exec [file join [bu_brlcad_root bin] fbclear] -F $port 0 0 0

	    set ::RtWizard::wizard_state(fbserv_port) $port
	    set ::RtWizard::wizard_state(pid) $pid
	    return "$port $pid"
	}
	set binpath [bu_brlcad_root "bin"]
	#
	# Create an on-screen buffer
	#
	set port [incr lastPort]
	set ok false
	#
	#
	#
	# TODO - need to be able to do something more
	# intelligent here based on what devices are
	# available in BRL-CAD...
	if {$tcl_platform(platform) == "windows"} {
	    set fbType "/dev/wglsp"
	} else {
	    set fbType "/dev/oglsp"
	}
	#
	#
	#
	while {[catch \
		    {exec "$binpath/fbserv" -w $width -n $height -F $fbType -p $port &} \
		    catchResult]} {
	    puts $catchResult
	    incr port
	}
	#
	# Damn important, give the fbserv a bit o' time to fire up
	#
	after 1000
	exec "$binpath/fbclear" -F $port 0 0 0
	set lastPort $port

	set ::RtWizard::wizard_state(fbserv_port) $port

	return "$port"
    }

    #--------------------#
    #  Private Methods   #
    #--------------------#
    #
    # onOK - called when the OK button is called
    #
    ::itcl::body FbPage::onOK {} {
	$::wizardInstance select intro
    }

    #
    # loadHelpText - loads a bit of helpful information into a
    #                text widget
    #
    ::itcl::body FbPage::loadHelpText { widget } {
	set help "Copious help on frame buffer stuff"
	$widget insert end $help
    }

    #
    # selectFbFile - called when the "browse" fb file is specified
    #
    ::itcl::body FbPage::selectFbFile { } {
	set of [tk_getSaveFile -initialfile rtwizard.png]
	set ::RtWizard::wizard_state(output_filename) $of
    }

    #
    # onToScreen - called when the toScreen radiobutton is
    #             selected. Deactivates the "fileName" and
    #             "browse" components.
    #
    ::itcl::body FbPage::onToScreen { } {
	$itk_component(fileName) configure -state disabled
	$itk_component(browse) configure -state disabled
    }

    #
    # onToFile - called when the toFile radiobutton is
    #            selected. Activates the "fileName" and
    #            "browse" components.
    #
    ::itcl::body FbPage::onToFile { } {
	$itk_component(fileName) configure -state normal
	$itk_component(browse) configure -state normal
    }

    #
    # updateWidth - clears the width widget and inserts the
    #               current value.
    #
    ::itcl::body FbPage::updateWidth { } {
	$itk_component(width) clear
	$itk_component(width) insert 0 [ lindex $sizes $widthIndex ]
    }

    #
    # incrWidth - called when the width spinner's up button
    #             is pressed.
    #
    ::itcl::body FbPage::incrWidth { } {
	if { $widthIndex < $topSpot } {
	    incr widthIndex
	}
	updateWidth
    }

    #
    # decrWidth - called when the width spinner's down button
    #             is pressed.
    #
    ::itcl::body FbPage::decrWidth { } {
	if { $widthIndex > 0 } {
	    incr widthIndex -1
	}
	updateWidth
    }

    #
    # updateHeight - clears the height widget and inserts the
    #                current value.
    #
    ::itcl::body FbPage::updateHeight { } {
	$itk_component(height) clear
	$itk_component(height) insert 0 [ lindex $sizes $heightIndex ]
    }

    #
    # incrHeight - called when the height spinner's up button
    #              is pressed.
    #
    ::itcl::body FbPage::incrHeight { } {
	if { $heightIndex < $topSpot } {
	    incr heightIndex
	}
	updateHeight
    }

    #
    # decrHeight - called when the height spinner's down button
    #              is pressed.
    #
    ::itcl::body FbPage::decrHeight { } {
	if { $heightIndex > 0 } {
	    incr heightIndex -1
	}
	updateHeight
    }

}
#end namespace


# Local Variables:
# mode: Tcl
# tab-width: 8
# c-basic-offset: 4
# tcl-indent-level: 4
# indent-tabs-mode: t
# End:
# ex: shiftwidth=4 tabstop=8