drawos2.for

来自「开放源码的编译器open watcom 1.6.0版的源代码」· FOR 代码 · 共 504 行 · 第 1/2 页

c$define INCL_PM
c$include os2.fap


      subroutine make_buttons( hwnd )
      integer hwnd
      integer offset
      integer max_height
      integer btn_width
      integer btn_height
      integer index
      integer buttons( 9 )

      include 'drawos2.fi'

      buttons( 1 ) = IDM_ROTATE_UP
        buttons( 2 ) = IDM_MOVE_IN
        buttons( 3 ) = IDM_ROTATE_LEFT
        buttons( 4 ) = IDM_ROTATE_RIGHT
        buttons( 5 ) = IDM_MOVE_OUT
        buttons( 6 ) = IDM_ROTATE_DOWN
        buttons( 7 ) = IDM_MORE_BRIGHTNESS
        buttons( 8 ) = IDM_LESS_BRIGHTNESS
        buttons( 9 ) = 0

      Draw_area.yTop = Draw_area.yTop - 2
      offset = Draw_area.xLeft + 2
      max_height = 0
      index = 1
      while( buttons( index ) .ne. 0 ) do
          call add_button( hwnd, Draw_area.yTop, offset,
     &              buttons( index ), btn_width, btn_height )
             if( max_height .lt. btn_height ) then
              max_height = btn_height
          endif
          index = index + 1
          offset = offset + btn_width - 1
      end while
      ! remove buttons from drawing area
      Draw_area.yTop = Draw_area.yTop - ( max_height + 2 )
      Button_height = max_height + 4
      end


      include 'drawos2.fi'
      include 'threed.fi'

      integer       init_app
      integer        init_instance
      record /QMSG/ qmsg

      Main_hwnd = 0
      Main_hab = 0
      Main_hmq = 0

c$ifdef DRAW_ALL_AT_ONCE
      Hdc = 0
      Mem_dc = 0
      Draw_bitmap = 0
      Old_bitmap = 0
c$endif

c$ifdef undefined
      call memclear( 0, loc( Draw_area ), isizeof( RECTL ) )
c$else
      call memclear( loc( Draw_area ), 0, isizeof( RECTL ) )
c$endif
      hThree_d = 0
      Button_height = 0
      Auto_run = 0

      Main_hab = WinInitialize( 0 )
      if( Main_hab .eq. 0 ) then
            return
      endif

      Main_hmq = WinCreateMsgQueue( Main_hab, 0 )
      if( Main_hmq .eq. 0 ) then
            return
      endif

      if( init_app( Main_hab ) .eq. 0 ) then
            return
      endif

      ! Perform initializations that apply to a specific instance

      call three_d_init()
      call define_room()
      if ( init_instance( SWP_SHOW .or. SWP_ACTIVATE ) .eq. 0 ) then
            call finish_room()
            call three_d_fini()
            return
        endif

        ! Acquire and dispatch messages until WM_QUIT is received.

        while(WinGetMsg(Main_hab, qmsg, NULL, NULL, NULL) .ne. 0) do
            call WinDispatchMsg( Main_hab, qmsg )
      endwhile
      call finish_room()
      call three_d_fini()

      if( Main_hmq .ne. 0 ) then
          call WinDestroyMsgQueue( Main_hmq )
      endif

      if( Main_hab .ne. 0 ) then
             call WinTerminate( Main_hab )
      endif

      call DosExit( 1, 0)
      end


      subroutine add_wrap( attr, add, minimum, maximum )
      integer attr
      integer add
      integer minimum
      integer maximum

      integer start

        include 'drawos2.fi'
      include 'threed.fi'

        start = three_d_get( hThree_d, attr )
      start = start + add

      while( start .ge. maximum ) do
            start = start - ( maximum - minimum )
      end while

      while( start .lt. minimum ) do
            start = start + maximum - minimum
      end while

      call three_d_set( hThree_d, attr, start )
      end


      subroutine add_range( attr, add, minimum, maximum )
      integer attr
      integer add
      integer minimum
      integer maximum

      integer start

        include 'drawos2.fi'
      include 'threed.fi'

      start = three_d_get( hThree_d, attr )
      start = start + add

      if( start .ge. maximum ) then
            call three_d_set( hThree_d, attr, maximum )
      else if( start .lt. minimum ) then
            call three_d_set( hThree_d, attr, minimum )
      else
            call three_d_set( hThree_d, attr, start )
      endif
      end


      subroutine draw_box(x1, x2, y1, y2, z1, z2, red, green, blue)
      real    x1
      real    x2
      real    y1
      real    y2
      real    z1
      real    z2
      integer red
      integer green
      integer blue

        include 'drawos2.fi'
      include 'threed.fi'

      call three_d_box(hThree_d,x1,x2,y1,y2,z1,z2,red,green,blue)
      end


      subroutine memclear( locale, ch, len )
      integer*4 locale
      integer*1 ch
      integer   len
      integer    cnt
      integer*1 arr(:)

      allocate( arr( len ), location=locale )
      cnt = len
      while( cnt .gt. 0 ) do
          arr( cnt ) = ch
          cnt = cnt - 1
      end while
      end


      subroutine new_display()
c$ifdef DRAW_ALL_AT_ONCE

      include 'drawos2.fi'

      GpiSetBitmap( Mem_dc, Old_bitmap )
      GpiDeleteBitmap( Draw_bitmap )
      Draw_bitmap = NULLHANDLE
      GpiDestroyPS( Mem_dc )
      DevCloseDC( Hdc )
c$endif
      end


      subroutine draw_stuff( hwnd )
      integer hwnd

        include 'drawos2.fi'
      include 'threed.fi'

      integer        win_dc
      record /RECTL/ paint
      record /RECTL/ intersect

c$ifdef DRAW_ALL_AT_ONCE
      integer                    old_top
      integer                    width
      integer           height
      record /SIZEL/             sizl
      data sizl /0, 0/
      record /BITMAPINFOHEADER2/ bmih
      integer                    formats(24)
      record /POINTL/            pts(3)
      integer                    old_cursor
      integer                    hour_glass_cur
      record /RECTL/             interior
      record /DEVOPENSTRUC/      dop
      data dop /0, 0, 0, 0, 0, 0, 0, 0, 0/

      dop.pszDriveName = LOC( 'DISPLAY'//char(0) )
c$endif

      win_dc = WinBeginPaint( hwnd, 0, paint )
      call GpiCreateLogColorTable(win_dc, 0, LCOLF_RGB, 0, 0, NULL)
c$ifdef DRAW_ALL_AT_ONCE
      old_top = paint.yBottom
      paint.yBottom = Draw_area.yTop
c$endif
      call WinFillRect( win_dc, paint, SYSCLR_WINDOW )
c$ifdef DRAW_ALL_AT_ONCE
      paint.yBottom = old_top
c$endif