You can subscribe to this list here.
2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(70) |
---|---|---|---|---|---|---|---|---|---|---|---|---|
2005 |
Jan
(38) |
Feb
(4) |
Mar
(11) |
Apr
(49) |
May
(81) |
Jun
(65) |
Jul
(36) |
Aug
(57) |
Sep
(63) |
Oct
(57) |
Nov
(49) |
Dec
(41) |
2006 |
Jan
(75) |
Feb
(80) |
Mar
(10) |
Apr
(13) |
May
(100) |
Jun
(100) |
Jul
(77) |
Aug
(87) |
Sep
(80) |
Oct
(124) |
Nov
(39) |
Dec
(41) |
2007 |
Jan
(20) |
Feb
(32) |
Mar
(32) |
Apr
(43) |
May
(146) |
Jun
(40) |
Jul
(49) |
Aug
(33) |
Sep
(25) |
Oct
(19) |
Nov
(11) |
Dec
(8) |
2008 |
Jan
(4) |
Feb
(11) |
Mar
(31) |
Apr
(40) |
May
(34) |
Jun
(24) |
Jul
(39) |
Aug
(104) |
Sep
(27) |
Oct
(35) |
Nov
(34) |
Dec
(97) |
2009 |
Jan
(75) |
Feb
(29) |
Mar
(45) |
Apr
(76) |
May
(121) |
Jun
(103) |
Jul
(67) |
Aug
(28) |
Sep
(22) |
Oct
(39) |
Nov
(9) |
Dec
(15) |
2010 |
Jan
(7) |
Feb
(39) |
Mar
(40) |
Apr
(57) |
May
(67) |
Jun
(69) |
Jul
(49) |
Aug
(68) |
Sep
(22) |
Oct
(7) |
Nov
(2) |
Dec
(10) |
2011 |
Jan
|
Feb
|
Mar
(10) |
Apr
(4) |
May
(6) |
Jun
(10) |
Jul
(16) |
Aug
(23) |
Sep
(9) |
Oct
|
Nov
(28) |
Dec
(3) |
2012 |
Jan
(11) |
Feb
(10) |
Mar
(1) |
Apr
|
May
(4) |
Jun
(3) |
Jul
(3) |
Aug
(4) |
Sep
(2) |
Oct
|
Nov
|
Dec
(1) |
2013 |
Jan
|
Feb
(7) |
Mar
(30) |
Apr
(4) |
May
(4) |
Jun
(8) |
Jul
(10) |
Aug
(4) |
Sep
|
Oct
(2) |
Nov
(24) |
Dec
(13) |
2014 |
Jan
(7) |
Feb
(2) |
Mar
|
Apr
(1) |
May
(9) |
Jun
|
Jul
(3) |
Aug
(9) |
Sep
|
Oct
(2) |
Nov
|
Dec
(3) |
2015 |
Jan
(4) |
Feb
(2) |
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
(1) |
Oct
(4) |
Nov
(7) |
Dec
(39) |
2016 |
Jan
(17) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(1) |
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(1) |
Dec
(2) |
2017 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(1) |
Jun
(2) |
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
|
Dec
(2) |
2018 |
Jan
|
Feb
|
Mar
(2) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
2019 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
2022 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(1) |
Jun
|
Jul
|
Aug
|
Sep
(1) |
Oct
(2) |
Nov
(1) |
Dec
(1) |
2023 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
|
Oct
(1) |
Nov
|
Dec
|
From: Jos v.d.V. <jo...@us...> - 2016-01-11 20:02:21
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthInstaller In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv6238 Modified Files: Mkdir.f Log Message: Jos: F ascii-z made it running out of memory Index: Mkdir.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthInstaller/Mkdir.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Mkdir.f 9 Jan 2016 14:51:18 -0000 1.1 --- Mkdir.f 11 Jan 2016 20:02:19 -0000 1.2 *************** *** 3,7 **** : GetFileAttributes ( addr u -- FileAttributes ) \ *G Returns the file system attributes for a specified file or directory. ! temp$ ascii-z Call GetFileAttributesA ; : dir-exist? ( addr u -- flag ) --- 3,8 ---- : GetFileAttributes ( addr u -- FileAttributes ) \ *G Returns the file system attributes for a specified file or directory. ! MAX_PATH 1+ LocalAlloc dup>r place ! r@ +null r> 1+ Call GetFileAttributesA ; : dir-exist? ( addr u -- flag ) *************** *** 18,22 **** r> ; ! : find-missing { adr cnt -- adr-top n } \ *G Finds the first missing directory. adr cnt 3 /string --- 19,23 ---- r> ; ! : find-missing { adr cnt -- adr n-first-dir } \ *G Finds the first missing directory. adr cnt 3 /string *************** *** 26,30 **** then while 1+ adr cnt rot /string ! repeat temp$ swap ; --- 27,31 ---- then while 1+ adr cnt rot /string ! repeat adr swap ; *************** *** 32,40 **** \ *G Create the specified directory including the needed directory tree \ ** when needed. begin 2dup find-missing dup ! while 0 -rot drop 1+ call CreateDirectory 0= abort" Failed to create the install directory" repeat ! 4drop ; --- 33,42 ---- \ *G Create the specified directory including the needed directory tree \ ** when needed. + MAX_PATH 1+ LocalAlloc >r begin 2dup find-missing dup ! while 0 -rot r@ place r@ dup +null 1+ call CreateDirectory 0= abort" Failed to create the install directory" repeat ! 4drop r> drop ; |
From: Jos v.d.V. <jo...@us...> - 2016-01-10 13:54:11
|
Update of /cvsroot/win32forth/win32forth In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv21656 Modified Files: fkernel.exe Log Message: Jos: Includes the updates for the new installer. Index: fkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth/fkernel.exe,v retrieving revision 1.67 retrieving revision 1.68 diff -C2 -d -r1.67 -r1.68 Binary files /tmp/cvs0Fex1p and /tmp/cvsQNuWfP differ |
From: Jos v.d.V. <jo...@us...> - 2016-01-09 15:13:35
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthInstaller In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv23472 Modified Files: Win32ForthInstaller.txt Log Message: Jos: Added more needed explanation Index: Win32ForthInstaller.txt =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthInstaller/Win32ForthInstaller.txt,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Win32ForthInstaller.txt 9 Jan 2016 14:51:18 -0000 1.1 --- Win32ForthInstaller.txt 9 Jan 2016 15:13:33 -0000 1.2 *************** *** 2,7 **** 1.Change the version number in src\kernel\version.f ! 2.Load Win32ForthInstaller.f in the IDE and compile it ! 3.In the Win32Forth directory will be a new program called w32fNNNNN.exe containing the installer and the needed compressed files. --- 2,8 ---- 1.Change the version number in src\kernel\version.f ! 2 Make a new kernel and extend it with setup.exe ! 3.Load Win32ForthInstaller.f in the IDE and compile it ! 4.In the Win32Forth directory will be a new program called w32fNNNNN.exe containing the installer and the needed compressed files. |
From: Jos v.d.V. <jo...@us...> - 2016-01-09 14:54:14
|
Update of /cvsroot/win32forth/win32forth/src/kernel In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv22814 Modified Files: version.f Log Message: Jos: Setting the new release Index: version.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/kernel/version.f,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 *** version.f 9 Dec 2013 19:34:37 -0000 1.24 --- version.f 9 Jan 2016 14:54:11 -0000 1.25 *************** *** 3,7 **** cr .( Loading META version info) ! 61503 VALUE #VERSION# \ 70000 VALUE #VERSION# \ For future V7.xx.xx testing --- 3,7 ---- cr .( Loading META version info) ! 61504 VALUE #VERSION# \ 70000 VALUE #VERSION# \ For future V7.xx.xx testing |
From: Jos v.d.V. <jo...@us...> - 2016-01-09 14:49:29
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthInstaller In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv22633/Win32ForthInstaller Log Message: Directory /cvsroot/win32forth/win32forth/apps/Win32ForthInstaller added to the repository |
From: Jos v.d.V. <jo...@us...> - 2016-01-09 14:45:24
|
Update of /cvsroot/win32forth/win32forth/apps/Setup In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv22492 Modified Files: MakeSetup.bat Setup.f Log Message: Jos; Adapted for the new installer. Index: Setup.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Setup/Setup.f,v retrieving revision 1.33 retrieving revision 1.34 diff -C2 -d -r1.33 -r1.34 *** Setup.f 29 Dec 2015 13:00:13 -0000 1.33 --- Setup.f 9 Jan 2016 14:45:21 -0000 1.34 *************** *** 613,617 **** s" Setup.exe" prepend<home>\ (AddCheckSum) ! wait&bye \s --- 613,618 ---- s" Setup.exe" prepend<home>\ (AddCheckSum) ! \ wait&bye \ Was hanging the installation ! setup-bye \s Index: MakeSetup.bat =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Setup/MakeSetup.bat,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** MakeSetup.bat 21 Dec 2004 00:18:49 -0000 1.1 --- MakeSetup.bat 9 Jan 2016 14:45:21 -0000 1.2 *************** *** 1 **** --- 1,5 ---- + @echo off start ..\..\fkernel.exe fload Setup.f + echo . + echo Done + timeout /t 3 \ No newline at end of file |
From: Jos v.d.V. <jo...@us...> - 2016-01-09 13:35:37
|
Update of /cvsroot/win32forth/win32forth/apps/WinEd In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv19725 Modified Files: Ed_FrameWindowObj.F Ed_Globals.F Log Message: Jos: Making sure thet the window will be in the center at it's first use. Index: Ed_Globals.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/WinEd/Ed_Globals.F,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** Ed_Globals.F 2 Sep 2008 06:38:41 -0000 1.7 --- Ed_Globals.F 9 Jan 2016 13:35:35 -0000 1.8 *************** *** 28,33 **** 10000 value start-text-size \ initial text buffer size in bytes ! 760 value start-width \ was 640 ! 420 value start-height \ was 480 60 value drag-barH --- 28,33 ---- 10000 value start-text-size \ initial text buffer size in bytes ! 0 value start-width \ determined in Ed_FrameWindowObj.f ! 0 value start-height \ determined in Ed_FrameWindowObj.f 60 value drag-barH Index: Ed_FrameWindowObj.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/WinEd/Ed_FrameWindowObj.F,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** Ed_FrameWindowObj.F 17 Dec 2013 19:25:22 -0000 1.8 --- Ed_FrameWindowObj.F 9 Jan 2016 13:35:35 -0000 1.9 *************** *** 18,22 **** : abs-create-frame-window ( -- hwnd ) 0 0 \ adjust x,y relative to zero, zero ! StartSize: [ self ] \ width, height SetRect: EditRect ^base \ creation parameters --- 18,23 ---- : abs-create-frame-window ( -- hwnd ) 0 0 \ adjust x,y relative to zero, zero ! StartSize: [ self ] ! MinSize: [ self ] rot max -rot max swap \ width, height SetRect: EditRect ^base \ creation parameters *************** *** 58,62 **** : in-hdrag? ( -- f1 ) \ in horizontal drag bar hWnd get-mouse-xy \ -- x y ;mouse position - edit-top Height -status between swap drag-barH dup drag-thick + 2 + between and ; --- 59,62 ---- *************** *** 324,341 **** :M StartSize: ( -- width height ) \ starting window size ! start-width ! SM_CXSCREEN Call GetSystemMetrics 4 - ! StartPos: self drop - min \ screen width ! start-height ! SM_CYSCREEN Call GetSystemMetrics 4 - ! StartPos: self nip - min \ screen height ;M :M StartPos: ( -- x y ) ! OriginX 0max OriginY 0max ;M :M MinSize: ( -- width height ) \ minimum window size ! 0 -20 ;M --- 324,339 ---- :M StartSize: ( -- width height ) \ starting window size ! start-width start-height ;M :M StartPos: ( -- x y ) ! start-width 0= ! if CenterWindow: Self ! else OriginX 0max OriginY 0max ! then ;M :M MinSize: ( -- width height ) \ minimum window size ! 400 200 ;M |
From: Jos v.d.V. <jo...@us...> - 2016-01-08 16:05:38
|
Update of /cvsroot/win32forth/win32forth/src/kernel In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv30869 Modified Files: fkernel.f Log Message: Jos: Enables bigger sections. Index: fkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/kernel/fkernel.f,v retrieving revision 1.104 retrieving revision 1.105 diff -C2 -d -r1.104 -r1.105 *** fkernel.f 6 Aug 2014 12:30:30 -0000 1.104 --- fkernel.f 8 Jan 2016 16:05:36 -0000 1.105 *************** *** 4536,4540 **** @ @ 0x00FFFFFF and 0xC1C790 = ; \ nop mov ecx, # ?; used in see and debugger ! variable suppress suppress off : Sys-warn-does? ( newcode destxt -- ) --- 4536,4540 ---- @ @ 0x00FFFFFF and 0xC1C790 = ; \ nop mov ecx, # ?; used in see and debugger ! variable suppress : Sys-warn-does? ( newcode destxt -- ) *************** *** 4577,4581 **** PARMS-INIT DOCOL COMPILE, !CSP ] ; ! | VARIABLE ANON ANON OFF : :NONAME ( -- xt ) \ start a headerless colon definition --- 4577,4581 ---- PARMS-INIT DOCOL COMPILE, !CSP ] ; ! | VARIABLE ANON : :NONAME ( -- xt ) \ start a headerless colon definition |
From: Jos v.d.V. <jo...@us...> - 2016-01-03 17:58:55
|
Update of /cvsroot/win32forth/win32forth/src In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv24636 Modified Files: Utils.f Log Message: Jos: For the new installer which works outside &FORTHDIR Index: Utils.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Utils.f,v retrieving revision 1.33 retrieving revision 1.34 diff -C2 -d -r1.33 -r1.34 *** Utils.f 19 Aug 2015 10:53:22 -0000 1.33 --- Utils.f 3 Jan 2016 17:58:53 -0000 1.34 *************** *** 37,41 **** repeat ; - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ 5a Display the current file --- 37,40 ---- *************** *** 50,53 **** --- 49,59 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + \ 5b Set the current directory relative to the &forthdir + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + + : idir ( -<optional_new_directory>- -- ) + &forthdir count "chdir chdir ; + + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ |
From: Jos v.d.V. <jo...@us...> - 2016-01-02 22:41:50
|
Update of /cvsroot/win32forth/win32forth/src In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv12236 Modified Files: paths.f Log Message: Jos: Was not working when the string was not zero terminated. Index: paths.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/paths.f,v retrieving revision 1.41 retrieving revision 1.42 diff -C2 -d -r1.41 -r1.42 *** paths.f 16 Apr 2014 17:57:06 -0000 1.41 --- paths.f 2 Jan 2016 22:41:48 -0000 1.42 *************** *** 27,33 **** IN-APPLICATION ! : "chdir ( a1 n1 -- ) \ *G Set the current directory. ! IF $current-dir! THEN drop ; IN-SYSTEM --- 27,34 ---- IN-APPLICATION ! : "chdir ( a1 n1 -- ) { \ current$ } \ *G Set the current directory. ! MAX_PATH 1+ LocalAlloc: current$ dup ! IF current$ place current$ dup +null 1+ $current-dir! drop ELSE 2drop THEN ; IN-SYSTEM |
From: Jos v.d.V. <jo...@us...> - 2016-01-02 16:45:37
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv29785 Modified Files: TextBox.f Log Message: Jos: To avoid a warning during meta compiling. Index: TextBox.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/TextBox.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** TextBox.f 28 Nov 2013 20:51:55 -0000 1.6 --- TextBox.f 2 Jan 2016 16:45:35 -0000 1.7 *************** *** 98,104 **** --- 98,106 ---- swap 0 EM_SETMODIFY SendMessage:SelfDrop ;M + DPR-WARNING-OFF :M NotModified: ( -- ) \ *G Depreacted method. Use \i SetModify: \d instead. 0 0 EM_SETMODIFY SendMessage:SelfDrop ;M DEPRECATED + DPR-WARNING-ON :M Undo?: ( -- f ) *************** *** 327,333 **** --- 329,338 ---- 0 EM_GETSELTEXT SendMessage:self ;M + DPR-WARNING-OFF :M GetLines: ( -- nr ) \ *G Depreacted method. Use \i GetLineCount: \d instead. GetLineCount: super ;M DEPRECATED + DPR-WARNING-ON + ;Class \ *G End of RichEditControl class |
From: Jos v.d.V. <jo...@us...> - 2015-12-30 11:41:51
|
Update of /cvsroot/win32forth/win32forth/apps/Setup In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv30841 Modified Files: HYPER.F Log Message: Jos: Avoiding duplicate byte-array. Index: HYPER.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Setup/HYPER.F,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** HYPER.F 26 Aug 2006 15:25:31 -0000 1.4 --- HYPER.F 30 Dec 2015 11:41:49 -0000 1.5 *************** *** 32,38 **** file to search or build. ! )) anew -hyper.f cr .( Loading Hyper...) --- 32,39 ---- file to search or build. ! )) anew -hyper.f + needs sub_dirs.f cr .( Loading Hyper...) *************** *** 244,247 **** --- 245,254 ---- ?word.terminate \ 5 stop scanning the file if this is found ; + defined byte-array nip not [IF] + + : byte-array ( n1 -<name>- ) \ compile time + ( -- a1 ) \ runtime + create 1+ here over allot swap erase ; + [THEN] 64 constant b/tbl *************** *** 526,530 **** : build-index ( --- ) ! current-dir$ \ save current directory &forthdir 1+ $current-dir! drop \ set current directory --- 533,537 ---- : build-index ( --- ) ! current-dir$ \ save current directory &forthdir 1+ $current-dir! drop \ set current directory *************** *** 546,548 **** $current-dir! ; \ restore current directory - |
From: Jos v.d.V. <jo...@us...> - 2015-12-30 11:39:42
|
Update of /cvsroot/win32forth/win32forth/src In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv30752 Modified Files: Extend.f Log Message: Jos: Prepared for the new installer. The old way will also work. Index: Extend.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Extend.f,v retrieving revision 1.36 retrieving revision 1.37 diff -C2 -d -r1.36 -r1.37 *** Extend.f 6 Nov 2015 13:39:03 -0000 1.36 --- Extend.f 30 Dec 2015 11:39:40 -0000 1.37 *************** *** 121,126 **** [if] ! &forthdir count pad place ! s" Win32for.exe" pad +place pad count "path-file drop AddToFile --- 121,126 ---- [if] ! current-dir$ count pad place ! s" \Win32for.exe" pad +place pad count "path-file drop AddToFile *************** *** 134,138 **** [then] Require Checksum.f ! s" Win32for.exe" prepend<home>\ (AddCheckSum) 2 pause-seconds --- 134,138 ---- [then] Require Checksum.f ! s" Win32for.exe" current-dir$ count makeabsolutepath count (AddCheckSum) 2 pause-seconds |
From: Jos v.d.V. <jo...@us...> - 2015-12-30 11:37:42
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv30656 Modified Files: StatusBar.f Log Message: Jos: Avoiding duplicate loading Index: StatusBar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/StatusBar.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** StatusBar.f 15 Mar 2013 00:23:07 -0000 1.6 --- StatusBar.f 30 Dec 2015 11:37:40 -0000 1.7 *************** *** 8,11 **** --- 8,13 ---- \ *T ExControls -- More (enhanced) classes for standard windows controls. + defined -statusbar.f nip [if] \s [then] anew -StatusBar.f + cr .( Loading StatusBar Class...) |
From: Jos v.d.V. <jo...@us...> - 2015-12-29 13:00:16
|
Update of /cvsroot/win32forth/win32forth/apps/Setup In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv7761 Modified Files: Setup.f Log Message: Jos: Repairing broken code Index: Setup.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Setup/Setup.f,v retrieving revision 1.32 retrieving revision 1.33 diff -C2 -d -r1.32 -r1.33 *** Setup.f 20 Mar 2013 23:51:20 -0000 1.32 --- Setup.f 29 Dec 2015 13:00:13 -0000 1.33 *************** *** 22,25 **** --- 22,26 ---- FLOAD ..\..\src\paths.f \ multi path support words SYS-FLOAD ..\..\src\interpif.f \ interpretive conditionals + sys-FLOAD ..\..\src\NumberAlloc.f SYS-FLOAD ..\..\src\486asm.f \ Jim's 486 assembler SYS-FLOAD ..\..\src\asmmac.f \ Jim's 486 macros *************** *** 28,31 **** --- 29,33 ---- FLOAD ..\..\src\pointer.f FLOAD ..\..\src\registry.f \ Win32 Registry support + FLOAD ..\..\src\winversion.f \ FLOAD ..\..\src\ansfile.f FLOAD ..\..\src\callback.f |
From: Jos v.d.V. <jo...@us...> - 2015-12-18 16:47:20
|
Update of /cvsroot/win32forth/win32forth/src/lib/OpenGl In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv3564 Modified Files: OGLEVTS.F Log Message: Jos: For a better performance. Index: OGLEVTS.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/OpenGl/OGLEVTS.F,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** OGLEVTS.F 3 Dec 2015 17:43:40 -0000 1.2 --- OGLEVTS.F 18 Dec 2015 16:47:18 -0000 1.3 *************** *** 57,61 **** : time-1-period ( max-periods/second - ) ( f: Time1Period ) 1e s>f f/ ; ! 60 time-1-period fvalue ns-time-out-done : wait/restart-timer-slow-action --- 57,61 ---- : time-1-period ( max-periods/second - ) ( f: Time1Period ) 1e s>f f/ ; ! 66 time-1-period fvalue ns-time-out-done : wait/restart-timer-slow-action *************** *** 84,88 **** : sounds ( z"sound-file" - ) sounds_on/off ! if SND_FILENAME NULL rot call PlaySound then drop ; : sound-action ( - ) \ Prevents waiting while making a sound --- 84,88 ---- : sounds ( z"sound-file" - ) sounds_on/off ! if SND_FILENAME SND_ASYNC or NULL rot call PlaySound then drop ; : sound-action ( - ) \ Prevents waiting while making a sound |
From: Jos v.d.V. <jo...@us...> - 2015-12-08 21:55:52
|
Update of /cvsroot/win32forth/win32forth/src/lib/OpenGl In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv14235 Modified Files: Opengl.f Log Message: Jos: Some cleanup Index: Opengl.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/OpenGl/Opengl.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** Opengl.f 5 Dec 2015 12:05:34 -0000 1.7 --- Opengl.f 8 Dec 2015 21:55:50 -0000 1.8 *************** *** 872,887 **** then ; - : _relative-direction ( adr n - ) ( f: fsum - rel fsum ) - >f@ fover f/0 fswap ; - - : relative-direction ( fref4RotD n - ) ( f: - x y z ) - over >r 1 - floats@ f+ f+ - r@ 2 _relative-direction - r@ 1 _relative-direction - r> f@ fswap f/0 - ; - - \ 27e 1e 2e 3e fref4RotD 2dup floats! relative-direction f.s abort - 0 value resizing? true value key-ready? --- 872,875 ---- *************** *** 974,978 **** then endof - upc \ Uppercase characters only --- 962,965 ---- *************** *** 983,1008 **** ascii C of ['] fref3CenterC is-fref3D endof \ center-offset of the eye - ascii D of ['] fref4RotD is-fref3D endof \ direction of the eye - ascii E of ['] fref3eyeE is-fref3D endof \ viewpoint of the eye - ascii F of ['] fref3upF is-fref3D endof \ up-offset of the eye - ascii G of ['] fref4RotG is-fref3D endof \ rotate cylinder - ascii H of ['] fref3SizeH is-fref3D endof \ size of the outlined cube - ascii I of ['] fref3TransI is-fref3D endof \ move cylinder - ascii L of ['] fref3LpositionL is-fref3D endof \ move light - ascii N of ['] fref4LambientN is-fref3D endof \ ambient - ascii P of ['] fref4PersP is-fref3D endof \ perspective - ascii R of ['] fref4RotR is-fref3D endof \ rotate all objects - ascii T of ['] fref3TransT is-fref3D endof \ move a scene - ascii S of ['] fref3ScaleS is-fref3D endof \ the scale - ascii V of ['] fref4DiffuseV is-fref3D endof \ diffuse - ascii X of ['] fref4RotX is-fref3D endof \ rotate around the center - ascii W of start/end-fullscreen endof - ascii Z of start/stop-slow-action endof - endcase - ; - - (( - - ascii C of ['] fref3CenterC is-fref3D endof \ center-offset of the eye ascii D of ['] fref4RotD is-fref3D endof \ direction of the eye ascii E of ['] fref3eyeE is-fref3D endof \ viewpoint of the eye --- 970,973 ---- *************** *** 1020,1027 **** ascii X of ['] fref4RotX is-fref3D endof \ rotate around the center ascii W of start/end-fullscreen endof - VK_F1 of fullscreen-to-window endof ascii Z of start/stop-slow-action endof ! ! )) ' (change-scene is KeyboardAction \ For the default keys --- 985,991 ---- ascii X of ['] fref4RotX is-fref3D endof \ rotate around the center ascii W of start/end-fullscreen endof ascii Z of start/stop-slow-action endof ! endcase ! ; ' (change-scene is KeyboardAction \ For the default keys *************** *** 1077,1086 **** ; - \ ------------------------------------------------------------------------------- \ buffer management \ ------------------------------------------------------------------------------- - \ clear the drawing buffer --- 1041,1048 ---- *************** *** 1096,1105 **** ; ! : DC>screen ( - ) \ Renderes the DC directy to a window. hdc-pixmap SwapBuffers ; ! defer >screen \ use a DIBsection or a DC only or another pixelformat. : StableBuffer>Screen ( - ) --- 1058,1067 ---- ; ! : DC>screen ( - ) \ Renderes the DC directly to a window. hdc-pixmap SwapBuffers ; ! defer >screen \ Use a DIBsection or a DC only or another pixelformat. : StableBuffer>Screen ( - ) *************** *** 1132,1136 **** ' DC>screen is >screen - : ScaleSize ( n - scaled ) ( f: ScaleRate - ScaleRate ) s>f fover f* f>s 5 max ; --- 1094,1097 ---- *************** *** 1264,1269 **** GL_LIGHT0 GL_POSITION lightPosition glLightfv GL_LIGHT_MODEL_AMBIENT model-ambient glLightModelfv ! ! ; \ begin a quadric object --- 1225,1229 ---- GL_LIGHT0 GL_POSITION lightPosition glLightfv GL_LIGHT_MODEL_AMBIENT model-ambient glLightModelfv ! ; \ begin a quadric object *************** *** 1275,1279 **** qobj GLU_FILL gluQuadricDrawStyle qobj GLU_SMOOTH gluQuadricNormals ! ; \ finish a quadric object --- 1235,1239 ---- qobj GLU_FILL gluQuadricDrawStyle qobj GLU_SMOOTH gluQuadricNormals ! ; \ finish a quadric object *************** *** 1283,1287 **** GL_LIGHTING glDisable GL_LIGHT0 glDisable ! ; : sphere ( stacks slices - ) ( f: wide - ) --- 1243,1247 ---- GL_LIGHTING glDisable GL_LIGHT0 glDisable ! ; : sphere ( stacks slices - ) ( f: wide - ) *************** *** 1289,1293 **** d' qobj call gluSphere drop quad] ! ; : glPushMatrix_glTranslatef ( f: xt yt zt -- ) glPushMatrix glTranslatef ; --- 1249,1253 ---- d' qobj call gluSphere drop quad] ! ; : glPushMatrix_glTranslatef ( f: xt yt zt -- ) glPushMatrix glTranslatef ; *************** *** 1446,1450 **** vocabulary GLFunctions \ To avoid duplicate names in the same vocabulary - : +GLFunctions ( -- ) \ Also search in the vocabulary GLFunctions \in-system-ok current @ also GLFunctions current ! --- 1406,1409 ---- *************** *** 1841,1845 **** frefT4RotR floatsf@+ glRotatef \ Angle in orbit x y z frefT3MoveM floatsf@+ glTranslatef \ Distance from the center x y z ! ; --- 1800,1804 ---- frefT4RotR floatsf@+ glRotatef \ Angle in orbit x y z frefT3MoveM floatsf@+ glTranslatef \ Distance from the center x y z ! ; *************** *** 1875,1884 **** frefT4RotR floatsf@+ glRotatef \ Angle in orbit x y z frefT3MoveM floatsf@+ glTranslatef \ Distance from the center x y z ! ; : xJoint ( f: deg xg yg zg xt yt zt -- ) \ Set the position and angle of a joint frefT3MoveM floatsf@+ glTranslatef \ Can be changed with the key m frefT4RotR floatsf@+ glRotatef \ Can be changed with the key r ! ; : Add3dTurtle ( -- ) --- 1834,1843 ---- frefT4RotR floatsf@+ glRotatef \ Angle in orbit x y z frefT3MoveM floatsf@+ glTranslatef \ Distance from the center x y z ! ; : xJoint ( f: deg xg yg zg xt yt zt -- ) \ Set the position and angle of a joint frefT3MoveM floatsf@+ glTranslatef \ Can be changed with the key m frefT4RotR floatsf@+ glRotatef \ Can be changed with the key r ! ; : Add3dTurtle ( -- ) *************** *** 1898,1902 **** \ End of the interactive definitions - : ;Part ( - ) \in-system-ok postpone glPopMatrix postpone ; ; immediate --- 1857,1860 ---- |
From: Jos v.d.V. <jo...@us...> - 2015-12-05 12:05:37
|
Update of /cvsroot/win32forth/win32forth/src/lib/OpenGl In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv8886 Modified Files: Opengl.f Log Message: Jos: Solving the system warnings. I think I am ready with OpenGL. Index: Opengl.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/OpenGl/Opengl.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** Opengl.f 4 Dec 2015 19:09:55 -0000 1.6 --- Opengl.f 5 Dec 2015 12:05:34 -0000 1.7 *************** *** 805,809 **** 0 value FirstTime ! : reset-opengl ( - ) 0 0 wglMakeCurrent ghrc wglDeleteContext 2drop glin ; : display-it ( - ) reset-opengl ( winpause ) painting ; --- 805,809 ---- 0 value FirstTime ! : reset-opengl ( - ) release-context glin ; : display-it ( - ) reset-opengl ( winpause ) painting ; *************** *** 1469,1474 **** : GLFunction: \ CompileTime: ( -- <name> ) \ Map: ProcPointer lastext FunctionName ( case sensitive ) ! current @ >r SaveFunctionName \ Save it in temp$ ! "header dovar compile, \ Create a header from the input stream in uppercase InitFunction r> current ! does> @ call-proc \ Runtime: Executes the function. the stack depends on the used function --- 1469,1474 ---- : GLFunction: \ CompileTime: ( -- <name> ) \ Map: ProcPointer lastext FunctionName ( case sensitive ) ! current @ >r SaveFunctionName \ Save it in temp$ ! \in-system-ok "header dovar compile, \ Create a header from the input stream in uppercase InitFunction r> current ! does> @ call-proc \ Runtime: Executes the function. the stack depends on the used function *************** *** 1476,1481 **** : VoidGLFunction: \ CompileTime: ( -- <name> ) \ Map: ProcPointer lastext FunctionName ( case sensitive ) ! current @ >r SaveFunctionName \ Save it in temp$ ! "header dovar compile, \ Create a header from the input stream in uppercase InitFunction r> current ! does> @ call-proc drop \ Runtime: Executes the function. the stack depends on the used function --- 1476,1481 ---- : VoidGLFunction: \ CompileTime: ( -- <name> ) \ Map: ProcPointer lastext FunctionName ( case sensitive ) ! current @ >r SaveFunctionName \ Save it in temp$ ! \in-system-ok "header dovar compile, \ Create a header from the input stream in uppercase InitFunction r> current ! does> @ call-proc drop \ Runtime: Executes the function. the stack depends on the used function |
From: Jos v.d.V. <jo...@us...> - 2015-12-05 12:03:46
|
Update of /cvsroot/win32forth/win32forth/demos/OpenGLdemos In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv8779 Modified Files: HelpForm.f OpenGl_Hello.f UfoWithRobot.f opengllib-1.11.f Log Message: Jos: Added the ExitScene actions. Index: opengllib-1.11.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/OpenGLdemos/opengllib-1.11.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** opengllib-1.11.f 4 Dec 2015 19:08:43 -0000 1.1 --- opengllib-1.11.f 5 Dec 2015 12:03:44 -0000 1.2 *************** *** 25,29 **** menubar Openglmenu \ Define a menu for the OpenGL window ! popup "&File" menuitem "E&xit" bye ; endbar --- 25,29 ---- menubar Openglmenu \ Define a menu for the OpenGL window ! popup "&File" menuitem "E&xit" ExitScene bye ; endbar *************** *** 232,240 **** ; ! : _exitLesson ( -- ) \ For a clean start in the next lesson DeleteTextures true to resizing? ; : ResetLesson ( -- ) \ For a clean start in this lesson ResetOpenGL \ Cleanup from a previous lesson --- 232,242 ---- ; ! : _exitLesson ( -- ) \ For a clean start in the next drawing DeleteTextures true to resizing? ; + ' _exitLesson is ExitScene + : ResetLesson ( -- ) \ For a clean start in this lesson ResetOpenGL \ Cleanup from a previous lesson Index: HelpForm.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/OpenGLdemos/HelpForm.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** HelpForm.f 4 Dec 2015 19:23:50 -0000 1.2 --- HelpForm.f 5 Dec 2015 12:03:44 -0000 1.3 *************** *** 5,10 **** aNew -Helpform.f - defer FocusOpenGLWindow - : $| ( -<line>- ) 0 temp$ ! --- 5,8 ---- *************** *** 138,142 **** :M start: ( -- ) start: Super - \ FocusOpenGLWindow ;M --- 136,139 ---- Index: OpenGl_Hello.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/OpenGLdemos/OpenGl_Hello.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** OpenGl_Hello.f 4 Dec 2015 17:50:31 -0000 1.1 --- OpenGl_Hello.f 5 Dec 2015 12:03:44 -0000 1.2 *************** *** 6,10 **** menubar Openglmenu \ Define a menu for the OpenGL window ! popup "&File" menuitem "E&xit" bye ; endbar --- 6,10 ---- menubar Openglmenu \ Define a menu for the OpenGL window ! popup "&File" menuitem "E&xit" ExitScene bye ; endbar *************** *** 105,108 **** --- 105,109 ---- lpgmf_buffer free ; \ Free the lpgmf_buffer + ' ExitIntro is ExitScene ShowIntro \ Start the OpenGL window with the OpenGL drawing. Index: UfoWithRobot.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/OpenGLdemos/UfoWithRobot.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** UfoWithRobot.f 4 Dec 2015 17:50:31 -0000 1.1 --- UfoWithRobot.f 5 Dec 2015 12:03:44 -0000 1.2 *************** *** 6,10 **** menubar Openglmenu \ Define a menu for the OpenGL window ! popup "&File" menuitem "E&xit" bye ; endbar --- 6,10 ---- menubar Openglmenu \ Define a menu for the OpenGL window ! popup "&File" menuitem "E&xit" ExitScene bye ; endbar *************** *** 280,283 **** --- 280,285 ---- ; + ' _exitdrawing is ExitScene + : DrawUfoWithRobot ( -- ) \ (R)edraw of the scene. ResetOpenGL \ Cleanup from a previous drawing |
From: Jos v.d.V. <jo...@us...> - 2015-12-04 19:23:52
|
Update of /cvsroot/win32forth/win32forth/demos/OpenGLdemos In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv13271 Modified Files: HelpForm.f Log Message: Jos: On_Init: Super made it hang. Index: HelpForm.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/OpenGLdemos/HelpForm.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** HelpForm.f 4 Dec 2015 17:50:31 -0000 1.1 --- HelpForm.f 4 Dec 2015 19:23:50 -0000 1.2 *************** *** 108,112 **** :M On_Init: ( -- ) ! On_Init: Super ['] FormAction SetCommand: self --- 108,112 ---- :M On_Init: ( -- ) ! \ On_Init: Super ['] FormAction SetCommand: self *************** *** 159,163 **** ; ! \ Use: :long$ InitialText$ --- 159,163 ---- ; ! \s Use: :long$ InitialText$ *************** *** 169,173 **** InitialText$ zHelpText ! \ start: HelpForm abort \ Activate this line for a demo. \s --- 169,173 ---- InitialText$ zHelpText ! start: HelpForm abort \ Activate this line for a demo. \s |
From: Jos v.d.V. <jo...@us...> - 2015-12-04 19:09:57
|
Update of /cvsroot/win32forth/win32forth/src/lib/OpenGl In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv12126 Modified Files: Opengl.f Log Message: Jos: Adpted for the last demo. Index: Opengl.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/OpenGl/Opengl.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Opengl.f 4 Dec 2015 17:53:02 -0000 1.5 --- Opengl.f 4 Dec 2015 19:09:55 -0000 1.6 *************** *** 805,809 **** 0 value FirstTime ! : reset-opengl ( - ) release-context glin ; : display-it ( - ) reset-opengl ( winpause ) painting ; --- 805,809 ---- 0 value FirstTime ! : reset-opengl ( - ) 0 0 wglMakeCurrent ghrc wglDeleteContext 2drop glin ; : display-it ( - ) reset-opengl ( winpause ) painting ; |
From: Jos v.d.V. <jo...@us...> - 2015-12-04 19:08:45
|
Update of /cvsroot/win32forth/win32forth/demos/OpenGLdemos In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv12023 Added Files: OpenGlLessons.f Readme.txt opengllib-1.11.f tim.bmp Log Message: Jos: The last demo. --- NEW FILE: opengllib-1.11.f --- \ =================================================================== \ File: opengllib-1.11.fs \ Author: Bosco \ Linux Version: Ti Leggett \ gForth Version: Timothy Trussell, 07/25/2010 \ Description: Flag effect (waving texture) \ Forth System: gforth-0.7.0 \ Linux System: Ubuntu v10.04 LTS i386, kernel 2.6.31-23 \ C++ Compiler: gcc version 4.4.3 (Ubuntu 4.4.3-4ubuntu5) \ =================================================================== \ NeHe Productions \ http://nehe.gamedev.net/ \ =================================================================== \ OpenGL Tutorial Lesson 11 \ =================================================================== \ This code was created by Bosco \ ported to Linux/SDL by Ti Leggett \ March, 2013 adapted for Win32Forth by Jos v.d.Ven \ Visit Jeff at http://nehe.gamedev.net/ \ =================================================================== s" src\lib\OpenGl" "fpath+ \ For OpenGL support needs opengl.f \ The OpenGl wrapper and many tools menubar Openglmenu \ Define a menu for the OpenGL window popup "&File" menuitem "E&xit" bye ; endbar needs oglwin.f \ The OpenGL window needs Helpform.f \ For the help window needs OpenGlLessons.f \ To support this lesson vocabulary Lesson11 also Lesson11 definitions \ ---[ Variable Declarations ]--------------------------------------- -1e facos fconstant pi PI 2e F* fconstant 2PI \ common calc fvariable x-rot fvariable y-rot fvariable z-rot 0 value wiggle-count \ how fast the flag waves \ Need to create a [45][45][3] fp array here \ These can be fixed as 8-byte fp values, as they are sent to the \ OpenGL system via the gl-vertex-3f call, not by passing the address \ of the array. \ One way of thinking of this is as (3) (45x45) arrays \ So, x and y have a range of [0..44], and z has a range of [0..2] \ +-------+ |---x ---| \ | |-+ +--------+ -+- \ | | |-+ | | | \ | z=0| | | | | y \ +-------+1| | | | | \ +-------+2| +--------+ -+- \ +-------+ create points[] here 45 floats 45 * 3 * dup allot 0 fill \ ---[ Array Index Functions ]--------------------------------------- \ Index functions to access the arrays : points-ndx { _x _y _z -- *points[x][y][z] } points[] \ *points[] \ calculate row of the y coordinate _y 45 floats * \ *points[] yofs \ calculate column of the x coordinate _x floats + \ *points[] yofs+xofs \ calculate page of the z coordinate _z 45 floats 45 * * + \ *points[] yofs+xofs+zofs + \ *points[yofs+xofs+zofs] ; \ ---[ LoadGLTextures ]---------------------------------------------- : LoadGLTextures ( -- status ) \ create variables for storing surface pointers and return flag 1 MallocTextures \ MallocTextures allocates only when not done NumTextures texture[] gl-gen-textures \ create the textures \ Attempt to load the texture images by using a mapping s" tim.bmp" 0 ahndl LoadGLTexture \ ndx = 0 true \ exit -1=ok OR abort in LoadGLTexture ; \ ---[ HandleKeyPress ]---------------------------------------------- \ function to handle key press events: :long$ h11$ $| About lesson 11: $| $| Key-list for the available functions in this lesson: $| $| ESC exits the lesson $| w toggles between fullscreen and windowed modes ;long$ \ ---[ HandleKeyPress ]---------------------------------------------- \ function to handle key press events : HandleKeyPress ( VK_key -- ) ascii W = if start/end-fullscreen \ Starts of end the full screen else h11$ ShowHelp \ Show the help text for this lesson then ; \ ---[ Set the viewpoint ]------------------------------------------- : set-viewpoint ( -- ) \ the call to glViewport is done in Opengl.f GL_PROJECTION gl-matrix-mode \ Reset the matrix gl-load-identity \ Set our perspective - the F/ calcs the aspect ratio of w/h 45e widthViewport S>F heightViewport S>F F/ 0.1e 100e glu-perspective \ Make sure we are changing the model view and not the projection GL_MODELVIEW gl-matrix-mode ; \ ---[ InitGL ]------------------------------------------------------ \ general OpenGL initialization function : InitGL ( -- ) \ Load in the texture LoadGLTextures drop \ Enable texture mapping GL_TEXTURE_2D gl-enable \ Enable smooth shading GL_SMOOTH gl-shade-model \ Set the background black 0e 0e 0e 0.5e gl-clear-color \ Depth buffer setup 1e gl-clear-depth \ Enable depth testing GL_DEPTH_TEST gl-enable \ Type of depth test to do GL_LEQUAL gl-depth-func \ Really nice perspective calculations GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST gl-hint \ Fill the back with texture; the front will only be wireline GL_BACK GL_FILL gl-polygon-mode GL_FRONT GL_LINE gl-polygon-mode \ Apply the wave to our mesh array 45 0 do 45 0 do j S>F 5e F/ 4.5e F- j i 0 points-ndx F! i S>F 5e F/ 4.5e F- j i 1 points-ndx F! j S>F 5e F/ 40e F* 360e F/ 2PI F* FSIN j i 2 points-ndx F! loop loop ; \ ---[ DrawGLScene ]------------------------------------------------- \ Here goes our drawing code fvariable f-x \ use to break the flag into tiny quads fvariable f-y fvariable f-xb fvariable f-yb : DrawGLScene ( -- ) \ Clear the screen and the depth buffer GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT OR gl-clear gl-load-identity \ restore matrix \ Translate 17 units into the screen 0e 0e -17e gl-translate-f \ Rotate on the x/y/z axes x-rot F@ 1e 0e 0e gl-rotate-f y-rot F@ 0e 1e 0e gl-rotate-f z-rot F@ 0e 0e 1e gl-rotate-f \ Select our texture GL_TEXTURE_2D 0 texture-ndx @ gl-bind-texture \ Start drawing our quads GL_QUADS gl-begin 44 0 do 44 0 do j S>F 44e F/ f-x F! \ Create a fp x value i S>F 44e F/ f-y F! \ Create a fp y value j 1+ S>F 44e F/ f-xb F! \ Create x+0.0227e value i 1+ S>F 44e F/ f-yb F! \ Create y+0.0227e value \ Bottom Left texture coordinate f-x F@ f-y F@ gl-tex-coord-2f j i 0 points-ndx F@ j i 1 points-ndx F@ j i 2 points-ndx F@ gl-vertex-3f \ Top left texture coordinate f-x F@ f-yb F@ gl-tex-coord-2f j i 1+ 0 points-ndx F@ j i 1+ 1 points-ndx F@ j i 1+ 2 points-ndx F@ gl-vertex-3f \ Top Right texture coordinate f-xb F@ f-yb F@ gl-tex-coord-2f j 1+ i 1+ 0 points-ndx F@ j 1+ i 1+ 1 points-ndx F@ j 1+ i 1+ 2 points-ndx F@ gl-vertex-3f \ Bottom Right texture coordinate f-xb F@ f-y F@ gl-tex-coord-2f j 1+ i 0 points-ndx F@ j 1+ i 1 points-ndx F@ j 1+ i 2 points-ndx F@ gl-vertex-3f loop loop gl-end \ Used to slow down the wave (every 2nd frame only) wiggle-count 1 > if 45 0 do 0 i 2 points-ndx F@ 44 0 do i 1+ j 2 points-ndx F@ i j 2 points-ndx F! loop 44 i 2 points-ndx F! loop 0 to wiggle-count \ set back to zero then wiggle-count 1+ to wiggle-count \ Draw it to the screen sdl-gl-swap-buffers x-rot F@ 0.3e F+ x-rot F! \ increment x rotation y-rot F@ 0.2e F+ y-rot F! \ increment y rotation z-rot F@ 0.4e F+ z-rot F! \ increment z rotation ; : _exitLesson ( -- ) \ For a clean start in the next lesson DeleteTextures true to resizing? ; : ResetLesson ( -- ) \ For a clean start in this lesson ResetOpenGL \ Cleanup from a previous lesson InitGL \ Enable some features and load textures set-viewpoint \ Set the viewpoint false to resizing? ; also Forth definitions : DrawGLLesson11 ( -- ) \ Handles ONE frame LessonChanged? if false to LessonChanged? ['] HandleKeyPress is KeyboardAction \ Use the keystrokes for this lesson only ['] _ExitLesson is ExitLesson \ Specify ExitLesson to free allocated memory Reset-request-to-stop then resizing? if ResetLesson then DrawGLScene \ Redraw only the changes in the lesson ProcesKeyAndRelease \ HandleKeyPress only here ; : StartGLLesson11 ( -- ) Start: OpenGLWindow DrawGLLesson11 ['] DrawGLScene is painting begin DrawGLLesson11 request-to-stop until ; StartGLLesson11 \s --- NEW FILE: Readme.txt --- The following demos can be compiled: 1) OpenGl_Hello.f \ To show how a simple OpenGL drawing can be made in Win32Forth 2) UfoWithRobot.f \ To demonstrate the new 3D turtle. 3) opengllib-1.11.f \ A bit more complicated lesson from NeHe --- NEW FILE: tim.bmp --- (This appears to be a binary file; contents omitted.) --- NEW FILE: OpenGlLessons.f --- \ OpenGlLessons.f \ Adaptations for NeHeLessons aNew -OpenGlLessons.f synonym gl-shade-model glShadeModel synonym gl-clear-depth glClearDepth synonym gl-enable glEnable synonym gl-hint glHint synonym gl-depth-func glDepthFunc synonym gl-clear-color glClearColor synonym gl-clear glClear synonym gl-load-identity glLoadIdentity synonym gl-translate-f glTranslatef synonym gl-begin glBegin synonym gl-vertex-3f glVertex3f synonym gl-end glEnd synonym gl-color-3f glColor3f synonym gl-rotate-f glRotatef synonym gl-tex-image-2d glTexImage2D synonym gl-gen-textures glGenTextures synonym gl-bind-texture glBindTexture synonym gl-tex-parameter-i glTexParameteri synonym gl-tex-coord-2f glTexCoord2f synonym glu-build-2d-mipmaps gluBuild2DMipmaps synonym gl-light-fv glLightfv synonym gl-normal-3f glNormal3f synonym gl-color-4f glColor4f synonym gl-blend-func glBlendFunc synonym gl-color-4ub glColor4ub synonym gl-polygon-mode glPolygonMode synonym gl-gen-lists glGenLists synonym gl-new-list glNewList synonym gl-end-list glEndList synonym gl-color-3fv glColor3fv synonym gl-call-list glCallList synonym gl-delete-lists glDeleteLists synonym gl-fog-i glFogi synonym gl-fog-fv glFogfv synonym gl-fog-f glFogf synonym gl-vertex-2i glVertex2i synonym gl-translate-d glTranslated synonym gl-disable glDisable synonym gl-matrix-mode glMatrixMode synonym gl-push-matrix glPushMatrix synonym gl-ortho glOrtho synonym gl-list-base glListBase synonym gl-call-lists glCallLists synonym gl-pop-matrix glPopMatrix synonym gl-vertex-2f glVertex2f synonym glu-new-quadric gluNewQuadric synonym glu-quadric-normals gluQuadricNormals synonym glu-quadric-texture gluQuadricTexture synonym glu-cylinder gluCylinder synonym glu-disk gluDisk synonym glu-sphere gluSphere synonym glu-partial-disk gluPartialDisk synonym gl-depth-mask glDepthMask synonym gl-color-mask glColorMask synonym gl-stencil-func glStencilFunc synonym gl-front-face glFrontFace synonym gl-stencil-op glStencilOp synonym gl-clear-stencil glClearStencil synonym gl-material-fv glMaterialfv synonym gl-cull-face glCullFace synonym gl-get-float-v glGetFloatv synonym gl-flush glFlush synonym gl-scale-f glScalef synonym gl-color-3ub glColor3ub synonym gl-vertex-2d glVertex2d synonym gl-line-width glLineWidth synonym gl-get-string glGetString synonym gl-scissor glScissor synonym gl-get-integer-v glGetIntegerv synonym gl-tex-gen-i glTexGeni synonym gl-clip-plane glClipPlane synonym gl-pixel-transfer-f glpixeltransferf synonym gl-tex-env-f gltexenvf synonym gl-push-attrib glPushAttrib synonym gl-pop-attrib glPopAttrib synonym gl-raster-pos-2f glRasterPos2f synonym glu-perspective gluPerspective synonym gl-delete-textures glDeleteTextures synonym glu-delete-quadric gluDeleteQuadric defer ExitLesson ' noop is ExitLesson synonym sdl-gl-swap-buffers show-frame -1e facos fconstant pi synonym =: constant true value LessonChanged? : clrTitle$ ( - ) title$ 50 erase ; : NeHe>title ( - ) clrTitle$ s" NeHe lessons in Win32Forth. " title$ place ogl-hwnd retitle-window ; : StaticScene ( - ) NeHe>title true to static-scene ; : DynamicScene ( - ) clrTitle$ s" NeHe lessons in Win32Forth. Fps: " FpsStart$ place false to static-scene ; : SF, ( r -- ) here 1 sfloats allot SF! ; : F-! ( f: fval -- ) ( *fvar -- ) FNEGATE F+! ; : rnd ( -- rnd ) 0xfffffff random ; : set-viewpoint-wf32 ( -- ) \ Needed for the Win32Forth window GL_PROJECTION glMatrixMode \ set viewing to the projection matrix 85e .5e 0.1e 200.0e fref4PersP floatsf@+ gluPerspective 1.1e 2.0e 1.5e fref3ScaleS floatsf@+ glscalef \ To fit it into the window GL_MODELVIEW glMatrixMode \ set viewing to the model matrix \ 2 ; #define VK_NUMPAD+ 107 #define VK_NUMPAD- 109 \s |
From: Jos v.d.V. <jo...@us...> - 2015-12-04 17:53:04
|
Update of /cvsroot/win32forth/win32forth/src/lib/OpenGl In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv5663 Modified Files: Opengl.f Log Message: Jos: For the new demo Index: Opengl.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/OpenGl/Opengl.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** Opengl.f 4 Dec 2015 11:57:11 -0000 1.4 --- Opengl.f 4 Dec 2015 17:53:02 -0000 1.5 *************** *** 1992,1996 **** true value OtherScene? ! defer ExitLesson : AnewScene s" Anew Scene" evaluate ; immediate --- 1992,1996 ---- true value OtherScene? ! defer ExitScene : AnewScene s" Anew Scene" evaluate ; immediate |
From: Jos v.d.V. <jo...@us...> - 2015-12-04 17:52:14
|
Update of /cvsroot/win32forth/win32forth/demos In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv5617 Removed Files: OpenGl_Hello.f Log Message: Jos: Removing the duplicate. --- OpenGl_Hello.f DELETED --- |
From: Jos v.d.V. <jo...@us...> - 2015-12-04 17:50:34
|
Update of /cvsroot/win32forth/win32forth/demos/OpenGLdemos In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv5521 Added Files: Body.bmp CUBE.BMP Floor.bmp HelpForm.f OpenGl_Hello.f UfoWithRobot.f Log Message: Jos: Putting all OpenGL demos in one map and adding a new one. Just one demo still to go... --- NEW FILE: CUBE.BMP --- (This appears to be a binary file; contents omitted.) --- NEW FILE: OpenGl_Hello.f --- anew -OpenGl_Hello.f \ To show how an OpenGL drawing can be made in Win32Forth s" src\lib\OpenGl" "fpath+ \ For OpenGL support needs opengl.f \ The OpenGl wrapper and many tools menubar Openglmenu \ Define a menu for the OpenGL window popup "&File" menuitem "E&xit" bye ; endbar needs oglwin.f \ The OpenGL window \ Next starts the OpenGL part. That might need some study. Font vFont 0 value baselist : init-3Dfont ( -- ) sizeof glyphmetricsfloat 256 * malloc to lpgmf_buffer 255 glGenLists to baselist s" Comic Sans MS" SetFaceName: vFont Create: vFont Handle: vFont ghdc call SelectObject \ Old font on the stack ghdc 1 255 baselist 0.2e 0.09e \ create display lists WGL_FONT_POLYGONS lpgmf_buffer wglUseFontOutlines \ for the selected font ( OldFont) ghdc call SelectObject \ Restore the old font call DeleteObject ?winerror ; \ Delete the new font. It is now in the list : eye-parameters ( f: -- eyex eyey eyez centerx centery centerz upx upy upz ) \ eyex eyey eyez .0000e .2300e 4.130e \ centerx centery centerz .0000e .1724e 3.340e \ upx upy upz 00000e .000e -.02000e ; : set-viewpoint GL_PROJECTION glMatrixMode \ starting the projection matrix glLoadIdentity GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT OR glClear 0.0e0 0e0 .0e0 glColor3f \ The screen color \ Setting up a perspective in the projection matrix. \ This will affect the entire scene. 47.00e 1.000e .0100e 15.00e gluPerspective 0.00e .00e -.200e .000e glRotatef \ deg x y z rotate eye \ Setting up a viewing transformation eye-parameters gluLookAt .1290e .1583e .1700e glscalef \ Scale it a bit 0.00e .00e -.200e .000e glRotatef \ deg x y z Rotate around the center -.8700e 1.399e 21.40e glTranslatef \ x y z position of the scene 4.000e -1.400e .0000e .0000e glRotatef \ deg x y z Rotate all objects \ Continue with the model matrix for the object(s) GL_MODELVIEW glMatrixMode ; : InitGL ( -- ) init-3Dfont \ Enable a number of features GL_SMOOTH glShadeModel GL_DEPTH_TEST glEnable GL_FRONT GL_AMBIENT glColorMaterial GL_COLOR_MATERIAL glEnable GL_LIGHTING glEnable GL_LIGHT0 glEnable ; : DrawIntro ( -- ) 0.00e 1.1624e .1766e 0.3000e objectcolor! \ Prepair the color of the object GL_POLYGON \ fill -10.00e 0e 0.5e 0e \ Rotation f: deg xg yg zg .2333e .2531e .7000e \ Scaling f: xs ys zs -.4000e .2100e -.4000e \ Transformation f: xt yt zt [rot-scaled-object ( fill -- ) ( f: deg xg yg zg xs ys zs xt yt zt -- ) s" Hello OpenGL" baselist glType object] 0.00e -4.038e 1.977e .3000e objectcolor! GL_POLYGON -10.00e 0e 0.5e 0e .2333e .2531e .7000e -.4000e -.1900e -.4000e [rot-scaled-object ( fill -- ) ( f: deg xg yg zg xs ys zs xt yt zt -- ) s" in Win32Forth." baselist glType object] show-frame ; \ Startup and exit part: : RefreshIntro ( - ) \ Should be used when the window is repainted InitGL \ Initialize the scene set-viewpoint DrawIntro ; \ Draw the scene true to static-scene \ This drawing does not change : ShowIntro ( -- ) Start: OpenGLWindow \ Starting the OpenGl window ['] drop is KeyboardAction \ Disable all keys here except escape RefreshIntro ; : ExitIntro ( - ) \ The cleanup part baselist 255 glDeleteLists \ Kill the 3d Font in the list lpgmf_buffer free ; \ Free the lpgmf_buffer ShowIntro \ Start the OpenGL window with the OpenGL drawing. ' RefreshIntro is painting \ Action when the window is repainted ( resized etc ) \s --- NEW FILE: UfoWithRobot.f --- Anew UfoWithRobot \ To demonstrate the new 3D turtle. s" src\lib\OpenGl" "fpath+ \ For OpenGL support needs opengl.f \ The OpenGl wrapper and many tools menubar Openglmenu \ Define a menu for the OpenGL window popup "&File" menuitem "E&xit" bye ; endbar needs oglwin.f \ The OpenGL window needs Helpform.f \ For the help window \ ---[ DrawGLScene ]------------------------------------------------- \ Here goes our drawing code \ Define the various display lists /BoxList mkstruct: SmallBox /BoxList mkstruct: floor /BoxList mkstruct: Body /BoxList mkstruct: NodeUnit : BuildLists ( #lists -- ) glGenLists to lists \ Compile the lists and specify the width height and depth (xyz) .32e .32e .32e SmallBox CompileBox 14e .2e 4e Floor CompileBox .3e .85e .3e Body CompileBox .05e .15e .15e NodeUnit CompileBox ; \ Define and load various textures 0 value Texture-Ufo 0 value Texture-Floor 0 value Texture-Body : LoadGLTextures ( -- ) 3 Create-Textures \ Create the all the needed textures s" cube.bmp" LoadTexture to Texture-Ufo \ Load the texture and save the name s" floor.bmp" LoadTexture to Texture-Floor \ Load the texture and save the name s" Body.bmp" LoadTexture to Texture-Body \ Load the texture and save the name ; : SetupLight GL_LIGHT0 glEnable \ enable light0 GL_LIGHTING glEnable \ enable lighting \ gray blue green red 4.50000e 4.5e 4.5e 4.5e fref4LambientN floatsf@+ model-ambient GLfloat! GL_LIGHT_MODEL_AMBIENT model-ambient glLightModelfv \ gray blue green red \ 1e 1e 1e 1e fref4DiffuseV floatsf@+ lightcolor GLfloat! \ GL_LIGHT0 GL_DIFFUSE lightcolor glLightfv \ ??? y z x 1e .9900e 1.478e 0.021e fref3LpositionL floatsf@+ lightPosition GLfloat! GL_LIGHT0 GL_POSITION lightPosition glLightfv ; \ Initialization OpenGL 0 value 0quadratic : InitGL ( -- boolean ) LoadGLTextures \ Load in the texture GL_TEXTURE_2D glEnable \ Enable texture mapping GL_SMOOTH glShadeModel \ Enable smooth shading .2e .2e .5e 0.5e glClearColor \ A blue background 1e glClearDepth \ Depth buffer setup GL_DEPTH_TEST glEnable \ Enable depth testing GL_LEQUAL glDepthFunc \ Type of depth test to do GL_COLOR_MATERIAL glEnable \ enable material coloring GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST glHint \ Really nice perspective calculations 4 BuildLists \ Build the display lists SetupLight ; \ Set the viewpoint : set-viewpoint ( -- ) \ The call to glViewport is done in Opengl.f GL_PROJECTION glMatrixMode \ Switch to the projection view \ Set our perspective - the F/ calcs the aspect ratio of w/h 100e widthViewport S>F heightViewport S>F F/ 0.1e 100e GluPerspective \ ( f: fovy aspect near far-- ) GL_MODELVIEW glMatrixMode \ Switch to the model view ; create 0colors 1e F, 0e F, 0e F, : Save#elements ( n - n ) dup to #elements ; : AddElement ( f: red green blue - ) glColor3f DrawReposition ; \ Various parts for the round Ufo : AddGreenElements ( n - ) Save#elements 0 do 0e i IncrColor 0e AddElement loop ; \ Adding a colored element : AddRedElements ( n - ) Save#elements 0 do i IncrColor 0e 0e AddElement loop ; : AddBlueElements ( n - ) Save#elements 0 do 0e 0e i IncrColor AddElement loop ; : AddYelloElements ( n - ) Save#elements 0 do i IncrColor fdup 0e AddElement loop ; \ For the robot body : AddBodyElements ( n - ) Save#elements 0 do .175e fdup 0e AddElement loop ; : AddWhiteElements ( n - ) Save#elements 0 do i IncrColor fdup fdup AddElement loop ; \ Various parts in the drawing :Part .Floor ( f: deg xg yg zg xt yt zt -- ) Floor to element \ Using the display list of the floor which contains the sizes Texture-Floor Bind2DTexture \ Select it's texture 0.08e fdup fdup glColor3f \ Select a color DrawReposition \ It consists of 1 element and contains no additional elements ;Part :Part .Ufo ( f: deg xg yg zg xt yt zt -- ) SmallBox to element \ Each element is a SmallBox Texture-Ufo Bind2DTexture \ Select it's texture 5 AddGreenElements \ Add a number of green cubes 60 0 do \ Repeat 90e 0e 0e 1e glRotatef \ Turn Z ( up) 5 AddRedElements 90e 0e 1e 1e glRotatef \ Turn Y and Z ( down + left ) 5 AddBlueElements \ Add blue cubes 90e 0e 0e 1e glRotatef \ Turn Z 9 AddYelloElements \ Add yello cubes 90e 0e 1e 1e glRotatef \ Turn Y and Z 9 AddWhiteElements \ Add white cubes loop ;Part \ All parts are attached to .Body, so keep the body in the starting matrix \ Do not use glPushMatrix or :Part here. : .Body ( -- ) body to element \ Use body as the element for expanding .175e fdup 0.09e glColor3f \ Select a color DrawReposition \ The body has 1 element and contains no additional elements ; :Part .RightArm ( f: deg xg yg zg xt yt zt -- ) \ :Part also takes care for the joint 7 AddWhiteElements \ Draw the upper right arm -29.00e .0000e .0000e 1.600e 0e 0e 0e joint \ The joint for the lower right arm 8 AddWhiteElements \ Draw the lower right arm ;Part :Part .LeftArm ( f: deg xg yg zg xt yt zt -- ) 7 AddWhiteElements \ The upper arm 97.00e .0000e .0000e 1.600e 0e 0e 0e joint \ The Lower left arm 8 AddWhiteElements ;Part :Part .head ( f: deg xg yg zg xt yt zt -- ) 3 AddWhiteElements \ The neck 90.00e .0000e -.0593e 1.600e .0403e -.1139e .0000e joint 5 AddWhiteElements \ The head ;Part :Part .LeftLeg ( f: deg xg yg zg xt yt zt -- ) 11 AddWhiteElements \ The upper left leg -23.00e .4000e .0000e -1.200e -.0173e -.0025e .0000e joint 12 AddWhiteElements \ The lower left leg ;Part :Part .RightLeg ( f: deg xg yg zg xt yt zt -- ) 11 AddWhiteElements \ The upper right leg 25.00e .0000e .0000e -.6000e -.0173e -.0025e .0000e joint 12 AddWhiteElements \ The lower right leg ;Part :xPart .Robot ( f: deg xg yg zg xt yt zt -- ) \ :xPart activates also the m and r key functions Texture-Body Bind2DTexture \ Select the texture for the body .Body \ The next parts are attached to the body Texture-Ufo Bind2DTexture \ Select the texture for the other parts NodeUnit to element \ Use the NodeUnit for expanding the other parts 180.0e .1580e .1580e .0000e -.3168e .4529e .0185e .head 184.0e .0000e .1709e .0000e -.47e .3535e .0185e .LeftArm -4.000e .0000e -.8000e -1.400e -.1717e .3535e .0185e .RightArm 114.0e .0000e .0000e -.6000e -.3705e -.4376e .0185e .LeftLeg 65.00e .0000e .0000e -.6000e -.2134e -.4376e .0185e .RightLeg ;Part : .Scene ( -- ) GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT OR glClear \ Clear the screen \ glLoadIdentity 0e 0e 0e 0e .0000e -5.00e -7.600e .Floor -.000e .00e 0.100e 00e fref4RotG floatsf@+ -1.200e .4000e -7.000e fref3TransI floatsf@+ .Ufo \ The keys g and i can be used -47.e .20e .800e .0e 4.007e -3.163e -6.430e .Robot ; : DrawGLScene ( -- ) .Scene .changed-fps>title show-frame ; \ ---[ Help text available Keys ]---------------------------------------------- :long$ h12$ $| General key functions for the ufo and the robot: $| <Del> Resets the active function $| <Home> Resets the whole scene $| <w> toggles between fullscreen and windowed modes $| $| Activate one of the following functions: $| <i> To move the ufo $| <g> To rotate the ufo $| <m> To move the robot $| <r> To rotate the robot $| $| Then use: $| <Left> <Right> <Up> <Down> <PageUp> <PageDown> $| to change the offset of the active function. $| $| Extra: $| <,> Decrement rotation after a rotation function $| <.> Increment rotation after a rotation function $| <-> Decrement the amount to change $| <=> Increment the amount to change ;long$ : .change-Turtle ( adr-flookat - ) ( f: n - ) f! ( DrawGLScene) ; : HandleKeyPress ( &event -- ) case VK_RIGHT of zx .change-Turtle endof \ right VK_LEFT of -zx .change-Turtle endof \ left VK_UP of zy .change-Turtle endof \ up VK_DOWN of -zy .change-Turtle endof \ down VK_PGUP of -zz .change-Turtle endof \ zoom- VK_PGDN of zz .change-Turtle endof \ zoom. Forwards is DOWN on the negative z-axis! 117 VK_HOME of reset-active-function painting endof \ use defaults VK_. of -zr if .change-Turtle then endof \ rotate- VK_, of zr if .change-Turtle then endof \ rotate VK_DEL of clear-all-offsets painting endof VK_- of decr_interval endof \ decr VK_= of incr_interval endof \ incr ascii w of start/end-fullscreen endof ascii i of ['] fref3TransI is-fref3D endof \ move ufo ascii g of ['] fref4RotG is-fref3D endof \ rotate ufo ascii m of ['] frefT3MoveM is-fref3D endof \ move robot ascii r of ['] frefT4RotR is-fref3D endof \ rotate robot \ Only active when the source is changed: ascii c of ['] frefT3Color is-fref3D endof \ color turtle ascii s of ['] frefT3RotS is-fref3D endof \ scale the elements ascii n of ['] frefT3Elements is-fref3D endof \ #elements turtle ascii x of ['] frefT3MoveX is-fref3D endof \ orbit araound a turnpoint ascii z of start/stop-slow-action endof h12$ ShowHelp \ Show help when an inactive key is pressed endcase DrawGLScene ; : _exitdrawing ( -- ) \ For a clean start of the next drawing DeleteTextures true to resizing? ; : DrawUfoWithRobot ( -- ) \ (R)edraw of the scene. ResetOpenGL \ Cleanup from a previous drawing InitGL \ Enable some features and load textures set-viewpoint \ Set the viewpoint DrawGLScene \ Draw the scene ; : InitUfoWithRobot ( -- ) \ The startup ['] HandleKeyPress is KeyboardAction \ Use the keystrokes for this drawing only ['] _Exitdrawing is ExitScene \ Specify Exitdrawing to free allocated memory Start: OpenGLWindow DrawUfoWithRobot ; true to static-scene \ No automatic scene change InitUfoWithRobot ' DrawUfoWithRobot is painting \s --- NEW FILE: Floor.bmp --- (This appears to be a binary file; contents omitted.) --- NEW FILE: HelpForm.f --- \ Helpform.f \- textbox needs excontrols.f aNew -Helpform.f defer FocusOpenGLWindow : $| ( -<line>- ) 0 temp$ ! source 3 /string temp$ +place crlf$ count temp$ +place here temp$ c@ allot temp$ 1+ swap temp$ c@ cmove (source) @ >IN ! ; immediate : :long$ create -1 , does> lcount ; immediate : ;long$ ( - ) here last @ name> cell+ dup>r - r> ! \ Store the lcount 0 , \ Add a zero ; 0 value zHelpText$ : zHelpText ( adr cnt - ) drop to zHelpText$ ; :Object HelpForm <Super DialogWindow Font WinFont \ default font ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color \ Font setting definitions Font MText1-font : Set-MText1-font ( -- ) -14 Height: MText1-font 0 Width: MText1-font 0 Escapement: MText1-font 0 Orientation: MText1-font 400 Weight: MText1-font 0 CharSet: MText1-font 3 OutPrecision: MText1-font 2 ClipPrecision: MText1-font 1 Quality: MText1-font 49 PitchAndFamily: MText1-font s" Courier New" SetFacename: MText1-font ; MultiLineTextBox MText1 PushButton btOK :M ClassInit: ( -- ) ClassInit: super \ Insert your code here, e.g initialize variables, values etc. ;M :M WindowStyle: ( -- style ) WS_POPUPWINDOW WS_DLGFRAME or ;M \ N.B if this form is a modal form a non-zero parent must be set :M ParentWindow: ( -- hwndparent | 0 if no parent ) hWndParent ;M :M WindowTitle: ( -- ztitle ) z" Help" ;M :M StartSize: ( -- width height ) 611 490 ;M :M StartPos: ( -- x y ) CenterWindow: Self swap width 2/ + 60 + swap 14 + ;M :M Close: ( -- ) \ Insert your code here, e.g any data entered in form that needs to be saved Close: super ;M :M WM_COMMAND ( h m w l -- res ) dup 0= \ id is from a menu if lparam is zero if over LOWORD CurrentMenu if dup DoMenu: CurrentMenu then CurrentPopup if dup DoMenu: CurrentPopup then drop else over LOWORD ( ID ) self \ object address on stack WMCommand-Func ?dup \ must not be zero if execute else 2drop \ drop ID and object address then then 0 ;M : FormAction { id obj -- } id IDOK = if close: Self then ; :M SetCommand: ( cfa -- ) \ set WMCommand function to WMCommand-Func ;M :M On_Init: ( -- ) On_Init: Super ['] FormAction SetCommand: self s" MS Sans Serif" SetFaceName: WinFont 8 Width: WinFont Create: WinFont \ set form color to system color COLOR_BTNFACE Call GetSysColor NewColor: FrmColor 1000 SetTextLimit: MText1 self Start: MText1 30 32 556 383 Move: MText1 Set-MText1-font Create: MText1-font Handle: MText1-font SetFont: MText1 zHelpText$ SetTextZ: MText1 true ReadOnly: MText1 10 5 SetMargins: MText1 IDOK SetID: btOK self Start: btOK 253 440 100 25 Move: btOK Handle: Winfont SetFont: btOK s" OK" SetText: btOK ;M :M start: ( -- ) start: Super \ FocusOpenGLWindow ;M :M On_Paint: ( -- ) 0 0 GetSize: self Addr: FrmColor FillArea: dc ;M :M On_Done: ( -- ) Delete: WinFont Delete: MText1-font \ Insert your code here, e.g delete fonts, any bitmaps etc. On_Done: super ;M ;Object : ShowHelp ( zHelpText cnt - ) zHelpText close: HelpForm start: HelpForm ; \ Use: :long$ InitialText$ $| zHelpText$ has not been set. $| Use zHelpText first. $| zHelpText expects a long counted 0 terminated string. ;long$ InitialText$ zHelpText \ start: HelpForm abort \ Activate this line for a demo. \s --- NEW FILE: Body.bmp --- (This appears to be a binary file; contents omitted.) |