Simulate the use of complex types and type functions

[Galileo]

Yabasic does not allow the creation of user-defined types, but can be emulated. Even the use of type functions.

This is the import file with new type definition.

Code: [Select]

// Save with the name "c2d.yab"
// Type Cheb2d

sub create() // new object of type Cheb2d
items = items + 1
type() // redim attributes
return items // index of new object
end sub

sub init(p, order, precision, iterations)
   precision(p) = precision
   iterations(p) = iterations
   if order < 2 then
      print "Order must be >= 2"
      end
   end if
   redim xt(p, order - 1), yt(p, order - 1), coeffP(p, order * order - 1), coeffC(p, order * order - 1)
end sub

sub fit(p, xyz())
local i, j, m, tc, e, childcost

   parentcost(p) = 1 / 0
   tc = arraysize(coeffP(), 2)
   for i = 0 to tc
      coeffP(p, i) = 1 - 2 * ran()
   next
   for i = 0 to iterations - 1
      childcost = 0
      for j = 0 to tc
          m = exp(-precision * ran())
          if ran() < .5 then m = -m end if
          m = m + coeffP(p, j)
          if m > 1 or m < -1 then
            coeffC(p, j) = coeffP(p, j)
         else
            coeffC(p, j) = m
         end if
      next
      for j = 0 to arraysize(xyz(), 1) step 3
         e = evaluateX(p, xyz(j), xyz(j + 1), coeffC()) - xyz(j + 2)
         childcost = childcost + e * e
      next
      if childcost < parentcost(p) then
         parentcost(p) = childcost
         for j = 0 to tc
            coeffP(p, j) = coeffC(p, j)
         next
      end if
   next
end sub

sub evaluate(p, x, y)
   return evaluateX(p, x, y, coeffP())
end sub

sub type() // Attributes
dim xt(items, 1)
    dim yt(items, 1)
    dim coeffP(items, 1)
    dim coeffC(items, 1)
    dim precision(items)
    dim iterations(items)
    dim parentcost(items)
end sub

sub evaluateX(p, x, y, c())
local k, r, i, j, t

   xt(p, 0) = 1
   yt(p, 0) = 1
   xt(p, 1) = x
   yt(p, 1) = y
   t = arraysize(xt(), 2)
   for i = 2 to t
      xt(p, i) = 2 * x * xt(p, i - 1) - xt(p, i - 2)
      yt(p, i) = 2 * y * yt(p, i - 1) - yt(p, i - 2)
   next
   for i = 0 to t
      for j = 0 to arraysize(yt(), 2)
         r = r + c(p, k) * xt(p, i) * yt(p, j)
         k = k + 1
      next
   next
   return r
end sub
And this is the main code:

Code: [Select]

// 2D Chebyshev approximation
// Adapted from FreeBASIC to Yabasic by Galileo, 02/2018
// Original code: https://www.freebasic.net/forum/viewtopic.php?f=7&t=25969&p=236937&hilit=chebyshev#p236937
//
// An example of how to simulate the use of complex types and type functions.

import c2d // File where the type and its associated methods are implemented. c2d is the name of type.

if not peek("isbound") bind "TestChebyshev.exe" // If the code is modified, the executable file is generated again.

sub testfn(x, y)
   return sin(sin(7 * x) + cos(3 * y))
end sub
   
open window 400,400
n = 2000
dim xyz(n * 3 - 1)
x = 0 : y = 0 : z = 0

for x = -1 to 1 step .0025
   for y = -1 to 1 step .0025
      c = int(127.9999 * (1 + testfn(x, y)))
      color c, c, c
      dot 200 + 200 * x, 200 + 200 * y
   next
next

for i = 0 to n - 1 step 3
   x = 1 - 2 * ran()
   y = 1 - 2 * ran()
   z = testfn(x, y)
   xyz(i) = x
   xyz(i + 1) = y
   xyz(i + 2) = z
next

c1 = c2d.create() // Create a new object of type c2d
c2d.init(c1, 9, 60, 200000)
c2d.fit(c1, xyz())

for x = -1 to 1 step .0025
   for y = -1 to 1 step .0025
      e = c2d.evaluate(c1, x, y)
      if e > 1 then e = 1 end if
      if e < -1 then e = -1 end if
      c = int(127.9999 * (1 + e))
      color 0, c, c
      dot 200 + 200 * x, 200 + 200 * y
   next y
next x
Source code and executable is included.

[Galileo]

A simpler example to understand.

The library:

Code: [Select]

// Yabasic 2.78, by Galileo, 02/2018
// Complex type and functions type
// Type defined: MyCircle

items = 1
type() // Initialize array of type objects
items = 0

ps = 1
dim stack(ps) // Free storage stack
ps = 0

sub type() // Complex type MyCircle
dim cx(items) // Coordenate x of the center
dim cy(items) // Coordenate y of the center
dim radius(items) // Circle radius
dim col$(items) // Circle colour in mode "red, green, blue" (0 to 255 each of)
dim mode(items) // Fill mode (true or false)
end sub

sub copy(dest, orig)
cx(dest) = cx(orig)
cy(dest) = cy(orig)
radius(dest) = radius(orig)
col$(dest) = col$(orig)
mode(dest) = mode(orig)
end sub

sub create(parent, cx, cy, radius, col$, mode)
local item

item = stack(ps)
if not item then
items = items + 1
item = items
type()
else
stack(ps) = 0
ps = ps - 1
end if

if parent then
copy(item, parent)
else
cx(item) = cx
cy(item) = cy
radius(item) = radius
if col$ = "" col$ = "0, 0, 0"
col$(item) = col$
mode(item) = mode
end if
return item
end sub

sub destroy(item)
erase(item)
ps = ps + 1
stack(ps) = item
end sub

sub  erase(item)
if mode(item) then
clear fill circle cx(item), cy(item), radius(item)
else
clear circle cx(item), cy(item), radius(item)
end if
end sub

sub draw(item)
color col$(item)
if mode(item) then
fill circle cx(item), cy(item), radius(item)
else
circle cx(item), cy(item), radius(item)
end if
end sub

sub move(item, cx, cy)
erase(item)
cx(item) = cx : cy(item) = cy
draw(item)
end sub

sub resize(item, radius)
erase(item)
radius(item) = radius
draw(item)
end sub

sub colorize(item, col$, mode)
erase(item)
col$(item) = col$
if numparams = 3 mode(item) = mode
draw(item)
end sub

Test program:

Code: [Select]

// Test of complex type MyCircle

import MyCircle

open window 640, 480
backcolor 255, 255, 255
clear window

circle1 = MyCircle.create(0, 100, 100, 25) // create a circle in coords cx, cy with radius = 25. By default, color "0,0,0" (black) and no filler mode
print "Identification of item = ", circle1
MyCircle.draw(circle1)
pause 1
MyCircle.move(circle1, 200, 200)
pause 1
MyCircle.resize(circle1, 50)
pause 1
MyCircle.colorize(circle1, "255, 0, 0", true)
pause 1
MyCircle.destroy(circle1)
pause 1
circle2 = MyCircle.create(0, 300, 200, 75, "0, 0, 255", true)
print "Identification of item = ", circle2 // "reuse" the identificator
MyCircle.draw(circle2)
pause 1
circle3 = MyCircle.create(circle2) // create a new object with attributes of other (is a copy)
print "Identification of item = ", circle3 // new identificator
MyCircle.move(circle3, 100, 100)
MyCircle.draw(circle3) // Hey! Where is my first circle?
pause 1
MyCircle.draw(circle2) // Luckily!
pause 1
MyCircle.colorize(circle3, "0, 255, 0") // So I can already tell them apart.



[Galileo]

A slightly more complicated example. A number of changes and generalisations are made.

MyBox.yab library:

Code: [Select]

// Yabasic 2.78, by Galileo, 02/2018
// Complex type and functions type
// Type defined: MyBox

items = 1
type() // Initialize array of type objects

sub type() // Complex type MyCircle
dim used(items) // if true the item is in use. if false the item is free.
dim cx(items) // Coordenate x of the left-top corner of the box
dim cy(items) // Coordenate y of the left-top corner of the box
dim width(items) // Width of the box
dim height(items) // Height of the box
dim col$(items) // Box colour in mode "red, green, blue" (0 to 255 each of)
dim mode(items) // Fill mode (true or false)
end sub

sub copy(dest, orig)
cx(dest) = cx(orig)
cy(dest) = cy(orig)
width(dest) = width(orig)
height(dest) = height(orig)
col$(dest) = col$(orig)
mode(dest) = mode(orig)
end sub

sub create(parent, cx, cy, width, height, col$, mode)
local item

for item = 1 to items
if not used(item) break
next item

if item > items then
items = item
type()
end if

used(item) = true

if parent then
copy(item, parent)
else
cx(item) = cx
cy(item) = cy
width(item) = width
height(item) = height
if col$ = "" col$ = "0, 0, 0"
col$(item) = col$
mode(item) = mode
end if
redrawAll()
return item
end sub

sub destroy(item)
used(item) = false
redrawAll()
end sub

sub draw(item)
color col$(item)
if mode(item) then
fill box cx(item), cy(item), cx(item) + width(item), cy(item) + height(item)
else
box cx(item), cy(item), cx(item) + width(item), cy(item) + height(item)
end if
end sub

sub move(item, cx, cy)
cx(item) = cx : cy(item) = cy
redrawAll()
end sub

sub resize(item, width, height)
width(item) = width
height(item) = height
redrawAll()
end sub

sub colorize(item, col$, mode)
col$(item) = col$
if numparams = 3 mode(item) = mode
redrawAll()
end sub

sub redraw()
local n

for n = 1 to items
if used(n) draw(n)
next n
end sub

MyCircle2.yab library:

Code: [Select]

// Yabasic 2.78, by Galileo, 02/2018
// Complex type and functions type
// Type defined: MyCircle2

items = 1
type() // Initialize array of type objects

sub type() // Complex type MyCircle
dim used(items) // if true the item is in use. if false the item is free.
dim cx(items) // Coordenate x of the center
dim cy(items) // Coordenate y of the center
dim radius(items) // Circle radius
dim col$(items) // Circle colour in mode "red, green, blue" (0 to 255 each of)
dim mode(items) // Fill mode (true or false)
end sub

sub copy(dest, orig)
cx(dest) = cx(orig)
cy(dest) = cy(orig)
radius(dest) = radius(orig)
col$(dest) = col$(orig)
mode(dest) = mode(orig)
end sub

sub create(parent, cx, cy, radius, col$, mode)
local item

for item = 1 to items
if not used(item) break
next item

if item > items then
items = item
type()
end if

used(item) = true

if parent then
copy(item, parent)
else
cx(item) = cx
cy(item) = cy
radius(item) = radius
if col$ = "" col$ = "0, 0, 0"
col$(item) = col$
mode(item) = mode
end if
redrawAll()
return item
end sub

sub destroy(item)
used(item) = false
redrawAll()
end sub

sub draw(item)
color col$(item)
if mode(item) then
fill circle cx(item), cy(item), radius(item)
else
circle cx(item), cy(item), radius(item)
end if
end sub

sub move(item, cx, cy)
cx(item) = cx : cy(item) = cy
redrawAll()
end sub

sub resize(item, radius)
radius(item) = radius
redrawAll()
end sub

sub colorize(item, col$, mode)
col$(item) = col$
if numparams = 3 mode(item) = mode
redrawAll()
end sub

sub redraw()
local n

for n = 1 to items
if used(n) draw(n)
next n
end sub

General library TShape.yab:

Code: [Select]

// Yabasic 2.78, by Galileo, 02/2018
// Complex type and functions type
// General library: TShape

import MyBox
import MyCircle2

export sub redrawAll() // common subroutine for redraw all shapes
clear window
MyCircle2.redraw()
MyBox.redraw()
end sub
Main code (you can name it as you wish):

Code: [Select]

// Yabasic 2.78, by Galileo, 02/2018
// Complex type and functions type
// Test of complex types MyCircle2 and MyBox

import TShape

open window 640, 480
backcolor 255, 255, 255
clear window

circle1 = MyCircle2.create(0, 100, 100, 25) // create a circle in coords cx, cy with radius = 25. By default, color "0,0,0" (black) and no filler mode
box1 = MyBox.create(0, 200, 200, 100, 50) // create a box in coords 200, 200 with width = 100 and height = 50. By default, color "0,0,0" (black) and no filler mode
print "Identification of item circle = ", circle1
print "Identification of item box = ", box1
pause 1
MyCircle2.move(circle1, 200, 200)
pause 1
MyCircle2.resize(circle1, 50)
pause 1
MyCircle2.colorize(circle1, "255, 0, 0", true)
pause 1
MyCircle2.destroy(circle1)
pause 1
circle2 = MyCircle2.create(0, 300, 200, 75, "0, 0, 255", true)
print "Identification of item circle = ", circle2 // "reuse" the identificator
pause 1
circle3 = MyCircle2.create(circle2) // create a new object with attributes of other (is a copy)
print "Identification of item circle = ", circle3 // new identificator
MyCircle2.move(circle3, 100, 100) // Hey! Where is my first circle?
pause 1
MyCircle2.colorize(circle3, "0, 255, 0") // So I can already tell them apart.
MyBox.colorize(box1, "255, 0, 0")