Re[5]: Ссылки по Форту
От: DJ KARIES Россия  
Дата: 04.03.05 15:42
Оценка: 21 (1)
Кстати, вот мой игровой SDK giref (на основе моей forth-системы ref):
http://retroforth.org/board/index.php?topic=177.0
Всё полностью в исходниках.

Там есть архив с последней выложенной версией djkaries_giref_test5.zip
Прога запускается без консоли.
Чтобы включить консоль, в модуле system.f вставьте первую строчку "console" — слово без кавычек.

exe-шник весит 3584 байта в несжатом виде (rar-ом ужимается до 1922 байт).
Он при запуске компилит исходники, лежащие рядом с ним.

Юзается glfw для инициализации OpenGL, fmod для музыки и звука.

Проекты не требуют компиляции. Просто меняется текст исходников и запускается exe-шник (djkaries_giref_test5.zip\ref\bin\ref.exe).


Содержимое файлика game.f:
uses rtl/math.f
uses rtl/string.f
uses giref/sound.f  
uses giref/opengl.f
uses giref/glfw.f
uses giref/colors.f
uses giref/utils.f

var FullScreen

uses ini.f

Sound.Ini
" game.xm" Sound.PlaySong

3 vars: Running Width Height
2 vars: MouseX MouseY
3 vars: txFont txGui txWalls
var PressedQ

uses camera.f
uses levels.f
uses objects.f

uses levels/1.f

: LoadTextures
  EnableTexture
  s" Textures/Font.tga" LoadTexture to txFont texMipmapLinear
  s" Textures/Gui.tga" LoadTexture to txGui texNearest
  s" Textures/Walls.tga" LoadTexture to txWalls texNearest
;

: DeleteTextures

;

0 var, CurX
-256 var, CurY
16 var, CurSize
5 vars: x x2 y z i
3 vars: red green blue

: Render2D
  GL_TEXTURE glMatrixMode
  glLoadIdentity
  float 0 float 1 float 0 glTranslatef
  [ float 1 float 256 f/ ] literal [ float -1 float 256 f/ ] literal float 1 glScalef
  
  GL_MODELVIEW glMatrixMode
  
 
  EnableTexture
  
  EnableBlend
  texBlend
  
  txWalls SetTexture
  level.test
    
  DisableTexture
  texBlend
  EnableBlend
  
  | Header
  224 224 255 128 glColor4ub
  rects:
    0 8 640 64 rectangle    
    0 448 640 24 rectangle
  draw;

  EnableTexture
  texBlend
  
  txFont SetTexture
  16 to FontSize
  -4 to FontStep
  220 255 189 glColor3ub
  s" giref Test v6 :)" 16 16 TextOut
  150 210 255 glColor3ub
  s" Press keys: Arrows, PGUp, PGDown, Esc" 16 32 TextOut
  s" 'F'-FullScreen; 'Q'-Test" 16 48 TextOut
  
  -2 to FontStep
  8 to FontSize
  128 224 255 224 glColor4ub  
  s" (c)2005 Alexey Abramov. e-mail: djkaries at list.ru" 16 456 TextOut
  
  0 255 0 224 glColor4ub
  PressedQ if
    8 to FontSize
    s" You pressed 'q'. Command Line: " 16 100 TextOut
    GetCommandLine z>str 16 116 TextOut
  then
  
  | Render mouse cursor
  txGui SetTexture
  rects:
    clWhite glColor3ub
    MouseX MouseY 32 64 16 16 texRectangle
  draw;
;

: reopenWindow
  DeleteTextures
  glfwCloseWindow
  640 480 0 0 0 0 0 0
    FullScreen if
      s" FullScreen mode" type cr
      GLFW_FULLSCREEN
    else
      s" Windowed mode" type cr
      GLFW_WINDOW
    then
    glfwOpenWindow
  s" giref: forth game sdk" drop glfwSetWindowTitle
  1 glfwSwapInterval
  LoadTextures
;

: ProcessControls
  GLFW_KEY_RIGHT key: CurX 1+ to CurX key;
  GLFW_KEY_LEFT key: CurX 1- to CurX key;
  GLFW_KEY_DOWN key: CurY 1+ to CurY key;
  GLFW_KEY_UP key: CurY 1- to CurY key;
  
  GLFW_KEY_PAGEUP key: CurSize 1+ to CurSize key;
  GLFW_KEY_PAGEDOWN key: CurSize 1- to CurSize key;
  'F key:
    FullScreen not to FullScreen
    reopenWindow
  key;
  
  false to PressedQ
  'Q key: true to PressedQ key;
  addr MouseX addr MouseY glfwGetMousePos
  
  CurX to camera.x
  CurY to camera.y
;

: RenderLoop
  repeat
    GLFW_KEY_ESC key: ;; key;
    GLFW_OPENED glfwGetWindowParam 0; drop
    addr Width addr Height glfwGetWindowSize
    ProcessControls
    0 0 Width Height glViewport
    float 0.25 float 0.25 float 0.75 float 1 glClearColor
    GL_COLOR_BUFFER_BIT glClear
    glLoadIdentity
    float -1 float 1 float 0 glTranslatef
    [ float 1 float 320 f/ ] literal [ float -1 float 240 f/ ] literal float 1 glScalef
    GLFW_ACTIVE glfwGetWindowParam 0 =if
      0 0 glfwSleep
    then
    Render2D
    glfwSwapBuffers
  again
;

: StartUp
  glfwInit drop
  reopenWindow
  RenderLoop
  glfwTerminate
;
... << http://dkdens.narod.ru :: http://retroforth.org >>
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.