[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/jr6LEI0M    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Jul 15:
; breshenham's line-drawing algorithm

(define esc (integer->char 27))
(define (cls)
  (display esc) (display #\[)
  (display #\2) (display #\J))
(define (hide-cursor)
  (display esc) (display #\[) (display #\?)
  (display #\2) (display #\5) (display #\l))
(define (show-cursor)
  (display esc) (display #\[) (display #\?)
  (display #\2) (display #\5) (display #\h))
(define (goto r c)
  (display esc) (display #\[) (display r)
  (display #\;) (display c) (display #\H))
(define max-r 24) (define max-c 39)

(define (set-pixel x y)
  (goto y (+ x x)) (display #\*))

(define (line x0 y0 x1 y1)
  (let* ((dx (abs (- x1 x0))) (sx (if (< x0 x1) 1 -1))
         (dy (abs (- y1 y0))) (sy (if (< y0 y1) 1 -1))
         (err (- dx dy)))
    (let loop ((x0 x0) (y0 y0) (err err))
      (set-pixel x0 y0)
      (when (not (and (= x0 x1) (= y0 y1)))
        (let* ((e2 (* err 2))
               (err (if (> e2 (- dy)) (- err dy) err))
               (x0 (if (> e2 (- dy)) (+ x0 sx) x0))
               (err (if (< e2 dx) (+ err dx) err))
               (y0 (if (< e2 dx) (+ y0 sy) y0)))
          (loop x0 y0 err))))))

(define (draw poly)
  (cls)
  (let ((start (car poly)))
    (do ((poly poly (cdr poly)))
        ((null? (cdr poly))
          (line (caar poly) (cadar poly)
                (car start) (cadr start)))
      (line (caar poly) (cadar poly)
            (caadr poly) (cadadr poly))))
  (read-char) (goto 0 0) (cls) (if #f #f))

(draw '((19 0) (30 24) (5 8) (33 8) (8 24)))


Output:
1
Disallowed system call: SYS__newselect


Create a new paste based on this one


Comments: