## One Line Challenge!

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
BasicCoder2
Posts: 3917
Joined: Jan 01, 2009 7:03
Location: Australia

### Re: One Line Challenge!

mindlord

Just for fun decided to write a program to translate one of your one line programs to a multiline version.

One issue was the one line string contained inverted commas,
loop until inkey()="q"
changed to
loop until multikey(&H01)

The result is saved as multiLine3.bas which you can load and run.

Code: Select all

``````dim shared as string prog

prog = "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 multikey(&H01):sleep:imagedestroy a"

dim shared as string char
dim shared as string text(0 to 1000)
dim shared as integer lineCount2

'save the result

Const filename As String = "multiLine3.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

for i as integer =  1 to len(prog)
char = mid(prog,i,1)
if char = ":" then
'        print text(lineCount2)
'        sleep
lineCount2 = lineCount2 + 1
else
text(lineCount2) = text(lineCount2) + char
end if
next i

dim as integer tabIt

for i as integer = 0 to lineCount2

if text(i)="endif" then
text(i)=""
end if

if left(text(i),4) = "loop" then
tabIt = tabIt - 4
end if

'    if left(text(i),5) = "endif" then
'        tabIt = tabit - 4
'    end if

if left(text(i),6) = "end if" then
tabIt = tabit - 4
end if

if left(text(i),4) = "else" then
tabIt = tabit - 4
end if

if left(text(i),7) = "end sub" then
tabIt = tabit - 4
end if

if left(text(i),4) = "next" then
tabIt = tabit - 4
end if

print tab(tabit);text(i)

print #1,tab(tabit);text(i)

if left(text(i),3) = "sub" then
tabIt = tabit + 4
end if

if left(text(i),3) = "for" then
tabIt = tabit + 4
end if

if left(text(i),4) = "else" then
tabIt = tabit + 4
end if

if left(text(i),2) = "do" or left(text(i),2) = "if" then
tabIt = tabIt + 4
end if

next i

Close(filenum)

sleep

``````
mindlord
Posts: 29
Joined: Jul 18, 2020 19:59

### Re: One Line Challenge!

BasicCoder2 wrote: Apr 29, 2024 7:00 Just for fun decided to write a program to translate one of your one line programs to a multiline version.
Cool, now make it fit on one line of 1024 characters or less.
dafhi
Posts: 1673
Joined: Jun 04, 2005 9:51

### Re: One Line Challenge!

haha
dodicat
Posts: 7993
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: One Line Challenge!

Nothing dimensioned here.

Code: Select all

``````
Start:if screenptr=0 then screen 20:end if:Locate int(rnd*(Hiword(width)-1))+1,int(rnd*(Loword(width)-1))+1:err=1+int(rnd*255):sleep(iif(err<2,1,0)):Color 256-err,err:if (err=7 or err=10 or err=9) then goto Start else ? chr(err)::if inkey="" then goto Start

``````
mindlord
Posts: 29
Joined: Jul 18, 2020 19:59

### Re: One Line Challenge!

dodicat wrote: Apr 30, 2024 22:48 Nothing dimensioned here.
Reminds me of when DPMI paging failed in DOS. The program was still running, but the screen memory was complete garbage.