RetroBASIC
Basicprogramming(.org) => Code and examples => Topic started by: Galileo on February 05, 2018, 07:18:34 PM
-
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.
// 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:
// 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.
-
A simpler example to understand.
The library:
// 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:
// 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.
-
A slightly more complicated example. A number of changes and generalisations are made.
MyBox.yab library:
// 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:
// 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:
// 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):
// 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")