Anonymous user
Fractal tree: Difference between revisions
→{{header|Tcl}}: +Standard ML
(→{{header|Tcl}}: +Standard ML) |
|||
Line 2,895:
tree
</lang>
=={{header|Standard ML}}==
<lang Standard ML>open XWindows;
open Motif;
fun toI {x=x,y=y} = {x=Real.toInt IEEEReal.TO_NEAREST x,y=Real.toInt IEEEReal.TO_NEAREST y} ;
fun drawOnTop win usegc ht hs {x=l1,y=l2} {x=r1,y=r2} =
let
val xy = {x=l1 - ht * (l2-r2) , y = l2 - ht * (r1-l1) }
val zt = {x=r1 - ht * (l2-r2) , y= r2 - ht * (r1-l1) }
val ab = {x= ( (#x xy + #x zt) + hs * (#y zt - #y xy ) )/2.0 , y = ( (#y zt + #y xy) - hs * (#x zt - #x xy )) /2.0 }
in
if abs (l1 - #x xy ) < 0.9 andalso abs (l2 - #y xy ) < 0.9
then XFlush (XtDisplay win)
else
(XFillPolygon (XtWindow win) usegc [ (XPoint o toI) {x=l1,y=l2},
(XPoint o toI ) xy ,
(XPoint o toI ) ab ,
(XPoint o toI ) zt ,
(XPoint o toI ) {x=r1,y=r2} ] Convex CoordModeOrigin ;
drawOnTop win usegc (0.87*ht) hs xy ab ;
drawOnTop win usegc (0.93*ht) hs ab zt )
end ;
val demoWindow = fn () =>
let
val shell = XtAppInitialise "" "tree" "top" [] [ XmNwidth 800, XmNheight 650] ;
val main = XmCreateMainWindow shell "main" [ XmNmappedWhenManaged true ] ;
val canvas = XmCreateDrawingArea main "drawarea" [ XmNwidth 800, XmNheight 650] ;
val usegc = DefaultGC (XtDisplay canvas) ;
in
XtSetCallbacks canvas [ (XmNexposeCallback ,
(fn (w,c,t) => ( drawOnTop canvas usegc 8.0 0.85 {x=385.0,y=645.0} {x=415.0,y=645.0} ; t) ) )
] XmNarmCallback ;
XtManageChild canvas ;
XtManageChild main ;
XtRealizeWidget shell
end ;
demoWindow ();</lang>
=={{header|Tcl}}==
| |||