home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / gpacks / htetris / htetris.icn < prev    next >
Text File  |  2000-07-29  |  57KB  |  1,784 lines
  1. ############################################################################
  2. #
  3. # File  :   htetris.icn
  4. # Author:   Henrik Sandin
  5. # Date  :   May 3, 1999
  6. #
  7. ############################################################################
  8. #
  9. #   This file is in the public domain.
  10. #
  11. ############################################################################
  12. #
  13. # Implements htetris, which is a version of the game tetris.
  14. # The interface is built using the tool VIB.
  15. # Bricks and the game pane are represented by two dimensional matrices.
  16. # Conceptually, the brick matrices moves on top of the pane matrix.
  17. # At every position, a brick matrix contains information on where on the
  18. # pane matrix it is.
  19. # An element of a matrix correspons to a 20 by 20 pixel square on the
  20. # game pane. The game pane is 200 pixels wide and 600 pixels high, but its
  21. # matrix has 12 colums and 31 rows. The extra row and columns are conceptually
  22. # outside the game pane and serves as boundaries used to determine if a brick
  23. # can move or rotate in some situations.
  24. # An element in the pane matrix has the value 'FILLED' if there is a colored
  25. # square belonging to a brick permanently stuck there. Otherwise it has the
  26. # value 'EMPTY'.
  27. # A brick can not move onto a position on the pane corresponding to an
  28. # element in the pane matrix that has the value 'FILLED'.
  29. #
  30. ############################################################################
  31. #
  32. #  Requires: keysyms.icn, brickdata.icn, matrix.icn, brickio.icn,
  33. #            editor.icn, help.icn
  34. #
  35. ############################################################################
  36. #
  37. #  Links: random, numbers, vsetup
  38. #
  39. ############################################################################
  40.  
  41. link random
  42. link numbers
  43. link vsetup
  44.  
  45. ############################################################################
  46. #
  47. # Global varibles used by both htetris.icn and editor.icn.
  48. #
  49. ############################################################################
  50.  
  51. global htetris_window
  52. global htetris_vidgets
  53.  
  54. ############################################################################
  55. #
  56. # Global varibles used by htetris.icn only.
  57. #
  58. # game_pane  - The game playing area, which is 200 by 600 pixels.
  59. # next_pane  - The pane showing the next brick about to come up.
  60. # anim_pane  - The area where the initial animation is performed.
  61. # score_pane     - The current score area.
  62. # highscore_pane - The highscore area.
  63. # level_pane     - The area showing the current level of difficulty.
  64. #                  The showed level is either the most recently played level
  65. #                  or the most recently picked starting level.
  66. # brick_table      - A table containing the bricks currently in play.
  67. #                    The keys are unique names as strings.
  68. # next_brick       - The next brick to come up in a game.
  69. # current_matrices - List containing the four matrices of the currently
  70. #                    falling brick.
  71. # current_images - List containing the four images of the currently
  72. #                  falling brick.
  73. # pane_matrix - A 12 by 32 matrix representing the game area. There are one
  74. #               extra row (bottom) and two extra columns used as edge markers.
  75. # top_row        - The currently highest (smallest row number) non-empty row
  76. #                  in the pane matrix.
  77. # rows_completed - The number of full rows achieved in the current game.
  78. # flip_offset    - A brick-specific integer which is used to calculate the
  79. #                  new top-left corner position of a brick when it is flipped.
  80. # start_speed - The level-depending speed which the next game is going to
  81. #               start at.
  82. # speed        - The current level-depending speed.
  83. # speed_factor - Integer used to speed up the game on a slow computer.
  84. # score        - Current score.
  85. # highscore    - Highscore so far.
  86. # next_id      - Used to construct id's for added userdefined bricks.
  87. # editor_on    - Flag determining whether the editor was started or not.
  88. # game_on      - Flag determining whether a game is currently going on.
  89. # pause        - Flag determining whether a game is paused or not.
  90. # cheated          - TRUE if the player just cheated. Reset to false after cheat.
  91. # cheating         - TRUE if a cheating brick is currently falling.
  92. # record_highscore - FALSE if the player has cheated during the current game.
  93. # special_keys     - A list of the possible special keys availible as controls.
  94. # current_keys - current keys to control the game.
  95. # root         - The currently active interface root (htetris or editor).
  96. #
  97. ############################################################################
  98.  
  99. global game_pane
  100. global next_pane
  101. global anim_pane
  102. global score_pane
  103. global highscore_pane
  104. global level_pane
  105. global brick_table
  106. global current_matrices
  107. global current_images
  108. global next_brick
  109. global next_id
  110. global pane_matrix
  111. global top_row
  112. global rows_completed
  113. global flip_offset
  114. global start_speed
  115. global speed
  116. global speed_factor
  117. global score
  118. global highscore
  119. global editor_on
  120. global game_on
  121. global pause
  122. global cheated
  123. global cheating
  124. global record_highscore
  125. global special_keys
  126. global current_keys
  127. global root
  128.  
  129. $define MAX_SCORE   999999999 # Defines the maximum score.
  130. $define MIDDLE      6         # Defines the middle column of the game pane.
  131. $define FALSE       0         
  132. $define TRUE        1
  133. $define EMPTY       0         # The status of a square on the game pane.
  134. $define FILLED      1         # The status of a square on the game pane.
  135. $define WIDTH       12        # The width of the game pane matrix.
  136. $define HEIGHT      31        # The height of the game pane matrix.
  137. $define RIGHT_EDGE  12        # The rightmost column of the game pane matrix.
  138. $define BOTTOM      31        # The bottom row of the game pane matrix.
  139. $define RIGHT       1         # Move brick to the right.
  140. $define LEFT        2         # Move brick to the left.
  141. $define ROTATE      3         # Rotate brick.
  142. $define SLAM        4         # Bring brick down instantly.
  143. $define SPEED_UP    10        # The speedup when a new level is begun.
  144. $define THRESH_HOLD 20        # Number of rows to complete before level switch.
  145. $define ANIM_DELAY  20        # Delay in initial animation.
  146. $define MIN_SPEED   150       # Minimum game speed (level 1).
  147. $define MAX_SPEED   10        # Maximum game speed (level 15).
  148.  
  149. $include "keysyms.icn"
  150. $include "brickdata.icn"
  151. $include "matrix.icn"
  152. $include "brickio.icn"
  153. $include "movement.icn"
  154. $include "help.icn"
  155. $include "editor.icn"
  156.  
  157. ############################################################################
  158. #
  159. # Record: brick
  160. # Fields: color    - The color of the brick in string format.
  161. #         offset   - The rotation offset of this brick.
  162. #         matrices - The four matrices of this brick.
  163. #         images   - The four imagestrings of this brick.
  164. #
  165. # This record represents a brick and stores data to use it in a game.
  166. # The rotation offset depends on the shape of the brick and determines
  167. # where, relative to the current upper-left corner, the new upper-left
  168. # corner is going to be when the brick is rotated.
  169. # 'matrices' and 'images' are two lists containing corresponding matrices
  170. # and image strings.
  171. #
  172. ############################################################################
  173.  
  174. record brick( color, offset, matrices, images)
  175.  
  176. ############################################################################
  177. #
  178. # Record: position
  179. # Fields: row_nr      - Row number within the game pane matrix.
  180. #         col_nr      - Column number within the game pane matrix.
  181. #         transparent - Flag determining if this square is transparent or not.
  182. #
  183. # This record represents the position and status of each square in a brick on
  184. # the game pane. When a brick is falling, its matrix consists of 'position'-
  185. # records describing where within the larger game pane matrix each one of its
  186. # squares are positioned at the moment.
  187. #
  188. ############################################################################
  189.  
  190. record position( row_nr, col_nr, transparent)
  191.  
  192. ############################################################################
  193. #
  194. # Procedure: main
  195. # Arguments: None.
  196. # Returns  : Nothing.
  197. #
  198. # This procedure starts the htetris application and the brick editor.
  199. # If the brick editor could not be started properly it won't be used.
  200. # The the event loop is entered. The htetris and the brick editor are
  201. # "mutually exclusive". If the editor is in use, htetris does not
  202. # accept any user events and when htetris is in use, the editor is
  203. # not availible.
  204. #
  205. ############################################################################
  206.  
  207. procedure main()
  208.  
  209.     start_htetris()
  210.     if start_editor() then
  211.     editor_on := TRUE
  212.     else
  213.     editor_on := FALSE
  214.     
  215.     repeat {
  216.     if root === htetris_vidgets["root"] then
  217.         game()
  218.     else
  219.         edit()
  220.     }
  221. end
  222.  
  223. ############################################################################
  224. #
  225. # Procedure: start_htetris
  226. # Arguments: None.
  227. # Returns  : Nothing.
  228. #
  229. # This procedure starts the htetris application.
  230. # Its window is opened and the different regions on the interface are
  231. # initialized.
  232. # Event root vidget is set to the htetris window.
  233. # The original bricks are initialized by calling 'init_bricks' and put
  234. # them in a global table.
  235. # A Control keys table is created and initialized with the arrow keys.
  236. # A global list of synonyms for valid special control keys is also
  237. # initialized.
  238. # Then the game pane matrix is created and various status variables used
  239. # when playing the game are initialized.
  240. # The score and highscore are written on the interface, the highscore
  241. # possibly read from a file. The highscore is set to zero if the file
  242. # could not be opened.
  243. # The level display pane is initialized as well.
  244. # Last of all, an initial animation is performed on the animation pane.
  245. #
  246. ############################################################################
  247.  
  248. procedure start_htetris()
  249.  
  250.     randomize()
  251.  
  252.     (htetris_window := WOpen ! htetris_atts()) |
  253.     stop( "Can't open htetris window.")
  254.     htetris_vidgets := htetris( htetris_window)    
  255.  
  256.     game_pane := Clone( htetris_window, "bg=black",
  257.                 "dx=" || htetris_vidgets["playfield"].ux,
  258.                 "dy=" || htetris_vidgets["playfield"].uy)
  259.     next_pane := Clone( htetris_window,
  260.                 "dx=" || htetris_vidgets["next"].ux,
  261.                 "dy=" || htetris_vidgets["next"].uy)
  262.     anim_pane := Clone( htetris_window,
  263.                 "dx=" || htetris_vidgets["animation"].ux,
  264.                 "dy=" || htetris_vidgets["animation"].uy)
  265.     score_pane := Clone( htetris_window,
  266.                  "dx=" || htetris_vidgets["score"].ux,
  267.                  "dy=" || htetris_vidgets["score"].uy)
  268.     highscore_pane := Clone( htetris_window,
  269.                  "dx=" || htetris_vidgets["highscore"].ux,
  270.                  "dy=" || htetris_vidgets["highscore"].uy)
  271.     level_pane := Clone( htetris_window,
  272.              "dx=" || htetris_vidgets["level"].ux,
  273.              "dy=" || htetris_vidgets["level"].uy)
  274.  
  275.     Clip( game_pane, 0, 0,
  276.       htetris_vidgets["playfield"].uw, htetris_vidgets["playfield"].uh)
  277.     Clip( next_pane, 0, 0,
  278.       htetris_vidgets["next"].uw, htetris_vidgets["next"].uh)
  279.     Clip( anim_pane, 0, 0,
  280.       htetris_vidgets["animation"].uw, htetris_vidgets["animation"].uh)
  281.     Clip( score_pane, 0, 0,
  282.       htetris_vidgets["score"].uw, htetris_vidgets["score"].uh)
  283.     Clip( highscore_pane, 0, 0,
  284.       htetris_vidgets["highscore"].uw, htetris_vidgets["highscore"].uh)
  285.     Clip( level_pane, 0, 0,
  286.       htetris_vidgets["level"].uw, htetris_vidgets["level"].uh)
  287.  
  288.     EraseArea( game_pane)
  289.  
  290.     root := htetris_vidgets["root"]
  291.  
  292.     brick_table := init_bricks()
  293.     next_id     := "1"
  294.  
  295.     current_keys         := table()
  296.     current_keys[RIGHT]  := Key_Right
  297.     current_keys[LEFT]   := Key_Left
  298.     current_keys[ROTATE] := Key_Up
  299.     current_keys[SLAM]   := Key_Down
  300.     special_keys :=
  301.     ["print screen","scroll lock","pause","insert","home","page up","end",
  302.      "page down","arrow left","arrow up","arrow right","arrow down","F1",
  303.      "F2","F3","F4","F5","F6","F7","F8","F9","F10","F11","F12","backspace",
  304.      "delete","escape","form feed","line feed","newline","return","tab",
  305.      "vertical space"]
  306.  
  307.     pane_matrix          := new_matrix( HEIGHT, WIDTH)
  308.     game_on              := FALSE
  309.     pause                := FALSE
  310.     start_speed          := MIN_SPEED
  311.     speed_factor         := 1
  312.  
  313.     Font( level_pane, "lucidasanstypewriter-bold-24")
  314.     Font( score_pane, "lucidasanstypewriter-bold-24")
  315.     Font( highscore_pane, "lucidasanstypewriter-bold-24")
  316.  
  317.     DrawString( score_pane, 2, 20, "000000000")
  318.     highscore_file := open( "highscore.dat")
  319.     if /highscore_file then {
  320.     highscore := 0
  321.     DrawString( highscore_pane, 2, 20, "000000000")
  322.     }
  323.     else if not integer( highscore_string := read( highscore_file)) |
  324.         *highscore_string > 9                                   then {
  325.  
  326.     highscore := 0
  327.     DrawString( highscore_pane, 2, 20, "000000000")
  328.     close( highscore_file)
  329.     }
  330.     else {
  331.     highscore := integer( highscore_string)
  332.     DrawString( highscore_pane, 2, 20, right( highscore_string, 9, "0"))
  333.     close( highscore_file)
  334.     }
  335.  
  336.     DrawString( level_pane, 2, 20,
  337.             right( string( (MIN_SPEED - start_speed)/10 + 1), 2, "0"))
  338.     animate()
  339.     return
  340. end
  341.  
  342. ############################################################################
  343. #
  344. # Procedure: close_htetris
  345. # Arguments: None.
  346. # Returns  : Nothing.
  347. #
  348. # This procedure closes down the brick editor if it was started, possibly
  349. # saving the highscore to a file, closes the htetris application window and
  350. # exits the program altogether.
  351. #
  352. ############################################################################
  353.  
  354. procedure close_htetris()
  355.  
  356.     if editor_on = TRUE then kill_editor()
  357.  
  358.     highscore_file := open( "highscore.dat", "ct")
  359.     if /highscore_file then
  360.     Notice( htetris_window,
  361.             "Could not open highscore-file, highscore unsaved.")
  362.     else
  363.     write( highscore_file, string( highscore))
  364.  
  365.     close( highscore_file)
  366.     WClose( htetris_window)
  367.     exit()
  368. end
  369.  
  370. ############################################################################
  371. #
  372. # Procedure: game
  373. # Arguments: None.
  374. # Returns  : Nothing.
  375. #
  376. # This is the game loop that plays the game.
  377. # If the flag 'game_on' equals 'TRUE', and there are events pending, events
  378. # corresponding to the current control keys are checked for and appropriate
  379. # procedures are called in case of such an event. If a cheating brick is
  380. # currently falling, move right, left and rotating will not work.
  381. # If no control event was found, other events are processed and the current
  382. # brick keeps falling.
  383. # If the 'game_on' flag equals 'FALSE', events in general are processed
  384. # and the procedure returns.
  385. # If a certain amount of rows has been completed, the game speeds up
  386. # ie. advances one level.
  387. #
  388. ############################################################################
  389.  
  390. procedure game()
  391.  
  392.     while game_on = TRUE do {
  393.     every 1 to ceil(speed / speed_factor) do {
  394.         if (*Pending( htetris_window) > 0) then {
  395.         event  := pop( Pending())
  396.         value1 := pop( Pending())
  397.         value2 := pop( Pending())
  398.         case event of {
  399.             current_keys[RIGHT] : {
  400.             if cheating = FALSE                     &
  401.                can_move_right( current_matrices[1]) then
  402.                 move_right( game_pane, current_matrices[1])
  403.             }
  404.             current_keys[LEFT] : {
  405.             if cheating = FALSE                    &
  406.                can_move_left( current_matrices[1]) then
  407.                 move_left( game_pane, current_matrices[1])
  408.             }
  409.             current_keys[ROTATE] : {
  410.             if cheating = FALSE then
  411.                 flip()
  412.             }
  413.             current_keys[SLAM]   : {
  414.             slam()
  415.             if game_on = FALSE then break next
  416.             }
  417.             default : {
  418.             push( Pending(), value2, value1, event)
  419.             ProcessEvent( root, , shortcuts)
  420.             }
  421.         }
  422.         }
  423.     }
  424.     while pause = TRUE do ProcessEvent( root, , shortcuts)
  425.     if game_on = FALSE then next
  426.     fall()
  427.     if rows_completed > THRESH_HOLD & speed > MAX_SPEED then {
  428.         speed          := speed - SPEED_UP
  429.         rows_completed := 0
  430.         EraseArea( level_pane)
  431.         DrawString( level_pane, 2, 20,
  432.                 right( string( (MIN_SPEED - speed)/10 + 1), 2, "0"))
  433.     }
  434.     }
  435.     ProcessEvent( root, , shortcuts)
  436.     return
  437. end
  438.  
  439. ############################################################################
  440. #
  441. # Procedure: set_positions
  442. # Arguments: matrix    - Matrix to be initialized.
  443. #            first_row - Row of "background" matrix.
  444. #            first_col - Column of "background" matrix.
  445. # Returns  : matrix    - Updated matrix.
  446. #
  447. # This procedure initializes a brick matrix with pane matrix "background"
  448. # positions, by traversing the given matrix. The top left element is set
  449. # to the given row, column position and all other elements are initialized
  450. # from there.
  451. #
  452. ############################################################################
  453.  
  454. procedure set_positions( matrix, first_row, first_col)
  455.  
  456.     new_row := first_row
  457.     every r := 1 to *matrix do {
  458.     new_col := first_col
  459.     every c := 1 to *matrix[r] do {
  460.         matrix[r][c].row_nr := new_row
  461.         matrix[r][c].col_nr := new_col
  462.         new_col             := new_col+1
  463.     }
  464.     new_row := new_row+1
  465.     }
  466.     return matrix
  467. end
  468.  
  469. ############################################################################
  470. #
  471. # Procedure: animate_brick
  472. # Arguments: brick_rec - Data of brick to be moved.
  473. #            index     - Index of matrix and image to be used.
  474. #            start_row - Start row of upper left brick square.
  475. #            start_col - Start column of upper left brick square.
  476. #            steps     - The number of steps to move the brick.
  477. #            move_func - Function to move the brick with.
  478. # Returns  : Nothing.
  479. #
  480. # This procedure moves a given brick in the given direction the given
  481. # number of steps on the animation pane, starting at the given position.
  482. # The moving function can be 'move_left', 'move_right', 'move_down' or
  483. # 'move_up'.
  484. # Copies are made of the appropriate image and matrix which is then
  485. # initialized.
  486. # Although the brick matrix is initialized, there is no "background" matrix
  487. # representing the animation pane. This is not needed since a brick is only
  488. # to be moved a fixed number of steps and does not have to have a stop
  489. # criterion depending on what is already on the pane.
  490. #
  491. ############################################################################
  492.  
  493. procedure animate_brick( brick_rec, index,
  494.              start_row, start_col, steps, move_func)
  495.  
  496.     current_images   := [brick_rec.images[index]]
  497.     current_matrices := [copy_matrix( brick_rec.matrices[index])]
  498.     matrix           := set_positions( current_matrices[1], start_row, start_col)
  499.     DrawImage( anim_pane,
  500.            (matrix[1][1].col_nr-2)*20,
  501.            (matrix[1][1].row_nr-1)*20,
  502.            current_images[1])
  503.     every 1 to steps do {
  504.     move_func( anim_pane, matrix)
  505.     WDelay( ANIM_DELAY)
  506.     }
  507.     return
  508. end
  509.  
  510. ############################################################################
  511. #
  512. # Procedure: animate
  513. # Arguments: None.
  514. # Returns  : Nothing.
  515. #
  516. # This procedure performs an initial animation when htetris is started.
  517. #
  518. ############################################################################
  519.  
  520. procedure animate()
  521.  
  522.     animate_brick( brick_table["brick_4"], 2, 7, 15, 7, move_left)
  523.     animate_brick( brick_table["brick_7"], 1, 7, 0, 6, move_right)
  524.     animate_brick( brick_table["brick_2"], 1, -2, 7, 6, move_down)
  525.     animate_brick( brick_table["brick_1"], 1, 5, 0, 5, move_right)
  526.     animate_brick( brick_table["brick_1"], 1, 4, 15, 7, move_left)
  527.     animate_brick( brick_table["brick_6"], 2, 8, 0, 4, move_right)
  528.     animate_brick( brick_table["brick_3"], 1, 14, 8, 5, move_up)
  529.     animate_brick( brick_table["brick_5"], 1, 5, 15, 6, move_left)
  530.     animate_brick( brick_table["brick_1"], 1, 14, 5, 4, move_up)
  531.     animate_brick( brick_table["brick_7"], 1, 6, 0, 4, move_right)
  532.     animate_brick( brick_table["brick_3"], 4, 0, 10, 4, move_down)
  533.     animate_brick( brick_table["brick_2"], 1, 14, 7, 5, move_up)
  534.     animate_brick( brick_table["brick_5"], 1, 9, 15, 6, move_left)
  535.     animate_brick( brick_table["brick_3"], 2, 11, -1, 5, move_right)
  536.     animate_brick( brick_table["brick_4"], 2, 4, -1, 5, move_right)
  537.     animate_brick( brick_table["brick_2"], 2, 8, 15, 6, move_left)
  538.     animate_brick( brick_table["brick_5"], 1, 14, 8, 3, move_up)
  539.     animate_brick( brick_table["brick_6"], 2, 9, 15, 4, move_left)
  540.     animate_brick( brick_table["brick_4"], 4, 14, 10, 3, move_up)
  541.     animate_brick( brick_table["brick_1"], 1, 6, 15, 4, move_left)
  542.  
  543.     shades := ["gray","dark-gray","black"]
  544.     every 1 to 3 do {
  545.     Fg( anim_pane, pop( shades))
  546.     FillRectangle( anim_pane, 120, 100, 20, 20)
  547.     WDelay( 4*ANIM_DELAY)
  548.     }
  549.     return
  550. end
  551.  
  552. ############################################################################
  553. #
  554. # Procedure: full_row
  555. # Arguments: r - A row number in the game pane matrix.
  556. # Returns  : Nothing.
  557. #
  558. # This procedure determines if a matrix row is the game pane matrix is
  559. # filled or not. If it's not, the procedure fails.
  560. #
  561. ############################################################################
  562.  
  563. procedure full_row( r)
  564.  
  565.     every c := 2 to 11 do
  566.     if pane_matrix[r][c] = EMPTY then
  567.         fail
  568.     return
  569. end
  570.  
  571. ############################################################################
  572. #
  573. # Procedure: erase_row
  574. # Arguments: r - A row number in the game pane matrix.
  575. # Returns  : Nothing.
  576. #
  577. # This procedure erases the given matrix row on the game pane by drawing
  578. # 20 consecutive black lines.
  579. #
  580. ############################################################################
  581.  
  582. procedure erase_row( r)
  583.  
  584.     first_line := (r-1)*20    # Calculate start pixel line from matrix row.
  585.     Fg( game_pane, "black")
  586.  
  587.     every line := first_line to first_line+19 do {
  588.     DrawLine( game_pane, 0, line, 199, line)
  589.     WDelay()
  590.     }
  591.     return
  592. end
  593.  
  594. ############################################################################
  595. #
  596. # Procedure: shift_pane_matrix
  597. # Arguments: erased_row - A row number in the game pane matrix.
  598. # Returns  : Nothing.
  599. #
  600. # This procedure shifts the game pane matrix by moving all rows above the
  601. # given row up to the top row one step "down". A blank row is inserted
  602. # as replacement for the previous top row.
  603. #
  604. ############################################################################
  605.  
  606. procedure shift_pane_matrix( erased_row)
  607.  
  608.     every r := erased_row to top_row+1 by -1 do
  609.     pane_matrix[r] := pane_matrix[r-1]
  610.  
  611.     blank                := list( WIDTH, EMPTY)
  612.     blank[1]             := FILLED
  613.     blank[RIGHT_EDGE]    := FILLED
  614.     pane_matrix[top_row] := blank
  615.     return
  616. end
  617.  
  618. ############################################################################
  619. #
  620. # Procedure: shift_pane
  621. # Arguments: r - A row number in the game pane matrix.
  622. # Returns  : Nothing.
  623. #
  624. # This procedure shifts the game pane down graphically by copying the area
  625. # above the given matrix row up to and including the top row, down 20 pixels
  626. # which is the height of one row. The previous top row is erased.
  627. #
  628. ############################################################################
  629.  
  630. procedure shift_pane( r)
  631.  
  632.     upper_limit := (top_row-1)*20
  633.  
  634.     CopyArea( game_pane, game_pane,
  635.           0, upper_limit, 200, (r-1)*20 - upper_limit,
  636.           0, upper_limit+20)
  637.     EraseArea( game_pane, 0, upper_limit, 200, 20)
  638.     return
  639. end
  640.  
  641. ############################################################################
  642. #
  643. # Procedure: add_score
  644. # Arguments: nr_rows - Number of filled rows to get score from.
  645. # Returns  : Nothing.
  646. #
  647. # This procedure calculates and adds the score for the given number of
  648. # simultanously filled rows to the total score.
  649. # The score is 20 points per row, plus 5 bonus points for each extra row
  650. # if there are more than one.
  651. # The score "wraps around" at maximum score.
  652. # The score showed on the interface is updated.
  653. #
  654. ############################################################################
  655.  
  656. procedure add_score( nr_rows)
  657.  
  658.     score := score + nr_rows*20 + (nr_rows-1)*5
  659.  
  660.     if score > MAX_SCORE then
  661.     score := score - MAX_SCORE
  662.  
  663.     score_string := right( score, 9, "0")
  664.  
  665.     EraseArea( score_pane)        
  666.     DrawString( score_pane, 2, 20, score_string)
  667.     return
  668. end
  669.  
  670. ############################################################################
  671. #
  672. # Procedure: eliminate_rows
  673. # Arguments: None.
  674. # Returns  : Nothing.
  675. #
  676. # This procedure determines how many rows that were filled by the last
  677. # brick to get stuck by traversing the pane matrix top-down from the top
  678. # row to the (conceptual) bottom. For each filled row, it is erased, and the
  679. # pane matrix and the pane are shifted.
  680. # If there were any filled rows, the total number of completed rows is up-
  681. # dated and points are added to the current score.
  682. #
  683. ############################################################################
  684.  
  685. procedure eliminate_rows()
  686.  
  687.     nr_full_rows := 0
  688.  
  689.     every r := top_row to 30 do
  690.     if full_row( r) then {
  691.         nr_full_rows := nr_full_rows+1
  692.         erase_row( r)
  693.         shift_pane_matrix( r)
  694.         shift_pane( r)
  695.         top_row := top_row+1
  696.     }
  697.     if nr_full_rows > 0 then {
  698.     rows_completed := rows_completed + nr_full_rows
  699.     add_score( nr_full_rows)
  700.     }
  701.     return
  702. end
  703.  
  704. ############################################################################
  705. #
  706. # Procedure: get_stuck
  707. # Arguments: None.
  708. # Returns  : Nothing.
  709. #
  710. # This procedure makes a brick stick to the pane and eliminates any rows
  711. # that were filled as a consequence of this.
  712. # If the position of the upper left square of the brick is higher than the
  713. # current top row, the top row is updated.
  714. # Then, for each element in the brick's matrix (which holds the position
  715. # it is occupying in the pane matrix) the corresponding element in the
  716. # pane matrix is set to the value 'FILLED'. This 'glues' the brick to the
  717. # pane graphically and is reflected in the pane matrix.
  718. #
  719. ############################################################################
  720.  
  721. procedure get_stuck()
  722.  
  723.     matrix := current_matrices[1]
  724.  
  725.     if matrix[1][1].row_nr < top_row then
  726.     top_row := matrix[1][1].row_nr
  727.  
  728.     every r := 1 to *matrix do
  729.     every c := 1 to *matrix[r] do
  730.         if matrix[r][c].transparent = FALSE then
  731.         pane_matrix[matrix[r][c].row_nr][matrix[r][c].col_nr] := FILLED
  732.  
  733.     eliminate_rows()
  734.     cheating := FALSE
  735.     return
  736. end
  737.  
  738. ############################################################################
  739. #
  740. # Procedure: create_cheat_matrix
  741. # Arguments: None.
  742. # Returns  : Nothing.
  743. #
  744. # This procedure creates and returns a matrix representing a "cheat brick".
  745. # This brick covers every empty square upto and one row above 'top row'.
  746. # Only vertically connected empty squares are considered.
  747. # The matrix is initialized with the appropriate game pane matrix positions.
  748. #
  749. ############################################################################
  750.  
  751. procedure create_cheat_matrix()
  752.  
  753.     cheat_string := ";1111111111"
  754.     done         := FALSE
  755.  
  756.     r := top_row
  757.     while done = FALSE do {
  758.     temp := ";"
  759.     every c := 2 to 11 do
  760.         if pane_matrix[r][c] = EMPTY            &
  761.            cheat_string[(11*(r-top_row))+c] = 1 then
  762.         temp := temp || "1"
  763.         else
  764.         temp := temp || "0"
  765.     if temp == ";0000000000" then
  766.         done := TRUE
  767.     else {
  768.         cheat_string := cheat_string || temp
  769.         r := r+1
  770.     }
  771.     }
  772.     cheat_matrix := stom( string( r-top_row+1) || ",10" || cheat_string)
  773.  
  774.     return set_positions( init_positions( cheat_matrix), 1, 2)
  775. end
  776.  
  777. ############################################################################
  778. #
  779. # Procedure: cheat
  780. # Arguments: None.
  781. # Returns  : Nothing.
  782. #
  783. # This procedure sets 'current_matrices' and 'current_images' to the matrix
  784. # and image of a dynamicly created "cheat brick" by creating a hidden window
  785. # and draw the "cheat brick" in it by using the matrix and then transform it
  786. # into a transparent imagestring.
  787. #
  788. ############################################################################
  789.  
  790. procedure cheat()
  791.  
  792.     cheat_matrix := create_cheat_matrix()
  793.     if /(cheat_window := WOpen( "canvas=hidden", "bg=black",
  794.                     "width=" || (*cheat_matrix[1])*20,
  795.                     "height=" || (*cheat_matrix)*20)) then
  796.     write( "No cheating today, sucker!")
  797.     else {
  798.     old_pointer := WAttrib( htetris_window, "pointer")
  799.     if old_pointer == "left ptr" then
  800.         WAttrib( htetris_window, "pointer=watch")
  801.     else
  802.         WAttrib( htetris_window, "pointer=wait")
  803.     
  804.     every r := 1 to *cheat_matrix do
  805.         every c := 1 to *cheat_matrix[r] do
  806.         if cheat_matrix[r][c].transparent = EMPTY then
  807.             draw_square( r, c, cheat_window, "gray")
  808.     
  809.     current_matrices := [cheat_matrix,
  810.                  cheat_matrix,
  811.                  cheat_matrix,
  812.                  cheat_matrix]
  813.     cheat_image := 
  814.         transparentify( Capture( cheat_window, "c1", 0, 0,
  815.                     WAttrib( cheat_window, "width"),
  816.                     WAttrib( cheat_window, "height")))
  817.     current_images := [cheat_image,
  818.                cheat_image,
  819.                cheat_image,
  820.                cheat_image]
  821.     WClose( cheat_window)
  822.     WAttrib( htetris_window, "pointer=" || old_pointer)
  823.     }
  824.     return
  825. end
  826.  
  827. ############################################################################
  828. #
  829. # Procedure: fetch_next
  830. # Arguments: None.
  831. # Returns  : Nothing.
  832. #
  833. # This procedure fetches the next upcoming brick by setting the current
  834. # matrices and images to those of the next brick.
  835. # If the user has cheated, a dynamicly created "cheat brick" is fetched
  836. # instead of the regular one which is fetched at the next call to
  837. # 'fetch_next' providing the user did not cheat again.
  838. # If the user hasn't cheated, the global variable 'next_brick' is updated
  839. # with a randomly picked brick from the global brick table and that one is
  840. # displayed on the "next pane".
  841. # The start positions of every square of the next brick is checked against
  842. # the pane matrix and if it is to be placed so that any filled square in it
  843. # will cover a position in the pane matrix which value is 'FILLED' (another
  844. # already stuck brick resides there) the game is over.
  845. # Even when cheating the game might be over if a brick is stuck so that its
  846. # top row is in the first row of the game pane because a cheating brick
  847. # always has at least one row ten squares wide.
  848. # If the game is over the highscore is possibly updated depending if the
  849. # user cheated or not, the game pane is cleared and the procedure returns.
  850. # If the game is not over, the next brick is drawn in its initial position.
  851. #
  852. ############################################################################
  853.  
  854. procedure fetch_next()
  855.  
  856.     if cheated = TRUE then {
  857.     cheated := FALSE
  858.     cheat()
  859.         cheating := TRUE
  860.     }
  861.     else {
  862.     current_matrices := copy_matrices( next_brick.matrices)
  863.     current_images   := copy( next_brick.images)
  864.     flip_offset      := next_brick.offset
  865.  
  866.     next_brick := ?brick_table
  867.     width      := *(next_brick.matrices[1][1])
  868.     height     := *(next_brick.matrices[1])
  869.     
  870.     if width % 2 = 0 then
  871.         startx := (MIDDLE - width/2 - 1)*20
  872.     else
  873.         startx := (MIDDLE - width/2 - 2)*20
  874.     if height % 2 = 0 then
  875.         starty := (MIDDLE - height/2 - 1)*20
  876.     else
  877.         starty := (MIDDLE - height/2 - 2)*20
  878.     
  879.     EraseArea( next_pane)
  880.     DrawImage( next_pane, startx, starty, next_brick.images[1])
  881.     }
  882.     matrix := current_matrices[1]
  883.  
  884.     every r := 1 to *matrix do
  885.     every c := 1 to *matrix[r] do
  886.         if matrix[r][c].transparent = FALSE &
  887.            pane_matrix[matrix[r][c].row_nr][matrix[r][c].col_nr] =
  888.            FILLED then {
  889.         if score > highscore & record_highscore = TRUE then {
  890.             highscore := score
  891.             EraseArea( highscore_pane)
  892.             DrawString( highscore_pane, 2, 20,
  893.                     right( string( highscore), 9, "0"))
  894.         }
  895.         game_on := FALSE
  896.         black_out()
  897.         EraseArea( next_pane)
  898.         return
  899.         }
  900.     startx := (current_matrices[1][1][1].col_nr - 2)*20
  901.     DrawImage( game_pane, startx, 0, current_images[1])
  902.     return
  903. end
  904.  
  905. ############################################################################
  906. #
  907. # Procedure: init_pane_matrix
  908. # Arguments: None.
  909. # Returns  : Nothing.
  910. #
  911. # This procedure initializes the game pane matrix.
  912. # The leftmost and rightmost as well as the bottom row get all their
  913. # elements set to 'FILLED'. This row and columns are conceptually "outside"
  914. # the actual pane. This is convenient to make the falling bricks not to go
  915. # off the pane graphically.
  916. # All "interior" elements within the u-shaped border of 'FILLED' elements
  917. # are set to 'EMPTY'.
  918. #
  919. ############################################################################
  920.  
  921. procedure init_pane_matrix()
  922.  
  923.     every r := 1 to HEIGHT do
  924.     every c := 1 to WIDTH do
  925.         if r = BOTTOM | c = 1 | c = RIGHT_EDGE then
  926.         pane_matrix[r][c] := FILLED
  927.         else 
  928.         pane_matrix[r][c] := EMPTY
  929.     return
  930. end
  931.  
  932. ############################################################################
  933. #
  934. # Procedure: black_out
  935. # Arguments: None.
  936. # Returns  : Nothing.
  937. #
  938. # This procedure blanks out the game pane by drawing smaller and smaller
  939. # gray and black rectangles until the middle is reached.
  940. # The The whole pane is erased since the last drawn gray rectangle is on
  941. # the pane.
  942. #
  943. ############################################################################
  944.  
  945. procedure black_out()
  946.  
  947.     every x := 0 to htetris_vidgets["playfield"].uw/2 do {
  948.     Fg( game_pane, "dark-gray")
  949.     DrawRectangle( game_pane, x+1, x+1,
  950.                htetris_vidgets["playfield"].uw-2*(x+1),
  951.                htetris_vidgets["playfield"].uh-2*(x+1))
  952.     Fg( game_pane, "black")
  953.     DrawRectangle( game_pane, x, x,
  954.                htetris_vidgets["playfield"].uw-2*x,
  955.                htetris_vidgets["playfield"].uh-2*x)
  956.     WDelay( game_pane)
  957.     }
  958.     EraseArea( game_pane)
  959.     return
  960. end
  961.  
  962. ############################################################################
  963. #
  964. # Procedure: valid_synonym
  965. # Arguments: key_string - A synonym for a special key.
  966. # Returns  : Nothing.
  967. #
  968. # This procedure determines if a given synonym corresponds to a valid
  969. # special key.
  970. #
  971. ############################################################################
  972.  
  973. procedure valid_synonym( key_string)
  974.  
  975.     case key_string of {
  976.     special_keys[1] : return Key_PrSc
  977.     special_keys[2] : return Key_ScrollLock
  978.     special_keys[3] : return Key_Pause
  979.     special_keys[4] : return Key_Insert
  980.     special_keys[5] : return Key_Home
  981.     special_keys[6] : return Key_PgUp
  982.     special_keys[7] : return Key_End
  983.     special_keys[8] : return Key_PgDn
  984.     special_keys[9] : return Key_Left
  985.     special_keys[10] : return Key_Up
  986.     special_keys[11] : return Key_Right
  987.     special_keys[12] : return Key_Down
  988.     special_keys[13] : return Key_F1
  989.     special_keys[14] : return Key_F2
  990.     special_keys[15] : return Key_F3
  991.     special_keys[16] : return Key_F4
  992.     special_keys[17] : return Key_F5
  993.     special_keys[18] : return Key_F6
  994.     special_keys[19] : return Key_F7
  995.     special_keys[20] : return Key_F8
  996.     special_keys[21] : return Key_F9
  997.     special_keys[22] : return Key_F10
  998.     special_keys[23] : return Key_F11
  999.     special_keys[24] : return Key_F12
  1000.     special_keys[25] : return "\b"
  1001.     special_keys[26] : return "\d"
  1002.     special_keys[27] : return "\e"
  1003.     special_keys[28] : return "\f"
  1004.     special_keys[29] : return "\l"
  1005.     special_keys[30] : return "\n"
  1006.     special_keys[31] : return "\r"
  1007.     special_keys[32] : return "\t"
  1008.     special_keys[33] : return "\v"
  1009.     }
  1010.     return
  1011. end
  1012.  
  1013. ############################################################################
  1014. #
  1015. # Procedure: ktos
  1016. # Arguments: key_value - The value returned from a keypress event.
  1017. # Returns  : Nothing.
  1018. #
  1019. # This procedure returns a string representation of the given key value.
  1020. #
  1021. ############################################################################
  1022.  
  1023. procedure ktos( key_value)
  1024.  
  1025.     case key_value of {
  1026.     Key_PrSc       : return special_keys[1]
  1027.     Key_ScrollLock : return special_keys[2]
  1028.     Key_Pause      : return special_keys[3]
  1029.     Key_Insert     : return special_keys[4]
  1030.     Key_Home       : return special_keys[5]
  1031.     Key_PgUp       : return special_keys[6]
  1032.     Key_End        : return special_keys[7]
  1033.     Key_PgDn       : return special_keys[8]
  1034.     Key_Left       : return special_keys[9]
  1035.     Key_Up         : return special_keys[10]
  1036.     Key_Right      : return special_keys[11]
  1037.     Key_Down       : return special_keys[12]
  1038.     Key_F1         : return special_keys[13]
  1039.     Key_F2         : return special_keys[14]
  1040.     Key_F3         : return special_keys[15]
  1041.     Key_F4         : return special_keys[16]
  1042.     Key_F5         : return special_keys[17]
  1043.     Key_F6         : return special_keys[18]
  1044.     Key_F7         : return special_keys[19]
  1045.     Key_F8         : return special_keys[20]
  1046.     Key_F9         : return special_keys[21]
  1047.     Key_F10        : return special_keys[22]
  1048.     Key_F11        : return special_keys[23]
  1049.     Key_F12        : return special_keys[24]
  1050.     }
  1051.     key_string := string( key_value)
  1052.     case key_string of {
  1053.     "\b" : return special_keys[25]
  1054.     "\d" : return special_keys[26]
  1055.     "\e" : return special_keys[27]
  1056.     "\f" : return special_keys[28]
  1057.     "\l" : return special_keys[29]
  1058.     "\n" : return special_keys[30]
  1059.     "\r" : return special_keys[31]
  1060.     "\t" : return special_keys[32]
  1061.     "\v" : return special_keys[33]
  1062.     }
  1063.     return key_string
  1064. end
  1065.  
  1066. ############################################################################
  1067. #
  1068. # Procedure: key_value
  1069. # Arguments: None.
  1070. # Returns  : specials - A window.
  1071. #
  1072. # This procedure opens and returns a window containing a list of synonyms
  1073. # for valid special keys. Null is returned if the window could not be
  1074. # opened.
  1075. #
  1076. ############################################################################
  1077.  
  1078. procedure specials_window()
  1079.  
  1080.     if specials := WOpen( "label=htetris", "size=120,550",
  1081.               "posx=" || WAttrib( htetris_window, "posx")-60,
  1082.               "posy=" || WAttrib( htetris_window, "posy")+60,
  1083.               "bg=gray-white") then {
  1084.  
  1085.     Font( specials, Font( htetris_window))
  1086.     DrawString( specials, 10, 20, "Special keys:")
  1087.     y := 60
  1088.     every special := 1 to *special_keys do {
  1089.         DrawString( specials, 10, y, special_keys[special])
  1090.         y := y+15
  1091.     }
  1092.     }
  1093.     else write( "List of special keys could not be shown.")
  1094.     return specials
  1095. end
  1096.  
  1097. ############################################################################
  1098. #
  1099. # Procedure: select_keys
  1100. # Arguments: None.
  1101. # Returns  : Nothing.
  1102. #
  1103. # This procedure shows a text dialog with buttons "Okay" and "Cancel", which
  1104. # prompts for new control keys to be entered. Valid keys are any charachter
  1105. # or a synonym from the 'special_keys' list.
  1106. # If one or more of the enterd values are invalid, an error message is
  1107. # shown and the dialog reappears. If cancel is pressed the dialog dis-
  1108. # appears.
  1109. # The global variables containing the current key settings are updated.
  1110. #
  1111. ############################################################################
  1112.  
  1113. procedure select_keys()
  1114.  
  1115.     button_pressed :=
  1116.     TextDialog( htetris_window,
  1117.             ["Enter control keys."],
  1118.             ["Move right:", "Move Left:", "Rotate:", "Slam down:"],
  1119.             [],
  1120.             [14, 14, 14, 14])
  1121.     
  1122.     case button_pressed of {
  1123.     "Okay" : {
  1124.         if *dialog_value[1] = 1 then
  1125.         right_value := dialog_value[1]
  1126.         else {
  1127.         right_value := valid_synonym( dialog_value[1])
  1128.         if /right_value then {
  1129.             Notice( htetris_window,
  1130.                 "Invalid key specification \"" ||
  1131.                 dialog_value[1]                ||
  1132.                 "\".")
  1133.             select_keys()
  1134.             return
  1135.         }
  1136.         }
  1137.  
  1138.         if *dialog_value[2] = 1 then
  1139.         left_value := dialog_value[2]
  1140.         else {
  1141.         left_value := valid_synonym( dialog_value[2])
  1142.         if /left_value then {
  1143.             Notice( htetris_window,
  1144.                 "Invalid key specification \"" ||
  1145.                 dialog_value[2]                ||
  1146.                 "\".")
  1147.             select_keys()
  1148.             return
  1149.         }
  1150.         }
  1151.  
  1152.         if *dialog_value[3] = 1 then
  1153.         rotate_value := dialog_value[3]
  1154.         else {
  1155.         rotate_value := valid_synonym( dialog_value[3])
  1156.         if /rotate_value then {
  1157.             Notice( htetris_window,
  1158.                 "Invalid key specification \"" ||
  1159.                 dialog_value[3]                ||
  1160.                 "\".")
  1161.             select_keys()
  1162.             return
  1163.         }
  1164.         }
  1165.  
  1166.         if *dialog_value[4] = 1 then
  1167.         slam_value := dialog_value[4]
  1168.         else {
  1169.         slam_value := valid_synonym( dialog_value[4])
  1170.         if /slam_value then {
  1171.             Notice( htetris_window,
  1172.                 "Invalid key specification \"" ||
  1173.                 dialog_value[4]                ||
  1174.                 "\".")
  1175.             select_keys()
  1176.             return
  1177.         }
  1178.         }
  1179.  
  1180.         current_keys[RIGHT]  := right_value
  1181.         current_keys[LEFT]   := left_value
  1182.         current_keys[ROTATE] := rotate_value
  1183.         current_keys[SLAM]   := slam_value
  1184.     }
  1185.     }
  1186.     return
  1187. end
  1188.  
  1189. ############################################################################
  1190. #
  1191. # Procedure: pick_level
  1192. # Arguments: None.
  1193. # Returns  : Nothing.
  1194. #
  1195. # This procedure shows a text dialog with buttons "Okay" and "Cancel", which
  1196. # prompts for a new starting level.
  1197. # If the entered level was valid, the starting speed and the level pane
  1198. # are updated. Else, the dialog reappears until the user enters a valid
  1199. # level or presses cancel.
  1200. #
  1201. ############################################################################
  1202.  
  1203. procedure pick_level()
  1204.  
  1205.     if game_on = FALSE then {
  1206.     button_pressed :=
  1207.         TextDialog( htetris_window,
  1208.                 ["Enter starting level (1 - 15)."],
  1209.                 ["Level:"],
  1210.                 [string( (MIN_SPEED - start_speed)/10 + 1)],
  1211.                 [2])
  1212.     
  1213.     case button_pressed of {
  1214.         "Okay" : {
  1215.         level := integer( dialog_value[1])
  1216.         if /level | level < 1 | level > 15 then {
  1217.             Notice( htetris_window, "Invalid level specification.")
  1218.             pick_level()
  1219.             return
  1220.         }
  1221.         start_speed := (MIN_SPEED - (level-1)*10)
  1222.         EraseArea( level_pane)
  1223.         DrawString( level_pane, 2, 20, right( string( level), 2, "0"))
  1224.         }
  1225.     }
  1226.     }
  1227.     return    
  1228. end
  1229.  
  1230. ############################################################################
  1231. #
  1232. # Procedure: change_speed_factor
  1233. # Arguments: None.
  1234. # Returns  : Nothing.
  1235. #
  1236. # This procedure shows a text dialog with buttons "Okay" and "Cancel", which
  1237. # prompts for a new speed factor between -10 and 10. A negative number slows
  1238. # the application down while a positive number speeds it up. If 0 was entered,
  1239. # the speed factor is set to 1.
  1240. # I the entered factor was valid, the global variable 'speed_factor' is
  1241. # updated. Else, the dialog reappears until the user enters a valid speed
  1242. # factor or presses cancel.
  1243. #
  1244. ############################################################################
  1245.  
  1246. procedure change_speed_factor()
  1247.  
  1248.     if game_on = FALSE then {
  1249.     button_pressed :=
  1250.         TextDialog( htetris_window,
  1251.                 ["Enter new speed factor (-10 - 10)."],
  1252.                 ["Speed factor:"],
  1253.                 [],
  1254.                 [3])
  1255.     
  1256.     case button_pressed of {
  1257.         "Okay" : {
  1258.         factor := dialog_value[1]
  1259.         if not integer( factor) |
  1260.            factor < -10         |
  1261.            factor > 10          then {
  1262.  
  1263.             Notice( htetris_window, "Invalid speed factor.")
  1264.             change_speed_factor()
  1265.             return
  1266.         }
  1267.         if factor = 0 then
  1268.             speed_factor = 1
  1269.         else if factor < 0 then
  1270.             speed_factor := 1.0/(-factor)
  1271.         else
  1272.             speed_factor := factor
  1273.         }
  1274.     }
  1275.     }
  1276.     return
  1277. end
  1278.  
  1279. ############################################################################
  1280. #
  1281. # Procedure: new_game
  1282. # Arguments: None.
  1283. # Returns  : Nothing.
  1284. #
  1285. # This procedure starts a new game at the current starting speed.
  1286. # The game pane is cleared and initialized and the next brick is fetched.
  1287. # Setting the global variable 'game_on' to 'TRUE' makes the program go into the
  1288. # game loop after this procedure has returned.
  1289. #
  1290. ############################################################################
  1291.  
  1292. procedure new_game()
  1293.  
  1294.     EraseArea( game_pane)
  1295.     EraseArea( score_pane)
  1296.     EraseArea( level_pane)
  1297.     DrawString( score_pane, 2, 20, "000000000")
  1298.     DrawString( level_pane, 2, 20,
  1299.             right( string( (MIN_SPEED - start_speed)/10 + 1), 2, "0"))
  1300.     init_pane_matrix()
  1301.     randomize()
  1302.     speed            := start_speed
  1303.     rows_completed   := 0
  1304.     score            := 0
  1305.     game_on          := TRUE
  1306.     pause            := FALSE
  1307.     cheated          := FALSE
  1308.     cheating         := FALSE
  1309.     record_highscore := TRUE
  1310.     top_row          := BOTTOM
  1311.     next_brick       := ?brick_table
  1312.     fetch_next()
  1313.     return
  1314. end
  1315.  
  1316. ############################################################################
  1317. #
  1318. # Procedure: stop_game
  1319. # Arguments: None.
  1320. # Returns  : Nothing.
  1321. #
  1322. # This procedure stops a running game and blanks out the game pane.
  1323. # If no game is running, nothing happens.
  1324. #
  1325. ############################################################################
  1326.  
  1327. procedure stop_game()
  1328.  
  1329.     if game_on = FALSE then
  1330.     return
  1331.  
  1332.     game_on := FALSE
  1333.     black_out()
  1334.     EraseArea( next_pane)
  1335.     return
  1336. end
  1337.  
  1338. ############################################################################
  1339. #
  1340. # Procedure: pause_game
  1341. # Arguments: None.
  1342. # Returns  : Nothing.
  1343. #
  1344. # This procedure pauses a running game. If the game is paused, it is resumed.
  1345. # If a game is not in progress, nothing happens.
  1346. #
  1347. ############################################################################
  1348.  
  1349. procedure pause_game()
  1350.  
  1351.     if game_on = TRUE then
  1352.     if pause = TRUE then
  1353.         pause := FALSE
  1354.     else
  1355.         pause := TRUE
  1356.     return
  1357. end
  1358.  
  1359. ############################################################################
  1360. #
  1361. # Procedure: add_brick
  1362. # Arguments: None.
  1363. # Returns  : Nothing.
  1364. #
  1365. # This procedure prompts for a brick to be opened from file and adds it
  1366. # to the currently used bricks. The opened brick gets a unique id which is
  1367. # used if the user wants to remove it or display it.
  1368. # If a game is in progress, nothing happens.
  1369. #
  1370. ############################################################################
  1371.  
  1372. procedure add_brick()
  1373.  
  1374.     if game_on = FALSE then {
  1375.     if /(added := open_brick( htetris_window)) then
  1376.         return
  1377.     added.matrices[1] := init_positions( added.matrices[1])
  1378.     added.matrices[2] := init_positions( added.matrices[2])
  1379.     added.matrices[3] := init_positions( added.matrices[3])
  1380.     added.matrices[4] := init_positions( added.matrices[4])
  1381.     
  1382.     matrix := added.matrices[1]
  1383.  
  1384.     if *matrix = *matrix[1] then
  1385.         added.offset := 0
  1386.     else if *matrix > *matrix[1] then
  1387.         added.offset := ceil( abs( *matrix-*matrix[1])/2)
  1388.     else
  1389.         added.offset := -(ceil( abs( *matrix-*matrix[1])/2))
  1390.  
  1391.     brick_table["user_" || next_id] := added
  1392.     Notice( htetris_window,
  1393.             "Brick successfully added.",
  1394.             "Brick id is 'user_" || next_id ||"'.")
  1395.     next_id := string( integer( next_id) + 1)
  1396.     }
  1397.     return
  1398. end
  1399.  
  1400. ############################################################################
  1401. #
  1402. # Procedure: standard
  1403. # Arguments: None.
  1404. # Returns  : Nothing.
  1405. #
  1406. # This procedure determines if a brick id entered by a user in a dialog
  1407. # is the name of one of the standard brick.
  1408. # This is a security check so that none of the original bricks get removed
  1409. # and all brick names stay unique.
  1410. #
  1411. ############################################################################
  1412.  
  1413. procedure standard( brick_id)
  1414.  
  1415.     standard_bricks := set( ["brick_1","brick_2","brick_3","brick_4",
  1416.                  "brick_5","brick_6","brick_7"])
  1417.  
  1418.     return member( standard_bricks, brick_id)
  1419. end
  1420.  
  1421. ############################################################################
  1422. #
  1423. # Procedure: remove_brick
  1424. # Arguments: None.
  1425. # Returns  : Nothing.
  1426. #
  1427. # If there are user defined bricks in play (the total number is greater
  1428. # than seven), this procedure shows a text dialog box with buttons "Okay"
  1429. # and "Cancel", prompting the user to enter a user defined brick to be
  1430. # removed from the game.
  1431. # If no brick with the specified id is in use, the dialog reappears until
  1432. # the user enters a valid one or presses cancel.
  1433. # If a brick with the entered id is in use, it is deleted from the global
  1434. # table of bricks.
  1435. # If a game is in progress, nothing happens.
  1436. #
  1437. ############################################################################
  1438.  
  1439. procedure remove_brick()
  1440.  
  1441.     if game_on = FALSE then {
  1442.     if *brick_table = 7 then {
  1443.         Notice( htetris_window, "No user defined bricks in play.")
  1444.         return
  1445.     }
  1446.     button_pressed :=
  1447.         TextDialog( htetris_window,
  1448.                 ["Enter id of brick to remove."],
  1449.                 ["Id:"],
  1450.                 [],
  1451.                 [20])
  1452.     
  1453.     case button_pressed of {
  1454.         "Okay" : {
  1455.         id := dialog_value[1]
  1456.         if standard( id) | /brick_table[id] then {
  1457.             Notice( htetris_window,
  1458.                 "Brick '" || id || "' is not in use.")
  1459.             remove_brick()
  1460.             return
  1461.         }
  1462.         delete( brick_table, id)
  1463.         Notice( htetris_window, "Brick '" || id || "' removed.")
  1464.         }
  1465.     }        
  1466.     }    
  1467.     return
  1468. end
  1469.  
  1470. ############################################################################
  1471. #
  1472. # Procedure: display_bricks
  1473. # Arguments: None.
  1474. # Returns  : Nothing.
  1475. #
  1476. # If there are any user defined bricks in play, their ids are shown in a
  1477. # text dialog box with buttons "Okay" and "Cancel", prompting the user
  1478. # to enter one of the ids displayed.
  1479. # If this is done correctly, the brick corresponding to the given id is
  1480. # displayed in a popup window.
  1481. # The popup windows are open and the dialog reappears until the user
  1482. # presses cancel. Thus, several user bricks can be viewed simultanously.
  1483. # If a game is in progress, nothing happens.
  1484. #
  1485. ############################################################################
  1486.  
  1487. procedure display_bricks()
  1488.  
  1489.     if game_on = FALSE then {
  1490.     user_bricks := ""
  1491.     every user_brick := key( brick_table) do
  1492.         if not standard( user_brick) then
  1493.         user_bricks := user_bricks || user_brick || ","
  1494.  
  1495.     if user_bricks == "" then {
  1496.         Notice( htetris_window, "No user defined bricks in play.")
  1497.         return
  1498.     }
  1499.     button_pressed :=
  1500.         TextDialog( htetris_window,
  1501.                 ["The following user bricks are in play:",
  1502.              user_bricks,
  1503.              "enter id of brick to view."],
  1504.                 ["Id:"],
  1505.                 [],
  1506.                 [20])
  1507.  
  1508.     case button_pressed of {
  1509.         "Okay" : {
  1510.         id := dialog_value[1]        
  1511.         if standard( id) | /brick_table[id] then {
  1512.             Notice( htetris_window,
  1513.                 "Brick '" || id || "' is not in use.")
  1514.             display_bricks()
  1515.             return
  1516.         }
  1517.         else {
  1518.             brick := brick_table[id]
  1519.             temp_window :=
  1520.             WOpen( "width=" || (*brick.matrices[1][1])*20,
  1521.                    "height=" || (*brick.matrices[1])*20,
  1522.                        "bg=black") | {
  1523.                    Notice( htetris_window,
  1524.                        "Image window could not be opened.")
  1525.                    return
  1526.                    }
  1527.             DrawImage( temp_window, 0, 0, brick.images[1])
  1528.             display_bricks()
  1529.             WClose( temp_window)
  1530.             return
  1531.         }
  1532.         }
  1533.     }
  1534.     }
  1535.     return
  1536. end
  1537.  
  1538. ############################################################################
  1539. #
  1540. # Procedure: edit_bricks
  1541. # Arguments: None.
  1542. # Returns  : Nothing.
  1543. #
  1544. # This procedure displays the brick editor initializes it and transfers
  1545. # event handling to its window.
  1546. # No events from the htetris application window are now accepted.
  1547. # If a game is in progress, nothing happens.
  1548. #
  1549. ############################################################################
  1550.  
  1551. procedure edit_bricks()
  1552.  
  1553.     if game_on = FALSE then
  1554.     if editor_on = TRUE then {
  1555.         reset_editor( new_matrix( 3, 3), "yellow")
  1556.         WAttrib( editor_window, "canvas=normal")
  1557.         root := editor_vidgets["root"]
  1558.         while get( Pending( editor_window))
  1559.     }
  1560.     return
  1561. end
  1562.  
  1563. ############################################################################
  1564. #
  1565. # Procedure: shortcuts
  1566. # Arguments: event - An event.
  1567. # Returns  : Nothing.
  1568. #
  1569. # This procedure catches and processes keyboard shortcut events.
  1570. #
  1571. ############################################################################
  1572.  
  1573. procedure shortcuts( event)
  1574.  
  1575.     if &meta then
  1576.     case map( event) of {
  1577.         "n" : new_game()
  1578.         "s" : stop_game()
  1579.         "p" : pause_game()
  1580.         "q" : close_htetris()
  1581.         "a" : add_brick()
  1582.         "e" : edit_bricks()
  1583.     }
  1584.     return
  1585. end
  1586.  
  1587. ################################ CALLBACKS #################################
  1588.  
  1589. ############################################################################
  1590. #
  1591. # Procedure: game_cb
  1592. # Arguments: None.
  1593. # Returns  : Nothing.
  1594. #
  1595. # This procedure handles events from the "Game" menu.
  1596. #
  1597. ############################################################################
  1598.  
  1599. procedure game_cb( vidget, value)
  1600.     
  1601.     case value[1] of {
  1602.     "New game     @N" : new_game()
  1603.     "Stop game    @S" : stop_game()
  1604.     "Pause        @P" : pause_game()
  1605.     "Speed factor"    : change_speed_factor()
  1606.     "Pick level"      : pick_level()
  1607.     "Quit         @Q" : close_htetris()
  1608.     }
  1609.     return
  1610. end
  1611.  
  1612. ############################################################################
  1613. #
  1614. # Procedure: controls_cb
  1615. # Arguments: None.
  1616. # Returns  : Nothing.
  1617. #
  1618. # This procedure handles events from the "Controls" menu.
  1619. # If the "Set keys" item was selected, a window displaying valid special
  1620. # control keys and a dialog are opened.
  1621. # If the "Current keys" item was selected, the current key settings are
  1622. # displayed in a notice dialog.
  1623. # If a game is in progress, nothing happens.
  1624. #
  1625. ############################################################################
  1626.  
  1627. procedure controls_cb( vidget, value)
  1628.     
  1629.     if game_on = FALSE then
  1630.     case value[1] of {
  1631.         "Set keys"     : {
  1632.         specials := specials_window()
  1633.         select_keys()
  1634.         if \specials then WClose( specials)
  1635.         }
  1636.         "Current keys" : {
  1637.         Notice( htetris_window,
  1638.                 "Current key settings:",
  1639.                 "",
  1640.                 "Move right: " || ktos( current_keys[RIGHT]) || ".",
  1641.                 "Move left:  " || ktos( current_keys[LEFT]) || ".",
  1642.                 "Rotate:     " || ktos( current_keys[ROTATE]) || ".",
  1643.                 "Slam down:  " || ktos( current_keys[SLAM]) || ".")
  1644.         }
  1645.     }
  1646.     return
  1647. end
  1648.  
  1649. ############################################################################
  1650. #
  1651. # Procedure: bricks_cb
  1652. # Arguments: None.
  1653. # Returns  : Nothing.
  1654. #
  1655. # This procedure handles events from the "Bricks" menu.
  1656. # If a game is in progress, nothing happens.
  1657. #
  1658. ############################################################################
  1659.  
  1660. procedure bricks_cb( vidget, value)
  1661.     
  1662.     if game_on = FALSE then
  1663.     case value[1] of {
  1664.         "Add brick     @A" : add_brick()
  1665.         "Remove brick  @R" : remove_brick()
  1666.         "Bricks in use"    : display_bricks()
  1667.         "Brick editor  @E" : edit_bricks()
  1668.     }
  1669.     return
  1670. end
  1671.  
  1672. ############################################################################
  1673. #
  1674. # Procedure: htetris_help_cb
  1675. # Arguments: None.
  1676. # Returns  : Nothing.
  1677. #
  1678. # This procedure handles events from the "Help" menu of the htetris
  1679. # application window.
  1680. # If a game is in progress, nothing happens.
  1681. #
  1682. ############################################################################
  1683.  
  1684. procedure htetris_help_cb( vidget, value)
  1685.     
  1686.     if game_on = FALSE then
  1687.     case value[1] of {
  1688.         "How to play" : how_to_play()
  1689.         "Menus"       : game_menu()
  1690.         "About"       : about_htetris()
  1691.     }
  1692.     return
  1693. end
  1694.  
  1695. ############################################################################
  1696. #
  1697. # Procedure: buttons_cb
  1698. # Arguments: None.
  1699. # Returns  : Nothing.
  1700. #
  1701. # This procedure handles events from the four convenience buttons on the
  1702. # interface.
  1703. #
  1704. ############################################################################
  1705.  
  1706. procedure buttons_cb( vidget, value)
  1707.  
  1708.     case vidget.id of {
  1709.     "new_game"  : new_game()
  1710.     "stop_game" : stop_game()
  1711.     "pause"     : pause_game()
  1712.     "quit"      : close_htetris()
  1713.     }
  1714.     return
  1715. end
  1716.  
  1717. ############################################################################
  1718. #
  1719. # Procedure: animation_cb
  1720. # Arguments: None.
  1721. # Returns  : Nothing.
  1722. #
  1723. # This procedure handles events from the animation region.
  1724. # Only left mouse button clicks on a certain square are handled.
  1725. # If the user clicks there during a game, a cheat is going to take place
  1726. # instead of the next upcoming brick.
  1727. #
  1728. ############################################################################
  1729.  
  1730. procedure animation_cb( vidget, event, x, y)
  1731.  
  1732.     if game_on = TRUE then {
  1733.     x := x-WAttrib( anim_pane, "dx")-1
  1734.     y := y-WAttrib( anim_pane, "dy")-1
  1735.     r := ctop( y)
  1736.     c := ctop( x)
  1737.     
  1738.     if (r = 6 & c = 7) then
  1739.         case event of {
  1740.         &lpress : {
  1741.             cheated          := TRUE
  1742.             record_highscore := FALSE
  1743.         }
  1744.         }
  1745.     }    
  1746.     return
  1747. end
  1748.  
  1749. #===<<vib:begin>>===    modify using vib; do not remove this marker line
  1750. procedure htetris_atts()
  1751.    return ["size=520,640", "bg=gray-white", "label=htetris"]
  1752. end
  1753.  
  1754. procedure htetris(win, cbk)
  1755. return vsetup(win, cbk,
  1756.    ["htetris:Sizer:::0,0,520,640:htetris",],
  1757.    ["bricks:Menu:pull::100,0,50,21:Bricks",bricks_cb,
  1758.       ["Add brick     @A","Remove brick  @R","Bricks in use","Brick editor  @E"]],
  1759.    ["controls:Menu:pull::36,0,64,21:Controls",controls_cb,
  1760.       ["Set keys","Current keys"]],
  1761.    ["game:Menu:pull::0,0,36,21:Game",game_cb,
  1762.       ["New game     @N","Stop game    @S","Pause        @P","Speed factor","Pick level",
  1763.       "Quit         @Q"]],
  1764.    ["highscore_label:Label:::90,312,70,13:Highscore:",],
  1765.    ["htetris_help:Menu:pull::150,0,36,21:Help",htetris_help_cb,
  1766.       ["How to play","Menus","About"]],
  1767.    ["level_label:Label:::27,191,42,13:Level:",],
  1768.    ["menubar:Line:::0,22,520,22:",],
  1769.    ["new_game:Button:regular::6,30,75,30:New game",buttons_cb],
  1770.    ["next_label:Label:::150,30,77,13:Next brick:",],
  1771.    ["pause:Button:regular::6,102,75,30:Pause",buttons_cb],
  1772.    ["quit:Button:regular::6,138,75,30:Quit",buttons_cb],
  1773.    ["score_label:Label:::118,274,42,13:Score:",],
  1774.    ["stop_game:Button:regular::6,66,75,30:Stop game",buttons_cb],
  1775.    ["level:Rect:sunken::29,216,36,26:",],
  1776.    ["highscore:Rect:sunken::164,306,134,26:",],
  1777.    ["score:Rect:sunken::164,268,134,26:",],
  1778.    ["next:Rect:grooved::94,51,204,204:",],
  1779.    ["animation:Rect:invisible::25,356,260,260:",animation_cb],
  1780.    ["playfield:Rect:raised::310,30,204,604:",],
  1781.    )
  1782. end
  1783. #===<<vib:end>>===    end of section maintained by vib
  1784.