hetris (empty) → 0.1
raw patch · 15 files changed
+1615/−0 lines, 15 filesdep +arraydep +basedep +old-timesetup-changed
Dependencies added: array, base, old-time, random
Files
- LICENSE +340/−0
- README +21/−0
- Setup.hs +5/−0
- TECH +4/−0
- TODO +62/−0
- hetris.cabal +26/−0
- src/Board.lhs +345/−0
- src/Curses.hsc +94/−0
- src/Data.lhs +152/−0
- src/Hetris.lhs +149/−0
- src/Input.lhs +103/−0
- src/Output.lhs +144/−0
- src/Pieces.lhs +103/−0
- src/UI.lhs +62/−0
- wrap.c +5/−0
+ LICENSE view
@@ -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.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ 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.++ <signature of Ty Coon>, 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.
+ README view
@@ -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+
+ Setup.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/runhaskell++import Distribution.Simple++main = defaultMainWithHooks defaultUserHooks
+ TECH view
@@ -0,0 +1,4 @@++http://www.opengroup.org/onlinepubs/007908799/cursesix.html+http://www.gnu.org/software/ncurses/ncurses.html+
+ TODO view
@@ -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+
+ hetris.cabal view
@@ -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 <igloo@earth.li>+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
+ src/Board.lhs view
@@ -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}+
+ src/Curses.hsc view
@@ -0,0 +1,94 @@+{-# LANGUAGE ForeignFunctionInterface #-}+-- vim: set syntax=haskell tw=72:++-- Part of Hetris++#include <curses.h>++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 ()
+ src/Data.lhs view
@@ -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.+
+ src/Hetris.lhs view
@@ -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}+
+ src/Input.lhs view
@@ -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}+
+ src/Output.lhs view
@@ -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}+
+ src/Pieces.lhs view
@@ -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}+
+ src/UI.lhs view
@@ -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}+
+ wrap.c view
@@ -0,0 +1,5 @@+#include <curses.h>++void w_getmaxyx(WINDOW *w, int *y, int *x) {+ getmaxyx(w, *y, *x);+}