« previous next »
Pages: [1]

Author Topic: Dithering samples  (Read 384 times)

Offline keybone

  • My name a Nursultan Tulyakbay. I get iPod Mini!
Dithering samples
« on: July 06, 2018, 08: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.
Logged
My neighbor Borat he a pain in my assholes. I get a window from a glass, he get a window from a glass. I get a step, he must get a step. He get clock radio I cannot afford!

Offline bplus

Re: Dithering samples
« Reply #1 on: July 08, 2018, 12: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
Logged
B = B + ...

Offline keybone

  • My name a Nursultan Tulyakbay. I get iPod Mini!
Re: Dithering samples
« Reply #2 on: July 09, 2018, 01:38:33 AM »
Quote from: bplus on July 08, 2018, 12: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.
Logged
My neighbor Borat he a pain in my assholes. I get a window from a glass, he get a window from a glass. I get a step, he must get a step. He get clock radio I cannot afford!

Offline _vince

Re: Dithering samples
« Reply #3 on: July 16, 2018, 05:33:43 AM »
gradient example
Logged

Offline bplus

Re: Dithering samples
« Reply #4 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: [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

Logged
B = B + ...

Offline bplus

Re: Dithering samples
« Reply #5 on: July 17, 2018, 10:40:11 AM »
Dang, I just noticed, I am missing a couple of 32's for _rgb32(...) not _rgb(...).
Logged
B = B + ...

Offline keybone

  • My name a Nursultan Tulyakbay. I get iPod Mini!
Re: Dithering samples
« Reply #6 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. :)
« Last Edit: July 31, 2018, 03:53:05 AM by keybone »
Logged
My neighbor Borat he a pain in my assholes. I get a window from a glass, he get a window from a glass. I get a step, he must get a step. He get clock radio I cannot afford!
Pages: [1]
« previous next »