# GLOBAL VARIABLES RELATED WITH UI

set frame 0
set fps 0
set xangle -80
set yangle 0
set zangle 0
set name 0

set do_init 1
set screen_width 300
set screen_height 300

proc gl_init {} {
  global name options

  gl -enable lighting \
     -enable light0 \
     -clearcolor 0 0 0 1 \
     -light light0 position 20 20 200 1 \
     -light light0 ambient 0 0 0 1 \
     -light light0 diffuse 0 0 0 1 \
     -light light0 specular 0 0 0 1

  gl -genlists name
  catch { change_vehicle_scene [cache::filename $options(vehicle)] }
}

proc about_to_next {next} {
  glut -mousefunc {}
  glut -keyboardfunc {}
  glut -timerfunc 0 1 {}
  glut -timerfunc 0 4 {}
  glut -timerfunc 0 5 {}
  fade_out 1 1 1 1 2000 $next
}

proc about_page {} {
  gl -clearcolor 0 0 0 1
  fade_in 1 1 1 0 2000

  glutwidget forget
  glut -reshapefunc {default_reshape $WIDTH $HEIGHT}

  glutwidget append [show_vehicle]

  glutlabel title \
		-text "GRacer" \
		-pos 0 50 center \
		-fgcolor normal 1 0 0
  glutwidget append title

  glutlabel version \
		-font bitmap_helvetica_10 \
		-text "Release 0.1.4" \
		-pos 0 30 center \
		-fgcolor normal 1 0 0
  glutwidget append version

  glutlabel copy \
		-font bitmap_times_roman_10 \
		-pos 0 0 center \
		-text "Copyright (C) 1999 Takashi Matsuda" \
		-fgcolor normal 0.5 0.5 0.5
  glutwidget append copy

  glutlabel mail \
		-font bitmap_times_roman_10 \
		-pos 0 -20 center \
		-text "matsu@arch.comp.kyutech.ac.jp" \
		-fgcolor normal 0.5 0.5 0.5
  glutwidget append mail

  set file [open [cache::get license] "r"]
  glutlabel license \
		-font bitmap_helvetica_10 \
		-pos 0 -60 s \
		-text "[read $file]" \
		-justify left \
		-fgcolor normal 0.5 0.5 0.5
  glutwidget append license
  close $file

  glutwidget append [show_fps]

  roll_away_loop 0 [expr [glutwidget height] / 2] 1 {license} \
    roll_away 1 {copy mail license} about_to_next top_page

  glut -mousefunc {about_to_next top_page}
  glut -keyboardfunc {about_to_next top_page}
}

proc top_page {} {
  gl -clearcolor 0 0 0 1
  fade_in 1 1 1 0 1000
  set buttons {server_b make_b score_b option_b quit_b}

  glutwidget forget
  glut -reshapefunc {default_reshape $WIDTH $HEIGHT}

  glutlabel title \
		-text "GRacer 0.1.4" \
		-pos 0 -5 n \
		-fgcolor normal 1 0 0
  glutwidget append title

  glutbutton server_b \
		-text "Connect To Server" \
		-pos 0 60 center \
		-size 180 0 \
		-command [list saw_away 40 $buttons connect_page ]
  glutwidget append server_b

  glutbutton make_b \
		-text "Make New Race" \
		-pos 0 25 center \
		-size 180 0 \
		-command [list saw_away 40 $buttons make_page ]
  glutwidget append make_b
  glutwidget focus make_b

  glutbutton score_b \
		-text "Course Records" \
		-pos 0 -10 center \
  		-size 180 0 \
		-command [list saw_away 40 $buttons highscore_page top_page ]
  glutwidget append score_b

  glutbutton option_b \
		-text "Options" \
		-pos 0 -45 center \
  		-size 180 0 \
		-command [list saw_away 40 $buttons option_page top_page ]
  glutwidget append option_b

  glutbutton quit_b \
		-text "Quit" \
		-pos 0 -90 center \
  		-size 180 0 \
		-command [list saw_away 40 $buttons exit ]
  glutwidget append quit_b

  glut -keyboardfunc {
    if {$KEY == 27} {quit_b invoke}
  }
}

proc connect_page {} {
  global screen_width
  global options

  gl -clearcolor 0 0 0 1
  fade_in 1 1 1 0 1000
  glutwidget forget
  glut -reshapefunc {default_reshape $WIDTH $HEIGHT}

  glutlabel title \
		-text "Connect To Server" \
		-pos 0 -5 n \
		-fgcolor normal 1 0 0
  glutwidget append title

  glutlabel label1 \
		-text "Hostname :" \
		-pos 20 80 w \
		-fgcolor normal 1 0.5 0
  glutwidget append label1

  glutentry entry1 \
		-text $options(hostname) \
		-pos 20 60 we \
		-size [expr int([glutwidget width] - 40)] 0 \
		-fgcolor normal 0.7 0.7 1 \
		-fgcolor active 0.7 0.7 1 \
		-fgcolor focus 0.5 0.5 1 \
		-changed {set options(hostname) [entry1 get]} \
		-command {ok invoke}
  glutwidget append entry1

  glutlabel label2 \
		-text "Port :" \
		-pos 20 30 w \
		-fgcolor normal 1 0.5 0
  glutwidget append label2

  glutentry entry2 \
		-text $options(port) \
		-pos 20 10 w \
		-size 100 0 \
		-fgcolor normal 0.7 0.7 1 \
		-fgcolor active 0.7 0.7 1 \
		-fgcolor focus 0.5 0.5 1 \
		-changed {set options(port) [entry2 get]} \
		-command {ok invoke}
  glutwidget append entry2

  glutbutton ok \
		-text "OK" \
		-pos -50 -60 center \
  		-command {
		  alart 5000 "Sorry, not yet implemented."
		  return
		  if {[string length $options(hostname)] &&
		      [string length $options(port)]} {
		    saw_away 40 {label1 entry1 label2 entry2 ok cancel} \
			     entry_page
		  }
		}
  glutwidget append ok
  glutwidget focus ok

  glutbutton cancel \
		-text "Cancel" \
		-pos 50 -60 center \
		-command {
		  saw_away 40 {label1 entry1 label2 entry2 ok cancel} \
			   top_page
		}
  glutwidget append cancel

  glut -keyboardfunc {
    if {$KEY == 27} {
      cancel invoke
      glut -keyboardfunc {}
    }
  }
}

proc select_page {} {
  fade_in 1 1 1 0 1000

  gl -clearcolor 0 0 0 1
  glutwidget forget
  glut -reshapefunc {default_reshape $WIDTH $HEIGHT}

  glutlabel title \
		-text "GRacer 0.1.4" \
		-pos 0 -5 n \
		-fgcolor normal 1 0 0
  glutwidget append title
}

set vehicles	{}

proc change_vehicle_scene {file} {
  global name

  switch -exact -- [file extension $file] {
    .grc -
    .grv {
      if [catch {set grs [get_model $file]}] {
	error "couldn't find grs name."
      }
      set baseurl [cache::url $file]
      set file [cache::fullurl $grs $baseurl]
    }
    .grs {
    }
    default {
      error "unkown format."
    }
  }

  if {$name == 0} {
    gl -genlists name 1
  }
  set scene [gr::scene create $file]
  gl -pushattrib all_attrib_bits
  gr::scene setup $scene
  gl -newlist $name compile
  gr::scene draw $scene all
  gl -endlist
  gl -popattrib
  gr::scene destroy $scene
}

set do_alart 0
proc alart {time message} {
  global do_alart

  if {$do_alart} {
    alart_message configure -text $message
  } else {
    glutlabel alart_message \
		-fgcolor normal 1 0.5 0 \
		-text "$message" \
		-pos 0 0 center
    glutwidget append alart_message
  }

  set do_alart 1
  glut -postredisplay

  glut -timerfunc $time 8 {
    set do_alart 0
    glutwidget remove alart_message
    glut -timerfunc 0 8 {}
    glut -postredisplay
  }
}

proc entry_page {} {
  global options vehicles scene name

  gl -clearcolor 0 0 0 1
  fade_in 1 1 1 0 1000
  glut -reshapefunc {default_reshape $WIDTH $HEIGHT}

  glutwidget forget

# check if memoried vehicle is exists #

  set vehicles [search_files *.grv]
  set index -1
  catch {
    set filename [cache::filename $options(vehicle)]
    set index [lsearch -exact $vehicles $filename]
  }

# if memoried vehicle is not exists, then use first vehicle of found. #

  if {$index < 0} {
    set index 0
    set filename [lindex $vehicles $index]
    set options(vehicle) [cache::url $filename]
  }

  set title {}
  catch {
    set title [get_title $filename]
    change_vehicle_scene $filename
  }

  glutwidget append [show_vehicle]

  glutlabel title \
		-text "Entry" \
		-pos 0 -5 n \
		-fgcolor normal 1 0 0
  glutwidget append title

  glutentry entry \
		-font bitmap_helvetica_12 \
		-text "$title" \
  		-pos 10 -30 wen \
		   -size [expr [glutwidget width] - 20] 0 \
		   -command {
		     set url [entry get]
		     if [cache {set file [cache::get $url]}] {
		       alart 3000 "failed to get $url."
		     } else {
		       set vehicles [search_files *.grv]
		       entry configure -text [get_title $file]
		       if [cache {change_vehicle_scene $file}] {
			 alart 3000 "couldn't get grs file."
		       } else {
			 set optons(vehicle) $url
		       }
		     }
		   }
  glutwidget append entry

  glutbutton prev \
		-font bitmap_helvetica_12 \
		-text "Prev" \
		-pos 10 -50 wn \
  		-command {
		  set file [cache::filename $options(vehicle)]
		  set index [lsearch -exact $vehicles $file]
		  incr index -1
		  if {$index < 0} {
		    set index end
		  }
		  set file [lindex $vehicles $index]
		  set options(vehicle) [cache::url $file]
		  entry configure -text [get_title $file]
		  change_vehicle_scene $file
		}
  glutwidget append prev

  glutbutton next \
	        -font bitmap_helvetica_12 \
  		-text "Next" \
		-pos -10 -50 en \
  		-command {
		  set file [cache::filename $options(vehicle)]
		  set index [lsearch -exact $vehicles $file]
		  incr index
		  if {$index >= [llength $vehicles]} {
		    set index 0
		  }
		  set file [lindex $vehicles $index]
		  set options(vehicle) [cache::url $file]
		  entry configure -text [get_title $file]
		  change_vehicle_scene $file
		}
  glutwidget append next

  glutbutton ok \
  		-text "OK" \
		-pos -90 20 s \
		-size 70 0 \
  		-command {
		  saw_away 40 {next prev entry cancel ok watch}
		  fade_out 1 1 1 1 2000 time_trial_page
		}
  glutwidget append ok

  glutbutton watch \
		-text "Watch" \
		-pos 0 20 s \
		-size 70 0 \
  		-command {
		  saw_away 40 {next prev entry cancel ok watch}
		  fade_out 1 1 1 1 2000 time_trial_page
		}
  glutwidget append watch

  glutbutton cancel \
		-text "Cancel" \
		-pos 90 20 s \
		-size 70 0 \
  		-command {
		  fade_out 1 1 1 1 2000
		  saw_away 40 {next prev entry cancel ok watch} top_page
		}
  glutwidget append cancel

  glutwidget append [show_fps]

  glutwidget focus prev
  glut -keyboardfunc {
    if {$KEY == 27} {
      cancel invoke
      glut -keyboardfunc {}
    }
  }
}

set courses {}
set conditions {Fine Rainy}

proc make_page {} {
  global options courses conditions

  gl -clearcolor 0 0 0 1
  fade_in 1 1 1 0 1000 

  set courses [search_files *.grc]
  set index -1
  catch {
    set filename [cache::filename $options(course)"]
    set index [lsearch -exact $courses $filename]
  }
  if {$index < 0} {
    set index 0
    set filename [lindex $courses 0]
    set options(course) [cache::url $filename]
  }
  set title [get_title $filename]

  glutwidget forget

  glutlabel title \
		-text "Make New Race" \
		-pos 0 -5 n \
		-fgcolor normal 1 0 0
  glutwidget append title

  glutlabel label0 \
		 -text "Course :" \
		 -pos 10 110 w \
		 -fgcolor normal 1 0.5 0
  glutwidget append label0

  glutlabel label1 \
		-text "[expr int($index + 1)]/[llength $courses]" \
		-pos -10 110 e \
  		-fgcolor normal 1 0.5 0
  glutwidget append label1

  glutbutton button0 \
		-text "Prev" \
		-pos 10 87 w \
  		-command {
		  set filename [cache::filename $options(course)]
		  set index [lsearch -exact $courses $filename]
		  incr index -1
		  if {$index < 0} {
		    set index [expr [llength $courses] - 1]
		  }
		  set filename [lindex $courses $index]
		  set options(course) [cache::url $filename]
		  label1 configure -text "[expr $index + 1]/[llength $courses]"
		  entry0 configure -text [get_title $filename]
		}
  glutwidget append button0

  glutbutton button1 \
		-text "Next" \
		-pos -10 87 e \
  		-command {
		  set filename [cache::filename $options(course)]
		  set index [lsearch -exact $courses $filename]
		  incr index
		  if {$index >= [llength $courses]} {
		    set index 0
		  }
		  set filename [lindex $courses $index]
		  set options(course) [cache::url $filename]
		  label1 configure -text "[expr $index + 1]/[llength $courses]"
		  entry0 configure -text [get_title $filename]
		}
  glutwidget append button1

  glutentry entry0 \
		-text "$title" \
		-pos 69 87 we \
		-size [expr [glutwidget width] - 140] 0
  glutwidget append entry0


  glutlabel label2 \
		-text "Lap :" \
		-pos 10 60 w \
  		-fgcolor normal 1 0.5 0
  glutwidget append label2

  glutbutton button2 \
		-text "-1" \
		-pos 27 37 w \
		-command {
		  catch { set options(lap) [expr int([entry1 get])]}
		  incr options(lap) -1
		  entry1 configure -text "$options(lap)"
		}
  glutwidget append button2

  glutbutton button3 \
		-text "+1" \
		-pos -27 37 e \
		-command {
		  catch { set options(lap) [expr int([entry1 get])]}
		  incr options(lap)
		  entry1 configure -text "$options(lap)"
		}
  glutwidget append button3

  glutentry entry1 \
		-text "$options(lap)" \
		-pos 69 37 we \
		-size [expr [glutwidget width] - 140] 0
  glutwidget append entry1


  glutlabel label3 \
		-text "Condition :" \
		-pos 10 10 w \
		-fgcolor normal 1 0.5 0
  glutwidget append label3

  glutbutton button4 \
		-text "Prev" \
		-pos 10 -13 w \
  		-command {
		  set index [lsearch -exact $conditions $options(condition)]
		  incr index -1
		  set options(condition) [lindex $conditions $index]
		  if {[string length $options(condition)] == 0} {
		    set index [expr [llength $conditions] - 1]
		    set options(condition) [lindex $conditions $index]
		  }
		  entry2 configure -text $options(condition)
		}
  glutwidget append button4

  glutbutton button5 \
		-text "Next" \
		-pos -10 -13 e \
  		-command {
		  set index [lsearch -exact $conditions $options(condition)]
		  incr index
		  set options(condition) [lindex $conditions $index]
		  if {[string length $options(condition)] == 0} {
		    set index 0
		    set options(condition) [lindex $conditions 0]
		  }
		  entry2 configure -text $options(condition)
		}

  glutwidget append button5

  glutentry entry2 \
		-text "$options(condition)" \
		-pos 69 -13 we \
		-size [expr [glutwidget width] - 140] 0
  glutwidget append entry2


  glutlabel label4 \
		-text "Port :" \
		-pos 10 -60 w \
  		-fgcolor normal 1 0.5 0
  glutwidget append label4

  glutentry entry3 \
		-text "$options(port)" \
		-pos 69 -60 we \
		-size [expr [glutwidget width] - 140] 0
  glutwidget append entry3


  glutbutton ok \
		-text "OK" \
		-pos -50 -110 center \
		-size 80 0 \
  		-command {
		  saw_away 40 { label0 label1 entry0 {} button0 button1
				label2 entry1 button2 button3
				label3 {} entry2 {} button4 button5
				label4 entry3
				ok cancel } entry_page
		}
  glutwidget append ok

  glutbutton cancel \
		-text "Cancel" \
		-pos 50 -110 center \
		-size 80 0 \
  		-command {
		  saw_away 40 { label0 label1 entry0 {} button0 button1
				label2 entry1 button2 button3
				label3 {} entry2 {} button4 button5
				label4 entry3
				ok cancel } top_page
		}
  glutwidget append cancel

  glut -keyboardfunc {
    if {$KEY == 27} {
      cancel invoke
      glut -keyboardfunc {}
    }
  }
}

proc set_sort_result {} {
  global options sort_index env

  switch $sort_index {
    0 {
      set key [list \
	"race:time trial" \
	"type:best" \
	"course:$options(course)"]
      set show_vehicle 1
      set show_user 1
    }
    1 {
      set key [list \
	"race:time trial" \
	"type:average" \
	"course:$options(course)"]
      set show_vehicle 1
      set show_user 1
    }
    2 {
      set key [list \
	"race:time trial" \
	"type:best" \
	"course:$options(course)" \
	"vehicle:$options(vehicle)"]
      set show_vehicle 0
      set show_user 1
    }
    3 {
      set key [list \
	"race:time trial" \
	"type:average" \
	"course:$options(course)" \
	"vehicle:$options(vehicle)"]
      set show_vehicle 0
      set show_user 1
    }
    4 {
      set key [list \
	"race:time trial" \
	"type:best" \
	"user:$env(LOGNAME)" \
	"course:$options(course)"]
      set show_vehicle 1
      set show_user 0
    }
    5 {
      set key [list \
	"race:time trial" \
	"type:average" \
	"user:$env(LOGNAME)" \
	"course:$options(course)"]
      set show_vehicle 1
      set show_user 0
    }
    6 {
      set key [list \
	"race:time trial" \
	"type:best" \
	"user:$env(LOGNAME)" \
	"course:$options(course)" \
	"vehicle:$options(vehicle)"]
      set show_vehicle 0
      set show_user 0
    }
    7 {
      set key [list \
	"race:time trial" \
	"type:average" \
	"user:$env(LOGNAME)" \
	"course:$options(course)" \
	"vehicle:$options(vehicle)"]
      set show_vehicle 0
      set show_user 0
    }
  }

  set result [score::hiscore_search 10 $key]
  set string {}

  set script {
    set line [format "%7.3f" [lindex $entry 0]]

# user name #
    if {$show_user} {
      set index [lsearch -glob $entry "user:*"]
      regexp {user:(.*)} [lindex $entry $index] dum name
      lappend line $name
    }

# time stamp #
    set index [lsearch -glob $entry "date:*"]
    regexp {date:(.*)} [lindex $entry $index] dum date
    lappend line [clock format $date -format "%m/%d/%Y"]

# vehicle #
    if {$show_vehicle} {
      set index [lsearch -glob $entry "vehicle:*"]
      regexp {vehicle:(.*)} [lindex $entry $index] dum url
      set vehicle [get_title [cache::filename $url]]
      lappend line $vehicle
    }

    set line [join $line " - "]
  }

  set i 1
  foreach entry $result {
    eval $script
    lappend string [format "%d: %s" $i $line]
    incr i
  }
  
  if {$i < 9} {
    lappend key "expired"
    set result [score::hiscore_search [expr 10 - $i] $key]
    if {[llength $result] > 0} {
      lappend string "< expired >"
      foreach entry $result {
	eval $script
	lappend string [format "-: %s" $line]
      }
    }
  }

  sort_result configure -text [join $string "\n"] 
}

set sort_index 0
set sort_title {
  "fastest lap"
  "average lap"
  "fastest lap of this vehicle"
  "average lap of this vehicle"
  "your fastest lap"
  "your average lap"
  "your fastest lap of this vehicle"
  "your average lap of this vehicle"
}

proc highscore_page {next} {
  global options
  global vehicles courses
  global sort_title sort_index

  gl -clearcolor 0 0 0 1
  fade_in 1 1 1 0 2000

# check current vehicle #

  set vehicles [search_files *.grv]
  if [catch {
    set vfilename [cache::filename $options(vehicle)]
    set index [lsearch $vehicles $vfilename]
  }] {
    set index 0
    set vfilename [lindex $vehicles 0]
    set options(vehicle) [cache::url $vfilename]
  }

# check current course #

  set courses [search_files *.grc]
  if [catch {
    set cfilename [cache::filename $options(course)]
    set index [lsearch $courses $cfilename]
  }] {
    set index 0
    set cfilename [lindex $courses 0]
    set options(course) [cache::url $cfilename]
  }

  glutwidget forget
  glut -reshapefunc {default_reshape $WIDTH $HEIGHT}

  glutlabel title \
		-text "Course Records" \
		-pos 0 -5 n \
  	    	-fgcolor normal 1 0 0
  glutwidget append title

  glutlabel label1 \
  		-font bitmap_helvetica_10 \
		-text "Course :" \
		-pos 20 -30 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label1

  set title {}
  catch { set title [get_title $cfilename] }
  glutlabel course_name \
  		-font bitmap_helvetica_10 \
		-text $title \
		-pos 65 -30 wn \
		-fgcolor normal 1 1 1
  glutwidget append course_name

  glutbutton course_prev \
	        -font bitmap_helvetica_10 \
		-text "<" \
		-pos -30 -28 en \
		-fgcolor normal 1 0 0 \
  		-command {
		  set file [cache::filename $options(course)]
		  set index [lsearch -exact $courses $file]
		  incr index -1
		  if {$index < 0} {
		    set index end
		  }
		  set file [lindex $courses $index]
		  set options(course) [cache::url $file]
		  course_name configure -text [get_title $file]
		  set_sort_result
		}
  glutwidget append course_prev

  glutbutton course_next \
	        -font bitmap_helvetica_10 \
		-text ">" \
		-pos -10 -28 en \
		-fgcolor normal 1 0 0 \
  		-command {
		  set file [cache::filename $options(course)]
		  set index [lsearch -exact $courses $file]
		  incr index
		  if {$index >= [llength $courses]} {
		    set index 0
		  }
		  set file [lindex $courses $index]
		  set options(course) [cache::url $file]
		  course_name configure -text [get_title $file]
		  set_sort_result
		}
  glutwidget append course_next

  glutlabel label2 \
  		-font bitmap_helvetica_10 \
		-text "Vehicle :" \
		-pos 20 -50 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label2

  set title {}
  catch { set title [get_title $vfilename] }
  glutlabel vehicle_name \
		-font bitmap_helvetica_10 \
  		-text $title \
		-pos 65 -50 wn \
		-fgcolor normal 1 1 1
  glutwidget append vehicle_name

  glutbutton vehicle_prev \
	        -font bitmap_helvetica_10 \
		-text "<" \
		-pos -30 -48 en \
		-fgcolor normal 1 0 0 \
  		-command {
		  set file [cache::filename $options(vehicle)]
		  set index [lsearch -exact $vehicles $file]
		  incr index -1
		  if {$index < 0} {
		    set index end
		  }
		  set file [lindex $vehicles $index]
		  set options(vehicle) [cache::url $file]
		  vehicle_name configure -text [get_title $file]
		  set_sort_result
		}
  glutwidget append vehicle_prev

  glutbutton vehicle_next \
	        -font bitmap_helvetica_10 \
		-text ">" \
		-pos -10 -48 en \
		-fgcolor normal 1 0 0 \
  		-command {
		  set file [cache::filename $options(vehicle)]
		  set index [lsearch -exact $vehicles $file]
		  incr index
		  if {$index >= [llength $vehicles]} {
		    set index 0
		  }
		  set file [lindex $vehicles $index]
		  set options(vehicle) [cache::url $file]
		  vehicle_name configure -text [get_title $file]
		  set_sort_result
		}
  glutwidget append vehicle_next

  glutlabel label3 \
  		-font bitmap_helvetica_10 \
		-text "Sort :" \
		-pos 30 -70 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label3

  set title [lindex $sort_title $sort_index]
  glutlabel sort_type \
  		-font bitmap_helvetica_10 \
		-text $title \
		-pos 65 -70 wn \
		-fgcolor normal 1 1 1
  glutwidget append sort_type

  glutbutton sort_prev \
  		-font bitmap_helvetica_10 \
  		-text "<" \
  		-pos -30 -68 en \
		-fgcolor normal 1 0 0 \
  		-command { 
		  incr sort_index -1
		  if {$sort_index < 0} {
		    set sort_index [llength $sort_title]
		    incr sort_index -1
		  }
		  sort_type configure -text [lindex $sort_title $sort_index]
		  set_sort_result
		}
  glutwidget append sort_prev

  glutbutton sort_next \
  		-font bitmap_helvetica_10 \
  		-text ">" \
		-pos -10 -68 en \
		-fgcolor normal 1 0 0 \
  		-command { 
		  incr sort_index
		  set length [llength $sort_title]
		  if {$sort_index >= $length} {
		    set sort_index 0
		  }
		  sort_type configure -text [lindex $sort_title $sort_index]
		  set_sort_result
		}
  glutwidget append sort_next

  glutlabel sort_result \
  		-font bitmap_helvetica_10 \
		-text "" \
		-pos 0 -100 n \
		-justify left \
		-fgcolor normal 1 1 1
  glutwidget append sort_result

  set_sort_result

  glutbutton dismiss -text "Dismiss" -pos 0 20 s \
  		-command [list about_to_next $next ]
  glutwidget append dismiss
  glutwidget focus dismiss

  glutwidget append [show_fps]

  glut -keyboardfunc {
    if {$KEY == 27} {dismiss invoke}
  }
}

set xpan 6

proc overhead_view {widget value} {
  global xpan

  set diff [expr $xpan - $value]

  if {abs($diff) <= 0.5} {
    set xpan $value
  } elseif {$diff > 0} {
    set xpan [expr $xpan - 0.5]
  } else {
    set xpan [expr $xpan + 0.5]
  }

  $widget overhead -xpan $xpan

  if {abs($xpan - $value) > 0.1} {
    glut -timerfunc 10 7 "overhead_view $widget $value"
  }
}

set prev_width 0
set prev_height 0

set key_left 0
set key_right 0

proc set_steering {widget} {
  global key_left key_right

  $widget control -steering [expr 0.3 * ( $key_left + $key_right )] 
}

proc get_ranking {rank message} {
  switch $rank {
    1 {set str "the best"}
    2 {set str "the second"}
    3 {set str "the third"}
    default {set str [format "%dth" $rank]}
  }
  return [format $message $str]
}

proc save_high_score {} {
  global env options lap laptime laptime_best

  if {$lap > 0} {
# BEST LAP
    score::hiscore_add 11 $laptime_best [list \
      "type:best" \
      "user:$env(LOGNAME)" \
      "race:time trial" \
      "course:$options(course)" \
      "vehicle:$options(vehicle)" \
      ]

# AVERAGE LAP
    score::hiscore_add 11 [expr $laptime / $lap] [list \
      "type:average" \
      "user:$env(LOGNAME)" \
      "race:time trial" \
      "course:$options(course)" \
      "vehicle:$options(vehicle)" \
      ]
  }
}

proc show_results {} {
  global options lap laptime laptime_best
  global prev_width prev_height

  glut -reshapewindow $prev_width $prev_height

  set messages {}

  if {$lap <= 0} {
    top_page
    return
  }

# EXPIRE OLD SCORES
  if [timestamp::check [cache::filename $options(course)]] {
    score::hiscore_expire [list "course:$options(course)"]
  }
  if [timestamp::check [cache::filename $options(vehicle)]] {
    score::hiscore_expire [list "vehicle:$options(vehicle)"]
  }

# BEST COURSE RECORDS
  set rank [score::check_ranking 10 $laptime_best \
		[score::hiscore_search 11 \
		  [list "type:best" "race:time trial" \
			"course:$options(course)"]]]
  if {$rank > 0} {
    lappend messages \
      [get_ranking $rank "%s course record"]
  }

# BEST COURSE RECORDS OF SAME VEHICLE
  set rank [score::check_ranking 10 $laptime_best \
		[score::hiscore_search 11 \
		  [list "type:best" "race:time trial" \
			"vehicle:$options(vehicle)" \
			"course:$options(course)"]]]
  if {$rank > 0} {
    lappend messages \
      [get_ranking $rank "%s course record of the vehicle"]
  }

# AVERAGE COURSE RECORDS
  set rank [score::check_ranking 10 [expr $laptime / $lap] \
		[score::hiscore_search 11 \
		  [list "type:average" "race:time trial" \
			"course:$options(course)"]]]
  if {$rank > 0} {
    lappend messages \
      [get_ranking $rank "%s average course record"]
  }

# AVERAGE COURSE RECORDS OF SAME VEHICLE
  set rank [score::check_ranking 10 [expr $laptime / $lap] \
		[score::hiscore_search 11 \
		  [list "type:average" "race:time trial" \
			"vehicle:$options(vehicle)" \
			"course:$options(course)"]]]
  if {$rank > 0} {
    lappend messages \
      [get_ranking $rank "%s average course record of the vehicle"]
  }

  save_high_score

  result_page $laptime_best [expr $laptime / $lap] $messages top_page
}

proc result_page {best average messages next} {
  global options

  gl -clearcolor 0 0 0 1
  fade_in 1 1 1 0 2000

  glutwidget forget
  glut -reshapefunc {default_reshape $WIDTH $HEIGHT}

  glutlabel title \
		-text "Results" \
		-pos 0 -5 n \
		-fgcolor normal 1 0 0
  glutwidget append title

  glutlabel label1 \
		-font bitmap_helvetica_10 \
		-text "Course :" \
		-pos 20 -30 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label1

  glutlabel course_name \
		-font bitmap_helvetica_10 \
		-text [get_title [cache::filename $options(course)]] \
		-pos 65 -30 wn \
		-fgcolor normal 1 1 1
  glutwidget append course_name

  glutlabel label2 \
		-font bitmap_helvetica_10 \
		-text "Vehicle :" \
		-pos 20 -50 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label2

  glutlabel vehicle_name \
		-font bitmap_helvetica_10 \
  		-text [get_title [cache::filename $options(vehicle)]] \
		-pos 65 -50 wn \
		-fgcolor normal 1 1 1
  glutwidget append vehicle_name

  glutlabel label3 \
		-font bitmap_helvetica_10 \
		-text "Fastest :" \
		-pos 20 -70 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label3

  glutlabel fastest_lap \
		-font bitmap_helvetica_10 \
  		-text [format "%.2f sec" $best] \
		-pos 65 -70 wn \
		-fgcolor normal 1 1 1
  glutwidget append fastest_lap

  glutlabel label4 \
		-font bitmap_helvetica_10 \
		-text "Average :" \
		-pos 20 -90 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label4

  glutlabel average_lap \
		-font bitmap_helvetica_10 \
  		-text [format "%.2f sec" $average] \
		-pos 65 -90 wn \
		-fgcolor normal 1 1 1
  glutwidget append average_lap

  if [llength $messages] {
    glutlabel celeb \
		-font bitmap_helvetica_12 \
		-text "Congraturations !!" \
		-pos 0 -110 n \
		-fgcolor normal 1 1 0
    glutwidget append celeb

    glutlabel celeb \
		-font bitmap_helvetica_10 \
		-text "You marked :" \
		-pos 0 -130 n \
		-fgcolor normal 1 0.5 0
    glutwidget append celeb

    for {set i 0} {$i < [llength $messages]} {incr i} {
      glutlabel message$i \
		-font bitmap_helvetica_10 \
      		-text [lindex $messages $i] \
      		-pos 0 [expr - 150 - $i * 20] n \
 		-fgcolor normal 1 0.5  0
      glutwidget append message$i
    }
  }

  glutbutton dismiss \
		-text "Dismiss" \
		-pos 0 20 s \
		-command [list about_to_next $next ]
  glutwidget append dismiss
  glutwidget focus dismiss

  glut -keyboardfunc {
    if {$KEY == 27} {dismiss invoke}
  }
}

proc time_trial_page {} {
  global prev_width prev_height
  global options
  global xpan
  global lap laptime laptime_prev laptime_best

  set lap 0
  set laptime 0
  set laptime_prev 0
  set laptime_best 0

  gl -light light0 diffuse 1 1 1 1
  fade_in 1 1 1 0 1000 

  glutwidget forget

  glut -reshapefunc {default_reshape $WIDTH $HEIGHT}
  gl -clearcolor .3 .4 .8 1

  set prev_width [glutwidget width]
  set prev_height [glutwidget height]

  glut -reshapewindow $options(resx) $options(resy)

  glutgame game \
  		-use_texture $options(use_texture) \
  		-use_mipmap $options(use_mipmap) \
		-use_linear $options(use_linear) \
		-use_shading $options(use_shading) \
		-show_sky $options(show_sky) \
		-show_decr $options(show_decr) \
		-use_audio $options(audio)

  game course $options(course)
  game sky scenes/sky.grs
  game font scenes/font.grs
  game rpm scenes/panel.grs
  game entry 0 $options(vehicle)
  game compile
  game trace 0
  game trigger -lap++ -command {
    set lap [game query -entry 0 lap]
    set laptime_prev $laptime
    set laptime [game query -entry 0 event_time]
    if {$lap == 1} {
      set laptime_best $laptime
    } else {
      if {$laptime_best > $laptime - $laptime_prev} {
	set laptime_best [expr $laptime - $laptime_prev]
      }
    }
    if {$lap == $options(lap)} {
      finish_race
    }
  }

  game overhead -xpan $xpan -xmax 400 -zmax 100
  glutwidget append game

  glutwidget append [show_fps]

  glut -mousefunc {
    if {$BUTTON == 0} {
      set xpan [expr $xpan - 0.1]
    } else {
      set xpan [expr $xpan + 0.1]
    }
    game overhead -xpan $xpan
  }

  glut -ignorekeyrepeat 1

  glut -specialupfunc {
    switch $KEY {
      100 { set key_left 0; set_steering game } 	# left
      102 { set key_right 0; set_steering game }	# right
      #101 { game control -steering 1 }			# up
      #103 { game control -accel 0 }			# down
    }
  }

  glut -specialfunc {
    switch $KEY {
      100 { set key_left -1; set_steering game } 	# left
      102 { set key_right 1; set_steering game }	# right
    }
  }

  glut -keyboardupfunc {
    switch $KEY {
      32 { game control -accel 0 }			# space
      122 { game control -footbreak 0 }			# z
      97 { game control -sidebreak 0 }			# a
    }
  }

  glut -keyboardfunc {
    switch $KEY {
      49 { overhead_view game 0 }			# 1
      50 { overhead_view game 5 }			# 2
      51 { overhead_view game 10 }			# 3
      99 { game control -down }				# c
      118 { game control -up }				# b
      122 { game control -footbreak 1 }			# z
      97 { game control -sidebreak 1 }			# a
      32 { game control -accel 1 }			# space
      27 {						# escape
	finish_race
      }
    }
  }

  catch {
    joystick command {
      switch $TYPE {
	1 {
	  if {$VALUE == 1} {
	    switch $NUMBER {
	      3 { game control -up }
	      7 { game control -down }
	    }
	  }
	}
	2 {
	  switch $NUMBER {
	    0 { game control -steering [expr $VALUE * 0.4] }
	    1 { game control -accel $VALUE }
	    2 { game control -footbreak $VALUE }
	  }
	}
      }
    }
  }

  game start
}

proc finish_race {} {
  glut -mousefunc {}
  glut -keyboardfunc {}
  glut -keyboardupfunc {}
  glut -specialfunc {}
  glut -specialupfunc {}
  glut -timerfunc 0 4 {}
  glut -timerfunc 0 5 {}
  glut -ignorekeyrepeat 0
  catch {joystick command {}}
  fade_out 1 1 1 1 2000 show_results
}

proc toggle_action {name} {
  set val [string match OFF [$name configure -text]]
  if {$val} {
    $name configure -text "ON"
  } else {
    $name configure -text "OFF"
  }
}

proc toggle_button {name val args} {
  if {$val} {
    set text "ON"
  } else {
    set text "OFF"
  }

  eval glutbutton $name -text $text $args \
  		-command [list "toggle_action $name"]
}

proc check_options {} {
# hostname
  if {![string length [entry0 get]]} {
    glutwidget focus entry0
    return 0
  }
# port
  if {![string length [entry1 get]]} {
    glutwidget focus entry1
    return 0
  }
# resx
  if [catch {set val [expr int([entry2a get])]}] {
    glutwidget focus entry2a
    return 0
  }
# resy
  if [catch {set val [expr int([entry2b get])]}] {
    glutwidget focus entry2b
    return 0
  }

  return 1
}

proc update_options {} {
  global options
  set options(hostname)		[entry0 get]
  set options(port)		[entry1 get]
  set options(resx)		[entry2a get]
  set options(resy)		[entry2b get]
  set options(use_texture)	[string match ON [button3a configure -text]]
  set options(use_mipmap)	[string match ON [button3b configure -text]]
  set options(use_linear)	[string match ON [button3c configure -text]]
  set options(use_shading)	[string match ON [button3d configure -text]]
  set options(show_sky)		[string match ON [button3e configure -text]]
  set options(show_decr)	[string match ON [button3f configure -text]]
  set options(grab_keyboard)	[string match ON [button4 configure -text]]
  set options(audio)		[string match ON [button5 configure -text]]
}

proc option_page {next} {
  global options

  gl -clearcolor 0 0 0 1
  fade_in 1 1 1 0 1000

  glutwidget forget

  glutlabel title \
		-text "Options" \
		-pos 0 -5 n \
		-fgcolor normal 1 0 0
  glutwidget append title

  glutlabel label0 \
		-font bitmap_helvetica_12 \
		-text "Server:" \
		-pos 5 -30 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label0

  glutentry entry0 \
		-font bitmap_helvetica_12 \
  		-text $options(hostname) \
		-pos 60 -30 wen \
		-size [expr [glutwidget width] - 80] 0
  glutwidget append entry0

  glutlabel label1 \
		-font bitmap_helvetica_12 \
  		-text "Port:" \
		-pos 5 -50 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label1

  glutentry entry1 \
		-font bitmap_helvetica_12 \
  		-text $options(port) \
		-pos 60 -50 wn \
		-size 100 0
  glutwidget append entry1

  glutlabel label2 \
		-font bitmap_helvetica_12 \
  		-text "Resolution:" \
		-pos 5 -70 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label2

  glutlabel label2a \
		-font bitmap_helvetica_12 \
  		-text "Width:" \
		-pos 15 -90 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label2a

  glutlabel label2b \
		-font bitmap_helvetica_12 \
  		-text "Height:" \
		-pos 15 -110 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label2b

  glutentry entry2a \
		-font bitmap_helvetica_12 \
  		-text "$options(resx)" \
		-pos 60 -90 ewn \
		-size [expr [glutwidget width] - 230] 0
  glutwidget append entry2a

  glutentry entry2b \
		-font bitmap_helvetica_12 \
  		-text "$options(resy)" \
		-pos 60 -110 ewn \
		-size [expr [glutwidget width] - 230] 0
  glutwidget append entry2b

  glutbutton button2a \
		-font bitmap_helvetica_12 \
  		-text "210 x 160" \
		-pos -90 -88 en \
		-size 70 0 \
		-fgcolor normal 1 0 0 \
		-command {
		  entry2a configure -text 210
		  entry2b configure -text 160
		}
  glutwidget append button2a

  glutbutton button2b \
		-font bitmap_helvetica_12 \
  		-text "320 x 240" \
		-pos -10 -88 en \
		-size 70 0 \
		-fgcolor normal 1 0 0 \
		-command {
		  entry2a configure -text 320
		  entry2b configure -text 240
		}
  glutwidget append button2b

  glutbutton button2c \
		-font bitmap_helvetica_12 \
  		-text "640 x 480" \
		-pos -90 -108 en \
		-size 70 0 \
		-fgcolor normal 1 0 0 \
		-command {
		  entry2a configure -text 640
		  entry2b configure -text 480
		}
  glutwidget append button2c

  glutbutton button2d \
		-font bitmap_helvetica_12 \
  		-text "win size" \
		-pos -10 -108 en \
		-size 70 0 \
		-fgcolor normal 1 0 0 \
		-command {
		  entry2a configure -text [glutwidget width]
		  entry2b configure -text [glutwidget height]
		}
  glutwidget append button2d


  glutlabel label3 \
		-font bitmap_helvetica_12 \
  		-text "Quality:" \
		-pos 5 -130 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label3

  glutlabel label3a \
		-font bitmap_helvetica_12 \
  		-text "Texture:" \
		-pos 15 -150 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label3a

  toggle_button button3a $options(use_texture) \
  		-font bitmap_helvetica_12 \
		-pos 80 -148 wn \
		-size 35 0 \
		-fgcolor normal 1 0 0
  glutwidget append button3a

  glutlabel label3b \
		-font bitmap_helvetica_12 \
  		-text "Mipmap:" \
		-pos 15 -170 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label3b

  toggle_button button3b $options(use_mipmap) \
  		-font bitmap_helvetica_12 \
		-pos 80 -168 wn \
		-size 35 0 \
		-fgcolor normal 1 0 0
  glutwidget append button3b

  glutlabel label3c -font bitmap_helvetica_12 \
  		-text "Linear:" \
		-pos 15 -190 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label3c

  toggle_button button3c $options(use_linear) \
  		-font bitmap_helvetica_12 \
		-pos 80 -188 wn \
		-size 35 0 \
		-fgcolor normal 1 0 0
  glutwidget append button3c

  glutlabel label3d \
		-font bitmap_helvetica_12 \
  		-text "Shading:" \
		-pos 140 -150 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label3d

  toggle_button button3d $options(use_shading) \
  		-font bitmap_helvetica_12 \
		-pos 210 -148 wn \
		-size 35 0 \
		-fgcolor normal 1 0 0
  glutwidget append button3d

  glutlabel label3e \
		-font bitmap_helvetica_12 \
  		-text "Show Sky:" \
		-pos 140 -170 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label3e

  toggle_button button3e $options(show_sky) \
  		-font bitmap_helvetica_12 \
		-pos 210 -168 wn \
		-size 35 0 \
		-fgcolor normal 1 0 0
  glutwidget append button3e

  glutlabel label3f \
		-font bitmap_helvetica_12 \
  		-text "Decoration:" \
		-pos 140 -190 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label3f

  toggle_button button3f $options(show_decr) \
  		-font bitmap_helvetica_12 \
		-pos 210 -188 wn \
		-size 35 0 \
		-fgcolor normal 1 0 0
  glutwidget append button3f


  glutlabel label4 -font bitmap_helvetica_12 \
  		-text "Grab keyboard:" \
		-pos 5 -210 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label4

  toggle_button button4 $options(grab_keyboard) \
  		-font bitmap_helvetica_12 \
		-pos 100 -208 wn \
		-size 35 0 \
		-fgcolor normal 1 0 0
  glutwidget append button4

  glutlabel label5 -font bitmap_helvetica_12 \
  		-text "Audio:" \
		-pos 150 -210 wn \
		-fgcolor normal 1 0.5 0
  glutwidget append label5

  toggle_button button5 $options(audio) \
  		-font bitmap_helvetica_12 \
		-pos 210 -208 wn \
		-size 35 0 \
		-fgcolor normal 1 0 0
  glutwidget append button5

  glutbutton binding \
		-text "Binding" \
		-pos 90 40 s \
		-size 70 0
  glutwidget append binding

  set widgets {{ label0 entry0 label1 entry1 label2 label2a label2b entry2a 
  		entry2b button2a button2b button2c button2d label3
		label3a button3a label3b button3b label3c button3c
		label3d button3d label3e button3e label3f button3f
		label4 button4 label5 button5 binding ok save cancel }}

  glutbutton ok \
		-text "OK" \
		-pos -90 10 s \
		-size 70 0 \
		-command "
		  if [check_options] \{
		    update_options;
		    saw_away 40 $widgets $next
		  \}"

  glutwidget append ok

  glutbutton save \
		-text "Save" \
		-pos 0 10 s \
		-size 70 0 \
		-command "
		  if [check_options] \{
		    update_options;
		    save_setting;
		  \}"
  glutwidget append save

  glutbutton cancel \
		-text "Cancel" \
		-pos 90 10 s \
		-size 70 0 \
		-command "saw_away 40 $widgets $next"
  glutwidget append cancel

  glut -keyboardfunc {
    if {$KEY == 27} {
      cancel invoke
      glut -keyboardfunc {}
    }
  }
}

proc saw_away {inc widgets args} {
  set width [glutwidget width]
  set height [glutwidget height]

  foreach w $widgets {
    if [string length $w] {
      set bbox [glutwidget bbox [lindex $widgets 0]]
      set max [expr [lindex $bbox 2] + $width / 2]
      break
    }
  }

  set side 1
  foreach w $widgets {
    if [string length $w] {
      set bbox [glutwidget bbox $w]
      if {$side % 2} {
	set tmp [expr [lindex $bbox 2] + $width / 2]
      } else {
	set tmp [expr -[lindex $bbox 0] + $width / 2]
      }
      if {$max < $tmp} {set max $tmp}
    }
    incr side
  }

  set command [list saw_away_loop 0 $max $inc $widgets]
  if [llength $args] {
    set command [concat $command $args]
  }
  eval $command
}

proc saw_away_loop {count max inc widgets args} {
  set side 1
  foreach w $widgets {
    if [string length $w] {
      if {$side % 2} {
	glutwidget move $w [expr - $inc] 0
      } else {
	glutwidget move $w $inc 0
      }
    }
    incr side
  }
  glut -postredisplay

  incr count $inc
  if {$count <= $max} {
    set command [list saw_away_loop $count $max $inc $widgets]
    if [llength $args] {
      set command [concat $command $args]
    }
    glut -timerfunc 50 4 $command
  } elseif [llength $args] {
    eval $args
  }
}

proc roll_away {inc widgets args} {
  set height [glutwidget height]

  set bbox [glutwidget bbox [lindex $widgets 0]]
  set min [lindex $bbox 0]

  foreach w $widgets {
    set tmp [lindex [glutwidget bbox $w] 0]
    if {$min > $tmp} {set min $tmp}
  }

  set command [list roll_away_loop 0 [expr $height - $min] $inc $widgets]
  if [llength $args] {
    set command [concat $command $args]
  }
  eval $command
}

proc roll_away_loop {count max inc widgets args} {
  foreach w $widgets {
    glutwidget move $w 0 $inc
  }
  glut -postredisplay

  incr count $inc
  if {$count <= $max} {
    set command [list roll_away_loop $count $max $inc $widgets]
    if [llength $args] {
      set command [concat $command $args]
    }
    glut -timerfunc 50 5 $command
  } elseif [llength $args] {
    eval $args
  }
}

proc fade_in {r g b scale msec args} {
  gl -enable lighting \
     -enable light0
  gl -light light0 diffuse \
  	[expr $r * $scale] [expr $g * $scale] [expr $b * $scale] 1

  if {$msec > 0} {
    set scale [expr 1.0 - (1.0 - double($scale)) * \
			  (($msec - 50.0) / double($msec))]
  }
  incr msec -50

  glut -postredisplay
  
  if {$msec >= 0} {
    set command [list fade_in $r $g $b $scale $msec]
    if [llength $args] {
      set command [concat $command $args]
    }
    glut -timerfunc 50 6 $command
  } elseif [llength $args] {
    eval $args
  }
}

proc fade_out {r g b scale msec args} {
  gl -enable lighting \
     -enable light0
  gl -light light0 diffuse \
  	[expr $r * $scale] [expr $g * $scale] [expr $b * $scale] 1

  if {$msec > 0} {
    set scale [expr double($scale) * (($msec - 50.0) / double($msec))]
  }
  incr msec -50

  glut -postredisplay
  
  if {$msec >= 0} {
    set command [list fade_out $r $g $b $scale $msec]
    if [llength $args] {
      set command [concat $command $args]
    }
    glut -timerfunc 50 6 $command
  } elseif [llength $args] {
    eval $args
  }
}

proc update_fps {value} {
  global frame fps

  set fps $frame
  set frame 0

  glut -postredisplay
  glut -timerfunc 1000 $value {update_fps $VALUE}
}
glut -timerfunc 1000 2 {update_fps $VALUE}

proc show_fps {} {
  global fps frame

  glutroot fps -display {
    global fps frame

    gl -matrixmode projection \
       -loadidentity \
       -ortho 0 [glutwidget width] 0 [glutwidget height] 0 10 \
       -matrixmode modelview \
       -loadidentity \
       -disable color_material \
       -rasterpos 2 2 \
       -color 1 1 1

    glut -bitmapcharacter bitmap_helvetica_10 "FPS: $fps"

    incr frame
  }
  return fps
}

proc default_reshape {width height} {
  global do_init
  global name
  global left right bottom top
  global options

  set left [expr - $width / 2 + 1]
  set right [expr $width / 2]
  set bottom [expr - $height / 2 + 1]
  set top [expr $height / 2]

  gl -viewport 0 0 $width $height
}

proc show_vehicle_timer {value} {
  global zangle
  incr zangle
  glut -postredisplay \
       -timerfunc 10 $value {show_vehicle_timer $VALUE}
}

proc show_vehicle {} {
  glutroot background -display vehicle_display
  glut -timerfunc 10 1 {show_vehicle_timer $VALUE}
  return background
}

proc vehicle_display {} {
  global zangle
  global name
  global left right bottom top

  set width [glutwidget width]
  set height [glutwidget height]
  set half_height [expr double ($height) / $width / 2]

  gl -matrixmode projection \
     -loadidentity \
     -frustum -0.5 0.5 -$half_height $half_height 2 100 \
     -matrixmode modelview \
     -loadidentity \
     -translate 0 -1 -15 \
     -rotate -80 1 0 0 \
     -rotate $zangle 0 0 1

  if {$name} {
    gl -pushattrib current_bit \
       -calllist $name \
       -popattrib
  }

  gl -matrixmode projection \
     -loadidentity \
     -ortho $left $right $bottom $top -10 10 \
     -matrixmode modelview \
     -loadidentity
}

gl_init
glut -reshapefunc {
  gl -enable color_material cull_face depth_test \
     -disable color_material lighting light0
     #-light light0 spot_direction 0 0 1 \
     #-light light0 ambient 0.5 0.5 0.5 1 \
     #-light light0 position 20 20 200 1

  default_reshape $WIDTH $HEIGHT
  about_page
}
catch {joystick open /dev/js0}
