#!/usr/bin/wish package require tcl3d 0.2 # Fenstergröße set winWidth 640 set winHeight 480 set Posx 0 set Posy 0 set Posz -300 set Rotx -45 set Roty -300 set Rotz 0 set PI [ expr 2* asin(1)] # Berechnet eine RGB-Farbe, aus http://wiki.tcl.tk/666 proc hls2rgb {h l s} { set h6 [expr {($h-floor($h))*6}] set r [expr {$h6<=3 ? 2-$h6 : $h6-4}] set g [expr {$h6<=2 ? $h6 : $h6<=5 ? 4-$h6 : $h6-6}] set b [expr {$h6<=1 ? -$h6 : $h6<=4 ? $h6-2 : 6-$h6}] set r [expr {$r<0.0 ? 0.0 : $r>1.0 ? 1.0 : double($r)}] set g [expr {$g<0.0 ? 0.0 : $g>1.0 ? 1.0 : double($g)}] set b [expr {$b<0.0 ? 0.0 : $b>1.0 ? 1.0 : double($b)}] set r [expr {(($r-1)*$s+1)*$l}] set g [expr {(($g-1)*$s+1)*$l}] set b [expr {(($b-1)*$s+1)*$l}] return [list $r $g $b] } # Kugelmodell erzeugen proc kugel {radius} { set kante 10 set ::displayliste [glGenLists 1] glNewList $::displayliste GL_COMPILE for {set l 0} {$l <= 360} {incr l 5} { for {set b -90 } {$b <= 90} {incr b 5} { # Position im Bogenmaß set lr [expr {$l/180.0 * $::PI}] set br [expr {$b/180.0 * $::PI}] # Farbe für das nächste Element setzen set hue [expr {sin($br/3.0)}] eval glColor3f [hls2rgb $hue 1 1] # Dreieck einfügen glBegin GL_TRIANGLES glVertex3f [expr {$radius * cos($lr) * cos($br)}] \ [expr {$radius * sin($lr) * cos($br)}] \ [expr {$radius * sin($br)}] glVertex3f [expr {$radius * cos($lr) * cos($br)}] \ [expr {$radius * sin($lr) * cos($br) +$kante}] \ [expr {$radius * sin($br)}] glVertex3f [expr {$radius * cos($lr) * cos($br)}] \ [expr {$radius * sin($lr) * cos($br)}] \ [expr {$radius * sin($br) +$kante}] glEnd } } glEndList } # Setzt ein paar Startwerte und erzeugt die Displayliste. # Wird beim Erzeugen des Fensters augerufen proc tclCreateFunc {toglwin} { # Schwarzer Hintergrund glClearColor 0.0 0.0 0.0 0.0 # Ein bischen Tuning glClearDepth 1.0 glEnable GL_DEPTH_TEST glShadeModel GL_FLAT glDepthFunc GL_LEQUAL glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST # Displayliste einmalig erzeugen kugel 100 } # Diese Funktion zeigt das 3D-Modell an proc tclDisplayFunc {toglwin} { # Screen And Depth Buffer löschen glClear [expr {$::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT}] # Anfangsposition setzen glLoadIdentity glTranslatef $::Posx $::Posy $::Posz glRotatef $::Rotx 1.0 0.0 0.0 glRotatef $::Roty 0.0 1.0 0.0 glRotatef $::Rotz 0.0 0.0 1.0 # Displayliste abrufen glCallList $::displayliste $toglwin swapbuffers } # Berechnet eine passende Ansicht auf das Modell. # Wird aufgerufen wenn sich die Fenstergröße ändert proc tclReshapeFunc {toglwin b h} { # Verhindert Teilen durch Null set h [expr {$h<1 ? 1 : $h}] # Viewport neu berechnen glViewport 0 0 $b $h glMatrixMode GL_PROJECTION # wieder Einheitsmatrix setzen glLoadIdentity # Perspektive berechnen lassen und aktive machen set winkel 45 set verhaeltnis [expr {double($b)/double($h)}] set von 0.1 set bis 5000 gluPerspective $winkel $verhaeltnis $von $bis glMatrixMode GL_MODELVIEW } # Speichert die Mausposition beim Drücken der linken Maustaste proc RotStart {x y W} { global startx starty set startx $x set starty $y } # Berechnet die neue Rotation nach dem Loslassen der linken Maustaste proc RotMove {x y W} { global startx starty set ::Rotx [expr {$::Rotx + 0.1 * ($x - $startx)}] set ::Roty [expr {$::Roty + 0.1 * ($y - $starty)}] $W postredisplay } # Bewegt das Modell beim Drehen des Mausrads proc MovePos {dist W} { # Berechne neue Position set ::Posx 0 set ::Posy 0 set ::Posz [expr {int($::Posz +$dist)}] $W postredisplay } # Bewegt das Modell mit den Pfeiltasten proc LinksRechtsObenUnten {key W} { if {[string match Left $key]} { incr ::Posx -10 } elseif {[string match Right $key]} { incr ::Posx 10 } elseif {[string match Up $key]} { incr ::Posy 10 } elseif {[string match Down $key]} { incr ::Posy -10 } .toglwin postredisplay } # Create Our OpenGL Window togl .toglwin -width $::winWidth -height $::winHeight \ -double true -depth true \ -reshapeproc tclReshapeFunc \ -displayproc tclDisplayFunc \ -createproc tclCreateFunc pack .toglwin -expand 1 -fill both # An Events binden bind . {LinksRechtsObenUnten %K %W} bind .toglwin {MovePos 20 %W} bind .toglwin {MovePos -20 %W} bind .toglwin {RotStart %x %y %W} bind .toglwin {RotMove %x %y %W}