Thread: [Win32forth-cvs] win32forth/apps/Chess BMPIO.F,1.1,1.2 Fullscreen.f,1.1,1.2 Oglwin.f,1.1,1.2 Opengl.

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/win32forth/win32forth/apps/Chess
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5876/apps/Chess

Modified Files:
	BMPIO.F Fullscreen.f Oglwin.f Opengl.f PIXELFRM.F TOOLSET.F 
Log Message:
Removed REL>ABS and ABS>REL from the applications and demos, and made the demos work with the current w32f version

Index: TOOLSET.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Chess/TOOLSET.F,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** TOOLSET.F	5 May 2005 08:55:27 -0000	1.2
--- TOOLSET.F	5 May 2005 09:43:25 -0000	1.3
***************
*** 90,95 ****
        MB_OK MB_ICONSTOP  or
        MB_TASKMODAL or
!       z" Error:" rel>abs
!       message$ 1+ rel>abs
        NULL call MessageBox drop
   ;
--- 90,95 ----
        MB_OK MB_ICONSTOP  or
        MB_TASKMODAL or
!       z" Error:"
!       message$ 1+
        NULL call MessageBox drop
   ;
***************
*** 134,138 ****
  : (ABORT")      ( f -- )
                  \ _.rstack
!                 2r@  abs>rel at-word ! drop ((")) SWAP
                  IF      MSG !
                          THROW_ABORTQ THROW
--- 134,138 ----
  : (ABORT")      ( f -- )
                  \ _.rstack
!                 2r@  at-word ! drop ((")) SWAP
                  IF      MSG !
                          THROW_ABORTQ THROW
***************
*** 176,180 ****
     drop
   ;
! \ 1234 here ! here rel>abs 10 cadump abort
  
  
--- 176,180 ----
     drop
   ;
! \ 1234 here ! here 10 cadump abort
  
  
***************
*** 505,509 ****
      time-buf 2 + w! \ month
      time-buf 6 + w! \ day
!     hld-max hld rel>abs 0  time-buf rel>abs
      r> LOCALE_SYSTEM_DEFAULT
      call GetDateFormat dup 0= abort" ldate failed" hld-count
--- 505,509 ----
      time-buf 2 + w! \ month
      time-buf 6 + w! \ day
!     hld-max hld 0  time-buf
      r> LOCALE_SYSTEM_DEFAULT
      call GetDateFormat dup 0= abort" ldate failed" hld-count
***************
*** 515,519 ****
  
  : ltime         ( time-buf - adr count )    \ time-buf must be filled
!     hld-max hld rel>abs 0  time-buf rel>abs
      TIME_FORCE24HOURFORMAT  LOCALE_SYSTEM_DEFAULT
      call GetTimeFormat dup 0= abort" ltime failed" hld-count
--- 515,519 ----
  
  : ltime         ( time-buf - adr count )    \ time-buf must be filled
!     hld-max hld 0  time-buf
      TIME_FORCE24HOURFORMAT  LOCALE_SYSTEM_DEFAULT
      call GetTimeFormat dup 0= abort" ltime failed" hld-count
***************
*** 815,823 ****
          0                               \ last written time and date not needed
          0                               \ last access time not needed
!         file-time-buf-created rel>abs   \ creation time needed
          r> call GetFileTime drop
  
!         _systemtime     rel>abs         \ where to put results
!         file-time-buf   rel>abs         \ file time/date to convert
          call FileTimeToSystemTime drop
          _systemtime ;
--- 815,823 ----
          0                               \ last written time and date not needed
          0                               \ last access time not needed
!         file-time-buf-created           \ creation time needed
          r> call GetFileTime drop
  
!         _systemtime                     \ where to put results
!         file-time-buf                   \ file time/date to convert
          call FileTimeToSystemTime drop
          _systemtime ;
***************
*** 885,902 ****
  
  : OpenProcessToken ( - token )
!    here rel>abs TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY  or call GetCurrentProcess
     call OpenProcessToken drop here @
   ;
  
  : GetEnvironmentVariable  ( zstr-EnvironmentVariable-name buffer n - adr n )
!    swap dup >r rel>abs rot rel>abs call GetEnvironmentVariable r> swap ;
  
  : SetEnvironmentVariable  ( zstr-EnvironmentVariable-name  buffer n - )
!    pad +place pad dup +null 1+ rel>abs swap rel>abs
     call SetEnvironmentVariable drop
   ;
  
  : DelEnvironmentVariable  ( zstr-EnvironmentVariable-name  - )
!    rel>abs 0 pad ! pad rel>abs swap
     call SetEnvironmentVariable drop
   ;
--- 885,902 ----
  
  : OpenProcessToken ( - token )
!    here TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY  or call GetCurrentProcess
     call OpenProcessToken drop here @
   ;
  
  : GetEnvironmentVariable  ( zstr-EnvironmentVariable-name buffer n - adr n )
!    swap dup >r rot call GetEnvironmentVariable r> swap ;
  
  : SetEnvironmentVariable  ( zstr-EnvironmentVariable-name  buffer n - )
!    pad +place pad dup +null 1+ swap
     call SetEnvironmentVariable drop
   ;
  
  : DelEnvironmentVariable  ( zstr-EnvironmentVariable-name  - )
!    0 pad ! pad swap
     call SetEnvironmentVariable drop
   ;
***************
*** 909,918 ****
  
  : computername$! ( adr - ) \ March 30th, 2002 was GetComputerName
!    100 pad ! pad rel>abs  \ lpszName
!    over 1+ rel>abs             \ lpdwbuffer
     call GetComputerName drop  pad @ swap c! ;
  
  : username$!     ( adr - )  \ March 30th, 2002  was GetUserName
!    100 pad! pad rel>abs over 1+ rel>abs  call GetUserName  drop
     pad@ 1- swap c!
    ;
--- 909,918 ----
  
  : computername$! ( adr - ) \ March 30th, 2002 was GetComputerName
!    100 pad ! pad \ lpszName
!    over 1+       \ lpdwbuffer
     call GetComputerName drop  pad @ swap c! ;
  
  : username$!     ( adr - )  \ March 30th, 2002  was GetUserName
!    100 pad! pad over 1+ call GetUserName  drop
     pad@ 1- swap c!
    ;
***************
*** 934,938 ****
      title$   place title$   +NULL
      r>
!     title$ 1+ rel>abs message$ 1+ rel>abs
      NULL call MessageBox
   ;
--- 934,938 ----
      title$   place title$   +NULL
      r>
!     title$ 1+ message$ 1+
      NULL call MessageBox
   ;
***************
*** 956,960 ****
    0 do i to-cell tmp-array loop  ;
  
! : nrel>abs ( start end -- ...abs )   swap do i tmp-array rel>abs loop  ;
  
  ((  DWORD  lpAppName,    // points to section name
--- 956,960 ----
    0 do i to-cell tmp-array loop  ;
  
! : nrel>abs ( start end -- ...abs )   swap do i tmp-array loop  ;
  
  ((  DWORD  lpAppName,    // points to section name
***************
*** 967,971 ****
  \ lpReturnedString will contain a counted string with a 0 at the end
  :  GetPrivateProfileString  ( lpAppName lpKeyName lpDefault lpReturnedString nSize lpFileName - ncopied )
!    1+ 6 to-tmp-array 0 tmp-array rel>abs 1 tmp-array 2 tmp-array dup >r 1+ rel>abs
     3 6 nrel>abs  call GetPrivateProfileString r> c! ;
  
--- 967,971 ----
  \ lpReturnedString will contain a counted string with a 0 at the end
  :  GetPrivateProfileString  ( lpAppName lpKeyName lpDefault lpReturnedString nSize lpFileName - ncopied )
!    1+ 6 to-tmp-array 0 tmp-array 1 tmp-array 2 tmp-array dup >r 1+
     3 6 nrel>abs  call GetPrivateProfileString r> c! ;
  
***************
*** 1182,1186 ****
  : sounds  ( z"sound-file" - )
     sounds_on/off
!      if   SND_FILENAME NULL rot rel>abs call PlaySound  then drop  ;
  
  \ October 22nd, 2001 - 23:46
--- 1182,1186 ----
  : sounds  ( z"sound-file" - )
     sounds_on/off
!      if   SND_FILENAME NULL rot call PlaySound  then drop  ;
  
  \ October 22nd, 2001 - 23:46
***************
*** 1205,1210 ****
                                        key$ +NULL
                  >r
!                 disposition rel>abs         \ we get it, but don't use it
!                 regkey      rel>abs         \ the return value
                  NULL
                  samDesired
--- 1205,1210 ----
                                        key$ +NULL
                  >r
!                 disposition          \ we get it, but don't use it
!                 regkey               \ the return value
                  NULL
                  samDesired
***************
*** 1212,1216 ****
                  NULL
                  0
!                 key$ 1+  rel>abs
                  r> \ root-key
                  Call RegCreateKeyEx
--- 1212,1216 ----
                  NULL
                  0
!                 key$ 1+
                  r> \ root-key
                  Call RegCreateKeyEx
***************
*** 1233,1241 ****
                  then    >r  drop >r
                  MAXCOUNTED reglen !             \ init max length of string
!                 reglen          rel>abs
!                 ReturnedKey$ 1+ rel>abs
!                 regtype         rel>abs
                  0
!                 r>              rel>abs
                  r@
                  Call RegQueryValueEx
--- 1233,1241 ----
                  then    >r  drop >r
                  MAXCOUNTED reglen !             \ init max length of string
!                 reglen
!                 ReturnedKey$ 1+
!                 regtype
                  0
!                 r>
                  r@
                  Call RegQueryValueEx
***************
*** 1366,1373 ****
  \ October 7th, 2002 - 10:12
  
! : mkdir  ( pSecurityAttributes  z"path" - ior )  rel>abs call CreateDirectory ;
  
  \ Empty the directory before using rd
! : rd     ( z"path" - ior )                       rel>abs call RemoveDirectory ;
  
  : -string  ( adr1 cnt1 adr2 cnt2 - adr1+cnt2 cnt1-cnt2 )
--- 1366,1373 ----
  \ October 7th, 2002 - 10:12
  
! : mkdir  ( pSecurityAttributes  z"path" - ior )  call CreateDirectory ;
  
  \ Empty the directory before using rd
! : rd     ( z"path" - ior )                       call RemoveDirectory ;
  
  : -string  ( adr1 cnt1 adr2 cnt2 - adr1+cnt2 cnt1-cnt2 )
***************
*** 1528,1532 ****
  &InfoRect 3 cells+ constant height
  
! : windowposition ( hWnd - ) &InfoRect rel>abs swap  Call GetWindowRect ?win-error ;
  
  250 string: inifile$
--- 1528,1532 ----
  &InfoRect 3 cells+ constant height
  
! : windowposition ( hWnd - ) &InfoRect swap  Call GetWindowRect ?win-error ;
  
  250 string: inifile$

Index: Oglwin.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Chess/Oglwin.f,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Oglwin.f	21 Dec 2004 00:18:43 -0000	1.1
--- Oglwin.f	5 May 2005 09:43:25 -0000	1.2
***************
*** 131,135 ****
          12 cells                                                to cbSizeEx
          CS_HREDRAW  CS_VREDRAW or CS_OWNDC or CS_BYTEALIGNCLIENT or to StyleEx
!         TheWndProc rel>abs                                      to wndProcEx
          0                                                       to clsExtraEx
          0                                                       to wndExtraEx
--- 131,135 ----
          12 cells                                                to cbSizeEx
          CS_HREDRAW  CS_VREDRAW or CS_OWNDC or CS_BYTEALIGNCLIENT or to StyleEx
!         TheWndProc                                              to wndProcEx
          0                                                       to clsExtraEx
          0                                                       to wndExtraEx
***************
*** 139,148 ****
          0                                                       to hbrBackgroundEx
          NULL                                                    to MenuNameEx
!         WindowClassName 1+ rel>abs                              to ClassNameEx
          0                                                       to hIconSmEx
    ;
  
  : register-the-classEx    ( -- f )        \ register the class structure
!         WndClassEx rel>abs  Call RegisterClassEx ;
  
  : register-openGL-window  ( -- f )
--- 139,148 ----
          0                                                       to hbrBackgroundEx
          NULL                                                    to MenuNameEx
!         WindowClassName 1+                                      to ClassNameEx
          0                                                       to hIconSmEx
    ;
  
  : register-the-classEx    ( -- f )        \ register the class structure
!         WndClassEx Call RegisterClassEx ;
  
  : register-openGL-window  ( -- f )
***************
*** 158,162 ****
          WindowHasMenu: [ self ]                 \ have menu flag?
          WindowStyle:   [ self ]                 \ the window style
!         AddrOf: WndRect rel>abs                 \ make a new rectangle
          call AdjustWindowRectEx ?win-error      \ adjust the window
  
--- 158,162 ----
          WindowHasMenu: [ self ]                 \ have menu flag?
          WindowStyle:   [ self ]                 \ the window style
!         AddrOf: WndRect                         \ make a new rectangle
          call AdjustWindowRectEx ?win-error      \ adjust the window
  
***************
*** 169,174 ****
          StartPos:      [ self ] swap            \ y, x starting position
          WindowStyle:   [ self ]                 \ the window style dwStyle
!         WindowTitle:   [ self ] rel>abs         \ the window title lpWindowName
!         WindowClassName 1+ rel>abs              \ class name pClassName
          ExStyle
          Call CreateWindowEx
--- 169,174 ----
          StartPos:      [ self ] swap            \ y, x starting position
          WindowStyle:   [ self ]                 \ the window style dwStyle
!         WindowTitle:   [ self ]                 \ the window title lpWindowName
!         WindowClassName 1+                      \ class name pClassName
          ExStyle
          Call CreateWindowEx
***************
*** 283,284 ****
--- 283,285 ----
  \s
  
+

Thread: [Win32forth-cvs] win32forth/apps/Chess BMPIO.F,1.1,1.2 Fullscreen.f,1.1,1.2 Oglwin.f,1.1,1.2 Opengl.

win32forth-cvs