(define image-series (lambda (n width height) (let ((canvas (image-new width height))) (image-show canvas) (let ( (col1 (cond ((< n 250) (rgb-new (+ (* 88 0.004 (- 250 n)) (* 221 0.004 n)) (+ (* 189 0.004 (- 250 n)) (* 238 0.004 n)) (+ (* 248 0.004 (- 250 n)) (* 248 0.004 n)))) ((< n 500) (rgb-new (+ (* 221 0.004 (- 250 n)) (* 43 0.004 n)) (+ (* 238 0.004 (- 250 n)) (* 165 0.004 n)) (+ (* 248 0.004 (- 250 n)) (* 195 0.004 n)))) (else (rgb-new (+ (* 43 0.004 (- 250 n)) (* 14 0.004 n)) (+ (* 165 0.004 (- 250 n)) (* 46 0.004 n)) (+ (* 195 0.004 (- 250 n)) (* 63 0.004 n)))) )) (col2 (cond ((< n 80) (rgb-new (+ (* 232 0.004 (- 250 n)) (* 67 0.004 n)) (+ (* 189 0.004 (- 250 n)) (* 184 0.004 n)) (+ (* 248 0.004 (- 250 n)) (* 251 0.004 n)))) ((< n 420) (rgb-new (+ (* 67 0.004 (- 250 n)) (* 232 0.004 n)) (+ (* 184 0.004 (- 250 n)) (* 189 0.004 n)) (+ (* 251 0.004 (- 250 n)) (* 248 0.004 n)))) ((< n 580) (rgb-new (+ (* 232 0.004 (- 250 n)) (* 167 0.004 n)) (+ (* 189 0.004 (- 250 n)) (* 19 0.004 n)) (+ (* 248 0.004 (- 250 n)) (* 57 0.004 n)))) (else (rgb-new (+ (* 14 0.004 (- 250 n)) (* 0 0.004 n)) (+ (* 46 0.004 (- 250 n)) (* 0 0.004 n)) (+ (* 63 0.004 (- 250 n)) (* 0 0.004 n))))))) (image-compute-pixels! canvas 0 0 (- width 1) (- height 1) (lambda (pos) (rgb-new (+ (* (rgb-red col1) (/ (- height (position-row pos)) height)) (* (rgb-red col2) (position-row pos) (/ 1 height))) (+ (* (rgb-green col1) (/ (- height (position-row pos)) height)) (* (rgb-green col2) (position-row pos) (/ 1 height))) (+ (* (rgb-blue col1) (/ (- height (position-row pos)) height)) (* (rgb-blue col2) (position-row pos) (/ 1 height))))))) (sunmoon canvas n width height)))) (define sunmoon (lambda (canvas n width height) (cond ;;; Sun ((and (>= n 45) (<= n 455)) ; Draw the primary circle (image-select-ellipse! canvas selection-replace (- (+ (/ (image-width canvas) 2) (* (/ (image-width canvas) 2) (cos (/ ( * n pi) 500)))) (/ (image-width canvas) 12) ) (- (image-height canvas) (* (/ 2 3) (+ (/ (image-height canvas) 2) (* (/ (image-height canvas) 2) (sin (/ ( * n pi) 500))))) (/ (image-width canvas) 12)) (/ (image-width canvas) 6) (/ (image-width canvas) 6)) (context-set-fgcolor! "orange") (image-fill! canvas) (image-select-nothing! canvas) ; Draw left eye (image-select-ellipse! canvas selection-replace (- (+ (/ (image-width canvas) 2) (* (/ (image-width canvas) 2) (cos (/ ( * n pi) 500)))) (/ (image-width canvas) 24) (/ (image-width canvas) 72)) (- (image-height canvas) (* (/ 2 3) (+ (/ (image-height canvas) 2) (* (/ (image-height canvas) 2) (sin (/ ( * n pi) 500))))) (/ (image-width canvas) 24)) (/ (image-width canvas) 24) (/ (image-width canvas) 24)) (context-set-fgcolor! "white") (image-fill! canvas) (image-select-nothing! canvas) ; Draw right eye (image-select-ellipse! canvas selection-replace (+ (/ (image-width canvas) 2) (* (/ (image-width canvas) 2) (cos (/ ( * n pi) 500))) (+ (/ (image-width canvas) 72))) (- (image-height canvas) (* (/ 2 3) (+ (/ (image-height canvas) 2) (* (/ (image-height canvas) 2) (sin (/ ( * n pi) 500))))) (/ (image-width canvas) 24) ) (/ (image-width canvas) 24) (/ (image-width canvas) 24)) (context-set-fgcolor! "white") (image-fill! canvas) (image-select-nothing! canvas) ; Smile (image-select-ellipse! canvas selection-replace (- (+ (/ (image-width canvas) 2) (* (/ (image-width canvas) 2) (cos (/ ( * n pi) 500)))) (/ (image-width canvas) 16)) (+ (- (image-height canvas) (* (/ 2 3) (+ (/ (image-height canvas) 2) (* (/ (image-height canvas) 2) (sin (/ ( * n pi) 500)))))) (/ (image-width canvas) 96)) (/ (image-width canvas) 8) (/ (image-width canvas) 24)) (context-set-fgcolor! "white") (image-fill! canvas) ; Get ready to show (image-select-nothing! canvas) (context-update-displays!)) ;;; Moon ((and (> n 545) (<= n 955)) ; Draw the primary circle (image-select-ellipse! canvas selection-replace (- (+ (/ (image-width canvas) 2) (* (/ (image-width canvas) 2) (cos (/ ( * (- n 500) pi) 500)))) (/ (image-width canvas) 12) ) (- (image-height canvas) (* (/ 2 3) (+ (/ (image-height canvas) 2) (* (/ (image-height canvas) 2) (sin (/ ( * (- n 500) pi) 500))))) (/ (image-width canvas) 12)) (/ (image-width canvas) 6) (/ (image-width canvas) 6)) (context-set-fgcolor! "grey") (image-fill! canvas) ; Draw left eye (image-select-ellipse! canvas selection-replace (- (+ (/ (image-width canvas) 2) (* (/ (image-width canvas) 2) (cos (/ ( * (- n 500) pi) 500)))) (/ (image-width canvas) 24) (/ (image-width canvas) 72)) (- (image-height canvas) (* (/ 2 3) (+ (/ (image-height canvas) 2) (* (/ (image-height canvas) 2) (sin (/ ( * (- n 500) pi) 500))))) (/ (image-width canvas) 24)) (/ (image-width canvas) 24) (/ (image-width canvas) 24)) (context-set-fgcolor! "white") (image-fill! canvas) ; Draw right eye (image-select-ellipse! canvas selection-replace (+ (/ (image-width canvas) 2) (* (/ (image-width canvas) 2) (cos (/ ( * (- n 500) pi) 500))) (+ (/ (image-width canvas) 72))) (- (image-height canvas) (* (/ 2 3) (+ (/ (image-height canvas) 2) (* (/ (image-height canvas) 2) (sin (/ ( * (- n 500) pi) 500))))) (/ (image-width canvas) 24)) (/ (image-width canvas) 24) (/ (image-width canvas) 24)) (context-set-fgcolor! "white") (image-fill! canvas) ; Smile (image-select-ellipse! canvas selection-replace (- (+ (/ (image-width canvas) 2) (* (/ (image-width canvas) 2) (cos (/ ( * (- n 500) pi) 500)))) (/ (image-width canvas) 16)) (+ (- (image-height canvas) (* (/ 2 3) (+ (/ (image-height canvas) 2) (* (/ (image-height canvas) 2) (sin (/ ( * (- n 500) pi) 500)))))) (/ (image-width canvas) 96)) (/ (image-width canvas) 8) (/ (image-width canvas) 24)) (context-set-fgcolor! "white") (image-fill! canvas) ; Get ready to show (image-select-nothing! canvas) (context-update-displays!))) (render-sky-new canvas skyX width height n))) ; Cloud list (define skyX (list (list -1 360 8 28 8) (list -1 368 5 5 7) (list -1 370 5 13 6) (list -1 320 28 13 20) (list -1 328 31 10 5) (list -1 327 38 15 8) (list -1 316 33 20 11) (list -1 313 39 13 8) (list -1 315 31 11 12) (list -1 283 19 13 9) (list -1 286 17 5 5) (list -1 279 22 13 5) (list -1 291 19 9 4) (list -1 249 44 18 9) (list -1 260 41 5 7) (list -1 253 42 8 5) (list -1 245 44 4 3) (list -1 244 45 2 1) (list -1 190 55 45 10) (list -1 203 53 14 4) (list -1 219 63 8 3) (list -1 213 12 13 12) (list -1 221 4 8 16) (list -1 225 4 7 6) (list -1 219 14 15 8) (list -1 226 9 8 7) (list -1 210 15 7 4) (list -1 161 28 13 20) (list -1 169 31 10 5) (list -1 168 38 15 8) (list -1 157 33 20 11) (list -1 154 39 13 8) (list -1 156 31 11 12) ;begin star section (list -1 118 68 1 14) ;vertical one (list -1 111 74 14 1) ;horiz bling (list -8961 115 72 6 6) (list -278529 116 73 4 4) (list -1988609 117 74 2 2) (list -8961 108 10 6 6) (list -278529 109 11 4 4) (list -1988609 110 12 2 2) (list -8961 78 29 6 6) (list -278529 79 29 4 4) (list -1988609 80 30 2 2) (list -8961 65 56 6 6) (list -278529 66 57 4 4) (list -1988609 67 58 2 2) (list -1 45 8 1 14) ;vertical one (list -1 38 15 15 1) ;horiz bling (list -8961 43 13 6 6) (list -278529 44 14 4 4) (list -1988609 45 15 2 2) (list -8961 27 64 6 6) (list -278529 28 65 4 4) (list -1988609 29 66 2 2) (list -8961 8 10 6 6) (list -278529 9 11 4 4) (list -1988609 10 12 2 2) (list -278529 68 78 12 10) (list -617335553 66 86 7 4) (list -617335553 74 86 7 4) (list -1734829825 55 84 40 4))) ; Render clouds (define render-sky-new (lambda (image sky width height n) (if (null? sky) image ;if sky is not empty, draw! ;test if spot is outside the image. If it is, proceed to next spot (cond ((or (< (* (+ -300 (* n 0.3) (cadr (car sky)) (cadddr (car sky))) width 0.0111) 0) ;end of object is before image begins (> (* (+ -300 (* n 0.3) (cadr (car sky))) width 0.0111) width)) ;object begins beyond the image (render-sky-new image (cdr sky) width height n)) (else (context-set-fgcolor! (car (car sky))) (image-select-ellipse! image selection-replace (if (< (* (+ -300 (* n 0.3) (cadr (car sky))) width 0.0111) 0) 0 (* (+ -300 (* n 0.3) (cadr (car sky))) width 0.0111)) ;start col (* (caddr (car sky)) height 0.0111) ;start row (* (cadddr (car sky)) width 0.0111) ;factor horiz (* (cadddr (cdr (car sky))) height 0.0111)) ;factor vert (image-fill! image) (image-select-nothing! image) (render-sky-new image (cdr sky) width height n) (context-update-displays!))))))