Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
(define H 500)
(define r (/ H 2))
(define (ypos x)
(if (<= x 1)
(/ (sqrt (- 1 (sqr (- (* 2 x) 1)))) 2)
(/ (sqrt (- 1 (sqr (- (* 2 x) 3)))) -2)))
(define (ypos-as-posn x)
(make-posn (* x r)
(* (+ 1 (ypos x)) r)))
(define (div-by n)
(lambda (x) (/ x n)))
(define (range start stop)
(if (<= start stop)
(cons start (range (+ 1 start) stop))
(list)))
(define (do-pairwise action lst)
(if (>= (length lst) 2)
(begin (action (car lst) (cadr lst))
(do-pairwise action (cdr lst)))
'done))
(define (make-rotate degree x0 y0)
(let ((c (cos degree))
(s (sin degree)))
(lambda (posn) (make-posn (+ (- (* c (- (posn-x posn) x0)) (* s (- (posn-y posn) y0))) x0)
(+ (+ (* s (- (posn-x posn) x0)) (* c (- (posn-y posn) y0))) y0)))))
(define points (map ypos-as-posn
(map (div-by r) (range 0 H))))
(start H H)
(define (draw-lines points) (do-pairwise (lambda (a b) (draw-solid-line a b 'black)) points))
(define (clear-lines points) (do-pairwise (lambda (a b) (clear-solid-line a b 'black)) points))
(define (make-rotated-posn x y x0 y0 degree)
(let ((c (cos degree))
(s (sin degree)))
(make-posn (+ (- (* c (- x x0)) (* s (- y y0))) x0)
(+ (+ (* s (- x x0)) (* c (- y y0))) y0))))
(define (draw-hangman degree)
(and
(draw-circle (make-rotated-posn 275 111 r r degree) 90 'red)
(draw-solid-line (make-rotated-posn 288 49 r r degree) (make-rotated-posn 265 67 r r degree) 'black)
(draw-solid-line (make-rotated-posn 273 50 r r degree) (make-rotated-posn 282 74 r r degree) 'black)
(draw-solid-line (make-rotated-posn 339 73 r r degree) (make-rotated-posn 316 88 r r degree) 'black)
(draw-solid-line (make-rotated-posn 326 73 r r degree) (make-rotated-posn 335 94 r r degree) 'black)
(draw-solid-line (make-rotated-posn 240 191 r r degree) (make-rotated-posn 231 361 r r degree) 'black)
(draw-solid-line (make-rotated-posn 239 241 r r degree) (make-rotated-posn 171 201 r r degree) 'black)
(draw-solid-line (make-rotated-posn 243 239 r r degree) (make-rotated-posn 301 231 r r degree) 'black)
(draw-solid-line (make-rotated-posn 234 364 r r degree) (make-rotated-posn 147 402 r r degree) 'black)
(draw-solid-line (make-rotated-posn 231 360 r r degree) (make-rotated-posn 295 414 r r degree) 'black)
(draw-solid-line (make-rotated-posn 221 142 r r degree) (make-rotated-posn 251 178 r r degree) 'black)
))
(define (clear-hangman degree)
(and
(clear-circle (make-rotated-posn 275 111 r r degree) 90 'red)
(clear-solid-line (make-rotated-posn 288 49 r r degree) (make-rotated-posn 265 67 r r degree) 'black)
(clear-solid-line (make-rotated-posn 273 50 r r degree) (make-rotated-posn 282 74 r r degree) 'black)
(clear-solid-line (make-rotated-posn 339 73 r r degree) (make-rotated-posn 316 88 r r degree) 'black)
(clear-solid-line (make-rotated-posn 326 73 r r degree) (make-rotated-posn 335 94 r r degree) 'black)
(clear-solid-line (make-rotated-posn 240 191 r r degree) (make-rotated-posn 231 361 r r degree) 'black)
(clear-solid-line (make-rotated-posn 239 241 r r degree) (make-rotated-posn 171 201 r r degree) 'black)
(clear-solid-line (make-rotated-posn 243 239 r r degree) (make-rotated-posn 301 231 r r degree) 'black)
(clear-solid-line (make-rotated-posn 234 364 r r degree) (make-rotated-posn 147 402 r r degree) 'black)
(clear-solid-line (make-rotated-posn 231 360 r r degree) (make-rotated-posn 295 414 r r degree) 'black)
(clear-solid-line (make-rotated-posn 221 142 r r degree) (make-rotated-posn 251 178 r r degree) 'black)
))
(define (main n stop)
(if (< n stop)
(let ((degree (/ n -2)))
(begin
(draw-hangman degree)
(sleep-for-a-while 0.1)
(clear-hangman degree)
(main (+ n 1) stop)))
'done))
(wait-for-mouse-click)
(main 0 72000000)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment