h65089
s 00049/00069/00152
d D 1.6 83/03/30 22:46:36 mjb 6 5
c changed clipping
e
s 00035/00023/00186
d D 1.5 83/03/02 11:29:25 tes 5 4
c modified clipping for speedup on 8086
e
s 00021/00014/00188
d D 1.4 83/02/17 15:07:09 tes 4 3
c made fonts integer*4 when clipping and determining string length
e
s 00001/00001/00201
d D 1.3 83/02/03 15:54:26 mjb 3 2
c fixed common name collision
e
s 00041/00015/00161
d D 1.2 83/01/20 21:02:02 tes 2 1
c Added polyline buffer and adjusted interface to hshlng (added font)
e
s 00176/00000/00000
d D 1.1 83/01/20 10:46:31 tes 1 0
c date and time created 83/01/20 10:46:31 by tes
e
u
tes
mjb
U
t
T
I 1
subroutine hshtxt (font, string, x, y)
D 2
integer string(1)
E 2
I 2
SHORTINT string(1)
E 2
integer font, x, y

I 5
SHORTINT lclstr(2)
E 5
integer hshrec, upe64w, i, bp
integer nw, f, ch, hx, hy, w
D 6
integer action, xsize, ysize, scx, scy
E 6
I 6
integer action, xsize, ysize
E 6
I 2
integer inttyp, contrl(3), dummy
I 5
D 6
integer chkclp, kclip
integer hshclp
E 6
E 5

E 2
D 4
real xoff, yoff
real lx, ly, cx, cy
E 4
I 4
D 5
LONGINT xoff, yoff
LONGINT lx, ly, cx, cy
E 5
I 5
D 6
real xoff, yoff, rtemp
real lx, ly, cx, cy
E 6
I 6
integer lx, ly, cx, cy
E 6
E 5
E 4
D 2
integer buf(100)
E 2

include(`hshcom')

D 2
f = font + 1
if (f < 1) f=1
E 2
I 2
data inttyp /1/   # polyline type of solid
I 5
data lclstr /NUL, NUL/
E 5


contrl(1) = 15  # set polyline type
call gzddop (contrl, inttyp, dummy, dummy, dummy)

contrl(1) = 17  # set polyline color index
call gzddop (contrl, hcolor, dummy, dummy, dummy)

f = font
if (f < 0) f=0
E 2
if (f > nfonts) f = nfonts - 1
i = 1
I 2

E 2
while (string(i) != 0) {
   ch = string(i)
D 2
   nw = hshrec (f-1, ch, buf) - 1
E 2
I 2
   nw = hshrec (f, ch) - 1
E 2
   if (i == 1) {
I 4
D 6

D 5
      # position for outout of string according to current size and
E 5
I 5
      # position for output of string according to current size and
E 5
      # justification
E 6
E 4
      xsize = hsize*cfscal
      ysize = vsize*cfscal
      cx = x
D 6
      cy = y - cfbase*ysize
D 2
      call hshlng (string, xoff, yoff)
      lx = cx - ((float(hjust)/100.)*xoff)*xsize
      ly = cy - ((float(vjust)/100.)*yoff)*ysize
E 2
I 2
      call hshlng (f, string, xoff, yoff)
D 4
      lx = cx - ((float(hjust)/100.)*xoff)*hsize
      ly = cy - ((float(vjust)/100.)*yoff)*vsize
E 4
I 4
D 5
      lx = cx - (hjust*xoff)/100
      ly = cy - (vjust*yoff)/100
E 5
I 5
      lx = cx - (hjust*xoff)/100.
      ly = cy - (vjust*yoff)/100.
E 5
E 4
E 2
      scx = lx
      scy = ly
      call hshmov (scx, scy)
I 5
      kclip = 0
      chkclp = hshclp (1, lx, ly) + hshclp (1, lx+xoff, ly+yoff)
E 6
I 6
      cy = y
      lx = cx
      ly = cy
      call hshmov (cx, cy)
E 6
E 5
      }
   i = i + 1
   if (nw > 0 & nw < 100) {
I 5
D 6
      if (chkclp != 0) {
         lclstr(1) = ch
         call hshlng (f, lclstr, xoff, yoff)
	 kclip = hshclp (1, lx, ly) + hshclp (1, lx+xoff, ly+yoff)
	 }
E 6
E 5
      bp = 2
      while(nw > 0) {
D 2
         w = buf(bp)
E 2
I 2
         w = chrbuf(bp)
E 2
	 bp = bp + 1
	 nw = nw - 1
	 action = upe64w (w, hx, hy)
	 hx = hx*xsize
	 hy = hy*ysize
	 if (action == 0) {
	    lx = lx + hx
	    ly = ly + hy
D 4
	    scx = lx
	    scy = ly
	    call hshmov (scx, scy)
E 4
I 4
D 5
	    if (lx <= 32767 & lx >= 0) {
	       if (ly <= 32767 & ly >= 0) {
	          scx = lx
	          scy = ly
	          call hshmov (scx, scy)
		  }
E 5
I 5
D 6
            if (hshclp (kclip, lx, ly) == 0) {
	       scx = lx
	       scy = ly
	       call hshmov (scx, scy)
E 5
	       }
E 6
I 6
	    call hshmov (lx, ly)
E 6
E 4
	    }
D 5
	 else {
E 5
I 5
         else {
E 5
	    cx = lx + hx
	    cy = ly + hy
D 4
	    if (lx < 32767. & lx > 0.) {
	       if (ly < 32767. & ly > 0.) {
		  if (cx < 32767. & cx > 0.) {
                     if (cy < 32767. & cy > 0.) {
E 4
I 4
D 5
	    if (lx <= 32767 & lx >= 0) {
	       if (ly <= 32767 & ly >= 0) {
		  if (cx <= 32767 & cx >= 0) {
                     if (cy <= 32767 & cy >= 0) {
E 4
			scx = cx
			scy = cy
			call hshdrw (scx, scy)
			}
                     }
		  }
E 5
I 5
D 6
            if (hshclp (kclip, lx, ly) == 0 & hshclp (kclip, cx, cy) == 0) {
               scx = cx
               scy = cy
               call hshdrw (scx, scy)
E 5
               }
E 6
I 6
            call hshdrw (cx, cy)
E 6
	    lx = cx
	    ly = cy
	    }
         }
      }
   }
return
end
I 5
D 6
integer function hshclp (clip, x, y)
integer clip
real x, y
E 6
I 6
subroutine hshfnt (font)
integer font
E 6

D 6
if (clip != 0)
   if ((x < 0.0 | x > 32767.) | (y < 0.0 | y > 32767.)) return (-1)
E 6
I 6
integer f, i, hshrec
E 6

I 6
include(`hshcom')

f = font
if (f < 0) f = 0
else if (f > nfonts) f = nfonts - 1
if (f != chfont) i = hshrec (f, 0)

return
end
integer function hshclp (x, xmin, xmax)
real x, xmin, xmax

   if (x < xmin | x > xmax) return (-1)

E 6
return (0)
end
I 6
integer function hshwid (char)
SHORTINT char

integer j, upe64w, wid1, wid2

include(`hshcom')

   j = 3 + char/2
   j = upe64w (fnttbl(j), wid1, wid2)
   if (mod(char,2) == 0) j = wid1
   else                  j = wid2
   hshwid = j*cfscal*hsize

return
end
integer function hshhgt (dummy)
integer dummy

include(`hshcom')

   hshhgt = (cftop - cfbase)*cfscal*vsize

return
end
E 6
E 5
subroutine hshmov (x, y)
integer x, y
include(`hshcom')

D 2
if (vecknt > 1) call hshdmp
E 2
I 2
if (vecknt > 0) call hshdmp
E 2
call hshdrw (x, y)

return
end
subroutine hshdrw (x, y)
integer x, y, i
include(`hshcom')

D 2
if (vecknt >= MAXxVECTOR) call hshdmp
E 2
I 2
if (vecknt >= MAXxVECTOR) {
   call hshdmp
   vecknt =1
   i = (MAXxVECTOR-1)*2 + 1
   vecbuf(1) = vecbuf(i)
   vecbuf(2) = vecbuf(i+1)
   }
E 2
vecknt = vecknt + 1
i = (vecknt-1)*2 + 1
vecbuf(i) = x
vecbuf(i+1) = y

return
end
subroutine hshdmp
integer contrl(6), intin(1), intout(1), ptsout(1)
include(`hshcom')

data contrl /6, 2, 0, 0, 0, 0/

if (vecknt > 1) {
   contrl(2) = vecknt
   call gzddop (contrl, intin, vecbuf, intout, ptsout)
   }
vecknt = 0
D 6

return
end
D 2
subroutine hshlng (string, xoff, yoff)
integer string(1)
E 2
I 2
subroutine hshlng (font, string, xoff, yoff)
integer font
SHORTINT string(1)
E 2
D 4
real xoff, yoff
E 4
I 4
D 5
LONGINT xoff, yoff
E 5
I 5
real xoff, yoff
E 5
E 4

D 2
integer chr, i, j, upe64w, wid1, wid2
E 2
I 2
integer chr, i, f, j, upe64w, wid1, wid2
integer hshrec
E 2

include(`hshcom')

I 2
f = font
if (f < 0) f=0
if (f > nfonts) f = nfonts - 1
D 3
if (f != cfont) 
E 3
I 3
if (f != chfont) 
E 3
   i = hshrec (font, 0)

E 2
xoff = 0.
yoff = 0.
i = 1
while (string(i) != NUL) {
   chr = string(i)
   j = 3 + chr/2
   j = upe64w (fnttbl(j), wid1, wid2)
   if (mod(chr,2) == 0) xoff = xoff + wid1
   else                 xoff = xoff + wid2
   i = i + 1
   }
D 2
yoff = cftop - cfbase
E 2
I 2
D 4
xoff = xoff*cfscal
yoff = (cftop - cfbase)*cfscal
E 4
I 4
xoff = xoff*cfscal*hsize
yoff = (cftop - cfbase)*cfscal*vsize
E 6
E 4
E 2

return
end
subroutine hshsiz (x, y)
integer x, y

include(`hshcom')

if (x >= 1 & x <=100) {
   if (y >= 1 & y <= 100) {
      hsize = x
      vsize = y
      }
   }
return
end
subroutine hshclr (color)
integer color

include(`hshcom')

if (color >= 0) {
   hcolor = color
   }

return
end
subroutine hshjst (horiz, vert)
integer horiz, vert

include(`hshcom')

if (horiz >= 0 & horiz <=100) {
   if (vert >= 0 & vert <= 100) {
      hjust = horiz
      vjust = vert
      }
   }

return
end
subroutine hshrot (rotat)
real rotat

include(`hshcom')

rotatn = rotat

return
end
E 1
