C*********************************************************************** 
C    Module:  cmap.f
C 
C    Copyright (C) 1996 Harold Youngren, Mark Drela 
C 
C    This program is free software; you can redistribute it and/or modify 
C    it under the terms of the GNU General Public License as published by 
C    the Free Software Foundation; either version 2 of the License, or 
C    (at your option) any later version. 
C 
C    This program is distributed in the hope that it will be useful, 
C    but WITHOUT ANY WARRANTY; without even the implied warranty of 
C    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
C    GNU General Public License for more details. 
C 
C    You should have received a copy of the GNU General Public License 
C    along with this program; if not, write to the Free Software 
C    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 
C
C    Report problems to:    guppy@maine.com 
C                        or drela@mit.edu  
C*********************************************************************** 


      program cmap2
c---------------------------------------------------------------
c     Color selection program.
c
c     Displays a 2-D slice through the R-G-B color space,
c     and gives the R,G,B components of a mouse-selected color.
c
c     The cutting plane is parallel to the RG, RB, or GB plane.
c     The position along the remaining B, G, or R axis is specified
c     by the % saturation 0..100.
c
c---------------------------------------------------------------
c
      character*2 plane
      character*1 axis, chkey
c
      character*40 colorname
c
      dimension x(5), y(5)
      logical lok
c
      ch = 0.03
c
 1000 format(a)
c
 5    write(*,1050) 
 1050 format(/' Enter cutting-plane orientation (RG, RB, or GB): ',$)
      read (*,1000) plane
c
      axis = ' '
      if(index('RGrg',plane(1:1)).NE.0 .AND.
     &   index('RGrg',plane(2:2)).NE.0       ) axis = 'B'
      if(index('RBrb',plane(1:1)).NE.0 .AND.
     &   index('RBrb',plane(2:2)).NE.0       ) axis = 'G'
      if(index('Gbgb',plane(1:1)).NE.0 .AND.
     &   index('Gbgb',plane(2:2)).NE.0       ) axis = 'R'
c
ccc   if(index('RGB',axis).EQ.0) go to 5
      if(index('RGB',axis).EQ.0) then
        call plot(0.,0.,+999)
        stop
      endif
c
c
      write(*,1100) axis
 1100 format( ' Enter % saturation along ',a1,' axis (0..100) : ', $)
      read (*,*) isat
c
      isat = max(  0,isat)
      isat = min( 99,isat)
c
      nc = 10
c
      sat = float(isat) / 100.0
c
c
c---- R,G,B unit vectors for projection onto x-y cutting plane
      xr = 0.
      yr = 0.
      zr = 0.
c
      xg = 0.
      yg = 0.
      zg = 0.
c
      xb = 0.
      yb = 0.
      zb = 0. 
c
      if(sat .lt. 0.50) then
c
        if(index('R',axis).EQ.1) then
          zr = 1.0
          xg = 1.0
          yb = 1.0
        endif
c
        if(index('G',axis).EQ.1) then
          yr = 1.0
          zg = 1.0
          xb = 1.0
        endif
c
        if(index('B',axis).EQ.1) then
          xr = 1.0
          yg = 1.0
          zb = 1.0
        endif
c
      else
c
        if(index('R',axis).EQ.1) then
          zr = 1.0
          yg = 1.0
          xb = 1.0
        endif
c
        if(index('G',axis).EQ.1) then
          xr = 1.0
          zg = 1.0
          yb = 1.0
        endif
c
        if(index('B',axis).EQ.1) then
          yr = 1.0
          xg = 1.0
          zb = 1.0
        endif
c
      endif
c
C
C---Initialize the plot package before we get into color plotting...
      CALL PLINITIALIZE
c
      call PLOPEN(0.8,0,1)
      call PLOT(5.5, 4.25, -3)
      call NEWFACTOR(6.0)
      call PLOT(-0.5,-0.5,-3)
c
c      call plopen(-0.8,0,5)
c      call plot(0.5,0.5,-3)
c      call newfactor(1.4)
c
      xdel = 1.0/float(nc)
      ydel = 1.0/float(nc)
c
      do 10 j = 1, nc
        y0 = ydel*float(j-1)
c
        do 105 i = 1, nc
          x0 = xdel*float(i-1)
c
          xx = x0 + 0.5*xdel
          yy = y0 + 0.5*ydel
          zz = sat
c
          r = xx*xr + yy*yr + zz*zr
          g = xx*xg + yy*yg + zz*zg
          b = xx*xb + yy*yb + zz*zb
c
          ir = int(256.0*r)
          ig = int(256.0*g)
          ib = int(256.0*b)
c
          x(1) = x0
          y(1) = y0
          x(2) = x0 + xdel
          y(2) = y0
          x(3) = x0 + xdel
          y(3) = y0 + ydel
          x(4) = x0
          y(4) = y0 + ydel
          x(5) = x0
          y(5) = y0
          n = 5
c
          call NEWCOLORRGB(ir,ig,ib)
          call POLYLINE(x,y,n,1)
c
 105    continue
 10   continue
c
      call PLFLUSH
c
      write(*,*)
      write(*,*) 'Click on colors...'
C
 200  call GETCURSORXY(xx,yy,chkey)
      zz = sat
c
      r = xx*xr + yy*yr + zz*zr
      g = xx*xg + yy*yg + zz*zg
      b = xx*xb + yy*yb + zz*zb
c
      ir = int(256.0*r)
      ig = int(256.0*g)
      ib = int(256.0*b)
c
      write(*,1500) ir, ig, ib
 1500 format(1x,'R G B  = ', i4,',',i4,',',i4)
c
      if( lok(ir,ig,ib) ) then
        go to 200
      endif
c
      go to 5
      end



      logical function lok(ir,ig,ib)
      lok = ir.LE.255 .AND. ig.LE.255 .AND. ib.LE.255  .AND.
     &      ir.GE.0   .AND. ig.GE.0   .AND. ib.GE.0  
      return
      end

