okay here is the core of a code me and mysoft are making in Qbasic... it reads from a "database.txt" file that looks like this:
database.txt file:
Q:
hi
hello
A:
oh hello there, how are you?
hi, you always come here?
hey, do i know you?
Q:
bye
goodbye
A:
bye bye have a good day
thanks for chatting goodbye
D:
that is interesting
go on please
i'm listening go on
can you explain further?
and here is the main module "doctor.bas"
DECLARE FUNCTION ProcessInput$ (sText AS STRING)
DECLARE FUNCTION PrcessInput$ (sText AS STRING)
DECLARE SUB LoadDatabase ()
DECLARE SUB ShowAscii ()
DECLARE SUB LoadBMP (sFilename AS STRING, iWid AS INTEGER, iHei AS INTEGER)
REM $DYNAMIC
DEFSTR A-Z: DEFINT I: DEFLNG L: DEFSTR S: DEFSNG F: DEFDBL D
COMMON SHARED igNumQuestions AS INTEGER, igNumAnswers AS INTEGER
COMMON SHARED igNumDefaults AS INTEGER
COMMON SHARED sgQuestions() AS STRING, sgAnswers() AS STRING
COMMON SHARED sgDefaults() AS STRING
DIM iTemp AS INTEGER, iIndex AS INTEGER
SCREEN 12
'ShowAscii
'C9 = top/left 'BB = top/right
'BA = dbl vert 'CD = dbl horz
'B3 = sng vert 'C4 = sng horz
'C7 = left mid 'B6 = right mid
'C8 = bot/left 'BC = bot/right
CONST TL = &HC9, TR = &HBB
CONST VD = &HBA, HD = &HCD
CONST VS = &HB3, HS = &HC4
CONST LM = &HC7, RM = &HB6
CONST BL = &HC8, BR = &HBC
FOR iN = 0 TO 15: PALETTE iN, 0: NEXT iN 'turn all palette black
LoadBMP "doctor.bmp", iWid, iHei': iWid = 276: iHei = 128
lQWords = ((iWid * CLNG(iHei)) + 15) \ 15& + 1
REDIM SHARED dBmp(lQWords)
GET (0, 0)-(iWid - 1, iHei - 1), dBmp
'DEF SEG = VARSEG(dBmp(0))
'BSAVE "doctor.bmq", VARPTR(dBmp(0)), lQWords * 8&
'BLOAD "doctor.bmq", VARPTR(dBmp(0))
CLS
PRINT CHR$(TL); STRING$(78, HD); CHR$(TR);
FOR iN = 0 TO 8
PRINT CHR$(VD); STRING$(78, CHR$(28)); CHR$(VD);
NEXT iN
PRINT CHR$(BL); STRING$(78, HD); CHR$(BR);
LOCATE 6, 1: PRINT CHR$(LM); STRING$(78, HS); CHR$(RM);
PUT ((640 - iWid) \ 2, 22), dBmp(0), OR
COLOR 14
LOCATE 9, 4: PRINT "Mysoft & ron77"
LOCATE 7, 4: PRINT "BY"
LOCATE 2, 4: PRINT "DOCTOR STANISLAV"
LOCATE 4, 4: PRINT "VERSION 0.1"
COLOR 15
VIEW PRINT 12 TO 30
PRINT "Hello, i'm Doctor Stanislav. What i can do for you today? (type 'quit' to exit)"
LoadDatabase
'SLEEP
'PRINT "Questions: "; igNumQuestions
'FOR i = 0 TO igNumQuestions - 1
' iTemp = CVI(sgQuestions(i))
' PRINT , MID$(sgQuestions(i), 3), "Start:"; iTemp MOD 3000, "Num:"; iTemp \ 3000
'NEXT i
'PRINT "Answers..: "; igNumAnswers
'FOR i = 0 TO igNumAnswers - 1
' PRINT , sgAnswers(i)
'NEXT i
'PRINT "Defaults.: "; igNumDefaults
'FOR i = 0 TO igNumDefaults - 1
' PRINT , sgDefaults(i)
'NEXT i
RANDOMIZE TIMER
DIM sUserInput AS STRING
DO
COLOR 14
INPUT ">", sUserInput
COLOR 15
sReply = ProcessInput$(sUserInput)
PRINT sReply
LOOP UNTIL sUserInput = "quit"
REM $STATIC
SUB LoadDatabase
DIM sLine AS STRING, iType AS INTEGER
iFN = FREEFILE
ON LOCAL ERROR GOTO Failed 'enable manual error check
OPEN "database.txt" FOR INPUT AS #iFN
ON LOCAL ERROR GOTO 0 'disable custom error check
REDIM sgQuestions(15) AS STRING
REDIM sgAnswers(15) AS STRING
REDIM sgDefaults(15) AS STRING
igNumQuestions = 0: igNumAnswers = 0: igNumDefaults = 0
DIM iFirstQuestion AS INTEGER, iFirstAnswer AS INTEGER
DO
IF EOF(iFN) THEN sLine = "D:" ELSE LINE INPUT #iFN, sLine
'PRINT sLine: SLEEP
DO
IF sLine = "" THEN EXIT DO
IF sLine = "Q:" OR sLine = "A:" OR sLine = "D:" THEN
'after answers were added we set their location to the questions
IF iType = 2 THEN '2=answers
'PRINT sLine, iFirstAnswer, (igNumAnswers - iFirstAnswer)
sIQ = MKI$(iFirstAnswer + 3000 * (igNumAnswers - iFirstAnswer))
'pad the index and count of answers for each question
FOR i = iFirstQuestion TO igNumQuestions - 1
sgQuestions(i) = sIQ + sgQuestions(i)
NEXT i
END IF
SELECT CASE sLine
CASE "Q:"
iFirstQuestion = igNumQuestions 'first question of the group
iType = 1: EXIT DO 'now reading questions
CASE "A:"
iFirstAnswer = igNumAnswers 'first answer of the group
iType = 2: EXIT DO 'now reading answers
CASE "D:"
'if end of file then we loaded whole database
IF EOF(iFN) THEN
REDIM PRESERVE sgQuestions(igNumQuestions) AS STRING
REDIM PRESERVE sgAnswers(igNumAnswers) AS STRING
REDIM PRESERVE sgDefaults(igNumDefaults) AS STRING
CLOSE #iFN: EXIT SUB
END IF
iType = 3: EXIT DO 'now reading default answers
END SELECT
END IF
'adding question or answer
SELECT CASE iType
CASE 1 'add Question
IF (igNumQuestions AND 15) = 15 THEN 'reserve more 16 every 16
REDIM PRESERVE sgQuestions(igNumQuestions + 16) AS STRING
END IF
sgQuestions(igNumQuestions) = sLine
igNumQuestions = igNumQuestions + 1
CASE 2 'add Answer
IF (igNumAnswers AND 15) = 15 THEN 'reserve more 16 every 16
REDIM PRESERVE sgAnswers(igNumAnswers + 16) AS STRING
END IF
sgAnswers(igNumAnswers) = sLine
igNumAnswers = igNumAnswers + 1
CASE 3 'add Default Question
IF (igNumDefaults AND 15) = 15 THEN 'reserve more 16 every 16
REDIM PRESERVE sgDefaults(igNumDefaults + 16) AS STRING
END IF
sgDefaults(igNumDefaults) = sLine
igNumDefaults = igNumDefaults + 1
CASE ELSE: PRINT "Database error": EXIT SUB
END SELECT
EXIT DO
LOOP
LOOP
Failed:
PRINT "Failed to load database"
EXIT SUB
END SUB
FUNCTION ProcessInput$ (sText AS STRING)
DIM sOutputTemp AS STRING
DIM iRange AS INTEGER
iRange = 0
DIM iFlag AS INTEGER
iFlag = 0
FOR i = 0 TO igNumQuestions - 1
iPos = INSTR(sText, MID$(sgQuestions(i), 3))
IF iPos > 0 THEN
iRange = iRange + 1
iTemp = CVI(sgQuestions(i))
iIndex = (iTemp MOD 3000)
IF iRange > 5 THEN
iFlag = 1
EXIT FOR
END IF
sOutputTemp = sOutputTemp + " " + sgAnswers(iIndex + INT(RND * ((iTemp \ 3000))))
iFlag = 1
END IF
NEXT i
IF iFlag = 0 THEN
sOutputTemp = sgDefaults(INT(RND * (igNumDefaults)))
END IF
ProcessInput$ = sOutputTemp
END FUNCTION
SUB ShowAscii
COLOR 10: PRINT " 0 1 2 3 4 5 6 7 8 9 A B C D E F"
FOR iY = 128 TO 255 STEP 16
COLOR 10: PRINT HEX$(iY \ 16); " "; : COLOR 7
FOR iX = 0 TO 15
PRINT CHR$(iY + iX); " ";
NEXT iX
PRINT : PRINT
NEXT iY
SLEEP: END
END SUB
the chatbot has a bmp loadr module "bmpl.bas"
DECLARE SUB LoadBMP (sFilename AS STRING, iWid AS INTEGER, iHei AS INTEGER)
SUB info
'bmpinfosize - Is the size of the information header for the bitmap.
' Different bitmap versions have variations in filetypes.
' 40 is a standard windows 3.1 bitmap.
' 12 is for OS/2 bitmaps
'The next routine reads in the appropriate headers and colour tables.
'nbits is the number of bits per pixel - i.e. number of colours
'1 bit = 2 colours, 4 bits = 16 colours, 8 bits = 256 colours, etc.
'the 24 bit mode does not have a palette, its colours are expressed as
'image data
'Design of a windows 3.1 bitmap - Taken from bmp.txt on the
'x2ftp.oulu.fi ftp site under /pub/msdos/programming/formats
'Specifications for a Windows 3.1 bitmap. (.BMP)
'Email any questions/responses to me at zabudsk@ecf.utoronto.ca
'or post to alt.lang.basic or comp.lang.basic.misc.
' | # of |
'Offset | bytes | Function (value)
'-------+--------+--- General Picture information starts here---------
' 0 | 2 | (BM) - Tells us that the picture is in bmp format
' 2 | 4 | Size of the file (without header?)
' 6 | 2 | (0) Reserved1 - Must be zero
' 8 | 2 | (0) Reserved2 - Must be zero
' 10 | 4 | Number of bytes offset of the picture data
'-------+--------+--- Information Header starts here -----------------
' 14 | 4 | (40/12) Size of information header (Win3.1/OS2)
' 18 | 4 | Picture width in pixels
' 22 | 4 | Picture Height in pixels
' 26 | 2 | (1) Number of planes, must be 1
' 28 | 2 | Number of bits per pixel (bpp), must be 1,4,8 or 24
' 30 | 4 | (0) Compression - 0 means no compression, 1,2 are RLEs
' 34 | 4 | Image size in bytes
' 38 | 4 | picture width in pels per metre
' 42 | 4 | picture height in pels per metre
' 46 | 4 | (0) Number of colours used in the picture, 0 means all
' 50 | 4 | (0) Number of important colours, 0 means all
'-------+--------+--- Palette data starts here -----------------------
' 54 | 1 | (b) - blue intensity component, color 0 - range 0 to 255
' 55 | 1 | (g) - green intensity component, color 0 - range 0 to 255
' 56 | 1 | (r) - red intensity component, color 0 - range 0 to 255
' 57 | 1 | (0) - unused
' 58 | 1 | (b) - blue intensity component, color 0 - range 0 to 255
' ... | ... |
' 54 | 4*2^bpp| total range of palette
'-------+--------+--- Image data starts here -------------------------
'54+ | width* | Bitmap data starting at lower left portion of the
'(4*2^n)| height*| image moving from left towards right. Moving up 1
' | (8/bpp)| pixel when at the right hand side of the image, starting
' | | from the left side again, until the top right of the
' | | image is reached
'Note that this format is slightly different for a OS/2 Bitmap.
'The header is the same up to (but not including) bit 30-
'The palette colour values follow at bit 30, with the form...
'1 byte blue intensity
'1 byte green intensity
'1 byte red intensity
'For each colour of the picture.
'Bitmapped image data follows the colour tables
'Special note: When storing 1 bit (2 colour) pictures.
'8 horizontal pixels are packed into 1 byte. Each bit determines
'the colour of one pixel (colour 0 or colour 1)
'4 bit pictures (16 colours) use 2 nibbles (4 bits) for each pixel
'thus there are 2 pixels for each byte of image data.
'8 bit pictures use 1 byte per pixel. Each byte of image data
'represents one of 256 colours.
'24 bit pictures express colour values by using 3 bytes and each has a
'value between 0 and 255. The first byte is for red, the second is for
'green and the third is for blue. Thus (256)^3 or 2^24 of 16777216 different
'colours.
'Even more special note:
'each line of bitmap images have a long word integer boundary;
'this means that at the end of each line, there may be extra "padding"
'bytes to ensure that the actual amount of data encoded with each line
'is encoded to be a multiple of 4 bytes (the size of a long word).
END SUB
DEFINT A-Z
SUB LoadBMP (sFilename AS STRING, iWid AS INTEGER, iHei AS INTEGER)
DIM xstart, xsiz, ystart, ysiz AS INTEGER
CONST xmax = 320, ymax = 200
CONST va = &H3C8, vd = &H3C9
DEF SEG = 0: iWid = -1: iHei = -1
'settings (0=false or 1=true)
dither = 0: grey = 0: slowpal = 0
filename$ = sFilename
IF INSTR(filename$, ".") = 0 THEN filename$ = filename$ + ".BMP"
iFN = FREEFILE: iSuccess = 0
ON LOCAL ERROR GOTO Failed:
OPEN filename$ FOR INPUT AS #iFN
CLOSE #iFN: iSuccess = 1
Failed:
IF iSuccess = 0 THEN
PRINT "Failed to open '" + filename$ + "'"
EXIT SUB
END IF
OPEN filename$ FOR BINARY AS #iFN
header$ = SPACE$(14): sizing$ = SPACE$(4)
GET #iFN, 1, header$
IF LEN(header$) = 0 THEN PRINT "Not a valid Bitmap file.": CLOSE #iFN: EXIT SUB
IF MID$(header$, 1, 2) <> "BM" THEN PRINT "Not a valid Bitmap file.": CLOSE #iFN: EXIT SUB
GET #iFN, 15, sizing$
bmpinfosize = CVI(sizing$)
IF bmpinfosize = 12 THEN
infoheader$ = SPACE$(12)
GET #iFN, 15, infoheader$
nBits = CVI(MID$(infoheader$, 15, 4))
SELECT CASE nBits
CASE 1: palet$ = SPACE$(6)
CASE 4: palet$ = SPACE$(48)
CASE 8: palet$ = SPACE$(768)
CASE ELSE:
PRINT "Unsupported Color bits: "; nBits
CLOSE #iFN: EXIT SUB
END SELECT
GET #iFN, bmpinfosize + 15, palet$
ELSEIF bmpinfosize = 40 THEN
infoheader$ = SPACE$(40)
GET #iFN, 15, infoheader$
nBits = CVI(MID$(infoheader$, 15, 4))
SELECT CASE nBits
CASE 1: palet$ = SPACE$(8)
CASE 4: palet$ = SPACE$(64)
CASE 8: palet$ = SPACE$(1024)
CASE ELSE:
PRINT "Unsupported Color bits: "; nBits
CLOSE #iFN: EXIT SUB
END SELECT
GET #iFN, bmpinfosize + 15, palet$
END IF
ft$ = MID$(header$, 1, 2)
'PRINT "Type of file (Should be BM): "; ft$
filesize& = CVL(MID$(header$, 3, 4))
'PRINT "Size of file: "; filesize&
r1 = CVI(MID$(header$, 7, 2))
'PRINT "Reserved 1: "; r1
r2 = CVI(MID$(header$, 9, 2))
'PRINT "Reserved 2: "; r2
offset& = CVL(MID$(header$, 11, 4))
'PRINT "Number of bytes offset from beginning: "; offset&
'PRINT
headersize& = CVL(MID$(infoheader$, 1, 4))
'PRINT "Size of header: "; headersize&
picwidth = CVL(MID$(infoheader$, 5, 4))
'PRINT "Width: "; picwidth
picheight = CVL(MID$(infoheader$, 9, 4))
'PRINT "Height: "; picheight
nplanes = CVI(MID$(infoheader$, 13, 4))
'PRINT "Planes: "; nplanes
'PRINT "Bits per plane: "; nBits
'PRINT
IF headersize& = 40 THEN
'PRINT "Compression: ";
comptype = CVL(MID$(infoheader$, 17, 4))
'IF comptype = 0 THEN PRINT "None"
IF comptype = 1 THEN PRINT "Run Length - 8 Bits"
IF comptype = 2 THEN PRINT "Run Length - 4 Bits"
imagesize& = CVL(MID$(infoheader$, 21, 4))
'PRINT "Image Size (bytes): "; imagesize&
xsize = CVL(MID$(infoheader$, 25, 4))
'PRINT "X size (pixels per metre): "; xsize
ysize = CVL(MID$(infoheader$, 29, 4))
'PRINT "Y size (pixels per metre): "; ysize
colorsused = CVL(MID$(infoheader$, 33, 4))
'PRINT "Number of colours used: "; colorsused
neededcolours = CVL(MID$(infoheader$, 37, 4))
'PRINT "Number of important colours: "; neededcolours
IF colorsused <> 0 THEN
palet$ = SPACE$(4 * colorsused)
GET #iFN, bmpinfosize + 15, palet$
END IF
END IF
'PRINT : PRINT "Press Any key to continue."
'WHILE INKEY$ = "": WEND
'display picture -------------------------------------------------
IF nBits = 1 THEN
'SCREEN 11
xres = 640: yres = 480: nc = 2
ELSEIF nBits = 4 THEN
'SCREEN 12
'xres = 640: yres = 480: nc = 16
ELSEIF nBits = 8 OR nBits = 24 THEN
'SCREEN 13
xres = 320: yres = 200: nc = 256
END IF
IF bmpinfosize = 40 THEN ngroups = 4
IF bmpinfosize = 12 THEN ngroups = 3
IF nBits = 24 THEN
IF grey = 1 THEN
IF ngroups = 3 THEN
FOR c = 0 TO 63
d = c * 4
palet$ = palet$ + CHR$(d) + CHR$(d) + CHR$(d)
palet$ = palet$ + CHR$(d) + CHR$(d) + CHR$(d + 1)
palet$ = palet$ + CHR$(d) + CHR$(d + 1) + CHR$(d)
palet$ = palet$ + CHR$(d + 1) + CHR$(d) + CHR$(d)
NEXT c
ELSEIF ngroups = 4 THEN
FOR c = 0 TO 63
d = c * 4
palet$ = palet$ + CHR$(d) + CHR$(d) + CHR$(d) + CHR$(0)
palet$ = palet$ + CHR$(d) + CHR$(d) + CHR$(d + 1) + CHR$(0)
palet$ = palet$ + CHR$(d) + CHR$(d + 1) + CHR$(d) + CHR$(0)
palet$ = palet$ + CHR$(d + 1) + CHR$(d) + CHR$(d) + CHR$(0)
NEXT c
END IF
ELSE
FOR t = 0 TO 5
FOR u = 0 TO 5
FOR v = 0 TO 5
palet$ = palet$ + CHR$(INT(v * (256 / 6)))
palet$ = palet$ + CHR$(INT(u * (256 / 6)))
palet$ = palet$ + CHR$(INT(t * (256 / 6)))
IF ngroups = 4 THEN palet$ = palet$ + CHR$(0)
NEXT v
NEXT u
NEXT t
FOR count = 0 TO 31
palet$ = palet$ + CHR$(count * 8) + CHR$(count * 8) + CHR$(count * 8)
IF ngroups = 4 THEN palet$ = palet$ + CHR$(0)
NEXT count
palet$ = palet$ + CHR$(255) + CHR$(255) + CHR$(255)
END IF
END IF
IF comptype = 0 THEN
'No Compression
IF nBits = 24 THEN
y = picheight - 1: x = 0
Lin$ = SPACE$((INT((3 * picwidth - 1) / 4) + 1) * 4)
WHILE y >= 0
GET #iFN, , Lin$
IF grey = 0 THEN
'WHILE x < picwidth
WHILE x < xmax AND y < ymax
b = ASC(MID$(Lin$, x * 3 + 1, 1))
g = ASC(MID$(Lin$, x * 3 + 2, 1))
r = ASC(MID$(Lin$, x * 3 + 3, 1))
IF b = g AND g = r THEN
p1 = INT(b / 8) + 216
IF b = 255 THEN p1 = 247
ELSE
r = INT(r * (6 / 256))
g = INT(g * (6 / 256))
b = INT(b * (6 / 256))
IF dither THEN
qa = INT(RND(1) * (r + 1)) * .4
qb = INT(RND(1) * (g + 1)) * .4
qc = INT(RND(1) * (b + 1)) * .4
r = INT(r + qa - (r * .2))
g = INT(g + qg - (g * .2))
b = INT(b + qb - (b * .2))
IF r > 5 THEN r = 5
IF r < 0 THEN r = 0
IF g > 5 THEN g = 5
IF g < 0 THEN g = 0
IF b > 5 THEN b = 5
IF b < 0 THEN b = 0
END IF
p1 = r * 36 + g * 6 + b
END IF
PSET (x, y), p1
x = x + 1
WEND
ELSE
'WHILE x < picwidth
WHILE x < xmax AND y < ymax
p1 = INT((ASC(MID$(Lin$, x * 3 + 1, 1)) + ASC(MID$(Lin$, x * 3 + 2, 1)) + ASC(MID$(Lin$, x * 3 + 3, 1))) / 3)
PSET (x, y), p1
x = x + 1
WEND
END IF
y = y - 1
x = 0
WEND
ELSEIF nBits = 8 THEN
y = picheight - 1
x = 0
Lin$ = SPACE$((INT((picwidth - 1) / 4) + 1) * 4)
WHILE y >= 0
GET #iFN, , Lin$
WHILE x < picwidth
PSET (x, y), ASC(MID$(Lin$, x + 1, 1))
x = x + 1
WEND
y = y - 1
x = 0
WEND
ELSEIF nBits = 4 THEN
y = picheight - 1
x = 0
Lin$ = SPACE$((INT((picwidth - 1) / 8) + 1) * 4)
WHILE y >= 0
GET #iFN, , Lin$
WHILE x < picwidth
p2 = ASC(MID$(Lin$, INT(x / 2) + 1, 1)) AND 15
p1 = (ASC(MID$(Lin$, INT(x / 2) + 1, 1)) AND 240) / 16
PSET (x, y), p1
IF x + 1 < picwidth THEN PSET (x + 1, y), p2
x = x + 2
WEND
y = y - 1
x = 0
WEND
ELSEIF nBits = 1 THEN
y = picheight - 1
x = 0
Lin$ = SPACE$((INT((picwidth - 1) / 32) + 1) * 4)
WHILE y >= 0
GET #iFN, , Lin$
WHILE x < picwidth
p8 = ASC(MID$(Lin$, INT(x / 8) + 1, 1))
FOR b = 0 TO 7
IF x + (7 - b) < picwidth THEN PSET (x + (7 - b), y), (p8 AND 2 ^ b) / 2 ^ b
NEXT b
x = x + 8
WEND
y = y - 1
x = 0
WEND
END IF
ELSEIF comptype = 1 THEN
'Compression Essentials
'[a][b] a>0, repeat b a-times
'[0][0] End of line
'[0][1] End of bitmap
'[0][2][h][v] Move current position h to the right and v down
'PRINT "Wow! RLE-8 Compression."
a$ = " ": x = 0: y = 0: ef = 0
WHILE ef = 0
GET #iFN, , a$
c = ASC(a$)
IF c > 0 THEN
GET #iFN, , a$
b = ASC(a$)
FOR count = 1 TO c
PSET (picwidth - x - 1, picheight - y - 1), b
x = x + 1
'if x>=picwidth then x=0:y=y+1
NEXT count
ELSE
GET #iFN, , a$
c = ASC(a$)
IF c = 0 THEN
x = 0: y = y + 1
ELSEIF c = 1 THEN
ef = 1
ELSEIF c = 2 THEN
GET #iFN, , a$
h = ASC(a$)
GET #iFN, , a$
v = ASC(a$): x = x + h: y = y + v
ELSE
FOR count = 1 TO c
GET #iFN, , a$
p1 = ASC(a$)
PSET (picwidth - x - 1, picheight - y - 1), p1
x = x + 1
'if x>=picwidth then x=0:y=y+1
NEXT count
IF c MOD 2 = 1 THEN GET #iFN, , a$
END IF
IF (y = picheight - 1 AND x >= picwidth) OR y >= picheight THEN ef = 1
END IF
IF EOF(1) THEN ef = 1
WEND
ELSEIF comptype = 2 THEN
'Compression Essentials
'[a][b1|b0] a>0, repeat b1|b0 a/2-times e.g. a=5 -> b1 b0 b1 b0 b1
'[0][0] End of line
'[0][1] End of bitmap
'[0][2][h][v] Move current position h to the right and v down
'PRINT "Wow! RLE-4 Compression."
a$ = " ": x = 0: y = 0: ef = 0
WHILE ef = 0
GET #iFN, , a$
c = ASC(a$)
IF c > 0 THEN
GET #iFN, , a$
b = ASC(a$)
FOR count = 1 TO c
IF (count MOD 2) = 0 THEN
PSET (picwidth - x - 1, picheight - y - 1), b AND 15
ELSE
PSET (picwidth - x - 1, picheight - y - 1), (b AND 240) / 16
END IF
x = x + 1
'if x>=picwidth then x=0:y=y+1
NEXT count
ELSE
GET #iFN, , a$
c = ASC(a$)
IF c = 0 THEN
x = 0: y = y + 1
ELSEIF c = 1 THEN
ef = 1
ELSEIF c = 2 THEN
GET #iFN, , a$
h = ASC(a$)
GET #iFN, , a$
v = ASC(a$): x = x + h: y = y + v
ELSE
FOR count = 1 TO INT(c / 2)
GET #iFN, , a$
p1 = ASC(a$)
PSET (picwidth - x - 1, picheight - y - 1), (p1 AND 240) / 16
x = x + 1
PSET (picwidth - x - 1, picheight - y - 1), p1 AND 15
x = x + 1
'if x>=picwidth then x=0:y=y+1
NEXT count
br = INT(c / 2)
IF (c MOD 2) = 1 THEN
GET #iFN, , a$
PSET (picwidth - x - 1, picheight - y - 1), (p1 AND 240) / 16
x = x + 1
br = br + 1
END IF
IF br MOD 2 = 1 THEN GET #iFN, , a$
END IF
IF (y = picheight - 1 AND x >= picwidth) OR y >= picheight THEN ef = 1
END IF
IF EOF(1) THEN ef = 1
WEND
END IF
CLOSE #iFN
IF slowpal = 1 THEN
FOR x = 1 TO LEN(palet$) STEP ngroups
zb# = INT((ASC(MID$(palet$, x, 1))) / 4)
zg# = INT((ASC(MID$(palet$, x + 1, 1))) / 4)
zr# = INT((ASC(MID$(palet$, x + 2, 1))) / 4)
zc# = zb# * 65536# + zg# * 256# + zr#
' cres = ASC(MID$(palet$, x + 3, 1))
PALETTE ((x - 1) / ngroups), zc#
NEXT x
ELSE 'Use VGA Palette I/O Registers to set palette values - Faster
OUT va, 0
FOR x = 1 TO LEN(palet$) STEP ngroups
zb = INT((ASC(MID$(palet$, x, 1))) / 4)
zg = INT((ASC(MID$(palet$, x + 1, 1))) / 4)
zr = INT((ASC(MID$(palet$, x + 2, 1))) / 4)
' zc# = zb# * 65536# + zg# * 256# + zr#
' cres = ASC(MID$(palet$, x + 3, 1))
OUT vd, zr: OUT vd, zg: OUT vd, zb
'PALETTE ((x - 1) / ngroups), zc#
NEXT x
END IF
iWid = picwidth: iHei = picheight
END SUB
here is how the chatbot looks like (screen 12)
doctor1-sshot.png
Ok, more improvement to the chatbot. Now there is a TTS added (TRAN.EXE), which sounds horrible but can be switched off by typing "--s" and it will shut it off and make the bot silent - mysoft is working on another option for a better TTS plus, we added a better bmp or bmq file uploader which is faster - the database needs to be worked on more to add more questions and answers (keywords and replies) and not just for testing - remember in this kind of chatbots in Qbasic what makes the chatbot good at conversations is the database more than the actual code.
Attached to a zip file are all the source codes and executable (DOCTOR.EXE) the database file and the TRAN.EXE TTS cli engine...
stan2.zip
ron77