Author Topic: Dithering samples (Read 98 times)

keybone · « **on:** July 06, 2018, 09:33:17 AM »

Hey everyone, I created this when I had a few minutes to kill... :)

Just a few subroutines that draw out a few dithering patterns...
Probably end up using it for my gui in some shape or form.

With today's 32-bit color modes, it doesnt have much of a point but it looks cool.

bplus · « **Reply #1 on:** July 08, 2018, 01:48:57 PM »

For a more moving experience, I diddled with dither:

Code: [Select]

_TITLE "Dither by keybone diddled by bplus 2018-07-08"
SCREEN _NEWIMAGE(640, 480, 32)
m = 11
WHILE LEN(INKEY$) = 0
    r = (r + 1) MOD m
    ditherCheckerbox r, m, _RGBA32(255, 0, 0, 255), _RGBA32(0, 0, 0, 255)
    'ditherColumns r, m, _RGBA32(255, 0, 0, 255), _RGBA32(0, 0, 255, 255)
    'ditherLines r, m, _RGBA32(255, 0, 0, 255), _RGBA32(0, 0, 0, 255)
    _DISPLAY
    _LIMIT 20
WEND

SUB ditherCheckerbox (remainder AS INTEGER, modulus AS INTEGER, color1 AS _UNSIGNED LONG, color2 AS _UNSIGNED LONG)
    startLine = 1
    FOR j = 1 TO _HEIGHT
        yr = (j + remainder) MOD modulus
        IF yr MOD modulus = 0 THEN
            FOR i = 1 TO _WIDTH
                xr = (i + remainder) MOD modulus
                IF xr MOD modulus THEN
                    PSET (i, j), color2
                ELSE
                    PSET (i, j), color1
                END IF
            NEXT i
        ELSE
            FOR i = 1 TO _WIDTH
                xr = (i + remainder) MOD modulus
                IF xr MOD modulus = 0 THEN
                    PSET (i, j), color2
                ELSE
                    PSET (i, j), color1
                END IF
            NEXT i
        END IF
    NEXT j
END SUB

SUB ditherColumns (remainder AS INTEGER, modulus AS INTEGER, color1 AS _UNSIGNED LONG, color2 AS _UNSIGNED LONG)
    FOR j = 1 TO _HEIGHT
        FOR i = 1 TO _WIDTH
            xr = (i + remainder) MOD modulus
            IF xr MOD modulus = 0 THEN
                PSET (i, j), color2
            ELSE
                PSET (i, j), color1
            END IF
        NEXT i
    NEXT j
END SUB

SUB ditherLines (remainder AS INTEGER, modulus AS INTEGER, color1 AS _UNSIGNED LONG, color2 AS _UNSIGNED LONG)
    FOR j = 1 TO _HEIGHT
        yr = (j + remainder) MOD modulus
        FOR i = 1 TO _WIDTH
            IF yr MOD modulus = 0 THEN
                PSET (i, j), color2
            ELSE
                PSET (i, j), color1
            END IF
        NEXT i
    NEXT j
END SUB

keybone · « **Reply #2 on:** July 09, 2018, 02:38:33 AM »

Quote from: bplus on July 08, 2018, 01:48:57 PM

For a more moving experience, I diddled with dither:
Code: [Select]
_TITLE "Dither by keybone diddled by bplus 2018-07-08" SCREEN _NEWIMAGE(640, 480, 32) m = 11 WHILE LEN(INKEY$) = 0 r = (r + 1) MOD m ditherCheckerbox r, m, _RGBA32(255, 0, 0, 255), _RGBA32(0, 0, 0, 255) 'ditherColumns r, m, _RGBA32(255, 0, 0, 255), _RGBA32(0, 0, 255, 255) 'ditherLines r, m, _RGBA32(255, 0, 0, 255), _RGBA32(0, 0, 0, 255) _DISPLAY _LIMIT 20 WEND SUB ditherCheckerbox (remainder AS INTEGER, modulus AS INTEGER, color1 AS _UNSIGNED LONG, color2 AS _UNSIGNED LONG) startLine = 1 FOR j = 1 TO _HEIGHT yr = (j + remainder) MOD modulus IF yr MOD modulus = 0 THEN FOR i = 1 TO _WIDTH xr = (i + remainder) MOD modulus IF xr MOD modulus THEN PSET (i, j), color2 ELSE PSET (i, j), color1 END IF NEXT i ELSE FOR i = 1 TO _WIDTH xr = (i + remainder) MOD modulus IF xr MOD modulus = 0 THEN PSET (i, j), color2 ELSE PSET (i, j), color1 END IF NEXT i END IF NEXT j END SUB SUB ditherColumns (remainder AS INTEGER, modulus AS INTEGER, color1 AS _UNSIGNED LONG, color2 AS _UNSIGNED LONG) FOR j = 1 TO _HEIGHT FOR i = 1 TO _WIDTH xr = (i + remainder) MOD modulus IF xr MOD modulus = 0 THEN PSET (i, j), color2 ELSE PSET (i, j), color1 END IF NEXT i NEXT j END SUB SUB ditherLines (remainder AS INTEGER, modulus AS INTEGER, color1 AS _UNSIGNED LONG, color2 AS _UNSIGNED LONG) FOR j = 1 TO _HEIGHT yr = (j + remainder) MOD modulus FOR i = 1 TO _WIDTH IF yr MOD modulus = 0 THEN PSET (i, j), color2 ELSE PSET (i, j), color1 END IF NEXT i NEXT j END SUB

Nice!! It even works if you switch it to either of the line routines :)
It would be cool if it randomly changed directions.

v · « **Reply #3 on:** July 16, 2018, 06:33:43 AM »

gradient example

bplus · « **Reply #4 on:** July 17, 2018, 12:56:18 AM »

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: [Select]

_TITLE "Making the Gradient"

DEFLNG A-Z
CONST w = 800
CONST h = 600
SCREEN _NEWIMAGE(w, h, 32)
d = 1
k1 = _RGB32(128, 0, 0)
k2 = _RGB(0, 128, 255)
stepper = 300
WHILE 1
    FOR y = 0 TO h - 1 STEP stepper
        FOR x = 0 TO w - 1 STEP stepper
            IF y MOD 2 * stepper THEN
                IF x MOD 2 * stepper THEN
                    IF x MOD 4 * stepper = 3 * stepper THEN c1 = k1: c2 = k2 ELSE c1 = k2: c2 = k1
                    horzGradRec x, y, stepper, stepper, c1, c2
                    gradCirc x + stepper / 2, y + stepper / 2, stepper \ 3, k2, k1
                ELSE
                    vertGradRec x, y, stepper, stepper, c2, c1
                    gradCirc x + stepper / 2, y + stepper / 2, stepper \ 3, k1, k2
                END IF
            ELSE
                IF x MOD 2 * stepper THEN
                    vertGradRec x, y, stepper, stepper, c2, c1
                    gradCirc x + stepper / 2, y + stepper / 2, stepper \ 3, k1, k2
                ELSE
                    IF x MOD 4 * stepper = 2 * stepper THEN c1 = k1: c2 = k2 ELSE c1 = k2: c2 = k1
                    horzGradRec x, y, stepper, stepper, c2, c1
                    gradCirc x + stepper / 2, y + stepper / 2, stepper \ 3, k2, k1
                END IF
            END IF
        NEXT
    NEXT
    stepper = stepper - 2 * d
    IF stepper < 10 OR stepper > 300 THEN d = d * -1
    _DISPLAY
    _LIMIT 8
WEND

'c1 color to left, c2 color to right
SUB horzGradRec (x0, y0, w, h, c1, c2)
    FOR cx = 0 TO w
        midInk c1, c2, cx / w
        LINE (x0 + cx, y0)-STEP(0, h), , BF
    NEXT
END SUB

SUB vertGradRec (x0, y0, w, h, c1, c2)
    FOR cy = 0 TO h
        midInk c1, c2, cy / h
        LINE (x0, y0 + cy)-STEP(w, 0), , BF
    NEXT
END SUB

'let c1 be outer most color c2 the inner most
SUB gradCirc (x0, y0, r, c1, c2)
    FOR cr = r TO 0 STEP -1
        midInk c2, c1, cr / r
        fcirc x0, y0, cr
    NEXT
END SUB

' let fr## be the fraction from 1st color to 2nd color 0 means all color 1, 1 means all color 2
SUB midInk (c1, c2, fr##)
    r1 = _RED(c1): g1 = _GREEN(c1): b1 = _BLUE(c1)
    r2 = _RED(c2): g2 = _GREEN(c2): b2 = _BLUE(c2)
    COLOR _RGB(r1 + (r2 - r1) * fr##, g1 + (g2 - g1) * fr##, b1 + (b2 - b1) * fr##)
END SUB

SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
    DIM Radius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG

    Radius = ABS(R)
    RadiusError = -Radius
    X = Radius
    Y = 0

    IF Radius = 0 THEN PSET (CX, CY): EXIT SUB

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    LINE (CX - X, CY)-(CX + X, CY), , BF

    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    WEND

END SUB

bplus · « **Reply #5 on:** July 17, 2018, 11:40:11 AM »

Dang, I just noticed, I am missing a couple of 32's for _rgb32(...) not _rgb(...).

News:

Author Topic: Dithering samples (Read 98 times)

keybone

Dithering samples

bplus

Re: Dithering samples

keybone

Re: Dithering samples

v

Re: Dithering samples

bplus

Re: Dithering samples

bplus

Re: Dithering samples