🚀 go-pugleaf

/* REXX */
/*====================================================================*\
                                FREEWARE

                                ENDLESS

                            A Multi-platform
                             Execute-ready
                           REXX Show Program

         Released and maintained by Simon Husin (husin@ibm.net)
                          Version: 1995/12/30
========================================================================
This program is based on the well-known 'Towers of Hanoi' problem.

It is created by Simon Husin to show REXX program's flexibility and
portability.

You are encouraged to modify this program to make it run on your REXX
engine.  To make sure that it is maintained properly, I am inviting you
to send me your modifications which I will apply on my copy to release
it back to (more) public.  To show my gratitudes, I will include your
name and contribution(s) in the list of contributors below.

I thank you in advance for your interests and cooperations.

For latest news and releases, please read newsgroup 'comp.lang.rexx'!
------------------------------------------------------------------------

                          List Of Contributors
                    And Supported Platforms To-date

Hard-  Operating        REXX                YYYY/MM/DD
Ware   System           Engine              Applied     Contributed By
.......................................................................
Intel+ IBM PC DOS 7.0   IBM PC DOS REXX     1995/12/25  Simon Husin
Intel+ Any PC/MS-DOS+   Quercus Systems     1995/12/25  Simon Husin
                        Personal/REXX 3.0
Intel+ IBM OS/2 & Warp  IBM PL/2 REXX       1995/12/25  Simon Husin
Intel+ IBM OS/2 & Warp  Quercus Systems     1995/12/25  Simon Husin
                        Personal/REXX 3.0
Intel+ IBM OS/2 & Warp  IBM PL/2 REXX &     1995/12/27  Simon Husin
       Under Tritus SPF Quercus P/REXX 3.0
Intel+ PC/MS-DOS+& ANSI Tritus SPF REXX     1995/12/27  Simon Husin
Intel+ PC/MS-DOS+& ANSI Regina REXX         1995/12/28  Mark Hessling
Any    Any Unix         Regina REXX         1995/12/28  Mark Hessling
Intel+ Any PC/MS-DOS+   Kilowatt Software   1995/12/29  Simon Husin
                        Portable/REXX 1.x
.......................................................................
Notes: + = Including compatibles
\*====================================================================*/

/*--------------------------------------------------------------------*\
                     General Program Initialization
\*--------------------------------------------------------------------*/
delay  = 0
esc    = d2c(27)||d2c(91)
global = 'DELAY ENGINE ESC FOOTER GEN. Q.'

/*--------------------------------------------------------------------*\
                   Check operating system environment
   Initial system specific commands for local system interpret(ation)
\*--------------------------------------------------------------------*/
parse version interpreter version release
interpreter = translate(interpreter)
addr = translate(address())
parse source env .
footer = 'EndLess * OS-Env:'env'-'addr||,
         ' * REXX Engine:'interpreter' V.'version' of 'release
footer = center(strip(left(footer, 78)), 78)

select
   when interpreter = 'REXX370' then do /* IBM Mainframe */
        select
          when addr = 'MVS' then
               engine = 'IBMMVSREXX'   /* MVS                         */
          when addr = 'TSO' then do
               if strip(sysvar('sysenv')) = 'FORE' then /* TSO/E      */
                  engine = 'IBMTSOFOREREXX'  /* Foreground            */
               else
                  engine = 'IBMTSOBATCHREXX' /* Batch                 */
               end
          otherwise
               engine = 'IBMVMREXX'    /* VM/CMS                      */
          end
        end
   when interpreter = 'UNI-REXX' then  /* Unix/AIX Workstation        */
        engine = 'WRKUNIREXX'         /*The Workstation Group uni-REXX*/
   when interpreter = 'REXXSAA' &,
        addr = 'COMMAND' then do       /* New IBM REXX environment    */
        if env = 'DOS' then
           engine = 'IBMPCDOSREXX'     /* IBM PC-DOS 7.x REXX         */
        else
           engine = 'IBMOS400REXX'     /* IBM OS/400 REXX             */
        end
   when interpreter = 'REXXSAA' &,
        addr = 'CMD' then              /* IBM PL 2/REXX               */
        engine = 'IBMOS2REXX'
   when interpreter = 'REXXSAA' &,
        addr = 'ISPEXEC' then
        engine = 'IBMOS2REXXTSPF'      /* IBM PL 2/REXX in Tritus SPF */
   when interpreter = 'REXX/PERSONAL' then do /* Quercus Systems REXX */
        if addr = 'CMD' then
           engine = 'QUERCUSOS2REXX'   /* under OS/2                  */
        else if addr = 'DOS' then
           engine = 'QUERCUSDOSREXX'   /* under PC/MS-DOS             */
        else if addr = 'WINREXX' then
           engine = 'QUERCUSWINREXX'   /*under MS-Windows & IBM WinOS2*/
        else if addr = 'ISPEXEC' then
           engine = 'QUERCUSOS2REXXTSPF' /* Tritus SPF under OS/2     */
        end
   when left(interpreter, 9) = 'REXX-KILO' then /* PC/MS-DOS          */
        engine = 'KILODOSREXX'       /*Kilowatt Software Portable/REXX*/
   when left(interpreter, 9) = 'REXX/WIND' then /* Windows/Win-OS2    */
        engine = 'KILOWINREXX'       /* Kilowatt Software REXX/Windows*/
   when interpreter = 'REXX:OPEN-REXX179' then
        engine = 'TRITUSDOSREXX'     /* Tritus REXX under DOS TSPF    */
   when interpreter = 'AREXX' then
        engine = 'AMIGAREXX'         /* Amiga Micro Computer w/ ARexx */
   when left(interpreter, 11) = 'REXX-REGINA' then
        engine = 'REGINAREXX'        /* Regina REXX under UNIX or DOS */
   otherwise
        engine = 'UNKNOWNREXX'       /* Unknown OS/REXX environment   */
   end

/*--------------------------------------------------------------------*\
               Set engine- & platform-dependent features
\*--------------------------------------------------------------------*/
gen.Block     = ''
gen.Clear     = "'CLS'"
gen.Console   = 'CON:'
gen.CursorOFF = 'NOP'
gen.CursorON  = 'NOP'
gen.DelayDur  = 'NOP'
gen.MaxRow    = 24
gen.Start     = 1
gen.Temp      = 27
gen.Target    = 53

select
  when left(engine, 10) = 'IBMOS2REXX' then do
       call rxfuncadd 'sysloadfuncs', 'REXXUTIL', 'sysloadfuncs'
       call sysloadfuncs
       if right(engine, 4) = 'TSPF' then
          gen.Clear  = 'ADDRESS CMD CLS'
       gen.CursorOFF = "call syscurstate 'OFF'"
       gen.CursorON  = "call syscurstate 'ON'"
       gen.DelayDur  = 'call syssleep'
       end
  when engine = 'IBMPCDOSREXX' then do
       gen.Console   = 'CON'
       gen.CursorOFF = "call rxcrstat 'OFF'"
       gen.CursorON  = "call rxcrstat 'ON'"
       gen.DelayDur  = 'call rxsleep'
       end
  when left(engine, 14) = 'QUERCUSDOSREXX' |,
       left(engine, 14) = 'QUERCUSOS2REXX' then do
       if right(engine, 4) = 'TSPF' then
          gen.Clear  = 'ADDRESS CMD CLS'
       gen.DelayDur  = 'call delay'
       end
  when engine = 'REGINAREXX' then do
       gen.Block     = '*'
       gen.Clear     = 'call UnixClear'
       gen.Console   = '/dev/tty'
       gen.DelayDur  = 'call UnixSleep'
       gen.MaxRow    = 23
       end
  when engine = 'TRITUSDOSREXX' then
       gen.Clear     = 'ADDRESS CMD CLS'
  when engine = 'KILODOSREXX' then do
       gen.Console   = '!'
       gen.DelayDur  = 'call delay'
       end
  otherwise
       nop
  end

if gen.Block = '' then gen.Block     = d2c(240)
gen.MaxRowMin = gen.MaxRow - 1

/*--------------------------------------------------------------------*\
   Create 3 number strings holders to keep disk numbers for each pole
\*--------------------------------------------------------------------*/
q.Start = ''
q.Temp = ''
q.Target = ''

/*--------------------------------------------------------------------*\
                  Request number of disks to play with
\*--------------------------------------------------------------------*/
interpret gen.Clear
say 'Please enter the number of disks to play with:'
say '(if not entered, or entered but wrong it will be set to 3)'
pull disks
if datatype(disks) \= 'NUM' then disks = 3
disks = disks % 1
if disks < 1 then disks = 3

/*--------------------------------------------------------------------*\
                        Ask for delay in seconds
\*--------------------------------------------------------------------*/
if gen.DelayDur \= 'NOP' then do
   say 'Please enter delay factor in seconds:'
   say '(if not entered, or entered but wrong it will be set to 2 sec.)'
   pull delay
   if datatype(delay) \= 'NUM' then delay = 2
   delay = delay % 1
   if delay < 0 then delay = 2
   gen.DelayDur  = gen.DelayDur delay
   end

/*--------------------------------------------------------------------*\
               Put as many disks as requested in 'START'
\*--------------------------------------------------------------------*/
do ix = 1 to disks
   q.Start = q.Start ix
   end
q.Start = strip(q.Start)

/*--------------------------------------------------------------------*\
           Start the real presentation and recursive process
\*--------------------------------------------------------------------*/
call time 'R'
timestarted = time()
call GStart disks
interpret gen.CursorOFF
call GHanoi disks, 'START', 'TEMP', 'TARGET'
interpret gen.CursorON

/*--------------------------------------------------------------------*\
                        Show process statistics
\*--------------------------------------------------------------------*/
call CursorSet 1, 1
say
say 'Process started at' timestarted
say '        duration  ' time('E') 'seconds'
say 'Current time is   ' time()
return

/*--------------------------------------------------------------------*\
                         Show the starting pile
\*--------------------------------------------------------------------*/
GStart: procedure expose (global)
arg disks
interpret gen.Clear
if disks < gen.MaxRow - 2 then
   row = gen.MaxRow - 2 - disks
else
   row = 0
call CursorSet gen.MaxRow, gen.Start
call charout gen.Console, footer
call CursorSet gen.MaxRowMin, gen.Start
call charout gen.Console, center('Start', 24, gen.block)
call CursorSet gen.MaxRowMin, gen.Temp
call charout gen.Console, center('Temp', 24, gen.block)
call CursorSet gen.MaxRowMin, gen.Target
call charout gen.Console, center('Target', 24, gen.block)

do ix = disks to 1 by -1
   call CursorSet (row + ix), 1
   call charout gen.Console, center(center(ix, ix, gen.block), 24)
   end
return

/*--------------------------------------------------------------------*\
                           Recursive Process
\*--------------------------------------------------------------------*/
GHanoi: procedure expose (global)
parse arg disks, start, temp, target
disks = strip(disks)
if disks = 1 then
   call GDiskMove start, target
else do
   call GHanoi (disks - 1), start, target, temp
   call GDiskMove start, target
   call GHanoi (disks - 1), temp, start, target
   end
return

/*--------------------------------------------------------------------*\
                  Move a disk from one pole to another
\*--------------------------------------------------------------------*/
GDiskMove: procedure expose (global)
parse arg start, target
if delay > 0 then interpret gen.DelayDur
call CursorSet (gen.MaxRowMin - words(q.Start)), gen.Start
call charout gen.Console, '                        '
parse var q.Start disknum q.Start
q.Target = disknum q.Target
call CursorSet (gen.MaxRowMin - words(q.Target)), gen.target
call charout gen.Console, center(center(disknum, disknum, gen.block), 24)
return

/*--------------------------------------------------------------------*\
         Set the cusor on the screen at the specified location
\*--------------------------------------------------------------------*/
CursorSet: procedure expose (global)
parse arg row, col
select
  when engine = 'IBMOS2REXX'         then call syscurpos row, col
  when engine = 'IBMPCDOSREXX'       then call rxsetpos  row, col
  when engine = 'IBMOS2REXXTSPF'     then call syscurpos row, col
  when engine = 'QUERCUSDOSREXX'     then call cursor row, col
  when engine = 'QUERCUSOS2REXX'     then call cursor row, col
  when engine = 'QUERCUSOS2REXXTSPF' then call cursor row, col
  when engine = 'REGINAREXX'         then call ANSIcursor row, col
  when engine = 'TRITUSDOSREXX'      then call ANSIcursor row, col
  when engine = 'KILODOSREXX'        then call cursor row, col
  otherwise nop
  end
return

/*--------------------------------------------------------------------*\
    Internal function to use ANSI escape sequence to position cursor
\*--------------------------------------------------------------------*/
ANSICursor: procedure expose (global)
parse arg row, col
call charout gen.Console, esc||row';'col'H'
return

/*--------------------------------------------------------------------*\
                Internal functions to call Unix commands
\*--------------------------------------------------------------------*/
UnixClear: procedure expose (global)
Address System 'clear'
return

UnixSleep: procedure expose (global)
parse arg seconds
Address System 'sleep' seconds
return