All pastes #38166 Raw Edit

Someone

public text v1 · immutable
#38166 ·published 2006-01-23 12:35 UTC
rendered paste body
View.Set ("graphics:max,max")

% Constants, Fonts & Pictures
const newtonGravConst := 6.6723e-11                                % The Newtonian Gravitational Constant
const shipWeight := 3
const maxSpeed := 15
var planetSizes : array 1 .. 4 of int := init (10, 20, 40, 55)
var planetWeights : array 1 .. 4 of real := init (3.3e23, 4.87e24, 5.97e24, 5.68e26)
var planetCols : array 1 .. 4 of int := init (red, blue, green, 42)
var mx, my, mb : int := 13
var gameOver : boolean := false

% The Planet Class :)
class planet
    import newtonGravConst, shipWeight
    export initialize, describe, drawPlanet, calcAttraction, hitTest                                     % Export functions for use in the game

    % Declare the planet variables
    var x, y, size, col : int
    var weight : real

    proc initialize (planX, planY, planSize, planCol : int, planWeight : real)
        x := planX
        y := planY
        size := planSize
        col := planCol
        weight := planWeight
    end initialize

    proc drawPlanet
        drawfilloval (x, y, size, size, col)
    end drawPlanet

    proc calcAttraction (shipX, shipY : int, var xForce, yForce : int)
        var angle : int
        var mag, distance : real
        distance := sqrt ((shipX - x) ** 2 + (shipY - y) ** 2)
        mag := newtonGravConst * weight * shipWeight / (distance * 1000) ** 2
        locate (1, 1)
        put mag
        if shipX not= x then
            angle := round (arctand (abs (shipY - y) / abs (shipX - x)))
            xForce := round (cosd (angle) * mag)
            yForce := round (cosd (angle) * mag)
            if shipX > x then
                xForce *= -1
            end if
            if shipY > y then
                yForce *= -1
            end if
        end if
    end calcAttraction

    proc describe               % Temporary function, delete this later :)
        put "X: ", x
        put "Y: ", y
        put "Size: ", size
        put "Colour: ", col
    end describe

    function hitTest (shipX, shipY : int) : boolean
        var halfPlanetSize := size div 2
        if (shipX - 5 > x - halfPlanetSize and shipX + 5 < x + halfPlanetSize and shipY - 5 > y - halfPlanetSize and shipY + 5 < y + halfPlanetSize) then
            put "Hit"
            result true
        end if
        result false
    end hitTest
end planet

var planets : flexible array 0 .. 0 of pointer to planet  % Set up pointers to the Planet Class

proc initializePlanets (numPlanets : int)
    var planetNum : int

    for i : 1 .. numPlanets
        new planets, i
        new planet, planets (i)
        planetNum := Rand.Int (1, 4)
        planets (i) -> initialize (Rand.Int (100, maxx - 100), Rand.Int (100, maxy - 100), planetSizes (planetNum), planetCols (planetNum), planetWeights (planetNum))
        planets (i) -> drawPlanet
    end for
end initializePlanets

proc redrawPlanets (num : int)
    for i : 1 .. num
        planets (i) -> drawPlanet
    end for
end redrawPlanets

proc launchSS (var x, y, xSpeed, ySpeed : int, numPlanets : int)
    var startAngle, startMagnitude : int
    % Let the player move the spaceship to desired location
    loop
        mousewhere (mx, my, mb)
        drawfilloval (mx, my, 10, 10, grey)
        View.Update
        delay (15)
        redrawPlanets (numPlanets)
        exit when mb = 1
        drawfilloval (mx, my, 10, 10, black)
    end loop
    x := mx
    y := my
    delay (150)
    % Let the player determine the power
    loop
        mousewhere (mx, my, mb)
        drawfilloval (x, y, 10, 10, grey)
        drawline (x, y, mx, my, grey)
        redrawPlanets (numPlanets)
        delay (15)
        View.Update
        drawline (x, y, mx, my, black)
        exit when mb = 1
    end loop

    startMagnitude := round (sqrt (abs (mx - x) ** 2 + abs (my - y) ** 2))
    startAngle := round (arctand (abs (my - y) / abs (mx - x)))
    % Break it up into its component vectors
    if (mx < x) and (my > y) then
        xSpeed := round (cosd (startAngle) * startMagnitude) div 10
        ySpeed := round (sind (startAngle) * startMagnitude) div 10 * -1
    elsif (mx < x) and (my < y) then
        xSpeed := round (cosd (startAngle) * startMagnitude) div 10
        ySpeed := round (sind (startAngle) * startMagnitude) div 10
    elsif (mx > x) and (my < y) then
        xSpeed := round (cosd (startAngle) * startMagnitude) div 10 * -1
        ySpeed := round (sind (startAngle) * startMagnitude) div 10
    else
        xSpeed := round (cosd (startAngle) * startMagnitude) div 10 * -1
        ySpeed := round (sind (startAngle) * startMagnitude) div 10 * -1
    end if
end launchSS

proc moveSS (xSpeed, ySpeed : int, var x, y : int)
    drawfilloval (x, y, 10, 10, black)
    x += xSpeed
    y += ySpeed
    drawfilloval (x, y, 10, 10, grey)
    View.Update
    delay (15)
end moveSS

proc calcAllForces (x, y, numPlanets : int, var xSpeed, ySpeed : int)
    for i : 1 .. numPlanets
        var totalXForce, totalYForce, tempX, tempY : int := 0
        planets (i) -> calcAttraction (x, y, tempX, tempY)
        totalXForce += tempX
        totalYForce += tempY
        locate (1, 1)
        xSpeed += totalXForce div (10000 * shipWeight)
        ySpeed += totalYForce div (10000 * shipWeight)
        %put totalXForce
        if xSpeed > maxSpeed then
            xSpeed := maxSpeed
        elsif ySpeed > maxSpeed then
            ySpeed := maxSpeed
        end if
    end for
end calcAllForces


% The main program! :)
var numPlanets : int := 1
var ssXSpeed, ssYSpeed, ssX, ssY : int
drawfillbox (-20, -20, maxx + 20, maxy + 20, black)

initializePlanets (numPlanets)
launchSS (ssX, ssY, ssXSpeed, ssYSpeed, numPlanets)
loop
    if gameOver = false then
        calcAllForces (ssX, ssY, numPlanets, ssXSpeed, ssYSpeed)
        moveSS (ssXSpeed, ssYSpeed, ssX, ssY)
        if ssX <= 10 or ssX >= maxx - 10 then
            ssXSpeed *= -1
        elsif ssY <= 10 or ssY >= maxy - 10 then
            ssYSpeed *= -1
        end if
        for i : 1 .. numPlanets
            exit when planets (i) -> hitTest (ssX, ssY) = true
        end for
    end if
    exit when gameOver = true
end loop