
  '#compact
  '$ FileName  "t.exe"
  'uses RTL32
  'uses RTL64
  '

  % MultiSamples 4
  % ExplicitMain
  % title        "Pick / move objects / right-click for menu"
  % fontA        "Arial",FW_SEMIBOLD

  'macro keydown
  'case 27 : 'no action
  'case 32 : 'no action
  'end macro
  '
  uses OpenglSceneFrame
  '
  uses glo2\shapes
  uses glo2\materials

  %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 'SHAPES
  sys   picknext

  %cone -1


  function WndMessages( sys hWnd, wMsg, wParam, lparam ) as sys, link WndProcExtra, callback
  ============================================================================
  '
  static sys         hMenu,hSubMenu,hSubMenu1,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     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_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





  =================
  class SceneObject
  =================
  '
  float  x,y,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
  '
  float*ma              'MATERIALS
  '
  method setdi(float px,py,pz,psc,prz,pry,psm,pn)
  x=px : y=py : z=pz : sc=psc : rz=prz : ry=pry
  sm=psm 
  n=pn
  end method
  '
  method setma(float*m) 'materials
  @ma=@m
  end method
  '
  method setsh(sys sh)
  shape=sh
  end method
  '
  method Render()
  Material ma
  glPushMatrix
  gltranslatef  x,y,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=x : by=y : bz=z
  end method
  '
  method move(single mx,my,mz)
  x=bx+mx : y=by+my : 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=-z,id=-1/z
  if  x*id<-0.5 then x=-.5*d
  if  y*id<-0.4 then y=-.4*d
  if z>-1.0 then z=-1.0
  if x*id>.5  then x=.5*d
  if y*id>.4 then 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=-z/crect.right
    move dx*dz,dy*dz,0
  end if
  end method
  '
  end class

'#recordof sceneobject


  ========================
  sub initialize(sys hWnd)
  ========================
  '
  GDIplus 1
  '
  cube=CompileList   : CubeForm      : 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[6].setdi  6.5, -0.9, -16.0, 0.5, 0, 4. , 0, 4
    c[5].setdi  2.5, -0.9, -8.0 , 0.5, 0, 2. , 0, 10
    c[4].setdi  0.5, -0.9, -4.0 , 0.5, 0, 3. , 0, 15
    c[3].setdi -0.5, -0.6, -2.0 , 0.5,.5, 1. , 1, 30
    c[2].setdi -0.5, -0.1, -2.0 , .25,1., 2. , 1, 30
    c[1].setdi -0.5,  0.4, -2.0 , .25,0., 2. , 1, 30
    '
    c[6].setsh cube
    c[5].setsh helix
    c[4].setsh cone
    c[3].setsh tors
    c[2].setsh sphere
    c[1].setsh cone
    '
    c[6].setma RedShiny
    c[5].setma BlackShiny
    c[4].setma Steel
    c[3].setma Bronze
    c[2].setma Silver
    c[1].setma Gold
    picknext=7
  end if
  '
  'PICK OR RENDER MODE
  '
  int a=lastkey-48
  select a
  case 1 to 6 : 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
      float *m
      select cmd
      case 4021 : @m=@RedShiny
      case 4022 : @m=@BlackShiny
      case 4023 : @m=@Steel
      case 4024 : @m=@Bronze
      case 4025 : @m=@Silver
      case 4026 : @m=@Gold
      end select
      if @m
        c[picked].setma 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
    end select
    if shape then
      if picked=0 then
        if picknext<=100 then
          picked=picknext
          c[picked].setdi -0.0, -0.0, -5.0 , 0.5,.5, 1. , 1, 30
          c[picked].setma Silver
          picknext++
        end if
      end if
      if picked then c[picked].setsh shape
    end if
  end if
  ncmd:
  cmd=0 'FINISHED WITH COMMAND
  '
  'RENDER OBJECTS
  '
  sys i
  SceneObject *cc
  for i=1 to <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 .25,.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
