blob: a95ea0d86d071ae6ba7c3ea8639f0ad98bc2cd73 (
plain) (
blame)
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
|
#lang racket/gui
(define frame (new frame%
[label "Pixel Pixel Pixel Pixel Pixel Pixel"]
[width 600]
[height 600]))
(define cell-size 20)
(define selected-color "black")
;; Create a set of predefined colors
(define colors '("black" "white" "red" "green" "blue" "yellow" "purple" "orange"))
(define my-canvas%
(class canvas%
(super-new)
(inherit get-dc get-width get-height)
(define/override (on-paint)
(define dc (get-dc))
(define canvas-width (get-width))
(define canvas-height (get-height))
(define grid-width (quotient canvas-width cell-size))
(define grid-height (quotient canvas-height cell-size))
(define grid (make-vector grid-width (make-vector grid-height "")))
;; Draw the stored colors
(for ([x (in-range grid-width)]
[y (in-range grid-height)])
(let ([color (vector-ref (vector-ref grid x) y)])
(when (not (string=? color ""))
(send dc set-brush color 'solid)
(send dc draw-rectangle (* x cell-size) (* y cell-size) cell-size cell-size)))))
(define/override (on-event event)
(define canvas-width (get-width))
(define canvas-height (get-height))
(define grid-width (quotient canvas-width cell-size))
(define grid-height (quotient canvas-height cell-size))
(when (send event button-down?)
(let ([x (quotient (send event get-x) cell-size)]
[y (quotient (send event get-y) cell-size)])
(when (and (< x grid-width) (< y grid-height))
(define grid (make-vector grid-width (make-vector grid-height "")))
(vector-set! (vector-ref grid x) y selected-color)
(send (get-dc) set-brush selected-color 'solid)
(send (get-dc) draw-rectangle (* x cell-size) (* y cell-size) cell-size cell-size)))))))
(define canvas (new my-canvas% [parent frame]))
;; Layout the UI components
(define main-panel (new vertical-panel% [parent frame]))
;; Add a horizontal panel to hold the canvas and color picker
(define canvas-panel (new horizontal-panel%
[parent main-panel]
[stretchable-width #t]
[stretchable-height #t]))
;; Add the canvas to the canvas panel
(new my-canvas% [parent canvas-panel]
[min-width 500]
[min-height 500])
;; Position the color picker in the top right corner
(define color-panel (new horizontal-panel%
[parent main-panel]
[alignment '(right top)]))
(new choice% [parent color-panel]
[label "Pick Color: "]
[choices colors]
[callback (lambda (choice event)
(set! selected-color (send choice get-string-selection)))])
(send frame show #t)
|