aboutsummaryrefslogtreecommitdiff
path: root/plotlib/examples/cmap3.f
diff options
context:
space:
mode:
Diffstat (limited to 'plotlib/examples/cmap3.f')
-rw-r--r--plotlib/examples/cmap3.f198
1 files changed, 198 insertions, 0 deletions
diff --git a/plotlib/examples/cmap3.f b/plotlib/examples/cmap3.f
new file mode 100644
index 0000000..ce9939f
--- /dev/null
+++ b/plotlib/examples/cmap3.f
@@ -0,0 +1,198 @@
+C***********************************************************************
+C Module: cmap3.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 cmap3
+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 perpendicular to the diagonal
+c axis running from R,G,B = 0,0,0 (black), to
+c R,G,B = 1,1,1 (white). The position of this cutting
+c plane is specified by the % saturation 0..300.
+c The plane passes through one or three pure-color
+c corners for the specific saturations shown.
+c
+c 0% (0 0 0) black
+c 100% (1 0 0), (0 1 0), (0 0 1) red , green , blue
+c 200% (1 1 0), (1 0 1), (0 1 1) yellow, magenta, cyan
+c 300% (1 1 1) white
+c
+c For 0-100% and 200-300%, the cutting plane is a triangle.
+c For 100-200%, the plane is a hexagon.
+c
+c---------------------------------------------------------------
+c
+ dimension x(4), y(4)
+ logical lok
+ character*1 chkey
+c
+ ch = 0.03
+ call PLINITIALIZE
+c
+ 1 continue
+c
+ write(*,1100)
+ 1100 format(/' Enter % saturation (0..300) : ', $)
+ read (*,*) isat
+c
+ if(isat.eq.0) go to 500
+c
+ isat = max( 1,isat)
+ isat = min(299,isat)
+c
+ nc1 = 10
+c
+ nc = nc1
+ if(isat.gt.100) nc = (nc1*isat)/ 100
+ if(isat.gt.200) nc = (nc1*200 )/(300-isat) + 1
+c
+ sat = float(isat) / 100.0
+c
+c
+c---- R,G,B unit vectors for projection onto x-y cutting plane
+ xr = -sat
+ yr = -sat/sqrt(3.0)
+c
+ xg = 0.0
+ yg = sat*2.0/sqrt(3.0)
+c
+ xb = sat
+ yb = -sat/sqrt(3.0)
+c
+ call COLORMAPDEFAULT
+c
+ call PLOPEN(0.8,0,1)
+c
+ call PLOT(5.5, 4.25, -3)
+ call NEWFACTOR(3.0)
+c
+c
+ area = sat * 2.0*sqrt(3.0)
+c
+ xdel = sat* 2.0 /float(nc)
+ ydel = sat*sqrt(3.0)/float(nc)
+c
+ do 10 j = 1, nc
+ y0 = yr + ydel*float(j-1)
+c
+ do 105 i = 1, nc-j+1
+ x0 = xr + xdel*(float(i-1) + 0.5*float(j-1))
+c
+ xx = x0 + 0.5*xdel
+ yy = y0 + ydel/3.0
+c
+ r = ((xg-xb)*(yy-yb) - (yg-yb)*(xx-xb))/area
+ g = ((xb-xr)*(yy-yr) - (yb-yr)*(xx-xr))/area
+ b = ((xr-xg)*(yy-yg) - (yr-yg)*(xx-xg))/area
+c
+ ir = int(256.0*r)
+ ig = int(256.0*g)
+ ib = int(256.0*b)
+c
+ if( lok(ir,ig,ib) ) then
+ x(1) = x0
+ y(1) = y0
+ x(2) = x0 + xdel
+ y(2) = y0
+ x(3) = x0 + xdel*0.5
+ y(3) = y0 + ydel
+ x(4) = x0
+ y(4) = y0
+ n = 4
+c
+ call NEWCOLORRGB(ir,ig,ib)
+ call POLYLINE(x,y,n,1)
+ endif
+c
+c
+ if(i.eq.nc-j+1) go to 105
+
+ xx = x0 + xdel
+ yy = y0 + 2.0*ydel/3.0
+c
+ r = ((xg-xb)*(yy-yb) - (yg-yb)*(xx-xb))/area
+ g = ((xb-xr)*(yy-yr) - (yb-yr)*(xx-xr))/area
+ b = ((xr-xg)*(yy-yg) - (yr-yg)*(xx-xg))/area
+c
+ ir = int(256.0*r)
+ ig = int(256.0*g)
+ ib = int(256.0*b)
+c
+ if( lok(ir,ig,ib) ) then
+ x(1) = x0 + xdel
+ y(1) = y0
+ x(2) = x0 + xdel*1.5
+ y(2) = y0 + ydel
+ x(3) = x0 + xdel*0.5
+ y(3) = y0 + ydel
+ x(4) = x0 + xdel
+ y(4) = y0
+ n = 4
+c
+ call NEWCOLORRGB(ir,ig,ib)
+ call POLYLINE(x,y,n,1)
+ endif
+c
+ 105 continue
+ 10 continue
+c
+ call PLFLUSH
+c
+ write(*,*) 'Click on colors...'
+C
+ 200 call GETCURSORXY(xx,yy,chkey)
+c
+ r = ((xg-xb)*(yy-yb) - (yg-yb)*(xx-xb))/area
+ g = ((xb-xr)*(yy-yr) - (yb-yr)*(xx-xr))/area
+ b = ((xr-xg)*(yy-yg) - (yr-yg)*(xx-xg))/area
+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 1
+c
+ 500 call PLOT(0.0,0.0,+999)
+ stop
+C
+ 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
+