10.03.2019 - Round 1 results of our "A Love Letter For FreeBASIC" game dev competition have been published. Please be sure to check the results thread: http://games.freebasic.net/forum/index.php?topic=629.0. Don't forget that the competition is continuing with a round 2, lasting till 29th of April, 300 USD first prize. Stay tuned!

Author Topic: Tetris in day  (Read 161 times)

mysoft

  • Recruit
  • **
  • Posts: 49
    • MSN Messenger - mysoft@bol.com.br
    • View Profile
    • MyTDT Software
    • Email
Tetris in day
« on: March 08, 2022, 07:47:15 PM »
hello people, long time no see! :D
so i was trying some algorithms out, and for fun then i ended making a simple game of tetris
without any dependencies (it have no sound... but its fully playable with an ending ^^)

arrow keys to control... (up to rotate, left/right to move, down to fall)
must finish 99 lines to reach the end of the game (it worths!!!) have fun :P

const BlkSz can be used to select screen scale... 8 = 1x (must be multiple of 8)

Code: [Select]
#define fbc -s gui

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

'scale in multiple of 8...
const BlkSz=32

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

static shared as byte _bMatrix(16*28-1)
static shared as fb.image ptr pFont

type Piece
  as byte bSz 
  as zstring*17 zPiece
end type

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 integer 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 integer = 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),pFont,(0,iC)-step(BlkSz-1,BlkSz-1), and
    end if
    iPX += BlkSz
  next N
end sub

screenres 20*BlkSz,20*BlkSz,8
windowtitle "Mysoft Simple Tetris"

pFont = ImageCreate(BlkSz,BlkSz*128)
for N as long = 1 to 127
  line pFont,(0,0)-(7,7),0,bf
  draw string pFont,(0,0),chr(N),255
  var iScale = BlkSz\8 , PY = N*BlkSz
  for iY as long = 0 to 7
    for iX as long = 0 to 7
      var iN = point(iX,iY,pFont)
      if iN then line pFont,(iX*iScale,PY)-step(iScale-1,iScale-1),255,bf
    next iX
    PY += iScale
  next iY
next N

for Y as long = -4 to 18
  bMatrix(0,Y) = 8 : bMatrix(11,Y) = 8
next Y
memset( @bMatrix(0,19) , 8 , 3*16 )

randomize()

var iGameOver = 0 , iPause = 0 , iStarted=0 , iCongrats = 0
var iScore = 0 , iLines = 0 , iLevel = 1 , iWant = 7 , iWantAdd = 7
var iPiece = 2+cint(int(rnd*5)) , iNext = cint(int(rnd*7))
var iPX = 4 , iPY = -(tPiece(iPiece).bSz+1) , iAngle = 0 , iFall = 0
dim as double dMove = timer , dAnim , dFps
dim as single fPosY = -1000 , fSpd = 0

do
 
  if abs(timer-dFps) > 1/5 then dFps = timer
  while (timer-dfps) < 1/60
    sleep 1,1
  wend
  dFps += 1/60 
 
  do
    var sKey = inkey()
    if len(sKey)=0 then exit do
    var iKey=cint(sKey[0])
    if iKey=255 then iKey=-sKey[1]
    select case iKey
    case 27 , -asc("k") : exit do,do
    case asc("P"),asc("p")
      if iPause then dMove=timer+dMove else dMove=timer-dMove     
      iPause xor= 1
    case -fb.SC_LEFT  : if PieceAct(iPX-1,iPY,iPiece,iAngle,paCheck) then iPX -= 1
    case -fb.SC_RIGHT : if PieceAct(iPX+1,iPY,iPiece,iAngle,paCheck) then iPX += 1
    case -fb.SC_UP
      var iNewA = (iAngle+1) and 3
      if PieceAct(iPX,iPY,iPiece,iNewA,paCheck) then
        iAngle = iNewA
      else
        for iY as long = 0 to 1
          for iX as long = -1 to 1
            if PieceAct(iPX+iX,iPY+iY,iPiece,iNewA,paCheck) then
              iPX += iX : iPY += iY : iAngle=iNewA : exit for,for
            end if
          next iX
        next iY
      end if
      if iNewA=iAngle andalso PieceAct(iPX,iPY+1,iPiece,iAngle,paCheck)=0 then dMove=timer     
    case -fb.SC_DOWN  : iFall=1
    case else
      if iGameover orelse iCongrats then       
        iGameover = 0 : iCongrats = 0
        iWant = 7 : iPause = 0 : iWantAdd = 7
        iScore = 0 : iLines = 0 : iLevel = 0 : iStarted = 0
        iPiece = 2+cint(int(rnd*5)) : iNext = cint(int(rnd*7))
        iPX = 4 : iPY = -(tPiece(iPiece).bSz+1) : iAngle = 0 : iFall = 0
        for Y as long = -4 to 18
          memset( @bMatrix(1,Y) , 0 , 10 )
        next Y
        continue do,do
      end if
    end select   
  loop 
 
  if iPause then
    if iCongrats then
      DrawFont( BlkSz , 08*BlkSz , "!! Well !!",(10+((timer*10) and 1)*2) )         
      DrawFont( BlkSz , 10*BlkSz , "!! Done !!",(12-((timer*10) and 1)*2) )         
      continue do
    end if     
    if iGameOver 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 )   
      continue do
    end if 
    DrawFont( 12*BlkSz+BlkSz\2 , 17*BlkSz , "Paused!",((timer*3) and 1)*14 )   
    continue do
  end if
 
  if iLevel < 10 andalso (iFall orelse abs(timer-dMove) > (.7-(iLevel*.05))) then
    dMove = timer
    if PieceAct(iPX,iPY+1,iPiece,iAngle,paCheck) then
      iPY += 1
    else
      if PieceAct( iPX,iPY,iPiece,iAngle,paSet)=0 then iPause=1:iGameOver=1
      iPX=4 : iPY = -tPiece(iNext).bSz : iFall=0 : iAngle = 0
      iPiece = iNext : iNext = cint(int(rnd*7))
      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 += iLevel*4937+1 : iWantAdd += 1
        iLevel += 1 : iWant += iWantAdd
      end if
      if iLevel >= 10 then
        dAnim = timer+2 : fPosy = BlkSz*20 : fSpd = BlkSz/128
        for Y as long = -4 to 18
            memset( @bMatrix(1,Y) , 0 , 10 )
        next Y       
      end if
      iScore += iPoints+iif(iPoints,33,0)
    end if
  end if
 
  screenlock
  cls
   
  for Y as integer = 0 to 19
    for X as integer = 0 to 11
      if 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
 
  if iLevel < 10 then
    if iStarted then
      for iY as long = iPY to 19
        if PieceAct( iPX,iY+1 , iPiece , iAngle , paCheck ) = 0 then
          PieceAct( iPX,iY , iPiece , iAngle , paShadow ) : exit for
        end if
      next iY
    end if   
    PieceAct( iPX,iPY , iPiece,iAngle,paOverlay ) 
    PieceAct(  15, 2  , iNext ,  0   ,paOverlay ) 
  end if
 
  DrawFont( 13*BlkSz+BlkSz\2 , 0*BlkSz , "Next:" , 5 )   
 
  DrawFont( 13*BlkSz , 6*BlkSz , "Level:" , 6 )   
  DrawFont( 15*BlkSz+BlkSz\2 , 7*BlkSz , "" & iif(iLevel>9,"*",str(iLevel)) , 11 ) 
  DrawFont( 13*BlkSz , 9*BlkSz , "Score:" , 6 )   
  DrawFont( 13*BlkSz ,10*BlkSz , right("00000" & iScore,6) , 11 )     
  DrawFont( 13*BlkSz ,12*BlkSz , "Lines:" , 6 )   
  DrawFont( 15*BlkSz ,13*BlkSz , right("0" & iLines,2) , 11 )   
 
  if dAnim andalso (timer>dAnim) then
    static as string sFire(5)
    var iLevel = 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 integer = 0 to 5
        sFire(N) = "C" & iif(cint(rnd),12,14)
        for I as integer = 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 integer = 0 to (BlkSz\8)-1
      draw "BM" & (BlkSz*4+T) & "," & (cint(fPosY)+T) & "S" & BlkSz & "C15U14R3D6R2U20" _
      "R2U10L2D3L2U6R2U2R2U5R3D5R2D2R2D6L2U3L2D10R2D20R2U6R3D14L3U5L2DL2DL3UL2UL2D5L3"
      for N as integer = 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 : iCongrats = 1 : iPause = 1
   
  end if
   
  screenunlock
 
  if iStarted = 0 then
    DrawFont( 12*BlkSz+BlkSz\2 , 15*BlkSz , "any KEY"  ,10 )   
    DrawFont( 12*BlkSz         , 17*BlkSz , "to start!",10 )   
    iStarted = 1 : sleep
  end if
 
loop

Programming is like love... you will never acomplish anything by treating your language as if it was a tool, or a slave of yours...

badidea

  • Amoeba
  • *
  • Posts: 4
    • View Profile
    • Email
Re: Tetris in day
« Reply #1 on: May 25, 2022, 04:00:35 PM »
hello people, long time no see! :D
This site is a bit deserted. But anyway, I found a bug. I you keep the UP-button (rotation) pressed, the piece never stops rotating (it does not touch the floor).