Squares

General FreeBASIC programming questions.
BasicScience
Posts: 469
Joined: Apr 18, 2008 4:09
Location: Los Angeles, CA
Contact:

Postby BasicScience » Aug 14, 2010 21:11

@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.
dodicat
Posts: 5693
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Aug 14, 2010 22:22

@ 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.

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
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » Aug 15, 2010 14:58

@All

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
Pritchard
Posts: 5492
Joined: Sep 12, 2005 20:06
Location: Ohio, USA

Postby Pritchard » Aug 15, 2010 20:15

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.
dodicat
Posts: 5693
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Aug 15, 2010 23:02

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!

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
Pritchard
Posts: 5492
Joined: Sep 12, 2005 20:06
Location: Ohio, USA

Postby Pritchard » Aug 16, 2010 12:42

I know, it's crazy. It makes you wonder how programs are ever slow.
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » Aug 16, 2010 14:46

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).
dodicat
Posts: 5693
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Aug 16, 2010 15:26

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!

Thanks Rollie~, looks neat, I haven't tried to make these curves yet.
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.
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » Aug 16, 2010 15:42

With my thing? I get 60 FPS, but that's because of the texture generator. It generates 50k pixels. The circular pixel scanner is as optimized as it's going to get for now.

Maybe I'll make a magnifier for it.

With your thing I'm getting .707 seconds or so.
dodicat
Posts: 5693
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Aug 17, 2010 0:25

rolliebollocks wrote:With my thing? I get 60 FPS

Hi ROLLIE, I get 11 FPS with your thing.

@ Pritchard
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
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » Aug 17, 2010 11:26

@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.
dodicat
Posts: 5693
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Aug 17, 2010 14:00

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.

I'll look into Sphere mapping, I know Dark Basic uses it.

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

rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » Aug 17, 2010 14:21

Like a charm!
Richard
Posts: 2906
Joined: Jan 15, 2007 20:44
Location: Australia

Postby Richard » Aug 17, 2010 20:09

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
'===================================================================
dodicat
Posts: 5693
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Aug 17, 2010 22:33

@ 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.

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

Return to “General”

Who is online

Users browsing this forum: albert and 1 guest