The [Fractal Mountains] are so nice that I wanted to look at them from all directions. So I put together some code to display the mountain using TkOGL (over on the OpenGL page). Unfortunately I don't know much about OpenGL so the lighting doesn't work right, and it could probably be optimized better for OpenGL. But its nifty nontheless. Right click to toggle fill. Left click and drag to rotate Space bar to toggle (broken) lighting ---- [kpv] - damn, I'm dying to see it but TkOGL for windows seems to need tcl80. Has anyone gotten it to work in 8.4 on windows? ---- [wfs] - Gosh I love linux/tcl it's amazing...I have two machines 400mhz and 1.2gig. Haven't bothered to compile tkogl on the new 1.2gig machine yet. Really wanted to try the demo below...copied it to the 400mhz...exported my display...ran glwish and sourced the file below...hardware accelerated graphics since my 1.2gig has it...amazing that a simple prog running on my 400mhz machine can use the hardware accelleration on my 1.2gig machine...OpenGL rocks...what is windows...what is DirectX...how come we even use Microsoft products...buy a game that doesnt use OpenGL and you add one more bullet to the war machine that is killing some cool technolog...lets see DirectX run an app on one machine while displaying it on another and using the 2nd machines graphics hardware... nugh venting... --- ##+########################################################################## # # Fractal Mountain # # Builds and displays a fractal mountain. Based on code at # http://www.mactech.com/articles/mactech/Vol.07/07.05/FractalMountains/ # by Keith Vetter # # Revisions: # KPV Nov 07, 2002 - initial revision # KPV Nov 12, 2002 - added variable water level; better redraw for new depths # ##+########################################################################## ############################################################################# package require Tk proc K {x y} {return [set x]} if {[catch {package require Tcl 8.4}]} { package require Tcl 8.3 proc lset {_lvar idx value} { ;# Need lset from 8.4 upvar 1 $_lvar lvar set lvar [lreplace [K $lvar [unset lvar]] $idx $idx $value] } } interp alias {} = {} expr set S(version) 1.2 set S(date) "Nov 12, 2002" # S(v,*) = GUI S(w,*) = what user wants to see M(d,*) = what's in $map set S(params) [list depth contour roughness nHeight profile xTilt flood] set S(v,depth) 3 ;# Number of iterations set S(v,contour) 1.00 ;# The contour of the mountain set S(v,roughness) 2.75 ;# How jagged the mountain set S(v,nHeight) 7 ;# Max height of mountain set S(v,profile) 1 ;# Profile number (1-4) set S(v,xTilt) 80 ;# Tilt angle (in degrees) set S(v,flood) 50 set M(d,depth) -1 ;# No map yet set S(maxIter) 9 ;# Bounds our height set S(normalHeightBase) 10000 ;# Normalized height set S(normalHeightBase) 10000 ;# Normalized height set S(water) 0 ;# Water level altitude set S(nocolor) 0 set S(seed) 0 # Unit vector to our light source set S(lx) [= {-1 / sqrt(3)}]; set S(ly) [= {-$S(lx)}]; set S(lz) [= {-$S(lx)}] set MIN_INT 0x80000000 set DEG2RAD [= {4*atan(1)*2/360}] proc LMAP {a b v} { lset ::map [= {$a + $b*$::M(S)}] $v; return} proc LMAP {a b v} { lset ::map [= {$a + $b*$::M(S)}] $v} proc LMAP1 {a v} { lset ::map $a $v; return} proc RMAP {a b} { return [lindex $::map [= {$a + $b*$::M(S)}]]} proc RMAP1 {a} { return [lindex $::map $a]} ##+########################################################################## # # Go - Computes the new mountain and draws it. # proc Go {{how 1}} { global S M set start [clock click -milliseconds] clear if {$how == 1} { set M(d,depth) -1 ;# Force recalculation set S(seed) [clock clicks -milliseconds] } set S(draw) 1 ToggleButtons 1 CalcMountains DrawMountains set xysc [= {50.0 / (1 << $M(d,depth))}] # set zsc [= {.005 / (1 << $M(d,depth))}] set zsc .0005 .gl eval -matrixmode modelview -loadidentity -scale $xysc $xysc $zsc set start [= {([clock click -milliseconds] - $start) / 1000}] Stop set msg "Iterations: $S(w,depth) Contour: $M(d,contour) " append msg "Smoothness: $M(d,roughness) Height: $M(d,nHeight) " append msg "Profile: $M(d,profile) Tilt: $S(w,xTilt) ([Duration $start])" INFO $msg } proc Stop {} { global S set S(draw) 0 ToggleButtons 0 ProgressBar 1 0 } ##+########################################################################## # # CopyParameters # # Copies gui/want/data parameter values to g/w/d as requested # proc CopyParameters {from to} { global S M foreach v [array names S $from,*] { foreach {a b} [split $v ,] break if {$to == "d"} { set M($to,$b) $S($v) } else { set S($to,$b) $S($v) } } } ##+########################################################################## # # CalcMountains # # Initializes our mountain grid for the profile and then does the # recursive iterations to build up our fractal. It then normalizes # all the data to be under a certain height. # proc CalcMountains {} { global M S CopyParameters v w ;# Params the user wants to use set n [CompareParameters] ;# Is data still valid??? if {$n == 2} { INFO "Reusing existing mountain data" return } # Generate each main triangle recursively InitMountains $n INFO "Calculating the [comma [= {1 + $M(N)}]] points in the display" IterCalc 0 $M(D) $M(N) [= {$S(maxIter)+1}] IterCalc [= {$M(S) * $M(D)}] $M(N) 0 [= {$S(maxIter)+1}] NormalizeMap CopyParameters w d ;# Parameters for our data return } ##+########################################################################## # # CompareParameters: returns TRUE if data is still ok for S(w,*) params # 0 - total mismatch # 1 - new depth is greater # 2 - compatible # proc CompareParameters {} { global M S if {$M(d,depth) == -1} {return 0} ;# No map data foreach v [array names S w,*] { if {$v == "w,depth"} continue if {$v == "w,xTilt"} continue ;# Only visual affects if {$v == "w,flood"} continue ;# Only visual affects foreach {a b} [split $v ,] break if {$M(d,$b) != $S(w,$b)} { return 0} } if {$S(w,depth) <= $M(d,depth)} { return 2} ;# Less deep, okay return 1 } ##+########################################################################## # # InitMountains # # Creates the initial grid for our mountain. # proc InitMountains {up} { global map M S MIN_INT if {$up} { set map2 $map ; set D $M(d,depth) ; set MD $M(D) ; set MS $M(S) } = {srand($S(seed))} set M(D) [= {1 << $S(w,depth)}] set M(S) [= {$M(D) + 1}] ;# Points along side of triangle set M(N) [= {$M(S) * $M(S) - 1}] ;# Last point in our grid set S(normalHeight) [= {$S(normalHeightBase) * $S(w,nHeight)}] set map [string repeat " $MIN_INT" [= {1+$M(N)}]] ;# Our mountain if {$up} { GoDeeper $map2 $D $MD $MS return } # Generate starting profile to build on set q [MaxDeviation [= {$S(maxIter)+1}]] set q [= {$q / 2}] set nq [= {-$q}] set d2 [= {$M(D) / 2}] if {$S(w,profile) == 1} { ;# Back up, front down, corner 0 LMAP 0 0 $q LMAP $M(D) 0 0 LMAP 0 $M(D) 0 LMAP $M(D) $M(D) $nq } elseif {$S(w,profile) == 2} { ;# Back up; side/corners 0 LMAP 0 0 $q LMAP $M(D) 0 0 LMAP 0 $M(D) 0 LMAP $M(D) $M(D) 0 if {$d2 > 0} { LMAP $d2 $d2 0 LMAP $d2 $M(D) 0 LMAP $M(D) $d2 0 } } elseif {$S(w,profile) == 3} { ;# front down, corners 0 LMAP 0 0 0 LMAP $M(D) 0 0 LMAP 0 $M(D) 0 LMAP $M(D) $M(D) $nq } elseif {$S(w,profile) == 4} { LMAP 0 0 0 LMAP $M(D) 0 0 LMAP 0 $M(D) 0 LMAP $M(D) $M(D) 0 if {$d2 > 0} { LMAP $d2 $d2 [= {$q/2}] LMAP $d2 0 $q LMAP 0 $d2 $q } } elseif {$S(w,profile) == 5} { LMAP 0 0 $q LMAP $M(D) 0 0 LMAP $d2 0 [= {$q / 2}] LMAP 0 $M(D) 0 LMAP $M(D) $M(D) $nq } else { error "profile out of range (1-4): $S(w,profile)" } } ##+########################################################################## # # GoDeeper - Transfers all elevation info from old map at level D # into the current map. IterCalc still needs to be called to fill # in the rest of the slots. # proc GoDeeper {map2 D MD MS} { global map S M set step [= {1 << ($S(w,depth) - $D)}] set idx -1 for {set y 0} {$y < $M(S)} {incr y $step} { for {set x 0} {$x < $M(S)} {incr x $step} { LMAP $x $y [lindex $map2 [incr idx]] } } } ##+########################################################################## # # MaxDeviation # # Returns the maximum deviation allowed for a given recursion depth. # The function is strictly decreasing monotonic as depth increases. # proc MaxDeviation {ic} { global S if {$S(w,roughness) == 0} { return 100000 } return [= {int(8.0 * pow ($S(w,roughness), $ic-1))}] } ##+########################################################################## # # NormalizeMap # # Scales all heights to be w/i normalHeight and applies contour transformation. # proc NormalizeMap {} { global map S M MIN_INT set max [lindex $map 0] ;# Get max height foreach v $map { if {$v > $max} { set max $v} } if {$max <= 0} {set max 10000} ;# All water, avoid divide by 0 set z [= {pow($max, $S(w,contour))}] set z [= {$S(normalHeight) / $z}] set map2 {} set min [set max 0] foreach k $map { if {$k >= 0} { set i [= {pow($k, $S(w,contour)) * $z}] set val [= {int($i)}] if {$val > $max} {set max $val} } else { set i [= {pow(-$k, $S(w,contour)) * $z}] set val [= {int(-$i)}] if {$val < $min} {set min $val} } lappend map2 $val } set map $map2 set M(min) $min set M(max) $max return } ##+########################################################################## # # IterCalc # # Given three points of a triangle it calculates the midpoints of each # side and recurses. Parameter c is the depth. # proc IterCalc {s1 s2 a c} { global map MIN_INT incr c -1 ;# Decrement iteration count set ns1 [= {($s1 + $a) / 2}] ;# Midpoints of sub-triangle set ns2 [= {($s2 + $a) / 2}] set na [= {($s1 + $s2) / 2}] set vs1 [RMAP1 $s1] set vs2 [RMAP1 $s2] set va [RMAP1 $a] if {[RMAP1 $ns1] == $MIN_INT} { LMAP1 $ns1 [= {($vs1 + $va) / 2}] DeviatePoint $ns1 $c } if {[RMAP1 $ns2] == $MIN_INT} { LMAP1 $ns2 [= {($vs2 + $va) / 2}] DeviatePoint $ns2 $c } if {[RMAP1 $na] == $MIN_INT} { LMAP1 $na [= {($vs1 + $vs2) / 2}] DeviatePoint $na $c } # Recurse on sub-triangles if we haven't bottomed out if {$ns1 + 1 >= $ns2} return IterCalc $s1 $na $ns1 $c IterCalc $na $s2 $ns2 $c IterCalc $ns1 $ns2 $na $c IterCalc $ns1 $ns2 $a $c } ##+########################################################################## # # DeviatePoint # # Deviates a point up or down by a random amount between # -MaxDeviation to +MaxDeviation. # proc DeviatePoint {o ic} { global map S if {$S(w,roughness) < 0} return set v [MaxDeviation $ic] set r [Rand [= {-$v}] $v] LMAP1 $o [= {[RMAP1 $o] + $r}] } ##+########################################################################## # # Rand # # Returns a random number between first and last. # proc Rand {first last} { set delta [= {$last - $first + 1}] set r [= {$first + int(rand() * $delta)}] return $r } proc PrintData {} { global map M set cnt 0 foreach v $map { if {$v == 0x80000000} { puts -nonewline [format "%9s" --] } else { puts -nonewline [format "% 9ld" $v] } if {([incr cnt] % $M(S)) == 0} { puts ""} } } ################################################################ ################################################################ # # Drawing routines # ##+########################################################################## # # DrawMountains # # Sets up the transformation variables and then draws all the triangles. # proc DrawMountains {{lvl ""}} { global tm M S xc sc wx wy global l dlist set dlist {} if {$lvl == ""} { ;# Called from Go set lvl $S(w,depth) update if {$S(draw) == 0} return } if {$lvl > $M(d,depth)} { error "ERROR: Can't display level $lvl" } if {$lvl <= 0} { set lvl [= {$M(d,depth) + $lvl}] if {$lvl < 0} { set lvl 0 } } set D [= {1 << $lvl}] ;# Nodes per side set step [= {1 << ($M(d,depth) - $lvl)}] ;# Step size for this data set INFO "Drawing the [comma [= {2*$D*$D}]] triangles in the display" set S(draw) 1 set wx [winfo width .gl] set wy [winfo height .gl] set wd [expr {$wx > $wy ? $wy : $wx}] set xc [= {0.4073 * (1 << ($S(maxIter) - $S(w,depth)))}] set xc [= {0.4073 * (1 << ($S(maxIter) - $M(d,depth)))}] set sc [= {$wd / 630.0}] # Make transformation matrix for rotating around x axis set tm(0,0) 1 set tm(1,0) 0 set tm(2,0) 0 set tm(0,1) 0 set tm(1,1) [= {cos(-$S(w,xTilt) * $::DEG2RAD)}] set tm(2,1) [= {sin(-$S(w,xTilt) * $::DEG2RAD)}] set tm(0,2) 0 set tm(1,2) [= {-sin(-$S(w,xTilt) * $::DEG2RAD)}] set tm(2,2) [= {cos(-$S(w,xTilt) * $::DEG2RAD)}] # Figure out water level set S(water) [= {$M(min) + $S(w,flood) * ($M(max) - $M(min)) / 100.0}] # Go back to front, left to right, and draw each triangle # .c delete triag2 for {set y 0} {$y < $M(D)} {incr y $step} { set y1 [= {$y + $step}] for {set x 0} {$x < $M(D)} {incr x $step} { set x1 [= {$x + $step}] DrawTriangle $x $y $x $y1 $x1 $y1 DrawTriangle $x $y $x1 $y1 $x1 $y } ProgressBar $y $M(D) update if {! $S(draw)} break } ProgressBar 1 0 eval .gl newlist $l $dlist .gl redraw # set sr [.c bbox all] } ##+########################################################################## # # DrawTriangle # # Draw a given triangle. This routine is mainly concerned with the # possibility that a triangle could span the waterline. If this # occurs, this procedure breaks it up into three smaller triangles, # each of which is either above or below water. All actual drawing or # coloration is delegated to _DrawTriangle. # proc DrawTriangle {x0 y0 x1 y1 x2 y2} { global S set z0 [RMAP $x0 $y0] set z1 [RMAP $x1 $y1] set z2 [RMAP $x2 $y2] # Easy cases: all underwater or all above water if {$z0 <= $S(water) && $z1 <= $S(water) && $z2 <= $S(water)} { _DrawTriangle $x0 $y0 $S(water) $x1 $y1 $S(water) $x2 $y2 $S(water) } elseif {$z0 >= $S(water) && $z1 >= $S(water) && $z2 >= $S(water)} { _DrawTriangle $x0 $y0 $z0 $x1 $y1 $z1 $x2 $y2 $z2 } else { ;# Spans the water line set p0 [list $x0 $y0 $z0] set p1 [list $x1 $y1 $z1] set p2 [list $x2 $y2 $z2] set w(0) [= {$z0 < $S(water)}] set w(1) [= {$z1 < $S(water)}] set w(2) [= {$z2 < $S(water)}] if {$w(0) != $w(1) && $w(0) != $w(2)} { set ap $p0 set s0 $p1 set s1 $p2 } elseif {$w(1) != $w(0)} { set s1 $p0 set ap $p1 set s0 $p2 } else { set s0 $p0 set s1 $p1 set ap $p2 } foreach {apx apy apz} $ap break foreach {s(0,x) s(0,y) s(0,z)} $s0 break foreach {s(1,x) s(1,y) s(1,z)} $s1 break # At this point, ap is the "odd man out" - either it is above # water and the other two are below, or it is below and the # other two are above. Which corner s[0] is and which s[1] is # *is* important - if we get the wrong order, the normal # vector used to find the shading coefficient is the wrong # sign. This is true whenever we are manipulating corners - # the ordering is always important. # Find the "midpoints" between ap and s[0]&s[1] - this is # where we split our big triangle into smaller triangles. # Actually it is not a normal midpoint, but a weighted # midpoint, such that the z component is 0 - waterline. foreach n {0 1} { set f($n) [= {-1.0 * ($apz - $S(water)) / ($s($n,z) - $apz)}] set m($n,x) [= {$apx - ($apx - $s($n,x)) * $f($n)}] set m($n,y) [= {$apy - ($apy - $s($n,y)) * $f($n)}] set m($n,z) $S(water) } # Set whichever triangles are below water to 0 altitude if {$apz < $S(water)} {set apz $S(water)} else { set s(0,z) $S(water); set s(1,z) $S(water)} # Draw our three triangles _DrawTriangle $apx $apy $apz $m(0,x) $m(0,y) $m(0,z) \ $m(1,x) $m(1,y) $m(1,z) _DrawTriangle $m(0,x) $m(0,y) $m(0,z) $s(0,x) $s(0,y) $s(0,z) \ $s(1,x) $s(1,y) $s(1,z) _DrawTriangle $m(0,x) $m(0,y) $m(0,z) $s(1,x) $s(1,y) $s(1,z) \ $m(1,x) $m(1,y) $m(1,z) } } ##+########################################################################## # # _DrawTriangle # # This routine actually draws a triangle, given by a set of three # (x,y,z) triplets. It determines the color and shading according to # altitude and lighting, and draws the triangle. # proc _DrawTriangle {x1 y1 z1 x2 y2 z2 x3 y3 z3} { global S global dlist # Figure out what color we want: blue, green or gray if {$z1 == $S(water) && $z2 == $S(water) && $z3 == $S(water)} { set color ".6 .6 1" ;# water } else { set treeline [= {.4 * $S(normalHeight) + 10000}] set snowcap [= {$treeline + 19000}] set az [= {($z1 + $z2 + $z3) / 3.0}] ;# Average height if {$az > $snowcap} { set color 150 ;# Gray } elseif {$az < $treeline} { set color 0 ;# Green } else { set color [= {($az - $treeline) / (($snowcap - $treeline)/150)}] } # Blend to brown and white over treeline (work in hsv color model) set C [= {(150-$color) / 150.0}] set h [= {$C * (120 - 45) + 45}] ;# 120 -> 45 set s $C ;# 1 -> 0 set v [= {.94 - $C * (.94 - 2.0/3)}] ;# .94 -> .667 set color [hsv2rgb $h $s $v] } append dlist " -color $color \ -begin triangles \ -vertex $x1 $y1 $z1 \ -vertex $x2 $y2 $z2 \ -vertex $x3 $y3 $z3 \ -end " } ##+########################################################################## # # hsv2rgb # # Convert from HSV color model to RGB model. h is 0.0 to 360.0, s and v # are 0.0 to 1.0. # proc hsv2rgb {h s v} { set v [= {double($v)}] set r [set g [set b 0.0]] if {$h == 360 || $h == -1} { set h 0 } set h [= {$h/60}] set i [= {int(floor($h))}] set f [= {$h - $i}] set p1 [= {$v*(1-$s)}] set p2 [= {$v*(1-($s*$f))}] set p3 [= {$v*(1-($s*(1-$f)))}] switch -- $i { 0 { set r $v ; set g $p3 ; set b $p1 } 1 { set r $p2 ; set g $v ; set b $p1 } 2 { set r $p1 ; set g $v ; set b $p3 } 3 { set r $p1 ; set g $p2 ; set b $v } 4 { set r $p3 ; set g $p1 ; set b $v } 5 { set r $v ; set g $p1 ; set b $p2 } } return [list $r $g $b] } ################################################################ ################################################################ # # GUI stuff # proc DoDisplay {} { wm title . "Fractal Mountains" wm protocol . WM_DELETE_WINDOW exit DoMenus frame .bottom -bd 2 -relief ridge OGLwin .gl -width 600 -height 600 global l set l [.gl newlist] set ax [.gl newlist \ -begin lines \ -vertex 0 0 0 -vertex 500 0 0 \ -vertex 495 5 0 -vertex 505 -5 0 \ -vertex 495 -5 0 -vertex 505 5 0 \ -vertex 0 0 0 -vertex 0 500 0 \ -vertex -5 505 0 -vertex 5 500 0 \ -vertex 5 505 0 -vertex -5 495 0 \ -vertex 0 0 0 -vertex 0 0 500 \ -end ] set lt [.gl newlist \ -light light0 diffuse 0.9 0.9 0.7 \ -light light0 specular 1 1 1 \ -light light0 position 1000 1000 1000 \ -light light0 spotdirecion -1 -1 -1 \ ] .gl mainlist -clear colorbuffer depthbuffer -call $ax -call $l -call $lt .gl eval -matrixmode projection \ -loadidentity \ -ortho -50 50 -50 50 -80 50 \ -rotate 135 0 0 -1 \ -rotate 315 -1 1 0 \ -disable lighting \ -enable light0 \ -enable colormaterial -enable depthtest canvas .msg -bd 1 -relief sunken -height 20 -highlightthickness 0 .msg xview moveto 0 ; .msg yview moveto 0 .msg create text 5 2 -tag txt -anchor nw pack .bottom -side right -fill y pack .msg -side bottom -fill x pack .gl -side top -fill both -expand 1 proc rescale {args} { global px1 px2 py1 py2 pz1 pz2 .gl eval -matrixmode modelview \ -loadidentity \ -scale $pz2 $pz2 $pz2 \ -rotate 180 1 0 0 .gl redraw } # bindings for GL window set ::lenable 0 focus .gl bind .gl { if {$lenable} { .gl eval -disable lighting .gl redraw set lenable 0 } else { .gl eval -enable lighting .gl redraw set lenable 1 } } bind .gl { set x %x ; set y %y } set ::pmode fill bind .gl { set xrot [expr %x - $x] set yrot [expr %y - $y] set x %x set y %y .gl eval -matrixmode projection \ -rotate $xrot 0 0 1\ -rotate $yrot -1 1 0 .gl redraw } bind .gl { if {$pmode=="fill"} { set pmode line } else { set pmode fill } .gl eval -polygonmode frontandback $pmode .gl redraw } set ::moving 0 %0