

  '=============================
  'Multiple Opengl child Windows
  'And ViewPorts
  '=============================

  #case capital

  'MS Child Windows
  'http://msdn.microsoft.com/en-us/library/ms632598(VS.85).aspx
  
  '10:28 05/06/2012
  '16:21 03/10/2013
  '03:30 16/05/2018
  'Charles Pegge
  

  $ filename "t.exe"
  uses MinWin
  uses Ogl
  '

  sub shape1
  '===========
  float s1,s2,s3,s4
  s1=.2
  s2=0
  s3=0.5
  s4=s3*.2
  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
  end sub

  sub shape2
  '===========
  float s1,s2,s3,s4
  s1=.2
  s2=0
  s3=0.5
  s4=s3*.2
  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
  end sub


  % 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, choose) as sys
  '===========================================

  'setup pixel format

  static Format as sys
  
  static pfd as PIXELFORMATDESCRIPTOR

  if choose then
  '
  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                            '...
  '
  Format = ChoosePixelFormat(hDC, @pfd) 'First without multisampling
  '
  end if
  '
  SetPixelFormat(hDC, Format, @pfd)
  '
  return Format
  '
  end function



  '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
  '===============================================================
    type wnd
      sys hWnd,hDC
    end type
    '
    static wnd h[4]
    static single ang1,ang2,angi1=-2,angi2=1
    static zstring zs[4096]
    '
    RECT rcClient 
    static sys i,j,px,py,lx,ly,id,style,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
              '
              h[i].hWnd=CreateWindowEx(0,*sty, null, style, px,py,lx,ly, hwnd, id, inst, null)
              h[i].hDC=GetDC h[i].hwnd
              '
            next
            '
            'SETUP DEVICE CONTEXTS FOR EACH OPENGL CHILD WINDOW
            '
            PixelFormat(h[3].hDC,1)
            PixelFormat(h[4].hDC,0)
            '
            'reinitialise fpu after npixelformat
            '
            finit
            '
            'create one render context for several device contexts
            '
            hRC = wglCreateContext(h[3].hdc)
            '
            'SETUP INITIAL VALUES FOR ROTATION SPEED IN THE EDIT BOXES
            '
            zs="-2 Rotation Speed"
            SendMessage h[1].hwnd, WM_SETTEXT,32 , @zs
            zs="5 Rotation Speed"
            SendMessage h[2].hwnd, 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 
 
 
            GetClientRect(hwnd, @rcClient); 
            sys i,u,v
            u=rcClient.right/4
            v=rcClient.bottom
            for i=1 to 4
              MoveWindow(h[i].hWnd, i*u-u, 0, u, v, true);
            next
 
            act=1 

        case WM_CLOSE: 

         DestroyWindow(hwndMain)
         return 0

         'case WM_ERASEBKGND
         '
         'return 0

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


    end select
    '


    macro PrepareForRender(x,y,w,h)
    '==============================
    '
    'SET THE VIEWPORT AND PERSPECTIVE
    '
    glEnable GL_SCISSOR_TEST
    glViewport x,y,w,h
    glScissor  x,y,w,h
    '
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    gluPerspective 45, w/h, 1.0, 100
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    end macro


    '-----------------------------------
    'CREATE SCENE FRAME AND SWAP BUFFERS
    '===================================
    '
    if act then
      '
      RECT crect
      '
      '
      'PROCESS EACH OPENGL CHILD WINDOW
      '--------------------------------
      '
      'READ ROTATION SPEED FROM EDIT BOX
      '
      SendMessage h[1].hWnd, WM_GETTEXT,32 , @zs
      angi1=val zs
      '
      wglMakeCurrent h[3].hDC, hRC
      GetClientRect  h.hwnd,@cRect
      PrepareForRender 0,0,cRect.right,cRect.bottom
      glClearColor .9, 0.9, 1.0, 0
      glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
      gltranslatef 0,0,-1
      glrotatef ang1, 0,0,1
      '
      shape1()
      '
      swapBuffers h[3].hdc

      ang1+=angi1
      if ang1>360 then ang1-=360
      '
      '
      'NEXT OPENGL CHILD WINDOW
      '========================
      '
      'READ ROTATION SPEED FROM EDIT BOX
      '
      SendMessage h[2].hWnd, WM_GETTEXT,32 , @zs
      angi2=val zs
      '
      wglMakeCurrent h[4].hDC, hRC
      GetClientRect(h[4].hwnd, @cRect)
      '
      'FOUR VIEWPORTS
      '
      sys u,v,x,y
      '
      u=cRect.right  >>1
      v=cRect.bottom >>1
      glEnable GL_SCISSOR_TEST
      '
      for y=0 to 1
      for x=0 to 1
        PrepareForRender x*u+5,y*v+5,u-10,v-10
        glClearColor 0.5*x, 0, 0.5*y, 0
        glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
        gltranslatef 0,0,-2
        if x=0 then glrotatef ang2, 0,0,1
        if x=1 then glrotatef ang2, 1,0,0
        '
        shape2()
        '
      next
      next
      swapBuffers h[4].hdc
      sleep 15
      ang2+=angi2
      if ang2>360 then ang2-=360
      '
      act=0
      return 0
      '
    end if 'act
    '
    '
    'for unprocessed messages:
    '
    return DefWindowProc(hwnd, uMsg, wParam, lParam); 
    '
  end function



  '--------------------------------------------------------------------
  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
