Rhea Myers

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. :-) :

<br></br>;; -*-Scheme-*-<br></br><br></br>;; Subjects<br></br><br></br>(define $subject-size 20.0)<br></br>(define $subject-size/2 (/ $subject-size<br></br>2))<br></br><br></br>(define (random-colour)<br></br>(format #f "(set-colour ~f ~f ~f 0.0)"<br></br>(random 1.0)<br></br>(random 1.0)<br></br>(random 1.0)))<br></br><br></br>(define (subject buffer x-pos y-pos)<br></br>(let* ((x (+ (- x-pos<br></br>$subject-size/2)<br></br>(random $subject-size)))<br></br>(y (+ (- y-pos<br></br>$subject-size/2)<br></br>(random $subject-size)))<br></br>(top (+<br></br>y $subject-size/2))<br></br>(left (- x<br></br>$subject-size/2))<br></br>(bottom (- y<br></br>$subject-size/2))<br></br>(right (+ x<br></br>$subject-size/2)))<br></br>(format #f<br></br>"~a~%(path-begin)~%(move-to ~f ~f)~%(line-to ~f ~f)~%(line-to ~f ~f)~%(line-to ~f ~f)~%(path-end)~%"<br></br>(random-colour)<br></br>left<br></br>bottom<br></br>left<br></br>top<br></br>right<br></br>top<br></br>right<br></br>bottom)))<br></br><br></br>(define (subjects-mouse-up win button x y)<br></br>(let* ((window (window-for-id win))<br></br>(main-buffer (window-buffer-main window)))<br></br>(do ((i 0 (+ i 1)))<br></br>((> i 10))<br></br>(buffer-insert-undoable main-buffer<br></br>#f<br></br>(subject main-buffer<br></br>(window-view-x window<br></br>x)<br></br>(window-view-y window<br></br>y))))<br></br>(buffer-undo-mark main-buffer)<br></br>(buffer-invalidate main-buffer))<br></br>(window-redraw win))<br></br><br></br>;; Install<br></br><br></br>(define (subjects-tool-install)<br></br>(add-mouse-up-hook subjects-mouse-up))<br></br><br></br>;; Uninstall<br></br><br></br>(define (subjects-tool-uninstall)<br></br>(remove-mouse-up-hook subjects-mouse-up))<br></br><br></br>;; Register<br></br><br></br>(install-tool subjects-tool-install<br></br>subjects-tool-uninstall<br></br>"Subjects"<br></br>"t" "s")<br></br>