;;;    *****game tree creator 0.5***
;;;
;;;    Creates graphs of game trees for game theory
;;;
;;;    By Corey Sweeney


;;,config ,load fps-package.scm
;;,open fps


;;; this is my game theory grapher for texmacs. it's not finished but has gotten to the point where i'm actually useing it by tweaking a lot of things manually for each case.

;you'll need to get scsh from http://www.scsh.net and fps (the "functional poscript" for scsh) from http://www.scsh.net/resources/fps.  make sure to apply the patch to fps.  

;;this is not integrated with texmacs yet, but that should be easy.  basically we keep our data in a macro, then have the macro write the string that represents the code to a file, then execute run-game-tree-creator.

;this has better potential for integration with texmacs in teh future, since fps can be ported to guile, and integrated into texmacs from the inside.


;;;what's missing?

;you have to execute xxx.tmp.out after it runs.  this adds a mising line.

;;; eventually we should just get texmacs to execute the temp-out file******

;;note: get the bounding box values from fps, add the padding from the constant at the begining and insert the values in the above string.  Then we don't need to run xxx.tmp.out after each pass


;node labels and line labels should check how big the text is, and center themselfs based on that.

;a auto-layout system is needed, so we don't have to care about where our nodes are, but just how they are connected, and have everythign work.
;(this has been delayed untill i can figure the right format to hand the drawer a game in.

;;;note: those who saw my eirler post, these postscript files do not cause segfaults.  it's actually the \tree command that was doing it, which this does not use.


(define scale 1)

(define node-radius (* 7 scale))
(define grey (rgb .8 .8 .8))
(define sibling-spacing (* 50 scale))
(define generation-spacing (* 70 scale))

(define node-label-font (font "Helvetica" (* 10 scale)))
(define line-label-font (font "Helvetica" (* 10 scale)))


(define (create-node-picture x y label)
  (define circle-path
    (arc  (pt x y) node-radius  0  2pi))
  (compose-pict
   (fill circle-path
	 (:color grey))
   (stroke circle-path)
   (stroke (translate (- x 5) (- y 17)
		      (simple-string->glyphpath node-label-font label)))))



(define (create-3-children parent-x parent-y list-of-labels
			   list-of-line-labels)
  (define (hypotenuse x y)
    (sqrt ( + (* x x) (* y y))))
  (define (branch-angle x y)
    (asin (/ y (hypotenuse x y))))
  (define (create-child x y label line-label)
    (define circle-picture (create-node-picture x y label))
    (define line-picture
      (stroke (line (pt 20 500) (pt x y))))
    (define line-label-picture
      (stroke
       (translate (+ (/ (- x 20) 2) 20) (+ (+ (/ (- y 500) 2) 500) 5)
		  (rotate (branch-angle (- x parent-x) (- y parent-y))
			  (simple-string->glyphpath line-label-font
						    line-label)))))
    (compose-pict circle-picture line-picture line-label-picture))
  (compose-pict
   (create-child (+ parent-x generation-spacing)
		 (+ parent-y sibling-spacing)
		 (car list-of-labels)
		 (car list-of-line-labels))
   (create-child (+ parent-x generation-spacing)
		 parent-y
		 (cadr list-of-labels)
		 (cadr list-of-line-labels))
   (create-child (+ parent-x generation-spacing)
		 (- parent-y sibling-spacing)
		 (caddr list-of-labels)
		 (caddr list-of-line-labels))))


(define generation1-pic (compose-pict
		   (create-node-picture 20 500 "21")
		   (create-3-children 20
				      500
				      `("20" "19" "18")
				      `("roi-1" "roi-2" "roi-3"))))
(show-w/ps2-text-channel "generation1.ps" generation1-pic)

(define temp-out
  (open-output-file "xxx.tmp.out"))
(display "sed 's/%%Pages: (atend)/%%Pages: (atend)\\n%%BoundingBox: 0 380 150 620 /' generation1.ps" temp-out)




;(define generation2-pic (compose-pict
;		   (create-node-picture 20 500 "21")
;		   (create-3-children 20
;				      500
;				      `("20" "19" "18")
;				      `("1" "2" "3"))))
;(show-w/ps2-text-channel "generation2.ps" generation2-pic)

;(define temp-out
;  (open-output-file "xxx.tmp.out"))
;(display "sed 's/%%Pages: (atend)/%%Pages: (atend)\\n%%BoundingBox: 0 380 150 620 /' generation2.ps" temp-out)


;add bounding box info here




(exit)