Menu
▾
▴
[Win32forth-cvs] win32forth/src/console CommandWindow.f,1.18,1.19
|
From: Jos v.d.V. <jo...@us...> - 2008-09-16 01:39:45
|
Update of /cvsroot/win32forth/win32forth/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv16308 Modified Files: CommandWindow.f Log Message: Jos: Reduces elapsed time of the ConsoleTest from 00:02:51.443 to 00:01:46.566. That is +/- 38% faster. Index: CommandWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/CommandWindow.f,v retrieving revision 1.18 retrieving revision 1.19 diff -C2 -d -r1.18 -r1.19 *** CommandWindow.f 29 Aug 2008 08:55:18 -0000 1.18 --- CommandWindow.f 16 Sep 2008 08:39:40 -0000 1.19 *************** *** 5,9 **** \ Features: \ ! \ Action when enter is pressed is deferred \ Font changeable \ Key buffer --- 5,9 ---- \ Features: \ ! \ Action when enter is pressed is deferred \ Font changeable \ Key buffer *************** *** 47,50 **** --- 47,52 ---- int text \ pointer to text buffer int MaxText \ size of text buffer allocated + int NewLine \ To reduce calculations in paint + : TextEnd ( -- a ) text zcount + ; : RowAddress ( row -- a ) \ address of text at beginning of row *************** *** 242,246 **** \ :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 - --- 244,248 ---- \ :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 - *************** *** 276,280 **** r> ScrollPos.top + ; ! :M UpdateVScroll: ( -- ) Top: ScrollPos negate to nPos Top: ScrollRange to nMin --- 278,282 ---- r> ScrollPos.top + ; ! :M UpdateVScroll: ( -- ) Top: ScrollPos negate to nPos Top: ScrollRange to nMin *************** *** 287,291 **** ;M ! :M UpdateHScroll: ( -- ) Left: ScrollPos negate to nPos Left: ScrollRange to nMin --- 289,293 ---- ;M ! :M UpdateHScroll: ( -- ) Left: ScrollPos negate to nPos Left: ScrollRange to nMin *************** *** 304,308 **** Bottom: ScrollRange - Top: ScrollPos - max dup ScrollPos 4 + +! 0 swap Scroll: self ! \ Update: self UpdateVScroll: self THEN --- 306,310 ---- Bottom: ScrollRange - Top: ScrollPos - max dup ScrollPos 4 + +! 0 swap Scroll: self ! \ Update: self UpdateVScroll: self THEN *************** *** 318,322 **** SB_PAGEUP OF VertPage ENDOF SB_THUMBTRACK OF dup negate Top: ScrollPos - ENDOF ! ( default case) 0 swap ENDCASE VScroll --- 320,324 ---- SB_PAGEUP OF VertPage ENDOF SB_THUMBTRACK OF dup negate Top: ScrollPos - ENDOF ! ( default case) 0 swap ENDCASE VScroll *************** *** 328,334 **** IF Left: ScrollPos negate min Right: ScrollPage ! Right: ScrollRange - Left: ScrollPos - max dup ScrollPos +! 0 Scroll: self ! Update: self UpdateHScroll: self THEN --- 330,336 ---- IF Left: ScrollPos negate min Right: ScrollPage ! Right: ScrollRange - Left: ScrollPos - max dup ScrollPos +! 0 Scroll: self ! Update: self UpdateHScroll: self THEN *************** *** 350,354 **** ;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 --- 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 *************** *** 423,427 **** : 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 --- 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 *************** *** 435,439 **** : SCP ( -- ) \ SetCommandPosition ! get-dc hFont SetFont: dc X Y SetSelectionStart SetCaretPosition --- 437,441 ---- : SCP ( -- ) \ SetCommandPosition ! get-dc hFont SetFont: dc X Y SetSelectionStart SetCaretPosition *************** *** 447,451 **** : 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 --- 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 *************** *** 516,524 **** BackgroundColour SetBkColor: dc \ Calculate the size of the text then draw it DRAWTEXTPARAMS DT_CALCRECT DT_EXPANDTABS or DT_TABSTOP or DT_NOPREFIX or ! 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 --- 518,528 ---- BackgroundColour SetBkColor: dc + NewLine if \ Calculate the size of the text then draw it DRAWTEXTPARAMS DT_CALCRECT DT_EXPANDTABS or DT_TABSTOP or DT_NOPREFIX or ! ScrollRange -1 Text GetHandle: dc call DrawTextEx VertLine / to lines false to NewLine ! then 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 *************** *** 563,567 **** : 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> ; --- 567,571 ---- : 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> ; *************** *** 576,580 **** StartY EndY < dup IF ! StartX width min StartY width \ more than one line ELSE StartX StartY EndX \ one line only --- 580,584 ---- StartY EndY < dup IF ! StartX width min StartY width \ more than one line ELSE StartX StartY EndX \ one line only *************** *** 584,588 **** BEGIN StartY EndY < ! WHILE 0 StartY width VertLine +to StartY StartY \ whole lines true UpdateRectangle --- 588,592 ---- BEGIN StartY EndY < ! WHILE 0 StartY width VertLine +to StartY StartY \ whole lines true UpdateRectangle *************** *** 596,600 **** :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 --- 600,604 ---- :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 *************** *** 624,628 **** : On_Track ( h m -- h m ) ! get-dc hFont SetFont: dc MouseX MouseY GetColRow release-dc --- 628,632 ---- : On_Track ( h m -- h m ) ! get-dc hFont SetFont: dc MouseX MouseY GetColRow release-dc *************** *** 636,641 **** SelectedLength IF ! 0 to SelectedLength ! get-dc hFont SetFont: dc SelStartCol SelStartRow ColRow>XY ScrollAdjust SelEndCol SelEndRow ColRow>XY ScrollAdjust --- 640,645 ---- SelectedLength IF ! 0 to SelectedLength ! get-dc hFont SetFont: dc SelStartCol SelStartRow ColRow>XY ScrollAdjust SelEndCol SelEndRow ColRow>XY ScrollAdjust *************** *** 646,650 **** : SetStart ( x y -- ) \ used in On_Click and SelectAll: ! get-dc hFont SetFont: dc GetColRow 2dup SetSelectionStart over swap OnCommandLine --- 650,654 ---- : SetStart ( x y -- ) \ used in On_Click and SelectAll: ! get-dc hFont SetFont: dc GetColRow 2dup SetSelectionStart over swap OnCommandLine *************** *** 695,699 **** :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 --- 699,703 ---- :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 *************** *** 701,705 **** :M DeleteTextAndRedraw: ( a n -- ) \ DeleteText and update DeleteText: self ! Deselect: self Redraw: self ;M --- 705,709 ---- :M DeleteTextAndRedraw: ( a n -- ) \ DeleteText and update DeleteText: self ! Deselect: self Redraw: self ;M *************** *** 710,714 **** drop text - nip Text swap DeleteTextAndRedraw: self ;M ! : CheckTextBuffer ( n -- ) dup text zcount nip + 256 + MaxText > --- 714,718 ---- drop text - nip Text swap DeleteTextAndRedraw: self ;M ! : CheckTextBuffer ( n -- ) dup text zcount nip + 256 + MaxText > *************** *** 722,726 **** :M CR: ( -- ) ! crlf$ count OverwriteLineAtXY: self Y UpdateLine: self 0 to X 1 +to Y --- 726,730 ---- :M CR: ( -- ) ! crlf$ count true to NewLine OverwriteLineAtXY: self Y UpdateLine: self 0 to X 1 +to Y *************** *** 761,764 **** --- 765,769 ---- :M cls: ( -- ) 0 text c! + true to NewLine Redraw: self 0 to X 0 to Y \ 1 to lines \ 0 text ! *************** *** 797,801 **** CommandStart to X X Y X #chars + Y true UpdateRange ! 0 to #chars SCP true to editing --- 802,806 ---- CommandStart to X X Y X #chars + Y true UpdateRange ! 0 to #chars SCP true to editing *************** *** 808,813 **** SelStartCol SelEndCol min to X \ Update: self X Y X #chars + Y true UpdateRange ! SelectedLength negate +to #chars ! Deselect: self SCP true to editing --- 813,818 ---- 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 --- 889,893 ---- 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 --- 963,968 ---- : 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 --- 999,1003 ---- :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 --- 1014,1020 ---- 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 --- 1035,1039 ---- 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 --- 1044,1048 ---- 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 --- 1053,1057 ---- 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 --- 1062,1066 ---- 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 --- 1071,1076 ---- 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 --- 1081,1085 ---- 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: ( -- ) --- 1097,1101 ---- 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 --- 1105,1109 ---- 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 --- 1113,1117 ---- 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 --- 1141,1149 ---- 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 --- 1187,1191 ---- VK_PAUSE of 0x20009 endof VK_PRIOR of 0x20010 endof ! VK_NEXT of 0x20011 endof ( default ) 0 swap EndCase *************** *** 1205,1208 **** --- 1210,1214 ---- 1024 to MaxHistory 100000 to MaxText + true to NewLine 0 to head -1 to wrap |
