[ create a new paste ] login | about

Link: http://codepad.org/2mCJTrNY    [ raw code | fork ]

hurracane - Scheme, pasted on Dec 19:
(define getX (lambda (vec)
               (caadr vec)))
(define getY (lambda (vec)
               (cdr (cadr vec))))
(define makeVec (lambda (x y)
                  (list 'vector (cons x y))))
(define (fill-rectangle-rotated! x bad-y width bad-height colour degrees rotation-origin calcVec)
  ;http://nl.wikipedia.org/wiki/Rotatie_(tweedimensionaal)
  ;(x', y') = ((x-a)cos φ − (y-b)sin φ, (x-a)sin φ + (y-b)cos φ).
  (define a (getX rotation-origin))
  (define b (getY rotation-origin))
  (define (rotate x y radians)
    (cons (+ (- (* (- x a) (cos radians)) (* (- y b) (sin radians))) a)
          (+ (+ (* (- x a) (sin radians)) (* (- y b) (cos radians))) b)))
  (let* ((y (- Pixels-y bad-y))
         (height (- bad-height))
         (pos1 (my-make-posn 0 height)) ; original rectangle without rotiation
         (pos2 (my-make-posn width height))
         (pos3 (my-make-posn width 0))
         (pos4 (my-make-posn 0 0))
         (offset (my-make-posn x y))
         (rads (degrees->radians degrees))
         (pos1-rotated (my-make-posn (car (rotate 0 height rads))
                                     (cdr (rotate 0 height rads))))
         (pos2-rotated (my-make-posn (car (rotate width height rads))
                                     (cdr (rotate width height rads))))
         (pos3-rotated (my-make-posn (car (rotate width 0 rads))
                                     (cdr (rotate width 0 rads))))
         (pos4-rotated (my-make-posn 0 0)))
    
    ;display original rectangle without rotation
    ((draw-solid-polygon MainWindow) (list pos1 pos2 pos3 pos4) offset "black")
    ;display rotated
    ((draw-solid-polygon MainWindow) (list pos1-rotated pos2-rotated pos3-rotated pos4-rotated) offset "red")))


Create a new paste based on this one


Comments: