;SHOWIM.PRO IDL (or PV-WAVE) image display procedure
; (clumsy, may still have bugs)
;Revised 12/28/93.
;Written by
;       Mitchell R Grunes (grunes@imsy1.nrl.navy.mil)
;       Allied-Signal Technical Services
; at and for
;       Code 7230 (Imaging Systems and Research)
;       Naval Research Laboratory
;       Washington, DC 20375-5351
;for his own use--if you don't like it, feel free to make your own version.
 
;To get free (7 minute runs, no output files) version of IDL through internet:
;       FTP 128.138.240.1       or FTP boulder.colorado.edu
;       anonymous
;       <your e-mail address>
;       cd pub/idl
;       dir
;       get README
;       quit
;Then type README file for more info.
 
;To run this program, get into IDL (or PV-WAVE) and type
;       .rnew showim
;NOTE: This creates or uses a file (demo.txt) which holds the menu of images.
; Compression and reconstruction may also create test.im, test.rim and
; test.siz.
; @(#)showim.pro	1.1 01/23/98 :LASCO IDL LIBRARY
;
;----------------------------------------------------------------------
  pro AskDevice,idev1,idev,xsKeep,ysKeep,jsize,nwrite,xscrn,yscrn
;Written by Mitchell R Grunes.
  print,'1=SunView'
  print,'2=Sun OpenWindows'
  print,'3=SGI X-Windows'
  print,'9=Other X-Windows'
  print,'10=Old Pre-Windows IDL for PC with VGA (recommended)'
  print,'30=Microsoft Windows PC IDL'
  print,'31=VT 340 (Regis)'
  print,'98=Tektronix graphics plot'
	;99 reserved for postscript printer
  print,'100=none (TTY)'
  print,' '
  print,'Display Device:'
  idev1=3
  read,idev1
  if idev1 ge 10 and idev1 ne 30 then ShowText,idev1
  xscrn=[0,51,102,153,204,255]          ;On Screen Transfer Function
  yscrn=[0,51,102,153,204,255]          ; These values corrospond to using
					; no transfer function--but see
					; below for each device.
  jsize=1.                              ;text size
  nwrite=1                              ;text line thickness
  if idev1 eq 1 then begin              ;SunView
    spawn,'rm core'                     ;almost anything on sun creates core
    xsKeep=1120                         ;full screen window size in screen
    ysKeep=870                          ; coordinates
    xscrn=[0,5,78,177,251,255]
    yscrn=[0,51,102,167,230,255]
    nwrite=1                            ;Text thickness
  endif else if idev1 eq 2 then begin   ;Sun OpenWindows
    spawn,'rm core'
    xsKeep=1120
    ysKeep=870
    nwrite=1
    xscrn=[0,5,78,177,251,255]
    yscrn=[0,51,102,167,230,255]
    jsize=1.35                          ;text size for Sun OpenWindows version
  endif else if idev1 eq 3 then begin   ;SGI X Windows
    jsize=.75                           ;text size for SGI version
    xsKeep=1265
    ysKeep=985
    nwrite=2
  endif else if idev1 eq 9 then begin   ;Other X Windows
    print,'X,Y Size of window (Sun:1120,870 SGI=1265,985):'
    read,xsKeep,ysKeep;
    xsKeep=1120
    ysKeep=650
    nwrite=2
    print,'relative text size (Sunview:1, OpenWindows:1.35, SGI:.75):'
    read,jsize
    jsize=1.3
  endif else if idev1 eq 10 then begin  ;Non-Windows IBM PC IDL
    set_plot,'vga'
    help,/device
    print,'The highest resolution 256 color mode is probably best, but not all'
    print,' modes will work with all VGA adaptor/monitor combinations.'
    print,'Select mode #:'
    imode=0
    read,imode
    idev1=imode+11
    device,set_mode=imode               ;choose resolution: varies with board
    erase
    xsKeep=!d.x_vsize
    ysKeep=!d.y_vsize
    xscrn=[0,9,81,171,246,255]
    yscrn=[0,34,99,155,228,255]
    nwrite=1
  endif else if idev1 eq 30 then begin  ;Windows IBM PC
    set_plot,'win'
    window,0,xsize=1500,ysize=1500
    erase
    xsKeep=!d.x_vsize-9                 ;Because of windows bug
    ysKeep=!d.y_vsize-9
    xscrn=[0,9,81,171,246,255]
    yscrn=[0,34,99,155,228,255]
    nwrite=1
  endif else if idev1 eq 31 then begin  ;Regis (VT340)
    set_plot,'regis'
    erase
    xsKeep=!d.x_vsize
    ysKeep=!d.y_vsize
    nwrite=1
  endif else if idev1 eq 98 then begin  ;none
    xsKeep=125
    ysKeep=125
  endif else if idev1 eq 100 then begin  ;none
    xsKeep=11
    ysKeep=6
  endif
  idev=idev1
  end
;----------------------------------------------------------------------
  pro SetDev,idev,xs,ys,xo,yo,leftm,rightm,topm,botm,$
   nimage,nimage2,nimagex,spacex,spacey,greywid,nline,ls,itransfer
					;open window 0 to whole screen
;Written by Mitchell R Grunes.
  if idev eq 1 then begin               ;SunView version
    set_plot,'sun'
    window,1,title='2',xsize=xs,ysize=ys,colors=256;for IDL/SunView version
    window,0,title=' ',xsize=xs,ysize=ys,colors=256;for IDL/SunView version
  endif else if idev lt 10 then begin   ;OpenWindows or X version
    set_plot,'x'
    device,pseudo=8
    window,1,title='2',xsize=xs,ysize=ys,xpos=0,ypos=30,colors=256
    window,0,title=' ',xsize=xs,ysize=ys,xpos=0,ypos=30,colors=256
  endif else if idev ge 10 and idev le 29 then begin
    set_plot,'vga'                      ;for PC VGA version (pre-windows)
    ;device,set_mode=idev-11            ;choose resolution: varies with board
  endif else if idev eq 30 then begin
    set_plot,'win'                      ;for PC IDL--Windows version
					;Will not really get 256 colors!
    window,1,title='2',xsize=xs,ysize=ys,colors=256,xpos=0,ypos=0
    window,0,title=' ',xsize=xs,ysize=ys,colors=256,xpos=0,ypos=0
  endif else if idev eq 31 then begin   ;VT 340 (Regis)
    set_plot,'regis'
  endif else if idev eq 98 then begin   ;Tektronix plot
    set_plot,'tek'
  endif else if idev eq 99 or idev eq 99.5 then begin   ;hardcopy (postscript)
    PrintMenu1,nimage,nimage2,nimagex,spacex,spacey,greywid,nline,$
     ls,leftm,rightm,topm,botm,itransfer,idev
    if idev eq 99.5 then idev=99
    if idev eq 99 then begin
      set_plot,'ps'
      device,filename='idl.ps'
    endif
    x=8.5                             ;Size
    y=11
    xo=-.706                          ;Offsets for IDL postscript handling
    yo=-5.05
    if ls ne 0 then begin
      x=11
      y=8.5
      xo=-.7
      yo=-.8
    endif
    xo=fix(xo*2540)
    yo=fix(yo*2540)
    leftm=fix(leftm*2540)
    rightm=fix(rightm*2540)
    topm=fix(topm*2540)
    botm=fix(botm*2540)
    if ls ne 0 then device,/landscape
    device,/inches,xsize=x,ysize=y,font_size=6.8,bits_per_pixel=8
    device,/times
    !p.thick=2                          ;some printers can't draw thin lines
  endif
  end
;----------------------------------------------------------------------
  pro ClosePS                           ;close postscript output
;Written by Mitchell R Grunes.
  device,/close_file
  print,'Postscript output will go to file idl.ps'
  print,'Appending a control-D to end of file (makes Tektronix IIsd go faster).'
  print,'The free trial version of IDL cannot do this, and will give warnings.'
  close,1
  openw,1,'idl.ps',/append
  writeu,1,byte(4)
  close,1
  print,'Enter command to print file idl.ps'
  print,'The free trial version of IDL cannot do this, and will give warnings.'
  print,'(e.g. cat idl.ps > /dev/ttyb  ON SUN;  copy/b idl.ps lpt1:  ON PC):'
  a=' '
  read,a
  if a gt ' ' then spawn,a
  end
;----------------------------------------------------------------------
  pro ClearScreen,idev                  ;clear screen
;Written by Mitchell R Grunes.
  if idev lt 10 or idev eq 30 then begin
    wset,1
    erase
    wset,0
    erase
  endif else if idev ne 100 then begin
    erase
  endif
  end
;----------------------------------------------------------------------
  pro ShowText,idev                     ;Show text screen
;Written by Mitchell R Grunes.
  if idev lt 99 then begin
    if idev ne 98 then MyColor,-1,0,[0,255],[0,255]
    if idev ge 10 and idev lt 30 then begin
      device,set_display=2
    endif else if idev lt 10 or idev eq 30 then begin
      wshow,0,0
      wshow,1,0
    endif else begin
      erase
    endelse
  endif
  end
;----------------------------------------------------------------------
  pro ShowWin,idev,iWindow            ;Show image screen
;Written by Mitchell R Grunes.
  if idev lt 10 or idev eq 30 then begin
    wshow,iWindow
    wset,iWindow
  endif
  if idev ge 10 and idev lt 30 then device,set_display=3
  ;if idev ge 10 and idev lt 30 then device,set_mode=idev-11
  end
;----------------------------------------------------------------------
  pro MyColor,icolor,itransfer,xscrn,yscrn          ;load color tables
					;icolor=-1: for text window
					; 0=black and white
					; 1-15 =IDL LOADCT color schemes
					;  (some not allowed)
					; 16=my blackbody false color scheme
					;itransfer sets transfer function:
					; =0 Use xscrn,yscrn
					; =1 Tektronix Phaser IISD printer,
					;    4 color transfer roll,
					;    glossy paper.
					; =2 Tektronix Phaser IISD printer,
					;    black and white transfer roll,
					;    glossy paper.
					; =5 Kodak printer,
					;    3 color ribbon,
					;    glossy paper.
;Written by Mitchell R Grunes.
  if icolor lt -1 or icolor gt 16 then icolor=0
  n=!d.n_colors
  if icolor eq -1 then begin            ;Color 0 is often used for text.
    r=indgen(256)
    r(0)=128
    g=r
    b=r
  endif else if icolor eq 0 then begin
    r=indgen(256)
    g=r
    b=r
  endif else if icolor lt 16 then begin
    loadct,icolor
    COMMON colors,ro,go,bo,rc,gc,bc
    r=rc
    g=gc
    b=bc
    if n lt 256 then begin              ;Interpolate to 256 colors
      s=fix(interpol([0,n-1],[0,255],indgen(256)+.5))
      r=r(s)
      g=g(s)
      b=b(s)
    endif
  endif else if icolor eq 16 then begin ;My black body color schme
    ;0=black,50=red,85=orange,100=yellow,135=green,165=aqua,200=blue,255=white
    r=[0,5,10,15,20,25,30,35,40,45,50,55,60,65,70,75,80,85,90,95,100,105,$
     110,115,120,125,130,135,140,145,150,155,160,165,170,175,180,185,190]
    r=[r,195,200,205,210,215,220,225,230,235,240,245,250,255,255,255,255,255,$
     255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255]
    r=[r,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,$
     255,255,255,255,255,255,255,255,255,255,255,255,255,252,248,245,241]
    r=[r,237,234,231,227,223,220,217,213,210,206,202,199,196,192,189,185,181,$
     178,175,171,167,164,161,157,154,150,146,143,140,136,133,129,125,122]
    r=[r,119,115,111,108,105,101,98,94,90,87,84,80,77,75,73,72,71,69,67,66,$
     64,63,62,60,58,57,56,54,53,51,49,48,47,45,43,42,40,39,38,36,34,33]
    r=[r,32,30,29,27,25,24,23,21,19,18,16,15,14,12,10,9,8,6,5,3,1,0,5,10,15,$
     20,25,30,35,40,45,50,55,60,65,70,75,80,85,90,95,100,105,110,115,120]
    r=[r,125,130,135,140,145,150,155,160,165,170,175,180,185,190,195,200,205,$
     210,215,220,225,230,235,240,245,250,255]
    g=[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,$
     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,10,15,20,25,30,35,40,45,50]
    g=[g,55,60,65,70,75,80,85,90,95,100,105,110,115,120,125,130,135,140,145,$
     150,155,160,165,170,175,180,185,190,195,200,205,210,215,220,225]
    g=[g,230,235,240,245,250,255,254,253,252,251,250,249,248,247,246,245,$
     244,243,242,241,240,239,238,237,236,235,234,233,232,231,230,229,228]
    g=[g,227,226,225,224,223,222,221,220,219,218,217,216,215,214,213,212,211,$
     210,209,208,207,206,205,204,203,201,200,198,196,195,194,192,191,189]
    g=[g,188,186,185,183,181,180,179,177,176,174,172,171,170,168,167,165,$
     164,162,161,159,157,156,155,153,152,150,148,147,146,144,142,141,140]
    g=[g,138,137,135,133,132,131,129,128,130,133,135,137,140,143,145,148,150,$
     152,155,158,160,162,165,168,170,173,175,177,180,183,185,188,190,192]
    g=[g,195,198,200,202,205,208,210,213,215,217,220,223,225,228,230,232,$
     235,238,240,242,245,248,250,253,255]
    b=[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,$
     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
    b=[b,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,$
     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
    b=[b,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5,10,15,20,25,30,35,40,45,50,$
     55,60,65,70,75,80,85,90,95,100,105,110,115,120,125,130,135,140,145]
    b=[b,150,155,160,165,170,175,180,185,190,195,200,205,210,215,220,225,230,$
     235,240,245,250,255,255,255,255,255,255,255,255,255,255,255,255,255]
    b=[b,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,$
     255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,$
     255,255,255,255,255]
  endif
  if itransfer eq 0 then begin                  ;xscrn,yscrn transfer function
    s=fix(interpol(yscrn+.5,xscrn,indgen(256)))
    r=s(r)
    g=s(g)
    b=s(b)
  endif else if itransfer eq 1 then begin       ;Tek II SD, 4 color roll, glossy
    ;This is based on producing approximately equal visual increments from
    ; 0,40,70,100,135,170,205,230,240,255.
    s=[0,7,11,13,15,17,18,20,21,23,24,25,26,27,28,29,30,31,32,33,34,34,35,$
     36,37,38,38,39,40,41,42,43,44,45,46,47,48,50,51,52,53,54,55,56,57]
    s=[s,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,76,77,78,79,80,$
     81,82,83,84,85,86,87,88,89,90,91,92,93,95,96,97,98,99,100,101,102]
    s=[s,104,105,106,107,108,110,111,112,113,114,116,117,118,119,121,122,123,$
     124,126,127,128,129,131,132,133,135,136,137,138,140,141,142,143,144]
    s=[s,146,147,148,149,151,152,153,154,156,157,158,159,161,162,163,164,165,$
     167,168,169,170,172,173,174,176,177,179,180,181,182,184,185,186,188]
    s=[s,189,190,191,193,194,195,196,197,198,200,201,202,203,204,205,207,209,$
     211,212,213,215,216,217,218,219,220,220,221,222,223,223,224,225,225]
    s=[s,226,226,227,227,228,228,229,229,230,230,231,231,231,232,232,232,233,$
     233,233,234,234,234,235,235,235,236,236,237,237,237,238,238,238,239]
    s=[s,239,239,240,240,240,241,241,241,241,242,242,242,243,243,243,244,244,$
     244,245,245,246,246,247,247,248,248,249,249,250,251,252,255]
    r=s(r)
    g=s(g)
    b=s(b)
  endif else if itransfer eq 2 then begin       ;Tek II SD, B&W roll, glossy
    ;This is based on producing approximately equal visual increments from
    ; 0,11,15,27,40,56,65,76,109,122,141,157,175,185,215,232,249;
    ; modified to include 255 at top.
    s=[0,3,4,5,5,6,7,7,8,8,9,9,10,10,10,11,11,11,12,12,12,12,13,13,$
     13,13,14,14,14,14,15,15,15,15,16,16,17,17,17,18,18]
    s=[s,19,20,20,21,22,23,25,27,28,29,29,30,31,32,33,33,34,35,36,$
     37,38,38,39,40,42,43,44,46,47,48,49,50,51,52,53,54,54,55,56]
    s=[s,56,57,57,57,58,58,59,59,60,60,61,61,61,62,62,63,63,64,64,$
     65,66,66,67,68,68,69,70,71,72,73,74,75,77,78,80,81,83,85,88,91]
    s=[s,94,97,99,102,104,105,107,108,109,110,111,112,113,113,114,$
     115,116,117,118,118,119,120,121,122,123,124,125,126,127,128,129]
    s=[s,131,132,133,134,136,137,138,139,141,142,143,144,145,146,$
     147,148,149,150,151,152,153,154,155,156,157,158,159,161,162,163]
    s=[s,164,166,167,168,169,170,171,172,173,174,175,175,176,177,177,$
     178,179,179,180,181,181,182,182,183,184,184,185,186,187,188,189]
    s=[s,190,191,193,194,196,198,201,204,207,210,212,215,216,217,218,$
     219,220,222,223,224,225,226,227,228,229,230,231,232,233,233,234]
    s=[s,234,235,236,236,237,238,239,239,240,242,243,245,255]
    r=s(r)
    g=s(g)
    b=s(b)
  endif else if itransfer eq 5 then begin       ;Kodak, 4 color roll, glossy
    ;This is based on producing approximately equal visual increments from
    ; 0,2,6,14,20,32,42,70,80,110,143,159,189,204,245;
    ; modified to include 255 at top.
    s=[0,0,0,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,4,4,4,$
     4,5,5,5,6,6,6,7,7,7,8,8,8,9,9,10,10,11,11,12,12,13,13,14,14,14,15]
    s=[s,15,15,16,16,16,17,17,17,18,18,18,19,19,19,20,20,21,21,21,22,23,$
     23,24,24,25,26,26,27,28,29,30,30,31,32,33,33,34,34,35,35,36,36,37]
    s=[s,37,38,39,39,40,40,41,41,42,43,44,45,46,47,49,51,53,55,58,60,62,$
     64,65,66,68,69,70,70,71,71,72,73,73,74,74,75,75,76,76,77,77,78,78]
    s=[s,79,80,80,81,82,83,83,84,85,86,87,88,90,91,93,94,96,99,102,105,$
     110,113,115,117,120,122,124,126,128,130,132,133,135,136,138,139]
    s=[s,140,142,143,144,145,146,146,147,148,149,150,151,152,153,153,154,$
     155,156,157,158,159,160,161,163,164,166,168,170,172,174,176,177]
    s=[s,179,181,183,184,186,187,188,189,190,191,192,193,194,194,195,$
     196,197,198,198,199,200,201,202,203,203,204,205,207,208,209,210]
    s=[s,212,213,215,216,218,220,221,224,226,228,231,235,255]
    r=s(r)
    g=s(g)
    b=s(b)
  endif
  if n lt 256 then begin                ;reduce to n colors
    s=fix(interpol([0,255],[0,n-1]+.5,indgen(n)))
    r(0:n-1)=r(s)
    g(0:n-1)=g(s)
    b(0:n-1)=b(s)
    r(n:255)=r(255)
    g(n:255)=g(255)
    b(n:255)=b(255)
  endif
  tvlct,fix(r+.5),fix(g+.5),fix(b+.5)
  end
;----------------------------------------------------------------------
  pro Beep,nrep                         ;sound a Beep
;Written by Mitchell R Grunes.
  for i=1,nrep do print,format='(a1,$)','\007'
  end
;----------------------------------------------------------------------
  pro xyout2,x,y,a,jsize,nwrite,align,idev   ;similar to xyouts, but writes
					     ; with thicker lines.
;Written by Mitchell R Grunes.
  if idev eq 98 or idev eq 100 then begin
    print,a
  endif else begin
    xyouts,x,y,a,size=jsize,alignment=align,charthick=nwrite
  endelse
  end
;----------------------------------------------------------------------
  pro cursor2,x,y,oldtime,ibutton,jbutton,idev,device2
					;Similar to cursor, but adds
					; extra features.
					; -----INPUTS-----
					; oldtime=-1: Wait until a button
					;             or key is pressed.
					;        =-2: Return immediately
					;             even if nothing pressed.
					;        >=0: An old systime(1).
					;             If more than 2 seconds
					;             from current time, return
					;             even if no button or
					;             key was pressed.
					; device2=0 for data coordinates
					;         1 for device coordinates
					; -----OUTPUTS----
					; x,y= device coordinates of
					;      cursor, or -1 if was
					;      outside window or if
					;      function was interupted
					;      by keyboard key press.
					; ibutton=0 (initialize button #)
					; jbutton=the keyboard button #,
					;         or 0.
;Written by Mitchell R Grunes.
Start:
  if idev ne 31 and idev lt 98 then tvcrs,1     ;Turn on cursor
  x=-1
  y=-1
  ibutton=0
  jbutton=0
  if oldtime gt 0 and abs(systime(1)-oldtime) gt 2 then goto,Last
  c=get_kbrd(0)
  if c gt '' then begin
    beep,1
    if c ge '0' and c le '9' then begin
      jbutton=fix(c)
    endif else if c ge 'A' and c le 'Z' then begin
      jbutton=strpos('ABCDEFGHIJKLMNOPQRSTUVWXYZ',c,0)+10
    endif else if c ge 'a' and c le 'z' then begin
      jbutton=strpos('abcdefghijklmnopqrstuvwxyz',c,0)+10
    endif
    goto,Last
  endif
  !err=0                                ;Wait until button is down.
  if idev ne 31 and idev lt 98 then cursor,x,y,device=device2,/nowait
  if !err eq 0 then begin
    x=-1
    y=-1
    if oldtime eq -2 then goto,Last2 else goto,Start
  endif
  beep,1
  if x ge 0 and y ge 0 and idev lt 98 then plots,[x],[y],psym=2,/device
Last:
  while get_kbrd(0) ne '' do c=''       ;Wait till key up
  !err=0                                ;Wait until button is up again.
  if idev ne 31 and idev lt 98 then cursor,x2,y2,device=device2,/nowait
  if !err ne 0 then goto,Last
Last2:
  end
;----------------------------------------------------------------------
  pro Button,xc,yc,name,jsize,nwrite,ibutton,idev  ;draw Button
;Written by Mitchell R Grunes.
  if idev lt 98 then plots,xc+[-27,-27,24,24,-27],yc+[-9,+10,+10,-9,-9]
  a='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'
  ibutton=ibutton+1
  if ibutton gt 35 then ibutton=35
  a=strmid(a,ibutton,1)
  if idev lt 98 then xyout2,xc-27+2,yc-4,a,   jsize*.6,nwrite,0,idev
  if idev lt 98 then xyout2,xc-27+7,yc-6,name,jsize*.85,nwrite,0,idev
  if idev eq 98 or idev eq 100 then print,a,':',name
  end
;----------------------------------------------------------------------
  function ButtonRd,x,y,xc,yc,ibutton,jbutton,idev   ;Check for button
;Written by Mitchell R Grunes.
  ibutton=ibutton+1
  if (x ge xc-27 and x le xc+24 and y ge yc-9 and y le yc+10) $
     or (ibutton eq jbutton) then begin
    if idev lt 98 then polyfill,[xc-26,xc-26,xc+23,xc+23],$
     [yc-8,yc+8,yc+8,yc-8],color=0,/device
    return,1
  endif
  return,0                                      ;Not right button
  end
;----------------------------------------------------------------------
  pro MainComment
;Written by Mitchell R Grunes.
  print,' '
  print,'SHOWIM--Simple image display procedure written in IDL by M Grunes.'
  print,'Can display up to 2 images, print as many as needed.  Mouse Buttons:'
  print,'Zoom                   Lets you enter box corners to zoom in on.'
  print,'Dezoom                 Views whole image.'
  print,'In                     Zooms in on a smaller viewing window.'
  print,'Out                    Zooms out on a larger viewing window.'
  print,'Left, Right, Up, Down  Moves viewed portion of image'
  print,'Left+,Right+,Up+,Down+ Same, larger motion'
  print,'Scale                  Autoscales black and white pixel values
  print,'                       based on current viewing window.'
  print,'Error                  Show Difference and Abs. Difference Images,'
  print,'                       find RMS difference between images, draw'
  print,'                       histogram of errors.'
  print,'Print                  Print or extract image(s).'
  print,'Fast                   Use faster mode (sub-sample, replicate pixel)
  print,'                       to resize images to fit on screen.'
  print,'Slow                   Use slower (default) mode.'
  print,'Color                  Toggles in and out of false color mode.'
  print,'KeyBd                  Keyboard entry of values or commands.'
  print,'Exit                   Ends program.'
  print,'Full                   Full Screen.'
  print,'NEXT                   Next demo screen.'
  print,'NOTE: When using the mouse, you must depress Button until it Beeps!'
  print,' '
  end
;----------------------------------------------------------------------
  function squeeze,a                    ;format number, remove blanks
;Written by Mitchell R Grunes.
  b=a
  if b eq long(b) then b=long(b)
  return,strcompress(string(b),/remove_all)
  end
;----------------------------------------------------------------------
  pro AskInitial,idev, $
   image1,title1,image2,title2,itype,nheader, $
   ncol,icol1,icol2,nrow,irow1,irow2, $
   ishow,icolor,igeom,isamp,ifull,dmin,dmax, $
   oldimage1,oldimage2,nimage, $
   demo,jsize,icolor2,xsKeep,ysKeep,nwrite,xscrn,yscrn
;Written by Mitchell R Grunes.
start:
  ShowWin,idev,0
  image1='test.im'
  image2=' '
  ncol=512
  nrow=512
  itype=1
  nheader=0
  isamp=1
  icol1=0
  irow1=0
  icol2=0
  irow2=0
  ishow=0
  dmin=0L
  dmax=0L
  icolor=0
  icolor2=-1
  title1=' '
  title2=' '
  ifull=0
  igeom=1000
  if itype ge 1000 and itype ne 17 then igeom=1007
  xs2=xsKeep                        ;xs,ys in device coordinates
  ys2=ysKeep
  !x.s=[0,1./xs2]                   ;so data and screen device coord match
  !y.s=[0,1./ys2]
  x=50
  y=ys2-25
  for iloop=demo,1 do begin             ;0=Make Buttons, 1=Check Buttons or
					; Read Demo.
    ibutton=0
    jbutton=0
    if iloop eq 0 then begin
      ClearScreen,idev
      if idev lt 98 then MyColor,0,0,[0,255],[0,255]
      Button,30,ys2-19,  'Input    New Image',jsize,nwrite,ibutton,idev
      Button,30,ys2-19*2,'Grey     Scale Adjust and Test',jsize,nwrite,ibutton,$
       idev
      Button,30,ys2-19*3,'Check    True Screen Resolution',jsize,nwrite,$
       ibutton,idev
      Button,30,ys2-19*4,'Unix     (or other operating system) Commands',$
       jsize,nwrite,ibutton,idev
      Button,30,ys2-19*5,'Exit',              jsize,nwrite,ibutton,idev
    endif else if demo eq 0 then begin
      if idev ne 31 and idev lt 98 then tvcrs,x,y,/device
      cursor2,x,y,-1,ibutton,jbutton,idev,1
      if ButtonRd(x,y,30,ys2-19,ibutton,jbutton,idev) then begin;Input New Image
	image1=image1save
	KeyMenu,idev,0, $
	 image1,title1,image2,title2,itype,nheader, $
	 ncol,icol1,icol2,nrow,irow1,irow2, $
	 ishow,icolor,igeom,isamp,ifull,dmin,dmax, $
	 demo,oldimage1,oldimage2,nimage,nimage3,moviename
	goto,Last
							;Grey Scale Test
      endif else if ButtonRd(x,y,30,ys2-19*2,ibutton,jbutton,idev) then begin
	AdjustTrans,xscrn,yscrn,xsKeep,idev
	icol1=0
	icol2=0
	irow1=0
	irow2=0
	isamp=1
	dmin=0L
	dmax=255L
	ifull=0
	image1='Grey Scale Test'
	image2=' '
	title1=image1
	itype=1
	icolor=0
	goto,Last
						;Check Resolution
      endif else if ButtonRd(x,y,30,ys2-19*3,ibutton,jbutton,idev) then begin
	for iresol=1,4 do begin
	  ncol=fix(xsKeep/iresol)
	  if fix(ncol/2)*2 eq ncol then ncol=ncol-1
	  nrow=fix(ysKeep/iresol)
	  a=byte(indgen(ncol,nrow) and 1)*255
	  a=rebin(a,ncol*iresol,nrow*iresol,/sample)
	  erase
	  if idev lt 98 then tv,a
	  if idev eq 98 then surface,a
	  if idev eq 100 then print,a
	  a=squeeze(fix(xsKeep/iresol))+'*'+squeeze(fix(ysKeep/iresol))
	  if idev lt 98 then tv,bytarr(xsKeep/4,yskeep/10),50,ysKeep/2
	  xyout2,50+5,ysKeep/2+5,a,jsize,nwrite,0,idev
	  wait,3
	endfor
	goto,Start
						;Unix Commands
      endif else if ButtonRd(x,y,30,ys2-19*4,ibutton,jbutton,idev) then begin
	ShowText,idev
	aaa='.'
	while aaa gt ' ' do begin
	  print,'The free trial version of IDL cannot do this, ',$
	   'and will give warnings.'
	  print,'Enter operating system command (blank to end):'
	  read,aaa
	  if aaa gt ' ' then spawn,aaa
	endwhile
	if idev ge 10 and idev le 30 then erase
	goto,start
						;Exit
      endif else if ButtonRd(x,y,30,ys2-19*5,ibutton,jbutton,idev) then begin
	image1=' '
	goto,Last
      endif
    endif
    yy=ys2-19*7
    ierr=0
    if demo eq 0 then begin             ;demo.txt holds menu-of-images info
      close,2
      openr,2,'demo.txt',error=ierr
    endif
    if ierr eq 0 then begin
      if eof(2) then ierr=1
    endif
    image1save=image1
    while ierr eq 0 do begin
      image1save=image1
      readf,2,image1
      if image1 eq '=' then begin
	readf,2,title1
	if iloop eq 0 then begin
	  if yy gt 10 or idev ge 98 then $
	   Button,30,yy,'Demo    '+title1,jsize,nwrite,ibutton,idev
	endif else if demo ne 0 or ButtonRd(x,y,30,yy,ibutton,jbutton,idev) $
	 then begin
	  demo=1
	  ClearScreen,idev
	  y=ys2-30
	  while title1 gt ' ' do begin
	    if idev lt 98 then xyouts,xsKeep/2,y,title1,size=1.8*jsize,$
	     align=.5,charthick=nwrite
	    if idev ge 98 then print,title1
	    y=y-30
	    readf,2,title1
	  endwhile
	  cursor2,x,y,-1,ibutton,jbutton,idev,1
	  goto,Start
	endif
	while image1 gt ' ' do readf,2,image1
	yy=yy-19
      endif else if image1 gt ' ' then begin
	readf,2,title1
	readf,2,image2
	readf,2,title2
	readf,2,ncol
	readf,2,nrow
	readf,2,itype
	if image2 le ' ' and itype ne 50 then title2=' '
	readf,2,nheader
	readf,2,isamp
	readf,2,icol1
	readf,2,icol2
	readf,2,irow1
	readf,2,irow2
	dmin=0L
	dmax=0L
	readf,2,dmin
	readf,2,dmax
	if (itype eq 2 or itype eq 5) and dmin lt 0 and dmax lt 0 then begin
	  dmin=dmin+32768                       ;compensate for early bugs
	  dmax=dmax+32768
	endif
	if (itype eq 3 or itype eq 6)$
	 and dmin gt 32767 and dmax gt 32767 then begin
	  dmin=dmin-32768                       ;compensate for early bugs
	  dmax=dmax-32768
	endif
	readf,2,icolor
	ishow=fix(icolor/1000)
	icolor=icolor-ishow*1000
	readf,2,icolor2
	readf,2,ifull
	readf,2,igeom
	if igeom eq 1 then igeom=1000           ;deal with old format
	if igeom eq 0 then igeom=1007
	if iloop eq 0 then begin
	  aaa=title1
	  if title2 gt ' ' then aaa=aaa+'; '+title2
	  if (yy gt 10 or idev ge 98) and itype ne 50 then $
	   Button,30,yy,'Demo    '+aaa,jsize,nwrite,ibutton,idev
	  if (yy gt 10 or idev ge 98) and itype eq 50 then $
	   Button,30,yy,'Movie   '+aaa,jsize,nwrite,ibutton,idev
	endif else if demo ne 0 or ButtonRd(x,y,30,yy,ibutton,jbutton,idev) $
	 then begin; Use this
								 ;  image.
	  demo=1
	  ClearScreen,idev
	  if idev lt 99 then MyColor,icolor,0,[0,255],[0,255]
	  goto,Last
	endif
	yy=yy-19
      endif
      if eof(2) then ierr=1
    endwhile
  endfor
  if ierr ne 0 then demo=0
  Beep,3
  goto,start
Last:
    if icol2 le icol1 then icol2=ncol-1
    if irow2 le irow1 then irow2=nrow-1
  end
;----------------------------------------------------------------------
  pro AdjustTrans,xscrn,yscrn,xsKeep,idev
;Written by Mitchell R Grunes.
Start:
  MyColor,0,0,xscrn,yscrn
  jtransfer=fix(interpol(yscrn+.5,xscrn,indgen(256)))
  plot,xscrn,yscrn,xstyle=1,ystyle=1, $
   xtitle='Pixel Value',ytitle='Brightness', $
   title='Make scale linear across scale--click outside to exit.'
  for i=0,254 do begin
    j=jtransfer(i)
    if !d.n_colors lt 256 then j=byte(j*!d.n_colors/256)
    polyfill,[i-.5,i-.5,i+.5,i+.5],[0,-4,-4,0],color=j,/noclip
  endfor
  oplot,[76.5,76.5],[0,255]
  oplot,[127.5,127.5],[0,255]
  oplot,[178.5,178.5],[0,255]
  oplot,xscrn,yscrn,psym=2
  cursor2,x,y,-1,ibutton,jbutton,idev,0
  if x lt 0 or x gt 255 or y lt 0 or y gt 255 then goto,Last
  i=fix(x/51+.5)
  if i lt 1 then i=1 else if i gt 4 then i=4
  xscrn(i)=x
  yscrn(i)=y
  for i=1,4 do if yscrn(i) lt yscrn(i-1) then yscrn(i)=yscrn(i-1)
  goto,Start
Last:
  ShowText,idev
  erase
  print,' '
  print,'xscrn=',xscrn
  print,'yscrn=',yscrn
  print,' '
  print,'This section was intended to adjust the screen transfer function'
  print,' (the way pixel values are mapped to screen intensities)'
  print,' to compensate for any non-linear response of your monitor.  You'
  print,' should have adjusted the positions of the stars so that the'
  print,' grey scale increases uniformly across the screen.'
  print,'If you wish to make any changes permanent, alter the'
  print,' lines relating to these variables in function AskDevice in file'
  print,' SHOWIM.PRO.'
  print,' '
  print,'Any adjustments that you have made do NOT affect the appearance'
  print,' of hardcopy.'
  print,'If you wish to change the way pixel values are mapped to'
  print,' on both screen and print, you can do so by altering the black'
  print,' and white pixel values from the KeyBd Menu.'
  print,' '
  print,'Hit key to continue'
  while get_kbrd(0) eq '' do c=''
  while get_kbrd(0) ne '' do c=''
  end
;----------------------------------------------------------------------
  pro autoscale,image,dmin,dmax,idev,icolor,xscrn,yscrn
;Written by Mitchell R Grunes.
;Sets dmin and dmax so that about .1% of pixels lie above and below.
  ShowText,idev
  print,'Old black,white clip=',dmin,dmax
  n=n_elements(image)
  n2=n*.001
  dmin=double(min(image))
  dmax=double(max(image))
  MustBeInt=0
  if min(image eq long(image)) eq 1 then MustBeInt=1
  if MustBeInt ne 0 and dmin ge -32768 and dmax le 32767 then MustBeInt=2
  almost1=0 > (1-(dmax-dmin)/10000.d0)
  if MustBeInt ge 1 then begin
    dmin=long(dmin)
    dmax=long(dmax+almost1)
    if MustBeInt eq 2 and dmin eq fix(dmin) and dmax eq fix(dmax) then begin
      dmin=fix(dmin)
      dmax=fix(dmax)
    endif
  endif
 
  print,'Minumum,maximum pixel for this window=',dmin,dmax
 
  print,''
  print,'Enter those values if you want no saturation.'
  print,'Enter the lower value after the higher value if you want'
  print,' to use reverse video.'
  print,'Enter 0,0 if you want to use a fancy search algorithm to clip'
  print,' about 0.1% of the pixels at each end.'
  print,''
  print,'Enter black,white clip values:'
  read,dminrd,dmaxrd
  dminrd=dminrd
  dmaxrd=dmaxrd
  if dminrd ne dmaxrd then begin
    dmin=dminrd
    dmax=dmaxrd
    goto,Last
  endif
  print,'Attempting to autoscale.'
 
  bot=double(dmin)                      ;Start binary search for dmin
  top=double(dmax)
  diff=top-bot
  for i=1,10 do begin
    try=(double(bot)+top)/2
    if MustBeInt ge 1 then try=long(try)
    if MustBeInt eq 2 and try eq fix(try) then try=fix(try)
    if bot ne top then begin
      if total(image lt try) gt n2 then top=try else bot=try
    endif
  endfor
  dmin=(double(bot)+top)/2
  if MustBeInt ge 1 then dmin=long(dmin)
  if MustBeInt eq 2 and dmin eq fix(dmin) then dmin=fix(dmin)
  print,'Black=',dmin
 
  bot=double(dmin)                      ;Start binary search for dmax
  top=double(dmax)
  for i=1,10 do begin
    try=(double(bot)+top)/2
    if MustBeInt ge 1 then try=long(try+almost1)
    if MustBeInt eq 2 and try eq fix(try) then try=fix(try)
    if bot ne top then begin
      if total(image ge try) gt n2 then bot=try else top=try
    endif
  endfor
  dmax=(double(bot)+top)/2
  if MustBeInt ge 1 then dmax=long(dmax+almost1)
  if MustBeInt eq 2 and dmax eq fix(dmax) then dmax=fix(dmax)
  if dmax eq dmin then dmax=dmin+1
  print,'White=',dmax
Last:
  ShowWin,idev,0
  if idev lt 98 then MyColor,icolor,0,xscrn,yscrn
  end
;----------------------------------------------------------------------
  pro MakeButton,xs2,ys2,jsize,demo,title1,ifull,nwrite,icolor,idev
					;make Buttons
;Written by Mitchell R Grunes.
  ibutton=0
  if ifull eq 0 then begin
    Button,xs2+27-53*5,ys2+28,     'Zoom', jsize,nwrite,ibutton,idev
    Button,xs2+27-53*5,ys2+28-19,  'Dezoom', jsize,nwrite,ibutton,idev
    Button,xs2+27-53*4,ys2+28,     'In',   jsize,nwrite,ibutton,idev
    Button,xs2+27-53*4,ys2+28-19,  'Out',  jsize,nwrite, ibutton,idev
    Button,xs2+27-53*3,ys2+28,     'Left', jsize,nwrite,ibutton,idev
    Button,xs2+27-53*3,ys2+28-19,  'Left+',jsize,nwrite, ibutton,idev
    Button,xs2+27-53*2,ys2+28,     'Right',jsize,nwrite,ibutton,idev
    Button,xs2+27-53*2,ys2+28-19,  'Right+',jsize,nwrite,ibutton,idev
    Button,xs2+27-53,  ys2+28,     'Up'  , jsize,nwrite,ibutton,idev
    Button,xs2+27-53,  ys2+28-19,  'Up+'  ,jsize,nwrite ,ibutton,idev
    Button,xs2+27,     ys2+28,     'Down', jsize,nwrite,ibutton,idev
    Button,xs2+27,     ys2+28-19,  'Down+',jsize,nwrite ,ibutton,idev
 
    Button,xs2+27,     ys2+28-19*2,'Scale',jsize,nwrite ,ibutton,idev
    Button,xs2+27,     ys2+28-19*3,'Error',jsize,nwrite ,ibutton,idev
    Button,xs2+27,     ys2+28-19*4,'Print',jsize,nwrite ,ibutton,idev
    Button,xs2+27,     ys2+28-19*5,'Fast', jsize,nwrite ,ibutton,idev
    Button,xs2+27,     ys2+28-19*6,'Slow', jsize,nwrite ,ibutton,idev
    Button,xs2+27,     ys2+28-19*7,'Color'+squeeze(icolor),jsize,nwrite,$
     ibutton,idev
    Button,xs2+27,     ys2+28-19*8,'KeyBd',jsize,nwrite ,ibutton,idev
    Button,xs2+27,     ys2+28-19*9,'Exit', jsize,nwrite ,ibutton,idev
  endif
  if demo eq 0 then begin
    if ifull eq 0 then $
     Button,xs2+27,     ys2+28-19*11,'Full', jsize,nwrite,ibutton,idev
  endif else begin
    if ifull eq 0 then $
     Button,xs2+27,     ys2+28-19*11,'NEXT', jsize,nwrite,ibutton,idev
  endelse
  if idev lt 98 then $
   xyouts,5,!d.y_vsize-30,title1,size=jsize*1.5,charthick=nwrite
  if idev eq 98 then print,title1
  end
;----------------------------------------------------------------------
  pro KeyMenu,idev,iplace, $
   image1,title1,image2,title2,itype,nheader, $
   ncol,icol1,icol2,nrow,irow1,irow2, $
   ishow,icolor,igeom,isamp,ifull,dmin,dmax, $
   demo,oldimage1,oldimage2,nimage,nimage3,moviename
;Written by Mitchell R Grunes.
  ShowText,idev
  imenu=iplace
  if iplace gt 0 then goto,menu2
menu1:
  if idev eq 98 then erase
  if icol1 eq 0 and icol2 eq 0 then begin
    irow1=0
    irow2=0
  endif
  print,' '
  print,  '1  Image file name           =',image1
  print,  '2  Screen title              =',title1
  print,  '3  Second image file name    =',image2
  nimage=1
  if image2 gt ' ' then nimage=2
  if nimage gt 1 then $
    print,'4  Second screen title       =',title2
  print,  '5  Type of image             =',squeeze(itype)
  if itype eq 4 then $
    print,'6  # of ASCII lines to skip  =',squeeze(nheader)
  if itype ne 4 and itype lt 10 then $
    print,'6  # of bytes of header(0)   =',squeeze(nheader)
  if itype lt 10 or itype eq 50 then $
    print,'7  # of cols,rows in file    =',squeeze(ncol),' ',squeeze(nrow)
  if icol1 eq 0 and icol2 eq 0 then $
   print, '8  Start & end col to display=ALL'
  if icol1 ne 0 or icol2 ne 0 then $
   print, '8  Start & end col to display=',squeeze(icol1),' ',squeeze(icol2)
  if icol1 eq 0 and icol2 eq 0 then $
   print, '9  Start & end row to display=ALL
  if icol1 ne 0 or icol2 ne 0 then $
   print, '9  Start & end row to display=',squeeze(irow1),' ',squeeze(irow2)
  print,  '10 Col,Row Geometry #        =',squeeze(igeom-1000)
  print,  '11 Screen Resampling scheme #=',squeeze(isamp)
  if nimage gt 1 then $
    print,'12 0:images 1:diff 2:ratio   =',squeeze(ishow)
  print,  '13 Color Scheme              =',squeeze(icolor)
  print,  '14 0:Buttons 1:Full screen   =',squeeze(ifull)
  if dmin eq dmax then $
   print, '15 Black,white pixel values  =Scan Image'
  if dmin ne dmax then $
   print, '15 Black,white pixel values  =',squeeze(dmin), $
   ' ',squeeze(dmax)
  print,  '16 Operating System Command'
  if iplace ne 0 then begin
    print,'17 Add this image to image menu'
    print,'18 SOHO-style Compress and reconstruct'
  endif
  print,  '0  Exit this menu'
  print,' '
  print,'Choose parameter # to change:'
  read,imenu
menu2:
 if imenu gt 0 and imenu lt 16 then print,'Enter new value(s):'
  if imenu eq 1 then begin
    read,image1
    title1=image1
    oldimage1=' '
  endif else if imenu eq 2 then begin
    read,title1
  endif else if imenu eq 3 then begin
    print,'(Second Image will be flickered with first, unless you select'
    print,' difference or ratio in option 13)'
    read,image2
    title2=image2
    oldimage2=' '
  endif else if imenu eq 4 and nimage gt 1 then begin
    read,title2
  endif else if imenu eq 5 then begin
    print,'  Raw Pixel Data
    print,'    1 8 bit Unsigned
    print,'    2 16 bit Unsigned
    print,'    3 16 bit Signed
    print,'    7 32 bit IEEE real (real*4)
    print,'  Byte Reversed Raw Integral Pixel Data
    print,'    5 16 bit Unsigned
    print,'    6 16 bit Signed
    print,'    8 32 bit IEEE real
    print,'  ASCII Text of Pixel Data
    print,'    4 Pixel values
    print,'  Fancy image file formats
    print,'    10 GIF
    print,'    11 PICT
    print,'    12 Sun Rasterfile
    print,'    13 .wave or .bwave (Adv Data Vis)
    print,'    14 X11 Bitmap
    print,'    15 XWD Dump
    print,'    16 TIFF
    print,'    17 SOHO Compressed'
    print,'    20 Raw PGM (PBMPlus greyscale format from jpeg)
    print,'    50 8 bit raw Movie'
    read,itype
    if itype eq 50 then begin
      print,'# of frames
      read,nimage3
      image2=''
      title2=string(nimage3)
    endif
    oldimage1=' '
    oldimage2=' '
    dmin=0
    dmax=0
    icol1=0
    icol2=0
  endif else if imenu eq 6 and itype lt 10 then begin
    read,nheader
    oldimage1=' '
    oldimage2=' '
  endif else if imenu eq 7 and (itype lt 10 or itype eq 50) then begin
    read,ncol,nrow
    icol1=0
    icol2=0
    oldimage1=' '
    oldimage2=' '
  endif else if imenu eq 8 and (itype lt 10 or itype eq 50) then begin
    read,icol1,icol2
  endif else if imenu eq 9 and (itype lt 10 or itype eq 50) then begin
    read,irow1,irow2
  endif else if imenu eq 10 then begin
    print,' '
    print,'0 Normal--rows are contiguous left > right, rows are top down'
    print,'1 Rotate CW 90 deg'
    print,'2 Rotate 180 deg'
    print,'3 Rotate CCW 90 deg'
    print,'4 Reflect across main diag (i.e., transpose)'
    print,'5 Reflect across vertical (reverse cols)'
    print,'6 Reflect across other diag'
    print,'7 Reflect across horizontal (reverse rows)'
    print,'    Warning--not all the bugs have been worked out of handling'
    print,'    values other than 0, due to the fact that start and end'
    print,'    columns refer to the transformed image, and that the number'
    print,'    of columns and rows may interchange.'
    read,igeom
    igeom=igeom+1000
    oldimage1=' '
    oldimage2=' '
  endif else if imenu eq 11 then begin
    print,'                           0:Slow      1:Fast'
    print,'Image larger than screen:  Average     Subsample'
    print,'Screen larger than image:  Interpolate Replicate
    read,isamp
  endif else if imenu eq 12 then begin
    read,ishow
    dmin=0
    dmax=0
  endif else if imenu eq 13 then begin
    read,icolor
  endif else if imenu eq 14 then begin
    read,ifull
  endif else if imenu eq 15 then begin
    print,'black < white makes low pixel values black, hi white.'
    print,'black > white makes low pixel values white, hi black.'
    print,'black = white causes the image to be scanned.
    dmin=0.
    dmax=0.
    read,dmin,dmax
    dmin=dmin
    dmax=dmax
    if dmin eq long(dmin) then dmin=long(dmin)
    if dmax eq long(dmax) then dmax=long(dmax)
    if dmin eq fix (dmin) then dmin=fix (dmin)
    if dmax eq fix (dmax) then dmax=fix (dmax)
  endif else if imenu eq 16 then begin
    aaa='.'
    while aaa gt ' ' do begin
      print,'Enter operating system command (blank to end):'
      print,'The free trial version of IDL cannot do this, and will give ',$
       'warnings.'
      read,aaa
      if aaa gt ' ' then spawn,aaa
    endwhile
    if idev ge 10 and idev ne 30 then erase
  endif else if imenu eq 17 then begin
    close,2
    openw,2,'demo.txt',/append
    print,'0=Image With Menu Bar, 1=Full Screen Image, 2=Text Only (No Image):'
    if nimage3 gt 0 then print,'3=Movie'
    read,ifull
    if ifull eq 2 then begin
      ifull=0
      printf,2,'='
      print,'Line to place on screen, or blank to end:'
      title1='='
      while title1 gt ' ' do begin
	read,title1
	printf,2,title1
      endwhile
      printf,2,' '
      goto,Last
    endif
    if ifull eq 3 then begin
      image1=moviename
      image2=' '
      title2=string(nimage3)+' frames'
      oldimage1=''
      oldimage2=''
      itype=50
      ncol=icol2-icol1+1
      nrow=irow2-irow1+1
      icol1=0
      icol2=ncol-1
      irow1=0
      irow2=nrow-1
      dmin=0
      dmax=255
      print,'0=Image With Menu Bar,1=Full Screen Image'
      read,ifull
    endif
    icolor2=0
    print,'Current color scheme #=',icolor
    print,'Second color scheme # (-1 for none):'
    read,icolor2
    printf,2,image1
    printf,2,title1
    printf,2,image2
    printf,2,title2
    printf,2,ncol,' # of cols of pixels in disk file'
    printf,2,nrow,' # of rows of pixels'
    printf,2,itype,' Image format #'
    printf,2,nheader,' # of header bytes or lines'
    printf,2,isamp,' 0=slow, 1=fast'
    printf,2,icol1,' Start col to display'
    printf,2,icol2,' End   col to display'
    printf,2,irow1,' Start row to display'
    printf,2,irow2,' End   row to display'
    printf,2,dmin, ' Black pixel value
    printf,2,dmax, ' White pixel value
    printf,2,icolor+1000*ishow,' color scheme #+1000*ishow'
    printf,2,icolor2,' Second color scheme to display'
    printf,2,ifull,' 0=with menu bar,1=full screen'
    printf,2,igeom,' col,row geometry #'
    printf,2,' '
    close,1
    close,2
    close,3
    demo=0
  endif else if imenu eq 18 then begin
    print,'The free trial version of IDL cannot do this, and will give ',$
     'warnings.'
    if (itype ne 2 and itype ne 3) then begin
      print,"---Now creating test.im, in raw 2 byte/pixel form.---"
      ReadImage,image1,a,ncol,nrow,itype,nheader,igeom,title2
      close,1
      openw,1,'test.im'
      writeu,1,fix(a)                   ;Convert everything to int
      if min(a) lt 0 then itype=3 else itype=2
      dmin=dmax
      image1='test.im'
      oldimage1=' '
    endif
    image2='test.rim'
    oldimage2=' '
    title2='test.rim'
    nimage=2
    print,'# of words in ',image1,'=',ncol*long(nrow)
    print,'# of bits/pixel desired in compressed image(-1=uncompressed,0=lossless):'
    read,bpp
    spawn,'rm test.cim test.rim test.siz'
    spawn,'sohocomp '+image1+' test.cim '+squeeze(ncol)+' '+squeeze(nrow) $
     +' '+squeeze(bpp)+squeeze(itype-2)+' 0 0 0'
    spawn,'sohorecon test.cim test.rim'
    ishow=0
    goto,Last
  endif else if imenu ne 0 then begin
    print,'***Bad choice!***'
  endif
  if imenu ne 0 then goto,menu1
Last:
  if icol1 lt 0 then icol1=0
  if icol1 gt ncol-1 then icol1=ncol-1
  if irow1 lt 0 then irow1=0
  if irow1 gt nrow-1 then irow1=nrow-1
  if nimage eq 1 then ishow=0
  end
;----------------------------------------------------------------------
    pro PrintMenu1,nimage,nimage2,nimagex,spacex,spacey,greywid,nline,$
     ls,leftm,rightm,topm,botm,itransfer,idev
;Written by Mitchell R Grunes.
    nimage2=nimage
    nimagex=nimage
    spacex=.12
    spacey=.12
    greywid=.15
    nline=1
    ls=1
    leftm=(rightm=1.3)
    topm=(botm=.5)
menu1:
    if idev eq 98 then erase
    print,' '
    print,'-----Print Page Setup-----'
    print,' '
    print,'1 # of images to print on this page=',nimage2
    if nimage2 gt 1 then print,'2 # of horizontal images across page=',nimagex
    print,'3 Horizontal, vertical image spacing in inches=',spacex,spacey
    print,'4 Width of greyscale (.15? 0=none)            =',greywid
    print,'5 # of lines of text per image                =',nline
    print,'6 Paper Orientation (0=Portrait)              =',ls
    print,'7 Left,right,top,bottom margins               =', $
     leftm,rightm,topm,botm
    print,'8 Printer Transfer Function=',itransfer
    print,'  0    =None'
    print,'  1    =Tektronix Phaser IID, 4 color roll,         glossy paper'
    print,'  2    =Tektronix Phaser IID, Black and white roll, glossy paper'
    print,'  5    =Kodak,                3 color ribbon,       glossy paper'
    print,' '
    print,'0 Exit this menu'
    print,' '
    read,imenu
    if imenu gt 0 then print,'Enter new value(s):'
 
    if imenu eq 1 then begin
      read,nimage2
      if ls then nimagex=nimage2
    endif else if imenu eq 2 then begin
      if nimage2 gt 1 then read,nimagex
    endif else if imenu eq 3 then begin
      read,spacex,spacey
    endif else if imenu eq 4 then begin
      read,greywid
    endif else if imenu eq 5 then begin
      read,nline
    endif else if imenu eq 6 then begin
      read,ls
      if ls eq 0 then leftm=(rightm=.5)
      if ls eq 0 then topm=(botm=1.3)
      if ls ne 0 then leftm=(rightm=1.3)
      if ls ne 0 then topm=(botm=.5)
    endif else if imenu eq 7 then begin
      read,leftm,rightm,topm,botm
    endif else if imenu eq 8 then begin
      read,itransfer
    endif
    if imenu ne 0 then goto,menu1
    end
;----------------------------------------------------------------------
  pro PrintMenu2,ij,TrueCol,nband,nimage2,image1,image2,image3,title1,title2, $
   nline,t,ifactor,dmin,dmax,itransfer,idev
					;Print menu for each image
;Written by Mitchell R Grunes.
  image3=strarr(3)
  if ij eq 1 then image3(0)=image1
  if ij eq 2 then image3(0)=image2
  if ij eq 1 then t(0)=title1
  if ij eq 2 then t(0)=title2
menu1:
  if idev eq 98 then erase
  print,' '
  print,'----------Image #',ij,'----------'
  print,' '
  print,'1 Color Scheme #=',TrueCol
  print,'  0    =black and white,
  print,'  1-15 =IDL LOADCT color schemes'
  print,'  16   =my blackbody false color scheme'
  print,'  17   =True Color (seperate images for red,green,blue)'
  if TrueCol eq 17 then nband=3 else nband=1
  if nband eq 1 then begin
    print,'2 Image Name=',image3(0)
  endif else begin
    print,'2 Image Names (red,green,blue)='
    print,' ',image3(0)
    print,' ',image3(1)
    print,' ',image3(2)
  endelse
  print,'3 Print Resolution Enhancement Factor=',ifactor
  print,'4 Black,White Pixel Values=',dmin,dmax
  if nline gt 0 then begin
    print,'5 Line(s) of Text:'
    for i=0,nline-1 do print,' ',t(i)
  endif
  print,'0 Exit this menu'
  read,imenu
  if imenu gt 0 then print,'Enter New Value(s):'
 
  if imenu eq 1 then begin
    print,'Color/transfer type:'
    read,TrueCol
  endif else if imenu eq 2 then begin
    i3=' '
    if nband eq 1 then begin
      print,'Image file name, or blank to leave out:'
      read,i3
      image3(0)=i3
    endif else begin
      print,'Red Image file name or blank to leave out:'
      read,i3
      image3(0)=i3
      print,'Green Image file name or blank to leave out:'
      read,i3
      image3(1)=i3
      print,'Blue Image file name or blank to leave out:'
      read,i3
      image3(2)=i3
    endelse
  endif else if imenu eq 3 then begin
    read,ifactor
  endif else if imenu eq 4 then begin
    read,dmin,dmax
  endif else if imenu eq 5 then begin
    for i=0,nline-1 do begin
      print,'Text line ',i+1,' for image ',ij,':'
      tt=' '
      read,tt
      t(i)=tt
    endfor
  endif
  if imenu ne 0 then goto,menu1
 
  if TrueCol eq 0  then device,color=0 else device,/color
  if TrueCol ne 17 then MyColor,TrueCol,itransfer,[0,255],[0,255]
  if TrueCol eq 17 then MyColor,0,itransfer,[0,255],[0,255]
  end
;----------------------------------------------------------------------
  pro printmenu3,idev,outform,image1,image2,i   ;Select output file type
  i=1
  ShowText,idev
  if idev eq 98 then erase
  print,'Output file type:'
  print,'Printer output file'
  print,'  0 postscript'
  print,'Raw Pixel Data
  print,'  1 8 bit Unsigned
  print,'  2 16 bit Unsigned
  print,'  3 16 bit Signed
  print,'  7 32 bit IEEE real (real*4)
  print,'ASCII Text of Pixel Data
  print,'  4 Pixel values
  print,'Fancy image file formats
  print,'  10 GIF
  print,'  11 PICT
  print,'  13 .wave or .bwave (Adv Data Vis Wavefront Visualizer)
  print,'  16 TIFF
  print,'  18 NRIF
  print,'  19 SRF (Sun rasterfile)
  print,'  20 Raw PGM (PBMPlus greyscale format from jpeg for jpeg)
  print,'  50 8 bit unsigned Movie
  print,'NOTE: If you pick postscript, you can print any image(s)
  print,'of the same size.'
  print,'Otherwise you must select a displayed image.'
  print,''
  print,'Output file type:'
  read,outform
  if outform eq 0 then begin
    idev=99
  endif else begin
    if image2 gt ' ' then begin
      print,'Select image to extract:'
      print,'1 ',image1
      print,'2 ',image2
      read,i
    endif
  endelse
  end
;----------------------------------------------------------------------
  pro ReadImage,image1,a,ncol,nrow,itype,nheader,igeom,title2
;Written by Mitchell R Grunes.
Start:
  close,1                               ;read image
  print,'Reading image ',image1
  if image1 eq 'Grey Scale Test' then begin
    a=byte(255-indgen(16,16))
    for i=1,15,2 do a(*,i)=a(15-indgen(16),i)
    a=rebin(a,32,32)
    for i=1,31,4 do a(0:29,i)=0
    for i=3,31,4 do a(2:31,i)=0
    a=a(*,0:30)
    ncol=32
    nrow=31
  endif else if itype lt 10 then begin
    openr,1,image1
    if nheader gt 0 then a=bytarr(nheader)
    if nheader gt 0 and itype ne 4 then readu,1,a
    if itype eq 4 then a=' '
    if nheader gt 0 and itype eq 4 then for i=1,nheader do readf,1,a
    if itype eq 1 then a=bytarr(ncol,nrow)
    if itype eq 2 or itype eq 3 or itype eq 5 or itype eq 6 then $
     a=intarr(ncol,nrow)
    if itype eq 4 or itype eq 7 or itype eq 8 then a=fltarr(ncol,nrow)
    if itype ne 4 then readu,1,a
    if itype eq 4 then readf,1,a
    print,"File read complete"
    if itype eq 5 or itype eq 6 or itype eq 8 then byteorder,a
    if itype eq 2 or itype eq 5 then a=a and 65535 ;unsigned--clip hi bits
 
    jtype=[0,1,3,2,4,3,2,4,4,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1]
    jtype=jtype(itype)                  ;Store in 1=byte,2=int,3=long,4=float
    if jtype eq 4 then begin
      if min(a eq long(a)) eq 1 then begin
	a=long(a)
	jtype=3
      endif
    endif
    if jtype eq 3 then begin
      if min(a eq fix(a)) eq 1 then begin
	a=fix(a)
	jtype=2
      endif
    endif
    if jtype eq 2 then begin
      if min(a eq byte(a)) eq 1 then a=byte(a)
    endif
  endif else begin
    if itype eq 10 then begin
      read_gif,image1,a,r,g,b
    endif else if itype eq 11 then begin
      READ_PICT,image1,a,r,g,b
    endif else if itype eq 12 then begin
      READ_SRF,image1,a,R,G,B
    endif else if itype eq 13 then begin
      ;Not yet understood function description--probably won't work
      read_wave,image1,a,names,dimensions
    endif else if itype eq 14 then begin
      READ_X11_BITMAP,image1,a
    endif else if itype eq 15 then begin
      a=READ_XWD(image1,r,g,b)
    endif else if itype eq 16 then begin
      a=TIFF_READ(image1,R,G,B)
    endif else if itype eq 17 then begin
      print,'The free trial version of IDL cannot do this, and will give ',$
       'warnings.'
      if image1 ne 'test.cim' then spawn,'cp '+image1+' test.cim'
      spawn,'rm test.rim test.siz'
      spawn,'sohorecon test.cim test.rim'
      openr,1,'test.siz'
      readf,1,ncol,nrow,itype
      image1='test.rim'
      itype=itype+2
      goto,Start
    endif else if itype eq 20 then begin        ;PGM
      read_pgm,image1,a
    endif else if itype eq 50 then begin        ;Movie
      close,1
      openr,1,image1
      a=bytarr(ncol,nrow,fix(title2))
      readu,1,a
    endif
    igeom=1000
  endelse
  if igeom ne 1000 then a=rotate(a,igeom-1000)
  s=size(a)
  ncol=s(1)
  nrow=s(2)
  help,a
  end
;----------------------------------------------------------------------
  pro read_pgm,image,a                          ;Read raw PGM file
  close,1
  openr,1,image
  a='  '
  readu,1,a
  if a ne 'P5' then print,'ERROR--Invalid PGM File'
  ReadFileInt,ncol
  ReadFileInt,nrow
  ReadFileInt,maxa
  if maxa le 255 then a=bytarr(ncol,nrow)
  if maxa gt 255 then a=intarr(ncol,nrow)
  readu,1,a
  close,1
  end
;----------------------------------------------------------------------
  pro ReadFileInt,n                     ;Read ASCII # from file 1
start:
  n=0
  a=' '
  readu,1,a
  if a eq '#' then begin                ;Skip comment
    readf,1,a
    goto,start
  endif
  if a le ' ' then goto,start           ;Skip leading white space
  while a ge '0' and a le '9' do begin
    n=n*10+long(a)
    readu,1,a
  endwhile
  end
;----------------------------------------------------------------------
						;Write output image
  pro ExtractImage,a,outform,idev,dmin,dmax,nimage3,moviename
  print,'Name of output image file:'
  if outform eq 50 and nimage3 gt 0 then $
   print,'(Leave blank to append as movie frame',nimage3+1,')'
  imagename=''
  read,imagename
  close,1                               ;In case someone else's routines need it
  if imagename gt ' ' then begin        ;Not a movie image
    close,3
    if outform lt 10 or outform eq 50 then openw,3,imagename
    if outform eq 50 then begin
      nimage3=1
      i=1
      moviename=imagename
    endif else begin
      nimage3=0
      print,'Apply black/white (',dmin,dmax,') scaling (0=no)?'
      read,i
    endelse
  endif else begin
    nimage3=nimage3+1
    i=1
  endelse
  if i ne 0 then a=bytscl(a,min=dmin,max=dmax)
  if outform eq 1 or (outform ge 10 and outform ne 20) then begin ;convert type
    a=byte(0>(a<255))
  endif else if outform eq 2 then begin
    a=fix (0>(a<65535))
  endif else if outform eq 3 then begin
    a=fix( -32768>(a<32767))
  endif else if outform eq 7 then begin
    a=float(0>a)
  endif
  if outform lt 10 and outform ne 4 and outform ne 1 then writeu,3,a
  if outform eq 1 then writeu,3,a
  if outform eq 4  then writef,3,a
  if outform eq 10 then write_gif ,imagename,a
  if outform eq 11 then write_pict,imagename,a
  if outform eq 13 then write_wave,imagename,a
  if outform eq 16 then tiff_write,imagename,a
  if outform eq 18 then write_nrif ,imagename,a
  if outform eq 19 then write_srf ,imagename,a
  if outform eq 20 then write_pgm, imagename,a
  if outform eq 50 then writeu,3,a
  print,'Image will be sized according to array a:'
  help,a
  print,'Hit key to continue.'
  while get_kbrd(0) eq '' do c=''
  while get_kbrd(0) ne '' do c=''
  end
;----------------------------------------------------------------------
  pro write_pgm,image,a                         ;Write raw PGM file
  close,3
  openw,3,image
  mina=min(a)
  if mina<0 then begin                          ;must be unsigned
    print,'Adding ',-mina,' to make unsigned!'
    a=a-mina
  endif
  maxa=max(a)
  print,'Maximum value was ',maxa
  if maxa gt 255 then begin                     ;JPEG cannot handle over 255
    f=255./maxa
    if f gt 1 then f=1
    print,'JPEG cannot handle images with pixels over 255.'
    print,'We could scale this to an 8 bit image by:'
    print,'  a=fix(a*',f,'+.5)'
    print,'Do you want this to be scaled to 8 bits (0=no,1=yes)?'
    read,i
    if i then begin
      a=fix(a*f+.5)
      maxa=255
    endif
  endif
  if maxa le 255 then maxa=255 else maxa=65535
  s=size(a)
  ncol=s(1)
  nrow=s(2)
  b='P5 '+squeeze(ncol)+' '+squeeze(nrow)+' '+squeeze(maxa)+' '
  writeu,3,b
  if maxa le 255 then writeu,3,byte(a)
  if maxa gt 255 then writeu,3,fix (a)
  end
;----------------------------------------------------------------------
  pro PickZoom,icol1,irow1,icol2,irow2,icol1old,icol2old,irow1old,irow2old, $
   ncol,nrow,factor,ys2,jsize,xoff,yoff,iClearScreen,nwrite,idev
;Written by Mitchell R Grunes.
  polyfill,[0,320,320,0],[ys2+1,ys2+1,ys2+42,ys2+42],color=0,/device
  xyout2,5,ys2+2,'Select one corner.',jsize,nwrite,0,idev
  cursor2,icol1,irow1,-1,ibutton,jbutton,idev,1
  xyout2,150,ys2+2,'; Opposite corner.',jsize,nwrite,0,idev
  cursor2,icol2,irow2,-1,ibutton,jbutton,idev,1
  if icol1 ne icol2 and irow1 ne irow2 then begin
    icol1=icol1old  +fix(float(icol1-xoff)/factor+.5)
    icol2=icol1old  +fix(float(icol2-xoff)/factor+.5)
    irow1=irow2old-1-fix(float(irow1-yoff)/factor+.5)
    irow2=irow2old-1-fix(float(irow2-yoff)/factor+.5)
  endif else begin
    icol1=icol1old
    icol2=icol2old
    irow1=irow1old
    irow2=irow2old
  endelse
  if icol1 gt icol2 then begin
    swap=icol1
    col1=icol2
    icol2=swap
  endif
  if irow1 gt irow2 then begin
    swap=irow1
    irow1=irow2
    irow2=swap
  endif
  iClearScreen=1
  end
;----------------------------------------------------------------------
  pro InZoom,icol1,icol2,irow1,irow2,xs2,ys2,factor,dx,dy,centerx,centery, $
   iClearScreen
;Written by Mitchell R Grunes.
  if factor ge 1 then begin
    factor=fix( (factor+1) > (factor*1.1) )
  endif else begin
    factor=fix(1./factor+.5)
    factor=fix( (factor-1) < (factor*.9) )
    if factor eq 0 then factor=.5
    factor=1./factor
  endelse
  dx=fix((xs2/float(factor)-1)*.5-.01)
  dy=fix((ys2/float(factor)-1)*.5-.01)
  icol1=fix(centerx-dx)
  icol2=fix(centerx+dx)
  irow1=fix(centery-dy)
  irow2=fix(centery+dy)
  iClearScreen=1
  end
;----------------------------------------------------------------------
  pro OutZoom,icol1,icol2,irow1,irow2,xs2,ys2,factor,dx,dy,centerx,centery, $
   iClearScreen
;Written by Mitchell R Grunes.
  if factor gt 1 then begin
    factor=fix( (factor-1) < (factor*.8) )
  endif else begin
    factor=fix(1./factor+.5)
    factor=fix( (factor+1) > (factor*1.25) )
    if factor eq 0 then factor=1
    factor=1./factor
  endelse
  dx=fix((xs2/float(factor)-1)*.5+.01)
  dy=fix((ys2/float(factor)-1)*.5+.01)
  if fix(xs2/(2*dx+1)) gt factor then dx=dx+1
  if fix(ys2/(2*dy+1)) gt factor then dy=dy+1
  icol1=fix(centerx-dx)
  icol2=fix(centerx+dx)
  irow1=fix(centery-dy)
  irow2=fix(centery+dy)
  iClearScreen=1
  end
;----------------------------------------------------------------------
  pro ShowError,idev,a,b,aa,bb,icol1,icol2,irow1,irow2,xsz,ysz,isamp, $
    xs2,ys2,jsize,nwrite
					;Show error between original and
					; reconstructed images.
;Written by Mitchell R Grunes.
  ClearScreen,idev
  aa=a(icol1:icol2,irow1:irow2)
  bb=b(icol1:icol2,irow1:irow2)
  npixc=icol2-icol1+1
  npixr=irow2-irow1+1
  npix=double(npixc)*npixr
  MSa=total(double(aa)^2)/npix
  aa=long(aa)-bb
  MSe=total(double(aa)^2)/npix
  NMSe=MSe/MSa
  RMSe=sqrt(MSe)
  SNratio=-10*alog10(NMSe)
  print,'RMSE,NMSE,S/N=',RMSe,NMSe,SNratio
  bb=rebin(aa,xsz,ysz,sample=isamp)
  if idev lt 98 then tvscl,bb                   ;Difference Image
  if idev eq 98 then surface,bb
  xyout2,xs2/2-12,ys2-15,'Difference Image--Hit Mouse',jsize,nwrite,0,idev
  cursor2,x,y,-1,ibutton,jbutton,idev,1
  ClearScreen,idev
  if idev lt 98 then tvscl,abs(bb)              ;Absolute Difference Image
  if idev eq 98 then surface,abs(bb)
  xyout2,xs2/2-12,ys2-15,'Absolute Difference',jsize,nwrite,0,idev
  cursor2,x,y,-1,ibutton,jbutton,idev,1
  ClearScreen,idev
  xyout2,xs2/2-50,ys2-15,'Please Wait for Histogram',jsize,nwrite,0,idev
  Beep,1
  aalo=min(aa)
  aahi=max(aa)
  if aalo gt -45 then aalo=-45
  if aahi lt  45 then aahi= 45
  aaval=indgen(aahi-aalo+1)+aalo
  cnt =lonarr(aahi-aalo+1)
  for j=0,npixr-1 do begin
  for i=0,npixc-1 do begin
    k=aa(i,j)-aalo
    cnt(k)=cnt(k)+1
  endfor
  endfor
  plot,aaval,cnt,title='RMS='+squeeze(RMSe)+'   NMSE='+squeeze(NMSe) $
   +'    S/N='+squeeze(SNratio)+' dB'
  cursor2,x,y,-1,ibutton,jbutton,idev,1
  plot,aaval(-aalo-45:-aalo+45),cnt(-aalo-45:-aalo+45)
  cursor2,x,y,-1,ibutton,jbutton,idev,1
  plot,aaval(-aalo-20:-aalo+20),cnt(-aalo-20:-aalo+20)
  cursor2,x,y,-1,ibutton,jbutton,idev,1
  plot,aaval(-aalo-10:-aalo+10),cnt(-aalo-10:-aalo+10)
  cursor2,x,y,-1,ibutton,jbutton,idev,1
  ClearScreen,idev
  end
;----------------------------------------------------------------------
;======================================================================
  MainComment
;Written by Mitchell R Grunes.
  AskDevice,idev1,idev,xsKeep,ysKeep,jsize,nwrite,xscrn,yscrn
  SetDev,idev,xsKeep,ysKeep,xo,yo,leftm,rightm,topm,botm
  CanFlickWin=0                         ;Not all window systems let you flicker
					; between two windows.
					;For example, SGI erases hidden window!
  if idev eq 1 or idev eq 2 then CanFlickWin=1
  demo=0
  oldimage1=' '
  oldimage2=' '
  x=xsKeep-10                           ;initial cursor positions
  y=yskeep-200
  ishow=0                               ;Display images, not diff or ratio
  if idev ne 31 and idev lt 98 then tvcrs,x,y,/device
  MustScale=0
  itransfer=2                           ;B&W Transfer Roll on Tek Phaser IISD
  nimage3=0                             ;# of movie frames written
  moviename=''
Start:
  if idev eq 98 then ShowText,idev
  AskInitial,idev, $
   image1,title1,image2,title2,itype,nheader, $
   ncol,icol1,icol2,nrow,irow1,irow2, $
   ishow,icolor,igeom,isamp,ifull,dmin,dmax, $
   oldimage1,oldimage2,nimage, $
   demo,jsize,icolor2,xsKeep,ysKeep,nwrite,xscrn,yscrn
  iClearScreen=1
  if image1 le ' ' then goto,Last
  if image1 eq 'Grey Scale Test' then oldimage1=' '
 
ReDisplay:
  nimage=1
  if image2 gt ' ' then nimage=2
  if image1 ne oldimage1 then ReadImage,image1,a,ncol,nrow,itype,nheader, $
   igeom,title2
  oldimage1=image1
  if icol1 lt 0 then icol1=0
  if icol2 le icol1 or icol2 gt ncol-1 then icol2=ncol-1
  if irow1 lt 0 then irow1=0
  if irow2 le irow1 or irow2 gt nrow-1 then irow2=nrow-1
 
  if nimage gt 1 and image2 ne oldimage2 then $
    ReadImage,image2,b,ncol,nrow,itype,nheader,igeom,title2
  if nimage gt 1 and image2 ne oldimage2 then oldimage2=image2
  ShowWin,idev,0
  if icol1 gt icol2 or irow1 gt irow2 then begin      ;should not happen
    Beep,3
    icol1=icol1old
    icol2=icol2old
    irow1=irow1old
    irow2=irow2old
  endif
  n=icol2-icol1+1
  m=irow2-irow1+1
  xs=xsKeep                             ;Full screen window size in screen
  ys=ysKeep                             ; coordinates
 
  if nimage gt 1 and ishow gt 0 then begin
    if ishow eq 1 then $
      aa=float(a(icol1:icol2,irow1:irow2))-float(b(icol1:icol2,irow1:irow2))
    if ishow eq 2 then begin
      aa=  float(a(icol1:icol2,irow1:irow2)) $
	 / float(b(icol1:icol2,irow1:irow2))
    endif
    nimage=1
  endif else if itype ne 50 then begin
    aa=a(icol1:icol2,irow1:irow2)
  endif else begin
    aa=a(icol1:icol2,irow1:irow2,0:fix(title2)-1)
  endelse
 
  if dmin eq dmax or MustScale then $
   autoscale,aa,dmin,dmax,idev,icolor,xscrn,yscrn ;scale image(s)
  MustScale=0
  if dmin eq long(dmin) and dmax eq long(dmax) or $
   (itype ne 4 and itype ne 7 and itype ne 8) then begin
    dmin=long(dmin)
    dmax=long(dmax)
    if dmin ge -32768 and dmin le 32767L then dmin=fix(dmin)
    if dmax ge -32768 and dmax le 32767L then dmax=fix(dmax)
  endif
  if dmin le dmax and idev ne 98 then aa=bytscl(aa,min=dmin,max=dmax)
  if dmin gt dmax and idev ne 98 then aa=255-bytscl(aa,min=dmax,max=dmin)
  if idev eq 98 then aa=dmin > (dmax < aa)
  if !d.n_colors lt 256 and idev ne 98 then aa=byte(aa*!d.n_colors/256)
 
  if nimage gt 1 then begin
    bb=b(icol1:icol2,irow1:irow2)
    if dmin le dmax and idev ne 98 then bb=bytscl(bb,min=dmin,max=dmax)
    if dmin gt dmax and idev ne 98 then bb=255-bytscl(bb,min=dmax,max=dmin)
    if idev eq 98 then aa=dmin > (dmax < bb)
    if !d.n_colors lt 256 and idev ne 98 then bb=byte(bb*!d.n_colors/256)
  endif
 
RePrint:
  if idev eq 99 or idev eq 99.5 then $
   SetDev,idev,xsKeep,ysKeep,xo,yo,leftm,rightm,topm, $
   botm,nimage,nimage2,nimagex,spacex,spacey,greywid,nline,ls,itransfer
 
  xs2=xsKeep                            ;xs,ys in device coordinates
  ys2=ysKeep
  if idev eq 99 then xs2=!d.x_vsize
  if idev eq 99 then ys2=!d.y_vsize
  xs2orig=xs2
  ys2orig=ys2
  !x.s=[0,1./xs2]                       ;so data and screen device coord match
  !y.s=[0,1./ys2]
 
  if idev eq 99 then begin              ;PostScript
    nimagey=fix(nimage2/float(nimagex)+.99)
    spacex=fix(spacex*2540)
    spacey=fix(spacey*2540)
    greywid=fix(greywid*2540)
    if greywid gt 0 then xs2=xs2-spacex-greywid
    xs2=xs2-leftm-rightm-(nimagex-1)*spacex
    ys2=ys2-topm -botm  -(nimagey-1)*spacey
    xs2=xs2/nimagex                     ;space/image
    ys2=ys2/nimagey
    ys2=ys2-nline*jsize*375             ;space for text
  endif else begin                      ;Not PostScript
    greywid=53                          ;leave space for grey scale
    if ifull eq 0 then begin
      if idev lt 100 then xs2=xs2-greywid
      if idev lt 100 then ys2=ys2-4-19*2
    endif else begin
      ys2=ys2-30
    endelse
  endelse
 
  xs2=fix(xs2)
  ys2=fix(ys2)
  factor=fix((xs2/n) < (ys2/m))         ;display image as large as can
  xsz=n*factor
  ysz=m*factor
  if factor lt 1 then begin             ;Too small--must enlarge image
    factor=fix((n+xs2-1)/xs2 > (m+ys2-1)/ys2)
    xsz=fix(n/factor)
    ysz=fix(m/factor)
    if ( (xsz*factor ne n) or (ysz*factor ne m) ) then begin
      aa=aa(0:xsz*factor-1,0:ysz*factor-1)
      if nimage gt 1 then bb=bb(0:xsz*factor-1,0:ysz*factor-1)
    endif
    factor=1.d0/factor
  endif
 
  ShowWin,idev,0
  if idev ne 99 and (idev ne 98 or factor lt 1) and factor ne 1 $
   and itype eq 50 then aa=rebin(aa,xsz,ysz,fix(title2),sample=isamp)
  if idev ne 99 and (idev ne 98 or factor lt 1) and factor ne 1 $
   and itype ne 50 then aa=rebin(aa,xsz,ysz,sample=isamp)
  if idev ne 99 and (idev ne 98 or factor lt 1) and factor ne 1 $
   and nimage gt 1 then $
   bb=rebin(bb,xsz,ysz,sample=isamp)
  if idev eq 99 then begin
    totalx=xsz*nimagex+spacex*(nimage-1)
    if greywid gt 0 then totalx=totalx+spacex+greywid
    totaly=(ysz+nline*jsize*375)*nimagey+spacey*(nimagey-1)
    leftpos=xo+(xs2orig-totalx)/2.+(leftm-(rightm+greywid))/2 ;Left and bottom
							      ; positions
    botpos =yo+(ys2orig-totaly)/2.+((botm+nline*jsize*375)-topm)/2;
  endif
  GreyScale=indgen(256)                 ;Prepare grey scale
  if !d.n_colors lt 256 then GreyScale=byte(GreyScale*!d.n_colors/256)
  GreyScale=reform(GreyScale,1,256)
  if idev eq 99 then begin
    !order=1                            ;probably first row on top
    print,' '
    print,'Displaying Cols',icol1,icol2,' Rows',irow1,irow2
    TrueCol=icolor
    if nline gt 0 then t=strarr(nline) else t=strarr(1)
    ifactor=1
    for ij=1,nimage2 do begin
      print,' '
      PrintMenu2,ij,TrueCol,nband,nimage2,image1,image2,image3,title1,title2, $
       nline,t,ifactor,dmin,dmax,itransfer,idev
      if TrueCol eq 13 then bb=bytarr(n*ifactor,m*ifactor,3)
      j=fix((ij-1)/nimagex)
      i=(ij-1)-j*nimagex
      j=nimagey-1-j
      leftpos2=leftpos+i*(xsz+spacex)
      botpos2=botpos+j*(ysz+nline*jsize*375+spacey)
      for L=1,nband do begin
	if image3(L-1) gt ' ' then begin
	  if image3(L-1) eq image1 then begin
	    aa=a(icol1:icol2,irow1:irow2)
	    if ishow eq 1 then $
	      aa=float(a(icol1:icol2,irow1:irow2)) $
	       - float(b(icol1:icol2,irow1:irow2))
	    if ishow eq 2 then begin
	      aa=  float(a(icol1:icol2,irow1:irow2)) $
		 / float(b(icol1:icol2,irow1:irow2))
	    endif
	  endif else if image3(L-1) eq image2 then begin
	    aa=b(icol1:icol2,irow1:irow2)
	  endif else begin
	    ReadImage,image3(L-1),aa,ncol,nrow,itype,nheader, $
	     igeom,title2
	    aa=aa(icol1:icol2,irow1:irow2)
	  endelse
	  if dmin le dmax then aa=bytscl(aa,min=dmin,max=dmax)
	  if dmin gt dmax then aa=255-bytscl(aa,min=dmax,max=dmin)
	  if ifactor gt 1 then aa=rebin(aa,n*ifactor,m*ifactor)
	  if nband eq 1 then begin
	   tv,aa,xsize=xsz,ysize=ysz,fix(leftpos2),fix(botpos2+nline*jsize*375)
	  endif else begin
	    bb(0:n*ifactor-1,0:m*ifactor-1,L-1)=aa
	    if L eq nband then $
	     tv,bb,xsize=xsz,ysize=ysz,fix(leftpos2), $
	      fix(botpos2+nline*jsize*375),true=3
	  endelse
	endif
      endfor
      nwrite2=3
      if itransfer eq 5 then nwrite2=4.5;Because psrender (postscript to
					; pixel converter) makes text a
					; little thin.
      for L=1,nline do xyout2,fix(leftpos2)+xsz/2,$
       fix(botpos2+(nline-L)*jsize*375), t(L-1),jsize*1.5,nwrite2,.5,idev
    endfor
    !order=0
    if greywid gt 0 then $
     tv,GreyScale,xsize=greywid,ysize=ysz,fix(leftpos+nimagex*(xsz+spacex)), $
      fix(botpos2+nline*jsize*375)
    idev=99.5
    print,'Overprint anything else onto this sheet (0=no):'
    read,i
    if i ne 0 then goto,RePrint
    ClosePS
    idev=idev1
    iClearScreen=1
    SetDev,idev,xsKeep,ysKeep,xo,yo,leftm,rightm,topm,botm
    goto,ReDisplay
  endif
  iShown=0                              ;Images not shown yet
  GreyScale=rebin(GreyScale,10,256)
  if ys2+28-19*10 lt 256 then GreyScale=rebin(GreyScale,10,128)
NoChange:
  ShowWin,idev,0
  iShownB=0                             ;Buttons not shown yet
  ImNum=0
  if idev lt 98 then MyColor,icolor,0,xscrn,yscrn
  if idev ge 10 and idev lt 30 and icolor gt 0 and icolor lt 16 then $
   iClearScreen=1
flicker:
  if iClearScreen then begin
    ClearScreen,idev
    iShown=0
    iShownB=0
  endif
  iClearScreen=0
  oldtime=-1
  if nimage gt 1 then oldtime=systime(1)
  if CanFlickWin then ShowWin,idev,ImNum
  if iShown eq 0 then begin
    !order=1
    xoff=fix(xs2-xsz)/2
    yoff=fix(ys2-ysz)/2
    if itype eq 50 then xoff=0
    if itype eq 50 then yoff=0
    if ImNum eq 0 and idev lt 98 and itype ne 50 then tv,aa,xoff,yoff
    if ImNum eq 0 and idev lt 98 and itype eq 50 then movie,aa,.5
    if ImNum eq 0 and idev lt 98 and itype eq 50 then iClearScreen=1
    if ImNum eq 0 and idev eq 98 then surface,aa
    if ImNum eq 0 and idev eq 100 then print,aa
    if ImNum eq 1 and idev lt 98 then tv,bb,xoff,yoff
    if ImNum eq 1 and idev eq 98 then surface,bb
    if ImNum eq 1 and idev eq 100 then print,bb
    if xoff gt 0 and yoff gt 0 and idev lt 98 then $
     plots,xoff+[-1,-1,xsz,xsz,-1],yoff+[-1,ysz,ysz,-1,-1]   ;draw frame
    if nimage eq ImNum+1 and (nimage eq 1 or CanFlickWin) and itype ne 50 then $
     iShown=1
  endif
  cursor2,x,y,-2,ibutton,jbutton,idev,1
  if (x ge 0 and y ge 0) or jbutton ne 0 then goto,FoundCursor
  if iShownB eq 0 then begin
    if idev lt 99 then $
     polyfill,[0,xs2-236,xs2-236,0],[ys2+1,ys2+1,ysKeep,ysKeep],color=0,/device
    if idev lt 98 then begin
      !order=0
      if ifull eq 0 then tv,GreyScale,xs2+26,1
      if ys2+28-19*10 ge 256 then plots,xs2+[25,36,36,25,25],[0,0,257,257,0]
      if ys2+28-19*10 lt 256 then plots,xs2+[25,36,36,25,25],[0,0,129,129,0]
      cursor2,x,y,-2,ibutton,jbutton,idev,1
      if (x ge 0 and y ge 0) or jbutton ne 0 then goto,FoundCursor
    endif
    if ImNum eq 0 and iShownB eq 0 then MakeButton,xs2,ys2,jsize,demo,title1, $
     ifull,nwrite,icolor,idev
    if ImNum eq 1 and iShownB eq 0 then MakeButton,xs2,ys2,jsize,demo,title2, $
     ifull,nwrite,icolor,idev
    if nimage eq ImNum+1 and (nimage eq 1 or CanFlickWin) and itype ne 50 then $
     iShownB=1
  endif
  if nimage gt 1 then ImNum=1-ImNum
  cursor2,x,y,oldtime,ibutton,jbutton,idev,1
  if (x lt 0 or y lt 0) and jbutton eq 0 and ifull eq 0 then goto,flicker
FoundCursor:
  dx=fix((icol2-icol1)*.9)
  dy=fix((irow2-irow1)*.9)
  dx10=fix(dx/10)
  dy10=fix(dy/10)
  if dx  lt 1 then dx=1
  if dy  lt 1 then dy=1
  if dx10 lt 1 then dx10=1
  if dy10 lt 1 then dy10=1
  centerx=(icol1+icol2)/2.
  centery=(irow1+irow2)/2.
  icol1old=icol1
  icol2old=icol2
  irow1old=irow1
  irow2old=irow2
  if ButtonRd(x,y,xs2+27-53*5,ys2+28,ibutton,jbutton,idev) then begin ;Zoom
    PickZoom,icol1,irow1,icol2,irow2,icol1old,icol2old,irow1old,irow2old, $
     ncol,nrow,factor,ys2,jsize,xoff,yoff,iClearScreen,nwrite,idev
  endif else if ButtonRd(x,y,xs2+27-53*5,ys2+28-19,ibutton,jbutton,idev) then $
   begin                                        ;Dezoom
    icol1=0
    icol2=ncol-1
    irow1=0
    irow2=nrow-1
    iClearScreen=1
  endif else if ButtonRd(x,y,xs2+27-53*4,ys2+28,ibutton,jbutton,idev) then $
   begin                                        ;in
    InZoom, icol1,icol2,irow1,irow2,xs2,ys2,factor,dx,dy,centerx,centery, $
     iClearScreen
  endif else if ButtonRd(x,y,xs2+27-53*4,ys2+28-19,ibutton,jbutton,idev) then $
   begin                                        ;out
    OutZoom,icol1,icol2,irow1,irow2,xs2,ys2,factor,dx,dy,centerx,centery, $
     iClearScreen
  endif else if ButtonRd(x,y,xs2+27-53*3,ys2+28,ibutton,jbutton,idev) then $
   begin                                        ;left
    icol1=icol1-dx10
    if icol1 lt 0 then dx10=dx10+icol1
    icol2=icol2-dx10
  endif else if ButtonRd(x,y,xs2+27-53*3,ys2+28-19,ibutton,jbutton,idev) then $
   begin                                        ;left+
    icol1=icol1-dx
    if icol1 lt 0 then dx=dx+icol1
    icol2=icol2-dx
						;right
  endif else if ButtonRd(x,y,xs2+27-53*2,ys2+28,ibutton,jbutton,idev) then begin
    icol2=icol2+dx10
    if icol2 ge ncol then dx10=dx10+(ncol-1-icol2)
    icol1=icol1+dx10
  endif else if ButtonRd(x,y,xs2+27-53*2,ys2+28-19,ibutton,jbutton,idev) then $
   begin                                        ;right+
    icol2=icol2+dx
    if icol2 ge ncol then dx=dx+(ncol-1-icol2)
    icol1=icol1+dx
						;up
  endif else if ButtonRd(x,y,xs2+27-53,  ys2+28,ibutton,jbutton,idev) then begin
    irow1=irow1-dy10
    if irow1 lt 0 then dy10=dy10+irow1
    irow2=irow2-dy10
  endif else if ButtonRd(x,y,xs2+27-53,  ys2+28-19,ibutton,jbutton,idev) then $
   begin                                        ;up+
    irow1=irow1-dy
    if irow1 lt 0 then dy=dy+irow1
    irow2=irow2-dy
						;down
  endif else if ButtonRd(x,y,xs2+27,     ys2+28,ibutton,jbutton,idev) then begin
    irow2=irow2+dy10
    if irow2 ge nrow then dy10=dy10+(nrow-1-irow2)
    irow1=irow1+dy10
  endif else if ButtonRd(x,y,xs2+27,     ys2+28-19,ibutton,jbutton,idev) then $
   begin                                        ;down+
    irow2=irow2+dy
    if irow2 ge nrow then dy=dy+(nrow-1-irow2)
    irow1=irow1+dy
  endif else if ButtonRd(x,y,xs2+27,     ys2+28-19*2,ibutton,jbutton,idev) $
   then begin                                   ;Scale
    MustScale=1
  endif else if ButtonRd(x,y,xs2+27,     ys2+28-19*3,ibutton,jbutton,idev) $
   then begin                                   ;Error
    ShowError,idev,a,b,aa,bb,icol1,icol2,irow1,irow2,xsz,ysz,isamp, $
     xs2,ys2,jsize,nwrite
  endif else if ButtonRd(x,y,xs2+27,     ys2+28-19*4,ibutton,jbutton,idev) $
   then begin                                   ;Print
    printmenu3,idev,outform,image1,image2,i
    if outform ne 0 and i eq 1 then $
     ExtractImage,a(icol1:icol2,irow1:irow2),outform,idev,dmin,dmax,nimage3, $
      moviename
    if outform ne 0 and i eq 2 then $
     ExtractImage,b(icol1:icol2,irow1:irow2),outform,idev,dmin,dmax,nimage3, $
      moviename
  endif else if ButtonRd(x,y,xs2+27,     ys2+28-19*5,ibutton,jbutton,idev) $
   then begin                                   ;Fast
    isamp=1
  endif else if ButtonRd(x,y,xs2+27,     ys2+28-19*6,ibutton,jbutton,idev) $
   then begin                                   ;Slow
    isamp=0
  endif else if ButtonRd(x,y,xs2+27,     ys2+28-19*7,ibutton,jbutton,idev) $
   then begin                                   ;color
    icolor=icolor+1
    if icolor eq 2 then icolor=3        ;Some color schemes are ambiguous
					; or have only 16 colors, or look
					; awful.
    if icolor ge 5 and icolor le 7 then icolor=8
    if icolor eq 9 or icolor eq 10 then icolor=11
    if icolor ge 11 and icolor lt 16 then icolor=16
    goto,NoChange
  endif else if ButtonRd(x,y,xs2+27,     ys2+28-19*8,ibutton,jbutton,idev) $
   then begin                                   ;KeyBd
   KeyMenu,idev,-1, $
    image1,title1,image2,title2,itype,nheader, $
    ncol,icol1,icol2,nrow,irow1,irow2, $
    ishow,icolor,igeom,isamp,ifull,dmin,dmax, $
    demo,oldimage1,oldimage2,nimage,nimage3,moviename
    iClearScreen=1
  endif else if ButtonRd(x,y,xs2+27,     ys2+28-19*9,ibutton,jbutton,idev) $
   then begin                                   ;Exit
    demo=0
    if igeom ne 0 then oldimage1=''
    if igeom ne 0 then oldimage2=''
    goto,Start
  endif else if ButtonRd(x,y,xs2+27,ys2+28-19*11,ibutton,jbutton,idev) $
   or ifull ne 0 then begin
    if demo eq 0 then begin                    ;full
      ifull=1-ifull
      iClearScreen=1
    endif else if demo eq 1 then begin         ;Next
      if icolor2 ge 0 and icolor2 ne icolor then begin
	icolor=icolor2
	icolor2=-1
	goto,NoChange
      endif
      goto,Start
    endif else if demo eq 2 then begin
     KeyMenu,idev,19, $
      image1,title1,image2,title2,itype,nheader, $
      ncol,icol1,icol2,nrow,irow1,irow2, $
      ishow,icolor,igeom,isamp,ifull,dmin,dmax, $
      demo,oldimage1,oldimage2,nimage,nimage3,moviename
      iClearScreen=1
    endif
  endif else if demo eq 0 and ifull ne 0 then begin
    ifull=1-ifull
    iClearScreen=1
  endif else begin
    Beep,3
    ImNum=0
    goto,NoChange
  endelse
  goto,ReDisplay
Last:
  ShowText,idev
  if idev lt 10 or idev eq 30 then wdelete,0
  if idev lt 10 or idev eq 30 then wdelete,1
  end