'''
''' playfield tutorial - part 3
''' Simple Collision Detection
'''
''' by greg smith
'''

'''
''' use c coordinates
'''
OPTION C_COORDS

dim x as int  'position of lemming from 0-480
dim y as int  'position of lemming from 0-300
dim z_dir as int  'which direction of lemming
dim z_cnt as int  'animation image of lemming

dim sprite_field as int 'the sprite number of the playfield sprites
dim sprite_lemming as int   'the sprite number of the lemming sprites
dim lemming_left as int     'index into lemming sprite for going left
dim lemming_right as int    'index into lemming sprite for going right
dim lemming_up as int       'index into lemming sprite for going up
dim lemming_down as int     'index into lemming sprite for going down

dim collision_street as char     'the street's collision value

dim collision_table[30,31] as char 'the collision table

'''
''' initialization
'''
sub init
    sprite_field = 0  'playfield sprite
    sprite_lemming = 31    'lemming sprite is largest possible sprite - on top

    lemming_left=0        'lemming left image
    lemming_right=5       'lemming right image
    lemming_up=10         'lemming up image
    lemming_down=15       'lemming down image

    '''
    ''' the playfield sprite has 9 bitmaps
    ''' one for each of the different areas of the
    ''' playfield
    sprite sprite_field, "playfield.pic"

    '''
    ''' the lemming has 20 bitmaps 5 for each direction
    sprite sprite_lemming, "lemming.pic"

    '''
    ''' the lemming can be anywhere on the playfield from
    ''' x = 0-480
    ''' y = 0-300
    x=240  'center of the playfield
    y=150  'center of the playfield
    z_dir=lemming_right  ' lemming faces right
    z_cnt=0              ' animation counter

    '''
    ''' set the collision flags
    '''
    collision_street = \x\
end sub

sub repaint
    dim field_x as int   '0,1,2 for the horizontal bitmap
    dim field_y as int   '0,1,2 for the vertical bitmap
    dim field as int     '0-8 for the bitmap currently visible
    dim lemming_x as int     '0-159 for the x coord on the screen
    dim lemming_y as int     '0-99  for the y coord on the screen

    field_x = x / 160    ' compute the horizontal bitmap
    field_y = y / 100    ' compute the vertical bitmap
    field = field_y*3 + field_x ' combine them to compute the bitmap number

    lemming_x = x mod 160  ' compute the lemming's position on the screen
    lemming_y = y mod 100  ' compute the lemming's position on the screen

    move sprite_field, 0, 0, field  'display the current field
    move sprite_lemming, lemming_x, lemming_y, z_dir+z_cnt 'display the lemming 

    paper white  'transparent color for the lemming
    ink ltgrey

    redraw        'redraw all the sprites
    
end sub

'''
''' increment the z_cnt variable
'''
sub update_z_cnt
    z_cnt=(z_cnt+1) MOD 5
end sub

'''
''' check for collision against table
'''
function collision_check(x as int, y as int) as char
    collision_check = collision_table[y/10,x/16]
end function

'''
''' process the keyboard
'''
sub get_keys
    dim tmp as int
    if key(#KEY_UP) then   'move the lemming up
        tmp=y-3
        if collision_check(x,tmp) = collision_street then
            y=tmp
            z_dir=lemming_up
            update_z_cnt
        end if
    end if
    if key(#KEY_DOWN) then 'move the lemming down
        tmp=y+3
        if collision_check(x,tmp) = collision_street then
            y=tmp
            z_dir=lemming_down
            update_z_cnt
        end if
    end if
    if key(#KEY_LEFT) then 'move the lemming left
        tmp=x-3
        if collision_check(tmp,y) = collision_street then
            x=tmp
            z_dir=lemming_left
            update_z_cnt
        end if
    end if
    if key(#KEY_RIGHT) then 'move the lemming right
        tmp=x+3
        if collision_check(tmp,y) = collision_street then
            x=tmp
            z_dir=lemming_right
            update_z_cnt
        end if
    end if
end sub

sub init_playfield(field as int)
    collision_table[ 0]=".............................." 'y=0-9
    collision_table[ 1]=".............................." 'y=10-19 
    collision_table[ 2]=".............................." 'y=20-29
    collision_table[ 3]=".............................." 'y=30-39
    collision_table[ 4]="..xxxxxxxxxxxxxxxxxxxxxxxxx..." 'y=40-49
    collision_table[ 5]="..x...........x...........x..." 'y=50-59
    collision_table[ 6]="..x...........x...........x..." 'y=60-69
    collision_table[ 7]="..x...........x...........x..." 'y=70-79
    collision_table[ 8]="..x...........x...........x..." 'y=80-89
    collision_table[ 9]="..x...........x...........x..." 'y=90-99
    collision_table[10]="..x...........x...........x..." 'y=100-109
    collision_table[11]="..x...........x...........x..." 'y=110-119
    collision_table[12]="..x...........x...........x..." 'y=120-129
    collision_table[13]="..x...........x...........x..." 'y=130-139
    collision_table[14]="..xxxxxxxxxxxxxxxxxxxxxxxxx..." 'y=140-149
    collision_table[15]="..x...........x...........x..." 'y=150-159
    collision_table[16]="..x...........x...........x..." 'y=160-169
    collision_table[17]="..x...........x...........x..." 'y=170-179
    collision_table[18]="..x...........x...........x..." 'y=180-189
    collision_table[19]="..x...........x...........x..." 'y=190-199
    collision_table[20]="..x...........x...........x..." 'y=200-209
    collision_table[21]="..x...........x...........x..." 'y=210-219
    collision_table[22]="..x...........x...........x..." 'y=220-229
    collision_table[23]="..x...........x...........x..." 'y=230-239
    collision_table[24]="..xxxxxxxxxxxxxxxxxxxxxxxxx..." 'y=240-249
    collision_table[25]=".............................." 'y=250-259
    collision_table[26]=".............................." 'y=260-269
    collision_table[27]=".............................." 'y=270-279
    collision_table[28]=".............................." 'y=280-289
    collision_table[29]=".............................." 'y=290-299
end sub

'''
''' main subroutine
'''
sub mainsub
    init
    init_playfield(0)

    while true
        repaint
        get_keys
    wend
end sub

'''
''' call the main subroutine
'''
mainsub