screens:
the instructions shown, and the graph of X * sin(Y)
graph of sqrt(9 - X^2 * Y^2)
Have fun! P.S. when entering an equation i forgot to add, don't use spaces
Version 1.0:
REMSTART
3D Equation grapher
By Qwe
Ver 1.0
Press Enter after it starts up to see the help menu
REMEND
REM Ini
sync on
sync rate 60
set camera range 0.01, 100
REM Typ
type graph
x as float
y as float
z as float
endtype
type equations
v as float
o as string
endtype
REM Var
global mc
global oldmc
global uk
global olduk
global dk
global olddk
global ek
global oldek
global sel
global help_msg
global alternate_calculate
global error_msg$ = ""
global answer# = 0.0
global option_display_steps = 1
global total
global progress
global obj_left
global obj_right
global obj_front
global obj_back
global xd as float
global yd as float
global xi as float
global yi as float
`user settings
global xa as float : xa = -2 `xa: start X value (graph)
global xb as float : xb = 2 `xb: end X value (graph)
global ya as float : ya = 0 `ya: start Y value (graph)
global yb as float : yb = 760 `yb: end Y value (graph)
global xn as integer : xn = 20 `xn: x resolution (graph)
global yn as integer : yn = 20 `yn: y resolution (graph)
global xs as float : xs = 10.0*1.0 `xs: x size of graph in units, NB: user moves 1 unit per second
global ys as float : ys = 10.0*1.0 `ys: y size of graph in units, NB: user moves 1 unit per second
global equation as string : equation = "(x*sy)"
REM Arr
dim a(1,1) as graph
dim e(256) as equations
REM Setup
setup_3d()
REM Main do loop
do
show_data()
control_fields()
control_camera()
sync
loop
REM Show data
function show_data()
set cursor 0,0
REM Main
ink rgb(255,0,0),0
print "3d Equation Grapher, version 1.0"
print "By Qwe"
print ""
ink rgb(255,255,255),0
print "FPS: "; screen fps()
print "Use the up and down arrows to select a field"
print "Press enter to change a field's value"
print "Note: All values in degrees"
print "Fields:"
print
REM Fields
ink rgb(255,255,0),0
print "Help"
print "X Min : "; xa
print "X Max : "; xb
print "Y Min : "; ya
print "Y Max : "; yb
print "X Res : "; xn
print "Y Res : "; yn
print "X Size : "; xs
print "Y Size : "; ys
print "Equation: "; equation
print "Calculate new graph"
print
REM Graph data
ink rgb(255,255,255),0
print "Graph data:"
ink rgb(255,0,0),0
print "Corner: "; xa; ", "; ya
ink rgb(0,0,255),0
print "Corner: "; xa; ", "; yb
ink rgb(255,255,0),0
print "Corner: "; xb; ", "; yb
ink rgb(0,255,0),0
print "Corner: "; xb; ", "; ya
ink rgb(128,128,128),0
print "X Distance: "; xd
print "Y Distance: "; yd
print "X Units: "; xn
print "Y Units: "; yn
print "X Increment: "; xi
print "Y Increment: "; yi
endfunction
REM User changes field values
function control_fields()
REM Show which field is currently selected
if sel = 10
inc alternate_calculate
if alternate_calculate > 10
alternate_calculate = -10
endif
if alternate_calculate > 0 then ink rgb(255, 0, 0), 0
emptybox(0, 135 + sel*15, 155, 150 + sel*15)
else
ink rgb(255, 0, 0), 0
emptybox(0, 135 + sel*15, 75, 150 + sel*15)
endif
REM Show help box
if help_msg
ink rgb(0,255,255),0
n = -1
inc n : text 200, 200+n*20, "WASD moves around, QE moves up and down"
inc n : text 200, 200+n*20, "Mouse and Right Click to turn around"
inc n : text 200, 200+n*20, ""
inc n : text 200, 200+n*20, "XMin is the minimum X-Axis value on the graph"
inc n : text 200, 200+n*20, "XMax is the maximum X-Axis value on the graph"
inc n : text 200, 200+n*20, "YMin is the minimum Y-Axis value on the graph"
inc n : text 200, 200+n*20, "YMax is the maximum Y-Axis value on the graph"
inc n : text 200, 200+n*20, "XRes is how many Z-Height units are calculated along the X axes"
inc n : text 200, 200+n*20, "YRes is how many Z-Height units are calculated along the Y axes"
inc n : text 200, 200+n*20, "XSiz is the X size in units of the whole graph. It takes the user 1 second to move 1 unit"
inc n : text 200, 200+n*20, "YSiz is the Y size in units of the whole graph. It takes the user 1 second to move 1 unit"
inc n : text 200, 200+n*20, "The Equation field allows you to enter the equation"
inc n : text 200, 200+n*20, "The Calculate button re-calculates the graph according to the parameters set and the equation given"
inc n : text 200, 200+n*20, ""
inc n : text 200, 200+n*20, "When entering the equation, you have the following features:"
inc n : text 200, 200+n*20, "(, ), *, /, +, -, !, [p]i, [e], [s]in, [c]os, [t]an, sq[r]t, a[b]s, [E]"
inc n : text 200, 200+n*20, "When entering an equation, use the following syntax (example):"
inc n : text 200, 200+n*20, "(x*sy) means (X * sine(Y)), (x*s(`y+1)) means (X * sine(-Y + 1))"
inc n : text 200, 200+n*20, ""
inc n : text 200, 200+n*20, "Remember to use '`' for negative values (eg `1 or `y instead of -1 or -y) when entering an equation!"
inc n : text 200, 200+n*20, "All angles should be in degrees, eg, -pi to 2*pi would be -360 to 720"
inc n : text 200, 200+n*20, "Please report any bugs to me, the code is holy in as much as it relates to the flying spaghetti monster"
endif
REM Get input from arrowkeys and enter
olduk = uk
uk = upkey()
olddk = dk
dk = downkey()
oldek = ek
ek = returnkey()
REM Use arrow keys to select a field
if uk = 1 and olduk = 0
`go up
dec sel
if sel < 0 then sel = 10
help_msg = 0
endif
if dk = 1 and olddk = 0
`go down
inc sel
if sel > 10 then sel = 0
help_msg = 0
endif
REM User enter to change field value
if ek = 1 and oldek = 0
ink rgb(255,255,255),0
select sel
case 0
help_msg = 1
endcase
case 1
xa = get_user_float("Enter the minimum X Value for the graph")
endcase
case 2
xb = get_user_float("Enter the maximum X Value for the graph")
endcase
case 3
ya = get_user_float("Enter the minimum Y Value for the graph")
endcase
case 4
yb = get_user_float("Enter the maximum Y Value for the graph")
endcase
case 5
xn = get_user_integer("Enter the Y Resolution (units) for the graph")
endcase
case 6
yn = get_user_integer("Enter the X Resolution (units) for the graph")
endcase
case 7
xs = get_user_float("Enter the Y Size of the graph")
endcase
case 8
ys = get_user_float("Enter the X Size of the graph")
endcase
case 9
equation = get_user_string("Enter the equation. Available functions are (,),`,*,/,+,-,!,^,[p]i,[e],[s]ine,[c]osine,[t]an,sq[r]t,a[b]s,[E], prev[a]ns")
endcase
case 10
setup_3d()
endcase
endselect
endif
endfunction
REM Create 3d environment with specified parameters
function setup_3d()
REM Var
xd = dist_2d(xa, 0.0, xb, 0.0)`xd: x distance (graph)
yd = dist_2d(ya, 0.0, yb, 0.0)`yd: y distance (graph)
xi = xd / ((xn) + 0.0)`xi: x increment (graph)
yi = yd / ((yn) + 0.0)`yi: y increment (graph)
REM Arr
undim a()
dim a(xn, yn) as graph
total = (xn+1) * (yn+1)
progress = 0
REM Set array
for x = 0 to xn
for y = 0 to yn
a(x, y).x = ((x + 0.0) / (xn + 0.0)) * xd + xa
a(x, y).y = ((y + 0.0) / (yn + 0.0)) * yd + ya
a(x, y).z = get_answer(equation, a(x, y).x, a(x, y).y)
cls
inc progress
print ((progress+0.0)/(total+0.0)*100.0); "% complete"
sync
next y
next x
REM Set matrix
if matrix exist(1) then delete matrix 1
make matrix 1, xs, ys, xn, yn
set matrix 1, 1, 1, 0, 1, 1, 1, 1
for x = 0 to xn
for y = 0 to yn
set matrix height 1, x, y, a(x, y).z
next y
next x
update matrix 1
REM Show bounds
if obj_left > 0 then delete object obj_left
if obj_right > 0 then delete object obj_right
if obj_front > 0 then delete object obj_front
if obj_back > 0 then delete object obj_back
s# = xs / 10.0
obj_left = free_obj()
make object sphere obj_left, s#
color object obj_left, rgb(255,0,0)
position object obj_left, 0, 0, 0
obj_right = free_obj()
make object sphere obj_right, s#
color object obj_right, rgb(0,0,255)
position object obj_right, 0, 0, ys
obj_front = free_obj()
make object sphere obj_front, s#
color object obj_front, rgb(255,255,0)
position object obj_front, xs, 0, ys
obj_back = free_obj()
make object sphere obj_back, s#
color object obj_back, rgb(0,255,0)
position object obj_back, xs, 0, 0
endfunction
REM User control camera
function control_camera()
local mmy as float
local mmx as float
local spd as float
REM Var
spd = 0.01667
oldmc = mc
mc = mouseclick()
mmy = mousemovey() / 5.0
mmx = mousemovex() / 5.0
REM Toggle FPS
if keystate(78) then sync rate 0
if keystate(156) then sync rate 45
REM Look
if mc = 2 and oldmc = 2
`hide moues while looking around
hide mouse
position mouse 512, 384
`turn camera
xrotate camera wrapvalue(camera angle x() + mmy)
yrotate camera wrapvalue(camera angle y() + mmx)
`bound camera angle
if camera angle x()>89 and camera angle x()<180 then xrotate camera 89
if camera angle x()<271 and camera angle x()>180 then xrotate camera 271
else
show mouse
endif
REM Move (zoom)
if keystate(42)
spd = spd * 5.0
endif
if keystate(17)
move camera spd
endif
if keystate(31)
move camera -spd
endif
if keystate(30)
position camera newxvalue(camera position x(), camera angle y()-90.0, spd), camera position y(), newzvalue(camera position z(), camera angle y()-90.0, spd)
endif
if keystate(32)
position camera newxvalue(camera position x(), camera angle y()+90.0, spd), camera position y(), newzvalue(camera position z(), camera angle y()+90.0, spd)
endif
if keystate(16)
position camera camera position x(), camera position y() - spd, camera position z()
endif
if keystate(18)
position camera camera position x(), camera position y() + spd, camera position z()
endif
endfunction
REM Solve equation functions
function get_answer(e$, valx#, valy#)
REM set variables
length = len(e$)
array_count = 0
REM clear array
for i = 0 to 255
e(i).o = ""
e(i).v = 0.0
next i
REM translate string equation into array
for i = 1 to length
s$ = mid$(e$, i)
if s$="(" or s$=")" or s$="+" or s$="-" or s$="*" or s$="/" or s$="^" or s$="p" or s$ = "e" or s$ = "s" or s$ = "c" or s$ = "t" or s$ = "r" or s$ = "a" or s$ = "b" or s$ = "x" or s$ = "!" or s$ = "E" or s$ = "y"
if add_value$ = ""
else
e(array_count).v = val(add_value$)
add_value$ = ""
inc array_count
endif
e(array_count).o = s$
inc array_count
else
if s$ = "`" then s$ = "-"
add_value$ = add_value$ + s$
if mid$(e$, i+1) = "(" and add_value$ = "-" then add_value$ = "-1"
endif
next i
REM special features
add_implicit_multiplications()
set_pi_and_e_values()
set_x_value(valx#)
set_y_value(valy#)
add_implicit_a()
uh_oh = check_for_brackets_error()
if uh_oh = 1 then exitfunction 0.0
REM find out how many bracketed sections there are
for i = 0 to 255
if e(i).o = "(" then total_brackets = total_brackets + 1
next i
REM solve each level of brackets
if total_brackets > 0
for lvl = total_brackets to 1 step -1
display_equation_array()
length = solve_level(lvl)
next lvl
endif
REM give answer, store answer in global variable
localanswer#=e(0).v
answer#=e(0).v
endfunction localanswer#
function display_equation_array()
ink rgb(192,192,192),0
done=0
pos = 0
repeat
`see what brakcet level computer is at
if e(pos).o = "(" then inc bracket_level
if e(pos).o = ")" then dec bracket_level
`once reaches last bracket, no more no more
if bracket_level = 0 then done = 1
`add each array element to string
if e(pos).o = ""
display$ = display$ + str$(e(pos).v)
else
display$ = display$ + e(pos).o
endif
inc pos
until done=1
`take off first and last brackets
length = len(display$)
display$ = left$(display$, length-1)
display$ = right$(display$, length-2)
`display string
if option_display_steps = 1
print display$
endif
endfunction
function solve_level(lvl)
for i = 0 to 255
if e(i).o = "(" then inc count_brackets
`when computer comes to specified level
if count_brackets = lvl
`do operations
solve_factorial(i)
solve_sci_not(i)
solve_special(i, "s")
solve_special(i, "c")
solve_special(i, "t")
solve_special(i, "r")
solve_special(i, "b")
solve_segment(i, "^", "{")
solve_segment(i, "*", "/")
solve_segment(i, "-", "+")
`now the segment is simplified to one value
`now we can eliminate brackets around this value
e(i).v = e(i+1).v
e(i).o = ""
eliminate_slot(i+1)
eliminate_slot(i+1)
dec count_brackets
endif
next i
endfunction length
function solve_sci_not(i)
pos = i
repeat
`increase position along array and get its operator value
inc pos
s$ = e(pos).o
`if operator is what we want, perform operation and pull out previous and next slots
if e(pos).o = "E"
e(pos).v = e(pos-1).v * (10.0 ^ e(pos+1).v)
e(pos).o = ""
eliminate_slot(pos+1)
eliminate_slot(pos-1)
dec pos
endif
until s$ = ")"
endfunction
function solve_factorial(i)
pos = i
repeat
`increase position along array and get its operator value
inc pos
s$ = e(pos).o
`if operator is what we want, perform operation and pull out previous and next slots
if e(pos).o = "!"
e(pos).v = factorial(e(pos-1).v)
e(pos).o = ""
eliminate_slot(pos-1)
dec pos
endif
until s$ = ")"
endfunction
function log(nr#, acc)
result# = 0.00
for c = 0 to acc
repeat
inc result#, 10.0^(c*-1)
until 10.0^result# >= nr#
if 10.0^result# = nr#
exitfunction result#
else
dec result#, 10.0^(c*-1)
endif
next c
endfunction result#
function factorial(num#)
ans# = 1.0
for i = 1 to num#
ans# = ans# * i
next i
endfunction ans#
function solve_special(i, o$)
pos = i
repeat
`increase position along array and get its operator value
inc pos
s$ = e(pos).o
`if operator is what we want, perform operation and pull out previous and next slots
if e(pos).o = o$
if o$ = "s" then e(pos).v = sin(e(pos+1).v)
if o$ = "c" then e(pos).v = cos(e(pos+1).v)
if o$ = "t" then e(pos).v = tan(e(pos+1).v)
if o$ = "r" then e(pos).v = sqrt(e(pos+1).v)
if o$ = "b" then e(pos).v = abs(e(pos+1).v)
eliminate_slot(pos+1)
e(pos).o = ""
endif
until s$ = ")"
endfunction
function solve_segment(i, oa$, ob$)
pos = i
repeat
`increase position along array and get its operator value
inc pos
s$ = e(pos).o
`if operator is what we want, perform operation and pull out previous and next slots
if e(pos).o = oa$ or e(pos).o = ob$
if e(pos).o = "^" then e(pos).v = e(pos-1).v ^ e(pos+1).v
if e(pos).o = "*" then e(pos).v = e(pos-1).v * e(pos+1).v
if e(pos).o = "/" then e(pos).v = e(pos-1).v / e(pos+1).v
if e(pos).o = "+" then e(pos).v = e(pos-1).v + e(pos+1).v
if e(pos).o = "-" then e(pos).v = e(pos-1).v - e(pos+1).v
if e(pos).o = "/" and e(pos+1).v = 0 then error_msg$ = "Error: Divide by zero"
e(pos).o = ""
eliminate_slot(pos+1)
eliminate_slot(pos-1)
dec pos `position along array is dec'd because previous position was just pulled out
endif
until s$ = ")"
endfunction
function add_slot(pos_add, add$)
for pos = 255 to pos_add step -1
e(pos).o = e(pos-1).o
e(pos).v = e(pos-1).v
next pos
e(pos_add).o = add$
e(pos_add).v = 0.0
endfunction
function eliminate_slot(pos_remove)
for pos = pos_remove to 254
e(pos).o = e(pos+1).o
e(pos).v = e(pos+1).v
next pos
endfunction
function set_pi_and_e_values()
for i = 0 to 255
if e(i).o = "p" then e(i).o = "": e(i).v = 3.1415927
if e(i).o = "e" then e(i).o = "": e(i).v = 2.7182818
if e(i).o = "a" then e(i).o = "": e(i).v = answer#
next i
endfunction
function set_x_value(xval#)
for i = 0 to 255
if e(i).o = "x" then e(i).o = "": e(i).v = xval#
next i
endfunction
function set_y_value(yval#)
for i = 0 to 255
if e(i).o = "y" then e(i).o = "": e(i).v = yval#
next i
endfunction
function add_implicit_a()
if e(1).o = "+" or e(1).o = "-" or e(1).o = "*" or e(1).o = "/" or e(1).o = "^"
add_slot(1, "a")
endif
set_pi_and_e_values()
endfunction
function add_implicit_multiplications()
for i = 1 to 255
if e(i).o = "(" or e(i).o = "s" or e(i).o = "c" or e(i).o = "t" or e(i).o = "r" or e(i).o = "p" or e(i).o = "b" or e(i).o = "a" or e(i).o = "e" or e(i).o = "x" or e(i).o = "y"
if e(i-1).o = "" or e(i-1).o = ")" or e(i-1).o = "!" or e(i-1).o = "p" or e(i-1).o = "e" or e(i-1).o = "a" or e(i-1).o = "x" or e(i-1).o = "y"
add_slot(i, "*")
endif
endif
if e(i).o = ")" or e(i).o = "!"
if e(i+1).o = "" or e(i).o = "s" or e(i).o = "c" or e(i).o = "t" or e(i).o = "r" or e(i).o = "p" or e(i).o = "b" or e(i).o = "a" or e(i).o = "e" or e(i).o = "x" or e(i).o = "y"
add_slot(i+1, "*")
endif
endif
if e(i).o = ""
if e(i-1).o = "p" or e(i-1).o = "e" or e(i-1).o = "a" or e(i-1).o = ")" or e(i-1).o = "x" or e(i-1).o = "y"
add_slot(i, "*")
endif
endif
next i
endfunction
function check_for_brackets_error()
for i = 0 to 255
if e(i).o = "(" and e(i+1).o = ")" then error_msg$ = "Error: empty brackets" : uh_oh = 1
next i
for i = 0 to 255
if e(i).o = "(" then inc count_start_brackets
if e(i).o = ")" then inc count_end_brackets
next i
if count_start_brackets <> count_end_brackets then error_msg$ = "Error: Start brackets don't match end brackets" : uh_oh = 1
endfunction uh_oh
REM Line input functions
function get_user_float(msg$)
wait_until_enter_not_pressed()
sync off
cls
print msg$
input ret#
sync on
sync rate 60
endfunction ret#
function get_user_integer(msg$)
wait_until_enter_not_pressed()
sync off
cls
print msg$
input ret
sync on
sync rate 60
endfunction ret
function get_user_string(msg$)
wait_until_enter_not_pressed()
sync off
cls
print msg$
input ret$
sync on
sync rate 60
endfunction ret$
REM General functions
function free_obj()
repeat
inc i
if object exist(i) = 0 then found = 1
until found
endfunction i
function emptybox(xa,ya,xb,yb)
line xa,ya,xa,yb
line xa,yb,xb,yb
line xb,yb,xb,ya
line xb,ya,xa,ya
endfunction
function wait_until_enter_not_pressed()
repeat
until returnkey() = 0
endfunction
REM Maths functions
function dist_2d(xa as float, ya as float, xb as float, yb as float)
local d as float
local dx as float
local dy as float
dx = xa - xb
dy = ya - yb
d = sqrt(dx * dx + dy * dy)
endfunction d
function bound_integer(n as integer, min as integer, max as integer)
if n < min then n = min
if n > max then n = max
endfunction n
function bound_float(n as float, min as float, max as float)
if n < min then n = min
if n > max then n = max
endfunction n
Here's some other maths projects...
Walk on a (mostly) infinite spiral. Edit lines 25 and 26 for cool effects
You need to download the .rar of the project folder because it has a 3d model and two images. exe included.
http://www.gallonstogoinc.com/qwe/spiral.rar
`REM Particles lab
REM By qwe
REM initiate isplay
sync on
sync rate 50
set image colorkey 255, 0, 255
REM Globals
global height as float
global spd as float
global dist as float
global spiral_height as float
global globaltest as float
global spiral_power as float
REM initiate camera
make camera 1
backdrop on 1
color backdrop 1, rgb(0,0,0)
set camera range 1, 0.01, 100000000.0
position camera 1, 500000.0, 70000.0, 500000.0
REM initiate level
spiral_height = 3.333
spiral_power = 1.0
` cool settings
` 0.5 0.8
` 3.33 1.0
` 1.0 1.3
load image "spiral.bmp", 1
load image "spiral2.bmp", 2
load object "spiral.x", 1
modify_y_vertices(1, 1)
set object cull 1, 0
load object "spiral2.x", 2
modify_y_vertices(2, 2)
set object cull 2, 0
load object "spiral3.x", 3
modify_y_vertices(3, 1)
set object cull 3, 0
load object "spiral4.x", 4
modify_y_vertices(4, 2)
set object cull 4, 0
REM main do loop
do
REM Display data
set cursor 0,0
ink rgb(255,255,255),0
print "FPS: "; screen fps()
print "X: "; camera position x(1)
print "Y: "; camera position y(1)
print "Z: "; camera position z(1)
REM User control
do_move()
do_look()
do_control()
REM Make player larger as he goes up spiral and smaller as he goes down
adjust_player()
sync
loop
function adjust_player()
dist = sqrt(camera position x(1)*camera position x(1) + 0.0 + camera position z(1)*camera position z(1)) ^ spiral_power
height = (dist / 10.0) + (dist / spiral_height)
spd = dist / 150.0
position camera 1, camera position x(1), height, camera position z(1)
endfunction
function do_control()
REM toggle sync rate
if keystate(74)
sync rate 5
endif
if keystate(78)
sync rate 0
endif
if keystate(156)
sync rate 50
endif
REM pt to ctr
if keystate(83)
point camera 1, 0, 0, 0
endif
endfunction
function do_move()
REM if hold LShift then go twice as fast
if keystate(42)
spd=spd*2
endif
REM move around
if keystate(17)
move camera 1, spd
endif
if keystate(31)
move camera 1, -spd
endif
if keystate(30)
position camera 1, newxvalue(camera position x(1), camera angle y(1)-90.0, spd), height, newzvalue(camera position z(1), camera angle y(1)-90.0, spd)
endif
if keystate(32)
position camera 1, newxvalue(camera position x(1), camera angle y(1)+90.0, spd), height, newzvalue(camera position z(1), camera angle y(1)+90.0, spd)
endif
endfunction
function do_look()
local mx as float
local my as float
local mousedamp as float
local cam as integer
REM var
mousedamp = 8.0
REM look around, unless right clicking
if mouseclick() > 1
show mouse
else
hide mouse
`still cursor
position mouse 500,500
`dampen amount to move
mx=mousemovex()/mousedamp
my=mousemovey()/mousedamp
`turn camera object
xrotate camera 1, wrapvalue(camera angle x(1)+my)
yrotate camera 1, wrapvalue(camera angle y(1)+mx)
`bound camera object angle
if camera angle x(1)>89 and camera angle x(1)<180 then xrotate camera 1,89
if camera angle x(1)<271 and camera angle x(1)>180 then xrotate camera 1,271
endif
endfunction
function modify_y_vertices(o, i)
local a as integer
local n as integer
local x as float
local y as float
local z as float
make mesh from object 1, o
delete object o
lock vertexdata for mesh 1
n = get vertexdata vertex count()
for a = 0 to n
x = get vertexdata position x(a)
z = get vertexdata position z(a)
y = (sqrt((x)*(x)+(z)*(z)) ^ spiral_power / spiral_height)
set vertexdata position a, x, y, z
next a
unlock vertexdata
make object o, 1, i
delete mesh 1
endfunction
View and select an area to zoom in on (indefinately) a mandelbrot fractal
REM Ini
sync on
sync rate 50
get image 1, 0, 0, 2, 2
REM Typ
type fractal
x as float `x coord
y as float `y coord
b as integer `bound by limit? y/n
t as integer `steps till reach limit (if not bound)
endtype
REM Var
global lim as float
global steps as integer
`for calculation
global Zr as float
global Zi as float
global nZr as float
global nZi as float
global Cr as float
global Ci as float
`screen
global xp as integer: xp = screen width()
global yp as integer: yp = screen height()
global screen_ratio as float: screen_ratio = xp/yp
global res as float
REM Array
DIM f(xp, yp) as fractal
REM Default Window
xa# = -2.0
xb# = 0.667
ya# = -1.0
yb# = 1.0
REM Options
lim = 2.0 ^ 2.0
steps = 100
get_mandelbrot(xa#,xb#,ya#,yb#)
do
CLS
REM Show fractal
paste image 1, 0, 0
REM Update mouse variables
oldmc = mc
mc = mouseclick()
REM Update position that mouse is at in the fractal array
x = mousex()
y = yp-(mousey() - (screen height() - yp))
REM According to position in fractal array, get coordinates of current mouse location
if x < xp and y > (screen height() - yp) and y < yp
x# = f(x,y).x
y# = f(x,y).y
endif
REM Print coordinates of where mouse is
set cursor 0,0
ink rgb(255,255,0),0
print "X Coordinate: "; x#
print "Y Coordinate: "; y#
REM If click, and previously not clicking, then start zoom-box
if oldmc = 0 and mc = 1
box_xa = mousex()
box_ya = mousey()
endif
REM if clicking and previously clicking, then continue zoombox
if oldmc = 1 and mc = 1
box_xb = mousex()
box_yb = mousey()
ink rgb(255,0,0),0
emptybox(box_xa,box_ya,box_xb,box_yb)
endif
REM if not clicking and previously clicking, then zoom in to zoombox
if oldmc = 1 and mc = 0
`get coordinates
xa# = f(box_xa,yp-(box_ya - (screen height() - yp))).x
ya# = f(box_xa,yp-(box_ya - (screen height() - yp))).y
xb# = f(box_xb,yp-(box_yb - (screen height() - yp))).x
yb# = f(box_xb,yp-(box_yb - (screen height() - yp))).y
`arrange coordinates into left,top,bottom,right of a window box
if xa# < xb# then left_x# = xa#:right_x# = xb#
if xb# < xa# then left_x# = xb#:right_x# = xa#
if ya# < yb# then left_y# = ya#:right_y# = yb#
if yb# < ya# then left_y# = yb#:right_y# = ya#
`set new window to xa xb ya yb
xa# = left_x#
xb# = right_x#
ya# = left_y#
yb# = right_y#
`get fractal at that window
get_mandelbrot(xa#,xb#,ya#,yb#)
endif
sync
loop
end
function get_mandelbrot(xa as float,xb as float,ya as float,yb as float)
REM Make array
window_ratio# = abs(xa - xb) / abs(ya - yb)
`resolution depends on y length (unless screen ratio X:Y is less than window ratio X:Y)
res = abs(ya - yb) / screen height()
if screen_ratio < window_ratio#
res = abs(xa - xb) / screen width()
endif
`set how far we will go on array depending on resolution
xp = int(abs(xa - xb) / res)
yp = int(abs(ya - yb) / res)
`just in case
if xp > screen width() then xp = screen width()
if yp > screen height() then yp = screen height()
REM Set array, get fractal
for x = 0 to xp-1
for y = 0 to yp-1
REM Set x,y coordinates
f(x,y).x = ((x + 0.0) * res) + xa
f(x,y).y = ((y + 0.0) * res) + ya
REM Get fractal
calculate_bound(x,y)
next y
cls : paste image 1,0,0 : print int(((x+0.0)/(xp+0.0))*100.0); "% complete" : sync
next x
REM Get and save fractal image
create bitmap 1, screen width(), screen height()
set current bitmap 1
ink rgb(0,0,0),0
box 0,0,xp-1, yp-1
for x = 0 to xp-1
for y = 0 to yp-1
if f(x,y).b = 0
p# = (f(x,y).t+0.0)/100.0
cr=p#*255
cg=p#*255
cb=p#*255
ink rgb(cr,cg,cb),0
box x, y, x+1, y+1
endif
if f(x,y).b = 1
endif
next y
next x
flip bitmap 1
make memblock from bitmap 1, 1
delete bitmap 1
if image exist(1) then delete image 1
make image from memblock 1, 1
delete memblock 1
set current bitmap 0
endfunction
function calculate_bound(a,b)
f(a,b).b = 1
f(a,b).t = 0
Zr = f(a,b).x
Zi = f(a,b).y
Cr = Zr
Ci = Zi
repeat
inc n
if n = steps then stop = 1
nZr = Zr*Zr - Zi*Zi + Cr
nZi = 2.0*Zr*Zi + Ci
Zr = nZr
Zi = nZi
inc f(a,b).t
if (Zr*Zr - Zi*Zi) > lim
stop = 1
f(a,b).b = 0
endif
until stop = 1
endfunction
function emptybox(xa,ya,xb,yb)
line xa,ya,xa,yb
line xa,yb,xb,yb
line xb,yb,xb,ya
line xb,ya,xa,ya
endfunction
Here's a calculator and graphing calculator in case you dont have a TI83 at hand
remstart
Maths parser! (,), *, /, +, -, p[i], e, s[in], c[os], t[an], sq[r]t, a[b]s
by qwe
remend
REM types
type equations
v as float
o as string
endtype
REM arrays
dim e(256) as equations
REM global variables
global error_msg$ = ""
global answer# = 0.0
global option_display_steps = 1
global x_value# = 0.0
REM cut straight to plotter
`gosub graphing
gosub clear
REM MAIN DO LOOP
do
ink rgb(0,255,128),0
previous_equation$ = equation$
input "Enter equation: ", equation$
if equation$ = "" then equation$ = previous_equation$
if equation$ = "help" then gosub help : equation$ = "no solve"
if equation$ = "plot" then use_same_stats = 0 : gosub graphing : equation$ = "clear"
if equation$ = "clear" then gosub clear : equation$ = "no solve"
if equation$ <> "no solve"
error_msg$ = ""
answer# = get_answer("("+equation$+")", 0)
ink rgb(0,255,255),0
print "The answer is : " + str$(answer#)
ink rgb(255,0,0),0
if error_msg$ <> "" then print error_msg$
print
endif
loop
end
clear:
CLS
REM instructions
ink rgb(255,64,64),0
print "Maths parser by qwe"
print "Handles (, ), *, /, +, -, !, [p]i, [e], [s]in, [c]os, [t]an, sq[r]t, a[b]s, [E]"
ink rgb(255,255,128),0
print "Type 'help' for help"
print "Type 'plot' for graphing"
print "Type 'clear' to clean screen"
print "Type in an equation to solve it. Use '`' for negative symbol"
print
return
help:
ink rgb(255,128,255),0
print "Type in an equation and press enter to see the answer"
print "Valid characters are: (, ), +, -, *, /, ^, !"
print "'p' is treated as pi, 'e' is treated as e, '`' is the negative symbol"
print "'s' 'c' 't' and 'r' are treated as sine, cosine, tangent, and square root"
print " - They can be entered as r(#), r(equation), or r# ( e.g. r(4), r(3+1), r4 )"
print "'a' is treated as the previous answer, 'b' as absolute value, 'E' as sci. not."
print
print "'help' brings up this menu. 'plot' brings up the graphing utility"
print
return
function get_answer(e$, option_replace_x)
REM set variables
length = len(e$)
array_count = 0
REM clear array
for i = 0 to 255
e(i).o = ""
e(i).v = 0.0
next i
REM translate string equation into array
for i = 1 to length
s$ = mid$(e$, i)
if s$="(" or s$=")" or s$="+" or s$="-" or s$="*" or s$="/" or s$="^" or s$="p" or s$ = "e" or s$ = "s" or s$ = "c" or s$ = "t" or s$ = "r" or s$ = "a" or s$ = "b" or s$ = "x" or s$ = "!" or s$ = "E"
if add_value$ = ""
else
e(array_count).v = val(add_value$)
add_value$ = ""
inc array_count
endif
e(array_count).o = s$
inc array_count
else
if s$ = "`" then s$ = "-"
add_value$ = add_value$ + s$
if mid$(e$, i+1) = "(" and add_value$ = "-" then add_value$ = "-1"
endif
next i
REM special features
add_implicit_multiplications()
set_pi_and_e_values()
if option_replace_x = 1 then set_x_value()
add_implicit_a()
uh_oh = check_for_brackets_error()
if uh_oh = 1 then exitfunction 0.0
REM find out how many bracketed sections there are
for i = 0 to 255
if e(i).o = "(" then total_brackets = total_brackets + 1
next i
REM solve each level of brackets
if total_brackets > 0
for lvl = total_brackets to 1 step -1
display_equation_array()
length = solve_level(lvl)
next lvl
endif
REM give answer, store answer in global variable
localanswer#=e(0).v
answer#=e(0).v
endfunction localanswer#
function display_equation_array()
ink rgb(192,192,192),0
done=0
pos = 0
repeat
`see what brakcet level computer is at
if e(pos).o = "(" then inc bracket_level
if e(pos).o = ")" then dec bracket_level
`once reaches last bracket, no more no more
if bracket_level = 0 then done = 1
`add each array element to string
if e(pos).o = ""
display$ = display$ + str$(e(pos).v)
else
display$ = display$ + e(pos).o
endif
inc pos
until done=1
`take off first and last brackets
length = len(display$)
display$ = left$(display$, length-1)
display$ = right$(display$, length-2)
`display string
if option_display_steps = 1
print display$
endif
endfunction
function solve_level(lvl)
for i = 0 to 255
if e(i).o = "(" then inc count_brackets
`when computer comes to specified level
if count_brackets = lvl
`do operations
solve_factorial(i)
solve_sci_not(i)
solve_special(i, "s")
solve_special(i, "c")
solve_special(i, "t")
solve_special(i, "r")
solve_special(i, "b")
solve_segment(i, "^", "{")
solve_segment(i, "*", "/")
solve_segment(i, "-", "+")
`now the segment is simplified to one value
`now we can eliminate brackets around this value
e(i).v = e(i+1).v
e(i).o = ""
eliminate_slot(i+1)
eliminate_slot(i+1)
dec count_brackets
endif
next i
endfunction length
function solve_sci_not(i)
pos = i
repeat
`increase position along array and get its operator value
inc pos
s$ = e(pos).o
`if operator is what we want, perform operation and pull out previous and next slots
if e(pos).o = "E"
e(pos).v = e(pos-1).v * (10.0 ^ e(pos+1).v)
e(pos).o = ""
eliminate_slot(pos+1)
eliminate_slot(pos-1)
dec pos
endif
until s$ = ")"
endfunction
function solve_factorial(i)
pos = i
repeat
`increase position along array and get its operator value
inc pos
s$ = e(pos).o
`if operator is what we want, perform operation and pull out previous and next slots
if e(pos).o = "!"
e(pos).v = factorial(e(pos-1).v)
e(pos).o = ""
eliminate_slot(pos-1)
dec pos
endif
until s$ = ")"
endfunction
function log(nr#, acc)
result# = 0.00
for c = 0 to acc
repeat
inc result#, 10.0^(c*-1)
until 10.0^result# >= nr#
if 10.0^result# = nr#
exitfunction result#
else
dec result#, 10.0^(c*-1)
endif
next c
endfunction result#
function factorial(num#)
ans# = 1.0
for i = 1 to num#
ans# = ans# * i
next i
endfunction ans#
function solve_special(i, o$)
pos = i
repeat
`increase position along array and get its operator value
inc pos
s$ = e(pos).o
`if operator is what we want, perform operation and pull out previous and next slots
if e(pos).o = o$
if o$ = "s" then e(pos).v = sin(e(pos+1).v)
if o$ = "c" then e(pos).v = cos(e(pos+1).v)
if o$ = "t" then e(pos).v = tan(e(pos+1).v)
if o$ = "r" then e(pos).v = sqrt(e(pos+1).v)
if o$ = "b" then e(pos).v = abs(e(pos+1).v)
eliminate_slot(pos+1)
e(pos).o = ""
endif
until s$ = ")"
endfunction
function solve_segment(i, oa$, ob$)
pos = i
repeat
`increase position along array and get its operator value
inc pos
s$ = e(pos).o
`if operator is what we want, perform operation and pull out previous and next slots
if e(pos).o = oa$ or e(pos).o = ob$
if e(pos).o = "^" then e(pos).v = e(pos-1).v ^ e(pos+1).v
if e(pos).o = "*" then e(pos).v = e(pos-1).v * e(pos+1).v
if e(pos).o = "/" then e(pos).v = e(pos-1).v / e(pos+1).v
if e(pos).o = "+" then e(pos).v = e(pos-1).v + e(pos+1).v
if e(pos).o = "-" then e(pos).v = e(pos-1).v - e(pos+1).v
if e(pos).o = "/" and e(pos+1).v = 0 then error_msg$ = "Error: Divide by zero"
e(pos).o = ""
eliminate_slot(pos+1)
eliminate_slot(pos-1)
dec pos `position along array is dec'd because previous position was just pulled out
endif
until s$ = ")"
endfunction
function add_slot(pos_add, add$)
for pos = 255 to pos_add step -1
e(pos).o = e(pos-1).o
e(pos).v = e(pos-1).v
next pos
e(pos_add).o = add$
e(pos_add).v = 0.0
endfunction
function eliminate_slot(pos_remove)
for pos = pos_remove to 254
e(pos).o = e(pos+1).o
e(pos).v = e(pos+1).v
next pos
endfunction
function set_pi_and_e_values()
for i = 0 to 255
if e(i).o = "p" then e(i).o = "": e(i).v = 3.1415927
if e(i).o = "e" then e(i).o = "": e(i).v = 2.7182818
if e(i).o = "a" then e(i).o = "": e(i).v = answer#
next i
endfunction
function set_x_value()
for i = 0 to 255
if e(i).o = "x" then e(i).o = "": e(i).v = x_value#
next i
endfunction
function add_implicit_a()
if e(1).o = "+" or e(1).o = "-" or e(1).o = "*" or e(1).o = "/" or e(1).o = "^"
add_slot(1, "a")
endif
set_pi_and_e_values()
endfunction
function add_implicit_multiplications()
for i = 1 to 255
if e(i).o = "(" or e(i).o = "s" or e(i).o = "c" or e(i).o = "t" or e(i).o = "r" or e(i).o = "p" or e(i).o = "b" or e(i).o = "a" or e(i).o = "e" or e(i).o = "x"
if e(i-1).o = "" or e(i-1).o = ")" or e(i-1).o = "!" or e(i-1).o = "p" or e(i-1).o = "e" or e(i-1).o = "a" or e(i-1).o = "x"
add_slot(i, "*")
endif
endif
if e(i).o = ")" or e(i).o = "!"
if e(i+1).o = "" or e(i).o = "s" or e(i).o = "c" or e(i).o = "t" or e(i).o = "r" or e(i).o = "p" or e(i).o = "b" or e(i).o = "a" or e(i).o = "e" or e(i).o = "x"
add_slot(i+1, "*")
endif
endif
if e(i).o = ""
if e(i-1).o = "p" or e(i-1).o = "e" or e(i-1).o = "a" or e(i-1).o = ")" or e(i-1).o = "x"
add_slot(i, "*")
endif
endif
next i
endfunction
function check_for_brackets_error()
for i = 0 to 255
if e(i).o = "(" and e(i+1).o = ")" then error_msg$ = "Error: empty brackets" : uh_oh = 1
next i
for i = 0 to 255
if e(i).o = "(" then inc count_start_brackets
if e(i).o = ")" then inc count_end_brackets
next i
if count_start_brackets <> count_end_brackets then error_msg$ = "Error: Start brackets don't match end brackets" : uh_oh = 1
endfunction uh_oh
function emptybox(xa,ya,xb,yb)
line xa,ya,xa,yb
line xa,yb,xb,yb
line xb,yb,xb,ya
line xb,ya,xa,ya
endfunction
graphing:
CLS
REM Get window stats
if use_same_stats = 0
ink rgb(128,255,128),0
print "Press enter 7 times to leave default and just enter equation"
print
ink rgb(255,255,128),0
print "Default window size is 400 pixels"
print
ink rgb(192,192,128),0
input "Enter window x size (pixels): ", x_pixel_size : if x_pixel_size = 0 then x_pixel_size = 400
input "Enter window y size (pixels): ", y_pixel_size : if y_pixel_size = 0 then y_pixel_size = 400
print
ink rgb(255,255,128),0
print "Default value for window x/y unit size is 20 (-10 to 10) on each axis"
print
ink rgb(192,192,128),0
input "Enter window X size in units: ", x_max# : x_max# = x_max# / 2.0 : if x_max# = 0 then x_max# = 10
input "Enter window Y size in units: ", y_max# : y_max# = y_max# / 2.0 : if y_max# = 0 then y_max# = 10
print
input "Enter x grid value (enter for none): ", grid_x#
input "Enter y grid value (enter for none): ", grid_y#
print
input "Connect dots of grid? (0 or 1): ", option_connect
print
endif
ink rgb(128,255,128),0
input "Enter equation: ", equation$
CLS
sync on
REM get some variables
x_min# = -1 * x_max#
y_min# = -1 * y_max#
total_x_unit_size# = abs(x_min#) + x_max#
total_y_unit_size# = abs(y_min#) + y_max#
option_display_steps = 0
winxpos = 320 - x_pixel_size/2
winypos = 240 - y_pixel_size/2
REM draw window
if grid_x# > 0.001
`draw x grid
ink rgb(64,64,64),0
x_ratio# = grid_x# / total_x_unit_size#
x_interval# = x_ratio# * (x_pixel_size + 0.0)
current_x# = 0.0
repeat
line int(current_x#) + winxpos, 0 + winypos, int(current_x#) + winxpos, y_pixel_size + winypos
inc current_x#, x_interval#
until int(current_x#) > x_pixel_size
endif
if grid_y# > 0.001
`draw y grid
ink rgb(64,64,64),0
y_ratio# = grid_y# / total_y_unit_size#
y_interval# = y_ratio# * (y_pixel_size + 0.0)
current_y# = 0.0
repeat
line 0 + winxpos, int(current_y#) + winypos, x_pixel_size + winxpos, int(current_y#) + winypos
inc current_y#, y_interval#
until int(current_y#) > y_pixel_size
endif
`draw border
ink rgb(255,255,255),0
emptybox(0 + winxpos,0 + winypos,x_pixel_size + winxpos,y_pixel_size + winypos)
`draw x and y axis
ink rgb(192,192,192),0
line 0 + winxpos, y_pixel_size/2 + winypos, x_pixel_size + winxpos, y_pixel_size/2 + winypos
line x_pixel_size/2 + winxpos, 0 + winypos, x_pixel_size/2 + winxpos, y_pixel_size + winypos
`get plot stats to display
length_msg$ = str$(x_min#) + " <-> " + str$(x_max#)
height_msg$ = str$(y_min#) + " <-> " + str$(y_max#)
error_msg$ = ""
previous_x = 0
previous_y = 0
REM Draw each x,y coordinate
for x_pixel = 1 to x_pixel_size
`find which x value in units we're to solve for
x_unit# = (x_pixel + 0.0) / (x_pixel_size + 0.0)
x_unit# = x_unit# * (total_x_unit_size# + 0.0)
x_unit# = x_unit# + (x_min# + 0.0)
`find y value in units
x_value# = x_unit#
y_unit# = get_answer("("+equation$+")", 1)
`find y value in pixels
y_pixel# = y_unit# * -1.0
y_pixel# = y_pixel# / (total_y_unit_size#)
y_pixel# = y_pixel# * (y_pixel_size + 0.0)
y_pixel# = y_pixel# + ((y_pixel_size + 0.0) / 2.0)
y_pixel = y_pixel#
`draw point
if x_pixel = 1 then previous_x = x_pixel: previous_y = y_pixel
if y_pixel < y_pixel_size
if option_connect
ink rgb(255,255,128),0
line x_pixel + winxpos, y_pixel + winypos, previous_x + winxpos, previous_y + winypos
else
dot x_pixel + winxpos, y_pixel + winypos, rgb(255,255,128)
endif
endif
previous_x = x_pixel
previous_y = y_pixel
next x
` cover up line if it went outside of graph
ink rgb(32,32,32),0
box 0, y_pixel_size + winypos + 1, 640, 480
box 0, 0, 640, winypos
box 0, 0, winxpos, 480
box winxpos + x_pixel_size + 1, 0, 640, 480
` show graph stats
ink rgb(128,255,128),0
center text x_pixel_size/2 + winxpos, y_pixel_size + winypos, length_msg$
center text x_pixel_size + 50 + winxpos, y_pixel_size/2 + winypos, height_msg$
ink rgb(255,255,255),0
center text x_pixel_size/2 + winxpos, y_pixel_size + 50 + winypos, equation$
ink rgb(255,64,64),0
if error_msg$ <> "" then center text x_pixel_size/2 + winxpos, y_pixel_size + 100 + winypos, error_msg$
ink rgb(0,255,255),0
center text x_pixel_size/2 + winxpos, winypos - 40, "[RShift] returns to equation solver"
center text x_pixel_size/2 + winxpos, winypos - 28, "[] runs grapher again"
center text x_pixel_size/2 + winxpos, winypos - 16, "[Backspace] runs grapher keeping same window stats"
sync
sync off
done=0
redo_grapher=0
use_same_stats=0
repeat
if keystate(54) then done=1
if keystate(43) then done=1: redo_grapher=1
if keystate(14) then done=1: redo_grapher=1: use_same_stats=1
until done=1
if redo_grapher then gosub graphing
if redo_grapher_same_stats then gosub graphing
option_display_steps = 1
gosub clear
return
Heres a Henon map generator. tiny program but it could be modified to model other chaotic particle systems
REM Ini
sync on
sync rate 60
REM Typ
type xy
x as float
y as float
endtype
REM Var
global a as float : a = 1.4
global b as float : b = 0.3
global y as float
global x as float
global oldy as float
global oldx as float
global minx as float
global miny as float
global maxx as float
global maxy as float
REM Set
DIM a(1000) as xy
for n = 0 to 1000
oldx = x
oldy = y
x = oldy + 1 - a * oldx ^ 2.0
y = b * oldx
if x < minx then minx = x
if x > maxx then maxx = x
if y < miny then miny = y
if y > maxy then maxy = y
a(n).x = x
a(n).y = y
next n
n = 0
REM Main
do
inc n
dot a(n).x * 100.0 + 128, a(n).y * 100.0 + 38
wait key
sync
loop
