Brexit day.

[dodicat]

Officially we (UK) left the EU last night at 2300.
In 2016 I posted my Euro flag doodle after the Brexit referendum.
I said I would post it again, suitably adjusted, when Brexit was complete, but it is not really complete yet, only about half way there in my reckoning, despite last night's jubilations (or not, just depending).
So I shall post an intermediary just in case it drags on and on, and I am no longer here to see it.

Code: Select all

Screen 20,32,1,64' Or 1
Dim  Shared As Integer xres,yres
Screeninfo xres,yres
locate 10,10
print  "Wait five ..."
Type _point
    As Single x,y
    As Ulong col
End Type
Type rainbow 
    As long min,max,z
    As long ba
    As long xp,yp
    Declare Function colours(As String,As Any Pointer) As Ulong
End Type
Type cloud
    As long shadepos1,shadepos2,mangle
    As long lowercol,uppercol
    As long r,g,b
    Declare Sub Create(As long,As long,As long,As long,As Single,Byref As Any Pointer=0)
End Type
Sub cloud.create(x As long, y As long,length As long=100,Alpha As long=105, Zoom As Single = 0,Byref im As Any Pointer=0)
    Dim As long r=this.r
    Dim As long b=this.g
    Dim As long g=this.b
    Dim As Double pi=3.14159
    #define Intrange(f,l) Int(Rnd*((l+1)-(f))+(f))
    #define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
    If Length<=1 Or Alpha<=1 Then Exit Sub
    Dim As Single rnded = -pi+Rnd*1*pi/2
    Dim As Single rnded2 = -pi+Rnd*-3*pi
    Var c=0
    If Alpha<25 Then
        For i As long = 0 To 255-Alpha Step 100
            Dim As long i=IntRange(-this.mangle,this.mangle)
            c=map(this.shadepos1,this.shadepos2,y+i,this.lowercol,this.uppercol)
            Line im,(-(Zoom/2)+x-length/2,y)-((Zoom/2)+x+Length/6+length*Cos(-pi/2+rnded*PI/3),y+Length/6+length*Sin(-pi/2+rnded*PI/3)),Rgba(R-c,G-c,B-c,Alpha)
            Line im,(-(Zoom/2)+x-length/2,y)-((Zoom/2)+x+Length/6+length*Cos(-pi/2+rnded2*PI/3),y+Length/6+length*Sin(pi/2+rnded2*PI/3)),Rgba(R-c,G-c,B-c,Alpha)
        Next
    End If
    create(-(Zoom/2)+x+length*Cos(-pi/2+rnded*PI/3),(Zoom/2)+y+length*Sin(-pi/2+rnded*PI/3),length/1.4,Alpha/1.2,Zoom,im)
    create(-(Zoom/2)+x+length*Cos(-pi/2+rnded2*PI/3),(Zoom/2)+y+length*Sin(pi/2+rnded2*PI/3),length/1.4,Alpha/1.2,Zoom,im)
    create(-(Zoom/2)+x+length*Cos(pi/3+rnded2*PI/3),(Zoom/2)+y+length*Sin(pi+rnded2*PI/3),length/1.4,Alpha/2,Zoom,im)
End Sub
Dim Shared As Any Pointer im
im=Imagecreate(xres,yres)

Dim Shared As _point array(1 To 9801)'6561)
Declare Sub EUROjack(x As long,y As long,s As Single,im As Any Pointer=0)
Declare Function Blur(Byref tim As Ulong Pointer,rad As Single=2) As Ulong Pointer
#define distance(cx,cy,px,py) sqr((cx-px)*(cx-px)+(cy-py)*(cy-py))
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
#define rr(first,last) Rnd * (last - first) + first
#macro rotate(pivotx,pivoty,px,py,a,scale)
rotx=scale*(Cos(a*.0174533)*(px-pivotx)-Sin(a*.0174533)*(py-pivoty))+pivotx
roty=scale*(Sin(a*.0174533)*(px-pivotx)+Cos(a*.0174533)*(py-pivoty))+pivoty
#endmacro

Sub lineto(x1 As long,y1 As long,x2 As long,y2 As long,l As long,col As Ulong)
    Dim As long diffx=x2-x1,diffy=y2-y1,ln=Sqr(diffx*diffx+diffy*diffy)
    Dim As Single nx=diffx/ln,ny=diffy/ln 'normalize
    If ln>l Then
        Line(x1,y1)-(x1+l*nx,y1+l*ny),col 
    Else
        Line(x1,y1)-(x2,y2),col
    End If
End Sub
Sub trees
    Dim As long rotx,roty
    #macro turnline(piv,p1,p2,ang,col,d)
    Scope
        rotate(piv.x,piv.y,p1.x,p1.y,ang,d)
        Var rot1=Type<_point>(rotx,roty)
        rotate(piv.x,piv.y,p2.x,p2.y,ang,d)
        Var rot2=Type<_point>(rotx,roty)
        Line im,(rot1.x,rot1.y)-(rot2.x,rot2.y),col
    End Scope
    #endmacro
    Dim As _point v1,v2,piv
    Dim As Ulong treecol
    Dim As Double pivx,pivy,pivz,l,k,d
    Dim As long rd,g,b
    For m As Double=0 To 50 Step 5
        Randomize m
        For n As Double=200-(m+rr(2,20)) To 990+m Step rr(3,9)
            Randomize n^2
            l=rr(2,11)
            k=rr(1,5)
            piv=Type(n,.8*yres+20*(1-Sin(.01*(n-m*5-k+40-200))))
            Line im,(piv.x,piv.y)-(piv.x+rr(-2,5),piv.y+8),Rgb((100),(35),37)
            Var cc=rr(1,40)
            For a As Double=90 To 450 Step 7
                Randomize a
                Var shader=rr(1,6)
                rd=20+shader+cc
                g=150+shader:If g>40 Then g=g-40
                b=20+shader:If b>20 Then b=b-20
                treecol=Rgb(rd/2,g/2,b/2)
                For a2 As Double=0 To l Step .3
                    If a>270 Then shader=-shader
                    treecol=Rgb(rd/2,(g-a2*shader)/2,b/2)
                    v1=Type(piv.x-a2,piv.y)
                    v2=Type(piv.x-l,piv.y)
                    turnline(piv,v1,v2,a,treecol,1)
                Next a2
            Next a
        Next n
        Screenlock
        Cls
        d=(5-80)*(m/50)+80 
        eurojack((.35*xres+xres)*(d-80)/(5-80)-xres,(.2*yres+.75*yres)*(d-80)/(5-80)-.75*yres,d)
        Screenunlock
        If m=0 Then Sleep 800
        Sleep 5
    Next m
End Sub

Sub inspectimage
    Dim As long mx=550,my=552
    Dim As long count
    Dim As Ulong tempcol
    For x As long=mx-80 To mx+40
        For y As long=my-80 To my
            count=count+1
            tempcol=Point(x,y,im)
            array(count)=Type(x,y,tempcol)
        Next y
    Next x
End Sub

Sub EUROjack(x As long,y As long,s As Single,im As Any Pointer=0)
    
    #macro pentagon(starx,stary,size,col)
    Scope
        Var count=0,rad=0.0,_px=0.0,_py=0.0
        For z As Single=0+.28 To 2*pi+.1+.28 Step 2*pi/10
            count=count+1
            If count Mod 2=0 Then rad=size Else rad=.4*size
            _px=starx+rad*Cos(z)
            _py=stary+rad*Sin(z)
            If count=1 Then Pset im,(_px,_py)Else Line im,-(_px,_py),col
        Next z
        Paint im,(starx,stary),col,col
    End Scope
    #endmacro
    Dim As Double pi=4*Atn(1)
    Dim As long lx=60*s,ly=1*lx
    Line im,(x,y)-(x+lx+40,y+ly),Rgb(2,3,192),bf
    Dim As long cntx=(x+x+lx)/2+20,cnty=(y+Y+ly)/2
    For z As Double=0 To 2*pi Step 2*pi/12
        Var px=cntx+.7*(lx/2)*Cos(z)
        Var py=cnty+.7*(lx/2)*Sin(z)
        pentagon(px,py,3*s,Rgb(243,236,24))
    Next z
End Sub

Sub Unionjack(x As Single,y As Single,s As Single,im As Any Pointer=0)
    Dim As Single lx=60*s,ly=.75*lx
    Dim As Uinteger col
    Dim As Single st=-4*s,fi=0
    Line im,(x,y)-(x+lx,y+ly),Rgb(0,0,200),bf
    For n As Integer=1 To 2
        For k As Single=st To fi
            If k>-1*s Or k<-3*s Then col=Rgb(255,255,255) Else col=Rgb(200,0,0)
            Line im,(x,y-k)-(x+lx,y+ly-k-4*s),col
            Line im,(x,y+ly-4*s-k)-(x+lx,y-k),col
            Line im,((x+lx/2)+k+2*s,y)-((x+lx/2)+k+2*s,y+ly),col
            Line im,(x,y+ly/2+k+2*s)-(x+lx,y+ly/2+k+2*s),col
        Next k
        st=-3*s:fi=-1*s
    Next n
End Sub

Sub backdrop 'hills/trees/cloud
    #macro paintsketch(_function,minx,maxx,miny,maxy,r,g,b,alp)
    For x As Double=minx To maxx Step (maxx-minx)/10000
        Var x1=(xres)*(x-minx)/(maxx-minx)
        Var y1=(yres)*(_function-maxy)/(miny-maxy)
        gr=(lasty-y1)*1000
        lasty=y1
        If gr>g Then gr=g
        Line im,(x1,yres)-(x1,y1),Rgba(r,g-gr,b,alp)
    Next x
    #endmacro
    Imagedestroy(im)
    im=Imagecreate(xres,yres)
    Dim As long r,g,b,dr,dg,db
    'sky
    For y As long = 0 To yres
        For x As long=0 To xres
            dr=map(0,xres,x,0,59)
            dg=map(0,xres,x,0,55)
            db=map(0,xres,x,0,30)
            r=map(0,yres,y,2+dr,186+dr)
            g=map(0,yres,y,75+dg,189+dg)
            b=map(0,yres,y,204+db,219+db)
            Pset im,(x,y),Rgb(r,g,b)
        Next x
    Next y
    Dim As cloud nine
    nine.shadepos1=0
    nine.shadepos2=550
    nine.mangle=29
    nine.lowercol=0
    nine.uppercol=255
    nine.r=255
    nine.g=255
    nine.b=255
    
    nine.create(300,140-20,80,250,1,im)
    nine.create(500,140-20,80,250,1,im)
    nine.create(700,140-20,80,250,1,im)
    
    im=blur(im,3)
    Dim As Double lasty,gr
    paintsketch(.65*yres+90*(1-Sin(.15*x)/(.15*x)),100,-100,yres,0,50,100,0,10)
    paintsketch(.82*yres+20*Sin(.01*(x-200)),xres,0,yres,0,50,100,0,255)
    trees
    paintsketch(.85*yres+60*Sin(.001*x)-15*Cos(.015*x),xres,0,yres,0,0,100,0,255)
    
    Dim As rainbow arc 
    Dim As Single dist,cx,cy
    cx=xres/2-100:cy=1.5*yres
    For y As long=0 To yres
        For x As long=0 To xres
            dist=distance(cx,cy,x,y)
            arc.xp=x:arc.yp=y
            arc.z=dist
            arc.min=.7*xres
            arc.max=.7*xres+.05*xres
            arc.ba=80'105
            Pset im,(x,y),arc.colours("inner",im)
        Next x
    Next y 
End Sub

Sub flag(mag As Single=3,inc As Single=.001)
    Static As Single x,counter
    counter=counter+.6981:If counter>= 6.283 Then counter=0
    x=x+.01:If x>= 6.283 Then x=0
    Dim As long mx=Any,my=Any,tx=Any,ty=Any,bx=Any,by=Any
    Dim As long rotx,roty
    mx=500+5*Sin(x):my=600+5*Sin(x)
    Dim As long count
    For x As long=mx-80 To mx+40
        For y As long=my-80 To my
            count=count+1
            mag=mag+rr(-3*inc,+3*inc)+inc/10
            rotate((mx+2),(my+2),array(count).x,array(count).y,10000*inc,mag)
            If count=1  Then tx=rotx:ty=roty
            If count=80 Then bx=rotx:by=roty
            Circle (rotx,roty),mag*1.5,array(count).col,,,,f
        Next y
    Next x
    Var cc=40
    Dim As Single lasty,_mx,_my
    For k As long=10 To 150 Step 2
        For x As long=-200 To xres+50 Step 2
            _mx=600+100*Sin(500*inc):_my=200+300*Sin(500*inc)
            Var firsty=.85*yres+60*(1-Sin(.001*x))-15*(1-Cos(.015*x))+k+rr(-2,2)
            Var grad=(firsty-lasty)*15
            lineto(x-25+100,firsty,_mx+1000+100*Sin(.5*counter),_my-200+40*Sin(counter),40+.05*k,Rgb(cc+grad/10,100+grad,0))
            lasty=firsty
        Next x
    Next k
    Line(tx,ty)-(260,50) 'halyard
    Line(bx,by)-(250,yres+200)
    For z As long=1 To 10
        Line(250+z,50)-(250+z,yres),Rgb(z*20,z*20,z*20)'post
    Next z
End Sub

Function rainbow.colours(part As String="inner",im As Any Pointer=0) As Ulong
    Dim As Ulong col
    Dim As long diff=this.z-this.min
    Dim As long gap=(this.max-this.min)/6
        If this.z>=this.min-2*gap And this.z<this.min Then
            col=Point(this.xp,this.yp,im)
            Return Rgba((238-(col Shr 16 And 255))*(diff+2*gap)/(2*gap)+(col Shr 16 And 255),_
            (130-(col Shr  8 And 255))*(diff+2*gap)/(2*gap)+(col Shr  8 And 255),_
            (238-(col  And 255 ))*(diff+2*gap)/(2*gap)+(col  And 255 ),this.ba)
        End If
        If this.z>=this.min And this.z<this.min+gap Then _ 
        Return Rgba((75-238)*(diff)/gap+238,-130*(diff)/(gap)+130,(130-238)*(diff)/gap+238,this.ba)
        
        If this.z>=this.min+gap And this.z<this.min+2*gap Then _ 
        Return Rgba((0-75)*(diff-gap)/gap+75,0,(255-130)*(diff-gap)/gap+130,this.ba)
        
        If this.z>=this.min+2*gap And this.z<this.min+3*gap Then _
        Return Rgba(0,128*(diff-2*gap)/gap,-255*(diff-2*gap)/gap+255,this.ba)
        
        If this.z>=this.min+3*gap And this.z<this.min+4*gap Then _
        Return Rgba(255*(diff-3*gap)/gap,(255-128)*(diff-3*gap)/gap +128,0,this.ba)
        
        If this.z>=this.min+4*gap And this.z<this.min+5*gap Then _
        Return Rgba(255,(165-255)*(diff-4*gap)/gap+255,0,this.ba) 
        
        If this.z>=this.min+5*gap And this.z<this.min+6*gap Then _
        Return Rgba(255,-165* (diff-5*gap)/gap +165,0,this.ba)
        
        If this.z>=this.min+6*gap And this.z<this.min+8*gap Then 
            col=Point(this.xp,this.yp,im)
            Return Rgba((-255+(col Shr 16 And 255))*(diff-6*gap)/(2*gap)+255,_
            (col Shr  8 And 255)*(diff-6*gap)/(2*gap),_
            (col  And 255 )*(diff-6*gap)/(2*gap),this.ba)
        End If
End Function

Function Blur(Byref tim As Ulong Pointer,rad As Single=2) As Ulong Pointer
    Type p2
        As long x,y
        As Ulong col
    End Type
    #macro ppoint(_x,_y,colour)
    pixel=row+pitch*(_y)+4*(_x)
    (colour)=*pixel
    #endmacro
    #macro ppset(_x,_y,colour)
    pixel=row+pitch*(_y)+4*(_x)
    *pixel=(colour)
    #endmacro
    #macro average()
    ar=0:ag=0:ab=0:inc=0
    xmin=x:If xmin>rad Then xmin=rad
    xmax=rad:If x>=(_x-1-rad) Then xmax=_x-1-x
    ymin=y:If ymin>rad Then ymin=rad
    ymax=rad:If y>=(_y-1-rad) Then ymax=_y-1-y
    For y1 As long=-ymin To ymax
        For x1 As long=-xmin To xmax
            inc=inc+1 
            ar=ar+(NewPoints(x+x1,y+y1).col Shr 16 And 255)
            ag=ag+(NewPoints(x+x1,y+y1).col Shr 8 And 255)
            ab=ab+(NewPoints(x+x1,y+y1).col And 255)
        Next x1
    Next y1
    averagecolour=Rgb(ar/(inc),ag/(inc),ab/(inc))
    #endmacro
    Dim As integer _x,_y
    Imageinfo tim,_x,_y
    Dim  As Ulong Pointer im=Imagecreate(_x,_y)
    Dim As integer pitch
    Dim  As Any Pointer row
    Dim As Ulong Pointer pixel
    Dim As Ulong col
    Imageinfo tim,,,,pitch,row
    Dim As p2 NewPoints(_x,_y)
    For y As long=0 To (_y)-1
        For x As long=0 To (_x)-1
            ppoint(x,y,col)
            NewPoints(x,y)=Type<p2>(x,y,col)
        Next x
    Next y
    Dim As Ulong averagecolour
    Dim As long ar,ag,ab
    Dim As long xmin,xmax,ymin,ymax,inc
    For y As long=0 To _y-1
        For x As long=0 To _x-1  
            average()
            NewPoints(x,y).col=averagecolour
        Next x
    Next y
    Imageinfo im,,,,pitch,row
    For y As long=0 To _y
        For x As long=0 To _x
            ppset((NewPoints(x,y).x),(NewPoints(x,y).y),NewPoints(x,y).col) 
        Next x
    Next y
    Function= im
End Function

Function Regulate(Byval MyFps As long,Byref fps As long) As long
    Static As Double timervalue,lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function
'____________________________________________
Dim As Single count,mag
Dim As Single inc
EUROjack(.455*xres,.61*yres,1.5,im)
unionjack(.41*xres,.61*yres,2,im)
inspectimage
backdrop
Dim As long fps

Do
    count=count+.01
    mag=3+Cos(count)/2
    inc=.003*Sin(count)*Cos(count)+rr(-.0001,.0001)
    If inc<.0001 And inc >-.0001 Then inc=rr(-.0001,.0001)
    Screenlock
    Cls
    Put(0,0),im
    flag mag,inc
    Draw String(10,10),"Goodbyeeee "
    Screenunlock
    Sleep regulate(15,fps)
Loop Until Len(Inkey)
Sleep

Imagedestroy im  
  

[UEZ]

@dodicat: looks very nice - very windy the Scottish highlands

Goodbye UK...
(\____/)
( ͡ ͡° ͜ ʖ ͡ ͡°)
\╭☞ \╭☞


Btw, I cannot compile it with gcc optimized parameters - a lot of error messages...

[hurtado]

Great program, as usual

some time ago I did a tiny program to draw (pixelated) flags. Here a pretended similar flag as yours.

Edited: Pressing button 1 you may draw your own flag that will be saved as a gif.

[jj2007]

Compliments, dodicat - great code!

[dodicat]

Thank you for testing everybody.
Before today becomes tomorrow (in this time zone - G.M.T.), soon.

01.01 in 1010 -- Macbeth was King of Scotland.
02.02 in 2020 - - Today.
03.03 in 3030 - - Anybody's guess.

[marcov]

Thank you for testing everybody.
03.03 in 3030 - - Anybody's guess.

03.03.3030 Headline: The prime minister, commonly nicknamed "The Boris" leaves the Shetland islands(*) goes to Brussels to ask for an extension on certain negotiation deadlines. Nobody exactly knows what is being negotiated anymore, but it is an annual tradition.

(*) Where the British government is based after the main isles were destroyed in the Trumpian wars of the early 2000s.

[badidea]

@dodicat, how is the flag doing in storm Ciara?

[dodicat]

A new definition of horizontal.