Forth и другие саморасширяющиеся системы программирования Locations of visitors to this page
Текущее время: Чт май 24, 2018 15:33

...
Google Search
Forth-FAQ Spy Grafic

Часовой пояс: UTC + 3 часа [ Летнее время ]




Начать новую тему Ответить на тему  [ Сообщений: 22 ]  На страницу 1, 2  След.
Автор Сообщение
 Заголовок сообщения: Конкурс: рисуем космос
СообщениеДобавлено: Пт апр 30, 2010 20:43 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 6310
Благодарил (а): 14 раз.
Поблагодарили: 99 раз.
Объявляется конкурс на создание "космической" графики средствами Форта. В качестве решений можно представлять любые варианты изображений на космическую тему, сгенерированных на Форте - звезды, планеты, космические корабли, астероиды и кометы, и все прочее, что придет в голову. Изображение может быть двумерное, трехмерное, статическое, динамическое или интерактивное - на усмотрение автора.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Конкурс: рисуем космос
СообщениеДобавлено: Вт май 04, 2010 13:38 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
Хищник писал(а):
Объявляется конкурс на создание "космической" графики средствами Форта. В качестве решений можно представлять любые варианты изображений на космическую тему, сгенерированных на Форте - звезды, планеты, космические корабли, астероиды и кометы, и все прочее, что придет в голову. Изображение может быть двумерное, трехмерное, статическое, динамическое или интерактивное - на усмотрение автора.


Космос бывает виден с Земли, и если на поверхности есть крупные сооружения, то впечатление очень космическое

Потом вытрем этот офтоп :(
прошу прощения, трудно было не поделиться

Изображение
гора в глубине - вулкан. Впечаляет? Есть ощущение что космос близко?

вот большая фотография - это всё из вики - смотреть в полный экран
http://upload.wikimedia.org/wikipedia/c ... _2006.jpeg


На самом деле я к тому, что по-настоящему космическая графика - это искусство

А что хочет Хищник?


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Конкурс: рисуем космос
СообщениеДобавлено: Вт май 04, 2010 21:04 
Не в сети
Аватара пользователя

Зарегистрирован: Вт мар 20, 2007 23:39
Сообщения: 1253
Благодарил (а): 3 раз.
Поблагодарили: 16 раз.
вопрос писал(а):
гора в глубине - вулкан. Впечаляет? Есть ощущение что космос близко?

Нет. Ни капли. Космосом даже и не пахнет - одна трава. И зачем надо было выкладывать в полный размер? Сложно было превью или линк сделать?
А настоящий космос здесь:
http://www.eso.org/public/images/
http://www.nasa.gov/multimedia/imagegallery/index.html
http://www.space.com/bestimg/index.php? ... t=galactic

_________________
Cтоимость сопровождения программного обеспечения пропорциональна квадрату творческих способностей программиста.
Роберт Д. Блисc


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Конкурс: рисуем космос
СообщениеДобавлено: Вт май 04, 2010 21:10 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 13:19
Сообщения: 3565
Откуда: St.Petersburg
Благодарил (а): 4 раз.
Поблагодарили: 72 раз.
Народ, зачем разводить оффтопик, да еще и флудить про этот оффтопиК?

_________________
С уважением, WingLion
Forth-CPU . RuF09WE
Мой Форт
Отсутствие бана это не заслуга юзера, а недоработка модератора (с)


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Конкурс: рисуем космос
СообщениеДобавлено: Вт май 04, 2010 21:26 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
WingLion писал(а):
Народ, зачем разводить оффтопик, да еще и флудить про этот оффтопиК?
очень уж фото красивое, если непредвзято на него взглянуть, кажется, что гора где-то упирается в верхний слой атмосферы и что это для красоты , вот, видимо, такие виды внушили древним людям, что мир - это космос (космос - по древнегречески - украшение) Просто решил поделиться. Конечно, посмотрев на этот офтопик, нужно его удалить. Sorry.
Надеюсь, Хищник не огорчился
Фото http://www.nasa.gov/multimedia/imagegallery/index.html видели, спасибо


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Конкурс: рисуем космос
СообщениеДобавлено: Вт май 04, 2010 22:00 
Не в сети
Аватара пользователя

Зарегистрирован: Вт мар 20, 2007 23:39
Сообщения: 1253
Благодарил (а): 3 раз.
Поблагодарили: 16 раз.
Ну тогда и отправить весь офтопик в соответствующий раздел форума.

_________________
Cтоимость сопровождения программного обеспечения пропорциональна квадрату творческих способностей программиста.
Роберт Д. Блисc


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Конкурс: рисуем космос
СообщениеДобавлено: Ср май 05, 2010 17:14 
Не в сети
Аватара пользователя

Зарегистрирован: Пт апр 30, 2010 21:37
Сообщения: 8
Благодарил (а): 2 раз.
Поблагодарили: 0 раз.
Уважаемые, не надо сносить эту тему в офтопик. Может у когонибуть и есть фрактальные алгоритмы генерирования космической графики.. Можно сначала выложить и их, а потом всем вместе перевести их на язык Форт.. Лично у меня Форт как раз и ассациируется с космосом.. Незнаю почему, наверное потомучто "вояджер" NASA несет этот язык в далекую бездну. И кто его знает, может "серые человечки", хотя на самом деле они зеленые, скорей поймут язык форта, чем то послание которое несет "Вояджер" :D


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Конкурс: рисуем космос
СообщениеДобавлено: Ср май 05, 2010 21:00 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
:D :)
для кварка

Код:
  4 VALUE V3
  40 VALUE PLANET
  30 VALUE RADIUS
200  TIMER_INTERVAL !
: p

250 1 DO 250 1 DO

   125 I - DUP * 125 J - DUP * + 15600 <        \ сама планета
   
   IF
   J I  J   I   210 RGB
   \ готово пиксел
   
   \  " текстура или "вихри"
   I I 3 * 2 / * J 4 * +
   DUP 17 MOD 7 <
   OVER 31 MOD V3 2 * 3 / < OR
   SWAP 43 MOD V3 > OR
   
   
      125 I - DUP *  PLANET J - DUP * + 900 <       \ satelite
   OR


   IF DROP 0 THEN 
   
   
   PLANET I - DUP *  125 J - DUP * + 625 <  \ other satelite
   IF DROP 255 255 255 RGB THEN
   
   PIXEL
   
   THEN

LOOP LOOP

V3 1 + DUP TO V3 40 =
IF ['] NOOP TO <TIMER> THEN PLANET 4 + TO PLANET
;

' p TO <TIMER>


газовый гигант (в нём происходят какие-то там процессы), вокруг него по перпендикулярным орбитам движутся 2 спутника - один светится. другой нет, в процессе происходит полное затмение одного другим :D


Последний раз редактировалось вопрос Чт май 06, 2010 15:24, всего редактировалось 1 раз.

Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Конкурс: рисуем космос
СообщениеДобавлено: Ср май 05, 2010 21:07 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
Хм, так нагляднее
Код:

  4 VALUE V3
  40 VALUE PLANET
300  TIMER_INTERVAL !
: p

250 1 DO 250 1 DO

   125 I - DUP * 125 J - DUP * + 15600 <        \ сама планета
   
   IF
   J I  J   I   210 RGB
   \ готово пиксел
   
   \  " текстура" или "вихри"
   I I 3 * 2 / * J 4 * +
   DUP 17 MOD 7 <
   OVER 31 MOD V3 2 * 3 / < OR
   SWAP 43 MOD V3 > OR
   
   
   IF DROP
   \ 0
   6579300
   THEN 
   
   
      125 I - DUP *  PLANET J - DUP * + 900 <       \ satelite
      IF DROP 0 THEN
   PLANET I - DUP *  125 J - DUP * + 625 <  \ other satelite
   IF DROP 255 255 255 RGB THEN
   
   PIXEL
   
   THEN

LOOP LOOP

V3 1 + DUP TO V3 40 =
IF ['] NOOP TO <TIMER> THEN PLANET 4 + TO PLANET
;

' p TO <TIMER>


Последний раз редактировалось вопрос Чт май 06, 2010 15:25, всего редактировалось 1 раз.

Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Конкурс: рисуем космос
СообщениеДобавлено: Чт май 06, 2010 09:15 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 6310
Благодарил (а): 14 раз.
Поблагодарили: 99 раз.
вопрос писал(а):
300 TO TIMER_INTERVAL

300 TIMER_INTERVAL !

Я тоже постоянно путаю, как-то вот сделал таймер через VARIABLE, а просится QUAN.

Но "газовые процессы" смотрятся красиво :)


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Конкурс: рисуем космос
СообщениеДобавлено: Чт май 06, 2010 15:56 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
Хищник писал(а):
вопрос писал(а):
300 TO TIMER_INTERVAL

300 TIMER_INTERVAL !

Я тоже постоянно путаю, как-то вот сделал таймер через VARIABLE, а просится QUAN.

Но "газовые процессы" смотрятся красиво :)


Исправил, а я то думаю, что это оно не меняется


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Конкурс: рисуем космос
СообщениеДобавлено: Чт май 06, 2010 16:38 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 6310
Благодарил (а): 14 раз.
Поблагодарили: 99 раз.
Там оно еще будет сильно глючить, потому что 300 TO TIMER_INTERVAL установило адрес переменной на 300. Так что последующая запись туда нового значения через ! полезет в системную область. Это следствие особенностей ассемблерного кода кварка для QUAN и VARIABLE - они начинаются с mov eax, NNNN, причем для QUAN это само значение и есть, а для VARIABLE - адрес.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Конкурс: рисуем космос
СообщениеДобавлено: Чт май 06, 2010 16:55 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 6310
Благодарил (а): 14 раз.
Поблагодарили: 99 раз.
Что-то я никак скриншот не закачаю никуда, так что смотрим картинку в кварке :)

Ой, нет, закачал

Изображение


Код:
0 VALUE ActiveLibrary

: FUNCTION ActiveLibrary SWAP GETPROCADDRESS VALUE ;

" opengl32.dll" LOADLIBRARY VALUE OPENGL
OPENGL TO ActiveLibrary

: ? DUP 0 = IF . THEN ;

" glViewport" FUNCTION glViewPort@   : glViewPort glViewPort@ API4 DROP ;
" glPointSize" FUNCTION glPointSize@ : glPointSize glPointSize@ API1 DROP ;
" glColor3i" FUNCTION glColor3i@     : glColor3i glColor3i@ API3 DROP ;
" glColor3ubv" FUNCTION glColor3ubv@ : glColor3ubv glColor3ubv@ API1 DROP ;
" glColor4ubv" FUNCTION glColor4ubv@ : glColor4ubv glColor4ubv@ API1 DROP ;
" glVertex2dv" FUNCTION glVertex2dv@ : glVertex2dv glVertex2dv@ API1 DROP ;
" glVertex3dv" FUNCTION glVertex3dv@ : glVertex3dv glVertex3dv@ API1 DROP ;
" glBegin" FUNCTION glBegin@         : glBegin glBegin@ API1 DROP ;
" glEnd" FUNCTION glEnd@             : glEnd glEnd@ API0 DROP ;
" glEnable" FUNCTION glEnable@       : glEnable glEnable@ API1 DROP ;
" glDisable" FUNCTION glDisable@     : glDisable glDisable@ API1 DROP ;
" glClear" FUNCTION glClear@         : glClear glClear@ API1 DROP ;
" glPushMatrix" FUNCTION glPushMatrix@ : glPushMatrix glPushMatrix@ API0 DROP ;
" glPopMatrix" FUNCTION glPopMatrix@   : glPopMatrix glPopMatrix@ API0 DROP ;
" glFrustum" FUNCTION glFrustum@       : glFrustum 6 glFrustum@ API DROP ;
" glTranslatef" FUNCTION glTranslatef@ : glTranslatef glTranslatef@ API3 DROP ;
" glTexImage2D" FUNCTION glTexImage2D@ : glTexImage2D glTexImage2D@ API9 DROP ;
" glTexParameteri" FUNCTION glTexParameteri@ : glTexParameteri glTexParameteri@ API3 DROP ;
" glTexCoord2dv" FUNCTION glTexCoord2dv@ : glTexCoord2dv glTexCoord2dv@ API1 DROP ;
" glTexEnvf" FUNCTION glTexEnvf@ : glTexEnvf glTexEnvf@ API3 DROP ;

CREATE AUX3D[] 24 ALLOT

: 3dpoint
  S>F 1000.0 F/ AUX3D[] 16 + F!
  S>F 1000.0 F/ AUX3D[] 8 + F!
  S>F 1000.0 F/ AUX3D[] F!
  AUX3D[] glVertex3dv
;

CREATE TexPoint0 0.0 F, 0.0 F, 0.0 F,
CREATE TexPoint1 1.0 F, 0.0 F, 0.0 F,
CREATE TexPoint2 1.0 F, 1.0 F, 0.0 F,
CREATE TexPoint3 0.0 F, 1.0 F, 0.0 F,

CREATE Point0 0.0 F, 0.0 F, 0.0 F,
CREATE Point1 -1.0 F, 0.0 F, 0.0 F,
CREATE Point2 1.0 F, 0.0 F, 0.0 F,
CREATE Point3 0.0 F, 1.0 F, 0.0 F,
CREATE Point4 0.0 F, -1.0 F, 0.0 F,
CREATE Point5 0.0 F, 0.0 F, 1.0 F,
CREATE Point6 0.0 F, 0.0 F, -1.0 F,

CREATE Triangle1A 0.0 F, 0.0 F, -0.50 F,
CREATE Triangle1B 0.0 F, 0.5 F, -0.51 F,
CREATE Triangle1C 1.0 F, 0.9 F, -0.59 F,

FLOAT NX 1420.0 NX F!
FLOAT NY 320.0 NY F!
FLOAT NZ

: X+ NX F@ 10.0 F+ NX F! NX F@ 360.0 F> IF NX F@ 360.0 F- NX F! THEN
;
: X- NX F@ 10.0 F- NX F! NY F@ 0.0 F< IF NX F@ 360.0 F+ NX F! THEN
;
: Y+ NY F@ 10.0 F+ NY F! NY F@ 360.0 F> IF NY F@ 360.0 F- NY F! THEN ;
: Y- NY F@ 10.0 F- NY F! NY F@ 0.0 F< IF NY F@ 360.0 F+ NY F! THEN ;
: Z+ NZ F@ 10.0 F+ NZ F! NZ F@ 360.0 F> IF NZ F@ 360.0 F- NZ F! THEN ;
: Z- NZ F@ 10.0 F- NZ F! NZ F@ 0.0 F< IF NZ F@ 360.0 F+ NZ F! THEN ;



FLOAT ENGINE.X 0.0 ENGINE.X F!
FLOAT ENGINE.Y 0.0 ENGINE.Y F!
FLOAT ENGINE.Z 0.0 ENGINE.Z F!
FLOAT ENGINE.DIAMETER 0.08 ENGINE.DIAMETER F!
FLOAT ENGINE.L 0.4 ENGINE.L F!


: DRAW-ENGINE
  0x7FFFFFFF DUP DUP glColor3i
  40 0 DO
    GL_QUADS glBegin
      I S>F 40.0 F/ 2.0 F* PI F* FCOS ENGINE.DIAMETER F@ F* ENGINE.X F@ F+ Point1 F!
      I S>F 40.0 F/ 2.0 F* PI F* FSIN ENGINE.DIAMETER F@ F* ENGINE.Y F@ F+ Point1 8 + F!
      ENGINE.L F@ -0.5 F* ENGINE.Z F@ F+ Point1 16 + F!
     
      I 1 + S>F 40.0 F/ 2.0 F* PI F* FCOS ENGINE.DIAMETER F@ F* ENGINE.X F@ F+ Point2 F!
      I 1 + S>F 40.0 F/ 2.0 F* PI F* FSIN ENGINE.DIAMETER F@ F* ENGINE.Y F@ F+ Point2 8 + F!
      ENGINE.L F@ -0.5 F* ENGINE.Z F@ F+ Point2 16 + F!

      I 1 + S>F 40.0 F/ 2.0 F* PI F* FCOS ENGINE.DIAMETER F@ F* ENGINE.X F@ F+ Point3 F!
      I 1 + S>F 40.0 F/ 2.0 F* PI F* FSIN ENGINE.DIAMETER F@ F* ENGINE.Y F@ F+ Point3 8 + F!
      ENGINE.L F@ 0.5 F* ENGINE.Z F@ F+ Point3 16 + F!

      I S>F 40.0 F/ 2.0 F* PI F* FCOS ENGINE.DIAMETER F@ F* ENGINE.X F@ F+ Point4 F!
      I S>F 40.0 F/ 2.0 F* PI F* FSIN ENGINE.DIAMETER F@ F* ENGINE.Y F@ F+ Point4 8 + F!
      ENGINE.L F@ 0.5 F* ENGINE.Z F@ F+ Point4 16 + F!

      Point1 glVertex3dv
      Point2 glVertex3dv
      Point3 glVertex3dv
      Point4 glVertex3dv
    glEnd
  LOOP
 
  0x7FFFFFFF 0 0 glColor3i
  40 0 DO
    GL_TRIANGLES glBegin
      I S>F 40.0 F/ 2.0 F* PI F* FCOS ENGINE.DIAMETER F@ F* ENGINE.X F@ F+ Point1 F!
      I S>F 40.0 F/ 2.0 F* PI F* FSIN ENGINE.DIAMETER F@ F* ENGINE.Y F@ F+ Point1 8 + F!
      ENGINE.L F@ -0.5 F* ENGINE.Z F@ F+ Point1 16 + F!

      I 1 + S>F 40.0 F/ 2.0 F* PI F* FCOS ENGINE.DIAMETER F@ F* ENGINE.X F@ F+ Point2 F!
      I 1 + S>F 40.0 F/ 2.0 F* PI F* FSIN ENGINE.DIAMETER F@ F* ENGINE.Y F@ F+ Point2 8 + F!
      ENGINE.L F@ -0.5 F* ENGINE.Z F@ F+ Point2 16 + F!

      0.0 ENGINE.X F@ F+ Point3 F!
      0.0 ENGINE.Y F@ F+ Point3 8 + F!
      ENGINE.L F@ 0.5 F* ENGINE.Z F@ F+ Point3 16 + F!

      Point1 glVertex3dv
      Point2 glVertex3dv
      Point3 glVertex3dv
    glEnd
  LOOP
;

: DRAW-HULL
  0x3FFFFFFF DUP DUP glColor3i
  -0.3 Point1 F! 0.1 Point1 8 + F! 0.2 Point1 16 + F!
  -0.2 Point2 F! 0.1 Point2 8 + F! 0.7 Point2 16 + F!
   0.2 Point3 F! 0.1 Point3 8 + F! 0.7 Point3 16 + F!
   0.3 Point4 F! 0.1 Point4 8 + F! 0.2 Point4 16 + F!
  GL_QUADS glBegin
    Point1 glVertex3dv
    Point2 glVertex3dv
    Point3 glVertex3dv
    Point4 glVertex3dv
  glEnd
  -0.3 Point1 F! -0.1 Point1 8 + F! 0.2 Point1 16 + F!
  -0.2 Point2 F! -0.1 Point2 8 + F! 0.7 Point2 16 + F!
   0.2 Point3 F! -0.1 Point3 8 + F! 0.7 Point3 16 + F!
   0.3 Point4 F! -0.1 Point4 8 + F! 0.2 Point4 16 + F!
  GL_QUADS glBegin
    Point1 glVertex3dv
    Point2 glVertex3dv
    Point3 glVertex3dv
    Point4 glVertex3dv
  glEnd

  -0.3 Point1 F! -0.1 Point1 8 + F! 0.2 Point1 16 + F!
  -0.2 Point2 F! -0.1 Point2 8 + F! 0.7 Point2 16 + F!
  -0.2 Point3 F! 0.1 Point3 8 + F! 0.7 Point3 16 + F!
  -0.3 Point4 F! 0.1 Point4 8 + F! 0.2 Point4 16 + F!
  GL_QUADS glBegin
    Point1 glVertex3dv
    Point2 glVertex3dv
    Point3 glVertex3dv
    Point4 glVertex3dv
  glEnd
  0.3 Point1 F! -0.1 Point1 8 + F! 0.2 Point1 16 + F!
  0.2 Point2 F! -0.1 Point2 8 + F! 0.7 Point2 16 + F!
  0.2 Point3 F! 0.1 Point3 8 + F! 0.7 Point3 16 + F!
  0.3 Point4 F! 0.1 Point4 8 + F! 0.2 Point4 16 + F!
  GL_QUADS glBegin
    Point1 glVertex3dv
    Point2 glVertex3dv
    Point3 glVertex3dv
    Point4 glVertex3dv
  glEnd

  0x7FFFFFFF DUP DUP glColor3i

  0.0 Point1 F! 0.0 Point1 8 + F! 1.2 Point1 16 + F!
  0.2 Point2 F! -0.1 Point2 8 + F! 0.7 Point2 16 + F!
  0.2 Point3 F! 0.1 Point3 8 + F! 0.7 Point3 16 + F!

  GL_TRIANGLES glBegin
    Point1 glVertex3dv
    Point2 glVertex3dv
    Point3 glVertex3dv
  glEnd

  0.0 Point1 F! 0.0 Point1 8 + F! 1.2 Point1 16 + F!
  -0.2 Point2 F! -0.1 Point2 8 + F! 0.7 Point2 16 + F!
  -0.2 Point3 F! 0.1 Point3 8 + F! 0.7 Point3 16 + F!

  GL_TRIANGLES glBegin
    Point1 glVertex3dv
    Point2 glVertex3dv
    Point3 glVertex3dv
  glEnd

  0 0x3FFFFFFF DUP glColor3i

  0.0 Point1 F! 0.0 Point1 8 + F! 1.2 Point1 16 + F!
  -0.2 Point2 F! 0.1 Point2 8 + F! 0.7 Point2 16 + F!
  0.2 Point3 F! 0.1 Point3 8 + F! 0.7 Point3 16 + F!

  GL_TRIANGLES glBegin
    Point1 glVertex3dv
    Point2 glVertex3dv
    Point3 glVertex3dv
  glEnd
 
  0x3FFFFFFF DUP DUP glColor3i

  0.0 Point1 F! 0.0 Point1 8 + F! 1.2 Point1 16 + F!
  -0.2 Point2 F! -0.1 Point2 8 + F! 0.7 Point2 16 + F!
  0.2 Point3 F! -0.1 Point3 8 + F! 0.7 Point3 16 + F!

  GL_TRIANGLES glBegin
    Point1 glVertex3dv
    Point2 glVertex3dv
    Point3 glVertex3dv
  glEnd


  0x7FFFFFFF DUP DUP glColor3i

  -0.5 Point1 F! 0.0 Point1 8 + F! 0.3 Point1 16 + F!
  -0.2 Point2 F! 0.0 Point2 8 + F! 0.7 Point2 16 + F!
  -0.25 Point3 F! 0.0 Point3 8 + F! 0.3 Point3 16 + F!

  GL_TRIANGLES glBegin
    Point1 glVertex3dv
    Point2 glVertex3dv
    Point3 glVertex3dv
  glEnd

  0.5 Point1 F! 0.0 Point1 8 + F! 0.3 Point1 16 + F!
  0.2 Point2 F! 0.0 Point2 8 + F! 0.7 Point2 16 + F!
  0.25 Point3 F! 0.0 Point3 8 + F! 0.3 Point3 16 + F!

  GL_TRIANGLES glBegin
    Point1 glVertex3dv
    Point2 glVertex3dv
    Point3 glVertex3dv
  glEnd

;

: DRAW-FIRE
  0 0x7FFFFFFF DUP glColor3i

  -0.21 Point1 F! -0.01 Point1 8 + F! 0.9 Point1 16 + F!
  -0.21 Point2 F! 0.01 Point2 8 + F! 0.9 Point2 16 + F!
  -0.2 Point3 F! 0.0 Point3 8 + F! 1.2 Point3 16 + F!

  GL_TRIANGLES glBegin
    Point1 glVertex3dv
    Point2 glVertex3dv
    Point3 glVertex3dv
  glEnd

  -0.19 Point1 F! -0.01 Point1 8 + F! 0.9 Point1 16 + F!
  -0.19 Point2 F! 0.01 Point2 8 + F! 0.9 Point2 16 + F!
  -0.2 Point3 F! 0.0 Point3 8 + F! 1.2 Point3 16 + F!

  GL_TRIANGLES glBegin
    Point1 glVertex3dv
    Point2 glVertex3dv
    Point3 glVertex3dv
  glEnd

  -0.21 Point1 F! 0.01 Point1 8 + F! 0.9 Point1 16 + F!
  -0.19 Point2 F! 0.01 Point2 8 + F! 0.9 Point2 16 + F!
  -0.2 Point3 F! 0.0 Point3 8 + F! 1.2 Point3 16 + F!

  GL_TRIANGLES glBegin
    Point1 glVertex3dv
    Point2 glVertex3dv
    Point3 glVertex3dv
  glEnd

  -0.21 Point1 F! -0.01 Point1 8 + F! 0.9 Point1 16 + F!
  -0.19 Point2 F! -0.01 Point2 8 + F! 0.9 Point2 16 + F!
  -0.2 Point3 F! 0.0 Point3 8 + F! 1.2 Point3 16 + F!

  GL_TRIANGLES glBegin
    Point1 glVertex3dv
    Point2 glVertex3dv
    Point3 glVertex3dv
  glEnd
;

: TEST
  0 0 700 700 glViewPort
  glPushMatrix


  GL_DEPTH_TEST glEnable
  GL_DEPTH_BUFFER_BIT glClear

  GL_LIGHTING glEnable
  GL_LIGHT0 glEnable
  GL_LIGHT1 glEnable
  GL_COLOR_MATERIAL glEnable
  GL_LINE_SMOOTH glEnable

  0 0x7FFFFFFF 0 glColor3i

  NX F@ ROTATEANGLE SF!
  1.0 glX SF!
  0.0 glY SF!
  0.0 glZ SF!
  3DROTATE

  NY F@ ROTATEANGLE SF! // -120
  0.0 glX SF!
  1.0 glY SF!
  0.0 glZ SF!
  3DROTATE

  NZ F@ ROTATEANGLE SF! // 100
  0.0 glX SF!
  0.0 glY SF!
  1.0 glZ SF!
  3DROTATE


  0x3FFFFFFF DUP DUP glColor3i

   -0.2 ENGINE.X F!
   0.0 ENGINE.Y F!
   0.0 ENGINE.Z F!
   DRAW-ENGINE

   0.0 ENGINE.X F!
   0.0 ENGINE.Y F!
   0.0 ENGINE.Z F!
   DRAW-ENGINE

   0.2 ENGINE.X F!
   0.0 ENGINE.Y F!
   0.0 ENGINE.Z F!
   DRAW-ENGINE
   
   DRAW-HULL
   
   DRAW-FIRE

  glPopMatrix
;

' TEST TO 3D

' X+ TO K_UP
' X- TO K_DOWN
' Y+ TO K_LEFT
' Y- TO K_RIGHT
' Z+ TO K_PGUP
' Z- TO K_PGDOWN


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Конкурс: рисуем космос
СообщениеДобавлено: Чт май 06, 2010 17:49 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
Код:
  250 VALUE PLANET_X
  250 CONSTANT PLANET_Y
100  TIMER_INTERVAL !
: p

700 10 DO 700 10 DO

   PLANET_X I - DUP *
   PLANET_Y J - DUP * + 8000 <        \ сама планета   
   
   IF
      I  J 
        50 50 141 
           RGB   
      \ готово пиксел
      
      J PLANET_Y >
      
      
      IF
      
      PLANET_X I - DUP *
        PLANET_Y J - 6 * DUP *
        + DUP 28700 < SWAP 14200 > AND
          IF DROP 250  PLANET_X  I - ABS 240 MOD PLANET_Y J - I * 255 MOD RGB THEN
      
      PLANET_X I - DUP *
        PLANET_Y J - 6 * DUP *
        + DUP 50700 < SWAP 34200 > AND
          IF DROP 250  PLANET_X  I - ABS 240 MOD PLANET_Y J - I * 255 MOD RGB THEN
      THEN 
   ELSE
      
      I J 0   
      
      
      PLANET_X I - DUP *
        PLANET_Y J - 6 * DUP *
        + DUP 28700 < SWAP 14200 > AND
          IF DROP 250  PLANET_X  I - ABS 240 MOD PLANET_Y J - I * 255 MOD RGB THEN
      
      PLANET_X I - DUP *
        PLANET_Y J -  6 * DUP *
        + DUP 50700 < SWAP 34200 > AND
          IF DROP 250  PLANET_X  I - ABS 240 MOD PLANET_Y J - I * 255 MOD RGB THEN
      
      
      
   THEN
PIXEL
LOOP LOOP

PLANET_X 2 + DUP TO PLANET_X   PLANET_X 500 =
IF ['] NOOP TO <TIMER> THEN
;

' p TO <TIMER>


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Конкурс: рисуем космос
СообщениеДобавлено: Пт май 07, 2010 00:51 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
А. ну да, я не сказал, это алгоритм генерации "сатурна"
меняя коэффициенты или вводя новые можно изменять вид
вот более выразительно
Код:
  250 VALUE PLANET_X
  250 CONSTANT PLANET_Y
100  TIMER_INTERVAL !
: p

500 90 DO 700 10 DO

   PLANET_X I - DUP *
   PLANET_Y J - DUP * + 8000 <        \ сама планета   
   
   IF
   I  J 
      50 PLANET_X 90 + I - 4 / 25 * 18 / +
      50 PLANET_Y 90 + J - 2
       /  255 MOD +
      141 
          RGB   
   \ готово пиксел
   
   J PLANET_Y >
   
   
   IF
   
   PLANET_X I - DUP *
      PLANET_Y J - 9 * 2 / DUP *
      + DUP 28700 < SWAP 14200 > AND
         IF DROP 250  PLANET_X  I - ABS 240 MOD PLANET_Y J - I * 255 MOD RGB THEN
   
   PLANET_X I - DUP *
      PLANET_Y J - 9 * 2 / DUP *
      + DUP 50700 < SWAP 34200 > AND
         IF DROP 250  PLANET_X  I - ABS 240 MOD PLANET_Y J - I * 255 MOD RGB THEN
   THEN 
   ELSE
   
   I J 0    
   
   
   PLANET_X I - DUP *
      PLANET_Y J - 9 * 2 /  DUP *
      + DUP 28700 < SWAP 14200 > AND
         IF DROP 250  PLANET_X  I - ABS 240 MOD PLANET_Y J - I * 255 MOD RGB THEN
   
   PLANET_X I - DUP *
      PLANET_Y J -  18 * 4 / DUP *
      + DUP 50700 < SWAP 34200 > AND
         IF DROP 250  PLANET_X  I - ABS 240 MOD PLANET_Y J - I * 255 MOD RGB THEN
   
   
   
   THEN
PIXEL
LOOP LOOP

PLANET_X 2 + DUP TO PLANET_X   PLANET_X 500 =
IF ['] NOOP TO <TIMER> THEN
;

' p TO <TIMER>


ps у Хищника непонятно, что делают клавиши


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 22 ]  На страницу 1, 2  След.

Часовой пояс: UTC + 3 часа [ Летнее время ]


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1


Вы не можете начинать темы
Вы можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
phpBB сборка от FladeX // Русская поддержка phpBB