/*************************************************************\
/                                                               \                              
            Fourier V2.0, by Reinhard Grams © 1995
\                                                               / 
 \*************************************************************/

StartMacro:

	call InitMacro("Fourier",1)
	call SetParms()
	call DoTheJob()
	call ExitMacro()

/**************************************************************/

DoTheJob:

	source_layer=curlayer(); result_layer=LWE_GetEmptyLayer(-1)
	if (result_layer="") then call ExitMacro(NO_LAYER_ERR) 
	if (result_layer~=source_layer) then call setlayer(result_layer)

	call randu(random_seed)

	freq=start_frequency
	damp=start_damping

	if (frames>1) then do
		freq_step=(end_frequency-start_frequency)/(frames-1)
		damp_step=(end_damping-start_damping)/(frames-1)
	end
	else do
		freq_step=0; damp_step=0
	end

	if (diff_surfaces) then do
		f1=".FACE"; f2=".BEVEL"; f3=".SIDE"
	end
	else do
		f1=""; f2=""; f3=""
	end

	surf=1
	do frame=1 to frames
		if (frames>1) then do		
			surface_name="Fourier."||surf
			surf=surf+1; if (surf>surfaces_max) then surf=1
			file=LWE_AddExt(file_name,frame)
		end
		else do
			surface_name="Fourier"
		end
		call CalcSegment(cx,cy,cz-radius_z,freq,damp)		
		if (frames>1) then do
			call save(file)
			call cut(); call cut()
		end
		freq=freq+freq_step
		damp=damp+damp_step
	end

	if (verbose & frames>1) then do
		call notify(1, trunc(frames) vmes.language)
	end

	return

/**************************************************************/

CalcSegment: ARG x, y, z, frequency, damping

	source_layer=curlayer()
	result_layer=LWE_GetEmptyLayer(source_layer)
	if (result_layer=0) then call ExitMacro(NO_LAYER_ERR)

	call sel_mode("USER")

	sa=PIM2/points; a=0
	if (frames>1) then v=randu()*PIM2; else v=0

	func1="coef1="func.1
	func2="coef2="func.2

	if (frames>1) then do
		infl2=(frame-1)/(frames-1); infl1=1-infl2
	end
	else do; infl1=1; infl2=0; end

	do p=1 to points
		fc=0; fe=1; fcv=1
		do while (fcv<iterations*2+1)
			f=fe/iterations; fe=fe+1
			interpret(func1)
			interpret(func2)
			coef=coef1*infl1+coef2*infl2
			fc=fc+coef*sin(fcv*v*frequency)
			fcv=fcv+2
		end
		if (do_rings) then do
			px.p=sin(a)*radius_x*(offset+damping*(1+abs(fc)))
			py.p=cos(a)*radius_y*(offset+damping*(1+abs(fc)))
		end
		else do
			px.p=(p-1)*radius_x*2/(points-1)
			if (p=1 | p=points) then py.p=0
			else py.p=radius_y*2*(offset+damping*(1+abs(fc)))
		end
		v=v+sa; a=a+sa
	end

	if (keep_size) then do
		max_x=px.1;	max_y=py.1
		do p=2 to points
			if (px.p>max_x) then max_x=px.p	
			if (py.p>max_y) then max_y=py.p	
		end
		if (do_rings) then do
			do p=1 to points
				if (max_x>0) then px.p=px.p/max_x*radius_x; else px.p=radius_x 
				if (max_y>0) then py.p=py.p/max_y*radius_y; else py.p=radius_y
			end
		end
		else do
			do p=1 to points
				if (max_y>0) then py.p=(py.p/max_y)*radius_y; else py.p=radius_y
			end
		end
	end

	if (~do_rings) then x=-radius_x
	call add_begin() 
	plist=""
	do p=points to 1 by -1
		p=trunc(p); plist=plist add_point(x+px.p y+py.p z)
	end
	call surface(surface_name||f1)
	if (use_curves) then do
		if (do_rings) then call add_curve(plist word(plist,1))
		else call add_curve(plist)
	end
	else call add_polygon(plist)
	call add_end()

	if (do_bevel) then do
		call mirror("Z")
		call setlayer(result_layer)
		call add_begin() 
		plist=""
		do p=1 to points
			plist=plist add_point(x+px.p y+py.p z)
		end
		call surface(surface_name||f2)	
		if (use_curves) then do
			if (do_rings) then call add_curve(plist word(plist,1))
			else call add_curve(plist)
		end
		else call add_polygon(plist)
		call add_end()
		a=LWE_Heading(px.2-px.1,py.2-py.1)
		if (a<0) then f=-1; else f=1
		call bevel(radius_z*bevel_width*f,radius_z*bevel_depth*f)

		new_points=xfrm_begin()
		if (new_points~=points*2) then call ExitMacro(BEVEL_ERR)

		do p=points+1 to new_points
			parse value xfrm_getpos(p) with bx.p by.p bz.p
		end
		call xfrm_end()
		call sel_polygon("SET","NVEQ",points)
		call removepols()
		call mirror("Z")
		call flip()
		call cut()	
		call surface(surface_name||f3)
		call add_begin()
		plist=""
		do p=points+1 to new_points
			plist=plist add_point(bx.p by.p bz.p)
		end
		if (use_curves) then do
			if (do_rings) then call add_curve(plist word(plist,1))
			else call add_curve(plist)
		end
		else call add_polygon(plist)
		call add_end()
		call extrude("Z",(radius_z-(radius_z*bevel_depth))*2,1)
		call sel_polygon("SET","NVEQ",points)
		call removepols()
		call paste()
		call cut()
		call setlayer(source_layer)
		call paste()
		if (do_merge) then call mergepoints()
	end
	else do
		if (do_extrude) then call extrude("Z",radius_z*2,1)
	end

	return

/**************************************************************/

InitVariables:

	PI=3.14159265358
	PID180=PI/180
	PIM2=PI*2

	do_merge=1
	points=50
	start_damping=0.5
	end_damping=0.5
	offset=0.1
	start_frequency=3.3
	end_frequency=4.7
	iterations=3
	frames=1
	do_rings=1
	use_curves=0
	do_bevel=1
	do_extrude=1
	keep_size=1
	bevel_depth=0.05
	bevel_width=0.05
	cx=0; cy=0; cz=0
	radius_x=1; radius_y=1; radius_z=1
	func.1="sin(f)"
	func.2="sqrt(f)"
	diff_surfaces=0
	surfaces_max=2
	random_seed=4713

	rmes.0="Sequence Basename"
	rmes.1="Sequenz Basisnamen"
	vmes.0="Fourier Objects generated"
	vmes.1="Fourier Objekte erzeugt"

	return

/**************************************************************/

SetParms:

	call GeneralRequester()
	call OptionsRequester()
	if (do_bevel) then call BevelRequester()

	if (frames>1) then do
		file_name=SelectFile(rmes.language,"3D:Objects",1)
		if (file_name="(none)") then call ExitMacro()
	end

	call SaveConfig()

	return

/**************************************************************/

OptionsRequester:

	call req_begin(macro_name": Options")

	id_sr=req_addcontrol("Scale to Radius",'b')
	id_dr=req_addcontrol("Do Circle",'b')
	id_be=req_addcontrol("Do Bevel",'b')
	id_ex=req_addcontrol("Do Extrude",'b')
	id_cu=req_addcontrol("Use Curves",'b')
	id_su=req_addcontrol("Different Surfaces",'b')
	id_sm=req_addcontrol("Max Surfaces",'n')

	call req_setval(id_sr,keep_size)
	call req_setval(id_dr,do_rings)
	call req_setval(id_be,do_bevel)
	call req_setval(id_ex,do_extrude)
	call req_setval(id_cu,use_curves)
	call req_setval(id_su,diff_surfaces)
	call req_setval(id_sm,surfaces_max)
	if (~req_post()) then call ExitMacro()

	keep_size=req_getval(id_sr)
	do_rings=req_getval(id_dr)
	do_bevel=req_getval(id_be)
	do_extrude=req_getval(id_ex)
	use_curves=req_getval(id_cu)
	diff_surfaces=req_getval(id_su)
	surfaces_max=req_getval(id_sm)
	call req_end()

	if (do_bevel) then do_curves=0

	return

/**************************************************************/

GeneralRequester:

	call req_begin(macro_name": General")

	id_se=req_addcontrol("Objects",'n')
	id_po=req_addcontrol("Outline Points",'n')
	id_it=req_addcontrol("Iterations",'n')
	id_fr=req_addcontrol("Frequency Start,End",'v')
	id_da=req_addcontrol("Damping Start,End",'v')
	id_of=req_addcontrol("Shift Value",'n')
	id_ss=req_addcontrol("Radius X, Y, Z",'v',1)
	id_c1=req_addcontrol("Coeff 1",'s',32)
	id_c2=req_addcontrol("Coeff 2",'s',32)

	call req_setval(id_se,frames)
	call req_setval(id_po,points)
	call req_setval(id_it,iterations)
	call req_setval(id_fr,start_frequency end_frequency 0)
	call req_setval(id_da,start_damping end_damping 0)
	call req_setval(id_of,offset)
	call req_setval(id_ss,radius_x radius_y radius_z)
	call req_setval(id_c1,func.1)
	call req_setval(id_c2,func.2)
	if (~req_post()) then call ExitMacro()

	frames=req_getval(id_he)
	points=req_getval(id_po)
	iterations=req_getval(id_it)
	freq=req_getval(id_fr)
	parse value freq with start_frequency end_frequency .
	damp=req_getval(id_da)
	parse value damp with start_damping end_damping .
	offset=req_getval(id_of)
	radius=req_getval(id_ss)
	parse value radius with radius_x radius_y radius_z
	func.1=req_getval(id_c1)
	func.2=req_getval(id_c2)
	call req_end()

	if (iterations<0) then iterations=0
	if (points<3) then points=3
	if (frames<1) then frames=1
	if (func.1="") then func.1="1/f"
	if (func.2="") then func.1="1-1/f"
	if (random_seed=0) then random_seed=time('s')

	return

/**************************************************************/

BevelRequester:

	call req_begin(macro_name": Bevel")

	id_bw=req_addcontrol("Bevel Width",'n')
	id_bd=req_addcontrol("Bevel Depth",'n')
	id_me=req_addcontrol("Merge Points",'b')

	call req_setval(id_bw,bevel_width)
	call req_setval(id_bd,bevel_depth)
	call req_setval(id_me,do_merge)
	if (~req_post()) then call ExitMacro()

	bevel_width=req_getval(id_bw)
	bevel_depth=req_getval(id_bd)
	do_merge=req_getval(id_me)
	call req_end()

	return

/**************************************************************/

SaveConfig:

	success=open(state,config,'W')
	if (success) then do
    	call writeln(state,frames start_frequency end_frequency,
			keep_size points radius_x radius_y radius_z iterations,
			use_curves do_rings start_damping end_damping offset,
			do_bevel bevel_depth bevel_width diff_surfaces,
			surfaces_max do_merge do_extrude )
    	call writeln(state,func.1)
    	call writeln(state,func.2)
		s=1; do while (s<=used_file_sel_nrs)
			writeln(state,sel_drawer.s); writeln(state,sel_file.s); s=s+1
		end
		call close state
	end
	return success

/**************************************************************/

LoadConfig:

    success=open(state,config,'R')
	if (success) then do
	    parse value readln(state) with frames,
			start_frequency end_frequency keep_size points,
			radius_x radius_y radius_z iterations,
			use_curves do_rings start_damping end_damping,
			offset do_bevel bevel_depth bevel_width diff_surfaces,
			surfaces_max do_merge do_extrude .
	    func.1=readln(state)
	    func.2=readln(state)
		s=1; do while (s<=used_file_sel_nrs)
			sel_drawer.s=readln(state); sel_file.s=readln(state); s=s+1
		end
    	call close state
	end
	return success

/**************************************************************/
/**************************************************************/
			
InitMacro: PARSE ARG macro_name, used_file_sel_nrs

	signal on error; signal on syntax
	mathlib="rexxmathlib.library"
	rexxlib="rexxsupport.library"
	supplib="LWE.library"
	modport="LWModelerARexx.port"

	if (~show('L',rexxlib)) then do
		if (~addlib(rexxlib,0,-30,0)) then exit 14
		if (~show('L',rexxlib)) then exit 14
	end
	if (~show('L',mathlib)) then do
		if (~addlib(mathlib,0,-30,0)) then exit 14
		if (~show('L',mathlib)) then exit 14
	end
	if (~show('L',supplib)) then do
		if (~addlib(supplib,0,-30,0)) then exit 14
		if (~show('L',supplib)) then exit 14
	end
	p=addlib(modport,0); if (p!=0) then exit 14

	parse value LWE_GetSettings(macro_name) with,
		config selection temp language help verbose digits .
	call InitVariables(); success=LoadConfig()
	if ((help=1 & ~success) | help=2) then do
		t=LWE_Help(macro_name); if (t=3) then call ExitMacro()
	end
	return

/**************************************************************/

ExitMacro: PARSE ARG status, add_string

	call end_all()
	if (status~="") then do
		t=LWE_ErrorRequester(macro_name,status,add_string)
		if (t=1) then signal StartMacro
		if (t=2) then t=LWE_Help(macro_name)
		if (t=1) then signal StartMacro
	end
	call remlib(modport); exit 0

/**************************************************************/

error:; syntax:
	t=Notify(1,'!Rexx Script Error','@'ErrorText(rc),'Line 'SIGL)
	call ExitMacro()

/**************************************************************/

SelectFile: PROCEDURE EXPOSE sel_drawer. sel_file.
	PARSE ARG title,def_drawer,sel_nr

	if (sel_drawer.sel_nr=="SEL_DRAWER."||sel_nr) then do
		sel_drawer.sel_nr=def_drawer; sel_file.sel_nr=""; 
	end
	file=getfilename(title,sel_drawer.sel_nr,sel_file.sel_nr)
	if (file="(none)") then return file
	sel_drawer.sel_nr=LWE_Drawer(file)
	sel_file.sel_nr=LWE_File(file)
	return file

/**************************************************************/