The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 
 

 Return to Index  

Utility to convert TheBOBs programs to newer mouse routines

August 25 2016 at 1:51 PM
Simmons  (no login)

 
OPTION _EXPLICIT
CONST true = -1
CONST false = 0

DIM bobSignature AS INTEGER
DIM bobVars(1 TO 5) AS STRING
DIM file AS STRING
DIM outFile AS STRING
DIM codeLine AS STRING
DIM outLine AS STRING
DIM codeChar AS STRING * 1

DIM codePos AS INTEGER
DIM absStart AS INTEGER
DIM absEnd AS INTEGER
DIM remLoc AS INTEGER
DIM varNumber AS INTEGER
DIM bracketLevel AS INTEGER
DIM foundSignature AS INTEGER

bobSignature = 5


INPUT "Enter file to convert: ", file
DO UNTIL _FILEEXISTS(file)
PRINT "File: " + file + " not found"
INPUT "Enter file to convert: ", file
LOOP
INPUT "Enter output file name: ", outFile

OPEN file FOR INPUT AS #1
OPEN outFile FOR OUTPUT AS #2
WHILE NOT EOF(1)
LINE INPUT #1, codeLine
codeLine = formatLine$(codeLine, remLoc)
foundSignature = false
codePos = INSTR(codeLine, "CALL ABSOLUTE")
absStart = codePos
IF codePos > 0 AND (codePos < remLoc OR remLoc = 0) THEN
codePos = codePos + 13
codeChar = MID$(codeLine, codePos, 1)
IF codeChar = " " THEN
codePos = codePos + 1
codeChar = MID$(codeLine, codePos, 1)
END IF
IF codeChar <> "(" THEN
PRINT "Error: CALL ABSOLUTE mouse code has errors (missing left bracket)"
END
ELSE
bracketLevel = 1
varNumber = 1
DO
codePos = codePos + 1
codeChar = MID$(codeLine, codePos, 1)
IF codeChar = "(" THEN
bobVars(varNumber) = bobVars(varNumber) + "("
bracketLevel = bracketLevel + 1
ELSEIF codeChar = ")" THEN
IF bracketLevel > 1 THEN bobVars(varNumber) = bobVars(varNumber) + ")"
bracketLevel = bracketLevel - 1
ELSE
IF codeChar = "," AND bracketLevel = 1 THEN
varNumber = varNumber + 1
IF varNumber > bobSignature THEN
PRINT "Error: Unknown CALL ABSOLUTE mouse signature"
END
END IF

ELSE
bobVars(varNumber) = bobVars(varNumber) + codeChar
END IF
END IF
LOOP UNTIL bracketLevel = 0
absEnd = codePos
IF varNumber < bobSignature THEN
PRINT "Error: Unknown CALL ABSOLUTE mouse signature"
END
ELSE
foundSignature = true
END IF
END IF
END IF
IF foundSignature THEN
outLine = LEFT$(codeLine, absStart - 1)
outLine = outLine + "CALL ABSOLUTE_MOUSE_EMU (" + bobVars(1) + ", " + bobVars(2) + ", " + bobVars(3) + ", " + bobVars(4) + ") "
outLine = outLine + RIGHT$(codeLine, LEN(codeLine) - absEnd)
PRINT #2, outLine
ELSE
PRINT #2, codeLine
END IF
WEND

PRINT #2, " "

PRINT #2, "SUB ABSOLUTE_MOUSE_EMU (AX%, BX%, CX%, DX%)"
PRINT #2, "SELECT CASE AX%"
PRINT #2, " CASE 0"
PRINT #2, " AX% = -1"
PRINT #2, " CASE 1"
PRINT #2, " _MOUSESHOW "
PRINT #2, " CASE 2"
PRINT #2, " _MOUSEHIDE"
PRINT #2, " CASE 3"
PRINT #2, " WHILE _MOUSEINPUT"
PRINT #2, " WEND"
PRINT #2, " BX% = -_MOUSEBUTTON(1) - _MOUSEBUTTON(2) * 2 - _MOUSEBUTTON(3) * 4"
PRINT #2, " CX% = _MOUSEX"
PRINT #2, " DX% = _MOUSEY"
PRINT #2, " CASE 4"
PRINT #2, " _MOUSEMOVE CX%, DX% 'Not currently supported in QB64 GL"
PRINT #2, "END SELECT"
PRINT #2, "END SUB"

CLOSE #1
CLOSE #2

PRINT
PRINT "Conversion succesful!"
END


FUNCTION formatLine$ (text AS STRING, remarkLoc AS INTEGER)

DIM index AS INTEGER
DIM inQuote AS INTEGER
DIM bracketLevel AS INTEGER
DIM outWhite AS INTEGER
DIM outText AS STRING
DIM char AS STRING * 1

remarkLoc = 0
text = RTRIM$(text)
outWhite = false
inQuote = false
bracketLevel = 0
FOR index = 1 TO LEN(text) '- 1
char = MID$(text, index, 1)
IF char = CHR$(34) THEN
inQuote = NOT inQuote
outText = outText + CHR$(34)
ELSE
IF inQuote THEN
outText = outText + char
ELSE
IF char = "'" THEN
outText = outText + RIGHT$(text, LEN(text) - index + 1)
remarkLoc = index
EXIT FOR
ELSEIF UCASE$(char) = "R" THEN
IF LEN(text) - index > 2 THEN
IF UCASE$(MID$(text, index + 1, 1)) = "E" AND UCASE$(MID$(text, index + 2, 1)) = "M" THEN
outText = outText + RIGHT$(text, LEN(text) - index + 1)
remarkLoc = index
EXIT FOR
END IF
END IF
outText = outText + char
ELSEIF char = "(" THEN
bracketLevel = bracketLevel + 1
outText = outText + "("
ELSEIF char = ")" THEN
bracketLevel = bracketLevel - 1
outText = outText + ")"
ELSE
IF outWhite THEN
IF NOT (char = " " AND MID$(text, index + 1, 1) = " ") THEN
outText = outText + char
END IF
ELSE
IF char <> " " THEN
outWhite = true
END IF
outText = outText + char
END IF
END IF
END IF
END IF
NEXT index
formatLine$ = outText
END FUNCTION

 
 Respond to this message   
 Copyright © 1999-2018 Network54. All rights reserved.   Terms of Use   Privacy Statement  

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums