program pal_gamma
c
c apply a gamma color correction to a palette for NCSA image tools to use.
c
c GWH 1-Dec-1992

      implicit none

      character*1 pal(3,256)
      character filename*80

      integer i
      integer iret
      real gammar, gammag, gammab

c      integer dssdast,dsadata
      integer dfpgetpal, dfpputpal

c read a palette file:

      filename = ' '
      do while (filename .eq. ' ')
         write(6,*) ' Palette file name to read:'
         read(5,*) filename
      enddo
        
      iret=DFPgetpal(filename,pal)
      if(iret .ne. 0) then
         write(6,*) 'error. iret=',iret
         stop
      endif

      write(6,*) 'index   Red   Green  Blue'
      do i=1,256
         write(6,*) i, ichar(pal(1,i)), ichar(pal(2,i)), 
     >              ichar(pal(3,i))
      enddo

      write(6,*) 'Red Green Blue Gamma correction factors (0 to 1):'
      read(5,*) gammar,gammag,gammab

      do i=1,256
c- skip solid black:
         if(ichar(pal(1,i)) .ne. 0 .or. ichar(pal(2,i)) .ne. 0
     >        .or. ichar(pal(3,i)) .ne. 0) then
            pal(1,i)=char( 255 - gammar*(255 - ichar(pal(1,i))) )
            pal(2,i)=char( 255 - gammag*(255 - ichar(pal(2,i))) )
            pal(3,i)=char( 255 - gammab*(255 - ichar(pal(3,i))) )
         endif
      enddo

c write the resulting palette:

      filename = ' '
      do while (filename .eq. ' ')
         write(6,*) ' Palette file name to write:'
         read(5,*) filename
         if(filename .eq. 'q') stop
      enddo

      iret=DFPputpal(filename,pal,0,'w')
      if(iret .ne. 0) then
         write(6,*) 'error. iret=',iret
         stop
      endif

      stop
      end