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