Horoscope or Pie plotter A pie chart is a way to show the relative portions of the whole. Pie plots have been used to map the planets and constellations for at least 3500 years, although the latest extant horoscope is about 400 AD. Here is a stater on a horoscope chart in TCL.[gold] ---- # horoscope pie plotter # horoscope pie plotter # loaded on tcl wiki # used version tcl8 # 22may2006, [gold] # start of deck # canvas_horoscope_pie_chart.tcl -- # tcl wiki script on 20060601 # modified to demonstration script in Expect 5.2 # TCL8 distribution, for Win95 use # canvas_horoscope_pie_chart.tcl -- # # horoscope pie plotter # tcl8 set color 0 proc star {x y color args } { global dx dy set c5 [lpick {black brown white gray brown3 brown4}] set c1 [lpick {red yellow blue purple pink green}] set c2 [lpick {red yellow blue purple pink green}] .p create rectangle 60 60 10 10 \ -fill $c1 -tags [concat $args mv] } proc makeplanet {x y color args} { global dx dy set color [lpick {black brown white gray \ brown3 brown4 red yellow blue purple}] set c1 [lpick {red yellow blue purple \ pink green brown black white gray}] set c2 [lpick {red yellow blue purple \ pink green brown black white gray}] .p create oval [expr {$x+2}] [expr {$y+2}] [expr {$x+$dx-3}] [expr {$y+$dy-3}] \ -fill $color -tags [concat $args mv] } proc lpick L {lindex $L [expr int(rand()*[llength $L])]} proc horoscope {win radiusradius sectors percentages color} { canvas $win -width [expr $radiusradius * 2.2] -height [expr $radiusradius * 2.2] set next 0 set x0 [expr $radiusradius * 1.1] set y0 [expr $radiusradius * 1.1] set dim [list [expr $x0 - $radiusradius] [expr $y0 - $radiusradius] \ [expr $x0 + $radiusradius] [expr $y0 + $radiusradius]] foreach segment $sectors percentage $percentages color $color { set degrees [expr $percentage * 3.6] eval $win create arc $dim -start $next -extent $degrees \ -fill $color set sectors_mid [expr ($next + $degrees / 2) * acos (0) / 90] $win create text \ [expr $x0 + $radiusradius * cos ($sectors_mid)*6 / 8] \ [expr $y0 - $radiusradius * sin ($sectors_mid)*6 / 8] \ -text $segment set next [expr $next + $degrees] } return $win } # pack [horoscope .p 220 {ARIES TAURUS CANCER GEMINI LEO VIRGO LIBRA SCORPIO SAGITTARIUS CAPRICORN "AQUARIUS" PISCES } {8.3 8.3 8.3 8.3 8.3 8.3 8.3 8.3 8.3 8.3 8.3 8.9 } {white yellow white yellow white yellow white yellow white yellow white yellow}] set dx 50 set dy 50 .p bind all <1> {set p(X) [.p canvasx %x]; set p(Y) [.p canvasy %y]} .p bind mv {mv %x %y} proc mv {x y} { global p set x [.p canvasx $x] set y [.p canvasy $y] set id [.p find withtag current] .p move $id [expr {$x-$p(X)}] [expr {$y-$p(Y)}] .p raise $id set p(X) $x; set p(Y) $y } star 20 20 20 args makeplanet 2 2 red makeplanet 2 2 brown makeplanet 2 2 blue makeplanet 2 2 green makeplanet 2 2 black makeplanet 2 2 blue makeplanet 2 2 red makeplanet 2 2 brown makeplanet 2 2 blue makeplanet 2 2 green makeplanet 2 2 black ---- Screenshot Section [http://img144.imageshack.us/img144/2320/piechartchartxxxxed0.jpg] [http://img144.imageshack.us/img144/2320/piechartchartxxxxed0.th.jpg] ---- Comments Section Please put useful comments in this section, thank you. ---- [CLN] - What, pray tell, is "horoscope pie"? I've heard of apple pie, blueberry pie, and even funeral pie but horoscope? (Less snidely put, pages full of code with no exposition at all (even in the comments) are a bit less than useful.) ---- [goldshell7] This was my first effort for the TCL wiki. The horoscope_pie_plotter.tcl has seized the niche of underappreciation. All is certain that the petitioner of wisdom will catch up with the Ancient Egyptians and Babylonians, circa 1500 BCE. See Senmut's tomb for funeral pie (or horoscope pie plot). ---- References Programming References ( TCL ) ---- [Simple Canvas Demo], http://wiki.tcl.tk/15073 [canvas],http://wiki.tcl.tk/1415 [Widgets on a canvas],http://wiki.tcl.tk/17067 See also [A little pie chart], http://wiki.tcl.tk/17968 ---- Web References ---- http://en.wikipedia.org/wiki/Pie_chart http://www.stariq.com/ google >> Astrology and Horoscope Homepage - Astrodienst http://www.astro.com/horoscopes/ahor.asp google >> Babylon - Wikipedia, the free encyclopedia http://en.wikipedia.org/wiki/Babylon http://www.geocities.com/astrologyconstellations/nonzodiac.htm http://www.nickcampion.com/nc/history/eygptian.html http://touregypt.net/featurestories/dendera.htm http://en.wikipedia.org/wiki/Dendera google >> urania horoscope russia http://www.urania.ru/english/Chart/index.html http://www.urania.ru/english/Chart/fullscreen.html For total eclipse on 3Mar2007, try plotting London,03:03:2007,GMT 2244 on Urania. http://news.bbc.co.uk/1/hi/sci/tech/6411991.stm http://analyzer.depaul.edu/paperplate/Egyptian%20calendar.htm http://www.historylab.org/../calendars/calendars.htm google >> Astronomical Ceiling-Decoration in Tomb of Senmut google >> Senemut - Wikipedia, the free encyclopedia http://en.wikipedia.org/wiki/Senemut http://www.geocities.com/astrologyages/images/senmutnorth.jpg ---- Appendix of optional unicode symbols $c create text 25c 25.2c -text "\u263D moon " -font $font3 -tags item $c create text 25c 25.2c -text "\u263F mercury" -font $font3 -tags item $c create text 25c 25.2c -text "\u2640 venus" -font $font3 -tags item $c create text 25c 25.2c -text "\u2641 earth" -font $font3 -tags item $c create text 25c 25.2c -text "\u2642 mars" -font $font3 -tags item $c create text 25c 25.2c -text "\u2644 saturn" -font $font3 -tags item $c create text 25c 25.2c -text "\u2643 jupiter" -font $font3 -tags item $c create text 25c 25.2c -text "\u2645 uranus" -font $font3 -tags item $c create text 25c 20.2c -text "\u2646 neptune" -font $font3 -tags item $c create text 25c 20.2c -text "\u2647 pluto" -font $font3 -tags item $c create text 25c 20.2c -text "\u260A sun" -font $font3 -tags item $c create text 25c 20.2c -text "\u260B " -font $font3 -tags item $c create text 25c 20.2c -text "\u260C " -font $font3 -tags item $c create text 25c 20.2c -text "\u260D " -font $font3 -tags item $c create text 25c 20.2c -text "\u2648 " -font $font3 -tags item $c create text 25c 20.2c -text "\u2649 " -font $font3 -tags item $c create text 25c 20.2c -text "\u2650 " -font $font3 -tags item $c create text 25c 20.2c -text "\u2651 " -font $font3 -tags item $c create text 25c 20.2c -text "\u2652 " -font $font3 -tags item $c create text 25c 20.2c -text "\u2653 " -font $font3 -tags item $c create text 25c 20.2c -text "\u2654 " -font $font3 -tags item $c create text 25c 20.2c -text "\u2655 " -font $font3 -tags item $c create text 25c 20.2c -text "\u2656 " -font $font3 -tags item $c create text 25c 20.2c -text "\u264A " -font $font3 -tags item $c create text 25c 20.2c -text "\u264B " -font $font3 -tags item $c create text 25c 20.2c -text "\u264C " -font $font3 -tags item $c create text 25c 20.2c -text "\u264D " -font $font3 -tags item $c create text 25c 20.2c -text "\u264E " -font $font3 -tags item $c create text 25c 20.2c -text "\u264F " -font $font3 -tags item $c create text 25c 20.2c -text "\u2650 " -font $font3 -tags item $c create text 25c 20.2c -text "\u2651 " -font $font3 -tags item $c create text 25c 20.2c -text "\u2652 " -font $font3 -tags item $c create text 25c 20.2c -text "\u2653 " -font $font3 -tags item $c create text 25c 15.2c -text "\u2630 tian" -font $font3 -tags item $c create text 25c 15.2c -text "\u2631 lake " -font $font3 -tags item $c create text 25c 15.2c -text "\u2632 hu fire " -font $font3 -tags item $c create text 25c 15.2c -text "\u2633 thunder " -font $font3 -tags item $c create text 25c 15.2c -text "\u2634 feng " -font $font3 -tags item $c create text 25c 15.2c -text "\u2635 shui " -font $font3 -tags item $c create text 25c 15.2c -text "\u2636 shan " -font $font3 -tags item $c create text 25c 15.2c -text "\u2637 mu " -font $font3 -tags item $c create text 25c 17.2c -text "\u2601 " -font $font3 -tags item $c create text 25c 17.2c -text "\u2602 " -font $font3 -tags item $c create text 25c 17.2c -text "\u2603 " -font $font3 -tags item $c create text 25c 17.2c -text "\u2604 " -font $font3 -tags item $c create text 25c 17.2c -text "\u2605 " -font $font3 -tags item $c create text 25c 17.2c -text "\u2606 " -font $font3 -tags item $c create text 25c 17.2c -text "\u2607 " -font $font3 -tags item # horoscope pie plotter # horoscope pie plotter # loaded on tcl wiki # used version tcl8 # 22may2006, goldshell7 # start of deck # canvas_horoscope_pie_chart.tcl -- # goldshell7, tcl wiki script on 20060601 # modified to demonstration script in Expect 5.2 # TCL8 distribution, for Win95 use # canvas_horoscope_pie_chart.tcl -- # # modified to demonstration script in TCL8 distribution # canvas item types. # # SCCS: @(#) items.tcl 1.16 97/03/02 16:25:05 package require Tk set w .items catch {destroy $w} toplevel $w wm title $w "Canvas Horoscope Pie Plot" wm iconname $w "Items" #positionWindow $w set c $w.frame.c frame $w.buttons pack $w.buttons -side bottom -fill x -pady 2m button $w.buttons.dismiss -text Dismiss -command "destroy $w" button $w.buttons.code -text "See Code" -command "showCode $w" pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 frame $w.frame pack $w.frame -side top -fill both -expand yes canvas $c -scrollregion {0c 0c 30c 24c} -width 15c -height 10c \ -relief sunken -borderwidth 2 \ -xscrollcommand "$w.frame.hscroll set" \ -yscrollcommand "$w.frame.vscroll set" scrollbar $w.frame.vscroll -command "$c yview" scrollbar $w.frame.hscroll -orient horiz -command "$c xview" grid $c -in $w.frame \ -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news grid $w.frame.vscroll \ -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news grid $w.frame.hscroll \ -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news grid rowconfig $w.frame 0 -weight 1 -minsize 0 grid columnconfig $w.frame 0 -weight 1 -minsize 0 proc lpick L {lindex $L [expr int(rand()*[llength $L])]} set c3 [lpick {black brown white \ brown3 brown4 red }] set c1 [lpick {red yellow blue purple \ pink green brown black white gray}] set c2 [lpick {red yellow blue purple \ pink green brown black white gray}] set color black set dx 50 set dy 50 set radiusradius 220 set sectors [list ARIES TAURUS CANCER GEMINI LEO VIRGO LIBRA SCORPIO SAGITTARIUS CAPRICORN "AQUARIUS" PISCES ] set percentages [list 8.3 8.3 8.3 8.3 8.3 8.3 8.3 8.3 8.3 8.3 8.3 8.9 ] array set colors [list white white yellow white white yellow white white yellow white white yellow] proc lpick L {lindex $L [expr int(rand()*[llength $L])]} set next 0 set x0 [expr $radiusradius * 1.1] set y0 [expr $radiusradius * 1.1] set dim [list [expr $x0 - $radiusradius] [expr $y0 - $radiusradius] \ [expr $x0 + $radiusradius] [expr $y0 + $radiusradius]] foreach segment $sectors percentage $percentages colour $color { set degrees [expr $percentage * 3.6] eval $c create arc $dim -start $next -extent $degrees -fill yellow; set sectors_mid [expr ($next + $degrees / 2) * acos (0) / 90] $c create text \ [expr $x0 + $radiusradius * cos ($sectors_mid)*6 / 8] \ [expr $y0 - $radiusradius * sin ($sectors_mid)*6 / 8] \ -text $segment set next [expr $next + $degrees] } set font1 {Helvetica 12} set font2 {Helvetica 24 bold} if {[winfo depth $c] > 1} { set blue DeepSkyBlue3 set red red set bisque bisque3 set green SeaGreen3 } else { set blue black set red black set bisque black set green black } # Set up $c create text 2c .2c -text HOROSCOPE -anchor n $c create line 21c 21c 23c 21c 21c 24c 23c 24c -width 2m -fill $blue \ -cap butt -join miter -tags item $c create line 24.67c 21c 24.67c 24c -arrow last -tags item $c create line 26.33c 21c 26.33c 24c -arrow both -tags item $c create line 31c 24c 31.5c 21c 33.5c 21c 34c 24c -smooth on \ -fill $blue -tags item $c create line 21c 5c 21.5c 7c 21.5c 5c 22c 4c -arrow last -smooth on \ -fill brown -width 3 -tags item $c create line 15.5c 11c 19.5c 11.5c 15.5c 14.5c 19.5c 14c -smooth on \ -arrow both -width 3 -tags item catch {$c create line 32c 26c 33.5c 24.5c 36.5c 27.5c 38c 26c \ 36.5c 24.5c 33.5c 27.5c 32c 26c -smooth on -width 3m -cap round \ -stipple @[file join $tk_library demos images gray25.bmp] \ -fill $red -tags item } $c create line 21c 27c 21.75c 25.8c 22.5c 27c 23.25c 25.8c 24c 27c -width .5c \ -cap round -join round -tags item $c create text 25c .2c -text Symbol_Stack -anchor n $c create polygon 21c 1.0c 22.5c 1.75c 24c 1.0c 23.25c 2.5c \ 24c 4.0c 22.5c 3.25c 21c 4.0c 21.75c 2.5c -fill $green \ -outline black -width 4 -tags item $c create oval 21c 9.0c 22c 10.0c -fill $c2 -outline black -width 1m -tags item ; $c create oval 21c 19.5c 24c 22.5c -fill $c2 -outline $red -width 3m -tags item ; $c create oval 21c 19.5c 24c 22.5c -fill $c2 -outline $red -width 3m -tags item ; $c create oval 21c 19.5c 24c 22.5c -fill $c2 -outline $red -width 3m -tags item ; $c create oval 21c 19.5c 24c 22.5c -fill $c2 -outline $red -width 3m -tags item ; button $c.button -text "exit" -command "exit" $c create window 15c 1c -window $c.button -anchor n -tags item entry $c.entry -width 20 -relief sunken $c.entry insert end "Date TBA" $c create window 15c 3c -window $c.entry -anchor n -tags item $c create text 15c 1c -text Button: -anchor s $c create text 15c 3c -text Entry: -anchor s # Set up event bindings for canvas: $c bind item "itemEnter $c" $c bind item "itemLeave $c" bind $c <2> "$c scan mark %x %y" bind $c "$c scan dragto %x %y" bind $c <3> "itemMark $c %x %y" bind $c "itemStroke $c %x %y" bind $c "itemsUnderArea $c" bind $c <1> "itemStartDrag $c %x %y" bind $c "itemDrag $c %x %y" # Utility procedures for highlighting the item under the pointer: proc itemEnter {c} { global restoreCmd if {[winfo depth $c] == 1} { set restoreCmd {} return } set type [$c type current] if {$type == "window"} { set restoreCmd {} return } if {$type == "bitmap"} { set bg [lindex [$c itemconf current -background] 4] set restoreCmd [list $c itemconfig current -background $bg] $c itemconfig current -background SteelBlue2 return } set fill [lindex [$c itemconfig current -fill] 4] if {(($type == "rectangle") || ($type == "oval") || ($type == "arc")) && ($fill == "")} { set outline [lindex [$c itemconfig current -outline] 4] set restoreCmd "$c itemconfig current -outline $outline" $c itemconfig current -outline SteelBlue2 } else { set restoreCmd "$c itemconfig current -fill $fill" $c itemconfig current -fill SteelBlue2 } } proc itemLeave {c} { global restoreCmd eval $restoreCmd } # Utility procedures for stroking out a rectangle and printing what's # underneath the rectangle's area. proc itemMark {c x y} { global areaX1 areaY1 set areaX1 [$c canvasx $x] set areaY1 [$c canvasy $y] $c delete area } proc itemStroke {c x y} { global areaX1 areaY1 areaX2 areaY2 set x [$c canvasx $x] set y [$c canvasy $y] if {($areaX1 != $x) && ($areaY1 != $y)} { $c delete area $c addtag area withtag [$c create rect $areaX1 $areaY1 $x $y \ -outline black] set areaX2 $x set areaY2 $y } } proc itemsUnderArea {c} { global areaX1 areaY1 areaX2 areaY2 set area [$c find withtag area] set items "" foreach i [$c find enclosed $areaX1 $areaY1 $areaX2 $areaY2] { if {[lsearch [$c gettags $i] item] != -1} { lappend items $i } } puts stdout "Items enclosed by area: $items" set items "" foreach i [$c find overlapping $areaX1 $areaY1 $areaX2 $areaY2] { if {[lsearch [$c gettags $i] item] != -1} { lappend items $i } } puts stdout "Items overlapping area: $items" } set areaX1 0 set areaY1 0 set areaX2 0 set areaY2 0 # Utility procedures to support dragging of items. proc itemStartDrag {c x y} { global lastX lastY set lastX [$c canvasx $x] set lastY [$c canvasy $y] } proc itemDrag {c x y} { global lastX lastY set x [$c canvasx $x] set y [$c canvasy $y] $c move current [expr $x-$lastX] [expr $y-$lastY] set lastX $x set lastY $y } # Procedure that's invoked when the button embedded in the canvas # is invoked. proc butPress {w color} { set i [$w create text 25c 18.1c -text "Ouch!!" -fill $color -anchor n] after 500 "$w delete $i" } #end of deck ---- #horoscope pie chart! ---- From [Graffiti]: [goldshell7] if 0 {#test} if 0 {#test} # # horoscope pie plotter # tcl8 set color 0 proc star {x y color args } { global dx dy set c5 [lpick {black brown white gray brown3 brown4}] set c1 [lpick {red yellow blue purple pink green}] set c2 [lpick {red yellow blue purple pink green}] .p create rectangle 60 60 10 10 \ -fill $c1 -tags [concat $args mv] } proc makeplanet {x y color args} { global dx dy set color [lpick {black brown white gray \ brown3 brown4 red yellow blue purple}] set c1 [lpick {red yellow blue purple \ pink green brown black white gray}] set c2 [lpick {red yellow blue purple \ pink green brown black white gray}] .p create oval [expr {$x+2}] [expr {$y+2}] [expr {$x+$dx-3}] [expr {$y+$dy-3}] \ -fill $color -tags [concat $args mv] } proc lpick L {lindex $L [expr int(rand()*[llength $L])]} proc horoscope {win radiusradius sectors percentages color} { canvas $win -width [expr $radiusradius * 2.2] -height [expr $radiusradius * 2.2] set next 0 set x0 [expr $radiusradius * 1.1] set y0 [expr $radiusradius * 1.1] set dim [list [expr $x0 - $radiusradius] [expr $y0 - $radiusradius] \ [expr $x0 + $radiusradius] [expr $y0 + $radiusradius]] foreach segment $sectors percentage $percentages color $color { set degrees [expr $percentage * 3.6] eval $win create arc $dim -start $next -extent $degrees \ -fill $color set sectors_mid [expr ($next + $degrees / 2) * acos (0) / 90] $win create text \ [expr $x0 + $radiusradius * cos ($sectors_mid)*6 / 8] \ [expr $y0 - $radiusradius * sin ($sectors_mid)*6 / 8] \ -text $segment set next [expr $next + $degrees] } return $win } # pack [horoscope .p 220 {ARIES TAURUS CANCER GEMINI LEO VIRGO LIBRA SCORPIO SAGITTARIUS CAPRICORN "AQUARIUS" PISCES } \ {8.3 8.3 8.3 8.3 8.3 8.3 8.3 8.3 8.3 8.3 8.3 8.9 } \ {white yellow white yellow white yellow white yellow white yellow white yellow}] set dx 50 set dy 50 .p bind all <1> {set p(X) [.p canvasx %x]; set p(Y) [.p canvasy %y]} .p bind mv {mv %x %y} proc mv {x y} { global p set x [.p canvasx $x] set y [.p canvasy $y] set id [.p find withtag current] .p move $id [expr {$x-$p(X)}] [expr {$y-$p(Y)}] .p raise $id set p(X) $x; set p(Y) $y } star 20 20 20 args makeplanet 2 2 red makeplanet 2 2 brown makeplanet 2 2 blue makeplanet 2 2 green makeplanet 2 2 black makeplanet 2 2 blue makeplanet 2 2 red makeplanet 2 2 brown makeplanet 2 2 blue makeplanet 2 2 green makeplanet 2 2 black if 0 {#test} if 0 {#test} ---- ---- [Category Toys]