/examples/random-art/source.scm
Scheme | 163 lines | 78 code | 71 blank | 14 comment | 0 complexity | 38ec5f9fdfb43deb8a77d4d1ee3d8523 MD5 | raw file
Possible License(s): BSD-3-Clause
1 2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3 4(random-source-randomize! default-random-source) 5 6;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 8(define (vector-ref-random v) 9 (vector-ref v (random-integer (vector-length v)))) 10 11;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12 13(define (sin-pi* c) (sin (* pi c))) 14(define (cos-pi* c) (cos (* pi c))) 15 16;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17 18(define (random-product-procedure n) 19 20 (display "(* ") 21 22 (let ((proc-1 (random-procedure (- n 1))) 23 (proc-2 (random-procedure (- n 1)))) 24 25 (display ")") 26 27 (lambda (a b) 28 29 (* (proc-1 a b) 30 (proc-2 a b))))) 31 32;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 33 34(define (random-average-procedure n) 35 36 (display "(avg ") 37 38 (let ((proc-1 (random-procedure (- n 1))) 39 (proc-2 (random-procedure (- n 1)))) 40 41 (display ")") 42 43 (lambda (a b) 44 45 (/ (+ (proc-1 a b) 46 (proc-2 a b)) 47 2.0)))) 48 49;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 50 51(define (random-sin-pi*-procedure n) 52 53 (display "(sin (* pi ") 54 55 (let ((proc (random-procedure (- n 1)))) 56 57 (display "))") 58 59 (lambda (a b) 60 61 (sin-pi* (proc a b))))) 62 63;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 64 65(define (random-cos-pi*-procedure n) 66 67 (display "(cos (* pi ") 68 69 (let ((proc (random-procedure (- n 1)))) 70 71 (display "))") 72 73 (lambda (a b) 74 75 (cos-pi* (proc a b))))) 76 77;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 78 79(define (random-x-y-procedure n) 80 (let ((arg (random-integer 2))) 81 (display (if (= arg 0) "x " "y ")) 82 (lambda (a b) 83 (vector-ref (vector a b) arg)))) 84 85;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 86 87(define (random-procedure n) 88 89 (cond ((= n 1) 90 (random-x-y-procedure #f)) 91 92 (else 93 (let ((procedure (vector-ref-random (vector random-product-procedure 94 random-average-procedure 95 random-sin-pi*-procedure 96 random-cos-pi*-procedure)))) 97 (procedure n))))) 98 99;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 100 101(display "(lambda (x y) ") 102 103(define fun (random-procedure 7)) 104 105(display ")\n") 106 107;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 108 109(glutInit (vector 0) (vector "")) 110 111(glutInitWindowPosition 100 100) 112 113(glutInitWindowSize 500 500) 114 115(glutCreateWindow "Random Art") 116 117(glutReshapeFunc (ortho-2d -1.0 1.0 -1.0 1.0)) 118 119;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 120 121(glutDisplayFunc 122 123 (lambda () 124 125 (glMatrixMode GL_MODELVIEW) 126 127 (glLoadIdentity) 128 129 (glClearColor 0.0 0.0 0.0 0.0) 130 131 (glClear GL_COLOR_BUFFER_BIT) 132 133 (glBegin GL_POINTS) 134 135 (do ((y -1.0 (+ y 0.01))) 136 ((> y 1.0)) 137 138 (do ((x -1.0 (+ x 0.01))) 139 ((> x 1.0)) 140 141 (let ((val (fun x y))) 142 143 (let ((grey (/ (+ val 1.0) 2.0))) 144 145 (glColor4d grey grey grey 1.0) 146 147 (glVertex2d x y))))) 148 149 (glEnd) 150 151 (glFlush) 152 153 )) 154 155;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 156 157(glutKeyboardFunc 158 (lambda (key x y) 159 (exit))) 160 161;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 162 163(glutMainLoop)