here's my next example, all work in progress :-)
included a grid plane
'#compact
includepath "$\inc\"
$ FileName "t.exe"
'include "RTL32.inc"
'include "RTL64.inc"
'
% MultiSamples 4
% ExplicitMain
'% title "Pick / move objects / right-click for menu"
% title "Create+Pick / move objects / Left+right-click for menu"
% fontA "Arial",FW_SEMIBOLD
'macro keydown
'case 27 : 'no action
'case 32 : 'no action
'end macro
'
include "OpenglSceneFrame.inc"
'
'includepath "$\examples\opengl\"
include "glo2\shapes.inc"
include "glo2\materials.inc"
%TPM_LEFTBUTTON 0x0000
%TPM_RIGHTBUTTON 0x0002
%TPM_LEFTALIGN 0x0000
'SCENE GLOBALS
==============
indexbase 1
sys texn[16] 'ARRAY OF TEXTURE NUMBERS
sys GdiplusToken '
float ang1 'ANIMATION ANGLE
sys cmd 'COMMAND MESSAGE WPARAM
sys cube,sphere,tors,helix,line,grid 'SHAPES
sys picknext
sys i,j
%cone -1
function WndMessages( hWnd, wMsg, wParam, lparam ) as sys, link WndProcExtra
============================================================================
'
static sys hMenu,hSubMenu,hCursorMenu
static String szAppName
static POINT pt
'
select wMsg
===========
case WM_CREATE
'
if mincreate then return
'
hMenu = CreateMenu
hSubMenu = CreateMenu
hSubMenu1= CreateMenu
AppendMenu hSubMenu1, MF_STRING, 4021, "Shiny Red"
AppendMenu hSubMenu1, MF_STRING, 4022, "Shiny Black"
AppendMenu hSubMenu1, MF_STRING, 4023, "Steel"
AppendMenu hSubMenu1, MF_STRING, 4024, "Bronze"
AppendMenu hSubMenu1, MF_STRING, 4025, "Silver"
AppendMenu hSubMenu1, MF_STRING, 4026, "Gold"
AppendMenu hSubMenu , MF_POPUP, hSubMenu1, "&Materials"
'
hSubMenu1= CreateMenu
AppendMenu hSubMenu1, MF_STRING, 4041, "Cube"
AppendMenu hSubMenu1, MF_STRING, 4042, "Cone"
AppendMenu hSubMenu1, MF_STRING, 4043, "Sphere"
AppendMenu hSubMenu1, MF_STRING, 4044, "Torus"
AppendMenu hSubMenu1, MF_STRING, 4045, "Helix"
AppendMenu hSubMenu1, MF_STRING, 4046, "Lines"
AppendMenu hSubMenu1, MF_STRING, 4047, "grid"
AppendMenu hSubMenu , MF_POPUP, hSubMenu1, "&Shapes"
' AppendMenu hSubMenu , MF_SEPARATOR, 0, null
AppendMenu hSubMenu , MF_STRING, 4005, "E&xit"
'
AppendMenu hMenu, MF_POPUP, hSubMenu, "&Objects"
'
' CheckMenuItem hMenu,4022, MF_CHECKED
' EnableMenuItem hMenu,4024, MF_DISABLED or MF_GRAYED
'
hCursorMenu = GetSubMenu(hMenu, 0)
'
case WM_COMMAND
if wparam = 4005 then 'Exit
SendMessage hwnd, WM_CLOSE, 0, 0
end if
cmd=wParam
case WM_KEYDOWN
cmd=12
act=1
case WM_KEYUP
cmd=12
case WM_LBUTTONUP
GetClientRect crect
GetCursorPos(pt)
TrackPopupMenu(hCursorMenu, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON,
pt.x, pt.y, 0, hwnd, null)
'print "Left create Lines"
bright=0 : return 1
case WM_RBUTTONUP
GetClientRect crect
GetCursorPos(pt)
TrackPopupMenu(hCursorMenu, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON,
pt.x, pt.y, 0, hwnd, null)
bright=0 : return 1
end select
end function
sub lines(single x,y)
==========================
glPushMatrix
glLineWidth 4.0
gltranslatef 0,0,-1
glscalef 0.01,0.01,0.01
'
glBegin GL_LINES
glColor4ub 250,250,150,250
glVertex2i -100,-100
glVertex2i 100, 100
glColor4ub 150,250,250,250
glVertex2i -100, 100
glVertex2i 100,-100
glEnd
'
'glLineWidth 2.0
glPopMatrix
end sub
sub grids(sys i,j)
glLineWidth 2.0
gltranslatef 0,-2,-1
glBegin GL_LINES
for i = -10 to 10
for j = -10 to 10
glVertex3i -10, 0, j
glVertex3i 10, 0, j
glVertex3i i, 0, -10
glVertex3i i, 0, 10
next
next
glEnd
end sub
=================
class SceneObject
=================
'
float p.x,p.y,p.z 'POSITION
float sc,rz,ry 'PROPORTIONS
float sm 'SMOOTHING
sys n 'FACETS
sys shape
'
float a.x,a.y,a.z 'ORIENTATION
float ax,ay,az 'ANCHOR ROTATION
float bx,by,bz 'ANCHOR POSITION
'
Materials*ma
'
method set(float px,py,pz,psc,prz,pry,psm,pn)
p.x=px : p.y=py : p.z=pz : sc=psc : rz=prz : ry=pry
sm=psm
n=pn
end method
'
method set(materials*m)
@this.ma=@m
end method
'
method set(sys sh)
shape=sh
end method
'
method Render()
if @ma then ma.act
glPushMatrix
gltranslatef p.x,p.y,p.z
glrotatef a.x,1,0,0 'rotate yz : PITCH
glrotatef a.y,0,1,0 'rotate xz : YAW
glrotatef a.z,0,0,1 'rotate xy : ROLL
glscalef sc,sc,sc
if shape=-1
ConeFaces n,rz,ry,sm
elseif shape>0
glCallList shape
end if
a.y+=1 : if a.y=360 then a.y=0
glPopMatrix
end method
'
method anchor()
ax=a.x : ay=a.y : az=a.z
bx=p.x : by=p.y : bz=p.z
end method
'
method move(single mx,my,mz)
p.x=bx+mx : p.y=by+my : p.z=bz+mz
limit
end method
'
method rotate(single mx,my,mz)
a.x=ax+mx : a.y=ay+my : a.z=az+mz
end method
'
method limit()
float d=-p.z,id=-1/p.z
if p.x*id<-0.5 then p.x=-.5*d
if p.y*id<-0.4 then p.y=-.4*d
if p.z>-1.0 then p.z=-1.0
if p.x*id>.5 then p.x=.5*d
if p.y*id>.4 then p.y=.4*d
end method
'
method drag()
float dx,dy,dz
dx=mposx-sposx
dy=sposy-mposy
if key[VK_CONTROL]
'a.z=-dx : a.x=-dy
'rotate(-0.5*dy,0.0,-0.5*dx)
rotate(-0.5*dy,0.0,0.0)
elseif key[VK_SHIFT]
dx=mposx-sposx
dz=(mposy-sposy)/crect.right
move 0,0,20*dz
else
dx=mposx-sposx
dy=sposy-mposy
dz=-p.z/crect.right
move dx*dz,dy*dz,0
end if
end method
'
end class
========================
sub initialize(sys hWnd)
========================
'
GDIplus 1
'
cube=CompileList : CubeForm : glEndList
line=CompileList : lines 1,1 : glEndList
grid=CompileList : grids 1,2 : glEndList
sphere=CompileList : Spheric 1,1,6 : glEndList
tors=CompileList : torus 1.,.20 : glEndList
helix=CompileList : toroid 1.,.25,.8,.16,5.,6. : glEndList
end sub
=====================
sub Release(sys hwnd)
=====================
'
DeleteAllGlCompiled
Gdiplus 0
end sub
===================
sub scene(sys hWnd)
===================
'
static single ra,ri,angi1=.5
'
'
ActiveFrame
glClearColor 0.5, 0.5, 0.7, 0.0
Fog 0.5, 0.5, 0.7, 0.035 'rgb and density
BeginPick
'
StandardLighting li
StandardMaterial ma
'glEnable GL_TEXTURE_2D
'
sys t1=texn[1] 'texture
'
'
static SceneObject c[100]
'
'INITIAL DATA
if c.sc=0
'
'shape x y z sc rz ry sm n
'
c[8].set 1.5, -1.9, -4.0, 0.5, 0, 4. , 0, 4
c[7].set 2.5, -0.9, -4.0, 0.5, 0, 4. , 0, 4
c[6].set 6.5, -0.9, -16.0, 0.5, 0, 4. , 0, 4
c[5].set 2.5, -0.9, -8.0 , 0.5, 0, 2. , 0, 10
c[4].set 0.5, -0.9, -4.0 , 0.5, 0, 3. , 0, 15
c[3].set -0.5, -0.6, -2.0 , 0.5,.5, 1. , 1, 30
c[2].set -0.5, -0.1, -2.0 , .25,1., 2. , 1, 30
c[1].set -0.5, 0.4, -2.0 , .25,0., 2. , 1, 30
'
c[8].set grid
c[7].set line
c[6].set cube
c[5].set helix
c[4].set cone
c[3].set tors
c[2].set sphere
c[1].set cone
'
c[6].set RedShinyMaterial
c[5].set BlackShinyMaterial
c[4].set SteelMaterial
c[3].set BronzeMaterial
c[2].set SilverMaterial
c[1].set GoldMaterial
picknext=8
end if
'
'PICK OR RENDER MODE
'
a=lastkey-48
select a
case 1 to 7 : picked=a 'number keys 1..6
end select
'
MoveObjectWithKeys c[picked], 0.01, 1.0
'
'
'RESPOND TO MENU SELECTION
'
if cmd
if picked
if cmd=12
if bleft or bright
c[picked].anchor
sposx=mposx : sposy=mposy
end if
goto ncmd
end if
materials *m
select cmd
case 4021 : @m=@RedShinyMaterial
case 4022 : @m=@BlackShinyMaterial
case 4023 : @m=@SteelMaterial
case 4024 : @m=@BronzeMaterial
case 4025 : @m=@SilverMaterial
case 4026 : @m=@GoldMaterial
end select
if @m
c[picked].set m
goto ncmd
end if
end if
sys shape
select cmd
case 4041 : shape=cube
case 4042 : shape=cone
case 4043 : shape=sphere
case 4044 : shape=tors
case 4045 : shape=helix
case 4046 : shape=line
case 4047 : shape=grid
end select
if shape then
if picked=0 then
if picknext<=100 then
picked=picknext
c[picked].set -0.0, -0.0, -5.0 , 0.5,.5, 1. , 1, 30
c[picked].set SilverMaterial
picknext++
end if
end if
if picked then c[picked].set shape
end if
end if
ncmd:
cmd=0 'FINISHED WITH COMMAND
'
'RENDER OBJECTS
'
sys i
SceneObject *cc
for i=1,i<picknext
PickLabel i
@cc=@c[i]
if bleft
if picked=i
cc.drag
end if
else
cc.anchor
end if
cc.render
next
'
'PRINTING INFO / LABELS
'
'glDisable GL_TEXTURE_2D
glDisable GL_LIGHTING
if picked
glPushMatrix
glLoadIdentity
gltranslatef -.5,.35,-1.0
float w,h
glscalef .07,.07,.01
GetWordArea "Shape:",w,h
if pick
PutBoxArea w,h
else
glColor3f .99,.99,.00
gprint "Shape: "
glColor3f .99,.99,.99
gprint picked
end if
glPopMatrix
end if
'
EndPick
'
end sub
MainWindow width,height,WS_OVERLAPPEDWINDOW
