
c      include 'c:\contour\graph.fi'
      include 'fgraph.fi'
c      include 'c:\contour\graph.fd'
      include 'fgraph.fd'
      common/scalef/ iwc0,jwc0,nxhpix,nyhpix,xpix,ypix,xscr,yscr
      dimension isel(1)
      integer*2 mode
      mode = 19
      call setcrt(mode)
      numcol=64
      call pcolor(numcol)
      iwc0=1
      jwc0=198
      iclr=0
      is=1
      ie=65
      idiv=4
      jdiv=0
10    j=0
      do 30 k=1,numcol/idiv
      iclr=iclr+1
      do 20 m=1,3
      j=j+1
      call onepix(is,j,iclr,ie)
20    continue
      j=j+1
30    continue
      jdiv=jdiv+1
      if(jdiv.eq.idiv) go to 40
      is=is+ 67
      ie=is+ 64
      go to 10
40    stop
      end

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine onepix(ii,jj,iclr,ncol)
      common/scalef/ iwc0,jwc0,nxhpix,nyhpix,xpix,ypix,xscr,yscr

      itemp = iwc0 + ii-1
      itemp1 =iwc0 + (ncol-1)
      jtemp = jwc0 - (jj-1)

      call mcolor(iclr)
      call makel(itemp,jtemp,itemp1,jtemp)

      return
      end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine pcolor(numcol)
      parameter (maxcol=79)
      integer r(maxcol),g(maxcol),b(maxcol),incl(maxcol)
      integer gray(14)
c      include 'c:\contour\graph.fd'
      include 'fgraph.fd'
      integer*4 remappalette
      integer*4 kol(maxcol),rgb,red,gr,bl
      data (r(i),i=1,maxcol)/8,32,32,40,32,32,32,36,32,40,0,32,
     & 0,32,0,32,8,32,0,40,16,40,0,32,0,32,8,40,16,40,16,
     & 48,40,52,48,52,48,52,48,56,48,56,60,56,60,63,63,63,
     & 63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,63,56,
     & 63,56,63,56,63,56,63,56,63,56,63,56,63,56/
      data (g(i),i=1,maxcol)/0,24,8,24,16,32,20,32,24,32,40,48,
     & 48,56,56,63,56,63,63,63,63,63,56,63,63,63,63,63,
     & 63,63,63,63,60,63,60,63,60,63,63,63,63,63,63,63,60,
     & 63,48,56,44,56,40,56,40,48,32,40,28,40,24,32,16,32,
     & 8,24,40,40,32,24,16,16,8,12,0,0,0,0,0,0,0/
      data (b(i),i=1,maxcol)/63,63,63,63,63,63,63,63,63,63,63,
     & 63,63,63,63,63,63,60,63,63,63,55,0,24,24,0,24,20,24,
     & 32,0,36,32,36,36,24,20,12,12,0,0,4,8,12,4,8,0,0,4,16,
     & 4,24,12,24,0,32,8,24,16,32,8,24,0,32,63,63,63,63,63,
     & 63,63,63,63,63,56,48,32,0,0/
      data incl/1,79,16,70,62,22,36,46,68,8,54,26,74,44,12,64,
     & 30,18,52,4,24,38,34,56,72,14,48,20,58,40,6,32,66,50,10,76,
     & 28,42,60,2,61,29,43,77,67,11,51,33,9,41,59,21,49,73,15,35,
     & 25,57,39,5,53,31,19,65,13,45,27,75,55,7,69,37,23,47,63,17,
     & 71,78,3/
      data gray/#141414,#161616,#191919,#1c1c1c,#1f1f1f,
     & #222222,#252525,#282828,#2b2b2b,#2e2e2e,#313131,
     & #343434,#373737,#393939/
      rgb(red,gr,bl)=(#3f3f3f.and.(red.or.ishft(bl,16).or.ishft(gr,8)))
c*****GET APPROPRIATE COLOR 
      n=0
      do 10 i=1,maxcol                                                          
      if(incl(i).gt.numcol) go to 10                                            
      n=n+1                                                                     
      kol(n)=rgb(r(i),g(i),b(i))
   10 continue                                                                  
c*****REMAP THE PALLETEE
      do 20 i=1,numcol
      istat=remappalette(i,kol(i))
       if(istat.eq.-1) then
         print *,'error remapping the pallete'
         print *,'index no. ',i,' value: ',kol(i)
         stop
       endif
20    continue
      return
      end

      
       subroutine setcrt(mode)
       integer*2 setvideomode,mode,istat
* arguments to setvideomode()
	INTEGER*2 $MAXRESMODE,$MAXCOLORMODE,$DEFAULTMODE,$TEXTBW40,
     +            $TEXTC40,$TEXTBW80,$TEXTC80,$MRES4COLOR,$MRESNOCOLOR,
     +            $HRESBW,$TEXTMONO,$HERCMONO,$MRES16COLOR,$HRES16COLOR,
     +            $ERESNOCOLOR,$ERESCOLOR,$VRES2COLOR,$VRES16COLOR,
     +            $MRES256COLOR,$ORESCOLOR
	PARAMETER($MAXRESMODE   =-3)    ! graphics mode with highest resolution
        PARAMETER($MAXCOLORMODE =-2)    ! graphics mode with most colors
	PARAMETER($DEFAULTMODE  =-1)    ! restore screen to original mode
	PARAMETER($TEXTBW40      =0)    ! 40 x 25 text, 16 grey
	PARAMETER($TEXTC40       =1)    ! 40 x 25 text, 16/8 color
	PARAMETER($TEXTBW80      =2)    ! 80 x 25 text, 16 grey
	PARAMETER($TEXTC80       =3)    ! 80 x 25 text, 16/8 color
	PARAMETER($MRES4COLOR    =4)    ! 320 x 200, 4 color
	PARAMETER($MRESNOCOLOR   =5)    ! 320 x 200, 4 grey
	PARAMETER($HRESBW        =6)    ! 640 x 200, BW
	PARAMETER($TEXTMONO      =7)    ! 80 x 25 text, BW
	PARAMETER($HERCMONO      =8)    ! 720 x 348, BW for HGC
	PARAMETER($MRES16COLOR   =13)   ! 320 x 200, 16 color
	PARAMETER($HRES16COLOR   =14)   ! 640 x 200, 16 color
	PARAMETER($ERESNOCOLOR   =15)   ! 640 x 350, BW
	PARAMETER($ERESCOLOR     =16)   ! 640 x 350, 4 or 16 color
	PARAMETER($VRES2COLOR    =17)   ! 640 x 480, BW
	PARAMETER($VRES16COLOR   =18)   ! 640 x 480, 16 color
	PARAMETER($MRES256COLOR  =19)   ! 320 x 200, 256 color
	PARAMETER($ORESCOLOR     =64)   ! 640 x 400, 1 of 16 colors (Olivetti)

       istat = setvideomode(mode)
       if(istat.eq.0) then
       print *,'desired video mode not supported'
       endif
       return
       end
