0. #lang racket
1.  
2. (require 2htdp/image)
3. (require lang/posn)
4.  
5. (define N-GRID-ROWS 42)
6. (define N-RECTO-GRID-COLUMNS 17)
7.  
8. (define PX/PT 1)
9.  
10. ;; produces the number of pixels equivalent to n points
11. (define (pt n) (* n PX/PT))
12.  
13.  
14. (define CELL-W (pt 24))
15. (define CELL-H (pt 24))
16.  
17. (define HEADER-ROW-H (pt 108))
18.  ; how far the header line & number are rotated from horiz:
19. (define HEADER-ROW-ANGLE 60)
20. (define HEADER-LINE-LENGTH
21.   (/ HEADER-ROW-H (sin (degrees->radians HEADER-ROW-ANGLE))))
22.  
23. (define HEADER-NUMERAL-SIZE (pt 9))
24.  
25. ;; Names column geometry
26. (define NAMES-COLUMN-W (pt 72))
27. (define NAMES-NUMERAL-SIZE (pt 8))
28.  
29. (define NAMES-ROW-ANGLE 30)
30.  
31. (define NAMES-COLUMN-LINE-LENGTH (/ NAMES-COLUMN-W (cos (degrees->radians NAMES-ROW-ANGLE))))
32.  
33. (define NAME-CELL-DIAGONAL-H
34.   ;; vertical distance from bottom-left corner of a name cell to the right end of
35.   ;; the bottom line of the cell
36.   (* NAMES-COLUMN-LINE-LENGTH (sin (degrees->radians NAMES-ROW-ANGLE))))
37. (define NAME-CELL-DIAGONAL-OVERLAP (- NAME-CELL-DIAGONAL-H CELL-H))
38.  
39. ;; Colors
40.  
41. (define GRID-BG-COLORS
42.   ; lavenders
43.   #;(list 'white
44.         (make-color #xF0 #xE0 #xFF)
45.         (make-color #xD0 #xC0 #xFF))
46.   ; greens
47.   (list 'white
48.         (make-color #xF0 #xFF #xE0)
49.         (make-color #xD0 #xFF #xC0)))
50.  
51. (define HEADER-LINE-COLOR 'forestgreen)
52. (define GRID-LINE-COLOR (make-color 0 0 0 #x40))
53. (define DARK-GRID-LINE-COLOR (make-color 0 0 0 #xA0))
54. (define HEADER-NUMERAL-COLOR (make-color #x80 #x80 #x80 255))
55. (define NAMES-NUMERAL-COLOR HEADER-NUMERAL-COLOR)
56. (define HEADER-NUMERAL-OFFSET
57.   (* CELL-W (cos (degrees->radians HEADER-ROW-ANGLE))))
58.  
59. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
60. ;; Pinhole helper
61.  
62. ;; x-place y-place Image -> Image
63. ;; places a pinhole on img at the location specified by x-place and y-place
64. (define (align-pinhole x-place y-place img)
65.   (put-pinhole (x-place->coordinate x-place img)
66.                (y-place->coordinate y-place img)
67.                img))
68.  
69. ;; x-place Image -> (Option Nat)
70. ;; produces the x-coordinate for the given x-place in the image, or
71. ;; #f if x-place is 'pinhole and img has no pinhole.
72. (define (x-place->coordinate x-place img)
73.   (define place (if (symbol? x-place) x-place (string->symbol x-place)))
74.   (case place
75.     [(left) 0]
76.     [(right)         (image-width img)]
77.     [(middle center) (exact-round (/ (image-width img) 2))]
78.     [(pinhole)       (pinhole-x img)]))
79.  
80. ;; y-place Image -> (Option Nat)
81. ;; produces the y-coordinate for the given y-place in the image, or
82. ;; #f if y-place is 'pinhole and img has no pinhole.
83. (define (y-place->coordinate y-place img)
84.   (define place (if (symbol? y-place) y-place (string->symbol y-place)))
85.   (case place
86.     [(top)           0]
87.     [(bottom)        (image-height img)]
88.     [(middle center) (exact-round (/ (image-height img) 2))]
89.     [(baseline) (error "FIXME need to implement baseline")]
90.     [(pinhole) (pinhole-y img)]))
91.  
92. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
93. ;; Making numbered slanted headers
94.  
95. ;; Int+ -> Image
96. ;; makes n header cells side-by-side, numbered R-to-L from 1 to n,
97. ;; with a pinhole at the right end of the bottom line
98. (define (number-headers n)
99.   (put-pinhole (* n CELL-W) HEADER-ROW-H
100.                (for/fold ([result empty-image])
101.                          ([i (in-range 1 (add1 n))])
102.                  (overlay/align/offset 'left 'bottom
103.                                        (number-header i)
104.                                        CELL-W 0
105.                                        result))))
106.  
107. ;; Int+ -> Image
108. ;; makes a header cell containing the number i
109. (define (number-header i)
110.   (define lines
111.     (overlay/align 'left 'top
112.                    (rotate (- HEADER-ROW-ANGLE) (line CELL-W 0 HEADER-LINE-COLOR))
113.                    (line HEADER-LINE-LENGTH 0 HEADER-LINE-COLOR)))
114.   (rotate HEADER-ROW-ANGLE
115.           (overlay/align/offset 'left 'middle  lines HEADER-NUMERAL-OFFSET 0
116.                                 (numeral i HEADER-NUMERAL-COLOR HEADER-NUMERAL-SIZE))))
117.  
118. ;; Nat Color Int+ -> Image
119. ;; make an image of the given numeral, given color & point size font
120. (define (numeral n c size) (cell-text (number->string n) c size))
121.  
122. ;; String Color Int+ -> Image
123. ;; make an image of the given text, color & point size font
124. (define (cell-text s c size)
125.   (text/font s size c "Concourse T3 Tab" 'default 'normal 'normal #f))
126.  
127. (define ASSIGNMENTS-TITLE
128.   (rotate HEADER-ROW-ANGLE
129.           (put-pinhole 0 0 (above/align 'right
130.                                         (line HEADER-LINE-LENGTH 0 HEADER-LINE-COLOR)
131.                                         (cell-text "Asg" HEADER-NUMERAL-COLOR 11)))))
132.  
133. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
134. ;; Names column
135.  
136. ;; Int+ -> Image
137. ;; makes n right-sidebar name cells, stacked vertically, numbered 1 to n
138. ;; with a pinhole @ TL corner of the top cell
139. (define (name-cells n)
140.   (put-pinhole 0 NAME-CELL-DIAGONAL-H
141.                (for/fold ([result empty-image])
142.                          ([i (in-range 1 (add1 n))]
143.                           [c (in-cycle GRID-BG-COLORS)])
144.                  (overlay/align/offset 'left 'bottom
145.                                        result
146.                                        0 CELL-H
147.                                        (name-cell i c)))))
148.  
149. ;; Generate the page:
150. (gradebook-recto 20 36)

=>

gradebook-recto: undefined;

cannot reference an identifier before its definition

in module: 'm