home *** CD-ROM | disk | FTP | other *** search
/ NetNews Offline 2 / NetNews Offline Volume 2.iso / news / comp / unix / amiga / 46 < prev    next >
Encoding:
Internet Message Format  |  1996-08-06  |  19.4 KB
  1. Path: news-m01.ny.us.ibm.net!usenet
  2. From: husin@ibm.net
  3. Newsgroups: comp.unix.amiga
  4. Subject: Run this program on Amiga,PC,Unix,Mainframes * without changes!
  5. Date: 7 Jan 1996 06:18:26 GMT
  6. Message-ID: <4cnoji$4g9u@news-s01.ny.us.ibm.net>
  7. Reply-To: husin@ibm.net
  8. NNTP-Posting-Host: slip37-241-74.ibm.net
  9. X-Newsreader: IBM NewsReader/2 v1.2.5
  10.  
  11. /* REXX */
  12. /*====================================================================*\
  13.                                 FREEWARE
  14.  
  15.                                 ENDLESS
  16.  
  17.                             A Multi-platform
  18.                              Execute-ready
  19.                            REXX Show Program
  20.  
  21.          Released and maintained by Simon Husin (husin@ibm.net)
  22.                           Version: 1996/01/06
  23. ========================================================================
  24. This program is based on the well-known 'Towers of Hanoi' problem.
  25.  
  26. It is created by Simon Husin to show REXX program's flexibility and
  27. portability.
  28.  
  29. You are encouraged to modify this program to make it run on your REXX
  30. engine.  To make sure that it is maintained properly, I am inviting you
  31. to send me your modifications which I will apply on my copy to release
  32. it back to (more) public.  To show my gratitudes, I will include your
  33. name and contribution(s) in the list of contributors below.
  34.  
  35. I thank you in advance for your interests and cooperations.
  36.  
  37. For latest news and releases, please read newsgroup 'comp.lang.rexx'!
  38. ------------------------------------------------------------------------
  39.                           List Of Contributors
  40.                     And Supported Platforms To-date
  41.  
  42. Hard-  Operating        REXX                YYYY/MM/DD
  43. Ware   System           Engine              Applied     Contributed By
  44. .......................................................................
  45. Intel+ IBM PC DOS 7.0   IBM PC DOS REXX     1995/12/25  Simon Husin
  46. Any?   Any PC/MS-DOS+   Quercus Systems     1995/12/25  Simon Husin
  47.                         Personal/REXX 3.0
  48. Intel+ IBM OS/2 & Warp  IBM PL/2 REXX       1995/12/25  Simon Husin
  49. Intel+ IBM OS/2 & Warp  Quercus Systems     1995/12/25  Simon Husin
  50.                         Personal/REXX 3.0
  51. Intel+ IBM OS/2 & Warp  IBM PL/2 REXX &     1995/12/27  Simon Husin
  52.        Under Tritus SPF Quercus P/REXX 3.0
  53. Any?   PC/MS-DOS+& ANSI Tritus SPF REXX     1995/12/27  Simon Husin
  54. Any?   PC/MS-DOS+& ANSI Regina REXX         1995/12/28  Mark Hessling
  55. Any?   Any Unix         Regina REXX         1995/12/28  Mark Hessling
  56. Any?   Any PC/MS-DOS+   Kilowatt Software   1995/12/29  Simon Husin
  57.                         Portable/REXX 1.x
  58. Any?   PC/MS-DOS+& ANSI BNV REXX 1.x        1995/12/30  Mathew Goldstein
  59. Any?   MS-Windows+ &    Quercus Systems     1996/01/01  Simon Husin
  60.        IBM-WinOS2       Personal/REXX 3.0
  61. Any?   MS-Windows+ &    Kilowatt Software   1995/01/01  Simon Husin
  62.        IBM-WinOS2       Portable/REXX 1.x
  63. Amiga  Amiga DOS        William Hawes       1995/01/01  Simon Husin
  64.        Release 2/newer  ARexx ?
  65. IBM370+MVS-TSO/E        IBM REXX/370 ?      1995/01/02  Simon Husin
  66. IBM370+VM/CMS           IBM REXX/370        1995/01/01  Gil P.?
  67.                         Graphics +          1995/01/04  Paul Barnett
  68.                         Interpreter+Compiler
  69. .......................................................................
  70. Notes: + = Including compatibles
  71.        ? = Still waiting for (your) confirmation
  72. \*====================================================================*/
  73.  
  74. /*--------------------------------------------------------------------*\
  75.                    Check operating system environment
  76.    Initial system specific commands for local system interpret(ation)
  77. \*--------------------------------------------------------------------*/
  78. parse version interpreter version release
  79. interpreter = translate(interpreter)
  80. addr = translate(address())
  81. parse source env . gen.SRC3 .
  82. gen.Footer = 'EndLess * OS-Env:'env'-'addr||,
  83.              ' * REXX Engine:'interpreter' V.'version' of 'release
  84. gen.Footer = center(strip(left(gen.Footer, 78)), 78)
  85.  
  86. select
  87.   when interpreter = 'REXX370' |,       /* IBM Mainframe interpreter  */
  88.        interpreter = 'REXXC370' then do /*  or Mainframe compiler v2  */
  89.        select
  90.          when addr = 'MVS' then
  91.               gen.Engine = 'IBMMVSREXX' /* MVS                        */
  92.          when addr = 'TSO' then do
  93.               if strip(sysvar('sysenv')) = 'FORE' then /* TSO/E       */
  94.                  gen.Engine = 'IBMTSOFOREREXX' /* Foreground          */
  95.               else
  96.                  gen.Engine = 'IBMTSOBATCHREXX' /* Batch              */
  97.               end
  98.          otherwise
  99.               gen.Engine = 'IBMVMREXX' /* VM/CMS                      */
  100.          end
  101.        end
  102.   when interpreter = 'UNI-REXX' then  /* Unix/AIX Workstation         */
  103.        gen.Engine = 'WRKUNIREXX'      /*The Workstation Group uni-REXX*/
  104.   when interpreter = 'REXXSAA' &,
  105.        addr = 'COMMAND' then do       /* New IBM REXX environment     */
  106.        if env = 'DOS' then
  107.           gen.Engine = 'IBMPCDOSREXX' /* IBM PC-DOS 7.x REXX          */
  108.        else
  109.           gen.Engine = 'IBMOS400REXX' /* IBM OS/400 REXX              */
  110.        end
  111.   when interpreter = 'REXXSAA' &,
  112.        addr = 'CMD' then              /* IBM PL 2/REXX                */
  113.        gen.Engine = 'IBMOS2REXX'
  114.   when interpreter = 'REXXSAA' &,
  115.        addr = 'ISPEXEC' then
  116.        gen.Engine = 'IBMOS2REXXTSPF'  /* IBM PL 2/REXX in Tritus SPF  */
  117.   when interpreter = 'REXX/PERSONAL' then do /* Quercus Systems REXX  */
  118.        if addr = 'CMD' then
  119.           gen.Engine = 'QUERCUSOS2REXX' /* under OS/2                 */
  120.        else if addr = 'DOS' then
  121.           gen.Engine = 'QUERCUSDOSREXX' /* under PC/MS-DOS            */
  122.        else if addr = 'WINREXX' then
  123.           gen.Engine = 'QUERCUSWINREXX' /* under MS-Windows/IBM WinOS2*/
  124.        else if addr = 'ISPEXEC' then
  125.           gen.Engine = 'QUERCUSOS2REXXTSPF' /* Tritus SPF under OS/2  */
  126.        end
  127.   when left(interpreter, 9) = 'REXX-KILO' then /* PC/MS-DOS           */
  128.        gen.Engine = 'KILODOSREXX'   /*Kilowatt Software Portable/REXX */
  129.   when left(interpreter, 9) = 'REXX/WIND' then /* Windows/Win-OS2     */
  130.        gen.Engine = 'KILOWINREXX'   /* Kilowatt Software REXX/Windows */
  131.   when interpreter = 'REXX:OPEN-REXX179' then
  132.        gen.Engine = 'TRITUSDOSREXX' /* Tritus REXX under DOS TSPF     */
  133.   when interpreter = 'AREXX' then
  134.        gen.Engine = 'AMIGAREXX'     /* Amiga Micro Computer w/ ARexx  */
  135.   when left(interpreter, 11) = 'REXX-REGINA' then
  136.        gen.Engine = 'REGINAREXX'    /* Regina REXX under UNIX or DOS  */
  137.   when interpreter = 'REXX' & left(release, 3) = 'BNV' then
  138.        gen.Engine = 'BNVREXX'       /* BNV (?) REXX under PC/MS-DOS   */
  139.   otherwise
  140.        gen.Engine = 'UNKNOWNREXX'   /* Unknown OS/REXX environment    */
  141.   end
  142.  
  143. /*--------------------------------------------------------------------*\
  144.                Set engine- & platform-dependent features
  145. \*--------------------------------------------------------------------*/
  146. gen.ANSIesc   = d2c(27)||d2c(91)
  147.                              /* ANSI Esc char. + open bracket         */
  148. gen.Block     = ''           /* Block character for graphical present.*/
  149. gen.Cleanup   = 'NOP'        /* Exit processing (VM/CMS Graph.support)*/
  150. gen.Clear     = "'CLS'"      /* To clear screen                       */
  151. gen.Console   = 'CON:'       /* Name of output device                 */
  152. gen.CursorOFF = 'NOP'        /* To hide the cursor during gr. present.*/
  153. gen.CursorON  = 'NOP'        /* To show the cursor after gr. present. */
  154. gen.DelayDur  = 'call DelayTime'
  155.                              /* Instruction/command to pause in moves */
  156. gen.Hanoi     = 'T'          /* Graphical or Textual presentation     */
  157. gen.MaxRow    = 24           /* Maximum number of rows on the screen  */
  158. gen.Q.Start   = ''           /* String w/ disk numbers on pole Start  */
  159. gen.Q.Temp    = ''           /* String w/ disk numbers on pole Temp   */
  160. gen.Q.Target  = ''           /* String w/ disk numbers on pole Target */
  161. gen.Start     = 1            /* 1st pole pos. for graphical present.  */
  162. gen.Steps     = 0            /* Disk movements needed to solve        */
  163. gen.Target    = 53           /* last pole pos. for graphical present. */
  164. gen.Temp      = 27           /* 2nd pole pos. for graphical present.  */
  165.  
  166. select
  167.   when gen.Engine    = 'AMIGAREXX' then do
  168.        gen.Block     = '*'
  169.        gen.Console   = 'STDOUT'
  170.        gen.Clear     = 'call writech' gen.Console',' gen.ANSIesc'2J'
  171.        gen.DelayDur  = 'call delay'
  172.        gen.Hanoi     = 'G'
  173.        end
  174.   when gen.Engine    = 'BNVREXX' then
  175.        gen.Hanoi     = 'G'
  176.   when left(gen.Engine, 10) = 'IBMOS2REXX' then do
  177.        call rxfuncadd 'sysloadfuncs', 'REXXUTIL', 'sysloadfuncs'
  178.        call sysloadfuncs
  179.        if right(gen.Engine, 4) = 'TSPF' then
  180.           gen.Clear  = 'ADDRESS CMD CLS'
  181.        gen.CursorOFF = "call syscurstate 'OFF'"
  182.        gen.CursorON  = "call syscurstate 'ON'"
  183.        gen.DelayDur  = 'call syssleep'
  184.        gen.Hanoi     = 'G'
  185.        end
  186.   when gen.Engine    = 'IBMPCDOSREXX' then do
  187.        gen.Console   = 'CON'
  188.        gen.CursorOFF = "call rxcrstat 'OFF'"
  189.        gen.CursorON  = "call rxcrstat 'ON'"
  190.        gen.DelayDur  = 'call rxsleep'
  191.        gen.Hanoi     = 'G'
  192.        end
  193.   when gen.Engine    = 'IBMTSOFOREREXX' then
  194.        gen.Clear     = "'CLRSCRN'"
  195.   when gen.Engine    = 'IBMVMREXX' then do
  196.        gen.Block     = '*'
  197.        gen.Clear     = '"VMFCLEAR";'
  198.        gen.Console   = ''
  199.        gen.DelayDur  = 'CALL diag 8,"SLEEP" gen.Delay "SEC";'
  200.        ADDRESS COMMAND
  201.        'QUERY CMSLEVEL ( LIFO'
  202.        parse pull 'Level' cmslevel ','
  203.        'QUERY DISPLAY ( LIFO'
  204.        parse pull terminal gen.MaxRow cols .
  205.  
  206.        if terminal = 'DISPLAY' & cmslevel >= 5.6 then do
  207.           gen.Hanoi     = 'G'
  208.           'VSCREEN DELETE' gen.SRC3
  209.           'VSCREEN DEFINE' gen.SRC3 gen.MaxRow cols '0 0'
  210.           'WINDOW  DEFINE' gen.SRC3 gen.MaxRow cols '1 1'
  211.           'WINDOW  SHOW  ' gen.SRC3 'ON' gen.SRC3 '1 1'
  212.           gen.Cleanup   = gen.Delaydur ';' ,
  213.                           '"VSCREEN DELETE" gen.SRC3;' ,
  214.                           '"WINDOW  DELETE" gen.SRC3;'
  215.           gen.DelayDur  = '"VSCREEN CURSOR" gen.SRC3 "1 1";' ,
  216.                           '"VSCREEN WAITT" gen.SRC3;' ,
  217.                           '"PSCREEN REFRESH";' gen.DelayDur
  218.           end
  219.        end
  220.   when gen.Engine    = 'KILODOSREXX' then do
  221.        gen.Console   = '!'
  222.        gen.DelayDur  = 'call delay'
  223.        gen.Hanoi     = 'G'
  224.        end
  225.   when gen.Engine    = 'KILOWINREXX' then
  226.        gen.DelayDur  = 'call delay'
  227.   when left(gen.Engine, 14) = 'QUERCUSDOSREXX' |,
  228.        left(gen.Engine, 14) = 'QUERCUSOS2REXX' then do
  229.        if right(gen.Engine, 4) = 'TSPF' then
  230.           gen.Clear  = 'ADDRESS CMD CLS'
  231.        gen.DelayDur  = 'call delay'
  232.        gen.Hanoi     = 'G'
  233.        end
  234.   when gen.Engine    = 'QUERCUSWINREXX' then
  235.        gen.DelayDur  = 'call delay'
  236.   when gen.Engine    = 'REGINAREXX' then do
  237.        gen.Block     = '*'
  238.        gen.Clear     = 'call UnixClear'
  239.        gen.Console   = '/dev/tty'
  240.        gen.DelayDur  = 'call UnixSleep'
  241.        gen.MaxRow    = 23
  242.        gen.Hanoi     = 'G'
  243.        end
  244.   when gen.Engine    = 'TRITUSDOSREXX' then do
  245.        gen.Clear     = 'ADDRESS CMD CLS'
  246.        gen.Console   = 'CON'
  247.        gen.Hanoi     = 'G'
  248.        end
  249.   otherwise nop
  250.   end
  251.  
  252. if gen.Hanoi = 'G' then do
  253.    if gen.Block = '' then gen.Block = d2c(240)
  254.    gen.MaxRowMin = gen.MaxRow - 1
  255.    end
  256.  
  257. /*--------------------------------------------------------------------*\
  258.                   Request number of disks to play with
  259. \*--------------------------------------------------------------------*/
  260. interpret gen.Clear
  261. say 'Please enter the number of disks to play with:'
  262. say '(if not entered, or entered but wrong it will be set to 3)'
  263. pull gen.Disks
  264. if datatype(gen.Disks) = 'NUM' then nop
  265. else gen.Disks = 3
  266. gen.Disks = gen.Disks % 1
  267. if gen.Disks < 1 then gen.Disks = 3
  268.  
  269. /*--------------------------------------------------------------------*\
  270.           Request for delay in seconds between disk movements
  271. \*--------------------------------------------------------------------*/
  272. say 'Please enter delay factor in seconds:'
  273. say '(if not entered, '||,
  274.     'or entered but unacceptable it will be set to 2 sec.)'
  275. pull gen.Delay
  276. if datatype(gen.Delay) = 'NUM' then nop
  277. else gen.Delay = 2
  278. gen.Delay = gen.Delay % 1
  279. if gen.Delay < 0 | gen.Delay > 99 then gen.Delay = 2
  280. if gen.Engine = 'IBMVMREXX' then nop
  281. else gen.DelayDur = gen.DelayDur gen.Delay
  282.  
  283. /*--------------------------------------------------------------------*\
  284.                Put as many disks as requested in 'START'
  285. \*--------------------------------------------------------------------*/
  286. do ix = 1 to gen.Disks
  287.    gen.Q.Start = gen.Q.Start ix
  288.    end
  289. gen.Q.Start = strip(gen.Q.Start)
  290.  
  291. /*--------------------------------------------------------------------*\
  292.            Start the real presentation and recursive process
  293. \*--------------------------------------------------------------------*/
  294. call time 'R'
  295. timestarted = time()
  296. if gen.Hanoi = 'T' then
  297.    call Hanoi gen.Disks, 'START', 'TEMP', 'TARGET'
  298. else do
  299.    interpret gen.Clear
  300.    interpret gen.CursorOFF
  301.    call GStart gen.Disks
  302.    call GHanoi gen.Disks, 'START', 'TEMP', 'TARGET'
  303.    interpret gen.CursorON
  304.    end
  305.  
  306. /*--------------------------------------------------------------------*\
  307.                         Show process statistics
  308. \*--------------------------------------------------------------------*/
  309. call CursorSet 1, 1
  310. interpret gen.Cleanup
  311. say
  312. say 'Process started at' timestarted'.  It is now' time()'.'
  313. say 'It took' gen.Steps 'moves to solve with' gen.Disks 'disks.'
  314. say 'Total duration' time('E') / 1 'seconds,'
  315. say ' with' gen.Delay 'seconds delay for each move.'
  316. return
  317.  
  318. /*--------------------------------------------------------------------*\
  319.                 Recursive Process (textual presentation)
  320. \*--------------------------------------------------------------------*/
  321. Hanoi: procedure expose gen.
  322. parse arg disks, start, temp, target
  323. disks = strip(disks)
  324. if disks = 1 then
  325.    say 'Move disk#' DiskMove(start, target) ||,
  326.        ' from' left(start, 6) 'to' target
  327. else do
  328.    call Hanoi (disks - 1), start, target, temp
  329.    say 'Move disk#' DiskMove(start, target) ||,
  330.        ' from' left(start, 6) 'to' target
  331.    call Hanoi (disks - 1), temp, start, target
  332.    end
  333. return
  334.  
  335. /*--------------------------------------------------------------------*\
  336.       Move a disk from one pole to another (textual presentation)
  337. \*--------------------------------------------------------------------*/
  338. DiskMove: procedure expose gen.
  339. parse arg start, target
  340. if gen.Delay > 0 then interpret gen.DelayDur
  341. parse var gen.Q.Start disknum gen.Q.Start
  342. gen.Q.Target = disknum gen.Q.Target
  343. gen.Steps = gen.Steps + 1
  344. return right(disknum, 3)
  345.  
  346. /*--------------------------------------------------------------------*\
  347.                          Show the starting pile
  348. \*--------------------------------------------------------------------*/
  349. GStart: procedure expose gen.
  350. arg disks
  351. if disks < gen.MaxRow - 2 then
  352.    row = gen.MaxRow - 2 - disks
  353. else
  354.    row = 0
  355. call XYString gen.MaxRow, gen.Start, gen.Console, gen.Footer
  356. call XYString gen.MaxRowMin, gen.Start,,
  357.               gen.Console, center('Start',  24, gen.block)
  358. call XYString gen.MaxRowMin, gen.Temp,,
  359.               gen.Console, center('Temp',   24, gen.block)
  360. call XYString gen.MaxRowMin, gen.Target,,
  361.               gen.Console, center('Target', 24, gen.block)
  362.  
  363. do ix = disks to 1 by -1
  364.    call XYString (row + ix), 1,,
  365.                  gen.Console, center(center(ix, ix, gen.block), 24)
  366.    end
  367. return
  368.  
  369. /*--------------------------------------------------------------------*\
  370.           Recursive Process (primitive graphical presentation)
  371. \*--------------------------------------------------------------------*/
  372. GHanoi: procedure expose gen.
  373. parse arg disks, start, temp, target
  374. disks = strip(disks)
  375. if disks = 1 then
  376.    call GDiskMove start, target
  377. else do
  378.    call GHanoi (disks - 1), start, target, temp
  379.    call GDiskMove start, target
  380.    call GHanoi (disks - 1), temp, start, target
  381.    end
  382. return
  383.  
  384. /*--------------------------------------------------------------------*\
  385. Move a disk from one pole to another (primitive graphical presentation)
  386. \*--------------------------------------------------------------------*/
  387. GDiskMove: procedure expose gen.
  388. parse arg start, target
  389. if gen.Delay > 0 then interpret gen.DelayDur
  390. call XYString (gen.MaxRowMin - words(gen.Q.Start)), gen.Start,,
  391.               gen.Console, '                        '
  392. parse var gen.Q.Start disknum gen.Q.Start
  393. gen.Q.Target = disknum gen.Q.Target
  394. call XYString (gen.MaxRowMin - words(gen.Q.Target)), gen.target,,
  395.               gen.Console, center(center(disknum,disknum,gen.block),24)
  396. gen.Steps = gen.Steps + 1
  397. return
  398.  
  399. /*--------------------------------------------------------------------*\
  400.   General routine to write a string at a specified position on screen
  401. \*--------------------------------------------------------------------*/
  402. XYString: procedure expose gen.
  403. parse arg row, col, device, data
  404. select
  405.   when gen.Engine = 'BNVREXX' then
  406.        say gen.ANSIesc||row';'col'H'data
  407.   when gen.Engine = 'IBMVMREXX' then
  408.        'VSCREEN WRITE' gen.SRC3 row col 1 + length(data) '( FIELD' data
  409.   otherwise
  410.        call CursorSet row, col
  411.        call XCharout device, data
  412.   end
  413. return
  414.  
  415. /*--------------------------------------------------------------------*\
  416.          Set the cusor on the screen at the specified location
  417. \*--------------------------------------------------------------------*/
  418. CursorSet: procedure expose gen.
  419. parse arg row, col
  420. select
  421.   when gen.Engine = 'AMIGAREXX'      then call ANSIcursor row, col
  422.   when gen.Engine = 'BNVREXX'        then say gen.ANSIesc||row';'col'H'
  423.   when gen.Engine = 'IBMOS2REXX'     then call syscurpos row, col
  424.   when gen.Engine = 'IBMOS2REXXTSPF' then call syscurpos row, col
  425.   when gen.Engine = 'IBMPCDOSREXX'   then call rxsetpos  row, col
  426.   when gen.Engine = 'KILODOSREXX'    then call cursor row, col
  427.   when gen.Engine = 'QUERCUSDOSREXX' then call cursor row, col
  428.   when gen.Engine = 'QUERCUSOS2REXX' then call cursor row, col
  429.   when gen.Engine = 'QUERCUSOS2REXXTSPF' then call cursor row, col
  430.   when gen.Engine = 'REGINAREXX'     then call ANSIcursor row, col
  431.   when gen.Engine = 'TRITUSDOSREXX'  then call ANSIcursor row, col
  432.   otherwise nop
  433.   end
  434. return
  435.  
  436. /*--------------------------------------------------------------------*\
  437.        General routine to write a string of characters to screen
  438. \*--------------------------------------------------------------------*/
  439. XCharout: procedure expose gen.
  440. parse arg device, data
  441. if gen.Engine = 'AMIGAREXX' then
  442.    call writech device, data
  443. else
  444.    call charout device, data
  445. return
  446.  
  447. /*--------------------------------------------------------------------*\
  448.     Internal function to use ANSI escape sequence to position cursor
  449. \*--------------------------------------------------------------------*/
  450. ANSICursor: procedure expose gen.
  451. parse arg row, col
  452. call XCharout gen.Console, gen.ANSIesc||row';'col'H'
  453. return
  454.  
  455. /*--------------------------------------------------------------------*\
  456.                 Internal functions to call Unix commands
  457. \*--------------------------------------------------------------------*/
  458. UnixClear: procedure expose gen.
  459. Address System 'clear'
  460. return
  461.  
  462. UnixSleep: procedure expose gen.
  463. parse arg seconds
  464. Address System 'sleep' seconds
  465. return
  466.  
  467. /*--------------------------------------------------------------------*\
  468.                   Internal function to simulate delay
  469. \*--------------------------------------------------------------------*/
  470. DelayTime: procedure
  471. parse arg delay
  472. start= time('S')
  473. now  = start
  474. done = start + delay
  475. do until now >= done
  476.    now = time('S')
  477.    if now < start then now = now + 86400
  478.    end
  479. return
  480.  
  481.