win32forth-cvs — CVS Commit List

[Win32forth-cvs] win32forth/apps/Win32ForthInstaller Installerform.f, NONE, 1.1 LinksInGroup.f, NONE, 1.1 Win32ForthInstaller.f, 1.1, 1.2

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Win32ForthInstaller
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv6380

Modified Files:
	Win32ForthInstaller.f 
Added Files:
	Installerform.f LinksInGroup.f 
Log Message:
Jos: Exteded the installer for optional shortcuts

--- NEW FILE: LinksInGroup.f ---
Anew -LinksInGroup.f

s" apps\Setup" "fpath+

needs Setup_dtop_lnk.f
needs Mkdir.f

#define CSIDL_PROGRAMS	0x0002	\ <user name>\Start Menu\Programs

: create_link_group       ( name$ cnt -- dirSpec cnt )
        CSIDL_PROGRAMS GetSpecialFolderLocation link-location$ place
        s" \" link-location$ +place  link-location$ +place
        link-location$ count mkdir
 ;

: create_links_in_group   ( -- )
        init_dtop_for_link s" Win32Forth"   create_link_group
        create_links_in_location CoUninitialize
 ;

\s

Index: Win32ForthInstaller.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthInstaller/Win32ForthInstaller.f,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Win32ForthInstaller.f	9 Jan 2016 14:51:18 -0000	1.1
--- Win32ForthInstaller.f	11 Jan 2016 20:05:20 -0000	1.2
***************
*** 9,28 ****
      needs lz77files.f
      needs Browsefld.f
! 
! : msgboxEx    { \ title$ message$ -- } ( adr2 len2 adr1 len1 type  - button )
!     MAXSTRING localAlloc: message$
!     MAXSTRING localAlloc: title$
!     >r
!     message$ place message$ +NULL
!     title$   place title$   +NULL
!     r>
!     title$ 1+  message$ 1+
!     conhndl call MessageBox
!  ;
! 
! : qbox   { \ title$ message$ -- }  ( adr2 len2 adr1 len1  - button )
!     [ MB_YESNO MB_ICONQUESTION or MB_TASKMODAL or MB_SETFOREGROUND or ] literal msgboxEx
!  ;
! 
  
  only forth also installer also forth definitions
--- 9,13 ----
      needs lz77files.f
      needs Browsefld.f
!     needs Installerform.f
  
  only forth also installer also forth definitions
***************
*** 123,126 ****
--- 108,112 ----
   ;
  
+ 
  : BuildApps ( - )
      cr ." -- Win32Forth support files:" cr
***************
*** 177,182 ****
  : create-links ( - )
      cr ." -- Create links"
!     s" idir apps\Setup fload Setup_dtop_lnk.f create_links_on_desktop bye"
!     ProcexecNew
   ;
  
--- 163,174 ----
  : create-links ( - )
      cr ." -- Create links"
!     LinksOnDesktop-
!        if   s" idir apps\Setup fload Setup_dtop_lnk.f create_links_on_desktop bye"
!             ProcexecNew
!        then
!     LinksInMenu-
!        if   s" idir apps\Win32ForthInstaller fload LinksInGroup.f create_links_in_group bye"
!             ProcexecNew
!        then
   ;
  
***************
*** 237,248 ****
   ;
  
! : Install_Y/N? ( - flag )
!    OverwriteTest
        if   s" Warning: OVERWRITING a previous Win32Forth installation."
             ." Warning: Found a previous Win32Forth installation." cr
             ." The install directory should be empty." cr cr
        else s" Installing Win32Forth."
!       then
!    s" Would you like to install Win32Forth?"  qbox IDYES =
   ;
  
--- 229,244 ----
   ;
  
! : WaitOnStartInstallForm ( - Flag )
!     begin   200 ms winpause IdOnClose 0<>   until  IdOnClose IDOK =
!  ;
! 
! : Install_Y/N? ( - )
!     0 to IdOnClose  OverwriteTest
        if   s" Warning: OVERWRITING a previous Win32Forth installation."
             ." Warning: Found a previous Win32Forth installation." cr
             ." The install directory should be empty." cr cr
        else s" Installing Win32Forth."
!       then TitleInstallForm place
!     Start: InstallForm WaitOnStartInstallForm
   ;
  
***************
*** 287,291 ****
  previous
  
! : StartInstallWin32Forth ( - )  Start: LiveLogWindow  InstallWin32Forth ;
  
  chdir ..
--- 283,291 ----
  previous
  
! : StartInstallWin32Forth ( - )
!    Start: LiveLogWindow
!    GetHandle: LiveLogWindow SetParent: InstallForm
!    InstallWin32Forth
!  ;
  
  chdir ..

--- NEW FILE: Installerform.f ---
Anew Installerform.f

\- textbox Require excontrols.f

0 value IdOnClose

string: TitleInstallForm
s" Warning: OVERWRITING a previous Win32Forth installation." TitleInstallForm place

0 value LinksOnDesktop-
0 value LinksInMenu-


:Object InstallForm                <Super DialogWindow

Font WinFont           \ default font
' 2drop value WmCommand-Func   \ function pointer for WM_COMMAND
ColorObject FrmColor      \ the background color

PushButton Button1
PushButton Button2
GroupBox Group1
CheckBox Check1
CheckBox Check2
Label Label1


:M ClassInit:   ( -- )
                ClassInit: super
                \ Insert your code here, e.g initialize variables, values etc.
                ;M

:M WindowStyle:  ( -- style )
                 WS_DLGFRAME
                ;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 )
                TitleInstallForm dup +null 1+
                ;M

:M StartSize:   ( -- width height )
                480 263
                ;M

:M StartPos:    ( -- x y )
                CenterWindow: Self
                ;M

:M Close:        ( -- )
                \ Insert your code here, e.g any data entered in form that needs to be saved
                Close: super
                ;M

: HandleId  ( Id - )
                IsButtonChecked?: Check1 to LinksOnDesktop-
                IsButtonChecked?: Check2 to LinksInMenu-
                to IdOnClose
                close: Self ;

: HandleButtons  ( Action/Button - )
            case
                IDOK     of IDOK     HandleId endof
                IDcancel of IDcancel HandleId endof
            endcase
 ;

:M WM_COMMAND   ( h m w l -- res )
                over LOWORD ( ID ) self   \ object address on stack
                WMCommand-Func ?dup    \ must not be zero
                if        execute drop HandleButtons
                else        2drop   \ drop ID and object address
                then        0 ;M


:M SetCommand:  ( cfa -- )  \ set WMCommand function
                to WMCommand-Func
                ;M

:M On_Init:     ( -- )
                On_Init: Super
                s" MS Sans Serif" SetFaceName: WinFont
                8 Width: WinFont
                Create: WinFont

                \ set form color to system color
                COLOR_BTNFACE Call GetSysColor NewColor: FrmColor

                IDOK SetID: Button1
                self Start: Button1
                130 210 100 25 Move: Button1
                Handle: Winfont SetFont: Button1
                s" Yes" SetText: Button1

                IDCANCEL SetID: Button2
                self Start: Button2
                240 210 100 25 Move: Button2
                Handle: Winfont SetFont: Button2
                s" No" SetText: Button2

                self Start: Check1
                150 60 210 27 Move: Check1
                true Check: Check1
                Handle: Winfont SetFont: Check1
                s" Add shorcuts on the desktop" SetText: Check1

                self Start: Check2
                150 100 210 28 Move: Check2
                Handle: Winfont SetFont: Check2
                s" Add shortcuts to the Start menu" SetText: Check2
                win8 winver =
                    if    false Check: Check2  Disable: Check2
                    else  true  Check: Check2
                    then

                self Start: Group1
                131 27 212 111 Move: Group1
                Handle: Winfont SetFont: Group1
                s" Options" SetText: Group1

                self Start: Label1
                149 160 220 44 Move: Label1
                Handle: Winfont SetFont: Label1
                s" Would you like to install Win32Forth?" SetText: Label1

                ;M

:M On_Paint:    ( -- )
                0 0 GetSize: self Addr: FrmColor FillArea: dc
                ;M

:M On_Done:    ( -- )
                Delete: WinFont
                \ Insert your code here, e.g delete fonts, any bitmaps etc.
                On_Done: super
                ;M

;Object

\s

[Win32forth-cvs] win32forth/apps/Win32ForthInstaller Mkdir.f, 1.1, 1.2

[Jos v.d.V. <jo...@us...>]

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
  ;
  

[Win32forth-cvs] win32forth fkernel.exe,1.67,1.68

[Jos v.d.V. <jo...@us...>]

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

[Win32forth-cvs] win32forth/apps/Win32ForthInstaller Win32ForthInstaller.txt, 1.1, 1.2

[Jos v.d.V. <jo...@us...>]

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.
  

[Win32forth-cvs] win32forth/src/kernel version.f,1.24,1.25

[Jos v.d.V. <jo...@us...>]

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
  

[Win32forth-cvs] win32forth/apps/Win32ForthInstaller - New directory

[Jos v.d.V. <jo...@us...>]

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

[Win32forth-cvs] win32forth/apps/Setup MakeSetup.bat, 1.1, 1.2 Setup.f, 1.33, 1.34

[Jos v.d.V. <jo...@us...>]

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

[Win32forth-cvs] win32forth/apps/WinEd Ed_FrameWindowObj.F, 1.8, 1.9 Ed_Globals.F, 1.7, 1.8

[Jos v.d.V. <jo...@us...>]

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
  

[Win32forth-cvs] win32forth/src/kernel fkernel.f,1.104,1.105

[Jos v.d.V. <jo...@us...>]

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

[Win32forth-cvs] win32forth/src Utils.f,1.33,1.34

[Jos v.d.V. <jo...@us...>]

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  ;
+ 
+ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  

[Win32forth-cvs] win32forth/src paths.f,1.41,1.42

[Jos v.d.V. <jo...@us...>]

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

[Win32forth-cvs] win32forth/src/lib TextBox.f,1.6,1.7

[Jos v.d.V. <jo...@us...>]

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

[Win32forth-cvs] win32forth/apps/Setup HYPER.F,1.4,1.5

[Jos v.d.V. <jo...@us...>]

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
- 

[Win32forth-cvs] win32forth/src Extend.f,1.36,1.37

[Jos v.d.V. <jo...@us...>]

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

[Win32forth-cvs] win32forth/src/lib StatusBar.f,1.6,1.7

[Jos v.d.V. <jo...@us...>]

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...)
  

[Win32forth-cvs] win32forth/apps/Setup Setup.f,1.32,1.33

[Jos v.d.V. <jo...@us...>]

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

[Win32forth-cvs] win32forth/src/lib/OpenGl OGLEVTS.F,1.2,1.3

[Jos v.d.V. <jo...@us...>]

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

[Win32forth-cvs] win32forth/src/lib/OpenGl Opengl.f,1.7,1.8

[Jos v.d.V. <jo...@us...>]

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 ----

[Win32forth-cvs] win32forth/src/lib/OpenGl Opengl.f,1.6,1.7

[Jos v.d.V. <jo...@us...>]

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

[Win32forth-cvs] win32forth/demos/OpenGLdemos HelpForm.f, 1.2, 1.3 OpenGl_Hello.f, 1.1, 1.2 UfoWithRobot.f, 1.1, 1.2 opengllib-1.11.f, 1.1, 1.2

[Jos v.d.V. <jo...@us...>]

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

[Win32forth-cvs] win32forth/demos/OpenGLdemos HelpForm.f,1.1,1.2

[Jos v.d.V. <jo...@us...>]

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
  

[Win32forth-cvs] win32forth/src/lib/OpenGl Opengl.f,1.5,1.6

[Jos v.d.V. <jo...@us...>]

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 ;
  

[Win32forth-cvs] win32forth/demos/OpenGLdemos OpenGlLessons.f, NONE, 1.1 Readme.txt, NONE, 1.1 opengllib-1.11.f, NONE, 1.1 tim.bmp, NONE, 1.1

[Jos v.d.V. <jo...@us...>]

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

[Win32forth-cvs] win32forth/src/lib/OpenGl Opengl.f,1.4,1.5

[Jos v.d.V. <jo...@us...>]

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

[Win32forth-cvs] win32forth/demos OpenGl_Hello.f,1.1,NONE

[Jos v.d.V. <jo...@us...>]

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 ---