1
General Discussion / Sons-A-Bitches!
« Last post by Dr_D on January 27, 2024, 06:13:26 PM »Hello. 
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!
Recent Posts
2
General Discussion / RetroCoders Community - A new freeBASIC Community Forum
« Last post by ron77 on September 16, 2022, 05:12:13 PM »https://retrocoders.phatcode.net/index.php
RetroCoders Community first game-dev jam competition:
https://retrocoders.phatcode.net/index.php?topic=306.0
RetroCoders Community first game-dev jam competition:
https://retrocoders.phatcode.net/index.php?topic=306.0
3
Showcase / Re: Tetris in day
« Last post by badidea on May 25, 2022, 04:00:35 PM »hello people, long time no see!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).
4
Showcase / Tetris in day
« Last post by mysoft on March 08, 2022, 07:47:15 PM »hello people, long time no see! 
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
const BlkSz can be used to select screen scale... 8 = 1x (must be multiple of
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
const BlkSz can be used to select screen scale... 8 = 1x (must be multiple of
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
5
Showcase / my FB game on itch.io "Russian Roulette"
« Last post by ron77 on April 10, 2021, 05:57:02 AM »6
Work In Progress / GUI FREE Code
« Last post by neo on March 20, 2021, 12:15:16 AM »it taken me some time i fix the leak in it now only using 13.5mb ram i think i did a ok job ....
https://www.youtube.com/channel/UCvndZ9dI5UkoK_Tycv6i3tw
https://www.youtube.com/channel/UCvndZ9dI5UkoK_Tycv6i3tw
8
Programming / Re: new gui all freebasic
« Last post by neo on March 18, 2021, 05:35:45 AM »my freebasic ver is 0.4.6
9
Programming / Re: new gui all freebasic
« Last post by neo on March 18, 2021, 05:32:47 AM »there was a ram leak an some how i fix it now its at 13.5 mb ram so thats good
10
Programming / Re: new gui all freebasic
« Last post by neo on March 18, 2021, 05:29:45 AM »dont for get you have to make a file call pic an place icon image in there