#|
created: 2011-05-02
last modified: 2011-05-02
version: 1.02
Author: Patrick Weber
for: ThE CaD.De-CoMmUnItY
tested with: OneSpace Modeling v17.0 M030

quick-and-diry!

|#


(in-package :custom)
(use-package :OLI)

(sd-defdialog 'custom-pkg2jpg-recursive-dialog
	:dialog-title "pkg2jpg"
	:variables
	'(
		(LOCATION		:value-type :directory
								:title "Quelle"
								:initialDirectory "C:/temp"
		)
		("picture settings")
    (KEEP_VP_SETTINGS
            :value-type :boolean
            :title "keep viewport camera and drawlist"
            :toggle-type :wide-toggle
            :initial-value t  ;t, nil ; If you change something here, you will have to change ALL_PARTS too.
    )
    (ALL_PARTS
            :value-type :boolean
            :title "isometric view (XY-Z), all parts"
            :toggle-type :wide-toggle
            :initial-value nil  ;nil, t ; If you change something here, you will have to change KEEP_VP_SETTINGS too.
    )
    (WP     :value-type :boolean
            :title "hide workplanes"
            :toggle-type :wide-toggle
            :initial-value nil ;nil, t
    )
    (XSIZE  :value-type :integer
            :title "width:"
            :initial-value 800
    )
    (YSIZE
            :value-type :integer
            :title "height:"
            :initial-value 600
    )
	)
	:local-functions
	'(
		(index-all-pkg (LOCATION)
			(let (FULL_LIST PIC_FULL_FILENAME ORG_VP_CAM ORG_VP ORG_VP_MAX PIC_VP)
				(setf FULL_LIST (ls-recursive LOCATION))
				(dolist (F FULL_LIST)
					(if (sd-string-match-pattern-p "*.[pP][kK][gG]" (first F))
						(progn
							(sd-call-cmds (load_package (first F)))
							(when KEEP_VP_SETTINGS 
								(setf ORG_VP_CAM (sd-inq-vp-camera (sd-inq-current-vp)) ;if KEEP_VP_SETTINGS is true -> set variable ORG_VP_CAM as SD-VP-CAMERA-STRUCT
									ORG_VP (sd-inq-current-vp)) ;inquire name of the "old" viewport
							) ;end: when
							(create_vp) ;creates new viewport with standard background, add :background_color "#FFFFFF" for white background  or  :background_color "#000000" for black background
							(setf PIC_VP (sd-inq-current-vp)) ;inquires the name of the new viewport
							(if ALL_PARTS
								(progn
									(uic_draw_all PIC_VP) ;enables all objects in struct browser
									(when WP (remove_from_vp_drawlist PIC_VP (sd-call-cmds (get_selection :focus_type *sd-workplane-seltype* :select :all_at_top)))) ;if WP is true -> hide all workplanes
									(set_vp_direction PIC_VP (make-gpnt3d :x 1.0 :y 1.0 :z -1.0)) ;set isometric view
									(fit_vp PIC_VP) ;fit parts in viewport
									(update_screen)
								)
								(progn
									(copy_vp_drawlist PIC_VP ORG_VP) ;copies the drawlist of the active viewport to the new one
									(when WP (remove_from_vp_drawlist PIC_VP (sd-call-cmds (get_selection :focus_type *sd-workplane-seltype* :select :all_at_top)))) ;if WP is true -> hide all workplanes
									(sd-set-vp-camera PIC_VP ORG_VP_CAM :smooth nil) ;set the kept camera setting
									(update_screen)
								)
							) ;end: if
							(setf PIC_FULL_FILENAME (format nil "~a.jpg" (subseq (first F) 0 (- (length (first F)) 4)))) ;substitute .pkg with .jpg
							(when (sd-inq-file-status PIC_FULL_FILENAME :existence) (delete-file PIC_FULL_FILENAME));if filename exists -> delete
							(create_thumbnail :vp PIC_VP :size :user :size_x XSIZE :size_y YSIZE :fit :off :filename PIC_FULL_FILENAME) ;creates picture
							(delete_vp PIC_VP) ;delete picture viewport
							(sd-maximize-vp (sd-inq-current-vp)) ;maximize "old" viewport window ---- remove if not wanted
							;(sd-call-cmds (delete_3d :all_at_top))
							(sd-call-cmds (uic_reset_session :yes))
						)
					)
				)
			)
		)
  )
	:ok-action '(index-all-pkg LOCATION)
	:help-action '()
)

(defun ls-recursive (DIR)
	(let (F LSR)
		(setq  F (directory (format nil "~a/*" DIR)))
		(dolist (L F)
			(if (sd-directory-p (namestring L))
				(setq LSR (nconc LSR (ls-recursive (namestring L))))
				(push (list (namestring L) (file-write-date (namestring L))) LSR)
			)
		)
		LSR
	)
)