54 lines
1.9 KiB
Racket
54 lines
1.9 KiB
Racket
#lang scheme
|
|
|
|
(require htdp/hangman
|
|
htdp/big-draw
|
|
lang/prim
|
|
lang/posn)
|
|
|
|
(provide go)
|
|
|
|
(define-primitive go go/proc)
|
|
|
|
#| ------------------------------------------------------------------------
|
|
draw-next-part :
|
|
{ 'noose 'head 'right-arm 'left-arm 'body 'right-leg 'left-leg } -> #t
|
|
result: #t if things went okay
|
|
effect: to draw the specified body part in a canvas of size W x H
|
|
credit: John Clements
|
|
|#
|
|
(define (draw-next-part body-part)
|
|
(cond ((eq? body-part 'body)
|
|
(draw-solid-line (make-posn 100 60) (make-posn 100 130) 'black))
|
|
((eq? body-part 'right-leg)
|
|
(draw-solid-line (make-posn 100 130) (make-posn 30 170) 'black))
|
|
((eq? body-part 'left-leg)
|
|
(draw-solid-line (make-posn 100 130) (make-posn 170 170) 'black))
|
|
((eq? body-part 'right-arm)
|
|
(draw-solid-line (make-posn 100 75) (make-posn 40 65) 'black))
|
|
((eq? body-part 'left-arm)
|
|
(draw-solid-line (make-posn 100 75) (make-posn 160 65) 'black))
|
|
((eq? body-part 'head)
|
|
(draw-circle (make-posn 100 50) 10 'black))
|
|
((eq? body-part 'noose)
|
|
(and
|
|
(draw-solid-line (make-posn 100 30) (make-posn 100 10) 'black)
|
|
(draw-solid-line (make-posn 100 10) (make-posn 0 10) 'black)
|
|
(draw-solid-line (make-posn 115 35) (make-posn 123 43) 'black)
|
|
(draw-solid-line (make-posn 123 35) (make-posn 115 43) 'black)
|
|
(draw-solid-line (make-posn 131 40) (make-posn 139 48) 'black)
|
|
(draw-solid-line (make-posn 139 40) (make-posn 131 48) 'black)
|
|
(draw-circle (make-posn 120 50) 30 'red)))))
|
|
|
|
;; reveal-list : list-of-letters list-of-letters letter -> list-of-letters
|
|
(define (reveal-list l1 l2 gu)
|
|
(map (lambda (x1 x2)
|
|
(cond
|
|
[(eq? x1 gu) gu]
|
|
[else x2]))
|
|
l1 l2))
|
|
|
|
(define (go/proc x)
|
|
(start 200 400)
|
|
(hangman-list reveal-list draw-next-part))
|
|
|