Menu
▾
▴
[Win32forth-cvs] win32forth/src/console CommandWindow.f, 1.23, 1.24 NewConsole.f, 1.29, 1.30
|
From: Rod O. <rod...@us...> - 2008-11-19 13:32:11
|
Update of /cvsroot/win32forth/win32forth/src/console In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv21115 Modified Files: CommandWindow.f NewConsole.f Log Message: Rod: major improvements in speed and stability Index: NewConsole.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/NewConsole.f,v retrieving revision 1.29 retrieving revision 1.30 diff -C2 -d -r1.29 -r1.30 *** NewConsole.f 25 Oct 2008 15:16:21 -0000 1.29 --- NewConsole.f 19 Nov 2008 13:31:03 -0000 1.30 *************** *** 172,176 **** :M On_Done: ( -- ) WindowState SIZE_RESTORED = IF SaveWindowSettings THEN - cmd.Text release bye ;M --- 172,175 ---- *************** *** 183,186 **** --- 182,188 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + INTERNAL + EXTERNAL + : c_type ( a n -- ) KeysOff: cmd \ send key strokes to key buffer *************** *** 192,202 **** : c_emit ( c -- ) sp@ 1 c_type drop ; : c_cr ( -- ) cr: cmd ; ! : c_?cr ( n -- ) CharsNotFit: cmd IF c_cr THEN ; : c_cls ( -- ) cls: cmd ; : c_getcolrow ( -- col row ) VisibleColRow: cmd ; : c_getxy ( -- x y ) GetXY: cmd ; : c_gotoxy ( x y -- ) GoToXY: cmd ; - internal - external 0 value entered --- 194,202 ---- : c_emit ( c -- ) sp@ 1 c_type drop ; : c_cr ( -- ) cr: cmd ; ! : c_?cr ( n -- ) ?cr: cmd ; : c_cls ( -- ) cls: cmd ; : c_getcolrow ( -- col row ) VisibleColRow: cmd ; : c_getxy ( -- x y ) GetXY: cmd ; : c_gotoxy ( x y -- ) GoToXY: cmd ; 0 value entered *************** *** 228,234 **** : c_key? ( -- f ) ! cmd.ClipboardHandle IF false exit THEN \ seem to need to disable key? during paste KeysOff: cmd - \ PauseForMessage PauseForMessages \ Winpause KeyBufferEmpty: cmd not --- 228,233 ---- : c_key? ( -- f ) ! cmd.ClipboardHandle IF false exit THEN \ need to disable key? during paste because of SLOW KeysOff: cmd PauseForMessages \ Winpause KeyBufferEmpty: cmd not *************** *** 243,251 **** 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 --- 242,246 ---- EndPrompt: cmd ; ! : c_Init-Console ( -- f ) \ start the Console window hidden or show console if already started \ progreg-init *************** *** 283,312 **** : c_copy-console copy: cmd ; ! : c_cut-console SelectAll: cmd Cut: cmd ; : c_mark-all SelectAll: cmd ; : c_paste-load Paste: cmd ; ! : c_GETROWOFF ( - n ) FirstVisibleRow: cmd ; ! :noname ( n -- ) Case ! 'O' +k_control of edit-forth endof ! '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] ! '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 ! \in-system-ok k_F12 of LoadProject endof ( default ) \ swap drop EndCase ; is HandleKeys (( :noname ( c -- ) --- 278,307 ---- : c_copy-console copy: cmd ; ! : c_cut-console SelectAll: cmd cut: cmd ; : c_mark-all SelectAll: cmd ; : c_paste-load Paste: cmd ; ! : c_getrowoff ( -- n ) FirstVisibleRow: cmd ; :noname ( n -- ) Case ! 'O' +k_control of edit-forth endof ! '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] ! '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 ! \in-system-ok k_F12 of LoadProject endof ( default ) \ swap drop EndCase ; is HandleKeys + (( :noname ( c -- ) *************** *** 323,326 **** --- 318,322 ---- ; is HandleKeyDown )) + ' menukey-more is LogKeyStrokes *************** *** 332,338 **** : NewConsole ( -- ) \ reset all defered words for the console window \ ['] NOOP IS CONSOLE - \ [cdo] ??? handle CONSOLE is special ??? already set by dc.f ??? ['] c_Init-Console IS INIT-CONSOLE ! ['] c_INIT-SCREEN IS INIT-SCREEN ['] c_key IS KEY ['] c_key? IS KEY? --- 328,333 ---- : NewConsole ( -- ) \ reset all defered words for the console window \ ['] NOOP IS CONSOLE ['] c_Init-Console IS INIT-CONSOLE ! ['] c_Init-Screen IS INIT-SCREEN ['] c_key IS KEY ['] c_key? IS KEY? *************** *** 348,367 **** ['] c_gotoxy IS GOTOXY ['] c_getxy IS GETXY ! ['] c_FGBG! IS FGBG! \ use forgrnd/bckgrnd 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 ) ! ['] DROP IS SET-CURSOR \ no big-cursor, norm-cursor ??? ['] K_NOOP1 IS GET-CURSOR \ no ['] c_getcolrow IS GETCOLROW ! ['] c_GETROWOFF IS GETROWOFF ! ['] c_&TheScreen IS &THE-SCREEN \ #print-screen in dc.f will not work **************** \ specific to new console : ! ['] NewConHndl IS conHndl ! ['] c_copy-console IS copy-console ! ['] c_cut-console IS cut-console ! ['] c_mark-all IS mark-all ! ['] c_paste-load IS paste-load ; --- 343,362 ---- ['] c_gotoxy IS GOTOXY ['] c_getxy IS GETXY ! ['] c_FGBG! IS FGBG! \ use forgrnd/bckgrnd color_objects ['] c_FG@ IS FG@ ['] c_BG@ IS BG@ ! ['] c_CharWH IS CHARWH ['] 2DROP IS SETCHARWH \ no ( change the font ) ! ['] DROP IS SET-CURSOR \ no big-cursor, norm-cursor ['] K_NOOP1 IS GET-CURSOR \ no ['] c_getcolrow IS GETCOLROW ! ['] c_getrowoff IS GETROWOFF ! ['] c_&TheScreen IS &THE-SCREEN \ specific to new console : ! ['] NewConHndl IS ConHndl ! ['] c_copy-console IS copy-console ! ['] c_cut-console IS cut-console ! ['] c_mark-all IS mark-all ! ['] c_paste-load IS paste-load ; Index: CommandWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/CommandWindow.f,v retrieving revision 1.23 retrieving revision 1.24 diff -C2 -d -r1.23 -r1.24 *** CommandWindow.f 5 Nov 2008 11:00:00 -0000 1.23 --- CommandWindow.f 19 Nov 2008 13:31:03 -0000 1.24 *************** *** 12,27 **** - Font CommandFont - 10 Height: CommandFont - \ FW_HEAVY Weight: CommandFont \ Optional - s" Courier" SetFaceName: CommandFont - \ s" Terminal" SetFaceName: CommandFont \ Optional choice - defer HandleKeys ' drop is HandleKeys \ define to handle keys e.g. 'O' +k_control defer HandleKeyDown ' drop is HandleKeyDown \ define to handle virtual keys e.g. VK_F12 defer LogKeyStrokes ' noop is LogKeyStrokes \ used in KeySave.f defined as menukey-more - WinDC mDC \ used for font calculations - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 12,19 ---- *************** *** 34,39 **** :M SetAction: ( xt -- ) to action ;M ! int font int hFont int X --- 26,32 ---- :M SetAction: ( xt -- ) to action ;M ! int CommandFont int hFont + int mDC \ WinDC mDC \ used for font calculations int X *************** *** 41,58 **** :M SetXY: ( X Y -- ) to Y to X ;M :M GetXY: ( -- X Y ) X Y ;M int text \ pointer to text buffer int MaxText \ size of text buffer allocated ! : TextEnd ( -- a ) text zcount + ; : RowAddress ( row -- a ) \ address of text at beginning of row ! Text zcount rot 0 ?DO 13 scan 1 /string 10 skip LOOP drop ; \ stop at textend??? ! : RowLength ( row -- n ) RowAddress dup zcount 13 scan drop swap - ; \ without the cr ! : ColRow>Address ( col row -- a ) RowAddress + ; \ col RowLength min ??? ! : XYAddress ( -- ) X Y RowAddress + ; \ address of text at current X Y ! : RowEndAddress ( row - a ) dup RowAddress swap RowLength + ; ! Rectangle CaretPos \ caret position to bottom right used to update part of window ! Rectangle UpdateRect \ l , t , r , b 4 bytes TabWidth --- 34,62 ---- :M SetXY: ( X Y -- ) to Y to X ;M :M GetXY: ( -- X Y ) X Y ;M + int XYA int text \ pointer to text buffer int MaxText \ size of text buffer allocated + int lines \ number of rows of text + int TextZero \ address of terminating zero ! : LastRowAddress ( -- a ) TextZero dup text - 10 -scan drop 1 10 skip drop ; : RowAddress ( row -- a ) \ address of text at beginning of row ! dup lines 1- >= ! IF drop LastRowAddress ! ELSE Text TextZero over - rot 0 ?DO 13 scan 1 /string 10 skip LOOP drop ! THEN ; ! : XYAddress ( -- a ) Y RowAddress X + ; \ address of text at current X Y ! : RowString ( row -- a n ) RowAddress TextZero over - 2dup 13 scan nip - ; \ without the cr ! : RowLength ( row -- n ) RowString nip ; ! : RowEndAddress ( row - a ) RowString + ; \ address immediately after text at end of row (contains cr or null) ! : LastRow ( -- row ) lines 1- ; ! : LastCol ( -- col ) LastRow RowLength ; ! ! :M LastColRow: ( -- col row ) LastCol LastRow ;M ! ! Rectangle CaretPos \ caret position to bottom right used to update part of window ! Rectangle UpdateRect \ l , t , r , b 4 bytes TabWidth *************** *** 61,65 **** int Editing - int lines \ number of rows of text int #chars \ number of characters on command line int CommandStart \ column after prompt --- 65,68 ---- *************** *** 169,173 **** : ExecuteCommand ( -- ) CommandString dup IF 2dup AddCommand THEN action execute ; - \ :M dh: CommandHistory 128 dump ;M \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Scrollbars \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 172,175 ---- *************** *** 255,267 **** :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 - Text zcount BEGIN 1 +to ll 13 scan 1 /string 10 skip dup 0= UNTIL - 2drop ll dup rowlength swap ;M - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\ Managing the Scrollbars \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 257,260 ---- *************** *** 311,317 **** SB_LINEDOWN OF VertLine negate ENDOF SB_LINEUP OF VertLine ENDOF ! SB_PAGEDOWN OF VertPage negate ENDOF ! SB_PAGEUP OF VertPage ENDOF ! SB_THUMBTRACK OF dup negate Top: ScrollPos - ENDOF ( default case) 0 swap ENDCASE --- 304,312 ---- SB_LINEDOWN OF VertLine negate ENDOF SB_LINEUP OF VertLine ENDOF ! \ SB_PAGEDOWN OF VertPage negate ENDOF ! \ SB_PAGEUP OF VertPage ENDOF ! SB_PAGEDOWN OF VisibleRows: self VertLine * negate ENDOF ! SB_PAGEUP OF VisibleRows: self VertLine * ENDOF ! SB_THUMBTRACK OF dup negate Top: ScrollPos negate $FFFF and negate - ENDOF ( default case) 0 swap ENDCASE *************** *** 337,342 **** SB_LINERIGHT OF HorzLine negate ENDOF SB_LINELEFT OF HorzLine ENDOF ! SB_PAGERIGHT OF HorzPage negate ENDOF ! SB_PAGELEFT OF HorzPage ENDOF SB_THUMBTRACK OF dup negate Left: ScrollPos - ENDOF ( default case) 0 swap --- 332,339 ---- SB_LINERIGHT OF HorzLine negate ENDOF SB_LINELEFT OF HorzLine ENDOF ! \ SB_PAGERIGHT OF HorzPage negate ENDOF ! \ SB_PAGELEFT OF HorzPage ENDOF ! SB_PAGERIGHT OF VisibleCols: self HorzLine * negate ENDOF ! SB_PAGELEFT OF VisibleCols: self HorzLine * ENDOF SB_THUMBTRACK OF dup negate Left: ScrollPos - ENDOF ( default case) 0 swap *************** *** 353,366 **** IF Case ! 0 of SB_LINEDOWN WM_VSCROLL Endof ! MK_SHIFT of SB_LINERIGHT WM_HSCROLL Endof ! MK_CONTROL of SB_PAGEDOWN WM_VSCROLL Endof ( default case) 0 0 rot EndCase ELSE Case ! 0 of SB_LINEUP WM_VSCROLL Endof ! MK_SHIFT of SB_LINELEFT WM_HSCROLL Endof ! MK_CONTROL of SB_PAGEUP WM_VSCROLL Endof ( default case) 0 0 rot EndCase --- 350,365 ---- IF Case ! 0 of SB_LINEDOWN WM_VSCROLL Endof ! MK_SHIFT of SB_LINERIGHT WM_HSCROLL Endof ! MK_CONTROL of SB_PAGEDOWN WM_VSCROLL Endof ! MK_SHIFT MK_CONTROL or of SB_PAGERIGHT WM_HSCROLL Endof ( default case) 0 0 rot EndCase ELSE Case ! 0 of SB_LINEUP WM_VSCROLL Endof ! MK_SHIFT of SB_LINELEFT WM_HSCROLL Endof ! MK_CONTROL of SB_PAGEUP WM_VSCROLL Endof ! MK_SHIFT MK_CONTROL or of SB_PAGELEFT WM_HSCROLL Endof ( default case) 0 0 rot EndCase *************** *** 431,439 **** : SCP ( -- ) \ SetCommandPosition - \ get-dc - \ hFont SetFont: mdc X Y SetSelectionStart SetCaretPosition - \ release-dc ; --- 430,435 ---- *************** *** 444,451 **** : UpdateRange ( SelStartCol SelStartRow SelEndCol SelEndRow f -- ) >r 2>r - \ get-dc - \ hFont SetFont: mdc ColRow>XY ScrollAdjust 2r> ColRow>XY VertLine + ScrollAdjust r> UpdateRectangle - \ release-dc ; --- 440,444 ---- *************** *** 472,477 **** :M AutoScroll: ( -- ) \ scroll caret into view WindowState: parent SIZE_MINIMIZED = IF exitm THEN ! UpdatePoint: self \ force a paint to update text size ! PauseForMessages iLeftMargin CaretPos @ - 0 max width iRightMargin - CaretPos @ - 0 min + HScroll --- 465,470 ---- :M AutoScroll: ( -- ) \ scroll caret into view WindowState: parent SIZE_MINIMIZED = IF exitm THEN ! \ UpdatePoint: self \ force a paint to update text size ! \ PauseForMessages iLeftMargin CaretPos @ - 0 max width iRightMargin - CaretPos @ - 0 min + HScroll *************** *** 505,509 **** \ Draw the null terminated text 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 --- 498,503 ---- \ Draw the null terminated text DRAWTEXTPARAMS DT_NOCLIP DT_EXPANDTABS or DT_TABSTOP or DT_NOPREFIX or ! \ ScrollPos -1 Text GetHandle: dc call DrawTextEx drop ! ScrollPos TextZero Text - Text GetHandle: dc call DrawTextEx drop \ Draw highlighted text if any *************** *** 533,537 **** \ Calculate the size of the text and update ScrollRange DRAWTEXTPARAMS DT_CALCRECT DT_EXPANDTABS or DT_TABSTOP or DT_NOPREFIX or ! ScrollRange -1 Text GetHandle: mdc call DrawTextEx VertLine / to lines ;M --- 527,532 ---- \ Calculate the size of the text and update ScrollRange DRAWTEXTPARAMS DT_CALCRECT DT_EXPANDTABS or DT_TABSTOP or DT_NOPREFIX or ! \ ScrollRange -1 Text GetHandle: mdc call DrawTextEx VertLine / to lines ! ScrollRange TextZero Text - Text GetHandle: mdc call DrawTextEx VertLine / to lines ;M *************** *** 544,549 **** :M SetFont: ( font -- ) ! delete: font to font create: font ! Handle: font to hFont hFont SetFont: mdc tm GetTextMetrics: mdc --- 539,544 ---- :M SetFont: ( font -- ) ! delete: CommandFont to CommandFont create: CommandFont ! Handle: CommandFont to hFont hFont SetFont: mdc tm GetTextMetrics: mdc *************** *** 606,610 **** :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 --- 601,604 ---- *************** *** 620,624 **** UpdateLines THEN - \ release-dc ;M --- 614,617 ---- *************** *** 634,640 **** : On_Track ( h m -- h m ) - \ get-dc hFont SetFont: dc MouseX MouseY GetColRow - \ release-dc 2dup BeforeCommandLine StartBeforeCommandLine and >r 2dup AfterCommandLine StartAfterCommandLine and >r --- 627,631 ---- *************** *** 647,660 **** IF 0 to SelectedLength - \ get-dc hFont SetFont: dc SelStartCol SelStartRow ColRow>XY ScrollAdjust SelEndCol SelEndRow ColRow>XY ScrollAdjust UpdateLines SelStartCol to SelEndCol SelStartRow to SelEndRow - \ release-dc THEN ;M : SetStart ( x y -- ) \ used in On_Click and SelectAll: - \ get-dc hFont SetFont: dc GetColRow 2dup SetSelectionStart over swap OnCommandLine --- 638,648 ---- *************** *** 662,666 **** ELSE drop false THEN to Editing - \ release-dc ; --- 650,653 ---- *************** *** 677,682 **** : On_Unclick ( h m w -- h m w ) Call ReleaseCapture drop ; :M ReplaceText: { a n a1 n1 -- } \ replace a1 n1 with string a n ! a1 n1 + a1 n + TextEnd a1 - n1 - 1+ move \ a a1 n move n 0 ?DO a i + c@ dup 0= IF drop 32 THEN a1 i + c! LOOP \ replace 0 with space --- 664,674 ---- : On_Unclick ( h m w -- h m w ) Call ReleaseCapture drop ; + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + \ \\\\\ Changing text in the text buffer \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + :M ReplaceText: { a n a1 n1 -- } \ replace a1 n1 with string a n ! a1 n1 + a1 n + TextZero a1 - n1 - 1+ move ! n n1 - +to TextZero \ a a1 n move n 0 ?DO a i + c@ dup 0= IF drop 32 THEN a1 i + c! LOOP \ replace 0 with space *************** *** 686,690 **** :M DeleteText: { a1 n1 -- } \ remove a1 n1 ! a1 n1 + ( TextEnd min ) a1 TextEnd a1 - n1 - ( 0max ) 1+ move ;M --- 678,684 ---- :M DeleteText: { a1 n1 -- } \ remove a1 n1 ! \ n1 0max to n1 ! a1 n1 + ( TextZero min ) a1 TextZero a1 - n1 - ( 0max ) 1+ move ! n1 negate +to TextZero ;M *************** *** 692,700 **** :M InsertText: { a n a1 -- } ! a1 a1 n + TextEnd a1 - 1+ move a a1 n move ;M ! :M InsertTextAtEnd: ( a n -- ) TextEnd InsertText: self ;M :M DeleteTextOnCommandLine: ( a1 n1 -- ) \ and replace with spaces --- 686,695 ---- :M InsertText: { a n a1 -- } ! a1 a1 n + TextZero a1 - 1+ move ! n +to TextZero a a1 n move ;M ! :M InsertTextAtEnd: ( a n -- ) TextZero InsertText: self ;M :M DeleteTextOnCommandLine: ( a1 n1 -- ) \ and replace with spaces *************** *** 703,720 **** ;M - :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 - :M DeleteTextAndRedraw: ( a n -- ) \ DeleteText and update DeleteText: self Deselect: self Redraw: self ;M :M DeleteTextFromStart: ( n -- ) \ n chars increased to make whole rows, Y adjusted ! text + Text zcount BEGIN Y 1- 0max to Y 13 scan 1 /string 10 skip over 3 pick > over 0= or UNTIL drop text - nip --- 698,711 ---- ;M :M DeleteTextAndRedraw: ( a n -- ) \ DeleteText and update DeleteText: self Deselect: self Redraw: self + XYAddress to XYA ;M :M DeleteTextFromStart: ( n -- ) \ n chars increased to make whole rows, Y adjusted ! \ text + Text zcount ! text + Text TextZero over - BEGIN Y 1- 0max to Y 13 scan 1 /string 10 skip over 3 pick > over 0= or UNTIL drop text - nip *************** *** 722,726 **** : CheckTextBuffer ( n -- ) ! dup text zcount nip + 256 + MaxText > IF DeleteTextFromStart: self ELSE drop THEN ; --- 713,718 ---- : CheckTextBuffer ( n -- ) ! \ dup text zcount nip + 256 + MaxText > ! dup TextZero text - + 256 + MaxText > IF DeleteTextFromStart: self ELSE drop THEN ; *************** *** 732,749 **** :M OverwriteLineAtXY: ( a n -- ) dup>r ! XYAddress over Y RowLength X - min ReplaceText: self ! X Y r> +to X X ( 1+ ) Y false UpdateRange ;M :M CR: ( -- ) ! crlf$ count OverwriteLineAtXY: self Y UpdateLine: self 0 to X 1 +to Y - \ LastColRow: self X Y 1+ d> IF DeleteLine: self THEN \ safe to delete nothing DeleteLine: self \ no need to update this scp AutoScroll: self ;M int wrap :M wrap: ( n -- ) to wrap ;M \ false: no wrapping, true: wrap after last visible column, positve value: wrap after this column --- 724,751 ---- :M OverwriteLineAtXY: ( a n -- ) dup>r ! XYA over 2dup 13 scan nip - >r over 2dup 0 scan nip - r> min r@ min ReplaceText: self ! X Y r@ +to XYA r> +to X X Y false UpdateRange ! ;M ! ! :M DeleteLine: ( -- ) \ delete current row ! XYA TextZero over - ! 2dup 13 scan 13 skip 10 skip nip - DeleteText: self ! \ 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 :M CR: ( -- ) ! crlf$ count XYA InsertText: self Y UpdateLine: self + 2 +to XYA 0 to X 1 +to Y DeleteLine: self \ no need to update this + \ ScrollRangeChanged? IF UpdateScrollRange: self THEN scp AutoScroll: self ;M + :M ?CR: ( n -- ) X + VisibleCols: self > IF CR: self THEN ;M + int wrap :M wrap: ( n -- ) to wrap ;M \ false: no wrapping, true: wrap after last visible column, positve value: wrap after this column *************** *** 753,757 **** :M OverwriteTextAtXY: ( a n -- ) dup CheckTextBuffer \ one line at a time BEGIN dup>r 2dup 2dup 13 scan nip - AdjustCount dup>r OverwriteLineAtXY: self r@ 2r> - \ chars inserted, chars remaining ! WHILE CR: self /string 13 skip 10 skip REPEAT 3drop ScrollRangeChanged? IF UpdateScrollRange: self THEN --- 755,760 ---- :M OverwriteTextAtXY: ( a n -- ) dup CheckTextBuffer \ one line at a time BEGIN dup>r 2dup 2dup 13 scan nip - AdjustCount dup>r OverwriteLineAtXY: self r@ 2r> - \ chars inserted, chars remaining ! \ WHILE CR: self /string 13 skip 10 skip ! WHILE CR: self /string 1 /string 10 skip REPEAT 3drop ScrollRangeChanged? IF UpdateScrollRange: self THEN *************** *** 760,783 **** :M InsertTextAtXY: ( a n -- ) \ insert text and update to end of row dup>r XYAddress 0 ReplaceText: self X Y r> +to X Y RowLength Y false UpdateRange ScrollRangeChanged? IF UpdateScrollRange: self THEN ;M - \ ************ special one for command line ********************* :M GoToXY: ( X Y -- ) \ add extra lines and lengthen lines with spaces if necessary to Y to X ! Y dup LastColRow: self nip - 0max 0 ?DO crlf$ count InsertTextAtEnd: self LOOP ! to Y X Y RowLength 2dup > ! IF - SPCS swap Y RowEndAddress InsertText: self ELSE 2drop THEN scp AutoScroll: self ;M :M cls: ( -- ) 0 text c! ! Redraw: self ! 0 to X 0 to Y \ 1 to lines \ 0 text ! 0 to CommandStart 0 to #chars ;M --- 763,791 ---- :M InsertTextAtXY: ( a n -- ) \ insert text and update to end of row + \ ************ special one for command line dup>r XYAddress 0 ReplaceText: self X Y r> +to X Y RowLength Y false UpdateRange ScrollRangeChanged? IF UpdateScrollRange: self THEN ;M :M GoToXY: ( X Y -- ) \ add extra lines and lengthen lines with spaces if necessary to Y to X ! \ Y dup LastRow - 0max 0 ?DO crlf$ count InsertTextAtEnd: self LOOP to Y ! Y LastRow - 0max 0 ?DO crlf$ count InsertTextAtEnd: self LOOP ! Y RowString 2>r ! X r@ > ! IF SPCS X r@ - 2r> + InsertText: self ELSE 2r> 2drop THEN scp AutoScroll: self + XYAddress to XYA ;M :M cls: ( -- ) 0 text c! ! 0 to X 0 to Y 1 to lines 0 to CommandStart 0 to #chars + text to XYA text to TextZero + EraseRect: ScrollRange + Redraw: self ;M *************** *** 801,806 **** SelStartCol SelStartRow RowAddress + dup SelStartCol 32 -scan 32 skip drop \ search backwards for space ! over dup textend swap - 13 scan drop \ search forwards for cr ! rot dup textend swap - 32 scan drop min \ search forwards for space over - pad place 32 pad count + ! \ add a space pad 1+ InsertTextOnCommandLine: self ; --- 809,814 ---- SelStartCol SelStartRow RowAddress + dup SelStartCol 32 -scan 32 skip drop \ search backwards for space ! over dup TextZero swap - 13 scan drop \ search forwards for cr ! rot dup TextZero swap - 32 scan drop min \ search forwards for space over - pad place 32 pad count + ! \ add a space pad 1+ InsertTextOnCommandLine: self ; *************** *** 917,921 **** prompt zcount OverwriteTextAtXY: self X to CommandStart ! XYAddress to CommandLine 0 to #chars SPCS MaxChars Y RowLength X - min OverwriteTextAtXY: self \ blank up to MaxChar --- 925,929 ---- prompt zcount OverwriteTextAtXY: self X to CommandStart ! XYA to CommandLine 0 to #chars SPCS MaxChars Y RowLength X - min OverwriteTextAtXY: self \ blank up to MaxChar *************** *** 924,927 **** --- 932,936 ---- AutoScroll: self ShowCaret: self + ShowCaret: self \ does no harm but prevents loss of caret with lengthy text in buffer InitHistory ;M *************** *** 931,936 **** Deselect: self CommandEnd to X \ correct X if caret is not at end of command line false to editing - \ EmptyKeyBuffer: self ExecuteCommand \ -1 to CommandStart --- 940,945 ---- Deselect: self CommandEnd to X \ correct X if caret is not at end of command line + XYAddress to XYA false to editing ExecuteCommand \ -1 to CommandStart *************** *** 1161,1166 **** VK_INSERT of 0 0 endof VK_DELETE of DeleteForward: self 0 0 endof ! VK_PRIOR of SB_TOP WM_VSCROLL endof ! VK_NEXT of SB_BOTTOM WM_VSCROLL endof VK_LEFT of ?Shift IF ShiftLeft: self ELSE CaretLeft: self THEN 0 0 endof VK_RIGHT of ?Shift IF ShiftRight: self ELSE CaretRight: self THEN 0 0 endof --- 1170,1175 ---- VK_INSERT of 0 0 endof VK_DELETE of DeleteForward: self 0 0 endof ! VK_PRIOR of ?shift IF SB_TOP ELSE SB_PAGEUP THEN WM_VSCROLL endof ! VK_NEXT of ?shift IF SB_BOTTOM ELSE SB_PAGEDOWN THEN WM_VSCROLL endof VK_LEFT of ?Shift IF ShiftLeft: self ELSE CaretLeft: self THEN 0 0 endof VK_RIGHT of ?Shift IF ShiftRight: self ELSE CaretRight: self THEN 0 0 endof *************** *** 1220,1224 **** 8 to iTabLength 1024 to MaxHistory ! 100000 to MaxText 0 to head -1 to wrap --- 1229,1233 ---- 8 to iTabLength 1024 to MaxHistory ! $100000 to MaxText \ max size of text buffer 1 MB 0 to head -1 to wrap *************** *** 1227,1233 **** 8 to HorzLine 13 to VertLine - CommandFont to font - Create: CommandFont - Handle: CommandFont to hFont Black to ForegroundColour White to BackgroundColour --- 1236,1239 ---- *************** *** 1253,1258 **** :M On_Init: ( -- ) 0 Call CreateCompatibleDC PutHandle: mDC ! MaxText malloc to text text MaxText 45 fill 0 text c! \ text MaxText erase CommandFont SetFont: self \ this creates a caret in BigCursor: self DestroyCaret: self \ no caret until command window gets the focus --- 1259,1271 ---- :M On_Init: ( -- ) + new> WinDC to mDC 0 Call CreateCompatibleDC PutHandle: mDC ! MaxText malloc to text ! cls: self ! new> font to CommandFont ! 10 Height: CommandFont ! \ FW_HEAVY Weight: CommandFont \ Optional ! s" Courier" SetFaceName: CommandFont ! \ s" Terminal" SetFaceName: CommandFont \ Optional choice CommandFont SetFont: self \ this creates a caret in BigCursor: self DestroyCaret: self \ no caret until command window gets the focus *************** *** 1263,1266 **** --- 1276,1283 ---- :M On_Done: ( -- ) GetHandle: mdc call DeleteDC drop + mDC dispose + delete: CommandFont + CommandFont dispose + Text release ;M |
