(use-package :oli)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Das Folgende prüft die Dichte aller Teile    ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(sd-defdialog 'Teile-Dichte_pruefen
  :dialog-title   "Dichte Pruefung"
  :start-variable 'object
  :variables
  '(
  	(partlist)
	 	(OBJECT		:value-type		:part-assembly
				:title        	 	"Teil/Baugr."
				:prompt-text   		"Teil/Baugr. wählen"
				:initial-value		nil
				:after-input	
		(progn
		(if minimum	(initialize)
			)
																		);progn
	 	)
	 	(Minimum	:value-type		:positive-number	 								:initial-value		nil	
	 			:title			"Dichte >="
	 			:after-input		(if object 
				(initialize)
			)
	 	)
	 	("-")
	 	(alte_dichte	:value-type		:display-only
	 			:title			" alte Dichte"
			 	:initial-value		nil
				:initial-optional 	t
			)				
	 	(neue_dichte	:value-type		:positive-number
	 			:initial-value		0.00785
	 			:title			"neue Dichte"
	 			:after-input		(if (/= neue_dichte alte_dichte)
	 	
	 	(sd-set-variable-status 'next :title "aendern")
	 	(sd-set-variable-status 'next :title "Weiter")
	 	
	 		);if
	 	)
	 	
	 	(OBJECT2	:value-type		:part-assembly
	 			:initial-visible	nil
	 			:modifies		nil
	 			:after-input		(display object2)
	 	)
	 	(Weiter		:push-action		(progn
		
		(if (sd-inq-obj-contents-read-only-p object2)
		(progn
		(setq result
		(display "Teil ist gesperrt. Keine Änderungen moeglich."); Press Cancel to reserve part by pressing RESERVE or Continue to leave part unchanged")
		
		)
		)
		(progn
		(sd-call-cmds (set_part_density object2 neue_dichte))
		(sd-call-cmds (set_part_base_density :parts object2 :dens neue_dichte))
		);progn
		);if
		(sd-set-variable-status 'Reserve :visible nil)
		(if partlist
		(progn
		(inquire_part)
		);progn
		(progn
		(sd-call-cmds (clear_vp (sd-inq-current-vp)))
		(sd-call-cmds (set_vp_drawlist (sd-inq-current-vp) object))
		(sd-call-cmds (fit_vp (sd-inq-current-vp)))
		(sd-abort-dialog)
		);progn
		);if
	 	)
	 	)
  )
  :local-functions
  '(
  	(initialize ()
		(let ((tree (jb-inq-obj-tree-list object)))
			(dolist (i (remove-if #'(lambda (obj)	(or (equal (sd-inq-obj-pathname obj) nil) (and  (not (equal (sel_item-type obj) *sd-part-seltype*)) ))) tree))
				(if (>= (sd-inq-part-density i) minimum)
					(if partlist
						(progn
							(setq inlist nil)
							(dolist (j partlist)
								(if (equal (sd-inq-obj-contents-sysid i) (sd-inq-obj-contents-sysid j))
									(setq inlist t)
								);if
							);dolist
								(if (not inlist)
								(push	i	PartList)
							);if
						);progn
						(progn
							(setq partlist (list i))
						)
					);if
				);if
			);dolist
		);let
		(if partlist
			(progn
				(inquire_part)
				(if (sd-inq-obj-contents-read-only-p object2)
					(progn
						(sd-display-warning "Teil ist gesperrt. Zum Ändern entsperren")
						(sd-set-variable-status 'Reserve :visible t)
					);progn
					(sd-set-variable-status 'Reserve :visible nil)
				);if	
			);progn											
			(sd-display-warning "Alle gefundenen Teile geändert")
		)
  	);initialize
  	(inquire_part ()
  		(setq object2 (first partlist))
			(sd-call-cmds (clear_vp (sd-inq-current-vp)))
			(sd-call-cmds (set_vp_drawlist (sd-inq-current-vp) object2))
			(sd-call-cmds (fit_vp (sd-inq-current-vp)))
			(sd-call-cmds (redraw_vp (sd-inq-current-vp)))
			(setq alte_dichte (sd-inq-part-density object2))
			(setq neue_dichte alte_dichte)
			(sd-set-variable-status 'next :title "Weiter")
			(pop partlist)
  	);inquire_part
   )
);make-list

(defun jb-inq-obj-tree-list (obj)
	(cons obj
	(apply #'nconc (mapcar #'jb-inq-obj-tree-list (sd-inq-obj-children obj))))
)