Menu
▾
▴
[Win32forth-cvs] win32forth/src/console Console1.f, 1.2, 1.3 Console2.f, 1.10, 1.11 ConsoleMenu.f, 1.16, 1.17 NewConsole.f, 1.22, 1.23
|
From: Rod O. <rod...@us...> - 2008-08-19 12:48:38
|
Update of /cvsroot/win32forth/win32forth/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv17747 Modified Files: Console1.f Console2.f ConsoleMenu.f NewConsole.f Log Message: Rod: removed some unnecessary deferred I/O words for the new console Index: NewConsole.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/NewConsole.f,v retrieving revision 1.22 retrieving revision 1.23 diff -C2 -d -r1.22 -r1.23 *** NewConsole.f 18 Aug 2008 21:19:48 -0000 1.22 --- NewConsole.f 19 Aug 2008 12:48:34 -0000 1.23 *************** *** 269,277 **** EndPrompt: cmd ; ! \ required for debug ' c_key? is x_key? ' c_key is x_key ! : c_Init-Console ( -- f ) \ start the Console window hidden or show console if already started \ progreg-init --- 269,277 ---- EndPrompt: cmd ; ! (( \ required for debug ' c_key? is x_key? ' c_key is x_key ! )) : c_Init-Console ( -- f ) \ start the Console window hidden or show console if already started \ progreg-init *************** *** 320,324 **** : NewConsole ( -- ) \ reset all defered words for the console window ! ['] NOOP IS INIT-CONSOLE-REG \ no ['] c_Init-Console IS INIT-CONSOLE ['] c_INIT-SCREEN IS INIT-SCREEN --- 320,324 ---- : NewConsole ( -- ) \ reset all defered words for the console window ! \ ['] NOOP IS INIT-CONSOLE-REG \ no ['] c_Init-Console IS INIT-CONSOLE ['] c_INIT-SCREEN IS INIT-SCREEN *************** *** 328,332 **** ['] c_pushkey IS PUSHKEY ['] c_"pushkeys IS "PUSHKEYS - \ ['] K_NOOP1 IS SHIFTMASK \ defined in Console.f - needed ['] X_SHIFTMASK IS SHIFTMASK ['] c_cls IS CLS --- 328,331 ---- *************** *** 335,359 **** ['] c_cr IS CR ['] c_?cr IS ?CR ! ['] NOOP IS CONSOLE \ no ( NewConsole ) ['] c_gotoxy IS GOTOXY ['] c_getxy IS GETXY ['] c_getcolrow IS GETCOLROW ! ['] K_NOOP1 IS SIZESTATE \ no ( ConsoleWindow.WindowState ) ! ['] 4DROP IS MARKCONSOLE \ no ( 2swap swap GoToXY:cmd swap Select: cmd ) ! ['] NOOP IS CURSORINVIEW \ no ( does nothing ??? AutoScroll: cmd ) ['] c_FGBG! IS FGBG! \ using foreground/background color_objects ['] c_FG@ IS FG@ ['] c_BG@ IS BG@ ['] c_CharWH IS CHARWH \ ( cmd.HorzLine cmd.VertLine ) ! ['] 2DROP IS SETCHARWH \ no ( change the font ) ! ['] 2DROP IS SETCOLROW \ no ( resize ConsoleWindow ) ! ['] DROP IS SET-CURSOR \ no big-cursor, norm-cursor ??? ! ['] K_NOOP1 IS GET-CURSOR \ no ! ['] DROP IS SETROWOFF \ no ! ['] K_NOOP1 IS GETROWOFF \ no ! ['] K_NOOP2 IS GETMAXCOLROW \ max console size - see wrapper??? ! ['] 2DROP IS SETMAXCOLROW \ check wrapper??? ! ['] c_&TheScreen IS &THE-SCREEN \ #print-screen in dc.f will not work ! \ keysave not working ['] NewConHndl IS conHndl ['] c_copy-console IS copy-console --- 334,357 ---- ['] c_cr IS CR ['] c_?cr IS ?CR ! ['] NOOP IS CONSOLE \ no ( NewConsole ) ['] c_gotoxy IS GOTOXY ['] c_getxy IS GETXY ['] c_getcolrow IS GETCOLROW ! \ ['] K_NOOP1 IS SIZESTATE \ no ( ConsoleWindow.WindowState ) ! \ ['] 4DROP IS MARKCONSOLE \ no ( 2swap swap GoToXY:cmd swap Select: cmd ) ! \ ['] NOOP IS CURSORINVIEW \ no ( does nothing ??? AutoScroll: cmd ) ['] c_FGBG! IS FGBG! \ using foreground/background color_objects ['] c_FG@ IS FG@ ['] c_BG@ IS BG@ ['] c_CharWH IS CHARWH \ ( cmd.HorzLine cmd.VertLine ) ! \ ['] 2DROP IS SETCHARWH \ no ( change the font ) ! \ ['] 2DROP IS SETCOLROW \ no ( resize ConsoleWindow ) ! \ ['] DROP IS SET-CURSOR \ no big-cursor, norm-cursor ??? ! \ ['] K_NOOP1 IS GET-CURSOR \ no ! \ ['] DROP IS SETROWOFF \ no ! \ ['] K_NOOP1 IS GETROWOFF \ no ! \ ['] K_NOOP2 IS GETMAXCOLROW \ max console size - see wrapper??? ! \ ['] 2DROP IS SETMAXCOLROW \ check wrapper??? ! ['] c_&TheScreen IS &THE-SCREEN \ #print-screen in dc.f will not work **************** ['] NewConHndl IS conHndl ['] c_copy-console IS copy-console *************** *** 368,372 **** 'W' +k_control of open-web endof 'L' +k_control of load-forth endof ! 'P' +k_control of print-screen endof 'D' +k_control of ChdirDlg endof [DEFINED] replay-macro [IF] --- 366,370 ---- 'W' +k_control of open-web endof 'L' +k_control of load-forth endof ! \ 'P' +k_control of print-screen endof 'D' +k_control of ChdirDlg endof [DEFINED] replay-macro [IF] Index: ConsoleMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/ConsoleMenu.f,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** ConsoleMenu.f 19 Aug 2008 03:55:24 -0000 1.16 --- ConsoleMenu.f 19 Aug 2008 12:48:34 -0000 1.17 *************** *** 105,163 **** if 0 0 ExecIDE drop then ; - (( - ledit-chain chain-add ?f1-help \ help key recognition - - : ?macro-keys ( chad flag -- char flag ) - dup ?exit - over [ 'S' +k_control +k_shift ] literal = - if 0= start/stop-macro EXIT then - over [ 'M' +k_control +k_shift ] literal = - if 0= replay-macro EXIT then - over [ 'R' +k_control +k_shift ] literal = - if 0= CONHNDL repeat-amacro EXIT then - over [ 'O' +k_control ] literal = - if 0= edit-forth EXIT then - over [ 'W' +k_control ] literal = - if 0= open-web EXIT then - over [ K_F12 ] literal = - \in-system-ok if 0= 2>r >r LoadProject r> 2r> EXIT then - over [ 'L' +k_control ] literal = - if 0= load-forth EXIT then - over [ 'P' +k_control ] literal = - if 0= print-screen EXIT then - over [ 'X' +k_control ] literal = - if 0= cut-console - [DEFINED] ledit-y - [IF] getxy nip to ledit-y - [THEN] EXIT then - over [ 'A' +k_control ] literal = - if 0= mark-all EXIT then - over [ 'C' +k_control ] literal = - if 0= copy-console EXIT then - over [ 'V' +k_control ] literal = - if 0= paste-load EXIT then - turnkeyed? ?exit - over [ 'D' +k_control ] literal = - if 0= ChdirDlg EXIT then - ; - - ledit-chain chain-add ?macro-keys \ add macro key recognition - )) - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - - \ 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 --- 105,108 ---- *************** *** 165,169 **** \ Note: If you add a new menu entry with a shortcut, you must add ! \ add the handling of the shortcut to ?MACRO-KEYS !!! POPUP "&File" --- 110,114 ---- \ Note: If you add a new menu entry with a shortcut, you must add ! \ add the handling of the shortcut to HandleKeys in NewConsole.f !!! POPUP "&File" *************** *** 202,207 **** MENUITEM "Pages Up Setup..." page-up-setup ; MENUITEM "&Print Forth File..." print-forth ; ! MENUITEM "Print Forth Console Window...\tCtrl+P" print-screen ; ! MENUITEM "Print Forth Console Buffer..." print-console ; MENUSEPARATOR MENUCONSOLE "E&xit Win32Forth \tBYE" bye ; --- 147,152 ---- MENUITEM "Pages Up Setup..." page-up-setup ; MENUITEM "&Print Forth File..." print-forth ; ! \ MENUITEM "Print Forth Console Window...\tCtrl+P" print-screen ; ! \ MENUITEM "Print Forth Console Buffer..." print-console ; MENUSEPARATOR MENUCONSOLE "E&xit Win32Forth \tBYE" bye ; *************** *** 220,224 **** MENULINE "Operating System Version \t.PLATFORM" ".PLATFORM" MENULINE "Console Current Size \tGetColRow . ." "GetColRow . ." ! MENULINE "Console Maximum Size \tGetMaxColRow . ." "GetMaxColRow . ." MENULINE "Return Stack Contents \t.RSTACK" ".RSTACK" MENULINE "Memory Used and Available \t.FREE" ".FREE" --- 165,169 ---- MENULINE "Operating System Version \t.PLATFORM" ".PLATFORM" MENULINE "Console Current Size \tGetColRow . ." "GetColRow . ." ! \ MENULINE "Console Maximum Size \tGetMaxColRow . ." "GetMaxColRow . ." MENULINE "Return Stack Contents \t.RSTACK" ".RSTACK" MENULINE "Memory Used and Available \t.FREE" ".FREE" *************** *** 306,335 **** INTERNAL \ more internal definitions - (( - : menukey ( -- c1 ) \ keyboard/event handler for console menus - cursorinview - BEGIN _mkey - dup menu_mask and - WHILE havemenu? - IF 0xFFFF and - dup DoMenu: console-menu - dup DoMenu: console-popup - THEN drop - REPEAT menukey-more ; - - : menu-forth-io ( -- ) - ['] menukey is key ; - - FORTH-IO-CHAIN CHAIN-ADD MENU-FORTH-IO - - menu-forth-io - )) - (( - : RightMouseClick ( -- ) \ Handle a right mouse click - mouseflags 3 and 2 <> ?EXIT \ exit if not right mouse clicked - mousex mousey conhndl Track: console-popup ; - - MOUSE-CHAIN CHAIN-ADD RightMouseClick - )) : Start-console-menu { \ mlink -- } \ startup the console's menubar --- 251,254 ---- *************** *** 348,355 **** conhndl loadmenu: console-popup ; - \ INITIALIZATION-CHAIN CHAIN-ADD START-CONSOLE-MENU - - \ Start-console-menu - EXTERNAL --- 267,270 ---- Index: Console1.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/Console1.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** Console1.f 19 Aug 2008 03:55:24 -0000 1.2 --- Console1.f 19 Aug 2008 12:48:34 -0000 1.3 *************** *** 150,154 **** synonym tabbing-on tabing-on ! : x_CRTAB ( -- ) cr \ [cdo] because w32fconsole.dll was removed \ have to check if there is still recursive call problems --- 150,154 ---- synonym tabbing-on tabing-on ! : CRTAB ( -- ) cr \ [cdo] because w32fconsole.dll was removed \ have to check if there is still recursive call problems *************** *** 162,167 **** then ; - DEFER CRTAB ' x_CRTAB IS CRTAB - : ?LINE ( n1 -- ) 0 max getxy drop + wrap? --- 162,165 ---- *************** *** 169,202 **** then ; ! (( \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Additional words for the console \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ - WINLIBRARY W32FCONSOLE.DLL - 1 PROC k_fpushkey - 2 PROC c_setfgbg - 0 PROC c_getfg - 0 PROC c_getbg - 0 PROC c_thescreen - 0 PROC c_charwh - 2 PROC c_setcharwh - 2 PROC c_resize - 1 PROC c_setcursorheight - 0 PROC c_getcursorheight - 1 PROC c_wscroll - 0 PROC c_rowoffset - 0 PROC c_maxcolrow - 2 PROC c_setmaxcolrow - 1 PROC c_setfont - - : x_pushkey ( c1 -- ) \ push c1 into the keyboard input stream - Call k_fpushkey drop ; - - : x_"pushkeys ( a1 n1 -- ) \ push the characters of string a1,n1 - 0max 127 min bounds - ?do i c@ x_pushkey - loop ; - )) 1 PROC GetKeyState : x_shiftmask ( -- mask ) --- 167,175 ---- then ; ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Additional words for the console \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 1 PROC GetKeyState : x_shiftmask ( -- mask ) *************** *** 213,266 **** : ?control ( -- f1 ) \ return true if control is down shiftmask control_mask and 0<> ; - (( - : x_cursorinview ( -- ) \ make sure cursor is visible in the window - ; - - : x_fgbg! ( forground background -- ) - Call c_setfgbg drop ; - - : x_fg@ ( -- foreground ) - Call c_getfg ; - - : x_bg@ ( -- background ) - Call c_getbg ; - - : x_&the-screen ( -- a1 ) \ get the forth relative address of the users - \ console screen memory buffer - Call c_thescreen ; - - : x_charWH ( -- width height ) \ get the width and height of the - \ current console font - Call c_charwh word-split swap ; - - 3 PROC InvalidateRect - : ConsoleRepaint ( -- ) \ redraw console window - 1 0 _conHndl call InvalidateRect drop ; - - : x_SetcharWH ( width height -- ) \ set the width and height of the - Call c_setcharwh drop \ current console font - ConsoleRepaint ; \ force repaint - - : x_setcolrow ( cols rows -- ) \ set the console size - Call c_resize drop ; - - : 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 !!! - - )) - synonym set-consize setcolrow 4 PROC SetWindowPos --- 186,189 ---- *************** *** 268,294 **** 2>r ( SWP_NOSIZE ) 1 0 0 2r> ( HWND_TOP ) 0 _conHndl call SetWindowPos drop ; - (( - 1 PROC SetCursor - 2 PROC LoadCursor - : set-pointer ( pointer-identifier -- ) \ set the pointer shape - 0 call LoadCursor call SetCursor drop ; - )) - (( - : x_set-cursor ( cursor-height -- ) \ set the cursor height - Call c_setcursorheight drop ; - - : x_get-cursor ( -- cursor-height ) \ get the cursor height - Call c_getcursorheight ; - - \ Note: The cursor hight is used by the Line Editor (in Lineedit.f) to - \ show the current insert/overstrike mode. So a direct call to - \ set-cursor, big-cursor or norm-cursor doesn't show any efect at all. - : big-cursor ( -- ) \ set a block cursor - charWH nip set-cursor ; - 2 value norm-height \ hold the norm cursor height - : norm-cursor ( -- ) \ set a normal cursor - norm-height set-cursor ; - )) 0 value havemenu? : havemenu! ( flag -- ) --- 191,195 ---- *************** *** 299,304 **** _conHndl call GetDC ; ! 0 value saveconx ! 0 value savecony 2 PROC ShowWindow --- 200,205 ---- _conHndl call GetDC ; ! \ 0 value saveconx ! \ 0 value savecony 2 PROC ShowWindow *************** *** 307,320 **** : hide-console ( -- ) ! saveconx ?exit ! getcolrow to savecony to saveconx ( SW_HIDE ) 0 show-window ; : unhide-console ( -- ) ! saveconx 0= ?exit ( SW_SHOW ) 5 show-window ! saveconx savecony setcolrow \ resize to original size ! 0 to saveconx ! 0 to savecony ; synonym show-console unhide-console --- 208,222 ---- : hide-console ( -- ) ! \ saveconx ?exit ! \ getcolrow to savecony to saveconx ( SW_HIDE ) 0 show-window ; : unhide-console ( -- ) ! \ saveconx 0= ?exit ( SW_SHOW ) 5 show-window ! \ saveconx savecony setcolrow \ resize to original size ! \ 0 to saveconx ! \ 0 to savecony ! ; synonym show-console unhide-console *************** *** 326,363 **** : focus-console ( -- ) _conHndl call SetFocus drop ; - (( - : x_setrowoff ( n1 -- ) \ set the console row offset - Call c_wscroll drop ; - - : x_getrowoff ( -- n1 ) \ get the current console row offset - Call c_rowoffset ; - - : x_getmaxcolrow ( -- maxcols maxrows ) \ get maximum window columns - Call c_maxcolrow word-split ; - - : x_setmaxcolrow ( maxcols maxrows -- ) \ set the saved screen area and clear - 16384 min 20 max swap \ clip rows - 256 min 26 max \ clip columns - Call c_setmaxcolrow drop ; - ' X_CURSORINVIEW IS CURSORINVIEW - ' X_FGBG! IS FGBG! - ' X_FG@ IS FG@ - ' X_BG@ IS BG@ - ' X_PUSHKEY IS PUSHKEY - ' X_"PUSHKEYS IS "PUSHKEYS - ' X_&THE-SCREEN IS &THE-SCREEN - ' X_CHARWH IS CHARWH - ' X_SETCHARWH IS SETCHARWH - ' X_SHIFTMASK IS SHIFTMASK - ' X_SETCOLROW IS SETCOLROW - ' X_SET-CURSOR IS SET-CURSOR - ' X_GET-CURSOR IS GET-CURSOR - ' X_SETROWOFF IS SETROWOFF - ' X_GETROWOFF IS GETROWOFF - ' X_GETMAXCOLROW IS GETMAXCOLROW - ' X_SETMAXCOLROW IS SETMAXCOLROW - )) \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Facility extension words --- 228,233 ---- Index: Console2.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/Console2.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** Console2.f 19 Aug 2008 03:55:24 -0000 1.10 --- Console2.f 19 Aug 2008 12:48:34 -0000 1.11 *************** *** 3,14 **** cr .( Loading... Console I/O Part 2) ! : forth-io ; ! : _mkey key ; ! \ required for debug ! warning @ ! warning off ! defer x_key ! defer x_key? ! warning ! 1 proc HideCaret --- 3,7 ---- cr .( Loading... Console I/O Part 2) ! : forth-io ; \ ******* need to look at printing the console in dc.f ********** 1 proc HideCaret *************** *** 108,114 **** defer auto_key? ' noop is auto_key? \ default to nothing - : marked? ( -- f1 ) \ return TRUE if any text is marked - false ; - defer menukey-more ' noop is menukey-more --- 101,104 ---- |
