' <em>, an emphasized textmode shmup
' (c) 2008, Deveah
' schimba ce e mai sus si mori // change the text above and die.

#define textmode

'#define chrfull chr(219)
'#define chrthreequarters chr(178)
'#define chrhalf chr(177)
'#define chrquarter chr(176)
'#define chrhalfblock chr(220)

#ifdef textmode
    #include "windows.bi"
    #include "conlib.bi"
    const clRed=13
    const clGreen=2
    const clBlue=1
    const clBlack=0
    const clWhite=15
#else
    const clRed=rgb(255,0,0)
    const clGreen=rgb(0,255,0)
    const clBlue=rgb(0,0,255)
    const clBlack=rgb(0,0,0)
    const clWhite=rgb(255,255,255)
    screen 17,32
#endif

width 80,50
windowtitle "<em>"
randomize timer,3

type chartype
    as uinteger bg,fg
    as string char
end type

type particletype
    as integer x,y,direction,life
    as chartype char
end type

dim shared as integer mx,my,btn,status,ticks,particlecount
dim shared as chartype _screen(1 to 80,1 to 50)
dim shared as particletype particle(1 to 1000)

function rndr(hi as integer,lo as integer) as integer
    rndr = Int((hi - lo + 1) * Rnd + lo)
end function

sub reparticle
    dim as integer freecount
    dim as particletype temp(1 to 1000)
    for i as integer=1 to ubound(particle)
        if particle(i).life<1 then 
            freecount+=1
            temp(freecount)=particle(i)
        endif
    next i
    for i as integer=1 to (ubound(particle)-freecount)
        particle(i)=temp(i)
    next i
    particlecount=(1000-freecount)
end sub

sub clearscreen
    for ix as integer=1 to 80
        for iy as integer=1 to 50
            _screen(ix,iy).fg=0:_screen(ix,iy).bg=0:_screen(ix,iy).char=chr(0)
        next iy
    next ix
end sub

sub outscreen
    #ifndef textmode
        screenlock
    #endif
    for ix as integer=1 to 80
        for iy as integer=1 to 50
            #ifdef textmode
                conlib.locate iy,ix
                conlib.color _screen(ix,iy).fg,_screen(ix,iy).bg
                conlib.print _screen(ix,iy).char
            #else
                locate iy,ix:color _screen(ix,iy).fg,_screen(ix,iy).bg:?_screen(ix,iy).char;
            #endif
        next iy
    next ix
    #ifdef textmode
        conlib.flip
    #else
        screenunlock
    #endif
end sub

sub decreasecolors
    for ix as integer=1 to 80
        for iy as integer=1 to 50
            if _screen(ix,iy).fg>0 then _screen(ix,iy).fg-=1
            if _screen(ix,iy).bg>0 then _screen(ix,iy).bg-=1
        next iy
    next ix
end sub

sub createparticle(x as integer,y as integer,fg as integer, bg as integer, char as string, direction as integer,life as integer)
    dim temp as integer
    for i as integer=1 to ubound(particle)
        if particle(i).life<1 then temp=i:exit for
    next i
    if particlecount+1>ubound(particle) then
        reparticle
    endif
    particlecount+=1
    particle(temp).x=x
    particle(temp).y=y
    particle(temp).direction=direction
    particle(temp).char.bg=bg
    particle(temp).char.fg=fg
    particle(temp).char.char=char
    particle(temp).life=life
end sub

sub particletick
    for i as integer=1 to particlecount
        if particle(i).life>0 then particle(i).life-=1
        if particle(i).life>0 then
            select case particle(i).direction
            case 1:particle(i).y-=1
            case 2:particle(i).y-=1:particle(i).x+=1
            case 3:particle(i).x+=1
            case 4:particle(i).y+=1:particle(i).x+=1
            case 5:particle(i).y+=1
            case 6:particle(i).y+=1:particle(i).x-=1
            case 7:particle(i).x-=1
            case 8:particle(i).y-=1:particle(i).x-=1
            end select
            if particle(i).x>0 and particle(i).x<81 and particle(i).y>0 and particle(i).y<51 then
                _screen(particle(i).x,particle(i).y).fg=particle(i).char.fg
                _screen(particle(i).x,particle(i).y).bg=particle(i).char.bg
                _screen(particle(i).x,particle(i).y).char=particle(i).char.char
            endif
        endif
    next i
end sub
        
sub decreasechars
    for ix as integer=1 to 80
        for iy as integer=1 to 50
            select case _screen(ix,iy).char
            case "#"
                _screen(ix,iy).char="8"
            case "8"
                _screen(ix,iy).char="%"
            case "%"
                _screen(ix,iy).char="*"
            case "*"
                _screen(ix,iy).char=":"
            case ":"
                _screen(ix,iy).char="."
            case "."
                _screen(ix,iy).char=" "
            end select
        next iy
    next ix
end sub

dim as integer fpscnt = 0, fps = 0
dim as double tini = timer
do
    fps += 1
    if timer - tini >= 1 then
        fpscnt = fps
        fps = 0
        tini = timer
    end if
    ticks+=1:particletick
    getmouse mx,my,,btn
    setmouse ,,0
    #ifndef textmode
        mx/=8:my/=8
        locate 1,1,0
    #endif
    if ticks mod 2=0 then decreasechars
    if ticks mod 10=0 then status=0
    if mx>0 and my>0 then
        if btn and 1 then
            if status=0 then
                for i as integer=1 to 8
                    #ifdef textmode
                        createparticle(mx,my,rnd*15+1,clBlack,"#",i,rnd*10+2)
                    #else
                        createparticle(mx,my,rgb(rnd*255,rnd*255,rnd*255),clBlack,"#",i,rnd*10+2)
                    #endif
                next i
                status=1
            endif
        elseif btn and 2 then
            var rx=rnd*79+1:var ry=rnd*49+1
            for i as integer=1 to 8
                    #ifdef textmode
                        createparticle(rx,ry,rnd*15+1,clBlack,"#",i,rnd*10+10)
                    #else
                        createparticle(rx,ry,rgb(rnd*255,rnd*255,rnd*255),clBlack,"#",i,rnd*10+10)
                    #endif
            next i
        endif
        _screen(mx,my).fg=clWhite:_screen(mx,my).char="#"
    endif
    #ifdef textmode
        createparticle(rnd*79+1,rnd*49+1,1,0,"#",rnd*7+1,rnd*5+5)
    #else
        createparticle(rnd*79+1,rnd*49+1,rgb(20,20,20),0,"#",rnd*7+1,rnd*5+5)
    #endif
    outscreen
    #ifdef textmode
        setconsoletitle "<em> particle test with " & fpscnt & " fps and " & particlecount & " particles!"
    #else
        windowtitle "<em> particle test with " & fpscnt & " fps and " & particlecount & " particles!"
    #endif
    sleep 1,1
loop until multikey(1)