Super Shape Morpher

[relsoft]

This all started when Rbraz pointed me to a very cool site by paul Bourke.

I got this from an equation developed by Paul Bourke. ;*)
http://astronomy.swin.edu.au/~pbourke/surfaces/supershape3d/

DEMO:
http://rel.betterwebber.com/junk.php?id=61

Enjoy!

[Clyde]

Cooolness dude, welldone.

[Shockwave]

That's rather nifty!
I must admit to being totally intrigued when I saw the line "morphing is achieved by linear interpolation of parameters"
Good one Relsoft, 10/10.

[relsoft]

Yeah, I saw the equation when Rbraz reffered me to the 2d supershape.  Seiing how simple the equaion is in 3d, I thought I might give it a try since it begs to be used :*)
 

[Rbz]

Nice one Relsoft !

I'll try to code a tunnel using those equations.

 

[relsoft]

Nice one Relsoft !

I'll try to code a tunnel using those equations.

 

Cool!!!

For tunnels, the torus maping should do a better job. :*)

you'd have to supply a tga file for the texture though. The one packaged with the demo works. :*)

Code: [Select]

'Super Shape Morpher in torus mapping
'Based on the equations from Paul Bourke
'http://astronomy.swin.edu.au/~pbourke/surfaces/supershape3d/
'Relsoft 2006
'Richard Eric m. Lope BSN RN
'http://rel.betterwebber.com
'Although the superhape formula offers infinite possibilities,
'it's a little hard to predict the size of the shape due to it's
'exponential nature. That's why I limited the shapes to the ones I defined in
'the S_SHAPE() array.


Option Explicit
'$Static
'$INCLUDE: "\gl\gl.bi"
'$INCLUDE: "\gl\glu.bi"
'$INCLUDE: "\gl\glfw.bi"
'$INCLUDE: "\gl\glext.bi"

const SCR_WIDTH = 640                   'Width of the screen
const SCR_HEIGHT = 480                  'height of the screen
const BITSPP = 32                       '32 bits per pixel format


const PI = 3.141593
const TWOPI = (2 * PI)


CONST S_SLICES= 32
CONST S_BANDS = 32 
CONST S_RADIUS = 1.0         




Type DisplayType
    W As Uinteger
    H As Uinteger
    R_BITS As Uinteger
    G_BITS As Uinteger
    B_BITS As Uinteger
    A_BITS As Uinteger
    D_BITS As Uinteger
    S_BITS As Uinteger
    MODE As Uinteger
    GlVer As Zstring Ptr
    As Single FOVy, Aspect, zNear, zFar
End Type

type vector3d
    as single   x
    as single   y
    as single   z
end type

type textuv
    as single  u
    as single  v
end type


Type polytype
        p1      as integer      'vertex 1 of our triangle
        p2      as integer      'huh?
        p3      as integer
        u1      as single
        v1      as single
        u2      as single
        v2      as single
        u3      as single
        v3      as single
        col as single
end Type

Type Supa_shape
        as single a,b
        as single m
        as single n1,n2,n3
End type





declare Sub Init_GL_Window( Display As DisplayType )
declare SUB Init_GL_SCREEN()
declare sub super_shape (model() as vector3d, modeltext() as textuv, byval radius as single,_
             byval slices as single, byval bands as single, byval a as single, byval b as single,_
             byval m as single, byval n1 as single, byval n2 as single, byval n3 as single)
                         
declare sub glDraw() 
declare sub lathing (model() as vector3d, poly() as polytype, rings, bands)
declare sub vector_normalize (v as vector3d)




Dim Display As DisplayType
Init_GL_Window Display
init_GL_SCREEN()


redim shared model ((S_SLICES * (S_BANDS + 1) )-1) as vector3d
redim shared model_text((S_SLICES * (S_BANDS + 1))-1) as textuv
redim shared model_norm((S_SLICES * (S_BANDS + 1))-1) as vector3d


dim as single ss_a, ss_b, ss_m, ss_n1, ss_n2, ss_n3
ss_a = 1
ss_b = 1
ss_m = 4
ss_n1 = 0.3
ss_n2 = 1.0
ss_n3 = 1.0

ss_n1 = 0.173275
ss_n2 = 31.5035
ss_n3 = -0.580
ss_m = 8

super_shape (model(), model_text(), S_RADIUS,S_SLICES,S_BANDS,_
             ss_a, ss_b, ss_m, ss_n1, ss_n2, ss_n3)             
redim shared model_tri(1) as PolyType


lathing (model(), model_tri(), S_SLICES, S_BANDS)


Dim FileNam as String
Dim shared texture as  GLUINT


GlEnable GL_Texture_2D
GlGenTextures 1, @texture
glBindTexture GL_Texture_2D, texture
Filenam = "vein.tga"
If NOT GlfwLoadTexture2D( FileNam, GLFW_BUILD_MIPMAPS_BIT) Then
    GlfwTerminate()
    Print "Failed to load image!!!"
    sleep
    End
End If

dim as integer shape_changed = 0
randomize timer


dim shared s_shape(11) as supa_shape
s_shape(0).a = 1
s_shape(0).b = 1
s_shape(0).m = 7
s_shape(0).n1 = 0.4
s_shape(0).n2 = 1.2
s_shape(0).n3 = 1.7

s_shape(1).a = 1
s_shape(1).b = 1
s_shape(1).m = 0
s_shape(1).n1 = 1.0
s_shape(1).n2 = 1.0
s_shape(1).n3 = 1.0

s_shape(2).a = 1
s_shape(2).b = 1
s_shape(2).m = 4
s_shape(2).n1 = 100.0
s_shape(2).n2 = 100.0
s_shape(2).n3 = 100.0


s_shape(3).a = 1
s_shape(3).b = 1
s_shape(3).m = 7
s_shape(3).n1 = 0.3
s_shape(3).n2 = 1.7
s_shape(3).n3 = 1.7

s_shape(4).a = 1
s_shape(4).b = 1
s_shape(4).m = 5
s_shape(4).n1 = 0.6
s_shape(4).n2 = 0.4
s_shape(4).n3 = 0.5

s_shape(5).a = 1
s_shape(5).b = 1
s_shape(5).m = 6
s_shape(5).n1 = 0.6
s_shape(5).n2 = 2.07
s_shape(5).n3 = 2.5


s_shape(6).a = 1
s_shape(6).b = 1
s_shape(6).m = 11
s_shape(6).n1 = 10.16
s_shape(6).n2 = 0.30
s_shape(6).n3 = 2.05

s_shape(7).a = .2
s_shape(7).b = .1
s_shape(7).m = 8
s_shape(7).n1 = 18.16
s_shape(7).n2 = 2.30
s_shape(7).n3 = 10.05

s_shape(8).a = 1
s_shape(8).b = 1
s_shape(8).m = 13
s_shape(8).n1 = 0.16
s_shape(8).n2 = 2.30
s_shape(8).n3 = 0.05


s_shape(9).a = 1
s_shape(9).b = 1
s_shape(9).m = 4
s_shape(9).n1 = 0.46
s_shape(9).n2 = 5.30
s_shape(9).n3 = 0.305

s_shape(10).a = 1
s_shape(10).b = 1
s_shape(10).m = 13
s_shape(10).n1 = 0.46
s_shape(10).n2 = 0.30
s_shape(10).n3 = 5.305


s_shape(11).a = 1
s_shape(11).b = 1
s_shape(11).m = 6
s_shape(11).n1 = 1.26
s_shape(11).n2 = -1.00
s_shape(11).n3 = 1.7380


'ss_n3 +=-1.5 + rnd * 3
'        ss_n2 = -3 + rnd * 6

dim shared as integer morph_frames = 100
dim i as integer
dim mi as integer
dim shared as single gtime
dim as single time_start
dim as integer target_shape = 11
dim as integer current_shape = 1
dim as integer shape_counter = 0

s_shape(0).a=  (s_shape(target_shape).a  - s_shape(current_shape).a )/morph_frames
s_shape(0).b=  (s_shape(target_shape).b  - s_shape(current_shape).b )/morph_frames
s_shape(0).m=  (s_shape(target_shape).m  - s_shape(current_shape).m )/morph_frames
s_shape(0).n1= (s_shape(target_shape).n1 - s_shape(current_shape).n1)/morph_frames
s_shape(0).n2= (s_shape(target_shape).n2 - s_shape(current_shape).n2)/morph_frames
s_shape(0).n3= (s_shape(target_shape).n3 - s_shape(current_shape).n3)/morph_frames       

   
   
ss_a = s_shape(current_shape).a
ss_b = s_shape(current_shape).b
ss_m = s_shape(current_shape).m
ss_n1 = s_shape(current_shape).n1
ss_n2 = s_shape(current_shape).n2
ss_n3 = s_shape(current_shape).n3
mi = 0
current_shape = target_shape         
randomize timer
Do
    time_start =  timer/100
    GlClear GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT
       
    GlMatrixMode GL_MODELVIEW
    GlLoadIdentity     

   
       
   
   
    if mi = (morph_frames * 2) then
        mi = 0               
        if target_shape = 1 then             
            shape_counter =  (shape_counter + 1) mod (ubound(s_shape))
            target_shape = 1 + shape_counter
        else
            target_shape = 1           
        end if               
        s_shape(0).a=  (s_shape(target_shape).a  - s_shape(current_shape).a )/morph_frames
        s_shape(0).b=  (s_shape(target_shape).b  - s_shape(current_shape).b )/morph_frames
        s_shape(0).m=  (s_shape(target_shape).m  - s_shape(current_shape).m )/morph_frames
        s_shape(0).n1= (s_shape(target_shape).n1 - s_shape(current_shape).n1)/morph_frames
        s_shape(0).n2= (s_shape(target_shape).n2 - s_shape(current_shape).n2)/morph_frames
        s_shape(0).n3= (s_shape(target_shape).n3 - s_shape(current_shape).n3)/morph_frames       
        current_shape = target_shape         
    end if
   
    gtime = timer/100
    if mi<morph_frames then
        ss_a += s_shape(0).a
        ss_b += s_shape(0).b
        ss_m += s_shape(0).m
        ss_n1 += s_shape(0).n1
        ss_n2 += s_shape(0).n2
        ss_n3 += s_shape(0).n3
    end if
    mi += 1
    super_shape (model(), model_text(), S_RADIUS,S_SLICES,S_BANDS,_
             ss_a, ss_b, ss_m, ss_n1, ss_n2, ss_n3)       
    glDraw()     
   
   
    GlfwSwapBuffers
   
    'while((timer/1000) < (time_start + 16)): sleep 1 : wend
   
loop Until glfwGetKey( GLFW_KEY_ESC )

GlDeleteTextures 1, @texture

GlfwTerminate()




sub glDraw() 
  dim as integer i 
  static as integer theta= 0
  theta += 1
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT) 
  GlMatrixMode GL_MODELVIEW
  glLoadIdentity()
  glTranslatef(0.0,0.0,-5)
 
  glRotatef(theta, 1, 0, 0)
  glRotatef(theta, 0, 1, 0)
  glRotatef(theta, 0, 0, 1)
 
 
   glBegin GL_TRIANGLES   
    for i = 0 to Ubound(model_tri)         
         glTexCoord2fv @model_text(model_tri(i).p1).u   
         glVertex3fv @model(model_tri(i).p1).x
                 
         glTexCoord2fv @model_text(model_tri(i).p2).u   
         glVertex3fv @model(model_tri(i).p2).x
                 
         glTexCoord2fv @model_text(model_tri(i).p3).u   
         glVertex3fv @model(model_tri(i).p3).x
    next i
   glEnd
   

 
end sub

sub super_shape (model() as vector3d, modeltext() as textuv, byval radius as single,_
             byval slices as single, byval bands as single, byval a as single, byval b as single,_
             byval m as single, byval n1 as single, byval n2 as single, byval n3 as single)

    'a1 = abs(cos(m*theta/4)/a)^n2
    'a2 = abs(sin(m*theta/4)/a)^n3
    'r(theta) = (a1+a2)^(-1/n1)
    '
    'x = r*(theta)  * cos(theta) * r*(phi)* cos(phi)
    'y = r*(theta)  * sin(theta) * r*(phi)* cos(phi)
    'z = r*(phi)  * sin(phi)
    '
    '-pi/2 <= phi <= pi/2
    '-pi <= theta <= pi
   
   
   
    dim as integer i, sliceloop, bandloop
    dim as single phi, theta
    i = 0
    dim as single r1, r2, a1, a2
    static as single text_off=0
    text_off += 0.00041926 * gtime
   
    dim as single Tpi_d
    Tpi_d = (TWOPI)/Bands
    dim as single Ppi_d
    Ppi_d = (TWOPI)/slices
   
    phi = -Pi/2
   
    FOR SliceLoop = 0 TO Slices - 1
       
        a1 = abs(cos(m*phi/4)/a)^n2
        a2 = abs(sin(m*phi/4)/b)^n3
        r2 = (a1+a2)^(-1/n1)
        r2 *= radius * 0.6
       
        phi += Ppi_d
       
        theta = -Pi
        FOR BandLoop = 0 TO Bands
                   
            a1 = abs(cos(m*theta/4)/a)^n2
            a2 = abs(sin(m*theta/4)/b)^n3
            r1 = (a1+a2)^(-1/n1)
            r1 *= radius
           
            Model(i).x = cos(theta) * (r1  + r2* cos(phi))
            Model(i).y = sin(theta) * (r1  + r2* cos(phi))
            Model(i).z = r2  * sin(phi)
           
            modeltext(i).v = (((BandLoop) / (bands) ) * 4)  +text_off
            modeltext(i).u = (((SliceLoop) / (slices) ) * 4) +text_off
            i = i + 1         
            theta += tPi_d         
        NEXT BandLoop                   
    NEXT SliceLoop
   
             
end sub


sub lathing (model() as vector3d, poly() as polytype, rings, bands)
       
       dim as integer maxpoint,i
       MaxPoint = (Rings) * (Bands+ 1)
       

       dim Maxtri as integer
   maxtri = MaxPoint * 2
       redim Poly(maxtri) as polytype


'lathing
    dim s as integer, u as integer
    dim maxvert as integer
    dim slice as integer
    maxvert = MaxPoint
    i = 0
for s = 0 to rings - 1
slice = s * bands
for u = 0 to bands   'duplicate texture ( not bands - 1)
poly(i).p1=(u+bands+1+(slice)) mod maxvert
poly(i).p2=(u+bands+(slice)) mod maxvert
poly(i).p3=(u+(slice)) mod maxvert
poly(i).col=rnd
poly(i).u1=0
poly(i).v1=0
poly(i).u2=1
poly(i).v2=0
poly(i).u3=1
poly(i).v3=1
poly(i+1).p1=(u+(slice)) mod maxvert
poly(i+1).p2=(u+1+(slice)) mod maxvert
poly(i+1).p3=(u+bands+1+(slice)) mod maxvert
poly(i+1).col=rnd
poly(i+1).u1=1
poly(i+1).v1=1
poly(i+1).u2=0
poly(i+1).v2=1
poly(i+1).u3=0
poly(i+1).v3=0
i = i + 2
next t
next s



end sub


Sub Init_GL_Window( Display As DisplayType )
    Display.W     = 640
    Display.H     = 480
    Display.R_BITS= 8
    Display.G_BITS= 8
    Display.B_BITS= 8
    Display.A_BITS= 8
    Display.D_BITS= BITSPP
    Display.S_BITS= 8
    Display.MODE  = GLFW_WINDOW
    'Display.MODE  = GLFW_FULLSCREEN
   
    If glfwInit() Then
        'Successful!
    Else   
        Print "Failed to initialize GLFW!"
        Sleep 1000
        End
    End If
   
   
    If  glfwOpenWindow( _
    Display.W     , _
    Display.H     , _
    Display.R_BITS, _
    Display.G_BITS, _
    Display.B_BITS, _
    Display.A_BITS, _
    Display.D_BITS, _
    Display.S_BITS, _
    Display.MODE  ) _
    Then
    GlfwSwapInterval 1
    Display.GlVer = glGetString(GL_VERSION)
Else
    GlfwTerminate()
    End
End If

End Sub

SUB Init_GL_SCREEN()

   'screen information
   dim w as integer, h as integer
    'OpenGL params for gluerspective
   dim FOVy as double            'Field of view angle in Y
   dim Aspect as double          'Aspect of screen
   dim znear as double           'z-near clip distance
   dim zfar as double            'z-far clip distance

    'using screen info w and h as params
   glViewport 0, 0, SCR_WIDTH,SCR_HEIGHT

   'Set current Mode to projection(ie: 3d)
   glMatrixMode GL_PROJECTION

    'Load identity matrix to projection matrix
   glLoadIdentity

    'Set gluPerspective params
    FOVy = 80/2                                     '45 deg fovy
    Aspect = SCR_WIDTH / SCR_HEIGHT                                  'aspect = x/y
    znear = 1                                       'Near clip
    zfar = 200                                      'far clip

    'use glu Perspective to set our 3d frustum dimension up
   gluPerspective FOVy, aspect, znear, zfar

    'Modelview mode
    'ie. Matrix that does things to anything we draw
    'as in lines, points, tris, etc.
   glMatrixMode GL_MODELVIEW
   'load identity(clean) matrix to modelview
   glLoadIdentity

   glShadeModel GL_SMOOTH                 'set shading to smooth(try GL_FLAT)
   glClearColor 0.0, 0.0, 0.0, 1.0        'set Clear color to BLACK
   glClearDepth 1.0                       'Set Depth buffer to 1(z-Buffer)
   glEnable GL_DEPTH_TEST                 'Enable Depth Testing so that our z-buffer works

   'compare each incoming pixel z value with the z value present in the depth buffer
   'LEQUAL means than pixel is drawn if the incoming z value is less than
    'or equal to the stored z value
   glDepthFunc GL_LEQUAL

    'have one or more material parameters track the current color
    'Material is your 3d model
   glEnable GL_COLOR_MATERIAL


    'Enable Texturing
    glEnable GL_TEXTURE_2D
   

    'Set blending parameters
    glBlendFunc GL_SRC_ALPHA, GL_ONE


   'Tell openGL that we want the best possible perspective transform
   glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST
   
   'Enable Backface culling
   'GlEnable GL_CULL_FACE
   glPolygonMode(GL_FRONT, GL_FILL)
   
   
        'lighting
  dim as glFloat mat_ambient(0 to 3) =  { 0.5, 0.5, 1.0, 0.15 }
  dim as glFloat mat_specular(0 to 3) = {  1.0, 1.0, 1.0, 0.15 } 
  dim as glFloat mat_shininess = 15.0
  dim as glFloat light_position(0 to 3)= { -7.0, 8.0, -6.0, 1.0  }
  dim as glFloat light_ambient(0 to 3)= { 0.5, 0.5, 0.5, 1.0 }
  dim as glFloat mat_twister(0 to 3) = { 0.75, 0.75, 0.0, 1.0 }
  dim as GLfloat fBrightLight(0 to 3) = { 1.0, 1.0, 1.0, 1.0 }
  glMaterialfv(GL_FRONT, GL_AMBIENT, @mat_ambient(0))
  glMaterialfv(GL_FRONT, GL_SPECULAR, @mat_specular(0))
  glMaterialfv(GL_FRONT, GL_SHININESS, @mat_shininess)
  glMaterialfv(GL_FRONT, GL_DIFFUSE,@mat_twister(0))
  glMaterialfv(GL_FRONT, GL_SPECULAR, @fBrightLight(0))


'  glLightModeli(GL_LIGHT_MODEL_COLOR_CONTROL, GL_SEPARATE_SPECULAR_COLOR)
'  glLightfv(GL_LIGHT0,GL_AMBIENT, @light_ambient(0))
'  glLightfv(GL_LIGHT0,GL_DIFFUSE, @light_ambient(0))
'  glLightfv(GL_LIGHT0, GL_POSITION, @light_position(0))
'  glEnable(GL_LIGHTING)
'  glEnable(GL_LIGHT0)
END SUB

sub vector_normalize (v as vector3d)
    'makes v a unit vector
    dim mag as single
    mag = 1/sqr(v.x * v.x + v.y * v.y + v.z * v.z)
    if mag <> 0 then
        v.x = v.x * mag
        v.y = v.y * mag
        v.z = v.z * mag
    else
        v.x = 0
        v.y = 0
        v.z = 1
    end if

end sub

[Shockwave]

Mmm.. Dougnuts
Sweet.