[Win32forth-cvs] win32forth/src/console CommandWindow.f,1.22,1.23

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/win32forth/win32forth/src/console
In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv6309

Modified Files:
	CommandWindow.f 
Log Message:
Rod: improved On_Paint: method and UpdateScrollRange: method

Index: CommandWindow.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/console/CommandWindow.f,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -d -r1.22 -r1.23
*** CommandWindow.f	29 Oct 2008 23:20:55 -0000	1.22
--- CommandWindow.f	5 Nov 2008 11:00:00 -0000	1.23
***************
*** 36,46 ****
  int font
  int hFont
- :M SetFont: ( font -- )
-         delete: font  to font  create: font
-         Handle: font to hFont
-         hFont SetFont: mdc
-         paint: self
-         PauseForMessages  BigCursor: [ self ]
-         ;M

  int X
--- 36,39 ----
***************
*** 51,55 ****
  int text   \ pointer to text buffer
  int MaxText   \ size of text buffer allocated
- int NewLine   \ To reduce calculations in paint

  : TextEnd ( -- a )   text zcount + ;
--- 44,47 ----
***************
*** 76,80 ****
  : CommandString ( -- a n )   CommandLine #chars ;

! int MaxChars   \ maximum nimber of characters accepted on the command line
  :M SetMaxChars: ( n -- )   to MaxChars ;M

--- 68,72 ----
  : CommandString ( -- a n )   CommandLine #chars ;

! int MaxChars   \ maximum number of characters accepted on the command line
  :M SetMaxChars: ( n -- )   to MaxChars ;M

***************
*** 83,88 ****
  :M KeysOn: ( -- )   true to KeysOn ;M

- int VirtualKey   \ last virtual key code stored when not processing keys
- :M SetVirtualkey: ( n -- )   to VirtualKey ;M
  int Abort?     \ flag set when esc pressed

--- 75,78 ----
***************
*** 336,340 ****
              Right: ScrollRange - Left: ScrollPos -  max
              dup  ScrollPos +!  0 Scroll: self
!             Update: self
              UpdateHScroll: self
          THEN
--- 326,330 ----
              Right: ScrollRange - Left: ScrollPos -  max
              dup  ScrollPos +!  0 Scroll: self
! \            Update: self
              UpdateHScroll: self
          THEN
***************
*** 505,527 ****
         ;M

! :M On_Paint: ( -- )   \ all window refreshing is done by On_Paint: or update:

- \ Set up metrics
          hFont SetFont: dc
-         tm GetTextMetrics: dc
-         tmAveCharWidth  dup to HorzLine  20 * to HorzPage
-         tmHeight tmExternalLeading +  dup to VertLine  7 * to VertPage
-         iTabLength HorzLine * TabWidth !
- 
          ForegroundColour SetTextColor: dc
          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
--- 495,509 ----
         ;M

! :M On_Paint: ( -- )   \ all window refreshing is done by On_Paint:
!                       \ the size of the text is now calculated in UpdateScrollRange:
!                       \ text metrics are calculated just once in SetFont:

          hFont SetFont: dc
          ForegroundColour SetTextColor: dc
          BackgroundColour SetBkColor: dc

! \ 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
***************
*** 548,601 ****
          ;M

! :M update: ( -- )   \ Added to prevent deadlocks when called by other tasks
! 
! \ Set up metrics
!         hFont SetFont: mdc
!         tm GetTextMetrics: mdc
!         tmAveCharWidth  dup to HorzLine  20 * to HorzPage
!         tmHeight tmExternalLeading +  dup to VertLine  7 * to VertPage
!         iTabLength HorzLine * TabWidth !
! 
!         ForegroundColour SetTextColor: mdc
!         BackgroundColour SetBkColor: mdc
! 
! \ 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: mdc 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: mdc call DrawTextEx  drop
! 
! \ Draw highlighted text if any
!         SelectedLength
!         IF
!             BackgroundColour SetTextColor: mdc
!             ForegroundColour SetBkColor: mdc
!             iLeftMargin scrollpos.left +  TabWidth  1
!             FirstSelectedLine swap
!             SelStartX SelStartY ScrollAdjust swap
!             GetHandle: mdc call TabbedTextOut drop
! 
!             0 SelStartX SelStartY nip ScrollAdjust   \ adjusted point at start of row
!             BEGIN  SelectionRemainingLength          \ while some chars left
!             WHILE
!                  VertLine +  2dup 2>r
!                  iLeftMargin scrollpos.left +  TabWidth  1
!                  NextSelectedLine swap
!                  2r> swap
!                  GetHandle: mdc call TabbedTextOut drop
!             REPEAT
!             2drop
!         THEN
          ;M

  :M Redraw: ( -- )
          Paint: self
!         Update: self
          UpdateVScroll: self
          UpdateHScroll: self
          ;M

  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  \ \\\\\ Text Operations \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
--- 530,558 ----
          ;M

! :M UpdateScrollRange: ( -- )   \ Added to prevent deadlocks when called by other tasks
!                                \ 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

  :M Redraw: ( -- )
          Paint: self
!         UpdateScrollRange: self
          UpdateVScroll: self
          UpdateHScroll: self
          ;M

+ :M SetFont: ( font -- )
+         delete: font  to font  create: font
+         Handle: font to hFont
+         hFont SetFont: mdc
+         tm GetTextMetrics: mdc
+         tmAveCharWidth  dup to HorzLine  20 * to HorzPage
+         tmHeight tmExternalLeading +  dup to VertLine  7 * to VertPage
+         iTabLength HorzLine * TabWidth !
+         Redraw: self
+         PauseForMessages  BigCursor: self
+         ;M
+ 
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  \ \\\\\ Text Operations \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
***************
*** 768,771 ****
--- 725,733 ----
          IF  DeleteTextFromStart: self  ELSE  drop  THEN ;

+ : ScrollRangeChanged? ( -- )
+         X Y ColRow>xy bottom: ScrollRange >
+         swap right: ScrollRange > or
+         ;
+ 
  :M OverwriteLineAtXY: ( a n -- )
          dup>r
***************
*** 775,779 ****

  :M CR: ( -- )
!         crlf$ count true to NewLine OverwriteLineAtXY: self
          Y UpdateLine: self
          0 to X  1 +to Y
--- 737,741 ----

  :M CR: ( -- )
!         crlf$ count OverwriteLineAtXY: self
          Y UpdateLine: self
          0 to X  1 +to Y
***************
*** 793,797 ****
          WHILE  CR: self  /string  13 skip 10 skip
          REPEAT  3drop
!         Update: self
  \        AutoScroll: self
          ;M
--- 755,759 ----
          WHILE  CR: self  /string  13 skip 10 skip
          REPEAT  3drop
!         ScrollRangeChanged? IF  UpdateScrollRange: self  THEN
  \        AutoScroll: self
          ;M
***************
*** 800,803 ****
--- 762,766 ----
          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 *********************
***************
*** 814,818 ****
  :M cls: ( -- )
          0 text c!
- 	true to NewLine
          Redraw: self
          0 to X  0 to Y  \ 1 to lines \  0 text !
--- 777,780 ----
***************
*** 951,954 ****
--- 913,917 ----

  :M Prompt: ( -- )
+         UpdateScrollRange: self
          true to editing
          prompt zcount OverwriteTextAtXY: self
***************
*** 973,977 ****
  \        -1 to CommandStart
          0 to #chars
-         0 to VirtualKey
          ;M

--- 936,939 ----
***************
*** 1259,1263 ****
          1024 to MaxHistory
          100000 to MaxText
- 	true to NewLine
          0 to head
          -1 to wrap
--- 1221,1224 ----