! @(#)showfonts.prg	17.1.1.1 (ESO-DMD) 01/25/02 17:12:30
! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
!  MIDAS procedure showfonts.prg
!  to show the Fonts for LABEL/DISPLAY and their No's.
!  K. Banse  ESO        960315, 970404, 980714
!
!  use via   @a showfonts  font_select  option  show  own_str
!
!  with font_select = first_font_no.,max_no[,pattern] 
!                     or ALL[,pattern] to show all fonts
!                     if pattern is not omitted, only the Fonts with names
!                     containing the pattern are selected
!                     defaulted to 1,200
! 
!       option = NEW - create new ASCII file $MID_SYSTAB/x11fonts.dat + use it
!                OWN - create new ASCII file $MID_WORK/x11fonts.dat + use it
!                else use the existing $MID_WORK/x11fonts.dat or if there is no
!                     such file, use existing $MID_SYSTAB/x11fonts.dat
!                x11fonts.dat contains all available fonts on the current
!                             X-server, each record has the form:
!                             (sequential FontNo): FontName
! 
!       show = 2 char. flag, (Y/N) for displaying selected Fonts and 
!                                  for writing the selected Font name
!              defaulted to YN (display Font, but do not type it's name)
!
!       own_str = optional string to use instead of canned text
! 
!  the no. of selected fonts is stored in keyword OUTPUTI(15)
! 
!  The first time this procedure is executed it should be run with 
!  the 2. parameter = NEW to create a new file $MID_SYSTAB/x11fonts.dat 
!  (this must be done by the someone with the privileges to update Midas 
!   system files).
!  Otherwise you'll use the x11fonts.dat created previously at ESO on a Solaris
!  machine which may contain fonts not installed on your local host.
!  
! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
! 
define/param p1 1,200 c "Enter first,last font no.:"
define/param p2 SYS c "Enter option, (NEW or OLD):"
define/param p3 YN c "Enter show_flags, (Y/N):"
define/param p4 + c "Enter string to be displayed in all selected fonts:"
! 
define/local fontno/i/1/2 1,200
define/local pattern/c/1/60 " " all
define/local kk/i/1/2 0,0
define/local norec/i/1/2 0,0
! 
pattern(1:1) = "?"
outputi(15) = -1
! 
if p1(1:3) .eq. "ALL" then
   write/keyw fontno 1,3000
   kk = m$index(p1,",") + 1
   if kk .gt. 1 pattern = p1({kk}:)
else
   kk = m$index(p1,",")
   if kk .lt. 2 then
      write/out "invalid font_select => use default: 1,200"
   else
      kk(2) = kk + 1
      kk = m$index(p1({kk(2)}:),",")
      if kk .gt. 0 then
         kk = kk(2) + kk - 1
         p1({kk}:{kk}) = " "
         kk = kk + 1
         pattern = p1({kk}:)
         kk = kk - 1
         write/keyw fontno {p1(1:{kk})}
      else
         write/keyw fontno {p1}
      endif
   endif
endif
! 
define/local maxfont/i/1/1 0
define/local fck/i/1/2 0,0
! 
define/local x11file/c/1/40 "MID_WORK:x11fonts.dat   "
if p2(1:1) .ne. "S" then
   write/out "first we create file" x11fonts.dat in current directory

   if aux_mode(1) .le. 1 then              ! VMS
      $ RUN SYS_EXE:fontsup
      if p2(1:1) .eq. "N" then
         $ COPY x11fonts.dat MID_DISK:[&MIDASHOME.&MIDVERS.SYSTAB.BIN]
      else
         $ COPY x11fonts.dat MID_WORK:
      endif
   else                                    ! UNIX
      $ $SYS_EXE/fontsup.exe
      if p2(1:1) .eq. "N" then
         $ cp x11fonts.dat $MID_SYSTAB
      else
         $ cp x11fonts.dat $MID_WORK
      endif
   endif
endif
! 
open/file {x11file} read fck
if fck .lt. 1 then
   write/keyw x11file "MID_SYSTAB:x11fonts.dat   "
   open/file {x11file} read fck
   if fck .lt. 1 then
      write/out "Could not open {x11file} ..."
      return
   endif
endif
! 
if pattern(1:1) .ne. "?" then
  readloop1:
   read/file {fck(1)} in_a 80
   if {fck(2)} .ne. -1 then
      norec = norec + 1
      if norec .lt. fontno(1) goto readloop1
 
      if m$index(in_a,pattern) .gt. 0 maxfont = maxfont+1
      if maxfont .lt. fontno(2) goto readloop1
   endif
else
  readloop2:
   read/file {fck(1)} in_a 20
   if {fck(2)} .ne. -1 then
      norec = norec + 1
      if norec .lt. fontno(1) goto readloop2
 
      maxfont = maxfont+1
      if maxfont .lt. fontno(2) goto readloop2
   endif
endif
close/file {fck}			!that also rewinds it
! 
set/format i1
write/out "No. of selected fonts = {maxfont}"
outputi(15) = maxfont
if p3 .eq. "NN" .or. maxfont .lt. 1 return
! 
if p3(1:1) .eq. "Y" then
   create/display 8 512,800,512,0 ? no >Null
   clear/chan ov
endif
! 
if maxfont .gt. 999 then
   set/format i4
else
   set/format i3
endif
! 
! now loop again to show the selected fonts
! 
define/local line/i/1/1 5
define/local str/char*40/1/4 " " all
if p4(1:1) .ne. "+" then
   norec = pcount(5)
   kk = 1
   if p4(1:1) .eq. """ then
      if  p4({norec}:{norec}) .eq. """ then
         kk = 2
         norec = norec - 1
      endif
   endif
   if norec .le. 40 then
      write/keyw str/char*40/1/1 "{p4({kk}:{norec})}"
      write/keyw str/char*40/2/1 "{p4({kk}:{norec})}"
      write/keyw str/char*40/3/1 "{p4({kk}:{norec})}"
      write/keyw str/char*40/4/1 "{p4({kk}:{norec})}"
   else
      write/keyw str/char*40/1/1 "{p4({kk}:40)}"
      write/keyw str/char*40/2/1 "{p4(41:{norec})}"
      write/keyw str/char*40/3/1 "{p4({kk}:40)}"
      write/keyw str/char*40/4/1 "{p4(41:{norec})}"
   endif
else
   write/keyw str/char*40/1/1 "It never rains in Paranal " 
   write/keyw str/char*40/2/1 "Il ne pleut jamais a Paranal "
   write/keyw str/char*40/3/1 "Nunca llueve en Paranal "
   write/keyw str/char*40/4/1 "Es regnet nie in Paranal "
endif
kk = 1
! 
open/file {x11file} read fck
norec = 0
   
readloop3:
read/file {fck(1)} in_a 80
norec = norec + 1
if norec .lt. fontno(1) then
   goto readloop3
else
   norec(2) = 0
   goto next_step
endif
! 
readloop4:
read/file {fck(1)} in_a 80
if {fck(2)} .eq. -1 goto end_of_loop
! 
norec = norec + 1
! 
next_step:
if pattern(1:1) .ne. "?" .and. m$index(in_a,pattern) .le. 0 goto readloop4
 
   norec(2) = norec(2) + 1
   if norec(2) .gt. maxfont goto end_of_loop
    
   if p3(1:1) .ne. "N" then
   label/display "({norec}) {str({kk})}" {line},5 ? ? -{norec}
     
   kk = kk+1
   if kk .gt. 4 kk = 1
     
   line = line+25
   if line .gt. 780 then
      wait/secs 5
      clear/chan over
      line = 1
   endif
endif
! 
if p3(2:2) .ne. "N" then
   write/out {in_a(1:>)}
endif
goto readloop4
! 
end_of_loop:
close/file {fck}
outputi(15) = maxfont