' BYE TO K_F9
" Выход: F9" PRINT CR
0 VALUE ActiveLibrary
: FUNCTION ActiveLibrary SWAP GETPROCADDRESS VALUE ;  \ это чтобы не писать имя dll каждый раз
" opengl32.dll" LOADLIBRARY VALUE OPENGL
OPENGL TO ActiveLibrary
" glViewport" FUNCTION glViewPort@     : glViewPort glViewPort@ API4 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 ;
" glColor3i" FUNCTION glColor3i@       : glColor3i glColor3i@ API3 DROP ;
" glColor3ubv" FUNCTION glColor3ubv@   : glColor3ubv glColor3ubv@ API1 DROP ;
\ " glFrustum" FUNCTION glFrustum@       : glFrustum glFrustum@ 6 API . ;
\ " glOrtho" FUNCTION glOrtho@           : glOrtho glOrtho@ API2 DROP ;
: раскрасить  glColor3ubv@ API1 DROP ;
: матрица! glPushMatrix@ API0 DROP ;
: матрица@ glPopMatrix@ API0 DROP ;

" kernel32.dll" LOADLIBRARY
" GetTickCount" GETPROCADDRESS CONSTANT 'GetTickCount
: GetTickCount \ ( -- ticks )
  'GetTickCount API0 ;

: F+!  DUP F@ F+ F! ;  \ ( a -- ) ( F: x -- )

: SF+!  DUP SF@ F+ SF! ; \ ( a -- ) ( F: x -- )

: gl_point  \ ( a1 -- ) Рисует точку в точке расположенной по адресу a1 (по адресу расположены x,y,z в формате float)
  GL_POINTS glBegin   glVertex3dv    glEnd
;

: gl_line  \ ( a1 a2 -- ) Рисует линию из точки расположенной по адресу a1 в точку расположенную во адресу a2 (по адресам расположены x,y,z в формате float)
  GL_LINES glBegin   glVertex3dv glVertex3dv    glEnd
;

: gl_triangle \ ( a1 a2 a3 -- ) Рисует треугольник в точках a1 a2 a3 (по адресам расположены x,y,z в формате float)
  GL_TRIANGLES glBegin   glVertex3dv glVertex3dv glVertex3dv  glEnd
;

: gl_quad  \ ( a1 a2 a3 a4 -- ) Рисует квадрат в точках a1 a2 a3 a4 (по адресам расположены x,y,z в формате float)
  GL_QUADS glBegin
    glVertex3dv   glVertex3dv    glVertex3dv   glVertex3dv
  glEnd
;

: (line.)  \ ( a -- a1 ) Линия
  DUP
  DUP 3 FLOATS +
  gl_line
  6 FLOATS +
;

: (triangle.)  \ ( a -- a1 ) Треугольник
  DUP
  DUP 3 FLOATS +
  DUP 3 FLOATS +
  gl_triangle
  9 FLOATS +
;

: (ltriangle.)  \ ( a -- a1 ) Треугольник линиями
  DUP >R          \ a1
  DUP 3 FLOATS +  \ a2
  DUP              \ a2
  DUP 3 FLOATS +   \ a3
  DUP             \ a3
  R@              \ a1
  GL_LINES glBegin
     glVertex3dv glVertex3dv
     glVertex3dv glVertex3dv
     glVertex3dv glVertex3dv
  glEnd
  R> 9 FLOATS +
;

: (quad.)  \ ( a -- a1 )  Квадрат
  DUP
  DUP 3 FLOATS +
  DUP 3 FLOATS +
  DUP 3 FLOATS +
  gl_quad
  12 FLOATS +
;

: (lquad.)  \ ( a -- a1 ) Квадрат линиями
  DUP >R          \ a1
  DUP 3 FLOATS +  \ a2
  DUP              \ a2
  DUP 3 FLOATS +   \ a3
  DUP             \ a3
  DUP 3 FLOATS +  \ a4
  DUP              \ a4
  R@               \ a1
  GL_LINES glBegin
     glVertex3dv glVertex3dv
     glVertex3dv glVertex3dv
     glVertex3dv glVertex3dv
     glVertex3dv glVertex3dv
  glEnd
  R> 12 FLOATS +
;

VECT line.
' (line.) TO line.
VECT triangle.
' (triangle.) TO triangle.
VECT quad.
' (quad.) TO quad.


1 CELLS CONSTANT MX_ofs
2 CELLS CONSTANT MY_ofs
3 CELLS CONSTANT MZ_ofs

4 CELLS CONSTANT RX_ofs
5 CELLS CONSTANT RY_ofs
6 CELLS CONSTANT RZ_ofs


\ Перемещение объекта по осям
: MX+  \ ( a -- ) ( F: x -- )
  MX_ofs + SF+!  ;
: MY+  \ ( a -- ) ( F: y -- )
  MY_ofs + SF+!  ;
: MZ+  \ ( a -- ) ( F: z -- )
  MZ_ofs + SF+!  ;

: MX!  \ ( a -- ) ( F: x -- )
  MX_ofs + SF!  ;
: MY!  \ ( a -- ) ( F: y -- )
  MY_ofs + SF!  ;
: MZ!  \ ( a -- ) ( F: z -- )
  MZ_ofs + SF!  ;

: MX@  \ ( a -- F: x )
  MX_ofs + SF@  ;
: MY@  \ ( a -- F: y )
  MY_ofs + SF@  ;
: MZ@  \ ( a -- F: z )
  MZ_ofs + SF@  ;


\ Вращение объекта по осям
: RX+  \ ( a -- ) ( F: angle -- )
  RX_ofs + SF+!  ;
: RY+  \ ( a -- ) ( F: angle -- )
  RY_ofs + SF+!  ;
: RZ+  \ ( a -- ) ( F: angle -- )
  RZ_ofs + SF+!  ;

: RX!  \ ( a -- ) ( F: angle -- )
  RX_ofs + SF!  ;
: RY!  \ ( a -- ) ( F: angle -- )
  RY_ofs + SF!  ;
: RZ!  \ ( a -- ) ( F: angle -- )
  RZ_ofs + SF!  ;

: RX@  \ ( a -- F: angle )
  RX_ofs + SF@  ;
: RY@  \ ( a -- F: angle )
  RY_ofs + SF@  ;
: RZ@  \ ( a -- F: angle )
  RZ_ofs + SF@  ;


\ Готовые флаги для вращения
CREATE f_gl_Xyz 1.0 SF, 0.0 SF, 0.0 SF,
CREATE f_gl_xYz 0.0 SF, 1.0 SF, 0.0 SF,
CREATE f_gl_xyZ 0.0 SF, 0.0 SF, 1.0 SF,

\ Уставновка флагов вращения для каждой оси
: glXyz  f_gl_Xyz glX 12  MOVE  ;
: glxYz  f_gl_xYz glX 12  MOVE  ;
: glxyZ  f_gl_xyZ glX 12  MOVE  ;

: рендер.  \ ( a -- ) Отрисовка модели
  BEGIN
    DUP @ DUP
  WHILE \ a xt
      SWAP 4 + DUP 4 + SWAP @ 0 DO  \ a xt
     OVER EXECUTE
      LOOP NIP
  REPEAT DROP DROP
;

: двигать.  \ ( a -- )  Двигает объект
  MX_ofs + glX 12 MOVE 3DTRANSLATE
;

: вращать.  \ ( a -- )  Вращает объект
  DUP RX_ofs + ROTATEANGLE 4 MOVE  glXyz  3DROTATE  \ Вращаем по x
  DUP RY_ofs + ROTATEANGLE 4 MOVE  glxYz  3DROTATE  \ Вращаем по y
      RZ_ofs + ROTATEANGLE 4 MOVE  glxyZ  3DROTATE  \ Вращаем по z
;

: рендерить.  \ ( a -- )  Отрисовка объекта, для каждого объекта делается отдельная установка его координат и углов вращения
  матрица!  \ Сохраняем матрицу
  \ Сначала вращаем, и только затем перемещаем объект, иначе объект будет вращаться вокруг собственной оси
  DUP вращать.
  \ Двигаем объект
  DUP двигать.
  @ \ Извлекаем адрес модели
  рендер.  \ и отрисовываем ее
  матрица@  \ Восстанавливаем матрицу
;

: скелет
  ['] (ltriangle.) TO triangle.
  ['] (lquad.) TO quad.
;

: плоть
  ['] (triangle.) TO triangle.
  ['] (quad.) TO quad.
;

: Опции_начала_сцены
  0 0 800 700 glViewPort        \ координаты левого нижнего угла, ширина и высота окна просмотра (OpenGL направляет оси вправо и вверх)
  GL_DEPTH_TEST glEnable          \ разрешаем контроль глубины
  GL_DEPTH_BUFFER_BIT glClear     \ и очищаем буфер глубины (сейчас в трехмерном пространстве ничего нет)
\ обращаем внимание, что COLOR_BUFFER_BIT не установлен, поскольку он уже очищен при отрисовке "двумерной" сцены
\ (это та, в которую кварк выводит текст)
  GL_LIGHTING glEnable                   \  разрешаем расчет освещения
  GL_LIGHT0 glEnable                       \  включаем первый
  GL_LIGHT1 glEnable                       \  и второй "стандартные" источники света
  GL_COLOR_MATERIAL glEnable       \  разрешаем раскрашивать примитивы
  GL_LINE_SMOOTH glEnable             \  разрешаем "размывание" линий
;

\ : Опции_конца_сцены
\  glPopMatrix                 \ восстанавливаем матрицу (раз уж сохраняли)
\ ;

VARIABLE fps_time
VARIABLE fps_num
: TickCountTime!  \ Сохраняет время
  GetTickCount fps_time !
;

CREATE fps_xy 2 , 2 ,
: fps_xy!  \ ( x y -- )
  fps_xy 4 + !  fps_xy !
;

: fps.  \ Вывод фреймрейта (кадров в секунду) на экран
  1 fps_num +!
  GetTickCount fps_time @ - 1000 >
    IF
      fps_xy @  fps_xy 4 + @ GOTOXY
      fps_num @ . " FPS   " PRINT
      0 fps_num !
      TickCountTime!
    THEN
;