Here is what I came up with:
dos also memory also
\needs glconst | import glconst
\needs xconst | import xconst
\needs float | import float
float also glconst also x11 also opengl also
Create .white !&1 f>fs , !&1 f>fs , !&1 f>fs , !1 f>fs ,
Create .bluish !&0.5 f>fs , !&0.5 f>fs , !&0.75 f>fs , !&1.0 f>fs ,
variable name-string
xconst also minos also
: buildFont ( -- n )
\ s" fixed"
s" -*-helvetica-*-r-*-*-25-*-*-*-*-*-*-*"
name-string $!
0 name-string $@ + c! name-string $@ drop
screen xrc dpy @ XLoadQueryFont
dup 0= abort" Font not found"
dup XFontStruct fid @
32 250
250 glGenLists dup >r
glXUseXFont
screen xrc dpy @ XFreeFont drop r> ;
previous
: init-OpenGL ( -- )
GL_CCW glFrontFace
GL_TRUE glDepthMask
GL_LIGHT0 GL_POINT_SMOOTH GL_BLEND GL_LIGHTING
GL_FOG GL_CULL_FACE GL_DEPTH_TEST GL_NORMALIZE
8 0 ?DO glEnable LOOP
GL_BACK glCullFace
GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST
glTexParameteri
GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_NEAREST
glTexParameteri
GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE GL_MODULATE glTexEnvi ;
: init-device ( fnear ffar w h -- ) { f: near f: far w h }
0 0 w h glViewport
GL_PROJECTION glMatrixMode glLoadIdentity
w h > IF
w s>f h fm/ fdup fnegate fswap !-1 !1
ELSE
!-1 !1 h s>f w fm/ fdup fnegate fswap
THEN near far glFrustum
.bluish [EMAIL PROTECTED] [EMAIL PROTECTED] [EMAIL PROTECTED] sf@
glClearColor
GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT or glClear
GL_MODELVIEW glMatrixMode glLoadIdentity ;
: itoa ( n -- addr u ) extend <# #s #> ;
: draw-text ( x y -- )
{ alx aly |
glcanvas with
!&5 !&10 w @ h @ init-device
init-OpenGL
GL_LIGHTING glDisable
-1 1 -7 glRasterPos3i
GL_LIST_BIT glPushAttrib
1 32 - glListBase
GL_UNSIGNED_BYTE s" OpenGL bitmap font usage example" -rot
glCallLists glPopAttrib
-1 -1 -7 glRasterPos3i
GL_LIST_BIT glPushAttrib
1 32 - glListBase
GL_UNSIGNED_BYTE s" use left mouse button for rotation" -rot
glCallLists glPopAttrib
GL_LIGHTING glEnable
GL_LIST_BIT glPushAttrib
!0 !0 !-6 glTranslatef
alx s>f !1000 f/ !1 !0 !0 glRotatef
aly s>f !1000 f/ !0 !1 !0 glRotatef
glPushMatrix
\ alx s>f !1000 f/ !1 !0 !0 glRotatef
\ aly s>f !1000 f/ !0 !1 !0 glRotatef
1 32 - glListBase
6 0 do
!2 pi f* i s>f !6 f/ f* fcos !.5
f* !2 pi f* i s>f !6 f/ f* fsin !.5 f* !0 glRasterPos3f
GL_UNSIGNED_BYTE i itoa -rot glCallLists
loop
glPopAttrib
glPopMatrix
endwith } ;
previous previous previous
#! xbigforth
\ automatic generated code
\ do not edit
also editor also minos also forth
component class oglf
public:
early widget
early open
early dialog
early open-app
glcanvas ptr oglfont
( [varstart] ) cell var fbase
cell var axold
cell var ayold
cell var alphax
cell var alphay
cell var oglf-task ( [varend] )
how:
: open new DF[ 0 ]DF s" openGL font" open-component ;
: dialog new DF[ 0 ]DF s" openGL font" open-dialog ;
: open-app new DF[ 0 ]DF s" openGL font" open-application ;
class;
include ogl-font-example.fs
oglf implements
( [methodstart] ) : drawfont
oglf-task @ 0= IF
buildFont fbase !
\ s" Bitmap font usage example" name-string $!
THEN
oglfont self
alphax @ alphay @ draw-text ;
: redraw-font oglfont render oglfont draw ;
: mouse-rotate ( x y b n -- )
drop
DOPRESS
rot - oglfont h @ 2/ - s>f oglfont h @ 2/ s>f f/ !1000 f* !360 f*
f>s axold @ + 360000 mod alphax ! - oglfont w @ 2/ - s>f oglfont w @ 2/
f>s>f f/ !1000 f* !360 f* f>s
ayold @ + 360000 mod alphay ! redraw-font ;
( [methodend] )
: widget ( [dumpstart] )
GL[ outer with drawfont endwith ]GL ( MINOS ) ^^ CK[ ( x y b n
-- ) 1 = if
dup 1 = if
mouse-rotate
alphax @ axold !
alphay @ ayold !
drawfont
EXIT
then
drop 2drop
else
drop 2drop
then
]CK ( MINOS ) $12C $1 *hfill $12C $1 *vfill glcanvas new ^^bind
oglfont ^^ S[ close ]S ( MINOS ) S" done" button new
&1 habox new vfixbox
&2 vabox new
( [dumpend] ) ;
: init ^>^^ assign widget 1 super init ;
class;
: main
oglf open-app
$1 0 ?DO stop LOOP bye ;
script? [IF] main [THEN]
previous previous previous
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
