## Let's Have Some Fun

General FreeBASIC programming questions.
D.J.Peters
Posts: 8023
Joined: May 28, 2005 3:28
Contact:
Antoni wrote:This is Joshy's long vehicle reduced to 254 bytes. It requires -lang deprecated.
Good man :-)

@cha0s
the most people won't see the real power of the vehicle code.
it's nothing more than how ANY vehicle can steering and follow ANY path.
robots, cars, trucks with trailers, trains ...

i use it for traffic and AI vehicles in free speed racer.

often i can see that peoples used any path finding code but no good looking path following with steering. bla bla bla

Joshy
Antoni
Posts: 1393
Joined: May 27, 2005 15:40
Location: Barcelona, Spain
A classic rotozoomer

Code: Select all

`Screen 13:Do:a!=a!+.08:CS=COS(A!)*ABS(SIN(A!))*128:ss=SIN(A!)*ABS(SIN(A!))*128:Sleep 15For Y=-100 To 99:For X=-160 To 159:PSET(X+160,Y+100),((X*CS-Y*ss)AND(Y*CS+X*ss))\128Next X,Y:loop`
Posts: 469
Joined: Dec 17, 2006 23:37
Contact:
Dudes, you made rea-ea-lly cool things ! I'll try to propose something too but i'll wait to code interesting stuff :p

duke4e > I like the idea of "competition" :)
RockTheSchock
Posts: 228
Joined: Mar 12, 2006 16:25

### Calculating factorials

Calculating factorials:
5000! = A number with 16326 digits

No Problem! Try this! 245 Bytes

Code: Select all

`DEFINT A-Z:CONST Z=99999:DIM f(Z):f(Z)=1:r=1:Input nFOR i=1 TO n:FOR k=Z-r TO Z:f(k)=f(k)*i:NEXTDO:k=k-1:f(k-1)=f(k-1)+f(k)\10:IF f(k-1) AND Z-k+1=r THEN r=r+1e=f(k) MOD 10:f(k)=e:LOOP UNTIL k=Z-rNEXT:FOR j=k+1 TO Z:PRINT STR(f(j));:NEXT`

You can find my original code here
http://www.antonis.de/faq/progs/fastfak.bas

FB Version 0.15 Beta
or 0.17 with -lang deprecated
Last edited by RockTheSchock on May 04, 2007 16:59, edited 1 time in total.
UWLabs
Posts: 10
Joined: Jan 24, 2006 15:12
Location: North Carolina
Contact:

### Grabbed and old QB pc... 88bytes

Code: Select all

`DO:COLOR INT(RND*16):LOCATE INT(RND*25)+1,INT(RND*80)+1:?CHR\$(INT(RND*40)+179);:LOOP`
rdc
Posts: 1713
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:

Code: Select all

`dim t(255):for i=0 to 255:t(i)=rgb(255-i,i,0):next:screen 14,32:do:n=rnd*20:m=rnd*20:for x=0 to 319:for y=0 to 239:xx=(cos(n*3*x/320)*cos(m*3*y/240))*255:yy=(cos(m*3*x/320)*cos(n*3*y/240))*255:pset(x,y),t(abs((xx-yy)) mod 255):next:next:sleep 500:loop`
phishguy
Posts: 1201
Joined: May 05, 2006 16:12
Location: West Richland, Wa
@RDC
I like your code! It looks psychodelic.
I was able to get your example down to 231 bytes. Although the sleep delay is shorter and the values are slightly different.

Code: Select all

`j=255:Dim t(j):For i=0 To j:t(i)=rgb(j-i,i,0):Next:Screen 14,32:Do:n=Rnd*20:m=Rnd*20:For x=0 To 319:For y=0 To 239:r=(Cos(n*x/106)*Cos(m*y/80))*j:s=(Cos(m*x/106)*Cos(n*y/80))*j:Pset(x,y),t(Abs((r-s)) Mod j):Next:next:Sleep j:Loop`
rdc
Posts: 1713
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:
Heh, thanks. Nice bit of compression here.
Lemon-Man
Posts: 184
Joined: Dec 04, 2006 17:47
Location: Minnesota, USA
Contact:

### Noob Warning!

Some noob code: really lame RockPaperScissors game*
250 bytes

Code: Select all

`dim as ubyte c,pdoinput pc=int(rnd(1)*3)+1select case pcase 1print "r"case 2print "p"case 3print "s"case elseendend selectselect case ccase 1print "r"case 2print "p"case 3print "s"end selectsleepclsloop`

Also some More lame TicTacToe game* code
(Not really TicTacToe, just a hash that you can color in...)
252 bytes

Code: Select all

`option explicitscreenres 100,100dim as integer x,y,cline(33,0)-(33,99),7line(66,0)-(66,99),7line(0,33)-(99,33),7line(0,66)-(99,66),7dogetmouse x,y,,cif c and 1 thenpaint (x,y),3,7elseif c and 2 thenpaint (x,y),4,7endifloop`

Sorry that im late with this,

*not actually worthy of being called a game...
Deleter
Posts: 975
Joined: Jun 22, 2005 22:33

Code: Select all

`screenres 640,480:Dim As Any Ptr s:s=imagecreate(640,480):Do:Locate Int(Sin(Timer)*10)+10,80:Print "s";:Sleep 10:Get (4,0)-(639,479),s:Put (0,0),s,xor:Loop Until multikey(1):imagedestroy(s)`

189 bytes
rdc
Posts: 1713
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:
Nice ones guys.
Antoni
Posts: 1393
Joined: May 27, 2005 15:40
Location: Barcelona, Spain
A floormapper in 175 bytes (-lang deprecated)

Code: Select all

` SCREEN 13dor+=1 AND 15FOR y=1 TO 99y1=((1190/y+r)AND 15)y2!=6/yFOR x=0 TO 319PSET(x,y+100),CINT((159-x)*y2!)AND 15 XOR y1+16NEXT x,yLoop until LEN(INKEY)`
rdc
Posts: 1713
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:
That is awesome.
Antoni
Posts: 1393
Joined: May 27, 2005 15:40
Location: Barcelona, Spain
Factorize an integer up to 1.8E20 (-lang deprecated) 235 bytes

Code: Select all

`defulongint a-zdim shared x,ssub f(k)Do:if (x mod k) then  exit do   ?" ";k;:x\=k:s=sqr(x):loopend Suba=2:k=5INPUT "num ";x:?; s=sqr(x)f(2):f(3)WHILE K<=sf(k)k+=aa=6-aWENDif x>1 then ?" ";x;sleep `

you can check the results here http://www.alpertron.com.ar/ECM.HTM
Antoni
Posts: 1393
Joined: May 27, 2005 15:40
Location: Barcelona, Spain
This one is 100 bytes too big, I'm unable to squeeze it more.
It Prints a calendar of any month you request (-lang deprecated)

Code: Select all

`Input"y,m";y1,mIf m>2 Then m-=3:y=y1 Else m+=9:y=y1-1n=IIf(m=11,28-(y1 MOD 4=0)+(y1 MOD 100=0)-(y1 MOD 400=0),30-((1717and(1Shl i))>0))w=(2+y+y\4-y\100+y\400+Cint(2.6*m))Mod 7?Mid("MarAprMayJunJulAugSepOctNovDecJanFeb",m*3+1,3);" ";y1?"Mo Tu We Th Fr Sa Su"For i=1-w To n:If i>0 Then ?Using "## ";i; Else ?"   ";If i Mod 7=7-w Then ? Next:sleep`