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
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv27474 Modified Files: EdPreferences.f EdPreferences.ff EdPreferences.frm EdStatusbar.f EdToolbar.f EdVersion.f Main.f ScintillaMDI.f Log Message: Added autoindent. Incremented version. EAB Index: EdVersion.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdVersion.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** EdVersion.f 23 Jul 2006 09:36:40 -0000 1.3 --- EdVersion.f 13 Jan 2007 02:20:10 -0000 1.4 *************** *** 1,5 **** \ $Id$ ! 10202 value sciedit_version# \ Version numbers: v.ww.rr --- 1,5 ---- \ $Id$ ! 10203 value sciedit_version# \ Version numbers: v.ww.rr *************** *** 254,255 **** --- 254,270 ---- will reset the remote I/O. After executuing this command it should always be possible to compile. + + \ changes for Version 1.02.03 + EAB - added the ability to set colors for text and background. Set from the Preferences + dialog. + - Removed the textboxes in the rebarcontrol. + - Separated the editor toolbar and the project toolbar in the rebar. + - Added a combobox for quick viewing of source for a word. + - Ability to open HTML source for editing. Control and double-click in directory window. + - Quick editing and previewing of HTML source docs. Press F10 in HML source to preview in + in browser. + + EAB Friday, January 05 2007 + - Added the ability to autoindent lines in the IDE editor. Enable in the IDE + Preferences dialog. + - Added display of the current column to the status bar. Index: EdPreferences.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdPreferences.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** EdPreferences.f 13 Oct 2006 03:55:11 -0000 1.1 --- EdPreferences.f 13 Jan 2007 02:20:10 -0000 1.2 *************** *** 15,26 **** WindowStyle: super WS_BORDER or WS_VISIBLE or ;M ! :m paint: ( colorref -- ) newcolor: thecolor paint: super ;m ! :m on_paint: ( -- ) 0 0 width height thecolor fillarea: dc ;m ! ;class --- 15,26 ---- WindowStyle: super WS_BORDER or WS_VISIBLE or ;M ! :m paint: ( colorref -- ) newcolor: thecolor paint: super ;m ! :m on_paint: ( -- ) 0 0 width height thecolor fillarea: dc ;m ! ;class *************** *** 45,51 **** color: selfore to select-forecolor color: selback to select-backcolor Update close: super ;m ! : command-func ( id obj -- ) drop --- 45,53 ---- color: selfore to select-forecolor color: selback to select-backcolor + + IsButtonChecked?: chkAutoIndent to autoindent? Update close: super ;m ! : command-func ( id obj -- ) drop *************** *** 59,76 **** getid: btnok of close: self endof endcase ; ! :m on_init: ( -- ) IDCANCEL SetID: btnCancel IDOK SetID: btnOK on_init: super ! ! SW_HIDE Show: chkButtonTabs ! SW_HIDE Show: chkMultiLineTabs ! SW_HIDE Show: chkAutoIndent ! SW_HIDE Show: grpEditorOptions ! SW_HIDE Show: grpTabOptions ! ['] command-func setcommand: self ! fore-color newcolor: fore back-color newcolor: back --- 61,74 ---- getid: btnok of close: self endof endcase ; ! :m on_init: ( -- ) IDCANCEL SetID: btnCancel IDOK SetID: btnOK on_init: super ! ! autoindent? Check: chkAutoIndent ! ['] command-func setcommand: self ! fore-color newcolor: fore back-color newcolor: back *************** *** 111,115 **** GetHandle: MainWindow SetParentWindow: IDEPreferencesForm start: IDEPreferencesForm ; IDM_PREFERENCES SetCOmmand ! \s --- 109,113 ---- GetHandle: MainWindow SetParentWindow: IDEPreferencesForm start: IDEPreferencesForm ; IDM_PREFERENCES SetCOmmand ! \s Index: EdPreferences.frm =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdPreferences.frm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** EdPreferences.frm 13 Oct 2006 03:55:11 -0000 1.1 --- EdPreferences.frm 13 Jan 2007 02:20:10 -0000 1.2 *************** *** 11,15 **** GroupBox grpEditorOptions - GroupBox grpTabOptions GroupBox grpCOlors PushButton btnForeground --- 11,14 ---- *************** *** 43,48 **** 34 value SelBackChildW 25 value SelBackChildH - CheckBox chkButtonTabs - CheckBox chkMultiLineTAbs CheckBox chkAutoIndent PushButton btnOk --- 42,45 ---- *************** *** 72,76 **** :M StartSize: ( -- width height ) ! 188 362 ;M --- 69,73 ---- :M StartSize: ( -- width height ) ! 185 286 ;M *************** *** 87,91 **** s" MS Sans Serif" SetFaceName: WinFont 8 Width: WinFont ! Create: WinFont drop \ not testing return flag \ set form color to system color --- 84,88 ---- s" MS Sans Serif" SetFaceName: WinFont 8 Width: WinFont ! Create: WinFont \ set form color to system color *************** *** 94,106 **** self Start: grpEditorOptions ! 16 261 124 55 Move: grpEditorOptions Handle: Winfont SetFont: grpEditorOptions s" Editor Options" SetText: grpEditorOptions - self Start: grpTabOptions - 15 177 127 80 Move: grpTabOptions - Handle: Winfont SetFont: grpTabOptions - s" TabWindow Options" SetText: grpTabOptions - self Start: grpCOlors 16 14 161 155 Move: grpCOlors --- 91,98 ---- self Start: grpEditorOptions ! 16 181 124 55 Move: grpEditorOptions Handle: Winfont SetFont: grpEditorOptions s" Editor Options" SetText: grpEditorOptions self Start: grpCOlors 16 14 161 155 Move: grpCOlors *************** *** 133,158 **** s" Select Background" SetText: btnSelectBack - self Start: chkButtonTabs - 27 189 100 25 Move: chkButtonTabs - Handle: Winfont SetFont: chkButtonTabs - s" Button Style" SetText: chkButtonTabs - - self Start: chkMultiLineTAbs - 27 216 100 25 Move: chkMultiLineTAbs - Handle: Winfont SetFont: chkMultiLineTAbs - s" MultiLine" SetText: chkMultiLineTAbs - self Start: chkAutoIndent ! 28 277 100 25 Move: chkAutoIndent Handle: Winfont SetFont: chkAutoIndent s" AutoIndent" SetText: chkAutoIndent self Start: btnOk ! 8 332 80 25 Move: btnOk Handle: Winfont SetFont: btnOk s" &Ok" SetText: btnOk self Start: btnCancel ! 90 332 80 25 Move: btnCancel Handle: Winfont SetFont: btnCancel s" &Cancel" SetText: btnCancel --- 125,140 ---- s" Select Background" SetText: btnSelectBack self Start: chkAutoIndent ! 28 197 100 25 Move: chkAutoIndent Handle: Winfont SetFont: chkAutoIndent s" AutoIndent" SetText: chkAutoIndent self Start: btnOk ! 8 252 80 25 Move: btnOk Handle: Winfont SetFont: btnOk s" &Ok" SetText: btnOk self Start: btnCancel ! 90 252 80 25 Move: btnCancel Handle: Winfont SetFont: btnCancel s" &Cancel" SetText: btnCancel Index: EdToolbar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdToolbar.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** EdToolbar.f 21 Oct 2006 09:11:10 -0000 1.8 --- EdToolbar.f 13 Jan 2007 02:20:10 -0000 1.9 *************** *** 292,296 **** eraseband-info GetHandle: ControlToolBar ! [ RBBS_GRIPPERALWAYS RBBS_CHILDEDGE or ] literal 450 insert-band ; --- 292,296 ---- eraseband-info GetHandle: ControlToolBar ! [ RBBS_GRIPPERALWAYS RBBS_CHILDEDGE or ] literal 500 insert-band ; *************** *** 308,312 **** eraseband-info GetHandle: helpbox z" View Source for:" to lptext ! [ RBBS_GRIPPERALWAYS RBBS_CHILDEDGE or ] literal 200 insert-band ; --- 308,312 ---- eraseband-info GetHandle: helpbox z" View Source for:" to lptext ! [ RBBS_GRIPPERALWAYS RBBS_CHILDEDGE or ] literal 150 insert-band ; *************** *** 444,447 **** --- 444,448 ---- false IDM_FIND_NEXT EnableButton: ControlToolbar false IDM_REDO EnableButton: ControlToolbar + false IDM_BROWSE EnableButton: ControlToolbar then *************** *** 466,470 **** false IDM_FIND_NEXT EnableButton: ControlToolbar false IDM_REDO EnableButton: ControlToolbar - false IDM_BROWSE EnableButton: ControlToolbar false IDM_BACK EnableButton: ControlToolbar --- 467,470 ---- Index: EdStatusbar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdStatusbar.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** EdStatusbar.f 13 Oct 2006 03:55:11 -0000 1.4 --- EdStatusbar.f 13 Jan 2007 02:20:10 -0000 1.5 *************** *** 60,63 **** --- 60,66 ---- s" of " pad +place (.) pad +place + s" Column: " pad +place + GetColumn: ActiveChild (.) pad +place + ?BrowseMode: ActiveChild if s" - Use Rightclick to go to the source of the selected definition and CTRL+Rightclick to go back." Index: EdPreferences.ff =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdPreferences.ff,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 Binary files /tmp/cvsCpbbsA and /tmp/cvs2D28QT differ Index: Main.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Main.f,v retrieving revision 1.34 retrieving revision 1.35 diff -C2 -d -r1.34 -r1.35 *** Main.f 3 Dec 2006 07:12:05 -0000 1.34 --- Main.f 13 Jan 2007 02:20:10 -0000 1.35 *************** *** 19,23 **** only forth also editor definitions \ put all words into the EDITOR vocabulary ! true value sysgen s" apps\Win32ForthIDE" "fpath+ --- 19,23 ---- only forth also editor definitions \ put all words into the EDITOR vocabulary ! true value sysgen s" apps\Win32ForthIDE" "fpath+ *************** *** 64,67 **** --- 64,68 ---- true value FinalNewLine? false value CompileProject? + false value autoindent? 0 constant FT_SOURCE *************** *** 376,379 **** --- 377,381 ---- Select-ForeColor s>d (d.) s" SelectForeColor" "SetDefault Select-BackColor s>d (d.) s" SelectBackColor" "SetDefault + AutoIndent? s>d (d.) s" AutoIndent" "SetDefault WindowState SIZE_RESTORED = *************** *** 427,430 **** --- 429,434 ---- s" SelectForeColor" "GetDefaultValue 0= IF drop Select-ForeColor THEN to Select-ForeColor + s" AutoIndent" "GetDefaultValue 0= IF drop false THEN to autoindent? + s" SearchText" "GetDefault -IF 2dup "CLIP" find-buf place THEN 2drop s" SearchPath" "GetDefault -IF 2dup "CLIP" search-path place THEN 2drop *************** *** 673,682 **** ;M :M WM_NOTIFY ( h m w l -- res ) GetFileType: self FT_SOURCE = ! if 2 cells + @ SCN_UPDATEUI = if UpdateStatusBar: self EnableToolbar ! then then false ;M --- 677,711 ---- ;M + 1024 constant sizeof(linebuf) + create linebuf sizeof(linebuf) allot linebuf sizeof(linebuf) erase + + : ?indent { n \ curln prevlinelength linelength -- } \ adapted from Scintilla docs + n 0x0A = autoindent? and + if GetCurrentPos: ChildWindow LineFromPosition: ChildWindow to curln + curln LineLength: ChildWindow to linelength + true \ curln 0> linelength 2 <= and + if curln 1- LineLength: ChildWindow to prevlinelength + prevlinelength sizeof(linebuf) < + if curln 1- linebuf GetLine: ChildWindow to prevlinelength + 0 linebuf prevlinelength + c! + linebuf prevlinelength bounds + do i c@ bl over <> swap 0x09 <> and + if 0 i c! leave + then + loop linebuf ReplaceSel: ChildWindow + then + then + then ; + + :M GetColumn: ( -- n ) + maxstring new$ GetCurLine: ChildWindow ;M + :M WM_NOTIFY ( h m w l -- res ) GetFileType: self FT_SOURCE = ! if dup 2 cells + @ SCN_UPDATEUI = if UpdateStatusBar: self EnableToolbar ! else 4 cells+ @ ?indent ! then then false ;M Index: ScintillaMDI.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/ScintillaMDI.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** ScintillaMDI.f 23 Oct 2006 08:38:17 -0000 1.8 --- ScintillaMDI.f 13 Jan 2007 02:20:10 -0000 1.9 *************** *** 653,657 **** case \ SCN_STYLENEEDED of ." SCN_STYLENEEDED" endof \ SCN_STYLENEEDED of ." SCN_STYLENEEDED" endof ! \ SCN_CHARADDED of ." SCN_CHARADDED" endof \ SCN_SAVEPOINTREACHED of ." SCN_SAVEPOINTREACHED" endof \ SCN_SAVEPOINTLEFT of ." SCN_SAVEPOINTLEFT" endof --- 653,657 ---- case \ SCN_STYLENEEDED of ." SCN_STYLENEEDED" endof \ SCN_STYLENEEDED of ." SCN_STYLENEEDED" endof ! \ SCN_CHARADDED of ?indent endof \ SCN_SAVEPOINTREACHED of ." SCN_SAVEPOINTREACHED" endof \ SCN_SAVEPOINTLEFT of ." SCN_SAVEPOINTLEFT" endof *************** *** 677,680 **** --- 677,681 ---- :M OnCommand: ( h m w l -- res ) + \ OnNotify: self comment: cr ." OnCommand: " *************** *** 685,689 **** endcase comment; ! true ;M ;Class --- 686,691 ---- endcase comment; ! true ! ;M ;Class |
|
From: Ezra B. <ezr...@us...> - 2007-01-13 02:15:09
|
Update of /cvsroot/win32forth/win32forth/doc/ForthForm In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv25568/doc/ForthForm Modified Files: FF-History.htm Log Message: Bugfix for static labels. EAB Index: FF-History.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/ForthForm/FF-History.htm,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** FF-History.htm 31 Dec 2006 11:56:07 -0000 1.7 --- FF-History.htm 13 Jan 2007 02:15:06 -0000 1.8 *************** *** 27,30 **** --- 27,34 ---- <P ALIGN=LEFT> + <b>Thursday, January 11 2007</b> - Bug fix for static labels. Bitmap.f not loaded when + control has an image, Been there for a while. Probably because I have never used static labels! + Thanks to Dick for bringing it to my attention.<br><br> + <b>Saturday, December 30 2006</b> - Implemented a little mechanism to use the arrow keys when adjusting controls. For those times when you've selected controls and then moved them out of |
|
From: Ezra B. <ezr...@us...> - 2007-01-13 02:14:13
|
Update of /cvsroot/win32forth/win32forth/apps/ForthForm In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv25164/apps/ForthForm Modified Files: FORMOBJECT.F Log Message: Bugfix for static labels. EAB Index: FORMOBJECT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FORMOBJECT.F,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** FORMOBJECT.F 31 Dec 2006 11:55:17 -0000 1.16 --- FORMOBJECT.F 13 Jan 2007 02:14:08 -0000 1.17 *************** *** 1506,1509 **** --- 1506,1510 ---- TypeBitmapButton get-array TypeIconButton get-array or + TypeStaticBitmap get-array or if s" \- usebitmap needs bitmap.f" append&crlf then *************** *** 1891,1901 **** if 2tabs s"append append ( bitmap ) "append s" asciiz LoadBitmap SetImage: " append GetName: ThisControl append&crlf - GetToolTip: ThisControl ?dup - if 2tabs s"append append ( tooltip ) "append - s" ToolString: " append GetName: ThisControl append&crlf - else drop - then else 2drop ! then +crlf ; : startstaticbitmap ( -- ) \ --- 1892,1901 ---- if 2tabs s"append append ( bitmap ) "append s" asciiz LoadBitmap SetImage: " append GetName: ThisControl append&crlf else 2drop ! then GetToolTip: ThisControl ?dup ! if 2tabs s"append append ( tooltip ) "append ! s" ToolString: " append GetName: ThisControl append&crlf ! else drop ! then +crlf ; : startstaticbitmap ( -- ) \ |
|
From: Jos v.d.V. <jo...@us...> - 2007-01-06 13:59:03
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv17334 Modified Files: floadcmdline.f Log Message: Jos: Adapted for the current Win32Forth Index: floadcmdline.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/floadcmdline.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** floadcmdline.f 29 Nov 2006 13:22:58 -0000 1.6 --- floadcmdline.f 6 Jan 2007 13:58:57 -0000 1.7 *************** *** 38,42 **** cmdline ascii " scan 1 - swap 1+ swap 2dup "path-only" temp$ place ! temp$ zcount temp$ count "chdir drop count type cr cmdline type cr 1 - "fload ok quit --- 38,42 ---- cmdline ascii " scan 1 - swap 1+ swap 2dup "path-only" temp$ place ! temp$ +null temp$ count 2dup "chdir type cr cmdline type cr 1 - "fload ok quit |
|
From: Jos v.d.V. <jo...@us...> - 2007-01-06 12:37:17
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv17248 Modified Files: Sockets.f Log Message: Jos: CLIENT-OPEN- has the advantage that an application is able to decide what to do. Index: Sockets.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/Sockets.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Sockets.f 6 Jan 2007 12:27:51 -0000 1.1 --- Sockets.f 6 Jan 2007 12:37:12 -0000 1.2 *************** *** 174,177 **** --- 174,187 ---- ; + : CLIENT-OPEN- ( addr u port -- s IOR ) \ s IOR-0=OK + >r GetHostIP abort" Server not available " + r> CreateSocket DROP DUP >r + ConnectSocket dup + if cr . ." Can't connect " false + else drop true + then + r> swap + ; + \s SocketsStartup [if] cr .( SocketsStartup error) abort [then] |
|
From: Jos v.d.V. <jo...@us...> - 2007-01-06 12:27:57
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv13257 Added Files: Sockets.f Log Message: Jos: Update from jmdrake --- NEW FILE: Sockets.f --- \ Windows Sockets of Andrey Cherezov \ January 6th, 2007: Adapted for Win32Forth version 6.11.10 anew sockets.f winlibrary wsock32.dll 1 CONSTANT SOCK_STREAM -1 CONSTANT INVALID_SOCKET -1 CONSTANT SOCKET_ERROR 2 CONSTANT PF_INET 2 CONSTANT AF_INET 6 CONSTANT IPPROTO_TCP NOSTACK \ A tip from: Alex McDonald October 16th, 2002 0 2 FIELD+ sin_family 2 FIELD+ sin_port 4 FIELD+ sin_addr 8 FIELD+ sin_zero CONSTANT /sockaddr_in CREATE sock_addr HERE /sockaddr_in DUP ALLOT ERASE AF_INET sock_addr sin_family W! CHECKSTACK : ASCIIZ> 100 2dup 0 scan nip - ; : ztype ( z"a -- ) ASCIIZ> type ; : CreateSocket ( -- socket ior ) IPPROTO_TCP SOCK_STREAM PF_INET call socket DUP INVALID_SOCKET = IF call WSAGetLastError ELSE 0 THEN ; : ToRead ( socket -- n ior ) \ ñêîëüêî áàéò ìîæíî ñåé÷àñ ïðî÷åñòü èç ñîêåòà \ ìîæíî èñïîëüçîâàòü ïåðåä ReadSocket äëÿ òîãî ÷òîáû \ èçáåæàòü áëîêèðîâàíèÿ ïðè n=0 0 >r rp@ [ HEX ] 4004667F [ DECIMAL ] ROT call ioctlsocket SOCKET_ERROR = IF r>drop 0 call WSAGetLastError ELSE r> 0 THEN ; : ConnectSocket ( IP port socket -- ior ) >R 256 /MOD SWAP 256 * + sock_addr sin_port W! sock_addr sin_addr ! /sockaddr_in sock_addr R> call connect SOCKET_ERROR = IF call WSAGetLastError ELSE 0 THEN ; : CloseSocket ( s -- ior ) call closesocket SOCKET_ERROR = IF call WSAGetLastError ELSE 0 THEN ; : WriteSocket ( addr u s -- ior ) >r 0 swap rot r> \ 0 u addr s call send SOCKET_ERROR = IF call WSAGetLastError ELSE 0 THEN ; : SWrite ( addr u s -- wlen ) >r 0 swap rot r> \ 0 u addr s call send ; : WriteSocketLine ( addr u s -- ior ) DUP >R WriteSocket ?DUP IF R> DROP EXIT THEN crlf$ COUNT R> WriteSocket ; : WriteSocketCRLF ( s -- ior ) HERE 0 ROT WriteSocketLine ; : ReadSocket ( addr u s -- rlen ior ) >r 0 swap rot r> \ 0 u addr s call recv DUP SOCKET_ERROR = IF call WSAGetLastError ELSE 0 THEN OVER 0= IF DROP -1002 THEN ( åñëè ïðèíÿòî 0, òî îáðûâ ñîåäèíåíèÿ ) ; : SRead ( addr u s -- r ) >r 0 swap rot r> \ 0 u addr s call recv ; CODE a>r@ ( a1 -- n1 ) mov ebx, 0 [ebx] next c; : GetHostName ( IP -- addr u ior ) >r PF_INET 4 rp@ call gethostbyaddr ?DUP IF A>R@ ASCIIZ> 0 ELSE HERE 0 call WSAGetLastError THEN r>drop ; : Get.Host.Name ( addr u -- addr u ior ) DROP call inet_addr GetHostName ; : zGetHostIP ( z" -- IP ior ) dup c@ [char] 0 [char] 9 between over and if call inet_addr 0 else dup if then call gethostbyname DUP IF 3 CELLS + A>R@ A>R@ A>R@ 0 ELSE call WSAGetLastError THEN then ; \ changed Samstag, Mai 15 2004 - 13:20 dbu create my-ip-addr-buf 256 allot 0 my-ip-addr-buf ! : my-ip-addr ( -- IP ) my-ip-addr-buf zGetHostIP drop ; : GetHostIP ( addr len -- IP ior ) RP@ 265 - RP! RP@ 265 ERASE RP@ SWAP 265 UMIN CMOVE RP@ zGetHostIP RP@ 265 + RP! ; CREATE sock_addr2 HERE /sockaddr_in DUP ALLOT ERASE AF_INET sock_addr2 sin_family W! : GetPeerName ( s -- addr u ior ) /sockaddr_in >r rp@ sock_addr2 ROT call getpeername SOCKET_ERROR = IF HERE 0 call WSAGetLastError ELSE sock_addr2 sin_addr @ GetHostName THEN r>drop ; : SocketsStartup ( -- ior ) HERE 257 call WSAStartup ; : SocketsCleanup ( -- ior ) call WSACleanup ; : BindSocket ( port s -- ior ) >R /sockaddr_in ALLOCATE ?DUP IF NIP R> DROP EXIT THEN >R 256 /MOD SWAP 256 * + R@ sin_port W! AF_INET R@ sin_family W! R@ 0 R@ sin_addr ! /sockaddr_in R> R> call bind SWAP FREE DROP SOCKET_ERROR = IF call WSAGetLastError ELSE 0 THEN ; : ListenSocket ( s -- ior ) 2 SWAP call listen SOCKET_ERROR = IF call WSAGetLastError ELSE 0 THEN ; CREATE SINLEN /sockaddr_in , : SOCKET-ACCEPT { ADDR ALEN FH -- s2 ior } &OF ALEN ADDR FH call accept DUP INVALID_SOCKET = IF call WSAGetLastError ELSE 0 THEN ; : #IP ( du -- 0 ) #S [CHAR] . HOLD 2DROP 0 ; : (.IP) ( IP -- addr u ) 0 256 UM/MOD 0 256 UM/MOD 0 256 UM/MOD 0 <# \ 0 HOLD #IP #IP #IP #S #> ; : NtoA (.IP) ; : CLIENT-OPEN ( addr u port -- s ) >r GetHostIP abort" Server not available " r> CreateSocket DROP DUP >r ConnectSocket abort" Can't connect " r> ; \s SocketsStartup [if] cr .( SocketsStartup error) abort [then] create my-ip-name cr my-ip-addr cr dup NtoA type GetHostName drop space type \ dup 1+ allot my-ip-name place \s |
|
From: Ezra B. <ezr...@us...> - 2006-12-31 11:56:10
|
Update of /cvsroot/win32forth/win32forth/doc/ForthForm In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv11801/doc/ForthForm Modified Files: FF-Creating a Form.htm FF-History.htm Log Message: ForthForm updates. EAB Index: FF-Creating a Form.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/ForthForm/FF-Creating a Form.htm,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** FF-Creating a Form.htm 27 Dec 2006 18:34:29 -0000 1.4 --- FF-Creating a Form.htm 31 Dec 2006 11:56:07 -0000 1.5 *************** *** 35,41 **** to select the desired controls, indicated by a dashed-line box ( controls are considered selected if their top left corner falls inside the box ). Right click anywhere on the form and select "Group Action" from the menu. Select desired operation from the "Group Action" dialog. Below is an ! example form with four label controls selected. ! <p align="center"><img src="FF-GroupExample.gif" width="501" height="332" alt="" border="0"> <p> The Group Action dialog is shown below. The designated function for each button should be self-explanatory. However, --- 35,46 ---- to select the desired controls, indicated by a dashed-line box ( controls are considered selected if their top left corner falls inside the box ). Right click anywhere on the form and select "Group Action" from the menu. Select desired operation from the "Group Action" dialog. Below is an ! example form with four label controls selected.<br> ! <p align="center"><img src="FF-GroupExample.gif" width="501" height="332" alt="" border="0"><br clear="LEFT"></p> ! ! The dimensions of the selection box can be fine tuned by using the arrow keys (up, down, left, right). ! These keys increase the area of the selection box only. This can be useful in the instance where ! selected controls are moved outside the selection box. By adjusting the box these controls can ! once again be adjusted.<br><br> <p> The Group Action dialog is shown below. The designated function for each button should be self-explanatory. However, Index: FF-History.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/ForthForm/FF-History.htm,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** FF-History.htm 27 Dec 2006 18:34:30 -0000 1.6 --- FF-History.htm 31 Dec 2006 11:56:07 -0000 1.7 *************** *** 27,30 **** --- 27,34 ---- <P ALIGN=LEFT> + <b>Saturday, December 30 2006</b> - Implemented a little mechanism to use the arrow keys when + adjusting controls. For those times when you've selected controls and then moved them out of + the box. Just use the arrow keys to resize the box instead of redrawing it.<br><br> + <b>Sunday, December 24 2006</b> - In the past week or so got around to enhancing the toolbar design tool. After a whole year even! Ah well, better late than never!<br><br> *************** *** 273,277 **** <b>December 05, 2003 10:50:12 PM</b> - Added ChangeControl ! to menu. Allows the changing of control type e.g radiobox to checkbox. To change a control first select the control, check the type to change to in the toolbar and then select 'Change' from the --- 277,281 ---- <b>December 05, 2003 10:50:12 PM</b> - Added ChangeControl ! to menu. Allows the changing<BR>of control type e.g radiobox to checkbox. To change a control first select the control, check the type to change to in the toolbar and then select 'Change' from the |
|
From: Ezra B. <ezr...@us...> - 2006-12-31 11:55:25
|
Update of /cvsroot/win32forth/win32forth/apps/ForthForm In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv11395/apps/ForthForm Modified Files: FORMOBJECT.F Log Message: ForthForm updates. EAB Index: FORMOBJECT.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FORMOBJECT.F,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** FORMOBJECT.F 27 Dec 2006 18:43:57 -0000 1.15 --- FORMOBJECT.F 31 Dec 2006 11:55:17 -0000 1.16 *************** *** 749,752 **** --- 749,772 ---- then ; + : adjust-left ( -- ) + selecting? not ?exit + Left: FormBox 1- Top: FormBox Right: FormBox Bottom: FormBox + SetRect: FormBox Paint: self ; + + : adjust-right ( -- ) + selecting? not ?exit + Left: FormBox Top: FormBox Right: FormBox 1+ Bottom: FormBox + SetRect: FormBox Paint: self ; + + : adjust-up ( -- ) + selecting? not ?exit + Left: FormBox Top: FormBox 1- Right: FormBox Bottom: FormBox + SetRect: FormBox Paint: self ; + + : adjust-down ( -- ) + selecting? not ?exit + Left: FormBox Top: FormBox Right: FormBox Bottom: FormBox 1+ + SetRect: FormBox Paint: self ; + : sizebottomright { \ l t r b -- } ActiveControl 0= ?exit *************** *** 1306,1309 **** --- 1326,1333 ---- ( Ctrl-W ) 'W' +k_control of doWrite endof K_DELETE of dodelete endof + K_LEFT of adjust-left endof + K_RIGHT of adjust-right endof + K_UP of adjust-up endof + K_DOWN of adjust-down endof K_F12 of K_F12 PushKey: TheMainWindow endof K_F1 of K_F1 PushKey: TheMainWindow endof |
Update of /cvsroot/win32forth/win32forth/apps/ForthForm In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv14461/apps/ForthForm Modified Files: ABOUT.F CONTROLPROPERTYII.ff CreateMenu.f CreatePropertyForm.f CreateToolBar.f CreateToolBarForm.ff EXAMPLE.F FORMCONTROLS.F FORMOBJECT.F FORMPROPERTY.F FORMPROPERTY.ff FORMTOOLBAR.F FORTHFORM.F FormHelp.f FormMenu.f FormPad.f Forms.frm PREFERENCES.ff RECT.F SplitterWindow.f TABORDER.F TESTEXAMPLE.F Added Files: EXAMPLEII.ff EXAMPLEII.frm ExampleII.f FormMonitor.f JoinStr.f New Files.txt Splitter1.f Splitter2.f Splitter3.f Splitter4.f Splitter5.f Splitter6.f Log Message: ForthForm updates. EAB --- NEW FILE: Splitter5.f --- \ ForthForm generated splitter-window template \ Modify according to your needs :Object TopPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Top Pane" Textout: dc ;M ;Object :Object BottomLeftPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Bottom Left Pane" Textout: dc ;M ;Object :Object BottomRightPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Bottom Right Pane" Textout: dc ;M ;Object \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Bar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ COLOR_BTNFACE Call GetSysColor new-color BTNFACE :Class SplitterBar <Super child-window :M WindowStyle: ( -- style ) \ return the window style WindowStyle: super [ WS_DISABLED WS_CLIPSIBLINGS or ] literal or ;M :M On_Paint: ( -- ) \ screen redraw method 0 0 Width Height BTNFACE FillArea: dc ;M :M On_Init: ( -- ) \ Remove CS_HREDRAW and CS_VREDRAW styles from all instances of \ class Child-Window to prevent flicker in window on sizing. CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop ;M ;Class SplitterBar SplitterH SplitterBar SplitterV \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 0 value ToolBarHeight \ set to height of toolbar if any 0 value StatusBarHeight \ set to height of status bar if any 200 value TopHeight 150 value LeftWidth 5 value ThicknessH 5 value ThicknessV :Object SplitterWindow <Super Window int dragging int mousedown : RightXpos ( -- n ) LeftWidth ThicknessV + ; : RightWidth ( -- n ) Width RightXpos - ; : SplitterYpos ( -- n ) ToolBarHeight TopHeight + ; : BottomYpos ( -- n ) SplitterYpos ThicknessH + ; : StatusBarYpos ( -- n ) height StatusbarHeight - ; : BottomHeight ( -- n ) StatusBarYpos BottomYpos - ; : TotalHeight ( -- n ) StatusBarYpos ToolBarHeight - ; : LeftWidthMin ( -- n ) LeftWidth width min ; : TopHeightMin ( -- n ) TopHeight TotalHeight min ; : position-windows ( -- ) 0 ToolBarHeight Width TopHeightMin Move: TopPane 0 BottomYpos LeftWidthMin BottomHeight Move: BottomLeftPane RightXpos BottomYpos RightWidth BottomHeight Move: BottomRightPane LeftWidth BottomYpos ThicknessV BottomHeight Move: SplitterV 0 SplitterYpos Width ThicknessH Move: SplitterH ; : Splitter ( -- n ) \ the splitter window the cursor is on hWnd get-mouse-xy dup ToolBarHeight StatusBarYpos within IF 2dup BottomYpos height within swap LeftWidth RightXpos within and IF 2drop 1 ELSE SplitterYpos BottomYpos within swap 0 width within and IF 2 ELSE 0 THEN THEN ELSE 2drop 0 THEN ; : On_Tracking ( -- ) \ set min and max values of LeftWidth and TopHeight here mousedown dragging or 0= ?EXIT dragging Case 1 of mousex 0max width min thicknessV 2/ - to LeftWidth endof 2 of mousey ToolBarHeight - 0max TotalHeight min thicknessH 2/ - to TopHeight endof EndCase position-windows WINPAUSE ; : On_Clicked ( -- ) mousedown not IF hWnd Call SetCapture drop THEN true to mousedown Splitter to dragging On_Tracking ; : On_Unclicked ( -- ) mousedown IF Call ReleaseCapture drop THEN false to mousedown false to dragging ; : On_DblClick ( -- ) false to mousedown Splitter 1 = IF LeftWidth 8 > IF 0 thicknessV 2/ - to LeftWidth ELSE Width thicknessV - 2/ to LeftWidth THEN position-windows THEN ; :M WM_SETCURSOR ( h m w l -- ) Splitter Case 0 of DefWindowProc: self endof 1 of SIZEWE-CURSOR 1 endof 2 of SIZENS-CURSOR 1 endof EndCase ;M :M Classinit: ( -- ) ClassInit: super \ init super class ['] On_Clicked SetClickFunc: self ['] On_Unclicked SetUnClickFunc: self ['] On_Tracking SetTrackFunc: self ['] On_DblClick SetDblClickFunc: self ;M \ :M WindowHasMenu: ( -- f ) true ;M :M WindowStyle: ( -- style ) WindowStyle: Super WS_CLIPCHILDREN or ;M :M On_Size: ( -- ) position-windows ;M :M On_Init: ( -- ) \ prevent flicker in window on sizing CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop self Start: TopPane self Start: BottomLeftPane self Start: BottomRightPane self Start: SplitterH self Start: SplitterV ;M ;Object \ start: SplitterWindow --- NEW FILE: Splitter4.f --- \ ForthForm generated splitter-window template \ Modify according to your needs :Object TopLeftPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Top Left Pane" Textout: dc ;M ;Object :Object TopRightPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Top Right Pane" Textout: dc ;M ;Object :Object BottomLeftPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Bottom Left Pane" Textout: dc ;M ;Object :Object BottomRightPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Bottom Right Pane" Textout: dc ;M ;Object \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Bar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ COLOR_BTNFACE Call GetSysColor new-color BTNFACE :Class SplitterBar <Super child-window :M WindowStyle: ( -- style ) \ return the window style WindowStyle: super [ WS_DISABLED WS_CLIPSIBLINGS or ] literal or ;M :M On_Paint: ( -- ) \ screen redraw method 0 0 Width Height BTNFACE FillArea: dc ;M :M On_Init: ( -- ) \ Remove CS_HREDRAW and CS_VREDRAW styles from all instances of \ class Child-Window to prevent flicker in window on sizing. CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop ;M ;Class SplitterBar SplitterH SplitterBar SplitterV \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 0 value ToolBarHeight \ set to height of toolbar if any 0 value StatusBarHeight \ set to height of status bar if any 200 value TopHeight 150 value LeftWidth 5 value ThicknessH 5 value ThicknessV :Object SplitterWindow <Super Window int dragging int mousedown : RightXpos ( -- n ) LeftWidth ThicknessV + ; : RightWidth ( -- n ) Width RightXpos - ; : SplitterYpos ( -- n ) ToolBarHeight TopHeight + ; : BottomYpos ( -- n ) SplitterYpos ThicknessH + ; : StatusBarYpos ( -- n ) height StatusbarHeight - ; : BottomHeight ( -- n ) StatusBarYpos BottomYpos - ; : TotalHeight ( -- n ) StatusBarYpos ToolBarHeight - ; : LeftWidthMin ( -- n ) LeftWidth width min ; : TopHeightMin ( -- n ) TopHeight TotalHeight min ; : position-windows ( -- ) 0 ToolBarHeight LeftWidthMin TopHeightMin Move: TopLeftPane RightXpos ToolBarHeight RightWidth TopHeightMin Move: TopRightPane 0 BottomYpos LeftWidthMin BottomHeight Move: BottomLeftPane RightXpos BottomYpos RightWidth BottomHeight Move: BottomRightPane LeftWidth ToolBarHeight ThicknessV TotalHeight Move: SplitterV 0 SplitterYpos Width ThicknessH Move: SplitterH ; : Splitter ( -- n ) \ the splitter window the cursor is on hWnd get-mouse-xy dup ToolBarHeight StatusBarYpos within IF 2dup SplitterYpos BottomYpos within swap 0 width within and IF 2drop 2 ELSE ToolBarHeight StatusBarYpos within swap LeftWidth RightXpos within and IF 1 ELSE 0 THEN THEN ELSE 2drop 0 THEN ; : On_Tracking ( -- ) \ set min and max values of LeftWidth and TopHeight here mousedown dragging or 0= ?EXIT dragging Case 1 of mousex 0max width min thicknessV 2/ - to LeftWidth endof 2 of mousey ToolBarHeight - 0max TotalHeight min thicknessH 2/ - to TopHeight endof EndCase position-windows WINPAUSE ; : On_Clicked ( -- ) mousedown not IF hWnd Call SetCapture drop THEN true to mousedown Splitter to dragging On_Tracking ; : On_Unclicked ( -- ) mousedown IF Call ReleaseCapture drop THEN false to mousedown false to dragging ; : On_DblClick ( -- ) false to mousedown Splitter 1 = IF LeftWidth 8 > IF 0 thicknessV 2/ - to LeftWidth ELSE Width thicknessV - 2/ to LeftWidth THEN position-windows THEN ; :M WM_SETCURSOR ( h m w l -- ) Splitter Case 0 of DefWindowProc: self endof 1 of SIZEWE-CURSOR 1 endof 2 of SIZENS-CURSOR 1 endof EndCase ;M :M Classinit: ( -- ) ClassInit: super \ init super class ['] On_Clicked SetClickFunc: self ['] On_Unclicked SetUnClickFunc: self ['] On_Tracking SetTrackFunc: self ['] On_DblClick SetDblClickFunc: self ;M \ :M WindowHasMenu: ( -- f ) true ;M :M WindowStyle: ( -- style ) WindowStyle: Super WS_CLIPCHILDREN or ;M :M On_Size: ( -- ) position-windows ;M :M On_Init: ( -- ) \ prevent flicker in window on sizing CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop self Start: TopLeftPane self Start: TopRightPane self Start: BottomLeftPane self Start: BottomRightPane self Start: SplitterH self Start: SplitterV ;M ;Object \ start: SplitterWindow Index: FormMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FormMenu.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** FormMenu.f 20 Nov 2006 14:18:17 -0000 1.3 --- FormMenu.f 27 Dec 2006 18:43:57 -0000 1.4 *************** *** 7,11 **** --- 7,13 ---- MenuItem "&Open\tCtrl+O" doOpen ; :MenuItem mnu_doform "&Edit properties" doForm ; + :MenuItem mnu_close "Close Active &Form" ActiveForm if ActiveForm doCloseForm then ; + :MenuItem mnu_closeall "&Close All" doCloseAllForms ; MenuSeparator *************** *** 47,52 **** :MenuItem mnu_psheet "&Property Form Template" doPropertyForm ; MenuSeparator ! MenuItem "SciEdit&Mdi" Start-SciEditMdi ; ! MenuItem "Project Manager " Start-ProjectManager ; MenuSeparator MenuItem "&Save Session" doSaveSession ; --- 49,54 ---- :MenuItem mnu_psheet "&Property Form Template" doPropertyForm ; MenuSeparator ! MenuItem "Win32Forth IDE" Start-Win32ForthIDE ; ! \ MenuItem "Project Manager " Start-ProjectManager ; MenuSeparator MenuItem "&Save Session" doSaveSession ; *************** *** 78,88 **** then ; : ?EnableToolbarItems { flag -- } ! flag IDC_SAVE ?ChangeButton ! flag IDC_COPY ?ChangeButton ! flag IDC_COMPILE ?ChangeButton ! flag IDC_TEST ?ChangeButton ! flag IDC_EDITOR ?ChangeButton ! flag IDC_SAVEALL ?ChangeButton flag IDC_SELECT ?ChangeButton flag IDC_BITMAP ?ChangeButton --- 80,96 ---- then ; + : ?ChangeMainButton { flag id -- } \ if button with id is on bar perform flag operation + id CommandToIndex: TheMainToolbar 0< not \ -1 if not on bar + if flag id EnableButton: TheMainToolbar + then ; + + : ?EnableToolbarItems { flag -- } ! flag IDC_SAVE ?ChangeMainButton ! flag IDC_COPY ?ChangeMainButton ! flag IDC_COMPILE ?ChangeMainButton ! flag IDC_TEST ?ChangeMainButton ! flag IDC_EDITOR ?ChangeMainButton ! flag IDC_SAVEALL ?ChangeMainButton flag IDC_SELECT ?ChangeButton flag IDC_BITMAP ?ChangeButton *************** *** 133,143 **** dup Enable: mnu_bringfront dup Enable: mnu_moveback ! dup IDC_BACK ?ChangeButton ! dup IDC_FRONT ?ChangeButton ! dup IDC_DELETE ?ChangeButton ! IDC_TAB ?ChangeButton GetHandle: FFHelpwindow 0= dup Enable: mnu_hlp ! dup IDC_HELP ?ChangeButton not Enable: mnu_nohlp ; ' EnableMenuItems is UpdateSystem --- 141,151 ---- dup Enable: mnu_bringfront dup Enable: mnu_moveback ! dup IDC_BACK ?ChangeMainButton ! dup IDC_FRONT ?ChangeMainButton ! dup IDC_DELETE ?ChangeMainButton ! IDC_TAB ?ChangeMainButton GetHandle: FFHelpwindow 0= dup Enable: mnu_hlp ! dup IDC_HELP ?ChangeMainButton not Enable: mnu_nohlp ; ' EnableMenuItems is UpdateSystem Index: CONTROLPROPERTYII.ff =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/CONTROLPROPERTYII.ff,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 Binary files /tmp/cvsMQV4VQ and /tmp/cvssHOXDo differ Index: TABORDER.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/TABORDER.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** TABORDER.F 21 Dec 2004 00:18:45 -0000 1.1 --- TABORDER.F 27 Dec 2006 18:43:57 -0000 1.2 *************** *** 45,49 **** : UpTabList ( -- ) \ shift one up in list GetCurrent: TabList ?dup \ if not the first selection ! if dup>r GetString: TabList r@ DeleteString: TabList r@ dup 1- memswap \ order listbuffer --- 45,49 ---- : UpTabList ( -- ) \ shift one up in list GetCurrent: TabList ?dup \ if not the first selection ! if dup>r GetString: TabList r@ DeleteString: TabList r@ dup 1- memswap \ order listbuffer *************** *** 57,61 **** GetCurrent: TabList to cursel GetCount: TabList to cnt cursel cnt 1- 0max <> \ if not at end of list ! if cursel GetString: TabList cursel DeleteString: TabList cursel dup 1+ memswap \ order listbuffer --- 57,61 ---- GetCurrent: TabList to cursel GetCount: TabList to cnt cursel cnt 1- 0max <> \ if not at end of list ! if cursel GetString: TabList cursel DeleteString: TabList cursel dup 1+ memswap \ order listbuffer *************** *** 100,104 **** Call InitCommonControls drop ! Create: WinFont scrlup usebitmap \ create bitmap handle --- 100,104 ---- Call InitCommonControls drop ! Create: WinFont drop scrlup usebitmap \ create bitmap handle --- NEW FILE: Splitter2.f --- \ ForthForm generated splitter-window template \ Modify according to your needs :Object TopPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Top Pane" Textout: dc ;M ;Object :Object BottomPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Bottom Pane" Textout: dc ;M ;Object \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Bar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ COLOR_BTNFACE Call GetSysColor new-color BTNFACE :Class SplitterBar <Super child-window :M WindowStyle: ( -- style ) \ return the window style WindowStyle: super [ WS_DISABLED WS_CLIPSIBLINGS or ] literal or ;M :M On_Paint: ( -- ) \ screen redraw method 0 0 Width Height BTNFACE FillArea: dc ;M :M On_Init: ( -- ) \ Remove CS_HREDRAW and CS_VREDRAW styles from all instances of \ class Child-Window to prevent flicker in window on sizing. CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop ;M ;Class SplitterBar SplitterH \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 0 value ToolBarHeight \ set to height of toolbar if any 0 value StatusBarHeight \ set to height of status bar if any 200 value TopHeight 5 value ThicknessH :Object SplitterWindow <Super Window int dragging int mousedown : SplitterYpos ( -- n ) ToolBarHeight TopHeight + ; : BottomYpos ( -- n ) SplitterYpos ThicknessH + ; : StatusBarYpos ( -- n ) height StatusbarHeight - ; : BottomHeight ( -- n ) StatusBarYpos BottomYpos - ; : TotalHeight ( -- n ) StatusBarYpos ToolBarHeight - ; : TopHeightMin ( -- n ) TopHeight TotalHeight min ; : position-windows ( -- ) 0 ToolBarHeight Width TopHeightMin Move: TopPane 0 BottomYpos Width BottomHeight Move: BottomPane 0 SplitterYpos Width ThicknessH Move: SplitterH ; : Splitter ( -- n ) \ the splitter window the cursor is on hWnd get-mouse-xy dup ToolBarHeight StatusBarYpos within IF SplitterYpos BottomYpos within swap 0 width within and IF 1 ELSE 0 THEN ELSE 2drop 0 THEN ; : On_Tracking ( -- ) \ set min and max values of TopHeight here mousedown dragging or 0= ?EXIT dragging IF mousey ToolBarHeight - 0max TotalHeight min thicknessH 2/ - to TopHeight THEN position-windows WINPAUSE ; : On_Clicked ( -- ) mousedown not IF hWnd Call SetCapture drop THEN true to mousedown Splitter to dragging On_Tracking ; : On_Unclicked ( -- ) mousedown IF Call ReleaseCapture drop THEN false to mousedown false to dragging ; : On_DblClick ( -- ) false to mousedown Splitter 1 = IF TopHeight 8 > IF 0 thicknessH 2/ - to TopHeight ELSE TopHeight BottomHeight + thicknessH - 2/ to TopHeight THEN position-windows THEN ; :M WM_SETCURSOR ( h m w l -- ) Splitter Case 0 of DefWindowProc: self endof 1 of SIZENS-CURSOR 1 endof EndCase ;M :M Classinit: ( -- ) ClassInit: super \ init super class ['] On_Clicked SetClickFunc: self ['] On_Unclicked SetUnClickFunc: self ['] On_Tracking SetTrackFunc: self ['] On_DblClick SetDblClickFunc: self ;M \ :M WindowHasMenu: ( -- f ) true ;M :M WindowStyle: ( -- style ) WindowStyle: Super WS_CLIPCHILDREN or ;M :M On_Size: ( -- ) position-windows ;M :M On_Init: ( -- ) \ prevent flicker in window on sizing CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop self Start: TopPane self Start: BottomPane self Start: SplitterH ;M ;Object \ start: SplitterWindow Index: Forms.frm =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/Forms.frm,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** Forms.frm 1 Nov 2005 23:14:04 -0000 1.4 --- Forms.frm 27 Dec 2006 18:43:57 -0000 1.5 *************** *** 33,41 **** \ 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 --- 33,41 ---- [...1541 lines suppressed...] *** 1815,1819 **** s" MS Sans Serif" SetFaceName: WinFont 8 Width: WinFont ! Create: WinFont \ set form color to system color --- 2051,2055 ---- s" MS Sans Serif" SetFaceName: WinFont 8 Width: WinFont ! Create: WinFont \ set form color to system color *************** *** 1828,1832 **** self Start: radTest 221 32 103 21 Move: radTest - WS_GROUP +Style: radTest Handle: Winfont SetFont: radTest s" Test" SetText: radTest --- 2064,2067 ---- --- NEW FILE: Splitter6.f --- \ ForthForm generated splitter-window template \ Modify according to your needs :Object TopLeftPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Top Left Pane" Textout: dc ;M ;Object :Object TopRightPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Top Right Pane" Textout: dc ;M ;Object :Object BottomPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Bottom Pane" Textout: dc ;M ;Object \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Bar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ COLOR_BTNFACE Call GetSysColor new-color BTNFACE :Class SplitterBar <Super child-window :M WindowStyle: ( -- style ) \ return the window style WindowStyle: super [ WS_DISABLED WS_CLIPSIBLINGS or ] literal or ;M :M On_Paint: ( -- ) \ screen redraw method 0 0 Width Height BTNFACE FillArea: dc ;M :M On_Init: ( -- ) \ Remove CS_HREDRAW and CS_VREDRAW styles from all instances of \ class Child-Window to prevent flicker in window on sizing. CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop ;M ;Class SplitterBar SplitterH SplitterBar SplitterV \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 0 value ToolBarHeight \ set to height of toolbar if any 0 value StatusBarHeight \ set to height of status bar if any 200 value TopHeight 150 value LeftWidth 5 value ThicknessH 5 value ThicknessV :Object SplitterWindow <Super Window int dragging int mousedown : RightXpos ( -- n ) LeftWidth ThicknessV + ; : RightWidth ( -- n ) Width RightXpos - ; : SplitterYpos ( -- n ) ToolBarHeight TopHeight + ; : BottomYpos ( -- n ) SplitterYpos ThicknessH + ; : StatusBarYpos ( -- n ) height StatusbarHeight - ; : BottomHeight ( -- n ) StatusBarYpos BottomYpos - ; : TotalHeight ( -- n ) StatusBarYpos ToolBarHeight - ; : LeftWidthMin ( -- n ) LeftWidth width min ; : TopHeightMin ( -- n ) TopHeight TotalHeight min ; : position-windows ( -- ) 0 ToolBarHeight LeftWidthMin TopHeightMin Move: TopLeftPane RightXpos ToolBarHeight RightWidth TopHeightMin Move: TopRightPane 0 BottomYpos Width BottomHeight Move: BottomPane LeftWidth ToolBarHeight ThicknessV TopHeight Move: SplitterV 0 SplitterYpos Width ThicknessH Move: SplitterH ; : Splitter ( -- n ) \ the splitter window the cursor is on hWnd get-mouse-xy dup ToolBarHeight StatusBarYpos within IF 2dup ToolBarHeight SplitterYpos within swap LeftWidth RightXpos within and IF 2drop 1 ELSE SplitterYpos BottomYpos within swap 0 width within and IF 2 ELSE 0 THEN THEN ELSE 2drop 0 THEN ; : On_Tracking ( -- ) \ set min and max values of LeftWidth and TopHeight here mousedown dragging or 0= ?EXIT dragging Case 1 of mousex 0max width min thicknessV 2/ - to LeftWidth endof 2 of mousey ToolBarHeight - 0max TotalHeight min thicknessH 2/ - to TopHeight endof EndCase position-windows WINPAUSE ; : On_Clicked ( -- ) mousedown not IF hWnd Call SetCapture drop THEN true to mousedown Splitter to dragging On_Tracking ; : On_Unclicked ( -- ) mousedown IF Call ReleaseCapture drop THEN false to mousedown false to dragging ; : On_DblClick ( -- ) false to mousedown Splitter 1 = IF LeftWidth 8 > IF 0 thicknessV 2/ - to LeftWidth ELSE Width thicknessV - 2/ to LeftWidth THEN position-windows THEN ; :M WM_SETCURSOR ( h m w l -- ) Splitter Case 0 of DefWindowProc: self endof 1 of SIZEWE-CURSOR 1 endof 2 of SIZENS-CURSOR 1 endof EndCase ;M :M Classinit: ( -- ) ClassInit: super \ init super class ['] On_Clicked SetClickFunc: self ['] On_Unclicked SetUnClickFunc: self ['] On_Tracking SetTrackFunc: self ['] On_DblClick SetDblClickFunc: self ;M \ :M WindowHasMenu: ( -- f ) true ;M :M WindowStyle: ( -- style ) WindowStyle: Super WS_CLIPCHILDREN or ;M :M On_Size: ( -- ) position-windows ;M :M On_Init: ( -- ) \ prevent flicker in window on sizing CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop self Start: TopLeftPane self Start: TopRightPane self Start: BottomPane self Start: SplitterH self Start: SplitterV ;M ;Object \ start: SplitterWindow Index: FORMPROPERTY.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FORMPROPERTY.F,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** FORMPROPERTY.F 1 Nov 2005 23:14:04 -0000 1.4 --- FORMPROPERTY.F 27 Dec 2006 18:43:57 -0000 1.5 *************** *** 13,21 **** 0 value eActiveControl 0 value eActiveForm \ current form, not necessarily the ActiveForm ! /* ! : InhibitPropertyWindow ( -- ) ! frmEditProperties.hwnd 0= ?exit ! Close: frmEditProperties ; ! */ : IsTypeButton? { \ ctrltype -- f } GetType: eActiveControl to ctrltype --- 13,17 ---- 0 value eActiveControl 0 value eActiveForm \ current form, not necessarily the ActiveForm ! : IsTypeButton? { \ ctrltype -- f } GetType: eActiveControl to ctrltype *************** *** 30,52 **** \ Justification is invalid for some controls so we disable this feature if the control \ is a textbox, listbox or combobox ! GetType: eActiveControl dup>r ! TypeTextBox = ! r@ TypeListBox = or ! r@ TypeComboBox = or ! r@ TypeComboListBox = or ! r@ TypeHorizScroll = or ! r@ TypeVertScroll = or ! r> TypeMultiListBox = or dup not ! dup Enable: radLeft dup Enable: radCenter dup Enable: radRight dup Enable: radLefttext ! Enable: grpOrientation ; : LoadProperties ( -- ) GetName: eActiveControl SetText: txtName GetTitle: eActiveControl SetText: txtCaption ! Origin: eActiveControl (.) SetText: txtYpos (.) SetText: txtXpos ! Dimensions: eActiveControl (.) SetText: txtHeight (.) SetText: txtWidth GetToolTip: eActiveControl SetText: txtToolTip GetBitmap: eActiveControl SetText: txtBitmap --- 26,58 ---- \ Justification is invalid for some controls so we disable this feature if the control \ is a textbox, listbox or combobox ! GetType: eActiveControl ! | TypeTextBox ! TypeListBox ! TypeComboBox ! TypeComboListBox ! TypeHorizScroll ! TypeVertScroll ! TypeMultiListBox ! TypeFileWindow ! TypeTabControl ! |if false ! else true ! then dup Enable: radLeft dup Enable: radCenter dup Enable: radRight dup Enable: radLefttext ! dup Enable: grpOrientation ; ! ! : ?EnableSpinner ( -- ) ! GetType: eActiveControl TypeTextBox = dup Enable: chkSpinner ! if Spinner?: eActiveControl ! else false ! then Check: chkSpinner ; : LoadProperties ( -- ) GetName: eActiveControl SetText: txtName GetTitle: eActiveControl SetText: txtCaption ! Origin: eActiveControl SetValue: spnYpos SetValue: spnXpos ! Dimensions: eActiveControl SetValue: spnHeight SetValue: spnWidth GetToolTip: eActiveControl SetText: txtToolTip GetBitmap: eActiveControl SetText: txtBitmap *************** *** 55,58 **** --- 61,65 ---- Group?: eActiveControl Check: chkGroup Global?: eActiveControl Check: chkGlobal + ?EnableSpinner GetType: eActiveControl dup TypeBitmapButton = swap TypeStaticBitmap = or *************** *** 69,73 **** UnCheckButton: radRight UnCheckButton: radLeftText ! CheckTypeText 0= \ if it is a valid control if Orientation: eActiveControl case --- 76,80 ---- UnCheckButton: radRight UnCheckButton: radLeftText ! CheckTypeText \ if it is a valid control if Orientation: eActiveControl case *************** *** 90,101 **** GetText: txtName SetName: eActiveControl GetText: txtCaption SetTitle: eActiveControl ! GetText: txtXpos number? ! if drop else x then \ don't change if error ! GetText: txtYpos number? ! if drop else y then SetOrigin: eActiveControl ! GetText: txtwidth number? ! if drop else w then ! GetText: txtHeight number? ! if drop else h then SetDimensions: eActiveControl GetText: txtTooltip IsTooltip: eActiveControl GetType: eActiveControl dup --- 97,102 ---- GetText: txtName SetName: eActiveControl GetText: txtCaption SetTitle: eActiveControl ! GetValue: spnXpos GetValue: spnYpos SetOrigin: eActiveControl ! GetValue: spnWidth GetValue: spnHeight SetDimensions: eActiveControl GetText: txtTooltip IsTooltip: eActiveControl GetType: eActiveControl dup *************** *** 104,108 **** then IsButtonChecked?: chkGroup IsGroup: eActiveControl IsButtonChecked?: chkGlobal IsGlobal: eActiveControl ! \ justification IsTypeButton? --- 105,111 ---- then IsButtonChecked?: chkGroup IsGroup: eActiveControl IsButtonChecked?: chkGlobal IsGlobal: eActiveControl ! GetType: eActiveControl TypeTextBox = ! if IsButtonChecked?: chkSpinner IsSpinner: eActiveControl ! then \ justification IsTypeButton? *************** *** 119,123 **** then then IsOrientation: eActiveControl ! then Ismodified: eActiveForm \ update Update: eActiveControl \ everything UpdateStatus: eActiveForm \ at this time --- 122,127 ---- then then IsOrientation: eActiveControl ! then Validate: eActiveForm \ update ! Ismodified: eActiveForm \ and check Update: eActiveControl \ everything UpdateStatus: eActiveForm \ at this time *************** *** 190,197 **** FormName: ActiveForm count SetText: txtName FormTitle: ActiveForm count SetText: txtTitle ! Origin: ActiveForm (.) SetText: txtYpos ! (.) SetText: txtXpos ! Dimensions: ActiveForm (.) SetText: txtHeight ! (.) SetText: txtWidth GetModal: ActiveForm Check: ChkModal SaveScreen?: ActiveForm Check: chkSave --- 194,201 ---- FormName: ActiveForm count SetText: txtName FormTitle: ActiveForm count SetText: txtTitle ! Origin: ActiveForm SetValue: spnYpos ! SetValue: spnXpos ! Dimensions: ActiveForm SetValue: spnHeight ! SetValue: spnWidth GetModal: ActiveForm Check: ChkModal SaveScreen?: ActiveForm Check: chkSave *************** *** 221,232 **** GetText: txtName IsFormName: ActiveForm GetText: txtTitle IsFormTitle: ActiveForm ! GetText: txtXpos number? ! if drop else x then \ if invalid number reuse old value ! GetText: txtYpos number? ! if drop else y then SetOrigin: ActiveForm ! GetText: txtWidth number? ! if drop else w then ! GetText: txtHeight number? ! if drop else h then SetDimensions: ActiveForm IsButtonChecked?: chkModal SetModal: ActiveForm IsButtonChecked?: chkSave IsSaveScreen?: ActiveForm --- 225,230 ---- GetText: txtName IsFormName: ActiveForm GetText: txtTitle IsFormTitle: ActiveForm ! GetValue: spnXpos GetValue: spnYpos SetOrigin: ActiveForm ! GetValue: spnWidth GetValue: spnHeight SetDimensions: ActiveForm IsButtonChecked?: chkModal SetModal: ActiveForm IsButtonChecked?: chkSave IsSaveScreen?: ActiveForm *************** *** 250,253 **** --- 248,252 ---- GetHandle: ActiveForm AdjustWindowSize FormTitle: ActiveForm count Settext: ActiveForm + Validate: ActiveForm \ check everything is ok IsModified: ActiveForm DoUpdate *************** *** 263,272 **** :M On_Init: ( -- ) - - ES_NUMBER dup AddStyle: txtXPos - dup AddStyle: txtYPos - dup AddStyle: txtWidth - AddStyle: txtHeight - On_Init: super --- 262,265 ---- *************** *** 366,375 **** ['] PropertyFunc SetCommand: frmEditProperties - \ set these controls to accept only numbers - ES_NUMBER - dup AddStyle: txtXpos - dup AddStyle: txtYPos - dup AddStyle: txtWidth - AddStyle: txtHeight Addr: TabProperties Start: frmEditProperties ClientSize: TabProperties 2over d- Move: frmEditProperties --- 359,362 ---- *************** *** 384,387 **** --- 371,379 ---- 0 Addr: TabProperties ontab ;M + + :M ClassInit: ( -- ) + ClassInit: Super + self link-formwindow + ;M ;Object *************** *** 394,398 **** :Noname ( -- ) \ edit form properties ActiveForm 0= ?exit ! GetHandle: TheMainWindow SetParent: frmProperties++ Start: frmProperties++ 0 ShowTab: frmProperties++ \ show the form tab --- 386,390 ---- :Noname ( -- ) \ edit form properties ActiveForm 0= ?exit ! GetHandle: TheMainWindow SetParentWindow: frmProperties++ Start: frmProperties++ 0 ShowTab: frmProperties++ \ show the form tab *************** *** 401,405 **** :Noname ( -- ) \ edit control properties ActiveForm 0= ?exit ! GetHandle: TheMainWindow SetParent: frmProperties++ Start: frmProperties++ 1 ShowTab: frmProperties++ \ show the control tab --- 393,397 ---- :Noname ( -- ) \ edit control properties ActiveForm 0= ?exit ! GetHandle: TheMainWindow SetParentWindow: frmProperties++ Start: frmProperties++ 1 ShowTab: frmProperties++ \ show the control tab *************** *** 408,412 **** :Noname ( -- ) \ multiple action on controls ActiveForm 0= ?exit ! GetHandle: TheMainWindow SetParent: frmProperties++ Start: frmProperties++ 2 ShowTab: frmProperties++ \ show the action tab --- 400,404 ---- :Noname ( -- ) \ multiple action on controls ActiveForm 0= ?exit ! GetHandle: TheMainWindow SetParentWindow: frmProperties++ Start: frmProperties++ 2 ShowTab: frmProperties++ \ show the action tab --- NEW FILE: Splitter1.f --- \ ForthForm generated splitter-window template \ Modify according to your needs :Object LeftPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Left Pane" Textout: dc ;M ;Object :Object RightPane <Super Child-Window :M ExWindowStyle: ( -- style ) ExWindowStyle: Super WS_EX_CLIENTEDGE or ;M :M On_Paint: ( -- ) 0 0 Width Height white FillArea: dc 0 0 s" Right Pane" Textout: dc ;M ;Object \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Bar \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ COLOR_BTNFACE Call GetSysColor new-color BTNFACE :Class SplitterBar <Super child-window :M WindowStyle: ( -- style ) \ return the window style WindowStyle: super [ WS_DISABLED WS_CLIPSIBLINGS or ] literal or ;M :M On_Paint: ( -- ) \ screen redraw method 0 0 Width Height BTNFACE FillArea: dc ;M :M On_Init: ( -- ) \ Remove CS_HREDRAW and CS_VREDRAW styles from all instances of \ class Child-Window to prevent flicker in window on sizing. CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop ;M ;Class SplitterBar SplitterV \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Splitter Window - the main window \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 0 value ToolBarHeight \ set to height of toolbar if any 0 value StatusBarHeight \ set to height of status bar if any 150 value LeftWidth 5 value ThicknessV :Object SplitterWindow <Super Window int dragging int mousedown : RightXpos ( -- n ) LeftWidth ThicknessV + ; : RightWidth ( -- n ) Width RightXpos - ; : LeftWidthMin ( -- n ) LeftWidth width min ; : StatusBarYpos ( -- n ) height StatusbarHeight - ; : TotalHeight ( -- n ) Height ToolBarHeight - StatusBarHeight - ; : position-windows ( -- ) 0 ToolBarHeight LeftWidthMin TotalHeight Move: LeftPane RightXpos ToolBarHeight RightWidth TotalHeight Move: RightPane LeftWidth ToolBarHeight ThicknessV TotalHeight Move: SplitterV ; : Splitter ( -- n ) \ the splitter window the cursor is on hWnd get-mouse-xy ToolBarHeight StatusBarYpos within swap LeftWidth RightXpos within and IF 1 ELSE 0 THEN ; : On_Tracking ( -- ) \ set min and max values of LeftWidth here mousedown dragging or 0= ?EXIT dragging IF mousex 0max width min thicknessV 2/ - to LeftWidth THEN position-windows WINPAUSE ; : On_Clicked ( -- ) mousedown not IF hWnd Call SetCapture drop THEN true to mousedown Splitter to dragging On_Tracking ; : On_Unclicked ( -- ) mousedown IF Call ReleaseCapture drop THEN false to mousedown false to dragging ; : On_DblClick ( -- ) false to mousedown Splitter 1 = IF LeftWidth 8 > IF 0 thicknessV 2/ - to LeftWidth ELSE Width thicknessV - 2/ to LeftWidth THEN position-windows THEN ; :M WM_SETCURSOR ( h m w l -- ) Splitter Case 0 of DefWindowProc: self endof 1 of SIZEWE-CURSOR 1 endof EndCase ;M :M Classinit: ( -- ) ClassInit: super \ init super class ['] On_Clicked SetClickFunc: self ['] On_Unclicked SetUnClickFunc: self ['] On_Tracking SetTrackFunc: self ['] On_DblClick SetDblClickFunc: self ;M \ :M WindowHasMenu: ( -- f ) true ;M :M WindowStyle: ( -- style ) WindowStyle: Super WS_CLIPCHILDREN or ;M :M On_Size: ( -- ) position-windows ;M :M On_Init: ( -- ) \ prevent flicker in window on sizing CS_DBLCLKS GCL_STYLE hWnd Call SetClassLong drop self Start: LeftPane self Start: RightPane self Start: SplitterV ;M ;Object \ start: SplitterWindow --- NEW FILE: EXAMPLEII.frm --- \ EXAMPLE.FRM \- textbox needs excontrols.f \- -filelister.f needs filelister.f \ folder browser FileWindow dirbox TextBox txtpath PushButton btnDelete PushButton btnChoose PushButton btnClose ComboListBox CmbLstFilters :Object frmExample <Super DialogWindow Font WinFont \ default font ' 2drop value WmCommand-Func \ function pointer for WM_COMMAND ColorObject FrmColor \ the background color StatusBar TheStatusBar Label lblPath :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 ) hWndParent ;M :M SetParentWindow: ( hwndparent -- ) \ set owner window to hWndParent ;M :M WindowTitle: ( -- ztitle ) z" Example - Directory Viewer" ;M :M StartSize: ( -- width height ) 345 455 ;M :M StartPos: ( -- x y ) 150 175 ;M :M Close: ( -- ) Close: dirbox \ 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: TheStatusBar self Start: dirbox 8 37 225 358 Move: dirbox self Start: lblPath 9 9 72 19 Move: lblPath Handle: Winfont SetFont: lblPath s" Selected Path:" SetText: lblPath self Start: txtpath 83 9 247 21 Move: txtpath Handle: Winfont SetFont: txtpath self Start: btnDelete 239 40 100 25 Move: btnDelete Handle: Winfont SetFont: btnDelete s" &Delete File" SetText: btnDelete self Start: btnChoose 239 69 100 25 Move: btnChoose Handle: Winfont SetFont: btnChoose s" Choose &Folder" SetText: btnChoose self Start: btnClose 239 364 100 25 Move: btnClose Handle: Winfont SetFont: btnClose s" &Close" SetText: btnClose self Start: CmbLstFilters 8 401 224 20 Move: CmbLstFilters Handle: Winfont SetFont: CmbLstFilters ;M :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 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_Size: ( -- ) Redraw: TheStatusBar ;M :M On_Done: ( -- ) Delete: WinFont \ Insert your code here On_Done: super ;M ;Object Index: CreateToolBar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/CreateToolBar.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** CreateToolBar.f 20 Nov 2006 14:18:17 -0000 1.5 --- CreateToolBar.f 27 Dec 2006 18:43:57 -0000 1.6 *************** *** 2,11 **** \ needs CreateToolBarForm.frm 0 value DesignToolBar :Object PreviewWindow <Super Window - int &bitmap - max-path bytes BitmapFile BitmapObject TheBitmap dint xypos [...1409 lines suppressed...] ! GetID: btnMoveDown of movebuttondown endof ! GetID: btnFirst of firstbutton endof ! GetID: btnLast of lastbutton endof endcase 0 ;M + :M ParentWindow: ( -- hwndparent ) GetHandle: TheMainWindow ;M :M ToolBarName: ( -- addr cnt ) Name count ;M ! ;object :NoName ( -- ) Start: frmCreateToolBar ; is doCreateToolBar + + + \s --- NEW FILE: New Files.txt --- ( Note that this file is not intended for distribution. ) Added files for ForthForm 2.02.08 doc\forthform\FF-Toolbar Preview Window.gif doc\forthform\FF-Release Notes.htm apps\forthform\joinstr.f apps\forthform\splitter1.f apps\forthform\splitter2.f apps\forthform\splitter3.f apps\forthform\splitter4.f apps\forthform\splitter5.f apps\forthform\splitter6.f apps\forthform\formmonitor.f apps\forthform\exampleII.f apps\forthform\exampleII.ff apps\forthform\exampleII.frm Index: FORTHFORM.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FORTHFORM.F,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** FORTHFORM.F 2 Dec 2006 10:17:30 -0000 1.16 --- FORTHFORM.F 27 Dec 2006 18:43:57 -0000 1.17 *************** *** 29,33 **** needs file.f \ file functions encapsulated in a class needs caseEx.f \ extension to case and if ! needs sendmessage.f \ simple macro needs toolbar.f \ Windows toolbar class needs enum.f \ enumerated constants --- 29,33 ---- needs file.f \ file functions encapsulated in a class needs caseEx.f \ extension to case and if ! needs joinstr.f \ join any number of counted strings needs toolbar.f \ Windows toolbar class [...1033 lines suppressed...] ! ! \+ sysgen s" %DIRWin32ForthIDE.exe %FILENAME %LINE" editor$ place ! \+ sysgen s" %DIRWin32ForthIDE.exe /B %FILENAME %LINE" browse$ place \+ sysgen &forthdir count &appdir place \ create ForthForm.exe in the Win32Forth directory + \+ sysgen 0 0 ' ff application ForthForm.exe *************** *** 1249,1253 **** \+ sysgen 1 pause-seconds bye ! \- sysgen ff \s --- 1217,1221 ---- \+ sysgen 1 pause-seconds bye ! \- sysgen ff \s --- NEW FILE: FormMonitor.f --- \ FormMonitor.f :Object MiniWin <Super child-window int WasMoved? int wx int wy Point MyPoint :M ClassInit: ( -- ) ClassInit: super 0 to WasMoved? 0 to wx 0 to wy 1 to ID ;M :M WindowStyle: ( -- style ) WindowStyle: super WS_CAPTION or WS_BORDER or ;M :M WindowTitle: ( -- zstring ) z" Window" ;M :M StartSize: ( -- width height ) screen-size >r 10 / r> 10 / ;M :M StartPos: ( -- x y ) 0 0 ;M :M WM_MOVING ( h m w l -- ) true to WasMoved? DefWindowProc: self ;M \ WM_MOVE returns origin of window's client area only, but we are using the \ whole window as a replica : GetWindowXY ( -- x y ) GetWindowRect: self 2drop SetPoint: MyPoint AddrOf: MyPoint GetHandle: Parent Call ScreenToClient ?win-error MyPoint.x MyPoint.y ; :M WM_MOVE ( h m w l -- res ) wasMoved? if GetWindowXY 2dup to wy to wx WindowWasMoved: parent \ let parent know false to WasMoved? \ reset then WM_MOVE WM: Super \ send to super class ;M :M On_Paint: ( -- ) 0 0 GetSize: self WHITE FillArea: dc ;M ;Object :Object Monitor <Super Window Rect mBox :M ClassInit: ( -- ) ClassInit: super self link-formwindow ;M :M WindowStyle: ( -- style ) WS_OVERLAPPED WS_CAPTION or WS_DLGFRAME or ;M :M ExWindowStyle: ( -- exstyle ) ExWindowStyle: super WS_EX_TOOLWINDOW or ;M :M ParentWindow: ( -- parent | 0 if no parent ) GetHandle: TheMainWindow ;M :M WindowTitle: ( -- ztitle ) z" Monitor" ;M :M StartSize: ( -- width height ) screen-size 5 / swap 5 / swap ;M :M StartPos: ( -- x y ) MonitorLeft MonitorTop ;M :M Close: ( -- ) Close: MiniWin Close: super ;M :M On_Paint: ( -- ) 0 0 GetSize: self CYAN FillArea: dc 1 1 StartSize: self 1 1 d- SetRect: mBox addr: dc SetDC: mBox Red Green Sunken: mBox ;M : >screen-coord ( wx wy -- x y ) \ convert to screen coordinates for form screen-size StartSize: self { wx wy scrw scrh pw ph -- } scrw pw / wx * scrh ph / wy * ; : screen-coord> ( x y -- wx wy ) \ convert to form coordinates screen-size StartSize: self { x y scrw scrh pw ph -- } x scrw pw / / ( wx ) y scrh ph / / ( wy ) ; :M SetPosition: { x y -- } GetHandle: MiniWin 0= \ if not shown if self Start: MiniWin \ start it up then x y screen-coord> SetWindowPos: MiniWin ;M :M GetPosition: ( -- wx wy ) MiniWin.wx MiniWin.wy >screen-coord ;M :M Blank: ( -- ) Close: MiniWin ;M :M Update: ( -- ) ActiveForm if Origin: ActiveForm SetPosition: self FormTitle: ActiveForm count SetText: MiniWin then ;M :M WindowWasMoved: { x y -- } ActiveForm if Locked?: ActiveForm if Origin: ActiveForm SetPosition: self \ ignore move exitm then x y >screen-coord SetOrigin: ActiveForm IsModified: ActiveForm UpdateProperties++ then ;M :M PushKey: ( c -- ) Pushkey: TheMainWindow ;M ;Object : ?ShowMonitor ( -- ) ShowMonitor? if GetHandle: Monitor 0= if Start: Monitor then Update: Monitor else Close: Monitor then ; \s Index: EXAMPLE.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/EXAMPLE.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** EXAMPLE.F 21 Dec 2004 00:18:45 -0000 1.1 --- EXAMPLE.F 27 Dec 2006 18:43:57 -0000 1.2 *************** *** 21,25 **** Font WinFont - 0 value parent \ pointer to parent of form ' 2drop value OnWmCommand \ function pointer for WM_COMMAND --- 21,24 ---- *************** *** 33,36 **** --- 32,36 ---- RadioButton Radio1 Label Label6 + ColorObject FrmColor \ the background color :M ClassInit: ( -- ) *************** *** 40,44 **** :M WindowStyle: ( -- style ) ! WS_POPUPWINDOW WS_DLGFRAME or ;M --- 40,44 ---- :M WindowStyle: ( -- style ) ! WS_POPUPWINDOW WS_DLGFRAME or ;M *************** *** 50,58 **** \ if this form is a modal form a non-zero parent must be set :M ParentWindow: ( -- parent | 0 if no parent ) ! parent ;M ! :M SetParent: ( parentwindow -- ) \ set owner window ! to parent ;M --- 50,58 ---- \ if this form is a modal form a non-zero parent must be set :M ParentWindow: ( -- parent | 0 if no parent ) ! hwndparent ;M ! :M SetParentWindow: ( parentwindow -- ) \ set owner window ! to hwndparent ;M *************** *** 91,94 **** --- 91,97 ---- Create: WinFont + \ set form color to system color + COLOR_BTNFACE Call GetSysColor NewColor: FrmColor + self Start: lblName 33 22 45 17 Move: lblName *************** *** 214,218 **** :M On_Paint: ( -- ) ! 0 0 GetSize: self LTGRAY FillArea: dc ;M --- 217,221 ---- :M On_Paint: ( -- ) ! 0 0 GetSize: self Addr: FrmColor FillArea: dc ;M Index: SplitterWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/SplitterWindow.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** SplitterWindow.f 21 Aug 2005 06:22:00 -0000 1.2 --- SplitterWindow.f 27 Dec 2006 18:43:57 -0000 1.3 *************** *** 1,3 **** ! \ SplitterWindow.f Some Splitter Windows Templates for ForthForm by Ezra Boyce load-bitmap splitwin-type1 "splitwin-type1.bmp" --- 1,4 ---- ! \ SplitterWindow.f Some Splitter Windows Templates for ForthForm by Ezra Boyce ! \ May 27, 2006 - Updated to used splitter-window templates by Rod OakFord load-bitmap splitwin-type1 "splitwin-type1.bmp" *************** *** 8,11 **** --- 9,13 ---- load-bitmap splitwin-type6 "splitwin-type6.bmp" + :Object frmCreateSplitterWindow <Super frmSplitterWindow *************** *** 16,812 **** ImageButton Split5 ImageButton Split6 ! 0 value ischild-window? ! 0 value stype \ splitter type ! ! : write-superclass ( -- ) ! ischild-window? ! if s" <Super Child-Window" ! else s" <Super Window" ! then 1 +tabs append&crlf ; ! ! : write-autosize ( -- ) ! ischild-window? not ?exit ! +crlf ! s" :M Autosize: ( -- ) " append&crlf ! 2 +tabs s" 0 0 GetSi... [truncated message content] |
|
From: Ezra B. <ezr...@us...> - 2006-12-27 18:30:22
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv9785/src/lib Modified Files: RebarControl.f bitmap.f toolbar.f Log Message: ForthForm updates. EAB Index: toolbar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/toolbar.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** toolbar.f 23 Nov 2006 18:52:32 -0000 1.6 --- toolbar.f 27 Dec 2006 18:30:18 -0000 1.7 *************** *** 420,424 **** :M AddButtons: ( 'button_table noButtons -- n ) ! swap swap TB_ADDBUTTONS hwnd Call SendMessage ;M --- 420,424 ---- :M AddButtons: ( 'button_table noButtons -- n ) ! TB_ADDBUTTONS hwnd Call SendMessage ;M Index: bitmap.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/bitmap.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** bitmap.f 13 Oct 2006 03:50:29 -0000 1.6 --- bitmap.f 27 Dec 2006 18:30:18 -0000 1.7 *************** *** 212,216 **** \ a bitmap in any window ! :Class BitmapObject <super Object int &bitmap --- 212,216 ---- \ a bitmap in any window ! :Class BitmapObject <super Child-Window int &bitmap *************** *** 218,221 **** --- 218,230 ---- int xpos int ypos + WinDC bitmap-dc + + int sprite-bitmap + + int SpriteWidth + int SpriteHeight + int OffsetY + + int ParentDC :M SetXY: ( x y -- ) *************** *** 227,230 **** --- 236,243 ---- WHITE to BackGroundColor 0 0 SetXY: self + 0 to OffsetY + 16 to SpriteWidth + 15 to SpriteHeight + 0 to parentdc ;M *************** *** 307,310 **** --- 320,451 ---- to BackGroundColor ;M + \ The following adapted from Mike Kemper's bitmap routines + + :M Start: { \ hdcMem hbm -- } + &bitmap 0= abort" Bitmap not yet set!" \ continue only if object has a bitmap + &bitmap to currentbitmap + GetDC: self PutHandle: dc + 0 call CreateCompatibleDC PutHandle: bitmap-dc + + dib.width dib.height CreateCompatibleBitmap: dc to sprite-bitmap + sprite-bitmap SelectObject: bitmap-dc + GetHandle: dc ReleaseDC: self + + GetHandle: bitmap-dc \ device context + CreateDIBitmap to hbm + + GetHandle: bitmap-dc call CreateCompatibleDC to hdcMem + hbm hdcMem call SelectObject drop + + + SRCCOPY 0 0 + hdcMem + dib.height \ image height + dib.width \ image width + 0 0 GetHandle: bitmap-dc + call BitBlt ?WinError + hdcMem call DeleteDC ?WinError + hbm call DeleteObject ?WinError + ;M + + :M SetParentDC: ( dc -- ) + to ParentDC ;M + + :M GetParentDC: ( -- dc ) + ParentDC ;M + + :M GetWinDC: ( -- dc ) + GetHandle: bitmap-dc ;M + + :M SetSpriteSize: ( width height -- ) + to SpriteHeight to SpriteWidth ;M + + :M GetSpriteSize: ( -- width height ) + SpriteWidth SpriteHeight ;M + + :M SetOffsetY: ( y -- ) + to OffsetY ;M + + :M GetOffsetY: ( -- y ) + OffsetY ;M + + \ ------------------------------------------------------------------------- + \ ----- Draw a sized image at x, y within the parent's DC + \ ------------------------------------------------------------------------- + :M PutImage: { sprite# x y -- } + SRCCOPY \ direct copy + OffsetY sprite# SpriteWidth * \ source y x + GetHandle: bitmap-dc \ source DC + SpriteHeight SpriteWidth y x \ height width y x + ParentDC \ dest DC + call BitBlt drop ;M \ draw it + + \ ------------------------------------------------------------------------- + \ ----- Copy a sized image from a parent's DC at x, y to our bitmap image + \ ------------------------------------------------------------------------- + :M GetImage: { sprite# x y -- } + SRCCOPY \ direct copy + y x \ source y x + ParentDC \ source DC + SpriteHeight SpriteWidth \ height width + OffsetY sprite# SpriteWidth * \ dest y x + GetHandle: bitmap-dc \ dest DC + call BitBlt drop ;M \ copy it + + \ ------------------------------------------------------------------------- + \ ----- Logically AND's a sized image with the parent's DC at x, y + \ ------------------------------------------------------------------------- + :M AndBlit: { sprite# x y -- } + SRCAND + OffsetY sprite# SpriteWidth * + GetHandle: bitmap-dc + SpriteHeight SpriteWidth + y x + ParentDC + call BitBlt drop ;M + + \ ------------------------------------------------------------------------- + \ ----- Logically OR's a sized image with the parent's DC at x, y + \ ------------------------------------------------------------------------- + :M OrBlit: { sprite# x y -- } + SRCPAINT + OffsetY sprite# SpriteWidth * + GetHandle: bitmap-dc + SpriteHeight SpriteWidth + y x + ParentDC + call BitBlt drop ;M + + \ ------------------------------------------------------------------------- + \ ----- Draw a sized, masked image at x, y within the parent's DC + \ ------------------------------------------------------------------------- + :M PutImageMasked: { sprite# x y -- } + sprite# y x AndBlit: self + sprite# y x OrBlit: self ;M + + \ ------------------------------------------------------------------------- + \ ----- Draws the entire bitmap on the parent's DC at x, y + \ ------------------------------------------------------------------------- + :M PutBMP: { x y -- } + &bitmap to currentbitmap \ in case it was changed + SRCCOPY + 0 0 + GetHandle: bitmap-dc + dib.height dib.Width + y x + ParentDC + call BitBlt drop ;M + + :M Close: ( -- ) + GetHandle: bitmap-dc ?dup + if Call DeleteDC ?WinError + 0 PutHandle: bitmap-dc + then + sprite-bitmap ?dup + if sprite-bitmap call DeleteObject drop + 0 to sprite-bitmap + then 0 to &bitmap + Close: super ;M + ;Class Index: RebarControl.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/RebarControl.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** RebarControl.f 11 Jun 2006 09:03:50 -0000 1.6 --- RebarControl.f 27 Dec 2006 18:30:17 -0000 1.7 *************** *** 12,16 **** :Class RebarControl <Super Control ! Record: REBARBBANDINFO int binfoSize int bfMask --- 12,16 ---- :Class RebarControl <Super Control ! Record: REBARBANDINFO int binfoSize int bfMask *************** *** 33,40 **** int lParam int cxHeader ! ;Recordsize: sizeof(REBARBBANDINFO) : Eraseband-info ( -- ) ! REBARBBANDINFO sizeof(REBARBBANDINFO) dup>r erase r> to binfoSize ; --- 33,40 ---- int lParam int cxHeader ! ;Recordsize: sizeof(REBARBANDINFO) : Eraseband-info ( -- ) ! REBARBANDINFO sizeof(REBARBANDINFO) dup>r erase r> to binfoSize ; *************** *** 70,77 **** :M IdToIndex: ( uBandID -- uBand ) 0 swap RB_IDTOINDEX SendMessage:Self ;M ! :M InsertBandAt: ( uBand -- ) REBARBBANDINFO swap RB_INSERTBAND SendMessage:SelfDrop ;M :M InsertBand: ( -- ) -1 InsertBandAt: self ;M \ band info should have been set ! :M MaximizeBand: ( fIdeal uBand -- ) RB_MAXIMIZEBAND SendMessage:SelfDrop ;M --- 70,77 ---- :M IdToIndex: ( uBandID -- uBand ) 0 swap RB_IDTOINDEX SendMessage:Self ;M ! :M InsertBandAt: ( uBand -- ) REBARBANDINFO swap RB_INSERTBAND SendMessage:SelfDrop ;M :M InsertBand: ( -- ) -1 InsertBandAt: self ;M \ band info should have been set ! :M MaximizeBand: ( fIdeal uBand -- ) RB_MAXIMIZEBAND SendMessage:SelfDrop ;M *************** *** 90,94 **** \ Make sure Common Controls are loaded ICC_COOL_CLASSES 8 sp@ Call InitCommonControlsEx 3drop ! z" ReBarWindow32" Create-Control 0 0 SetBarInfo: self then ;M --- 90,94 ---- \ Make sure Common Controls are loaded ICC_COOL_CLASSES 8 sp@ Call InitCommonControlsEx 3drop ! z" ReBarWindow32" Create-Control 0 0 SetBarInfo: self then ;M *************** *** 116,120 **** :M GetToolTips: ( -- hwndToolTip ) 0 0 RB_GETTOOLTIPS SendMessage:Self ;M :M MoveBand: ( iTo iFrom -- ) RB_MOVEBAND SendMessage:SelfDrop ;M ! :M SetBandInfo: ( uBand -- ) REBARBBANDINFO swap RB_SETBANDINFO SendMessage:SelfDrop ;M :M SetBkColor: ( clrBk -- ) 0 swap RB_SETBKCOLOR SendMessage:SelfDrop ;M :M SetPalette: ( hpal -- ) 0 swap RB_SETPALETTE SendMessage:SelfDrop ;M --- 116,120 ---- :M GetToolTips: ( -- hwndToolTip ) 0 0 RB_GETTOOLTIPS SendMessage:Self ;M :M MoveBand: ( iTo iFrom -- ) RB_MOVEBAND SendMessage:SelfDrop ;M ! :M SetBandInfo: ( uBand -- ) REBARBANDINFO swap RB_SETBANDINFO SendMessage:SelfDrop ;M :M SetBkColor: ( clrBk -- ) 0 swap RB_SETBKCOLOR SendMessage:SelfDrop ;M :M SetPalette: ( hpal -- ) 0 swap RB_SETPALETTE SendMessage:SelfDrop ;M *************** *** 781,783 **** The rebar control sends notification messages to the window you specify with this message. ! This message does not actually change the parent of the rebar control. |
|
From: Alex M. <ale...@us...> - 2006-12-15 12:21:52
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29268 Modified Files: gkernel.f gmeta-compiler.f Log Message: arm: correct in/out values in kernel for constant, value, variable words Index: gmeta-compiler.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gmeta-compiler.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** gmeta-compiler.f 30 Nov 2006 20:17:32 -0000 1.10 --- gmeta-compiler.f 15 Dec 2006 12:21:48 -0000 1.11 *************** *** 722,726 **** mov ecx, # r@ jmp s" 't-ptr dovoc" evaluate ! (end-code) ofa-meta ]macro r>drop --- 722,726 ---- mov ecx, # r@ jmp s" 't-ptr dovoc" evaluate ! c; ofa-meta ]macro r>drop *************** *** 1019,1023 **** r@ t-literal macro[ next c; ]macro r>drop ! ; : value ( n -<name>- ) \ create a self fetching changeable value --- 1019,1023 ---- r@ t-literal macro[ next c; ]macro r>drop ! ; : value ( n -<name>- ) \ create a self fetching changeable value Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.27 retrieving revision 1.28 diff -C2 -d -r1.27 -r1.28 *** gkernel.f 30 Nov 2006 20:17:32 -0000 1.27 --- gkernel.f 15 Dec 2006 12:21:48 -0000 1.28 *************** *** 2178,2183 **** 0 dp-link ! - create kdp 0 , 0 , 0 , dp-link link, ," syscode" \ system code (aka kode) create sdp 0 , 0 , 0 , dp-link link, ," sys" \ system create adp 0 , 0 , 0 , dp-link link, ," app" \ application create cdp 0 , 0 , 0 , dp-link link, ," appcode" \ code --- 2178,2183 ---- 0 dp-link ! create sdp 0 , 0 , 0 , dp-link link, ," sys" \ system + create kdp 0 , 0 , 0 , dp-link link, ," syscode" \ system code (aka kode) create adp 0 , 0 , 0 , dp-link link, ," app" \ application create cdp 0 , 0 , 0 , dp-link link, ," appcode" \ code *************** *** 2456,2459 **** --- 2456,2473 ---- $c3 code-c, ; immediate + \ -------------------- Various support words -------------------------- + + : (in/out@) ( nfa -- in out ) \ get the ste values + n>ste dup sc@ swap 1+ sc@ ; + + : in/out@ ( -- in out ) \ get the ste values + last @ (in/out@) ; + + : (in/out!) ( in out -- ) \ set the ste values + last @ n>ste + dup>r 1+ c! r> c! ; + + ' (in/out!) alias in/out immediate \ immediate version + \ ---------------------------- Defining Words -------------------------------- *************** *** 2498,2502 **** : (comp-cons) ( xt -- ) execute postpone literal ; \ execute & compile a literal ! 0 1 in/out : constant ( n "name" ) \ compile time ( -- n ) \ run time >system \ constant value in system space --- 2512,2516 ---- : (comp-cons) ( xt -- ) execute postpone literal ; \ execute & compile a literal ! : constant ( n "name" ) \ compile time ( -- n ) \ run time >system \ constant value in system space *************** *** 2504,2528 **** dp> ['] (comp-cons) compiles-last \ make the defined word compile this ! ; : (comp-create) ( xt -- ) >body postpone literal ; ! 0 1 in/out : create ( -<name>- ) \ pointer ['] dovar tvar dogen ['] (comp-create) compiles-last \ doesn't work because of DOES> , needs fixed ??? ! ; ! 0 1 in/out : variable ( "name") \ compile time ( -- n ) \ run time create 0 , ! ['] (comp-cons) compiles-last ; : (comp-val) ( n -- ) >body postpone literal postpone @ ; ! 0 1 in/out : value ( n -<name>- ) \ self fetching value ['] doval tval dogen , ['] (comp-val) compiles-last \ make the defined word compile this ! ; : 2literal ( n m -- ) \ run-time skeleton for 2literal --- 2518,2547 ---- dp> ['] (comp-cons) compiles-last \ make the defined word compile this ! 0 1 in/out ! ; 1 0 in/out : (comp-create) ( xt -- ) >body postpone literal ; ! : create ( -<name>- ) \ pointer ['] dovar tvar dogen ['] (comp-create) compiles-last \ doesn't work because of DOES> , needs fixed ??? ! 0 1 in/out ! ; 0 0 in/out ! : variable ( "name") \ compile time ( -- n ) \ run time create 0 , ! ['] (comp-cons) compiles-last ! 0 0 in/out ! ; 0 1 in/out : (comp-val) ( n -- ) >body postpone literal postpone @ ; ! : value ( n -<name>- ) \ self fetching value ['] doval tval dogen , ['] (comp-val) compiles-last \ make the defined word compile this ! 0 1 in/out ! ; 1 0 in/out : 2literal ( n m -- ) \ run-time skeleton for 2literal *************** *** 5979,5996 **** : ok ( -- ) ; immediate \ to allow console code with ok prompt to be pasted - \ -------------------- Various support words -------------------------- - - : (in/out@) ( nfa -- in out ) \ get the ste values - n>ste dup sc@ swap 1+ sc@ ; - - : in/out@ ( -- in out ) \ get the ste values - last @ (in/out@) ; - - : (in/out!) ( in out -- ) \ set the ste values - last @ n>ste - dup>r 1+ c! r> c! ; - - ' (in/out!) alias in/out immediate \ immediate version - \ --------------------------------------------------------------------- \ --------------------------------------------------------------------- --- 5998,6001 ---- |
|
From: Alex M. <ale...@us...> - 2006-12-15 12:21:39
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29250 Modified Files: gkernel.exe Log Message: arm: correct in/out values in kernel for constant, value, variable words Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.28 retrieving revision 1.29 diff -C2 -d -r1.28 -r1.29 Binary files /tmp/cvs9xPZqW and /tmp/cvseXglyP differ |
|
From: George H. <geo...@us...> - 2006-12-11 10:42:43
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv26797/win32forth-stc/src Modified Files: optliterals.f paths.f Log Message: gah: Fixed bug in SWAP of literals and optimised PATH: Index: optliterals.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/optliterals.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** optliterals.f 22 Nov 2006 00:06:53 -0000 1.10 --- optliterals.f 11 Dec 2006 10:42:36 -0000 1.11 *************** *** 51,55 **** )) ! \ To help the optimiser, some code words that deal with constants \ are broken up into their constituent parts for compile time --- 51,55 ---- )) ! \ To help the optimiser, some code words that deal with constants \ are broken up into their constituent parts for compile time *************** *** 110,114 **** else macro[ and off stk[],# n ]macro then ; ! : pop-tos { } 0 n[ebp]->tos -1 n+stk ; : push-tos { } -4 tos->n[ebp] 1 n+stk ; --- 110,114 ---- else macro[ and off stk[],# n ]macro then ; ! : pop-tos { } 0 n[ebp]->tos -1 n+stk ; : push-tos { } -4 tos->n[ebp] 1 n+stk ; *************** *** 166,170 **** then ; ! ' litstack compiles-for literal ' litsync is sync-code --- 166,170 ---- then ; ! ' litstack compiles-for literal ' litsync is sync-code *************** *** 222,225 **** --- 222,226 ---- r> s-reverse \ reverse the order r> execute \ execute the word + r@ s-reverse \ reverse the order r> 0 ?do lits spush loop \ push outputs back on literal stack exit *************** *** 239,243 **** then xt-inline, ; \ else just inline it ! :noname ( -- ) \ set nseopt as the optimiser for specified xts ['] nseopt >r \ the optimisation code to run --- 240,244 ---- then xt-inline, ; \ else just inline it ! :noname ( -- ) \ set nseopt as the optimiser for specified xts ['] nseopt >r \ the optimisation code to run Index: paths.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/paths.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** paths.f 4 Dec 2006 17:58:15 -0000 1.6 --- paths.f 11 Dec 2006 10:42:37 -0000 1.7 *************** *** 162,165 **** --- 162,174 ---- IN-APPLICATION + internal + + : (path:) does> \ run-time: ( -- path ) + [ 2 cells ] literal + ; + + external + + in-system + : path: ( -- ) \ *G Defines a directory search path. \n *************** *** 168,174 **** \ ** followed by null. \n \ ** At runtime it returns address of the counted string of a path. ! create -1 , 0 , MAX-PATH 1+ allot does> \ run-time: ( -- path ) ! [ 2 cells ] literal + ! ; INTERNAL --- 177,184 ---- \ ** followed by null. \n \ ** At runtime it returns address of the counted string of a path. ! create -1 , 0 , MAX-PATH 1+ allot (path:) ! ['] (comp-cons) compiles-last ; ! ! in-application INTERNAL |
|
From: Jos v.d.V. <jo...@us...> - 2006-12-09 12:50:14
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv5522 Modified Files: Pl_MciWindow.f Log Message: Jos: Made it sure that the volume level is restored to the right level. Index: Pl_MciWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Pl_MciWindow.f,v retrieving revision 1.28 retrieving revision 1.29 diff -C2 -d -r1.28 -r1.29 *** Pl_MciWindow.f 6 Dec 2006 19:20:56 -0000 1.28 --- Pl_MciWindow.f 9 Dec 2006 12:50:06 -0000 1.29 *************** *** 158,162 **** :M PlayFile: ( addr len -- ) \ open and play a file ! Close: self 2dup file-status nip 0= if \ don't try play RealPlayer files, sometimes MCI crashes on my system, when trying (dbu) --- 158,165 ---- :M PlayFile: ( addr len -- ) \ open and play a file ! Playing? ! if GetVolume: Self vadr-config VolLevel ! ! Close: self ! then 2dup file-status nip 0= if \ don't try play RealPlayer files, sometimes MCI crashes on my system, when trying (dbu) *************** *** 224,228 **** PlayFile: self \ play this file begin PLAYER \ call the main PLAYER ! Playing? 0= \ and wait until playing is finished until ; --- 227,231 ---- PlayFile: self \ play this file begin PLAYER \ call the main PLAYER ! Playing? 0= \ and wait until playing is finished until ; |
|
From: George H. <geo...@us...> - 2006-12-08 10:27:35
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv10955/win32forth-stc/src Modified Files: float.f Log Message: gah: Optimisation using FCOMI FCMOV etc (work in progress) Index: float.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/float.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** float.f 7 Nov 2006 11:08:39 -0000 1.5 --- float.f 8 Dec 2006 10:27:31 -0000 1.6 *************** *** 102,105 **** --- 102,106 ---- previous + next-user @ cell naligned next-user ! cell NEWUSER FLOATSP \ floating point stack pointer in the user area (new) 256 constant fstack-elements \ 256 floating point elements in stack *************** *** 112,123 **** in-system macro: FSP_MEMORY ( -- ) FLOATSP [up] endm macro: FSTACK_MEMORY ( -- ) ! FLOATSTACK [ecx] [up] endm macro: +FSTACK_MEMORY ( n -- ) ! FLOATSTACK + [ecx] [up] endm in-previous --- 113,129 ---- in-system + \ These 3 macros are to make it easier to change the fsp caching register. + macro: fsp ecx endm + macro: fsp, ecx, endm + macro: [fsp] [ecx] endm + macro: FSP_MEMORY ( -- ) FLOATSP [up] endm macro: FSTACK_MEMORY ( -- ) ! FLOATSTACK [fsp] [up] endm macro: +FSTACK_MEMORY ( n -- ) ! FLOATSTACK + [fsp] [up] endm in-previous *************** *** 161,166 **** mov -4 [ebp], tos lea ebp, -4 [ebp] ! mov ecx, FSP_MEMORY ! cmp ecx, # b/float js short L$1 fld FSIZE b/float negate +FSTACK_MEMORY --- 167,172 ---- mov -4 [ebp], tos lea ebp, -4 [ebp] ! mov fsp, FSP_MEMORY ! cmp fsp, # b/float js short L$1 fld FSIZE b/float negate +FSTACK_MEMORY *************** *** 201,214 **** 0 value fsp-adjust ! \ makro to copy ST(0) on the separate float stack ! macro: (FPU>) fsp-cached? 0= if ! mov ecx, FSP_MEMORY ! true to fsp-cached? then fstp FSIZE fsp-adjust +FSTACK_MEMORY endm ! \ makro to move ST(0) on the separate float stack macro: FPU> (FPU>) --- 207,238 ---- 0 value fsp-adjust ! macro: +fsp-adjust ! b/float +to fsp-adjust ! endm ! ! macro: -fsp-adjust ! b/float negate +to fsp-adjust ! endm ! ! macro: ?cache-fsp fsp-cached? 0= if ! mov fsp, FSP_MEMORY ! true to fsp-cached? then endm ! ! macro: ?uncache-fsp ! fsp-adjust if ! add fsp, # fsp-adjust ! mov FSP_MEMORY , fsp ! 0 to fsp-adjust then ! false to fsp-cached? endm ! ! \ macro to copy ST(0) onto the separate float stack ! macro: (FPU>) ! ?cache-fsp fstp FSIZE fsp-adjust +FSTACK_MEMORY endm ! \ macro to move ST(0) onto the separate float stack macro: FPU> (FPU>) *************** *** 216,229 **** endm ! \ makro to move the top of the separate float stack into st(0) macro: >FPU ! fsp-cached? 0= if ! mov ecx, FSP_MEMORY ! true to fsp-cached? then b/float negate +to fsp-adjust fld FSIZE fsp-adjust +FSTACK_MEMORY endm ! \ makro to copy the top of the separate float stack into st(0) macro: (>FPU) >FPU --- 240,251 ---- endm ! \ macro to move the top of the separate float stack into st(0) macro: >FPU ! ?cache-fsp b/float negate +to fsp-adjust fld FSIZE fsp-adjust +FSTACK_MEMORY endm ! \ macro to copy the top of the separate float stack into st(0) macro: (>FPU) >FPU *************** *** 238,250 **** \ macro to end float words - macro: ?uncash-fsp - fsp-adjust if - add ecx, # fsp-adjust - mov FSP_MEMORY , ecx - 0 to fsp-adjust then - false to fsp-cached? endm - macro: float; ! ?uncash-fsp next ;c endm in-previous --- 260,265 ---- \ macro to end float words macro: float; ! ?uncache-fsp next ;c endm in-previous *************** *** 253,258 **** \ Input: eax = number of floats we need subr: fstack-check ! mov ecx, FSP_MEMORY ! cmp ecx, edx js short L$1 ret \ stack is fine, return to caller --- 268,273 ---- \ Input: eax = number of floats we need subr: fstack-check ! mov fsp, FSP_MEMORY ! cmp fsp, edx js short L$1 ret \ stack is fine, return to caller *************** *** 426,469 **** float; ! code FSWAP ( fs: r1 r2 -- r2 r1 ) ! fstack-check_2 \ TODO optimize 2>FPU ! fxch FPU> FPU> float; ! code FOVER ( fs: r1 r2 -- r1 r2 r3 ) fstack-check_2 ! ! \ TODO optimize ! mov ecx, FSP_MEMORY ! sub ecx, # B/FLOAT 2* ! fld FSIZE FSTACK_MEMORY ! add ecx, # B/FLOAT 2* fstp FSIZE FSTACK_MEMORY ! add ecx, # B/FLOAT ! mov FSP_MEMORY , ecx ! float; ! code FROT ( fs: r1 r2 r3 -- r2 r3 r1 ) fstack-check_3 ! ! \ TODO optimize ! mov ecx, FSP_MEMORY ! sub ecx, # B/FLOAT ! fld FSIZE FSTACK_MEMORY ! sub ecx, # B/FLOAT ! fld FSIZE FSTACK_MEMORY ! sub ecx, # B/FLOAT ! fld FSIZE FSTACK_MEMORY ! add ecx, # B/FLOAT 2* ! fstp FSIZE FSTACK_MEMORY ! sub ecx, # B/FLOAT 2* ! fstp FSIZE FSTACK_MEMORY ! add ecx, # B/FLOAT ! fstp FSIZE FSTACK_MEMORY ! float; --- 441,479 ---- float; ! code FSWAP ( fs: r1 r2 -- r2 r1 ) \ ANSI Floating ! \ *G Exchange the top 2 FP numbers. ! fstack-check_2 2>FPU ! +fsp-adjust FPU> + -fsp-adjust -fsp-adjust FPU> + +fsp-adjust float; ! code FOVER ( fs: r1 r2 -- r1 r2 r3 ) \ ANSI Floating ! \ *G Copy the 2nd FP stack number to the top of the FP stack. fstack-check_2 ! fld FSIZE b/float 2* negate +FSTACK_MEMORY fstp FSIZE FSTACK_MEMORY ! +fsp-adjust float; ! code FROT ( fs: r1 r2 r3 -- r2 r3 r1 ) \ ANSI Floating ! \ *G Rotate the top 3 FP stack numbers. fstack-check_3 ! -fsp-adjust ! fld FSIZE fsp-adjust +FSTACK_MEMORY ! -fsp-adjust ! fld FSIZE fsp-adjust +FSTACK_MEMORY ! -fsp-adjust ! fld FSIZE fsp-adjust +FSTACK_MEMORY ! +fsp-adjust +fsp-adjust ! fstp FSIZE fsp-adjust +FSTACK_MEMORY ! -fsp-adjust -fsp-adjust ! fstp FSIZE fsp-adjust +FSTACK_MEMORY ! +fsp-adjust ! fstp FSIZE fsp-adjust +FSTACK_MEMORY ! +fsp-adjust +fsp-adjust float; *************** *** 477,483 **** [THEN] call fstack-check ! sub ecx, edx fld FSIZE FSTACK_MEMORY ! add ecx, edx mov tos, 0 [ebp] lea ebp, 4 [ebp] --- 487,493 ---- [THEN] call fstack-check ! sub fsp, edx fld FSIZE FSTACK_MEMORY ! add fsp, edx mov tos, 0 [ebp] lea ebp, 4 [ebp] *************** *** 840,848 **** : f>= ( -- f ) ( fs: r1 r2 -- ) f< not ; ! : FMAX ( fs: r1 r2 -- r3 ) ! f2dup f< IF fswap THEN fdrop ; ! : FMIN ( fs: r1 r2 -- r3 ) ! f2dup f> IF fswap THEN fdrop ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 850,880 ---- : f>= ( -- f ) ( fs: r1 r2 -- ) f< not ; ! code FMAX ( fs: r1 r2 -- r3 ) ! fstack-check_2 ! 2>FPU ! fld st(1) ! fld st(1) ! fadd ! fxch st(2) ! fcomi ! fcmovbe \ cf=1 or zf=1 ! fcmovu st(2) ! fpu> ! fcompp ! float; ! code FMIN ( fs: r1 r2 -- r3 ) ! fstack-check_2 ! 2>FPU ! fld st(1) ! fld st(1) ! fadd ! fxch st(2) ! fcomi ! fcmovnbe \ cf=0 and zf=0 ! fcmovu st(2) ! fpu> ! fcompp ! float; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 1038,1053 **** fstack-check_1 fldln2 - mov edx, tos >FPU fld FSIZE sq2m1 ! fcomp st(1) ! fstsw ax ! sahf jp short L$3 ja short L$4 fld FSIZE sq2/2m1 ! fcomp st(1) ! fstsw ax ! sahf jb short L$4 fyl2xp1 --- 1070,1080 ---- fstack-check_1 fldln2 >FPU fld FSIZE sq2m1 ! fcomip st(1) jp short L$3 ja short L$4 fld FSIZE sq2/2m1 ! fcomip st(1) jb short L$4 fyl2xp1 *************** *** 1056,1071 **** L$4: fld1 \ add the "1" explicitly faddp st(1), st(0) - fabs fyl2x FPU> jmp short L$2 L$3: fcompp \ return arg if incomparable ! L$2: mov tos, edx ! float; code FLOG ( fs: r1 -- r2 ) fstack-check_1 fldlg2 - fabs \ ? error for x <= 0 >FPU fyl2x --- 1083,1096 ---- L$4: fld1 \ add the "1" explicitly faddp st(1), st(0) fyl2x FPU> jmp short L$2 L$3: fcompp \ return arg if incomparable ! L$2: float; ! code FLOG ( fs: r1 -- r2 ) fstack-check_1 fldlg2 >FPU fyl2x |
|
From: Jos v.d.V. <jo...@us...> - 2006-12-06 19:21:10
|
Update of /cvsroot/win32forth/win32forth/apps/Player4 In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv25929 Modified Files: Catalog.f Commands.f Mediatree.f PLAYER4.F Pl_MciWindow.f Pl_Toolset.f Pl_Version.f PopupWindow.f mshell_r.f Log Message: Jos: Made the catalog ROM bootable and adapted the catalog for full-path Index: mshell_r.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/mshell_r.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** mshell_r.f 19 Jul 2006 15:25:26 -0000 1.4 --- mshell_r.f 6 Dec 2006 19:20:57 -0000 1.5 *************** *** 179,181 **** --- 179,190 ---- : build-ptrs ( #records -- ) 0 swap add-ptrs ; + : #RecordsInDatabase ( record-size m_hndl - #records ) >hfileLength @ swap / ; + + : CreateIndexFile ( counted$ #records - f ) + cells + over create-file-ptrs + swap open-file-ptrs + extend-file + ; + \s Index: Pl_Version.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Pl_Version.f,v retrieving revision 1.20 retrieving revision 1.21 diff -C2 -d -r1.20 -r1.21 *** Pl_Version.f 19 Jul 2006 15:25:26 -0000 1.20 --- Pl_Version.f 6 Dec 2006 19:20:56 -0000 1.21 *************** *** 3,7 **** anew -Pl_Version.f ! 10127 value player_version# \ Version numbers: v.ww.rr --- 3,7 ---- anew -Pl_Version.f ! 10128 value player_version# \ Version numbers: v.ww.rr *************** *** 184,186 **** --- 184,218 ---- medialabel, relative filename and filesize are the same. + \ changes for Version 1.01.28 + Jos: December 6th, 2006. + Made the catalog of the player ROM bootable. + The idea is to burn a CD or DVD with a configured Player4 and some music. + As soon as that disk is put in the drive player4 will auto-start and + act according its configuration. It might even start playing and go + to the tray bar. + Steps to make a DVD: + Copy player4.exe and autorun.inf to a directory on your HD + Make a directory in it called files. + Copy the music into the directory files + Start Player4 + Choose in the menu Options for Setup a search path catalog + Select the music directory + Choose in the menu Catalog for Import directory tree... + Activate you favorite flags such as: Auto play the catalog at the start + Note: The sort flags can also be used. + Leave Player4 + + Burn the disk in such a way that the files: + + autorun.inf + catalog.dat + catalog.idx + PathMediaFiles.dat + Player4.exe + + are in the root together with the directory Files. + + When the autostart option is still on in your PC then it will start + player4 as soon as the disk is put in the drive. + Index: Catalog.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Catalog.f,v retrieving revision 1.40 retrieving revision 1.41 diff -C2 -d -r1.40 -r1.41 *** Catalog.f 15 Oct 2006 16:08:43 -0000 1.40 --- Catalog.f 6 Dec 2006 19:20:56 -0000 1.41 *************** *** 455,458 **** --- 455,475 ---- : set-all-not-played ( - ) for-all-records record-not-played ; + : Mark#playingAsPlayed ( - ) + #playing -1 > + if #playing RecordDef true #playing RecordDef Played- c! + then + ; + + : SetRecordInCollectionToNotPlayed ( n - ) + n>record dup RecordDef Excluded- c@ not + if 0 swap RecordDef Played- c! + then + ; + + : SetCollectionToNotPlayed ( - ) + for-all-records SetRecordInCollectionToNotPlayed + Mark#playingAsPlayed RefreshCatalog + ; + : change-randomlevel ( level n - ) n>record over random swap RecordDef RandomLevel ! *************** *** 505,511 **** ; ! : random-shuffle ( - ) vadr-config MaximumRandomLevel @ for-all-records change-randomlevel drop ! sort_by_RandomLevel RefreshCatalog ; --- 522,531 ---- ; ! : shuffle-catalog ( - ) vadr-config MaximumRandomLevel @ for-all-records change-randomlevel drop ! ; ! ! : random-shuffle ( - ) ! shuffle-catalog sort_by_RandomLevel RefreshCatalog ; *************** *** 621,627 **** if r@ Incollection? else r@ Requested? not ! r@ RecordDef Played- c@ 0= and then then r> RecordDef Deleted- c@ 0= and if drop i leave --- 641,648 ---- if r@ Incollection? else r@ Requested? not ! then then + r@ RecordDef Played- c@ 0= and r> RecordDef Deleted- c@ 0= and if drop i leave *************** *** 745,749 **** : "search-records ( adr count - ) ! for-all-records search-record 2drop ; --- 766,770 ---- : "search-records ( adr count - ) ! for-all-records search-record 2drop Mark#playingAsPlayed ; Index: Mediatree.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Mediatree.f,v retrieving revision 1.35 retrieving revision 1.36 diff -C2 -d -r1.35 -r1.36 *** Mediatree.f 19 Jul 2006 15:25:26 -0000 1.35 --- Mediatree.f 6 Dec 2006 19:20:56 -0000 1.36 *************** *** 121,125 **** z" Music" 2r@ 1 AddItemHierarical dup to hMusic z" Requests" 2r> 1 AddItemHierarical dup to hRequests ! dummy dup &PrevMusic ! dup &PrevMovie ! &PrevRequest ! dup &PrevMovie hArtist ! &PrevMovie hArtist ! (( z" First Artist" hPrev hMusic 1 AddItemHierarical to hArtist --- 121,125 ---- z" Music" 2r@ 1 AddItemHierarical dup to hMusic z" Requests" 2r> 1 AddItemHierarical dup to hRequests ! dummy dup &PrevMusic ! dup &PrevMovie ! dup to LastChar &PrevRequest ! dup &PrevMovie hArtist ! &PrevMovie hArtist ! (( z" First Artist" hPrev hMusic 1 AddItemHierarical to hArtist *************** *** 186,190 **** r@ n>record dup RecordDef Request- c@ if 1 +to #requests &PrevRequest ! else dup CountedFilename music? if &PrevMusic else &PrevMovie --- 186,190 ---- r@ n>record dup RecordDef Request- c@ if 1 +to #requests &PrevRequest ! else dup CountedFilename music? if &PrevMusic else &PrevMovie *************** *** 205,209 **** :M FillTreeView: ( -- ) - TVI_ROOT DeleteItem: self \ delete all items from the tree view 0 to #Excluded --- 205,208 ---- Index: Pl_Toolset.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Pl_Toolset.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 Binary files /tmp/cvsNkDLNX and /tmp/cvsKQhCL2 differ Index: PLAYER4.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PLAYER4.F,v retrieving revision 1.63 retrieving revision 1.64 diff -C2 -d -r1.63 -r1.64 *** PLAYER4.F 2 Dec 2006 10:17:30 -0000 1.63 --- PLAYER4.F 6 Dec 2006 19:20:56 -0000 1.64 *************** *** 94,97 **** --- 94,99 ---- needs CommandID.f + : SetVolLevel ( Volume - ) dup 1000 min 0 max vadr-config VolLevel ! SetVolume: Player4W ; + \ ----------------------------------------------------------------------------- \ Define the Main Window *************** *** 215,237 **** then check-config unmap-configuration ; ! :M On_Init: ( -- ) On_Init: super AccelTable EnableAccelerators \ init the accelerator table COLOR_BTNFACE 1+ GCL_HBRBACKGROUND hwnd Call SetClassLong drop ! InitFileNames check/resize-config-file catalog-exist? ! if map-config-file map-database vadr-config ExitFailed- c@ ! if MciDebug? if cr ." REBUILD " then ! generate-index-file build-free-list ! then ! true vadr-config ExitFailed- c! ! MciDebug? ! if database-mhndl #records-in-database . ." records, " ! ." freelist: " vadr-config #free-list @ . ! then ! else map-config-file then ! SortByFlags -1 to #playing GetHandle: Self SetParent: ControlCenter --- 217,256 ---- then check-config unmap-configuration ; ! string: StartupDir ! ! : ?SetPath ( flag - ) ! if Catalogpath count dup>r + r@ ascii \ -scan 1- r> swap - ! StartupDir count 1- pad place pad +place pad count Catalogpath place ! Catalogpath +null z" Player4.exe" zEXEC-CMD drop bye ! then ! ; ! ! :M On_Init: { RomBooted } ( -- ) On_Init: super AccelTable EnableAccelerators \ init the accelerator table COLOR_BTNFACE 1+ GCL_HBRBACKGROUND hwnd Call SetClassLong drop ! CURRENT-DIR$ count drop 3 StartupDir place ! RomBoot to RomBooted InitFileNames check/resize-config-file catalog-exist? ! if map-config-file RomBooted ?SetPath ! map-database vadr-config ExitFailed- c@ ! if MciDebug? ! if cr ." REBUILD " ! then ! generate-index-file build-free-list ! then ! true vadr-config ExitFailed- c! ! MciDebug? ! if database-mhndl #records-in-database . ." records, " ! ." freelist: " vadr-config #free-list @ . ! then ! vadr-config s_Random_popular- w@ ! if shuffle-catalog ! then ! SortByFlags ! else map-config-file then ! -1 to #playing GetHandle: Self SetParent: ControlCenter *************** *** 241,245 **** self Start: Player4W self Start: Splitter ! SeparatorX @ 0= if Startsize: self drop 2/ SeparatorX ! --- 260,264 ---- self Start: Player4W self Start: Splitter ! vadr-config VolLevel @ SetVolLevel SeparatorX @ 0= if Startsize: self drop 2/ SeparatorX ! *************** *** 270,273 **** --- 289,293 ---- :M WM_CLOSE ( h m w l -- res ) + GetVolume: Player4W vadr-config VolLevel ! AccelTable DisableAccelerators \ free the accelerator table Close: self *************** *** 316,320 **** : Stop ( -- ) ! Playing?: Player4W if AbortPlaying: Player4W then ; IDM_STOP SetCommand : Next ( -- ) --- 336,340 ---- : Stop ( -- ) ! Playing?: Player4W if -1 to #playing AbortPlaying: Player4W then ; IDM_STOP SetCommand : Next ( -- ) *************** *** 392,396 **** : ButtonIn? ( - ButtonIn ) IDJoystick GetJoystickInfo 2nip nip 0= ; : WaitTillDepressed ( - ) begin ButtonIn? until ; - : SetVolLevel ( Volume - ) dup 1000 min 0 max vadr-config VolLevel ! SetVolume: Player4W ; : DecreaseVolume ( - ) --- 412,415 ---- *************** *** 520,523 **** --- 539,543 ---- MENUITEM "&Export the catalog to Player.csv" csv-catalog ; MENUITEM "S&earch and make a collection..." SearchCatalog ; + MENUITEM "&Mark collection as not yet played" SetCollectionToNotPlayed ; MENUSEPARATOR :MENUITEM mEndless "Endless play" Endless ; Index: Pl_MciWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Pl_MciWindow.f,v retrieving revision 1.27 retrieving revision 1.28 diff -C2 -d -r1.27 -r1.28 *** Pl_MciWindow.f 19 Jul 2006 15:25:26 -0000 1.27 --- Pl_MciWindow.f 6 Dec 2006 19:20:56 -0000 1.28 *************** *** 159,163 **** :M PlayFile: ( addr len -- ) \ open and play a file Close: self - 2dup file-status nip 0= if \ don't try play RealPlayer files, sometimes MCI crashes on my system, when trying (dbu) --- 159,162 ---- *************** *** 165,168 **** --- 164,168 ---- if 2drop else Open: self 0 Play: self + vadr-config VolLevel @ SetVolume: Self \ Restore the volume to VolLevel then else 2drop *************** *** 223,227 **** : (PlayOneFile) ( addr len -- ) \ plays a file and waits until playing is finished PlayFile: self \ play this file - vadr-config VolLevel @ SetVolume: Self \ Restore the volume to VolLevel begin PLAYER \ call the main PLAYER Playing? 0= \ and wait until playing is finished --- 223,226 ---- *************** *** 276,279 **** --- 275,292 ---- \ Play files from catalog \ ----------------------------------------------------------------------------- + + :M PlayFileFromCatalog: ( adr n - ) + CatalogPath full-path + if turnkey? not + if 2dup type ." Not found in path" + then + then + 2dup file-status nip not + if (PlayOneFile) + else 2drop + then + + ;M + :M play-catalog-random: ( -- ) database-mhndl #records-in-database vadr-config #free-list @ - 0> *************** *** 289,295 **** RecordDef File_name r@ Cnt_File_name c@ 2dup type-cr r@ incr-#played r@ to #playing r> mark-played ! CatalogPath full-path not ! if (PlayOneFile) ! then then then --- 302,306 ---- RecordDef File_name r@ Cnt_File_name c@ 2dup type-cr r@ incr-#played r@ to #playing r> mark-played ! PlayFileFromCatalog: Self then then Index: PopupWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/PopupWindow.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** PopupWindow.f 22 Jul 2006 17:02:40 -0000 1.10 --- PopupWindow.f 6 Dec 2006 19:20:56 -0000 1.11 *************** *** 5,8 **** --- 5,9 ---- \ ----------------------------------------------------------------------------- + : PlaySelectedFromTreeView ( -- ) last-selected-rec n>record dup to #playing dup>r *************** *** 11,22 **** r> mark-played turnkey? not ! if 2dup cr type-space ! then ! CatalogPath full-path not ! if PlayFile: Player4W ! else turnkey? not ! if type ." Not found in path" ! then ! then ; defer ClosePopupWindow ' noop is ClosePopupWindow --- 12,19 ---- r> mark-played turnkey? not ! if 2dup cr type-space ! then ! PlayFileFromCatalog: Player4W ! ; defer ClosePopupWindow ' noop is ClosePopupWindow Index: Commands.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Player4/Commands.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** Commands.f 26 Aug 2006 15:25:31 -0000 1.7 --- Commands.f 6 Dec 2006 19:20:56 -0000 1.8 *************** *** 58,62 **** catalog-exist? if 0 to last-selected-rec player-base search-records ! SortByFlags then ; --- 58,62 ---- catalog-exist? if 0 to last-selected-rec player-base search-records ! SortByFlags RefreshCatalog then ; |
|
From: cozrses c. <mp...@op...> - 2006-12-04 22:19:53
|
1897 |
|
From: Dirk B. <db...@us...> - 2006-12-04 18:01:33
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv19888/src Modified Files: paths.f Log Message: - Fixed a bug in full-path Index: paths.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/paths.f,v retrieving revision 1.31 retrieving revision 1.32 diff -C2 -d -r1.31 -r1.32 *** paths.f 3 Dec 2006 19:05:30 -0000 1.31 --- paths.f 4 Dec 2006 18:01:23 -0000 1.32 *************** *** 150,158 **** create path-file$ MAX-PATH 1+ allot - : search-error ( addr -- ) - \ return input file and error flag - count path-file$ place path-file$ count - true ; - 6 PROC SearchPath --- 150,153 ---- *************** *** 236,240 **** current$ restore-current \ restore current dir ! filename$ search-error ; \ return input file and error flag \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 231,235 ---- current$ restore-current \ restore current dir ! a1 n1 true ; \ return input file and error flag \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ |
|
From: Dirk B. <db...@us...> - 2006-12-04 17:58:26
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv18652/src Modified Files: paths.f Log Message: - Fixed a bug in full-path Index: paths.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/paths.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** paths.f 2 Dec 2006 15:17:06 -0000 1.5 --- paths.f 4 Dec 2006 17:58:15 -0000 1.6 *************** *** 247,254 **** create path-file$ MAX-PATH 1+ allot ! : search-error ( addr -- ) \ return input file and error flag ! count path-file$ place path-file$ count ! true ; 6 PROC SearchPath --- 247,253 ---- create path-file$ MAX-PATH 1+ allot ! : search-error ( addr n -- f ) \ return input file and error flag ! path-file$ place path-file$ count true ; 6 PROC SearchPath *************** *** 295,299 **** current$ restore-current \ restore current dir ! filename$ search-error ; \ return input file and error flag : find-path { a1 n1 basepath path \ filename$ current$ search-current$ -- a2 n2 f1 } --- 294,298 ---- current$ restore-current \ restore current dir ! filename$ zcount search-error ; \ return input file and error flag : find-path { a1 n1 basepath path \ filename$ current$ search-current$ -- a2 n2 f1 } *************** *** 333,337 **** current$ restore-current \ restore current dir ! filename$ search-error ; \ return input file and error flag \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 332,336 ---- current$ restore-current \ restore current dir ! filename$ count search-error ; \ return input file and error flag \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 411,428 **** \ ** Applications that let Forth compile should not change it. - in-system - : "fbase-path+ ( a1 n1 -- ) \ w32f path \ *G Append a directory to the Forth search base path. search-base-path "path+ ; - : fbase-path+ ( -<directory>- -- ) \ w32f path system - \ *G Append a directory to the Forth search base path. - /parse-s$ count "fbase-path+ ; - : "fpath+ ( a1 n1 -- ) \ w32f path \ *G Append a directory to the Forth search path. search-path "path+ ; : fpath+ ( -<directory>- -- ) \ w32f path system \ *G Append a directory to the Forth search path. --- 410,427 ---- \ ** Applications that let Forth compile should not change it. : "fbase-path+ ( a1 n1 -- ) \ w32f path \ *G Append a directory to the Forth search base path. search-base-path "path+ ; : "fpath+ ( a1 n1 -- ) \ w32f path \ *G Append a directory to the Forth search path. search-path "path+ ; + in-system + + : fbase-path+ ( -<directory>- -- ) \ w32f path system + \ *G Append a directory to the Forth search base path. + /parse-s$ count "fbase-path+ ; + : fpath+ ( -<directory>- -- ) \ w32f path system \ *G Append a directory to the Forth search path. |
|
From: Jos v.d.V. <jo...@us...> - 2006-12-03 19:05:34
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29537 Modified Files: paths.f Log Message: Jos: Turns out that the filename$ is destroyed when an invalid path is used. So I used the orginal a1 n1 to get it back. Index: paths.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/paths.f,v retrieving revision 1.30 retrieving revision 1.31 diff -C2 -d -r1.30 -r1.31 *** paths.f 3 Dec 2006 18:30:20 -0000 1.30 --- paths.f 3 Dec 2006 19:05:30 -0000 1.31 *************** *** 198,202 **** current$ restore-current \ restore current dir ! filename$ zcount true ; \ return input file and error flag : find-path { a1 n1 basepath path \ filename$ current$ search-current$ -- a2 n2 f1 } --- 198,202 ---- current$ restore-current \ restore current dir ! a1 n1 true ; \ return input file and error flag : find-path { a1 n1 basepath path \ filename$ current$ search-current$ -- a2 n2 f1 } |
|
From: Jos v.d.V. <jo...@us...> - 2006-12-03 18:30:27
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv15490 Modified Files: paths.f Log Message: Jos: Repaired full-path Index: paths.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/paths.f,v retrieving revision 1.29 retrieving revision 1.30 diff -C2 -d -r1.29 -r1.30 *** paths.f 2 Dec 2006 15:17:06 -0000 1.29 --- paths.f 3 Dec 2006 18:30:20 -0000 1.30 *************** *** 198,202 **** current$ restore-current \ restore current dir ! filename$ search-error ; \ return input file and error flag : find-path { a1 n1 basepath path \ filename$ current$ search-current$ -- a2 n2 f1 } --- 198,202 ---- current$ restore-current \ restore current dir ! filename$ zcount true ; \ return input file and error flag : find-path { a1 n1 basepath path \ filename$ current$ search-current$ -- a2 n2 f1 } |
|
From: Dirk B. <db...@us...> - 2006-12-03 07:12:09
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv16230/apps/Win32ForthIDE Modified Files: Main.f Log Message: - I forgot to remove some debug code... Index: Main.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Main.f,v retrieving revision 1.33 retrieving revision 1.34 diff -C2 -d -r1.33 -r1.34 *** Main.f 2 Dec 2006 10:17:30 -0000 1.33 --- Main.f 3 Dec 2006 07:12:05 -0000 1.34 *************** *** 21,29 **** true value sysgen - cr .( .forthdir =) .forthdir - cr .( .dir =) .dir - - key drop - s" apps\Win32ForthIDE" "fpath+ s" apps\wined\res" "fpath+ --- 21,24 ---- |
|
From: George H. <geo...@us...> - 2006-12-02 15:17:10
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv4149/win32forth-stc/src Modified Files: paths.f Log Message: gah: Spelling corrections and minor optimisation. Index: paths.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/paths.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** paths.f 30 Sep 2006 15:17:33 -0000 1.4 --- paths.f 2 Dec 2006 15:17:06 -0000 1.5 *************** *** 152,156 **** cr ." Current directory: " current-dir$ count type ; ! : chdir ( -<optional_new_directory>- ) \ *G Set the current directory. /parse-word count "chdir cr .dir ; --- 152,156 ---- cr ." Current directory: " current-dir$ count type ; ! : chdir ( -<optional_new_directory>- -- ) \ *G Set the current directory. /parse-word count "chdir cr .dir ; *************** *** 162,172 **** IN-APPLICATION ! : path: ( - ) \ *G Defines a directory search path. \n \ ** The first 2 cells are used too handle a search path. \n \ ** The next 260 bytes are reserved for a counted string of a path. \n ! \ ** followed by 0. \n ! \ ** In runtime it returns adres of the counted string of a path ! create -1 , 0 , MAX-PATH 1+ allot does> \ run-time: ( - path ) [ 2 cells ] literal + ; --- 162,172 ---- IN-APPLICATION ! : path: ( -- ) \ *G Defines a directory search path. \n \ ** The first 2 cells are used too handle a search path. \n \ ** The next 260 bytes are reserved for a counted string of a path. \n ! \ ** followed by null. \n ! \ ** At runtime it returns address of the counted string of a path. ! create -1 , 0 , MAX-PATH 1+ allot does> \ run-time: ( -- path ) [ 2 cells ] literal + ; *************** *** 174,181 **** INTERNAL ! : path-source ( path - 2variable_path-source ) \ *G Path-source points to a substring in a path. \n ! \ ** Path-source returns this adress. ! 2 cells- ; EXTERNAL --- 174,180 ---- INTERNAL ! -2 cells offset path-source ( path -- 2variable_path-source ) \ *G Path-source points to a substring in a path. \n ! \ ** Path-source returns this address. EXTERNAL *************** *** 218,222 **** : .path ( path -- ) \ w32f path system \ *G Display a directory search path list. ! \ ** Note: The path source will be resetted for this path. dup >r first-path" begin dup --- 217,221 ---- : .path ( path -- ) \ w32f path system \ *G Display a directory search path list. ! \ ** Note: The path source will be reset for this path. dup >r first-path" begin dup *************** *** 231,236 **** INTERNAL ! : volume-indication? ( addr - flag ) ! \ True when the counted string at adr starts with x: or \\name dup 2 + c@ [char] : <> if count drop 2 s" \\" compare 0= --- 230,235 ---- INTERNAL ! : volume-indication? ( addr -- flag ) ! \ True when the counted string at addr starts with x: or \\name dup 2 + c@ [char] : <> if count drop 2 s" \\" compare 0= *************** *** 259,263 **** : full-path { a1 n1 path \ searchpath$ filename$ current$ -- a2 n2 f1 } \ *G Find the file \i a1,n1 \d in the path \i path \d and return the full path. ! \ ** \i a2,n2 \d . \i f1 \d = false if succeeded. a1 n1 MAX-PATH 1+ LocalAlloc ascii-z to filename$ \ save file name --- 258,262 ---- : full-path { a1 n1 path \ searchpath$ filename$ current$ -- a2 n2 f1 } \ *G Find the file \i a1,n1 \d in the path \i path \d and return the full path. ! \ ** \i a2,n2 \d . \i f1 \d = false if successful. a1 n1 MAX-PATH 1+ LocalAlloc ascii-z to filename$ \ save file name *************** *** 526,529 **** --- 525,529 ---- ' requires alias NEEDS + ' requires alias require \ Forth2000X name ' included alias "FLOAD ' fload alias INCLUDE *************** *** 534,538 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! : "file-clip" { adr len limit \ temp$ pre -- 'adr 'len } \ *G Clip filename to limit. new$ to temp$ \ so string isn't de-allocated on exit --- 534,538 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! : "file-clip" { addr len limit \ temp$ pre -- 'addr 'len } \ *G Clip filename to limit. new$ to temp$ \ so string isn't de-allocated on exit *************** *** 540,549 **** limit 20 - 2 / 6 + to pre \ balance start and end len limit > ! if adr pre 3 - temp$ place \ lay in first 5 chars s" ..." temp$ +place \ append some dots ! adr len dup limit pre - - 0MAX /string \ clip to last part temp$ +place \ of name and lay in temp$ count ! else adr len \ no need to clip file then ; --- 540,549 ---- limit 20 - 2 / 6 + to pre \ balance start and end len limit > ! if addr pre 3 - temp$ place \ lay in first 5 chars s" ..." temp$ +place \ append some dots ! addr len dup limit pre - - 0MAX /string \ clip to last part temp$ +place \ of name and lay in temp$ count ! else addr len \ no need to clip file then ; |
|
From: George H. <geo...@us...> - 2006-12-02 15:17:10
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv4149/win32forth/src Modified Files: paths.f Log Message: gah: Spelling corrections and minor optimisation. Index: paths.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/paths.f,v retrieving revision 1.28 retrieving revision 1.29 diff -C2 -d -r1.28 -r1.29 *** paths.f 2 Dec 2006 10:14:51 -0000 1.28 --- paths.f 2 Dec 2006 15:17:06 -0000 1.29 *************** *** 59,65 **** /parse-word count "chdir cr .dir ; - - IN-APPLICATION - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Multiple directory path search capability for file open --- 59,62 ---- *************** *** 68,78 **** IN-APPLICATION ! : path: ( - ) \ *G Defines a directory search path. \n \ ** The first 2 cells are used too handle a search path. \n \ ** The next 260 bytes are reserved for a counted string of a path. \n ! \ ** followed by 0. \n ! \ ** In runtime it returns adres of the counted string of a path ! create -1 , 0 , MAX-PATH 1+ allot does> \ run-time: ( - path ) [ 2 cells ] literal + ; --- 65,75 ---- IN-APPLICATION ! : path: ( -- ) \ *G Defines a directory search path. \n \ ** The first 2 cells are used too handle a search path. \n \ ** The next 260 bytes are reserved for a counted string of a path. \n ! \ ** followed by null. \n ! \ ** At runtime it returns address of the counted string of a path. ! create -1 , 0 , MAX-PATH 1+ allot does> \ run-time: ( -- path ) [ 2 cells ] literal + ; *************** *** 80,87 **** INTERNAL ! : path-source ( path - 2variable_path-source ) \ *G Path-source points to a substring in a path. \n ! \ ** Path-source returns this adress. ! 2 cells- ; EXTERNAL --- 77,83 ---- INTERNAL ! -2 cells offset path-source ( path -- 2variable_path-source ) \ *G Path-source points to a substring in a path. \n ! \ ** Path-source returns this address. EXTERNAL *************** *** 124,128 **** : .path ( path -- ) \ w32f path system \ *G Display a directory search path list. ! \ ** Note: The path source will be resetted for this path. dup >r first-path" begin dup --- 120,124 ---- : .path ( path -- ) \ w32f path system \ *G Display a directory search path list. ! \ ** Note: The path source will be reset for this path. dup >r first-path" begin dup *************** *** 137,142 **** INTERNAL ! : volume-indication? ( addr - flag ) ! \ True when the counted string at adr starts with x: or \\name dup 2 + c@ [char] : <> if count drop 2 s" \\" compare 0= --- 133,138 ---- INTERNAL ! : volume-indication? ( addr -- flag ) ! \ True when the counted string at addr starts with x: or \\name dup 2 + c@ [char] : <> if count drop 2 s" \\" compare 0= *************** *** 165,169 **** : full-path { a1 n1 path \ searchpath$ filename$ current$ -- a2 n2 f1 } \ *G Find the file \i a1,n1 \d in the path \i path \d and return the full path. ! \ ** \i a2,n2 \d . \i f1 \d = false if succeeded. a1 n1 MAX-PATH 1+ LocalAlloc ascii-z to filename$ \ save file name --- 161,165 ---- : full-path { a1 n1 path \ searchpath$ filename$ current$ -- a2 n2 f1 } \ *G Find the file \i a1,n1 \d in the path \i path \d and return the full path. ! \ ** \i a2,n2 \d . \i f1 \d = false if successful. a1 n1 MAX-PATH 1+ LocalAlloc ascii-z to filename$ \ save file name |
|
From: George H. <geo...@us...> - 2006-12-02 15:17:10
|
Update of /cvsroot/win32forth/win32forth/doc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv4149/win32forth/doc Modified Files: Paths.htm Log Message: gah: Spelling corrections and minor optimisation. Index: Paths.htm =================================================================== RCS file: /cvsroot/win32forth/win32forth/doc/Paths.htm,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** Paths.htm 25 Sep 2006 11:42:57 -0000 1.7 --- Paths.htm 2 Dec 2006 15:17:06 -0000 1.8 *************** *** 39,109 **** The next 260 bytes are reserved for a counted string of a path. <br /> followed by null. <br /> ! At runtime it returns address of the counted string of a path ! </p><pre><b><a name="8">: path-source ( path -- 2variable_path-source ) </a></b></pre><p>Path-source points to a substring in a path. <br /> Path-source returns this address. ! </p><pre><b><a name="9">path: path-ptr deprecated ! </a></b></pre><p>The old functionality had the bad habbit to pass a pointer through a ! value instead of passing the parameter over the stack. <br /> ! Use win32forth\src\Compat\OldPaths.f for the old functionality. <br /> ! Words like first-path" and next-path" are now able to handle ! each path separate without saving and restoring a path-ptr. ! </p><pre><b><a name="10">path: search-path ! </a></b></pre><p>search-path defines the path buffer for Forth.<br /> Applications that let Forth ! compile should not change it in a way that Forth is not able too compile. ! </p><pre><b><a name="11">: next-path" ( path -- a1 n1 ) </a></b></pre><p>Get the next path from dir list. ! </p><pre><b><a name="12">: reset-path-source ( path -- ) </a></b></pre><p>Points the path-source to the whole path. ! </p><pre><b><a name="13">: first-path" ( path -- a1 n1 ) </a></b></pre><p>Get the first forth directory path. ! </p><pre><b><a name="14">: "path+ ( a1 n1 path -- ) </a></b></pre><p>Append a directory to a path. ! </p><pre><b><a name="15">: "fpath+ ( a1 n1 -- ) ! </a></b></pre><p>Append a directory to the Forth path. ! </p><pre><b><a name="16">: fpath+ ( -<directory>- ) ! </a></b></pre><p>Append a directory to the Forth path. ! </p><pre><b><a name="17">: .path ( path -- ) </a></b></pre><p>Display a directory search path list. ! </p><pre><b><a name="18">: .fpath ( -- ) </a></b></pre><p>Display the Forth directory search path list. ! </p><pre><b><a name="19">: volume-indication? ( addr -- flag ) ! </a></b></pre><p>True when the counted string at addr starts with x: or \name ! </p><pre><b><a name="20">: full-path { a1 n1 path \ searchpath$ filename$ current$ -- a2 n2 f1 } ! </a></b></pre><p>Find file a1,n1 in a path and return the full path. <br /> ! a2,n2 and f1=false, succeeded. ! </p><pre><b><a name="21">: program-path-init ( -- ) </a></b></pre><p>Initialize the Forth directory search path list. Automatically done at program initialization and when Paths.f is loaded. ! </p><pre><b><a name="22">: "path-file { a1 n1 \ current$ -- a2 n2 f1 } ! </a></b></pre><p>Find file a1,n1 in the Forth path and return the full path. <br /> a2,n2 and f1=false, succeeded. ! </p><pre><b><a name="23">: n"open ( a1 n1 -- handle f1 ) </a></b></pre><p>Open file a1,n1 with a Forth path search. ! </p><pre><b><a name="24">: MakeAbsolutePath ( a1 n1 a2 n2 -- a3 ) </a></b></pre><p>Make path a1 n1 absolute to path a2 n2. ! </p><pre><b><a name="25">: IsPathRelativeTo? { a1 n1 a2 n2 -- f } </a></b></pre><p>Return true if path a1 n1 is relative to path a2 n2 ! </p><pre><b><a name="26">: MakePathRelativeTo ( a1 n1 a2 n2 -- a3 ) </a></b></pre><p>Make path a1 n1 relative to path a2 n2. ! </p><pre><b><a name="27">: FindRelativePath ( a1 n1 path - a2 n2 ) </a></b></pre><p>Returns a relative path for file a1 n1 in path ( first part ). <br /> n2=0 means not in search path. ! </p><pre><b><a name="28">: FindRelativeName ( a1 n1 path - a2 n2 f ) </a></b></pre><p>Returns a relative name for file a1 n1 in path ( last-part ). <br /> n2=0 means not in search path. ! </p><pre><b><a name="29">: "LOADED? ( addr len -- flag ) </a></b></pre><p>True if a file addr len is loaded. The filename must contain a full path. ! </p><pre><b><a name="30">: LOADED? ( -<name>- -- flag ) { \ current$ } </a></b></pre><p>True if the following file is loaded. The filename may be relative. ! </p><pre><b><a name="31">: \LOADED- ( -<name>- ) </a></b></pre><p>If the following file IS NOT LOADED interpret line. ! </p><pre><b><a name="32">: \LOADED ( -<name>- ) </a></b></pre><p> If the following file IS LOADED interpret line. ! </p><pre><b><a name="33">: NEEDS ( -<name>- ) </a></b></pre><p>Conditionally load file "name" if not loaded. ! </p><pre><b><a name="34">synonym Require needs </a></b></pre><p>Forth 200X name for needs. ! </p><pre><b><a name="35">: "file-clip" { addr len limit | temp$ pre -- addr len2 } </a></b></pre><p>Clip filename to limit. If limit is less than 20 then the filename is clipped to 20. len2=len if len < limit or len < 20. len2 = 20 if limit < 20. len2 = limt --- 39,113 ---- The next 260 bytes are reserved for a counted string of a path. <br /> followed by null. <br /> ! At runtime it returns address of the counted string of a path. ! </p><pre><b><a name="8">-2 cells offset path-source ( path -- 2variable_path-source ) </a></b></pre><p>Path-source points to a substring in a path. <br /> Path-source returns this address. ! </p><pre><b><a name="9">: next-path" ( path -- a1 n1 ) \ w32f path </a></b></pre><p>Get the next path from dir list. ! </p><pre><b><a name="10">: reset-path-source ( path -- ) \ w32f path </a></b></pre><p>Points the path-source to the whole path. ! </p><pre><b><a name="11">: first-path" ( path -- a1 n1 ) \ w32f path </a></b></pre><p>Get the first forth directory path. ! </p><pre><b><a name="12">: "path+ ( a1 n1 path -- ) \ w32f path </a></b></pre><p>Append a directory to a path. ! </p><pre><b><a name="13">: .path ( path -- ) \ w32f path system </a></b></pre><p>Display a directory search path list. ! Note: The path source will be reset for this path. ! </p><pre><b><a name="14">: full-path { a1 n1 path \ searchpath$ filename$ current$ -- a2 n2 f1 } ! </a></b></pre><p>Find the file <i> a1,n1 </i> in the path <i> path </i> and return the full path. ! <i> a2,n2 </i> . <i> f1 </i> = false if successful. ! </p><pre><b><a name="15">: find-path { a1 n1 basepath path \ filename$ current$ search-current$ -- a2 n2 f1 } ! </a></b></pre><p>Find the file <i> a1,n1 </i> in the path <i> basepath </i> by scanning the sub folders ! defined in <i> path </i>. Returns the full path of the file if possible. ! <i> a2,n2 </i> . <i> f1 </i> = false if succeeded. ! </p><pre><b><a name="16">path: search-base-path \ w32f path ! </a></b></pre><p>The path buffer for the base search folders for Forth.<br /> ! Applications that let Forth compile should not change it. ! </p><pre><b><a name="17">path: search-path \ w32f path ! </a></b></pre><p>The path buffer for the sub folders to search in. ! Applications that let Forth compile should not change it. ! </p><pre><b><a name="18">: "fbase-path+ ( a1 n1 -- ) \ w32f path ! </a></b></pre><p>Append a directory to the Forth search base path. ! </p><pre><b><a name="19">: "fpath+ ( a1 n1 -- ) \ w32f path ! </a></b></pre><p>Append a directory to the Forth search path. ! </p><pre><b><a name="20">: fbase-path+ ( -<directory>- -- ) \ w32f path system ! </a></b></pre><p>Append a directory to the Forth search base path. ! </p><pre><b><a name="21">: fpath+ ( -<directory>- -- ) \ w32f path system ! </a></b></pre><p>Append a directory to the Forth search path. ! </p><pre><b><a name="22">: .fpath ( -- ) \ w32f path system </a></b></pre><p>Display the Forth directory search path list. ! </p><pre><b><a name="23">: program-path-init ( -- ) </a></b></pre><p>Initialize the Forth directory search path list. Automatically done at program initialization and when Paths.f is loaded. ! </p><pre><b><a name="24">: "path-file ( a1 n1 -- a2 n2 f1 ) ! </a></b></pre><p>Find file a1,n1 in the Forth search path and return the full path. <br /> a2,n2 and f1=false, succeeded. ! </p><pre><b><a name="25">: n"open ( a1 n1 -- handle f1 ) </a></b></pre><p>Open file a1,n1 with a Forth path search. ! </p><pre><b><a name="26">: MakeAbsolutePath ( a1 n1 a2 n2 -- a3 ) </a></b></pre><p>Make path a1 n1 absolute to path a2 n2. ! </p><pre><b><a name="27">: IsPathRelativeTo? { a1 n1 a2 n2 -- f } </a></b></pre><p>Return true if path a1 n1 is relative to path a2 n2 ! </p><pre><b><a name="28">: MakePathRelativeTo ( a1 n1 a2 n2 -- a3 ) </a></b></pre><p>Make path a1 n1 relative to path a2 n2. ! </p><pre><b><a name="29">: FindRelativePath ( a1 n1 path - a2 n2 ) </a></b></pre><p>Returns a relative path for file a1 n1 in path ( first part ). <br /> n2=0 means not in search path. ! </p><pre><b><a name="30">: FindRelativeName ( a1 n1 path - a2 n2 f ) </a></b></pre><p>Returns a relative name for file a1 n1 in path ( last-part ). <br /> n2=0 means not in search path. ! </p><pre><b><a name="31">: "LOADED? ( addr len -- flag ) </a></b></pre><p>True if a file addr len is loaded. The filename must contain a full path. ! </p><pre><b><a name="32">: LOADED? ( -<name>- -- flag ) { \ current$ } </a></b></pre><p>True if the following file is loaded. The filename may be relative. ! </p><pre><b><a name="33">: \LOADED- ( -<name>- ) </a></b></pre><p>If the following file IS NOT LOADED interpret line. ! </p><pre><b><a name="34">: \LOADED ( -<name>- ) </a></b></pre><p> If the following file IS LOADED interpret line. ! </p><pre><b><a name="35">: NEEDS ( -<name>- ) </a></b></pre><p>Conditionally load file "name" if not loaded. ! </p><pre><b><a name="36">synonym Require needs </a></b></pre><p>Forth 200X name for needs. ! </p><pre><b><a name="37">: "file-clip" { addr len limit | temp$ pre -- addr len2 } </a></b></pre><p>Clip filename to limit. If limit is less than 20 then the filename is clipped to 20. len2=len if len < limit or len < 20. len2 = 20 if limit < 20. len2 = limt |
1040 messages has been excluded from this view by a project administrator.
