############################################################################
#
#	File:	  fev.icn
# 
#	Subject:  Program to display text in fisheye view
# 
#	Author:   Clinton L. Jeffery
#
#	Date:	  June 17, 1994
# 
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#     A text file browser that employs a fish-eye view.  The
# fish-eye view displays text in a larger font in the middle (focus)
# gradually declining to tiny fonts at the top and bottom of the screen.
#
#     "q" or ESC to quit.  "n" slides the focus down one line
# "p" slides the focus up one line.  "w" widens the focus by one.
# "W" narrows the focus by one.  Mouse clicks move the focus to the line
# on which the mouse is located; clicking in the left margin moves
# in the file proportional to the mouse's y coordinate in the window.
#
############################################################################
#
#     Requires:  Version 9 graphics with X11R5 scalable fonts on the X server
#
############################################################################
#
#  Links: wopen, xcompat
#
############################################################################

link wopen
link xcompat

procedure main(av)
   local slope, fin, win, L, ht, focus, focuswidth, e, base
   slope := 2
   if av[1] == "-s" then slope := (pop(av), pop(av))
   fin := open(av[1]) | stop("no file")
   win := WOpen("label=" || av[1], "height=860") | stop("no window")
   L := []
   every put(L,!fin)
   write(*L," lines")
   ht := 23
   focus := *L/2
   focuswidth := 1
   fisheye(win,L,focus,ht,slope,,,focuswidth)
   repeat {
      e := Event(win)
      case e of {
	 "q"|"\e": exit(0)
	 "n" : focus := *L >= focus+1
	 "p" : focus := 1 <= focus - 1
	 "w" : focuswidth +:= 1
	 "W" : (1 < focuswidth) -:= 1
	 &lpress|&ldrag|&mpress|&mdrag|&rpress|&rdrag: {
	    if &x < 17 then {
	       focus := *L * &y / WAttrib(win,"height")
	       }
	    else {
	       base := WAttrib(win,"height") / 2
	       focus := moveFocusToMouse(win,L,focus,base,ht,slope,focuswidth)
	       }
	    }
	 default : next
	 }
      fisheye(win,L,focus,ht,slope,,,focuswidth)
      }
end

procedure fisheye(w,L,focus,maxht,slope,family,weight,focuswidth)
   static fonttable
   local past_end, i, splt
   initial {
      fonttable := table()
      }
   /focuswidth := 1
   /family := "helvetica"
   /weight := "bold"

   /fonttable[w] := []

   past_end := *fonttable[w] + 1
   every i := past_end to maxht do {
      put(fonttable[w], 
	  XBind(w,"font=-adobe-"||family||"-"||weight||
		"-r-normal--"||i||"-*-*-*-*-*-*-*") | stop("no XBind"))
      }
   EraseArea(w)
   splt := WAttrib(w,"height") / 2
   viewtop(fonttable[w],L,focus,splt,maxht,slope,focuswidth)
   viewbottom(fonttable[w],L,focus+1,splt+maxht,maxht-slope,slope,focuswidth)
   FillRectangle(w,0,(focus * WAttrib(w,"height") / *L)-WAttrib(w,"ascent"),
		  16,WAttrib(w,"fheight"))
   DrawLine(w,17,0,17,WAttrib(w,"height") * focuswidth)

end

procedure viewtop(w,L,focus,base,ht,slope,focuswidth)
   local wh
   wh := WAttrib(w[1],"height") | stop("no WAttrib")
   while focus >= 1 & base >= 1 do {
      if ht < 1 then ht := 1
      GotoXY(w[1],20,base)

      writes(w[ht],L[focus])
      base -:= ht
      if focus > 1 & base / focus < ht & focuswidth <= 1 then
	 ht -:= slope
      focuswidth -:= 1
      focus -:= 1
      }
   if focus < 1 then return 1
   return focus
end

procedure viewbottom(w,L,focus,base,ht,slope,focuswidth)
   local wh
   wh := WAttrib(w[1],"height") | stop("no WAttrib")
   while focus <= *L & base <= wh do {
      if ht < 1 then ht := 1
      GotoXY(w[1],20,base)

      writes(w[ht],L[focus])
      base +:= ht
      if focus < *L & (wh - base) / (*L - focus) < ht & focuswidth <= 1 then
	 ht -:= slope
      focuswidth -:= 1
      focus +:= 1
      }
   if focus > *L then return *L
   return focus
end

procedure moveFocusToMouse(w,L,focus,base,ht,slope,focuswidth)
   local wh, fh
   wh := WAttrib(w,"height") | stop("no WAttrib")
   fh := WAttrib(w,"ascent") | stop("no WAttrib")
   if &y < base then {
      while focus >= 1 & base-fh >= &y do {
	 if ht < 1 then ht := 1
	 base -:= ht
	 if focus > 1 & base / focus < ht & focuswidth <= 1 then
	    ht -:= slope
	 focuswidth -:= 1
	 focus -:= 1
	 }
      }
   else {
      focus +:= 1
      base +:= ht
      ht -:= slope
      while focus <= *L & base <= &y do {
	 if ht < 1 then ht := 1
	 base +:= ht
	 if focus < *L & (wh - base) / (*L - focus) < ht & focuswidth <= 1 then
	    ht -:= slope
	 focuswidth -:= 1
	 focus +:= 1
	 }
      }
   if focus < 1 then return 1
   if focus > *L then return *L
   return focus
end