While the old Circles is still there, it has probably done it's dash. So why not post your silly code here. Squares, but probably still going to go in circles.I miss the old circles topic for posting silly code.
Squares
Squares
dodicat wrote in; http://www.freebasic.net/forum/viewtopi ... 755#141755
-
- Posts: 2655
- Joined: Aug 28, 2008 10:54
- Location: new york
Sweet. I have just the doodle to kick off the new thread. I have to put it together first.
@Dodicat
I tried to compile your doodle from the other thread, but it hung on me and displayed a blue screen. What's up with that?
@Richard
I guess a circle is made from three squares.
@Bfuller
Good to see you back!
@Dodicat
I tried to compile your doodle from the other thread, but it hung on me and displayed a blue screen. What's up with that?
@Richard
I guess a circle is made from three squares.
@Bfuller
Good to see you back!
-
- Posts: 2655
- Joined: Aug 28, 2008 10:54
- Location: new york
HAHAHAHA!
http://uncyclopedia.wikia.com/wiki/Bertrand_RussellThe historical battle known as Russell-Gödel war happened sometime during 12 AD, and even though Wittgenstein played an important role, his actions in the battle were not recorded. The summary of the battle was recorded on IRC and is briefly mentioned below:
Hi Rollie~rolliebollocks wrote:Sweet. I have just the doodle to kick off the new thread. I have to put it together first.
@Dodicat
I tried to compile your doodle from the other thread, but it hung on me and displayed a blue screen. What's up with that?
your quote about Dodicat's computer:
16 FPS!?! Pentium 3???
I'm surprised it's still running. That was right about the time they started making computers real cheap, disposable, so that they would die in 3 years. My 8088 outlasted my first Pentium (which I think was right before Pentium 3).
End of your quote.
I see your latest machine is a real topper, blue screen? well it's a start.
You'll have to be kind to your super duper processor and just use
screenres xres-border,yres-border,32
and skip the fbgfx flags.
An old fiddle plays a sweet tune.
-
- Posts: 2655
- Joined: Aug 28, 2008 10:54
- Location: new york
Hey guys. Here is an attempt at a volumetric image. I need a voxel type. And I also need to figure out how to plot the surface only w/o a zsort.
Code: Select all
#include once "fbgfx.bi"
Dim Shared As Integer screen_x = 800
Dim Shared As Integer screen_y = 600
Dim Shared As Integer center_x = 400
Dim Shared As Integer center_y = 300
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'FB IMAGE Buffer stuff
#Define ReturnPixData( _img ) ( Cast( Ubyte Ptr, _img ) + Sizeof( FB.IMAGE ) )
Declare Function GetPixelColor ( _img As fb.image Ptr, _x As Integer, _y As Integer ) As Uinteger
Declare Sub SetPixelColor ( _img As fb.image Ptr, _x As Integer, _y As Integer, _color As Uinteger )
#define RND_UBYTE Int(Rnd * 256)
#define RNDRGB rgb(RND_UBYTE, RND_UBYTE, RND_UBYTE)
#DEFINE RNDRGBA rgba( RND_UBYTE, RND_UBYTE, RND_UBYTE, RND_UBYTE )
Function GetPixelColor ( _img As fb.image Ptr, _x As Integer, _y As Integer ) As Uinteger
Return Cast( Uinteger Ptr, ReturnPixData( _img ) + ( _y * _img->Pitch ) )[ _x ]
End Function
Sub SetPixelColor ( _img As fb.image Ptr, _x As Integer, _y As Integer, _color As Uinteger )
Cast (Uinteger Ptr, ReturnPixData ( _img ) + ( _y * _img->Pitch ))[ _x ] = _color
End Sub
'3d Point
Type point3d
As single x,y,z
declare Constructor ()
declare Constructor ( rhs as point3d )
declare Operator Let ( rhs as point3d )
End Type
Constructor point3d ()
this.x = 0
this.y = 0
this.z = 0
end Constructor
Constructor point3d ( rhs as point3d )
this.x = rhs.x
this.y = rhs.y
this.z = rhs.z
end Constructor
Operator point3d.Let ( rhs as point3d )
this.x = rhs.x
this.y = rhs.y
this.z = rhs.z
end Operator
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Zooming Image type (supports 3d scaling)
Type zImage
As point3d location
As Integer height
As Integer Width
As Integer nPixels ' !!!
As uinteger Ptr pixdata
Declare Constructor ()
Declare Constructor ( rhs As zImage )
Declare Constructor ( rhs As fb.image Ptr )
Declare Operator Let ( rhs As zImage )
Declare Operator Let ( rhs As fb.image Ptr )
Declare Sub zPut ( screenbuffer As fb.image Ptr )
End Type
Constructor zImage ()
height = 1
Width = 1
nPixels = Width*Height ' !!!
pixdata = Callocate(nPixels,sizeof(uinteger))
location.x = 0
location.y = 0
location.z = 0
End Constructor
Constructor zImage ( rhs As zImage )
this.height = rhs.height
this.width = rhs.width
this.nPixels = rhs.nPixels ' !!!
pixdata = callocate(nPixels*sizeof(uinteger))
For i As Integer = 0 To nPixels-1
this.pixdata[i]=rhs.pixdata[i]
Next
End Constructor
Constructor zImage ( rhs As fb.image Ptr )
this.height = rhs->height
this.width = rhs->width
this.nPixels = Width*height ' !!!
pixdata = callocate(nPixels,sizeof(uinteger))
Dim As Integer i=0
For ix As Integer = 0 To height-1
For iy As Integer = 0 To Width - 1
this.pixdata[i] = Point ( ix,iy,rhs )
i+=1
Next
Next
End Constructor
Operator zImage.Let ( rhs As zImage )
this.height = rhs.height
this.width = rhs.width
this.nPixels = Width*height ' !!!
pixdata = reallocate(pixdata,nPixels*sizeof(uinteger))
For i As Integer =0 To nPixels-1
this.pixdata[i]=rhs.pixdata[i]
Next
End Operator
Operator zImage.Let ( rhs As fb.image Ptr )
this.height = rhs->height
this.width = rhs->width
this.nPixels = Width*height ' !!!
pixdata = reallocate(pixdata,nPixels*sizeof(uinteger))
Dim As Integer i=0
For ix As Integer = 0 To height-1
For iy As Integer = 0 To Width - 1
this.pixdata[i] = Point ( ix,iy,rhs )
i+=1
Next
Next
End Operator
Sub zImage.zPut ( screenbuffer As fb.image Ptr )
Dim As Integer i=0
Dim As Ubyte Ptr sbpix = Cast( Ubyte Ptr, screenbuffer ) + Sizeof( FB.IMAGE )
Dim As Integer xscreen = 0, yscreen = 0
For ix As Integer = 0 To height-1
For iy As Integer = 0 To Width - 1
' !!!
If (pixdata[i] And &HFF00FF)=&HFF00FF Then
i+=1
Continue For
End If
xscreen = ((ix+location.x)*256)/(location.z+1000) + center_x
If xscreen >-1 Then
If xscreen < screen_x Then
yscreen = ((iy+location.y)*256)/(location.z+1000) + center_y
If yscreen >-1 Then
If yscreen < screen_y Then
Cast (Uinteger Ptr, sbpix + ( yscreen * screenbuffer->Pitch ))[ xscreen ] = pixdata[i]
End If
End If
Endif
Endif
i+=1
Next
Next
End Sub
declare function zImageCreate ( xSize as integer, ySize as integer, clr as uinteger = RGB(255,0,255) ) as zImage
declare sub zRotate ( source as zImage, dest as zImage, degrees as single )
declare sub zSet ( dest as zImage, x as integer, y as integer, clr as uinteger )
function zImageCreate ( xSize as integer, ySize as integer, clr as uinteger = RGBA(255,0,255,0) ) as zImage
dim as zImage res
res.npixels = xSize*ySize
res.width = xSize
res.height = ySize
res.pixdata = reallocate(res.pixdata,res.nPixels*sizeof(uinteger))
if clr = RGBA(255,0,255,0) then return res
dim as integer i = 0
For ix As Integer = 0 To res.height-1
For iy As Integer = 0 To res.Width - 1
res.pixdata[i] = clr
i+=1
Next
Next
return res
end function
sub zSet ( dest as zImage, x as integer, y as integer, clr as uinteger )
with dest
if x > .width then exit sub
if x < 0 then exit sub
if y > .height then exit sub
if y < 0 then exit sub
dim as integer spot = x*.width + y
.pixdata[spot] = clr
end with
end sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Matrix Image Type: scaling and rotation
Type mImage
As Integer height
As Integer Width
As Integer nPixels ' !!!
As uinteger Ptr pixdata
As point3d ptr matrix
Declare Constructor ()
Declare Constructor ( rhs As mImage )
Declare Constructor ( rhs As zImage )
Declare Constructor ( rhs As fb.image Ptr )
Declare Operator Let ( rhs As mImage )
Declare Operator Let ( rhs As zImage )
Declare Operator Let ( rhs As fb.image Ptr )
Declare Sub mPut ( screenbuffer As fb.image Ptr )
declare sub mSetLoc ( x as integer, y as integer, z as integer )
End Type
Constructor mImage ()
height = 1
Width = 1
nPixels = Width*Height ' !!!
pixdata = Callocate(nPixels,sizeof(uinteger))
matrix = Callocate(nPixels, sizeof(point3d))
End Constructor
Constructor mImage ( rhs As mImage )
this.height = rhs.height
this.width = rhs.width
this.nPixels = rhs.nPixels ' !!!
pixdata = callocate(nPixels, sizeof(uinteger))
matrix = Callocate(nPixels, sizeof(point3d))
For i As Integer = 0 To nPixels-1
this.pixdata[i]=rhs.pixdata[i]
this.matrix[i]=rhs.matrix[i]
Next
End Constructor
Constructor mImage ( rhs As zImage )
dim as integer i=0
this.height = rhs.height
this.width = rhs.width
this.nPixels = rhs.nPixels ' !!!
pixdata = callocate(nPixels,sizeof(uinteger))
matrix = Callocate(nPixels, sizeof(point3d))
For ix As Integer = 0 To width-1
for iy as integer = 0 to height-1
this.matrix[i].z = rhs.location.z
this.matrix[i].x = rhs.location.x + ix
this.matrix[i].y = rhs.location.y + iy
this.pixdata[i]=rhs.pixdata[i]
i+=1
next
next
End Constructor
Constructor mImage ( rhs As fb.image Ptr )
this.height = rhs->height
this.width = rhs->width
this.nPixels = Width*height ' !!!
pixdata = callocate(nPixels,sizeof(uinteger))
matrix = Callocate(nPixels, sizeof(point3d))
Dim As Integer i=0
For ix As Integer = 0 To width-1
For iy As Integer = 0 To height - 1
this.pixdata[i] = Point ( ix,iy,rhs )
this.matrix[i].x = ix
this.matrix[i].y = iy
i+=1
Next
Next
End Constructor
Operator mImage.Let ( rhs As mImage )
this.height = rhs.height
this.width = rhs.width
this.nPixels = rhs.nPixels ' !!!
pixdata = reallocate(pixdata,nPixels*sizeof(uinteger))
matrix = reallocate(matrix,nPixels*sizeof(point3d))
For i As Integer = 0 To nPixels-1
this.pixdata[i]=rhs.pixdata[i]
this.matrix[i]=rhs.matrix[i]
Next
End Operator
Operator mImage.Let ( rhs As zImage )
dim as integer i=0
this.height = rhs.height
this.width = rhs.width
this.nPixels = rhs.nPixels ' !!!
pixdata = reallocate(pixdata,nPixels*sizeof(uinteger))
matrix = reallocate(matrix,nPixels*sizeof(point3d))
For ix As Integer = 0 To width-1
for iy as integer = 0 to height-1
this.matrix[i].z = rhs.location.z
this.matrix[i].x = rhs.location.x + ix
this.matrix[i].y = rhs.location.y + iy
this.pixdata[i]=rhs.pixdata[i]
i+=1
next
next
End Operator
Operator mImage.Let ( rhs As fb.image Ptr )
this.height = rhs->height
this.width = rhs->width
this.nPixels = Width*height ' !!!
pixdata = reallocate(pixdata,nPixels*sizeof(uinteger))
matrix = reallocate(matrix,nPixels*sizeof(point3d))
Dim As Integer i=0
For ix As Integer = 0 To width-1
For iy As Integer = 0 To height - 1
this.pixdata[i] = Point ( ix,iy,rhs )
this.matrix[i].x = ix
this.matrix[i].y = iy
i+=1
Next
Next
End Operator
Sub mImage.mPut ( screenbuffer As fb.image Ptr )
Dim As Integer i=0
Dim As Ubyte Ptr sbpix = Cast( Ubyte Ptr, screenbuffer ) + Sizeof( FB.IMAGE )
Dim As Integer xscreen = 0, yscreen = 0
For ix As Integer = 0 To width-1
For iy As Integer = 0 To height - 1
' !!!
If (pixdata[i] And &HFF00FF)=&HFF00FF Then
i+=1
Continue For
End If
xscreen = (matrix[i].x*512)/(matrix[i].z+1000) + center_x
If xscreen > 0 Then
If xscreen < screen_x-1 Then
yscreen = (matrix[i].y*512)/(matrix[i].z+1000) + center_y
If yscreen > 0 Then
If yscreen < screen_y-1 Then
Cast (Uinteger Ptr, sbpix + ( yscreen * screenbuffer->Pitch ))[ xscreen ] = pixdata[i]
End If
End If
Endif
Endif
i+=1
Next
Next
End Sub
sub mImage.mSetLoc ( x as integer, y as integer, z as integer )
dim as integer i=0
for ix as integer = 0 to width - 1
for iy as integer = 0 to height-1
matrix[i].x = x+ix
matrix[i].y = y+iy
matrix[i].z = z
i+=1
next
next
end sub
'''''''
declare function mImageCreate ( xSize as integer, ySize as integer, clr as uinteger = RGB(255,0,255) ) as mImage
declare sub mSet ( dest as mImage, x as integer, y as integer, clr as uinteger )
declare sub mRotateXY ( source as mImage, dest as mImage, degrees as single )
declare sub mRotateXZ ( source as mImage, dest as mImage, degrees as single )
declare sub mRotateYZ ( source as mImage, dest as mImage, degrees as single )
declare sub mTranslateXY ( source as mImage, dest as mImage, degrees as single, tPoint as point3d )
declare sub mTranslateXZ ( source as mImage, dest as mImage, degrees as single, tPoint as point3d )
declare sub mTranslateYZ ( source as mImage, dest as mImage, degrees as single, tPoint as point3d )
function mImageCreate ( xSize as integer, ySize as integer, clr as uinteger = RGBA(255,0,255,0) ) as mImage
dim as mImage res
res.npixels = xSize*ySize
res.width = xSize
res.height = ySize
res.pixdata = reallocate(res.pixdata,res.nPixels*sizeof(uinteger))
res.matrix = reallocate(res.matrix,res.nPixels*sizeof(point3d))
if clr = RGBA(255,0,255,0) then return res
dim as integer i = 0
For ix As Integer = 0 To res.width-1
For iy As Integer = 0 To res.height - 1
res.pixdata[i] = clr
res.matrix[i].x = ix
res.matrix[i].y = iy
i+=1
Next
Next
return res
end function
sub mSet ( dest as mImage, x as integer, y as integer, clr as uinteger )
with dest
if x > .width then exit sub
if x < 0 then exit sub
if y > .height then exit sub
if y < 0 then exit sub
dim as integer spot = x*.width + y
.pixdata[spot] = clr
end with
end sub
sub mRotateXY ( source as mImage, dest as mImage, degrees as single )
dest = source
with source
dim as integer cx = .matrix[0].x + .width\2
dim as integer cy = .matrix[0].y + .height\2
dim as single cosphi = cos(degrees), sinphi = sin(degrees)
dim as integer rx=0, ry=0
for i as integer = 0 to .npixels - 1
rx = .matrix[i].x - cx
ry = .matrix[i].y - cy
dest.matrix[i].x = cx + (rx * cosphi - ry * sinphi)
dest.matrix[i].y = cy + (ry * cosphi + rx * sinphi)
dest.pixdata[i] = .pixdata[i]
next
end with
end sub
sub mRotateXZ ( source as mImage, dest as mImage, degrees as single )
dest = source
with source
dim as integer cx = .matrix[0].x + .width\2
dim as integer cz = .matrix[0].z
dim as single cosphi = cos(degrees), sinphi = sin(degrees)
dim as integer rx=0
for i as integer = 0 to .npixels - 1
rx = .matrix[i].x - cx
dest.matrix[i].x = cx + (rx * cosphi)
dest.matrix[i].z = cz + (rx * sinphi)
dest.pixdata[i] = .pixdata[i]
next
end with
end sub
sub mRotateYZ ( source as mImage, dest as mImage, degrees as single )
dest = source
with source
dim as integer cz = .matrix[0].z
dim as integer cy = .matrix[0].y + .height\2
dim as single cosphi = cos(degrees), sinphi = sin(degrees)
dim as integer ry=0
for i as integer = 0 to .npixels - 1
ry = .matrix[i].y - cy
dest.matrix[i].y = cy + ( ry * cosphi )
dest.matrix[i].z = cz + ( ry * sinphi )
dest.pixdata[i] = .pixdata[i]
next
end with
end sub
sub mTranslateXY ( source as mImage, dest as mImage, degrees as single, tPoint as point3d )
dest = source
with source
dim as single cosphi = cos(degrees), sinphi = sin(degrees)
dim as integer rx=0, ry=0
for i as integer = 0 to .npixels - 1
rx = .matrix[i].x - tPoint.x
ry = .matrix[i].y - tPoint.y
dest.matrix[i].x = tPoint.x + (rx * cosphi - ry * sinphi)
dest.matrix[i].y = tPoint.y + (ry * cosphi + rx * sinphi)
dest.pixdata[i] = .pixdata[i]
next
end with
end sub
sub mTranslateXZ ( source as mImage, dest as mImage, degrees as single, tPoint as point3d )
dest = source
with source
dim as single cosphi = cos(degrees), sinphi = sin(degrees)
dim as integer rx=0, rz=0
for i as integer = 0 to .npixels - 1
rx = .matrix[i].x - tPoint.x
rz = .matrix[i].z - tPoint.z
dest.matrix[i].x = tPoint.x + (rx * cosphi - rz * sinphi)
dest.matrix[i].z = tPoint.z + (rz * cosphi + rx * sinphi)
dest.pixdata[i] = .pixdata[i]
next
end with
end sub
sub mTranslateYZ ( source as mImage, dest as mImage, degrees as single, tPoint as point3d )
dest = source
with source
dim as single cosphi = cos(degrees), sinphi = sin(degrees)
dim as integer ry=0, rz=0
for i as integer = 0 to .npixels - 1
ry = .matrix[i].y - tPoint.y
rz = .matrix[i].z - tPoint.z
dest.matrix[i].y = tPoint.y + (ry * cosphi - rz * sinphi)
dest.matrix[i].z = tPoint.z + (rz * cosphi + ry * sinphi)
dest.pixdata[i] = .pixdata[i]
next
end with
end sub
sub mMatrixTransform ( source as mImage, dest as mImage, _
mxx as single, mxy as single, mxz as single, _
myx as single, myy as single, myz as single, _
mzx as single, mzy as single, mzz as single )
dest = source
with source
for i as integer = 0 to .npixels-1
dest.matrix[i].x = .matrix[i].x * mxx + .matrix[i].y * mxy + .matrix[i].z * mxz
dest.matrix[i].y = .matrix[i].x * myx + .matrix[i].y * myy + .matrix[i].z * myz
dest.matrix[i].z = .matrix[i].x * mzx + .matrix[i].y * mzy + .matrix[i].z * mzz
dest.pixdata[i] = .pixdata[i]
next
end with
end sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'A boxel is a scalable square which means that dilating a sprite no longer
'means more pixels
type boxel
as uinteger clr = RNDRGBA
as point3d corners(1)
declare Constructor ()
declare Constructor (byref rhs as boxel)
declare Operator Let (byref rhs as boxel)
declare Property center () as point3d
declare sub DrawMe ( screenbuffer as fb.image ptr = 0 )
declare sub SetLoc ( x as single, y as single, z as single )
end type
Constructor boxel ()
this.corners(0).x = 0
this.corners(0).y = 0
this.corners(0).z = 0
this.corners(0).x = 1
this.corners(0).y = 1
this.corners(0).z = 0
end Constructor
Constructor boxel ( rhs as boxel )
this.corners(0).x = rhs.corners(0).x
this.corners(0).y = rhs.corners(0).y
this.corners(0).z = rhs.corners(0).z
this.corners(1).x = rhs.corners(0).x+1
this.corners(1).y = rhs.corners(0).y+1
this.corners(1).z = rhs.corners(0).z
end Constructor
Operator boxel.Let ( rhs as boxel )
this.corners(0).x = rhs.corners(0).x
this.corners(0).y = rhs.corners(0).y
this.corners(0).z = rhs.corners(0).z
this.corners(1).x = rhs.corners(0).x+1
this.corners(1).y = rhs.corners(0).y+1
this.corners(1).z = rhs.corners(0).z
end Operator
Property Boxel.Center() as point3d
dim as point3d res
res.x = ( corners(0).x + corners(1).x ) * .5
res.y = ( corners(0).y + corners(1).y ) * .5
res.z = ( corners(0).z + corners(1).z ) * .5
return res
end Property
sub Boxel.DrawMe ( screenbuffer as fb.image ptr )
Dim As Integer xscreen(1), yscreen(1)
for i as integer = 0 to 1
with corners(i)
xscreen(i) = (.x*256)/(.z+1000) + center_x
if xscreen(i) < 1 or xscreen(i) > screen_x-1 then exit sub
yscreen(i) = (.y*256)/(.z+1000) + center_y
if yscreen(i) < 1 or yscreen(i) > screen_y-1 then exit sub
end with
next
Dim As Ubyte Ptr sbpix = Cast( Ubyte Ptr, screenbuffer ) + Sizeof( FB.IMAGE )
if xscreen(0) > xscreen(1) then Swap xscreen(0), xscreen(1)
if yscreen(0) > yscreen(1) then Swap yscreen(0), yscreen(1)
For ix As Integer = xscreen(0) To xscreen(1)
For iy As Integer = yscreen(0) To yscreen(1)
Cast (Uinteger Ptr, sbpix + ( iy * screenbuffer->Pitch ))[ ix ] = Clr
Next
Next
end sub
sub Boxel.SetLoc ( x as single, y as single, z as single )
this.corners(0).x = x
this.corners(0).y = y
this.corners(0).z = z
this.corners(1).x = x+1
this.corners(1).y = y+1
this.corners(1).z = z
end sub
Type bImage
As Integer height
As Integer Width
As Integer nPixels ' !!!
As boxel ptr matrix
Declare Constructor ()
Declare Constructor ( rhs As fb.image Ptr )
declare Constructor ( rhs as bImage )
declare Constructor ( rhs as mImage )
Declare Operator Let ( rhs As fb.image Ptr )
declare Operator Let ( rhs as bImage )
declare Operator Let ( rhs as mImage )
Declare Sub bPut ( screenbuffer As fb.image Ptr = 0 )
declare sub bSetLoc ( x as integer, y as integer, z as integer )
declare sub MoveForward ( amt as integer )
End Type
Constructor bImage ()
height = 1
Width = 1
nPixels = Width*Height ' !!!
matrix = Callocate(nPixels, sizeof(boxel))
End Constructor
Constructor bImage ( rhs As fb.image Ptr )
this.height = rhs->height
this.width = rhs->width
this.nPixels = Width*height ' !!!
matrix = Callocate(nPixels, sizeof(boxel))
Dim As Integer i=0
For ix As Integer = 0 To width-1
For iy As Integer = 0 To height - 1
this.matrix[i].clr = Point ( ix,iy,rhs )
this.matrix[i].corners(0).x = ix
this.matrix[i].corners(0).y = iy
this.matrix[i].corners(1).x = ix+1
this.matrix[i].corners(1).y = iy+1
i+=1
Next
Next
End Constructor
Constructor bImage ( rhs as bImage )
this.height = rhs.height
this.width = rhs.width
this.nPixels = width*height
matrix = callocate (nPixels, sizeof(boxel))
for i as integer = 0 to nPixels-1
this.matrix[i].clr = rhs.matrix[i].clr
this.matrix[i].corners(0).x = rhs.matrix[i].corners(0).x
this.matrix[i].corners(0).y = rhs.matrix[i].corners(0).y
this.matrix[i].corners(0).z = rhs.matrix[i].corners(0).z
this.matrix[i].corners(1).x = rhs.matrix[i].corners(1).x
this.matrix[i].corners(1).y = rhs.matrix[i].corners(1).y
this.matrix[i].corners(1).z = rhs.matrix[i].corners(1).z
next
end Constructor
Constructor bImage ( rhs as mImage )
this.height = rhs.height
this.width = rhs.width
this.nPixels = width*height
matrix = callocate (nPixels, sizeof(boxel))
for i as integer = 0 to nPixels-1
this.matrix[i].clr = rhs.pixdata[i]
this.matrix[i].corners(0).x = rhs.matrix[i].x
this.matrix[i].corners(0).y = rhs.matrix[i].y
this.matrix[i].corners(0).z = rhs.matrix[i].z
this.matrix[i].corners(1).x = rhs.matrix[i].x+1
this.matrix[i].corners(1).y = rhs.matrix[i].y+1
this.matrix[i].corners(1).z = rhs.matrix[i].z
next
end Constructor
Operator bImage.Let ( rhs As fb.image Ptr )
this.height = rhs->height
this.width = rhs->width
this.nPixels = Width*height ' !!!
matrix = reallocate(matrix, nPixels * sizeof(boxel))
Dim As Integer i=0
For ix As Integer = 0 To width-1
For iy As Integer = 0 To height - 1
this.matrix[i].clr = Point ( ix,iy,rhs )
this.matrix[i].corners(0).x = ix
this.matrix[i].corners(0).y = iy
this.matrix[i].corners(1).x = ix+1
this.matrix[i].corners(1).y = iy+1
i+=1
Next
Next
End Operator
Operator bImage.Let ( rhs as bImage )
this.height = rhs.height
this.width = rhs.width
this.nPixels = width*height
matrix = reallocate(matrix, nPixels * sizeof(boxel))
for i as integer = 0 to nPixels-1
this.matrix[i].clr = rhs.matrix[i].clr
this.matrix[i].corners(0).x = rhs.matrix[i].corners(0).x
this.matrix[i].corners(0).y = rhs.matrix[i].corners(0).y
this.matrix[i].corners(0).z = rhs.matrix[i].corners(0).z
this.matrix[i].corners(1).x = rhs.matrix[i].corners(1).x
this.matrix[i].corners(1).y = rhs.matrix[i].corners(1).y
this.matrix[i].corners(1).z = rhs.matrix[i].corners(1).z
next
end Operator
Operator bImage.Let ( rhs as mImage )
this.height = rhs.height
this.width = rhs.width
this.nPixels = width*height
matrix = reallocate(matrix, nPixels * sizeof(boxel))
for i as integer = 0 to nPixels-1
this.matrix[i].clr = rhs.pixdata[i]
this.matrix[i].corners(0).x = rhs.matrix[i].x
this.matrix[i].corners(0).y = rhs.matrix[i].y
this.matrix[i].corners(0).z = rhs.matrix[i].z
this.matrix[i].corners(1).x = rhs.matrix[i].x+1
this.matrix[i].corners(1).y = rhs.matrix[i].y+1
this.matrix[i].corners(1).z = rhs.matrix[i].z
next
end Operator
Sub bImage.bPut ( screenbuffer As fb.image Ptr = 0 )
dim as integer i=0
Dim As Ubyte Ptr sbpix = Cast( Ubyte Ptr, screenbuffer ) + Sizeof( FB.IMAGE )
Dim As Integer xscreen(1)={0,0}, yscreen(1)={0,0}
for ix as integer = 0 to width-1
for iy as integer = 0 to height-1
If (matrix[i].clr And &HFF00FF)=&HFF00FF Then goto NEXTIY
with matrix[i]
for ii as integer = 0 to 1
with .corners(ii)
xscreen(ii) = (.x*256)/(.z+1000) + 400
if xscreen(ii) < 1 or xscreen(ii) > screen_x then goto NEXTIY
yscreen(ii) = (.y*256)/(.z+1000) + 300
if yscreen(ii) < 1 or yscreen(ii) > screen_y then goto NEXTIY
end with
next
if xscreen(0) > xscreen(1) then Swap xscreen(0), xscreen(1)
if yscreen(0) > yscreen(1) then Swap yscreen(0), yscreen(1)
For iix As Integer = xscreen(0) To xscreen(1)
For iiy As Integer = yscreen(0) To yscreen(1)
Cast (Uinteger Ptr, sbpix + ( iiy * screenbuffer->Pitch ))[ iix ] = .Clr
Next
Next
end with
NEXTIY:
i+=1
next
next
End Sub
sub bImage.bSetLoc ( x as integer, y as integer, z as integer )
dim as integer i=0
for ix as integer = 0 to height - 1
for iy as integer = 0 to width-1
matrix[i].corners(0).x = x+ix
matrix[i].corners(0).y = y+iy
matrix[i].corners(0).z = z
matrix[i].corners(1).x = x+ix+1
matrix[i].corners(1).y = y+iy+1
matrix[i].corners(1).z = z
i+=1
next
next
end sub
sub bImage.MoveForward ( amt as integer )
dim as integer i=0
for ix as integer = 0 to height - 1
for iy as integer = 0 to width-1
matrix[i].corners(0).z -= amt
matrix[i].corners(1).z -= amt
i+=1
next
next
end sub
declare sub bRotateXY ( source as bImage, dest as bImage, degrees as single )
declare sub bRotateXZ ( source as bImage, dest as bImage, degrees as single )
declare sub bRotateYZ ( source as bImage, dest as bImage, degrees as single )
declare sub bTranslateXY ( source as bImage, dest as bImage, degrees as single, tPoint as point3d )
declare sub bTranslateXZ ( source as bImage, dest as bImage, degrees as single, tPoint as point3d )
declare sub bTranslateYZ ( source as bImage, dest as bImage, degrees as single, tPoint as point3d )
sub bRotateXY ( source as bImage, dest as bImage, degrees as single )
dest = source
with source
dim as integer cx = .matrix[0].corners(0).x + .width\2
dim as integer cy = .matrix[0].corners(0).y + .height\2
dim as single cosphi = cos(degrees), sinphi = sin(degrees)
dim as integer rx=0, ry=0
for i as integer = 0 to .npixels - 1
rx = .matrix[i].corners(0).x - cx
ry = .matrix[i].corners(0).y - cy
dest.matrix[i].corners(0).x = cx + (rx * cosphi - ry * sinphi)
dest.matrix[i].corners(0).y = cy + (ry * cosphi + rx * sinphi)
rx = .matrix[i].corners(1).x - cx
ry = .matrix[i].corners(1).y - cy
dest.matrix[i].corners(1).x = cx + (rx * cosphi - ry * sinphi)
dest.matrix[i].corners(1).y = cy + (ry * cosphi + rx * sinphi)
dest.matrix[i].clr = .matrix[i].clr
next
end with
end sub
sub bRotateXZ ( source as bImage, dest as bImage, degrees as single )
dest = source
with source
dim as integer cx = .matrix[0].corners(0).x + .width\2
dim as integer cz = .matrix[0].corners(0).z
dim as single cosphi = cos(degrees), sinphi = sin(degrees)
dim as integer rx=0
for i as integer = 0 to .npixels - 1
rx = .matrix[i].corners(0).x - cx
dest.matrix[i].corners(0).x = cx + (rx * cosphi)
dest.matrix[i].corners(0).z = cz + (rx * sinphi)
rx = .matrix[i].corners(1).x - cx
dest.matrix[i].corners(1).x = cx + (rx * cosphi)
dest.matrix[i].corners(1).z = cz + (rx * sinphi)
dest.matrix[i].clr = .matrix[i].clr
next
end with
end sub
sub bRotateYZ ( source as bImage, dest as bImage, degrees as single )
dest = source
with source
dim as integer cy = .matrix[0].corners(0).y + .width\2
dim as integer cz = .matrix[0].corners(0).z
dim as single cosphi = cos(degrees), sinphi = sin(degrees)
dim as integer ry=0
for i as integer = 0 to .npixels - 1
ry = .matrix[i].corners(0).y - cy
dest.matrix[i].corners(0).y = cy + (ry * cosphi)
dest.matrix[i].corners(0).z = cz + (ry * sinphi)
ry = .matrix[i].corners(1).y - cy
dest.matrix[i].corners(1).y = cy + (ry * cosphi)
dest.matrix[i].corners(1).z = cz + (ry * sinphi)
dest.matrix[i].clr = .matrix[i].clr
next
end with
end sub
sub bTranslateXY ( source as bImage, dest as bImage, degrees as single, tPoint as point3d )
dest = source
with source
dim as single cosphi = cos(degrees), sinphi = sin(degrees)
dim as integer rx=0, ry=0
for i as integer = 0 to .npixels - 1
rx = .matrix[i].corners(0).x - tPoint.x
ry = .matrix[i].corners(0).y - tPoint.y
dest.matrix[i].corners(0).x = tPoint.x + (rx * cosphi - ry * sinphi)
dest.matrix[i].corners(0).y = tPoint.y + (ry * cosphi + rx * sinphi)
rx = .matrix[i].corners(1).x - tPoint.x
ry = .matrix[i].corners(1).y - tPoint.y
dest.matrix[i].corners(1).x = tPoint.x + (rx * cosphi - ry * sinphi)
dest.matrix[i].corners(1).y = tPoint.y + (ry * cosphi + rx * sinphi)
dest.matrix[i].clr = .matrix[i].clr
next
end with
end sub
sub bTranslateXZ ( source as bImage, dest as bImage, degrees as single, tPoint as point3d )
dest = source
with source
dim as single cosphi = cos(degrees), sinphi = sin(degrees)
dim as integer rx=0, rz=0
for i as integer = 0 to .npixels - 1
rx = .matrix[i].corners(0).x - tPoint.x
rz = .matrix[i].corners(0).z - tPoint.z
dest.matrix[i].corners(0).x = tPoint.x + (rx * cosphi - rz * sinphi)
dest.matrix[i].corners(0).z = tPoint.z + (rz * cosphi + rx * sinphi)
rx = .matrix[i].corners(1).x - tPoint.x
rz = .matrix[i].corners(1).z - tPoint.z
dest.matrix[i].corners(1).x = tPoint.x + (rx * cosphi - rz * sinphi)
dest.matrix[i].corners(1).z = tPoint.z + (rz * cosphi + rx * sinphi)
dest.matrix[i].clr = .matrix[i].clr
next
end with
end sub
sub bTranslateYZ ( source as bImage, dest as bImage, degrees as single, tPoint as point3d )
dest = source
with source
dim as single cosphi = cos(degrees), sinphi = sin(degrees)
dim as integer ry=0, rz=0
for i as integer = 0 to .npixels - 1
ry = .matrix[i].corners(0).y - tPoint.y
rz = .matrix[i].corners(0).z - tPoint.z
dest.matrix[i].corners(0).y = tPoint.y + (ry * cosphi - rz * sinphi)
dest.matrix[i].corners(0).z = tPoint.z + (rz * cosphi + ry * sinphi)
ry = .matrix[i].corners(1).y - tPoint.y
rz = .matrix[i].corners(1).z - tPoint.z
dest.matrix[i].corners(1).y = tPoint.y + (ry * cosphi - rz * sinphi)
dest.matrix[i].corners(1).z = tPoint.z + (rz * cosphi + ry * sinphi)
dest.matrix[i].clr = .matrix[i].clr
next
end with
end sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Depth Image Type: Our first real 3d image
'
Type dImage
As Integer height
As Integer Width
as integer depth
As Integer nPixels ' !!!
As uinteger Ptr pixdata
As point3d ptr matrix
Declare Constructor ()
Declare Constructor ( rhs As dImage )
Declare Constructor ( rhs As fb.image Ptr )
Declare Operator Let ( rhs As dImage )
Declare Operator Let ( rhs As fb.image Ptr )
Declare Sub dPut ( screenbuffer As fb.image Ptr )
declare sub dSetLoc ( x as integer, y as integer, z as integer )
End Type
Constructor dImage ()
height = 1
Width = 1
depth = 1
nPixels = Width*Height*depth
pixdata = Callocate(nPixels,sizeof(uinteger))
matrix = Callocate(nPixels, sizeof(point3d))
End Constructor
Constructor dImage ( rhs As dImage )
this.height = rhs.height
this.width = rhs.width
this.depth = rhs.depth
this.nPixels = rhs.nPixels ' !!!
pixdata = callocate(nPixels, sizeof(uinteger))
matrix = Callocate(nPixels, sizeof(point3d))
For i As Integer = 0 To nPixels-1
this.pixdata[i]=rhs.pixdata[i]
this.matrix[i]=rhs.matrix[i]
Next
End Constructor
Constructor dImage ( rhs As fb.image Ptr )
this.height = rhs->height
this.width = rhs->width
this.depth = 20
this.nPixels = depth*Width*height ' !!!
pixdata = callocate(nPixels,sizeof(uinteger))
matrix = Callocate(nPixels, sizeof(point3d))
Dim As Integer i=0
For ix As Integer = 0 To width-1
For iy As Integer = 0 To height - 1
dim as uinteger c = Point ( ix,iy,rhs )
for iz as integer = 0 to depth - 1
this.pixdata[i] = c
this.matrix[i].x = ix
this.matrix[i].y = iy
this.matrix[i].z = iz
i+=1
next
Next
Next
End Constructor
Operator dImage.Let ( rhs As dImage )
this.height = rhs.height
this.width = rhs.width
this.depth = rhs.depth
this.nPixels = rhs.nPixels ' !!!
pixdata = reallocate(pixdata,nPixels*sizeof(uinteger))
matrix = reallocate(matrix,nPixels*sizeof(point3d))
For i As Integer = 0 To nPixels-1
this.pixdata[i]=rhs.pixdata[i]
this.matrix[i]=rhs.matrix[i]
Next
End Operator
Operator dImage.Let ( rhs As fb.image Ptr )
this.height = rhs->height
this.width = rhs->width
this.depth = 20
this.nPixels = depth*Width*height ' !!!
pixdata = reallocate(pixdata,nPixels*sizeof(uinteger))
matrix = reallocate(matrix,nPixels*sizeof(point3d))
Dim As Integer i=0
For ix As Integer = 0 To width-1
For iy As Integer = 0 To height - 1
dim as integer c = Point ( ix,iy,rhs )
for iz as integer = 0 to depth - 1
this.matrix[i].x = ix
this.matrix[i].y = iy
this.matrix[i].z = iz
this.pixdata[i] = c
i+=1
next
Next
Next
End Operator
Sub dImage.dPut ( screenbuffer As fb.image Ptr )
Dim As Integer i=0,ix=0,iy=0,iz=0
Dim As Ubyte Ptr sbpix = Cast( Ubyte Ptr, screenbuffer ) + Sizeof( FB.IMAGE )
Dim As Integer xscreen = 0, yscreen = 0
For ix = 0 To width-1
If (pixdata[i] And &HFF00FF)=&HFF00FF Then goto RELOOP
For iy = 0 To height - 1
for iz = 0 to depth - 1
xscreen = (matrix[i].x*512)/(matrix[i].z+1000) + center_x
If xscreen < 0 Then goto RELOOP
If xscreen > screen_x-1 Then goto RELOOP
yscreen = (matrix[i].y*512)/(matrix[i].z+1000) + center_y
If yscreen < 0 Then GOTO RELOOP
If yscreen > screen_y-1 Then goto RELOOP
Cast (Uinteger Ptr, sbpix + ( yscreen * screenbuffer->Pitch ))[ xscreen ] = pixdata[i]
RELOOP:
i+=1
next
Next
Next
End Sub
sub dImage.dSetLoc ( x as integer, y as integer, z as integer )
dim as integer i=0
for ix as integer = 0 to width - 1
for iy as integer = 0 to height-1
for iz as integer = 0 to depth-1
matrix[i].x = x+ix
matrix[i].y = y+iy
matrix[i].z = z+iz
i+=1
next
next
next
end sub
'''''''
declare function dImageCreate ( xSize as integer, ySize as integer, zSize as integer, clr as uinteger = RGBA(255,0,255,0) ) as dImage
declare sub dSet ( dest as dImage, x as integer, y as integer, z as integer, clr as uinteger )
declare sub dRotateXY ( source as dImage, dest as dImage, degrees as single )
declare sub dRotateXZ ( source as dImage, dest as dImage, degrees as single )
declare sub dRotateYZ ( source as dImage, dest as dImage, degrees as single )
function dImageCreate ( xSize as integer, ySize as integer, zSize as integer, clr as uinteger = RGBA(255,0,255,0) ) as dImage
dim as dImage res
res.npixels = xSize*ySize*zSize
res.width = xSize
res.height = ySize
res.depth = zSize
res.pixdata = reallocate(res.pixdata,res.nPixels*sizeof(uinteger))
res.matrix = reallocate(res.matrix,res.nPixels*sizeof(point3d))
dim as integer i = 0
For ix As Integer = 0 To res.width-1
For iy As Integer = 0 To res.height - 1
for iz as integer = 0 to res.depth-1
res.pixdata[i] = clr
res.matrix[i].x = ix
res.matrix[i].y = iy
res.matrix[i].z = iz
i+=1
next
Next
Next
return res
end function
sub dSet ( dest as dImage, x as integer, y as integer, z as integer, clr as uinteger )
with dest
if x > .width then exit sub
if x < 0 then exit sub
if y > .height then exit sub
if y < 0 then exit sub
if z < 0 then exit sub
if z > .depth then exit sub
dim as integer spot = x*.width + y*.height + z
.pixdata[spot] = clr
end with
end sub
sub dRotateXY ( source as dImage, dest as dImage, degrees as single )
dest = source
with source
dim as integer cx = .matrix[0].x + .width\2
dim as integer cy = .matrix[0].y + .height\2
dim as single cosphi = cos(degrees), sinphi = sin(degrees)
dim as integer rx=0, ry=0
for i as integer = 0 to .npixels - 1
rx = .matrix[i].x - cx
ry = .matrix[i].y - cy
dest.matrix[i].x = cx + (rx * cosphi - ry * sinphi)
dest.matrix[i].y = cy + (ry * cosphi + rx * sinphi)
dest.pixdata[i] = .pixdata[i]
next
end with
end sub
sub dRotateXZ ( source as dImage, dest as dImage, degrees as single )
dest = source
with source
dim as integer cx = .matrix[0].x + .width\2
dim as integer cz = .matrix[0].z + .depth\2
dim as single cosphi = cos(degrees), sinphi = sin(degrees)
dim as integer rx=0, rz=0
for i as integer = 0 to .npixels - 1
rx = .matrix[i].x - cx
rz = .matrix[i].z - cz
dest.matrix[i].x = cx + (rx * cosphi) - (rz * sinphi)
dest.matrix[i].z = cz + (rx * sinphi) + (rz * cosphi)
dest.pixdata[i] = .pixdata[i]
next
end with
end sub
sub dRotateYZ ( source as dImage, dest as dImage, degrees as single )
dest = source
with source
dim as integer cz = .matrix[0].z + .depth\2
dim as integer cy = .matrix[0].y + .height\2
dim as single cosphi = cos(degrees), sinphi = sin(degrees)
dim as integer ry=0, rz=0
for i as integer = 0 to .npixels - 1
ry = .matrix[i].y - cy
rz = .matrix[i].z - cz
dest.matrix[i].y = cy + ( ry * cosphi ) - ( rz*sinphi )
dest.matrix[i].z = cz + ( ry * sinphi ) + ( rz*cosphi )
dest.pixdata[i] = .pixdata[i]
next
end with
end sub
'sub mTranslateXY ( source as mImage, dest as mImage, degrees as single, tPoint as point3d )
'
' dest = source
'
' with source
'
' dim as single cosphi = cos(degrees), sinphi = sin(degrees)
' dim as integer rx=0, ry=0
'
' for i as integer = 0 to .npixels - 1
' rx = .matrix[i].x - tPoint.x
' ry = .matrix[i].y - tPoint.y
' dest.matrix[i].x = tPoint.x + (rx * cosphi - ry * sinphi)
' dest.matrix[i].y = tPoint.y + (ry * cosphi + rx * sinphi)
' dest.pixdata[i] = .pixdata[i]
' next
'
' end with
'
'end sub
'
'sub mTranslateXZ ( source as mImage, dest as mImage, degrees as single, tPoint as point3d )
'
' dest = source
'
' with source
'
' dim as single cosphi = cos(degrees), sinphi = sin(degrees)
' dim as integer rx=0, rz=0
'
' for i as integer = 0 to .npixels - 1
' rx = .matrix[i].x - tPoint.x
' rz = .matrix[i].z - tPoint.z
' dest.matrix[i].x = tPoint.x + (rx * cosphi - rz * sinphi)
' dest.matrix[i].z = tPoint.z + (rz * cosphi + rx * sinphi)
' dest.pixdata[i] = .pixdata[i]
' next
'
' end with
'
'end sub
'
'sub mTranslateYZ ( source as mImage, dest as mImage, degrees as single, tPoint as point3d )
'
' dest = source
'
' with source
'
' dim as single cosphi = cos(degrees), sinphi = sin(degrees)
' dim as integer ry=0, rz=0
'
' for i as integer = 0 to .npixels - 1
' ry = .matrix[i].y - tPoint.y
' rz = .matrix[i].z - tPoint.z
' dest.matrix[i].y = tPoint.y + (ry * cosphi - rz * sinphi)
' dest.matrix[i].z = tPoint.z + (rz * cosphi + ry * sinphi)
' dest.pixdata[i] = .pixdata[i]
' next
'
' end with
'
'end sub
'
'sub mMatrixTransform ( source as mImage, dest as mImage, _
' mxx as single, mxy as single, mxz as single, _
' myx as single, myy as single, myz as single, _
' mzx as single, mzy as single, mzz as single )
'
' dest = source
'
' with source
'
' for i as integer = 0 to .npixels-1
' dest.matrix[i].x = .matrix[i].x * mxx + .matrix[i].y * mxy + .matrix[i].z * mxz
' dest.matrix[i].y = .matrix[i].x * myx + .matrix[i].y * myy + .matrix[i].z * myz
' dest.matrix[i].z = .matrix[i].x * mzx + .matrix[i].y * mzy + .matrix[i].z * mzz
' dest.pixdata[i] = .pixdata[i]
' next
'
' end with
'
'end sub
#include once "../../../Graphics/3dGFX/vImage.bas"
Screen 19,32,,fb.GFX_ALPHA_PRIMITIVES
Dim As fb.image Ptr pic = imagecreate(100,100,0)
Line pic,(0,0)-(100,100),rgba(255,0,255,0),BF 'trans rectangle
Circle pic,(50,50),50,rgba(255,255, 0,255),,,,F
Circle pic,(25,30),12,rgba(255,255,255,255),,,,F
Circle pic,(75,30),12,rgba(255,255,255,255),,,,F
Circle pic,(25,30), 7,rgba( 0, 0, 0,255),,,,F
Circle pic,(75,30), 7,rgba( 0, 0, 0,255),,,,F
Circle pic,(50,50),28,rgba( 0, 0, 0,255),1.57*2,1.57*4
Dim As Double t
Dim As Single theta
Dim As fb.image Ptr screenbuffer = imagecreate(screen_x,screen_y,0)
Dim As dImage dimg = pic, xy = pic, xz = pic, yz = pic
dimg.dSetLoc ( -50, -50, -879 )
Do
'xy.dput(screenbuffer)
xz.dput(screenbuffer)
'yz.dput(screenbuffer)
dRotateYZ( dimg, yz, theta )
dRotateXZ( yz, xz , theta )
'dRotateXY( dimg, xy, theta )
Put (0,0),screenbuffer,trans
Sleep 1
Line screenbuffer, (0,0)-(screen_x, screen_y),RGBA(0,0,0,255),bf
theta += .1
If theta > 2*3.1459 Then theta = 0
Loop Until Len(Inkey)
Hi Rollie~rolliebollocks wrote:Hey guys. Here is an attempt at a volumetric image. I need a voxel type. And I also need to figure out how to plot the surface only w/o a zsort.
Could you give a link for the file:
error 24: File not found, "../../../Graphics/3dGFX/vImage.bas"
Also I've got a couple of errors (warnings)
warning 15(1): Branch crossing local variable definition, to label: RELOOP, variable: LT_023C
You seem to have done a bit of work here, I'd like to give it a run.
-
- Posts: 2655
- Joined: Aug 28, 2008 10:54
- Location: new york
There have been no squares in squares yet.
Here are a few to start off.
Here are a few to start off.
Code: Select all
Dim As Integer xres,yres
screeninfo xres,yres
screenres xres,yres,32
dim as double pi=4*atn(1)
#define rad *pi/180
#macro r(first, last)
Rnd * (last - first) + first
#endmacro
dim as integer flag
#macro _pset(x1,y1,minx,maxx,miny,maxy)
Dim As Double xx1= Cdbl(xres)*(x1-minx)/(maxx-minx)
Dim As Double yy1=Cdbl(yres)*(y1-maxy)/(miny-maxy)
if flag=0 then
Pset im(1),(xx1,yy1),rgb(100-z,100-z,100-z)
Pset (xx1,yy1),rgb(r(100,150)-z,r(100,150)-z,r(100,150)-z)
end if
if flag=1 then
if point(xx1,yy1,im(1))<>-16777216 then
'Pset (xx1,yy1),rgb(100-z,100-z,100-z)
pset im(2),(xx1,yy1),rgb(r(100,150)-z,r(100,150)-z,r(100,150)-z)
pset (xx1,yy1),rgb(r(100,150)-z,r(100,150)-z,r(100,150)-z)
end if
end if
if flag=2 then
if point(xx1,yy1,im(2))<>-16777216 then
pset (xx1,yy1),rgb(r(100,150)-z,r(100,150)-z,r(100,150)-z)
end if
end if
#endmacro
#macro background(xl,xu,yl,yu,fl)
flag=fl
For x As Double=xl To xu Step (xu-xl)/xres
For y As Double=yl To yu Step(yu-yl)/yres
Dim As Double z=(100*(Sin(x rad))*(Cos(y rad)))^.1
_pset(x,y,xl,xu,yl,yu)
Next y
Next x
#endmacro
dim as any pointer im(1 to 2)
im(1)=imagecreate(xres,yres,rgb(0,0,0))
im(2)=imagecreate(xres,yres,rgb(0,0,0))
background(0,xres,0,yres,0)
for z2 as double=1 to 2 step 1
background(0,(6^z2)*xres,0,(6^z2)*yres,z2)
next z2
draw string (10,10), " DONE",rgb(0,200,0)
imagedestroy im(1)
imagedestroy im(2)
Sleep
Last edited by dodicat on Aug 16, 2010 1:30, edited 1 time in total.
-
- Posts: 489
- Joined: Apr 18, 2008 4:09
- Location: Los Angeles, CA
- Contact:
-
- Posts: 2655
- Joined: Aug 28, 2008 10:54
- Location: new york
There's only one way to find out:BasicScience wrote:Since this is a silly thread... here's a silly question, motivated by the code from Dodicat.
Look at the macro labeled background. Is there a performance penalty for using DIM within a loop, as compared to defining the var before the loop?
1) Sketch a curve through 4 million points internal dim
2) Sketch a curve through 4 million points external dim
Code: Select all
Dim As Integer xres,yres
screeninfo xres,yres
screenres xres,yres,32
dim as double PLOT_GRADE=4000000
#macro sketch(_function,minx,maxx,miny,maxy)
For x As Double=minx To maxx Step (maxx-minx)/PLOT_GRADE
dim as double x1=Cdbl(xres)*(x-minx)/(maxx-minx)
dim as double y1=Cdbl(yres)*(_function-maxy)/(miny-maxy)
Pset(x1,y1)
Next x
#endmacro
'SAME MACRO WITH EXTERNAL DIMS
dim as double x0,x1,x2,y2
#macro sketch2(_function,minx,maxx,miny,maxy)
For x0 =minx To maxx Step (maxx-minx)/PLOT_GRADE
x2=Cdbl(xres)*(x0-minx)/(maxx-minx)
y2=Cdbl(yres)*(_function-maxy)/(miny-maxy)
Pset(x2,y2)
Next x0
#endmacro
dim as double t1,t2,t3,t4
print "PRESS A KEY TO START"
sleep
t1=timer
sketch(sin(x)/x,-20,40,-1,2)
t2=timer
print "press a key"
sleep
cls
t3=timer
sketch2(sin(x0)/x0,-20,40,-1,2)
t4=timer
print "Time for internal dim ";t2-t1
print "Time for external dim ";t4-t3
sleep
-
- Posts: 489
- Joined: Apr 18, 2008 4:09
- Location: Los Angeles, CA
- Contact:
Hmm.... not what I expected. 0.03 sec faster for the internal assignment of DIM in the loop.
I wonder what the ASM code is actually doing. Somehow the compiler must be pulling the memory allocation out of the loop, since it would make no sense to repeatedly define the variable with each iteration. Moreover, the compiler keeps the scope local to the For-Next loop, since after the loop the variable does not exist.
I wonder what the ASM code is actually doing. Somehow the compiler must be pulling the memory allocation out of the loop, since it would make no sense to repeatedly define the variable with each iteration. Moreover, the compiler keeps the scope local to the For-Next loop, since after the loop the variable does not exist.
@ BasicScience
A Dim statement implicitly generates an initialisation assignment each time it is “executed”.
Do : Dim as Integer k = 1 : . . . : Loop
will have local scope and be faster than
Dim As Integer k : Do : k = 1 : . . . : Loop
because there is an unnecessary assignment of zero to k outside the loop.
Do : Dim As Integer k : . . . : k = 1 : . . . : Loop
would be slowest because of the double assignment to k within the loop.
The fastest code would be something like
Dim As Integer k = 1 : Do : . . . : Loop
but it assigns k only once, outside the loop, with scope outside the loop.
A Dim statement implicitly generates an initialisation assignment each time it is “executed”.
Do : Dim as Integer k = 1 : . . . : Loop
will have local scope and be faster than
Dim As Integer k : Do : k = 1 : . . . : Loop
because there is an unnecessary assignment of zero to k outside the loop.
Do : Dim As Integer k : . . . : k = 1 : . . . : Loop
would be slowest because of the double assignment to k within the loop.
The fastest code would be something like
Dim As Integer k = 1 : Do : . . . : Loop
but it assigns k only once, outside the loop, with scope outside the loop.
But it is convenient because you can have a fast stand alone macro, and a macro is faster than a function.BasicScience wrote:Hmm.... not what I expected. 0.03 sec faster for the internal assignment of DIM in the loop.
Simple example:
Code: Select all
function Isquare(x as double) as double
function=1/(x^2)
end function
#macro Isquare2(x)
1/(x^2)
#endmacro
dim as double t1,t2,sum
t1=timer
for z as long=1 to 500000
sum=sum+Isquare(z)
next z
t2=timer
print "Answer ";sum
print "time taken for function ";t2-t1
print
sum=0
t1=timer
for z as long=1 to 500000
sum=sum+Isquare2(z)
next z
t2=timer
print "Answer ";sum
print "time taken for macro ";t2-t1
sleep