[ create a new paste ] login | about

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

hurracane - Scheme, pasted on Dec 21: 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85

;#####--------------------##########--------------------#####
;#####-------------------Added by Sam-------------------#####
;#####--------------------##########--------------------#####

;Todo: add support for colours as represented in the rest of the code
;I probably have to convert integers to strings.

;Original positions which don't even make sense
;|------------|
;|(0,0)  (x,0)|
;|            |
;|            |
;|(0,y)  (x,y)|
;|------------|
;
;What it should actually be like with the origin where it makes much more sense
;-Relative to the 'wrong' origin
;-h = window height
;|---------------|
;|(0,h-y) (x,h-y)|
;|               |
;|               |
;|(0,0)     (x,0)|
;|---------------|

(define (degrees->radians deg)
  (* deg (/ pi 180)))

(define makeVec cons)
(define getX car)
(define getY cdr)

;orig is the origin of the vector
;rotate-orig is the origin around which the rotation should happen
;alpha should be converted to radians first, because degrees are so much better but radians are expected
;returns the new position of the vector after rotation
(define (rotateVec alpha orig rotate-orig)
  (let ((old-x (getX orig))
        (old-y (getY orig))
        (rotate-x (getX rotate-orig))
        (rotate-y (getY rotate-orig))
        (radians (degrees->radians alpha)))
    (makeVec (+ (- (* (- old-x rotate-x) (cos radians))
                   (* (- old-y rotate-y) (sin radians)))
                rotate-x)
             (+ (+ (* (- old-x rotate-x) (sin radians))
                   (* (- old-y rotate-y) (cos radians)))
                rotate-y))))
(define (make-rectangle x y width height angle rotate-x rotate-y colour)
  (let* ((pos1 (makeVec x y))
         (pos2 (makeVec (+ x width) y))
         (pos3 (makeVec x (+ y height)))
         (pos4 (makeVec (+ x width) (+ y height)))
         (rotateOrig (makeVec rotate-x rotate-y))
         (pos1-rotated (rotateVec angle pos1 rotateOrig))
         (pos2-rotated (rotateVec angle pos2 rotateOrig))
         (pos3-rotated (rotateVec angle pos3 rotateOrig))
         (pos4-rotated (rotateVec angle pos4 rotateOrig)))
    
    (draw-line! (getX pos1) (getY pos1) (getX pos2) (getY pos2) colour)
    (draw-line! (getX pos1) (getY pos1) (getX pos3) (getY pos3) colour)
    (draw-line! (getX pos2) (getY pos2) (getX pos4) (getY pos4) colour)
    (draw-line! (getX pos3) (getY pos3) (getX pos4) (getY pos4) colour)
    
    (draw-line! (getX pos1-rotated) (getY pos1-rotated) (getX pos2-rotated) (getY pos2-rotated) colour)
    (draw-line! (getX pos1-rotated) (getY pos1-rotated) (getX pos3-rotated) (getY pos3-rotated) colour)
    (draw-line! (getX pos2-rotated) (getY pos2-rotated) (getX pos4-rotated) (getY pos4-rotated) colour)
    (draw-line! (getX pos3-rotated) (getY pos3-rotated) (getX pos4-rotated) (getY pos4-rotated) colour)
    
    ((draw-solid-polygon MainWindow)
     (list (my-make-posn (getX pos3-rotated)
                         (getY pos3-rotated))
           (my-make-posn (getX pos4-rotated)
                         (getY pos4-rotated))
           (my-make-posn (getX pos2-rotated)
                         (getY pos2-rotated))
           (my-make-posn (getX pos1-rotated)
                         (getY pos1-rotated)))
     (my-make-posn 0 495)
     (12bitColor2rgb (make-color 15 0 0)))))

(define rectangle (make-rectangle 100 100 25 100 -45 112.5 100 (make-color 0 0 0)))
;#####--------------------##########--------------------#####
;#####--------------------------------------------------#####
;#####--------------------##########--------------------#####


Create a new paste based on this one


Comments: