/* Implicit Blob Surface Generator */
/* by GLYPH <y82s1@unb.ca> */

	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'))
tmpnam = "t:impblob.tmp"
syscode = 'Implicit Blob v1.0'
pi=3.1415926385897932384626

call GETLAYERS
call GETSTATE
call MENU
minerr = (size/20)
call GETPOINTS
call DOIT
call CREDITS
return


GETLAYERS:
/* Store current and background layers and first empty layer. */
fg = curlayer()
emp = emptylayers()
if (words(emp) = 0) then do
    ok = notify(2,'!No empty layer.','blob 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
RETURN

GETSTATE:
filnam = 'ENV:IMPBLOB.state'
version = 'ImpBlobv1.0'
if (exists(filnam)) then do
    if (~open(state, filnam, 'R')) then break
    if (readln(state) = version) then do
        sides = readln(state)
        segments = readln(state)
        size = readln(state)
        cutoff = readln(state)
        multi = readln(state)
    end
    call close state
end
RETURN

MENU:
call req_begin syscode
rq_sides = req_addcontrol("Sides ",N,sides)
rq_segments = req_addcontrol("Segments ",N,segments)
rq_cutoff = req_addcontrol("Cutoff ",N,cutoff)
rq_size = req_addcontrol("Size ",N,size)
rq_multi = req_addcontrol("Blobs",CH,"Single Multi")

call req_setval rq_sides, sides, 4
call req_setval rq_segments, segments, 4
call req_setval rq_size, size, 1
call req_setval rq_cutoff, cutoff, 1
call req_setval rq_multi, multi, 1

if (~req_post()) then do
    call req_end
    exit
end
sides = req_getval(rq_sides)
segments = req_getval(rq_segments)
size = req_getval(rq_size)
cutoff = req_getval(rq_cutoff)
multi = req_getval(rq_multi)

call req_end
return

GETPOINTS:
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()
/*
box = boundingbox()
parse var box blah x1 x2 y1 y2 z1 z2
*/
return

CREDITS:
call notify(1,'Thank you for using','!'syscode,'@ -GLYPH (11/10/1996)')
if (open(state, filnam, 'W')) then do
    call writeln state, version
    call writeln state, sides
    call writeln state, segments
    call writeln state, size
    call writeln state, cutoff
    call writeln state, multi
    call close state
end
return

DOIT:
if tlt = 1 then call setlayer(tl)
if tlt = 0 then call CUT()
do blob = 1 to n
    parse var xyz.blob cx.blob cy.blob cz.blob
end
if multi = 1 then do
 xc = 0
 yc = 0
 zc = 0
 do blob = 1 to n
  xc = xc + cx.blob/n
  yc = yc + cy.blob/n
  zc = zc + cz.blob/n
 end
 call DOBLOB
end

if multi = 2 then do
 do blob = 1 to n
  xc = cx.blob
  yc = cy.blob
  zc = cz.blob
  call DOBLOB
 end
end
return

DOBLOB:
call ADD_BEGIN
do segment = -segments to segments
 do side = 0 to sides
  call TRACE
 end
end

/* Here's the polys */
do segment = 0 to segments*2-1
 do side = 0 to sides-1
  pnum = segment*(sides+1) + side + 1
  pcode = trunc(pnum+1)||' '||trunc(pnum)||' '||trunc(pnum+sides+1)||' '||trunc(pnum+sides+2)
  call add_quad(pcode)
 end
end

call ADD_END
return

TRACE:
vx = cos(side*pi*2/sides)*cos(segment*pi/segments/2)
vy = sin(segment/segments*pi/2)
vz = sin(side*pi*2/sides)*cos(segment*pi/segments/2)
loc = size/cutoff
jmp = loc/2

MIDTRACE:
done = 0
do while done = 0
 px = xc + loc * vx
 py = yc + loc * vy
 pz = zc + loc * vz
 call EVALPOINT
 perr = cutoff - pnt

 if pnt < cutoff then do
  loc = loc - jmp
  jmp = jmp / 2
 end

 if pnt > cutoff then do
  loc = loc + jmp
 end
 done = 0

 if jmp < minerr/2 then jmp = jmp * 3

 if abs(perr) < minerr then done = 1
/* call ADD_POINT(px py pz) */
end

ENDTRACE:
call ADD_POINT(px py pz)
return

EVALPOINT:
pnt = 0
do blb = 1 to n
 dist = sqrt((px-cx.blb)**2+(py-cy.blb)**2+(pz-cz.blb)**2)
 dv = 999999999
 if dist > 0 then dv = size/dist
 pnt = pnt + dv
end
return