readability checker board

[BasicCoder2]

@UEZ,
As I did comment earlier "I would probably take the calculation out to reduce the size of the source code line to enhance readability".
Using blank lines and proper indentation to block related bits of code also enhances the readability.

However I was thinking more in these terms. Show code to say all the those who can program and use the number of those programmers who can easily read and understand the code as a measure of its readability. There will be some code they can all read and understand. There will be some code only the top programmers can read and understand. Now I always saw the BASIC syntax as easy for anyone to read and C++ for the professionals or advanced hobby programmer who wants to write fast, tight and efficient code. FreeBASIC is a mix although apart from its graphics it is essentially a kind of BASIC syntax version of C++. There is nothing wrong with that but there will be FreeBASIC code that is not readable by everyone. There are programming projects that would be easier to read and write if a set of simple innate bloated commands were available. I note for example that there are plenty of FB graphic demos but not much FB sound to accompany it.

My thoughts were that nothing is likely to change any time soon so making FB programs more readable, should you even care to do that, would involve extending the command set by writing functions that are more readable and as in the case of adding sound and music commands it may involve the use of libraries.

One example I have often used as an extended command is multiput() but I suspect there are many others?

[dodicat]

Shorter code using images.

Code: Select all

 Screen 20
            
Function grid(n As Long,s As Long,c1 As Ulong,c2 As Ulong) As Any Ptr
    Dim As Any Ptr t(0 To 2)={Imagecreate(s,s,c1),Imagecreate(s,s,c2),Imagecreate(n*s,n*s)}'3 images
    Dim As Long k=1  'index for image 
    For x As Long=0 To n*s-1 Step s
        If n Mod 2 =0 Then k+=1 'if dimension is 2,4,6, ... then an extra toggle
        For y As Long=0 To n*s-1 Step s
            k+=1:k=k Mod 2  'toggle k 0,1,0,1 ...
            Put t(2),(x,y),t(k) 'transfer to big image
            Next:Next
            Return t(2) 'big image returned
        End Function
        
   #define resetwheel(w,fl) fl=w
   #define wheel(w,f) w-f  
    
       dim as any ptr backdrop=grid(147,7,4,7)
       dim as long x,y,w,b,flag
        do
            getmouse x,y,w,b
            if x>0 then 'reset the wheel on button press
             If b Then  resetwheel(w,flag)
              w=wheel(w,flag)
          end if
           Var z=grid(8+w,50-w,15,0) 'black/white
           
            screenlock
        put(0,0),backdrop,pset
        Put(x,y),z,Pset
        screenunlock
        
        sleep 1,1
        imagedestroy z
        loop until len(inkey)
        Sleep
        imagedestroy backdrop
         

[BasicCoder2]

@dodicat,
Have placed my version of your checker grid in the Tricks and Tips section.
We all seem to code differently :)

[dodicat]

I have a board for a brand new game of some sort.
I have no idea what yet, just a board.

Code: Select all

Screen 20,32

sub setdice(i() as any ptr,size as long)
Type v
    As Long x,y
End Type
Dim as v p(1 To 7)
redim i(1 To 6)
Dim As Long sz=size,dt=sz/12
p(1)=Type(sz/4,sz/4)
p(2)=Type(sz/4,sz/2)
p(3)=Type(sz/4,3*sz/4)
p(4)=Type(3*sz/4,sz/4)
p(5)=Type(3*sz/4,sz/2)
p(6)=Type(3*sz/4,3*sz/4)
p(7)=Type(sz/2,sz/2)

For n As Long=1 To 6
    i(n)=Imagecreate(sz,sz)
    Select Case n
    Case 1
        Circle i(1),(p(7).x,p(7).y),dt,0,,,,f
    Case 2
        Circle i(2),(p(1).x,p(1).y),dt,0,,,,f
        Circle i(2),(p(6).x,p(6).y),dt,0,,,,f
    Case 3
        Circle i(3),(p(1).x,p(1).y),dt,0,,,,f
        Circle i(3),(p(7).x,p(7).y),dt,0,,,,f
        Circle i(3),(p(6).x,p(6).y),dt,0,,,,f
    Case 4
        Circle i(4),(p(1).x,p(1).y),dt,0,,,,f 
        Circle i(4),(p(3).x,p(3).y),dt,0,,,,f 
        Circle i(4),(p(4).x,p(4).y),dt,0,,,,f 
        Circle i(4),(p(6).x,p(6).y),dt,0,,,,f 
    Case 5
        Circle i(5),(p(1).x,p(1).y),dt,0,,,,f 
        Circle i(5),(p(3).x,p(3).y),dt,0,,,,f 
        Circle i(5),(p(4).x,p(4).y),dt,0,,,,f 
        Circle i(5),(p(6).x,p(6).y),dt,0,,,,f 
        Circle i(5),(p(7).x,p(7).y),dt,0,,,,f 
    Case 6
        For z As Long=1 To 6
            Circle i(6),(p(z).x,p(z).y),dt,0,,,,f 
        Next z
    End Select
Next
end sub
Function grid(n As Long,s As Long,c1 As Ulong,c2 As Ulong) As Any Ptr
    randomize 
    redim as any ptr d()
    setdice(d(),s)
    #define Intrange(f,l) int(Rnd*((l+1)-(f))+(f))
    Dim As Any Ptr t(0 To 2)={Imagecreate(s,s,c1),Imagecreate(s,s,c2),Imagecreate(n*s,n*s)}'3 images
    Dim As Long k=1  'index for image 
    For x As Long=0 To n*s-1 Step s
        If n Mod 2 =0 Then k+=1 'if dimension is 2,4,6, ... then an extra toggle
        For y As Long=0 To n*s-1 Step s
            k+=1:k=k Mod 2  'toggle k 0,1,0,1 ...
            line t(k),(0,0)-(s,s),rgb(0,0,0),b
            Put t(2),(x,y),t(k),pset 'transfer to big image
            put t(2),(x,y),d(intrange(1,6)),trans 'add die faces
            Next:Next
            Return t(2) 'big image returned
        End Function

do
var g=grid(9,75,rgb(200,0,0),rgb(0,200,0))
put (175,50),g,pset
sleep
loop until inkey=chr(27)
sleep 

[Tourist Trap]

Monthes ago, BasicCoder2 and me tried to deal with what I called bones, and BC2 "rods", kinematics.
We wrote 2 examples. I wonder from a stylistic point of view (not about efficiency or completeness of features) which is the more readable. For me, as someone that played a lot with .net, udts everywhere is more readable , of course my opinion is biased! I would like to know people's judgement about this.

BC2's

Code: Select all

 'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As Double TwoPi = 8 * Atn(1)
Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radians

screenres 840,480,32

type POLYGON
    as single px(10)  'absolute position of points to cx,cy
    as single py(10)
    as single rx(10)  'relative position of points to cx,cy after rotation ww degrees
    as single ry(10)
    as single cx      'absolute position of rotation point
    as single cy
    as single nx      'absolute position of next point of rotation
    as single ny
    as single rnx     'relative position of next point after rotation ww degrees
    as single rny
    as single ww      'angle of rotation around cx,cy
end type

dim shared as POLYGON poly(0 to 2)  'two polygons


dim shared as integer tpx,tpy 'tx,ty
dim shared as double mag   'magnification
mag = .25

'initialize polygons

poly(0).cx = 320   'absolute position of rotate point for first polygon
poly(0).cy = 240
poly(0).nx = 50    'position of polygon rotation point
poly(0).ny = 0

poly(0).ww = 0.0
poly(1).ww = 0.0
poly(2).ww = 90.0

sub drawPolygon(poly as POLYGON)
    for i as integer = 1 to 6
        line (poly.rx(i)+poly.cx,poly.ry(i)+poly.cy)-(poly.rx(i-1)+poly.cx,poly.ry(i-1)+poly.cy),rgb(0,255,0)
    next i
    'paint (poly.cx,poly.cy),rgb(0,0,255),rgb(0,255,0)
    circle (poly.cx,poly.cy),5,rgb(100,100,255),,,,f
    circle (poly.rnx,poly.rny),5,rgb(255,255,0),,,,f
    line (poly.cx,poly.cy)-(poly.rnx,poly.rny),rgb(0,0,255)
    locate 2,2
    print "USE NUMBER KEYS 1 TO 6 TO CHANGE JOINT ANGLES"
end sub

for j as integer = 0 to 2
    restore shape
    for i as integer = 0 to 6
        read poly(j).px(i),poly(j).py(i)
    next i
    poly(j).nx = 352
    poly(j).ny = 0
next j


'rotate points
dim as single ww2
dim as string key

do
    
    key = inkey
    if key = "1" then poly(0).ww = poly(0).ww + 5 'shoulder down
    if key = "2" then poly(1).ww = poly(1).ww + 5 'elbow down
    if key = "3" then poly(2).ww = poly(2).ww + 5 'wrist down
    if key = "4" then poly(0).ww = poly(0).ww - 5 'shoulder up
    if key = "5" then poly(1).ww = poly(1).ww - 5 'elbow up
    if key = "6" then poly(2).ww = poly(2).ww - 5 'wrist up

    ww2 = poly(0).ww   'start angle
    
    for j as integer = 0 to 2  'each polygon
        
        for i as integer = 0 to 6
            tpx = cos(ww2*DtoR)*poly(j).px(i) - sin(ww2*DtoR)*poly(j).py(i)
            tpy = cos(ww2*DtoR)*poly(j).py(i) + sin(ww2*DtoR)*poly(j).px(i)
            poly(j).rx(i) = tpx*mag
            poly(j).ry(i) = tpy*mag       
        next i
    
        'rotate next point's position
        tpx = cos(ww2*DtoR)*poly(j).nx - sin(ww2*DtoR)*poly(j).ny
        tpy = cos(ww2*DtoR)*poly(j).ny + sin(ww2*DtoR)*poly(j).nx
        poly(j).rnx = tpx*mag + poly(j).cx
        poly(j).rny = tpy*mag + poly(j).cy
    
        'update absolute rotation point and running angle total
        poly(j+1).cx = poly(j).rnx
        poly(j+1).cy = poly(j).rny
        ww2 = ww2 + poly(j+1).ww
    
    next j

    
    screenlock
    cls
    for j as integer = 0 to 2
        drawPolygon(poly(j))
    next j
    screenunlock

     
    sleep 20
loop until multikey(&H01)


shape:
data -20,-20
data 175,-40
data 370,-20
data 370,21
data 175,40
data -20,21
data -20,-20

TT's

Code: Select all

  ''--------------------------------------------------
''  first try of making of some 2D bone hierarchy   
''--------------------------------------------------

#define _MIN(a, b)      iif((a)<(b), (a), (b))
#define _MAX(a, b)      iif((a)>(b), (a), (b))


type LENGTH
      as single      _lengthValue
end type


type ANGLEOXY
      as single      _angleValue
end type


type POSITIONXY
      as single      _x
      as single      _y
end type


type ORIENTATION
      as ANGLEOXY      _angleOxy
end type


type BONEPARAMETER
      as integer         _boneHierarchyRank
      as POSITIONXY      _bonePivotPosition
      as LENGTH         _boneLength
      as ORIENTATION      _boneOrientation
end type

type BONEPARENT      as BONE ptr
type BONECHILD      as BONE ptr
type BONE
   declare constructor()
   declare destructor()
   declare property BonePivot() as POSITIONXY
   declare property BoneEnd() as POSITIONXY
   'hierarchy
   declare sub DefineBoneLength(byref L as const LENGTH)
   declare sub AttachBoneToParentBone(byval P as BONEPARENT=0, _ 
                              byref XY as POSITIONXY=type<POSITIONXY>(0,0))
   declare sub RefreshHierarchy()
   declare sub UpdateFixHierarchy()
      as BONEPARENT      _parent
      as BONECHILD      _child(any)
      as BONEPARAMETER   _parameter
   'interaction
   declare function DistanceToTubeFrom overload(byref Xy as const POSITIONXY) as single
   declare function DistanceToTubeFrom(byref X as const single, _ 
                              byref Y as const single) _ 
                              as single
   declare sub TestMouse()
      as integer         _detectionScreenDistanceToAxis
      as boolean         _hasMouseOver
      as boolean         _hasMouseOverAxis
      as boolean         _hasMouseOverTube
   'visualization
   declare sub DrawBone()
   declare sub DrawBoneDetectionTube()
      as ulong         _defaultColor
      as ulong         _mouseOverColor
      as ulong         _mouseOverDetectionTubeColor
end type
constructor BONE()
   if screenPtr=0 then
      dim as integer   deskX, deskY
         screenInfo   deskX, deskY
      windowTitle "Bone is a 32bits color gui object"
      screenRes 0.6*deskX, 0.6*deskY, 32
   end if
   with THIS
      'hierarchy
   end with
   with THIS
      'interaction
      ._detectionScreenDistanceToAxis   => 4
      ._hasMouseOver               => FALSE
   end with
   with THIS
      'visualization
      ._defaultColor               => rgb(220,200,140)
      ._mouseOverColor            => rgb(100,240,240)
      ._mouseOverDetectionTubeColor   => rgb(100,200,240)
   end with
end constructor
destructor BONE()
   if THIS._parent<>0 then
      for index as integer =   lBound(THIS._child) to _ 
                        uBound(THIS._child)
         THIS._child(index)->_parent = THIS._parent
      next index
   end if
end destructor
property BONE.BonePivot() as POSITIONXY
   return THIS._parameter._bonePivotPosition
end property
property BONE.BoneEnd() as POSITIONXY
   var returnValue   =>   THIS._parameter._bonePivotPosition
   with THIS._parameter
      returnValue._x   +=   cos(._boneOrientation._angleOxy._angleValue)*._boneLength._lengthValue
      returnValue._y   +=   sin(._boneOrientation._angleOxy._angleValue)*._boneLength._lengthValue
   end with
   '
   return returnValue
end property
sub BONE.DefineBoneLength(byref L as const LENGTH)
   with THIS
      with ._parameter
         ._boneLength      => L
      end with
   end with
   'refresh child position
   for index as integer =   lBound(THIS._child) to _ 
                     uBound(THIS._child)
      THIS._child(index)->_parameter._bonePivotPosition = THIS.BoneEnd
   next index
end sub
sub BONE.AttachBoneToParentBone(byval P as BONEPARENT=0, _ 
                        byref XY as POSITIONXY=type<POSITIONXY>(0,0))
   if P<>0 then
      THIS._parent   => P
      redim preserve P->_child(uBound(P->_child) - lBound(P->_child) + 1)
      P->_child(uBound(P->_child) - lBound(P->_child)) => @THIS
      P->_child(uBound(P->_child) - lBound(P->_child))->_parameter._bonePivotPosition = P->BoneEnd
   end if
end sub
sub BONE.RefreshHierarchy()
   for index as integer =   lBound(THIS._child) to _ 
                     uBound(THIS._child)
      THIS._child(index)->_parameter._bonePivotPosition = THIS.BoneEnd
   next index
end sub
sub BONE.UpdateFixHierarchy()
   var index   => lBound(THIS._child)
   while index<=uBound(THIS._child)
      if THIS._child(index)=0 then
         swap   THIS._child(index), _ 
               THIS._child(uBound(THIS._child))
         if (uBound(THIS._child) - lBound(THIS._child))>0 then
            redim preserve THIS._child(uBound(THIS._child) - lBound(THIS._child) - 1)
         else
            erase THIS._child
         end if
      else
         index += 1
      end if
   wend
end sub
function BONE.DistanceToTubeFrom(byref Xy as const POSITIONXY) as single
   var byref angle      => THIS._parameter._boneOrientation._angleOxy._angleValue
   var byref xPivot   => THIS._parameter._bonePivotPosition._x
   var byref yPivot   => THIS._parameter._bonePivotPosition._y
   '
   return _
   abs( Xy._x*sin(angle) - Xy._y*cos(angle) + yPivot*cos(angle) - xPivot*sin(angle) )
end function
function BONE.DistanceToTubeFrom(byref X as const single, _ 
                         byref Y as const single) _ 
                         as single
   var byref angle      => THIS._parameter._boneOrientation._angleOxy._angleValue
   var byref xPivot   => THIS._parameter._bonePivotPosition._x
   var byref yPivot   => THIS._parameter._bonePivotPosition._y
   '
   return _
   abs( X*sin(angle) - Y*cos(angle) + yPivot*cos(angle) - xPivot*sin(angle) )
end function
sub BONE.TestMouse()
   dim as integer   gmX, gmY, gmWheel, gmBtn
   var errorCode   => getMouse(gmX, gmY, gmWheel, gmBtn)
   if errorCode<>0 then exit sub
   '
   var byref yPivot   => THIS._parameter._bonePivotPosition._y
   var byref yEnd      => THIS.BoneEnd._y
   var distanceToBoneAxis => THIS.DistanceToTubeFrom(cSng(gmX), cSng(gmY))
   if distanceToBoneAxis<THIS._detectionScreenDistanceToAxis   andAlso _ 
      gmY>_MIN(yPivot, yEnd)                           andAlso _ 
      gmY<_MAX(yPivot, yEnd)                           then
      if distanceToBoneAxis<1 then
         if not THIS._hasMouseOverAxis then THIS._hasMouseOverAxis = TRUE
      else
         if THIS._hasMouseOverAxis then THIS._hasMouseOverAxis = FALSE
      end if
      if not THIS._hasMouseOverTube then THIS._hasMouseOverTube = TRUE
      if not THIS._hasMouseOver andAlso _ 
         (THIS._hasMouseOverAxis orElse THIS._hasMouseOverTube) then
         THIS._hasMouseOver = TRUE
      end if
   else
      if THIS._hasMouseOverAxis then THIS._hasMouseOverAxis = FALSE
      if THIS._hasMouseOverTube then THIS._hasMouseOverTube = FALSE
      if THIS._hasMouseOver then THIS._hasMouseOver = FALSE
   end if
end sub
sub BONE.DrawBone()
   THIS.TestMouse()
   '
   line(THIS.BonePivot._x, THIS.BonePivot._y) - _
      (THIS.BoneEnd._x, THIS.BoneEnd._y), _ 
      THIS._defaultColor
   for index as integer =   lBound(THIS._child) to _ 
                     uBound(THIS._child)
      THIS._child(index)->DrawBone()
   next index
   if THIS._hasMouseOver then
      line(THIS.BonePivot._x, THIS.BonePivot._y) - _
         (THIS.BoneEnd._x, THIS.BoneEnd._y), _ 
         THIS._mouseOverColor
   end if
end sub
sub BONE.DrawBoneDetectionTube()
   THIS.TestMouse()
   '
   var angle   => THIS._parameter._boneOrientation._angleOxy._angleValue + 2*aTn(1)
   if THIS._hasMouseOverTube then
      for t as integer = -THIS._detectionScreenDistanceToAxis to _ 
                     THIS._detectionScreenDistanceToAxis
         line(THIS.BonePivot._x + t*cos(angle), THIS.BonePivot._y + t*sin(angle)) - _
            (THIS.BoneEnd._x + t*cos(angle), THIS.BoneEnd._y + t*sin(angle)), _ 
            THIS._mouseOverDetectionTubeColor
      next t
   else
      for t as integer = -THIS._detectionScreenDistanceToAxis to _ 
                     THIS._detectionScreenDistanceToAxis
         line(THIS.BonePivot._x + t*cos(angle), THIS.BonePivot._y + t*sin(angle)) - _
            (THIS.BoneEnd._x + t*cos(angle), THIS.BoneEnd._y + t*sin(angle)), _ 
            0
      next t
   end if
   if THIS._hasMouseOverAxis then
      line(THIS.BonePivot._x, THIS.BonePivot._y) - _
         (THIS.BoneEnd._x, THIS.BoneEnd._y), _ 
         THIS._mouseOverColor
   else
      line(THIS.BonePivot._x, THIS.BonePivot._y) - _
         (THIS.BoneEnd._x, THIS.BoneEnd._y), _ 
         THIS._defaultColor
   end if
end sub


'<#>---------------------------------------------------<#>

dim as BONE   b0
dim as BONE   b1
dim as BONE   b2
dim as BONE   b2b

b0._parameter._bonePivotPosition   => type(320, 120)
b0._parameter._boneOrientation._angleOxy._angleValue   => aTn(1)
b1._parameter._bonePivotPosition   => type(120, 120)
b1._parameter._boneOrientation._angleOxy._angleValue   => 1.2*aTn(1)
b0.DefineBoneLength(type(25))
b1.DefineBoneLength(type(50))

b2._parameter._bonePivotPosition   => type(420, 120)
b2._parameter._boneOrientation._angleOxy._angleValue   => 0
b2.DefineBoneLength(type(45))
b2b.DefineBoneLength(type(25))

b1.AttachBoneToParentBone(@b0)
b2.AttachBoneToParentBone(@b0)
b2b.AttachBoneToParentBone(@b2)

var keyPressed   => inkey()
dim as single   orientationStep   => .008
do
   b0._parameter._boneOrientation._angleOxy._angleValue += orientationStep
   b1._parameter._boneOrientation._angleOxy._angleValue -= orientationStep*4
   b2._parameter._boneOrientation._angleOxy._angleValue += orientationStep*4
   b0.RefreshHierarchy()
   b2.RefreshHierarchy()
   screenLock()
      cls
      '
      b0.DrawBone()
      b1.DrawBone()
      b0.DrawBoneDetectionTube()
      b1.DrawBoneDetectionTube()
   screenUnlock()
   '
   keyPressed   => inkey()
   sleep 15
loop until keyPressed=chr(27)

'<#>-------------

It's just about the readability here of course. I loved the BC2's jet !