#!./tdv_wish

set display_vendor [winfo server .]

case $display_vendor in {
    {{*Silicon Graphics*}}                { set display_type sgi }
    {{*Hewlett-Packard *}}                { set display_type hp }
    {{*Sun Microsystems*}}                { set display_type sun }
    {{*International Business Machines*}} { set display_type ibm }
    {{*Digital Equipment Corporation*}}   { set display_type dec }
    default                               { set display_type other }
}

set initial_warning ""

set is_win [ file exists /etc/passwd ]
source lib/viewer.tcl

set tdv_library lib

set is_win [file exists /etc/passwd]

proc setup_vtest {w geo gtype} {
    global tdv_dbuffer_var display_type host_vendor initial_warning
    
    set tdv_dbuffer_var($w.view) 0
    toplevel $w
    tdv_init $w.view 500 500 $gtype black 0
    tdv_dynamics_bindings $w.view 0
    
    puts $initial_warning
    
    frame $w.top
    label $w.top.title -text "3 D Viewer"
    menubutton $w.top.options -text Options -borderwidth 2 -relief raised \
	-menu $w.top.options.m
    menubutton $w.top.orient -text Orientation -borderwidth 2 -relief raised \
	-menu $w.top.orient.m
    menubutton $w.top.create -text Create -borderwidth 2 -relief raised \
	-menu $w.top.create.m
    menubutton $w.top.misc -text Misc -borderwidth 2 -relief raised \
	-menu $w.top.misc.m
    
    # -------------------------------------------------
    
    set v $w.view
    set m $w.top.orient.m
    menu $m
    $m add command -label "Home" -command "tdv_home $v"
    $m add command -label "Zoom in" -command "tdv_zoomin $v"
    $m add command -label "Scale to fit" -command "tdv_scale_to_fit $v"
    $m add command -label "Positive X" -command "tdv_along_axis $v +x"
    $m add command -label "Negative X" -command "tdv_along_axis $v -x"
    $m add command -label "Positive Y" -command "tdv_along_axis $v +y"
    $m add command -label "Negative Y" -command "tdv_along_axis $v -y"
    $m add command -label "Positive Z" -command "tdv_along_axis $v +z"
    $m add command -label "Negative Z" -command "tdv_along_axis $v -z"
    $m add command -label "Isometric" -command "tdv_isoview $v"
    $m add command -label "Reverse" -command "tdv_reverse $v"
    
    # -------------------------------------------------
    
    set m $w.top.options.m
    menu $m
    $m add checkbutton -label "Depthcue" -variable tdv_depthcue_var($v) \
	-command "tdv_toggle_depthcue $v"
    $m add checkbutton -label "Double buffer" -variable tdv_dbuffer_var($v) \
	-command "tdv_toggle_dbuffer $v"
    $m add checkbutton -label "Hidden line" -variable tdv_hiddenline_var($v) \
	-command "tdv_toggle_hiddenline $v"
    $m add separator
    $m add checkbutton -label "Show origin" -variable tdv_origin_var($v) \
	-command "tdv_toggle_origin $v"
    $m add checkbutton -label "Show axes" -variable tdv_axes_var($v) \
	-command "tdv_toggle_axes $v"
    $m add checkbutton -label "Show rulers" -variable tdv_rulers_var($v) \
	-command "tdv_toggle_rulers $v"
    $m add checkbutton -label "Show date" -variable tdv_date_var($v) \
	-command "tdv_toggle_date $v"
    $m add checkbutton -label "Show title" -variable tdv_title_var($v) \
	-command "tdv_toggle_title $v"
    $m add checkbutton -label "Angled text" -variable tdv_angled_text_var($v) \
	-command "tdv_toggle_angled_text $v -45"
    # demonstrates how to use angled text
    # tdv_toggle_angled_text makes a call to tdv_angled_text_im 
    # which puts the angled text on screen

    $m add separator
    $m add radiobutton -label "Wireframe" -variable test_shading_type($v) \
	-value wire -command "test_update_shade $v"
    $m add radiobutton -label "Flat shading" -variable test_shading_type($v) \
	-value flat -command "test_update_shade $v"
    $m add radiobutton -label "Gouraud shading" \
	-variable test_shading_type($v) -value gouraud \
	-command "test_update_shade $v"
    $m add checkbutton -label "Directional light" \
	-variable tdv_directlight_var($v) \
	-command "tdv_toggle_directlight $v"
    if {$gtype == "X11"} {
	$m add separator
	$m add checkbutton -label "X hidden surface" \
	    -variable tdv_xhidden_var($v) \
	    -command "tdv_toggle_xhidden $v"
	$m add checkbutton -label "X Gouraud shading" \
	    -variable tdv_xgouraud_var($v) \
	    -command "tdv_toggle_xgouraud $v"
    }
    $m add separator
    $m add command -label "Background color" -command "tdv_changebg $v"
    
    # -------------------------------------------------
    
    set m $w.top.create.m
    menu $m
    $m add checkbutton -label "Wireframe box" -variable \
	object_exists($w,wirebox) -command "test_object $w wirebox"
    $m add checkbutton -label "Flat box" -variable \
	object_exists($w,flatbox) -command "test_object $w flatbox"
    $m add checkbutton -label "Gouraud poly" -variable \
	object_exists($w,gouraudpoly) -command "test_object $w gouraudpoly"
    $m add checkbutton -label "Texture poly" -variable \
	object_exists($w,texturepoly) -command "test_object $w texturepoly"
    $m add checkbutton -label "Point" -variable \
	object_exists($w,point) -command "test_object $w point"
    $m add checkbutton -label "Symmetry Points" -variable \
	object_exists($w,symm_point) -command "test_object $w symm_point"
    $m add checkbutton -label "Mirror Points" -variable \
	object_exists($w,mirror_point) -command "test_object $w mirror_point"
    $m add checkbutton -label "Line" -variable \
	object_exists($w,line) -command "test_object $w line"
    $m add checkbutton -label "Gouraud line" -variable \
	object_exists($w,gline) -command "test_object $w gline"
    
    $m add checkbutton -label "Incline" -variable \
	object_exists($w,incline) -command "test_object $w incline"
    
    $m add checkbutton -label "Group 1" -variable \
	object_exists($w,group1) -command "test_object $w group1"
    
    $m add checkbutton -label "Pixmap" -variable \
	object_exists($w,pixmap) -command "test_object $w pixmap"
    
    $m add checkbutton -label "Canvas" -variable \
	object_exists($w,canvas) -command "test_object $w canvas"
    
    # -------------------------------------------------
    
    set m $w.top.misc.m
    menu $m
    $m add command -label "Write PPM" -command "write_ppm $v"
    $m add command -label "Write VRML" -command "write_vrml $v"
    $m add command -label "Write PS" -command "write_ps $v"
    
    # -------------------------------------------------
    
    #tk_menuBar $w.top $w.top.options $w.top.orient $w.top.create $w.top.misc
    pack $w.top.title $w.top.options $w.top.orient $w.top.create $w.top.misc \
	-side left -fill y
    pack $w.top $w.view -side top -fill both -expand 1
    wm geometry $w $geo
}

proc test_object {w what} {
    global object_exists object_id
    
    if {$object_exists($w,$what) && ![info exists object_id($w,$what)]} {
	switch $what {
	    wirebox {
		set im [tdv_prism_geo  -color "1 1 1" -shade wire \
			    -point1 "0 0 0" -point2 "1 1 1"]
	    }
	    flatbox {
		set im [tdv_prism_geo -color "0 .9 0" -shade flat \
			    -point1 "2 0 0" -point2 "3 1 1"]
	    }
	    gouraudpoly {
		set im [tdv_poly_im -use_norms 1 -use_colors 1 -shade gouraud \
			    -vdesc {
				{4.0 0.0 0.0  0 0 1.0  1 0 0}
				{4.0 1.0 0.0  0 0 1.0  0 1 0}
				{5.0 1.0 0.0  0 0 1.0  0 0 1}
				{5.0 0.0 0.0  0 0 1.0  1 1 0}}]
	    }
	    texturepoly {
		set tid [.n.view load_texture image.ppm]
		set im [tdv_poly_im -use_norms 1 -use_colors 1 -use_textures 1 -texid $tid \
			    -draw_line 0  -vdesc {
				{4 0 1  0 0 1  0 0 0}
				{4 1 1  0 0 1  0 1 0}
				{5 1 1  0 0 1  1 1 0}
				{5 0 1  0 0 1  1 0 0}}]
		

# 		set im [tdv_poly_im -use_norms 1 -use_colors 1 -texwidth 4 -texheight 4 \
# 			    -draw_line 0 -use_textures 1 -vdesc {
# 				{4 0 1  0 0 1  0 0 0}
# 				{4 1 1  0 0 1  0 1 0}
# 				{5 1 1  0 0 1  1 1 0}
# 				{5 0 1  0 0 1  1 0 0}} \
# 			    -texture {
# 			        {  0 255   0}
# 				{  0 255   0}
# 				{255   0   0}
# 				{255 255 255}
# 			        {  0 255   0}
# 				{255   0   0}
# 				{255   0   0}
# 				{255 255 255}
# 				{  0 255   0}
# 				{  0   0 255}
# 				{255   0   0}
# 				{255 255 255}
# 				{  0   0 255}
# 				{  0   0 255}
# 				{  0   0 255}
# 				{255 255 255}}]
	    }
	    gline {
		set im [tdv_poly_im -use_norms 1 -use_colors 1 -shade gouraud \
			    -draw_line 1  -vdesc {
				{4 0 0  0 0 1  1 0 0}
				{4 1 0  0 0 1  0 1 0}
				{5 1 0  0 0 1  0 0 1}
				{5 0 0  0 0 1  1 1 0}}]
	    }
	    point {
		set im [tdv_point_im -color \#f00 -point "0 0 1" -size 4]
	    }
	    symm_point {
		set im [tdv_point_im -color \#0f0 -point "0 5 0" -size 4 \
			    -use_symm 7 -symm {0 0 0 0 0 1 .6}]
	    }
	    mirror_point {
		set im [tdv_point_im -color \#00f -point "5 5 0" -size 4 \
			    -use_mirror 1 -mirror {{1 0 0 9} {0 1 0 4} {0 0 1 2} {1 0 1 0} }]
	    }
	    line {
		set im [tdv_line_im -color \#0000ff -width 2 \
			    -point1 "-1 0 -1" -point2 "2 1 3"]
	    }
	    incline {
		set im [tdv_incline_geo -color "orange red" -axis z \
			    -rotate_sign -1 -point1 "0 2 0" -point2 "2 4 2" \
			    -thickness 0.2]
	    }
	    pixmap {
		set im [tdv_pixmap_im -pos "100 100 0" -transform 0 \
			    -ppmfile image.ppm]
	    }
	    group1 {
		set im1 [tdv_point_im -color \#f00 -point "0 0 1" -size 4]
		set im2 [tdv_line_im -color \#0000ff -width 2 \
			     -point1 "-1 0 -1" -point2 "2 1 3"]
		set im3 [tdv_prism_geo -color "1 1 1" -shade wire \
			     -point1 "0 0 0" -point2 "1 1 1"]
		set im [tdv_group -pos "0 10 0"]
		$im add_image $im1
		$im add_image $im2
		$im add_image $im3
	    }
	    canvas {
		toplevel .c
		canvas .c.c
		pack .c.c
		update
		.n.view configure -width [.c.c cget -width] -height [.c.c cget -height]
		.c.c create line 10 10 190 190 -fill green -width 3
		.c.c create rectangle 50 50 30 30 -fill blue
		.c.c create text 30 70 -text hello -fill red
		set im [tdv_plotcanvas_im -canvas .c.c -transform 0]
		#set tdv_origin_var(.n.view) 0; tdv_toggle_origin .n.view
		#set tdv_axes_var(.n.view) 0; tdv_toggle_axes .n.view
	    }
	}
	$w.view add_image $im
	set object_id($w,$what) $im
    } elseif {!$object_exists($w,$what) && [info exists object_id($w,$what)]} {
	$object_id($w,$what) delete
	unset object_id($w,$what)
    }
}

proc write_ppm {v} {
    $v redraw; $v redraw; update
    set fp [open output.ppm w]
    $v write_ppm $fp landscape 1 0 0 0 0
    close $fp
}

proc write_vrml {v} {
    global tdv_axes_var
    set ax_v $tdv_axes_var($v)
    if { $ax_v } { 
	set tdv_axes_var($v) 0
	tdv_toggle_axes $v
    }

    mess "Writing VRML\n"
    $v redraw; $v redraw; update
    mess "Screen redrawn\n"
    mess "Writing file.........\n"
    $v write_vrml output.wrl landscape 1 0 0 0 0
    mess "File written\n"
    if { $ax_v } {
	set tdv_axes_var($v) 1
	tdv_toggle_axes $v 
    }
    $v redraw; $v redraw; update
}

proc write_ps {v} {
    mess "Writing PS\n"
    $v postscript output.ps "this is the title" "this is the label" color 1
    mess "File written\n"
}

wm withdraw .

proc do_one {n pos} {
    global argv tdv_axes_var
    if {$argv == "-gdi"} {
	setup_vtest $n $pos Mswin
    } else { if {$argv == "-x"} {
	setup_vtest $n $pos X11
    } else {
	setup_vtest $n $pos native
    }}
    $n.view configure -xgouraud 1
    
    update
    set tdv_axes_var($n.view) 1
    tdv_toggle_axes $n.view
}

proc mess {text args} {
    puts -nonewline $text
}

proc set_cursor {w spec} {
    catch { $w configure -cursor $spec }
}
set small_screen_hack 0

puts "ARGV is $argv"

do_one .n +0+0
# do_one .m +300+0

