home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 2 / FFMCD02.bin / new / amigalibdisks / disk950 / bbdoors / bbdoors65.lha / rexxDoors / Ship_Hunt.rexx < prev    next >
OS/2 REXX Batch file  |  1993-08-07  |  19KB  |  692 lines
  1. /* Ship_Hunt.rexx version 2.3 by Matt English 1-10-93
  2.    This is an ONLINE game designed for the BBBBS system.
  3.    This game is freely distributable as long as no one makes
  4.    any money from it and the credits remain on the title screen.
  5.    To run on BBBBS, just copy the program "Ship_Hunt.rexx"
  6.    to your RexxDoors directory.
  7.     For bug reports or comments call Matt English (sysop)
  8.                                      Alternative BBS
  9.                                      503-761-3043
  10. */
  11.  
  12. options results
  13. FF='0C'x  /* FormFeed */
  14. CR='0D'x  /* Carraige Return */
  15. CALL TIME('R')
  16. SIGNAL ON BREAK_C
  17. SIGNAL ON BREAK_E
  18.  
  19. bbspath=GETCLIP('BBS_path')
  20. bbspath=bbspath'rexxDoors/Data/'
  21. datapath = bbspath'Ship'
  22.  
  23. PARSE arg Username winnings . colorflag secs .
  24. IF secs='' THEN secs=3600
  25. signal on syntax
  26.  
  27. name = Username
  28. letters = 'abcdefghijq'
  29.  
  30. def=''
  31. pen0=''
  32. pen2=''
  33. pen3=''
  34. pen4=''
  35. pen5=''
  36. pen6=''
  37. pen7=''
  38. bak2=''
  39. bak3=''
  40. bak4=''
  41. bak5=''
  42. bak6=''
  43. bak7=''
  44. CLS = 'H'
  45. UNL = ''
  46.  
  47. IF colorflag=1 THEN
  48.   DO
  49.     def=''
  50.     pen0=''
  51.     pen2=''
  52.     pen3=''
  53.     pen4=''
  54.     pen5=''
  55.     pen6=''
  56.     pen7=''
  57.     bak2=''
  58.     bak3=''
  59.     bak4=''
  60.     bak5=''
  61.     bak6=''
  62.     bak7=''
  63.     CLS = 'H'
  64.     UNL = ''
  65.   END
  66.  
  67. PPrompt = '2H'
  68. pmess = '12H'
  69. pmess2 = '12H'
  70. pturn = '64H'
  71. down.1 = '7H'
  72. down.2 = '7H'
  73. down.3 = '57H'
  74. down.4 = '57H'
  75.  
  76. stline = 5
  77. do aa = c2d('A') to c2d('J')
  78.  al = d2c(aa)
  79.  stpos = 28
  80.  stline = stline + 1
  81.  do bb = 1 to 10
  82.   stpos = stpos + 2
  83.   p.al.bb = ''stline';'stpos'H'
  84.   end
  85.  end
  86.  
  87. /* Open the support library if it is not already open. */
  88. if ~show('L',"rexxsupport.library") then do
  89.     addlib('rexxsupport.library',0,-30,0)
  90.      end
  91.  
  92. wz = random(1,999,time('S')) /* initalize random number generator */
  93.  
  94. if ~exists(datapath) then makedir(datapath)
  95. if ~exists(datapath'/winners') then do
  96.  call open(win,datapath'/winners','w')
  97.  top = 90
  98.  do 10
  99.   call writeln(win,''date()'... MATT_ENGLISH..... sank all the ships in 'top' shots!')
  100.   top = top + 1
  101.   end
  102.  call close(win)
  103.  end
  104.  
  105. say cr
  106. say cr
  107. say cr
  108. say'                          'bak7''pen0' Welcome to Ship Hunt ! 'def''cr
  109. say'                          'bak7''pen0'  version 2.3 1-10-93   'def''cr
  110. say'                          'bak7''pen0'    by Matt English     'def''cr
  111. say cr
  112. say cr
  113. call delay(100)
  114. call showwin
  115. say cr
  116. options prompt' Type "I" for instructions or hit return to play > '
  117. pull input
  118. if input ~= 'I' then call start
  119. else call instructions
  120. call start
  121.  
  122. showwin:
  123.  call open(win,datapath'/winners','r')
  124.  say'                   'bak5''pen0'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%'def''cr
  125.  say'                   'bak5''pen0'%       Top Ship Hunt Winners!       %'def''cr
  126.  say'                   'bak5''pen0'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%'def''cr
  127.  say cr
  128.  say cr
  129.  do 10
  130.   line = readln(win)
  131.   call sac70''line''
  132.   end
  133.  call close(win)
  134.  say cr
  135.  call delay(200)
  136. return
  137.  
  138. instructions:
  139.  say cr
  140.  say' This is a very simple game. The object is to sink the 5 ships'cr
  141.  say' that the computer has hidden on a 10 x 10 grid. If you can sink'cr
  142.  say' all the ships using less shots than a player on the WINNERS list,'cr
  143.  say' your name will be added to the winners list and you''ll be famous!'cr
  144.  say cr
  145.  say' The computer will generate a new grid for each game played, so you''ll'cr
  146.  say' never play the same game twice and no other player plays the same grid'cr
  147.  say' that you''re playing. The ships are:'cr
  148.  say'                                      Carrier...... 5 spots'cr
  149.  say'                                      Battleship... 4 spots'cr
  150.  say'                                      Destroyer.... 3 spots'cr
  151.  say'                                      Submarine.... 3 spots'cr
  152.  say'                                      PT Boat...... 2 spots'cr
  153.  say cr
  154.  say' If you decide to quit in the middle of a game, your stats will be'cr
  155.  say' saved and you can pick up where you left off next time.'cr
  156.  say cr
  157.  call sac70'HAVE FUN!'
  158.  say cr
  159.  call pressreturn
  160.  return
  161.  
  162. START:
  163. shipsdown = ''
  164. if ~exists(datapath'/'name) then do
  165.  say'Stand by, setting up the game..'
  166.  call setupdata
  167.  end
  168. if justsetup ~= 1 then do
  169.  say cr
  170.  options prompt' Would you like to continue your previous game? (Y,n) > '
  171.  pull answer
  172.  if answer = 'N' then do
  173.   say' OK,Setting up a new game..'cr
  174.   call setupdata
  175.   end
  176.  else do
  177.   say cr
  178.   say' OK, Loading your previous game...'cr
  179.   say cr
  180.   end
  181.  end
  182. call loaddata
  183. say cr
  184. if justsetup ~= 1 then say' You last played this game on 'pen7''lastplay''def''cr
  185. call delay(100)
  186. say cr
  187. say cr
  188. say cr
  189. call play
  190.  
  191. Play:
  192.  say cls
  193.  say'               'pen5'                   'bak2'Ship Hunt'def''cr
  194.  say cr
  195.  say'                             1 2 3 4 5 6 7 8 9 10'cr
  196.  say'  ' cr
  197.  say'  'bak6''UNL'Ship       Size'def'        A   's.a.1' 's.a.2' 's.a.3' 's.a.4' 's.a.5' 's.a.6' 's.a.7' 's.a.8' 's.a.9' 's.a.10'        'bak4''UNL'Ships Sunk'def''cr
  198.  say'  'bak6'               'def'        B   's.B.1' 's.B.2' 's.B.3' 's.B.4' 's.b.5' 's.b.6' 's.b.7' 's.b.8' 's.b.9' 's.b.10''cr
  199.  say'  'bak6'Carrier      5 'def'        C   's.c.1' 's.c.2' 's.c.3' 's.c.4' 's.c.5' 's.c.6' 's.c.7' 's.c.8' 's.c.9' 's.c.10''cr
  200.  say'  'bak6'Battleship   4 'def'        D   's.d.1' 's.d.2' 's.d.3' 's.d.4' 's.d.5' 's.d.6' 's.d.7' 's.d.8' 's.d.9' 's.d.10''cr
  201.  say'  'bak6'Destroyer    3 'def'        E   's.e.1' 's.e.2' 's.e.3' 's.e.4' 's.e.5' 's.e.6' 's.e.7' 's.e.8' 's.e.9' 's.e.10''cr
  202.  say'  'bak6'Submarine    3 'def'        F   's.f.1' 's.f.2' 's.f.3' 's.f.4' 's.f.5' 's.f.6' 's.f.7' 's.f.8' 's.f.9' 's.f.10''cr
  203.  say'  'bak6'PT Boat      2 'def'        G   's.g.1' 's.g.2' 's.g.3' 's.g.4' 's.g.5' 's.g.6' 's.g.7' 's.g.8' 's.g.9' 's.g.10''cr
  204.  say'                         H   's.h.1' 's.h.2' 's.h.3' 's.h.4' 's.h.5' 's.h.6' 's.h.7' 's.h.8' 's.h.9' 's.h.10''cr
  205.  say'                         I   's.i.1' 's.i.2' 's.i.3' 's.i.4' 's.i.5' 's.i.6' 's.i.7' 's.i.8' 's.i.9' 's.i.10'        'pen3'"Q" = Quit'def''cr
  206.  say'                         J   's.j.1' 's.j.2' 's.j.3' 's.j.4' 's.j.5' 's.j.6' 's.j.7' 's.j.8' 's.j.9' 's.j.10'        Turn #  'cr
  207.  say cr
  208.  say cr
  209.  call clrl2
  210.  call pullshotl
  211.  
  212. clrl:
  213.  arg where
  214.  call writech('STDOUT',''where'                                                              ')
  215.  return
  216.  
  217. clrl2:
  218.  call writech('STDOUT',''pmess''bak3'                                                  'def'')
  219.  call writech('STDOUT',''pmess2''bak3'                                                  'def'')
  220.  return
  221.  
  222. pullshotl:
  223.  if shipsdown ~= '' then do sd = 1 to words(shipsdown)
  224.   say''down.sd''word(shipsdown,sd)''
  225.   end
  226.  turns = turns + 1
  227.  say''pturn''turns''
  228.  options prompt''PPrompt'Enter your shot, Captain 'name' > '
  229.  pull theshot
  230.  CALL checkBBS()
  231.  call clrl pprompt
  232.  call clrl2
  233.  theshot = strip(theshot)
  234.  if theshot = 'Q' then call quit
  235.  shotl = substr(theshot,1,1)
  236.  shotn = strip(substr(theshot,2,2))
  237.  if length(theshot) > 3 | if theshot = '' |  ~(instring(shotl,letters)) | ~datatype(shotn,'W') | shotn > 10 | shotn < 1 then do
  238.   say''pmess'  'bak3' Please enter your shot in letter/number format'def''cr
  239.   say''pmess2'  'bak3'              Examples: A3 B10 C4              'def''cr
  240.   turns = turns - 1
  241.   call pullshotl
  242.   end
  243.  call checkshot
  244.  
  245. Quit:
  246.  turns = turns - 1
  247.  say cr
  248.  say''pmess''bak3'     OK, Saving your stats for next time....'def''cr
  249.  call delay(50)
  250.  if exists(datapath'/'name) then call delete(datapath'/'name)
  251.  call open(stat,datapath'/'name,'w')
  252.  call writeln(stat,pos.c)
  253.  call writeln(stat,pos.b)
  254.  call writeln(stat,pos.d)
  255.  call writeln(stat,pos.s)
  256.  call writeln(stat,pos.p)
  257.  call writeln(stat,damage.c)
  258.  call writeln(stat,damage.b)
  259.  call writeln(stat,damage.d)
  260.  call writeln(stat,damage.s)
  261.  call writeln(stat,damage.p)
  262.  call writeln(stat,shipssunk)
  263.  call writeln(stat,hits)
  264.  call writeln(stat,misses)
  265.  call writeln(stat,lastplay)
  266.  call writeln(stat,turns)
  267.  call close(stat)
  268.  say cr
  269.  call showwin
  270.  say cr
  271.  say' 'pen2'Returning to the BBS...'def''
  272.  say cr
  273.  call delay(25)
  274.  exit
  275.  
  276.  
  277. checkBBS:
  278. IF ADDRESS()~='BAUD' THEN RETURN 0
  279. IF TIME('E')>secs THEN SIGNAL Quit
  280. dcd
  281. IF RC=0 THEN SIGNAL Quit
  282. temp=secs-TIME('E')
  283. IF temp<120 THEN SAY '*** Only' temp 'seconds left! ***'CR 
  284. RETURN 0
  285.  
  286.  
  287. showshot:
  288.    gg = 0