'===========================================================================
' Subject: SOME USEFUL TEXT ROUTINES         Date: 07-31-99 (16:12)       
' Author:  Bernt Figaro                      Code: QB, QBasic, PDS        
' Origin:  bernt.figaro@swipnet.se         Packet: TEXT.ABC
'===========================================================================
REM
REM bernt.figaro@swipnet.se
REM
DECLARE FUNCTION GetMonSeg% ()
DECLARE FUNCTION Randy% (Lowest%, Highest%)
DECLARE SUB ClearScr0 (Row0%, Col0%, Row1%, Col1%, Attr%)
DECLARE SUB DrawBox (R0%, C0%, R1%, C1%, BAttr%, Btype%, WAttr%, Shadow%)
DECLARE SUB Meny ()
DECLARE SUB MemSwap (DSeg1%, DOfs1%, DSeg2%, DOfs2%, Bytes%)
DECLARE SUB QPRINTRC (Message$, Row%, Col%, Attr%)
DECLARE SUB Replace (Work$, Old$, New$)
DECLARE SUB TLoad (FileName$, Oops%)
DECLARE SUB Tsave (FileName$, Oops%)
REM Author 1994 <BERNT FIGARO>
REM
REM --- Start
DO
Meny
ClearScr0 25, 1, 25, 80, 79
QPRINTRC "Choice    S)ave picture   L)oad picture   E)xit", 25, 18, 79

L$ = UCASE$(INPUT$(1))


SELECT CASE L$
CASE "E"
COLOR 15, 0
CLS
END
CASE "S"
Meny
QPRINTRC "First name ", 7, 4, 79
QPRINTRC "Last name  ", 8, 4, 79
DrawBox 12, 6, 21, 75, 30, 3, 31, 1
QPRINTRC "Want You Your name in the picture (Y/N) ?", 13, 8, 31
QPRINTRC "(12 char each !)", 14, 8, 31
L$ = UCASE$(INPUT$(1))
IF L$ = "Y" THEN
QPRINTRC "First name: ", 15, 8, 31
COLOR 14, 1
LOCATE 15, 20, 1
LINE INPUT ; F$
QPRINTRC "Last  name: ", 16, 8, 31
LOCATE 16, 20, 1
LINE INPUT ; E$
END IF
QPRINTRC "Picture file name (8 char /A-Z/, /extension.BLD/)", 17, 8, 31
LOCATE 17, 62, 1
LINE INPUT FileName$
IF LEN(FileName$) > 8 THEN FileName$ = LEFT$(FileName$, 8)
IF LEN(FileName$) = 0 THEN FileName$ = "CopyPic"
Meny
IF LEN(F$) THEN
DrawBox 6, 3, 9, 19, 95, 4, 95, 1
QPRINTRC LEFT$(F$ + SPACE$(12), 12), 7, 5, 94
QPRINTRC LEFT$(E$ + SPACE$(12), 12), 8, 5, 94
END IF
Tsave FileName$ + ".BLD", Ecode%
SaveIt% = -1
CASE "L"
LoadIt:
IF NOT (SaveIt%) THEN
ClearScr0 25, 1, 25, 80, 116
QPRINTRC "No saving yet ! Hit Enter !", 25, 16, 116
ELSE
TLoad FileName$ + ".BLD", Ecode%
ClearScr0 25, 1, 25, 80, 116
IF Ecode% THEN
QPRINTRC "Wrong file name ! Hit Enter !", 25, 16, 116
ELSE
TLoad FileName$ + ".BLD", Ecode%
QPRINTRC "Picture loaded ! Hit any key !", 25, 16, 116
END IF
END IF
L$ = INPUT$(1)
CASE ELSE
END SELECT
LOOP

'----------------DATAAREA------------

MenyText:
DATA 8

DATA "ClearScr0 : Wipe off the SCREEN in current attribute.             "
DATA "DrawBox   : Making several boxes, w/O shadow.                     "
DATA "QPrintRC  : Write fast to the SCREEN.                             "
DATA "Memswap   : Memory copying routine.                               "
DATA "GetMonSeg : Get the current SCREEN segement.                      "
DATA "Replace   : Chaning char in a string.                             "
DATA "TSave     : Save text SCREEN binary, 4000 bytes to disk           "
DATA "TLoad     : Load a saved text SCREEN binary, 4000 bytes from disk "


MenyData:
DATA "15555015555015551015555015555015101051551015555015151015551"
DATA "55551010000015515015500015500010101001001015500010101010001"
DATA "55555055555050055055555055555050555055555055555050505055555"
DATA "55155015555015551010001015555"
DATA "00100055551015551010015015500"
DATA "00500055555050005055550055555"
DATA "55155010000015551015551051551"
DATA "00100010000010001015551001001"
DATA "00500055555055555050005055555"

REM $DYNAMIC
DEFINT A-Z
SUB ClearScr0 (Row0%, Col0%, Row1%, Col1%, Attr%) STATIC
STATIC ClrS$, InitCode
IF NOT InitCode THEN
ClrS$ = ClrS$ + MKL$(-1947432107)
ClrS$ = ClrS$ + MKL$(260770910)
ClrS$ = ClrS$ + MKL$(241077065)
ClrS$ = ClrS$ + MKL$(-1974990965)
ClrS$ = ClrS$ + MKL$(140413928)
ClrS$ = ClrS$ + MKL$(-1958213749)
ClrS$ = ClrS$ + MKL$(173968336)
ClrS$ = ClrS$ + MKL$(-1974990965)
ClrS$ = ClrS$ + MKL$(106859504)
ClrS$ = ClrS$ + MKL$(-125171829)
ClrS$ = ClrS$ + MKL$(-855244616)
ClrS$ = ClrS$ + MKL$(181034256)
ClrS$ = ClrS$ + MKL$(0)
ClrS$ = ClrS$ + MKL$(0)
END IF
DEF SEG = VARSEG(ClrS$)
CALL ABSOLUTE(Row0%, Col0%, Row1%, Col1%, Attr%, SADD(ClrS$))
DEF SEG
END SUB

REM $STATIC
SUB DrawBox (R0%, C0%, R1%, C1%, BAttr%, Btype%, WAttr%, Shadow%) STATIC

STATIC Bd$, InitCode%

IF NOT InitCode% THEN
I% = 0
Bd$ = Bd$ + MKL$(-2081649835)
Bd$ = Bd$ + MKL$(1187452140)
Bd$ = Bd$ + MKL$(-956255252)
Bd$ = Bd$ + MKL$(12906054)
Bd$ = Bd$ + MKL$(-621787449)
Bd$ = Bd$ + MKL$(-230242560)
Bd$ = Bd$ + MKL$(1187446975)
Bd$ = Bd$ + MKL$(-956251916)
Bd$ = Bd$ + MKL$(14284358)
Bd$ = Bd$ + MKL$(-1962254709)
Bd$ = Bd$ + MKL$(81159)
Bd$ = Bd$ + MKL$(82379637)
Bd$ = Bd$ + MKL$(146689)
Bd$ = Bd$ + MKL$(1187455349)
Bd$ = Bd$ + MKL$(-956253460)
Bd$ = Bd$ + MKL$(13495878)
Bd$ = Bd$ + MKL$(-907000121)
Bd$ = Bd$ + MKL$(-230242560)
Bd$ = Bd$ + MKL$(1187446971)
Bd$ = Bd$ + MKL$(-956249868)
Bd$ = Bd$ + MKL$(12383814)
Bd$ = Bd$ + MKL$(1023467241)
Bd$ = Bd$ + MKL$(561315843)
Bd$ = Bd$ + MKL$(-1158920505)
Bd$ = Bd$ + MKL$(-297351424)
Bd$ = Bd$ + MKL$(1187446980)
Bd$ = Bd$ + MKL$(-956246288)
Bd$ = Bd$ + MKL$(12055110)
Bd$ = Bd$ + MKL$(-738965817)
Bd$ = Bd$ + MKL$(-163133696)
Bd$ = Bd$ + MKL$(-1192689475)
Bd$ = Bd$ + MKL$(277760)
Bd$ = Bd$ + MKL$(1187455349)
Bd$ = Bd$ + MKL$(-956255252)
Bd$ = Bd$ + MKL$(13495878)
Bd$ = Bd$ + MKL$(-705673529)
Bd$ = Bd$ + MKL$(-230242560)
Bd$ = Bd$ + MKL$(1187446968)
Bd$ = Bd$ + MKL$(-956246796)
Bd$ = Bd$ + MKL$(12514886)
Bd$ = Bd$ + MKL$(1023447785)
Bd$ = Bd$ + MKL$(544538629)
Bd$ = Bd$ + MKL$(-605272377)
Bd$ = Bd$ + MKL$(-297351424)
Bd$ = Bd$ + MKL$(1187447003)
Bd$ = Bd$ + MKL$(-956245008)
Bd$ = Bd$ + MKL$(14414406)
Bd$ = Bd$ + MKL$(-604748089)
Bd$ = Bd$ + MKL$(-163133696)
Bd$ = Bd$ + MKL$(1844117723)
Bd$ = Bd$ + MKL$(1962935869)
Bd$ = Bd$ + MKL$(-297351392)
Bd$ = Bd$ + MKL$(1187446962)
Bd$ = Bd$ + MKL$(-956255508)
Bd$ = Bd$ + MKL$(11726918)
Bd$ = Bd$ + MKL$(-1292745017)
Bd$ = Bd$ + MKL$(-196688128)
Bd$ = Bd$ + MKL$(1187446962)
Bd$ = Bd$ + MKL$(-352275722)
Bd$ = Bd$ + MKL$(474440)
Bd$ = Bd$ + MKL$(1187455093)
Bd$ = Bd$ + MKL$(-956255762)
Bd$ = Bd$ + MKL$(11660358)
Bd$ = Bd$ + MKL$(-1309653305)
Bd$ = Bd$ + MKL$(-230242560)
Bd$ = Bd$ + MKL$(1187446961)
Bd$ = Bd$ + MKL$(-956255756)
Bd$ = Bd$ + MKL$(11662918)
Bd$ = Bd$ + MKL$(138224619)
Bd$ = Bd$ + MKL$(-954305280)
Bd$ = Bd$ + MKL$(11594822)
Bd$ = Bd$ + MKL$(-1326561593)
Bd$ = Bd$ + MKL$(-263796992)
Bd$ = Bd$ + MKL$(1187446960)
Bd$ = Bd$ + MKL$(-956256014)
Bd$ = Bd$ + MKL$(11596870)
Bd$ = Bd$ + MKL$(-1326037305)
Bd$ = Bd$ + MKL$(308185856)
Bd$ = Bd$ + MKL$(1317605259)
Bd$ = Bd$ + MKL$(-506377734)
Bd$ = Bd$ + MKL$(-1961599349)
Bd$ = Bd$ + MKL$(-129595129)
Bd$ = Bd$ + MKL$(10533448)
Bd$ = Bd$ + MKL$(-1056709898)
Bd$ = Bd$ + MKL$(1586229643)
Bd$ = Bd$ + MKL$(-1995470066)
Bd$ = Bd$ + MKL$(-783679922)
Bd$ = Bd$ + MKL$(-775017503)
Bd$ = Bd$ + MKL$(-259304983)
Bd$ = Bd$ + MKL$(-1961861493)
Bd$ = Bd$ + MKL$(-62486265)
Bd$ = Bd$ + MKL$(10533448)
Bd$ = Bd$ + MKL$(1346953974)
Bd$ = Bd$ + MKL$(-1962385781)
Bd$ = Bd$ + MKL$(1039698439)
Bd$ = Bd$ + MKL$(494141440)
Bd$ = Bd$ + MKL$(-27882671)
Bd$ = Bd$ + MKL$(-62485686)
Bd$ = Bd$ + MKL$(-1947170232)
Bd$ = Bd$ + MKL$(-906036658)
Bd$ = Bd$ + MKL$(-17283445)
Bd$ = Bd$ + MKL$(-1192719672)
Bd$ = Bd$ + MKL$(281872128)
Bd$ = Bd$ + MKL$(207522649)
Bd$ = Bd$ + MKL$(12191627)
Bd$ = Bd$ + MKL$(-1950183752)
Bd$ = Bd$ + MKL$(1183535358)
Bd$ = Bd$ + MKL$(-1949267218)
Bd$ = Bd$ + MKL$(-259331002)
Bd$ = Bd$ + MKL$(-1963964789)
Bd$ = Bd$ + MKL$(-230257672)
Bd$ = Bd$ + MKL$(1582880906)
Bd$ = Bd$ + MKL$(1979136854)
Bd$ = Bd$ + MKL$(-1963292156)
Bd$ = Bd$ + MKL$(653757402)
Bd$ = Bd$ + MKL$(65748104)
Bd$ = Bd$ + MKL$(1175750694)
Bd$ = Bd$ + MKL$(57933884)
Bd$ = Bd$ + MKL$(1174702118)
Bd$ = Bd$ + MKL$(-2010713374)
Bd$ = Bd$ + MKL$(3950108)
Bd$ = Bd$ + MKL$(-2010774668)
Bd$ = Bd$ + MKL$(995711748)
Bd$ = Bd$ + MKL$(-2127069709)
Bd$ = Bd$ + MKL$(-1962893113)
Bd$ = Bd$ + MKL$(2113092599)
Bd$ = Bd$ + MKL$(881337885)
Bd$ = Bd$ + MKL$(1946172486)
Bd$ = Bd$ + MKL$(76031491)
Bd$ = Bd$ + MKL$(66126670)
Bd$ = Bd$ + MKL$(881338097)
Bd$ = Bd$ + MKL$(1946172486)
Bd$ = Bd$ + MKL$(76031491)
Bd$ = Bd$ + MKL$(-1957635605)
Bd$ = Bd$ + MKL$(-125111226)
Bd$ = Bd$ + MKL$(-1963571573)
Bd$ = Bd$ + MKL$(1364416728)
Bd$ = Bd$ + MKL$(1586209771)
Bd$ = Bd$ + MKL$(1023904518)
Bd$ = Bd$ + MKL$(1735655424)
Bd$ = Bd$ + MKL$(-772125045)
Bd$ = Bd$ + MKL$(-62485535)
Bd$ = Bd$ + MKL$(-167731014)
Bd$ = Bd$ + MKL$(-1950284830)
Bd$ = Bd$ + MKL$(1317750512)
Bd$ = Bd$ + MKL$(-96039938)
Bd$ = Bd$ + MKL$(145803307)
Bd$ = Bd$ + MKL$(12206401)
Bd$ = Bd$ + MKL$(650284728)
Bd$ = Bd$ + MKL$(1178993800)
Bd$ = Bd$ + MKL$(1183578594)
Bd$ = Bd$ + MKL$(-1949267202)
Bd$ = Bd$ + MKL$(-259327930)
Bd$ = Bd$ + MKL$(737955467)
Bd$ = Bd$ + MKL$(45367752)
Bd$ = Bd$ + MKL$(281935666)
Bd$ = Bd$ + MKL$(281872564)
Bd$ = Bd$ + MKL$(162793651)
Bd$ = Bd$ + MKL$(112977)
Bd$ = Bd$ + MKL$(-1023536947)
Bd$ = Bd$ + MKL$(-13499724)
Bd$ = Bd$ + MKL$(146018509)
Bd$ = Bd$ + MKL$(145952973)
Bd$ = Bd$ + MKL$(281872820)
Bd$ = Bd$ + MKL$(-20251047)
Bd$ = Bd$ + MKL$(-1949048122)
Bd$ = Bd$ + MKL$(281697765)
Bd$ = Bd$ + MKL$(0)
InitCode% = -1
END IF
DEF SEG = VARSEG(Bd$)
CALL ABSOLUTE(R0%, C0%, R1%, C1%, BAttr%, Btype%, WAttr%, Shadow%, SADD(Bd$))
DEF SEG
END SUB

REM $DYNAMIC
DEFSNG A-Z
FUNCTION GetMonSeg%
REM  BESKRIVNING
REM  H„mtar monitorns segment.
REM  Notera: Monokromt system returnerar &HB000
REM          F„rgsystem returnerar &HB800
REM  VARIABLER
REM  GetMonSeg% - Funktionsvariabel


DEF SEG = FALSE
IF (PEEK(&H410) AND &H30) = &H30 THEN
GetMonSeg% = &HB000
ELSE
GetMonSeg% = &HB800
END IF
DEF SEG
END FUNCTION

DEFINT A-Z
SUB MemSwap (DSeg1%, DOfs1%, DSeg2%, DOfs2%, Bytes%) STATIC
REM  Copying data between 2 existing areas
STATIC Tl$, InitCode
IF NOT InitCode THEN

Tl$ = Tl$ + MKL$(1458342741)
Tl$ = Tl$ + MKL$(-1962533289)
Tl$ = Tl$ + MKL$(931859550)
Tl$ = Tl$ + MKL$(-1911923061)
Tl$ = Tl$ + MKL$(140413703)
Tl$ = Tl$ + MKL$(1586184075)
Tl$ = Tl$ + MKL$(-1961915642)
Tl$ = Tl$ + MKL$(529403486)
Tl$ = Tl$ + MKL$(128250876)
Tl$ = Tl$ + MKL$(1566465823)
Tl$ = Tl$ + MKL$(2762)
Tl$ = Tl$ + MKL$(0)
Tl$ = Tl$ + MKL$(0)
Tl$ = Tl$ + MKL$(0)
InitCode = -1
END IF
DEF SEG = VARSEG(Tl$)
CALL ABSOLUTE(DSeg1%, DOfs1%, DSeg2%, DOfs2%, Bytes%, SADD(Tl$))
DEF SEG
END SUB

DEFSNG A-Z
SUB Meny STATIC
QPRINTRC STRING$(2000, 176), 1, 1, 9
IF NOT (Init%) THEN
DIM Bild$(9), Row%(9), Col%(9)
RESTORE MenyData
Test$ = CHR$(176) + CHR$(219) + CHR$(223)
FOR I% = 1 TO 9
READ M$
FOR J% = 1 TO 3
Old$ = MID$("015", J%, 1)
New$ = MID$(Test$, J%, 1)
Replace M$, Old$, New$
NEXT J%
Row%(I%) = I% + 1
Col%(I%) = (81 - LEN(M$)) / 2
Bild$(I%) = M$
NEXT I%
Init% = -1
FOR I% = 1 TO 9
QPRINTRC Bild$(I%), Row%(I%), Col%(I%), 9
NEXT I%
DrawBox 12, 6, 21, 75, 30, 3, 31, 1
QPRINTRC "[Demo of the Routines]", 12, 25, 12
RESTORE MenyText
READ Antal%
FOR I% = 1 TO Antal%
READ A$
QPRINTRC A$, I% + 12, 8, 31
NEXT I%
Tsave "PROGRAM.BLD", Ooops%
ELSE
TLoad "PROGRAM.BLD", Ooops%
END IF

END SUB

DEFINT A-Z
SUB QPRINTRC (Msg$, Row%, Col%, Attr%)

REM  DESCRIPTION
REM  Writing very fast to the SCREEN

REM  PARAMETERS
REM  Msg$  - Text on the SCREEN
REM  Row%  - Rext row
REM  Col%  - Starting column
REM  Attr% - Color attribute

IF LEN(Msg$) = 0 THEN EXIT SUB 'No empty messages
STATIC QP$, InitCode
IF NOT InitCode THEN ' InitCode = 0 (First time)
QP$ = QP$ + MKL$(1475119957)
QP$ = QP$ + MKL$(-1962519010)
QP$ = QP$ + MKL$(1066076254)
QP$ = QP$ + MKL$(173968207)
QP$ = QP$ + MKL$(-1958213749)
QP$ = QP$ + MKL$(260770910)
QP$ = QP$ + MKL$(2005618659)
QP$ = QP$ + MKL$(4242178)
QP$ = QP$ + MKL$(-148454514)
QP$ = QP$ + MKL$(50350630)
QP$ = QP$ + MKL$(-1192766984)
QP$ = QP$ + MKL$(-1960398848)
QP$ = QP$ + MKL$(-2097147874)
QP$ = QP$ + MKL$(-75288349)
QP$ = QP$ + MKL$(-1206356944)
QP$ = QP$ + MKL$(-1960396800)
QP$ = QP$ + MKL$(-2097126634)
QP$ = QP$ + MKL$(1586169538)
QP$ = QP$ + MKL$(-1910535418)
QP$ = QP$ + MKL$(2222272)
QP$ = QP$ + MKL$(646977515)
QP$ = QP$ + MKL$(6493835)
QP$ = QP$ + MKL$(-1962491261)
QP$ = QP$ + MKL$(529204830)
QP$ = QP$ + MKL$(648331406)
QP$ = QP$ + MKL$(-498655864)
QP$ = QP$ + MKL$(526256121)
QP$ = QP$ + MKL$(147479903)
QP$ = QP$ + MKL$(-1460864512)
QP$ = QP$ + MKL$(-319064831)
QP$ = QP$ + MKL$(-76283480)
QP$ = QP$ + MKL$(27847844)
QP$ = QP$ + MKL$(-1460864139)
QP$ = QP$ + MKL$(654013441)
QP$ = QP$ + MKL$(-498655864)
QP$ = QP$ + MKL$(12844005)
InitCode = -1
END IF
DEF SEG = VARSEG(QP$)
CALL ABSOLUTE(Msg$, Row%, Col%, Attr%, SADD(QP$))
DEF SEG
END SUB

REM $STATIC
DEFSNG A-Z
FUNCTION Randy% (Lowest%, Highest%) STATIC

REM Returnerar ett slumptal mellan de angivna polerna.

Randy% = INT(RND * ((Highest% - Lowest%) + 1)) + Lowest%
END FUNCTION

SUB Replace (Work$, Old$, New$)
FOR I% = 1 TO LEN(Work$)
IF MID$(Work$, I%, 1) = Old$ THEN
MID$(Work$, I%, 1) = New$
END IF
NEXT I%
END SUB

SUB TLoad (FileName$, Oops%)

REM  FUNKTION: Laddar in bin„rt sparade data till sk„rmen.
REM  SYNTAX:   TLoad Filnamn, Errcode

IF LEN(FileName$) = 0 THEN EXIT SUB
PictureString$ = SPACE$(4000)
OPEN FileName$ FOR BINARY AS #1
GET #1, , PictureString$
CLOSE #1
DSeg1% = VARSEG(PictureString$)
DOfs1% = SADD(PictureString$)
DSeg2% = GetMonSeg% 'Anropa en funktion
DOfs2% = 0
Bytes% = 4000
MemSwap DSeg1%, DOfs1%, DSeg2%, DOfs2%, Bytes%
PictureString$ = ""
END SUB

SUB Tsave (FileName$, Oops%)

REM  FUNKTION: Sparar sk„rmdata bin„rt.
REM  SYNTAX:   TSave Filnamn, Errcode

IF LEN(FileName$) = 0 THEN
Oops% = -1
EXIT SUB
END IF
PictureString$ = SPACE$(4000)
DSeg1% = VARSEG(PictureString$)
DOfs1% = SADD(PictureString$)

DSeg2% = GetMonSeg% 'Anropa en funktion
DOfs2% = 0

Bytes% = 4000
MemSwap DSeg2%, DOfs2%, DSeg1%, DOfs1%, Bytes%

OPEN FileName$ FOR BINARY AS #1
PUT #1, , PictureString$
CLOSE #1

PictureString$ = ""
END SUB