This commit is contained in:
Ingy döt Net 2013-06-05 21:47:54 +00:00
parent 1f1ad49427
commit 6f050a029e
2496 changed files with 37609 additions and 3031 deletions

View file

@ -0,0 +1,35 @@
#DEFINE WM_LBUTTONDOWN 513
#DEFINE WM_CLOSE 16
FBSLSETTEXT(ME, "Bresenham") ' Set form caption
FBSLSETFORMCOLOR(ME, RGB(0, 255, 255)) ' Cyan: set persistent background color
DRAWWIDTH(5) ' Adjust point size
FBSL.GETDC(ME) ' Use volatile FBSL.GETDC below to avoid extra assignments
RESIZE(ME, 0, 0, 200, 235)
CENTER(ME)
SHOW(ME)
BEGIN EVENTS
SELECT CASE CBMSG
CASE WM_LBUTTONDOWN: Rhombus() ' Draw
CASE WM_CLOSE: FBSL.RELEASEDC(ME, FBSL.GETDC) ' Clean up
END SELECT
END EVENTS
SUB Rhombus()
Bresenham(50, 100, 100, 190)(100, 190, 150, 100)(150, 100, 100, 10)(100, 10, 50, 100)
SUB Bresenham(x0, y0, x1, y1)
DIM dx = ABS(x0 - x1), sx = SGN(x0 - x1)
DIM dy = ABS(y0 - y1), sy = SGN(y0 - y1)
DIM tmp, er = IIF(dx > dy, dx, -dy) / 2
WHILE NOT (x0 = x1 ANDALSO y0 = y1)
PSET(FBSL.GETDC, x0, y0, &HFF) ' Red: Windows stores colors in BGR order
tmp = er
IF tmp > -dx THEN: er = er - dy: x0 = x0 + sx: END IF
IF tmp < +dy THEN: er = er + dx: y0 = y0 + sy: END IF
WEND
END SUB
END SUB

View file

@ -0,0 +1,33 @@
#lang racket
(require racket/draw)
(define (draw-line dc x0 y0 x1 y1)
(define dx (abs (- x1 x0)))
(define dy (abs (- y1 y0)))
(define sx (if (> x0 x1) -1 1))
(define sy (if (> y0 y1) -1 1))
(cond
[(> dx dy)
(let loop ([x x0] [y y0] [err (/ dx 2.0)])
(unless (= x x1)
(send dc draw-point x y)
(define newerr (- err dy))
(if (< newerr 0)
(loop (+ x sx) (+ y sy) (+ newerr dx))
(loop (+ x sx) y newerr))))]
[else
(let loop ([x x0] [y y0] [err (/ dy 2.0)])
(unless (= y y1)
(send dc draw-point x y)
(define newerr (- err dy))
(if (< newerr 0)
(loop (+ x sx) (+ y sy) newerr)
(loop x (+ y sy) (+ newerr dy)))))]))
(define bm (make-object bitmap% 17 17))
(define dc (new bitmap-dc% [bitmap bm]))
(send dc set-smoothing 'unsmoothed)
(send dc set-pen "red" 1 'solid)
(for ([points '((1 8 8 16) (8 16 16 8) (16 8 8 1) (8 1 1 8))])
(apply draw-line (cons dc points)))
bm