home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / trucker.zip / TRUCKER.CMD < prev   
OS/2 REXX Batch file  |  1994-10-14  |  54KB  |  1,772 lines
  1. /* REXX */
  2. /*
  3. ========================================================================
  4.  
  5. ------------------------------- TRUCKER --------------------------------
  6.  
  7.                             TRUCKER in REXX
  8.  
  9.             A Multi-platform And Execute-ready Game Program
  10.  
  11.                            Version: 10/14/94
  12.  
  13.  
  14. --------------------------- F R E E W A R E ----------------------------
  15.  
  16. ========================================================================
  17. This was originally a BASIC program written by Hughes Glantzberg from
  18. Irving, Texas.
  19.  
  20. This version has been created based on the above program by Simon Husin
  21. to show REXX program's flexibility and portability.
  22.  
  23. TRUCKER in REXX has been tested to run problem-free on MVS/TSO, Unix,
  24. VM/CMS, OS/2, DOS, DOS/Windows, Amiga, and OS/400 platforms. For
  25. compatibility & other info, please see notes at the bottom the program.
  26.  
  27. Following the Main Program, the functions are placed in the order of
  28. their names.
  29.  
  30.  
  31. Update History:
  32. ========================================================================
  33.  
  34. March, 1993 Version
  35. ------------------------------------------------------------------------
  36. - Program released and transmitted to BBSes in
  37.   USA
  38.   Holland
  39.   Belgium
  40.  
  41.  
  42. September, 1994 Version
  43. ------------------------------------------------------------------------
  44. - OS/400 Support
  45. - Fill, Fill up, Fillup, or Full for Gas quantity is now allowed
  46. - 'shbracket' field introduced to make it more problem-free to upload
  47.   and download this program between PC and the Host.
  48.   (IBM mainframes do not support 'rectangle' brackets, so they get
  49.   converted either to spaces or other values)
  50. - REXX General Information has been removed from Notes and placed in
  51.   REXXIsIt.DOC which accompanies this program.
  52.  
  53. - Program transmitted to BBSes in
  54.   Australia, Melbourne
  55.   Belgium, Antwerp (multiple BBSes)
  56.   USA, California
  57.        Chicago
  58.        Missouri
  59.        Virginia
  60.        Washington (multiple BBSes)
  61.  
  62.  
  63. October, 1994 Version
  64. ------------------------------------------------------------------------
  65. - Function RND simplified
  66. - OS/400 Support corrected
  67. - REXX/370 Compiler release 2.0 compilation results reported
  68. - Tritus ISPF 1.2.5 REXX now runs 'stripped-down' version of Trucker
  69. ========================================================================
  70. */
  71.  
  72. /*
  73. ------------------------------------------------------------------------
  74. Main Program
  75. ------------------------------------------------------------------------
  76. */
  77.  
  78. /* Start Main Program Initialization */
  79.  
  80. call time 'R'         /* Reset the elapse time for the entire program */
  81. parse source shenv .
  82. queue shenv
  83. drop shenv
  84.  
  85.  
  86. /* General Initialization */
  87.  
  88. call InitialGame
  89.  
  90.  
  91. /* Main Driver */
  92.  
  93. do while sh_keep_on_trucking
  94.    call TruckTheJourney
  95.    end
  96.  
  97.  
  98. /* Termination */
  99.  
  100. say ' '
  101. say 'End Of Game...'
  102. say 'Thank you for playing T.R.U.C.K.E.R.'
  103. return 0
  104.  
  105.  
  106.  
  107. AnimateOS2Truck: procedure
  108. /*
  109. ------------------------------------------------------------------------
  110. Show a 'moving truck' under OS/2 2.x PL/2 REXX
  111. ------------------------------------------------------------------------
  112. */
  113. sht1 = ' TRUCKER_OO=.'
  114. sht2 = " -()-----()='"
  115. shtx = center('Press Enter to start the game...', 79)
  116.  
  117. call syscurstate 'OFF'  /* temporarily hide the cursor */
  118. do i = 2 to 79
  119.    if i > 67 & i < 79 then do
  120.       shil = 79 - i
  121.       sht1 = left(sht1, shil)
  122.       sht2 = left(sht2, shil)
  123.       end
  124.    call syscurpos 19, i
  125.    say sht1
  126.    call syscurpos 20, i
  127.    say sht2
  128.    call syscurpos 20, 2
  129.    say left(shtx, i)
  130.    end
  131. call syscurstate 'ON'
  132. return 0
  133.  
  134.  
  135.  
  136. AnimatePersonalTruck: procedure
  137. /*
  138. ------------------------------------------------------------------------
  139. Show a 'moving truck' under Quercus Personal/REXX
  140. ------------------------------------------------------------------------
  141. */
  142. sht1 = ' TRUCKER_OO=.'
  143. sht2 = " -()-----()='"
  144. shtx = center('Press Enter to start the game...', 79)
  145.  
  146. do i = 2 to 79
  147.    if i > 67 & i < 79 then do
  148.       shil = 79 - i
  149.       sht1 = left(sht1, shil)
  150.       sht2 = left(sht2, shil)
  151.       end
  152.    call cursor 20, i
  153.    say sht1
  154.    call cursor 21, i
  155.    say sht2
  156.    call cursor 21, 2
  157.    say left(shtx, i)
  158.    end
  159. return 0
  160.  
  161.  
  162.  
  163. AnimatePortableTruck: procedure
  164. /*
  165. ------------------------------------------------------------------------
  166. Show a 'moving truck' under Kilowatt Software Portable/REXX
  167. ------------------------------------------------------------------------
  168. */
  169. sht1 = ' TRUCKER_OO=.'
  170. sht2 = " -()-----()='"
  171. shtx = center('Press Enter to start the game...', 79)
  172.  
  173. do i = 2 to 79
  174.    if i > 67 & i < 79 then do
  175.       shil = 79 - i
  176.       sht1 = left(sht1, shil)
  177.       sht2 = left(sht2, shil)
  178.       end
  179.    call cursor 20, i
  180.    say sht1
  181.    call cursor 21, i
  182.    say sht2
  183.    call cursor 21, 2
  184.    if i < 78 then  /* to avoid a line overflow, bug(?) in ver.1.10 - */
  185.       say left(shtx, i)
  186.    end
  187. return 0
  188.  
  189.  
  190.  
  191. CalcSpoilFactor: procedure expose ct cx
  192. /*
  193. ------------------------------------------------------------------------
  194. Calculate load 1 (oranges) spoil factor
  195. ------------------------------------------------------------------------
  196. */
  197. if ct = 1 then do
  198.    cx = cx + (RND() * 3) % 1
  199.    say '     Sitting with the refer unit off is damaging the oranges.'
  200.    end
  201. call Delay 1000
  202. return 0
  203.  
  204.  
  205.  
  206. ChangeFlatTire:
  207. /*
  208. ------------------------------------------------------------------------
  209. Change the flat tire(s)
  210. ------------------------------------------------------------------------
  211. */
  212. shf = 3000
  213. shd = 100
  214. interpret rxbeep
  215. do shw = 200 to 100 by - 50
  216.    shf = shw
  217.    shd = (200 / shf * 500) % 1
  218.    interpret rxbeep
  219.    shf = shw / 2
  220.    interpret rxbeep
  221.    end
  222. say 'You just blew a tire !!'
  223. if ts <= 0 then do
  224.    say 'Since your spare has already been used, you have to call a tow'
  225.    say 'truck'
  226.    say 'from town to deliver a new tire for you.'
  227.    say '     This service cost $400.00 and took 4 hours.'
  228.    hl = hl + 4
  229.    hr = hr + 4
  230.    xc = xc + 400
  231.    end
  232. else do
  233.    ts = ts - 1
  234.    if ts < 0 then
  235.       ts = 0
  236.    tc = tc - 2 * ts
  237.    t = (RND() * 2) % 1 + 1
  238.    if t = 1 then
  239.       tX = 'outside'
  240.    else
  241.       tX = 'inside'
  242.    say '     It took 't' hours to change the 'tX' tire.'
  243.    hl = hl + t + 1
  244.    hr = hr + t + 1
  245.    end
  246. call Delay 750
  247. return 0
  248.  
  249.  
  250.  
  251. CheckObstacles:
  252. /*
  253. ------------------------------------------------------------------------
  254. Check obstacles or hindrance on the road
  255. ------------------------------------------------------------------------
  256. */
  257. say 'You have just passed 'mpX.rt.np
  258. zh = zm.rt.np
  259. sl = 55
  260. intzh = zh % 1
  261. select
  262.    when intzh = 1 then do
  263.         say 'Time zone changes -- set clock ahead one hour.'
  264.         hr = hr + 1
  265.         call ReportTripDuration hr
  266.         end
  267.    when intzh = 2 then do
  268.         t = 100 * (zh - intzh) % 1
  269.         if t > 0 then do
  270.            say 'STOP!   Pay toll of $'t
  271.            xc = xc + t
  272.            end
  273.         end
  274.    when intzh = 3 then do
  275.         if RND() >= zh - intzh then do
  276.            say 'Construction ahead !!'
  277.            call Delay 150
  278.            say 'Slow down -- speed limit 35 MPH'
  279.            sl = 35
  280.            end
  281.         end
  282.    when intzh = 4 then do
  283.         if RND() >= zh - intzh then do
  284.            t = sp + RND() * 5 % 1 - 2
  285.            say 'You were just clocked by radar at 't'MPH.'
  286.            if t > sl + 3 then do
  287.               call StopForPolice
  288.               if sh_keep_on_trucking then
  289.                  nop
  290.               else
  291.                  return 0
  292.               end
  293.            else
  294.               say '     No ticket this time.'
  295.            end
  296.         end
  297.    when intzh = 5 then do
  298.         if zh = intzh &,
  299.            RND() >= 0.5 |,
  300.            (zh < intzh | zh > intzh) &,
  301.            RND() < zh - intzh then
  302.            nop
  303.         else do
  304.            say 'Weighing station open -- trucks must stop.'
  305.            call Delay 150
  306.            say 'Scale weighs truck with cargo, fuel & driver: '
  307.            t = (19000 + wl + 7 * wf + 25 * RND() * 10) % 1
  308.            say t' pounds.'
  309.            t = t - 68000 % 1  /* limit was 60000 */
  310.            if t < 1 then
  311.               say "     You're O.K."
  312.            else if zh = 5 then do
  313.               say 'You are not allowed to enter Louisiana with that',
  314.                   'load.'
  315.               say '     Take a 200 mile detour through Arkansas',
  316.                   'with 45 MPH limit.'
  317.               sl = 45
  318.               mrX.rt.np = 'Arkansas country roads'
  319.               do i = 12 to 25
  320.                  mp.rt.i = mp.rt.i + 200
  321.                  end
  322.               mt.rt = mt.rt + 200
  323.               end
  324.            else do
  325.               t1 = (RND() * 4 + 2) % 1
  326.            say '     Overweight fine is $200.00 plus 't1' cents/pound.'
  327.               xc = xc + 200 + (t * t1) / 100
  328.               say 'Pay fine of $'200 + (t * t1) / 100
  329.               end
  330.            end
  331.         end
  332.    when intzh = 6 then do
  333.         if RND() >= zh - intzh then do
  334.            t = (RND() * 6) % 1
  335.            say 'A rock slide has blocked the Alleghany Tunnel',
  336.                'entrance.'
  337.            say '     THE HIGHWAY DEPARTMENT WILL HAVE IT',
  338.                'CLEARED IN 't' HOURS.'
  339.            hr = hr + t
  340.            call Delay 150
  341.            hsw1 = 1
  342.            if ct = 1 then do
  343.               wf = wf - 7 * t
  344.               if wf <= 1 then do
  345.                  say '     You ran out of gas while waiting...'
  346.                  t = 0
  347.                  call WaitForGasDelivery
  348.                  hsw1 = 0
  349.                  end
  350.               end
  351.            if hsw1 then do
  352.               if t > 1 then
  353.                  t1 = (t / 2 + 0.5) % 1
  354.               else
  355.                  t1 = 0
  356.               if t1 > 3 then
  357.                  hl = 0
  358.               else if t1 > 0 then
  359.                  hl = hl / 2
  360.               hs = hs + t1
  361.               say '     While waiting, you got 't1' hours of sleep...'
  362.               call ReportTripDuration hr
  363.               end
  364.            end
  365.         end
  366.    when intzh = 7 then do
  367.         if ct = 1 &,
  368.            RND() >= zh - intzh then do
  369.            say 'The trailer refrigeration unit has failed endangering',
  370.                'the cargo.'
  371.            say '     Repairs take 2 hours and cost $100.00.'
  372.            cx = cx + RND() * 5 % 1
  373.            hl = hl + 2
  374.            hr = hr + 2
  375.            xc = xc + 100
  376.            call ReportTripDuration hr
  377.            call Delay 400
  378.            end
  379.         end
  380.    when intzh = 8 then
  381.         call EndOfTrip
  382.    otherwise
  383.         nop
  384.    end
  385. np = np + 1
  386. call Delay 150
  387. return 0
  388.  
  389.  
  390.  
  391. CheckOS: procedure expose rxbeep rxcls rxenv rxext rxpull
  392. /*
  393. ------------------------------------------------------------------------
  394. Check operating system environment
  395. Initial system specific commands for local system interpret(ation)
  396. ------------------------------------------------------------------------
  397. */
  398. parse version interpreter version release
  399. addr = address()
  400. parse pull env
  401. /* parse source env . */
  402. rxenv = env' @ 'addr'  Running:'interpreter'  Ver/Rel:'version'/'release
  403. rxext = "say center('Press Enter to start the game...', 79)"
  404. interpreter = translate(interpreter)
  405. addr = translate(addr)
  406. shbracket = d2c(91) /* 'Rectangle' left (open) parenthesis */
  407.  
  408. select
  409.    when interpreter = 'REXX370' then do
  410.                     /* Welcome to the IBM Mainframe */
  411.         select
  412.            when addr = 'MVS' then do            /* MVS */
  413.                 say 'Sorry!'
  414.                 say 'This program is not intended to be used in the'
  415.                 say 'MVS Batch (IRXJCL) environment.'
  416.                 exit 10
  417.                 end
  418.            when addr = 'TSO' then do            /* TSO/E */
  419.                 if strip(sysvar('sysenv')) = 'FORE' then do
  420.                    rxcls = "'clrscrn'"
  421.                    rxbeep = 'nop'
  422.                    rxpull = 'pull shstr'
  423.                    end
  424.                 else do
  425.                    say 'Sorry!'
  426.                    say 'This program is not intended to be used in the'
  427.                    say 'TSO Batch (IKJEFT01) environment.'
  428.                    exit 20
  429.                    end
  430.                 end
  431.            otherwise                            /* VM/CMS */
  432.                 rxcls = "'clrscrn'"             /* SH 03/04/93 */
  433.                 rxbeep = 'nop'
  434.                 rxpull = 'pull shstr'
  435.            end
  436.         end
  437.  
  438.    when interpreter = 'UNI-REXX' then do
  439.                     /* Welcome to a Unix/AIX Workstation */
  440.                     /* The Workstation Group (wrk/grp) uni-REXX */
  441.         rxcls = "'clear'"
  442.         rxbeep = "'echo "d2c(7)"'"   /* ANSI ESC seq. char. (BELL) */
  443.         rxpull = 'pull shstr'
  444.         end
  445.  
  446.    when interpreter = 'REXXSAA' &,
  447.         addr = 'COMMAND' then do     /* Welcome to the OS/400 REXX */
  448.            rxcls =  'say d2c(12)'    /* EBCDIC char. (FF) */
  449.            rxbeep = 'say d2c(47)'    /* EBCDIC char. (BEL) */
  450.            rxpull = 'pull shstr'
  451.            end
  452.  
  453.    when interpreter = 'REXXSAA' &,
  454.         addr = 'CMD' then do         /* Welcome to the IBM PL 2/REXX */
  455.         rxbeep = 'result = beep(shf, shd * 1.5 % 1)'
  456.         rxcls = "'cls'"
  457.         /* Escape character, bracket, 36;44m light cyan on blue */
  458.         say '1B'x || shbracket'1;36;44m'
  459.         if word(release, 3) < 1992 then do
  460.            'echo off'
  461.            rxpull = 'shstr = translate(linein(con))'
  462.            rxenv = rxenv '(16-bit)'
  463.            end
  464.         else do
  465.            '@echo off'
  466.            call rxfuncadd sysloadfuncs, rexxutil, sysloadfuncs
  467.            call sysloadfuncs
  468.            rxpull = 'pull shstr'
  469.            rxenv = rxenv '(32-bit)'
  470.            rxext = 'call AnimateOS2Truck'
  471.            end
  472.         end
  473.  
  474.    when interpreter = 'REXX/PERSONAL' then do
  475.                     /* Welcome to the Quercus Systems REXX world */
  476.         if addr = 'CMD' then do                 /* under OS/2 */
  477.            /* Escape character, bracket, 36;44m light cyan on blue */
  478.            say '1B'x || shbracket'1;36;44m'
  479.            rxcls = 'result = scrwrite(1,1,,2000,,27) cursor(1,1)'
  480.            rxbeep = 'result = sound(shf, shd / 700)' /* or beep */
  481.            rxpull = 'pull shstr'
  482.            if version <= 2 then
  483.               rxenv = rxenv '(16-bit)'
  484.            else
  485.               rxenv = rxenv '(32-bit)'
  486.            rxext = 'call AnimatePersonalTruck'
  487.            end
  488.         else if addr = 'DOS' then do            /* under PC/MS-DOS */
  489.            rxcls = 'result = scrwrite(1,1,,2000,,27) cursor(1,1)'
  490.            rxbeep = 'result = sound(shf, shd / 700)' /* or beep */
  491.            rxpull = 'pull shstr'
  492.            rxext = 'call AnimatePersonalTruck'
  493.            end
  494.         else if addr = 'WINREXX' then do        /* under MS-Windows or
  495.                                                    IBM WinOS2 */
  496.            rxcls = "'cls'"
  497.            rxbeep = 'result = sound(shf, shd / 700)' /* or beep */
  498.            rxpull = 'pull shstr'
  499.            end
  500.         else do                                 /* unknown env. */
  501.            rxcls = "do 25;say ' ';end"
  502.            rxbeep = 'result = sound(shf, shd / 700)' /* assumed! */
  503.            rxpull = 'pull shstr'
  504.            end
  505.         end
  506.  
  507.    when left(interpreter, 9) = 'REXX-KILO' then do /* PC/MS-DOS */
  508.                     /* Welcome to the Kilowatt Software Portable/REXX */
  509.         rxcls = "'cls'"
  510.         rxbeep = 'result = tone(shf, shd / 700)'
  511.         rxpull = 'pull shstr'
  512.         rxext = 'call AnimatePortableTruck'
  513.         end
  514.  
  515.    when left(interpreter, 9) = 'REXX/WIND' then do /* Windows/Win-OS2 */
  516.                     /* Welcome to the Kilowatt Software REXX/Windows */
  517.         rxcls = "'cls'"
  518.         rxbeep = 'result = tone(shf, shd / 700)'
  519.         rxpull = 'pull shstr'
  520.         end
  521.  
  522.    when interpreter = 'REXXSAA' &,
  523.         addr = 'ISPEXEC' then do
  524.                     /* Welcome to the Tritus REXX under OS/2 TSPF */
  525.         rxcls  = 'ADDRESS CMD CLS'
  526.         rxbeep = 'nop'
  527.         rxpull = 'pull shstr'
  528.         end
  529.  
  530.    when interpreter = 'REXX:OPEN-REXX179' then do
  531.                     /* Welcome to the Tritus REXX under DOS TSPF */
  532.         rxcls = "ADDRESS CMD CLS"
  533.         rxbeep = 'nop'
  534.         rxpull = 'pull shstr'
  535.         end
  536.  
  537.    when interpreter = 'AREXX' then do
  538.                     /* Welcome to the Amiga Micro Computer w/ ARexx */
  539.         /* Escape character, bracket, 2J */
  540.         rxcls = "result = writech('STDOUT', '1B'x"
  541.         rxcls = rxcls || '"' || shbracket || '2J")'
  542.                                       /* ANSI ESC seq. char. (CLS) */
  543.         rxbeep = "result = writech('STDOUT', '07'x)"
  544.                                       /* ANSI ESC seq. char. (BELL) */
  545.         rxpull = 'pull shstr'
  546.         end
  547.  
  548.    otherwise
  549.                     /* Welcome to ... computer environment */
  550.         rxcls = 'nop'   /* with your ... REXX interpreter/compiler */
  551.         rxbeep = 'nop'
  552.         rxpull = 'pull shstr'
  553.    end
  554. interpret rxcls
  555. return 0
  556.  
  557.  
  558.  
  559. CheckPhysical:
  560. /*
  561. ------------------------------------------------------------------------
  562. Check the mood & physical condition of trucker
  563. ------------------------------------------------------------------------
  564. */
  565. if hl > 19 |,
  566.    hr / hs > 4 then do
  567.    cd = 100
  568.    cdX = '..E.X.H.A.U.S.T.E.D..'
  569.    end
  570. else if hl < 4 &,
  571.    Cos(hr / (hs * 1.819)) > 0 then do
  572.    cd = 1
  573.    cdX = 'rested & rearing to go.'
  574.    end
  575. else if hl < 8 &,
  576.    Cos(hr / (hs * 1.892)) > 0 then do
  577.    cd = 2
  578.    cdX = 'fine'
  579.    end
  580. else if hl < 12 &,
  581.    hr / hs <= 3 then do
  582.    cd = 4
  583.    cdX = '  b o r e d'
  584.    end
  585. else if hl < 16 &,
  586.    hr / hs <= 3 then do
  587.    cd = 8
  588.    cdX = '  t i r e d  !!'
  589.    end
  590. else do
  591.    cd = 25
  592.    cdX = "fatigued...you're getting sleepy"
  593.    end
  594. return 0
  595.  
  596.  
  597.  
  598. CheckWheater:
  599. /*
  600. ------------------------------------------------------------------------
  601. Check the weather and driving condition and report its description
  602. ------------------------------------------------------------------------
  603. */
  604. af = (3000 + mf) * RND()
  605. crX = 'clear & dry'
  606. select
  607.    when rt = 0 then do
  608.       if af < 3400 &,
  609.          (cr < 50 | cr > 50) then
  610.          cr = 1
  611.       else if af > 4900 then do
  612.          cr = 50
  613.          crX = 'B-L-I-Z-Z-A-R-D  !!'
  614.          end
  615.       else if af > 4700 then do
  616.          cr = 10
  617.          crX = 'fog -- limited visibility'
  618.          end
  619.       else if af > 4200 then do
  620.          cr = 5
  621.          if (RND() * 3) % 1 + 1 = 1 then
  622.             crX = 'light snow'
  623.          else
  624.             crX = 'rain'
  625.          end
  626.       else do
  627.          cr = 3
  628.          crX = 'clear, but roadway is wet'
  629.          end
  630.       end
  631.    when rt = 1 then do
  632.       if af < 3300 &,
  633.          (cr < 50 | cr > 50) then
  634.          cr = 1
  635.       else if af > 4800 then do
  636.          cr = 50
  637.          crX = 'B-L-I-Z-Z-A-R-D  !!'
  638.          end
  639.       else if af > 4600 then do
  640.          cr = 10
  641.          crX = 'fog -- limited visibility'
  642.          end
  643.       else if af > 3800 then do
  644.          cr = 5
  645.          crX = 'light snow'
  646.          end
  647.       else do
  648.          cr = 3
  649.          crX = 'clear, but roadway is wet'
  650.          end
  651.       end
  652.    otherwise do
  653.       if af < 4000 &,
  654.          (cr < 50 | cr > 50) then
  655.          cr = 1
  656.       else if af > 5700 then do
  657.          cr = 50
  658.          crX = 'B-L-I-Z-Z-A-R-D  !!'
  659.          end
  660.       else if af > 5500 then do
  661.          cr = 10
  662.          crX = 'fog -- limited visibility'
  663.          end
  664.       else if af > 4400 then do
  665.          cr = 5
  666.          crX = 'rain'
  667.          end
  668.       else do
  669.          cr = 3
  670.          crX = 'clear, but roadway is wet'
  671.          end
  672.       end
  673.    end
  674. return 0
  675.  
  676.  
  677.  
  678. Cos: procedure
  679. arg rad .
  680. /*
  681. ------------------------------------------------------------------------
  682. Calculate the COSine of the argument X (in Radians)
  683. According to algorithm: cos(x) = 1 - x**2/2! + x**4/4! - x**6/6! + ...
  684. ------------------------------------------------------------------------
  685. */
  686.  
  687. serrad = 1
  688. serfactn = 0
  689. serfact = 1
  690. plusmin = 1
  691. radquad = rad * rad
  692. cosine = 1
  693.  
  694. do digits()
  695.    serrad = serrad * radquad
  696.  
  697.    serfactn = serfactn + 2
  698.    serfact = serfact * (serfactn - 1) * serfactn
  699.  
  700.    plusmin = 0 - plusmin
  701.    serprec = serrad / serfact * plusmin
  702.  
  703.    if serprec = 0 then
  704.       leave
  705.    cosine = cosine + serprec
  706.    end
  707.  
  708. return cosine
  709.  
  710.  
  711.  
  712. Delay: procedure
  713. arg timeout
  714. /*
  715. ------------------------------------------------------------------------
  716. Delay processing through a loop for 'timeout' hundredths
  717. ------------------------------------------------------------------------
  718. */
  719. if timeout < 0.5 then
  720.    return 0
  721. call time 'R'       /* Reset the elapse time for this function only */
  722. hsec = (timeout + 0.5) / 100
  723. do until hsec <= time('E')
  724.    end
  725. return 0
  726.  
  727.  
  728.  
  729. EndOfTrip:
  730. /*
  731. ------------------------------------------------------------------------
  732. End of trip processing
  733. ------------------------------------------------------------------------
  734. */
  735. interpret rxcls
  736. say ' '
  737. say center('WELCOME', 79)
  738. call Delay 100
  739. say center('TO', 79)
  740. call Delay 100
  741. say center('NEW YORK', 79)
  742. call Delay 250
  743. call ReportTripDuration hr
  744. t = hr - (hr % 24)
  745. if t < 10 &,
  746.    t > 21 then do
  747.    say 'The warehouse is closed...'
  748.    if t < 10 then
  749.       t = 10 - t
  750.    else
  751.       t = 34 - t
  752.    say 'Wait 'FormatSim(t, 3)' hours until it opens...'
  753.    call Delay 500
  754.    hr = hr + t
  755.    call ReportTripDuration hr
  756.    end
  757. say ' '
  758. t = (hr / 24) % 1
  759. t1 = hr - 24 * t
  760. if t1 > 1 then
  761.    say 'You completed the trip in 't' days and 't1' hours.'
  762. else
  763.    say 'You completed the trip in 't' days.'
  764. say '     Trip expenses totaled $'xc
  765. t1 = 85 * t + 85
  766. say '     Truck payment, insurance and taxes cost $'t1
  767. xc = xc + t1
  768. xt = 0
  769. say ' '
  770. if ct = 1 then do
  771.    t1 = (t - 4) * (RND() * 3) % 1
  772.    if t1 > 0 then
  773.       cx = cx + t1
  774.    if cx > 6 then
  775.       say 'Your oranges have spoiled.  Haul them to the dump!'
  776.    else do
  777.       say 'Collect six-and-a-half cents per pound for good oranges.'
  778.       xt = 0.065 * wl
  779.       say '     Total for the load: $'xt
  780.       if cx >= 1 then do
  781.          say '     Part of the load is damaged. Subtract '5 * cx'%.'
  782.          xt = xt - xt * cx / 20
  783.          say '     Net payment is $'xt
  784.          end
  785.       end
  786.    end
  787. else if ct = 2 then do
  788.    xt = 0.05 * wl
  789.    say 'Collect five cents a pound for freight.'
  790.    say '     Total for load is $'xt
  791.    if hr >= 95 then do
  792.       say "     You're late!!  Subtract ten percent penalty."
  793.       xt = xt * 0.9
  794.       say '     Net payment is $'xt
  795.       end
  796.    end
  797. else do
  798.    say 'Postmaster pays 4.75 cents per pound on delivery.'
  799.    xt = 0.0475 * wl
  800.    end
  801. say ' '
  802. xt = xt - xc
  803. if xt >= 0 then do
  804.    say 'Your net profit this trip was $'xt
  805.    if xt > 100 then
  806.       say '     G O O D   W O R K  !!'
  807.    if xt < 200 then
  808.       say "     You'd make more money washing dishes !"
  809.    sh_keep_on_trucking = 0
  810.    end
  811. else do
  812.    say 'Bad trip. . . You lost $'abs(xt)
  813.    say 'You are bankrupt !!!'
  814.    call Delay 200
  815.    call GiveUpTruck
  816.    end
  817. return 0
  818.  
  819.  
  820.  
  821. FormatSim:
  822. arg number, before
  823. /*
  824. ------------------------------------------------------------------------
  825. Format a specified number of digits before the decimal point
  826. (simulating REXX FORMAT function which is not available in ARexx)
  827. ------------------------------------------------------------------------
  828. */
  829. shdigits = digits()
  830. numeric digits before
  831. shformattemp = number + 0
  832. numeric digits shdigits
  833. return shformattemp
  834.  
  835.  
  836.  
  837. GetNum: procedure expose rxenv rxpull
  838. /*
  839. ------------------------------------------------------------------------
  840. Get a numeric data from the console/keyboard
  841. ------------------------------------------------------------------------
  842. */
  843. do forever
  844.    shnum = space(translate(GetStr(), '', ','), 0)
  845.    if datatype(shnum, 'N') then
  846.       leave
  847.    end
  848. return shnum
  849.  
  850.  
  851.  
  852. GetStr: procedure expose rxenv rxpull
  853. /*
  854. ------------------------------------------------------------------------
  855. Get a string of characters from the console/keyboard
  856. ------------------------------------------------------------------------
  857. */
  858. shstr = ''
  859. interpret rxpull
  860. if shstr = '*' then do          /* allow user to exit at any time
  861.                                    by entering '*' at any prompt  */
  862.    say 'Thank you for playing Trucker under...'
  863.    say rxenv
  864.    exit 0
  865.    end
  866. return shstr
  867.  
  868.  
  869.  
  870. GiveUpTruck: procedure expose sh_keep_on_trucking
  871. /*
  872. ------------------------------------------------------------------------
  873. Give up the truck due to financial problems or trafic violations
  874. ------------------------------------------------------------------------
  875. */
  876. say ' '
  877. say 'Your rig has been repossessed...'
  878. call Delay 250
  879. sh_keep_on_trucking = 0
  880. return 0
  881.  
  882.  
  883.  
  884. InitialGame:
  885. /*
  886. ------------------------------------------------------------------------
  887. Initial game variables
  888. ------------------------------------------------------------------------
  889. */
  890. call CheckOS
  891. call ShowBanner
  892. cx = 0
  893. hl = 3
  894. hr = 0
  895. hs = 7
  896. mf = 0
  897. np = 1
  898. ns = 0
  899. nt = 0
  900. sl = 55
  901. tc = 10
  902. ts = 1
  903. wf = 190
  904. xc = 190
  905. ntX.1 = 'first'
  906. ntX.2 = 'second'
  907. ntX.3 = 'third'
  908. ntX.4 = 'fourth'
  909. dsX.0 = 'Monday'
  910. dsX.1 = 'Tuesday'
  911. dsX.2 = 'Wednesday'
  912. dsX.3 = 'Thursday'
  913. dsX.4 = 'Friday'
  914. dsX.5 = 'Saturday'
  915. dsX.6 = 'Sunday'
  916. sh_keep_on_trucking = 1   /* switch, 0 = end of loop */
  917. call Delay 100
  918. interpret rxext
  919. call GetStr
  920. interpret rxcls
  921. call ReportTripDuration hr
  922. say 'You are at the Los Angeles trucking terminal.'
  923. say 'Three types of cargo are available:'
  924. say ' '
  925. say "     1--Oranges (highest profit if they don't spoil)"
  926. say '     2--Freight forwarding (penalty for late delivery)'
  927. say '     3--U.S. Mail (lowest rate, but no hurry to arrive)'
  928. say ' '
  929. say 'The cargo is due in New York by 4 PM on Thursday.'
  930. say ' '
  931. say 'Which type of cargo do you want (1, 2 or 3)?'
  932. do forever
  933.    ct = GetStr()
  934.    if length(ct) = 1 & pos(ct, '123') > 0 then
  935.       leave
  936.    end
  937. wl = 0
  938. do while wl < 25000
  939.    say 'How many pounds will you carry (40,000 is the legal limit)?'
  940.    wl = GetNum()
  941.    if wl < 25000 then
  942.       say "You can't make a living on half a load."
  943.    end
  944. say ' '
  945. say '     They are loading your truck now.'
  946. call Delay (wl % 100)
  947. if wl > 50000 then do
  948.    wl = 50000
  949.    say '     50,000 pounds of cargo has filled your trailer!'
  950.    call Delay 250
  951.    end
  952. interpret rxcls
  953. hr = hr + 1
  954. call ReportTripDuration hr
  955. say 'You paid $190.00 for a nearly full tank of diesel fuel.'
  956. say ' '
  957. say 'Two of your tires are worn.  Do you want replacements (Y or N)?'
  958. do forever
  959.    ikeyX = GetStr()
  960.    if length(ikeyX) = 1 & pos(ikeyX, 'NY') > 0 then
  961.       leave
  962.    end
  963. if ikeyX = 'Y' then do
  964.    say 'A new tire costs $200.00.  A retread costs $100.00.'
  965.    say '     Which type do you want (N=new or R=retread)?'
  966.    do forever
  967.       zX = GetStr()
  968.       if length(zX) = 1 & pos(zX, 'NR') > 0 then
  969.          leave
  970.       end
  971.    say '     How many (0-3)?'
  972.    do forever
  973.       tno = GetStr()
  974.       if length(tno) = 1 & pos(tno,  '0123') > 0 then
  975.          leave
  976.       end
  977.    if tno > 0 then do
  978.       ts = ts + tno - 2
  979.       if zX = 'R' then do
  980.          tc = tc - 1.5 * tno
  981.          xc = xc + 100 * tno
  982.          end
  983.       else do
  984.          tc = tc - 2 * tno
  985.          xc = xc + 200 * tno
  986.          end
  987.       end
  988.    end
  989. say ' '
  990. say 'You may choose the N(orthern), M(iddle) or S(outhern) route.'
  991. say '     Which route do you choose (N, M or S)?'
  992. do forever
  993.    ikeyX = GetStr()
  994.    if length(ikeyX) = 1 & pos(ikeyX, 'MNS') > 0 then
  995.       leave
  996.    end
  997. say ' '
  998. if ikeyX = 'N' then do
  999.    rt = 1
  1000.    rh = 4
  1001.    mt.1 = 2710
  1002.    mp.1.1  =   90; mpX.1.1  = 'Barstow';
  1003.      mrX.1.1  = 'I-15 in California';    zm.1.1  = 7.80
  1004.    mp.1.2  =  245; mpX.1.2  = 'Las Vegas';
  1005.      mrX.1.2  = 'I-15 in California';    zm.1.2  = 1.00
  1006.    mp.1.3  =  365; mpX.1.3  = 'Utah border';
  1007.      mrX.1.3  = 'I-15 in Arizona';       zm.1.3  = 0.00
  1008.    mp.1.4  =  500; mpX.1.4  = 'End of Interstate';
  1009.      mrX.1.4  = 'I-15 in Utah';          zm.1.4  = 3.20
  1010.    mp.1.5  =  555; mpX.1.5  = 'Salina';
  1011.      mrX.1.5  = 'US-89 in Utah';         zm.1.5  = 4.50
  1012.    mp.1.6  =  760; mpX.1.6  = 'Grand Junction';
  1013.      mrX.1.6  = 'I-70 in Utah';          zm.1.6  = 5.40
  1014.    mp.1.7  = 1010; mpX.1.7  = 'Denver';
  1015.      mrX.1.7  = 'I-70 in Colorado';      zm.1.7  = 3.75
  1016.    mp.1.8  = 1190; mpX.1.8  = 'Nebraska border';
  1017.      mrX.1.8  = 'I-76 in Colorado';      zm.1.8  = 1.00
  1018.    mp.1.9  = 1450; mpX.1.9  = 'Omaha';
  1019.      mrX.1.9  = 'I-80 in Nebraska';      zm.1.9  = 5.50
  1020.    mp.1.10 = 1590; mpX.1.10 = 'Demoines';
  1021.      mrX.1.10 = 'I-80 in Iowa';          zm.1.10 = 4.75
  1022.    mp.1.11 = 1750; mpX.1.11 = 'Illinois border';
  1023.      mrX.1.11 = 'I-80 in Iowa';          zm.1.11 = 5.60
  1024.    mp.1.12 = 1910; mpX.1.12 = 'Gary';
  1025.      mrX.1.12 = 'I-80 in Illinois';      zm.1.12 = 2.50
  1026.    mp.1.13 = 2050; mpX.1.13 = 'Ohio border';
  1027.      mrX.1.13 = 'Indianna Turnpike';     zm.1.13 = 2.45
  1028.    mp.1.14 = 2215; mpX.1.14 = 'Cleveland';
  1029.      mrX.1.14 = 'Ohio Turnpike';         zm.1.14 = 2.80
  1030.    mp.1.15 = 2280; mpX.1.15 = 'Pennsylvania border';
  1031.      mrX.1.15 = 'I-80 in Ohio';          zm.1.15 = 4.16
  1032.    mp.1.16 = 2615; mpX.1.16 = 'East Stroudsberg';
  1033.      mrX.1.16 = 'I-80 in Pennsylvania';  zm.1.16 = 3.33
  1034.    mp.1.17 = 2675; mpX.1.17 = 'Washington Bridge';
  1035.      mrX.1.17 = 'I-80 in New Jersey';    zm.1.17 = 2.20
  1036.    mp.1.18 = 9999; mpX.1.18 = 'New York';
  1037.      mrX.1.18 = 'city streets';          zm.1.18 = 8.00
  1038.    end
  1039. else if ikeyX = 'M' then do
  1040.    rt = 0
  1041.    rh = 2
  1042.    mt.0 = 2850
  1043.    mp.0.1  =  90;  mpX.0.1  = 'Barstow';
  1044.      mrX.0.1  = 'I-15 in California';    zm.0.1  = 7.80
  1045.    mp.0.2  =  225; mpX.0.2  = 'Needles';
  1046.      mrX.0.2  = 'I-40 in California';    zm.0.2  = 1.00
  1047.    mp.0.3  =  440; mpX.0.3  = 'Flagstaff';
  1048.      mrX.0.3  = 'I-40 in California';    zm.0.3  = 3.65
  1049.    mp.0.4  =  620; mpX.0.4  = 'Gallup';
  1050.      mrX.0.4  = 'I-40 in Arizona';       zm.0.4  = 5.50
  1051.    mp.0.5  =  760; mpX.0.5  = 'Albuquerque';
  1052.      mrX.0.5  = 'I-40 in New Mexico';    zm.0.5  = 3.35
  1053.    mp.0.6  =  930; mpX.0.6  = 'Tucumcari';
  1054.      mrX.0.6  = 'I-40 in New Mexico';    zm.0.6  = 1.00
  1055.    mp.0.7  = 1040; mpX.0.7  = 'Amarillo';
  1056.      mrX.0.7  = 'I-40 in Texas';         zm.0.7  = 7.80
  1057.    mp.0.8  = 1155; mpX.0.8  = 'Oklahoma border';
  1058.      mrX.0.8  = 'I-40 in Texas';         zm.0.8  = 5.50
  1059.    mp.0.9  = 1305; mpX.0.9  = 'Oklahoma City';
  1060.      mrX.0.9  = 'I-40 in Oklahoma';      zm.0.9  = 2.65
  1061.    mp.0.10 = 1530; mpX.0.10 = 'Missouri border';
  1062.      mrX.0.10 = 'Oklahoma Turnpike';     zm.0.10 = 2.40
  1063.    mp.0.11 = 1815; mpX.0.11 = 'St. Louis';
  1064.      mrX.0.11 = 'I-44 in Missouri';      zm.0.11 = 0.00
  1065.    mp.0.12 = 1980; mpX.0.12 = 'Terre Haute';
  1066.      mrX.0.12 = 'I-70 in Illinois';      zm.0.12 = 5.50
  1067.    mp.0.13 = 2050; mpX.0.13 = 'Indianapolis';
  1068.      mrX.0.13 = 'I-70 in Indianna';      zm.0.13 = 0.00
  1069.    mp.0.14 = 2115; mpX.0.14 = 'Ohio border';
  1070.      mrX.0.14 = 'I-70 in Indianna';      zm.0.14 = 1.00
  1071.    mp.0.15 = 2220; mpX.0.15 = 'Columbus';
  1072.      mrX.0.15 = 'I-70 in Ohio';          zm.0.15 = 4.25
  1073.    mp.0.16 = 2350; mpX.0.16 = 'Wheeling West Virginia';
  1074.      mrX.0.16 = 'I-70 in Ohio';          zm.0.16 = 4.25
  1075.    mp.0.17 = 2410; mpX.0.17 = 'New Stanton';
  1076.      mrX.0.17 = 'I-70 in Pennsylvania';  zm.0.17 = 6.75
  1077.    mp.0.18 = 2570; mpX.0.18 = 'Harrisburg';
  1078.      mrX.0.18 = 'Pennsylvania Turnpike'; zm.0.18 = 3.75
  1079.    mp.0.19 = 2760; mpX.0.19 = 'New Jersey border';
  1080.      mrX.0.19 = 'Pennsylvania Turnpike'; zm.0.19 = 2.95
  1081.    mp.0.20 = 2840; mpX.0.20 = 'Holland Tunnel';
  1082.      mrX.0.20 = 'I-70 in New Jersey';    zm.0.20 = 2.40
  1083.    mp.0.21 = 9999; mpX.0.21 = 'New York';
  1084.      mrX.0.21 = 'New York streets';      zm.0.21 = 8.00
  1085.    end
  1086. else do
  1087.    rt = 2
  1088.    rh = 1
  1089.    mt.2 = 3120
  1090.    mp.2.1  =   75; mpX.2.1  = 'Palm Springs';
  1091.      mrX.2.1  = 'I-10 in California';    zm.2.1  = 0.00
  1092.    mp.2.2  =  225; mpX.2.2  = 'Blythe';
  1093.      mrX.2.2  = 'I-10 in California';    zm.2.2  = 1.00
  1094.    mp.2.3  =  375; mpX.2.3  = 'Phoenix';
  1095.      mrX.2.3  = 'I-10 in Arizona';       zm.2.3  = 0.00
  1096.    mp.2.4  =  495; mpX.2.4  = 'Tucson';
  1097.      mrX.2.4  = 'I-10 in Arizona';       zm.2.4  = 7.90
  1098.    mp.2.5  =  650; mpX.2.5  = 'Lordsburg';
  1099.      mrX.2.5  = 'I-10 in Arizona';       zm.2.5  = 5.75
  1100.    mp.2.6  =  795; mpX.2.6  = 'El Paso';
  1101.      mrX.2.6  = 'I-10 in New Mexico';    zm.2.6  = 0.00
  1102.    mp.2.7  =  965; mpX.2.7  = 'Pecos';
  1103.      mrX.2.7  = 'I-10 in Texas';         zm.2.7  = 1.00
  1104.    mp.2.8  = 1080; mpX.2.8  = 'Odessa';
  1105.      mrX.2.8  = 'I-20 in Texas';         zm.2.8  = 0.00
  1106.    mp.2.9  = 1250; mpX.2.9  = 'Abilene';
  1107.      mrX.2.9  = 'I-20 in Texas';         zm.2.9  = 3.80
  1108.    mp.2.10 = 1439; mpX.2.10 = 'Dallas';
  1109.      mrX.2.10 = 'I-20 in Texas';         zm.2.10 = 0.00
  1110.    mp.2.11 = 1610; mpX.2.11 = 'Louisiana border';
  1111.      mrX.2.11 = 'I-20 in Texas';         zm.2.11 = 5.00
  1112.    mp.2.12 = 1785; mpX.2.12 = 'Vicksburg';
  1113.      mrX.2.12 = 'I-20 in Louisiana';     zm.2.12 = 0.00
  1114.    mp.2.13 = 1965; mpX.2.13 = 'Alabama border';
  1115.      mrX.2.13 = 'I-20 in Mississippi';   zm.2.13 = 1.00
  1116.    mp.2.14 = 2100; mpX.2.14 = 'Birmingham';
  1117.      mrX.2.14 = 'I-20 in Alabama';       zm.2.14 = 4.25
  1118.    mp.2.15 = 2200; mpX.2.15 = 'Georgia border';
  1119.      mrX.2.15 = 'I-20 in Alabama';       zm.2.15 = 0.00
  1120.    mp.2.16 = 2255; mpX.2.16 = 'Atlanta';
  1121.      mrX.2.16 = 'I-20 in Georgia';       zm.2.16 = 0.00
  1122.    mp.2.17 = 2320; mpX.2.17 = 'Carolina border';
  1123.      mrX.2.17 = 'I-85 in Georgia';       zm.2.17 = 5.75
  1124.    mp.2.18 = 2565; mpX.2.18 = 'Greensboro';
  1125.      mrX.2.18 = 'I-85 in Carolina';      zm.2.18 = 3.80
  1126.    mp.2.19 = 2680; mpX.2.19 = 'Virginia border';
  1127.      mrX.2.19 = 'I-85 in North Carolina';zm.2.19 = 7.85
  1128.    mp.2.20 = 2775; mpX.2.20 = 'Richmond';
  1129.      mrX.2.20 = 'I-85 in Virginia';      zm.2.20 = 0.00
  1130.    mp.2.21 = 2880; mpX.2.21 = 'Washington D.C.';
  1131.      mrX.2.21 = 'I-95 in Virginia';      zm.2.21 = 0.00
  1132.    mp.2.22 = 2920; mpX.2.22 = 'Baltimore';
  1133.      mrX.2.22 = 'I-95 in Maryland';      zm.2.22 = 2.30
  1134.    mp.2.23 = 2990; mpX.2.23 = 'New Jersey border';
  1135.      mrX.2.23 = 'I-95 in Delaware';      zm.2.23 = 2.25
  1136.    mp.2.24 = 3110; mpX.2.24 = 'Holland Tunnel';
  1137.      mrX.2.24 = 'New Jersey Turnpike';   zm.2.24 = 2.40
  1138.    mp.2.25 = 9999; mpX.2.25 = 'New York';
  1139.      mrX.2.25 = 'city streets';          zm.2.25 = 8.00
  1140.    end
  1141. return 0
  1142.  
  1143.  
  1144.  
  1145. NearTruckStop:
  1146. /*
  1147. ------------------------------------------------------------------------
  1148. Come close to a truck stop
  1149. ------------------------------------------------------------------------
  1150. */
  1151. say 'Truck stop ahead.  Do you want to stop (Y or N)? '
  1152. shsleep_sw = 0  /* switch, 1 = has rested/slept */
  1153. do forever
  1154.    do forever
  1155.       ikeyX = GetStr()
  1156.       if length(ikeyX) = 1 & pos(ikeyX, 'NY') > 0 then
  1157.          leave
  1158.       end
  1159.    if ikeyX = 'N' then do
  1160.       hl = hl + 1
  1161.       leave
  1162.       end
  1163.    t = 85 + 35 * RND() % 1
  1164.    say 'Diesel fuel costs $'t/100' per gallon.'
  1165.    say '     How many gallons do you want?'
  1166.    do forever
  1167.       t1 = translate(strip(GetStr()))
  1168.       if t1 = 'FILL' |,
  1169.          t1 = 'FULL' |,
  1170.          space(t1, 0) = 'FILLUP' then
  1171.          t1 = (200 - wf) % 1
  1172.       if datatype(t1, 'N') then
  1173.          leave
  1174.       end
  1175.    if t1 > 0 then do
  1176.       say 'Pay $'t * t1 / 100
  1177.       xc = xc + t * t1 / 100
  1178.       wf = wf + t1
  1179.       end
  1180.    say 'So far, you have spent $'xc
  1181.    if wf > 200 then do
  1182.       say 'Your tank only holds 200 gallons ...'
  1183.       say FormatSim(wf - 200, 4) 'gallons spilled !!'
  1184.       wf = 200
  1185.       end
  1186.    if ts <= 0 then do
  1187.       t = 200 + 50 * RND() % 1
  1188.       t1 = 100 + 70 * RND() % 1
  1189.       say 'A new tire costs $'t'   A retread costs $'t1
  1190.       say '     Do you want to buy a tire (Y or N)?'
  1191.       do forever
  1192.          ikeyX = GetStr()
  1193.          if length(ikeyX) = 1 & pos(ikeyX, 'NY') > 0 then
  1194.             leave
  1195.          end
  1196.       if ikeyX = 'Y' then do
  1197.          say '     Which type do you want (N=new or R=retread)?'
  1198.          do forever
  1199.             zX = GetStr()
  1200.             if length(zX) = 1 & pos(zX, 'NR') > 0 then
  1201.                leave
  1202.             end
  1203.          say '     How many (0-3)?'
  1204.          do forever
  1205.             tno = GetStr()
  1206.             if length(tno) = 1 & pos(tno, '0123') > 0 then
  1207.                leave
  1208.             end
  1209.          if tno > 0 then do
  1210.             ts = tno - 1
  1211.             if zX = 'R' then do
  1212.                tc = tc - 0.5 * tno
  1213.                xc = xc + t1 * tno
  1214.                end
  1215.             else do
  1216.                tc = tc - tno
  1217.                xc = xc + t * tno
  1218.                end
  1219.             end
  1220.          end
  1221.       end
  1222.    if shsleep_sw then do
  1223.       say ' '
  1224.       leave
  1225.       end
  1226.    hr = hr + 1
  1227.    ns = 0
  1228.    say 'Do you want to get some sleep (Y or N)?'
  1229.    do forever
  1230.       ikeyX = GetStr()
  1231.       if length(ikeyX) = 1 & pos(ikeyX, 'NY') > 0 then
  1232.          leave
  1233.       end
  1234.    if ikeyX = 'N' then do
  1235.       say ' '
  1236.       call ReportTripDuration hr
  1237.       leave
  1238.       end
  1239.    say '     How many hours of rest?'
  1240.    t = GetNum()
  1241.    if t < 1 then
  1242.       leave
  1243.    shsleep_sw = 1
  1244.    dh = hr + 7 - 24 * ((hr + 7) % 24)
  1245.    hr = hr + t
  1246.    call Delay (50 * t)
  1247.    if ct = 1 then do
  1248.       wf = wf - 7 * t
  1249.       if wf < 0 then do
  1250.          wf = 0
  1251.          call CalcSpoilFactor
  1252.          end
  1253.       end
  1254.    if dh > 3 &,
  1255.       dh < 20 then do
  1256.       t = (t / 2 + 0.6) % 1
  1257.       say "Thanks to your neighbors' noise, you got only "t,
  1258.           "hours real sleep."
  1259.       call Delay 200
  1260.       end
  1261.    hs = hs + t
  1262.    if t > 3 then
  1263.       hl = 0
  1264.    else
  1265.       hl = hl / 2
  1266.    shf = 5000
  1267.    shd = 100
  1268.    do 3
  1269.       interpret rxbeep
  1270.       call Delay 50
  1271.       end
  1272.    shd = 350
  1273.    interpret rxbeep
  1274.    interpret rxcls
  1275.    call ReportTripDuration hr
  1276.    say 'Time to hit the road again.'
  1277.    say ' '
  1278.    call CheckPhysical
  1279.    say 'You now have 'wf % 1' gallons of fuel.'
  1280.    say 'Do you want to buy more (Y or N)?'
  1281.    end
  1282. return 0
  1283.  
  1284.  
  1285.  
  1286. ReportTripDuration: procedure expose dsX. dh
  1287. arg hr
  1288. /*
  1289. ------------------------------------------------------------------------
  1290. Report calculated trip duration in days and hours
  1291. ------------------------------------------------------------------------
  1292. */
  1293. dh = hr + 8
  1294. shdt = dh % 24
  1295. dh = dh - 24 * shdt
  1296. do while shdt > 6
  1297.    shdt = shdt - 7
  1298.    end
  1299. dmX = 'AM'
  1300. if dh = 12 then
  1301.    dmX = 'Noon'
  1302. else do
  1303.    if dh > 12 then do
  1304.       dh = dh - 12
  1305.       dmX = 'PM'
  1306.       end
  1307.    if dh = 0 then do
  1308.       dh = 12
  1309.       dmX = 'Midnight'
  1310.       end
  1311.    end
  1312. say ' '
  1313. say 'Day: 'dsX.shdt
  1314. say 'Time: 'FormatSim(dh, 2)' 'dmX
  1315. say ' '
  1316. return 0
  1317.  
  1318.  
  1319.  
  1320. RND: procedure
  1321. /*
  1322. ------------------------------------------------------------------------
  1323. Generate a random number between 0.0000 and 1.0000
  1324. ------------------------------------------------------------------------
  1325. */
  1326. return random(0, 10000) / 10000
  1327.  
  1328.  
  1329.  
  1330. ShowBanner: procedure
  1331. /*
  1332. ------------------------------------------------------------------------
  1333. Show the game banner
  1334. ------------------------------------------------------------------------
  1335. */
  1336. sh.1 =,
  1337. 'TTTTTTTTT RRRRRRR   UUU   UUU   CCCCCC  KKK   KKK EEEEEEEEE RRRRRRR'
  1338. sh.2 =,
  1339. '   TTT    RRR  RRR  UUU   UUU  CCC  CCC KKK  KKK  EEE       RRR  RRR'
  1340. sh.3 =,
  1341. '   TTT    RRR   RRR UUU   UUU CCC       KKK KKK   EEE       RRR   RRR'
  1342. sh.4 =,
  1343. '   TTT    RRR  RRR  UUU   UUU CCC       KKKKKK    EEE       RRR  RRR'
  1344. sh.5 =,
  1345. '   TTT    RRRRRRR   UUU   UUU CCC       KKKKK     EEEEE     RRRRRRR'
  1346. sh.6 =,
  1347. '   TTT    RRRRRR    UUU   UUU CCC       KKKKKK    EEE       RRRRRR'
  1348. sh.7 =,
  1349. '   TTT    RRR RRR   UUU   UUU CCC       KKK KKK   EEE       RRR RRR'
  1350. sh.8 =,
  1351. '   TTT    RRR  RRR  UUU   UUU  CCC  CCC KKK  KKK  EEE       RRR  RRR'
  1352. sh.9 =,
  1353. '   TTT    RRR   RRR  UUUUUUU    CCCCCC  KKK   KKK EEEEEEEEE RRR   RRR'
  1354. say ' '
  1355. do shi = 1 to 9
  1356.    say '     'sh.shi
  1357.    say '     'sh.shi
  1358.    end
  1359. say ' '
  1360. drop sh.
  1361. return 0
  1362.  
  1363.  
  1364.  
  1365. SQRT: procedure
  1366. arg x
  1367. /*
  1368. ------------------------------------------------------------------------
  1369. Return the SQUARE ROOT of the argument X calculated according to
  1370. Newton-Raphson algorithm
  1371. ------------------------------------------------------------------------
  1372. */
  1373. arg = abs(x)
  1374. root = arg / 2
  1375. if root > 0 then do digits()
  1376.    root = (root + arg / root) / 2
  1377.    if abs(root ** 2 - arg) / arg - 0.000001 <= 0 then
  1378.       leave
  1379.    end
  1380. return root
  1381.  
  1382.  
  1383.  
  1384. StopByEmptyTank:
  1385. /*
  1386. ------------------------------------------------------------------------
  1387. Stop the truck due to empty gasoline tank
  1388. ------------------------------------------------------------------------
  1389. */
  1390. t1 = t1 + wf
  1391. wf = 0
  1392. sp = 0
  1393. t = (4.5 - 0.2 * t) * t1
  1394. mf = mf + (t % 1)
  1395. say 'After' FormatSim(t, 4),
  1396.     'more miles, you ran out of fuel   (DUMMY !!)'
  1397. call WaitForGasDelivery
  1398. return 0
  1399.  
  1400.  
  1401.  
  1402. StopForPolice:
  1403. /*
  1404. ------------------------------------------------------------------------
  1405. Stop and face the police due to a trafic violation
  1406. ------------------------------------------------------------------------
  1407. */
  1408. say 'Smokey is behind you with his lights on.  Pull over!'
  1409. shd = 400
  1410. do 3
  1411.    shf = 3000
  1412.    interpret rxbeep
  1413.    shf = 2500
  1414.    interpret rxbeep
  1415.    end
  1416. nt = nt + 1
  1417. say 'See the justice of the peace for your 'ntX.nt' offense.'
  1418. say '     Wait 'nt' hours for your hearing...'
  1419. hl = hl + nt
  1420. hr = hr + nt
  1421. if nt <= 3 then do
  1422.    t = (nt * (RND() * 5)) % 1
  1423.    t1 = (5 * (rt + nt * (RND() * 4))) % 1
  1424.    say '     The fine is $'t1' plus $'t' for each MPH over the limit.'
  1425.    say '     Pay $'t1 + t * (sp - sl)
  1426.    xc = xc + t1 + t * (sp - sl)
  1427.    call Delay (nt * 500)
  1428.    return 0
  1429. end
  1430. say 'You are sentenced to 30 days in jail for reckless driving.'
  1431. call Delay 300
  1432. say "Your I.C.C. driver's license is revoked !"
  1433. call GiveUpTruck
  1434. return 0
  1435.  
  1436.  
  1437.  
  1438. TruckTheJourney:
  1439. /*
  1440. ------------------------------------------------------------------------
  1441. Go trucking coast to coast (main program loop)
  1442. ------------------------------------------------------------------------
  1443. */
  1444. do while mp.rt.np <= mf
  1445.    call CheckObstacles
  1446.    if sh_keep_on_trucking then
  1447.       nop
  1448.    else
  1449.       return 0
  1450.    end
  1451. say 'Cruising on 'mrX.rt.np
  1452. call CheckPhysical
  1453. say 'You are feeling 'cdX
  1454. call CheckWheater
  1455. say 'Current weather: 'crX
  1456. ns = ns + 1
  1457. if ns > 3 then
  1458.    call NearTruckStop
  1459. sp = 0
  1460. maxsp = (1.5 * sl) % 1
  1461. do while sp < 20 |,
  1462.          sp > maxsp
  1463.    say 'How fast do you wish to go (20-100)?'
  1464.    sp = GetNum()
  1465.    sp = (sp + 0.5) % 1       /* Round it up */
  1466.    if sp < 20 then
  1467.       say 'Your have to go at least 20 --'
  1468.    if sp > maxsp then
  1469.    say 'You can only get the old rig to go 'maxsp'MPH on this road.'
  1470.    end
  1471. af = sp ** 2 * cd * cr
  1472. if af > RND() * 10000000 then do
  1473.    do shf = 1000 to 10 by -50
  1474.       shd = shf % 10
  1475.       interpret rxbeep
  1476.       interpret rxcls
  1477.       say ' '
  1478.       say 'C R A S H !!'
  1479.       end
  1480.    say ' '
  1481.    if cd = 100 |,
  1482.       (cd = 25 & sp < 65) then
  1483.       say 'You fell asleep at the wheel.'
  1484.    else if cr = 50 then
  1485.       say 'You drove off the road into a snow filled ditch.'
  1486.    else if cr = 10 then
  1487.       say 'You rear-ended a pick-up with no tail lights.'
  1488.    else if sp > 65 then
  1489.       say '        Speed kills !'
  1490.    else if cd > 2 then do
  1491.       say 'You hit a slick spot... !@#$%^...'
  1492.       call Delay 500
  1493.       say '                    ... and !@#$%^... skidded off the road.'
  1494.       end
  1495.    else
  1496.       say 'A drunk driver rammed your rig. !@#$%^... Tough luck !'
  1497.    say ' '
  1498.    call Delay 350
  1499.    say 'You lose your truck & profits.'
  1500.    sh_keep_on_trucking = 0
  1501.    return 0
  1502.    end
  1503. tc = tc + 0.00005 * sp * wl / 40000
  1504. af = SQRT(mf + 100) * tc
  1505. if af > rh * 25000 * RND() then
  1506.    call ChangeFlatTire
  1507. if sp > sl - rh + 10 then do
  1508.    if (sp - sl + 2 * rh - 5) ** 2 >= 900 * RND() then do
  1509.       call StopForPolice
  1510.       if sh_keep_on_trucking then
  1511.          nop
  1512.       else
  1513.          return 0
  1514.       end
  1515.    end
  1516. hl = hl + 1
  1517. hr = hr + 1
  1518. if sl < 40 then
  1519.    sl = 55
  1520. t = abs(55 - sp)
  1521. if t > 12 then
  1522.    t = 12.5
  1523. t1 = sp / (4.5 - 0.2 * t)
  1524. wf = wf - t1
  1525. if wf < 0 then
  1526.    call StopByEmptyTank
  1527. mf = mf + sp
  1528. if mf >= mt.rt then
  1529.    call EndOfTrip
  1530. if sh_keep_on_trucking then do
  1531.    call Delay 25
  1532.    interpret rxcls
  1533.    call ReportTripDuration hr
  1534.    say 'Approximate fuel:' ((wf - 4 + RND() * 10) % 1)
  1535.    say 'Speed: 'sp
  1536.    say 'Odometer: 'mf
  1537.    say 'Miles to go: 'mt.rt - mf
  1538.    say ' '
  1539.    end
  1540. return 0
  1541.  
  1542.  
  1543.  
  1544. WaitForGasDelivery:
  1545. /*
  1546. ------------------------------------------------------------------------
  1547. Wait for gas to be delivered
  1548. ------------------------------------------------------------------------
  1549. */
  1550. say '     It cost $200 to get a barrel of diesel delivered.'
  1551. wf = 55
  1552. t1 = 1 + (RND() * 5) % 1
  1553. xc = xc + 200
  1554. hl = hl + t1
  1555. hr = hr + t1
  1556. say '          You also wasted 't1' hours by your carelessness.'
  1557. call CalcSpoilFactor
  1558. return 0
  1559.  
  1560.  
  1561.  
  1562. /*
  1563. ========================================================================
  1564. NOTES:
  1565. ========================================================================
  1566. ------------------------------------------------------------------------
  1567. Descriptions of important variables in 'TRUCKER'
  1568. ------------------------------------------------------------------------
  1569. af    = all (reusable) failure code
  1570. cd    = code of condition/mood of the trucker (1:good, ..., 100:worst)
  1571. cdX   = condition/mood of the trucker
  1572. cr    = condition of the weather code (1:good, ..., 50:worst)
  1573. crX   = condition of the weather
  1574. ct    = cargo type (1, 2 or 3)
  1575. cx    = condition of the load (okay if smaller than 1)
  1576. dh    = day hour (time in day)
  1577. dsX   = day script (day in word)
  1578. hl    = hours labored (hours continuously worked)
  1579. hr    = hours ridden (total elapse time away from LA)
  1580. hs    = hours slept (total)
  1581. hsw1  = help switch
  1582. ikeyX = input character string
  1583. intzh = integer(zh)
  1584. maxsp = maximum speed the truck can handle
  1585. mf    = miles covered
  1586. mp    = milestone place number (where the truck is)
  1587. mpX   = milestone place name (city/town at mp)
  1588. mrX   = milestone road name (highway/street name at mp)
  1589. mt    = mile total between LA and NY for the chosen route
  1590. np    = number of place (milestone number)
  1591. ns    = number of stations passed after last stop
  1592. nt    = number of traffic violations
  1593. ntX   = number of traffic violations in word
  1594. rh    = road quality (1 = better, 4 = worst)
  1595. rt    = route (1 = North, 0 = Middle, 2 = South)
  1596. rx..  = variables with REXX system specific commands to be interpreted
  1597. sh..  = Simon Husin's work, temporary and reusable variables
  1598. sl    = speed limit imposed
  1599. sp    = speed
  1600. t..   = temporary and reusable variables
  1601. tc    = tire condition (0 = best, 10 = okay, etc.)
  1602. tno   = number of tires purchased
  1603. ts    = tire spared
  1604. wf    = work fuel (estimate volume of fuel available in tank)
  1605. wl    = work load (total pounds of load)
  1606. xc    = trip expenses
  1607. xt    = trip final financial result
  1608. zh    = same as zm
  1609. zm    = standard hindrance factor at milestone mp
  1610. zx    = tire type (N=new or R=retread)
  1611.  
  1612.  
  1613.  
  1614. ------------------------------------------------------------------------
  1615. Compatibility Issues:
  1616. ------------------------------------------------------------------------
  1617. 1. This program is using IF THEN NOP ELSE ...  and  (x < y | x > y)
  1618.    constructions rather than \ or \= to make it run under ARexx which is
  1619.    using tilde (~) as the NOT sign.
  1620.  
  1621.    Solutions applied to complement ARexx shortcomings:
  1622.    - FORMATSIM(...) instead of FORMAT(...)
  1623.    - LENGTH(...) = 1 & POS(...) instead of WORDPOS(...)
  1624.    - A 80-character title has been replaced with two short title lines
  1625.      to avoid the line to wrap around on the output window
  1626.  
  1627.    Solutions applied to complement REXX/Windows shortcomings:
  1628.    - Parse Source has been moved to the main program to avoid problems
  1629.      with REXX/Windows running with the Intel 386(-compatible) processor
  1630.  
  1631.    Solutions applied to complement ARexx and uni-REXX shortcomings:
  1632.    - Exponential notation (e.g. 1E4, 1E-6, etc.) has been replaced with
  1633.      conventional notation (e.g. 10000, 0.000001, etc.)
  1634.  
  1635. 2. IBM Mainframe and AS/400 users:
  1636.    This program will run without any changes in your environment.  You
  1637.    might want to check first whether the character '|' gets converted
  1638.    correctly (to a whole vertical bar) or to a broken vertical bar.  In
  1639.    the latter case, replace all broken bars with whole ones, then... hit
  1640.    the road!
  1641.  
  1642.    The first release of the program was successfully compiled with
  1643.    IBM Compiler REXX/370 (release 2.0) on June 25th, 1993.
  1644.    The compiler reported zero errors and zero warnings.
  1645.  
  1646.    Just in case you don't know:
  1647.    The MVS/TSO or VM/CMS implementation of REXX supports the millionth
  1648.    of a second (1E-6) in the E and L options of the TIME function.
  1649.  
  1650. 3. PC users:
  1651.    a) Personal REXX:
  1652.    This program has been tested with Quercus Systems Personal REXX under
  1653.    DOS, Windows and OS/2 (16-bit and 32-bit) without any problems.
  1654.  
  1655.    In DOS environment:
  1656.    -  first create the object code with /O/NM option
  1657.    -  due to the QUEUE instruction, needed to accomodate REXX/Windows'
  1658.       shortcomings, you must first run RXINTMGR and STACKMGR before
  1659.       executing this program
  1660.  
  1661.    DELAY(n) and REXXLIB functions COS(n) and SQRT(n) are not used to
  1662.    simplify this program's portability.
  1663.  
  1664.    b) Portable/REXX:
  1665.    Built-in functions COS(n), DELAY(n) and SQRT(n) are not used to
  1666.    simplify this program's portability.
  1667.  
  1668.    Although the components, tested separately do work, this entire
  1669.    program has been tested with Portable/REXX Versions 1.10 and 1.30
  1670.    without any success (system resources exhausted).
  1671.  
  1672.    c) REXX/Windows:
  1673.    This program will run without any changes in REXX/Windows.
  1674.  
  1675.    The shortcomings in the interpreter mentioned in point number 1 were
  1676.    detected only on 386-based computers caused by the PARSE SOURCE on
  1677.    line 401 which resides within a function.  The interpreter has
  1678.    since been fixed.
  1679.  
  1680.    d) Tritus SPF
  1681.    Tritus allows only 32000-byte or smaller REXX programs to be run via
  1682.    its REXX primary command.
  1683.  
  1684.    For the experiments below, I removed all comment lines and also lines
  1685.    1039 through 1140 (route Middle and South array data).
  1686.  
  1687.    Under DOS (TSPFP):
  1688.    The program has been tested with TSPF 1.2.5. without any problems.
  1689.  
  1690.    Under OS/2 (TSPFP): (in this case, it is using installed OS/2 REXX)
  1691.    The program has been tested with TSPF 1.2.5. without any problems.
  1692.  
  1693.    e) OS/2 Procedures Language/2 REXX:
  1694.    Built-in function SysSleep(n), and functions SQRT(n) and COS(n)
  1695.    supported by RXMATHFN library are not used to simplify this program's
  1696.    portability.
  1697.  
  1698.    OS/2 2.x REXX Utility 'SYSCLS' is not used despite the fact that it
  1699.    is a bit faster and 'cleaner' than the OS/2 command clear screen
  1700.    (CLS) because the latter maintains the screen colors better than the
  1701.    first.
  1702.  
  1703.    Although PULL is supported by OS/2, earlier versions (before 2.0)
  1704.    have one difference with the same command in other interpreters,
  1705.    i.e. it shows a blank line with '?' followed by the actual prompt
  1706.    on the next line.
  1707.  
  1708. 4. Unix/AIX users:
  1709.    This program will run without any changes in uni-REXX.
  1710.  
  1711.    The shortcomings in the interpreter mentioned in point number 1 were
  1712.    detected by The Workstation Group.  The interpreter has since been
  1713.    fixed.
  1714.  
  1715. 5. The use of interpret command slows down the execution of the
  1716.    program, yet it is used to ensure and ease compatibility accross
  1717.    platforms.
  1718.  
  1719. 6. TRUCKxxx functions have been created for those (xxx) interpreters
  1720.    which support cursor positioning on the screen.  This approach was
  1721.    chosen, instead of the INTERPRET instruction executing the cursor
  1722.    positioning function, to achieve the maximum speed of the 'animation'
  1723.    of the 'truck' on the screen.
  1724.  
  1725.    The same can be created for the mainframe computers equipped with a
  1726.    Dialog Manager (ISPF/VM), by creating a panel member.
  1727.  
  1728. 7. LINEIN(CON) is a function that is supported only by OS/2, Personal
  1729.    REXX and Portable/REXX interpreters.
  1730.    It is comparable with the PARSE PULL command in that the entered
  1731.    alphabetical characters are NOT translated into uppercase.
  1732. ------------------------------------------------------------------------
  1733.  
  1734.  
  1735.  
  1736. ------------------------------------------------------------------------
  1737. Thanks
  1738. ------------------------------------------------------------------------
  1739. I would like to thank the following people for helping me in creating
  1740. and enhancing this program:
  1741.  
  1742. -  Mr. Cooper, Kerry      (Nybbles & Bytes, Tacoma, WA - Amiga Dealer)
  1743. -  Mr. Daney, Charles     (Quercus Systems)
  1744. -  Mr. Clark, Jeff        (Eddie Bauer, WA - AS/400 Expert)
  1745. -  Mr. Glantzberg, Hughes (Himself)
  1746. -  Mr. Kenney, Barry      (Blue Cross of Washington and Alaska)
  1747. -  Mr. Slayton, Bill      (Blue Cross of Washington and Alaska)
  1748. -  Mr. Spire, Ed          (The Workstation Group)
  1749. -  Ms. Taylor, Pam        (The Workstation Group)
  1750. -  Mr. VanDewater, BJ     (IBM, Vienna, Austria - REXX/370 Compiler)
  1751. -  Mr. Watts, Keith       (Kilowatt Software)
  1752. ------------------------------------------------------------------------
  1753.  
  1754.  
  1755.  
  1756. ------------------------------------------------------------------------
  1757. Comments
  1758. ------------------------------------------------------------------------
  1759. For comments, tech-exchange, and/or more information, please send your
  1760. letter to:
  1761.  
  1762.                        GLOBAL AUTOMATION COMPANY
  1763.                        23901  114TH  PLACE  S.E.
  1764.                           KENT,  WA 98031-3417
  1765.                                  U.S.A.
  1766.  
  1767. or fax it to:
  1768.                              1-206-813-8202
  1769.  
  1770. ========================================================================
  1771. */
  1772.