mysoft game ARCHS

[ron77]

ok here is a freebasic/fbgfx game done by mysoft with his permission to post it on the forum:

#include "fbgfx.bi"

const PI = 3.141592
const ScrWid=1280,ScrHei=720

dim as integer ArchCount
do
  input "Number of Archs";ArchCount
  if ArchCount < 1 then
    print "Too few archs, retry..."
    continue do
  end if
  if (ScrWid\ArchCount) >= 5 then exit do
  print "Too many archs, retry..."
loop

sub DrawBall( X as long , Y as long , BallSize as long )    
  dim as integer TexSize = BallSize/2 , TexSwap = TexSize  
  dim as single TexMul = sqr(BallSize/100)
  dim as integer TexOffX= ((-X*TexMul)+BallSize*256) mod BallSize
  dim as integer TexOffY= ((-Y*TexMul)+BallSize*256) mod BallSize
  dim as fb.image ptr pBall = ImageCreate(BallSize*2,BallSize*2,15)
    
  for Y as long = ((-TexSize)-TexOffY) to BallSize*3-TexSize step TexSize
    TexSwap xor= TexSize
    for X as long = ((-TexSize)-TexOffX)+TexSwap to (BallSize*3)-TexSize step TexSize*2
      line pBall,(X-TexSize\2,Y)-(X-TexSize\4,Y-TexSize\2),16
      line pBall,(X-TexSize\2,Y)-(X-TexSize\4,Y+TexSize\2),16
      line pBall,(X-TexSize\4,Y-TexSize\2)-(X+TexSize\4,Y-TexSize\2),16
      line pBall,(X+TexSize\2,Y)-(X+TexSize\4,Y-TexSize\2),16
      line pBall,(X+TexSize\2,Y)-(X+TexSize\4,Y+TexSize\2),16
      line pBall,(X-TexSize\4,Y+TexSize\2)-(X+TexSize\4,Y+TexSize\2),16
      
      paint pBall,(X-TexSize\4+1,Y-TexSize\2+1),16
      paint pBall,(X-TexSize\4+1,Y+TexSize\2-1),16
      paint pBall,(X+TexSize\4-1,Y-TexSize\2+1),16
      paint pBall,(X+TexSize\4-1,Y+TexSize\2-1),16
      paint pBall,(X-TexSize\2+1,Y),16
      paint pBall,(X+TexSize\2-1,Y),16
      
    next X
  next Y
  
  circle pBall,(BallSize,BallSize),BallSize-2,0
  paint pBall,(0,0),0,0  
  
  put (X-BallSize,Y-BallSize),pBall,trans
  ImageDestroy(pBall)
   
end sub
sub DrawGoal( DotSize as long )
  static as fb.image ptr pGoal
  if pGoal=0 then 
    const sText = "GOAL!"
    pGoal = ImageCreate(8*len(sText),8)
    Draw String pGoal, (0,0),sText    
  end if
  
  dim as long iPX = ((ScrWid-clng(pGoal->Width*DotSize))\2)+(DotSize\2)
  dim as long iPY = (ScrHei-clng(pGoal->Height*DotSize))\2
  for iY as long = 0 to pGoal->Height-1
    for iX as long = 0 to pGoal->Width-1
      if point(iX,iY,pGoal) then circle( iPX+iX*DotSize , iPY+iY*DotSize ),DotSize-DotSize\4,32+rnd*16,,,,f
    next iX
  next iY
end sub

redim as integer ArchSizes(ArchCount)
dim as integer MaxArchSize = ScrWid\ArchCount , DistanceArchs = MaxArchSize

if MaxArchSize > ScrHei*.66 then MaxArchSize = ScrHei*.66
dim as integer BallSize = MaxArchSize

for N as long = 0 to ArchCount-1
  print "Size of Arch #" & N+1 & " (5 to " & MaxArchSize\10 & ") ";  
  input ArchSizes(N)
  if ArchSizes(N)<1 or ArchSizes(N) > (MaxArchSize\10) then
    print "Size out of range, retry..." 
    N = N - 1
  end if
  ArchSizes(N) *= 5
  if ArchSizes(N) < BallSize then BallSize = ArchSizes(N)
next N

if BallSize > ScrHei\6 then BallSize = ScrHei\6
BallSize -= BallSize\4

screenres ScrWid,ScrHei

dim as fb.image ptr pBack = ImageCreate(ScrWid,ScrHei\3)

dim as integer I = 0
for N as long = DistanceArchs\2 to ScrWid-((DistanceArchs\2)-1) step DistanceArchs
  dim as single fArch = (ScrHei/4)/ArchSizes(I)
  dim as single fRad = (ScrHei/4)
  if fArch < 1 then fRad /= fArch : fArch = 1
  circle pBack,(N,ScrHei\3),fRad,14,,,fArch
  I = I+1
next N
paint pBack,(0,0),6,14

dim as double TMR = timer

dim as single BallX = ScrWid/2 , BallY = ScrHei-ScrHei\8+BallSize 'BallSize/3
dim as single CurBallX = BallX , CurBallY , ReflectX=0 , Speed = ScrHei/64
dim as integer Goals=0,Misses=0
dim as byte Shooting = false
do
  
  CurBallX = (BallX+(CurBallX*7))\8
  dim as integer CurBallSz = (((BallSize*BallY)\((ScrHei\3)-BallSize))+BallSize*3)\4
  
  screenlock
  
  put(0,0),pBack,pset
  line(0,ScrHei\3)-(ScrWid,ScrHei),0,bf
  Draw String ( 4,4 ), " Goals: " & Goals , 11
  Draw String ( 4,14 ), "Misses: " & Misses , 11
  
  if Shooting<>0 then 
    BallX += ReflectX : BallY -= Speed : Speed *= .998
    dim as integer BallYLimit = ((ScrHei\3)-BallSize)    
    if BallY <= BallYLimit then
      if Shooting=1 then 'only if it didnt collied yet
        Shooting=3 'goal
        dim as integer I = 0
        for N as long = DistanceArchs\2 to ScrWid-((DistanceArchs\2)-1) step DistanceArchs          
          var fRad = ArchSizes(I) : I += 1 
          if abs(N-BallX) < (DistanceArchs/2) then
            if abs(N-BallX) > (fRad-BallSize)*.85 then
              ReflectX = sgn(N-BallX)*(BallSize\4)
              Shooting = 2 : exit for
            end if
          end if
        next N        
      end if      
      if Shooting=2 then
        CurBallY = BallYLimit+(BallYLimit-BallY)
        CurBallSz = (((BallSize*CurBallY)\((ScrHei\3)-BallSize))+BallSize*3)\4      
      else
        CurBallY = BallyLimit
        CurBallSz = (((BallSize*BallY)\((ScrHei\3)-BallSize))+BallSize*3)\4
        '(BallSize*BallY)\((ScrHei\3)-BallSize)
      end if
      
    else
      CurBallY = BallY
    end if
        
    if Shooting=3 then 
      dim as integer DotSz = 8+sqr((BallYLimit-BallY)*2)
      DrawGoal(DotSz)
    end if
    
    if BallY <= ((ScrHei\8)-BallSize) then       
      if SHooting=2 then Misses += 1 else Goals += 1
      sleep 500 , 1 : Shooting = false : ReflectX = 0
      BallX = cint(rnd*ScrWid) : BallX -= BallX mod (BallSize\2)
      BallY = ScrHei-BallSize/3 : Speed = ScrHei/64    
    end if
  else
    CurBallY = BallY
  end if
    
  DrawBall ( CurBallX,CurBallY , CurBallSz )
  
  screenunlock
  
  if abs(timer-TMR)>1 then
    TMR = timer
  else
    var dFps = iif(Shooting=3,1/20,1/60)
    while (timer-TMR)<dFps
      sleep 1,1
    wend
    TMR += dFps
  end if
  
  do
    var sKey = inkey()
    if len(sKey)=0 then exit do
    dim as integer iKey = sKey[0]
    if iKey=255 then iKey = -sKey[1]
    
    select case iKey
    case -fb.SC_LEFT   : if Shooting=0 andalso BallX > BallSize          then BallX -= BallSize\2
    case -fb.SC_RIGHT  : if Shooting=0 andalso BallX < (ScrWid-BallSize) then BallX += BallSize\2
    case -fb.SC_UP     : Shooting = 1 'start shooting
    case 27            : exit do,do
    end select    
  loop
  
loop

You cannot view this attachment.