Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
cubo rotante - cube5a.f90

cube5a.f90

Caricato da:
Scarica il programma completo

  1. subroutine SetDCPixelFormat(hdc)
  2. !MS$  ATTRIBUTES VALUE :: hdc
  3. use msfwina
  4. use opengl
  5. use cubeinc
  6. integer(4)                      hdc
  7. integer(4)                      hHeap
  8. integer(4)                      nColors, i
  9. integer(4)                      lpPalette
  10. BYTE                            byRedMask, byGreenMask, byBlueMask
  11. type(T_LOGPALETTE)              logpal
  12. type(T_PIXELFORMATDESCRIPTOR)   pfd
  13. type(T_PALETTEENTRY)            palette(256);
  14.  
  15. logical(4)  bret
  16.  
  17.     DATA pfd / T_PIXELFORMATDESCRIPTOR (  &
  18.          40,                & !sizeof(T_PIXELFORMATDESCRIPTOR),
  19.          1,                 &
  20.          #25, & !IOR(PFD_DRAW_TO_WINDOW ,IOR(PFD_SUPPORT_OPENGL , PFD_DOUBLEBUFFER)), &
  21.          PFD_TYPE_RGBA,     &
  22.          24,                &
  23.          0, 0, 0, 0, 0, 0,  &
  24.          0, 0,              &
  25.          0, 0, 0, 0, 0,     &
  26.          32,                &
  27.          0,                 &
  28.          0,                 &
  29.          PFD_MAIN_PLANE,    &
  30.          0,                 &
  31.          0, 0, 0            &
  32.       ) /
  33.  
  34.    integer(4)   nPixelFormat
  35.  
  36.    nPixelFormat = ChoosePixelFormat(hdc, pfd)
  37.    bret = SetPixelFormat(hdc, nPixelFormat, pfd)
  38.  
  39.     i = DescribePixelFormat (hdc, nPixelFormat, 40, pfd)
  40.  
  41.     if (IAND(pfd%dwFlags , PFD_NEED_PALETTE)) then
  42.         nColors = ISHL(1, pfd%cColorBits)
  43.         hHeap = GetProcessHeap()
  44.  
  45.         lpPalette = HeapAlloc (hHeap, 0, 8 + (nColors * 4))
  46.       logpal%palVersion = #300
  47.       logpal%palNumEntries = nColors
  48.  
  49.       logPal%palPalEntry(1) = palette(1)
  50. !     lpPalette->palVersion = #300
  51. !       lpPalette->palNumEntries = nColors
  52.  
  53.         byRedMask   = ISHL(1, pfd%cRedBits) - 1
  54.         byGreenMask = ISHL(1, pfd%cGreenBits) - 1
  55.         byBlueMask  = ISHL(1, pfd%cBlueBits) - 1
  56.  
  57.         do i = 1, nColors
  58.          palette(i)%peRed =            &
  59.                 (IAND((ISHL(i ,-pfd%cRedShift)) , byRedMask) * 255) / byRedMask
  60.          palette(i)%peGreen =       &
  61.                 (IAND((ISHL(i ,-pfd%cGreenShift)) , byGreenMask) * 255) / byGreenMask
  62.          palette(i)%peBlue =        &
  63.                 (IAND((ISHL(i ,-pfd%cBlueShift)) , byBlueMask) * 255) / byBlueMask
  64.       end do
  65.  
  66.       !call CopyMemory (lpPalette, LOC(logpal), 8 + (nColors * 4))
  67.       hPalette = CreatePalette (logpal)
  68.       if (hPalette .NE. NULL) then
  69.           i = SelectPalette (hdc, hPalette, .FALSE.)
  70.           i = RealizePalette (hdc)
  71.       end if
  72.     end if
  73. end
  74.  
  75. !/*
  76. ! *  InitializeRC initializes the current rendering context.
  77. ! *  
  78. ! *  Input parameters:
  79. ! *      None
  80. ! *  
  81. ! *  Returns:
  82. ! *      Nothing
  83. ! */
  84.  
  85. subroutine InitializeRC ()
  86. use msfwina
  87. use opengl
  88.     real(4)     glfLightAmbient(4)
  89.     real(4)     glfLightDiffuse(4)
  90.     real(4)     glfLightSpecular(4)
  91.  
  92.     DATA glfLightAmbient /0.1, 0.1, 0.1, 1.0/
  93.     DATA glfLightDiffuse /0.7, 0.7, 0.7, 1.0/
  94.     DATA glfLightSpecular / 1.0, 0.0, 0.0, 1.0/
  95.      
  96.     call fglEnable(GL_DEPTH_TEST)
  97.     call fglEnable(GL_CULL_FACE)
  98.  
  99.    
  100.  
  101.     call fglLightfv (GL_LIGHT0, GL_AMBIENT, LOC(glfLightAmbient))
  102.     call fglLightfv (GL_LIGHT0, GL_DIFFUSE, LOC(glfLightDiffuse))
  103.     call fglLightfv (GL_LIGHT0, GL_SPECULAR, LOC(glfLightSpecular))
  104.    
  105.     call fglEnable (GL_LIGHTING)
  106.     call fglEnable (GL_LIGHT0)
  107. end