      PROGRAM TWIMP5
C        a Fortran wimp program to test more 
C        on menus, and text windows
C
C        needs only the Wimp library
C
C        initialise the wimp
      CALL WPINIT('TWIMP5')
C        initialise windows, & menus
      CALL INIT
C        go into the wimp loop (without null calls)
      CALL WPLOOP(1)
C        that's all we can do here
      END
C
      SUBROUTINE INIT
      COMMON /HANDLE/ IWH1
      COMMON /MENUS/ MENU1(31),MENU2(19)
C        make the window
      CALL WPCHWF(25,.FALSE.)
      CALL WPCHWF(28,.FALSE.)
      CALL WPCHWF(30,.FALSE.)
      CALL WPMKNW(440,80,0,100,440,80,0,0,'My window',IWH1)
C        make top menu block
      CALL WPMKMB('TWimp5,menu1,menu2,text,quit',MENU1)
C        make secondary menu
      CALL WPMKMB('menu2,item1,item2',MENU2)
C        set flags to call MQWARN
      CALL WPSTMF(3,MENU1,0,.TRUE.)
      CALL WPSTMF(3,MENU1,1,.TRUE.)
C        open the window
      CALL WPOPNW(IWH1)
      RETURN
      END
C
      SUBROUTINE TXTWIN
      CHARACTER ANS
C             make a standard text window (e.g. for debug)
      CALL WPOPTX('TWimp5 text window')
C             set background pale grey
      CALL WPSTTC(128+1)
C             set text colour cyan
      CALL WPSTTC(15)
C             write message
      PRINT *,'This is a text window'
   10 PRINT *,'Type "Y" to return immediately,'
      PRINT *,'or type "N" to get spacebar message'
      READ (*,101) ANS
  101 FORMAT(A)
C      I = IGET()
C      IF(I.GT.96) I = I - 32
C      ANS = CHAR(I)
C      PRINT *,ANS
      IF(ANS.NE.'Y' .AND. ANS.NE.'N') GO TO 10
C             set text colour red
      CALL WPSTTC(11)
C             close window
      CALL WPCLTX(ANS.EQ.'Y')
      RETURN
      END
C
      SUBROUTINE WQCLIK(IWH,ICH,IX,IY,IBUTT)
      COMMON /MENUS/ MENU1(31),MENU2(19)
C         mouse click over our window,
C         make sure it is 'menu'
      IF(IBUTT .NE. 2) RETURN
C         show the menu
      CALL WPSHWM(MENU1,IX,IY+200)
      RETURN
      END
C
      SUBROUTINE WQPLOT(IWHAN,IX1,IY1,IX2,IY2)
C        here we just print out a message.
C        there is only 1 window, so we don't need to check it's handle
C        and we don't even need to check the area.
C
      CHARACTER*28 MESG
C
C        print messages
      CALL WPTEXT(0,-16,'Click menu over this window')
      RETURN
      END
C
      SUBROUTINE WQMENU(MMB,ITEMS,NMENU)
      COMMON /MENUS/ MENU1(31),MENU2(19)
      DIMENSION MMB(*),ITEMS(NMENU)
C            click over menu item
C            check it is the right menu
      IF(MMB(1) .NE. MENU1(1)) THEN
        CALL WPERR(2,'This is the wrong menu!!',IRES)
        CALL WPQUIT
        RETURN
      ENDIF
C            join menu2 to menu1
      IF(ITEMS(1) .EQ. 0) CALL WPAM2M(MENU2,MENU1,0)
      IF(ITEMS(1) .EQ. 1) CALL WPAM2M(MENU2,MENU1,1)
C            make text window
      IF(ITEMS(1) .EQ. 2) CALL TXTWIN
C            if it is over 'quit', then stop
      IF(ITEMS(1) .EQ. 3) CALL WPQUIT
C            check if second level menu
C            then remove it from the tree
      IF(NMENU .EQ. 2) CALL WPAZ2M(MENU1,ITEMS(2))
      RETURN
      END
C
      SUBROUTINE WQMWRN(MMB,ITEMS,NMENU)
      COMMON /MENUS/ MENU1(31),MENU2(19)
      DIMENSION MMB(*),ITEMS(NMENU)
C            moving over to new menu
C            check it is the right menu
      IF(MMB(1) .NE. MENU1(1)) THEN
        CALL WPERR(2,'This is the wrong menu!!',IRES)
        CALL WPQUIT
        RETURN
      ENDIF
C       it should be item 0 or 1
      IF(ITEMS(1) .EQ. 0) THEN
C              if 0, then grey next menu item 2
        CALL WPSTMF(2,MENU2,1,.TRUE.)
        CALL WPSTMF(2,MENU2,0,.FALSE.)
      ELSEIF(ITEMS(1) .EQ. 1) THEN
C              if 1, then grey next menu item 1
        CALL WPSTMF(2,MENU2,0,.TRUE.)
        CALL WPSTMF(2,MENU2,1,.FALSE.)
      ELSE
        CALL WPERR(2,'Wrong menu item!!',IRES)
        CALL WPQUIT
      ENDIF
      RETURN
      END
