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
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
