( ScrollTextUp )

needs module: modules

api: FntWordWrap
api: FntCharsWidth
api: StrLen
api: RctSetRectangle
api: WinDrawChars
api: WinSetClip
api: WinGetClip
api: WinScrollRectangle
api: WinEraseLine

module: ScrollTextUp
module: _
0 value StrCur
0 value StrCurLen
0 value StrY
0 value StrX
0 value StrNext
create ScrollRect 8 allot
: scrX ScrollRect w@ ;
: scrY ScrollRect 2+ w@ ;
: scrW ScrollRect 4 + w@ ;
: scrH ScrollRect 6 + w@ ;
: StrRemoveCR ( addr u -- addr u1 )
	2dup + 1- c@ 0x0A = if
		1- then ;
: CalcStrPortion ( z-addr -- f )
\ f = end of text
	dup to StrCur
	>abs StrLen 0= if
		true exit then
	StrCur >abs scrW
	FntWordWrap
	StrCur swap
	2dup + to StrNext
	StrRemoveCR dup to StrCurLen
	swap >abs swap FntCharsWidth
	scrW swap - 2/ 1+ to StrX
	false ;
create ClipRect 8 allot
create OldClipRect 8 allot
: SetClip
	OldClipRect >abs WinGetClip
	ClipRect >abs
	scrX
	scrY scrH + 11 -
	scrW 11 RctSetRectangle
	ClipRect >abs WinSetClip ;
: ResetClip
	OldClipRect >abs WinSetClip ;
: ScrollScr
	ScrollRect >abs
	0 1 ClipRect >abs
	WinScrollRectangle
	scrX ScrY scrH + 1-
	2dup swap scrW + 1- swap
	WinEraseLine ;
0 value ScrState
export
0 constant ssScroll
1 constant ssFeed
2 constant ssOut
: ScrollStep ( -- ss )
\ ss - scroll state
\ ssScroll - scroll and appear text
\ ssFeed - end of text reached
\ ssOut - whole text disappeared
	ScrState ssOut = if
		ssOut exit then
	ScrollScr
	ScrState ssScroll = if
		SetClip
		StrCur >abs StrCurLen
		scrX StrX +
		scrY scrH + StrY - 1-
		WinDrawChars
		ResetClip
		StrY 1+
		dup 11 > if
			drop 0 to StrY
			StrNext
			CalcStrPortion if
				ssFeed
			else
				ssScroll
			then
		else
			to StrY ssScroll
		then
	else
		StrY 1+ dup to StrY
		scrH > if ssOut
		else ssFeed then
	then
	dup to ScrState ;

: SetRect ( x y w h -- )
	2>r 2>r ScrollRect >abs
	2r> 2r> RctSetRectangle ;
: SetText ( z-addr -- )
	CalcStrPortion drop
	0 to StrY
	ssScroll to ScrState ;
: Run begin ScrollStep ssScroll = until ;
;module
;module

