      PROGRAM TWIMP3
C        a trivial Fortran wimp program which
C        puts an icon on the icon bar with an associated menu tree
C        exercises drag saves
C        needs the Wimp and Utils library
C
C        initialise the wimp
C      OPEN(20,FILE='s.text',STATUS='OLD')
      CALL WPINIT('TWIMP3')
C        set up the desk-top
      CALL SETUP
C        go into the wimp loop (without null calls)
      CALL WPLOOP(1)
C        that's all we can do here
      END
C
      SUBROUTINE SETUP
C        here we make the menus an put an icon on the icon bar
C        keep its handle in common
      COMMON/HANDLE/ ICBAR,IWSAVE
C        file name
      COMMON/FILES/FILE1
      CHARACTER*80 FILE1
      CHARACTER*10 TEXT
      DATA TEXT/'TestWimp3X'/
      SAVE TEXT
C        menus have 7 + 6*(number of entries) words
      COMMON/MENUS/MENU1(19),MENU2(25)
C        make up menu 1
      CALL WPMKMB('TestWimp3,next,quit',MENU1)
C        make up menu2
      CALL WPMKMB('next,save,grey,flag',MENU2)
C        attach menu2 to menu1
      CALL WPAM2M(MENU2,MENU1,0)
C        make grey item grey
      CALL WPSTMF(2,MENU2,1,.TRUE.)
C        make save window
      FILE1='Text'//CHAR(0)
      CALL WPSAVE('FFF',512,FILE1,IWSAVE)
C        add it to menu
      CALL WPAW2M(IWSAVE,MENU2,0)
C        get sprites into Wimp sprite area
      CALL OSCLI('IconSprites TWSprites')
C        put icon on icon bar
      CALL WPBART('tw3_sprite',-1,MENU1,TEXT,ICBAR)
      RETURN
      END
C
      SUBROUTINE WQMENU(IMB,ITEMS,NM)
C           receives click over menu item
      COMMON/MENUS/MENU1(19),MENU2(25)
      DIMENSION ITEMS(NM)
      LOGICAL SET
C           make sure this is our menu (it has to be really)
      IF(LOC(IMB) .NE. LOC(MENU1)) RETURN
C           check if 'quit'
      IF(NM.EQ.1 .AND. ITEMS(1).EQ.1) THEN
        CALL WPQUIT
      ENDIF
C           check if 'flag'
      IF(NM.EQ.2) THEN
        IF(ITEMS(2).EQ.2) THEN
C           invert tick flag
          CALL WPGTMF(0,MENU2,2,SET)
          CALL WPSTMF(0,MENU2,2,.NOT.SET)
        ENDIF
      ENDIF
      RETURN
      END
C
      SUBROUTINE WQWFIL(IWH,SFL)
C            called to write out file SFL
      CHARACTER SFL*(*)
      LOGICAL ANS
C        common of handles
      COMMON/HANDLE/ ICBAR,IWSAVE
C            check this is the right window
C           (it must be because this is the only save window)
      IF(IWH.NE.IWSAVE) RETURN
C           write trivial text file
      INQUIRE(FILE=SFL,EXIST=ANS)
      IF(ANS) THEN
        CALL WPERR(3,'File already exists, overwrite?',IA)
        IF(IA.EQ.2) RETURN
        OPEN(10,FILE=SFL,FORM='FORMATTED',STATUS='OLD')
        WRITE(10,*)'An overwritten file'
      ELSE
        OPEN(10,FILE=SFL,FORM='FORMATTED',STATUS='NEW')
        WRITE(10,*)'A trivial text file'
      ENDIF
      CLOSE(10)
      RETURN
      END
