Jorbalax's Tools/Etc
| Author |
Message |
Jorbalax
|
 Posted: Wed Apr 27, 2005 11:55 pm Post subject: 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.
| 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.  |
|
|
|
|
 |
Sponsor
Sponsor
|
|
|
jamonathin
|
| Posted: Thu Apr 28, 2005 8:24 am Post subject: (No subject) |
|
|
Those are nice simple little progs. I'd definately work on that color prog.
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 Post subject: (No subject) |
|
|
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 Post subject: (No subject) |
|
|
KISS, you can make one of those in 6 lines using mousewhere  |
|
|
|
|
|
Jorbalax
|
| Posted: Thu Apr 28, 2005 10:59 pm Post subject: (No subject) |
|
|
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 Post subject: (No subject) |
|
|
| Nice Work |
|
|
|
|
|
Jorbalax
|
| Posted: Wed Jun 01, 2005 5:27 pm Post subject: (No subject) |
|
|
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. |
|
|
|
|
|
|
|
Register
Wiki
Blog
Search
Turing
Chat Room
Members
