Tetris in a day

[mysoft]

so, some months ago, i decided as a sample for my students to make a game of tetris in a day... this is the result of it... plus some small changes for it to work in DOS and the later addition of replay's.

'#define fbc -s gui
#cmdline "-s gui"

#include "fbgfx.bi"
#include "crt.bi"
#include "file.bi"

'scale in multiple of 8...
#ifdef __FB_DOS__
  #undef puts
  #undef printf
  #define puts(_S)
  #define printf(_S,_P...)
  const BlkSz=10
#else
  const BlkSz=32
#endif

#define RoundFonts
#define bMatrix(_X,_Y) _bMatrix((_Y)*20+(_X)+(4*20+2))

const MaxActBuf = 32767 , cMaxChar = 127
const MaxDelay = (1 shl 10)-1 , MaxAct = (1 shl 6)-1 , MaxPieces = 7

enum ActionType
  atNone
  atIdle
  atLeft
  atRight
  atDrop
  atRotate  
  atPiece = MaxAct-(MaxPieces+1)
end enum
type ActionStruct
  wDelay :10 as ushort
  wAct   :6  as ushort
end type
type HighScore
  uScore as ulong    
  zName  as zstring*8
  uHash  as ulong
end type  
type Piece
  as byte bSz  
  as zstring*17 zPiece
end type

static shared as ActionStruct g_Stream(MaxActBuf) = any
static shared as byte g_bRecording = 0 , g_bReplaying = 0
static shared as long g_iStreamFrames , g_iStreamLength
static shared as long g_iStreamPos = 0 , g_iStreamSize , g_iFrames = 0
static shared as string g_sReplayFile
memset(@g_Stream(0),255,(MaxActBuf+1)*2)

sub Replay_AddAction( bAct as ActionType )
  if g_iStreamPos >= MaxActBuf then exit sub
  while g_iFrames > MaxDelay
    g_iFrames -= MaxDelay : g_iStreamFrames += MaxDelay
    with g_stream(g_iStreamPos)
      .wDelay = MaxDelay : .wAct = atIdle : g_iStreamPos += 1
    end with    
  wend
  with g_stream(g_iStreamPos)
    .wDelay = g_iFrames : .wAct = bAct : g_iStreamPos += 1
  end with
  g_iStreamFrames += g_iFrames : g_iFrames = 0 
  g_Stream(g_iStreamPos).wAct = MaxAct  
  printf(!"Record: %i entries\r",g_iStreamPos)
end sub
function Replay_GetAction(bForce as byte=0) as ActionType
  with g_Stream(g_iStreamPos)
    if .wAct = MaxAct then 
      printf(!"Replay completed! %-16s\n","")      
      g_bReplaying=0: return atNone
    end if
    if bForce orelse g_iFrames >= .wDelay then
      'g_iStreamFrames += .wDelay
      g_iFrames -= .wDelay : g_iStreamPos += 1
      return .wAct 
      'var iAct = .wAct    
      'printf(!"Delay=%i Action=%i , iFrames=%i\n",cint(.wDelay),cint(iAct),cint(g_iFrames)) : return iAct
    end if
  end with
  'printf(!"\rNext at %i, now %i ",g_Stream(g_iStreamPos).wDelay,g_iFrames)
  return atNone
end function
function Replay_Save( tScore as HighScore = type(0,"Latest",0) ) as byte
  var f = freefile(), sFile = hex(tScore.uScore,5)
  var sPath = exepath+"/Replays" : mkdir sPath
  for N as long = 0 to len(tScore.zName)-1
    sFile += hex(tScore.zName[N],2)
  next N
  if open(sPath+"/"+sFile for binary access write as #f) then return 0    
  dim as ushort tSave(g_iStreamSize-1) = any
  dim as HighScore tHdr = any
  dim as ushort uCrypt  = cint(rnd*255)+(cint(rnd*255) shl 8)
  dim as ushort uCrypt2 = (g_iStreamSize xor uCrypt)
  dim as ushort uCrypt3 = ((g_iStreamSize+(g_iStreamSize shl 4)) xor &hA5A5) and &hFFFF
  with tHdr
    .uScore = uCrypt or (uCrypt2 shl 16)
    for N as long = 1 to 7
      .zName[N] = rnd*255
    next N
    .zName = tScore.zName : .uHash = 0
    for N as long = 0 to 3
      cptr(ushort ptr, @.zName)[N] xor= iif(N and 1,uCrypt2,uCrypt)
      .uHash = (.uHash*7)+cptr(ushort ptr, @.zName)[N]
    next N
    for N as long = 0 to g_iStreamSize-1
      var uAct = *cptr(ushort ptr,@g_Stream(N))
      .uHash = (.uHash*3)+uAct
      tSave(N) = uAct xor iif(N and 1,uCrypt3,uCrypt)
    next N    
  end with
  put #f,,tHdr
  put #f,,tSave(0),g_iStreamSize
  close #f
  return 1
end function
function Replay_Load( tScore as HighScore = type(0,"Latest",0) , bDelete as byte=0 ) as byte
  
  var f = freefile(), sFile = hex(tScore.uScore,5)
  var sPath = exepath+"/Replays" 
  for N as long = 0 to len(tScore.zName)-1
    sFile += hex(tScore.zName[N],2)
  next N
  if bDelete then return kill(sFile)
  sPath += "/"+sFile
  if len(g_sReplayFile) then sPath=g_sReplayFile  
  if open(sPath for binary access read as #f) then return 0
  var iSz = lof(f)
  if iSz < sizeof(HighScore) orelse iSz > (sizeof(HighScore)+(MaxActBuf+1)*sizeof(ActionStruct)) then
    close #f : return 0
  end if
  
  dim as HighScore tHdr = any
  dim as ushort uCrypt=any,uCrypt2=any,uCrypt3=any  
  dim as ulong uSize,uHash
  
  get #f,,tHdr  
  with tHdr    
    uCrypt = .uScore and &hFFFF
    uCrypt2 = (.uScore shr 16)
    uSize = uCrypt2 xor uCrypt
    uCrypt3 = (uSize+(uSize shl 4) xor &hA5A5) and &hFFFF
    if iSz <> (sizeof(HighScore)+(uSize*sizeof(ActionStruct))) then
      puts("Bad file size!")
      close #f: return 0
    end if
    dim as ushort tSave(uSize-1) = any
    uHash = 0
    for N as long = 0 to 3
      uHash = (uHash*7)+cptr(ushort ptr, @.zName)[N]
      cptr(ushort ptr, @.zName)[N] xor= iif(N and 1,uCrypt2,uCrypt)      
    next N
    if len(g_sReplayFile)=0 then
      .zName[7]=0 : if .zName <> tScore.zName then close #f: return 0
    end if
    get #f,,tSave(0),uSize : close #f
    var uFrames = 0
    for N as long = 0 to uSize-1      
      tSave(N) xor= iif(N and 1,uCrypt3,uCrypt)      
      uHash = (uHash*3)+tSave(N)
      uFrames += cptr(ActionStruct ptr,@tSave(0))[N].wDelay
    next N
    if uHash <> .uHash then
      puts("Bad Hash on content")
      return 0
    end if
    memcpy( @g_Stream(0) , @tSave(0) , (uSize*sizeof(ActionStruct)) )
    g_iStreamSize = uSize : g_iStreamPos = 0
    printf(!"Frames=%i\n",uFrames)
    g_iStreamLength = uFrames
    g_Stream(uSize).wAct = MaxAct
  end with
  return 1
end function
#define Replay_Delete( _t ) Replay_Load( _t , 1 )

static shared as HighScore g_tHigh(11)
static shared as byte _bMatrix(20*28-1), g_iLevel
static shared as fb.image ptr g_pFont

function HashScore( iScore as long , iSave as byte ) as long
  dim as long uResu = &hF0E1D2
  with g_tHigh(iScore)    
    if iSave then
      var iLen = len(.zName)
      for N as long = iLen+1 to 6
        .zName[N] = rnd*255
      next N
    end if
    for N as long = 0 to 7
      uResu += (iScore+1)*(((.zName[N]+33*(iScore+1)) and 255)+1)*((.uScore xor &h55FF55)+(iScore+1))
      uResu += iScore+(iScore shl 8)+(iScore shl 16)+(iScore shl 24)
    next N
  end with
  return uResu
end function
function ReadKey() as long  
  do
    var sKey = inkey
    if len(sKey)=0 then exit do
    dim as long iKey = sKey[0]
    if iKey = 255 then iKey = -sKey[1]
    select case iKey
    case -fb.SC_LEFT,-fb.SC_RIGHT,-fb.SC_DOWN,-fb.SC_UP
      if g_bReplaying then continue do
    end select
    return iKey
  loop    
  
  if g_bReplaying then
    var iAct = Replay_GetAction()
    select case iAct
    case atNone , atIdle  : rem do nothing
    case atLeft  : return -fb.SC_LEFT
    case atRight : return -fb.SC_RIGHT
    case atDrop  : return -fb.SC_DOWN
    case atRotate: return -fb.SC_UP
    case atPiece to atPiece+(MaxPieces-1)
      g_iStreamPos -= 1 : g_iFrames += g_Stream(g_iStreamPos).wDelay
      'g_iStreamFrames -= g_Stream(g_iStreamPos).wDelay
    case else : printf(!"Invalid action %i\n",iAct)
    end select        
  end if
  return 0  
  
end function

sub LoadScores() constructor  
  
  var f = freefile()  
  if open("HighScore.bin" for binary access read as #f)=0 then
    if lof(f) = sizeof(HighScore)*10 then
      get #f,,g_tHigh(0),10
    end if
    close #f
  end if
  'check invalid scores
  for N as long = 0 to 9
    with g_tHigh(N)
      .zName[7] = 0
      var uHash = HashScore(N,0)
      if (N<>9 andalso .uScore = 0) orelse uHash <> .uHash then
        printf(!"#%i score set to default.\n",N+1)
        .zName = "       "
        .uScore = 620000-(N*40000)
        if N = 9 then .uScore = 0
      end if
    end with
  next N
end sub
sub SaveScores() 'destructor
  var f = freefile()
  if open("HighScore.bin" for binary access write as #f) then exit sub
  for N as long = 0 to 9
    with g_tHigh(N)
      .uHash = HashScore(N,1)
      .zName[7] = rnd*255
    end with
  next N
  put #f,,g_tHigh(0),10
  for N as long = 0 to 9
    g_tHigh(N).zName[7] = 0
  next N
  close #f
end sub

chdir exepath()

static shared as piece tPiece(...) = { _  
  (3,"*  **  * " ) , (3," * ** *  " ) , (4," *   *   *   *  "  ) , (2,"****" ) , _
  (3,"*  *  ** " ) , (3," *  * ** " ) , (3,"   *** * " ) }
rem ------------------------------------

enum PieceActs
  paShadow , paOverlay , paSet , paCheck
end enum

function PieceAct(  iPX as long , iPY as long , iPiece as long , iAngle as long , iAct as long ) as long
  if iPiece<4 then iAngle and= 1
  var iFill = iPiece+9, iBorder = iFill xor 8 , iPen = &hFFFF
  if iAct = paShadow then iPen = &h3333: iAct=paOverlay : iBorder = iFill : iFill=0
  function = 1
  with tPiece( iPiece )    
    for Y as long = 0 to .bSz-1
      for X as long = 0 to .bSz-1
        dim as long iN(3) = { Y*.bSz+X , X*.bSz+(.bSz-1)-Y , ((.bSz-1)-Y)*.bSz+(.bSz-1)-X ,  ((.bSz-1)-X)*.bSz+Y }
        if .zPiece[iN(iAngle)] <> asc("*") then continue for
        select case iAct
        case paOverlay
          line ((iPX+X)*BlkSz,(iPY+Y)*BlkSz)-step(BlkSz-1,BlkSz-1),iFill,bf
          line ((iPX+X)*BlkSz,(iPY+Y)*BlkSz)-step(BlkSz-1,BlkSz-1),iBorder,b,iPen
        case paSet
          bMatrix(iPX+X,iPY+Y)=iFill
          if (iPY+Y) < 0 then function = 0
        case paCheck
          if bMatrix(iPX+X,iPY+Y) then return 0
        end select
      next X
    next Y    
  end with
end function
sub DrawFont( iPX as long , iPY as long , sText as string , iColor as long )
  for N as long = 0 to len(sText)-1    
    var iC = sText[N]*BlkSz
    'if iC <> (32*BlkSz) then
      line(iPX,iPY)-step(BlkSz-1,BlkSz-1),iColor,bf
      put (iPX,iPY),g_pFont,(0,iC)-step(BlkSz-1,BlkSz-1), and
    'end if
    iPX += BlkSz
  next N
end sub
sub DrawMatrix(bFull as byte=0)
  for Y as long = 0 to 19
    for X as long = 0 to iif(bFull,19,11)
      if g_iLevel=10 andalso (X>0 andalso X<11) then continue for 
      var iC = bMatrix(X,Y)
      if iC then 
        line(X*BlkSz,Y*BlkSz)-step(BlkSz-1,BlkSz-1),iC,bf
        line(X*BlkSz,Y*BlkSz)-step(BlkSz-1,BlkSz-1),iC xor 8,b
      end if
    next X
  next Y
end sub
function NextPiece(iFirst as byte=0) as long  
  while g_bReplaying
    var iAct = Replay_GetAction(1)
    select case iAct
    case atNone      
      puts("None!?")
      sleep
    case atIdle      
      puts("Idle!")
      continue while
    case atIdle+1 to atPiece-1      
      puts("shouldnt get actions other than pieces at NextPiece()")
    case atPiece to atPiece+(MaxPieces-1)
      return iAct-atPiece
    case else
      printf(!"Invalid action %i\n",iAct)
    end select
    return 0
  wend
    
  const cIter = 1*7
  static as byte iLeft=-1 , bNum(cIter-1)
  do
    if iLeft < 1 then
      if iLeft=-1 then 
        for N as long = 0 to cIter-1
          bNum(N) = (N mod 7) 'printf("%i ",bNum(N))
        next N      
      end if
      for N as long = 0 to cIter-1
        swap bNum(N),bNum(cint(int(rnd*cIter)))
      next N
      iLeft = cIter
    end if
    iLeft -= 1  
    'printf(!"%i %i\n",iLeft,bNum(iLeft))
    if iFirst=0 orelse bNum(iLeft) >= 2 then exit do
  loop
  if g_bRecording>0 then Replay_AddAction( atPiece+bNum(iLeft) )
  return bNum(iLeft)  
end function

#ifdef __FB_DOS__
screenres 320,200
#else
screenres 20*BlkSz,20*BlkSz,8
#endif
windowtitle "Mysoft Simple Tetris"

'Create Font
g_pFont = ImageCreate(BlkSz,BlkSz*(cMaxChar+1))
for N as long = 1 to cMaxChar
  var iScale = BlkSz\8 , PY = N*BlkSz 
  var iRad = (iScale\2), iRad2 = (iScale+1)\2  
  if iRad2 < 1 then iRad2 = 1
  if iRad then
    line g_pFont,(0,PY)-(BlkSz-1,PY+BlkSz),0,bf
    line g_pFont,(0,0)-(9,9),0,bf  
    draw string g_pFont,(1,1),chr(N),255
    var iW = iif(iRad=1,iRad,iRad2-1)
    for iY as long = 0 to 7
      for iX as long = 0 to 7
        var iN = point(iX+1,iY+1,g_pFont)      
        if iN then         
          #ifdef RoundFonts
            for iOY as long = -1 to 1
              for iOX as long = -1 to 1
                if point(iX+iOX+1,iY+iOY+1,g_pFont) then
                  for iNY as long = -(iRad-1) to (iRad2-1)
                    for iNX as long = -(iRad-1) to (iRad2-1)
                      line g_pFont,(iX*iScale+iRad+iNX,PY+iRad+iNY)-step(iOX*iW,iOY*iW),255
                    next iNX
                  next iNY
                end if
              next iOX
            next iOY
          #else
            line g_pFont,(iX*iScale,PY)-step(iScale-1,iScale-1),255,bf
          #endif
        end if
      next iX
      PY += iScale    
    next iY
  else
    draw string g_pFont,(0,PY),chr(N),255
  end if
  line g_pFont,(0,0)-(BlkSz-1,BlkSz-1),8,bf
next N

#ifdef __FB_DOS__
scope
  var iL = ((20*BlkSz)-320)\2, iT = ((20*BlkSz)-200)\2
  window screen (iL,iT)-(iL+320,iT+200)
end scope
#endif

randomize()

dim as long iScore,iLines,g_bLevel,iWant=7,iWantAdd=7
dim as long iMoveTime , iPX , iPY
dim as byte bGameOver,bPause,bStarted,bCongrats
dim as byte bPiece,bNext,bAngle,bFall,bAdvance,bOnce
dim as double dAnim , dFps
dim as single fPosY = -1000 , fSpd = 0

do
  
  var bTurbo = cbyte(multikey(fb.SC_CONTROL) or bAdvance), bSkip=bTurbo
  if g_bReplaying=1 andalso bFall=0 then bSkip=1
  var iFps = iif(bTurbo,60*(4-(g_bReplaying*3)),60)      
  if bPause=0 then iMoveTime += 1 : g_iFrames += 1  
  if g_bReplaying then
    g_iStreamFrames += 1
    if g_iFrames >= g_Stream(g_iStreamPos).wDelay then bSkip=0
    if g_Stream(g_iStreamPos).wAct=MaxAct then 
      printf(!"Replay completed! %-16s\n","")
      g_bReplaying=0 : bPause=1 : bGameOver=1
    end if
  else
    bSkip=0
  end if
  
  if bSkip then
    'dFps = timer'-(1/iFps)
  else
    if abs(timer-dFps) > 1/2 then dFps = timer
    while (timer-dfps) < 1/iFps
      sleep 1,1
    wend  
    dFps += 1/iFps
    if abs(timer-dFps) > (1/iFps)*2 then bSkip=1
  end if  
    
  do   
    var iKey = ReadKey()
    select case iKey
    case 0 : exit do    
    case -asc("k") : exit do,do    
    case asc("a"): iLines += 1 : iScore += 5000
    case -fb.SC_END : bNext = (bNext+1) mod 7
    case asc("P"),asc("p")      
      bPause xor= 1 
    case -fb.SC_LEFT        
      if PieceAct(iPX-1,iPY,bPiece,bAngle,paCheck) then 
        iPX -= 1
        if g_bRecording>0 then Replay_AddAction( atLeft )
      end if
    case -fb.SC_RIGHT 
      if PieceAct(iPX+1,iPY,bPiece,bAngle,paCheck) then 
        iPX += 1
        if g_bRecording>0 then Replay_AddAction( atRight )
      end if
    case -fb.SC_UP
      var iNewA = (bAngle+1) and 3
      if PieceAct(iPX,iPY,bPiece,iNewA,paCheck) then
        if g_bRecording>0 then Replay_AddAction( atRotate )
        bAngle = iNewA
      else
        for iY as long = 0 to 1
          for iX as long = -1 to 1
            if PieceAct(iPX+iX,iPY+iY,bPiece,iNewA,paCheck) then 
              if g_bRecording>0 then Replay_AddAction( atRotate )
              iPX += iX : iPY += iY : bAngle=iNewA : exit for,for
            end if
          next iX
        next iY
      end if
      if iNewA=bAngle andalso PieceAct(iPX,iPY+1,bPiece,bAngle,paCheck)=0 then iMoveTime=0
        
    case -fb.SC_DOWN  
      if bFall=0 then
        bFall=1
        if g_bRecording>0 then Replay_AddAction( atDrop )
      end if
    case else            
      if bGameOver orelse bCongrats orelse g_bReplaying then
        bGameOver = 0 : bCongrats = 0 : bStarted = 0 : bPause = 0
      elseif iKey = 27 then
        bPause=1 : bGameOver=1
      end if           
    end select    
  loop  
    
  if bPause then     
    screenlock
    if bCongrats then
      DrawFont( BlkSz , 08*BlkSz , "!! Well !!",(10+((timer*10) and 1)*2) )          
      DrawFont( BlkSz , 10*BlkSz , "!! Done !!",(12-((timer*10) and 1)*2) )          
      screenunlock : continue do
    end if      
    if bGameOver then       
      DrawFont( 13*BlkSz+BlkSz\2 , 15*BlkSz , "Game",((timer*3) and 1)*12 )    
      DrawFont( 14*BlkSz, 17*BlkSz , "Over!",((timer*3) and 1)*12 )    
      screenunlock : continue do
    end if      
    if g_bReplaying then
      DrawFont( 12*BlkSz+BlkSz\2 , 16*BlkSz , "Replay!",((timer*3) and 1)*10 )
    end if
    DrawFont( 12*BlkSz+BlkSz\2 , 17*BlkSz , "Paused!",((timer*3) and 1)*14 )    
    screenunlock : continue do
  end if 
    
  if bStarted then
    screenlock
    if bSkip=0 then line(0,0)-(20*BlkSz,20*BlkSz),0,bf
    
    if g_bReplaying then
      DrawFont( 12*BlkSz+BlkSz\2 , 16*BlkSz , "Replay!",((timer*3) and 1)*10 )      
      var iPerMili = (g_iStreamFrames*1000)\g_iStreamLength
      dim as zstring*16 zPlay = any
      var iX = sprintf(zPlay,"%i.%i%%",iPerMili\10,iPerMili mod 10)
      iX = 16*BlkSz-(iX*BlkSz)\2    
      DrawFont( iX , 18*BlkSz , zPlay,7 )    
    end if
    
    if g_bLevel < 10 andalso (bFall orelse iMoveTime >= (42-g_bLevel*3)) then
      iMoveTime = 0
      if PieceAct(iPX,iPY+1,bPiece,bAngle,paCheck) then
        iPY += 1
      elseif PieceAct( iPX,iPY,bPiece,bAngle,paSet)=0 then 
        puts("Game over!")
        bPause=1:bGameOver=1
        if g_bRecording > 0 then 
          g_bRecording = -1 : g_iStreamSize = g_iStreamPos      
          g_iStreamLength = g_iStreamFrames
        end if
      else
        iPX=4 : iPY = -tPiece(bNext).bSz : bFall=0 : bAngle = 0
        bPiece = bNext : bNext = NextPiece()
        var iPoints = 0
        for Y as long = 18 to 0 step -1
          for X as long = 1 to 10
            if bMatrix(X,Y)=0 then continue for,for
          next X
          for YY as long = Y to 1 step-1
            memcpy( @bMatrix(1,YY) , @bMatrix(1,YY-1) , 10 )
          next YY
          Y += 1 : iPoints = (iPoints*3+777) : iLines += 1
        next Y
        if iLines > 99 then iLines = 99
        if iLines >= iWant then 
          iScore += g_bLevel*4937+1 : iWantAdd += 1
          g_bLevel += 1 : iWant += iWantAdd
        end if
        if g_bLevel >= 10 then
          if g_bRecording = 0 then 
            bCongrats = 1 : bPause = 1
          else
            dAnim = timer+2  : fPosy = BlkSz*20 
            fSpd = BlkSz/128
            for Y as long = -4 to 19
                memset( @bMatrix(1,Y) , 0 , 10 )
            next Y          
          end if
        end if
        iScore += iPoints+iif(iPoints,33,0)
      end if
    end if
    
    if bSkip=0 then DrawMatrix()    
    
    if g_bLevel < 10 andalso bStarted then    
      for iY as long = iPY to 19
        if PieceAct( iPX,iY+1 , bPiece , bAngle , paCheck ) = 0 then
          if bSkip = 0 then PieceAct( iPX,iY , bPiece , bAngle , paShadow ) 
          exit for
        end if
      next iY
      if bSkip=0 then
        PieceAct( iPX,iPY , bPiece,bAngle,paOverlay )  
        PieceAct(  15, 2  , bNext ,  0   ,paOverlay )
      end if
    end if
    
    if bSkip=0 then
      DrawFont( 13*BlkSz+BlkSz\2 , 0*BlkSz , "Next:" , 5 )
      DrawFont( 13*BlkSz , 6*BlkSz , "Level:" , 6 )    
      DrawFont( 15*BlkSz+BlkSz\2 , 7*BlkSz , "" & iif(g_bLevel>9,"*",str(g_bLevel)) , 11 )  
      DrawFont( 13*BlkSz , 9*BlkSz , "Score:" , 6 )    
    end if
    if bSkip=0 then
      if iScore > 999999 then
        iScore = 999999
        DrawFont( 13*BlkSz ,10*BlkSz , "******" , 11 )
      else
        DrawFont( 13*BlkSz ,10*BlkSz , right("00000" & iScore,6) , 11 )
      end if
      DrawFont( 13*BlkSz ,12*BlkSz , "Lines:" , 6 )
      DrawFont( 15*BlkSz ,13*BlkSz , right("0" & iLines,2) , 11 )
    end if
    
    if dAnim andalso (timer>dAnim) then
      static as string sFire(5)
      var g_bLevel = fSpd , fDelay = 200/1000    
      if fSpd > BlkSz/64 then fDelay = 100/1000
      if fSpd > BlkSz/48 then fDelay = 50/1000
      if fSpd > BlkSz/32 then fDelay = 30/1000
      
      while (timer-dAnim) > fDelay
        dAnim += fDelay    
        for N as long = 0 to 5
          sFire(N) = "C" & iif(cint(rnd),12,14)
          for I as long = 0 to cint(fSpd*(85/BlkSz))
            sFire(N) += chr(iif(cint(rnd),asc("R"),asc("L")),asc("D"))
          next I
        next N    
        fPosY -= fSpd : fSpd *= 1.03
      wend
      
      for T as long = 0 to (BlkSz\8)-1
        draw "BM" & (BlkSz*4+T) & "," & (cint(fPosY)+T) & "S" & BlkSz & "C15U14R3D6R2U20" _
        "R2U10L2D3L2U6R2U2R2U5R3D5R2D2R2D6L2U3L2D10R2D20R2U6R3D14L3U5L2DL2DL3UL2UL2D5L3"
        for N as long = 0 to 5
          draw "BM" & ((BlkSz*5)+T+((BlkSz*N)\2)) & "," & (cint(fPosY)+T) & sFire(N)
        next N
      next T    
      if fPosy < (BlkSz*-40) then 
        dAnim = 0 : bCongrats = 1 : bPause = 1
        if g_bRecording>0 then 
          g_bRecording = -1 : g_iStreamSize = g_iStreamPos
          g_iStreamLength = g_iStreamFrames
        end if
      end if    
    end if
    
    'locate 1,1: print iWant
    
    screenunlock
  else
    if len(g_sReplayFile) then exit do
    dim as HighScore tDelete = any
    dim as ulong TempLastScore = g_tHigh(9).uScore
    'iScore = 333333 : g_bRecording = 1
    
    dim as long iNewScorePos = 10
    if g_bRecording then 
      g_tHigh(9).uScore = iScore
      g_tHigh(9).zName = ""       
      for N as long = 9 to 1 step-1
        if g_tHigh(N).uScore < g_tHigh(N-1).uScore then exit for
        iNewScorePos = N : swap g_tHigh(N), g_tHigh(N-1)
      next N    
      if iNewScorePos=10 then      
        if g_bRecording  then Replay_Save(): SaveScores()
      else
        tDelete = g_tHigh(9)
        g_tHigh(9).uScore = iScore
      end if
      g_tHigh(9).zName = "Latest"
    end if
        
    cls : erase _bMatrix
    var iX = 0 , iY = 0 , iC = 9 , iUpdate = 0    
    DrawFont( 4*BlkSz+BlkSz\2 , 2*BlkSz , "High Scores" , 11 )
        
    for N as long = 1 to 10
      with g_tHigh(N-1)
        dim zText as zstring*32 = any , iColor as byte = 6+8*(N and 1)
        sprintf(zText,"%c.%-7s %06i",asc("0")+(N mod 10),.zName,.uScore)        
        if N = 10 then
          DrawFont( 2*BlkSz , (3+N)*BlkSz , "----------------" , 8 ) 
          iColor = 3+8*(N and 1) : N += 1
        end if
        DrawFont( 2*BlkSz , (3+N)*BlkSz , zText , iColor )
      end with
    next N
    
    DrawFont(  5*BlkSz         , 16*BlkSz , "0-9"    , 15 )
    DrawFont(  3*BlkSz+BlkSz\2 , 17*BlkSz , "Replay" , 9 )
    DrawFont( 14*BlkSz+BlkSz\2 , 16*BlkSz , "S"      , 15 )
    DrawFont( 13*BlkSz         , 17*BlkSz , "Play"   , 10 )
    
    g_iStreamPos = 0 : g_iStreamFrames = 0
    g_iFrames = 0 : g_bRecording = 1 : g_bReplaying = 0
    
    do
      if bOnce=0 then 'check for replay file
        var sCmd = command() : bOnce=1
        if len(sCmd) andalso FileExists(sCmd) then          
          g_sReplayFile = sCmd : Replay_Load()
          if g_iStreamSize then 
            puts("Replay from file!")
            swap g_bRecording , g_bReplaying
            exit do
          else
            puts("invalid replay file :(")
            g_sReplayFile=""
          end if
        end if
      end if

      scope 'rotate borders
        dim as long iSN(3) = {+1, 0,-1, 0}      
        for N as long = 0 to (19*4)-1
          bMatrix(iX,iY) = iC : iC += 1
          if iC = 16 then iC = 9
          iX += iSN(N\19) : iY += iSN(((N\19)-1) and 3)
        next N 
      end scope
      screenlock    
      DrawMatrix(1)
      
      while iNewScorePos <> 10
        static as long iSwapTitle = 10 : iSwapTitle xor= (10 xor 9)
        DrawFont( 2*BlkSz , 2*BlkSz , "Enter your name!" , iSwapTitle )
        var iY = (3+iNewScorePos)*BlkSz
        with g_tHigh(iNewScorePos-1)
          var iLen = len(.zName)
          if iUpdate then            
            DrawFont( 4*BlkSz , iY , .zName , 6+8*(iNewScorePos and 1)  )
            line( (4+iLen)*BlkSz , iY )-step(((7-iLen)*BlkSz)-1,BlkSz-1),0,bf
            if iUpdate = -1 then 'last update
              DrawFont( 1*BlkSz+BlkSz\2 , 2*BlkSz , "   High Scores   " , 11 )
              iNewScorePos=10 : exit while
            end if
            iUpdate=0
          end if          
          if iLen > 6 then iLen = 6
          put ( (4+iLen)*BlkSz , iY ) , g_pFont,(0,0)-(BlkSz-1,BlkSz-1), xor
        end with
        exit while
      wend
      
      screenunlock
      sleep 100,1
      
      do        
        var iKey = ReadKey()
        select case iKey
        case 0 : exit do
        case 27,-asc("k")     
          exit do,do,do
        end select
        if iNewScorePos <> 10 then 'new score (get name)
          with g_tHigh(iNewScorePos-1)
            select case iKey
            case 8 'backspace
              var iLen = len(.zName)
              if iLen then .zName[iLen-1]=0 : iUpdate = 1
            case 13,10
              iUpdate = -1 'final update
              Replay_Save(g_tHigh(iNewScorePos-1))
              Replay_Delete(tDelete)
              swap TempLastScore , g_tHigh(9).uScore
              SaveScores() 'save without modified "latest" score
              swap TempLastScore , g_tHigh(9).uScore
            case 1 to cMaxChar
              var iLen = len(.zName)
              if iLen > 6 then iLen=6              
              .zName[iLen] = iKey : .zName[iLen+1] = 0
              iUpdate = 1
            end select
          end with          
        else 'just showing scores now
          select case iKey
          case asc("0")
            if g_iStreamSize=0 then Replay_Load()
            if g_iStreamSize then 
              swap g_bRecording , g_bReplaying
              exit do,do
            end if
          case asc("1") to asc("9")        
            Replay_Load( g_tHigh(iKey-asc("1")) )
            if g_iStreamSize then 
              swap g_bRecording , g_bReplaying
              exit do,do
            end if
          case else 'asc("s"),asc("S")
            exit do,do
          end select
        end if
      loop      
      
    loop
    
    randomize()
    'DrawFont( 12*BlkSz+BlkSz\2 , 15*BlkSz , "any KEY"  ,10 )    
    'DrawFont( 12*BlkSz         , 17*BlkSz , "to start!",10 )        
    'sleep    
    bStarted = 1 : iMoveTime = 0 :  iWant = 7 : iWantAdd = 7
    iScore = 0 : iLines = 0 : g_bLevel = 1 : bAngle = 0 : bFall = 0
    bPiece = NextPiece(1) : bNext = NextPiece()
    iPX = 4 : iPY = -(tPiece(bPiece).bSz+1)    
    for Y as long = -4 to 18 : memset( @bMatrix(1,Y) , 0 , 10 ) : next Y      
    'Matrix border
    for Y as long = -4 to 18
      bMatrix(0,Y) = 8 : bMatrix(11,Y) = 8
    next Y
    memset( @bMatrix(0,19) , 8 , 3*16 )
      
  end if
  
loop

You cannot view this attachment.You cannot view this attachment.

this .zip file includes the same source as above, a compiled version for windows along one highscore and replay...

You cannot view this attachment.   

[johnno56]

Slight problem... Cut and Paste into PoseidonFB and compiled...

You cannot view this attachment.

I do not know enough of FB to fix this... Sorry...

J

[ron77]

Hello johnno56 I've checked the code on Poseidon FB, and yes, it throws errors, but when I switched to another IDE it compiled and ran successfully - I guess the problem is with Poseidon FB and how it works differently with the fbc compiler...

I recommend you to try the code again in Geany IDE as Poseidon FB is a half-backed buggy IDE that has many bugs and is done very badly both on Linux and windows...

Try Geany IDE and tell us if it works...

[johnno56]

Ran with Geany without error... Cool... Thank you.

[yevrowl]

Thanks for this Tetris.
Please tell which lines need to be changed in order to run under DOS?

[ron77]

hello @yevrowl

i compiled the tetris game code with freebasic for dos (DJGPP) AND ADDED HDMPI32.EXE file and a batch file so you can run it under dos (either dosbox or freeDOS OS) I am attaching it here for you as a zip file - tell us if it works for you (to start the game just run START.BAT file)

You cannot view this attachment.

[yevrowl]

i compiled the tetris game code with freebasic for dos (DJGPP) AND ADDED HDMPI32.EXE file and a batch file so you can run it under dos (either dosbox or freeDOS OS) I am attaching it here for you as a zip file - tell us if it works for you (to start the game just run START.BAT file)

Thanks a lot, Tetris works great!