Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on August 03, 2018, 10:47:10 pm

Title: 2 Point Gradient
Post by: bplus on August 03, 2018, 10:47:10 pm
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
  14.     twoPtGrad 100, 100, 600, 400, RND * wW, RND * wH, RND * wW, RND * wH, k1, k2
  15.     _DISPLAY
  16.     _LIMIT 5
  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
  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
  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
  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
  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##)
  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.  
  91.  
  92.  

Note: the points don't even have to be in the area displayed.
Title: Re: 2 Point Gradient
Post by: bplus on August 04, 2018, 12:17:12 am
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
  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
  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
  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
  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
  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
  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
  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)
  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.  
  99.  
  100.  
Title: Re: 2 Point Gradient
Post by: keybone on August 04, 2018, 04:09:57 am
Nice gradients... Between the different ones people have written in the past few days we have quite a collection. :)
Text Only | Text with Attachments