
-----------------------------------
Jorbalax
Wed Apr 27, 2005 11:55 pm

Jorbalax's Tools/Etc
-----------------------------------
Just a couple tools/projects that I've created to help me work on a game and to get a better grasp of Turing and it's commands.


---Colour Grid---


I couldn't find a chart with all 256 color codes on it, so I made one.  Notably laggy, and some of the colors return the same value since I used the whatdotcolor command.


%Colour Codes%
%By Jorbalax%

View.Set ("graphics:max;max, nobuttonbar, offscreenonly, title:Colour Codes")
var mousex, mousey, mousebutton : int
var x, xc, y : int := 0
var xincrement := maxx div 16
var yincrement := maxy div 16
var picID: int


%Draws the grid%
for i : 0 .. 255
    Draw.FillBox (x, y, x + xincrement, y + yincrement, (i))
    x := x + xincrement
    xc := xc + 1
    if xc = 16 then
        y := y + yincrement
        xc := 0
        x := 0
    end if
end for
View.Update

%Capture the grid
picID := Pic.New (0, 0, maxx, maxy)


%Display Value depending on where mouse is.
loop
for i: 0..255
Mouse.Where (mousex, mousey, mousebutton)
if whatdotcolor (mousex, mousey )= (i) then
put (i)
View.Update
end if
cls
Pic.Draw (picID, 0, 0, picCopy)
end for
end loop





---Multi-Ball Stream---


Working with classes and procedures to produce multiple balls bouncing around the screen.   Edit the constants near the top to change Ball amount, size, and their speed (lower is faster).


%Draws a fixed amount of balls on the screen that have random colors and bounce off of walls.%

View.Set ("graphics:max;max, nobuttonbar,title:Mult-Ball Stream,  offscreenonly")

%Editable Constants%
const BALLCOUNT := 500
const BALLRADIUS := 5
const BALLSPEED := 0

class RandomCircles
    import BALLRADIUS, BALLSPEED
    export StartValues, BallDirection, BallCreate

    var cx, cy, cdirectionx, cdirectiony, iColour : int := 0
    var chars : string (1)
    
    %Starting Values for Balls (location, color, and direction)
    procedure StartValues
        randint (cx, 0+BALLRADIUS*2, maxx-BALLRADIUS*2)
        randint (cy, 0+BALLRADIUS*2, maxy-BALLRADIUS*2)
        loop
            randint (iColour, 1, 255)
            randint (cdirectionx, -5, 5)
            randint (cdirectiony, -5, 5)
            exit when cdirectionx not = 0
            exit when cdirectiony not = 0 
        end loop
    end StartValues

    %Wall collision
    procedure BallDirection
        cx := cx + cdirectionx
        cy := cy + cdirectiony
        if cx < BALLRADIUS or cx > maxx - BALLRADIUS then
            cdirectionx := -cdirectionx
        end if
        if cy < BALLRADIUS or cy > maxy - BALLRADIUS then
            cdirectiony := -cdirectiony
        end if
    end BallDirection

    %Ball Creation Procedure%
    procedure BallCreate
        Draw.FillOval (cx, cy, BALLRADIUS, BALLRADIUS, iColour)
        BallDirection
        delay (BALLSPEED)
    end BallCreate
        

end RandomCircles


%Draws all of the balls%
procedure DrawBall
    
    %Creates an array of pointers%
    var p : array 1 .. BALLCOUNT of pointer to RandomCircles
    for i : 1 .. BALLCOUNT
        new RandomCircles, p (i)
    end for

    %Produces starting values and creates each ball simultaneously%
    loop
        for i : 1 .. BALLCOUNT
            p (i) -> StartValues
        end for
        loop
            for i : 1 .. BALLCOUNT
                p (i) -> BallCreate
          
            end for
            View.Update
            cls
        end loop
    end loop
end DrawBall

%Executes%
DrawBall





---Simple Etch-a-Sketch Program---


Simple enough.  Arrow keys to move, space bar resets.


%Simple Etch-a-Sketch Program%
%By Jorbalax%
%Use arrow keys to move, space bar to clear.%
%-------------------------------------------%
View.Set ("graphics:400;300, offscreenonly, Title:Etch-a-Sketch")

const RADIUS := 3
const DCOLOR := 7
const DDISTANCE := 1
const DELAYTIME := 10

var x, y : int
var chars : array char of boolean
x := 200
y := 150

%Determines if boundaries have been reached, and acts on them (resets ball on other side)%
procedure DrawBounds
    if x > 400 then
        x := 0
    end if
    if y > 300 then
        y := 0
    end if
    if x < 0 then
        x := 400
    end if
    if y < 0 then
        y := 300
    end if
end DrawBounds

%Resets screen%
procedure Reset
    for i : 0 .. 300
        Draw.Line (0, (i), 400, (i), 7)
        View.Update
        cls
    end for
end Reset

%Determines if a key has been entered, and acts on it%
procedure KeyInput
        Input.KeyDown (chars)
        if chars (KEY_UP_ARROW) then
            y := y + DDISTANCE
        end if
        if chars (KEY_DOWN_ARROW) then
            y := y - DDISTANCE
        end if
        if chars (KEY_LEFT_ARROW) then
            x := x - DDISTANCE
        end if
        if chars (KEY_RIGHT_ARROW) then
            x := x + DDISTANCE
        end if
        if chars (' ') then
            Reset
        end if
end KeyInput

%Execution%
%----------------------------------------------%

loop
    Draw.FillOval (x, y, RADIUS, RADIUS, DCOLOR)
    View.Update
    delay (DELAYTIME)
    KeyInput
    DrawBounds
end loop



More to come, I'm sure.
[EDIT] Fixed Etch a Sketch program, I had accidently put an older version of it up.  Also changed space character like suggested.   :wink:

-----------------------------------
jamonathin
Thu Apr 28, 2005 8:24 am


-----------------------------------
Those are nice simple little progs.  I'd definately work on that color prog.

for i:1..maxcolor
color(i)
put i, " " ..
end for

And here's a little tip for your etch a sketch.  Instead of using chr(32), you can simple use.... (' '). That work for any key that inserts a character.
[ ('a') or ('t') or ('0') or (]') and so on ]

Good work though.

-----------------------------------
Shyfire
Thu Apr 28, 2005 10:36 am


-----------------------------------
screen cord finder


var keys:array char of boolean
var x,y:int:=10
loop
   drawfilloval(x,y,2,2,255) 
View.Update
   Input.KeyDown (keys)
    if keys (KEY_UP_ARROW) and whatdotcolor (x,y+5) not=255 then
        y+=1
    View.Update
        elsif keys (KEY_RIGHT_ARROW) and whatdotcolor (x+5,y) not=255  then
        x+=1
  View.Update
  elsif keys (KEY_LEFT_ARROW) and whatdotcolor (x-5,y) not =255  then
        x-=1
    View.Update
        elsif keys (KEY_DOWN_ARROW) and whatdotcolor (x,y-5) not=255  then
      y-=1
    View.Update
      
    end if
locate(1,2)
    put"x"
locate(1,6)
    put x
locate(2,2)
    put"y"
    locate(2,6)
put y
    end loop

-----------------------------------
jamonathin
Thu Apr 28, 2005 11:18 am


-----------------------------------
KISS, you can make one of those in 6 lines using mousewhere  :lol:

-----------------------------------
Jorbalax
Thu Apr 28, 2005 10:59 pm


-----------------------------------
Simpler Color Code program.  Notice the somewhat ackward location of the text on some of the circles.  I'm assuming this is because the text is auto aligned to a colum/row.  If someone knows a way to stop it from happening, please do tell.


%Colour Code Program%
%Displays all 255 colours%
View.Set ("graphics:max;max, nobuttonbar,title:Colour Codes)")

var x, y, RADIUS: int :=0
RADIUS := 100

%Auto-adjusts radius size to screen
loop
if RADIUS*RADIUS*2 > maxx or RADIUS*RADIUS*2 > maxy then
    RADIUS -=1
end if
exit when RADIUS*RADIUS*2 < maxx or RADIUS*RADIUS*2 < maxy
end loop

x:=0 + RADIUS
y:=maxy - RADIUS

%Draws circles and places number
for i:0..maxcolor 
color(i) 
Draw.FillOval (x, y, RADIUS, RADIUS, i)
locatexy (x, y)
color (black)
put (i)
if x = (maxx - RADIUS * 3) or  x > (maxx - RADIUS * 3) then
y:= y - RADIUS*2
x:=0 + RADIUS
else 
x:=x + RADIUS*2
end if
end for

-----------------------------------
prdukt
Mon May 23, 2005 7:59 pm


-----------------------------------
Nice Work ;)

-----------------------------------
Jorbalax
Wed Jun 01, 2005 5:27 pm


-----------------------------------
Ah, I've been busy.  Let's start with my newer, MUCH better, color grid.

---Colour Grid V2---

Again, uses whatdotcolor to determine color, so some values will return the same (7 and 248, for example).


%Colour Grid V2%
%By Jorbalax% 

View.Set ("graphics:max;max, nobuttonbar, title:Color Grid V2")
const BOXSIZE := 20 %Determine size of color boxes
var x, y, button : int %Mouse variables
var cx, cy, clr : int

%start locations%
cx := 30 
cy := maxy - 30

%create grid
for i : 0 .. 255
    drawfillbox (cx - BOXSIZE, cy - BOXSIZE, cx + BOXSIZE, cy + BOXSIZE, i)
    cx += BOXSIZE * 2 + 5
    if cx + BOXSIZE >= maxx then
        cx := 30
        cy -= BOXSIZE * 2 + 5
    end if
end for

%determine color
loop
    Mouse.Where (x, y, button)
    clr := whatdotcolor (x, y)
    locatexy (maxx div 2, cy - 50)
    put clr
    delay (50)
end loop


---Record and Array Example---

A simple program that takes the age and name of members of a population.  It then asks the user to select any age, and outputs the names of the individuals who are that age.


%Record and Array Example%
%By Jorbalax%

var AgeEntered : int :=0
var Population : int := 0

put "Enter the population amount."
get Population

%Create an array of a record.  The record contains the element's "name" and "age"    
var NameAge : array 1..Population of
    record
        name : string (20)
        age : int
    end record

%retrieve the data for the elements of the array
for i : 1..Population
    put "Enter Name:"..
    get NameAge (i).name
    put "Enter Age:"..
    get NameAge (i).age
    put " "
end for

%Takes an age
put "Enter an age."
get AgeEntered

%Outputs the names of people in the population who are that age
for i : 1..Population
    if NameAge (i).age = AgeEntered then
    put NameAge (i).name
    end if
end for



I have some more at school, I'll post them tomorrow.
