%% Terrain Masking
View.Set ("offscreenonly,nobuttonbar,graphics:640;640")
var mask : int := Pic.FileNew ("mask.bmp")
var terrain : int
var terrainMap : array 1 .. maxx, 1 .. maxy of int
Pic.Draw (mask, 0, 0, picCopy)
for x : 1 .. maxx
for y : 1 .. maxy
if whatdotcolor (x, y) = 7 then
terrainMap (x, y) := 1
else
terrainMap (x, y) := 0
end if
end for
end for
Pic.Free (mask)
cls
for x : 1 .. maxx
for y : 1 .. maxy
if terrainMap (x, y) = 1 then
drawdot (x, y, green)
else
drawdot (x, y, 7)
end if
end for
end for
terrain := Pic.New (0, 0, maxx, maxy)
View.Update
var pic : int := Pic.FileNew ("face3.bmp")
class Particle
import terrainMap
export Init, ResetTo, Run, life, Erase
const g := -0.098
var x, y, rx, ry, vx, vy, rvx, rvy, life, maxLife : real
proc Randomize
vx := (Rand.Int (1, 1) * Rand.Real) / 5
vy += Rand.Real
end Randomize
proc Init (X, Y, VX, VY, LIFE : real)
x := X
y := Y + (Rand.Int (-1, 1) * Rand.Real * 5)
vx := VX
vy := VY
maxLife := LIFE
life := LIFE - Rand.Int (0, round (maxLife))
rx := X
ry := Y + (Rand.Int (-1, 1) * Rand.Real * 5)
rvx := VX
rvy := VY
Randomize
end Init
proc ResetTo (X, Y : real)
x := X
y := Y
vx := rvx
vy := rvy
life := maxLife - Rand.Int (0, round (maxLife))
Randomize
end ResetTo
proc Erase
drawdot (round (x), round (y), black)
end Erase
const r := 3
proc Run
var x0, y0 : int
vy += g
x0 := round (x + vx)
y0 := round (y + vy)
if x0 > 1 and x0 < maxx and y0 > 1 and y0 < maxy then
if terrainMap (x0, y0) = 1 then
vy -= (vy / 2)
vy := -vy
life -= 1
vx += Rand.Int (-1, 1) * Rand.Real
vy += Rand.Real
else
x += vx
y += vy
end if
end if
drawdot( round (x), round (y), 0)
end Run
end Particle
const maxP := 100
const maxLife := 2
var main : array 1 .. maxP of ^Particle
for i : 1 .. maxP
new main (i)
main (i) -> Init (maxx div 1.5, maxy - 100, 0, -3, maxLife)
end for
var x, y, z : int
loop
mousewhere (x, y, z)
for i : 1 .. maxP
main (i) -> Run
if main (i) -> life <= 0 then
main (i) -> ResetTo (x, y)
end if
end for
View.Update
Pic.Draw (terrain, 0, 0, picCopy)
end loop |