OpenEuphoria

starfield demo

• Posted by "Vikas B. Patel" <patelv at EROLS.COM> Aug 12, 1997
• 824 views

For those without a UUencoder/decoder, here it is in text. copy and paste
--*******************************************************************\
--File: Star.ex                                                      |
--Author: Vikas B. Patel, 1997                                       |
--Description: Starfield demo                                        |
--Comments: I saw some horizontal star scrollers, but not a 3-d one. |
--          This isn't as good as many others out there, but it works|
--          and it is flexible.  A Euphoria version of the Pascal    |
--          starfield written by Denthor.  Found in Denthor's VGA    |
--          Tutorial #13 (can be found at almost any graphics progra-|
--          mming site, or at the address below).                    |
--                                                                   |
--File downloaded from: The Programmers' Guild                       |
--http://www.geocities.com/SiliconValley/Way/7272/main.html          |
--*******************************************************************/

--bof

without type_check
without warning
include graphics.e

constant num=200 --max number of stars, there can be less on the screen but
no more
                 --does not work very well
constant speed=2 --higher=faster
constant message="EUPHORIA!"
constant X=1
constant Y=2
constant Z=3
integer XX,YY
XX=320
YY=240

sequence star,pos, stars,clear --info on star; it's x,y pos;
star=repeat(0,3)
pos=repeat(0,2)
stars=repeat(repeat(0,3),num)
clear=repeat(repeat(repeat(0,2),num),2)


procedure init()
  for loop1=1 to num do
      stars[loop1][X]=rand(640)-320
      stars[loop1][Y]=rand(480)-240
      stars[loop1][3]=loop1
  end for
end procedure

procedure calc()
integer x,y
  for loop1=1 to num do
    x=floor(((stars[loop1][X])/stars[loop1][3])+XX)
    y=floor(((stars[loop1][Y])/stars[loop1][3])+YY)
    clear[1][loop1][X]=x
    clear[1][loop1][Y]=y
  end for
end procedure

procedure drawstars()
integer x,y
  for loop1=1 to num do
    x=clear[1][loop1][X]
    y=clear[1][loop1][Y]
    if (x>20) and (x<640) and (y>20) and (y<480) then
     if stars[loop1][Z]>15 then
          --pixel(19,{x,y})
      else pixel(BRIGHT_WHITE,{x,y}) pixel(BRIGHT_WHITE,{x+1,y}) end if
    end if
  end for
end procedure

procedure clearstars()
integer x,y
  for loop1=1 to num do
    x=clear[2][loop1][X]
    y=clear[2][loop1][Y]
    if (x>20) and (x<640) and (y>20) and (y<480) then
      pixel(BLACK,{x,y}) pixel(BLACK,{x+1,y}) end if
  end for
end procedure

procedure movestars(integer towards)
  if towards then
    for loop1=1 to num do
      stars[loop1][Z]=stars[loop1][Z]-speed
      if stars[loop1][Z]<1 then stars[loop1][Z]=stars[loop1][Z]+num end if
    end for
    else
    for loop1=1 to num do
      stars[loop1][Z]=stars[loop1][Z]+speed
      if stars[loop1][Z]>num then stars[loop1][Z]=stars[loop1][Z]-num end if
    end for
  end if
end procedure

procedure main()
integer key
 key=get_key()
  calc()
  drawstars()
  while key !=27 do
      key=get_key()
      position(1,1)
      puts(1,message)
    clear[2]=clear[1]
    calc()
    clearstars()
    drawstars()
  if key='A' or key='a' then
    movestars(1)
  end if
  if key='z' or key='Z' then
    movestars(0)
  end if
  if key=331 then
    XX=XX-3
  end if
  if key=333 then
    XX=XX+3
  end if
  if key=328 then
    YY=YY-3
  end if
  if key=336 then
    YY=YY+3
  end if
  end while
end procedure

if graphics_mode(18) then end if
init()
main()
if graphics_mode(-1) then end if
--eof
*******************************************************************
\*The Programmers' Guild:For the Amatuer and Hardcore Programmers*/
\\*  http://www.geocities.com/SiliconValley/Way/7272/main.html  *//
\\\*OM            http://home.onestop.net/tpg                OM*///
\\\\*OM         |Maintained by Vikas B. Patel|              OM*////
\\\\\*OM               Mera Bharat Mahaan                  OM*/////
*******************************************************************