Matching joker shapes partially outside playfield boundary.

[generic-block-game.git] / gbg.bas

/'
Generic Block Game
Copyright 2008, 2018 Pajo <xpio at tut dot by>

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <https://www.gnu.org/licenses/>.
'/

Open Cons For Output As #3 ' debug

#include "fbgfx.bi"
Using fb

Const GFXPATH = "gfx"
Const VARPATH = "variations"
Const SPEED = 2
Const MAX_SPEED = 10
Const SPEEDUP_TIME = 20
Const SPEED_INDICATOR_SIZE = 8
Const SCORE_INDICATOR_SIZE = 16
Const DRAWPLAYFIELD_DELAY = 0.02

Type block
        'Declare Constructor
        Declare Sub init()
        Declare Sub imprint(remove As Byte = True, place As Byte = True, noshadow As Byte = True)
        Declare Sub drop()
        Declare Function move(as Byte,as Byte=0,As UByte=0) As Byte
        As UByte typ
        As Short x,y
        As Byte shadow
        As Byte dropping = False 'Used when dropping with mouse
private:
        As Short oldx,oldy
        Declare Function isblocked(x as Byte, y As Byte=0, typ As UByte=0, mode As Byte=False) As Byte
        As UByte oldtyp
End Type


Type settings_type
        As Byte show_shadow = True, show_score = False, show_speed = False
        As Byte play_mouse = True, first_button_turning = False
        As UByte tileset = 0
End Type


Type game_type
        As String title
        As Short w, h
        As UByte speed = 1
        As Double tim, speed_timer, menu_timer
End Type


Dim Shared settings As settings_type
Dim Shared game As game_type

Dim Shared nextvariation As String
ReDim Shared help () As String
Dim Shared As UByte playabletiles, numberoftiles
Dim Shared As Short columns=1, rows=1
Dim Shared As Byte wrap, gravity, randominputs, randomgoals, inputrotate
Dim Shared score As Short=0
ReDim Shared tilesfiles(0) As String
ReDim Shared randomtable() As UByte
Dim Shared keypress As String
Dim Shared tilewidth As Short
Dim Shared tilesimg As Any Ptr
Dim Shared scoreimg As Any Ptr
Dim Shared As block blok, shadow
Dim Shared As Double lazydrawplayfield = -1, lastdrawplayfield
lastdrawplayfield = Timer()
Dim Shared As UByte maxgoalsw = 0, maxgoalsh = 0


Declare Function loadgame(filename As String) As Byte
Declare Sub loadTiles(increment As Byte=1)
Declare Sub initplayfield()
Declare Sub drop_shadow()


Sub resizewindow(w As UShort = game.w, h As Short = -1, t As String = game.title)
        Dim As Integer oldw, oldh : ScreenInfo oldw, oldh
        Dim As Integer oldx, oldy : ScreenControl GET_WINDOW_POS, oldx, oldy
        If h = -1 Then
                h = game.h
                If settings.show_score Then h += SCORE_INDICATOR_SIZE
                If settings.show_speed Then h += SPEED_INDICATOR_SIZE
        End If
        If oldw = w And oldh = h Then
                Cls
        Else
                ScreenRes w, h, 16, 2
                If oldx > 0 And oldy > 0 Then ScreenControl SET_WINDOW_POS, oldx, oldy
        End If
        WindowTitle(t)
End Sub


Function asctonumber(ch As UByte) As UByte
        If ch=46 Then : Return 0
        ElseIf ch=33 Then : Return 254 'start=!=254
        ElseIf ch=Asc("@") Then : Return 253 'exit=@=253
        ElseIf ch>=48 And ch<=57 Then : Return ch-48
        ElseIf ch>=65 And ch<=90 Then : Return ch-65+10
        ElseIf ch>=97 And ch<=122 Then : Return ch-97+36
        Else : Return 255
        End If
End Function

Function getImgWidth(filename As String) As Short
        Open filename For Input As #2
        If Err>0 Then Return 0
        Dim w As Integer
        Get #2,19,w
        Close #2
        Return w
End Function

ReDim Shared inputsindex(0) As Short
ReDim Shared inputs(0,2) As UByte
'inputs and inputsindex are linked arrays. inputsindex shows individual inputs' ends
ReDim Shared goals(0,2) As UByte


Sub end_shape(shapes() As UByte, index As Byte = False)
        shapes(UBound(shapes), 0) = 255
        shapes(UBound(shapes), 1) = 255
        shapes(UBound(shapes), 2) = 255
        If index Then
                inputsindex(UBound(inputsindex)) = UBound(shapes)
                ReDim Preserve inputsindex(UBound(inputsindex) + 1)
        End If
        ReDim Preserve shapes(UBound(shapes) + 1, 2)
End Sub


Sub rotate_shape()
        Dim As Short strt, stp, a, offset
        If UBound(inputsindex) = 1 Then strt = 0 Else strt = inputsindex(UBound(inputsindex) - 1 - 1) + 1 'skip "255" point
        stp = inputsindex(UBound(inputsindex) - 1) - 1 'leave out "255" point
        offset = stp - strt
        ReDim Preserve inputs(UBound(inputs) + offset + 1, 2)
        For a = strt To stp
                'mirror one axis and swap x and y to rotate
                inputs(a + offset + 2, 1) = inputs(a, 0)
                inputs(strt + stp - a + offset + 2, 0) = inputs(a, 1)
                inputs(a + offset + 2, 2) = inputs(a, 2)
        Next
End Sub


Sub loadshapes(shapes() As UByte, index As Byte = False)
        ReDim shapes(0, 2)
        If index Then ReDim inputsindex(0)
        Dim l as String
        Dim As UByte a, b
        Do Until l = "}" Or Eof(1)
                Line Input #1, l
                If l = "" Then 
                        b = 0
                        end_shape(shapes(), index)
                        If inputrotate And index Then
                                For a = 1 To 3
                                        rotate_shape()
                                        end_shape(shapes(), index)
                                Next
                        End If
                ElseIf l <> "}" Then
                        For a = 0 To Len(l) - 1
                                shapes(UBound(shapes), 0) = a
                                shapes(UBound(shapes), 1) = b
                                If l[a]=46 Then : shapes(UBound(shapes), 2) = 0
                                Else : shapes(UBound(shapes), 2) = asctonumber(l[a])
                                End If
                                ReDim Preserve shapes(UBound(shapes) + 1, 2)
                        Next
                        b += 1
                        If Not index Then
                                If Len(l) > maxgoalsw Then maxgoalsw = Len(l)
                                If b > maxgoalsh Then maxgoalsh = b
                        End If
                End If
        Loop
        '}
        end_shape(shapes(), index)
        If inputrotate And index Then
                For a = 1 To 3
                        rotate_shape()
                        end_shape(shapes(), index)
                Next
        End If
        If index Then ReDim Preserve inputsindex(UBound(inputsindex) - 1)
End Sub


Declare Sub gameOver()

Dim Shared playfield(0 to columns-1,0 to rows-1) as UByte
Dim Shared originalplayfield(0 to columns-1,0 to rows-1) as UByte

ReDim Shared nextshape() As UByte

Function block.isblocked(x as Byte, y As Byte=0, typ As UByte=0, mode As Byte=False) As Byte
        Dim As Short strt, stp, a
        Dim As Byte failed

        If typ=1 Then strt=0 Else strt=inputsindex(typ-1-1)+1 'preskace se ona 255 tacka
        stp=inputsindex(typ-1)-1 'izostavlja se ona 255 tacka
        'mode=True = ispituje se origin
        For a = strt To stp
                failed=inputs(a,2)<>0 And _
                playfield(x+inputs(a,0),y+inputs(a,1))<>254 And _
                playfield(x+inputs(a,0),y+inputs(a,1))<>253
                If Not mode Then failed=failed And playfield(x+inputs(a,0),y+inputs(a,1))<>0
                failed=failed Or y+inputs(a,1)>=rows _
                Or y+inputs(a,1)<0 _
                Or x+inputs(a,0)>=columns _
                Or x+inputs(a,0)<0
                If failed Then Exit For
        Next
        Return failed
End Function


Sub block.init()
        this.dropping = False
        If randominputs Then 'permutovati brojeve od 1 do playabletiles
                Dim a As UByte
                ReDim randomtable(playabletiles) As UByte
                For a = 1 To playabletiles
                        randomtable(a)=fix(rnd*playabletiles)+1
                Next
        EndIf

        Type xy
                As UByte x,y
        End Type
        ReDim startpositions(0) As xy
        Dim posnumber As UShort=0
        Dim As UShort x,y
        Dim starttyp As UByte
        this.typ=Fix(RND*(UBound(inputsindex)+1))+1
        starttyp=this.typ
        Do
           For y=0 to rows-1 : For x=0 to columns-1
                If originalplayfield(x,y)=254 Then
                        If Not this.isblocked(x,y,this.typ,True) Then  'dodaj na listu
                                        ReDim Preserve startpositions(posnumber) As xy
                                        startpositions(posnumber)=Type(x,y)
                                        posnumber+=1
                        EndIf
                EndIf
           Next x: Next y
           If posnumber=0 Then
                this.typ=nextshape(this.typ)
                        If this.typ=starttyp Then
                                gameOver()
                                Return
                        EndIf
           EndIf
        Loop Until posnumber>0
        posnumber=fix(rnd*posnumber)
        this.x=startpositions(posnumber).x
        this.y=startpositions(posnumber).y
        this.oldx=this.x
        this.oldy=this.y
        this.oldtyp=this.typ
        If Not this.shadow Then drop_shadow()
End Sub

'Constructor block 
        'constructor bi se pokretao kod samog deklarisanja, pre playfielda
'End Constructor

Function getshapewidthheight(typ As UByte,geth As Byte = False) As Short
        Dim As Short strt, stp, a, maxwidth=0, maxheight=0
        
        If typ=1 Then strt=0 Else strt=inputsindex(typ-1-1)+1 'preskace se ona 255 tacka
        stp=inputsindex(typ-1)-1 'izostavlja se ona 255 tacka
        For a = strt To stp
                If maxwidth<inputs(a,0) Then maxwidth=inputs(a,0) 
                If maxheight<inputs(a,1) Then maxheight=inputs(a,1) 
        Next
        If geth Then Return maxheight
        Return maxwidth
End Function


Function block.move(x as Byte, y As Byte=0, typ As UByte=0) As Byte 'successful?True/False
        Dim As Byte dw,dh
        If typ=0 Then
                 typ=this.typ
        Else
                '!centriranje
                dw=(getshapewidthheight(this.typ)-getshapewidthheight(typ)) / 2
                If gravity Then
                        dh=0
                Else
                        dh=(getshapewidthheight(this.typ,True)-getshapewidthheight(typ,True)) / 2
                EndIf
        EndIf
        this.oldx=this.x
        this.oldy=this.y
        this.oldtyp=this.typ
        this.imprint(True, False) 'just erase oldx i oldy

        this.x=x + this.x + dw 
        this.y=y + this.y + dh 
        If wrap Then
                this.x=(this.x + columns) Mod columns
                If Not gravity Then this.y=(this.y + rows) Mod rows 
        EndIf
/'
                        failed=failed Or y+inputs(a,1)>=rows _
                        Or y+inputs(a,1)<0 _
                        Or x+inputs(a,0)>=columns _
                        Or x+inputs(a,0)<0
'/

        Dim As Byte failed
        failed=this.isblocked(this.x,this.y,typ)
        If failed Then
                this.x=this.oldx
                this.y=this.oldy
                this.typ=this.oldtyp
        Else
                this.typ=typ
        EndIf
        If not this.shadow Then drop_shadow()
        this.imprint()
        Return Not failed

End Function


Sub markshape(shapestart As Short,shapeend As Short,x As Short,y As Short)
        Dim As Short mx,my,q
        For q=shapestart To shapeend-1
                mx=x-goals(q,0)
                my=y-goals(q,1)
                If goals(q,2)<>0 And playfield(mx,my)<>0 And playfield(mx,my)<100 Then
                        playfield(mx,my)+=100
                End if
        Next
End Sub


Function matchshape(x As Short,y As Short) As Byte
        Dim As Byte fullshape,foundshape=False
        Dim As Short mx,my,shapestart=0,p=0,q
        Dim a As UByte
        Dim goalscolors(100) As UByte 'za randomgoals '!max 100 randomgolova
        fullshape=True
        For p=0 To UBound(goals)
                If goals(p,0)=255 And goals(p,1)=255 And goals(p,2)=255 Then '255,255,255=end   
                        If fullshape=True Then
                                print #3, "Marking shape"
                                markshape(shapestart,p,x,y)
                                foundshape=True
                        End If
                        shapestart=p+1
                        fullshape=True
                        For a=0 To UBound(goalscolors) : goalscolors(a)=0 : Next a
                ElseIf goals(p,2)<>254 Then
                'do nothing with fullshape variable if 254(joker)
                '254="!"=matches also empty space (useful when tiles surrounding matched shape should be destroyed)
                        mx=x-goals(p,0)
                        my=y-goals(p,1)
                        If mx<0 Or mx>columns-1 Or my<0 Or my>rows-1 Then
                                fullshape=False
                        ElseIf goals(p,2)=255 Then '255 matches everything except empty space
                                fullshape = fullshape And _
                                (playfield(mx,my)<>0) And _
                                (playfield(mx,my)<>254) And _
                                (playfield(mx,my)<>253)
                        ElseIf goals(p,2)<>0 Then
                                If randomgoals Then
                                        If goalscolors(goals(p,2))=0 Then
                                                If (playfield(mx,my)<>0) And _
                                                        (playfield(mx,my)<>254) And _
                                                        (playfield(mx,my)<>253)Then  
                                                        goalscolors(goals(p,2))=playfield(mx,my)
                                                Else
                                                        fullshape=False
                                                EndIf
                                        EndIf  
                                        fullshape = fullshape And (playfield(mx,my)=goalscolors(goals(p,2)) _
                                        Or playfield(mx,my)=goalscolors(goals(p,2))+100)
                                Else    
                                        fullshape = fullshape And (playfield(mx,my)=goals(p,2) _
                                        Or playfield(mx,my)=goals(p,2)+100)
                                EndIf
                        End If
                End If 
        Next
        Return foundshape
End Function


Sub checksituation()
        Dim As Byte x, y, gap, removed=False, scoremulti=0, existsnextvariation=False, gotonextvariation=True
        For y=0 To rows-1 + maxgoalsh : For x=0 To columns-1 + maxgoalsw
                If matchshape(x,y) Then
                        scoremulti += 1
                        game.speed_timer = Timer() 'delay speedup
                End If
        Next x: Next y
        If gravity Then 'remove >100 (marked shapes)
           For x=0 To columns-1
               gap=0
               For y=rows-1 To 0 Step -1
                    If playfield(x,y)>=100 And playfield(x,y)<>254 And playfield(x,y)<>253 Then
                        gap+=1
                    Else
                                                If playfield(x,y)=254 Then
                                                        If originalplayfield(x,y)=254 Or originalplayfield(x,y)=253 Then 
                                                                playfield(x,y+gap)=originalplayfield(x,y) 
                                                        Else
                                                                playfield(x,y+gap)=0
                                                        EndIf 
                                                Else playfield(x,y+gap)=playfield(x,y)
                                                End If
                    End if
                    If y<gap Then 
                        If originalplayfield(x,y)=254 Or originalplayfield(x,y)=253 Then
                                playfield(x,y)=originalplayfield(x,y)
                        Else
                                playfield(x,y)=0
                        EndIf
                    EndIf
                Next y
                removed=removed or gap>0
            Next x
    If removed Then checksituation()
        Else 'no gravity
                For y=0 To rows-1 : For x=0 To columns-1
                        If playfield(x,y)>100 And playfield(x,y)<>254 And playfield(x,y)<>253 Then
                                If originalplayfield(x,y)=254 Or originalplayfield(x,y)=254 Then
                                        playfield(x,y)=originalplayfield(x,y)
                                Else
                                        playfield(x,y)=0
                                EndIf
                        EndIf
                Next x: Next y
        EndIf
        score+=scoremulti*10
        'check exit
        For y=0 To rows-1 : For x=0 To columns-1
                If originalplayfield(x,y)=253 Then
                        existsnextvariation=True
                        If playfield(x,y)=253 Then gotonextvariation=False
                EndIf
        Next x: Next y
        If existsnextvariation And gotonextvariation Then
                loadgame(VARPATH+"/"+nextvariation)
                loadTiles(0)
                game.speed = 1
                initplayfield()
        EndIf
End Sub


Sub putshape(x As Short, y As Short, typ As UByte, nodel As Byte, noshadow As Byte)
        Dim As Short strt, stp, a
        Dim As Short o
        'skip the 255-point that marks the end of the previous shape
        If typ = 1 Then strt = 0 Else strt=inputsindex(typ - 1 - 1) + 1
        stp = inputsindex(typ - 1) - 1 'leave out 255-point
        For a = strt To stp : If inputs(a, 2) <> 0 Then 
                ' determine output
                If nodel Then
                        If Not noshadow Then
                                'don't overwrite blocks with shadow
                                o = playfield(x + inputs(a, 0), y + inputs(a, 1))
                                If o = 0 Or o = 254 Then o = 253
                        ElseIf randominputs Then
                                o = randomtable(inputs(a, 2))
                        Else
                                o = inputs(a, 2)
                        EndIf
                Else 'delete
                        o = originalplayfield(x + inputs(a, 0), y + inputs(a, 1))
                        'preserve special tiles, but don't restore blocks (if any) from the beginning
                        If Not (o = 254 Or o = 253) Then o = 0 
                EndIf
                ' put
                playfield(x + inputs(a, 0), y + inputs(a, 1)) = o
        End If : Next
End Sub


Sub block.imprint(remove As Byte = True, place As Byte = True, noshadow As Byte = True)
        If (Not (settings.show_shadow And gravity) Or noshadow) And this.shadow Then Return
        If remove Then putshape(this.oldx, this.oldy, this.oldtyp, False, noshadow) 'delete old shape
        If place Then putshape(this.x, this.y, this.typ, True, noshadow) 'put new shape
End Sub


Sub block.drop()
        If Not this.move(0,1) Then
                checksituation()
                this.init()
                this.imprint()
        EndIf
        If Not this.shadow Then game.tim = Timer()
End Sub


Sub initplayfield
        ReDim playfield(0 To columns-1,0 To rows-1) As UByte
        Dim As UByte x,y
        For y=0 To rows-1 : For x=0 To columns-1
                playfield(x,y)=originalplayfield(x,y)
        Next x : Next y
End Sub


Declare Sub drawplayfield()

Sub loadTiles(increment As Byte)
        settings.tileset += increment
        If settings.tileset > UBound(tilesfiles) Then settings.tileset = 0
        If settings.tileset < 0 Then settings.tileset = UBound(tilesfiles) 

        Dim tilesfile As String
        tilesfile=GFXPATH & "/" & tilesfiles(settings.tileset)
        tilewidth = getImgWidth(tilesfile)
        game.w = tilewidth*columns : game.h = tilewidth*rows
        tilesimg = ImageCreate(tilewidth, tilewidth*(3+numberoftiles))
        BLoad tilesfile, tilesimg
        scoreimg = ImageCreate(122,20)
        BLoad GFXPATH+"/brojke.bmp", scoreimg
        resizewindow()
        ScreenSet 0,1
        drawplayfield()
End Sub


Sub drawscore
        Dim As UByte a,digit
        Dim As Byte numberstarted=False

        Dim xpx As UShort = tilewidth*columns
        Line(0,0)-(xpx,16),RGB(0,0,0),BF
        For a=0 To 9 'max 10 digits - traze se otpozadi
                If 10^a > score Then Exit For
                digit=Fix((score Mod 10^(a+1)) / 10^a)
                If digit=1 Then
                        xpx-=5
                        Put (xpx,1),scoreimg,(13,0)-(17,14),PSet
                ElseIf digit=0 Then
                        xpx-=13
                        Put (xpx,1),scoreimg,(0,0)-(12,14),PSet
                Else
                        xpx-=13
                        Put (xpx,1),scoreimg,(-8+digit*13,0)-(-8+12+digit*13,14),PSet
                EndIf
        Next
End Sub


Sub drawspeed()
        Dim y As Short = 0
        If settings.show_score Then y += SCORE_INDICATOR_SIZE
        Line (0, y) - (game.w, y + 7), RGB(22, 22, 22), BF ' background
        Line (0, y) - (game.w * game.speed / 10, y + 3), RGB(222, 222, 222), BF
        Line (0, y + 4) - (game.w * (Timer() - game.speed_timer) / SPEEDUP_TIME, y + 7), RGB(166, 166, 233), BF
End Sub


Sub drawplayfield
        ' Prevent too much redraws
        If Timer() - lastdrawplayfield < DRAWPLAYFIELD_DELAY Then
                lazydrawplayfield = Timer()
                Return
        End If
        
        shadow.imprint(False, True, False)

        Dim As Short offsetx=0,offsety=0,offsetpx=0,offsetpy=0 
        If settings.show_score Then offsetpy += SCORE_INDICATOR_SIZE
        If settings.show_speed Then offsetpy += SPEED_INDICATOR_SIZE
        Dim As UByte x,y,t
        for y=0 to rows-1 : for x=0 to columns-1
                If playfield(x,y)=0 Then : t=0
                ElseIf playfield(x,y)=254 Then : t=1
                ElseIf playfield(x,y)=253 Then : t=2
                Else : t=playfield(x,y)+2
                End If
                Put (offsetpx+(offsetx+x)*tilewidth, offsetpy+(offsety+y)*tilewidth), _
                tilesimg,(0,t*tilewidth) - Step(tilewidth-1,tilewidth-1),PSet
        Next x: Next y

        shadow.imprint(True, False, False)

        If settings.show_score Then drawscore()
        If settings.show_speed Then drawspeed()
        
        ScreenSync
        ScreenCopy

        ' Prevent too much redraws
        lastdrawplayfield = Timer()
        lazydrawplayfield = -1

End Sub


Sub loadtilesets()
        Dim l As String, n As UByte=0
        Do Until l="}" Or Eof(1)
                Line Input #1,l
                ReDim Preserve tilesfiles(n)
                tilesfiles(n)=l
                n+=1
        Loop
        ReDim Preserve tilesfiles(n-2)
End Sub


Sub loadcycle()
        Dim l As String, n As UByte
        If inputrotate Then
                ReDim nextshape(UBound(inputsindex) + 1) As UByte 
                For n = 0 To UBound(inputsindex) Step 4
                        nextshape(n + 1) = n + 2
                        nextshape(n + 2) = n + 3
                        nextshape(n + 3) = n + 4
                        nextshape(n + 4) = n + 1
                Next
        Else
                Line Input #1,l
                ReDim nextshape(Len(l)) As UByte 
                For n = 0 To Len(l) 'nextshape(0) is not used
                        nextshape(n+1)=asctonumber(l[n])
                Next
        EndIf
End Sub


Sub loadplayfield()
        columns=0 : rows=0
        Dim l As String, n As UByte
        Dim position As Integer = Seek(1)
        Dim As Short a,b=0
        Do Until l="}" Or Eof(1)
                rows+=1
                Line Input #1,l
                If Len(l)>columns Then columns=Len(l)
        Loop
        ReDim originalplayfield(0 to columns-1,0 to rows-1) as UByte
        rows-=1
        Seek #1,position
        l=""
        Do Until l="}" Or Eof(1)
                b+=1
                Line Input #1,l
                For a=0 To Len(l)-1
/'
                        If l[a]=46 Then : originalplayfield(a,b-1)=0
                        Else : originalplayfield(a,b-1)=asctonumber(l[a])
                        End If
'/
                        n=asctonumber(l[a])
                        originalplayfield(a,b-1)=n
                        If n>numberoftiles And n<100 Then numberoftiles=n 
                Next
        Loop
        If playabletiles>numberoftiles Then numberoftiles=playabletiles
End Sub


Sub loadsettings()
        wrap=False
        gravity=False
        inputrotate=False
        randominputs=False
        randomgoals=False
        Dim l As String
        Do Until l="}" Or Eof(1)
                Line Input #1,l
                wrap=wrap Or l="wrap"           
                gravity=gravity Or l="gravity"          
                inputrotate=inputrotate Or l="inputrotate"
                randominputs=randominputs Or l="randominputs"           
                randomgoals=randomgoals Or l="randomgoals"
                If Left(l,6)="tiles:" Then playabletiles=CInt(Mid(l,7))
        Loop
End Sub


Sub drop_shadow()
        If Not (settings.show_shadow And gravity) Then Return
        shadow.x = blok.x
        shadow.y = blok.y
        shadow.typ = blok.typ
        shadow.shadow = True
        Do : Loop While shadow.move(0,1)
End Sub


Sub gameRestart()
        score = 0
        game.speed = 1
        initplayfield() 
        blok.init()
        blok.imprint()
        drawplayfield() 
End Sub


Sub loadhelp()
        ReDim help(0)
        Dim l As String
        Do Until Eof(1)
                Line Input #1,l
                If l="}" Then Exit Do
                ReDim Preserve help(UBound(help) + 1)
                help(UBound(help)) = l
        Loop
End Sub


Function loadgame(filename As String) As Byte
        If filename = "" Then Return False
        Dim l As String, loadedcycle As Byte
        Open filename For Input As #1
        If Err>0 Then Print "Error opening the file":End
        Do
                Line Input #1,l
                Select Case l
                        Case "Title {"
                                Line Input #1,l
                                game.title = l
                        Case "Settings {"
                                loadsettings()
                        Case "Next {"
                                Line Input #1,nextvariation
                        Case "Tilesets {"
                                loadtilesets()
                        Case "Playfield {"
                                loadplayfield()
                        Case "Input {"
                                loadshapes(inputs(),True)
                        Case "Cycle {"
                                loadcycle()
                                loadedcycle = True
                        Case "Goals {"
                                loadshapes(goals())     
                        Case "Help {"
                                loadhelp()
                End Select
        Loop Until Eof(1)
        Close #1
        If Not loadedcycle Then loadcycle()
        gameRestart()
        loadTiles(0)
        Return True
End Function


Sub togglescore()
        settings.show_score = Not settings.show_score
        resizewindow()
        ScreenSet 0,1
        drawplayfield()
End Sub


Sub quit()
        ImageDestroy(tilesimg)
        ImageDestroy(scoreimg)
        Close #3
        End
End Sub

#include "menus.bi"


Sub drop_but_dont_fix(y As Integer)
        If Int(y  / tilewidth - blok.y) <= 0 Then Return
        If blok.move(0,1) Then
                game.tim = Timer()
                drop_but_dont_fix(y)
        End If
        blok.imprint()
End Sub


Function windowmouse(mode As String) As String
        Dim e As EVENT
        Static pressed As Integer = 0
        If (ScreenEvent(@e)) Then
                Select Case e.type
                Case EVENT_MOUSE_BUTTON_PRESS
                        If mode = "gameover" Then Return " " 'Space=end gameover
                        If settings.play_mouse Then
                                If e.button=1 Then
                                        If settings.first_button_turning And Int(e.y  / tilewidth - blok.y) <= 0 Then
                                                Return " " 'Space = turn
                                        Else
                                                drop_but_dont_fix(e.y)
                                                blok.dropping = True
                                        End If
                                        drawplayfield()
                                End If
                                If e.button=2 Then Return " " 'Space = turn
                        End If
                        If Not settings.play_mouse Or e.button>2 Then Return Chr(27) 'Esc = open menu
                Case EVENT_MOUSE_BUTTON_RELEASE
                        If settings.play_mouse Then
                                If e.button=1 And blok.dropping Then Return Chr(13) 'Enter = drop
                        End If
                Case EVENT_WINDOW_CLOSE
                        quit()
                Case EVENT_MOUSE_MOVE
                        If e.x > 0 And e.x < game.w And settings.play_mouse And mode <> "gameover" Then
                                While Int(e.x  / tilewidth - blok.x) <> 0 And blok.move(Sgn(Int(e.x  / tilewidth - blok.x)))
                                WEnd
                                If blok.dropping Then drop_but_dont_fix(e.y)
                                drawplayfield()
                        End If
                End Select
        End If
End Function


Sub gameOver()
        Dim As Short starty = 0, y = 0, endy
        Dim As Byte scoredrawn = False
        Dim tim2 As Double
        scoredrawn = settings.show_score
        If settings.show_score Then starty += SCORE_INDICATOR_SIZE
        y = starty
        endy = game.h + starty - 6
        If settings.show_speed Then endy += SPEED_INDICATOR_SIZE
        game.tim = Timer()
        tim2 = Timer()
        keypress = ""
        Do
                If Timer() - tim2 > 0.5 Then 
                        keypress = InKey()
                        If keypress = "" Then keypress = windowmouse("gameover")
                Else
                        While InKey() <> "" : Wend 'prevents exit from gameover screen for 0.5 seconds
                EndIf
                
                If y < endy Then
                        If Timer() - game.tim > 0.03 Then
                                game.tim = Timer()
                                Line (0, y) - (game.w, y + 6), RGB(0, 0, 0), BF
                                Put(game.w / 2 - 47 / 2, y + 1), scoreimg,(52, 15) - (99, 19), PSet
                                y += 1
                                ScreenSync
                                ScreenCopy
                        EndIf
                EndIf
                If y > SCORE_INDICATOR_SIZE + 4 And Not scoredrawn Then
                        drawscore()
                        scoredrawn = True
                EndIf
        Loop Until keypress<>""
        Cls
        gameRestart()
End Sub


Randomize
If Not loadgame(Command) Then
        If Not loadgame(openloader(VARPATH)) Then End 
End If
game.tim = Timer()
game.speed_timer = game.tim
Do
        If lazydrawplayfield > 0 And Timer() - lazydrawplayfield > DRAWPLAYFIELD_DELAY Then
                lazydrawplayfield = -1
                drawplayfield()
        End If
        keypress = InKey 
        If keypress = "" Then keypress = windowmouse("play")
        Select Case keypress
        Case Chr(255) + "K" 'left
                blok.move(-1)
                drawplayfield()
        Case Chr(255) + "M" 'right 
                blok.move(1)
                drawplayfield()
        Case " "
                blok.move(0,0,nextshape(blok.typ)) 'cycle
                drawplayfield()
        Case Chr(255) + "H" 'move up or rotate
                If gravity Then
                blok.move(0,0,nextshape(blok.typ)) 'cycle
                Else
                        blok.move(0,-1)
                EndIf
        drawplayfield()
        Case Chr(255) + "P" 'down
                If gravity Then
                        score+=1
                        blok.drop()
                Else
                        blok.move(0,1)
                EndIf
                drawplayfield()
        Case "t", "T"
                loadTiles(1)
        Case Chr(13) 'Enter = fix or drop
                If gravity Then
                        Do : score+=1 : Loop While blok.move(0,1)
                EndIf
                checksituation()
                blok.init()
                blok.imprint()
                drawplayfield()
        Case "s", "S" 'score
                togglescore()
        Case "o", "O" 'settings
                game.menu_timer = Timer()
                opensettings()
                'make up for lost time
                game.tim += Timer() - game.menu_timer
                game.speed_timer += Timer() - game.menu_timer
                resizewindow() : drawplayfield()
        Case "l", "L" 'load
                game.menu_timer = Timer()
                If Not loadgame(openloader(VARPATH)) Then
                        resizewindow() 'restore window size and title
                        'make up for lost time
                        game.tim += Timer() - game.menu_timer
                        game.speed_timer += Timer() - game.menu_timer
                        drawplayfield()
                End If
        Case Chr(255)+";" 'F1
                game.menu_timer = Timer()
                openhelp()
                'make up for lost time
                game.tim += Timer() - game.menu_timer
                game.speed_timer += Timer() - game.menu_timer
        Case Chr(255)+"<" 'F2
        gameRestart()
        Case "+" 'speed+
                game.speed += 1
        Case Chr(27) 'Esc
                game.menu_timer = Timer()
                openmenu()
                'make up for lost time
                game.tim += Timer() - game.menu_timer
                game.speed_timer += Timer() - game.menu_timer
        End Select
        'drop
        If gravity And Timer() - game.tim > SPEED / game.speed then
        blok.drop()
        drawplayfield()
        End If
        'speedup based on time
        If gravity And game.speed < MAX_SPEED And Timer() > game.speed_timer + SPEEDUP_TIME Then
                game.speed_timer = Timer()
                game.speed += 1
        End If
Loop