/*
HL_News: A  Headline News Viewer (ver 1.0)
By Tom Fredrickson
4-21-1999


Citation:
   Headline News Viewer is based on  the  Deja News Reader  by
   Eric Walker (ftp.highboskage.com/dnreader)

Requirements:
   Headline News requires the following dynamic link libraries (DLL):
       REXXLIB.DLL and RXWIN30.DLL from Quercus Systems at
              http://www.quercus-sys.com/files/rexxlib.zip
       RXSOCK.DLL:  the IBM EWS RxSock library is usually installed with 
                OS/2. If you do not a copy of RXSOCK.DLL, you  can find it at
                 ftp.ibm.com/pub/pccbbs/os2_ews/rxsock.zip
   These DLL library files must be in your LIBPATH (say, in x:\os2\dll, where
    x: is your boot drive), or in the same directory as HL_NEWS.CMD

Installation:
  a)  Copy HL_NEWS.CMD., NEWS.CFG, and  possibly the aforementioned DLLs
        to one of your applications directory.
  b)  create a LOADS and SAVE subdirectories under this directory --
       these are used for workspace.
       If you want to use diffferent names for these workspace directories,
      you can modify NEWS.CFG.

  Caution:
         The  LOADS subdirectory is subject to bulk erasal -- do NOT put anything in
         LOADS that you want to keep!


 Acknowlegements:
   *  This program  downloads a list, maintained by Derek Decker, of article
      headlines for viewing in a textmode window. You can check this list,
      at http://www.iglou.com/DeckerAutomation/news.html, with a java
      enabled  browser. 

      For more info about Decker Automation, and what Derek J Decker REALLY does,
        take a look at    http://www.cris.com/~djd

  * I must give specal thanks to Daniel Hellerstein author of HTML_TXT
     Without his help I would have probably not been able to get the text
     formatted in such a nice way.



*/




/***SETUP & INITIALIZATION:***************************************************/

/*   Rexx Function Extensions:  */

/*      Add Extended REXX Functions.  */
junk='Found RexxUtil DLL already available.'
If RxFuncQuery('SysLoadFuncs')=1 Then
  Do
    rexxutils=1
    junk='Loaded RexxUtils DLL functions locally.'
    If RxFuncAdd('SysLoadFuncs','RexxUtil','SysLoadFuncs')=0 Then Call SysLoadFuncs
     Else
      Do
        Say 'HL_News Unable to register OS/2 RexxUtils DLL functions.'
        Say
        Exit -1
      End
  End


/*      Add Quercus REXXLIB Functions.  */
text='Found RexxLib DLL already available.'
If RxFuncQuery('rexxlibregister')=1 Then
  Do
    quercuslib=1
    text='Loaded RexxLib DLL functions locally.'
    If RxFuncAdd('rexxlibregister','rexxlib','rexxlibregister')=0 Then Call RexxLibRegister
     Else
      Do
        Say 'HL_News Unable to register Quercus RexxLib DLL functions.'
        Say
        If rexxutils Then Call SysDropFuncs
        Exit -2
      End
  End

Call SysCls
Call CursorType ,,0  /* remove cursor from screen */
Call ScrWrite 1,1,Center('Setting up . . . ',80),,,31
Call ScrWrite 25,1,Center('Loading needed DLL functions . . . ',80),,,31
Call ScrWrite  5,1,Center(junk,80),,,14
Call ScrWrite  8,1,Center(text,80),,,14


/*      Add Quercus Window Functions.  */
text='Found RXWin30 DLL already available.'
If RxFuncQuery('w_open')=1 Then
  Do
    quercuswin=1
    text='Loaded RXWin30 DLL functions locally.'
    If RxFuncAdd('w_register','rxwin30','rxwindow')=0 Then Call W_Register
     Else
      Do
        Call ScrWrite 11,1,'Unable to register Quercus RXWin30 DLL functions.',,,12
        Call ScrWrite 13,1,Center('(Press any key to exit.)',80),,,15
        Call InKey
        Call SysCls
        If quercuslib Then Call RexxLibDeregister
        If rexxutils Then Call SysDropFuncs
        Exit -3
      End
  End
Call ScrWrite 11,1,Center(text,80),,,14
hello=W_Open(18,1,5,80,79)
Call W_Border hello
Call W_ScrWrite hello,3,2,Center('Remember!  The <F1> key brings help at any list-selection screen.',78)


/*      Add RxSock DLL functions.  */
text='Found RxSock DLL already available.'
If RxFuncQuery('SockLoadFuncs')=1 Then
  Do
    rexxsock=1
    text='Loaded RxSock DLL functions locally.'
    If RxFuncAdd('SockLoadFuncs','RxSock','SockLoadFuncs')=0 Then Call SockLoadFuncs dummy
     Else
      Do
        Call ScrWrite 14,1,'Unable to register IBM-EWS RxSock DLL functions.',,,12
        Call ScrWrite 16,1,Center('(Press any key to exit.)',80),,,15
        Call InKey
        'cls'
        If quercuswin Then Call W_Deregister
        If quercuslib Then Call RexxLibDeregister
        If rexxutils Then Call SysDropFuncs
        Exit -4
      End
  End
Call ScrWrite 14,1,Center(text,80),,,14
Drop junk text



/*   Initializations:  */

Call ScrWrite 25,1,Center('Initializing values . . . ',80),,,31


/*      Set essential (error-exit) "global" values.  */
rexxutils=0
quercuslib=0
quercuswin=0
rexxsock=0
global='rexxutils quercuslib quercuswin rexxsock boops'


/*      Set error reporting.  */
Signal On SYNTAX
Signal On HALT


/*      Set universal values.  */
homedir=Directory()


/*      Set scan codes.  */
pgup=D2C(73)
pgdn=D2C(81)
upkey=D2C(72)
dnkey=D2C(80)
leftkey=D2C(75)
rightkey=D2C(77)
ins=D2C(82)
del=D2C(83)
homekey=D2C(71)
endkey=D2C(79)
helpf1=D2C(59)
alts=D2C(31)
alti=D2C(23)
scancodes='pgup pgdn upkey dnkey leftkey rightkey ins del homekey endkey helpf1 alti alts' 


/*      User-settable values.  */

/*         Initialize values  */
line_len=78
h_mark=''
hi_asc=0
loadsdir=homedir'\LOADS\'
savesdir=''
boops=1
artcolor=96        /*  black on brown   */
hitpick=10         /*  GREEN on black   */

/*         Over-ride via CNF file  */
Call FileRead 'NEWS.CNF','dummy.'
Do line=1 to dummy.0
  If Pos('boops=',dummy.line)>0 Then Interpret dummy.line
  If Pos('loadsdir=',dummy.line)>0 Then Interpret dummy.line
  If Pos('savesdir=',dummy.line)>0 Then Interpret dummy.line
  If Pos('artcolor=',dummy.line)>0 Then Interpret dummy.line
  If Pos('hitpick=',dummy.line)>0 Then Interpret dummy.line
   If Pos('line_len=',dummy.line)>0 Then Interpret dummy.line
  If Pos('hi_asc=',dummy.line)>0 Then Interpret dummy.line
   If Pos('h_mark=',dummy.line)>0 Then Interpret dummy.line

End
Drop line dummy.
If boops<>0 and boops<>1 Then boops=1
If crossmax>10 Then crossmax=10


/*      Augment "global" variables list.  */
cr=D2C(13)
crlf=D2C(13)||D2C(10)
escape=D2C(27)
nul=''
help=0
alfabase=64  /* ascii of "A" minus 1 */
global=global||' cr crlf escape nul help alfabase homedir loadsdir line_len h_mark hi_asc savesdir'

/*      Initialize pointers cv.  */
pointers.0=5
Do junk=1 To 5
  pointers.junk=nul
End
Drop junk
!nextup=1
!oneback=2
!hitlist=3
!thread=4
!author=5
pointerstuff='pointers. !nextup !oneback !hitlist !thread !author'


/*   Net SetUp:  */

Call ScrWrite 25,1,Center('Resolving addresses . . . ',80),,,31


/*      Get queries-host dot address.  */
queryserver=NewHost('www.iglou.com')
If queryserver=nul Then Call ItQuits 'Unable to resolve query-server name--exiting.',-5



/*   Set other procedure-expose groups:  */

colors=' artcolor hitpick '
poststuff='poster postserver username password email myname myorg editor groupname quoter intro crossmax'
criteria='svcclass ageweight agesign showsort msgmax'



/*   Clean plate:  */

/*      Delete any old Load files.  */
Call ScrWrite 25,1,Center('Cleaning up . . . ',80),,,31
Call SysFileTree loadsdir'*.*','dummy.','FO'
If (dummy.0)>0 Then Call KillAll '*.*'

/*      Close "hello" window.  */
Call Delay 3
Call W_Close hello
Call CursorType ,,0
drop dummy. hello




/***MAIN ACTIVITY LOOP:*******************************************************/

IF BOOPS THEN CALL SOUND 500,.1
/*CALL POPUP 'This is BETA 1 of Headline News',2,'X'*/

Do Forever  
  /*  Select Clusters, Browse, Search, or Quit  */
  If boops Then Call Sound 900,.1
  Call ScrClear
  Call ScrWrite  1,1,Center('Task-Selection Screen:',80),,,31
  Call ScrWrite 25,1,Center('Select a task by indicator letter (<Esc> quits the program).',80),,,31
  Call ScrWrite  7,10,'Attention you Must be ON LINE to use Headline News',,,8
  Call ScrWrite 13,10,'B = Browse local list of news headlines',,,8
  Call ScrWrite 19,10,'D = Download  a new list of headlines',,,8
  ok=0
  allowed='BD'||escape
  help=8
  Do Until ok
    gothelp=0
    pressed=Upper(InKey())
    If Length(pressed)=2 Then
      Do
        scancode=Right(pressed,1)
        If scancode=helpf1 Then
          Do
            gothelp=1
            Call ShowHelp
          End
      End
     Else ok=Verify(pressed,allowed,'M')
    If gothelp=0 & ok=0 Then Call Sound 40,.3
    If pressed=escape Then
      Do
        If PopUp('Do you really want to exit this program?',6)='N' Then ok=0
         Else Call ItQuits 'Normal exit.',0
      End
  End
  help=0
  Call ScrClear
  /*  Do Called-For Task  */
  Select
    /*When pressed='I' Then Call Interests*/
    When pressed='B' Then do;bill=1; Call OffLine;end  /*Browse*/
    When pressed='D' Then Call Search     /* search will be online mode*/
  End
End




/******GET HEADLINES ACTIVITY LOOP:********************************************/
Search:

/*  Actual activity loop.  */
Do Forever
  Call ScrWrite 1,1,Center('Power Search HeadLines:',80),,,31
  queryY= "/DeckerAutomation/news.txt" 
  query='GET 'queryy||crlf||' HTTP/1.0'
  site="www.iglou.com"
  port=80
  artlist=MakeQuery(query,site,port,0,'S')
  /*:::::::::::::::::::::::::::::::::::::::::::::::::::::::
        query="/DeckerAutomation/news.txt"
      queryserver=NewHost("www.iglou.com")
      ok=MakeQuery(query,queryserver,'80','N')

  MakeQuery gets the server's response and saves it in a
  file named SEARCH.HTM; it returns 0 for success or, for 
  any failure, -1.
  :::::::::::::::::::::::::::::::::::::::::::::::::::::::*/
  If artlist<0 Then Call PopUp 'Search failed somehow!',4,'X'
  If artlist<0 Then leave
  bill=0
OffLine:

if bill=1 then got=1
  got=ParseSearch()
  If got=0 Then Call PopUp 'There were NO Headlines returned.',3,'X'
  If got=0 Then Iterate
  artibase=0                               /*  Re-initialize articles-list placeholder */
  Do Forever
    toread=PickArticle(-1)                   /*  Select article from search results      */
    If toread=nul Then Leave                 /*  User quits article selection            */
    if toread>0 then do
    toread=GetUrl(toread)
    Do Forever
      toread=ReadArticle(toread)               /*  User could select next article here     */
      If toread=nul Then Leave                 /*  User quits internal article selection   */
    End
  End
End
Return



/*  Procedures Specific To This Task.  */


ParseSearch:
Procedure Expose (global)
Call ScrWrite 1,1,Center('Reply complete; parsing list . . . ',80),,,31    
Call ScrWrite 25,1,Center('Speed, shmeed: this is only Rexx!',80),,,31
Call FileRead loadsdir'SEARCH.HTM','html.'

/*  Extract hits/hrefs from raw file.  */
hits.0=0
hrefs.0=0
art=0
line=0
/*start*/
 Do line=1 To html.0
              if pos('www.futurecard.com',html.line)>0 then iterate
              if pos('freewire.htm',html.line)>0 then iterate
             art=art+1
             start=pos('" ',html.line) 
             Head_lines=strip(left(html.line,start),'B','"')
                hits.art=CONVERT_CODES(Head_lines)
                hrefs.art=strip(substr(html.line,start+9),'L','/')
              End

          hits.0=art
          hrefs.0=art
/*end*/
hits.0=art
hrefs.0=art
If art>0 Then
  Do
    Call FileWrite loadsdir'SEARCH.HIT','hits.','R'
    Call FileWrite loadsdir'SEARCH.REF','hrefs.','R'
  End
Return art




/***SHARED PROCEDURES, ROUTINES, ETC.:****************************************/

/*   Major Routines:  */

PickArticle:
Procedure Expose (global) (scancodes) (colors) (pointerstuff) (poststuff)  artibase groupname queryserver
Parse Arg groupnumber
  /* search */
  do
      scheme1=hitpick
      scheme2=hitpick
      namespec='SEARCH'
      serial=0
      usename='News HeadLines'
      mode='S'
      end
call fileread loadsdir'SEARCH.HIT','hits.'
call fileread loadsdir'SEARCH.REF','hrefs'
art=hits.0
help=3
picked=0
nextblock=''
Do Until picked
Call ScrWrite 1,1,Center('Current "'usename'"',80),,,31
  /*  Display 22-line window of list selections.  */
  attr=scheme1
  Do row=3 To 24    
    inset=(row-2)+artibase  /* row 3 is "A" */
    If inset<=art Then
      Do
        test=Strip(hits.inset,'L')
        blanks=(Length(hits.inset))-Length(test)
        If blanks=0 | Left(test,4)='Re: ' Then
          Do
            If attr=scheme1 Then attr=scheme2
             Else attr=scheme1
          End
        leader=D2C(row-2+alfabase)': '
        Call ScrWrite row,1,leader||Left(hits.inset,77),,,attr
        top=row
      End
     Else Call ScrWrite row,1,' ',80,' ',2
  End
  Call ScrWrite 2,1,Center('Local list lines 'artibase+1' To 'artibase+top-2' (of 'hits.0')',80),,,15
  /*  Get valid user choice.  */
  top=D2C(top-2+alfabase)
  allowed=XRange('A',top)
  Call ScrWrite 25,1,Center('Pick an Article by corresponding letter key.',80),,,31
  ok=0
  Do Until ok
    pressed=InKey()
    If Length(pressed)=1 Then 
      Do
        scancode=nul
        pressed=Upper(pressed)
        If pressed=escape Then ok=1
        If Verify(pressed,allowed,'Match') Then 
          Do
            index=artibase+C2D(pressed)-alfabase
            If hrefs.index<>nul Then ok=1
          End
      End
     Else 
      Do
        scancode=Right(pressed,1)
        pressed=nul
        If scancode=pgup | scancode=pgdn | scancode=homekey | scancode=endkey | scancode=helpf1 Then ok=1
      End
    If \ok Then Call Sound 40,.3
  End  /* of UNTIL OK loop */
  /*  Process choice as appropriate.  */
  picked=0
  If scancode<>nul Then
    Do
      Select
        /*  Screen-change keys.  */
        When scancode=pgup Then
          Do
            If artibase=0 Then 
              Do
                If boops Then Call Sound 200,.1
              End
             Else artibase=artibase-22
            If artibase<0 Then artibase=0
          End
        When scancode=pgdn Then
          Do
            If artibase<art-22 Then 
              Do
                artibase=artibase+22
                If artibase>(art-22) Then artibase=art-22
              End
              /* +++++++++++?+++++++++*/
             Else
              Do
                If nextblock='' Then Call Sound 40,.3
              End  /* of were-at-end */
             
          End  /* of PgDn */
        When scancode=homekey Then 
          Do
            If artibase=0 Then 
              Do
                If boops Then Call Sound 200,.1
              End
             Else artibase=0
          End
        When scancode=endkey Then 
          Do
            If artibase>=art-22 Then 
              Do
                If boops Then Call Sound 1300,.1
              End
             Else artibase=art-22
            If artibase<0 Then artibase=0
          End
        When scancode=helpf1 Then 
          Do
            Call ShowHelp
          End
      End  /* Select scancode */
    End  /* nonascii key used */
   Else
    Do
      picked=1
      If pressed=escape Then toread=nul
      Else toread=hrefs.index
      /*
       Else do; toread=hrefs.index;  /* calculated in appraising keypress validity */
       /* get next and prev here Toread+1 -1 */
         !index=index+1
          index!=index-1
          if index>2 then pointers.!oneback=GetUrl(hrefs.index!)
          else pointers.!oneback=nul
          if index=art then pointers.!nextup=nul
          else pointers.!nextup=getUrl(hrefs.!index)
       end /* do */
        */

    End
End  /* of Do-Until-Picked loop */
help=0
Return toread


ReadArticle:
Procedure Expose (global) (scancodes) (pointerstuff) (colors) (poststuff) /*queryserver*/
Parse Arg toread
 parse var toread query site port type
ok=MakeQuery(query,site,port,0,type)
/*If ok<0 Then Call PopUp 'Article NOT returned!',4,'X'*/
If ok<0 Then Return nul
/*call dosdel loadsdir'IMAGE.TXT'*/
call dosdel loadsdir'IMG.REF'
call dosdel loadsdir'IMG.HIT'

 if site='gopher.voa.gov' then do
    Call FileRead loadsdir'ARTICLE.HTM','article.'
    Call ScrWrite 1,1,Center('Converting 'article.0' HTML lines to straight text . . . ',80),,,31
    Call ScrWrite 25,1,Center('Speed, shmeed: this is only Rexx!',80),,,31
     If article.0>0 then call FileWrite loadsdir'ARTICLE.TXT','article.'
 end /* do */
 else do
Call FileRead loadsdir'ARTICLE.HTM','text.'
Call ScrWrite 1,1,Center('Converting 'text.0' HTML lines to straight text . . . ',80),,,31
Call ScrWrite 25,1,Center('Speed, shmeed: this is only Rexx!',80),,,31

/*===How to read article====*/
no_start_mess=''
      select                                                                           
         when site='dailynews.yahoo.com'  then do  /* checked */                              
            read_by=1
            start='TimeStamp:'
            stop='<!-- TextEnd -->'        /* need -1 from endat */
         end /* do dailynews.yahoo.com */
         when site='gopher.voa.gov'  then do        /* checked */                             
            read_by=2
            beginat=1
            endat=text.0 
         end /* do gopher.voa.gov */
         when site='www.vny.com'   then do         /**/                            
             read_by=3 
             start='<title>'
             stop='</PRE>'        /* need-2 */
           end /* do vny.com */
         when site='www.latimes.com'   then do       /* checked */                           
                        read_by=4
            found.1=0
            call arraysearch 'text.','found.','<div align=right>'
            if found.1>0 then start='<div align=right>'
             else do; call arraysearch 'text.','found.','<!--CONTENT SPACE-->'
                  if found.1>0 then start='<!--CONTENT SPACE-->'
             else start='<!--LEFT SIDE LINKS END-->'
             end
             found.1=0
             call arraysearch 'text.','found.','<!--STORY ENDS-->'
                if found.1>0 then stop='<!--STORY ENDS-->'
                else stop='<!--BOTTOM NAV ROW-->'
         end /* do LA Times */
            
         when site='7am.com'   then do                 /**/
            read_by=5
            call arraysearch 'text.','found.','A 7am News Special Feature'
            if found.1>0 then start='<TITLE>'
                else   start='<FONT SIZE=5>'
                found.1=0
              call arraysearch 'text.','found.','#0000c0'
              if found.1>0 then stop='#0000c0'
               else  stop='<B>Previous Stories</B>'
         end /* do 7am.com */
         when site='cnn.com'   then do                 /* checked */
            read_by=6
            start='Paste story between here'
            stop='Relateds'
            end /* do cnn.com */
         when site='www.washingtonpost.com' then  do   /**/                         
         call arraysearch 'text.','found.1','302 Moved'
             if found.1>0 then do
                 call Scrwrite  23,1,Center('Connection: closed Article Moved 'site,80),,,79
                 return  nextart
                   end
         read_by=7
         start='plsfield:headline'
         stop='The Washington Post Company'
          found.1=0
           end /* do www.washingtonpost.com */
         when site='news.bbc.co.uk'   then do          /**/                      
            read_by=8
            start='date" component *'
            stop='Search/Back'
         end /* do news.bbc.co.uk */
         when site='www.wired.com'  then do                /**/                      
            read_by=9
            /* get headline out<!-- HEADLINE=The Sordid Saga of Sex.com -->*/
            start='HEADLINE='
            stop='- END_OF_BODY -'
         end /* do www.wired  */ 
         when site='cnnfn.com'   then do               /**/                         
            read_by=10
                                    found.0=0
            call arraysearch 'text.','found.','-Start Header Block'
            if found.0>0 then start='-Start Header Block'
             else do; call arraysearch 'text.','found.','digitaljam'
                  if found.1>0 then start='digitaljam'
             else start='<title>'
             end
             found.1=0
             call arraysearch 'text.','found.','-End Body-'
                if found.1>0 then stop='-End Body-'
                else stop='Copyright '
         end /* do cnnfn.com */
         when site='www.news.com.au'  then do             /**/                         
            read_by=11
            start='<!-- START: Columns Table -->'
            stop='<!-- END: Columns Table -->'
         end /* do */
         when site='www.zdii.com'   then do            /**/                         
            read_by=12
            start='- content start center table -'
            stop='-content stop-'
         end /* do */
         when site='www.futurecard'   then do          /**/                         
            read_by=13
             call Scrwrite  23,1,Center('Need Credit? Goto:'site,80),,,79           
             return  nextart                                                           
         end /* do */
         when site='www.news.com'   then do            /**/                         
            read_by=14
            start='<blockquote>'
            stop='</blockquote>'
         end /* do */
         when site='dynamic.webpoint.com' then  do           /*checked*/                 
            read_by=15  
             start='<!-- START TEXT -->'
             stop='<!-- END TEXT -->'       /* some strange character */
              end /* do */
          when site='www.techweb.com'   then do       /**/      
             read_by=16                                  
             start='-HEADLINE-'
             stop='-/BODY-'
          end /* do */                                   


                                                                                       
      otherwise                                                                        
      read_by=0                                                                        
       call ArraySearch 'text.','found.','/applet','S'
         if found.0>0 then beginat=found.1+1
          else beginat=1
          endat=text.0
      end  /* select */                                                                


if no_start_mess='' then no_start_mess='Cant find text start.'

  found.1=0                                                                           
  call ArraySearch 'text.','found.',start,'S'                                         
  if found.1>0 then  beginat=found.1                                                  
  else do                                                                             
       call Scrwrite  23,1,Center(no_start_mess' 'site,80),,,79                  
       return  nextart                                                                
         end                                                                          
         found.1=0                                                                    
  call ArraySearch 'text.','found.',stop,'S'                                          
  if found.1>0 then  endat=found.1                                                    
  else do                                                                             
       call Scrwrite  24,1,Center('Cant find text end.'site,80),,,79                  
       return  nextart                                                                
         end                                                                          

/*-- add beginat endat ajustments here --*/
/*if read_by=1 then endat=endat-1*/

article.0=0
count=0
in=0
out=0
pre_tx_on=0
cut_on=0
pre_tx_on=0

text=''
do line=beginat to endat
   if text.line=nul then iterate line
   /*---------site specific -------------*/

     if read_by=4 then do           /* la times */
     if pos('>ADVERTISEMENT<',text.line)>0 then iterate line
  end /* do */

    if read_by=14 then do              /* www.news.com */
       if pos('>&nbsp;Do you want to know more?<',text.line)>0 then iterate line
       if pos('newsLinks">',text.line)>0 then iterate line
       if pos('Message Boards</a',text.line)>0 then iterate line
        in=pos('>QUOTE SNAPSHOT<',text.line)
        
        out=pos('20+ minutes<',text.line)

        if pos('News.com</a>',text.line)>0 then iterate line

    end /* do */
        if read_by =9 then do
       if pos('Related Wired Links:',text.line)>0 then leave
    end /* do */


   if pos('<PRE>',upper(text.line))>0 then pre_tx_on=1
   if pos('</PRE',upper(text.line))>0 then pre_tx_on=0

  count=count+1
      text_in=translate(text.line,' ','0da00009'X)
        if in>0 then text_in=insert('[cut]',text_in,in)
        if out>0 then text_in=insert('[/cut]',text_in,out+10)
   if pre_tx_on=1 then text=text' 'text_in||' [pre]'
  else text=text' 'text_in
  end

    text=DeHtml(text)
     
    
       call Wrapper text
    end /* gopher not */

 count=article.0
Call ScrWrite 1,1,Center('Article From: 'site,80),,,31
nextart=nul
baseline=0
inset=0
done=0
temp=W_Open(2,1,23,80,artcolor)
help=6
Do Until done
  /*  Clear FULL screen in case of side trips made  */
  Call W_Clear temp,artcolor,' ',2,1,23,80
  /*  Display 23-line window of article.  */
  top=baseline+23
  If top>count Then top=count
  Call ScrWrite 25,1,Center('Lines 'baseline+1' to 'top' of article.',80),,,31
  maxlength=0
  Do row=1 To top
    index=row+baseline
    Call W_ScrWrite temp,row,1,SubStr(article.index,1+inset,80)
    If Length(article.index)>maxlength Then maxlength=Length(article.index)
  End
  /*  Get a valid keypress.  */
  ok=0
  Do Until ok | done
    pressed=InKey()
    If Length(pressed)=1 Then 
      Do
        scancode=nul
        If pressed=escape Then done=1
         Else Call Sound 40,.3
      End
     Else 
      Do
        scancode=Right(pressed,1)
        pressed=nul
        Select
          When scancode=pgup Then
            Do
              ok=1
              If baseline=0 Then 
                Do
                  If boops Then Call Sound 200,.1
                End
               Else baseline=baseline-23
            End
          When scancode=pgdn Then
            Do
              ok=1
              If baseline>=(count-23) Then 
                Do
                  If boops Then Call Sound 1300,.1
                End
               Else 
                Do
                  baseline=baseline+23
                  If (baseline+24)>count Then baseline=count-23
                End
            End
          When scancode=homekey Then 
            Do
              ok=1
              If baseline=0 Then 
                Do
                  If boops Then Call Sound 200,.1
                End
               Else baseline=0
            End
          When scancode=endkey Then 
            Do
              ok=1
              If baseline=count-23 Then 
                Do
                  If boops Then Call Sound 1300,.1
                End
               Else baseline=count-23
            End
          When scancode=leftkey Then
            Do
              ok=1
              If inset=0 Then 
                Do
                  If boops Then Call Sound 200,.1
                End
               Else inset=inset-10
            End
          When scancode=rightkey Then
            Do
              ok=1
              If inset>=(maxlength-80) Then 
                Do
                  If boops Then Call Sound 1300,.1
                End
               Else 
                Do
                  inset=inset+10
                  If (inset+80)>maxlength Then inset=maxlength-80
                End
            End
          When scancode=helpf1 Then 
            Do
              Call ShowHelp
            End
/*::::::::Special-call keys:::::::::::::::::::::::::::::::::::::::::::*/
          When scancode=alts Then
            Do
              ok=1
              Call SaveIt
            End
          When scancode=alti Then
            Do
              ok=1
              Call ShowHeader
            End
          Otherwise Call Sound 40,.3
        End  /* Select on scancode */
      If baseline<0 Then baseline=0
      If inset<0 Then inset=0
      End  /* scankey pressed */
  End  /* get & process keypress */
  If \ok & \done Then Call Sound 40,.3
End
help=0
Call W_Close temp
Call CursorType ,,0
Return nextart


/*===============================================*/


MakeQuery:
Procedure Expose (global)
Parse Arg query,site,port,serial,type
/*Parse Arg query,serveraddr,port,serial,type*/
serveraddr=NewHost(site)
if port='' then port=80
Select
  When type='S' Then Call ScrWrite 1,1,Center('Getting requested HeadLines . . . ',80),,,31
  When type='G' Then Call ScrWrite 1,1,Center('Getting requested Gopher Article. . . ',80),,,31
  When type='A' Then Call ScrWrite 1,1,Center('Getting requested Article from: 'site,80),,,31
  Otherwise Call ScrWrite 1,1,Center('Getting requested Article . . . ',80),,,31
End
/*  Connect to server for a socket.  */
Call ScrWrite 25,1,Center('Connecting . . . ',80),,,31
/*  Now log on.  */
socket=SockSocket("AF_INET","SOCK_STREAM",0)
If socket=-1 Then
   Do
     If boops Then Call Sound 300,.3
     Call ScrWrite 25,1,Center('Error opening socket!  (Press any key to continue.)',80),,,79
     Call InKey
   End
If socket=-1 Then Return -1
/*  Log on to the socket.  */
Call ScrWrite 25,1,Center('Logging on to socket 'socket' . . . ',80),,,31
server.!family='AF_INET'  /* mandatory  */
server.!port=port  /*  standard HTTP port  */
server.!addr=serveraddr  /* as obtained earlier  */
got=SockConnect(socket,'server.!')
If got=-1 Then
   Do
     If boops Then Call Sound 300,.3
     Call ScrWrite 25,1,Center('Error logging on to socket!  (Press any key to continue.)',80),,,79
     Call InKey
   End
If got=-1 Then Return -1
/*  Send actual service request.  */
Call ScrClear 7,' ',2,1,23,80
Call ScrWrite 25,1,Center('Sending request . . . ',80),,,31
select
   when type='G' then do
      Call SendLine query,socket      /*Gopher*/
   end /* do */
   when type='S' then do
      Call SendLine query,socket      /*Headlines*/
   end /* do */
otherwise
Call SendLine 'GET 'query' HTTP/1.0',socket
end  /* select */
Call SendLine 'Accept: *'||'/'||'*; q=0.300',socket
Call SendLine 'Accept: application/octet-stream; q=0.100',socket
Call SendLine 'Accept: text/plain',socket
Call SendLine 'Accept: text/html',socket
Call SendLine 'User-Agent: IBM-RxSock-DLL/v1.1',socket
Call SendLine nul,socket
Call SendLine query,socket
Call ScrWrite 25,1,Center('Request sent . . . ',80),,,31
buffer=nul
Call Time('R')
Do Until buffer<>nul & data=nul
  If Time('E')>120 Then Leave
  rc=SockRecv(socket,'data',8000)
  If buffer=nul Then Call ScrWrite 25,1,Center('Receiving reply . . . ',80),,,31
  buffer=buffer||data
  If data<>nul Then Call Time('R')
  Call ScrWrite 13,1,Center(Length(buffer)' bytes received . . . ',80),,,14
End
/*  Close socket before proceeding.  */
got=SockSoClose(socket)
If got=-1 Then Call ItQuits 'Error closing socket.',-7
/*  Process response, if any.  */
If Pos('>Bad Request<',buffer)>0 Then Call PopUp 'Server Could Not Understand Query!',4,'X'
If Pos('>Bad Request<',buffer)>0 Then Return -1
If Pos('Moved Temporarily',buffer)>0 Then Call PopUp 'This Article has Been Moved!',4,'X'
If Pos('Moved Temporarily',buffer)>0 Then Return -1
If Pos('HTTP/1.0 404 Not found',buffer)>0 Then Call PopUp 'This Article Not Found on server!',4,'X'
If Pos('HTTP/1.0 404 Not found',buffer)>0 Then Return -1
If Pos('HTTP/1.0 302 Found',buffer)>0 Then Call PopUp 'This Article has Been Moved!',4,'X'
If Pos('HTTP/1.0 302 Found',buffer)>0 Then Return -1

If buffer<>nul Then
  Do      /* need select by QueryServer our type to set up the readArticle*/
    If type='G' Then ok=1/*serial+1*/
     Else ok=0
    dummy.0=1
    dummy.1=buffer
    Call ScrWrite 25,1,Center('Reply received; saving . . . ',80),,,31
    Select
      When type='S' Then dropin='SEARCH'
      Otherwise dropin='ARTICLE'
    End
    Call ScrWrite 13,1,Copies(' ',80)
    Call FileWrite loadsdir||dropin||'.HTM','dummy.'
  End
 Else 
   Do
     ok=-1
     Call PopUp 'Error receiving response!',4,'X'
   End
Return ok



/*   Lesser Routines:  */


/*   Small Procedures (only globals Exposed):  */



NewHost:
Procedure Expose (global)
Parse Arg service
If SockGetHostByName(service,'host.!')=0 Then serveraddr=nul
 Else serveraddr=host.!addr
Return serveraddr



GetUrl:
procedure Expose (global)
parse arg url
/*  //gopher.voa.gov:70/00/newswire/mon/CONGO-HUMAN_RIGHTS 
    www.vny.com/cf/News/upidetail.cfm?QID=74278
*/

if pos('gopher',url)>0 Then do
     
     j=pos(':',url)
  site=substr(url,1,j-1)
  com=substr(url,j+5)
           n=pos('%',com)
           if n >0 then 
           do until n=0
          parse var com '%' !test
          /* set query for gopher*/
          test='%'||substr(!test,1,2)
          old=substr(!test,3)
          new_com=left(com,n-1)
            select
            When test='%26' Then use='&'
            When test='%7C' Then use='|'
            When test='%21' Then use='!'
            When test='%5E' Then use='^'
            When test='%22' Then use='"'
            When test='%3F' Then use='?'
            When test='%29' Then use=')'
            When test='%7B' Then use='{'
            When test='%7D' Then use='}'
            When test='%23' Then use='#'
            When test='%28' Then use='('
            When test='%2C' Then use=','
            When test='%25' Then use='%'
            When test='%3A' Then use=':' 
            When test='%7E' Then use='~'
            Otherwise use='[bad]'
          End
          com=new_com||use||old
           n=pos('%',com)
         end
         query=com
/*queryserver=NewHost(site)*/
port=70
type='G'
   return query site port type
   end
else
    do
   j=pos('/',url)
   site_tag=substr(url,1,j-1)
   /*=====could select long or short here======*/
  if site_tag='www.latimes.com' then do
      la=lastpos('.1',url)
      if la>0 then  com_tag=substr(url,j,la-j)||substr(url,la+2)
      else com_tag=substr(url,j)
      comtag=url
      end
      else com_tag=substr(url,j)

query=com_tag
port=80
site=site_tag
return query site port
end

  /*MakeQuery(query,queryserver,0,'A')*/



Wrapper: procedure  expose article.
parse arg text
art_text.0=0
art=0
/*do line=1 to count*/
 sentence=''
   do forever
      if text='' then /* leave*/
      do 
         art=art+1
         /*say sentence*/
         art_text.art=sentence
         leave
      end /* do */
      len=pos('[pre]',text)
      if len>0 then line_len=400
      else line_len=76
     parse var text aword text
         /*
      bad=pos('>',aword)
      badlink=pos('HTTP:',upper(aword))
       if bad>0 then aword=' '
       if badlink>0 then aword=' '
       */
      if length(sentence)+length(aword)> line_len  then do    /*aword*/
         art=art+1
         art_text.art=sentence
       /* say  sentence /* or lineout it */*/
              if aword='[P]' then do; aword='';art=art+1;/*say ''*/ art_text.art='';end
        if aword='[BR]' then do; aword='';art=art+1;/*say ''*/ art_text.art='';end
           if aword='[pre]' then aword=''
            if aword='[/CENTER]' then aword=''
            if aword='[/TITLE]' then aword=''
            if aword='[CENTER]' then aword=''
            if aword='[TITLE]' then aword=''

         sentence=aword
         
    end
   else do
     sentence=sentence' 'aword
     if sentence='[BR]' then sentence=''
     if sentence='[P]' then sentence=''
                  /*
       tabl=Pos('[TABLE]',sentence)-1
       if tabl>0 then do
          sentence=left(sentence,tabl)
          art=art+1
          art_text.art=sentence||'[tabl'
           /*
           art=art+1
          art_text.art=''
          */
          sentence=''
       end /* do */
       
       end_tabl=pos('[/TABLE]',sentence)-1
       if end_tabl>0 then do
          sentence=left(sentence,end_tabl)||'[end'
           art=art+1
          art_text.art=center(sentence,78)
           art=art+1
          art_text.art=''
          sentence=''

       end /* do */
       */


     brk=pos('[BR]',sentence)-1
      if brk >0 then do
        /*sentence=sentence' 'aword*/
        sentence=left(sentence,brk)
        art=art+1
        art_text.art=sentence
       sentence=''
       art=art+1
       art_text.art=''
       /*say ''*/
       sentence=''
       end

     wrap=pos('[P]',sentence)-1
      if wrap >0 then do
        /*sentence=sentence' 'aword*/
        sentence=left(sentence,wrap)
        art=art+1
        art_text.art=sentence
      /* say sentence*/
       art=art+1
       art_text.art=''
       /*say ''*/
       sentence=''
       art=art+1
       art_text.art=''
       /*say ''*/
       sentence=''

       end



       title=pos('[TITLE]',sentence)-1
       if title>0 then do
          sentence=left(sentence,title)
          art=art+1
          art_text.art=sentence
           art=art+1
          art_text.art=''
          sentence='***'
       end /* do */
       end_title=pos('[/TITLE]',sentence)-1
       if end_title>0 then do
          sentence=left(sentence,end_title)||'***'
           art=art+1
          art_text.art=center(sentence,line_len-2)
           art=art+1
          art_text.art=''
          sentence=''

       end /* do */
              cent=pos('[CENTER]',sentence)-1
       if cent>0 then do
          sentence=left(sentence,cent)
          art=art+1
          art_text.art=sentence
          /*
           art=art+1
          art_text.art=''
          */
          sentence=''
       end /* do */
       end_cent=pos('[/CENTER]',sentence)-1
       if end_cent>0 then do
          sentence=left(sentence,end_cent)
           art=art+1
          art_text.art=center(sentence,line_len-2)
          /*
           art=art+1
          art_text.art=''
          */
          sentence=''

       end /* do */

       pre_tx=pos('[pre]',sentence)-1
       if pre_tx>0 then do
          sentence=substr(sentence,1,pre_tx)
          art=art+1
          art_text.art=sentence
          sentence=''

       end /* do */
    end  
    end  

  art_text.0=art
 if art>0 then do 
  /* call filewrite 'loads\ARTICLE.TXT','art_text.'*/
    call arraydelete article.,1, article.0
 call arrayinsert art_text.,article.,1,1, art_text.0
/* end*/
    return 
 end



/*---- New Html markdown---*/
DeHtml:
PROCEDURE expose (global)


parse arg body
thispara=''
capon=0
cut_on=pos('[cut]',body)-1
cut_off=pos('[/cut]',body)+6
if cut_on>0 then body=left(body,cut_on)||substr(body,cut_off)
ispre=0
ulineon=0
img_num=0
img_href.=0
img_alt.=0
do forever
 if body='' then leave
    
    parse var body t1 '<' t2a '>' body
       
    T1=CONVERT_CODES(T1,CAPON,ISPRE,ULINEON)
/* Ready to add more content ..... */
     thispara=thispara||t1      /* ADD T1 TO THISPARA FOR EVENTUAL OUTPUT */
/* now prepare to process this <element> (T2 is first word, T2A is all words */
    t2=strip(translate(word(t2a,1)))             /* get rid of element modifiers */
    if left(t2,1)='/'  then
        t2end=substr(t2,2)
    else
        t2end=''

       /*do some stuff here*/
    select
    when t2='P' then do
       thispara=thispara||' ['t2'] '
    end /* do */
      when t2='PRE' then do;ispre=1;end
       when t2='/PRE' then do;ispre=0;end
        when t2='B' then capon=1
       when t2='/B' then capon=0
       when t2='IMG' then do
          img_num=img_num+1
          parse var t2a . imgname 
          here=Pos('SRC',upper(imgname))
          start=Pos('"',imgname,here)+1
           cut=pos('"',imgname,start+1)
            link=substr(imgname,start,cut-start)
          here=Pos('ALT',upper(imgname))
          if here>0 then do
          start=pos('"',imgname,here)
           cut=pos('"',imgname,start+1)-1
          link_nam=substr(imgname,start+1,cut-start)
          end
          else link_nam='What no alt tag?'
           img_href.img_num=link
           img_alt.img_num=link_nam

            /*
          say'herf: 'link
          say'link: 'link_nam
              */
                /*  if cut-start=2 then  imgname=substr(imgname,start+1,1)*/
                if length(link_nam)=1 then alt_let=link_nam
        else alt_let=''
          thispara=thispara||' 'alt_let
          
          end
        when t2='TITLE' then do
       thispara=thispara||' ['t2'] '
    end /* do */
    when t2='/TITLE' then do
       thispara=thispara||' ['t2'] '
       end
         when t2='CENTER' then do
       thispara=thispara||' ['t2'] '
    end /* do */
    when t2='/CENTER' then do
       thispara=thispara||' ['t2'] '
       end

     when wordpos(t2,'H1 H2 H3 H4 H5 H6 H7')>0 then do
        if h_mark='' then h_mark='0000'X||strip(t2,'L','H')||')'

         thispara=thispara||h_mark
           end
              when wordpos(t2,'/H1 /H2 /H3 /H4 /H5 /H6 /H7')>0 then do
         thispara=thispara||' [BR] '
           end

        when t2='BR' then do
       thispara=thispara||' [BR] '
    end /* do */
 otherwise nop
   end
 end
 if img_num>0 then do
    img_href.0=img_num
    img_alt.0=img_num
    call filewrite loadsdir'IMG.REF','img_href.'
    call filewrite loadsdir'IMG.HIT','img_alt.'
 end /* do */
return thispara



/* CONVERT &ENCODING */
CONVERT_CODES:PROCEDURE expose (global)
PARSE ARG T1,CAPON,ISPRE,ULINEON,ISTH

IF T1='' then RETURN T1

      if capon>0 | ISTH='TH' then t1=translate(t1)
      if ispre=0 then t1=translate(T1,' ','0d0a0009'x)
      if ulineon=1 then do
           if ispre=0 then
              t1= translate(space(t1,1),'_',' ')
           else
              t1=translate(t1,'_',' ')
      end /* do */

      tt1=t1 ;t1=''
      do forever
        if tt1='' then leave
        parse var tt1 v1 '&' v2a tt1

        t1=t1||v1
        goo=pos(';',v2a)

        if goo>0 then do
            v2=left(v2a,goo-1)
            v3a=substr(v2a,goo+1)
            tt1=v3a' 'tt1
        end /* do */
        else do
           v2=v2a
        end /* do */

        v2=strip(v2)

        if v2<>"" then do
            v2=strip(translate(v2))
            v2=strip(v2,,'#')
            select
               when v2='AMP' then t1=t1||'&'
               when v2='LT' then t1=t1||'<'
               when v2='GT' then t1=t1||'>'
               when v2='QUOT' then t1=t1||'"'
               when v2='NBSP' then t1=t1||'01'x
               when datatype(v2)='NUM' then do 
                  if hi_asc=0 then t1=t1||' '
                  else t1=t1||d2c(v2)
               end /* do */
               otherwise t1=t1||' 'translate(v2)' '
            end  /* select */
        end /* v2<>"" */
      end /* FOREVER  */
RETURN T1

/*-------------------------------------*/
        /* end text markup*/


GetPointer:
Procedure Expose (global)
Parse Arg item
test=Upper(item)
start=Pos('HREF=',test)
If start=0 Then Return nul
start=start+12
If Pos('HREF="',test)>0 Then 
  Do
    start=start+1
    cut=Pos('">',item,start)
  End
 Else cut=Pos('>',item,start)
If cut>0 Then 
  Do
    ref=SubStr(item,start,cut-start)
    If ref<>nul Then
      Do
        start=Pos('/',ref)
        If start>0 Then query=SubStr(ref,start)
         Else query=ref
      End
  End
 Else query=nul
Return query


GetAuthor:           /* cuold be used t get a url ?*/
Procedure Expose (global)
Parse Arg item
start=Pos('/profile.xp',item)
If start=0 Then Return nul
cut=Pos('">',item,start)
If cut=0 Then cut=Pos('>',item,start)
If cut>0 Then query=SubStr(item,start,cut-start)
 Else query=nul
Return query


PopUp:
Procedure Expose (global)
Parse Arg text,color,mode
If mode=nul Then second='Press Y for Yes or any other key for No.'
 Else second='Press any key to continue.'
width=6+Length(text)
If width<46 Then width=46
column=1+((80-width)%2)
If boops Then Call Sound 600,.2
handle=W_Open(10,column,7,width,(color+8)*16)
Call W_Border handle,1,1,1,1
Call W_ScrWrite handle,3,4,Center(text,width-6)
Call W_ScrWrite handle,5,4,Center(second,width-6)
pressed=Upper(InKey())
Call W_Close handle
Call CursorType ,,0
If pressed<>'Y' Then pressed='N'
Return pressed






KillAll:
Procedure Expose (global)
Parse Arg spec
Call SysFileTree loadsdir||spec,'dummy.','FO'
Do i=1 To dummy.0
   if dummy.i=loadsdir||'SEARCH.HTM' then iterate
  Call DosDel dummy.i
End
Return


SendLine:
Procedure Expose (global)
Parse Arg tosend,socket
data=tosend||crlf
Do Forever
  If SockSend(socket,data)=Length(data) Then Leave
   Else
    Do
      pressed=PopUp('Failure sending command line.  Retry?',1,nul)
      If pressed='N' Then Call ItQuits 'Fatal error trying to send to server.',-8
    End
End
Return


ShowHeader:
Procedure Expose (global)
Call FileRead loadsdir'IMG.REF','dummy.'
head.0=0
j=0
done=0
Do i=1 To dummy.0
  j=j+1
  If j>18 Then
    Do
      done=1
      j=18
      dummy.j=Center('[Image text overflowed allowed space--not all shown]',80)
    End
  If done Then Leave
  If Length(dummy.i)<=80 Then head.j=dummy.i
   Else
    Do
      head.j=Left(dummy.i,80)
      inset=1+Pos(':',dummy.i)
      balance=SubStr(dummy.i,81)
      allowed=79-inset
      Do While balance<>nul
        j=j+1
        head.j=Copies(' ',inset)||Left(balance,allowed)
        balance=SubStr(balance,1+allowed)
      End
    End  
End
head.0=j
max=5+head.0
temp=W_Open(2,1,max,80,112)
Call W_ScrWrite temp,max-2,1,Center('(Press any key to dismiss image text.)',80)
Call W_ScrWrite temp,max,1,Copies(':',80)
row=1
Do line=1 To head.0
  row=row+1
  Call W_ScrWrite temp,row,1,head.line
End
Call InKey
Call W_Close temp
Call CursorType ,,0
Return


SaveIt:
Procedure Expose (global)
Parse Arg serial
temp=W_Open(10,1,7,80,95)
Call W_Border temp
Call W_ScrWrite temp,3,2,Center('Enter the save-file name (or press <Esc> to abort):',78)
saveas=W_Get(temp,5,2,78,savesdir,15)
Call W_Close temp
Call CursorType ,,0
If saveas<>nul Then
  Do
    If ValidName(saveas) Then
      Do
        testdir=FileSpec('Drive',saveas)||Strip(FileSpec('Path',saveas),'T','\')
        If DosIsDir(testdir) Then 
          Do
            If DosIsFile(saveas) Then 
              Do
                If PopUp('File exists; append?',6)='Y' Then howto='A'
                 Else howto='R'
              End
             Else howto='R'
            /*ec=DosCopy(loadsdir'IMAGE.TXT',saveas,howto)*/
             ec=DosCopy(loadsdir'ARTICLE.TXT',saveas,howto)
            If ec<>0 Then Call PopUp 'Save failed! (rc='ec')',4,'X'
             Else 
               Do
                 If boops Then Call Sound 1200,.1
               End
          End
         Else Call PopUp 'That directory does not exist!  (Not saved.)',3,'X'
      End
     Else Call PopUp 'That is not a valid filespec! (Not saved.)',3,'X'
  End
Call CursorType ,,0
Return




GetALine:
Procedure Expose (global)
Parse Arg socket
buffer=nul
Do While Pos(crlf,buffer)=0
  rc=SockRecv(socket,'data',8000)
  If rc<>-1 Then buffer=buffer||data
End
cut=Pos(crlf,buffer)
If cut>0 Then 
  Do
    got=SubStr(buffer,1,cut-1)
    buffer=SubStr(buffer,cut+2)  /*  keep any excess for later  */
  End
 Else got='### BAD RECEIVE ###'
Return got


LineValue:
Procedure Expose (global)
Parse Arg linevalue
start=Pos(':',linevalue)
linevalue=Strip(SubStr(linevalue,start+1))
Return linevalue


LongMessage:
Procedure Expose (global)
Parse Arg meaning
temp=W_Open(12,1,3,80,79)
Call W_ScrWrite temp,2,1,meaning
Call InKey
Call W_Close temp
Call CursorType ,,0
Return


GoodBye:
Procedure Expose (global)
Parse Arg socket
Call SendLine 'QUIT',socket
Call ScrWrite 25,1,Center('Logging off 'poster'.',80),,,31
got=GetALine(socket)
got=SockSoClose(socket)
If got=-1 Then Call PopUp 'Error closing socket!',4,'X'
Return got



/*   Help Screens:  */

ShowHelp:
Procedure Expose (global)
temp=W_Open(2,1,24,80,31)
Call W_Border temp
Call W_ScrWrite temp,24,2,Center('(Press any key to dismiss this help screen.)',78,'Í')
/*                                      ----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8  */
Select
  /*  Pick an Article:  */
  When help=3 Then
    Do
      Call W_ScrWrite temp, 5,2,Center('You can use the <PgDn>, <PgUp>, <Home>, and <End> keys',78)
      Call W_ScrWrite temp, 7,2,Center('to display more choices (if there are more).',78)
      Call W_ScrWrite temp,10,2,Center('Press any letter shown to see that specific article.',78)
      Call W_ScrWrite temp,16,2,Center('Press the <Esc> key to select another group in this interest cluster.',78)
    End
  /*  View an Article:  */
  When help=6 Then
    Do
      Call W_ScrWrite temp, 5,2,Center('You can use the <PgDn>, <PgUp>, <Home>, and <End> keys',78)
      Call W_ScrWrite temp, 6,2,Center('to see more text (if there is more).',78)
      Call W_ScrWrite temp, 10,2,Center('You can use the LeftArrow and RightArrow cursor keys.',78)
      Call W_ScrWrite temp, 14,2,Center('to shift the display sideways if text is off-screen.',78)
      Call W_ScrWrite temp,16,2,Center('Press Alt-S to save this article to a specific file.',78)
      Call W_ScrWrite temp,18,2,Center('Press Alt-I to see image text: a list of any images',78)
      Call W_ScrWrite temp,22,2,Center('Press the <Esc> key to return to selecting articles.',78)
    End
  /*  Select a Task:  */
  When help=8 Then
    Do
      Call W_ScrWrite temp, 8,2,Center('You must be online to use this Program to view any articles ',78)
      Call W_ScrWrite temp, 10,2,Center('B allows you to browse all available news headlines from local file',78)
      Call W_ScrWrite temp,12,2,Center('D allows a search of all news headlines by loading a new list of articles',78)
      Call W_ScrWrite temp,16,2,Center('Press the <Esc> key to completely exit the Reader.',78)
    End
  Otherwise
    Do
      Call W_ScrWrite temp,12,2,Center('No context-sensitive help is available for this screen.',78)
    End
End
Call InKey
Call W_Close temp
Call CursorType ,,0
Return



/*   Exit Routines:  */

SYNTAX:
which=rc
where=sigl
Do 3
  Call Sound 500,.2
  Call Sound 200,.1
End
Call ScrClear
Call ScrWrite  1,1,Center('A SYNTAX Trap has occurred!',80),,,79
Call ScrWrite  6,1,Center('The error was in Line #'where', which reads:',80),,,63
Call ScrWrite 14,1,Center('The short error description for Rexx Error #'which' is:',80),,,63
Call ScrWrite 15,1,Center(ErrorText(which),80)
Call ScrWrite 25,1,Center('Operation cannot continue--press any key to exit.',80),,,79
Call ScrWrite  7,1,ShowLine(where)
Call Inkey
Call ItQuits 'Syntax Error 'which' on Line 'where'.',-9


HALT:
where=sigl
Do 3
  Call Sound 500,.2
  Call Sound 200,.1
End
Call ScrClear
Call ScrWrite  1,1,Center('A HALT has occurred!',80),,,79
Call ScrWrite 10,1,Left('The Halt occurred while in Line #'where', which reads:',80),,,63
Call ScrWrite 11,1,ShowLine(where)
Call ScrWrite 25,1,Center('Operation cannot continue--press any key to exit.',80),,,79
Call Inkey
Call ItQuits 'HALT initiated while on Line 'where'.',-10


ItQuits:
Procedure Expose (global)
Parse Arg message,ec
Call CursorType ,,1
If rexxsock Then Call SockDropFuncs
If quercuswin Then Call W_Deregister
If quercuslib Then Call RexxLibDeregister
If rexxutils Then Call SysDropFuncs
If boops Then 
  Do
    Call Beep 400,200
    Call Beep 200,100
  End
'cls'
Say
Say '   'message
Say
Say
Exit ec


ShowLine:
Procedure Expose (global)
Parse Arg line
Call FileRead homedir'HL_News.CMD','reader.'
text=reader.line
Return text


/* [end] */
