The 50 years ago moon landing 4K contest!

Game development specific discussions.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

The 50 years ago moon landing 4K contest!

Post by D.J.Peters »

The 50 years ago moon landing 4K contest !
(sorry about my bad written English)

50 years ago I was 5 years old and saw it on a black and white TV in Germany
I was a tiny child but it was clear for me something special is going on :-)
(A night in front of an TV as a child what a unique exception!)

In memory and honor to all the tough involved peoples that makes it possible,
what are about a "tiny" 4K source code FreeBASIC contest ?

The 4 rules:

1) It must be to do with the Apollo moon mission !
(don't write a Parkman clone again and put the NASA sign on it)

2) The BASIC code you wrote must less ore equal 4096 bytes (4K).
(for measuring, only one *.bas file are allowed and it's size count)

3) It must be run on all Windows and Linux supported OS's.
(Bad idea to include any Windows API only stuff or SDL, Alegro, OpenGL etc. this libs are not installed on all target machine)

4) It's a FreeBASIC contest so it must be #lang "fb" compatible (not the Q-BASIC nor fblite stuff)

Of course you can include *.bi files witch are included in a "standard" FreeBASIC setup !
For example #include "crt.bi" or #include "fbgfx.bi" are allowed but NOTE the last example cost 19 bytes so only 4077 bytes are left :-)

Note 32 vs 64-bit:
if you write on 32-bit, colors as an example are not integers on 64-bit use u/long instead (32-bit)
...

Tips:
Don't load any prepared external files like levels or images !(remember Rule 2: only one *.bas file are allowed)
(of course you can create files on the fly and load it if it makes sense)

Every end of line in source code needs space, on Windows 2 bytes and MAC/Linux 1 byte per line.
May be you will put many commands in one line you can, but be a ware every command separator ":" counts also one byte :-(

use #define if it makes things smaller !
As an example "#define L Line" makes only sense if you use the Line command more then 3 times !
"#define L Line" <- counts 14 chars
"Line Line Line" <- counts 14 chars also !

If you prefer a full screen mode (I do it for games and demos)
be sure ScreenList() report a supported mode on the target device.
Some modern 64-bit systems don't support 8-bit full screen modes anymore.

Remember it's a size contest not writing easy to read nor well nice formatted code.

How many time you get ?
All time you need :-) If you are ready publish it here in this forum thread.

What you can win ?
A lot of fun and all our respect !

Joshy
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: The 50 years ago moon landing 4K contest!

Post by dodicat »

For fun to start.
(Kinda from an old post)
The crew didn't know then about how the little flag would cause all sorts of conspiracy theories.
Because it looked like it was flapping about in a breeze, and the whole mission looked like it was done in some draughty hanger in the Nevada desert or somewhere.
Here the lads are taking pot shots at it with the flare gun (Which really should be kept for emergencies).
No scoring or anything like that, just for fun.
Edit-set a couple of sleep 10 for smoother run.
~3907 bytes.

Code: Select all

 
Dim As Integer wx,wy
Screen 20,32,,64
Screeninfo wx,wy
Dim Shared As Any Ptr i:i=Imagecreate(wx,wy,0)
Type v2
As Single x,y
End Type
Const k=1   
Const g=9.81
Const m=5   
Const pi=acos(-1)
Dim Shared As Integer mx,my,btn,x
x=990
#define DC circle
#define Ds draw string
#define range(f,l) Int(Rnd*((l+1)-(f))+(f))
#define map(a,b,x,c,d)  ((d)-(c))*((x)-(a))/((b)-(a))+(c)
#define IC(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
#define inbox mx>20 andalso mx<400 andalso my>300 andalso my<340
#macro Tline(x1,y1,x2,y2,th,cl,im)
var h=Sqr((x2-x1)^2+(y2-y1)^2),s= (y1-y2)/h ,c=(x2-x1)/h
Line im,(x1+s*th/2,y1+c*th/2)-(x2+s*th/2,y2+c*th/2),cl
Line im,(x1-s*th/2,y1-c*th/2)-(x2-s*th/2,y2-c*th/2),cl
Line im,(x1+s*th/2,y1+c*th/2)-(x1-s*th/2,y1-c*th/2),cl
Line im,(x2+s*th/2,y2+c*th/2)-(x2-s*th/2,y2-c*th/2),cl
Paint im,((x1+x2)/2,(y1+y2)/2),cl,cl
#endmacro
Sub Dline(x as long,y as long,a as single,L as long,col As Ulong,i as any ptr=0)
a=a*.0174532925199433 
Var x2=x+L*Cos(a)
Var y2=y-L*Sin(a)
Tline(x,y,x2,y2,10,col,i)
End Sub
Sub Cimage
line i,(0,0)-(1023,767),rgba(0,0,0,220),bf
randomize 1
static as long z=-10
if x<400 or x>990 then z=-z
dim as single y,ly=768
for n as single=0 to 1024 step .5
if n mod 3=0 then pset i,(rnd*1024,690-rnd*768)
y=700-10*(sin(n/50)+cos(n/45)+sin(n/65))
var f=(ly-y)
f=50+f*250
pset i,(n,y)
line i,(n,1024)-(n,y),rgb(f,f,f)
ly=y
next
line i,(x,750)-(x+5,700)
line i,(x+3,720)-(x+25,700),rgb(178,54,32),bf
for n as long=1 to 9
line i,(x+3,700+n*2)-(x+25,700+n*2),rgb(255,255,255)
next
line i,(x+3,700)-(x+12,710),rgb(60,60,110),bf
x+=z
End Sub
Function Regulate(Byval MyFps as long,Byref fps as long=60) as long
Static As Double tv,lst,t3,f
f+=1
If (Timer-t3)>=1 Then t3=Timer:fps=f:f=0
Var st=lst+((1/myfps)-Timer+tv)*1000
If st<1 Then st=1
lst=st
tv=Timer
Return st
End Function
Sub fire(st As v2,th as single,v as single)
Randomize
th=th*(4*Atn(1))/180
Dim As Integer wx,wy,w=range(-10,10)
Screeninfo wx,wy
Dim As v2 p,lp
Dim as single t
Do
t+=.05
p.x=st.x+(m/k)*(1-Exp(-(k/m)*t))*(V*Cos(th)-w)+w*t
p.y=st.y+(m/k)*(1-Exp(-(k/m)*t))*(V*Sin(th)+g*m/k)-(g*m/k)*t
Screenlock
Put(0,0),i,pset
Ds(500,20),"Solar Wind " & Abs(w)
If w<0 Then
Ds(500,60),"<---"
Else
Ds(500,60),"--->"
End If
DC(p.x,wy-p.y),4,rgb(200,5,5),,,,f
DC i,(p.x,wy-p.y),4,rgb(200,5,5),,,,f
lp=p
Screenunlock
Sleep regulate(60)
if IC(x+5,18,5,p.x,p.y) then  Ds i,(500,500),"HIT" '20
Loop Until p.y<0
End Sub
Sub show(p As long,th as long,cx as long,cy as long)
Dim as string zz = _
"C4278215905B"_
&"BM155,135M+-15,0M+-1,5"_
&"M+2,2M+9,1M+4,1M+0,2M+-2,5M+-7,0"_
&"M+-3,3M+4,4M+4,4M+1,5M+5,-14"_
&"M+-1,-7M+1,-8"_
&"BM+-6,17P4278248960,4278215905"_
&"BM+6,-16M+0,-4"_
&"BM+-8,3P4278241280,4278215905"
Put(0,0),i,pset
DC(150,150),25,rgb(0,50,180),,,,f
draw zz:color rgb(200,200,200)
DC(150,130),12,rgb(200,200,200),,,.39,f
DC(150,174),4,rgb(255,255,255),,,.25,f
Ds(195,145),"<-- Fire",rgb(200,0,0)
Ds(50,280),"Charge = " &p
Ds(400,320),"<--- Adjust Charge"
Line(20,300)-(400,340),rgb(0,200,255),b
Ds(20,350),"100":Ds(390,350),"300"
DC(0,768),100,rgb(0,200,0)
Ds(100,740),"<------  Adjust elevation"
Ds(20,600),"Elevation = "&th
DC(cx,cy),20
Dline(0,768,th,100,rgb(200,100,0))
End Sub
Dim As String key
Dim As Integer cx=200,cy=320,pdr=200,theta=40
Cimage
Do
key=Inkey
Getmouse mx,my,,btn
Screenlock
show(pdr,theta,cx,cy)
If btn=1 And inbox Then
Cls
show(pdr,theta,cx,cy)
cx=mx
If cx<40 Then cx=40
If cx>380 Then cx=380
pdr=map(40,380,cx,100,300)
End If
If IC(150,150,25,mx,my) And btn Then
Screenunlock
sleep 10
Cls
Cimage
fire(Type(0,0),theta,pdr)
End If
If IC(0,768,100,mx,my) And btn=1 Then
Cls
show(pdr,theta,cx,cy)
Var a=Atan2(768-my,mx)
theta=a*180/pi
End If
Screenunlock
sleep 10   
Loop Until key=Chr(27)
If i Then Imagedestroy i
Last edited by dodicat on Jul 27, 2019 23:18, edited 1 time in total.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: The 50 years ago moon landing 4K contest!

Post by deltarho[1859] »

@dodicat

I knew that you would be first out the traps. <smile>

However, the 'Adjust Charge' is a bit 'flaky'. A left click sometimes works and other times I get 'Not responding'.

Actually, I am getting 'Not responding' in other areas as well.

Have you changed your editor's settings? There are no indentations making it difficult to read the code.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: The 50 years ago moon landing 4K contest!

Post by D.J.Peters »

deltarho[1859] wrote:There are no indentations making it difficult to read the code.
D.J.Peters wrote:Remember it's a size contest not writing easy to read nor well nice formatted code.
Last edited by D.J.Peters on Jul 24, 2019 12:22, edited 2 times in total.
Knatterton
Posts: 165
Joined: Apr 19, 2019 19:03

Re: The 50 years ago moon landing 4K contest!

Post by Knatterton »

dodicat wrote: No scoring or anything like that, just for fun.
Good work, but i hitted the flag in 4. attempt.
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: The 50 years ago moon landing 4K contest!

Post by deltarho[1859] »

D.J.Peters wrote:Remember it's a size contest not writing easy to read nor well nice formatted code.
My mistake, I didn't realize that was an instruction to turn off automatic indentation in our IDEs. <Quickly exists stage left><smile>
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: The 50 years ago moon landing 4K contest!

Post by deltarho[1859] »

With Joshy's editing we lose the animation of the flare.

I would suggest we do not remove the ScreenUnlock at line 130 but insert a ScreenLock just after line 137. That is, dodicat did not have one ScreenUnlock too many but one ScreenLock too little. Added: The 'Sleep 10' works a treat, I am not getting 'Not responding' anywhere now.

Code: Select all

If incircle(0,768,100,mx,my) And btn=1 Then
  Cls
  ScreenLock ' !!!  <--- added
  show(pdr,theta,cx,cy)
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: The 50 years ago moon landing 4K contest!

Post by dodicat »

In the sub fire the screenlock is paired with a screenlock and a sleep, so that is OK.
Try puting sleep 1 (or 10) below each screenunlock in the main code (two instances).
If that is OK then I'll edit the code.
(still under the 4k)
Thanks for testing.
I think you have a super fast machine deltarho, and need a sleep strictly after every screenunlock.
If I indent it comes > 4K.
I suppose I could do more #defines, but it looks silly enough now.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: The 50 years ago moon landing 4K contest!

Post by D.J.Peters »

4K only what a stupid rule ;-)

After I got an idea for a tiny game I copied my triangle filler in the apollo11.bas file at first.

Ups only this one function is more then 4K ~4500 byes !

Wish me luck to get down to near 1K :-)

Joshy
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: The 50 years ago moon landing 4K contest!

Post by deltarho[1859] »

dodicat wrote:I think you have a super fast machine deltarho, and need a sleep strictly after every screenunlock.
That is a good point. In another thread, where I was having issues, XP was working OK and with srvaldez's Mac. Anyone using XP has probably got a CPU weaker than mine and, if memory serves, srvaldez's Mac is getting a bit long in the tooth.
Try puting sleep 1 (or 10)
With Windows 'Sleep n' where n < 16 will give a Sleep of 15.625ms (1/64 x 1000) whether we like it or not. Only when we use your world-famous

Code: Select all

Declare Function settimer Lib "winmm" Alias "timeBeginPeriod"(As Ulong=1) As Long
Declare Function freetimer Lib "winmm" Alias "timeEndPeriod"(As Ulong=1) As Long
can we go below the radar with n < 16.
If I indent it comes > 4K.
Ah! In that case apologies to Joshy for my outrageously cryptic remark. <smile>
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: The 50 years ago moon landing 4K contest!

Post by D.J.Peters »

D.J.Peters wrote:Wish me luck to get down to near 1K :-)
Looks like I'm a lucky man today :-)

I compressed it from 4500 down to 953 bytes !

only screenptr, screeninfo and imageinfo are not compressed

A polygon filler in 28 lines of compressed code:

Code: Select all

fu Poly(img as any ptr,v() av,n ai,c32 al) ab
dim ai iW,iH,iP,f,t,b,l,r,lv,lc,nl,rc,nr,lx,ls,rx,rs,cl,cr,nc
dim al ptr p,s,e
ir(n,<,3)
lv=n-1:i img=0 th:p=screenptr():ir(p,=,0)
screeninfo iW,iH,,,iP:el:i imageinfo(img,iW,iH,,iP,p) trf
ei:t=iH:b=-t:l=iW:r=-l:fo nc=0 to lv:wi v(nc)
i t>.y th t=.y:f=nc
ia(b,<,.y)
ia(l,>,.x)
ia(r,<,.x)
en wi:ne:i (r-l)<1oe(b-t)<1 trf
iW-=1:iH-=1
ir(l,>,iW)
ir(r,<,1)
ir(t,>,iH)
ir(b,<,1)
ia(b,>,iH)
lc=f:nl=lc-1:iv(nl,<,0,lv)
rc=f:nr=rc+1:iv(nr,>,lv,0)
ip shr=2:p+=t*iP:b+=1
wh t<b:i t=v(lc).y th:wh v(lc).y=v(nl).y:lc=nl:nl-=1:iv(nl,<,0,lv)
ew:lx=v(lc).x sl:ls=((v(nl).x-v(lc).x) sl)/(v(nl).y-v(lc).y):lc=nl
ei:i t=v(rc).y th:wh v(rc).y=v(nr).y:rc=nr:nr+=1:iv(nr,>,lv,0)
ew:rx=v(rc).x sl:rs=((v(nr).x-v(rc).x) sl)/(v(nr).y-v(rc).y):rc=nr
ei:i t>-1 th:l=lx sr:i l<iW th:r=rx sr:i r>l th:i l<0 th l=0
ia(r,>,iW)
s=p+l:e=p+r+1:wh s<e:*s=c32:s+=1:ew:ei:ei:ei:p+=iP:lx+=ls:rx+=rs:t+=1:ew:re true:ef
Unbelievable it draws polygons, here are a test

Code: Select all

#define d #define
d bo boolean
d in integer
d lo long
d si single
d te string
d ab as boolean
d ai as in
d al as lo
d af as si
d at as te
d ad as double
d en end
d i if
d el else
d oe orelse
d ei en i
d fu function
d ef en fu
d ty type
d et en ty
d wi with
d wh while
d ew wend
d fo for
d ne next
d th then
d re return
d rf re false
d sl shl 16
d sr shr 16
d trf th rf
ty v2i:ai x,y:et
d av as v2i
d ir(a,o,b) i a o b trf
d ia(a,o,b) i a o b th a = b
d iv(a,o,b,v) i a o b th a = v
fu Poly(img as any ptr,v() av,n ai,c32 al) ab
dim ai iW,iH,iP,f,t,b,l,r,lv,lc,nl,rc,nr,lx,ls,rx,rs,cl,cr,nc
dim al ptr p,s,e
ir(n,<,3)
lv=n-1:i img=0 th:p=screenptr():ir(p,=,0)
screeninfo iW,iH,,,iP:el:i imageinfo(img,iW,iH,,iP,p) trf
ei:t=iH:b=-t:l=iW:r=-l:fo nc=0 to lv:wi v(nc)
i t>.y th t=.y:f=nc
ia(b,<,.y)
ia(l,>,.x)
ia(r,<,.x)
en wi:ne:i (r-l)<1oe(b-t)<1 trf
iW-=1:iH-=1
ir(l,>,iW)
ir(r,<,1)
ir(t,>,iH)
ir(b,<,1)
ia(b,>,iH)
lc=f:nl=lc-1:iv(nl,<,0,lv)
rc=f:nr=rc+1:iv(nr,>,lv,0)
ip shr=2:p+=t*iP:b+=1
wh t<b:i t=v(lc).y th:wh v(lc).y=v(nl).y:lc=nl:nl-=1:iv(nl,<,0,lv)
ew:lx=v(lc).x sl:ls=((v(nl).x-v(lc).x) sl)/(v(nl).y-v(lc).y):lc=nl
ei:i t=v(rc).y th:wh v(rc).y=v(nr).y:rc=nr:nr+=1:iv(nr,>,lv,0)
ew:rx=v(rc).x sl:rs=((v(nr).x-v(rc).x) sl)/(v(nr).y-v(rc).y):rc=nr
ei:i t>-1 th:l=lx sr:i l<iW th:r=rx sr:i r>l th:i l<0 th l=0
ia(r,>,iW)
s=p+l:e=p+r+1:wh s<e:*s=c32:s+=1:ew:ei:ei:ei:p+=iP:lx+=ls:rx+=rs:t+=1:ew:re true:ef

'
' main
'
const n=32
dim av t(2) ' triangle
dim av q(3) ' quad
dim av p(n) ' polygon

dim ai scr_w,scr_h,fps,frames
dim af  w1,w2,w3
dim af m1x,m1y,s1x=.1,s1y=.2
dim af m2x,m2y,s2x=.3,s2y=-.1
dim af m3x,m3y,s3x=-.4,s3y=.1
dim ad delta=1/60,tLast=Timer()

screenres 640,480,32
var img=imagecreate(640,480,0)

screeninfo scr_w,scr_h
m1x=scr_w\2:m1y=scr_h\2
m2x=scr_w\2:m2y=scr_h\2
m3x=scr_w\2:m3y=scr_h\2

#macro mo(p_,s_,mi_,ma_)
  p_+=s_
  i p_<mi_ th 
    s_*=-1
  elseif p_>ma_ th
    s_*=-1
  ei
#endmacro

wh inkey()=""
  mo(m1x,s1x,-150,scr_w+150)
  mo(m1y,s1y,-250,scr_h+250)
  mo(m2x,s2x,-150,scr_w+150)
  mo(m2y,s2y,-250,scr_h+250)
  mo(m3x,s3x,-200,scr_w+200)
  mo(m3y,s3y,-200,scr_h+200)
  fo c ai=0 to 2:wi t(c):.x=m1x+cos(w1+c*6.28/3)*150:.y=m1y+sin(w1+c*6.28/3)*150:en wi:ne
  fo c ai=0 to 3:wi q(c):.x=m2x+cos(w2+c*6.28/4)*150:.y=m2y+sin(w2+c*6.28/4)*150:en wi:ne
  fo c ai=0 to n:wi p(c):.x=m3x+cos(w3+c*6.28/n)*150:.y=m3y+sin(w3+c*6.28/n)*150:en wi:ne
  w1+=s1x*delta*2: w2+=s2x*delta*3:w3+=s3x*delta*1
  line img,(0,0)-(scr_w-1,scr_h-1),&HFFFFFFFF,BF
  i poly(img,p(),n,RGB(32,255, 32)) then:fo c ai=0 to n-1:dim ai j=(c+1) mod n:line img,( p(c).x,p(c).y ) - ( p(j).x,p(j).y ),RGB(0,0,255):ne:ei
  i poly(img,q(),4,RGB(32, 32,255)) then:fo c ai=0 to 3:  dim ai j=(c+1) mod 4:line img,( q(c).x,q(c).y ) - ( q(j).x,q(j).y ),RGB(255,0,0):ne:ei
  i poly(img,t(),3,RGB(255,32, 32)) then:fo c ai=0 to 2:  dim ai j=(c+1) mod 3:line img,( t(c).x,t(c).y ) - ( t(j).x,t(j).y ),RGB(0,0,255):ne:ei
  put (0,0),img,PSET
  frames+=1
  i frames mod 60=0 then
    dim ad tNow = Timer(), tDiff=(tNow-tLast)
    fps=60.0/tDiff : delta= delta*0.75 + 1/fps*0.25
    WindowTitle "FPS = " & fps
    tLast = tNow
  ei 
  sleep 1
ew
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: The 50 years ago moon landing 4K contest!

Post by UEZ »

Moonshine 700 bytes:

Code: Select all

#Include "fbgfx.bi"
#Define S Single
Using FB:Const As Integer NS=1023:Dim Shared As S N(NS)
Randomize:For x As Integer = 0 To NS:N(x)=Rnd():Next  
Function sN1d(x As S) As S
	x=Abs(x):Dim As Integer x1=Int(x),x2=x1+1:Dim As S tx=x-x1:x1 And=NS:x2 And=NS:Dim As S l=N(x1),r=N(x2),v=l+(r-l)*tx:Return v
End Function
Dim As Ushort w=800:Screenres(w,w,32,1,GFX_ALPHA_PRIMITIVES):Windowtitle "Moonshine":Dim As S a,c,d,x,y,t=0,r=w/2,b=sN1d(Rnd()*NS)*r/2:Line (0,0)-(w,w),Rgb(0,6,45),BF:Do:a=sN1d(t+3)*r:c=sN1d(t*2)*5.25:t+=0.75:d=sN1d(t)*4.75:x=Cos(d)*b+r:y=Sin(d)*b+r:Circle(x,y),Rnd()*a,Rgba(255,255,255,2):Line(Cos(c)*a+r,Sin(c)*a+r)-(x,y),Rgba(255,255,255,7):Sleep(1,1):Loop Until Len(Inkey())
Last edited by UEZ on Jul 24, 2019 22:08, edited 1 time in total.
Knatterton
Posts: 165
Joined: Apr 19, 2019 19:03

Re: The 50 years ago moon landing 4K contest!

Post by Knatterton »

I am no game expert, but i believe my program is the shortest with 94 bytes:

Code: Select all

? "Female astronaut: Houston we have a problem. Don't know where to buy shoes here!"

sleep
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: The 50 years ago moon landing 4K contest!

Post by deltarho[1859] »

That is a sexist post.

The byte count can be reduced and avoid offending anyone with.

Code: Select all

? "Astronaut: Houston we have a problem. We cannot find a McDonald's!"
 
sleep
<smile>
Knatterton
Posts: 165
Joined: Apr 19, 2019 19:03

Re: The 50 years ago moon landing 4K contest!

Post by Knatterton »

deltarho[1859] wrote:That is a sexist post.
<smile>
Thanks, real girls love it that way. Would be annoying now if you win the contest with my program-concept.<smile>
Post Reply