Freebasic 3d renderer using tinyptc

[Stonemonkey]

A sort of basic renderer which has perspective correct texturing and per vertex gouraoud shading from a single light source.

The following code is the lib only, save as "stonemonkey3d.bas"

Code: [Select]

'*****************************************************************************
'******************** Stonemonkey 3D lib using Tiny_PTC **********************
'*****************************************************************************
'
'Use as you want but please credit if used in any work.
'
'******************** user functions **********************
'
'buffer as buffer pointer=graphics_3d(width,height,[name$])
'close_graphics(buffer)
'world as world pointer=create_world()
'delete_world(world)
'texture as texture pointer=create_texture(world,width,height[,argb_fill])
'set_texel(texture,x,y,argb)
'argb as integer=get_texel(texture,x,y)
'ambient_light(world,level0-255)
'camera as entity pointer=create_camera(world)
'change_camera(world,camera)
'camera as entity pointer=current_camera(world)
'light as entity pointer=create_light(world)
'mesh as entity pointer=create_mesh(world)
'vertex as vertex pointer=add_vertex(mesh,x,y,z[,u,v])
'triangle as triangle pointer=add_triangle(mesh,vertex0,vertex1,vertex2,texture)
'update_normals(world)
'translate_entity(entity,x,y,z)
'position_entity(entity,x,y,z)
'move_entity(entity,x,y,z)
'rotate_entity(entity,a,b,c)
'turn_entity(entity,a,b,c)
'reset_entity_rotation(entity)
'point_entity(entity,target_entity)
'copy_position(destination_entity,source_entity)
'align_to_vector(entity,vx,vy,vz)
'render_world(world,buffer)
'
'

option explicit

const rad_conv=3.14159265/180.0

#define PTC_WIN
#Include Once "tinyptc.bi"

'==============================================================================
' Binary Font By Shockwave / DBF; (59 Chars)
'==============================================================================
font_data:
'space
data 59
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
'!
data 0,0,0,1,1,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,1,1,1,0,0,0
data 0,0,0,1,1,1,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,1,1,1,0,0,0
data 0,0,0,1,1,1,0,0,0
'"
data 0,1,1,0,1,1,0,0,0
data 0,1,1,0,1,1,0,0,0
data 0,1,1,0,1,1,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
'#
data 0,0,0,0,0,0,0,0,0
data 0,1,1,0,0,0,1,1,0
data 1,1,1,1,1,1,1,1,1
data 0,1,1,0,0,0,1,1,0
data 0,1,1,0,0,0,1,1,0
data 0,1,1,0,0,0,1,1,0
data 1,1,1,1,1,1,1,1,1
data 0,1,1,0,0,0,1,1,0
data 0,0,0,0,0,0,0,0,0
'£
data 0,0,1,1,1,1,0,0,0
data 0,1,1,1,1,1,0,0,0
data 0,1,1,0,0,0,0,0,0
data 0,1,1,0,0,0,0,0,0
data 0,1,1,1,1,0,0,0,0
data 0,1,1,0,0,0,0,0,0
data 0,1,1,0,0,0,0,0,0
data 1,1,1,1,1,1,1,1,0
data 1,1,1,1,1,1,1,1,0
'%
data 0,0,0,0,0,0,0,0,0
data 0,1,1,0,0,0,0,0,0
data 0,1,1,0,0,0,1,0,0
data 0,0,0,0,0,1,0,0,0
data 0,0,0,0,1,0,0,0,0
data 0,0,0,1,0,0,0,0,0
data 0,0,1,0,0,0,1,1,0
data 0,0,0,0,0,0,1,1,0
data 0,0,0,0,0,0,0,0,0
'&
data 0,0,0,1,1,1,0,0,0
data 0,0,1,1,1,1,1,0,0
data 0,0,1,1,0,1,1,0,0
data 0,0,0,1,1,1,0,0,0
data 0,0,1,1,0,1,1,0,0
data 0,1,1,0,0,1,1,1,1
data 0,1,1,1,0,0,1,1,0
data 0,0,1,1,1,1,1,0,0
data 0,0,0,0,1,1,0,0,0
''
data 0,1,1,0,0,0,0,0,0
data 0,1,1,0,0,0,0,0,0
data 0,1,1,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
'(
data 0,0,0,0,0,1,1,1,0
data 0,0,0,0,1,1,1,1,0
data 0,0,0,0,1,1,0,0,0
data 0,0,0,0,1,1,0,0,0
data 0,0,0,0,1,1,1,0,0
data 0,0,0,0,1,1,1,0,0
data 0,0,0,0,1,1,1,0,0
data 0,0,0,0,1,1,1,1,0
data 0,0,0,0,0,1,1,1,0
')
data 0,1,1,1,0,0,0,0,0
data 0,1,1,1,1,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,1,1,1,0,0,0,0
data 0,0,1,1,1,0,0,0,0
data 0,0,1,1,1,0,0,0,0
data 0,1,1,1,1,0,0,0,0
data 0,1,1,1,0,0,0,0,0
'*
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,1,0,0,0,0
data 0,0,1,0,1,0,1,0,0
data 0,0,0,1,1,1,0,0,0
data 0,1,1,1,1,1,1,1,0
data 0,0,0,1,1,1,0,0,0
data 0,0,1,0,1,0,1,0,0
data 0,0,0,0,1,0,0,0,0
data 0,0,0,0,0,0,0,0,0
'+
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,1,0,0,0,0
data 0,0,0,0,1,0,0,0,0
data 0,0,1,1,1,1,1,0,0
data 0,0,0,0,1,1,0,0,0
data 0,0,0,0,1,1,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
''
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,0,1,0,0,0,0
'-
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,1,1,1,1,1,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
'.
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,1,1,0,0,0,0
'/
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,1,0
data 0,0,0,0,0,0,1,1,0
data 0,0,0,0,0,1,1,0,0
data 0,0,0,0,1,1,0,0,0
data 0,0,0,1,1,1,0,0,0
data 0,0,1,1,1,0,0,0,0
data 0,1,1,1,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
'0
data 0,1,1,1,1,1,1,1,0
data 1,1,1,1,1,1,1,1,1
data 1,1,0,0,0,0,1,1,1
data 1,1,0,0,0,1,0,1,1
data 1,1,0,0,1,0,0,1,1
data 1,1,0,1,1,0,0,1,1
data 1,1,1,1,0,0,0,1,1
data 1,1,1,1,1,1,1,1,1
data 0,1,1,1,1,1,1,1,0
'1
data 0,0,0,1,1,0,0,0,0
data 0,0,1,1,1,0,0,0,0
data 0,0,1,1,1,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,1,1,1,0,0,0
data 0,0,0,1,1,1,0,0,0
data 0,0,0,1,1,1,0,0,0
data 0,1,1,1,1,1,1,0,0
data 0,1,1,1,1,1,1,0,0
'2
data 0,0,1,1,1,1,1,1,0
data 0,0,1,1,1,1,1,1,1
data 0,0,0,0,0,0,0,1,1
data 0,0,0,0,0,0,0,1,1
data 0,1,1,1,1,1,1,1,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,1
'3
data 1,1,1,1,1,1,1,1,0
data 1,1,1,1,1,1,1,1,0
data 0,0,0,0,0,0,0,1,1
data 0,0,0,0,0,0,0,1,1
data 0,0,0,0,1,1,1,1,0
data 0,0,0,0,0,0,1,1,1
data 0,0,0,0,0,0,1,1,1
data 1,1,1,1,1,1,1,1,0
data 1,1,1,1,1,1,1,1,0
'4
data 1,1,0,0,0,0,0,0,0
data 1,1,0,0,0,0,0,0,0
data 1,1,0,0,1,1,0,0,0
data 1,1,0,0,1,1,0,0,0
data 1,1,1,1,1,1,1,1,1
data 0,0,0,0,0,1,1,1,0
data 0,0,0,0,0,1,1,1,0
data 0,0,0,0,0,1,1,1,0
data 0,0,0,0,0,1,1,1,0
'5
data 0,1,1,1,1,1,1,0,0
data 0,1,1,1,1,1,1,0,0
data 0,1,1,0,0,0,0,0,0
data 0,1,1,0,0,0,0,0,0
data 0,1,1,1,1,1,1,1,0
data 0,0,0,0,0,0,1,1,1
data 0,0,0,0,0,0,1,1,1
data 1,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,0
'6
data 1,1,0,0,0,0,0,0,0
data 1,1,0,0,0,0,0,0,0
data 1,1,0,0,0,0,0,0,0
data 1,1,0,0,0,0,0,0,0
data 1,1,1,1,1,1,1,1,0
data 1,1,0,0,0,0,1,1,1
data 1,1,0,0,0,0,1,1,1
data 1,1,1,1,1,1,1,1,1
data 0,1,1,1,1,1,1,1,0
'7
data 0,1,1,1,1,1,1,1,1
data 0,1,1,1,1,1,1,1,1
data 0,0,0,0,0,0,0,1,1
data 0,0,0,0,0,0,0,1,1
data 0,0,0,0,1,1,1,1,1
data 0,0,0,0,0,0,1,1,1
data 0,0,0,0,0,1,1,1,0
data 0,0,0,0,0,1,1,1,0
data 0,0,0,0,0,1,1,1,0
'8
data 0,0,1,1,1,1,1,0,0
data 0,1,1,1,1,1,1,1,0
data 0,1,1,0,0,0,1,1,0
data 0,1,1,0,0,0,1,1,0
data 0,0,1,1,1,1,1,0,0
data 1,1,1,0,0,0,1,1,1
data 1,1,0,0,0,0,1,1,1
data 1,1,1,1,1,1,1,1,1
data 0,1,1,1,1,1,1,1,0
'9
data 0,0,1,1,1,1,1,1,1
data 0,1,1,1,1,1,1,1,1
data 0,1,1,0,0,0,0,1,1
data 0,1,1,0,0,0,0,1,1
data 0,0,1,1,1,1,1,1,1
data 0,0,0,0,0,0,1,1,1
data 0,0,0,0,0,0,1,1,1
data 0,0,0,0,0,0,1,1,1
data 0,0,0,0,0,0,1,1,1
':
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,1,1,0,0,0,0
';
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,0,1,0,0,0,0
'<
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,1,1,0,0
data 0,0,0,0,1,1,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,1,1,1,0,0,0,0
data 0,0,0,1,1,1,0,0,0
data 0,0,0,0,1,1,1,0,0
data 0,0,0,0,0,1,1,0,0
data 0,0,0,0,0,0,0,0,0
'=
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,1,1,1,1,1,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,1,1,1,1,1,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
'>
data 0,0,0,0,0,0,0,0,0
data 0,0,1,1,0,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,0,1,1,0,0,0
data 0,0,0,0,1,1,1,0,0
data 0,0,0,1,1,1,0,0,0
data 0,0,1,1,1,0,0,0,0
data 0,1,1,1,0,0,0,0,0
data 0,0,0,0,0,0,0,0,0
'?
data 0,0,1,1,1,1,1,0,0
data 0,1,1,1,1,1,1,1,0
data 0,1,1,0,0,0,1,1,0
data 0,0,0,0,0,0,1,1,0
data 0,0,0,1,1,1,1,0,0
data 0,0,0,1,1,1,0,0,0
data 0,0,0,0,0,0,0,0,0
data 0,0,0,1,1,1,0,0,0
data 0,0,0,1,1,1,0,0,0
'@
data 0,0,0,0,0,0,0,0,0
data 0,0,1,1,1,1,1,0,0
data 0,1,0,0,0,0,0,0,0
data 0,1,0,0,1,1,1,0,0
data 0,1,0,1,0,0,0,1,0
data 0,1,0,1,1,1,0,1,0
data 0,1,0,0,0,0,0,1,0
data 0,0,1,1,1,1,1,0,0
data 0,0,0,0,0,0,0,0,0
'a
data 0,1,1,1,1,1,1,1,0
data 1,1,1,1,1,1,1,1,0
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,1,1,1,1,1,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
'b
data 1,1,1,1,1,1,1,1,0
data 1,1,1,1,1,1,1,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,1,1,1,1,1,1,0
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,0
'c
data 0,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,1
data 1,1,0,0,0,0,0,0,0
data 1,1,0,0,0,0,0,0,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,1,1,1,1,1,1
data 0,1,1,1,1,1,1,1,1
'd
data 1,1,1,1,1,1,1,1,0
data 1,1,1,1,1,1,1,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,0
'e
data 0,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,1
data 1,1,0,0,0,0,0,0,0
data 1,1,0,0,0,0,0,0,0
data 1,1,1,1,1,1,0,0,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,1,1,1,1,1,1
data 0,1,1,1,1,1,1,1,1
'f
data 0,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,1
data 1,1,0,0,0,0,0,0,0
data 1,1,0,0,0,0,0,0,0
data 1,1,1,1,1,1,0,0,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,0,0,0,0,0,0
'g
data 0,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,1
data 1,1,0,0,0,0,0,0,0
data 1,1,0,0,0,0,0,0,0
data 1,1,0,0,0,1,1,1,1
data 1,1,0,0,0,0,1,1,1
data 1,1,0,0,0,0,1,1,1
data 1,1,1,1,1,1,1,1,1
data 0,1,1,1,1,1,1,1,0
'h
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,1,1,1,1,1,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
'i
data 1,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,1
data 0,0,0,1,1,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,1,1,1,0,0,0
data 0,0,0,1,1,1,0,0,0
data 0,0,0,1,1,1,0,0,0
data 1,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,1
'j
data 1,1,1,1,1,1,1,1,0
data 1,1,1,1,1,1,1,1,0
data 0,0,0,0,0,0,0,1,1
data 0,0,0,0,0,0,0,1,1
data 0,0,0,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,0
'k
data 1,1,0,0,0,0,1,1,0
data 1,1,0,0,0,0,1,1,0
data 1,1,0,0,0,0,1,1,0
data 1,1,0,0,0,0,1,1,0
data 1,1,1,1,1,1,1,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
'l
data 1,1,0,0,0,0,0,0,0
data 1,1,0,0,0,0,0,0,0
data 1,1,0,0,0,0,0,0,0
data 1,1,0,0,0,0,0,0,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,1,1,1,1,1,1
data 0,1,1,1,1,1,1,1,1
'm
data 0,1,1,1,0,1,1,1,0
data 1,1,1,1,1,1,1,1,1
data 1,1,0,0,1,0,0,1,1
data 1,1,0,0,1,0,0,1,1
data 1,1,0,0,1,0,0,1,1
data 1,1,1,0,1,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
'n
data 1,1,1,1,1,1,1,1,0
data 1,1,1,1,1,1,1,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1

'o
data 0,1,1,1,1,1,1,1,0
data 1,1,1,1,1,1,1,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,1,1,1,1,1,1
data 0,1,1,1,1,1,1,1,0
'p
data 1,1,1,1,1,1,1,1,0
data 1,1,1,1,1,1,1,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,1,1,1,1,1,1,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,0,0,0,0,0,0
'q
data 0,1,1,1,1,1,1,1,0
data 1,1,1,1,1,1,1,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,1,0,1,1
data 1,1,1,0,0,0,1,1,1
data 1,1,1,1,1,1,1,1,1
data 0,1,1,1,1,1,1,1,0
'r
data 1,1,1,1,1,1,1,1,0
data 1,1,1,1,1,1,1,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,1,1,1,1,1,1,0
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
's
data 0,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,1
data 1,1,0,0,0,0,0,0,0
data 1,1,0,0,0,0,0,0,0
data 0,1,1,1,1,1,1,1,0
data 0,0,0,0,0,0,1,1,1
data 0,0,0,0,0,0,1,1,1
data 1,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,0
't
data 1,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,1
data 0,0,0,1,1,0,0,0,0
data 0,0,0,1,1,0,0,0,0
data 0,0,0,1,1,1,0,0,0
data 0,0,0,1,1,1,0,0,0
data 0,0,0,1,1,1,0,0,0
data 0,0,0,1,1,1,0,0,0
data 0,0,0,1,1,1,0,0,0
'u
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,1,1,1,1,1,1
data 0,1,1,1,1,1,1,1,0
'v
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,1,0,0,1,1,1
data 0,1,1,1,1,1,1,1,0
data 0,0,1,1,1,1,1,0,0
'w
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,1,0,1,0,0,1,1
data 1,1,1,0,1,0,0,1,1
data 1,1,1,0,1,0,0,1,1
data 1,1,1,1,1,1,1,1,1
data 0,1,1,1,0,1,1,1,0
'x
data 0,1,1,0,0,0,1,1,0
data 0,1,1,0,0,0,1,1,0
data 0,1,1,0,0,0,1,1,0
data 0,1,1,0,0,0,1,1,0
data 0,1,1,1,1,1,1,1,0
data 1,1,1,1,0,0,1,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
data 1,1,1,0,0,0,0,1,1
'y
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 1,1,0,0,0,0,0,1,1
data 0,1,1,1,1,1,1,1,1
data 0,0,0,0,0,0,1,1,1
data 0,0,0,0,0,0,1,1,1
data 1,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,0
'z
data 1,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,1
data 0,0,0,0,0,0,0,1,1
data 0,0,0,0,0,0,1,1,1
data 0,1,1,1,1,1,1,1,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,0,0,0,0,0,0
data 1,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,1

type buffer
  Â  wwidth as integer
  Â  height as integer
  Â  argb_buffer as integer pointer
  Â  depth_buffer as single pointer
  Â  font_data as integer pointer
  Â  previous_time as double
end type

type texture
  Â  wwidth as integer
  Â  height as integer
  Â  u_and as integer
  Â  v_and as integer
  Â  u_mult as single
  Â  v_mult as single
  Â  buffer as integer pointer
  Â  mipmap as texture pointer
  Â  next_texture as texture pointer
end type

type vertex
  Â  x as single
  Â  y as single
  Â  z as single
  Â  rx as single
  Â  ry as single
  Â  rz as single
  Â  nx as single
  Â  ny as single
  Â  nz as single
  Â  rnx as single
  Â  rny as single
  Â  rnz as single
  Â  u as single
  Â  v as single
  Â  shade as single
  Â  next_vertex as vertex pointer
end type

type triangle
  Â  v0 as vertex pointer
  Â  v1 as vertex pointer
  Â  v2 as vertex pointer
  Â  nx as single
  Â  ny as single
  Â  nz as single
  Â  texture as texture pointer
  Â  area as single
  Â  next_triangle as triangle pointer
end type

type entity
  Â  x as single
  Â  y as single
  Â  z as single
  Â  ux0 as single
  Â  uy0 as single
  Â  uz0 as single
  Â  ux1 as single
  Â  uy1 as single
  Â  uz1 as single
  Â  ux2 as single
  Â  uy2 as single
  Â  uz2 as single
  Â  first_vertex as vertex pointer
  Â  first_triangle as triangle pointer
  Â  next_entity as entity pointer
end type

type world
  Â  first_mesh as entity pointer
  Â  first_texture as texture pointer
  Â  first_light as entity pointer
  Â  first_camera as entity pointer
  Â  current_camera as entity pointer
  Â  ambient_light as integer
end type

function graphics_3d(byval wwidth as integer,byval height as integer,byval windowname as string="Stonemonkey_3d")as buffer pointer
  Â  If( ptc_open( windowname, wwidth, height ) = 0 ) Then
  Â  Â  Â  End -1
  Â  End If
  Â  dim buffer as buffer pointer=callocate(len(buffer))
  Â  buffer->wwidth=wwidth
  Â  buffer->height=height
  Â  buffer->argb_buffer=callocate(len(integer)*wwidth*height)
  Â  buffer->depth_buffer=callocate(len(single)*wwidth*height)

  Â  dim as integer chars,chrbit,chrdat,char,x,y
  Â  
  Â  restore font_data
  Â  read chars
  Â  buffer->font_data=callocate(len(integer)*chars*9)
  Â  dim as integer pointer font_pointer=buffer->font_data
  Â  for char=0 to chars-1
  Â  Â  Â  for y=0 to 8
  Â  Â  Â  Â  Â  chrdat=0
  Â  Â  Â  Â  Â  for x=0 to 8
  Â  Â  Â  Â  Â  Â  Â  read chrbit
  Â  Â  Â  Â  Â  Â  Â  chrdat=chrdat or((2^x)*chrbit)
  Â  Â  Â  Â  Â  next
  Â  Â  Â  Â  Â  *font_pointer=chrdat
  Â  Â  Â  Â  Â  font_pointer+=1
  Â  Â  Â  next
  Â  next
  Â  function=buffer
end function

sub text(byval buffer as buffer pointer,txt as string,byval x as integer,y as integer)
  Â  dim as integer char,position,chrdat,xx,yy
  Â  dim as integer pointer char_pointer,screen_pointer
  Â  for position=1 to len(txt)
  Â  Â  Â  char=(asc(mid$(txt,position,1))-32)*9
  Â  Â  Â  char_pointer=buffer->font_data+char
  Â  Â  Â  for yy=y to y+8
  Â  Â  Â  Â  Â  screen_pointer=buffer->argb_buffer+(yy*buffer->wwidth+x+(position*10))
  Â  Â  Â  Â  Â  chrdat=*char_pointer
  Â  Â  Â  Â  Â  for xx=x to x+8
  Â  Â  Â  Â  Â  Â  Â  if (chrdat and 1)=1 then *screen_pointer=&hffffff
  Â  Â  Â  Â  Â  Â  Â  chrdat shr=1
  Â  Â  Â  Â  Â  Â  Â  screen_pointer+=1
  Â  Â  Â  Â  Â  next
  Â  Â  Â  Â  Â  char_pointer+=1
  Â  Â  Â  next
  Â  next
end sub

sub close_graphics(byval buffer as buffer pointer)
  Â  deallocate buffer->argb_buffer
  Â  deallocate buffer->depth_buffer
    deallocate buffer->font_data
  Â  deallocate buffer
  Â  ptc_close
end sub

function create_texture(byval world as world pointer,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byval texture_width as integer,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byval texture_height as integer,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byval argb as integer=0)as texture pointer
  Â  dim texture as texture pointer=callocate(len(texture))
  Â  texture->wwidth=texture_width
  Â  texture->height=texture_height
  Â  texture->u_mult=texture_width
  Â  texture->v_mult=texture_width*texture_height
  Â  texture->u_and=texture_width-1
  Â  texture->v_and=(texture_height-1)*texture_width
  Â  texture->buffer=callocate(texture_width*texture_height*len(integer))
  Â  dim x as integer,y as integer,p as integer pointer
  Â  p=texture->buffer
  Â  for y=0 to texture_height-1
  Â  Â  Â  for x=0 to texture_width-1
  Â  Â  Â  Â  Â  *p=argb
  Â  Â  Â  Â  Â  p+=1
  Â  Â  Â  next
  Â  next
  Â  texture->next_texture=world->first_texture
  Â  world->first_texture=texture
  Â  function=texture
end function

sub set_texel(byval texture as texture pointer,byval u as integer,byval v as integer,byval argb as integer)
  Â  *(texture->buffer+(u+v*texture->wwidth))=argb
end sub

function get_texel(byval texture as texture pointer,byval u as integer,byval v as integer)as integer
  Â  function=*(texture->buffer+(u+v*texture->wwidth))
end function

sub mipmap(byval world as world pointer,byval texture as texture pointer)
  Â  if (texture->wwidth<2)or(texture->height<2) then return
  Â  if texture->mipmap=0 then texture->mipmap=create_texture(world,texture->wwidth shr 1,texture->height shr 1)
  Â  dim uu as integer,vv as integer,argb as uinteger,alpha as uinteger,red as integer,gre as integer,blu as integer
  Â  for vv=0 to texture->height-2 step 2
  Â  Â  Â  for uu=0 to texture->wwidth-2 step 2
  Â  Â  Â  Â  Â  argb=get_texel(texture,uu,vv)
  Â  Â  Â  Â  Â  alpha=(argb and &hff000000)shr 24
  Â  Â  Â  Â  Â  red=argb and &hff0000
  Â  Â  Â  Â  Â  gre=argb and &hff00
  Â  Â  Â  Â  Â  blu=argb and &hff
  Â  Â  Â  Â  Â  argb=get_texel(texture,uu+1,vv)
  Â  Â  Â  Â  Â  alpha=alpha+((argb and &hff000000)shr 24)
  Â  Â  Â  Â  Â  red=red+(argb and &hff0000)
  Â  Â  Â  Â  Â  gre=gre+(argb and &hff00)
  Â  Â  Â  Â  Â  blu=blu+(argb and &hff)
  Â  Â  Â  Â  Â  argb=get_texel(texture,uu,vv+1)
  Â  Â  Â  Â  Â  alpha=alpha+((argb and &hff000000)shr 24)
  Â  Â  Â  Â  Â  red=red+(argb and &hff0000)
  Â  Â  Â  Â  Â  gre=gre+(argb and &hff00)
  Â  Â  Â  Â  Â  blu=blu+(argb and &hff)
  Â  Â  Â  Â  Â  argb=get_texel(texture,uu+1,vv+1)
  Â  Â  Â  Â  Â  alpha=alpha+((argb and &hff000000)shr 24)
  Â  Â  Â  Â  Â  red=red+(argb and &hff0000)
  Â  Â  Â  Â  Â  gre=gre+(argb and &hff00)
  Â  Â  Â  Â  Â  blu=blu+(argb and &hff)
  Â  Â  Â  Â  Â  alpha=(alpha shl 22)and &hff000000
  Â  Â  Â  Â  Â  red=(red shr 2)and &hff0000
  Â  Â  Â  Â  Â  gre=(gre shr 2)and &hff00
  Â  Â  Â  Â  Â  blu=(blu shr 2)and &hff
  Â  Â  Â  Â  Â  set_texel(texture->mipmap,uu shr 1,vv shr 1,alpha or red or gre or blu)
  Â  Â  Â  next
  Â  next
  Â  mipmap world,texture->mipmap
end sub

function create_world() as world pointer
  Â  dim world_pointer as world pointer=callocate(len(world))
  Â  function=world_pointer
end function

sub ambient_light(byval world as world pointer,byval level as integer)
  Â  world->ambient_light=level and &hff
end sub

function create_camera(byval world as world pointer) as entity pointer
  Â  dim camera as entity pointer=callocate(len(entity))
  Â  camera->ux0=1.0
  Â  camera->uy1=1.0
  Â  camera->uz2=1.0
  Â  camera->next_entity=world->first_camera
  Â  world->first_camera=camera
  Â  world->current_camera=camera
  Â  function=camera
end function

sub change_camera(byval world as world pointer,byval camera as entity pointer)
  Â  world->current_camera=camera
end sub

function current_camera(byval world as world pointer)as entity pointer
  Â  function=world->current_camera
end function

function create_light(byval world as world pointer) as entity pointer
  Â  dim light as entity pointer=callocate(len(entity))
  Â  light->ux0=1.0
  Â  light->uy1=1.0
  Â  light->uz2=1.0
  Â  light->next_entity=world->first_light
  Â  world->first_light=light
  Â  function=light
end function

function create_mesh(byval world as world pointer) as entity pointer
  Â  dim mesh as entity pointer=callocate(len(entity))
  Â  mesh->ux0=1.0
  Â  mesh->uy1=1.0
  Â  mesh->uz2=1.0
  Â  mesh->next_entity=world->first_mesh
  Â  world->first_mesh=mesh
  Â  function=mesh
end function

function add_vertex(byval mesh as entity pointer,byval x as single,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â byval y as single,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â byval z as single,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â byval u as single=0.0,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â byval v as single=0.0) as vertex pointer
  Â  dim vertex as vertex pointer=callocate(len(vertex))
  Â  vertex->x=x
  Â  vertex->y=y
  Â  vertex->z=z
  Â  vertex->u=u
  Â  vertex->v=v
  Â  vertex->next_vertex=mesh->first_vertex
  Â  mesh->first_vertex=vertex
  Â  function=vertex
end function

sub add_triangle(byval mesh as entity pointer,byval vertex0 as vertex pointer,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byval vertex1 as vertex pointer,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byval vertex2 as vertex pointer,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byval texture as texture pointer)
  Â  dim triangle as triangle pointer=callocate(len(triangle))
  Â  triangle->v0=vertex0
  Â  triangle->v1=vertex1
  Â  triangle->v2=vertex2
  Â  triangle->texture=texture
  Â  triangle->next_triangle=mesh->first_triangle
  Â  mesh->first_triangle=triangle
end sub

private sub update_triangle_normals(byval mesh as entity pointer)
  Â  dim triangle as triangle pointer=mesh->first_triangle
  Â  dim v0 as vertex pointer
  Â  dim v1 as vertex pointer
  Â  dim v2 as vertex pointer
  Â  dim vx0 as single,vy0 as single,vz0 as single
  Â  dim vx1 as single,vy1 as single,vz1 as single
  Â  dim vx as single,vy as single,vz as single,d as single
  Â  while triangle<>0
  Â  Â  Â  v0=triangle->v0
  Â  Â  Â  v1=triangle->v1
  Â  Â  Â  v2=triangle->v2
  Â  Â  Â  vx0=v1->x-v0->x
  Â  Â  Â  vy0=v1->y-v0->y
  Â  Â  Â  vz0=v1->z-v0->z
  Â  Â  Â  vx1=v2->x-v0->x
  Â  Â  Â  vy1=v2->y-v0->y
  Â  Â  Â  vz1=v2->z-v0->z
  Â  Â  Â  vx=vy0*vz1-vz0*vy1
  Â  Â  Â  vy=vz0*vx1-vx0*vz1
  Â  Â  Â  vz=vx0*vy1-vy0*vx1
  Â  Â  Â  d=1.0/Sqr(vx*vx+vy*vy+vz*vz)
  Â  Â  Â  triangle->area=abs((v1->u-v0->u)*(v2->v-v0->v)-(v2->u-v0->u)*(v1->v-v0->v))
  Â  Â  Â  triangle->area*=(triangle->texture->wwidth*triangle->texture->height)
  Â  Â  Â  triangle->nx=vx*d
  Â  Â  Â  triangle->ny=vy*d
  Â  Â  Â  triangle->nz=vz*d
  Â  Â  Â  triangle=triangle->next_triangle
  Â  wend
end sub

private sub update_vertex_normals(byval mesh as entity pointer)
  Â  dim vertex as vertex pointer=mesh->first_vertex
  Â  dim d as single
  Â  dim triangle as triangle pointer=mesh->first_triangle
  Â  while triangle<>0
  Â  Â  Â  triangle->v0->nx+=triangle->nx
  Â  Â  Â  triangle->v0->ny+=triangle->ny
  Â  Â  Â  triangle->v0->nz+=triangle->nz
  Â  Â  Â  triangle->v1->nx+=triangle->nx
  Â  Â  Â  triangle->v1->ny+=triangle->ny
  Â  Â  Â  triangle->v1->nz+=triangle->nz
  Â  Â  Â  triangle->v2->nx+=triangle->nx
  Â  Â  Â  triangle->v2->ny+=triangle->ny
  Â  Â  Â  triangle->v2->nz+=triangle->nz
  Â  Â  Â  triangle=triangle->next_triangle
  Â  wend
  Â  while vertex<>0
  Â  Â  Â  d=1.0/sqr(vertex->nx*vertex->nx+vertex->ny*vertex->ny+vertex->nz*vertex->nz)
  Â  Â  Â  vertex->nx*=d
  Â  Â  Â  vertex->ny*=d
  Â  Â  Â  vertex->nz*=d
  Â  Â  Â  vertex=vertex->next_vertex
  Â  wend
end sub

sub update_normals(byval world as world pointer)
  Â  dim mesh as entity pointer=world->first_mesh
  Â  while mesh<>0
  Â  Â  Â  update_triangle_normals(mesh)
  Â  Â  Â  update_vertex_normals(mesh)
  Â  Â  Â  mesh=mesh->next_entity
  Â  wend
end sub

sub translate_entity(byval entity as entity pointer,byval x as single,byval y as single,byval z as single)
  Â  entity->x+=x
  Â  entity->y+=y
  Â  entity->z+=z
end sub

sub position_entity(byval entity as entity pointer,byval x as single,byval y as single,byval z as single)
  Â  entity->x=x
  Â  entity->y=y
  Â  entity->z=z
end sub

sub move_entity(byval entity as entity pointer,byval x as single,byval y as single,byval z as single)
  Â  entity->x+=x*entity->ux0+y*entity->uy0+z*entity->uz0
  Â  entity->y+=x*entity->ux1+y*entity->uy1+z*entity->uz1
  Â  entity->z+=x*entity->ux2+y*entity->uy2+z*entity->uz2
end sub

sub turn_entity(byval entity as entity pointer,byval b as single,byval a as single,byval c as single)
  Â  dim csa as single=cos(-a*rad_conv)
  Â  dim sna as single=sin(-a*rad_conv)
  Â  dim csb as single=cos(-b*rad_conv)
  Â  dim snb as single=sin(-b*rad_conv)
  Â  dim csc as single=cos(c*rad_conv)
  Â  dim snc as single=sin(c*rad_conv)
  Â  dim x as single
  Â  dim y as single
  Â  dim z as single
  Â  x=entity->ux0*csa+entity->uz0*sna
  Â  z=entity->uz0*csa-entity->ux0*sna
  Â  entity->uz0=z*csb+entity->uy0*snb
  Â  y=entity->uy0*csb-z*snb
  Â  entity->ux0=x*csc+y*snc
  Â  entity->uy0=y*csc-x*snc
  Â  x=entity->ux1*csa+entity->uz1*sna
  Â  z=entity->uz1*csa-entity->ux1*sna
  Â  entity->uz1=z*csb+entity->uy1*snb
  Â  y=entity->uy1*csb-z*snb
  Â  entity->ux1=x*csc+y*snc
  Â  entity->uy1=y*csc-x*snc
  Â  x=entity->ux2*csa+entity->uz2*sna
  Â  z=entity->uz2*csa-entity->ux2*sna
  Â  entity->uz2=z*csb+entity->uy2*snb
  Â  y=entity->uy2*csb-z*snb
  Â  entity->ux2=x*csc+y*snc
  Â  entity->uy2=y*csc-x*snc
end sub

sub rotate_entity(byval entity as entity pointer,byval b as single,byval a as single,byval c as single)
  Â  dim csa as single=cos(a*rad_conv)
  Â  dim sna as single=sin(a*rad_conv)
  Â  dim csb as single=cos(b*rad_conv)
  Â  dim snb as single=sin(b*rad_conv)
  Â  dim csc as single=cos(-c*rad_conv)
  Â  dim snc as single=sin(-c*rad_conv)
  Â  dim x as single
  Â  dim y as single
  Â  dim z as single
  Â  x=entity->ux0*csa+entity->ux2*sna
  Â  z=entity->ux2*csa-entity->ux0*sna
  Â  entity->ux2=z*csb+entity->ux1*snb
  Â  y=entity->ux1*csb-z*snb
  Â  entity->ux0=x*csc+y*snc
  Â  entity->ux1=y*csc-x*snc
  Â  x=entity->uy0*csa+entity->uy2*sna
  Â  z=entity->uy2*csa-entity->uy0*sna
  Â  entity->uy2=z*csb+entity->uy1*snb
  Â  y=entity->uy1*csb-z*snb
  Â  entity->uy0=x*csc+y*snc
  Â  entity->uy1=y*csc-x*snc
  Â  x=entity->uz0*csa+entity->uz2*sna
  Â  z=entity->uz2*csa-entity->uz0*sna
  Â  entity->uz2=z*csb+entity->uz1*snb
  Â  y=entity->uz1*csb-z*snb
  Â  entity->uz0=x*csc+y*snc
  Â  entity->uz1=y*csc-x*snc
end sub

sub reset_entity_rotation(byval entity as entity pointer)
  Â  entity->ux0=1.0
  Â  entity->uy0=0.0
  Â  entity->uz0=0.0
  Â  entity->ux1=0.0
  Â  entity->uy1=1.0
  Â  entity->uz1=0.0
  Â  entity->ux2=0.0
  Â  entity->uy2=0.0
  Â  entity->uz2=1.0
end sub

Function point_entity(byval entity as entity pointer,byval target as entity pointer,byval roll as single=0.0)
  Â  dim tx as single=target->x-entity->x
  Â  dim ty as single=target->y-entity->y
  Â  dim tz as single=target->z-entity->z
  Â  reset_entity_rotation(entity)
turn_entity entity,-ATan2(ty,Sqr(tx*tx+tz*tz))/rad_conv,ATan2(tx,tz)/rad_conv,roll
End Function

sub copy_position(byval dest as entity pointer,byval source as entity pointer)
  Â  dest->x=source->x
  Â  dest->y=source->y
  Â  dest->z=source->z
end sub

sub copy_rotation(byval dest as entity pointer,byval source as entity pointer)
  Â  dest->ux0=source->ux0
  Â  dest->uy0=source->uy0
  Â  dest->uz0=source->uz0
  Â  dest->ux1=source->ux1
  Â  dest->uy1=source->uy1
  Â  dest->uz1=source->uz1
  Â  dest->ux2=source->ux2
  Â  dest->uy2=source->uy2
  Â  dest->uz2=source->uz2
end sub

Function align_to_vector(byval entity as entity pointer,byval vx as single,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byval vy as single,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byval vz as single,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byval axis as integer,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byval speed as single=1.0)
  Â  dim x as single,y as single,z as single
  Â  dim a as single,b as single,c as single
  Â  select case axis
  Â  case 1
  Â  Â  Â  turn_entity entity,-90,0,0
  Â  case 2
  Â  Â  Â  turn_entity entity,0,-90,0
  Â  end select
  Â  x=vx*entity->ux0+vy*entity->ux1+vz*entity->ux2
  Â  y=vx*entity->uy0+vy*entity->uy1+vz*entity->uy2
  Â  z=vx*entity->uz0+vy*entity->uz1+vz*entity->uz2
  Â  a=atan2(-y,z)/rad_conv
  Â  b=atan2(x,z)/rad_conv
  Â  c=0
  Â  turn_entity entity,a*speed,b*speed,c*speed
  Â  select case axis
  Â  case 1
  Â  Â  Â  turn_entity entity,90,0,0
  Â  case 2
  Â  Â  Â  turn_entity entity,0,90,0
  Â  end select
End Function

type render_vertex
  Â  z as single
  Â  x as single
  Â  y as single
  Â  u as single
  Â  v as single
  Â  s as single
end type

type render_edge
  Â  x as single
  Â  dx as single
  Â  z as single
  Â  dz as single
  Â  u as single
  Â  du as single
  Â  v as single
  Â  dv as single
  Â  s as single
  Â  ds as single
end type

private sub render_triangle(byval y_start as integer,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byval y_end as integer,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byref ledge as render_edge,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byref redge as render_edge,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byval buffer as buffer pointer,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byval ambient as integer,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byval texture as texture pointer)
  Â  dim as integer x_start,x_end,uu,vv,sh,argb,rbl,gre
  Â  dim as single zz,z,dz,u,du,v,dv,s,ds,d
  Â  dim depth_pointer as single pointer
  Â  while y_start<=y_end

  Â  Â  Â  d=1.0/(redge.x-ledge.x)
  Â  Â  Â  dz=(redge.z-ledge.z)*d
  Â  Â  Â  du=(redge.u-ledge.u)*d
  Â  Â  Â  dv=(redge.v-ledge.v)*d
  Â  Â  Â  ds=(redge.s-ledge.s)*d
  Â  Â  Â  z=ledge.z
  Â  Â  Â  u=ledge.u
  Â  Â  Â  v=ledge.v
  Â  Â  Â  s=ledge.s

  Â  Â  Â  x_start=ledge.x+0.5
  Â  Â  Â  x_end=redge.x-0.5
  Â  Â  Â  
  Â  Â  Â  if x_start<0 then x_start=0
  Â  Â  Â  if x_end>=buffer->wwidth then x_end=buffer->wwidth-1
  Â  Â  Â  
  Â  Â  Â  d=x_start-ledge.x
  Â  Â  Â  z+=dz*d
  Â  Â  Â  u+=du*d
  Â  Â  Â  v+=dv*d
  Â  Â  Â  s+=ds*d

  Â  Â  Â  depth_pointer=buffer->depth_buffer+(x_start+y_start*buffer->wwidth)
  Â  Â  Â  while x_start<=x_end
  Â  Â  Â  Â  Â  if z>*depth_pointer then
  Â  Â  Â  Â  Â  Â  Â  *depth_pointer=z
  Â  Â  Â  Â  Â  Â  Â  zz=1.0/z
  Â  Â  Â  Â  Â  Â  Â  uu=(u*zz)and texture->u_and
  Â  Â  Â  Â  Â  Â  Â  vv=(v*zz)and texture->v_and
  Â  Â  Â  Â  Â  Â  Â  sh=s*zz
  Â  Â  Â  Â  Â  Â  Â  if sh<ambient then sh=ambient
  Â  Â  Â  Â  Â  Â  Â  argb=*(texture->buffer+(uu or vv))
  Â  Â  Â  Â  Â  Â  Â  rbl=((argb and &hff00ff)*sh)and &hff00ff00
  Â  Â  Â  Â  Â  Â  Â  gre=((argb and &hff00)*sh)and &hff0000
  Â  Â  Â  Â  Â  Â  Â  *(buffer->argb_buffer+(x_start+y_start*buffer->wwidth))=(rbl or gre)shr 8
  Â  Â  Â  Â  Â  end if
  Â  Â  Â  Â  Â  z+=dz
  Â  Â  Â  Â  Â  u+=du
  Â  Â  Â  Â  Â  v+=dv
  Â  Â  Â  Â  Â  s+=ds
  Â  Â  Â  Â  Â  depth_pointer+=1
  Â  Â  Â  Â  Â  x_start+=1
  Â  Â  Â  wend
  Â  Â  Â  ledge.x+=ledge.dx
  Â  Â  Â  ledge.z+=ledge.dz
  Â  Â  Â  ledge.u+=ledge.du
  Â  Â  Â  ledge.v+=ledge.dv
  Â  Â  Â  ledge.s+=ledge.ds
  Â  Â  Â  redge.x+=redge.dx
  Â  Â  Â  redge.z+=redge.dz
  Â  Â  Â  redge.u+=redge.du
  Â  Â  Â  redge.v+=redge.dv
  Â  Â  Â  redge.s+=redge.ds
  Â  Â  Â  y_start+=1
  Â  wend
end sub

private sub setup_textured_triangle(byval triangle as triangle pointer,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byval buffer as buffer pointer,_
  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  Â  byval ambient as integer)
  Â  dim as vertex pointer v0=triangle->v0,v1=triangle->v1,v2=triangle->v2
  Â  dim v(0 to 2) as render_vertex
  Â  v(0).z=1.0/v0->rz
  Â  v(0).x=(buffer->wwidth shr 1)+(v0->rx*v(0).z*buffer->wwidth)
  Â  v(0).y=(buffer->height shr 1)-(v0->ry*v(0).z*buffer->wwidth)
  Â  v(1).z=1.0/v1->rz
  Â  v(1).x=(buffer->wwidth shr 1)+(v1->rx*v(1).z*buffer->wwidth)
  Â  v(1).y=(buffer->height shr 1)-(v1->ry*v(1).z*buffer->wwidth)
  Â  v(2).z=1.0/v2->rz
  Â  v(2).x=(buffer->wwidth shr 1)+(v2->rx*v(2).z*buffer->wwidth)
  Â  v(2).y=(buffer->height shr 1)-(v2->ry*v(2).z*buffer->wwidth)
  Â  
  Â  
  Â  if (v(1).x-v(0).x)*(v(2).y-v(0).y)>(v(2).x-v(0).x)*(v(1).y-v(0).y) then

  Â  Â  Â  dim area as single=((v(1).x-v(0).x)*(v(2).y-v(0).y)-(v(2).x-v(0).x)*(v(1).y-v(0).y))*2.0
  Â  Â  Â  dim texture as texture pointer=triangle->texture
  Â  Â  Â  while (area<triangle->area)and(texture->mipmap<>0)
  Â  Â  Â  Â  Â  texture=texture->mipmap
  Â  Â  Â  Â  Â  area*=4.0
  Â  Â  Â  wend

  Â  Â  Â  v(0).u=(v0->u*texture->u_mult-.5)*v(0).z
  Â  Â  Â  v(0).v=(v0->v*texture->v_mult-.5)*v(0).z
  Â  Â  Â  v(0).s=v0->shade*v(0).z
  Â  Â  Â  v(1).u=(v1->u*texture->u_mult-.5)*v(1).z
  Â  Â  Â  v(1).v=(v1->v*texture->v_mult-.5)*v(1).z
  Â  Â  Â  v(1).s=v1->shade*v(1).z
  Â  Â  Â  v(2).u=(v2->u*texture->u_mult-.5)*v(2).z
  Â  Â  Â  v(2).v=(v2->v*texture->v_mult-.5)*v(2).z
  Â  Â  Â  v(2).s=v2->shade*v(2).z
  Â  Â  Â  
  Â  Â  Â  dim as integer p0,p1,p2
  Â  
  Â  Â  Â  p0=0
  Â  Â  Â  if v(1).y<v(0).y then p0=1
  Â  Â  Â  if v(2).y<v(p0).y then p0=2
  Â  Â  Â  p2=2
  Â  Â  Â  if v(1).y>v(2).y then p2=1
  Â  Â  Â  if v(0).y>v(p2).y then p2=0
  Â  Â  Â  p1=3-p0-p2
  Â  
  Â  Â  Â  dim edge0 as render_edge,edge1 as render_edge

  Â  Â  Â  dim d as single,y_start as integer,y_end as integer
  Â  Â  Â  if (v(p0).y<buffer->height)and(v(p1).y>=0.0) then
  Â  Â  Â  Â  Â  d=1.0/(v(p1).y-v(p0).y)
  Â  Â  Â  Â  Â  edge0.dx=(v(p1).x-v(p0).x)*d
  Â  Â  Â  Â  Â  edge0.dz=(v(p1).z-v(p0).z)*d
  Â  Â  Â  Â  Â  edge0.du=(v(p1).u-v(p0).u)*d
  Â  Â  Â  Â  Â  edge0.dv=(v(p1).v-v(p0).v)*d
  Â  Â  Â  Â  Â  edge0.ds=(v(p1).s-v(p0).s)*d
  Â  Â  Â  Â  Â  d=1.0/(v(p2).y-v(p0).y)
  Â  Â  Â  Â  Â  edge1.dx=(v(p2).x-v(p0).x)*d
  Â  Â  Â  Â  Â  edge1.dz=(v(p2).z-v(p0).z)*d
  Â  Â  Â  Â  Â  edge1.du=(v(p2).u-v(p0).u)*d
  Â  Â  Â  Â  Â  edge1.dv=(v(p2).v-v(p0).v)*d
  Â  Â  Â  Â  Â  edge1.ds=(v(p2).s-v(p0).s)*d
  Â  Â  Â  Â  Â  y_start=v(p0).y+.5
  Â  Â  Â  Â  Â  if y_start<0 then y_start=0
  Â  Â  Â  Â  Â  y_end=v(p1).y-.5
  Â  Â  Â  Â  Â  if y_end>=buffer->height then y_end=buffer->height-1
  Â  Â  Â  Â  Â  d=y_start-v(p0).y
  Â  Â  Â  Â  Â  edge0.x=v(p0).x+edge0.dx*d
  Â  Â  Â  Â  Â  edge0.z=v(p0).z+edge0.dz*d
  Â  Â  Â  Â  Â  edge0.u=v(p0).u+edge0.du*d
  Â  Â  Â  Â  Â  edge0.v=v(p0).v+edge0.dv*d
  Â  Â  Â  Â  Â  edge0.s=v(p0).s+edge0.ds*d
  Â  Â  Â  Â  Â  edge1.x=v(p0).x+edge1.dx*d
  Â  Â  Â  Â  Â  edge1.z=v(p0).z+edge1.dz*d
  Â  Â  Â  Â  Â  edge1.u=v(p0).u+edge1.du*d
  Â  Â  Â  Â  Â  edge1.v=v(p0).v+edge1.dv*d
  Â  Â  Â  Â  Â  edge1.s=v(p0).s+edge1.ds*d
  Â  Â  Â  Â  Â  if edge1.dx>edge0.dx then
  Â  Â  Â  Â  Â  Â  Â  render_triangle y_start,y_end,edge0,edge1,buffer,ambient,texture
  Â  Â  Â  Â  Â  else
  Â  Â  Â  Â  Â  Â  Â  render_triangle y_start,y_end,edge1,edge0,buffer,ambient,texture
  Â  Â  Â  Â  Â  end if
  Â  Â  Â  end if
  Â  Â  Â  if (v(p1).y<buffer->height)and(v(p2).y>=0.0) then

  Â  Â  Â  Â  Â  d=1.0/(v(p2).y-v(p0).y)
  Â  Â  Â  Â  Â  edge0.dx=(v(p2).x-v(p0).x)*d
  Â  Â  Â  Â  Â  edge0.dz=(v(p2).z-v(p0).z)*d
  Â  Â  Â  Â  Â  edge0.du=(v(p2).u-v(p0).u)*d
  Â  Â  Â  Â  Â  edge0.dv=(v(p2).v-v(p0).v)*d
  Â  Â  Â  Â  Â  edge0.ds=(v(p2).s-v(p0).s)*d
  Â  Â  Â  Â  Â  d=1.0/(v(p2).y-v(p1).y)
  Â  Â  Â  Â  Â  edge1.dx=(v(p2).x-v(p1).x)*d
  Â  Â  Â  Â  Â  edge1.dz=(v(p2).z-v(p1).z)*d
  Â  Â  Â  Â  Â  edge1.du=(v(p2).u-v(p1).u)*d
  Â  Â  Â  Â  Â  edge1.dv=(v(p2).v-v(p1).v)*d
  Â  Â  Â  Â  Â  edge1.ds=(v(p2).s-v(p1).s)*d
  Â  Â  Â  Â  Â  y_start=v(p1).y+.5
  Â  Â  Â  Â  Â  if y_start<0 then y_start=0
  Â  Â  Â  Â  Â  y_end=v(p2).y-.5
  Â  Â  Â  Â  Â  if y_end>=buffer->height then y_end=buffer->height-1
  Â  Â  Â  Â  Â  d=y_start-v(p2).y
  Â  Â  Â  Â  Â  edge0.x=v(p2).x+edge0.dx*d
  Â  Â  Â  Â  Â  edge0.z=v(p2).z+edge0.dz*d
  Â  Â  Â  Â  Â  edge0.u=v(p2).u+edge0.du*d
  Â  Â  Â  Â  Â  edge0.v=v(p2).v+edge0.dv*d
  Â  Â  Â  Â  Â  edge0.s=v(p2).s+edge0.ds*d
  Â  Â  Â  Â  Â  edge1.x=v(p2).x+edge1.dx*d
  Â  Â  Â  Â  Â  edge1.z=v(p2).z+edge1.dz*d
  Â  Â  Â  Â  Â  edge1.u=v(p2).u+edge1.du*d
  Â  Â  Â  Â  Â  edge1.v=v(p2).v+edge1.dv*d
  Â  Â  Â  Â  Â  edge1.s=v(p2).s+edge1.ds*d
  Â  Â  Â  Â  Â  if edge1.dx>edge0.dx then
  Â  Â  Â  Â  Â  Â  Â  render_triangle y_start,y_end,edge1,edge0,buffer,ambient,texture
  Â  Â  Â  Â  Â  else
  Â  Â  Â  Â  Â  Â  Â  render_triangle y_start,y_end,edge0,edge1,buffer,ambient,texture
  Â  Â  Â  Â  Â  end if
  Â  Â  Â  end if
  Â  end if
end sub

private sub mesh_render(byval world as world pointer,byval buffer as buffer pointer)
  Â  dim mesh as entity pointer=world->first_mesh
  Â  dim triangle as triangle pointer
  Â  while mesh<>0
  Â  Â  Â  triangle=mesh->first_triangle
  Â  Â  Â  while triangle<>0
  Â  Â  Â  Â  Â  if (triangle->v0->rz>0.0)and _
  Â  Â  Â  Â  Â  Â  Â (triangle->v1->rz>0.0)and _
  Â  Â  Â  Â  Â  Â  Â (triangle->v2->rz>0.0) then setup_textured_triangle triangle,buffer,world->ambient_light
  Â  Â  Â  Â  Â  triangle=triangle->next_triangle
  Â  Â  Â  wend
  Â  Â  Â  mesh=mesh->next_entity
  Â  wend
end sub

private sub update_geometry(byval world as world pointer)
  Â  dim mesh as entity pointer=world->first_mesh
  Â  dim camera as entity pointer=world->current_camera
  Â  dim as single cam_xt,cam_yt,cam_zt,ox,oy,oz
  Â  dim as single light_xt,light_yt,light_zt,lx,ly,lz,d
  Â  dim as single ux0,uy0,uz0,ux1,uy1,uz1,ux2,uy2,uz2
  Â  light_xt=world->first_light->x-camera->x
  Â  light_yt=world->first_light->y-camera->y
  Â  light_zt=world->first_light->z-camera->z
  Â  lx=camera->ux0*light_xt+camera->ux1*light_yt+camera->ux2*light_zt
  Â  ly=camera->uy0*light_xt+camera->uy1*light_yt+camera->uy2*light_zt
  Â  lz=camera->uz0*light_xt+camera->uz1*light_yt+camera->uz2*light_zt
  Â  dim vertex as vertex pointer
  Â  while mesh<>0
  Â  Â  Â  cam_xt=mesh->x-camera->x
  Â  Â  Â  cam_yt=mesh->y-camera->y
  Â  Â  Â  cam_zt=mesh->z-camera->z
  Â  Â  Â  ox=camera->ux0*cam_xt+camera->ux1*cam_yt+camera->ux2*cam_zt
  Â  Â  Â  oy=camera->uy0*cam_xt+camera->uy1*cam_yt+camera->uy2*cam_zt
  Â  Â  Â  oz=camera->uz0*cam_xt+camera->uz1*cam_yt+camera->uz2*cam_zt
  Â  Â  Â  ux0=camera->ux0*mesh->ux0+camera->ux1*mesh->ux1+camera->ux2*mesh->ux2
  Â  Â  Â  ux1=camera->ux0*mesh->uy0+camera->ux1*mesh->uy1+camera->ux2*mesh->uy2
  Â  Â  Â  ux2=camera->ux0*mesh->uz0+camera->ux1*mesh->uz1+camera->ux2*mesh->uz2
  Â  Â  Â  uy0=camera->uy0*mesh->ux0+camera->uy1*mesh->ux1+camera->uy2*mesh->ux2
  Â  Â  Â  uy1=camera->uy0*mesh->uy0+camera->uy1*mesh->uy1+camera->uy2*mesh->uy2
  Â  Â  Â  uy2=camera->uy0*mesh->uz0+camera->uy1*mesh->uz1+camera->uy2*mesh->uz2
  Â  Â  Â  uz0=camera->uz0*mesh->ux0+camera->uz1*mesh->ux1+camera->uz2*mesh->ux2
  Â  Â  Â  uz1=camera->uz0*mesh->uy0+camera->uz1*mesh->uy1+camera->uz2*mesh->uy2
  Â  Â  Â  uz2=camera->uz0*mesh->uz0+camera->uz1*mesh->uz1+camera->uz2*mesh->uz2
  Â  Â  Â  vertex=mesh->first_vertex
  Â  Â  Â  while vertex<>0
  Â  Â  Â  Â  Â  vertex->rx=vertex->x*ux0+vertex->y*ux1+vertex->z*ux2+ox
  Â  Â  Â  Â  Â  vertex->ry=vertex->x*uy0+vertex->y*uy1+vertex->z*uy2+oy
  Â  Â  Â  Â  Â  vertex->rz=vertex->x*uz0+vertex->y*uz1+vertex->z*uz2+oz
  Â  Â  Â  Â  Â  vertex->rnx=vertex->nx*ux0+vertex->ny*ux1+vertex->nz*ux2
  Â  Â  Â  Â  Â  vertex->rny=vertex->nx*uy0+vertex->ny*uy1+vertex->nz*uy2
  Â  Â  Â  Â  Â  vertex->rnz=vertex->nx*uz0+vertex->ny*uz1+vertex->nz*uz2
  Â  Â  Â  Â  Â  light_xt=lx-vertex->rx
  Â  Â  Â  Â  Â  light_yt=ly-vertex->ry
  Â  Â  Â  Â  Â  light_zt=lz-vertex->rz
  Â  Â  Â  Â  Â  d=1.0/sqr(light_xt^2+light_yt^2+light_zt^2)
  Â  Â  Â  Â  Â  light_xt*=d
  Â  Â  Â  Â  Â  light_yt*=d
  Â  Â  Â  Â  Â  light_zt*=d
  Â  Â  Â  Â  Â  vertex->shade=255.0*(light_xt*vertex->rnx+light_yt*vertex->rny+light_zt*vertex->rnz)
  Â  Â  Â  Â  Â  vertex=vertex->next_vertex
  Â  Â  Â  wend
  Â  Â  Â  mesh=mesh->next_entity
  Â  wend
end sub

private sub clear_buffers(byval buffer as buffer pointer)
  Â  dim as integer x,y
  Â  dim as integer pointer argb_pointer=buffer->argb_buffer
  Â  dim as single pointer depth_pointer=buffer->depth_buffer
  Â  for y=0 to buffer->height-1
  Â  Â  Â  for x=0 to buffer->wwidth-1
  Â  Â  Â  Â  Â  *argb_pointer=0
  Â  Â  Â  Â  Â  *depth_pointer=0.0
  Â  Â  Â  Â  Â  argb_pointer+=1
  Â  Â  Â  Â  Â  depth_pointer+=1
  Â  Â  Â  next
  Â  next
end sub

sub render_world(byval world as world pointer,byval buffer as buffer pointer)
  Â  clear_buffers buffer
  Â  update_geometry world
  Â  mesh_render world,buffer
  Â  dim time_diff as double=timer-buffer->previous_time
  Â  buffer->previous_time=timer
  Â  text buffer,"FPS: "+left$(str$(1.0/time_diff),4),10,20
  Â  ptc_update buffer->argb_buffer
end sub

sub delete_world(byval world as world pointer)
  Â  dim to_delete as any pointer
  Â  dim texture as texture pointer=world->first_texture
  Â  while texture<>0
  Â  Â  Â  to_delete=texture
  Â  Â  Â  texture=texture->next_texture
  Â  Â  Â  deallocate to_delete
  Â  wend
  Â  dim vertex as vertex pointer,triangle as triangle pointer
  Â  dim entity as entity pointer=world->first_light
  Â  while entity<>0
  Â  Â  Â  to_delete=entity
  Â  Â  Â  entity=entity->next_entity
  Â  Â  Â  deallocate to_delete
  Â  wend
  Â  entity=world->first_camera
  Â  while entity<>0
  Â  Â  Â  to_delete=entity
  Â  Â  Â  entity=entity->next_entity
  Â  Â  Â  deallocate to_delete
  Â  wend
  Â  entity=world->first_mesh
  Â  while entity<>0
  Â  Â  Â  vertex=entity->first_vertex
  Â  Â  Â  while vertex<>0
  Â  Â  Â  Â  Â  to_delete=vertex
  Â  Â  Â  Â  Â  vertex=vertex->next_vertex
  Â  Â  Â  Â  Â  deallocate to_delete
  Â  Â  Â  wend
  Â  Â  Â  triangle=entity->first_triangle
  Â  Â  Â  while triangle<>0
  Â  Â  Â  Â  Â  to_delete=triangle
  Â  Â  Â  Â  Â  triangle=triangle->next_triangle
  Â  Â  Â  Â  Â  deallocate to_delete
  Â  Â  Â  wend
  Â  Â  Â  to_delete=entity
  Â  Â  Â  entity=entity->next_entity
  Â  Â  Â  deallocate to_delete
  Â  wend
  Â  deallocate world
end sub


[Stonemonkey]

and a small demo of it in use:

Code: [Select]

#include "stonemonkey3d.bas"

function create_cube(byval world as world pointer)as entity pointer
    dim texture1 as texture pointer=create_texture(world,64,64)
    dim as integer u,v
    for v=0 to 63
        for u=0 to 63
            set_texel texture1,u,v,rnd*&hffffff
        next
    next
    dim texture2 as texture pointer=create_texture(world,256,256)
    for v=0 to 255
        for u=0 to 255
            set_texel texture2,u,v,(u shl 16)or v
            if (v=100)or(v=110)or(v=115) then set_texel texture2,u,v,&hffffff
        next
    next
    dim texture3 as texture pointer=create_texture(world,1,1,&hff00)
    dim vert(0 to 3) as vertex pointer
   
    mipmap world,texture1
    mipmap world,texture2
    dim mesh as entity pointer=create_mesh(world)
    vert(0)=add_vertex(mesh,-100,-100,-100,0,1)
    vert(1)=add_vertex(mesh,-100, 100,-100,0,0)
    vert(2)=add_vertex(mesh, 100, 100,-100,1,0)
    vert(3)=add_vertex(mesh, 100,-100,-100,1,1)
    add_triangle mesh,vert(0),vert(1),vert(2),texture1
    add_triangle mesh,vert(2),vert(3),vert(0),texture1
   
    vert(0)=add_vertex(mesh,-100,-100, 100,0,1)
    vert(1)=add_vertex(mesh,-100, 100, 100,0,0)
    vert(2)=add_vertex(mesh,-100, 100,-100,1,0)
    vert(3)=add_vertex(mesh,-100,-100,-100,1,1)
    add_triangle mesh,vert(0),vert(1),vert(2),texture2
    add_triangle mesh,vert(2),vert(3),vert(0),texture2
   
    vert(0)=add_vertex(mesh, 100,-100, 100,0,1)
    vert(1)=add_vertex(mesh, 100, 100, 100,0,0)
    vert(2)=add_vertex(mesh,-100, 100, 100,1,0)
    vert(3)=add_vertex(mesh,-100,-100, 100,1,1)
    add_triangle mesh,vert(0),vert(1),vert(2),texture1
    add_triangle mesh,vert(2),vert(3),vert(0),texture1
   
    vert(0)=add_vertex(mesh, 100,-100,-100,0,1)
    vert(1)=add_vertex(mesh, 100, 100,-100,0,0)
    vert(2)=add_vertex(mesh, 100, 100, 100,1,0)
    vert(3)=add_vertex(mesh, 100,-100, 100,1,1)
    add_triangle mesh,vert(0),vert(1),vert(2),texture2
    add_triangle mesh,vert(2),vert(3),vert(0),texture2
   
    vert(0)=add_vertex(mesh,-100, 100,-100,0,1)
    vert(1)=add_vertex(mesh,-100, 100, 100,0,0)
    vert(2)=add_vertex(mesh, 100, 100, 100,1,0)
    vert(3)=add_vertex(mesh, 100, 100,-100,1,1)
    add_triangle mesh,vert(0),vert(1),vert(2),texture3
    add_triangle mesh,vert(2),vert(3),vert(0),texture3
   
    vert(0)=add_vertex(mesh,-100,-100, 100,0,1)
    vert(1)=add_vertex(mesh,-100,-100,-100,0,0)
    vert(2)=add_vertex(mesh, 100,-100,-100,1,0)
    vert(3)=add_vertex(mesh, 100,-100, 100,1,1)
    add_triangle mesh,vert(0),vert(1),vert(2),texture3
    add_triangle mesh,vert(2),vert(3),vert(0),texture3
    function=mesh
end function

sub main
   
'these lines are essential otherwise program will close/crash on render_world call
    dim buffer as buffer pointer=graphics_3d(640,480,"Test")
    dim world as world pointer=create_world()
    dim light as entity pointer=create_light(world)
    dim camera as entity pointer=create_camera(world)
   
'create/setup your world
    ambient_light world,20
    dim cube(0 to 100) as entity pointer,i as integer
    for i=0 to 100
        cube(i)=create_cube(world)
        position_entity cube(i),rnd*2000-1000,rnd*2000-1000,rnd*2000-1000
        turn_entity cube(i),rnd*360,rnd*360,rnd*360
    next
    position_entity light,2000,2000,-500
    move_entity current_camera(world),0,0,-4000

'essential for lighting to work
    update_normals world
   
'main loop
    do
       
'move and turn camera sideways
        turn_entity camera,0,-.8,0
        move_entity camera,50,0,0
       
'move cubes
        for i=0 to 100
            move_entity cube(i),0,0,4
            turn_entity cube(i),0,.5,0
        next
       
        render_world(world,buffer)
    LOOP UNTIL INKEY$<>""
   
'these lines are essential (earlier windows don't take care of garbage collection afaik)
    delete_world world
    close_graphics(buffer)

end sub

main


[Clyde]

That is pure genius, thanks and welldone indeed Stonemonkey dude

[Stonemonkey]

Thanks Clyde, I've tried to simplify and tidy the code and it's use and removed all the asm so it's in pure FB code. Not quite as efficient as it could be but should be pretty much bug free.

[Shockwave]

It worked fine here without a hitch, it was fast too.
Great 3D engine there, thank you very much for posting the source

[Stonemonkey]

Cool If anyone's interested I could do some more work on this and add some other bits n pieces. Something that would be cool is if someone that knows about 3d files could put together some kind of loader.

[Rbz]

Great one ! 

[Clyde]

Yeah, I'd be interested in expansions dude.

Btw, how does this snippet of code work dude?

Code: [Select]

    function=mesh

Really ace going.
Clyde.

[Blitz Amateur]

I don't know too much about 3D model file structure, but I've looked into loaders before. I might be willing to give it a shot though. What sorts of filetypes are you looking at?

[Stonemonkey]

Hi Blitz amateur, it would be great if you could give that a go and as for the filetype, anything at all would be handy.

Clyde, that piece of code returns the pointer to the mesh created within the function.

BTW, just edited the code above (both the engine and the demo) and it now has mipmapping. If you REM out the 2 mipmap calls in the create_cube function you'll see the difference it makes to the appearance of the randomly generated texture and to the fine white lines across the red/blue texture.

[Shockwave]

Seems to run a little bit nicer with the mipmapping, I'm not sure if the refresh rate is better but I think it is because it seems smoother and the textures definately look much better.

[Stonemonkey]

I think the framerate is slightly better (should put in a counter to check), the reason being that each mipmap is 1/4 the size of the one above so there's smaller amounts of memory to access when drawing each tri.

[Shockwave]

Yep, the trouble with adding an fps counter when you're using tinyptc is that you'll need to display the fps and since there's no text command you're stuffed.
I've attached a zip file of a binary font I did, feel free to use it.
It's 8*8 and all in ascii order so it's easy to incorporate.
I also made a text function if you want it to save you the hassle of writing one.

[Stonemonkey]

Thanks shockwave, I'll use the font but gonna think up some way of fitting the text function in with the rest of the code. Probably have it linked with the graphics buffer.

[Stonemonkey]

OK, added a text function but only for debugging atm and not a user function. There is a bit of a difference in fps when mipmapping.
Thanks for the font shockwave although had me a bit confused until i noticed that it's 9*9.

[Clyde]

Stoney dude, dont suppose you could attach those ace code listings. As Mr Copy And Paste keeps messing me about, hehehe.

Can't wait to try the updates.

I remember someplace there being a milkshape ascii loader around in BB. It may of got wiped with the ezboard crash.

Cheers,
Clyde.

[Stonemonkey]

Here you go.

EDIT: slightly updated.

[Clyde]

Wicked one and thanks bud.
I'll have to test this out on my home PC, my parents one has a naff gfx card (Nvidia Vanta Lt) shows 16 fps. But looks incredible.

Welldone StoneMonkey Dude,
Cheers and all the best,
Clyde.

[Stonemonkey]

Try reducing the number of cubes, something like 50.
Just reduce the 2

For i=0 to 100

loops in main to

for i=0 to 50

That might speed things up a little

[Clyde]

Ok, bud. Will do.
Just a thought Rbaz's and my Loadbitmap snippet might be neat to include.