Jorbalax's Tools/Etc

Jorbalax · **Posted:** Wed Apr 27, 2005 11:55 pm

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.

code:

%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).

code:

%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.

code:

%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 · **Posted:** Thu Apr 28, 2005 8:24 am

Those are nice simple little progs. I'd definately work on that color prog.

Turing:

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 · **Posted:** Thu Apr 28, 2005 10:36 am

screen cord finder

code:

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 · **Posted:** Thu Apr 28, 2005 11:18 am

KISS, you can make one of those in 6 lines using mousewhere Laughing

Jorbalax · **Posted:** 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.

code:

%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 · **Posted:** Mon May 23, 2005 7:59 pm

Nice Work

Jorbalax · **Posted:** 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).

code:

%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.

code:

%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.

	Computer Science Canada Programming C, C++, Java, PHP, Ruby, Turing, VB Username: Password: Register
Wiki Blog Search Turing Chat Room Members