      PROGRAM TWIMP1
C        a trivial Fortran wimp program which
C        demonstrates using the colour picker
C
C        needs the Wimp and Graphics libraries
C
C        initialise the wimp
      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
C           initialise the wimp, make the window and icons
      COMMON/ADMIN/IWHAN,IHS,IHP,IR,IG,IB,START
      LOGICAL START
      CHARACTER TITLE*16
      DATA TITLE/'Colour Picking'/
      TITLE(15:15) = CHAR(0)
      CALL WPINIT('TWIMP14')
C        make the window (no close icon)
      CALL WPCHWF(25,.FALSE.)
      CALL WPMKNW(400,320,0,512,400,320,0,0,TITLE,IWHAN)
C        make icons with just click selecting
      CALL WPCHTF(103)
C        make an icon to stop the program
      CALL WPADTI(IWHAN,40,-80,80,48,'Stop',0,IHS)
C        and one for picking a colour
      CALL WPADTI(IWHAN,160,-80,192,48,'Pick Colour',0,IHP)
C        set initial colour to RED
      IR = 240
      IG = 0
      IB = 0
C        initialise the plotting
      START=.FALSE.
C        open the window
      CALL WPOPNW(IWHAN)
      RETURN
      END
C
      SUBROUTINE WQPLOT(IWH,IX1,IY1,IX2,IY2)
C        print out the colours
      COMMON/ADMIN/IWHAN,IHS,IHP,IR,IG,IB,START
      LOGICAL START
      DIMENSION IRGB(3)
      EQUIVALENCE (IRGB(1),IR)
      CHARACTER*10 TEXT(3)
      DATA TEXT/'  Red','Green',' Blue'/
C
      IF(START) THEN
        IY = -128
        DO 10 I=1,3
          WRITE(TEXT(I)(7:10),*)IRGB(I)
          CALL WPTEXT(40,IY,TEXT(I))
          IY = IY - 64
   10   CONTINUE
C          make coloured square
        CALL GRSETC(0,IR,IG,IB)
        DO 20 I=1,2
          IF(I.EQ.2 .OR. IR.GE.0) CALL GRRECT(220,-256,348,-128,I.EQ.1)
          CALL WPSETC(0,7)
   20   CONTINUE
      ELSE
        CALL WPTEXT(20,-128,'No colours selected yet')
      ENDIF
      RETURN
      END
C
      SUBROUTINE WQCLIK(IWH,ICONH,IX,IY,IBUT)
C          responds to mouse clicks
      COMMON/ADMIN/IWHAN,IHS,IHP,IR,IG,IB,START
      LOGICAL START
      IF(IBUT.NE.4) RETURN
      IF(ICONH.EQ.IHS) THEN
C            click over 'stop'
        CALL WPQUIT
      ELSE IF(ICONH.EQ.IHP) THEN
C            prepare to pick colour
        CALL WPPICC(IX,IY,'TWIMP14 colours',IR,IG,IB)
        START = .TRUE.
        CALL WPPLOT(IWHAN,-1)
      ENDIF
      RETURN
      END

