Author Topic: Cube Wave  (Read 423 times)

Offline Ashish

  • The joy of coding is endless.
Cube Wave
« on: March 12, 2018, 01:34:58 PM »
Hello everyone! :D
Now the harmonic motion comes in 3D. :)
Enjoy the cube waves.

Code: [Select]
'Coded by Ashish on 12 March, 2018
'Originally By @BeesandBombs
'https://youtu.be/H81Tdrmz2LA

_TITLE "Cube Wave"

SCREEN _NEWIMAGE(800, 600, 32)

TYPE vec4
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
    w AS SINGLE
END TYPE

TYPE vec3
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
END TYPE

DECLARE LIBRARY
    'for camera
    SUB gluLookAt (BYVAL eyeX#, BYVAL eyeY#, BYVAL eyeZ#, BYVAL centerX#, BYVAL centerY#, BYVAL centerZ#, BYVAL upX#, BYVAL upY#, BYVAL upZ#)
END DECLARE

DIM SHARED glAllow AS _BYTE
DIM SHARED cubeSize
cubeSize = .2

_GLRENDER _BEHIND
glAllow = -1
DO
    _DISPLAY
    _LIMIT 40
LOOP



SUB _GL ()
    STATIC glInit, aspect#, clock#, angOff#

    DIM lightAmb AS vec3, lightDiff AS vec3, lightSpec AS vec3, lightPos AS vec4
    DIM matAmb AS vec3, matDiff AS vec3, matSpec AS vec3, matShin AS SINGLE

    'light color settings
    lightAmb.x = .2: lightDiff.x = .79: lightSpec.x = .99
    lightAmb.y = .2: lightDiff.y = .79: lightSpec.x = .99
    lightAmb.z = .2: lightDiff.z = .79: lightSpec.x = .99
    'light direction settings ,when w=0 it is directional light, when w =1, it is a point light
    lightPos.x = 0
    lightPos.y = 0
    lightPos.z = 1
    lightPos.w = 0
    'material settings
    'try to play with it! but the value of any of these must be between 0 and 1.
    matAmb.x = .4: matDiff.x = .7: matSpec.x = .999
    matAmb.y = .7: matDiff.y = 1: matSpec.y = .999
    matAmb.z = .7: matDiff.z = 1: matSpec.z = .999
    matShin = .6
    '

    IF NOT glAllow THEN EXIT SUB

    _glEnable _GL_DEPTH_TEST

    IF NOT glInit THEN
        glInit = -1
        aspect# = _WIDTH / _HEIGHT
        _glViewport 0, 0, _WIDTH, _HEIGHT
    END IF

    'setuping light
    _glEnable _GL_LIGHTING
    _glEnable _GL_LIGHT0
    addLight _GL_LIGHT0, lightAmb, lightSpec, lightDiff, lightPos

    _glMatrixMode _GL_PROJECTION
    _glLoadIdentity
    'we will be using orthographic projection
    _glOrtho -5, 5, -5, 5, -5, 5

    _glMatrixMode _GL_MODELVIEW
    _glLoadIdentity

    _glTranslatef 0, 0, 0
    _glRotatef 45, 0, 1, 0
    _glRotatef 23, 0, 0, 1

    'give our materials.
    setMaterial matAmb, matSpec, matDiff, matShin

    'draw our cubes
    FOR z = -3 TO 3 STEP cubeSize + cubeSize / 1.5
        FOR x = -3 TO 3 STEP cubeSize + cubeSize / 1.5
            d = dist(0, 0, x, z) 'angle will be shifted according to the distance from the center, i.e., (0,0,0)
            offset = map(d, 0, SQR(18), _PI, -_PI)

            s# = map(SIN(offset + angOff#), -1, 1, 1, 4)

            _glPushMatrix

            _glTranslatef x, 0, z
            drawBox cubeSize, s#, cubeSize

            _glPopMatrix
        NEXT x
    NEXT z

    _glFlush
    angOff# = angOff# + .07
    clock# = clock# + .01
END SUB


SUB addLight (light, ambient AS vec3, specular AS vec3, diffuse AS vec3, __pos AS vec4)
    _glLightfv light, _GL_AMBIENT, glVec3(ambient.x, ambient.y, ambient.z)
    _glLightfv light, _GL_SPECULAR, glVec3(specular.x, specular.y, specular.z)
    _glLightfv light, _GL_DIFFUSE, glVec3(diffuse.x, diffuse.y, diffuse.z)
    _glLightfv light, _GL_POSITION, glVec4(__pos.x, __pos.y, __pos.z, __pos.w)
END SUB

SUB setMaterial (ambient AS vec3, specular AS vec3, diffuse AS vec3, shineness AS SINGLE)
    _glMaterialfv _GL_FRONT, _GL_AMBIENT, glVec3(ambient.x, ambient.y, ambient.z)
    _glMaterialfv _GL_FRONT, _GL_DIFFUSE, glVec3(diffuse.x, diffuse.y, diffuse.z)
    _glMaterialfv _GL_FRONT, _GL_SPECULAR, glVec3(specular.x, specular.y, specular.z)
    _glMaterialfv _GL_FRONT, _GL_SHININESS, glVec3(128 * shineness, 0, 0)
END SUB

'sub to draw a custom box with given width, height and depth.
SUB drawBox (w, h, d)
    _glPushMatrix
    _glBegin _GL_QUADS
    'front
    _glNormal3f 0, 0, 1
    _glVertex3f -w / 2, h / 2, d / 2
    _glVertex3f w / 2, h / 2, d / 2
    _glVertex3f w / 2, -h / 2, d / 2
    _glVertex3f -w / 2, -h / 2, d / 2
    'back
    _glNormal3f 0, 0, -1
    _glVertex3f -w / 2, h / 2, -d / 2
    _glVertex3f w / 2, h / 2, -d / 2
    _glVertex3f w / 2, -h / 2, -d / 2
    _glVertex3f -w / 2, -h / 2, -d / 2
    'right
    _glNormal3f 1, 0, 0
    _glVertex3f w / 2, h / 2, d / 2
    _glVertex3f w / 2, h / 2, -d / 2
    _glVertex3f w / 2, -h / 2, -d / 2
    _glVertex3f w / 2, -h / 2, d / 2
    'left
    _glNormal3f -1, 0, 0
    _glVertex3f -w / 2, h / 2, d / 2
    _glVertex3f -w / 2, h / 2, -d / 2
    _glVertex3f -w / 2, -h / 2, -d / 2
    _glVertex3f -w / 2, -h / 2, d / 2
    'top
    _glNormal3f 0, 1, 0
    _glVertex3f -w / 2, h / 2, d / 2
    _glVertex3f -w / 2, h / 2, -d / 2
    _glVertex3f w / 2, h / 2, -d / 2
    _glVertex3f w / 2, h / 2, d / 2
    'bottom
    _glNormal3f 0, -1, 0
    _glVertex3f -w / 2, -h / 2, d / 2
    _glVertex3f -w / 2, -h / 2, -d / 2
    _glVertex3f w / 2, -h / 2, -d / 2
    _glVertex3f w / 2, -h / 2, d / 2

    _glEnd
    _glPopMatrix
END SUB

'used for passing pointers to the OpenGL.
FUNCTION glVec3%& (x, y, z)
    STATIC internal_vec3(2)
    internal_vec3(0) = x
    internal_vec3(1) = y
    internal_vec3(2) = z
    glVec3%& = _OFFSET(internal_vec3())
END FUNCTION

FUNCTION glVec4%& (x, y, z, w)
    STATIC internal_vec4(3)
    internal_vec4(0) = x
    internal_vec4(1) = y
    internal_vec4(2) = z
    internal_vec4(3) = w
    glVec4%& = _OFFSET(internal_vec4())
END FUNCTION

'taken from p5js.bas
FUNCTION dist! (x1!, y1!, x2!, y2!)
    dist! = SQR((x2! - x1!) ^ 2 + (y2! - y1!) ^ 2)
END FUNCTION


FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION

if (Me.success) {Me.improve()} else {Me.tryAgain()}


aKFrameWork - http://bit.ly/aKFrameWork
Menu System - http://bit.ly/guiMenuBar
p5.js in QB64 - http://bit.ly/p5jsbas

@KingOfCoders

Re: Cube Wave
« Reply #1 on: March 13, 2018, 09:14:21 PM »
Once again I am inspired by Ashish example and attempt a similar thing from a different angle.

Here is Johnno's Gold Wave translated from SmallBASIC to QB64 in 2 ways:
1. First I tried the old fashioned way with line filled triangles.
2. Then I tried a very simple _MAPTRIANGLE method which turns out to be allot speedier if you remember _FREEIMAGE

Code: [Select]
_TITLE "Gold Wave bplus 2018-03-13"
'translated from SmallBASIC: Goldwave by johnno copied and mod by bplus 2018-01-28

'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
CONST xmax = 600
CONST ymax = 480
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60
DIM ccc AS _UNSIGNED LONG


'                  compare fill triangle subs:  one uses very simple  _MAPTRIANGLE opt = 1
'                                               2nd uses primative line graphic0s  opt <> 1


opt = 1 ' << opt 1 uses _MAPTRIANGLE to fill triangles, any other uses line filled triangles
WHILE 1
    FOR t = 1 TO 60 STEP .1 '< changed
        CLS 'changed
        FOR y1 = 0 TO 24
            FOR x1 = 0 TO 24
                x = (12 * (24 - x1)) + (12 * y1)
                y = (-6 * (24 - x1)) + (6 * y1) + 300
                d = ((10 - x1) ^ 2 + (10 - y1) ^ 2) ^ .5
                h = 60 * SIN(x1 / 4 + t) + 65
                IF t > 10 AND t < 20 THEN h = 60 * SIN(y1 / 4 + t) + 65
                IF t > 20 AND t < 30 THEN h = 60 * SIN((x1 - y1) / 4 + t) + 65
                IF t > 30 AND t < 40 THEN h = 30 * SIN(x1 / 2 + t) + 30 * SIN(y1 / 2 + t) + 65
                IF t > 40 AND t < 50 THEN h = 60 * SIN((x1 + y1) / 4 + t) + 65
                IF t > 50 AND t < 60 THEN h = 60 * SIN(d * .3 + t) + 65
                IF opt = 1 THEN
                    'TOP
                    ccc = _RGB32(242 + .1 * h, 242 + .1 * h, h)
                    filltri x, y - h, x + 10, y + 5 - h, x + 20, y - h, ccc
                    filltri x, y - h, x + 10, y - 5 - h, x + 20, y - h, ccc
                    'FRONT-LEFT
                    ccc = _RGB(255, 80, 0)
                    filltri x, y - h, x + 10, y + 5 - h, x + 10, y, ccc
                    filltri x, y - h, x, y - 5, x + 10, y, ccc
                    'FRONT-RIGHT
                    ccc = _RGB32(255, 150, 0)
                    filltri x + 10, y + 5 - h, x + 10, y, x + 20, y - 5, ccc
                    filltri x + 10, y + 5 - h, x + 20, y - h, x + 20, y - 5, ccc
                ELSE
                    COLOR _RGB32(242 + .1 * h, 242 + .1 * h, h)
                    filltri2 x, y - h, x + 10, y + 5 - h, x + 20, y - h
                    filltri2 x, y - h, x + 10, y - 5 - h, x + 20, y - h
                    'FRONT-LEFT
                    COLOR _RGB32(255, 80, 0)
                    filltri2 x, y - h, x + 10, y + 5 - h, x + 10, y
                    filltri2 x, y - h, x, y - 5, x + 10, y
                    COLOR _RGB32(255, 150, 0)
                    filltri2 x + 10, y + 5 - h, x + 10, y, x + 20, y - 5
                    filltri2 x + 10, y + 5 - h, x + 20, y - h, x + 20, y - 5
                END IF

                IF INKEY$ = CHR$(27) THEN END
            NEXT
        NEXT
        _DISPLAY
        _LIMIT 200  'to compare speeds
    NEXT
WEND

'Andy Amaya's modified FillTriangle
SUB filltri2 (xx1, yy1, xx2, yy2, xx3, yy3)
    'make copies before swapping
    x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2: x3 = xx3: y3 = yy3
    'thanks Andy Amaya!
    'triangle coordinates must be ordered: where x1 < x2 < x3
    IF x2 < x1 THEN SWAP x1, x2: SWAP y1, y2
    IF x3 < x1 THEN SWAP x1, x3: SWAP y1, y3
    IF x3 < x2 THEN SWAP x2, x3: SWAP y2, y3
    IF x1 <> x3 THEN slope1 = (y3 - y1) / (x3 - x1)

    'draw the first half of the triangle
    length = x2 - x1
    IF length <> 0 THEN
        slope2 = (y2 - y1) / (x2 - x1)
        FOR x = 0 TO length
            LINE (INT(x + x1), INT(x * slope1 + y1))-(INT(x + x1), INT(x * slope2 + y1))
            'lastx2% = lastx%
            lastx% = INT(x + x1)
        NEXT
    END IF

    'draw the second half of the triangle
    y = length * slope1 + y1: length = x3 - x2
    IF length <> 0 THEN
        slope3 = (y3 - y2) / (x3 - x2)
        FOR x = 0 TO length
            'IF INT(x + x2) <> lastx% AND INT(x + x2) <> lastx2% THEN  'works! but need 2nd? check
            IF INT(x + x2) <> lastx% THEN
                LINE (INT(x + x2), INT(x * slope1 + y))-(INT(x + x2), INT(x * slope3 + y2))
            END IF
        NEXT
    END IF
END SUB

' found at QB64.net:    http://www.qb64.net/forum/index.php?topic=14425.0
SUB filltri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
    a = _NEWIMAGE(1, 1, 32)
    _DEST a
    PSET (0, 0), K
    _DEST 0
    _MAPTRIANGLE (0, 0)-(0, 0)-(0, 0), a TO(x1, y1)-(x2, y2)-(x3, y3)
    _FREEIMAGE a '<<< this is important!
END SUB

B = B + ...
QB64 x 64 v1.2 2018 0228/86 git b30af92
QB64 v1.2 2018 0228/86 git b30af92
QB64 v1.1 2017 1106/82

Offline Ashish

  • The joy of coding is endless.
Re: Cube Wave
« Reply #2 on: March 14, 2018, 02:44:23 AM »
This is really cool bplus! I like it a lot!
« Last Edit: March 14, 2018, 10:17:48 AM by Ashish »
if (Me.success) {Me.improve()} else {Me.tryAgain()}


aKFrameWork - http://bit.ly/aKFrameWork
Menu System - http://bit.ly/guiMenuBar
p5.js in QB64 - http://bit.ly/p5jsbas

@KingOfCoders

Offline FellippeHeitor

  • QB64 Developer
  • LET IT = BE
    • QB64.org
Re: Cube Wave
« Reply #3 on: March 14, 2018, 09:40:48 AM »
Amazing results both with OpenGL and with pure QB64. Kudos to both of you guys. These are really cool.

Offline FellippeHeitor

  • QB64 Developer
  • LET IT = BE
    • QB64.org
Re: Cube Wave
« Reply #4 on: March 14, 2018, 10:14:43 AM »
My mod to gold wave to turn it into "Trippy Bedsheet Swing With Morphing Colors":

Code: [Select]
_TITLE "Trippy Bedsheet Swing With Morphing Colors"
'translated from SmallBASIC: Goldwave by johnno copied and mod by bplus 2018-01-28
'trippy bedsheet mod by fellippeheitor 2018-03-14

CONST xmax = 600
CONST ymax = 480
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60
DIM ccc AS _UNSIGNED LONG


'                  compare fill triangle subs:  one uses very simple  _MAPTRIANGLE opt = 1
'                                               2nd uses primative line graphic0s  opt <> 1


opt = 1 ' << opt 1 uses _MAPTRIANGLE to fill triangles, any other uses line filled triangles

DIM r AS _UNSIGNED _BYTE, g AS _UNSIGNED _BYTE, b AS _UNSIGNED _BYTE
r = 0
g = 65
b = 127
WHILE 1
    r = r + 15
    g = g + 15
    b = b + 15
    ccc = _RGB32(r, g, b)
    FOR t = 50.5 TO 56.6 STEP .1 '< changed
        CLS 'changed
        FOR y1 = 0 TO 24
            FOR x1 = 0 TO 24
                x = (12 * (24 - x1)) + (12 * y1)
                y = (-6 * (24 - x1)) + (6 * y1) + 300
                d = ((10 - x1) ^ 2 + (10 - y1) ^ 2) ^ .5
                h = 60 * SIN(x1 / 4 + t) + 65
                IF t > 10 AND t < 20 THEN h = 60 * SIN(y1 / 4 + t) + 65
                IF t > 20 AND t < 30 THEN h = 60 * SIN((x1 - y1) / 4 + t) + 65
                IF t > 30 AND t < 40 THEN h = 30 * SIN(x1 / 2 + t) + 30 * SIN(y1 / 2 + t) + 65
                IF t > 40 AND t < 50 THEN h = 60 * SIN((x1 + y1) / 4 + t) + 65
                IF t > 50 AND t < 60 THEN h = 60 * SIN(d * .3 + t) + 65
                IF opt = 1 THEN
                    'TOP
                    filltri x, y - h, x + 10, y + 5 - h, x + 20, y - h, Shade(ccc, h)
                    filltri x, y - h, x + 10, y - 5 - h, x + 20, y - h, Shade(ccc, h)
                    ''FRONT-LEFT
                    'filltri x, y - h, x + 10, y + 5 - h, x + 10, y, Shade(ccc, 40)
                    'filltri x, y - h, x, y - 5, x + 10, y, Shade(ccc, 40)
                    ''FRONT-RIGHT
                    'filltri x + 10, y + 5 - h, x + 10, y, x + 20, y - 5, Shade(ccc, 120)
                    'filltri x + 10, y + 5 - h, x + 20, y - h, x + 20, y - 5, Shade(ccc, 120)
                ELSE
                    COLOR _RGB32(242 + .1 * h, 242 + .1 * h, h)
                    filltri2 x, y - h, x + 10, y + 5 - h, x + 20, y - h
                    filltri2 x, y - h, x + 10, y - 5 - h, x + 20, y - h
                    'FRONT-LEFT
                    COLOR _RGB32(255, 80, 0)
                    filltri2 x, y - h, x + 10, y + 5 - h, x + 10, y
                    filltri2 x, y - h, x, y - 5, x + 10, y
                    COLOR _RGB32(255, 150, 0)
                    filltri2 x + 10, y + 5 - h, x + 10, y, x + 20, y - 5
                    filltri2 x + 10, y + 5 - h, x + 20, y - h, x + 20, y - 5
                END IF

                IF INKEY$ = CHR$(27) THEN END
            NEXT
        NEXT
        _DISPLAY
        _LIMIT 30 'to compare speeds
    NEXT
WEND

'Andy Amaya's modified FillTriangle
SUB filltri2 (xx1, yy1, xx2, yy2, xx3, yy3)
    'make copies before swapping
    x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2: x3 = xx3: y3 = yy3
    'thanks Andy Amaya!
    'triangle coordinates must be ordered: where x1 < x2 < x3
    IF x2 < x1 THEN SWAP x1, x2: SWAP y1, y2
    IF x3 < x1 THEN SWAP x1, x3: SWAP y1, y3
    IF x3 < x2 THEN SWAP x2, x3: SWAP y2, y3
    IF x1 <> x3 THEN slope1 = (y3 - y1) / (x3 - x1)

    'draw the first half of the triangle
    length = x2 - x1
    IF length <> 0 THEN
        slope2 = (y2 - y1) / (x2 - x1)
        FOR x = 0 TO length
            LINE (INT(x + x1), INT(x * slope1 + y1))-(INT(x + x1), INT(x * slope2 + y1))
            'lastx2% = lastx%
            lastx% = INT(x + x1)
        NEXT
    END IF

    'draw the second half of the triangle
    y = length * slope1 + y1: length = x3 - x2
    IF length <> 0 THEN
        slope3 = (y3 - y2) / (x3 - x2)
        FOR x = 0 TO length
            'IF INT(x + x2) <> lastx% AND INT(x + x2) <> lastx2% THEN  'works! but need 2nd? check
            IF INT(x + x2) <> lastx% THEN
                LINE (INT(x + x2), INT(x * slope1 + y))-(INT(x + x2), INT(x * slope3 + y2))
            END IF
        NEXT
    END IF
END SUB

' found at QB64.net:    http://www.qb64.net/forum/index.php?topic=14425.0
SUB filltri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
    a = _NEWIMAGE(1, 1, 32)
    _DEST a
    PSET (0, 0), K
    _DEST 0
    _MAPTRIANGLE (0, 0)-(0, 0)-(0, 0), a TO(x1, y1)-(x2, y2)-(x3, y3)
    _FREEIMAGE a '<<< this is important!
END SUB

FUNCTION Shade~& (WhichColor~&, ByHowMuch%)
    Shade~& = _RGB32(_RED32(WhichColor~&) * (ByHowMuch% / 100), _GREEN32(WhichColor~&) * (ByHowMuch% / 100), _BLUE32(WhichColor~&) * (ByHowMuch% / 100))
END FUNCTION

Offline Ashish

  • The joy of coding is endless.
Re: Cube Wave
« Reply #5 on: March 14, 2018, 10:20:35 AM »
@Fellippe
Very nice mod! Amazing effect with shading colors.
if (Me.success) {Me.improve()} else {Me.tryAgain()}


aKFrameWork - http://bit.ly/aKFrameWork
Menu System - http://bit.ly/guiMenuBar
p5.js in QB64 - http://bit.ly/p5jsbas

@KingOfCoders

Offline FellippeHeitor

  • QB64 Developer
  • LET IT = BE
    • QB64.org
Re: Cube Wave
« Reply #6 on: March 14, 2018, 03:07:41 PM »
Modded once again (my last, I promisse) to use HSB color space and provide smooth color transition.

Code: [Select]
_TITLE "Trippy Bedsheet Swing With Morphing Colors"
'translated from SmallBASIC: Goldwave by johnno copied and mod by bplus 2018-01-28
'trippy bedsheet mod by fellippeheitor 2018-03-14

CONST xmax = 600
CONST ymax = 480
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60
DIM ccc AS _UNSIGNED LONG
'_FULLSCREEN _SQUAREPIXELS , _SMOOTH

'                  compare fill triangle subs:  one uses very simple  _MAPTRIANGLE opt = 1
'                                               2nd uses primative line graphic0s  opt <> 1


opt = 1 ' << opt 1 uses _MAPTRIANGLE to fill triangles, any other uses line filled triangles

DIM angle
WHILE 1
    ccc = hsb(angle, 127, 127, 255)
    angle = angle + 10
    FOR t = 50.5 TO 56.7 STEP .1 '< changed
        CLS 'changed
        FOR y1 = 0 TO 24
            FOR x1 = 0 TO 24
                x = (12 * (24 - x1)) + (12 * y1)
                y = (-6 * (24 - x1)) + (6 * y1) + 300
                d = ((10 - x1) ^ 2 + (10 - y1) ^ 2) ^ .5
                h = 60 * SIN(x1 / 4 + t) + 65
                IF t > 10 AND t < 20 THEN h = 60 * SIN(y1 / 4 + t) + 65
                IF t > 20 AND t < 30 THEN h = 60 * SIN((x1 - y1) / 4 + t) + 65
                IF t > 30 AND t < 40 THEN h = 30 * SIN(x1 / 2 + t) + 30 * SIN(y1 / 2 + t) + 65
                IF t > 40 AND t < 50 THEN h = 60 * SIN((x1 + y1) / 4 + t) + 65
                IF t > 50 AND t < 60 THEN h = 60 * SIN(d * .3 + t) + 65
                IF opt = 1 THEN
                    'TOP
                    filltri x, y - h, x + 10, y + 5 - h, x + 20, y - h, Shade(ccc, h)
                    filltri x, y - h, x + 10, y - 5 - h, x + 20, y - h, Shade(ccc, h)
                    ''FRONT-LEFT
                    'filltri x, y - h, x + 10, y + 5 - h, x + 10, y, Shade(ccc, h * .4)
                    'filltri x, y - h, x, y - 5, x + 10, y, Shade(ccc, h * .4)
                    ''FRONT-RIGHT
                    'filltri x + 10, y + 5 - h, x + 10, y, x + 20, y - 5, Shade(ccc, h * 1.2)
                    'filltri x + 10, y + 5 - h, x + 20, y - h, x + 20, y - 5, Shade(ccc, h * 1.2)
                ELSE
                    COLOR _RGB32(242 + .1 * h, 242 + .1 * h, h)
                    filltri2 x, y - h, x + 10, y + 5 - h, x + 20, y - h
                    filltri2 x, y - h, x + 10, y - 5 - h, x + 20, y - h
                    'FRONT-LEFT
                    COLOR _RGB32(255, 80, 0)
                    filltri2 x, y - h, x + 10, y + 5 - h, x + 10, y
                    filltri2 x, y - h, x, y - 5, x + 10, y
                    COLOR _RGB32(255, 150, 0)
                    filltri2 x + 10, y + 5 - h, x + 10, y, x + 20, y - 5
                    filltri2 x + 10, y + 5 - h, x + 20, y - h, x + 20, y - 5
                END IF

                IF INKEY$ = CHR$(27) THEN SYSTEM
            NEXT
        NEXT
        _DISPLAY
        IF iconSetup = 0 THEN iconSetup = -1: _ICON _DEST
        _LIMIT 24 'to compare speeds
    NEXT
WEND

'Andy Amaya's modified FillTriangle
SUB filltri2 (xx1, yy1, xx2, yy2, xx3, yy3)
    'make copies before swapping
    x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2: x3 = xx3: y3 = yy3
    'thanks Andy Amaya!
    'triangle coordinates must be ordered: where x1 < x2 < x3
    IF x2 < x1 THEN SWAP x1, x2: SWAP y1, y2
    IF x3 < x1 THEN SWAP x1, x3: SWAP y1, y3
    IF x3 < x2 THEN SWAP x2, x3: SWAP y2, y3
    IF x1 <> x3 THEN slope1 = (y3 - y1) / (x3 - x1)

    'draw the first half of the triangle
    length = x2 - x1
    IF length <> 0 THEN
        slope2 = (y2 - y1) / (x2 - x1)
        FOR x = 0 TO length
            LINE (INT(x + x1), INT(x * slope1 + y1))-(INT(x + x1), INT(x * slope2 + y1))
            'lastx2% = lastx%
            lastx% = INT(x + x1)
        NEXT
    END IF

    'draw the second half of the triangle
    y = length * slope1 + y1: length = x3 - x2
    IF length <> 0 THEN
        slope3 = (y3 - y2) / (x3 - x2)
        FOR x = 0 TO length
            'IF INT(x + x2) <> lastx% AND INT(x + x2) <> lastx2% THEN  'works! but need 2nd? check
            IF INT(x + x2) <> lastx% THEN
                LINE (INT(x + x2), INT(x * slope1 + y))-(INT(x + x2), INT(x * slope3 + y2))
            END IF
        NEXT
    END IF
END SUB

' found at QB64.net:    http://www.qb64.net/forum/index.php?topic=14425.0
SUB filltri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
    a = _NEWIMAGE(1, 1, 32)
    _DEST a
    PSET (0, 0), K
    _DEST 0
    _MAPTRIANGLE (0, 0)-(0, 0)-(0, 0), a TO(x1, y1)-(x2, y2)-(x3, y3)
    _FREEIMAGE a '<<< this is important!
END SUB

FUNCTION Shade~& (WhichColor~&, ByHowMuch%)
    Shade~& = _RGB32(_RED32(WhichColor~&) * (ByHowMuch% / 100), _GREEN32(WhichColor~&) * (ByHowMuch% / 100), _BLUE32(WhichColor~&) * (ByHowMuch% / 100))
END FUNCTION

'Functions below come from p5js.bas
FUNCTION hsb~& (__H AS _FLOAT, __S AS _FLOAT, __B AS _FLOAT, A AS _FLOAT)
    DIM H AS _FLOAT, S AS _FLOAT, B AS _FLOAT

    H = map(__H, 0, 255, 0, 360)
    S = map(__S, 0, 255, 0, 1)
    B = map(__B, 0, 255, 0, 1)

    IF S = 0 THEN
        hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
        EXIT FUNCTION
    END IF

    DIM fmx AS _FLOAT, fmn AS _FLOAT
    DIM fmd AS _FLOAT, iSextant AS INTEGER
    DIM imx AS INTEGER, imd AS INTEGER, imn AS INTEGER

    IF B > .5 THEN
        fmx = B - (B * S) + S
        fmn = B + (B * S) - S
    ELSE
        fmx = B + (B * S)
        fmn = B - (B * S)
    END IF

    iSextant = INT(H / 60)

    IF H >= 300 THEN
        H = H - 360
    END IF

    H = H / 60
    H = H - (2 * INT(((iSextant + 1) MOD 6) / 2))

    IF iSextant MOD 2 = 0 THEN
        fmd = (H * (fmx - fmn)) + fmn
    ELSE
        fmd = fmn - (H * (fmx - fmn))
    END IF

    imx = _ROUND(fmx * 255)
    imd = _ROUND(fmd * 255)
    imn = _ROUND(fmn * 255)

    SELECT CASE INT(iSextant)
        CASE 1
            hsb~& = _RGBA32(imd, imx, imn, A)
        CASE 2
            hsb~& = _RGBA32(imn, imx, imd, A)
        CASE 3
            hsb~& = _RGBA32(imn, imd, imx, A)
        CASE 4
            hsb~& = _RGBA32(imd, imn, imx, A)
        CASE 5
            hsb~& = _RGBA32(imx, imn, imd, A)
        CASE ELSE
            hsb~& = _RGBA32(imx, imd, imn, A)
    END SELECT

END FUNCTION

FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION

Re: Cube Wave
« Reply #7 on: March 14, 2018, 07:55:36 PM »
All this code are nice.
Coding is relax (At least sometimes)

Re: Cube Wave
« Reply #8 on: March 14, 2018, 11:30:59 PM »
Did someone say "Trippy":

Code: [Select]
_TITLE "Trippy Wave bplus 2018-03-14"
' mod Gold Wave
'translated from SmallBASIC: Goldwave by johnno copied and mod by bplus 2018-01-28

'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
CONST xmax = 600
CONST ymax = 480
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60
DIM SHARED cN, pR, pG, pB
DIM ccc AS _UNSIGNED LONG
RANDOMIZE TIMER

WHILE 1
    resetPlasma
    FOR t = 1 TO 60 STEP .1 '< changed
        toggle = (toggle + 1) MOD 16
        IF toggle MOD 16 = 0 THEN CLS
        CLS 'changed
        FOR y1 = 0 TO 24
            FOR x1 = 0 TO 24
                x = (12 * (24 - x1)) + (12 * y1)
                y = (-6 * (24 - x1)) + (6 * y1) + 300
                d = ((10 - x1) ^ 2 + (10 - y1) ^ 2) ^ .5
                h = 60 * SIN(x1 / 4 + t) + 65
                IF t > 10 AND t < 20 THEN h = 60 * SIN(y1 / 4 + t) + 65
                IF t > 20 AND t < 30 THEN h = 60 * SIN((x1 - y1) / 4 + t) + 65
                IF t > 30 AND t < 40 THEN h = 30 * SIN(x1 / 2 + t) + 30 * SIN(y1 / 2 + t) + 65
                IF t > 40 AND t < 50 THEN h = 60 * SIN((x1 + y1) / 4 + t) + 65
                IF t > 50 AND t < 60 THEN h = 60 * SIN(d * .3 + t) + 65
                'TOP
                ccc&& = changePlasma
                filltri x, y - h, x + 10, y + 5 - h, x + 20, y - h, ccc&&
                filltri x, y - h, x + 10, y - 5 - h, x + 20, y - h, ccc&&
                'FRONT-LEFT
                ccc = _RGBA32(200, 200, 200, 80)
                filltri x, y - h, x + 10, y + 5 - h, x + 10, y, ccc
                filltri x, y - h, x, y - 5, x + 10, y, ccc
                'FRONT-RIGHT
                ccc = _RGBA32(155, 155, 155, 80)
                filltri x + 10, y + 5 - h, x + 10, y, x + 20, y - 5, ccc
                filltri x + 10, y + 5 - h, x + 20, y - h, x + 20, y - 5, ccc
                IF INKEY$ = CHR$(27) THEN END
            NEXT
        NEXT
        _DISPLAY
        _LIMIT 20
    NEXT
WEND

' found at QB64.net:    http://www.qb64.net/forum/index.php?topic=14425.0
SUB filltri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
    a& = _NEWIMAGE(1, 1, 32)
    _DEST a&
    PSET (0, 0), K
    _DEST 0
    _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
    _FREEIMAGE a& '<<< this is important!
END SUB

FUNCTION changePlasma&& ()
    cN = cN + 1
    changePlasma&& = _RGB32(127 + 127 * SIN(pR * cN), 127 + 127 * SIN(pG * cN), 127 + 127 * SIN(pB * cN))
END SUB

SUB resetPlasma ()
    pR = .1 * RND ^ 2: pG = .1 * RND ^ 2: pB = .1 * RND ^ 2
END SUB
« Last Edit: March 14, 2018, 11:34:10 PM by bplus »
B = B + ...
QB64 x 64 v1.2 2018 0228/86 git b30af92
QB64 v1.2 2018 0228/86 git b30af92
QB64 v1.1 2017 1106/82

Offline FellippeHeitor

  • QB64 Developer
  • LET IT = BE
    • QB64.org
Re: Cube Wave
« Reply #9 on: March 15, 2018, 09:40:50 AM »
Where's your seizure warning, man?

Offline FellippeHeitor

  • QB64 Developer
  • LET IT = BE
    • QB64.org
Re: Cube Wave
« Reply #10 on: March 19, 2018, 02:24:26 PM »
Smoother color morphing.

Code: [Select]
_TITLE "Trippy Bedsheet Swing With Morphing Colors"
'translated from SmallBASIC: Goldwave by johnno copied and mod by bplus 2018-01-28
'trippy bedsheet mod by fellippeheitor 2018-03-14

CONST xmax = 600
CONST ymax = 480
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60
DIM ccc AS _UNSIGNED LONG
'_FULLSCREEN _SQUAREPIXELS , _SMOOTH

'                  compare fill triangle subs:  one uses very simple  _MAPTRIANGLE opt = 1
'                                               2nd uses primative line graphic0s  opt <> 1


opt = 1 ' << opt 1 uses _MAPTRIANGLE to fill triangles, any other uses line filled triangles

DIM angle
WHILE 1
    FOR t = 50.5 TO 56.7 STEP .01 '< changed
        CLS 'changed
        ccc = hsb(angle, 127, 127, 255)
        angle = angle + .1
        IF angle > 359 THEN angle = 0
        FOR y1 = 0 TO 24
            FOR x1 = 0 TO 24
                x = (12 * (24 - x1)) + (12 * y1)
                y = (-6 * (24 - x1)) + (6 * y1) + 300
                d = ((10 - x1) ^ 2 + (10 - y1) ^ 2) ^ .5
                h = 60 * SIN(x1 / 4 + t) + 65
                IF t > 10 AND t < 20 THEN h = 60 * SIN(y1 / 4 + t) + 65
                IF t > 20 AND t < 30 THEN h = 60 * SIN((x1 - y1) / 4 + t) + 65
                IF t > 30 AND t < 40 THEN h = 30 * SIN(x1 / 2 + t) + 30 * SIN(y1 / 2 + t) + 65
                IF t > 40 AND t < 50 THEN h = 60 * SIN((x1 + y1) / 4 + t) + 65
                IF t > 50 AND t < 60 THEN h = 60 * SIN(d * .3 + t) + 65
                IF opt = 1 THEN
                    'TOP
                    filltri x, y - h, x + 10, y + 5 - h, x + 20, y - h, Shade(ccc, h)
                    filltri x, y - h, x + 10, y - 5 - h, x + 20, y - h, Shade(ccc, h)
                    ''FRONT-LEFT
                    'filltri x, y - h, x + 10, y + 5 - h, x + 10, y, Shade(ccc, h * .4)
                    'filltri x, y - h, x, y - 5, x + 10, y, Shade(ccc, h * .4)
                    ''FRONT-RIGHT
                    'filltri x + 10, y + 5 - h, x + 10, y, x + 20, y - 5, Shade(ccc, h * 1.2)
                    'filltri x + 10, y + 5 - h, x + 20, y - h, x + 20, y - 5, Shade(ccc, h * 1.2)
                ELSE
                    COLOR _RGB32(242 + .1 * h, 242 + .1 * h, h)
                    filltri2 x, y - h, x + 10, y + 5 - h, x + 20, y - h
                    filltri2 x, y - h, x + 10, y - 5 - h, x + 20, y - h
                    'FRONT-LEFT
                    COLOR _RGB32(255, 80, 0)
                    filltri2 x, y - h, x + 10, y + 5 - h, x + 10, y
                    filltri2 x, y - h, x, y - 5, x + 10, y
                    COLOR _RGB32(255, 150, 0)
                    filltri2 x + 10, y + 5 - h, x + 10, y, x + 20, y - 5
                    filltri2 x + 10, y + 5 - h, x + 20, y - h, x + 20, y - 5
                END IF

                IF INKEY$ = CHR$(27) THEN SYSTEM
            NEXT
        NEXT
        _DISPLAY
        IF iconSetup = 0 THEN iconSetup = -1: _ICON _DEST
        _LIMIT 60 'to compare speeds
    NEXT
WEND

'Andy Amaya's modified FillTriangle
SUB filltri2 (xx1, yy1, xx2, yy2, xx3, yy3)
    'make copies before swapping
    x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2: x3 = xx3: y3 = yy3
    'thanks Andy Amaya!
    'triangle coordinates must be ordered: where x1 < x2 < x3
    IF x2 < x1 THEN SWAP x1, x2: SWAP y1, y2
    IF x3 < x1 THEN SWAP x1, x3: SWAP y1, y3
    IF x3 < x2 THEN SWAP x2, x3: SWAP y2, y3
    IF x1 <> x3 THEN slope1 = (y3 - y1) / (x3 - x1)

    'draw the first half of the triangle
    length = x2 - x1
    IF length <> 0 THEN
        slope2 = (y2 - y1) / (x2 - x1)
        FOR x = 0 TO length
            LINE (INT(x + x1), INT(x * slope1 + y1))-(INT(x + x1), INT(x * slope2 + y1))
            'lastx2% = lastx%
            lastx% = INT(x + x1)
        NEXT
    END IF

    'draw the second half of the triangle
    y = length * slope1 + y1: length = x3 - x2
    IF length <> 0 THEN
        slope3 = (y3 - y2) / (x3 - x2)
        FOR x = 0 TO length
            'IF INT(x + x2) <> lastx% AND INT(x + x2) <> lastx2% THEN  'works! but need 2nd? check
            IF INT(x + x2) <> lastx% THEN
                LINE (INT(x + x2), INT(x * slope1 + y))-(INT(x + x2), INT(x * slope3 + y2))
            END IF
        NEXT
    END IF
END SUB

' found at QB64.net:    http://www.qb64.net/forum/index.php?topic=14425.0
SUB filltri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
    a = _NEWIMAGE(1, 1, 32)
    _DEST a
    PSET (0, 0), K
    _DEST 0
    _MAPTRIANGLE (0, 0)-(0, 0)-(0, 0), a TO(x1, y1)-(x2, y2)-(x3, y3)
    _FREEIMAGE a '<<< this is important!
END SUB

FUNCTION Shade~& (WhichColor~&, ByHowMuch%)
    Shade~& = _RGB32(_RED32(WhichColor~&) * (ByHowMuch% / 100), _GREEN32(WhichColor~&) * (ByHowMuch% / 100), _BLUE32(WhichColor~&) * (ByHowMuch% / 100))
END FUNCTION

FUNCTION hsb~& (__H AS _FLOAT, __S AS _FLOAT, __B AS _FLOAT, A AS _FLOAT)
    DIM H AS _FLOAT, S AS _FLOAT, B AS _FLOAT

    H = map(__H, 0, 255, 0, 360)
    S = map(__S, 0, 255, 0, 1)
    B = map(__B, 0, 255, 0, 1)

    IF S = 0 THEN
        hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
        EXIT FUNCTION
    END IF

    DIM fmx AS _FLOAT, fmn AS _FLOAT
    DIM fmd AS _FLOAT, iSextant AS INTEGER
    DIM imx AS INTEGER, imd AS INTEGER, imn AS INTEGER

    IF B > .5 THEN
        fmx = B - (B * S) + S
        fmn = B + (B * S) - S
    ELSE
        fmx = B + (B * S)
        fmn = B - (B * S)
    END IF

    iSextant = INT(H / 60)

    IF H >= 300 THEN
        H = H - 360
    END IF

    H = H / 60
    H = H - (2 * INT(((iSextant + 1) MOD 6) / 2))

    IF iSextant MOD 2 = 0 THEN
        fmd = (H * (fmx - fmn)) + fmn
    ELSE
        fmd = fmn - (H * (fmx - fmn))
    END IF

    imx = _ROUND(fmx * 255)
    imd = _ROUND(fmd * 255)
    imn = _ROUND(fmn * 255)

    SELECT CASE INT(iSextant)
        CASE 1
            hsb~& = _RGBA32(imd, imx, imn, A)
        CASE 2
            hsb~& = _RGBA32(imn, imx, imd, A)
        CASE 3
            hsb~& = _RGBA32(imn, imd, imx, A)
        CASE 4
            hsb~& = _RGBA32(imd, imn, imx, A)
        CASE 5
            hsb~& = _RGBA32(imx, imn, imd, A)
        CASE ELSE
            hsb~& = _RGBA32(imx, imd, imn, A)
    END SELECT

END FUNCTION

FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
END FUNCTION
« Last Edit: March 19, 2018, 02:29:09 PM by FellippeHeitor »

Offline Ashish

  • The joy of coding is endless.
Re: Cube Wave
« Reply #11 on: March 20, 2018, 06:07:36 AM »
Nice Fellippe!
if (Me.success) {Me.improve()} else {Me.tryAgain()}


aKFrameWork - http://bit.ly/aKFrameWork
Menu System - http://bit.ly/guiMenuBar
p5.js in QB64 - http://bit.ly/p5jsbas

@KingOfCoders

Re: Cube Wave
« Reply #12 on: March 20, 2018, 10:08:08 AM »
It's nice but I don't see anybody being awoken by it.

Now a ball might be something!

Where is Pete?
B = B + ...
QB64 x 64 v1.2 2018 0228/86 git b30af92
QB64 v1.2 2018 0228/86 git b30af92
QB64 v1.1 2017 1106/82

Re: Cube Wave
« Reply #13 on: March 20, 2018, 11:55:28 AM »
Trippy Wave Ball Mod:
Code: [Select]
_TITLE "Trippy Wave Ball Mod bplus 2018-03-20"
'2018-03-20 just screwing around more with Ball stuff
' mod Gold Wave
'translated from SmallBASIC: Goldwave by johnno copied and mod by bplus 2018-01-28

'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
CONST xmax = 600
CONST ymax = 480
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60
DIM SHARED cN, pR, pG, pB
DIM ccc AS _UNSIGNED LONG
RANDOMIZE TIMER

WHILE 1
    resetPlasma
    FOR t = 1 TO 60 STEP .1 '< changed
        toggle = (toggle + 1) MOD 16
        IF toggle MOD 16 = 0 THEN CLS
        CLS 'changed
        FOR y1 = 0 TO 24
            FOR x1 = 0 TO 24
                x = (12 * (24 - x1)) + (12 * y1)
                y = (-6 * (24 - x1)) + (6 * y1) + 300
                d = ((10 - x1) ^ 2 + (10 - y1) ^ 2) ^ .5
                h = 60 * SIN(x1 / 4 + t) + 65
                IF t > 10 AND t < 20 THEN h = 60 * SIN(y1 / 4 + t) + 65
                IF t > 20 AND t < 30 THEN h = 60 * SIN((x1 - y1) / 4 + t) + 65
                IF t > 30 AND t < 40 THEN h = 30 * SIN(x1 / 2 + t) + 30 * SIN(y1 / 2 + t) + 65
                IF t > 40 AND t < 50 THEN h = 60 * SIN((x1 + y1) / 4 + t) + 65
                IF t > 50 AND t < 60 THEN h = 60 * SIN(d * .3 + t) + 65
                'TOP
                FOR r = 20 TO 1 STEP -4
                    ccc&& = changePlasma
                    fcirc x + 10, y - h, r
                NEXT
                IF INKEY$ = CHR$(27) THEN END
            NEXT
        NEXT
        _DISPLAY
        _LIMIT 20
    NEXT
WEND

FUNCTION changePlasma&& ()
    cN = cN + .05
    COLOR _RGB32(127 + 127 * SIN(pR * cN), 127 + 127 * SIN(pG * cN), 127 + 127 * SIN(pB * cN))
END SUB

SUB resetPlasma ()
    pR = .1 * RND ^ 2: pG = .1 * RND ^ 2: pB = .1 * RND ^ 2
END SUB

'Steve McNeil's  copied from his forum   note: Radius is too common a name
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
    DIM subRadius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG

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

    IF subRadius = 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
B = B + ...
QB64 x 64 v1.2 2018 0228/86 git b30af92
QB64 v1.2 2018 0228/86 git b30af92
QB64 v1.1 2017 1106/82