/examples/perlin-noise/ui/source.scm
Scheme | 356 lines | 230 code | 72 blank | 54 comment | 0 complexity | b2b3cb3d2c09c7ef00919523648c080b MD5 | raw file
Possible License(s): BSD-3-Clause
1;; Perlin noise calculations GUI 2;; 3;; by David St-Hilaire 4;; comp-521: assignement 2, winter 2008 5;; 6;; 7;; This is a opengl/glut gui implementation and demonstration of the 8;; implemented perlin noise library. It has several features, notably, 9;; animation (double buffering) and 3 display modes (grayscale, cloud and 10;; terrain). 11 12;; Ported to Abstracting by Ed Cavazos 13 14;;;;;;;;;;;;;;;;;;;;;;; Global state variables ;;;;;;;;;;;;;;;;;;;;;;; 15 16(define image-height #f) 17(define image-width #f) 18 19(define octaves 1) 20(define x-offset 0) 21(define y-offset 0) 22 23 24(define image-modified #f) 25(define animation-activated #f) 26(define animation-velocity 1) 27(define status-message #f) 28 29(define interpolation-fun #f) 30(define display-mode #f) 31 32;;;;;;;;;;;;;;;;;;;;;;; State modification functions ;;;;;;;;;;;;;;;;;;;;;;; 33 34(define (move-image! delta-x delta-y) 35 (let ((new-x (+ x-offset delta-x)) 36 (new-y (+ y-offset delta-y))) 37 (if (and (>= new-x 0) (>= new-y 0)) 38 (begin 39 (set! x-offset new-x) 40 (set! y-offset new-y) 41 (set! image-modified #t))))) 42 43(define (set-octave! number) 44 (set! octaves number) 45 (set! status-message (string-append "Now using " 46 (number->string number) 47 " octaves.")) 48 (set! image-modified #t)) 49 50(define (switch-octave!) 51 (set-octave! (modulo (+ octaves 1) 10))) 52 53(define (set-display-mode! mode-fun) 54 (set! display-mode mode-fun) 55 (set! image-modified #t)) 56 57(define (switch-animation-mode!) 58 (set! animation-activated (not animation-activated)) 59 (set! status-message (if animation-activated 60 "Animation turned on." 61 "Animation turned off."))) 62 63 64(define switch-interpolation-fun! 65 (let* ((index 2) 66 (functions (vector (cons "s-curve" s-curve-interpolation) 67 (cons "linear" linear-interpolation) 68 (cons "cosine" cos-interpolation))) 69 (length (vector-length functions))) 70 (lambda () 71 (set! index (modulo (+ index 1) length)) 72 (set! interpolation-fun (cdr (vector-ref functions index))) 73 (set! status-message (string-append "Now using " 74 (car (vector-ref functions index)) 75 " interpolation.")) 76 (set! image-modified #t)))) 77 78 79;;;;;;;;;;;;;;;;;;;;;;; Menu functionnalities ;;;;;;;;;;;;;;;;;;;;;;; 80 81(define gray-scale-mode 3) 82(define cloud-mode 0) 83(define terrain-mode 1) 84(define animation-mode 2) 85(define interpolation-mode 4) 86(define octaves-mode 5) 87 88(define (menu value) 89 (cond 90 ((eqv? value gray-scale-mode) (set-display-mode! grayscalify)) 91 ((eqv? value cloud-mode) (set-display-mode! cloudify)) 92 ((eqv? value terrain-mode) (set-display-mode! terrainify)) 93 ((eqv? value interpolation-mode)(switch-interpolation-fun!)) 94 ((eqv? value animation-mode) (switch-animation-mode!)) 95 ((eqv? value octaves-mode) (switch-octave!)))) 96 97(define (create-menu) 98 (glutCreateMenu menu) 99 (glutAddMenuEntry "Gray Scale Mode" gray-scale-mode) 100 (glutAddMenuEntry "Cloud Mode" cloud-mode) 101 (glutAddMenuEntry "Terrain Mode" terrain-mode) 102 (glutAddMenuEntry "Toggle Animation" animation-mode) 103 (glutAddMenuEntry "Toggle Interpolation" interpolation-mode) 104 (glutAddMenuEntry "Toggle Octaves Number" octaves-mode) 105 (glutAttachMenu GLUT_RIGHT_BUTTON)) 106 107;;;;;;;;;;;;;;;;;;;;;;; Display Modes ;;;;;;;;;;;;;;;;;;;;;;; 108 109(define (grayscalify noise) 110 (glColor3f noise noise noise)) 111 112(define (cloudify noise) 113 (let ((noise (+ .3 (* .7 noise)))) 114 (glColor3f noise noise 1.))) 115 116(define (terrainify noise) 117 (define water-threshold 0.5) 118 (define beach-threshold 0.54) 119 (define plain-threshold 0.70) 120 (define forest-threshold 0.77) 121 (define mountain-threshold 0.92) 122 (cond 123 ;; Water 124 ((< noise water-threshold) 125 (let ((noise (+ noise 0.4))) 126 (glColor3f .2 .2 noise))) 127 ;; Beaches 128 ((< noise beach-threshold) 129 (glColor3f 1. 1. noise)) 130 ;; Plains / Green Terrain 131 ((< noise plain-threshold) 132 (let ((noise (- 1 (/ (- noise beach-threshold) 133 (- forest-threshold beach-threshold))))) 134 (glColor3f .3 noise .3))) 135 ;; Forests 136 ((< noise forest-threshold) 137 (let ((noise (- 1 noise))) 138 (glColor3f .2 noise .2))) 139 ;; Light Mountains 140 ((< noise mountain-threshold) 141 (let ((noise (/ (- noise 0.4) 0.7))) 142 (glColor3f noise (/ noise 3.) (/ noise 4.)))) 143 ;; Snow 144 (else 145 (let ((noise (/ (- noise 0.1) 0.9))) 146 (glColor3f noise noise noise))))) 147 148;;;;;;;;;;;;;;;;;;;;;;; Render-Sceneing function ;;;;;;;;;;;;;;;;;;;;;;; 149 150;; (define (display-message x y msg) 151;; (let ((chars (map char->integer (string->list msg))) 152;; (font GLUT_BITMAP_HELVETICA_12)) 153;; (glColor3f 1. 1. 1.) 154;; (glRasterPos2i x y) 155;; (for-each (lambda (char) (glutBitmapCharacter font char)) 156;; chars))) 157 158(define (display-message x y msg) 159 (print msg "\n")) 160 161(define (render-scene) 162 163 (glClearColor 0. 0. 0. 0.) 164 (glClear GL_COLOR_BUFFER_BIT) 165 166 (glColor3f 0.0 1.0 0.0) 167 168 (print "Rendering...") 169 170 (for i 0 (< i image-height) 171 (for j 0 (< j image-width) 172 (begin 173 (let ((noise (cached-perlin-noise (+ j x-offset) 174 (+ i y-offset) 175 octaves 176 image-height image-width 177 interpolation-fun))) 178 (display-mode noise) 179 (glBegin GL_POINTS) 180 (glVertex2i j i) 181 (glEnd))) 182 (lambda () 'ok)) 183 (lambda () 'ok)) 184 185 (print "done\n") 186 187 (if status-message 188 (display-message 0 0 status-message)) 189 190 (glutSwapBuffers)) 191 192;;;;;;;;;;;;;;;;;;;;;;; Viewport and projection ;;;;;;;;;;;;;;;;;;;;;;; 193 194(define (reshape w h) 195 (let ((zoom-x (/ w image-width)) 196 (zoom-y (/ h image-height))) 197 (glPointSize (exact->inexact (+ (max zoom-x zoom-y) 1))) 198 (glViewport 0 0 w h) 199 (glMatrixMode GL_PROJECTION) 200 (glLoadIdentity) 201 (glOrtho 0. ;;left clip 202 (exact->inexact (/ w zoom-x)) ;;right clip 203 0. ;;bottom clip 204 (exact->inexact (/ h zoom-y)) ;;top 205 -10.0 10.0) 206 (glMatrixMode GL_MODELVIEW) 207 (glLoadIdentity))) 208 209 210;;;;;;;;;;;;;;;;;;;;;;; User I/O ;;;;;;;;;;;;;;;;;;;;;;; 211 212(define (keyboard key x y) 213 214 (let ((key (if (integer? key) 215 (integer->char key) 216 key))) 217 218 (case key 219 ((#\0) (set-octave! 0)) 220 ((#\1) (set-octave! 1)) 221 ((#\2) (set-octave! 2)) 222 ((#\3) (set-octave! 3)) 223 ((#\4) (set-octave! 4)) 224 ((#\5) (set-octave! 5)) 225 ((#\6) (set-octave! 6)) 226 ((#\7) (set-octave! 7)) 227 ((#\8) (set-octave! 8)) 228 ((#\9) (set-octave! 9)) 229 230 ;; On Escape, Ctl-q, q -> terminate the program 231 ((#\x1b #\x11 #\q) (quit)) 232 (else (print `(received keyboard input ,key ,x ,y)))))) 233 234(define (special-keyboard key x y) 235 236 (let ((key (if (integer? key) 237 (integer->char key) 238 key))) 239 240 (case key 241 ((#\e) (move-image! 0 animation-velocity)) 242 ((#\g) (move-image! 0 (- animation-velocity))) 243 ((#\f) (move-image! animation-velocity 0)) 244 ((#\d) (move-image! (- animation-velocity) 0)) 245 246 (else (print `(received special keyboard input ,key ,x ,y)))))) 247 248;;;;;;;;;;;;;;;;;;;;;;; Idle function (animation) ;;;;;;;;;;;;;;;;;;;;;;; 249 250(define (idle-callback) 251 252 ;; (thread-sleep! 0.05) 253 254 (if animation-activated 255 (move-image! animation-velocity animation-velocity)) 256 257 (if (or image-modified animation-activated) 258 (begin 259 (set! image-modified #f) 260 (render-scene)))) 261 262;;;;;;;;;;;;;;;;;;;;;;; Gui Initialization ;;;;;;;;;;;;;;;;;;;;;;; 263 264(define (glut-init height width) 265 266 (set! image-height height) 267 (set! image-width width) 268 269 ;; (glutInit (vector) (vector)) 270 271 (glutInit (vector 0) (vector "")) 272 273 (glutInitDisplayMode (bitwise-ior GLUT_DOUBLE GLUT_RGB)) 274 (glutInitWindowSize image-width image-height) 275 (glutCreateWindow "Question 2: Perlin Noise") 276 277 (glPointSize 1.) 278 (glDisable GL_POINT_SMOOTH) 279 280 (create-menu) 281 (set! octaves 5) 282 (set! display-mode grayscalify) 283 (switch-interpolation-fun!) 284 (set! animation-velocity (inexact->exact 285 (ceiling (/ (max image-width image-height) 286 100)))) 287 (glutReshapeFunc reshape) 288 (glutKeyboardFunc keyboard) 289 (glutSpecialFunc special-keyboard) 290 (glutIdleFunc idle-callback) 291 (glutDisplayFunc render-scene)) 292 293;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 294 295(define usage-message 296 (string-append "Usage:\n" 297 "question2 [image height (default: 200)] " 298 "[image width (default: 200)]\n\n")) 299 300(define (display-instructions) 301 (for-each (lambda (x) (display x)) 302 (list 303 "\n" 304 " ----- Comp521 - Assignement 2 - Question2: ----\n" 305 " Perlin noise implementation\n" 306 " by\n" 307 " David St-Hilaire\n\n" 308 usage-message 309 "Instructions:\n" 310 " Please use the context menu by pressing the right mouse \n" 311 " button to get all available options. Also some keyboard \n" 312 " shortcuts are available:\n" 313 " 0-9 digits: Use N perlin noise octaves summation.\n" 314 " arrows: Pan into the generated landscape.\n" 315 " q, escape: Quit.\n\n" 316 "Please Note:\n" 317 " -The image can be resized/zoomed by expanding the window.\n" 318 " -Slightly better performances can be achived by running\n" 319 " the program with: ./question2 -:m10000 [heigth] [width].\n\n" 320 "Please enjoy! ^_^Y\n"))) 321 322(define return #f) 323(define (quit) (return 0)) 324 325;; (define (main) 326;; (define (start heigth width) 327;; (glut-init heigth width) 328;; (display-instructions) 329;; (call/cc (lambda (k) (set! return k) (glutMainLoop)))) 330 331;; ;; Start a debug/developpement repl in a seperate thread 332;; ;; (thread-start! (make-thread (lambda () (##repl)))) 333;; (cond 334;; ((eqv? (length (command-line)) 1) (start 200 200)) 335;; ((eqv? (length (command-line)) 3) 336;; (start (string->number (list-ref (command-line) 1)) 337;; (string->number (list-ref (command-line) 2)))) 338;; (else 339;; (display usage-message)))) 340 341;; (main) 342 343;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 344 345(define (start heigth width) 346 347 (random-source-randomize! default-random-source) 348 349 (glut-init heigth width) 350 (display-instructions) 351 ;; (call/cc (lambda (k) (set! return k) (glutMainLoop))) 352 (glutMainLoop) 353 ) 354 355(switch-animation-mode!) 356(start 200 200)