diff options
Diffstat (limited to 'support/qfig/src/qfigsub2.bas')
-rw-r--r-- | support/qfig/src/qfigsub2.bas | 1206 |
1 files changed, 1206 insertions, 0 deletions
diff --git a/support/qfig/src/qfigsub2.bas b/support/qfig/src/qfigsub2.bas new file mode 100644 index 0000000000..c967cc4cea --- /dev/null +++ b/support/qfig/src/qfigsub2.bas @@ -0,0 +1,1206 @@ +' qfigsub2.bas
+
+'$INCLUDE: 'QFIG.BI'
+
+SUB CL.R.edraw (simple%, show%)
+' clear and redraw
+CLS 0
+i% = windowx%(wndwfctr%) + pxo%
+IF i% > REGIONXMAX THEN i% = REGIONXMAX
+LINE (pxo%, pyo%)-(i%, pyo%), 3
+i% = windowy%(wndwfctr%) + pyo%
+IF i% > REGIONYMAX THEN i% = REGIONYMAX
+LINE (pxo%, pyo%)-(pxo%, i%), 3
+FOR i% = pxo% TO windowx%(wndwfctr%) + pxo% STEP 4
+IF i% > REGIONXMAX THEN EXIT FOR
+LINE (i%, pyo%)-(i%, pyo% + 2), 3
+IF INT(i% / 20) * 20 = i% THEN LINE -(i%, pyo% + 4), 3
+IF INT(i% / 40) * 40 = i% THEN LINE -(i%, pyo% + 6), 3
+IF i% <> 0 AND INT(i% / 200) * 200 = i% THEN CIRCLE (i%, pyo% + 6), 3, 3, , , 1
+NEXT i%
+FOR i% = pyo% TO windowy%(wndwfctr%) + pyo% STEP 4
+IF i% > REGIONYMAX THEN EXIT FOR
+LINE (pxo%, i%)-(pxo% + 2, i%), 3
+IF INT(i% / 20) * 20 = i% THEN LINE -(pxo% + 4, i%), 3
+IF INT(i% / 40) * 40 = i% THEN LINE -(pxo% + 6, i%), 3
+IF i% <> 0 AND INT(i% / 200) * 200 = i% THEN CIRCLE (pxo% + 6, i%), 3, 3, , , 1
+NEXT i%
+IF nobj% <> 0 THEN
+ IF show% <> 0 THEN
+ LOCATE 12, 30: COLOR 10: PRINT msgrdrw$; : COLOR 7
+ END IF
+ xmin% = REGIONXMAX: xmax% = 0: ymin% = REGIONYMAX: ymax% = 0
+ FOR n% = 0 TO nobj% - 1
+ SetObject n%, 7, simple%
+ NEXT n%
+END IF
+LINE (PMAP(0, 2), PMAP(windowy%(0) - texth% * 4 - 5, 3))-(PMAP(639, 2), PMAP(windowy%(0), 3)), 0, BF
+KeyDisplay
+LINE (PMAP(0, 2), PMAP(windowy%(0) - texth% * 4 - 4, 3))-(PMAP(639, 2), PMAP(windowy%(0) - texth% * 4 - 4, 3)), 3
+'
+END SUB
+
+SUB CopySymm
+' symmetric copy
+job% = 11
+KeySwitch 0
+SetInst job%
+wx1% = 17 * 8 - 8
+wx2% = 17 * 8 + 40
+wy1% = line1% * texth% - texth%
+wy2% = line1% * 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$(13), 0, 1
+'
+startcopysymm:
+selh% = 1
+Marking 2, n%
+IF n% = 0 THEN Marking 2, n%: GOTO donecopysymm
+DO
+ CursorMotion keyin%
+LOOP UNTIL keyin% <> 1
+Marking 2, n%
+IF keyin% = 4 THEN GOTO donecopysymm
+VIEW SCREEN (0, 0)-(windowx%(0), winpy%)
+Marking.Chk 2, sobj%, snode%
+IF sobj% < 0 THEN GOTO startcopysymm
+FOR i% = 0 TO 6: obj%(nobj%, i%) = obj%(sobj%, i%): NEXT i%
+FOR i% = 0 TO obj%(nobj%, 1): xx(nobj%, i%) = xx(sobj%, i%)
+yy(nobj%, i%) = yy(sobj%, i%): NEXT i%
+SELECT CASE keyin%
+ CASE 2
+ FOR i% = 0 TO obj%(nobj%, 1)
+ yy(nobj%, i%) = 2! * yy(sobj%, snode%) - yy(nobj%, i%)
+ NEXT i%
+ CASE 3
+ FOR i% = 0 TO obj%(nobj%, 1)
+ xx(nobj%, i%) = 2! * xx(sobj%, snode%) - xx(nobj%, i%)
+ NEXT i%
+END SELECT
+SetObject nobj%, 7, 0
+nobj% = nobj% + 1
+Object.Max.Check
+GOTO startcopysymm
+'
+donecopysymm:
+SetInst job%
+KeySwitch 1
+job% = 0
+VIEW SCREEN (0, 0)-(windowx%(0), windowy%(0))
+selh% = 0
+LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 0, BF
+LOCATE line1%, 17: COLOR 3: PRINT kky$(13); : COLOR 7
+'
+END SUB
+
+SUB Disp.C (sobj%, snode%)
+' cut nodes
+IF obj%(sobj%, 1) = 1 THEN EXIT SUB
+IF fnoo%(sobj%) = 2 AND obj%(sobj%, 1) = 3 THEN EXIT SUB
+CursorDisplay px%, py%
+FOR i% = 0 TO nobj% - 1
+IF fnoo%(i%) = 11 AND obj%(i%, 5) = sobj% AND obj%(i%, 6) = snode% THEN Killer i%, sobj%
+NEXT i%
+SetObject sobj%, 0, 0
+FOR i% = 1 TO 3: obj%(sobj%, i%) = obj%(sobj%, i%) - 1: NEXT i%
+IF snode% <> obj%(sobj%, 1) + 1 THEN
+ FOR i% = snode% + 1 TO obj%(sobj%, 1) + 1
+ xx(sobj%, i% - 1) = xx(sobj%, i%): yy(sobj%, i% - 1) = yy(sobj%, i%)
+ NEXT i%
+ IF fnoo%(sobj%) = 2 OR fnoo%(sobj%) = 4 THEN
+ xx(sobj%, obj%(sobj%, 1)) = xx(sobj%, 0)
+ yy(sobj%, obj%(sobj%, 1)) = yy(sobj%, 0)
+ END IF
+END IF
+IF fnoo%(sobj%) = 3 OR fnoo%(sobj%) = 4 THEN
+ snode% = obj%(sobj%, 1)
+ G.Addnode sobj%, snode%, 0
+ ' Next line resets a closed curve which was originally a Poly
+ 'but has just been edited
+ IF fnoo%(sobj%) = 4 AND obj%(sobj%, 6) <> 0 THEN obj%(sobj%, 6) = 0
+END IF
+FOR i% = 0 TO nobj% - 1
+IF fnoo%(i%) = 11 AND obj%(i%, 5) = sobj% THEN
+ SetObject i%, 0, 0
+ snode% = 0
+ IF obj%(i%, 6) <> 0 THEN snode% = obj%(sobj%, 1): obj%(i%, 6) = snode%
+ G.ArrowDirec sobj%, snode%, i%
+ SetObject i%, 7, 0
+END IF
+NEXT i%
+SetObject sobj%, 7, 0
+CursorDisplay px%, py%
+'
+END SUB
+
+SUB Disp.D (sobj%, snode%)
+' displace nodes
+pxold% = px%: pyold% = py%
+DO
+ CursorMotion keyin%
+ CursorDisplay px%, py%
+ IF snode% = obj%(sobj%, 1) THEN
+ LINE (pxold%, pyold%)-(xx(sobj%, snode% - 1), yy(sobj%, snode% - 1)), 0
+ ELSE
+ LINE (pxold%, pyold%)-(xx(sobj%, snode% + 1), yy(sobj%, snode% + 1)), 0
+ IF snode% <> 0 THEN
+ LINE (pxold%, pyold%)-(xx(sobj%, snode% - 1), yy(sobj%, snode% - 1)), 0
+ ELSEIF fnoo%(sobj%) = 2 OR fnoo%(sobj%) = 4 THEN
+ LINE (pxold%, pyold%)-(xx(sobj%, obj%(sobj%, 1) - 1), yy(sobj%, obj%(sobj%, 1) - 1)), 0
+ END IF
+ END IF
+ IF keyin% = 4 THEN GOTO donedisp
+ ' Next line resets a closed curve which was originally a Poly
+ 'but has just been edited
+ IF fnoo%(sobj%) = 4 AND obj%(sobj%, 6) <> 0 THEN obj%(sobj%, 6) = 0
+ IF snode% = obj%(sobj%, 1) THEN
+ LINE (px%, py%)-(xx(sobj%, snode% - 1), yy(sobj%, snode% - 1)), 2
+ ELSE
+ LINE (px%, py%)-(xx(sobj%, snode% + 1), yy(sobj%, snode% + 1)), 2
+ IF snode% <> 0 THEN
+ LINE (px%, py%)-(xx(sobj%, snode% - 1), yy(sobj%, snode% - 1)), 2
+ ELSEIF fnoo%(sobj%) = 2 OR fnoo%(sobj%) = 4 THEN
+ LINE (px%, py%)-(xx(sobj%, obj%(sobj%, 1) - 1), yy(sobj%, obj%(sobj%, 1) - 1)), 2
+ END IF
+ END IF
+ CursorDisplay px%, py%
+ pxold% = px%: pyold% = py%
+LOOP UNTIL keyin% = 2
+CursorDisplay px%, py%
+IF snode% = obj%(sobj%, 1) THEN
+ LINE (pxold%, pyold%)-(xx(sobj%, snode% - 1), yy(sobj%, snode% - 1)), 0
+ELSE
+ LINE (pxold%, pyold%)-(xx(sobj%, snode% + 1), yy(sobj%, snode% + 1)), 0
+ IF snode% <> 0 THEN
+ LINE (pxold%, pyold%)-(xx(sobj%, snode% - 1), yy(sobj%, snode% - 1)), 0
+ ELSEIF fnoo%(sobj%) = 2 OR fnoo%(sobj%) = 4 THEN
+ LINE (pxold%, pyold%)-(xx(sobj%, obj%(sobj%, 1) - 1), yy(sobj%, obj%(sobj%, 1) - 1)), 0
+ END IF
+END IF
+SetObject sobj%, 0, 0
+xx(sobj%, snode%) = px%: yy(sobj%, snode%) = py%
+IF (fnoo%(sobj%) = 2 OR fnoo%(sobj%) = 4) AND snode% = 0 THEN
+ xx(sobj%, obj%(sobj%, 1)) = px%: yy(sobj%, obj%(sobj%, 1)) = py%
+END IF
+' arrows
+FOR i% = 0 TO nobj% - 1
+IF fnoo%(i%) <> 11 THEN GOTO chkdisp
+IF obj%(i%, 5) <> sobj% THEN GOTO chkdisp
+SetObject i%, 0, 0
+G.ArrowDirec sobj%, obj%(i%, 6), i%
+SetObject i%, 7, 0
+chkdisp: NEXT i%
+'
+donedisp:
+SetObject sobj%, 7, 0
+CursorDisplay px%, py%
+'
+END SUB
+
+SUB DispCut
+' displace/cut nodes
+job% = 9
+CursorDisplay px%, py%
+FOR i% = 0 TO 92: SWAP curs%(i%), curs2%(i%): NEXT i%
+CursorDisplay px%, py%
+KeySwitch 0
+SetInst job%
+wx1% = 47 * 8 - 8
+wx2% = 47 * 8 + 40
+wy1% = line1% * texth% - texth%
+wy2% = line1% * 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$(16), 0, 1
+'
+startdispcut:
+Marking 2, n%
+IF n% = 0 THEN Marking 2, n%: GOTO donedispcut
+selh% = 1
+DO
+ CursorMotion keyin%
+LOOP UNTIL keyin% <> 1
+Marking 2, n%
+IF keyin% = 4 THEN GOTO donedispcut
+VIEW SCREEN (0, 0)-(windowx%(0), winpy%)
+selh% = 0
+Marking.Chk 2, sobj%, snode%
+IF sobj% < 0 THEN GOTO startdispcut
+SELECT CASE keyin%
+ CASE 2
+ Disp.D sobj%, snode%
+ CASE 3
+ Disp.C sobj%, snode%
+END SELECT
+GOTO startdispcut
+'
+donedispcut:
+SetInst job%
+KeySwitch 1
+CursorDisplay px%, py%
+FOR i% = 0 TO 92: SWAP curs%(i%), curs2%(i%): NEXT i%
+CursorDisplay px%, py%
+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 line1%, 47: COLOR 3: PRINT kky$(16); : COLOR 7
+'
+END SUB
+
+SUB EditObject
+' edit one object
+job% = 8
+KeySwitch 0
+SetInst job%
+wx1% = 31 * 8 - 8
+wx2% = 31 * 8 + 40
+wy1% = line1% * texth% - texth%
+wy2% = line1% * 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$(15), 0, 1
+'
+Marking 1, n%
+startediting:
+IF n% = 0 THEN Marking 1, n%: GOTO donediting
+selh% = 1
+startediting2:
+DO
+ CursorMotion keyin%
+ IF keyin% = 4 THEN Marking 1, n%: GOTO donediting
+LOOP UNTIL keyin% = 2 OR keyin% = 3
+Marking.Chk 1, sobj%, snode%
+IF sobj% < 0 THEN
+ IF keyin% = 3 THEN
+ G.Group1 1 '1 means change thickness
+ END IF
+ GOSUB donediting
+END IF
+VIEW SCREEN (0, 0)-(windowx%(0), winpy%)
+Marking.One 1, sobj%
+FOR i% = 0 TO 6: obj%(nobj%, i%) = obj%(sobj%, i%): NEXT i%
+FOR i% = 0 TO obj%(nobj%, 1): xx(nobj%, i%) = xx(sobj%, i%)
+yy(nobj%, i%) = yy(sobj%, i%): NEXT i%
+CursorDisplay px%, py%
+SetObject sobj%, 0, 0
+CursorDisplay px%, py%
+selh% = 0
+ON fnoo%(sobj%) GOSUB edline, edline, edline, edline, edcrcl, edarc, edellps, edbox, edbox, edstring, edarrw
+CursorDisplay px%, py%
+SetObject sobj%, 7, 0
+CursorDisplay px%, py%
+Marking.One 1, sobj%
+GOTO startediting
+'
+edline:
+obj%(sobj%, 4) = thick%: obj%(sobj%, 5) = ltype%
+IF keyin% = 3 AND fnoo%(sobj%) >= 2 THEN GOTO regularshape
+obj%(sobj%, 0) = obj%(sobj%, 0) + 4 - 2 * fnoo%(sobj%)
+IF fnoo%(sobj%) = 0 OR fnoo%(sobj%) = 2 THEN obj%(sobj%, 0) = obj%(sobj%, 0) + 2
+
+'**** added for converting poly to original shape ****
+IF (fnoo%(sobj%) = 1 OR fnoo%(sobj%) = 2) AND obj%(sobj%, 6) <> 0 THEN
+ FOR itemp% = obj%(sobj%, 6) TO (obj%(sobj%, 1) - 1)
+ xx(sobj%, itemp%) = xx(sobj%, itemp% + 1)
+ yy(sobj%, itemp%) = yy(sobj%, itemp% + 1)
+ NEXT itemp%
+ obj%(sobj%, 6) = 0
+ FOR itemp% = 1 TO 3: obj%(sobj%, itemp%) = obj%(sobj%, itemp%) - 1: NEXT itemp%
+END IF
+'****************************
+IF fnoo%(sobj%) > 2 AND INT(obj%(sobj%, 1) / 2) * 2 <> obj%(sobj%, 1) THEN
+ G.Addnode sobj%, obj%(sobj%, 1), 1
+ FOR i% = 0 TO nobj% - 1
+ IF fnoo%(i%) = 11 AND obj%(i%, 5) = sobj% AND obj%(i%, 6) <> 0 THEN obj%(i%, 6) = obj%(i%, 6) + 1
+ NEXT i%
+END IF
+GOSUB OKarrow: RETURN
+' keyin%=3 and closed line or curve
+regularshape:
+x0 = 0!: y0 = 0!
+FOR i% = 0 TO obj%(sobj%, 2): x0 = x0 + xx(sobj%, i%): y0 = y0 + yy(sobj%, i%)
+NEXT i%: x0 = x0 / (obj%(sobj%, 2) + 1): y0 = y0 / (obj%(sobj%, 2) + 1)
+IF fnoo%(sobj%) <> 3 THEN
+ x2 = 2! * pi / obj%(sobj%, 1)
+ELSE
+ x3 = x0: y3 = y0
+ x0 = (xx(sobj%, 0) + xx(sobj%, obj%(sobj%, 1))) / 2!
+ y0 = (yy(sobj%, 0) + yy(sobj%, obj%(sobj%, 1))) / 2!
+ x4 = xx(sobj%, 0) - xx(sobj%, obj%(sobj%, 1))
+ y4 = yy(sobj%, 0) - yy(sobj%, obj%(sobj%, 1))
+ x3 = x3 - x0: y3 = y3 - y0
+ x2 = pi / obj%(sobj%, 1)
+ IF x4 * y3 - y4 * x3 > 0 THEN x2 = -x2
+END IF
+SELECT CASE fnoo%(sobj%)
+CASE IS = 2
+ rad = SQR((xx(sobj%, snode%) - x0) ^ 2 + (yy(sobj%, snode%) - y0) ^ 2)
+ s1 = Angle(x0, y0, xx(sobj%, snode%), yy(sobj%, snode%))
+ xx(sobj%, 0) = xx(sobj%, snode%): yy(sobj%, 0) = yy(sobj%, snode%)
+ xx(sobj%, obj%(sobj%, 1)) = xx(sobj%, snode%)
+ yy(sobj%, obj%(sobj%, 1)) = yy(sobj%, snode%)
+ FOR i% = 1 TO obj%(sobj%, 2)
+ xx(sobj%, i%) = x0 + rad * COS(s1 + x2 * i%)
+ yy(sobj%, i%) = y0 - rad * SIN(s1 + x2 * i%)
+ NEXT i%
+CASE IS >= 3
+ r1 = -10000!: r3 = 10000!
+ FOR i% = 0 TO obj%(sobj%, 2)
+ rad = SQR((xx(sobj%, i%) - x0) ^ 2 + (yy(sobj%, i%) - y0) ^ 2)
+ IF rad > r1 THEN r1 = rad: s1 = Angle(x0, y0, xx(sobj%, i%), yy(sobj%, i%))
+ IF rad < r3 THEN r3 = rad
+ NEXT i%
+ IF fnoo%(sobj%) = 4 THEN
+ s1 = s1 + pi / 2!
+ ELSE
+ x1 = x4 * COS(s1) - y4 * SIN(s1): y1 = x4 * SIN(s1) + y4 * COS(s1)
+ x3 = SGN(y1) * SQR(ABS(4! * r1 * r1 - x1 * x1))
+ IF x1 > 0! THEN
+ s2 = -ATN(x3 / x1)
+ ELSEIF x1 < 0! THEN
+ s2 = -ATN(x3 / x1) - pi
+ ELSE
+ s2 = -SGN(x3) * pi / 2!
+ END IF
+ x3 = SIN(s2): IF x3 <> 0! THEN y3 = -y1 / 2! / x3: IF y3 > 1! THEN r3 = y3
+ END IF
+ FOR i% = 0 TO obj%(sobj%, 2)
+ IF fnoo%(sobj%) = 3 THEN
+ x3 = r1 * COS(i% * x2 + s2): y3 = -r3 * SIN(i% * x2 + s2)
+ ELSE
+ x3 = r3 * COS(i% * x2): y3 = -r1 * SIN(i% * x2)
+ END IF
+ xx(sobj%, i%) = x0 + x3 * COS(s1) + y3 * SIN(s1)
+ yy(sobj%, i%) = y0 - x3 * SIN(s1) + y3 * COS(s1)
+ NEXT i%
+ IF fnoo%(sobj%) = 4 THEN
+ xx(sobj%, obj%(sobj%, 1)) = xx(sobj%, 0)
+ yy(sobj%, obj%(sobj%, 1)) = yy(sobj%, 0)
+ END IF
+END SELECT
+RETURN
+'
+edcrcl:
+IF xx(nobj%, 1) > pxmax% OR xx(nobj%, 1) < pxmin% OR yy(nobj%, 1) > pymax2% OR yy(nobj%, 1) < pymin% THEN
+ RETURN
+END IF
+obj%(nobj%, 4) = thick%
+CursorDisplay px%, py%
+px% = xx(nobj%, 1): py% = yy(nobj%, 1)
+SetObject nobj%, 7, 0
+CursorDisplay px%, py%
+DO
+ CursorMotion keyin%
+ CursorDisplay px%, py%
+ SetObject nobj%, 0, 0
+ IF keyin% = 4 THEN
+ CursorDisplay px%, py%: GOTO edcrcldone
+ END IF
+ xx(nobj%, 1) = px%: yy(nobj%, 1) = py%
+ xx(nobj%, 2) = SQR((px% - xx(nobj%, 0)) ^ 2 + (py% - yy(nobj%, 0)) ^ 2)
+ SetObject nobj%, 7, 0
+ CursorDisplay px%, py%
+LOOP UNTIL keyin% = 2
+GOSUB editok
+edcrcldone:
+RETURN
+'
+edarc:
+obj%(nobj%, 4) = thick%
+CursorDisplay px%, py%
+SetObject nobj%, 7, 0
+px% = xx(nobj%, snode%): py% = yy(nobj%, snode%)
+CursorDisplay px%, py%
+pxold% = px%: pyold% = py%
+DO
+ CursorMotion keyin%
+ CursorDisplay px%, py%
+ SetObject nobj%, 0, 0
+ IF keyin% = 4 THEN CursorDisplay px%, py%: GOTO edarcdone
+ x0 = xx(nobj%, 1): y0 = yy(nobj%, 1): rad = xx(nobj%, 3)
+ x3 = xx(nobj%, 2): y3 = yy(nobj%, 2)
+ r1 = yy(nobj%, 3): r3 = yy(nobj%, 4)
+ x1 = xx(nobj%, 0): y1 = yy(nobj%, 0)
+ IF snode% = 1 THEN
+ cx = (x1 + x3) / 2!: cy = (y1 + y3) / 2!
+ IF x1 = x3 THEN
+ y0 = cy: x0 = px%
+ ELSEIF y1 = y3 THEN
+ x0 = cx: y0 = py%
+ ELSE
+ dx = x3 - x1: dy = y3 - y1
+ x0 = (dx * cx / dy + dy * px% / dx - py% + cy) / (dx / dy + dy / dx)
+ y0 = py% + dy * (x0 - px%) / dx
+ END IF
+ xx(nobj%, 3) = SQR((x0 - x1) ^ 2 + (y0 - y1) ^ 2)
+ yy(nobj%, 3) = Angle(x0, y0, xx(nobj%, 0), yy(nobj%, 0))
+ yy(nobj%, 4) = Angle(x0, y0, xx(nobj%, 2), yy(nobj%, 2))
+ xx(nobj%, 1) = x0: yy(nobj%, 1) = y0
+ px% = INT(x0): py% = INT(y0)
+ ELSE
+ IF snode% = 0 THEN x1 = px%: y1 = py% ELSE x3 = px%: y3 = py%
+ x4 = SQR((x1 - x3) ^ 2 + (y1 - y3) ^ 2) / 2!
+ IF x4 > rad THEN
+ px% = pxold%: py% = pyold%
+ ELSE
+ y4 = SQR(rad * rad - x4 * x4)
+ s2 = Angle(0!, 0!, y4, -x4)
+ IF (r3 > r1 AND r3 - r1 > pi) OR (r3 < r1 AND r3 - r1 > -pi) THEN s2 = pi - s2
+ s2 = 2! * s2
+ x4 = x3 - x1 * COS(s2) - y1 * SIN(s2)
+ y4 = y3 - y1 * COS(s2) + x1 * SIN(s2)
+ xx(nobj%, 1) = ((1! - COS(s2)) * x4 + SIN(s2) * y4) / 2! / (1! - COS(s2))
+ yy(nobj%, 1) = ((1! - COS(s2)) * y4 - SIN(s2) * x4) / 2! / (1! - COS(s2))
+ xx(nobj%, snode%) = px%: yy(nobj%, snode%) = py%
+ yy(nobj%, 3) = Angle(xx(nobj%, 1), yy(nobj%, 1), x1, y1)
+ yy(nobj%, 4) = Angle(xx(nobj%, 1), yy(nobj%, 1), x3, y3)
+ pxold% = px%: pyold% = py%
+ END IF
+ END IF
+ SetObject nobj%, 7, 0
+ px% = INT(CSNG(px%) / CSNG(s%)) * s%: py% = INT(CSNG(py%) / CSNG(s%)) * s%
+ CursorDisplay px%, py%
+LOOP UNTIL keyin% = 2
+xx(nobj%, 0) = xx(nobj%, 1) + xx(nobj%, 3) * COS(yy(nobj%, 3))
+yy(nobj%, 0) = yy(nobj%, 1) - xx(nobj%, 3) * SIN(yy(nobj%, 3))
+xx(nobj%, 2) = xx(nobj%, 1) + xx(nobj%, 3) * COS(yy(nobj%, 4))
+yy(nobj%, 2) = yy(nobj%, 1) - xx(nobj%, 3) * SIN(yy(nobj%, 4))
+GOSUB editok
+edarcdone:
+GOSUB OKarrow
+RETURN
+'
+edellps:
+IF xx(nobj%, 1) > pxmax% OR xx(nobj%, 1) < pxmin% OR yy(nobj%, 1) > pymax2% OR yy(nobj%, 1) < pymin% THEN
+ RETURN
+END IF
+obj%(nobj%, 4) = thick%
+CursorDisplay px%, py%
+px% = xx(nobj%, 0): py% = yy(nobj%, 0)
+IF yy(nobj%, 2) > 1 THEN
+ px% = px% + xx(nobj%, 2) / yy(nobj%, 2)
+ py% = py% - xx(nobj%, 2)
+ELSE
+ px% = px% + xx(nobj%, 2)
+ py% = py% - xx(nobj%, 2) * yy(nobj%, 2)
+END IF
+SetObject nobj%, 7, 0
+CursorDisplay px%, py%
+DO
+ CursorMotion keyin%
+ CursorDisplay px%, py%
+ SetObject nobj%, 0, 0
+ IF keyin% = 4 THEN CursorDisplay px%, py%: GOTO edellpsdone
+ rad = ABS(px% - xx(nobj%, 0)): rt = ABS(py% - yy(nobj%, 0))
+ IF rad > rt THEN
+ rt = rt / rad
+ ELSE
+ IF rad <> 0 THEN SWAP rad, rt: rt = rad / rt
+ END IF
+ xx(nobj%, 2) = rad: yy(nobj%, 2) = rt
+ SetObject nobj%, 7, 0
+ CursorDisplay px%, py%
+LOOP UNTIL keyin% = 2
+xx(nobj%, 1) = xx(nobj%, 0): yy(nobj%, 1) = yy(nobj%, 0)
+IF rt < 1! THEN
+ xx(nobj%, 1) = xx(nobj%, 1) + rad
+ELSE
+ yy(nobj%, 1) = yy(nobj%, 1) - rad
+END IF
+GOSUB editok
+edellpsdone:
+RETURN
+'
+edbox:
+fillnow% = fill%
+obj%(nobj%, 4) = thick%: obj%(nobj%, 5) = ltype%
+fill% = obj%(nobj%, 6)
+CursorDisplay px%, py%
+SetObject nobj%, 7, 0
+CursorDisplay px%, py%
+inbox% = 2
+DO
+ CursorMotion keyin%
+ CursorDisplay px%, py%
+ wkill% = 1
+ SetObject nobj%, 0, 0
+ IF keyin% = 4 THEN CursorDisplay px%, py%: GOTO edboxdone
+ obj%(nobj%, 6) = fill%
+ IF fill% <> 0 THEN
+ obj%(nobj%, 0) = obj%(nobj%, 0) - fnoo%(nobj%) + 9: obj%(nobj%, 5) = 0
+ ELSE
+ obj%(nobj%, 0) = obj%(nobj%, 0) - fnoo%(nobj%) + 8
+ END IF
+ xx(nobj%, snode%) = px%: yy(nobj%, snode%) = py%
+ SetObject nobj%, 7, 0
+ CursorDisplay px%, py%
+LOOP UNTIL keyin% = 2
+inbox% = 0
+'****add here for edit boxtext (NOT COMPLETE OR FUNCTIONAL!)
+ FOR ibt% = 0 TO nobj% - 1
+ IF obj%(ibt%, 0) = 10 THEN
+ IF (obj%(ibt%, 6) = (sobj% + 1)) THEN
+ tempx0% = xx(nobj%, 0)
+ tempx1% = xx(nobj%, 1)
+ tempy0% = yy(nobj%, 0)
+ tempy1% = yy(nobj%, 1)
+ 'recalculate coordinates for boxtext
+ SetObject ibt%, 0, 0
+ '------------
+ xx(ibt%, 0) = tempx1% - ((tempx1% - tempx0%) / 2)
+ yy(ibt%, 0) = tempy1% - ((tempy1% - tempy0%) / 2) - texth% + 4
+ '------------
+ '
+ SetObject ibt%, 7, 0
+ EXIT FOR
+ END IF
+ END IF
+ NEXT ibt%
+' **** End Edit Boxtext ****
+GOSUB editok
+edboxdone:
+fill% = fillnow%
+RETURN
+'
+edstring:
+chartypeold% = chartype%: charptold% = charpt%
+chartype% = obj%(nobj%, 5): charpt% = obj%(nobj%, 4)
+edstring1:
+CursorDisplay px%, py%
+SetObject nobj%, 7, 0
+pxold% = px%: pyold% = py%
+LINE (px%, py%)-(px% + epitch%(chartype%, 0) * charpt% / 250 * ptmm, py% + eheight(chartype%) * charpt% * ptmm / .25), 2, B
+CursorDisplay px%, 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%
+ams$ = ""
+FOR i% = 1 TO obj%(nobj%, 1)
+IF SGN(yy(nobj%, i%)) = 0 THEN
+ ams$ = ams$ + CHR$(xx(nobj%, i%))
+ELSE
+ ams$ = ams$ + STRING$(1, VAL("&j" + HEX$(yy(nobj%, i%)) + HEX$(xx(nobj%, i%))))
+END IF
+NEXT i%
+L.Text px%, py%: PRINT "-> "; : Chr.Input ams$
+L.Text px%, py%: PRINT SPACE$(LEN(ams$) + 3);
+CursorDisplay px%, py%
+SetObject nobj%, 0, 0
+CursorDisplay px%, py%
+obj%(nobj%, 4) = charpt%: obj%(nobj%, 5) = chartype%
+IF ams$ <> "" THEN
+ obj%(nobj%, 1) = LEN(ams$)
+ G.Charset ams$, nobj%
+END IF
+j% = 0: FOR i% = 1 TO obj%(nobj%, 1): j% = j% + yy(nobj%, i%): NEXT i%
+IF j% <> 0 AND chartype% > 1 THEN obj%(nobj%, 5) = obj%(nobj%, 5) - 2
+GOSUB editok
+edstringdone:
+chartype% = chartypeold%: charpt% = charptold%
+RETURN
+'
+edarrw: RETURN ' no edit for arrows
+'
+OKarrow:
+FOR i% = 0 TO nobj% - 1
+IF fnoo%(i%) = 11 AND obj%(i%, 5) = sobj% THEN
+ CursorDisplay px%, py%
+ SetObject i%, 0, 0
+ obj%(i%, 4) = obj%(sobj%, 4)
+ G.ArrowDirec sobj%, obj%(i%, 6), i%
+ SetObject i%, 7, 0
+ CursorDisplay px%, py%
+END IF
+NEXT i%
+RETURN
+'
+editok:
+FOR i% = 0 TO 6: obj%(sobj%, i%) = obj%(nobj%, i%): NEXT i%
+FOR i% = 0 TO obj%(sobj%, 1): xx(sobj%, i%) = xx(nobj%, i%)
+yy(sobj%, i%) = yy(nobj%, i%): NEXT i%
+RETURN
+'
+donediting:
+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 line1%, 31: COLOR 3: PRINT kky$(15); : COLOR 7
+CL.R.edraw 0, 0
+'
+END SUB
+
+SUB G.Group
+' get several objects grouped
+job% = 13
+KeySwitch 0
+LOCATE 2, 2: COLOR 11: PRINT "Setting Group No. "; group%; : COLOR 7
+SetInst job%
+'
+Marking 1, n%
+IF n% = 0 THEN Marking 1, n%: GOTO donegrouping
+c% = 0
+DO
+ CursorMotion keyin%
+ SELECT CASE keyin%
+ CASE 4
+ ggroup% = 100 * group%
+ FOR i% = 0 TO nobj% - 1
+ IF obj%(i%, 0) <> fnoo%(i%) THEN
+ IF obj%(i%, 0) - fnoo%(i%) = ggroup% THEN
+ Marking.One 1, i%
+ obj%(i%, 0) = fnoo%(i%)
+ Marking.One 1, i%
+ END IF
+ END IF
+ NEXT i%
+ GOTO donegrouping
+ CASE 2 TO 3
+ Marking.Chk 1, sobj%, snode%
+ IF sobj% >= 0 THEN
+ Marking.One 1, sobj%
+ IF fnoo%(sobj%) <> obj%(sobj%, 0) THEN
+ ggroup% = obj%(sobj%, 0) - fnoo%(sobj%)
+ IF ggroup% = 100 * group% THEN c% = 0
+ obj%(sobj%, 0) = fnoo%(sobj%)
+ FOR i% = 0 TO nobj% - 1
+ IF obj%(i%, 0) <> fnoo%(i%) THEN
+ IF obj%(i%, 0) - fnoo%(i%) = ggroup% THEN
+ Marking.One 1, i%
+ obj%(i%, 0) = fnoo%(i%)
+ Marking.One 1, i%
+ END IF
+ END IF
+ NEXT i%
+ ELSE
+ obj%(sobj%, 0) = 100 * group% + obj%(sobj%, 0)
+ c% = c% + 1
+ END IF
+ Marking.One 1, sobj%
+ END IF
+ END SELECT
+LOOP UNTIL keyin% = 3
+IF c% <> 0 THEN group% = group% + 1
+'
+donegrouping:
+Marking 1, n%
+SetInst job%
+LOCATE 2, 2: COLOR 0: PRINT SPACE$(25); : COLOR 7
+KeySwitch 1
+job% = 0
+'
+END SUB
+
+SUB Help.Me
+' help messages
+KEY(17) OFF: KEY(19) OFF
+SCREEN scrtype%
+VIEW PRINT 1 TO line3%
+CLS 0
+SCREEN scrtype%
+COLOR 7
+ON job% + 1 GOSUB h.0, h.1, h.2, h.3, h.4, h.5, h.6, h.7, h.8, h.9, h.10, h.11, h.12
+VIEW PRINT 1 TO line1%
+SCREEN scrtype%
+IF seljob% <> 0 THEN VIEW SCREEN (0, 0)-(windowx%(0), windowy%(0))
+CL.R.edraw 0, 0
+IF seljob% <> 0 AND py% > pymax2% THEN py% = pymax2%
+CursorDisplay px%, py%
+KeyDisplay
+SetInst 0
+SELECT CASE seljob%
+ CASE 0
+ linesel% = 0
+ CASE 1 TO 5
+ wx1% = (seljob% * 7 - 4) * 8 - 8
+ wx2% = (seljob% * 7 - 4) * 8 + 40
+ wy1% = (line2% + linesel%) * texth% - texth%
+ wy2% = (line2% + linesel%) * texth%
+ CASE 6 TO 9
+ wx1% = (5 + seljob% * 7) * 8 - 8
+ wx2% = (5 + seljob% * 7) * 8 + 40
+ wy1% = (line2% + linesel%) * texth% - texth%
+ wy2% = (line2% + linesel%) * texth%
+END SELECT
+COLOR 11
+IF seljob% <> 0 THEN
+ 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$(seljob% + linesel% * 10), 0, 1
+ COLOR 7
+ VIEW SCREEN (0, 0)-(windowx%(0), winpy%)
+END IF
+IF selh% = 1 THEN Marking 1, n%
+KEY(17) ON: KEY(19) ON
+help% = 1
+EXIT SUB
+'
+h.0:
+KeySwitch 0
+PRINT
+PRINT
+PRINT TAB(3); " FUNCTION KEY (A) ==> [ESC] ==> (B) ==> [ESC] ==> (C) ==> [ESC] ==> (A)"
+
+PRINT TAB(11); "(A)"; TAB(35); "(B)"; TAB(60); "(C)";
+PRINT TAB(1); " f.1: Straight Lines"; TAB(28); "to Move objects"; TAB(54); "to change Box Fill Pattern"
+PRINT TAB(1); " f.2: Curves"; TAB(28); "to Copy objects"; TAB(54); "to change font type"
+PRINT TAB(1); " f.3: Circles & Ellipses"; TAB(28); "to Copy symmetrically"; TAB(54); "to change font size"
+PRINT TAB(1); " f.4: Arcs"; TAB(28); "to Rotate objects"; TAB(54); "to Zoom"
+PRINT TAB(1); " f.5: Boxes w/wo filler"; TAB(28); "to Edit objects"; TAB(54); "to Hide/Show Text"
+PRINT TAB(1); " f.6: Polygons"; TAB(28); "to Cut or Move nodes"; TAB(54); "to Redraw screen"
+PRINT TAB(1); " f.7: Closed curves"; TAB(28); "to Kill objects"; TAB(54); "to Reset (clear) drawing"
+PRINT TAB(1); " f.8: Arrows"; TAB(28); "to change line Pattern"
+PRINT TAB(1); " f.9: Strings"; TAB(28); "to change line Thickness"
+PRINT TAB(1); "f.10: File operations"; TAB(28); "to change cursor pitch"
+PRINT
+PRINT TAB(2); "SPACE/RETURN/DEL ==> to set each choice";
+PRINT TAB(45); "ARROWS ==> to move the cursor";
+PRINT TAB(2); "PGUP/PGDN ==> Page-up/Page-down";
+PRINT TAB(45); "CTRL+w ==> Widen window (Zoom)"
+PRINT TAB(45); "CTRL+s ==> Reset all the objects";
+PRINT TAB(45); "CTRL+r ==> Redraw all the objects"
+PRINT TAB(2); "CTRL+q ==> Quit Program";
+PRINT TAB(45); "CTRL+h ==> Context sensitive help"
+PRINT TAB(2); "CTRL+LEFT/RIGHT ARROWS ==> Shift Region Right/Left"
+PRINT TAB(2); "CTRL+T ==> Hide/Show text toggle"
+GOSUB help.hit
+KeySwitch 1
+seljob% = 0
+RETURN
+'
+h.1:
+PRINT
+PRINT TAB(5); " Lines(f.1)/ Curves(f.2)/ Polygons(f.6)/ Closed Curves(f.7)"
+PRINT
+PRINT TAB(5); " SPACE = to set intermediate points"
+PRINT TAB(5); " RETURN = to set the last point"
+PRINT TAB(5); " DEL = to cancel drawing"
+PRINT
+PRINT TAB(5); " f.8/f.9 = to change Line Type/Thickness"
+
+wnode% = 1
+GOSUB help.hit
+RETURN
+'
+h.2:
+PRINT
+PRINT TAB(5); " Circles/ Ellipses(f.3)"
+PRINT
+PRINT TAB(5); " SPACE => Circles --- to set center and radius"
+PRINT TAB(5); " RETURN => Ellipses --- to set diagonal points"
+PRINT TAB(5); " DEL = to cancel drawing"
+PRINT
+PRINT TAB(5); " f.8/f.9 = to change Line Type/Thickness"
+GOSUB help.hit
+RETURN
+'
+h.3:
+PRINT
+PRINT TAB(5); " Arcs(f.4)"
+PRINT
+PRINT TAB(5); " SPACE = to set two end points"
+PRINT TAB(5); " RETURN = to set the last point on the arc"
+PRINT TAB(5); " DEL = to cancel drawing"
+PRINT
+PRINT TAB(5); " f.8/f.9 = to change Line Type/Thickness"
+GOSUB help.hit
+RETURN
+'
+h.4:
+PRINT
+PRINT TAB(5); " Boxes with or without filler(f.5)"
+PRINT
+PRINT TAB(5); " SPACE/RETURN = to set diagonal points"
+PRINT TAB(5); " DEL = to cancel drawing"
+PRINT
+PRINT TAB(5); "After drawing box you will be asked if you"
+PRINT TAB(5); "want to add centered text to the box "
+PRINT
+PRINT TAB(5); " f.1 = to change filler pattern"
+PRINT TAB(5); " f.8/f.9 = to change Line Type/Thickness"
+
+
+GOSUB help.hit
+RETURN
+'
+h.5:
+PRINT
+PRINT TAB(5); " Strings(f.9)"
+PRINT
+PRINT TAB(5); " SPACE/RETURN = to start the string (ended by RETURN)"
+PRINT TAB(5); " DEL = to cancel "
+PRINT
+PRINT TAB(5); " Use f.1 & f.2 to change size and font"
+GOSUB help.hit
+RETURN
+'
+h.6:
+PRINT
+PRINT TAB(5); " Arrows on Lines/ Curves/ Arcs(f.8)"
+PRINT
+PRINT TAB(5); " SPACE = to set/reset one arrow at that end"
+PRINT TAB(5); " RETURN = to set/reset arrows at both ends"
+PRINT TAB(5); " DEL = to cancel drawing"
+GOSUB help.hit
+RETURN
+'
+h.7:
+PRINT
+PRINT TAB(5); " Move or Copy objects(f.1)(f.2)"
+PRINT
+PRINT TAB(5); " SPACE = to move/copy individual object"
+PRINT TAB(5); " RETURN = to set region to be moved/copied"
+PRINT TAB(5); " DEL = to cancel operation"
+GOSUB help.hit
+RETURN
+'
+h.8:
+PRINT
+PRINT TAB(5); " Edit objects(f.5) -- Line thickness and pattern are updated"
+PRINT
+PRINT TAB(5); " SPACE/RETURN = to select object/area respectively"
+PRINT TAB(5); " DEL = to cancel operation"
+PRINT : PRINT
+PRINT TAB(5); " Lines, Polygons <== (SPACE) ==> Curves, Closed Curves"
+PRINT TAB(5); " Polygons, Curves == (RETURN) ==> Regular Polygons, Ellipses"
+PRINT TAB(5); " Circles and Ellipses (SPACE) : radii can be changed"
+PRINT TAB(5); " Arcs (SPACE) : end positions and radius can be changed"
+PRINT TAB(5); " Boxes (SPACE) : size can be changed"
+PRINT TAB(5); " (RETURN) : filler pattern can be changed"
+PRINT TAB(5); " Strings (RETURN) : To end editing"
+PRINT
+PRINT TAB(5); "NOTE: To change string(s) font/size select it in area to edit"
+COLOR 14
+PRINT
+PRINT TAB(5); "NOTE: To Move or Cut nodes of Lines/ Curves/ Polygons/ Closed Curves"
+PRINT TAB(5); " Use DspCut(f.6)"
+COLOR 7
+
+GOSUB help.hit
+RETURN
+'
+h.9:
+PRINT
+PRINT TAB(5); " Move or Cut nodes of Lines/ Curves/ Polygons/ Closed Curves(f.6)"
+PRINT
+PRINT TAB(5); " SPACE = to move the node"
+PRINT TAB(5); " RETURN = to cut the node"
+PRINT TAB(5); " DEL = to cancel operation"
+GOSUB help.hit
+RETURN
+'
+h.10:
+PRINT
+PRINT TAB(5); " Kill objects(f.7)"
+PRINT
+PRINT TAB(5); " SPACE/RETURN = to select the object/area respectively"
+PRINT TAB(5); " y = to confirm this choice"
+PRINT TAB(5); " n = to cancel operation"
+GOSUB help.hit
+RETURN
+'
+h.11:
+PRINT
+PRINT TAB(5); " Symmetric copy of Lines/ Curves/ Polygons/ Closed Curves(f.3)"
+PRINT
+PRINT TAB(5); " SPACE = to copy symmetrically with respect to the horizontal axis"
+PRINT TAB(5); " RETURN = to copy symmetrically with respect to the vertical axis"
+PRINT TAB(5); " DEL = to cancel operation"
+GOSUB help.hit
+RETURN
+'
+h.12:
+PRINT
+PRINT TAB(5); " Rotate Lines/ Curves/ Polygons/ Closed Curves(f.4)"
+PRINT
+PRINT TAB(5); " Before any operation:"
+PRINT TAB(5); " RETURN = to enter the incremental angle"
+PRINT
+PRINT TAB(5); " After the set:"
+PRINT TAB(5); " ARROWS, SPACE = anticlockwise rotation"
+PRINT TAB(5); " RETURN = to set the position and copy"
+PRINT TAB(5); " DEL = to cancel operation"
+GOSUB help.hit
+RETURN
+'
+help.hit:
+PRINT : PRINT TAB(60); : COLOR 10: PRINT "< Hit any key >"; : COLOR 7
+DO: res$ = INKEY$: LOOP UNTIL res$ <> ""
+RETURN
+'
+END SUB
+
+SUB Killer (i%, s%)
+' kill i%
+wkill% = 1
+SetObject i%, 0, 0
+IF i% <> nobj% - 1 THEN
+ FOR j% = i% + 1 TO nobj% - 1
+ FOR k% = 0 TO 6: obj%(j% - 1, k%) = obj%(j%, k%): NEXT k%
+ FOR k% = 0 TO obj%(j% - 1, 1): xx(j% - 1, k%) = xx(j%, k%)
+ yy(j% - 1, k%) = yy(j%, k%): NEXT k%
+ IF fnoo%(j% - 1) = 11 AND obj%(j% - 1, 5) <> s% AND obj%(j% - 1, 5) > i% THEN obj%(j% - 1, 5) = obj%(j% - 1, 5) - 1
+ NEXT j%
+END IF
+nobj% = nobj% - 1
+'
+END SUB
+
+SUB KillObject
+' kill one object
+job% = 10
+CursorDisplay px%, py%
+FOR i% = 0 TO 92: SWAP curs%(i%), curs1%(i%): NEXT i%
+CursorDisplay px%, py%
+KeySwitch 0
+SetInst job%
+wx1% = 54 * 8 - 8
+wx2% = 54 * 8 + 40
+wy1% = line1% * texth% - texth%
+wy2% = line1% * 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$(17), 0, 1
+'
+Marking 1, n%
+startkilling:
+IF n% = 0 THEN Marking 1, n%: GOTO donekilling
+selh% = 1
+DO
+ CursorMotion keyin%
+ IF keyin% = 4 THEN Marking 1, n%: GOTO donekilling
+LOOP UNTIL keyin% <> 1
+IF keyin% = 2 THEN
+selh% = 0
+VIEW SCREEN (0, 0)-(windowx%(0), winpy%)
+Marking.Chk 1, sobj%, snode%
+IF sobj% < 0 THEN Marking 1, n%: GOTO donekilling
+ipy% = py%: ipx% = px%: L.Text ipx%, ipy%
+PRINT "Sure(y/n)??";
+bkey$ = yesno$
+L.Text ipx%, ipy%: PRINT SPACE$(12);
+IF bkey$ = "n" THEN Marking 1, n%: SetObject sobj%, 7, 0: GOTO donekilling
+CursorDisplay px%, py%
+grp% = obj%(sobj%, 0) - fnoo%(sobj%)
+DO
+ Marking.One 1, sobj%
+ i% = sobj% 'arrow deleting
+ DO UNTIL i% = nobj% - 1
+ i% = i% + 1
+ IF fnoo%(i%) = 11 AND obj%(i%, 5) = sobj% THEN
+ Killer i%, sobj%
+ i% = i% - 1
+ END IF
+ LOOP
+ Killer sobj%, sobj% 'kill THAT object
+ sobj% = -1
+ IF grp% <> 0 THEN 'group killing
+ FOR i% = 0 TO nobj% - 1
+ IF obj%(i%, 0) - fnoo%(i%) = grp% THEN sobj% = i%: EXIT FOR
+ NEXT i%
+ END IF
+LOOP UNTIL sobj% < 0
+CursorDisplay px%, py%
+IF nobj% <> 0 THEN GOTO startkilling
+'=======================
+ ELSEIF keyin% = 3 THEN
+ G.Group1 0 ' 0 means kill
+'==========================
+END IF
+'
+donekilling:
+SetInst job%
+KeySwitch 1
+CursorDisplay px%, py%
+FOR i% = 0 TO 92: SWAP curs%(i%), curs1%(i%): NEXT i%
+CursorDisplay px%, py%
+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 line1%, 54: COLOR 3: PRINT kky$(17); : COLOR 7
+'
+END SUB
+
+SUB MarkEnds (c%)
+' marking end points only
+c% = 0
+xyshift% = INT(3! * wndwxy(wndwfctr%))
+FOR i% = 0 TO nobj% - 1
+IF fnoo%(i%) <> 1 AND fnoo%(i%) <> 3 AND fnoo%(i%) <> 6 THEN GOTO nomarkends
+c% = c% + 1
+PPUT xx(i%, 0) - xyshift%, yy(i%, 0) - xyshift%, mark%()
+PPUT xx(i%, obj%(i%, 2)) - xyshift%, yy(i%, obj%(i%, 2)) - xyshift%, mark%()
+nomarkends: NEXT i%
+'
+END SUB
+
+SUB Marking (c%, n%)
+' marking1 or marking2 (c%=1,2)
+IF nobj% = 0 THEN EXIT SUB
+n% = 0
+FOR i% = 0 TO nobj% - 1
+IF obj%(i%, c% + 1) < 0 THEN GOTO nomarking
+Marking.One c%, i%: n% = n% + 1
+nomarking: NEXT i%
+'
+END SUB
+
+SUB Marking.Chk (m%, sobj%, snode%)
+' get object # chosen (marking.m%)
+sobj% = -1: snode% = -1
+more% = 0
+FOR i% = 0 TO nobj% - 1
+IF obj%(i%, m% + 1) < 0 THEN GOTO nomarkchk
+FOR j% = 0 TO obj%(i%, m% + 1)
+dist = SQR((xx(i%, j%) - CSNG(px%)) ^ 2 + (yy(i%, j%) - CSNG(py%)) ^ 2)
+IF dist < 3! * wndwxy(wndwfctr%) THEN
+ sobj% = i%: snode% = j%
+ SetObject sobj%, 3, 0
+'------------------
+' check for for next
+'
+FOR i1% = i% + 1 TO nobj% - 1
+ FOR j1% = 0 TO obj%(i1%, m% + 1)
+ dist = SQR((xx(i1%, j1%) - CSNG(px%)) ^ 2 + (yy(i1%, j1%) - CSNG(py%)) ^ 2)
+ IF dist < 3! * wndwxy(wndwfctr%) THEN
+ more% = 1
+ EXIT FOR
+ END IF
+ NEXT j1%
+ IF more% = 1 THEN EXIT FOR
+NEXT i1%
+IF more% = 1 THEN
+ ipy% = py%: ipx% = px%: L.Text ipx%, ipy%
+ PRINT "y/n?";
+ bkey$ = yesno$
+ L.Text ipx%, ipy%: PRINT SPACE$(5);
+ELSE
+ bkey$ = "y"
+END IF
+'------------
+IF bkey$ = "y" THEN EXIT SUB
+ SetObject sobj%, 7, 0
+ sobj% = -1: snode% = -1
+END IF
+NEXT j%
+nomarkchk: NEXT i%
+'
+END SUB
+
+SUB Marking.One (c%, i%)
+' mark one object
+xyshift% = INT(3! * wndwxy(wndwfctr%))
+FOR j% = 0 TO obj%(i%, c% + 1)
+ IF fnoo%(i%) = obj%(i%, 0) THEN
+ PPUT xx(i%, j%) - xyshift%, yy(i%, j%) - xyshift%, mark%()
+ ELSE
+ PPUT xx(i%, j%) - xyshift%, yy(i%, j%) - xyshift%, markg%()
+ END IF
+NEXT j%
+'
+END SUB
+
+SUB Marking.Reg (sx%, sy%, ex%, ey%, total%)
+' get objects # chosen
+total% = -1
+FOR i% = 0 TO nobj% - 1: IF obj%(i%, 2) < 0 THEN GOTO nomarkreg
+FOR j% = 0 TO obj%(i%, 1)
+IF (xx(i%, j%) - sx%) * (xx(i%, j%) - ex%) > 0 THEN GOTO nomarkreg1
+IF (yy(i%, j%) - sy%) * (yy(i%, j%) - ey%) > 0 THEN GOTO nomarkreg1
+total% = total% + 1: mobj%(total%) = i%: GOTO nomarkreg
+nomarkreg1: NEXT j%
+nomarkreg: NEXT i%
+'
+END SUB
+
+SUB Object.Max.Check
+' only warn the maximum
+IF nobj% < UBOUND(xx, 1) THEN EXIT SUB
+LOCATE 2, 25
+IF nobj% = UBOUND(xx, 1) THEN
+ COLOR 14
+ PRINT CHR$(7); " The next one will be the last object. ";
+ELSE
+ COLOR 10
+ PRINT CHR$(7); " This one is the very very last one!!! ";
+END IF
+COLOR 7
+'
+END SUB
+
+SUB Rotate
+' rotate object
+job% = 12
+KeySwitch 0
+SetInst job%
+s2 = pi / 90!
+wx1% = 24 * 8 - 8
+wx2% = 24 * 8 + 40
+wy1% = line1% * texth% - texth%
+wy2% = line1% * 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$(14), 0, 1
+'
+startrotate:
+Marking 2, n%
+selh% = 1
+IF n% = 0 THEN Marking 2, n%: GOTO donerotate1
+DO
+ CursorMotion keyin%
+LOOP UNTIL keyin% <> 1
+Marking 2, n%
+IF keyin% = 4 THEN CursorDisplay px%, py%: GOTO donerotate
+VIEW SCREEN (0, 0)-(windowx%(0), winpy%)
+IF keyin% = 3 THEN
+ L.Text px%, py%
+ a$ = fno$(90, 1): PRINT "Angle (PI/n) : n = ";
+ Chr.Input a$: s2 = VAL(a$): IF s2 <= 0! THEN s2 = 90!
+ s2 = pi / s2
+ L.Text px%, py%: PRINT SPACE$(30);
+ GOTO startrotate
+END IF
+Marking.Chk 2, sobj%, snode%
+IF sobj% < 0 THEN GOTO startrotate
+selh% = 0
+FOR i% = 0 TO 6: obj%(nobj%, i%) = obj%(sobj%, i%): NEXT i%
+FOR i% = 0 TO obj%(nobj%, 1): xx(nobj%, i%) = xx(sobj%, i%)
+yy(nobj%, i%) = yy(sobj%, i%): NEXT i%
+DO
+ CursorMotion keyin%
+ CursorDisplay px%, py%
+ IF keyin% <> 3 THEN
+ SetObject nobj%, 0, 1
+ FOR i% = 0 TO obj%(nobj%, 1)
+ s1 = Angle(xx(nobj%, snode%), yy(nobj%, snode%), xx(nobj%, i%), yy(nobj%, i%))
+ rad = SQR((xx(nobj%, i%) - xx(nobj%, snode%)) ^ 2 + (yy(nobj%, i%) - yy(nobj%, snode%)) ^ 2)
+ xx(nobj%, i%) = xx(nobj%, snode%) + rad * COS(s1 + s2)
+ yy(nobj%, i%) = yy(nobj%, snode%) - rad * SIN(s1 + s2)
+ NEXT i%
+ IF keyin% = 4 THEN GOTO donerotate
+ SetObject nobj%, 3, 1
+ END IF
+ CursorDisplay px%, py%
+LOOP UNTIL keyin% = 3
+CursorDisplay px%, py%
+SetObject nobj%, 0, 1
+SetObject nobj%, 7, 0
+nobj% = nobj% + 1
+Object.Max.Check
+'
+donerotate:
+IF sobj% >= 0 THEN
+ SetObject sobj%, 0, 0
+ SetObject sobj%, 7, 0
+END IF
+CursorDisplay px%, py%
+donerotate1:
+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 line1%, 24: COLOR 3: PRINT kky$(14); : COLOR 7
+'
+END SUB
+
|