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
