%Created by Adam Bielinski
%this is the basic engine for Bielin_Forces
%this was written early in my learning of turing, so it's messy and not commented
% --------------------------------
%the conrols are: Spacebar, z, x, c, and all the mouse buttons
% -------------------------------
%try it out! see what you can do!
View.Set ("nocursor")
View.Set ("noecho")
Mouse.ButtonChoose ("multibutton")
setscreen ("graphics:800;600")
drawline (1, 1, 1, 1, black)
View.Set ("offscreenonly")
var back_color : int := black
%Change either of these to a lower number if you're getting a slowdown
const NUM_SPKL := 500 %this is the max number of sparkles
const SPKL_RATIO := 10 %this is how many sparkles are made by clicking
const SPKL_LIFE := 2500
drawfillbox (-10, -10, 810, 610, back_color) %erases the screen
const AIR_RES := 1.05 %how fast the sparkles slow down (make it less than 1 to make them speed up!)
const SPKL_GRAV := -0.94 %how fast they accelerate in th y plane
const EXPL_FORCE := 600 %something to do with how powerful the World_Force procedure is.... hmm...
type vector :
record
x : real
y : real
x_vel : real
y_vel : real
life : int
clr : int
end record
var cur_spkl : int := 1
var spkl : array 1 .. NUM_SPKL of vector
for lp : 1 .. NUM_SPKL
spkl (lp).x := 0
spkl (lp).y := 0
spkl (lp).x_vel := 0
spkl (lp).y_vel := 0
spkl (lp).life := SPKL_LIFE
end for
var global_clr : int := white
procedure Draw_Spkl (num, colour : int)
%drawfilloval (round (spkl (num).x), round (spkl (num).y), 3, 3, colour)
var dir_x, dir_y, dist : real := 0
dist := sqrt (spkl (num).x_vel ** 2 + spkl (num).y_vel ** 2)
if dist ~= 0 then
dir_x := ((spkl (num).x_vel / dist * 10) + spkl (num).x_vel)
dir_y := ((spkl (num).y_vel / dist * 10) + spkl (num).y_vel)
end if
drawline (round (spkl (num).x), round (spkl (num).y),
round (spkl (num).x - dir_x), round (spkl (num).y - dir_y), colour)
end Draw_Spkl
procedure Run_Sparkle
for lp : 1 .. NUM_SPKL by 1
if spkl (lp).life < SPKL_LIFE then % if the sparkle needs processing, process it
%Draw_Spkl (lp, back_color)
spkl (lp).life += 1 %decrease the life of the sparkle
spkl (lp).y_vel := (spkl (lp).y_vel + SPKL_GRAV) / AIR_RES
spkl (lp).x_vel := spkl (lp).x_vel / AIR_RES
spkl (lp).y := (spkl (lp).y + spkl (lp).y_vel)
spkl (lp).x := (spkl (lp).x + spkl (lp).x_vel)
if spkl (lp).y < -50 then
spkl (lp).life := SPKL_LIFE
end if
if spkl (lp).life < SPKL_LIFE then
Draw_Spkl (lp, spkl (lp).clr)
end if
else
%do nothing
end if
end for
end Run_Sparkle
function SpklCount : int %how many sparkles are alive?
var temp1 : int := 1
for lp : 1 .. NUM_SPKL by 1
if spkl (lp).life < SPKL_LIFE then
temp1 += 1
else
%do nothing
end if
end for
result temp1
end SpklCount
procedure Mk_Spkl (x1, y1 : real) %make a sparkle at a point in a random direction
var angle : real
var mag : real
if cur_spkl > NUM_SPKL then
cur_spkl := 1
end if
Draw_Spkl (cur_spkl, back_color)
spkl (cur_spkl).clr := global_clr
spkl (cur_spkl).life := 1
spkl (cur_spkl).x := x1
spkl (cur_spkl).y := y1
angle := Rand.Int (1, 360)
mag := Rand.Int (1, 120) / 10
spkl (cur_spkl).x_vel := mag * cosd (angle)
spkl (cur_spkl).y_vel := mag * sind (angle) + 5
%this gives the sparkles a shot upwards
cur_spkl += 1
end Mk_Spkl
procedure Mk_Spkl_Custom (x1, y1, x2, y2 : real) %make a sparkle at a point going in a specific direction with a specific speed
if cur_spkl > NUM_SPKL then
cur_spkl := 1
end if
Draw_Spkl (cur_spkl, back_color)
spkl (cur_spkl).clr := global_clr
spkl (cur_spkl).life := 1
spkl (cur_spkl).x := x1
spkl (cur_spkl).y := y1
spkl (cur_spkl).x_vel := x2
spkl (cur_spkl).y_vel := y2
%this gives the sparkles a shot upwards
cur_spkl += 1
end Mk_Spkl_Custom
procedure World_Force (h1, v1 : int, num : real)
%this forces ALL sparkles using gravity (or colomb's law, whichever you want)
%this is a horrible medly of math X(
%it could Easily be simplified, but it works, and i don't feel like it lol
var dist : real
for lp : 1 .. NUM_SPKL
dist := sqrt ((spkl (lp).x - h1) ** 2 + (spkl (lp).y - v1) ** 2)
if round (spkl (lp).x) not= h1 then
spkl (lp).x_vel += ((spkl (lp).x - h1) / ((dist ** 2) /
EXPL_FORCE)) * (num / 30)
end if
if round (spkl (lp).y) not= v1 then
spkl (lp).y_vel += ((spkl (lp).y - v1) / ((dist ** 2) /
EXPL_FORCE)) * (num / 30)
end if
end for
end World_Force
%general var declarations
var mouse_x, mouse_y, button, left, middle, right : int
var last_time : real
var chars : array char of boolean
var key_press_temp : int := 0
last_time := Time.Elapsed
% MAIN LOOOOOOP
loop
key_press_temp -= 1 %this var controls if you can press a key
if key_press_temp < 0 then
key_press_temp := 0
end if
Mouse.Where (mouse_x, mouse_y, button)
Input.KeyDown (chars)
if chars (' ') and key_press_temp <= 0 then %if spacebar is pressed, change the backround color, and fill the screen
if back_color = black then
back_color := white
else
back_color := black
end if
drawfillbox (-10, -10, 810, 610, back_color)
key_press_temp := 20
end if
if chars ('z') and key_press_temp <= 0 then %make a line of sparkels
for lp : 1 .. 800 by 20
Mk_Spkl_Custom (lp, 600, 0, -10)
end for
key_press_temp := 5
end if
if chars ('x') or chars ('p') then %re randomize the color
global_clr += 1
global_clr := (global_clr - 1) mod 102 + 1
end if
if chars ('c') and key_press_temp <= 0 then %make the fireworks random
key_press_temp := round ((Rand.Real * 6) ** 2)
const original_clr := global_clr
case Rand.Int (1, 9) of %get a random color for the sparkle
label 1 :
global_clr := brightred
label 2 :
global_clr := brightblue
label 3 :
global_clr := brightgreen
label 4 :
global_clr := 31 %white
label 5 :
global_clr := 72 %green
label 6 :
global_clr := yellow
label 7 :
global_clr := 66 %orange
label 8 :
global_clr := 11 %lightblue
%this is incase there isn't one that fits
label :
global_clr := 59 %purple
end case
const temp_x := Rand.Int (50, 750) %get a random point
const temp_y := Rand.Int (150, 600)
%these are the points that will be used for the explosion
const expl_size := Rand.Int (15, 80)
const upwards_force := Rand.Real * 15 %how much the explosion is forces upwards
for lp : 1 .. expl_size * 2 %how many to make?
const randnum := Rand.Real
const mag := expl_size * sind (randnum * 360) * cosd (randnum * 360)
const angle := Rand.Real * 360
Mk_Spkl_Custom (temp_x + Rand.Real * 5, temp_y + Rand.Real * 5,
mag * sind (angle), mag * cosd (angle) + upwards_force)
%Mk_Spkl (temp_x + Rand.Real * 5, temp_y + Rand.Real * 5)
end for
global_clr := original_clr
end if
left := button mod 10
% left = 0 or 1
middle := (button - left) mod 100
% middle = 0 or 10
right := (button - middle - left) div 100
% right = 0 or 1
if left = 1 then %make sparkles if the user is clickint
for lp : 1 .. abs (round (SPKL_RATIO))
Mk_Spkl (mouse_x, mouse_y)
end for
end if
%if mouse buttons are being pressed...
if right = 1 then
World_Force (mouse_x, mouse_y, 30)
end if
if middle = 10 then
World_Force (mouse_x, mouse_y, -30)
end if
Run_Sparkle
/* this was to find out at how many sparkles do i find a slowdown
if Time.Elapsed - last_time > 35 then
cls
put "slowdown at " + intstr (SpklCount) + " sparkles"
end if
*/
loop %this makes the frames not goo too fast (but it can still go too slow)
exit when Time.Elapsed - last_time > 30
end loop
last_time := Time.Elapsed
View.Update
% drawfillbox (-10, -10, 810, 610, back_color)
% THIS IS THE SECRET TO MY BLURRING!
% :D
for lp : 1 .. 600
drawline (Rand.Int (1, 800) * 2 - 400, Rand.Int (1, 600) * 2 - 300,
Rand.Int (1, 800) * 2 - 400,
Rand.Int (1, 600) * 2 - 300, back_color)
end for
% now you hate me, don't you? :P
end loop
|