1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
;;;
;;; Contributed by Issac Trotts
;;;
(use gl)
(use gl.glut)
(use math.const)
(define *pad* 30)
(define (range n)
(define (aux acc n)
(if (<= n 0)
acc
(aux (cons (- n 1) acc) (- n 1))))
(aux '() n))
(define (iter f ls)
(cond
((null? ls)) ; do nothing
((pair? ls)
(f (car ls))
(iter f (cdr ls)))
(else (error "Cannot iterate over a non-list"))))
(define (iter2 f lsa lsb)
(cond
((or (null? lsa) (null? lsb))) ; do nothing
((and (pair? lsa) (pair? lsb))
(f (car lsa) (car lsb))
(iter2 f (cdr lsa) (cdr lsb)))
(else (error "Cannot iterate over a non-list"))))
(define (draw-string x y s)
(gl-raster-pos x y)
(iter (lambda (c) (glut-bitmap-character GLUT_BITMAP_8_BY_13
(char->integer c)))
(string->list s)))
(define plot
(let1 have-called-glut-init #f
(lambda (f a b)
(let ((w 500)
(h 500))
(if (not have-called-glut-init)
(begin
(glut-init '())
(set! have-called-glut-init #t)))
(glut-init-display-mode (logior GLUT_DOUBLE GLUT_RGBA))
(glut-init-window-size w h)
(glut-create-window "plot")
; Initialize GL
(begin
(gl-enable GL_BLEND)
(gl-blend-func GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA)
(gl-enable GL_LINE_SMOOTH)
(gl-clear-color 1.0 1.0 1.0 1.0)
)
(let*
((xs (map (lambda (x) (+ a (* (- b a) (/ x w)))) (range w)))
(ys (map f xs))
(mx (apply max ys))
(mn (apply min ys)))
(glut-reshape-func
(lambda (new-w new-h)
(gl-viewport 0 0 new-w new-h)
(set! w new-w)
(set! h new-h)
))
(glut-display-func
(lambda ()
(gl-clear GL_COLOR_BUFFER_BIT)
(gl-color 0 0 0 1)
;; Draw the plot
(begin
(gl-viewport *pad* *pad* (- w (* 2 *pad*)) (- h (* 2 *pad*)))
(gl-matrix-mode GL_PROJECTION)
(gl-load-identity)
(glu-ortho-2d a b mn mx)
(gl-matrix-mode GL_MODELVIEW)
(gl-load-identity)
(gl-begin GL_LINE_STRIP)
(iter2 (lambda (x y) (gl-vertex x y 0.0)) xs ys)
(gl-end)
)
;; Change to pixel coordinates
(begin
(gl-viewport 0 0 w h)
(gl-matrix-mode GL_PROJECTION)
(gl-load-identity)
(glu-ortho-2d 0 w 0 h)
)
;; Show a, b, min, max.
(let1 pad2 (/ *pad* 2)
(draw-string pad2 (/ h 2) (format #f "~a" a))
(draw-string (- w *pad*) (/ h 2) (format #f "~a" b))
(draw-string (/ w 2) (- h pad2) (format #f "~a" mx))
(draw-string (/ w 2) pad2 (format #f "~a" mn))
)
;; Todo: Show axis labels.
;; Todo: show tick marks
(glut-swap-buffers)
))
(glut-keyboard-func
(lambda (key x y)
(case (integer->char key)
((#\q) (error "Don't worry about this error.")))))
(guard (exc (else 'foo))
(glut-main-loop))
0
)))))
|
