fbitfont.f
上传用户:xk288cn
上传日期:2007-05-28
资源大小:4876k
文件大小:2k
源码类别:

GIS编程

开发平台:

Visual C++

  1. C  Copyright (c) Mark J. Kilgard, 1994.
  2. C  This program is freely distributable without licensing fees
  3. C  and is provided without guarantee or warrantee expressed or
  4. C  implied.  This program is -not- in the public domain.
  5. C  GLUT Fortran example demonstrating use of bitmap fonts.
  6. subroutine output(x,y,s)
  7. real x,y
  8. character s*(*)
  9. character c
  10. #include "GL/fgl.h"
  11. #include "GL/fglut.h"
  12. C  XXX Stroke and font names must be explicitly declared as
  13. C  external instead of relying on "GL/fglut.h" because
  14. C  the IRIX Fortran compiler does not know to only
  15. C  link in used external data symbols.
  16. external GLUT_BITMAP_TIMES_ROMAN_24
  17. call fglrasterpos2f(x,y)
  18. lenc = len(s)
  19. do 10, i=1,lenc
  20.   c = s(i:i)
  21.   call glutbitmapcharacter(GLUT_BITMAP_TIMES_ROMAN_24,
  22.      2      ichar(c))
  23. 10 continue
  24. end
  25. subroutine display
  26. #include "GL/fgl.h"
  27. #include "GL/fglut.h"
  28. call fglclear(GL_COLOR_BUFFER_BIT)
  29. call output(0.0,24.0,
  30.      2    'This is written in a GLUT bitmap font.')
  31. call output(100.0,100.0,'ABCDEFGabcdefg')
  32. call output(50.0,145.0,
  33.      2    '(positioned in pixels with upper-left origin)')
  34. end
  35. subroutine reshape(w,h)
  36. integer w, h
  37. #include "GL/fgl.h"
  38. #include "GL/fglu.h"
  39. call fglviewport(0, 0, w, h)
  40. call fglmatrixmode(GL_PROJECTION)
  41. call fglloadidentity
  42. call fgluortho2d(dble(0.0), dble(w), dble(0.0), dble(h))
  43. call fglscalef(1.0, -1.0, 1.0)
  44. call fgltranslatef(real(0.0), real(-h), real(0.0))
  45. call fglmatrixmode(GL_MODELVIEW)
  46. end
  47. program main
  48. #include "GL/fglut.h"
  49. external display
  50. external reshape
  51. integer win
  52. call glutinitdisplaymode(GLUT_RGB + GLUT_SINGLE)
  53. call glutinitwindowsize(500, 150)
  54. call glutinit
  55. win = glutcreatewindow('Fortran GLUT bitmap A')
  56. call fglclearcolor(0.0, 0.0, 0.0, 1.0)
  57. call glutdisplayfunc(display)
  58. call glutreshapefunc(reshape)
  59. call glutmainloop
  60. end