pdp10 folder

.gitignore

@@ -35,5 +35,4 @@ lang-sentences*
 /venv310/
 /cmake-build-debug-docker/
 /build-docs/
-*build*
 .vscode

pdp10/compuserve/BASBLD.FOR

@@ -0,0 +1,45 @@
+C	This file is part of Decwar.
+C	Copyright 1979, 2011 Bob Hysick, Jeff Potter, The University of Texas
+C	Computation Center and Harris Newman.
+
+C	This program is free software; you can redistribute it and/or modify
+C	it under the terms of the GNU General Public License as published by
+C	the Free Software Foundation; either version 3, or (at your option)
+C	any later version.
+
+C	This program is distributed in the hope that it will be useful,
+C	but WITHOUT ANY WARRANTY; without even the implied warranty of
+C	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C	GNU General Public License for more details.
+
+C	You should have received a copy of the GNU General Public License
+C	along with this program; if not, write to the Free Software
+C	Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
+C	02110-1301, USA.  
+
+
+C	This routine is activated whenever any player (or the Romulan)
+C	makes a time-consuming move.  It's purpose is to strengthen
+C	weakened starbases of the opposite team.  The Romulan rebuilds
+C	both side's starbases.  The percentage gain in base energy per
+C	BASBLD call is reduced as the number of players increase.
+
+	subroutine BASBLD
+	include 'param/nolist'
+	include 'hiseg/nolist'
+	include 'lowseg/nolist'
+	include 'extern/nolist'
+
+	ib = 1  ;  ie = 2  ;  n = 50 / (numply + 1)
+	if (.not. PLAYER)  goto 100		!Romulan?
+	if (team .eq. 1)  ib = 2  ;  ie = ib
+	n = 25 / numsid(team)
+ 100	do 300 j = ib, ie
+	  do 200 i = 1, KNBASE
+	    if (base(i,3,j) .le. 0)  goto 200	!is base dead?
+	    base(i,3,j) = min0 (base(i,3,j) + n, 1000)
+ 200	  continue
+ 300	continue
+	return
+
+	end

pdp10/compuserve/BASKIL.FOR

@@ -0,0 +1,66 @@
+C	This file is part of Decwar.
+C	Copyright 1979, 2011 Bob Hysick, Jeff Potter, The University of Texas
+C	Computation Center and Harris Newman.
+
+C	This program is free software; you can redistribute it and/or modify
+C	it under the terms of the GNU General Public License as published by
+C	the Free Software Foundation; either version 3, or (at your option)
+C	any later version.
+
+C	This program is distributed in the hope that it will be useful,
+C	but WITHOUT ANY WARRANTY; without even the implied warranty of
+C	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C	GNU General Public License for more details.
+
+C	You should have received a copy of the GNU General Public License
+C	along with this program; if not, write to the Free Software
+C	Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
+C	02110-1301, USA.  
+
+
+C	This routine is activated whenever a starbase or captured
+C	planet is destroyed.  The purpose of the routine is to check
+C	whether any adjacent ships were docked at this object at the
+C	time of the attack, and reset their ship's condition to RED
+C	if true.  ITYPE = team of destroyed port.
+
+	subroutine BASKIL (itype)
+	include 'param/nolist'
+	include 'hiseg/nolist'
+	include 'lowseg/nolist'
+	include 'extern/nolist'
+
+	ib = 1  ;  ie = KNPLAY
+	if (itype .eq. 1)  ie = KNPLAY / 2
+	if (itype .eq. 2)  ib = (KNPLAY / 2) + 1
+
+	do 400 i = ib, ie
+	  if (.not. docked(i))  goto 400	!is he docked?
+
+*.........Check for adjacent starbase
+
+	  if (nbase(itype) .le. 0)  goto 200	!any bases alive?
+	  do 100 j = 1, KNBASE
+	    if (base(j,3,itype) .le. 0)  goto 100
+	    if (ldis(shpcon(i,KVPOS), shpcon(i,KHPOS), 
+     +	    base(j,KVPOS,itype), base(j,KHPOS,itype), 1))  goto 400
+ 100	  continue
+
+*.........Check for adjacent friendly planet
+
+ 200	  if (numcap(itype) .le. 0)  goto 400	!any friendly planets?
+	  do 300 j = 1, nplnet
+	    if ((itype + DXNPLN) .ne. dispc(locpln(j,KVPOS), 
+     +	    locpln(j,KHPOS)))  goto 300
+	    if (ldis(shpcon(i,KVPOS), shpcon(i,KHPOS), locpln(j,KVPOS), 
+     +	    locpln(j,KHPOS), 1))  goto 400
+ 300	  continue
+
+*.........No adjacent friendly port, undock player.
+
+	  shpcon(i,KSPCON) = RED
+	  docked(i) = .FALSE.
+ 400	continue
+	return
+
+	end

pdp10/compuserve/BASPHA.FOR

@@ -0,0 +1,87 @@
+C	This file is part of Decwar.
+C	Copyright 1979, 2011 Bob Hysick, Jeff Potter, The University of Texas
+C	Computation Center and Harris Newman.
+
+C	This program is free software; you can redistribute it and/or modify
+C	it under the terms of the GNU General Public License as published by
+C	the Free Software Foundation; either version 3, or (at your option)
+C	any later version.
+
+C	This program is distributed in the hope that it will be useful,
+C	but WITHOUT ANY WARRANTY; without even the implied warranty of
+C	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C	GNU General Public License for more details.
+
+C	You should have received a copy of the GNU General Public License
+C	along with this program; if not, write to the Free Software
+C	Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
+C	02110-1301, USA.  
+
+
+C	This routine controls the phaser defenses of the starbases.
+C	These defenses are activated whenever a player (or the Romulan)
+C	performs a time-consuming move.  A player only activates the
+C	opposite team's starbases, with the Romulan activating both
+C	side's bases.
+
+	subroutine BASPHA
+	include 'param/nolist'
+	include 'hiseg/nolist'
+	include 'lowseg/nolist'
+	include 'extern/nolist'
+
+	jb = 1  ;  je = 2
+	if (.not. PLAYER)  goto 100			!Romulan?
+	jb = 3 - team  ;  je = jb
+
+ 100	do 500 i = jb, je
+	  if (nbase(i) .le. 0)  goto 500		!active bases?
+	  do 400 j = 1, KNBASE
+	    if (base(j,3,i) .le. 0)  goto 400		!base alive?
+
+*...........Attack the players
+
+	    do 300 k = (KNPLAY/2) * (2 - i) + 1, (KNPLAY/2) * (3 - i)
+	      if (.not. alive(k))  goto 300		!player dead?
+	      if (disp(shpcon(k,KVPOS), shpcon(k,KHPOS)) .le. 0) 
+     +	      goto 300					!player cloaked?
+	      if (.not. ldis(shpcon(k,KVPOS), shpcon(k,KHPOS), 
+     +	      base(j,KVPOS,i), base(j,KHPOS,i), 4))  goto 300	!player in range?
+	      Vfrom = base(j,KVPOS,i)  ;  Hfrom = base(j,KHPOS,i)
+	      Vto   = shpcon(k,KVPOS)  ;  Hto   = shpcon(k,KHPOS)
+	      dispto = (DXFSHP + (2 - i)) * 100 + k  ;  iwhat = 1
+	      dispfr = (DXFBAS + (i - 1)) * 100 + j  ;  shjump = 0
+	      id = pdist (Vfrom, Hfrom, Vto, Hto)
+	      call phadam (3-i, k, id, 200/numply, .FALSE.)	!hit him!
+	      tmscor(i,KPEDAM) = tmscor(i,KPEDAM) + ihita
+	      shstfr = base(j,3,i)       ;  shcnfr = 1
+	      if (klflg .ne. 0) tmscor(i,KPEKIL) = tmscor(i,KPEKIL) + 5000
+ 200	      call pridis (shpcon(k,KVPOS), shpcon(k,KHPOS), KRANGE, 
+     +        team, 0)
+	      call pridis (shpcon(k,KVPOS), shpcon(k,KHPOS), 4, 0, 1)
+	      dbits = dbits .or. bits(k)
+	      call makhit				!send hit message
+ 300	    continue
+
+*...........Attack the Romulan (if he's alive)
+
+	    if (.not. ROM)  goto 400		!Romulan alive?
+	    if (.not. ldis (locr(KVPOS), locr(KHPOS), base(j,KVPOS,i),
+     +	    base(j,KHPOS,i), 4))  goto 400	!Romulan in range?
+	    dispto = DXROM * 100  ;  shjump = 0
+	    dispfr = (DXFBAS + (i - 1)) * 100 + j  ;  iwhat = 1
+	    Vfrom = base(j,KVPOS,i)  ;  Hfrom = base(j,KHPOS,i)
+	    Vto   = locr(KVPOS)      ;  Hto   = locr(KHPOS)
+	    id = pdist (Vfrom, Hfrom, Vto, Hto)
+	    call pharom (200/numply, id)		!hit Romulan!
+	    shstfr = base(j,3,i)  ;  shcnfr = 1
+	    shstto = erom         ;  shcnto = 1
+	    call pridis (locr(KVPOS), locr(KHPOS), KRANGE, 0, 0)
+	    tmscor(i,KPRKIL) = tmscor(i,KPRKIL) + ihita
+	    if (.not. ROM)  tmscor(i,KPRKIL) = tmscor(i,KPRKIL) + 5000
+	    call makhit				!send hit message
+ 400	  continue
+ 500	continue
+	return
+
+	end

pdp10/compuserve/BLKDAT.FOR

@@ -0,0 +1,105 @@
+C	This file is part of Decwar.
+C	Copyright 1979, 2011 Bob Hysick, Jeff Potter, The University of Texas
+C	Computation Center and Harris Newman.
+
+C	This program is free software; you can redistribute it and/or modify
+C	it under the terms of the GNU General Public License as published by
+C	the Free Software Foundation; either version 3, or (at your option)
+C	any later version.
+
+C	This program is distributed in the hope that it will be useful,
+C	but WITHOUT ANY WARRANTY; without even the implied warranty of
+C	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C	GNU General Public License for more details.
+
+C	You should have received a copy of the GNU General Public License
+C	along with this program; if not, write to the Free Software
+C	Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
+C	02110-1301, USA.  
+
+
+	BLOCK DATA
+	include 'param/nolist'
+	include 'hiseg/nolist'
+	include 'lowseg/nolist'
+
+	data (device(i), i = 1, KNDEV)/ 
+     +	  2HSH, 2HWA, 2HIM, 2HLS, 2HTO, 2HPH, 2HCO, 2HRA, 2HTR /
+
+	data ((isaydo(i,j), i = 1, 2), j = 1, KNCMD)/ 
+     +    'BAses', '     ',
+     +	  'BUild', '     ',
+     +	  'Captu', 're   ',
+     +	  'DAmag', 'es   ',
+     +	  'DOck ', '     ',
+     +	  'Energ', 'y    ',
+     +    'Gripe', '     ',
+     +	  'Help ', '     ',
+     +	  'Impul', 'se   ',
+     +	  'List ', '     ',
+     +	  'Move ', '     ',
+     +	  'News ', '     ',
+     +	  'PHase', 'rs   ',
+     +	  'PLane', 'ts   ',
+     +    'POint', 's    ',
+     +	  'Quit ', '     ',
+     +	  'RAdio', '     ',
+     +	  'REpai', 'r    ',
+     +	  'SCan ', '     ',
+     +	  'SEt  ', '     ',
+     +	  'SHiel', 'ds   ',
+     +	  'SRsca', 'n    ',
+     +	  'STatu', 's    ',
+     +	  'SUmma', 'ry   ',
+     +	  'TArge', 'ts   ',
+     +	  'TEll ', '     ',
+     +	  'TIme ', '     ',
+     +	  'TOrpe', 'dos  ',
+     +	  'TRact', 'or   ',
+     +	  'TYpe ', '     ',
+     +    'Users', '     ',
+     +    '*Debu' ,'g    ',
+     +    '*Pass' ,'word '/
+
+	data ((xhelp(i,j), i = 1, 2), j = 1, KNXTR)/ 
+     +	  'CTL-C', '     ',
+     +    '     ', '     ',
+     +    'INTRO', '     ',
+     +	  'HInts', '     ',
+     +	  'INput', '     ',
+     +	  'Outpu', 't    ',
+     +	  'PAuse', 's    ',
+     +	  'PRega', 'me   '/
+
+	data ((ttydat(i,j), i = 1, 2), j = 1, KNTTY)/ 
+     +	  'ACT-I', 'V    ',
+     +	  'ADM-2', '     ',
+     +	  'ADM-3', 'a    ',
+     +	  'DATAP', 'OINT ',
+     +	  'ACT-V', '     ',
+     +	  'SOROC', '     ',
+     +	  'BEEHI', 'VE   ',
+     +	  'CRT  ', '     '/
+
+	data ((names(i,j), j = 1, 3), i = 1, KNPLAY)/ 
+     +	  'Lexin', 'gton ', ' L',
+     +	  'Nimit', 'z    ', ' N',
+     +	  'Savan', 'nah  ', ' S',
+     +	  'Vulca', 'n    ', ' V',
+     +	  'Yorkt', 'own  ', ' Y',
+     +	  'Cobra', '     ', ' C',
+     +	  'Demon', '     ', ' D',
+     +	  'Hawk ', '     ', ' H',
+     +    'Jacka', 'l    ', ' J',
+     +	  'Wolf ', '     ', ' W'/
+
+	data (bits(i), i = 1, 10)/ 
+     +	"1, "2, "4, "10, "20, "40, "100, "200, "400, "1000/
+
+	data (sbits(i), i = 0, 2)/ NEUBIT , FEDBIT , EMPBIT /
+
+	data (cmdbts(i), i = 1, KNCMD)/ 
+     +	  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+     +	  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
+
+	end