Dark Bit Factory & Gravity

PROGRAMMING => Freebasic => Topic started by: Stonemonkey on May 13, 2006

Title: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 13, 2006
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
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 13, 2006
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
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Clyde on May 13, 2006
That is pure genius, thanks and welldone indeed Stonemonkey dude :)
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 13, 2006
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.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Shockwave on May 13, 2006
It worked fine here without a hitch, it was fast too.
Great 3D engine there, thank you very much for posting the source :)
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 13, 2006
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.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Rbz on May 13, 2006
Great one !  ;D
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Clyde on May 13, 2006
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.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Blitz Amateur on May 13, 2006
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?
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 13, 2006
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.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Shockwave on May 13, 2006
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.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 13, 2006
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.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Shockwave on May 13, 2006
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.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 13, 2006
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.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 13, 2006
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.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Clyde on May 13, 2006
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.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 13, 2006
Here you go.

EDIT: slightly updated.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Clyde on May 13, 2006
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.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 13, 2006
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
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Clyde on May 13, 2006
Ok, bud. Will do.
Just a thought Rbaz's and my Loadbitmap snippet might be neat to include.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Shockwave on May 13, 2006
Whoops! Sorry, I forgot that the font was 9*9!!
Getting 54 - 65 fps
P4 3.0ghz Radeon X300se 128mb, 512mb ram.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 14, 2006
good framerate, there's not much in the way of optimisation atm.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Clyde on May 14, 2006
Wouldnt worry about optimizing it buddy, I wouldnt think you could. Fantastic work.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 14, 2006
I think I can make some improvements on it Clyde.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: relsoft on May 15, 2006
That's some awesome and wicked render man!!!!

14 - 15 FPS here on my duron 750. :*)

Title: Re: Freebasic 3d renderer using tinyptc
Post by: Shockwave on May 15, 2006
By the way, if anyone else wants to nab that font for their own prods, feel free and grab it.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 20, 2006
Made a few changes now and made it into a .dll. Still got loads of stuff i'm wanting to add but here's a slightly modified tunnel demo along with the files you need to use the dll as it is atm.

Some changes:
All texture/entity/world etc handles are now integers
Models now contain the object data instead of meshes, models can be used by multiple meshes to cut down on memory usage.
Added functions: text_to_texture,texture_offset,move_texture_offset,render_to_texture.

EDIT d/l removed, get updated version from later post
Title: Re: Freebasic 3d renderer using tinyptc
Post by: relsoft on May 20, 2006
Cool update!!! I like it when the texture got warped. :*)
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Clyde on May 20, 2006
Very cool and clever, btw im getting around 30 fps.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Shockwave on May 20, 2006
Nice effect SM, loving the sunken cubes it looks much nicer than the first one, getting a fairly consistent 60fps here.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 20, 2006
Thanks rel and clyde, as i said before i'm planning on adding a lot more to this as well as speeding it up and if there's anything anoyone would like added feel free to make suggstions.

currently on the to do list:
vertex/texel alpha
entity heirarchy
shadows
methods to retrieve and modify entity/vertex etc info(coords and stuff)
scene blending/wipes
display buffer pixel operations

ah, you've posted before me shockwave, thanks and must look good at 60fps i just get around 35
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Clyde on May 20, 2006
As a suggestion how about primitive creating. Like CreateCylinder, CreateSphere, etc.

What a cool to do list.

All the best matey,
Cheers - Clyde.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 20, 2006
Yeah clyde, stuff like that's pretty handy but would maybe be better kept outside the dll and instead in some sort of add in list of functions, as well as keeping the size of the dll to a minimum it would allow the programmer more control over stuff like how the cubes or cylinders are textured.  Keep the suggestions coming though.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 21, 2006
Alpha should now be fully working, got some of the shadow code in place but nothing to see there yet. Added a brush system so textures can be reused with differing properties. Starting to slow down a bit now tho.
Also the call to update the buffer to the display is now manual and it's possible to get the address of the colour buffer to read and write to before the update.

Maybe this should be in the work in progress forum.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Shockwave on May 21, 2006
The FPS has certainly taken a big hit here, it's running at about half the speed of the last version but the alpha is working perfectly and it is chucking a lot of stuff around so I guess that's to be expected. Looking cool.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 22, 2006
Managed to get a little bit of the speed back but not much (although can't be compared to previous now as the demo's changed a bit), and added the entity hierarchy stuff which i might still add to to give a little more control over. Thinking of starting something similar using opengl.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Rbz on May 23, 2006
I got 36 fps instead 16 from previous one, nice work  :)
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 23, 2006
Cool rbraz, thanks. Got the shadow system working now which probably needs a bit of adjustment here and there as i do some testing but on the whole it's working pretty well (with the exception that shading doesn't work on the alpha surfaces atm but i'll fix that).

One problem with the system and i can't see any way around it is that shadows can't be cast onto alpha surfaces which is a bit annoying.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Shockwave on May 23, 2006
I tell you what, that is really reall nice. The speed of the whole thing seems unchanged too so I guess that your optimisations did the trick.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: relsoft on May 23, 2006
Cool update! faster too. about 10 FPS here from 2 FPS. :*)
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 23, 2006
thanks, no idea what ive done that would make it go from 2 up to 10 tho
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Optimus on May 24, 2006
ABSOLUTELY AMAZING!!!
Never seen such a good 3d engine for freebasic before. Gotta love the commands and stuff, interesting..
27 fps here.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Shockwave on May 27, 2006
If I know Stonemonkey, it will get much much better.

Any chance of getting this to the stage where the running man demo could be replecated SM?
I'd love to see that running at some silly speed in 640X480 mode.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on May 27, 2006
Sorry, not for a while shockwave. little example of something i did a while ago though with some similar effects going on  here though.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Shockwave on May 27, 2006
Jeepers, that's stunning.
Unbelievably quick frame rate too.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Rbz on May 27, 2006
@Stonemonkey:   That demo3.zip It's fantastic !

 I just can't believe that this one was software rendered, welldone !
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Ghost^BHT on May 27, 2006
Very cool indeed :)
Title: Re: Freebasic 3d renderer using tinyptc
Post by: taj on November 12, 2006
Wow, please please please tell me how you were doing the transparency in this demo...can I bribe you with Karma???
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Shockwave on November 12, 2006
I think that he might have resorted to inline asm for a lot of the transparency stuff, Stonemonkey can verify that though.. Stonemonkey also made this nice little definition that makes quite fast alpha blending possible;

Code: [Select]
#define alpha(s,d) ((((s and &hff00ff)*(s shr 24)+(d and &hff00ff)*(256-(s shr 24)))and &hff00ff00)or(((s and &hff00)*(s shr 24)+(d and &hff00)*(256-(s shr 24)))and &hff0000))shr 8
Title: Re: Freebasic 3d renderer using tinyptc
Post by: rdc on November 12, 2006
Heh. I didn't see this before. Looks like the alpha stuff has already been covered. Impressive work on this Stonemonkey.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on November 12, 2006
Yep, using inline asm but really just using the same method as in the definition Shockwave's posted there where the red and blue channels are dealt with together.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: taj on November 12, 2006
But it looked like there was some refraction going on...did I see it wrong?
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on November 12, 2006
Ah right, sorry I forgot about that. It's done by wrapping a texture around the object and then for every frame it first renders to that texture using a camera placed inside the object. Other ways it could be done are with cube or sphere mapping using pre rendered textures although that wouldn't allow for moving objects around so well.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Shockwave on November 12, 2006
Been thinking about multitexturing.
Tell me if you think this would work..

Render a shadow map from the view of the light source to a texture.

Then multi texture the shadow map over the scene and render the scene from the camera's point of view.

I think that this could work quite well for shadows....
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on November 12, 2006
That's a method that's sometimes used but i've not looked into it in much depth as i think, particularly with sw rendering it would suffer quite badly from visible stepping of the shadows. I think it can be done well in hw but i'm not sure how.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Shockwave on November 12, 2006
There's nothing new under the sun eh?  :) There was me thinking I had had a brainwave!
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on November 12, 2006
heh, that's happened to me a few times too but i think it's pretty cool when it does as it shows you're thinking along the right lines.

http://en.wikipedia.org/wiki/Shadow_mapping

Title: Re: Freebasic 3d renderer using tinyptc
Post by: taj on November 12, 2006
Been thinking about multitexturing.
Tell me if you think this would work..

Render a shadow map from the view of the light source to a texture.

Then multi texture the shadow map over the scene and render the scene from the camera's point of view.

I think that this could work quite well for shadows....

Well it always helps to deduc things yourself from first principles. Its a technique used in OpenGL. Here is a cool article on the maths

http://www.paulsprojects.net/tutorials/smt/smt.html
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Shockwave on November 13, 2006
Cheers Taj.

The reason the thought of doing it like this came to me wasa that I was thinking about Stonemonkeys SW engine and the way he does the shadows, he explained about the principles of having a prism like volume and everything contained in it's projection being in shadow..

I was thinking about casting shadows onto objects which are cones, spheres etc and just thought why not render the shadow and texture map it onto the object.
Shadows aren't something I can say I've ever really done, I'll most certainly be trying this technique out when I can get some stuff happening in CPP.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: taj on November 13, 2006
Ah right, sorry I forgot about that. It's done by wrapping a texture around the object and then for every frame it first renders to that texture using a camera placed inside the object. Other ways it could be done are with cube or sphere mapping using pre rendered textures although that wouldn't allow for moving objects around so well.

Mr Monkey,

Stone, I dont quite get it. Could you be a bit more precise. I'm asking because the code to do refractions in OGL (using cubemaps) requires extensions ansd is therefore expensive in 4k. However you seem to be using 1 texture per object. The technique might be very useful, could you maybe detail it a bit more? I get rendering from inside the object, but how do you decide but how did you decide what the texture co-ordinates are on the object? What field of view do you use for rendering the view? Does it change depeding on how far away the object is or not? Any hints and tips could earn a stone banana...

Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on November 13, 2006
ok, a bit more detail.

The objects I've done it with in that demo are the pawns, the sphere uses a similar method for reflections but the camera points the other way. The sphere can be pointed towards the camera but the pawn is pointed towards a pivot placed at the same height as the pawn but with the cameras x and z coords. That means i only have to set the texture coords once and don't have to recalculate each frame, with more complex objects you'd need to.
I then place a camera somewhere inside the object with the same orientation as the main camera (maybe back the camera up a bit and hide the object) and render with quite a wide angle which changes a little with the distance from the object to the main camera.
For the uv values I think (can't find the source atm and don't think i worked out the refraction) I just used the reflection formula (from some point along -z), normalised the vector then multiplied the x and y components by .5 and added .5 to bring them into the range 0.0->1.0 and used them for u and v.

EDIT:
I've used this a few times but always had to mess around with values with a bit of trial and error until i'm happy with it.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: DrewPee on November 13, 2006
Stonemonkey . . . I am not worthy - that is absolutely fantastic - I was gobsmacked - cool cool beans dude!

Have some karma for that!

Regards and appreciation

Drew
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Shockwave on November 14, 2006
We had started to put a project together with this engine and it was looking promising, it's really nice to use it and behaves a lot like the BB3D command set, I hope that in the future that we can pick this up again and finish something with it. I'll give SM some karma for this too as he's been developing the techniques to do this since the Yabasic days a few years ago and it represents a lot of hard work.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: ninogenio on April 24, 2007
how exaclty does this line work?

Code: [Select]
#define alpha(s,d) ((((s and &hff00ff)*(s shr 24)+(d and &hff00ff)*(256-(s shr 24)))and &hff00ff00)or(((s and &hff00)*(s shr 24)+(d and &hff00)*(256-(s shr 24)))and &hff0000))shr 8

ive been trying to get a nice alpha in my softrender using it but it doesnt work the way im trying to do it is something like this *buckbuffer=alpha(rgb(r,g,b), *backbuffer) on every pixel transfer but my object turns black so im guessing im doing it wrong.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on April 24, 2007
You need an alpha value in the source:

*backbuffer=alpha((alpha_value shl 24) or rgb(r,g,b), *backbuffer)

in this case, alpha_value should be a value 0-255.

When you multiply 2 8 bit numbers you can't have more than a 16 bit result so it's able to do the multiply on the red and blue bytes together without them interfering with each other which means you only have to separate out the green byte.

EDIT: the same idea can be used for shading.

Fryer.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: ninogenio on April 25, 2007
cool it works!

i have a bit of a problem though the white inmy object turns red and red gets filtered out?
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Emil_halim on April 25, 2007

oh.., really noce work man.  :)

I suggest that , you add a skelta animation to your 3D Engine.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Stonemonkey on April 25, 2007
I'm not sure why that's happening nino but i just thought that there must be a better method you could use as the idea behind my code is to take 2 32 bit colour values to do the calculations whereas you already have them as individual r,g,b values and you're combining them with rgb(r,g,b) only to take them apart again to do the alpha.

Is your buffer 24 or 32 bit?  and what order are the bytes(colours) in?
Title: Re: Freebasic 3d renderer using tinyptc
Post by: ninogenio on April 25, 2007
its r shr 16 or g shr 8 or blue in that order i coded up something that works quite nicely today because like you said i wasnt using your macro to its full potential.

cheers anyway mate :cheers:.
Title: Re: Freebasic 3d renderer using tinyptc
Post by: Tetra on April 26, 2007
wow cant beleive I havent seen this sooner, really nice work Fryer, top quality rendering there as per usual ;D