diff: more extras.
Tyson Dowd
trd at cs.mu.OZ.AU
Sun Sep 6 18:54:28 AEST 1998
Hi,
Some more changes for extras.
Don't do anything silly like review the code, it's a hack of a hack
of a hack. Better to compile it and watch the pretty pictures.
===================================================================
Estimated hours taken: 5
Added new example, update top level readme file.
graphics/README:
graphics/samples/maze/globals.m:
graphics/samples/pent/Mmakefile:
graphics/samples/pent/PROBLEM:
graphics/samples/pent/globals.m:
graphics/samples/pent/pent.m:
graphics/samples/pent/place_pent.m:
graphics/samples/pent/shapes.m:
Add a new example for the OpenGL interface.
Index: graphics/README
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/graphics/README,v
retrieving revision 1.1
diff -u -r1.1 README
--- README 1997/07/18 05:03:40 1.1
+++ README 1998/09/06 08:25:41
@@ -5,20 +5,19 @@
If you add missing functionality to any of these modules, let us know,
and we'll see about incorporating enhancements in the main distribution.
-It contains the following modules:
- mtcltk.m - a binding to Tcl/Tk (Tk 4.0 or later)
- mtk.m - a layer on top of mtcltk making it easier to
- create and manipulate Tk widgets.
- mogl.m - a binding to OpenGL
- mglu.m - a binding to the GLU library
- mtogl.m - a binding to the ToGL widget for Tk.
-We have included the Togl-1.2 distribution for convenience. See the
-LICENSE file in the Togl-1.2 directory.
+ mercury_tcltk/ A Mercury binding to Tcl/Tk.
-We have included two sample programs in the samples directory:
- samples/calc - a calculator that uses the Tcl/Tk and Tk modules.
- samples/maze - draws pretty mazes in 3D using OpenGL.
+ mercury_opengl/ A Mercury binding to OpenGL (or the free
+ alternative, Mesa).
+
+ samples/
+ calc/ A calculator that uses mercury_tcltk.
+
+ maze/ Draws pretty mazes in 3D using OpenGL.
+
+ pent/ Places pentominoes on a board in 3D
+ using OpenGL.
We haven't worked out how to prevent the Tcl/Tk library from giving a
tcl prompt when it enters the event loop. If you know how, let us know!
Index: graphics/samples/maze/globals.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/graphics/samples/maze/globals.m,v
retrieving revision 1.2
diff -u -r1.2 globals.m
--- globals.m 1998/09/06 08:22:09 1.2
+++ globals.m 1998/09/06 08:29:03
@@ -1,3 +1,11 @@
+%------------------------------------------------------------------------------%
+% file: globals.m
+% author: conway, June 1997
+%
+% This source file is hereby placed in the public domain. -conway (the author).
+%
+%------------------------------------------------------------------------------%
+
:- module globals.
:- interface.
Index: graphics/samples/pent/Mmakefile
===================================================================
RCS file: Mmakefile
diff -N Mmakefile
--- /dev/null Wed May 28 10:49:58 1997
+++ Mmakefile Tue Sep 1 12:45:30 1998
@@ -0,0 +1,27 @@
+
+# To use static libraries under Linux you need this.
+#MGNUCFLAGS = --pic-reg
+#EXTRA_MLFLAGS = -shared
+
+EXTRA_MLLIBS = -ltk8.0 -ltcl8.0 -lMesaGLU -lMesaGL -L/usr/X11R6/lib -lX11 \
+ -lXmu -lXext -ldl
+
+# Specify the location of the `mercury_tcltk' and `mercury_opengl' packages.
+MERCURY_TCLTK_DIR = ../mercury_tcltk
+MERCURY_OPENGL_DIR = ../mercury_opengl
+
+# Tell mmake to use the `mercury_tcltk' and `mercury_opengl' libraries.
+VPATH = $(MERCURY_OPENGL_DIR):$(MERCURY_TCLTK_DIR):$(MMAKE_VPATH)
+MCFLAGS = -I$(MERCURY_TCLTK_DIR) -I$(MERCURY_OPENGL_DIR) \
+ $(EXTRA_MCFLAGS)
+MLFLAGS = -R$(MERCURY_TCLTK_DIR) -R$(MERCURY_OPENGL_DIR) \
+ $(EXTRA_MLFLAGS) -L$(MERCURY_TCLTK_DIR) \
+ -L$(MERCURY_OPENGL_DIR)
+MLLIBS = -lmercury_opengl -lmercury_tcltk $(EXTRA_MLLIBS)
+C2INITFLAGS = $(MERCURY_TCLTK_DIR)/mercury_tcltk.init \
+ $(MERCURY_OPENGL_DIR)/mercury_opengl.init
+
+default_target : pent
+
+depend : pent.depend
+
Index: graphics/samples/pent/PROBLEM
===================================================================
RCS file: PROBLEM
diff -N PROBLEM
--- /dev/null Wed May 28 10:49:58 1997
+++ PROBLEM Tue Sep 1 12:45:10 1998
@@ -0,0 +1,96 @@
+
+Here's the problem that pent is trying to solve:
+
+
+From rec.games.programmer Mon Aug 11 14:04:47 1997
+Path: cs.mu.OZ.AU!news.unimelb.edu.au!munnari.OZ.AU!news.Hawaii.Edu!news.caldera.com!enews.sgi.com!nntprelay.mathworks.com!europa.clark.net!4.1.16.34!cpk-news-hub1.bbnplanet.com!cam-news-hub1.bbnplanet.com!news.bbnplanet.com!news.idt.net!nntp.farm.idt.net!news
+From: Tenie Remmel <tjr19 at mail.idt.net>
+Newsgroups: comp.os.msdos.programmer,alt.msdos.programmer,rec.games.programmer,sci.math,rec.puzzles
+Subject: Pentominoes Contest!
+Date: Thu, 07 Aug 1997 14:57:41 -0700
+Organization: IDT
+Lines: 83
+Message-ID: <33EA44D5.4090 at mail.idt.net>
+Reply-To: tjr19 at mail.idt.net
+NNTP-Posting-Host: port28.annex4.nwlink.com
+Mime-Version: 1.0
+Content-Type: text/plain; charset=us-ascii
+Content-Transfer-Encoding: 7bit
+X-Mailer: Mozilla 3.01 (Win95; I; 16bit)
+Xref: cs.mu.OZ.AU comp.os.msdos.programmer:87045 rec.games.programmer:123522 sci.math:198623 rec.puzzles:71222
+
+------------------------------------------------------------------------
+Tenie Remmel/PT&T Magazine Pentominoes Contest!
+------------------------------------------------------------------------
+
+This is a contest to write the fastest Pentominoes puzzle solver.
+Pentominoes are the 12 shapes that can be made with 5 squares:
+
+ L N T F Z U
+ | | | | | |
+[] [][] [] [][][] [][] [][] [][][]
+[] [] [] [] [] [][] [] [] []
+[] [] [] [][] [] [] [] [] [][] []
+[] [] [][] [] [] [][] [][] [][][]
+[] [] [][][] [][] [][][] []
+| | | | | |
+I Y V W P X
+
+They can be fit together in a rectangle. The object here is to write
+the fastest program that generates all 2,339 solutions to the puzzle
+of fitting these Pentominoes into a 6 by 10 rectangle.
+
+We have a program that does this in about 5 minutes on the main test
+machine (a Pentium/90 w/o MMX). We suspect that it may be possible to
+do it in 20-30 seconds with a more sophisticated algorithm.
+
+Note that a simple program that uses piece recursion (place the I-piece
+somewhere, then the L-piece, etc, etc.) tends to run about a factor of
+50-200 slower than a simple program that uses position recursion (cover
+the first square with something, then cover the next empty square with
+something, etc, etc.).
+
+Rules:
+
+ All entries must include source (MASM/TASM/NASM/A86/TERSE/NEGA for
+ low-level language, Borland C/Microsoft C/Watcom C/Turbo Pascal for
+ high-level language).
+
+ All entries must be submitted either uncompressed or in a .ACB,
+ .ARC, .ARJ, .HAP, .LHA, .LZH, .PAK, .RAR, .UC2, .ZIP, or .ZOO file.
+ Entries must be sent by E-mail; you may use UU, XX, or MIME encoding.
+
+ The deadline is November 1, 1997. This may be extended if not
+ enough interest is generated.
+
+ Cheating by, for example, including the complete solution set in your
+ program, will result in disqualification.
+
+ You will be notified of, and be given a chance to fix, any bugs
+ or other problems with your version.
+
+ By entering this contest you grant PT&T Magazine a non-exclusive
+ license to publish your entry at any time before January 1, 2000.
+
+ This message will be posted every 2 weeks until the contest is over.
+
+ The program which runs fastest on a Pentium 90MHz w/o MMX and an AMD
+ K5/PR100 will be the winner.
+
+ Entries may be submitted by E-mail:
+
+ mailto:tjr19 at mail.idt.net
+
+------------------------------------------------------------------------
+
+Prizes:
+
+ The winner will get a copy of the book 'Polyominoes' by Solomon
+Golomb.
+
+------------------------------------------------------------------------
+
+For more information, E-mail me: mailto:tjr19 at mail.idt.net
+
+
+
Index: graphics/samples/pent/globals.m
===================================================================
RCS file: globals.m
diff -N globals.m
--- /dev/null Wed May 28 10:49:58 1997
+++ globals.m Sun Sep 6 16:57:44 1998
@@ -0,0 +1,81 @@
+%------------------------------------------------------------------------------%
+% file: globals.m
+% author: Tyson Dowd, August 1997 (based on code by Tom Conway)
+%
+% Stores global variables.
+%
+% This source file is hereby placed in the public domain. -Tyson Dowd
+% (the author).
+%
+%------------------------------------------------------------------------------%
+
+:- module globals.
+
+:- interface.
+
+:- import_module io.
+
+:- pred init_globals(io__state, io__state).
+:- mode init_globals(di, uo) is det.
+
+:- pred get_global(string, T, io__state, io__state).
+:- mode get_global(in, out, di, uo) is det.
+
+:- pred set_global(string, T, io__state, io__state).
+:- mode set_global(in, in, di, uo) is det.
+
+:- implementation.
+
+:- import_module list, map, require, string, std_util.
+
+init_globals -->
+ { my_map_init(Map) },
+ { type_to_univ(Map, UMap1) },
+ { unsafe_promise_unique(UMap1, UMap) },
+ io__set_globals(UMap).
+
+get_global(Name, Value) -->
+ io__get_globals(UMap0),
+ (
+ { univ_to_type(UMap0, Map0) }
+ ->
+ (
+ { map__search(Map0, Name, UValue) }
+ ->
+ (
+ { univ_to_type(UValue, Value0) }
+ ->
+ { Value = Value0 }
+ ;
+ { string__format(
+ "globals: value for `%s' has bad type",
+ [s(Name)], Str) },
+ { error(Str) }
+ )
+ ;
+ { string__format("globals: %s not found",
+ [s(Name)], Str) },
+ { error(Str) }
+ )
+ ;
+ { error("globals: global store stuffed up") }
+ ).
+
+set_global(Name, Value) -->
+ io__get_globals(UMap0),
+ (
+ { univ_to_type(UMap0, Map0) }
+ ->
+ { type_to_univ(Value, UValue) },
+ { map__set(Map0, Name, UValue, Map) },
+ { type_to_univ(Map, UMap1) },
+ { unsafe_promise_unique(UMap1, UMap) },
+ io__set_globals(UMap)
+ ;
+ { error("globals: global store stuffed up") }
+ ).
+
+:- pred my_map_init(map(string, univ)::out) is det.
+
+my_map_init(Map) :-
+ map__init(Map).
Index: graphics/samples/pent/pent.m
===================================================================
RCS file: pent.m
diff -N pent.m
--- /dev/null Wed May 28 10:49:58 1997
+++ pent.m Tue Sep 1 12:45:10 1998
@@ -0,0 +1,318 @@
+%------------------------------------------------------------------------------%
+% file: pent.m
+% author: Tyson Dowd, August 1997 (based on code by Tom Conway)
+%
+% pent tries to place pentominoes on a 6x5 grid.
+%
+% This source file is hereby placed in the public domain. -Tyson Dowd
+% (the author).
+%
+%------------------------------------------------------------------------------%
+:- module pent.
+
+%------------------------------------------------------------------------------%
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+%------------------------------------------------------------------------------%
+:- implementation.
+
+:- import_module mtcltk, mogl, mglu, mtogl.
+:- import_module globals.
+:- import_module bool, getopt, map, set, random, require.
+:- import_module char, list, math, string, float, int, std_util.
+:- import_module place_pent.
+
+:- type option
+ ---> height
+ ; width
+ .
+
+%------------------------------------------------------------------------------%
+
+main -->
+ init_globals,
+ % Process the command line options...
+ io__command_line_arguments(Args0),
+ { getopt__process_options(option_ops(short, long, defaults),
+ Args0, _Args, MOpts) },
+ (
+ { MOpts = ok(Opts) },
+ % Create the pentomino boards
+ io__write_string("generating pentominoes...."),
+ io__flush_output,
+ { getopt__lookup_int_option(Opts, width, Width) },
+ { getopt__lookup_int_option(Opts, height, Height) },
+ set_global("Size", float(MaxX)), % XXX
+ set_global("MaxX", MaxX),
+ set_global("MaxY", MaxY),
+
+ { MaxX = Width - 1 },
+ { MaxY = Height - 1 },
+ { initial_board(Board0) },
+ { initial_sqs(MaxX, MaxY, Sqs0) },
+ { initial_pieces(Pieces) },
+
+ { solutions(fill_board(MaxX, MaxY, Sqs0, Pieces, Board0),
+ Boards) },
+
+ io__write_string(" done.\n"),
+ io__flush_output,
+ % enter Tcl/Tk.
+ main(doit(Boards, MaxX, MaxY), ["maze"])
+
+ ;
+ { MOpts = error(Str) },
+ { string__format("usage: maze [-xN] [-yN] [-sN]\nerror: %s\n",
+ [s(Str)], Msg) },
+ io__stderr_stream(StdErr),
+ io__write_string(StdErr, Msg)
+ ).
+
+%------------------------------------------------------------------------------%
+
+ % Main callback from Tcl/Tk.
+
+:- pred doit(list(board), int, int, tcl_interp, io__state, io__state).
+:- mode doit(in, in, in, in, di, uo) is det.
+
+doit([], _, _, _) --> { error("no solutions to draw") }.
+doit([Board | Boards], MaxX, MaxY, Interp) -->
+ % Initialize the Togl widget.
+ mtogl__init(Interp, Res0),
+ { Res0 \= tcl_ok -> error("Mtogl__init failed") ; true },
+ mtogl__create(pent__create(Board, MaxX, MaxY)),
+ mtogl__display(pent__display),
+ mtogl__reshape(pent__reshape),
+
+ set_global("Boards", Boards),
+ set_global("Phi", 0.0),
+ set_global("Theta", 0.0),
+ create_command(Interp, "nextframe", nextframe),
+ % Create a new togl widget
+ eval(Interp, "
+ togl .togl -rgb true -double true -depth true \
+ -privatecmap true -height 300 -width 300
+ pack .togl
+ nextframe
+ ", Res1, Str),
+ { Res1 \= tcl_ok -> error(Str) ; true }.
+
+ % Compute each frame of the display.
+:- pred nextframe(tcl_interp, list(string),
+ tcl_status, string, io__state, io__state).
+:- mode nextframe(in, in, out, out, di, uo) is det.
+
+nextframe(Interp, _Args, tcl_ok, "") -->
+ eval(Interp, "
+ .togl render
+ after 1 nextframe
+ ", Res, Str),
+ { Res \= tcl_ok -> error(Str) ; true }.
+
+%------------------------------------------------------------------------------%
+
+:- pred pent__create(board, int, int, togl, io__state, io__state).
+:- mode pent__create(in, in, in, in, di, uo) is det.
+
+ % Set up everything for the display.
+
+pent__create(_Board, _MaxX, _MaxY, _Togl) -->
+
+ get_global("Size", Size),
+
+ matrix_mode(modelview),
+ push_matrix,
+ load_identity,
+ light(0, position(0.0, 0.0, 0.0, 1.0)),
+ light(0, ambient(0.5, 0.5, 0.0, 1.0)),
+ light(0, diffuse(0.7, 0.7, 0.0, 1.0)),
+ light(0, specular(0.7, 0.7, 0.0, 1.0)),
+ light(1, position(Size, 0.0, Size, 1.0)),
+ light(1, ambient(0.0, 0.0, 0.7, 1.0)),
+ light(1, diffuse(0.8, 0.0, 0.7, 1.0)),
+ light(1, specular(0.0, 0.0, 0.7, 1.0)),
+ pop_matrix,
+ point_size(1.5),
+
+ light_model(light_model_two_side(yes)),
+ light_model(light_model_local_viewer(yes)),
+
+ enable(normalize),
+ enable(lighting),
+ enable(light(0)),
+ enable(light(1)),
+
+ shade_model(smooth),
+ enable(depth_test).
+
+:- pred make_mlist(list(pair(square, piece)), io__state, io__state).
+:- mode make_mlist(in, di, uo) is det.
+
+make_mlist([]) --> [].
+make_mlist([Pos - Piece |Rest]) -->
+
+ { X = sq_x(Pos) },
+ { Y = sq_y(Pos) },
+
+ { Xf = float(X) },
+ { Zf = float(Y) },
+
+ (
+ { not Piece = e }
+ ->
+ push_matrix,
+ translate(Xf, 0.0, Zf),
+ set_colour_of_piece(Piece),
+ draw_cube,
+ pop_matrix
+ ;
+ []
+ ),
+ make_mlist(Rest).
+
+:- pred set_colour_of_piece(piece::in, io__state::di, io__state::uo) is det.
+
+set_colour_of_piece(i) --> material(front, specular(0.6, 0.0, 1.0, 1.0)).
+set_colour_of_piece(y) --> material(front, specular(0.8, 0.4, 0.8, 1.0)).
+set_colour_of_piece(l) --> material(front, specular(0.8, 0.6, 1.0, 1.0)).
+set_colour_of_piece(n) --> material(front, specular(0.6, 0.4, 1.0, 1.0)).
+set_colour_of_piece(t) --> material(front, specular(0.4, 0.2, 1.0, 1.0)).
+set_colour_of_piece(v) --> material(front, specular(0.6, 0.8, 1.0, 1.0)).
+set_colour_of_piece(f) --> material(front, specular(0.8, 0.6, 0.8, 1.0)).
+set_colour_of_piece(w) --> material(front, specular(0.0, 0.6, 0.6, 1.0)).
+set_colour_of_piece(z) --> material(front, specular(0.6, 0.8, 0.8, 1.0)).
+set_colour_of_piece(p) --> material(front, specular(0.0, 0.4, 0.6, 1.0)).
+set_colour_of_piece(u) --> material(front, specular(0.6, 0.0, 0.8, 1.0)).
+set_colour_of_piece(x) --> material(front, specular(0.0, 0.4, 1.0, 1.0)).
+set_colour_of_piece(e) --> material(front, specular(0.4, 0.0, 0.4, 1.0)).
+
+:- pred draw_cube(io__state::di, io__state::uo) is det.
+
+draw_cube -->
+ { Left = 0.10 },
+ { Right = 0.90 },
+ material(front, ambient(0.0, 0.0, 0.0, 1.0)),
+ material(front, diffuse(0.0, 0.0, 0.0, 1.0)),
+ material(front, emission(0.0, 0.0, 0.0, 1.0)),
+ begin(quads),
+ vertex3(Left, Left, Left),
+ vertex3(Left, Right, Left),
+ vertex3(Right, Right, Left),
+ vertex3(Right, Left, Left),
+
+ vertex3(Left, Left, Right),
+ vertex3(Left, Right, Right),
+ vertex3(Right, Right, Right),
+ vertex3(Right, Left, Right),
+
+ vertex3(Left, Left, Left),
+ vertex3(Left, Left, Right),
+ vertex3(Right, Left, Right),
+ vertex3(Right, Left, Left),
+
+ vertex3(Left, Right, Left),
+ vertex3(Left, Right, Right),
+ vertex3(Right, Right, Right),
+ vertex3(Right, Right, Left),
+
+ vertex3(Left, Left, Left),
+ vertex3(Left, Left, Right),
+ vertex3(Left, Right, Right),
+ vertex3(Left, Right, Left),
+
+ vertex3(Right, Left, Left),
+ vertex3(Right, Left, Right),
+ vertex3(Right, Right, Right),
+ vertex3(Right, Right, Left),
+ end.
+
+
+ % The stuff that happens for each frame.
+
+:- pred pent__display(togl, io__state, io__state).
+:- mode pent__display(in, di, uo) is det.
+
+pent__display(Togl) -->
+
+ clear_color(0.0, 0.0, 0.0, 0.0),
+ clear([color, depth]),
+
+ draw_maze,
+
+ mtogl__swap_buffers(Togl).
+
+ % The stuff that happens if we resize the togl widget.
+
+:- pred pent__reshape(togl, io__state, io__state).
+:- mode pent__reshape(in, di, uo) is det.
+
+pent__reshape(_Togl) -->
+ matrix_mode(projection),
+ load_identity,
+ perspective(55.0, 1.0, 0.1, 10000.0),
+ matrix_mode(modelview).
+
+%------------------------------------------------------------------------------%
+
+:- pred draw_maze(io__state, io__state).
+:- mode draw_maze(di, uo) is det.
+
+draw_maze -->
+ load_identity,
+
+ % Set the viewpoint
+ get_global("Size", Size),
+ get_global("Phi", Phi),
+ get_global("Theta", Theta),
+ get_global("Boards", Boards0),
+ { R = 1.5 * Size },
+ { Y = R * sin(Theta) },
+ { Q = R * cos(Theta) },
+ { X = Q * cos(Phi) + 0.5*Size },
+ { Z = Q * sin(Phi) + 0.5*Size },
+ look_at(X, Y, Z, 0.5*Size, 0.0, 0.5*Size, 0.0, 0.0, 1.0),
+
+ ( { Boards0 = [Board | Boards] } ->
+ new_list(7, compile),
+ make_mlist(Board),
+ end_list,
+ set_global("Boards", Boards)
+ ;
+ { error("no more boards") }
+ ),
+
+ call_list(7),
+
+ % Turn the thing
+ set_global("Phi", Phi+0.005),
+ set_global("Theta", Theta+0.006).
+
+%------------------------------------------------------------------------------%
+
+:- pred short(char, option).
+:- mode short(in, out) is semidet.
+
+short('x', width).
+short('y', height).
+
+:- pred long(string, option).
+:- mode long(in, out) is semidet.
+
+long("width", width).
+long("height", height).
+
+:- pred defaults(option, option_data).
+:- mode defaults(out, out) is nondet.
+
+defaults(Option, Value) :-
+ semidet_succeed, defaults0(Option, Value).
+
+:- pred defaults0(option, option_data).
+:- mode defaults0(out, out) is multi.
+
+defaults0(width, int(5)).
+defaults0(height, int(5)).
Index: graphics/samples/pent/place_pent.m
===================================================================
RCS file: place_pent.m
diff -N place_pent.m
--- /dev/null Wed May 28 10:49:58 1997
+++ place_pent.m Tue Sep 1 12:45:10 1998
@@ -0,0 +1,183 @@
+%------------------------------------------------------------------------------%
+% file: place_pent.m
+% author: Tyson Dowd, August 1997
+%
+% Place pentominoes on the board.
+%
+% This source file is hereby placed in the public domain. -Tyson Dowd
+% (the author).
+%
+%------------------------------------------------------------------------------%
+
+:- module place_pent.
+
+:- interface.
+
+:- import_module list, std_util, io.
+
+%--------------------------------------------------------------------------
+ % The pieces - 'e' is for empty.
+:- type piece ---> i ; l ; y ; n ; t ; v ; f ; w ; z ; p ; u ; x ; e.
+
+:- type piece_descriptor == list(square).
+
+:- type square == int.
+
+:- type board == list(pair(square, piece)).
+
+:- type squares == list(square).
+%--------------------------------------------------------------------------
+
+:- pred fill_board(int::in, int::in, squares::in, list(piece)::in,
+ board::in, board::out) is nondet.
+
+:- pred initial_board(board::out) is det.
+
+:- pred initial_sqs(int::in, int::in, squares::out) is det.
+
+:- pred initial_pieces(list(piece)::out) is det.
+
+:- pred write_board(int::in, int::in, board::in, io__state::di,
+ io__state::uo) is det.
+
+:- func make_sq(int::in, int::in) = (square::out) is det.
+:- func sq_x(square::in) = (int::out) is det.
+:- func sq_y(square::in) = (int::out) is det.
+
+%--------------------------------------------------------------------------
+
+:- implementation.
+
+:- import_module std_util, list, int, assoc_list, require.
+:- import_module shapes.
+
+fill_board(MaxX, MaxY, EmptySqs0, Pieces, Board0, Board) :-
+ fill_board_2(MaxX, MaxY, EmptySqs0, Pieces, Board0, Board).
+
+:- pred fill_board_2(int::in, int::in, squares::in,
+ list(piece)::in, board::in, board::out) is nondet.
+
+fill_board_2(_, _, _, _, Board, Board). % Comment out this to just see
+ % solutions.
+fill_board_2(MaxX, MaxY, [Sq0 | EmptySqs0], Pieces0, Board0, Board) :-
+ place_piece(Sq0, MaxX, MaxY, [Sq0 | EmptySqs0], EmptySqs1,
+ Pieces0, Pieces1, Board0,
+ Board1),
+ fill_board_2(MaxX, MaxY, EmptySqs1, Pieces1, Board1, Board).
+
+
+ % Since we only use the uppermost, leftmost point, the
+ % Y value will always be zero, so you don't have to
+ % translate Y as much.
+:- pred place_piece(int::in, int::in, int::in, squares::in, squares::out,
+ list(piece)::in, list(piece)::out, board::in, board::out) is nondet.
+
+place_piece(Sq0, MaxX, MaxY, EmptySqs0, EmptySqs, Pieces0, Pieces,
+ Board0, Board) :-
+ list__delete(Pieces0, Piece, Pieces),
+ get_piece(Piece, PieceDesc),
+ PieceDesc = [ PointSq | _ ],
+ Sq1 = translate_sq(Sq0, 0 -(sq_x(PointSq)), 0),
+ place(Piece, PieceDesc, MaxX, MaxY, Sq1, EmptySqs0,
+ EmptySqs, Board0, Board).
+
+:- pred place(piece::in, piece_descriptor::in, int::in, int::in, square::in,
+ squares::in, squares::out, board::in, board::out) is semidet.
+
+place(_Piece, [], _, _, _, EmptySqs, EmptySqs, Board, Board).
+place(Piece, [Sq1 | Rest], MaxX, MaxY, Sq0, EmptySqs0,
+ EmptySqs, Board0, Board) :-
+
+ Sq = translate_sq(Sq0, Sq1),
+
+ sq_x(Sq) >= 0,
+% sq_y(Sq) >= 0, % (don't need to check this, actually)
+ sq_x(Sq) =< MaxX,
+ sq_y(Sq) =< MaxY,
+ Board1 = [Sq - Piece | Board0],
+ list__delete_first(EmptySqs0, Sq, EmptySqs1),
+ place(Piece, Rest, MaxX, MaxY, Sq0, EmptySqs1, EmptySqs,
+ Board1, Board).
+
+make_sq(X, Y) = Sq :-
+ ShiftY = Y << 16,
+ Sq = ShiftY + X.
+
+sq_x(Sq) = Sq /\ ((1 << 16) - 1).
+
+sq_y(Sq) = Sq >> 16.
+
+:- func translate_sq(square::in, int::in, int::in) = (square::out) is det.
+translate_sq(Sq0, X, Y) = Sq :-
+ ShiftY = Y << 16,
+ Sq = ShiftY + Sq0 + X.
+
+:- func translate_sq(square::in, square::in) = (square::out) is det.
+translate_sq(Sq0, Sq1) = Sq0 + Sq1.
+
+initial_pieces([f,i,l,n,p,t,u,v,w,x,y,z]).
+
+initial_board([]).
+
+initial_sqs(MaxX, MaxY, Sqs) :-
+ Generator = lambda([Sq::out] is nondet, (
+ between(0, MaxX, X),
+ between(0, MaxY, Y),
+ Sq = make_sq(X, Y))),
+ solutions(Generator, Sqs).
+
+:- pred between(int, int, int).
+:- mode between(in, in, out) is nondet.
+
+between(Min, Max, I) :-
+ Min =< Max,
+ (
+ I = Min
+ ;
+ Min1 is Min + 1,
+ between(Min1, Max, I)
+ ).
+
+
+
+ % The Board must be sorted in advance.
+write_board(MaxX, MaxY, Board) -->
+ { list__sort(Board, SortedBoard) },
+ write_board_rows(0, MaxX, MaxY, SortedBoard, _).
+
+:- pred write_board_rows(int::in, int::in, int::in, board::in, board::out,
+ io__state::di, io__state::uo) is det.
+write_board_rows(Y, MaxX, MaxY, Board0, Board) -->
+ (
+ { Y =< MaxY }
+ ->
+ write_board_row(0, Y, MaxX, Board0, Board1),
+ io__write_string("\n"),
+ write_board_rows(Y + 1, MaxX, MaxY, Board1, Board)
+ ;
+ { Board = Board0 },
+ io__write_string("\n")
+ ).
+
+
+:- pred write_board_row(int::in, int::in, int::in, board::in, board::out,
+ io__state::di, io__state::uo) is det.
+write_board_row(X, Y, MaxX, Board0, Board) -->
+ (
+ { X =< MaxX }
+ ->
+ {
+ Board0 = [make_sq(X, Y) - Elem0 | Board1]
+ ->
+ Elem = Elem0,
+ Board2 = Board1
+ ;
+ Elem = e,
+ Board2 = Board0
+ },
+ io__write(Elem),
+ write_board_row(X + 1, Y, MaxX, Board2, Board)
+ ;
+ { Board = Board0 }
+ ).
+
Index: graphics/samples/pent/shapes.m
===================================================================
RCS file: shapes.m
diff -N shapes.m
--- /dev/null Wed May 28 10:49:58 1997
+++ shapes.m Tue Sep 1 12:45:10 1998
@@ -0,0 +1,94 @@
+%------------------------------------------------------------------------------%
+% file: shapes.m
+% author: Tyson Dowd, August 1997
+%
+% Stores that shapes.
+%
+% This source file is hereby placed in the public domain. -Tyson Dowd
+% (the author).
+%
+%------------------------------------------------------------------------------%
+
+:- module shapes.
+
+:- interface.
+
+:- import_module place_pent.
+
+:- pred get_piece(piece, piece_descriptor).
+:- mode get_piece(in, out) is multidet.
+
+:- implementation.
+
+:- import_module require, list, std_util.
+
+% L N T F Z U
+% | | | | | |
+% [] [][] [] [][][] [][] [][] [][][]
+% [] [] [] [] [] [][] [] [] []
+% [] [] [] [][] [] [] [] [] [][] []
+% [] [] [][] [] [] [][] [][] [][][]
+% [] [] [][][] [][] [][][] []
+% | | | | | |
+% I Y V W P X
+
+get_piece(i, [0, 1, 2, 3, 4]).
+get_piece(i, [0, 65536, 131072, 196608, 262144]).
+get_piece(l, [0, 1, 2, 3, 65536]).
+get_piece(l, [0, 1, 2, 3, 65539]).
+get_piece(l, [0, 1, 65536, 131072, 196608]).
+get_piece(l, [0, 1, 65537, 131073, 196609]).
+get_piece(l, [0, 65536, 65537, 65538, 65539]).
+get_piece(l, [0, 65536, 131072, 196608, 196609]).
+get_piece(l, [1, 65537, 131073, 196608, 196609]).
+get_piece(l, [3, 65536, 65537, 65538, 65539]).
+get_piece(y, [0, 1, 2, 3, 65537]).
+get_piece(y, [0, 1, 2, 3, 65538]).
+get_piece(y, [0, 65536, 65537, 131072, 196608]).
+get_piece(y, [0, 65536, 131072, 131073, 196608]).
+get_piece(y, [1, 65536, 65537, 65538, 65539]).
+get_piece(y, [1, 65536, 65537, 131073, 196609]).
+get_piece(y, [1, 65537, 131072, 131073, 196609]).
+get_piece(y, [2, 65536, 65537, 65538, 65539]).
+get_piece(n, [0, 1, 2, 65538, 65539]).
+get_piece(n, [0, 1, 65537, 65538, 65539]).
+get_piece(n, [0, 65536, 65537, 131073, 196609]).
+get_piece(n, [0, 65536, 131072, 131073, 196609]).
+get_piece(n, [1, 2, 3, 65536, 65537]).
+get_piece(n, [1, 65536, 65537, 131072, 196608]).
+get_piece(n, [1, 65537, 131072, 131073, 196608]).
+get_piece(n, [2, 3, 65536, 65537, 65538]).
+get_piece(t, [0, 1, 2, 65537, 131073]).
+get_piece(t, [0, 65536, 65537, 65538, 131072]).
+get_piece(t, [1, 65537, 131072, 131073, 131074]).
+get_piece(t, [2, 65536, 65537, 65538, 131074]).
+get_piece(v, [0, 1, 2, 65536, 131072]).
+get_piece(v, [0, 1, 2, 65538, 131074]).
+get_piece(v, [0, 65536, 131072, 131073, 131074]).
+get_piece(v, [2, 65538, 131072, 131073, 131074]).
+get_piece(f, [0, 65536, 65537, 65538, 131073]).
+get_piece(f, [1, 65537, 65538, 131072, 131073]).
+get_piece(w, [0, 1, 65537, 65538, 131074]).
+get_piece(w, [0, 65536, 65537, 131073, 131074]).
+get_piece(w, [1, 2, 65536, 65537, 131072]).
+get_piece(w, [2, 65537, 65538, 131072, 131073]).
+get_piece(z, [0, 1, 65537, 131073, 131074]).
+get_piece(z, [0, 65536, 65537, 65538, 131074]).
+get_piece(z, [1, 2, 65537, 131072, 131073]).
+get_piece(z, [2, 65536, 65537, 65538, 131072]).
+get_piece(p, [0, 1, 2, 65536, 65537]).
+get_piece(p, [0, 1, 2, 65537, 65538]).
+get_piece(p, [0, 1, 65536, 65537, 65538]).
+get_piece(p, [0, 1, 65536, 65537, 131072]).
+get_piece(p, [0, 1, 65536, 65537, 131073]).
+get_piece(p, [0, 65536, 65537, 131072, 131073]).
+get_piece(p, [1, 2, 65536, 65537, 65538]).
+get_piece(p, [1, 65536, 65537, 131072, 131073]).
+get_piece(u, [0, 1, 2, 65536, 65538]).
+get_piece(u, [0, 1, 65536, 131072, 131073]).
+get_piece(u, [0, 1, 65537, 131072, 131073]).
+get_piece(u, [0, 2, 65536, 65537, 65538]).
+get_piece(x, [1, 65536, 65537, 65538, 131073]).
+get_piece(e, _) :-
+ error("tried to lookup piece 'e'").
+
--
Tyson Dowd # There isn't any reason why Linux can't be
# implemented as an enterprise computing solution.
trd at cs.mu.oz.au # Find out what you've been missing while you've
http://www.cs.mu.oz.au/~trd # been rebooting Windows NT. -- InfoWorld, 1998.
More information about the developers
mailing list