c equivalent storage for comparing character values
      integer c0i/0/, c1i/0/
      logical c0l, c1l
      equivalence (c0i,c0l), (c1i,c1l)
c buffer for the checker characters
      logical*1 char(3)
c name of this subroutine
      logical*1 name(6)/'c', 'h', 'e', 'k', 'e', 'r'/
c
c
c
      do 1 i=1,6
 1    caller(i) = name(i)
c adjust boundaries, test for absence of error message
      if (qadj(xcentr,ycentr,width,height,prob,adjprb,
     c   ledge,redge,bedge,tedge,xecute,0)) go to 11
c show the user his actual call
      call getfmt(8,.false.)
      write (ttyo,fmtbuf) xcentr,ycentr,width,height,prob,char0,char1
c ask the user what he wants to do next
      call qnowut
 11   if (.not. xecute) go to 12
c copy the characters into an array buffer where they can be accessed by
c index number.  observe that in the subsequent code the even-odd parity
c of subscripts is reversed.  for example, the square in the bottom left
c corner of the picture has coordinates:  picher(1,1) with the parity of
c x+y = 1+1 even.  this square has the equivalent address string(1) with
c the parity of the string index = 1 odd.
      char(1) = char1
      char(2) = char0
c for efficient execution, set up loops using the string equivalent
c addresses of squares in the rectangle.  this allows single indexing in
c the innermost loop, where array addresses would require double
c indexing.
      probx4=4*adjprb+adjprb/51
      point=random(0,400,0)+1
      skip=random(0,399,0)
      del=random(1,397,0)
      if(mod(bedge+ledge,2).eq.1)go to 25
      char(3)=char(2)
      char(2)=char(1)
      char(1)=char(3)
  25  bedge = (bedge-1)*pictx + 1
      tedge = (tedge-1)*pictx + 1
      do 16 y=bedge,tedge,pictx
      char(3)=char(2)
      char(2)=char(1)
      char(1)=char(3)
      mindex = y + ledge - 1
      maxdex = y + redge - 1
      if(adjprb.lt.100)go to 20
      c0l = char0
      c1l = char1
      if (c0i .eq. c1i) go to 15
      do 13 index=mindex,maxdex
 13   string(index) = char(mod(index,2)+1)
      go to 16
  20  skip=mod(skip+del,400)
      do 17 index=mindex,maxdex
      point=mod(point+skip,401)+1
      if(ranseq(point).lt.probx4)string(index)=char(mod(index,2)+1)
  17  continue
      go to 16
  15  do 18 index=mindex,maxdex
  18  string(index)=char1
  16  continue
 12   return
      end
c the first 4 parameters define a rectangle.  "prob" is a percentage
c probability between 0 and 100 applied separately to each square (x,y)
c in the rectangle, determining whether any operation is to be executed
c on the square.
c for each square operated upon, "addend" is added to the previous
c contents of the square and the result modulo "modlus" is stored back
c into the square.  "addend" may have any integer value.  "modlus" must
c be an integer between 2 and (chars-1) (inclusive), where "chars" is a
c variable defined in common area "qommon".
c
c
c
      subroutine addmod(xcentr,ycentr,width,height,prob,addend,modlus)
      implicit integer (a-z)
c
c specifications of called functions
      logical qadj
c boundaries of the rectangle
      integer ledge,redge,bedge,tedge
c count of consecutive error messages for illegal modulus
      integer moder/1/
c switch determines whether to type an error message showing all the
c input parameters
      logical ermsg
c switch determines whether actual parameters allow subroutine execution
      logical xecute
c probability adjusted to legal value
      integer adjprb
c variables for random-skipping through table
      integer point,skip,del
c four times adjusted probability
      integer probx4
c addend adjusted to non-negative value
      integer adjadd
c equivalent storage for numerical operations on character values
      integer chari/0/
      logical charl
      equivalence (chari,charl)
c name of this subroutine
      logical*1 name(6)/'a', 'd', 'd', 'm', 'o', 'd'/
c
c
c
      do 1 i=1,6
 1    caller(i) = name(i)
c adjust boundaries, test for absence of error message
      ermsg = .not. qadj(xcentr,ycentr,width,height,prob,adjprb,
     c   ledge,redge,bedge,tedge,xecute,0)
c test for valid modulus
      if ((modlus .lt. 2) .or. (modlus .ge. chars)) go to 30
c reset error count
      moder = 1
c if illegal parameters caused any error messages, show the user his
c actual call
 9    if (ermsg) go to 10
 11   if (.not. xecute) go to 12
c for efficient execution, set up loops using the string equivalent
c addresses of squares in the rectangle.  this allows single indexing in
c the innermost loop, where array addresses would require double
c indexing.
c set initial values for table skipping
      point=random(1,401,0)
      skip=random(0,399,0)
      del=random(1,397,0)
      probx4=4*adjprb+adjprb/51
c adjust addend
      adjadd=mod(addend,modlus)
      if(adjadd.lt.0)adjadd=adjadd+modlus
      bedge = (bedge-1)*pictx + 1
      tedge = (tedge-1)*pictx + 1
      do 19  y=bedge,tedge,pictx
      mindex = y + ledge - 1
      maxdex = y + redge - 1
c go if straight process
      if(adjprb.ge.100)go to 15
      skip=mod(skip+del,400)
      do 16 index=mindex,maxdex
      point=mod(point+skip,401)+1
      if(ranseq(point).ge.probx4)go to 16
      charl=string(index)
      chari=mod(chari+adjadd,modlus)
      string(index)=charl
  16  continue
      go to 19
c straight addmod of all squares
  15  do 13 index=mindex,maxdex
      charl = string(index)
      chari = mod(chari+adjadd,modlus)
 13   string(index) = charl
  19  continue
 12   return
c modulus parameter < 2 or > (chars-1)
 30   xecute = .false.
c test error count
      if (moder .gt. maxmsg) go to 9
      moder = moder + 1
c no need to set error message switch; execution falls through to
c statement 10
c passing character size to the error message allows this code to run
c unchanged on computers with different character sizes
      temp = chars - 1
      call getfmt(51,.false.)
      write (ttyo,fmtbuf) temp
c at least one error message preceded this.  show the user his actual
c call.
 10   call getfmt(52,.false.)
      write (ttyo,fmtbuf) xcentr,ycentr,width,height,prob,addend,modlus
c ask the user what he wants to do next
      call qnowut
      go to 11
      end
c the first 4 parameters define a rectangle.  "prob" is a percentage
c probability between 0 and 100 applied separately to each square (x,y)
c in the rectangle, determining whether any operation is to be executed
c on the square.
c the last parameter is the name of a 1-dimensional integer array
c containing a transliteration table.  the transliteration table may be
c of any length, but if it is too short for the numeric values of the
c characters being transliterated, garbage may be stored in the picture.
c for each square operated upon, the numeric value (call it "oldval") of
c the character previously occupying the square is used as an index into
c the transliteration table.  the character stored at table entry number
c (oldval+1) is copied back into the square.
c
c
c
      subroutine xlitr8(xcentr,ycentr,width,height,prob,table)
      implicit integer (a-z)
      integer table(1024)
c
c specifications of called functions
      logical qadj
c boundaries of the rectangle
      integer ledge,redge,bedge,tedge
c switch determines whether actual parameters allow subroutine execution
      logical xecute
c probability adjusted to legal value
      integer adjprb
c indices of transliteration table entries which are not characters
      integer tablx(3)
c index of indices of transliteration table entries
      integer tablxx
c variables for random-skipping through table
      integer point,skip,del
c four times adjusted probability
      integer probx4
c equivalent storage for numerical operations on character values
      integer chari/0/, entryi/0/
      logical charl,entryl
      equivalence (chari,charl), (entryi,entryl)
c name of this subroutine
      logical*1 name(6)/'x', 'l', 'i', 't', 'r', '8'/
c
c
c
      do 1 i=1,6
 1    caller(i) = name(i)
c adjust boundaries, test for absence of error message
      if (qadj(xcentr,ycentr,width,height,prob,adjprb,
     c   ledge,redge,bedge,tedge,xecute,0)) go to 11
c show the user his actual call
      call getfmt(60,.false.)
      write (ttyo,fmtbuf) xcentr,ycentr,width,height,prob
c ask the user what he wants to do next
      call qnowut
 11   if (.not. xecute) go to 12
c reset index of indices
      tablxx = 0
c for efficient execution, set up loops using the string equivalent
c addresses of squares in the rectangle.  this allows single indexing in
c the innermost loop, where array addresses would require double
c indexing.
c set initial values for table skipping
      point=random(1,401,0)
      skip=random(0,399,0)
      del=random(1,397,0)
      probx4=4*adjprb+adjprb/51
      bedge = (bedge-1)*pictx + 1
      tedge = (tedge-1)*pictx + 1
      do 16 y=bedge,tedge,pictx
      mindex = y + ledge - 1
      maxdex = y + redge - 1
c if prob = 100 go to straight process
      if(adjprb.ge.100)go to 15
c set return loc. for processing illegal table entries
      assign 18 to next
c change skip distance, process a line (probabilistically)
      skip=mod(skip+del,400)
      do 18 index=mindex,maxdex
      point=mod(point+skip,401)+1
      if(ranseq(point).ge.probx4)go to 18
      charl=string(index)
      entryi = table(chari+1)
c only the rightmost bits are stored
      string(index) = entryl
c test whether the transliteration table entry was a character
      if ((entryi .lt. 0) .or. (entryi .ge. chars)) go to 2
  18  continue
      go to 16
c straight process of all squares
c set return loc. for processing illegal table entries
 15   assign 13 to next
      do 13 index=mindex,maxdex
      charl = string(index)
      entryi = table(chari+1)
c only the rightmost bits are stored
      string(index) = entryl
c test whether the transliteration table entry was a character
      if ((entryi .lt. 0) .or. (entryi .ge. chars)) go to 3
 13   continue
  16  continue
 12   return
c an illegal transliteration table entry was encountered.  test whether
c to type an error message.
 2    if (tablxx .eq. 3) go to 18
      go to 4
 3    if (tablxx .eq. 3) go to 13
c test whether any messages have been typed during this call of "xlitr8"
 4    if (tablxx .eq. 0) go to 5
c compare index = (chari) with previously typed indices
      do 6 i=1,tablxx
      if (chari .eq. tablx(i)) go to next, (18,13)
 6    continue
c type an error message
 5    call getfmt(45,.false.)
      write (ttyo,fmtbuf) chari
c store (chari) as an index
      tablxx = tablxx + 1
      tablx(tablxx) = chari
      go to next, (18,13)
      end
c subroutine copy copies from the rectangle defined by xcopy,ycopy,wcopy
c and hcopy into the rectangle defined by xtarg,ytarg,wtarg, and
c htarg.       only prob percentage of the squares of the target area
c are affected.  before copying, each rectangle is truncated, if neces-
c sary, by edges of the picture area, and the "from" area is reoriented
c as follows: 1= no reorientation, 2= rotate 90 degrees clockwise, 3=
c rotate180 degrees, 4= rotate 270 degrees clockwise; -1, -2, -3, and -4
c mean reflect left-right before corresponding clockwise rotation.  dont
c is a number which if found in the "from" area, means dont change the
c target area for this square.
c
c if after truncation and "reorientation" the target and copy-from areas
c are not the same size and shape, correspondence is asserted between
c lower left corners.  if the copy-from area is too long, in either
c direction, the excess is ignored; if it is too short, the copy-from
c area is used in modular fashion (i.e. effectively repeated) to fill
c the target region.  if either is entirely off the surface, no opera-
c tion is performed.
c
      subroutine copy(xtarg,ytarg,wtarg,htarg,prob,xcopy,ycopy,wcopy,
     c hcopy,orient,dont)
      implicit integer(a-z)
c specification of called functions
      logical qadj
c input parameters. target position and dimensions, square-by-square
c probability, copy-from position and dimensions, number not to copy.
      integer xtarg, ytarg, wtarg, htarg, prob, xcopy, ycopy, wcopy,
     c            hcopy, orient, dont
c parameters for scanning copy-from area
      integer stcorn, start, nomore, findex, beyond, wide, high
c switches that say whether error messages have been typed
      logical ermsg, ermsg2
c boundaries of the adjusted target rectangle, size
      integer tedge, bedge, ledge, redge
c boundaries of the adjusted copied rectangle
      integer ftop, fbot, fleft, fright
c switches set for not execute if either rectangle entirely off the
c surface, or invalid orientation.
      logical xecute, xecut2, xecut3
c adjusted probability (a legal value), 4 times this
      integer adjprb,probx4
c variables for random-skipping through table
      integer point, skip, del
c equivalent storage for numerical test for dont
      integer chari/0/
      logical charl
      equivalence (chari,charl)
c name of this subroutine
      logical*1 name(6)/'c','o','p','y',' ',' '/
c
c
c
      do 1 i=1,6
  1   caller(i)=name(i)
c test and adjust copy-from boundaries
      ermsg2= .not. qadj(xcopy,ycopy,wcopy,hcopy,100,adjprb,
     c       fleft,fright,fbot,ftop,xecut2,0)
c test and adjust target area boundaries
      ermsg = .not. qadj(xtarg,ytarg,wtarg,htarg,prob,adjprb,
     c      ledge,redge,bedge,tedge,xecute,0)
      xecut3=.true.
      if((orient.ge.(-4)).and.(orient.le.4).and.(orient.ne.0))go to 5
      call qttyo(85)
      xecut3= .false.
      go to 6
c test for any errors printed
  5   if((.not.ermsg).and.(.not.ermsg2))go to 7
c show user his actual call
 6    call getfmt(86,.false.)
      write (ttyo,fmtbuf) xtarg,ytarg,wtarg,htarg,prob,
     c  xcopy,ycopy,wcopy,hcopy,orient,dont
c ask the user what he wants to do next
      call qnowut
c test for instruction executable (both areas at least partially on
c surface, and valid orientation)
  7   if(.not.(xecute.and.xecut2.and.xecut3))go to 50
c initialize stcorn= starting corner of copy-from rectangle, nxtsq=
c index increment to next copy-from square, nxtln= index increment
c to next line
c orient has been tested and is assured to be -4 thru 4, but not 0
      orpl5= orient+5
      go to (24,23,22,21,50,11,12,13,14),orpl5
c copy-from orientation 1(straight copy)
  11  stcorn= (fbot-1)*pictx+fleft
      nxtsq=1
      nxtln=pictx
      go to 30
c
c copy-from orientation 2(rotate copied material 90 degrees clockwise)
  12  stcorn= (fbot-1)*pictx+fright
      nxtsq=pictx
      nxtln=-1
      go to 31
c
c copy-from orientation 3 (rotate copied material 180 degrees)
  13  stcorn= (ftop-1)*pictx+fright
      nxtsq=-1
      nxtln=-pictx
      go to 30
c
c copy-from orientation 4 (rotate copied stuff 270 degrees clockwise)
  14  stcorn= (ftop-1)*pictx+fleft
      nxtsq=-pictx
      nxtln=1
      go to 31
c
c copy-from orientation -1 (left-right flip)
  21  stcorn= (fbot-1)*pictx+fright
      nxtsq=-1
      nxtln=pictx
      go to 30
c
c copy-from orientation -2 (left-right flip, 90 degrees clockwise rotat)
  22  stcorn= (fbot-1)*pictx+fleft
      nxtsq=pictx
      nxtln=1
      go to 31
c
c copy-from orientation -3. (left-right flip, 180 degrees rotate)
  23  stcorn= (ftop-1)*pictx+fleft
      nxtsq=1
      nxtln=-pictx
      go to 30
c
c copy-from orientation -4 (left-right flip, rotate 270 degrees clockws)
  24  stcorn=(ftop-1)*pictx+fright
      nxtsq=-pictx
      nxtln=-1
      go to 31
c
c basic indexing scheme works across target area, as in other routines,
c from mindex to maxdex across a line, from bedge (in terms of 1-d
c string address) to tedge lines.  simultaneously, findex (=from index)
c crawls across the copy-from area, starting at "start" incrementing by
c nxtsq for the next square. if it reaches "beyond", it resets to start,
c thus using the copy-from area as a repeating module in this direction.
c for the next line, start is incremented by "nextln" to get to the
c starting point of the next line. if start reaches "nomore", it resets
c to stcorn (starting corner), thus using the area as a module in this
c direction. these are thus functions of orientation: stcorn, nxtsq,
c and nxtln.  in all cases, beyond and nomore can be computed from them.
c
  30  wide=fright-fleft+1
      high=ftop-fbot+1
      go to 35
  31  wide=ftop-fbot+1
      high=fright-fleft+1
  35  point=random(1,401,0)
      skip=random(0,399,0)
      del=random(1,397,0)
      probx4=adjprb*4+adjprb/51
      start=stcorn
      nomore=stcorn+(nxtln*high)
      bedge=(bedge-1)*pictx+1
      tedge=(tedge-1)*pictx+1
c
      do 45 y=bedge,tedge,pictx
      mindex=y+ledge-1
      maxdex=y+redge-1
      skip=mod(skip+del,400)
      beyond=start+(wide*nxtsq)
      findex=start
c
      do 40 index=mindex,maxdex
      point=mod(point+skip,401)+1
      charl=string(findex)
      if(probx4.ge.ranseq(point).and.chari.ne.dont)string(index)=charl
      findex=findex+nxtsq
      if(findex.eq.beyond)findex=start
  40  continue
      start=start+nxtln
      if(start.eq.nomore)start=stcorn
  45  continue
  50  return
      end
c the first 4 parameters define a rectangle.  the rectangle is adjusted
c to be within the picture and not to include any of the margin squares
c of the picture.  "prob" is a percentage probability between 0 and 100
c applied separately to each square (x,y) in the rectangle, determining
c whether transliteration is to be executed on the square.
c another test, based on properties of the neighboring squares of
c square (x,y), must be satisfied before the contents of square (x,y)
c can be transliterated.  only those neighbors are considered whose
c directions relative to (x,y) are as specified in parameter "dirset".
c the contents of each of these neighbors is examined to determine
c whether it lies within the inclusive interval specified by the
c absolute values of parameters "minval" and "maxval".  a count is taken
c of such neighbors.  the algebraic sign of parameter "minval" is used
c as a switch.  if the sign is +, the neighbors whose values lie within
c the interval are counted.  if the sign is -, the neighbors whose
c values lie outside the interval are counted.  the sign of parameter
c "maxval" is ignored.  the absolute value of "minval" must be less than
c or equal to the absolute value of "maxval".
c when the count has been formed for all the specified neighbors of
c square (x,y), a test is made to determine whether the count lies
c within the inclusive range specified by the absolute values of
c parameters "minnum" and "maxnum".  the algebraic sign of parameter
c "minnum" is used as a switch.  if the sign is +, transliteration is
c executed on square (x,y) only if the count lies within the range.  if
c the sign is -, transliteration is executed on square (x,y) only if the
c count lies outside the range.  the sign of parameter "maxnum" is
c ignored.  the absolute value of "minnum" must be less than or equal to
c the absolute value of "maxnum".
c parameter "table" is the name of a 1-dimensional integer array
c containing a transliteration table.  the transliteration table may be
c of any length, but if it is too short for the numeric values of the
c characters being transliterated, garbage may be stored in the picture.
c for each square transliterated, the numeric value (call it "oldval")
c of the character previously occupying the square is used as an index
c into the transliteration table.  the character stored at table entry
c number (oldval+1) is copied back into the square.
c
c
c
      subroutine locop(xcentr,ycentr,width,height,prob,minnum,maxnum,
     c dirset,minval,maxval,table)
      implicit integer (a-z)
      integer table(1024)
c
c specifications of called functions
      logical qadj
c height, adjusted to be within the picture
      integer hadj
c boundaries of the rectangle
      integer ledge,redge,bedge,tedge
c switch determines whether to type an error message showing all the
c input parameters
      logical ermsg
c switch determines whether actual parameters allow subroutine execution
      logical xecute
c probability adjusted to legal value
      integer adjprb
c switch indicates 100% probability
      logical doall
c indices of transliteration table entries which are not characters
      integer tablx(3)
c index of indices of transliteration table entries
      integer tablxx
c a copy of the direction set, to be decomposed
      integer decomp
c numbers specifying the directions
      integer direct(3,3) /400,200,100,40,20,10,4,2,1/
c max. direction values before decomposition
      integer maxb4(3) /777,77,7/
c string address displacements of neighbors specified by the user
      integer nabor(9)
c count of the number of neighbors specified by the user
      integer nabors
c switch determines whether a test of neighbors is necessary; if the
c switch is .false., any number (including 0) of neighbors having values
c within the specified interval would satisfy the test
      logical natest
c count of the number of neighbors having values within the specified
c interval
      integer within
c min. and max. numbers of neighbors which must have values within the
c specified interval (for inclusive intervals) or outside the specified
c interval (for exclusive intervals), to satisfy the test; variables
c adjusted to non-negative values; these variables contain garbage if no
c test is necessary
      integer minbor,maxbor
c switch for inclusive or exclusive number of neighbors
      logical incbor
c switch determines whether a test of the interval is necessary; if the
c switch is .false., all neighbors have values within the interval
      logical intest
c lower and upper bounds of the interval, adjusted to non-negative
c values; these variables contain garbage if no test is necessary
      integer lbound,ubound
c switch for inclusive or exclusive interval
      logical incval
c counts of consecutive error messages
      integer naber/1/, direr/1/, inter/1/
c variables for random-skipping through table
      integer point,skip,del
c four times adjusted probability
      integer probx4
c equivalent storage for numerical operations on character values
      integer chari/0/, entryi/0/
      logical charl,entryl
      equivalence (chari,charl), (entryi,entryl)
c name of this subroutine
      logical*1 name(6) /'l', 'o', 'c', 'o', 'p', ' '/
c
c
c
      do 1 i=1,6
 1    caller(i) = name(i)
c adjust boundaries, test for absence of error message
      ermsg = .not. qadj(xcentr,ycentr,width,height,prob,adjprb,
     c   ledge,redge,bedge,tedge,xecute,1)
c decompose the direction set
      if (dirset .lt. 0) go to 3
      decomp = dirset
      nabors = 0
      do 2 dy=1,3
c test for illegal direction specification
      if (decomp .gt. maxb4(dy)) go to 3
      do 2 dx=1,3
      if (decomp .lt. direct(dx,dy)) go to 2
      decomp = decomp - direct(dx,dy)
      nabors = nabors + 1
      nabor(nabors) = (2-dy)*pictx + (dx-2)
 2    continue
c reset error count
      direr = 1
c test and adjust the min. and max. number of neighbors
 12   natest = .true.
      minbor = iabs(minnum)
      maxbor = iabs(maxnum)
      incbor = (minnum .ge. 0)
      if (minbor .gt. maxbor) go to 4
      if (minbor .gt. nabors) go to 5
      if ((maxbor .gt. nabors) .and. incbor) go to 6
      if ((maxbor .ge. nabors) .and. .not. incbor) go to 7
      if ((minbor .eq. 0) .and. (maxbor .eq. nabors) .and. incbor)
     c   natest = .false.
c reset error count
      naber = 1
c test and adjust the specified interval
 14   intest = .true.
      temp = chars - 1
      lbound = iabs(minval)
      ubound = iabs(maxval)
      incval = (minval .ge. 0)
      if (lbound .gt. ubound) go to 8
      if (lbound .ge. chars) go to 9
      if ((ubound .ge. chars) .and. incval) go to 10
      if ((ubound .ge. temp) .and. .not. incval) go to 11
      if ((lbound .eq. 0) .and. (ubound .eq. temp) .and. incval)
     c   intest = .false.
c reset error count
      inter = 1
c test for special cases which cannot be satisfied
 18   xecute = xecute .and. .not.
     c   (((nabors.eq.0).and.(minbor.gt.0).and.natest.and.incbor) .or.
     c   ((.not.intest).and.natest.and.
     c   (((maxbor.eq.0).and.(nabors.gt.0).and.incbor) .or.
     c   ((minbor.eq.1).and.(maxbor.eq.nabors).and.(.not.incbor)))))
c if illegal parameters caused any error messages, show the user his
c actual call
      if (ermsg) go to 21
 22   if (.not. xecute) go to 23
c set initial values for table skipping
      point = random(1,401,0)
      skip = random(0,399,0)
      del = random(1,397,0)
      probx4 = 4*adjprb + adjprb/51
      doall = (adjprb .eq. 100)
c reset index of indices
      tablxx = 0
c for efficient execution, set up loops using the string equivalent
c addresses of squares in the rectangle.  this allows single indexing in
c the innermost loop, where array addresses would require double
c indexing.
      hadj = (tedge-bedge)*pictx + 1
      tedge = (tedge-1)*pictx + 1
      do 24 dy=1,hadj,pictx
      mindex = tedge - dy + ledge
      maxdex = tedge - dy + redge
c change skip distance
      skip = mod(skip+del,400)
      do 24 index=mindex,maxdex
c test whether to process this square
      if (doall) go to 25
      point = mod(point+skip,401) + 1
      if (ranseq(point) .ge. probx4) go to 24
c examine neighboring squares
 25   if (.not. natest) go to 26
      within = 0
c execution cannot pass through here if nabors=0
c separate loops for inclusive or exclusive intervals
      if (incval) go to 31
      do 27 i=1,nabors
      charl = string(index+nabor(i))
      if ((chari .lt. lbound) .or. (chari .gt. ubound))
     c   within = within + 1
 27   continue
      go to 32
 31   do 33 i=1,nabors
      charl = string(index+nabor(i))
      if ((chari .ge. lbound) .and. (chari .le. ubound))
     c   within = within + 1
 33   continue
c determine whether an acceptable number of neighboring squares satisfy
c the interval conditions
 32   if ((incbor.and.((within.lt.minbor).or.(within.gt.maxbor))) .or.
     c   ((.not.incbor).and.(within.ge.minbor).and.(within.le.maxbor)))
     c   go to 24
c transliterate square picher(x,y) = string(index)
 26   charl = string(index)
      entryi = table(chari+1)
c only the rightmost bits are stored
      string(index) = entryl
c test whether the transliteration table entry was a character
      if ((entryi .lt. 0) .or. (entryi .ge. chars)) go to 30
 24   continue
 23   return
c process illegal direction set
 3    xecute = .false.
c test error count
      if (direr .gt. maxmsg) go to 12
      direr = direr + 1
      ermsg = .true.
      call qttyo(54)
      go to 12
c neighbor error: minbor>maxbor
 4    i = 55
c test error count
 15   if (naber .gt. maxmsg) go to 13
      naber = naber + 1
      ermsg = .true.
      call qttyo(i)
 13   xecute = xecute .and. .not. incbor
      natest = .false.
      go to 14
c neighbor error: minbor>nabors
 5    i = 56
      go to 15
c neighbor error: maxbor>nabors for an inclusive number of neighbors
 6    maxbor = nabors
      i = 57
c test error count
 16   if (naber .gt. maxmsg) go to 14
      naber = naber + 1
      ermsg = .true.
      call qttyo(i)
      go to 14
c neighbor error: maxbor.ge.nabors for an exclusive number of neighbors
 7    incbor = .true.
      maxbor = minbor - 1
      minbor = 0
      i = 58
      go to 16
c interval error: lower bound > upper bound
c test error count
 8    if (inter .gt. maxmsg) go to 17
      call qttyo(59)
 19   inter = inter + 1
      ermsg = .true.
 17   xecute = xecute .and. .not. incval
      intest = .false.
      go to 18
c interval error: lower bound .ge. chars
c test error count
 9    if (inter .gt. maxmsg) go to 17
c passing character size to the error message allows this code to run
c unchanged on computers with different character sizes
      call getfmt(80,.false.)
      write (ttyo,fmtbuf) temp
      go to 19
c interval error: upper bound .ge. chars for an inclusive interval
 10   ubound = temp
      i = 81
c test error count
 20   if (inter .gt. maxmsg) go to 18
      inter = inter + 1
      ermsg = .true.
c passing character size to the error message allows this code to run
c unchanged on computers with different character sizes
      call getfmt(i,.false.)
      write (ttyo,fmtbuf) temp
      go to 18
c interval error: upper bound .ge. chars-1 for an exclusive interval
 11   incval = .true.
      ubound = lbound - 1
      lbound = 0
      i = 82
      go to 20
c at least one error message preceded this.  show the user his actual
c call.
 21   call getfmt(83,.false.)
      write (ttyo,fmtbuf) xcentr,ycentr,width,height,prob,
     c   minnum,maxnum,dirset,minval,maxval
c ask the user what he wants to do next
      call qnowut
      go to 22
c an illegal transliteration table entry was encountered.  test whether
c to type an error message.
 30   if (tablxx .eq. 3) go to 24
c test whether any messages have been typed during this call of "locop"
      if (tablxx .eq. 0) go to 28
c compare index = (chari) with previously typed indices
      do 29 i=1,tablxx
      if (chari .eq. tablx(i)) go to 24
 29   continue
c type an error message
 28   call getfmt(84,.false.)
      write (ttyo,fmtbuf) chari
c store (chari) as an index
      tablxx = tablxx + 1
      tablx(tablxx) = chari
      go to 24
      end
c fleck fills indicated percentage (probability) of squares in specified
c rectangle with numbers from range min thru max.  normal values for
c min and max are zero thru maximum character for the machine, with min
c less than or equal to max.  if either is negative, the absolute value
c is taken; if min greater than max, their roles are reversed.
c
c
c
      subroutine  fleck(xcentr,ycentr,width,height,prob,minmum,maxmum)
      implicit integer (a-z)
c
c specifications of called functions
      logical qadj
