Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: keybone on July 06, 2018, 08:33:17 am

Title: Dithering samples
Post by: keybone on July 06, 2018, 08:33:17 am
Post Deleted
Title: Re: Dithering samples
Post by: bplus on July 08, 2018, 12:48:57 pm
For a more moving experience, I diddled with dither:
Code: QB64: [Select]
  1. _TITLE "Dither by keybone diddled by bplus 2018-07-08"
  2. SCREEN _NEWIMAGE(640, 480, 32)
  3. m = 11
  5.     r = (r + 1) MOD m
  6.     ditherCheckerbox r, m, _RGBA32(255, 0, 0, 255), _RGBA32(0, 0, 0, 255)
  7.     'ditherColumns r, m, _RGBA32(255, 0, 0, 255), _RGBA32(0, 0, 255, 255)
  8.     'ditherLines r, m, _RGBA32(255, 0, 0, 255), _RGBA32(0, 0, 0, 255)
  9.     _DISPLAY
  10.     _LIMIT 20
  12.  
  13. SUB ditherCheckerbox (remainder AS INTEGER, modulus AS INTEGER, color1 AS _UNSIGNED LONG, color2 AS _UNSIGNED LONG)
  14.     startLine = 1
  15.     FOR j = 1 TO _HEIGHT
  16.         yr = (j + remainder) MOD modulus
  17.         IF yr MOD modulus = 0 THEN
  18.             FOR i = 1 TO _WIDTH
  19.                 xr = (i + remainder) MOD modulus
  20.                 IF xr MOD modulus THEN
  21.                     PSET (i, j), color2
  22.                 ELSE
  23.                     PSET (i, j), color1
  24.                 END IF
  25.             NEXT i
  26.         ELSE
  27.             FOR i = 1 TO _WIDTH
  28.                 xr = (i + remainder) MOD modulus
  29.                 IF xr MOD modulus = 0 THEN
  30.                     PSET (i, j), color2
  31.                 ELSE
  32.                     PSET (i, j), color1
  33.                 END IF
  34.             NEXT i
  35.         END IF
  36.     NEXT j
  38.  
  39. SUB ditherColumns (remainder AS INTEGER, modulus AS INTEGER, color1 AS _UNSIGNED LONG, color2 AS _UNSIGNED LONG)
  40.     FOR j = 1 TO _HEIGHT
  41.         FOR i = 1 TO _WIDTH
  42.             xr = (i + remainder) MOD modulus
  43.             IF xr MOD modulus = 0 THEN
  44.                 PSET (i, j), color2
  45.             ELSE
  46.                 PSET (i, j), color1
  47.             END IF
  48.         NEXT i
  49.     NEXT j
  51.  
  52. SUB ditherLines (remainder AS INTEGER, modulus AS INTEGER, color1 AS _UNSIGNED LONG, color2 AS _UNSIGNED LONG)
  53.     FOR j = 1 TO _HEIGHT
  54.         yr = (j + remainder) MOD modulus
  55.         FOR i = 1 TO _WIDTH
  56.             IF yr MOD modulus = 0 THEN
  57.                 PSET (i, j), color2
  58.             ELSE
  59.                 PSET (i, j), color1
  60.             END IF
  61.         NEXT i
  62.     NEXT j
  64.  
Title: Re: Dithering samples
Post by: _vince on July 16, 2018, 05:33:43 am
gradient example
Title: Re: Dithering samples
Post by: bplus on July 16, 2018, 11:56:18 pm
I guess I will get to dithering later, first I wanted to make the gradient.

Quiz: Can anyone explain what's happening in the first column?
Code: QB64: [Select]
  1. _TITLE "Making the Gradient"
  2.  
  3. DEFLNG A-Z
  4. CONST w = 800
  5. CONST h = 600
  6. SCREEN _NEWIMAGE(w, h, 32)
  7. d = 1
  8. k1 = _RGB32(128, 0, 0)
  9. k2 = _RGB(0, 128, 255)
  10. stepper = 300
  12.     FOR y = 0 TO h - 1 STEP stepper
  13.         FOR x = 0 TO w - 1 STEP stepper
  14.             IF y MOD 2 * stepper THEN
  15.                 IF x MOD 2 * stepper THEN
  16.                     IF x MOD 4 * stepper = 3 * stepper THEN c1 = k1: c2 = k2 ELSE c1 = k2: c2 = k1
  17.                     horzGradRec x, y, stepper, stepper, c1, c2
  18.                     gradCirc x + stepper / 2, y + stepper / 2, stepper \ 3, k2, k1
  19.                 ELSE
  20.                     vertGradRec x, y, stepper, stepper, c2, c1
  21.                     gradCirc x + stepper / 2, y + stepper / 2, stepper \ 3, k1, k2
  22.                 END IF
  23.             ELSE
  24.                 IF x MOD 2 * stepper THEN
  25.                     vertGradRec x, y, stepper, stepper, c2, c1
  26.                     gradCirc x + stepper / 2, y + stepper / 2, stepper \ 3, k1, k2
  27.                 ELSE
  28.                     IF x MOD 4 * stepper = 2 * stepper THEN c1 = k1: c2 = k2 ELSE c1 = k2: c2 = k1
  29.                     horzGradRec x, y, stepper, stepper, c2, c1
  30.                     gradCirc x + stepper / 2, y + stepper / 2, stepper \ 3, k2, k1
  31.                 END IF
  32.             END IF
  33.         NEXT
  34.     NEXT
  35.     stepper = stepper - 2 * d
  36.     IF stepper < 10 OR stepper > 300 THEN d = d * -1
  37.     _DISPLAY
  38.     _LIMIT 8
  40.  
  41. 'c1 color to left, c2 color to right
  42. SUB horzGradRec (x0, y0, w, h, c1, c2)
  43.     FOR cx = 0 TO w
  44.         midInk c1, c2, cx / w
  45.         LINE (x0 + cx, y0)-STEP(0, h), , BF
  46.     NEXT
  48.  
  49. SUB vertGradRec (x0, y0, w, h, c1, c2)
  50.     FOR cy = 0 TO h
  51.         midInk c1, c2, cy / h
  52.         LINE (x0, y0 + cy)-STEP(w, 0), , BF
  53.     NEXT
  55.  
  56. 'let c1 be outer most color c2 the inner most
  57. SUB gradCirc (x0, y0, r, c1, c2)
  58.     FOR cr = r TO 0 STEP -1
  59.         midInk c2, c1, cr / r
  60.         fcirc x0, y0, cr
  61.     NEXT
  63.  
  64. ' let fr## be the fraction from 1st color to 2nd color 0 means all color 1, 1 means all color 2
  65. SUB midInk (c1, c2, fr##)
  66.     r1 = _RED(c1): g1 = _GREEN(c1): b1 = _BLUE(c1)
  67.     r2 = _RED(c2): g2 = _GREEN(c2): b2 = _BLUE(c2)
  68.     COLOR _RGB(r1 + (r2 - r1) * fr##, g1 + (g2 - g1) * fr##, b1 + (b2 - b1) * fr##)
  70.  
  71. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  72.     DIM Radius AS LONG, RadiusError AS LONG
  73.     DIM X AS LONG, Y AS LONG
  74.  
  75.     Radius = ABS(R)
  76.     RadiusError = -Radius
  77.     X = Radius
  78.     Y = 0
  79.  
  80.     IF Radius = 0 THEN PSET (CX, CY): EXIT SUB
  81.  
  82.     ' Draw the middle span here so we don't draw it twice in the main loop,
  83.     ' which would be a problem with blending turned on.
  84.     LINE (CX - X, CY)-(CX + X, CY), , BF
  85.  
  86.     WHILE X > Y
  87.         RadiusError = RadiusError + Y * 2 + 1
  88.         IF RadiusError >= 0 THEN
  89.             IF X <> Y + 1 THEN
  90.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  91.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  92.             END IF
  93.             X = X - 1
  94.             RadiusError = RadiusError - X * 2
  95.         END IF
  96.         Y = Y + 1
  97.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  98.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  99.     WEND
  100.  
  102.  
  103.  
Title: Re: Dithering samples
Post by: bplus on July 17, 2018, 10:40:11 am
Dang, I just noticed, I am missing a couple of 32's for _rgb32(...) not _rgb(...).
Title: Re: Dithering samples
Post by: keybone on July 31, 2018, 03:46:16 am
Quote from: v on July 16, 2018, 05:33:43 am
gradient example

I was bored so I made a test pattern using these routines.

I overlaid a grayscale gradient with a few translucent LINE … BF statements to get this effects. Afterwards the whole image is dithered.
I might use this effect in my gui ive been programming. :)
Text Only | Text with Attachments