Rosetta Code

Animation: Difference between revisions

Page Discussion

Animation (view source)

Revision as of 00:37, 5 April 2020

403 bytes removed ,  4 years ago
m
→‎{{header|Standard ML}}: shortened
(→‎{{header|Standard ML}}: rem. compilation)
Line 2,766:
<lang Standard ML>open XWindows ;
open Motif ;
 
structure TTd = Thread.Thread ;
structure TTm = Thread.Mutex ;
 
val bannerWindow = fn () =>
Line 2,781:
val main = XmCreateMainWindow shell "main" [ XmNmappedWhenManaged true ] ;
val canvas = XmCreateDrawingArea main "drawarea" [ XmNwidth (#tw dim), XmNheight (#th dim)] ;
val usegc = DefaultGC (XtDisplay canvas) ;
val buf = XCreatePixmap (RootWindow (XtDisplay shell)) (Area{x=0,y=0,w = #tw dim, h= (#th dim) }) 24 ;
Line 2,790:
XCopyArea buf (XtWindow canvas) usegc ( XPoint {x=00,y=0} ) (Area{x= (#tw dim) - pos ,y=0,w = pos, h= #th dim }) ;
XFlush (XtDisplay canvas) ) ;
val finishdirect = fnref (w,s,t)1 =>;▼
val direct = ref (1,1) (* pair needed due to makeshift use of inputCallback *)
fun shift s = ( drawparts ( s mod (#tw dim)) ; Posix.Process.sleep (Time.fromReal 0.1) ; shift ( s + (!direct)) ) ;
val swdir = fn () => direct := Posix.Process.sleep~ (Time.fromReal 0.1!direct) ;
shift (val sfinish + 1= * (#1fn (!direct))) ) ;=>
( if !on <> nothr then if TTd.isActive (toThr (!on)) then TTd.kill (toThr (!on)) else () else () ;▼
val swdir = fn (w,s,t) =>
(TTd.fork( fn () on :=> nothr );
val movimg = fn () => ( finish () ; swdir () ; on := thr (TTd.fork (fn () => shift 0,[]) ) ; t ) ;▼
(TTm.lock mx;
val setimg = fn (w,s,t) direct :=> (if (#2 finish (!direct))* (#1; (!direct)) >drawparts 0 ; t )
then ( ~1 * (#1 (!direct)),#2 (!direct))
else (#1 (!direct),~1 * (#2 (!direct))) );
TTm.unlock mx;
TTd.exit ()), [] ) ;
t )
▲ val finish = fn (w,s,t) =>
▲ ( if !on <> nothr then if TTd.isActive (toThr (!on)) then TTd.kill (toThr (!on)) else () else () ;
on := nothr ;
t) ;
val movimg = fn (w,s,t) =>
( finish (w,s,t) ; swdir (w,s,t) ;
▲ on := thr (TTd.fork (fn () => shift 0,[]) ) ; t ) ;
val setimg = fn (w,s,t) =>
( finish (w,s,t); drawparts 0 ; t )
in
(
XtSetCallbacks canvas [ (XmNexposeCallback , setimg) ,(XmNinputCallback (XmNdestroyCallback, movimg) ,(fn (XmNdestroyCallbackw, c,t)=>(finish();t))) ] XmNarmCallback ;
XtAddEventHandler canvas [ ButtonPressMask ] false (fn (w,ButtonPress a)=> movimg ()|_=> ()) ;
XtManageChild canvas ;▼
XtManageChild main canvas ;
▲ XtManageChild canvas main ;
XtRealizeWidget shell (* add loop here to compile *)
)
Anonymous user
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/116228"