Menu
▾
▴
win32forth-cvs — CVS Commit List
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
|
| 2025 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Jos v.d.V. <jo...@us...> - 2005-10-18 17:11:56
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4170/apps/Player4 Added Files: View.f view.ff Log Message: Jos: A new form. Not yet fully operational. --- NEW FILE: view.ff --- (This appears to be a binary file; contents omitted.) --- NEW FILE: View.f --- \ VIEW.FRM \- textbox needs excontrols.f :Object ViewForm <Super DialogWindow Font WinFont ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color GroupBox Group1 GroupBox Group2 GroupBox Group3 CheckBox s_DriveType CheckBox s_label CheckBox s_filesize CheckBox s_#played CheckBox lbl_Index CheckBox lbl_Drivetype CheckBox lbl_Label CheckBox lbl_File_size CheckBox lbl_#Played RadioButton R_Filename RadioButton R_Artist_and_title CheckBox s_Filename CheckBox s_Artist_Title PushButton Button1 PushButton Button2 :M ClassInit: ( -- ) ClassInit: super \ Insert your code here ;M :M WindowStyle: ( -- style ) WS_POPUPWINDOW WS_DLGFRAME or ;M \ if this form is a modal form a non-zero parent must be set :M ParentWindow: ( -- hwndparent | 0 if no parent ) parent ;M :M SetParent: ( hwndparent -- ) \ set owner window to parent ;M :M WindowTitle: ( -- ztitle ) z" View" ;M :M StartSize: ( -- width height ) 201 290 ;M :M StartPos: ( -- x y ) CenterWindow: Self ;M :M Close: ( -- ) \ Insert your code here Close: super ;M :M On_Init: ( -- ) s" MS Sans Serif" SetFaceName: WinFont 8 Width: WinFont Create: WinFont \ set form color to system color COLOR_BTNFACE Call GetSysColor NewColor: FrmColor self Start: Group1 20 10 164 230 Move: Group1 Handle: Winfont SetFont: Group1 s" Sort/Group" SetText: Group1 self Start: Group2 50 30 101 124 Move: Group2 Handle: Winfont SetFont: Group2 s" Optional" SetText: Group2 self Start: Group3 50 160 125 70 Move: Group3 Handle: Winfont SetFont: Group3 s" Name" SetText: Group3 self Start: s_DriveType 30 70 18 16 Move: s_DriveType \ Handle: Winfont SetFont: s_DriveType \ s" " SetText: s_DriveType self Start: s_label 30 90 18 16 Move: s_label \ Handle: Winfont SetFont: s_label \ s" " SetText: s_label self Start: s_filesize 30 110 18 16 Move: s_filesize \ Handle: Winfont SetFont: s_filesize \ s" " SetText: s_filesize self Start: s_#played 30 130 18 16 Move: s_#played \ Handle: Winfont SetFont: s_#played \ s" " SetText: s_#played self Start: lbl_Index 60 50 75 16 Move: lbl_Index Handle: Winfont SetFont: lbl_Index s" Index" SetText: lbl_Index self Start: lbl_Drivetype 60 70 77 16 Move: lbl_Drivetype Handle: Winfont SetFont: lbl_Drivetype s" Drivetype" SetText: lbl_Drivetype self Start: lbl_Label 60 90 76 16 Move: lbl_Label Handle: Winfont SetFont: lbl_Label s" Label" SetText: lbl_Label self Start: lbl_File_size 60 110 66 16 Move: lbl_File_size Handle: Winfont SetFont: lbl_File_size s" File size" SetText: lbl_File_size self Start: lbl_#Played 60 130 77 16 Move: lbl_#Played Handle: Winfont SetFont: lbl_#Played s" #Played" SetText: lbl_#Played self Start: R_Filename 60 180 107 16 Move: R_Filename Handle: Winfont SetFont: R_Filename s" Filename" SetText: R_Filename self Start: R_Artist_and_title 60 200 101 16 Move: R_Artist_and_title Handle: Winfont SetFont: R_Artist_and_title s" Artist and title" SetText: R_Artist_and_title self Start: s_Filename 30 180 18 16 Move: s_Filename \ Handle: Winfont SetFont: s_Filename \ s" " SetText: s_Filename self Start: s_Artist_Title 30 200 19 22 Move: s_Artist_Title \ Handle: Winfont SetFont: s_Artist_Title \ s" " SetText: s_Artist_Title IDOK SetID: Button1 self Start: Button1 40 250 50 20 Move: Button1 Handle: Winfont SetFont: Button1 s" Ok" SetText: Button1 IDcancel SetID: Button2 self Start: Button2 100 250 50 20 Move: Button2 Handle: Winfont SetFont: Button2 s" Cancel" SetText: Button2 vadr-config dup s_Drivetype- c@ Check: s_DriveType dup s_Label- c@ Check: s_Label dup s_filesize- c@ Check: s_filesize dup s_#Played- c@ Check: s_#Played dup s_Filename- c@ Check: s_Filename dup s_Artist_Title- c@ Check: s_Artist_Title dup l_Index- c@ Check: lbl_Index dup l_Drivetype- c@ Check: lbl_DriveType dup l_Label- c@ Check: lbl_Label dup l_File_size- c@ Check: lbl_File_size dup l_#Played- c@ Check: lbl_#Played l_Filename- c@ if CheckButton: R_Filename else CheckButton: R_Artist_and_title then ;M : SaveSettingsForm ( - ) vadr-config IsButtonChecked?: s_Drivetype over s_DriveType- c! IsButtonChecked?: s_Label over s_Label- c! IsButtonChecked?: s_filesize over s_filesize- c! IsButtonChecked?: s_#Played over s_#Played- c! IsButtonChecked?: s_Filename over s_Filename- c! IsButtonChecked?: s_Artist_Title over s_Artist_Title- c! IsButtonChecked?: lbl_Index over l_Index- c! IsButtonChecked?: lbl_Drivetype over l_DriveType- c! IsButtonChecked?: lbl_Label over l_Label- c! IsButtonChecked?: lbl_File_size over l_File_size- c! IsButtonChecked?: lbl_#Played over l_#Played- c! IsButtonChecked?: R_Filename over l_Filename- c! IsButtonChecked?: R_Artist_and_title swap l_Artist_and_title- c! ; : HandleButtons ( Action/Button - ) case IDOK of SaveSettingsForm close: Self endof IDcancel of close: Self endof endcase ; \ debug HandleButtons :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_Paint: ( -- ) 0 0 GetSize: self Addr: FrmColor FillArea: dc ;M :M On_Done: ( -- ) Delete: WinFont \ Insert your code here On_Done: super ;M ;Object : StartViewForm Start: ViewForm ; |
|
From: Jos v.d.V. <jo...@us...> - 2005-10-17 20:29:30
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16764/apps/Player4 Modified Files: PLAYER4.F Log Message: Jos: Turnkey correction Index: PLAYER4.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v retrieving revision 1.25 retrieving revision 1.26 diff -C2 -d -r1.25 -r1.26 *** PLAYER4.F 17 Oct 2005 20:26:31 -0000 1.25 --- PLAYER4.F 17 Oct 2005 20:29:20 -0000 1.26 *************** *** 20,25 **** decimal ! \ true value turnkey? ! false value turnkey? true value MciDebug? --- 20,25 ---- decimal ! true value turnkey? ! \ false value turnkey? true value MciDebug? |
|
From: Jos v.d.V. <jo...@us...> - 2005-10-17 20:26:50
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16030/apps/Player4 Modified Files: Catalog.f Mediatree.f PLAYER4.F Log Message: Jos: Removed a bug from the catalog while extending the catalog. The new form is not fully operational yet. Index: PLAYER4.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 *** PLAYER4.F 16 Oct 2005 10:24:39 -0000 1.24 --- PLAYER4.F 17 Oct 2005 20:26:31 -0000 1.25 *************** *** 20,25 **** decimal ! true value turnkey? ! \ false value turnkey? true value MciDebug? --- 20,25 ---- decimal ! \ true value turnkey? ! false value turnkey? true value MciDebug? *************** *** 50,53 **** --- 50,55 ---- needs Resources.f needs multiopen.f + needs view.f + \ ----------------------------------------------------------------------------- *************** *** 88,97 **** MENUSEPARATOR ! SUBMENU "S&ort" MENUITEM "Se&t maximum random level" SetRandomLevel ; MENUITEM "&Generate random numbers" RandomizeCatalog ; MENUSEPARATOR MENUITEM "S&ort by random number" SortRandom ; ! MENUITEM "S&ort by least played" SortLeastPlayed ; MENUITEM "S&ort by size" SortSize ; MENUITEM "S&ort by filename" SortCatalog ; --- 90,99 ---- MENUSEPARATOR ! SUBMENU "S&ort and show" MENUITEM "Se&t maximum random level" SetRandomLevel ; MENUITEM "&Generate random numbers" RandomizeCatalog ; MENUSEPARATOR MENUITEM "S&ort by random number" SortRandom ; ! MENUITEM "Define a view" StartViewForm ; MENUITEM "S&ort by size" SortSize ; MENUITEM "S&ort by filename" SortCatalog ; *************** *** 227,231 **** ['] on_unclicked to unclick-func InitFileNames ! GetHandle: Self SetParent: ControlCenter catalog-exist? if map-config-file map-database --- 229,234 ---- ['] on_unclicked to unclick-func InitFileNames ! GetHandle: Self dup SetParent: ControlCenter ! SetParent: ViewForm catalog-exist? if map-config-file map-database Index: Mediatree.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Mediatree.f,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** Mediatree.f 16 Oct 2005 10:24:39 -0000 1.15 --- Mediatree.f 17 Oct 2005 20:26:31 -0000 1.16 *************** *** 20,31 **** ;M : add-record ( n - ) \ Add when not deleted and found in a collection dup n>record dup RecordDef Deleted- c@ 0= show-deleted = swap RecordDef Excluded- c@ or if drop ! Else dup to lParam ! dup (l.int) InlineRecord place ! s" " InlineRecord +place ! n>record dup RecordDef File_name swap Cnt_File_name c@ InlineRecord +place InlineRecord +null InlineRecord 1+ to pszText --- 20,52 ---- ;M + : +space ( - ) s" " InlineRecord +place ; + + \ add-record is under construction.... : add-record ( n - ) \ Add when not deleted and found in a collection dup n>record dup RecordDef Deleted- c@ 0= show-deleted = swap RecordDef Excluded- c@ or if drop ! Else vadr-config over to lParam 0 InlineRecord ! ! dup l_Index- c@ ! if over (l.int) InlineRecord place +space ! then ! swap n>record ! over l_Drivetype- c@ ! if dup RecordDef DriveType c@ ! DriveType$ InlineRecord +place +space ! then ! ! dup RecordDef File_name swap Cnt_File_name c@ ! InlineRecord +place + + \ dup l_Label- c@ + \ dup l_File_size- c@ + \ dup l_#Played- c@ + \ l_Filename- c@ + \ if CheckButton: R_Filename + \ else CheckButton: R_Artist_and_title + \ then + + InlineRecord +null InlineRecord 1+ to pszText *************** *** 33,36 **** --- 54,58 ---- tvins 0 TVM_INSERTITEMA hWnd Call SendMessage to hInsertAfter + drop then ; Index: Catalog.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Catalog.f,v retrieving revision 1.13 retrieving revision 1.14 diff -C2 -d -r1.13 -r1.14 *** Catalog.f 16 Oct 2005 10:24:39 -0000 1.13 --- Catalog.f 17 Oct 2005 20:26:31 -0000 1.14 *************** *** 27,35 **** DWORD first-free-record DWORD MaximumRandomLevel ;struct sizeof ConfigDef mkstruct: Config s" \" Config ConfigDef PathMediaFiles place create DatFileFile$ ," \PathMediaFiles.dat" ! create DatFile$ : InitFileNames ( - ) --- 27,49 ---- DWORD first-free-record DWORD MaximumRandomLevel + BYTE s_Drivetype- + BYTE s_Label- + BYTE s_filesize- + BYTE s_#Played- + BYTE s_Filename- + BYTE s_Artist_Title- + BYTE l_Index- + BYTE l_Drivetype- + BYTE l_Label- + BYTE l_File_size- + BYTE l_#Played- + BYTE l_Filename- + BYTE l_Artist_and_title- + ;struct sizeof ConfigDef mkstruct: Config s" \" Config ConfigDef PathMediaFiles place create DatFileFile$ ," \PathMediaFiles.dat" ! string: DatFile$ : InitFileNames ( - ) |
|
From: George H. <geo...@us...> - 2005-10-17 08:56:28
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13786/win32forth/src Modified Files: Class.f Dc.f Log Message: gah: minor optimizations to Dc.f Added code to Class.f so object IVARs also create a word (internal to the class and it's descendants) of the same name that returns the ivar address (compile only). Index: Dc.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Dc.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** Dc.f 8 Oct 2005 11:50:36 -0000 1.8 --- Dc.f 17 Oct 2005 08:56:21 -0000 1.9 *************** *** 154,159 **** ;M ! :M PenColor: { color_object -- } ! color_object LineColor: self ;M --- 154,159 ---- ;M ! :M PenColor: ( color_object -- ) ! LineColor: self ;M Index: Class.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Class.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Class.f 29 Aug 2005 15:56:27 -0000 1.5 --- Class.f 17 Oct 2005 08:56:21 -0000 1.6 *************** *** 17,21 **** cell newuser (NewObject) \ Newest object being created : NewObject (NewObject) @ ; ! IN-SYSTEM --- 17,21 ---- cell newuser (NewObject) \ Newest object being created : NewObject (NewObject) @ ; ! IN-SYSTEM *************** *** 119,123 **** ?win-error-enabled TURNKEYED? 0= AND if false to ?win-error-enabled ! \+ forth-io forth-io cr cr unhash type ." NULL" \IN-SYSTEM-OK .rstack --- 119,123 ---- ?win-error-enabled TURNKEYED? 0= AND if false to ?win-error-enabled ! \+ forth-io forth-io cr cr unhash type ." NULL" \IN-SYSTEM-OK .rstack *************** *** 132,136 **** BYE then ; ! : (Defer) ( ^obj -- ) \ look up SelID at IP and run the method @(ip) swap ( SelID ^obj ) --- 132,136 ---- BYE then ; ! : (Defer) ( ^obj -- ) \ look up SelID at IP and run the method @(ip) swap ( SelID ^obj ) *************** *** 190,194 **** 0 Value ^Self 0 Value ^Super \ nfa of SUPER pseudo-Ivar ! in-system --- 190,194 ---- 0 Value ^Self 0 Value ^Super \ nfa of SUPER pseudo-Ivar ! in-system *************** *** 298,305 **** --- 298,309 ---- 0 value contiguous-data? + defer ivar-name + \ Compile an instance variable dictionary entry : <VAR ( #elems ^class OR ^class -- ) dup XFA @ >r dup>r \ save XFA contents and class ptr + >in @ @word Vfind abort" Duplicate Instance Variable" + swap >in ! contiguous-data? \ if contiguous flag non zero if -1 r@ XFA ! \ set XFA to -1 *************** *** 319,322 **** --- 323,327 ---- if rot dup , * 4 + then 0max \ #elems + ivar-name swap DFA @ + \ Account for named ivar lengths class-allot *************** *** 380,384 **** THEN obAddr (newObject) ! ! theClass IFA @ 0 Itrav classinit obAddr ; in-system --- 385,389 ---- THEN obAddr (newObject) ! ! theClass IFA @ 0 Itrav classinit obAddr ; in-system *************** *** 462,466 **** here to ^Class 0 op! \ for error checking in runIvarRef ! ?loading if loadline @ else -1 --- 467,471 ---- here to ^Class 0 op! \ for error checking in runIvarRef ! ?loading if loadline @ else -1 *************** *** 794,798 **** VFIND IF getIvarRef ! ELSE getRef THEN ELSE VFIND --- 799,803 ---- VFIND IF getIvarRef ! ELSE getRef THEN ELSE VFIND *************** *** 962,965 **** --- 967,972 ---- class-allot ; + :noname 0 bytes ; is ivar-name + : byte ( -<name>- ) \ byte (8bit) instance variable header *************** *** 1231,1232 **** --- 1238,1240 ---- only forth also definitions + |
|
From: Jos v.d.V. <jo...@us...> - 2005-10-16 10:52:36
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8378/src/lib Modified Files: Volinfo.f Log Message: Jos: Minor bug in a stacknotation Index: Volinfo.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/Volinfo.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Volinfo.f 16 Oct 2005 10:26:55 -0000 1.1 --- Volinfo.f 16 Oct 2005 10:52:28 -0000 1.2 *************** *** 14,18 **** ! : DriveType$ ( DriveType - DriveType$ ) case DRIVE_UNKNOWN of s" Unknown" endof --- 14,18 ---- ! : DriveType$ ( DriveType - DriveType$ cnt ) case DRIVE_UNKNOWN of s" Unknown" endof *************** *** 80,87 **** ; ! \ \s Use: ! current-dir$ count .Volume ! s" e:\" VolumeLabel type . \s --- 80,86 ---- ; ! \s Use: current-dir$ count .Volume ! s" c:\" VolumeLabel type . \s |
|
From: Jos v.d.V. <jo...@us...> - 2005-10-16 10:27:05
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4840/src/lib Added Files: Volinfo.f Log Message: Jos: Retrieve information about a volume. --- NEW FILE: Volinfo.f --- anew -Volinfo.f string: RootPathName // root directory of the file system string: VolumeNameBuffer // name of the volume \ 0 value nVolumeNameSize // length of lpVolumeNameBuffer 0 value VolumeSerialNumber // serial number 0 value MaximumComponentLength // maximum filename length 0 value FileSystemFlags // file system flags string: FileSystemNameBuffer // file system \ 0 value nFileSystemNameSize // FileSystemNameBuffer \ nFileSystemNameSize nVolumeNameSize are not filled : DriveType$ ( DriveType - DriveType$ ) case DRIVE_UNKNOWN of s" Unknown" endof DRIVE_NO_ROOT_DIR of s" Invalid, or not mounted" endof DRIVE_REMOVABLE of s" Removable" endof DRIVE_FIXED of s" Fixed" endof DRIVE_REMOTE of s" Remote" endof DRIVE_CDROM of s" Cd/Dvd" endof DRIVE_RAMDISK of s" Ram" endof s" unknown" rot endcase ; \ Not yet implemented: \ To determine whether a drive is a USB-type drive, \ call SetupDiGetDeviceRegistryProperty and \ specify the SPDRP_REMOVAL_POLICY property. : GetVolumeInformation ( RootPath count - DriveType$ flag ) RootPathName place RootPathName +null \ A UNC name (ROOTpath) should still be possible RootPathName 2 + 2 s" :\" compare 0= if 0 RootPathName 4 + ! 3 RootPathName c! \ Change a full path into a ROOTpath then 0 to FileSystemFlags 0 to MaximumComponentLength RootPathName 1+ dup>r call GetDriveType FileSystemNameBuffer erase$ VolumeNameBuffer erase$ 0 to VolumeSerialNumber pad FileSystemNameBuffer [ &of FileSystemFlags ] literal [ &of MaximumComponentLength ] literal [ &of VolumeSerialNumber ] literal pad cell+ VolumeNameBuffer r> call GetVolumeInformation ; : y/n-box ( szText szTitle - button ) [ MB_YESNO MB_ICONQUESTION or MB_TASKMODAL or ] literal NULL MessageBox ; : RetrieveVolumeInformation ( RootPath count - DriveType$ ) begin 2dup GetVolumeInformation dup 0= while nip (?WinError) z" Continue ? " z" Error while retrieving information" y/n-box IDNO = if 2drop DRIVE_UNKNOWN exit then repeat drop nip nip ; : VolumeLabel ( RootPath count - DriveType adr cnt ) RetrieveVolumeInformation VolumeNameBuffer zcount ; : .Volume ( RootPath count - ) RetrieveVolumeInformation cr cr ." Volume information of " RootPathName count type cr ." Type: " DriveType$ type ." Serialnumber: " VolumeSerialNumber . cr ." File system: " FileSystemNameBuffer zcount type ." Maximum length of a filename: " MaximumComponentLength . cr ." System flags: " FileSystemFlags dup . ." Filecompression is by windows is " FS_FILE_COMPRESSION and 0= if ." not " then ." possible" cr ." Label: " VolumeNameBuffer zcount type ; \ \s Use: current-dir$ count .Volume s" e:\" VolumeLabel type . \s |
|
From: Jos v.d.V. <jo...@us...> - 2005-10-16 10:24:55
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4456/apps/Player4 Modified Files: Catalog.f Mediatree.f PLAYER4.F Pl_MciWindow.f Log Message: Jos: Added volume info for the catalog and made it possible to extract the name of the artist and title of the album from the filename. Made it also possible to escape to the Forth-console when player4 is not used as a turnkey. Index: PLAYER4.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v retrieving revision 1.23 retrieving revision 1.24 diff -C2 -d -r1.23 -r1.24 *** PLAYER4.F 9 Oct 2005 16:33:07 -0000 1.23 --- PLAYER4.F 16 Oct 2005 10:24:39 -0000 1.24 *************** *** 20,26 **** decimal ! true value turnkey? \ false value turnkey? ! true value MciDebug? defer PLAYER ' noop is PLAYER --- 20,26 ---- decimal ! true value turnkey? \ false value turnkey? ! true value MciDebug? defer PLAYER ' noop is PLAYER *************** *** 40,43 **** --- 40,44 ---- needs Pl_Toolset.f + needs volinfo.f needs sub_dirs.f needs number.f *************** *** 53,56 **** --- 54,58 ---- \ Define the Popup bar \ ----------------------------------------------------------------------------- + POPUPBAR player4-Popup-bar POPUP " " *************** *** 232,236 **** ." freelist: " vadr-config #free-list @ . then ! else datfile$ count file-exist? not check-config then --- 234,238 ---- ." freelist: " vadr-config #free-list @ . then ! else datfile$ count file-exist? check-config then *************** *** 465,468 **** --- 467,472 ---- On_Paint: MainWindow ; + defer StopPlayer + : QuitPlayer ( -- ) Close: MainWindow bye ; *************** *** 479,483 **** 'Q' +k_control of QuitPlayer endof k_F1 of AboutPlayer endof ! k_esc of QuitPlayer endof 'A' +k_control of AudioOn: Player4W endof --- 483,487 ---- 'Q' +k_control of QuitPlayer endof k_F1 of AboutPlayer endof ! k_esc of StopPlayer endof 'A' +k_control of AudioOn: Player4W endof *************** *** 542,552 **** turnkey? [if] false to MciDebug? ' player4 turnkey Player4.exe s" Player4.ico" s" Player4.exe" AddAppIcon - 1 pause-seconds [else] true to MciDebug? s" Player4.ico" s" Player4.exe" AddAppIcon PLAYER4 --- 546,557 ---- turnkey? [if] + ' QuitPlayer is StopPlayer false to MciDebug? ' player4 turnkey Player4.exe s" Player4.ico" s" Player4.exe" AddAppIcon 1 pause-seconds [else] true to MciDebug? + ' abort is StopPlayer \ Access to Forth ( Not fullproof ) s" Player4.ico" s" Player4.exe" AddAppIcon PLAYER4 Index: Pl_MciWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Pl_MciWindow.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** Pl_MciWindow.f 9 Oct 2005 16:33:07 -0000 1.10 --- Pl_MciWindow.f 16 Oct 2005 10:24:39 -0000 1.11 *************** *** 34,37 **** --- 34,38 ---- ;Object + : GetLabel ( path cnt - ) VolumeLabel to /VolumeNameBuffer drop to _DriveType ; MultiFileOpenDialog GetFilesDialog "Select File" "Media Files (*.mp3,*.midi,*.mid,*.wav,*.mpeg,*.mpg,*.mp2,*.mp4,*.mpa,*.wma,*.wmv,*.avi,*.dat)|*.mp3;*.midi;*.mid;*.wav;*.mpeg;*.mpg;*.mp2;*.mp4;*.mpa;*.wma;*.wmv;*.avi;*.dat|" *************** *** 237,256 **** : add-to-catalog ( -- ) \ Delete the *.dat files to start a new catalog ! z" Folder(s) to catalog" ! config-mhndl map-hndl>vadr PathMediaFiles dup +null GetHandle: Self ! BrowseForFolder ! If add_dir_tree ! then ; :M Import-to-catalog: ( -- ) ! DatFile$ count file-exist? ! check-config ! add-to-catalog ;M :M AddFilesFromSelector: ( - ) \ add one or more files ! OpenAppendDatabase GetHandle: self Start: GetFilesDialog count nip 0> ! if #SelectedFiles: GetFilesDialog 0 do dup i GetFile: GetFilesDialog AddFile loop --- 238,258 ---- : add-to-catalog ( -- ) \ Delete the *.dat files to start a new catalog ! z" Folder(s) to catalog" ! vadr-config PathMediaFiles dup +null GetHandle: Self ! BrowseForFolder ! If vadr-config PathMediaFiles count GetLabel add_dir_tree ! then ! ; :M Import-to-catalog: ( -- ) ! add-to-catalog ;M + :M AddFilesFromSelector: ( - ) \ add one or more files ! OpenAppendDatabase GetHandle: self Start: GetFilesDialog count nip 0> ! if 0 GetFile: GetFilesDialog GetLabel ! #SelectedFiles: GetFilesDialog 0 do dup i GetFile: GetFilesDialog AddFile loop Index: Mediatree.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Mediatree.f,v retrieving revision 1.14 retrieving revision 1.15 diff -C2 -d -r1.14 -r1.15 *** Mediatree.f 9 Oct 2005 16:33:07 -0000 1.14 --- Mediatree.f 16 Oct 2005 10:24:39 -0000 1.15 *************** *** 44,48 **** \ -1 to statemask [ TVIF_TEXT TVIF_CHILDREN or TVIF_PARAM or TVIF_STATE or ] literal to mask ! 0 for-all-records-from# add-record ;M --- 44,48 ---- \ -1 to statemask [ TVIF_TEXT TVIF_CHILDREN or TVIF_PARAM or TVIF_STATE or ] literal to mask ! for-all-records add-record ;M *************** *** 75,78 **** --- 75,79 ---- ;Class + \ ----------------------------------------------------------------------------- \ define the child window for the left part of the main window *************** *** 96,99 **** --- 97,102 ---- 0 0 -1 hDrop Call DragQueryFile ?dup if datfile$ count file-exist? check-config + MAXCOUNTED drop$ 0 hDrop Call DragQueryFile + drop$ swap GetLabel OpenAppendDatabase to wHndl begin MAXCOUNTED drop$ #File hDrop Call DragQueryFile dup 0> Index: Catalog.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Catalog.f,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** Catalog.f 9 Oct 2005 16:33:07 -0000 1.12 --- Catalog.f 16 Oct 2005 10:24:39 -0000 1.13 *************** *** 1,3 **** ! anew catalog.f \ 4-4-2005 needs ExtStruct.f --- 1,4 ---- ! \ Error: GetxxxxFileName failed RC=0x3003 ! anew catalog.f \ 15-10-2005 needs ExtStruct.f *************** *** 14,19 **** create IndexFile$ ," \catalog.idx" ! maxstring create database$ allot ! maxstring create index$ allot \ Define the configuration of the database --- 15,21 ---- create IndexFile$ ," \catalog.idx" ! string: database$ ! string: index$ ! 0 value _DriveType \ Define the configuration of the database *************** *** 29,33 **** sizeof ConfigDef mkstruct: Config s" \" Config ConfigDef PathMediaFiles place create DatFileFile$ ," \PathMediaFiles.dat" ! create DatFile$ maxstring ConfigDef allot : InitFileNames ( - ) --- 31,35 ---- sizeof ConfigDef mkstruct: Config s" \" Config ConfigDef PathMediaFiles place create DatFileFile$ ," \PathMediaFiles.dat" ! create DatFile$ : InitFileNames ( - ) *************** *** 38,64 **** ; ! \ Record discription of the catalog ! 256 constant /file_name ! 40 constant /Artist ! 36 constant /Title :struct RecordDef \ catalog ! /file_name Field: File_name BYTE Cnt_File_name - /Artist Field: Artist - BYTE Cnt_Artist - /Title Field: Title - BYTE Cnt_Title - DWORD FileSize BYTE Deleted- ! BYTE Excluded- \ Was: LastPlayed BYTE Played- ! BYTE Not_used2 Offset Deleted-thread DWORD RandomLevel DWORD #played DWORD Not_used1 ! ;struct \ database part --- 40,74 ---- ; ! \ Record discription of the catalog. October 14th, 2005. ! \ This model assumes that the filename is the title of an album and ! \ that it is placed in a directory named after the artist. ! 255 constant /file_name ! 32 constant /MediaLabel ! 80 constant /artist ! 120 constant /Title :struct RecordDef \ catalog ! /file_name Field: File_name BYTE Cnt_File_name BYTE Deleted- ! BYTE Excluded- BYTE Played- ! BYTE DriveType ! DWORD FileSize ! /MediaLabel Field: MediaLabel ! BYTE Cnt_MediaLabel ! /artist Field: Artist \ Extracted from the filename ! BYTE Cnt_Artist ! /Title Field: Title \ Extracted from the filename ! BYTE Cnt_Title Offset Deleted-thread DWORD RandomLevel DWORD #played DWORD Not_used1 ! DWORD Not_used2 ! DWORD Not_used3 ! DWORD Not_used4 ! ;struct \ database part *************** *** 77,83 **** map-handle config-mhndl ! : map-index ( - ) index$ count idx-mhndl open-map-file throw ; ! : map-database-file ( - ) database$ count database-mhndl open-map-file throw ; ! : map-config-file ( - ) DatFile$ count config-mhndl open-map-file throw ; : create-index-file ( #records - f ) --- 87,93 ---- map-handle config-mhndl ! : map-index ( - ) index$ count idx-mhndl open-map-file throw ; ! : map-database-file ( - ) database$ count database-mhndl open-map-file throw ; ! : map-config-file ( - ) DatFile$ count config-mhndl open-map-file throw ; : create-index-file ( #records - f ) *************** *** 116,121 **** in-system ! : do_part ( - ) ! s" database-mhndl #records-in-database swap do i " evaluate ; : for-all-records-from# \ compiletime: ( -<word>- ) runtime: ( start - ) --- 126,132 ---- in-system ! : do_part ( n - ) ! s" database-mhndl #records-in-database swap do i " EVALUATE ; ! : for-all-records-from# \ compiletime: ( -<word>- ) runtime: ( start - ) *************** *** 125,133 **** ; immediate in-application \ Define key-len and key-start before using sort-database : sort-database ( - ) 0 n>aptr database-mhndl #records-in-database shell-rel ; ! : sort-database-bin ( - ) 0 n>aptr database-mhndl #records-in-database shell-rel-c ; : rebuild-index-hdrs ( - ) \ database must mapped --- 136,152 ---- ; immediate + : do_all_part ( - ) s" database-mhndl #records-in-database 0 do i " EVALUATE ; + + : for-all-records ( - ) \ compiletime: ( -<word>- ) runtime: ( - ) + do_all_part + ' compile, ( rec-adr - ) + postpone loop + ; immediate + in-application \ Define key-len and key-start before using sort-database : sort-database ( - ) 0 n>aptr database-mhndl #records-in-database shell-rel ; ! : sort-database-bin ( - ) 0 n>aptr database-mhndl #records-in-database shell-rel-c ; : rebuild-index-hdrs ( - ) \ database must mapped *************** *** 145,148 **** --- 164,168 ---- \ ==== Part that depends on a record definition + : vadr-config ( - vadr-config ) s" config-mhndl map-hndl>vadr " EVALUATE ; IMMEDIATE *************** *** 192,199 **** : build-free-list ( - ) 0 vadr-config #free-list ! ! 0 for-all-records-from# free-list-check ; ! : delete-record ( n - ) dup true swap n>record dup>r RecordDef Deleted- c! 0 r> RecordDef Excluded- c! --- 212,219 ---- : build-free-list ( - ) 0 vadr-config #free-list ! ! for-all-records free-list-check ; ! : delete-record ( n - ) dup true swap n>record dup>r RecordDef Deleted- c! 0 r> RecordDef Excluded- c! *************** *** 236,240 **** : delete-collection ( - flag ) s" Deleting the collection." WarningBox dup ! if 0 for-all-records-from# delete-record-in-collection then ; --- 256,260 ---- : delete-collection ( - flag ) s" Deleting the collection." WarningBox dup ! if for-all-records delete-record-in-collection then ; *************** *** 249,253 **** --- 269,279 ---- dup>r not-deleted? if cr r@ . + r@ RecordDef DriveType c@ . + r@ RecordDef MediaLabel r@ RecordDef Cnt_MediaLabel c@ type-space r@ RecordDef File_name r@ Cnt_File_name c@ type-space + cr 3 spaces + r@ RecordDef Artist r@ Cnt_Artist c@ type-space + r@ RecordDef Title r@ Cnt_Title c@ type-space + r@ RecordDef #played ? r@ RecordDef RandomLevel ? *************** *** 259,267 **** ; : record-not-played ( n - ) n>record 0 swap RecordDef Played- c! ; ! : set-all-not-played ( - ) 0 for-all-records-from# record-not-played ; : list-record ( n - ) n>record _list-record ; ! : list-records ( - ) 0 for-all-records-from# list-record cr ; : list-database ( - ) map-database list-records unmap-database ; --- 285,294 ---- ; + : record-not-played ( n - ) n>record 0 swap RecordDef Played- c! ; ! : set-all-not-played ( - ) for-all-records record-not-played ; : list-record ( n - ) n>record _list-record ; ! : list-records ( - ) for-all-records list-record cr ; : list-database ( - ) map-database list-records unmap-database ; *************** *** 281,285 **** : random-shuffle ( - ) ! vadr-config MaximumRandomLevel @ 0 for-all-records-from# change-randomlevel drop sort_by_RandomLevel ; --- 308,312 ---- : random-shuffle ( - ) ! vadr-config MaximumRandomLevel @ for-all-records change-randomlevel drop sort_by_RandomLevel ; *************** *** 290,293 **** --- 317,322 ---- internal + 0 value /VolumeNameBuffer + : add.dir->file-size ( -- file-size ) _win32-find-data @ FILE_ATTRIBUTE_DIRECTORY and *************** *** 296,307 **** then ; - : (add-file) ( wHndl addr len file-size - wHndl ) \ add a file to the catalog InlineRecord [ sizeof RecordDef ] literal erase ! struct, InlineRecord RecordDef FileSize ! ! >r ! struct, InlineRecord RecordDef File_name r@ cmove ! r@ struct, InlineRecord RecordDef Cnt_File_name c! ! 100 random struct, InlineRecord RecordDef RandomLevel ! r>drop dup write-record --- 325,348 ---- then ; : (add-file) ( wHndl addr len file-size - wHndl ) \ add a file to the catalog InlineRecord [ sizeof RecordDef ] literal erase ! struct, InlineRecord RecordDef FileSize ! ! ! >r dup r@ + r@ ascii \ -scan 2dup r@ swap - swap 1+ dup rot \ adr Title ! dup>r ascii . scan nip r> swap - dup \ count artist ! struct, InlineRecord RecordDef Cnt_Title c! ! struct, InlineRecord RecordDef Title swap cmove \ move Title ! swap 1- dup rot ascii \ -scan drop 2dup - swap 1+ over ! struct, InlineRecord RecordDef Cnt_Artist c! ! struct, InlineRecord RecordDef Artist rot cmove ! drop ! struct, InlineRecord RecordDef File_name r@ cmove ! ! r@ struct, InlineRecord RecordDef Cnt_File_name c! ! 100 random struct, InlineRecord RecordDef RandomLevel ! ! VolumeNameBuffer struct, InlineRecord RecordDef MediaLabel ! /VolumeNameBuffer /MediaLabel min cmove ! /VolumeNameBuffer struct, InlineRecord RecordDef Cnt_MediaLabel c! ! _DriveType struct, InlineRecord RecordDef DriveType c! r>drop dup write-record *************** *** 405,414 **** s" artist*album " init-dlg Start: searchDlg >r pad$_ok? over and r> 0> and ! if 0 for-all-records-from# search-record 2drop RefreshCatalog else 2drop then ; ! create tmp$ maxstring allot : n>tmp$ ( n - ) 0 (d.) tmp$ place ; --- 446,455 ---- s" artist*album " init-dlg Start: searchDlg >r pad$_ok? over and r> 0> and ! if for-all-records search-record 2drop RefreshCatalog else 2drop then ; ! string: tmp$ : n>tmp$ ( n - ) 0 (d.) tmp$ place ; *************** *** 425,428 **** ; - \s - |
|
From: Jos v.d.V. <jo...@us...> - 2005-10-15 18:13:18
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv16955/src/lib Modified Files: multiopen.f Log Message: Jos: Changed the buffersize back to 2048. Index: multiopen.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/multiopen.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** multiopen.f 9 Oct 2005 19:55:49 -0000 1.4 --- multiopen.f 15 Oct 2005 18:13:10 -0000 1.5 *************** *** 8,12 **** \- ofn-struct create ofn-struct 19 cells , 22 CELLS allot \ OPENFILENAME struct ! 262144 constant /szFile \ Was 2048 #ifndef fdlg-filter --- 8,12 ---- \- ofn-struct create ofn-struct 19 cells , 22 CELLS allot \ OPENFILENAME struct ! 2048 constant /szFile \ Was 2048 #ifndef fdlg-filter |
|
From: Jos v.d.V. <jo...@us...> - 2005-10-14 17:33:11
|
Update of /cvsroot/win32forth/win32forth/apps/Setup In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1204/apps/Setup Modified Files: dtop_lnk.f Log Message: Jos: Adapted for the new string: Note: My toolset has still an old string: some adjustments are still needed. Index: dtop_lnk.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Setup/dtop_lnk.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** dtop_lnk.f 5 May 2005 09:43:27 -0000 1.2 --- dtop_lnk.f 14 Oct 2005 17:33:03 -0000 1.3 *************** *** 33,45 **** ; immediate - \ Format string: [count-allocated count-string string 0] The "0" is not counted - : string: ( compile-time: len - ) ( run-time: - adr-counted-string ) - create th fc over < \ max 252 char - abort" String out off range ! " \ map: - here swap 3 + dup allot swap c! \ max-char. counted string - does> 1+ ; - - 250 constant /tmp /tmp string: tmp$ - : c>unicode! ( dest char - dest+2 ) over w! 2 chars + ; --- 33,36 ---- *************** *** 62,65 **** --- 53,58 ---- [THEN] + string: tmp$ + [UNDEFINED] zCount [IF] : zCount ( a1 -- a2 len ) *************** *** 177,179 **** [then] ! |
|
From: Jos v.d.V. <jo...@us...> - 2005-10-12 22:37:52
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2309/src Modified Files: Primutil.f Log Message: Jos: Removed the does> part Index: Primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** Primutil.f 12 Oct 2005 15:52:29 -0000 1.11 --- Primutil.f 12 Oct 2005 22:37:44 -0000 1.12 *************** *** 747,752 **** : STRING: \ Allocates strings ! CREATE MAXSTRING ALLOT \ Compiletime: ( -< name >- ) ! DOES> \ Runtime: ( - addr$ ) ; --- 747,751 ---- : STRING: \ Allocates strings ! CREATE MAXSTRING ALLOT \ Compiletime: ( -< name >- ) Runtime: ( - addr$ ) ; |
|
From: Jos v.d.V. <jo...@us...> - 2005-10-12 15:52:39
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19483/src Modified Files: Primutil.f Log Message: Jos: Added string: and erase$. They are often used in various sources. Now they can be easier used. Index: Primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** Primutil.f 29 Aug 2005 15:56:27 -0000 1.10 --- Primutil.f 12 Oct 2005 15:52:29 -0000 1.11 *************** *** 97,102 **** MAXSTRING newuser z-buf ! : asciiz ( addr len -- buff-z ) ! z-buf ascii-z ; : +z," ( -<text">- ) --- 97,102 ---- MAXSTRING newuser z-buf ! : asciiz ( addr len -- buff-z ) ! z-buf ascii-z ; : +z," ( -<text">- ) *************** *** 524,528 **** LCOUNT BASE ! EXECUTE \ run headerless definition R> BASE ! ; ! in-application --- 524,528 ---- LCOUNT BASE ! EXECUTE \ run headerless definition R> BASE ! ; ! in-application *************** *** 688,704 **** : NT? ( -- fl ) \ Retained for compatability -- deprecated WinVer 4 >= ; \ NT3.51 or above ! DEPRECATED : Win95? ( -- f1 ) \ Retained for compatability -- deprecated winver 1 = ; ! DEPRECATED : Win98? ( -- f1 ) \ Retained for compatability -- deprecated winver 2 3 between ; ! DEPRECATED : Win32s? ( -- f1 ) \ Retained for compatability -- deprecated false ; \ no longer supported ! DEPRECATED \ -------------------- Load Standard Libraries -------------------- --- 688,704 ---- : NT? ( -- fl ) \ Retained for compatability -- deprecated WinVer 4 >= ; \ NT3.51 or above ! DEPRECATED : Win95? ( -- f1 ) \ Retained for compatability -- deprecated winver 1 = ; ! DEPRECATED : Win98? ( -- f1 ) \ Retained for compatability -- deprecated winver 2 3 between ; ! DEPRECATED : Win32s? ( -- f1 ) \ Retained for compatability -- deprecated false ; \ no longer supported ! DEPRECATED \ -------------------- Load Standard Libraries -------------------- *************** *** 741,744 **** --- 741,757 ---- in-application + + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + \ Often used + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + + : STRING: \ Allocates strings + CREATE MAXSTRING ALLOT \ Compiletime: ( -< name >- ) + DOES> \ Runtime: ( - addr$ ) + ; + + : ERASE$ ( adr - ) MAXSTRING ERASE ; + + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ LONG counted string support *************** *** 778,781 **** --- 791,795 ---- LCOUNT + 0 SWAP C! ; + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Some case insensitive version of search and compare *************** *** 860,862 **** defer (dialogunlock) ' noop is (dialogunlock) ! --- 874,876 ---- defer (dialogunlock) ' noop is (dialogunlock) ! \s |
|
From: Rod O. <rod...@us...> - 2005-10-10 22:26:18
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12877/src/lib Modified Files: RESOURCES.F Log Message: Rod: made external - SourceFile - needed for copying resources Index: RESOURCES.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/RESOURCES.F,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** RESOURCES.F 7 Aug 2005 09:34:57 -0000 1.5 --- RESOURCES.F 10 Oct 2005 22:26:20 -0000 1.6 *************** *** 200,209 **** : CloseSourceFile ( -- ) hExe call FreeLibrary drop 0 to hExe ; : SourceFile ( s" Filename" -- ) 2dup SourceFileName place asciiz call LoadLibrary to hExe hExe 0= IF SourceFileName SourceFileError abort THEN ; - external - : ListResources ( s" Filename" -- ) SourceFile --- 200,209 ---- : CloseSourceFile ( -- ) hExe call FreeLibrary drop 0 to hExe ; + external + : SourceFile ( s" Filename" -- ) 2dup SourceFileName place asciiz call LoadLibrary to hExe hExe 0= IF SourceFileName SourceFileError abort THEN ; : ListResources ( s" Filename" -- ) SourceFile |
|
From: Jos v.d.V. <jo...@us...> - 2005-10-09 19:55:55
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7067/src/lib Modified Files: multiopen.f Log Message: Jos: Increased /szFile again Index: multiopen.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/multiopen.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** multiopen.f 1 Oct 2005 16:57:26 -0000 1.3 --- multiopen.f 9 Oct 2005 19:55:49 -0000 1.4 *************** *** 8,12 **** \- ofn-struct create ofn-struct 19 cells , 22 CELLS allot \ OPENFILENAME struct ! 12048 constant /szFile \ Was 2048 #ifndef fdlg-filter --- 8,12 ---- \- ofn-struct create ofn-struct 19 cells , 22 CELLS allot \ OPENFILENAME struct ! 262144 constant /szFile \ Was 2048 #ifndef fdlg-filter |
|
From: Jos v.d.V. <jo...@us...> - 2005-10-09 16:33:39
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23074/apps/Player4 Modified Files: Catalog.f Mediatree.f PLAYER4.F Pl_MciWindow.f Pl_Version.f Log Message: Jos: Enabled a fileselector to add files into de catalog. Index: PLAYER4.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v retrieving revision 1.22 retrieving revision 1.23 diff -C2 -d -r1.22 -r1.23 *** PLAYER4.F 1 Oct 2005 12:57:38 -0000 1.22 --- PLAYER4.F 9 Oct 2005 16:33:07 -0000 1.23 *************** *** 48,51 **** --- 48,52 ---- needs Player4.frm needs Resources.f + needs multiopen.f \ ----------------------------------------------------------------------------- *************** *** 78,81 **** --- 79,83 ---- MENUITEM "&Exit\tAlt+F4" 'Q' +k_control pushkey ; POPUP "&Catalog" + MENUITEM "&Add file(s)...\tCtrl+M" 'M' +k_control pushkey ; MENUITEM "&Import directory tree...\tCtrl+I" 'I' +k_control pushkey ; MENUITEM "S&earch and make a collection..." SearchCatalog ; *************** *** 216,219 **** --- 218,222 ---- position-windows ;M + :M On_Init: ( -- ) On_Init: super *************** *** 221,225 **** ['] on_clicked to click-func ['] on_unclicked to unclick-func ! GetHandle: Self SetParent: ControlCenter catalog-exist? --- 224,228 ---- ['] on_clicked to click-func ['] on_unclicked to unclick-func ! InitFileNames GetHandle: Self SetParent: ControlCenter catalog-exist? *************** *** 492,496 **** 'R' +k_control of beep catalog-exist? if play-catalog-random: Player4W then endof ! 'I' +k_control of Import-to-catalog: Player4W RefreshCatalog endof \ 'C' +k_control of PlayAudioCD: Player4W endof \ doesn't work on my system (dbu) endcase --- 495,500 ---- 'R' +k_control of beep catalog-exist? if play-catalog-random: Player4W then endof ! 'M' +k_control of AddFilesFromSelector: Player4W endof ! 'I' +k_control of Import-to-catalog: Player4W RefreshCatalog endof \ 'C' +k_control of PlayAudioCD: Player4W endof \ doesn't work on my system (dbu) endcase Index: Pl_MciWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Pl_MciWindow.f,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** Pl_MciWindow.f 26 May 2005 08:29:29 -0000 1.9 --- Pl_MciWindow.f 9 Oct 2005 16:33:07 -0000 1.10 *************** *** 14,17 **** --- 14,18 ---- needs MCIWnd.f + internal external *************** *** 25,29 **** :M ExWindowStyle: ( -- style ) ! ExWindowStyle: Super [ WS_EX_CLIENTEDGE WS_EX_TRANSPARENT or ] literal or ;M --- 26,30 ---- :M ExWindowStyle: ( -- style ) ! ExWindowStyle: Super [ WS_EX_CLIENTEDGE WS_EX_TRANSPARENT or ] literal or ;M *************** *** 33,36 **** --- 34,39 ---- ;Object + MultiFileOpenDialog GetFilesDialog "Select File" "Media Files (*.mp3,*.midi,*.mid,*.wav,*.mpeg,*.mpg,*.mp2,*.mp4,*.mpa,*.wma,*.wmv,*.avi,*.dat)|*.mp3;*.midi;*.mid;*.wav;*.mpeg;*.mpg;*.mp2;*.mp4;*.mpa;*.wma;*.wmv;*.avi;*.dat|" + \ ----------------------------------------------------------------------------- \ define the child window for the right part of the main window *************** *** 215,225 **** \ ----------------------------------------------------------------------------- :M play-catalog-random: ( -- ) ! AbortPlaying: self false to catalog-aborted? ! ! begin PLAYER catalog-aborted? if exitm then ! Playing?: Self not if next-not-played dup -1 = ! if cr cr ." All done. Reset randomlevel and shuffle..." set-all-not-played random-shuffle else cr 2 spaces dup . 2 spaces n>record dup>r --- 218,227 ---- \ ----------------------------------------------------------------------------- :M play-catalog-random: ( -- ) ! database-mhndl #records-in-database vadr-config #free-list @ - 0> ! if AbortPlaying: self false to catalog-aborted? ! begin PLAYER catalog-aborted? if exitm then Playing?: Self not if next-not-played dup -1 = ! if cr cr ." All done. Reset randomlevel and shuffle..." set-all-not-played random-shuffle else cr 2 spaces dup . 2 spaces n>record dup>r *************** *** 230,234 **** then then ! again ;M : add-to-catalog ( -- ) \ Delete the *.dat files to start a new catalog --- 232,238 ---- then then ! again ! then ! ;M : add-to-catalog ( -- ) \ Delete the *.dat files to start a new catalog *************** *** 236,245 **** config-mhndl map-hndl>vadr PathMediaFiles dup +null GetHandle: Self BrowseForFolder ! If \ PathMediaFiles count ! \ DatFile$ count r/w create-file abort" Can't create dat-file" ! \ dup>r write-file abort" Can't save path to media folder" ! \ crlf$ count r@ write-file throw ! \ r> close-file throw ! else true abort" No media folder selected" then ; --- 240,244 ---- config-mhndl map-hndl>vadr PathMediaFiles dup +null GetHandle: Self BrowseForFolder ! If add_dir_tree then ; *************** *** 248,252 **** check-config add-to-catalog ! add_dir_tree ;M --- 247,261 ---- check-config add-to-catalog ! ;M ! ! :M AddFilesFromSelector: ( - ) \ add one or more files ! OpenAppendDatabase ! GetHandle: self Start: GetFilesDialog count nip 0> ! if #SelectedFiles: GetFilesDialog 0 ! do dup i GetFile: GetFilesDialog AddFile ! loop ! then ! CloseReMap ! RefreshCatalog ;M *************** *** 332,334 **** module ! |
|
From: George H. <geo...@us...> - 2005-10-08 11:50:45
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4294/win32forth/src Modified Files: Dc.f Log Message: gah: optimised InvertRect: to not use locals (since the stack order is already correct) Index: Dc.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Dc.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** Dc.f 8 Oct 2005 08:14:50 -0000 1.7 --- Dc.f 8 Oct 2005 11:50:36 -0000 1.8 *************** *** 278,282 **** \ Samstag, Oktober 08 2005 dbu \ Added as suggested by Larry Daniel ! :M RoundRect: { left top right bottom width height } height width bottom right top left hDC Call RoundRect ?win-error ;M --- 278,282 ---- \ Samstag, Oktober 08 2005 dbu \ Added as suggested by Larry Daniel ! :M RoundRect: { left top right bottom width height -- } height width bottom right top left hDC Call RoundRect ?win-error ;M *************** *** 284,289 **** \ Samstag, Oktober 08 2005 dbu \ Added as suggested by Larry Daniel ! :M InvertRect: { left top right bottom } ! left top right bottom SetRect: FillRect Addrof: FillRect hDC Call InvertRect ?win-error ;M --- 284,289 ---- \ Samstag, Oktober 08 2005 dbu \ Added as suggested by Larry Daniel ! :M InvertRect: ( left top right bottom -- ) ! SetRect: FillRect Addrof: FillRect hDC Call InvertRect ?win-error ;M |
|
From: Dirk B. <db...@us...> - 2005-10-08 08:25:06
|
Update of /cvsroot/win32forth/win32forth/doc/ProMgr In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29171/doc/ProMgr Modified Files: ProjectManager.htm Log Message: Some cleanup Index: ProjectManager.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/ProMgr/ProjectManager.htm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** ProjectManager.htm 5 Sep 2005 19:58:34 -0000 1.2 --- ProjectManager.htm 8 Oct 2005 08:24:58 -0000 1.3 *************** *** 33,37 **** <p>Menu Functions:<br> ! <pre><b>File View Project Help</pre></b> <img src="prjFileMenu.gif" width="129" height="117" alt="" border="0" align="top"> <img src="prjViewMenu.gif" width="134" height="100" alt="" border="0" align="top"> --- 33,37 ---- <p>Menu Functions:<br> ! <pre><b>File View Project Help</b></pre> <img src="prjFileMenu.gif" width="129" height="117" alt="" border="0" align="top"> <img src="prjViewMenu.gif" width="134" height="100" alt="" border="0" align="top"> *************** *** 83,87 **** <p><a href="mailto:ezr...@ya...">Ezra Boyce</a> - <p><a href="http://www.evrsoft.com/1stpage/"><img src="http://www.evrsoft.com/1stpage/1st-now.gif" border="0" alt="Made with 1st Page 2000 - Professional tools for real minds."></a> </body> --- 83,86 ---- |
|
From: Dirk B. <db...@us...> - 2005-10-08 08:25:06
|
Update of /cvsroot/win32forth/win32forth/apps/SciEdit In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29171/apps/SciEdit Modified Files: EdStatusbar.f Log Message: Some cleanup Index: EdStatusbar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/EdStatusbar.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvs6DOn5F and /tmp/cvsmf90jZ differ |
|
From: Dirk B. <db...@us...> - 2005-10-08 08:24:30
|
Update of /cvsroot/win32forth/win32forth/apps/Sudoku In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29063/apps/Sudoku Modified Files: Sudoku.f SudokuStatusBar.f Log Message: Some changes to add Sudoku into the next relase Index: SudokuStatusBar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Sudoku/SudokuStatusBar.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** SudokuStatusBar.f 3 Oct 2005 22:04:27 -0000 1.1 --- SudokuStatusBar.f 8 Oct 2005 08:24:21 -0000 1.2 *************** *** 4,49 **** \- hStatusBar 0 value hStatusBar ! Warning off ! Needs StatusBarClass.f ! Warning on cr .( Loading Sudoku StatusBar...) - - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - \ \\\\\ Sudoku StatusBar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - - :Object SudokuStatusBar <Super StatusBar - - :M Start: ( parent -- ) - Start: super - 200 -1 2 SetParts: self - ;M - - :M WindowStyle: - [ WS_CHILD WS_CLIPSIBLINGS or ] literal \ not WS_VISIBLE - start hidden, no border - ;M - - ;Object - - - 0 value StatusBarHeight - - : ShowStatusBar ( -- ) GetWindowRect: SudokuStatusBar nip swap - nip to StatusBarHeight - SW_SHOW show: SudokuStatusBar true check: hStatusBar ; - : HideStatusBar ( -- ) 0 to StatusBarHeight - SW_HIDE show: SudokuStatusBar false check: hStatusBar ; - - - \s - \ ******** Using ExControls.f ******** - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Sudoku StatusBar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - Needs ExControls.f - :Object SudokuStatusBar <Super MultiStatusBar --- 4,15 ---- \- hStatusBar 0 value hStatusBar ! Needs ExControls.f cr .( Loading Sudoku StatusBar...) \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Sudoku StatusBar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ :Object SudokuStatusBar <Super MultiStatusBar *************** *** 61,69 **** create text$ 256 allot :M GetText: ( n -- szText ) \ get text in n'th part ! text$ swap SB_GETTEXT SendMessage:Self drop text$ ;M ! :M UpdatePart: ( text$ p -- ) >r ! dup count r@ GetText: self zcount compare IF count asciiz r> SetText: self --- 27,35 ---- create text$ 256 allot :M GetText: ( n -- szText ) \ get text in n'th part ! text$ swap SB_GETTEXT SendMessage:Self drop text$ ;M ! :M UpdatePart: ( text$ p -- ) >r ! dup count r@ GetText: self zcount compare IF count asciiz r> SetText: self Index: Sudoku.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Sudoku/Sudoku.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Sudoku.f 3 Oct 2005 22:04:27 -0000 1.1 --- Sudoku.f 8 Oct 2005 08:24:21 -0000 1.2 *************** *** 43,47 **** 0 value ShowElimination 0 value EditMode ! : PlayError ( -- ) AudibleWarning IF MB_ICONEXCLAMATION call MessageBeep drop THEN ; : PlayApplause ( -- ) ShowSolution ?exit --- 43,47 ---- 0 value ShowElimination 0 value EditMode ! : PlayError ( -- ) AudibleWarning IF MB_ICONEXCLAMATION call MessageBeep drop THEN ; : PlayApplause ( -- ) ShowSolution ?exit *************** *** 114,124 **** \ SetColours Create TempNumbers 81 allot ! : Start>Solution numbers 81 + numbers 81 move ; ! : Current>Solution numbers 162 + numbers 81 move ; ! : Solution>Current numbers numbers 162 + 81 move ; ! : Current>Temp numbers 162 + TempNumbers 81 move ; ! : Temp>Current TempNumbers numbers 162 + 81 move ; ! : Solution>Temp numbers TempNumbers 81 move ; ! : Temp>Solution TempNumbers numbers 81 move ; Create Eliminations 9 81 * allot : ns cr Numbers 81 type ; --- 114,124 ---- \ SetColours Create TempNumbers 81 allot ! : Start>Solution numbers 81 + numbers 81 move ; ! : Current>Solution numbers 162 + numbers 81 move ; ! : Solution>Current numbers numbers 162 + 81 move ; ! : Current>Temp numbers 162 + TempNumbers 81 move ; ! : Temp>Current TempNumbers numbers 162 + 81 move ; ! : Solution>Temp numbers TempNumbers 81 move ; ! : Temp>Solution TempNumbers numbers 81 move ; Create Eliminations 9 81 * allot : ns cr Numbers 81 type ; *************** *** 131,145 **** : GetLastMove ( -- n ) LastMove w@ 256 /mod 9 /mod to y to x ; : SetLastMove ( x y n -- ) -rot 9 * + 256 * + LastMove w! ; ! : NumberFixed ( -- n ) 0 81 0 DO Numbers 81 + i + c@ 49 58 within IF 1+ THEN LOOP ; : ShowMoves ( -- ) EditMode moves c@ 0= or IF s" Given numbers: " pad place NumberFixed ! ELSE s" Moves: " pad place Moves c@ THEN (.) pad +place pad 1 UpdatePart: SudokuStatusBar ; : StoreMove ( x y n -- ) Moves cincr SetLastMove ShowMoves ; : NoRedo ( -- ) 0 Moves 1+ c! ; : ZeroMoves ( -- ) 0 Moves w! ShowMoves ; ! : Solved? ( -- ) numbers 162 + 81 48 scan nip 0= \ no blanks? ! IF IDM_CHECK_ALL DoCommand error 0= ShowSolution 0= and IF IDM_STOP DoCommand THEN THEN ; : CellAddress ( x y -- a ) 9 * + Numbers + ; : GetNumber ( x y - n ) CellAddress 162 + c@ ; --- 131,145 ---- : GetLastMove ( -- n ) LastMove w@ 256 /mod 9 /mod to y to x ; : SetLastMove ( x y n -- ) -rot 9 * + 256 * + LastMove w! ; ! : NumberFixed ( -- n ) 0 81 0 DO Numbers 81 + i + c@ 49 58 within IF 1+ THEN LOOP ; : ShowMoves ( -- ) EditMode moves c@ 0= or IF s" Given numbers: " pad place NumberFixed ! ELSE s" Moves: " pad place Moves c@ THEN (.) pad +place pad 1 UpdatePart: SudokuStatusBar ; : StoreMove ( x y n -- ) Moves cincr SetLastMove ShowMoves ; : NoRedo ( -- ) 0 Moves 1+ c! ; : ZeroMoves ( -- ) 0 Moves w! ShowMoves ; ! : Solved? ( -- ) numbers 162 + 81 48 scan nip 0= \ no blanks? ! IF IDM_CHECK_ALL DoCommand error 0= ShowSolution 0= and IF IDM_STOP DoCommand THEN THEN ; : CellAddress ( x y -- a ) 9 * + Numbers + ; : GetNumber ( x y - n ) CellAddress 162 + c@ ; *************** *** 152,159 **** : SetColour ( x y c -- ) -rot CellAddress 243 + c! ; : WarningText ( x y ) true to error VisibleWarning ! IF 2dup GetColour 128 or SetColour c" Error in position" 1 UpdatePart: SudokuStatusBar ELSE 2drop ! THEN ; \ warning colour ! : RemoveWarningText ( x y ) 2dup GetColour 127 and SetColour ; \ normal text colour : RemoveWarnings ( -- ) 9 0 DO 9 0 DO i j RemoveWarningText LOOP LOOP ; --- 152,159 ---- : SetColour ( x y c -- ) -rot CellAddress 243 + c! ; : WarningText ( x y ) true to error VisibleWarning ! IF 2dup GetColour 128 or SetColour c" Error in position" 1 UpdatePart: SudokuStatusBar ELSE 2drop ! THEN ; \ warning colour ! : RemoveWarningText ( x y ) 2dup GetColour 127 and SetColour ; \ normal text colour : RemoveWarnings ( -- ) 9 0 DO 9 0 DO i j RemoveWarningText LOOP LOOP ; *************** *** 222,226 **** LOOP ; ! : Eliminated? ( n p - f ) swap 49 - 81 * + Eliminations + c@ ; : RemoveEliminations ( -- ) 9 0 DO 9 0 DO i j 2dup GetColour 64 invert and SetColour LOOP LOOP ; --- 222,226 ---- LOOP ; ! : Eliminated? ( n p - f ) swap 49 - 81 * + Eliminations + c@ ; : RemoveEliminations ( -- ) 9 0 DO 9 0 DO i j 2dup GetColour 64 invert and SetColour LOOP LOOP ; *************** *** 229,233 **** SetEliminations CurrentCursor ! IF 9 0 DO 9 0 DO CurrentCursor 48 + i j 9 * + Eliminated? i j GetNumber 48 = and --- 229,233 ---- SetEliminations CurrentCursor ! IF 9 0 DO 9 0 DO CurrentCursor 48 + i j 9 * + Eliminated? i j GetNumber 48 = and *************** *** 245,249 **** : Try ( n p -- f ) ! 2dup Eliminated? IF 2drop false exit THEN >r 0 \ position saved on return stack, number and flag kept on stack r@ 9 / 9 * numbers + 9 3 pick scan nip or dup IF r> 3drop false exit THEN \ check row, exit on error --- 245,249 ---- : Try ( n p -- f ) ! 2dup Eliminated? IF 2drop false exit THEN >r 0 \ position saved on return stack, number and flag kept on stack r@ 9 / 9 * numbers + 9 3 pick scan nip or dup IF r> 3drop false exit THEN \ check row, exit on error *************** *** 257,270 **** numbers 81 48 scan nip \ any more spaces? IF ! 81 0 DO \ check all 81 numbers for '0' ! i numbers + c@ 48 = ! IF \ space found ! 58 49 DO ! i j try \ try fitting numbers in... IF ! i j numbers + c! \ set number recurse IF ! FindNumber counter MaxToFind < and IF 1 +to counter 48 j numbers + c! \ ns ELSE unloop unloop true exit --- 257,270 ---- numbers 81 48 scan nip \ any more spaces? IF ! 81 0 DO \ check all 81 numbers for '0' ! i numbers + c@ 48 = ! IF \ space found ! 58 49 DO ! i j try \ try fitting numbers in... IF ! i j numbers + c! \ set number recurse IF ! FindNumber counter MaxToFind < and IF 1 +to counter 48 j numbers + c! \ ns ELSE unloop unloop true exit *************** *** 272,281 **** ELSE 48 j numbers + c! \ remove number THEN ! THEN ! LOOP ! false leave \ none of 1-9 fit, false trail.... ! THEN ! LOOP ! ELSE true \ no more spaces THEN ; --- 272,281 ---- ELSE 48 j numbers + c! \ remove number THEN ! THEN ! LOOP ! false leave \ none of 1-9 fit, false trail.... ! THEN ! LOOP ! ELSE true \ no more spaces THEN ; *************** *** 294,298 **** : ShowTime ( a n -- ) pad place ! time 1000 / 0 \ 60 /mod <# # 6 base ! # 10 base ! ':' hold #s #> pad +place s" m:s" pad +place --- 294,298 ---- : ShowTime ( a n -- ) pad place ! time 1000 / 0 \ 60 /mod <# # 6 base ! # 10 base ! ':' hold #s #> pad +place s" m:s" pad +place *************** *** 350,354 **** \ IF 3drop false to SaveFlag ( WriteErrorMessage ) \ file does not exist IF drop WriteErrorMessage false to SaveFlag \ file does not exist ! ELSE to FileHandle count CurrentFile place CurrentFile count "path-only" Directory place --- 350,354 ---- \ IF 3drop false to SaveFlag ( WriteErrorMessage ) \ file does not exist IF drop WriteErrorMessage false to SaveFlag \ file does not exist ! ELSE to FileHandle count CurrentFile place CurrentFile count "path-only" Directory place *************** *** 365,369 **** IF "to-pathend" ELSE drop s" Untitled" ! THEN pad +place s" ?" pad +place pad +NULL pad 1+ z" Sudoku" --- 365,369 ---- IF "to-pathend" ELSE drop s" Untitled" ! THEN pad +place s" ?" pad +place pad +NULL pad 1+ z" Sudoku" *************** *** 404,408 **** RecentFilesList s" File1" 10 1 DO ! 2dup + 1- i 48 + swap c! 2dup i GetRecentFile: RecentFiles count 2swap REG_SZ SetRegistryValue --- 404,408 ---- RecentFilesList s" File1" 10 1 DO ! 2dup + 1- i 48 + swap c! 2dup i GetRecentFile: RecentFiles count 2swap REG_SZ SetRegistryValue *************** *** 429,441 **** :Object Frame <Super Window ! Record: CHOOSEFONT ! int lSize ! int hOwner ! int hDC ! int lpLogFont ! int iPointSize ! int FontFlags int rgbColors ! 8 cells class-allot ;RecordSize: sizeof(CHOOSEFONT) --- 429,441 ---- :Object Frame <Super Window ! Record: CHOOSEFONT ! int lSize ! int hOwner ! int hDC ! int lpLogFont ! int iPointSize ! int FontFlags int rgbColors ! 8 cells class-allot ;RecordSize: sizeof(CHOOSEFONT) *************** *** 447,451 **** 64 bytes CustomColors ! Record: CHOOSECOLOR int lStructSize int hwndOwner --- 447,451 ---- 64 bytes CustomColors ! Record: CHOOSECOLOR int lStructSize int hwndOwner *************** *** 486,490 **** CC_RGBINIT CC_FULLOPEN or to Flags ;M ! :M WindowHasMenu: ( -- f ) true ;M --- 486,490 ---- CC_RGBINIT CC_FULLOPEN or to Flags ;M ! :M WindowHasMenu: ( -- f ) true ;M *************** *** 503,507 **** register-frame-window drop create-frame-window to hWnd ! WindowState SIZE_MAXIMIZED = IF SW_SHOWMAXIMIZED ELSE SW_SHOW THEN Show: self \ allow to start maximized when WindowState is SIZE_MAXIMIZED Update: self --- 503,507 ---- register-frame-window drop create-frame-window to hWnd ! WindowState SIZE_MAXIMIZED = IF SW_SHOWMAXIMIZED ELSE SW_SHOW THEN Show: self \ allow to start maximized when WindowState is SIZE_MAXIMIZED Update: self *************** *** 573,577 **** Options SaveSettings Sudoku SaveSettings ! SaveRecentFiles ZeroMenu: CurrentMenu SudokuAccelerators DisableAccelerators \ free the accelerator table --- 573,577 ---- Options SaveSettings Sudoku SaveSettings ! SaveRecentFiles ZeroMenu: CurrentMenu SudokuAccelerators DisableAccelerators \ free the accelerator table *************** *** 633,637 **** size x * 1 + 1+ LeftMargin + size y * 1 + 1+ TopMargin + ! 2dup size 1 - size 1 - d+ Color FillArea: mdc ;M --- 633,637 ---- size x * 1 + 1+ LeftMargin + size y * 1 + 1+ TopMargin + ! 2dup size 1 - size 1 - d+ Color FillArea: mdc ;M *************** *** 639,643 **** :M PlaceText: ( -- ) 9 0 DO ! 9 0 DO i j GetColour dup dup 63 and --- 639,643 ---- :M PlaceText: ( -- ) 9 0 DO ! 9 0 DO i j GetColour dup dup 63 and *************** *** 652,658 **** Case 0 of FixedColor Endof ! 1 of TextColor1 EndOf ! 2 of TextColor2 EndOf ! 4 of TextColor3 EndOf 8 of TextColor4 EndOf ( default ) TextColor1 swap --- 652,658 ---- Case 0 of FixedColor Endof ! 1 of TextColor1 EndOf ! 2 of TextColor2 EndOf ! 4 of TextColor3 EndOf 8 of TextColor4 EndOf ( default ) TextColor1 swap *************** *** 660,664 **** THEN SetTextColor: mdc ! size i * 1 + LeftMargin + size j * 1 + TopMargin + 2dup size 1+ size 1+ D+ SetRect: TempRect --- 660,664 ---- THEN SetTextColor: mdc ! size i * 1 + LeftMargin + size j * 1 + TopMargin + 2dup size 1+ size 1+ D+ SetRect: TempRect *************** *** 680,684 **** :M On_Paint: ( -- ) \ SaveDC: dc ! SRCCOPY 0 0 GetHandle: mdc Width Height StatusBarHeight - ToolbarHeight - 0 ToolbarHeight BitBlt: dc --- 680,684 ---- :M On_Paint: ( -- ) \ SaveDC: dc ! SRCCOPY 0 0 GetHandle: mdc Width Height StatusBarHeight - ToolbarHeight - 0 ToolbarHeight BitBlt: dc *************** *** 690,697 **** :M WM_CLOSE ( h m w l -- res ) SaveIfModified ! IF CurrentFile Insert: RecentFiles WM_CLOSE WM: Super \ close window ! ELSE 0 \ abandon the close THEN ;M --- 690,697 ---- :M WM_CLOSE ( h m w l -- res ) SaveIfModified ! IF CurrentFile Insert: RecentFiles WM_CLOSE WM: Super \ close window ! ELSE 0 \ abandon the close THEN ;M *************** *** 706,710 **** CurrentCursor 142 + AppInst call LoadCursor dup ShowNumber and IF call SetCursor drop true ELSE drop false THEN ; ! :M SelectCursor: ( n -- ) to CurrentCursor --- 706,710 ---- CurrentCursor 142 + AppInst call LoadCursor dup ShowNumber and IF call SetCursor drop true ELSE drop false THEN ; ! :M SelectCursor: ( n -- ) to CurrentCursor *************** *** 718,722 **** IF CurrentCursor 9 + 10 mod dup CheckNumber SelectCursor: self THEN ; ! :M WM_MOUSEWHEEL ( h m w l -- res ) over word-split 32768 and \ get the Key flags (loword of wParam) and the WHEEL_DELTA (hiword of wParam) \ A positive value indicates that the wheel was rotated forward, away --- 718,722 ---- IF CurrentCursor 9 + 10 mod dup CheckNumber SelectCursor: self THEN ; ! :M WM_MOUSEWHEEL ( h m w l -- res ) over word-split 32768 and \ get the Key flags (loword of wParam) and the WHEEL_DELTA (hiword of wParam) \ A positive value indicates that the wheel was rotated forward, away *************** *** 822,826 **** 0 ;M ! :M WM_SYSCOMMAND ( h m w l -- res ) \ determine whether Frame is being Maximized or Restored over 0xFFF0 and dup SC_MAXIMIZE = to Maximizing --- 822,826 ---- 0 ;M ! :M WM_SYSCOMMAND ( h m w l -- res ) \ determine whether Frame is being Maximized or Restored over 0xFFF0 and dup SC_MAXIMIZE = to Maximizing *************** *** 854,858 **** IDYES = IF IDM_RESTART DoCommand ELSE InitGame THEN THEN ; ! : New ( -- ) SaveIfModified 0= ?exit 0 to x 0 to y BlankAll Redraw: Frame CurrentFile Insert: RecentFiles --- 854,858 ---- IDYES = IF IDM_RESTART DoCommand ELSE InitGame THEN THEN ; ! : New ( -- ) SaveIfModified 0= ?exit 0 to x 0 to y BlankAll Redraw: Frame CurrentFile Insert: RecentFiles *************** *** 867,871 **** CurrentFile count OpenDialog place Frame @ Start: OpenDialog dup c@ ?OpenFile ; IDM_OPEN SetCommand ! : SaveAs ( -- ) CurrentFile count 2dup SaveDialog place PreviousFile place Frame @ Start: SaveDialog dup c@ --- 867,871 ---- CurrentFile count OpenDialog place Frame @ Start: OpenDialog dup c@ ?OpenFile ; IDM_OPEN SetCommand ! : SaveAs ( -- ) CurrentFile count 2dup SaveDialog place PreviousFile place Frame @ Start: SaveDialog dup c@ *************** *** 873,877 **** ELSE drop false to SaveFlag THEN ; IDM_SAVE_AS SetCommand ! : Save ( -- ) CurrentFile c@ IF CurrentFile SaveFile ELSE SaveAs THEN ; IDM_SAVE SetCommand : ImportGame ( -- ) SaveIfModified 0= ?exit --- 873,877 ---- ELSE drop false to SaveFlag THEN ; IDM_SAVE_AS SetCommand ! : Save ( -- ) CurrentFile c@ IF CurrentFile SaveFile ELSE SaveAs THEN ; IDM_SAVE SetCommand : ImportGame ( -- ) SaveIfModified 0= ?exit *************** *** 931,937 **** : ToggleEdit ( -- ) EditMode IF FinishEdit ELSE StartEdit THEN ; IDM_TOGGLE_EDIT SetCommand : UndoMove ( -- ) ! Moves c@ IF ! GetLastMove Moves cdecr PutNumber check redraw: frame --- 931,937 ---- : ToggleEdit ( -- ) EditMode IF FinishEdit ELSE StartEdit THEN ; IDM_TOGGLE_EDIT SetCommand : UndoMove ( -- ) ! Moves c@ IF ! GetLastMove Moves cdecr PutNumber check redraw: frame *************** *** 944,948 **** IF Moves cincr ! GetLastMove Moves cdecr PutNumber check redraw: frame --- 944,948 ---- IF Moves cincr ! GetLastMove Moves cdecr PutNumber check redraw: frame *************** *** 962,970 **** true to RemoveWarning to AudibleWarning to VisibleWarning ! error IF c" Error in current position" 1 UpdatePart: SudokuStatusBar false THEN ; IDM_CHECK_ALL SetCommand : SolveCurrentPosition ( -- f ) \ true on success CheckAll error 0= ! IF Current>solution SetEliminations --- 962,970 ---- true to RemoveWarning to AudibleWarning to VisibleWarning ! error IF c" Error in current position" 1 UpdatePart: SudokuStatusBar false THEN ; IDM_CHECK_ALL SetCommand : SolveCurrentPosition ( -- f ) \ true on success CheckAll error 0= ! IF Current>solution SetEliminations *************** *** 975,979 **** THEN THEN ; ! : Hint ( -- ) SolutionNeeded? IF SolveCurrentPosition ELSE true THEN IF x y CellAddress c@ PutNumber NextSpace Redraw: Frame THEN ; IDM_HINT SetCommand : SeeSolution ( -- ) \ toggle --- 975,979 ---- THEN THEN ; ! : Hint ( -- ) SolutionNeeded? IF SolveCurrentPosition ELSE true THEN IF x y CellAddress c@ PutNumber NextSpace Redraw: Frame THEN ; IDM_HINT SetCommand : SeeSolution ( -- ) \ toggle *************** *** 1013,1018 **** : ShowEliminations ( -- ) \ toggle ShowElimination ! IF RemoveEliminations false false ! ELSE eliminate true true THEN to ShowElimination Check: hEliminate redraw: frame ; IDM_ELIMINATION SetCommand --- 1013,1018 ---- : ShowEliminations ( -- ) \ toggle ShowElimination ! IF RemoveEliminations false false ! ELSE eliminate true true THEN to ShowElimination Check: hEliminate redraw: frame ; IDM_ELIMINATION SetCommand *************** *** 1033,1041 **** \ Miscellaneous : Left ( -- ) BlankWrongNumber ! DecreaseX RemoveWarnings check Redraw: Frame ; IDM_LEFT SetCommand : Right ( -- ) BlankWrongNumber ! IncreaseX RemoveWarnings check Redraw: Frame ; IDM_RIGHT SetCommand : Up ( -- ) BlankWrongNumber ! DecreaseY RemoveWarnings check Redraw: Frame ; IDM_UP SetCommand : Down ( -- ) BlankWrongNumber IncreaseY RemoveWarnings check Redraw: Frame ; IDM_DOWN SetCommand --- 1033,1041 ---- \ Miscellaneous : Left ( -- ) BlankWrongNumber ! DecreaseX RemoveWarnings check Redraw: Frame ; IDM_LEFT SetCommand : Right ( -- ) BlankWrongNumber ! IncreaseX RemoveWarnings check Redraw: Frame ; IDM_RIGHT SetCommand : Up ( -- ) BlankWrongNumber ! DecreaseY RemoveWarnings check Redraw: Frame ; IDM_UP SetCommand : Down ( -- ) BlankWrongNumber IncreaseY RemoveWarnings check Redraw: Frame ; IDM_DOWN SetCommand *************** *** 1051,1055 **** : Select9 ( -- ) 9 select ; IDM_SELECT_9 SetCommand : SelectBlank ( -- ) 0 select ; IDM_SELECT_BLANK SetCommand ! : KeyDown ( n -- ) dup select 48 + PutNumber check Redraw: Frame Solved? NoRedo ; : Key1 ( -- ) 1 KeyDown ; IDM_KEY_1 SetCommand : Key2 ( -- ) 2 KeyDown ; IDM_KEY_2 SetCommand --- 1051,1055 ---- : Select9 ( -- ) 9 select ; IDM_SELECT_9 SetCommand : SelectBlank ( -- ) 0 select ; IDM_SELECT_BLANK SetCommand ! : KeyDown ( n -- ) dup select 48 + PutNumber check Redraw: Frame Solved? NoRedo ; : Key1 ( -- ) 1 KeyDown ; IDM_KEY_1 SetCommand : Key2 ( -- ) 2 KeyDown ; IDM_KEY_2 SetCommand *************** *** 1149,1153 **** FCONTROL 'I' IDM_IMPORT AccelEntry ! \ View menu FCONTROL '1' IDM_SIZE_1 AccelEntry FCONTROL '2' IDM_SIZE_2 AccelEntry --- 1149,1153 ---- FCONTROL 'I' IDM_IMPORT AccelEntry ! \ View menu FCONTROL '1' IDM_SIZE_1 AccelEntry FCONTROL '2' IDM_SIZE_2 AccelEntry *************** *** 1203,1207 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ Opening files from the command line \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 1203,1207 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ Opening files from the command line \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 1280,1304 **** ; - (( - : da SudokuAccelerators DisableAccelerators ; - - \ Su - \ \s - cr .( Save Sudoku.exe [Y/N]: ) key dup emit dup 121 = swap 89 = or nostack - [IF] - )) - [defined] VIMAGE [if] also VIMAGE [then] [defined] CONSOLE-DLL? [if] false to CONSOLE-DLL? [then] ! ' Su turnkey Sudoku.exe needs SudokuResources ! cr .( Do you want to associate .sku files with Sudoku.exe [Y/N]: ) key dup emit dup 121 = swap 89 = or nostack ! [IF] ! Needs FileAssociations ! s" .sku" s" Sudoku File" s" Sudoku.exe" SetAssociation ! [THEN] ! 2 pause-seconds bye ! (( ! [ELSE] Su ! [THEN] ! )) \ No newline at end of file --- 1280,1292 ---- ; [defined] VIMAGE [if] also VIMAGE [then] [defined] CONSOLE-DLL? [if] false to CONSOLE-DLL? [then] ! ' Su turnkey Sudoku.exe needs SudokuResources ! \ cr .( Do you want to associate .sku files with Sudoku.exe [Y/N]: ) key dup emit dup 121 = swap 89 = or nostack ! \ [IF] ! \ Needs FileAssociations ! \ s" .sku" s" Sudoku File" s" Sudoku.exe" SetAssociation ! \ [THEN] ! 1 pause-seconds bye ! |
|
From: Dirk B. <db...@us...> - 2005-10-08 08:24:29
|
Update of /cvsroot/win32forth/win32forth In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29063 Modified Files: setup.exe Log Message: Some changes to add Sudoku into the next relase Index: setup.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth/setup.exe,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 Binary files /tmp/cvs9dpIZ6 and /tmp/cvs58PBEE differ |
|
From: Dirk B. <db...@us...> - 2005-10-08 08:24:29
|
Update of /cvsroot/win32forth/win32forth/apps/Setup In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29063/apps/Setup Modified Files: Setup.f Log Message: Some changes to add Sudoku into the next relase Index: Setup.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Setup/Setup.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** Setup.f 17 Sep 2005 07:01:24 -0000 1.7 --- Setup.f 8 Oct 2005 08:24:21 -0000 1.8 *************** *** 125,129 **** ." P Rebuild Project Manager." cr cr ." S Rebuild SciEdit." cr cr ! ." A Rebuild sample applications (Player4, Solipon2 and PlayVirginRadio)" cr cr ." D Copy Win32Forth dll files (w32fConsole.dll, w32fScintilla.dll," cr ." wincon.dll and Zip32.dll) into the Windows system folder:" cr --- 125,130 ---- ." P Rebuild Project Manager." cr cr ." S Rebuild SciEdit." cr cr ! ." A Rebuild sample applications (Player4, Solipon2, Sudoku and" cr ! ." PlayVirginRadio)" cr cr ." D Copy Win32Forth dll files (w32fConsole.dll, w32fScintilla.dll," cr ." wincon.dll and Zip32.dll) into the Windows system folder:" cr *************** *** 277,280 **** --- 278,283 ---- c" WIN32FOR.EXE fload apps\Solipon2\SOLIPION.F bye" procexec c" SOLIPION.EXE" filecheck + c" WIN32FOR.EXE fload apps\Sudoku\Sudoku.F bye" procexec + c" Sudoku.EXE" filecheck c" WIN32FOR.EXE fload apps\PlayVirginRadio\PlayVirginRadio.F bye" procexec c" PlayVirginRadio.EXE" filecheck |
|
From: Dirk B. <db...@us...> - 2005-10-08 08:24:29
|
Update of /cvsroot/win32forth/win32forth/doc In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv29063/doc Modified Files: p-relnotes.6.12.htm Log Message: Some changes to add Sudoku into the next relase Index: p-relnotes.6.12.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/p-relnotes.6.12.htm,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** p-relnotes.6.12.htm 18 Sep 2005 11:10:31 -0000 1.5 --- p-relnotes.6.12.htm 8 Oct 2005 08:24:21 -0000 1.6 *************** *** 93,96 **** --- 93,97 ---- <li><a href="../PlayVirginRadio.exe">PlayVirginRadio (Play "Virgin Radio" from the internet)</a></li> <li><a href="../solipion.exe">Solipion (Classic Morpion Solitaire Like Game)</a></li> + <li><a href="../sudoku.exe">Sudoku (Classic Sudoku Game)</a></li> </ul> |
|
From: Dirk B. <db...@us...> - 2005-10-08 08:14:58
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27758/src Modified Files: Dc.f Log Message: Added RoundRect: and InvertRect as suggested by Larry Daniel Index: Dc.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Dc.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** Dc.f 2 Oct 2005 07:25:36 -0000 1.6 --- Dc.f 8 Oct 2005 08:14:50 -0000 1.7 *************** *** 276,279 **** --- 276,292 ---- 0 0 0 0 Arc: self ;M + \ Samstag, Oktober 08 2005 dbu + \ Added as suggested by Larry Daniel + :M RoundRect: { left top right bottom width height } + height width bottom right top left hDC Call RoundRect ?win-error + ;M + + \ Samstag, Oktober 08 2005 dbu + \ Added as suggested by Larry Daniel + :M InvertRect: { left top right bottom } + left top right bottom SetRect: FillRect + Addrof: FillRect hDC Call InvertRect ?win-error + ;M + :M CreateCompatibleBitmap: ( width height -- hbitmap ) swap hdc |
|
From: Jos v.d.V. <jo...@us...> - 2005-10-05 15:54:55
|
Update of /cvsroot/win32forth/win32forth/apps/WinEd In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1902/apps/WinEd Modified Files: Ed_EditWindowObj.F Log Message: Adrew has removed same duplicated words in Ed_EditWindowObj.f HTML: and G: in line 354. Index: Ed_EditWindowObj.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/WinEd/Ed_EditWindowObj.F,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** Ed_EditWindowObj.F 28 Aug 2005 07:28:06 -0000 1.4 --- Ed_EditWindowObj.F 5 Oct 2005 15:54:39 -0000 1.5 *************** *** 352,357 **** new-chain &-chain ! : ?HTML-EXIT ( a1 n1 a2 n2 -- a3 n3 ) ! dup 3 pick > \ if looking for longer string than we have IF 2drop r>drop --- 352,357 ---- new-chain &-chain ! : (?htm-EXIT) ( a1 n1 a2 n2 -- a3 n3 ) ! dup 3 pick > \ if looking for longer string than we have IF 2drop r>drop *************** *** 364,370 **** THEN ; ! : HTML: ( "htmlstring" -- ) \ compile time ! ( a1 n1 -- a2 n2 ) \ runtime ! html-chain \ link into html-chain BEGIN dup @ WHILE @ --- 364,368 ---- THEN ; ! : StringHtml BEGIN dup @ WHILE @ *************** *** 372,400 **** docol , \ make a headerless def compile (s") ,"text" align \ compile in html command string ! compile ?HTML-EXIT \ compile in html test !csp ] ; \ define a headerless definition ! : ?&-EXIT ( a1 n1 a2 n2 -- a3 n3 ) ! dup 3 pick > \ if looking for longer string than we have ! IF 2drop ! r>drop ! EXIT ! THEN ! 2>r over 2r@ tuck compare 0= \ a2,n2 starts a1,n1? ! IF 2r> nip /string \ then remove n2 chars ! ELSE 2r> 2drop ! r>drop ! THEN ; : &: ( "&string" -- ) \ compile time ( a1 n1 -- a2 n2 ) \ runtime ! &-chain \ link into html-chain ! BEGIN dup @ ! WHILE @ ! REPEAT here swap ! 0 , here cell+ , ! docol , \ make a headerless def ! compile (s") ,"text" align \ compile in html command string ! compile ?&-EXIT \ compile in html test ! !csp ] ; \ define a headerless definition \ ISO 8859-1 characters set --- 370,386 ---- docol , \ make a headerless def compile (s") ,"text" align \ compile in html command string ! compile (?htm-EXIT) \ compile in html test !csp ] ; \ define a headerless definition ! : HTML: ( "htmlstring" -- ) \ compile time ! ( a1 n1 -- a2 n2 ) \ runtime ! html-chain \ link into html-chain ! StringHtml ; : &: ( "&string" -- ) \ compile time ( a1 n1 -- a2 n2 ) \ runtime ! &-chain \ link into &-chain ! StringHtml ; ! \ ISO 8859-1 characters set |
|
From: Jos v.d.V. <jo...@us...> - 2005-10-05 15:53:17
|
Update of /cvsroot/win32forth/win32forth In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1711 Modified Files: WinEdColorize.f WinEdColorize2.COL Log Message: Adrew has expanded colorizing words for ANS Floating Point words in WinEdColorize.f. WinEd now Knows hair to Colorize *.COL files and display them properly. So you can use Winedcolorize1.col for " Red" defined words while Winedcolorize2.col can be used for "Blue" defined words. Index: WinEdColorize.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/WinEdColorize.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** WinEdColorize.f 21 Dec 2004 00:18:42 -0000 1.1 --- WinEdColorize.f 5 Oct 2005 15:53:09 -0000 1.2 *************** *** 28,31 **** --- 28,32 ---- 1 18 CODE defining words that come in pairs 1 12 CFA-CODE green + 1 12 CFA-FUNC 1 12 END-CODE yellow 1 12 C; *************** *** 120,123 **** --- 121,125 ---- 1 9 #ELSE 1 9 #THEN + 1 9 #ENDIF 1 9 [IF] 1 9 [ELSE] *************** *** 156,161 **** --- 158,169 ---- 1 4 2/ 1 4 2@ + 1 4 -ROT + 1 4 2ROT 1 4 2DROP + 1 4 3DROP + 1 4 4DROP 1 4 2DUP + 1 4 3DUP + 1 4 4DUP 1 4 2OVER 1 4 2SWAP *************** *** 168,171 **** --- 176,181 ---- 1 4 >NUMBER 1 4 >R + 1 4 R>DROP + 1 4 DUP>R 1 4 ?DUP 1 4 @ *************** *** 230,233 **** --- 240,245 ---- 1 4 WORD 1 4 XOR + 1 4 3REVERSE + 1 4 4REVERSE \ Other ANS EXT *************** *** 247,250 **** --- 259,263 ---- 1 15 HEX 1 15 NIP + 1 15 2NIP 1 15 PAD 1 15 PARSE *************** *** 264,267 **** --- 277,381 ---- 1 15 WITHIN + \ Other ANS Floating Piont + + 1 11 1/F + 1 11 >FLOAT + 1 11 F>S + 1 11 S>F + 1 11 F. + 1 11 F+! + 1 11 F+ + 1 11 F- + 1 11 F* + 1 11 F/ + 1 11 F^2 + 1 11 F~ + 1 11 F@ + 1 11 D>F + 1 11 F>D + 1 11 SF@ + 1 11 DF@ + 1 11 F! + 1 11 SF! + 1 11 DF! + 1 11 F= + 1 11 F< + 1 11 F> + 1 11 F>= + 1 11 F0= + 1 11 F0< + 1 11 F0> + 1 11 F0<> + 1 11 F2/ + 1 11 F2* + 1 11 F** + 1 11 FTO + 1 11 FE. + 1 11 FS. + 1 11 FEPS + 1 11 FINF + 1 11 FLN + 1 11 FLOG + 1 11 FSIN + 1 11 FSINH + 1 11 FCOS + 1 11 FCOSH + 1 11 FTAN + 1 11 FTANH + 1 11 FABS + 1 11 FMAX + 1 11 FMIN + 1 11 FDUP + 1 11 FEXP + 1 11 FLNP1 + 1 11 FDROP + 1 11 FSWAP + 1 11 FOVER + 1 11 FEXAM + 1 11 FEXPM1 + 1 11 FNIP + 1 11 FROT + 1 11 FLOAT+ + 1 11 FLOATS + 1 11 DFLOAT+ + 1 11 DFLOATS + 1 11 FLOOR + 1 11 F-ROT + 1 11 FPICK + 1 11 FSQRT + 1 11 FTUCK + 1 11 FASIN + 1 11 FALOG + 1 11 FASINH + 1 11 FACOS + 1 11 FACOSH + 1 11 FATAN + 1 11 FATAN2 + 1 11 FATANH + 1 11 FALIGN + 1 11 FALIGNED + 1 11 FLITERAL + 1 11 DFALIGN + 1 11 DFALIGNED + 1 11 SFALIGN + 1 11 SFALIGNED + 1 11 SFLOAT+ + 1 11 SFLOATS + 1 11 F2DUP + 1 11 FINIT + 1 11 F2DROP + 1 11 F2SWAP + 1 11 F2NIP + 1 11 FROUND + 1 11 FDEPTH + 1 11 FNEGATE + 1 11 FVALUE + 1 11 FSINCOS + 1 11 REPRESENT + 1 11 FVARIABLE + 1 11 FCONSTANT + 1 11 PRECISION + 1 11 SET-PRECISION + \ Other stuff used in Firmware Studio *************** *** 269,272 **** --- 383,387 ---- 1 12 ASSEMBLE 1 12 MACRO: + 1 12 ;MACRO 1 12 MULTI for MULTI..REPEAT 1 12 IF_Z assembler control structures *************** *** 377,378 **** --- 492,494 ---- max-toolbar displayingLine + |
|
From: Jos v.d.V. <jo...@us...> - 2005-10-05 15:40:44
|
Update of /cvsroot/win32forth/win32forth/apps/Chess In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31574/apps/Chess Modified Files: Opengl.f Log Message: Andrew: modified 2f' 3f' to use short jumps in the assembler code and removed [edi] from FRESULT assembler code Index: Opengl.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Chess/Opengl.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Opengl.f 20 Jun 2005 07:40:43 -0000 1.3 --- Opengl.f 5 Oct 2005 15:40:36 -0000 1.4 *************** *** 169,175 **** Saturday, June 18 2005 gah ! - modified to use 3reverse and 4reverse as suggested by Andrew Stevenson - modified stack comments to use -- for consistency )) --- 169,179 ---- Saturday, June 18 2005 gah ! - modified to use 3reverse and 4reverse as suggested by Andrew Stephenson - modified stack comments to use -- for consistency + Thursday, September 29 2005 aws + - modified 2f' 3f' to use short jumps in the assembler code and + removed [edi] from FRESULT assembler code + )) *************** *** 199,206 **** \ to the Win32Forth float stack code FRESULT ( x -- ) ( FS: -- r ) ! mov ecx, FSP [edi] ! fstp FSIZE FSTACK [ecx] [edi] add ecx, # B/FLOAT ! mov FSP [edi], ecx pop ebx next, --- 203,210 ---- \ to the Win32Forth float stack code FRESULT ( x -- ) ( FS: -- r ) ! mov ecx, FSP ! fstp FSIZE FSTACK [ecx] add ecx, # B/FLOAT ! mov FSP , ecx pop ebx next, *************** *** 216,220 **** mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! js L$3 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx --- 220,224 ---- mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! js short L$3 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx *************** *** 223,229 **** fstp float 0 [esp] pop ebx ! L$2: mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! js L$3 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx --- 227,233 ---- fstp float 0 [esp] pop ebx ! mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! js short L$3 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx *************** *** 233,237 **** fwait pop ebx ! jmp L$4 L$3: mov esi, # ' FSTKUFLO >body add esi, edi --- 237,241 ---- fwait pop ebx ! jmp short L$4 L$3: mov esi, # ' FSTKUFLO >body add esi, edi *************** *** 244,248 **** mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! js L$5 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx --- 248,252 ---- mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! js short L$5 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx *************** *** 251,257 **** fstp float 0 [esp] pop ebx ! L$2: mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! js L$5 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx --- 255,261 ---- fstp float 0 [esp] pop ebx ! mov ecx, FSP_MEMORY sub ecx, # B/FLOAT ! js short L$5 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx *************** *** 261,265 **** pop ebx sub ecx, # B/FLOAT ! js L$5 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx --- 265,269 ---- pop ebx sub ecx, # B/FLOAT ! js short L$5 fld FSIZE FSTACK_MEMORY mov FSP_MEMORY , ecx *************** *** 269,273 **** fwait pop ebx ! jmp L$6 L$5: mov esi, # ' FSTKUFLO >body add esi, edi --- 273,277 ---- fwait pop ebx ! jmp short L$6 L$5: mov esi, # ' FSTKUFLO >body add esi, edi *************** *** 286,296 **** : 2d' ( f: f1 f0 -- ) ( -- d0 d1 ) ! s" df>stack df>stack " evaluate ; immediate : 3d' ( f: f2 f1 f0 -- ) ( -- d0 d1 d2 ) ! s" df>stack df>stack df>stack " evaluate ; immediate : 4d' ( f: f3 f2 f1 f0 -- ) ( -- d0 d1 d2 d3 ) ! s" df>stack df>stack df>stack df>stack " evaluate ; immediate : nd' ( f: fx..f0 -- ) ( k -- dt0..dx ) --- 290,300 ---- : 2d' ( f: f1 f0 -- ) ( -- d0 d1 ) ! s" df>stack df>stack " evaluate ; immediate : 3d' ( f: f2 f1 f0 -- ) ( -- d0 d1 d2 ) ! s" df>stack df>stack df>stack " evaluate ; immediate : 4d' ( f: f3 f2 f1 f0 -- ) ( -- d0 d1 d2 d3 ) ! s" df>stack df>stack df>stack df>stack " evaluate ; immediate : nd' ( f: fx..f0 -- ) ( k -- dt0..dx ) *************** *** 340,344 **** : glDisable ( cap -- ) call glDisable drop ; : glViewport ( x y width height -- ) 4reverse call glViewport drop ; ! : glGetFloatv ( pname *params -- ) swap call glGetFloatv drop ; : glShadeModel ( mode -- ) call glShadeModel drop ; : glLightModelfv ( pname *param -- ) swap call glLightModelfv drop ; --- 344,348 ---- : glDisable ( cap -- ) call glDisable drop ; : glViewport ( x y width height -- ) 4reverse call glViewport drop ; ! : glGetFloatv ( pname *params -- ) swap call glGetFloatv drop ; : glShadeModel ( mode -- ) call glShadeModel drop ; : glLightModelfv ( pname *param -- ) swap call glLightModelfv drop ; *************** *** 356,364 **** : gluQuadricDrawStyle ( qobj style -- ) swap call gluQuadricDrawStyle drop ; : gluQuadricNormals ( qobj normals -- ) swap call gluQuadricNormals drop ; ! : gluBeginCurve ( *nobj -- ) call gluBeginCurve drop ; ! : gluEndCurve ( *nobj -- ) call gluEndCurve drop ; ! : gluNewNurbsRenderer ( -- *nobj ) call gluNewNurbsRenderer ; >>> ! : glSelectBuffer ( size buffer -- ) swap call glSelectBuffer drop ; : glRenderMode ( mode -- 0|#sel|val ) call glRenderMode ; : glInitNames ( -- ) call glInitNames drop ; --- 360,368 ---- : gluQuadricDrawStyle ( qobj style -- ) swap call gluQuadricDrawStyle drop ; : gluQuadricNormals ( qobj normals -- ) swap call gluQuadricNormals drop ; ! : gluBeginCurve ( *nobj -- ) call gluBeginCurve drop ; ! : gluEndCurve ( *nobj -- ) call gluEndCurve drop ; ! : gluNewNurbsRenderer ( -- *nobj ) call gluNewNurbsRenderer ; >>> ! : glSelectBuffer ( size buffer -- ) swap call glSelectBuffer drop ; : glRenderMode ( mode -- 0|#sel|val ) call glRenderMode ; : glInitNames ( -- ) call glInitNames drop ; *************** *** 368,384 **** : glGetIntegerv ( pname *params -- ) swap call glGetIntegerv drop ; : gluPickMatrix ( f: x y width height -- ) ( viewport -- ) ! 4d' call gluPickMatrix drop ; : glReadPixels ( f: x y width height -- ) ( format type *pixels -- ) ! 3reverse 2>r >r 4f' r> 2r> call glReadPixels drop ; : glPixelStorei ( pname param -- ) swap call glPixelStorei drop ; : glDepthRange ( f: near far -- ) 2d' call glDepthRange drop ; \ : gluDeleteQuadric ( qobj -- ) call gluDeleteQuadric drop ; : wglUseFontBitmaps ( ghdc 1st_char #chars baselist -- ) ! 4reverse call wglUseFontBitmaps drop ; : glBindTexture ( target name -- ) swap call glBindTexture drop ; : glGenTextures ( GLsizei *name -- ) swap call glGenTextures drop ; : glTexParameteri ( target pname param -- ) 3reverse call glTexParameteri drop ; : glTexImage2D ( target level components width height border format type *pixels -- ) ! 9 s-reverse call glTexImage2D drop ; : glTexEnvi ( target pname param -- ) 3reverse call glTexEnvi drop ; --- 372,388 ---- : glGetIntegerv ( pname *params -- ) swap call glGetIntegerv drop ; : gluPickMatrix ( f: x y width height -- ) ( viewport -- ) ! 4d' call gluPickMatrix drop ; : glReadPixels ( f: x y width height -- ) ( format type *pixels -- ) ! 3reverse 2>r >r 4f' r> 2r> call glReadPixels drop ; : glPixelStorei ( pname param -- ) swap call glPixelStorei drop ; : glDepthRange ( f: near far -- ) 2d' call glDepthRange drop ; \ : gluDeleteQuadric ( qobj -- ) call gluDeleteQuadric drop ; : wglUseFontBitmaps ( ghdc 1st_char #chars baselist -- ) ! 4reverse call wglUseFontBitmaps drop ; : glBindTexture ( target name -- ) swap call glBindTexture drop ; : glGenTextures ( GLsizei *name -- ) swap call glGenTextures drop ; : glTexParameteri ( target pname param -- ) 3reverse call glTexParameteri drop ; : glTexImage2D ( target level components width height border format type *pixels -- ) ! 9 s-reverse call glTexImage2D drop ; : glTexEnvi ( target pname param -- ) 3reverse call glTexEnvi drop ; *************** *** 403,407 **** : gluNurbsProperty ( *nobj property -- ) ( f: value -- ) ! f' 3reverse call gluNurbsProperty drop ; : glClearColor ( f: GLclampf_red GLclampf_green GLclampf_blue GLclampf_alpha -- ) --- 407,411 ---- : gluNurbsProperty ( *nobj property -- ) ( f: value -- ) ! f' 3reverse call gluNurbsProperty drop ; : glClearColor ( f: GLclampf_red GLclampf_green GLclampf_blue GLclampf_alpha -- ) *************** *** 415,431 **** : gluPerspective ( f: fovy aspect near far -- ) ! 4d' call gluPerspective drop ; : gluCylinder ( *qobj stacks slices -- ) ( f: height topRadius baseRadius -- ) ! >r swap 3d' r> call gluCylinder drop ; : gluDisk ( *qobj -- ) ( f: innerRadius outerRadius stacks loops -- ) ! >r f>s f>s 2d' r> call gluDisk drop ; : gluPartialDisk ( *qobj -- ) ( f: innerRadius outerRadius stacks loops startAngle sweepAngle -- ) ! >r 2d' f>s f>s 2d' r> call gluPartialDisk drop ; : gluLookAt ( f: eyex eyey eyez centerx centery centerz upx upy upz -- ) ! 9 nd' call gluLookAt drop ; --- 419,435 ---- : gluPerspective ( f: fovy aspect near far -- ) ! 4d' call gluPerspective drop ; : gluCylinder ( *qobj stacks slices -- ) ( f: height topRadius baseRadius -- ) ! >r swap 3d' r> call gluCylinder drop ; : gluDisk ( *qobj -- ) ( f: innerRadius outerRadius stacks loops -- ) ! >r f>s f>s 2d' r> call gluDisk drop ; : gluPartialDisk ( *qobj -- ) ( f: innerRadius outerRadius stacks loops startAngle sweepAngle -- ) ! >r 2d' f>s f>s 2d' r> call gluPartialDisk drop ; : gluLookAt ( f: eyex eyey eyez centerx centery centerz upx upy upz -- ) ! 9 nd' call gluLookAt drop ; *************** *** 434,443 **** : gluNurbsCurve ( *nobj nknots *knot stride *ctlarray order type -- ) ! 3reverse 3 roll 4 roll 5 roll 6 roll call gluNurbsCurve drop ; 1 CallBack: nurbsError ( arg -- f ) ( return ) 1 ; : gluNurbsCallback ( *nobj which nurbsError -- errorcode ) ! 3reverse call gluNurbsCallback ; : .gluerror ( *nobj -- ) GLU_ERROR &nurbsError gluNurbsCallback . ; --- 438,447 ---- : gluNurbsCurve ( *nobj nknots *knot stride *ctlarray order type -- ) ! 3reverse 3 roll 4 roll 5 roll 6 roll call gluNurbsCurve drop ; 1 CallBack: nurbsError ( arg -- f ) ( return ) 1 ; : gluNurbsCallback ( *nobj which nurbsError -- errorcode ) ! 3reverse call gluNurbsCallback ; : .gluerror ( *nobj -- ) GLU_ERROR &nurbsError gluNurbsCallback . ; *************** *** 623,632 **** : floats! ( adr k -- ) ( FS: fk..f0 -- ) ! 0 do dup i >f! ! loop drop ; : 0floats! ( adr k -- ) ! 0 do 0e dup i >f! ! loop drop ; defer fref3D ( -- adr k ) \ when deferred --- 627,636 ---- : floats! ( adr k -- ) ( FS: fk..f0 -- ) ! 0 do dup i >f! ! loop drop ; : 0floats! ( adr k -- ) ! 0 do 0e dup i >f! ! loop drop ; defer fref3D ( -- adr k ) \ when deferred *************** *** 649,660 **** : +value$>fparams$ \ f: ( n -- ) fdup fabs 1000000e f> ! if s" ..." ! else fdup fabs 1000e f> ! if 7 ! else 4 ! then sigdigits ! ! pad fvalue-to-string s" e " pad ! +place pad count ! then fparams$ +place ; --- 653,664 ---- : +value$>fparams$ \ f: ( n -- ) fdup fabs 1000000e f> ! if s" ..." ! else fdup fabs 1000e f> ! if 7 ! else 4 ! then sigdigits ! ! pad fvalue-to-string s" e " pad ! +place pad count ! then fparams$ +place ; *************** *** 743,748 **** : fm+ ( adr-floats-to-add addr-floats-result -- ) ! dup>r rot = 0= abort" The number of floats not equal." ! swap r@ floats@ dup r@ floatsf@+ r> floats! ; --- 747,752 ---- : fm+ ( adr-floats-to-add addr-floats-result -- ) ! dup>r rot = 0= abort" The number of floats not equal." ! swap r@ floats@ dup r@ floatsf@+ r> floats! ; *************** *** 785,789 **** : -zz ( -- adr-flookat ) ( F: -- f ) fref3D 0 addr#floats+@ distance f- ; ! : zr ( -- adr-flookat flag ) ( F: zoom -- ) fref3D 3 2dup <= if 2drop false --- 789,793 ---- : -zz ( -- adr-flookat ) ( F: -- f ) fref3D 0 addr#floats+@ distance f- ; ! : zr ( -- adr-flookat flag ) ( F: zoom -- ) fref3D 3 2dup <= if 2drop false *************** *** 792,800 **** ; ! : -zr ( -- adr-flookat flag ) ( F: zoom -- ) ! fref3D 3 2dup <= ! if 2drop false ! else addr#floats+@ rdistance f- true ! then ; --- 796,804 ---- ; ! : -zr ( -- adr-flookat flag ) ( F: zoom -- ) ! fref3D 3 2dup <= ! if 2drop false ! else addr#floats+@ rdistance f- true ! then ; *************** *** 961,965 **** VK_= of incr_interval endof \ incr \ ascii A of ['] fref3TransT is-fref3D ! \ fref4RotD fref3TransT move_forward endof \ move forwards \ ascii B of ['] fref3TransT is-fref3D \ fref4RotD fref3TransT move_backward endof \ move backward --- 965,969 ---- VK_= of incr_interval endof \ incr \ ascii A of ['] fref3TransT is-fref3D ! \ fref4RotD fref3TransT move_forward endof \ move forwards \ ascii B of ['] fref3TransT is-fref3D \ fref4RotD fref3TransT move_backward endof \ move backward *************** *** 988,996 **** : .text-line ( str$ count -- ) ! swap 0 0 ghdc call TextOut drop ; false value ignore_esc : showing-bitmap(s)? ( -- flag ) ! ['] _load-bitmap ['] painting >body @ = ; : key-event ( VK_key -- ) --- 992,1000 ---- : .text-line ( str$ count -- ) ! swap 0 0 ghdc call TextOut drop ; false value ignore_esc : showing-bitmap(s)? ( -- flag ) ! ['] _load-bitmap ['] painting >body @ = ; : key-event ( VK_key -- ) *************** *** 1152,1156 **** : [object ( fill -- ) ( f: xt yt zt -- ) ! glPushMatrix_glTranslatef [quad_object ; : [scaled-object ( fill -- ) ( f: xs ys zs xt yt zt -- ) --- 1156,1160 ---- : [object ( fill -- ) ( f: xt yt zt -- ) ! glPushMatrix_glTranslatef [quad_object ; : [scaled-object ( fill -- ) ( f: xs ys zs xt yt zt -- ) *************** *** 1161,1165 **** : [rot-scaled-object-inline ( fill -- ) ( f: deg xg yg zg xs ys zs xt yt zt -- ) ! glTranslatef glscalef glRotatef [quad_object ; : [rot-object ( fill -- ) ( f: deg xg yg zg xt yt zt -- ) --- 1165,1169 ---- : [rot-scaled-object-inline ( fill -- ) ( f: deg xg yg zg xs ys zs xt yt zt -- ) ! glTranslatef glscalef glRotatef [quad_object ; : [rot-object ( fill -- ) ( f: deg xg yg zg xt yt zt -- ) *************** *** 1174,1178 **** : cylinder ( stacks slices basef topf heightf -- ) [quad ! 3f' qobj call gluCylinder drop quad] ; --- 1178,1182 ---- : cylinder ( stacks slices basef topf heightf -- ) [quad ! 3f' qobj call gluCylinder drop quad] ; *************** *** 1234,1238 **** : clear-buffer ( -- ) ! GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT OR glClear ; : cls-openGL ( -- ) --- 1238,1242 ---- : clear-buffer ( -- ) ! GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT OR glClear ; : cls-openGL ( -- ) *************** *** 1279,1283 **** : 3Ddot ( f: 2*size -- ) ! 3fdups glVertex3f fdup fnegate fover glVertex3f ; --- 1283,1287 ---- : 3Ddot ( f: 2*size -- ) ! 3fdups glVertex3f fdup fnegate fover glVertex3f ; *************** *** 1331,1335 **** : rectangle-obj ( f: width height depth -- ) \ Note: The sizes will be 2* ! fto c3 fto c2 fto c1 _box ; : cube ( f: size -- ) --- 1335,1339 ---- : rectangle-obj ( f: width height depth -- ) \ Note: The sizes will be 2* ! fto c3 fto c2 fto c1 _box ; : cube ( f: size -- ) *************** *** 1377,1381 **** : box_sizes@ ( adr-struct-box -- ) ( f: -- width height depth ) ! dup fbox_x f@ dup fbox_y f@ fbox_z f@ ; : rotatef! ( degrees adr-struct-obj -- degrees ) ( f: x y z -- ) --- 1381,1385 ---- : box_sizes@ ( adr-struct-box -- ) ( f: -- width height depth ) ! dup fbox_x f@ dup fbox_y f@ fbox_z f@ ; : rotatef! ( degrees adr-struct-obj -- degrees ) ( f: x y z -- ) *************** *** 1415,1419 **** : set-speed-degrees ( -- ) #frames-to-do$ dup ms-slow-action #cycles-1-second val>$ ! oglwin-base Start: Degree/sec not abort" Stop. Maximum degrees / second is not changed." #frames-to-do$ count number? not --- 1419,1423 ---- : set-speed-degrees ( -- ) #frames-to-do$ dup ms-slow-action #cycles-1-second val>$ ! oglwin-base Start: Degree/sec not abort" Stop. Maximum degrees / second is not changed." #frames-to-do$ count number? not *************** *** 1447,1449 **** \s ! |
1040 messages has been excluded from this view by a project administrator.
![http://www.evrsoft.com/1stpage/1st-now.gif"](http://www.evrsoft.com/1stpage/1st-now.gif"){kind=link}