! CleanWin
! This program demonstrates how to use native Windows APIs to radically change
! the appearance of a QuickWin window.  In this example, it changes the QuickWin
! window to look like a Win95 command prompt.
! This program also shows how to set the original size and resize the resulting
! window.
!
! To compile from the command line:
! df /libs:qwin cleanwin.f90
!  Note, this cannot be run under Standard Graphics, it must be a QuickWin project,
! as there are calls not supported under Standard Graphics.
!
      USE DFLIB
      integer*4 i,j,h,w
      call wininit(0,0,640,480)
      do i = 1,10
      write(0,*) "hello world i = ",i
      end do
      write(0,*) "enter number of lines to type"
      read(5,*) j
      if(j.le.0) j = 25
      do i = 1, j
      write(0,*) "hello world again i = ",i
      end do

      write(0,*) "Set to resize window: enter h and w"
      read(5,*) h,w

! Resize Window (will lose current output on it)
! and then see if new parameters work

      call winresize(0,0,w,h)

      write(0,*) "enter number of lines to type"
      read(5,*) j
      if(j.le.0) j = 25
      do i = 1, j
      write(0,*) "hello world yet again i = ",i
      end do
      write(0,*) "Enter a number to exit"
      read(5,*) j
      end

      subroutine wininit(xorg,yorg,width, height)
      USE DFLIB
      USE DFWIN
      implicit none

      TYPE (windowconfig) wc
      TYPE (QWINFO) qwi
      integer*4 i,j,k,ifontsize,htmp,wtmp,htmp0,wtmp0
      integer*4 delx,dely,width,height,xorg,yorg
     
      logical*4 STATUS

! check input
      if(width.lt.125.or.height.lt.125) then
	write(0,*) "Bad Sizing Parameters"
	stop
	endif

!Goodbye Menu
      DO I = 7,1,-1
	 STATUS= DELETEMENUQQ(I, 0)
      END DO

! Goodbye Status Bar
      i = clickqq( QWIN$STATUS )

! Kill scroll bars and unwanted features
      i = GetWindowLong( GetHWndQQ(QWIN$FRAMEWINDOW), GWL_STYLE )
      i = ior( iand( i, not(WS_THICKFRAME) ), WS_BORDER )
      i = iand( i, not(WS_MAXIMIZEBOX) )
      k = SetWindowLong( GetHWndQQ(QWIN$FRAMEWINDOW), GWL_STYLE, i )
	    
      i = GetWindowLong( GetHWndQQ(0), GWL_STYLE )
      i = ior(iand( i, not(WS_CAPTION.or.WS_SYSMENU.or.WS_THICKFRAME)), &
     &    WS_BORDER)
      k = SetWindowLong( GetHWndQQ(0), GWL_STYLE, i )     

! Get font size and make sure height and width are multiples      
      open(unit=0, file='user')

      status = getwindowconfig(wc)
      ifontsize = wc.fontsize
      dely= iand(ifontsize,16#FFFF) ! height of a char
      delx= ishft(ifontsize,-16)    ! width of a char

      wtmp0 = ((width+delx-1)/delx)*delx  ! round up
      htmp0 = ((height+dely-1)/dely)*dely ! round up

! Prepare for adaptive adjustment      
      i = 1
50    wtmp = wtmp0 -  1 ! account for style effects
      htmp = htmp0 - 40 ! i.e. thin frames, no menu, etc.

! Set Position and size
100   qwi.x = xorg  
      qwi.y = yorg 
      qwi.w = wtmp
      qwi.h = htmp
      qwi.type = QWIN$SET
      status = setwsizeqq(QWIN$FRAMEWINDOW, QWI)

! Get actual size back, should be wtmp0 and htmp0    
      status = getwsizeqq(QWIN$FRAMEWINDOW,QWIN$SIZECURR, QWI)
      if(qwi.w .eq. wtmp0 .and. qwi.h .eq. htmp0) goto 200
! Problems: adjust wtmp and htmp
      i = i + 1
      if(qwi.w .lt. wtmp0) wtmp = wtmp + 1 
      if(qwi.w .gt. wtmp0) wtmp = wtmp - 1
      if(qwi.h .lt. htmp0) htmp = htmp + 1 
      if(qwi.h .gt. htmp0) htmp = htmp - 1
      !write(0,*) qwi.h,height,qwi.w,width
      if(i.ne.150 .and. i.le.300) goto 100

      !try for smaller window       
      wtmp0 = (qwi.w/delx)*delx ! round down
      htmp0 = (qwi.h/dely)*dely ! round down
      if(i.le.300) goto 50

	write(0,*) "Warning cannot adjust size exactly"
      read(5,*) i

! Make sure numbtxtrows = size of the child window
200   wc.numtextcols = qwi.w/delx   ! number of scrollable cols
      wc.numtextrows = qwi.h/dely   ! number of scrollable rows

      wc.numxpixels =  -1
      wc.numypixels =  -1
      wc.numcolors = -1
      wc.fontsize = ifontsize
      wc.title = '  'C
 
      if( .not. setwindowconfig( wc ) ) then
      stop
      endif
      
! Magical Windows incantations to make style set above real      
      i = MoveWindow( GetHWndQQ(0), -1, -1, 0, 0, .TRUE.) 
      call clearscreen($GCLEARSCREEN)
      status = UpdateWindow(GETHANDLEFRAMEQQ())
     

!     status = getwsizeqq(QWIN$FRAMEWINDOW,QWIN$SIZECURR, QWI)
!     status = getwindowconfig(wc)
!     write(0,*) qwi.h,wc.numypixels,dely, qwi.w,wc.numxpixels, delx 
!     read(5,*) i

      return
      end
      
      
      subroutine winresize(xorg,yorg,width, height)
      USE DFLIB
      USE DFWIN
      implicit none

      TYPE (windowconfig) wc
      TYPE (QWINFO) qwi
      integer*4 i,j,k,ifontsize,htmp,wtmp,htmp0,wtmp0
      integer*4 delx,dely,width,height,xorg,yorg
     
      logical*4 STATUS

! check input
      if(width.lt.125.or.height.lt.125) then
	write(0,*) "Bad Sizing Parameters"
	stop
	endif

! Get rid of clutter before changing size so nothing is 
! left around that we can't reach. 
      call clearscreen($GCLEARSCREEN)


! Get font size and make sure height and width are multiples      
      i =focusqq(0)

      status = getwindowconfig(wc)
      ifontsize = wc.fontsize
      dely= iand(ifontsize,16#FFFF) ! height of a char
      delx= ishft(ifontsize,-16)    ! width of a char

      wtmp0 = ((width+delx-1)/delx)*delx  ! round up
      htmp0 = ((height+dely-1)/dely)*dely ! round up

! Prepare for adaptive adjustment      
      i = 1
50    wtmp = wtmp0 -  1 ! account for style effects
      htmp = htmp0 - 40 ! i.e. thin frames, no menu, etc.

! Set Position and size
      i = 1
100   qwi.x = xorg  
      qwi.y = yorg 
      qwi.w = wtmp
      qwi.h = htmp
      qwi.type = QWIN$SET
      status = setwsizeqq(QWIN$FRAMEWINDOW, QWI)

! Get actual size back, should be wtmp0 and htmp0    
      status = getwsizeqq(QWIN$FRAMEWINDOW,QWIN$SIZECURR, QWI)
      if(qwi.w .eq. wtmp0 .and. qwi.h .eq. htmp0) goto 200
! Problems: adjust wtmp and htmp
      i = i + 1
      if(qwi.w .lt. wtmp0) wtmp = wtmp + 1 
      if(qwi.w .gt. wtmp0) wtmp = wtmp - 1
      if(qwi.h .lt. htmp0) htmp = htmp + 1 
      if(qwi.h .gt. htmp0) htmp = htmp - 1
      !write(0,*) qwi.h,height,qwi.w,width
      if(i.ne.150 .and. i.le.300) goto 100

      !try for smaller window       
      wtmp0 = (qwi.w/delx)*delx ! round down
      htmp0 = (qwi.h/dely)*dely ! round down
      if(i.le.300) goto 50

      write(0,*) "Warning cannot adjust size exactly"
      read(5,*) i
      

! Make sure numbtxtrows = size of the child window
200   wc.numtextcols = qwi.w/delx   ! number of scrollable cols
      wc.numtextrows = qwi.h/dely   ! number of scrollable rows

      wc.numxpixels =  -1
      wc.numypixels =  -1
      wc.numcolors = -1
      wc.fontsize = ifontsize
      wc.title = ''C
 
      if( .not. setwindowconfig( wc ) ) then
      stop
      endif
      
!      status = getwsizeqq(QWIN$FRAMEWINDOW,QWIN$SIZECURR, QWI)
!      status = getwindowconfig(wc)
!      write(0,*) qwi.h,wc.numypixels,dely, qwi.w,wc.numxpixels, delx 
!      read(5,*) i

! Magical Windows incantations to make style set above real      
      i = MoveWindow( GetHWndQQ(0), -1, -1, 0, 0, .TRUE.) 
      call clearscreen($GCLEARSCREEN)
      status = UpdateWindow(GETHANDLEFRAMEQQ())

      return
      end
