subroutine strek_write (new, ship_name, user_name, capt_name, & nick_name, & key_file, ship_avail, last_score, & cum_score, ship_active, top_ten) c c c ******************************************************************* c ***** ***** c ***** STAR TREK VERSION 3.0 ***** c ***** ***** c ***** written by ***** c ***** ***** c ***** Justin S. Revenaugh ***** c ***** ***** c ***** 7/87 ***** c ***** ***** c ***** Massachussetts Institute of Technology ***** c ***** Department of Earth, Atmospheric and Planetary Science ***** c ***** ***** c ******************************************************************* c STREK_WRITE updates the two STREK info files (strek_info and c strek_top_scores). If (new) then a name is appended, else the c name is updated. c c integer*4 ship_avail(3), last_score, cum_score, ship_retired integer*4 num_lines, count, top_scores(10) logical ship_active, new, fyn, top_ten character ship_name*30, user_name*10 character capt_name*10, nick_name*10, temp*30 character my_tmp(10)*10 character ctemp(10)*10, stemp(10)*30, key_file*256 c c if ship name is blank then return c if (ship_name.eq.' ') then top_ten = .false. return end if c c open up strek_info file c inquire(file='/usr/lib/X11/xstrek/strek_info',exist=fyn) if (.not.fyn) then status = 1 return end if open (unit=1,file='/usr/lib/X11/xstrek/strek_info', & access ='direct',form = & 'unformatted', status='old',recl=1000) inquire(file='/usr/lib/X11/xstrek/strek_top_scores', exist=fyn) if (.not.fyn) then status = 1 return end if open (unit=2,file='/usr/lib/X11/xstrek/strek_top_scores', & status='old',recl=1000, & form='formatted') c c if new then update num_lines and append info c if (ship_active) then ship_retired = 0 else ship_retired = 1 end if if (new) then read (1,rec=1) num_lines num_lines = num_lines + 1 write (1,rec=1) num_lines write (1,rec=num_lines+1) ship_name, user_name, & capt_name, nick_name, & key_file, (ship_avail(i),i=1,3), last_score, & cum_score, ship_retired close(1) else c c name is old, find it and update c read(1,rec=1) num_lines count = 1 10 continue read(1,rec=count+1) temp if (temp.eq.ship_name) then write (1,rec=count+1) ship_name, user_name, & capt_name, nick_name, & key_file, (ship_avail(i),i=1,3), last_score, & cum_score, ship_retired goto 20 end if if (count.eq.num_lines) then close(1) end if count = count + 1 goto 10 20 continue close(1) end if c c determine if the score is a top ten score c do 30 j=1,10 read (2,110) my_tmp(j),ctemp(j), stemp(j), top_scores(j) 30 continue rewind(2) 110 format(a10,a10,a30,i10) i = 1 top_ten = .false. 40 continue if (cum_score.gt.top_scores(i)) then top_ten = .true. goto 50 end if if (i.eq.10) goto 50 i = i + 1 goto 40 50 continue if (top_ten) then c c see if ship is already on the list c do 55 j = 1,i-1 if (stemp(j).eq.ship_name) then top_ten = .false. close(2) return end if 55 continue do 60 j = i,10 if (stemp(j).eq.ship_name) then c c move everybody up one to delete the duplicate entry c do 70 k = j,9 my_tmp(k) = my_tmp(k+1) stemp(k) = stemp(k+1) ctemp(k) = ctemp(k+1) top_scores(k) = top_scores(k+1) 70 continue end if 60 continue c c write out the new list, note that a ship that was previously c on the list and who's score drops as a result of a mission c will remain on the list. c do 80 j = 1,i-1 write (2,110) my_tmp(j),ctemp(j), stemp(j), top_scores(j) 80 continue write (2,110) user_name,capt_name, ship_name, cum_score do 90 j = i,9 write (2,110) my_tmp(j),ctemp(j), stemp(j), top_scores(j) 90 continue end if close(2) return end subroutine strek_review (ship_name, user_name, & capt_name, nick_name, & ship_avail, cum_score, last_score, & ship_active, key_file, status) c c STREK_REVIEW reviews the STREK database which includes c ships, shipnames, captains, cumulative scores, ship avail- c ability times and last outing scores. File is hardwired to c be STREK_INFO. The file structure is as follows: c c line 1 number of lines (i8) c c lines 2 - last: c c shipname (char*30), captain (char*10), nickname (char*10), c ship availability (3i*4), last outing score (i*10), cumu- c lative score (i*10), ship active toggle (i*1). c c The file is direct access, and all new entries are appended c to the end. c c A second file called STREK_TOP_SCORES is maintained. In it c are the current ten best scores (ascii). The file is struct- c ered: c c lines 1 - 10 captains name (char*10), shipname (char*30), and c cumulative score (i*10). c c c version 1 c -jsr 8/85 c c integer*4 ship_avail(3), cum_score, ship_retired, last_score integer*4 status, num_lines, count logical ship_active, fyn character ship_name*30, user_name*10 character capt_name*10, nick_name*10, temp*30 character key_file*256 c c open up strek_info file c status = 0 inquire(file='/usr/lib/X11/xstrek/strek_info',exist=fyn) if (.not.fyn) then status = 1 return end if open (unit=1,file='/usr/lib/X11/xstrek/strek_info', & access = 'direct',form = & 'unformatted', status='old',recl=1000) c c read number of lines c read(1, rec=1) num_lines count = 1 10 continue read(1,rec=count+1) temp if (temp.eq.ship_name) then read(1,rec=count+1) temp, user_name, & capt_name, nick_name, key_file, & (ship_avail(i),i=1,3), last_score, cum_score, ship_retired goto 20 end if if (count.eq.num_lines) then close(1) status = 2 return end if count = count + 1 goto 10 20 continue close(1) if (ship_retired.eq.1) then ship_active = .false. else ship_active = .true. end if return end subroutine strek_question (user_name, capt_name, & nick_name, ship_name, & key_file, new) c c STREK_QUESTION determines if the player has a ship or if he c is new (or just a new ship). c c version 1 c -jsr 8/85 c logical new, found character user_name*10 character capt_name*10, nick_name*10, ship_name*30 character answer*1, key_file*256, means(256)*1 c c key definition common c common /key_defs/ means nick_name = ' ' call getusername(user_name) c c question captains c print*,'STAR TREK v.3' print*,' ' print*,'What is your name, captain?' read (*,'(a)') capt_name call strek_search_name (user_name, & capt_name, ship_name, key_file, new) if (new) then print*,' ' print*, 'What do your friends call you sir?' read(*,'(a)') nick_name 10 continue print*,' ' print*,'Enter pathname of your key definition file.' print*,' for no file.' read (*,'(a)') key_file if (key_file .ne. ' ') then call strek_parse_key_defs (key_file, found) if (.not.found) then print*,'The key definition file was not found, try again.' goto 10 end if else do 20 j = 1, 256 means(j) = char(j) 20 continue end if else if (key_file .ne. ' ') then call strek_parse_key_defs (key_file, found) if (.not.found) then print*,' ' print*,'The key definition file was not found,' print*,'enter the pathname of another file.' print*,' for no file.' print*,' ' read(*,'(a)') key_file if (key_file .ne. ' ') then call strek_parse_key_defs (key_file, found) end if if (.not. found .or. key_file .eq. ' ') then do 30 j = 1, 256 means(j) = char(j) 30 continue end if end if else do 40 j = 1, 256 means(j) = char(j) 40 continue end if end if print*,' ' return end subroutine strek_ships c c STREK_SHIPS outputs the current ship list including the c scores of their last outings. c c version 1 c -jsr 8/85 c c % include '/sys/ins/base.ins.ftn' c % include '/sys/ins/cal.ins.ftn' c % include '/sys/ins/time.ins.ftn' c integer*2 decoded_clock(6) integer*4 num_lines, last_score, cum_score, ship_avail(3) integer*4 ship_retired logical fyn character ship_name*30, user_name*10 character capt_name*10, nick_name*10, retired*10 character key_file*256 save retired data retired /'retired'/ c c get local time c call caldecodelocaltime (decoded_clock) c c open database c inquire(file='/usr/lib/X11/xstrek/strek_info',exist=fyn) if (.not.fyn) then status = 1 return end if open (unit=1,file='/usr/lib/X11/xstrek/strek_info', & access ='direct',form = & 'unformatted', status='old',recl=1000) c c print out header c print*,' ' print*,' ' write (*,100) (decoded_clock(i),i=1,3) 100 format ('STAR TREK Ship Registry as of ',i4,'/',i2,'/',i2) print*,' ' print*,'SHIP NAME LAST SCORE AVAILABLE &SCORE' print*,' ' read (1,rec=1) num_lines do 10 j=2,num_lines+1 read (1,rec=j) ship_name, user_name, & capt_name, nick_name, key_file, & (ship_avail(i), i=1,3), last_score, & cum_score, ship_retired if (ship_retired.eq.1) then write (*,120) ship_name, last_score, retired, cum_score else write (*,130) ship_name, last_score, (ship_avail(i), i=1,3), & cum_score end if 10 continue 120 format (1x,a30,x,i10,5x,a7,i10) 130 format (1x,a30,x,i10,2x,i4,'/',i2,'/',i2,i10) print*,' ' print*,' ' close(1) return end subroutine strek_scores c c STREK_SCORES prints out the list of top scores currently c in STREK_TOP_SCORES. c c version 1 c -jsr 8/85 c c % include '/sys/ins/base.ins.ftn' c % include '/sys/ins/cal.ins.ftn' c % include '/sys/ins/time.ins.ftn' integer*2 decoded_clock(6) integer*4 top_scores logical fyn character dummy1*34, dummy2*34 character user_name*10, capt_name*10, ship_name*30 save dummy1 save dummy2 data dummy1 /' User CAPTAIN SHIP NA'/ data dummy2 /'ME SCORE'/ c c get local time c call caldecodelocaltime (decoded_clock) c c open up top scores file and read c inquire(file='/usr/lib/X11/xstrek/strek_top_scores', exist=fyn) if (.not.fyn) then status = 1 return end if open (unit=2,file='/usr/lib/X11/xstrek/strek_top_scores', & status='old',recl=1000, & form='formatted') c c print out header c print*,' ' write (*,100) (decoded_clock(i),i=1,3) 100 format (' Top 10 STAR TREK Scores as of ',i4,'/',i2,'/',i2) print*,' ' write (*,130) dummy1, dummy2 print*,' ' do 10 j=1,10 read (2,110) user_name, capt_name, ship_name, top_scores write (*,120) j, user_name, capt_name, ship_name, top_scores 10 continue c print*,' ' write (*,'(a1)') ' ' c print*,' ' write (*,'(a1)') ' ' 110 format(a10,a10,a30,i10) 120 format(i2,'.',2x,a10,x,a10,x,a30,x,i10) 130 format(a34,a34) close(2) return end subroutine strek_damage_date (damage_days, ship_avail) c c STREK_DAMAGE_DATE computes the ship availability date c given the damage repair time in whole days. This is c used after a game but before updating STREK_INFO via c STREK_WRITE. Note that damage date can't exceed 1 year c and is not adjusted for leap years encountered when c damage occurs in a non-leap year. c c version 1 c -jsr 8/85 c c % include '/sys/ins/base.ins.ftn' c % include '/sys/ins/cal.ins.ftn' c % include '/sys/ins/time.ins.ftn' c integer*2 decoded_clock(6) integer*4 ship_avail(3), damage_days, days(12) c c days in months data c data days/31,28,31,30,31,30,31,31,30,31,30,31/ c c get local time c call caldecodelocaltime (decoded_clock) c c if a leap year change days(2) c ichk = mod(decoded_clock(1),4) if (ichk.eq.0) then days(2) = 29 ichk1 = mod(decoded_clock(1),100) ichk2 = mod(decoded_clock(1),400) if (ichk1.eq.0) then if (ichk2.eq.0) then days(2) = 29 else days(2) = 28 end if end if end if c c add damage days to local time c iday = damage_days + decoded_clock(3) imonth = decoded_clock(2) if (iday.gt.days(imonth)) then iday = iday - days(imonth) imonth = decoded_clock(2) + 1 end if if (imonth.le.12) then iyear = decoded_clock(1) else iyear = decoded_clock(1) + 1 imonth = imonth - 12 end if c c load ship availability date c ship_avail(1) = iyear ship_avail(2) = imonth ship_avail(3) = iday return end subroutine strek_startup (user_name, & capt_name, nick_name, ship_name, & last_score, cum_score, key_file, new) c c STREK_STARTUP initializes the strek system. The order c of calls is: c c STREK_QUESTION - get captain info and ship name, c c STREK_REVIEW - if ship is old get it's stats. c c options: STREK_SHIPS - review the current ship registry, c and STREK_SCORES - review the top 10 scores. c c version 1 c -jsr 8/85 c integer*4 ship_avail(3), last_score, cum_score, status logical ship_active, open, new, avail character user_name*10 character capt_name*10, nick_name*10, ship_name*30, answer*1 character*256 key_file c c STREK is open so question the captain c call strek_question (user_name, & capt_name, nick_name, ship_name, & key_file, new) c c if this is a new ship or captain set up scores c if (new) then cum_score = 0 last_score = 0 else c c this is an old ship, check her status in the registry c call strek_review (ship_name, user_name, & capt_name, nick_name, ship_avail, & cum_score, last_score, ship_active, key_file, & status) if (status.eq.1) then print*,'STREK_INFO doesn''t exist, execution stops!' print*,'Run XSTREK_STARTUP_DB to initialize the database.' print*,' ' stop end if end if c c review the registry or scores? c 10 continue print*,'Enter to view the ship registry,' print*,' to view the top ten scores or' print*,' to start.' print*,' ' read (*,'(a)') answer if (answer.eq.'r') then call strek_ships goto 10 else if (answer.eq.'s') then call strek_scores goto 10 else print*,' ' end if return end subroutine strek_ship_avail (ship_avail, avail) c c STREK_SHIP_AVAIL decodes the ship available time from c STREK_INFO and decides if the ship is ready or not. c Dead ships are flagged in STREK_INFO and needn't c be processed herein. c c If (avail) then the ship is available. c c version 1 c -jsr 8/85 c c % include '/sys/ins/base.ins.ftn' c % include '/sys/ins/time.ins.ftn' c % include '/sys/ins/cal.ins.ftn' c integer*2 decoded_clock(6) integer*4 ship_avail(3) logical avail c c get local time c call caldecodelocaltime (decoded_clock) c c compare dates and see if ship is ready c if (ship_avail(1).gt.decoded_clock(1)) then avail = .false. return else if (ship_avail(1).lt.decoded_clock(1)) then avail = .true. return else if (ship_avail(2).gt.decoded_clock(2)) then avail = .false. return else if (ship_avail(2).lt.decoded_clock(2)) then avail = .true. return else if (ship_avail(3).gt.decoded_clock(3)) then avail = .false. return else avail = .true. end if return end subroutine strek_dock (d_pct, score, user_name, & capt_name, nick_name, & ship_name, cum_score, key_file, new_ship) c c STREK_DOCK updates the STREK database after docking c c version 1 c -jsr 8/85 c c % include '/sys/ins/base.ins.ftn' c % include '/sys/ins/cal.ins.ftn' c % include '/sys/ins/gpr.ins.ftn' c % include '/sys/ins/time.ins.ftn' c integer*2 clock(3) integer*4 score, cum_score, days, ship_avail(3), status integer*4 seconds real*4 d_pct(6), time(6), damage character*80 message(3) character user_name*10 character capt_name*10, nick_name*10, ship_name*30, key_file*256 logical new_ship, active, top_ten data time /1.25, 1.25, .75, 0.5, .75, 0.5/ data active /.true./ data seconds /2/ c c do house keeping c cum_score = cum_score + score call calsectoclock (seconds, clock) c c add up damage times c damage = 0.5 do 10 j = 1,6 damage = damage + (1.00 - d_pct(j))*time(j) 10 continue days = nint(damage) call strek_damage_date (days, ship_avail) c c write update info to STREK_INFO c call strek_write (new_ship, ship_name, user_name, & capt_name, nick_name, & key_file, ship_avail, score, cum_score, & active, top_ten) c c write messages to screen c message(1) = ' ' message(2) = 'Awaiting permission to dock.' message(3) = ' ' call strek_message (message, 3) call timewait (timerelative, clock, status) message(2) = 'Docking completed, good going captain. ' call strek_message (message, 3) call timewait (timerelative, clock, status) c c terminate graphics c call gprterminate (.true., status) print*,' ' if (ship_name.ne.' ') then write (*,100) (ship_avail(i), i=1,3) end if 100 format(' Your ship will be ready on ',i4,'/',i2,'/',i2) print*,' ' print*,'Score for this mission: ',score print*,'Cumulative score: ',cum_score print*,' ' if (top_ten) then call strek_scores print*,' ' print*,'Congratulations! Your score places you in the Top 10.' print*,' ' end if return end subroutine strek_no_energy (num_times, user_name, & capt_name, nick_name, & ship_name, key_file, score, & cum_score, new) c c STREK_NO_ENERGY advises the captain to cut energy use. Messages c become more and more urgent as the number of turns w/o energy c increases. After 150 turns the ship is retired and the database c updated. c c version 1 c -jsr 8/85 c c % include '/sys/ins/base.ins.ftn' c % include '/sys/ins/cal.ins.ftn' c % include '/sys/ins/gpr.ins.ftn' c % include '/sys/ins/time.ins.ftn' c integer*2 clock(3) integer*4 num_times, score, cum_score, status, ship_avail(3) integer*4 seconds character user_name*10 character capt_name*10, nick_name*10, ship_name*30, key_file*256 character*80 message_1(3), message_2(3), message_3(3), blank(3) logical top_ten, new save message_1, message_2, message_3, seconds, ship_avail data seconds, ship_avail /5, 3*0/ c c data for message strings c data message_1 /'Message from engineering:', & 'Sir, the battery reserves are critically low.', & 'Non-vital subsystems being dropped.'/ data message_2 /'Message from engineering:', & 'Main system shutdown occuring on all decks.', & 'Life-support system is in danger of failure.'/ data message_3 /'Message from engineering:', & 'Life-support system is down, oxygen content is dr &opping.', & 'Main system shutdown complete.'/ if (num_times.eq.1) then call strek_message (message_1, 3) else if (num_times.eq.50) then call strek_message (message_2, 3) else if (num_times.eq.100) then call strek_message (message_3, 3) else if (num_times.eq.150) then blank(1) = 'Message from chief engineer Scotty:' blank(2) = 'Sir, aye can''t hold on much longah.' write (blank(3),'(a30, a10)') 'It looks like the game''s over ', & nick_name call strek_message (blank, 3) c c do house keeping c cum_score = cum_score + score call calsectoclock (seconds, clock) call strek_write (new, ship_name, user_name, & capt_name, nick_name, & key_file, ship_avail, score, cum_score, & .false., top_ten) call timewait (timerelative, clock, status) c c terminate graphics c call gprterminate (.true., status) print*,' ' print*,'Score for this mission: ',score print*,'Cumulative score: ',cum_score print*,' ' if (top_ten) then call strek_scores print*,' ' print*,'Congratulations! Your score places you in the Top 10.' print*,'A rather hollow victory I would think.' print*,' ' end if print*,' ' if (ship_name.ne.' ') then print*,'Your ship, the ',ship_name print*,'was decommissioned after being found by Federation sco &uts.' print*,' ' end if stop end if return end subroutine strek_search_name (user_name, & capt_name, ship_name, key_file, new) c c STREK_SEARCH_NAME searches for the names of ships for a certain c captain. To fly a certain ship he need only type the number c associated with it. c c 4/86 -jsr c integer num_lines, ship_avail(3), last_score, cum_score integer ship_retired, count logical new, avail, ready(10) character user_name*10 character capt_name*10, nick_name*10, ship_name*30 character key_file*256, temp1*30, temp2*10, practice*30 character temp3*10 character ships(10)*30, nick(10)*10, key(10)*256 c c open the info file and read off all ship names c open (unit=1,file='/usr/lib/X11/xstrek/strek_info', & access = 'direct',form = & 'unformatted', status='old',recl=1000) c c read number of lines c read(1, rec=1) num_lines count = 2 do 10 i = 2, num_lines + 1 read(1,rec = i) temp1, temp3, temp2 if ((temp2.eq.capt_name).and.(temp3.eq.user_name)) then read(1,rec=i) ships(count), temp3, & temp2, nick(count), key(count), & (ship_avail(j),j=1,3), last_score, cum_score, ship_retired call strek_ship_avail (ship_avail, avail) if (avail) then ready(count) = .true. else ready(count) = .false. end if count = count + 1 end if 10 continue close(1) count = count - 1 practice = 'practice flight' ships(1) = 'initiate new ship' ready(1) = .true. print*,' ' print*,'Ships available:' print*,' ' write(*, 100) 0, practice do 20 i = 1, count if (ready(i)) then write(*, 100) i, ships(i) end if 20 continue 30 continue 100 format (x, i1, '. ', a30) print*,' ' print*,'Enter the number of the ship you wish to fly.' print*,' ' read*,number if (number .eq. 1) then print*,' ' print*,'What do you want to call your ship sir?' read(*,'(a)') ship_name new = .true. else if (number .gt. 1 .and. ready(number)) then new = .false. ship_name = ships(number) nick_name = nick(number) key_file = key(number) else if (number .eq. 0) then new = .true. ship_name = ' ' else goto 30 end if return end