; $Id: tetris.pro,v 1.1 1993/04/02 19:43:31 idl Exp $

;======================================================================
;       IDL Tetris,
;       Ray Sterner, 23 and 25 June, 1991
;
;       IDL version of Tetris.
;       This program is composed of the following routines:
;
;       t_init  = initializes the screen and internal arrays.
;                 Sets up colors and shape tables.
;       t_next  = selects next piece to play.
;       t_drop  = Drops the piece down one position.
;       t_left  = Moves piece one position left.
;       t_right = Moves piece one position right.
;       t_rot   = Rotates piece by 90 CCW.
;       t_plot  = Plots or erases piece.
;       t_score = Handles a score, lights up line
;                 and squeezes it out.
;       tetris  = Main control program.
;
;======================================================================
;-----  t_init.pro = tetris init  ----------
;       R. Sterner, 23 Jun, 1991

        pro t_init, wt, lev, bell=bell

        common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
           t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
           t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
           t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc
        ;--------  Common variables  -------------
        ;  t_nx, t_ny = X and Y size of playing board.
        ;  t_brd = playing board.
        ;  t_p = current playing piece (used only in t_next?).
        ;  t_seed = random seed used in t_next to get next piece.
        ;  t_r = current rotation (0-3).
        ;  t_x, t_y = current reference point. This is what drops each
        ;    cycle, and can be moved left and right.
        ;  t_pxa, t_pya = X and Y offset for all pieces.
        ;  t_px, t_py = X and Y offsets for current piece.
        ;  t_ca = colors for all pieces.
        ;  t_c = current piece color.
        ;  t_bell = Ring bell for each line scored?
        ;  t_wait = drop cycle delay time.
        ;  t_pflst = array of last element numbers for piece outlines.
        ;  t_pfxa, t_pfya = table of all piece outlines, all rotations.
        ;  t_pfx, t_pfy = current piece outline.
        ;  t_pc, t_hpc = # pieces played in game and IDL session.
        ;  t_ln, t_hln = # lines scored in game and IDL session.
        ;  t_sc, t_hsc = score for game and IDL session.
        ;-------------------------------------------------
 
        ;--------  init board  --------
        t_bell = 0
        if keyword_set(bell) then t_bell = 1    ; Ring bell when line complete?
        if n_elements(wt) eq 0 then wt = -1.    ; Time delay.
        if wt eq -1. then wt = 0.05             ; Default time delay.
        t_wait = wt                             ; Wait in sec between drops.
        if n_elements(t_hln) eq 0 then t_hln = 0  ; High scores.
        if n_elements(t_hpc) eq 0 then t_hpc = 0
        if n_elements(t_hsc) eq 0 then t_hsc = 0
        t_nx = 11                               ; Size in X. (+1)
        t_ny = 21                               ; Size in Y. (+1)
        t_brd = bytarr(t_nx-1, t_ny)            ; Board.

        ;-----  Set up random starting pieces  -----
        ;-----  If level < 0 then plot these pieces in gray (8) ----
        if abs(lev) gt 0 then begin
          lset = (byte(randomu(i,t_nx-1,abs(lev))*8)<7B)* $
                 byte(randomu(i,t_nx-1,abs(lev)) gt .5)
          if lev lt 0 then lset = 8*(lset ne 0)          
          t_brd(0,0) = lset
        endif


        ;--------  Set up piece color array  -------
        t_ca = [1,2,3,4,5,6,7,8]

        ;--------  Set up pieces  ------
        ;--------  As offsets:  ----------
        ;---  Set up X offsets for 7 4 part pieces, each with 4 rotations --
        t_pxa = intarr(4,4,7)
        t_pxa(0,0,0) = [[0,1,0,1], $   ; Piece # 0:  X X
                        [0,1,0,1], $   ;             X X
                        [0,1,0,1], $
                        [0,1,0,1]]

        t_pxa(0,0,1) = [[-2,-1,0,1], $ ; Piece # 1: X X X X
                        [0,0,0,0], $
                        [-2,-1,0,1],$
                        [0,0,0,0]]

        t_pxa(0,0,2) = [[-1,0,1,0], $  ; Piece # 2:  X X X
                        [0,0,0,1], $   ;               X
                        [-1,0,1,0], $
                        [0,0,0,-1]]

        t_pxa(0,0,3) = [[-1,0,0,1], $  ; Piece # 3:    X X
                        [0,0,-1,-1], $ ;                 X X
                        [0,-1,-1,-2], $
                        [-1,-1,0,0]]

        t_pxa(0,0,4) = [[-1,0,0,1], $  ; Piece # 4:      X X
                        [-1,-1,0,0], $ ;               X X
                        [0,-1,-1,-2], $
                        [0,0,-1,-1]]

        t_pxa(0,0,5) = [[-1,0,1,1],$   ; Piece # 5:    X X X
                        [0,0,0,1], $   ;                   X
                        [1,0,-1,-1], $
                        [0,0,0,-1]]

        t_pxa(0,0,6) = [[1,0,-1,-1],$  ; Piece # 6:    X X X
                        [0,0,0,1],$    ;               X
                        [-1,0,1,1],$
                        [0,0,0,-1]]

        ;---  Set up Y offsets for 7 4 part pieces, each with 4 rotations --
        t_pya = intarr(4,4,7)

        t_pya(0,0,0) = [[0,0,1,1],[0,0,1,1],[0,0,1,1],[0,0,1,1]]
        t_pya(0,0,1) = [[0,0,0,0],[-2,-1,0,1],[0,0,0,0],[-2,-1,1,0]]
        t_pya(0,0,2) = [[0,0,0,-1],[-1,0,1,0],[0,0,0,1],[1,0,-1,0]]
        t_pya(0,0,3) = [[0,0,-1,-1],[0,-1,-1,-2],[-1,-1,0,0],[-1,0,0,1]]
        t_pya(0,0,4) = [[-1,-1,0,0],[0,-1,-1,-2],[0,0,-1,-1],[-1,0,0,1]]
        t_pya(0,0,5) = [[0,0,0,-1],[-1,0,1,1],[0,0,0,1],[1,0,-1,-1]]
        t_pya(0,0,6) = [[0,0,0,-1],[1,0,-1,-1],[0,0,0,1],[-1,0,1,1]]

        ;------  Setup pieces as outlines  ---------
        t_pflst = [3,3,7,7,7,5,5]       ; Last outline point #.
        t_pfxa = intarr(8,4,7)
        t_pfxa(0,0,0) = [[0,2,2,0,0,0,0,0],$
                         [0,2,2,0,0,0,0,0],$
                         [0,2,2,0,0,0,0,0],$
                         [0,2,2,0,0,0,0,0]]
        t_pfxa(0,0,1) = [[-2,2,2,-2,0,0,0,0],$
                         [0,1,1,0,0,0,0,0],$
                         [-2,2,2,-2,0,0,0,0],$
                         [0,1,1,0,0,0,0,0]]
        t_pfxa(0,0,2) = [[-1,0,0,1,1,2,2,-1],$
                         [0,1,1,2,2,1,1,0],$
                         [-1,2,2,1,1,0,0,-1],$
                         [-1,0,0,1,1,0,0,-1]]
        t_pfxa(0,0,3) = [[-1,0,0,2,2,1,1,-1],$
                         [-1,0,0,1,1,0,0,-1],$
                         [-2,-1,-1,1,1,0,0,-2],$
                         [-1,0,0,1,1,0,0,-1]]
        t_pfxa(0,0,4) = [[-1,1,1,2,2,0,0,-1],$
                        [0,1,1,0,0,-1,-1,0],$
                        [-2,0,0,1,1,-1,-1,-2],$
                        [0,1,1,0,0,-1,-1,0]]
        t_pfxa(0,0,5) = [[-1,1,1,2,2,-1,0,0],$
                         [0,1,1,2,2,0,0,0],$
                         [-1,2,2,0,0,-1,0,0],$
                         [-1,1,1,0,0,-1,0,0]]
        t_pfxa(0,0,6) = [[-1,0,0,2,2,-1,0,0],$
                         [0,2,2,1,1,0,0,0],$
                         [-1,2,2,1,1,-1,0,0],$
                         [0,1,1,-1,-1,0,0,0]]
        t_pfya = intarr(8,4,7)
        t_pfya(0,0,0) = [[0,0,2,2,0,0,0,0],$
                         [0,0,2,2,0,0,0,0],$
                         [0,0,2,2,0,0,0,0],$
                         [0,0,2,2,0,0,0,0]]
        t_pfya(0,0,1) = [[0,0,1,1,0,0,0,0],$
                         [-2,-2,2,2,0,0,0,0],$
                         [0,0,1,1,0,0,0,0],$
                         [-2,-2,2,2,0,0,0,0]]
        t_pfya(0,0,2) = [[0,0,-1,-1,0,0,1,1],$
                         [-1,-1,0,0,1,1,2,2],$
                         [0,0,1,1,2,2,1,1],$
                         [0,0,-1,-1,2,2,1,1]]
        t_pfya(0,0,3) = [[0,0,-1,-1,0,0,1,1],$
                         [-2,-2,-1,-1,1,1,0,0],$
                         [0,0,-1,-1,0,0,1,1],$
                         [-1,-1,0,0,2,2,1,1]]
        t_pfya(0,0,4) = [[-1,-1,0,0,1,1,0,0],$
                         [-2,-2,0,0,1,1,-1,-1],$
                         [-1,-1,0,0,1,1,0,0],$
                         [-1,-1,1,1,2,2,0,0]]
        t_pfya(0,0,5) = [[0,0,-1,-1,1,1,0,0],$
                         [-1,-1,1,1,2,2,0,0],$
                         [0,0,1,1,2,2,0,0],$
                         [-1,-1,2,2,0,0,0,0]]
        t_pfya(0,0,6) = [[-1,-1,0,0,1,1,0,0],$
                         [-1,-1,0,0,2,2,0,0],$
                         [0,0,2,2,1,1,0,0],$
                         [-1,-1,2,2,1,1,0,0]]

        ;-------  Scale board to screen  --------
        plot,[0,t_nx-1],[0,t_ny-1],position=[.1,.1,.4,.9],/xsty,/ysty,/nodata
        ;-------  Outline board  -----------------
        erase
        polyfill, [-1,t_nx, t_nx, -1], [-1, -1, t_ny, t_ny], $
          color=10
        polyfill, [-1,t_nx, t_nx, -1], [-1, -1, t_ny, t_ny], $
          color=9, spacing=.15, orient=0
        polyfill, [-1,t_nx, t_nx, -1], [-1, -1, t_ny, t_ny], $
          color=9, spacing=.15, orient=90
        polyfill,[-.2,t_nx-.8,t_nx-.8,-.2],$
          [-.2,-.2,t_ny-.8,t_ny-.8]
        polyfill,[0,1,1,0]*(t_nx-1),[0,0,1,1]*(t_ny-1), color=0
        plots,[-1,t_nx,t_nx,-1,-1],[-1,-1,t_ny,t_ny,-1],thick=3

        ;------  Show starting board  --------
        if abs(lev) gt 0 then begin
          for iy = 0, abs(lev) do begin
            for ix = 0, t_nx-2 do begin
              c = t_brd(ix,iy)
              polyfill, [0,1,1,0]+ix, [0,0,1,1]+iy, color=c
            endfor
          endfor
        endif

        ;------  Menu  -----
        xyouts, 350-25, 280+30, /dev, size=1.2, '!3J = Move left'
        xyouts, 475, 280+30, /dev, size=1.2, 'L = Move right'
        xyouts, 350-25, 260+30, /dev, size=1.2, 'SPACE = Rotate'
        xyouts, 475, 260+30, /dev, size=1.2, 'H = Help'
        xyouts, 475, 240+30, /dev, size=1.2, 'Q = Quit'
        xyouts, 350-25, 240+30, /dev, size=1.2, 'S = Start'
        xyouts, 350-25, 220+30, /dev, size=1.2, 'P = Pause/unpause'


        xyouts, 420, 190, 'Game', size=1.8, /dev
        xyouts, 520, 190, 'Session', size=1.8, /dev
        xyouts, 320, 160, 'Pieces:',size=1.8, /dev
        xyouts, 320, 130, 'Lines:',size=1.8, /dev
        xyouts, 320, 100, 'Score:',size=1.8, /dev

        t_pc = 0        ; Current score.
        t_ln = 0
        t_sc = 0
        xyouts, /dev, 420, 160, size=1.8, strtrim(t_pc,2)
        xyouts, /dev, 520, 160, size=1.8, strtrim(t_hpc,2)
        xyouts, /dev, 420, 130, size=1.8, strtrim(t_ln, 2)
        xyouts, /dev, 520, 130, size=1.8, strtrim(t_hln, 2)
        xyouts, /dev, 420, 100, size=1.8, strtrim(t_sc, 2)
        xyouts, /dev, 520, 100, size=1.8, strtrim(t_hsc, 2)


        ;-------  Load color table  --------
        tvlct, $
          [0,255,255,127,255,127,255,127,128,255,  0,  0,255,255,255,255],$
          [0,127,127,255,255,127,189,255,128,255,  0,255,  0,255,255,255],$
          [0,127,255,255,127,255,127,127,128,255,255,233,  0,  0,  0,255]

        ;---------  Make title  --------
        xyouts, 25+300, 400+15, /dev, size=3, '!17IDL Tetris', color=10
        xyouts, 25+301, 401+15, /dev, size=3, '!17IDL Tetris', color=10
        xyouts, 25+302, 402+15, /dev, size=3, '!17IDL Tetris', color=11
        xyouts, 25+303, 403+15, /dev, size=3, '!17IDL Tetris', color=11
        xyouts, 25+304, 404+15, /dev, size=3, '!17IDL Tetris', color=12
        xyouts, 25+305, 405+15, /dev, size=3, '!17IDL Tetris', color=12
        xyouts, 25+306, 406+15, /dev, size=3, '!17IDL Tetris', color=13
        xyouts, 25+307, 407+15, /dev, size=3, '!17IDL Tetris', color=13

        xyouts, /dev, size=2, 23+392, 370+13, '!13by', color=12
        xyouts, /dev, size=2, 23+342, 336+13, '!13Ray Sterner!3', color=12
        xyouts, /dev, size=2, 24+392, 370+14, '!13by', color=12
        xyouts, /dev, size=2, 24+342, 336+14, '!13Ray Sterner!3', color=12
        xyouts, /dev, size=2, 25+392, 370+15, '!13by', color=6
        xyouts, /dev, size=2, 25+342, 336+15, '!13Ray Sterner!3', color=6


        return
        end

;======================================================================
;--------  t_next = get next piece ready  ------
;       R. Sterner, 23 Jun, 1991

        pro t_next, pn

        common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
           t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
           t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
           t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc
 
        if n_elements(pn) eq 0 then begin
          t_p = byte(randomu(t_seed)*7)  ; Pick a random piece #.
        endif else t_p = pn          ; Use selected piece number.
        t_r = 0                      ; Start in standard position.
        t_c = t_ca(t_p)              ; Look up piece color.
        t_px = t_pxa(*, t_r, t_p)    ; Pull out correct offsets.
        t_py = t_pya(*, t_r, t_p)
        t_pfx = t_pfxa(0:t_pflst(t_p),t_r,t_p)    ; Extract outline.
        t_pfy = t_pfya(0:t_pflst(t_p),t_r,t_p)
        t_x = t_nx/2                 ; Starting position.
        t_y = t_ny

        return
        end

;======================================================================
;-------  t_drop = drop a piece one position  ------
;       R. Sterner, 23 Jun, 1991

        pro t_drop, done=done, range=range
 
       common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
           t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
           t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
           t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc
 
        t_plot, 0       ; Erase current position.
        t_y = t_y - 1   ; Drop one position.

        flag = 0                                ; Undo flag.
        if min(t_y + t_py) lt 0 then flag = 1   ; Hit bottom.
        if max(t_brd(t_x+t_px, t_y+t_py)) gt 0 then flag = 1    ; Collision.

        done = 0                                ; Assume not done yet.
        if flag eq 1 then begin                 ; Done.
          t_y = t_y + 1                         ; Can't move down.
          t_brd(t_x+t_px, t_y+t_py) = t_c       ; Update board with color.
          done = 1                              ; Set done flag.
          range = [min(t_y+t_py), max(t_y+t_py)]  ; Range to check.
        endif

        t_plot, 1       ; Plot new position.
        wait, t_wait

        return
        end

;======================================================================
;-------  t_left = move piece one position left ------
;       R. Sterner, 23 Jun, 1991

        pro t_left

        common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
           t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
           t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
           t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc
 
        t_plot, 0                               ; Erase current position.

        t_x = t_x - 1                           ; Shift left 1.

        flag = 0                                ; Undo flag.
        if min(t_x + t_px) lt 0 then flag = 1   ; Out of bounds.
        if max(t_brd(t_x+t_px, t_y+t_py)) gt 0 then flag = 1    ; Collision.

        if flag eq 1 then t_x = t_x + 1         ; Undo.

        t_plot, 1                               ; Plot new position.

        return
        end


;======================================================================
;-------  t_right = move piece one position right ------
;       R. Sterner, 23 Jun, 1991

        pro t_right

        common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
           t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
           t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
           t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc
 
        t_plot, 0             ; Erase current position.

        t_x = t_x + 1         ; Shift right 1.
                              
        flag = 0              ; Undo flag.
        if max(t_x + t_px) gt (t_nx-2) then flag = 1    ; Out of bounds.
        if max(t_brd(t_x+t_px, t_y+t_py)) gt 0 then flag = 1    ; Collision.

        if flag eq 1 then t_x = t_x - 1                 ; Undo.

        t_plot, 1                                       ; Plot new position.

        return
        end

;======================================================================
;-------  t_rot = rotate a piece one position  ------
;       R. Sterner, 23 Jun, 1991

        pro t_rot

        common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
           t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
           t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
           t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc
 
        t_plot, 0               ; Erase current position.

        t_r = (t_r + 1) mod 4   ; Rotate.
        t_px = t_pxa(*,t_r,t_p) ; Extract new offsets.
        t_py = t_pya(*,t_r,t_p)
        t_pfx = t_pfxa(0:t_pflst(t_p),t_r,t_p)    ; Extract outline.
        t_pfy = t_pfya(0:t_pflst(t_p),t_r,t_p)
 
        ;----  Check for out of bounds or collision. -----
        flag = 0                ; Undo flag.
        ;------  Don't rotate out the sides  ---------
        if (min(t_x+t_px) lt 0) or (max(t_x+t_px) gt (t_nx-2)) then flag = 1
        ;------  Don't rotate out the bottom  -----
        if (min(t_y+t_py) lt 0) then flag = 1
        ;------  Check collision with another piece  ------
        if max(t_brd(t_x+t_px, t_y+t_py)) gt 0 then flag = 1    ; Collision.
        if flag eq 1 then begin    ; Undo.
          t_r = (t_r + 3) mod 4    ; Rotate 270 = -90.
          t_px = t_pxa(*,t_r,t_p)  ; Extract new offsets.
          t_py = t_pya(*,t_r,t_p)
          t_pfx = t_pfxa(0:t_pflst(t_p),t_r,t_p)    ; Extract outline.
          t_pfy = t_pfya(0:t_pflst(t_p),t_r,t_p)
        endif

        t_plot, 1               ; Plot new position.

        return
        end

;======================================================================
;------  t_plot.pro = Erase or draw current tetris piece  ---------
;       R. Sterner, 23 Jun, 1991

        pro t_plot, flag

        common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
           t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
           t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
           t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc
 
        c = 0
        if flag eq 1 then c = t_c

        if max(t_y+t_pfy) lt t_ny then begin
          polyfill, t_x+t_pfx, t_y+t_pfy, color=c
        endif

        return
        end

;======================================================================
;-------  t_score = Look for and process a score.  ------
;       R. Sterner, 23 Jun, 1991

        pro t_score, r

        common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
           t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
           t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
           t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc

        ;---------  Add score for this piece  --------
        xyouts, 420, 100, /dev, size=1.8, strtrim(t_sc,2), color=0
        t_sc = t_sc + 7      ; Each piece worth 7 pts.
        xyouts, 420, 100, /dev, size=1.8, strtrim(t_sc,2)
 
        count = 0                                 ; Lines scored on piece.
        rn = (r(0)+indgen(r(1)-r(0)+1))<(t_ny-1)  ; Range to check.
        for i = 0, n_elements(rn)-1 do begin      ; Check each line.
          if total(t_brd(*,rn(i)) eq 0) eq 0 then begin  ; Score.
           ;---  light up score line  ----
            xp = [0.01,.99,.99,0.01]*(t_nx-1)
            yp = [0.05,0.05,.99,.99]+rn(i)
            polyfill, xp,yp,color=0,spacing=.1,orient=0
            polyfill, xp,yp,color=0,spacing=.1,orient=90
            wait, 0
            ;---  ring bell  -----
            if t_bell then print,string(7b),form='($,a1)'
            ;---  Collapse board  -------
            t_brd(0,rn(i)) = t_brd(*,(rn(i)+1):*)
            ;---  Repaint screen board  -----
            tmp = fltarr(t_ny)
            for j = 0, t_ny-1 do tmp(j) = total(t_brd(*,j))
            mx = 1+max(where(tmp ne 0))
            for z = 0.8, 0., -.2 do begin
            for iy = rn(i), mx do begin
              for ix = 0, t_nx-2 do begin
                c = t_brd(ix,iy)
                polyfill, [0,1,1,0]+ix, (z+[0,0,1,1]+iy)<(t_ny-1), color=c
              endfor
            endfor
            endfor  ; Z
            ;---  Decrement range  ------
            rn = rn - 1
            ;----  Count scored line  -----
            count = count + 1
            ;---  Update score board  -----
            xyouts, 420, 130, /dev, size=1.8, strtrim(t_ln,2), color=0
            t_ln = t_ln + 1
            xyouts, 420, 130, /dev, size=1.8, strtrim(t_ln,2)
            xyouts, 420, 100, /dev, size=1.8, strtrim(t_sc,2), color=0
            t_sc = t_sc + 22      ; Each line worth 22 pts.
            xyouts, 420, 100, /dev, size=1.8, strtrim(t_sc,2)
           endif
        endfor
       
        ;--------  Check for a tetris (4 lines scored on 1 piece) ----
        if count eq 4 then begin
          xyouts, 420, 100, /dev, size=1.8, strtrim(t_sc,2), color=0
          t_sc = t_sc + 48      ; 48 extra points.
          xyouts, 420, 100, /dev, size=1.8, strtrim(t_sc,2)
        endif

        return
        end

;======================================================================
;-------  t_help.pro = display help text  --------
;       R. Sterner, 4 Aug, 1991

        pro t_help

	ver	= WIDGET_INFO(/VERSION)
        if ver.style eq 'MS Windows' then device, set_display=2
        print,' '
        print,' Tetris has 7 different playing pieces which drop down'
        print,' from the top of the screen. Points are scored by'
        print,' fitting these pieces together to form horizontal rows'
        print,' having no gaps. Such complete rows dissolve away and add'
        print," to the player's score. Pieces may be moved left and right"
        print,' and rotated to fit together. The more rows completed the'
        print,' higher the score each newly completed row is worth.'
        print,' Extra credit is given for completing 4 rows at the same'
        print,' time.  Upper or lower case key commands may be used, except'
        print,' that the Q (quit) command must be upper case.'
        print,' Both the current game scores and the highest score during'
        print,' the current session of IDL are displayed.'
        print,' '
        print,' The first version of this project was written using PC IDL'
        print,' in an afternoon as a test of the capabilities of IDL on a'
        print,' 386 class machine.'
        print,' 
        txt = ''
        read,' Press RETURN to continue', txt
        if ver.style eq 'MS Windows' then device, set_display=3
        return
        end

;======================================================================
;;------  tetris.pro main tetris routine  ------
;       R. Sterner, 23 Jun, 1991

        pro tetris, wait=wt, level=lev, help=hlp, bell=bell, $
          top=top
 
;+
; NAME:
;	TETRIS
;
; PURPOSE:
;	IDL version of the falling blocks game Tetris.
;
;	The object of this game is to build solid rows of blocks from the
;	differently-shaped falling pieces.
;
; CATEGORY:
;	Games.
;
; CALLING SEQUENCE:
;	TETRIS
;
; INPUTS:
;	No required inputs.
;
; OUTPUTS:
;	No explicit outputs.
;
; OPTIONAL KEYWORD PARAMETERS:
;	WAIT:	The delay between moves in seconds.  This parameter adjusts
;		the playing speed.  The default is 0.05, which may be too
;		low for faster machines (or beginning players).
;
;	LEVEL:	Level of random starting pieces, default = 0.
;
;	HELP:	Set this keyword to display help text.
;
;	BELL:	Set this keyword to ring the bell for each line scored.
;
; COMMON BLOCKS:
;	Some.
;
; SIDE EFFECTS:
;	A window is created for the game.
;	Interaction is via keyboard and display.
;
; MODIFICATION HISTORY:
;	Written by Ray Sterner, Johns-Hopkins Applied Physics Research Lab
;				23 and 25 June, 1991
;-
 
       common t_com, t_nx, t_ny, t_brd, t_p, t_seed, t_r, t_x, t_y, $
           t_pxa, t_pya, t_px, t_py, t_ca, t_c, $
           t_bell, t_wait, t_pflst, t_pfxa, t_pfya, t_pfx, t_pfy, $
           t_pc, t_hpc, t_ln, t_hln, t_sc, t_hsc

        if keyword_set(hlp) then begin
          print,' Play tetris game.'
          print,' tetris'
          print,' Keywords:'
          print,'   WAIT=tm  Seconds between pieces (def=.05).'  
          print,'     tm = 0 is very fast, 0.1 is slow.'
          print,'   LEVEL=L  Level of random starting pieces (def=0).'
          print,'     If L is negative then starting pieces are gray.'
          print,"   /BELL means ring bell for each line scored."
          print,'   TOP=tp returns highest level for each piece played.'
          print,'     Games are delimited by -1s.'
          return
        endif

        if n_elements(wt) eq 0 then wt = -1.
        if wt eq -1. then wt = 0.05
        if n_elements(lev) eq 0 then lev = 0

        top = [-1]      ; Start TOP array.

start:  t_init, wt, lev, bell=bell

        ;-------  Find top  ----------
        tmp = fltarr(t_ny)
        for j = 0, t_ny-1 do tmp(j) = total(t_brd(*,j))
        mx = 1+max(where(tmp ne 0))
        top = [top,mx]

rd:     k = strupcase(get_kbrd(1))
        if (k eq 'H') then begin
          t_help
          goto, rd
        endif
        if k eq 'Q' then return
        if k ne 'S' then goto, rd

loop1:  t_next

loop2:  ku = strupcase(get_kbrd(0))   ; Get key.
        if ku eq ' ' then t_rot       ; Rotate.
        if ku eq 'J' then t_left     ; Move left.
        if ku eq 'L' then t_right    ; Move right.
        if ku eq 'Q' then goto, over  ; Game over.
        if ku eq 'P' then begin      ; Pause.
          ku = get_kbrd(1)
          goto, loop2
        endif
        t_drop, done=d, range=r      ; Drop piece.

        if d eq 1 then begin              ; Piece done moving.
          ;-------  Find top  ----------
          tmp = fltarr(t_ny)
          for j = 0, t_ny-1 do tmp(j) = total(t_brd(*,j))
          mx = 1+max(where(tmp ne 0))
          top = [top,mx]
          if min(r) ge t_ny-1 then begin  ; Game over?
           goto, over
          endif 
          ;------  Erase current score.  ------
          xyouts, /dev, 420, 160, size=1.8, strtrim(t_pc,2),color=0
          t_pc = t_pc + 1
          xyouts, /dev, 420, 160, size=1.8, strtrim(t_pc,2)
          t_score, r                      ; Update score.
          goto, loop1
        endif

        goto, loop2

        ;------  Game over  -------
over:   polyfill, [0,1,1,0]*(t_nx-1), [0,0,1,1]*(t_ny-1),$
          color=0, spacing=.1, orient=0
        polyfill, [0,1,1,0]*(t_nx-1), [0,0,1,1]*(t_ny-1),$
          color=0, spacing=.1, orient=90

        ;--------  Wait for another start command.  ------
loopw:  ku = strupcase(get_kbrd(1))


        ;---------  Update session max values.  -----
        if (ku eq 'S') or (ku eq 'Q') then begin
          xyouts,/dev,size=1.8,520,160,strtrim(t_hpc,2),color=0
          t_hpc = t_hpc > t_pc 
          xyouts,/dev,size=1.8,520,160,strtrim(t_hpc,2)
          xyouts,/dev,size=1.8,520,130,strtrim(t_hln,2),color=0
          t_hln = t_hln > t_ln 
          xyouts,/dev,size=1.8,520,130,strtrim(t_hln,2)
          xyouts,/dev,size=1.8,520,100,strtrim(t_hsc,2),color=0
          t_hsc = t_hsc > t_sc 
          xyouts,/dev,size=1.8,520,100,strtrim(t_hsc,2)
        endif

        ;---------  Handle S or Q  ---------
        if ku eq 'S' then begin
          t_init, wt, lev, bell=bell
          top = [top,-1]
          ;-------  Find top  ----------
          tmp = fltarr(t_ny)
          for j = 0, t_ny-1 do tmp(j) = total(t_brd(*,j))
          mx = 1+max(where(tmp ne 0))
          top = [top,mx]
          goto, loop1
        endif
        if ku ne 'Q' then goto, loopw

        end