Shareware Overload/ShartewareOverload.cdr/busi/smiiutil.zip/TEXTVIEW.PF2

Text File | 1990-01-10 | 8KB | 278 lines

'*****************************************************************************
'       FILENAME:   TEXTVIEW.PF2
'
'     Programmer:   Pierce D. Nunley
'        Updated:   A.M.  1/05/90
'
'          Notes:   Written in PDL (Informix, SmartWare II, Ver. 1.01)
'
'    Description:   This a text viewer that I threw together.  Its only
'                   use is within a Project when you want to allow the user
'                   to view, but not edit, a file (e.g. help files, and
'                   text file reports, etc).  I have not cleaned up the code,
'                   and there are plenty of places to make modifications.
'                   I recommend using this as a function in which it is fed
'                   $filename (the filename to be read) and $title (the title
'                   that appears on line 1 of the screen).  e.g. the call
'                   would be "texview($filename,$title)"
'
'                   Play with it and enjoy.  If you use it, or any significant
'                   part of it, for any commercial applications, I would
'                   appreciate some reimbursement for my efforts.   This may
'                   seem like easy code, but it took quite a long time to get
'                   the bugs out.
'
'****************************************************************************
' Copyright Notice
' Copyright (c) January 1, 1989    Pierce Nunley Consulting
' 3921 Bell Ave.
' Kansas City, Missouri  64111
'****************************************************************************
public $text[3000], $limit, $line, $pos, $lastline, $q, $filename, $title
public $goto, $searchtxt, $searchpos
public $wrap, $tick
public goto(0), search()
public $path,$files,$select
lock module $line

$searchtxt=null
'---------------------------------------------------------------------------
  'the following is just a way of getting a file name into $filename.  It
  'puts all *.txt files in the current directory into a menu which they can
  'be selected from.
  $path = path(datapath)
  $files = getfnames("*.txt",1)
  screen clear box 4 9 21 71 12 1  'print a blue box with red border
  screen print 21 11 14 1 " Path = "|$path|" "  'print the path on the box
  if len($files) < 3 ' check for no project files in directory
    beep
    screen print 11 10 12 1 format "M60" "There are no ""*.txt"" files in this directory"
    inchar
    exit
  end if
  screen menu 5 10   20 70   15 1   1 15   1   $files $select
  if $select = 0   'checks for ESC out of menu
    exit 'quit project
  end if
  $filename = group($files,$select) 'convert the menu number to the file name
  $title=upper($filename)
'---------------------------------------------------------------------------


screen clear box 1 1 scrheight 80 15 0
screen clear box 2 1 scrheight-1 80 15 0 no-border
screen print 1 39-(len($title)/2) 14 0 " "|$title|" "
screen print scrheight 24 15 0 "F3=Find  F4=Goto  F8=Wrap/Unwrap"
screen print scrheight/2 1 15 0 format "M80" "Reading """|upper($filename)|""" into Text Viewer"

$wrap="No Wrap"
$limit=3000

'---------------------------------
label readtext
'---------------------------------
fopen $filename as 1
error on
for $line = 1 to $limit

  if nextkey = keyvalue("Esc")  'allow an exit
    stop
  end if

  'the following is a ticker in case it takes a while to load a file
  $tick= val(mid(str(fixed(now,7)),11))
  if $tick < 1000/8
    $tick="|"
  elseif $tick < 2*(1000/8)
    $tick="/"
  elseif $tick < 3*(1000/8)
    $tick="-"
  elseif $tick < 4*(1000/8)
    $tick= "\"
  elseif $tick < 5*(1000/8)
    $tick="|"
  elseif $tick < 6*(1000/8)
    $tick="/"
  elseif $tick < 7*(1000/8)
    $tick="-"
  else
    $tick= "\"
  end if
  screen print (scrheight/2)+1 1 15 0 format "M80" $tick

  'check memory and rediminsion if necessary.  truncate if necessary.
  if memleft < 2500
    beep
    if $line < $limit-500
      beep 2
      $limit=$limit-500
      redimension $text[$limit]
      error off 'turn off beep for "filename already open"
      fseek 1 0
      jump readtext
    else
      exit for 'just display the lines that we have enough memory for
    end if
  end if

  fread 1 into $text[$line]

  if $wrap="Wrap"
    while len($text[$line]) > 80
      $line=$line+1
      if $line>10000
        exit while
      end if
      $text[$line]=mid($text[$line-1],81)
    end while
  end if

  if eof(1)=1
    exit for
  end if

end for

fclose 1

$lastline=$line-1
if $lastline=0
  beep 2
  screen print scrheight/2 1 15 0 format "M80" "File contains no data, Hit any key to Exit."
  inchar
  exit
end if
$pos=1


while 1 <> 2  'keep the loop going until 'exit' has been issued
  for $line = 2 to scrheight-1
    if len($text[$pos])<=80
      screen print $line 1 15 0 format "L80" $text[$pos]
      if $pos=$searchpos
        screen print $line find($searchtxt,$text[$pos],0)+1 0 15 $searchtxt
      end if
    else
      screen print $line 1 15 0 left($text[$pos],80)
      if $pos=$searchpos
        screen print $line find($searchtxt,$text[$pos],0)+1 0 15 $searchtxt
      end if
    end if
    $pos=$pos+1

    if $pos>$lastline
      $line=$line+1
      while $line < scrheight
        screen print $line 1 15 0 format "L80" ""
        $line=$line+1
      end while
    end if
  end for

  'the following line will print the % of file that has been scrolled
  screen print scrheight 5 15 0 " "|str( round((($pos-1)/$lastline)*100,0) )|"%  "
  screen print scrheight 70 15 0 format "M9" $wrap
  '--------------------
  label keyentry
  '--------------------
  key name inchar $q
  case lower($q)
  when "home"
    $pos=1
  when "end"
    $pos=$lastline-(scrheight-3)
  when "pgup"
    $pos=$pos-(scrheight-2)*2
  when "pgdn"
    'no change
  when "up"
    $pos=$pos-(scrheight-1)
  when "down"
    $pos=$pos-(scrheight-3)
  when "f4"
    goto()
  when "f3"
    search()
  when "esc"
    exit while
  when "f8"
    if $wrap="Wrap"
      $wrap="No Wrap"
    else
      $wrap="Wrap"
    end if
    jump readtext
  otherwise
    $pos=$pos-(scrheight-2)
    jump keyentry 'use instead of continue while to avoid rewritting screen
  end case

  if $pos<1
    '$pos=$lastline+$pos                       'revolving text
    $pos=1                                    'non-revolving text
'  elseif $pos > $lastline                     'revolving text
  elseif $pos > $lastline-(scrheight-3)       'non-revolving text
    '$pos=$pos-$lastline                       'revolving text
    if scrheight-2 >= $lastline               'non-revolving text
      $pos=1                                  'non-revolving text
    else                                      'non-revolving text
      $pos=$lastline-(scrheight-3)            'non-revolving text
    end if                                    'non-revolving text
  end if

end while

'*******************************************************
function goto()
'*******************************************************
screen clear box 10 20 13 60 15 1
screen print 11 21 15 1 format "M39" "Enter Page Number (1-"|str ( int( ($lastline/(scrheight-2))+1 ) )|")"
screen input 12 39 0 7 3 $goto mask "{#{#{#}}}"

if $goto=null
 $pos=$pos-(scrheight-2)  'screen won't change
 return
end if

$goto=(val($goto)*(scrheight-2))-(scrheight-3)
if $goto > $lastline
  beep
  screen clear box 10 20 13 60 15 1
  screen print 11 21 15 1 format "M39" "Page Number Out of Range"
  screen print 12 21 15 1 format "M39" "Press Any Key to Continue"
  inchar
  $pos=$pos-(scrheight-2)  'screen won't change
  return
end if
$pos=$goto
end function


'*******************************************************
function search()
'*******************************************************
screen clear box 10 20 13 60 15 1
screen print 11 21 15 1 format "M39" "Enter Search Text to Find"
screen input 12 25 0 7 30 $searchtxt $searchtxt

if $searchtxt=null
 $pos=$pos-(scrheight-2)  'screen won't change
 return
end if

$line=$pos-(scrheight-2)
error off
for $pos = $line+1 to $lastline
  clearerror
  find($searchtxt,left($text[$pos],80),0)
  if lerror <> 18
    exit for
  end if
end for
error on
$searchpos=$pos

end function