Bleak Mid Winter Cheer

dodicat · Post by **dodicat** » Dec 21, 2010 1:42

A little compendium of stuff done during the year, on this bleak night.
(-15 degrees centigrade outside tonight, and only a shade warmer inside.

Code: Select all



'Winter dead centre
declare Sub ball_not2d(cx As Double,_  'CENTRES
               cy As Double,_
               radius As Double,_
               col() As Uinteger,_  'COLOUR ARAY, 2 Dimensions
               offsetX As Double=0,_ 'Bright spot (0 to about .9)
               offsetY As Double=0,_
               e As Double=0,_        'eccentricity 
               resolution As Double=32,_  'number of circles drawn
               im As Any Pointer=0)
Declare Sub starfield(pixels As Integer=1000,_ 'number of stars
                    maxlength As Integer=10,_  'max length of each trace
                    offx As Double=0,_          'offset from centre x   
                    offy As Double=0)           'offset from centre y
             'N.B. offsets from about -.9 to .9
declare Function r(first As Double, last As Double) As Double
declare sub drawpolygon(x() as double,y() as double,colour as uinteger,im as any pointer=0)
declare sub drawstars(starx as double,stary as double,size as double,col as uinteger)
declare sub paintstring(x as double,_
           y as double,_
           s as string,_
           size as double,_
           c as uinteger,_
           line_angle as double=0,_
           char_angle as double=0,_
           thickness_tweak as double=1,_
           image as any pointer=0)
declare Sub polygon(n As Integer,_ 'number of sides
    centreX As Double,_            'centres
    centreY As Double,_
    col() as uinteger,_              'dim 1 to 6
    t As Double=1,_                'thickness
    size As Double=100,_           'radius if circle
    angle As Double=0,_           'turn a few degrees to one side
    offset as double=0,_            
    ex As Double=1,_               'eccentricity on x plane
    ey As Double=1,_               'eccentricity on y plane
    im as any pointer=0)
   declare sub bonnet
   declare sub bird
  declare  sub xmas
Dim Shared np(1 To 4) As Double
dim shared as double next_x,next_y
Dim As Double deg,radians = Atn(1)/45
Dim As Single s, c, mod_s, mod_c
Dim As Integer x, y, xctr, yctr, radius
Dim As Single modifier
Dim As Integer toggle
dim shared as integer xres,yres
screeninfo xres,yres
#include "fbgfx.bi"
screen 19,32,1,fb.GFX_ALPHA_PRIMITIVES
dim shared img as any pointer
    img=imagecreate(xres,yres,rgb(10,10,20))
dim as uinteger colour(0,3),blue=rgba(85,85,255,50),white=rgba(205,205,205,20)
#macro galaxy(zz)
dim as double x7,y7,s7
    dim as uinteger c7
  
for z as integer=1 to 50
    x7=r(0,xres)
    y7=r(0,yres)
    s7=r(1,2)
    c7=rgb(r(200,255),r(100,200),r(100,200))
    drawstars(x7,y7,s7,c7)
    
next z
bonnet
xmas
#endmacro
colour(0,0)=0
colour(0,1)=100
colour(0,2)=50
colour(0,3)=150
xctr=400
yctr=290
radius=250

modifier = -.045
toggle = 0
dim looper as double
dim k as integer=1
galaxy(0)

Do
    looper=looper+10*k
    screenlock
    Cls
    
    put(0,0),img,pset
    starfield(1500,20)
    For deg = 0 To 360 Step .1
        s = Sin(deg*radians)
        c = Cos(deg*radians)
        If deg >= 0 And deg <= 180 Then 
            mod_s = (180-(deg)) * ((deg)/180) * modifier
            mod_c = 0
            If deg >= 45 And deg <= 65 Then 
                mod_s = mod_s+(20-(deg-45)) * ((deg-45)/20) * modifier/2
                mod_c = mod_c+(20-(deg-45)) * ((deg-45)/20) * modifier*2
            End If
            If deg >= 45 And deg <= 135 Then 
                mod_s = mod_s+-(90-(deg-45)) * ((deg-45)/90) * (modifier*2)
            End If
            If deg >= 115 And deg <= 135 Then 
                mod_s = mod_s+(20-(deg-115)) * ((deg-115)/20) * modifier/2
                mod_c = mod_c+-((20-(deg-115)) * ((deg-115)/20) * modifier*2)
            End If
        Else
            mod_s=0
            mod_c=0
        End If

    
        y=radius*(s+mod_s)
        x=radius*(c+mod_c)
    
        If mod_c<>0 Or mod_s <> 0 Then 
            circle (xctr+x,yctr+y),5,white,,,,f'jaw
        Else
            circle (xctr+x,yctr+y+100),10,blue
        End If
        
    Next
     
    colour(0,1)=100
    colour(0,2)=100
    colour(0,3)=100
    ball_not2d(400-100,290-70,50,colour(),0,0,.2)'brows
    ball_not2d(400+100,290-70,50,colour(),0,0,.2)
    colour(0,1)=100
colour(0,2)=50
colour(0,3)=150
    ball_not2d(400-100,290,50,colour(),.8*looper/500,0)'eye
    ball_not2d(400+100,290,50,colour(),-.8*looper/500,0)
    colour(0,1)=100
    colour(0,2)=0
    colour(0,3)=0
    ball_not2d(400,310,50,colour(),0,.9,3)'nose
    
    for z as double=400-50 to 400+50 step 20
        colour(0,1)=255
        colour(0,2)=255
        colour(0,3)=200
    ball_not2d(z,290+90,10,colour(),,4)
    ball_not2d(z+10,290+160-(40*(looper-360)/360),10,colour(),,-4)''teeth
    colour(0,1)=0
    colour(0,2)=50
    colour(0,3)=0
    ball_not2d(400-270,320,100,colour(),0,0,3)
    ball_not2d(400+270,320,100,colour(),0,0,3)
next z
bird
    screenunlock

    sleep 1,1
    If toggle = 0 Then 
        modifier+=.0001
        If modifier >= .005 Then toggle=1
    Else
        modifier-=.0001
        If modifier <=-.045 Then toggle = 0
        
    End If
  if looper>500 then k=-k
  if looper<0 then k=-k
  
Loop Until inkey =chr(27)

Function r(first As Double, last As Double) As Double
    Function = Rnd * (last - first) + first
End Function
sub drawpolygon(x() as double,y() as double,colour as uinteger,im as any pointer=0)
    dim k as integer=ubound(x)+1
    dim as integer index,nextindex
    dim as double xc,yc
    for n as integer=1 to ubound(x)'+1
        xc=xc+x(n):yc=yc+y(n)
        index=n mod k:nextindex=(n+1) mod k
        if nextindex=0 then nextindex=1
    line im,(x(index),y(index))-(x(nextindex),y(nextindex)),colour
    next
  xc=xc/ubound(x):yc=yc/ubound(y)
  paint im,(xc,yc),colour,colour
end sub
sub drawstars(starx as double,stary as double,size as double,col as uinteger)
    dim as double xstar(8),ystar(8)
    dim l as double=4*size
    static counts as integer
    
    Xstar(1)=starX : Ystar(1)=starY-l
  Xstar(2)=starX+size:Ystar(2)=starY-size
  Xstar(3)=starX+l:Ystar(3)=starY
  Xstar(4)=starX+size:Ystar(4)=starY+size
  Xstar(5)=starX:Ystar(5)=starY+l
  Xstar(6)=starX-size:Ystar(6)=starY+size
  Xstar(7)=starX-l:Ystar(7)=starY
  Xstar(8)=starX-size:Ystar(8)=starY-size
 if counts<51 then
 drawpolygon(Xstar(),Ystar(),col,img)
else
 drawpolygon(Xstar(),Ystar(),col)
 end if
'end if
counts=counts+1

'print count
end sub
Sub rotate(Byval pivot_x As Double,_   'turns about this point
           Byval pivot_y As Double,_
           Byval first_x As Double,_    'centre for circles
           Byval first_y As Double,_
           Byval second_x As Double, _   'radius for circles
           Byval second_y As Double, _   'aspect
           byval arc_1 as double,_       'arcs only for circle, 0 for lines
           byval arc_2 as double,_
           Byval angle As Double, _      'all below for circles and lines
           Byval magnifier As Double,_
           Byval dilator as double,_
           Byval colour As Integer,_
           byval thickness as double,_
           Byref shape As String,_
           image as any pointer=0)
           'rotated line is  (np(1),np(2))-(np(3),np(4))
           'rotated circle centre is np(3),np(4)
           'shape:
           'line - draws the line
           'linepoint - does the calculation, draws nothing
           'linepointset - does the calculations, sets a pixel at the line ends
           'ALSO circle,circlepoint, circlepointset,box, boxfill, circlefill.
           'arcs from horizontal positive x axis in DEGREES
           'arc1<arc2 always e.g from 330 to 430
  shape=lcase$(shape)      
Dim p As Double = 4*Atn(1)  '(pi)
Dim radians As Double
Dim line_xvector As Double
Dim line_yvector As Double
Dim pivot_xvector As Double
Dim pivot_yvector As Double
Dim th As Double
  th=thickness
  Dim sx As Double=second_x
  angle=angle mod 360
radians=(2*p/360)*angle      'change from degrees to radians
#Macro thickline(t)
Dim As Double s,h,c
Dim As Uinteger prime=rgb(255,255,255)
h=Sqr(((np(1))-(np(3)))^2+((np(2))-(np(4)))^2)
s=((np(4))-np(2))/h
c=(np(1)-(np(3)))/h
line image, (np(3)+s*t/2,np(4)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),prime
line image, (np(3)-s*t/2,np(4)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),prime
line image, (np(3)+s*t/2,np(4)+c*t/2)-(np(3)-s*t/2,np(4)-c*t/2),prime
line image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),prime
paint image,((np(3)+np(1))/2, (np(4)+np(2))/2),prime,prime

line image, (np(3)+s*t/2,np(4)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),colour
line image, (np(3)-s*t/2,np(4)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colour
line image, (np(3)+s*t/2,np(4)+c*t/2)-(np(3)-s*t/2,np(4)-c*t/2),colour
line image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colour
paint image,((np(3)+np(1))/2, (np(4)+np(2))/2), colour, colour
#EndMacro

#macro thickcircle(t)
Dim As Uinteger prime=rgb(255,255,255)
dim as double xp1,xp2,yp1,yp2
dim arc1 as double=arc_1*p/180
dim arc2 as double=arc_2*p/180
arc1=2*p+(arc1-(radians))
arc2=2*p+(arc2-(radians))
sx=sx*magnifier
if arc1=arc2 then
     circle image,(np(3),np(4)),sx+t/2,prime,,,second_y
    circle image,(np(3),np(4)),sx-t/2,prime,,,second_y
    paint image,(np(3),np(4)+sx),prime,prime
    paint image,(np(3)+sx,np(4)),prime,prime
    circle image,(np(3),np(4)),sx+t/2,colour,,,second_y
    circle image,(np(3),np(4)),sx-t/2,colour,,,second_y
    paint image,(np(3),np(4)+sx),colour,colour
    paint image,(np(3)+sx,np(4)),colour,colour
end if
if arc1<>arc2 then
    xp1=np(3)+(sx)*cos(.5*(arc2+arc1))
yp1=np(4)-(sx)*sin(.5*(arc2+arc1))
circle image,(np(3),np(4)),sx+t/2,prime,arc1,arc2,second_y
    circle image,(np(3),np(4)),sx-t/2,prime,arc1,arc2,second_y
    line image,(np(3)+(sx+t/2)*cos(arc1),np(4)-(sx+t/2)*sin(arc1))-(np(3)+(sx-t/2)*cos(arc1),np(4)-(sx-t/2)*sin(arc1)),prime
    line image,(np(3)+(sx+t/2)*cos(arc2),np(4)-(sx+t/2)*sin(arc2))-(np(3)+(sx-t/2)*cos(arc2),np(4)-(sx-t/2)*sin(arc2)),prime

    paint image,(xp1,yp1),prime,prime
    
circle image,(np(3),np(4)),sx+t/2,colour,arc1,arc2,second_y
    circle image,(np(3),np(4)),sx-t/2,colour,arc1,arc2,second_y
    line image,(np(3)+(sx+t/2)*cos(arc1),np(4)-(sx+t/2)*sin(arc1))-(np(3)+(sx-t/2)*cos(arc1),np(4)-(sx-t/2)*sin(arc1)),colour
    line image,(np(3)+(sx+t/2)*cos(arc2),np(4)-(sx+t/2)*sin(arc2))-(np(3)+(sx-t/2)*cos(arc2),np(4)-(sx-t/2)*sin(arc2)),colour

    paint image,(xp1,yp1),colour,colour
   
end if
#endmacro

magnifier=dilator*magnifier      
pivot_xvector=first_x-pivot_x
pivot_yvector=first_y-pivot_y
pivot_xvector=dilator*pivot_xvector  
pivot_yvector=dilator*pivot_yvector 
Dim mover(1 To 2,1 To 2) As Double
Dim new_pos(1 To 2) As Double
mover(1,1)=Cos(radians)
mover(2,2)=Cos(radians)
mover(1,2)=-Sin(radians)
mover(2,1)=Sin(radians)

line_xvector=magnifier*(second_x-first_x)                   'get the vector
line_yvector=magnifier*(second_y-first_y)                   'get the vector

new_pos(1)=mover(1,1)*pivot_xvector+mover(1,2)*pivot_yvector +pivot_x
new_pos(2)=mover(2,1)*pivot_xvector+mover(2,2)*pivot_yvector +pivot_y
Dim new_one(1 To 2) As Double            'To hold the turned value

new_one(1)=mover(1,1)*line_xvector+mover(1,2)*line_yvector +first_x
new_one(2)=mover(2,1)*line_xvector+mover(2,2)*line_yvector +first_y
Dim xx As Double   'translation
Dim yy As Double 
xx=first_x-new_pos(1)
yy=first_y-new_pos(2)
np(1)=new_one(1)-xx  
  np(2)=new_one(2)-yy   
  np(3)=first_x-xx
 np(4)=first_y-yy
Select Case shape
Case "line"
    If th<2 Then
 line image,(np(3),np(4))-(np(1),np(2)),colour 
Else
 thickline(th)   
 End If
Case "circle"
    dim arc1 as double=arc_1*p/180
dim arc2 as double=arc_2*p/180
    if arc1=arc2 then
    If th<=3 Then
        for n as double=magnifier*sx-1 to magnifier*sx+1 step .5
     circle image,(np(3),np(4)),n,colour,,,second_y       
 'circle image,(np(3),np(4)),magnifier*sx,colour,,,second_y
 next n
Else
 thickcircle(th)
End If
endif
if arc1<>arc2 then
If th<=3 Then
    arc1=2*p+(arc1-(radians))'new
arc2=2*p+(arc2-(radians))'new
    for n as double=magnifier*sx-1 to magnifier*sx+1 step .5
     circle image,(np(3),np(4)),n,colour,arc1,arc2,second_y   
   ' circle image,(np(3),np(4)),magnifier*sx,colour,arc1,arc2,second_y
    next n
else
    thickcircle(th)
end if
end if
Case "circlefill"
    dim as double xp1,xp2,yp1,yp2
Dim As Uinteger prime=rgb(255,255,255)
dim arc1 as double=arc_1*p/180
dim arc2 as double=arc_2*p/180
if arc1=arc2 then circle image,(np(3),np(4)),magnifier*sx,colour,,,second_y,F
if arc1<>arc2 then

 xp1=np(3)+magnifier*sx*cos(.5*(arc2+arc1))*3/4
yp1=np(4)-magnifier*sx*sin(.5*(arc2+arc1))*3/4   
circle image,(np(3),np(4)),magnifier*sx,prime,arc1,arc2,second_y
line image,(np(3),np(4))-(np(3)+magnifier*sx*cos(arc2),np(4)-magnifier*sx*sin(arc2)),prime
line image,(np(3),np(4))-(np(3)+magnifier*sx*cos(arc1),np(4)-magnifier*sx*sin(arc1)),prime
paint image,(xp1,yp1),prime,prime

circle image,(np(3),np(4)),magnifier*sx,colour,arc1,arc2,second_y
line image,(np(3),np(4))-(np(3)+magnifier*sx*cos(arc2),np(4)-magnifier*sx*sin(arc2)),colour
line image,(np(3),np(4))-(np(3)+magnifier*sx*cos(arc1),np(4)-magnifier*sx*sin(arc1)),colour
paint image,(xp1,yp1),colour,colour
end if
 Case"box"
 line image,(np(3),np(4))-(np(1),np(2)),colour,b
Case "boxfill"
 line image,(np(3),np(4))-(np(1),np(2)),colour,bf
        Case "linepoint","circlepoint"
  'nothing drawn
Case "linepointset","circlepointset"
 If shape="linepointset" Then
 Pset image,(np(1),np(2)),colour
 Pset image,(np(3),np(4)),colour
 Endif
 If shape="circlepointset" Then
     Pset image,(np(3),np(4)),colour
 End If

        Case Else
 Print "unknown rotation shape"
End Select 
End Sub
'dim shared as double next_x,next_y


sub paintstring(x as double,_
           y as double,_
           s as string,_
           size as double,_
           c as uinteger,_
           line_angle as double=0,_
           char_angle as double=0,_
           thickness_tweak as double=1,_
           image as any pointer=0)
dim l as integer=len(s)
dim px as double=16*size+x
y=y+16*size
dim py as double=y'16*size+y
dim z as integer=0
dim th as double'=4
th=((.5-size)/4.5+5)*thickness_tweak
dim sp as double=6
dim sp2 as double=6
dim pi as double=4*atn(1)
dim la as double=(line_angle *.5) 
dim ca as double=(char_angle*.5) 
sp2=sp2+30*abs(sin(ca*pi/180-la*pi/180))

#macro set(x1,y1,x2,y2,sarc,earc,shape,im)
rotate(px,py,x1,y1,x2,y2,sarc,earc,-char_angle,1,size,c,th*size,shape,im)
#endmacro

#macro spaces(xpixels,ypixels)
px=px+(xpixels*size+sp2*size)*cos(line_angle*pi/180)
py=py-(ypixels*size+sp2*size)*sin(line_angle*pi/180)
next_x=px-16*size
next_y=py-16*size
#endmacro

for n as integer=1 to l
    
    select case mid$(s,n,1)
    case " "
 spaces(30,30)

 
case "|"
 z=z+1
 px=(x+16*size+z*16*sin(line_angle*pi/180))+1.3*z*(24*size+size*sp*size)*sin(line_angle*pi/180)
 py=(y+z*16*cos(line_angle*pi/180))+1.3*z*(24*size+size*sp*size)*cos(line_angle*pi/180)
 next_x=px-16*size
next_y=py-16*size
case "1"
 set(px-8,py-18,px-8,py+16,.0,.0,"line",image)'vert
 set(px-8,py-16,px-12,py-8,.0,.0,"line",image)
 spaces(12,12)
case "2"
 set(px-2,py-8,9,1,310,530,"circle",image)'curve
 set(px-15,py+14,px+5,py-2,.0,.0,"line",image)
 set(px-16,py+14,px+10,py+14,.0,.0,"line",image)'base
 spaces(28,28)
case "3"
 set(px-2,py-7,9,1,300,530,"circle",image)'curve top
 set(px-2,py+6,9,1,190,395,"circle",image)'curve
 set(px-3,py,px+5,py,.0,.0,"line",image)
 spaces(28,28)
case "4"
 set(px-16,py+4,px+12,py+4,.0,.0,"line",image)'horiz 
 set(px-14,py+4,px+4,py-16,.0,.0,"line",image)'slope
 set(px+4,py-18,px+4,py+16,.0,.0,"line",image)
 spaces(28,28)
case "5"
 set(px-14,py-16,px+6,py-16,.0,.0,"line",image)'top
 set(px-12,py-16,px-12,py+1,.0,.0,"line",image)'vert
 set(px-4,py+6,9,1,210,500,"circle",image)'curve
 spaces(28,28)
case "6"
 set(px-2,py+6,9,1,360,360,"circle",image)'curve base
 set(px+16,py+4,27,1,130,180,"circle",image)'curve edge
 spaces(28,28)
case "7"
 set(px-14,py-16,px+6,py-16,.0,.0,"line",image)'top
 set(px+5,py-16,px-12,py+16,.0,.0,"line",image)'slope
 spaces(26,26)
case "8"
 set(px-2,py-7,9,1,320,575,"circle",image)'curve top
 set(px-2,py+6,9,1,130,415,"circle",image)'curve
 set(px-9,py-1,px+6,py-1,.0,.0,"line",image)
 spaces(28,28)
 
case "9"
 set(px-2,py-6,9,1,360,360,"circle",image)'top 
 set(px-20,py-4,27,1,310,360,"circle",image)
 spaces(28,28)
case "0"
 set(px,py-1,15,1,360,360,"circle",image)
 spaces(36,36)
case "."
 set(px-12,py+12,1,1,360,360,"circle",image)
 spaces(10,10)
case "A"
 set(px,py-16,px-12,py+16,.0,.0,"line",image)
 set(px,py-16,px+12,py+16,.0,.0,"line",image)
 set(px-8,py+3,px+8,py+3,.0,.0,"line",image)
 spaces(30,30)'36
 case "a"
 set(px-4,py+4,10,1,360,360,"circle",image)
 set(px+6,py-8,px+6,py+16,.0,.0,"line",image)
 spaces(26,26)
case "B"
 set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
 set(px-12,py-14,px-5,py-14,.0,.0,"line",image)'top
  set(px-12,py+14,px-5,py+14,.0,.0,"line",image)'base
  set(px-5,py-6,8,1,290,450,"circle",image)'top loop
  set(px-5,py+6,8,1,270,430,"circle",image)'base loop
  set(px-12,py,px-2,py,.0,.0,"line",image)'middle
  spaces(24,24)
case "b"
    set(px-2,py+4,10,1,360,360,"circle",image)
 set(px-12,py-16,px-12,py+16,.0,.0,"line",image)
 spaces(28,28)
case "C"
    set(px,py,14,1,60,300,"circle",image)
    spaces(25,25)
case "c"
    set(px-4,py+4,10,1,60,300,"circle",image)
    spaces(20,20)
    case "D"
  set(px-12,py-16,px-12,py+16,.0,.0,"line",image)
 set(px-5,py,14,1,270,450,"circle",image)
 set(px-12,py-14,px-5,py-14,.0,.0,"line",image)
  set(px-12,py+14,px-5,py+14,.0,.0,"line",image)
  
  'rotate(px,py,px-24,py+20,px-24,py-20,0,0,-line_angle,1,size,rgb(255,0,0),1,"line",image)
 spaces(30,30)
case "d"
 set(px-4,py+4,10,1,360,360,"circle",image)
 set(px+6,py-16,px+6,py+16,.0,.0,"line",image)
 spaces(26,26)
case "E"
 set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
 set(px-12,py-14,px+6,py-14,.0,.0,"line",image)'top
  set(px-12,py+14,px+6,py+14,.0,.0,"line",image)'base
  set(px-12,py,px-2,py,.0,.0,"line",image)'middle
  spaces(25,25)
case "e"
  set(px-4,py+4,10,1,0,320,"circle",image)
  set(px-12,py+3,px+8,py+3,.0,.0,"line",image)
  spaces(26,26)
case "F"
  set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
 set(px-12,py-14,px+6,py-14,.0,.0,"line",image)'top
  set(px-12,py,px-2,py,.0,.0,"line",image)'middle
  spaces(24,24)
case "f"
  set(px-2,py-8,10,1,0,170,"circle",image)'curve
 set(px-12,py-10,px-12,py+16,.0,.0,"line",image)'vert
 set(px-10,py,px-2,py,.0,.0,"line",image)'middle
 spaces(28,28) 
case "G"
  set(px,py,14,1,50,350,"circle",image)
  set(px,py,px+16,py,.0,.0,"line",image)
    spaces(35,35)
case "g"
    set(px-4,py+4,10,1,360,360,"circle",image)
 set(px+6,py-6,px+6,py+20,.0,.0,"line",image)
 set(px-4,py+17,10,1,230,345,"circle",image)
 
 spaces(26,26)
case "H"
 set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
 set(px+12,py-16,px+12,py+16,.0,.0,"line",image)'vert
 set(px-12,py,px+12,py,.0,.0,"line",image)'middle
 spaces(32,32)
case "h"
  'set(px-6,py+4,10,1,0,150,"circle",image)
  set(px-4,py+2,8,1,0,170,"circle",image)'curve right
 set(px-12,py-16,px-12,py+16,.0,.0,"line",image)
 set(px+4,py,px+4,py+16,.0,.0,"line",image)
 spaces(25,25)
case "I"
 set(px,py+16,px,py-16,.0,.0,"line",image)'vert
 set(px-12,py+14,px+12,py+14,.0,.0,"line",image)
 set(px-12,py-14,px+12,py-14,.0,.0,"line",image)
 spaces(30,30)
case "i"
  set(px-12,py-6,px-12,py+16,.0,.0,"line",image)
  set(px-12,py-14,1,1,360,360,"circle",image)
  spaces(10,10)
case "J"
    'set(px-2,py+4,12,1,200,270,"circle",image)
    set(px-7,py+8,7,1,220,355,"circle",image)
 set(px,py-16,px,py+9,.0,.0,"line",image)'vert
 set(px-12,py-14,px+12,py-14,.0,.0,"line",image)'top
 spaces(30,30)
case "j"
 set(px,py-6,px,py+20,.0,.0,"line",image)
 set(px-7,py+20,7,1,220,360,"circle",image)
 set(px,py-14,1,1,360,360,"circle",image)
 spaces(22,22)
case "K"
 set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
 set(px+6,py-16,px-12,py,.0,.0,"line",image)'upper
 set(px+6,py+16,px-6,py-3,.0,.0,"line",image)
 spaces(25,25)
case "k"
 set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
 set(px+3,py-6,px-12,py,.0,.0,"line",image)'upper
 set(px,py+16,px-8,py-3,.0,.0,"line",image)'lower
 spaces(20,20)
case "L"
 set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
 set(px-12,py+14,px+6,py+14,.0,.0,"line",image)'base
 spaces(25,25)
case "l"
 set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
 spaces(10,10)
case "M"
 set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
 set(px+12,py-16,px+12,py+16,.0,.0,"line",image)'vert
 set(px-12,py-16,px,py,.0,.0,"line",image)'left arm
 set(px+12,py-16,px,py,.0,.0,"line",image)'right arm
 
 spaces(32,32)
case "m"
 set(px-6,py+2,6,1,0,170,"circle",image)'curve left
 set(px+6,py+2,6,1,0,170,"circle",image)'curve right
 set(px-12,py-5,px-12,py+16,.0,.0,"line",image)'vert left
 set(px+12,py,px+12,py+16,.0,.0,"line",image)'vert right
 set(px,py+16,px,py,.0,.0,"line",image)'mid arm
 spaces(32,32)
case "N"
 set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
 set(px+12,py-16,px+12,py+16,.0,.0,"line",image)'vert
 set(px-12,py-16,px+12,py+16,.0,.0,"line",image)'middle
 spaces(32,32)
case "n"
    set(px-4,py+2,8,1,0,170,"circle",image)'curve right
 set(px-12,py-5,px-12,py+16,.0,.0,"line",image)'vert left
 set(px+4,py+16,px+4,py,.0,.0,"line",image)'mid arm
 spaces(24,24)
case "O"
 set(px,py,14,1,360,360,"circle",image)
 spaces(36,36)
case "o"
 set(px-4,py+4,10,1,360,360,"circle",image)
 'set(px+6,py-16,px+6,py+16,.0,.0,"line",image)
 spaces(26,26)
case "P"
 set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
 set(px-12,py-14,px-5,py-14,.0,.0,"line",image)'top
  'set(px-12,py+14,px-5,py+14,.0,.0,"line",image)'base
  set(px-5,py-6,8,1,280,450,"circle",image)'top loop
  'set(px-5,py+6,10,1,270,430,"circle",image)'base loop
  set(px-12,py+2,px-2,py+2,.0,.0,"line",image)'middle
  spaces(24,24)
case "p"
 set(px-5,py+4,10,1,270,435,"circle",image)' loop
  set(px-14,py-5,px-2,py-5,.0,.0,"line",image)'top
 set(px-12,py+14,px-5,py+14,.0,.0,"line",image)'base
 set(px-12,py-6,px-12,py+26,.0,.0,"line",image)'vert
 spaces(24,24) 
case "Q"
 set(px,py,14,1,360,360,"circle",image)
 set(px+5,py+20,16,1,400,460,"circle",image)
 spaces(36,36)
case "q"
 set(px-5,py+6,10,1,110,270,"circle",image)' loop
 set(px-9,py-3,px+2,py-3,.0,.0,"line",image)'top
 set(px-8,py+16,px,py+16,.0,.0,"line",image)'base
 set(px,py-3,px,py+26,.0,.0,"line",image)'vert
 spaces(20,20)
case "R"
 set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
 set(px-12,py-14,px-5,py-14,.0,.0,"line",image)'top
  'set(px-12,py+14,px-5,py+14,.0,.0,"line",image)'base
  set(px-5,py-6,8,1,290,450,"circle",image)'top loop
  'set(px-5,py+6,10,1,270,430,"circle",image)'base loop
  set(px-12,py+2,px-2,py+2,.0,.0,"line",image)'middle
  set(px-8-1+3,py+1,px+12-8-1,py+16+1-2,.0,.0,"line",image)'slope
  spaces(24,24)
case "r"
  set(px-4,py+4,10,1,30,130,"circle",image)
 set(px-12,py-8,px-12,py+16,.0,.0,"line",image)
 spaces(24,24)
case "S"
 set(px-2,py-7,8,1,20,240,"circle",image)'curve top
 set(px-2,py+6,8,1,200,500,"circle",image)'curve
 'set(px-9,py-1,px+6,py-1,.0,.0,"line",image)
 spaces(26,26)
case "s"
 set(px-4,py+4,10,1,40,140,"circle",image)'top
 set(px-1,py-4,10,1,180,240,"circle",image)'topslant
 set(px-6,py+14,10,1,20,100,"circle",image)'baseslant
 set(px-4,py+4,10,1,220,325,"circle",image)'base
 'set(px-12,py-4,px+2,py+12,.0,.0,"line",image)
 'set(px+6,py-8,px+6,py+16,.0,.0,"line",image)
 spaces(26,26)
case "T"
 set(px,py-12,px,py+16,.0,.0,"line",image)'vert
 set(px-16,py-12-2,px+16,py-12-2,.0,.0,"line",image)
 spaces(34,34)
case "t"
 set(px-12,py-16,px-12,py+10,.0,.0,"line",image)'edge
 set(px-12,py-4,px-2,py-4,.0,.0,"line",image)
 set(px-4,py+4,10,1,210,320,"circle",image)
 spaces (24,24)
case "U"
 set(px-12,py-16,px-12,py+8,.0,.0,"line",image)'vert
 set(px+12,py-16,px+12,py+8,.0,.0,"line",image)'vert
 set(px,py,14,1,205,335,"circle",image)
 'set(px-12,py,px+12,py,.0,.0,"line",image)'middle
 spaces(33,33)
case "u"
 set(px-4,py+4,10,1,210,360,"circle",image)
 set(px+6,py-6,px+6,py+16,.0,.0,"line",image)
 set(px-12,py-6,px-12,py+10,.0,.0,"line",image)'left edge
 spaces(26,26)
case "V"
 set(px,py+16,px-12,py-16,.0,.0,"line",image)
 set(px,py+16,px+12,py-16,.0,.0,"line",image)
 'set(px-8,py+3,px+8,py+3,.0,.0,"line",image)
 spaces(32,32)'36
    	Case "v"
  set(px-12,py-6,px-4,py+16,.0,.0,"line",image)'left 
  set(px-4,py+16,px+4,py-6,.0,.0,"line",image)
  spaces(24,24) 
    	Case "W"
   set(px-12,py-16,px-8,py+16,.0,.0,"line",image)'vert left
 set(px+12,py-16,px+8,py+16,.0,.0,"line",image)'vert
 set(px-8,py+16,px,py,.0,.0,"line",image)'left arm
 set(px+8,py+16,px,py,.0,.0,"line",image)'right arm
 spaces(32,32)
    	Case "w"
    		set(px-14,py-6,px-8,py+16,.0,.0,"line",image)'vert left
    		set(px+8,py+16,px+12,py-6,.0,.0,"line",image)'vert right
    		set(px-8,py+16,px,py,.0,.0,"line",image)'left arm
 set(px+8,py+16,px,py,.0,.0,"line",image)'right arm
    		spaces(33,33)
        case "X"
            set(px-12,py-16,px+12,py+16,.0,.0,"line",image)
            set(px+12,py-16,px-12,py+16,.0,.0,"line",image)
            spaces(32,32)
        case "x"
            set(px-12,py-6,px+2,py+16,.0,.0,"line",image)
            set(px+2,py-6,px-12,py+16,.0,.0,"line",image)
            spaces(22,22)
        case "Y"
            set(px-12,py-16,px,py,.0,.0,"line",image)
            set(px+12,py-16,px,py,.0,.0,"line",image)
            set(px,py,px,py+16,.0,.0,"line",image)
            spaces(32,32)
        case "y"
               set(px-4,py+4,8,1,180,380,"circle",image)'top
 set(px+4,py-6,px+4,py+20,.0,.0,"line",image)'right
 set(px-6,py+17,10,1,230,345,"circle",image)'base
 set(px-12,py-6,px-12,py+4,.0,.0,"line",image)'left
 spaces(24,24)
case "Z"
 set(px-12,py-14,px+12,py-14,.0,.0,"line",image)'top
 set(px-12,py+14,px+12,py+14,.0,.0,"line",image)
 set(px+10,py-14,px-10,py+14,.0,.0,"line",image)'slope
 spaces(30,30)
case "z"
 set(px-16,py-4,px+2,py-4,.0,.0,"line",image)'top
 set(px-16,py+14,px+2,py+14,.0,.0,"line",image)'base
 set(px+1,py-5,px-14,py+14,.0,.0,"line",image)'slope
 spaces(20,20)
            
 '************************************************ 		
case ","
 set(px-12,py+12,px-18,py+20,.0,.0,"line",image)
 set(px-12,py+12,1,1,360,360,"circle",image)
 spaces(10,10)

 case"£"
 set(px-5,py-5,8,1,40,220,"circle",image)'top
 set(px-19-5-5,py+10-5,18,1,320,390,"circle",image)
 set(px-16,py+16,px+8,py+16,.0,.0,"line",image)'base
 set(px-16,py+2,px,py+2,.0,.0,"line",image)
 spaces(28,28)
case "$"
  set(px-2,py-7,8,1,20,240,"circle",image)'curve top
 set(px-2,py+6,8,1,200,495,"circle",image)'curve
 set(px-2,py-17,px-2,py+17,.0,.0,"line",image)
 'set(px-9,py-1,px+6,py-1,.0,.0,"line",image)
 spaces(26,26)
case "%"
 set(px-10,py-10,6,1,360,360,"circle",image)
 set(px+10,py+10,6,1,360,360,"circle",image)
 set(px+8,py-8,px-8,py+8,.0,.0,"line",image)
 spaces(33,33)
case "^"
 set(px-14,py,px-7,py-16,.0,.0,"line",image)
 set(px-7,py-16,px,py,.0,.0,"line",image)
 spaces(20,20)
 case"&"
 set(px-2,py-7,8,1,70,220,"circle",image)'curve top
 set(px-2,py+6,8,1,110,415,"circle",image)'curve
 set(px-4-4-2,py-8,px+12-4,py+16,.0,.0,"line",image)
 'set(px-9,py-1,px+6,py-1,.0,.0,"line",image)
 spaces(28,28)
case "*"
 set(px-12,py-6-8,px+2,py+16-8,.0,.0,"line",image)
            set(px+2,py-6-8,px-12,py+16-8,.0,.0,"line",image)
            set(px-16,py-3,px+6,py-3,.0,.0,"line",image)
            spaces(24,24)
        case "("
            set(px+22,py,38,1,150,210,"circle",image)
            spaces(12,12)
        case ")"
       set(px-22-16-6,py,38,1,330,390,"circle",image)
            spaces(12,12)
        case "-"
            set(px-16,py,px+8,py,.0,.0,"line",image)
            spaces(26,26)
        case "_"
            set(px-16,py+16,px+16,py+16,.0,.0,"line",image)
            spaces(34,34)
            case "+"
            set(px-16,py,px+8,py,.0,.0,"line",image)
            set(px-4,py+12,px-4,py-12,.0,.0,"line",image)
            spaces(26,26)
        case "="
        set(px-16,py-4,px+8,py-4,.0,.0,"line",image)
        set(px-16,py+4,px+8,py+4,.0,.0,"line",image)
        spaces(26,26)
    case "!"
        set(px-12,py-16,px-12,py+6,.0,.0,"line",image)
        set(px-12,py+12,1,1,360,360,"circle",image)
        spaces(10,10)
    case "¬"
    set(px-16,py+4,px+8,py+4,.0,.0,"line",image)
    set(px+6,py+4,px+6,py+12,.0,.0,"line",image)
    spaces(26,26)
case "`"
    set(px-16,py-16,px-12,py-12,.0,.0,"line",image)
    spaces(8,8)
case ";"
    set(px-12,py-4,1,1,360,360,"circle",image)'top
  set(px-12,py+12,px-18,py+20,.0,.0,"line",image)
 set(px-12,py+12,1,1,360,360,"circle",image)
 spaces(10,10) 
case ":"
   set(px-12,py-4,1,1,360,360,"circle",image)'top
  'set(px-12,py+12,px-18,py+20,.0,.0,"line",image)
 set(px-12,py+12,1,1,360,360,"circle",image)
 spaces(10,10)
case "@"
 set(px,py,14,1,0,290,"circle",image)
 set(px+6,py,7,1,100,365,"circle",image)
 spaces(36,36)
case "'"
 set(px-12,py-12,px-18,py-4,.0,.0,"line",image)
 set(px-12,py-12,1,1,360,360,"circle",image)
 spaces(10,10)
case "#"
 set(px-16,py-4,px+8,py-4,.0,.0,"line",image)
set(px-16,py+4,px+8,py+4,.0,.0,"line",image)
set(px-8,py-12,px-8,py+12,.0,.0,"line",image)
set(px,py-12,px,py+12,.0,.0,"line",image)
        spaces(26,26)
    case "~"
  set(px-8,py+16,14,1,60,120,"circle",image)
  set(px+4,py-8,14,1,240,300,"circle",image)
  spaces(30,30)
case "/"
  set(px+14,py-16,px-14,py+16,.0,.0,"line",image)
  spaces(34,34)
case "\"
  set(px-14,py-16,px+14,py+16,.0,.0,"line",image)
  spaces(34,34)
case "["
  set(px-12,py-16,px-12,py+16,.0,.0,"line",image)'vert
  set(px-12,py-14,px-4,py-14,.0,.0,"line",image)'top
  set(px-12,py+14,px-4,py+14,.0,.0,"line",image)
  spaces(14,14)
case "]"
  set(px-4,py-16,px-4,py+16,.0,.0,"line",image)'vert
  set(px-4,py-14,px-12,py-14,.0,.0,"line",image)'top
  set(px-12,py+14,px-4,py+14,.0,.0,"line",image)
  spaces(16,16)
case "{"
  set(px+12,py-8,28,1,160,200,"circle",image)
  set(px+12,py+8,28,1,160,200,"circle",image)
            spaces(8,8)
case "}"
  set(px-12-16-6,py-8,28,1,340,380,"circle",image)
  set(px-12-16-6,py+8,28,1,340,380,"circle",image)
            spaces(14,14)
case "<"
    set(px-16,py,px+4,py-12,.0,.0,"line",image)
    set(px-16,py,px+4,py+12,.0,.0,"line",image)
    spaces(24,24)
case ">"
    set(px+4,py,px-16,py-12,.0,.0,"line",image)
    set(px+4,py,px-16,py+12,.0,.0,"line",image)
    spaces(24,24)
case "?"
     set(px-5,py-6,8,1,280,490,"circle",image)'top loop
     set(px-4,py,px-4,py+8,.0,.0,"line",image)
     set(px-4,py+15,1,1,360,360,"circle",image)
     spaces(24,24)
     case """"
  set(px-12,py-16,px-18,py-8,.0,.0,"line",image)
 set(px-12,py-16,1,1,360,360,"circle",image)
 
 set(px-4,py-16,px-10,py-8,.0,.0,"line",image)
 set(px-4,py-16,1,1,360,360,"circle",image)
 spaces(16,16)  
  case else
    draw string(px,py),"?",c
    spaces(24,24)
    end select
    next n
end sub
Sub starfield(pixels As Integer=1000,maxlength As Integer=10,offx As Double=0,offy As Double=0)
    Dim  As Integer xres,yres
    Screeninfo xres,yres
    Dim As Integer _width=(1+offx)*xres,_height=(1+offy)*yres',X,Y,Z
    Static As Integer x,y,z
    
    #macro refresh(zz)
   
    X=rr(-(( _width + 1) - ( _width /2)),(( _width + 1) - ( _width /2)))
    Y=rr(-((_height + 1) - (_height /2)),((_height + 1) - (_height /2)))
    X3D(i,0) = X
    Y3D(i,0) = Y
    length=Int(Rnd*(maxlength))+1
    Z3D(i,0) =  length
    #endmacro
    #macro rr(first,last)
    Rnd * (last - first) + first
    #endmacro
   static as double size1()
    Static  As Double Z3D(),X2D(),Y2D()
    Static As Integer X3D(),Y3D()
    Static As Uinteger colour()
    Static count As Integer
    redim preserve size1(pixels)
    Redim Preserve X3D(pixels,2)'int
    Redim Preserve Y3D(pixels,2)'int
    Redim  Preserve Z3D(pixels,2) 'as double
    Redim Preserve X2D(pixels,2)'dbl
    Redim Preserve Y2D(pixels,2)'dbl
    Dim As Integer i
    Static As Integer  length
    Redim Preserve colour(pixels)
   
    ' Initialize on first call only
    If count=0 Then
        For i = 0 To pixels
            X=rr(-(( _width + 1) - ( _width /2)),(( _width + 1) - ( _width /2)))
            Y=rr(-((_height + 1) - (_height /2)),((_height + 1) - (_height /2)))
            Z=Int(Rnd*200)
            length=Int(Rnd*maxlength)+1
            X3D(i,0) = X
            Y3D(i,0) = Y
            Z3D(i,0) = Z  +  length
            X3D(i,1) = X
            Y3D(i,1) = Y
            Z3D(i,1) = Z
            colour(i)=Rgb(rr(0,255),rr(0,255),rr(0,255))
        Next
        count=count+1
    End If
   
    For i = 0 To pixels
        X2D(i,0) = ((X3D(i,0) * 256) / (256 - Z3D(i,0))) + ( _width / 2)
        Y2D(i,0) = (((_height / 2)- Y3D(i,0) * 256) / (256 - Z3D(i,0))) + (_height / 2)
       
        X2D(i,1) = ((X3D(i,1) * 256) / (256 - Z3D(i,1))) + ( _width / 2)
        Y2D(i,1) = (((_height / 2)- Y3D(i,1) * 256) / (256 - Z3D(i,1))) + (_height / 2)
        Line(X2d(i,0),Y2D(i,0))-(X2d(i,1),Y2D(i,1)),colour(i)'rgb(x3d(i,1),y3d(i,1),z3d(i,1))
        size1(i)=.03*sqr((x2d(i,0)-x2d(i,1))^2+(y2d(i,0)-y2d(i,1))^2)
    drawstars(X2D(i,0),Y2d(i,0),size1(i),colour(i)+1)
    Next 
    For i = 0 To pixels
        Z3D(i,0) = Z3D(i,0) + 1
        Z3D(i,1) = Z3D(i,1) + 1
       
        If Z3D(i,1) > 254 - maxlength Then 
            Refresh(0)
        End If
       
        If Z3D(i,1) > 254 - maxlength Then
            X3D(i,1) = X3D(i,0): Y3D(i,1) = Y3D(i,0)
        End If
        If Z3D(i,1) > 254 - maxlength Then
            Z3D(i,1) = 0
        End If
    Next
End Sub

Sub polygon(n As Integer,_ 'number of sides
    centreX As Double,_            'centres
    centreY As Double,_
    col() as uinteger,_              'dim 1 to 6
    t As Double=1,_                'thickness
    size As Double=100,_           'radius if circle
    angle As Double=0,_           'turn a few degrees to one side
    offset as double=0,_            
    ex As Double=1,_               'eccentricity on x plane
    ey As Double=1,_               'eccentricity on y plane
    im as any pointer=0)

    Dim pi As Double=4*Atn(1)
    #define rad *pi/180
    angle=angle rad 'can rotate the polygon by degrees
    Dim slug As Double=2*pi/n
    Dim As Double dist=size
    dim as double x1,x2,y1,y2
    dim as double x1r,x2r,y1r,y2r
For z As Double=0+offset To 2*pi+offset Step slug
    For k As Double =0 To t Step .1
       
    x1=centrex+ex*(dist-k)*Cos(z)
    y1=centrey+ey*(dist-k)*Sin(z)
    x2=centrex+ex*(dist-k)*Cos(z+slug)
    y2=centrey+ey*(dist-k)*Sin(z+slug)
   'now rotate
    x1r=(cos(angle)*(x1-centreX)-sin(angle)*(y1-centreY))+centreX
    y1r=(sin(angle)*(x1-centreX)+cos(angle)*(y1-centreY))+centreY
    x2r=(cos(angle)*(x2-centreX)-sin(angle)*(y2-centrey))+centreX
    y2r=(sin(angle)*(x2-centreX)+cos(angle)*(y2-centreY))+centreY
    line im,(x1r,y1r)-(x2r,y2r),rgb(col(1),col(2),col(3))
   
    Next k
Next z
End Sub
sub bonnet
dim as integer xres,yres
screeninfo xres,yres
dim as uinteger col(1 to 3)
col(1)=200
#macro col2(z)
select case z
case 1
  col(1)=200:col(2)=0:col(3)=0
case 2
  col(1)=200
col(2)=200
col(3)=200
end select
#endmacro
col2(2)
polygon(50,.3*xres+20,.1*yres-40,col(),25,20,0,0,1,1,img)
   col2(1)
polygon(15,.4*xres+40,.14*yres-20,col(),55,55,20,0,2,1,img)
col2(2)
polygon(20,.5*xres,.2*yres-20,col(),30,30,0,0,7,1,img)
  
   
end sub
sub bird
dim as integer xres,yres
screeninfo xres,yres
dim as double PLOT_grade=20000
dim as double temp1,temp2
#macro sketch(_function,minx,maxx,miny,maxy)
For x As Double=minx To maxx Step (maxx-minx)/PLOT_GRADE
    dim as double x1=Cdbl(xres)*(x-minx)/(maxx-minx)
    dim as double y1=Cdbl(yres)*(_function-maxy)/(miny-maxy)
    Pset(x1,y1),rgb(0,0,10)'10
    if abs(x)<1e-3 then
        temp1=x1:temp2=y1
        end if
Next x
circle (temp1,temp2),50,rgb(0,200,0),,,,f
circle (temp1-20,temp2-20),10,rgb(200,200,200),,,,f
circle (temp1+20,temp2-20),10,rgb(200,200,200),,,,f

circle (temp1-20-5*z,temp2-20),3,rgb(00,00,200),,,,f
circle (temp1+20-5*z,temp2-20),3,rgb(00,00,200),,,,f

circle (temp1,temp2),30,rgb(0,0,0),4,5.5
circle (temp1,temp2-2),30,rgb(0,0,0),4-k/3,5.5+k/3
circle (temp1,temp2),51,rgb(0,0,10)
#endmacro

static k as integer=1
static z as double
dim pi as double=4*atn(1)
     z=z+.02*k '.02

sketch (-sin(z*x+z),-(pi),pi,-2,2)
sketch (sin(z*x-z),-(pi),pi,-2,2)
paint (.25*xres,.5*yres),rgba(100,100,120,190),rgb(0,0,10)
paint (.75*xres,.5*yres),rgba(100,100,120,190),rgb(0,0,10)
if z>1.1 then k=-k
if z<-1.1 then k=-k
if z>2*pi then z=0
end sub
sub xmas
    dim as uinteger col
    for n as double=.9 to 1 step .01
     if n<1 then
         col=rgb(255,254,254)
     else
         col=rgb(255,0,0)
     end if
     if n<=.902 then col=rgb(0,0,0)
     paintstring(0+50*n,30+50*n,"MERRY CHRISTMAS|",1.4,col,0,0,n,img)
     paintstring(150+50*n,500+50*n,"Happy New Year",.9,col,0,0,n,img)
     paintstring(-20+50*n,450+50*n,"2011 (soon)",1,col,0,0,1,img)
 next n
 end sub
 Sub ball_not2d(cx As Double,_  'CENTRES
               cy As Double,_
               radius As Double,_
               col() As Uinteger,_  'COLOUR ARAY, 2 Dimensions
               offsetX As Double=0,_ 'Bright spot (0 to about .9)
               offsetY As Double=0,_
               e As Double=0,_        'eccentricity 
               resolution As Double=32,_  'number of circles drawn
               im As Any Pointer=0)
    
    Dim As Double d',px,py
    Dim As Integer red,green,blue,_r,g,b
    Dim As Double ox,oy,nx,ny 'ox,oy offset centres position, nx,ny New moving centres
    Dim As Integer n=col(0,0)
    
    ox=cx+offsetX*radius
    oy=cy+offsetY*radius
    red=col(n,1) 
    green=col(n,2)
    blue=col(n,3)
    For d = radius To 0 Step -radius/resolution
        nx=(cx-ox)*(d-radius)/radius + cx 'linear mappings for moving centre
        ny=(cy-oy)*(d-radius)/radius + cy
        _r=-red*(d/radius-1)
        g=-green*(d/radius-1)
        b=-blue*(d/radius-1)
        Circle im,(nx,ny),d,rgb(_r,g,b),,,e,F
    Next d
End Sub
imagedestroy img

Sleep

dafhi · Post by **dafhi** » Dec 21, 2010 2:24

That's awesome!!!!!

It's a bit chilly in here, but I wear a coat and sit in front of the fire that is my laptop =)

rolliebollocks · Post by **rolliebollocks** » Dec 21, 2010 16:19

That's awesome, Dodicat... Merry Xmas to you too good sir...

squall4226 · Post by **squall4226** » Dec 21, 2010 17:24

Most excellent.

Since everyone is commenting on the weather, it is not cold here at all. Outside is 52F(11C). Inside is ~70F(21C). This room is ~80F(27C) because of various electronic equipment in a closed room lol.

Anyway, Merry Christmas to you all.

~Blyss

h4tt3n · Post by **h4tt3n** » Dec 21, 2010 17:55

Really neat Dodicat :-)

Here in Denmark we have -7 degrees celsius. Everything is already covered in snow, and there's more to come in the next few days, so we're almost 100% certain of a white christmas.

Cheers,
Mike

Richard · Post by **Richard** » Dec 22, 2010 0:42

Almost exactly one hour ago we all passed the solstice together.

So far here we have had a much colder than normal December. It only reached +17C yesterday and fell all the way to +9C overnight. To code in FreeBASIC is usually seen to demonstrate intelligence, but a failure to migrate like the swallows shows that it might not be so much intelligence as merely cleverness. Maybe you are just hemispherically challenged.

Now I must go out on the tractor to move my neighbours irrigator. I will remember to take a bucket to carry the unseasonal mushrooms that are springing up here in time for Christmas.

@ dodicat. Nice code. It is a bit late to complain about the cold, you should have abandoned the Red Duster in Northern Queensland, back when you had the chance. Yes, I know that is 20:20 hindsight in 2010, but it is right.