h26901
s 00002/00002/00151
d D 1.8 83/03/30 22:43:48 mjb 8 7
c changed clipping 
e
s 00001/00000/00152
d D 1.7 83/03/02 18:22:48 tes 7 6
c modified to display a currently selected text string
e
s 00007/00009/00145
d D 1.6 83/02/17 15:02:46 tes 6 5
c fixed text picking problems, mostly problems with hershey interface
e
s 00059/00059/00095
d D 1.5 83/02/02 19:43:01 tes 5 4
c added integer to byte packing and unpacking
e
s 00002/00001/00152
d D 1.4 83/01/29 16:37:50 tes 4 3
c Fixed typo in deltxt, string location was set to 16 versus 6
e
s 00005/00005/00148
d D 1.3 83/01/29 14:30:28 mjb 3 2
c made changes to anocom, included in gphcom
e
s 00001/00001/00152
d D 1.2 83/01/28 20:31:30 mjb 2 1
c put in error reporting
e
s 00153/00000/00000
d D 1.1 83/01/24 18:01:32 tes 1 0
c date and time created 83/01/24 18:01:32 by tes
e
u
tes
mjb
U
t
T
I 1
subroutine deftxt (x, y, string)
integer x, y
SHORTINT string(1)
integer i, j, k, length
integer tmpx, tmpy

D 3
include(`anocom')
E 3
I 3
include(`gphcom')
E 3

i = 1
while (anobuf(i) != NUL) {
   i = i + anobuf(i)
   }
D 2
if (i > 990) stop 9876
E 2
I 2
D 5
if (i > 990) call errmsg (PAUSE, ANOBUFxERROR)
E 2

k = i
if (x > 26624) x = 26600
anobuf(i+1) = x
if (y < 6827) y = 6827
anobuf(i+2) = y
anobuf(i+3) = tfont
anobuf(i+4) = tcolor
anobuf(i+5) = tsize
i = i + 5
length = 7
j = 1
while (string(j) != NUL) {
   length = length + 1
   i = i + 1
   anobuf(i) = string(j)
   j = j + 1
E 5
I 5
if (i > 980) call errmsg (PAUSE, ANOBUFxERROR)
else {
   k = i
D 8
   if (x > 26624) x = 26600
E 8
I 8
   if (x > 26542) x = 26522
E 8
   call pack2b (x, anobuf(i+TEXTxITEMxX))
D 8
   if (y < 6827) y = 6827
E 8
I 8
   if (y < 6882) y = 6882
E 8
   call pack2b (y, anobuf(i+TEXTxITEMxY))
   anobuf(i+TEXTxITEMxFONT) = tfont
   anobuf(i+TEXTxITEMxCOLOR) = tcolor
   anobuf(i+TEXTxITEMxSIZE) = tsize
   i = i + TEXTxITEMxSTRING
   length = TEXTxITEMxSTRING + 1   # Add one for NUL terminator
   j = 1
   while (string(j) != NUL) {
      anobuf(i) = string(j)
      length = length + 1
      i = i + 1
      j = j + 1
      }
   anobuf(i) = NUL
   anobuf(k) = length
   cfont = tfont
   ccolor = tcolor
   call qstgsz (tsize, tmpx, tmpy)
   call qgtext (x, y, string)
I 7
   call anstat (k)
E 7
E 5
   }
D 5
anobuf(i+1) = NUL
anobuf(k) = length
cfont = tfont
ccolor = tcolor
call qstgsz (tsize, tmpx, tmpy)
call qgtext (x, y, string)
E 5

return
end
subroutine fndtxt (x, y, id)
integer x, y, id
D 6
integer i, lx, ly, xtext, ytext, length
E 6
I 6
integer i, xtext, ytext, length
E 6
D 5
integer xtemp, ytemp, size
E 5
I 5
integer xtemp, ytemp, size, unpk2b
E 5
real xmax, ymax

D 3
include(`anocom')
E 3
I 3
include(`gphcom')
E 3

i = 1
id = 0
D 6
lx = x/2
ly = y/2
E 6
repeat {
   if (anobuf(i) == NUL) break
D 5
   length = anobuf(i) - 7
   xtext = anobuf(i+1)/2
   ytext = anobuf(i+2)/2
   cfont = anobuf(i+3)
   size = anobuf(i+5)
E 5
I 5
   length = anobuf(i) - TEXTxITEMxSTRING
D 6
   xtext = unpk2b (anobuf(i+TEXTxITEMxX))/2
   ytext = unpk2b (anobuf(i+TEXTxITEMxY))/2
E 6
I 6
   xtext = unpk2b (anobuf(i+TEXTxITEMxX))
   ytext = unpk2b (anobuf(i+TEXTxITEMxY))
E 6
   cfont = anobuf(i+TEXTxITEMxFONT)
   size = anobuf(i+TEXTxITEMxSIZE)
E 5
   call qstgsz (size, xtemp, ytemp)
D 6
   xmax = float(xtext) + (length*float(xtemp))/2
   ymax = float(ytext) + ytemp/2
   if (xtext <= lx & float(lx) <= xmax) {
      if (ytext <= ly & float(ly) <= ymax) {
E 6
I 6
   xmax = float(xtext) + (length-1)*xtemp
   ymax = float(ytext) + ytemp
   if (xtext <= x & float(x) <= xmax) {
      if (ytext <= y & float(y) <= ymax) {
E 6
	 id = i
	 break
	 }
      }
D 5
   i = i + length + 7
   } until (i > 990)
E 5
I 5
   i = i + length + TEXTxITEMxSTRING
   } until (i > 980)
E 5

return
end
subroutine deltxt (id)
integer id
D 5
integer temp, i, j, length, x, y
E 5
I 5
integer temp, i, j, length, x, y, unpk2b
E 5

D 3
include(`anocom')
E 3
I 3
include(`gphcom')
E 3

# remove text from display
D 5
cfont = anobuf(id+3)
temp = anobuf(id+5)
E 5
I 5
cfont = anobuf(id+TEXTxITEMxFONT)
temp = anobuf(id+TEXTxITEMxSIZE)
E 5
call qstgsz (temp, x, y)

D 5
x = anobuf(id+1)
y = anobuf(id+2)
D 4
call eragtx (x, y, anobuf(id+16))
E 4
I 4
call eragtx (x, y, anobuf(id+6))
E 5
I 5
x = unpk2b (anobuf(id+TEXTxITEMxX))
y = unpk2b (anobuf(id+TEXTxITEMxY))
call eragtx (x, y, anobuf(id+TEXTxITEMxSTRING))
E 5
E 4

I 4
# squish the memory used by the deleted element
E 4
j = id
length = anobuf(id)
for (i=id + length; i<=1000; i=i+1) {
   anobuf(j) = anobuf(i)
   j = j + 1
   }

return
end
subroutine movtxt (id, xnew, ynew, xpick, ypick)
integer id, xnew, ynew, xpick, ypick
D 5
integer size, x, y, xtemp, ytemp
E 5
I 5
integer size, x, y, xtemp, ytemp, unpk2b
E 5

D 3
include(`anocom')
E 3
I 3
include(`gphcom')
E 3

D 5

E 5
# remove the current text
D 5
cfont = anobuf(id+3)
size = anobuf(id+5)
E 5
I 5
cfont = anobuf(id+TEXTxITEMxFONT)
size = anobuf(id+TEXTxITEMxSIZE)
E 5
call qstgsz (size, x, y)
D 5
x = anobuf(id+1)
y = anobuf(id+2)
call eragtx (x, y, anobuf(id+6))
E 5
I 5
x = unpk2b (anobuf(id+TEXTxITEMxX))
y = unpk2b (anobuf(id+TEXTxITEMxY))
call eragtx (x, y, anobuf(id+TEXTxITEMxSTRING))
E 5

# appear the text in the new position
ccolor = tcolor
call qstgsz (size, xtemp, ytemp)
if (ynew < 6882) ynew = 6882
x = xnew - (xpick - x)
y = ynew - (ypick - y)
D 5
call qgtext (x, y, anobuf(id+6))
E 5
I 5
call qgtext (x, y, anobuf(id+TEXTxITEMxSTRING))
E 5

D 5
anobuf(id+1) = x
anobuf(id+2) = y
E 5
I 5
call pack2b (x, anobuf(id+TEXTxITEMxX))
call pack2b (y, anobuf(id+TEXTxITEMxY))
E 5

return
end
subroutine chgtxt (id)
integer id
D 5
integer size, tmpx, tmpy, x, y
E 5
I 5
integer size, tmpx, tmpy, x, y, unpk2b
E 5

D 3
include(`anocom')
E 3
I 3
include(`gphcom')
E 3

D 5
cfont = anobuf(id+3)
ccolor = anobuf(id+4)
size = anobuf(id+5)
E 5
I 5
cfont = anobuf(id+TEXTxITEMxFONT)
ccolor = anobuf(id+TEXTxITEMxCOLOR)
size = anobuf(id+TEXTxITEMxSIZE)
E 5

# remove the current text
call qstgsz (size, tmpx, tmpy)
D 5
x = anobuf(id+1)
y = anobuf(id+2)
call eragtx (x, y, anobuf(id+6))
E 5
I 5
x = unpk2b (anobuf(id+TEXTxITEMxX))
y = unpk2b (anobuf(id+TEXTxITEMxY))
call eragtx (x, y, anobuf(id+TEXTxITEMxSTRING))
E 5

D 5
anobuf(id+3) = tfont
anobuf(id+4) = tcolor
anobuf(id+5) = tsize
E 5
I 5
anobuf(id+TEXTxITEMxFONT) = tfont
anobuf(id+TEXTxITEMxCOLOR) = tcolor
anobuf(id+TEXTxITEMxSIZE) = tsize
E 5
cfont = tfont
ccolor = tcolor

# appear the text in the new position
call qstgsz (tsize, tmpx, tmpy)
D 5
call qgtext (x, y, anobuf(id+6))
E 5
I 5
call qgtext (x, y, anobuf(id+TEXTxITEMxSTRING))
E 5

return
end
E 1
