Messages

I decided to check this forum out and saw this. Great work Zawran . I took the liberty of adding a couple of functions to your library: circle and elipse(not really an elipse its really an oval). I hope you don't mind. It draws them filled and hollow. Also, I added alpha to the line function to keep consistency with the pixel and my functions. I hope this is usefull if not just ignore it.  

check out this thread it might help you out:
http://www.blitzmax.com/Community/posts.php?topic=71132

this past couple of days I had some free time and I decided to take my time and try to look at vectors. I googled and got a load of sites to search. I ran in to this site:
http://tonypa.pri.ee/vectors/start.html
it is a vector tutorial website for flash. I noticed that most of the language is similar to blitzmax. So I started looking deep in to it and discovered it is a good site for vectors. I have learned a bit from it so far. I went through all of the tutorials and managed to convert most of them to blitzmax. and also managed to make a demo. And Here it is:
demo:

Code Select Expand


SuperStrict
Framework BRL.GLMax2D
Import BRL.Random
Import BRL.DXGraphics
SetGraphicsDriver GLMax2DDriver()
Include "lib.bmx"
Type point
Field x#
Field y#
End Type
Type tgame
Field stageW%
Field stageH%
Field maxV#
Field gravity#
Field bounce:vector2d
Field t#
Field LastTime#
Global walllist:TList
Global ballList:TList
Global objlist:TList
Method Create(W%,H%,V#,G#)
    walllist = CreateList()
balllist = CreateList()
objlist = CreateList()
stageW = W
    stageH = H
    maxV = V
    gravity = G
'myOb = New vector2d
End Method
Method createObjects(n%)
For Local i% = 1 To n
Local bn:vector2d = New vector2d
bn.p0 = New point
bn.p1 = New point
objlist.addlast(bn)
bn.r=5+Rand(4)*5
bn.m=1
'attach mc
Local x#=i*65;
Local y#=80;
bn.p0.x=x
bn.p0.y=y
x:+i*20
y:+Rand(6)-1
bn.p1.x=x
bn.p1.y=y
bn.updateVector(True);
bn.airf = 1
bn.b = 1
bn.f = 1
bn.r = 20
bn.lastTime = MilliSecs()
Next
End Method
Method createWall(x1#,y1#,x2#,y2#,b#,f#)
Local v:vector2d = New vector2d
walllist.addlast(v)
v.p0 = New point
v.p0.x = x1
v.p0.y = y1
v.p1 =New point
v.p1.x = x2
v.p1.y = y2
v.b = b
v.f = f
v.updatevector(True)
End Method
Method CreateBall(x1#,y1#,R#)
Local B:vector2d = New vector2d
balllist.addlast(B)
b.p0 = New point
b.p0.x = x1
b.p0.y = y1
b.r = R
b.updatevector(True)
End Method

Method speedlimit(ob:vector2d)
         If (ob.vx>game.maxV)
            ob.vx = game.maxV;
         Else If (ob.vx<-game.maxV)
            ob.vx = -game.maxV;
         EndIf
         If (ob.vy>game.maxV)
            ob.vy = game.maxV
         ElseIf (ob.vy<-game.maxV)
            ob.vy = -game.maxV;
         EndIf
End Method
Method collitionball2wall(ob:vector2d)
         For Local w:vector2d = EachIn game.BallList
            Local v:vector2d = ob.ball2ball(w);
            Local pen# = ob.r+w.r-v.Length;
            ' If we have hit the ball
            If pen>=0
               ' move Object away from the ball
               ob.p1.x :+ v.dx*pen;
               ob.p1.y :+ v.dy*pen;
               ' change movement, bounce off from the normal of v
               Local vbounce:vector2d = New vector2d
   vbounce.dx = v.dy
   vbounce.dy =-v.dx
   vbounce.lx = v.dx
   vbounce.ly = v.dy
               Local vb:vector2d = ob.bounced(vbounce)
               ob.vx = vb.vx
               ob.vy = vb.vy
            EndIf
         Next
End Method
Method collitionball2ball(ob:vector2d)
End Method
Method collitionwall(ob:vector2d)
         For Local w:vector2d = EachIn game.walllist
            Local v:vector2d = Ob.findIntersection(w);

v = v.updateVector(False);
           
Local pen# = Ob.r-v.Length;
            ' If we have hit the wall
            If (pen>=0)
               ' move Object away from the wall
               Ob.p1.x :+ v.dx*pen;
               Ob.p1.y :+ v.dy*pen;
               ' change movement, bounce off from the normal of v
               Local vbounce:vector2d = New vector2d
   vbounce.dx = v.lx
   vbounce.dy = v.ly
   vbounce.lx = v.dx
   vbounce.ly = v.dy
   vbounce.b = 1
   vbounce.f = 1
               Local vb:vector2d = Ob.bounced(vbounce);
               Ob.vx = vb.vx;
               Ob.vy = vb.vy;
            EndIf
         Next
End Method
'wrap balls to opoisite side of screen
Method wrap(ob:vector2d)
         If (ob.p1.x>game.stageW+ob.r)
            ob.p1.x = -ob.r
          Else If (ob.p1.x<-ob.r)
            ob.p1.x = game.stageW+ob.r
         EndIf
         If (ob.p1.y>game.stageH+ob.r)
            ob.p1.y = -ob.r;
         Else If (ob.p1.y<-ob.r)
            ob.p1.y = game.stageH+ob.r
         EndIf
End Method
Method ball2wall (ob:vector2d)
    ' start To calculate movement
        ' dont let it go over Max speed
        ' update the vector parameters
        ob.vx:*ob.airf
ob.vy:*ob.airf
speedlimit(ob)
ob.updateObject();
' check the balls For collisions
        collitionball2wall(ob)
collitionwall(ob)
' reset Object To other side If gone out of stage
wrap(ob)
' make End point equal To starting point For Next cycle
ob.p0 = ob.p1
' save the movement without time
ob.vx :/ ob.timeFrame
ob.vy :/ ob.timeFrame
End Method
Method drawall()
SetColor 255,0,0
For Local v:vector2d = EachIn game.BallList
Drawcircle v.p0.x,v.p0.y,v.r
Next

SetColor 0,255,0
For Local v:vector2d = EachIn game.walllist
DrawLineaa v.p0.x,v.p0.y,v.p1.x,v.p1.y
Next
EndMethod      ' main Function
Method ball2ball()
Local vc:vector2d = New vector2d
Local vn:vector2d = New vector2d
Local v3:vector2d = New vector2d
Local v4:vector2d = New vector2d
Local p2:point = New point
Local p3:point = New point
Local totalradius#
Local remaining:TList = objlist.copy()
For Local ob:vector2d = EachIn objlist
Local newv:vector2d = New vector2d
remaining.removefirst()
For Local ob2:vector2d = EachIn remaining
'vector between center points of ball
vc.p0 = ob.p0
vc.p1 = ob2.p0
vc.updateVector(True)
'sum of radius
totalRadius=ob.r+ob2.r
Local pen#=totalRadius-vc.length
'check If balls collide at start
If(pen>=0)
'move Object away from the ball
ob.p1.x:-vc.dx*pen
ob.p1.y:-vc.dy*pen
'change movement, bounce off from the normal of v
newv=ob.bounceBalls(ob2, vc)
ob.vx=newv.vx1
ob.vy=newv.vy1
ob2.vx=newv.vx2
ob2.vy=newv.vy2
Else
'reduce movement vector from ball2 from movement vector of ball1
v3.p0 = ob.p0
v3.vx=ob.vx-ob2.vx
v3.vy=ob.vy-ob2.vy
v3.updateVector()
'use v3 as New movement vector For collision calculation
'projection of vc on v3
Local vp:vector2d=vc.projectVector(v3.dx, v3.dy)
'vector To center of ball2 in direction of movement vectors normal

p2.x=ob.p0.x+vp.vx
p2.y=ob.p0.y+vp.vy
vn.p0 = p2
vn.p1 = ob2.p0
vn.updateVector(True)
'check If vn is shorter Then combined radiuses
Local diff#=totalRadius-vn.length;
Local collision%=False
If(diff>0)
'collision
'amount To move back moving ball
Local moveBack#=Sqr(totalRadius*totalRadius-vn.length*vn.length);
p3.x=vn.p0.x-moveBack*v3.dx
p3.y=vn.p0.y-moveBack*v3.dy
'vector from ball1 starting point To its coordinates when collision happens
v4.p0 = ob.p0
v4.p1 = ob.p1
v4.updateVector(True)
'check If p3 is on the movement vector
If(v4.length<=v3.length And v4.dotP(ob)>0)
'collision
Local t#=v4.length/v3.length
collision=True
ob.p1.x=ob.p0.x+t*ob.vx
ob.p1.y=ob.p0.y+t*ob.vy
ob2.p1.x=ob2.p0.x+t*ob2.vx
ob2.p1.y=ob2.p0.y+t*ob2.vy
'vector between centers of ball in the moment of collision
vc.p0 = ob.p1
vc.p1 = ob2.p1
vc.updateVector(True)
newv:vector2d=ob.bounceBalls(ob2, vc)
ob.vx=newv.vx1
ob.vy=newv.vy1
ob2.vx=newv.vx2
ob2.vy=newv.vy2
ob2.makeVector()
ob.makeVector()
EndIf
EndIf
EndIf
Next
Next
End Method
End Type
Type vector2d
Field p0:point
Field p1:point
Field vx#,vy#
Field dx#,dy#
Field rx#,ry#
Field lx#,ly#
Field r#,m#
Field vx1#,vy1#
Field vx2#,vy2#
Field Length#
Field timeFrame#
Field lastTime#
Global airf#
Global b#
Global f#
      Method updateObject ()
         ' find time passed from last update
         Local thisTime# = MilliSecs()
         Local time# = (thisTime - lastTime)/60
         ' we use time, Not frames To move so multiply movement vector with time passed
         vx :* time
         vy :* time
         ' add gravity, also based on time
         vy = vy+time*game.gravity
         p1 = New point
         ' find End point coordinates
         p1.x = p0.x+vx;
         p1.y = p0.y+vy;
         ' length of vector
         Length = Sqr(vx*vx+vy*vy);
         ' normalized unti-sized components
         dx = vx/Length;
         dy = vy/Length;
         ' Right hand normal
         rx = -vy;
         ry = vx;
         ' Left hand normal
         lx = vy;
         ly = -vx;
         ' save the current time
         lastTime = thisTime;
         ' save time passed
         timeFrame = time;
      EndMethod
    Method updateVector:vector2d (frompoints:Int = False)
         ' x And y components
         If frompoints
            vx = p1.x-p0.x;
            vy = p1.y-p0.y;
         Else
p0 = New point
p1 = New point
            p1.x = p0.x+vx;
            p1.y = p0.y+vy;
         EndIf
         makeVector()
holdvector()
Return Self
      End Method
Method makeVector()
'lengthgth of vector
length=Sqr(vx*vx+vy*vy);
'normalized unti-sized components
If(length>0)
dx=vx/length;
dy=vy/length;
Else
dx=0
dy=0
EndIf
'Right hand normal
rx = -dy;
ry = dx;
'Left hand normal
lx = dy;
ly = -dx;
End Method
'Function To hold balls inside stage
Method holdVector()
'reset Object To other side If gone out of stage
If(p1.x>game.stageW-r)
p1.x=game.stageW-r;
vx=-Abs(vx);
ElseIf(p1.x<r)
p1.x=r;
vx=Abs(vx);
EndIf
If(p1.y>game.stageH-r)
p1.y=game.stageH-r;
vy=-Abs(vy);
ElseIf(p1.y<r)
p1.y=r;
vy=Abs(vy);
EndIf
End Method
'calculate dot product of 2 vectors
Method dotP#(v2:vector2d)
Local dp# = vx*v2.vx + vy*v2.vy;
Return dp
End Method
    Method findIntersection:vector2d (v2:vector2d)
    ' vector between center of ball And starting point of wall
    Local v3:vector2d = New vector2d
    Local v:vector2d
v3.vx = p1.x-v2.p0.x;
    v3.vy = p1.y-v2.p0.y;
    ' check If we have hit starting point
    Local dp# = v3.dotP(v2)
    If (dp<0)
        ' hits starting point
            v = v3;
Else
Local v4:vector2d = New vector2d
v4.vx = p1.x-v2.p1.x;
v4.vy = p1.y-v2.p1.y;
' check If we have hit side Or endpoint
dp = v4.vx*v2.dx+v4.vy*v2.dy;
If (dp>0)
' hits ending point
v = v4;
Else
' it hits the wall
' project this vector on the normal of the wall
v = v3.projectVector(v2.lx, v2.ly);
EndIf
EndIf
Return v;
EndMethod
' find collision of 2 balls
Method ball2ball:vector2d (b2:vector2d)
' vector between centers of balls
Local v3:vector2d = New vector2d
v3.vx = p1.x-b2.p0.x;
v3.vy = p1.y-b2.p0.y;
        v3.Length = Sqr(v3.vx*v3.vx+v3.vy*v3.vy);
v3.dx = v3.vx/v3.Length;
v3.dy = v3.vy/v3.Length;
Return v3;
EndMethod
' find New vector bouncing from v2
Method bounced:vector2d (v2:vector2d)
         ' projection of v1 on v2
         Local proj1:vector2d = projectVector(v2.dx, v2.dy);
         ' projection of v1 on v2 normal
         Local proj2:vector2d = projectVector(v2.lx, v2.ly);
         Local proj:vector2d = New vector2d
         ' reverse projection on v2 normal
         proj2.Length = Sqr(proj2.vx*proj2.vx+proj2.vy*proj2.vy);
         proj2.vx = v2.lx*proj2.Length
         proj2.vy = v2.ly*proj2.Length
         ' add the projections
         proj.vx = proj1.vx+proj2.vx;
         proj.vy = proj1.vy+proj2.vy;
         Return proj;
EndMethod
Method bounceBalls:vector2d(v2:vector2d, v:vector2d)
Local proj11:vector2d=projectVector(v.dx, v.dy) 'projection of v1 on v
Local proj12:vector2d=projectVector(v.lx, v.ly) 'projection of v1 on v normal
Local proj21:vector2d=v2.projectVector(v.dx, v.dy) 'projection of v2 on v
Local proj22:vector2d=v2.projectVector(v.lx, v.ly) 'projection of v2 on v normal

Local P#= m * proj11.vx + v2.m * proj21.vx;
Local Vn#=proj11.vx-proj21.vx;
Local v2fx#=(P+Vn*m)/(m+v2.m);
Local v1fx#=v2fx-Vn;

P#=m*proj11.vy+v2.m*proj21.vy;
    Vn#=proj11.vy-proj21.vy;
Local v2fy#=(P+Vn*m)/(m+v2.m);
Local v1fy#=v2fy-Vn;

Local proj:vector2d  = New vector2d
'add the projections For v1
proj.vx1=proj12.vx+v1fx;
proj.vy1=proj12.vy+v1fy;
'add the projections For v2
proj.vx2=proj22.vx+v2fx;
proj.vy2=proj22.vy+v2fy;
Return proj
End Method
      ' project vector v1 on unit-sized vector dx/dy
      Method projectVector:vector2d (dx#, dy#)
         ' find dot product
         Local dp# = vx*dx+vy*dy;
         Local proj:vector2d = New vector2d
         ' projection components
         proj.vx = dp*dx;
         proj.vy = dp*dy;
         Return proj;
      EndMethod
End Type

Global game:tgame = New tgame
game.Create(640,640,40,0.4)
game.Createobjects(4)
game.createBall(100,100,30)
game.createBall(400,100,40)
game.createBall(250,250,20)
game.createBall(100,300,15)
game.createball(500,350,25)
game.createwall(0,0,game.stageW-1,0,1,1)
game.createwall(0,game.stageH-1,game.stageW-1,game.stageH-1,1,1)
game.createwall(0,0,0,game.stageH-1,1,1)
game.createwall(game.stageW-1,0,game.stageW-1,game.stageH-1,1,1)

game.createWall(250,110,50,250,1,1)
game.createwall(250,150,250,110,1,1)
game.createWall(50,150,250,150,1,1)
game.createWall(50,250,50,150, 1,1)
game.createWall(250,300,400,280,1,1)
game.createWall(250,300,250,350,1,1)
game.createWall(400,280,400,330,1,1)
game.createWall(250,350,400,330,1,1)
game.createWall(250,620,500,600,1,1)
game.createWall(200,620,200,500,1,1)

Graphics game.stageW,game.stageH
Global mycaps:TG_D3DDEVICEDESC7
If _max2dDriver.ToString() = "DirectX7"
mycaps = New TG_D3DDEVICEDESC7
D3D7GraphicsDriver().Direct3DDevice7().getcaps mycaps
EndIf
Repeat

Cls
game.ball2ball()
game.drawall()
For Local g:vector2d = EachIn game.objlist
game.ball2wall(g)
SetColor 0,0,255
Drawcircle g.p0.x, g.p0.y,g.r
Next
Flip()
Until KeyDown(key_escape)



lib.bmx:

Code Select Expand


Function DRAWLINEAA(from_x:Float,from_y:Float,to_x:Float,to_y:Float)
If _max2dDriver.ToString() = "DirectX7"
If mycaps.dwRasterCaps_LINE & 4096
Local D3DRS_EDGEANTIALIAS:Int=40
D3D7GraphicsDriver().Direct3DDevice7().setRenderState D3DRS_EDGEANTIALIAS,True
DrawLine from_x,from_y,to_x,to_y
D3D7GraphicsDriver().Direct3DDevice7().setRenderState D3DRS_EDGEANTIALIAS,False
Else
    DebugLog "AA not supported"
          DrawLine from_x,from_y,to_x,to_y
EndIf
Else
Local saveblend:Int=GetBlend()
SetBlend alphablend
    glEnable(GL_LINE_SMOOTH)
DrawLine from_x,from_y,to_x,to_y
SetBlend saveblend
    glDisable(GL_LINE_SMOOTH)
EndIf
End Function

Type TG_D3DDeviceDesc7
Field dwDevCaps:Int
Field dwSize_LINE:Int               'Size of structure
    Field dwMiscCaps_LINE:Int           'Miscellaneous capabilities
    Field dwRasterCaps_LINE:Int         'Raster capabilities
    Field dwZCmpCaps_LINE:Int           'Z-comparison capabilities
    Field dwSrcBlendCaps_LINE:Int       'Source-blending capabilities
    Field dwDestBlendCaps_LINE:Int      'Destination-blending capa bilities
    Field dwAlphaCmpCaps_LINE:Int       'Alpha-test-comparison capabilities
    Field dwShadeCaps_LINE:Int          'Shading capabilities
    Field dwTextureCaps_LINE:Int        'Texture capabilities
    Field dwTextureFilterCaps_LINE:Int  'Texture-filtering capabilities
    Field dwTextureBlendCaps_LINE:Int   'Texture-blending capabilities
    Field dwTextureAddressCaps_LINE:Int 'Texture-addressing capabilities
    Field dwStippleWidth_LINE:Int       'Stipple width
    Field dwStippleHeight_LINE:Int      'Stipple height
    Field dwSize_TRI:Int               'Size of structure
    Field dwMiscCaps_TRI:Int           'Miscellaneous capabilities
    Field dwRasterCaps_TRI:Int         'Raster capabilities
    Field dwZCmpCaps_TRI:Int           'Z-comparison capabilities
    Field dwSrcBlendCaps_TRI:Int       'Source-blending capabilities
    Field dwDestBlendCaps_TRI:Int      'Destination-blending capa bilities
    Field dwAlphaCmpCaps_TRI:Int       'Alpha-test-comparison capabilities
    Field dwShadeCaps_TRI:Int          'Shading capabilities
    Field dwTextureCaps_TRI:Int        'Texture capabilities
    Field dwTextureFilterCaps_TRI:Int  'Texture-filtering capabilities
    Field dwTextureBlendCaps_TRI:Int   'Texture-blending capabilities
    Field dwTextureAddressCaps_TRI:Int 'Texture-addressing capabilities
    Field dwStippleWidth_TRI:Int       'Stipple width
    Field dwStippleHeight_TRI:Int      'Stipple height
Field      dwDeviceRenderBitDepth:Int
Field      dwDeviceZBufferBitDepth:Int
Field      dwMinTextureWidth:Int
Field     dwMinTextureHeight:Int
Field      dwMaxTextureWidth:Int
Field    dwMaxTextureHeight:Int
Field      dwMaxTextureRepeat:Int
Field      dwMaxTextureAspectRatio:Int
Field      dwMaxAnisotropy:Float
Field      dvGuardBandLeft:Float
Field      dvGuardBandTop:Float
Field      dvGuardBandRight:Float
Field      dvGuardBandBottom:Float
Field      dvExtentsAdjust:Float
Field      dwStencilCaps:Int
Field      dwFVFCaps:Int
Field      dwTextureOpCaps:Int
Field      wMaxTextureBlendStages:Short
Field      wMaxSimultaneousTextures:Short
Field      dwMaxActiveLights:Int
Field      dvMaxVertexW:Float
Field      GUID_Interface_type:Int
Field      GUID_1:Short
Field      GUID_2:Short
Field      GUID_3:Byte
Field      GUID_4:Byte
Field      GUID_5:Byte
Field      GUID_6:Byte
Field      GUID_7:Byte
Field      GUID_8:Byte
Field      GUID_9:Byte
Field      GUID_10:Byte
Field      wMaxUserClipPlanes:Short
Field      wMaxVertexBlendMatrices:Short
Field      dwVertexProcessingCaps:Int
Field      dwReserved1:Int
Field      dwReserved2:Int
Field      dwReserved3:Int
Field      dwReserved4:Int
End Type

Type Tdrag
   Field x%         'object x
   Field y%         'object y
   Field msx%         'mouse x
   Field msy%         'mouse y
   Field Width%      'object width
   Field Height%      'object height
   Field inuse%      'object selected flag
   Field dragging%      'mouse dragging object flag
   Field Oldmx%      ' old mouse x
   Field Oldmy%      ' old mouse y
   Global selected%  ' object selected
'   create a box(square) object

   Function Create:tdrag(x%,y%,Width%,Height%)
      Local box:Tdrag = New Tdrag
      box.x = x
      box.y = y
      box.Width = width
      box.Height = Height
      box.dragging = False
      box.inuse = False
      Return box
   End Function
'   test to see if mouse is width in the box/squre object   
   Method mouseinbox%()
      If msx < Self.x Return False
      If msx > (Self.x+Self.Width) Return False
      If msy < Self.y Return False
      If msy > (Self.y+Self.Height) Return False
      Return True
   End Method
'   move object to new position
   Method shift()
      Self.x :+(msx-oldmx)
      Self.y :+(msy-oldmy)
   End Method
'   check to see if mouse was moved
   Method mousemove%()
      If oldmx <> msx Return True
      If oldmy <> msy Return True
      Return False
   End Method
'   draw Object
   Method getxy(x% Var,y% Var)
      x = Self.x
      y = Self.y
   End Method
   Method getcenter(x% Var,y% Var)
      x = Self.x+width/2
  y = Self.y+height/2
   End Method
' animate box
   Method animate()
      msx = MouseX() 'assign to variable to avoid continuous mouse function calls
      msy = MouseY() '  ''                          ''
      If MouseDown(1)
         
   If dragging = True
            If mousemove()  shift() ' set new position of object
         Else
            If mouseinbox()
If inuse = False
                If selected = False
dragging = True ' find box and allow dragging'
            selected = True
EndIf
  EndIf
  Else
               inuse = True 'prevent any more selection of object/s
            EndIf
         EndIf
      Else
         dragging = False ' if mouse is not pressed stop moving object
         inuse = False ' allow selection of object/s
          selected = False
End If
      oldmx = msx ' store mouse current position for futere use
      oldmy = msy '      ''               ''      ''

   End Method
End Type


Function drawcircle (xC%,yC%,radius%)
If (xC-radius) > GraphicsWidth()  Return 
If (yC-radius) > GraphicsHeight()  Return
If (xC+radius) < 0 Then Return
If (yC+radius) < 0 Then Return
Local x:Int = 0
Local d:Int = (2*Radius)
Local y:Int=Radius
While x<y
If d < 0 Then
d = d + (4 * x) + 6
Else
d = d + 4 * (x - y) + 10
y = y - 1
End If
Plot(xC + X, yC + Y)
Plot(xC + X, yC - Y)
Plot(xC - X, yC + Y)
Plot(xC - X, yC - Y)
Plot(xC + Y, yC + X)
Plot(xC + Y, yC - X)
Plot(xC - Y, yC + X)
Plot(xC - Y, yC - X)
x=x+1
Wend

so far the only problem I have is that the balls slow down even with out any friction or gravity.
the source coude is mostly a straight copy from the flash files so keep in mind that the code is copyright and is limited to the conditions here:
http://www.tonypa.pri.ee/vectors/index.html
other than that you are free to use as you please with this code.
if anybody is interested in some of the original demos( I managed to convert most of them with limitations of mouse control but other than that they are straight copy),I can post them here.

yes, I tried it. I think it is usable for most of my applications. and it speeds up about 15 percent.  I will keep gradiets  in mind.  thanks.

uhhhhh, with my mouth wide open. Ok, those are really nice effects. I am impressed. 

good one Chris.

Thanks StoneMonkey I will look in to it.
the antialias routines are not mine.  I modified them from some sorce code I had from years back. I believe the reason for the tables is that it is using integer math and it is using it to shift the floating point precision left or right(I know, old code).  I have  little knowledge of  color manipulation, although I do understand what you and Jim are explaining. I like the 50/50 blending  and the texture lookup wrap. I will try to implement both of them.

maybe silly question:
how bad would it be to zero out 2 bits for each color in a pixel  for a four pixel look up.such as $00fcfcfc. is it functional? I don't know how much it would affect the quality. I might try it later on, out of curiosity.

well I managed to speed it up some still the weighted function is sloooooow. let me know  what you think

why didn't I think of that? Thanks Jim.
I guess sacrificing a bit more memory fo the sake of speed is a fair tradeoff in this case.

I am half way down the convertion. and now thanks to you I am going to add the pixmap convertion function which shouldn't be too hard.

The reason I am using it like this is to process images from with in memory that are created on the fly. Shure, I can hardware rotate them on the fly. It is one of the qualities of Bmax. but if I want to modify an image on the fly without disturbing video memory, I have to work with pixmaps. if I want to work with prefabricated images I have to accept whatever format is available. so the single format is not an option. but you are right I can separate the different type of format in a single process group each. it will do pretty much what you said. you know, that crossed my mind before but I didn't considered it such a big deal until you mentioned it. so now it's like duh. I will post any modifications to the code as soon as I am done with it. thanks Jim.

@Shockwave, thanks.

@ jim, Thanks.  I have been braking my head trying to get it to move faster but thats the best my limited skills can do. Maybe somebody have a better algorith.  I will keep looking around for a better way. oh, how I wish bmax had built in asm integration.

@spitfire, no it's BlitzMax, it shouldn't be too hard to convert.

@Benny, Thank's

here is a bata of my  pixmap antialias image rotation. it should work with any png image. and if you take away the framework it should work with any png, jpg or bmp. It does both weighted and unwheighted pixel transformation. it works with both alpha and non-alpha images. I don't think it has any bugs but let me know if you find any.
press:
1 for no antialias (normal speed)
2 for unweighted antialias(slow speed)
3 for  weighted antialias ( slowest)

note: make shure it is running in release mode. debug mode can get quite slow.
as always if anybody find a way to speed this up I apreciate the help. and if any body can test it on a mac and let me know if it works(little endian big endian thing) I apreciate it also.

executable included:

Code Select Expand


SuperStrict
Rem
  algoritm:
   0 No antialias
   1 Unweighted antialiasing
   2 Weighted antialiasing
EndRem

' This sets the width of the block where only one pixel is selected
' It should be a multiple of 2
Const BW:Int = 2
Const W4S:Int = (8-BW/2)
Const W2W:Int = (BW)
Const W2H:Int = (8-BW/2)
Const CX1B:Float = (0.5-BW/2)
Const CY1B:Float = (8.5)
Const CX2B:Float = (0.5-BW/2)
Const CY2B:Float = (-7.5)
Const C1X:Float = 8.5
Const C1Y:Float = 8.5
Const C2X:Float =-7.5
Const C2Y:Float = 8.5
Const C3X:Float = 8.5
Const C3Y:Float =-7.5
Const C4X:Float =-7.5
Const C4Y:Float =-7.5

Const PRECISION:Int = 256'

Global clrColour:Int=0
Global algoritm:Int=0
Global BytesPerPixel:Int[] = [0,1,1,3,3,4,4]
Global convTableW4:Byte[W4S*W4S*4]
Global convTableW2:Byte[W2W*W2H*2]

Function putPixel(image:TPixmap, x%, y%, pixel%)

  Local mem:Byte Ptr, bpp:Int
  bpp = BytesPerPixel[image.format]
  mem = image.pixels+y*image.pitch+x*bpp
     
  Select bpp
  Case 1 mem[0] = Byte(pixel)
  Case 2 mem[0] = pixel
  Case 3
    mem[0] = (pixel & $FF)
    mem[1] = (pixel Shr 8) & $FF
    mem[2] = (pixel Shr 16) & $FF
  Case 4 Int Ptr(mem)[0] = pixel '4 Byte/pixel
  End Select

End Function

'** getPixel ***/

Function  getPixel:Int(image:TPixmap, x%, y%)
  Local pixel:Int
  Local mem:Byte Ptr, bpp:Int
  If((x<0) Or (y<0) Or (x>=image.width) Or (y>=image.height)) Return clrColour
  bpp = BytesPerPixel[image.format]
  mem = image.pixels +y*image.pitch+x*bpp
  Select bpp
  Case 1 Return mem[0]
  Case 2 Return mem[0]|(mem[0] Shl 8)
  Case 3 '24 bit pixel
    Local r:Int, g:Int, b:Int
    r = mem[0]
    g = mem[1]
    b = mem[2]
    Return  r  | (g Shl 8) | (b Shl 16)
  Case 4 Return Int Ptr(mem)[0]
  End Select 
End Function


Function mid2:Int(p1%, p2%)

  Local r:Int, g:Int, b:Int,a:Int
  a = (((p1 Shr 24) & $ff)+((p2 Shr 24) & $ff)) Shr 1
  r = (((p1 Shr 16) & $ff)+((p2 Shr 16) & $ff)) Shr 1
  g = (((p1 Shr 8 ) & $ff)+((p2 Shr 8 ) & $ff)) Shr 1
  b = ((p1 & $ff)+(p2 & $ff)) Shr 1
  Return (a Shl 24)|(r Shl 16) | (g Shl 8) | b

End Function

Function mid4:Int(p1%, p2%, p3%, p4%)

  Local  r:Int, g:Int, b:Int,a:Int
  a = ( ((p1 Shr 24)&$ff)+((p2 Shr 24)&$ff)+((p3 Shr 24)&$ff)+((p4 Shr 24)&$ff))Shr 2
  r = ( ((p1 Shr 16)&$ff)+((p2 Shr 16)&$ff)+((p3 Shr 16)&$ff)+((p4 Shr 16)&$ff))Shr 2
  g = ( ((p1 Shr  8)&$ff)+((p2 Shr  8)&$ff)+((p3 Shr 8) &$ff)+((p4 Shr 8 )&$ff))Shr 2
  b = ( (p1 &$ff)+(p2 &$ff)+(p3 &$ff)+(p4 &$ff) )  Shr  2
  Return (a Shl 24)|(r Shl 16)|(g Shl 8)|b

End Function

Function calcPixel:Int(image:TPixmap, xpos%, ypos%)

  Local x%, y%, px%, py%
  Local pixelSelect:Int

  x = xpos Shr 8
  y = ypos Shr 8
  px = xpos Shr 4
  py = ypos Shr 4
  px = px & $f
  py = py & $f

  pixelSelect = 0
  If(px >= 12) pixelSelect :| 4
  If(py >= 12) pixelSelect :| 8
  If(px < 4)   pixelSelect :| 2
  If(py < 4)   pixelSelect :| 1

  Select pixelSelect
  Case 0                   ' Pick one pixel
    Return getPixel(image,x,y)
  Case 1                   ' Weight two pixels, up
    Return mid2(getPixel(image,x,y),getPixel(image,x,y-1))
  Case 2                   ' Weight two pixels, Left
    Return mid2(getPixel(image,x,y), getPixel(image,x-1,y))
  Case 3                   ' Weight four pixels, Upper Left
    Return mid4(getPixel(image,x,y), getPixel(image,x-1,y),getPixel(image,x,y-1),getPixel(image,x-1,y-1))
  Case 4                   ' Weight two pixels, Right
    Return mid2(getPixel(image, x,y),getPixel(image,x+1,y))
  Case 5                   ' Weight four pixels, Upper Right
    Return mid4(getPixel(image,x,y),getPixel(image,x+1,y),getPixel(image,x,y-1),getPixel(image,x+1,y-1))
  Case 8                   ' Weight two pixels, Lower
    Return mid2(getPixel(image,x,y),getPixel(image,x,y+1))
  Case 10                  ' Weight four pixels, Lower Left
    Return mid4(getPixel(image,x,y),getPixel(image,x-1,y),getPixel(image,x,y+1),getPixel(image,x-1,y+1))
  Case 12                  ' Weight four pixels, Lower Right
    Return mid4(getPixel(image,x,y),getPixel(image,x+1,y),getPixel(image,x,y+1),getPixel(image,x+1,y+1))
  End Select


End Function

Function midw2:Int(p1%, p2%, px%, py%)

  Local r:Int, g:Int, b:Int,a:Int
  Local w1:Int, w2:Int

  If(px+py)>(W2W-1+W2H-1) Notify " Out of bounds!"

  w1 = convTableW2[(px+py*W2W) Shl 1]
  w2 = convTableW2[(px+py*W2W) Shl 1+1]
  a = ( ((p1 Shr 24)&$ff)*w1 + ((p2 Shr 24)&$ff)*w2 )  Shr  5
  r = ( ((p1 Shr 16)&$ff)*w1 + ((p2 Shr 16)&$ff)*w2 )  Shr  5
  g = ( ((p1 Shr 8)&$ff )*w1 + ((p2 Shr 8 )&$ff)*w2 )  Shr  5
  b = ( (p1&$ff)*w1 +( p2&$ff)*w2 )  Shr  5
  Return (a Shl 24) | (r Shl 16) | (g Shl 8) | b
End Function

Function midw4:Int(p1%, p2%, p3%, p4%, wx%, wy%)

  Local x:Int
  Local r:Int, g:Int, b:Int,a:Int
  Local w1:Int, w2:Int, w3:Int, w4:Int
  Local convTable2:Int[] = [0,1,2,3,4,5,6,7,7,6,5,4,3,2,1,0]

  wx = convTable2[wx]
  wy = convTable2[wy]

  w1 = convTableW4[(wx+wy*W4S)Shl 2+ 0]
  w2 = convTableW4[(wx+wy*W4S)Shl 2+ 1]
  w3 = convTableW4[(wx+wy*W4S)Shl 2+ 2]
  w4 = convTableW4[(wx+wy*W4S)Shl 2+ 3]
  a = (((p1 Shr 24)&$ff)*w1+((p2 Shr 24)&$ff)*w2+((p3 Shr 24)&$ff)*w3+((p4 Shr 24)&$ff)*w4)Shr  5
  r = (((p1 Shr 16)&$ff)*w1+((p2 Shr 16)&$ff)*w2+((p3 Shr 16)&$ff)*w3+((p4 Shr 16)&$ff)*w4)Shr  5
  g = (((p1 Shr 8)&$ff)*w1+((p2 Shr 8)&$ff)*w2+((p3 Shr 8 )&$ff)*w3+((p4 Shr 8)&$ff)*w4)Shr 5
  b =  ((p1&$ff)*w1+(p2&$ff)*w2+(p3&$ff)*w3+(p4&$ff)*w4 )Shr  5
  Return (r Shl 16) | (g Shl 8) | b
End Function

Function rint:Float(n:Float)
If n<0 Return Floor(n)
If n> 0 Return Ceil(n)
Return n
End Function


Function  calcWeightedPixel:Int(image:TPixmap, xpos%, ypos%)
  Local x%, y%, px%, py%
  Local pixelSelect:Int
  Local p1%, p2%, p3%, p4%

  x = xpos Shr 8
  y = ypos Shr 8
  px = xpos Shr 4
  py = ypos Shr 4
  px = px & $f
  py = py & $f

  pixelSelect = 0
  If(px >= (8+BW/2)) pixelSelect :| 4
  If(py >= (8+BW/2)) pixelSelect :| 8
  If(px < (8-BW/2))  pixelSelect :| 2
  If(py < (8-BW/2))  pixelSelect :| 1

  Select pixelSelect
  Case 0                   ' Pick one pixel
    Return getPixel(image, x, y)
   
  Case 1                   ' Weight two pixels, up
    p1 = getPixel(image, x, y-1)
    p2 = getPixel(image, x, y)
    Return midw2(p1, p2, px-(8-BW/2), py)
   
  Case 2                   ' Weight two pixels, Left
    p1 = getPixel(image, x-1, y)
    p2 = getPixel(image, x, y)
    Return midw2(p1, p2, py-(8-BW/2), px)
   
  Case 3                   ' Weight four pixels, up Left
    p1 = getPixel(image, x-1, y-1)
    p2 = getPixel(image, x, y-1)
    p3 = getPixel(image, x-1, y)
    p4 = getPixel(image, x, y)
    Return midw4(p1, p2, p3, p4, px, py)
   
  Case 4                   ' Weight two pixels, Right
    p1 = getPixel(image, x+1, y)
    p2 = getPixel(image, x, y)
    Return midw2(p1, p2, py-(8-BW/2), 15-px)
   
  Case 5                   ' Weight four pixels, up Right
    p1 = getPixel(image, x+1, y-1)
    p2 = getPixel(image, x, y-1)
    p3 = getPixel(image, x+1, y)
    p4 = getPixel(image, x, y)
    Return midw4(p1, p2, p3, p4, px, py)
  Case 8                   ' Weight two pixels, down
    p1 = getPixel(image, x, y+1)
    p2 = getPixel(image, x, y)
    Return midw2(p1, p2, px-(8-BW/2), 15-py)
   
   
  Case 10                  ' Weight four pixels, down Left
    p1 = getPixel(image, x-1, y+1)
    p2 = getPixel(image, x, y+1)
    p3 = getPixel(image, x-1, y)
    p4 = getPixel(image, x, y)
    Return midw4(p1, p2, p3, p4, px, py)
   
  Case 12                  ' Weight four pixels, down Right
    p1 = getPixel(image, x+1, y+1)
    p2 = getPixel(image, x, y+1)
    p3 = getPixel(image, x+1, y)
    p4 = getPixel(image, x, y)
    Return midw4(p1, p2, p3, p4, px, py)
  End Select
End Function

Function drawRotateImage(image:TPixmap, canvas:TPixmap, v#)

  Local x%, y%
  Local mag% = 1

  '--------- Beginning of rotate routine ------------

  Local sinv:Int, cosv:Int        ' Holds sinus And cosius values
  Local startx:Int, starty:Int    ' Holds start values
  Local zoom:Int,pw:Int,ph:Int
  Local imagePosX:Int, imagePosY:Int
  Local tmpImagePosX:Int, tmpImagePosY:Int
  Local pixelSelect:Int
  Local px:Int, py:Int
 
  Local pixel:Int
  Local src:Byte Ptr, dest:Byte Ptr, srcbpp:Int, destbpp:Int

  zoom = 100

  sinv = rint((Sin(v)*PRECISION))
  cosv = rint((Cos(v)*PRECISION))

  startx = (Image.Width Shr 1)*PRECISION + PRECISION Shr 1
  starty = (Image.Height Shr 1)*PRECISION + PRECISION Shr 1
 
  startx :+ (Canvas.Width Shr 1)*(-cosv) + (Canvas.height Shr 1)*sinv
  starty :- (Canvas.Width Shr 1)* sinv + (Canvas.Height Shr 1)*cosv

  '************** First Field *****************/
 
  '--- Start of Y-loop
  imagePosX = startx
  imagePosY = starty
  pw = Canvas.Width*PRECISION 
  ph = Canvas.Height*PRECISION
  For y=0 Until Canvas.Height Step 2
    ' Make temp copies of image counters For use in x loop
    tmpImagePosX = imagePosX
    tmpImagePosY = imagePosY
    ' Update image pos counter For Next row
    imagePosX = imagePosX - sinv Shl 1
    imagePosY = imagePosY + cosv Shl 1
    '--- Start of X-loop
    For x = 0 Until Canvas.Width
      pixel = clrColour ' Default colour For cleared corners
      If((tmpImagePosX>0) & (tmpImagePosX<(pw)) & (tmpImagePosY>0) & (tmpImagePosY<ph)) 
Select(algoritm)
Case 0 pixel = getPixel(image, tmpImagePosX Shr 8, tmpImagePosY Shr 8)
Case 1 pixel = calcPixel(image, tmpImagePosX, tmpImagePosY)
Case 2 pixel = calcWeightedPixel(image, tmpImagePosX, tmpImagePosY)
End Select
      EndIf
      tmpImagePosX = tmpImagePosX + cosv
      tmpImagePosY = tmpImagePosY + sinv
      putPixel(canvas, x, y, pixel)
    Next
  Next
 

  '************** Second Field *****************/
  imagePosX = startx - sinv
  imagePosY = starty + cosv
  '--- Start of Y-loop
  For y = 0 Until Canvas.Height Step 2
    ' Make temp copies of image counters For use in x loop
    tmpImagePosX = imagePosX
    tmpImagePosY = imagePosY
    ' One Step For odd frames
    imagePosX = imagePosX - sinv Shl 1
    imagePosY = imagePosY + cosv Shl 1
    '--- Start of X-loop
    For x = 0 Until Canvas.Width
      pixel = clrColour ' Default colour For cleared corners
      If((tmpImagePosX>0) & (tmpImagePosX<(pw)) & (tmpImagePosY>0) & (tmpImagePosY<ph))
Select(algoritm)
Case 0 pixel = getPixel(image, tmpImagePosX Shr 8, tmpImagePosY Shr 8)
Case 1 pixel = calcPixel(image, tmpImagePosX, tmpImagePosY)
Case 2 pixel = calcWeightedPixel(image, tmpImagePosX, tmpImagePosY)
End Select
      EndIf
      ' Update temp image pos counter For Next pixel in row
      tmpImagePosX = tmpImagePosX + cosv
      tmpImagePosY = tmpImagePosY + sinv
      putPixel(canvas, x, y+1, pixel)
    Next
  Next
  '------------ End of rotate routine ---------------
End Function

Function invl:Double(l:Double)

  l = 15 - l
  If(l<0) l = 0
  Return l
End Function


Function scalar4:Double(w1:Double, w2:Double, w3:Double, w4:Double)

  Return 32.0/(w1+w2+w3+w4)
End Function

Function scalar2:Double(w1:Double, w2:Double)

  Return 32/(w1+w2)
End Function


Function calcTables()

  Local x:Int, y:Int, i:Int
  Local l1:Double, l2:Double, l3:Double, l4:Double
  Local w1:Int, w2:Int, w3:Int, w4:Int
  Local s:Double
  Local d1:Double, d2:Double, d3:Double, d4:Double
  ' Calc 4-weight table
  For y=0 Until (8-2/2)
    For x=0 Until (8-2/2)
l1=invl(Sqr((C1X+x)*(C1X+x) + (C1Y+y)*(C1Y+y)))
l2=invl(Sqr((C2X+x)*(C2X+x) + (C2Y+y)*(C2Y+y)))
l3=invl(Sqr((C3X+x)*(C3X+x) + (C3Y+y)*(C3Y+y)))
l4=invl(Sqr((C4X+x)*(C4X+x) + (C4Y+y)*(C4Y+y)))
s = scalar4(l1, l2, l3, l4)
w1 = rint(l1*s)
w2 = rint(l2*s)
w3 = rint(l3*s)
w4 = rint(l4*s)
If(w1+w2+w3+w4 <> 32)
d1 = Abs(l1*s-w1)
d2 = Abs(l1*s-w1)
d3 = Abs(l1*s-w1)
d4 = Abs(l1*s-w1)
  If((d1<d2) And (d1<d3) And (d1<d4))
  w1 = w1 + (32-w1-w2-w3-w4)
Else
    If((d2<d3) & (d2<d4))
    w2 = w2 + (32-w1-w2-w3-w4)
    Else
If(d3<d4) w3 = w3 + (32-w1-w2-w3-w4) Else w4 = w4 + (32-w1-w2-w3-w4)
    EndIf
EndIf
EndIf
convTableW4[(x+y*(8-2/2))*4+0] = w1
convTableW4[(x+y*(8-2/2))*4+1] = w2
convTableW4[(x+y*(8-2/2))*4+2] = w3
    convTableW4[(x+y*(8-2/2))*4+3] = w4
    Next
  Next

  ' Calc 2-weight table
  For y = 0 Until (8-BW/2)
    For x=0 Until BW
      l1 = Sqr((CX1B+x)*(CX1B+x) + (CY1B+y)*(CY1B+y))
      l2 = Sqr((CX2B+x)*(CX2B+x) + (CY2B+y)*(CY2B+y))
      l1 = invl(l1)
      l2 = invl(l2)
      s = scalar2(l1, l2)
      w1 = rint(l1*s)
      w2 = rint(l2*s)
      If(w1+w2 <> 32)
If((Abs(l1*s-w1)) < (Abs(l2*s-w2)))
  w1 = w1 + (32-w1-w2)
Else
  w2 = w2 + (32-w1-w2)
EndIf
      EndIf
      convTableW2[(x+y*(2))*2 + 0] = w1
      convTableW2[(x+y*(2))*2 + 1] = w2
    Next
  Next

End Function
Function CreateCanvas:TPixmap(image:TPixmap)

Local D% = Sqr((image.width)^2+(image.height)^2)+1
D = (D Shr 1) Shl 1
Return CreatePixmap(D,D,image.format)

End Function

Global fps:Float, fpst:Float,fpsc:Float

Function CountFPS:Float()
If fpst < MilliSecs() Then
fpst=MilliSecs()+1000
fps = fpsc
fpsc = 0
Else
fpsc = fpsc + 1
End If
Return fps
End Function

Local canvas:TPixmap
Local image:TPixmap
Local v:Float= 0,dv:Float
Local motion:Int=1,update:Int=0
Local getEvent:Int,i:Int,x:Int, y:Int

calcTables()
Graphics 640,480,32
image = LoadPixmap("image.png")
If (image = Null) Notify "Could not load file"
canvas = CreateCanvas(image)
While Not KeyDown(key_escape)
Cls
dv = 0
update = motion
Select True
Case KeyDown(KEY_UP) dv = dv + 01.5; update = 1
Case KeyDown(KEY_DOWN) dv = dv - 01.5; update = 1
Case KeyDown(KEY_LCONTROL) v = 0; dv = 0; update = 1
Case KeyDown(KEY_LEFT) clrColour :- $080808; update = 1
Case KeyDown(KEY_RIGHT) clrColour :+ $080808; update = 1
Case KeyDown(KEY_1)
If(algoritm <>0)
    algoritm = 0
    update = 1
  EndIf
Case KeyDown(KEY_2)
  If(algoritm <>1)
    algoritm = 1
    update = 1
  EndIf
Case KeyDown(KEY_3)
  If(algoritm<>2)
    algoritm = 2
    update = 1
  EndIf
End Select
If((dv <> 0) | (update))
v = v + dv
drawRotateImage(image, canvas, v)
motion = 0
EndIf
   
DrawPixmap canvas,150,100
DrawText ("FPS:"+(Int(CountFPS())),20,0)
DrawText "1: No antialias",20,15
DrawText "2: Unweighted antialiasing",20,30
DrawText "3: Weighted antialiasing", 20 ,45
DrawText "Left/Rigth: arrow canvas color",20,60
DrawText "Up/Down: set Rotation angle",20,75
DrawText "image Width  = "+image.width,300,15
DrawText "image height = "+image.height,300,30
DrawText "canvas width = "+canvas.width,300,45
DrawText "canvas Height= "+canvas.height,300,60

Flip(0)
Wend

 

Hi everybody
I have been spending what ever time I have free to myself(almost none) to learn OGL. I have been going to websites and found some tutorials. To make it more complicated for me to learn, Most of them are in cpp of which I know little of. I have been forced to learn as I go. To make a long story short, I just want to share some of the things I am learning. I can't remember where I got this demo from but I converted it to BMax.  It took me a long time sence there is not much help at Bmax for OGL. if any body have some suggestions on what I can improve or how I can do it better  I would apreciate it.

Code Select Expand


Framework BRL.GLGraphics
Import BRL.EventQueue
Import BRL.PNGLoader

'-----------------------------------------------------------------------------
'           Name: ogl_alpha_blending_texture.cpp
'         Author: Kevin Harris
'  Last Modified: 03/25/05
'    Description: This sample demonstrates how To perform alpha blending using
'                 the alpha channel of a standard .png texture. For proper
'                 alpha blending, the sample uses a cull-mode sorting trick
'                 To ensure the sides of the textured cube get rendered in
'                 back-To-front order.
'
'   Control Keys: b - Toggle blending
'                 s - Toggle usage of cull-mode sorting trick
'                 Up Arrow - Move the test cube closer
'                 Down Arrow - Move the test cube away
'-----------------------------------------------------------------------------
SuperStrict
Const stric% = 1
Const WIN32_LEAN_AND_MEAN% = 1

'
Type Vertex
   Field tu#, tv#;
   Field x#, y#, z#;
End Type
Type point
Field x%,y%
End Type

Global g_bBlending% = True;
Global g_bSortUsingCullModeTrick% = True;
Global ptLastMousePosit:point = New point
Global ptCurrentMousePosit:point = New point
Global bMousing%;
Global oldx%,oldy%
Global g_fDistance# = -4.5;
Global g_fSpinX#    = 0.0;
Global g_fSpinY#    = 0.0;
Global Checkimage:Byte[256,256,4]
Global Texname:Int
Global g_textureID% = -1
Global g_cubeVertices:Float[] = [..
.. ' Front Face
0.0, 0.0, -1.0, -1.0, 1.0,..       ' Bottom Left Of The Texture And Quad
1.0, 0.0,  1.0, -1.0, 1.0,..       ' Bottom Right Of The Texture And Quad
1.0, 1.0,  1.0,  1.0, 1.0,..       ' Top Right Of The Texture And Quad
0.0, 1.0, -1.0,  1.0, 1.0,..       ' Top Left Of The Texture And Quad
.. ' Back Face
1.0, 0.0, -1.0, -1.0, -1.0,..      ' Bottom Right Of The Texture And Quad
1.0, 1.0, -1.0,  1.0, -1.0,..      ' Top Right Of The Texture And Quad
0.0, 1.0,  1.0,  1.0, -1.0,..      ' Top Left Of The Texture And Quad
0.0, 0.0,  1.0, -1.0, -1.0,..      ' Bottom Left Of The Texture And Quad
.. ' Top Face
0.0, 1.0, -1.0,  1.0, -1.0,..      ' Top Left Of The Texture And Quad
0.0, 0.0, -1.0,  1.0,  1.0,..      ' Bottom Left Of The Texture And Quad
1.0, 0.0,  1.0,  1.0,  1.0,..      ' Bottom Right Of The Texture And Quad
1.0, 1.0,  1.0,  1.0, -1.0,..      ' Top Right Of The Texture And Quad
.. ' Bottom Face
1.0, 1.0, -1.0, -1.0, -1.0,..      ' Top Right Of The Texture And Quad
0.0, 1.0,  1.0, -1.0, -1.0,..      ' Top Left Of The Texture And Quad
0.0, 0.0,  1.0, -1.0,  1.0,..      ' Bottom Left Of The Texture And Quad
1.0, 0.0, -1.0, -1.0,  1.0,..      ' Bottom Right Of The Texture And Quad
.. ' Right face
1.0, 0.0,  1.0, -1.0, -1.0,..      ' Bottom Right Of The Texture And Quad
1.0, 1.0,  1.0,  1.0, -1.0,..      ' Top Right Of The Texture And Quad
0.0, 1.0,  1.0,  1.0,  1.0,..      ' Top Left Of The Texture And Quad
0.0, 0.0,  1.0, -1.0,  1.0,..      ' Bottom Left Of The Texture And Quad
.. ' Left Face
0.0, 0.0, -1.0, -1.0, -1.0,..      ' Bottom Left Of The Texture And Quad
1.0, 0.0, -1.0, -1.0,  1.0,..      ' Bottom Right Of The Texture And Quad
1.0, 1.0, -1.0,  1.0,  1.0,..      ' Top Right Of The Texture And Quad
0.0, 1.0, -1.0,  1.0, -1.0]      ' Top Left Of The Texture And Quad

'-----------------------------------------------------------------------------
' PROTOTYPES
'-----------------------------------------------------------------------------
'Int WINAPI WinMain(HINSTANCE hInstance,HINSTANCE hPrevInstance,
'   LPSTR lpCmdLine, Int nCmdShow);
'LRESULT CALLBACK WindowProc(HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam);
'void loadTexture(void);
'void init(void);
'void render(void);
'void shutDown(void);

'-----------------------------------------------------------------------------
' Name: WinMain()
' Desc: The application's entry point
'-----------------------------------------------------------------------------

GLGraphics 800,600
oldx = MouseX()
oldy = MouseY()

init();
Repeat

callback();
render();
GLDrawText("B - blending ",10,1)
GLDrawText("s - cull sorting",10,15)
GLDrawText("up/down arrow - aproach",10,30)
GLDrawText("(esc) to Exit",10,45)
Flip()
Forever 'Until KeyDown(KEY_ESCAPE)

End

'-----------------------------------------------------------------------------
' Name: WindowProc()
' Desc: The window's message handler
'-----------------------------------------------------------------------------
Function CALLBACK%()

   Select True
Case KeyHit(KEY_B)
           g_bBlending = Not g_bBlending;
       Case KeyHit(KEY_S)
           g_bSortUsingCullModeTrick = Not g_bSortUsingCullModeTrick;
       Case KeyDown(KEY_ESCAPE)
End
       Case KeyDown(KEY_UP) ' Up Arrow Key
            g_fDistance :- 0.1;
       Case KeyDown(KEY_DOWN)'  Down Arrow Key
           g_fDistance :+ 0.1;
End Select
Select PollEvent()

       Case EVENT_MOUSEDOWN
ptLastMousePosit.x = ptCurrentMousePosit.x = MouseX()
           ptLastMousePosit.y = ptCurrentMousePosit.y = MouseY()
bMousing = True;
Case EVENT_MOUSEMOVE

ptCurrentMousePosit.x = MouseX()
ptCurrentMousePosit.y = MouseY()

If( bMousing )

g_fSpinX :- (ptCurrentMousePosit.x - ptLastMousePosit.x);
g_fSpinY :- (ptCurrentMousePosit.y - ptLastMousePosit.y);
EndIf

ptLastMousePosit.x = ptCurrentMousePosit.x;
           ptLastMousePosit.y = ptCurrentMousePosit.y;
End Select
If Not MouseDown(1) bMousing = False;

End Function

'-----------------------------------------------------------------------------
' Name: loadTexture()
' Desc:
'-----------------------------------------------------------------------------
Function loadTexture( )
Local PointeurImg:Byte Ptr
Local TexWidth%
Local TexHeight%
Local tex01:TPixmap=LoadPixmap("radiation_box.png")
TexWidth=tex01.Width
TexHeight=tex01.Height
PointeurImg=PixmapPixelPtr(tex01,0,0)
Local pp%=0
For Local y%=TexHeight-1 To 0 Step -1
For Local x%=0 To TexWidth-1
If x> 28 And x< (TexWidth-29) And y > 28 And y<(TexHeight-29)
Checkimage[y,x,0]=PointeurImg[pp]
Checkimage[y,x,1]=PointeurImg[pp+1]
Checkimage[y,x,2]=PointeurImg[pp+2]
Checkimage[y,x,3]=160
Else
Checkimage[y,x,0]=PointeurImg[pp]
Checkimage[y,x,1]=PointeurImg[pp+1]
Checkimage[y,x,2]=PointeurImg[pp+2]
Checkimage[y,x,3]=255
EndIf
pp=pp+3
Next
Next
tex01=Null
glPixelStorei(GL_UNPACK_ALIGNMENT,1)
glGenTextures(1, Varptr Texname)
glBindTexture(GL_TEXTURE_2D, Texname)
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT)
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT)
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST)
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST)
glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, TexWidth, TexHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, Checkimage)
End Function


'-----------------------------------------------------------------------------
' Name: init()
' Desc:
'-----------------------------------------------------------------------------
Function init()
loadTexture();
glClearColor( 0.35, 0.53, 0.7, 1.0 );
glEnable( GL_TEXTURE_2D );
glMatrixMode( GL_PROJECTION );
glLoadIdentity();
gluPerspective( 45.0, 640.0 / 480.0, 0.1, 100.0);
End Function


'-----------------------------------------------------------------------------
' Name: render()
' Desc:
'-----------------------------------------------------------------------------
Function render( )

   glClear( GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT );

   glMatrixMode( GL_MODELVIEW );
   glLoadIdentity();
   glTranslatef( 0.0, 0.0, g_fDistance );
   glRotatef( -g_fSpinY, 1.0, 0.0, 0.0 );
   glRotatef( -g_fSpinX, 0.0, 1.0, 0.0 );

Rem
   
    Transparency sorting For our cube...
   
    If you have a single transparent Object, Or multiple transparent objects
    which do Not overlap in screen space (i.e., each screen pixel is touched
    by at most one of the transparent objects), there's a sorting short-cut
    which can be used under certain conditions.
   
    If your transparent objects are closed, convex, And viewed from the
    outside, culling may be used To draw the back-facing polygons prior To
    the front-facing polygons. This will accomplish the same thing
    as sorting your objects Or polygons into back-To-front order.
    Fortunately For us, our cube is a perfect candidate For this sorting
    trick.
   
    On the other hand, If we can't use the cull-mode sorting trick, we would
    need To sort our objects manually, which would require us To transform
    the geometry into eye-space so we could compare their Final position
    along the z axis. Only Then, could we could render them in the proper
    back-To-front order For alpha blending.
   
    Also, If transparent objects intersect in any way, the individual
    triangles of the objects touching will have To be sorted And drawn
    individually from back-To-front. And is some rare cases, triangles that
    intersect each other may have To be broken into smaller triangles so they
    no longer intersect Or blending artifacts will persist regardless of our
    sorting efforts.
   
    Itââ,¬â,,¢s plain To see, transparency sorting can become a big, hairy mess real quick.
   
    http:www.opengl.org/resources/tutorials/sig99/advanced99/notes/node204.html
   
EndRem
If( g_bBlending = True )

'        
'         Use the texture's alpha channel to blend it with whateverââ,¬â,,¢s already
'         in the frame-buffer.
'        

glDisable( GL_DEPTH_TEST );

       glEnable( GL_BLEND );
       glBlendFunc( GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA );

       glBindTexture( GL_TEXTURE_2D, texname);

      If( g_bSortUsingCullModeTrick = True )
   
'            
'             Use the cull-mode sorting trick For convex non-overlapping
'             geometry.
'            

           glEnable( GL_CULL_FACE );

'            
'             Render the cube but only render the back-facing polygons.
'            

           glCullFace( GL_FRONT );

           glInterleavedArrays( GL_T2F_V3F, 0, g_cubeVertices );
glDrawArrays( GL_QUADS, 0, 24 );

'            
'             Render the cube again, but this time we only render the
'             front-facing polygons.
'            

           glCullFace( GL_BACK );

          glInterleavedArrays( GL_T2F_V3F, 0, g_cubeVertices );
          glDrawArrays( GL_QUADS, 0, 24 );

          glDisable( GL_CULL_FACE );
     
       Else
'        
'            
'             Do no sorting And hope For the best. From certain viewing
'             positions the cube's sides will appear sorted correctly, but this
'             is typically rare And the cube will Not look Right most of the
'             time.
'            

           glInterleavedArrays( GL_T2F_V3F, 0, g_cubeVertices );
           glDrawArrays( GL_QUADS, 0, 24 );
       EndIf'
'
Else
'
'        
'         Render the cube, but do no blending...
'        

glDisable( GL_BLEND );
glEnable( GL_DEPTH_TEST );

       glBindTexture( GL_TEXTURE_2D, Texname);
       glInterleavedArrays( GL_T2F_V3F, 0, g_cubeVertices );
       glDrawArrays( GL_QUADS, 0, 24 );
EndIf

End Function



<edit>
forgot:
hold left mouse button down and move  mouse to rotate cube.

executable included.

I been trying to figure this thing out. I think is that it expect the model to have a texture included. and it doesn't compensate for not having one thus giving an error. I remarked all of the lines that have anything to do with texture output and modified a couple of lines that have to do with texture to bypass if no texture is present and it seems to work. I really don't know if that is how it supposed to work sence this is the first time I do anything threed with ogl and 3ds. here is the code

Code Select Expand



Strict
Global ScreenW=800,screenH=600
Global wireframe

init()

'    ------------------------------------------------------------------------------
'    Type Vertex, contient les positions des vertices.
'    ------------------------------------------------------------------------------
Type Vertex
    Field x:Float,y:Float,z:Float
   
    Method constructor(vx:Float,vy:Float,vz:Float)'assigne des coordonnees a un vertex cree
        x=vx; y=vy; z=vz
    End Method
End Type

'    ------------------------------------------------------------------------------
'    Type Polygone, contient les informations sur le vertices des ploygones(classe par ID)
'    ------------------------------------------------------------------------------
Type Polygone
    Field v1,v2,v3
    Field flag
    Field id_mat
   
    Method constructor(a,b,c)'assigne les vertices au polygone
        v1=a; v2=b; v3=c
    End Method
End Type

'    ------------------------------------------------------------------------------
'    Type MapCoord Contient les coordonnees des textures sur les polygones
'    ------------------------------------------------------------------------------
Type MapCoord
    Field u:Float,v:Float
   
    Method constructor(mu:Float,mv:Float)
        u=mu; v=mv
    End Method
End Type

'    ------------------------------------------------------------------------------
'    Type Objet Contient les polygones des sous objets d une scene
'    ------------------------------------------------------------------------------
Type Objet
    Field nom:String
    Field nombre_vertices,nombre_polygones,nombre_coordonnees
    Field n_vertex,n_polygone,n_mapCoord
    Field v:vertex[]
    Field p:polygone[]
    Field m:mapCoord[]
    Global texture:Int[],texture_name:String[],texture_path:String[],n_texture
   
    Method resizeV()
        v=v[..nombre_vertices]
    End Method
    Method resizeP()
        p=p[..nombre_polygones]
    End Method
    Method resizeM()
        m=m[..nombre_coordonnees]
    End Method
    Method assignTexture(tex,pathfile:String,texname:String)
        texture=texture[..n_texture+1] '????Comprend pas array out of bound
        texture_name=texture_name[..n_texture+1]
        texture_path=texture_path[..n_texture+1]
        DebugLog "n_texture "+n_texture
       
texture_path[n_texture]=pathfile
        texture[n_texture]=tex
        texture_name[n_texture]=texname
        n_texture :+1
        Return n_texture-1
    End Method
    Method initTextureArray()
        texture=texture[..n_texture] '????Comprend pas array out of bound
        texture_name=texture_name[..n_texture]
        texture_path=texture_path[..n_texture]
    End Method
   
    Method NewVertex(vx:Float,vy:Float,vz:Float)
        'DebugLog n_vertex+"-"+vx+" "+vy+" "+vz
        v[n_vertex]=New vertex
        v[n_vertex].x=vx;v[n_vertex].y=vy;v[n_vertex].z=vz
        n_vertex:+1
    End Method
   
    Method newPolygon(a,b,c,flag:Short=0)
        'DebugLog n_polygone+"-"+a+" "+b+" "+c
        p[n_polygone]=New polygone
        p[n_polygone].v1=a;p[n_polygone].v2=b;p[n_polygone].v3=c
        p[n_polygone].flag=flag
        n_polygone:+1
    End Method
   
    Method newMapCoord(u:Float,v:Float)
        'DebugLog n_mapCoord+"-"+u+" "+v
        m[n_mapCoord]=New mapCoord
        m[n_mapCoord].u=u;m[n_mapCoord].v=v
        n_mapCoord:+1
    End Method
   
    Method draw()
        Local l
        'DebugLog texture
       
        Print nombre_polygones-1
        For l=0 To nombre_polygones-1

            'glColor3f Rnd(1),Rnd(1),Rnd(1)
            If n_texture glBindTexture (GL_TEXTURE_2D,texture[p[l].id_mat])
            'DebugLog p[l].id_mat
            glBegin GL_TRIANGLES
            'glTexCoord2f m[p[l].v1].u,m[p[l].v1].v
            glVertex3f v[p[l].v1].x, v[p[l].v1].y, v[p[l].v1].z
            'glTexCoord2f m[p[l].v2].u,m[p[l].v2].v
            glVertex3f v[p[l].v2].x, v[p[l].v2].y, v[p[l].v2].z
            'glTexCoord2f m[p[l].v3].u,m[p[l].v3].v
            glVertex3f v[p[l].v3].x, v[p[l].v3].y, v[p[l].v3].z
            glEnd
        Next
       
    End Method
   
    Method LoadTexture(filePath:String,texname:String,filter=2)
        Local img:TPixmap
        Local texture
        filepath=Lower$(filepath)
        If Right$(filepath,3)="png"
            img=LoadPixmapPNG(filePath)
            texture=GLTexFromPixmap(img,True)
        ElseIf Right$(filepath,3)="jpg"
            img=LoadPixmap(filePath)
            texture=GLTexFromPixmap(img,True)
        EndIf   
        If img=Null Or texture=Null Return 0
        glBindTexture (GL_TEXTURE_2D,texture)
        If filter=0
            glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_LINEAR)
            glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_LINEAR)
        ElseIf filter=1
            glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_NEAREST)
            glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_NEAREST)
        ElseIf filter=2   
            glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_LINEAR)
            glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_LINEAR_MIPMAP_NEAREST)
        EndIf
        Return assignTexture(texture,filepath,texname)
       
    End Method
   
End Type

'    ------------------------------------------------------------------------------
'    Type Scene Contient les textures et les sous objets de .. ..
'    ------------------------------------------------------------------------------
Type Scene
    Field path:String
    Field directory:String
    Field o:Objet[],nombre_objets=-1
    Field listObjet:TList,obj:objet
    Field size
   
    Method New()
        If listObjet=Null Then listObjet=New TList
    End Method
   
    Method resizeO()
        nombre_objets:+1
        o=o[..nombre_objets]
    End Method
   
    Method load3ds(file:String)
       
        Local stream:TStream,id_noeud:String,taille_noeud,b:Byte,l,newobj:Objet,texture_name:String
        stream=ReadStream(file)
        If stream=Null Then Return 0
        size=FileSize(file)
        DebugLog "Open "+file+" | Size:"+size
       
        Local char:String
        Repeat
            l:+1
            char=Mid$(file,Len(file)-l,1)
        Until char="/"
        directory=Left$(file,Len(file)-l)
        Print "Directory="+directory
       
        While Not Eof(stream)
            id_noeud=Right$(Upper$(Hex$(ReadShort(stream))),4)
            taille_noeud=ReadInt(stream)
           
            DebugLog "Id="+id_noeud+"  taille="+taille_noeud
           
            Select id_noeud
                Case "4D4D" 'Noeud Principal
                'Case "0002" 'Version
                    'version=readint(stream)
                Case "3D3D" 'Editeur
                Case "4000" 'nom de l objet
                    resizeO()
                    newobj=New objet
                    listObjet.AddLast newobj
                    DebugLog "Nouvel objet "+nombre_objets
                    Repeat '???????????????????? peut etre limite a 20 char?
                        b=ReadByte(stream)   
                        If b=0 Exit
                        newobj.nom:+Chr(b)                       
                    Until b = 0
                    DebugLog "Nom ="+newobj.nom
                Case "4100" 'regroupe les donnees/positions des points, faces
                Case "4110" 'liste des vertices   
                    newobj.nombre_vertices=ReadShort(stream)
                    newobj.resizeV()
                    DebugLog "    Vertices:"+newobj.nombre_vertices
                    For l = 0 To newobj.nombre_vertices-1
                        newobj.newVertex(ReadFloat(stream),ReadFloat(stream),ReadFloat(stream))
                    Next
                Case "4120"
                    Local a,b,c
                    newobj.nombre_polygones=ReadShort(stream)
                    newobj.resizeP()
                    DebugLog "    Polygones:"+newobj.nombre_polygones
                    For l=0 To newobj.nombre_polygones-1
                        newobj.newPolygon(ReadShort(stream),ReadShort(stream),ReadShort(stream))
                        ReadShort(stream)
                    Next
                Case "4130"
                    newobj.initTextureArray()
                    Local mat_name:String="",id_mat,face_n,id_poly
                    Repeat
                        b=ReadByte(stream)
                        If b=0 Exit
                        mat_name:+Chr(b)
                    Until b=0
                    DebugLog "Assign "+mat_name +" as material. "+newobj.n_texture
                    If newobj.n_texture
For l= 0 To newobj.n_texture 'donne l id du materiel en echange de son nom '(pour l utiliser dans les arrays)
                        If mat_name=newobj.texture_name[l]
                            id_mat=l
                            Exit
                        EndIf
                    Next
EndIf
                    face_n=ReadShort(stream)
                    DebugLog "N FACE TO TEX TO "+mat_name+":"+face_n
                    For l=0 To face_n-1
                        id_poly=ReadShort(stream)
                        newobj.p[id_poly].id_mat=id_mat
                        'DebugLog "="newobj.p[id_poly].id_mat
                    Next
                Case "4140"
                    newobj.nombre_Coordonnees=ReadShort(stream)
                    newobj.resizeM()
                    DebugLog "    MapCoord"+newobj.nombre_Coordonnees
                    For l=0 To newobj.nombre_Coordonnees-1
                        newobj.newMapCoord(ReadFloat(stream),ReadFloat(stream))
                    Next                   
               
                Case "AFFF" 'textures
                   
                    Case "A000"
                        texture_name=""
                        Repeat
                            b=ReadByte(stream)
                            If b=0 Exit
                            texture_name:+Chr(b)
                        Until b=0
                        DebugLog "Nom Texture:"+texture_name
                    Case "A200"'le fichier contient une texture
                        newobj=New objet
                    Case "A300"
                        Local texture_path:String
                        Repeat
                            b=ReadByte(stream)
                            If b=0 Exit
                            texture_path:+Chr(b)
                        Until b=0
                        DebugLog "Path to  Texture:"+texture_path
                        newobj.loadtexture(directory+texture_path,texture_name)
                   
                   
                Default
                    SeekStream(stream,StreamPos(stream)-6+taille_noeud)
            End Select
        Wend
        CloseStream stream
        DebugLog "*** Fichier Ferme ***"
    End Method
   
    Method draw()
        For obj=EachIn ListObjet
            obj.draw()
        Next
    End Method
End Type

Function init()
    GLGraphics ScreenW,ScreenH
    glEnable GL_TEXTURE_2D
    glShadeModel(GL_SMOOTH)
    glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST)
    glEnable GL_DEPTH_TEST
    glMatrixMode GL_PROJECTION
    glLoadIdentity()
    glFrustum -0.1, 0.1,-0.1, 0.1, 0.5, 10000.0
    glMatrixMode GL_MODELVIEW
    glLoadIdentity()
End Function

Function key()
    If KeyHit(KEY_F1)
        If wireframe=0
            wireframe=1
            glPolygonMode (GL_FRONT_AND_BACK,GL_POINT ) 'dessinne les poly comme des points
            'le 1er parametre peut etre GL_FRONT ou GL_BACK aussi
        ElseIf wireframe=1
            wireframe=2
            glPolygonMode (GL_FRONT_AND_BACK,GL_LINE ) 'comme des ligne (wireframe)
        ElseIf wireframe=2
            wireframe=0
            glPolygonMode (GL_FRONT_AND_BACK, GL_FILL ) 'dessinne les poly remplits
        EndIf
       
    EndIf
End Function


Local s:scene=New scene
s.load3ds("news/teapot.3ds")
Local r:Float

While Not KeyHit(KEY_ESCAPE)
    key()
    glClear GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT 'nettoye les buffer(tampon) de couleur et de profondeur
    glLoadIdentity
    'gluLookAt(0,0,-500,    0,0,5,     0, 1, 0);
    glTranslatef 0,0,-200
    r:+.1
    If r>360 r:-360
    glRotatef r,1,.5,0
   
    s.draw()
   
Flip()
Wend



I think there is something wrong with the code itself I. I started testing it and found out that you have to put the 3ds file in a subfolder then access it with a "foldername\file name". then I get an error while reading the file. and sence I don't know how 3ds files are stored, I am stuck.   

I am trying also to learn OGL through bmax and I am finding it hard to learn it due to the lack of users interest I guess. I posted a few questions
but never got an answer. any way on the code above some of the ogl commands there were modified to a more standardized format. Mostly all that start with Bgl...   are now just Gl some commands were ommitted and some were merged with the standard blitzmax commands. I don't know if I fixed it correctly sence I don't have any 3ds files but it runs with out any errors in my pc. I hope it works fine.

Code Select Expand


Strict
Global ScreenW=800,screenH=600
Global wireframe

init()

'    ------------------------------------------------------------------------------
'    Type Vertex, contient les positions des vertices.
'    ------------------------------------------------------------------------------
Type Vertex
    Field x:Float,y:Float,z:Float
   
    Method constructor(vx:Float,vy:Float,vz:Float)'assigne des coordonnees a un vertex cree
        x=vx; y=vy; z=vz
    End Method
End Type

'    ------------------------------------------------------------------------------
'    Type Polygone, contient les informations sur le vertices des ploygones(classe par ID)
'    ------------------------------------------------------------------------------
Type Polygone
    Field v1,v2,v3
    Field flag
    Field id_mat
   
    Method constructor(a,b,c)'assigne les vertices au polygone
        v1=a; v2=b; v3=c
    End Method
End Type

'    ------------------------------------------------------------------------------
'    Type MapCoord Contient les coordonnees des textures sur les polygones
'    ------------------------------------------------------------------------------
Type MapCoord
    Field u:Float,v:Float
   
    Method constructor(mu:Float,mv:Float)
        u=mu; v=mv
    End Method
End Type

'    ------------------------------------------------------------------------------
'    Type Objet Contient les polygones des sous objets d une scene
'    ------------------------------------------------------------------------------
Type Objet
    Field nom:String
    Field nombre_vertices,nombre_polygones,nombre_coordonnees
    Field n_vertex,n_polygone,n_mapCoord
    Field v:vertex[]
    Field p:polygone[]
    Field m:mapCoord[]
    Global texture:Int[],texture_name:String[],texture_path:String[],n_texture
   
    Method resizeV()
        v=v[..nombre_vertices]
    End Method
    Method resizeP()
        p=p[..nombre_polygones]
    End Method
    Method resizeM()
        m=m[..nombre_coordonnees]
    End Method
    Method assignTexture(tex,pathfile:String,texname:String)
        texture=texture[..n_texture+1] '????Comprend pas array out of bound
        texture_name=texture_name[..n_texture+1]
        texture_path=texture_path[..n_texture+1]
        DebugLog n_texture
        texture_path[n_texture]=pathfile
        texture[n_texture]=tex
        texture_name[n_texture]=texname
        n_texture :+1
        Return n_texture-1
    End Method
    Method initTextureArray()
        texture=texture[..n_texture] '????Comprend pas array out of bound
        texture_name=texture_name[..n_texture]
        texture_path=texture_path[..n_texture]
    End Method
   
    Method NewVertex(vx:Float,vy:Float,vz:Float)
        'DebugLog n_vertex+"-"+vx+" "+vy+" "+vz
        v[n_vertex]=New vertex
        v[n_vertex].x=vx;v[n_vertex].y=vy;v[n_vertex].z=vz
        n_vertex:+1
    End Method
   
    Method newPolygon(a,b,c,flag:Short=0)
        'DebugLog n_polygone+"-"+a+" "+b+" "+c
        p[n_polygone]=New polygone
        p[n_polygone].v1=a;p[n_polygone].v2=b;p[n_polygone].v3=c
        p[n_polygone].flag=flag
        n_polygone:+1
    End Method
   
    Method newMapCoord(u:Float,v:Float)
        'DebugLog n_mapCoord+"-"+u+" "+v
        m[n_mapCoord]=New mapCoord
        m[n_mapCoord].u=u;m[n_mapCoord].v=v
        n_mapCoord:+1
    End Method
   
    Method draw()
        Local l
        'DebugLog texture
       
       
        For l=0 To nombre_polygones-1
            'glColor3f Rnd(1),Rnd(1),Rnd(1)
            glBindTexture (GL_TEXTURE_2D,texture[p[l].id_mat])
            'DebugLog p[l].id_mat
            glBegin GL_TRIANGLES
            glTexCoord2f m[p[l].v1].u,m[p[l].v1].v
            glVertex3f v[p[l].v1].x, v[p[l].v1].y, v[p[l].v1].z
            glTexCoord2f m[p[l].v2].u,m[p[l].v2].v
            glVertex3f v[p[l].v2].x, v[p[l].v2].y, v[p[l].v2].z
            glTexCoord2f m[p[l].v3].u,m[p[l].v3].v
            glVertex3f v[p[l].v3].x, v[p[l].v3].y, v[p[l].v3].z
            glEnd
        Next
       
    End Method
   
    Method LoadTexture(filePath:String,texname:String,filter=2)
        Local img:TPixmap
        Local texture
        filepath=Lower$(filepath)
        If Right$(filepath,3)="png"
            img=LoadPixmapPNG(filePath)
            texture=GLTexFromPixmap(img,True)
        ElseIf Right$(filepath,3)="jpg"
            img=LoadPixmap(filePath)
            texture=GLTexFromPixmap(img,True)
        EndIf   
        If img=Null Or texture=Null Return 0
        glBindTexture (GL_TEXTURE_2D,texture)
        If filter=0
            glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_LINEAR)
            glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_LINEAR)
        ElseIf filter=1
            glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_NEAREST)
            glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_NEAREST)
        ElseIf filter=2   
            glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_LINEAR)
            glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_LINEAR_MIPMAP_NEAREST)
        EndIf
        Return assignTexture(texture,filepath,texname)
       
    End Method
   
End Type

'    ------------------------------------------------------------------------------
'    Type Scene Contient les textures et les sous objets de .. ..
'    ------------------------------------------------------------------------------
Type Scene
    Field path:String
    Field directory:String
    Field o:Objet[],nombre_objets=-1
    Field listObjet:TList,obj:objet
    Field size
   
    Method New()
        If listObjet=Null Then listObjet=New TList
    End Method
   
    Method resizeO()
        nombre_objets:+1
        o=o[..nombre_objets]
    End Method
   
    Method load3ds(file:String)
       
        Local stream:TStream,id_noeud:String,taille_noeud,b:Byte,l,newobj:Objet,texture_name:String
        stream=ReadStream(file)
        If stream=Null Then Return 0
        size=FileSize(file)
        DebugLog "Open "+file+" | Size:"+size
       
        Local char:String
        Repeat
            l:+1
            char=Mid$(file,Len(file)-l,1)
        Until char="/"
        directory=Left$(file,Len(file)-l)
        Print "Directory="+directory
       
        While Not Eof(stream)
            id_noeud=Right$(Upper$(Hex$(ReadShort(stream))),4)
            taille_noeud=ReadInt(stream)
           
            DebugLog "Id="+id_noeud+"  taille="+taille_noeud
           
            Select id_noeud
                Case "4D4D" 'Noeud Principal
                'Case "0002" 'Version
                    'version=readint(stream)
                Case "3D3D" 'Editeur
                Case "4000" 'nom de l objet
                    resizeO()
                    newobj=New objet
                    listObjet.AddLast newobj
                    DebugLog "Nouvel objet "+nombre_objets
                    Repeat '???????????????????? peut etre limite a 20 char?
                        b=ReadByte(stream)   
                        If b=0 Exit
                        newobj.nom:+Chr(b)                       
                    Until b = 0
                    DebugLog "Nom ="+newobj.nom
                Case "4100" 'regroupe les donnees/positions des points, faces
                Case "4110" 'liste des vertices   
                    newobj.nombre_vertices=ReadShort(stream)
                    newobj.resizeV()
                    DebugLog "    Vertices:"+newobj.nombre_vertices
                    For l = 0 To newobj.nombre_vertices-1
                        newobj.newVertex(ReadFloat(stream),ReadFloat(stream),ReadFloat(stream))
                    Next
                Case "4120"
                    Local a,b,c
                    newobj.nombre_polygones=ReadShort(stream)
                    newobj.resizeP()
                    DebugLog "    Polygones:"+newobj.nombre_polygones
                    For l=0 To newobj.nombre_polygones-1
                        newobj.newPolygon(ReadShort(stream),ReadShort(stream),ReadShort(stream))
                        ReadShort(stream)
                    Next
                Case "4130"
                    newobj.initTextureArray()
                    Local mat_name:String="",id_mat,face_n,id_poly
                    Repeat
                        b=ReadByte(stream)
                        If b=0 Exit
                        mat_name:+Chr(b)
                    Until b=0
                   
                    DebugLog "Assign "+mat_name +" as material. "+newobj.n_texture
                    For l= 0 To newobj.n_texture 'donne l id du materiel en echange de son nom
                                            '(pour l utiliser dans les arrays)
                        If mat_name=newobj.texture_name[l]
                            id_mat=l
                            Exit
                        EndIf
                    Next
                    face_n=ReadShort(stream)
                    DebugLog "N FACE TO TEX TO "+mat_name+":"+face_n
                    For l=0 To face_n-1
                        id_poly=ReadShort(stream)
                        newobj.p[id_poly].id_mat=id_mat
                        'DebugLog "="newobj.p[id_poly].id_mat
                    Next
                Case "4140"
                    newobj.nombre_Coordonnees=ReadShort(stream)
                    newobj.resizeM()
                    DebugLog "    MapCoord"+newobj.nombre_Coordonnees
                    For l=0 To newobj.nombre_Coordonnees-1
                        newobj.newMapCoord(ReadFloat(stream),ReadFloat(stream))
                    Next                   
               
                Case "AFFF" 'textures
                   
                    Case "A000"
                        texture_name=""
                        Repeat
                            b=ReadByte(stream)
                            If b=0 Exit
                            texture_name:+Chr(b)
                        Until b=0
                        DebugLog "Nom Texture:"+texture_name
                    Case "A200"'le fichier contient une texture
                        newobj=New objet
                    Case "A300"
                        Local texture_path:String
                        Repeat
                            b=ReadByte(stream)
                            If b=0 Exit
                            texture_path:+Chr(b)
                        Until b=0
                        DebugLog "Path to  Texture:"+texture_path
                        newobj.loadtexture(directory+texture_path,texture_name)
                   
                   
                Default
                    SeekStream(stream,StreamPos(stream)-6+taille_noeud)
            End Select
        Wend
        CloseStream stream
        DebugLog "*** Fichier Ferme ***"
    End Method
   
    Method draw()
        For obj=EachIn ListObjet
            obj.draw()
        Next
    End Method
End Type

Function init()
    GLGraphics ScreenW,ScreenH
    glEnable GL_TEXTURE_2D
    glShadeModel(GL_SMOOTH)
    glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST)
    glEnable GL_DEPTH_TEST
    glMatrixMode GL_PROJECTION
    glLoadIdentity()
    glFrustum -0.1, 0.1,-0.1, 0.1, 0.1, 10000.0
    glMatrixMode GL_MODELVIEW
    glLoadIdentity()
End Function

Function key()
    If KeyHit(KEY_F1)
        If wireframe=0
            wireframe=1
            glPolygonMode (GL_FRONT_AND_BACK,GL_POINT ) 'dessinne les poly comme des points
            'le 1er parametre peut etre GL_FRONT ou GL_BACK aussi
        ElseIf wireframe=1
            wireframe=2
            glPolygonMode (GL_FRONT_AND_BACK,GL_LINE ) 'comme des ligne (wireframe)
        ElseIf wireframe=2
            wireframe=0
            glPolygonMode (GL_FRONT_AND_BACK, GL_FILL ) 'dessinne les poly remplits
        EndIf
       
    EndIf
End Function


Local s:scene=New scene
s.load3ds("obj/essai2tex.3ds")

Local r:Float

While Not KeyHit(KEY_ESCAPE)
    key()
    glClear GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT 'nettoye les buffer(tampon) de couleur et de profondeur
    glLoadIdentity
    'gluLookAt(0,0,-500,    0,0,5,     0, 1, 0);
    glTranslatef 0,0,-200
    r:+.1
    If r>360 r:-360
    glRotatef r,1,.5,0
   
    s.draw()
Flip()
Wend


Thanks Benny.

Thank you shockwave.

here is a demo of a lense effect I downloaded years back from a blitzbasic website. I converted it to blitzmax. and modified from plotting to the screen to drawing  to a pixmap which made it a lot faster. hope somebody likes it.

Code Select Expand


Framework BRL.D3D7Max2D
Import BRL.Math
Import BRL.Pixmap
Import BRL.PNGLoader

' modules which may be required:
' Import BRL.BMPLoader
' Import BRL.TGALoader
' Import BRL.JPGLoader


SetGraphicsDriver D3D7Max2DDriver()

'**************************************
'*            LENS EFFECT             *
'*              OS 2000               *
'*     Credits To : maLi/FiNESSE      *
'*    For the lens effect routine     *
'*                                    *
'*  I don't know HOW this routine     *
'*  works but it works ! '-)          *
'*                                    *
'**************************************

Global mx,my
Global d=300 'Change this value To increase/decrease size of lens (Max 100 on my P300 !)
Global r=Int(d/2)
Global m=20 'Change this value To increase/decrease magnification factor
Global s#=Sqr(r*r-m*m)
Global sphere:TPixmap
Global tfm[d*d*2]
Global org[d*d*2]
Global mouseon% = True

Graphics 1024,768,32

Lense()

Global backpicture:TPixmap = LoadPixmap("forlense.png")
Global pixformat% = PixmapFormat(backpicture)
sphere = CreatePixmap(d,d,pixformat)

Global nx% = 1
Global ny% = 1
HideMouse()
Repeat
Cls
DrawPixmap backpicture,0,0
If mouseon
mx = MouseX()
my = MouseY()
If mx => 1024-d Then mx = 1024-d
If my >=  768-d Then my = 768-d
Else
mx:+nx*8
my:+ny*8
If mx => 1024-(d+8) And nx = 1 Then nx = -nx
If mx =< 0 And nx = -1 Then nx=-nx
If my >= 768-(d+8) And ny = 1 Then ny = -ny
If my =< 0 And ny = -1 Then ny=-ny
EndIf
CopyOrg()
draw()
Flip(0)
Until KeyHit(key_escape)
End



'***************************************
'*       Precalculate lens           *
'***************************************

Function Lense()
Local x,y,a,b,z
For y=-r To -r+(d-1)
For x=-r To r+(d-1)
If (x*x+y*y)>=(s*s)
a=x
b=y
Else
z=Sqr(r*r-x*x-y*y)
a=Int(x*m/z+.8)
b=Int(y*m/z+.8)
EndIf
tfm(1+(y+r)*d+(x+r))=(b+r)*d+(a+r)
Next
Next
End Function


'***************************************
'* Copy original pixel color To array  *
'***************************************

Function CopyOrg()
Local x=0,i,j
For i=MX To (MX+d)-1
For j=MY To (MY+d)-1
org[x] = ReadPixel(backpicture,i,j)
x=x+1
Next
Next
End Function

'***************************************
'*      magnify to screen              *
'***************************************

Function draw()
x=1
For i=0 To d-1
For j=0 To d-1
WritePixel(sphere,i,j,org[tfm[x]])
x=x+1
Next
Next
DrawPixmap(sphere,mx,my)
End Function


I just found out Thre is a Bug in the code Thats Also why it behaves so erregular.  But Sence it looks good that way, I am not going to fix it...
now I can continue on improving it when I am completely done with it I will post the complete code.

Thanks Tetra & Jim for your interest in helping.

JP