/* CMD: PClone Deluxe
 * Particle Clone Deluxe version 1.4 by GLYPH (03/15/1997)
                                        E-Mail: y82s1@unb.ca
 * Clones active layer data at offsets given by points in background
   layers and places clones in first empty layer.
 * Clones points or polygons
 * Optional boolean union of clones - good for crater stencils & bubbles
 * Random Scaling & Rotation - good for asteroids & grass
 * Lock Scale factors to X for random yet proportionally correct clones
 * 2-D Radial Alignment of clones - good for making things stick out in 2-D
 * 3-D Radial Alignment of clones - good for making things stick out in 3-D
 * User-definable Radial Alignment Center from which things stick
 * Global scaling function dependant on distance from Radial Center
 * Uses LW3.1 commands for compatability (3.5 commands would have been easier)
 */
	call addlib("LWModelerARexx.port",0)
	signal on error
	signal on syntax
	call addlib("rexxmathlib.library",0,-30,0)
        call addlib("rexxsupport.library",0,-30,0)
	call main
	exit

	syntax:
	error:
	t=Notify(1,'!Rexx Script Error','@'ErrorText(rc),'Line 'SIGL)
	if (mxx_add) then call remlib(mxx)
	exit

MAIN:

call random(,,time('s'))

syscode = "Particle Clone Deluxe"
tmpnam = "t:pclone.tmp"

pi=3.1415926385897932384626

/* Store current and background layers and first empty layer. */
fg = curlayer()
bg = curblayer()
emp = emptylayers()
if (words(emp) = 0) then do
    ok = notify(2,'!No empty layer.','Clones will be placed','on current layer.','Original will be','!nuked.')
    if ok = 0 then return
    tlt = 0
end
if (words(emp) > 0) then do
    tl = word(emp,1)
    tlt = 1
end
filnam = 'ENV:PCDLX.state'
version = 'PCloneDeluxe1.5'
slm = 2
clm = 0
rrx = 1
rry = 1
rrz = 1
rmp = 360 360 360
rcn = 0 0 0
tdr = 0
rsx = 1
rsy = 1
rsz = 1
globs = '1'
smp = 30 30 30


if (exists(filnam)) then do
    if (~open(state, filnam, 'R')) then break
    if (readln(state) = version) then do
        parse value readln(state) with slm clm rrx rry rrz rsx rsy rsz tdr
        globs = readln(state)
        parse value readln(state) with rmp
        parse value readln(state) with rcn
        parse value readln(state) with smp
    end
    call close state
end

rotops="None Random Radial"
scalops="None Random Fixed"

call req_begin 'Particle Clone Deluxe 1.4'
rq_sm = req_addcontrol("Clone", CH, 'Points Polygons')
rq_cm = req_addcontrol("Unify Clones", B)
rq_rx = req_addcontrol("Rotation on X", CH, rotops)
rq_ry = req_addcontrol("            Y", CH, rotops)
rq_rz = req_addcontrol("            Z", CH, rotops)
rq_rmp = req_addcontrol("Max Random Rotations", V, 0)
rq_rcn = req_addcontrol("Radial Center", V, 1)
rq_tdr = req_addcontrol("3-D Radial Alignment", B)
rq_sx = req_addcontrol("Scaling on X", CH, scalops)
rq_sy = req_addcontrol("           Y", CH, scalops' Lock_to_X')
rq_sz = req_addcontrol("           Z", CH, scalops' Lock_to_X')
rq_gs = req_addcontrol("Scaling funtion (of d)", S, 40)
rq_smp = req_addcontrol("Max Scale Percentages", V, 0)
call req_setval rq_sm, slm, 2
call req_setval rq_cm, clm, 0
call req_setval rq_rx, rrx, 1
call req_setval rq_ry, rry, 1
call req_setval rq_rz, rrz, 1
call req_setval rq_rmp, rmp, 360 360 360
call req_setval rq_rcn, rcn, 0 0 0
call req_setval rq_tdr, tdr, 0
call req_setval rq_sx, rsx, 1
call req_setval rq_sy, rsy, 1
call req_setval rq_sz, rsz, 1
call req_setval rq_gs, globs, "1"
call req_setval rq_smp, smp, 30 30 30

if (~req_post()) then do
    call req_end
    exit
end
slm = req_getval(rq_sm)
clm = req_getval(rq_cm)
rrx = req_getval(rq_rx)
rry = req_getval(rq_ry)
rrz = req_getval(rq_rz)
rmp = req_getval(rq_rmp)
parse var rmp rmx rmy rmz
rcn = req_getval(rq_rcn)
parse var rcn rcx rcy rcz
rsx = req_getval(rq_sx)
tdr = req_getval(rq_tdr)
rsy = req_getval(rq_sy)
rsz = req_getval(rq_sz)
globs = req_getval(rq_gs)
smp = req_getval(rq_smp)
parse var smp smx smy smz

call req_end

call setlayer(bg)
n = xfrm_begin()
if (n = 0) then return

call meter_begin(n, syscode, "Reading Points")
do i=1 to n
    xyz.i = xfrm_getpos(i)
    call meter_step()
end i
call meter_end()
call xfrm_end()

cloneop = 2
if clm=0 then cloneop=1
if slm=1 then cloneop=1

if cloneop = 1 then do
    call setlayer(fg)
    call sel_mode('user')
    if slm=1 then call sel_point('CLEAR')
    if slm=2 then call sel_polygon('CLEAR')
    if tlt=1 then do
        call copy()
        call setlayer(tl)
        call paste()
    end
    call PadVol
    if slm = 1 then call sel_point('SET','VOLUME',x1 y1 z1,x2 y2 z2)
    if slm = 2 then call sel_polygon('SET','VOLINCL',x1 y1 z1,x2 y2 z2)

    call repl_begin(COPY)
    call meter_begin(n, syscode, "Generating Clones")
    do i=1 to n
        call RTSCLCLC
        call repl_step(xyz.i, scx scy scz, rox roy roz)
        call meter_step()
    end i
    call meter_end()
    call repl_end()
    call cut()
    call CREDITS
    return
end

if cloneop=2 then do
    if tlt=0 then do
        call notify(1,"!Must have an empty layer","!to UNIFY polygons.","Try again!")
        call setlayer(fg)
        call sel_mode('USER')
        call sel_polygon('CLEAR')
        call PadVol
        call sel_polygon('SET','VOLINCL',x1 y1 z1,x2 y2 z2)
        call paste()
        call cut()
        return
    end
    if n > 3 then do
        ok = notify(2,"!Unifying Clones is REALLY SLOW","(Clones are UNIFIED","one at a time)","@Continue Anyway?")
        if ok = 0 then return
    end
    call setlayer(fg)
    call sel_mode('user')
    call sel_polygon('CLEAR')
    call PadVol
    then call sel_polygon('SET','VOLINCL',x1 y1 z1,x2 y2 z2)
    call cut()
    call ADD_BEGIN
    pt = ADD_POINT(0 0 0)
    call ADD_END
    call sel_point('CLEAR')
    call PadVol
    call sel_point('SET','VOLUME',x1 y1 z1,x2 y2 z2)
    call paste()
    call cut()
    call sel_polygon('CLEAR')
    do i=1 to n
        call RTSCLCLC
        call PadVol
        call sel_point('SET','VOLUME',x1 y1 z1,x2 y2 z2)
        call repl_begin('COPY')
        call repl_step(xyz.i, scx scy scz, rox roy roz)
        call repl_end()
        call CUT()
        call setlayer(tl)
        call setblayer(fg)
        call meter_begin(n, syscode, "Generating Clones ("i"/"n")")
        do j=1 to i
            call meter_step()
        end j
        call BOOLEAN('UNION')
        call meter_end()
        call setlayer(fg)
        call sel_polygon('CLEAR')
        call PadVol
        call sel_polygon('SET','VOLINCL',x1 y1 z1,x2 y2 z2)
        call PASTE()
        call cut()
    end i
    call setlayer(tl)
    call CREDITS
    return
end

PADVOL:
box=boundingbox()
parse var box blah x1 x2 y1 y2 z1 z2
x1=x1-1
x2=x2+1
y1=y1-1
y2=y2+1
z1=z1-1
z2=z2+1
return

ARCTAN:
actu = actn
if actu < -1 then th = 90+(atan(1/abs(actn)) * 180 / pi)
if (actu < 1.00001)&(actu > -1.00001) then th = atan(actn) * 180 / pi
if actu > 1 then th = 90-(atan(1/actn) * 180 / pi)
return


RTSCLCLC:
    parse var xyz.i x y z
    x=x-rcx
    y=y-rcy
    z=z-rcz
    d = sqrt(x*x+y*y+z*z)
    interpret 'scx='||globs
    interpret 'scy='||globs
    interpret 'scz='||globs
    if rsx=2 then scx=scx*((randu()-.5)*smx/50*rsx+1)
    if rsy=2 then scy=scy*((randu()-.5)*smy/50*rsy+1)
    if rsz=2 then scz=scz*((randu()-.5)*smz/50*rsz+1)
    if rsx=3 then scx=scx*smx/100
    if rsy=3 then scy=scy*smy/100
    if rsz=3 then scz=scz*smz/100
    if rsy=4 then scy=scx
    if rsz=4 then scz=scx
    rox = 0
    roy = 0
    roz = 0

    if tdr=1 then do        /* 3-D Radial Rotation */
        /* First we adjust our heading */
        yf=0
        if z=0 then do
            if x>0 then roy=roy+90
            if x<0 then roy=roy-90
            yf = 1
        end
        if x=0 then do
            if z>0 then roy=roy+0
            if z<0 then roy=roy+180
            yf = 1
        end
        if yf=0 then do
            actn=abs(x/z)
            call arctan
            if z>0 then do           /* quadrant 1 */
                if x>0 then roy=roy+th
            end
            if z>0 then do           /* quadrant 2 */
                if x<0 then roy=roy-th
            end
            if x<0 then do           /* quadrant 3 */
                if z<0 then roy=roy+180+th
            end
            if z<0 then do           /* quadrant 4 */
                if x>0 then roy=roy+180-th
            end
        end

    /* Now we pitch up */
        nd=sqrt(z*z+x*x)
        yf=0
        if nd=0 then do
            if y>0 then rox=rox+90
            if y<0 then rox=rox+-90
            yf = 1
        end
        if y=0 then yf = 1
        if yf=0 then do
            actn=abs(y/nd)
            call arctan
            if y>0 then rox=rox+th
            if y<0 then rox=rox-th
        end
    end

    if rrx=2 then rox=rox+(randu()-.5)*rmx*2
    if rrx=3 then do             /* radial rotation for x */
        yf=0
        if y=0 then do
            if z>0 then rox=rox+0
            if z<0 then rox=rox+180
           yf = 1
        end
        if z=0 then do
            if y>0 then rox=rox+90
            if y<0 then rox=rox-90
            yf = 1
        end
        if yf=0 then do
            actn=abs(z/y)
            call arctan
            if y>0 then do           /* quadrant 1 */
                if z>0 then rox=rox+90-th
            end
            if y>0 then do           /* quadrant 2 */
                if z<0 then rox=rox+90+th
            end
            if z<0 then do           /* quadrant 3 */
                if y<0 then rox=rox-90-th
            end
            if y<0 then do           /* quadrant 4 */
                if z>0 then rox=rox-90+th
            end
        end
    end

    if rry=2 then roy=roy+(randu()-.5)*rmy*2
    if rry=3 then do             /* radial rotation for y */
        yf=0
        if z=0 then do
            if x>0 then roy=roy+90
            if x<0 then roy=roy-90
            yf = 1
        end
        if x=0 then do
            if z>0 then roy=roy+0
            if z<0 then roy=roy+180
            yf = 1
        end
        if yf=0 then do
            actn=abs(x/z)
            call arctan
            if z>0 then do           /* quadrant 1 */
                if x>0 then roy=roy+th
            end
            if z>0 then do           /* quadrant 2 */
                if x<0 then roy=roy-th
            end
            if x<0 then do           /* quadrant 3 */
                if z<0 then roy=roy+180+th
            end
            if z<0 then do           /* quadrant 4 */
                if x>0 then roy=roy+180-th
            end
        end
    end

    if rrz=2 then roz=roz+(randu()-.5)*rmz*2
    if rrz=3 then do             /* radial rotation for z */
        yf=0
        if y=0 then do
            if x>0 then roz=roz+90
            if x<0 then roz=roz-90
            yf = 1
        end
        if x=0 then do
            if y>0 then roz=roz+0
            if y<0 then roz=roz+180
            yf = 1
        end
        if yf=0 then do
            actn=abs(x/y)
            call arctan
            if y>0 then do           /* quadrant 1 */
                if x>0 then roz=roz+th
            end
            if y>0 then do           /* quadrant 2 */
                if x<0 then roz=roz-th
            end
            if x<0 then do           /* quadrant 3 */
                if y<0 then roz=roz+180+th
            end
            if y<0 then do           /* quadrant 4 */
                if x>0 then roz=roz+180-th
            end
        end
    end
return

CREDITS:
call notify(1,'Thank you for using','!Particle Clone Deluxe','@ -GLYPH (03/15/1997)')
if (open(state, filnam, 'W')) then do
    call writeln state, version
    call writeln state, slm clm rrx rry rrz rsx rsy rsz tdr
    call writeln state, globs
    call writeln state, rmp
    call writeln state, rcn
    call writeln state, smp
    call close state
end
return