home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
basic
/
library
/
tb
/
wprint
/
wprint.inc
< prev
next >
Wrap
Text File
|
1987-12-05
|
4KB
|
90 lines
'WPRINT.INC Copyright (c) 1987 by Unique Software
SUB Wprint(windo%,wcolor%,strng$,no.cr%) STATIC
' windo% : 0=print to current active window
' : >0=print to specific window
' : (in TBWINDO.INC this is the variable "li")
' wcolor% : the foreground color for this string to be printed in
' : the background color of the window is ALWAYS used
' strng$ : string you want to print
' no.cr% : 0=do a <CR> after printing string
' : <>0=don't do a <CR> after printing sring
' : i.e. consider a non-zero value as a trailing ; in a PRINT stmt
SHARED li , wrow() , wrows() , wcol() , wcols() , wccol() , wcrow()
LOCAL wstr$ , wword$ , word.len% , row.max% , col.max% , row.min% , col.min%
LOCAL cols% , rows% , exit.flag%
IF windo%<1 OR windo%>li THEN windo%=li
cols%=wcols(windo%)-2
' speed up things by not recalculating this value several times in this SUB
wstr$=strng$
word.len%=0
WHILE LEN(wstr$)>0
CALL Getword(word.len%,wstr$)
IF word.len%=0 THEN EXIT SUB
wword$=LEFT$(wstr$,word.len%) ' get word
wstr$=MID$(wstr$,word.len%+1) ' remove from string
IF ( word.len%+wccol(windo%)-1 ) > cols% AND word.len% > cols% THEN
' if the whole word is wider than the total width of the window then
wstr$=MID$(wword$,cols%-wccol(windo%)+2)+wstr$
' put the part of the word we won't use back to the working string
wword$=LEFT$(wword$,cols%-wccol(windo%)+1)
' get enough of the word to fill current line
word.len%=len(wword$)
' the new word length
END IF
IF ( word.len%+wccol(windo%)-1 ) > cols% THEN CALL Wscroll(windo%)
CALL WQPRINT(windo%,wcolor%,wword$)
IF wccol(windo%)>=cols% THEN CALL Wscroll(windo%) ' scroll position
WEND
IF no.cr%=0 THEN CALL Wscroll(windo%) ' scroll position
END SUB
SUB Wqprint(windo%,wcolor%,word$)
'print word$ at current position and update
SHARED wrow() , wcol() , wcrow() , wccol() , wattr() , li
LOCAL tmp%
IF windo%<1 OR windo%>li THEN windo%=li
if asc(word$)=32 then
' if we have a single space & are at the start of a column then don't print it
if len(word$)=1 and wccol(windo%)=1 then exit sub
end if
if wcolor%=0 then
tmp%=wattr(windo%)
else
tmp%=16*(wattr(windo%)\16)+wcolor%
end if
CALL Qprint (wrow(windo%)+wcrow(windo%),wcol(windo%)+wccol(windo%),word$,tmp%)
INCR wccol(windo%),LEN(word$)
END SUB
SUB Wscroll(windo%)
'windo% : 0=active window (variable "li" in TBWINDO.INC)
' : >li=active window
SHARED wrow() , wcol() , wrows() , wcols() , wattr() , li , wcrow() , wccol()
IF windo%<1 OR windo%>li THEN windo%=li ' 0=current active window
wccol(windo%)=1
IF wcrow(windo%) < ( wrows(windo%)-2 ) THEN
INCR wcrow(windo%) ' increment current row
exit sub
END IF
REG 1,&H0601 ' scroll up : one line
REG 2,wattr(windo%)*256 ' windo%'s attribute to BH
REG 3,wrow(windo%)*256+wcol(windo%) ' starting row & column
' the video bios routine uses absolute (0:0) addressing and since we don't
' want to scroll the frame (relative 0:0) no adjustment is necessary
REG 4,( wrow(windo%)+wrows(windo%)-3 )*256+_ ' lower right row to DH
( wcol(windo%)+wcols(windo%)-3 ) ' lower right col to DL
CALL INTERRUPT &H10 ' execute video bios routine
END SUB
'CALL getword (result%,string$)
SUB Getword INLINE
'returns the length of the first word in string$
'where a word is a group of spaces OR a group of characters ending with a space
$INLINE 085,137,229,006,030,196,126,006,038,139,013,129,225,255,127,131,249
$INLINE 000,116,002,235,005,049,192,233,037,000,062,139,022,000,000,082,031
$INLINE 038,139,117,002,065,030,007,137,247,176,032,038,138,037,128,252,032
$INLINE 117,004,243,174,235,002,242,174,137,248,041,240,072,197,126,010,062
$INLINE 137,005,031,007,093
END SUB