Code: Select all
View.Set ("text")
%var font : int := Font.New ("comic sans ms:20")
var num : int
put "Please enter a number: " ..
get num
%View.Set ("nocursor,offscreenonly")
%Font.Draw ("Enter your number in decimal: ", 20, maxy - 60, font, black)
% loop
% var ch := getchar
% if strintok (ch) then
% num := strint (ch)
% end if
% exit when ch = KEY_ENTER
% Font.Draw ("Enter your number in decimal: " + ch, 20, maxy - 60, font, black)
% View.Update
% cls
% end loop
var cnt, space : int := 0
var loc : array 1 .. 1000000 of int
put ""
put num ..
for i : 1 .. num
if num mod 2 = 1 then
loc (i) := 1
else
loc (i) := 0
end if
put ": ", loc (i)
exit when num = 0
put num div 2 ..
num div= 2
cnt += 1
end for
put ""
for decreasing i : cnt .. 1
space += 1
put loc (i) ..
end for
put ""
[code]
[b]Sun Fighters[/b]
[code]
%Sun Fighters! V 1.7 FINAL RELEASE
%"Last updated ", (theDayYouReadThis - theDatelastEdited), " days ago by Drew Martell"
%CONSTANTS/VARIABLES
const timer := Font.New ("@Terminal:10")
const win := Font.New ("Times New Roman:20")
const rec := "Sun Fighter's Best Time.rec"
var sun, back, ground, face, cnt, sx, sy, sunx, suny, file, maxBall, size, touch, ammount, deaths, x : int
var timeElapsed, speedS, msg, bestTime : string
var ch : char
var gravity, speed, selectedSpeed, subSpeed, line : real
%var current : array 0 .. 3 of int
var score, c : array 1 .. 4 of int
var ballx, bally, vx, vy : array 1 .. 4 of real
var scoreS : array 1 .. 4 of string
var flash : boolean := false
var keys : array char of boolean
% current (0) := 120
% current (1) := 56
% current (2) := 112
% current (3) := 104
for i : 1 .. 4
score (i) := 0
end for
cnt := 0
deaths := 0
maxBall := 4
speed := 25
selectedSpeed := speed
sun := brightred
open : file, rec, put, mod
close : file
File.Status (rec, size, x, x)
if (size <= 2) then
open : file, rec, put, mod
put : file, "0"
close : file
end if
process Sound
Music.Sound (100, 70)
Music.SoundOff
end Sound
procedure Reset
open : file, rec, get
get : file, msg
close : file
bestTime := msg
cnt := 0
c (1) := 37
c (2) := brightgreen
c (3) := yellow
c (4) := white
back := white
ground := back + 1
face := black
line := 50
ballx (1) := line + maxx - 100
bally (1) := line
ballx (2) := line + maxx - 150
bally (2) := line
ballx (3) := line + maxx - 200
bally (3) := line
ballx (4) := line + maxx - 250
bally (4) := line
for i : 1 .. maxBall
vx (i) := 5
vy (i) := 10
end for
gravity := .25
sunx := Rand.Int (100, maxx div 2)
suny := Rand.Int (100, maxy - 100)
sx := 1
sy := 1
speed := selectedSpeed
subSpeed := .01
View.Set ("offscreenonly")
end Reset
procedure Pause
View.Update
Input.Flush
delay (500)
Input.Flush
loop
%touch := parallelget
exit when hasch %or (touch not= current (0))
end loop
end Pause
procedure Debugger
drawfillbox (0, 0, maxx, maxy, black)
var cmd : string
color (white)
colourback (black)
locate (1, 1)
put "COMMAND:/" ..
get cmd
if cmd = "rainbow" then
flash := true
end if
end Debugger
procedure Intro
Reset
for i : 1 .. maxBall
score (i) := 0
end for
View.Set ("title:Sun Fighters, nocursor, nooffscreenonly")
var title := Font.New ("TimesNewRoman:40")
drawfillbox (0, 0, maxx, maxy, blue)
Font.Draw ("Sun Fighters!!!", 160, 280, title, brightred)
colourback (blue)
colour (white)
locate (4, 37)
put "SPEED: ", speed
locate (10, 14)
put "This is a 1 to 4 player game in which you must dodge the"
locate (11, 17)
put "sun from melting your bum. Try to keep a good score!"
locate (12, 33)
colour (56)
put "Press 'Q' to quit"
colour (white)
locate (14, 35)
put "--------------"
locate (15, 35)
put "// CONTROLS //"
locate (16, 35)
put "--------------"
locate (19, 10)
colour (c (1))
put " 1P: 'a' moves left 'd' moves right"
locate (20, 10)
colour (c (2))
put " 2P: 'j' moves left 'l' moves right"
locate (21, 10)
colour (c (3))
put " 3P: 'LEFT' moves left 'RIGHT' moves right"
locate (22, 10)
colour (c (4))
put " 4P: 'NUM3' moves left 'NUM9' moves right"
drawbox (50, 30, maxx - 50, maxy - 30, white)
locate (maxrow, 11)
colour (11)
put "Press 1 - 4 for the ammount of players or 's' to set the speed"
View.Update
Input.Flush
delay (500)
Input.Flush
ch := getchar
if (ch = KEY_SHIFT_F10) then
Debugger
end if
if (ch = 'b') then
sun := 17
end if
if ~ ((ch = '1') or (ch = '2') or (ch = '3') or (ch = '4') or (ch = 's') or (ch = 'q')) then
Intro
end if
if (ch = 's') then
locate (maxrow, maxrow)
put "ENTER A SPEED: " ..
View.Update
get speed
selectedSpeed := speed
Intro
end if
if (ch = 'q') then
quit
end if
end Intro
procedure Save
bestTime := msg
open : file, rec, get
get : file, msg
close : file
if (strint (timeElapsed) > strint (msg)) then
open : file, rec, put, mod
put : file, timeElapsed
close : file
end if
end Save
procedure Player
if (ch = '1') then
ammount := 1
elsif (ch = '2') then
ammount := 2
elsif (ch = '3') then
ammount := 3
elsif (ch = '4') then
ammount := 4
end if
for i : 1 .. ammount
drawfilloval (round (ballx (i)), round (bally (i)), 10, 10, c (i)) %body
drawoval (round (ballx (i)), round (bally (i)), 10, 10, face) %body outline
drawfilloval (round (ballx (i)) - 3, round (bally (i)) + 2, 1, 1, face) %left eye
drawfilloval (round (ballx (i)) + 3, round (bally (i)) + 2, 1, 1, face) %right eye
drawfillarc (round (ballx (i)), round (bally (i)) - 2, 2, 4, 180, 360, face) %smile
end for
end Player
procedure Sun
if flash = true then
if sun = c (1) then
else
sun := Rand.Int (0, 255)
end if
end if
drawfilloval (round (sunx), round (suny), 100, 100, sun) %sun body
drawfilloval (round (sunx) - 40, round (suny) + 30, 10, 10, face) %left eye
drawfilloval (round (sunx) + 40, round (suny) + 30, 10, 10, face) %right eye
drawfillarc (round (sunx), round (suny) - 2, 80, 80, 180, 360, face) %smile
drawoval (round (sunx), round (suny), 100, 100, face) %sun outline
end Sun
proc Main
View.Set ("offscreenonly")
Reset
loop
for i : 1 .. maxBall
scoreS (i) := intstr (score (i))
end for
timeElapsed := intstr (cnt div 50)
speedS := realstr (speed, 0)
%touch := parallelget
cnt += 1
%Painting
drawfillbox (0, 0, maxx, maxy, back) %background
drawfillbox (0, 0, maxx, round (line), ground) %floor
Font.Draw ("Player 1: " + scoreS (1), 10, 30, timer, c (1))
Font.Draw ("Player 2: " + scoreS (2), 10, 15, timer, c (2))
Font.Draw ("Player 3: " + scoreS (3), 110, 30, timer, c (3))
Font.Draw ("Player 4: " + scoreS (4), 110, 15, timer, c (4))
Font.Draw ("TIME:" + timeElapsed, maxx - 170, 20, timer, 11)
Font.Draw ("BEST:" + bestTime, maxx - 100, 20, timer, brightred)
Font.Draw ("SPEED:" + speedS, (maxx div 2) - 50, 20, timer, back)
Player
Sun
%Variables changing
for i : 1 .. maxBall
ballx (i) += vx (i)
bally (i) += vy (i)
end for
sunx += sx
suny += sy
for i : 1 .. maxBall
vy (i) -= gravity
end for
%Boundaries
for i : 1 .. ammount
if (vy (i) = -10) then
vy (i) := 10 - gravity
fork Sound
end if
end for
for i : 1 .. ammount
if (ballx (i) + 15 >= maxx) then
fork Sound
ballx (i) -= 1
vx (i) *= -1
end if
if (ballx (i) <= 10) then
fork Sound
ballx (i) += 1
vx (i) *= -1
end if
end for
if (suny = 100) or (suny = maxy - 100) then
sy := -sy
elsif (sunx = 100) or (sunx = maxx - 100) then
sx := -sx
end if
%Controlls
Input.KeyDown (keys)
if keys ('d') then
vx (1) += 1
speed -= subSpeed
end if
if keys ('a') then
vx (1) -= 1
speed -= subSpeed
end if
% if (ch = '1') then
% if (touch = current (2)) then
% vx (1) += 1
% speed -= subSpeed
% end if
% if (touch = current (1)) then
% vx (1) -= 1
% speed -= subSpeed
% end if
% end if
if (ch = '2') or (ch = '3') or (ch = '4') then
if keys ('l') /*or (touch = current (2))*/ then
vx (2) += 1
speed -= subSpeed
end if
if keys ('j') /*or (touch = current (1))*/ then
vx (2) -= 1
speed -= subSpeed
end if
end if
if (ch = '3') or (ch = '4') then
if keys (KEY_RIGHT_ARROW) then
vx (3) += 1
speed -= subSpeed
end if
if keys (KEY_LEFT_ARROW) then
vx (3) -= 1
speed -= subSpeed
end if
end if
if (ch = '4') then
if keys (KEY_PGUP) /*or (touch = current (2))*/ then
vx (4) += 1
speed -= subSpeed
end if
if keys (KEY_PGDN) /*or (touch = current (1))*/ then
vx (4) -= 1
speed -= subSpeed
end if
end if
% if (touch = current (3)) then
% speed -= .01
% end if
%Sun collision detection
colourback (back)
colour (black)
locate (3, 23)
for i : 1 .. ammount
if (whatdotcolour (round (ballx (i)), round (bally (i))) = sun) then
speed := selectedSpeed
drawfillbox (0, 100, maxx, 50, white)
Font.Draw ("Player " + intstr (i) + " Died! Press ESC For New Game", 100, 65, win, black)
for x : 1 .. ammount
if ~ (i = x) then
score (x) += 1
end if
end for
Save
Pause
Input.KeyDown (keys)
if (ammount = 2) then
View.Set ("title: Sun Fighters P" + intstr (1) + ":" + intstr (score (1)) + " P" + intstr (2) + ":" + intstr (score (2)))
elsif (ammount = 3) then
View.Set ("title: Sun Fighters P" + intstr (1) + ":" + intstr (score (1)) + " P" + intstr (2) + ":" + intstr (score (2)) + " P" + intstr (3) + ":" +
intstr (score (3)))
elsif (ammount = 4) then
View.Set ("title: Sun Fighters P" + intstr (1) + ":" + intstr (score (1)) + " P" + intstr (2) + ":" + intstr (score (2)) + " P" + intstr (3) + ":" +
intstr (score (3))
+ " P" + intstr (4) + ":" + intstr (score (4)))
else
deaths += 1
View.Set ("title: Sun Fighters Deaths " + intstr (deaths))
end if
if keys (KEY_ESC) then
Reset
Intro
end if
Reset
end if
end for
View.Update
delay (round (speed))
speed -= .0025
if keys (KEY_ESC) then
Pause
end if
end loop
end Main
Intro
Main
[code]
[b]Drives[/b]
[code]
View.Set ("graphics:1000,300;offscreenonly")
var boxCol, boxRad, boxX, boxY, button, cnt, driveCol, fontcol, ground, growX, growY,
inc, mouseX, mouseY, pass, space : int
var font : int := Font.New ("comic sans ms:15")
var stop : int := Font.New ("comic sans ms:50")
boxCol := brightred
cnt := 0
driveCol := red
ground := 10
growX := 0
inc := 35
space := 0
boxRad := inc div 2
var existant : string := ""
var quicklaunch : char
var drive : array 1 .. 26 of char
var done : boolean := false
var keys : array char of boolean
for i : 'B' .. 'Z'
%if Dir.Exists (i + ":/") then
%put i
cnt += 1
drive (cnt) := i
%end if
end for
var boxes : array 1 .. cnt of int
for i : 1 .. cnt
boxes (i) := inc * i
end for
procedure Pause
cls
Input.Flush
loop
exit when hasch
drawfillbox (0, 0, maxx, maxy, 11)
drawfillbox (370, 80, 680, 240, white)
drawbox (370, 80, 680, 240, black)
Font.Draw ("PAUSED", maxx div 2 - 100, maxy div 2, stop, Rand.Int (0, 255))
Font.Draw ("(press any key to continue)", maxx div 2 - 95, maxy div 2 - 50, font, black)
View.Update
end loop
done := false
end Pause
loop
drawfillbox (0, 0, maxx, maxy, 11) %Background
Mouse.Where (mouseX, mouseY, button)
Input.KeyDown (keys)
drawfilloval (mouseX, mouseY, 10, 10, yellow) %Cursor
drawoval (mouseX, mouseY, 10, 10, black) %Cursor
drawfillbox (370, 110, 620, 290, white) %Information
drawbox (370, 110, 620, 290, black) %Information
Font.Draw ("Hello " + Sys.GetUserName, maxx div 2 - 95, maxy div 2, font, black)
Font.Draw ("on " + Sys.GetComputerName, maxx div 2 - 110, maxy div 2 - 20, font, black)
for i : 1 .. cnt
growX += inc
if Dir.Exists (drive (i) + ":/") then
driveCol := Rand.Int (0, 255) %Makes existing drives flash
else
driveCol := brightred %Default drive colour
end if
drawfillbox (growX - inc div 2, ground, inc + growX, ground + inc, driveCol) %Draws the drives
drawbox (growX - inc div 2, ground, inc + growX, ground + inc, black) %Draws the drives
Font.Draw (drive (i), growX - inc div 2 div 2, 20, font, white) %Drive letters
if button = 1 and mouseX > boxes (i) - boxRad and mouseX < boxes (i) + boxRad and
Dir.Exists (drive (i) + ":/") and mouseY > 10 and mouseY < 45
%or Dir.Exists (keys + ":/")
then %Checks if mouse is touching the drive and clicked
put drive (i)
if Sys.Exec (drive (i) + ":/") then
end if
done := true
exit
elsif button = 0 and mouseX > boxes (i) - boxRad and mouseX < boxes (i) + boxRad
and mouseY > 10 and mouseY < 45 then %Checks if mouse is touching the drive
locate (4, 1)
if Dir.Exists (drive (i) + ":/") then
fontcol := 33
existant := " exists!"
else
fontcol := brightred
existant := " does not exist"
end if
Font.Draw (drive (i) + existant /*+ " (" + (intstr (File.DiskFree (drive (i))) + ") ")*/,
maxx div 2 - 75, maxy div 2 + 35, font, fontcol)
end if
end for
if done or keys (KEY_ESC) then
Pause
end if
for i : 'b' .. 'z'
if keys (i) and Sys.Exec (i + ":/") then
end if
end for
drawfillbox (maxx - 105, 10, maxx - 89, 45, 11) %Cuts off the end of Z
drawline (maxx - 105, 10, maxx - 105, 45, black) %The end of Z
growX := 0 %Resets the size of the boxes
locate (1, 1)
Font.Draw (intstr (mouseX), maxx div 2 - 50, maxy - 30, font, black)
Font.Draw (intstr (mouseY), maxx div 2 + 10, maxy - 30, font, black)
% colour (black)
% for i : 1 .. cnt
% put boxes (i), " " ..
% end for
locate (5, 55)
Font.Draw ("DRIVES", maxx div 2 - 80, maxy - 75, font, black)
for i : 1 .. cnt
if Dir.Exists (drive (i) + ":/") then
colour (33)
Font.Draw (drive (i), maxx div 2 + space, maxy - 75, font, 33)
space += 15
end if
end for
space := 0
View.Update
cls
if button = 1 then
boxCol := 55
else
boxCol := brightred
end if
end loop
[code]
[b]Character Values[/b]
[code]
View.Set ("graphics:770;400,nocursor,offscreenonly")
var back : int := black
colour (white)
colourback (back)
drawfillbox (0, 0, maxx, maxy, black)
var font : int := Font.New ("serif:20")
var letter : array 1 .. 255 of char
for i : 1 .. 255
letter (i) := chr (i)
put i, ": ", letter (i), " " ..
end for
View.Update
loop
locate (maxrow - 1, 1)
var ch := getchar
colour (Rand.Int (0, 255))
Font.Draw (intstr (ord (ch)), maxx div 2, 10, font, brightred)
Font.Draw (ch, maxx div 2 - 25, 10, font, brightred)
View.Update
drawfillbox (0, 0, maxx, 40, black)
end loop
[code]
[b]Colour Pallet[/b]
[code]
View.Set ("graphics:555;255,offscreenonly")
Mouse.ButtonChoose ("multibutton")
%draw the x and y axis
var x, y, c, button, size : int := 0
var keys : array char of boolean
size := 10
loop
Input.KeyDown (keys)
Mouse.Where (x, y, button)
drawfillbox (maxx - 240, maxy - 55, maxx - 265, maxy - 30, whatdotcolour (x, y))
drawbox (maxx - 240, maxy - 55, maxx - 265, maxy - 30, black)
drawfillbox (maxx - 240, maxy - 105, maxx - 265, maxy - 80, c)
drawbox (maxx - 240, maxy - 105, maxx - 265, maxy - 80, black)
for i : 0 .. 255
drawfillbox (0 + i, 0, 255, 255, i)
end for
if (button = 1) then
c := whatdotcolour (x, y)
end if
if keys (KEY_UP_ARROW) then
size += 1
elsif keys (KEY_DOWN_ARROW) then
size -= 1
end if
if (button = 100) then
drawoval (x, y, size, size, c)
elsif (button = 10) then
drawfilloval(x, y, size, size, c)
end if
locate (1, 1)
put "COLOUR:", whatdotcolour (x, y), " CURRENT:", c, " SIZE:", size
View.Update
end loop
[code]
[color=#888888][size=85]Archived topic from Iceteks, old topic ID:4585, old post ID:36552[/size][/color]