Subjects

200511082330

Here’s a minara tool that draws random squares, named “Subjects” in honour of my old program of the same name. To load it, pop this in your .minara file and press t,s . Then click for squares. 🙂 :


;; -*-Scheme-*-

;; Subjects

(define $subject-size 20.0)
(define $subject-size/2 (/ $subject-size
2))

(define (random-colour)
(format #f "(set-colour ~f ~f ~f 0.0)"
(random 1.0)
(random 1.0)
(random 1.0)))

(define (subject buffer x-pos y-pos)
(let* ((x (+ (- x-pos
$subject-size/2)
(random $subject-size)))
(y (+ (- y-pos
$subject-size/2)
(random $subject-size)))
(top (+
y $subject-size/2))
(left (- x
$subject-size/2))
(bottom (- y
$subject-size/2))
(right (+ x
$subject-size/2)))
(format #f
"~a~%(path-begin)~%(move-to ~f ~f)~%(line-to ~f ~f)~%(line-to ~f ~f)~%(line-to ~f ~f)~%(path-end)~%"
(random-colour)
left
bottom
left
top
right
top
right
bottom)))

(define (subjects-mouse-up win button x y)
(let* ((window (window-for-id win))
(main-buffer (window-buffer-main window)))
(do ((i 0 (+ i 1)))
((> i 10))
(buffer-insert-undoable main-buffer
#f
(subject main-buffer
(window-view-x window
x)
(window-view-y window
y))))
(buffer-undo-mark main-buffer)
(buffer-invalidate main-buffer))
(window-redraw win))

;; Install

(define (subjects-tool-install)
(add-mouse-up-hook subjects-mouse-up))

;; Uninstall

(define (subjects-tool-uninstall)
(remove-mouse-up-hook subjects-mouse-up))

;; Register

(install-tool subjects-tool-install
subjects-tool-uninstall
"Subjects"
"t" "s")

Posted in Projects