/*
   Author - Mark Short, 1991
   SCROLWIN EXEC -
   Scrollable Picking Window, explanation at bottom
   You can set:
    topline - text on top line of window
    botline - text on bottom line of window
    wincolor - color of window (default is system default)
    textcolor - color of window (default is system default)
    startrow - where upper left corner row of box is on phys. screen
    startcol - where upper left corner column of box is on phys. screen
       Note: default is where cursor is in xedit, will try to fit anyway
    infile   - filename filetype filemode of file to show or
               a string delimited with '05'x that has the "lines" to show
               example:
                    line1 '05'x line2
                  would deliver
                 line1
                 line2
                  in the window, this will save IO's
    #rows    - number of rows to show (default 12)
    #cols    - number of columns to show (default 40)
    comand   - if this is present this will execute the comand and pass
               the line selected as the parameter
    presearch- if this is present then will search on this string upon
               entry
    helpfile - if this is present then will use this file instead of
               default help file.
    helptitle- if this is present then pass this title to HELPWIN for
               display.

    Each parameter is seperated by a | character.

    Sample 1: (using a file as list to scroll)

    Key = ScrolWin('Pick Something|Press Enter  PF3 Cancel|',
               'RED|WHITE|1|1|SOME FILE A|8|40')


    Sample 2: (using a list of items to scroll)

    Key = ScrolWin('Pick Something|Press Enter  PF3 Cancel|',
               'RED|WHITE|1|1|Item1']]'05'x']]'Item2|8|40')

    Note: Maximum rows = terminal size
          Maximum cols = terminal size-1 (need attribute byte)

 */

 parse arg topline  '|' botline,
         '|' wincolor '|' textcolor '|' startrow '|' startcol '|' infile,
         '|' #rows    '|' #cols '|' comand '|' presearch '|' helpfile,
         '|' helptitle
 line. = ''
 nl = '15'x
 nf = '05'x
 na = '01'x
 parse upper var comand comand
 if comand = '' then menu = 'NOMENU'
 if comand = 'HELP' then menu = 'HELP'  /* main thing is no help */
 if helpfile = '' then helpfile = 'SCROLWIN HELP *'

 if textcolor = '' then textcolor = wincolor
 filewidth = 0
 infile = strip(infile)
 Select
    when infile = '' then do
       push ''
       exit 28   /* 24 could be a pf key */
       end
    when index(infile,'05'x) > 0 then do
/*       address command "EXEC CLICKER SCROLWIN STRING" menu*/
            /* this is a list instead of a filename,
               break it down into lines to display in window. */
       do i = 1 until infile = ''
          parse var infile line.i '05'x infile
          if length(line.i) > filewidth then filewidth = length(line.i)
          end
       filelength = i
       end
    otherwise do
/*       address command "EXEC CLICKER SCROLWIN FILE" menu*/
       qd = queued()
       address command 'LISTFILE' infile '(ALLOC LIFO'
       if rc <> 0 then do
          push ''
          exit 28   /* 24 could be a pf key */
          end
       qd = queued() - qd
       do qd
          pull . . . . filewidth filelength .
          end
       address command 'EXECIO * DISKR' infile '1 (FINIS STEM LINE.'
       line.0 = ''
       end
    end

      /* make integer and minimize empty rows */
 if datatype(#rows,'W') then #rows = min(filelength+1,(#rows + 1) % 1)
 else #rows = ''
 if #rows = '' then #rows = filelength + 1
 if #cols = '' then #cols = filewidth

 WinId = WindIO('%CREATE%'startrow'%'startcol'%'#rows'%'#cols+3)
     /* find out what happened, validity checks done in Create */
 if left(WinId,1) <> 'W' then exit WinId
 address command 'QUERY WINDOW' WinId '(LIFO'
 pull . . #rows #cols WinPos .
 #rows = #rows - 3  /* allow for search message top bot line */
 #cols = #cols - 8  /* allow for border, etc */

 Select
    when comand = '' then ValidKeys = '1 2 5 7 8 10 11'
    when comand = 'HELP' then ValidKeys = '5 7 8 10 11'
    otherwise ValidKeys = '0 1 2 5 7 8 10 11'
    end
 StartLine = 1
 EndLine = StartLine+#rows-1
 Hits. = ''

 SearchString = PreSearch
 emsg = ''
 StartCol = 1
 CursRow = 2
 CursField = 1
 CursOffset = 1
 msg = 'PF1-Help  PF2-Search  PF5-Print'
 if menu = 'HELP' then msg = ''
 tb = 'DATA'na' 'na'1'na'RED'na'INVIS'nf

 numberofscreens = ((filelength-1)%#rows)+1
 screennumber = 1
 if SearchString <> '' then do
    QuestKey = 0
    Call PreSearch
    if emsg = '' then emsg = 'All lines with' Searchstring 'located!'
    end
 else Emsg = BuildLines('0')

 do until find(ValidKeys,KeyPress) = 0
    if emsg = '' then
       emsg = screennumber 'of' numberofscreens
    else emsg = screennumber 'of' numberofscreens']'emsg
    RetString = WindIO('%READ%'WinId'%'TopLine'%'BotLine'%'WinColor'%',
             CursRow'%'CursField'%'CursOffset,
            '%TEXT'na]]substr(emsg']']]msg,1,#cols+2)]]na,
             wincolor]]na]]'REV'nl]]lines)

    emsg = ''
    parse upper var RetString,
       KeyPress '15'x CursRow CursField CursOff '15'x .
    if KeyPress > 12 then KeyPress = KeyPress - 12

    Select   /* KeyPress actions */
       when KeyPress = 2 & Menu <> 'HELP' then Call Searcher
       when KeyPress = 5 then do
          prtfile = 'SCROLWIN $T$E$M$P A'
          pl = 2
          prtlines.1 = TopLine
          prtlines.2 = ' '
          do prtct = 1 to filelength
             if Hits.prtct = '' then do
                pl = pl + 1
                prtlines.pl = line.prtct
                end
             end
          prtlines.0 = pl
          address command 'PIPE  stem prtlines. ',
                               '] > 'prtfile
          address command 'EXEC PRT' prtfile
          address command 'ERASE   ' prtfile
          drop prtlines.
          end
       when KeyPress = 7 then emsg = BuildLines('-')
       when KeyPress = 8 then emsg = BuildLines('+')
       when KeyPress = 10 then
          if StartCol = 1 then emsg = 'Max Left of List!'
          else do
             StartCol = max(StartCol-#cols,1)
             emsg = BuildLines('0')
             end
       when KeyPress = 11 then
          if StartCol+#cols <= FileWidth then do
             if StartCol+#cols <= FileWidth - #cols
                then StartCol = StartCol  + #cols
                else StartCol = FileWidth - #cols
             emsg = BuildLines('0')
             end
          else emsg = 'Max Right of List!'
       when KeyPress = 1 & Menu <> 'HELP' then
          'EXEC HELPWIN' helpfile '( TITLE('helptitle')'
       otherwise do /* KeyPress = 0 or others than scroll/search */
          if CursRow > #rows+1 then LineRow = 0      /* not in list */
          else linerow = CursRow - 1  /* subtract msg line */
             /* line.linerow is contents of current line */
          if comand <> '' & Menu <> 'HELP' & find('3 12',KeyPress) = 0
             then do
                l# = strip(linerow)
                if l# > 0 & l# <= words(linelist) then do
                   l# = word(linelist,linerow)
                   address cms comand line.l#
                   end
                else emsg = 'Place cursor on valid selection'
             end
          else nop
          end
       end
    end
      /* clean up windows */
 drc = WindIO('%DELETE%'WinId)

/*
 * return answer (ans-above) and KeyPress if not a menu
 *  also pipe out the Scrolwin_var Stack won't put out a line over 255.
 *   and pipe out the SearchString. Just in case it changes.
 */

 address command 'PIPE var scrolwin_var ] var scrolwin_var 1 '
 address command 'PIPE var SearchString ] var SearchString 1 '

 if comand = '' then do
    if linerow < 1 then l# = 0
    else l# = word(linelist,linerow)
    push line.l#
    if length(line.l#) > 254 then do
       scrolwin_var = line.l#
       address command 'PIPE var scrolwin_var ] var scrolwin_var 1 '
       end
    return KeyPress

    end
 else return KeyPress

/*
 * Do search or rebuild lines or Reset
 */
Searcher:
      /* pop up search window */

   Questkey = QuestWin('Type in search string and Press ENTER|',
                     ]]'PF2 RESET  PF3/12 Cancel|GREEN|'WinPos-3'||',
                     ]] SearchString)
   pull SearchString
   if questkey > 12 then questkey = questkey - 12
Presearch:
   SearchString = strip(SearchString)
   Select
      when questkey = 2 then do  /* reset to ALL */
         Drop Hits.
         Hits. = ''
         StartLine = 1
         EndLine = 0
         emsg = BuildLines('0')
         screennumber = 1
         numberofscreens = ((filelength-1)%#rows)+1
         end
      when questkey = 3 ] questkey = 12 then emsg = 'Search Cancelled!'
      when questkey = 0 then do  /* search it */
         found = 0

         Drop hits.
         do i = 1 to filelength
            rec = translate(line.i)
            do wrd = 1 to words(SearchString) until Hits.i = ''
                   /* make |] spaces, allows words to be connected */
               if index(rec,translate(word(SearchString,wrd),'  ','|]')) <> 0 then do
                  Hits.i = ''
                  found = found + 1
                  end
               end
            end
         if found = 0 then do
            Drop Hits.
            Hits. = ''
            emsg = 'No Matches on' SearchString'!'
            screennumber = 1
            numberofscreens = ((filelength-1)%#rows)+1
            end
         else do
            numberofscreens = ((found-1)%#rows)+1
            screennumber = 1
            end
         StartLine = 1

         bmsg = BuildLines('0')
         if bmsg = '' then nop
         else emsg = bmsg
         end
      otherwise emsg = 'PF'questkey 'invalid in SEARCH!'
      end

return

/*
   Build a string containing the lines to be displayed
 */

BuildLines:

   arg direction
   OldStart = StartLine
   OldEnd   = EndLine
   Select
      when direction = '-' then do
         StartLine = StartLine-1
         inc = -1
         end
      when direction = '+' then do
         StartLine = EndLine + 1
         inc = 1
         end
      otherwise do  /* same range, scrolling left or right */
         inc = 1
         end
      end

   ErrMsg = ''
   newlines = ''
   l = StartLine
   lcnt = 0
   eol = 0
   oldlinelist = linelist
   linelist = ''
   do until (lcnt = #rows) ] eol
      if l < 1 ] l > filelength then eol = 1
      else do
         if Hits.l = '' then do
            lcnt = lcnt + 1
            if line.l == '' then newlines = newlines]]'TEXT'nl
            else do

               if inc = 1 then do
                  newlines = newlines]]tb'TEXT',
                     na]]substr(line.l,StartCol,#cols)na]]TextColor]]nl
                  linelist = linelist l
                  end
               else do  /* reverse it */
                  newlines = tb'TEXT',
                     na]]substr(line.l,StartCol,#cols)na]]TextColor]]nl,
                     newlines
                  linelist = l linelist
                  end

               end
            end
         l = l + inc
         end
      end
   if direction = '-' then do
      EndLine = StartLine
      StartLine = l - Inc
      end
   else EndLine = l - Inc          /* startline stays the same for +/0 */
   if newlines <> '' then do
      if direction <> 0 then screennumber = screennumber + inc
      lines = newlines
      end
   else do
      StartLine = OldStart
      EndLine = OldEnd
      linelist = oldlinelist
      if inc = -1 then ErrMsg = 'Top of list!'
      else ErrMsg = 'Bottom of list!'
      end

return ErrMsg