|
Post by bluatigro on Aug 26, 2020 9:20:52 GMT -5
''bluatigro 26 aug 2020
''@bluaGL.bas
''wil be openGL wrapper lib
''version 1 : only color and points
nomainwin
dim pntx(256),pnty(256),pntz(256),box(5),sk(64,2)
global pi : pi = atn( 1 ) * 4
'' color objects
global black , red , green , yellow
global blue , magenta , cyan , white
global gray , pink , purple , orange
black = rgba( 000 , 000 , 000 , 255 )
red = rgba( 255 , 000 , 000 , 255 )
green = rgba( 000 , 255 , 000 , 255 )
yellow = rgba( 255 , 255 , 000 , 255 )
blue = rgba( 000 , 000 , 255 , 255 )
magenta = rgba( 255 , 000 , 255 , 255 )
cyan = rgba( 000 , 255 , 255 , 255 )
white = rgba( 255 , 255 , 255 , 255 )
gray = rgba( 127 , 127 , 127 , 255 )
pink = rgba( 255 , 127 , 127 , 255 )
purple = rgba( 127 , 000 , 127 , 255 )
orange = rgba( 255 , 127 , 000 , 255 )
global xyz , xzy , yxz , yzx , zxy , zyx
xyz = 0
xzy = 1
yxz = 2
yzx = 3
zxy = 4
zyx = 5
'' opengl consts
global GL.COLOR.BUFFER.BIT : GL.COLOR.BUFFER.BIT = 16384
global GL.DEPTH.BUFFER.BIT : GL.DEPTH.BUFFER.BIT = 256
global GL.DEPTH.TEST : GL.DEPTH.TEST = 2929
' primatifs
global GL.TRIANGLES : GL.TRIANGLES = 4
global GL.QUADS : GL.QUADS = 7
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , winyx
winx = WindowWidth
winy = WindowHeight
winyx = winy / winx
global MainH , MainDC ''wil be filled by code
global angle , state
open "opengl32.dll" for dll as #gl
open "openGL" for graphics as #m
#m "trapclose [quit]"
#m "when characterInput [key]"
#m "setfocus"
MainH = hwnd( #m )
call openglInit
state = 6
timer 40 , [timer]
wait
[timer]
scan
call glClear GL.COLOR.BUFFER.BIT or GL.DEPTH.BUFFER.BIT
call glLoadIdentity
call glScale winyx , 1 , 1
call glPushMatrix
select case state
case 0
call glRotate angle , 1,1,0
call setbox 0,0,0 , .5,.5,.5
call cube red,cyan , green,magenta , blue,yellow
case 1
call glRotate angle , 1,0,1
call setbox 0,0,0 , .5,.5,.5
call color8cube
case 2
call glRotate angle , 0,1,1
call setbox 0,0,0 , .5,.25,.5
call cone 6 , .5 , .5 , rainbow( angle )
case 3
call glRotate angle , 1,1,1
call setbox 0,0,0 , .5,.25,.25
call torus 6 , 6 , -1
case 4
call glRotate angle , 1,1,1
call setbox 0,0,0 , .5,.25,.25
call torus 6 , 6 , -2
case 5
call glRotate angle , 1,1,1
call setbox 0,0,0 , .5,.25,.25
call torus 6 , 6 , -3
case 6
call glRotate angle , 1,1,1
call setbox 0,0,0 , .5,.2,.2
call banana 6 , 6 , -1
case 7
call glRotate angle , 1,1,1
call setbox 0,0,0 , .5,.2,.2
call banana 6 , 12 , -2
case 8
call glRotate angle , 1,1,1
call setbox 0,0,0 , .5,.5,.2
call banana 6 , 16 , -3
case else
call glRotate angle , 0,0,1
call point 0 , 0,1,0
call point 1 , .8,-.6,0
call point 2 , -.8,-.6,0
call tri3 0 , red , 1 , green , 2 , blue
end select
call glPopMatrix
calldll #gdi32,"SwapBuffers" _
, MainDC as ulong _
, ret as long
angle = angle + 1
if angle mod 360 = 0 then state = state + 1
if state >= 10 then state = 0
[key]
key$ = right$( Inkey$ , 1 )
if key$ <> chr$( 27 ) then wait
[quit]
calldll #gl,"wglMakeCurrent" _
, 0 as ulong, 0 as ulong, ret as long
calldll #gl,"wglDeleteContext" _
, GLContext as ulong, ret as long
calldll #user32, "ReleaseDC" _
, MainH as ulong, MainDC as ulong,ret as long
close #m
close #gl
end
'' color object math
function rainbow( x )
r = sin( rad( x ) ) * 127 + 128
g = sin( rad( x - 120 ) ) * 127 + 128
b = sin( rad( x + 120 ) ) * 127 + 128
rainbow = rgba( r , g , b , 255 )
end function
function rgba( r , g , b , a )
''create color object
r = r and 255
g = g and 255
b = b and 255
a = a and 255
rgba = r + g * 256 + b * 256 ^ 2 + a * 256 ^ 3
end function
function colorR( clr )
''get red channel from color object
colorR = int( clr and 255 ) / 256
end function
function colorG( clr )
''get green channel from color object
colorG = ( int( clr / 256 ) and 255 ) / 256
end function
function colorB( clr )
''get blue channel from color object
colorB = ( int( clr / 256 ^ 2 ) and 255 ) / 256
end function
function colorA( clr )
''get alpha channel from color object
colorA = ( int( clr / 256 ^ 3 ) and 255 ) / 256
end function
'' 3d engine stuf
sub child x , y , z , lim , ax
''create a joint for avatar animation
if lim < 0 or lim > 64 then exit sub
select case ax
case xyz
call glTranslate x , y , z
call glRotate sk(lim,0) , 1,0,0
call glRotate sk(lim,1) , 0,1,0
call glRotate sk(lim,2) , 0,0,1
case xzy
call glTranslate x , y , z
call glRotate sk(lim,0) , 1,0,0
call glRotate sk(lim,2) , 0,0,1
call glRotate sk(lim,1) , 0,1,0
case yxz
call glTranslate x , y , z
call glRotate sk(lim,1) , 0,1,0
call glRotate sk(lim,0) , 1,0,0
call glRotate sk(lim,2) , 0,0,1
case yzx
call glTranslate x , y , z
call glRotate sk(lim,1) , 0,1,0
call glRotate sk(lim,2) , 0,0,1
call glRotate sk(lim,0) , 1,0,0
case zxy
call glTranslate x , y , z
call glRotate sk(lim,2) , 0,0,1
call glRotate sk(lim,0) , 1,0,0
call glRotate sk(lim,1) , 0,1,0
case zyx
call glTranslate x , y , z
call glRotate sk(lim,2) , 0,0,1
call glRotate sk(lim,1) , 0,1,0
call glRotate sk(lim,0) , 1,0,0
case else
end select
end sub
sub skelet no , x , y , z
''set the angle's of a joint of a avatar
if no < 0 or no > 64 then exit sub
sk( no , 0 ) = x
sk( no , 1 ) = y
sk( no , 2 ) = z
end sub
function pend( f , a )
''for smooth animation of a joint
pend = sin( rad( f ) ) * a
end function
function rad( x )
''fron degree's to radian's
rad = x * pi / 180
end function
function sgn( x )
uit = 0
if x < 0 then uit = -1
if x > 0 then uit = 1
sgn = uit
end function
'' shapes part of bluaGL
sub setbox mx , my , mz , dx , dy , dz
''set bodinging box coordinates
box(0) = mx
box(1) = my
box(2) = mz
box(3) = dx
box(4) = dy
box(5) = dz
end sub
sub cone s , dx , dz , kl
''s = number of side's
''dx , dz = diametger top
''kl = color cylinder
if s < 4 then s = 4
if s > 24 then s = 24
call glPushMatrix
call glTranslate box(0) , box(1) , box(2)
call glScale box(3) , box(4) , box(5)
for i = 0 to pi * 2 step pi * 2 / s
i2 = i + pi * 2 / s
call point 0 , sin( i ) * dx , 1 , cos( i ) * dz
call point 1 , sin( i2 ) * dx , 1 , cos( i2 ) * dz
call point 2 , sin( i2 ) , -1 , cos( i2 )
call point 3 , sin( i ) , -1 , cos( i )
call quad 0 , 1 , 2 , 3 , kl
next i
call glPopMatrix
end sub
sub sphere a , b , da , db , kl
''a , b = number of sides
''da , db = superellipsoid [ 1 , 1 for normal sphere ]
''kl = color of sphere
if a < 4 then a = 4
if a > 24 then a = 24
if b < 4 then b = 4
if b > 24 then b = 24
call glPushMatrix
call glTranslate box( 0 ) , box( 1 ) , box( 2 )
call glScale box( 3 ) , box( 4 ) , box( 5 )
for i = 0-pi to pi step pi / a * 2
i2 = i + pi / a * 2
for j = 0-pi / 2 to pi / 2 - pi / b * 2 step pi / b * 2
j2 = j + pi / b * 2
x = sin( i ) * cos( j )
y = sin( j )
z = cos( i ) * cos( j )
call point 0 _
, abs( x ) ^ da * sgn( x ) _
, abs( y ) ^ db * sgn( y ) _
, abs( z ) ^ da * sgn( z )
x = sin( i2 ) * cos( j )
y = sin( j )
z = cos( i2 ) * cos( j )
call point 1 _
, abs( x ) ^ da * sgn( x ) _
, abs( y ) ^ db * sgn( y ) _
, abs( z ) ^ da * sgn( z )
x = sin( i2 ) * cos( j2 )
y = sin( j2 )
z = cos( i2 ) * cos( j2 )
call point 2 _
, abs( x ) ^ da * sgn( x ) _
, abs( y ) ^ db * sgn( y ) _
, abs( z ) ^ da * sgn( z )
x = sin( i ) * cos( j2 )
y = sin( j2 )
z = cos( i ) * cos( j2 )
call point 3 _
, abs( x ) ^ da * sgn( x ) _
, abs( y ) ^ db * sgn( y ) _
, abs( z ) ^ da * sgn( z )
call quad 0 , 1 , 2 , 3 , kl
next j
next i
call glPopMatrix
end sub
sub torus a , b , kl
''a , b = number of sides
''kl = color mode
if a < 4 then a = 4
if a > 24 then a = 24
if b < 4 then b = 4
if b > 24 then b = 24
mx = box( 0 )
my = box( 1 )
mz = box( 2 )
dx = box( 3 )
dy = box( 4 )
dz = box( 5 )
for i = 0-pi to pi step pi / a * 2
i2 = i + pi / a * 2
for j = 0-pi to pi step pi / b * 2
j2 = j + pi / b * 2
call point 0 _
, mx + ( dx + dy * cos( i ) ) * cos( j ) _
, my + ( dx + dy * cos( i ) ) * sin( j ) _
, mz + sin( i ) * dz
call point 1 _
, mx + ( dx + dy * cos( i ) ) * cos( j2 ) _
, my + ( dx + dy * cos( i ) ) * sin( j2 ) _
, mz + sin( i ) * dz
call point 2 _
, mx + ( dx + dy * cos( i2 ) ) * cos( j2 ) _
, my + ( dx + dy * cos( i2 ) ) * sin( j2 ) _
, mz + sin( i2 ) * dz
call point 3 _
, mx + ( dx + dy * cos( i2 ) ) * cos( j ) _
, my + ( dx + dy * cos( i2 ) ) * sin( j ) _
, mz + sin( i2 ) * dz
if kl > 0 then
call quad 0 , 1 , 2 , 3 , kl
else
select case kl
case -1
kla = rainbow( i * 180 / pi)
klb = rainbow( i2 * 180 / pi)
call quad4 0 , kla , 1 , kla , 2 , klb , 3 , klb
case -2
kla = rainbow( j * 180 / pi )
klb = rainbow( j2 * 180 / pi)
call quad4 0 , kla , 1 , klb , 2 , klb , 3 , kla
case else
kla = rainbow( ( j + i ) * 180 / pi )
klc = rainbow( ( j + i + j2 + i2 ) / 2 * 180 / pi )
klb = rainbow( ( j2 + i2 ) * 180 / pi )
call quad4 0 , kla , 1 , klc , 2 , klb , 3 , klc
end select
end if
next j
next i
end sub
sub banana a , b , kl
if a < 3 then a = 3
if a > 64 then a = 64
if b < 3 then b = 3
if b > 64 then b = 64
mx = box(0)
my = box(1)
mz = box(2)
dx = box(3)
dy = box(4)
dz = box(5)
for i = 0-pi to pi step pi / a * 2
i2 = i + pi / a * 2
for j = 0-pi/1.99 to pi/1.99 - pi/b*2 step pi / b * 1.99
j2 = j + pi / b * 1.99
call point 0 _
, mx + ( dx + dy * cos( i ) * cos( j ) ) _
* cos( j ) _
, my + ( dx + dy * cos( i ) * cos( j ) ) _
* sin( j ) _
, mz + sin( i ) * dz * cos( j )
call point 1 _
, mx + ( dx + dy * cos( i ) * cos( j2 ) ) _
* cos( j2 ) _
, my + ( dx + dy * cos( i ) * cos( j2 ) ) _
* sin( j2 ) _
, mz + sin( i ) * dz * cos( j2 )
call point 2 _
, mx + ( dx + dy * cos( i2 ) * cos( j2 ) ) _
* cos( j2 ) _
, my + ( dx + dy * cos( i2 ) * cos( j2 ) ) _
* sin( j2 ) _
, mz + sin( i2 ) * dz * cos( j2 )
call point 3 _
, mx + ( dx + dy * cos( i2 ) * cos( j ) ) _
* cos( j ) _
, my + ( dx + dy * cos( i2 ) * cos( j ) ) _
* sin( j ) _
, mz + sin( i2 ) * dz * cos( j )
if kl > 0 then
call quad 0 , 1 , 2 , 3 , kl
else
select case kl
case -1
kla = rainbow( i * 180 / pi)
klb = rainbow( i2 * 180 / pi)
call quad4 0 , kla , 1 , kla , 2 , klb , 3 , klb
case -2
kla = rainbow( j * 180 / pi )
klb = rainbow( j2 * 180 / pi)
call quad4 0 , kla , 1 , klb , 2 , klb , 3 , kla
case else
kla = rainbow( ( j + i ) * 180 / pi )
klc = rainbow( ( j + i + j2 + i2 ) / 2 * 180 / pi )
klb = rainbow( ( j2 + i2 ) * 180 / pi )
call quad4 0 , kla , 1 , klc , 2 , klb , 3 , klc
end select
end if
next j
next i
end sub
sub colorcube
call cube red,cyan , green,magenta , blue,yellow
end sub
sub color8cube
''create point's in the swarm
call point 0 , -1 , -1 , -1
call point 1 , -1 , -1 , 1
call point 2 , -1 , 1 , -1
call point 3 , -1 , 1 , 1
call point 4 , 1 , -1 , -1
call point 5 , 1 , -1 , 1
call point 6 , 1 , 1 , -1
call point 7 , 1 , 1 , 1
''then use points in swarm to draw quads
call glPushMatrix
call glTranslate box(0) , box(1) , box(2)
call glScale box(3) , box(4) , box(5)
call quad4 0 , black , 1 , red , 3 , yellow , 2 , green
call quad4 7 , white , 6 , cyan , 4 , blue , 5 , magenta
call quad4 0 , black , 2 , green , 6 , cyan , 4 , blue
call quad4 7 , white , 5 , magenta , 1 , red , 3 , yellow
call quad4 0 , black , 1 , red , 5 , magenta , 4 , blue
call quad4 7 , white , 6 , cyan , 2 , green , 3 , yellow
call glPopMatrix
end sub
sub cube left , right , front , back , down , up
''create a cube mesh
''whit 6 colors and whit bodingbox coordinates
''first fil swarm whit points
call point 0 , -1 , -1 , -1
call point 1 , -1 , -1 , 1
call point 2 , -1 , 1 , -1
call point 3 , -1 , 1 , 1
call point 4 , 1 , -1 , -1
call point 5 , 1 , -1 , 1
call point 6 , 1 , 1 , -1
call point 7 , 1 , 1 , 1
''then use points in swarm to draw quads
call glPushMatrix
call glTranslate box(0) , box(1) , box(2)
call glScale box(3) , box(4) , box(5)
call quad 0 , 1 , 3 , 2 , left
call quad 7 , 6 , 4 , 5 , right
call quad 0 , 2 , 6 , 4 , front
call quad 7 , 5 , 1 , 3 , back
call quad 0 , 1 , 5 , 4 , down
call quad 7 , 6 , 2 , 3 , up
call glPopMatrix
end sub
sub point no , x , y , z
''set a point in the swarm
if no < 0 or no > 256 then exit sub
pntx( no ) = x
pnty( no ) = y
pntz( no ) = z
end sub
sub tri p1 , p2 , p3 , kl
''draw a triangle whit 1 color
call tri3 p1 , kl , p2 , kl , p3 , kl
end sub
sub tri3 p1 , kl1 , p2 , kl2 , p3 , kl3
''draw a triangle from point's in the swarm
''whit 3 color's
if p1 < 0 or p1 > 256 then exit sub
if p2 < 0 or p2 > 256 then exit sub
if p3 < 0 or p3 > 256 then exit sub
x1 = pntx( p1 )
y1 = pnty( p1 )
z1 = pntz( p1 )
x2 = pntx( p2 )
y2 = pnty( p2 )
z2 = pntz( p2 )
x3 = pntx( p3 )
y3 = pnty( p3 )
z3 = pntz( p3 )
call glBegin GL.TRIANGLES
call setColor kl1
call glVertex x1 , y1 , z1
call setColor kl2
call glVertex x2 , y2 , z2
call setColor kl3
call glVertex x3 , y3 , z3
call glEnd
end sub
sub quad p1 , p2 , p3 , p4 , kl
''draw a quadangle from points in the swarm
''whit 1 color
call quad4 p1 , kl , p2 , kl , p3 , kl , p4 , kl
end sub
sub quad4 p1 , kl1 , p2 , kl2 , p3 , kl3 , p4 , kl4
''draw a quadangle from points in the swarm
''whit 4 color's
if p1 < 0 or p1 > 256 then exit sub
if p2 < 0 or p2 > 256 then exit sub
if p3 < 0 or p3 > 256 then exit sub
if p4 < 0 or p4 > 256 then exit sub
x1 = pntx( p1 )
y1 = pnty( p1 )
z1 = pntz( p1 )
x2 = pntx( p2 )
y2 = pnty( p2 )
z2 = pntz( p2 )
x3 = pntx( p3 )
y3 = pnty( p3 )
z3 = pntz( p3 )
x4 = pntx( p4 )
y4 = pnty( p4 )
z4 = pntz( p4 )
call glBegin GL.QUADS
call setColor kl1
call glVertex x1 , y1 , z1
call setColor kl2
call glVertex x2 , y2 , z2
call setColor kl3
call glVertex x3 , y3 , z3
call setColor kl4
call glVertex x4 , y4 , z4
call glEnd
end sub
'' openGl
sub glClear code
''clear the openGL screen
calldll #gl,"glClear" _
, code as long _
, ret as long
end sub
sub glLoadIdentity
''set drawingmatrix to standert
calldll #gl , "glLoadIdentity" _
, ret as long
end sub
sub glPushMatrix
''to new drawingmatrix
calldll #gl , "glPushMatrix" _
, ret as long
end sub
sub glPopMatrix
''to old drawingmatrix
calldll #gl , "glPopMatrix" _
, ret as long
end sub
sub glEnd
''end of polygon[s]
calldll #gl , "glEnd" _
, ret as void
end sub
sub glEnable i
''set a item
calldll #gl , "glEnable" _
, i as long _
, ret as long
end sub
sub glBegin i
''set polygon mode
calldll #gl , "glBegin" _
, i as long _
, ret as long
end sub
sub glScale x , y , z
''scale drawingmatrix
calldll #gl , "glScaled" _
, x as double _
, y as double _
, z as double _
, ret as long
end sub
sub glTranslate x , y , z
''move drawingmatrix
calldll #gl , "glTranslated" _
, x as double _
, y as double _
, z as double _
, ret as long
end sub
sub glRotate a , x , y , z
''rotate drawinmatrix
calldll #gl , "glRotated" _
, a as double _
, x as double _
, y as double _
, z as double _
, ret as long
end sub
sub glVertex x , y , z
''add a point to a polygon
calldll #gl , "glVertex3d" _
, x as double _
, y as double _
, z as double _
, ret as long
end sub
sub glNormal x , y , z
''set normal of point[s]
calldll #gl , "glNormal3f" _
, x as double _
, y as double _
, z as double _
, ret as long
end sub
sub setColor clr
''set color of point[s] of polygon
r = colorR( clr )
g = colorG( clr )
b = colorB( clr )
a = colorA( clr )
calldll #gl , "glColor4d" _
, r as double _
, g as double _
, b as double _
, a as double _
, ret as long
end sub
sub openglInit
struct PFD _
, Size as word _
, Version as word _
, Flags as long _
, pixelType as char[1] _
, ColorBits as char[1] _
, RedBits as char[1] _
, RedShift as char[1] _
, GreenBits as char[1] _
, GreenShift as char[1] _
, BlueBits as char[1] _
, BlueShift as char[1] _
, AlphaBits as char[1] _
, AlphaShift as char[1] _
, AccumBits as char[1] _
, AccumRedBits as char[1] _
, AccumGreenBits as char[1] _
, AccumBlueBits as char[1] _
, AccumAlphaBits as char[1] _
, DepthBits as char[1] _
, StencilBits as char[1] _
, AuxBuffers as char[1] _
, LayerType as char[1] _
, Reserved as char[1] _
, LayerMask as long _
, VisibleMask as long _
, DamageMask as long
PFD.Version.struct=1
PFD.ColorBits.struct=24
PFD.DepthBits.struct=16
PFD.Size.struct=len(PFD.struct)
PFD.Flags.struct=37
calldll #user32,"GetDC" _
, MainH as ulong, MainDC as ulong
calldll #gdi32,"ChoosePixelFormat" _
, MainDC as ulong, PFD as struct, ret as long
calldll #gdi32, "SetPixelFormat" _
, MainDC as ulong, ret as long _
, PFD as struct, t as long
calldll #gl,"wglCreateContext" _
, MainDC as ulong, GLContext as ulong
calldll #gl,"wglMakeCurrent" _
, MainDC as ulong, GLContext as ulong _
, ret as long
call glEnable GL.DEPTH.TEST
end sub
|
|
|
Post by bluatigro on Aug 26, 2020 10:09:22 GMT -5
cube whit lim animation added
''bluatigro 26 aug 2020 ''@bluaGL.bas ''wil be openGL wrapper lib ''version 1 : only color and points
nomainwin dim pntx(256),pnty(256),pntz(256),box(5),sk(64,2) global pi : pi = atn( 1 ) * 4
'' color objects
global black , red , green , yellow global blue , magenta , cyan , white global gray , pink , purple , orange black = rgba( 000 , 000 , 000 , 255 ) red = rgba( 255 , 000 , 000 , 255 ) green = rgba( 000 , 255 , 000 , 255 ) yellow = rgba( 255 , 255 , 000 , 255 ) blue = rgba( 000 , 000 , 255 , 255 ) magenta = rgba( 255 , 000 , 255 , 255 ) cyan = rgba( 000 , 255 , 255 , 255 ) white = rgba( 255 , 255 , 255 , 255 ) gray = rgba( 127 , 127 , 127 , 255 ) pink = rgba( 255 , 127 , 127 , 255 ) purple = rgba( 127 , 000 , 127 , 255 ) orange = rgba( 255 , 127 , 000 , 255 ) global xyz , xzy , yxz , yzx , zxy , zyx xyz = 0 xzy = 1 yxz = 2 yzx = 3 zxy = 4 zyx = 5
'' opengl consts
global GL.COLOR.BUFFER.BIT : GL.COLOR.BUFFER.BIT = 16384 global GL.DEPTH.BUFFER.BIT : GL.DEPTH.BUFFER.BIT = 256 global GL.DEPTH.TEST : GL.DEPTH.TEST = 2929 ' primatifs global GL.TRIANGLES : GL.TRIANGLES = 4 global GL.QUADS : GL.QUADS = 7
WindowWidth = DisplayWidth WindowHeight = DisplayHeight global winx , winy , winyx winx = WindowWidth winy = WindowHeight winyx = winy / winx
global MainH , MainDC ''wil be filled by code
global angle , state open "opengl32.dll" for dll as #gl open "openGL" for graphics as #m
#m "trapclose [quit]" #m "when characterInput [key]" #m "setfocus" MainH = hwnd( #m ) call openglInit state = 9 timer 40 , [timer] wait [timer] scan call glClear GL.COLOR.BUFFER.BIT or GL.DEPTH.BUFFER.BIT call glLoadIdentity call glScale winyx , 1 , 1 call glPushMatrix select case state case 0 call glRotate angle , 1,1,0 call setbox 0,0,0 , .5,.5,.5 call cube red,cyan , green,magenta , blue,yellow case 1 call glRotate angle , 1,0,1 call setbox 0,0,0 , .5,.5,.5 call color8cube case 2 call glRotate angle , 0,1,1 call setbox 0,0,0 , .5,.25,.5 call cone 6 , .5 , .5 , rainbow( angle ) case 3 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.25,.25 call torus 6 , 6 , -1 case 4 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.25,.25 call torus 6 , 6 , -2 case 5 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.25,.25 call torus 6 , 6 , -3 case 6 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.2,.2 call banana 6 , 6 , -1 case 7 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.2,.2 call banana 6 , 12 , -2 case 8 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.5,.2 call banana 6 , 16 , -3 case 9 call glRotate 30 , 1,1,1 call glScale .4,.4,.4 call skelet 0 , 0,pend(angle,45)+45,0 call skelet 1 , pend(angle,-45)-45,0,0 call skelet 2 , pend(angle,45)+45,0,0 call skelet 3 , 0,pend(angle,-45)-45,0 call setbox 0,0,0 , .5,.5,.1 call color8cube call glPushMatrix call child .5,0,0 , 0 , xyz call setbox .5,0,0 , .5,.5,.1 call color8cube call glPushMatrix call child 1,0,0 , 0 , xyz call color8cube call glPopMatrix call glPopMatrix call glPushMatrix call child 0,.5,0 , 1 , xyz call setbox 0,.5,0 , .5,.5,.1 call color8cube call glPopMatrix call glPushMatrix call child 0,-.5,0 , 2 , xyz call setbox 0,-.5,0 , .5,.5,.1 call color8cube call glPopMatrix call glPushMatrix call child -.5,0,0 , 3 , xyz call setbox -.5,0,0 , .5,.5,.1 call color8cube call glPopMatrix case else call glRotate angle , 0,0,1 call point 0 , 0,1,0 call point 1 , .8,-.6,0 call point 2 , -.8,-.6,0 call tri3 0 , red , 1 , green , 2 , blue end select call glPopMatrix
calldll #gdi32,"SwapBuffers" _ , MainDC as ulong _ , ret as long angle = angle + 1 if angle mod 360 = 0 then state = state + 1 if state > 10 then state = 0 [key] key$ = right$( Inkey$ , 1 ) if key$ <> chr$( 27 ) then wait [quit] calldll #gl,"wglMakeCurrent" _ , 0 as ulong, 0 as ulong, ret as long calldll #gl,"wglDeleteContext" _ , GLContext as ulong, ret as long calldll #user32, "ReleaseDC" _ , MainH as ulong, MainDC as ulong,ret as long close #m close #gl end '' color object math
function rainbow( x ) r = sin( rad( x ) ) * 127 + 128 g = sin( rad( x - 120 ) ) * 127 + 128 b = sin( rad( x + 120 ) ) * 127 + 128 rainbow = rgba( r , g , b , 255 ) end function function rgba( r , g , b , a ) ''create color object r = r and 255 g = g and 255 b = b and 255 a = a and 255 rgba = r + g * 256 + b * 256 ^ 2 + a * 256 ^ 3 end function function colorR( clr ) ''get red channel from color object colorR = int( clr and 255 ) / 256 end function function colorG( clr ) ''get green channel from color object colorG = ( int( clr / 256 ) and 255 ) / 256 end function function colorB( clr ) ''get blue channel from color object colorB = ( int( clr / 256 ^ 2 ) and 255 ) / 256 end function function colorA( clr ) ''get alpha channel from color object colorA = ( int( clr / 256 ^ 3 ) and 255 ) / 256 end function
'' 3d engine stuf
sub child x , y , z , lim , ax ''create a joint for avatar animation if lim < 0 or lim > 64 then exit sub select case ax case xyz call glTranslate x , y , z call glRotate sk(lim,0) , 1,0,0 call glRotate sk(lim,1) , 0,1,0 call glRotate sk(lim,2) , 0,0,1 case xzy call glTranslate x , y , z call glRotate sk(lim,0) , 1,0,0 call glRotate sk(lim,2) , 0,0,1 call glRotate sk(lim,1) , 0,1,0 case yxz call glTranslate x , y , z call glRotate sk(lim,1) , 0,1,0 call glRotate sk(lim,0) , 1,0,0 call glRotate sk(lim,2) , 0,0,1 case yzx call glTranslate x , y , z call glRotate sk(lim,1) , 0,1,0 call glRotate sk(lim,2) , 0,0,1 call glRotate sk(lim,0) , 1,0,0 case zxy call glTranslate x , y , z call glRotate sk(lim,2) , 0,0,1 call glRotate sk(lim,0) , 1,0,0 call glRotate sk(lim,1) , 0,1,0 case zyx call glTranslate x , y , z call glRotate sk(lim,2) , 0,0,1 call glRotate sk(lim,1) , 0,1,0 call glRotate sk(lim,0) , 1,0,0 case else end select end sub
sub skelet no , x , y , z ''set the angle's of a joint of a avatar if no < 0 or no > 64 then exit sub sk( no , 0 ) = x sk( no , 1 ) = y sk( no , 2 ) = z end sub
function pend( f , a ) ''for smooth animation of a joint pend = sin( rad( f ) ) * a end function
function rad( x ) ''fron degree's to radian's rad = x * pi / 180 end function
function sgn( x ) uit = 0 if x < 0 then uit = -1 if x > 0 then uit = 1 sgn = uit end function
'' shapes part of bluaGL
sub setbox mx , my , mz , dx , dy , dz ''set bodinging box coordinates box(0) = mx box(1) = my box(2) = mz box(3) = dx box(4) = dy box(5) = dz end sub
sub cone s , dx , dz , kl ''s = number of side's ''dx , dz = diametger top ''kl = color cylinder if s < 4 then s = 4 if s > 24 then s = 24 call glPushMatrix call glTranslate box(0) , box(1) , box(2) call glScale box(3) , box(4) , box(5) for i = 0 to pi * 2 step pi * 2 / s i2 = i + pi * 2 / s call point 0 , sin( i ) * dx , 1 , cos( i ) * dz call point 1 , sin( i2 ) * dx , 1 , cos( i2 ) * dz call point 2 , sin( i2 ) , -1 , cos( i2 ) call point 3 , sin( i ) , -1 , cos( i ) call quad 0 , 1 , 2 , 3 , kl next i call glPopMatrix end sub
sub sphere a , b , da , db , kl ''a , b = number of sides ''da , db = superellipsoid [ 1 , 1 for normal sphere ] ''kl = color of sphere if a < 4 then a = 4 if a > 24 then a = 24 if b < 4 then b = 4 if b > 24 then b = 24 call glPushMatrix call glTranslate box( 0 ) , box( 1 ) , box( 2 ) call glScale box( 3 ) , box( 4 ) , box( 5 ) for i = 0-pi to pi step pi / a * 2 i2 = i + pi / a * 2 for j = 0-pi / 2 to pi / 2 - pi / b * 2 step pi / b * 2 j2 = j + pi / b * 2
x = sin( i ) * cos( j ) y = sin( j ) z = cos( i ) * cos( j ) call point 0 _ , abs( x ) ^ da * sgn( x ) _ , abs( y ) ^ db * sgn( y ) _ , abs( z ) ^ da * sgn( z )
x = sin( i2 ) * cos( j ) y = sin( j ) z = cos( i2 ) * cos( j ) call point 1 _ , abs( x ) ^ da * sgn( x ) _ , abs( y ) ^ db * sgn( y ) _ , abs( z ) ^ da * sgn( z )
x = sin( i2 ) * cos( j2 ) y = sin( j2 ) z = cos( i2 ) * cos( j2 ) call point 2 _ , abs( x ) ^ da * sgn( x ) _ , abs( y ) ^ db * sgn( y ) _ , abs( z ) ^ da * sgn( z )
x = sin( i ) * cos( j2 ) y = sin( j2 ) z = cos( i ) * cos( j2 ) call point 3 _ , abs( x ) ^ da * sgn( x ) _ , abs( y ) ^ db * sgn( y ) _ , abs( z ) ^ da * sgn( z )
call quad 0 , 1 , 2 , 3 , kl next j next i call glPopMatrix end sub
sub torus a , b , kl ''a , b = number of sides ''kl = color mode if a < 4 then a = 4 if a > 24 then a = 24 if b < 4 then b = 4 if b > 24 then b = 24 mx = box( 0 ) my = box( 1 ) mz = box( 2 ) dx = box( 3 ) dy = box( 4 ) dz = box( 5 ) for i = 0-pi to pi step pi / a * 2 i2 = i + pi / a * 2 for j = 0-pi to pi step pi / b * 2 j2 = j + pi / b * 2 call point 0 _ , mx + ( dx + dy * cos( i ) ) * cos( j ) _ , my + ( dx + dy * cos( i ) ) * sin( j ) _ , mz + sin( i ) * dz call point 1 _ , mx + ( dx + dy * cos( i ) ) * cos( j2 ) _ , my + ( dx + dy * cos( i ) ) * sin( j2 ) _ , mz + sin( i ) * dz call point 2 _ , mx + ( dx + dy * cos( i2 ) ) * cos( j2 ) _ , my + ( dx + dy * cos( i2 ) ) * sin( j2 ) _ , mz + sin( i2 ) * dz call point 3 _ , mx + ( dx + dy * cos( i2 ) ) * cos( j ) _ , my + ( dx + dy * cos( i2 ) ) * sin( j ) _ , mz + sin( i2 ) * dz if kl > 0 then call quad 0 , 1 , 2 , 3 , kl else select case kl case -1 kla = rainbow( i * 180 / pi) klb = rainbow( i2 * 180 / pi) call quad4 0 , kla , 1 , kla , 2 , klb , 3 , klb case -2 kla = rainbow( j * 180 / pi ) klb = rainbow( j2 * 180 / pi) call quad4 0 , kla , 1 , klb , 2 , klb , 3 , kla case else kla = rainbow( ( j + i ) * 180 / pi ) klc = rainbow( ( j + i + j2 + i2 ) / 2 * 180 / pi ) klb = rainbow( ( j2 + i2 ) * 180 / pi ) call quad4 0 , kla , 1 , klc , 2 , klb , 3 , klc end select end if next j next i end sub
sub banana a , b , kl if a < 3 then a = 3 if a > 64 then a = 64 if b < 3 then b = 3 if b > 64 then b = 64 mx = box(0) my = box(1) mz = box(2) dx = box(3) dy = box(4) dz = box(5) for i = 0-pi to pi step pi / a * 2 i2 = i + pi / a * 2 for j = 0-pi/1.99 to pi/1.99 - pi/b*2 step pi / b * 1.99 j2 = j + pi / b * 1.99 call point 0 _ , mx + ( dx + dy * cos( i ) * cos( j ) ) _ * cos( j ) _ , my + ( dx + dy * cos( i ) * cos( j ) ) _ * sin( j ) _ , mz + sin( i ) * dz * cos( j ) call point 1 _ , mx + ( dx + dy * cos( i ) * cos( j2 ) ) _ * cos( j2 ) _ , my + ( dx + dy * cos( i ) * cos( j2 ) ) _ * sin( j2 ) _ , mz + sin( i ) * dz * cos( j2 ) call point 2 _ , mx + ( dx + dy * cos( i2 ) * cos( j2 ) ) _ * cos( j2 ) _ , my + ( dx + dy * cos( i2 ) * cos( j2 ) ) _ * sin( j2 ) _ , mz + sin( i2 ) * dz * cos( j2 ) call point 3 _ , mx + ( dx + dy * cos( i2 ) * cos( j ) ) _ * cos( j ) _ , my + ( dx + dy * cos( i2 ) * cos( j ) ) _ * sin( j ) _ , mz + sin( i2 ) * dz * cos( j )
if kl > 0 then call quad 0 , 1 , 2 , 3 , kl else select case kl case -1 kla = rainbow( i * 180 / pi) klb = rainbow( i2 * 180 / pi) call quad4 0 , kla , 1 , kla , 2 , klb , 3 , klb case -2 kla = rainbow( j * 180 / pi ) klb = rainbow( j2 * 180 / pi) call quad4 0 , kla , 1 , klb , 2 , klb , 3 , kla case else kla = rainbow( ( j + i ) * 180 / pi ) klc = rainbow( ( j + i + j2 + i2 ) / 2 * 180 / pi ) klb = rainbow( ( j2 + i2 ) * 180 / pi ) call quad4 0 , kla , 1 , klc , 2 , klb , 3 , klc end select end if next j next i end sub
sub colorcube call cube red,cyan , green,magenta , blue,yellow end sub sub color8cube ''create point's in the swarm call point 0 , -1 , -1 , -1 call point 1 , -1 , -1 , 1 call point 2 , -1 , 1 , -1 call point 3 , -1 , 1 , 1 call point 4 , 1 , -1 , -1 call point 5 , 1 , -1 , 1 call point 6 , 1 , 1 , -1 call point 7 , 1 , 1 , 1
''then use points in swarm to draw quads call glPushMatrix call glTranslate box(0) , box(1) , box(2) call glScale box(3) , box(4) , box(5) call quad4 0 , black , 1 , red , 3 , yellow , 2 , green call quad4 7 , white , 6 , cyan , 4 , blue , 5 , magenta call quad4 0 , black , 2 , green , 6 , cyan , 4 , blue call quad4 7 , white , 5 , magenta , 1 , red , 3 , yellow call quad4 0 , black , 1 , red , 5 , magenta , 4 , blue call quad4 7 , white , 6 , cyan , 2 , green , 3 , yellow call glPopMatrix end sub
sub cube left , right , front , back , down , up ''create a cube mesh ''whit 6 colors and whit bodingbox coordinates
''first fil swarm whit points call point 0 , -1 , -1 , -1 call point 1 , -1 , -1 , 1 call point 2 , -1 , 1 , -1 call point 3 , -1 , 1 , 1 call point 4 , 1 , -1 , -1 call point 5 , 1 , -1 , 1 call point 6 , 1 , 1 , -1 call point 7 , 1 , 1 , 1
''then use points in swarm to draw quads call glPushMatrix call glTranslate box(0) , box(1) , box(2) call glScale box(3) , box(4) , box(5) call quad 0 , 1 , 3 , 2 , left call quad 7 , 6 , 4 , 5 , right call quad 0 , 2 , 6 , 4 , front call quad 7 , 5 , 1 , 3 , back call quad 0 , 1 , 5 , 4 , down call quad 7 , 6 , 2 , 3 , up call glPopMatrix end sub
sub point no , x , y , z ''set a point in the swarm if no < 0 or no > 256 then exit sub pntx( no ) = x pnty( no ) = y pntz( no ) = z end sub
sub tri p1 , p2 , p3 , kl ''draw a triangle whit 1 color call tri3 p1 , kl , p2 , kl , p3 , kl end sub
sub tri3 p1 , kl1 , p2 , kl2 , p3 , kl3 ''draw a triangle from point's in the swarm ''whit 3 color's if p1 < 0 or p1 > 256 then exit sub if p2 < 0 or p2 > 256 then exit sub if p3 < 0 or p3 > 256 then exit sub x1 = pntx( p1 ) y1 = pnty( p1 ) z1 = pntz( p1 ) x2 = pntx( p2 ) y2 = pnty( p2 ) z2 = pntz( p2 ) x3 = pntx( p3 ) y3 = pnty( p3 ) z3 = pntz( p3 ) call glBegin GL.TRIANGLES call setColor kl1 call glVertex x1 , y1 , z1 call setColor kl2 call glVertex x2 , y2 , z2 call setColor kl3 call glVertex x3 , y3 , z3 call glEnd end sub
sub quad p1 , p2 , p3 , p4 , kl ''draw a quadangle from points in the swarm ''whit 1 color call quad4 p1 , kl , p2 , kl , p3 , kl , p4 , kl end sub
sub quad4 p1 , kl1 , p2 , kl2 , p3 , kl3 , p4 , kl4 ''draw a quadangle from points in the swarm ''whit 4 color's if p1 < 0 or p1 > 256 then exit sub if p2 < 0 or p2 > 256 then exit sub if p3 < 0 or p3 > 256 then exit sub if p4 < 0 or p4 > 256 then exit sub x1 = pntx( p1 ) y1 = pnty( p1 ) z1 = pntz( p1 ) x2 = pntx( p2 ) y2 = pnty( p2 ) z2 = pntz( p2 ) x3 = pntx( p3 ) y3 = pnty( p3 ) z3 = pntz( p3 ) x4 = pntx( p4 ) y4 = pnty( p4 ) z4 = pntz( p4 ) call glBegin GL.QUADS call setColor kl1 call glVertex x1 , y1 , z1 call setColor kl2 call glVertex x2 , y2 , z2 call setColor kl3 call glVertex x3 , y3 , z3 call setColor kl4 call glVertex x4 , y4 , z4 call glEnd end sub
'' openGl
sub glClear code ''clear the openGL screen calldll #gl,"glClear" _ , code as long _ , ret as long end sub
sub glLoadIdentity ''set drawingmatrix to standert calldll #gl , "glLoadIdentity" _ , ret as long end sub
sub glPushMatrix ''to new drawingmatrix calldll #gl , "glPushMatrix" _ , ret as long end sub
sub glPopMatrix ''to old drawingmatrix calldll #gl , "glPopMatrix" _ , ret as long end sub
sub glEnd ''end of polygon[s] calldll #gl , "glEnd" _ , ret as void end sub
sub glEnable i ''set a item calldll #gl , "glEnable" _ , i as long _ , ret as long end sub
sub glBegin i ''set polygon mode calldll #gl , "glBegin" _ , i as long _ , ret as long end sub
sub glScale x , y , z ''scale drawingmatrix calldll #gl , "glScaled" _ , x as double _ , y as double _ , z as double _ , ret as long end sub
sub glTranslate x , y , z ''move drawingmatrix calldll #gl , "glTranslated" _ , x as double _ , y as double _ , z as double _ , ret as long end sub
sub glRotate a , x , y , z ''rotate drawinmatrix calldll #gl , "glRotated" _ , a as double _ , x as double _ , y as double _ , z as double _ , ret as long end sub
sub glVertex x , y , z ''add a point to a polygon calldll #gl , "glVertex3d" _ , x as double _ , y as double _ , z as double _ , ret as long end sub
sub glNormal x , y , z ''set normal of point[s] calldll #gl , "glNormal3f" _ , x as double _ , y as double _ , z as double _ , ret as long end sub
sub setColor clr ''set color of point[s] of polygon r = colorR( clr ) g = colorG( clr ) b = colorB( clr ) a = colorA( clr ) calldll #gl , "glColor4d" _ , r as double _ , g as double _ , b as double _ , a as double _ , ret as long end sub
sub openglInit struct PFD _ , Size as word _ , Version as word _ , Flags as long _ , pixelType as char[1] _ , ColorBits as char[1] _ , RedBits as char[1] _ , RedShift as char[1] _ , GreenBits as char[1] _ , GreenShift as char[1] _ , BlueBits as char[1] _ , BlueShift as char[1] _ , AlphaBits as char[1] _ , AlphaShift as char[1] _ , AccumBits as char[1] _ , AccumRedBits as char[1] _ , AccumGreenBits as char[1] _ , AccumBlueBits as char[1] _ , AccumAlphaBits as char[1] _ , DepthBits as char[1] _ , StencilBits as char[1] _ , AuxBuffers as char[1] _ , LayerType as char[1] _ , Reserved as char[1] _ , LayerMask as long _ , VisibleMask as long _ , DamageMask as long
PFD.Version.struct=1 PFD.ColorBits.struct=24 PFD.DepthBits.struct=16 PFD.Size.struct=len(PFD.struct) PFD.Flags.struct=37
calldll #user32,"GetDC" _ , MainH as ulong, MainDC as ulong calldll #gdi32,"ChoosePixelFormat" _ , MainDC as ulong, PFD as struct, ret as long calldll #gdi32, "SetPixelFormat" _ , MainDC as ulong, ret as long _ , PFD as struct, t as long calldll #gl,"wglCreateContext" _ , MainDC as ulong, GLContext as ulong calldll #gl,"wglMakeCurrent" _ , MainDC as ulong, GLContext as ulong _ , ret as long call glEnable GL.DEPTH.TEST end sub
|
|
|
Post by bluatigro on Aug 27, 2020 4:12:02 GMT -5
update : 2 avatars added
''bluatigro 27 aug 2020 ''@bluaGL.bas ''wil be openGL wrapper lib ''version 2 : only color , points , shapes and avatars
nomainwin dim pntx(256),pnty(256),pntz(256),box(5),sk(100,2) global pi : pi = atn( 1 ) * 4
'' color objects
global black , red , green , yellow global blue , magenta , cyan , white global gray , pink , purple , orange black = rgba( 000 , 000 , 000 , 255 ) red = rgba( 255 , 000 , 000 , 255 ) green = rgba( 000 , 255 , 000 , 255 ) yellow = rgba( 255 , 255 , 000 , 255 ) blue = rgba( 000 , 000 , 255 , 255 ) magenta = rgba( 255 , 000 , 255 , 255 ) cyan = rgba( 000 , 255 , 255 , 255 ) white = rgba( 255 , 255 , 255 , 255 ) gray = rgba( 127 , 127 , 127 , 255 ) pink = rgba( 255 , 127 , 127 , 255 ) purple = rgba( 127 , 000 , 127 , 255 ) orange = rgba( 255 , 127 , 000 , 255 ) global xyz , xzy , yxz , yzx , zxy , zyx xyz = 0 xzy = 1 yxz = 2 yzx = 3 zxy = 4 zyx = 5
'' lim consts '' 4 legger global leftno : leftno = 0 global rightno : rightno = 50 global sholder : sholder = 0 global elbow : elbow = 1 global wrist : wrist = 2 global leg : leg = 3 global knee : knee = 4 global enkle : enkle = 5 global index.finger : index.finger = 6 global mid.finger : mid.finger = 9 global ring.finger : ring.finger = 12 global thumb.finger : thumb.finger = 15
'' opengl consts
global GL.COLOR.BUFFER.BIT : GL.COLOR.BUFFER.BIT = 16384 global GL.DEPTH.BUFFER.BIT : GL.DEPTH.BUFFER.BIT = 256 global GL.DEPTH.TEST : GL.DEPTH.TEST = 2929 ' primatifs global GL.TRIANGLES : GL.TRIANGLES = 4 global GL.QUADS : GL.QUADS = 7
WindowWidth = DisplayWidth WindowHeight = DisplayHeight global winx , winy , winyx winx = WindowWidth winy = WindowHeight winyx = winy / winx
global MainH , MainDC ''wil be filled by code
global angle , state open "opengl32.dll" for dll as #gl open "openGL" for graphics as #m
#m "trapclose [quit]" #m "when characterInput [key]" #m "setfocus" MainH = hwnd( #m ) call openglInit state = 9 timer 40 , [timer] wait [timer] scan call glClear GL.COLOR.BUFFER.BIT or GL.DEPTH.BUFFER.BIT call glLoadIdentity call glScale winyx , 1 , 1 call glPushMatrix select case state case 0 call glRotate angle , 1,1,0 call setbox 0,0,0 , .5,.5,.5 call cube red,cyan , green,magenta , blue,yellow case 1 call glRotate angle , 1,0,1 call setbox 0,0,0 , .5,.5,.5 call colorcube -2 case 2 call glRotate angle , 0,1,1 call setbox 0,0,0 , .5,.25,.5 call cone 6 , .5 , .5 , rainbow( angle ) case 3 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.25,.25 call torus 6 , 6 , -1 case 4 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.25,.25 call torus 6 , 6 , -2 case 5 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.25,.25 call torus 6 , 6 , -3 case 6 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.2,.2 call banana 6 , 6 , -1 case 7 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.2,.2 call banana 6 , 12 , -2 case 8 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.5,.2 call banana 6 , 16 , -3 case 9 call glRotate 30 , 1,1,1 call glScale .4,.4,.4 call skelet 0 , 0,pend(angle,45)+45,0 call skelet 1 , pend(angle,-45)-45,0,0 call skelet 2 , pend(angle,45)+45,0,0 call skelet 3 , 0,pend(angle,-45)-45,0 call setbox 0,0,0 , .5,.5,.1 call colorcube red call glPushMatrix call child .5,0,0 , 0 , xyz call setbox .5,0,0 , .5,.5,.1 call colorcube green call glPushMatrix call child 1,0,0 , 0 , xyz call colorcube cyan call glPopMatrix call glPopMatrix call glPushMatrix call child 0,.5,0 , 1 , xyz call setbox 0,.5,0 , .5,.5,.1 call colorcube blue call glPopMatrix call glPushMatrix call child 0,-.5,0 , 2 , xyz call setbox 0,-.5,0 , .5,.5,.1 call colorcube yellow call glPopMatrix call glPushMatrix call child -.5,0,0 , 3 , xyz call setbox -.5,0,0 , .5,.5,.1 call colorcube magenta call glPopMatrix case 10 for i = 0 to 100 call skelet i , 0,0,0 next i call glRotate angle , 0,1,0 call glScale .3,.3,.3 call human 0 , -2 case 11 for i = 0 to 100 call skelet i , 0,0,0 next i call glRotate angle , 0,1,0 call glScale .3,.3,.3 call dog -2 case else call glRotate angle , 0,0,1 call point 0 , 0,1,0 call point 1 , .8,-.6,0 call point 2 , -.8,-.6,0 call tri3 0 , red , 1 , green , 2 , blue end select call glPopMatrix
calldll #gdi32,"SwapBuffers" _ , MainDC as ulong _ , ret as long angle = angle + 1 if angle mod 360 = 0 then state = state + 1 if state > 12 then state = 0 [key] key$ = right$( Inkey$ , 1 ) if key$ <> chr$( 27 ) then wait [quit] calldll #gl,"wglMakeCurrent" _ , 0 as ulong, 0 as ulong, ret as long calldll #gl,"wglDeleteContext" _ , GLContext as ulong, ret as long calldll #user32, "ReleaseDC" _ , MainH as ulong, MainDC as ulong,ret as long close #m close #gl end '' color object math
function rainbow( x ) r = sin( rad( x ) ) * 127 + 128 g = sin( rad( x - 120 ) ) * 127 + 128 b = sin( rad( x + 120 ) ) * 127 + 128 rainbow = rgba( r , g , b , 255 ) end function function rgba( r , g , b , a ) ''create color object r = r and 255 g = g and 255 b = b and 255 a = a and 255 rgba = r + g * 256 + b * 256 ^ 2 + a * 256 ^ 3 end function function mix( kl1 , f , kl2 ) r1 = int( kl1 ) and 255 g1 = int( kl1 / 256 ) and 255 b1 = int( kl1 / 256 ^ 2 ) and 255 r2 = int( kl2 ) and 255 g2 = int( kl2 / 256 ) and 255 b2 = int( kl2 / 256 ^ 2 ) and 255 r = r1 + ( r2 - r1 ) * f g = g1 + ( g2 - g1 ) * f b = b1 + ( b2 - b1 ) * f mix = rgba( r , g , b , 255 ) end function function colorR( clr ) ''get red channel from color object colorR = int( clr and 255 ) / 256 end function function colorG( clr ) ''get green channel from color object colorG = ( int( clr / 256 ) and 255 ) / 256 end function function colorB( clr ) ''get blue channel from color object colorB = ( int( clr / 256 ^ 2 ) and 255 ) / 256 end function function colorA( clr ) ''get alpha channel from color object colorA = ( int( clr / 256 ^ 3 ) and 255 ) / 256 end function
'' 3d engine stuf
sub child x , y , z , lim , ax ''create a joint for avatar animation if lim < 0 or lim > 64 then exit sub select case ax case xyz call glTranslate x , y , z call glRotate sk(lim,0) , 1,0,0 call glRotate sk(lim,1) , 0,1,0 call glRotate sk(lim,2) , 0,0,1 case xzy call glTranslate x , y , z call glRotate sk(lim,0) , 1,0,0 call glRotate sk(lim,2) , 0,0,1 call glRotate sk(lim,1) , 0,1,0 case yxz call glTranslate x , y , z call glRotate sk(lim,1) , 0,1,0 call glRotate sk(lim,0) , 1,0,0 call glRotate sk(lim,2) , 0,0,1 case yzx call glTranslate x , y , z call glRotate sk(lim,1) , 0,1,0 call glRotate sk(lim,2) , 0,0,1 call glRotate sk(lim,0) , 1,0,0 case zxy call glTranslate x , y , z call glRotate sk(lim,2) , 0,0,1 call glRotate sk(lim,0) , 1,0,0 call glRotate sk(lim,1) , 0,1,0 case zyx call glTranslate x , y , z call glRotate sk(lim,2) , 0,0,1 call glRotate sk(lim,1) , 0,1,0 call glRotate sk(lim,0) , 1,0,0 case else end select end sub
sub skelet no , x , y , z ''set the angle's of a joint of a avatar if no < 0 or no > 64 then exit sub sk( no , 0 ) = x sk( no , 1 ) = y sk( no , 2 ) = z end sub
function pend( f , a ) ''for smooth animation of a joint pend = sin( rad( f ) ) * a end function
function rad( x ) ''fron degree's to radian's rad = x * pi / 180 end function
function sgn( x ) uit = 0 if x < 0 then uit = -1 if x > 0 then uit = 1 sgn = uit end function
'' example avatars
sub kootjes f , kl call setbox 0,-.2,0 , .1,.1,.1 call colorcube kl call glPushMatrix call child 0,-.2,0 , f + 1 , xyz call colorcube kl call glPushMatrix call child 0,-.2,0 , f + 2 , xyz call colorcube kl call glPopMatrix call glPopMatrix end sub
sub hand i , kl call glPushMatrix call setbox 0,-.3,0 , .1,.3,.3 call colorcube kl call glPushMatrix call child 0,-.6,.2 , index.finger + i , xyz call kootjes index.finger + i , kl call glPopMatrix call glPushMatrix call child 0,-.6,0 , mid.finger + i , xyz call kootjes mid.finger + i , kl call glPopMatrix call glPushMatrix call child 0,-.6,-.2 , ring.finger + i , xyz call kootjes ring.finger + i , kl call glPopMatrix call glPushMatrix call child 0,-.2,.4 , thumb.finger + i , xyz call kootjes thumb + i , kl call glPopMatrix call glPopMatrix end sub
sub human h , kl
call setbox 0 , 0 , 0 , .5 , .1 , .1 call colorcube kl call setbox 0 , .75 , 0 , .1 , .5 , .1 call colorcube kl call setbox 0 , 1.8 , 0 , .2 , .2 , .2 call colorcube kl call setbox 0 , 1.4 , 0 , .7 , .1 , .1 call colorcube kl call glPushMatrix call child .45 , 0 , 0 , leftno + leg , zyx call setbox 0 , -.6 , 0 , .1 , .4 , .1 call colorcube kl call glPushMatrix call child 0 , -1 , 0 , leftno + knee , xyz call colorcube kl call glPushMatrix call child 0 , -1.2 , 0 , leftno + enkle , xyz call setbox 0 , 0 , .2 , .1 , .1 , .3 call colorcube kl call glPopMatrix call glPopMatrix call glPopMatrix call glPushMatrix call child -.45 , 0 , 0 , leg + rightno , zyx call setbox 0 , -.6 , 0 , .1 , .4 , .1 call colorcube kl call glPushMatrix call child 0 , -1 , 0 , knee + rightno , xyz call colorcube kl call glPushMatrix call child 0 , -1.2 , 0 , enkle + rightno , xyz call setbox 0 , 0 , .2 , .1 , .1 , .3 call colorcube kl call glPopMatrix call glPopMatrix call glPopMatrix call glPushMatrix call child .65 , 1.3 , 0 , leftno + sholder , xyz call setbox 0 , -.5 , 0 , .1 , .4 , .1 call colorcube kl call glPushMatrix call child 0 , -1 , 0 , leftno + elbow , xyz call colorcube kl call glPushMatrix call child 0 , -1 , 0 , leftno + wrist , zyx if h then call glScale .5,.5,.5 call hand leftno , kl else call setbox 0,-.5,0 , .1,.5,.5 call colorcube kl end if call glPopMatrix call glPopMatrix call glPopMatrix call glPushMatrix call child -.65 , 1.3 , 0 , arm + rightno , xyz call setbox 0 , -.5 , 0 , .1 , .4 , .1 call colorcube kl call glPushMatrix call child 0 , -1 , 0 , elbow + rightno , xyz call colorcube kl call glPushMatrix call child 0 , -1 , 0 , wrist + rightno , zyx if h then call glScale .5,.5,.5 call hand rightno , kl else call setbox 0,-.5,0 , .1,.5,.5 call colorcube kl end if call glPopMatrix call glPopMatrix call glPopMatrix end sub
sub dog kl call setbox 0,.2,.5 , .3,.3,.7 call colorcube kl call glPushMatrix call child 0 , .6 , 1.5 , leftno + neck , xyz call glPushMatrix call child 0 , 0 , 0 , neck + rightno , zyx call setbox 0,0,0 , .3 , .3 , .3 call colorcube kl call setbox 0,-.2,.3 , .2,.2,.2 call colorcube kl call setbox 0,0,.5 , .1,.1,.1 call colorcube kl call setbox .3,-.15,0 , .05,.3,.2 call colorcube kl call setbox -.3,-.15,0 , .05,.3,.2 call colorcube kl call glPopMatrix call glPopMatrix call glPushMatrix call child 0 , .4 , -.5 , leftno + tail , yzx call setbox 0,.3,0 , .1 , .3 , .1 call colorcube kl call glPopMatrix call glPushMatrix call child .3 , 0 , 1 , leftno + leg , zyx call setbox 0 , -.6 , 0 , .1 , .4 , .1 call colorcube kl call glPushMatrix call child 0 , -1 , 0 , leftno + knee , xyz call colorcube kl call glPushMatrix call child 0 , -1.2 , 0 , leftno + enkle , xyz call setbox 0 , 0 , .2 , .1 , .1 , .3 call colorcube kl call glPopMatrix call glPopMatrix call glPopMatrix call glPushMatrix call child -.3 , 0 , 1 , leg + rightno, zyx call setbox 0 , -.6 , 0 , .1 , .4 , .1 call colorcube kl call glPushMatrix call child 0 , -1 , 0 , knee + rightno, xyz call colorcube kl call glPushMatrix call child 0 , -1.2 , 0 , enkle + rightno, xyz call setbox 0 , 0 , .2 , .1 , .1 , .3 call colorcube kl call glPopMatrix call glPopMatrix call glPopMatrix call glPushMatrix call child .3 , 0 , 0 , leftno + sholder , zyx call setbox 0 , -.6 , 0 , .1 , .4 , .1 call colorcube kl call glPushMatrix call child 0 , -1 , 0 , leftno + elbow , xyz call colorcube kl call glPushMatrix call child 0 , -1.2 , 0 , leftno + wrist , xyz call setbox 0 , 0 , .2 , .1 , .1 , .3 call colorcube kl call glPopMatrix call glPopMatrix call glPopMatrix call glPushMatrix call child -.3 , 0 , 0 , sholder + rightno , zyx call setbox 0 , -.6 , 0 , .1 , .4 , .1 call colorcube kl call glPushMatrix call child 0 , -1 , 0 , elbow + rightno , xyz call colorcube kl call glPushMatrix call child 0 , -1.2 , 0 , wrist + rightno , xyz call setbox 0 , 0 , .2 , .1 , .1 , .3 call colorcube kl call glPopMatrix call glPopMatrix call glPopMatrix end sub
'' shapes part of bluaGL
sub setbox mx , my , mz , dx , dy , dz ''set bodinging box coordinates box(0) = mx box(1) = my box(2) = mz box(3) = dx box(4) = dy box(5) = dz end sub
sub cone s , dx , dz , kl ''s = number of side's ''dx , dz = diametger top ''kl = color cylinder if s < 4 then s = 4 if s > 24 then s = 24 call glPushMatrix call glTranslate box(0) , box(1) , box(2) call glScale box(3) , box(4) , box(5) for i = 0 to pi * 2 step pi * 2 / s i2 = i + pi * 2 / s call point 0 , sin( i ) * dx , 1 , cos( i ) * dz call point 1 , sin( i2 ) * dx , 1 , cos( i2 ) * dz call point 2 , sin( i2 ) , -1 , cos( i2 ) call point 3 , sin( i ) , -1 , cos( i ) call quad 0 , 1 , 2 , 3 , kl next i call glPopMatrix end sub
sub sphere a , b , da , db , kl ''a , b = number of sides ''da , db = superellipsoid [ 1 , 1 for normal sphere ] ''kl = color of sphere if a < 4 then a = 4 if a > 24 then a = 24 if b < 4 then b = 4 if b > 24 then b = 24 call glPushMatrix call glTranslate box( 0 ) , box( 1 ) , box( 2 ) call glScale box( 3 ) , box( 4 ) , box( 5 ) for i = 0-pi to pi step pi / a * 2 i2 = i + pi / a * 2 for j = 0-pi / 2 to pi / 2 - pi / b * 2 step pi / b * 2 j2 = j + pi / b * 2
x = sin( i ) * cos( j ) y = sin( j ) z = cos( i ) * cos( j ) call point 0 _ , abs( x ) ^ da * sgn( x ) _ , abs( y ) ^ db * sgn( y ) _ , abs( z ) ^ da * sgn( z )
x = sin( i2 ) * cos( j ) y = sin( j ) z = cos( i2 ) * cos( j ) call point 1 _ , abs( x ) ^ da * sgn( x ) _ , abs( y ) ^ db * sgn( y ) _ , abs( z ) ^ da * sgn( z )
x = sin( i2 ) * cos( j2 ) y = sin( j2 ) z = cos( i2 ) * cos( j2 ) call point 2 _ , abs( x ) ^ da * sgn( x ) _ , abs( y ) ^ db * sgn( y ) _ , abs( z ) ^ da * sgn( z )
x = sin( i ) * cos( j2 ) y = sin( j2 ) z = cos( i ) * cos( j2 ) call point 3 _ , abs( x ) ^ da * sgn( x ) _ , abs( y ) ^ db * sgn( y ) _ , abs( z ) ^ da * sgn( z )
call quad 0 , 1 , 2 , 3 , kl next j next i call glPopMatrix end sub
sub torus a , b , kl ''a , b = number of sides ''kl = color mode if a < 4 then a = 4 if a > 24 then a = 24 if b < 4 then b = 4 if b > 24 then b = 24 mx = box( 0 ) my = box( 1 ) mz = box( 2 ) dx = box( 3 ) dy = box( 4 ) dz = box( 5 ) for i = 0-pi to pi step pi / a * 2 i2 = i + pi / a * 2 for j = 0-pi to pi step pi / b * 2 j2 = j + pi / b * 2 call point 0 _ , mx + ( dx + dy * cos( i ) ) * cos( j ) _ , my + ( dx + dy * cos( i ) ) * sin( j ) _ , mz + sin( i ) * dz call point 1 _ , mx + ( dx + dy * cos( i ) ) * cos( j2 ) _ , my + ( dx + dy * cos( i ) ) * sin( j2 ) _ , mz + sin( i ) * dz call point 2 _ , mx + ( dx + dy * cos( i2 ) ) * cos( j2 ) _ , my + ( dx + dy * cos( i2 ) ) * sin( j2 ) _ , mz + sin( i2 ) * dz call point 3 _ , mx + ( dx + dy * cos( i2 ) ) * cos( j ) _ , my + ( dx + dy * cos( i2 ) ) * sin( j ) _ , mz + sin( i2 ) * dz if kl > 0 then call quad 0 , 1 , 2 , 3 , kl else select case kl case -1 kla = rainbow( i * 180 / pi) klb = rainbow( i2 * 180 / pi) call quad4 0 , kla , 1 , kla , 2 , klb , 3 , klb case -2 kla = rainbow( j * 180 / pi ) klb = rainbow( j2 * 180 / pi) call quad4 0 , kla , 1 , klb , 2 , klb , 3 , kla case else kla = rainbow( ( j + i ) * 180 / pi ) klc = rainbow( ( j + i + j2 + i2 ) / 2 * 180 / pi ) klb = rainbow( ( j2 + i2 ) * 180 / pi ) call quad4 0 , kla , 1 , klc , 2 , klb , 3 , klc end select end if next j next i end sub
sub banana a , b , kl if a < 3 then a = 3 if a > 64 then a = 64 if b < 3 then b = 3 if b > 64 then b = 64 mx = box(0) my = box(1) mz = box(2) dx = box(3) dy = box(4) dz = box(5) for i = 0-pi to pi step pi / a * 2 i2 = i + pi / a * 2 for j = 0-pi/1.99 to pi/1.99 - pi/b*2 step pi / b * 1.99 j2 = j + pi / b * 1.99 call point 0 _ , mx + ( dx + dy * cos( i ) * cos( j ) ) _ * cos( j ) _ , my + ( dx + dy * cos( i ) * cos( j ) ) _ * sin( j ) _ , mz + sin( i ) * dz * cos( j ) call point 1 _ , mx + ( dx + dy * cos( i ) * cos( j2 ) ) _ * cos( j2 ) _ , my + ( dx + dy * cos( i ) * cos( j2 ) ) _ * sin( j2 ) _ , mz + sin( i ) * dz * cos( j2 ) call point 2 _ , mx + ( dx + dy * cos( i2 ) * cos( j2 ) ) _ * cos( j2 ) _ , my + ( dx + dy * cos( i2 ) * cos( j2 ) ) _ * sin( j2 ) _ , mz + sin( i2 ) * dz * cos( j2 ) call point 3 _ , mx + ( dx + dy * cos( i2 ) * cos( j ) ) _ * cos( j ) _ , my + ( dx + dy * cos( i2 ) * cos( j ) ) _ * sin( j ) _ , mz + sin( i2 ) * dz * cos( j )
if kl > 0 then call quad 0 , 1 , 2 , 3 , kl else select case kl case -1 kla = rainbow( i * 180 / pi) klb = rainbow( i2 * 180 / pi) call quad4 0 , kla , 1 , kla , 2 , klb , 3 , klb case -2 kla = rainbow( j * 180 / pi ) klb = rainbow( j2 * 180 / pi) call quad4 0 , kla , 1 , klb , 2 , klb , 3 , kla case else kla = rainbow( ( j + i ) * 180 / pi ) klc = rainbow( ( j + i + j2 + i2 ) / 2 * 180 / pi ) klb = rainbow( ( j2 + i2 ) * 180 / pi ) call quad4 0 , kla , 1 , klc , 2 , klb , 3 , klc end select end if next j next i end sub
sub colorcube kl ''create point's in the swarm select case kl case -1 call cube red,cyan , green,magenta , blue,yellow case -2 call point 0 , -1 , -1 , -1 call point 1 , -1 , -1 , 1 call point 2 , -1 , 1 , -1 call point 3 , -1 , 1 , 1 call point 4 , 1 , -1 , -1 call point 5 , 1 , -1 , 1 call point 6 , 1 , 1 , -1 call point 7 , 1 , 1 , 1
''then use points in swarm to draw quads call glPushMatrix call glTranslate box(0) , box(1) , box(2) call glScale box(3) , box(4) , box(5) call quad4 0 , black , 1 , red , 3 , yellow , 2 , green call quad4 7 , white , 6 , cyan , 4 , blue , 5 , magenta call quad4 0 , black , 2 , green , 6 , cyan , 4 , blue call quad4 7 , white , 5 , magenta , 1 , red , 3 , yellow call quad4 0 , black , 1 , red , 5 , magenta , 4 , blue call quad4 7 , white , 6 , cyan , 2 , green , 3 , yellow call glPopMatrix case else kl1 = mix( kl , .8 , black ) kl2 = mix( kl , .6 , black ) call cube kl1,kl1 , kl2,kl2 , kl,kl end select end sub
sub cube left , right , front , back , down , up ''create a cube mesh ''whit 6 colors and whit bodingbox coordinates
''first fil swarm whit points call point 0 , -1 , -1 , -1 call point 1 , -1 , -1 , 1 call point 2 , -1 , 1 , -1 call point 3 , -1 , 1 , 1 call point 4 , 1 , -1 , -1 call point 5 , 1 , -1 , 1 call point 6 , 1 , 1 , -1 call point 7 , 1 , 1 , 1
''then use points in swarm to draw quads call glPushMatrix call glTranslate box(0) , box(1) , box(2) call glScale box(3) , box(4) , box(5) call quad 0 , 1 , 3 , 2 , left call quad 7 , 6 , 4 , 5 , right call quad 0 , 2 , 6 , 4 , front call quad 7 , 5 , 1 , 3 , back call quad 0 , 1 , 5 , 4 , down call quad 7 , 6 , 2 , 3 , up call glPopMatrix end sub
sub point no , x , y , z ''set a point in the swarm if no < 0 or no > 256 then exit sub pntx( no ) = x pnty( no ) = y pntz( no ) = z end sub
sub tri p1 , p2 , p3 , kl ''draw a triangle whit 1 color call tri3 p1 , kl , p2 , kl , p3 , kl end sub
sub tri3 p1 , kl1 , p2 , kl2 , p3 , kl3 ''draw a triangle from point's in the swarm ''whit 3 color's if p1 < 0 or p1 > 256 then exit sub if p2 < 0 or p2 > 256 then exit sub if p3 < 0 or p3 > 256 then exit sub x1 = pntx( p1 ) y1 = pnty( p1 ) z1 = pntz( p1 ) x2 = pntx( p2 ) y2 = pnty( p2 ) z2 = pntz( p2 ) x3 = pntx( p3 ) y3 = pnty( p3 ) z3 = pntz( p3 ) call glBegin GL.TRIANGLES call setColor kl1 call glVertex x1 , y1 , z1 call setColor kl2 call glVertex x2 , y2 , z2 call setColor kl3 call glVertex x3 , y3 , z3 call glEnd end sub
sub quad p1 , p2 , p3 , p4 , kl ''draw a quadangle from points in the swarm ''whit 1 color call quad4 p1 , kl , p2 , kl , p3 , kl , p4 , kl end sub
sub quad4 p1 , kl1 , p2 , kl2 , p3 , kl3 , p4 , kl4 ''draw a quadangle from points in the swarm ''whit 4 color's if p1 < 0 or p1 > 256 then exit sub if p2 < 0 or p2 > 256 then exit sub if p3 < 0 or p3 > 256 then exit sub if p4 < 0 or p4 > 256 then exit sub x1 = pntx( p1 ) y1 = pnty( p1 ) z1 = pntz( p1 ) x2 = pntx( p2 ) y2 = pnty( p2 ) z2 = pntz( p2 ) x3 = pntx( p3 ) y3 = pnty( p3 ) z3 = pntz( p3 ) x4 = pntx( p4 ) y4 = pnty( p4 ) z4 = pntz( p4 ) call glBegin GL.QUADS call setColor kl1 call glVertex x1 , y1 , z1 call setColor kl2 call glVertex x2 , y2 , z2 call setColor kl3 call glVertex x3 , y3 , z3 call setColor kl4 call glVertex x4 , y4 , z4 call glEnd end sub
'' openGl
sub glClear code ''clear the openGL screen calldll #gl,"glClear" _ , code as long _ , ret as long end sub
sub glLoadIdentity ''set drawingmatrix to standert calldll #gl , "glLoadIdentity" _ , ret as long end sub
sub glPushMatrix ''to new drawingmatrix calldll #gl , "glPushMatrix" _ , ret as long end sub
sub glPopMatrix ''to old drawingmatrix calldll #gl , "glPopMatrix" _ , ret as long end sub
sub glEnd ''end of polygon[s] calldll #gl , "glEnd" _ , ret as void end sub
sub glEnable i ''set a item calldll #gl , "glEnable" _ , i as long _ , ret as long end sub
sub glBegin i ''set polygon mode calldll #gl , "glBegin" _ , i as long _ , ret as long end sub
sub glScale x , y , z ''scale drawingmatrix calldll #gl , "glScaled" _ , x as double _ , y as double _ , z as double _ , ret as long end sub
sub glTranslate x , y , z ''move drawingmatrix calldll #gl , "glTranslated" _ , x as double _ , y as double _ , z as double _ , ret as long end sub
sub glRotate a , x , y , z ''rotate drawinmatrix calldll #gl , "glRotated" _ , a as double _ , x as double _ , y as double _ , z as double _ , ret as long end sub
sub glVertex x , y , z ''add a point to a polygon calldll #gl , "glVertex3d" _ , x as double _ , y as double _ , z as double _ , ret as long end sub
sub glNormal x , y , z ''set normal of point[s] calldll #gl , "glNormal3f" _ , x as double _ , y as double _ , z as double _ , ret as long end sub
sub setColor clr ''set color of point[s] of polygon r = colorR( clr ) g = colorG( clr ) b = colorB( clr ) a = colorA( clr ) calldll #gl , "glColor4d" _ , r as double _ , g as double _ , b as double _ , a as double _ , ret as long end sub
sub openglInit struct PFD _ , Size as word _ , Version as word _ , Flags as long _ , pixelType as char[1] _ , ColorBits as char[1] _ , RedBits as char[1] _ , RedShift as char[1] _ , GreenBits as char[1] _ , GreenShift as char[1] _ , BlueBits as char[1] _ , BlueShift as char[1] _ , AlphaBits as char[1] _ , AlphaShift as char[1] _ , AccumBits as char[1] _ , AccumRedBits as char[1] _ , AccumGreenBits as char[1] _ , AccumBlueBits as char[1] _ , AccumAlphaBits as char[1] _ , DepthBits as char[1] _ , StencilBits as char[1] _ , AuxBuffers as char[1] _ , LayerType as char[1] _ , Reserved as char[1] _ , LayerMask as long _ , VisibleMask as long _ , DamageMask as long
PFD.Version.struct=1 PFD.ColorBits.struct=24 PFD.DepthBits.struct=16 PFD.Size.struct=len(PFD.struct) PFD.Flags.struct=37
calldll #user32,"GetDC" _ , MainH as ulong, MainDC as ulong calldll #gdi32,"ChoosePixelFormat" _ , MainDC as ulong, PFD as struct, ret as long calldll #gdi32, "SetPixelFormat" _ , MainDC as ulong, ret as long _ , PFD as struct, t as long calldll #gl,"wglCreateContext" _ , MainDC as ulong, GLContext as ulong calldll #gl,"wglMakeCurrent" _ , MainDC as ulong, GLContext as ulong _ , ret as long call glEnable GL.DEPTH.TEST end sub
|
|
|
Post by bluatigro on Aug 28, 2020 4:21:45 GMT -5
big text char's added
''bluatigro 28 aug 2020 ''@bluaGL.bas ''wil be openGL wrapper lib ''version 3 : only color , points , shapes and avatars
nomainwin dim pntx(256),pnty(256),pntz(256),box(5),sk(100,2) global letter$ letter$ = "abcdefghijklmnopqrstuvwxyz0123456789[]=" dim letter( len( letter$ ) , 8 ) for i = 1 to len( letter$ ) for j = 0 to 7 read q$ for k = 0 to 7 if mid$( q$ , k + 1 , 1 ) = "1" then letter( i , j ) = letter( i , j ) or 2 ^ k end if next k next j next i ''a data "...1...." data "..111..." data ".1...1.." data "1.....1." data "1111111." data "1.....1." data "1.....1." data "1.....1." ''b data "1111...." data "1...1..." data "1....1.." data "1....1.." data "111111.." data "1.....1." data "1.....1." data "111111.." ''c data "..111..." data ".1...1.." data "1.....1." data "1......." data "1......." data "1.....1." data ".1...1.." data "..111..." ''d data "11111..." data "1....1.." data "1.....1." data "1.....1." data "1.....1." data "1.....1." data "1....1.." data "11111..." ''e data "1111111." data "1.....1." data "1......." data "1......." data "111111.." data "1......." data "1.....1." data "1111111." ''f data "1111111." data "1.....1." data "1......." data "1......." data "111111.." data "1......." data "1......." data "1......." ''g data "..111..." data ".1...1.." data "1.....1." data "1......." data "1...111." data "1.....1." data ".1...1.." data "..111..." ''h data "1.....1." data "1.....1." data "1.....1." data "1.....1." data "1111111." data "1.....1." data "1.....1." data "1.....1." ''i data "..111..." data "...1...." data "...1...." data "...1...." data "...1...." data "...1...." data "...1...." data "..111..." ''j data "..111..." data "...1...." data "...1...." data "...1...." data "...1...." data "1..1...." data "1..1...." data ".11...." ''k data "1......." data "1.....1." data "1....1.." data "1...1..." data "1111...." data "1...1..." data "1....1.." data "1.....1." ''l data "1......." data "1......." data "1......." data "1......." data "1......." data "1......." data "1......." data "1111111." ''m data "1.....1." data "11...11." data "1.1.1.1." data "1..1..1." data "1..1..1." data "1.....1." data "1.....1." data "1.....1." ''n data "1.....1." data "11....1." data "1.1...1." data "1..1..1." data "1..1..1." data "1...1.1." data "1....11." data "1.....1." ''o data "..111..." data ".1...1.." data "1.....1." data "1.....1." data "1.....1." data "1.....1." data ".1...1.." data "..111..." ''p data "11111..." data "1....1.." data "1.....1." data "1....1.." data "11111..." data "1.....,." data "1......." data "1......." ''q data "..111..." data ".1...1.." data "1.....1." data "1.....1." data "1..1..1." data "1...1.1." data ".1...1.." data "..111.1." ''r data "11111..." data "1....1.." data "1.....1." data "1....1.." data "111111.." data "1...1..." data "1....1.." data "1.....1." ''s data "..111..." data ".1...1.." data "1.....1." data "1......." data ".11111.." data "......1." data "1.....1." data ".11111.." ''t data "1111111." data "1..1..1." data "...1...." data "...1...." data "...1...." data "...1...." data "...1...." data "..111..." ''u data "1.....1." data "1.....1." data "1.....1." data "1.....1." data "1.....1." data "1.....1." data "1.....1." data ".11111.." ''v data "1.....1." data "1.....1." data "1.....1." data "1.....1." data "1.....1." data ".1...1.." data "..1.1..." data "...1...." ''w data "1.....1." data "1.....1." data "1.....1." data "1.....1." data "1..1..1." data "1.1.1.1." data "11...11." data "1.....1." ''x data "1.....1." data ".1...1.." data "..1.1.." data "...1...." data "...1...." data "..1.1..." data ".1...1.." data "1.....1." ''y data "1.....1." data ".1...1.." data "..1.1.." data "...1...." data "...1...." data "..1....." data ".1......" data "1......." ''z data "1111111." data ".....1.." data "....1..." data "...1...." data "...1...." data "..1....." data ".1......" data "1111111." ''0 data ".11111.." data "1.....1." data "1.....1." data "1.....1." data "........" data "1.....1." data "1.....1." data ".11111.." ''1 data "........" data "......1." data "......1." data "......1." data "........" data "......1." data "......1." data "........" ''2 data ".11111.." data "......1." data "......1." data "......1." data ".11111.." data "1......." data "1......." data ".11111.." ''3 data ".11111.." data "......1." data "......1." data "......1." data ".11111.." data "......1." data "......1." data ".11111.." ''4 data "........" data "1.....1." data "1.....1." data "1.....1." data ".11111.." data "......1." data "......1." data "........" ''5 data ".11111.." data "1......." data "1......." data "1......." data ".11111.." data "......1." data "......1." data ".11111.." ''6 data ".11111.." data "1......." data "1......." data "1......." data ".11111.." data "1.....1." data "1.....1." data ".11111.." ''7 data ".11111.." data "......1." data "......1." data "......1." data "........" data "......1." data "......1." data "........" ''8 data ".11111.." data "1.....1." data "1.....1." data "1.....1." data ".11111.." data "1.....1." data "1.....1." data ".11111.." ''9 data ".11111.." data "1.....1." data "1.....1." data "1.....1." data ".11111.." data "......1." data "......1." data ".11111.." ''[ data "..1111.." data "..1....." data "..1....." data "..1....." data "..1....." data "..1....." data "..1....." data "..1111.." ''] data "..1111..." data ".....1.." data ".....1.." data ".....1.." data ".....1.." data ".....1.." data ".....1.." data "..1111.." ''= data "........" data "........" data "..1111.." data "........" data "........" data "..1111.." data "........" data "........" global pi : pi = atn( 1 ) * 4
'' color objects
global black , red , green , yellow global blue , magenta , cyan , white global gray , pink , purple , orange black = rgba( 000 , 000 , 000 , 255 ) red = rgba( 255 , 000 , 000 , 255 ) green = rgba( 000 , 255 , 000 , 255 ) yellow = rgba( 255 , 255 , 000 , 255 ) blue = rgba( 000 , 000 , 255 , 255 ) magenta = rgba( 255 , 000 , 255 , 255 ) cyan = rgba( 000 , 255 , 255 , 255 ) white = rgba( 255 , 255 , 255 , 255 ) gray = rgba( 127 , 127 , 127 , 255 ) pink = rgba( 255 , 127 , 127 , 255 ) purple = rgba( 127 , 000 , 127 , 255 ) orange = rgba( 255 , 127 , 000 , 255 ) global xyz , xzy , yxz , yzx , zxy , zyx xyz = 0 xzy = 1 yxz = 2 yzx = 3 zxy = 4 zyx = 5
'' lim consts '' 4 legger global leftno : leftno = 0 global rightno : rightno = 50 global sholder : sholder = 0 global elbow : elbow = 1 global wrist : wrist = 2 global leg : leg = 3 global knee : knee = 4 global enkle : enkle = 5 global index.finger : index.finger = 6 global mid.finger : mid.finger = 9 global ring.finger : ring.finger = 12 global thumb.finger : thumb.finger = 15
'' opengl consts
global GL.COLOR.BUFFER.BIT : GL.COLOR.BUFFER.BIT = 16384 global GL.DEPTH.BUFFER.BIT : GL.DEPTH.BUFFER.BIT = 256 global GL.DEPTH.TEST : GL.DEPTH.TEST = 2929 ' primatifs global GL.TRIANGLES : GL.TRIANGLES = 4 global GL.QUADS : GL.QUADS = 7
WindowWidth = DisplayWidth WindowHeight = DisplayHeight global winx , winy , winyx winx = WindowWidth winy = WindowHeight winyx = winy / winx
global MainH , MainDC ''wil be filled by code
global angle , state open "opengl32.dll" for dll as #gl open "openGL" for graphics as #m
#m "trapclose [quit]" #m "when characterInput [key]" #m "setfocus" MainH = hwnd( #m ) call openglInit state = 12 timer 40 , [timer] wait [timer] scan call glClear GL.COLOR.BUFFER.BIT or GL.DEPTH.BUFFER.BIT call glLoadIdentity call glScale winyx , 1 , 1 call glPushMatrix select case state case 0 call glRotate angle , 1,1,0 call setbox 0,0,0 , .5,.5,.5 call cube red,cyan , green,magenta , blue,yellow case 1 call glRotate angle , 1,0,1 call setbox 0,0,0 , .5,.5,.5 call colorcube -2 case 2 call glRotate angle , 0,1,1 call setbox 0,0,0 , .5,.25,.5 call cone 6 , .5 , .5 , rainbow( angle ) case 3 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.25,.25 call torus 6 , 6 , -1 case 4 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.25,.25 call torus 6 , 6 , -2 case 5 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.25,.25 call torus 6 , 6 , -3 case 6 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.2,.2 call banana 6 , 6 , -1 case 7 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.2,.2 call banana 6 , 12 , -2 case 8 call glRotate angle , 1,1,1 call setbox 0,0,0 , .5,.5,.2 call banana 6 , 16 , -3 case 9 call glRotate 30 , 1,1,1 call glScale .4,.4,.4 call skelet 0 , 0,pend(angle,45)+45,0 call skelet 1 , pend(angle,-45)-45,0,0 call skelet 2 , pend(angle,45)+45,0,0 call skelet 3 , 0,pend(angle,-45)-45,0 call setbox 0,0,0 , .5,.5,.1 call colorcube red call glPushMatrix call child .5,0,0 , 0 , xyz call setbox .5,0,0 , .5,.5,.1 call colorcube green call glPushMatrix call child 1,0,0 , 0 , xyz call colorcube cyan call glPopMatrix call glPopMatrix call glPushMatrix call child 0,.5,0 , 1 , xyz call setbox 0,.5,0 , .5,.5,.1 call colorcube blue call glPopMatrix call glPushMatrix call child 0,-.5,0 , 2 , xyz call setbox 0,-.5,0 , .5,.5,.1 call colorcube yellow call glPopMatrix call glPushMatrix call child -.5,0,0 , 3 , xyz call setbox -.5,0,0 , .5,.5,.1 call colorcube magenta call glPopMatrix case 10 for i = 0 to 100 call skelet i , 0,0,0 next i call glRotate angle , 0,1,0 call glScale .3,.3,.3 call human 0 , -2 case 11 for i = 0 to 100 call skelet i , 0,0,0 next i call glRotate angle , 0,1,0 call glScale .3,.3,.3 call dog -2 case 12 call glRotate angle * 2 , 0,1,0 call setbox 0,0,0 , .3,.3,.3 call text "game over" , -2 case else call glRotate angle , 0,0,1 call point 0 , 0,1,0 call point 1 , .8,-.6,0 call point 2 , -.8,-.6,0 call tri3 0 , red , 1 , green , 2 , blue end select call glPopMatrix
calldll #gdi32,"SwapBuffers" _ , MainDC as ulong _ , ret as long angle = angle + 1 if angle mod 360 = 0 then state = state + 1 if state > 13 then state = 0 [key] key$ = right$( Inkey$ , 1 ) if key$ <> chr$( 27 ) then wait [quit] calldll #gl,"wglMakeCurrent" _ , 0 as ulong, 0 as ulong, ret as long calldll #gl,"wglDeleteContext" _ , GLContext as ulong, ret as long calldll #user32, "ReleaseDC" _ , MainH as ulong, MainDC as ulong,ret as long close #m close #gl end '' color object math
function rainbow( x ) r = sin( rad( x ) ) * 127 + 128 g = sin( rad( x - 120 ) ) * 127 + 128 b = sin( rad( x + 120 ) ) * 127 + 128 rainbow = rgba( r , g , b , 255 ) end function function rgba( r , g , b , a ) ''create color object r = r and 255 g = g and 255 b = b and 255 a = a and 255 rgba = r + g * 256 + b * 256 ^ 2 + a * 256 ^ 3 end function function mix( kl1 , f , kl2 ) r1 = int( kl1 ) and 255 g1 = int( kl1 / 256 ) and 255 b1 = int( kl1 / 256 ^ 2 ) and 255 r2 = int( kl2 ) and 255 g2 = int( kl2 / 256 ) and 255 b2 = int( kl2 / 256 ^ 2 ) and 255 r = r1 + ( r2 - r1 ) * f g = g1 + ( g2 - g1 ) * f b = b1 + ( b2 - b1 ) * f mix = rgba( r , g , b , 255 ) end function function colorR( clr ) ''get red channel from color object colorR = int( clr and 255 ) / 256 end function function colorG( clr ) ''get green channel from color object colorG = ( int( clr / 256 ) and 255 ) / 256 end function function colorB( clr ) ''get blue channel from color object colorB = ( int( clr / 256 ^ 2 ) and 255 ) / 256 end function function colorA( clr ) ''get alpha channel from color object colorA = ( int( clr / 256 ^ 3 ) and 255 ) / 256 end function
'' 3d engine stuf
sub child x , y , z , lim , ax ''create a joint for avatar animation if lim < 0 or lim > 64 then exit sub select case ax case xyz call glTranslate x , y , z call glRotate sk(lim,0) , 1,0,0 call glRotate sk(lim,1) , 0,1,0 call glRotate sk(lim,2) , 0,0,1 case xzy call glTranslate x , y , z call glRotate sk(lim,0) , 1,0,0 call glRotate sk(lim,2) , 0,0,1 call glRotate sk(lim,1) , 0,1,0 case yxz call glTranslate x , y , z call glRotate sk(lim,1) , 0,1,0 call glRotate sk(lim,0) , 1,0,0 call glRotate sk(lim,2) , 0,0,1 case yzx call glTranslate x , y , z call glRotate sk(lim,1) , 0,1,0 call glRotate sk(lim,2) , 0,0,1 call glRotate sk(lim,0) , 1,0,0 case zxy call glTranslate x , y , z call glRotate sk(lim,2) , 0,0,1 call glRotate sk(lim,0) , 1,0,0 call glRotate sk(lim,1) , 0,1,0 case zyx call glTranslate x , y , z call glRotate sk(lim,2) , 0,0,1 call glRotate sk(lim,1) , 0,1,0 call glRotate sk(lim,0) , 1,0,0 case else end select end sub
sub skelet no , x , y , z ''set the angle's of a joint of a avatar if no < 0 or no > 64 then exit sub sk( no , 0 ) = x sk( no , 1 ) = y sk( no , 2 ) = z end sub
function pend( f , a ) ''for smooth animation of a joint pend = sin( rad( f ) ) * a end function
function rad( x ) ''fron degree's to radian's rad = x * pi / 180 end function
function sgn( x ) uit = 0 if x < 0 then uit = -1 if x > 0 then uit = 1 sgn = uit end function
'' example avatars
sub kootjes f , kl call setbox 0,-.2,0 , .1,.1,.1 call colorcube kl call glPushMatrix call child 0,-.2,0 , f + 1 , xyz call colorcube kl call glPushMatrix call child 0,-.2,0 , f + 2 , xyz call colorcube kl call glPopMatrix call glPopMatrix end sub
sub hand i , kl call glPushMatrix call setbox 0,-.3,0 , .1,.3,.3 call colorcube kl call glPushMatrix call child 0,-.6,.2 , index.finger + i , xyz call kootjes index.finger + i , kl call glPopMatrix call glPushMatrix call child 0,-.6,0 , mid.finger + i , xyz call kootjes mid.finger + i , kl call glPopMatrix call glPushMatrix call child 0,-.6,-.2 , ring.finger + i , xyz call kootjes ring.finger + i , kl call glPopMatrix call glPushMatrix call child 0,-.2,.4 , thumb.finger + i , xyz call kootjes thumb + i , kl call glPopMatrix call glPopMatrix end sub
sub human h , kl
call setbox 0 , 0 , 0 , .5 , .1 , .1 call colorcube kl call setbox 0 , .75 , 0 , .1 , .5 , .1 call colorcube kl call setbox 0 , 1.8 , 0 , .2 , .2 , .2 call colorcube kl call setbox 0 , 1.4 , 0 , .7 , .1 , .1 call colorcube kl call glPushMatrix call child .45 , 0 , 0 , leftno + leg , zyx call setbox 0 , -.6 , 0 , .1 , .4 , .1 call colorcube kl call glPushMatrix call child 0 , -1 , 0 , leftno + knee , xyz call colorcube kl call glPushMatrix call child 0 , -1.2 , 0 , leftno + enkle , xyz call setbox 0 , 0 , .2 , .1 , .1 , .3 call colorcube kl call glPopMatrix call glPopMatrix call glPopMatrix call glPushMatrix call child -.45 , 0 , 0 , leg + rightno , zyx call setbox 0 , -.6 , 0 , .1 , .4 , .1 call colorcube kl call glPushMatrix call child 0 , -1 , 0 , knee + rightno , xyz call colorcube kl call glPushMatrix call child 0 , -1.2 , 0 , enkle + rightno , xyz call setbox 0 , 0 , .2 , .1 , .1 , .3 call colorcube kl call glPopMatrix call glPopMatrix call glPopMatrix call glPushMatrix call child .65 , 1.3 , 0 , leftno + sholder , xyz call setbox 0 , -.5 , 0 , .1 , .4 , .1 call colorcube kl call glPushMatrix call child 0 , -1 , 0 , leftno + elbow , xyz call colorcube kl call glPushMatrix call child 0 , -1 , 0 , leftno + wrist , zyx if h then call glScale .5,.5,.5 call hand leftno , kl else call setbox 0,-.2,0 , .05,.2,.2 call colorcube kl end if call glPopMatrix call glPopMatrix call glPopMatrix call glPushMatrix call child -.65 , 1.3 , 0 , arm + rightno , xyz call setbox 0 , -.5 , 0 , .1 , .4 , .1 call colorcube kl call glPushMatrix call child 0 , -1 , 0 , elbow + rightno , xyz call colorcube kl call glPushMatrix call child 0 , -1 , 0 , wrist + rightno , zyx if h then call glScale .5,.5,.5 call hand rightno , kl else call setbox 0,-.2,0 , .05,.2,.2 call colorcube kl end if call glPopMatrix call glPopMatrix call glPopMatrix end sub
sub dog kl call setbox 0,.2,.5 , .3,.3,.7 call colorcube kl call glPushMatrix call child 0 , .6 , 1.5 , leftno + neck , xyz call glPushMatrix call child 0 , 0 , 0 , neck + rightno , zyx call setbox 0,0,0 , .3 , .3 , .3 call colorcube kl call setbox 0,-.2,.3 , .2,.2,.2 call colorcube kl call setbox 0,0,.5 , .1,.1,.1 call colorcube kl call setbox .3,-.15,0 , .05,.3,.2 call colorcube kl call setbox -.3,-.15,0 , .05,.3,.2 call colorcube kl call glPopMatrix call glPopMatrix call glPushMatrix call child 0 , .4 , -.5 , leftno + tail , yzx call setbox 0,.3,0 , .1 , .3 , .1 call colorcube kl call glPopMatrix call glPushMatrix call child .3 , 0 , 1 , leftno + leg , zyx call setbox 0 , -.6 , 0 , .1 , .4 , .1 call colorcube kl call glPushMatrix call child 0 , -1 , 0 , leftno + knee , xyz call colorcube kl call glPushMatrix call child 0 , -1.2 , 0 , leftno + enkle , xyz call setbox 0 , 0 , .2 , .1 , .1 , .3 call colorcube kl call glPopMatrix call glPopMatrix call glPopMatrix call glPushMatrix call child -.3 , 0 , 1 , leg + rightno, zyx call setbox 0 , -.6 , 0 , .1 , .4 , .1 call colorcube kl call glPushMatrix call child 0 , -1 , 0 , knee + rightno, xyz call colorcube kl call glPushMatrix call child 0 , -1.2 , 0 , enkle + rightno, xyz call setbox 0 , 0 , .2 , .1 , .1 , .3 call colorcube kl call glPopMatrix call glPopMatrix call glPopMatrix call glPushMatrix call child .3 , 0 , 0 , leftno + sholder , zyx call setbox 0 , -.6 , 0 , .1 , .4 , .1 call colorcube kl call glPushMatrix call child 0 , -1 , 0 , leftno + elbow , xyz call colorcube kl call glPushMatrix call child 0 , -1.2 , 0 , leftno + wrist , xyz call setbox 0 , 0 , .2 , .1 , .1 , .3 call colorcube kl call glPopMatrix call glPopMatrix call glPopMatrix call glPushMatrix call child -.3 , 0 , 0 , sholder + rightno , zyx call setbox 0 , -.6 , 0 , .1 , .4 , .1 call colorcube kl call glPushMatrix call child 0 , -1 , 0 , elbow + rightno , xyz call colorcube kl call glPushMatrix call child 0 , -1.2 , 0 , wrist + rightno , xyz call setbox 0 , 0 , .2 , .1 , .1 , .3 call colorcube kl call glPopMatrix call glPopMatrix call glPopMatrix end sub
'' shapes part of bluaGL
sub digit b , kl call glPushMatrix call glScale 1/8,1/8,1/8 for i = 0 to 7 for j = 0 to 7 if ( letter( b , i ) and 2 ^ j ) <> 0 then call setbox j - 3 , 3 - i , 0 , .5,.5,.5 call colorcube kl end if next j next i call glPopMatrix end sub sub text txt$ , kl call glPushMatrix call glTranslate box(0) , box(1) , box(2) call glScale box(3) , box(4) , box(5) l = len( txt$ ) for i = 1 to l call glPushMatrix call glTranslate i - l / 2 , 0 , 0 ch$ = lower$( mid$( txt$ , i , 1 ) ) ch = instr( letter$ , ch$ ) call digit ch , kl call glPopMatrix next i call glPopMatrix end sub sub setbox mx , my , mz , dx , dy , dz ''set bodinging box coordinates box(0) = mx box(1) = my box(2) = mz box(3) = dx box(4) = dy box(5) = dz end sub
sub cone s , dx , dz , kl ''s = number of side's ''dx , dz = diametger top ''kl = color cylinder if s < 4 then s = 4 if s > 24 then s = 24 call glPushMatrix call glTranslate box(0) , box(1) , box(2) call glScale box(3) , box(4) , box(5) for i = 0 to pi * 2 step pi * 2 / s i2 = i + pi * 2 / s call point 0 , sin( i ) * dx , 1 , cos( i ) * dz call point 1 , sin( i2 ) * dx , 1 , cos( i2 ) * dz call point 2 , sin( i2 ) , -1 , cos( i2 ) call point 3 , sin( i ) , -1 , cos( i ) call quad 0 , 1 , 2 , 3 , kl next i call glPopMatrix end sub
sub sphere a , b , da , db , kl ''a , b = number of sides ''da , db = superellipsoid [ 1 , 1 for normal sphere ] ''kl = color of sphere if a < 4 then a = 4 if a > 24 then a = 24 if b < 4 then b = 4 if b > 24 then b = 24 call glPushMatrix call glTranslate box( 0 ) , box( 1 ) , box( 2 ) call glScale box( 3 ) , box( 4 ) , box( 5 ) for i = 0-pi to pi step pi / a * 2 i2 = i + pi / a * 2 for j = 0-pi / 2 to pi / 2 - pi / b * 2 step pi / b * 2 j2 = j + pi / b * 2
x = sin( i ) * cos( j ) y = sin( j ) z = cos( i ) * cos( j ) call point 0 _ , abs( x ) ^ da * sgn( x ) _ , abs( y ) ^ db * sgn( y ) _ , abs( z ) ^ da * sgn( z )
x = sin( i2 ) * cos( j ) y = sin( j ) z = cos( i2 ) * cos( j ) call point 1 _ , abs( x ) ^ da * sgn( x ) _ , abs( y ) ^ db * sgn( y ) _ , abs( z ) ^ da * sgn( z )
x = sin( i2 ) * cos( j2 ) y = sin( j2 ) z = cos( i2 ) * cos( j2 ) call point 2 _ , abs( x ) ^ da * sgn( x ) _ , abs( y ) ^ db * sgn( y ) _ , abs( z ) ^ da * sgn( z )
x = sin( i ) * cos( j2 ) y = sin( j2 ) z = cos( i ) * cos( j2 ) call point 3 _ , abs( x ) ^ da * sgn( x ) _ , abs( y ) ^ db * sgn( y ) _ , abs( z ) ^ da * sgn( z )
call quad 0 , 1 , 2 , 3 , kl next j next i call glPopMatrix end sub
sub torus a , b , kl ''a , b = number of sides ''kl = color mode if a < 4 then a = 4 if a > 24 then a = 24 if b < 4 then b = 4 if b > 24 then b = 24 mx = box( 0 ) my = box( 1 ) mz = box( 2 ) dx = box( 3 ) dy = box( 4 ) dz = box( 5 ) for i = 0-pi to pi step pi / a * 2 i2 = i + pi / a * 2 for j = 0-pi to pi step pi / b * 2 j2 = j + pi / b * 2 call point 0 _ , mx + ( dx + dy * cos( i ) ) * cos( j ) _ , my + ( dx + dy * cos( i ) ) * sin( j ) _ , mz + sin( i ) * dz call point 1 _ , mx + ( dx + dy * cos( i ) ) * cos( j2 ) _ , my + ( dx + dy * cos( i ) ) * sin( j2 ) _ , mz + sin( i ) * dz call point 2 _ , mx + ( dx + dy * cos( i2 ) ) * cos( j2 ) _ , my + ( dx + dy * cos( i2 ) ) * sin( j2 ) _ , mz + sin( i2 ) * dz call point 3 _ , mx + ( dx + dy * cos( i2 ) ) * cos( j ) _ , my + ( dx + dy * cos( i2 ) ) * sin( j ) _ , mz + sin( i2 ) * dz if kl > 0 then call quad 0 , 1 , 2 , 3 , kl else select case kl case -1 kla = rainbow( i * 180 / pi) klb = rainbow( i2 * 180 / pi) call quad4 0 , kla , 1 , kla , 2 , klb , 3 , klb case -2 kla = rainbow( j * 180 / pi ) klb = rainbow( j2 * 180 / pi) call quad4 0 , kla , 1 , klb , 2 , klb , 3 , kla case else kla = rainbow( ( j + i ) * 180 / pi ) klc = rainbow( ( j + i + j2 + i2 ) / 2 * 180 / pi ) klb = rainbow( ( j2 + i2 ) * 180 / pi ) call quad4 0 , kla , 1 , klc , 2 , klb , 3 , klc end select end if next j next i end sub
sub banana a , b , kl if a < 3 then a = 3 if a > 64 then a = 64 if b < 3 then b = 3 if b > 64 then b = 64 mx = box(0) my = box(1) mz = box(2) dx = box(3) dy = box(4) dz = box(5) for i = 0-pi to pi step pi / a * 2 i2 = i + pi / a * 2 for j = 0-pi/1.99 to pi/1.99 - pi/b*2 step pi / b * 1.99 j2 = j + pi / b * 1.99 call point 0 _ , mx + ( dx + dy * cos( i ) * cos( j ) ) _ * cos( j ) _ , my + ( dx + dy * cos( i ) * cos( j ) ) _ * sin( j ) _ , mz + sin( i ) * dz * cos( j ) call point 1 _ , mx + ( dx + dy * cos( i ) * cos( j2 ) ) _ * cos( j2 ) _ , my + ( dx + dy * cos( i ) * cos( j2 ) ) _ * sin( j2 ) _ , mz + sin( i ) * dz * cos( j2 ) call point 2 _ , mx + ( dx + dy * cos( i2 ) * cos( j2 ) ) _ * cos( j2 ) _ , my + ( dx + dy * cos( i2 ) * cos( j2 ) ) _ * sin( j2 ) _ , mz + sin( i2 ) * dz * cos( j2 ) call point 3 _ , mx + ( dx + dy * cos( i2 ) * cos( j ) ) _ * cos( j ) _ , my + ( dx + dy * cos( i2 ) * cos( j ) ) _ * sin( j ) _ , mz + sin( i2 ) * dz * cos( j )
if kl > 0 then call quad 0 , 1 , 2 , 3 , kl else select case kl case -1 kla = rainbow( i * 180 / pi) klb = rainbow( i2 * 180 / pi) call quad4 0 , kla , 1 , kla , 2 , klb , 3 , klb case -2 kla = rainbow( j * 180 / pi ) klb = rainbow( j2 * 180 / pi) call quad4 0 , kla , 1 , klb , 2 , klb , 3 , kla case else kla = rainbow( ( j + i ) * 180 / pi ) klc = rainbow( ( j + i + j2 + i2 ) / 2 * 180 / pi ) klb = rainbow( ( j2 + i2 ) * 180 / pi ) call quad4 0 , kla , 1 , klc , 2 , klb , 3 , klc end select end if next j next i end sub
sub colorcube kl ''create point's in the swarm select case kl case -1 call cube red,cyan , green,magenta , blue,yellow case -2 call point 0 , -1 , -1 , -1 call point 1 , -1 , -1 , 1 call point 2 , -1 , 1 , -1 call point 3 , -1 , 1 , 1 call point 4 , 1 , -1 , -1 call point 5 , 1 , -1 , 1 call point 6 , 1 , 1 , -1 call point 7 , 1 , 1 , 1
''then use points in swarm to draw quads call glPushMatrix call glTranslate box(0) , box(1) , box(2) call glScale box(3) , box(4) , box(5) call quad4 0 , black , 1 , red , 3 , yellow , 2 , green call quad4 7 , white , 6 , cyan , 4 , blue , 5 , magenta call quad4 0 , black , 2 , green , 6 , cyan , 4 , blue call quad4 7 , white , 5 , magenta , 1 , red , 3 , yellow call quad4 0 , black , 1 , red , 5 , magenta , 4 , blue call quad4 7 , white , 6 , cyan , 2 , green , 3 , yellow call glPopMatrix case else kl1 = mix( kl , .8 , black ) kl2 = mix( kl , .6 , black ) call cube kl1,kl1 , kl2,kl2 , kl,kl end select end sub
sub cube left , right , front , back , down , up ''create a cube mesh ''whit 6 colors and whit bodingbox coordinates
''first fil swarm whit points call point 0 , -1 , -1 , -1 call point 1 , -1 , -1 , 1 call point 2 , -1 , 1 , -1 call point 3 , -1 , 1 , 1 call point 4 , 1 , -1 , -1 call point 5 , 1 , -1 , 1 call point 6 , 1 , 1 , -1 call point 7 , 1 , 1 , 1
''then use points in swarm to draw quads call glPushMatrix call glTranslate box(0) , box(1) , box(2) call glScale box(3) , box(4) , box(5) call quad 0 , 1 , 3 , 2 , left call quad 7 , 6 , 4 , 5 , right call quad 0 , 2 , 6 , 4 , front call quad 7 , 5 , 1 , 3 , back call quad 0 , 1 , 5 , 4 , down call quad 7 , 6 , 2 , 3 , up call glPopMatrix end sub
sub point no , x , y , z ''set a point in the swarm if no < 0 or no > 256 then exit sub pntx( no ) = x pnty( no ) = y pntz( no ) = z end sub
sub tri p1 , p2 , p3 , kl ''draw a triangle whit 1 color call tri3 p1 , kl , p2 , kl , p3 , kl end sub
sub tri3 p1 , kl1 , p2 , kl2 , p3 , kl3 ''draw a triangle from point's in the swarm ''whit 3 color's if p1 < 0 or p1 > 256 then exit sub if p2 < 0 or p2 > 256 then exit sub if p3 < 0 or p3 > 256 then exit sub x1 = pntx( p1 ) y1 = pnty( p1 ) z1 = pntz( p1 ) x2 = pntx( p2 ) y2 = pnty( p2 ) z2 = pntz( p2 ) x3 = pntx( p3 ) y3 = pnty( p3 ) z3 = pntz( p3 ) call glBegin GL.TRIANGLES call setColor kl1 call glVertex x1 , y1 , z1 call setColor kl2 call glVertex x2 , y2 , z2 call setColor kl3 call glVertex x3 , y3 , z3 call glEnd end sub
sub quad p1 , p2 , p3 , p4 , kl ''draw a quadangle from points in the swarm ''whit 1 color call quad4 p1 , kl , p2 , kl , p3 , kl , p4 , kl end sub
sub quad4 p1 , kl1 , p2 , kl2 , p3 , kl3 , p4 , kl4 ''draw a quadangle from points in the swarm ''whit 4 color's if p1 < 0 or p1 > 256 then exit sub if p2 < 0 or p2 > 256 then exit sub if p3 < 0 or p3 > 256 then exit sub if p4 < 0 or p4 > 256 then exit sub x1 = pntx( p1 ) y1 = pnty( p1 ) z1 = pntz( p1 ) x2 = pntx( p2 ) y2 = pnty( p2 ) z2 = pntz( p2 ) x3 = pntx( p3 ) y3 = pnty( p3 ) z3 = pntz( p3 ) x4 = pntx( p4 ) y4 = pnty( p4 ) z4 = pntz( p4 ) call glBegin GL.QUADS call setColor kl1 call glVertex x1 , y1 , z1 call setColor kl2 call glVertex x2 , y2 , z2 call setColor kl3 call glVertex x3 , y3 , z3 call setColor kl4 call glVertex x4 , y4 , z4 call glEnd end sub
'' openGl
sub glClear code ''clear the openGL screen calldll #gl,"glClear" _ , code as long _ , ret as long end sub
sub glLoadIdentity ''set drawingmatrix to standert calldll #gl , "glLoadIdentity" _ , ret as long end sub
sub glPushMatrix ''to new drawingmatrix calldll #gl , "glPushMatrix" _ , ret as long end sub
sub glPopMatrix ''to old drawingmatrix calldll #gl , "glPopMatrix" _ , ret as long end sub
sub glEnd ''end of polygon[s] calldll #gl , "glEnd" _ , ret as void end sub
sub glEnable i ''set a item calldll #gl , "glEnable" _ , i as long _ , ret as long end sub
sub glBegin i ''set polygon mode calldll #gl , "glBegin" _ , i as long _ , ret as long end sub
sub glScale x , y , z ''scale drawingmatrix calldll #gl , "glScaled" _ , x as double _ , y as double _ , z as double _ , ret as long end sub
sub glTranslate x , y , z ''move drawingmatrix calldll #gl , "glTranslated" _ , x as double _ , y as double _ , z as double _ , ret as long end sub
sub glRotate a , x , y , z ''rotate drawinmatrix calldll #gl , "glRotated" _ , a as double _ , x as double _ , y as double _ , z as double _ , ret as long end sub
sub glVertex x , y , z ''add a point to a polygon calldll #gl , "glVertex3d" _ , x as double _ , y as double _ , z as double _ , ret as long end sub
sub glNormal x , y , z ''set normal of point[s] calldll #gl , "glNormal3f" _ , x as double _ , y as double _ , z as double _ , ret as long end sub
sub setColor clr ''set color of point[s] of polygon r = colorR( clr ) g = colorG( clr ) b = colorB( clr ) a = colorA( clr ) calldll #gl , "glColor4d" _ , r as double _ , g as double _ , b as double _ , a as double _ , ret as long end sub
sub openglInit struct PFD _ , Size as word _ , Version as word _ , Flags as long _ , pixelType as char[1] _ , ColorBits as char[1] _ , RedBits as char[1] _ , RedShift as char[1] _ , GreenBits as char[1] _ , GreenShift as char[1] _ , BlueBits as char[1] _ , BlueShift as char[1] _ , AlphaBits as char[1] _ , AlphaShift as char[1] _ , AccumBits as char[1] _ , AccumRedBits as char[1] _ , AccumGreenBits as char[1] _ , AccumBlueBits as char[1] _ , AccumAlphaBits as char[1] _ , DepthBits as char[1] _ , StencilBits as char[1] _ , AuxBuffers as char[1] _ , LayerType as char[1] _ , Reserved as char[1] _ , LayerMask as long _ , VisibleMask as long _ , DamageMask as long
PFD.Version.struct=1 PFD.ColorBits.struct=24 PFD.DepthBits.struct=16 PFD.Size.struct=len(PFD.struct) PFD.Flags.struct=37
calldll #user32,"GetDC" _ , MainH as ulong, MainDC as ulong calldll #gdi32,"ChoosePixelFormat" _ , MainDC as ulong, PFD as struct, ret as long calldll #gdi32, "SetPixelFormat" _ , MainDC as ulong, ret as long _ , PFD as struct, t as long calldll #gl,"wglCreateContext" _ , MainDC as ulong, GLContext as ulong calldll #gl,"wglMakeCurrent" _ , MainDC as ulong, GLContext as ulong _ , ret as long call glEnable GL.DEPTH.TEST end sub
|
|
|
Post by bluatigro on Aug 28, 2020 4:22:46 GMT -5
my 'game over' does not rotate . why ?
|
|
|
Post by Brandon Parker on Aug 28, 2020 14:26:51 GMT -5
It rotated for me ... kind of ...
It looked like it was mostly squishing the letters inward and ended up clipping off a couple from either end as it was "rotating" ...
{:0)
Brandon Parker
|
|
|
Post by bluatigro on Aug 29, 2020 1:12:24 GMT -5
@ Brandon Parker : the pecspeverty is not goot in LB + openGL
@ anyone : how do i set the scene in pecseverty ? now it is not
|
|