

  '=============================
  'Multiple Opengl child Windows
  '=============================

  'MS Child Windows
  'http://msdn.microsoft.com/en-us/library/ms632598(VS.85).aspx
  
  '13:01 10/12/2010
  '13:30 03/10/2013
  '03:29 16/05/2018
  'Charles Pegge
  '
  #case capital
  '
  $ filename "t.exe"
 'uses RTL64
  uses MinWin
  uses Ogl


  % ID_FIRSTCHILD  100
  'other children ..115 


  'GLOBAL VARIABLES
  '----------------

  sys hinstance
  sys hWndMain
  sys hDC,hRC,hw[16],hd[16]

  RECT        cRect
  PAINTSTRUCT Paintst


  ;=====================================
  
  sys inst=GetModuleHandle 0
  asciiz * cmdline 
  &cmdline=GetCommandLine
  string szAppName="OpenGL Child Windows"
  string szconfirm="Confirm Quit"

  ;=====================================
 

  '-------------------------------------------
  function PixelFormat(sys hdc, choice) as sys
  '===========================================

  'setup pixel format

  dim nPixelFormat as sys
  dim pfd as PIXELFORMATDESCRIPTOR
  '
  pfd.nSize           = sizeof PIXELFORMATDESCRIPTOR 'Size of UDT structure
  pfd.nVersion        = 1                            'Version. Always set to 1.
  pfd.dwFlags         = PFD_DRAW_TO_WINDOW or _      'Support Window
                        PFD_SUPPORT_OPENGL or _      'Support OpenGL
                        PFD_DOUBLEBUFFER             'Support Double Buffering
  pfd.iPixelType      = PFD_TYPE_RGBA                'Red, Green, Blue, & Alpha Mode
  pfd.cColorBits      = 32                           '32-Bit Color Mode
  pfd.cRedBits        = 0                            'Ignore Color and Shift Bits...
  pfd.cRedShift       = 0                            '...
  pfd.cGreenBits      = 0                            '...
  pfd.cGreenShift     = 0                            '...
  pfd.cBlueBits       = 0                            '...
  pfd.cBlueShift      = 0                            '...
  pfd.cAlphaBits      = 0                            'No Alpha Buffer
  pfd.cAlphaShift     = 0                            'Ignore Shift Bit.
  pfd.cAccumBits      = 0                            'No Accumulation Buffer
  pfd.cAccumRedBits   = 0                            'Ignore Accumulation Bits...
  pfd.cAccumGreenBits = 0                            '...
  pfd.cAccumBlueBits  = 0                            '...
  pfd.cAccumAlphaBits = 0                            '... Good Cereal! ;)
  pfd.cDepthBits      = 16                           ' bits z-buffer depth 8 16 24
  pfd.cStencilBits    = 1                            'Stencil Buffer
  pfd.cAuxBuffers     = 0                            'No Auxiliary Buffer
  pfd.iLayerType      = PFD_MAIN_PLANE               'Main Drawing Plane
  pfd.bReserved       = 0                            'Reserved
  pfd.dwLayerMask     = 0                            'Ignore Layer Masks...
  pfd.dwVisibleMask   = 0                            '...
  pfd.dwDamageMask    = 0                            '...
  '
  nPixelFormat = ChoosePixelFormat(hDC, &pfd) 'First without multisampling
  '
  SetPixelFormat(hDC, nPixelFormat, &pfd)
  return nPixelFormat
  '
  end function


  '---------------------------
  sub PrepareRenderFor(sys n)
  '===========================
  {
    'GET CHILD HANDLE AND DEVICE CONTEXT FOR RENDERING
    '
    sys chw
    chw=hw[n] : hdc=hd[n]
    '
    wglMakeCurrent hDC, hRC
    '
    'SET THE VIEWPORT AND PERSPECTIVE
    '
    RECT crect
    GetClientRect  chw,@cRect
    glViewport 0, 0, crect.right, crect.bottom
    double aspect=crect.right/crect.bottom
    '
    glMatrixMode   GL_PROJECTION
    glLoadIdentity
    gluPerspective 45, aspect, 1.0, 100
    glMatrixMode   GL_MODELVIEW
    glLoadIdentity
    '
    glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
  }


  '------------------------------------------------------------
  function EnumChildProc(sys hwndChild, lParam) as sys callback
  '============================================================
  { 
    RECT * rcParent; 
    sys i, idChild;
    sys v,w,h,info
 
    // Retrieve the child-window identifier. Use it to set the 
    // position of the child window. 
    info=GWL_ID
    idChild = GetWindowLong(hwndChild, info)
    i=idChild-ID_FIRSTCHILD
 

    // Set Size and position the child window.  
 
    & rcParent = lParam;
    v=rcParent.right/4
    w=v*i
    h=rCParent.bottom
    if i=2 then v-=50 : h-=50 'size test
    if i=3 then v-=10 : 'shape text
    MoveWindow(hwndChild, w, 0, v, h, true);
 
 
    // Make sure the child window is visible. 
 
    ShowWindow(hwndChild, SW_SHOW); 
 
    return true;
  }





  'STANDARD CHILD WINDOWS STYLES
  '=============================
  '
  'Button	The class for a button.
  'ComboBox	The class for a combo box.
  'Edit	        The class for an edit control.
  'ListBox	The class for a list box.
  'MDIClient	The class for an MDI client window.
  'ScrollBar	The class for a scroll bar.
  'Static	The class for a static control.



  '---------------------------------------------------------------
  function WndProc(sys hwnd, uMsg, wParam, lParam) as sys callback
  '===============================================================
  {
    static single s1,s2,s3,s4,ang1,ang2,angi1=-2,angi2=1
    static zstring zs[4096]
    '
    RECT rcClient 
    static sys i,j,px,py,lx,ly,id,style,chw,act,idmenu

    string sty
 
    select umsg 
 
        case WM_CREATE: // creating main window  
            '
            'CREATE CHILD WINDOWS
            '
            style=WS_CHILD | WS_BORDER | WS_VISIBLE
            idmenu=0
            py=10
            '
            for i = 1 to 4
              j=i-1
              id=ID_FIRSTCHILD+j
              px=10+j*100 : lx=100 : ly=100
              '
              if i<=2 then
                sty="edit"
              elseif i=3 then
                sty="static"
              end if
              '
              hw[i]=CreateWindowEx(0,*sty, null, style, px,py,lx,ly, hwnd, id, inst, null)
              '
            next
            '
            'SETUP DEVICE CONTEXTS FOR EACH OPENGL CHILD WINDOW
            '
            for i=3 to 4
              '
              chw=hw[i]
              hDC=GetDC chw
              hd[i]=hDC
              '
              PixelFormat(hDC,0)
              finit 'reinitialise fpu after npixelformat
              '
            next
            '
            'create only one render context for several device contexts
            hRC = wglCreateContext(hD[3])
            '
            'SETUP INITIAL VALUES FOR ROTATION SPEED IN THE EDIT BOXES
            '

            chw=hw[1] : zs="-2 Rotation Speed"
            'a=1
            's=""
            'print zs
            SendMessage chw, WM_SETTEXT,32 , @zs
            chw=hw[2] : zs="1 Rotation Speed"
            SendMessage chw, WM_SETTEXT,32 , @zs
            return 0
            '
        case WM_TIMER
          '
          act=1
          '
        case WM_MOUSEMOVE
          '
        case WM_KEYDOWN
          '
          if wparam=27 then SendMessage hwnd, WM_DESTROY, 0, 0
          return 0
          '
        case WM_SIZE:   // main window changed size 
 
            // Get the dimensions of the main window's client 
            // area, and enumerate the child windows. Pass the 
            // dimensions to the child windows during enumeration. 
 
            GetClientRect(hwnd, &rcClient); 
            EnumChildWindows(hwnd, & EnumChildProc, &rcClient); 
            act=2 

        case WM_CLOSE: 
          // Create the message box. If the user clicks 
	  // the Yes button, destroy the main window. 
 
         'if (MessageBox(hwnd, *szConfirm, *szAppName, MB_YESNOCANCEL) == IDYES) 
            DestroyWindow(hwndMain)
         'end if 
         return 0

         'case WM_ERASEBKGND
         '
         'return 0

         case WM_DESTROY: 
 
         // Post the WM_QUIT message to 
         // quit the application terminate. 
 
         wglDeleteContext hRC
         hdc=hd[3] : wglMakeCurrent hDC, null : ReleaseDC hWnd,hDC
         hdc=hd[4] : wglMakeCurrent hDC, null : ReleaseDC hWnd,hDC
         PostQuitMessage(0); 
         return 0;

        case else
        return DefWindowProc(hwnd, uMsg, wParam, lParam); 
    end select
    '

    '-----------------------------------
    'CREATE SCENE FRAME AND SWAP BUFFERS
    '===================================
    '
    if act then

      'PROCESS EACH OPENGL CHILD WINDOW
      '--------------------------------
      '
      'READ ROTATION SPEED FROM EDIT BOX
      '
      chw=hw[1]
      SendMessage chw, WM_GETTEXT,32 , & zs
      '
      angi1=val zs
      '
      PrepareRenderFor 3
      '
      'INIT BUFFERS
      '
      glClearColor 0.5, 0, 0, 0
      '
      'SHAPE
      '
      s1=.2
      s2=-1
      s3=0.5
      s4=s3*.2
      glLoadIdentity
      glrotatef ang1, 0,0,1
      glbegin GL_TRIANGLES
      glcolor4f   00,  s3,  s3, 1
      glvertex3f -s1, -s1,  s2
      '
      glcolor4f   s3,  s3,  00, 1
      glvertex3f  s1, -s1,  s2
      glcolor4f   s4,   0,  s3, 1
      glvertex3f  00,  s1,  s2
      glend
      'glfinish
      swapBuffers hdc
      '
      '
      'NEXT OPENGL CHILD WINDOW
      '========================
      '
      'READ ROTATION SPEED FROM EDIT BOX
      '
      chw=hw[2]
      SendMessage chw, WM_GETTEXT,32 , & zs
      angi2=val zs
      '
      'SET DEVICE CONTEXT FOR RENDERING
      '
      PrepareRenderFor 4
      '
      'INIT BUFFERS
      '
      glClearColor 0.2, 0.0, 0.0, 0
      '
      'SHAPE
      '
      s1=.2
      s2=-1
      s3=0.5
      s4=s3*.2
      glLoadIdentity
      glrotatef ang2, 0,0,1
      glbegin GL_QUADS
      glcolor4f   s3,  00,  s4, 1
      glvertex3f -s1, -s1,  s2
      glcolor4f    0,  s3,  s4, 1
      glvertex3f -s1,  s1,  s2
      glcolor4f   s4,   0,  s3, 1
      glvertex3f  s1,  s1,  s2
      glcolor4f   s3,   0,  s4, 1
      glvertex3f  s1, -s1,  s2
      glend
      'glfinish
      swapBuffers hdc
      sleep 15
      '
      'UPDATE ROTATION ANGLES
      '----------------------
      '
      ang1+=angi1
      ang2+=angi2
      act=0
      return 0
      '
    end if 'act
    '
    '
  }



  '--------------------------------------------------------------------
  Function WinMain(sys inst, prevInst, asciiz*cmdline, sys show) as sys
  '====================================================================
                    '
  dim a,b,c,style,hWnd as sys
  dim wc as WNDCLASS
  dim wm as MSG

  with wc                 '
    .style=CS_HREDRAW or CS_VREDRAW
    .lpfnWndProc=@WndProc
    .cbClsExtra=0
    .cbWndExtra=0    
    .hInstance=inst
    .hIcon=LoadIcon 0, IDI_APPLICATION
    .hCursor=LoadCursor 0,IDC_ARROW
    .hbrBackground=GetStockObject WHITE_BRUSH '
    .lpszMenuName=0
    .lpszClassName=strptr "openglch"
  end with

  hinstance=inst

  if not RegisterClass @wc
    MessageBox 0,`Registration failed`,`Problem`,MB_ICONERROR
    exit function
  end if 


  style=WS_OVERLAPPEDWINDOW
  style=WS_OVERLAPPEDWINDOW | // overlapped window 
        WS_HSCROLL |          // horizontal scroll bar
        WS_VSCROLL            // vertical scroll bar


  // Create the main window. 

   hwndMain = CreateWindowEx( 
    0,                      // no extended styles           
    strptr "openglch",      // class name                   
    strptr szAppName,       // window title
    style,                  //                
    CW_USEDEFAULT,          // default horizontal position  
    CW_USEDEFAULT,          // default vertical position    
    800,                    // default width                
    240,                    // default height               
    null,                   // no parent or owner window    
    null,                   // class menu used              
    hinstance,              // instance handle              
    null);                  // no window creation data      


  // Show the window using the flag specified by the program 
  // that started the application, and send the application 
  // a WM_PAINT message. 

  hwnd=hwndMain
      
  if not hWnd then
    MessageBox 0,`Unable to create window`,`problem`,MB_ICONERROR
    exit function
  end if
  '
  ShowWindow hWnd,show
  UpdateWindow hWnd
  '
  SetTimer hWnd,1,10,null
  '
  ' 
  'MESSAGE LOOP
  '
  sys bRet
  '
  do while bRet := GetMessage (@wm, 0, 0, 0)
    if bRet == -1 then
      'show an error message?
    else
      TranslateMessage @wm
      DispatchMessage @wm
    end if
  wend
  '
  killTimer hwnd, 1
  '
  function=wm.wparam

  end function ; end of WinMain



  WinMain inst,0,cmdline,SW_NORMAL
