Menu
▾
▴
[Win32forth-cvs] win32forth/src/console CommandWindow.f, 1.15, 1.16 Console2.f, 1.11, 1.12 ConsoleMenu.f, 1.17, 1.18 NewConsole.f, 1.25, 1.26
|
From: Rod O. <rod...@us...> - 2008-08-25 18:11:52
|
Update of /cvsroot/win32forth/win32forth/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8583 Modified Files: CommandWindow.f Console2.f ConsoleMenu.f NewConsole.f Log Message: Rod: enabled printing from the new console Index: NewConsole.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/NewConsole.f,v retrieving revision 1.25 retrieving revision 1.26 diff -C2 -d -r1.25 -r1.26 *** NewConsole.f 24 Aug 2008 07:36:59 -0000 1.25 --- NewConsole.f 25 Aug 2008 18:11:45 -0000 1.26 *************** *** 321,324 **** --- 321,325 ---- : c_paste-load Paste: cmd ; + : c_GETROWOFF ( - n ) FirstVisibleRow: cmd ; : NewConsole ( -- ) *************** *** 338,342 **** ['] c_cr IS CR ['] c_?cr IS ?CR ! ['] NOOP IS CONSOLE \ no ( NewConsole ) ['] c_gotoxy IS GOTOXY ['] c_getxy IS GETXY --- 339,343 ---- ['] c_cr IS CR ['] c_?cr IS ?CR ! \ ['] NOOP IS CONSOLE \ no ( NewConsole ) ['] c_gotoxy IS GOTOXY ['] c_getxy IS GETXY *************** *** 354,358 **** \ ['] 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??? --- 355,359 ---- \ ['] K_NOOP1 IS GET-CURSOR \ no \ ['] DROP IS SETROWOFF \ no ! ['] c_GETROWOFF IS GETROWOFF \ ['] K_NOOP2 IS GETMAXCOLROW \ max console size - see wrapper??? \ ['] 2DROP IS SETMAXCOLROW \ check wrapper??? *************** *** 365,368 **** --- 366,371 ---- ; + forth-io-chain chain-add NewConsole + :noname ( n -- ) Case *************** *** 370,374 **** '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] --- 373,377 ---- '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.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** ConsoleMenu.f 19 Aug 2008 12:48:34 -0000 1.17 --- ConsoleMenu.f 25 Aug 2008 18:11:45 -0000 1.18 *************** *** 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 ; --- 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 ; Index: CommandWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/CommandWindow.f,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** CommandWindow.f 24 Aug 2008 07:36:59 -0000 1.15 --- CommandWindow.f 25 Aug 2008 18:11:45 -0000 1.16 *************** *** 243,247 **** \ :M VisibleCols: ( -- cols ) width iLeftMargin - iRightMargin - HorzLine / ;M ! :M VisibleCols: ( -- cols ) \ numbere of columns visible if scrollbars were present GetWindowRect: self drop nip swap - SM_CXVSCROLL call GetSystemMetrics - --- 243,247 ---- \ :M VisibleCols: ( -- cols ) width iLeftMargin - iRightMargin - HorzLine / ;M ! :M VisibleCols: ( -- cols ) \ number of columns visible if vertical scrollbar were present GetWindowRect: self drop nip swap - SM_CXVSCROLL call GetSystemMetrics - *************** *** 249,259 **** ;M ! \ :M VisibleRows: ( -- rows ) height VertLine / ;M ! ! :M VisibleRows: ( -- rows ) \ number of rows visible if scrollbars were present ! GetWindowRect: self nip swap - nip ! SM_CYHSCROLL call GetSystemMetrics - ! VertLine / ! ;M :M VisibleColRow: ( -- cols rows ) --- 249,253 ---- ;M ! :M VisibleRows: ( -- rows ) height ScrollPos.Top negate VertLine mod - VertLine / ;M :M VisibleColRow: ( -- cols rows ) *************** *** 262,268 **** --- 256,267 ---- ;M + :M FirstVisibleRow: ( -- n ) ScrollPos.Top negate VertLine + 1- VertLine / ;M \ number of first row completely visible + + :M LastVisibleRow: ( -- n ) FirstVisibleRow: self VisibleRows: self + ;M \ number of last row completely visible + :M CharsNotFit: ( n -- f ) \ when n more chars will not fit on line without scrolling X + VisibleCols: self > ;M + int ll :M LastColRow: ( -- col row ) -1 to ll *************** *** 278,282 **** r> ScrollPos.top + ; ! :M UpdateVScroll: ( -- ) Top: ScrollPos negate to nPos Top: ScrollRange to nMin --- 277,281 ---- r> ScrollPos.top + ; ! :M UpdateVScroll: ( -- ) Top: ScrollPos negate to nPos Top: ScrollRange to nMin *************** *** 289,293 **** ;M ! :M UpdateHScroll: ( -- ) Left: ScrollPos negate to nPos Left: ScrollRange to nMin --- 288,292 ---- ;M ! :M UpdateHScroll: ( -- ) Left: ScrollPos negate to nPos Left: ScrollRange to nMin *************** *** 306,310 **** Bottom: ScrollRange - Top: ScrollPos - max dup ScrollPos 4 + +! 0 swap Scroll: self ! \ Update: self UpdateVScroll: self THEN --- 305,309 ---- Bottom: ScrollRange - Top: ScrollPos - max dup ScrollPos 4 + +! 0 swap Scroll: self ! \ Update: self UpdateVScroll: self THEN *************** *** 320,324 **** SB_PAGEUP OF VertPage ENDOF SB_THUMBTRACK OF dup negate Top: ScrollPos - ENDOF ! ( default case) 0 swap ENDCASE VScroll --- 319,323 ---- SB_PAGEUP OF VertPage ENDOF SB_THUMBTRACK OF dup negate Top: ScrollPos - ENDOF ! ( default case) 0 swap ENDCASE VScroll *************** *** 330,336 **** IF Left: ScrollPos negate min Right: ScrollPage ! Right: ScrollRange - Left: ScrollPos - max dup ScrollPos +! 0 Scroll: self ! Update: self UpdateHScroll: self THEN --- 329,335 ---- IF Left: ScrollPos negate min Right: ScrollPage ! Right: ScrollRange - Left: ScrollPos - max dup ScrollPos +! 0 Scroll: self ! Update: self UpdateHScroll: self THEN *************** *** 352,356 **** ;M ! :M WM_MOUSEWHEEL ( h m w l -- res ) over word-split 32768 and \ get the Key flags (loword of wParam) and the WHEEL_DELTA (hiword of wParam) \ A positive value indicates that the wheel was rotated forward, away --- 351,355 ---- ;M ! :M WM_MOUSEWHEEL ( h m w l -- res ) over word-split 32768 and \ get the Key flags (loword of wParam) and the WHEEL_DELTA (hiword of wParam) \ A positive value indicates that the wheel was rotated forward, away *************** *** 425,429 **** : SetCaretPosition ( -- ) \ needs dc, also sets an update rectangle to end of line \ X Y ColRow>xy ScrollAdjust ! SelEndX SelEndY ScrollAdjust \ as long as SetSelectionStart is done first dup VertLine + width swap SetRect: CaretPos cursor-on? IF CaretPos.top CaretPos.left call SetCaretPos drop THEN --- 424,428 ---- : SetCaretPosition ( -- ) \ needs dc, also sets an update rectangle to end of line \ X Y ColRow>xy ScrollAdjust ! SelEndX SelEndY ScrollAdjust \ as long as SetSelectionStart is done first dup VertLine + width swap SetRect: CaretPos cursor-on? IF CaretPos.top CaretPos.left call SetCaretPos drop THEN *************** *** 437,441 **** : SCP ( -- ) \ SetCommandPosition ! get-dc hFont SetFont: dc X Y SetSelectionStart SetCaretPosition --- 436,440 ---- : SCP ( -- ) \ SetCommandPosition ! get-dc hFont SetFont: dc X Y SetSelectionStart SetCaretPosition *************** *** 449,453 **** : UpdateRange ( SelStartCol SelStartRow SelEndCol SelEndRow f -- ) >r 2>r ! get-dc hFont SetFont: dc ColRow>XY ScrollAdjust 2r> ColRow>XY VertLine + ScrollAdjust r> UpdateRectangle release-dc --- 448,452 ---- : UpdateRange ( SelStartCol SelStartRow SelEndCol SelEndRow f -- ) >r 2>r ! get-dc hFont SetFont: dc ColRow>XY ScrollAdjust 2r> ColRow>XY VertLine + ScrollAdjust r> UpdateRectangle release-dc *************** *** 522,526 **** ScrollRange -1 Text GetHandle: dc call DrawTextEx VertLine / to lines DRAWTEXTPARAMS DT_NOCLIP DT_EXPANDTABS or DT_TABSTOP or DT_NOPREFIX or ! ScrollPos -1 Text GetHandle: dc call DrawTextEx drop \ Draw highlighted text if any --- 521,525 ---- ScrollRange -1 Text GetHandle: dc call DrawTextEx VertLine / to lines DRAWTEXTPARAMS DT_NOCLIP DT_EXPANDTABS or DT_TABSTOP or DT_NOPREFIX or ! ScrollPos -1 Text GetHandle: dc call DrawTextEx drop \ Draw highlighted text if any *************** *** 565,569 **** : GetColRow ( X Y -- col row ) \ needs dc ScrollRange.bottom min scrollpos.top - VertLine / lines 1- min 0max >r ! ScrollRange.right iRightMargin - ( HorzLine + ) min scrollpos.left - iLeftMargin - r@ RowAddress r@ RowLength GetTabbedCharsFromPoint r@ RowLength min r> ; --- 564,568 ---- : GetColRow ( X Y -- col row ) \ needs dc ScrollRange.bottom min scrollpos.top - VertLine / lines 1- min 0max >r ! ScrollRange.right iRightMargin - ( HorzLine + ) min scrollpos.left - iLeftMargin - r@ RowAddress r@ RowLength GetTabbedCharsFromPoint r@ RowLength min r> ; *************** *** 578,582 **** StartY EndY < dup IF ! StartX width min StartY width \ more than one line ELSE StartX StartY EndX \ one line only --- 577,581 ---- StartY EndY < dup IF ! StartX width min StartY width \ more than one line ELSE StartX StartY EndX \ one line only *************** *** 586,590 **** BEGIN StartY EndY < ! WHILE 0 StartY width VertLine +to StartY StartY \ whole lines true UpdateRectangle --- 585,589 ---- BEGIN StartY EndY < ! WHILE 0 StartY width VertLine +to StartY StartY \ whole lines true UpdateRectangle *************** *** 598,602 **** :M Select: ( col row -- ) \ select text from SelStart to SelEnd - col row ! get-dc hFont SetFont: dc SelEndCol SelEndRow \ previous SelEnd col row 2swap to SelEndRow to SelEndCol --- 597,601 ---- :M Select: ( col row -- ) \ select text from SelStart to SelEnd - col row ! get-dc hFont SetFont: dc SelEndCol SelEndRow \ previous SelEnd col row 2swap to SelEndRow to SelEndCol *************** *** 626,630 **** : On_Track ( h m -- h m ) ! get-dc hFont SetFont: dc MouseX MouseY GetColRow release-dc --- 625,629 ---- : On_Track ( h m -- h m ) ! get-dc hFont SetFont: dc MouseX MouseY GetColRow release-dc *************** *** 638,643 **** SelectedLength IF ! 0 to SelectedLength ! get-dc hFont SetFont: dc SelStartCol SelStartRow ColRow>XY ScrollAdjust SelEndCol SelEndRow ColRow>XY ScrollAdjust --- 637,642 ---- SelectedLength IF ! 0 to SelectedLength ! get-dc hFont SetFont: dc SelStartCol SelStartRow ColRow>XY ScrollAdjust SelEndCol SelEndRow ColRow>XY ScrollAdjust *************** *** 648,652 **** : SetStart ( x y -- ) \ used in On_Click and SelectAll: ! get-dc hFont SetFont: dc GetColRow 2dup SetSelectionStart over swap OnCommandLine --- 647,651 ---- : SetStart ( x y -- ) \ used in On_Click and SelectAll: ! get-dc hFont SetFont: dc GetColRow 2dup SetSelectionStart over swap OnCommandLine *************** *** 697,701 **** :M DeleteLine: ( -- ) \ delete current row Y RowAddress TextEnd over - ! 2dup 13 scan 13 skip 10 skip nip - dup>r DeleteText: self \ 0 Y r> 1+ Y true UpdateRange \ no need to update here ;M --- 696,700 ---- :M DeleteLine: ( -- ) \ delete current row Y RowAddress TextEnd over - ! 2dup 13 scan 13 skip 10 skip nip - dup>r DeleteText: self \ 0 Y r> 1+ Y true UpdateRange \ no need to update here ;M *************** *** 703,707 **** :M DeleteTextAndRedraw: ( a n -- ) \ DeleteText and update DeleteText: self ! Deselect: self Redraw: self ;M --- 702,706 ---- :M DeleteTextAndRedraw: ( a n -- ) \ DeleteText and update DeleteText: self ! Deselect: self Redraw: self ;M *************** *** 712,716 **** drop text - nip Text swap DeleteTextAndRedraw: self ;M ! : CheckTextBuffer ( n -- ) dup text zcount nip + 256 + MaxText > --- 711,715 ---- drop text - nip Text swap DeleteTextAndRedraw: self ;M ! : CheckTextBuffer ( n -- ) dup text zcount nip + 256 + MaxText > *************** *** 799,803 **** CommandStart to X X Y X #chars + Y true UpdateRange ! 0 to #chars SCP true to editing --- 798,802 ---- CommandStart to X X Y X #chars + Y true UpdateRange ! 0 to #chars SCP true to editing *************** *** 810,815 **** SelStartCol SelEndCol min to X \ Update: self X Y X #chars + Y true UpdateRange ! SelectedLength negate +to #chars ! Deselect: self SCP true to editing --- 809,814 ---- SelStartCol SelEndCol min to X \ Update: self X Y X #chars + Y true UpdateRange ! SelectedLength negate +to #chars ! Deselect: self SCP true to editing *************** *** 884,888 **** ELSE Deselect: self ! X CommandEnd < IF XYAddress 1 DeleteTextOnCommandLine: self --- 883,887 ---- ELSE Deselect: self ! X CommandEnd < IF XYAddress 1 DeleteTextOnCommandLine: self *************** *** 958,963 **** : OpenClipboard ( -- ) CF_TEXT call IsClipboardFormatAvailable ! IF ! hWnd call OpenClipboard drop CF_TEXT call GetClipboardData dup to ClipboardHandle call GlobalLock zcount to ClipboardCount to ClipboardAddress --- 957,962 ---- : OpenClipboard ( -- ) CF_TEXT call IsClipboardFormatAvailable ! IF ! hWnd call OpenClipboard drop CF_TEXT call GetClipboardData dup to ClipboardHandle call GlobalLock zcount to ClipboardCount to ClipboardAddress *************** *** 994,998 **** :M PasteFirstLine: ( -- ) \ paste only the first line (less CR) to the commandline CF_TEXT call IsClipboardFormatAvailable ! IF hWnd call OpenClipboard drop CF_TEXT call GetClipboardData --- 993,997 ---- :M PasteFirstLine: ( -- ) \ paste only the first line (less CR) to the commandline CF_TEXT call IsClipboardFormatAvailable ! IF hWnd call OpenClipboard drop CF_TEXT call GetClipboardData *************** *** 1009,1015 **** SelectedLength IF ! hWnd call OpenClipboard drop call EmptyClipboard drop ! SelectedLength 1+ GMEM_DDESHARE call GlobalAlloc dup Call GlobalLock dup SelectedLength 1+ erase SelectedAddress over SelectedLength move --- 1008,1014 ---- SelectedLength IF ! hWnd call OpenClipboard drop call EmptyClipboard drop ! SelectedLength 1+ GMEM_DDESHARE call GlobalAlloc dup Call GlobalLock dup SelectedLength 1+ erase SelectedAddress over SelectedLength move *************** *** 1030,1034 **** ELSE StartAfterCommandLine SameRowAsCommandLine and ! IF CommandEnd ELSE 0 THEN THEN SelStartRow Select: self ;M --- 1029,1033 ---- ELSE StartAfterCommandLine SameRowAsCommandLine and ! IF CommandEnd ELSE 0 THEN THEN SelStartRow Select: self ;M *************** *** 1039,1043 **** ELSE StartBeforeCommandLine SameRowAsCommandLine and ! IF CommandStart ELSE SelStartRow RowLength THEN THEN SelStartRow Select: self ;M --- 1038,1042 ---- ELSE StartBeforeCommandLine SameRowAsCommandLine and ! IF CommandStart ELSE SelStartRow RowLength THEN THEN SelStartRow Select: self ;M *************** *** 1048,1052 **** ELSE StartAfterCommandLine ! IF CommandEnd Y ELSE 0 0 THEN THEN Select: self ;M --- 1047,1051 ---- ELSE StartAfterCommandLine ! IF CommandEnd Y ELSE 0 0 THEN THEN Select: self ;M *************** *** 1057,1061 **** ELSE StartBeforeCommandLine ! IF CommandStart Y ELSE LastColRow: self THEN THEN Select: self ;M --- 1056,1060 ---- ELSE StartBeforeCommandLine ! IF CommandStart Y ELSE LastColRow: self THEN THEN Select: self ;M *************** *** 1066,1071 **** ELSE SelStartCol SelEndRow 1- 0max RowLength min SelEndRow 1- dup 0< IF 2drop 0 0 THEN ! StartAfterCommandLine SelEndRow 1- 0max Y = and ! IF swap CommandEnd max swap THEN THEN Select: self ;M --- 1065,1070 ---- ELSE SelStartCol SelEndRow 1- 0max RowLength min SelEndRow 1- dup 0< IF 2drop 0 0 THEN ! StartAfterCommandLine SelEndRow 1- 0max Y = and ! IF swap CommandEnd max swap THEN THEN Select: self ;M *************** *** 1076,1080 **** ELSE SelStartCol SelEndRow 1+ RowLength min SelEndRow 1+ 2dup LastColRow: self d> IF 2drop LastColRow: self THEN ! StartBeforeCommandLine SelEndRow 1+ lines 1- min Y = and IF swap CommandStart min swap THEN StartBeforeCommandLine SameRowAsCommandLine and IF CommandStart Y THEN --- 1075,1079 ---- ELSE SelStartCol SelEndRow 1+ RowLength min SelEndRow 1+ 2dup LastColRow: self d> IF 2drop LastColRow: self THEN ! StartBeforeCommandLine SelEndRow 1+ lines 1- min Y = and IF swap CommandStart min swap THEN StartBeforeCommandLine SameRowAsCommandLine and IF CommandStart Y THEN *************** *** 1092,1096 **** THEN THEN ! Select: self ;M :M ShiftRight: ( -- ) --- 1091,1095 ---- THEN THEN ! Select: self ;M :M ShiftRight: ( -- ) *************** *** 1100,1104 **** SelEndCol SelEndRow CommandStart Y d= IF exitm THEN SelEndCol SelEndRow RowLength < IF SelEndCol 1+ SelEndRow ! ELSE lines 1- SelEndRow = IF exitm THEN 0 SelEndRow 1+ THEN THEN --- 1099,1103 ---- SelEndCol SelEndRow CommandStart Y d= IF exitm THEN SelEndCol SelEndRow RowLength < IF SelEndCol 1+ SelEndRow ! ELSE lines 1- SelEndRow = IF exitm THEN 0 SelEndRow 1+ THEN THEN *************** *** 1108,1112 **** CommandStart Y \ lines 1- 2dup SelEndCol SelEndRow d= ! SelStartRow SelStartCol d0= and IF 2drop \ if all is selected already ELSE Deselect: self 0 0 ScrollAdjust SetStart Select: self --- 1107,1111 ---- CommandStart Y \ lines 1- 2dup SelEndCol SelEndRow d= ! SelStartRow SelStartCol d0= and IF 2drop \ if all is selected already ELSE Deselect: self 0 0 ScrollAdjust SetStart Select: self *************** *** 1136,1144 **** ELSE dup 27 = IF true to Abort? THEN PutKey: self THEN ! \ drop false to Abort? 0 ;M :M HandleKeyDown: ( n -- ) ! CASE VK_HOME of ?shift IF 0 0 ?control IF CtrlShiftHome: self ELSE ShiftHome: self THEN ELSE SB_TOP WM_HSCROLL THEN endof VK_END of ?shift IF 0 0 ?control IF CtrlShiftEnd: self ELSE ShiftEnd: self THEN ELSE SB_BOTTOM WM_HSCROLL THEN endof --- 1135,1143 ---- ELSE dup 27 = IF true to Abort? THEN PutKey: self THEN ! \ drop false to Abort? 0 ;M :M HandleKeyDown: ( n -- ) ! CASE VK_HOME of ?shift IF 0 0 ?control IF CtrlShiftHome: self ELSE ShiftHome: self THEN ELSE SB_TOP WM_HSCROLL THEN endof VK_END of ?shift IF 0 0 ?control IF CtrlShiftEnd: self ELSE ShiftEnd: self THEN ELSE SB_BOTTOM WM_HSCROLL THEN endof *************** *** 1182,1186 **** VK_PAUSE of 0x20009 endof VK_PRIOR of 0x20010 endof ! VK_NEXT of 0x20011 endof ( default ) 0 swap EndCase --- 1181,1185 ---- VK_PAUSE of 0x20009 endof VK_PRIOR of 0x20010 endof ! VK_NEXT of 0x20011 endof ( default ) 0 swap EndCase Index: Console2.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/Console2.f,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** Console2.f 19 Aug 2008 12:48:34 -0000 1.11 --- Console2.f 25 Aug 2008 18:11:45 -0000 1.12 *************** *** 3,7 **** cr .( Loading... Console I/O Part 2) ! : forth-io ; \ ******* need to look at printing the console in dc.f ********** 1 proc HideCaret --- 3,7 ---- cr .( Loading... Console I/O Part 2) ! : forth-io ( -- ) forth-io-chain do-chain ; 1 proc HideCaret |
