/* Ship_Hunt.rexx version 2.3 by Matt English 1-10-93 This is an ONLINE game designed for the BBBBS system. This game is freely distributable as long as no one makes any money from it and the credits remain on the title screen. To run on BBBBS, just copy the program "Ship_Hunt.rexx" to your RexxDoors directory. For bug reports or comments call Matt English (sysop) Alternative BBS 503-761-3043 */ options results FF='0C'x /* FormFeed */ CR='0D'x /* Carraige Return */ CALL TIME('R') SIGNAL ON BREAK_C SIGNAL ON BREAK_E bbspath=GETCLIP('BBS_path') bbspath=bbspath'rexxDoors/Data/' datapath = bbspath'Ship' PARSE arg Username winnings . colorflag secs . IF secs='' THEN secs=3600 signal on syntax BBSIDENTIFY EMULATION PARSE VAR RESULT type . if type = "ANSI" then colorflag=1 else colorflag=0 BBSIDENTIFY USER PARSE VAR RESULT Username From Acces . Name = substr(Username,2,length(Username)-2) letters = 'abcdefghijq' def='' pen0='' pen2='' pen3='' pen4='' pen5='' pen6='' pen7='' bak2='' bak3='' bak4='' bak5='' bak6='' bak7='' CLS = '' UNL = '' IF colorflag=1 THEN DO def='' pen0='' pen2='' pen3='' pen4='' pen5='' pen6='' pen7='' bak2='' bak3='' bak4='' bak5='' bak6='' bak7='' CLS = '' UNL = '' END PPrompt = '' pmess = '' pmess2 = '' pturn = '' down.1 = '' down.2 = '' down.3 = '' down.4 = '' stline = 5 do aa = c2d('A') to c2d('J') al = d2c(aa) stpos = 28 stline = stline + 1 do bb = 1 to 10 stpos = stpos + 2 p.al.bb = '['stline';'stpos'H' end end /* Open the support library if it is not already open. */ if ~show('L',"rexxsupport.library") then do addlib('rexxsupport.library',0,-30,0) end wz = random(1,999,time('S')) /* initalize random number generator */ if ~exists(datapath) then makedir(datapath) if ~exists(datapath'/winners') then do call open(win,datapath'/winners','w') top = 90 do 10 call writeln(win,''date()'... MATT_ENGLISH..... sank all the ships in 'top' shots!') top = top + 1 end call close(win) end say cr say cr say cr say' 'bak7''pen0' Welcome to Ship Hunt ! 'def''cr say' 'bak7''pen0' version 2.3 1-10-93 'def''cr say' 'bak7''pen0' by Matt English 'def''cr say cr say cr call delay(100) call showwin say cr ' Type "I" for instructions or hit return to play > ' input=readstr() if input ~= 'I' then call start else call instructions call start showwin: call open(win,datapath'/winners','r') say' 'bak5''pen0'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%'def''cr say' 'bak5''pen0'% Top Ship Hunt Winners! %'def''cr say' 'bak5''pen0'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%'def''cr say cr say cr do 10 line = readln(win) call sac70''line'' end call close(win) say cr call delay(200) return instructions: say cr say' This is a very simple game. The object is to sink the 5 ships'cr say' that the computer has hidden on a 10 x 10 grid. If you can sink'cr say' all the ships using less shots than a player on the WINNERS list,'cr say' your name will be added to the winners list and you''ll be famous!'cr say cr say' The computer will generate a new grid for each game played, so you''ll'cr say' never play the same game twice and no other player plays the same grid'cr say' that you''re playing. The ships are:'cr say' Carrier...... 5 spots'cr say' Battleship... 4 spots'cr say' Destroyer.... 3 spots'cr say' Submarine.... 3 spots'cr say' PT Boat...... 2 spots'cr say cr say' If you decide to quit in the middle of a game, your stats will be'cr say' saved and you can pick up where you left off next time.'cr say cr call sac70'HAVE FUN!' say cr call pressreturn return START: shipsdown = '' if ~exists(datapath'/'name) then do say'Stand by, setting up the game..' call setupdata end if justsetup ~= 1 then do say cr prompt(' Would you like to continue your previous game? (Y,n) > ') answer=readstr() if answer = 'N' then do say' OK,Setting up a new game..'cr call setupdata end else do say cr say' OK, Loading your previous game...'cr say cr end end call loaddata say cr if justsetup ~= 1 then say' You last played this game on 'pen7''lastplay''def''cr call delay(100) say cr say cr say cr call play Play: say cls say' 'pen5' 'bak2'Ship Hunt'def''cr say cr say' 1 2 3 4 5 6 7 8 9 10'cr say' ' cr 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 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 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 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 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 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 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 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 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 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 say cr say cr call clrl2 call pullshotl clrl: arg where call writech('STDOUT',''where' ') return clrl2: call writech('STDOUT',''pmess''bak3' 'def'') call writech('STDOUT',''pmess2''bak3' 'def'') return pullshotl: if shipsdown ~= '' then do sd = 1 to words(shipsdown) say''down.sd''word(shipsdown,sd)'' end turns = turns + 1 say''pturn''turns'' prompt(''PPrompt'Enter your shot, Captain 'name' > ') theshot=readstr() CALL checkBBS() call clrl pprompt call clrl2 theshot = strip(theshot) if theshot = 'Q' then call quit shotl = substr(theshot,1,1) shotn = strip(substr(theshot,2,2)) if length(theshot) > 3 | if theshot = '' | ~(instring(shotl,letters)) | ~datatype(shotn,'W') | shotn > 10 | shotn < 1 then do say''pmess' 'bak3' Please enter your shot in letter/number format'def''cr say''pmess2' 'bak3' Examples: A3 B10 C4 'def''cr turns = turns - 1 call pullshotl end call checkshot Quit: turns = turns - 1 say cr say''pmess''bak3' OK, Saving your stats for next time....'def''cr call delay(50) if exists(datapath'/'name) then call delete(datapath'/'name) call open(stat,datapath'/'name,'w') call writeln(stat,pos.c) call writeln(stat,pos.b) call writeln(stat,pos.d) call writeln(stat,pos.s) call writeln(stat,pos.p) call writeln(stat,damage.c) call writeln(stat,damage.b) call writeln(stat,damage.d) call writeln(stat,damage.s) call writeln(stat,damage.p) call writeln(stat,shipssunk) call writeln(stat,hits) call writeln(stat,misses) call writeln(stat,lastplay) call writeln(stat,turns) call close(stat) say cr call showwin say cr say' 'pen2'Returning to the BBS...'def'' say cr call delay(25) exit checkBBS: IF ADDRESS()~='BAUD' THEN RETURN 0 IF TIME('E')>secs THEN SIGNAL Quit dcd IF RC=0 THEN SIGNAL Quit temp=secs-TIME('E') IF temp<120 THEN SAY '*** Only' temp 'seconds left! ***'CR RETURN 0 showshot: gg = 0 do 10 gg = gg + 1 if gg = 10 then gg = 0 say''p.shotl.shotn''pen4''gg''def''cr say''p.shotl.shotn''pen5'&'def''cr say''p.shotl.shotn''pen6'#'def''cr end say''p.shotl.shotn'-'cr return checkshot: shot = shotl||shotn /* Check to see if this is a repeat shot */ do w = 1 to words(hits) if word(hits,w) = shot then do say''pmess''bak3' That spot has already been shot!'def'' call delay(50) turns = turns - 1 call pullshotl end end do y = 1 to words(misses) if word(misses,y) = shot then do say''pmess''bak3' That spot has already been shot!'def'' call delay(50) turns = turns - 1 call pullshotl end end /* Check to see if it's a hit */ do w = 1 to words(pos.c) if word(pos.c,w) = shot then do s.shotl.shotn = ''pen3'X'def'' hits = ''hits'' ''shot'' damage.c = damage.c + 1 call showshot call delay(25) say''p.shotl.shotn''s.shotl.shotn''cr say''pmess''bak3' It''s a HIT! Good shot captain!'def'' if damage.c = 5 then do call delay(100) say''pmess2''bak3' You just sank the Carrier!!!'def'' call delay(100) shipsdown = shipsdown' Carrier' shipssunk = shipssunk + 1 say cr if shipssunk = 5 then call GameOver end call pullshotl end end do w = 1 to words(pos.b) if word(pos.b,w) = shot then do s.shotl.shotn = ''pen3'X'def'' hits = ''hits'' ''shot'' damage.b = damage.b + 1 call showshot call delay(25) say''p.shotl.shotn''s.shotl.shotn''cr say''pmess''bak3' It''s a HIT! Good shot captain!'def'' if damage.b = 4 then do call delay(100) say''pmess2''bak3' You just sank the Battleship!!!'def'' call delay(100) shipsdown =shipsdown' Battleship' shipssunk = shipssunk + 1 say cr if shipssunk = 5 then call GameOver end call pullshotl end end do w = 1 to words(pos.d) if word(pos.d,w) = shot then do s.shotl.shotn = ''pen3'X'def'' hits = ''hits'' ''shot'' damage.d = damage.d + 1 call showshot call delay(25) say''p.shotl.shotn''s.shotl.shotn''cr say''pmess''bak3' It''s a HIT! Good shot captain!'def'' if damage.d = 3 then do call delay(100) say''pmess2''bak3' You just sank the Destroyer!!!'def'' call delay(100) shipsdown = shipsdown' Destroyer' shipssunk = shipssunk + 1 say cr if shipssunk = 5 then call GameOver end call pullshotl end end do w = 1 to words(pos.s) if word(pos.s,w) = shot then do s.shotl.shotn = ''pen3'X'def'' hits = ''hits'' ''shot'' damage.s = damage.s + 1 call showshot call delay(25) say''p.shotl.shotn''s.shotl.shotn''cr say''pmess''bak3' It''s a HIT! Good shot captain!'def'' if damage.s = 3 then do call delay(100) say''pmess2''bak3' You just sank the Submarine!!!'def'' call delay(100) shipsdown = shipsdown' Submarine' shipssunk = shipssunk + 1 say cr if shipssunk = 5 then call GameOver end call pullshotl end end do w = 1 to words(pos.p) if word(pos.p,w) = shot then do s.shotl.shotn = ''pen3'X'def'' hits = ''hits'' ''shot'' damage.p = damage.p + 1 call showshot call delay(25) say''p.shotl.shotn''s.shotl.shotn''cr say''pmess''bak3' It''s a HIT! Good shot captain!'def'' if damage.p = 2 then do call delay(100) say''pmess2''bak3' You just sank the PT Boat!!!'def'' call delay(100) shipsdown = shipsdown' PT_Boat' shipssunk = shipssunk + 1 say cr if shipssunk = 5 then call GameOver end call pullshotl end end s.shotl.shotn = ''pen2'*'def'' misses = ''misses'' ''shot'' call showshot call delay(25) say''p.shotl.shotn''s.shotl.shotn''cr say''pmess''bak3' That shot was a MISS!!'def'' say cr call delay(30) call pullshotl Gameover: call sac70'You sank all the ships in 'turns' shots!' call delay(50) call sac70'Checking your score against the winners list, hold on...' say cr call checklist if madelist = 1 then call sac70'Congratulations, you made the winners list!' else call sac70'You didn''t quite make the winners list that time...' say cr call delete(datapath'/'name) prompt(' Would you like to play again? (Y,n) > ') again=readstr() if again ~= "N" then call start else do say cr call sac70'OK, thanks for playing.... Try again next time..' say cr call delay(25) call showwin say cr say' 'pen2'Returning to the BBS...'def''cr call delay(25) exit checklist: madelist = 0 call open(win,datapath'/winners','r') winline = ''date()'... 'left(name,17,".")' sank all the ships in 'left(turns,2)' shots!' do wl = 1 to 10 line.wl = readln(win) end call close(win) if turns <= word(line.10,10) then do templine.10 = winline madelist = 1 if turns <= word(line.9,10) then do templine.9 = winline templine.10 = line.9 end else templine.9 = line.9 if turns <= word(line.8,10) then do templine.8 = winline templine.9 = line.8 end else templine.8 = line.8 if turns <= word(line.7,10) then do templine.7 = winline templine.8 = line.7 end else templine.7 = line.7 if turns <= word(line.6,10) then do templine.6 = winline templine.7 = line.6 end else templine.6 = line.6 if turns <= word(line.5,10) then do templine.5 = winline templine.6 = line.5 end else templine.5 = line.5 if turns <= word(line.4,10) then do templine.4 = winline templine.5 = line.4 end else templine.4 = line.4 if turns <= word(line.3,10) then do templine.3 = winline templine.4 = line.3 end else templine.3 = line.3 if turns <= word(line.2,10) then do templine.2 = winline templine.3 = line.2 end else templine.2 = line.2 if turns <= word(line.1,10) then do templine.1 = winline templine.2 = line.1 end else templine.1 = line.1 call delete(datapath'/winners') call open(win,datapath'/winners','w') call writeln(win,templine.1) call writeln(win,templine.2) call writeln(win,templine.3) call writeln(win,templine.4) call writeln(win,templine.5) call writeln(win,templine.6) call writeln(win,templine.7) call writeln(win,templine.8) call writeln(win,templine.9) call writeln(win,templine.10) call close(win) end return loaddata: call open(data,datapath'/'name,'r') pos.c = readln(data) pos.b = readln(data) pos.d = readln(data) pos.s = readln(data) pos.p = readln(data) damage.c = readln(data) if damage.c = 5 then shipsdown = shipsdown' Carrier' damage.b = readln(data) if damage.b = 4 then shipsdown = shipsdown' Battleship' damage.d = readln(data) if damage.d = 3 then shipsdown = shipsdown' Destroyer' damage.s = readln(data) if damage.s = 3 then shipsdown = shipsdown' Submarine' damage.p = readln(data) if damage.p = 2 then shipsdown = shipsdown' PT_Boat' shipssunk = readln(data) hits = readln(data) misses = readln(data) lastplay = readln(data) turns = readln(data) call close(data) do z = c2d('A') to c2d('J') let = d2c(z) call writech(stdout,'.') do num = 1 to 10 call writech(stdout,'.') do w = 1 to words(hits) if word(hits,w) = let||num then do s.let.num = ''pen3'X'def'' iterate num end end do y = 1 to words(misses) if word(misses,y) = let||num then do s.let.num = ''pen2'*'def'' iterate num end end s.let.num = ''pen6'.'def'' end end return setupdata: if exists(datapath'/'name) then call delete(datapath'/'name) /* Setup the random locations of the ships */ pos.c = '' pos.b = '' pos.d = '' pos.s = '' pos.p = '' call setships C 6 5 /* Carrier */ call setships B 7 4 /* Battleship */ call setships D 8 3 /* Destroyer */ call setships S 8 3 /* Sub */ call setships P 9 2 /* PT Boat */ call open(data,datapath'/'name,'w') call writeln(data,pos.c) /* ship positions */ call writeln(data,pos.b) call writeln(data,pos.d) call writeln(data,pos.s) call writeln(data,pos.p) call writeln(data,'0') /* # of hits on Carrier */ call writeln(data,'0') /* # of hits on Battleship */ call writeln(data,'0') /* # of hits on Destroyer */ call writeln(data,'0') /* # of hits on Sub */ call writeln(data,'0') /* # of hits on PT Boat */ call writeln(data,'0') /* # of ships sunk so far */ call writeln(data,'') call writeln(data,'') call writeln(data,date()) call writeln(data,'0') call close(data) justsetup = 1 return setships: arg shiptype spotlimit spots starta = random(1,20,time('s')) if starta > 0 & starta < 11 then direction = 'V' else do direction = 'H' if starta = 11 then starta = 'A' if starta = 12 then starta = 'B' if starta = 13 then starta = 'C' if starta = 14 then starta = 'D' if starta = 15 then starta = 'E' if starta = 16 then starta = 'F' if starta = 17 then starta = 'G' if starta = 18 then starta = 'H' if starta = 19 then starta = 'I' if starta = 20 then starta = 'J' end startb = random(1,spotlimit,time('s')) if direction = 'V' then do if startb = 1 then shstring = 'A B C D E F G H I J' if startb = 2 then shstring = 'B C D E F G H I J' if startb = 3 then shstring = 'C D E F G H I J' if startb = 4 then shstring = 'D E F G H I J' if startb = 5 then shstring = 'E F G H I J' if startb = 6 then shstring = 'F G H I J' if startb = 7 then shstring = 'G H I J' if startb = 8 then shstring = 'H I J' if startb = 9 then shstring = 'I J' end if direction = 'V' then do do r = 1 to spots let.r = word(shstring,r) end if shiptype = 'C' then pos.shiptype = ''let.1''starta' 'let.2''starta' 'let.3''starta' 'let.4''starta' 'let.5''starta'' if shiptype = 'B' then pos.shiptype = ''let.1''starta' 'let.2''starta' 'let.3''starta' 'let.4''starta'' if shiptype = 'D' | shiptype = 'S' then pos.shiptype = ''let.1''starta' 'let.2''starta' 'let.3''starta'' if shiptype = 'P' then pos.shiptype = ''let.1''starta' 'let.2''starta'' end else do if shiptype = 'C' then pos.shiptype = ''starta''startb' 'starta''startb + 1' 'starta''startb + 2' 'starta''startb +3' 'starta''startb + 4'' if shiptype = 'B' then pos.shiptype = ''starta''startb' 'starta''startb + 1' 'starta''startb + 2' 'starta''startb +3'' if shiptype = 'D' | shiptype = 'S' then pos.shiptype = ''starta''startb' 'starta''startb + 1' 'starta''startb + 2'' if shiptype = 'P' then pos.shiptype = ''starta''startb' 'starta''startb + 1'' end if shiptype ~= 'C' then do do w = 1 to words(pos.shiptype) testword = word(pos.shiptype,w) do u = 1 to words(used) usedword = word(used,u) if testword = usedword then call setships shiptype spotlimit spots end end end used = ''pos.c' 'pos.b' 'pos.d' 'pos.s' 'pos.p'' return readstr: procedure str='' out=readch(STDIN) call WRITECH(STDOUT,out) do while out~=D2C(13) if out=D2C(8) then do str=SUBSTR(str,1,LENGTH(str)-1) call WRITECH(STDOUT,' ') call WRITECH(STDOUT,out) end else str=INSERT(str,out) out=readch(STDIN) call WRITECH(STDOUT,out) end say '0D'x return(UPPER(str)) prompt: procedure parse arg str writech(STDOUT,str) return 1 /********************************************************************/ instring: procedure arg letter,string if (index(string,letter) == 0) then return 0 else return 1 pressreturn: prompt(''pen5' Press return to continue'def'') out=readch(STDIN) return SAC70: /* SAY CENTER TEXT*/ PARSE ARG string SAY CENTER(string,75)||CR RETURN; SYNTAX: SAY '*BOOM* Got a syntax error. PLEASE notify the sysop.' SAY 'Line:' SIGL ' Error Code:' RC BREAK_C: BREAK_E: SAY exit