Forever GS
program ForeverGS;
uses Types, QuickDraw, Events, MiscTool, ST;
type
Star = record
x, y, sx, sy: Real;
end;
var
i, color, dir: Integer;
tick: LongInt;
s: Star;
stars: Array[0..20] of Star;
procedure playMusic(path: String);
begin
loadOneTool(219, 0);
stStartup(57005);
stLoadOneMusic(path);
stPlayMusic(true);
end;
procedure stopMusic;
begin
stShutDown;
end;
begin
{ Setup }
graphics(320);
clearScreen(black);
playMusic('Music/Toolbox');
setPenMode(modeXOR);
hideCursor;
tick := getTick;
dir := -1;
{ Draw background }
setColorEntry(0, 15, 0);
for i := 1 to 15 do
setColorEntry(1, i, i);
for i := 125 to 199 do
setSCB(i, 1);
setPenSize(1, 5);
for i := 1 to 15 do begin
setSolidPenPat(i);
moveTo(0, 120 + i * 5);
line(320, 0);
end;
setPenSize(1, 1);
setBackColor(black);
setForeColor(15);
moveTo(85, 124);
write('Apple IIGS Forever!');
{ Setup stars }
for i := 0 to 20 do begin
stars[i].x := 160;
stars[i].y := 60;
stars[i].sx := (random mod 41) / 10 - 2;
stars[i].sy := (random mod 41) / 10 - 2;
end;
repeat
{ Color cycle title }
color := getColorEntry(0, 15);
if (color = 0) or (color = $F00) then
dir := -dir;
setColorEntry(0, 15, color + $100 * dir);
{ Color cycle background }
color := getColorEntry(1, 15);
for i := 15 downto 1 do
setColorEntry(1, i, getColorEntry(1, i - 1));
setColorEntry(1, 1, color);
{ Move stars }
for i := 0 to 20 do begin
s := stars[i];
setSolidPenPat(i mod 14 + 1);
moveTo(round(s.x), round(s.y));
line(0, 0);
stars[i].x := s.x + s.sx;
stars[i].y := s.y + s.sy;
s := stars[i];
if (s.x < 0) or (s.x > 319) or (s.y < 0) or
(s.y > 119)
then begin
stars[i].x := 160;
stars[i].y := 60;
stars[i].sx := (random mod 41) / 10 - 2;
stars[i].sy := (random mod 41) / 10 - 2;
end
else begin
{ Accelerate stars movement }
stars[i].sx := s.sx * 1.1;
stars[i].sy := s.sy * 1.1;
end;
s := stars[i];
moveTo(round(s.x), round(s.y));
line(0, 0);
end;
repeat until getTick - tick > 1;
tick := getTick;
until button(0);
stopMusic;
end.
Apple IIGS Forever! Now you can design your own FTA demo!
This program teaches psuedo 3D effect, multiple color palettes and color cycling.
Note: The program uses FTA Tool219 to play music, please install Tool219 to the Apple IIGS System folder first.
GSoft BASIC 3D star field demo:
TYPE STAR
X
Y
SX
SY
END TYPE
DIM S AS STAR
DIM STARS(20) AS STAR
HGR
SETPENMODE (MODEXOR)
! Write message
SETBACKCOLOR (0)
SETFORECOLOR (7)
MOVETO (85, 100)
PRINT “Apple IIGS Forever!”
! Setup stars
FOR I = 0 TO 20
STARS(I).X = 160
STARS(I).Y = 100
STARS(I).SX = RND (1) * 4 - 2
STARS(I).SY = RND (1) * 4 - 2
NEXT
DO
! Move Stars
FOR I = 0 TO 20
S = STARS(I)
HCOLOR= (I / 21) * 15 + 1
HPLOT S.X, S.Y
STARS(I).X = S.X + S.SX
STARS(I).Y = S.Y + S.SY
S = STARS(I)
IF (S.X < 0) OR (S.X > 319) OR (S.Y < 0)
OR (S.Y > 199) THEN
STARS(I).X = 160
STARS(I).Y = 100
STARS(I).SX = RND (1) * 4 - 2
STARS(I).SY = RND (1) * 4 - 2
ELSE
! Accelerate stars movement
STARS(I).SX = S.SX * 1.1
STARS(I).SY = S.SY * 1.1
END IF
HPLOT STARS(I).X, STARS(I).Y
NEXT
LOOP