Menu
▾
▴
[Win32forth-cvs] win32forth/apps/Chess Opengl.f,1.3,1.4
|
From: Jos v.d.V. <jo...@us...> - 2005-10-05 15:40:44
|
Update of /cvsroot/win32forth/win32forth/apps/Chess In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31574/apps/Chess Modified Files: Opengl.f Log Message: Andrew: modified 2f' 3f' to use short jumps in the assembler code and removed [edi] from FRESULT assembler code Index: Opengl.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Chess/Opengl.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Opengl.f 20 Jun 2005 07:40:43 -0000 1.3 --- Opengl.f 5 Oct 2005 15:40:36 -0000 1.4 *************** *** 169,175 **** Saturday, June 18 2005 gah ! - modified to use 3reverse and 4reverse as suggested by Andrew Stevenson - modified stack comments to use -- for consistency )) --- 169,179 ---- Saturday, June 18 2005 gah ! - modified to use 3reverse and 4reverse as suggested by Andrew Stephenson - modified stack comments to use -- for consistency + Thursday, September 29 2005 aws + - modified 2f' 3f' to use short jumps in the assembler code and + removed [edi] from FRESULT assembler code + )) *************** *** 199,206 **** \ to the Win32Forth float stack code FRESULT ( x -- ) ( FS: -- r ) ! mov ecx, FSP [edi] ! fstp FSIZE FSTACK [ecx] [edi] add ecx, # B/FLOAT ! mov FSP [edi], ecx pop ebx next, --- 203,210 ---- \ to the Win32Forth float stack code FRESULT ( x -- ) ( FS: -- r ) ! mov ecx, FSP ! fstp FSIZE FSTACK [ecx] add ecx, # B/FLOAT ! mov FSP , ecx pop ebx next, *************** *** 216,220 **** mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! js L$3 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx --- 220,224 ---- mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! js short L$3 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx *************** *** 223,229 **** fstp float 0 [esp] pop ebx ! L$2: mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! js L$3 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx --- 227,233 ---- fstp float 0 [esp] pop ebx ! mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! js short L$3 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx *************** *** 233,237 **** fwait pop ebx ! jmp L$4 L$3: mov esi, # ' FSTKUFLO >body add esi, edi --- 237,241 ---- fwait pop ebx ! jmp short L$4 L$3: mov esi, # ' FSTKUFLO >body add esi, edi *************** *** 244,248 **** mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! js L$5 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx --- 248,252 ---- mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! js short L$5 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx *************** *** 251,257 **** fstp float 0 [esp] pop ebx ! L$2: mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! js L$5 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx --- 255,261 ---- fstp float 0 [esp] pop ebx ! mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! js short L$5 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx *************** *** 261,265 **** pop ebx sub ecx, # B/FLOAT ! js L$5 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx --- 265,269 ---- pop ebx sub ecx, # B/FLOAT ! js short L$5 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx *************** *** 269,273 **** fwait pop ebx ! jmp L$6 L$5: mov esi, # ' FSTKUFLO >body add esi, edi --- 273,277 ---- fwait pop ebx ! jmp short L$6 L$5: mov esi, # ' FSTKUFLO >body add esi, edi *************** *** 286,296 **** : 2d' ( f: f1 f0 -- ) ( -- d0 d1 ) ! s" df>stack df>stack " evaluate ; immediate : 3d' ( f: f2 f1 f0 -- ) ( -- d0 d1 d2 ) ! s" df>stack df>stack df>stack " evaluate ; immediate : 4d' ( f: f3 f2 f1 f0 -- ) ( -- d0 d1 d2 d3 ) ! s" df>stack df>stack df>stack df>stack " evaluate ; immediate : nd' ( f: fx..f0 -- ) ( k -- dt0..dx ) --- 290,300 ---- : 2d' ( f: f1 f0 -- ) ( -- d0 d1 ) ! s" df>stack df>stack " evaluate ; immediate : 3d' ( f: f2 f1 f0 -- ) ( -- d0 d1 d2 ) ! s" df>stack df>stack df>stack " evaluate ; immediate : 4d' ( f: f3 f2 f1 f0 -- ) ( -- d0 d1 d2 d3 ) ! s" df>stack df>stack df>stack df>stack " evaluate ; immediate : nd' ( f: fx..f0 -- ) ( k -- dt0..dx ) *************** *** 340,344 **** : glDisable ( cap -- ) call glDisable drop ; : glViewport ( x y width height -- ) 4reverse call glViewport drop ; ! : glGetFloatv ( pname *params -- ) swap call glGetFloatv drop ; : glShadeModel ( mode -- ) call glShadeModel drop ; : glLightModelfv ( pname *param -- ) swap call glLightModelfv drop ; --- 344,348 ---- : glDisable ( cap -- ) call glDisable drop ; : glViewport ( x y width height -- ) 4reverse call glViewport drop ; ! : glGetFloatv ( pname *params -- ) swap call glGetFloatv drop ; : glShadeModel ( mode -- ) call glShadeModel drop ; : glLightModelfv ( pname *param -- ) swap call glLightModelfv drop ; *************** *** 356,364 **** : gluQuadricDrawStyle ( qobj style -- ) swap call gluQuadricDrawStyle drop ; : gluQuadricNormals ( qobj normals -- ) swap call gluQuadricNormals drop ; ! : gluBeginCurve ( *nobj -- ) call gluBeginCurve drop ; ! : gluEndCurve ( *nobj -- ) call gluEndCurve drop ; ! : gluNewNurbsRenderer ( -- *nobj ) call gluNewNurbsRenderer ; >>> ! : glSelectBuffer ( size buffer -- ) swap call glSelectBuffer drop ; : glRenderMode ( mode -- 0|#sel|val ) call glRenderMode ; : glInitNames ( -- ) call glInitNames drop ; --- 360,368 ---- : gluQuadricDrawStyle ( qobj style -- ) swap call gluQuadricDrawStyle drop ; : gluQuadricNormals ( qobj normals -- ) swap call gluQuadricNormals drop ; ! : gluBeginCurve ( *nobj -- ) call gluBeginCurve drop ; ! : gluEndCurve ( *nobj -- ) call gluEndCurve drop ; ! : gluNewNurbsRenderer ( -- *nobj ) call gluNewNurbsRenderer ; >>> ! : glSelectBuffer ( size buffer -- ) swap call glSelectBuffer drop ; : glRenderMode ( mode -- 0|#sel|val ) call glRenderMode ; : glInitNames ( -- ) call glInitNames drop ; *************** *** 368,384 **** : glGetIntegerv ( pname *params -- ) swap call glGetIntegerv drop ; : gluPickMatrix ( f: x y width height -- ) ( viewport -- ) ! 4d' call gluPickMatrix drop ; : glReadPixels ( f: x y width height -- ) ( format type *pixels -- ) ! 3reverse 2>r >r 4f' r> 2r> call glReadPixels drop ; : glPixelStorei ( pname param -- ) swap call glPixelStorei drop ; : glDepthRange ( f: near far -- ) 2d' call glDepthRange drop ; \ : gluDeleteQuadric ( qobj -- ) call gluDeleteQuadric drop ; : wglUseFontBitmaps ( ghdc 1st_char #chars baselist -- ) ! 4reverse call wglUseFontBitmaps drop ; : glBindTexture ( target name -- ) swap call glBindTexture drop ; : glGenTextures ( GLsizei *name -- ) swap call glGenTextures drop ; : glTexParameteri ( target pname param -- ) 3reverse call glTexParameteri drop ; : glTexImage2D ( target level components width height border format type *pixels -- ) ! 9 s-reverse call glTexImage2D drop ; : glTexEnvi ( target pname param -- ) 3reverse call glTexEnvi drop ; --- 372,388 ---- : glGetIntegerv ( pname *params -- ) swap call glGetIntegerv drop ; : gluPickMatrix ( f: x y width height -- ) ( viewport -- ) ! 4d' call gluPickMatrix drop ; : glReadPixels ( f: x y width height -- ) ( format type *pixels -- ) ! 3reverse 2>r >r 4f' r> 2r> call glReadPixels drop ; : glPixelStorei ( pname param -- ) swap call glPixelStorei drop ; : glDepthRange ( f: near far -- ) 2d' call glDepthRange drop ; \ : gluDeleteQuadric ( qobj -- ) call gluDeleteQuadric drop ; : wglUseFontBitmaps ( ghdc 1st_char #chars baselist -- ) ! 4reverse call wglUseFontBitmaps drop ; : glBindTexture ( target name -- ) swap call glBindTexture drop ; : glGenTextures ( GLsizei *name -- ) swap call glGenTextures drop ; : glTexParameteri ( target pname param -- ) 3reverse call glTexParameteri drop ; : glTexImage2D ( target level components width height border format type *pixels -- ) ! 9 s-reverse call glTexImage2D drop ; : glTexEnvi ( target pname param -- ) 3reverse call glTexEnvi drop ; *************** *** 403,407 **** : gluNurbsProperty ( *nobj property -- ) ( f: value -- ) ! f' 3reverse call gluNurbsProperty drop ; : glClearColor ( f: GLclampf_red GLclampf_green GLclampf_blue GLclampf_alpha -- ) --- 407,411 ---- : gluNurbsProperty ( *nobj property -- ) ( f: value -- ) ! f' 3reverse call gluNurbsProperty drop ; : glClearColor ( f: GLclampf_red GLclampf_green GLclampf_blue GLclampf_alpha -- ) *************** *** 415,431 **** : gluPerspective ( f: fovy aspect near far -- ) ! 4d' call gluPerspective drop ; : gluCylinder ( *qobj stacks slices -- ) ( f: height topRadius baseRadius -- ) ! >r swap 3d' r> call gluCylinder drop ; : gluDisk ( *qobj -- ) ( f: innerRadius outerRadius stacks loops -- ) ! >r f>s f>s 2d' r> call gluDisk drop ; : gluPartialDisk ( *qobj -- ) ( f: innerRadius outerRadius stacks loops startAngle sweepAngle -- ) ! >r 2d' f>s f>s 2d' r> call gluPartialDisk drop ; : gluLookAt ( f: eyex eyey eyez centerx centery centerz upx upy upz -- ) ! 9 nd' call gluLookAt drop ; --- 419,435 ---- : gluPerspective ( f: fovy aspect near far -- ) ! 4d' call gluPerspective drop ; : gluCylinder ( *qobj stacks slices -- ) ( f: height topRadius baseRadius -- ) ! >r swap 3d' r> call gluCylinder drop ; : gluDisk ( *qobj -- ) ( f: innerRadius outerRadius stacks loops -- ) ! >r f>s f>s 2d' r> call gluDisk drop ; : gluPartialDisk ( *qobj -- ) ( f: innerRadius outerRadius stacks loops startAngle sweepAngle -- ) ! >r 2d' f>s f>s 2d' r> call gluPartialDisk drop ; : gluLookAt ( f: eyex eyey eyez centerx centery centerz upx upy upz -- ) ! 9 nd' call gluLookAt drop ; *************** *** 434,443 **** : gluNurbsCurve ( *nobj nknots *knot stride *ctlarray order type -- ) ! 3reverse 3 roll 4 roll 5 roll 6 roll call gluNurbsCurve drop ; 1 CallBack: nurbsError ( arg -- f ) ( return ) 1 ; : gluNurbsCallback ( *nobj which nurbsError -- errorcode ) ! 3reverse call gluNurbsCallback ; : .gluerror ( *nobj -- ) GLU_ERROR &nurbsError gluNurbsCallback . ; --- 438,447 ---- : gluNurbsCurve ( *nobj nknots *knot stride *ctlarray order type -- ) ! 3reverse 3 roll 4 roll 5 roll 6 roll call gluNurbsCurve drop ; 1 CallBack: nurbsError ( arg -- f ) ( return ) 1 ; : gluNurbsCallback ( *nobj which nurbsError -- errorcode ) ! 3reverse call gluNurbsCallback ; : .gluerror ( *nobj -- ) GLU_ERROR &nurbsError gluNurbsCallback . ; *************** *** 623,632 **** : floats! ( adr k -- ) ( FS: fk..f0 -- ) ! 0 do dup i >f! ! loop drop ; : 0floats! ( adr k -- ) ! 0 do 0e dup i >f! ! loop drop ; defer fref3D ( -- adr k ) \ when deferred --- 627,636 ---- : floats! ( adr k -- ) ( FS: fk..f0 -- ) ! 0 do dup i >f! ! loop drop ; : 0floats! ( adr k -- ) ! 0 do 0e dup i >f! ! loop drop ; defer fref3D ( -- adr k ) \ when deferred *************** *** 649,660 **** : +value$>fparams$ \ f: ( n -- ) fdup fabs 1000000e f> ! if s" ..." ! else fdup fabs 1000e f> ! if 7 ! else 4 ! then sigdigits ! ! pad fvalue-to-string s" e " pad ! +place pad count ! then fparams$ +place ; --- 653,664 ---- : +value$>fparams$ \ f: ( n -- ) fdup fabs 1000000e f> ! if s" ..." ! else fdup fabs 1000e f> ! if 7 ! else 4 ! then sigdigits ! ! pad fvalue-to-string s" e " pad ! +place pad count ! then fparams$ +place ; *************** *** 743,748 **** : fm+ ( adr-floats-to-add addr-floats-result -- ) ! dup>r rot = 0= abort" The number of floats not equal." ! swap r@ floats@ dup r@ floatsf@+ r> floats! ; --- 747,752 ---- : fm+ ( adr-floats-to-add addr-floats-result -- ) ! dup>r rot = 0= abort" The number of floats not equal." ! swap r@ floats@ dup r@ floatsf@+ r> floats! ; *************** *** 785,789 **** : -zz ( -- adr-flookat ) ( F: -- f ) fref3D 0 addr#floats+@ distance f- ; ! : zr ( -- adr-flookat flag ) ( F: zoom -- ) fref3D 3 2dup <= if 2drop false --- 789,793 ---- : -zz ( -- adr-flookat ) ( F: -- f ) fref3D 0 addr#floats+@ distance f- ; ! : zr ( -- adr-flookat flag ) ( F: zoom -- ) fref3D 3 2dup <= if 2drop false *************** *** 792,800 **** ; ! : -zr ( -- adr-flookat flag ) ( F: zoom -- ) ! fref3D 3 2dup <= ! if 2drop false ! else addr#floats+@ rdistance f- true ! then ; --- 796,804 ---- ; ! : -zr ( -- adr-flookat flag ) ( F: zoom -- ) ! fref3D 3 2dup <= ! if 2drop false ! else addr#floats+@ rdistance f- true ! then ; *************** *** 961,965 **** VK_= of incr_interval endof \ incr \ ascii A of ['] fref3TransT is-fref3D ! \ fref4RotD fref3TransT move_forward endof \ move forwards \ ascii B of ['] fref3TransT is-fref3D \ fref4RotD fref3TransT move_backward endof \ move backward --- 965,969 ---- VK_= of incr_interval endof \ incr \ ascii A of ['] fref3TransT is-fref3D ! \ fref4RotD fref3TransT move_forward endof \ move forwards \ ascii B of ['] fref3TransT is-fref3D \ fref4RotD fref3TransT move_backward endof \ move backward *************** *** 988,996 **** : .text-line ( str$ count -- ) ! swap 0 0 ghdc call TextOut drop ; false value ignore_esc : showing-bitmap(s)? ( -- flag ) ! ['] _load-bitmap ['] painting >body @ = ; : key-event ( VK_key -- ) --- 992,1000 ---- : .text-line ( str$ count -- ) ! swap 0 0 ghdc call TextOut drop ; false value ignore_esc : showing-bitmap(s)? ( -- flag ) ! ['] _load-bitmap ['] painting >body @ = ; : key-event ( VK_key -- ) *************** *** 1152,1156 **** : [object ( fill -- ) ( f: xt yt zt -- ) ! glPushMatrix_glTranslatef [quad_object ; : [scaled-object ( fill -- ) ( f: xs ys zs xt yt zt -- ) --- 1156,1160 ---- : [object ( fill -- ) ( f: xt yt zt -- ) ! glPushMatrix_glTranslatef [quad_object ; : [scaled-object ( fill -- ) ( f: xs ys zs xt yt zt -- ) *************** *** 1161,1165 **** : [rot-scaled-object-inline ( fill -- ) ( f: deg xg yg zg xs ys zs xt yt zt -- ) ! glTranslatef glscalef glRotatef [quad_object ; : [rot-object ( fill -- ) ( f: deg xg yg zg xt yt zt -- ) --- 1165,1169 ---- : [rot-scaled-object-inline ( fill -- ) ( f: deg xg yg zg xs ys zs xt yt zt -- ) ! glTranslatef glscalef glRotatef [quad_object ; : [rot-object ( fill -- ) ( f: deg xg yg zg xt yt zt -- ) *************** *** 1174,1178 **** : cylinder ( stacks slices basef topf heightf -- ) [quad ! 3f' qobj call gluCylinder drop quad] ; --- 1178,1182 ---- : cylinder ( stacks slices basef topf heightf -- ) [quad ! 3f' qobj call gluCylinder drop quad] ; *************** *** 1234,1238 **** : clear-buffer ( -- ) ! GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT OR glClear ; : cls-openGL ( -- ) --- 1238,1242 ---- : clear-buffer ( -- ) ! GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT OR glClear ; : cls-openGL ( -- ) *************** *** 1279,1283 **** : 3Ddot ( f: 2*size -- ) ! 3fdups glVertex3f fdup fnegate fover glVertex3f ; --- 1283,1287 ---- : 3Ddot ( f: 2*size -- ) ! 3fdups glVertex3f fdup fnegate fover glVertex3f ; *************** *** 1331,1335 **** : rectangle-obj ( f: width height depth -- ) \ Note: The sizes will be 2* ! fto c3 fto c2 fto c1 _box ; : cube ( f: size -- ) --- 1335,1339 ---- : rectangle-obj ( f: width height depth -- ) \ Note: The sizes will be 2* ! fto c3 fto c2 fto c1 _box ; : cube ( f: size -- ) *************** *** 1377,1381 **** : box_sizes@ ( adr-struct-box -- ) ( f: -- width height depth ) ! dup fbox_x f@ dup fbox_y f@ fbox_z f@ ; : rotatef! ( degrees adr-struct-obj -- degrees ) ( f: x y z -- ) --- 1381,1385 ---- : box_sizes@ ( adr-struct-box -- ) ( f: -- width height depth ) ! dup fbox_x f@ dup fbox_y f@ fbox_z f@ ; : rotatef! ( degrees adr-struct-obj -- degrees ) ( f: x y z -- ) *************** *** 1415,1419 **** : set-speed-degrees ( -- ) #frames-to-do$ dup ms-slow-action #cycles-1-second val>$ ! oglwin-base Start: Degree/sec not abort" Stop. Maximum degrees / second is not changed." #frames-to-do$ count number? not --- 1419,1423 ---- : set-speed-degrees ( -- ) #frames-to-do$ dup ms-slow-action #cycles-1-second val>$ ! oglwin-base Start: Degree/sec not abort" Stop. Maximum degrees / second is not changed." #frames-to-do$ count number? not *************** *** 1447,1449 **** \s ! |
