/examples/perlin-noise/ui/source.scm

  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)