1 Examples:

1.1.1 alarmer.rooProgram

-- alarmer.rooProgram

-- this program processes time of day alarms in 'alarms.asc'
-- the format of an alarm line is:
--  HH:MM . Command
-- lines that begin with a ';' are ignored.

if arg( 1 ) <> '' then
  signal usagemsg

-- the 'alarms' object locates commands associated with a time
--   alarms[ time ] => command

alarms = ^^ map

-- read alarm definitions in 'alarms.asc'

alarmLines = ^^ inLineFile( 'alarms.asc' )

loop ix over alarmLines

  parse value alarmLines[ ix ] with time . cmd

  if left( time, 1 ) = ';' then iterate

  alarms[ time ] = cmd

  say time '==>' cmd

  end 

trace 'Commands'

signal on halt -- exit normally when halt is requested

say 'Press Ctrl+Break to halt...'

do forever

  parse value time() with hh':'mm':'

  now = hh':'mm

  cmd = alarms[ now ] -- get command for time

  if cmd <> '' then do

    say now '==>' cmd
    
    cmd -- perform associated command
	
	alarms ~ removeAt( now )

    if alarms ~ isEmpty then  -- no more alarms ?
      leave 

    say 'Press Ctrl+Break to halt...'

    end 

  call nap 60000 -- take a 1 minute nap

  end 

halt :

exit 0

usagemsg :
  say 'Usage:'
  say '  roo alarmer'
  say 
  say 'Note: alarms are defined in file -- alarms.asc'

1.1.2 asc2html.rooProgram

/* asc2html.rooProgram
 ASC2HTML is a program that converts marked up Ascii text to a HTML file

Usage:
 roo asc2html [options] < infile > outfile.htm

 'infile' is an Ascii text file that is marked up using the legend shown below.

 'options' is one of:
  /?                  => show usage message
  /H[elp]             => show usage message (1st two characters suffice)
  /N[umberHeadings]   => number heading levels, i.e. 1.3.4.1

Example:
 roo asc2html < roo.asc > roo.htm

Returns:
 0 => success
 non-0 => error (invalid option, or empty input file)

Note:

 The asc2html program is a very helpful program for rapidly preparing
 simple HTML files. Many of the HTML files that are provided by
 Kilowatt Software were prepared by this program! For example, the
 roo!(TM) User's Guide was prepared by converting the
 roo.asc file to the roo.htm web page!

 You can study the roo.asc file to gain an understanding of how various
 Ascii markup triggers are used to compose the resulting HTML file.

 You should expect to spend a little time learning how to markup Ascii
 files initially. After a short learning period you will be able to
 prepare HTML files quickly. If you encounter any stumbling blocks
 you can send an e-mail to support@kilowattsoftware.com for assistance.

Legend:

 Input lines are marked up as follows:

  CoRest
  ^^^
  |||
  123

  C      :  main formatting trigger (1st character in line)
  o      :  optional trigger (used with '+' and '`' triggers only) (2nd character in line)
  Rest   :  text to format (starts in column 3, and proceeds for remainder of line)

 Main formatting trigger -- ch[1]:

    ; remarkLine -- ignored

    ' ' untriggered line

    < HTML text written as-is

    I ascFileName -- Imbed marked up ascFileName

    @ preformattedFileName -- imbed preformatted file -- Rexx program, etc.

    ` commandLine -- writes output of command line
    `u commandLine -- writes output of command line, UNFORMATTED

    ~ Begin escaped section -- script, etc
    . End escaped section

    + HeadingText
    - ends a heading level

    a urlTarget anchorText

    A spotText anchorText

    b break [followed by optional text]

    c centeredText

    i imageSrc rest

    p paragraph break [followed by optional text]

    r horizontal return [followed by optional text]

    v singleLine <DIV> ... </div>

      /* lists and tables */

    D starts a definition list
    O starts an ordered list
    U starts an unordered list
    T starts a table
    x starts an indented box of arbitrary width
    X starts a box that is 80% as wide as the browser window

    / ends a list, or table, or box

    l ListItemText -or- tableItem^tableItem^...  /* table columns are delimited by carets */
                                                 /* long table lines can be continued by a trailing ' +' */

    h tableHeader^tableHeader^...                /* table headers are delimited by carets */

    L BoldListItemText

    d DefinitionText

    t DefinitionTermText

    z => omit 'Last Updated ...' line at end
*/

    /* process 'options' */

arg options +2 .

    /* process 'help requests' */

if either( options, '/H', '/?' ) then
  call usagemsg    /* and exit! */

    /* validate 'options' */

if options <> '' & options <> '/N' then
  call usagemsg "Unrecognized program option: " arg(1)

enumerateHeadings = ( '/N' = options )    /* set optional enumerateHeadings boolean */

    /* show message that indicates default input stream is being read
     * in case, a redirected input file is not provided
     */

call lineout !, "Asc2Html: reading input..."

    /* assert input file has lines to process */

if lines() = 0 then
  call usagemsg "The input file is empty"

    /* initialize controls */

heading = 0        /* heading depth */

level. = 0        /* active heading level for each depth */

listtype = ''    /* 1st character indicates active list or table type */

escaped = 0        /* escape section active boolean indicator */

topLine = 0     /* 1 => top line within box */

showLastUpdatedLine =  1  /* 1 => show 'Last Updated ...' line at end */

addTabLinks = pos( 'PRESENTATION', translate( stream( '', 'C', 'chdir' ) ) ) > 0

topOptions = strip( linein() )

do while right( topOptions, 2 ) = ' +'
  topOptions = substr( topOptions, 1, length( topOptions ) - 2 ) ,
       || strip( linein() )
  end 

parse var topOptions title '^' metaKeywords '~' bodyOptions

    /* write HTML heading section
     *  the 1st input line is the HTML file's title
     */

say '<HTML>'
say '<HEAD>'
say '<TITLE>' strip( title ) '</TITLE>'
if metaKeywords <> '' then
  say '<META  name="keywords" content="'metaKeywords'">'
say '<link rel=stylesheet type="text/css" HREF="kwsw.css">'
say '</HEAD>'

if bodyOptions <> '' then
  say '<BODY' bodyOptions'>'
else 
  say '<BODY background=backgrnd.gif bgcolor=LIGHTSTEELBLUE>'

call processLines ''

    /* write HTML conclusion section */
say '<p>'

if showLastUpdatedLine then
  say '<p><center><i>Last updated on:' date()'</center><p>'

say '</BODY>'
say '</HTML>'

exit 0    /* exit with code 0 => success */

processLines  :  /* procedure EXPOSEALL ! */

    /* process input lines */

do lines( arg(1) )

  lin = linein( arg(1) )    /* get another input line */

    /* process escaped text
     *  escaped text is triggered by a line that begins with a tilde (~)
     *  it concludes with a line that begins with a period (.)
     *  all text between these two lines is written as-is
     */

  if escaped then do
    if lin = '.' then
      escaped = 0        /* end of escaped text */

    else if lin = ';beginSyntax' | lin = ';endSyntax' then iterate
    
    else do
        
      if left( translate( lin ), 6 ) = '</PRE>' then
        escaped = 0 /* implicit escape conclusion ! */
    
      say lin            /* write text as-is */
      
      end 

    end 

  else if lin = '' then
    say '<p>'            /* empty lines indicate paragraph separation */

  else do

        /* other input lines are marked up as follows:
         *  ch[1]    : main formatting trigger
         *  ch[2]    : an optional formatting trigger (used with '+' heading trigger only)
         *  rest    :  text to format
         */

    parse var lin ch +1 +1 rest
    rest = strip( rest, 'T' )

        /* process line by main formatting trigger */

    select 

      when ch = ' ' then                    /* untriggered line */
        say rest

      when ch = 'l' then do                    /* list, table, or box row */

        if pos( left( listtype, 1 ), 'TX' ) = 0 then /* HTML list item */
          say '<LI>'rest

        else if left( listtype, 1 ) = 'X' then do /* 'X' => box row */
          if topLine then
            say '&nbsp;'rest
          else 
            say '<BR>&nbsp;'rest
          topLine = 0
          end 

        else do                                /* 'T' => table row */

          /* table rows can be lengthy, so allow continuation with ' +' at end of stripped line */

          do while right( rest, 2 ) = ' +'
            rest = substr( rest, 1, length( rest ) - 2 ) ,
                   || '<br>'strip( linein( arg(1) ) ) /* an implicit <br> tag is also added */
            end 

          say '<TR>'
          do while rest <> ''
            parse var rest segment '^' rest    /* table columns are delimited by carets */
            say '<TD valign=top>'segment'</TD>'
            end 
          say '</TR>'
          end 
        end 

      when ch = 'b' then                    /* break */
        say '<BR>'rest

      when ch = 'p' then                    /* paragraph break */
        say '<P>'rest

      when ch = '<' then do                    /* formatted HTML text line */
        upperLin = translate( lin )
        
        if left( upperLin, 5 ) = '<PRE>' then
          escaped = 1 * ( 0 = pos( '</PRE>', upperLin ) ) /* implicit escape ! */

        say lin
        end 

      when ch = '/' then                    /* list, table, or box conclusion */
        if queued() > 0 then do
          listtype = substr( listtype, 2 )    /* reduce active lists or tables */
          parse pull qline                    /* get list or table conclusion line */
          say qline
          end 

      when ch = '~' then                    /* begin escaped section */
        escaped = 1

      when ch = ';' then                    /* commented text */
        iterate 

      when ch = '-' then do                    /* end of heading section */
        call value 'level.' || ( heading + 1 ), 0    /* next level is concluded */
        heading = heading - 1                        /* reduce heading depth */
        end 

      when ch = '+' then do                    /* new heading level */

        ch2 = substr( lin, 2, 1 )            /* non-blank ch[2] => 1st word is a heading id */

        heading = heading + 1                /* increase heading level */
        
        level.heading = level.heading + 1    /* increase heading depth for this level */

        if ch2 = ' ' then                    /* identifier-less heading */
          text = '<H'heading'>'

        else do
          text = '<H'heading
          parse var rest id rest
          text = text 'ID="'id'">'            /* add heading identifier */
          end 

		/* prefix the heading text with a link so that the heading can be a tab target !! */

        if addTabLinks then
          text = text '<a href="#"><small>&#8226;</small></a> ' 

            /* prepare optional heading numbers */

        if enumerateHeadings then do
          number = ''
          do i=heading to 1 by -1
            number = level.i || copies( '.'number, number <> '' )
            end 
          text = text number rest
          end 

        else 
          text = text rest                    /* prepare numberless heading */

        say text '</H'heading'>'
        end 
      
      when ch = 'r' then                    /* horizontal return */
        say '<HR>'rest
      
      when ch = 'L' then                    /* bold list item */
        say '<LI><b>'rest'</b>'
      
      when ch = 'd' then                    /* definition list item */
        say '<DD><b>'rest'</b>'
      
      when ch = 't' then                    /* definition list text */
        say '<DT>'rest

      when ch = 'i' then do                    /* image */
        parse var rest src rest
        say '<IMG SRC="'src'"' rest'>'
        end 

      when ch = 'v' then                    /* division */
        say '<DIV>'rest'</DIV>'

      when ch = 'c' then                    /* centered text */
        say '<center>'rest'</center>'

      when ch = 'a' then do                    /* link */
        parse var rest file rest
        say '<A HREF="'file'">' rest '</A>'
        end 
      
      when ch = 'A' then do                    /* anchor */
        parse var rest spot rest
        say '<A NAME="'spot'">' rest '</A>'
        end 
      
      when ch = 'D' then do                    /* new definition list */
        say '<ul><DL' rest'>'
        push '</DL></ul>'
        end 
      
      when ch = 'U' then do                    /* new unordered list */
          listtype = 'U'listtype
        say '<UL' rest'>'
        push '</UL>'
        end 
      
      when ch = 'O' then do                    /* new ordered list */
        listtype = 'O'listtype
        say '<OL' rest'>'
        push '</OL>'
        end 
      
      when ch = 'T' then do                    /* new table */
        listtype = 'T'listtype
        if rest <> '' then
          say '<ul><TABLE' rest'>'
        else 
          say '<ul><TABLE border=1>'
        push '</TABLE></ul>'
        end 
      
      when ch = 'x' then do                    /* new box */
        listtype = 'X'listtype
        if rest <> '' then
          say '<ul><TABLE border=1 cellspacing=5' rest'><TR><TD>'
        else 
          say '<ul><TABLE border=1 cellspacing=5><TR><TD>'
        push '</TD></TR></TABLE></ul>'
        topLine = 1
        end 
            
      when ch = 'X' then do                    /* new box */
        listtype = 'X'listtype
        if rest <> '' then
          say '<ul><TABLE border=1 cellspacing=5 width=80%' rest'><TR><TD>'
        else 
          say '<ul><TABLE border=1 cellspacing=5 width=80%><TR><TD>'
        push '</TD></TR></TABLE></ul>'
        topLine = 1
        end 

      when ch = 'h' then do                    /* table header row */
        say '<TR>'
        do while rest <> ''
          parse var rest segment '^' rest    /* table headers are delimited by carets */
          say '<TH>'segment'</TH>'
          end 
        say '</TR>'
        end 

      when ch = 'I' then do
        call lineout !, 'Imbedding' rest '...'
        call processLines rest              /* imbed fileName */
        end 

      when ch = '@' then do
        heading = heading + 1                /* increase heading level */
        level.heading = level.heading + 1    /* increase heading depth for this level */

        call lineout !, 'Imbedding, preformatted:' rest '...'
        call imbedPreformattedLines rest              /* imbed fileName */

        call value 'level.' || ( heading + 1 ), 0    /* next level is concluded */
        heading = heading - 1                        /* reduce heading depth */
        end 

      when ch = '`' then do /* backquote -- command output */
        formatted = translate( substr( lin, 2, 1 ) ) <> 'U'
        newstack 
        rest '(stack'
        if queued() > 0 then do
          if formatted then
            say '<pre>'
          do queued()
            parse pull qline
            if formatted then
              call charout , '<br>'
            say qline
            end 
          if formatted then
            say '</pre>'
          end 
        delstack 
        end 

      when ch = 'z' then
        showLastUpdatedLine = 0
      
      otherwise 
          say rest                            /* whatever */
      end 
    end 
  end 

  if arg(1) <> '' then
    call lineout arg(1)               /* close the file */

  return /* processLines */

imbedPreformattedLines  :  /*procedure*/
  say '<hr width=20 align=left>'
  say '<a name='arg(1)'>'

  text = '<H'2'>' /* instead of 2, 'heading' could be specified */

  if enumerateHeadings then do
    number = ''
    do i=heading to 1 by -1
      number = level.i || copies( '.'number, number <> '' )
      end 
    text = text number
    end 

  if pos( '\', arg(1) ) > 0 then
    say text substr( arg(1), 1 + lastpos( '\', arg(1) ) ) || '</H'2'>' /* instead of 2, 'heading' could be specified */
  else 
    say text arg(1) || '</H'2'>' /* instead of 2, 'heading' could be specified */

  keywords = 'ADDRESS ARG CALL CATCH CLASS DO DROP ELSE END EXIT FINALLY IF INTERPRET ITERATE THEN LEAVE LOOP METHOD',
             'NOP NUMERIC ! OPTIONS OTHERWISE PARSE PROCEDURE PULL PUSH QUEUE RETURN SAY SELECT SIGNAL TRACE WHEN',
             'LOCAL SHARED STATIC',
             'NEWSTACK DELSTACK MAKEBUF DROPBUF'

  say '<ul>'
  say '<pre>'
  
  do lines( arg(1) )

    lin = convertToSafeHtml( linein( arg(1) ) ) /* get another input line */

    -- add coloration of special characters

    if verify( lin, '~^{}', 'Match' ) > 0 then do

      before =  { '~', '^^', '^ ', '{', '}' }

      after = { '<span class=special>~</span>', '<span class=special>^^</span>', '<span class=special>^</span> ', '<span class=special>{</span>', '<span class=special>}</span>' }

      loop ix over before
        lin = changestr( lin, before[ ix ], after[ ix ] )
        end 
      end 

    parse var lin before ':' after

    if after <> '' & 1 = words( before ) then
      say '<b><span style="color: green">'before'</span> :</b>' after

    else if pos( translate( word( lin, 1 ) ), keywords ) > 0 then do
      if left( lin, 1 ) = ' ' then
        say copies( ' ', verify( lin, ' ', 'NoMatch' ) - 1 )'<b><span style="color: mediumblue">'word( lin, 1 )'</span></b>' subword( lin, 2 )
      else 
        say '<b><span style="color: mediumblue">'word( lin, 1 )'</span></b>' subword( lin, 2 )
      end 

else 
      say lin
    end 

  say '</pre>'
  say '</ul>'
  call lineout arg(1) /* close the file ! */
  return 

-- the 'convertToSafeHtml' procedure transforms special HTML characters
-- to their corresponding HTML equivalents

convertToSafeHtml  :  procedure

  s = changestr( arg(1), '&', '&amp;' )

  if verify( s, '<>', 'Match' ) = 0 then
    return s

  -- replace the special XML entities
  -- note: these are special HTML entities also

  before =  { '<', '>' }

  after = { '&lt;', '&gt;' }

  loop ix over before
    s = changestr( s, before[ ix ], after[ ix ] )
    end 
  
  return s

    /* EITHER procedure
     *  determines if 1st argument matches the 2nd or 3rd argument
     */

either  :  procedure
  parse arg term, choice1, choice2
  return term = choice1 | term = choice2

    /* USAGEMSG procedure
     *  shows optional note and usage information
     *  then always exits with a code of 1 => error
     */

usagemsg :

    /* show optional note */

  if arg(1) <> '' then
    call lineout !, arg(1)

  call lineout !, 'Usage:'

  call lineout !, '  roo ASC2HTML [/NumberHeadings] < infile.asc > outfile.htm'

  exit 1

1.1.3 blueMoonGenie.rooProgram

-- blueMoonGenie.rooProgram
-- discovers next blue moon

-- uses 'fullMoon_ice.rooProgram' to determine
-- the date of the Nth full moon after Jan 1, 2000

arg noteType   -- get type of 'note' to display

-- get today's base date

baseDateToday = date( 'Base' )

-- establish 'date' class instance (see date.roo)

nthDate = ^^ date

-- iterate until the next blue moon is discovered

do N=1

  call charout !, '.'      -- let user know program is progressing

  -- get the base date of the Nth full moon
  -- after January 1, 2000

  baseDateOfFullMoonN = fullMoon_ice( N )

  -- analyze full moon with base date
  -- greater than or equal to today's base date

  if baseDateOfFullMoonN >= baseDateToday then do

    -- set date associated with 'date' class instance
    
    nthDate ~ setDate( baseDateOfFullMoonN  )

    -- if the day of the month is greater than 29
    -- then it's a blue moon !
  
    if 29 <  word( nthDate ~ getDate( 'Normal' ), 1 ) then do

      call lineout !, ''

      blueMoonText = nthDate ~ getDate( 'Weekday' )',' nthDate ~ toString

      select 
        when noteType = 'NOTE' then
          ! 'start vuhtml "{The next blue moon is:' blueMoonText'}" note.htm'

        when noteType = 'MARQUEE' then
          ! 'showNote' '"The next blue moon is:' blueMoonText'"'

        otherwise 
          say 'The next blue moon is:' blueMoonText

        end 

      leave 

      end 

    end 

  end 

exit 0

1.1.4 arcCosecantGraph.rooProgram

-- arcCosecantGraph.rooProgram
-- this program prepares the graph of the arcCosecant function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 10

yLimit = 10

graphPropsFile = 'arcCosecantGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# arcCosecantGraph.props -- created by program: arcCosecantGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'colorSet=mediumblue;mediumgreen'
call lineout graphPropsFile, 'lineCount=2'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=ArcCsc X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet1='

do i=-xLimit to 0 by .1
  if math ~ arcCosecant( i ) <> 'undefined' then
    call charout graphPropsFile, i',' || math ~ arcCosecant( i ) || ';'
  end 

call lineout graphPropsFile, ''

call charout graphPropsFile, 'pointSet2='

do i=0 to xLimit by .1
  if math ~ arcCosecant( i ) <> 'undefined' then
    call charout graphPropsFile, i',' || math ~ arcCosecant( i ) || ';'
  end 

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.5 arcCosineGraph.rooProgram

-- arccosineGraph.rooProgram
-- this program prepares the graph of the arccosine function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ math

xLimit = 1

yLimit = 4

graphPropsFile = 'arccosineGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# arccosineGraph.props -- created by program: arccosineGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=ArcCos X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the parabola points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by .05
  if 'undefined' <> math ~ arccosine( i ) then
    call charout graphPropsFile, i',' || math ~ arccosine( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.6 arcCotangentGraph.rooProgram

-- arcCotangentGraph.rooProgram
-- this program prepares the graph of the arcCotangent function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 10

yLimit = 10

graphPropsFile = 'arcCotangentGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# arcCotangentGraph.props -- created by program: arcCotangentGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'colorSet=mediumblue;mediumgreen'
call lineout graphPropsFile, 'lineCount=2'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=ArcCot X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet1='

do i=-xLimit to 0 by .1
  if math ~ arcCotangent( i ) <> 'undefined' then
    call charout graphPropsFile, i',' || math ~ arcCotangent( i ) || ';'
  end 

call lineout graphPropsFile, ''

call charout graphPropsFile, 'pointSet2='

do i=0 to xLimit by .1
  if math ~ arcCotangent( i ) <> 'undefined' then
    call charout graphPropsFile, i',' || math ~ arcCotangent( i ) || ';'
  end 

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.7 arcSecantGraph.rooProgram

-- arcSecantGraph.rooProgram
-- this program prepares the graph of the arcSecant function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 10

yLimit = 10

graphPropsFile = 'arcSecantGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# arcSecantGraph.props -- created by program: arcSecantGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'colorSet=mediumblue;mediumgreen'
call lineout graphPropsFile, 'lineCount=2'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=ArcSec X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet1='

do i=-xLimit to -1 by .1
  if math ~ arcSecant( i ) <> 'undefined' then
    call charout graphPropsFile, i',' || math ~ arcSecant( i ) || ';'
  end 

call lineout graphPropsFile, ''

call charout graphPropsFile, 'pointSet2='

do i=1 to xLimit by .1
  if math ~ arcSecant( i ) <> 'undefined' then
    call charout graphPropsFile, i',' || math ~ arcSecant( i ) || ';'
  end 

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.8 arcSineGraph.rooProgram

-- arcsineGraph.rooProgram
-- this program prepares the graph of the arcsine function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ math

xLimit = 1

yLimit = 2

graphPropsFile = 'arcsineGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# arcsineGraph.props -- created by program: arcsineGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=ArcSin X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by .05
  if 'undefined' <> math ~ arcsine( i ) then
    call charout graphPropsFile, i',' || math ~ arcsine( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.9 arcTangentGraph.rooProgram

-- arcTangentGraph.rooProgram
-- this program prepares the graph of the arcTangent function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ math

xLimit = 10

yLimit = 2

graphPropsFile = 'arcTangentGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# arcTangentGraph.props -- created by program: arcTangentGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=ArcTan X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by .1
  call charout graphPropsFile, i',' || math ~ arcTangent( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.10 audiotext.roo

/* audiotext.roo
 a class that collects stream output to a text value
*/

audiotext  :  class extends outtext -- text is collected by the 'outtext' class

shared text -- 'text' is a shared symbol in the 'outtext' class

emit  :  method

  ! 'WAVE' text -- text is emitted to the 'wave.exe' program.

                -- each word within the text symbol is
                -- considered a .WAV file name,
                -- with an implicit ".WAV" extension.

                -- english text is spoken if the wave file
                -- is a recording of the associated word !

  return ^ self -- an audiotext instance context reference

1.1.11 calc.rex

/* calc.rex -- a Classic Rexx desk calculator
 this program can be executed by any Classic Rexx interpreter

 Keywords
  Numerical calculator, Generic REXX expression calculator,
  INTERPRET example, REXX expression experimentation

 Usage
  roo calc any_REXX_expression

 Arguments
  A REXX expression

 Files used
  Standard output

 Exit codes
   0   => expression performed
 non-0 => usage error

 Input record format
  N/A

 Sample input file
  N/A

 Sample output
  13 ** 47 is: 2.26640520E+52

 Example of use
  [1] roo calc 13 ** 47 ---> 2.26640520E+52
  [2] roo calc dirs('\*')
  [3] roo calc files('*.rex')
  [4] roo calc words('To be, or not to be')

 Explanation
  This procedure is used to compute the value of any REXX
  expression.

  In the examples above,
   [1] Calculates 13 raised to an exponent of 47
   [2] Shows all subdirectories of the root directory
   [3] Shows files matching pattern "*.rex" within the current directory
   [4] Shows the number of words in the quotation

   As simple as this procedure looks it is a highly capable calculator!
*/

if arg(1) = "" | arg(1) = "?" then signal usagemsg

parse arg inargs                      /* acquire requested REXX expression */

if verify( inargs, '()', 'Match' ) > 0 then
  inargs = inargs || optional_paren( inargs )

interpret 'say inargs "is:"' inargs        /* what you get is what you say */

exit 0

usagemsg:
    say "Usage"
    say " roo calc any_REXX_expression"
    say ""
    say " Examples of use"
    say "  [1] roo calc 13 ** 47 ---> 2.26640523E+52"
    say "  [2] roo calc dirs('\*')"
    say "  [3] roo calc files('*.rex')"
    say "  [4] roo calc words('To be, or not to be')"
    exit 1

optional_paren  :  procedure
  arg inargs
  count = 0
  do while inargs <> ''
    p = verify( inargs, '()', 'Match' )
    if p = 0 then leave
    count = count + word( '-1 1', 1 + (substr( inargs, p, 1 ) = ')' ) )
    inargs = substr( inargs, p+1 )
    end 
  return substr( ')', 1, count < 0 )

1.1.12 checksum.rooProgram

-- checksum.rooProgram

parse arg fileName .

if fileName = '' then
  signal usagemsg

-- prepare two bit vectors

checksum = ^^ bitvector ~ resize( 32 ) -- result bit vector

cv = ^^ bitvector ~ resize( 32 )       -- current character bit vector

-- read the entire file to a character vector

bytes = ^^ charactervector( charin( fileName, , chars( fileName ) ) )

loop i over bytes -- process characters 1 at a time

  -- set the current character bit vector.
  -- the current character value shifted leftward 2 bits each cycle.
  -- every 12th cycle the character is not shifted at all

  cv ~ resetAll ~ setMultipleBytes( 25 - ( ( (i-1) // 12) * 2 ), bytes[ i ] )

  -- exclusive or the shifted character value with the result bit vector

  checksum ~ exclusiveOr( cv )

  end 

say c2d( checksum ~ tobytestring ) -- show checksum value in decimal

exit 0

usagemsg :

  ^^ console ~ writeLine( 'Usage:', '  roo checksum nameOfFile' )

1.1.13 commandOutputLines.roo

-- commandOutputLines.roo

-- the commandOutputLines class is
-- an explicit derivative of the
-- vector built-in class.

-- this class performs a command
-- which is passed as the argument
-- of the class constructor.
-- command output lines are converted
-- to vector items. Various aggregate
-- class methods can be used subsequently
-- to process the lines.

-- command output lines can be processed
-- in order as follows:
--  lines = ^^ commandOutputLines( 'dir *.roo' )
--  loop ix over lines
--    process lines[ ix ]
--    end

commandOutputLines  :  class extends vector explicitly

initialize  :  method

  'base' ~ initialize

  newstack 

  ! arg(1) '(stack'

  'base' ~ addSystemQueue

  delstack 

  return ''

1.1.14 copyText.rooProgram

-- copytext.rooProgram

-- this program uses array indexing to copy text lines
-- from default input (stdin) to default output (stdout)

if arg(1) <> '' then
  call usagemsg 'No arguments are expected...'

infile = ^^ inlinefile() -- default input

outfile = ^^ outlinefile() -- default output

loop lno over infile
  
  outfile[ lno ] = infile[ lno ]

  end lno

exit 0

usagemsg :

  if arg(1) <> '' then
    ^^ console ~ writeLine( arg( 1 ), '' )

  ^^ console ~ writeLine( 'Usage:', '  roo copytext < infile > outfile' )
    
  exit 1

1.1.15 cosecantGraph.rooProgram

-- cosecantGraph.rooProgram
-- this program prepares the graph of the cosecant function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 10

yLimit = 10

graphPropsFile = 'cosecantGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# cosecantGraph.props -- created by program: cosecantGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=Csc X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the parabola points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by .1
  if math ~ cosecant( i ) <> 'undefined' then
    call charout graphPropsFile, i',' || math ~ cosecant( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.16 cosineGraph.rooProgram

-- cosineGraph.rooProgram
-- this program prepares the graph of the cosine function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ math

xLimit = 10

graphPropsFile = 'cosineGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# cosineGraph.props -- created by program: cosineGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='1
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=Cosine X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' 1

-- add the points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by .1
  call charout graphPropsFile, i',' || math ~ cosine( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.17 cotangentGraph.rooProgram

-- cotangentGraph.rooProgram
-- this program prepares the graph of the cotangent function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 10

yLimit = 10

graphPropsFile = 'cotangentGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# cotangentGraph.props -- created by program: cotangentGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=Cot X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the parabola points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by .1
  if math ~ cotangent( i ) <> 'undefined' then
    call charout graphPropsFile, i',' || math ~ cotangent( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.18 csv2xml.rooProgram

/* csv2xml.rooProgram

 usage:
  roo CSV2XML inFile.csv

 description:
  the CSV2XML program converts a comma-separated value file (CSV) to a corresponding XML file

 assumptions:
  the 1st line of the CSV file contains column tags
  remaining lines contain column values

 remarks:

  1. the root tag is derived from the CSV file name

  2. spaces in column names are replaced with underscores, to conform with XML requirements
*/

con = ^^ console

-- validate input file name argument

if arg( 1 ) = ''  then
  call usagemsg 'One argument is expected: the name of the CSV file to process'

csvFile = ^^ file( arg( 1 ) ) -- get CSV file name

if \ ( csvFile ~ exists ) then
  call usagemsg 'File' arg(1) 'does not exist.'

if csvFile ~ isDirectory then
  call usagemsg arg(1) 'is the name of a directory, not a file.'

con ~ writeLine( "Processing CSV file:" csvFile ~ toString )

xmlRootTag = csvFile ~ getName

-- derive output XML file name

outXmlFileName = csvFile ~ getDirectoryPath || '\'xmlRootTag'.xml'

con ~ writeLine( "Preparing XML file:" outXmlFileName )

outXmlFile = ^^ outLineFile( outXmlFileName )

-- prepare a table from a CSV file

inCsvFile = ^^ inLineFile( csvFile )

if inCsvFile ~ size < 1 then
  call usagemsg 'File' csvFile ~ toString 'is empty.'

-- the 1st line in the CSV file contains the table headings

table = ^^ table ~ setHeadings( ^^ vector ~ addDelimitedString( translate( inCsvFile[ 1 ], '_', ' ' ), ',' ) )

-- the remaining lines in the CSV file contains the table row/column values
-- these are assigned to table positions by using the addDelimitedString method

loop ix over inCsvFile

  if ix > 1 then
    table ~ addDelimitedString( inCsvFile[ ix ], ',' )

  end 

-- write the XML file
-- the table ~ toXmlString request, does almost all of the work

outXmlFile ~ writeLine( '<?xml version="1.0" encoding="UTF-8"?>' )
outXmlFile ~ writeLine( '<!--' xmlRootTag 'document -->' )

outXmlFile ~ writeLine( '<'xmlRootTag'>' )

outXmlFile ~ writeLine( table ~ toXmlString( 'table', 'headings', 'heading', 'row' ) )

outXmlFile ~ writeLine( '</'xmlRootTag'>' )

-- done !

exit 0

-- procedure USAGEMSG
-- show usage information, with optional error note

usagemsg :
  con ~ writeLine( 'Note:' arg( 1 ), '' )
  con ~ writeLine( 'Usage:', '  roo CSV2XML aFile.csv' )
  exit 99

1.1.19 date.roo

-- date.roo
-- date class

-- provides functionality similar to the <b>date</b> built-in function,
-- for a specific base date,
-- or for a specific month, day, and year.

shared _baseDate _Mmm _monthName _mm _dd _yy _yyyy _julianDay _dayOfWeek

shared _quadYearDays _centuryDays _quadCenturyDays _daysInMonth _monthOffset _monthOffsetLeap

-- initialization method
-- usage:
--   dateRef = ^^ date( 731306 ) -- establishes information for a specific base date -- Wed,  2 Apr 2003
-- or:
--   dateRef = ^^ date( 4 2 2003 ) -- establishes information for a specific month day and year

-- then, you can get date information as follows:
--   say dateRef ~ getDate( [dateFormat] )
-- where the dateFormat is the same as the parameter of the date built-in function

-- the following shows how to establish a date instance for a day which is two weeks from today
--   dateRef = ^^ date( date( 'B' ) + 2 * 7 ) -- establishes information for the day that is two weeks from today


initialize  :  method

  _quadYearDays    = 1461     -- 4 * 365 + 1

  _centuryDays     = 36524    -- 25 * _quadYearDays - 1

  _quadCenturyDays = 146097   -- 4 * _centuryDays + 1

  _daysInMonth     = { 31, 28, 31, 30, 31,  30,  31,  31,  30,  31,  30,  31 }

  _monthOffset     = { 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334 }

  _monthOffsetLeap = { 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335 }

  return ^ setDate( arg( 1 ) )

toString  :  method
  return ^ getDate

getDate  :  method

  parse upper arg ch +1

  select 
    when words( arg( 1 ) ) > 1 then
      call raiseObjection 'Only 1 argument value is expected. The argument is:' arg( 1 )

    when left( ch'N', 1 ) = 'N' then     -- Normal (default)
      return ( 0 + _dd ) _Mmm _yyyy

    when ch = 'B' then                   -- Base
      return _baseDate

    when ch = 'D' then                   -- Day
      return _julianDay

    when ch = 'E' then                   -- European
      return _dd'/'_mm'/'_yy

    when ch = 'M' then                   -- Month
      return _monthName

    when ch = 'O' then                   -- Ordered
      return _yy'/'_mm'/'_dd

    when ch = 'S' then                   -- Standard
      return _yyyy || _mm || _dd

    when ch = 'U' then                   -- USA
      return _mm'/'_dd'/'_yy

    when ch = 'W' then                   -- Weekday
      return _dayOfWeek

    otherwise 
      call raiseObjection 'Unrecognized argument value. The argument is:' arg( 1 )
  end 

setDate  :  method

  select 

    when arg( 1 ) = '' then
      _baseDate = date( 'Base' )

    when words( arg( 1 ) ) = 1 then do

      dateNumber = arg( 1 )

      if \ datatype( dateNumber, 'WholeNumber' ) then
        return 'Base day must be a positive whole number. The erroneous value is:' dateNumber

      if dateNumber < 1 then
        return 'Base day must be a positive whole number. The erroneous value is:' dateNumber

      _baseDate = dateNumber

      end 

    when words( arg( 1 ) ) = 3 then do
      parse arg month day year

      if \ validMonthAndDay( month, day, year ) then
        return 'Invalid day of month. Expected argument format: mm dd yyyy. The erroneous value is:' arg( 1 )

      if \ validYear( year ) then
        return 'Invalid year. Expected argument format: mm dd yyyy. The erroneous value is:' arg( 1 )

      _baseDate = computeBaseDate( month day year )

      end 

    otherwise 
      return 'Invalid argument. Expected argument format: baseDay# | mm dd yyyy. The erroneous value is:' arg( 1 )
    
    end 

  call computeOtherDateValues
 
  return ''

-- COMPUTEOTHERDATEVALUES procedure
-- computes other date values from base date

computeOtherDateValues  :  procedure

  -- compute: _Mmm _monthName _mm _dd _yy _yyyyy _julianDay _dayOfWeek

  todaysDate = _baseDate

  nQuadCenturies = trunc( todaysDate / _quadCenturyDays )

  todaysDate = todaysDate - nQuadCenturies * _quadCenturyDays

  nCenturies = trunc( todaysDate / _centuryDays )

  if nCenturies = 4 then
    nCenturies = 3

  todaysDate = todaysDate - nCenturies * _centuryDays

  nQuadYears = trunc( todaysDate / _quadYearDays )

  todaysDate = todaysDate - nQuadYears * _quadYearDays

  nYears = trunc( todaysDate / 365 )

  if nYears = 4 then
    nYears = 3

  todaysDate = todaysDate - nYears * 365

  _yyyy = nYears ,
        + 4 * nQuadYears ,
        + 100 * nCenturies ,
        + 400 * nQuadCenturies ,
        + 1

  _yy = right( _yyyy, 2, '0' )

  _julianDay = 0

  isLeapYear = leap( _yyyy )

  do i=1 to 12
    
    monthOffset = _monthOffset[ i ] + ( isLeapYear * ( i > 2 ) )

    if todaysDate < monthOffset then
      leave 

    _mm = i
    
    _julianDay = monthOffset

    end 

  _mm = right( _mm, 2, '0' )

  _dd = todaysDate - ( _monthOffset[ _mm ] + ( isLeapYear * ( _mm > 2 ) ) ) + 1
  
  _julianDay = _julianDay + _dd

  _dd = right( _dd, 2, '0' )

  _Mmm = word( 'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec', _mm )

  _monthName = word( 'January February March April May June July August September October November December', _mm )

  _dayOfWeek = word( "Monday Tuesday Wednesday Thursday Friday Saturday Sunday", 1 + ( _baseDate // 7 ) )

  return 

-- COMPUTEBASEDATE procedure
-- computes base date for a specific month day year

computeBaseDate  :  procedure
  
  parse arg month day year

  thisYear        = year - 1                         -- 0-origin

  nQuadCenturies  = trunc( thisYear / 400 )

  thisYear        = thisYear - 400 * nQuadCenturies

  nCenturies      = trunc( thisYear / 100 )

  thisYear        = thisYear - 100 * nCenturies

  nQuadYears      = trunc( thisYear / 4 )

  thisYear        = thisYear - 4 * nQuadYears

  yearOffset      = nQuadCenturies * _quadCenturyDays ,
                  + nCenturies * _centuryDays ,
                  + nQuadYears * _quadYearDays ,
                  + thisYear * 365

  if leap( year ) then
      return yearOffset + _monthOffsetLeap[ month ] + day - 1

  return yearOffset + _monthOffset[ month ] + day - 1

-- LEAP procedure
-- identify if this year is a leap year (the year 2000 is not a leap year)

leap  :  procedure
  arg yr

  return (yr//4 = 0) & ((yr//100 <> 0) | (yr//400 = 0))   -- after Pope Gregory

-- RANGE procedure
-- validates range of argument

range  :  procedure
  parse arg n, lo, hi
  return n >= lo & n <= hi

-- VALIDMONTHANDDAY procedure
-- ensures month and day are valid

validMonthAndDay  :  procedure
  parse arg month, day, year

  if \ datatype( month, 'WholeNumber' ) then
    return 0

  if \ range( month, 1, 12 ) then
    return 0

  if \ datatype( day, 'WholeNumber' ) then
    return 0

  daysInThisMonth = _daysInMonth[ month ]

  if leap( year ) & ( month = 2 ) then      -- identify if this is a leap month
    daysInThisMonth = daysInThisMonth + 1   -- february has 29 days in a leap year

  if \ range( day, 1, daysInThisMonth ) then
    return 0

  return 1

-- VALIDYEAR procedure
-- ensures year is between 1 and 9999 inclusive

validYear  :  procedure
  year = arg( 1 )

  if \ datatype( year, 'WholeNumber' ) then
    return 0

  if \ range( year, 1, 9999 ) then
    return 0

  return 1

1.1.20 deal.roo

/* deal.roo
 this is the worker class program associated with deal.rooProgram
*/

local hands -- this variable holds 4 hand card values

local image -- a vector of 4 sequences of: 2 3 4 5 6 7 8 9 10 J Q K A

local orderedCards -- this variable is used to sort card values

local suit -- a vector of suit indices -- { 1 .. 4 }

-- initialize method, does everything

initialize  :  method

  -- get ready to deal

  hands = ^^ vector -- actually it is a vector of vectors

  orderedCards = ^^ orderedVector  ~ comparator( 'REVERSE' ) -- prepare card sorting instance

  call prepareCardImages -- prepare image vector

  call prepareSuitIndices -- prepare suit vector

  -- shuffle the cards
  
  cards = ^^ randomSequence( 52, 1, 52, 'Unique' ) ~ join( ' ' ) -- shuffle 52 cards

  -- deal hands

  do i=1 to 52 by 13                     -- get 4 hands
    call getHand subword( cards, i, 13 ) -- get another hand
    end 

  -- display hands

  ^ displayUsingBridgeFormat -- display 4 hands

  -- done !!
  
  return ''

-- the 'displayUsingBridgeFormat' method shows hands in Bridge format

displayUsingBridgeFormat  :  method

  -- show North hand -- which is 4 vectors stored in hands[ 1 ]

  say copies( ' ', 30 ) 'North'

  do i=1 for 4  -- 4 suits per hand

    say copies( ' ', 30 ) ,
      hands[ 1 ][ i ] ~ join( ' ' ) -- one North suit

    end 

  -- show West hand      -- which is 4 vectors stored in hands[ 2 ]
  -- and, show East hand -- which is 4 vectors stored in hands[ 3 ]

  say 'West' copies( ' ', 50 ) 'East'

  do i=1 for 4  -- 4 suits per hand

    say ,
      left( hands[ 2 ][ i ] ~ join( ' ' ) , 55 ),  -- one West suit
      hands[ 3 ][ i ] ~ join( ' ' )                -- one East suit

    end 

  -- show North hand -- which is 4 vectors stored in hands[ 4 ]

  say copies( ' ', 30 ) 'South'

  do i=1 for 4  -- 4 suits per hand

    say copies( ' ', 30 ) ,
      hands[ 4 ][ i ]  ~ join( ' ' ) -- one South suit

    end 

  return ''

-- the 'getHand' procedure prepares a hand of cards

getHand  :  procedure

  thisHand = ^^ vector  -- a hand is a vector of suit vectors

  -- a hand contains 4 suit vectors.
  -- start each vector with a suit image.

  -- a Windows command window shows decimal 3..6 as card suit images,
  -- in the order 6, 3, 4, 5

  thisHand ~ add( ^^ vector( d2c( 6 ) ) )   -- spades
  thisHand ~ add( ^^ vector( d2c( 3 ) ) )   -- hearts
  thisHand ~ add( ^^ vector( d2c( 4 ) ) )   -- diamonds
  thisHand ~ add( ^^ vector( d2c( 5 ) ) )   -- clubs

  -- sort cards in this hand, numerically, from highest to lowest

  orderedCards ~ removeAll ~ addDelimitedString( arg( 1 ), ' ' )

  -- arrange cards by suit

  loop i over orderedCards                           -- process cards in this hand

    card = orderedCards[ i ]                         -- get a card

    thisHand [ suit[ card ] ] ~ add( image[ card ] ) -- add card to this hand
                                                     -- suit[ card ] assigns suit
                                                     -- image[ card ] assigns image

    end 

  hands ~ add( thisHand )   -- add this 'hand' to the vector of hands

  return -- getHand

-- the 'prepareCardImages' procedure
-- prepares a vector which has four copies of: 2 3 4 5 6 7 8 9 10 J Q K A
-- these are the displayed card images

prepareCardImages  :  procedure
  image = ^^ vector ~ addDelimitedString( copies( '2 3 4 5 6 7 8 9 10 J Q K A ', 4 ), ' ' )
  return 

prepareSuitIndices  :  procedure
  suit = ^^ vector ~ addDelimitedString( copies( '1 ', 13 ), ' ' ) ,
                   ~ addDelimitedString( copies( '2 ', 13 ), ' ' ) ,
                   ~ addDelimitedString( copies( '3 ', 13 ), ' ' ) ,
                   ~ addDelimitedString( copies( '4 ', 13 ), ' ' )
  return 

1.1.21 deal.rooProgram

/* deal.rooProgram -- deals 52 cards to 4 hands
 usage
  roo deal

 this is the external roo program that processes the command line

 no arguments are expected

 the 'deal.roo' class file does the actual processing
*/

if arg(1) <> '' then
  signal usagemsg

^^ deal -- deal a hand !

exit 0

/* usage information */

usagemsg :

  ^^ console ~ writeLine( '', 'No arguments are expected', '', 'Usage', '  roo deal' )

1.1.22 dir2csv.rooProgram

-- dir2csv.rooProgram

-- prepares a summary of the current directory as a comma-separated value (CSV) file

-- usage:
--  roo dir2csv [pattern] > directoryFiles.csv

-- the file can be subsequently converted to HTML or XML by csv2html or csv2xml respectively
--  i.e. roo dir2csv [pattern] | csv2html Files > directoryFiles.htm ; vuHtml directoryFiles.htm

say 'File,Date,Time,Size,Read/Write'

fileVector = ^^ folder ~ getFiles( arg(1) )

loop ix over fileVector
  file = fileVector[ ix ]
  say file ~ GetNameAndExtension','translate(  file ~ toDetailedString, ',,', '- ' )
  end 

1.1.23 extroo.rooProgram

/* ExtRoo.rooProgram
 this is a program that executes within roo.dll

 it is invoked by testRooDll.cpp
 which is a C++ program.
*/

-- gather arguments in a vector

vec = ^^ vector

do i=1 for arg()
  vec ~ add( arg(i) )
  end 

say 'extroo, received arguments:' vec ~ toString -- show comma separated arguments

call callback 'ExtRoo_arg1', 'ExtRoo_arg2', 'ExtRoo_arg3' -- call the 'callback' function !

return "so long -- from ExtRoo.rooProgram" -- return a final value

1.1.24 folie.rooProgram

-- folie.rooProgram

-- this program prepares a graph of Descartes' folie
-- the equation is:
--   x^3 + y^3 - 3 x y = 0
-- this is transformed to:
--   x^3 - 3 x y + y^3 = 0

-- the rootFinder.rooProgram discovers the polynomial roots
-- of the 2nd equation above,
-- for values of y ranging from -10 to 10.
-- imaginary roots are discarded !

-- there are 4 segments to plot:
--  1. the 2nd quadrant, when x < 0, and y > 0
--  2. the 1st quadrant, when x > 0, and x < y
--  3. the 1st quadrant, when x > 0, and x > y
--  4. the 4th quadrant, when x > 0, and y < 0

-- in the initial pass the roots are discovered,
-- and stored in a map.

map_y_to_roots = ^^ map

yLimit = 5

do y=-yLimit to yLimit by .1

  coeffs = '1,0,' || ( 0 - ( 3 * y ) ) || ',' || ( y * y * y )

  ! 'roo rootFinder' coeffs '(stack'

  if rc <> 0 then iterate -- ignore singularities

  -- the roots are now in the external data queue

  roots = ''

  do queued()
    parse pull root
    if pos( 'i', root ) = 0 then
      roots = roots','root
    end 

  if y > 0 & y < 2 then
    say 'y' y '=> roots' strip( roots, 'L', ',' )

  map_y_to_roots ~ add( y, strip( roots, 'L', ',' ) )

  end 

-- a few extra points are needed between 1.4 and 1.6

do y=1.4 to 1.8 by .05

  coeffs = '1,0,' || ( 0 - ( 3 * y ) ) || ',' || ( y * y * y )

  ! 'roo rootFinder' coeffs '(stack'

  if rc <> 0 then iterate -- ignore singularities

  -- the roots are now in the external data queue

  roots = ''

  do queued()
    parse pull root
    if pos( 'i', root ) = 0 then
      roots = roots','root
    end 

  if y > 0 & y < 2 then
    say 'y' y '=> roots' strip( roots, 'L', ',' )

  map_y_to_roots ~ add( y, strip( roots, 'L', ',' ) )

  end 

graphPropsFile = 'folieGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# folieGraph.props -- created by program: folie.rooProgram'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='yLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=X : -'yLimit '..' yLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the 'folie' points

call charout graphPropsFile, 'pointSet='

--  1. plot the 2nd quadrant, when x < 0, and y > 0

do y=yLimit to 0 by -.1
  root = split( map_y_to_roots[ y ], ',' )
  loop ix over root
    if root[ ix ] < 0 then do
      if abs( root[ ix ] ) < yLimit then
        call charout graphPropsFile, root[ ix ]','y';'
      leave 
      end 
    end 
  end 

call charout graphPropsFile, '0,0;'

--  2. plot the 1st quadrant, when x > 0, and x > y

do y=0 to 1.8 by .05
  root = split( map_y_to_roots[ y ], ',' )
  loop ix over root
    if root[ ix ] > 0 & root[ ix ] >= y then do
      call charout graphPropsFile, root[ ix ]','y';'
      leave 
      end 
    end 
  end 

--  3. plot the 1st quadrant, when x > 0, and x < y

do y=1.8 to 0 by -.05
  root = split( map_y_to_roots[ y ], ',' )
  loop ix over root
    if root[ ix ] > 0 & root[ ix ] <= y then do
      call charout graphPropsFile, root[ ix ]','y';'
      leave 
      end 
    end 
  end 

--  4. plot the 4th quadrant, when x > 0, and y < 0

do y=0 to -yLimit by -.1
  root = split( map_y_to_roots[ y ], ',' )
  loop ix over root
    if root[ ix ] > 0 then do
      if root[ ix ] < yLimit then
        call charout graphPropsFile, root[ ix ]','y';'
      leave 
      end 
    end 
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.25 fullMoonGenie.rooProgram

-- fullMoonGenie.rooProgram
-- discovers all of the full moons within the current year

-- uses 'fullMoon_ice.rooProgram' to determine
-- the date of the Nth full moon after Jan 1, 2000

-- get base date of Jan 1 and Dec 31 of this year

year = left( date( 'Standard' ), 4 )

dec31Date = ^^ date( '12 31' year )

dec31BaseDate = dec31Date ~ getDate( 'BaseDate' )

dec31JulianDay = dec31Date ~ getDate( 'Day' )

jan1BaseDate = 1 + dec31BaseDate - dec31JulianDay

-- establish 'date' class instance (see date.roo)

nthDate = ^^ date

-- iterate until the next blue moon is discovered

do N=1

  -- get the base date of the Nth full moon
  -- after January 1, 2000

  baseDateOfFullMoonN = fullMoon_ice( N )

  if baseDateOfFullMoonN < jan1BaseDate then
    iterate 

  if baseDateOfFullMoonN > dec31BaseDate then
    leave 

  -- set date associated with 'date' class instance

  nthDate ~ setDate( baseDateOfFullMoonN  )

  say left( nthDate ~ getDate( 'Weekday' ), 10 ) right( nthDate ~ toString, 11 )

  end 

exit 0

1.1.26 getHostIp.rooProgram

-- getHostIp.rooProgram

-- when an argument is not provided, this program
-- discovers this system's IP address

socket = ^^ socket( 'UDP' )

say socket ~ getHostIp( arg( 1 ) )

1.1.27 getHostName.rooProgram

-- getHostName.rooProgram

-- when an argument is not provided, this program
-- discovers this system's host name

socket = ^^ socket( 'UDP' )

say socket ~ getHostName( arg( 1 ) )

1.1.28 getHtmlKeywords.rooProgram

-- getHtmlKeywords.rooProgram
-- get keywords from HTML source file

-- if found, list them on separate lines, in ascending order

-- return values:
--  0 : keywords were listed
--  1 : some keywords were not found
-- 99 : a usage message was displayed

-- example, on a local disk:
--  roo getHtmlKeywords default.htm

parse arg htmlFileURL

if htmlFileURL = '' then
  call usagemsg 'One argument is expected. The name of the HTML file URL'

if pos( '/', htmlFileURL ) = 0 then do

  -- ensure the file exists in the current directory

  if \ stream( htmlFileURL, 'C', 'Exists' ) then
    call usagemsg 'File URL,' htmlFileURL', does NOT exist in the current directory'

  -- build a local file system URL automatically

  currDisk = stream( '', 'C', 'chdisk' )

  htmlFileURL = 'file:///'currDisk':./'htmlFileURL

  end 

! 'URLGET' htmlFileURL '(stack'

if rc <> 0 then
  call usagemsg 'Could not retrieve HTML file URL' htmlFileURL

htmlFileLines = ^^ vector ~ addSystemQueue

loop ix over htmlFileLines

  parse value lower( htmlFileLines[ ix ] ) with '<meta' 'keywords' 'content="' keywords '"'

  if keywords <> '' then do

    say ^^ OrderedVector ~ addDelimitedString( keywords, ',' ) ~ toDelimitedString( '0a'x )

    exit 0

end 

  end 

exit 1

usagemsg  :  procedure

  if arg(1) <> '' then
    ^^ console ~ writeLine( arg(1), '' )

  ^^ console ~ writeLine( 'Usage:', '  roo getHtmlKeywords htmlFileURL' )

  exit 99

1.1.29 getModuleSizeAndChecksum.rooProgram

-- getModuleSizeAndChecksum.rooProgram

-- this example shows how to extract information
-- from multiple lines that are produced by a command.

-- it uses the 'commandOutputLines.roo' class definition,
-- which is an explicit derivative of the vector built-in class.

-- information in this example is obtained from the Poof!(TM)
-- program named EXEPATH.

parse arg moduleName .

if moduleName = '' then
  call usagemsg	 'Please specify the module name to analyze.'

lines = ^^ commandOutputLines( 'EXEPATH' moduleName )

if lines ~ isEmpty then
  call usagemsg	 'No information was found for module:' moduleName

size = word( lines[ 2 ], 2 )

checksum = word( lines[ 4 ], 2 )

say lines[ 1 ] 'size(' size ') checksum(' checksum ')'

exit 0

usagemsg :

  ^^ console ~ writeLine( arg(1), '', 'Usage:', '  roo getModuleSizeAndChecksum moduleName' )

1.1.30 hanoiStack.roo

/* hanoiStack.roo
 this program holds the 'ring' values
 for the towersOfHanoi.roo class
*/

hanoiStack  :  class extends stack   -- a 'tower of hanoi' is a stack

static nRings -- #rings

local caption -- tower caption .. left, middle, right

preinitialize  :  method
  nRings = value( 'HANOIRINGS', , 'SYSTEM' ) -- initialize the #rings static symbol
  return ''

setCaption  :  method
  caption = arg(1) -- remember the caption
  return caption

-- override the 'top' method
-- return 0 when the top element is fetched
-- from an empty stack !

top  :  method
  if ^ isEmpty then
    return 0
  return 'base' ~ top

getDisplayLines  :  method

  -- show empty part of spindle top

  -- the number of vertical bars
  -- is 1 plus the number of possible rings
  -- minus this tower's size

  vec = split( copies( '| ', 1 + ( nRings - ^ size ) ), ' ' )

  -- show actual rings

  do i = ^ size to 1 by -1

    -- ringWidth = ^ getAt( i )

    vec ~ add( '[' copies( '. ', ^ getAt( i ) )']' ) -- show a ring
    
    end 

  -- show base

  vec ~ add( copies( '=', 16 ) ) -- show tower base

  vec ~ add( caption ) -- show tower caption

  return vec

1.1.31 htmlPrefix.rooProgram

/* HtmlPrefix.rooProgram -- an external procedure */

parse arg title

say '<html>'

if title <> '' then do
  say '<head>'
  say '<title>'title'</title>'
  end 

say '<body>'

1.1.32 htmlSuffix.rooProgram

/* HtmlSuffix.rooProgram  -- an external procedure */

say '<p><p><center><i>Last updated on:' date()'</center>'
say '</body>'
say '</html>'

1.1.33 htmlnote.roo

/* htmlnote.roo
 a derived class that collects stream output to a text value,
 and displays HTML text, with the VUHTML auxiliary program.

 The text is passed as an argument to the JavaScript
 initialization program within the NOTE.HTM file.
*/

htmlnote  :  class extends outtext -- text is collected by the 'outtext' class

shared text -- 'text' is a shared symbol in the 'outtext' class

emit  :  method

  'start VUHTML' '"{' || text || '}" note.htm' -- show the text
                                               -- using vuhtml.exe
                                               -- which displays note.htm

  return ^ self -- an htmlnote instance context reference

1.1.34 htmltext.roo

/* htmltext.roo
 a derived class that collects stream output to a text value,
 and emits it as HTML text
*/

htmltext  :  class extends outtext -- text is collected by the 'outtext' class

shared attributes -- vector of attributes

shared endTag -- associated HTML end tag

shared tag -- associated HTML tag

shared text -- 'text' is a shared symbol in the 'outtext' class

shared emitTextOnly -- 'emitTextOnly' is a boolean used in this class

initialize  :  method
  attributes = ^^ vector
  tag = 'p'
  endTag = ''
  emitTextOnly = translate( arg(1) ) <> 'COMPLETEFILE' -- set output emission boolean
  return ''

attribute  :  method                            -- add an attribute
  parse arg name, value
  attributes ~ add( name'="'value'"' )
  return ^ self   -- an htmltext instance context reference

setEndTag  :  method                            -- set end tag explicitly
  endTag = arg(1)
  return ^ self   -- an htmltext instance context reference

setTag  :  method
  tag = arg(1)
  if wordpos( translate( tag ), 'P BR' ) = 0 then
    endtag = '</'tag'>'                       -- set end tag implicitly
  return ^ self   -- an htmltext instance context reference

emit  :  method
  
  if emitTextOnly then
    ^^ outstream ~ writeLine( emitText() ) -- show text only

  else do                                  -- prepare a complete HTML file
    out = ^^ outstream
    out ~ writeLine( '<html>' )
    out ~ writeLine( '<body>' )
    out ~ writeLine( emitText() )          -- this is the text
    out ~ writeLine( '</body>' )
    out ~ writeLine( '</html>' )
    end 
  return ^ self   -- an htmltext instance context reference

emitText  :  procedure
  if attributes ~ IsNonEmpty then
    startTag = '<'tag attributes ~ join( ' ' )'>'
  else 
    startTag = '<'tag'>'
  return startTag || text || endTag

1.1.35 hyperbolicCosecantGraph.rooProgram

-- hyperbolicCosecantGraph.rooProgram
-- this program prepares the graph of the hyperbolicCosecant function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 10

yLimit = 2

graphPropsFile = 'hyperbolicCosecantGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# hyperbolicCosecantGraph.props -- created by program: hyperbolicCosecantGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=HypCsc X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by .2
  if 'undefined' <> math ~ hyperbolicCosecant( i ) then
    call charout graphPropsFile, i',' || math ~ hyperbolicCosecant( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.36 hyperbolicCosineGraph.rooProgram

-- hyperbolicCosineGraph.rooProgram
-- this program prepares the graph of the hyperbolicCosine function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 10

yLimit = 20

graphPropsFile = 'hyperbolicCosineGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# hyperbolicCosineGraph.props -- created by program: hyperbolicCosineGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=HypCos X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by 1
  if 'undefined' <> math ~ hyperbolicCosine( i ) then
    call charout graphPropsFile, i',' || math ~ hyperbolicCosine( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.37 hyperbolicCotangentGraph.rooProgram

-- hyperbolicCotangentGraph.rooProgram
-- this program prepares the graph of the hyperbolicCotangent function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 10

yLimit = 2

graphPropsFile = 'hyperbolicCotangentGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# hyperbolicCotangentGraph.props -- created by program: hyperbolicCotangentGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=HypCot X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by .2
  if 'undefined' <> math ~ hyperbolicCotangent( i ) then
    call charout graphPropsFile, i',' || math ~ hyperbolicCotangent( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.38 hyperbolicSecantGraph.rooProgram

-- hyperbolicSecantGraph.rooProgram
-- this program prepares the graph of the hyperbolicSecant function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 10

yLimit = 2

graphPropsFile = 'hyperbolicSecantGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# hyperbolicSecantGraph.props -- created by program: hyperbolicSecantGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=HypSec X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by .2
  if 'undefined' <> math ~ hyperbolicSecant( i ) then
    call charout graphPropsFile, i',' || math ~ hyperbolicSecant( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.39 hyperbolicSineGraph.rooProgram

-- hyperbolicSineGraph.rooProgram
-- this program prepares the graph of the hyperbolicSine function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 10

yLimit = 20

graphPropsFile = 'hyperbolicSineGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# hyperbolicSineGraph.props -- created by program: hyperbolicSineGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=HypSin X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by 1
  if 'undefined' <> math ~ hyperbolicSine( i ) then
    call charout graphPropsFile, i',' || math ~ hyperbolicSine( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.40 hyperbolicTangentGraph.rooProgram

-- hyperbolicTangentGraph.rooProgram
-- this program prepares the graph of the hyperbolicTangent function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 10

yLimit = 2

graphPropsFile = 'hyperbolicTangentGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# hyperbolicTangentGraph.props -- created by program: hyperbolicTangentGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=HypTan X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by 1
  if 'undefined' <> math ~ hyperbolicTangent( i ) then
    call charout graphPropsFile, i',' || math ~ hyperbolicTangent( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.41 in2out.rooProgram

/* in2out.rooProgram
 copy default input stream to default output stream
 
 usage:
   roo in2out < inFile.dat > outFile.dat
*/

if arg(1) <> '' then -- no arguments are expected
  signal usagemsg

-- copy all lines in the default input stream
-- to the default output stream.
-- it's all done in a single source line !

^^ outLineFile( '' ) ~ addAggregate( ^^ inLineFile( '' ) )

-- done !

exit 0

usagemsg :

  ^^ console ~ writeLine( ,
    '.'               , ,
    ''                                         , ,
    'Usage : '                                   , ,
    '   roo in2out < inFile.dat > outFile.dat' )

1.1.42 inverseHyperbolicCosecantGraph.rooProgram

-- inverseHyperbolicCosecantGraph.rooProgram
-- this program prepares the graph of the inverseHyperbolicCosecant function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 10

yLimit = 2

graphPropsFile = 'inverseHyperbolicCosecantGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# inverseHyperbolicCosecantGraph.props -- created by program: inverseHyperbolicCosecantGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=InvHypCsc X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by .2
  if 'undefined' <> math ~ inverseHyperbolicCosecant( i ) then
    call charout graphPropsFile, i',' || math ~ inverseHyperbolicCosecant( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.43 inverseHyperbolicCosineGraph.rooProgram

-- inverseHyperbolicCosineGraph.rooProgram
-- this program prepares the graph of the inverseHyperbolicCosine function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 20

yLimit = 10

graphPropsFile = 'inverseHyperbolicCosineGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# inverseHyperbolicCosineGraph.props -- created by program: inverseHyperbolicCosineGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'colorSet=mediumblue;mediumgreen'
call lineout graphPropsFile, 'lineCount=2'
call lineout graphPropsFile, 'textColor=navy'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=InvHypCos X : '1 '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

/* add the points */

call charout graphPropsFile, 'pointSet1='

do i=1 to xLimit by 1
  if 'undefined' <> math ~ inverseHyperbolicCosine( i ) then
    call charout graphPropsFile, i',' || math ~ inverseHyperbolicCosine( i ) || ';'
  end 

call lineout graphPropsFile, ''

call charout graphPropsFile, 'pointSet2='

do i=1 to xLimit by 1
  if 'undefined' <> math ~ inverseHyperbolicCosine( i ) then
    call charout graphPropsFile, i',' || ( 0 - math ~ inverseHyperbolicCosine( i ) ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.44 inverseHyperbolicCotangentGraph.rooProgram

-- inverseHyperbolicCotangentGraph.rooProgram
-- this program prepares the graph of the inverseHyperbolicCotangent function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 5

yLimit = 5

graphPropsFile = 'inverseHyperbolicCotangentGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# inverseHyperbolicCotangentGraph.props -- created by program: inverseHyperbolicCotangentGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'colorSet=mediumblue;mediumgreen'
call lineout graphPropsFile, 'lineCount=2'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=InvHypCot X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet1='

do i=-xLimit to -1.5 by .1
  if 'undefined' <> math ~ inverseHyperbolicCotangent( i ) then
    call charout graphPropsFile, i',' || math ~ inverseHyperbolicCotangent( i ) || ';'
  end 

do i=-1.45 to -1 by .01
  if 'undefined' <> math ~ inverseHyperbolicCotangent( i ) then
    call charout graphPropsFile, i',' || math ~ inverseHyperbolicCotangent( i ) || ';'
  end 

call lineout graphPropsFile, ''

call charout graphPropsFile, 'pointSet2='

do i=1 to 1.45 by .01
  if 'undefined' <> math ~ inverseHyperbolicCotangent( i ) then
    call charout graphPropsFile, i',' || math ~ inverseHyperbolicCotangent( i ) || ';'
  end 

do i=1.5 to xLimit by .1
  if 'undefined' <> math ~ inverseHyperbolicCotangent( i ) then
    call charout graphPropsFile, i',' || math ~ inverseHyperbolicCotangent( i ) || ';'
  end 

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.45 inverseHyperbolicSecantGraph.rooProgram

-- inverseHyperbolicSecantGraph.rooProgram
-- this program prepares the graph of the inverseHyperbolicSecant function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 2

yLimit = 2

graphPropsFile = 'inverseHyperbolicSecantGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# inverseHyperbolicSecantGraph.props -- created by program: inverseHyperbolicSecantGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'colorSet=mediumblue;mediumgreen'
call lineout graphPropsFile, 'lineCount=2'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=InvHypSec X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet1='

do i=0 to xLimit by .05
  if 'undefined' <> math ~ inverseHyperbolicSecant( i ) then
    call charout graphPropsFile, i',' || math ~ inverseHyperbolicSecant( i ) || ';'
  end 

call lineout graphPropsFile, ''

call charout graphPropsFile, 'pointSet2='

do i=0 to xLimit by .05
  if 'undefined' <> math ~ inverseHyperbolicSecant( i ) then
    call charout graphPropsFile, i',' || ( 0 - math ~ inverseHyperbolicSecant( i ) ) || ';'
  end 

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.46 inverseHyperbolicSineGraph.rooProgram

-- inverseHyperbolicSineGraph.rooProgram
-- this program prepares the graph of the inverseHyperbolicSine function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 10

yLimit = 20

graphPropsFile = 'inverseHyperbolicSineGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# inverseHyperbolicSineGraph.props -- created by program: inverseHyperbolicSineGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=InvHypSin X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by 1
  if 'undefined' <> math ~ inverseHyperbolicSine( i ) then
    call charout graphPropsFile, i',' || math ~ inverseHyperbolicSine( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.47 inverseHyperbolicTangentGraph.rooProgram

-- inverseHyperbolicTangentGraph.rooProgram
-- this program prepares the graph of the inverseHyperbolicTangent function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 1

yLimit = 2

graphPropsFile = 'inverseHyperbolicTangentGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# inverseHyperbolicTangentGraph.props -- created by program: inverseHyperbolicTangentGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=InvHypTan X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet='

do i=-1 to 1 by .05
  if 'undefined' <> math ~ inverseHyperbolicTangent( i ) then
    call charout graphPropsFile, i',' || math ~ inverseHyperbolicTangent( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.48 linearProgram.rooProgram

/* linearProgram.rooProgram

 the 'linearProgram' finds the optimal value
 for a system of linear inequalities.

 an example lineFile is:

  2.5,5,100
  70,50,2100
  2,4,200
  2,10,160
  150,250,R

 the last line establishes the x & y coefficients to
 evaluate at each vertex; i.e. 150 x + 250 y
 The trailing 'R' is ignored.

 the first four lines above establish 4 linear inequalities:

  2.5 x +  5 y <= 100

   70 x + 50 y <= 2100

    2 x +  4 y <= 200

    2 x + 10 y <= 160

 the above inequalities would be the equations of 4 lines,
 if the <= comparison were replaced by an = comparison.

 An example scenario that corresponds to these equations is:

  a. 100 bushels of corn requires 2.5 acres,
     100 bushels of wheat requires 5 acres,
     and there are 100 acres available

  b. 100 bushels of corn requires $70 capital,
     100 bushels of wheat requires $50 capital,
     and the farmer has $2100 available.

  c. 100 bushels of corn requires 2 hours of labor in August,
     100 bushels of wheat requires 4 hours of labor in August,
     and there are 200 hours of labor available in August.

  d. 100 bushels of corn requires 2 hours of labor in September,
     100 bushels of wheat requires 10 hours of labor in September,
     and there are 160 hours of labor available in September.

  e. 100 bushels of corn is worth $150,
     100 bushels of wheat is worth $250,
     so the amount made (R) is:
       $150 x #100 bushels of corn produced
     + $250 x #100 bushels of wheat produced

 the programming logic proceeds as follows:

 1. the intersection of all lines is
    stored in the 'points' vector.

 2. the x & y intercepts of each of the 4 lines is
    added to the 'points' vector.

 3. a vertex in the 'points' vector is disqualified
    if either the x or y value is negative.

 4. a vertex in the 'points' vector is disqualified
    if any of the line inequalities are not satisfied.

 5. the optimal vertex is the one with the largest value of:
     150 x + 250 y

 for the example lineFile shown above, the result is:

  best 5611.11111 -- 24.4444444,7.77777778

 this indicates that an optimal result of 5611.11111
 will be obtained at the vertex 24.4444444,7.77777778
 this is associated with the 'R' value of:
  150 * 24.4444444 + 250 * 7.77777778

 note :  the 'matrixOperation.rooProgram' is used to
 discover the intersection of the lines.
*/

lineFileName = arg( 1 )

-- 2. validate arguments

if lineFileName = '' then
  call usagemsg

if \ ( ^^ file( lineFileName ) ~ exists ) then
  call usagemsg "Line file '"lineFileName"' does NOT exist."

-- points is a set of line intersection vertices

points = ^^ vector

lines = ^^ inLineFile( lineFileName )

tempFile = lineFileName'.temp'

-- find the intersections of all the lines

loop ix over lines
  
  do jx=ix+1 to lines ~ size - 1

    call lineout tempFile, lines[ ix ], 1

    call lineout tempFile, lines[ jx ], 2

    call lineout tempFile -- close the file
    
    'roo matrixOperation' tempFile 'Solve (stack'

    if \ queued() then
      iterate -- skip parallel lines

    parse pull qline
   
    points ~ add( qline )    

    'erase' tempFile
    
    end 
  end 

-- now find all of the x & y intercepts of the lines

do ix=1 to lines ~ size - 1
  parse value lines[ ix ] with  xCoeff ',' yCoeff ',' c

  xIntercept = c / xCoeff

  points ~ add( xIntercept','0 )

  yIntercept = c / yCoeff

  points ~ add( 0','yIntercept )

  end 

-- if you want to analyze the vertices
-- alter the following '0' to '1'

if '0' then do
  say 'vertices'
  say points ~ toDelimitedString( '0a'x )
  end 

best = 0

parse value lines[ lines ~ size ] with xFactor ',' yFactor ','

bestVertex = '?'

do ix=1 to points ~ size

  parse value points[ ix ] with x ',' y

  if x < 0 | y < 0 then iterate -- skip non-positive intersections

  -- the vertex must be tested to see if it is <= all lines

  do jx=1 to lines ~ size - 1
    parse value lines[ jx ] with  xCoeff ',' yCoeff ',' c
    if ( ( x * xCoeff ) + ( y * yCoeff ) ) > c then
      iterate ix
    end 

  v = x * xFactor + y * yFactor

  if v > best then do
    best = max( best, v )
    bestVertex = points[ ix ] 
    end 

  end 

say 'best' best '--' bestVertex

exit 0

-- the 'usagemsg' procedure describes how to use this program

usagemsg  :  procedure

  ^^ console ~ writeLine( arg(1), '', ,
    'Usage : ', '  roo linearProgram lineFile' )

  exit 99

1.1.49 lottery.rooProgram

-- lottery.rooProgram, displays 6 random numbers in the range of 1 to 49.

say ' ' ^^ orderedVector ~ addAggregate( ^^ randomSequence( 6, 1, 49, 'U' ) ) ~ toDelimitedString( '   ' )

1.1.50 make.rooProgram

/* make.rooProgram
 perform directives in a make file script

 usage:
   roo make makeFileName

 remarks in the make file can begin with any of the following characters:
  ; # - /

 an example make file is, assume the :

  ; rebuild java class file, if the source file is newer

  ; assume the following line begins in column 1, without any leading spaces

  ; the following line checks the newness of the class file versus the source file

  ; if the source file is newer, then command(s) on subsequent line(s) that begin with a
  ; space is/are performed

  yourProgram.class yourProgram.java
    javac yourProgram.java

  yourProgram2.class yourProgram2.java
    javac yourProgram2.java

  yourProduct.zip *.class
    erase yourProduct.jar
    erase yourProduct.zip
    args "jar.exe -cf yourProduct.jar" >zz
    fi *.class >>zz
    filecmd <zz
    ren yourProduct.jar yourProduct.zip
    jar.exe -tf yourProduct.zip

 the above make file uses the ARGS, FI, and FILECMD programs that are distributed
 in the Poof!(TM) product.

 this program uses the NEWER program to determine if a series of files are newer than a test file.

 Documentation of the NEWER program can be found in Poof!(TM) distribution files.
*/

parse arg makeFileName

if makeFileName = '' then
  call usagemsg 'One argument is expected. The name of the MAKE file'

if makeFileName = '' | \ stream( makeFileName, 'C', exists ) then
  call usagemsg "File '"makeFileName"' does NOT exist."
  
makeFileLines = ^^ inLineFile( makeFileName )

do ix=1 to makeFileLines ~ size

  -- ignore empty lines, and lines that start with a comment character
  
  if makeFileLines[ ix ] <&amp;gt; '' &amp; pos( left( makeFileLines[ ix ], 1 ), ";#-/" ) = 0 then

    -- newness comparison lines begin with a character in the first position

    if left( makeFileLines[ ix ], 1 ) <&amp;gt; ' ' then do

      'NEWER -Silent' makeFileLines[ ix ]  -- check newness of files

      -- the NEWER program returns 2 if one of the comparison files
      -- is newer than the test file.

      if rc = 2 then do

        -- the command(s) to perform are on the next line(s), beginning with a space

        do ix=ix+1 to makeFileLines ~ size

          if left( makeFileLines[ ix ], 1 ) <&amp;gt; ' ' then
            leave 

          ! makeFileLines[ ix ] -- perform command to rebuild the tested file

          end 

        end 

      end 
  end 

exit 0

usagemsg  :  procedure

  if arg(1) <&amp;gt; '' then
    ^^ console ~ writeLine( arg(1), '' )

  ^^ console ~ writeLine( 'Usage:', '  roo make makeFileName' )

1.1.51 marquee.roo

/* marquee.roo
 a derived class that collects stream output to a text value,
 and displays an HTML text marquee, with the VUHTML auxiliary program.

 The text is passed as an argument to the JavaScript
 initialization program within the MARQUEE.HTM file.
*/

marquee  :  class extends outtext -- text is collected by the 'outtext' class

shared text -- 'text' is a shared symbol in the 'outtext' class

emit  :  method

  'start VUHTML' '"{' || text || '}" marquee.htm' -- show the text
                                                  -- using vuhtml.exe
                                                  -- which displays marquee.htm

  return ^ self -- a marquee instance context reference

1.1.52 mathX.roo

-- mathX.roo
-- extensions to the Math built-in class

-- the related mathXX_ice class (in mathXX_ice.roo) defines the following additional methods

  -- GammaFunction : method
  --   this program computes the value of Gamma( X ) to 10 digits of accuracy.
  --   return Gamma( arg( 1 ) )

  -- lnGammaFunction : method
  --   this program computes the value of lnGamma( X ) to 10 digits of accuracy.
  --   return lnGamma( arg( 1 ) )

-- the mathXX_ice class is implemented as an '_ice' file to comply with copyright
-- requirements of the algorithm's authors.

mathX  :  class extends Math

arcCosecant  :  method
  x = arg(1)
  
  if x = 0 then
    return 'undefined'

  arcsin = ^ arcsine( 1 / x )
  
  if arcsin = 'undefined' then
    return 'undefined'
  
  if x > 0 then
    return arcsin

  return - ^ pi - arcsin

arcSecant  :  method
  x = arg(1)
  
  if x = 0 then
    return 'undefined'

  arccos = ^ arcCosine( 1 / x )
  
  if arccos = 'undefined' then
    return 'undefined'
  
  if x > 0 then
    return arccos

  return - arccos

arcCotangent  :  method
  x = arg(1)
  
  if x = 0 then
    return 'undefined'

  arctan = ^ arcTangent( 1 / x )
  
  if arctan = 'undefined' then
    return 'undefined'
  
  if x > 0 then
    return arctan

  return ^ pi + arctan

cosecant  :  method
  sin = ^ sine( arg( 1 ) )
  if sin <> 0 then
    return 1 / sin
  return 'undefined'

secant  :  method
  cos = ^ cosine( arg( 1 ) )
  if cos <> 0 then
    return 1 / cos
  return 'undefined'

cotangent  :  method
  sin = ^ sine( arg( 1 ) )
  if sin <> 0 then
    return ^ cosine( arg( 1 ) ) / sin
  return 'undefined'

hyperbolicSine  :  method
  x = arg(1)

  return .5 * ( ^ naturalPower( x ) - ^ naturalPower( - x ) )

hyperbolicCosine  :  method
  x = arg(1)

  return .5 * ( ^ naturalPower( x ) + ^ naturalPower( - x ) )

hyperbolicTangent  :  method
  cosh = ^ hyperbolicCosine( arg( 1 ) )
  if cosh <> 0 then
    return ^ hyperbolicSine( arg( 1 ) ) / cosh
  return 'undefined'

hyperbolicCosecant  :  method
  sinh = ^ hyperbolicSine( arg( 1 ) )
  if sinh <> 0 then
    return 1 / sinh
  return 'undefined'

hyperbolicSecant  :  method
  cosh = ^ hyperbolicCosine( arg( 1 ) )
  if cosh <> 0 then
    return 1 / cosh
  return 'undefined'

hyperbolicCotangent  :  method
  sinh = ^ hyperbolicSine( arg( 1 ) )
  if sinh <> 0 then
    return ^ hyperbolicCosine( arg( 1 ) ) / sinh
  return 'undefined'

inverseHyperbolicSine  :  method
  x = arg(1)

  if x >= 0 then
    return ^ naturalLogarithm( x + squareroot( x * x + 1 ) )

  return 0 - ^ inverseHyperbolicSine( 0 - x )

inverseHyperbolicCosine  :  method
  x = arg(1)

  if x >= 1 then
    return ^ naturalLogarithm( x + squareroot( x * x - 1 ) )

  return 'undefined'

inverseHyperbolicTangent  :  method
  x = arg(1)

  if abs( x ) >= 1 then
    return 'undefined'

  return .5 * ^ naturalLogarithm( ( 1 + x ) / ( 1 - x ) )

inverseHyperbolicCosecant  :  method
  x = arg(1)
  if x <> 0 then
    return ^ inverseHyperbolicSine( 1 / x )
  return 'undefined'

inverseHyperbolicSecant  :  method
  x = arg(1)
  if x <> 0 then
    return ^ inverseHyperbolicCosine( 1 / x )
  return 'undefined'

inverseHyperbolicCotangent  :  method
  x = arg(1)

  if abs( x ) > 1 then
    return ^ inverseHyperbolicTangent( 1 / x )
  return 'undefined'

1.1.53 matrix.roo

-- matrix.roo

-- this class transforms the built-in 'table' class into an NxN matrix

-- the class is constructed EXPLICITLY
-- because, the initialization method of the table class
-- expects to receive the table headings

matrix  :  class extends table explicitly

-- there are 3 initialization method formats:

--  initialize( filename ) .. a file that contains rows of comma separated matrix values

--  initialize( m, n ) .. an MxN matrix is prepared

--  initialize( n, 'I' ) .. a unit NxN matrix is prepared .. with all 1's on the diagonal

initialize  :  method

  'base' ~ initialize -- construct the base class

  -- assert proper argument count

  if arg() < 0 | arg() > 2 then
    return 'Improper argument count. One or two arguments are expected; either a filename, or a row and column count'

  -- the following initializes the matrix to a fixed number of rows and columns

  if arg() = 2 then do
    parse arg rows, columns

    identityMatrix = 0

    if columns = 'I' then do
      columns = rows
      identityMatrix = 1
      end 

    -- prepare column headings for the table
    -- and the initial value of each row .. all 0's

    headings = ^^ vector

    initialValue = ^^ vector

    do i=1 for columns
      headings ~ add( i )
      initialValue ~ add( 0 )
      end 

    ^ setHeadings( headings ) -- this establishes the matrix width (#columns)

    -- prepare #rows

    do i=1 for rows

      ^ addAggregate( initialValue )

      if identityMatrix then
        ^ setValue( i, i, 1 )

      end 

    return '' -- done
    end 

  -- the following initializes the matrix from a CSV file

  if \ ( ^^ file( arg(1) ) ~ exists ) then
    return 'Matrix file' arg(1) 'does not exist.'

  matrixFile = ^^ inLineFile( arg(1) )

  loop ix over matrixFile
    
    if matrixFile[ ix ] <> '' then do

      -- prepare the first row

      if ^ size = 0 then do

        v = ^^ vector ~ addDelimitedString( matrixFile[ ix ], ',' )

        headings = ^^ vector

        do i=1 for v ~ size
          headings ~ add( i )
          end 

        ^ setHeadings( headings )

        ^ addAggregate( v )

        end 

      -- prepare another row

      else 

        ^ addDelimitedString( matrixFile[ ix ], ',' )

      end 

    end 

  return ''

-- the diagnose method dumps the matrix to the console

diagnose  :  method

  ^^ console ~ writeLine( 'Matrix' arg(1) ',' ^ size 'x' ^ width )

  ^^ console ~ writeLine( '' )

  do ix=1 for ^ size
    do jx=1 for ^ width
      ^^ console ~ writeCharacters( left( format( ^ getValue( ix, jx ), 8 ), 16 ) )
      end 
    ^^ console ~ writeLine( '' )
    end 

  return ''

1.1.54 matrixOperation.rooProgram

-- matrixOperation.rooProgram

-- this program performs a variety of matrix computations.
-- one or two matrices are acquired as CSV files.

-- the related 'matrix.roo' file provides the matrix class definition
-- which establishes fundamental MxN access capabilities.

-- the following operations are supported. these are specified as
-- the 1st character of the 'operation' argument. All results are
-- written to default output.

--  '+' .. add two matrices

--  '-' .. subtract a matrix from another

--  '*' .. multiply two matrices

--  '/' .. divide a matrix by another

--  '=' .. compare two matrices for equality

--  'Determinant' .. computes the determinant of a matrix

--  'Eigen matrix' .. computes matrix of eigenvectors
--      note: the input matrix must be symmetric .. A = A<sup>T</sup>
--      for the determination of the eigenvectors.

--  'Inverse' .. computes the inverse of a matrix

--  'Orthogonal' .. analyzes a matrix to determine if it is orthogonal

--  'Polynomial' .. computes the characteristic polynomial

--  'Solve' .. solves an Nx(N+1) system of simultaneous equations

--  'Transpose' .. transposes row and column values about the main diagonal

--  'Values, eigen' .. computes eigenvalues -- roots of characteristic polynomial

-- Note: for the 'Solve' operation the last column contains the values that
-- would appear after the equal sign for a collection of simultaneous equations.
-- For example,
--  2x + 3y = -1
--  3x + 5y = -2
-- The input matrix would be:
--  2,3,-1
--  3,5,-2
-- The result is:
--  1,-1
-- which indicates that the solution for x is 1,
-- and the solution for y is -1

-- get the name of the matrix file(s) to process,
-- and the operation to perform.

parse arg fileA operation fileB

-- validate arguments

if fileA = '' then
  call usagemsg

if \ ( ^^ file( fileA ) ~ exists ) then
  call usagemsg "Matrix file '"fileA"' does NOT exist."

if fileB <> '' then
  if \ ( ^^ file( fileB ) ~ exists ) then
    call usagemsg "Matrix file '"fileB"' does NOT exist."

if operation = '' then
  call usagemsg 'A matrix operation is required.'

A = ^^ Matrix( fileA )

A ~ diagnose( fileA )

B = ''

if fileB <> '' then do
  B = ^^ Matrix( fileB )
  ^^ console ~ writeLine( '' )
  B ~ diagnose( fileB )
  end 

^^ console ~ writeLine( '' )

C = '' -- prepare the default output matrix

-- perform a matrix operation, based on the requested

operation = upper( left( operation, 1 ) )

select 

  when operation = '+' then
    return add()

  when operation = '-' then
    return subtract()

  when operation = '*' then
    return multiply()

  when operation = '/' then
    return divide()

  when operation = '=' then
    return equal()

  when operation = 'D' then
    say determinant( A )

  when operation = 'E' then
    call eigenMatrix

  when operation = 'I' then
    return invert()

  when operation = 'O' then
    call isOrthogonal

  when operation = 'P' then
    call characteristicPolynomial

  when operation = 'S' then
    call solve

  when operation = 'T' then
    return transpose()

  when operation = 'V' then
    call eigenValues

  otherwise 
    call usagemsg 'The requested matrix operation is invalid.'

  end 

exit 0

-- the 'assertDimensionsMatch' procedure asserts that both matrices
-- have the same number of rows and columns

assertDimensionsMatch  :  procedure expose A B
  
  if A ~ size <> B ~ size then
    call usagemsg "MISMATCH: Matrix file 'A' has" A ~ size "rows. Matrix file 'B' has" B ~ size "rows."
  
  if A ~ width <> B ~ width then
    call usagemsg "MISMATCH: Matrix file 'A' has" A ~ width "columns. Matrix file 'B' has" B ~ width "columns."

  return 

-- the 'assertSquareMatrix' procedure asserts that a square matrix is being processed

assertSquareMatrix  :  procedure expose A
  
  if A ~ size <> A ~ width then
    call usagemsg "INVALID SQUARE MATRIX: Matrix file 'A' has" A ~ size "rows. Matrix file 'B' has" A ~ width "columns."

  return 

-- the 'assertSquareMatrixWithOneExtraColumn' asserts that the matrix
-- has one more column than it has rows. This is used when a system
-- of simultaneous equations is solved.

assertSquareMatrixWithOneExtraColumn  :  procedure expose A
  
  if A ~ width <> ( 1 + ( A ~ size ) ) then
    call usagemsg "INVALID MATRIX:" || '0a'x || "  There should be exactly one more column than there are rows." || '0a'x || "  The matrix file has" A ~ size "rows, and" A ~ width "columns."

  return 

-- the 'isSingular' procedure determines whether or not a matrix is singular.
-- a matrix is singular if the determinant is 0, and non-singular otherwise.

isSingular  :  procedure
  return determinant( arg(1) ) = 0

-- the 'add' procedure adds 2 matrices
-- producing the result in matrix C

add  :  procedure expose A B C

  if \ datatype( B, 'Instance' ) then
    call usagemsg 'matrixFileB is required for an ADD operation.'

  call assertDimensionsMatch

  C = ^^ matrix( A ~ size, A ~ width )

  loop ix over A
    loop jx over A[ ix ]
      C [ ix ] [ jx ] = A [ ix ] [ jx ] + B [ ix ] [ jx ]
      end 
    end 

  return emit()

-- 'characteristicCoefficients' determines characteristic coefficients of the matrix

characteristicCoefficients  :  procedure expose A

  call assertSquareMatrix

  dim = A ~ size

  -- call spur A, 3

  if dim < 2 then
    call usagemsg 'Only 2x2 matrices, or greater, are supported for the CHARACTERISTIC POLYNOMIAL operation.'

  coeff = { 1, 0 - spur( a ) }

  if dim = 2 then
    coeff ~ add( determinant( a ) )

  else 
  
    do i=2 to dim

      -- uncomment the following to determine which 'spur/trace' value is being computed

/*
      ^^ console ~ writeLine( 'Computing, spur A' i )
*/

      if 0 = ( ( dim - i ) // 2 ) then
        coeff ~ add( 0 - spur( a, i ) )
      else 
        coeff ~ add( spur( a, i ) )

      end 

  return coeff

-- 'characteristicPolynomial' determines characteristic polynomial of the matrix

characteristicPolynomial  :  procedure expose A

  coeff = characteristicCoefficients()

  dim = A ~ size

  -- say 'The Characteristic equation''s coefficients are:' coeff ~ tostring

  -- say

  -- say 'The polynomial to solve is:'

  poly = ''

  do i=dim to 0 by -1

    if i <> dim then
      poly = poly word( '- +', 1 + ( sign( coeff[ 1 + ( dim - i ) ] ) = 1 ) )

    if coeff[ 1 + ( dim - i ) ] = 0 then iterate

    if coeff[ 1 + ( dim - i ) ] <> 1 then
      poly = poly abs( coeff[ 1 + ( dim - i ) ] )

    else if i = 0 then
      poly = poly 1

    if i > 0 then
      poly = poly 'x^'i
    end 
  
  say strip( poly ) '= 0'

  return 0

-- the 'determinant' procedure computes the determinant of a square matrix

determinant  :  procedure
  mat = arg(1)

  if \ datatype( mat, 'Instance' ) then
    call usagemsg 'A matrix is required for a DETERMINANT operation.'

  if mat ~ width <> mat ~ size then
    call usagemsg "The determinant can only be computed for a square matrix."

  if mat ~ width = 0 then
    call usagemsg "The matrix is empty"

  if mat ~ width = 1 then
    return mat[ 1 ][ 1 ]

  -- algorithm: CRC 27th ed. p31, 4.10

  if mat ~ width = 2 then
    return ( mat[ 1 ][ 1 ] * mat[ 2 ][ 2 ] ) - ( mat[ 1 ][ 2 ] * mat[ 2 ][ 1 ] )

  det = 0

  loop jx over mat[ 1 ]
    det = det + mat[ 1 ][ jx ] * cofactor( mat, 1, jx )
    end 

  return det

-- the 'divide' procedure divides one matrix by another
-- producing the result in matrix C

divide  :  procedure expose A B C
  if \ datatype( B, 'Instance' ) then
    call usagemsg 'matrixFileB is required for an DIVIDE operation.'

  if B ~ width <> B ~ size then
    call usagemsg "File '"fileB"' is not a square matrix. Matrix file '"fileB"' has" B ~ width "columns. Matrix file '"fileB"' has" B ~ size "rows."

  if A ~ width <> B ~ size then
    call usagemsg "MISMATCH: Matrix file '"fileA"' has" A ~ width "columns. Matrix file '"fileB"' has" B ~ size "rows."

  C = ^^ matrix( B ~ width, A ~ size )

  call invertB

  loop ix over A
    loop jx over A[ ix ]
      loop mx over B_inverse
        C [ ix ] [ jx ] = C [ ix ] [ jx ] + ( A [ ix ] [ mx ] * B_inverse [ mx ] [ jx ] )
        end 
      end 
    end 

  return emit()

-- the 'equal' procedure determines if two matrices have the same values

equal  :  procedure expose A B
  if \ datatype( B, 'Instance' ) then
    call usagemsg 'matrixFileB is required for an EQUAL operation.'

  call assertDimensionsMatch

  loop ix over A
    loop jx over A[ ix ]
      if A [ ix ] [ jx ] <> B [ ix ] [ jx ] then
        return '0'
      end 
    end 

  return '1'

-- the 'eigenMatrix' procedure computes a matrix of eigenvectors

eigenMatrix  :  procedure expose A

  coeff = characteristicCoefficients()

  ^^ console ~ writeLine( 'characteristicCoefficients:' coeff ~ tostring )

  -- use the 'rootFinder.rooProgram' to find the eigenvalues !

  ! 'roo rootFinder' coeff ~ tostring '(stack'

  -- the eigenvalues are now in the external data queue

  eigenvalues = ^^ vector ~ addSystemQueue

  -- say 'eigenvalues:' eigenvalues ~ tostring

  -- algorithm: CRC 27th ed. p40, 8.24

  dim = A ~ width

  S = ^^ matrix( dim - 1, dim ) -- simultaneous equations to solve

  eigenmatrix = ^^ matrix( dim, dim )

  eigenvalueDim = eigenvalues ~ size

  loop ix over eigenvalues
    eigenvalue = eigenvalues[ 1 + ( eigenvalueDim - ix ) ]

    -- say 'eigenvalue' eigenvalue

    do row=1 to dim-1
      do col=2 to dim
        S[ row ][ col - 1 ] = A[ row ][ col ]
        end 
      if row = 1 then
        S[ row ][ dim ] = eigenvalue - A[ row ][ 1 ]
      else do
        S[ row ][ row - 1 ] = S[ row ][ row - 1 ] - eigenvalue
        S[ row ][ dim ] = 0 - A[ row ][ 1 ]
        end 
      end 

    eigenvector = solveSimultaneousEquations( S )

    eigenvector ~ insertAt( 1, 1 )

    sumOfSquares = 0

    loop jx over eigenvector
      sumOfSquares = sumOfSquares + eigenvector[ jx ] ** 2
      end jx

    sumOfSquaresRoot = squareroot( sumOfSquares )

    loop jx over eigenvector
      eigenvector[ jx ] = eigenvector[ jx ] / sumOfSquaresRoot
      end jx

    eigenmatrix[ ix ] = eigenvector
    end ix

  say eigenmatrix ~ toString

  return 

-- the 'eigenValues' procedure computes the eigenvalues of the matrix

eigenValues  :  procedure expose A

  coeff = characteristicCoefficients()

  -- use the 'rootFinder.rooProgram' to find the eigenvalues !

  call rootFinder coeff ~ tostring

  return 

-- the 'invert' procedure computes the inverse of a matrix

invert  :  procedure expose A B C
  if datatype( B, 'Instance' ) then
    call usagemsg 'matrixFileB is NOT required for an INVERT operation.'

  call assertSquareMatrix

  if isSingular( A ) then
    call usagemsg 'Matrix A is singular'

  -- algorithm: CRC 27th ed. p35, 6.13

  det = determinant( A )

  dim = A ~ width

  C = ^^ matrix( dim, dim ) -- C is the inverse of A

  loop ix over A
    loop jx over A[ ix ]
      C[ ix ][ jx ] =  cofactor( A, jx, ix ) / det
      end 
    end 

  return emit()

-- the 'invert' procedure computes the inverse of matrix B
-- this is used in the 'division' process

invertB  :  procedure expose B B_inverse

  if isSingular( B ) then
    call usagemsg 'Matrix B is singular'

  det = determinant( B )

  dim = B ~ width

  B_inverse = ^^ matrix( dim, dim )

  loop ix over B
    loop jx over B[ ix ]
      B_inverse[ ix ][ jx ] =  cofactor( B, jx, ix ) / det
      end 
    end 

  return 

-- the 'multiply' procedure multiplies 2 matrices
-- producing the result in matrix C

multiply  :  procedure expose A B C
  if \ datatype( B, 'Instance' ) then
    call usagemsg 'matrixFileB is required for an MULTIPLY operation.'

  if A ~ width <> B ~ size then
    call usagemsg "MISMATCH: Matrix file '"fileA"' has" A ~ width "columns. Matrix file '"fileB"' has" B ~ size "rows."

  C = ^^ matrix( A ~ size, B ~ width )

  do ix=1 for C ~ size
    do jx=1 for C ~ width
      do kx=1 for B ~ size
        C [ ix ] [ jx ] = C [ ix ] [ jx ] + ( A [ ix ] [ kx ] * B [ kx ] [ jx ] )
        end 
      end 
    end 

  return emit()

-- the 'isorthogonal' procedure analyzes if a matrix is orthogonal

isorthogonal  :  procedure expose A B C
  if datatype( B, 'Instance' ) then
    call usagemsg 'matrixFileB is NOT required for an isorthogonal operation.'

  call assertSquareMatrix

  if isSingular( A ) then
    call usagemsg 'Matrix A is singular'

  det = determinant( A )

  say abs( det ) '(the matrix is orthogonal if the value on the left is 1, or nearly 1)'

  return 

-- the 'solveSimultaneousEquations' procedure
-- solves a system of simultaneous equations
-- the input matrix has one more column than the number of rows.

solveSimultaneousEquations  :  procedure
  mat = arg(1)

  -- this algorithm is based on Cramer's Rule

  dim = mat ~ size   -- #rows => dimension of submatrices

  lastCol = dim + 1

  R = ^^ vector -- result is a vector .. ex: x,y,z

  denominatorMatrix = ^^ matrix( dim, dim )

  loop ix over mat
    do jx=1 to dim
      denominatorMatrix[ ix ][ jx ] = mat[ ix ][ jx ]
      end 
    end 

  detDenominator = determinant( denominatorMatrix )

  if detDenominator = 0 then
    call usagemsg 'The' dim'x'dim 'portion on the left side of the matrix has a determinant of 0 (it''s singular) !'

  -- process columns

  do col=1 to dim

    M = ^^ matrix( dim, dim )

    loop ix over mat
      do jx=1 to dim

        -- a specific column value is usually the value in that column
        -- of the input matrix. However, when the column is the one
        -- being processed, the value is taken from the last column
        -- of the input matrix.

          M[ ix ][ jx ] = mat[ ix ][ word( jx lastCol, 1 + ( col = jx ) ) ]
          end 
        end 

    R ~ add( determinant( M ) / detDenominator )

    end 

  return R

-- the 'solve' procedure solves a system of simultaneous equations
-- the input matrix was the first argument of the command line

solve  :  procedure expose A B C
  if datatype( B, 'Instance' ) then
    call usagemsg 'matrixFileB is NOT required for a SOLVE operation.'

  call assertSquareMatrixWithOneExtraColumn

  R = solveSimultaneousEquations( A )

  say R ~ toString
 
  return 

-- the 'subtract' procedure subtracts one matrix by another
-- producing the result in matrix C

subtract  :  procedure expose A B C
  if \ datatype( B, 'Instance' ) then
    call usagemsg 'matrixFileB is required for an SUBTRACT operation.'

  call assertDimensionsMatch

  C = ^^ matrix( A ~ size, A ~ width )

  loop ix over A
    loop jx over A[ ix ]
      C [ ix ] [ jx ] = A [ ix ] [ jx ] - B [ ix ] [ jx ]
      end 
    end 

  return emit()

-- the 'transpose' method swaps the row and column values around
-- the main diagonal,
-- producing the result in matrix C

transpose  :  procedure expose A B C
  if datatype( B, 'Instance' ) then
    call usagemsg 'matrixFileB is NOT required for an TRANSPOSE operation.'

  C = ^^ matrix( A ~ width, A ~ size )

  loop ix over A
    loop jx over A[ ix ]
      C [ jx ] [ ix ] = A [ ix ] [ jx ]
      end 
    end 

  return emit()

-- the 'cofactor' procedure computes the determinant
-- of a submatrix of a given matrix. the submatrix
-- is prepared by striking the ith row and jth column
-- from the original matrix.

-- note: the 'determinant' procedure uses the 'cofactor'
-- procedure. consequently, this pair of procedures can
-- be recursive, and always is when the number of rows
-- and columns exceeds 3.

cofactor  :  procedure
  parse arg mat, ix, jx
  
  dim = mat ~ width - 1

  submat = ^^ matrix( dim, dim ) 

  row = 1

  loop i over mat
    col = 1
    loop j over mat[ i ]
      if ix <> i & jx <> j then do
        submat[ row ][ col ] = mat[ i ][ j ]
        col = col + 1
        end 
      end 
    if ix <> i then
      row = row + 1
    end 

  return determinant( submat ) * word( "1 -1", 1 + ( 0 <> ( ( ix + jx ) // 2 ) )

-- the 'spur' of a matrix, is also known as the 'trace'
-- since the trace function is a Rexx built-in function,
-- the 'spur' name is used here

spur  :  procedure
  parse arg mat, order

  if \ datatype( mat, 'Instance' ) then
    call usagemsg 'A matrix is required for a spur / trace operation.'

  -- assert square matrix

  if mat ~ width <> mat ~ size then do
    mat ~ diagnose( "Invalid square matrix for a spur / trace request" )
    ^^ console ~ writeLine( 'Calling context:' )
    ^^ ContextVector ~ print
    exit 1
    end 

  -- algorithm: CRC 27th ed. p37 -- TRACES section

  dim = mat ~ size

  -- the trace of a square matrix, without a specified order,
  -- is the sum of the diagonal elements

  if order = '' then do
      tr = 0
      loop ix over mat
          tr = tr + mat[ ix ][ ix ]
          end 
      end 

  else if order > dim then
    call usagemsg 'The requested order ('order') of a spur / trace operation exceeds the matrix dimension ('dim').'

  -- the trace of a square matrix, with order = #rows,
  -- is the determinant

  else if order = dim then
    tr = determinant( mat )

  -- the trace of a square matrix, with order = 2,
  -- is the sum of the determinants of all 2 x 2 submatrices
  -- within the original matrix

  else if order = 2 then do

    tr = 0

    submat = ^^ matrix( 2, 2 )

    do i=1 to dim - 1
      do j=i+1 to dim
        submat[ 1 ][ 1 ] = mat[ i ][ i ]
        submat[ 1 ][ 2 ] = mat[ i ][ j ]
        submat[ 2 ][ 1 ] = mat[ j ][ i ]
        submat[ 2 ][ 2 ] = mat[ j ][ j ]

        tr = tr + determinant( submat )
        end 
      end 
    end 

  -- the trace of a 4x4 matrix with order = 3
  -- is the sum of the cofactors going down
  -- the main diagonal

  else if order = 3 & dim = 4 then do
    tr = 0
    do i=1 to 4
      tr = tr + cofactor( mat, i, i )
      end 
    end 

  -- the trace of an NxN matrix, with order higher than 2
  -- is difficult to determine. the method used here
  -- proceeds in two steps:

  --  1. a series of row-column values to eliminate is computed

  --  2. the sum of the determinants of the submatrices with
  --     the row-column values removed is computed.

  else do
    k = order

    -- call usagemsg 'Matrix dimensions above 4 are not currently supported, for a spur / trace operation (TBD)'

    call cull k, dim

    -- get the culled 'row-column' values from the external data queue

    culled = ^^ vector ~ addsystemqueue

    -- you can determine what row-column values are culled
    -- by uncommenting the following code lines.

/*
say 
say 'culled vectors'

    loop ix over culled
      say culled[ ix ]
      end 

    exit 99
*/

    submat = ^^ matrix( k, k )

    tr = 0

    loop ix over culled

      elim = culled[ ix ] -- this contains the 'row-column' values to exclude

      subrow = 0

      do i=1 to dim

        if wordpos( i, elim ) = 0 then do
          subrow = subrow + 1

          subcol = 1

          do j=1 to dim

            -- add 'unexcluded' values to the submatrix

            if wordpos( i, elim ) = 0 then do
              submat[ subrow ][ subcol ] = mat[ i ][ j ]
              subcol = subcol + 1
              end 
            end 

          end 

        end 

      -- compute the determinant of the submatrix
      -- and add it to the trace result

      tr = tr + determinant( submat )

      end 

    end 

  return tr

-- the 'cull' procedure produces a series of lines
-- each line is a set of the 'row-column' values to exclude.

cull  :  procedure
  parse arg k, dim

  -- generate the code that emits culled row-column indices !

  -- the code to do this is a series of nested iterative do loops

  -- the number of nested loops is dependent on the difference
  -- between the k and dim arguments !

  code = 'do ix1=1 to dim - 1;'

  do i=2 to dim - k
    code = code || 'do ix'i '= 1 + ix' || (i-1) 'to dim;'
    end 

  code = code || 'lin = "";'

  do i=1 to dim - k
    code = code || 'lin = lin" "ix'i';'
    end 

  -- each set of row-column indices is written to the external data queue

  code = code || 'queue strip( lin );'

  do i=1 to dim - k
    code = code || 'end;'
    end 

  -- if you want to know what the code that computes the culled values
  -- looks like, uncomment the following line !

/*
  say translate( code, '0a'x, ';' )
*/

  -- INTERPRET the generated code !

  interpret code

  return 

-- the 'emit' procedure writes matrix C to the default output stream
-- as a series of comma-separated value lines

emit  :  procedure expose C

  loop ix over C
    say C[ ix ] ~ toDelimitedString( ',' )
    end 

  return 0

-- the 'usagemsg' procedure describes how to use this program

usagemsg  :  procedure
  ^^ console ~ writeLine( arg(1), '', ,
    'Usage : ', '  roo matrixOperation matrixFileA op [ matrixFileB ] [ [>] > outMatrixFile ]' , ,
    '', 'Supported operators:', '', ,
    '  + .. matrix addition', ,
    '  - .. matrix subtraction', ,
    '  * .. matrix multiplication', ,
    '  / .. matrix division', ,
    '  = .. matrix equality', ,
    '  D .. matrix determinant', ,
    '  E .. computes matrix of eigenvectors', ,
    '  I .. matrix inversion', ,
    '  O .. matrix orthogonal analysis', ,
    '  P .. matrix characteristic polynomial', ,
    '  S .. solve simultaneous equations', ,
    '  T .. matrix transpose', ,
    '  V .. computes eigenvalues -- roots of characteristic polynomial' )

1.1.55 msgbox.roo

/* msgbox.roo
 a class that sends stream output to a message box

 the message is displayed by the auxiliary program MSGBOX.EXE
*/

msgbox  :  class extends outtext

-- local variables

local caption       -- message box caption

local messagestyle  -- message box style

local showtime      -- boolean => show time too

shared text -- 'text' is a shared symbol in the 'outtext' class

-- initialize member variables

initialize  :  method
  caption = ''
  messagestyle = 0  -- default style: OK button
  showtime = ''
  return ''

-- configuration methods

setCaption  :  method
  caption = arg(1)
  return ^ self

showButtons  :  method
  button = translate( arg(1) )
  call addStyle wordpos( button, 'OK OKCANCEL ABORTRETRYIGNORE YESNOCANCEL YESNO RETRYCANCEL' ) - 1
  return ^self

showIcon  :  method
  iconImage = translate( arg(1) )
  call addStyle wordpos( iconImage, 'STOP QUESTIONMARK EXCLAMATION INFORMATION' ) * 16
  return ^self

setDefaultButton  :  method
  defaultButton = translate( arg(1) )
  call addStyle ( wordpos( defaultButton, 'FIRST SECOND THIRD FOURTH' ) - 1 ) * 256
  return ^self

setTopFloat  :  method
  call addStyle 262144
  return ^self

showTime  :  method
  showtime = translate( left( arg(1), 1 ) )
  return ^ self

-- emit method

emit  :  method

  -- prepare message box parameters
  
  params = ''

  if showtime = 'Y' then
    params = params '/Time'
  
  if caption <> '' then
    params = params '/C"'caption'"'
  
  if messagestyle <> 0 then
    params = params '/S'messagestyle

  -- change backslashes in the text to double-backslashes
  -- change line terminators to escaped line terminators

  ttext = changestr( changestr( text, '\', '\\' ), '0d0a'x, '\r\n' )

  -- show the message

  'msgbox' strip( params ttext ) -- show message box !
                                 -- using the msgbox.exe program

  -- convert response index to corresponding word

  return word( 'OK CANCEL ABORT RETRY IGNORE YES NO', rc )

addStyle  :  procedure
  messagestyle = messagestyle + arg( 1 )
  return ^self

1.1.56 naturalLogarithmGraph.rooProgram

-- naturalLogarithm.rooProgram
-- this program prepares the graph of the naturalLogarithm function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ math

xLimit = 10

yLimit = 2

graphPropsFile = 'naturalLogarithm.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# eToXGraph.props -- created by program: naturalLogarithm.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=Ln X : '.1 '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet='

do i=.1 to xLimit by .1
  call charout graphPropsFile, i',' || math ~ naturalLogarithm( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.57 naturalPowerGraph.rooProgram

-- naturalPowerGraph.rooProgram
-- this program prepares the graph of the naturalPower function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ math

xLimit = 10

yLimit = 2

graphPropsFile = 'naturalPowerGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# naturalPowerGraph.props -- created by program: naturalPowerGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=e^X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by .1
  call charout graphPropsFile, i',' || math ~ naturalPower( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.58 outtext.roo

/* outtext.roo
 a base class that collects stream output to a text value
*/

shared text -- 'text' is a shared symbol with derived classes .. audiotext, etc.

initialize  :  method
  text = arg( 1 )    -- initialize text variable
  return ''

emit  :  method
  return ^ self -- an outtext instance context reference

writeCharacters  :  method
  text = text || arg(1)  -- add some characters
  return 0 -- #characters remaining to be written

writeLine  :  method
  trace ?r
  text = text || arg(1) || '0d0a'x  -- add a line
  return 0 -- #lines remaining to be written

getText  :  method
  return text    -- return the text

reset  :  method
  text = ''      -- reset the text
  return ''

toString  :  method
  return text    -- return the text

1.1.59 polynomialMultiplication.rooProgram

-- polynomialMultiplication.rooProgram

-- this program multiplies 2 polynomials.
-- each polynomial is provided as a comma separated string value.

-- the 2 polynomials can be provided on the command line as follows:
--   roo polynomialMultiplication 3,3,1 * 2,1

-- or, the 2 polynomials can be provided as the 1st 2 lines
-- in the default input stream.

-- the result polynomial is written to the default output stream
-- as comma separated coefficients.

-- the input polynomials and the output polynomial are displayed
-- to the console.

-- this algorithm is 'adapted' from:
-- Sedgewick, Algorithms in C++, p529
-- ISBN: 0-201-51059-6, Copyright (C) 1992, Addison-Wesley

-- this program requires roo! build date: 31 Jan 2003, or later

parse arg comma_separated_coefficients '*' comma_separated_coefficients2

if comma_separated_coefficients = '' then do

  ^^ console ~ writeLine( "Please enter 2 comma separated coefficients on separate lines below" )

  comma_separated_coefficients = linein()

  if pos( ',', comma_separated_coefficients ) = 0 then
    call usagemsg

  comma_separated_coefficients2 = linein()

  end 

if pos( ',', comma_separated_coefficients ) = 0 then
  call usagemsg

if pos( ',', comma_separated_coefficients2 ) = 0 then
  call usagemsg

p = ^^ vector ~ addDelimitedString( strip( comma_separated_coefficients ), ',' )

q = ^^ vector ~ addDelimitedString( strip( comma_separated_coefficients2 ), ',' )

call showPolynomial 'The 1st polynomial is:', p

call showPolynomial 'The 2nd polynomial is:', p

-- make sure the coefficients have the same rank
-- the rank is the size - 1

do while p ~ size < q ~ size
  p ~ insertAt( 1, 0 )
  end 

do while p ~ size > q ~ size
  q ~ insertAt( 1, 0 )
  end 

-- this algorithm requires the polynomials to have an even number of coefficients

if 0 <> ( p ~ size // 2 ) then do
  p ~ insertAt( 1, 0 )
  q ~ insertAt( 1, 0 )
  end 

N = p ~ size

answer = mult( p, q, N )

-- eliminate leading 0's

do while answer[ 1 ] = 0
  answer ~ removeAt( 1 )
  end 

call showPolynomial 'The product polynomial is:', answer

say answer ~ toString

exit 0

-- the 'mult' procedure recursively multiplies half the polynomials
-- and then combines the results

mult  :  procedure
  parse arg p, q, N

  if N = 1 then do

    return { p[ 1 ] * q[ 1 ] }
    end 

  halfN = trunc( N / 2 )

  -- establish intermediate vectors

  pLow  = {}
  qLow  = {}
  pHigh = {}
  qHigh = {}
  t1    = {}
  t2    = {}

  -- establish the result vector

  resultRank = ( 2 * ( N - 1 ) ) + 1

  resultPoly = ^^ vector ~ addDelimitedString( strip( copies( '0,', resultRank), 'T', ',' ), ',' )

  -- prepare the low side half vectors

  do i=1 to halfN
    pLow[ i ] = p[ i ]  
    qLow[ i ] = q[ i ]  
    end 

  -- prepare the high side half vectors

  do i=halfN+1 to N
    pHigh[ i - halfN ] = p[ i ]  
    qHigh[ i - halfN ] = q[ i ]  
    end 

  -- prepare the temporary half vectors

  do i=1 to halfN
    t1[ i ] = pLow[ i ] + pHigh[ i ]
    t2[ i ] = qLow[ i ] + qHigh[ i ]
    end 

  -- get the result of multiplying the low side half vectors

  rLow = mult( pLow, qLow, halfN )

  -- get the result of multiplying the temporary half vectors

  rMiddle = mult( t1, t2, halfN )

  -- get the result of multiplying the high side half vectors

  rHigh = mult( pHigh, qHigh, halfN )

  -- prepare the lower half of the result polynomial

  do i=1 to N-1
    resultPoly[ i ] = rLow[ i ]
    end 

  -- the middle of the result polynomial is 0

  resultPoly[ N ] = 0

  -- prepare the upper half of the result polynomial

  do i=1 to N-1
    resultPoly[ N + i ] = rHigh[ i ]
    end 

  -- combine the intermediate results

  do i=1 to N-1

    resultPoly[ halfN + i ] = resultPoly[ halfN + i ] + rMiddle[ i ] - ( rLow[ i ] + rHigh[ i ] )

    end 

  return resultPoly

-- 'showPolynomial' procedure

showPolynomial  :  procedure
  parse arg title, coeff

  dim = coeff ~ size - 1

  poly = ''

  do i=dim to 0 by -1

    currentCoefficient = coeff[ 1 + ( dim - i ) ]

    if currentCoefficient = 0 then iterate

    if i <> dim then do
      if sign( currentCoefficient ) = -1 then do
        poly = poly '-'
        currentCoefficient = abs( currentCoefficient )
        end 
      else 
        poly = poly '+'
      end 

    if currentCoefficient <> 1 then
      poly = poly currentCoefficient

    else if i = 0 then
      poly = poly 1

    if i > 0 then
      poly = poly 'x^'i
    end 

  ^^ console ~ writeLine( '', title, '  'strip( poly ) )

  return 

-- 'usagemsg' procedure
-- show program usage information

usagemsg  :  procedure
  if arg(1) <> '' then
    ^^ console ~ writeLine( arg(1), '' )

  ^^ console ~ writeLine( 'Usage:', '  roo polynomialMultiplication [comma_separated_coefficients1 * comma_separated_coefficients2] [>outfile]', '' )
  ^^ console ~ writeLine( 'Example polynomials to multiply:' )
  ^^ console ~ writeLine( '  3 x^2  + 3 x + 1' )
  ^^ console ~ writeLine( '  2 x + 1' )
  ^^ console ~ writeLine( '', 'Associated coefficients:' )
  ^^ console ~ writeLine( '  3,3,1' )
  ^^ console ~ writeLine( '  2,1' )
  ^^ console ~ writeLine( '', 'Command to perform:' )
  ^^ console ~ writeLine( '  roo polynomialMultiplication 3,3,1 * 2,1' )
  ^^ console ~ writeLine( '', 'When the comma_separated_coefficients values are absent,', 'they are read from the 1st two lines of the default input stream.' )
  exit 1

1.1.60 qt.roo

/* qt.roo
 This is the supporting QT class file
 for the 'query time' example program from TRL-2 p172
 which tells the current time in English.
*/

local out -- the output text destination

local specificTime -- a specific time to display

initialize  :  method

  parse arg out, specificTime -- set local variables from parameters

  -- ensure output destination is an instance

  if \ datatype( out, 'Instance' ) then do

    ^^ console ~ writeLine( 'The parameter for QT.ROO should be an output destination object instance' )

    return 'The parameter for QT.ROO should be an output destination object instance'

end 

  return ''

settime  :  method
  specificTime = arg(1) -- prepare to display a specific time
  return now

telltime  :  method

  out ~ writeCharacters( "It's" ) -- start output phrase

  if specificTime = '' then
    now = time()			-- show current time

  else 
    now = specificTime      -- show specific time

  -- prepare nearby time clauses

  near = {                  ,
           ''             , ,
           ' just gone'   , ,
           ' just after'  , ,
           ' nearly'      , ,
           ' almost' }

  -- get hour, minute, and second

  parse var now hour ':' min ':' sec

  -- round minutes

  if sec > 29 then
    min = min+1

  -- determine REMAINDER of minutes divided by 5
  -- emit 'near' phrase

  out ~ writeCharacters( near[ 1 + ( min // 5 ) ] )

  -- round hour

  if min > 32 then
    hour = hour + 1

  -- increment minutes by nearby interval

  min = min + 2

  -- show exactly noon or midnight

  if hour // 12 = 0 & min // 60 <= 4 then do
    if hour=12 then
      out ~ writeCharacters( 'Noon' )
    else 
      out ~ writeCharacters( 'Midnight' )
return ''
    end 

  -- reduce minutes to 5 minute interval base

  min = min - ( min // 5 )

  if hour > 12 then
    hour = hour - 12		-- reduce PM times by 12 hours

  else if hour = 0 then
    hour = 12				-- 0 hour: is 12 to 1 am

  -- prepare 5 minute interval clauses

  roundedMinute = ,
      {                      ,
        ''                   , ,
        'five past'          , ,
        'ten past'           , ,
        'a quarter past'     , ,
        'twenty past'        , ,
        'twenty-five past'   , ,
        'half past'          , ,
        'twenty-five to'     , ,
        'twenty to'          , ,
        'a quarter to'       , ,
        'ten to'             , ,
        'five to'            , ,
        '' }

  -- emit 'rounded' phrase

  out ~ writeCharacters( ' 'strip( roundedMinute[ 1 + ( min / 5 ) ], 'T' ) )

  -- hour numbers

  hourNumbers = { 'one', 'two', 'three', 'four', 'five', 'six', 'seven', 'eight', 'nine', 'ten', 'eleven', 'twelve' }

  out ~ writeCharacters( ' 'hourNumbers[ hour ] ) -- add current hour

  if 0 = ( min // 60 ) then
    out ~ writeCharacters( " o'clock" )	-- it's exactly a specific hour clause

  -- done !

  return ^ self -- return 'qt' instance reference

1.1.61 qt.rooProgram

/* qt.rooProgram
 This is a roo!(TM) version
 of the 'query time' example program from TRL-2 p172
 which tells the current time in English.

 usage:
  roo qtRoo.rooProgram [emitterClass _ hh:mm:ss]

  'emitterClass' is one of:
    audiotext console outstream htmlnote htmltext marquee msgbox xmltext

 related programs:
  qtVoice.rooProgram -- tells the time once, vocally
  qtVoiceEndless.rooProgram -- tells the time vocally, endlessly

 Alternate output emitters are passed to the supporting qt.roo program.

 This program uses the related PICKLIST.EXE program to select an output emitter.
*/

-- validate arguments

arg parm '_' testtime .

outputEmitter = ''

-- 'emitter' is a vector of supported output emitter class names

emitter = { 'AUDIOTEXT', 'CONSOLE', 'OUTSTREAM', 'HTMLNOTE', ,
            'HTMLTEXT',  'MARQUEE', 'MSGBOX',    'XMLTEXT' }

select 

  when parm='?' then
    call usagemsg

  when wordpos( parm, emitterClasses ) > 0 then
    outputEmitter = parm

  when parm = '' then do -- let the user pick the emitter type

    choices = { 'What output format would you prefer?' , ,
                   'Audio'                                      , ,
                   'Console'                                    , ,
                   'Default output'                             , ,
                   'HTML note'                                  , ,
                   'HTML text'                                  , ,
                   'Marquee'                                    , ,
                   'Message box'                                , ,
                   'XML note'       } ~ toString

    trace o
    'PICKLIST' choices

    if rc = 0 then
      exit 1 /* cancel was selected */

    outputEmitter = emitter[ rc ]

    end 

  otherwise 
    call usagemsg 'Invalid argument: 'parm

  end 

-- note: outputEmitter is a class name,
-- which is the value of a variable.

dest = ^^ outputEmitter                      -- prepare text destination

-- the 'qt.roo' class prepares the text

^^ qt( dest, testtime ) ~ telltime

-- additional preparations

if outputEmitter <> 'AUDIOTEXT' then
  dest ~ writeCharacters( '.' )              -- add trailing period

if outputEmitter = 'HTMLTEXT' then do
  dest ~ setTag( 'div' )
  dest ~ attribute( 'align', 'center' ) ~ attribute( 'style', 'color:yellow; background-color:navy' )
  end 

if outputEmitter = 'MSGBOX' then
  dest ~ setCaption( 'A message from QT !' ) -- add caption

-- emit the text
-- which is the time of day, in English

dest ~ emit                                  

-- done !

exit 0

usagemsg :
  con = ^^ console
  con ~ writeLine( arg(1), '', 'Usage:', '  roo QT.rooProgram [ emitterClass [ _ hh:mm:ss ] ]' )
  con ~ writeLine( '', 'Supported emitter classes are:', '  'emitterClasses  )

1.1.62 qtVoice.rooProgram

/* qtVoice.rooProgram
 This is a roo!(TM) version
 of the 'query time' example program from TRL-2 p172
 which tells the current time with an English voice.

 usage:
  roo qtVoice.rooProgram
*/

if arg( 1 ) <> '' then
  call usagemsg

dest = ^^ audiotext

^^ qt( dest ) ~ telltime
  
dest ~ emit

exit 0

usagemsg :
  ^^ console ~ writeLine( 'No arguments are expected.', '', 'Usage:', '  roo qtVoice.rooProgram' )

1.1.63 qtVoiceEndless.rooProgram

/* qtVoiceEndless.rooProgram
 This is a roo!(TM) version
 of the 'query time' example program from TRL-2 p172
 which tells the current time with an English voice, endlessly.

 usage:
  roo qtVoiceEndless.rooProgram
*/

if arg( 1 ) <> '' then -- no arguments are expected !
  call usagemsg

dest = ^^ audiotext -- the output destination is audio

qt = ^^ qt( dest ) -- prepare a QT class instance

priorTime = '' -- remember previous cycle time

priorText = '' -- remember previous cycle text

do forever -- forever is a long time !

  -- if the time is the same there is nothing
  -- new to say.

  if priorTime <> time() then do

    priorTime = time()

    qt ~ telltime -- get the time in English

    -- if the time text is the same
    -- there is nothing new to say.

    if priorText <> dest ~ getText then do

      dest ~ emit -- say the current time in English !

      priorText = dest ~ getText -- save the new text

      end 

    dest ~ reset -- reset the audio text

    end 

  call nap 20 * 1000 -- snooze for 20 seconds

  end 

exit 0

usagemsg :
  ^^ console ~ writeLine( 'No arguments are expected.', '', 'Usage:', '  roo qtVoiceEndless.rooProgram' )

1.1.64 quipDuJour.rooProgram

/* quipDuJour.rooProgram
 shows a quip du jour

 the optional argument is the name of a text file that contains quips

 the default quip file is: quips.dat
*/

-- get optional file name containing quips

arg quipFileName .

if quipFileName = '' then
  quipFileName = 'quips.dat' -- use default

-- check if quip file exists

quipFile = ^^ file( quipFileName )

if \ ( quipFile ~ exists ) then
  call usagemsg 'File' quipFileName 'does not exist.'

-- read all quip file lines to a vector

quipLines = ^^ inLineFile( quipFileName )

-- generate a random quip number

quipNumber = random( 1, quipLines ~ size )

-- show the random quip

^^ outstream ~ writeLine( 'Quip #'quipNumber, '  'quipLines[ quipNumber ] )
  
exit 0

-- show usage information

usagemsg :
  ^^ console ~ writeLine( ,
    arg(1), ,
    '', ,
    'Usage : ', ,
    '  roo quipDuJour.rooProgram [ quipFileName ]  (default: quips.dat)', ,
    '', ,
    'Example : ', ,
    '  roo quipDuJour quips.dat' )

1.1.65 randomSequence.roo

/* randomSequence.roo
 generate a random sequence of numbers

 this program is used by deal.roo
 to prepare the shuffled sequence
 of 52 cards.
*/

-- this class extends the built-in class 'vector' explicitly
-- because the arguments for this class differ from a
-- vector's initialization arguments.

randomSequence  :  class extends Vector explicitly

initialize  :  method

  'base' ~ initialize                                         -- prepare base class

  ARG count, low, high, uniqueOption +1                            -- get arguments

  if uniqueOption = '' then
    uniqueOption = 'U'                              -- a unique sequence is desired

  numeric digits 11   -- 'nap' function can return a number with more than 9 digits

  call random , , nap( 0 )                            -- establish a new sequence !

  numeric digits 9

  do count                                                -- prepare 'count' values

    -- add another value.

    do forever                                       -- loop until a value is added

      newValue = random( low, high )

      if uniqueOption <> 'U' ,                                  -- non-unique is OK
      | \ ^ contains( newValue ) then do   -- value not already contained in vector

        ^ add( newValue )                                    -- add value to vector
        leave 
        end 

      end 

    end 

  return ''        -- done !

1.1.66 rooTry.rooProgram

/* rooTry.rooProgram, a bare bones interpreter

 Keywords
  ROO statement experimentation, INTERPRET example,
  Interactive command shell

 Usage
  roo rooTry

 Arguments
  None

 Files used
  Console immediate input and output

 Exit codes
   0   => last request was successful
 non-0 => last return code

 Input record format
  Input is read as normal console input.

 Sample input file
  N/A

 Sample output file
  An output file is not produced, but a sample session follows:

  Type 'EXIT' to end

  ==> say ^^ randomSequence( 6, 1, 49, 'U' ) ~ toString
  41,27,38,7,16,31

  ==> EXIT

 Example of use
  roo rooTry

 Explanation
  This procedure is an interactive ROO statement execution shell. A
  prompt is displayed for entry 1 or more ROO statements. The user's
  response is INTERPRETed. Statements can perform any ROO statement,
  including loops, references to built-in functions, external procedure
  calls, and system command initiation. There are special concerns which
  must be met when loops are coded [refer to the description of INTERPRET
  instruction].
  Output from statements is processed normally.

  When erroneous requests are encountered, a message is displayed showing
  the erroneous line, and processing resumes with another prompt.

  Processing is terminated by typing "EXIT" or "RETURN" statements, or
  by hitting either Control-Break or Control-C.
*/

con = ^^ console

prompt = '==> '

humbleResponse = "O'roo -- your wish is my command."

RC = 0                                                     -- presume no errors

con ~ writeLine( "Type 'EXIT' to end" )                     -- show how to stop

con ~ writeCharacters( date() time() prompt )    -- solicit initial ROO request

do while con ~ hasInput          -- process requests until end of console input

  parse value con ~ readLine with _line_                     -- get ROO request

  if translate( _line_ ) == 'THANKS' then      -- answer unexpected user praise
    con ~ writeLine( humbleResponse )                          -- show humility

  else 
    interpret _line_                              -- interpret ROO statement(s)

  con ~ writeCharacters( date() time() prompt )     -- solicit next ROO request

  catch e = ERROR
    call diagnose

  catch e = FAILURE
    call diagnose

  catch halt
    con ~ writeLine( 'Tata...' )
    exit 0

  catch e = SYNTAX
    call diagnose

  end 

exit RC                           -- final command error code is returned upward

diagnose  :  /* exposeAll */                       -- deal with erroneous requests

  con ~ writeLine( "???" e ~ description "07"x )     -- show befuddlement & beep

  con ~ writeLine( "  " _line_ )                       -- show erroneous request

  con ~ writeCharacters( date() time() prompt )      -- solicit next ROO request

  return -- resume processing

1.1.67 rootFinder.rooProgram

-- rootFinder.rooProgram

-- this program discovers the roots of a polynomial having a single variable, using Newton's iteration method

-- the polynomial is entered either as comma separated values on the command line,
--  or as a sequence of numeric values separated by commas, on the first line in the default input stream

-- the roots are written on separate lines to the default output stream

-- if the polynomial is quadratic, the quadratic formula is used

parse arg comma_separated_coefficients

if comma_separated_coefficients = '' then do

  ^^ console ~ writeLine( "Please enter the polynomial coefficients below -- separated by commas" )

  comma_separated_coefficients = linein()

  if pos( ',', comma_separated_coefficients ) = 0 then
    call usagemsg

  end 

coeff = ^^ vector ~ addDelimitedString( comma_separated_coefficients, ',' )

call showPolynomial 'The polynomial to solve is:', coeff

if coeff ~ size < 3 then
  call usagemsg 'At least 3 coefficients are expected...'

if coeff[ 1 ] = 0 then
  call usagemsg 'The first coefficient can''t be 0 !!'

-- usually the 1st polynomial coefficient is one. convert the values if it is not 1.

if coeff[ 1 ] <> 1 then do
  coeff1 = coeff[ 1 ] 
  loop ix over coeff
    coeff[ ix ] = coeff[ ix ] / coeff1
    end 
  end 

-- roots are discovered iteratively
-- the 1st root is discovered using Newton's iteration method
-- then the polynomial is reduced by dividing by ( x - root )
-- then the next root is discovered.

-- eventually the polynomial will be quadratic, at which point
-- the quadratic formula is used to obtain the last 2 roots.
-- the final roots may be complex ! 

do while coeff ~ size > 2

  -- call showPolynomial 'The current polynomial to solve is:', coeff

  if coeff ~ size = 3 then
    call quadraticRoots coeff -- the 'quadraticRoots' procedure exits !

  dim = coeff ~ size - 1

  -- compute derivative coefficients

  -- the derivative of a specific term: A x ^ n
  -- is ( A * n ) x ^ ( n - 1)

  -- the derivative of: x^3 + 3 x^2  + 3 x + 1
  -- is: 3x^2 + 6 x + 3

  derivativeCoefficient = ^^ vector

  do i=dim to 1 by -1
    derivativeCoefficient ~ add( coeff[ 1 + ( dim - i ) ] * i )
    end 

  -- call showPolynomial 'Derivative polynomial:', derivativeCoefficient, 'Y'

  stab = 0

  do ix = 2 to coeff ~ size while stab = 0
    stab = coeff[ ix ] / 3
    end 

  if stab = 0 then
    call usagemsg 'all coefficients were zero ?'

  root = newton( stab, coeff, derivativeCoefficient  )

  say root

  coeff = reducePolynomial( coeff, root )

  -- call showPolynomial 'The reduced polynomial is:', coeff

  end 

exit 0

-- 'evaluate' procedure

-- evaluate polynomial for a given value: v

evaluate  :  procedure
  parse arg poly, v

  value = poly[ poly ~ size ]  -- last coefficient

  x = v

  do i=2 to poly ~ size
    value = value + ( x * poly[ 1 + ( poly ~ size - i ) ] )
    x = x * v
    end 

  return value

-- 'newton' procedure

-- the following is Newton's iterative procedure to discover a root

newton  :  procedure

  parse arg stab, coeff, derivativeCoefficient

  prevRoot = 0

  root = 0

  dejavu = 0

  do i=1 to digits() * 5

    derivative = evaluate( derivativeCoefficient, stab )

    if derivative = 0 then do
      if dejavu then do
        ^^ console ~ writeLine( 'singular derivative discovered', 'stab' stab, 'derivativeCoefficient' derivativeCoefficient ~ toString ) 
        exit 1
        end 
      if ( stab / 2 ) <> 0 then
        stab = stab / 2
      else 
        stab = stab * 2
      dejavu = 1
      end 

    else do
      dejavu = 0

      value = evaluate( coeff, stab )

      root = stab - ( value / derivative )

      if root = stab | root = prevRoot then leave

      prevRoot = stab

      stab = root

      end 
    end 

  return root

-- 'quadraticRoots' procedure

-- find the roots of a quadratic equation

quadraticRoots  :  procedure
  coeff = arg(1)

  a = coeff[ 1 ]
  b = coeff[ 2 ]
  c = coeff[ 3 ]

  if a = 0 then
    call usagemsg 'The first coefficient of a quadratic equation is 0 (invalid).'

  twoA = a * 2

  subterm = ( b * b ) - ( 4 * a * c )

  subtermSign = sign( subterm )

  subterm = abs( subterm )

  subroot = squareroot( subterm )

  if subtermSign <> -1 then
    root1 = ( subroot - b ) / twoA
  else 
    root1 = ( 0 - b ) / twoA '+' ( subroot / twoA ) 'i'

  if subtermSign <> -1 then
    root2 = ( 0 - ( subroot + b ) ) / twoA
  else 
    root2 = ( 0 - b ) / twoA '-' ( subroot / twoA ) 'i'

  say root1
  say root2
  
  exit 0

-- 'reducePolynomial' procedure

-- reduce the order of a polynomial,
-- by dividing by ( x + root )

-- notice the coefficient of x is 1,
-- which simplifies the polynomial division process

reducePolynomial  :  procedure
  parse arg coeff, root

  -- invert the sign of the root
  --  if the root was -1
  --  the polynomial in the denominator is ( x + 1 )

  root = - root

  newPoly = { 1 } -- the 1st coefficient is always 1

  factor = 1

  dim = coeff ~ size

  do ix=2 to dim - 1
    factor = coeff[ ix ] - ( factor * root )
    newPoly ~ add( factor )
    end 

  return newPoly

-- 'showPolynomial' procedure

showPolynomial  :  procedure
  parse arg title, coeff, withoutEquals

  dim = coeff ~ size - 1

  poly = ''

  do i=dim to 0 by -1

    currentCoefficient = coeff[ 1 + ( dim - i ) ]

    if currentCoefficient = 0 then iterate

    if i <> dim then do
      if sign( currentCoefficient ) = -1 then do
        poly = poly '-'
        currentCoefficient = abs( currentCoefficient )
        end 
      else 
        poly = poly '+'
      end 

    if currentCoefficient <> 1 then
      poly = poly currentCoefficient

    else if i = 0 then
      poly = poly 1

    if i > 0 then
      poly = poly 'x^'i
    end 

  ^^ console ~ writeLine( '', title, '  'strip( poly ) copies( ' = 0', withoutEquals <> 'Y' ), '' )

  return 

-- 'usagemsg' procedure
-- show program usage information

usagemsg  :  procedure
  if arg(1) <> '' then
    ^^ console ~ writeLine( arg(1), '' )

  ^^ console ~ writeLine( 'Usage:', '  roo rootfinder [comma_separated_coefficients] [>outfile]', '' )
  ^^ console ~ writeLine( 'Example polynomial to solve:' )
  ^^ console ~ writeLine( '  x^3 + 3 x^2  + 3 x + 1 = 0' )
  ^^ console ~ writeLine( '', 'Associated coefficients:' )
  ^^ console ~ writeLine( '  1,3,3,1' )
  ^^ console ~ writeLine( '', 'Command to perform:' )
  ^^ console ~ writeLine( '  roo rootfinder 1,3,3,1' )
  ^^ console ~ writeLine( '', 'When the comma_separated_coefficients value is absent,', 'they are read from the 1st line of the default input stream.' )
  exit 1

1.1.68 secantGraph.rooProgram

-- secantGraph.rooProgram
-- this program prepares the graph of the secant function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ mathX

xLimit = 10

yLimit = 10

graphPropsFile = 'secantGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# secantGraph.props -- created by program: secantGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=Sec X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the parabola points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by .1
  if math ~ secant( i ) <> 'undefined' then
    call charout graphPropsFile, i',' || math ~ secant( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.69 showQuip.rooProgram

/* showQuip.rooProgram
 show a quip du jour
 
 usage:
   roo showQuip < quipFile.dat [ > outFile ]

  Distribution file "quips.dat" contains many quips
*/

if arg(1) <> '' then
  signal usagemsg

quips = ^^ inLineFile( '' ) -- read all lines in the default input stream

if quips ~ isEmpty then do
  ^^ console ~ writeLine( "The input file is empty." );
  exit 1
  end 

say quips[ random( 1, quips ~ size ) ] -- write quip

exit 0

usagemsg :

  ^^ console ~ writeLine( ,
    'No arguments are expected.'                    , ,
    ''                                              , ,
    'Usage : '                                        , ,
    '   roo showQuip < quipFile.dat [ > outFile ]'  , ,
    ''                                              , ,
    'Example : '                                      , ,
    '  roo showQuip < quips.dat' )

1.1.70 sineGraph.rooProgram

-- sineGraph.rooProgram
-- this program prepares the graph of the sine function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ math

xLimit = 10

graphPropsFile = 'sineGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# sineGraph.props -- created by program: sineGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='1
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=Sine X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' 1

--add the points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by .1
  call charout graphPropsFile, i',' || math ~ sine( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.71 solveIt.rooProgram

-- SolveIt.rooProgram
-- this program solves a system of simultaneous equations

-- this program is executed by TopHat. The associated command is:
--  tophat solveIt

-- refer to the SolveIt.topHat file, and TopHat!(TM) program
-- documentation, to understand how the solveIt.rooProgram
-- is invoked.

-- this program communicates with TopHat.EXE via the registry

-- a tab delimited request is received from registry value:
--  HKLM\Software\Kilowatt Software\roo\SolveIt[Request]

-- a tab delimited response is returned in registry value:
--  HKLM\Software\Kilowatt Software\roo\SolveIt[Response]

tab = d2c( 9 )

-- get TopHat request 

request = value( "HKLM\Software\Kilowatt Software\roo\SolveIt[Request]", , "Registry" )

response = '?' || tab || '?'

'set ROOREGISTRYWRITE=Y'   -- enable registry writing 

call value "HKLM\Software\Kilowatt Software\roo\SolveIt[Response]", response, "Registry"

-- parse tab delimited request fields -- equations to solve 

parse var request a (tab) b (tab) c (tab) d (tab) e (tab) f (tab) g (tab) h

call validate a, b, c, d, e, f, g, h

eq = { a, b, c, d, e, f, g, h }

eq_id = { 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H' }

loop ix over eq
  if eq[ ix ] = '' then leave
  if ix >= words( a ) then do
    'msgbox There should only be' ( words( a ) - 1 ) 'equations. Equation' eq_id[ ix ] 'should be empty.'
    exit 2
    end 
  end 

matrixFile = 'solveit_Temp_'right( date( 'B' )time( s ), 8 )

loop ix over eq
  if translate( eq[ ix ], ' ', '-' ) = '' then leave
  call lineout matrixFile, translate( space( eq[ ix ] ), ',', ' ' )
  end 

call lineout matrixFile -- close the file

-- the 'matrixOperation.rooProgram' solves the equation
-- and writes the solution as a line to the default output stream (stdout).
-- the output line is obtained from the stack.

'roo matrixOperation' matrixFile 's (stack'

'erase' matrixFile

if \ queued() then do
  'msgbox There is no solution for your equations. They are equivalent, or inconsistent.'
  exit 1
  end 

parse pull solution

-- prepare tab delimited TopHat response  

call value "HKLM\Software\Kilowatt Software\roo\SolveIt[Response]", translate( solution, tab, ',' ), "Registry"

return 0

-- the 'validate' procedure
-- assures all equations are specified correctly

validate  :  procedure
  parse arg a, b, c, d, e, f, g, h

  order = words( a )

  if order = 0 then do
    'msgbox The 1st equation is empty.'
    exit 2
    end 

  call assertAllNumeric a, 'A'

  call assertValidOrder b, 'B', order

  call assertAllNumeric b, 'B'

  eq = { c, d, e, f, g, h }

  eq_id = { 'C', 'D', 'E', 'F', 'G', 'H' }

  do i=3 to order - 1
    ix = i - 2
    call assertValidEquation eq[ ix ], eq_id[ ix ], order
    end 

  return 

-- the 'assertValidEquation' procedure
-- assures a specific equation is specified correctly

assertValidEquation  :  procedure
  parse arg eq, id, order

  if eq = '' then do
    'msgbox There should be at least' (order-1) 'equations. Equation' id 'is empty.'
    exit 2
    end 

  call assertValidOrder eq, id, order

  call assertAllNumeric eq, id

  return 

-- the 'assertAllNumeric' procedure
-- assures all values in an equation are numeric

assertAllNumeric  :  procedure
  parse arg eq, id

  do while eq <> ''
    parse var eq n eq
if datatype( n ) <> 'NUM' then do
      'msgbox Equation' id 'has a non-numeric value.'
exit 2
end 
    end 

  return 

-- the 'assertValidOrder' procedure
-- assures an equation has the correct number of values

assertValidOrder  :  procedure
  parse arg eq, id, order

  if words( eq ) <> order then do
    'msgbox Equation' id 'should have' order 'values.'
exit 2
    end 

  return 

1.1.72 sumdisk.roo

/* sumdisk.roo
 summarize disk folder tree from current folder downward

 for a complete description of program usage see: sumdisk.rooProgram

 For each folder level the following are identified:
  1. total size of all files in folder [true size, rounded by cluster size]
  2. number of files in the folder
  3. date and time of most recently modified file in folder
  4. biggest file size in folder
  5. full folder path name [with leading hierarchic indentation indicators]

 The report includes leading "disk" summary information. Then, folder
 summary output is produced recursively, in hierarchic order, from the
 starting folder downward. The report concludes with the total space used
 by ALL of the folders that were analyzed.

 The resulting folder summary information can be sorted in various ways:
   by descending size,      when disk space must be reduced
   by descending date&time, to identify folders that need to be backed up
   by descending biggest size, to identify folders with biggest files
*/

local report cluster_size console

initialize  :  method

  report = arg( 1 ) -- report output class instance

  numeric digits 16 -- prepare for large space usage

  console = ^^ console -- log progress to the console

  ^ diskFreeSpaceAnalysis -- analyze disk free space

  -- prepare folder analysis title lines

  report ~ writeLine( '    Folder Summary' )

  report ~ writeLine( right( 'Size', 14 ) '#Files  Newest date & time' right( 'Biggest', 14 ) 'Folder Path' )

  -- analyze folders and show total of files within folder tree

  report ~ writeLine( ' Total size of files in analyzed folders is:' ^ do_subfolders( ^^ folderContext, ' +' ) )

  return ''

 -- DO_SUBFOLDERS procedure
 -- analyze files in this folder
 -- and recursively analyze all subfolders

do_subfolders  :  method

  arg folderCtx, indent  -- folder context, folder output indentation prefix

  total = 0 -- total file size in this folder and ALL subfolders downward
  
  console ~ writeLine( indent || folderCtx ~ toString ) -- show current folder

  total = total + do_files( folderCtx ) -- add file utilization to total

  report ~ writeLine( indent || folderCtx ~ toString ) -- report current folder name

  --
  -- process subfolders
  --

  subfolders = folderCtx ~ getSubfolders
  
  loop index over subfolders

    console ~ writeLine( subfolders[ index ] ~ tostring )  -- show subfolder name
	    
    subCtx = ^^ folderContext( subfolders[ index ] ~ tostring ) -- subfolder context

	total = total + do_subfolders( subCtx, indent'+-' ) -- add subfolder size to total

    end 

  return total -- total used in this folder

 -- DO_FILES procedure
 -- analyze all files in this folder
 -- total size of all files [with each file size rounded to cluster size]
 -- also,
 --  identify date and time of most recently modified file in folder
 --  identify biggest file size in folder

do_files  :  procedure

  arg folderCtx   -- folder context

  file_total = 0  -- total file size in current folder

  newest = ''     -- this retains newest file date and time

  biggest = 0     -- this retains biggest file size

  --
  -- process all files in the current folder
  --

  files = folderCtx ~ getFiles

  loop index over files

parse value files[ index ] ~ toDetailedString with dateTime fsize .

    --
    -- round file size to a whole number of disk clusters
    --

    fsize = cluster_size * trunc( ( fsize + cluster_size - 1 ) / cluster_size )

    file_total = file_total + fsize -- add file size to total

    if dateTime > newest then       -- check date & time
      newest = dateTime             -- this file is newest in folder

    biggest = max( biggest, fsize ) -- determine biggest size in folder

    end 

  --
  -- report file summary information, in this folder
  --

  report ~ writeCharacters(       ,
    right( file_total, 14 ) right( files ~ size, 6 ) left( newest, 19 ) right( biggest, 14 ) )

  --
  -- return total file size in this folder
  -- to the do_subfolders method above
  --

  return file_total

  --
  -- analyze current disk utilization
  -- and determine 'cluster size'
  --

diskFreeSpaceAnalysis  :  method

  driveCtx = ^^ driveContext -- current drive

  -- get drive information

  parse value driveCtx ~ toDetailedString with . . total_space free_space cluster_size .

  if total_space <> '_' then do

      numeric digits 20 -- be prepared for some large drives

      -- determine amount of space that is free

	  percent_free = trunc( ( free_space * 100 ) / total_space, 1 )

      -- write disk information to report

	  report ~ writeLine(                                                                       ,
		  '    Summary of' driveCtx ~ toString 'disk. Prepared at' time() 'on' date()                       , ,
		  '  Total space:' total_space', free:' free_space',' percent_free'% is free'         , ,
		  '  Cluster size for' driveCtx ~ toString 'disk files is:' cluster_size )

end 

  else 
    cluster_size = 0

  return cluster_size

1.1.73 sumdisk.rooProgram

/* sumdisk.rooProgram
 summarize disk folder tree from current folder downward

 For each folder level the following are identified:
  1. total size of all files in folder [true size, rounded by cluster size]
  2. number of files in the folder
  3. date and time of most recently modified file in folder
  4. biggest file size in folder
  5. full folder path name [with leading hierarchic indentation indicators]

 The report includes leading "disk" summary information. Then, folder
 summary output is produced recursively, in hierarchic order, from the
 starting folder downward. The report concludes with the total space used
 by ALL of the folders that were analyzed.

 The resulting folder summary information can be sorted in various ways:
   by descending size,      when disk space must be reduced
   by descending date&time, to identify folders that need to be backed up
   by descending biggest size, to identify folders with biggest files

 This procedure could be modified in various ways. For example, if you are
 looking for the most recent copy of a file that is contained in multiple
 folders, you could compare the "fname" value versus a target file name
 as each file is processed in the "do_files" procedure. When matching files
 are located, associated file information and folder information could be
 displayed.

 Keywords
   Disk management, Folder analysis, Recursive folder file search example

 Usage
   roo sumdisk [>summary_output_file]

 Arguments
  N/A

 Files used

  Standard output: disk summary report [usually redirected]

  Console immediate output: shows progress through folder levels

 Exit codes
   0   => summary report complete
 non-0 => an error occurred

 Input record format
  N/A

 Sample input file
  N/A

 Sample output file
  +-----------------------------------------------------------------------------+
  |    Summary of G disk. Prepared at 05:35:50 on 15 May 2001                   |
  |  Total space: 15093387264, free: 12326969344, 81.6% is free                 |
  |  Cluster size for G disk files is: 4096                                     |
  |                                                                             |
  |    Folder Summary                                                        |
  |          Size #Files  Newest date & time        Biggest Folder Path      |
  |       3870720    373 2001/05/15-05:35:50         651264 +G:\r4              |
  |      19980288     33 2001/05/15-05:29:46        6287360 ++-G:\r4\Debug      |
  |         49152      3 2001/05/11-16:40:32          32768 ++-G:\r4\examples   |
  |      20164608     27 2001/05/14-14:38:55        6332416 ++-G:\r4\RDebug     |
  |       7716864     24 2001/05/15-05:31:33        4841472 ++-G:\r4\Release    |
  |       1003520    194 2001/04/24-11:51:23         110592 ++-G:\r4\tc         |
  |      18063360     26 2001/04/17-12:57:30        5382144 ++-G:\r4\TDebug     |
  | Total size of files in analyzed folders is: 70848512                    |
  +-----------------------------------------------------------------------------+

 Example of use
   roo sumdisk >d:harddisk.sum

 Explanation
  In the example above, a summary report is produced for the current disk,
  and the current folder downward. The report is saved in file
  "d : harddisk.sum". The request is performed in the "G:\r4" folder
  of the "G" disk. The total size in all folders is 70848512.
*/

arg x .

  --
  -- no arguments are expected
  --

if x <> '' then
  signal usagemsg

^^ sumdisk( ^^ outstream ) -- processing is performed by: sumdisk.roo
                           -- report output is written to the
                           -- default output stream

exit 0

  --
  -- show program usage information
  --

usagemsg :

  ^^ console ~ writeLine( ,
        'No arguments are expected.'                                , ,
        ''                                                          , ,
        'Usage : '                                                    , ,
        '  roo sumdisk [ > outfile ]'                               , ,
        ''                                                          , ,
        'The sumdisk program summarizes folder information'         , ,
        'for the current folder, and its subfolders.'               , ,
        ''                                                          , ,
        'Please establish the current disk & folder to analyze'     , ,
        'prior to executing the sumdisk program' )

1.1.74 tangentGraph.rooProgram

-- tangentGraph.rooProgram
-- this program prepares the graph of the tangent function

-- it uses the Poof!(TM) program named GraphIt

math = ^^ math

xLimit = 10

yLimit = 10

graphPropsFile = 'tangentGraph.props'

'erase' graphPropsFile

-- prepare the graph properties

call lineout graphPropsFile, '# tangentGraph.props -- created by program: tangentGraph.rex'
call lineout graphPropsFile, 'quadrants=4'
call lineout graphPropsFile, 'bgColor=gainsboro'
call lineout graphPropsFile, 'fgColor=mediumblue'
call lineout graphPropsFile, 'textColor=blue'
call lineout graphPropsFile, 'lineWidth=3'
call lineout graphPropsFile, 'insideColor=lightskyblue'
call lineout graphPropsFile, 'gridColor=lightgoldenrodyellow'
call lineout graphPropsFile, 'xLimit='xLimit
call lineout graphPropsFile, 'yLimit='yLimit
call lineout graphPropsFile, 'fontName=sansserif'
call lineout graphPropsFile, '# fontStyle=bold'
call lineout graphPropsFile, 'fontSize=12'
call lineout graphPropsFile, 'xCaption=Tangent X : -'xLimit '..' xLimit
call lineout graphPropsFile, 'yCaption=Y limit :' yLimit

-- add the parabola points

call charout graphPropsFile, 'pointSet='

do i=-xLimit to xLimit by .1
  call charout graphPropsFile, i',' || math ~ tangent( i ) || ';'
  end 

call lineout graphPropsFile, ''

call lineout graphPropsFile -- close the file

-- display the graph using the Poof!(TM) program named GraphIt

'graphit' graphPropsFile

1.1.75 testRooDll.cpp

// testRooDll.cpp

// build:
//  cl /GX testRooDll.cpp

# include <stdlib.h>
# include <string.h>
# include <stdio.h>
# include <iostream.h>
# include <fstream.h>
# include <strstrea.h>
# include <tchar.h>
# include <ctype.h>

# include <set>

# include <string>

# include <vector>

using namespace std;

# define WIN32_LEAN_AND_MEAN
# include <windows.h>

# include "roodll.h"

// the 'GlobalHandleStore' class is a handy wrapper class for a global handle
// that is returned by a roo.dll entry point. A helpful casting operator converts
// a global handle to a safe 'const char*'. This obviates the use of actual Global*
// function calls within the body of the testRooDll.cpp program. In addition,
// the class implicitly frees the handle when the instance context concludes.

class GlobalHandleStore
{
public :

	GlobalHandleStore( HGLOBAL hGlobal=NULL )
	{
		_hGlobal = hGlobal;
	}

	virtual ~GlobalHandleStore()
	{
		if( _hGlobal )
			GlobalFree( _hGlobal );
	}

	operator const char* () const
	{
		const char* pResult = IsValid() ? (const char*) GlobalLock( _hGlobal ) : "";
		if( IsValid() )
			GlobalUnlock( _hGlobal );
return pResult;
	}

protected :

	bool IsValid() const
	{
return 
			_hGlobal && GlobalFlags( _hGlobal ) != GMEM_INVALID_HANDLE ? true
			: false;
	}

protected :

	HGLOBAL _hGlobal;
};

extern "C"
{
	// the PerformCallback function is invoked by the roo! 'callback' built-in function

	GLOBALHANDLE CALLBACK PerformCallback(
		LPCSTR invocationContext,
		LPCSTR pCallbackOption,
		... )
	{
		cout << "testRooDll callback, option '" << pCallbackOption << "' received arguments:" << endl;

		// process callback arguments
		// a variable number of arguments follow the pMethod parameter of this function
		
		try
		{
			va_list pStrs; // variable value name iteration list
			
			// establish initial position
			
			va_start( pStrs, pCallbackOption );

int argno=1;
			
			for( LPCTSTR pCurrentStr = va_arg( pStrs, LPCTSTR ); // advance to parameter after pMethod
			
			/**/ pCurrentStr != NULL; // continue for all parameter strings
			
			/**/ pCurrentStr = va_arg( pStrs, LPCTSTR ) ) // advance to next parameter string
			{
				
				cout << argno++ << ". " << pCurrentStr << endl;
			}
			
			// va_end( pStrs ); // conclude key name iteration
		}
		
		catch( ... )
		{
			cerr << "A bad string locator was passed to the testRooDll callback" << endl;
		}

		// invoke the method that is being called back

		string sResult( "all is swell" );

		// convert the method result to a global handle

int lenText = sResult.size();

		GLOBALHANDLE gHandle = GlobalAlloc( GHND, sizeof( TCHAR ) * ( lenText + 1 ) );

		if( gHandle )
		{
			_tcscpy( (LPTSTR) (LPVOID) GlobalLock( gHandle ), sResult.c_str() );
			GlobalUnlock( gHandle );
		}

		// return the result global handle
		// to the function in the program associated with the ExternalClass.
		// the global handle must be freed by the external program !

return gHandle;
	}

	typedef GLOBALHANDLE (WINAPI* entry_point_with_callback_t ) (
		LPCSTR invocationContext,
		LPCTSTR pCallbackOption,
		LPCSTR pEntryPointName,
		... );

	typedef GLOBALHANDLE (WINAPI* execute_function_t ) (
		LPCSTR pBuiltinFunctionName,
		... );

	typedef GLOBALHANDLE (WINAPI* remove_instance_t ) ( LPCSTR pInstance, ... );

	typedef GLOBALHANDLE (CALLBACK* callback_method_t ) ( LPCSTR invocationContext, LPCTSTR pCallbackOption, ... );

	typedef void (WINAPI* set_callback_method_t ) ( LPCSTR invocationContext, callback_method_t, ... );

	typedef void (WINAPI* terminate_method_t ) ( LPCSTR invocationContext, ... );
};

int main( int argc, char* argv[] )
{
	cout << "testRooDll loading roo.dll library" << endl;
 
	HINSTANCE _hInstLib = LoadLibraryA( "roo.dll" );
	if( _hInstLib == NULL )
	{
		cerr << "Program roo.dll was not found." << endl;
		exit( 1 );
	}

	{
		cout << "testRooDll setting callback" << endl;

		set_callback_method_t pMethod = (set_callback_method_t) GetProcAddress( _hInstLib, "SetCallback" ) ;

		if( ! pMethod )
		{
			cerr << "Could not locate 'SetCallback' roo.dll library entry." << endl;
			exit( 1 );
		
		}

		pMethod( "_", PerformCallback ); 
	}

	{
		cout << "testRooDll performing procedure: extroo.rooProgram (with callback: 'another')" << endl;

		entry_point_with_callback_t pMethod = (entry_point_with_callback_t) GetProcAddress( _hInstLib, "PerformWithCallback" ) ;

		if( ! pMethod )
		{
			cerr << "Could not locate 'Perform' roo.dll library entry." << endl;
			exit( 1 );
		}

		GlobalHandleStore globalHandleStore( pMethod( "_", "another", "extroo.rooProgram", "arg1", "arg2", NULL ) ); 

		string sResult = (const char*) globalHandleStore; // any result ?

		cout << "Perform: " << sResult.c_str() << endl;
	}

	{
		cout << "testRooDll executing built-in function: SquareRoot" << endl;

		execute_function_t pMethod = (execute_function_t) GetProcAddress( _hInstLib, "ExecuteFunction" ) ;

		if( ! pMethod )
		{
			cerr << "Could not locate 'ExecuteFunction' roo.dll library entry." << endl;
			exit( 1 );
		}

		GlobalHandleStore globalHandleStore( pMethod( "SquareRoot", "31", NULL ) ); 

		string sResult = (const char*) globalHandleStore; // any result ?

		cout << "ExecuteFunction: " << sResult.c_str() << endl;
	}

	string sInstance;

	{
		cout << "testRooDll creating class: vector" << endl;

		entry_point_with_callback_t pMethod = (entry_point_with_callback_t) GetProcAddress( _hInstLib, "CreateClassWithCallback" ) ;

		if( ! pMethod )
		{
			cerr << "Could not locate 'CreateClass' roo.dll library entry." << endl;
			exit( 1 );
		}

		GlobalHandleStore globalHandleStore( pMethod( "_", "", "vector", "arg1", "arg2", NULL ) ); 

		sInstance = (const char*) globalHandleStore; // any result ?

		cout << "CreateClass: " << sInstance.c_str() << endl;
	}

	{
		cout << "testRooDll performing: vector ~ tostring" << endl;

		entry_point_with_callback_t pMethod = (entry_point_with_callback_t) GetProcAddress( _hInstLib, "InvokeMethodWithCallback" ) ;

		if( ! pMethod )
		{
			cerr << "Could not locate 'InvokeMethod' roo.dll library entry." << endl;
			exit( 1 );
		}

		GlobalHandleStore globalHandleStore( pMethod( "_", "", sInstance.c_str(), "tostring", NULL ) ); 

		string sResult = (const char*) globalHandleStore; // any result ?

		cout << "InvokeMethod: " << sResult.c_str() << endl;
	}

	{
		cout << "testRooDll removing vector instance" << endl;

		remove_instance_t pMethod = (remove_instance_t) GetProcAddress( _hInstLib, "RemoveInstance" ) ;

		if( ! pMethod )
		{
			cerr << "Could not locate 'RemoveInstance' roo.dll library entry." << endl;
			exit( 1 );
		}

		GlobalHandleStore globalHandleStore( pMethod( sInstance.c_str(), NULL ) ); 

		string sResult = (const char*) globalHandleStore; // any result ?

		cout << "RemoveInstance: " << sResult.c_str() << endl;
	}

return 0;
}

1.1.76 tickler.rooProgram

/* tickler.rooProgram -- calendar note file analyzer

 Description
  A tickler file lookup program, that identifies today's planned
  activities, and looks ahead to tomorrow's activities. If today
  is Friday, it also looks ahead to Monday's activities.

 Keywords
  Calendar reminder service, Calendar-based command initiation, Parsing

 Usage
  roo tickler < tickler.file > tickler.out
  vuHtml tickler.out

 Arguments
  None

 Files used
  Standard output
  Distribution file "kwscal" is an example calendar note input file

 Exit codes
   0   => Tickling completed without errors
 non-0 => Tickling avoided

 Input record formats:

  Format [1]:
   yymmdd text to display on matching date

  Format [2]:
   yymmdd %command-line to perform on matching date
            file redirection is supported within cmd lines!

  The "yymmdd" field is analyzed for the following wild-card matches:
   021115  => 15th November 2002
   xx1115  => any 15th day in November
   0211xx  => any day in November 2002
   02xxxx  => any day in 2002
   02xx15  => any 15th day of the month in 2002
   xx11xx  => any day in November, any year
   xxxx15  => 15th any month
   xxxxxx  => any day
   tuesday => show on tuesday
   xx0704  => %line BooMM! | box

  The somewhat awkward form of "yymmdd" is used,
  because it is the only ordering which can be "sorted".

  If a line begins with ".qu", calendar analysis is discontinued.


 Sample input file

  021030 (monday) Swami's Int'l, Jacob Javits center, NYC, (212) 391-9111
  xx0704 %line BoomMM !!!
  xx10xx October, winter's foothill.
  xxxxxx turn on the radio
  Saturday AM, consolidate business plans
  Sunday %line "Run BACKUP, P-L-E-A-S-E" | box
  Monday Week planning
  Tuesday 7pm, Rexxer's Anonymous

 Sample output file (wrapped by HTML)

  The following appears on Monday, October 30th, 2002 [ie. 021030]

  (monday) Swami's Int'l, Jacob Javits center, NYC, (212) 391-9111
  October, winter's foothill.
  turn on the radio
  Week planning

 Example of use
  roo tickler < tickler.file > tickler.out
  vuHtml tickler.out

 Explanation
  This procedure analyzes lines within standard input for date matches.
  Matched lines are then displayed, or issued as system commands.

  In the example above,
   entries within file "kwscal" are compared for matches with today's date.
*/

trace c

con = ^^ console 

con ~ writeLine( 'Reading input...' )

-- get all input lines

lines = ^^ inLineFile()

-- prepare HTML text output destination

dest = ^^ outstream

-- prepare HTML file prefix

dest ~ writeLine( '<HTML>', ,
        '<HEAD>' , ,
        '<TITLE>Today''s schedule</TITLE>' , ,
        '<link rel=stylesheet type="text/css" HREF="kwsw.css">' , ,
        '<style>LI { font-weight:900; FONT-SIZE:10pt; FONT-FAMILY: "Arial","Helvetica","Sanserif;" }</style>' , ,
        '</HEAD>' , ,
        '<BODY background="backgrnd.gif" bgcolor=LIGHTSTEELBLUE>' , ,
        '<div align=center class=point14sem>Tickler file notes...</div>' )

-- get today, yr, mon, dayofmon, and dayofwk symbols for today's date

today = right( date('Standard'), 6 )

parse var today yr 3 mon 5 dayofmon

dayofwk = date('Weekday')

con ~ writeLine( "Looking for today's events..." )

-- establish patterns to match

patternSet = ^^ set( ,
  today , ,
  'xxxxxx', ,
  yr'xx'dayofmon , ,
  yr || mon'xx' , ,
  'xx'mon || dayofmon , ,
  'xxxx'dayofmon , ,
  'xx'mon'xx' , ,
  dayofwk )

call process_lines ""

con ~ writeLine( "Looking ahead for tomorrow's events..." )

-- revise patterns to match tomorrow's date

-- note: the function 'getTomorrowsDate()' alters
-- the yr, mon, dayofmon, and dayofwk values that
-- are used in subsequent pattern values

patternSet = ^^ set( ,
  getTomorrowsDate() , ,
  yr'xx'dayofmon , ,
  'xx'mon || dayofmon , ,
  'xxxx'dayofmon , ,
  dayofwk )

call process_lines "Tomorrow's events..."

if date('Weekday') = 'Friday' then do

  con ~ writeLine( "Looking ahead for Monday's events..." )

  -- revise patterns to match Monday's date

  -- note: the function 'getMondaysDate()' alters
  -- the yr, mon, dayofmon, and dayofwk values that
  -- are used in subsequent pattern values

  patternSet = ^^ set( ,
      getMondaysDate() , ,
      yr'xx'dayofmon , ,
      'xx'mon || dayofmon , ,
      'xxxx'dayofmon , ,
      'Monday' )

  call process_lines "Monday's events..."

  end 

-- show closing remark and prepare HTML suffix

dest ~ writeLine( '<p><div align=center class=point14sem>'date('W')',' date() , ,
         '<br>Have a good day !</div>' , ,
         '</BODY>' , ,
         '</HTML>' )

-- done !

exit 0

-- process_lines PROCEDURE, process lines in the tickler file
  
process_lines  :  procedure expose dest lines patternSet

  anyMatches = 0

  loop ix over lines     -- process monday's lines in the input tickler file

    parse value lines[ ix ] with day text       -- get "day" selector & text
    
    parse var text action 2 cmd           -- get optional "action" and "cmd"

    action = strip( action )

    if day = '.qu' then                     -- immediate end of tickler file
      leave 

    -- match "day" selector versus alternate forms of "today"

    if patternSet ~ contains( day ) then do

      -- when the first match is found for the current search
      -- a caption is prepared ... if arg(1) <> ''
      -- and an ordered list is started.

      if \ anyMatches then do
          
          anyMatches = 1

        -- prepare HTML caption 

        if arg(1) <> '' then
            dest ~ writeLine( '<div class=point14sem>' || arg(1) || '</div>' )

          dest ~ writeLine( '<ol>' )                  -- start an ordered list

          end 

      -- commands are triggered by a '%' character
      -- commands are not performed if arg(1) <> ''

      if '%' = action || arg(1) then               -- command action trigger
        cmd                                   -- initiate associated command

      else if '!' = action then                         -- highlight trigger
        dest ~ writeLine( '<p><li class=darkred>'cmd )       -- display text

      else 
        dest ~ writeLine( '<p><li>'text )             -- display normal text

      end 

    end 

  if anyMatches then
    dest ~ writeLine( '</ol>' )                       -- end an ordered list

  return 

getTomorrowsDate  :  procedure expose yr mon dayofmon dayofwk

  days = split( 'Monday Tuesday Wednesday Thursday Friday Saturday Sunday', ' ' )

  dayofwkno = days ~ find( dayofwk )           -- identify day of week: 1 to 7

  -- advance to next day

  dayofwkno = dayofwkno + 1

  if dayofwkno > 7 then                              -- wrap when past Sunday
    dayofwkno = 1

  dayofwk = days[ dayofwkno ]

  daysin = split( '31 28 31 30 31 30 31 31 30 31 30 31', ' ' )

  daysinmo = daysin[ mon ]                         -- identify #days in month

  -- identify if this is a leap month

  if mon = 2 then
    if leap( yr ) then
      daysinmo = daysinmo + 1          -- february has 29 days in a leap year 

  dayofmon = dayofmon + 1

  if dayofmon > daysinmo then do

    -- advance to next month

    dayofmon = 1

    mon = mon + 1

    if mon > 12 then do
      mon = 1
      yr = yr + 1
      end 
    
    end 

  return twodigit( yr )twodigit( mon )twodigit( dayofmon )

getMondaysDate  :  procedure expose yr mon dayofmon dayofwk

  today = right( date('Standard'), 6 )

  parse var today yr 3 mon 5 dayofmon

  dayofwk = 'Monday'

  daysin = split( '31 28 31 30 31 30 31 31 30 31 30 31', ' ' )

  daysinmo = daysin[ mon ]                         -- identify #days in month

  -- identify if this is a leap month

  if mon = 2 then
    if leap( yr ) then
      daysinmo = daysinmo + 1          -- february has 29 days in a leap year 

  dayofmon = dayofmon + 3           -- advance to Monday, 3 days after Friday

  if dayofmon > daysinmo then do

    -- advance to next month

    dayofmon = dayofmon - daysinmo

    mon = mon + 1

    if mon > 12 then do
      mon = 1
      yr = yr + 1
      end 

    end 

  return twodigit( yr )twodigit( mon )twodigit( dayofmon )

-- TWODIGIT procedure -- converts numeric argument to two digits

twodigit  :  procedure
  return right( arg( 1 ), 2, '0' )

-- LEAP procedure
-- identify if this year is a leap year (the year 2000 is not a leap year)

leap  :  procedure
  arg yr
  return (yr//4 = 0) & ((yr//100 <> 0) | (yr//400 = 0)) -- after Pope Gregory

1.1.77 timesTable.rooProgram

-- timesTable.rooProgram

tab = '09'x

-- prepare the column headers

say { '', 1,2,3,4,5,6,7,8,9 } ~ toDelimitedString( tab' ' )

say 

do i=1 to 9

  row = {}  -- collect products in a vector

  do j=1 to 9
    row ~ add( right( i * j, 2 ) ) -- add i x j to vector
    end 

  -- show row I

  say i || tab || row ~ toDelimitedString( tab )

  end 

1.1.78 towersOfHanoi.roo

/* towersOfHanoi.roo
 this is the worker class associated with
 the 'towersOfHanoi.rooProgram'
*/

static nRings -- #rings to display

local console leftTower middleTower rightTower -- three towers (stacks)

preinitialize  :  method
  nRings = value( 'HANOIRINGS', , 'SYSTEM' ) -- get #rings
  return ''

initialize  :  method

  parse arg leftTower, middleTower, rightTower -- get 'hanoiStack' class instances

  console = ^^ console

  -- assign tower captions

  leftTower ~ setCaption( 'left' )
  middleTower ~ setCaption( 'middle' )
  rightTower ~ setCaption( 'right' )

  -- put all of the rings on the left tower

  leftTower ~ addDelimitedString( reverse( sequence( 1, nRings ) ), ' ' )

  -- display initial position

  ^ display

  -- cycle until done

  ^ cycle

  -- done !

  return ''

cycle  :  method

  -- process until the left & middle towers are empty

  do until leftTower ~ isEmpty & middleTower ~ isEmpty

    -- transfer a ring from the left tower to the other two
    -- until the left tower is empty

    do while leftTower ~ isNonEmpty

      leftTop = leftTower ~ top

      call transfer leftTop, leftTower, rightTower, middleTower

      ^ display

      end 

    -- transfer a ring from the middle tower to the other two
    -- until the middle tower is empty

    do while middleTower ~ isNonEmpty

      middleTop = middleTower ~ top

      call transfer middleTop, middleTower, rightTower, leftTower

      ^ display

      end 

    end 

  return ''

-- transfer a ring from one tower to a specific tower
-- possibly using the other tower if necessary

transfer  :  method

  arg widthOfRing, fromTower, toTower, otherTower -- get arguments

  -- if the ring at the top of the 'toTower' is too big
  -- then transfer it to the 'otherTower'

  -- this results in interesting recursion

  do while toTower ~ isNonEmpty & widthOfRing > toTower ~ top

    call transfer toTower ~ top, toTower, otherTower, fromTower -- recurse !

    ^ display

    end 

  -- now we can move the topmost ring on the 'fromTower'
  -- to the top of the 'toTower'

  toTower ~ push( fromTower ~ pull )

  return ''

-- display current ring positions on three towers

display  :  method

  'cls' -- clear the screen

  -- get tower display lines

  leftTowerLines = leftTower ~ getDisplayLines

  middleTowerLines = middleTower ~ getDisplayLines

  rightTowerLines = rightTower ~ getDisplayLines

  -- prepare output lines

  out = ''

  loop i over leftTowerLines
    out = out center( leftTowerLines [ i ], 26 )   center( middleTowerLines [ i ], 26 )  center( rightTowerLines [ i ], 26 )
    out = out '0a'x
    end 

  console ~ writeLine( out ) -- show lines on the console

  call nap 10 -- take a short snooze between display presentations

  return ''

-- prepare a contiguous sequence of numbers between a 'low' value and a 'high' value

sequence  :  procedure
  parse arg lo, hi
  seq = ''
  do i=lo for hi
    seq = seq i
    end 
  return strip( seq )

1.1.79 towersOfHanoi.rooProgram

/* towersOfHanoi.rooProgram

 a roo implmentation of the hanoi tower game, whereby rings are rearranged between 3 pegs,
 with the rule that a larger ring cannot be placed on top of a smaller ring

                STARTING POSITION
               -------------------

        |              |              |
      [ . ]            |              |
     [ . . ]           |              |
    [ . . . ]          |              |
  =============  =============  =============
      left           middle         right


                  GOAL POSITION
                 ---------------

        |              |              |
        |              |            [ . ]     
        |              |           [ . . ]    
        |              |          [ . . . ]   
  =============  =============  =============
      left           middle         right

 usage
   roo hanoi2 #rings [on first peg]

 note:
  this program performs simple animation by using the NAP.EXE program
  to wait for 50 milliseconds between cycles
*/

trace off

arg nRings .

if nRings = '' then
  nRings = 5

else if \ datatype( nRings, 'W' ) then
  call usageMsg 'Please specify the number of rings to display -- between 3 and 7, inclusive'

else if nRings < 3 || nRings > 7 then
  call usageMsg 'Please specify the number of rings to display -- between 3 and 7, inclusive'

call value 'HANOIRINGS', 5, 'SYSTEM'    -- set global environment variable -- #rings

-- create 'towersOfHanoi' class instance,

-- the 'initialize' method of the 'towersOfHanoi' class instance
-- does everything !

-- the class parameters are three 'hanoiStack' class instances

^^ towersOfHanoi( ^^ hanoiStack, ^^ hanoiStack, ^^ hanoiStack )

-- done !

exit 0

-- 'usageMsg' displays how to use the program

usageMsg :

  ^^ console ~ writeLine( 'Note:' arg(1), '', 'Usage', '  roo towersOfHanoi #rings [default #rings: 5]' )

1.1.80 udpClient.rooProgram

-- udpClient.rooProgram

parse arg server port

if port = '' then
  signal usagemsg

if \ datatype( port, 'W' ) then
  signal usagemsg

-- establish a UDP socket

sock = ^^ socket( 'UDP' )

^^ console ~ writeLine( 'Sending...' )

sock ~ sendTo( server, port, 'Hello, World!' )

-- receive response

data = sock ~ receiveFrom( 50000 )

say data

sock ~ sendTo( server, port, 'Quit' )

exit 0

usagemsg :

  if arg( 1 ) <> '' then
    ^^ console ~ writeLine( arg( 1 ), '' )

  ^^ console ~ writeLine( 'Usage:', '  roo udpClient server port' )

  exit 1

1.1.81 udpServer.rooProgram

-- udpServer.rooProgram

parse arg port

if port <> '' & \ datatype( port, 'W' ) then
  signal usagemsg

if port = '' then
  port = 1432

-- establish a UDP socket

sock = ^^ socket( 'UDP' )

sock ~ bind( port )

^^ console ~ writeLine( 'Receiving...' )

-- remove the following line if the udpClient
-- program is running on another system.

'start roo udpClient' sock ~ getHostName() port

do forever

  -- receive data, 50000 bytes at a time

  data = sock ~ receiveFrom( 50000 )

  say 'Received:' data

  if length( data ) = 0 then
    leave 

  -- process data here...

  if translate( data ) = 'QUIT' then
    leave 

  parse value sock ~ hostInformation with requestor requestPort type hostname

  sock ~ sendTo( requestor, requestPort, translate( data ) )

  end 

exit 0

usagemsg :

  if arg( 1 ) <> '' then
    ^^ console ~ writeLine( arg( 1 ), '' )

  ^^ console ~ writeLine( 'Usage:', '  roo udpServer [ port ]' )

  exit 1

1.1.82 urlget.rooProgram

-- urlget.rooProram

parse arg URL outFile

-- validate URL

if URL = '' then
  call usagemsg 'Please specify the URL to fetch'

parse var URL protocol'://'server'/'file

if protocol <> 'http' then
  call usagemsg 'The URL must begin with http://'

if file = '' then
  call usagemsg 'You must specify a specific file to retrieve'

if outFile = '.' then
  outFile = file

if outFile <> '' then
  call promptToReplaceOutputFile outFile

-- establish a TCP socket connection using the HTTP protocol

httpProtocolPort = 80

sock = ^^ socket( 'TCP', server, httpProtocolPort )

if \ datatype( sock, 'Instance' ) then
  call usagemsg 'Could NOT establish connection with server:' server || '0a0d'x || 'Are you connected to the internet ?'

-- send HTTP get request for the specified URL

sock ~ send( 'GET' URL || '0d0a0d0a'x )

value = ''

^^ console ~ writeLine( 'Receiving...' )

do forever

  -- receive data, 50000 bytes at a time

  data = sock ~ receive( 50000 )

  if length( data ) = 0 then
    leave 

  value = value || data

  end 

if length( value ) = 0 then
  call usagemsg 'The URL could not be received. The URL was:' URL

if outFile <> '' then
  'erase' outFile

call charout copies( outFile, outfile <> '-' ), value

^^ console ~ writeLine( length( value ) 'bytes were written to file:' outFile )

exit 0

promptToReplaceOutputFile  :  procedure
  outFile = arg( 1 )

  if stream( outFile, 'C', 'exists' ) then do

    mb = ^^ msgbox( 'File' outFile 'exists, do you want to replace it ?' )

    mb ~ setCaption( 'URLGET' ) ~ showButtons( 'YESNO' ) ~  showIcon( 'QUESTIONMARK' ) ~ setDefaultButton( 'SECOND' )

    if mb ~ emit <> 'YES' then
      exit 1

    end 

  return 

usagemsg :

  if arg( 1 ) <> '' then
    ^^ console ~ writeLine( arg( 1 ), '' )

  ^^ console ~ writeLine( 'Usage:', '  roo urlget URL [ outFileName | . ]', ,
       '', 'Examples ... all of the following examples write URL content to file: default.htm', ,
       '', ' Ex1:', '  roo urlget http://www.kilowattsoftware.com/default.htm default.htm', ,
       '', ' Ex2:', '  roo urlget http://www.kilowattsoftware.com/default.htm .', ,
       '', ' Ex3:', '  roo urlget http://www.kilowattsoftware.com/default.htm > default.htm', ,
       '', 'When the output file name is a period, URL content is written to a file derived from the end of the URL.' , ,
       '', 'When the output file name is omitted, URL content is written to the default output stream.' )

  exit 1

1.1.83 winlist.cpp

// winlist.cpp : Defines the entry point for the DLL application.
//

# pragma warning( disable : 4786 )

#include "winlist.h"

# include <map>

# include <iostream>

# include <string>

using namespace std;

map< string, callback_method_t > _aCallback;

string g_sCurrentInvocationContext;

string g_sCallbackMethodName;

BOOL __stdcall ListWindows(
	HWND hwnd,
	LPARAM lParam )
{
	char szNum[ 50 ];
	_ultoa( (DWORD) hwnd, szNum, 10 );

	char szCaption[ 1000+1+1 ];
	GetWindowText( hwnd, szCaption, 1000 );

	char szClass[ 1000+1+1 ];
	GetClassName( hwnd, szClass, 1000 );

# if 0 // ifdef _DEBUG
	cerr << "Performing callback, context: " << g_sCurrentInvocationContext.c_str() << ", method: " << g_sCallbackMethodName.c_str() << endl;
# endif

	callback_method_t CallbackMethod = _aCallback[ g_sCurrentInvocationContext ];

	GLOBALHANDLE gh =
		CallbackMethod(
			g_sCurrentInvocationContext.c_str(),
			g_sCallbackMethodName.c_str(),
			szNum,
			szCaption,
			szClass,
			NULL );

	if( gh )
		GlobalFree( gh );

return TRUE;
}

extern "C"
{
	WINLIST_API GLOBALHANDLE WINAPI Initialize( LPCSTR invocationContext, LPCSTR pOther, ... )
	{
return 0;
	}

	WINLIST_API void WINAPI SetCallback( LPCSTR invocationContext, callback_method_t CallbackMethod, ... )
	{
		_aCallback[ invocationContext ] = CallbackMethod;
	}

	WINLIST_API GLOBALHANDLE WINAPI List( LPCSTR invocationContext, LPCSTR pCallbackMethodName, ... )
	{
		g_sCurrentInvocationContext = invocationContext;

		g_sCallbackMethodName = pCallbackMethodName;

		EnumWindows( (WNDENUMPROC) ListWindows, 0 );

return 0;
	}

	WINLIST_API void WINAPI Terminate( LPCSTR invocationContext, ... )
	{
		_aCallback.erase( invocationContext );
	}
};

1.1.84 winlist.h

# define WIN32_LEAN_AND_MEAN
# include <windows.h>

// The following ifdef block is the standard way of creating macros which make exporting 
// from a DLL simpler. All files within this DLL are compiled with the WINLIST_EXPORTS
// symbol defined on the command line. this symbol should not be defined on any project
// that uses this DLL. This way any other project whose source files include this file see 
// WINLIST_API functions as being imported from a DLL, wheras this DLL sees symbols
// defined with this macro as being exported.
#ifdef WINLIST_EXPORTS
#define WINLIST_API __declspec(dllexport)
#else
#define WINLIST_API __declspec(dllimport)
#endif

extern "C"
{
	// note: the triple dots at the end of these prototypes circumvents C++ decorated name challenges !

	// multiple additional parameters are potentially passed for the Initialize function,
	// and functions that are invoked by a roo ExternalClass 'perform' method request

	typedef GLOBALHANDLE (CALLBACK* callback_method_t ) ( LPCSTR invocationContext, LPCSTR pMethod, ... );

	WINLIST_API GLOBALHANDLE WINAPI Initialize( LPCSTR invocationContext, LPCSTR pOther, ... );

	WINLIST_API void WINAPI SetCallback( LPCSTR invocationContext, callback_method_t Callback, ... );

	WINLIST_API void WINAPI Terminate( LPCSTR invocationContext, ... );

	// the following function is invoked by a roo ExternalClass 'perform' method request

	WINLIST_API GLOBALHANDLE WINAPI List( LPCSTR invocationContext, LPCSTR pPattern, ... );
};

1.1.85 winlist.roo

/* winlist.roo
 this program is the worker class associated with the winList.rooProgram

 since this program is an extension of ExternalClass,
 various methods can be called back from the external program.

 the 'another' method below is a callback method !
*/

shared count resultTable

winList  :  class extends ExternalClass

initialize  :  method

  -- parse arg programName .. the first initialization argument is the ExternalClass program name
                           -- this argument is not used here
						   -- it is implicitly passed to the base class during class construction

  resultTable = ^^ table( '#', 'Caption', 'Class', 'WindowId' )

  count = 0

  ^ perform( 'List', 'another' ) -- obtain information about all active windows
                                 -- 'List' is a function in the ExternalClass program (winlist.dll)
                                 -- call back 'another' method

  call HtmlPrefix 'Active windows'  -- prepare preliminary HTML text

  say '<h1>Active windows</h1>'     -- prepare preliminary HTML text

  say resultTable ~ toHtmlString    -- emit table body

  call HtmlSuffix                   -- prepare conclusion HTML text
  
  return ''

another  :  method -- callback method !

  parse arg windowId, windowName, windowClass -- these arguments came from the 'List' function of winlist.dll

  count = count + 1

  resultTable ~ addAggregate( { count, windowName, windowClass, windowId } )

  return ''

1.1.86 winlist.rooProgram

/* WinList.rooProgram
 this program lists information about active windows.

 the winlist.roo class is an extension of the ExternalClass class.

 the class constructor activates the winlist.dll program.
*/

^^ winlist( 'winlist.dll' ) -- list information from the 'winlist.dll' program

1.1.87 xmlTree.roo

-- xmlTree.roo

-- the 'xmltree' class converts a list of XML lines
-- to a tree of XML tags, and optional
-- element content values.

-- this program is an excellent example
-- of the use of the 'tree' built-in class.
-- it is also a useful program for processing
-- XML.

-- you might want to alter this program in 2 ways:
--  1. you might want to process information, by
--     altering the code in the 'printSubTree' procedure
--  2. you might want to invoke a method in a class
--     that EXTENDS the xmlTree class
--     at the end of the 'processXmlSegment' method.

-- the 'printTree' method shows how to traverse nodes
-- of the 'tree' built-in class. it uses the
-- 'printSubTree' procedure recursively.

static xmlStack -- locates upwards XML nodes

static xmlText -- the current XML text remaining to be processed

-- the 'xmltree' class is 'explicitly' derived from
-- the 'tree' built-in class. It is explicitly derived
-- because different arguments are processed during
-- instance initialization.

xmlTree  :  class extends Tree explicitly

-- the 'initialize' method prepares an XML tree node

initialize  :  method

   -- make sure the base class is constructed

  'base' ~ initialize

  -- either a list of XML lines will be processed,
  -- or a node value will be prepared.

  xmlLineListOrValue = arg( 1 )

  -- when the argument is not an instance,
  -- a node value will be prepared.

  if \ datatype( xmlLineListOrValue, 'Instance' ) then do

    -- when the argument is not '_' a simple node is prepared

    if xmlLineListOrValue <> '_' then do
      ^ setContent( xmlLineListOrValue )
      return ''
      end 

    -- when the argument is '_' a subtree is being constructed

    return ''
    end 

  -- a list of XML lines will be processed

  -- 1. eliminate comments

  textList = ^^ list

  inComment = 0

  loop ix over xmlLineListOrValue

    lin = strip( xmlLineListOrValue[ ix ] )

    text = ''

    do while lin <> ''

      if inComment then do
        parse var lin before '-->' lin

        inComment = ( before = '' )
        end 

      if pos( '<!--', lin ) > 0 then do
        parse var lin segment '<!--' lin
        inComment = 1
        end 

      else do
        segment = lin
        lin = ''
        end 

      text = text || strip( segment )

      end 

    if text <> '' then
      textList ~ add( text )
   
    end 

  if textList ~ isEmpty then
    return 'File' xmlFileName 'does not contain any XML content'

  -- 2. join the text into a lengthy string

  xmlText = textList ~ toDelimitedString( '' )

  -- 3. eliminate the processing instructions !

  do while pos( '<?', xmlText ) <> 0
    parse var xmlText before '<?' . '?>' after
    xmlText = before || after
    end 

  -- 4. prepare a stack that locates pending tree parents

  xmlStack = ^^ stack

  -- 5. process the XML text

  ^ processXmlSegment

  -- 6. assert that all of the text was processed

  if xmlText <> '' then do
    ^^ console ~ writeLine( 'ERROR: more text remains, at conclusion of program.', '', 'Text at error position:', '  'substr( xmlText, 1, 40 ) )
    return 'Invalid XML'
    end 

  return ''

-- the 'printTree' method prints the tree to the default output stream

printTree  :  method
  say 
  call printSubTree 1, ^ self -- invoke the recursive subtree procedure
  return ''

-- the 'printSubTree' procedure
-- prints information about a specific XML node,
-- and recursively prints subtree elements

printSubTree  :  procedure
  parse arg depth, xmlTreeOrValue

  -- process the node's content

  if xmlTreeOrValue ~ hasContent then do

    content = xmlTreeOrValue ~ getContent

    if left( content, 1 ) = '<' then do

      -- process an XML tag

      say 

      call charout , copies( '.', depth )
      call charout , ' '

      -- eliminate leading and trailing '<', '>'

      content = strip( translate( content, '   ', '<>' ) )

      -- eliminate optional trailing '/'

      content = strip( content, 'Trailing', '/' )

      -- split the XML tag and optional attributes

      parse var content tag attributes

      say 'XMLTAG:' tag

      -- process optional attributes

      do while attributes <> ''

        -- process an attribute
        --   format: attributeName='value'

        -- get the attribute name

        parse var attributes attributeName '=' rest

        -- get the quote character, after the equal sign

        quoteCh = left( rest, 1 )

        -- assert it's a single or double quote

        if quoteCh <> '"' & quoteCh <> "'" then
          call raiseObjection 'An XML tag has a poorly formed attribute value.' || '0a'x ,
            || 'The erroneous tag is:' || '0a'x ,
            || '  'xmlTreeOrValue ~ getContent

        -- get the rest of the text, after the quote character

        rest = substr( rest, 2 )

        -- locate the corresponding quote,
        -- that ends the attribute value

        nextQuotePos = pos( quoteCh, rest )

        -- assert the corresponding quote is present

        if nextQuotePos = 0 then
          call raiseObjection 'An XML tag has a poorly formed attribute value.' || '0a'x ,
            || 'The erroneous tag is:' || '0a'x ,
            || '  'xmlTreeOrValue ~ getContent

        -- get the attribute value,
        -- and establish remaining 'attributes' to process

        parse var rest attributeValue =(nextQuotePos) +1 attributes

        call charout , copies( ' ', depth )
        say '    attribute:' attributeName', value:' convert( attributeValue )

        end 
      end 

    else do

      -- show an element's content

      call charout , copies( ' ', depth )
      say '  Element content:' convert( content )
      end 

    end 

  -- process the node's children

  if xmlTreeOrValue ~ hasChild then
    call printSubTree depth+1, xmlTreeOrValue ~ getChild

  -- process the node's successors

  if xmlTreeOrValue ~ hasSuccessor then
    call printSubTree depth, xmlTreeOrValue ~ getSuccessor
   
  return 

-- the 'convert' procedure transforms special XML entities
-- to their corresponding printed values

convert  :  procedure

  s = arg(1)

  -- most values do not require conversion

  if pos( '&', s ) = 0 then
    return s

  -- replace the special XML entities
  -- note: these are special HTML entities also

  before = { '&lt;', '&gt;', '&amp;', '&apos;', '&quot;' }
  after =  { '<', '>', '&', "'", '"' }

  loop ix over before
    if pos( '&', s ) = 0 then
      return s
    s = changestr( s, before[ ix ], after[ ix ] )
    end 
  
  return s

-- the 'processXmlSegment' method recursively
-- processes the XML text

processXmlSegment  :  method

  -- assure a tag appears here

  if left( xmlText, 1 ) <> '<' then do
    ^^ console ~ writeLine( 'ERROR: a less than sign was expected.', '', 'Text at error position:', '  'substr( xmlText, 1, 40 ) )
    return 'Invalid XML'
    end 

  -- mainly ignore end tags

  if left( xmlText, 2 ) = '</' then
    return ^ self

  -- locate end of tag

  endPos = pos( '>', xmlText )

  if endPos = 0 then do
    ^^ console ~ writeLine( 'ERROR: a greater than sign was expected, after the current position.', '', 'Text at error position:', '  'substr( xmlText, 1, 40 ) )
    return 'Invalid XML'
    end 

  -- the XML tag contains child contents, if the last
  -- character before the end of the tag
  -- is not a forward slash

  hasChildren = ( substr( xmlText, endPos - 1, 1 ) <> '/' )

  endPos = endPos + 1

  -- split the current tag from the remainder of the XML text

  parse var xmlText xmlTag =( endPos ) xmlText

  -- this node's content is the XML tag

  ^ setContent( xmlTag )

  -- add this node to the stack of pending nodes

  xmlStack ~ push( ^ self )

  -- process optional child content, recursively

  if hasChildren then do

    -- prepare the corresponding end tag 

    currentTag = word( translate( xmlTag, '  ', '<>' ), 1 )

    endTag = '</'currentTag'>'

    -- process the text until the end tag is discovered
 
    do n=1 while left( xmlText, length( endTag ) ) <> endTag

      -- if the text begins with a '<' character,
      -- a child tag is processed as a new tree node

      if left( xmlText, 1 ) = '<' then

        newChild = ^^ xmlTree( '_' ) ~ processXmlSegment()

      -- if the text does not begin with a '<' character,
      -- the text is the element's content.

      -- consider the element: <date>Thu, 23 Jan 2003 10:13am</date>
      -- at this point the 'xmlText' would be:
      --   Thu, 23 Jan 2003 10:13am</date>
      -- the element's content is the text prior to the next'<' character
      -- which in this example is:
      --   Thu, 23 Jan 2003 10:13am

      else do

        -- locate the next '<' character

        nextPos = pos( '<', xmlText )

        if nextPos = 0 then do
          ^^ console ~ writeLine( 'ERROR: a less than sign was expected, after the current position.', '', 'Text at error position:', '  'substr( xmlText, 1, 40 ) )
          return 'Invalid XML'
          end 

        -- separate the element content from the remaining XML text 

        parse var xmlText elementContent =( nextPos ) xmlText

        -- prepare a tree node, that just contains the element content

        newChild = ^^ xmlTree( elementContent )

        end 

      -- when the current node does not have any children,
      -- the new node is added as a child.

      if 0 = ^ hasChild then
        ^ setChild( newChild )

      -- otherwise,
      -- the new node is added as the successor
      -- of the last child that has been added.

      else 
        lastChild ~ setSuccessor( newChild )

      -- the last child that has been added,
      -- is the new child

      lastChild = newChild

      end 

    -- eliminate the end tag
  
    xmlText = substr( xmlText, length( endTag ) + 1 )

    end -- has children

  -- remove the current node from the stack of pending nodes

  xmlStack ~ pop

  -- note: at this point an XML node, it's 1st child, and the child's successors are
  -- accessible via the 'xmlTree' instance locator. Upper XML nodes can be referenced
  -- via the 'xmlStack' instance locator, which can be accessed as a vector.
  -- the only nodes that can't be accessed at this point, are the successor's of this
  -- node.

  -- you might want to invoke a method in a class that EXTENDS the xmlTree class
  -- at this point.

  return ^ self

1.1.88 xmlTree.rooProgram

-- xmlTree.rooProgram

-- the 'xmltree' program converts an XML file
-- to a tree of XML information. This is commonly
-- referred to as the XML 'Document Object Model' (DOM)

-- the 'xmltree.roo' class does all of the work.

-- usage information is printed to the console
-- when the program is executed without any arguments.

-- 1. get the name of the XML file to process

xmlFileName = arg( 1 )

-- 2. validate arguments

if xmlFileName = '' then
  call usagemsg

if \ ( ^^ file( xmlFileName ) ~ exists ) then
  call usagemsg "XML file '"xmlFileName"' does NOT exist."

-- 3. show a note describing the XML file that is being processed

parse var xmlFileName documentName '.xml'

lastSlash = lastpos( '\', documentName )

if lastSlash <> 0 then
  documentName = substr( documentName, lastSlash + 1 )

^^ console ~ writeLine( 'Processing XML document:' documentName )

-- 4. prepare a vector of XML lines from the file

xmlLines = ^^ inLineFile( xmlFileName )

-- 5. convert the vector of XML lines to a tree of XML nodes

xmlTreeOrMessage = ^^ xmlTree( xmlLines )

-- 6. check for errors

if \ datatype( xmlTreeOrMessage, 'Instance' ) then
  call usagemsg xmlTreeOrMessage

-- 7. print the tree of XML information

xmlTreeOrMessage ~ printTree 

exit 0

-- the 'usagemsg' procedure describes how to use this program

usagemsg  :  procedure

  ^^ console ~ writeLine( arg(1), '', ,
    'Usage : ', '  roo xmlTree xmlFile' )

  exit 99

1.1.89 xmltext.roo

/* xmltext.roo
 a derived class that collects stream output to a text value,
 and emits it as XML text
*/

xmltext  :  class extends outtext -- text is collected by the 'outtext' class

shared attributes -- vector of attributes

shared endTag -- associated XML end tag

shared tag -- associated XML tag

shared text -- 'text' is a shared symbol in the 'outtext' class

shared emitTextOnly -- 'emitTextOnly' is a boolean used in this class

initialize  :  method
  attributes = ^^ vector
  tag = 'text'
  endTag = '</text>'
  emitTextOnly = translate( arg(1) ) <> 'COMPLETEFILE' -- set output emission boolean
  return ''

attribute  :  method                            -- add an attribute
  parse arg name, value
  attributes ~ add( name'="'value'"' )
  return ^ self   -- an htmltext instance context reference

setEndTag  :  method                            -- set end tag explicitly
  endTag = arg(1)
  return ^ self                               -- an xmltext instance context reference

setTag  :  method
  tag = arg(1)
  endtag = '</'tag'>'                         -- set end tag implicitly
  return ^ self                               -- an xmltext instance context reference

emit  :  method
  
  if emitTextOnly then
    ^^ outstream ~ writeLine( emitText() )   -- show text only

  else do                                    -- prepare a complete XML file
    out = ^^ outstream
    out ~ writeLine( '<?xml version="1.0" encoding="UTF-8"?>' )
    out ~ writeLine( '<queryTime>' )
    out ~ writeLine( emitText() )            -- this is the text
    out ~ writeLine( '</queryTime>' )
    end 
  return ^ self   -- an xmltext instance context reference

emitText  :  procedure
  if attributes ~ IsNonEmpty then
    startTag = '<'tag attributes ~ join( ' ' )'>'
  else 
    startTag = '<'tag'>'
  return startTag || text || endTag

1.2 Related '_ice' files:

Various solutions are implemented as '_ice' files to comply with copyright requirements of the algorithm's authors. The following '_ice' files are provided:

betaIncomplete_ice.rooProgram	external procedure, computes: incompleteBeta( X )
chiSquaredAssessment_ice.rooProgram	main procedure, computes: "chi-squared" value, and associated significance. Usage:   roo chiSquaredAssessment_ice kind bin-file1 bin-file2 [constraint : default(1)] where, kind is one of (1 or 2) -- chi-squared assessment kind:   1. processes a bin versus expected numbers   2. processes 2 bins in parallel Example:   roo chiSquaredAssessment_ice 2 binFile1 binFile2 Each line in the statistics files contains a numeric 'bin' value. The chiSquaredAssessment_ice program uses the following external procedure to compute the significance gammaIncomplete_ice.rooProgram
fullMoon_ice.rooProgram	external procedure, computes base date of Nth full moon after Jan 1, 2000 Usage:   fullMoonBaseDate = fullMoon_ice( N ) -- where: N is a positive whole number
gammaIncomplete_ice.rooProgram	external procedure, computes: incompleteGamma( X )
linearFit_ice.rooProgram	main procedure, computes equation of a line that fits a series of points, and the mean absolute deviation. Usage:   roo linearFit_ice < pointFile Or:   progA | roo linearFit_ice N points are acquired from the default input stream. Each line in the default input stream begins with 2 numeric space separated values: x y [rest]. Example:   roo linearFit_ice pointFile
mathXX_ice.roo	extension of mathX.roo. methods: GammaFunction( X ), lnGammaFunction( X )
meanAssessment_ice.rooProgram	main procedure, computes: "Student's t" value, and associated significance. Usage:   roo meanAssessment_ice kind statistics-file1 statistics-file2 where, kind is one of (1,2,3):   1. pools the variances   2. specific variances   3. uses covariance of paired samples Example:   roo meanAssessment_ice 2 statFile1 statFile2 Each line in the statistics files contains a numeric value. The meanAssessment_ice program uses the following external procedure to compute the significance betaIncomplete_ice.rooProgram