REQUIRE WFL ~day/wfl/wfl.f
NEEDS ~ygrek/lib/wfl/opengl/GLWindow.f
NEEDS ~day/common/clparam.f
NEEDS ~ygrek/lib/neilbawd/mersenne.f
NEEDS font.f
: PrepareLight
GL_NORMALIZE glEnable DROP \ Enable normalization of normales
GL_COLOR_MATERIAL glEnable DROP \ The color is treated as the material color
|| CGLPoint p ||
0.2e 0.2e 0.2e 0.5e p :set4
\ p :getv GL_AMBIENT GL_LIGHT1 glLightfv DROP
0.6e 0.6e 0.6e 1.0e p :set4
p :getv GL_DIFFUSE GL_LIGHT1 glLightfv DROP
0.0e 0.0e 0.0e -1.0e p :set4
p :getv GL_POSITION GL_LIGHT1 glLightfv DROP
0.8e 0.8e 0.8e 1.0e p :set4
\ p :getv GL_SPECULAR GL_LIGHT1 glLightfv DROP
GL_LIGHT1 glEnable DROP \ Enable our light source
GL_LIGHTING glEnable DROP \ Enable lighting in general
;
CGLText NEW text
CGLWindow SUBCLASS CMyGLWindow
: :prepare
SUPER :prepare
SUPER _hDC @ text zinit
PrepareLight ;
;CLASS
CGLObject SUBCLASS Text1
: :draw
SUPER :draw
1.0e 1.0e 1.0e SetColor
15.0e 15.0e 0.0e SUPER :setShift
5e 0e 0.0e SUPER :setAngleSpeed
S" Very funny indeed bu bu bu" text write ;
;CLASS
\ -----------------------------------------------------------------------
0 VALUE list1
: FGENRANDMAX ( F: max -- f ) FGENRAND F* ;
: FGENRANDABS ( F: abs -- f ) 2e F* FGENRAND 0.5e F- F* ;
: test ( -- n )
|| CMyGLWindow aa CMessageLoop loop D: m CTimer timer Text1 t ||
CGLObjectList NewObj TO list1
10 0 DO
10 0 DO
CGLCube NewObj
DUP 0.75e :: CGLCube.:resize
DUP 0e I DS>F 3e F* F+ 0e J DS>F 3e F* F+ -20e :: CGLObject.:setShift
DUP 5e FGENRANDABS 5e FGENRANDABS 5e FGENRANDABS :: CGLObject.:setAngleSpeed
list1 :: CGLObjectList.:add
LOOP
LOOP
list1 aa :add
t this aa :add
-15e -15e -40e aa :setShift
0 aa create DROP
SW_SHOW aa showWindow
timer :start
loop run
timer :stop
timer :ms@ CR ." Total time = " .
;
test