Menu
▾
▴
win32forth-cvs
|
From: Rod O. <rod...@us...> - 2008-08-06 18:19:58
|
Update of /cvsroot/win32forth/win32forth/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv460 Modified Files: CommandWindow.f NewConsole.f Log Message: Rod: Keyboard Macros are now supported if KeySaveNew.f is loaded in ExtendNew.f Index: NewConsole.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/NewConsole.f,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** NewConsole.f 4 Aug 2008 09:05:07 -0000 1.9 --- NewConsole.f 6 Aug 2008 18:19:53 -0000 1.10 *************** *** 170,173 **** --- 170,174 ---- ; + (( : PauseForMessage { | pMsg -- } \ instead of "Winpause" 7 cells LocalAlloc: pMsg *************** *** 182,186 **** REPEAT ; ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 183,187 ---- REPEAT ; ! )) \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 225,229 **** VisibleCols: cmd dup to w cmd.X - to n1 ! WrapText OverwriteTextAtXY: cmd ; \ : c_type ( a n -- ) OverwriteTextAtXY: cmd ; --- 226,230 ---- VisibleCols: cmd dup to w cmd.X - to n1 ! WrapText OverwriteTextAtXY: cmd PauseForMessages ; \ : c_type ( a n -- ) OverwriteTextAtXY: cmd ; *************** *** 235,238 **** --- 236,241 ---- : c_getxy ( -- x y ) GetXY: cmd ; : c_gotoxy ( -- x y ) GoToXY: cmd ; + internal + external 0 value entered *************** *** 242,253 **** Prompt: cmd false to entered ! \ BEGIN GetKey: cmd HandleChar: cmd WaitForMessage entered UNTIL ! \ BEGIN KeyBufferEmpty: cmd IF call WaitMessage drop ELSE GetKey: cmd HandleChar: cmd THEN PauseForMessages entered UNTIL ! BEGIN cmd.VirtualKey ?dup IF HandleChar: cmd 0 SetVirtualKey: cmd ! ELSE KeyBufferEmpty: cmd IF call WaitMessage drop ELSE GetKey: cmd HandleChar: cmd THEN THEN PauseForMessages entered UNTIL EnteredString >r swap r@ move r> ; ! : AcceptCommand ( a n -- ) to EnteredString true to entered 0 0 0 0 call PostMessage drop ; ' AcceptCommand SetAction: cmd --- 245,261 ---- Prompt: cmd false to entered ! BEGIN auto_key cmd.VirtualKey ?dup ! IF 0 SetVirtualKey: cmd HandleChar: cmd ! ELSE ! KeyBufferEmpty: cmd ! IF call WaitMessage drop ! ELSE GetKey: cmd HandleChar: cmd ! THEN ! THEN ! PauseForMessages entered auto_key? UNTIL EnteredString >r swap r@ move r> ; ! : AcceptCommand ( a n -- ) to EnteredString true to entered ; ' AcceptCommand SetAction: cmd *************** *** 269,276 **** : c_key ( -- c ) \ keys from WM_KEYDOWN as well 1 SetMaxChars: cmd Prompt: cmd ! KeyBufferEmpty: cmd IF BEGIN KeysOff: cmd WaitForMessage c_key? UNTIL THEN ! cmd.VirtualKey ?dup 0= IF GetKey: cmd THEN EndPrompt: cmd ; --- 277,285 ---- : c_key ( -- c ) \ keys from WM_KEYDOWN as well + auto_key 1 SetMaxChars: cmd Prompt: cmd ! KeyBufferEmpty: cmd IF BEGIN KeysOff: cmd WaitForMessage c_key? auto_key? UNTIL THEN ! cmd.VirtualKey ?dup 0= IF GetKey: cmd ELSE 0 SetVirtualKey: cmd THEN EndPrompt: cmd ; *************** *** 310,315 **** Black White c_FGBG! - internal - external : K_NOOP0 2DROP 0 ; : K_NOOP1 0 ; --- 319,322 ---- *************** *** 367,371 **** ; ! :noname ( c -- ) Case 'O' +k_control of edit-forth endof --- 374,378 ---- ; ! :noname ( n -- ) Case 'O' +k_control of edit-forth endof *************** *** 374,384 **** 'P' +k_control of print-screen endof 'D' +k_control of ChdirDlg endof ! \ 'M' +k_control +k_shift of replay-macro endof ! \ 'R' +k_control +k_shift of CONHNDL repeat-amacro endof ! \ 'S' +k_control +k_shift of start/stop-macro endof ( default ) \ swap drop EndCase ! ; is HandleChar ! :noname ( c -- ) ?shift ?control or --- 381,396 ---- 'P' +k_control of print-screen endof 'D' +k_control of ChdirDlg endof ! [DEFINED] replay-macro [IF] ! 'M' +k_control +k_shift of replay-macro endof ! 'R' +k_control +k_shift of CONHNDL repeat-amacro endof ! 'S' +k_control +k_shift of start/stop-macro endof ! [THEN] ! k_F1 of F1-doc endof ! \ k_F2 of F2-help endof ! k_F12 of LoadProject endof ( default ) \ swap drop EndCase ! ; is HandleKeys ! (( :noname ( c -- ) ?shift ?control or *************** *** 386,398 **** ELSE Case ! VK_F1 of F1-doc endof \ VK_F2 of F2-help endof ! VK_F12 of LoadProject endof ! ( default ) \ swap drop EndCase THEN ; is HandleKeyDown ! ! \ ' menukey-more is LogKeyStrokes : New-default-hello ( -- ) \ for turnkey --- 398,410 ---- ELSE Case ! \ VK_F1 of F1-doc endof \ VK_F2 of F2-help endof ! \ VK_F12 of LoadProject endof ! \ ( default ) \ swap drop EndCase THEN ; is HandleKeyDown ! )) ! ' menukey-more is LogKeyStrokes : New-default-hello ( -- ) \ for turnkey Index: CommandWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/CommandWindow.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** CommandWindow.f 4 Aug 2008 09:04:06 -0000 1.8 --- CommandWindow.f 6 Aug 2008 18:19:53 -0000 1.9 *************** *** 19,23 **** \ s" Terminal" SetFaceName: CommandFont \ Optional choise ! defer HandleChar defer HandleKeyDown defer LogKeyStrokes --- 19,23 ---- \ s" Terminal" SetFaceName: CommandFont \ Optional choise ! defer HandleKeys defer HandleKeyDown defer LogKeyStrokes *************** *** 83,99 **** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ \\\\\ Type ahead circular Key Buffer \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 256 bytes KeyBuffer byte head ! byte tail ! :M EmptyKeyBuffer: ( -- ) head to tail ;M ! :M KeyBufferEmpty: ( -- f ) head tail = ;M :M PutKey: ( c -- ) \ as long as key buffer is not full ! head 1+ tail = IF drop beep ELSE KeyBuffer head + c! head 1+ to head --- 83,99 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ \\\\\ Type ahead Key Buffer \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 256 bytes KeyBuffer byte head ! \ byte tail ! :M EmptyKeyBuffer: ( -- ) 0 to head ;M ! :M KeyBufferEmpty: ( -- f ) head 0= ;M :M PutKey: ( c -- ) \ as long as key buffer is not full ! head 255 = IF drop beep ELSE KeyBuffer head + c! head 1+ to head *************** *** 103,110 **** KeyBufferEmpty: self IF 0 ! ELSE KeyBuffer tail + c@ 1 +to tail THEN ;M ! :M KeyString: ( -- a n ) KeyBuffer tail + head tail - ;M \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 103,110 ---- KeyBufferEmpty: self IF 0 ! ELSE KeyBuffer c@ KeyBuffer dup 1+ swap 255 move head 1- to head THEN ;M ! :M KeyString: ( -- a n ) KeyBuffer head ;M \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 1074,1078 **** 27 of DeleteCommand: self InitHistory endof 127 of DeleteForward: self endof ! ( default ) dup dup 32 256 within IF emit: self ELSE HandleChar THEN EndCase ;M --- 1074,1078 ---- 27 of DeleteCommand: self InitHistory endof 127 of DeleteForward: self endof ! ( default ) dup dup 32 256 within IF emit: self ELSE HandleKeys THEN EndCase ;M *************** *** 1133,1138 **** VK_PRIOR of 0x20010 endof VK_NEXT of 0x20011 endof - \ VK_SHIFT of 0x00000 endof - \ VK_CONTROL of 0x00000 endof ( default ) 0 swap EndCase --- 1133,1136 ---- *************** *** 1142,1146 **** VK_SHIFT call GetKeyState 32768 and IF 0x80000 or THEN THEN ! dup IF LogKeyStrokes THEN to VirtualKey 0 ;M --- 1140,1144 ---- VK_SHIFT call GetKeyState 32768 and IF 0x80000 or THEN THEN ! dup IF LogKeyStrokes KeysOn IF dup HandleKeys THEN THEN to VirtualKey 0 ;M *************** *** 1159,1163 **** 100000 to MaxText 0 to head ! 0 to tail 1 to CaretWidth 13 to CaretHeight --- 1157,1161 ---- 100000 to MaxText 0 to head ! \ 0 to tail 1 to CaretWidth 13 to CaretHeight *************** *** 1198,1201 **** ;Class ! ' drop is HandleChar ' drop is HandleKeyDown --- 1196,1199 ---- ;Class ! ' drop is HandleKeys ' drop is HandleKeyDown |
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X