From 563df85b8773c353043349c555f7622ddc1cab14 Mon Sep 17 00:00:00 2001 From: Masaya Tojo Date: Sat, 15 May 2021 00:05:53 +0900 Subject: Fix `draw-line` procedure. * sicp-picture-language.scm(draw-line): Fix. --- sicp-picture-language.scm | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/sicp-picture-language.scm b/sicp-picture-language.scm index 39f9c8e..379aa0e 100644 --- a/sicp-picture-language.scm +++ b/sicp-picture-language.scm @@ -122,15 +122,12 @@ (($ x1 y1) (match end-vect (($ x2 y2) - (let* ((screen (current-screen)) - (w (pict-width screen)) - (h (pict-height screen))) - (current-screen - (lb-superimpose - (line (* w x1) (- h (* h y1)) - (* w x2) (- h (* h y2)) - #:stroke-width (current-line-stroke-width) - #:color (current-line-color)))))))))) + (let ((screen (current-screen))) + (let ((l (line x1 y1 + x2 y2 + #:stroke-width (current-line-stroke-width) + #:color (current-line-color)))) + (current-screen (pin-over screen 0 0 l))))))))) (define current-screen (make-parameter #f)) (define current-pict-ids (make-parameter '())) -- cgit v1.2.3