' qfigsub.bas '\$INCLUDE: 'QB.BI' 'rem \$INCLUDE: 'C:\QB45\USERLIB\GRAPH.BI' 'REM \$INCLUDE: 'MOUSE.BI' '\$INCLUDE: 'QFIG.BI' FUNCTION Angle (x0, y0, x1, y1) ' arc sin Angle = 0!: a = 0! rad = SQR((x1 - x0) ^ 2 + (y1 - y0) ^ 2) IF rad = 0! THEN EXIT FUNCTION IF x1 = x0 THEN a = SGN(y0 - y1) * pi / 2! IF a < 0! THEN a = a + 2! * pi ELSE a = ATN((y1 - y0) / (x0 - x1)) IF x1 > x0 AND a < 0! THEN a = a + 2! * pi ELSEIF x1 < x0 THEN a = a + pi END IF END IF Angle = a ' END FUNCTION SUB D.Circles (cx%, cy%, rad, ratio, sang, eang, clr%, thickness%, simple%, wpatt%) ' circle/ellipse drawings with thickness IF ratio > 0 THEN CIRCLE (cx%, cy%), INT(rad), clr%, , , ratio IF simple% <> 1 THEN IF ratio >= 1! THEN rt1 = INT(rad): rt2 = INT(rad) / ratio ELSE rt1 = ratio * INT(rad): rt2 = INT(rad) END IF IF thickness% > 0 THEN CIRCLE (cx%, cy%), INT(rad) - 1, clr%, , , (rt1 - 1) / (rt2 - 1) IF thickness% > 1 THEN CIRCLE (cx%, cy%), INT(rad) + 1, clr%, , , (rt1 + 1) / (rt2 + 1) END IF rrt1 = rad / ratio: rrt2 = rad IF ratio < 1! THEN rrt2 = rad * ratio: rrt1 = rad IF simple% = -1 THEN MaxMin cx% + rrt1, cy% + rrt2: MaxMin cx% - rrt1, cy% - rrt2 END IF ELSE sang1 = sang: eang1 = eang IF sang < 0 THEN sang1 = 0!: eang1 = 2! * pi CIRCLE (cx%, cy%), INT(rad), clr%, sang1, eang1, 1 IF simple% <> 1 THEN IF thickness% > 0 THEN CIRCLE (cx%, cy%), INT(rad) - 1, clr%, sang1, eang1, 1 IF thickness% > 1 THEN CIRCLE (cx%, cy%), INT(rad) + 1, clr%, sang1, eang1, 1 END IF IF simple% = -1 THEN IF sang < 0 THEN MaxMin cx% + rad, cy% + rad: MaxMin cx% - rad, cy% - rad ELSE MaxMin cx% + rad * COS(sang), cy% - rad * SIN(sang) MaxMin cx% + rad * COS(eang), cy% - rad * SIN(eang) IF sang < eang THEN IF eang > pi / 2! AND sang < pi / 2! THEN MaxMin cx%, cy% - rad IF eang > pi AND sang < pi THEN MaxMin cx% - rad, cy% IF eang > 3! * pi / 2! AND sang < 3! * pi / 2! THEN MaxMin cx%, cy% + rad ELSE MaxMin cx% + rad, cy% IF eang > pi / 2! OR (eang < pi / 2! AND sang < pi / 2!) THEN MaxMin cx%, cy% - rad IF eang > pi OR (eang < pi AND sang < pi) THEN MaxMin cx% - rad, cy% IF eang > 3! * pi / 2! OR (eang < 3! * pi / 2! AND sang < 3! * pi / 2!) THEN MaxMin cx%, cy% + rad END IF END IF END IF END IF ' END SUB SUB D.Lines (sx%, sy%, ex%, ey%, clr%, box%, thickness%, linetype%, filltype%, simple%) ' line/box drawings with thickness/linetype/fill SELECT CASE box% CASE 0 LINE (sx%, sy%)-(ex%, ey%), clr%, , ltp%(linetype%) CASE 1 LINE (sx%, sy%)-(ex%, ey%), clr%, B, ltp%(linetype%) CASE 2 LINE (sx%, sy%)-(ex%, ey%), 2, B IF filltype% <> 0 AND (sx% - ex%) * (sy% - ey%) <> 0 THEN IF clr% <> 0 THEN PAINT ((sx% + ex%) / 2, (sy% + ey%) / 2), tlp\$(filltype%), 2 ELSE PAINT ((sx% + ex%) / 2, (sy% + ey%) / 2), 0, 2 END IF END IF IF wkill% = 1 AND clr% = 0 THEN LINE (sx%, sy%)-(ex%, ey%), clr%, BF wkill% = 0 ELSE LINE (sx%, sy%)-(ex%, ey%), clr%, B END IF END SELECT IF simple% <> 1 AND thickness% <> 0 THEN SELECT CASE box% CASE 0 dx% = 1: dy% = 0 IF ABS(ex% - sx%) > ABS(ey% - sy%) THEN dx% = 0: dy% = 1 LINE (sx% - dx%, sy% - dy%)-(ex% - dx%, ey% - dy%), clr%, , ltp%(linetype%) IF thickness% > 1 THEN LINE (sx% + dx%, sy% + dy%)-(ex% + dx%, ey% + dy%), clr%, , ltp%(linetype%) END IF CASE ELSE dx% = SGN(ex% - sx%): dy% = SGN(ey% - sy%) a% = ltp%(linetype%): IF box% = 2 THEN a% = ltp%(0) LINE (sx% + dx%, sy% + dy%)-(ex% - dx%, ey% - dy%), clr%, B, a% IF thickness% > 1 THEN LINE (sx% - dx%, sy% - dy%)-(ex% + dx%, ey% + dy%), clr%, B, a% END IF END SELECT END IF ' IF simple% = -1 THEN MaxMin sx%, sy%: MaxMin ex%, ey% ' END SUB SUB D.Strings (n%, clr%, simple%) ' display strings sx% = xx(n%, 0): sy% = yy(n%, 0) ipt = 0!: kanji% = 0: sylow% = 0: syhigh% = 0 IF simple% <> 1 THEN special% = 0: script% = 0 'KPUT is special WINDOW SCREEN (0, 0)-(windowx%(wndwfctr%), windowy%(wndwfctr%)) wt% = obj%(n%, 1) IF wtext% = 1 THEN wt% = 1 FOR i% = 1 TO wt% IF yy(n%, i%) = 0! THEN a\$ = CHR\$(xx(n%, i%)) IF special% = 0 AND a\$ = "\" THEN special% = 1: GOTO one.char.done IF INSTR("^\@_", a\$) <> 0 THEN IF special% = 0 AND INSTR("^@_", a\$) <> 0 THEN SELECT CASE a\$ CASE "^" script% = 1 syhigh% = INT(scrpt(1) * obj%(n%, 4) + .9) CASE "_" script% = 2 sylow% = -INT(scrpt(2) * obj%(n%, 4) + .9) CASE ELSE script% = 0 END SELECT GOTO one.char.done ELSE special% = 0 END IF ELSEIF special% = 1 THEN special% = 0 END IF IF ASC(a\$) < &H20 OR ASC(a\$) > &H7E THEN a\$ = " " scriptsize = 1!: IF script% <> 0 THEN scriptsize = .7 jpt = 8 ELSE kanji% = 1 a\$ = STRING\$(1, VAL("&j" + HEX\$(yy(n%, i%)) + HEX\$(xx(n%, i%)))) jpt = CSNG(obj%(n%, 4) * jpitch%) / 250! * ptmm END IF ssx% = sx% + INT(ipt) - pxo% ssy% = sy% - INT(scrpt(script%) * obj%(n%, 4)) - pyo% ssx% = INT(CSNG(ssx%) / wndwxy(wndwfctr%)) ssy% = INT(CSNG(ssy%) / wndwxy(wndwfctr%)) IF ssx% + INT(jpt) > pxmax% - pxo% OR ssx% + INT(jpt) < pxmin% - pxo% THEN GOTO one.char.skipped IF ssy% > pymax% - pyo% OR ssy% < pymin% - pyo% THEN EXIT FOR IF clr% <> 0 THEN ptext ssx%, ssy%, a\$, chattr%(obj%(n%, 5), 0), 0 ELSE ptext ssx%, ssy%, a\$, 0, 0 END IF one.char.skipped: ipt = ipt + jpt one.char.done: NEXT i% 'retrieve WINDOW SCREEN (pxo%, pyo%)-(pxo% + windowx%(wndwfctr%), pyo% + windowy%(wndwfctr%)) IF simple% = -1 THEN MaxMin sx%, sy% - sylow% sysy = eheight(obj%(n%, 5)): IF kanji% = 1 THEN sysy = jheight(obj%(n%, 5)) MaxMin sx% + INT(ipt), sy% + INT(sysy * obj%(n%, 4) * ptmm / .25) + syhigh% END IF ELSE ipt = 0!: special% = 0: script% = 0 FOR i% = 1 TO obj%(n%, 1) IF yy(n%, i%) = 0! THEN a\$ = CHR\$(xx(n%, i%)) IF special% = 0 AND a\$ = "\" THEN special% = 1: GOTO one.simple.done IF INSTR("^\@_", a\$) <> 0 THEN IF special% = 0 AND INSTR("^@_", a\$) <> 0 THEN SELECT CASE a\$ CASE "^" script% = 1 CASE "_" script% = 2 CASE ELSE script% = 0 END SELECT GOTO one.simple.done ELSE special% = 0 END IF ELSEIF special% = 1 THEN special% = 0 END IF IF ASC(a\$) < &H20 OR ASC(a\$) > &H7E THEN a\$ = " " scriptsize = 1!: IF script% <> 0 THEN scriptsize = .7 ipt = ipt + CSNG(INT(scriptsize * obj%(n%, 4)) * epitch%(obj%(n%, 5), ASC(a\$) - &H20)) / 250! * ptmm ELSE ipt = ipt + CSNG(obj%(n%, 4) * jpitch%) / 250! * ptmm kanji% = 1 END IF one.simple.done: NEXT i% sysy = eheight(obj%(n%, 5)): IF kanji% = 1 THEN sysy = jheight(obj%(n%, 5)) LINE (sx%, sy%)-(sx% + INT(ipt), sy% + INT(sysy * obj%(n%, 4) * ptmm / .25)), clr%, B END IF ' END SUB SUB FillPattern ' fill pattern set, silly isn't it? fill% = fill% + 1: IF fill% > UBOUND(filler%) THEN fill% = 0 ' END SUB SUB G.Addnode (o%, n%, editcc%) ' add one node when even-nodes curve is input IF n% = 1 THEN x.new% = (xx(o%, 0) + xx(o%, 1)) / 2!: y.new% = (yy(o%, 0) + yy(o%, 1)) / 2! j% = 0 ELSE dist = 0! FOR i% = 0 TO n% - 1 dist1 = SQR((xx(o%, i%) - xx(o%, i% + 1)) ^ 2 + (yy(o%, i%) - yy(o%, i% + 1)) ^ 2) IF dist1 > dist THEN j% = i%: dist = dist1 NEXT i%: t% = 0: IF j% = n% - 1 THEN t% = 1 x0% = xx(o%, j% - t%): y0% = yy(o%, j% - t%) x1% = xx(o%, j% + 1 - t%): y1% = yy(o%, j% + 1 - t%) x2% = xx(o%, j% + 2 - t%): y2% = yy(o%, j% + 2 - t%) G.XYparam x0%, y0%, x1%, y1%, x2%, y2%, ax, bx, cx, ay, by, cy t = CSNG(t%) + .5 x.new% = ax * t * t + bx * t + cx: y.new% = ay * t * t + by * t + cy END IF FOR i% = n% TO j% + 1 STEP -1 xx(o%, i% + 1) = xx(o%, i%): yy(o%, i% + 1) = yy(o%, i%): NEXT i% xx(o%, j% + 1) = x.new%: yy(o%, j% + 1) = y.new% '***** Mark Closed Curve which was originally a Poly **** IF editcc% = 1 THEN obj%(o%, 6) = j% + 1 '******************************************************** n% = n% + 1 FOR i% = 1 TO 3: obj%(o%, i%) = obj%(o%, i%) + 1: NEXT i% ' END SUB SUB G.Arc ' arc job% = 3 KeySwitch 0 'LOCATE line2%, 24: COLOR 11: PRINT kky\$(4); COLOR 7 SetInst job% wx1% = 24 * 8 - 8 wx2% = 24 * 8 + 40 wy1% = line2% * texth% - texth% wy2% = line2% * texth% LINE (PMAP(wx1%, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 11, BF ptext PMAP(wx1%, 2) + 19, PMAP(wy1%, 3) + 1, kky\$(4), 0, 1 ' startarc: DO CursorMotion keyin% LOOP UNTIL keyin% <> 1 VIEW SCREEN (0, 0)-(windowx%(0), winpy%) IF keyin% >= 3 THEN GOTO donearc pxold% = px%: pyold% = py% xx(nobj%, 0) = px%: yy(nobj%, 0) = py% DO CursorMotion keyin% CursorDisplay px%, py% LINE (xx(nobj%, 0), yy(nobj%, 0))-(pxold%, pyold%), 0 IF keyin% = 4 THEN CursorDisplay px%, py%: GOTO donearc LINE (xx(nobj%, 0), yy(nobj%, 0))-(px%, py%), 7 pxold% = px%: pyold% = py% CursorDisplay px%, py% LOOP UNTIL keyin% <> 1 xx(nobj%, 2) = px%: yy(nobj%, 2) = py%: ok% = 1 DO CursorMotion keyin% tol = SQR((xx(nobj%, 0) - xx(nobj%, 2)) ^ 2 + (yy(nobj%, 0) - yy(nobj%, 2)) ^ 2) tol1 = SQR((px% - xx(nobj%, 2)) ^ 2 + (py% - yy(nobj%, 2)) ^ 2) tol1 = tol1 + SQR((px% - xx(nobj%, 0)) ^ 2 + (py% - yy(nobj%, 0)) ^ 2) - tol IF tol <> 0 THEN tol = tol1 / tol CursorDisplay px%, py% IF ok% = 1 THEN LINE (xx(nobj%, 0), yy(nobj%, 0))-(xx(nobj%, 2), yy(nobj%, 2)), 0 ELSE CIRCLE (x0, y0), rad, 0, r1, r3, 1 END IF IF keyin% = 4 THEN CursorDisplay px%, py%: GOTO donearc IF tol < .001 THEN LINE (xx(nobj%, 0), yy(nobj%, 0))-(xx(nobj%, 2), yy(nobj%, 2)), 7 ok% = 1 ELSE ok% = 0 a = xx(nobj%, 0) - px%: B = yy(nobj%, 0) - py% c = px% - xx(nobj%, 2): D = py% - yy(nobj%, 2) E = xx(nobj%, 0) ^ 2 - CSNG(px%) * CSNG(px%) f = yy(nobj%, 0) ^ 2 - CSNG(py%) * CSNG(py%) G = CSNG(px%) * CSNG(px%) - xx(nobj%, 2) ^ 2 h = CSNG(py%) * CSNG(py%) - yy(nobj%, 2) ^ 2 y0 = ((E + f) * c - (G + h) * a) / (B * c - D * a) / 2! IF a <> 0! THEN x0 = (E + f - 2! * B * y0) / a / 2! ELSE x0 = (G + h - 2! * D * y0) / c / 2! END IF rad = SQR((xx(nobj%, 2) - x0) ^ 2 + (yy(nobj%, 2) - y0) ^ 2) r3 = Angle(x0, y0, xx(nobj%, 2), yy(nobj%, 2)) r1 = Angle(x0, y0, xx(nobj%, 0), yy(nobj%, 0)) r2 = Angle(x0, y0, CSNG(px%), CSNG(py%)) IF (r3 < r2 AND r2 < r1) OR ((r1 < r3) AND (r2 < r1 OR r3 < r2)) THEN SWAP r1, r3: SWAP xx(nobj%, 0), xx(nobj%, 2) SWAP yy(nobj%, 0), yy(nobj%, 2) END IF CIRCLE (x0, y0), rad, 7, r1, r3, 1 END IF CursorDisplay px%, py% LOOP UNTIL keyin% = 3 CursorDisplay px%, py% IF ok% = 1 THEN LINE (xx(nobj%, 0), yy(nobj%, 0))-(xx(nobj%, 2), yy(nobj%, 2)), 0 ELSE CIRCLE (x0, y0), rad, 0, r1, r3, 1 END IF CursorDisplay px%, py% xx(nobj%, 0) = x0 + rad * COS(r1): yy(nobj%, 0) = y0 - rad * SIN(r1) xx(nobj%, 1) = x0: yy(nobj%, 1) = y0 xx(nobj%, 2) = x0 + rad * COS(r3): yy(nobj%, 2) = y0 - rad * SIN(r3) xx(nobj%, 3) = rad: yy(nobj%, 3) = r1: yy(nobj%, 4) = r3 obj%(nobj%, 0) = 6: obj%(nobj%, 1) = 4 obj%(nobj%, 2) = 2: obj%(nobj%, 3) = -1 obj%(nobj%, 4) = thick%: obj%(nobj%, 5) = 0: obj%(nobj%, 6) = 0 CursorDisplay px%, py% SetObject nobj%, 7, 0 CursorDisplay px%, py% nobj% = nobj% + 1 Object.Max.Check GOTO startarc ' donearc: SetInst job% KeySwitch 1 job% = 0 VIEW SCREEN (0, 0)-(windowx%(0), windowy%(0)) LINE (PMAP(wx1%, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 0, BF LOCATE line2%, 24: COLOR 3: PRINT kky\$(4); : COLOR 7 ' END SUB SUB G.ArrowDirec (sobj%, snode%, n%) ' calculate the direction of arrow SELECT CASE fnoo%(sobj%) CASE 1 IF snode% = 0 THEN x3% = xx(sobj%, 1): y3% = yy(sobj%, 1) ELSE x3% = xx(sobj%, obj%(sobj%, 1) - 1) y3% = yy(sobj%, obj%(sobj%, 1) - 1) END IF GOSUB arrowarrow CASE 3 k% = 0: t = .2: IF snode% <> 0 THEN k% = snode% - 2: t = 1.8 x2% = xx(sobj%, k% + 2): y2% = yy(sobj%, k% + 2) x1% = xx(sobj%, k% + 1): y1% = yy(sobj%, k% + 1) x0% = xx(sobj%, k%): y0% = yy(sobj%, k%) G.XYparam x0%, y0%, x1%, y1%, x2%, y2%, ax, bx, cx, ay, by, cy x3% = ax * t * t + bx * t + cx: y3% = ay * t * t + by * t + cy GOSUB arrowarrow CASE 6 x1% = xx(sobj%, snode%): y1% = yy(sobj%, snode%) s2 = yy(sobj%, 3) + 3! * pi / 2! + arcarrowd IF snode% <> 0 THEN s2 = yy(sobj%, 4) + pi / 2! - arcarrowd END SELECT arrow = arrowhead + darrowhead * obj%(n%, 4) xx(n%, 2) = x1% - arrow * COS(s2 + arrowdirect) yy(n%, 2) = y1% + arrow * SIN(s2 + arrowdirect) xx(n%, 0) = x1% - arrow * COS(s2 - arrowdirect) yy(n%, 0) = y1% + arrow * SIN(s2 - arrowdirect) xx(n%, 1) = x1%: yy(n%, 1) = y1% EXIT SUB ' arrowarrow: x1% = xx(sobj%, snode%): y1% = yy(sobj%, snode%) IF x1% = x3% THEN s2 = SGN(y3% - y1%) * pi / 2! ELSE s2 = ATN(CSNG(y3% - y1%) / CSNG(x1% - x3%)) IF x1% < x3% THEN s2 = s2 + pi END IF RETURN ' END SUB SUB G.Arrows ' set arrows MarkEnds c%: IF c% = 0 THEN EXIT SUB job% = 6 KeySwitch 0 SetInst job% wx1% = 61 * 8 - 8 wx2% = 61 * 8 + 40 wy1% = line2% * texth% - texth% wy2% = line2% * texth% LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 11, BF ptext PMAP(wx1%, 2) + 19, PMAP(wy1%, 3) + 1, kky\$(8), 0, 1 ' startarrow: selh% = 1 DO CursorMotion keyin% LOOP UNTIL keyin% <> 1 IF keyin% = 4 THEN GOTO donearrow sobj% = -1 FOR i% = 0 TO nobj% - 1 IF fnoo%(i%) <> 1 AND fnoo%(i%) <> 3 AND fnoo%(i%) <> 6 THEN GOTO nogetends selh% = 0 dist = SQR((xx(i%, 0) - px%) ^ 2 + (yy(i%, 0) - py%) ^ 2) IF dist < 3 THEN snode% = 0: sobj% = i%: EXIT FOR dist = SQR((xx(i%, obj%(i%, 2)) - px%) ^ 2 + (yy(i%, obj%(i%, 2)) - py%) ^ 2) IF dist < 3 THEN snode% = obj%(i%, 2): sobj% = i%: EXIT FOR nogetends: NEXT i% IF sobj% < 0 THEN GOTO startarrow G.Arrowset sobj%, snode%, already% IF already% = 0 THEN nobj% = nobj% + 1: Object.Max.Check IF keyin% = 3 THEN IF snode% = 0 THEN snode% = obj%(sobj%, 2) ELSE snode% = 0 G.Arrowset sobj%, snode%, already% IF already% <> 0 THEN GOTO startarrow nobj% = nobj% + 1 Object.Max.Check END IF GOTO startarrow ' donearrow: MarkEnds c% SetInst job% KeySwitch 1 job% = 0 selh% = 0 VIEW SCREEN (0, 0)-(windowx%(0), windowy%(0)) LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 0, BF LOCATE line2%, 61: COLOR 3: PRINT kky\$(8); : COLOR 7 ' END SUB SUB G.Arrowset (sobj%, snode%, already%) ' arrow set & check already% = 0 FOR i% = 0 TO nobj% - 1 IF fnoo%(i%) <> 11 THEN GOTO skipsrchar IF obj%(i%, 5) = sobj% AND obj%(i%, 6) = snode% THEN already% = 1 CursorDisplay px%, py% PPUT xx(sobj%, snode%) - 3, yy(sobj%, snode%) - 3, mark%() Killer i%, sobj% SetObject sobj%, 7, 0 PPUT xx(sobj%, snode%) - 3, yy(sobj%, snode%) - 3, mark%() CursorDisplay px%, py% EXIT SUB END IF skipsrchar: NEXT i% ' obj%(nobj%, 0) = 11: obj%(nobj%, 1) = 2: obj%(nobj%, 2) = -1 obj%(nobj%, 3) = -2: obj%(nobj%, 4) = obj%(sobj%, 4) obj%(nobj%, 5) = sobj%: obj%(nobj%, 6) = snode% G.ArrowDirec sobj%, snode%, nobj% ' CursorDisplay px%, py% PPUT xx(sobj%, snode%) - 3, yy(sobj%, snode%) - 3, mark%() SetObject nobj%, 7, 0 PPUT xx(sobj%, snode%) - 3, yy(sobj%, snode%) - 3, mark%() CursorDisplay px%, py% ' END SUB SUB G.Box ' box job% = 4 KeySwitch 0 SetInst job% wx1% = 31 * 8 - 8 wx2% = 31 * 8 + 40 wy1% = line2% * texth% - texth% wy2% = line2% * texth% LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 11, BF ptext PMAP(wx1%, 2) + 19, PMAP(wy1%, 3) + 1, kky\$(5), 0, 1 ' startbox: 'fill% = 0 DO CursorMotion keyin% ' IF keyin% = 3 THEN FillPattern LOOP UNTIL keyin% <> 1 VIEW SCREEN (0, 0)-(windowx%(0), winpy%) IF keyin% = 4 THEN GOTO donebox sx% = px%: sy% = py%: pxold% = px%: pyold% = py% sxg% = sx%: syg% = sy% inbox% = 1 DO CursorMotion keyin% CursorDisplay px%, py% IF fill% <> 0 THEN LINE (sx%, sy%)-(pxold%, pyold%), 2, B PAINT ((sx% + pxold%) / 2, (sy% + pyold%) / 2), 0, 2 END IF LINE (sx%, sy%)-(pxold%, pyold%), 0, BF IF keyin% = 4 THEN CursorDisplay px%, py%: GOTO donebox ' IF keyin% = 3 THEN FillPattern LINE (sx%, sy%)-(px%, py%), 0, BF IF fill% = 0 THEN LINE (sx%, sy%)-(px%, py%), 7, B ELSE LINE (sx%, sy%)-(px%, py%), 2, B PAINT ((sx% + px%) / 2, (sy% + py%) / 2), tlp\$(fill%), 2 END IF CursorDisplay px%, py% pxold% = px%: pyold% = py% LOOP UNTIL keyin% = 2 OR keyin% = 3 inbox% = 0 CursorDisplay px%, py% IF fill% <> 0 THEN LINE (sx%, sy%)-(px%, py%), 2, B PAINT ((sx% + px%) / 2, (sy% + py%) / 2), 0, 2 END IF LINE (sx%, sy%)-(px%, py%), 0, B CursorDisplay px%, py% xx(nobj%, 0) = sx%: yy(nobj%, 0) = sy% xx(nobj%, 1) = px%: yy(nobj%, 1) = py% obj%(nobj%, 0) = 8: obj%(nobj%, 1) = 1 IF fill% <> 0 THEN obj%(nobj%, 0) = 9 obj%(nobj%, 2) = 1: obj%(nobj%, 3) = -1 obj%(nobj%, 4) = thick%: obj%(nobj%, 5) = ltype% obj%(nobj%, 6) = 0: obj%(nobj%, 6) = fill% IF fill% <> 0 THEN obj%(nobj%, 5) = 0 CursorDisplay px%, py% SetObject nobj%, 7, 0 CursorDisplay px%, py% nobj% = nobj% + 1 Object.Max.Check ' -------- ' Box Text, yes/no? ipy% = py%: ipx% = px%: L.Text ipx%, ipy% PRINT "Text(y/n)??"; bkey\$ = yesno\$ L.Text ipx%, ipy%: PRINT SPACE\$(12); IF bkey\$ = "n" THEN GOTO startbox '-------- ' string job% = 5 KeySwitch 0 LOCATE line2%, 68: COLOR 11: PRINT kky\$(9); : COLOR 7 SetInst job% wx1% = 68 * 8 - 8 wx2% = 68 * 8 + 40 wy1% = line2% * texth% - texth% wy2% = line2% * texth% LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 11, BF ' pxold% = px%: pyold% = py% '------ ' Calculate Box center for Box text px% = sx% + (pxold% - sx%) / 2 py% = sy% + (pyold% - sy%) / 2 - texth% + 4 '------ pxold% = px%: pyold% = py% CursorDisplay px%, py% startchar2: LINE (px%, py%)-(px% + epitch%(chartype%, 0) * charpt% / 250 * ptmm, py% + eheight(chartype%) * charpt% * ptmm / .25), 2, B CursorDisplay px%, py% LINE (pxold%, pyold%)-(pxold% + epitch%(chartype%, 0) * charpt% / 250 * ptmm, pyold% + eheight(chartype%) * charpt% * ptmm / .25), 0, B LINE (px%, py%)-(px% + epitch%(chartype%, 0) * charpt% / 250 * ptmm, py% + eheight(chartype%) * charpt% * ptmm / .25), 2, B pxold% = px%: pyold% = py% CursorDisplay px%, py% LINE (pxold%, pyold%)-(pxold% + epitch%(chartype%, 0) * charpt% / 250 * ptmm, pyold% + eheight(chartype%) * charpt% * ptmm / .25), 0, B CursorDisplay px%, py% IF px% + 10 - pxo% > pxmax% OR py% + 16 - pyo% > pymax% THEN GOTO donechar2 xx(nobj%, 0) = px%: yy(nobj%, 0) = py% L.Text px%, py%: ams\$ = "": PRINT "-> "; : Chr.Input ams\$ L.Text px%, py%: PRINT SPACE\$(LEN(ams\$) + 3); IF ams\$ = "" THEN GOTO donechar2 obj%(nobj%, 0) = 10: obj%(nobj%, 1) = LEN(ams\$) obj%(nobj%, 2) = 0: obj%(nobj%, 3) = -1: obj%(nobj%, 4) = charpt% obj%(nobj%, 5) = chartype% 'Put object number of Box + 1, i.e. string number in Obj(x,6) obj%(nobj%, 6) = nobj% G.Charset ams\$, nobj% CursorDisplay px%, py% SetObject nobj%, 7, 0 CursorDisplay px%, py% nobj% = nobj% + 1 Object.Max.Check ' donechar2: SetInst job% KeySwitch 0 'Fixing the bug of boxtext job=0---> job=4 job% = 4 LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 0, BF LOCATE line2%, 68: COLOR 3: PRINT kky\$(9); : COLOR 7 CursorDisplay ipx%, ipy% ' end box text section GOTO startbox: ' donebox: SetInst job% KeySwitch 1 job% = 0 VIEW SCREEN (0, 0)-(windowx%(0), windowy%(0)) wx1% = 31 * 8 - 8 wx2% = 31 * 8 + 40 wy1% = line2% * texth% - texth% wy2% = line2% * texth% LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 0, BF LOCATE line2%, 31: COLOR 3: PRINT kky\$(5); : COLOR 7 CL.R.edraw 0, 0 ' END SUB SUB G.Char ' string job% = 5 KeySwitch 0 SetInst job% wx1% = 68 * 8 - 8 wx2% = 68 * 8 + 40 wy1% = line2% * texth% - texth% wy2% = line2% * texth% LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 11, BF ptext PMAP(wx1%, 2) + 19, PMAP(wy1%, 3) + 1, kky\$(9), 0, 1 ' startchar: pxold% = px%: pyold% = py% CursorDisplay px%, py% LINE (px%, py%)-(px% + epitch%(chartype%, 0) * charpt% / 250 * ptmm, py% + eheight(chartype%) * charpt% * ptmm / .25), 2, B CursorDisplay px%, py% DO CursorMotion keyin% CursorDisplay px%, py% LINE (pxold%, pyold%)-(pxold% + epitch%(chartype%, 0) * charpt% / 250 * ptmm, pyold% + eheight(chartype%) * charpt% * ptmm / .25), 0, B LINE (px%, py%)-(px% + epitch%(chartype%, 0) * charpt% / 250 * ptmm, py% + eheight(chartype%) * charpt% * ptmm / .25), 2, B pxold% = px%: pyold% = py% CursorDisplay px%, py% LOOP UNTIL keyin% <> 1 VIEW SCREEN (0, 0)-(windowx%(0), winpy%) CursorDisplay px%, py% LINE (pxold%, pyold%)-(pxold% + epitch%(chartype%, 0) * charpt% / 250 * ptmm, pyold% + eheight(chartype%) * charpt% * ptmm / .25), 0, B CursorDisplay px%, py% IF keyin% = 4 THEN GOTO donechar 'IF keyin% = 3 THEN G.CharDisp: GOTO startchar IF px% + 10 - pxo% > pxmax% OR py% + 16 - pyo% > pymax% THEN GOTO donechar xx(nobj%, 0) = px%: yy(nobj%, 0) = py% L.Text px%, py%: ams\$ = "": PRINT "-> "; : Chr.Input ams\$ L.Text px%, py%: PRINT SPACE\$(LEN(ams\$) + 3); IF ams\$ = "" THEN GOTO startchar obj%(nobj%, 0) = 10: obj%(nobj%, 1) = LEN(ams\$) obj%(nobj%, 2) = 0: obj%(nobj%, 3) = -1: obj%(nobj%, 4) = charpt% obj%(nobj%, 5) = chartype%: obj%(nobj%, 6) = 0 G.Charset ams\$, nobj% CursorDisplay px%, py% SetObject nobj%, 7, 0 CursorDisplay px%, py% nobj% = nobj% + 1 Object.Max.Check GOTO startchar ' donechar: SetInst job% KeySwitch 1 job% = 0 VIEW SCREEN (0, 0)-(windowx%(0), windowy%(0)) LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 0, BF LOCATE line2%, 68: COLOR 3: PRINT kky\$(9); : COLOR 7 ' END SUB SUB G.CharDisp ' character font selection display ipy% = py%: ipx% = px% L.Text ipx%, ipy% charptold% = charpt%: a\$ = fno\$(charpt%, 1) PRINT "Size (10 or 12 pt.) = "; : Chr.Input a\$ charpt% = VAL(a\$) IF charpt% = 0 OR (charpt% <> 10 AND charpt% <> 12) THEN charpt% = charptold% L.Text ipx%, ipy%: PRINT SPACE\$(28); DO L.Text ipx%, ipy% PRINT "Font= "; chartype\$(chartype%) '; "."; CursorMotion keyin% IF keyin% = 2 THEN chartype% = chartype% + 1: IF chartype% > UBOUND(chartype\$) THEN chartype% = 0 END IF LOOP UNTIL keyin% = 3 L.Text ipx%, ipy% PRINT SPACE\$(5) L.Text ipx%, ipy% PRINT "'"; chartype\$(chartype%); "' character in "; charpt%; "pt."; SLEEP 1: L.Text ipx%, ipy% PRINT SPACE\$(5); SPACE\$(10); SPACE\$(25); ' END SUB SUB G.Charset (ams\$, n%) ' character code decomposition FOR i% = 1 TO LEN(ams\$): a\$ = MID\$(ams\$, i%, 1): j% = LEN(a\$) IF j% = 1 THEN yy(n%, i%) = 0!: xx(n%, i%) = ASC(a\$) ELSE a\$ = STR\$(ASC(a\$)) yy(n%, i%) = VAL("&H" + LEFT\$(a\$, 2)) xx(n%, i%) = VAL("&H" + RIGHT\$(a\$, 2)) END IF NEXT i% ' END SUB SUB G.Crcl ' circle 'LOCATE line3%, 42: PRINT "filler pattern" xx(nobj%, 0) = px%: yy(nobj%, 0) = py% sx% = px%: sy% = py%: rold = 1 'fill% = 0 DO CursorMotion keyin% CursorDisplay px%, py% CIRCLE (sx%, sy%), rold, 0, , , 1 IF keyin% = 4 THEN CursorDisplay px%, py%: GOTO donecrcl rad = SQR((px% - sx%) ^ 2 + (py% - sy%) ^ 2) CIRCLE (sx%, sy%), rad, 2, , , 1 '*********** 'For fillpattern for circle ' ' IF fill% = 0 THEN ' PAINT ((sx% + px%) / 2, (sy% + py%) / 2), 0, 2 ' ELSE ' PAINT ((sx% + px%) / 2, (sy% + py%) / 2), tlp\$(fill%), 2 ' END IF '************** rold = rad CursorDisplay px%, py% LOOP UNTIL keyin% = 2 CursorDisplay px%, py% CIRCLE (sx%, sy%), rad, 0, , , 1 CursorDisplay px%, py% xx(nobj%, 1) = px%: yy(nobj%, 1) = py%: xx(nobj%, 2) = rad obj%(nobj%, 0) = 5: obj%(nobj%, 1) = 2 obj%(nobj%, 2) = 1: obj%(nobj%, 3) = -1 obj%(nobj%, 4) = thick%: obj%(nobj%, 5) = 0 obj%(nobj%, 6) = 0 CursorDisplay px%, py% SetObject nobj%, 7, 0 CursorDisplay px%, py% nobj% = nobj% + 1 Object.Max.Check ' donecrcl: ' END SUB SUB G.Crcl.Ellps ' circle+ellpse job% = 2 KeySwitch 0 SetInst job% wx1% = 17 * 8 - 8 wx2% = 17 * 8 + 40 wy1% = line2% * texth% - texth% wy2% = line2% * texth% LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 11, BF ptext PMAP(wx1%, 2) + 19, PMAP(wy1%, 3) + 1, kky\$(3), 0, 1 ' startcrclellps: DO CursorMotion keyin% LOOP UNTIL keyin% <> 1 VIEW SCREEN (0, 0)-(windowx%(0), winpy%) SELECT CASE keyin% CASE 2 G.Crcl CASE 3 G.Ellps CASE 4 GOTO donecrclellps END SELECT GOTO startcrclellps ' donecrclellps: SetInst job% KeySwitch 1 job% = 0 VIEW SCREEN (0, 0)-(windowx%(0), windowy%(0)) LINE (PMAP(wx1% - 1, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 0, BF LOCATE line2%, 17: COLOR 3: PRINT kky\$(3); : COLOR 7 ' END SUB SUB G.Curve (curve%, closed%) ' straight/curved lines job% = 1 KeySwitch 0 SetInst job% wx1% = (curve% * 7 - 4 + closed% * 44) * 8 - 8 wx2% = (curve% * 7 - 4 + closed% * 44) * 8 + 40 wy1% = line2% * texth% - texth% wy2% = line2% * texth% LINE (PMAP(wx1%, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 11, BF ptext PMAP(wx1%, 2) + 19, PMAP(wy1%, 3) + 1, kky\$(curve% + 5 * closed%), 0, 1 ' startcurve: node% = 0: nodeismax% = 0 DO CursorMotion keyin% LOOP UNTIL keyin% <> 1 IF keyin% >= 3 THEN GOTO donest pxold% = px%: pyold% = py% xx(nobj%, 0) = px%: yy(nobj%, 0) = py% DO sx% = px%: sy% = py% node% = node% + 1 IF node% + closed% + curve% - 1 = UBOUND(xx, 2) THEN nodeismax% = 1 DO CursorMotion keyin% CursorDisplay px%, py% IF wnode% <> 0 AND node% > 1 THEN PSET (xx(nobj%, 0), yy(nobj%, 0)), 7 FOR i% = 1 TO (node% - 1) LINE -(xx(nobj%, i%), yy(nobj%, i%)), 7 NEXT i% END IF wnode% = 0 LINE (sx%, sy%)-(pxold%, pyold%), 0 LINE (sx%, sy%)-(px%, py%), 7 pxold% = px%: pyold% = py% CursorDisplay px%, py% LOOP UNTIL keyin% <> 1 CursorDisplay px%, py% LINE (sx%, sy%)-(px%, py%), 7 CursorDisplay px%, py% xx(nobj%, node%) = px%: yy(nobj%, node%) = py% IF keyin% = 4 THEN EXIT DO IF nodeismax% = 1 THEN keyin% = 3 LOOP UNTIL keyin% = 3 AND node% >= 1 + closed% IF curve% = 1 THEN obj%(nobj%, 0) = 1 ELSE obj%(nobj%, 0) = 3 END IF obj%(nobj%, 1) = node% obj%(nobj%, 2) = node% - closed%: obj%(nobj%, 3) = node% - closed% obj%(nobj%, 4) = thick%: obj%(nobj%, 5) = ltype%: obj%(nobj%, 6) = 0 CursorDisplay px%, py% PSET (xx(nobj%, 0), yy(nobj%, 0)), 0 FOR i% = 1 TO node%: LINE -(xx(nobj%, i%), yy(nobj%, i%)), 0: NEXT i% CursorDisplay px%, py% IF keyin% = 4 THEN GOTO donest IF closed% <> 0 THEN FOR i% = 0 TO 3: obj%(nobj%, i%) = obj%(nobj%, i%) + 1: NEXT i% node% = node% + 1 xx(nobj%, node%) = xx(nobj%, 0): yy(nobj%, node%) = yy(nobj%, 0) END IF IF curve% = 2 AND INT(node% / 2) * 2 <> node% THEN G.Addnode nobj%, node%, 0 CursorDisplay px%, py% SetObject nobj%, 7, 0 CursorDisplay px%, py% nobj% = nobj% + 1 Object.Max.Check GOTO startcurve ' donest: SetInst job% KeySwitch 1 job% = 0 VIEW SCREEN (0, 0)-(windowx%(0), windowy%(0)) LINE (PMAP(wx1%, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 0, BF LOCATE line2%, curve% * 7 - 4 + closed% * 44: COLOR 3 PRINT kky\$(curve% + 5 * closed%); : COLOR 7 ' END SUB SUB G.Ellps ' ellipse rold = 1: rtold = 1: sx% = px%: sy% = py%: cx% = px%: cy% = py% DO CursorMotion keyin% CursorDisplay px%, py% CIRCLE (cx%, cy%), rold, 0, , , rtold IF keyin% = 4 THEN CursorDisplay px%, py%: GOTO donellps cx% = (px% + sx%) / 2!: cy% = (py% + sy%) / 2! rad = ABS(px% - sx%) / 2!: rt = ABS(py% - sy%) / 2! IF rad = 0! OR rt = 0! THEN rad = 0!: rt = 1! ELSE rt = rt / rad IF rt > 1! THEN rad = rt * rad END IF CIRCLE (cx%, cy%), rad, 2, , , rt '*********** 'For fillpattern for circle ' ' IF fill% = 0 THEN ' PAINT ((sx% + px%) / 2, (sy% + py%) / 2), 0, 2 ' ELSE ' PAINT ((sx% + px%) / 2, (sy% + py%) / 2), tlp\$(fill%), 2 ' END IF '************** rold = rad: rtold = rt CursorDisplay px%, py% LOOP UNTIL keyin% = 3 CursorDisplay px%, py% CIRCLE (cx%, cy%), rad, 0, , , rt CursorDisplay px%, py% xx(nobj%, 0) = cx%: yy(nobj%, 0) = cy%: xx(nobj%, 2) = rad xx(nobj%, 1) = cx%: yy(nobj%, 1) = cy%: yy(nobj%, 2) = rt IF rt < 1! THEN xx(nobj%, 1) = cx% + rad ELSE yy(nobj%, 1) = cy% - rad END IF obj%(nobj%, 0) = 7: obj%(nobj%, 1) = 2: obj%(nobj%, 2) = 1 obj%(nobj%, 3) = -1: obj%(nobj%, 4) = thick%: obj%(nobj%, 5) = 0 obj%(nobj%, 6) = 0 CursorDisplay px%, py% SetObject nobj%, 7, 0 CursorDisplay px%, py% nobj% = nobj% + 1 Object.Max.Check ' donellps: ' END SUB SUB G.XYparam (x0%, y0%, x1%, y1%, x2%, y2%, ax, bx, cx, ay, by, cy) ' parametric parabolic curve coefficients ax = -(-x0% + 2! * x1% - x2%) / 2! bx = -(3! * x0% - 4! * x1% + x2%) / 2! cx = x0% ay = -(-y0% + 2! * y1% - y2%) / 2! by = -(3! * y0% - 4! * y1% + y2%) / 2! cy = y0% ' END SUB SUB L.Text (ipx%, ipy%) ' locate on text screen jpx% = INT(CSNG(ipx% - pxo%) / wndwxy(wndwfctr%) / 8!) + 2 jpy% = INT(CSNG(ipy% - pyo%) / wndwxy(wndwfctr%) / 16!) + 2 IF jpy% > 22 THEN jpy% = jpy% - 3 LOCATE jpy%, jpx% ' END SUB SUB MaxMin (ppxx%, ppyy%) ' set maximum/minimum IF ppxx% < xmin% THEN xmin% = ppxx% IF ppxx% > xmax% THEN xmax% = ppxx% IF ppyy% < ymin% THEN ymin% = ppyy% IF ppyy% > ymax% THEN ymax% = ppyy% ' END SUB SUB MoveObj (c%) ' move or copy objects job% = 7 KeySwitch 0 SetInst job% wx1% = (3 + 7 * c%) * 8 - 8 wx2% = (3 + 7 * c%) * 8 + 40 wy1% = line1% * texth% - texth% wy2% = line1% * texth% LINE (PMAP(wx1%, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 11, BF ptext PMAP(wx1%, 2) + 19, PMAP(wy1%, 3) + 1, kky\$(11 + c%), 0, 1 ' startmovecopy: Marking 1, n% selh% = 1 IF n% = 0 THEN Marking 1, n%: GOTO donemovecopy DO CursorMotion keyin% LOOP UNTIL keyin% <> 1 VIEW SCREEN (0, 0)-(windowx%(0), winpy%) woldrad% = 0 SELECT CASE keyin% CASE 2 selh% = 0 MoveObject 1, c% CASE 3 MoveObject 0, c% CASE ELSE Marking 1, n% END SELECT woldrad% = 0 IF keyin% <> 4 THEN GOTO startmovecopy ' donemovecopy: SetInst job% KeySwitch 1 job% = 0 selh% = 0 VIEW SCREEN (0, 0)-(windowx%(0), windowy%(0)) LINE (PMAP(wx1%, 2), PMAP(wy1%, 3))-(PMAP(wx2%, 2), PMAP(wy2%, 3)), 0, BF LOCATE line1%, 3 + 7 * c%: COLOR 3: PRINT kky\$(11 + c%); : COLOR 7 ' END SUB SUB MoveObject (total%, c%) ' really moving objects sx% = px%: sy% = py%: pxold% = px%: pyold% = py% IF total% = 1 THEN total% = 0 Marking.Chk 1, mobj%(total%), snode% IF mobj%(total%) < 0 THEN Marking 1, n%: EXIT SUB ELSE DO CursorMotion keyin% CursorDisplay px%, py% LINE (sx%, sy%)-(pxold%, pyold%), 0, B IF keyin% = 4 THEN CursorDisplay px%, py%: Marking 1, n%: EXIT SUB LINE (sx%, sy%)-(px%, py%), 2, B CursorDisplay px%, py% pxold% = px%: pyold% = py% LOOP UNTIL keyin% = 3 selh% = 0 CursorDisplay px%, py% LINE (sx%, sy%)-(px%, py%), 0, B CursorDisplay px%, py% Marking.Reg sx%, sy%, px%, py%, total% IF total% < 0 THEN Marking 1, n%: EXIT SUB END IF IF total% > UBOUND(mobj%) OR nobj% + total% > UBOUND(obj%, 1) THEN GOTO no.way.to.move ' group check gtotal% = 0 FOR k% = 0 TO total% IF fnoo%(mobj%(k%)) = obj%(mobj%(k%), 0) THEN GOTO movegroup2 ggroup% = obj%(mobj%(k%), 0) - fnoo%(mobj%(k%)) FOR i% = 0 TO nobj% - 1 IF fnoo%(i%) = obj%(i%, 0) THEN GOTO movegroup1 FOR j% = 0 TO total% IF i% = mobj%(j%) THEN GOTO movegroup1 NEXT j% IF obj%(i%, 0) - fnoo%(i%) = ggroup% THEN gtotal% = gtotal% + 1 IF total% + gtotal% > UBOUND(mobj%) THEN GOTO no.way.to.move IF nobj% + total% + gtotal% > UBOUND(obj%, 1) THEN GOTO no.way.to.move mobj%(total% + gtotal%) = i% END IF movegroup1: NEXT i% movegroup2: NEXT k% total% = total% + gtotal% Marking 1, n% ' FOR i% = 0 TO total% FOR j% = 0 TO 6: obj%(nobj% + i%, j%) = obj%(mobj%(i%), j%): NEXT j% FOR j% = 0 TO obj%(mobj%(i%), 1) xx(nobj% + i%, j%) = xx(mobj%(i%), j%) yy(nobj% + i%, j%) = yy(mobj%(i%), j%) NEXT j%: NEXT i%: dx% = 0: dy% = 0 ' DO CursorMotion keyin% CursorDisplay px%, py% IF keyin% = 4 THEN FOR i% = 0 TO total%: wkill% = 1: SetObject nobj% + i%, 0, 1: NEXT i% GOTO mvobj END IF ddx% = px% - pxold%: ddy% = py% - pyold% dx% = dx% + ddx%: dy% = dy% + ddy% a\$ = KeyIsTouched\$ 'check continuous motion, silly? IF (mouswitch% = 0 AND a\$ = "") OR (mouswitch% AND a\$ = "" AND row% = py% AND col% = px%) THEN IF c% = 0 OR dx% <> 0 OR dy% <> 0 THEN FOR i% = 0 TO total%: wkill% = 1: SetObject nobj% + i%, 0, 1: NEXT i% END IF FOR i% = 0 TO total%: jlast% = obj%(nobj% + i%, 2) IF fnoo%(nobj% + i%) = 2 OR fnoo%(nobj% + i%) = 4 THEN jlast% = jlast% + 1 FOR j% = 0 TO jlast% xx(nobj% + i%, j%) = xx(nobj% + i%, j%) + dx% yy(nobj% + i%, j%) = yy(nobj% + i%, j%) + dy%: NEXT j% SetObject nobj% + i%, 3, 1 NEXT i% dx% = 0: dy% = 0 END IF CursorDisplay px%, py% pxold% = px%: pyold% = py% LOOP UNTIL keyin% = 2 OR keyin% = 3 ' CursorDisplay px%, py% FOR i% = 0 TO total%: SetObject nobj% + i%, 0, 1: NEXT i% groupchk% = 0 IF c% = 0 THEN FOR i% = 0 TO total%: SetObject mobj%(i%), 0, 0: NEXT i% FOR i% = 0 TO total% FOR j% = 0 TO 6: obj%(mobj%(i%), j%) = obj%(nobj% + i%, j%): NEXT j% FOR j% = 0 TO obj%(mobj%(i%), 1): xx(mobj%(i%), j%) = xx(nobj% + i%, j%) yy(mobj%(i%), j%) = yy(nobj% + i%, j%): NEXT j%: NEXT i% FOR i% = 0 TO total%: FOR j% = 0 TO nobj% - 1 IF fnoo%(j%) = 11 AND obj%(j%, 5) = mobj%(i%) THEN SetObject j%, 0, 0 G.ArrowDirec obj%(j%, 5), obj%(j%, 6), j% SetObject j%, 7, 0 END IF NEXT j%: NEXT i% ELSE arrow% = 0: arrowoverflow% = 0 FOR i% = 0 TO total%: SetObject nobj% + i%, 7, 0 IF obj%(nobj% + i%, 0) <> fnoo%(nobj% + i%) THEN obj%(nobj% + i%, 0) = 100 * group% + fnoo%(nobj% + i%) groupchk% = 1 ELSE obj%(nobj% + i%, 0) = fnoo%(nobj% + i%) END IF FOR j% = 0 TO nobj% - 1 IF fnoo%(j%) = 11 AND obj%(j%, 5) = mobj%(i%) THEN mmobj% = nobj% + total% + arrow% + 1 IF mmobj% > UBOUND(obj%, 1) THEN arrowoverflow% = arrowoverflow% + 1 IF arrowoverflow% = 0 THEN FOR k% = 0 TO 6: obj%(mmobj%, k%) = obj%(j%, k%): NEXT k% IF obj%(mmobj%, 0) <> fnoo%(mmobj%) THEN obj%(mmobj%, 0) = 100 * group% + fnoo%(mmobj%) ELSE obj%(mmobj%, 0) = fnoo%(mmobj%) END IF FOR k% = 0 TO obj%(mmobj%, 1): xx(mmobj%, k%) = xx(j%, k%) yy(mmobj%, k%) = yy(j%, k%): NEXT k%: obj%(mmobj%, 5) = nobj% + i% G.ArrowDirec obj%(mmobj%, 5), obj%(mmobj%, 6), mmobj% SetObject mmobj%, 7, 0: arrow% = arrow% + 1 END IF END IF NEXT j%: NEXT i% IF groupchk% = 1 THEN group% = group% + 1 nobj% = nobj% + total% + arrow% + 1 IF arrowoverflow% > 0 THEN COLOR 14: LOCATE 2, 25 PRINT CHR\$(7); " "; arrowoverflow%; " arrow(s) NOT copied! "; COLOR 7 END IF END IF mvobj: FOR i% = 0 TO total%: SetObject mobj%(i%), 7, 0: NEXT i% CursorDisplay px%, py% EXIT SUB ' no.way.to.move: Marking 1, n% COLOR 14: LOCATE 2, 25 PRINT CHR\$(7); " No way to move/copy that many... "; COLOR 7 ' END SUB SUB PPUT (xp, yp, markp%()) ' conditional PUT IF xp < pxmax% AND xp > pxmin% AND yp < pymax2% AND yp > pymin% THEN PUT (xp, yp), markp%, XOR END IF ' END SUB SUB SetObject (n%, clr%, simple%) ' set each object IF fnoo%(n%) < 1 THEN EXIT SUB ON fnoo%(n%) GOSUB ln, ln, cv, cv, crc, arc, ellps, box, fbox, str, arr EXIT SUB ' line ln: FOR i% = 1 TO obj%(n%, 1) D.Lines INT(xx(n%, i% - 1)), INT(yy(n%, i% - 1)), INT(xx(n%, i%)), INT(yy(n%, i%)), clr%, 0, obj%(n%, 4), obj%(n%, 5), 0, simple% NEXT i%: RETURN ' curve cv: IF simple% = 1 THEN GOTO ln FOR i% = 0 TO obj%(n%, 1) - 2 x0% = xx(n%, i%): x1% = xx(n%, i% + 1): x2% = xx(n%, i% + 2) y0% = yy(n%, i%): y1% = yy(n%, i% + 1): y2% = yy(n%, i% + 2) G.XYparam x0%, y0%, x1%, y1%, x2%, y2%, ax, bx, cx, ay, by, cy jlast% = 4: IF i% = obj%(n%, 1) - 2 THEN jlast% = 9 FOR j% = 0 TO jlast% t = j% / 5!: sx% = ax * t * t + bx * t + cx: sy% = ay * t * t + by * t + cy t = (j% + 1) / 5!: ex% = ax * t * t + bx * t + cx: ey% = ay * t * t + by * t + cy D.Lines sx%, sy%, ex%, ey%, clr%, 0, obj%(n%, 4), obj%(n%, 5), 0, simple% NEXT j%: NEXT i% RETURN ' circle crc: D.Circles INT(xx(n%, 0)), INT(yy(n%, 0)), xx(n%, 2), -1, -1, 0, clr%, obj%(n%, 4), simple%, obj%(n%, 6) RETURN ' arc arc: D.Circles INT(xx(n%, 1)), INT(yy(n%, 1)), xx(n%, 3), -1, yy(n%, 3), yy(n%, 4), clr%, obj%(n%, 4), simple%, obj%(n%, 6) RETURN ' ellipse ellps: D.Circles INT(xx(n%, 0)), INT(yy(n%, 0)), xx(n%, 2), yy(n%, 2), -1, 0, clr%, obj%(n%, 4), simple%, obj%(n%, 6) RETURN ' box box: D.Lines INT(xx(n%, 0)), INT(yy(n%, 0)), INT(xx(n%, 1)), INT(yy(n%, 1)), clr%, 1, obj%(n%, 4), obj%(n%, 5), 0, simple% RETURN ' filled box fbox: D.Lines INT(xx(n%, 0)), INT(yy(n%, 0)), INT(xx(n%, 1)), INT(yy(n%, 1)), clr%, 2, obj%(n%, 4), 0, obj%(n%, 6), simple% RETURN ' strings str: D.Strings n%, clr%, simple% RETURN ' arrow arr: FOR i% = 0 TO 1 D.Lines INT(xx(n%, i%)), INT(yy(n%, i%)), INT(xx(n%, i% + 1)), INT(yy(n%, i% + 1)), clr%, 0, obj%(n%, 4), 0, 0, simple% NEXT i% RETURN ' END SUB 