The QBasic Forum      Other Subforums, Links and Downloads
 
 Return to Index  

Line Grapher

September 17 2009 at 4:58 PM
  (Login DSMan195276)
R

This program takes a equation and values and plots the line it creates. the limits are:
1. since I have to translate the equation string into a math problem, it is read left to right. meaning no order of operations(this is not a huge deal, you can usually rewrite the equation a little to make it work correctly.
2. no parentheses support yet
3. the graph is a big 200 by 200 points, not the common 10 by 10.
4. can only plot functions, no horizontal lines or anything line that.

features:
plots line from user input. pretty easy to use after the first couple of uses. can save the graph to a bmp(uses forebit sub)

code:

DECLARE SUB forebit (x1%, y1%, x2%, y2%, filename$)
DECLARE SUB drawline (points() AS ANY, num!)
DECLARE FUNCTION gety! (equation$, x!, savenums!())
DECLARE SUB waiter (text$, num!)
DECLARE FUNCTION xywork! (equation$, x!, y!, savenums!())
TYPE xypoint
xpoint AS INTEGER
ypoint AS INTEGER
END TYPE

SCREEN 12
LOCATE 1, 1
PRINT SPACE$(50)
LOCATE 1, 1
PRINT "Please enter the equation to test"
LOCATE 2, 1
PRINT "Equation has to be in (Y =) format with only variables(no numbers)"
LOCATE 3, 1
PRINT "Use ( | ) to mark abslute value. EX. |-14|"
LOCATE 4, 1
PRINT "Mark square with 2 EX. 2X"
LOCATE 5, 1
PRINT "Example: Y = M * X + B"
LOCATE 1, 34
INPUT ""; equation$

LOCATE 7, 1
PRINT "Please enter the num of variables"
LOCATE 8, 1
PRINT "Do not add in X's as Y's as these will be calculated to make the line"
LOCATE 7, 34
INPUT ""; varnum
DIM savvars(varnum)
FOR k = 1 TO varnum
LET newstring$ = "Please enter value for variable number:" + STR$(k)
LOCATE 10, 1
PRINT SPACE$(50)
LOCATE 10, 1
PRINT newstring$
LOCATE 10, LEN(newstring$) + 2
INPUT ""; savvars(k)
NEXT k

CLS
ON ERROR GOTO equationerror
DIM points(2000) AS xypoint

LET k = TIMER
LET dots = 1
CALL waiter("Calculating line", dots)
LOCATE 4, 20
PRINT "Please wait, this could take some time."

FOR x = -200 TO 200
LET test = gety(equation$, x, savvars())
IF test >= -400 AND test <= 200 THEN
LET num = num + 1
LET points(num).xpoint = x
LET points(num).ypoint = test
END IF
IF TIMER - k > 1 THEN
LET k = TIMER
LET dots = dots + 1
IF dots = 4 THEN
dots = 0
END IF
CALL waiter("Calculating line", dots)
END IF
NEXT x
CLS
CALL drawline(points(), num)
LOCATE 3, 53
PRINT "Calculated Line"
LOCATE 5, 53
PRINT "Tic marks every 10 points"
LOCATE 6, 53
PRINT "Graph 400 by 400 points"
LOCATE 7, 53
PRINT "Save as BMP image(Y/N)?"
DO
LET a$ = INKEY$
LET a$ = UCASE$(a$)
LOOP UNTIL a$ = "Y" OR a$ = "N"
IF a$ = "Y" THEN
LOCATE 8, 53
PRINT "Filename?"
LOCATE 9, 53
LINE INPUT ""; filename$
IF UCASE$(RIGHT$(filename$, 4)) <> ".BMP" THEN
FOR x = 1 TO LEN(filename)
IF MID$(filename$, x, 1) = "." THEN
LET dotmark = x
EXIT FOR
END IF
NEXT x
IF dotmark > 0 THEN
LET filename$ = LEFT$(filename$, LEN(filename$) - dotmark) + ".BMP"
ELSE
LET filename$ = filename$ + ".BMP"
END IF
END IF
CLS
CALL drawline(points(), num)
LOCATE 20, 1
DIM variablemarks(LEN(equation$))
FOR x = 1 TO LEN(equation$)
IF MID$(equation$, x, 1) >= "a" AND MID$(equation$, x, 1) <= "z" OR MID$(equation$, x, 1) >= "A" AND MID$(equation$, x, 1) <= "Z" THEN
IF UCASE$(MID$(equation$, x, 1)) <> "X" AND UCASE$(MID$(equation$, x, 1)) <> "Y" THEN
LET variablemarks(x) = 1
END IF
END IF
NEXT x
LET num = varnum
FOR x = LEN(equation$) TO 1 STEP -1
IF variablemarks(x) = 1 THEN
LET equation$ = MID$(equation$, 1, x - 1) + RIGHT$(STR$(savvars(num)), LEN(STR$(savvars(num))) - 1) + MID$(equation$, x + 1, LEN(equation$))
LET num = num - 1
END IF
NEXT x
LOCATE 27, 27 - LEN(equation$) / 2
PRINT equation$
CALL forebit(1, 1, 400, 440, filename$)
END IF
END

equationerror:
CLS
LOCATE 2, 35
PRINT "ERROR"
LOCATE 3, 21
PRINT "Please check that the equation and"
LOCATE 4, 21
PRINT "number of variables are equal, and"
LOCATE 5, 21
PRINT "that the equation is typed right"
END

SUB drawline (points() AS xypoint, num)

LINE (1, 200)-(400, 200), 14
LINE (200, 1)-(200, 400), 14
LINE (1, 400)-(400, 400), 14
LINE (400, 1)-(400, 400), 14
LINE (1, 1)-(1, 400), 14
LINE (1, 1)-(400, 1), 14

FOR x = 1 TO 400
IF x / 10 = INT(x / 10) OR x = 1 THEN
LINE (x, 195)-(x, 205), 14
LINE (195, x)-(205, x), 14
END IF
NEXT x

FOR x = 2 TO num
'PSET (points(x).xpoint, points(x).ypoint), 2
LINE (points(x - 1).xpoint + 200, points(x - 1).ypoint + 200)-(points(x).xpoint + 200, points(x).ypoint + 200), 2
NEXT x

END SUB

SUB forebit (x1%, y1%, x2%, y2%, filename$)
'fullscreen takes about 8 seconds
'not my sub.

DIM FileCOLORS%(1 TO 48)
DIM Colors4%(0 TO 15)

IF INSTR(UCASE$(filename$), ".BMP") = 0 THEN
filename$ = RTRIM$(filename$) + ".BMP"
END IF

FileTYPE$ = "BM"
Reserved1% = 0
Reserved2% = 0
OffsetBITS& = 118
InfoHEADER& = 40
PictureWIDTH& = x2% - x1% + 1
PictureDEPTH& = y2% - y1% + 1
NumPLANES% = 1
BPP% = 4
Compression& = 0
WidthPELS& = 3780
DepthPELS& = 3780
NumCOLORS& = 16

IF PictureWIDTH& MOD 8 <> 0 THEN
ZeroPAD$ = SPACE$((8 - PictureWIDTH& MOD 8) \ 2)
END IF

ImageSIZE& = (((PictureWIDTH& + LEN(ZeroPAD$)) * PictureDEPTH&) + .1) / 2
FileSize& = ImageSIZE& + OffsetBITS&

OUT &H3C7, 0 'start at color 0
FOR n = 1 TO 48 STEP 3
FileCOLORS%(n) = INP(&H3C9)
FileCOLORS%(n + 1) = INP(&H3C9)
FileCOLORS%(n + 2) = INP(&H3C9)
NEXT n

OPEN filename$ FOR BINARY AS #1
'Header bytes
PUT #1, , FileTYPE$ '2 '1 to 2
PUT #1, , FileSize& '4
PUT #1, , Reserved1% 'should be zero '2
PUT #1, , Reserved2% 'should be zero '2
PUT #1, , OffsetBITS& '4
PUT #1, , InfoHEADER& '4
PUT #1, , PictureWIDTH& '4
PUT #1, , PictureDEPTH& '4
PUT #1, , NumPLANES% '2
PUT #1, , BPP% '2
PUT #1, , Compression& '4
PUT #1, , ImageSIZE& '4
PUT #1, , WidthPELS& '4
PUT #1, , DepthPELS& '4
PUT #1, , NumCOLORS& '4
PUT #1, , SigCOLORS& '4 '51 - 54

u$ = " " 'unused byte
FOR n% = 1 TO 46 STEP 3 'PUT as BGR order colors
Colr$ = CHR$(FileCOLORS%(n% + 2) * 4)
PUT #1, , Colr$
Colr$ = CHR$(FileCOLORS%(n% + 1) * 4)
PUT #1, , Colr$
Colr$ = CHR$(FileCOLORS%(n%) * 4)
PUT #1, , Colr$
PUT #1, , u$ 'add Unused byte
NEXT n%

FOR y = y2% TO y1% STEP -1 'Place from bottom up
FOR x = x1% TO x2% STEP 2 'nibble steps
HiX = POINT(x, y): Colors4%(HiX) = 1 'added here
LoX = POINT(x + 1, y): Colors4%(LoX) = 1
HiNIBBLE$ = HEX$(HiX)
LoNIBBLE$ = HEX$(LoX)
HexVAL$ = "&H" + HiNIBBLE$ + LoNIBBLE$
a$ = CHR$(VAL(HexVAL$))
PUT #1, , a$
NEXT x
PUT #1, , ZeroPAD$
NEXT y

FOR n = 0 TO 15
IF Colors4%(n) = 1 THEN SigCOLORS& = SigCOLORS& + 1
NEXT n
PUT #1, 51, SigCOLORS& 'new PUT

CLOSE #1

END SUB

FUNCTION gety (equation$, x, savenums())
'this function translates the string to a equation that it works out

LET savexvalue = x

DIM vars$(LEN(equation$))

FOR k = 1 TO LEN(equation$)
IF MID$(equation$, k, 1) > " " THEN
LET vars$(k) = MID$(equation$, k, 1)
END IF
LET num = num + 1
NEXT k

FOR k = 1 TO num
IF vars$(k) >= "a" AND vars$(k) <= "z" OR vars$(k) >= "A" AND vars$(k) <= "Z" THEN
LET varsneeded = varsneeded + 1
END IF
NEXT k

FOR k = 3 TO num
IF vars$(k) >= "a" AND vars$(k) <= "z" OR vars$(k) >= "A" AND vars$(k) <= "Z" THEN
'LET numvar = numvar + 1
IF variable1 <> 0 THEN
IF UCASE$(vars$(k)) <> "X" AND UCASE$(vars$(k)) <> "Y" THEN
LET numvar = numvar + 1
LET variable2 = savenums(numvar)
ELSEIF UCASE$(vars$(k)) = "X" THEN
LET variable2 = x
ELSEIF UCASE$(vars$(k)) = "Y" THEN
LET variable2 = y
END IF
IF squareflag = 1 THEN
LET variable2 = variable2 * variable2
LET squareflag = 0
END IF
IF opperations = 1 THEN
LET savevalue = variable1 + variable2
ELSEIF opperations = 2 THEN
LET savevalue = variable1 - variable2
ELSEIF opperations = 3 THEN
LET savevalue = variable1 * variable2
ELSE
LET savevalue = variable1 / variable2
END IF

LET variable1 = savevalue
ELSE
IF UCASE$(vars$(k)) <> "X" AND UCASE$(vars$(k)) <> "Y" THEN
LET numvar = numvar + 1
LET variable1 = savenums(numvar)
ELSEIF UCASE$(vars$(k)) = "X" THEN
LET variable1 = x
ELSEIF UCASE$(vars$(k)) = "Y" THEN
LET variable1 = y
END IF
IF squareflag = 1 THEN
LET variable1 = variable1 * variable1
LET squareflag = 0
END IF
END IF
ELSEIF vars$(k) = "+" THEN
LET opperations = 1
ELSEIF vars$(k) = "-" THEN
LET opperations = 2
ELSEIF vars$(k) = "*" THEN
LET opperations = 3
ELSEIF vars$(k) = "/" THEN
LET opperations = 4
ELSEIF vars$(k) = "|" THEN
IF absflag = 1 THEN
LET absflag = 0
LET abssave = ABS(variable1)
IF savopp = 1 THEN
LET variable1 = savvariable1 + abssave
ELSEIF savopp = 2 THEN
LET variable1 = savvariable1 - abssave
ELSEIF savopp = 3 THEN
LET variable1 = savvariable1 * abssave
ELSEIF savopp = 4 THEN
LET variable1 = savvariable1 / abssave
ELSE
LET variable1 = abssave
END IF
ELSE
LET savvariable1 = variable1
LET absflag = 1
LET variable1 = 0
LET savopp = opperations
END IF
ELSEIF vars$(k) = "2" THEN
LET squareflag = 1
END IF
NEXT k

LET x = savexvalue
LET gety = variable1 * -1
END FUNCTION

SUB waiter (text$, num)
LOCATE 2, 40 - LEN(text$) / 2, 0
PRINT text$ + SPACE$(4)
IF num = 1 THEN
LOCATE 2, 40 + LEN(text$) / 2
PRINT "."
ELSEIF num = 2 THEN
LOCATE 2, 40 + LEN(text$) / 2
PRINT ".."
ELSEIF num = 3 THEN
LOCATE 2, 40 + LEN(text$) / 2
PRINT "..."
END IF
END SUB

FUNCTION xywork (equation$, x, y, savenums())
'this function translates the string to a equation that it works out

DIM vars$(LEN(equation$))

FOR k = 1 TO LEN(equation$)
IF MID$(equation$, k, 1) > " " THEN
LET vars$(k) = MID$(equation$, k, 1)
END IF
LET num = num + 1
NEXT k

FOR k = 1 TO num
IF vars$(k) >= "a" AND vars$(k) <= "z" OR vars$(k) >= "A" AND vars$(k) <= "Z" THEN
LET varsneeded = varsneeded + 1
END IF
NEXT k

FOR k = 3 TO num
IF vars$(k) >= "a" AND vars$(k) <= "z" OR vars$(k) >= "A" AND vars$(k) <= "Z" THEN
'LET numvar = numvar + 1
IF variable1 > 0 THEN
IF UCASE$(vars$(k)) <> "X" AND UCASE$(vars$(k)) <> "Y" THEN
LET numvar = numvar + 1
LET variable2 = savenums(numvar)
ELSEIF UCASE$(vars$(k)) = "X" THEN
LET variable2 = x
ELSEIF UCASE$(vars$(k)) = "Y" THEN
LET variable2 = y
END IF
IF opperations = 1 THEN
LET savevalue = variable1 + variable2
ELSEIF opperations = 2 THEN
LET savevalue = variable1 - variable2
ELSEIF opperations = 3 THEN
LET savevalue = variable1 * variable2
ELSE
LET savevalue = variable1 / variable2
END IF
LET variable1 = savevalue
ELSE
IF UCASE$(vars$(k)) <> "X" AND UCASE$(vars$(k)) <> "Y" THEN
LET numvar = numvar + 1
LET variable1 = savenums(numvar)
ELSEIF UCASE$(vars$(k)) = "X" THEN
LET variable1 = x
ELSEIF UCASE$(vars$(k)) = "Y" THEN
LET variable1 = y
END IF
END IF
ELSEIF vars$(k) = "+" THEN
LET opperations = 1
ELSEIF vars$(k) = "-" THEN
LET opperations = 2
ELSEIF vars$(k) = "*" THEN
LET opperations = 3
ELSEIF vars$(k) = "/" THEN
LET opperatiosn = 4
END IF
NEXT k

IF y = variable1 THEN
LET xywork = 1
ELSE
LET xywork = 0
END IF
END FUNCTION

 
 Respond to this message   

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