      PROGRAM TWIMP8
C        a  Fortran wimp program to test remaining window manipulations
C        needs the Wimp, Graphics and Utilities libraries
C
C        initialise the wimp
      CALL WPINIT('TWIMP8')
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          set up windows and icons
      COMMON/HANDLE/IWH,IWH2,IWH3,IHS,IHC,IHCOP,JSTAT,JFLAG
      JSTAT = 0
C        make windows
      CALL WPMKNW(800,320,0,800,800,320,0,0,'Test Wimp #8',IWH)
C        second one without a close icon
      CALL WPCHWF(25,.FALSE.)
      CALL WPMKNW(400,400,400,200,200,200,0,0,'TW8 window 1',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,IXB,IYB,IBUTT)
C        click over an icon
      COMMON/HANDLE/IWH,IWH2,IWH3,IHS,IHC,IHCOP,JSTAT,JFLAG
      COMMON/DATA/IBLK1(10),IBLK2(10),IX1,IY1,IX2,IY2,IX3,IY3
C        only interested if it is over the main window
      IF(IBUTT.GT.4) RETURN
      IF(IWHAN.EQ.IWH) THEN
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 test window
            CALL WPOPNW(IWH2)
C           get window state
            CALL WPGTWS(IWH2,IBLK1)
          ENDIF
          IF(JSTAT.EQ.1) THEN
C           get its external dimensions
            CALL WPGTWO(IWH2,IX1,IY1,IX2,IY2)
            CALL WPXY2W(IWH2,IX2,IY2,IX3,IY3)
          ENDIF
          IF(JSTAT.EQ.2) THEN
C              expand window to full 400x400 units
            IBLK1(4) = IBLK1(2) + 400
            IBLK1(5) = IBLK1(3) + 400
            CALL WPSTWS(IBLK1)
          ENDIF
C              change the working area to 800x800
          IF(JSTAT.EQ.3) CALL WPSTWA(IWH2,800,800)
C              delete the window
          IF(JSTAT.EQ.4) CALL WPDELW(IWH2)
C            try to reopen it
          IF(JSTAT.EQ.5) CALL WPOPNW(IWH2)
C            get state of icon
          IF(JSTAT.EQ.7) CALL WPGTIS(IWH,IHC,IBLK2)
C            remake window
          IF(JSTAT.EQ.9) THEN
C            set the scroll request flag
            CALL WPCHWF(8,.TRUE.)
            CALL WPMKNW(800,800,400,200,400,400,0,0,'TW8 window 2',IWH3)
            CALL WPOPNW(IWH3)
          ENDIF
C            force redraw window 3 at status 10
          IF(JSTAT.EQ.11) CALL WPPLOT(IWH3,0,-272,272,0)
C            force redraw main window
          CALL WPPLOT(IWH,0,-320,800,-110)
C            increment status
          IF(JSTAT.NE.12) JSTAT = JSTAT + 1
        ENDIF
        IF(JSTAT.EQ.14) THEN
          IF(ICONH.EQ.IHCOP) THEN
            CALL WPDRGI(IWH,ICONH)
          ELSE
            CALL BEEP
            RETURN
          ENDIF
        ENDIF
      ENDIF
      IF(IWHAN.EQ.IWH3) THEN
C            click over circle window
        IF(JSTAT.EQ.12) THEN
C            get current window size in IBLK1(7) to IBLK1(10)
C            (some of IBLK2 gets overwritten)
          CALL WPGTWS(IWH3,IBLK1(6))
C            initiate drag box
          IBLK1(2) = 6
C            position of original point
          IBLK1(3) = IXB
          IBLK1(4) = IYB
          IBLK1(5) = IXB
          IBLK1(6) = IYB
          CALL WPDRAG(IBLK1)
        ENDIF
        IF(JSTAT.EQ.13) THEN
C                 transform pointer coords to window
          CALL WPXY2W(IWH3,IXB,IYB,IX3,IY3)
C                 copy rectangle
          CALL WPCOPY(IWH3,IX1,IY1,IX2,IY2,IX3,IY3)
          JSTAT = 14
          CALL WPPLOT(IWH,0,-320,800,-110)
C                 make an icon to copy
          CALL WPCHTF(106)
          CALL WPCHTF(200)
          CALL WPADTI(IWH,16,-280,144,48,'copy me',0,IHCOP)
        ENDIF
      ENDIF
      RETURN
      END
C
      SUBROUTINE WQCLSW(IWHAN)
C          stop job if top window closed
      COMMON/HANDLE/IWH,IWH2,IWH3,IHS,IHC,IHCOP,JSTAT,JFLAG
      IF(IWHAN.EQ.IWH) THEN
        CALL WPQUIT
      ELSE
        CALL WPCLSW(IWHAN)
      ENDIF
      RETURN
      END
C
      SUBROUTINE WQPLOT(IWHAN)
C           draw stuff in windows
      COMMON/HANDLE/IWH,IWH2,IWH3,IHS,IHC,IHCOP,JSTAT,JFLAG
      COMMON/DATA/IBLK1(10),IBLK2(10),IX1,IY1,IX2,IY2,IX3,IY3
      IF(IWH.EQ.IWHAN) THEN
        IF(JSTAT.EQ.0) CALL WPTEXT(16,-120,'Open the test window')
        IF(JSTAT.GE.1 .AND. JSTAT.LE.3) THEN
          CALL GRMOVE(0,-120)
          PRINT 101,(IBLK1(I),I=2,5)
  101     FORMAT('bottom left',2I6,' top right',2I6)
        ENDIF
        IF(JSTAT.EQ.2) THEN
          CALL GRMOVE(0,-160)
          PRINT 102,IX1,IY1,IX2,IY2
  102     FORMAT('external dimensions',4I6)
          CALL GRMOVE(0,-200)
          PRINT 103,IX3,IY3
  103     FORMAT('top right at',2I6,' in the work area')
        ENDIF
        IF(JSTAT.EQ.3)
     +     CALL WPTEXT(16,-160,'Window expanded to full size')
        IF(JSTAT.EQ.4) THEN
          CALL WPTEXT(16,-120,'Work area now 800x800')
          CALL WPTEXT(16,-180,'Now delete the window')
        ENDIF
        IF(JSTAT.EQ.5) THEN
          CALL WPTEXT(16,-120,'Click over Continue to try to open it')
          CALL WPTEXT(16,-180,'Click on ''OK'' in the error window')
        ENDIF
        IF(JSTAT.EQ.6) JFLAG = -1
        IF(JSTAT.EQ.7) THEN
          IF(JFLAG.EQ.1) THEN
            CALL GRMOVE(16,-120)
            PRINT 104,IX1,IY1
  104       FORMAT('pointer entering window at',2I6)
          ELSE IF(JFLAG.EQ.0) THEN
            CALL WPTEXT(16,-120,'pointer leaving window')
          ELSE
            CALL WPTEXT(16,-120,
     +       'move the pointer in and out of this window')
          ENDIF
        ENDIF
        IF(JSTAT.EQ.6)  JSTAT = 7
        IF(JSTAT.EQ.8) THEN
          CALL WPTEXT(16,-120,'"Continue" icon is at:')
          CALL GRMOVE(0,-180)
          PRINT *,IBLK2(3),IBLK2(4),' size:',IBLK2(5)-IBLK2(3),
     +                                       IBLK2(6)-IBLK2(4)
        ENDIF
        IF(JSTAT.EQ.9) CALL WPTEXT(16,-120,'Make a new window')
        IF(JSTAT.EQ.10) THEN
          CALL WPTEXT(16,-120,'click on its scroll arrows')
          CALL WPTEXT(64,-180,'they work backwards!')
        ENDIF
        IF(JSTAT.EQ.11) CALL WPTEXT(16,-120,'Drawa Circle')
        IF(JSTAT.EQ.12) THEN
          CALL WPTEXT(16,-120,'Select a rectangle including part of')
          CALL WPTEXT(16,-160,'the circle by dragging the mouse')
          CALL WPTEXT(16,-200,'across while holding down "select"')
        ENDIF
        IF(JSTAT.EQ.13) THEN
          CALL WPTEXT(16,-120,'Now move to some other part of')
          CALL WPTEXT(16,-160,'the circle window and click again')
          CALL WPTEXT(16,-200,'to copy your selected area')
        ENDIF
        IF(JSTAT.EQ.14) THEN
          CALL WPTEXT(16,-120,'Drag the new icon below to')
          CALL WPTEXT(16,-160,'the other window')
        ENDIF
        IF(JSTAT.GE.15)
     +    CALL WPTEXT(16,-120,'All done; click over "Stop"')
      ENDIF
      IF(IWHAN.EQ.IWH3) THEN
        IF(JSTAT.EQ.12) THEN
C              draw a cyan circle
          CALL WPSETC(0,15)
          CALL GRCIRC(144,-144,128,.TRUE.)
          CALL WPSETC(0,7)
        ENDIF
        IF(JSTAT.EQ.15) THEN
          CALL WPSETC(0,7)
          CALL GRRECT(IBLK1(1),IBLK1(2),IBLK1(3),IBLK1(4),.FALSE.)
          CALL WPTEXT(IBLK1(1)+8,IBLK1(4)-8,'new icon')
        ENDIF
      ENDIF
      RETURN
      END
C
      SUBROUTINE WQOPNW(IWBLK)
      DIMENSION IWBLK(*)
      COMMON/HANDLE/IWH,IWH2,IWH3,IHS,IHC,IHCOP,JSTAT,JFLAG
      COMMON/DATA/IBLK1(10),IBLK2(10),IX1,IY1,IX2,IY2,IX3,IY3
C         called whenever the wimp opens a window
C         the default action is to call WPSTWS
      DIMENSION JUNK(10)
      CALL WPSTWS(IWBLK)
C      RETURN
      IF(IWBLK(1).EQ.IWH2.AND.JSTAT.LE.2) THEN
        DO 10 I = 1, 9
   10   IBLK1(I) = IWBLK(I)
C           get its external dimensions
        CALL WPGTWO(IWH2,IX1,IY1,IX2,IY2)
        CALL WPXY2W(IWH2,IX2,IY2,IX3,IY3)
C            force redraw top window
        CALL WPPLOT(IWH,0,-320,800,-110)
      ENDIF
      RETURN
      END
C
      SUBROUTINE WQPTWW(IWHAN,ENTER)
      LOGICAL ENTER
      COMMON/HANDLE/IWH,IWH2,IWH3,IHS,IHC,IHCOP,JSTAT,JFLAG
      COMMON/DATA/IBLK1(10),IBLK2(10),IX1,IY1,IX2,IY2,IX3,IY3
C            called when pointer enters or leaves window
C            only interested for top window, when JSTAT=7
      IF(JSTAT.NE.7 .OR. IWHAN.NE.IWH) RETURN
      IF(ENTER) THEN
C            get mouse pointer position
        CALL WPGTPI(IW,IH,IX1,IY1,IB)
C            transform to work area
        CALL WPXY2W(IW,IX1,IY1,IX1,IY1)
        JFLAG = 1
      ELSE
        IF(JFLAG.GE.0) JFLAG = 0
      ENDIF
C            force redraw window
      CALL WPPLOT(IWH,0,-320,800,-110)
      RETURN
      END
C
      SUBROUTINE WQSCRL(IWBLK)
      DIMENSION IWBLK(10)
      COMMON/HANDLE/IWH,IWH2,IWH3,IHS,IHC,IHCOP,JSTAT,JFLAG
C            come here when user requests to scroll the window
C            only do this for window 3 which has scroll request flag set
C            loop over x and y
      DO 10 IXY = 1, 2
C            get the request
        IF(JSTAT.EQ.10) THEN
C            but make it negative so that it works backwards
          IREQ = -IWBLK(IXY+8)
        ELSE
          IREQ = IWBLK(IXY+8)
        ENDIF
C            if zero, no action
        IF(IREQ.EQ.0) GO TO 10
C            IF 1, move on by 32 OS units (e.g. 1 character)
        IF(ABS(IREQ).EQ.1) THEN
          IWBLK(IXY+5) = IWBLK(IXY+5) + 32 * IREQ
        ELSE
C            IF 2, move on by 1 window size
          IWBLK(IXY+5) = IWBLK(IXY+5) +
     1     (IREQ/2)*(IWBLK(IXY+3) - IWBLK(IXY+1))
        ENDIF
   10 CONTINUE
C            now change the window
      CALL WPSTWS(IWBLK)
      RETURN
      END
C
      SUBROUTINE WQDRAG(IWHAN,ICH,IBOX)
C             user has dropped the drag box
      DIMENSION IBOX(4)
      COMMON/HANDLE/IWH,IWH2,IWH3,IHS,IHC,IHCOP,JSTAT,JFLAG
      COMMON/DATA/IBLK1(10),IBLK2(10),IX1,IY1,IX2,IY2,IX3,IY3
C             save coordinates
      IF(IWHAN.EQ.IWH3) THEN
        IF(JSTAT.EQ.12) THEN
          IX1 = MIN(IBOX(1),IBOX(3))
          IY1 = MIN(IBOX(2),IBOX(4))
          IX2 = MAX(IBOX(1),IBOX(3))
          IY2 = MAX(IBOX(2),IBOX(4))
C             update  status and redraw instruction window
          JSTAT = 13
        ENDIF
        IF(JSTAT.EQ.14) THEN
          DO 10 I=1,4
            IBLK1(I) = IBOX(I)
   10     CONTINUE
C            redraw graphics window
          CALL WPPLOT(IWH3,-1)
          CALL WPDELI(IWH,IHCOP)
          JSTAT = 15
        ENDIF
        CALL WPPLOT(IWH,0,-320,800,-110)
      ENDIF
      RETURN
      END
