diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,340 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,21 @@ + +Hetris 0.1.0 +============ + +A quick guide to building: + +./configure --prefix=/wherever/you/want/it +make +make install + +If you make changes to the code, in particular the imports, you may need +to also run make dep. + + +All of my code is released under the GNU GPL version 2. The files in the +CTAN directory was written by other people and their licences apply. + + +Enjoy! +Ian + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,5 @@ +#!/usr/bin/runhaskell + +import Distribution.Simple + +main = defaultMainWithHooks defaultUserHooks diff --git a/TECH b/TECH new file mode 100644 --- /dev/null +++ b/TECH @@ -0,0 +1,4 @@ + +http://www.opengroup.org/onlinepubs/007908799/cursesix.html +http://www.gnu.org/software/ncurses/ncurses.html + diff --git a/TODO b/TODO new file mode 100644 --- /dev/null +++ b/TODO @@ -0,0 +1,62 @@ + +* initscr error handling (nullPtr) +* stdscr debugging +* [21:23] < ibid> why does it state that literate programming was born in + 1992? it's at least a decade off afaik + < Igloo> I gave the date of Knuth's book (1992) rather than the + paper (1984) as I intended. Maybe 1982 would be a better + date, though +* [21:39] < pesco> Ah, a suggestion: Introduce the Data module in the Plan + chapter along with all the other modules. +* [21:40] < Igloo> On June 27th I had something that used ncurses and the + FFI but didn't really have much code (and no docs). I + must have finished that snapshot on the 16th July +* < pesco> I think it would be good to have a part talk about the actual + process of producing the literal program. + < Igloo> Hmmm, I have my project writeup that does that + < pesco> Project writeup? + < Igloo> Haskell2LaTeX was my undergrad project + < pesco> Oic. + < Igloo> This is more frmo the point of view of the user of the literate + system + < pesco> In that case I'd suggest a reference to it from the Hetris source. + < pesco> s/source/documentation/ + < pesco> Where can I find Haskell2LaTeX if I want to use it myself? + < Igloo> Ah, good point. I need to put it somewhere first though, and + that sort of implies polishing it off :-) +* < pesco> Hm, the type Vector might be kind of misleading, one is tempted + to suspect it to be a pair of Ints. + < Igloo> I don't like it either, but couldn't think of anything better + < pesco> I realize you must have spent some time already looking for a + better name. + < pesco> And it's not wrong in the mathematical sense. But an explicit + mention of the unusual meaning might be a good idea anyway. + < Igloo> *nod* + < pesco> Especially in respect to it being used to represent a position + on a rectangular grid. + < Igloo> Yeah :-) + < pesco> That almost feels as if indeed a 2D-vector would be justified. +* [22:02] < pesco> Why is the clock part of the UI? + < Igloo> Which page are you looking at? + < pesco> 6 + < pesco> I stumbled over the Tick event. + < Igloo> Does it mention the UI on page 6? + < pesco> Not directly. It talks about the Event data type. + < Igloo> I don't understand what you mean, then + < pesco> Page 5 mentions the Event data type serving the purpose of + communicating events from the UI to the Main module. + < Igloo> Timeouts happen in the UI module because the way they are done + is dependent on the particular interface + < pesco> Yes, that's what I would have guessed. + < Igloo> e.g. they use the ncurses "timeout" function in the concrete + module here + < pesco> But it's a system artifact which doesn't become appearent to + the user from common sense. + < pesco> Would be nice to be able to isolate it, but I'm afraid there's + no nice way to do it. + < Igloo> Oh, I see, the UI is mentioned at the bottom of page 5. Hmmm. +* Explicit import lists +* Storable/peek needs to be talked about. +* stdscr can now be used. +* Do error handling properly + diff --git a/hetris.cabal b/hetris.cabal new file mode 100644 --- /dev/null +++ b/hetris.cabal @@ -0,0 +1,26 @@ +name: hetris +version: 0.1 +synopsis: Text Tetris +description: This is a simple reimplementation of Tetris which + uses the Curses interface to run in a terminal. +category: Game +license: GPL +license-file: LICENSE +author: Ian Lynagh +maintainer: Ian Lynagh +homepage: http://web.comlab.ox.ac.uk/oucl/work/ian.lynagh/Hetris/ + +build-depends: base>3, random, array, old-time +build-type: Simple +data-files: README, TECH, TODO +tested-with: GHC==6.8.2 + +executable: hetris +main-is: Hetris.lhs +hs-source-dirs: src +other-modules: Board, Data, Input, Output, Pieces, UI, Curses +c-sources: wrap.c +extra-libraries: curses + +ghc-options: -O2 -Wall -optl-Wl,-s +ghc-prof-options: -prof -auto-all diff --git a/src/Board.lhs b/src/Board.lhs new file mode 100644 --- /dev/null +++ b/src/Board.lhs @@ -0,0 +1,345 @@ +% vim: set tw=72: + +% Part of Hetris + +\section{Board: Concrete implementation} + +Again, and as always, the header is the same as that of the abstract specification: + +\begin{code} +module Board (Board, create_board, get_changes, can_down, next_piece) where + +import Data +import Pieces +\end{code} + +The concrete implementation we will use here will be based around +Haskell's \hstype{Array} type. This will allow us to write clear, simple +code to get and overwrite the state of a board. We thus also need to +include the \hsmodule{Array} module. + +\begin{code} +import Data.Array +\end{code} + +In this simplified variant of the game each square of the board either +contains a block or it doesn't; therefore we can use a \hstype{Bool} to +represent whether a square has a block in it or not. The playing area is +then represented by an array of these, indexed by 2-d coordinates of +\hstype{Vector}s. The actual \hstype{Board} type also keeps track of the +current active piece as well as its coordinates. In both cases the $x$ +coordinate is the first \hstype{Vector} and $(0, 0)$ is the upper left +corner as usual. + +\begin{code} +type Block = Bool +type PlayingArea = Array (Vector, Vector) Block +data Board = Board PlayingArea Piece Vector Vector +\end{code} + +We will start the implementation with some utility functions. First we +provide an augmented version of the \hsfunction{blocks} function +exported by the \hsmodule{Pieces} module. This takes the relative block +positions of the piece as returned by \hsfunction{blocks} and adds them +to a position which it also takes as arguments; this gives a list of +absolute positions of blocks. It then filters the list to extract only +the coordinates that are in the range of the playing area array passed; +this means that if a piece is not entirely within the playing area, and +remember that when a piece first appears it may legitimately be off the +top of the playing area, then we won't ask the user interface to draw +blocks outside of the area it has allocated for the playing area. + +Next we define a function \hsfunction{alter\_blocks} that builds on +this. It takes the same arguments and additionally a (curried) function +that takes an $x$ and $y$ coordinate and returns a \hstype{Change}; it +then applies this function to all of the coordinate pairs to produce a +list of \hstype{Change}s. It is no coincidence that the +\hsconstructor{On} and \hsconstructor{Off} constructors have this type, +and we further define functions \hsfunction{on} and \hsfunction{off} +which can be used to create the list of changes needed to turn all the +blocks of a given piece at a given location on and off respectively. + +\begin{code} +restricted_blocks :: PlayingArea -> Piece -> Vector -> Vector -> [(Vector, Vector)] +restricted_blocks a p x y = filter (inRange (bounds a)) [ (x+off_x, y+off_y) | (off_x, off_y) <- blocks p ] + +alter_blocks :: (Vector -> Vector -> Change) + -> PlayingArea -> Piece -> Vector -> Vector + -> [Change] +alter_blocks f a p x y = map (uncurry f) (restricted_blocks a p x y) + +on :: PlayingArea -> Piece -> Vector -> Vector -> [Change] +on = alter_blocks On +off :: PlayingArea -> Piece -> Vector -> Vector -> [Change] +off = alter_blocks Off +\end{code} + +A playing area of width $w$ and height $h$ has squares indexed from +$(0, 0)$ up to $(w-1, h-1)$, and initially none of these contain a +block. The \hsfunction{create\_board} function creates an array with the +appropriate range of indices all containing \hsconstructor{False}. The +first component of the result tuple, the \hstype{Board}, is then built +from this \hstype{Array} and the piece that was passed, which is placed +at the middle of the top row as required by the abstract specification. + +The second component of the result tuple, the list of \hstype{Change}s +the user interface will have to perform, is the result of turning on all +of the blocks used by the piece in its initial position. + +\begin{code} +create_board :: Vector -> Vector -> Piece -> (Board, [Change]) +create_board width height p = (b, on a p (width `div` 2) 0) + where a = listArray ((0,0), (width-1,height-1)) (repeat False) + b = Board a p (width `div` 2) 0 +\end{code} + +The \hsfunction{get\_changes} function performs different tasks +depending on what \hstype{Event} it is passed. Probably the simplest +cases are those where the active piece is just moved one square down, +left or right. In these cases we first check, using functions we will +define shortly, that we can move in the specified direction. If we can +then the changes needed in the user interface are to turn off all the +blocks of the piece where it currently is and then turn on all the +blocks where it moves to. The new \hstype{Board} returned is the same as +the one passed but with the coordinates of the piece suitably updated. +If a \hsconstructor{Tick} event gets this far then it must correspond to +the active piece moving down as it would have been caught earlier if it +signals the next piece. + +\begin{code} +get_changes :: Board -> Event -> (Board, [Change]) +get_changes b@(Board a p x y) MDown + | can_down b = (Board a p x (y + 1), off a p x y ++ on a p x (y + 1)) +get_changes b@(Board a p x y) MLeft + | can_left b = (Board a p (x - 1) y, off a p x y ++ on a p (x - 1) y) +get_changes b@(Board a p x y) MRight + | can_right b = (Board a p (x + 1) y, off a p x y ++ on a p (x + 1) y) +get_changes b Tick = get_changes b MDown +\end{code} + +We can handle \hsconstructor{Drop} by, if we can move the piece down, +first acting as if we had been given a \hsconstructor{MDown} event. We +then take the \hstype{Board} this returns and recursively consider what +happens if we deal with a \hsconstructor{Drop} event on it. We return +the \hstype{Board} returned and both lists of changes concatenated in +order. + +\begin{code} +get_changes b Drop + | can_down b = (b'', cs1 ++ cs2) + where (b', cs1) = get_changes b MDown + (b'', cs2) = get_changes b' Drop +\end{code} + +The code for rotating both left and right is very similar so is best +handled by a generic function; we therefore define \hsfunction{rotate}, +as shown shortly, which we pass a function which manipulates a piece in +the appropriate way, i.e., rotates it left or right, and the +\hstype{Board} we were passed. + +\begin{code} +get_changes b RotL = rotate rot_left b +get_changes b RotR = rotate rot_right b +\end{code} + +%If we get a \hsconstructor{Redraw} event then the board is unchanged. +%There are two parts to the changes we make to the user interface; first +%of all we redraw the information help in the playing area array and then +%we draw the active piece in its current location. The first part updates +%every single square of the playing field, but sometimes with the wrong +%value. The second part corrects any incorrect values. +% +%The first part can be done by taking the list of associations, i.e., +%pairs whose first component is the coordinates of a square and second +%component is a \hstype{Bool} indicating whether or not it is on, and +%mapping a function that generates the appropriate \hstype{Change} for +%such a pair across it. +% +%The second part simply requires us to turn the blocks for the piece on +%as normal. +% +%\begin{code} +%get_changes b@(Board a p x y) Redraw = (b, cs_board ++ cs_piece) +% where cs_board = map (\(xy, is_on) -> uncurry (if is_on then On else Off) xy) (assocs a) +% cs_piece = on a p x y +%\end{code} + +We have handled every case where the board change or changes need to be +generated for the user interface. Therefore for any other event we just +return the same board we were passed and the empty list of changes. + +\begin{code} +get_changes b _ = (b, []) +\end{code} + +We now have some promises to fulfil; let us start with the definition of +\hsfunction{rotate}. We pass it a function that manipulates a piece in +the desired way followed by a \hstype{Board}. If the \hstype{Piece} in +the \hstype{Board} when acted upon by the rotate function `fits', as +defined by a function we, if you'll forgive the nested promise, will +define in just a few lines, then we return the board with the piece in +its new orientation and the changes list turns off the blocks used by +the piece in its previous position and turns on those corresponding to +its new position; all in all it is very similar to the movement events +except the piece also changes. + +If it doesn't fit then we do nothing, as \hsfunction{get\_changes} does. + +\begin{code} +rotate :: (Piece -> Piece) -> Board -> (Board, [Change]) +rotate f (Board a p x y) + | fits b' = (b', off a p x y ++ on a p' x y) + where p' = f p + b' = Board a p' x y +rotate _ b = (b, []) +\end{code} + +As promised, we continue with a definition of \hsfunction{fits}. We take +a \hstype{Board} and, in essence, return a \hstype{Bool} indicating +whether or not the \hstype{Piece} in the \hstype{Board} `fits'; that is +to say, we return \hsconstructor{True} if it doesn't lie on top of any +blocks already in the playing area and it doesn't stick out of the top, +left or right of the playing area. We allow it to stick out of the top. +The astute reader will have noticed that we need to make a yet deeper +nested promise, this time to define \hsfunction{not\_collides} that +checks that the \hstype{Piece} in a \hstype{Board} doesn't overlap any +blocks in the \hstype{Board}'s playing area. + +\begin{code} +fits :: Board -> Bool +fits b@(Board a p x y) = not_collides b + && y + extent_down p <= (snd $ snd $ bounds a) + && x - extent_left p >= (fst $ fst $ bounds a) + && x + extent_right p <= (fst $ snd $ bounds a) +\end{code} + +For this latest promise we take the blocks occupied by the +\hstype{Piece}, restricted to the playing area, and take the value of +the array at each coordinate. If any of them are \hsconstructor{True} +then there is a collision so we return \hsconstructor{False}; otherwise +we return \hsconstructor{True}. + +\begin{code} +not_collides :: Board -> Bool +not_collides (Board a p x y) = not $ or $ map (a!) $ restricted_blocks a p x y +\end{code} + +Having completed this chain of promises we still have one +outstanding---to define the functions to test whether the active piece +can be moved down, left and right. If you've been keeping a close eye on +things then you'll have noticed that one of these is exactly what is +exported to decide which is the applicable behaviour upon getting a +\hsconstructor{Tick} event. + +\begin{code} +can_down, can_left, can_right :: Board -> Bool +can_down (Board a p x y) = fits (Board a p x (y+1)) +can_left (Board a p x y) = fits (Board a p (x-1) y) +can_right (Board a p x y) = fits (Board a p (x+1) y) +\end{code} + +This leaves one exported function remaining---the one that deals with +one piece coming to rest, completed lines being removed and the new +active piece being added in. + +The first step is to update the playing area with the blocks of the +piece that is coming to rest. To do this we use the $(//)$ operator, +zipping the absolute position of the blocks within the playing area with +an infinite list of \hsconstructor{True}s to produce the list of new +associations to add. + +Second we we use the \hsfunction{drop\_complete\_lines}, that (you +guessed it!) we will define next, to produce a tuple of the array after complete +lines have been removed and the changes the user interface will need to +show the user this. + +For the returned board we take this final array and put the piece on +with its key point at the initial square. If it doesn't overlap with any +existing blocks in this position then we wrap it with +\hsconstructor{Just} and return it; otherwise we return +\hsconstructor{Nothing}. The second component of the result, the list of +changes, is composed of the changes needed to drop the complete lines +followed by the changes needed to turn on the blocks of the new active +piece. + +\begin{code} +next_piece :: Board -> Piece -> (Maybe Board, [Change]) +next_piece (Board a p x y) p' = (if not_collides b' then Just b' else Nothing, cs ++ on a'' p' x' y') + where a' = a // zip (restricted_blocks a p x y) (repeat True) + (a'', cs) = drop_complete_lines a' + b' = Board a'' p' x' y' + ((xmin, ymin), (xmax, _)) = bounds a + x' = (xmin + xmax) `div` 2 + y' = ymin +\end{code} + +All that is left is for us to define \hsfunction{drop\_complete\_lines}. +This is really just a header function for +\hsfunction{drop\_complete\_lines'} which does the hard work; all we do +here is to extract the range of $x$ values we will have to check for +each row and the list of $y$ values corresponding to rows to be checked. +We reverse the second list as we want to drop rows from the bottom up. + +\begin{code} +drop_complete_lines :: PlayingArea -> (PlayingArea, [Change]) +drop_complete_lines a = drop_complete_lines' xs (reverse ys) a + where ((xmin, ymin), (xmax, ymax)) = bounds a + xs = range (xmin, xmax) + ys = range (ymin, ymax) +\end{code} + +Then \hsfunction{drop\_complete\_lines'} recurses down the list of rows +to be checked. If the list is empty then trivially the array is +unchanged and the user interface need perform no changes. Otherwise we +first consider the first row in the list. If for each $x$ value the +array has \hsconstructor{True} for this $y$ value then we need to remove +this row; otherwise we continue with a recursive call on the rest of +the list. + +To remove row $y$ we first turn off all of the squares on that row and +then pause for the user to appreciate what has happened. Then we move +all the rows above that row down a row and make the top row empty, +passing the active playing area along and collecting up the changes +lists. Then there is another delay before finally we recursively call +ourselves; note that we need to check row $y$ again as it now contains +what was the row above. + +\begin{code} +drop_complete_lines' :: [Vector] -> [Vector] -> PlayingArea + -> (PlayingArea, [Change]) +drop_complete_lines' _ [] a = (a, []) +drop_complete_lines' xs (y:ys) a = if and [ a!(x, y) | x <- xs ] + then (a''', cs1 ++ [Delay] ++ cs2 ++ cs3 ++ [Delay] ++ cs4) + else drop_complete_lines' xs ys a + where cs1 = [ Off x y | x <- xs ] + (a', cs2) = move_down a xs ys + (a'', cs3) = empty_top_row a' xs + (a''', cs4) = drop_complete_lines' xs (y:ys) a'' +\end{code} + +There are two helper functions left undefined; the first, +\hsfunction{move\_down}, is intended to move a region of squares down one +row. The list of changes needed for this is build by considering each +square in the region and generating an on or off event depending on +whether or not it has a block in it; the event acts on the square below, +i.e., with $y$ value on greater, though. The array is overriden in an +analogous way. + +\begin{code} +move_down :: PlayingArea -> [Vector] -> [Vector] -> (PlayingArea, [Change]) +move_down a xs ys = (a', cs) + where cs = [ (if a!(x, y) then On else Off) x (y + 1) | y <- ys, x <- xs ] + a' = a // [ ((x, y + 1), a!(x, y)) | y <- ys, x <- xs ] +\end{code} + +The final function to define simple sets the top row to be empty of all +blocks. Thus for each $x$ value it sets the corresponding square in the +top row to be off and updates the array similarly. + +\begin{code} +empty_top_row :: PlayingArea -> [Vector] -> (PlayingArea, [Change]) +empty_top_row a xs = (a', cs) + where cs = [ Off x 0 | x <- xs ] + a' = a // [ ((x, 0), False) | x <- xs ] +\end{code} + diff --git a/src/Curses.hsc b/src/Curses.hsc new file mode 100644 --- /dev/null +++ b/src/Curses.hsc @@ -0,0 +1,94 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +-- vim: set syntax=haskell tw=72: + +-- Part of Hetris + +#include + +module Curses (PWindow, + ChType, + cERR, + cKEY_UP, + cKEY_DOWN, + cKEY_LEFT, + cKEY_RIGHT, + cTRUE, + cACS_BLOCK, + initscr, + cbreak, + noecho, + getch, + nonl, + halfdelay, + intrflush, + keypad, + stdscr, + timeout, + curs_set, + mvaddstr, + mvaddch, + addstr, + refresh, + endwin, + getmaxyx, + move, + errI, + errP, + ) where + +import Foreign +import Foreign.C + +data Window = Window +type PWindow = Ptr Window +type NBool = #type bool +type ChType = #type chtype + +cERR :: CInt +cERR = #const ERR +cKEY_UP, cKEY_DOWN, cKEY_LEFT, cKEY_RIGHT :: ChType +cKEY_UP = #const KEY_UP +cKEY_DOWN = #const KEY_DOWN +cKEY_LEFT = #const KEY_LEFT +cKEY_RIGHT = #const KEY_RIGHT +cTRUE :: NBool +cTRUE = #const TRUE +cACS_BLOCK :: ChType +cACS_BLOCK = #const ACS_BLOCK +foreign import ccall unsafe "static curses.h initscr" initscr :: IO PWindow +foreign import ccall unsafe "static curses.h cbreak" cbreak :: IO CInt +foreign import ccall unsafe "static curses.h noecho" noecho :: IO CInt +foreign import ccall unsafe "static curses.h getch" getch :: IO CInt +foreign import ccall unsafe "static curses.h nonl" nonl :: IO CInt +foreign import ccall unsafe "static curses.h halfdelay" halfdelay :: CInt -> IO CInt +foreign import ccall unsafe "static curses.h intrflush" intrflush :: PWindow -> CInt -> IO CInt +foreign import ccall unsafe "static curses.h keypad" keypad :: PWindow -> NBool -> IO CInt +foreign import ccall unsafe "static curses.h &stdscr" stdscr :: Ptr PWindow +foreign import ccall unsafe "static curses.h timeout" timeout :: CInt -> IO () +foreign import ccall unsafe "static curses.h mvaddstr" mvaddstr :: CInt -> CInt -> CString -> IO () +foreign import ccall unsafe "static curses.h mvaddch" mvaddch :: CInt -> CInt -> ChType -> IO () +foreign import ccall unsafe "static curses.h addstr" addstr :: CString -> IO () +foreign import ccall unsafe "static curses.h refresh" refresh :: IO CInt +foreign import ccall unsafe "static curses.h move" move :: CInt -> CInt -> IO CInt +foreign import ccall unsafe "static curses.h curs_set" curs_set :: CInt -> IO CInt +foreign import ccall unsafe "static curses.h endwin" endwin :: IO CInt +foreign import ccall unsafe "static wrap.h w_getmaxyx" wgetmaxyx :: PWindow -> Ptr CInt -> Ptr CInt -> IO () +getmaxyx :: PWindow -> IO (CInt, CInt) +getmaxyx w = alloca $ \py -> + alloca $ \px -> + do wgetmaxyx w py px + y <- peek py + x <- peek px + return (y, x) + +errI :: IO CInt -> IO () +errI f = do r <- f + if r == cERR then do _ <- endwin + error "curses returned an error" + else return () + +errP :: IO (Ptr a) -> IO () +errP f = do p <- f + if p == nullPtr then do _ <- endwin + error "curses returned an error" + else return () diff --git a/src/Data.lhs b/src/Data.lhs new file mode 100644 --- /dev/null +++ b/src/Data.lhs @@ -0,0 +1,152 @@ +% vim: set tw=72: + +% Part of Hetris + +\section{Global datatypes}\label{sec:data} + +There are many points at which we could begin our design of the +program. For example, we could start with the user interface and work +down to the logic of the game, working through the modules as we explore +deeper; another possibility would be to start at the deep logic and work +outwards. However, it seems logical to instead start with what one might +call global datatypes. + +The problem we are trying to solve is how information is passed from one +module to another, either as an argument to a function or as the result +of one. Hiding the details with data abstraction is not the effect we +want here---we are trying to \emph{share} the actual information, not +simply allow other modules to pass it around. + +We could, with a minimum of legerdemain, make any of these types +``owned'' by the most appropriate module. However, we would not be being +honest with ourselves if we did this---these types really belong, +conceptually speaking, to the channels by which modules communicate. + +There are four types that come into this category; as they just require +definitions it does not make seem worth the hassle to split them off +into four tiny modules, so instead we bundle them together into this +single module. The module export information is shown below, followed by +an explanation of each of the four types. + +\begin{code} +module Data (Delay, Vector, Event(..), Change(..)) where +\end{code} + +\subsection{Delay} % XXX Should this be typeset differently? + +At the very heart of the game is a clock ticking away. On each tick +either the active piece is moved down or, if this is not possible, its +component blocks are added to the board and a new piece is made active. +The time between these clock ticks is a policy decision---as far as the +mechanism modules are concerned it need not even necessarily be +constant---so it should be set by the \hsmodule{Main} module. However, +the user interface will need to stop waiting for input after this time +has elapsed, so it needs to know the value too. We therefore make it a +globally known type. We will allow modules using the type to assume that +it is an instance of the \hsclass{Integral} class, counting the time +until the next tick in milliseconds; this means the \hstype{Int} type +should be sufficiently wide to hold all the values we care about. + +\begin{code} +type Delay = Int +\end{code} + +\subsection{Vector} % XXX Should this be typeset differently? + +We need to talk about positions, widths and heights on and of the +playing area all over the place. For example, the policy module +\hsmodule{Main} will need to agree on a size, i.e., width and height, +that the mechanism module \hsmodule{UI} can display. + +For an example of when positions on the playing area need to be passed +around consider what happens when the playing area is altered and the +user interface needs to be updated accordingly. +We could always pass around lists of lists, say, to describe the current state +of the board to the user interface, but it is more efficient to pass +around a list of changes which describe a change of a particular square, +i.e., a position, on the playing area. + +We can use the same type for talking about both positions and the width +and height of the board, so we would like a name that conveys the +impression that its value may be either a length or position; for lack +of a better word we choose \hstype{Vector}. Again it makes sense if we +allow ourselves to assume that the type is an instance of class +\hsclass{Integral}, and again \hstype{Int} should be easily wide enough +for our purposes. + +\begin{code} +type Vector = Int +\end{code} + +A value of 0 refers to the the uppermost or leftmost cell as appropriate +if the \hstype{Vector} is referring to a position. + +\subsection{Event} % XXX Should this be typeset differently? + +The user interface will need to communicate with the policy module to +inform it of events that have happened. We don't want to pass low level +things like what key was pressed around, not least because this +precludes interfaces that don't work in this way, e.g., mouse driven +interfaces. Instead we use an abstract datatype \hstype{Event} where +each constructor corresponds to one of the possible events that can +occur. + +\begin{code} +data Event = RotL + | RotR + | MDown + | MLeft + | MRight + | Drop + | Tick + | Quit + | None + deriving Eq +\end{code} + +We derive Eq as it will allow us to use slightly simpler code later on. + +The meaning of each constructor is as follows: + +\bigskip\noindent +\begin{tabularx}{\hsize}{@{\hspace{2em}}X@{}} +\omit\hsconstructor{RotL}, \hsconstructor{RotR}, \hsconstructor{MDown}, +\hsconstructor{MLeft}, \hsconstructor{MRight}\hfil\smallskip\cr +These correspond to requests to rotate the active piece left or right or move +it down, left or right respectively.\medskip\cr +\omit\hsconstructor{Drop}\hfil\smallskip\cr +Corresponds to a request to drop the piece as far down as possible, +i.e., equivalent to multiple \hsconstructor{MDown} events.\medskip\cr +\omit\hsconstructor{Tick}\hfil\smallskip\cr +This event occurs when the time until the next clock tick +hits zero.\medskip\cr +\omit\hsconstructor{Quit}\hfil\smallskip\cr +The user has requested the program to quit.\medskip\cr +\omit\hsconstructor{None}\hfil\smallskip\cr +This is not a real event; it will be created when, for example, a user +presses a key that is not bound to any real event. Its purpose is simply +to make things more convenient for us in some circumstances.\medskip\cr +\end{tabularx} + +\subsection{Change} % XXX Should this be typeset differently? + +As we briefly mentioned earlier, changes in the playing area need to be +sent to the user interface module. In this simplified specification of +the game there are three things we will want to be able to do. First we +may want to turn a given square on the board on. Second we may want to +turn a square off. Finally, after deleting a complete row we may want to +pause briefly for the user to be able to see what has happened; the +amount of time we should wait is a look-and-feel issue, so we leave it +up to the user interface to decide. These map fairly directly to an +abstract datatype as shown: + +\begin{code} +data Change = On Vector Vector + | Off Vector Vector + | Delay +\end{code} + +The two \hstype{Vector}s used by the \hsconstructor{On} and +\hsconstructor{Off} constructors are $x$ and $y$ coordinates +respectively. + diff --git a/src/Hetris.lhs b/src/Hetris.lhs new file mode 100644 --- /dev/null +++ b/src/Hetris.lhs @@ -0,0 +1,149 @@ +% vim: set tw=72: + +% Part of Hetris + +\section{The heart of the game} + +All the modules dealing with the various pieces of the game are now +complete leaving only the central policy module, the very heart of the +game, left to write. This will serve as \hsmodule{Main} so the header is +essentially already fixed for us. + +\begin{code} +module Main (main) where +\end{code} + +We pull together all of the abstract modules here, so we start by +importing them all. We also import \hsmodule{Random} as we are going to +want to be able to select a random piece to become the new active piece. + +\begin{code} +import Data +import Pieces +import Board +import UI +import System.Random +\end{code} + +In this simplified variant the time between ticks is a constant, but in +a more sophisticated variant it might be a function on factors such as +the score. In either case it makes sense to separate this functionality +out into a function so it can easily be tweaked for good playability. + +\begin{code} +start_delay :: Delay +start_delay = 1000 +\end{code} + +Similarly we separate out the desired width and height. + +\begin{code} +desired_dimensions :: (Vector, Vector) +desired_dimensions = (9, 12) +\end{code} + +We are going to need to be able to get a random new piece both when we +create the \hstype{Board} and when we find we need to add a new piece on +a \hsconstructor{Tick} event. Thus it makes sense to split the code for +doing so off into a separate function. + +We use the random number generator in the \hstype{IO} monad so we return +an \hstype{IO Piece} rather than just a \hstype{Piece}. We pick a random +number in the range of the elements of the \hsfunction{pieces} list, +exported by \hsmodule{Pieces}, and return the element at that position in +the list. + +\begin{code} +get_new_piece :: IO Piece +get_new_piece = randomRIO (0, length pieces - 1) >>= (return . (pieces !!)) +\end{code} + +The \hsfunction{main} function first performs an initialisation phase. +The first task is to initialise the user interface, noting the maximum +width and height board it can cope with. It then gets a new piece and +makes a board, as large as possible while not more than the desired +dimensions, with this as the initial piece. The user interface is then +asked to perform the relevant changes. + +The next phase is performed by a function roughly equivalent to an event +loop. It takes the current representation of the board and the time +until the next tick event---in this case the time between ticks---and +deals with events as they happen. + +When the loop finishes we enter the final phase; we tell the user +interface to shut down and then the program terminates. + +\begin{code} +main :: IO () +main = do (width_ui, height_ui) <- init_ui + let (width_des, height_des) = desired_dimensions + let width = width_ui `min` width_des + height = height_ui `min` height_des + make_board width height + piece <- get_new_piece + let (b, cs) = create_board width height piece + do_changes cs + event_loop b start_delay + shutdown_ui + return () +\end{code} + +\begin{code} +{- +main :: IO () +main = do (width, height) <- init_ui + make_board width height + piece <- get_new_piece + let (b, cs) = create_board width height piece + do_changes cs + event_loop b start_delay + shutdown_ui + return () +-} +\end{code} + +The actual event loop is complicated mainly by special cases. It starts +by getting the next event, passing \hsfunction{get\_event} the time +until the next tick event is due. The event that occurred and the time +that elapsed are returned. If the event was \hsconstructor{Quit} then +the loop terminates. Otherwise more complex handling is needed. + +If the elapsed time is less than the time until the next tick event and +the event wasn't \hsconstructor{Tick} then we subtract the elapsed time +from the time until the next tick event to get the new time until the +next tick and leave the event unchanged. Otherwise we have either +overrun our allocated time (XXX could lose events here) or we have +received a \hsconstructor{Tick} event; in either case we reset the time +until the next tick and continue as if we had received a +\hsconstructor{Tick} event. + +If we are dealing with a \hsconstructor{Tick} event and the current +piece can't be moved down we get a new piece and use the +\hsfunction{next\_piece} function to add it to the board. If this +succeeds then we call ourselves recursively---the next iteration of the +event loop. Otherwise the game is over so we leave the loop. +Otherwise we can just use \hsfunction{get\_changes} and +\hsfunction{do\_changes} to work out and apply the changes needed +respectively. Then we continue with the next iteration of the event +loop. + +\begin{code} +event_loop :: Board -> Delay -> IO () +event_loop b d = do (e, elapsed) <- get_event d + if e == Quit + then return () + else do let (d', e') = if elapsed < d && e /= Tick + then (d - elapsed, e) + else (start_delay, Tick) + if e' == Tick && not (can_down b) + then do piece <- get_new_piece + let (m_b', cs) = next_piece b piece + do_changes cs + case m_b' of + Just b' -> event_loop b' d' + Nothing -> return () + else do let (b', cs) = get_changes b e' + do_changes cs + event_loop b' d' +\end{code} + diff --git a/src/Input.lhs b/src/Input.lhs new file mode 100644 --- /dev/null +++ b/src/Input.lhs @@ -0,0 +1,103 @@ +% vim: set tw=72: + +% Part of Hetris + +\section{Input: Concrete curses implementation} + +For the input side of the user interface we will need a number of +modules. It will come as no surprise that we need to import the +\hsmodule{Curses} and \hsmodule{Data} modules. In order to give types +to all of the functions we will need to be able to refer to the C types +returned by the FFI functions, so \hsmodule{CTypes} also needs to be +imported. The \hsmodule{Time} module is used to measure the elapsed time +and the \hsmodule{Char} module is used to convert between characters and +\hstype{Int}s. + +There is only one input function exported by the \hsmodule{UI} abstract +module, namely \hsfunction{get\_event}, so that is all we export here. + +\begin{code} +module Input (get_event) where + +import Curses +import Data + +import Foreign.C.Types +import System.Time +import Data.Char +\end{code} + +The specification does not allow the delay to be less than or equal to +zero, so we give an error if this is the case. Note that we check the +value of the delay after it has been converted to a \hstype{CInt} as the +conversion process may not preserve the value. + +Otherwise we set the timeout to what was requested, make a note of the +current time, and call \hsfunction{getch} to wait for a key to be +pressed. When this happens, or it times out, we record the time again. +Finally we return a tuple with the event corresponding to the key +pressed (which will be \hsfunction{cERR} if a timeout occurred) and the +time elapsed between the two times recorded; for both components an +additional function is used---these are described below. + +\begin{code} +get_event :: Delay -> IO (Event, Delay) +get_event delay + | delay' <= 0 = error "Input.get_event: delay <= 0" + | otherwise = do timeout delay' + start <- getClockTime + c <- getch + end <- getClockTime + return (key_to_event c, elapsed_time start end) + where delay' = fromIntegral delay +\end{code} + +Some keys, which are represented as \hstype{CInt}s by the +\hstype{Curses} library, have events tupled with them in a lookup list +\hsfunction{key\_events} suitable for use with \hsfunction{lookup}. If +the key we are passed is not mapped to anything then we return the event +\hsconstructor{None} instead. + +\begin{code} +key_to_event :: CInt -> Event +key_to_event k = maybe None id (lookup k key_events) +\end{code} + +The construction of the lookup list is uninteresting. We just built it +piece by piece and concatenate the pieces together. + +\begin{code} +key_events :: [(CInt, Event)] +key_events = [(cERR, Tick)] ++ movement ++ rotations ++ control + where to_event e = map (\c -> (c, e)) + conv_char = fromIntegral . ord + + movement = lefts ++ rights ++ downs ++ drops + rotations = rot_lefts ++ rot_rights + control = quits + + lefts = to_event MLeft [conv_char 'j', fromIntegral cKEY_LEFT] + rights = to_event MRight [conv_char 'l', fromIntegral cKEY_RIGHT] + downs = to_event MDown [conv_char 'k', fromIntegral cKEY_DOWN] + drops = to_event Drop [conv_char ' '] + rot_lefts = to_event RotR [conv_char 'u', fromIntegral cKEY_UP] + rot_rights = to_event RotR [conv_char 'i'] + quits = to_event Quit [conv_char 'q'] +\end{code} + +Sadly Haskell doesn't provide an easy way to measure the time between +two points in time. The best we can get from the standard libraries is a +\hstype{TimeDiff}. We assume that less than a minute passes between the +two times---a reasonable assumption in this context! + +\begin{code} +elapsed_time :: ClockTime -> ClockTime -> Delay +elapsed_time start end = t `max` 0 + where t = case diffClockTimes end start of + (TimeDiff 0 0 0 0 0 secs psecs) -> + let secs' = 1000 * fromIntegral secs + psecs' = fromIntegral (psecs `div` 1000000000) + in secs' + psecs' + td -> error ("Input.elapsed_time: " ++ show td) +\end{code} + diff --git a/src/Output.lhs b/src/Output.lhs new file mode 100644 --- /dev/null +++ b/src/Output.lhs @@ -0,0 +1,144 @@ +% vim: set tw=72: + +% Part of Hetris + +\section{Output: Concrete curses implementation} + +If we were to use a single character for each square of the playing +area, and indeed the rest of the board, then the squares would be +significantly taller than they are wide. To counteract this we will +treat each pair of characters on a line as a single entity as far as +drawing the board is concerned; this will give them a roughly square +appearance. + +The \hsmodule{Output} module is responsible for the other two functions +exported by the \hsmodule{UI} module, and also needs to provide the +concrete implementation of this module with a function giving the +largest size the interface can accommodate. + +Unsurprisingly we import the \hsmodule{Data} module, as well as the +\hsmodule{Curses} module to provide types for the functions. We also use +the \hsmodule{Char} module to convert characters into their numeric +ASCII values. + +XXX Storable + +\begin{code} +module Output (max_size, make_board, do_changes) where + +import Data +import Curses +import Data.Char +import Foreign.Storable +\end{code} + +Continuing our practise of separating constants out of the main code, we +define values representing the minimum amount of white space we require +around the playing area. A border of one empty character around one +solid character, a total width of 2, all the way round is quite +aesthetically pleasing so we go with that. + +\begin{code} +border_width, border_height :: Vector +border_width = 2 +border_height = 2 +\end{code} + +Our first commitment to the outside world is to provide a function that +returns the maximum size of user interface we can draw. We first use the +curses \hsfunction{getmaxyx} function to find the height and width of +the window passed (XXX while this can't use stdscr is getmaxyx really +width and height?). As we are treating characters in pairs along the +horizontal axis we need to divide this width by 2 (rounding down), and +then we use \hsfunction{fromIntegral} to convert the coordinates into +\hstype{CInt}s. Finally we need to subtract twice the appropriate border +sizes from the dimensions, once for the top/left and again for the +bottom/right. Note that width is the first component of the result. + +\begin{code} +max_size :: IO (Vector, Vector) +max_size = do w <- peek stdscr + (height, width) <- getmaxyx w + let width' = fromIntegral (width `div` 2) + height' = fromIntegral height + return (width' - 2 * border_width, + height' - 2 * border_height) +\end{code} + +Our second commitment is to provide a function to allow the user of the +module to draw a new board. We make a list of screen coordinates +comprising the border\footnote{Technically they are not screen +coordinates; the coordinate $(x, y)$ maps to both $(2x, y)$ and +$(2x + 1, y)$ in real screen coordinates} and convert `X' to a +\hstype{ChType} (XXX should be ACS\_BLOCK). then we use the +\hsfunction{write} function to write an `X' to each of these +coordinates. + +\begin{code} +make_board :: Vector -> Vector -> IO () +make_board width height = do let c = fromIntegral $ ord 'X' + mapM_ (flip (uncurry write) c) border + where border = [(x, border_height - 1) | x <- xs] + ++ [(x, border_height + height) | x <- xs] + ++ [(border_width - 1, y) | y <- ys] + ++ [(border_width + width, y) | y <- ys] + xs = [border_width - 1..border_width + width] + ys = [border_height..border_height - 1 + height] +\end{code} + +Our final external commitment is a function that performs a list of +changes to update the screen. To do this we use \hsfunction{mapM\_} with +a function that performs a single change and finish up by calling the +curses \hsfunction{refresh} function to make sure the changes are +reflected on the screen. + +\begin{code} +do_changes :: [Change] -> IO () +do_changes cs = do mapM_ do_change cs + errI refresh + return () +\end{code} + +Performing a single change is a simple case analysis. To turn a square +on we paint a `\#' in it; to turn a square off we paint a blank space in +it. For a delay we set the timeout to 500ms and call \hsfunction{getch}. +This could be cut short by the user pressing a key, but the effort +required to work around this cannot be justified---think of it as a +feature. + +\begin{code} +do_change :: Change -> IO () +-- do_change (On x y) = paint_square x y cACS_BLOCK +do_change (On x y) = paint_square_c x y '#' +do_change (Off x y) = paint_square_c x y ' ' +do_change Delay = do timeout 500 + _ <- getch + return () +\end{code} + +We still have a couple of functions left to tidy up. First let us look +at \hsfunction{write}. This takes an $x$ and $y$ coordinate and a +\hstype{ChType} and writes it at the corresponding pair of screen +coordinates. + +\begin{code} +write :: Vector -> Vector -> ChType -> IO () +write x y c = do mvaddch y' x' c + mvaddch y' (x' + 1) c + where y' = fromIntegral y + x' = fromIntegral $ 2 * x +\end{code} + +The \hsfunction{paint\_square\_c} function is similar; it writes a +\hstype{Char} at given playing area coordinates. The hard work is done +by \hsfunction{paint\_square}, with the harder work being done by +\hsfunction{write}. + +\begin{code} +paint_square_c :: Vector -> Vector -> Char -> IO () +paint_square_c x y c = paint_square x y (fromIntegral $ ord c) + +paint_square :: Vector -> Vector -> ChType -> IO () +paint_square x y c = write (x + border_width) (y + border_height) c +\end{code} + diff --git a/src/Pieces.lhs b/src/Pieces.lhs new file mode 100644 --- /dev/null +++ b/src/Pieces.lhs @@ -0,0 +1,103 @@ +% vim: set tw=72: + +% Part of Hetris + +\section{Pieces: Concrete implementation} + +The header is, as it always is for a concrete implementation of an +abstract module, the same as that of the abstract specification: + +\begin{code} +module Pieces (Piece, blocks, extent_down, extent_left, extent_right, + rot_left, rot_right, pieces) where + +import Data +\end{code} + +Tetris is not a particularly challenging task for today's CPUs, and +the amount of RAM required is not likely to cause a problem on a modern +machine. Our motivation here then is to pick a representation such that +the implementation can be easily understood. + +At the core of a representation is a list of coordinates of blocks +relative to the key square of the piece. We store an infinite list of +these corresponding to the blocks used by a piece after successive left +rotations. + +\begin{code} +newtype Piece = Piece [[(Vector, Vector)]] +\end{code} + +This makes the implementation of \hsfunction{blocks} simple---we just +return the first list. + +\begin{code} +blocks :: Piece -> [(Vector, Vector)] +blocks (Piece xss) = head xss +\end{code} + +The code to calculate the maximum extents is based on the output of +\hsfunction{blocks} in the way hinted at in +Section~\ref{sec:abs_pieces}. + +\begin{code} +extent_down :: Piece -> Vector +extent_down p = maximum $ map snd $ blocks p +extent_left :: Piece -> Vector +extent_left p = negate $ minimum $ map fst $ blocks p +extent_right :: Piece -> Vector +extent_right p = maximum $ map fst $ blocks p +\end{code} + +To rotate a piece left we just remove the first element of the list; the +correctness of this follows from the definition of the list above. +Rotating right is the same as rotating left 3 times so we drop the first +3 elements of the list. + +\begin{code} +rot_left :: Piece -> Piece +rot_left (Piece xss) = Piece (tail xss) +rot_right :: Piece -> Piece +rot_right (Piece xss) = Piece (drop 3 xss) +\end{code} + +The list of pieces is just that---the second part of the name is +intended to be descriptive of the shape of the piece, but this is more +successful in some cases than others. + +\begin{code} +pieces :: [Piece] +pieces = [piece_I, piece_L, piece_J, piece_T, piece_2, piece_5, piece_O] +\end{code} + +We conclude with the actual definitions of the pieces. + +\begin{code} +piece_I, piece_L, piece_J, piece_T, piece_2, piece_5, piece_O :: Piece +piece_I = Piece (cycle [p1, p2]) + where p1 = [(0, -1), (0, 0), (0, 1), (0, 2)] + p2 = [(-1, 0), (0, 0), (1, 0), (2, 0)] +piece_L = Piece (cycle [p1, p2, p3, p4]) + where p1 = [(0, -1), (0, 0), (0, 1), (1, 1)] + p2 = [(-1, 0), (0, 0), (1, 0), (1, -1)] + p3 = [(-1, -1), (0, -1), (0, 0), (0, 1)] + p4 = [(-1, 1), (-1, 0), (0, 0), (1, 0)] +piece_J = Piece (cycle [p1, p2, p3, p4]) + where p1 = [(0, -1), (0, 0), (0, 1), (-1, 1)] + p2 = [(-1, 0), (0, 0), (1, 0), (1, 1)] + p3 = [(1, -1), (0, -1), (0, 0), (0, 1)] + p4 = [(-1, -1), (-1, 0), (0, 0), (1, 0)] +piece_T = Piece (cycle [p1, p2, p3, p4]) + where p1 = [(-1, 0), (0, 0), (1, 0), (0, 1)] + p2 = [(0, -1), (0, 0), (0, 1), (1, 0)] + p3 = [(-1, 0), (0, 0), (1, 0), (0, -1)] + p4 = [(0, -1), (0, 0), (0, 1), (-1, 0)] +piece_2 = Piece (cycle [p1, p2]) + where p1 = [(1, 0), (0, 0), (0, -1), (-1, -1)] + p2 = [(0, 0), (0, -1), (-1, 0), (-1, 1)] +piece_5 = Piece (cycle [p1, p2]) + where p1 = [(-1, 0), (0, 0), (0, -1), (1, -1)] + p2 = [(0, 0), (0, -1), (1, 0), (1, 1)] +piece_O = Piece (repeat [(0, 0), (0, 1), (1, 0), (1, 1)]) +\end{code} + diff --git a/src/UI.lhs b/src/UI.lhs new file mode 100644 --- /dev/null +++ b/src/UI.lhs @@ -0,0 +1,62 @@ +% vim: set tw=72: + +% Part of Hetris + +\section{The user interface module (UI)} + +The user interface is the most obvious case where multiple +implementations are sensible. User interfaces are one of the less well +developed areas in the Haskell community, but the new FFI allows us to +easily and portably define a Haskell interface to curses. We don't show +the actual interface here, but it should be easy to understand from the +C documentation; the \hsmodule{Curses} module exports it. + +While as far as the game is concerned the user interface is a single +idea, the input and output aspects are really completely separate in +curses. We therefore split the functionality off into separate modules +which are both imported by \hsmodule{UI}. The initialisation and +shutdown functions come under neither category so we leave them in the +main module. + +\begin{code} +module UI (init_ui, shutdown_ui, make_board, get_event, do_changes) where + +import Data + +import Curses + +import Input +import Output +\end{code} + +The actual initialisation work is standard curses startup stuff: we +initialise the curses system, enter cbreak mode (disable line buffering +etc) and turn off echoing in common with the vast majority of curses +programs. We also enable the keypad mode so that we can use the arrow +keys to control the movement of the active piece. Finally we ask for the +cursor to be invisible. + +The maximum board size depends on how the board is drawn, and the logic +for that is in the \hsmodule{Output} module. We therefore have that +module export a function that gives this maximum size and we return that +value. + +\begin{code} +init_ui :: IO (Vector, Vector) +init_ui = do w <- initscr + errI $ cbreak + errI $ noecho + errI $ keypad w cTRUE + errI $ curs_set 0 + max_size +\end{code} + +Shutting the interface down is rather simpler---we just call the +curses shutdown function. + +\begin{code} +shutdown_ui :: IO () +shutdown_ui = do _ <- endwin + return () +\end{code} + diff --git a/wrap.c b/wrap.c new file mode 100644 --- /dev/null +++ b/wrap.c @@ -0,0 +1,5 @@ +#include + +void w_getmaxyx(WINDOW *w, int *y, int *x) { + getmaxyx(w, *y, *x); +}