' qfigsub.bas

'$INCLUDE: 'QB.BI'
'rem $INCLUDE: 'C:\QB45\USERLIB\GRAPH.BI'
'REM $INCLUDE: 'MOUSE.BI'
'$INCLUDE: 'QFIG.BI'

FUNCTION Angle (x0, y0, x1, y1)
'                                                                    arc sin
Angle = 0!: a = 0!
rad = SQR((x1 - x0) ^ 2 + (y1 - y0) ^ 2)
IF rad = 0! THEN EXIT FUNCTION
IF x1 = x0 THEN
  a = SGN(y0 - y1) * pi / 2!
  IF a < 0! THEN a = a + 2! * pi
ELSE
  a = ATN((y1 - y0) / (x0 - x1))
  IF x1 > x0 AND a < 0! THEN
	a = a + 2! * pi
  ELSEIF x1 < x0 THEN
	a = a + pi
  END IF
END IF
Angle = a
'
END FUNCTION

SUB D.Circles (cx%, cy%, rad, ratio, sang, eang, clr%, thickness%, simple%, wpatt%)
'                                     circle/ellipse drawings with thickness
IF ratio > 0 THEN
  CIRCLE (cx%, cy%), INT(rad), clr%, , , ratio
  IF simple% <> 1 THEN
	IF ratio >= 1! THEN
	  rt1 = INT(rad): rt2 = INT(rad) / ratio
	ELSE
	  rt1 = ratio * INT(rad): rt2 = INT(rad)
	END IF
	IF thickness% > 0 THEN CIRCLE (cx%, cy%), INT(rad) - 1, clr%, , , (rt1 - 1) / (rt2 - 1)
	IF thickness% > 1 THEN CIRCLE (cx%, cy%), INT(rad) + 1, clr%, , , (rt1 + 1) / (rt2 + 1)
  END IF
  rrt1 = rad / ratio: rrt2 = rad
  IF ratio < 1! THEN rrt2 = rad * ratio: rrt1 = rad
  IF simple% = -1 THEN
	MaxMin cx% + rrt1, cy% + rrt2: MaxMin cx% - rrt1, cy% - rrt2
  END IF
ELSE
  sang1 = sang: eang1 = eang
  IF sang < 0 THEN sang1 = 0!: eang1 = 2! * pi
  CIRCLE (cx%, cy%), INT(rad), clr%, sang1, eang1, 1
  IF simple% <> 1 THEN
	IF thickness% > 0 THEN CIRCLE (cx%, cy%), INT(rad) - 1, clr%, sang1, eang1, 1
	IF thickness% > 1 THEN CIRCLE (cx%, cy%), INT(rad) + 1, clr%, sang1, eang1, 1
  END IF
  IF simple% = -1 THEN
	IF sang < 0 THEN
	  MaxMin cx% + rad, cy% + rad: MaxMin cx% - rad, cy% - rad
	ELSE
	  MaxMin cx% + rad * COS(sang), cy% - rad * SIN(sang)
	  MaxMin cx% + rad * COS(eang), cy% - rad * SIN(eang)
	  IF sang < eang THEN
		IF eang > pi / 2! AND sang < pi / 2! THEN MaxMin cx%, cy% - rad
		IF eang > pi AND sang < pi THEN MaxMin cx% - rad, cy%
		IF eang > 3! * pi / 2! AND sang < 3! * pi / 2! THEN MaxMin cx%, cy% + rad
	  ELSE
		MaxMin cx% + rad, cy%
		IF eang > pi / 2! OR (eang < pi / 2! AND sang < pi / 2!) THEN MaxMin cx%, cy% - rad
		IF eang > pi OR (eang < pi AND sang < pi) THEN MaxMin cx% - rad, cy%
		IF eang > 3! * pi / 2! OR (eang < 3! * pi / 2! AND sang < 3! * pi / 2!) THEN MaxMin cx%, cy% + rad
	  END IF
	END IF
  END IF
END IF
'
END SUB

SUB D.Lines (sx%, sy%, ex%, ey%, clr%, box%, thickness%, linetype%, filltype%, simple%)
'                             line/box drawings with thickness/linetype/fill
SELECT CASE box%
  CASE 0
	LINE (sx%, sy%)-(ex%, ey%), clr%, , ltp%(linetype%)
  CASE 1
	LINE (sx%, sy%)-(ex%, ey%), clr%, B, ltp%(linetype%)
  CASE 2
	LINE (sx%, sy%)-(ex%, ey%), 2, B
	IF filltype% <> 0 AND (sx% - ex%) * (sy% - ey%) <> 0 THEN
	  IF clr% <> 0 THEN
		PAINT ((sx% + ex%) / 2, (sy% + ey%) / 2), tlp$(filltype%), 2
	  ELSE
		PAINT ((sx% + ex%) / 2, (sy% + ey%) / 2), 0, 2
	  END IF
	END IF
	IF wkill% = 1 AND clr% = 0 THEN
	       LINE (sx%, sy%)-(ex%, ey%), clr%, BF
	       wkill% = 0
	ELSE
	       LINE (sx%, sy%)-(ex%, ey%), clr%, B
	END IF
END SELECT
IF simple% <> 1 AND thickness% <> 0 THEN
  SELECT CASE box%
	CASE 0
	  dx% = 1: dy% = 0
	  IF ABS(ex% - sx%) > ABS(ey% - sy%) THEN dx% = 0: dy% = 1
	  LINE (sx% - dx%, sy% - dy%)-(ex% - dx%, ey% - dy%), clr%, , ltp%(linetype%)
	  IF thickness% > 1 THEN
		LINE (sx% + dx%, sy% + dy%)-(ex% + dx%, ey% + dy%), clr%, , ltp%(linetype%)
	  END IF
	CASE ELSE
	  dx% = SGN(ex% - sx%): dy% = SGN(ey% - sy%)
	  a% = ltp%(linetype%): IF box% = 2 THEN a% = ltp%(0)
	  LINE (sx% + dx%, sy% + dy%)-(ex% - dx%, ey% - dy%), clr%, B, a%
	  IF thickness% > 1 THEN
		LINE (sx% - dx%, sy% - dy%)-(ex% + dx%, ey% + dy%), clr%, B, a%
	  END IF
  END SELECT
END IF
'
IF simple% = -1 THEN MaxMin sx%, sy%: MaxMin ex%, ey%
'
END SUB

SUB D.Strings (n%, clr%, simple%)
'                                                            display strings
sx% = xx(n%, 0): sy% = yy(n%, 0)
ipt = 0!: kanji% = 0: sylow% = 0: syhigh% = 0
IF simple% <> 1 THEN
  special% = 0: script% = 0                                 'KPUT is special
  WINDOW SCREEN (0, 0)-(windowx%(wndwfctr%), windowy%(wndwfctr%))
  wt% = obj%(n%, 1)
  IF wtext% = 1 THEN wt% = 1
  FOR i% = 1 TO wt%
  IF yy(n%, i%) = 0! THEN
	a$ = CHR$(xx(n%, i%))
	IF special% = 0 AND a$ = "\" THEN special% = 1: GOTO one.char.done
	IF INSTR("^\@_", a$) <> 0 THEN
	  IF special% = 0 AND INSTR("^@_", a$) <> 0 THEN
		SELECT CASE a$
		  CASE "^"
			script% = 1
			syhigh% = INT(scrpt(1) * obj%(n%, 4) + .9)
		  CASE "_"
			script% = 2
			sylow% = -INT(scrpt(2) * obj%(n%, 4) + .9)
		  CASE ELSE
			script% = 0
		END SELECT
		GOTO one.char.done
	  ELSE
		special% = 0
	  END IF
	ELSEIF special% = 1 THEN
	  special% = 0
	END IF
	IF ASC(a$) < &H20 OR ASC(a$) > &H7E THEN a$ = " "
	scriptsize = 1!: IF script% <> 0 THEN scriptsize = .7
	jpt = 8
  ELSE
	kanji% = 1
	a$ = STRING$(1, VAL("&j" + HEX$(yy(n%, i%)) + HEX$(xx(n%, i%))))
	jpt = CSNG(obj%(n%, 4) * jpitch%) / 250! * ptmm
  END IF
  ssx% = sx% + INT(ipt) - pxo%
  ssy% = sy% - INT(scrpt(script%) * obj%(n%, 4)) - pyo%
  ssx% = INT(CSNG(ssx%) / wndwxy(wndwfctr%))
  ssy% = INT(CSNG(ssy%) / wndwxy(wndwfctr%))
  IF ssx% + INT(jpt) > pxmax% - pxo% OR ssx% + INT(jpt) < pxmin% - pxo% THEN GOTO one.char.skipped
  IF ssy% > pymax% - pyo% OR ssy% < pymin% - pyo% THEN EXIT FOR
  IF clr% <> 0 THEN
	ptext ssx%, ssy%, a$, chattr%(obj%(n%, 5), 0), 0
  ELSE
	ptext ssx%, ssy%, a$, 0, 0
  END IF
one.char.skipped:
  ipt = ipt + jpt
one.char.done:
  NEXT i%                                                          'retrieve
  WINDOW SCREEN (pxo%, pyo%)-(pxo% + windowx%(wndwfctr%), pyo% + windowy%(wndwfctr%))
  IF simple% = -1 THEN
	MaxMin sx%, sy% - sylow%
	sysy = eheight(obj%(n%, 5)): IF kanji% = 1 THEN sysy = jheight(obj%(n%, 5))
	MaxMin sx% + INT(ipt), sy% + INT(sysy * obj%(n%, 4) * ptmm / .25) + syhigh%
  END IF
ELSE
  ipt = 0!: special% = 0: script% = 0
  FOR i% = 1 TO obj%(n%, 1)
  IF yy(n%, i%) = 0! THEN
	a$ = CHR$(xx(n%, i%))
	IF special% = 0 AND a$ = "\" THEN special% = 1: GOTO one.simple.done
	IF INSTR("^\@_", a$) <> 0 THEN
	  IF special% = 0 AND INSTR("^@_", a$) <> 0 THEN
		SELECT CASE a$
		  CASE "^"
			script% = 1
		  CASE "_"
			script% = 2
		  CASE ELSE
			script% = 0
		END SELECT
		GOTO one.simple.done
	  ELSE
		special% = 0
	  END IF
	ELSEIF special% = 1 THEN
	  special% = 0
	END IF
	IF ASC(a$) < &H20 OR ASC(a$) > &H7E THEN a$ = " "
	scriptsize = 1!: IF script% <> 0 THEN scriptsize = .7
	ipt = ipt + CSNG(INT(scriptsize * obj%(n%, 4)) * epitch%(obj%(n%, 5), ASC(a$) - &H20)) / 250! * ptmm
  ELSE
	ipt = ipt + CSNG(obj%(n%, 4) * jpitch%) / 250! * ptmm
	kanji% = 1
  END IF
one.simple.done:
  NEXT i%
  sysy = eheight(obj%(n%, 5)): IF kanji% = 1 THEN sysy = jheight(obj%(n%, 5))
  LINE (sx%, sy%)-(sx% + INT(ipt), sy% + INT(sysy * obj%(n%, 4) * ptmm / .25)), clr%, B
END IF
'
END SUB

SUB FillPattern
'                                          fill pattern set, silly isn't it?
fill% = fill% + 1: IF fill% > UBOUND(filler%) THEN fill% = 0
'
END SUB

SUB G.Addnode (o%, n%, editcc%)
'                                add one node when even-nodes curve is input
IF n% = 1 THEN
  x.new% = (xx(o%, 0) + xx(o%, 1)) / 2!: y.new% = (yy(o%, 0) + yy(o%, 1)) / 2!
  j% = 0
ELSE
  dist = 0!
  FOR i% = 0 TO n% - 1
  dist1 = SQR((xx(o%, i%) - xx(o%, i% + 1)) ^ 2 + (yy(o%, i%) - yy(o%, i% + 1)) ^ 2)
  IF dist1 > dist THEN j% = i%: dist = dist1
  NEXT i%: t% = 0: IF j% = n% - 1 THEN t% = 1
  x0% = xx(o%, j% - t%): y0% = yy(o%, j% - t%)
  x1% = xx(o%, j% + 1 - t%): y1% = yy(o%, j% + 1 - t%)
  x2% = xx(o%, j% + 2 - t%): y2% = yy(o%, j% + 2 - t%)
  G.XYparam x0%, y0%, x1%, y1%, x2%, y2%, ax, bx, cx, ay, by, cy
  t = CSNG(t%) + .5
  x.new% = ax * t * t + bx * t + cx: y.new% = ay * t * t + by * t + cy
END IF
FOR i% = n% TO j% + 1 STEP -1
xx(o%, i% + 1) = xx(o%, i%): yy(o%, i% + 1) = yy(o%, i%): NEXT i%
xx(o%, j% + 1) = x.new%: yy(o%, j% + 1) = y.new%
'***** Mark Closed Curve which was originally a Poly ****
IF editcc% = 1 THEN obj%(o%, 6) = j% + 1
'********************************************************
n% = n% + 1
FOR i% = 1 TO 3: obj%(o%, i%) = obj%(o%, i%) + 1: NEXT i%
'
END SUB

SUB G.Arc
'                                                                        arc
job% = 3
KeySwitch 0
'LOCATE line2%, 24: COLOR 11: PRINT kky$(4);
COLOR 7
SetInst job%
wx1% = 24 * 8 - 8
wx2% = 24 * 8 + 40
wy1% = line2% * texth% - texth%
wy2% = line2% * texth%
LINE (PMAP(wx1%, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 11, BF
ptext PMAP(wx1%, 2) + 19, PMAP(wy1%, 3) + 1, kky$(4), 0, 1
'
startarc:
DO
  CursorMotion keyin%
LOOP UNTIL keyin% <> 1
VIEW SCREEN (0, 0)-(windowx%(0), winpy%)
IF keyin% >= 3 THEN GOTO donearc
pxold% = px%: pyold% = py%
xx(nobj%, 0) = px%: yy(nobj%, 0) = py%
DO
  CursorMotion keyin%
  CursorDisplay px%, py%
  LINE (xx(nobj%, 0), yy(nobj%, 0))-(pxold%, pyold%), 0
  IF keyin% = 4 THEN CursorDisplay px%, py%: GOTO donearc
  LINE (xx(nobj%, 0), yy(nobj%, 0))-(px%, py%), 7
  pxold% = px%: pyold% = py%
  CursorDisplay px%, py%
LOOP UNTIL keyin% <> 1
xx(nobj%, 2) = px%: yy(nobj%, 2) = py%: ok% = 1
DO
  CursorMotion keyin%
  tol = SQR((xx(nobj%, 0) - xx(nobj%, 2)) ^ 2 + (yy(nobj%, 0) - yy(nobj%, 2)) ^ 2)
  tol1 = SQR((px% - xx(nobj%, 2)) ^ 2 + (py% - yy(nobj%, 2)) ^ 2)
  tol1 = tol1 + SQR((px% - xx(nobj%, 0)) ^ 2 + (py% - yy(nobj%, 0)) ^ 2) - tol
  IF tol <> 0 THEN tol = tol1 / tol
  CursorDisplay px%, py%
  IF ok% = 1 THEN
	LINE (xx(nobj%, 0), yy(nobj%, 0))-(xx(nobj%, 2), yy(nobj%, 2)), 0
  ELSE
	CIRCLE (x0, y0), rad, 0, r1, r3, 1
  END IF
  IF keyin% = 4 THEN CursorDisplay px%, py%: GOTO donearc
  IF tol < .001 THEN
	LINE (xx(nobj%, 0), yy(nobj%, 0))-(xx(nobj%, 2), yy(nobj%, 2)), 7
	ok% = 1
  ELSE
	ok% = 0
	a = xx(nobj%, 0) - px%: B = yy(nobj%, 0) - py%
	c = px% - xx(nobj%, 2): D = py% - yy(nobj%, 2)
	E = xx(nobj%, 0) ^ 2 - CSNG(px%) * CSNG(px%)
	f = yy(nobj%, 0) ^ 2 - CSNG(py%) * CSNG(py%)
	G = CSNG(px%) * CSNG(px%) - xx(nobj%, 2) ^ 2
	h = CSNG(py%) * CSNG(py%) - yy(nobj%, 2) ^ 2
	y0 = ((E + f) * c - (G + h) * a) / (B * c - D * a) / 2!
	IF a <> 0! THEN
	  x0 = (E + f - 2! * B * y0) / a / 2!
	ELSE
	  x0 = (G + h - 2! * D * y0) / c / 2!
	END IF
	rad = SQR((xx(nobj%, 2) - x0) ^ 2 + (yy(nobj%, 2) - y0) ^ 2)
	r3 = Angle(x0, y0, xx(nobj%, 2), yy(nobj%, 2))
	r1 = Angle(x0, y0, xx(nobj%, 0), yy(nobj%, 0))
	r2 = Angle(x0, y0, CSNG(px%), CSNG(py%))
	IF (r3 < r2 AND r2 < r1) OR ((r1 < r3) AND (r2 < r1 OR r3 < r2)) THEN
	  SWAP r1, r3: SWAP xx(nobj%, 0), xx(nobj%, 2)
	  SWAP yy(nobj%, 0), yy(nobj%, 2)
	END IF
	CIRCLE (x0, y0), rad, 7, r1, r3, 1
  END IF
  CursorDisplay px%, py%
LOOP UNTIL keyin% = 3
CursorDisplay px%, py%
IF ok% = 1 THEN
  LINE (xx(nobj%, 0), yy(nobj%, 0))-(xx(nobj%, 2), yy(nobj%, 2)), 0
ELSE
  CIRCLE (x0, y0), rad, 0, r1, r3, 1
END IF
CursorDisplay px%, py%
xx(nobj%, 0) = x0 + rad * COS(r1): yy(nobj%, 0) = y0 - rad * SIN(r1)
xx(nobj%, 1) = x0: yy(nobj%, 1) = y0
xx(nobj%, 2) = x0 + rad * COS(r3): yy(nobj%, 2) = y0 - rad * SIN(r3)
xx(nobj%, 3) = rad: yy(nobj%, 3) = r1: yy(nobj%, 4) = r3
obj%(nobj%, 0) = 6: obj%(nobj%, 1) = 4
obj%(nobj%, 2) = 2: obj%(nobj%, 3) = -1
obj%(nobj%, 4) = thick%: obj%(nobj%, 5) = 0: obj%(nobj%, 6) = 0
CursorDisplay px%, py%
SetObject nobj%, 7, 0
CursorDisplay px%, py%
nobj% = nobj% + 1
Object.Max.Check
GOTO startarc
'
donearc:
SetInst job%
KeySwitch 1
job% = 0
VIEW SCREEN (0, 0)-(windowx%(0), windowy%(0))
LINE (PMAP(wx1%, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 0, BF
LOCATE line2%, 24: COLOR 3: PRINT kky$(4); : COLOR 7
'
END SUB

SUB G.ArrowDirec (sobj%, snode%, n%)
'                                           calculate the direction of arrow
SELECT CASE fnoo%(sobj%)
  CASE 1
	IF snode% = 0 THEN
	  x3% = xx(sobj%, 1): y3% = yy(sobj%, 1)
	ELSE
	  x3% = xx(sobj%, obj%(sobj%, 1) - 1)
	  y3% = yy(sobj%, obj%(sobj%, 1) - 1)
	END IF
	GOSUB arrowarrow
  CASE 3
	k% = 0: t = .2: IF snode% <> 0 THEN k% = snode% - 2: t = 1.8
	x2% = xx(sobj%, k% + 2): y2% = yy(sobj%, k% + 2)
	x1% = xx(sobj%, k% + 1): y1% = yy(sobj%, k% + 1)
	x0% = xx(sobj%, k%): y0% = yy(sobj%, k%)
	G.XYparam x0%, y0%, x1%, y1%, x2%, y2%, ax, bx, cx, ay, by, cy
	x3% = ax * t * t + bx * t + cx: y3% = ay * t * t + by * t + cy
	GOSUB arrowarrow
  CASE 6
	x1% = xx(sobj%, snode%): y1% = yy(sobj%, snode%)
	s2 = yy(sobj%, 3) + 3! * pi / 2! + arcarrowd
	IF snode% <> 0 THEN s2 = yy(sobj%, 4) + pi / 2! - arcarrowd
END SELECT
arrow = arrowhead + darrowhead * obj%(n%, 4)
xx(n%, 2) = x1% - arrow * COS(s2 + arrowdirect)
yy(n%, 2) = y1% + arrow * SIN(s2 + arrowdirect)
xx(n%, 0) = x1% - arrow * COS(s2 - arrowdirect)
yy(n%, 0) = y1% + arrow * SIN(s2 - arrowdirect)
xx(n%, 1) = x1%: yy(n%, 1) = y1%
EXIT SUB
'
arrowarrow:
x1% = xx(sobj%, snode%): y1% = yy(sobj%, snode%)
IF x1% = x3% THEN
  s2 = SGN(y3% - y1%) * pi / 2!
ELSE
  s2 = ATN(CSNG(y3% - y1%) / CSNG(x1% - x3%))
  IF x1% < x3% THEN s2 = s2 + pi
END IF
RETURN
'
END SUB

SUB G.Arrows
'                                                                 set arrows
MarkEnds c%: IF c% = 0 THEN EXIT SUB
job% = 6
KeySwitch 0
SetInst job%
wx1% = 61 * 8 - 8
wx2% = 61 * 8 + 40
wy1% = line2% * texth% - texth%
wy2% = line2% * texth%
LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 11, BF
ptext PMAP(wx1%, 2) + 19, PMAP(wy1%, 3) + 1, kky$(8), 0, 1
'
startarrow:
selh% = 1
DO
  CursorMotion keyin%
LOOP UNTIL keyin% <> 1
IF keyin% = 4 THEN GOTO donearrow
sobj% = -1
FOR i% = 0 TO nobj% - 1
IF fnoo%(i%) <> 1 AND fnoo%(i%) <> 3 AND fnoo%(i%) <> 6 THEN GOTO nogetends
selh% = 0
dist = SQR((xx(i%, 0) - px%) ^ 2 + (yy(i%, 0) - py%) ^ 2)
IF dist < 3 THEN snode% = 0: sobj% = i%: EXIT FOR
dist = SQR((xx(i%, obj%(i%, 2)) - px%) ^ 2 + (yy(i%, obj%(i%, 2)) - py%) ^ 2)
IF dist < 3 THEN snode% = obj%(i%, 2): sobj% = i%: EXIT FOR
nogetends: NEXT i%
IF sobj% < 0 THEN GOTO startarrow
G.Arrowset sobj%, snode%, already%
IF already% = 0 THEN nobj% = nobj% + 1: Object.Max.Check
IF keyin% = 3 THEN
  IF snode% = 0 THEN snode% = obj%(sobj%, 2) ELSE snode% = 0
  G.Arrowset sobj%, snode%, already%
  IF already% <> 0 THEN GOTO startarrow
  nobj% = nobj% + 1
  Object.Max.Check
END IF
GOTO startarrow
'
donearrow:
MarkEnds c%
SetInst job%
KeySwitch 1
job% = 0
selh% = 0
VIEW SCREEN (0, 0)-(windowx%(0), windowy%(0))
LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 0, BF
LOCATE line2%, 61: COLOR 3: PRINT kky$(8); : COLOR 7
'
END SUB

SUB G.Arrowset (sobj%, snode%, already%)
'                                                          arrow set & check
already% = 0
FOR i% = 0 TO nobj% - 1
IF fnoo%(i%) <> 11 THEN GOTO skipsrchar
IF obj%(i%, 5) = sobj% AND obj%(i%, 6) = snode% THEN
  already% = 1
  CursorDisplay px%, py%
  PPUT xx(sobj%, snode%) - 3, yy(sobj%, snode%) - 3, mark%()
  Killer i%, sobj%
  SetObject sobj%, 7, 0
  PPUT xx(sobj%, snode%) - 3, yy(sobj%, snode%) - 3, mark%()
  CursorDisplay px%, py%
  EXIT SUB
END IF
skipsrchar: NEXT i%
'
obj%(nobj%, 0) = 11: obj%(nobj%, 1) = 2: obj%(nobj%, 2) = -1
obj%(nobj%, 3) = -2: obj%(nobj%, 4) = obj%(sobj%, 4)
obj%(nobj%, 5) = sobj%: obj%(nobj%, 6) = snode%
G.ArrowDirec sobj%, snode%, nobj%
'
CursorDisplay px%, py%
PPUT xx(sobj%, snode%) - 3, yy(sobj%, snode%) - 3, mark%()
SetObject nobj%, 7, 0
PPUT xx(sobj%, snode%) - 3, yy(sobj%, snode%) - 3, mark%()
CursorDisplay px%, py%
'
END SUB

SUB G.Box
'                                                                        box
job% = 4
KeySwitch 0
SetInst job%
wx1% = 31 * 8 - 8
wx2% = 31 * 8 + 40
wy1% = line2% * texth% - texth%
wy2% = line2% * texth%
LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 11, BF
ptext PMAP(wx1%, 2) + 19, PMAP(wy1%, 3) + 1, kky$(5), 0, 1
'
startbox:
'fill% = 0
DO
  CursorMotion keyin%
'  IF keyin% = 3 THEN FillPattern
LOOP UNTIL keyin% <> 1
VIEW SCREEN (0, 0)-(windowx%(0), winpy%)
IF keyin% = 4 THEN GOTO donebox
sx% = px%: sy% = py%: pxold% = px%: pyold% = py%
sxg% = sx%: syg% = sy%
inbox% = 1
DO
  CursorMotion keyin%
  CursorDisplay px%, py%
  IF fill% <> 0 THEN
	LINE (sx%, sy%)-(pxold%, pyold%), 2, B
	PAINT ((sx% + pxold%) / 2, (sy% + pyold%) / 2), 0, 2
  END IF
  LINE (sx%, sy%)-(pxold%, pyold%), 0, BF
  IF keyin% = 4 THEN CursorDisplay px%, py%: GOTO donebox
'  IF keyin% = 3 THEN FillPattern
  LINE (sx%, sy%)-(px%, py%), 0, BF
  IF fill% = 0 THEN
	LINE (sx%, sy%)-(px%, py%), 7, B
  ELSE
	LINE (sx%, sy%)-(px%, py%), 2, B
	PAINT ((sx% + px%) / 2, (sy% + py%) / 2), tlp$(fill%), 2
  END IF
  CursorDisplay px%, py%
  pxold% = px%: pyold% = py%
LOOP UNTIL keyin% = 2 OR keyin% = 3
inbox% = 0
CursorDisplay px%, py%
IF fill% <> 0 THEN
  LINE (sx%, sy%)-(px%, py%), 2, B
  PAINT ((sx% + px%) / 2, (sy% + py%) / 2), 0, 2
END IF
LINE (sx%, sy%)-(px%, py%), 0, B
CursorDisplay px%, py%
xx(nobj%, 0) = sx%: yy(nobj%, 0) = sy%
xx(nobj%, 1) = px%: yy(nobj%, 1) = py%
obj%(nobj%, 0) = 8: obj%(nobj%, 1) = 1
IF fill% <> 0 THEN obj%(nobj%, 0) = 9
obj%(nobj%, 2) = 1: obj%(nobj%, 3) = -1
obj%(nobj%, 4) = thick%: obj%(nobj%, 5) = ltype%
obj%(nobj%, 6) = 0: obj%(nobj%, 6) = fill%
IF fill% <> 0 THEN obj%(nobj%, 5) = 0
CursorDisplay px%, py%
SetObject nobj%, 7, 0
CursorDisplay px%, py%
nobj% = nobj% + 1
Object.Max.Check

' --------
' Box Text, yes/no?
ipy% = py%: ipx% = px%: L.Text ipx%, ipy%
PRINT "Text(y/n)??";
bkey$ = yesno$
L.Text ipx%, ipy%: PRINT SPACE$(12);
IF bkey$ = "n" THEN GOTO startbox
'--------

'                                                                   string
job% = 5
KeySwitch 0
LOCATE line2%, 68: COLOR 11: PRINT kky$(9); : COLOR 7
SetInst job%
wx1% = 68 * 8 - 8
wx2% = 68 * 8 + 40
wy1% = line2% * texth% - texth%
wy2% = line2% * texth%
LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 11, BF

'
pxold% = px%: pyold% = py%
'------
' Calculate Box center for Box text
px% = sx% + (pxold% - sx%) / 2
py% = sy% + (pyold% - sy%) / 2 - texth% + 4
'------

pxold% = px%: pyold% = py%
CursorDisplay px%, py%

startchar2:

LINE (px%, py%)-(px% + epitch%(chartype%, 0) * charpt% / 250 * ptmm, py% + eheight(chartype%) * charpt% * ptmm / .25), 2, B
CursorDisplay px%, py%


LINE (pxold%, pyold%)-(pxold% + epitch%(chartype%, 0) * charpt% / 250 * ptmm, pyold% + eheight(chartype%) * charpt% * ptmm / .25), 0, B
LINE (px%, py%)-(px% + epitch%(chartype%, 0) * charpt% / 250 * ptmm, py% + eheight(chartype%) * charpt% * ptmm / .25), 2, B
pxold% = px%: pyold% = py%
CursorDisplay px%, py%
LINE (pxold%, pyold%)-(pxold% + epitch%(chartype%, 0) * charpt% / 250 * ptmm, pyold% + eheight(chartype%) * charpt% * ptmm / .25), 0, B
CursorDisplay px%, py%
IF px% + 10 - pxo% > pxmax% OR py% + 16 - pyo% > pymax% THEN GOTO donechar2
xx(nobj%, 0) = px%: yy(nobj%, 0) = py%
L.Text px%, py%: ams$ = "": PRINT "-> "; : Chr.Input ams$
L.Text px%, py%: PRINT SPACE$(LEN(ams$) + 3);
IF ams$ = "" THEN GOTO donechar2
obj%(nobj%, 0) = 10: obj%(nobj%, 1) = LEN(ams$)
obj%(nobj%, 2) = 0: obj%(nobj%, 3) = -1: obj%(nobj%, 4) = charpt%
obj%(nobj%, 5) = chartype%

'Put object number of Box + 1, i.e. string number in Obj(x,6)
obj%(nobj%, 6) = nobj%

G.Charset ams$, nobj%
CursorDisplay px%, py%
SetObject nobj%, 7, 0
CursorDisplay px%, py%
nobj% = nobj% + 1
Object.Max.Check
'
donechar2:
SetInst job%
KeySwitch 0
'Fixing the bug of boxtext job=0---> job=4
job% = 4
LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 0, BF
LOCATE line2%, 68: COLOR 3: PRINT kky$(9); : COLOR 7

CursorDisplay ipx%, ipy%


' end box text section

GOTO startbox:
'
donebox:
SetInst job%
KeySwitch 1
job% = 0
VIEW SCREEN (0, 0)-(windowx%(0), windowy%(0))
wx1% = 31 * 8 - 8
wx2% = 31 * 8 + 40
wy1% = line2% * texth% - texth%
wy2% = line2% * texth%
LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 0, BF
LOCATE line2%, 31: COLOR 3: PRINT kky$(5); : COLOR 7
CL.R.edraw 0, 0
'
END SUB

SUB G.Char
'                                                                     string
job% = 5
KeySwitch 0
SetInst job%
wx1% = 68 * 8 - 8
wx2% = 68 * 8 + 40
wy1% = line2% * texth% - texth%
wy2% = line2% * texth%
LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 11, BF
ptext PMAP(wx1%, 2) + 19, PMAP(wy1%, 3) + 1, kky$(9), 0, 1
'
startchar:
pxold% = px%: pyold% = py%
CursorDisplay px%, py%
LINE (px%, py%)-(px% + epitch%(chartype%, 0) * charpt% / 250 * ptmm, py% + eheight(chartype%) * charpt% * ptmm / .25), 2, B
CursorDisplay px%, py%
DO
  CursorMotion keyin%
  CursorDisplay px%, py%
  LINE (pxold%, pyold%)-(pxold% + epitch%(chartype%, 0) * charpt% / 250 * ptmm, pyold% + eheight(chartype%) * charpt% * ptmm / .25), 0, B
  LINE (px%, py%)-(px% + epitch%(chartype%, 0) * charpt% / 250 * ptmm, py% + eheight(chartype%) * charpt% * ptmm / .25), 2, B
  pxold% = px%: pyold% = py%
  CursorDisplay px%, py%
LOOP UNTIL keyin% <> 1
VIEW SCREEN (0, 0)-(windowx%(0), winpy%)
CursorDisplay px%, py%
LINE (pxold%, pyold%)-(pxold% + epitch%(chartype%, 0) * charpt% / 250 * ptmm, pyold% + eheight(chartype%) * charpt% * ptmm / .25), 0, B
CursorDisplay px%, py%
IF keyin% = 4 THEN GOTO donechar
'IF keyin% = 3 THEN G.CharDisp: GOTO startchar
IF px% + 10 - pxo% > pxmax% OR py% + 16 - pyo% > pymax% THEN GOTO donechar
xx(nobj%, 0) = px%: yy(nobj%, 0) = py%
L.Text px%, py%: ams$ = "": PRINT "-> "; : Chr.Input ams$
L.Text px%, py%: PRINT SPACE$(LEN(ams$) + 3);
IF ams$ = "" THEN GOTO startchar
obj%(nobj%, 0) = 10: obj%(nobj%, 1) = LEN(ams$)
obj%(nobj%, 2) = 0: obj%(nobj%, 3) = -1: obj%(nobj%, 4) = charpt%
obj%(nobj%, 5) = chartype%: obj%(nobj%, 6) = 0
G.Charset ams$, nobj%
CursorDisplay px%, py%
SetObject nobj%, 7, 0
CursorDisplay px%, py%
nobj% = nobj% + 1
Object.Max.Check
GOTO startchar
'
donechar:
SetInst job%
KeySwitch 1
job% = 0
VIEW SCREEN (0, 0)-(windowx%(0), windowy%(0))
LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 0, BF
LOCATE line2%, 68: COLOR 3: PRINT kky$(9); : COLOR 7
'
END SUB

SUB G.CharDisp
'                                           character font selection display
ipy% = py%: ipx% = px%
L.Text ipx%, ipy%
charptold% = charpt%: a$ = fno$(charpt%, 1)
PRINT "Size (10 or 12 pt.) = "; : Chr.Input a$
charpt% = VAL(a$)
IF charpt% = 0 OR (charpt% <> 10 AND charpt% <> 12) THEN charpt% = charptold%
L.Text ipx%, ipy%: PRINT SPACE$(28);
DO
  L.Text ipx%, ipy%
  PRINT "Font= "; chartype$(chartype%)  '; ".";
  CursorMotion keyin%
  IF keyin% = 2 THEN
	chartype% = chartype% + 1: IF chartype% > UBOUND(chartype$) THEN chartype% = 0
  END IF
LOOP UNTIL keyin% = 3
L.Text ipx%, ipy%
PRINT SPACE$(5)
L.Text ipx%, ipy%
PRINT "'"; chartype$(chartype%); "' character in "; charpt%; "pt.";
SLEEP 1: L.Text ipx%, ipy%
PRINT SPACE$(5); SPACE$(10); SPACE$(25);
'
END SUB

SUB G.Charset (ams$, n%)
'                                               character code decomposition
FOR i% = 1 TO LEN(ams$): a$ = MID$(ams$, i%, 1): j% = LEN(a$)
IF j% = 1 THEN
  yy(n%, i%) = 0!: xx(n%, i%) = ASC(a$)
ELSE
  a$ = STR$(ASC(a$))
  yy(n%, i%) = VAL("&H" + LEFT$(a$, 2))
  xx(n%, i%) = VAL("&H" + RIGHT$(a$, 2))
END IF
NEXT i%
'
END SUB

SUB G.Crcl
'                                                                     circle
'LOCATE line3%, 42: PRINT "filler pattern"
xx(nobj%, 0) = px%: yy(nobj%, 0) = py%
sx% = px%: sy% = py%: rold = 1
'fill% = 0
DO
  CursorMotion keyin%
  CursorDisplay px%, py%
  CIRCLE (sx%, sy%), rold, 0, , , 1
  IF keyin% = 4 THEN CursorDisplay px%, py%: GOTO donecrcl
  rad = SQR((px% - sx%) ^ 2 + (py% - sy%) ^ 2)
  CIRCLE (sx%, sy%), rad, 2, , , 1
'***********
'For fillpattern for circle
'
'  IF fill% = 0 THEN
'        PAINT ((sx% + px%) / 2, (sy% + py%) / 2), 0, 2
'  ELSE
'        PAINT ((sx% + px%) / 2, (sy% + py%) / 2), tlp$(fill%), 2
'  END IF
'**************
  rold = rad
  CursorDisplay px%, py%
LOOP UNTIL keyin% = 2
CursorDisplay px%, py%
CIRCLE (sx%, sy%), rad, 0, , , 1
CursorDisplay px%, py%
xx(nobj%, 1) = px%: yy(nobj%, 1) = py%: xx(nobj%, 2) = rad
obj%(nobj%, 0) = 5: obj%(nobj%, 1) = 2
obj%(nobj%, 2) = 1: obj%(nobj%, 3) = -1
obj%(nobj%, 4) = thick%: obj%(nobj%, 5) = 0
obj%(nobj%, 6) = 0
CursorDisplay px%, py%
SetObject nobj%, 7, 0
CursorDisplay px%, py%
nobj% = nobj% + 1
Object.Max.Check
'
donecrcl:
'
END SUB

SUB G.Crcl.Ellps
'                                                              circle+ellpse
job% = 2
KeySwitch 0
SetInst job%
wx1% = 17 * 8 - 8
wx2% = 17 * 8 + 40
wy1% = line2% * texth% - texth%
wy2% = line2% * texth%
LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 11, BF
ptext PMAP(wx1%, 2) + 19, PMAP(wy1%, 3) + 1, kky$(3), 0, 1
'
startcrclellps:
DO
  CursorMotion keyin%
LOOP UNTIL keyin% <> 1
VIEW SCREEN (0, 0)-(windowx%(0), winpy%)
SELECT CASE keyin%
  CASE 2
	G.Crcl
  CASE 3
	G.Ellps
  CASE 4
	GOTO donecrclellps
END SELECT
GOTO startcrclellps
'
donecrclellps:
SetInst job%
KeySwitch 1
job% = 0
VIEW SCREEN (0, 0)-(windowx%(0), windowy%(0))
LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 0, BF
LOCATE line2%, 17: COLOR 3: PRINT kky$(3); : COLOR 7
'
END SUB

SUB G.Curve (curve%, closed%)
'                                                      straight/curved lines
job% = 1
KeySwitch 0
SetInst job%
wx1% = (curve% * 7 - 4 + closed% * 44) * 8 - 8
wx2% = (curve% * 7 - 4 + closed% * 44) * 8 + 40
wy1% = line2% * texth% - texth%
wy2% = line2% * texth%
LINE (PMAP(wx1%, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 11, BF
ptext PMAP(wx1%, 2) + 19, PMAP(wy1%, 3) + 1, kky$(curve% + 5 * closed%), 0, 1
'
startcurve:
node% = 0: nodeismax% = 0
DO
  CursorMotion keyin%
LOOP UNTIL keyin% <> 1
IF keyin% >= 3 THEN GOTO donest
pxold% = px%: pyold% = py%
xx(nobj%, 0) = px%: yy(nobj%, 0) = py%
DO
sx% = px%: sy% = py%
node% = node% + 1
IF node% + closed% + curve% - 1 = UBOUND(xx, 2) THEN nodeismax% = 1
  DO
	CursorMotion keyin%
	CursorDisplay px%, py%
	IF wnode% <> 0 AND node% > 1 THEN
	   PSET (xx(nobj%, 0), yy(nobj%, 0)), 7
	   FOR i% = 1 TO (node% - 1)
	      LINE -(xx(nobj%, i%), yy(nobj%, i%)), 7
	   NEXT i%
	END IF
	wnode% = 0
	LINE (sx%, sy%)-(pxold%, pyold%), 0
	LINE (sx%, sy%)-(px%, py%), 7
	pxold% = px%: pyold% = py%
	CursorDisplay px%, py%
  LOOP UNTIL keyin% <> 1
  CursorDisplay px%, py%
  LINE (sx%, sy%)-(px%, py%), 7
  CursorDisplay px%, py%
  xx(nobj%, node%) = px%: yy(nobj%, node%) = py%
  IF keyin% = 4 THEN EXIT DO
  IF nodeismax% = 1 THEN keyin% = 3
LOOP UNTIL keyin% = 3 AND node% >= 1 + closed%
IF curve% = 1 THEN
  obj%(nobj%, 0) = 1
ELSE
  obj%(nobj%, 0) = 3
END IF
obj%(nobj%, 1) = node%
obj%(nobj%, 2) = node% - closed%: obj%(nobj%, 3) = node% - closed%
obj%(nobj%, 4) = thick%: obj%(nobj%, 5) = ltype%: obj%(nobj%, 6) = 0
CursorDisplay px%, py%
PSET (xx(nobj%, 0), yy(nobj%, 0)), 0
FOR i% = 1 TO node%: LINE -(xx(nobj%, i%), yy(nobj%, i%)), 0: NEXT i%
CursorDisplay px%, py%
IF keyin% = 4 THEN GOTO donest
IF closed% <> 0 THEN
  FOR i% = 0 TO 3: obj%(nobj%, i%) = obj%(nobj%, i%) + 1: NEXT i%
  node% = node% + 1
  xx(nobj%, node%) = xx(nobj%, 0): yy(nobj%, node%) = yy(nobj%, 0)
END IF
IF curve% = 2 AND INT(node% / 2) * 2 <> node% THEN G.Addnode nobj%, node%, 0
CursorDisplay px%, py%
SetObject nobj%, 7, 0
CursorDisplay px%, py%
nobj% = nobj% + 1
Object.Max.Check
GOTO startcurve
'
donest:
SetInst job%
KeySwitch 1
job% = 0
VIEW SCREEN (0, 0)-(windowx%(0), windowy%(0))
LINE (PMAP(wx1%, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 0, BF
LOCATE line2%, curve% * 7 - 4 + closed% * 44: COLOR 3
PRINT kky$(curve% + 5 * closed%); : COLOR 7
'
END SUB

SUB G.Ellps
'                                                                    ellipse
rold = 1: rtold = 1:
sx% = px%: sy% = py%: cx% = px%: cy% = py%
DO
  CursorMotion keyin%
  CursorDisplay px%, py%
  CIRCLE (cx%, cy%), rold, 0, , , rtold
  IF keyin% = 4 THEN CursorDisplay px%, py%: GOTO donellps
  cx% = (px% + sx%) / 2!: cy% = (py% + sy%) / 2!
  rad = ABS(px% - sx%) / 2!: rt = ABS(py% - sy%) / 2!
  IF rad = 0! OR rt = 0! THEN
	rad = 0!: rt = 1!
  ELSE
	rt = rt / rad
	IF rt > 1! THEN rad = rt * rad
  END IF
  CIRCLE (cx%, cy%), rad, 2, , , rt
  '***********
  'For fillpattern for circle
  '
  '  IF fill% = 0 THEN
  '      PAINT ((sx% + px%) / 2, (sy% + py%) / 2), 0, 2
  '  ELSE
  '      PAINT ((sx% + px%) / 2, (sy% + py%) / 2), tlp$(fill%), 2
  '  END IF
  '**************
 
  rold = rad: rtold = rt
  CursorDisplay px%, py%
LOOP UNTIL keyin% = 3
CursorDisplay px%, py%
CIRCLE (cx%, cy%), rad, 0, , , rt
CursorDisplay px%, py%
xx(nobj%, 0) = cx%: yy(nobj%, 0) = cy%: xx(nobj%, 2) = rad
xx(nobj%, 1) = cx%: yy(nobj%, 1) = cy%: yy(nobj%, 2) = rt
IF rt < 1! THEN
  xx(nobj%, 1) = cx% + rad
ELSE
  yy(nobj%, 1) = cy% - rad
END IF
obj%(nobj%, 0) = 7: obj%(nobj%, 1) = 2: obj%(nobj%, 2) = 1
obj%(nobj%, 3) = -1: obj%(nobj%, 4) = thick%: obj%(nobj%, 5) = 0
obj%(nobj%, 6) = 0
CursorDisplay px%, py%
SetObject nobj%, 7, 0
CursorDisplay px%, py%
nobj% = nobj% + 1
Object.Max.Check
'
donellps:
'
END SUB

SUB G.XYparam (x0%, y0%, x1%, y1%, x2%, y2%, ax, bx, cx, ay, by, cy)
'                                    parametric parabolic curve coefficients
ax = -(-x0% + 2! * x1% - x2%) / 2!
bx = -(3! * x0% - 4! * x1% + x2%) / 2!
cx = x0%
ay = -(-y0% + 2! * y1% - y2%) / 2!
by = -(3! * y0% - 4! * y1% + y2%) / 2!
cy = y0%
'
END SUB

SUB L.Text (ipx%, ipy%)
'                                                      locate on text screen
jpx% = INT(CSNG(ipx% - pxo%) / wndwxy(wndwfctr%) / 8!) + 2
jpy% = INT(CSNG(ipy% - pyo%) / wndwxy(wndwfctr%) / 16!) + 2
IF jpy% > 22 THEN jpy% = jpy% - 3
LOCATE jpy%, jpx%
'
END SUB

SUB MaxMin (ppxx%, ppyy%)
'                                                        set maximum/minimum
IF ppxx% < xmin% THEN xmin% = ppxx%
IF ppxx% > xmax% THEN xmax% = ppxx%
IF ppyy% < ymin% THEN ymin% = ppyy%
IF ppyy% > ymax% THEN ymax% = ppyy%
'
END SUB

SUB MoveObj (c%)
'                                                       move or copy objects
job% = 7
KeySwitch 0
SetInst job%
wx1% = (3 + 7 * c%) * 8 - 8
wx2% = (3 + 7 * c%) * 8 + 40
wy1% = line1% * texth% - texth%
wy2% = line1% * texth%
LINE (PMAP(wx1%, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 11, BF
ptext PMAP(wx1%, 2) + 19, PMAP(wy1%, 3) + 1, kky$(11 + c%), 0, 1
'
startmovecopy:
Marking 1, n%
selh% = 1
IF n% = 0 THEN Marking 1, n%: GOTO donemovecopy
DO
  CursorMotion keyin%
LOOP UNTIL keyin% <> 1
VIEW SCREEN (0, 0)-(windowx%(0), winpy%)
woldrad% = 0
SELECT CASE keyin%
  CASE 2
	selh% = 0
	MoveObject 1, c%
   CASE 3
	MoveObject 0, c%
  CASE ELSE
	Marking 1, n%
END SELECT
woldrad% = 0
IF keyin% <> 4 THEN GOTO startmovecopy
'
donemovecopy:
SetInst job%
KeySwitch 1
job% = 0
selh% = 0
VIEW SCREEN (0, 0)-(windowx%(0), windowy%(0))
LINE (PMAP(wx1%, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 0, BF
LOCATE line1%, 3 + 7 * c%: COLOR 3: PRINT kky$(11 + c%); : COLOR 7
'
END SUB

SUB MoveObject (total%, c%)
'                                                      really moving objects
sx% = px%: sy% = py%: pxold% = px%: pyold% = py%
IF total% = 1 THEN
  total% = 0
  Marking.Chk 1, mobj%(total%), snode%
  IF mobj%(total%) < 0 THEN Marking 1, n%: EXIT SUB
ELSE
  DO
	CursorMotion keyin%
	CursorDisplay px%, py%
	LINE (sx%, sy%)-(pxold%, pyold%), 0, B
	IF keyin% = 4 THEN CursorDisplay px%, py%: Marking 1, n%: EXIT SUB
	LINE (sx%, sy%)-(px%, py%), 2, B
	CursorDisplay px%, py%
	pxold% = px%: pyold% = py%
  LOOP UNTIL keyin% = 3
  selh% = 0
  CursorDisplay px%, py%
  LINE (sx%, sy%)-(px%, py%), 0, B
  CursorDisplay px%, py%
  Marking.Reg sx%, sy%, px%, py%, total%
  IF total% < 0 THEN Marking 1, n%: EXIT SUB
END IF
IF total% > UBOUND(mobj%) OR nobj% + total% > UBOUND(obj%, 1) THEN GOTO no.way.to.move
'                                                                group check
gtotal% = 0
FOR k% = 0 TO total%
IF fnoo%(mobj%(k%)) = obj%(mobj%(k%), 0) THEN GOTO movegroup2
ggroup% = obj%(mobj%(k%), 0) - fnoo%(mobj%(k%))
FOR i% = 0 TO nobj% - 1
IF fnoo%(i%) = obj%(i%, 0) THEN GOTO movegroup1
FOR j% = 0 TO total%
IF i% = mobj%(j%) THEN GOTO movegroup1
NEXT j%
IF obj%(i%, 0) - fnoo%(i%) = ggroup% THEN
  gtotal% = gtotal% + 1
  IF total% + gtotal% > UBOUND(mobj%) THEN GOTO no.way.to.move
  IF nobj% + total% + gtotal% > UBOUND(obj%, 1) THEN GOTO no.way.to.move
  mobj%(total% + gtotal%) = i%
END IF
movegroup1:
NEXT i%
movegroup2:
NEXT k%
total% = total% + gtotal%
Marking 1, n%
'
FOR i% = 0 TO total%
FOR j% = 0 TO 6: obj%(nobj% + i%, j%) = obj%(mobj%(i%), j%): NEXT j%
FOR j% = 0 TO obj%(mobj%(i%), 1)
xx(nobj% + i%, j%) = xx(mobj%(i%), j%)
yy(nobj% + i%, j%) = yy(mobj%(i%), j%)
NEXT j%: NEXT i%: dx% = 0: dy% = 0
'
DO
  CursorMotion keyin%
  CursorDisplay px%, py%
  IF keyin% = 4 THEN
	FOR i% = 0 TO total%: wkill% = 1: SetObject nobj% + i%, 0, 1: NEXT i%
	GOTO mvobj
  END IF
  ddx% = px% - pxold%: ddy% = py% - pyold%
  dx% = dx% + ddx%: dy% = dy% + ddy%
  a$ = KeyIsTouched$                        'check continuous motion, silly?
  IF (mouswitch% = 0 AND a$ = "") OR (mouswitch% AND a$ = "" AND row% = py% AND col% = px%) THEN
	IF c% = 0 OR dx% <> 0 OR dy% <> 0 THEN
	  FOR i% = 0 TO total%: wkill% = 1: SetObject nobj% + i%, 0, 1: NEXT i%
	END IF
	FOR i% = 0 TO total%: jlast% = obj%(nobj% + i%, 2)
	IF fnoo%(nobj% + i%) = 2 OR fnoo%(nobj% + i%) = 4 THEN jlast% = jlast% + 1
	FOR j% = 0 TO jlast%
	xx(nobj% + i%, j%) = xx(nobj% + i%, j%) + dx%
	yy(nobj% + i%, j%) = yy(nobj% + i%, j%) + dy%: NEXT j%
	SetObject nobj% + i%, 3, 1
	NEXT i%
	dx% = 0: dy% = 0
  END IF
  CursorDisplay px%, py%
  pxold% = px%: pyold% = py%
LOOP UNTIL keyin% = 2 OR keyin% = 3
'
CursorDisplay px%, py%
FOR i% = 0 TO total%: SetObject nobj% + i%, 0, 1: NEXT i%
groupchk% = 0
IF c% = 0 THEN
  FOR i% = 0 TO total%: SetObject mobj%(i%), 0, 0: NEXT i%
  FOR i% = 0 TO total%
  FOR j% = 0 TO 6: obj%(mobj%(i%), j%) = obj%(nobj% + i%, j%): NEXT j%
  FOR j% = 0 TO obj%(mobj%(i%), 1): xx(mobj%(i%), j%) = xx(nobj% + i%, j%)
  yy(mobj%(i%), j%) = yy(nobj% + i%, j%): NEXT j%: NEXT i%
  FOR i% = 0 TO total%: FOR j% = 0 TO nobj% - 1
  IF fnoo%(j%) = 11 AND obj%(j%, 5) = mobj%(i%) THEN
	SetObject j%, 0, 0
	G.ArrowDirec obj%(j%, 5), obj%(j%, 6), j%
	SetObject j%, 7, 0
  END IF
  NEXT j%: NEXT i%
ELSE
  arrow% = 0: arrowoverflow% = 0
  FOR i% = 0 TO total%: SetObject nobj% + i%, 7, 0
  IF obj%(nobj% + i%, 0) <> fnoo%(nobj% + i%) THEN
	obj%(nobj% + i%, 0) = 100 * group% + fnoo%(nobj% + i%)
	groupchk% = 1
  ELSE
	obj%(nobj% + i%, 0) = fnoo%(nobj% + i%)
  END IF
  FOR j% = 0 TO nobj% - 1
  IF fnoo%(j%) = 11 AND obj%(j%, 5) = mobj%(i%) THEN
	mmobj% = nobj% + total% + arrow% + 1
	IF mmobj% > UBOUND(obj%, 1) THEN arrowoverflow% = arrowoverflow% + 1
	IF arrowoverflow% = 0 THEN
	  FOR k% = 0 TO 6: obj%(mmobj%, k%) = obj%(j%, k%): NEXT k%
	  IF obj%(mmobj%, 0) <> fnoo%(mmobj%) THEN
		obj%(mmobj%, 0) = 100 * group% + fnoo%(mmobj%)
	  ELSE
		obj%(mmobj%, 0) = fnoo%(mmobj%)
	  END IF
	  FOR k% = 0 TO obj%(mmobj%, 1): xx(mmobj%, k%) = xx(j%, k%)
	  yy(mmobj%, k%) = yy(j%, k%): NEXT k%: obj%(mmobj%, 5) = nobj% + i%
	  G.ArrowDirec obj%(mmobj%, 5), obj%(mmobj%, 6), mmobj%
	  SetObject mmobj%, 7, 0: arrow% = arrow% + 1
	END IF
  END IF
  NEXT j%: NEXT i%
  IF groupchk% = 1 THEN group% = group% + 1
  nobj% = nobj% + total% + arrow% + 1
  IF arrowoverflow% > 0 THEN
	COLOR 14: LOCATE 2, 25
	PRINT CHR$(7); " "; arrowoverflow%; " arrow(s)  NOT  copied! ";
	COLOR 7
  END IF
END IF
mvobj:
FOR i% = 0 TO total%: SetObject mobj%(i%), 7, 0: NEXT i%
CursorDisplay px%, py%
EXIT SUB
'
no.way.to.move:
Marking 1, n%
COLOR 14: LOCATE 2, 25
PRINT CHR$(7); " No way to move/copy that many... ";
COLOR 7
'
END SUB

SUB PPUT (xp, yp, markp%())
'                                                            conditional PUT
IF xp < pxmax% AND xp > pxmin% AND yp < pymax2% AND yp > pymin% THEN
  PUT (xp, yp), markp%, XOR
END IF
'
END SUB

SUB SetObject (n%, clr%, simple%)
'                                                            set each object
IF fnoo%(n%) < 1 THEN EXIT SUB
ON fnoo%(n%) GOSUB ln, ln, cv, cv, crc, arc, ellps, box, fbox, str, arr
EXIT SUB
'                                                                       line
ln:
FOR i% = 1 TO obj%(n%, 1)
D.Lines INT(xx(n%, i% - 1)), INT(yy(n%, i% - 1)), INT(xx(n%, i%)), INT(yy(n%, i%)), clr%, 0, obj%(n%, 4), obj%(n%, 5), 0, simple%
NEXT i%: RETURN
'                                                                      curve
cv:
IF simple% = 1 THEN GOTO ln
FOR i% = 0 TO obj%(n%, 1) - 2
x0% = xx(n%, i%): x1% = xx(n%, i% + 1): x2% = xx(n%, i% + 2)
y0% = yy(n%, i%): y1% = yy(n%, i% + 1): y2% = yy(n%, i% + 2)
G.XYparam x0%, y0%, x1%, y1%, x2%, y2%, ax, bx, cx, ay, by, cy
jlast% = 4: IF i% = obj%(n%, 1) - 2 THEN jlast% = 9
FOR j% = 0 TO jlast%
t = j% / 5!: sx% = ax * t * t + bx * t + cx: sy% = ay * t * t + by * t + cy
t = (j% + 1) / 5!: ex% = ax * t * t + bx * t + cx: ey% = ay * t * t + by * t + cy
D.Lines sx%, sy%, ex%, ey%, clr%, 0, obj%(n%, 4), obj%(n%, 5), 0, simple%
NEXT j%: NEXT i%
RETURN
'                                                                     circle
crc:
D.Circles INT(xx(n%, 0)), INT(yy(n%, 0)), xx(n%, 2), -1, -1, 0, clr%, obj%(n%, 4), simple%, obj%(n%, 6)
RETURN
'                                                                        arc
arc:
D.Circles INT(xx(n%, 1)), INT(yy(n%, 1)), xx(n%, 3), -1, yy(n%, 3), yy(n%, 4), clr%, obj%(n%, 4), simple%, obj%(n%, 6)
RETURN
'                                                                    ellipse
ellps:
D.Circles INT(xx(n%, 0)), INT(yy(n%, 0)), xx(n%, 2), yy(n%, 2), -1, 0, clr%, obj%(n%, 4), simple%, obj%(n%, 6)
RETURN
'                                                                        box
box:
D.Lines INT(xx(n%, 0)), INT(yy(n%, 0)), INT(xx(n%, 1)), INT(yy(n%, 1)), clr%, 1, obj%(n%, 4), obj%(n%, 5), 0, simple%
RETURN
'                                                                 filled box
fbox:
D.Lines INT(xx(n%, 0)), INT(yy(n%, 0)), INT(xx(n%, 1)), INT(yy(n%, 1)), clr%, 2, obj%(n%, 4), 0, obj%(n%, 6), simple%
RETURN
'                                                                    strings
str:
D.Strings n%, clr%, simple%
RETURN
'                                                                      arrow
arr:
FOR i% = 0 TO 1
D.Lines INT(xx(n%, i%)), INT(yy(n%, i%)), INT(xx(n%, i% + 1)), INT(yy(n%, i% + 1)), clr%, 0, obj%(n%, 4), 0, 0, simple%
NEXT i%
RETURN
'
END SUB