Menu
▾
▴
[Win32forth-cvs] win32forth/src/console CONSOLE.F,1.4,1.5 Console2.f,1.1,1.2 ConsoleMenu.f,1.3,1.4 LINEEDIT.F,1.3,1.4
|
From: Dirk B. <db...@us...> - 2005-08-29 15:56:38
|
Update of /cvsroot/win32forth/win32forth/src/console In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31814/src/console Modified Files: CONSOLE.F Console2.f ConsoleMenu.f LINEEDIT.F Log Message: - Marked >BOLD , >NORM and set-font as depreacted (they don't work anyway) - Marked SP>COL as depreacted (use COL instead) - Removed >BOLD and >NORM from the files - Removed the supporting code for WinEd's internal console window. - Moved then code for communication between WinEd/SciEdit from Mapfile.f into EditorIO.f. - Moved some code around in the files to minimize the file dependencices (there can more done...) - Marked the xxx-pointer words in ScrnCtrl.f as depreacted (use the xxx-cursor words from utils.f) instead. Index: Console2.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/Console2.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** Console2.f 21 Dec 2004 00:19:09 -0000 1.1 --- Console2.f 29 Aug 2005 15:56:28 -0000 1.2 *************** *** 8,11 **** --- 8,12 ---- \ before this. + cr .( Loading... Console I/O Part 2) \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 97,100 **** --- 98,102 ---- then ; + new-chain mouse-chain \ chain of things to do on mouse down mouse-chain chain-add ?mouse_abort *************** *** 194,199 **** \ ------------------------------------------------------------------------------ - 0 value remote-io? \ is I/O being directed to remote console? - defer@ accept value defaultAccept --- 196,199 ---- *************** *** 221,226 **** focus-console tabing-off ! ! FALSE to remote-io? ; defer basic-forth-io ' _basic-forth-io is basic-forth-io --- 221,225 ---- focus-console tabing-off ! ; defer basic-forth-io ' _basic-forth-io is basic-forth-io *************** *** 287,312 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ allow the user to set the current display FONT \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! WINLIBRARY GDI32.DLL ! 1 proc GetDC ! 2 proc ReleaseDC ! 1 proc GetStockObject ! 2 proc SelectObject : set-font ( font_value -- ) ! conHndl call GetDC >r \ get and save the Device Control # ! call GetStockObject \ return the object information ! r@ call SelectObject drop \ selects the object ! r> conHndl call ReleaseDC drop ; ! ! : _>bold ( -- ) ! OEM_FIXED_FONT set-font ; ! ! : _>norm ( -- ) ! ANSI_FIXED_FONT set-font ; ! ! ' _>bold is >bold ! ' _>norm is >norm \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 286,312 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ allow the user to set the current display FONT + \ doesn't work so it's deprecated \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ WINLIBRARY GDI32.DLL ! \ 1 proc GetDC ! \ 2 proc ReleaseDC ! \ 1 proc GetStockObject ! \ 2 proc SelectObject : set-font ( font_value -- ) ! \ conHndl call GetDC >r \ get and save the Device Control # ! \ call GetStockObject \ return the object information ! \ r@ call SelectObject drop \ selects the object ! \ r> conHndl call ReleaseDC drop ! ; DEPRECATED + \ : _>bold ( -- ) + \ OEM_FIXED_FONT set-font ; + \ + \ : _>norm ( -- ) + \ ANSI_FIXED_FONT set-font ; + \ + \ ' _>bold is >bold + \ ' _>norm is >norm \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ Index: CONSOLE.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/CONSOLE.F,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** CONSOLE.F 17 May 2005 22:42:30 -0000 1.4 --- CONSOLE.F 29 Aug 2005 15:56:28 -0000 1.5 *************** *** 8,11 **** --- 8,12 ---- \ Win32Forth Terminal I/O (Moved here from Primutil.f ) + cr .( Loading... Console I/O Part 1) \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 36,42 **** \ sound stuff \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! ! VARIABLE TONE_FREQ 500 TONE_FREQ ! ! VARIABLE TONE_DURA 100 TONE_DURA ! 2 PROC Beep --- 37,42 ---- \ sound stuff \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! VARIABLE TONE_FREQ 700 TONE_FREQ ! ! VARIABLE TONE_DURA 50 TONE_DURA ! 2 PROC Beep *************** *** 50,53 **** --- 50,56 ---- tone_freq @ tone_dura @ tone ; + defer beep ' _beep is beep \ default sound stuff + + synonym NOTE tone DEPRECATED \ use TONE instad \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 55,63 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! defer beep ' _beep is beep \ default sound stuff ! defer >bold ' noop is >bold \ set bold font in console window ! defer >norm ' noop is >norm \ set normal font in console window ! defer page ' cls is page \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 58,67 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! defer page ' cls is page + \ the next two words are deprecated because changeing the + \ console font doesn't realy work + defer >bold DEPRECATED \ ' noop is >bold \ set bold font in console window + defer >norm DEPRECATED \ ' noop is >norm \ set normal font in console window \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 65,70 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! synonym SP>COL COL ! synonym AT-XY gotoxy : cols ( -- n1 ) \ current screen columns --- 69,74 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! synonym SP>COL COL DEPRECATED ! synonym AT-XY gotoxy \ ANS Version of gotoxy : cols ( -- n1 ) \ current screen columns *************** *** 73,101 **** : rows ( -- n1 ) \ current screen rows getcolrow nip ; - 0 value accept-cnt \ current count of chars accepted - : _faccept ( a1 n1 -- n2 ) - 0 swap 0 - ?do drop - i to accept-cnt \ save in case we need it - key - case 8 of i 1 < \ if input is empty - if 0 \ do nothing but - beep \ beep at user - else 1- \ decrement address 1 - -1 08 emit - bl emit - 08 emit - then - endof - 27 of dup c@ emit 1+ 1 endof - 13 of i leave endof - dup emit - 2dup swap c! \ place the character - swap 1+ swap \ bump the address - 1 swap \ loop increment - endcase i 1+ swap \ incase loop completes - +loop nip ; ! ' _faccept is accept \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 77,106 ---- : rows ( -- n1 ) \ current screen rows getcolrow nip ; ! \ 0 value accept-cnt \ current count of chars accepted ! \ : _faccept ( a1 n1 -- n2 ) ! \ 0 swap 0 ! \ ?do drop ! \ i to accept-cnt \ save in case we need it ! \ key ! \ case 8 of i 1 < \ if input is empty ! \ if 0 \ do nothing but ! \ beep \ beep at user ! \ else 1- \ decrement address 1 ! \ -1 08 emit ! \ bl emit ! \ 08 emit ! \ then ! \ endof ! \ 27 of dup c@ emit 1+ 1 endof ! \ 13 of i leave endof ! \ dup emit ! \ 2dup swap c! \ place the character ! \ swap 1+ swap \ bump the address ! \ 1 swap \ loop increment ! \ endcase i 1+ swap \ incase loop completes ! \ +loop nip ; ! \ ! \ ' _faccept is accept \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 238,242 **** 3 PROC InvalidateRect : ConsoleRepaint ( -- ) \ redraw console window ! 1 0 _conHndl call InvalidateRect drop ; : x_SetcharWH ( width height -- ) \ set the width and height of the --- 243,247 ---- 3 PROC InvalidateRect : ConsoleRepaint ( -- ) \ redraw console window ! 1 0 _conHndl call InvalidateRect drop ; : x_SetcharWH ( width height -- ) \ set the width and height of the *************** *** 248,265 **** : SetConsoleFont ( hFont -- ) \ set the console font. If hFont is NULL the ! \ default font will be set. ! call c_setfont drop ! ConsoleRepaint ; \ force repaint ! \ Usage: \ ! \ Font cFont ! \ 16 Height: cFont ! \ 8 Width: cFont ! \ s" Courier New" SetFaceName: cFont ! \ FW_NORMAL Weight: cFont ! \ Create: cFont ! \ Handle: cFont SetConsoleFont ! \ zHandle: cFont \ don't let Win32Forth destroy the font; the console does it !!! --- 253,270 ---- : SetConsoleFont ( hFont -- ) \ set the console font. If hFont is NULL the ! \ default font will be set. ! call c_setfont drop ! ConsoleRepaint ; \ force repaint ! \ Usage of SetConsoleFont: \ ! \ Font cFont ! \ 16 Height: cFont ! \ 8 Width: cFont ! \ s" Courier New" SetFaceName: cFont ! \ FW_NORMAL Weight: cFont ! \ Create: cFont ! \ Handle: cFont SetConsoleFont ! \ zHandle: cFont \ don't let Win32Forth destroy the font; the console does it !!! *************** *** 394,396 **** SYNONYM _BYE k_BYE DEPRECATED - --- 399,400 ---- Index: ConsoleMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/ConsoleMenu.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** ConsoleMenu.f 5 Aug 2005 08:41:06 -0000 1.3 --- ConsoleMenu.f 29 Aug 2005 15:56:28 -0000 1.4 *************** *** 6,9 **** --- 6,11 ---- only forth also definitions + in-application + INTERNAL \ internal definitions start here *************** *** 140,165 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! EXTERNAL \ externally available definitions start here ! ! defer class-browser ! :noname ( -- ) \ load the class and vocabulary browser ! turnkeyed? 0= ! \in-system-ok IF s" Tools/ClassBrowser.f" INCLUDED ! then ; is class-browser ! ! defer help-system ! :noname ( -- ) \ load the help-system ! turnkeyed? 0= ! \in-system-ok IF s" Tools/HelpSystem.f" INCLUDED ! THEN ; is help-system ! ! defer xref ! :noname ( -- ) \ load the xref tool ! turnkeyed? 0= ! \in-system-ok IF >system s" Tools/xref.f" INCLUDED system> ! THEN ; is xref ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ MENUBAR Win32Forth-Menu-bar --- 142,159 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ INTERNAL \ internal definitions start here ! \ ! \ |Class MENUCONSOLE <Super MENUITEM \ Only for use with the console window ! \ ! \ :M DoMenu: ( IDM -- ) ! \ mid = ! \ if mfunc execute-menufunc ! \ cr ! \ [DEFINED] ledit-y [IF] getxy to ledit-y to ledit-x \ move lineeditor down ! \ [THEN] then ;M ! \ ! \ ;Class ! EXTERNAL MENUBAR Win32Forth-Menu-bar *************** *** 395,397 **** MODULE \ end of the module - |
