      PROGRAM TWIMP7
C        a Fortran wimp program which
C        plays with modes and wimp colours
C
C        needs the Wimp, Graphics and Utils libraries
C
      COMMON/HANDLE/IWH,IWH2,IHS,IHC
C        initialise the wimp
      CALL WPINIT('TWIMP7')
C        make up windows and icons
      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              set up windows and icons
      COMMON/HANDLE/IWH,IWH2,IHS,IHC
C              indicator as to how far we have got
      COMMON/STATUS/JSTAT,IBLK(20)
      JSTAT = 0
C        make windows
      CALL WPMKNW(800,320,0,800,800,320,0,0,'Test Wimp #7',IWH)
      CALL WPMKNW(800,320,400,200,800,320,0,0,'TW7 answers',IWH2)
C        and icons
C        make menu type icons
      CALL WPCHTF(109)
C        in ESG 1
      CALL WPCHTF(201)
C        a 'stop' icon
      CALL WPADTI(IWH,40,-80,80,48,'Stop',0,IHS)
C        and a 'continue' icon
      CALL WPADTI(IWH,160,-80,160,48,'Continue',0,IHC)
C        open the window
      CALL WPOPNW(IWH)
      RETURN
      END
C
      SUBROUTINE WQCLIK(IWHAN,ICONH,IX,IY,IBUTT)
C        click over an icon
      COMMON/HANDLE/IWH,IWH2,IHS,IHC
      COMMON/STATUS/JSTAT,IBLK(20)
C        only interested if it is over the main window
      IF(IWHAN.NE.IWH) RETURN
C        stop if 'Stop'
      IF(ICONH.EQ.IHS) CALL WPQUIT
C        set up next text if 'Continue'
      IF(ICONH.EQ.IHC) THEN
        IF(JSTAT.EQ.0) THEN
C          first question, open window for answers
          CALL WPOPNW(IWH2)
C            get answers for printing
          CALL WPGETP(IBLK)
        ENDIF
        IF(JSTAT.EQ.1) THEN
C            make wimp background dark green
          IBLK(5)=?I00900000
          CALL WPSETP(IBLK)
        ENDIF
        IF(JSTAT.EQ.2) THEN
C            restore wimp background colour
          IBLK(5)=?I70707000
          CALL WPSETP(IBLK)
        ENDIF
        IF(JSTAT.EQ.3) THEN
C            change mode (to itself so as to cause minimum problems)
C            get mode
          CALL OSBYTE2(135,0,0,IDUM,MODE)
C            change mode
          CALL WPSTMD(MODE)
        ENDIF
C            force redraw windows
        CALL WPPLOT(IWH,16,-160,800,-110)
        CALL WPPLOT(IWH2,-1)
      ENDIF
      RETURN
      END
C
      SUBROUTINE WQPLOT(IWHAN,IX1,IY1,IX2,IY2)
C             print story in the two windows
      COMMON/HANDLE/IWH,IWH2,IHS,IHC
      COMMON/STATUS/JSTAT,IBLK(20)
      COMMON/STORY/TEXT
      CHARACTER*40 TEXT
C
      IF(IWHAN.EQ.IWH) THEN
        IF(JSTAT.EQ.0) TEXT='What is the current Wimp colour palette?'
        IF(JSTAT.EQ.1) TEXT='Change Wimp background to dark green'
        IF(JSTAT.EQ.2) TEXT='Restore Wimp background colour'
        IF(JSTAT.EQ.3) TEXT='Change screen mode to itself'
        IF(JSTAT.EQ.4) TEXT='All done, please click over <Stop>'
        CALL WPTEXT(16,-120,TEXT)
      ELSE
        IF(JSTAT.GE.0 .AND. JSTAT.LE.2) THEN
C            print out palette info
          CALL WPTEXT(0,0,' #  palette  #  palette  #  palette'//
     +      '  #  palette')
          DO 210 I=1,20
            CALL GRMOVE(MOD(I-1,4)*192,-((I-1)/4)*40-40)
            PRINT 201,I,IBLK(I)
  201       FORMAT(I2,1X,Z8)
  210     CONTINUE
        ENDIF
        IF(JSTAT.EQ.3) THEN
C            get mode
          CALL OSBYTE2(135,0,0,IDUM,MODE)
          CALL GRMOVE(16,-40)
          PRINT *,'Mode reset to',MODE
        ENDIF
C            increment status
        JSTAT = JSTAT + 1
      ENDIF
      RETURN
      END
C
      SUBROUTINE WQCLSW(IWHAN)
C           stop program if main window is closed
      COMMON/HANDLE/IWH,IWH2,IHS,IHC
      IF(IWH.EQ.IWHAN) THEN
        CALL WPQUIT
      ELSE
        CALL WPCLSW(IWHAN)
      ENDIF
      RETURN
      END
C
      SUBROUTINE WQPALC
C           called when the palette changes
      COMMON/STATUS/JSTAT,IBLK(20)
      IF(JSTAT.EQ.1) THEN
        CALL WPERR(1,'Detected Wimp palette change, I won''t do'//
     +  ' this again',IDUM)
      ENDIF
      RETURN
      END
C
      SUBROUTINE WQMODC
C           called when the mode changes
      CHARACTER*3 TEXT
C            get mode
          CALL OSBYTE2(135,0,0,IDUM,MODE)
      WRITE(TEXT,101)MODE
  101 FORMAT(I3)
      CALL WPERR(1,'Detected mode change to '//TEXT,IDUM)
      RETURN
      END
