#!/bin/sh
#
# This is a shell archive.  To extract its contents,
# execute this file with /bin/sh to create the file(s):
#
# altris.4gl	    makefile		makefile.gnu	    random.c
# key_press.c
#
# This shell archive created: Fri Feb  8 13:42:51 EST 2002
#
echo "Extracting file altris.4gl"
sed -e 's/^X//' <<\SHAR_EOF > altris.4gl
X# ALTRIS - Written by Alex Carmichael
X# alex.carmichael@medas.co.uk
X
XDEFINE
X    ma_piece         ARRAY[10,4,4] OF SMALLINT,
X    ma_grid          ARRAY[35,21,2] OF SMALLINT,
X    ma_old           ARRAY[35,21] OF SMALLINT,
X    ms_x             SMALLINT,
X    ms_y             SMALLINT,
X    ms_old_x         SMALLINT,
X    mb_tamper        SMALLINT,
X    mb_too_right     SMALLINT,
X    ms_curr_piece    SMALLINT,
X    ms_curr_rotation SMALLINT,
X    mb_erase         SMALLINT,
X    mt_time          DATETIME YEAR TO FRACTION(3),
X    mi_delay         INTERVAL HOUR TO FRACTION(3),
X    ms_score         SMALLINT,
X    ms_level         SMALLINT,
X    ms_lines         SMALLINT,
X    mb_drop          SMALLINT,
X    mb_done          SMALLINT,
X    ms_size          SMALLINT,
X    ms_left          SMALLINT,
X    ms_right         SMALLINT,
X    ms_rotate        SMALLINT,
X    ms_drop          SMALLINT,
X    ms_start_level   SMALLINT,
X    ms_difficulty    SMALLINT,
X    mc_extended      CHAR(1)
X
XMAIN
X    DEFINE
X        ls_key SMALLINT
X
X    CALL randomize()
X    CALL init_term()
X    RUN "tput civis"
X    CALL init_piece()
X    CALL piece_data()
X    CALL init_default()
X
X    OPEN WINDOW Tetris AT 1,1 WITH 22 ROWS, 78 COLUMNS
X
X    CALL draw_screen()
X    CALL draw_score()
X    CALL draw_grid("D")
X
X    WHILE 1=1
X        LET ls_key = key_press()
X        CASE
X           WHEN ls_key = 80
X               CALL draw_options("E")
X               CALL altris_main()
X               CALL draw_options("D")
X           WHEN ls_key = 69
X               EXIT WHILE
X           WHEN ls_key = 82
X               IF ms_size > 6 THEN 
X                   CALL draw_grid("E")
X                   LET ms_size = ms_size - 1
X                   CALL draw_grid("D")
X               END IF
X           WHEN ls_key = 73
X               IF ms_size < 35 THEN 
X                   CALL draw_grid("E")
X                   LET ms_size = ms_size + 1
X                   CALL draw_grid("D")
X               END IF
X           WHEN ls_key = 75
X               CALL define_keys()
X           WHEN ls_key = 76
X               LET ms_start_level = ms_start_level + 1
X               IF ms_start_level = 10 THEN
X                   LET ms_start_level = 1
X               END IF
X               DISPLAY ms_start_level AT 10,53
X           WHEN ls_key = 68
X               LET ms_difficulty = ms_difficulty + 1
X               IF ms_difficulty = 10 THEN
X                   LET ms_difficulty = 1
X               END IF
X               DISPLAY ms_difficulty AT 11,53
X           WHEN ls_key = 88
X               IF mc_extended = "Y" THEN
X                   LET mc_extended = "N"
X               ELSE
X                   LET mc_extended = "Y"
X               END IF
X               DISPLAY mc_extended AT 13,53
X        END CASE
X    END WHILE
X
X    CLOSE WINDOW Tetris
X
X    RUN "tput cvvis"
X    CALL end_term()
X
XEND MAIN
X
XFUNCTION altris_main()
X
X    DEFINE
X       lt_interval  INTERVAL HOUR TO FRACTION(3)
X
X    CALL init_game()
X    CALL init_grid()
X    CALL new_piece()
X    CALL draw_piece()
X
X    WHILE 1=1
X
X        IF mb_done THEN 
X            EXIT WHILE
X        END IF
X        IF mb_erase THEN
X            CALL erase_piece()
X        END IF
X        CALL draw_piece()
X        CALL delay()
X        CALL lower_piece()
X
X    END WHILE
X
XEND FUNCTION ---altris_main---
X
XFUNCTION init_piece()
X
X    DEFINE
X        ls_1 SMALLINT,
X        ls_2 SMALLINT,
X        ls_3 SMALLINT
X
X    FOR ls_1 = 1 TO 10
X        FOR ls_2 = 1 TO 4
X            FOR ls_3 = 1 TO 4
X                LET ma_piece[ls_1,ls_2,ls_3] = -1
X            END FOR ---ls_3---
X        END FOR ---ls_2---
X    END FOR ---ls_1---
X
XEND FUNCTION ---init_piece---
X
X
XFUNCTION piece_data()
X
X    --- Left big
X
X    # "  X"
X    # "XXX"
X    
X    LET ma_piece[1,1,1] = 2
X    LET ma_piece[1,1,2] = 4
X    LET ma_piece[1,1,3] = 5
X    LET ma_piece[1,1,4] = 6
X    
X    # "XX"
X    # " X"
X    # " X"
X    
X    LET ma_piece[1,2,1] = 0
X    LET ma_piece[1,2,2] = 1
X    LET ma_piece[1,2,3] = 5
X    LET ma_piece[1,2,4] = 9
X    
X    # "XXX"
X    # "X"
X    
X    LET ma_piece[1,3,1] = 0
X    LET ma_piece[1,3,2] = 1
X    LET ma_piece[1,3,3] = 2
X    LET ma_piece[1,3,4] = 4
X
X    # "X"
X    # "X
X    # "XX"
X    
X    LET ma_piece[1,4,1] = 0
X    LET ma_piece[1,4,2] = 4
X    LET ma_piece[1,4,3] = 8
X    LET ma_piece[1,4,4] = 9
X    
X    --- Stick
X
X    # "XXXX"
X    
X    LET ma_piece[2,1,1] = 4
X    LET ma_piece[2,1,2] = 5
X    LET ma_piece[2,1,3] = 6
X    LET ma_piece[2,1,4] = 7
X    
X    # "X"
X    # "X"
X    # "X"
X    # "X"
X    
X    LET ma_piece[2,2,1] = 0
X    LET ma_piece[2,2,2] = 4
X    LET ma_piece[2,2,3] = 8
X    LET ma_piece[2,2,4] = 12
X    
X    --- Left small
X    
X    # " XX"
X    # "XX"
X    
X    LET ma_piece[3,1,1] = 1
X    LET ma_piece[3,1,2] = 2
X    LET ma_piece[3,1,3] = 4
X    LET ma_piece[3,1,4] = 5
X    
X    # "X"
X    # "XX
X    # " X"
X    
X    LET ma_piece[3,2,1] = 0
X    LET ma_piece[3,2,2] = 4
X    LET ma_piece[3,2,3] = 5
X    LET ma_piece[3,2,4] = 9
X    
X    --- Right small
X    
X    # "XX"
X    # " XX"
X    
X    LET ma_piece[4,1,1] = 0
X    LET ma_piece[4,1,2] = 1
X    LET ma_piece[4,1,3] = 5
X    LET ma_piece[4,1,4] = 6
X    
X    # " X"
X    # "XX"
X    # "X"
X    
X    LET ma_piece[4,2,1] = 1
X    LET ma_piece[4,2,2] = 4
X    LET ma_piece[4,2,3] = 5
X    LET ma_piece[4,2,4] = 8
X    
X    --- Right big
X    
X    # "XXX"
X    # "  X"
X    
X    LET ma_piece[5,1,1] = 0
X    LET ma_piece[5,1,2] = 1
X    LET ma_piece[5,1,3] = 2
X    LET ma_piece[5,1,4] = 6
X    
X    # "XX"
X    # "X"
X    # "X"
X    
X    LET ma_piece[5,2,1] = 0
X    LET ma_piece[5,2,2] = 1
X    LET ma_piece[5,2,3] = 4
X    LET ma_piece[5,2,4] = 8
X    
X    # "X"
X    # "XXX"
X    
X    LET ma_piece[5,3,1] = 0
X    LET ma_piece[5,3,2] = 4
X    LET ma_piece[5,3,3] = 5
X    LET ma_piece[5,3,4] = 6
X    
X    # " X"
X    # " X"
X    # "XX"
X    
X    LET ma_piece[5,4,1] = 1
X    LET ma_piece[5,4,2] = 5
X    LET ma_piece[5,4,3] = 8
X    LET ma_piece[5,4,4] = 9
X    
X    --- Thingy
X    
X    # " X "
X    # "XXX"
X    
X    LET ma_piece[6,1,1] = 1
X    LET ma_piece[6,1,2] = 4
X    LET ma_piece[6,1,3] = 5
X    LET ma_piece[6,1,4] = 6
X    
X    # " X"
X    # "XX"
X    # " X"
X    
X    LET ma_piece[6,2,1] = 1
X    LET ma_piece[6,2,2] = 4
X    LET ma_piece[6,2,3] = 5
X    LET ma_piece[6,2,4] = 9
X    
X    # "XXX"
X    # " X "
X    
X    LET ma_piece[6,3,1] = 0
X    LET ma_piece[6,3,2] = 1
X    LET ma_piece[6,3,3] = 2
X    LET ma_piece[6,3,4] = 5
X    
X    # "X"
X    # "XX
X    # "X"
X    
X    LET ma_piece[6,4,1] = 0
X    LET ma_piece[6,4,2] = 4
X    LET ma_piece[6,4,3] = 5
X    LET ma_piece[6,4,4] = 8
X    
X    --- Block
X
X    # "XX"
X    # "XX"
X
X    LET ma_piece[7,1,1] = 0
X    LET ma_piece[7,1,2] = 1
X    LET ma_piece[7,1,3] = 4
X    LET ma_piece[7,1,4] = 5
X
X    --- X 1
X
X    # "X"
X    # "XX"
X
X    LET ma_piece[8,1,1] = 0
X    LET ma_piece[8,1,2] = 4
X    LET ma_piece[8,1,3] = 5
X    LET ma_piece[8,1,4] = 0
X
X    # " X"
X    # "XX"
X
X    LET ma_piece[8,2,1] = 1
X    LET ma_piece[8,2,2] = 4
X    LET ma_piece[8,2,3] = 5
X    LET ma_piece[8,2,4] = 1
X
X    # "XX"
X    # " X"
X
X    LET ma_piece[8,3,1] = 0
X    LET ma_piece[8,3,2] = 1
X    LET ma_piece[8,3,3] = 5
X    LET ma_piece[8,3,4] = 0
X
X    # "XX"
X    # "X "
X
X    LET ma_piece[8,4,1] = 0
X    LET ma_piece[8,4,2] = 1
X    LET ma_piece[8,4,3] = 4
X    LET ma_piece[8,4,4] = 0
X
X    --- X 2
X
X    # "X"
X
X    LET ma_piece[9,1,1] = 0
X    LET ma_piece[9,1,2] = 0
X    LET ma_piece[9,1,3] = 0
X    LET ma_piece[9,1,4] = 0
X
X    --- X 3
X
X    # "X X"
X    # "X X"
X
X    LET ma_piece[10,1,1] = 0
X    LET ma_piece[10,1,2] = 2
X    LET ma_piece[10,1,3] = 4
X    LET ma_piece[10,1,4] = 6
X
X    # "XX"
X    # "  "
X    # "XX"
X
X    LET ma_piece[10,2,1] = 0
X    LET ma_piece[10,2,2] = 1
X    LET ma_piece[10,2,3] = 8
X    LET ma_piece[10,2,4] = 9
X
XEND FUNCTION ---piece_data---
X
XFUNCTION translate_coor(ps_gridpos)
X
XDEFINE ps_gridpos SMALLINT
X
X    DEFINE
X        ls_x SMALLINT,
X        ls_y SMALLINT
X
X    LET ls_x = ps_gridpos MOD 4
X
X    LET ls_y = ps_gridpos / 4
X
X    RETURN ls_x,ls_y
X
XEND FUNCTION ---translate_coor---
X
XFUNCTION random_piece()
X
X    DEFINE 
X        ls_piece SMALLINT
X
X    IF mc_extended = "N" THEN
X        LET ls_piece = rnd(7) + 1
X    ELSE
X        LET ls_piece = rnd(10) + 1
X    END IF
X
X    RETURN ls_piece
X
XEND FUNCTION ---random_piece---
X
XFUNCTION init_grid()
X
X    DEFINE
X        ls_x SMALLINT,
X        ls_y SMALLINT
X
X    FOR ls_x = 1 TO ms_size
X        FOR ls_y = 1 TO 21
X            IF ls_y > (22 - ms_difficulty) THEN
X                IF rnd(3) = 0 THEN
X                    LET ma_grid[ls_x,ls_y,1] = 1
X                    LET ma_grid[ls_x,ls_y,2] = 1
X                ELSE
X                    LET ma_grid[ls_x,ls_y,1] = 0
X                    LET ma_grid[ls_x,ls_y,2] = 0
X                END IF
X            ELSE
X                LET ma_grid[ls_x,ls_y,1] = 0
X                LET ma_grid[ls_x,ls_y,2] = 0
X            END IF
X            IF ma_grid[ls_x,ls_y,1] = 0 THEN
X                CALL display_part(0,ls_x,ls_y)
X            ELSE
X                CALL display_part(ma_grid[ls_x,ls_y,2],ls_x,ls_y)
X            END IF
X        END FOR
X    END FOR
X
XEND FUNCTION ---init_grid---
X
XFUNCTION new_piece()
X
X    LET ms_x = ms_size / 2
X    LET ms_y = 1
X    LET ms_curr_piece = random_piece()
X    LET ms_curr_rotation = 1
X    LET mb_erase = FALSE
X    LET mb_drop = FALSE
X    LET mb_tamper = FALSE
X
X    IF NOT(can_move(ms_curr_piece,ms_curr_rotation,ms_x,ms_y)) THEN
X        LET mb_done = TRUE
X        DISPLAY "G A M E - O V E R !" AT 15,40
X    END IF
X
XEND FUNCTION ---new_piece---
X
XFUNCTION can_move(ps_piece,ps_rotation,ps_x,ps_y)
X
XDEFINE
X    ps_x        SMALLINT,
X    ps_y        SMALLINT,
X    ps_piece    SMALLINT,
X    ps_rotation SMALLINT
X
X    DEFINE
X        lb_ok    SMALLINT,
X        ls_part  SMALLINT,
X        ls_x     SMALLINT,
X        ls_y     SMALLINT 
X
X    LET lb_ok = TRUE
X    LET mb_too_right = FALSE
X
X    FOR ls_part = 1 TO 4
X        CALL translate_coor(ma_piece[ps_piece,
X                                     ps_rotation,
X                                     ls_part]) RETURNING ls_x, ls_y
X        LET ls_x = ls_x + ps_x
X        LET ls_y = ls_y + ps_y
X        IF ls_x < 1 OR ls_x > ms_size OR ls_y > 21 THEN
X            IF ls_x > ms_size THEN
X               LET mb_too_right = TRUE
X            END IF
X            LET lb_ok = FALSE
X        ELSE
X            IF ma_grid[ls_x,ls_y,1] = 1 THEN
X                LET lb_ok = FALSE
X            END IF
X        END IF
X    END FOR ---ls_part---
X
X    RETURN lb_ok
X             
XEND FUNCTION ---can_move---
X
XFUNCTION draw_piece()
X
X    DEFINE
X        ls_part SMALLINT,
X        ls_x    SMALLINT,
X        ls_y    SMALLINT
X
X    FOR ls_part = 1 TO 4
X        CALL translate_coor(ma_piece[ms_curr_piece,
X                                     ms_curr_rotation,
X                                     ls_part]) RETURNING ls_x, ls_y
X        LET ls_x = ms_x + ls_x
X        LET ls_y = ms_y + ls_y
X        CALL display_part(ms_curr_piece,ls_x,ls_y)
X        LET ma_old[ls_part,1] = ls_x
X        LET ma_old[ls_part,2] = ls_y
X        LET mb_erase = TRUE
X    END FOR ---ls_part---
X             
XEND FUNCTION ---draw_piece---
X
XFUNCTION rotate_piece()
X
X    DEFINE
X        ls_rotation SMALLINT,
X        ls_x        SMALLINT,
X        lb_rotate   SMALLINT
X
X    LET ls_rotation = ms_curr_rotation + 1
X
X    IF ls_rotation = 5 OR ma_piece[ms_curr_piece,ls_rotation,1] = -1 THEN
X        LET ls_rotation = 1
X    END IF
X 
X    LET lb_rotate = FALSE
X
X    IF mb_tamper THEN
X       LET ls_x = ms_old_x
X    ELSE
X       LET ls_x = ms_x
X    END IF
X
X    LET mb_tamper    = FALSE
X    LET mb_too_right = FALSE
X
X    WHILE TRUE
X       IF can_move(ms_curr_piece,ls_rotation,ls_x,ms_y) THEN
X           LET ms_curr_rotation = ls_rotation
X           IF ls_x != ms_x THEN
X              LET mb_tamper = TRUE
X              LET ms_old_x = ms_x
X           END IF
X           LET ms_x = ls_x
X           LET lb_rotate = TRUE
X           EXIT WHILE
X       ELSE
X           IF mb_too_right THEN
X              LET ls_x = ls_x - 1
X           ELSE
X              EXIT WHILE
X           END IF
X       END IF
X    END WHILE
X
X    RETURN lb_rotate
X
XEND FUNCTION ---rotate_piece---
X
XFUNCTION erase_piece()
X
X    DEFINE
X        ls_part SMALLINT,
X        ls_x    SMALLINT,
X        ls_y    SMALLINT
X
X    FOR ls_part = 1 TO 4
X        LET ls_x = ma_old[ls_part,1]
X        LET ls_y = ma_old[ls_part,2]
X        CALL display_part(0,ls_x,ls_y)
X    END FOR
X
XEND FUNCTION ---erase_part---
X
XFUNCTION delay()
X
X    DEFINE
X        ls_loop     SMALLINT,
X        lt_current  DATETIME YEAR TO FRACTION(3),
X        li_interval INTERVAL HOUR TO FRACTION(3)
X
X    IF NOT(mb_drop) THEN
X        WHILE 1 = 1
X            CALL detect_key()
X            LET lt_current = CURRENT
X            LET li_interval = lt_current - mt_time
X            IF li_interval >= mi_delay OR mb_drop THEN
X                LET mt_time = lt_current
X                EXIT WHILE
X            END IF
X        END WHILE
X    END IF
X
XEND FUNCTION ---delay---
X
XFUNCTION detect_key()
X
X    DEFINE
X        ls_char SMALLINT
X
X    LET ls_char = key_press()
X
X    CASE
X        WHEN ls_char = ms_left
X            IF move_left() THEN
X                IF mb_erase THEN
X                    CALL erase_piece()
X                END IF
X                CALL draw_piece()
X            END IF
X        WHEN ls_char = ms_right
X            IF move_right() THEN
X                IF mb_erase THEN
X                    CALL erase_piece()
X                END IF
X                CALL draw_piece()
X            END IF
X        WHEN ls_char = ms_rotate
X            IF rotate_piece() THEN
X                IF mb_erase THEN
X                    CALL erase_piece()
X                END IF
X                CALL draw_piece()
X            END IF
X        WHEN ls_char = ms_drop
X            LET mb_drop = TRUE
X        WHEN ls_char = 43
X            CLEAR SCREEN
X            RUN "tput cvvis"
X            EXIT PROGRAM
X    END CASE
X
XEND FUNCTION ---detect_key---
X
XFUNCTION move_left()
X
X    DEFINE
X        ls_x SMALLINT
X
X    LET ls_x = ms_x - 1
X
X    IF ls_x = 0 THEN
X        RETURN FALSE
X    END IF
X
X    IF can_move(ms_curr_piece,ms_curr_rotation,ls_x,ms_y) THEN
X        LET mb_tamper = FALSE
X        LET ms_x = ls_x
X    END IF
X
X    RETURN TRUE
X
XEND FUNCTION ---move_left---
X
XFUNCTION move_right()
X
X    DEFINE
X        ls_x SMALLINT
X
X    LET ls_x = ms_x + 1
X
X    IF ls_x = (ms_size + 1) THEN
X        RETURN FALSE
X    END IF
X
X    IF can_move(ms_curr_piece,ms_curr_rotation,ls_x,ms_y) THEN
X        LET mb_tamper = FALSE
X        LET ms_x = ls_x
X    END IF
X
X    RETURN TRUE
X
XEND FUNCTION ---move_right---
X
XFUNCTION lower_piece()
X
X    DEFINE
X        ls_part      SMALLINT,
X        ls_x         SMALLINT,
X        ls_y         SMALLINT,
X        lb_new_piece SMALLINT
X
X    LET lb_new_piece = FALSE
X
X    LET ls_y = ms_y + 1
X
X    IF ls_y = 22 THEN
X        LET lb_new_piece = TRUE
X    ELSE
X        LET lb_new_piece = NOT(can_move(ms_curr_piece,
X                                        ms_curr_rotation,ms_x,ls_y))
X    END IF
X
X    IF lb_new_piece THEN
X        FOR ls_part = 1 TO 4
X            CALL translate_coor(ma_piece[ms_curr_piece,
X                                         ms_curr_rotation,
X                                         ls_part]) RETURNING ls_x, ls_y
X            LET ls_x = ms_x + ls_x
X            LET ls_y = ms_y + ls_y
X            LET ma_grid[ls_x,ls_y,1] = 1
X            LET ma_grid[ls_x,ls_y,2] = ms_curr_piece
X        END FOR ---ls_part---
X        CALL draw_piece()
X        CALL check_line()
X        CALL new_piece()
X    ELSE
X        LET ms_y = ms_y + 1
X    END IF
X
XEND FUNCTION ---lower_piece---
X
XFUNCTION check_line()
X
X    DEFINE
X        lb_redraw  SMALLINT,
X        ls_line    SMALLINT,
X        lb_done    SMALLINT,
X        ls_redo    SMALLINT,
X        ls_x       SMALLINT,
X        ls_y       SMALLINT,
X        ls_check   SMALLINT,
X        ls_lines   SMALLINT
X
X    LET lb_redraw = FALSE
X    LET ls_lines = 0
X
X    FOR ls_line = 1 TO 21
X        LET lb_done = TRUE
X        FOR ls_check = 1 TO ms_size
X            IF ma_grid[ls_check,ls_line,1] = 0 THEN
X                LET lb_done = FALSE
X                EXIT FOR
X            END IF
X        END FOR ---ls_check---
X        IF lb_done THEN
X            LET lb_redraw = TRUE
X            LET ls_lines = ls_lines + 1
X            FOR ls_redo = (ls_line - 1) TO 1 STEP -1
X                LET ls_y = ls_redo + 1
X                FOR ls_x = 1 TO ms_size
X                    LET ma_grid[ls_x,ls_y,1] = ma_grid[ls_x,ls_redo,1]
X                    LET ma_grid[ls_x,ls_y,2] = ma_grid[ls_x,ls_redo,2]
X                END FOR ---ls_y---
X            END FOR ---ls_redo---
X        END IF
X    END FOR ---ls_line---
X
X    IF lb_redraw THEN
X        CALL increase_score(ls_lines)
X        FOR ls_y = 21 TO 1 STEP -1 
X            FOR ls_x = 1 TO ms_size
X                 IF ma_grid[ls_x,ls_y,1] = 1 THEN
X                     CALL display_part(ma_grid[ls_x,ls_y,2],ls_x,ls_y)
X                 ELSE
X                     CALL display_part(0,ls_x,ls_y)
X                 END IF
X            END FOR ---ls_y---
X        END FOR ---ls_x---
X    END IF
X
XEND FUNCTION ---check_line---
X
XFUNCTION display_part(ps_colour,ps_x,ps_y)
X
XDEFINE
X    ps_colour SMALLINT,
X    ps_x      SMALLINT,
X    ps_y      SMALLINT
X
X    LET ps_x = ps_x + 1
X    LET ps_y = ps_y
X
X    IF ps_colour = 0 THEN
X        DISPLAY " " AT ps_y,ps_x
X    ELSE
X        CASE
X           WHEN ps_colour = 1 OR ps_colour = 8
X              DISPLAY " " AT ps_y,ps_x ATTRIBUTE(RED,REVERSE)
X           WHEN ps_colour = 2 OR ps_colour = 9
X              DISPLAY " " AT ps_y,ps_x ATTRIBUTE(BLUE,REVERSE)
X           WHEN ps_colour = 3 OR ps_colour = 10
X              DISPLAY " " AT ps_y,ps_x ATTRIBUTE(GREEN,REVERSE)
X           WHEN ps_colour = 4 OR ps_colour = 11
X              DISPLAY " " AT ps_y,ps_x ATTRIBUTE(YELLOW,REVERSE)
X           WHEN ps_colour = 5 OR ps_colour = 12
X              DISPLAY " " AT ps_y,ps_x ATTRIBUTE(CYAN,REVERSE)
X           WHEN ps_colour = 6 OR ps_colour = 13
X              DISPLAY " " AT ps_y,ps_x ATTRIBUTE(MAGENTA,REVERSE)
X           WHEN ps_colour = 7 OR ps_colour = 14
X              DISPLAY " " AT ps_y,ps_x ATTRIBUTE(WHITE,REVERSE)
X        END CASE
X    END IF
X
XEND FUNCTION ---display_part---
X
XFUNCTION draw_score()
X
X    DISPLAY "Level      : 1      " AT 10,40
X    DISPLAY "Difficulty : 1      " AT 11,40
X    DISPLAY "Score      : 0      " AT 12,40
X    DISPLAY "Extended   : N      " AT 13,40
X    DISPLAY "                   " AT 15,40
X
XEND FUNCTION ---draw_score---
X
XFUNCTION init_game()
X
X    LET ms_score = 0
X    LET ms_lines = 0
X    LET mt_time = CURRENT
X    LET mb_drop = FALSE
X    LET mb_done = FALSE
X    LET mb_tamper = FALSE
X    LET ms_level = ms_start_level
X    LET mt_time = CURRENT
X    CALL set_delay()
X    DISPLAY ms_level AT 10,53
X    DISPLAY "0     " AT 12,53
X    DISPLAY "                   " AT 15,40
X
XEND FUNCTION ---init_game---
X
XFUNCTION set_delay()
X
X   CASE
X       WHEN ms_level = 1
X           LET mi_delay = "00:00:00.238"
X       WHEN ms_level = 2
X           LET mi_delay = "00:00:00.191"
X       WHEN ms_level = 3
X           LET mi_delay = "00:00:00.153"
X       WHEN ms_level = 4
X           LET mi_delay = "00:00:00.122"
X       WHEN ms_level = 5
X           LET mi_delay = "00:00:00.098"
X       WHEN ms_level = 6
X           LET mi_delay = "00:00:00.078"
X       WHEN ms_level = 7
X           LET mi_delay = "00:00:00.063"
X       WHEN ms_level = 8
X           LET mi_delay = "00:00:00.050"
X       WHEN ms_level = 9
X           LET mi_delay = "00:00:00.040"
X   END CASE
X
XEND FUNCTION ---set_delay---
X
XFUNCTION increase_score(ps_lines)
X
XDEFINE
X    ps_lines SMALLINT
X
X    CASE ps_lines
X        WHEN 1
X            LET ms_score = ms_score + ms_level 
X        WHEN 2
X            LET ms_score = ms_score + (3 * ms_level)
X        WHEN 3
X            LET ms_score = ms_score + (5 * ms_level)
X        WHEN 4
X            LET ms_score = ms_score + (10 * ms_level)
X    END CASE
X
X    LET ms_score = ms_score + (ms_difficulty / 2)
X
X    LET ms_lines = ms_lines + ps_lines
X
X    IF ms_level = ms_start_level AND ms_level != 9 THEN
X        IF ms_lines > ((15 * ms_start_level) - 1) THEN
X           LET ms_lines = ms_lines - (15 * ms_start_level)
X           LET ms_level = ms_level + 1
X           CALL set_delay()
X           DISPLAY ms_level AT 10,53
X        END IF
X    ELSE
X        IF ms_level != 9 AND ms_lines > 14 THEN
X            LET ms_lines = ms_lines - 15
X            LET ms_level = ms_level + 1
X            CALL set_delay()
X            DISPLAY ms_level AT 10,53
X        END IF
X    END IF
X
X    DISPLAY ms_score AT 12,53
X
XEND FUNCTION ---increase_score---
X
XFUNCTION draw_grid(pc_mode)
X
XDEFINE
X    pc_mode CHAR(1)
X
X    DEFINE
X        ls_x SMALLINT,
X        ls_y SMALLINT
X
X    IF pc_mode = "D" THEN 
X        CALL fgl_drawbox(20, ms_size + 2, 3, 1)
X    ELSE
X        FOR ls_x = 1 TO (ms_size + 2)
X            DISPLAY " " AT 22,ls_x
X            DISPLAY " " AT 3,ls_x
X        END FOR
X        FOR ls_y = 3 TO 22
X            LET ls_x = ms_size + 2
X            DISPLAY " " AT ls_y,1
X            DISPLAY " " AT ls_y,ls_x
X        END FOR
X    END IF
X
X    IF ms_size = 11 THEN
X        IF pc_mode = "D" THEN
X            DISPLAY "Default" AT 11,4 ATTRIBUTE(WHITE, REVERSE)
X        ELSE
X            DISPLAY "       " AT 11,4
X        END IF
X    END IF
X
XEND FUNCTION ---draw_grid---
X
XFUNCTION draw_screen()
X
X    DEFINE
X       ls_line    SMALLINT,
X       ls_loop    SMALLINT,
X       ls_x       SMALLINT,
X       ls_y       SMALLINT,
X       lac_line   ARRAY[5] OF CHAR(21)
X
X    CLEAR SCREEN
X
X    LET lac_line[1] = "XXX X  XXX XXX X XXX"
X    LET lac_line[2] = "X X X   X  X X X X  "
X    LET lac_line[3] = "XXX X   X  XX  X XXX"
X    LET lac_line[4] = "X X X   X  X X X   X"
X    LET lac_line[5] = "X X XXX X  X X X XXX"
X
X    FOR ls_line = 1 TO 5
X       FOR ls_loop = 1 TO LENGTH(lac_line[ls_line])
X          IF lac_line[ls_line][ls_loop] = "X" THEN
X             LET ls_x = 39 + ls_loop
X             LET ls_y = 3 + ls_line
X             DISPLAY " " AT ls_y, ls_x ATTRIBUTE(GREEN, REVERSE)
X          END IF
X       END FOR
X    END FOR
X
X    DISPLAY "Left   - O" AT 17,40
X    DISPLAY "Right  - P" AT 18,40
X    DISPLAY "Rotate - Q" AT 19,40
X    DISPLAY "Drop   - [SPACE]" AT 20,40
X
X    CALL draw_options("D")
X
XEND FUNCTION ---draw_screen---
X
XFUNCTION draw_options(pc_mode)
X
XDEFINE
X    pc_mode CHAR(1)
X
X    IF pc_mode = "E" THEN
X        DISPLAY "                                                                            " AT 1,1
X        DISPLAY "                                                                            " AT 2,1
X        IF ms_size = 11 THEN
X            DISPLAY "         " AT 11,3
X        END IF
X    ELSE
X        DISPLAY "  [P]lay [E]xit [I]ncrease [R]educe [K]eys [L]evel [D]ifficulty [X]tended" AT 1,1
X        DISPLAY "                        C h o o s e  a n  O p t i o n                      " AT 2,1 ATTRIBUTE(REVERSE)
X    END IF
X
XEND FUNCTION ---draw_options---
X
XFUNCTION define_keys()
X
X    DEFINE
X        lc_str CHAR(7),
X        ls_char SMALLINT
X
X    # Left
X
X    DISPLAY "?      " AT 17,49
X
X    WHILE 1=1
X        LET ls_char = key_press()
X        IF ls_char = 32 OR (ls_char > 96 AND ls_char < 123)
X        OR (ls_char > 64 AND ls_char < 69) THEN
X            LET ms_left = ls_char
X            CASE
X                WHEN ls_char = 32 
X                   LET lc_str = "[SPACE]"
X                WHEN ls_char = 65
X                   LET lc_str = "[UP]"
X                WHEN ls_char = 66
X                   LET lc_str = "[DOWN]"
X                WHEN ls_char = 67
X                   LET lc_str = "[RIGHT]"
X                WHEN ls_char = 68
X                   LET lc_str = "[LEFT]"
X                OTHERWISE
X                   LET lc_str = ASCII(ls_char)
X                   LET lc_str = UPSHIFT(lc_str)
X            END CASE
X            DISPLAY lc_str AT 17,49
X            EXIT WHILE
X        END IF
X    END WHILE
X
X    # Right
X
X    DISPLAY "?      " AT 18,49
X
X    WHILE 1=1
X        LET ls_char = key_press()
X        IF ls_char = 32 OR (ls_char > 96 AND ls_char < 123)
X        OR (ls_char > 64 AND ls_char < 69) THEN
X            IF ls_char = ms_left THEN
X                CONTINUE WHILE
X            END IF
X            LET ms_right = ls_char
X            CASE
X                WHEN ls_char = 32 
X                   LET lc_str = "[SPACE]"
X                WHEN ls_char = 65
X                   LET lc_str = "[UP]"
X                WHEN ls_char = 66
X                   LET lc_str = "[DOWN]"
X                WHEN ls_char = 67
X                   LET lc_str = "[RIGHT]"
X                WHEN ls_char = 68
X                   LET lc_str = "[LEFT]"
X                OTHERWISE
X                   LET lc_str = ASCII(ls_char)
X                   LET lc_str = UPSHIFT(lc_str)
X            END CASE
X            DISPLAY lc_str AT 18,49
X            EXIT WHILE
X        END IF
X    END WHILE
X
X    # Rotate
X
X    DISPLAY "?      " AT 19,49
X
X    WHILE 1=1
X        LET ls_char = key_press()
X        IF ls_char = 32 OR (ls_char > 96 AND ls_char < 123)
X        OR (ls_char > 64 AND ls_char < 69) THEN
X            IF ls_char = ms_left OR ls_char = ms_right THEN
X                CONTINUE WHILE
X            END IF
X            LET ms_rotate = ls_char
X            CASE
X                WHEN ls_char = 32 
X                   LET lc_str = "[SPACE]"
X                WHEN ls_char = 65
X                   LET lc_str = "[UP]"
X                WHEN ls_char = 66
X                   LET lc_str = "[DOWN]"
X                WHEN ls_char = 67
X                   LET lc_str = "[RIGHT]"
X                WHEN ls_char = 68
X                   LET lc_str = "[LEFT]"
X                OTHERWISE
X                   LET lc_str = ASCII(ls_char)
X                   LET lc_str = UPSHIFT(lc_str)
X            END CASE
X            DISPLAY lc_str AT 19,49
X            EXIT WHILE
X        END IF
X    END WHILE
X
X    # Drop
X
X    DISPLAY "?      " AT 20,49
X
X    WHILE 1=1
X        LET ls_char = key_press()
X        IF ls_char = 32 OR (ls_char > 96 AND ls_char < 123)
X        OR (ls_char > 64 AND ls_char < 69) THEN
X            IF ls_char=ms_left OR ls_char=ms_right OR ls_char=ms_rotate THEN
X                CONTINUE WHILE
X            END IF
X            LET ms_drop = ls_char
X            CASE
X                WHEN ls_char = 32 
X                   LET lc_str = "[SPACE]"
X                WHEN ls_char = 65
X                   LET lc_str = "[UP]"
X                WHEN ls_char = 66
X                   LET lc_str = "[DOWN]"
X                WHEN ls_char = 67
X                   LET lc_str = "[RIGHT]"
X                WHEN ls_char = 68
X                   LET lc_str = "[LEFT]"
X                OTHERWISE
X                   LET lc_str = ASCII(ls_char)
X                   LET lc_str = UPSHIFT(lc_str)
X            END CASE
X            DISPLAY lc_str AT 20,49
X            EXIT WHILE
X        END IF
X    END WHILE
X
XEND FUNCTION ---define_keys---
X
XFUNCTION init_default()
X
X    LET ms_size = 11
X    LET ms_left = 111
X    LET ms_right = 112
X    LET ms_rotate = 113
X    LET ms_drop = 32
X    LET ms_start_level = 1
X    LET ms_difficulty  = 1
X    LET mc_extended = "N"
X
XEND FUNCTION ---init_default---
SHAR_EOF
if [ `wc -c < altris.4gl` -ne    27839 ]
then
    echo "Lengths do not match -- Bad Copy of altris.4gl"
fi
echo "Extracting file key_press.c"
sed -e 's/^X//' <<\SHAR_EOF > key_press.c
X/*******************************************************************************
X SCCS ID : @(#) Mod: key_press.c Ver: 1.2 Date: 08/13/99 17:01:14
X*******************************************************************************/
X#include <stdio.h>
X#include <fcntl.h>
X#include <curses.h>
X#include <term.h>
X
Xint current_flags;
X
Xinit_term(noargs)
X{
X	current_flags = fcntl(0, F_GETFL, 0);
X	fcntl(0, F_SETFL, current_flags | O_NDELAY);
X	cursor_invisible=1;
X}
X
Xkey_press(noargs)
X{
Xchar c;
X
X	if (read(0, &c, 1) > 0)
X		pushint(c);
X	else
X		pushint(0);
X	return(1);
X}
X
Xend_term(noargs)
X{
X	fcntl(0, F_SETFL, current_flags);
X	return(0);
X}
SHAR_EOF
if [ `wc -c < key_press.c` -ne      658 ]
then
    echo "Lengths do not match -- Bad Copy of key_press.c"
fi
echo "Extracting file makefile"
sed -e 's/^X//' <<\SHAR_EOF > makefile
X
XLD=/usr2/develop/SCCS/objects
XCFLAGS=-s -c
X
X.SUFFIXES:
X.SUFFIXES: .msg .hlp .4gl .o .per .frm .ace .arc .c .4go
X.c.o:
X	cc $(CFLAGS) $< $(SYSLIBS)
X.msg.hlp:
X	mkmessage $< 
X.4gl.o:
X	c4gl -nokeep $(CFLAGS) $< $(SYSLIBS)
X.per.frm: 
X	form4gl $<
X.ace.arc: 
X	saceprep $<
X.4gl.4go:
X	fglpc $<
X
XSYSLIBS=\
X-lisam
X
X
XEXE=\
Xaltris.4ge
X
XRDS=\
Xaltris.4gi
X
XEXE: $(EXE)
X
XRDS: $(RDS)
X
Xaltris.4ge : altris.o key_press.o random.o
X	c4gl -o altris.4ge altris.o key_press.o random.o $(SYSLIBS)
SHAR_EOF
if [ `wc -c < makefile` -ne      506 ]
then
    echo "Lengths do not match -- Bad Copy of makefile"
fi
echo "Extracting file makefile.gnu"
sed -e 's/^X//' <<\SHAR_EOF > makefile.gnu
X
XLD=/usr2/develop/SCCS/objects
XCFLAGS=-s -c
X
X.SUFFIXES:
X.SUFFIXES: .msg .hlp .4gl .o .per .frm .ace .arc .c .4go
X.c.o:
X	gcc $(CFLAGS) random.c key_press.c
X.msg.hlp:
X	mkmessage $< 
X.4gl.o:
X	c4gl -nokeep $(CFLAGS) altris.4gl
X.per.frm: 
X	form4gl $<
X.ace.arc: 
X	saceprep $<
X.4gl.4go:
X	fglpc $<
X
XEXE=\
Xaltris.4ge
X
XRDS=\
Xaltris.4gi
X
XEXE: $(EXE)
X
XRDS: $(RDS)
X
Xaltris.4ge : altris.o key_press.o random.o
X	c4gl -o altris.4ge altris.o key_press.o random.o
SHAR_EOF
if [ `wc -c < makefile.gnu` -ne      477 ]
then
    echo "Lengths do not match -- Bad Copy of makefile.gnu"
fi
echo "Extracting file random.c"
sed -e 's/^X//' <<\SHAR_EOF > random.c
X/*******************************************************************************
X SCCS ID : @(#) Mod: random.c Ver: 1.2 Date: 08/13/99 17:01:19
X*******************************************************************************/
X#include <stdlib.h>
X#include <stdio.h>
X#include <time.h>
X
Xint randomize();
X
Xint randomize()
X{
Xtime_t t;
X
X	srand((unsigned) time(&t));
X	return(0);
X}
X
Xint rnd(noargs)
X{
Xint c;
Xint modulus;
X
X	popint(&modulus);
X	c = rand() % modulus;
X	pushint(c);
X  	return(1);   
X}
SHAR_EOF
if [ `wc -c < random.c` -ne      514 ]
then
    echo "Lengths do not match -- Bad Copy of random.c"
fi
echo "Done."
exit 0