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
Tetris2-M.pngTetris2-I.png
this .zip file includes the same source as above, a compiled version for windows along one highscore and replay...
Tetris2.zip
Slight problem... Cut and Paste into PoseidonFB and compiled...
tetris.png
I do not know enough of FB to fix this... Sorry...
J
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...
Ran with Geany without error... Cool... Thank you.
Thanks for this Tetris.
Please tell which lines need to be changed in order to run under DOS?
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)
tetris.zip
Quote from: ron77 on Apr 18, 2024, 03:32 PMi 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!
(https://i.postimg.cc/Wdc19R6p/tetris-001.png) (https://postimg.cc/Wdc19R6p) (https://i.postimg.cc/SXyNhWvw/tetris-002.png) (https://postimg.cc/SXyNhWvw) (https://i.postimg.cc/t12RCs07/tetris-003.png) (https://postimg.cc/t12RCs07) (https://i.postimg.cc/HcnYJTHz/tetris-004.png) (https://postimg.cc/HcnYJTHz) (https://i.postimg.cc/wyr6Lnjp/tetris-005.png) (https://postimg.cc/wyr6Lnjp) (https://i.postimg.cc/H87T23r7/tetris-006.png) (https://postimg.cc/H87T23r7)