diff options
| -rw-r--r-- | otherlibs/labltk/Widgets.src | 69 | ||||
| -rw-r--r-- | otherlibs/labltk/builtin/canvas_bind.ml | 5 | ||||
| -rw-r--r-- | otherlibs/labltk/builtin/canvas_bind.mli | 4 | ||||
| -rw-r--r-- | otherlibs/labltk/example/Makefile | 2 | ||||
| -rw-r--r-- | otherlibs/labltk/example/README | 10 | ||||
| -rw-r--r-- | otherlibs/labltk/example/calc.ml | 25 | ||||
| -rw-r--r-- | otherlibs/labltk/example/clock.ml | 72 | ||||
| -rw-r--r-- | otherlibs/labltk/example/demo.ml | 8 | ||||
| -rw-r--r-- | otherlibs/labltk/example/eyes.ml | 15 | ||||
| -rw-r--r-- | otherlibs/labltk/example/tetris.ml | 72 |
10 files changed, 147 insertions, 135 deletions
diff --git a/otherlibs/labltk/Widgets.src b/otherlibs/labltk/Widgets.src index 7cbb200a5..81cbba2f6 100644 --- a/otherlibs/labltk/Widgets.src +++ b/otherlibs/labltk/Widgets.src @@ -272,7 +272,7 @@ subtype option(arc) { Start ["-start"; float] Stipple ["-stipple"; Bitmap] ArcStyle ["-style"; ArcStyle] - Tags ["-tags"; [TagOrId list]] + Tags ["-tags"; [string list]] Width } @@ -399,10 +399,10 @@ widget canvas { option YScrollIncrement ["-yscrollincrement"; int] - function () addtag [widget(canvas); "addtag"; tag: TagOrId; specs: SearchSpec list] # Tag only + function () addtag [widget(canvas); "addtag"; tag: string; specs: SearchSpec list] # Tag only # bbox not fully supported. should be builtin because of ambiguous result # will raise protocol__TkError if no items match TagOrId - function (int,int,int,int) bbox [widget(canvas); "bbox"; tags: TagOrId list] + function (int,int,int,int) bbox [canvas: widget(canvas); "bbox"; TagOrId list] external bind "builtin/canvas_bind" function (float) canvasx [widget(canvas); "canvasx"; x:int; ?spacing:[int]] # function (float) canvasx [widget(canvas); "canvasx"; x:int] @@ -413,43 +413,38 @@ widget canvas { function () configure [widget(canvas); "configure"; option(canvas) list] function (string) configure_get [widget(canvas); "configure"] # TODO: check result - function (float list) coords_get [widget(canvas); "coords"; tag: TagOrId] - function () coords_set [widget(canvas); "coords"; tag: TagOrId; coords: int list] + function (float list) coords_get [canvas: widget(canvas); "coords"; TagOrId] + function () coords_set [canvas: widget(canvas); "coords"; TagOrId; coords: int list] # create variations (see below) - function () dchars [widget(canvas); "dchars"; tag: TagOrId; first: Index(canvas); last: Index(canvas)] - function () delete [widget(canvas); "delete"; tags: TagOrId list] - function () dtag [widget(canvas); "dtag"; tag: TagOrId; tagtodelete: TagOrId] # 2d arg is tag only + function () dchars [canvas: widget(canvas); "dchars"; TagOrId; first: Index(canvas); last: Index(canvas)] + function () delete [canvas: widget(canvas); "delete"; TagOrId list] + function () dtag [canvas: widget(canvas); "dtag"; TagOrId; tag: string] function (TagOrId list) find [widget(canvas); "find"; specs: SearchSpec list] # focus variations function () focus_reset [widget(canvas); "focus"; ""] function (TagOrId) focus_get [widget(canvas); "focus"] - function () focus [widget(canvas); "focus"; tag: TagOrId] - function (TagOrId list) gettags [widget(canvas); "gettags"; tag: TagOrId] - function () icursor [widget(canvas); "icursor"; tag: TagOrId; index: Index(canvas)] - function (int) index [widget(canvas); "index"; tag: TagOrId; index: Index(canvas)] - function () insert [widget(canvas); "insert"; tag: TagOrId; before: Index(canvas); text: string] - function () lower [widget(canvas); "lower"; tag: TagOrId; ?below: [TagOrId]] - # configure variations, see below -# function () lower_below [widget(canvas); "lower"; tag: TagOrId; below: TagOrId] -# function () lower_bot [widget(canvas); "lower"; tag: TagOrId] - function () move [widget(canvas); "move"; tag: TagOrId; x: int; y: int] + function () focus [canvas: widget(canvas); "focus"; TagOrId] + function (string list) gettags [canvas: widget(canvas); "gettags"; TagOrId] + function () icursor [canvas: widget(canvas); "icursor"; TagOrId; index: Index(canvas)] + function (int) index [canvas: widget(canvas); "index"; TagOrId; index: Index(canvas)] + function () insert [canvas: widget(canvas); "insert"; TagOrId; before: Index(canvas); text: string] + function () lower [canvas: widget(canvas); "lower"; TagOrId; ?below: [TagOrId]] + function () move [canvas: widget(canvas); "move"; TagOrId; x: int; y: int] unsafe function (string) postscript [widget(canvas); "postscript"; option(postscript) list] # We use raise... with Module name - function () raise [widget(canvas); "raise"; tag: TagOrId; ?above:[TagOrId]] -# function () raise_above [widget(canvas); "raise"; tag: TagOrId; above: TagOrId] -# function () raise_top [widget(canvas); "raise"; tag: TagOrId] - function () scale [widget(canvas); "scale"; tag: TagOrId; xorigin: int; yorigin: int; xscale: float; yscale: float] + function () raise [canvas: widget(canvas); "raise"; TagOrId; ?above:[TagOrId]] + function () scale [canvas: widget(canvas); "scale"; TagOrId; xorigin: int; yorigin: int; xscale: float; yscale: float] # For scan, use x:int and y:int since common usage is with mouse coordinates function () scan_mark [widget(canvas); "scan"; "mark"; x: int; y: int] function () scan_dragto [widget(canvas); "scan"; "dragto"; x: int; y: int] # select variations - function () select_adjust [widget(canvas); "select"; "adjust"; tag: TagOrId; index: Index(canvas)] + function () select_adjust [canvas: widget(canvas); "select"; "adjust"; TagOrId; index: Index(canvas)] function () select_clear [widget(canvas); "select"; "clear"] - function () select_from [widget(canvas); "select"; "from"; tag: TagOrId; index: Index(canvas)] + function () select_from [canvas: widget(canvas); "select"; "from"; TagOrId; index: Index(canvas)] function (TagOrId) select_item [widget(canvas); "select"; "item"] - function () select_to [widget(canvas); "select"; "to"; tag: TagOrId; index: Index(canvas)] + function () select_to [canvas: widget(canvas); "select"; "to"; TagOrId; index: Index(canvas)] - function (CanvasItem) typeof [widget(canvas); "type"; tag: TagOrId] + function (CanvasItem) typeof [canvas: widget(canvas); "type"; TagOrId] function (float,float) xview_get [widget(canvas); "xview"] function (float,float) yview_get [widget(canvas); "yview"] function () xview [widget(canvas); "xview"; scroll: ScrollValue] @@ -466,17 +461,17 @@ widget canvas { function (TagOrId) create_text [widget(canvas); "create"; "text"; x: int; y: int; option(canvastext) list] function (TagOrId) create_window [widget(canvas); "create"; "window"; x: int; y: int; option(window) list] - function (string) itemconfigure_get [widget(canvas); "itemconfigure"; tag: TagOrId] - - function () configure_arc [widget(canvas); "itemconfigure"; tag: TagOrId; option(arc) list] - function () configure_bitmap [widget(canvas); "itemconfigure"; tag: TagOrId; option(bitmap) list] - function () configure_image [widget(canvas); "itemconfigure"; tag: TagOrId; option(image) list] - function () configure_line [widget(canvas); "itemconfigure"; tag: TagOrId; option(line) list] - function () configure_oval [widget(canvas); "itemconfigure"; tag: TagOrId; option(oval) list] - function () configure_polygon [widget(canvas); "itemconfigure"; tag: TagOrId; option(polygon) list] - function () configure_rectangle [widget(canvas); "itemconfigure"; tag: TagOrId; option(rectangle) list] - function () configure_text [widget(canvas); "itemconfigure"; tag: TagOrId; option(canvastext) list] - function () configure_window [widget(canvas); "itemconfigure"; tag: TagOrId; option(window) list] + function (string) itemconfigure_get [canvas: widget(canvas); "itemconfigure"; TagOrId] + + function () configure_arc [canvas: widget(canvas); "itemconfigure"; TagOrId; option(arc) list] + function () configure_bitmap [canvas: widget(canvas); "itemconfigure"; TagOrId; option(bitmap) list] + function () configure_image [canvas: widget(canvas); "itemconfigure"; TagOrId; option(image) list] + function () configure_line [canvas: widget(canvas); "itemconfigure"; TagOrId; option(line) list] + function () configure_oval [canvas: widget(canvas); "itemconfigure"; TagOrId; option(oval) list] + function () configure_polygon [canvas: widget(canvas); "itemconfigure"; TagOrId; option(polygon) list] + function () configure_rectangle [canvas: widget(canvas); "itemconfigure"; TagOrId; option(rectangle) list] + function () configure_text [canvas: widget(canvas); "itemconfigure"; TagOrId; option(canvastext) list] + function () configure_window [canvas: widget(canvas); "itemconfigure"; TagOrId; option(window) list] } diff --git a/otherlibs/labltk/builtin/canvas_bind.ml b/otherlibs/labltk/builtin/canvas_bind.ml index 3f999b8aa..07392517d 100644 --- a/otherlibs/labltk/builtin/canvas_bind.ml +++ b/otherlibs/labltk/builtin/canvas_bind.ml @@ -1,5 +1,6 @@ -let bind :tag :events ?(:extend = false) ?(:breakable = false) ?(:fields = []) - ?:action widget = +let bind canvas:widget :events + ?(:extend = false) ?(:breakable = false) ?(:fields = []) + ?:action tag = tkCommand [| cCAMLtoTKwidget widget; TkToken "bind"; diff --git a/otherlibs/labltk/builtin/canvas_bind.mli b/otherlibs/labltk/builtin/canvas_bind.mli index ca26aef44..faf4645f6 100644 --- a/otherlibs/labltk/builtin/canvas_bind.mli +++ b/otherlibs/labltk/builtin/canvas_bind.mli @@ -1,4 +1,4 @@ val bind : - tag: tagOrId -> events: event list -> + canvas: canvas widget -> events: event list -> ?extend: bool -> ?breakable: bool -> ?fields: eventField list -> - ?action: (eventInfo -> unit) -> canvas widget -> unit + ?action: (eventInfo -> unit) -> tagOrId -> unit diff --git a/otherlibs/labltk/example/Makefile b/otherlibs/labltk/example/Makefile index ec720bc85..09ff25dde 100644 --- a/otherlibs/labltk/example/Makefile +++ b/otherlibs/labltk/example/Makefile @@ -1,6 +1,6 @@ include ../support/Makefile.common -COMPFLAGS=-I ../lib -I ../support -I $(OTHERS)/unix +COMPFLAGS=-I ../lib -I ../support -I $(OTHERS)/unix -w s all: hello demo eyes calc clock tetris diff --git a/otherlibs/labltk/example/README b/otherlibs/labltk/example/README index b3f473bac..dbb038b50 100644 --- a/otherlibs/labltk/example/README +++ b/otherlibs/labltk/example/README @@ -1,17 +1,17 @@ $Id$ -Some examples for LablTk. They must be compiled with the -modern -option, except for hello.ml and calc.ml. +Some examples for LablTk. +Only demo.ml and tetris.ml really need to be compiled with the -labels option. hello.ml A very simple example of CamlTk hello.tcl The same programme in Tcl/Tk -demo.ml A demonstration using many widget classes +demo.ml A demonstration using many widget classes (use -labels) eyes.ml A "bind" test calc.ml A little calculator -clock.ml An analog clock +clock.ml An analog clock (use unix.cma) -tetris.ml You NEED a game also. Edit it to set a background +tetris.ml You NEED a game also (use -labels) diff --git a/otherlibs/labltk/example/calc.ml b/otherlibs/labltk/example/calc.ml index c9657dfa6..18d0c7936 100644 --- a/otherlibs/labltk/example/calc.ml +++ b/otherlibs/labltk/example/calc.ml @@ -44,17 +44,17 @@ class calc () = object (calc) method set = Textvariable.set variable method get = Textvariable.get variable - method insert s = calc#set to:(calc#get ^ s) + method insert s = calc#set (calc#get ^ s) method get_float = float_of_string (calc#get) method command s = if s <> "" then match s.[0] with '0'..'9' -> - if displaying then (calc#set to:""; displaying <- false); + if displaying then (calc#set ""; displaying <- false); calc#insert s | '.' -> if displaying then - (calc#set to:"0."; displaying <- false) + (calc#set "0."; displaying <- false) else if not (mem_string elt:'.' calc#get) then calc#insert s | '+'|'-'|'*'|'/' as c -> @@ -62,11 +62,11 @@ class calc () = object (calc) begin match op with None -> x <- calc#get_float; - op <- Some (List.assoc key:c ops) + op <- Some (List.assoc c ops) | Some f -> x <- f x (calc#get_float); - op <- Some (List.assoc key:c ops); - calc#set to:(string_of_float x) + op <- Some (List.assoc c ops); + calc#set (string_of_float x) end | '='|'\n'|'\r' -> displaying <- true; @@ -75,7 +75,7 @@ class calc () = object (calc) | Some f -> x <- f x (calc#get_float); op <- None; - calc#set to:(string_of_float x) + calc#set (string_of_float x) end | 'q' -> closeTk (); exit 0 | _ -> () @@ -99,16 +99,17 @@ class calculator :parent = object initializer let buttons = - Array.map fun: - (List.map fun: + Array.map f: + (List.map f: (fun text -> Button.create :text command:(fun () -> calc#command text) frame)) m in Label.configure textvariable:variable label; - calc#set to:"0"; - bind parent events:[`KeyPress] fields:[`Char] - action:(fun ev -> calc#command ev.ev_Char); + calc#set "0"; + bind events:[`KeyPress] fields:[`Char] + action:(fun ev -> calc#command ev.ev_Char) + parent; for i = 0 to Array.length m - 1 do Grid.configure row:i buttons.(i) done; diff --git a/otherlibs/labltk/example/clock.ml b/otherlibs/labltk/example/clock.ml index 37d4542eb..f1fce00db 100644 --- a/otherlibs/labltk/example/clock.ml +++ b/otherlibs/labltk/example/clock.ml @@ -35,7 +35,7 @@ let pi = acos (-1.) class clock :parent = object (self) (* Instance variables *) - val canvas = Canvas.create parent width:100 height:100 + val canvas = Canvas.create width:100 height:100 parent val mutable height = 100 val mutable width = 100 val mutable rflag = -1 @@ -46,74 +46,86 @@ class clock :parent = object (self) initializer (* Create the oval border *) - Canvas.create_oval canvas tags:[`Tag "cadran"] - x1:1 y1:1 x2:(width - 2) y2:(height - 2) - width:3 outline:`Yellow fill:`White; + Canvas.create_oval x1:1 y1:1 x2:(width - 2) y2:(height - 2) + tags:["cadran"] width:3 outline:`Yellow fill:`White + canvas; (* Draw the figures *) self#draw_figures; (* Create the arrows with dummy position *) - Canvas.create_line canvas tags:[`Tag "hours"] fill:`Red - xys:[self#x 0.; self#y 0.; self#x 0.; self#y 0.]; - Canvas.create_line canvas tags:[`Tag "minutes"] fill:`Blue - xys:[self#x 0.; self#y 0.; self#x 0.; self#y 0.]; - Canvas.create_line canvas tags:[`Tag "seconds"] fill:`Black - xys:[self#x 0.; self#y 0.; self#x 0.; self#y 0.]; + Canvas.create_line xys:[self#x 0.; self#y 0.; self#x 0.; self#y 0.] + tags:["hours"] fill:`Red + canvas; + Canvas.create_line xys:[self#x 0.; self#y 0.; self#x 0.; self#y 0.] + tags:["minutes"] fill:`Blue + canvas; + Canvas.create_line xys:[self#x 0.; self#y 0.; self#x 0.; self#y 0.] + tags:["seconds"] fill:`Black + canvas; (* Setup a timer every second *) let rec timer () = self#draw_arrows (Unix.localtime (Unix.time ())); Timer.add ms:1000 callback:timer; () in timer (); (* Redraw when configured (changes size) *) - bind canvas events:[`Configure] + bind events:[`Configure] action:(fun _ -> width <- Winfo.width canvas; height <- Winfo.height canvas; - self#redraw); + self#redraw) + canvas; (* Change direction with right button *) - bind canvas events:[`ButtonPressDetail 3] - action:(fun _ -> rflag <- -rflag; self#redraw); + bind events:[`ButtonPressDetail 3] + action:(fun _ -> rflag <- -rflag; self#redraw) + canvas; (* Pack, expanding in both directions *) - pack [canvas] fill:`Both expand:true + pack fill:`Both expand:true [canvas] (* Redraw everything *) method redraw = - Canvas.coords_set canvas tag:(`Tag "cadran") - coords:[ 1; 1; width - 2; height - 2 ]; + Canvas.coords_set :canvas + coords:[ 1; 1; width - 2; height - 2 ] + (`Tag "cadran"); self#draw_figures; self#draw_arrows (Unix.localtime (Unix.time ())) (* Delete and redraw the figures *) method draw_figures = - Canvas.delete canvas tags:[`Tag "figures"]; + Canvas.delete :canvas [`Tag "figures"]; for i = 1 to 12 do let angle = float (rflag * i - 3) *. pi /. 6. in - Canvas.create_text canvas tags:[`Tag "figures"] + Canvas.create_text + x:(self#x (0.8 *. cos angle)) y:(self#y (0.8 *. sin angle)) + tags:["figures"] text:(string_of_int i) font:"variable" - x:(self#x (0.8 *. cos angle)) - y:(self#y (0.8 *. sin angle)) anchor:`Center + canvas done (* Resize and reposition the arrows *) method draw_arrows tm = - Canvas.configure_line canvas tag:(`Tag "hours") - width:(min width height / 40); + Canvas.configure_line :canvas + width:(min width height / 40) + (`Tag "hours"); let hangle = float (rflag * (tm.Unix.tm_hour * 60 + tm.Unix.tm_min) - 180) *. pi /. 360. in - Canvas.coords_set canvas tag:(`Tag "hours") + Canvas.coords_set :canvas coords:[ self#x 0.; self#y 0.; - self#x (cos hangle /. 2.); self#y (sin hangle /. 2.) ]; - Canvas.configure_line canvas tag:(`Tag "minutes") - width:(min width height / 50); + self#x (cos hangle /. 2.); self#y (sin hangle /. 2.) ] + (`Tag "hours"); + Canvas.configure_line :canvas + width:(min width height / 50) + (`Tag "minutes"); let mangle = float (rflag * tm.Unix.tm_min - 15) *. pi /. 30. in - Canvas.coords_set canvas tag:(`Tag "minutes") + Canvas.coords_set :canvas coords:[ self#x 0.; self#y 0.; - self#x (cos mangle /. 1.5); self#y (sin mangle /. 1.5) ]; + self#x (cos mangle /. 1.5); self#y (sin mangle /. 1.5) ] + (`Tag "minutes"); let sangle = float (rflag * tm.Unix.tm_sec - 15) *. pi /. 30. in - Canvas.coords_set canvas tag:(`Tag "seconds") + Canvas.coords_set :canvas coords:[ self#x 0.; self#y 0.; self#x (cos sangle /. 1.25); self#y (sin sangle /. 1.25) ] + (`Tag "seconds") end (* Initialize the Tcl interpreter *) diff --git a/otherlibs/labltk/example/demo.ml b/otherlibs/labltk/example/demo.ml index 94d686355..70fd5e437 100644 --- a/otherlibs/labltk/example/demo.ml +++ b/otherlibs/labltk/example/demo.ml @@ -80,10 +80,10 @@ pack [bar] fill: `X; (* Radio buttons *) let tv = Textvariable.create () in - Textvariable.set tv to: "One"; + Textvariable.set tv "One"; let radf = Frame.create right in let rads = List.map - fun:(fun t -> Radiobutton.create radf text: t value: t variable: tv) + f:(fun t -> Radiobutton.create radf text: t value: t variable: tv) ["One"; "Two"; "Three"] in (* Scale *) @@ -122,7 +122,7 @@ pack [bar] fill: `X; let defcol = `Color "#dfdfdf" in let selcol = `Color "#ffdfdf" in let buttons = - List.map fun:(fun (w, t, c, a) -> + List.map f:(fun (w, t, c, a) -> let b = Button.create top2 text:t command:c in bind b events: [`Enter] action:(fun _ -> a selcol); bind b events: [`Leave] action:(fun _ -> a defcol); @@ -147,7 +147,7 @@ pack [bar] fill: `X; (fun background -> Message.configure mes :background); coe radf, "Radiobox", (fun () -> ()), (fun background -> - List.iter rads fun:(fun b -> Radiobutton.configure b :background)); + List.iter rads f:(fun b -> Radiobutton.configure b :background)); coe sca, "Scale", (fun () -> ()), (fun background -> Scale.configure sca :background); coe tex, "Text", (fun () -> ()), diff --git a/otherlibs/labltk/example/eyes.ml b/otherlibs/labltk/example/eyes.ml index 021ea700c..eaa335809 100644 --- a/otherlibs/labltk/example/eyes.ml +++ b/otherlibs/labltk/example/eyes.ml @@ -20,20 +20,22 @@ let _ = let top = openTk () in let fw = Frame.create top in pack [fw]; - let c = Canvas.create fw width: 200 height: 200 in + let c = Canvas.create width: 200 height: 200 fw in let create_eye cx cy wx wy ewx ewy bnd = - let o2 = Canvas.create_oval c + let o2 = Canvas.create_oval x1:(cx - wx) y1:(cy - wy) x2:(cx + wx) y2:(cy + wy) outline: `Black width: 7 fill: `White - and o = Canvas.create_oval c + c + and o = Canvas.create_oval x1:(cx - ewx) y1:(cy - ewy) x2:(cx + ewx) y2:(cy + ewy) - fill:`Black in + fill:`Black + c in let curx = ref cx and cury = ref cy in - bind c events:[`Motion] extend:true fields:[`MouseX; `MouseY] + bind events:[`Motion] extend:true fields:[`MouseX; `MouseY] action:(fun e -> let nx, ny = let xdiff = e.ev_MouseX - cx @@ -46,9 +48,10 @@ let _ = else e.ev_MouseX, e.ev_MouseY in - Canvas.move c tag: o x: (nx - !curx) y: (ny - !cury); + Canvas.move canvas:c x: (nx - !curx) y: (ny - !cury) o; curx := nx; cury := ny) + c in create_eye 60 100 30 40 5 6 0.6; create_eye 140 100 30 40 5 6 0.6; diff --git a/otherlibs/labltk/example/tetris.ml b/otherlibs/labltk/example/tetris.ml index 580e7c82b..5e40c7d76 100644 --- a/otherlibs/labltk/example/tetris.ml +++ b/otherlibs/labltk/example/tetris.ml @@ -205,7 +205,7 @@ let line_full = int_of_string "0b1111111111111111" let decode_block dvec = let btoi d = int_of_string ("0b"^d) in - Array.map fun:btoi dvec + Array.map f:btoi dvec class cell t1 t2 t3 :canvas :x :y = object val mutable color = 0 @@ -213,33 +213,33 @@ class cell t1 t2 t3 :canvas :x :y = object method set color:col = if color = col then () else if color <> 0 & col = 0 then begin - Canvas.move canvas tag: t1 + Canvas.move t1 :canvas x:(- block_size * (x + 1) -10 - cell_border * 2) y:(- block_size * (y + 1) -10 - cell_border * 2); - Canvas.move canvas tag: t2 + Canvas.move t2 :canvas x:(- block_size * (x + 1) -10 - cell_border * 2) y:(- block_size * (y + 1) -10 - cell_border * 2); - Canvas.move canvas tag: t3 + Canvas.move t3 :canvas x:(- block_size * (x + 1) -10 - cell_border * 2) y:(- block_size * (y + 1) -10 - cell_border * 2) end else begin - Canvas.configure_rectangle canvas tag: t2 + Canvas.configure_rectangle t2 :canvas fill: colors.(col - 1) outline: colors.(col - 1); - Canvas.configure_rectangle canvas tag: t1 + Canvas.configure_rectangle t1 :canvas fill: `Black outline: `Black; - Canvas.configure_rectangle canvas tag: t3 + Canvas.configure_rectangle t3 :canvas fill: (`Color "light gray") outline: (`Color "light gray"); if color = 0 & col <> 0 then begin - Canvas.move canvas tag: t1 + Canvas.move t1 :canvas x: (block_size * (x+1)+10+ cell_border*2) y: (block_size * (y+1)+10+ cell_border*2); - Canvas.move canvas tag: t2 + Canvas.move t2 :canvas x: (block_size * (x+1)+10+ cell_border*2) y: (block_size * (y+1)+10+ cell_border*2); - Canvas.move canvas tag: t3 + Canvas.move t3 :canvas x: (block_size * (x+1)+10+ cell_border*2) y: (block_size * (y+1)+10+ cell_border*2) end @@ -298,8 +298,8 @@ let init fw = let cells_src = create_base_matrix cols:field_width rows:field_height in let cells = - Array.map cells_src fun: - (Array.map fun: + Array.map cells_src f: + (Array.map f: begin fun (x,y) -> let t1 = Canvas.create_rectangle c @@ -314,16 +314,16 @@ let init fw = x1:(-block_size - 12) y1:(-block_size - 12) x2:(-13) y2:(-13) in - Canvas.raise c tag: t1; - Canvas.raise c tag: t2; - Canvas.lower c tag: t3; + Canvas.raise canvas:c t1; + Canvas.raise canvas:c t2; + Canvas.lower canvas:c t3; new cell canvas:c :x :y t1 t2 t3 end) in let nexts_src = create_base_matrix cols:4 rows:4 in let nexts = - Array.map nexts_src fun: - (Array.map fun: + Array.map nexts_src f: + (Array.map f: begin fun (x,y) -> let t1 = Canvas.create_rectangle nc @@ -338,9 +338,9 @@ let init fw = x1:(-block_size - 12) y1:(-block_size - 12) x2:(-13) y2:(-13) in - Canvas.raise nc tag: t1; - Canvas.raise nc tag: t2; - Canvas.lower nc tag: t3; + Canvas.raise canvas:nc t1; + Canvas.raise canvas:nc t2; + Canvas.lower canvas:nc t3; new cell canvas:nc :x :y t1 t2 t3 end) in @@ -394,8 +394,8 @@ let _ = let line = ref 0 in let level = ref 0 in let time = ref 1000 in - let blocks = List.map fun:(List.map fun:decode_block) blocks in - let field = Array.create len:26 0 in + let blocks = List.map f:(List.map f:decode_block) blocks in + let field = Array.create 26 0 in let widgets, button, cell_field, next_field, scorev, linev, levv, game_over = init fw in let canvas = fst cell_field in @@ -419,13 +419,13 @@ let _ = let draw_falling_block fb = draw_block cell_field color: fb.bcolor - block: (List.nth fb.pattern pos: fb.d) + block: (List.nth fb.pattern fb.d) x: (fb.x - 3) y: (fb.y - 3) and erase_falling_block fb = draw_block cell_field color: 0 - block: (List.nth fb.pattern pos: fb.d) + block: (List.nth fb.pattern fb.d) x: (fb.x - 3) y: (fb.y - 3) in @@ -434,7 +434,7 @@ let _ = for i=0 to 3 do let cur = field.(i + fb.y) in field.(i + fb.y) <- - cur lor ((List.nth fb.pattern pos: fb.d).(i) lsl fb.x) + cur lor ((List.nth fb.pattern fb.d).(i) lsl fb.x) done; for i=0 to 2 do field.(i) <- line_empty @@ -489,18 +489,18 @@ let _ = let draw_next () = draw_block next_field color: (!next+1) - block: (List.hd (List.nth blocks pos: !next)) + block: (List.hd (List.nth blocks !next)) x: 0 y: 0 and erase_next () = draw_block next_field color: 0 - block: (List.hd (List.nth blocks pos: !next)) + block: (List.hd (List.nth blocks !next)) x: 0 y: 0 in let set_nextblock () = current := - { pattern= (List.nth blocks pos: !next); + { pattern= (List.nth blocks !next); bcolor= !next+1; x=6; y= 1; d= 0; alive= true}; erase_next (); @@ -512,7 +512,7 @@ let _ = try for i=0 to 3 do let cur = field.(i + fb.y) in - if cur land ((List.nth fb.pattern pos: fb.d).(i) lsl fb.x) <> 0 + if cur land ((List.nth fb.pattern fb.d).(i) lsl fb.x) <> 0 then raise Done done; false @@ -551,12 +551,12 @@ let _ = x: (block_size * 5 + block_size / 2) y: (block_size * 10 + block_size / 2) anchor: `Center in - Canvas.lower canvas tag: i; + Canvas.lower :canvas i; let img = Imagephoto.create () in fun file -> try Imagephoto.configure img file: file; - Canvas.configure_image canvas tag: i image: img + Canvas.configure_image :canvas i image: img with _ -> begin @@ -573,8 +573,8 @@ let _ = score := !score + l * l; set_message (Printf.sprintf "%d pts" (1 lsl ((l - 1) * 2))) end; - Textvariable.set linev to: (string_of_int !line); - Textvariable.set scorev to: (string_of_int !score); + Textvariable.set linev (string_of_int !line); + Textvariable.set scorev (string_of_int !score); if !line /10 <> pline /10 then (* undate the background every 10 lines. *) @@ -582,10 +582,10 @@ let _ = let num_image = List.length backgrounds - 1 in let n = !line/10 in let n = if n > num_image then num_image else n in - let file = List.nth backgrounds pos: n in + let file = List.nth backgrounds n in image_load file; incr level; - Textvariable.set levv to: (string_of_int !level) + Textvariable.set levv (string_of_int !level) end in @@ -699,7 +699,7 @@ let _ = do_after ms:!time do:loop in (* As an applet, it was required... *) - (* List.iter fun: bind_game widgets; *) + (* List.iter f: bind_game widgets; *) bind_game top; Button.configure button command: game_init; game_init () |