program display
c
c Display 'pixels.dump' image files created by scrdmp program.
c
c       Brent L. Bates
c       NASA-Langley Research Center
c       M.S. 294
c       Hampton, Virginia  23665-5225
c       (804) 864-2854
c       E-mail: blbates@aero4.larc.nasa.gov or blbates@aero2.larc.nasa.gov
c
      character filein*80,filetype*1
      integer*2 cmap(0:4095,3),pixels(1024)
      integer*2 mapcolor,numpix,totcolor,x,y
      integer*4 b,g,i,min,minb,ming,minr,r,winid
      logical ismex,mex,RGB
$ include /usr/include/fgl.h
$ include /usr/include/fdevice.h
      if(iargc().gt.1) then
         call getarg(2,filein)
      else
         filein='pixels.dump'
      endif
      open(12,file=filein,form='binary')
      rewind 12
      read(12) filetype
      if(filetype.eq.'r') RGB=.true.
      mex=ismex()
      if(mex) then
         if(RGB) then
            print *,'Can not display RGB file with MEX running.'
            stop
         else if(totcolor.gt.1023) then
            print *,'Can not display image with more than 1024 colors'
            print *,'while MEX running.'
            stop
         endif
      endif
      call ginit
      if(RGB) then
         call RGBmod
      else if(mex) then
         call foregr
         call prefpo(0,1023,0,767)
         winid=winope('preview',7)
      endif
      call single
      call gconfi
      call ortho2(0.0,1023.0,0.0,767.0)
   10 if(RGB) then
         read(12)
      else
         read(12) totcolor
         read(12)(cmap(i,1),cmap(i,2),cmap(i,3),i=0,totcolor)
         do 50 i=0,totcolor
            r=cmap(i,1)
            g=cmap(i,2)
            b=cmap(i,3)
            call mapcol(i,r,g,b)
   50    continue
         do 60 x=767,0,-1
            read(12) pixels
            call cmov2s(0,x)
            call writep(1024,pixels)
   60    continue
      endif
   70 if(getbut(middle)) then
          stop
      else if(getbut(leftmo)) then
         rewind 12
         read(12) filetype
         goto 10
      endif
      goto 70
      end
      program displaygr
c
c Display 'pixels.dump' image files created by scrdmp program as gray scale.
c
c
c       Brent L. Bates
c       NASA-Langley Research Center
c       M.S. 294
c       Hampton, Virginia  23665-5225
c       (804) 864-2854
c       E-mail: blbates@aero4.larc.nasa.gov or blbates@aero2.larc.nasa.gov
c
      character filein*80,filetype*1
      integer*2 cmap(0:4095,3),pixels(1024)
      integer*2 mapcolor,numpix,totcolor,x,y
      integer*4 b,g,i,min,minb,ming,minr,r,winid
      logical ismex,mex,RGB
$ include /usr/include/fgl.h
$ include /usr/include/fdevice.h
      if(iargc().gt.1) then
         call getarg(2,filein)
      else
         filein='pixels.dump'
      endif
      open(12,file=filein,form='binary')
      rewind 12
      read(12) filetype
      if(filetype.eq.'r') RGB=.true.
      mex=ismex()
      if(mex) then
         if(RGB) then
            print *,'Can not display RGB file with MEX running.'
            stop
         else if(totcolor.gt.1023) then
            print *,'Can not display image with more than 1024 colors'
            print *,'while MEX running.'
            stop
         endif
      endif
      call ginit
      if(RGB) then
         call RGBmod
      else if(mex) then
         call foregr
         call prefpo(0,1023,0,767)
         winid=winope('preview',7)
      endif
      call single
      call gconfi
      call ortho2(0.0,1023.0,0.0,767.0)
   10 if(RGB) then
         read(12)
      else
         read(12) totcolor
         read(12)(cmap(i,1),cmap(i,2),cmap(i,3),i=0,totcolor)
         do 50 i=0,totcolor
            r=cmap(i,1)
            g=cmap(i,2)
            b=cmap(i,3)
            r=(r+g+b)/3
            g=r
            b=r
            call mapcol(i,r,g,b)
   50    continue
         do 60 x=767,0,-1
            read(12) pixels
            call cmov2s(0,x)
            call writep(1024,pixels)
   60    continue
      endif
   70 if(getbut(middle)) then
          stop
      else if(getbut(leftmo)) then
         rewind 12
         read(12) filetype
         goto 10
      endif
      goto 70
      end
      program laserdump
c
c Create black&white Postscript image file from 'pixels.dump' image
c    files created by scrdmp program.
c
c
c       Brent L. Bates
c       NASA-Langley Research Center
c       M.S. 294
c       Hampton, Virginia  23665-5225
c       (804) 864-2854
c       E-mail: blbates@aero4.larc.nasa.gov or blbates@aero2.larc.nasa.gov
c
      character cr*1,filein*80,fileout*80,filetype*1
      integer*1 value
      integer*2 b,cmap(0:1023,3),pixels(0:1023),g,mapcolor,r
      integer*2 totcolor,x,y
      integer*4 i
      logical RGB
$ include /usr/include/fgl.h
$ include /usr/include/fdevice.h
      cr=char(10)
      if(iargc().gt.1) then
         call getarg(2,filein)
      else
         filein='pixels.dump'
      endif
      open(12,file=filein,form='binary')
      rewind 12
      if(iargc().gt.2) then
         call getarg(3,fileout)
      else
         fileout='dump.ps'
      endif
      open(10,file=fileout,form='binary')
      rewind 10
      read(12) filetype
      if(filetype.eq.'r') RGB=.true.
      if(RGB) then
      else
         read(12) totcolor
         read(12) (cmap(i,1),cmap(i,2),cmap(i,3),i=0,totcolor)
      endif
C     print *,''
      call ringbe
      write(10) '%!',cr
      write(10) '/picstr 1024 string def',cr
C     write(10) '30.0 30.0 translate',cr
C     write(10) '0.0 rotate',cr
C     write(10) '0.35 0.35 scale',cr
      write(10) '15.0 20.0 translate',cr
      write(10) '90.0 rotate',cr
      write(10) '0.75 0.75 scale',cr
      write(10) '1024 768 1 [1 0 0 -1 0 1]'
      write(10) '{currentfile picstr readhexstring pop}',cr
      write(10) 'image',cr
      do 20 y=0,767
         if(.not.RGB) read(12) pixels
         do 30 x=0,255
            value=0
            do 40 i=0,3
               if(RGB) then
               else
                  mapcolor=pixels(x*4+i)
                  r=cmap(mapcolor,1)
                  g=cmap(mapcolor,2)
                  b=cmap(mapcolor,3)
               endif
               value=ishft(value,1)
               if(r.eq.0.and.g.eq.0.and.b.eq.0) value=ior(value,1)
   40       continue
            if(value.lt.10) then
               value=value+48
            else
               value=value+87
            endif
            write(10) char(value)
   30    continue
         write(10) cr
   20 continue
      write(10) 'showpage',cr
      stop
      end
      program lasergray
c
c Create gray scale Postscript image file from 'pixels.dump' image
c    files created by scrdmp program.
c
c
c       Brent L. Bates
c       NASA-Langley Research Center
c       M.S. 294
c       Hampton, Virginia  23665-5225
c       (804) 864-2854
c       E-mail: blbates@aero4.larc.nasa.gov or blbates@aero2.larc.nasa.gov
c
      character cr*1,filein*80,fileout*80,filetype*1
      integer*1 mask,value,vtemp
      integer*2 cmap(0:1023,3),pixels(0:1023),mapcolor
      integer*2 totcolor,x,y
      integer*4 i
      logical RGB
      real b,g,r
$ include /usr/include/fgl.h
$ include /usr/include/fdevice.h
      cr=char(10)
      mask=$0f
      if(iargc().gt.1) then
         call getarg(2,filein)
      else
         filein='pixels.dump'
      endif
      open(12,file=filein,form='binary')
      rewind 12
      if(iargc().gt.2) then
         call getarg(3,fileout)
      else
         fileout='dump.ps'
      endif
      open(10,file=fileout,form='binary')
      rewind 10
      read(12) filetype
      RGB=.false.
      if(filetype.eq.'r') RGB=.true.
      if(RGB) then
      else
         read(12) totcolor
         read(12) (cmap(i,1),cmap(i,2),cmap(i,3),i=0,totcolor)
      endif
      print *,''
      write(10) '%!',cr
      write(10) '/picstr 1024 string def',cr
C     write(10) '30.0 30.0 translate',cr
C     write(10) '0.0 rotate',cr
C     write(10) '0.35 0.35 scale',cr
      write(10) '15.0 20.0 translate',cr
      write(10) '90.0 rotate',cr
      write(10) '0.70 0.70 scale',cr
      write(10) '1024 768 8 [1 0 0 -1 0 1]'
      write(10) '{currentfile picstr readhexstring pop}',cr
      write(10) 'image',cr
      do 20 y=0,767
         if(.not.RGB) read(12) pixels
         value=0
         do 30 x=0,1023
            if(RGB) then
            else
               mapcolor=pixels(x)
               r=real(cmap(mapcolor,1))*0.30
               g=real(cmap(mapcolor,2))*0.59
               b=real(cmap(mapcolor,3))*0.11
               value=nint(r+g+b)
            endif
            vtemp=ishft(value,-4)
            vtemp=iand(vtemp,mask)
            if(vtemp.lt.10) then
               vtemp=vtemp+48
            else
               vtemp=vtemp+87
            endif
            write(10) char(vtemp)
            vtemp=iand(value,mask)
            if(vtemp.lt.10) then
               vtemp=vtemp+48
            else
               vtemp=vtemp+87
            endif
            write(10) char(vtemp)
   30    continue
         write(10) cr
   20 continue
      write(10) 'showpage',cr
      stop
      end
      program lprdump
c
c Create black&white Printronix image file from 'pixels.dump' image
c    files created by scrdmp program.
c
c
c       Brent L. Bates
c       NASA-Langley Research Center
c       M.S. 294
c       Hampton, Virginia  23665-5225
c       (804) 864-2854
c       E-mail: blbates@aero4.larc.nasa.gov or blbates@aero2.larc.nasa.gov
c
      character endline*1,endpage*3,line*768,startline*1
      integer*2 b,g,mapcolor,numpix,r,value,x,y,zero
      integer*2 colormap(0:1023,3),colors(1024,0:767)
      integer*4 i,lprwind
      logical zbuf
$ include /usr/include/fgl.h
$ include /usr/include/fdevice.h
C     open(12,file='colors.dump',form='binary')
      call foregr
      call noport
      lprwind=winope('lprdump',7)
      call double
      zbuf=getzbu()
      call zbuffe(zbuf)
      call gconfi
c     call winset(lprwind)
c     call winpus
      call pushvi
      call pushma
      call pushat
      call screen
      read(*,'(a1)') dumb
      do 10 y=0,767
         call cmov2s(0,y)
         numpix=readpi(1024,colors(1,y))
   10 continue
      print *,''
      do 20 i=0,1023
         call getmco(i,colormap(i,1),colormap(i,2),colormap(i,3))
   20 continue
      print *,''
C     write(12) colormap
C     write(12) colors
C     print *,''
      call popvie
      call popmat
      call popatt
      call winclo(lprwind)
      endline=char(10)
      endpage(1:1)=char(13)
      endpage(2:2)=char(10)
      endpage(3:3)=char(12)
      startline=char(5)
      zero=0
      open(10,file='lpr.dump',form='binary')
      print *,''
      do 30 x=1,1024
         do 40 y=0,127
            value=1
            do 50 i=5,0,-1
               mapcolor=colors(x,y*6+i)
               r=colormap(mapcolor,1)
               g=colormap(mapcolor,2)
               b=colormap(mapcolor,3)
               value=ishft(value,1)
               if(r.ne.zero.or.g.ne.zero.or.b.ne.zero)
     .            value=ior(value,1)
   50       continue
            line(y+1:y+1)=char(value)
   40    continue
         write(10) startline,line,endline
   30 continue
      write(10) endpage
      print *,''
      stop
      end
      program scrdmp
c
c Create 'pixels.dump' image file.
c    Must be used with Mex running.  Have picture you want saved on
c    screen then 'push' image window, attach to another command window,
c    type 'scrdmp', 'pop' image on top, press <CR> once, pause, press
c    <CR> a second time.  Image is being save, DO NOT disturb image
c    until after 3rd bell.  Entire screen is saved.  1st bell indicates
c    program has started, 2nd bell indicates color map has been saved,
c    screen has been saved after 3rd bell.
c
c
c       Brent L. Bates
c       NASA-Langley Research Center
c       M.S. 294
c       Hampton, Virginia  23665-5225
c       (804) 864-2854
c       E-mail: blbates@aero4.larc.nasa.gov or blbates@aero2.larc.nasa.gov
c
c
c saves color map and screen
c
      character fileout*80
      integer*2 numpix,totcolor,y
      integer*2 cmap(0:4095,3),pixels(1024)
      integer*4 i,displaymode
      logical ismex,zbuf
$ include /usr/include/fgl.h
$ include /usr/include/fdevice.h
      if(iargc().gt.1) then
         call getarg(2,fileout)
      else
         fileout='pixels.dump'
      endif
      open(12,file=fileout,form='binary')
      if(ismex()) then
         totcolor=1023
      else
         totcolor=4095
      endif
      call noport
      call gbegin
      displaymode=getdis()
      if(displaymode.eq.0) then
         print *,'Can not dump screen in RGB mode.'
C        stop
         call single
      else if(displaymode.eq.1) then
         call single
      else if(displaymode.eq.2) then
         call double
      endif
      zbuf=getzbu()
      call zbuffe(zbuf)
      call gconfi
      call pushvi
      call pushma
      call pushat
      call screen
      write(12) 'm'
      write(12) totcolor
      read(*,'(a1)') dumb
      call ringbe
      do 20 i=0,totcolor
         call getmco(i,cmap(i,1),cmap(i,2),cmap(i,3))
   20 continue
      write(12)(cmap(i,1),cmap(i,2),cmap(i,3),i=0,totcolor)
      call ringbe
      do 10 y=767,0,-1
         call cmov2s(0,y)
         numpix=readpi(1024,pixels)
         write(12) pixels
   10 continue
      call ringbe
      call popvie
      call popmat
      call popatt
      stop
      end
      program tekcmap
c
c Create Tektronix 4693D color image file from 'pixels.dump' image
c    files created by scrdmp program.  Uses map mode of printer, thus
c    smaller files, max 4096 colors possible.
c
c
c       Brent L. Bates
c       NASA-Langley Research Center
c       M.S. 294
c       Hampton, Virginia  23665-5225
c       (804) 864-2854
c       E-mail: blbates@aero4.larc.nasa.gov or blbates@aero2.larc.nasa.gov
c
      character eol*1,eot*1,filein*80,fileout*80,filetype*1
      character image*2048,map*4096
      integer*1 checksum
      integer*2 blue1,green1,mapcolor,numpix,offset,red1,totcolor,x,y
      integer*2 cmap(0:4095,3),pixels(1024)
      integer*4 byte,i,sumcheck,tekwind,temp
      logical RGB
$ include /usr/include/fgl.h
$ include /usr/include/fdevice.h
      if(iargc().gt.1) then
         call getarg(2,filein)
      else
         filein='pixels.dump'
      endif
      open(12,file=filein,form='binary')
      rewind 12
      if(iargc().gt.2) then
         call getarg(3,fileout)
      else
         fileout='dump.tek'
      endif
      open(10,file=fileout,form='binary')
      rewind 10
      read(12) filetype
C     print *,'filetype:',filetype
      if(filetype.eq.'r') RGB=.true.
      if(RGB) then
      else
         read(12) totcolor
C        print *,'totcolor=',totcolor
         read(12)(cmap(i,1),cmap(i,2),cmap(i,3),i=0,totcolor)
      endif
      print *,''
      eol=char($02)
      eot=char($01)
      sumcheck=0
c                       print-request
      temp=$14
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       length, # of bytes in option list (23 + map)
c                       (primary integer format)
c                  byte 1: 11xxxxxx     byte x: 10xxxxxx
      if(totcolor.le.1024) then
         temp=$c1
      else
         temp=$c4
      endif
      write(10) char(temp)
      sumcheck=sumcheck+temp
      temp=$80
      write(10) char(temp)
      sumcheck=sumcheck+temp
      temp=$97
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       # pixels per line (1024)
c                       (primary integer format)
      temp=$d0
      write(10) char(temp)
      sumcheck=sumcheck+temp
      temp=$80
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       # lines in image (768)
c                       (primary integer format)
      temp=$cc
      write(10) char(temp)
      sumcheck=sumcheck+temp
      temp=$80
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       communication option (handshake)
c                       (primary option format)
      temp=$c1
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       # copies (printer default)
c                       (primary integer format)
      temp=$c0
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       pixel size/aspect ratio (printer default)
c                       (primary option format)
      temp=$c0
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       pixel encoding (index 12)
c                       (primary option format)
      temp=$c9
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       suboption (send 8 bit/primary color map)
c                       (successive option format)
      temp=$83
      write(10) char(temp)
      sumcheck=sumcheck+temp
c
c        write map
c
c                       (0 or more triplet options)
      do 50 i=0,totcolor
         offset=i*4+1
c red 1st part, 1st byte
         red1=cmap(i,1)
         temp=ishft(red1,-2)
         temp=iand(temp,$3f)
         byte=ior(temp,$80)
         map(offset:offset)=char(byte)
         sumcheck=sumcheck+byte
c red 2nd part, 2nd byte
         temp=ishft(red1,4)
         temp=iand(temp,$30)
         byte=ior(temp,$80)
c green 1st part, 2nd byte
         green1=cmap(i,2)
         temp=ishft(green1,-4)
         temp=iand(temp,$0f)
         byte=ior(byte,temp)
         map(offset+1:offset+1)=char(byte)
         sumcheck=sumcheck+byte
c green 2nd part, 3rd byte
         temp=ishft(green1,2)
         temp=iand(temp,$3c)
         byte=ior(temp,$80)
c blue 1st part, 3rd byte
         blue1=cmap(i,3)
         temp=ishft(blue1,-6)
         temp=iand(temp,$03)
         byte=ior(byte,temp)
         map(offset+2:offset+2)=char(byte)
         sumcheck=sumcheck+byte
c blue 2nd part, 4th byte
         byte=iand(blue1,$3f)
         byte=ior(byte,$80)
         map(offset+3:offset+3)=char(byte)
         sumcheck=sumcheck+byte
   50 continue
      write(10) map
c                       pixel ordering (pixel-data order 1)
c                       (primary option format)
      temp=$c1
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       image sizing (printer default)
c                       (primary option format)
      temp=$c0
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       image rendering (printer default)
c                       (primary option format)
      temp=$c0
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       color conversion, gamma correction (printer default)
c                       (primary option format)
      temp=$c0
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       color manipulation (printer default)
c                       (primary option format)
      temp=$c0
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       black/white inversion, color exchange (printer default)
c                       (primary option format)
      temp=$c0
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       hardcopy orientation (printer default)
c                       (primary option format)
      temp=$c0
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       copier identification (4693D printer)
c                       (identification option format)
      temp=$c9
      write(10) char(temp)
      sumcheck=sumcheck+temp
      temp=$95
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       suboption
c                       (primary option format)
      temp=$81
      write(10) char(temp)
      sumcheck=sumcheck+temp
c checksum calculation
c                       (checksum option format)
      sumcheck=mod(sumcheck,$80)
      checksum=iand(sumcheck,$7f)
      checksum=ior(checksum,$80)
      write(10) char(checksum),eol
c
c write image
c
      do 80 y=767,0,-1
         read(12) pixels
         do 90 x=1,1024
            mapcolor=pixels(x)
            offset=x*2-1
c 1st byte
            temp=ishft(mapcolor,-8)
            byte=iand(temp,$0f)
            image(offset:offset)=char(byte)
c 2nd byte
            byte=iand(mapcolor,$ff)
            image(offset+1:offset+1)=char(byte)
   90    continue
         write(10) image
         write(10) eol
   80 continue
      write(10) eot
      print *,''
      stop
      end
      program tekrgb
c
c Create Tektronix 4693D color image file from 'pixels.dump' image
c    files created by scrdmp program.  Uses RGB mode of printer, 
c    larger files, but full 16M colors avaiable.
c
c
c       Brent L. Bates
c       NASA-Langley Research Center
c       M.S. 294
c       Hampton, Virginia  23665-5225
c       (804) 864-2854
c       E-mail: blbates@aero4.larc.nasa.gov or blbates@aero2.larc.nasa.gov
c
      character eol*1,eot*1,filein*80,fileout*80,filetype*1
      character image*3072,map*4096
      integer*1 blue1,checksum,green1,red1
      integer*2 mapcolor,numpix,offset,totcolor,x,y
      integer*2 cmap(0:4095,3),pixels(0:1023)
      integer*4 byte,i,sumcheck,tekwind,temp
      logical RGB
$ include /usr/include/fgl.h
$ include /usr/include/fdevice.h
      if(iargc().gt.1) then
         call getarg(2,filein)
      else
         filein='pixels.dump'
      endif
      open(12,file=filein,form='binary')
      rewind 12
      if(iargc().gt.2) then
         call getarg(3,fileout)
      else
         fileout='dump.tek'
      endif
      open(10,file=fileout,form='binary')
      rewind 10
      read(12) filetype
C     print *,'filetype:',filetype
      if(filetype.eq.'r') RGB=.true.
      if(RGB) then
      else
         read(12) totcolor
C        print *,'totcolor=',totcolor
         read(12)(cmap(i,1),cmap(i,2),cmap(i,3),i=0,totcolor)
      endif
C     print *,''
      call ringbe
      eol=char($02)
      eot=char($01)
      sumcheck=0
c                       print-request
      temp=$14
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       length, # of bytes in option list (20)
c                       (primary integer format)
c                  byte 1: 11xxxxxx     byte x: 10xxxxxx
      temp=$d4
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       # pixels per line (1024)
c                       (primary integer format)
      temp=$d0
      write(10) char(temp)
      sumcheck=sumcheck+temp
      temp=$80
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       # lines in image (768)
c                       (primary integer format)
      temp=$cc
      write(10) char(temp)
      sumcheck=sumcheck+temp
      temp=$80
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       communication option (handshake)
c                       (primary option format)
      temp=$c1
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       # copies (printer default)
c                       (primary integer format)
      temp=$c0
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       pixel size/aspect ratio (printer default)
c                       (primary option format)
      temp=$c0
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       pixel encoding (arbitrary 8)
c                       (primary option format)
      temp=$cd
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       pixel ordering (pixel-data order 1)
c                       (primary option format)
      temp=$c1
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       image sizing (printer default)
c                       (primary option format)
      temp=$c0
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       image rendering (printer default)
c                       (primary option format)
      temp=$c0
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       color conversion, gamma correction (printer default)
c                       (primary option format)
      temp=$c0
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       color manipulation (printer default)
c                       (primary option format)
      temp=$c0
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       black/white inversion, color exchange (printer default)
c                       (primary option format)
      temp=$c0
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       hardcopy orientation (printer default)
c                       (primary option format)
      temp=$c0
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       copier identification (4693D printer)
c                       (identification option format)
      temp=$c9
      write(10) char(temp)
      sumcheck=sumcheck+temp
      temp=$95
      write(10) char(temp)
      sumcheck=sumcheck+temp
c                       suboption
c                       (primary option format)
      temp=$81
      write(10) char(temp)
      sumcheck=sumcheck+temp
c checksum calculation
c                       (checksum option format)
      sumcheck=mod(sumcheck,$80)
      checksum=iand(sumcheck,$7f)
      checksum=ior(checksum,$80)
      write(10) char(checksum),eol
c
c write image
c
      do 80 y=767,0,-1
         read(12) pixels
         do 90 x=0,1023
            mapcolor=pixels(x)
            red1=cmap(mapcolor,1)
            green1=cmap(mapcolor,2)
            blue1=cmap(mapcolor,3)
            offset=x*3+1
c 1st byte
            image(offset:offset)=char(red1)
c 2nd byte
            image(offset+1:offset+1)=char(green1)
c 3nd byte
            image(offset+2:offset+2)=char(blue1)
   90    continue
         write(10) image
         write(10) eol
   80 continue
      write(10) eot
C     print *,''
      call ringbe
      stop
      end
      program thinkdump
c
c Create black&white HP Thinkjet image file.
c       (Old program, not used anymore so input file format not same as
c        scrdmp.)
c
c
c       Brent L. Bates
c       NASA-Langley Research Center
c       M.S. 294
c       Hampton, Virginia  23665-5225
c       (804) 864-2854
c       E-mail: blbates@aero4.larc.nasa.gov or blbates@aero2.larc.nasa.gov
c
      character endpage*8,line*128,startline*7,startpage*12
      integer*2 b,colormap(0:1023,3),colors(1024,0:767),g,int
      integer*2 mapcolor,r,value,x,y
      integer*4 i
$ include /usr/include/fgl.h
$ include /usr/include/fdevice.h
      endpage=char(13)//char(10)//char(27)//'*rB'//char(13)//char(10)
      startline=char(27)//'*b128W'
      startpage=char(27)//'*rA'//char(27)//'*r1280S'
      open(10,file='screen.dump',form='binary')
      open(12,file='colors.dump',form='binary')
      read(12) colormap
      read(12) colors
      print *,''
      write(10) startpage
      do 20 y=767,0,-1
         do 30 x=0,127
            value=0
            do 40 i=1,8
               mapcolor=colors(x*8+i,y)
               r=colormap(mapcolor,1)
               g=colormap(mapcolor,2)
               b=colormap(mapcolor,3)
               int=(r+g+b)/3
               value=ishft(value,1)
               if(int.ge.85) value=ior(value,1)
   40       continue
            line(x+1:x+1)=char(value)
   30    continue
         write(10) startline,line
   20 continue
      write(10) endpage
      stop
      end
      program seikodump
c
c  Creates 8 color Seiko CH-5201 image file.
c       (Old program, not used anymore so input file format not same as
c        scrdmp.)
c
c       Brent L. Bates
c       NASA-Langley Research Center
c       M.S. 294
c       Hampton, Virginia  23665-5225
c       (804) 864-2854
c       E-mail: blbates@aero4.larc.nasa.gov or blbates@aero2.larc.nasa.gov
c
      character filein*80
      character startpage*5
      integer*1 rvalue,gvalue,bvalue
      integer*2 b,colormap(0:1023,3),colors(0:1023,0:767),g,mapcolor,r
      integer*2 x,y
      integer*4 i,minr,ming,minb
$ include /usr/include/fgl.h
$ include /usr/include/fdevice.h
      startpage(1:1)=char(27)
      startpage(2:2)=char(16)
      startpage(3:3)=char(0)
      startpage(4:4)=char(192)
      startpage(5:5)=char(128)
      if(iargc().gt.1) then
         call getarg(2,filein)
      else
         filein='colors.dump'
      endif
c     write(*,"('enter min r,g,b:',$)")
      read(*,*) minr,ming,minb
      open(10,file='seiko.dump',form='binary')
      open(12,file=filein,form='binary')
      read(12) colormap
      read(12) colors
      print *,''
      write(10) startpage
      do 20 x=127,0,-1
         do 30 y=767,0,-1
            rvalue=0
            gvalue=0
            bvalue=0
            do 40 i=0,7
               mapcolor=colors(x*8+i,y)
               r=colormap(mapcolor,1)
               g=colormap(mapcolor,2)
               b=colormap(mapcolor,3)
               rvalue=ishft(rvalue,1)
               gvalue=ishft(gvalue,1)
               bvalue=ishft(bvalue,1)
               if(r.ge.minr) then
                  rvalue=ior(rvalue,1)
               endif
               if(g.ge.ming ) then
                  gvalue=ior(gvalue,1)
               endif
               if(b.ge.minb) then
                  bvalue=ior(bvalue,1)
               endif
   40       continue
            write(10) char(rvalue),char(bvalue),char(gvalue)
c           write(*,*) rvalue,gvalue,bvalue
   30    continue
   20 continue
c     do 50 i=0,384
c        write(10) char(0)
c  50 continue
      stop
      end