Struggling with classes / types

[badidea]

Hello all,
Let say I want to make a game where objects are displayed as line drawings. And the world view can be rotated and scaled. I make:
* a graphics class containing the scaling and rotation, and knows how to draw a line with this.
* a line segments class containing a list of points which define the line segments
* a player class that contains its position and uses the segments class for its shape definition (a stick figure)
pseudo-code:

Code: Select all

'     _
'    / \
'    \ /
'     |
' ----+----
'     |
'     |
'    / \
'   /   \
'  /     \

type graphics_type
	dim as integer screenWidth, screenHeight
	dim as single viewScale, viewRotation 'etc.
	'
	'draw at line using the above scale and rotation
	declare sub drawLine(x1,x2, y1, y2, colour)
end 

type line_segments_type
	'a list of line segments with color
	'allocates & frees memory, loads from disk, etc.
	'
	'draw all line segments using drawLine form graphics_type 
	declare sub drawMe()
end type

type player_type
	dim as integer x, y 'etc.
	dim as line_segments_type ptr pLineSeg 'pointer to a list of lines
	declare sub drawMe() 'calls the drawMe() form line_segments_type
end type


dim as graphics_type graphics
dim as player_type player
 
'main loop
while 1
	'do stuff, change world rotation, whatever...
	player.drawMe()
	sleep 1, 1
wend

Now my question is, what is the best way to link the classes together to get this working?
Should I give the line_segments_type a pointer property that points to the graphics_type instance?

[dafhi]

I recommend using floats :-)

ignore the complexity of the types here. scroll down and see how little code it takes to get something running. aim for that

Code: Select all

'update 3

type myint as integer
type float as single

#Ifndef floor   '' http://www.freebasic.net/forum/viewtopic.php?p=118633
#Define floor(x) (((x)*2.0-0.5)shr 1)
#define ceil(x) (-((-(x)*2.0-0.5)shr 1))
  #EndIf

Type sng2D
    As Single                     x,y
End Type

#Macro Alpha256(ret,back, fore, a256) '2017 Mar 26
  ret=((_
  (fore And &Hff00ff) * a256 + _
  (back And &Hff00ff) * (256-a256) + &H800080) And &Hff00ff00 Or (_
  (fore And &H00ff00) * a256 + _
  (back And &H00ff00) * (256-a256) + &H008000) And &H00ff0000) Shr 8
#EndMacro

type imagevars
   
    /' -- a class created for
      .seamless screen & image interaction
      .encapsulate standard metrics
      .convenient additional vars, subs and functions
      .quick reference for ScreenInfo & ImageInfo
     
    -- 2018 Aug 15, by dafhi - '/
   
    as myint              w,h,bpp,bypp,pitch
    as myint              rate, num_pages, flags
    as any ptr            im, pixels
    as string             driver_name
   
    declare constructor   (as any ptr=0)
    declare destructor
   
    declare sub           get_info(as any ptr=0)
    declare sub           blit(byref as imagevars ptr, as float, as float, _
                                as float = 0, as float = 0, as boolean = false)
    declare sub           Plot(As long,As long,As Ulong,As float)
    declare sub           wuLine(As float,As float,As float,As float,As Ulong = -1)
    as single             wh, hh, diagonal, scale 'helpers
    as myint              wm, hm, pitchBy, ub     '
    as ulong ptr          p32                     '
   
   private:
    declare sub           release
    as ulong ptr          ps, pd
    as float              x0, x1, xsteps, xs, x0s '' blit
    as myint              ix0, ix1, istepx, ialpha
    as myint              iy0, iy1, istepy
    as float              y0, y1, ysteps, y0s
end type
Destructor.imagevars:  release
End Destructor

Sub imagevars.release
  If ImageInfo(im) = 0 Then ImageDestroy im
  im = 0
End Sub

constructor.imagevars(im as any ptr) ' 2018 Aug 22
  if im=0 then exit constructor
  if ImageInfo(im) = 0 then get_info im
end constructor

sub imagevars.get_info(im as any ptr)
    release
    if im=0 then:  pixels=screenptr
      ScreenInfo w,h, bpp,, pitch, rate, driver_name:  bypp=bpp\8 '2018 Jan 9
    elseif Imageinfo(im)=0 then
      ImageInfo im, w, h, bypp, pitch, pixels
      bpp = bypp * 8:  this.im = im
    endif:  pitchBy=pitch\bypp:  p32=pixels:  ub = w*h-1
    wm=w-1: wh=w/2
    hm=h-1: hh=h/2:  diagonal = sqr(wm*wm+hm*hm)
    scale = diagonal / sqr(.5) / 2
end sub

sub imagevars.blit(byref des as imagevars ptr, _x as float, _y as float, _w as float, _h as float, transparent as boolean)
    if _w=0 orelse _h=0 then exit sub
   
    ' Vars all float unless 'i' prefix
    ' image source denoted with suffix 's'
   
    #macro clip(f0, f1, i0, i1, _f, _wh, des_wh, steps, whs, istep, src0)
      istep = 1 + 2*(_wh<0)
      steps = whs / _wh
      f1 = _f + _wh
      if istep > 0 then
        f0 = _f + _f * (_f<0)               'if f0 < 0 then f0 = 0
        f1 += (f1-(des_wh)) * (f1>(des_wh)) 'if f1 > whm then f1 = whm
      else
        f0 = _f + (_f-(des_wh)) * (_f>(des_wh))
        f1 += f1 * (f1<0)
      endif
      i0 = floor( f0 + istep/2 )
      i1 = floor( f1 - istep/2 )
      src0 = (i0 +.5- _f) * steps
      steps *= istep                        'abs()
    #endmacro
   
    clip(x0, x1, ix0, ix1, _x, _w, des->w, xsteps, this.w, istepx, x0s)
    clip(y0, y1, iy0, iy1, _y, _h, des->h, ysteps, this.h, istepy, y0s)
    pd = des->p32 + iy0 * des->pitchBy      'pitch \ bypp
    x0s -= .5
    if transparent then
      for iy as myint = iy0 to iy1 step istepy
        ps = p32 + floor(y0s) * this.pitchBy
        pd = des->p32 + iy * des->pitchBy
        xs = x0s
        for ix as myint = ix0 to ix1 step istepx
          ialpha = 1 + ps[xs]shr 24
          alpha256(pd[ix], pd[ix], ps[xs], ialpha)
          xs += xsteps
        next:  y0s += ysteps
      next
    else
      for iy as myint = iy0 to iy1 step istepy
        ps = p32 + floor(y0s) * this.pitchBy
        pd = des->p32 + iy * des->pitchBy
        xs = x0s
        for ix as myint = ix0 to ix1 step istepx
          pd[ix] = ps[xs]
          xs += xsteps
        next:  y0s += ysteps
      next
    endif
End Sub

/'  -- https://www.freebasic.net/forum/viewtopic.php?f=7&t=24443
Xiaolin Wu's line algorithm

An algorithm for line antialiasing,
which was presented in the article
An Efficient Antialiasing Technique
in the July 1991 issue of Computer
Graphics, as well as in the article
Fast Antialiasing in the June 1992
issue of Dr. Dobb's Journal.
'/
#define _ipart(x) floor(x) ' integer part
#define _round(x) floor(x + .5)
#define _fpart(x) Frac(x)    ' fractional part
#Macro  _rfpart(x)
' 1 - Frac(x)    ' seems to give problems for very small x
IIf(1 - Frac(x) >= 1, 1, 1 - Frac(x))
#EndMacro

Sub imagevars.Plot(x As long, y As long,baseclr As Ulong, c As float)
    if x < 0 orelse x>=w orelse y<0 orelse y>=h then exit sub '2018 Aug 25
    x += y * pitchBy
    c *= ((baseclr shr 24)/255)
    y = c * 257 - .5 '' 0..256
    Alpha256(p32[x], p32[x], baseclr, y)
End Sub

sub imagevars.wuLine(x0 As float,y0 As float,x1 As float,y1 As float, clr As Ulong = -1)
    Dim As Integer steep = Abs(y1 - y0) > abs(x1 - x0)
    Dim As float dx,dy,gradient,xend,yend,xgap,xpxl1,ypxl1,xpxl2,ypxl2,intery
   
    if steep then
        Swap x0, y0
        Swap x1, y1
    end If
   
    if x0 > x1 then
        Swap x0, x1
        Swap y0, y1
    end if
   
    dx = x1 - x0
    dy = y1 - y0
    gradient = dy / dx
   
    ' handle first endpoint
    xend = _round(x0)
    yend = y0 + gradient * (xend - x0)
    xgap = _rfpart(x0 + 0.5)
   
    xpxl1 = xend ' this will be used in the main loop
    ypxl1 = _ipart(yend)
   
    if steep then
        plot(ypxl1,   xpxl1, clr, _rfpart(yend) * xgap)
        plot(ypxl1+1, xpxl1, clr,  _fpart(yend) * xgap)
    else
        plot(xpxl1, ypxl1  , clr, _rfpart(yend) * xgap)
        plot(xpxl1, ypxl1+1, clr,  _fpart(yend) * xgap)
    end if
    intery = yend + gradient ' first y-intersection for the main loop
   
    ' handle second endpoint
    xend = _round(x1)
    yend = y1 + gradient * (xend - x1)
    xgap = _fpart(x1 + 0.5)
   
    xpxl2 = xend 'this will be used in the main loop
    ypxl2 = _ipart(yend)
   
    if steep then
        plot(ypxl2  , xpxl2, clr, _rfpart(yend) * xgap)
        plot(ypxl2+1, xpxl2, clr,  _fpart(yend) * xgap)
    else
        plot(xpxl2, ypxl2, clr,  _rfpart(yend) * xgap)
        plot(xpxl2, ypxl2+1, clr, _fpart(yend) * xgap)
    end if
   
    ' Line loop
    for x As Integer = xpxl1 + 1 to xpxl2 - 1
      if steep then
          plot(_ipart(intery)  , x, clr, _rfpart(intery))
          plot(_ipart(intery)+1, x, clr,  _fpart(intery))
      else
          plot(x, _ipart(intery), clr,  _rfpart(intery))
          plot(x, _ipart(intery)+1, clr, _fpart(intery))
      end if
      intery = intery + gradient
    Next
   
End sub


dim as imagevars buf, im

screenres 800,600, 32
buf.get_info

im.get_info imagecreate(buf.w/2, buf.h/2, rgb(0,0,0))

im.wuline 50,50, 60, 55, rgb(0,255,0)
im.blit @buf, 0,0,buf.w,buf.h

sleep

[badidea]

In your case the drawing code is part of the imagevars class. That solves the problem, but I am not sure that I like the solution. I'll try some other stuff...

Edit: Quite happy with this (using a pointer to the drawing class):

Code: Select all

'============================= defaults.bas (begin) ============================

const as string KEY_UP = chr(255) & "H"
const as string KEY_DN = chr(255) & "P"
const as string KEY_LE = chr(255) & "K"
const as string KEY_RI = chr(255) & "M"
const as string KEY_ESC = chr(27)

const as double PI = 3.141592654

type xy_sgl
	dim as single x,y
end type

type xy_int
	dim as integer x,y
end type

'============================== defaults.bas (end) =============================

'============================= graphics.bas (begin) ============================

type world_render_type 'world render class
	private:
		dim as xy_int screenSize
		dim as single viewScale
		'dim as xy_sgl viewCenter
		dim as single viewAngle 'view rotation
		dim as single viewCos, viewSin
		declare constructor()
	public:
		declare constructor(scrnW as integer, scrnH as integer, scale as single, angle as single)
	private:
		declare function screenPos(drawPos as xy_sgl) as xy_int  
	public:
		declare sub updateAngle(angle as single)
		declare sub activateScreen()
		declare sub clearScreen()
		declare sub drawLine(p1 as xy_sgl, p2 as xy_sgl, c as ulong)
		declare sub drawCircle(p as xy_sgl, r as single, c as ulong)
end type

'set screen resolution and init world scaling and rotation - default values
constructor world_render_type()
	screenSize = type(800, 600)
	viewScale = 10.0
	updateAngle(0.0)
end constructor

constructor world_render_type(scrnW as integer, scrnH as integer, scale as single, angle as single)
	screenSize = type(scrnW, scrnH)
	viewScale = scale
	updateAngle(angle)
end constructor

'A private helper function to do the drawing scaling and rotation
function world_render_type.screenPos(drawPos as xy_sgl) as xy_int
	dim as single x = viewCos * drawPos.x - viewSin * drawPos.y
	dim as single y = viewSin * drawPos.x + viewCos * drawPos.y
	dim as integer xi = (screenSize.x \ 2) + int(x * viewScale + 0.5)
	dim as integer yi = (screenSize.y \ 2) - int(y * viewScale + 0.5)
	return type(xi, yi)
end function

'Whole world rotation 
sub world_render_type.updateAngle(angle as single)
	viewAngle = angle
	viewSin = sin(viewAngle)
	viewCos = cos(viewAngle)
	'print viewAngle, viewSin, viewCos 
end sub

sub world_render_type.activateScreen()
	if screenSize.x <= 0 or screenSize.y <= 0 then
		print "world_render_type() activateScreen bad screen size" 
	else
		screenres(screenSize.x, screenSize.y, 32) 
	end if
end sub

sub world_render_type.clearScreen()
	line(0, 0) - (screenSize.x-1, screenSize.y-1), &h00000000, bf
end sub

'Draw a line using world scaling and rotation
sub world_render_type.drawLine(p1 as xy_sgl, p2 as xy_sgl, c as ulong)
	dim as xy_int scrnPos1 = screenPos(p1)
	dim as xy_int scrnPos2 = screenPos(p2)
	line(scrnPos1.x, scrnPos1.y)-(scrnPos2.x, scrnPos2.y), c
end sub

'Draw a circle using world scaling and rotation
sub world_render_type.drawCircle(p as xy_sgl, r as single, c as ulong)
	dim as xy_int scrnPos = screenPos(p)
	circle(scrnPos.x, scrnPos.y), r * viewScale, c
end sub

'============================== graphics.bas (end) =============================

'============================ polyobject.bas (begin) ===========================

'Poly line class:
' N points will result in N-1 line segments
' The next line segment start where the previous ended
' Only 1 color for the whole poly-line

type poly_line_type
	private:
		dim as world_render_type ptr pWorldRender 'world render class in graphics.bas
		dim as integer maxPoints, numPoints
		dim as xy_sgl ptr pPoints
		dim as ulong colour
	public:
		declare constructor(numPoints as integer, c as ulong, pWr as world_render_type ptr)
		declare destructor()
		declare function addPoint(p as xy_sgl) as integer
		declare sub plot()
end type

constructor poly_line_type(points as integer, c as ulong, pWr as world_render_type ptr)
	colour = c
	maxPoints = points
	pPoints = callocate(maxPoints, sizeof(xy_sgl))
	if pPoints = 0 then
		print "poly_line_type() constructor malloc error" 
	end if
	if pWr = 0 then
		print "poly_line_type() constructor world_render_type -> zero" 
	else
		pWorldRender = pWr
	end if
end constructor

destructor poly_line_type()
	if (pPoints <> 0) then
		deallocate pPoints
	else
		print "poly_line_type() destructor free error" 
	end if
end destructor

function poly_line_type.addPoint(p as xy_sgl) as integer
	if numPoints >= maxPoints then
		print maxPoints, numPoints
		print "poly_line_type() addPoint failure" 
		return -1
	else
		pPoints[numPoints] = p
		numPoints += 1
	end if
end function

sub poly_line_type.plot()
	for i as integer = 0 to numPoints-2
		pWorldRender->drawLine(pPoints[i], pPoints[i+1], colour)
	next
end sub

'============================= polyobject.bas (end) ============================

var viewAngle = 0.0f 'starting to like statement "var" :-)
var worldRender = world_render_type(800, 600, 50.0, viewAngle) 'screen res, view scaling, rotation 
worldRender.activateScreen()

var polyLine = poly_line_type(4, &h00ff00ff, @worldRender) 'tell polyline the render class
polyLine.addPoint(type(0, -1)) 'starting point
polyLine.addPoint(type(1, 2))
polyLine.addPoint(type(-1, 2))
polyLine.addPoint(type(0, -1)) 'close the figure

while inkey <> chr(27) '<escape> to exit
	polyLine.plot()
	viewAngle += 0.1
	worldRender.updateAngle(viewAngle)
	sleep 100, 1
wend
sleep

No stick figure, but the start of a spaceship. Don't tell the others :-)

[MrSwiss]

1) In your case the drawing code is part of the imagevars class.
2) That solves the problem, but I am not sure that I like the solution.

1) dhafi repeats that (whenever posting code), until we others die of boredom ...
I fully agree with 2), neither do I.

[dafhi]

this i have found useful

Code: Select all

type my_shape
    ..
    declare sub         render_target(byref as imager)
    as imager ptr    pim
End Type
sub my_shape.render_target(byref im as imager)
    pim = @imv
End Sub

[dodicat]

Instead of struggling with glasses, I would keep things simple.

Code: Select all

screen 19,32

Dim as string figure = _
"M+-1,-103M+-24,-16M+-2,-23M+12,-25M+22,0M+8,21M+1,24M+-20,16"_
&"BM+2,103"_
&"M+0,18M+-42,70"_
&"BM+45,-67M+33,59"_
&"BM+-105,-158M+129,-3"_
&"BM+-71,-42M+8,2M+7,-5"_
&"BM+-18,-16M+6,0"_
&"BM+11,0"_
&"M+9,-1"

type shape
    as string  b
    declare sub set(as string="",as long=0,as long=0,as long=0,as long=0,as ulong=0)
    declare sub draw
end type

sub shape.set(b as string,xpos as long,ypos as long,angle as long,scale as long,colour as ulong)
    dim as string s1="C"+ str(colour)
    dim as string s2="BM"+str(xpos)+","+str(ypos)
    dim as string s3="Ta" +str(angle)
    dim as string s4="S"+str(scale*4)
   this.b=s1+s2+s3+s4+b
end sub

sub shape.draw
..draw b
end sub

dim as shape s
dim as single a
do
 screenlock
    a+=.2
    cls
s.set(figure,400,300,a,1,rgb(0,100,255))
s.draw
screenunlock
sleep 1,1
loop until len(inkey)
sleep

  

[badidea]

Instead of struggling with glasses, I would keep things simple.

The glasses problem, I solved, switched to contact lenses.

[dodicat]

Here's an alien.

Code: Select all

 
Type Point
    As Long x,y
    Declare Function rotate(As Point,As Single,As Single) As Point
End Type

Function point.rotate(pivot As Point,angle As Single,scale As Single) As Point
    Var a=angle,d=scale
    Return  Type<Point>(d*(Cos(a*.0174533)*(this.x-pivot.x)-Sin(a*.0174533)*(this.y-pivot.y)) +pivot.x,_
                        d*(Sin(a*.0174533)*(this.x-pivot.x)+Cos(a*.0174533)*(this.y-pivot.y)) +pivot.y)
End Function

Type Line
    As Point s,e
    Declare Sub Draw(As Ulong)
End Type

Type shape
    As Line w(Any)
    As Ulong colour
    as point centroid
    Declare Sub getdata(As Ulong)
    Declare Sub translate(As Point)
    Declare Sub rotate(As Point,As Single,as single=1)
    Declare Sub Draw(as boolean=false)
    declare sub DynamicDraw(As Point,As Single,as single=1,as boolean=false)
End Type


Sub line.draw(colour As Ulong)
    Line(s.x,s.y)-(e.x,e.y),colour
End Sub

Sub shape.draw(f as boolean)
    For n As Long=1 To Ubound(w)
        w(n).draw(colour)
    Next n
    if f=true then paint (centroid.x,centroid.y),colour,colour
End Sub

Sub shape.getdata(col As Ulong)
    dim as long num
    read num
    colour=col
    dim as point acc
    dim as long n
    Dim As Point p(1 To num)
    For n As Long=Lbound(p) To Ubound(p)
        Read p(n).x
    Next n
    For n =Lbound(p) To Ubound(p)
        Read p(n).y
    Next n
    Dim As Long counter
    For n =1 To Ubound(p) -1 Step 1
        counter+=1
        acc.x+=p(n).x
        acc.y+=p(n).y
        Redim Preserve w(1 To counter)
        w(counter)=Type<Line>(p(n),p(n+1))
    Next
    acc.x+=p(n).x
    acc.y+=p(n).y
    centroid=type(acc.x/num,acc.y/num)
End Sub

Sub shape.translate(p As Point)
    For n As Long=1 To Ubound(w)
        w(n).s.x+=p.x
        w(n).s.y+=p.y
        w(n).e.x+=p.x
        w(n).e.y+=p.y
    Next n
    centroid.x+=p.x
    centroid.y+=p.y
End Sub

Sub shape.DynamicDraw(fulcrum As Point,angle As Single,scaler as single,f as boolean)
    dim as shape temp = this
    For n As Long=1 To Ubound(w)
        temp.w(n).s=w(n).s.rotate(fulcrum,angle,scaler)
        temp.w(n).e=w(n).e.rotate(fulcrum,angle,scaler)
    Next n
    temp.draw(f)
End Sub

Sub shape.Rotate(fulcrum As Point,angle As Single,scaler as single)
    For n As Long=1 To Ubound(w)
        w(n).s=w(n).s.rotate(fulcrum,angle,scaler)
        w(n).e=w(n).e.rotate(fulcrum,angle,scaler)
    Next n
        centroid=centroid.rotate(fulcrum,angle,scaler)
End Sub
Screen 19,32

Dim As shape s
s.getdata(Rgb(0,100,255))
s.translate(Type(-150,-150))
s.rotate(s.centroid,0,.7)
s.draw()
dim as point fulcrum=s.centroid
print "press a key"
sleep
dim as single angle,scale=1,k=1
do
    angle+=.2
   scale+=.001*k
   if scale>1.2 then k=-k
    if scale<.4 then k=-k
    screenlock
    cls
     s.DynamicDraw(fulcrum,angle,scale,true)
    screenunlock
sleep 1,1
loop until inkey=chr(27)
Sleep
'===============  DATA HERE ================
'Number of points
DATA _
 1120

'X_values:

DATA _
459,458,457,456,455,454,453,451,450,448,446,444,443,441,439,437, _
435,433,432,430,428,426,425,423,422,420,419,418,417,416,415,415, _
414,414,414,414,414,415,415,416,417,418,419,420,421,423,424,426, _
428,429,431,433,435,437,439,441,443,445,447,450,452,454,456,458, _
460,462,464,466,468,470,471,473,475,477,479,481,483,485,487,489, _
491,493,496,498,500,502,504,507,509,511,513,515,517,519,521,523, _
525,527,529,531,532,534,535,537,538,539,540,542,543,544,545,546, _
547,549,550,551,552,553,553,554,555,556,557,557,558,559,559,560, _
560,560,561,561,561,561,561,561,561,561,561,560,560,559,559,558, _
557,556,554,553,551,550,548,546,544,542,540,538,536,534,532,530, _
528,526,524,523,521,519,518,516,515,514,513,512,512,511,511,511, _
511,511,512,512,513,514,514,515,516,518,519,520,522,523,525,526, _
528,530,532,533,535,537,539,541,543,545,547,549,551,553,555,556, _
558,560,561,563,565,567,569,571,573,576,578,580,583,585,588,591, _
593,596,598,601,603,606,608,610,613,615,617,619,621,623,625,626, _
628,629,631,632,633,633,634,634,635,635,636,636,636,636,636,636, _
636,635,635,635,634,634,633,632,632,631,630,629,628,627,626,625, _
624,623,621,620,619,617,616,615,614,613,611,609,607,605,603,601, _
599,596,594,591,589,586,584,581,578,576,573,570,568,565,562,560, _
557,555,553,550,548,546,544,542,540,538,537,536,535,533,532,531, _
530,529,528,527,526,525,524,523,522,522,521,520,520,519,519,519, _
518,518,517,517,517,517,517,516,516,516,516,516,516,516,516,516, _
516,516,517,517,517,518,518,519,519,520,521,521,522,523,523,524, _
525,526,527,527,528,529,530,531,531,532,533,534,534,535,536,536, _
537,537,537,538,538,539,539,540,540,541,541,541,542,542,543,543, _
543,544,544,544,545,545,545,546,546,546,547,547,547,548,548,548, _
549,549,549,550,550,550,551,551,551,551,551,552,552,552,552,552, _
552,552,552,552,553,553,553,553,553,553,554,554,554,555,555,556, _
556,557,558,559,559,560,561,562,563,565,566,568,569,571,573,575, _
577,580,582,584,586,589,591,594,596,598,601,603,605,608,610,612, _
614,616,618,620,621,623,624,626,627,628,628,629,629,630,630,631, _
631,631,631,631,631,631,631,631,631,630,630,629,629,628,628,627, _
626,625,625,624,623,622,621,620,619,618,617,616,615,614,613,612, _
610,609,607,606,604,602,601,599,597,595,593,591,589,587,585,583, _
581,579,577,574,572,570,568,566,564,561,559,557,555,553,551,549, _
548,546,544,542,540,538,536,534,532,530,528,526,523,521,519,517, _
515,513,511,509,507,505,503,500,498,496,494,492,490,488,486,485, _
483,481,479,478,476,474,473,471,469,467,465,464,462,460,458,457, _
455,453,452,450,448,447,445,443,442,440,439,437,435,434,432,431, _
430,428,427,425,424,423,422,421,419,418,417,416,415,414,412,411, _
410,409,408,407,406,405,404,403,402,402,401,400,399,398,397,396, _
395,395,394,393,392,391,390,389,388,388,387,386,385,384,383,382, _
381,379,378,377,376,374,373,372,371,370,369,367,366,365,365,364, _
363,362,362,361,361,360,360,360,360,360,360,361,361,362,362,364, _
365,366,367,369,371,373,375,377,379,381,383,385,388,390,393,395, _
397,400,402,405,407,409,411,414,416,418,420,422,423,425,426,427, _
428,430,431,432,433,434,435,436,437,438,439,440,441,442,443,443, _
444,445,445,446,447,447,448,448,449,449,450,450,450,451,451,451, _
452,452,452,452,452,452,453,453,453,452,452,452,452,452,452,451, _
451,451,450,450,450,449,449,448,448,448,447,447,446,446,445,445, _
445,444,444,444,443,443,443,442,442,442,441,441,441,440,440,440, _
439,439,439,438,438,437,437,437,436,436,436,435,435,434,434,434, _
433,433,432,432,432,431,431,430,430,430,429,429,428,428,427,427, _
426,426,425,425,425,424,424,423,423,422,422,421,421,420,420,419, _
419,418,418,417,417,416,415,415,414,414,413,413,412,412,411,411, _
410,410,409,409,408,408,407,407,406,406,405,404,404,403,403,402, _
402,401,400,400,399,398,398,397,396,396,395,394,393,392,392,391, _
390,389,388,387,386,385,384,382,381,380,379,377,376,375,374,372, _
371,370,369,367,366,365,364,363,362,361,360,359,358,357,356,356, _
355,355,355,354,354,353,353,353,353,353,353,353,353,353,353,353, _
353,353,353,353,354,354,354,354,355,355,355,355,356,356,356,357, _
357,357,358,358,358,358,359,359,359,360,360,360,361,361,362,362, _
363,363,364,364,364,365,366,366,367,367,368,368,369,369,370,370, _
371,371,372,372,373,373,374,374,374,375,375,376,376,377,377,378, _
378,379,379,380,380,381,381,382,382,383,383,384,384,384,385,385, _
386,387,387,388,388,389,389,390,390,391,391,392,392,393,393,394, _
394,395,395,396,396,397,397,398,398,399,399,400,400,401,401,402, _
402,403,404,404,405,406,406,407,408,409,410,411,412,412,413,414, _
415,416,418,419,420,422,423,425,426,428,429,431,432,434,435,437, _
439,440,442,443,444,446,447,448,450,451,452,453,454,455,456,457


'Y_values:

DATA _
247,246,246,245,244,243,242,241,240,239,238,237,236,235,233,232, _
231,229,228,227,225,224,222,221,219,218,217,215,214,212,211,209, _
208,206,205,204,203,201,199,198,196,194,192,191,189,187,185,183, _
181,179,177,175,173,172,170,168,166,164,163,161,159,158,156,155, _
154,152,151,150,149,148,148,147,147,146,146,145,145,145,144,144, _
144,144,144,144,144,144,144,144,145,145,145,146,146,147,147,148, _
148,149,149,150,151,151,152,153,154,154,155,156,157,158,159,160, _
161,163,164,165,167,168,170,171,173,174,176,178,179,181,183,184, _
186,187,189,191,192,194,195,197,198,200,201,202,203,204,206,207, _
208,209,211,212,213,215,216,217,218,220,221,222,223,225,226,227, _
228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,242, _
243,243,243,243,243,243,243,242,242,241,240,240,239,238,238,237, _
237,236,236,235,235,235,235,236,236,237,238,239,240,242,244,247, _
249,252,254,258,262,267,272,277,283,289,296,303,310,317,325,332, _
340,348,356,364,372,380,388,396,404,411,419,426,433,440,446,452, _
458,463,468,472,476,478,481,484,487,490,493,495,497,499,501,503, _
505,506,507,508,509,509,510,510,510,510,510,509,509,508,507,506, _
504,503,501,499,497,495,492,489,488,485,481,477,472,467,462,456, _
450,443,436,429,422,415,407,400,392,384,376,369,361,354,346,339, _
332,326,319,313,307,302,297,293,289,285,282,281,279,277,276,275, _
274,273,273,273,273,274,275,276,277,278,280,282,284,286,288,290, _
292,295,297,300,303,305,308,311,314,316,319,322,324,327,328,330, _
333,336,339,342,345,348,352,355,359,363,366,370,374,378,382,385, _
389,393,397,401,405,409,413,416,420,424,427,431,434,437,441,444, _
447,448,451,453,456,459,461,463,466,468,470,473,475,477,479,481, _
483,485,487,489,491,493,495,497,498,500,502,504,506,508,510,511, _
513,515,517,519,520,522,524,525,527,529,530,532,533,535,536,538, _
539,540,542,543,545,546,548,549,551,552,554,556,557,559,561,563, _
565,568,570,572,575,578,580,582,585,588,592,596,600,604,608,612, _
617,622,626,631,636,641,646,651,656,661,666,671,675,680,685,689, _
694,698,702,706,710,713,716,719,722,725,726,728,730,732,734,736, _
738,739,741,742,744,745,746,747,748,748,749,749,750,750,750,750, _
750,750,750,749,748,748,747,746,745,743,742,741,739,738,736,734, _
731,729,726,723,719,716,712,709,705,701,696,692,688,683,679,674, _
669,665,660,655,651,646,641,637,632,628,624,619,615,611,608,604, _
602,598,595,591,587,583,579,575,571,567,563,559,555,551,547,543, _
539,535,532,528,525,521,518,515,512,509,507,505,502,501,499,498, _
497,496,495,495,495,495,496,496,497,499,500,502,504,506,508,511, _
514,517,519,523,526,529,532,536,539,543,546,550,554,557,561,564, _
568,571,575,578,581,584,586,589,592,596,599,602,606,609,613,617, _
621,624,628,632,636,640,644,647,651,655,659,662,666,669,673,676, _
679,683,686,689,691,694,696,699,701,702,704,706,708,710,712,715, _
717,719,721,723,725,727,728,730,732,733,734,736,737,738,738,739, _
739,739,739,738,738,737,735,734,732,730,727,725,723,720,716,711, _
706,701,696,690,683,677,670,663,655,648,640,632,624,616,607,599, _
591,582,574,566,558,549,541,534,526,518,511,504,498,491,485,482, _
476,471,465,460,454,449,443,438,433,428,423,418,413,408,403,398, _
394,389,385,380,376,372,368,364,360,356,352,348,345,341,338,335, _
332,329,327,324,321,319,316,314,311,309,307,305,303,301,299,297, _
295,294,292,291,290,288,287,286,285,284,283,283,282,281,281,280, _
280,280,279,279,279,279,279,279,279,280,280,281,282,283,284,285, _
286,287,288,290,291,293,294,296,297,299,301,302,304,306,308,309, _
311,313,314,316,318,319,321,322,323,324,326,327,329,330,332,333, _
335,336,338,339,341,342,344,345,347,348,350,351,353,354,356,358, _
359,361,363,364,366,368,369,371,373,374,376,377,379,381,382,384, _
386,388,390,392,394,396,397,399,401,403,405,407,409,411,413,415, _
417,419,421,423,425,427,429,431,433,435,437,439,441,443,444,446, _
448,450,452,455,457,459,462,464,466,469,471,474,476,479,481,483, _
486,488,490,492,494,496,498,499,501,502,504,505,506,507,507,508, _
508,508,508,508,507,507,506,505,504,503,502,500,499,497,495,493, _
491,489,487,485,483,481,478,476,474,471,469,467,464,462,460,457, _
455,453,451,449,448,446,444,442,440,438,436,434,432,430,427,425, _
423,421,419,416,414,412,410,408,405,403,401,399,396,394,392,390, _
388,386,383,381,379,377,375,374,372,370,368,366,364,362,360,357, _
355,353,351,349,347,345,343,341,339,337,335,333,331,329,327,325, _
323,321,320,318,316,314,313,311,309,308,307,305,304,303,301,300, _
298,297,296,294,293,292,291,290,288,287,286,285,284,283,282,281, _
280,279,278,277,276,275,274,273,272,271,270,269,268,268,267,266, _
265,265,264,263,262,261,260,260,259,258,257,257,256,255,255,254, _
253,253,252,252,251,251,250,249,249,249,248,248,247,247,247,246


   

And a data editor.
Click points with mouse.
go into drag mode (top left) anytime to alter the points.
Use the wheel to magnify (e.g. closing a shape perhaps)
Press down on the mouse wheel to reset it.
Right click anywhere to delete the last point.
Press esc to end, save or not.
saves to a file, OR you can copy and paste from the console.
Paste fresh data to the other program.
You may have to skip painting if the centroid is outside the shape.

Code: Select all

 


Dim As Integer xres,yres
Screeninfo xres,yres
Screenres .9*xres,.9*yres,32
Screeninfo xres,yres


#define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
#define onscreen (mx>0) and (mx<xres) and (my>0) and (my<yres)
#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius

Type Point
    As Long x,y
End Type

Type V2 As Point
Function ShortSpline(p() As V2,t As Single) As V2
    #macro set(n)
    0.5 *(     (2 * P(2).n) +_
    (-1*P(1).n + P(3).n) * t +_
    (2*P(1).n - 5*P(2).n + 4*P(3).n - P(4).n) * t*t +_
    (-1*P(1).n + 3*P(2).n- 3*P(3).n + P(4).n) * t*t*t)
    #endmacro
    Dim As V2 G
    G.x=set(x):G.y=set(y)':G.z=set(z)
    Return g
End Function

Sub GetSpline(v() As V2,outarray() As V2,arraysize As Long=1000)
    Dim As V2 p(1 To 4)
    Redim outarray(0)
    Dim As Single stepsize=(Ubound(v)-1)/(arraysize)
    If stepsize>1 Then stepsize=1
    For n As Long=Lbound(v)+1 To Ubound(v)-2
        p(1)=v(n-1):p(2)=v(n):p(3)=v(n+1):p(4)=v(n+2)
        For t As Single=0 To 1 Step stepsize
            Redim Preserve outarray(1 To Ubound(outarray)+1)
            outarray(Ubound(outarray))=ShortSpline(p(),t)
        Next t
    Next n
End Sub

Sub DrawCurve(a() As V2,ydisp As Long=0,col As Ulong)
    Pset(a(Lbound(a)).x,a(Lbound(a)).y+ydisp),col
    For z As Long=Lbound(a)+1 To Ubound(a)
        Line-(a(z).x,a(z).y+ydisp),col
    Next z
End Sub

Sub lineto(x1 As Single,y1 As Single,x2 As Single,y2 As Single,L As Single,Byref ox As Single,Byref oy As Single)
    Var dx=x2-x1,dy=y2-y1
    ox=x1+dx*L
    oy=y1+dy*L
End Sub

Sub Magnify()
    #define resetwheel(w,fl) fl=w
    #define wheel(w,f) w-f
    Dim As Long mx,my,mw,button:Getmouse mx,my,mw,button
    Static As Long flag,pmw
    mw=(mw/2)
    If button=4 Then  resetwheel(mw,flag)
    Dim As Ulong array(1 To 6561),count
    pmw=wheel(mw,flag)
    If pmw<=1 Then Exit Sub
    For z As Long=1 To 2
        For x As Long=mx-40 To mx+40
            For y As Long=my-40 To my+40
                count+=1
                If z=1 Then array(count)=Point(x,y)
                If z=2 Then
                    Var NewX=pmw*(x-mx)+mx:Var NewY=pmw*(y-my)+my
                    Line(newx-pmw/2,newy-pmw/2)-(newx+pmw/2,newy+pmw/2),array(count),bf
                End If
            Next y
        Next x
        count=0
    Next z
    Line(mx-pmw*40,my-pmw*40)-(mx+pmw*40,my+pmw*40),Rgb(100,0,0),B
End Sub
#macro display()
Screenlock
Cls


'================= GRID =======================
For x As Long=0 To xres Step 50
    Line(x,0)-(x,yres),Rgb(155,155,155)
Next x
For y As Long=0 To yres Step 50
    Line(0,y)-(xres,y),Rgb(155,155,155)
Next y
Line(0,0)-(xres,20),Rgb(0,100,200),bf
If dragmode=1 Then
    Line(10,0)-(100,20),Rgb(200,0,0),bf
Else
    Line(10,0)-(100,20),Rgb(0,200,0),bf   
End If
Draw String(15,5),"Drag mode",Rgb(255,255,255)
Draw String(150,5),dragmessage,Rgb(255,255,255)
Draw String(xres/3,20),"mouse " & mx &"   " & my & "  " & Str(dragmode)  ,Rgb(200,200,200) 

'firsst point
If Ubound(s) Then Circle(s(1).x,s(1).y),3,Rgb(200,100,0),,,,f
'========== Get the CatMull Rom spline ====================
If Ubound(s)>1 Then
    Dim As Single ox,oy
    lineto(s(2).x,s(2).y,s(1).x,s(1).y,1,ox,oy)
    Redim s2(0 To Ubound(s)+1)
    s2(0)=Type<v2>(ox,oy)
    For n As Long=1 To Ubound(s)
        s2(n)=s(n)
    Next n
    lineto(s(Ubound(s)-1).x,s(Ubound(s)-1).y,s(Ubound(s)).x,s(Ubound(s)).y,1,ox,oy)
    s2(Ubound(s2)).x=ox
    s2(Ubound(s2)).y=oy
    Dim As Long m
    If Ubound(s)<6-3 Then 'after fourth point the spline becomes curved
        m=0
    Else
        m=map(0,100,Ubound(s),0,(Ubound(s)*100))+50
    End If
    Draw String (10,30),"Number of spline points " +Str(Ubound(cmull)),Rgb(255,255,255)
    Draw String (10,40),"Number of mouse points " +Str(Ubound(s2)),Rgb(255,255,255)
    GetSpline(s2(),Cmull(),m)
    DrawCurve(CMull(),,Rgb(200,0,0))
End If
For n As Long=2 To Ubound(s)
    Circle (s(n).x,s(n).y),3,Rgb(200,0,0),,,,f
Next n
magnify()
Screenunlock
Sleep 1,1
#endmacro

#macro mouse(m)
Dim As Long x=mx,y=my,dx,dy
While mb = 1
    Display()
    Getmouse mx,my,,mb
    If onscreen Then
        If mx<>x Or my<>y  Then
            dx = mx - x
            dy = my - y
            x = mx
            y = my
            s(m).x=x+dx
            s(m).y=y+dy
        End If
    End If
Wend
#endmacro

Redim As Point s(0),s2()
Redim As V2 Cmull()

Dim As Long mx,my,mb,flag1,counter,flag2,dragmode=-1
Dim As String key,dragmessage
Screencontrol 100,50,50

Do
    Getmouse mx,my,,mb
    key=Inkey
    
    display()
    
    If my<20 Then
        If mx>10 And mx<100 And mb=1 And flag1=0 Then
            flag1=1
            dragmode=-dragmode
        End If
    End If
    
    If dragmode =1 Then
        For n As Long=Lbound(s) To Ubound(s)
            If incircle(s(n).x,s(n).y,10,mx,my) Then
                mouse(n)
            End If
        Next n
        
    End If
    '==============================================
    'insertion of points
    If my>20 And dragmode=-1 Then
        If mb=1 And flag1=0 Then
            flag1=1:counter+=1
            Redim Preserve s(1 To Ubound(s)+1)
            s(Ubound(s))=Type<Point>(mx,my)
        End If
        
        'deletion of points
        If mb=2 And flag2=0 Then
            flag2=1
            If counter>1 Then Redim Preserve s(1 To Ubound(s)-1):counter-=1
            If counter=1 Then Redim s(0):counter=0
        End If
    End If
    flag1=mb
    flag2=mb
    If dragmode=-1 Then dragmessage="YOU CAN DRAW POINTS"
    If dragmode=1 Then  dragmessage="YOU CAN DRAG POINTS WITH THE MOUSE"
    
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
Loop Until key =Chr(27)

Draw String(10,100), "Do you want to save this  y/n ? ",Rgb(255,255,255)
Var g=Input(1)
If Lcase(g)<>"y" Then End

Open "polypoints.txt" For Output As #1

Print #1,"'Number of points "
Print #1,"DATA _"
print #1,Ubound(cmull)-Lbound(Cmull)+1
Print #1," "
Print #1,"'X_values:"
Print #1," "
Print #1,"DATA _"
'================
Dim As String accum
Dim As Integer ctr


For n As Integer=Lbound(Cmull) To Ubound(Cmull)
    ctr+=1
    accum+=Str(Cmull(n).x)+ ","
    If ctr Mod 16 =0  Then accum+= " _"+Chr(13) + Chr(10)
Next n
accum=Rtrim(accum,",")
accum=Rtrim(accum,Chr(10))
accum=Rtrim(accum,Chr(13))
accum=Rtrim(accum,"_")
accum=Rtrim(accum," ")
accum=Rtrim(accum,",")
Print #1,accum
accum=""
ctr=0


Print #1," "
Print #1," "
Print #1,"'Y_values:"
Print #1," "
Print #1,"DATA _"
For n As Integer=Lbound(Cmull) To Ubound(Cmull)
    ctr+=1
    accum+=Str(Cmull(n).y)+ ","
    If ctr Mod 16 =0  Then accum+= " _"+Chr(13) + Chr(10)
Next n
accum=Rtrim(accum,",")
accum=Rtrim(accum,Chr(10))
accum=Rtrim(accum,Chr(13))
accum=Rtrim(accum,"_")
accum=Rtrim(accum," ")
accum=Rtrim(accum,",")
Dim As Integer numpts=Ubound(cmull)-Lbound(Cmull)+1
Print #1,accum 
Print #1," "
Print #1," "
Close #1
Shell "type polypoints.txt"
Sleep
sleep

  

[badidea]

Here's an alien...
And a data editor...

That is a nice tool. Did you just made that, after my post or earlier?
My own poly-line class seems a but bit stupid now :-)

[dodicat]

Badidea.
I had bits and pieces of the editor from the past.
I did always prefer using strings and draw with another editor.
But the shape type is new.
Thanks for testing.

[dafhi]

It's fun watching pples' code style change. Mine changes too slowly :P

@dodicat - you had an function recently, it used pointer to grab width and height and made everything super tidy. I didn't quite buy into it at the time but I've been looking for new options

[badidea]

It's fun watching pples' code style change. Mine changes too slowly :P

It's never easy. You can spend time learning to write 'nicer' code, or spend the same time writing code that actually does what you had planned in a somewhat 'uglier' but quick way.
What can help is to write code in a different language as well. It changes your view on things. A few months ago, I wrote a program in python (with some help) using the tkinter GUI and fancy stuff like class inheritance. Part of code:

Code: Select all

class tkQuantity(tk.StringVar):
	factor = 1.0 # PrefUnit / SI
	valueStr = ""

	def __init__(self, value=0, unit=0, **kwds):
		valueStr = self.formatStr.format(float(value)) + ' ' + self.unitStr
		super().__init__(value=valueStr, **kwds) # Chain parent constructor

	def set(self, value=0.0, **kwds):
		valueStr = self.formatStr.format(float(value) * self.factor) + ' ' + self.unitStr
		# Set binded GUI value, always in preferred unit
		super().set(value=valueStr, **kwds)

	def get(self):
		valueStr = str(super().get()).split()[0]
		return float(valueStr) / self.factor # PrefUnit / (PrefUnit / SI) = SI

	def update(self):
		self.set(self.get()) # apply formatting

class tkTemp(tkQuantity):
	factor = 1.0 # [degC] / [degC]
	formatStr = "{:6.1f}"
	unitStr = "\xb0C" # degC

class tkFlow(tkQuantity):
	factor = 60.0 / density # [l/min] / [kg/s]
	formatStr = "{:6.1f}"
	unitStr = "lpm"

class tkPower(tkQuantity):
	factor = 1e-3 # [kW] / [W]
	formatStr = "{:6.1f}"
	unitStr = "kW"

class tkCond(tkQuantity):
	factor = 1e-3 # [kW/K] / [W/K]
	formatStr = "{:6.2f}"
	unitStr = "kW/K"

Crazy stuff right?

[dafhi]

I've been looking at python sporadically. I use 'i' instead of 'self'. Also interested in JS but know it less than python, although i discovered you can omit the semicolon in many cases >:D

[badidea]

"Looking at" doesn't work, you have to dive into it, get frustrated with it, complain about all the 'stupid' ways to do things, and try to actually make something that seems impossible in the beginning. Also, some direct help from colleges with a lot a experience in python helps :-)

I tried to make an app for my Jolla phone which runs Sailfish OS. The tool for this Qt Creator. The Language QML with C++. QML is weird, C++ is complex. Progress was too slow, example code online not up to date, on halt for now.

[badidea]

Ok, I'm done with this OOP stuff, I go back to 'no nonsense', 'solve the problem, without introducing new problems' code.