Squares
-
- Posts: 489
- Joined: Apr 18, 2008 4:09
- Location: Los Angeles, CA
- Contact:
@dodicat,
Yes, good lesson there that a macro is faster than a function.
I like your code structure of passing the expression to the macro...
#macro sketch(_function,minx,maxx,miny,maxy)
coupled with...
sketch(Sin(x)/x,-20,40,-1,2)
Very efficient if multiple (different) functions are used.
If I understand correctly, the compiler inserts the macro code at each invocation in the code, so the function must be defined at compile time. In other words, the first argument to sketch must be explicit in the code, and not, for example, a string variable that would specify the function. The latter would require some type of fancy parsing / interpreter, I guess.
Yes, good lesson there that a macro is faster than a function.
I like your code structure of passing the expression to the macro...
#macro sketch(_function,minx,maxx,miny,maxy)
coupled with...
sketch(Sin(x)/x,-20,40,-1,2)
Very efficient if multiple (different) functions are used.
If I understand correctly, the compiler inserts the macro code at each invocation in the code, so the function must be defined at compile time. In other words, the first argument to sketch must be explicit in the code, and not, for example, a string variable that would specify the function. The latter would require some type of fancy parsing / interpreter, I guess.
@ BASICScience
Just for completeness, with the sketcher,, you can include the axis, you can plot a user defined function or a function of a function.
Since the macro is so simple you can easily adjust it for different colours.
1) User defined -- Square wave (since this topic is squares)
2) Function of function -- Chebyshev (6) polynomium, in which I set the x range outside the polynomial's defined range i.e. [-1,1], just to be awkward.
Just for completeness, with the sketcher,, you can include the axis, you can plot a user defined function or a function of a function.
Since the macro is so simple you can easily adjust it for different colours.
1) User defined -- Square wave (since this topic is squares)
2) Function of function -- Chebyshev (6) polynomium, in which I set the x range outside the polynomial's defined range i.e. [-1,1], just to be awkward.
Code: Select all
Dim As Integer xres,yres
screeninfo xres,yres
screenres xres,yres,32
dim as double PLOT_GRADE=100000
function squarewave(x as double)as double
dim f as double
for n as double=1 to 500 step 2
f=f+sin(n*x)/n
next n
f=.5-(2/3.142)*f
return f
end function
#macro sketchwithaxis(_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(200,0,0)
Next x
'THE AXIS BIT
if sgn(minx)<>sgn(maxx) then
line(0,(yres-(miny/(miny-maxy))*yres))-(xres,(yres-(miny/(miny-maxy))*yres)),rgb(100,100,100) 'x axis
endif
if sgn(miny)<>sgn(maxy) then
line(((minx/(minx-maxx))*xres),0)-(((minx/(minx-maxx))*xres),yres),rgb(100,100,100) 'y axis
endif
#endmacro
' *****************************************************
dim pi as double=4*atn(1)
draw string(20,20),"SQUARE WAVE",rgb(0,200,0)
sketchwithaxis(squarewave(x+.5*pi)-.5,-2*pi,4*pi,-2,2)
draw string(20,30),"PRESS A KEY",rgb(0,200,0)
sleep
cls
draw string(20,20),"CHEBYSHEV (6) POLYNOMIUM",rgb(0,200,0)
sketchwithaxis(cos(6*acos(x)),-2,2,-2,2)
sleep
-
- Posts: 2655
- Joined: Aug 28, 2008 10:54
- Location: new york
@All
New doodle for new thread!
New doodle for new thread!
Code: Select all
'Lissajous Knots
Const as double Pi = Atn(1)*4
function delta( n as double ) as double
return ((n-1)/n)*(PI/2)
end function
screen 19,32
dim as single a,b
a=rnd*800:b=rnd*600
for i as integer = 0 to 5000
dim as single x = A * sin(a*i + delta(i))+400
dim as single y = B * sin(b*i) + 300
Pset (x,y)
next
sleep
cls
a=30:b=60
for i as integer = 0 to 5000
dim as single x = A * sin(a*i + delta(i))+400
dim as single y = B * sin(b*i) + 300
Pset (x,y)
next
sleep
cls
a=40:b=60
for i as integer = 0 to 5000
dim as single x = A * sin(a*i + delta(i))+400
dim as single y = B * sin(b*i) + 300
Pset (x,y)
next
sleep
cls
a=117:b=126
for i as integer = 0 to 5000
dim as single x = A * sin(a*i + delta(i))+400
dim as single y = B * sin(b*i) + 300
Pset (x,y)
next
sleep
cls
a=219:b=126
for i as integer = 0 to 5000
dim as single x = A * sin(a*i + delta(i))+400
dim as single y = B * sin(b*i) + 300
Pset (x,y)
next
sleep
-
- Posts: 5494
- Joined: Sep 12, 2005 20:06
- Location: California
I'm probably late, but using static x as foo = bar, or using a global variable can have significant performance implications.
You may require the reservation and initialization of four, eight or more variables (possibly objects with constructors). Maybe recursively.
Say you're plotting a million points on the screen - possibly a 3D projection. You may have to employ this and similar algorithms multiple times, especially if you're applying visual effects, per frame.
I bet the people over at Adobe lose sleep over this kind of stuff.
You may require the reservation and initialization of four, eight or more variables (possibly objects with constructors). Maybe recursively.
Say you're plotting a million points on the screen - possibly a 3D projection. You may have to employ this and similar algorithms multiple times, especially if you're applying visual effects, per frame.
I bet the people over at Adobe lose sleep over this kind of stuff.
Hi Rollie
Great to get the old doodles up and running again.
Hi Prichard.
I've irradiated the screen twice over, pixels on pixels, not with any plain old Raster things or constructor objects, but with a Bresenham macro gun, made in Scotland.
Even this old 933 Mhz. box stuffs the screen in less than 1.4 secs.
Mind you, the subject matter isn't too exciting, just a couple of Feldspar crystals.
I just wondered how fast some of the super computers can do it.
Rollie~ might have to tweak his bios to get in the frame.
The code is a bit long, 'cos I've shoved in some fonts.
Sleep well Adobe!
Great to get the old doodles up and running again.
Hi Prichard.
I've irradiated the screen twice over, pixels on pixels, not with any plain old Raster things or constructor objects, but with a Bresenham macro gun, made in Scotland.
Even this old 933 Mhz. box stuffs the screen in less than 1.4 secs.
Mind you, the subject matter isn't too exciting, just a couple of Feldspar crystals.
I just wondered how fast some of the super computers can do it.
Rollie~ might have to tweak his bios to get in the frame.
The code is a bit long, 'cos I've shoved in some fonts.
Sleep well Adobe!
Code: Select all
'THE BRESSENHAM GUN
Dim As Integer xres,yres
screeninfo xres,yres
'xres=500
'yres=500
screenres xres,yres,32
declare Sub _thickline(x1 As Double,_
y1 As Double,_
x2 As Double,_
y2 As Double,_
thickness As Double,_
colour 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)
#define callmacro scope
#define endcall end scope
#macro psetline(xf,yf,zf,xs,ys,zs)
'scope
dim as single x1=xf
dim as single y1=yf
dim as single z1=zf
dim as single x2=xs
dim as single y2=ys
dim as single z2=zs
dim as single nx=x2-x1
dim as single ny=y2-y1
dim as single nz=z2-z1
dim as single length=sqr(nx^2+ny^2+nz^2)
nx=nx/length
ny=ny/length
nz=nz/length
dim as single lastx=0
dim as single lasty=0
for i as integer=0 to length
x1=x1+nx
y1=y1+ny
z1=z1+nz
dim col as uinteger=(255-delta)*(z1-zf)/(zs-zf)+delta
if drawflag="thickline" then
if i>2 then _thickline(x1,y1,lastx,lasty,thickness,rgb(col*r,col*g,col*b))
lastx=x1/6
lasty=y1
end if
if drawflag="pset" then pset(x1,y1),rgb(col*r,col*g,col*b)
if drawflag="circle" then circle(x1,y1),(40-10)*(z1-zf)/(zs-zf)+10,rgb(col*r,col*g,col*b),,,,f
next i
'end scope
#endmacro
dim as double thickness,radius
dim as double r,g,b,delta 'colour adjusters
delta=50 'if delta=0 then full range (0 to 255)
dim as double t1,t2
dim as single tot
'THE BLUE BACKGROUND
t1=timer
dim as string drawflag="pset"
b=1
for z as integer=0 to yres
callmacro:psetline(0,z,0,xres,z,1):endcall
next z
' *************************
' THE SHAPES
drawflag="thickline"
r=1:g=1:b=1
thickness=100
callmacro:psetline(60,90,0,xres-60,yres-90,1500):endcall
r=0
callmacro:psetline(60,yres-90,0,xres-60,90,1500):endcall
'drawflag="circle"
radius=10
r=1:g=0:b=0
callmacro:psetline(.9*xres,yres/2,0,.9*xres,yres/2.05,500):endcall
t2=timer
tot=t2-t1
paintstring(.17*xres,.457*yres,str(tot)+"seconds.",1.5,rgb(150,0,100))
sleep
Sub _thickline(x1 As double,_
y1 As Double,_
x2 As Double,_
y2 As Double,_
thickness As Double,_
colour As Uinteger)
dim p as uinteger
p=Rgb(255, 255, 255)
If thickness<2 Then
Line(x1,y1)-(x2,y2),colour
Else
Dim As Double s,h,c
h=Sqr((x2-x1)^2+(y2-y1)^2) 'hypotenuse
s=(y1-y2)/h 'sine
c=(x2-x1)/h 'cosine
Line (x1+s*thickness/2,y1+c*thickness/2)-(x2+s*thickness/2,y2+c*thickness/2),p
Line (x1-s*thickness/2,y1-c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),p
Line (x1+s*thickness/2,y1+c*thickness/2)-(x1-s*thickness/2,y1-c*thickness/2),p
Line (x2+s*thickness/2,y2+c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),p
'Paint((x1+x2)/2, (y1+y2)/2), p, p
Line (x1+s*thickness/2,y1+c*thickness/2)-(x2+s*thickness/2,y2+c*thickness/2),colour
Line (x1-s*thickness/2,y1-c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),colour
Line (x1+s*thickness/2,y1+c*thickness/2)-(x1-s*thickness/2,y1-c*thickness/2),colour
Line (x2+s*thickness/2,y2+c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),colour
'Paint((x1+x2)/2, (y1+y2)/2), colour, colour
End If
End Sub
Dim Shared np(1 To 4) As Double
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
-
- Posts: 5494
- Joined: Sep 12, 2005 20:06
- Location: California
-
- Posts: 2655
- Joined: Aug 28, 2008 10:54
- Location: new york
Hey guys. I'm putting together a demo pack. This is the first demo in the pack. It is super awesome. I even compiled it. Have a look!
http://www.imakegames.com/rolliebollocks/demo.zip
The .bas has a Lissajous texture generator. You can extract the sub from the bas and use it at your own pleasure, but teh .bas will not compile since I didn't include the entire lib.
...Be sure to move the mouse over the texture.
Try to make a regress. (It works).
http://www.imakegames.com/rolliebollocks/demo.zip
The .bas has a Lissajous texture generator. You can extract the sub from the bas and use it at your own pleasure, but teh .bas will not compile since I didn't include the entire lib.
...Be sure to move the mouse over the texture.
Try to make a regress. (It works).
Thanks Rollie~, looks neat, I haven't tried to make these curves yet.rolliebollocks wrote:Hey guys. I'm putting together a demo pack. This is the first demo in the pack. It is super awesome. I even compiled it. Have a look!
I had to edit my chequered square post, I was getting an error with fb21, but not fb20.
I'll just stick to 21 from now on.
Look forward to some more demos.
How was your speed with the crystals, I'm thinking about a computer upgrade, I think the 933Mhz is maybe a bit slow these days.
-
- Posts: 2655
- Joined: Aug 28, 2008 10:54
- Location: new york
Hi ROLLIE, I get 11 FPS with your thing.rolliebollocks wrote:With my thing? I get 60 FPS
@ anonymous1337
Static foo as bar outside the macro is fast and global is fast.
We live in a crazy place.
@All
This little skit is beyond the pale altogether, but never mind, this is silly section.
Code: Select all
Dim As Integer xres,yres
xres=1024
yres=768
screenres xres,yres,32
declare Sub thickline(x1 As Double,_
y1 As Double,_
x2 As Double,_
y2 As Double,_
thickness As Double,_
colour As Uinteger)
declare Sub drawstring(x As Double,_
y As Double,_
s As String,_
c As Uinteger,_
angle As Double=0,_
word_space As Double=1,_
char_space As Double=1,_
line_space As Double=1,_
image As Any Pointer=0)
#define callmacro Scope
#define endcall End Scope
#macro psetline(xf,yf,zf,xs,ys,zs)
'scope
Dim As Single x1=xf
Dim As Single y1=yf
Dim As Single z1=zf
Dim As Single x2=xs
Dim As Single y2=ys
Dim As Single z2=zs
Dim As Single nx=x2-x1
Dim As Single ny=y2-y1
Dim As Single nz=z2-z1
Dim As Single length=Sqr(nx^2+ny^2+nz^2)
nx=nx/length
ny=ny/length
nz=nz/length
Dim As Single lastx=0
Dim As Single lasty=0
For i As Integer=0 To length
x1=x1+nx
y1=y1+ny
z1=z1+nz
Dim col As Uinteger=(255-delta)*(z1-zf)/(zs-zf)+delta
If drawflag="thickline" Then
If i>2 Then thickline(x1,y1,lastx,lasty,thickness,rgb(col*r,col*g,col*b))
lastx=x1/10
lasty=y1
End If
If drawflag="pset" Then Pset(x1,y1),rgb(col*r,col*g,col*b)
If drawflag="circle" Then Circle(x1,y1),(40-10)*(z1-zf)/(zs-zf)+10,rgb(col*r,col*g,col*b),,,,f
Next i
'end scope
#endmacro
#macro rr(first, last)
Rnd * (last - first) + first
#endmacro
Dim As String drawflag
Dim As Double thickness,radius
Dim As Double r,g,b,delta 'colour adjusters
delta=100'if delta=0 then full range (0 to 255)
Dim As Double dist,cx,cy,xpos
Dim As Single tot
dim as integer mx,my,flag,count
cx=xres/2
cy=yres/2
thickness=100
do
delta=100
if count>10 then count=0
do
getmouse mx,my
drawflag="thickline"
dist=sqr((mx-cx)^2+(my-cy)^2)
screenlock
cls
if flag=0 then draw string (10,10),"LINE 'EM UP TO SEE THROUGH BOTH"
if flag=1 then draw string (10,20),"VERY GOOD"
r=1:g=0:b=0
callmacro:psetline(mx,my,0,sqr((mx-cx)^2),sqr((my-cy)^2),200):endcall
b=1:r=0:g=.5
callmacro:psetline(xres-my,yres-mx,0,dist,dist,200):endcall
if mx <630 and mx>610 then
if my<230 and my>200 then
delta=50
count=count+1
if count>1 then flag=1
drawflag="circle"
b=30:r=30:b=30
xpos=rr(30,40)
callmacro:psetline(90,180,0,xpos,.9*yres,2000):endcall
circle(xpos-12,.9*yres-12),5,rgb(0,0,0),,,,f
circle(xpos+12,.9*yres-12),5,rgb(0,0,0),,,,f
circle(xpos,.9*yres-100),110,rgb(0,0,0),4,6
circle(xpos,.9*yres-40),60,rgb(0,0,0),4,6
drawstring (xpos,.9*yres,"WELL DONE, ESC ENDS IT ALL",rgb(0,255,0),30,5,2)
screenunlock
exit do
end if
else
flag=0
end if
screenunlock
loop until inkey=chr(27)
loop until inkey=chr(27)
Sub thickline(x1 As Double,_
y1 As Double,_
x2 As Double,_
y2 As Double,_
thickness As Double,_
colour As Uinteger)
Dim p As Uinteger
p=Rgb(255, 255, 255)
If thickness<2 Then
Line(x1,y1)-(x2,y2),colour
Else
Dim As Double s,h,c
h=Sqr((x2-x1)^2+(y2-y1)^2) 'hypotenuse
s=(y1-y2)/h 'sine
c=(x2-x1)/h 'cosine
Line (x1+s*thickness/2,y1+c*thickness/2)-(x2+s*thickness/2,y2+c*thickness/2),p
Line (x1-s*thickness/2,y1-c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),p
Line (x1+s*thickness/2,y1+c*thickness/2)-(x1-s*thickness/2,y1-c*thickness/2),p
Line (x2+s*thickness/2,y2+c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),p
'Paint((x1+x2)/2, (y1+y2)/2), p, p
Line (x1+s*thickness/2,y1+c*thickness/2)-(x2+s*thickness/2,y2+c*thickness/2),colour
Line (x1-s*thickness/2,y1-c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),colour
Line (x1+s*thickness/2,y1+c*thickness/2)-(x1-s*thickness/2,y1-c*thickness/2),colour
Line (x2+s*thickness/2,y2+c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),colour
'Paint((x1+x2)/2, (y1+y2)/2), colour, colour
End If
End Sub
Sub drawstring(x As Double,_
y As Double,_
s As String,_
c As Uinteger,_
angle As Double=0,_
word_space As Double=1,_
char_space As Double=1,_
line_space As Double=1,_
image As Any Pointer=0)
char_space=3*char_space:word_space=3*word_space
Dim l As Integer=Len(s)
Dim px As Double=16+x
Dim py As Double=y
Dim z As Integer=0
Dim pi As Double=4*Atn(1)
Dim sp As Double=6
#macro spaces(pixels)
px=px+(pixels+sp)*Cos(angle*pi/180)
py=py-(pixels+sp)*Sin(angle*pi/180)
#endmacro
For n As Integer=1 To l
Select Case Mid$(s,n,1)
Case " "
spaces(word_space)
Case "|"
z=z+1
px=x+16+z*16*Sin(angle*pi/180)*line_space
py=y+z*16*Cos(angle*pi/180)*line_space
Case Else
Draw String image,(px,py),Mid$(s,n,1),c
spaces(char_space)
End Select
Next n
End Sub
-
- Posts: 2655
- Joined: Aug 28, 2008 10:54
- Location: new york
I'll look into Sphere mapping, I know Dark Basic uses it.rolliebollocks wrote:@All
Hey guys. Does anyone have the inside infos on Sphere Mapping? This will be for a texturing routine.
@Dodicat
I'm digging the Paint String routine. You should clean it up and then send it to tips and trix.
Paintstring can be zapped by Bresenham also:
Does this work?
Code: Select all
'BRESENHAM ZAPS PAINTSTRING
Dim Shared As Integer xres,yres
xres=1000
yres=700
screenres xres,yres,32
declare Sub string_split(s_in As String,char As String,result() As String)
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)
dim shared as double next_x,next_y
dim as string s,s1,v,drawflag
redim ans (0) as string
dim as double r,g,b,delta,size
#define callmacro scope
#define endcall end scope
#macro psetline(xf,yf,zf,xs,ys,zs)
'scope
dim as single x1=xf
dim as single y1=yf
dim as single z1=zf
dim as single x2=xs
dim as single y2=ys
dim as single z2=zs
dim as single nx=x2-x1
dim as single ny=y2-y1
dim as single nz=z2-z1
dim as single length=sqr(nx^2+ny^2+nz^2)
nx=nx/length
ny=ny/length
nz=nz/length
dim as single lastx=0
dim as single lasty=0
for i as integer=0 to length
x1=x1+nx
y1=y1+ny
z1=z1+nz
dim col as uinteger=(255-delta)*(z1-zf)/(zs-zf)+delta
if drawflag="paintstring" then
paintstring(x1,y1,s1,size,rgb(col*r,col*g,col*b),col/30,col/30)
end if
if drawflag="thickline" then
' if i>2 then _thickline(x1,y1,lastx,lasty,thickness,rgb(col*r,col*g,col*b))
lastx=x1/6
lasty=y1
end if
if drawflag="pset" then pset(x1,y1),rgb(col*r,col*g,col*b)
if drawflag="circle" then circle(x1,y1),(40-10)*(z1-zf)/(zs-zf)+10,rgb(col*r,col*g,col*b),,,,f
next i
'end scope
#endmacro
#macro _pset(x1,y1,minx,maxx,miny,maxy)
dim as double xx1= Cdbl(xres)*(x1-minx)/(maxx-minx)
dim as double yy1=Cdbl(yres)*(y1-maxy)/(miny-maxy)
pset(xx1,yy1),rgba(200,100+z,100+z,100) 'can fiddle with colour
#endmacro
#macro background(xl,xu,yl,yu)
for x as double=xl to xu step (xu-xl)/xres
for y as double=yl to yu step(yu-yl)/yres
dim as double z=(10*(sin(x))*(cos(y)))^10 'can change function
callmacro: _pset(x,y,xl,xu,yl,yu):endcall
next y
next x
#endmacro
' **************************************************
s= command(0)
string_split(s,"",ans())
for z as integer=1 to ubound(ans)
ans(z)=ans(z)+"|"
s1=s1+ans(z)
next z
callmacro:background(-20,20,-20,20):endcall
v="FB.Version = "+__fb_version__
r=1:g=0:b=.9:size=1.2
drawflag="paintstring"
callmacro:psetline(10,10,0,50,100,10):endcall
size=1.4:s1=v
r=100:g=10:b=10
delta=500
callmacro:psetline(.9*xres,yres,0,.1*xres,.9*yres,100):endcall
sleep
' ***********************************************************
Sub string_split(s_in As String,char As String,result() As String)
Dim As String s=s_in,var1,var2
Dim As Long n,pst
#macro split(stri,char,var1,var2)
pst=Instr(stri,char)
var1="":var2=""
If pst<>0 Then
var1=Mid(stri,1,pst-1)
var2=Mid(stri,pst+1)
Else
var1=stri
Endif
Redim preserve result(1 To 1+n-((Len(var1)>0)+(Len(var2)>0)))
result(n+1)=var1
#endmacro
Do
split(s,char,var1,var2):n=n+1:s=var2
Loop Until var2=""
Redim preserve result(1 To Ubound(result)-1)
End Sub
'START OF PAINTSTRING ******************************************
Dim Shared np(1 To 4) As Double
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
-
- Posts: 2655
- Joined: Aug 28, 2008 10:54
- Location: new york
Code: Select all
'===================================================================
' Lissajous mayhem
'===================================================================
Dim As Integer m = 3
Dim As Integer n = 5
Dim As Integer p = 33
Dim As Integer q = 55
Dim As Double r = .07
'-------------------------------------------------------------------
Const As Double TwoPi = 8 * Atn(1)
Screen 19
Window (-1.01-r, -1.01-r)-( 1.01+r, 1.01+r)
Pset(0,1+r), 0
For t As Double = 0 To TwoPi Step 1/(10*(m*n))
Line -(Sin(m*t) + r * Sin(p*t), Cos(n*t) + r * Cos(q*t)), 13
Next t
Line -(0,1+r), 13
'===================================================================
Sleep
'===================================================================
@ Richard
These Lissajous, I take it that they are of the same ilk as those you can tweak on an oscilloscope, and I see they are related to our old friend, Chebyshev.
and
I'm surprised you didn't notice my subtle!! cross in one of the posts.
@Rollie
I had a paintstring demo posted a while back, but I've adjusted it a bit so here it is.
But it needs tweaked once more and cleaned up.
These Lissajous, I take it that they are of the same ilk as those you can tweak on an oscilloscope, and I see they are related to our old friend, Chebyshev.
and
I'm surprised you didn't notice my subtle!! cross in one of the posts.
@Rollie
I had a paintstring demo posted a while back, but I've adjusted it a bit so here it is.
But it needs tweaked once more and cleaned up.
Code: Select all
'START OF PAINTSTRING ******************************************
Dim Shared np(1 To 4) As Double
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
'************************* END OF PAINTSTRING ******************************
'THE FOLLOWING CODE IS FOR THE EXAMPLES
'EXAMPLE SUB -- WRITE TO AN IMAGE
sub make_draw_image
dim x as integer =900
dim y as integer =600
dim im as any pointer
screenres x,y,32
'exit sub
im=imagecreate(5*x,y)
paint (0,0),rgb(133,70,9)
paintstring(255,100,"Please wait",1,rgb(0,200,0))
paintstring(0,400,"LOADING : ",1,rgb(100,130,250))
'*** MAKE A SKY LIKE BACKGROUND
dim as integer r,b,g,r1,b1,g1,r2,b2,g2',x2
x=4500
r1=99
g1=127
b1=192
r2=170
g2=201
b2=241
for row as double=0 to y step .5
r=(r2-r1)*row/y+r1
b=(b2-b1)*row/y+b1
g=(g2-g1)*row/y+g1
line im,(0,row)-(x,row),rgb(r,g,b)
next row
'**********************************
'MAKE A SLOPE AND SOME TREES
dim as double valpv,valpg,valrr,g0
#macro pv(x)
valpv= 450-7.1e-2*x+2.5e-5*x^2
#endmacro
#macro pg(x)
valpg=-7.1e-2+2*2.5e-5*x
#endmacro
#macro rr(l,u)
valrr = Rnd * (u - l) + l
#endmacro
'THE SLOPE TO IMAGE
for n as double=0 to 4640 step .5
pv(n)
pg(n)
g0=-50*valpg
line im,(n,y)-(n,valpv),rgb(0,149-g0,0)
next n
'THE TREES TO IMAGE
for m as double=0 to 150 step 10
paintstring(next_x,next_y,"-",1,rgb(255,0,0))
randomize m
rr(3,9)
for n as double=125 to 4640 step valrr
randomize n^2
dim as double l,k,pivx,pivy,pivz,g0,shader
dim as uinteger treecol
rr(2,11)
l=valrr
rr(1,5)
k=valrr
pivx=n
pv(n)
pivy=valpv+k+m
pivz=0
pg(n)
g0=-50*valpg
rr(-2,2)
line im,(pivx,pivy)-(pivx+valrr,pivy+8),rgb(144-g0,35-g0,37)
rr(1,40)
dim cc as double=valrr
for a as double=90 to 450 step 7
randomize a
rr(2,4)
shader=-valrr
r=20+shader+cc
g=130-g0+shader:if g>40 then g=g-40
b=20+shader:if b>20 then b=b-20
treecol=rgb(r,g,b)
for a2 as double=0 to l step .3
if a>270 then shader=-shader
treecol=rgb(r,g-a2*shader,b)
rotate(pivx,pivy,pivx-a2,pivy,pivx-1,pivy,.0,.0,a,1,1,treecol,1,"line",im)
next a2
next a
next n
next m
'DRAW CHARACTERS TO IMAGE
dim sz as double=1.94 'character size
'to add some dimension to the characters
'where t = thickness,
for t as double=1.2 to .1 step -.1
dim cc as double=90*t
paintstring(0,200,"Will Scarlet, ",sz,rgb(200-cc,0,0),,,t,im)
'Use continue x and y to change colours for each name
paintstring(next_x,next_y,"Little John, ",sz,rgb(0,0,200-cc),,,t,im)
paintstring(next_x,next_y,"Friar Tuck, ",sz,rgb(200-cc,200-cc,200-cc),,,t,im)
paintstring(next_x,next_y,"Maid Marion, ",sz,rgb(250-cc,180-cc,200-cc),,,t,im)
paintstring(next_x,next_y,"Robin Hood ",sz,rgb(0,150-cc,0),,,t,im)
paintstring(next_x,next_y,"and ",sz,rgb(130-cc,130-cc,130-cc),,,t,im)
paintstring(next_x,next_y,"Gamble Gold.|",sz,rgb(200-cc,200-cc,130-cc),,,t,im)
next t
'RUN IMAGE
dim as integer z1,z2
for z1=0 to -3740 step -1
put (z1,z2),im,pset
next z1
paintstring(50,next_y+100,"press a key to move on",1,rgb(0,100,0))
sleep
imagedestroy(im)
end sub
'EXAMPLE SUB -- USAGE OF PAINTSTRING
sub usage
screenres 1000,600,32
paintstring(10,20,"Thank you for trying paintstring.",1,RGB(255,254,253))
dim as string s
s="A bit like Draw String, with parameters.|"
paintstring(10,90,s,.8,rgb(255,254,253))
s="There are 9 parameters as follows:|Parameter 1 - start x position|"
paintstring(next_x,next_y,s,.7,rgb(255,254,253))
s="Parameter 2 - start y position|Parameter 3 - The string to paint|Parameter 4 - Size|"
paintstring(next_x,next_y,s,.7,rgb(255,254,253))
s="Parameter 5 - Colour (RGB form)|Parameter 6 - Angle of text from horizontal|"
paintstring(next_x,next_y,s,.7,rgb(255,254,253))
s="Parameter 7 - Character angle from horizontal|"
paintstring(next_x,next_y,s,.7,rgb(255,254,253))
s="Parameter 8 - Tweak the thickness to suit|"
paintstring(next_x,next_y,s,.7,rgb(255,254,253))
s="Parameter 9 - Write to an image|"
paintstring(next_x,next_y,s,.7,rgb(255,254,253))
s="Press a key to continue|"
paintstring(next_x,next_y+10,s,.7,rgb(155,0,0))
sleep
cls
'________________________________SIZES
s="This starts at position 0,0|Size = 1|"
paintstring(0,0,s,1,rgb(0,155,0))
s="The characters available are from a British|keyboard|"
paintstring(next_x,next_y,s,.7,rgb(0,155,0))
s="All the characters are available except the pipe|"
paintstring(next_x,next_y,s,.7,rgb(155,0,0))
s="The pipe is used for a new line.|"
paintstring(next_x,next_y,s,.7,rgb(155,0,0))
s="ANGLES:|"
paintstring(next_x,next_y,s,.7,rgb(155,0,0))
s="Line angle=-15, character angle=-15, size=.7"
paintstring(next_x,next_y,s,.7,rgb(155,0,0),-15,-15)
s="Press a key to continue|"
paintstring(0,next_y,s,.7,rgb(155,100,100))
sleep
cls
'___________________________________THIRTY DEGREES
s="LINE MINUS THIRTY DEGREES | CHARACTER ZERO DEGREES| SIZE ONE|"
paintstring(0,0,s,1,rgb(155,200,0),-30,0)
s="Press a key to continue|"
paintstring(0,550,s,1,rgb(0,0,155))
sleep
cls
'__________________________________NUMBERS
s="Size = .5 (about the smallest for paintstring)|"
paintstring(10,10,s,.5,rgb(155,0,200))
s="Size = .75|"
paintstring(next_x,next_y,s,.75,rgb(155,0,200))
s="Size = 1.5|"
paintstring(next_x,next_y,s,1.5,rgb(155,0,200))
s="Size = 2|"
paintstring(next_x,next_y,s,2,rgb(155,0,200))
s="Size = 3|"
paintstring(next_x,next_y,s,3,rgb(155,0,200))
s="Size = 3.1|"
paintstring(next_x,next_y,s,3.1,rgb(155,0,200))
s="Press a key to continue|"
paintstring(10,580,s,.5,rgb(155,200,255))
sleep
cls
s="Some numbers:|"
paintstring(10,10,s,.6,rgb(155,0,0))
s=""
for x as double=-1 to 9
s=s+"SQR("+str$(x)+") = "+str$(sqr(x))+"|"
paintstring(10,50,s,.7,rgb(254,254,254))
next x
s="Press a key to continue|"
paintstring(10,580,s,.5,rgb(155,200,255))
sleep
cls
'_____________________________________IMAGE
s="Now put characters to an image.|The characters load quickly|but I have some background|"
paintstring(10,50,s,.7,rgb(254,254,254))
s="So please be patient while everything loads.|"
paintstring(next_x,next_y,s,.7,rgb(254,254,254))
s="Press a key to continue|"
paintstring(10,580,s,.5,rgb(155,200,255))
sleep
cls
make_draw_image
cls
'___________________________________________TIPS
s="The character sizes are independent of|screen resolutions. Size 1 is always|32*32 pixels.|"
paintstring(10,10,s,.7,rgb(253,185,11),,,1)
s="The shared doubles next_x and next_y|will position the next paintstring call|logically.|"
paintstring(next_x,next_y,s,.7,rgb(253,18,111),,,1)
s="The rotate sub with the shared array|np(1 to 4) can stand alone.|"
paintstring(next_x,next_y,s,.7,rgb(253,185,211),,,1)
s="Don't use pure brilliant white.|It is used as a primer in the painting|macro.|"
paintstring(next_x,next_y,s,.7,rgb(253,185,11),,,1)
s="Reduce it a digit or two|"
paintstring(next_x,next_y,s,.7,rgb(253,185,11),,,1)
s="e.g. RGB(255,255,254)|"
paintstring(next_x,next_y,s,.7,rgb(255,255,254),,,1)
s="NOW INCORPORATE A BIT OF MOTION :-"
paintstring(next_x,next_y,s,.7,rgb(253,0,211),,,1)
s="Press a key to continue|"
paintstring(10,580,s,.5,rgb(155,200,255))
sleep
'______________________________EARTH,AIR,FIRE,WATER
dim as uinteger col,count
for n as double =.6 to 2.2 step .005
count=count+1
if count mod 2=0 then
col=rgb(255,0,0)
else
col=rgb(255,255-100*n,0)
end if
screenlock
cls
paintstring(100*n-50,100*n+50,"Fire Burns|",n,col,10*n,10*n)
paintstring(next_x,next_y,"Earth Turns|",.8*n,rgb(154,90,8),10*n,10*n)
paintstring(next_x-80*(n-.6),next_y+30*(n-.6),"Water Flows|",.7*n,rgb(130,160,250),10*n,-10*n/10)
paintstring(next_x+80*(n-.6),next_y-30*(n-.6),"Wind Blows|",.6*n,rgba(200,200,200,50),10*n,300*n/10)
screenunlock
sleep 1,1
next n
s="Press a key to continue|"
paintstring(400,580,s,.5,rgb(155,200,255))
sleep
cls
'_______________________________________SHIFT
dim as double sx=32,sy=0,stx=100,sty=50,svx,hvx,ivx,fvx,tvx,svy,hvy,ivy,fvy,tvy
for a as double=0 to 360 step .5
svx=3.333333333333334*a-9.259259259259261e-003*a*a'ok
svy=-0.1114551083591331*a+3.095975232198143e-004*a*a'ok
hvx=-1.168831168831169*a+3.246753246753247e-003*a*a'ok
hvy=-1.111111111111111*a+3.08641975308642e-003*a*a'oh
ivx=4.800000000000001*a-1.333333333333334e-002*a*a'ok
ivy=2.408026755852843*a-6.688963210702342e-003*a*a'ok
fvx=0.2*a -5.555555555555557e-004*a*a'ok
fvy=-0.5555555555555556*a+1.54320987654321e-003*a*a'ok
tvx= -3.636363636363638*a+1.010101010101011e-002*a*a'redo
tvy= (-5.14285714285715*a+1.42857142857143e-002*a*a)/10'ok
screenlock
cls
paintstring(stx+a+svx,sty+sy+a+svy,"S",1,rgb(255,254,255),0,2*a)
paintstring(stx+sx+a+hvx,sty+sy+a+hvy,"H",1,rgb(255,254,255),0,8*a)
paintstring(stx+2*sx+a+ivx,sty+sy+a+ivy,"I",1,rgb(255,254,255),0,30*a)
paintstring(stx+3*sx+a+fvx,sty+sy+a+fvy,"F",1,rgb(255,254,255),0,-6*a)
paintstring(stx+4*sx+a+tvx,sty+sy+a+tvy,"T",1,rgb(255,254,255),0,-20*a)
screenunlock
sleep 1,1
if a=0 then
paintstring(300,50,"Translaion?",.7,rgb(200,200,100))
sleep 1000
end if
next a
s="Press a key to continue|"
paintstring(400,580,s,.5,rgb(155,200,255))
sleep
cls
'__________________________________CHRISTMAS
paint(0,0),rgb(0,207,255)
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(20+50*n,50+50*n,"MERRY CHRISTMAS|",1.5,col,,n)
paintstring(50+50*n,150+50*n,"(When it comes round)",.9,col,,n)
next n
s="Press a key to continue|"
paintstring(400,580,s,.5,rgb(155,200,255))
sleep
'______________________________________DIMENSION
s="Add some|DIMENSION|to the letters"
dim num as integer
num=190
paint (0,0),rgb(240,240,240)
for n as double=1.3 to 0 step -.1
paintstring(20,20,s,2,rgb(255-num*n,254-num*n,253-num*n),,,n)
next n
s="Press a key to continue|"
paintstring(10,580,s,.5,rgb(0,0,0))
sleep
cls
'______________________________________APPENDIX
s="APPENDIX:|"
paintstring(0,0,s,.6,rgb(255,255,254))
s="To add a character: use a 32*32 grid with centre|px=0,py=0|"
paintstring(next_x,next_y,s,.6,rgb(255,255,254))
s="use the set macro with another selected case|"
paintstring(next_x,next_y,s,.6,rgb(255,255,254))
s="Put left edge of character to left of grid|"
paintstring(next_x,next_y,s,.6,rgb(255,255,254))
s="Plot the line-ends and circle-centres + radius|"
paintstring(next_x,next_y,s,.6,rgb(255,255,254))
s="Go to case D, uncomment the rotate call|"
paintstring(next_x,next_y,s,.6,rgb(255,255,254))
s="Adjust spaces(*,*) to butt against the line|"
paintstring(next_x,next_y,s,.6,rgb(255,255,254))
s="Thank you for running this code!|"
paintstring(next_x,next_y+50,s,.75,rgb(255,255,154))
s="Well I didn't include a get out option|Ha Ha|"
paintstring(next_x,next_y,s,.75,rgb(255,255,154))
s="Hope you found it entertaining|"
paintstring(next_x,next_y,s,.75,rgb(255,255,154))
s="AND UTTERLY USELESS|"
paintstring(next_x,next_y,s,.75,rgb(155,255,254))
s="Press a key to move on|"
paintstring(next_x,next_y,s,.5,rgb(255,254,253))
sleep
cls
'________________________________________GOODBYE
paint(0,0),rgb(153,80,245)
s="GOODBYE"
for n as double=1.3 to 0 step -.1
paintstring(20,100,s,2,rgb(0,254-num*n,253-num*n),,-5,n)
next n
s="Good luck!|"
for n as double=1.3 to 0 step -.1
paintstring(20,300,s,2,rgb(255-num*n,254-num*n,0),,5,n)
next n
s="Press a key to end|"
paintstring(10,580,s,.5,rgb(0,0,0))
sleep
cls
end sub
usage