' 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