2 Point Gradient

[bplus]

It's almost plasma like!

Code: QB64: [Select]

1. _TITLE "2 point gradient"
2.  
3. DEFLNG A-Z
4. CONST wW = 800
5. CONST wH = 600
6. SCREEN _NEWIMAGE(wW, wH, 32)
7. _SCREENMOVE 200, 40
8. d = 1
9. k1 = _RGB32(128, 0, 0)
10. k2 = _RGB(0, 128, 255)
11.  
12. 'test 2 point gradient
13. WHILE NOT _KEYDOWN(27)
14.     twoPtGrad 100, 100, 600, 400, RND * wW, RND * wH, RND * wW, RND * wH, k1, k2
15.     _DISPLAY
16.     _LIMIT 5
17. WEND
18.  
19. SUB twoPtGrad (x0, y0, w, h, x1, y1, x2, y2, c1, c2)
20.     FOR y = y0 TO y0 + h
21.         FOR x = x0 TO x0 + w
22.             d1 = ((x1 - x) ^ 2 + (y1 - y) ^ 2) ^ .5
23.             d2 = ((x2 - x) ^ 2 + (y2 - y) ^ 2) ^ .5
24.             midInk c1, c2, d1 / (d1 + d2)
25.             PSET (x, y)
26.         NEXT
27.     NEXT
28. END SUB
29.  
30. 'c1 color to left, c2 color to right
31. SUB horzGradRec (x0, y0, w, h, c1, c2)
32.     FOR cx = 0 TO w
33.         midInk c1, c2, cx / w
34.         LINE (x0 + cx, y0)-STEP(0, h), , BF
35.     NEXT
36. END SUB
37.  
38. SUB vertGradRec (x0, y0, w, h, c1, c2)
39.     FOR cy = 0 TO h
40.         midInk c1, c2, cy / h
41.         LINE (x0, y0 + cy)-STEP(w, 0), , BF
42.     NEXT
43. END SUB
44.  
45. 'let c1 be outer most color c2 the inner most
46. SUB gradCirc (x0, y0, r, c1, c2)
47.     FOR cr = r TO 0 STEP -1
48.         midInk c2, c1, cr / r
49.         fcirc x0, y0, cr
50.     NEXT
51. END SUB
52.  
53. ' let fr## be the fraction from 1st color to 2nd color 0 means all color 1, 1 means all color 2
54. SUB midInk (c1, c2, fr##)
55.     r1 = _RED(c1): g1 = _GREEN(c1): b1 = _BLUE(c1)
56.     r2 = _RED(c2): g2 = _GREEN(c2): b2 = _BLUE(c2)
57.     COLOR _RGB(r1 + (r2 - r1) * fr##, g1 + (g2 - g1) * fr##, b1 + (b2 - b1) * fr##)
58. END SUB
59.  
60. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
61.     DIM Radius AS LONG, RadiusError AS LONG
62.     DIM X AS LONG, Y AS LONG
63.  
64.     Radius = ABS(R)
65.     RadiusError = -Radius
66.     X = Radius
67.     Y = 0
68.  
69.     IF Radius = 0 THEN PSET (CX, CY): EXIT SUB
70.  
71.     ' Draw the middle span here so we don't draw it twice in the main loop,
72.     ' which would be a problem with blending turned on.
73.     LINE (CX - X, CY)-(CX + X, CY), , BF
74.  
75.     WHILE X > Y
76.         RadiusError = RadiusError + Y * 2 + 1
77.         IF RadiusError >= 0 THEN
78.             IF X <> Y + 1 THEN
79.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
80.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
81.             END IF
82.             X = X - 1
83.             RadiusError = RadiusError - X * 2
84.         END IF
85.         Y = Y + 1
86.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
87.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
88.     WEND
89.  
90. END SUB
91.  
92.  

Note: the points don't even have to be in the area displayed.

[bplus]

2 Point Gradient Swirl:

Code: QB64: [Select]

1. _TITLE "2 point gradient swirl"
2. DEFLNG A-Z
3. CONST wW = 800
4. CONST wH = 600
5. SCREEN _NEWIMAGE(wW, wH, 32)
6. _SCREENMOVE 200, 40
7. DIM SHARED a!
8. k1 = _RGB32(128, 0, 0)
9. k2 = _RGB32(0, 128, 255)
10. incr! = _PI(1 / 90)
11. p2! = _PI(4)
12. cx = wW / 2
13. cy = wH / 2
14. 'test 2 point gradient
15. WHILE NOT _KEYDOWN(27)
16.     a! = a! + incr!
17.     IF a! >= p2! THEN a! = 0: CLS
18.     x1 = cx + 15 * a! ^ 1.25 * COS(a! + _PI)
19.     y1 = cy + 15 * a! ^ 1.25 * SIN(a! + _PI)
20.     x2 = cx + 15 * a! ^ 1.25 * COS(a!)
21.     y2 = cy + 15 * a! ^ 1.25 * SIN(a!)
22.     twoPtGrad 150, 50, 500, 500, x1, y1, x2, y2, k1, k2
23.     _DISPLAY
24.     _LIMIT 10
25. WEND
26.  
27. SUB twoPtGrad (x0, y0, w, h, x1, y1, x2, y2, c1, c2)
28.     FOR y = y0 TO y0 + h
29.         FOR x = x0 TO x0 + w
30.             d1 = ((x1 - x) ^ 2 + (y1 - y) ^ 2) ^ .5
31.             d2 = ((x2 - x) ^ 2 + (y2 - y) ^ 2) ^ .5
32.             midInk c1, c2, d1 / (d1 + d2)
33.             PSET (x, y)
34.         NEXT
35.     NEXT
36. END SUB
37.  
38. 'c1 color to left, c2 color to right
39. SUB horzGradRec (x0, y0, w, h, c1, c2)
40.     FOR cx = 0 TO w
41.         midInk c1, c2, cx / w
42.         LINE (x0 + cx, y0)-STEP(0, h), , BF
43.     NEXT
44. END SUB
45.  
46. SUB vertGradRec (x0, y0, w, h, c1, c2)
47.     FOR cy = 0 TO h
48.         midInk c1, c2, cy / h
49.         LINE (x0, y0 + cy)-STEP(w, 0), , BF
50.     NEXT
51. END SUB
52.  
53. 'let c1 be outer most color c2 the inner most
54. SUB gradCirc (x0, y0, r, c1, c2)
55.     FOR cr = r TO 0 STEP -1
56.         midInk c2, c1, cr / r
57.         fcirc x0, y0, cr
58.     NEXT
59. END SUB
60.  
61. ' let fr## be the fraction from 1st color to 2nd color 0 means all color 1, 1 means all color 2
62. SUB midInk (c1, c2, fr##)
63.     r1 = _RED(c1): g1 = _GREEN(c1): b1 = _BLUE(c1)
64.     r2 = _RED(c2): g2 = _GREEN(c2): b2 = _BLUE(c2)
65.     COLOR _RGB32(r1 + (r2 - r1) * fr##, g1 + (g2 - g1) * fr##, b1 + (b2 - b1) * fr##, 3)
66. END SUB
67.  
68. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
69.     DIM Radius AS LONG, RadiusError AS LONG
70.     DIM X AS LONG, Y AS LONG
71.  
72.     Radius = ABS(R)
73.     RadiusError = -Radius
74.     X = Radius
75.     Y = 0
76.  
77.     IF Radius = 0 THEN PSET (CX, CY): EXIT SUB
78.  
79.     ' Draw the middle span here so we don't draw it twice in the main loop,
80.     ' which would be a problem with blending turned on.
81.     LINE (CX - X, CY)-(CX + X, CY), , BF
82.  
83.     WHILE X > Y
84.         RadiusError = RadiusError + Y * 2 + 1
85.         IF RadiusError >= 0 THEN
86.             IF X <> Y + 1 THEN
87.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
88.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
89.             END IF
90.             X = X - 1
91.             RadiusError = RadiusError - X * 2
92.         END IF
93.         Y = Y + 1
94.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
95.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
96.     WEND
97.  
98. END SUB
99.  
100.  

[keybone]

Nice gradients... Between the different ones people have written in the past few days we have quite a collection. :)