Let's Have Some Fun

General FreeBASIC programming questions.
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

Let's Have Some Fun

Postby duke4e » May 02, 2007 12:40

I have found this idea on blitzmax forums, but I think it's really cool. So, here's the deal:

-your source code cannot exceed 255 bytes
-it can only use librarys provided with FB
-it shouldn't be OS specific
-it shouldn't load any external data

ok, here's my entry

Code: Select all

s=480:a=1:b=1:c=s/4:d=s/7:Screen 18:Do:Cls:Getmouse(x,y,,):Line(x-40,s-9)-(x+40,s),,bf:Line(x-40,0)-(x+40,9),,bf:Circle(c,d),10:c+=a:d+=b:If d>s Or d<0 Then End
If Abs(c-x)<40 Then If d>s-10 Or d<10 Then b*=-1
If c>640 Or c<0 Then a*=-1
Sleep 1:Loop


---------
=252 bytes
Antoni
Posts: 1393
Joined: May 27, 2005 15:40
Location: Barcelona, Spain

Postby Antoni » May 02, 2007 13:41

Code: Select all

1 SCREEN 13
2 r% = (r% + 1) AND 15
3 FOR y% = 1 TO 99
4   y1% = ((1190 / y% + r%) AND 15)
5   y2! = 6 / y%
6   FOR x% = 0 TO 319
7    PSET (x%, y% + 100), CINT((159 - x%) * y2!) AND 15 XOR y1% + 16
8 NEXT x%, y%
9 IF LEN(INKEY) = 0 THEN 2

250 bytes (requires -lang deprecated)
1000101
Posts: 2556
Joined: Jun 13, 2005 23:14
Location: SK, Canada

Postby 1000101 » May 02, 2007 13:58

Code: Select all

Dim As uByte Ptr foo
Do
foo = Rnd * 2^31
*foo = Rnd * 255
Loop


66 bytes
Richard
Posts: 2999
Joined: Jan 15, 2007 20:44
Location: Australia

Postby Richard » May 02, 2007 15:10

Life is a game, the aim of which is to discover the rules of the game.
We now know the rules, what is the cool idea?
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

Postby duke4e » May 02, 2007 15:34

I thought it's obvious. Make a program using the above rules. Aynthing you want. It can be a graphics demo, it can be a game, it can be something text related, or math related, etc...

Imagine this as a competition - who can write the most impressive stuff with above posted limitations.
D.J.Peters
Posts: 8023
Joined: May 28, 2005 3:28
Contact:

Postby D.J.Peters » May 02, 2007 17:09

Code: Select all

#define _d #define
_d _w wend
_d w_ while
w_ (y<80):y+=1:x=-5:w_ x<75:x+=1:? chr(32+k);:i!=0:j!=0:r!=0:k=0
w_ k<120:k+=1:j!=r!*r!-i!*i!-2+x/27:i!=2*r!*i!+(y-40)/40:if (j!*j!+i!*i!)>15 then exit w_
r!=j!:_w:_w:_w:sleep
-lang qb ~220
Tafoid
Posts: 80
Joined: Sep 26, 2006 17:37
Location: USA
Contact:

Postby Tafoid » May 02, 2007 18:15

I'll try..

Code: Select all

dim m as string
st:
cls
width 80,3
input"Message: ";m
input"Pause (MSec): ";p
m=m+string(80,32)
cls
do
a=1
for c=1 to len(m):d=c:locate 2,80-c,0
if d>79 then a=a+1:d=79:locate 2,1,0
sleep p:if inkey<>"" then goto st
?mid(m,a,d)
next
loop


Compile with -lang qb
254 bytes

Tafoid
Antoni
Posts: 1393
Joined: May 27, 2005 15:40
Location: Barcelona, Spain

Postby Antoni » May 02, 2007 18:30

A starfield...

Code: Select all

#Define a 400
Screen 13:Dim x(a),y(a),z(a)
#Define p (160+x(j)/z(j),100+y(j)/z(j))
#Define r RND*2e4-1e4
Do:For j=0 To a:If z(j)=0 THEN x(j)=r:y(j)=r:z(j)=100*RND+1
PSet p,0:z(j)-=1:IF z(j)THEN PSET p,32-z(j)\8
Next:Sleep 15:Loop Until Len(InKey)
h4tt3n
Posts: 693
Joined: Oct 22, 2005 21:12
Location: Denmark

Postby h4tt3n » May 02, 2007 20:21

PHEW! This one was pretty hard to squeeze down, but I did it at last: 255 bytes.

Edit: ten thousand asteroids on the screen. Pull them around with the mouse and make funny patterns. See if you can mak them orbit the mouse in ellipses or even harder a perfect circle...

Note: coded with 0.16

Code: Select all

n=9999:dim as single v(n),w(n),x(n),y(n):screen 19:for a=0 to n:v(a)=rnd*99:w(a)=rnd*99:next:do:getmouse mx,my:for a=0 to n:e=v(a)-mx:f=w(a)-my:c=e*e+f*f:D=sqr(c):x(a)-=e/D*9/c:y(a)-=f/D*9/c:v(a)+=x(a):w(a)+=y(a):pset(v(a),w(a)),a*a:next:sleep 1:cls:loop
Richard
Posts: 2999
Joined: Jan 15, 2007 20:44
Location: Australia

Postby Richard » May 02, 2007 20:32

Code: Select all

Randomize Timer:Dim As Double i=200,j,a=.2+2*Rnd,b=0.3+2*Rnd,c=-13-4*Rnd,x,y,xx,yy
Screen 21:Window(-240,-i)-(i,i)
a:For i=1 To 2e4:Pset(x+y,x-y),j:xx=y-Sgn(x)*Sqr(Abs(a*x-b)):yy=c-x:x=xx:y=yy:Next i
j+=1:If j>15 Then j=0
If Inkey$ = "" Then goto a

(A Martin Set) 252 bytes
redcrab
Posts: 619
Joined: Feb 07, 2006 15:29
Location: France / Luxemburg
Contact:

Postby redcrab » May 02, 2007 20:56

what the aim of this ?
shorter code of how to obfuscate the code ?

That's fun !
Antoni
Posts: 1393
Joined: May 27, 2005 15:40
Location: Barcelona, Spain

Postby Antoni » May 02, 2007 21:35

Code: Select all

SCREEN 12
1 CLS
i= (i+1)And &HFFFFF
k!=6.3*RND
l!=6.3*RND
n=(n+1)MOD 15
FOR j=0 TO 100000
PSET(320+300*SIN(.01*SIN(k!)+j),240+200*SIN(.01*SIN(l!)*j)),n+1
Next
Sleep 500
If LEN(INKEY)<1THEN 1

Lissajous -lang deprecated
anonymous1337
Posts: 5494
Joined: Sep 12, 2005 20:06
Location: California

Postby anonymous1337 » May 02, 2007 23:05

Can I ask you guys your point in using a : rather than a new line? It's one character either way >.>;;
cha0s
Site Admin
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:

Postby cha0s » May 02, 2007 23:09

Actually, CR LF is 2 characters. :P

Let's not get off topic, post again with some code, anonymous1337.
KristopherWindsor
Posts: 2428
Joined: Jul 19, 2006 19:17
Location: Sunnyvale, CA
Contact:

Postby KristopherWindsor » May 03, 2007 0:03

Code: Select all

screen 12:do:cls:for a=1 to 640:circle (a,sin(timer/2+a)*300+300),a/20,15:next:sleep 20:loop


92 Characters! :-]

Return to “General”

Who is online

Users browsing this forum: No registered users and 5 guests