One Line Challenge!

[mindlord]

Back in the "Old Days" we used to challenge ourselves by fitting something cool into a single line of code. For example.

The Rainbow Magazine for the Tandy Color Computer would always include these one line demos, utilities, tools, or amusements in its pages, and as I understand it other computer magazines had similar contests.

You could find graphical demos, games, disk management utilities, music, and more all crammed into just 255 characters of code.

In that tradition, I challenge you. Write a FreeBASIC program with the following restrictions:

• Must fit on one line of code that is no more than 1024 characters long.
  Cannot #include or #inclib another source or library. Only core FreeBASIC is allowed.

Here's a couple to get the ball rolling:

Balance:

Code: Select all

screen 13:color 0,15:cls:circle(160,96),109:circle(160,141),45,,1.57,4.71,1:circle(160,51),45,,4.71,1.57,1:circle(160,138),20:circle(160,48),20:paint(160,28),0,0:paint(160,138),0,0:sleep

"Modern" Art:

Code: Select all

screen 13:do:cls:for r as integer=1to 10:dim as integer x=rnd*320,y=rnd*240,x1=rnd*320,y1=rnd*200,x2=rnd*320,y2=rnd*240,px=(x+x1+x2)/3,py=(y+y1+y2)/3,pc=rnd(15):line(x,y)-(x1,y1),15:line-(x2,y2),15:line-(x,y),15:paint(px,py),pc,15:next r:sleep 500:loop until len(inkey())

[mindlord]

Climb! (1010 chacters)

Code: Select all

dim shared s(2) as ulongint=>{&hFFFF81422418FFFF,&h18187E99993C2466}:dim shared as longint h,w,i,j,x,y,v,g,u,n,p,t:dim shared as double d:sub b(l as ulong,t as ulong,s as ulongint,c as ubyte):for i=0 to 63:line(l+(i mod 8)*4,t+int(i/8)*4)-step(4,4),iif(bit(s,63-i),c,0),bf:next:end sub:sub z:g=0:u=0:for i=y to y+3:g+=point(x+16,32+i):u+=point(x+16,i-4):next:end sub:sub l(c as ubyte):for j=0 to w*4 step 32:if(rnd<.7-(d/10))then b(j,n,s(0),c):endif:next:End sub:w=1920:h=1080:screenres w,h,8,2:screenset 0,1:x=w/2:y=h/4:d=1:Dim As any Ptr a = imagecreate(w,h):for n=0 to h*4 step 128:l(rnd*14+1):next:n=0:get(0,0)-(w-1,h-1),a:do:z:x+=iif(multikey(&h4B),-3,iif(multikey(&h4D),3,0)):p+=1:v=iif(v>0 and g>0,-16,iif(v<0 and u>0,1,iif(v=8,v,v+1))):y+=v:cls:put(0,INT(d)),a:if p mod 128/INT(d)=0 then l(rnd*14+1):d+=iif(d<4,.1,0):endif:get(0,0)-(w-1,h-1),a:t=h-h/7+d:line (0,t)-(w,t),RND*15+1:b(x,y,s(1),15):color 15:locate 1,1:? p:if y>t then exit do:endif:flip:sleep 25:loop until inkey()="q":sleep:imagedestroy a

"Climb!" is a game. Climb up to avoid the deadly laser! Arrows move left and right, jumping occurs automatically, "q" quits. Have fun!

edited to remove flicker.
edited again to remove flicker and to optimize collision detection.

[neil]

Silver Balls is a one-liner with only 263 characters. The original code was from Dos World Magazine.

Code: Select all

Screen 20:Cls:Dim As Single c,cs:Dim As Integer i,r,w,h,x,y:Randomize:Screeninfo w,h:Do:x = Int(Rnd * w):y = Int(Rnd * h):c = 31: r = Int(Rnd * 25) + 10:cs = c / r / 2.3:For i = 1 to r:Circle(x,y),i,c:Circle(x,y+1),i,c:c -= cs:sleep 1:Next:Loop Until len(Inkey)

[mindlord]

Silver Balls is a one-liner with only 263 characters. The original code was from Dos World Magazine.

Nice. I like it.

[neil]

Lissajous pattern (253 characters)

Code: Select all

Screenres 400,400,32:Const Pi = 3.14159:Dim As Single a,b,delta,angle,x,y:a = 5:b = 4:delta = Pi / 2:For angle = 0 TO 2 * Pi Step .002:x = 200 + 100 * Sin(a * angle + delta):y = 200 + 100 * Sin(b * angle):Pset(x, y),Rgb(255, 255, 255):Sleep 1:Next:Sleep

[mindlord]

Anomaly (1008) characters
Control your blue matter siphon to collect the blue matter before it decays into red matter.
Use the arrow keys to expand,contract, and rotate your siphon.
Blue matter is worth 100 points.
Red matter is worth -50 points.
100 anomalies will appear in total. Good luck!

Code: Select all

dim shared as long w=1024,h=768,v=1000:type b:as long x,y,d,r:declare constructor():end type:constructor b():x=rnd*w:y=rnd*h:d=rnd*20+20:r=rnd*20+100:end constructor:dim as string d:dim p(100) as b:screen 20: dim as long x=0,y=0,a=0,t=0,s=4,c=0,i=0,e=0,o=0,m=0:do:screenlock:cls:d+="TA"+str(t)+"u"+str(s)+"c"+str(24+(e mod 24)):e+=1:a+=iif(multikey(75),10,iif(multikey(77),-10,0)):s+=iif(multikey(72),2,iif(multikey(80),-2,0)):t+=iif(a=t,0,iif(a>t,6,-6)):s+=iif(s=3,0,iif(s>3,-1,+1)):draw d:x=point(0):y=point(1):circle(x,y),20:d=iif(len(d)>v,right(d,v-INSTR(2,d,"TA")),d):c+=iif(rnd>.99 and c<100,1,0):for i=0 to c:with p(i):m=sqr((x-.x)^2+(y-.y)^2):if m<20+.d and .d>0 then .d=0:.r=0:o+=100:paint (0,0),9:endif:if m<20+.r and .d<0 and .r>0 then .d=0:.r=0:o-=50:paint (0,0),4:endif:circle(.x,.y),iif(.d>0,.d,.r),iif(.d>0,9,4),,,,F:circle(.x,.y),.r*rnd,4:if e mod 10=1 then .d-=1:.r-=1:endif:locate 1,1:?o,iif(i=100 and .r<0," GAME OVER - press q",""):end with:next:screenunlock:sleep 10:loop until inkey="q"

[mindlord]

invade! (1003 Characters!)
I almost can't believe I pulled this one off. Cramming graphics data into a WSTRING was the key.

Code: Select all

dim shared as long a=1,i,j=55,k,d,e,c,t,r,x,y,z,u,q=24,w=2,s=90,o=600,p=720,h=4,n,l,m:dim v(55)as byte:dim shared g as wstring*30 = "ᠼ绛ｚ腂ᠼ绛Ｄ媥ࠤ⼻㼟ࠐࠄ༛⼯⠆̟㼹㼎ᤌ̟㼹㼎ᥠă̿罿罿":sub b(l as long,t as long,u as byte,f as byte=1):do while f>=0:for i=0to 63:y=int(i/16):r=iif(f,i mod 16,15-i mod 16):line(l+((i mod 8)+iif(f,0,8))*4,t+(int(r/8)+y*2)*4)-step(3,3),iif(bit(asc(g,y+u),15-r),c,0),bf:next:f-=1:loop:end sub:screen 21:do:screenlock:cls:t+=1:q+=iif(t mod(5+j)=0,h,0):l=0:m=999:for x=0to 54:v(x)=iif(a,1,v(x)):d=q+s*(x mod 11):e=(w+int(x/11))*s/2:if v(x)then:l=iif(l<d,d,l):m=iif(m>d,d,m):n=iif(n<e,e,n):if abs(z-30-d)<30and abs(u-e)<5then:v(x)=0:u=0:j-=1:endif:c=15:b(d-iif(x<11,15,0),e,iif(d mod 3,iif(x<11,1,iif(x<33,9,17)),iif(x<11,5,iif(x<33,13,21))),iif(x<11,0,1)):endif:next:if l>1160or m<24then:h=-h:w+=1:q+=h:endif:c=2:b(o,p,25):line(z,u)-step(4,16),2,bf:a=0:o+=iif(multikey(&h4B),-1,iif(multikey(&h4D),1,0)):if(multikey(&h39)and u<=0)then:z=o+30:u=p:endif:u-=1:screenunlock:sleep 1,1:loop until j=0or n=p

left arrow, right arrow, space... you know... shoot the invaders.

[badidea]

Impressive!

[BasicCoder2]

But aren't all programs one line in the computer memory?
Isn't the colon the same as a CRLF?

Code: Select all

dim shared as long a=1,i,j=55,k,d,e,c,t,r,x,y,z,u,q=24,w=2,s=90,o=600,p=720,h=4,n,l,m
dim v(55)as byte
dim shared g as wstring*30 = "??z???D?????????????????a???"
sub b(l as long,t as long,u as byte,f as byte=1)
    do while f>=0
        for i=0 to 63
            y=int(i/16)
            r=iif(f,i mod 16,15-i mod 16)
            line(l+((i mod 8)+iif(f,0,8))*4,t+(int(r/8)+y*2)*4)-step(3,3),iif(bit(asc(g,y+u),15-r),c,0),bf
        next
        f-=1
    loop
end sub

screen 21
do
    screenlock
    cls
    t+=1
    q+=iif(t mod(5+j)=0,h,0)
    l=0
    m=999
    for x=0 to 54
        v(x)=iif(a,1,v(x))
        d=q+s*(x mod 11)
        e=(w+int(x/11))*s/2
        
        if v(x)then
        
            l=iif(l<d,d,l)
            
            m=iif(m>d,d,m)
            n=iif(n<e,e,n)
        
            if abs(z-30-d)<30 and abs(u-e)<5 then
                v(x)=0
                u=0
                j-=1
            end if
        
            c=15
            b(d-iif(x<11,15,0),e,iif(d mod 3,iif(x<11,1,iif(x<33,9,17)),iif(x<11,5,iif(x<33,13,21))),iif(x<11,0,1))
        endif
    next
    if l>1160 or m<24then
        h=-h
        w+=1
        q+=h
    end if
    c=2
    b(o,p,25)
    line(z,u)-step(4,16),2,bf
    a=0
    o+=iif(multikey(&h4B),-1,iif(multikey(&h4D),1,0))
    if(multikey(&h39)and u<=0)then
        z=o+30
        u=p
    end if
    u-=1
    screenunlock
    sleep 1,1
loop until j=0 or n=p

[mindlord]

But aren't all programs one line in the computer memory?
Isn't the colon the same as a CRLF?

Yes, but CR+LF are TWO characters and : is just one, see?
There are certain constructs such as #DEFINE that cannot be used in a single line program, so there's that... but it's the spirit of the challenge as well. On the TRS-80 there was a 255 character limit to a single line. FreeBASIC does not have such a limit, that's why I suggest an artificial limit of 1024 for this challenge.

For examples: https://colorcomputerarchive.com/repo/D ... lement.pdf

[dafhi]

climb is awesome!

emergent circles II

Code: Select all

dim as double w=800,h=600,seed,a,r,t,t0=timer
screenres w,h,32
    do
  for seed = 0 to 499
t = timer
randomize seed
a = rnd*6.28 + 4*(t-t0)*(.1+rnd)
r = 2.5+rnd*rnd*rnd*175
pset (rnd*w + r*cos(a), rnd*h + r*sin(a)), rnd*culng(-1)
next
sleep 1
loop while t < t0+10

[BasicCoder2]

@mindlord wrote:

"... but it's the spirit of the challenge as well."

Yes I sometimes forget that. It is the human connectedness that competitions provide regardless of any practical outcome. I seem to lack that need instead concentrate on something of practical value which I find the most rewarding challenge.

I guess you started with the TRS-80 Color Computer? I started and learned BASIC (and Assembler) with the first TRS-80 with its chunky graphics. However the color version didn't arrive on our shores so the first color computer I obtained was the C64 which gave me hours of fun and programming challenges

You could write a program to convert between a readable multiline version and a single line version.

[mindlord]

I guess you started with the TRS-80 Color Computer?

The first computer I ever touched as a Timex Sinclair.
The bulk of my elementary years I spent with a TI99/4A with Extended Basic. I love those sprites and you can see a hint of it in climb because of how I encoded the graphics as a 64bit hex, that's not just for fun, that's how the TI did it, too.

I also heavily used the Tandy Color Computer 2 and 3. Up through my teen years.

I also had access to an IBM PC with GWBASIC, and did some stuff there. I got my hands on a Tandy 1000HX Desktop PC and QB45 when I turned 14 and made a little money selling "Door" software for RemoteAccess BBS systems.

I can program in a wide variety of languages (c, c++, php, java, javascript, blah.blah.blah), but the Microsoft BASIC(s) are cozy to me.

[mindlord]

You could write a program to convert between a readable multiline version and a single line version.

My method is:

• Write the program just like normal while trying to compress each loop, instruction, and byte as tightly as possible

• Put colon at the end of each line.

• CTRL-H and replace all the :[CR][LF] with : and check my length.

• Undo, and keep tweaking until I get it down to 1024 or less.

[BasicCoder2]

mindlord
You could possibly automate or semi automate the method?
example:
First I saved the expanded version given in my post as prog.txt
Then used this code to load, convert and save it as a one line version as prog2.bas

Code: Select all

Dim As String file_name
Dim As Integer file_num
Dim as integer lineCount

file_name = "prog.txt"
file_num = FreeFile( )                 '' retrieve an available file number

'' open our file and bind our file number to it, exit on error
If( Open( file_name For Input As #file_num ) ) Then
   Print "ERROR: opening file " ; file_name
   sleep
   end
End If


dim as string text1,text2,text3

dim as integer flag,flag2

Do Until EOF( file_num ) or inkey = " "
    Line Input #file_num,text1
    
    'remove indents
    dim as integer ii,found
    found = 0
    ii = 1
    
    if len(text1)<>0 then
        'find first non space character
        while ii < len(text1) and found = 0
            if mid(text1,ii,1)<>" " then
                found = ii
            end if
            ii = ii + 1 'next char
        wend
    end if
    
    text2 = right(text1,len(text1)-found+1)
    
    if len(text2)<>0 then
        print text2 ';":";
        text3 = text3 + text2 + ":"
    end if
    
    sleep 2
Loop
print
print

Close #file_num 


'save the result

Const filename As String = "prog2.bas"

Dim filenum As Integer = FreeFile()

If 0 <> Open(filename, For Output, As filenum) Then
    Print "error opening " & filename & " for output."
    End -1
End If

print #1,
print #1,text3
print #1,


Close(filenum)

sleep