aboutsummaryrefslogtreecommitdiff
path: root/plotlib/examples/cmap2.f
diff options
context:
space:
mode:
Diffstat (limited to 'plotlib/examples/cmap2.f')
-rw-r--r--plotlib/examples/cmap2.f222
1 files changed, 222 insertions, 0 deletions
diff --git a/plotlib/examples/cmap2.f b/plotlib/examples/cmap2.f
new file mode 100644
index 0000000..c2ae015
--- /dev/null
+++ b/plotlib/examples/cmap2.f
@@ -0,0 +1,222 @@
+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 replot(4)
+ 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
+