dim akt_stein(3,3)

.L_Stein_re
data 0,0,0,0
data 1,0,0,0
data 1,0,0,0
data 1,1,0,0
.
.
.
if teil=1 then ;angenommen 1 stünde für L-re
   restore  L_Stein_re
for y = 0 to 3
  for x = 0 to 3
    read teil_gesetzt
    akt_teil(x,y)=teil_gesetzt
  next
next

dim rotate_speicher(3,3)

Function rotate_teil(wie_oft)
for wieder = 1 to wie_oft
for y = 0 to 3
  for x = 0 to 3
    rotate_speicher(y,(3-x))=akt_teil(x,y) ;90° links drehen
  next
next
for x=0 to 3
  for y= 0 to 3
    akt_teil(x,y)=rotate_speicher(x,y) ;übertragen in Teilspeicher
  next
next
.upschieb
status=0
for x= 0 to 3
  if akt_teil(x,3)=1 then Status=1 ;ist ein Teil in der untersten Zeile?
next
if status =0 then ;wenn nein schiebe die oberen runter:
  for y=2 to 0 step -1
    for x = 0 to 3
      akt_teil(x,y+1)=akt_teil(x,y)
    next
   next
   for i=0 to 3: akt_teil(i,0)=0:next ;oberste Zeile "säubern"
   goto upschieb
end if
status=0

.leftschieb
for y= 0 to 3
  if akt_teil(0,y)=1 then Status=1 ;ist ein Teil in der linken Spalte?
next
if status =0 then ;wenn nein schiebe die rechten nach:
  for x=1 to 3
    for y = 0 to 3
      akt_teil(x-1,y)=akt_teil(x,y)
    next
   next
   for i=0 to 3: akt_teil(3,i)=0:next
   goto leftschieb
end if
next

end function

Dim Spielfeld (11,39)

;==============================================================
;Game   : Text-Tetris in Blitzbasic
;Version: 1.0
;Author   : Patrick Mächler aka Valio
;Email   : valio@visionsinteractive.ch
;Legal   : (c) 2003 by Patrick Mächler
;        Free use for educational purposes
;        I coded this in about an hour, 'cause I was bored.
;
;Control: Shift Block Left   - Left Arrow
;        Shift Block Right   - Right Arrow
;        Turn Block Left   - Up Arrow
;        Turn Block Right   - Down Arrow
;        Shift Block Down   - Space
;        Pause/Resume      - Enter
;        End Game         - Esc
;
;Note   : There's no Gameover. You maybe just can't move the
;        blocks to somwhere anymore.
;        The speedformula is quite simple, so on Level 20 it
;        will be impossible to play.
;==============================================================
Const Fall$="#"
Const Full$=""
Const Free$=" "
Const Wall$="¦"
Const Floor$="-"
Const Erase$="+"

Const FieldX=11
Const FieldY=13

Dim GameField(FieldX,FieldY)
Dim Block(4,4)
Dim NBlock(4,4)

Global OriginX=40
Global OriginY=40

Global BlockX, BlockY
Global BlockTime, Level=1, Score=0, Speed=1000, Pause=False

SetBuffer BackBuffer()
SeedRnd MilliSecs()

Fillfield()
NewBlock()
NewBlock()

While Not(KeyHit(1))
   Cls
   DrawField()
   If Pause=False Then MoveBlock()
   If KeyHit(28) Then
      If Pause=False Then
         Pause = True
         BlockTime = BlockTime - MilliSecs()
      Else
         BlockTime = BlockTime + MilliSecs()
         Pause = False
      EndIf
   EndIf
   DrawBlock()
   DrawGUI()
   Flip
Wend
End

;==============================================================
;Called at the beginnig, puts walls and floor in the GameField
;array.
;==============================================================

Function Fillfield()
Local x
   For x=0 To FieldY
      GameField(0,x)=2 ;2=wall
      GameField(FieldX,x)=2 ;2=wall
   Next
   For x=1 To FieldX-1
      GameField(x,FieldY)=3 ;3 =floor
   Next
End Function

;==============================================================
;This swaps the data in the NBlock (next block) array to the
;Block array and fills NBlock with data of another randomly
;chosen block.
;==============================================================

Function NewBlock()
Local x,y,r
   BlockTime=MilliSecs()
   BlockX=5
   BlockY=-2
   r=Rand(5)
   Select r
      Case 1: Restore Block1
      Case 2: Restore Block2
      Case 3: Restore Block3
      Case 4: Restore Block4
      Case 5: Restore Block5
   End Select
   For y=0 To 4
      For x=0 To 4
         Block(x,y) = NBlock(x,y)
         Read NBlock(x,y)
      Next
   Next
End Function

;==============================================================
;Analyze all game related userinputs and controls the moving
;block.
;==============================================================

Function MoveBlock()
Local t
   If KeyHit(203) Then
      BlockX=BlockX-1
      If Collide() Then BlockX=BlockX+1
   EndIf
   If KeyHit(205) Then
      BlockX=BlockX+1
      If Collide() Then BlockX=BlockX-1
   EndIf
   If KeyHit(200) Then
      RotateLeft()
      If Collide() Then RotateRight()
   EndIf
   If KeyHit(208) Then
      RotateRight()
      If Collide() Then RotateLeft()
   EndIf
   If KeyDown(57) Then BlockTime = BlockTime - Speed/3
   t=MilliSecs()
   If t>BlockTime Then
      BlockY = BlockY+1
      BlockTime = BlockTime + Speed
      If Collide() Then BlockY = BlockY-1: SetBlock(): LineCheck(): NewBlock()
   EndIf
End Function

;==============================================================
;Transfers the data in the Block array to the GameField array.
;==============================================================

Function SetBlock()
Local x,y
   For x = 0 To 4
      For y = 0 To 4
         SetField(x,y)
      Next
   Next
End Function

;---------------------------------
;Helpfunction for SetBlock().
;---------------------------------

Function SetField(x,y)
Local tx,ty
   tx = BlockX+x
   ty = BlockY+y
   If tx<0 Or tx>FieldX Or ty<0 Or ty>FieldY Then Return
   If Block(x,y)<>0 Then GameField(tx,ty)=1
   Return False
End Function

;==============================================================
;Checks if one or some rows in the game field are upfilled and
;if so, calls EraseLine() to delete the rows.
;==============================================================

Function LineCheck()
Local x,y,l,e
   For y=0 To FieldY-1
      l=0
      For x=0 To FieldX
         If GameField(x,y)<>0 Then l=l+1
      Next
      If l=FieldX+1 Then
         e = e + 1
      Else
         EraseLine(y,e)
         e = 0
      EndIf
   Next
   EraseLine(y,e)
End Function

;==============================================================
;Erases the e rows over row y, with some blinky effects and
;calls AddScore to add some score for the well done job.
;==============================================================

Function EraseLine(y,e)
Local t,m,x
   If e=0 Then Return
   m=0
   t = MilliSecs()
   For x=1 To e
      ChangeLine(y-x,1,-1)
   Next
   Repeat
      If MilliSecs()-t>300 Then
         For x=1 To e
            If (m Mod 2)=0 Then
               ChangeLine(y-x,-1,0)
            Else
               ChangeLine(y-x,0,-1)
            EndIf
         Next
         t = MilliSecs()
         m=m+1
      EndIf
      Cls
      DrawField()
      DrawGUI()
      Flip
   Until m=9
   For m=y-1 To e Step -1
      For x=0 To FieldX
         GameField(x,m)=GameField(x,m-e)
      Next
   Next
   For m=m To 0 Step -1
      ChangeLine(m,1,0)
   Next
   AddScore(e)
End Function

;---------------------------------
;Helpfunction for EraseLine().
;---------------------------------

Function ChangeLine(y,f,t)
Local x
   For x=0 To FieldX
      If GameField(x,y)=f Then GameField(x,y)=t
   Next
End Function

;==============================================================
;Adds score for the l erased rows and updates speed and level.
;==============================================================

Function AddScore(l)
   Score = Score + 10*(l^2)
   Level = 1 + Score/100
   Speed = 2200 - Level*200
End Function

;==============================================================
;Checks if the block array currently collides with the game
;field.
;==============================================================

Function Collide()
Local x,y
   For x = 0 To 4
      For y=0 To 4
         If CollideField(x,y) Then Return True
      Next
   Next
   Return False
End Function

;---------------------------------
;Helpfunction for Collide().
;---------------------------------

Function CollideField(x,y)
Local tx,ty
   tx = BlockX+x
   ty = BlockY+y
   If tx<0 Or tx>FieldX Or ty<0 Or ty>FieldY Then Return False
   If Block(x,y)<>0 And GameField(tx,ty)<>0 Then Return True
   Return False
End Function

;==============================================================
;Rotates the data in the Block array counter clockwise.
;==============================================================

Function RotateLeft()
Local x,y,swap
   For x=0 To 1
      For y=0 To 1
         swap=Block(x,y)
         Block(x,y)=Block(4-y,x)
         Block(4-y,x)=Block(4-y,4-x)
         Block(4-y,4-x)=Block(y,4-x)
         Block(y,4-x)=swap
      Next
      swap=Block(x,2)
      Block(x,2)=Block(2,x)
      Block(2,x)=Block(4-x,2)
      Block(4-x,2)=Block(2,4-x)
      Block(2,4-x)=swap
   Next
End Function

;==============================================================
;Rotates the data in the Block array clockwise.
;==============================================================

Function RotateRight()
Local x,y,swap
   For x=0 To 1
      For y=0 To 1
         swap=Block(y,4-x)
         Block(y,4-x)=Block(4-y,4-x)
         Block(4-y,4-x)=Block(4-y,x)
         Block(4-y,x)=Block(x,y)
         Block(x,y)=swap
      Next
      swap=Block(2,4-x)
      Block(2,4-x)=Block(4-x,2)
      Block(4-x,2)=Block(2,x)
      Block(2,x)=Block(x,2)
      Block(x,2)=swap
   Next
End Function

;==============================================================
;Draws the graphical user interface (GUI).
;==============================================================

Function DrawGUI()
Local p$
   ;Locate OriginX+200,OriginY
   ;print "Score : "+Score
   Text OriginX+200,OriginY,"Score: "+Score
   ;Locate OriginX+200,OriginY+20
   ;print "Level: "+Level
   Text OriginX+200,OriginY+20,"Level: "+Level
   ;Locate OriginX+200,OriginY+40
   Text OriginX+200,OriginY+40,"Speed: "+Speed
   ;print "Speed: "+Speed
   ;Locate OriginX+200,OriginY+80
   Text OriginX+200,OriginY+80,"Next Block:"
   ;print "Next Block:"
   DrawNextBlock(OriginX+200,OriginY+100)
   p$ = "PAUSE +++++ "
   If Pause Then Text (-MilliSecs()/12 Mod StringWidth(p$)), 280, String(p$,10)
End Function

;---------------------------------
;Helpfunction for DrawGUI().
;---------------------------------

Function DrawNextBlock(OX,OY)
Local s$,x,y
   For y=0 To 4
      s$ = ""
      For x=0 To 4
         If NBlock(x,y)=1 Then s$ = s$ + full Else s$ = s$ + free
      Next
      ;Locate OX,OY+y*FontHeight()
      ;Print s$
         Text OX,OY+y*FontHeight(),s$
   Next
End Function

;==============================================================
;Draw the data in the Block array.
;==============================================================

Function DrawBlock()
Local s$,x,y
   For y=0 To 4
      s$ = ""
      For x=0 To 4
         If Block(x,y)=1 Then s$ = s$ + fall Else s$ = s$ + free
      Next
      ;Locate OriginX+BlockX*FontWidth(),OriginY+(y+BlockY)*FontHeight()
      ;Print s$
      Text OriginX+BlockX*FontWidth(),OriginY+(y+BlockY)*FontHeight(),s$
   Next
End Function

;==============================================================
;Draw the game field (data in the GameField array).
;==============================================================

Function DrawField()
Local x,y,s$
   For y=0 To FieldY
      s$=""
      For x=0 To FieldX
         Select GameField(x,y)
            Case 1: s$ = s$ + full
            Case 2: s$ = s$ + wall
            Case 3: s$ = s$ + Floor
            Case -1: s$ = s$ + Erase
            Default: s$ = s$ + free
         End Select
      Next
      ;Locate OriginX,OriginY+y*FontHeight()
      ;Print s$
      Text OriginX,OriginY+y*FontHeight(),s$
   Next
End Function

;==============================================================
;Data for blocks to fill in the Block array.
;==============================================================

.Block1
Data 0,0,1,0,0
Data 0,0,1,0,0
Data 0,0,1,0,0
Data 0,0,1,0,0
Data 0,0,0,0,0

.Block2
Data 0,0,1,0,0
Data 0,0,1,0,0
Data 0,0,1,1,0
Data 0,0,0,0,0
Data 0,0,0,0,0

.Block3
Data 0,0,1,0,0
Data 0,0,1,0,0
Data 0,1,1,0,0
Data 0,0,0,0,0
Data 0,0,0,0,0

.Block4
Data 0,0,0,0,0
Data 0,0,1,0,0
Data 0,1,1,1,0
Data 0,0,0,0,0
Data 0,0,0,0,0

.Block5
Data 0,0,0,0,0
Data 0,1,1,0,0
Data 0,1,1,0,0
Data 0,0,0,0,0
Data 0,0,0,0,0