~rhcarvalho/+junk/racket

« back to all changes in this revision

Viewing changes to demo/random-image.rkt

  • Committer: Rodolfo Carvalho
  • Date: 2011-08-07 07:43:33 UTC
  • Revision ID: rhcarvalho@gmail.com-20110807074333-gxjsq793o6e90e8y
Add random image generator

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
#lang slideshow
 
2
; Inspired by this thread:
 
3
; http://www.mail-archive.com/users@racket-lang.org/msg06079.html
 
4
 
 
5
#|
 
6
 EXPR = x |
 
7
        y |
 
8
        (sinpi EXPR) |
 
9
        (cospi EXPR) |
 
10
        (* EXPR EXPR) |
 
11
        (avg EXPR EXPR)
 
12
|#
 
13
 
 
14
(require (only-in picturing-programs
 
15
                  build3-image
 
16
                  real->int))
 
17
 
 
18
(define (avg x y)
 
19
  (/ (+ x y)
 
20
     2))
 
21
 
 
22
(define (sinpi x)
 
23
  (sin (* pi x)))
 
24
 
 
25
(define (cospi x)
 
26
  (cos (* pi x)))
 
27
 
 
28
;; N -> EXPR
 
29
;; generate an expression of depth i
 
30
(define (generate-expression i)
 
31
  (if (> i 1)
 
32
      (let ([sub-expr (generate-expression (sub1 i))])
 
33
        (case (random 2)
 
34
          [(0) (case (random 2)
 
35
                 [(0) (lambda (x y) (sinpi (sub-expr x y)))]
 
36
                 [(1) (lambda (x y) (cospi (sub-expr x y)))])]
 
37
          [(1) (let([sub-expr2 (generate-expression (sub1 i))])
 
38
                 (case (random 2)
 
39
                   [(0) (lambda (x y)
 
40
                          (* (sub-expr x y)
 
41
                             (sub-expr2 x y)))]
 
42
                   [(1) (lambda (x y)
 
43
                          (avg (sub-expr x y)
 
44
                               (sub-expr2 x y)))]))]))
 
45
      (case (random 2)
 
46
        [(0) (lambda (x y) x)]
 
47
        [(1) (lambda (x y) y)])))
 
48
 
 
49
(define (range-interpolator from-min from-max to-min to-max)
 
50
  (λ (x)
 
51
    (+ to-min
 
52
       (* (/ (- to-max to-min)
 
53
             (- from-max from-min))
 
54
          (- x
 
55
             from-min)))))
 
56
 
 
57
;(set-page-numbers-visible! #f)
 
58
(set-margin! 0)
 
59
(define width 160)
 
60
(define height 120)
 
61
 
 
62
(define scale/x (/ client-w width))
 
63
(define scale/y (/ client-h height))
 
64
 
 
65
(define (color-from-expression expr)
 
66
  (let ([x-interpolator (range-interpolator 0 (sub1 width) -1 1)]
 
67
        [y-interpolator (range-interpolator 0 (sub1 height) -1 1)]
 
68
        [output-interpolator (range-interpolator -1 1 0 255)])
 
69
    (λ (x y)
 
70
      (real->int
 
71
       (output-interpolator
 
72
        (expr (x-interpolator x)
 
73
              (y-interpolator y)))))))
 
74
 
 
75
(define (caption n)
 
76
  (let ([text (bt (format "~a" n))])
 
77
    (colorize (scale/improve-new-text text (/ (* 0.8 client-h) (pict-height text))) "white")))
 
78
 
 
79
(define (generate-slide n image)
 
80
  (slide
 
81
   ;(cc-superimpose
 
82
    (scale
 
83
     (bitmap
 
84
      (send
 
85
       image
 
86
       get-bitmap))
 
87
     scale/x scale/y)
 
88
    ;(caption n))
 
89
   ))
 
90
 
 
91
(define images
 
92
  (for/list ([i (in-range 10)])
 
93
    (build3-image
 
94
     width
 
95
     height
 
96
     (color-from-expression (generate-expression 5))
 
97
     (color-from-expression (generate-expression 6))
 
98
     (color-from-expression (generate-expression 7)))))
 
99
 
 
100
(for ([img (in-list images)]
 
101
      [i (in-naturals 1)])
 
102
  (generate-slide i img))
 
103
 
 
104
 
 
105
 
 
106
; -------------- "interesting image" ------------------
 
107
 
 
108
(define expr
 
109
  (λ (x y)
 
110
    (cospi (* (avg (sinpi y) x) (cospi (* x y))))))
 
111
 
 
112
(let ([cfe (color-from-expression expr)])
 
113
  (build3-image
 
114
   width height
 
115
   cfe cfe cfe))