! File: lesson01.f90
! Compile with
! gfortran-6 -Wall lesson01.f90 -lGL -lX11 -lXxf86vm -lGLU -olesson01

module libC
   use ISO_C_BINDING
   implicit none
   private

   integer, parameter, public :: time_t = C_LONG
   integer, parameter, public :: suseconds_t = C_LONG
   integer, parameter, public :: EXIT_SUCCESS = 0
   integer, parameter, public :: EXIT_FAILURE = 1
   integer(C_INT), parameter, public :: ITIMER_REAL = 0
   integer(C_INT), parameter, public :: SIGALRM = 14

   type, bind(C), public :: timeval
      integer(time_t) tv_sec
      integer(suseconds_t) tv_usec
   end type timeval

   type, bind(C), public :: itimerval
      type(timeval) it_interval
      type(timeval) it_value
   end type itimerval

   public setitimer
   interface
      function setitimer(which,new_value,old_value) bind(C,name='setitimer')
         import
         implicit none
         integer(C_INT) setitimer
         integer(C_INT), value :: which
         type(itimerval) new_value
         type(itimerval) old_value
      end function setitimer
   end interface

   abstract interface
      subroutine SIG_handler(signum) bind(C)
         import
         implicit none
         integer(C_INT), value :: signum
      end subroutine SIG_handler
   end interface

   public signal
   interface
      function signal(signum, func) bind(C,name='signal')
         import
         implicit none
         type(C_FUNPTR) signal
         integer(C_INT), value :: signum
         procedure(SIG_handler) func
      end function signal
   end interface
end module libC

module Xlib
   use ISO_C_BINDING
   use ISO_C_BINDING, only: C_PTR=>C_PTR, PDisplay=>C_PTR
   implicit none
   private
   public PDisplay
   integer, parameter, public :: XID = C_LONG
   integer, parameter, public :: Window = XID
   integer, parameter, public :: Font = XID
   integer, parameter, public :: Pixmap = XID
   integer, parameter, public :: Atom = C_LONG
   integer, parameter, public :: Bool = C_INT
   integer, parameter, public :: Status = C_INT
   integer, parameter, public :: Drawable = XID
   integer, parameter, public :: Time = C_LONG
   integer, parameter, public :: Colormap = XID
   integer, parameter, public :: Cursor = XID
   integer, parameter, public :: KeySym = XID
   integer, parameter, public :: VisualID = C_LONG

   integer(C_LONG), parameter, public :: None = 0

   integer(C_LONG), parameter, public :: PPosition = ishft(1_C_LONG,2)
   integer(C_LONG), parameter, public :: PSize = ishft(1_C_LONG,3)
   integer(C_LONG), parameter, public :: PMinSize = ishft(1_C_LONG,4)

   integer(C_LONG), parameter, public :: InputHint = ishft(1_C_LONG,0)
   integer(C_LONG), parameter, public :: StateHint = ishft(1_C_LONG,1)
   integer(C_INT), parameter, public :: NormalState = 1
   integer(Bool), parameter, public :: True = 1
   integer(Bool), parameter, public :: False = 0

   integer(C_INT), parameter, public :: GrabModeAsynch = 1
   integer(C_INT), parameter, public :: AllocNone = 0

   integer(C_LONG), parameter, public :: ExposureMask = ishft(1_C_LONG,15)
   integer(C_LONG), parameter, public :: KeyPressMask = ishft(1_C_LONG,0)
   integer(C_LONG), parameter, public :: ButtonPressMask = ishft(1_C_LONG,2)
   integer(C_LONG), parameter, public :: StructureNotifyMask = ishft(1_C_LONG,17)

   integer(C_INT), parameter, public :: Expose = 12
   integer(C_INT), parameter, public :: ConfigureNotify = 22
   integer(C_INT), parameter, public :: ButtonPress = 4
   integer(C_INT), parameter, public :: KeyPress = 2
   integer(C_INT), parameter, public :: ClientMessage = 33

   integer(C_LONG), parameter, public :: CurrentTime = 0

   integer, parameter, public :: XMaxTransChars = 4
   integer(C_LONG), parameter, public :: CWBorderPixel = ishft(1_C_LONG,3)
   integer(C_LONG), parameter, public :: CWColorMap = ishft(1_C_LONG,13)
   integer(C_LONG), parameter, public :: CWEventMask = ishft(1_C_LONG,11)
   integer(C_LONG), parameter, public :: CWOverrideRedirect = ishft(1_C_LONG,9)

   integer(C_INT), parameter, public :: InputOutput = 1

   integer(KeySym), parameter, public :: XK_Escape = int(Z'ff1b',KeySym)
   integer(KeySym), parameter, public :: XK_F1 = int(Z'ffbe',KeySym)

   type, bind(C), public :: XTextProperty
      type(C_PTR) value
      integer(Atom) encoding
      integer(C_INT) format
      integer(C_LONG) nitems
   end type XTextProperty

   type, bind(C), public :: XKeyEvent
      integer(C_INT) type
      integer(C_LONG) serial
      integer(Bool) send_event
      type(PDisplay) display
      integer(Window) window
      integer(Window) root
      integer(Window) subwindow
      integer(Time) time
      integer(C_INT) x, y
      integer(C_INT) x_root, y_root
      integer(C_INT) state
      integer(C_INT) keycode
      integer(Bool) same_screen
      character(KIND=C_CHAR) trans_char(XMaxTransChars)
      integer(C_INT) nbytes
   end type XKeyEvent

   type, bind(C), public :: XButtonEvent
      integer(C_INT) type
      integer(C_LONG) serial
      integer(Bool) send_event
      type(PDisplay) display
      integer(Window) window
      integer(Window) root
      integer(Window) subwindow
      integer(Time) time
      integer(C_INT) x, y
      integer(C_INT) x_root, y_root
      integer(C_INT) state
      integer(C_INT) button
      integer(Bool) same_screen
   end type XButtonEvent

   type, bind(C), public :: XExposeEvent
      integer(C_INT) type
      integer(C_LONG) serial
      integer(Bool) send_event
      type(PDisplay) display
      integer(Window) window
      integer(C_INT) x, y
      integer(C_INT) width, height
      integer(C_INT) count
   end type XExposeEvent

   type, bind(C), public :: XConfigureEvent
      integer(C_INT) type
      integer(C_LONG) serial
      integer(Bool) send_event
      type(PDisplay) display
      integer(Window) event
      integer(Window) window
      integer(C_INT) x, y
      integer(C_INT) width, height
      integer(C_INT) border_width
      integer(Window) above
      integer(Bool) override_redirect
   end type XConfigureEvent

   type, bind(C), public :: XEvent
      integer(C_LONG) pad(24)
   end type XEvent

   type, bind(C), public :: XCharStruct
      integer(C_SHORT) lbearing
      integer(C_SHORT) rbearing
      integer(C_SHORT) width
      integer(C_SHORT) ascent
      integer(C_SHORT) descent
      integer(C_SHORT) attributes
   end type XCharStruct

   type, bind(C), public :: XFontProp
      integer(Atom) name
      integer(C_LONG) card32
   end type XFontProp

   type, bind(C), public :: XFontStruct
      type(C_PTR) ext_data
      integer(Font) fid
      integer(C_INT) direction
      integer(C_INT) min_char_or_byte2
      integer(C_INT) max_char_or_byte2
      integer(C_INT) min_byte1
      integer(C_INT) max_byte1
      integer(Bool) all_chars_exist
      integer(C_INT) default_char
      integer(C_INT) n_properties
      type(C_PTR) properties          ! XFontProp *properties
      type(XCharStruct) min_bounds
      type(XCharStruct) max_bounds
      type(C_PTR) per_char            ! XCharStruct *per_char
      integer(C_INT) ascent
      integer(C_INT) descent
   end type XFontStruct

   type, bind(C), public :: XGCValues
      integer(C_INT) function
      integer(C_LONG) plane_mask
      integer(C_LONG) foreground
      integer(C_LONG) background
      integer(C_INT) line_width
      integer(C_INT) line_style
      integer(C_INT) cap_style
      integer(C_INT) join_style
      integer(C_INT) fill_style
      integer(C_INT) fill_rule
      integer(C_INT) arc_mode
      integer(Pixmap) tile
      integer(Pixmap) stipple
      integer(C_INT) ts_x_origin
      integer(C_INT) ts_y_origin
      integer(Font) font
      integer(C_INT) subwindow_mode
      integer(Bool) graphics_exposures
      integer(C_INT) clip_x_origin
      integer(C_INT) clip_y_origin
      integer(Pixmap) clip_mask
      integer(C_INT) dash_offset
      character(KIND=C_CHAR) dashes
   end type XGCValues

   type, bind(C), public :: T_POINT
      integer(C_INT) x
      integer(C_INT) y
   end type T_POINT

   type, bind(C), public :: XSizeHints
      integer(C_LONG) flags
      integer(C_INT) x
      integer(C_INT) y
      integer(C_INT) width
      integer(C_INT) height
      integer(C_INT) min_width
      integer(C_INT) min_height
      integer(C_INT) max_width
      integer(C_INT) max_height
      integer(C_INT) width_inc
      integer(C_INT) height_inc
      type(T_POINT) min_aspect
      type(T_POINT) max_aspect
      integer(C_INT) base_width
      integer(C_INT) base_height
      integer(C_INT) win_gravity
! May grow in the future
   end type XSizeHints

   type, bind(C), public :: XWMHints
      integer(C_LONG) flags
      integer(Bool) input
      integer(C_INT) initial_state
      integer(Pixmap) icon_pixmap
      integer(Window) icon_window
      integer(C_INT) icon_x
      integer(C_INT) icon_y
      integer(Pixmap) icon_mask
      integer(XID) window_group
! May grow in the future
   end type XWMHints

   type, bind(C), public :: XClassHint
      type(C_PTR) res_name  ! char *res_name
      type(C_PTR) res_class ! char *res_class
   end type XClassHint

   type, bind(C), public :: XSetWindowAttributes
      integer(Pixmap) background_pixmap
      integer(C_LONG) background_pixel
      integer(Pixmap) border_pixmap
      integer(C_LONG) border_pixel
      integer(C_INT) bit_gravity
      integer(C_INT) win_gravity
      integer(C_INT) backing_store
      integer(C_LONG) backing_planes
      integer(C_LONG) backing_pixel
      integer(Bool) save_under
      integer(C_LONG) event_mask
      integer(C_LONG) do_not_propagate_mask
      integer(Bool) override_redirect
      integer(Colormap) colormap
      integer(Cursor) cursor
   end type XSetWindowAttributes

   type, bind(C), public :: XVisualInfo
      type(C_PTR) visual
      integer(VisualID) visualid
      integer(C_INT) screen
      integer(C_INT) depth
      integer(C_INT) class
      integer(C_LONG) red_mask
      integer(C_LONG) green_mask
      integer(C_LONG) blue_mask
      integer(C_INT) colormap_size
      integer(C_INT) bits_per_rgb
   end type XVisualInfo

   type, bind(C), public :: Visual
      type(C_PTR) ext_data
      integer(VisualID) visualid
      integer(C_INT) class
      integer(C_LONG) red_mask, green_mask, blue_mask
      integer(C_INT) bits_per_rgb
      integer(C_INT) map_entries
   end type Visual

   type, bind(C), public :: XClientMessageEvent
      integer(C_INT) type
      integer(C_LONG) serial
      integer(Bool) send_event
      type(PDisplay) display
      integer(Window) window
      integer(Atom) message_type
      integer(C_INT) format
      integer(C_LONG) data(5)
! union {
!   char b[20];
!   short s[10];
!   long l[5];
! } data;
   end type XClientMessageEvent

   public XAllocSizeHints
   interface
      function XAllocSizeHints() bind(C,name='XAllocSizeHints')
         import
         implicit none
         type(C_PTR) XAllocSizeHints
      end function XAllocSizeHints
   end interface

   public XAllocWMHints
   interface
      function XAllocWMHints() bind(C,name='XAllocWMHints')
         import
         implicit none
         type(C_PTR) XAllocWMHints
      end function XAllocWMHints
   end interface

   public XAllocClassHint
   interface
      function XAllocClassHint() bind(C,name='XAllocClassHint')
         import
         implicit none
         type(C_PTR) XAllocClassHint
      end function XAllocClassHint
   end interface

   public XOpenDisplay
   interface
      function XOpenDisplay(display_name) bind(C,name='XOpenDisplay')
         import
         implicit none
         type(PDisplay) XOpenDisplay
         character(KIND=C_CHAR), intent(in) :: display_name(*)
      end function XOpenDisplay
   end interface

   public XDefaultScreen
   interface
      function XDefaultScreen(display) bind(C,name='XDefaultScreen')
         import
         implicit none
         integer(C_INT) XDefaultScreen
         type(PDisplay), value :: display
      end function XDefaultScreen
   end interface

   public XDisplayWidth
   interface
      function XDisplayWidth(display,screen_number) bind(C,name='XDisplayWidth')
         import
         implicit none
         integer(C_INT) XDisplayWidth
         type(PDisplay), value :: display
         integer(C_INT), value :: screen_number
      end function XDisplayWidth
   end interface

   public XDisplayHeight
   interface
      function XDisplayHeight(display,screen_number) bind(C,name='XDisplayHeight')
         import
         implicit none
         integer(C_INT) XDisplayHeight
         type(PDisplay), value :: display
         integer(C_INT), value :: screen_number
      end function XDisplayHeight
   end interface

   public XCreateSimpleWindow
   interface
      function XCreateSimpleWindow(display,parent,x,y,width,height, &
         border_width,border,background) bind(C,name='XCreateSimpleWindow')
         import
         implicit none
         integer(Window) XCreateSimpleWindow
         type(PDisplay), value :: display
         integer(Window), value :: parent
         integer(C_INT), value :: x
         integer(C_INT), value :: y
         integer(C_INT), value :: width
         integer(C_INT), value :: height
         integer(C_INT), value :: border_width
         integer(C_LONG), value :: border
         integer(C_LONG), value :: background
      end function XCreateSimpleWindow
   end interface

   public XDefaultRootWindow
   interface
      function XDefaultRootWindow(display) bind(C,name='XDefaultRootWindow')
         import
         implicit none
         integer(Window) XDefaultRootWindow
         type(PDisplay), value :: display
      end function XDefaultRootWindow
   end interface

   public XRootWindow
   interface
      function XRootWindow(display, screen_number) bind(C,name='XRootWindow')
         import
         implicit none
         integer(Window) XRootWindow
         type(PDisplay), value :: display
         integer(C_INT), value :: screen_number
      end function XRootWindow
   end interface

   public XBlackPixel
   interface
      function XBlackPixel(display,screen_number) bind(C,name='XBlackPixel')
         import
         implicit none
         integer(C_LONG) XBlackPixel
         type(PDisplay), value :: display
         integer(C_INT), value :: screen_number
      end function XBlackPixel
   end interface

   public XWhitePixel
   interface
      function XWhitePixel(display,screen_number) bind(C,name='XWhitePixel')
         import
         implicit none
         integer(C_LONG) XWhitePixel
         type(PDisplay), value :: display
         integer(C_INT), value :: screen_number
      end function XWhitePixel
   end interface

   public XStringListToTextProperty
   interface
      function XStringListToTextProperty(list,count, &
         text_prop_return) bind(C,name='XStringListToTextProperty')
         import
         implicit none
         integer(Status) XStringListToTextProperty
         type(C_PTR) list(*)
         integer(C_INT), value :: count
         type(XTextProperty) text_prop_return
      end function XStringListToTextProperty
   end interface

   public XSetWMProperties
   interface
      subroutine XSetWMProperties(display,w,window_name,icon_name, &
        argv,argc,normal_hints,wm_hints,class_hints) &
        bind(C,name='XSetWMProperties')
        import
        implicit none
        type(PDisplay), value :: display
        integer(Window), value :: w
        type(XTextProperty) window_name
        type(XTextProperty) icon_name
        type(C_PTR) argv(*)
        integer(C_INT), value :: argc
        type(C_PTR), value :: normal_hints
        type(C_PTR), value :: wm_hints
        type(C_PTR), value :: class_hints
      end subroutine XSetWMProperties
   end interface

   public XSelectInput
   interface
      function XSelectInput(display,w,event_mask) bind(C,name='XSelectInput')
         import
         implicit none
         integer(C_INT) XSelectInput
         type(PDisplay), value :: display
         integer(Window), value :: w
         integer(C_LONG), value :: event_mask
      end function XSelectInput
   end interface

   public XLoadQueryFont
   interface
      function XLoadQueryFont(display,name) bind(C,name='XLoadQueryFont')
         import
         implicit none
         type(C_PTR) XLoadQueryFont
         type(PDisplay), value :: display
         character(KIND=C_CHAR) name(*)
      end function XLoadQueryFont
   end interface

   public XCreateGC
   interface
      function XCreateGC(display,d,valuemask,values) bind(C,name='XCreateGC')
         import
         implicit none
         type(C_PTR) XCreateGC
         type(PDisplay), value :: display
         integer(Drawable), value :: d
         integer(C_LONG), value :: valuemask
         type(XGCValues) :: values
      end function XCreateGC
   end interface

   public XSetFont
   interface
      function XSetFont(display,gc,font_) bind(C,name='XSetFont')
         import
         implicit none
         integer(C_INT) XSetFont
         type(PDisplay), value :: display
         type(C_PTR), value :: gc
         integer(Font), value :: font_
      end function XSetFont
   end interface

   public XSetForeground
   interface
      function XSetForeground(display,gc,foreground) bind(C,name='XSetForeground')
         import
         implicit none
         integer(C_INT) XSetForeground
         type(PDisplay), value :: display
         type(C_PTR), value :: gc
         integer(C_LONG), value :: foreground
      end function XSetForeground
   end interface

   public XMapWindow
   interface
      function XMapWindow(display,w) bind(C,name='XMapWindow')
         import
         implicit none
         integer(C_INT) XMapWindow
         type(PDisplay), value :: display
         integer(Window), value :: w
      end function XMapWindow
   end interface

   public XNextEvent
   interface
      function XNextEvent(display,event_return) bind(C,name='XNextEvent')
         import
         implicit none
         integer(C_INT) XNextEvent
         type(PDisplay), value :: display
         type(XEvent) event_return
      end function XNextEvent
   end interface

   public XTextWidth
   interface
      function XTextWidth(font_struct,string,count) bind(C,name='XTextWidth')
         import
         implicit none
         integer(C_INT) XTextWidth
         type(XFontStruct) font_struct
         character(KIND=C_CHAR) string(*)
         integer(C_INT), value :: count
      end function XTextWidth
   end interface

   public XDrawString
   interface
      function XDrawString(display,d,gc,x,y,string,length) bind(C,name='XDrawString')
         import
         implicit none
         integer(C_INT) XDrawString
         type(PDisplay), value :: display
         integer(Drawable), value :: d
         type(C_PTR), value :: gc
         integer(C_INT), value :: x
         integer(C_INT), value :: y
         character(KIND=C_CHAR) string(*)
         integer(C_INT), value :: length
      end function XDrawString
   end interface

   public XUnloadFont
   interface
      function XUnloadFont(display,font_) bind(C,name='XUnloadFont')
         import
         implicit none
         integer(C_INT) XUnloadFont
         type(PDisplay), value :: display
         integer(Font), value :: font_
      end function XUnloadFont
   end interface

   public XFreeGC
   interface
      function XFreeGC(display,gc) bind(C,name='XFreeGC')
         import
         implicit none
         integer(C_INT) XFreeGC
         type(PDisplay), value :: display
         type(C_PTR), value :: gc
      end function XFreeGC
   end interface

   public XCloseDisplay
   interface
      function XCloseDisplay(display) bind(C,name='XCloseDisplay')
         import
         implicit none
         integer(C_INT) XCloseDisplay
         type(PDisplay), value :: display
      end function XCloseDisplay
   end interface

   public XGrabKeyboard
   interface
      function XGrabKeyboard(display, grab_window, owner_events, pointer_mode, &
         keyboard_mode, time_) bind(C,name='XGrabKeyboard')
         import
         implicit none
         integer(C_INT) XGrabKeyboard
         type(PDisplay), value :: display
         integer(Window), value :: grab_window
         integer(Bool), value :: owner_events
         integer(C_INT), value :: pointer_mode
         integer(C_INT), value :: keyboard_mode
         integer(Time), value :: time_
      end function XGrabKeyboard
   end interface

   public XCreateColormap
   interface
      function XCreateColormap(display, w, visual_, alloc) &
         bind(C,name='XCreateColormap')
         import
         implicit none
         integer(Colormap) XCreateColormap
         type(PDisplay), value :: display
         integer(Window), value :: w
         type(Visual) visual_
         integer(C_INT), value :: alloc
      end function XCreateColormap
   end interface

   public XFree
   interface
      function XFree(data) bind(C,name='XFree')
         import
         implicit none
         integer(C_INT) XFree
         type(C_PTR), value :: data
      end function XFree
   end interface

   public XCreateWindow
   interface
      function XCreateWindow(display,parent,x,y,width,height,border_width, &
         depth,class,visual_,valuemask,attributes) bind(C,name='XCreateWindow')
         import
         implicit none
         integer(Window) XCreateWindow
         type(PDisplay), value :: display
         integer(Window), value :: parent
         integer(C_INT), value :: x
         integer(C_INT), value :: y
         integer(C_INT), value :: width
         integer(C_INT), value :: height
         integer(C_INT), value :: border_width
         integer(C_INT), value :: depth
         integer(C_INT), value :: class
         type(Visual) visual_
         integer(C_LONG), value :: valuemask
         type(XSetWindowAttributes) attributes
      end function XCreateWindow
   end interface

   public XWarpPointer
   interface
      function XWarpPointer(display,src_w,dest_w,src_x,src_y,src_width, &
         src_height,dest_x,dest_y) bind(C,name='XWarpPointer')
         import
         implicit none
         integer(C_INT) XWarpPointer
         type(PDisplay), value :: display
         integer(Window), value :: src_w
         integer(Window), value :: dest_w
         integer(C_INT), value :: src_x
         integer(C_INT), value :: src_y
         integer(C_INT), value :: src_width
         integer(C_INT), value :: src_height
         integer(C_INT), value :: dest_x
         integer(C_INT), value :: dest_y
      end function XWarpPointer
   end interface

   public XMapRaised
   interface
      function XMapRaised(display, w) bind(C,name='XMapRaised')
         import
         implicit none
         integer(C_INT) XMapRaised
         type(PDisplay), value :: display
         integer(Window), value :: w
      end function XMapRaised
   end interface

   public XGrabPointer
   interface
      function XGrabPointer(display,grab_window,owner_events,event_mask, &
         pointer_mode,keyboard_mode,confine_to,cursor_,time_) &
         bind(C,name='XGrabPointer')
         import
         implicit none
         integer(C_INT) XGrabPointer
         type(PDisplay), value :: display
         integer(Window), value :: grab_window
         integer(Bool), value :: owner_events
         integer(C_INT), value :: event_mask
         integer(C_INT), value :: pointer_mode
         integer(C_INT), value :: keyboard_mode
         integer(Window), value :: confine_to
         integer(Cursor), value :: cursor_
         integer(Time), value :: time_
      end function XGrabPointer
   end interface

   public XSetWMProtocols
   interface
      function XSetWMProtocols(display,w,protocols,count) &
         bind(C,name='XSetWMProtocols')
         import
         implicit none
         integer(Status) XSetWMProtocols
         type(PDisplay), value :: display
         integer(Window), value :: w
         integer(Atom) protocols
         integer(C_INT), value :: count
      end function XSetWMProtocols
   end interface

   public XSetStandardProperties
   interface
      subroutine XSetStandardProperties(display,w,window_name,icon_name, &
         icon_pixmap,argv,argc,hints) bind(C,name='XSetStandardProperties')
         import
         implicit none
         type(PDisplay), value :: display
         integer(Window), value :: w
         character(KIND=C_CHAR), intent(in) :: window_name(*)
         character(KIND=C_CHAR), intent(in) :: icon_name(*)
         integer(Pixmap), value :: icon_pixmap
         type(C_PTR) argv(*)
         integer(C_INT), value :: argc
         type(XSizeHints) hints
      end subroutine XSetStandardProperties
   end interface

   public XInternAtom
   interface
      function XInternAtom(display,atom_name,only_if_exists) &
         bind(C,name='XInternAtom')
         import
         implicit none
         integer(Atom) XInternAtom
         type(PDisplay), value :: display
         character(KIND=C_CHAR), intent(in) :: atom_name
         integer(Bool), value :: only_if_exists
      end function XInternAtom
   end interface

   public XLookupKeysym
   interface
      function XLookupKeysym(key_event,index) bind(C,name='XLookupKeysym')
         import
         implicit none
         integer(KeySym) XLookupKeysym
         type(XKeyEvent) key_event
         integer(C_INT), value :: index
      end function XLookupKeysym
   end interface

   public XGetAtomName
   interface
      function XGetAtomName(display,atom_) bind(C,name='XGetAtomName')
         import
         implicit none
         type(C_PTR) XGetAtomName
         type(PDisplay), value :: display
         integer(Atom), value :: atom_
      end function XGetAtomName
   end interface

   public XPending
   interface
      function XPending(display) bind(C,name='XPending')
         import
         implicit none
         integer(C_INT) XPending
         type(PDisplay), value :: display
      end function XPending
   end interface

   public XGetGeometry
   interface
      function  XGetGeometry(display,d,root_return,x_return,y_return,width_return, &
         height_return,border_width_return,depth_return) bind(C,name='XGetGeometry')
         import
         implicit none
         integer(Status) XGetGeometry
         type(PDisplay), value :: display
         integer(Drawable), value :: d
         integer(Window) root_return
         integer(C_INT) x_return
         integer(C_INT) y_return
         integer(C_INT) width_return
         integer(C_INT) height_return
         integer(C_INT) border_width_return
         integer(C_INT) depth_return
      end function  XGetGeometry
   end interface

   public XFlush
   interface
      function XFlush(display) bind(C,name='XFlush')
         import
         implicit none
         integer(C_INT) XFlush
         type(PDisplay), value :: display
      end function XFlush
   end interface

   public XSendEvent
   interface
      function XSendEvent(display,w,propagate,event_mask,event_send) &
         bind(C,name='XSendEvent')
         import
         implicit none
         integer(Status) XSendEvent
         type(PDisplay), value :: display
         integer(Window), value :: w
         integer(Bool), value :: propagate
         integer(C_LONG), value :: event_mask
         type(XEvent) event_send
      end function XSendEvent
   end interface

end module Xlib

module xf86
   use ISO_C_BINDING
   use Xlib
   implicit none
   private

   integer(Status), parameter, public :: MODE_OK = 0
   integer(Status), parameter, public :: MODE_BAD = -2

   type, bind(C), public :: XF86VidModeModeInfo
      integer(C_INT) dotclock
      integer(C_SHORT) hdisplay
      integer(C_SHORT) hsyncstart
      integer(C_SHORT) hsyncend
      integer(C_SHORT) htotal
      integer(C_SHORT) hskew
      integer(C_SHORT) vdisplay
      integer(C_SHORT) vsyncstart
      integer(C_SHORT) vsyncend
      integer(C_SHORT) vtotal
      integer(C_INT) flags
      integer(C_INT) privsize
      type(C_PTR) private
   end type XF86VidModeModeInfo

   type, bind(C), public :: XF86VidModeModeLine
      integer(C_SHORT) hdisplay
      integer(C_SHORT) hsyncstart
      integer(C_SHORT) hsyncend
      integer(C_SHORT) htotal
      integer(C_SHORT) hskew
      integer(C_SHORT) vdisplay
      integer(C_SHORT) vsyncstart
      integer(C_SHORT) vsyncend
      integer(C_SHORT) vtotal
      integer(C_INT) flags
      integer(C_INT) privsize
      type(C_PTR) private
   end type XF86VidModeModeLine

   public XF86VidModeQueryVersion
   interface
      function XF86VidModeQueryVersion(display,major_version_return, &
         minor_version_return) bind(C,name='XF86VidModeQueryVersion')
         import
         implicit none
         integer(Bool) XF86VidModeQueryVersion
         type(PDisplay), value :: display
         integer(C_INT) major_version_return
         integer(C_INT) minor_version_return
      end function XF86VidModeQueryVersion
   end interface

   public XF86VidModeGetAllModeLines
   interface
      function XF86VidModeGetAllModeLines(display,screen,modecount_return, &
         modesinfo) bind(C,name='XF86VidModeGetAllModeLines')
         import
         implicit none
         integer(Bool) XF86VidModeGetAllModeLines
         type(PDisplay), value :: display
         integer(C_INT), value :: screen
         integer(C_INT) modecount_return
         type(C_PTR) modesinfo
      end function XF86VidModeGetAllModeLines
   end interface

   public XF86VidModeSwitchToMode
   interface
      function XF86VidModeSwitchToMode(dpy, screen, modeline) &
         bind(C,name='XF86VidModeSwitchToMode')
         import
         implicit none
         integer(Bool) XF86VidModeSwitchToMode
         type(PDisplay), value :: dpy
         integer(C_INT), value :: screen
         type(XF86VidModeModeInfo) modeline
      end function XF86VidModeSwitchToMode
   end interface

   public XF86VidModeSetViewPort
   interface
      function XF86VidModeSetViewPort(dpy, screen, x, y) &
         bind(C,name='XF86VidModeSetViewPort')
         import
         implicit none
         integer(Bool) XF86VidModeSetViewPort
         type(PDisplay), value :: dpy
         integer(C_INT), value :: screen
         integer(C_INT), value :: x
         integer(C_INT), value :: y
      end function XF86VidModeSetViewPort
   end interface

   public XF86VidModeValidateModeLine
   interface
      function XF86VidModeValidateModeLine(display,screen,modeline) &
         bind(C,name='XF86VidModeValidateModeLine')
         import
         implicit none
         integer(Status) XF86VidModeValidateModeLine
         type(PDisplay), value :: display
         integer(C_INT), value :: screen
         type(XF86VidModeModeInfo) modeline
      end function XF86VidModeValidateModeLine
   end interface
end module xf86

module glx
   use ISO_C_BINDING
   use ISO_C_BINDING, only: C_PTR=>C_PTR, GLXContext=>C_PTR
   use Xlib
   implicit none
   private
   public GLXContext

   integer(C_INT), parameter, public :: GLXDrawable = XID

   integer(C_INT), parameter, public :: GLX_RGBA = 4
   integer(C_INT), parameter, public :: GLX_DOUBLEBUFFER = 5
   integer(C_INT), parameter, public :: GLX_RED_SIZE = 8
   integer(C_INT), parameter, public :: GLX_GREEN_SIZE = 9
   integer(C_INT), parameter, public :: GLX_BLUE_SIZE = 10
   integer(C_INT), parameter, public :: GLX_DEPTH_SIZE = 12

   public glXSwapBuffers
   interface
      subroutine glXSwapBuffers(dpy, drawable) bind(C,name='glXSwapBuffers')
         import
         implicit none
         type(PDisplay), value :: dpy
         integer(GLXDrawable), value :: drawable
      end subroutine glXSwapBuffers
   end interface

   public glXChooseVisual
   interface
      function glXChooseVisual(dpy,screen,attribList) bind(C,name='glXChooseVisual')
         import
         implicit none
         type(C_PTR) glXChooseVisual
         type(PDisplay), value :: dpy
         integer(C_INT), value :: screen
         integer(C_INT) :: attribList(*)
      end function glXChooseVisual
   end interface

   public glXQueryVersion
   interface
      function glXQueryVersion(dpy,maj,min) bind(C,name='glXQueryVersion')
         import
         implicit none
         integer(Bool) glXQueryVersion
         type(PDisplay), value :: dpy
         integer(C_INT) maj
         integer(C_INT) min
      end function glXQueryVersion
   end interface

   public glXCreateContext
   interface
      function glXCreateContext(dpy, vis, sharelist, direct) &
         bind(C,name = 'glXCreateContext')
         import
         implicit none
         type(GLXContext) glXCreateContext
         type(PDisplay), value :: dpy
         type(XVisualInfo) vis
         type(GLXContext), value :: sharelist
         integer(Bool), value :: direct
      end function glXCreateContext
   end interface

   public glXIsDirect
   interface
      function glXIsDirect(dpy,ctx) bind(C,name='glXIsDirect')
          import
          implicit none
          integer(Bool) glXIsDirect
          type(PDisplay), value :: dpy
          type(GLXContext), value :: ctx
      end function glXIsDirect
   end interface

   public glXMakeCurrent
   interface
      function glXMakeCurrent(dpy,drawable,ctx) bind(C,name='glXMakeCurrent')
         import
         implicit none
         integer(Bool) glXMakeCurrent
         type(PDisplay), value :: dpy
         integer(GLXDrawable), value :: drawable
         type(GLXContext), value :: ctx
      end function glXMakeCurrent
   end interface

   public glXDestroyContext
   interface
      subroutine glXDestroyContext(dpy,ctx) bind(C,name='glXDestroyContext')
         import
         implicit none
         type(PDisplay), value :: dpy
         type(GLXContext), value :: ctx
      end subroutine glXDestroyContext
   end interface
end module glx

module gl
   use ISO_C_BINDING
   implicit none
   private
   integer, parameter, public :: &
      GLenum = C_INT, &
      GLint = C_INT, &
      GLsizei = C_INT, &
      GLclampd = C_DOUBLE, &
      GLfloat = C_FLOAT, &
      GLclampf = C_FLOAT, &
      GLbitfield = C_INT, &
      GLuint = C_INT, &
      GLbool = C_INT, &
      GLdouble = C_DOUBLE

   integer(GLenum), parameter, public :: GL_PROJECTION = int(Z'1701',GLenum)
   integer(GLenum), parameter, public :: GL_MODELVIEW = int(Z'1700',GLenum)
   integer(GLenum), parameter, public :: GL_SMOOTH = int(Z'1D01',GLenum)
   integer(GLenum), parameter, public :: GL_DEPTH_TEST = int(Z'0B71',GLenum)
   integer(GLenum), parameter, public :: GL_LEQUAL = int(Z'0203',GLenum)
   integer(GLbitfield), parameter, public :: GL_COLOR_BUFFER_BIT = int(Z'00004000',GLbitfield)
   integer(GLbitfield), parameter, public :: GL_DEPTH_BUFFER_BIT = int(Z'00000100',GLbitfield)
   integer(GLenum), parameter, public :: GL_CULL_FACE = int(Z'0B44',GLenum)
   integer(GLenum), parameter, public :: GL_LIGHTING = int(Z'0B50',GLenum)
   integer(GLenum), parameter, public :: GL_FRONT = int(Z'0404',GLenum)
   integer(GLenum), parameter, public :: GL_AMBIENT_AND_DIFFUSE = int(Z'1602',GLenum)
   integer(GLenum), parameter, public :: GL_SPECULAR = int(Z'1202',GLenum)
   integer(GLenum), parameter, public :: GL_SHININESS = int(Z'1601',GLenum)
!   integer(GLbool), parameter, public :: GL_TRUE = 1
   integer(GLenum), parameter, public :: &
      GL_PERSPECTIVE_CORRECTION_HINT = int(z'0C50',GLenum)
   integer(GLenum), parameter, public :: GL_NICEST = int(z'1102',GLenum)

   integer(GLenum), parameter, public :: GL_LIGHT_MODEL_AMBIENT = int(Z'0B53',GLenum)
   integer(GLenum), parameter, public :: GL_LIGHT_MODEL_COLOR_CONTROL = int(Z'81F8',GLenum)
   integer(GLint), parameter, public :: GL_SEPARATE_SPECULAR_COLOR = int(Z'81FA',GLint)
   integer(GLbool), parameter, public :: BOOL_TRUE = 1
   integer(GLbool), parameter, public :: BOOL_FALSE = 0
   integer(GLenum), parameter, public :: GL_LIGHT_MODEL_LOCAL_VIEWER = int(Z'0B51',GLenum)
   integer(GLenum), parameter, public :: GL_LIGHT_MODEL_TWO_SIDE = int(Z'0B52',GLenum)
!   integer(GLenum), parameter, public :: GL_SMOOTH = int(Z'1D01',GLenum)
   integer(GLenum), parameter, public :: GL_LIGHT0 = int(Z'4000',GLenum)
   integer(GLenum), parameter, public :: GL_LIGHT1 = int(Z'4001',GLenum)
   integer(GLenum), parameter, public :: GL_AMBIENT = int(Z'1200',GLenum)
   integer(GLenum), parameter, public :: GL_DIFFUSE = int(Z'1201',GLenum)
!   integer(GLenum), parameter, public :: GL_SPECULAR = int(Z'1202',GLenum)
   integer(GLenum), parameter, public :: GL_POSITION = int(Z'1203',GLenum)
   integer(GLenum), parameter, public :: GL_SPOT_DIRECTION = int(Z'1204',GLenum)
   integer(GLenum), parameter, public :: GL_SPOT_EXPONENT = int(Z'1205',GLenum)
   integer(GLenum), parameter, public :: GL_SPOT_CUTOFF = int(Z'1206',GLenum)
   integer(GLenum), parameter, public :: GL_CONSTANT_ATTENUATION = int(Z'1207',GLenum)
   integer(GLenum), parameter, public :: GL_LINEAR_ATTENUATION = int(Z'1208',GLenum)
   integer(GLenum), parameter, public :: GL_QUADRATIC_ATTENUATION = int(Z'1209',GLenum)
   integer(GLenum), parameter, public :: GL_COMPILE = int(Z'1300',GLenum)
   integer(GLenum), parameter, public :: GL_TRIANGLE_STRIP = int(Z'0005',GLenum)
   integer(GLenum), parameter, public :: GL_TRIANGLE_FAN = int(Z'0006',GLenum)

   public glViewport
   interface
      subroutine glViewport(x,y,width,height) &
         bind(C,name='glViewport')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glViewport
!!GCC$ ATTRIBUTES STDCALL :: glViewport
         integer(GLint),value :: x
         integer(GLint),value :: y
         integer(GLsizei),value :: width
         integer(GLsizei),value :: height
      end subroutine glViewport
   end interface

   public glMatrixMode
   interface
      subroutine glMatrixMode(mode) &
         bind(C,name='glMatrixMode')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glMatrixMode
!!GCC$ ATTRIBUTES STDCALL :: glMatrixMode
         integer(GLenum),value :: mode
      end subroutine glMatrixMode
   end interface

   public glLoadIdentity
   interface
      subroutine glLoadIdentity() bind(C,name='glLoadIdentity')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glLoadIdentity
!!GCC$ ATTRIBUTES STDCALL :: glLoadIdentity
      end subroutine glLoadIdentity
   end interface

   public glShadeModel
   interface
      subroutine glShadeModel(mode) &
         bind(C,name='glShadeModel')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glShadeModel
!!GCC$ ATTRIBUTES STDCALL :: glShadeModel
         integer(GLenum),value :: mode
      end subroutine glShadeModel
   end interface

   public glClearDepth
   interface
      subroutine glClearDepth(depth) &
         bind(C,name='glClearDepth')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glClearDepth
!!GCC$ ATTRIBUTES STDCALL :: glClearDepth
         real(GLclampd),value :: depth
      end subroutine glClearDepth
   end interface

   public glEnable
   interface
      subroutine glEnable(cap) &
         bind(C,name='glEnable')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glEnable
!!GCC$ ATTRIBUTES STDCALL :: glEnable
         integer(GLenum),value :: cap
      end subroutine glEnable
   end interface

   public glDepthFunc
   interface
      subroutine glDepthFunc(func) &
         bind(C,name='glDepthFunc')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glDepthFunc
!!GCC$ ATTRIBUTES STDCALL :: glDepthFunc
         integer(GLenum),value :: func
      end subroutine glDepthFunc
   end interface

   public glClearColor
   interface
      subroutine glClearColor(red,green,blue,alpha) &
         bind(C,name='glClearColor')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glClearColor
!!GCC$ ATTRIBUTES STDCALL :: glClearColor
         real(GLclampf),value :: red
         real(GLclampf),value :: green
         real(GLclampf),value :: blue
         real(GLclampf),value :: alpha
      end subroutine glClearColor
   end interface

   public glClear
   interface
      subroutine glClear(mask) &
         bind(C,name='glClear')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glClear
!!GCC$ ATTRIBUTES STDCALL :: glClear
         integer(GLbitfield),value :: mask
      end subroutine glClear
   end interface

   public glPushMatrix
   interface
      subroutine glPushMatrix() bind(C,name='glPushMatrix')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glPushMatrix
!!GCC$ ATTRIBUTES STDCALL :: glPushMatrix
      end subroutine glPushMatrix
   end interface

   public glTranslatef
   interface
      subroutine glTranslatef(x,y,z) &
         bind(C,name='glTranslatef')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glTranslatef
!!GCC$ ATTRIBUTES STDCALL :: glTranslatef
         real(GLfloat),value :: x
         real(GLfloat),value :: y
         real(GLfloat),value :: z
      end subroutine glTranslatef
   end interface

   public glRotatef
   interface
      subroutine glRotatef(angle,x,y,z) &
         bind(C,name='glRotatef')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glRotatef
!!GCC$ ATTRIBUTES STDCALL :: glRotatef
         real(GLfloat),value :: angle
         real(GLfloat),value :: x
         real(GLfloat),value :: y
         real(GLfloat),value :: z
      end subroutine glRotatef
   end interface

   public glMaterialfv
   interface
      subroutine glMaterialfv(face,pname,params) &
         bind(C,name='glMaterialfv')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glMaterialfv
!!GCC$ ATTRIBUTES STDCALL :: glMaterialfv
         integer(GLenum),value :: face
         integer(GLenum),value :: pname
         real(GLfloat),intent(in) :: params(*)
      end subroutine glMaterialfv
   end interface

   public glMaterialf
   interface
      subroutine glMaterialf(face,pname,param) &
         bind(C,name='glMaterialf')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glMaterialf
!!GCC$ ATTRIBUTES STDCALL :: glMaterialf
         integer(GLenum),value :: face
         integer(GLenum),value :: pname
         real(GLfloat),value :: param
      end subroutine glMaterialf
   end interface

   public glCallList
   interface
      subroutine glCallList(list) &
         bind(C,name='glCallList')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glCallList
!!GCC$ ATTRIBUTES STDCALL :: glCallList
         integer(GLuint),value :: list
      end subroutine glCallList
   end interface

   public glPopMatrix
   interface
      subroutine glPopMatrix() bind(C,name='glPopMatrix')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glPopMatrix
!!GCC$ ATTRIBUTES STDCALL :: glPopMatrix
      end subroutine glPopMatrix
   end interface

   public glFlush
   interface
      subroutine glFlush() bind(C,name='glFlush')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glFlush
!!GCC$ ATTRIBUTES STDCALL :: glFlush
      end subroutine glFlush
   end interface

   public glHint
   interface
      subroutine glHint(target, mode) bind(C,name='glHint')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glHint
!!GCC$ ATTRIBUTES STDCALL :: glHint
         integer(GLenum), value :: target
         integer(GLenum), value :: mode
      end subroutine glHint
   end interface

   public glGetError
   interface
      function glGetError() bind(C,name='glGetError')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glGetError
!!GCC$ ATTRIBUTES STDCALL :: glGetError
         integer(glEnum) glGetError
      end function glGetError
   end interface

   public glLightModelfv, glLightModeli
   interface
      subroutine glLightModelfv(pname,params) &
         bind(C,name='glLightModelfv')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glLightModelfv
!!GCC$ ATTRIBUTES STDCALL :: glLightModelfv
         integer(GLenum),value :: pname
         real(GLfloat),intent(in) :: params(*)
      end subroutine glLightModelfv

      subroutine glLightModeli(pname,param) &
         bind(C,name='glLightModeli')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glLightModeli
!!GCC$ ATTRIBUTES STDCALL :: glLightModeli
         integer(GLenum),value :: pname
         integer(GLint),value :: param
      end subroutine glLightModeli
   end interface

   public glLightf
   interface
      subroutine glLightf(light,pname,param) &
         bind(C,name='glLightf')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glLightf
!!GCC$ ATTRIBUTES STDCALL :: glLightf
         integer(GLenum),value :: light
         integer(GLenum),value :: pname
         real(GLfloat),value :: param
      end subroutine glLightf
   end interface

   public glLightfv
   interface
      subroutine glLightfv(light,pname,params) &
         bind(C,name='glLightfv')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glLightfv
!!GCC$ ATTRIBUTES STDCALL :: glLightfv
         integer(GLenum),value :: light
         integer(GLenum),value :: pname
         real(GLfloat),intent(in) :: params(*)
      end subroutine glLightfv
   end interface
   public glGenLists
   interface
      function glGenLists(range) &
         bind(C,name='glGenLists')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glGenLists
!!GCC$ ATTRIBUTES STDCALL :: glGenLists
         integer(GLuint) glGenLists
         integer(GLsizei),value :: range
      end function glGenLists
   end interface

   public glNewList
   interface
      subroutine glNewList(list,mode) &
         bind(C,name='glNewList')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glNewList
!!GCC$ ATTRIBUTES STDCALL :: glNewList
         integer(GLuint),value :: list
         integer(GLenum),value :: mode
      end subroutine glNewList
   end interface

   public glNormal3f
   interface
      subroutine glNormal3f(nx,ny,nz) &
         bind(C,name='glNormal3f')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glNormal3f
!!GCC$ ATTRIBUTES STDCALL :: glNormal3f
         real(GLfloat),value :: nx
         real(GLfloat),value :: ny
         real(GLfloat),value :: nz
      end subroutine glNormal3f
   end interface

   public glBegin
   interface
      subroutine glBegin(mode) &
         bind(C,name='glBegin')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glBegin
!!GCC$ ATTRIBUTES STDCALL :: glBegin
         integer(GLenum),value :: mode
      end subroutine glBegin
   end interface

   public glVertex3fv
   interface
      subroutine glVertex3fv(v) &
         bind(C,name='glVertex3fv')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glVertex3fv
!!GCC$ ATTRIBUTES STDCALL :: glVertex3fv
         real(GLfloat),intent(in) :: v(3)
      end subroutine glVertex3fv
   end interface

   public glEnd
   interface
      subroutine glEnd() bind(C,name='glEnd')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glEnd
!!GCC$ ATTRIBUTES STDCALL :: glEnd
      end subroutine glEnd
   end interface

   public glEndList
   interface
      subroutine glEndList() bind(C,name='glEndList')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: glEndList
!!GCC$ ATTRIBUTES STDCALL :: glEndList
      end subroutine glEndList
   end interface

end module gl

module glu
   use ISO_C_BINDING
   use gl
   implicit none
   private

   public gluPerspective
   interface
      subroutine gluPerspective(fovy,aspect,zNear,zFar) &
         bind(C,name='gluPerspective')
         import
         implicit none
!DEC$ ATTRIBUTES STDCALL :: gluPerspective
!!GCC$ ATTRIBUTES STDCALL :: gluPerspective
         real(GLdouble),value :: fovy
         real(GLdouble),value :: aspect
         real(GLdouble),value :: zNear
         real(GLdouble),value :: zFar
      end subroutine gluPerspective
   end interface

end module glu

module procs
   use ISO_C_BINDING
   use ISO_FORTRAN_ENV
   use libc
   use Xlib
   use xf86
   use glx
   use gl
   use glu
   implicit none
   private

   real(GLfloat), volatile :: MASTER_THETA = 0.0_GLfloat
   integer(GLuint), public :: STELLATED
   real(GLdouble), parameter :: pi = 4*atan(1.0_GLdouble)
   real(GLfloat), parameter :: rsq3 = 1/sqrt(3.0_GLfloat)
   real(GLfloat),parameter :: phi = (sqrt(5.0_GLfloat)+1)/2
   real(GLfloat),parameter :: INorm = 1/sqrt(sqrt(5.0_GLfloat)*phi)
   integer(GLuint),save,public :: triangle1
   integer(GLuint),save,public :: pyramid5

   type, bind(C), public :: GLWindow
      type(PDisplay) dpy
      integer(C_INT) screen
      integer(Window) win
      type(GLXContext) ctx
      type(XSetWindowAttributes) attr
      integer(Bool) fs
      integer(Bool) doubleBuffered
      type(XF86VidModeModeInfo) deskMode
      integer(C_INT) x, y
      integer(C_INT) width, height
      integer(C_INT) depth
   end type GLWindow

   integer(C_INT) :: attrListSgl(10) = [integer(C_INT) :: &
      GLX_RGBA, &
      GLX_RED_SIZE, 4, &
      GLX_GREEN_SIZE, 4, &
      GLX_BLUE_SIZE, 4, &
      GLX_DEPTH_SIZE, 16, &
      None]

   integer(C_INT) :: attrListDbl(11) = [integer(C_INT) :: &
      GLX_RGBA, GLX_DOUBLEBUFFER, &
      GLX_RED_SIZE, 4, &
      GLX_GREEN_SIZE, 4, &
      GLX_BLUE_SIZE, 4, &
      GLX_DEPTH_SIZE, 16, &
      None]

   type(GLWindow), public :: GLWin

   character(LEN=:,KIND=C_CHAR), target, allocatable, public :: appname

   public CreateGLWindow, drawGLScene, resizeGLScene, killGLWindow, setup_handler
   contains
      recursive subroutine lightit() bind(C)
!DEC$ ATTRIBUTES STDCALL :: lightit
!!GCC$ ATTRIBUTES STDCALL :: lightit
         call glLightModelfv(GL_LIGHT_MODEL_AMBIENT, &
            [0.44_GLfloat,0.41_GLfloat,0.41_GLfloat,1.0_GLfloat])
         call glLightModeli(GL_LIGHT_MODEL_COLOR_CONTROL, &
            GL_SEPARATE_SPECULAR_COLOR)
         call glLightModeli(GL_LIGHT_MODEL_LOCAL_VIEWER,BOOL_TRUE)
         call glLightModeli(GL_LIGHT_MODEL_TWO_SIDE,BOOL_FALSE)
         call glShadeModel(GL_SMOOTH)
         call glEnable(GL_LIGHT0)
         call glLightfv(GL_LIGHT0,GL_AMBIENT, &
            [0.0_GLfloat,0.0_GLfloat,0.0_GLfloat,1.0_GLfloat])
         call glLightfv(GL_LIGHT0,GL_DIFFUSE, &
            [0.44_GLfloat,0.41_GLfloat,0.41_GLfloat,1.0_GLfloat])
         call glLightfv(GL_LIGHT0,GL_SPECULAR, &
            [0.52_GLfloat,0.52_GLfloat,0.48_GLfloat,1.0_GLfloat])
         call glLightfv(GL_LIGHT0,GL_POSITION, &
            [-2.0_GLfloat,2.0_GLfloat,0.0_GLfloat,1.0_GLfloat])
         call glLightf(GL_LIGHT0,GL_CONSTANT_ATTENUATION, &
            0.0_GLfloat)
         call glLightf(GL_LIGHT0,GL_LINEAR_ATTENUATION, &
            0.0_GLfloat)
         call glLightf(GL_LIGHT0,GL_QUADRATIC_ATTENUATION, &
            1/12.0_GLfloat)
         call glLightfv(GL_LIGHT0,GL_SPOT_DIRECTION, &
            [rsq3,-rsq3,-rsq3])
         call glLightf(GL_LIGHT0,GL_SPOT_CUTOFF,45.0_GLfloat)
         call glLightf(GL_LIGHT0,GL_SPOT_EXPONENT,20.0_GLfloat)
         call glEnable(GL_LIGHT1)
         call glLightfv(GL_LIGHT1,GL_DIFFUSE, &
            [0.41_GLfloat,0.41_GLfloat,0.44_GLfloat,1.0_GLfloat])
         call glLightfv(GL_LIGHT1,GL_SPECULAR, &
            [0.6_GLfloat,0.6_GLfloat,0.65_GLfloat,1.0_GLfloat])
         call glLightfv(GL_LIGHT1,GL_POSITION, &
            [2.0_GLfloat,2.0_GLfloat,0.0_GLfloat,1.0_GLfloat])
         call glLightf(GL_LIGHT1,GL_CONSTANT_ATTENUATION, &
            0.0_GLfloat)
         call glLightf(GL_LIGHT1,GL_LINEAR_ATTENUATION, &
            0.0_GLfloat)
         call glLightf(GL_LIGHT1,GL_QUADRATIC_ATTENUATION, &
            1/12.0_GLfloat)
         call glLightfv(GL_LIGHT1,GL_SPOT_DIRECTION, &
            [-rsq3,-rsq3,-rsq3])
         call glLightf(GL_LIGHT1,GL_SPOT_CUTOFF,60.0)
         call glLightf(GL_LIGHT1,GL_SPOT_EXPONENT,20.0)
      end subroutine lightit

      recursive function MakeStellated() bind(C)
!DEC$ ATTRIBUTES STDCALL :: MakeStellated
!!GCC$ ATTRIBUTES STDCALL :: MakeStellated
         integer(GLuint) MakeStellated
         real(GLfloat),parameter :: rotparams(4,12) = reshape([ &
            0.0_GLfloat,0.0_GLfloat,0.0_GLfloat,1.0_GLfloat, &
            180.0_GLfloat,1.0_GLfloat,0.0_GLfloat,0.0_GLfloat, &
            180.0_GLfloat,0.0_GLfloat,1.0_GLfloat,0.0_GLfloat, &
            180.0_GLfloat,0.0_GLfloat,0.0_GLfloat,1.0_GLfloat, &
            120.0_GLfloat,rsq3,rsq3,rsq3, &
            120.0_GLfloat,rsq3,rsq3,-rsq3, &
            120.0_GLfloat,rsq3,-rsq3,rsq3, &
            120.0_GLfloat,rsq3,-rsq3,-rsq3, &
            120.0_GLfloat,-rsq3,rsq3,rsq3, &
            120.0_GLfloat,-rsq3,rsq3,-rsq3, &
            120.0_GLfloat,-rsq3,-rsq3,rsq3, &
            120.0_GLfloat,-rsq3,-rsq3,-rsq3],[4,12])
         integer i
         integer iBase
         integer iApex
         integer,parameter :: nBase = 10
         integer,parameter :: nApex = 20
         real(GLfloat),parameter :: pointA(3) = &
            [0.0_GLfloat,INorm/phi**2,INorm]
         real(GLfloat),parameter :: pointB(3) = &
            [0.0_GLfloat,-INorm/phi**2,INorm]
         real(GLfloat),parameter :: pointC(3) = &
            [INorm,0.0_GLfloat,Inorm*phi]
         real(GLfloat),parameter :: stepBase(3) = &
            (pointA-pointB)/nBase
         real(GLfloat),parameter :: stepApex(3) = &
            (pointC-pointB)/nApex
         real(GLfloat) startPoint(3)
         integer nBaseOuter
         real(GLfloat) stepBaseOuter(3)
         real(GLfloat) stepBaseInner(3)

         triangle1 = glGenLists(1)
         call glNewList(triangle1,GL_COMPILE)
         call glNormal3f(-INorm,0.0_GLfloat,INorm*phi)
         do iApex = 1, nApex-1
            startPoint = pointB+stepApex*(iApex-1)
            call glBegin(GL_TRIANGLE_STRIP)
            call glVertex3fv(startPoint)
            nBaseOuter = max(2,(nBase*(nApex-iApex+1)+nApex/2)/nApex)
            stepBaseOuter = stepBase*nBase*(nApex-iApex+1)/ &
               (nApex*nBaseOuter)
            stepBaseInner = stepBase*nBase*(nApex-iApex)/ &
               (nApex*(nBaseOuter-1))
            do iBase = 1, nBaseOuter
               call glVertex3fv(startPoint+stepApex+ &
                  (iBase-1)*stepBaseInner)
               call glVertex3fv(startPoint+iBase*stepBaseOuter)
            end do
            call glEnd()
         end do
         startPoint = pointB+stepApex*(nApex-1)
         call glBegin(GL_TRIANGLE_FAN)
         call glVertex3fv(startPoint+stepApex)
         nBaseOuter = max(2,(nBase+nApex/2)/nApex)
         stepBaseOuter = stepBase*nBase/(nApex*nBaseOuter)
         do iBase = nBaseOuter, 0, -1
            call glVertex3fv(startPoint+iBase*stepBaseOuter)
         end do
         call glEnd()
         call glEndList()
         pyramid5 = glGenLists(1)
         call glNewList(pyramid5,GL_COMPILE)
         call glPushMatrix()
         do i = 1, 5
            call glCallList(triangle1)
            call glRotatef(72.0_GLfloat,INorm,0.0_GLfloat,Inorm*phi)
         end do
         call glPopMatrix()
         call glEndList()
         MakeStellated = glGenLists(1)
         call glNewList(MakeStellated,GL_COMPILE)
         call glPushMatrix()
         do i = 1, 12
            call glPushMatrix()
            call glRotatef(rotparams(1,i),rotparams(2,i),rotparams(3,i),rotparams(4,i))
            call glCallList(pyramid5)
            call glPopMatrix()
         end do
         call glPopMatrix()
         call glEndList()
      end  function MakeStellated

      recursive subroutine resizeGLScene(width,height) bind(C,name='resizeGLScene')
!DEC$ ATTRIBUTES STDCALL :: resizeGLScene
!!GCC$ ATTRIBUTES STDCALL :: resizeGLScene
         integer(C_INT),value :: width
         integer(C_INT),value :: height
         height = max(height,1)
         call glViewport(0,0,width,height)
         call glMatrixMode(GL_PROJECTION)
         call glLoadIdentity()
         if(width >= height) then
            call gluPerspective(80.0_GLdouble, &
               real(width,GLdouble)/height,1.0_GLdouble,5000.0_GLdouble)
         else
            call gluPerspective(2*180/pi*atan(height*tan(40.0_GLdouble*pi/180)/width), &
               real(width,GLdouble)/height,1.0_GLdouble,5000.0_GLdouble)
         end if
         call glMatrixMode(GL_MODELVIEW)
      end subroutine resizeGLScene

      recursive function initGL() bind(C,name='initGL')
!DEC$ ATTRIBUTES STDCALL :: initGL
!!GCC$ ATTRIBUTES STDCALL :: initGL
         integer(C_INT) initGL
         call glShadeModel(GL_SMOOTH)
write(*,*) 'In initGL',glGetError()
         call glClearDepth(1.0_GLdouble)
write(*,*) glGetError()
         call glEnable(GL_DEPTH_TEST)
write(*,*) glGetError()
         call glDepthFunc(GL_LEQUAL)
write(*,*) glGetError()
         call glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST)
write(*,*) glGetError()
         call resizeGLScene(GLWin%width,GLWin%height)
write(*,*) glGetError()
         call glFlush()
write(*,*) glGetError()
         initGL = True
      end function initGL

      recursive subroutine drawGLScene() bind(C,name='drawGLScene')
!DEC$ ATTRIBUTES STDCALL :: drawGLScene
!!GCC$ ATTRIBUTES STDCALL :: drawGLScene
         real(GLfloat) RNorm(3)
         real(GLfloat) theta

write(*,*) 'In drawGLScene'
         theta = MASTER_THETA
         call glClearColor(0.0_GLclampf,0.0_GLclampf,0.0_GLclampf,0.0_GLclampf)
write(*,*) 1,glGetError()
         call glClearDepth(1.0_GLclampd)
write(*,*) 2,glGetError()
         call glClear(ior(GL_COLOR_BUFFER_BIT,GL_DEPTH_BUFFER_BIT))
write(*,*) 3,glGetError()
         call glEnable(GL_CULL_FACE)
write(*,*) 4,glGetError()
         call glEnable(GL_LIGHTING)
write(*,*) 5,glGetError()
         call glPushMatrix()
write(*,*) 6,glGetError()
         call glLoadIdentity()
write(*,*) 7,glGetError()
         call glTranslatef(0.0_GLfloat,0.0_GLfloat,-2.0_GLfloat)
write(*,*) 7,glGetError()
         RNorm = [1.0,1.2,0.8]
         RNorm = RNorm/norm2(RNorm)
         call glRotatef(theta,RNorm(1),RNorm(2),RNorm(3))
write(*,*) 8,glGetError()
         call glMaterialfv(GL_FRONT,GL_AMBIENT_AND_DIFFUSE, &
            [0.5_GLfloat,0.52_GLfloat,0.55_GLfloat,1.0_GLfloat])
write(*,*) 9,glGetError()
         call glMaterialfv(GL_FRONT,GL_SPECULAR, &
            [0.9_GLfloat,0.9_GLfloat,0.9_GLfloat,1.0_GLfloat])
write(*,*) 10,glGetError()
         call glMaterialf(GL_FRONT,GL_SHININESS,100.0_GLfloat)
write(*,*) 11,glGetError()
         call glCallList(STELLATED)
write(*,*) 12,glGetError()
         call glPopMatrix()
write(*,*) 13,glGetError()
         call glXSwapBuffers(GLWin%dpy,GLWin%win) ! Swap buffers (double buffering)
write(*,*) 14,glGetError()
      end subroutine drawGLScene

! function to release/destroy our resources and restoring the old desktop
      subroutine killGLWindow() bind(C,name='killGLWindow')
!DEC$ ATTRIBUTES STDCALL :: killGLWindow
!!GCC$ ATTRIBUTES STDCALL :: killGLWindow
         integer result4
         if(C_ASSOCIATED(GLWin%ctx)) then
            if(glXMakeCurrent(GLWin%dpy, None, C_NULL_PTR) == 0) then
               write(*,'(*(g0))') 'Could not release drawing context.'
            end if
            call glXDestroyContext(GLWin%dpy, GLWin%ctx)
            GLWin%ctx = C_NULL_PTR
         end if
! switch back to original desktop resolution if we were in fs
         if(GLWin%fs /= 0) then
            result4 = XF86VidModeSwitchToMode(GLWin%dpy,GLWin%screen,GLWin%deskMode)
            result4 = XF86VidModeSetViewPort(GLWin%dpy,GLWin%screen,0,0)
         end if
         result4 = XCLoseDisplay(GLWin%dpy)
      end subroutine killGLWindow

      function createGLWindow(title, width, height, bits, fullscreenflag) &
         bind(C, name = 'CreateGLWindow')
         integer(Bool) createGLWindow
         character(KIND=C_CHAR) title(*)
         integer(C_INT), value :: width
         integer(C_INT), value :: height
         integer(C_INT), value :: bits
         integer(Bool), value :: fullscreenflag
! Display variables
         character(LEN=0,KIND=C_CHAR), pointer :: display_name

! Miscellaneous X variables
         type(C_PTR) size_hints   ! XSizeHints *size_hints
         type(C_PTR) wm_hints     ! XMWHints *wm_hints
         type(C_PTR) class_hints  ! XClassHint *class_hints
         integer(C_INT) vidModeMajorVersion, vidModeMinorVersion
         integer(C_INT) modeNum
         type(C_PTR), pointer :: modes(:)   !   XF86VidModeModeInfo **modes;
         integer(C_INT) result4
         integer(C_INT) bestMode
         type(C_PTR) vi     !         XVisualInfo *vi;
         integer(C_INT) glxMajorVersion, glxMinorVersion
         integer(C_INT) borderDummy
         integer(C_INT) i
         integer(Window) winDummy
         integer(Atom) wmDelete
         integer(Colormap) cmap
         integer(C_INT) dpyWidth, dpyHeight
         type(C_PTR) cmodes

! Get command used to invoke program
         BLOCK
            integer length
            call GET_COMMAND_ARGUMENT(0,LENGTH=length)
            allocate(character(LEN=length+1,KIND=C_CHAR)::appname)
            call GET_COMMAND_ARGUMENT(0,VALUE=appname)
            appname(length+1:) = C_NULL_CHAR
         END BLOCK

! Allocate memory for our structures
         BLOCK
            logical good
            good = .FALSE.
            size_hints = XAllocSizeHints()
            if(C_ASSOCIATED(size_hints)) then
               wm_hints = XAllocWMHints()
               if(C_ASSOCIATED(wm_hints)) then
                  class_hints = XAllocClassHint()
                  good = C_ASSOCIATED(class_hints)
               end if
            end if
            if(.NOT.good) then
               write(ERROR_UNIT,'(*(g0))') appname(:len(appname)-1), &
                  ": couldn't allocate memory"
               stop EXIT_FAILURE
            end if
!write(*,'(*(z0:1x))') transfer(size_hints,0_C_LONG),transfer(wm_hints,0_C_LONG), &
!transfer(class_hints,0_C_LONG)
         END BLOCK

         GLWin%fs = fullscreenflag
         GLWin%attr = transfer(spread(0_INT8,1,C_SIZEOF(GLWin%attr)),GLWin%attr)
! Connect to X server
         call C_F_POINTER(C_NULL_PTR,display_name)
         GLWin%dpy = XOpenDisplay(display_name)
         if(.NOT.C_ASSOCIATED(GLWin%dpy)) then
            write(ERROR_UNIT,'(*(g0))') appname(:len(appname)-1), &
               ": couldn't connect to X server "
            stop EXIT_FAILURE
         end if

! Get screen size from display structure macro
         GLWin%screen = XDefaultScreen(GLWin%dpy)
!write(*,*) GLWin%screen
         result4 = XF86VidModeQueryVersion(GLWin%dpy, &
            vidModeMajorVersion, vidModeMinorVersion)
         write(*,'(*(g0))') 'XF86VidModeExtension-Version ', &
            vidModeMajorVersion, '.', vidModeMinorVersion
         BLOCK
            type(XF86VidModeModeInfo), pointer :: pVidMode
            result4 = XF86VidModeGetAllModeLines(GLWin%dpy, GLWin%screen, &
            modeNum, cmodes)
            call C_F_POINTER(cmodes, modes, [modeNum])
!write(*,*) modeNum,transfer(cmodes,0_C_LONG)
            call C_F_POINTER(modes(1),pVidMode)
            GLWin%deskmode = pVidMode
         END BLOCK

! look for mode with requested resolution
         bestmode = 0
         do i = 1, modenum
            BLOCK
               type(XF86VidModeModeInfo), pointer :: pVidMode
               call C_F_POINTER(modes(i),pVidMode)
write(*,*) i,pVidMode%hdisplay,pVidMode%vdisplay,pVidMode%dotclock, &
pVidMode%hSyncstart,pVidMode%hSyncend,pVidMode%hskew, &
XF86VidModeValidateModeLine(GLWin%dpy,GLWin%screen,pVidMode)
!               if(XF86VidModeValidateModeLine(GLWin%dpy, &
!                  GLWin%screen,pVidMode) == MODE_OK) then
                  if(pVidMode%hdisplay == width .AND. &
                     pVidMode%vdisplay == height) then
                     bestMode = i;
                   end if
!                end if
            END BLOCK
         end do

write(*,*) bestmode
         if(bestmode == 0) then
            write(ERROR_UNIT,'(*(g0))') 'Cound not find a suitable graphics mode'
            stop EXIT_FAILURE
         end if

!     get an appropriate visual
         vi = glXChooseVisual(GLWin%dpy, GLWin%screen, attrListDbl)
         if(.NOT.C_ASSOCIATED(vi)) then
            vi = glXChooseVisual(GLWin%dpy, GLWin%screen, attrListSgl)
            GLWin%doubleBuffered = False
            write(*,'(a)') 'Only Singlebuffered Visual!'
         else
            GLWin%doubleBuffered = True
            write(*,'(a)') 'Got Doublebuffered Visual!'
         end if
         result4 = glXQueryVersion(GLWin%dpy, glxMajorVersion, glxMinorVersion)
         write(*,'(*(g0))') 'glX-Version ',glxMajorVersion,'.',glxMinorVersion
         BLOCK
            type(XVisualInfo), pointer :: pvi
            type(Visual), pointer :: pvis
            call C_F_POINTER(vi,pvi)
! create a GLX context
            GLWin%ctx = glXCreateContext(GLWin%dpy,pvi,C_NULL_PTR,True)
! create a color map
            call C_F_POINTER(pvi%visual,pvis)
            cmap = XCreateColormap(GLWin%dpy,XRootWindow(GLWin%dpy, pvi%screen), &
               pvis, AllocNone);
            GLWin%attr%colormap = cmap
            GLWin%attr%border_pixel = 0
         END BLOCK
write(*,'(z0)') cmap

BLOCK
   integer display_width, display_height
   display_width = XDisplayWidth(GLWin%dpy,GLWin%screen)
write(ERROR_UNIT,'(*(g0))') 'width=',display_width
   display_height = XDisplayHeight(GLWin%dpy,GLWin%screen)
write(ERROR_UNIT,'(*(g0))') 'height=',display_height
END BLOCK
write(*,*) GLWin%fs, bestmode
         if(GLWin%fs /= 0) then
            BLOCK
               type(XF86VidModeModeInfo), pointer :: pmode
               call C_F_POINTER(modes(bestMode),pmode)
               result4 = XF86VidModeSwitchToMode(GLWin%dpy,GLWin%screen, pmode)
write(*,*) result4
               result4 = XFlush(GLWin%dpy)
write(*,*) result4
               result4 = XF86VidModeSetViewPort(GLWin%dpy, GLWin%screen, 0, 0)
write(*,*) result4
               dpyWidth = pmode%hdisplay
               dpyHeight = pmode%vdisplay
               write(*,'(*(g0))') 'Resolution ',dpyWidth,'x',dpyHeight
               result4 = XFree(cmodes)
            END BLOCK
! Create a fullscreen window
            GLWin%attr%override_redirect = True
            GLWin%attr%event_mask = iany([ &
               ExposureMask,KeyPressMask,ButtonPressMask,StructureNotifyMask])
            BLOCK
               type(XVisualInfo), pointer :: pvi
               type(Visual), pointer :: pvis
               call C_F_POINTER(vi,pvi)
               call C_F_POINTER(pvi%visual,pvis)
               GLWin%win = XCreateWindow(GLWin%dpy,XRootWindow(GLWin%dpy,pvi%screen), &
                  0, 0, dpyWidth, dpyHeight, 0, pvi%depth, InputOutput, pvis, &
                  iany([CWBorderPixel,CWColorMap,CWEventMask,CWOverrideRedirect]), &
                  GLWin%attr)
!call killGLWindow()
write(*,*) GLWin%attr
write(*,*) GLWin%win
            END BLOCK
            result4 = XWarpPointer(GLWin%dpy, None, GLWin%win, 0, 0, 0, 0, 0, 0)
write(*,*) result4
            result4 = XMapRaised(GLWin%dpy, GLWin%win)
write(*,*) result4
            result4 = XGrabKeyboard(GLWin%dpy, GLWin%win, True, GrabModeAsynch, &
               GrabModeAsynch, CurrentTime)
write(*,*) result4
            result4 = XGrabPointer(GLWin%dpy, GLWin%win, True, &
               int (ButtonPressMask,C_INT), &
               GrabModeAsynch, GrabModeAsynch, GLWin%win, None, CurrentTime)
write(*,*) result4
         else
! Create a window in window mode
            GLWin%attr%event_mask = iany &
               ([ExposureMask,KeyPressMask,ButtonPressMask,StructureNotifyMask])
            BLOCK
               type(XVisualInfo), pointer :: pvi
               type(Visual), pointer :: pvis
               call C_F_POINTER(vi,pvi)
               call C_F_POINTER(pvi%visual,pvis)
               GLWin%win = XCreateWindow(GLWin%dpy,XRootWindow(GLWin%dpy,pvi%screen), &
                  0, 0, width, height, 0, pvi%depth, InputOutput, pvis, &
                  iany([CWBorderPixel,CWColorMap,CWEventMask]), GLWin%attr)
            END BLOCK
! only set window title and handle wm_delete_events if in windowed mode
            wmDelete = XInternAtom(GLWin%dpy, 'WM_DELETE_WINDOW'//achar(0), True)
            result4 = XsetWMProtocols(GLWin%dpy, GLWin%win, wmDelete, 1)
            BLOCK
               type(XSizeHints), pointer :: phints
               call C_F_POINTER(C_NULL_PTR,phints)
               call XSetStandardProperties(GLWin%dpy, GLWin%win, title, &
                  title, None, C_NULL_PTR, 0, phints)
            END BLOCK
            result4 = XMapRaised(GLWin%dpy, GLWin%win)
         end if

! connect the glx-context to the window
         result4 = glXMakeCurrent(GLWin%dpy, GLWin%win, GLWin%ctx)
write(*,*) result4
         result4 = XGetGeometry(GLWin%dpy, GLWin%win, winDummy, GLWin%x, GLWin%y, &
            GLWin%width, GLWin%height, borderDummy, GLWin%depth)
write(*,*) result4,winDummy,GLWin%x,GLWin%y,GLWin%width,GLWin%height, &
borderDummy,GLWin%depth
         write(*,'(*(g0))') 'Depth ',GLWin%depth
         if(glXIsDirect(GLWin%dpy, GLWin%ctx) /= 0) then
            write(*,'(*(g0))') 'Congrats, you have Direct Rendering!'
         else
            write(*,'(*(g0))') 'Sorry, no Direct Rendering Possible!'
         end if
         result4 = initGL()
write(*,*) result4
         STELLATED = MakeStellated()
         call lightit()

         CreateGLWindow = True
   end function CreateGLWindow

   subroutine ALARMhandler(sig) bind(C)
      integer(C_INT), value :: sig
      type(XEvent), target :: event
      type(XExposeEvent), pointer :: xexpose
      integer result4

      event%pad = 0
      call C_F_POINTER(C_LOC(event),xexpose)
      xexpose = XExposeEvent( &
         type = Expose, &
         serial = 0, & ! not sure about this
         send_event = True, &
         display = GLWin%dpy, &
         window = GLWin%win, &
         x = 0, &
         y = 0, &
         width = GLWin%width, &
         height = GLWin%height, &
         count = 0)
      MASTER_THETA = MASTER_THETA+1.0
!write(*,*) 'SIGALRM'
      result4 = XSendEvent(GLWin%dpy,GLWin%win,False,ExposureMask,event)
   end subroutine ALARMhandler

   subroutine setup_handler() bind(C)
!DEC$ ATTRIBUTES STDCALL :: setup_handler
!!DEC$ ATTRIBUTES STDCALL :: setup_handler
      integer result4
      type(itimerval) new_timer, old_timer
      type(C_FUNPTR) old_handler

      old_handler = signal(SIGALRM,ALARMhandler)
      new_timer = itimerval( &
         timeval(0,33000), &
         timeval(0,33000))
      result4 = setitimer(ITIMER_REAL,new_timer,old_timer)
   end subroutine setup_handler
end module procs

program lesson01
   use ISO_C_BINDING
   use Xlib
   use procs
   use libC
   implicit none

   type(XEvent), target :: event
   integer(C_INT), pointer :: event_type_
   integer(Bool) done
   integer result4

integer:: icount = 0

   done = False
! default to fullscreen
   result4 = CreateGLWindow("NeHe's OpenGL Framework", 640, 480, 24, False)
   call setup_handler()

! wait for events
   do while(done == False)
! handle the events in the queue
      do while(XPending(GLWin%dpy) > 0)
         result4 = XNextEvent(GLWin%dpy, event)
         call C_F_POINTER(C_LOC(event),event_type_)
         select case(event_type_)
            case(Expose)
icount = icount+1
write(*,*) 'Case Expose',XPending(GLWin%dpy),icount
               BLOCK
                  type(XExposeEvent), pointer :: xexpose
                  call C_F_POINTER(C_LOC(event),xexpose)
write(*,*) xexpose%count
                  if(xexpose%count == 0) then
                     call drawGLScene()
                  end if
write(*,*) 'survived'
               END BLOCK
            case(ConfigureNotify)
write(*,*) 'Case ConfigureNotify'
! call resizeGLScene only if our window-size changed
               BLOCK
                  type(XConfigureEvent), pointer :: xconfigure
                  call C_F_POINTER(C_LOC(event),xconfigure)
                  if(xconfigure%width /= GLWin%width .OR. &
                     xconfigure%height /= GLWin%height) then
                     GLWin%width = xconfigure%width
                     GLWin%height = xconfigure%height
                     write(*,'(*(g0))') 'Resize event'
                     call resizeGLScene(xconfigure%width, xconfigure%height)
                  end if
               END BLOCK
! exit in case of a mouse button press
            case(ButtonPress)
write(*,*) 'Case ButtonPress'
               done = True
            case(KeyPress)
write(*,*) 'Case KeyPress'
               BLOCK
                  type(XKeyEvent), pointer :: xkey
                  call C_F_POINTER(C_LOC(event),xkey)
write(*,'(z0)') XLookupKeysym(xkey,0)
                  if(XLookupKeysym(xkey,0) == XK_Escape) then
                     done = True
                  end if
                  if(XLookupKeysym(xkey,0) == XK_F1) then
                     call killGLWindow()
                     GLWin%fs = merge(True, False, GLWin%fs == 0)
                     result4 = CreateGLWindow("NeHe's OpenGL Framework", &
                        640, 480, 24, GLWin%fs)
                  end if
if(XLookupKeysym(xkey,0)==int(Z'ffbf',KeySym)) then
   call drawGLScene()
end if
               END BLOCK
            case(ClientMessage)
write(*,*) 'Case ClientMessage'
               BLOCK
                  type(C_PTR) name
                  character(LEN=*,KIND=C_CHAR), parameter :: cmp = &
                     'WM_PROTOCOLS'//achar(0)
                  character(LEN=LEN(cmp),KIND=C_CHAR), pointer :: pname
                  type(XClientMessageEvent), pointer :: xclient
                  call C_F_POINTER(C_LOC(event),xclient)
                  name = XGetAtomName(GLWin%dpy,xclient%message_type)
                  call C_F_POINTER(name,pname)
                  if(index(pname,achar(0)) == LEN(pname)) then
                     if(pname == cmp) then
                        write(*,'(*(g0))') 'Exiting sanely...'
                        done = True
                     end if
                  end if
               END BLOCK
            case default
write(*,*) 'Case Default'
         end select
      end do
      call drawGLScene()
   end do
write(*,*) 'done'
   call killGLWindow()
   stop 0
end program lesson01
