;**
;**  This CADKEY LISP program is provided with CADKEY LISP free of charge.
;**  This and other example programs are for demonstration purposes and
;**  should be thoroughly tested and inspected prior to implementation in
;**  any CADKEY LISP application program.  BitWise Solutions does not
;**  warrant the functionality nor correctness of this or any example
;**  program.  All or portions of this example program may be included
;**  in an CADKEY LISP application program provided the following copyright
;**  line appears at the beginning of the application:
;**                 Copyright 1994, BitWise Solutions
;**
;**  Copyright 1994, BitWise Solutions.  All rights reserved.
;**
;** -----------------------------------------------------------------------
;**  CmFrac.Lsp
;**
;**  Cmfrac will draw a representation of a fractal.  The example will show
;**  the difference of drawing a line using the LINE command and the ENTMAKE
;**  function.  Type 'cmfrac' to execute the program.  A level of 9 will
;**  generate a nicely detailed fractal.  The higher the level, the more
;**  detailed (and thus the more time required) the fractal becomes.
;**
;** -----------------------------------------------------------------------
;**
(defun fract (x1 y1 x2 y2 lev / p1 p2 newx newy )
	(if (= lev 0)
		(progn
			(setq	p1 (list x1 y1)
					p2 (list x2 y2)
			)
			(if (= doption "1")
				(cmdline p1 p2 clr)
			;else
				(makeline p1 p2 clr)
			)

			(setq clr (1+ clr))
			(if (> clr 15)
				(setq clr 1)
			)
		)
	; else
		(progn
			(setq newx (+ (/ (+ x1 x2) 2) (/ (- y2 y1) 2))
					newy (- (/ (+ y1 y2) 2) (/ (- x2 x1) 2))
			)
			(fract x1 y1 newx newy (1- lev))
			(fract newx newy x2 y2 (1- lev))
		) ; end progn
	) ; end if
)

(defun cmdline ( p1 p2 cl / )
	(command "_.color" cl)
	(command "_.line" p1 p2 "")
)

(defun makeline ( p1 p2 cl / dxflist )
	(setq dxflist
			(list (cons 0 "LINE")
					(cons 10 p1)
					(cons 11 p2)
					(cons 62 cl)
			)
	)
	(entmake dxflist)
)

(defun c:cmfrac ( / ul lr level)
	(setvar "cmdecho" 0)
	(setq	level		(getint "\nEnter level of fractal: ")
			ul			(getpoint "\nEnter left fractal limits: ")
			lr			(getcorner ul "\nEnter right fractal limits: ")
	)
	(setq ul (list (+ (car ul) (* (- (car lr) (car ul)) 0.3)) (cadr ul))
			lr (list (- (car lr) (* (- (car lr) (car ul)) 0.3)) (cadr ul))
	)

	(princ "\nEnter drawing option,")
	(initget 1 "1 2")
	(setq doption (getkword "\n<1> Command line, <2> Entmake: " ))
	(setq clr 1)

	(fract (car ul) (cadr ul) (car lr) (cadr lr) level)
	(princ)
)


