'##############################################################################################
'3D Grapher By Ashish Kushwaha
'----------------------------------------------------------------------------------------------
'* Thanks to STxAxTIC. Without his sxript, coding this would be harder.
'* Thanks to FellipeHeitor. His INPUTBOX() come handy when I need QB64 Input & OpenGL together.
'----------------------------------------------------------------------------------------------
'Description: Give an expression for z = ... containing terms of x, y (any power) & constants
'With the power of sxript, it also support *trigonometric functions* in the expression.
'Click on Ok. Then the Graph is plotted in 3D Space & shown in 2D screen.
'-----------------------------------------------------------------------------------------------
'Controls:
'* Drag on screen with mouse for rotation.
'* Mousewheel for zooming in or zooming out.
'* Right click to plot new graph.
'----------------------------------------------------------------------------------------------
'Friday the 13th March, 2020
'----------------------------------------------------------------------------------------------
'UPDATED : 16 March, 2020
'added sgn() signum and abs() absolute value function
'also added zooming feature and ability to plot new graph without running the app again.
'$INCLUDE:'sxript.bi'
DIM SHARED vert
(100, 100), glAllow
, xRot
, yRot
, colArr
(100, 100) AS rgb
, init
scaleFactor = 1.0
a$ = SxriptEval("func(abs,{unquote(quote([x])/`-')})") 'hack for abs() function by STxAxTIC
a$ = SxriptEval("func(sgn,{sub({let(a,[x]*1):print_iff([a]=0,{0},{iff(greater([a],0),{1},{-1})})})})") 'signum function by STxAxTIC
start:
dummy = INPUTBOX("Enter the expression for Z = ", "Enter the expression for Z = (ex. X*Y)", "X+Y-1", e$, -1)
' for i = 1 to len(e$)
' ca$ = mid$(e$,i,1)
' if lcase$(ca$) = "x" then ca$= "[x]"
' if lcase$(ca$) = "y" then ca$= "[y]"
' ex$ = ex$+ca$
' next
' a$ = SxriptEval("func(plot,{"+ex$+"})")
PRINT "Generating... Just a moment"
expression$ = ""
expression$ = expression$ + ca$
vert
(x
+ 50, z
+ 50) = VAL(SxriptEval
(expression$
)) 'replace x & y with actual numeric value & then evaluate with sxript. 'PRINT expression$, VAL(SxriptEval(expression$))
'SLEEP
IF init
= 0 THEN 'storage of color per vertex need not done again & again. c~& = hsb(map(z, -50, 50, 0, 255), 255, 128, 255)
colArr
(x
+ 50, z
+ 50).r
= _RED(c~&
) / 255 colArr
(x
+ 50, z
+ 50).g
= _GREEN(c~&
) / 255 colArr
(x
+ 50, z
+ 50).b
= _BLUE(c~&
) / 255
CLS , 1 'display the equation. glAllow = 1
init = 1
'SLEEP
IF scaleFactor
> 0.1 THEN 'to prevent negative value scaleFactor = 0.11 'so it's value can still be change.
yRot
= yRot
+ (_MOUSEX - x
) 'rotate by change glAllow = 0 'disbale GL rendering & clear screen.
GOTO start
'to take new input
_glClear _GL_COLOR_BUFFER_BIT
OR _GL_DEPTH_BUFFER_BIT
gluLookAt 0, 7, 15, 0, 0, 0, 0, 1, 0
_glScalef scaleFactor
, scaleFactor
, scaleFactor
'for zooming with mousewheel
'draw axis
'x-axis
'z-axis
'y-axis
'draw the surface according to stored height map evaluated before.
_glColor4f colArr
(x
+ 50, z
+ 50).r
, colArr
(x
+ 50, z
+ 50).g
, colArr
(x
+ 50, z
+ 50).b
, 0.7 _glVertex3f map
(x
, -50, 50, -5, 5), vert
(x
+ 50, z
+ 50), map
(z
, -50, 50, 5, -5) _glVertex3f map
(x
, -50, 50, -5, 5), vert
(x
+ 50, z
+ 51), map
(z
+ 1, -50, 50, 5, -5)
'By Fellipe Heitor
'INPUTBOX ---------------------------------------------------------------------
'Show a dialog and allow user input. Returns 1 = OK or 2 = Cancel. '
' '
'- tTitle$ is the desired dialog title. If not provided, it'll be "Input" '
' '
'- tMessage$ is the prompt that'll be shown to the user. You can show '
' a multiline message by adding line breaks with CHR$(10). '
' '
' - InitialValue can be passed both as a string literal or as a variable. '
' '
'- Actual user input is returned by altering NewValue, so it must be '
' passed as a variable. '
' '
'- Selected indicates wheter the initial value will be preselected when the '
' dialog is first shown. -1 preselects the whole text; positive values '
' select only part of the initial value (from the character position passed '
' to the end of the initial value). '
' '
'Intended for use with 32-bit screen modes. '
'------------------------------------------------------------------------------
'Variable declaration:
'Data type used for the dialog buttons:
'Color constants. You can customize colors by changing these:
'Initial variable setup:
Message$ = tMessage$
IF Title$
= "" THEN Title$
= "Input" DefaultButton = 1
'Save the current drawing page so it can be restored later:
'Figure out the print width of a single character (in case user has a custom font applied)
'Place a color overlay over the old screen image so the focus is on the dialog:
'Message breakdown, in case CHR$(10) was used as line break:
MaxLen = 1
lineBreak
= INSTR(lineBreak
+ 1, Message$
, CHR$(10)) totalLines = 1
MessageLines(1) = Message$
totalLines = totalLines + 1
MessageLines
(totalLines
) = RIGHT$(Message$
, LEN(Message$
) - prevlinebreak
+ 1) IF LEN(MessageLines
(totalLines
)) > MaxLen
THEN MaxLen
= LEN(MessageLines
(totalLines
)) IF totalLines
= 0 THEN prevlinebreak
= 1 totalLines = totalLines + 1
MessageLines
(totalLines
) = MID$(Message$
, prevlinebreak
, lineBreak
- prevlinebreak
) IF LEN(MessageLines
(totalLines
)) > MaxLen
THEN MaxLen
= LEN(MessageLines
(totalLines
)) prevlinebreak = lineBreak + 1
Selection.Start = 0
InputViewStart = 1
FieldArea
= _WIDTH \ CharW
- 4 IF FieldArea
> 62 THEN FieldArea
= 62 IF Selected
> 0 THEN Selection.Start
= Selected: Selected
= -1
'Calculate dialog dimensions and print coordinates:
DialogW = (CharW * FieldArea) + 10
IF DialogW
< MaxLen
* CharW
+ 10 THEN DialogW
= MaxLen
* CharW
+ 10
DialogX
= _WIDTH / 2 - DialogW
/ 2 DialogY
= _HEIGHT / 2 - DialogH
/ 2 InputField.X = (DialogX + (DialogW / 2)) - (((FieldArea * CharW) - 10) / 2) - 4
'Calculate button's print coordinates:
TotalButtons = 2
DIM Buttons
(1 TO TotalButtons
) AS BUTTONSTYPE
B = 1
Buttons(B).ID = 1: Buttons(B).CAPTION = "< OK >": B = B + 1
Buttons(B).ID = 2: Buttons(B).CAPTION = "< Cancel >": B = B + 1
ButtonLine$ = " "
FOR cb
= 1 TO TotalButtons
ButtonLine$
= ButtonLine$
+ RTRIM$(LTRIM$(Buttons
(cb
).CAPTION
)) + " " Buttons
(cb
).Y
= DialogY
+ 5 + _FONTHEIGHT * (5 + totalLines
) FOR cb
= 2 TO TotalButtons
'Main loop:
DIALOGRESULT = 0
'Draw the dialog.
LINE (DialogX
, DialogY
)-STEP(DialogW
- 1, DialogH
- 1), DialogBGColor
, BF
'Draw the input field
COLOR InputFieldTextColor
'Selection highlight:
'Cursor blink:
IF cursorBlink%
= 1 THEN cursorBlink%
= 0 ELSE cursorBlink%
= 1
'Check if buttons have been clicked or are being hovered:
'Draw buttons:
FOR cb
= 1 TO TotalButtons
'Process input:
IF k
= 100303 OR k
= 100304 THEN shiftDown
= -1 IF k
= -100303 OR k
= -100304 THEN shiftDown
= 0 IF k
= 100305 OR k
= 100306 THEN ctrlDown
= -1 IF k
= -100305 OR k
= -100306 THEN ctrlDown
= 0
CASE 13: DIALOGRESULT
= 1 CASE 27: DIALOGRESULT
= 2 CASE 32 TO 126 'Printable ASCII characters NewValue = NewValue + Clip$
NewValue
= LEFT$(NewValue
, Cursor
) + Clip$
+ MID$(NewValue
, Cursor
+ 1) Cursor
= Cursor
+ LEN(Clip$
) s1 = Selection.Start
s2 = Cursor
NewValue
= LEFT$(NewValue
, s1
) + Clip$
+ MID$(NewValue
, s2
+ 1) Selected = 0
k = 0
k = 0
k = 0
Selection.Start = 0
Selected = -1
k = 0
NewValue
= NewValue
+ CHR$(k
) Cursor = Cursor + 1
NewValue
= LEFT$(NewValue
, Cursor
) + CHR$(k
) + MID$(NewValue
, Cursor
+ 1) Cursor = Cursor + 1
IF Cursor
> FieldArea
THEN InputViewStart
= (Cursor
- FieldArea
) + 2 s1 = Selection.Start
s2 = Cursor
NewValue
= LEFT$(NewValue
, s1
) + CHR$(k
) + MID$(NewValue
, s2
+ 1) Selected = 0
Cursor = s1 + 1
NewValue
= LEFT$(NewValue
, LEN(NewValue
) - 1) Cursor = Cursor - 1
NewValue
= LEFT$(NewValue
, Cursor
- 1) + MID$(NewValue
, Cursor
+ 1) Cursor = Cursor - 1
NewValue
= RIGHT$(NewValue
, LEN(NewValue
) - 1) Cursor = Cursor - 1
NewValue
= RIGHT$(NewValue
, LEN(NewValue
) - 1) NewValue
= LEFT$(NewValue
, Cursor
) + MID$(NewValue
, Cursor
+ 2) CASE 19200 'Left arrow key IF Cursor
> 0 THEN Cursor
= Cursor
- 1 CASE 19712 'Right arrow key IF Cursor
< LEN(NewValue
) THEN Cursor
= Cursor
+ 1 Cursor = 0
'Cursor adjustments:
INPUTBOX = DIALOGRESULT
'Restore previous display:
CursorAdjustments:
IF Cursor
- InputViewStart
+ 2 > FieldArea
THEN InputViewStart
= (Cursor
- FieldArea
) + 2 IF Cursor
< InputViewStart
- 1 THEN InputViewStart
= Cursor
prevCursor = Cursor
IF InputViewStart
< 1 THEN InputViewStart
= 1
CheckSelection:
Selected = -1
Selection.Start = Cursor
Selected = 0
DeleteSelection:
NewValue
= LEFT$(NewValue
, s1
) + MID$(NewValue
, s2
+ 1) Selected = 0
Cursor = s1
SelectionHighlight:
s1 = Selection.Start
s2 = Cursor
ss1 = s1 - InputViewStart + 1
ss1 = s1
ss2 = s2 - s1
IF ss1
+ ss2
> FieldArea
THEN ss2
= FieldArea
- ss1
ss1 = s1
ss2 = s2 - s1
IF ss1
< InputViewStart
THEN ss1
= 0: ss2
= s2
- InputViewStart
+ 1 IF ss1
> InputViewStart
THEN ss1
= ss1
- InputViewStart
+ 1: ss2
= s2
- s1
Selection.Value$
= MID$(NewValue
, s1
+ 1, s2
- s1
)
CheckButtons:
'Hover highlight:
FOR cb
= 1 TO TotalButtons
IF (mx
>= Buttons
(cb
).X
) AND (mx
<= Buttons
(cb
).X
+ Buttons
(cb
).W
) THEN
'Clicking inside the text field positions the cursor
Cursor = ((mx - InputField.X) / CharW) + (InputViewStart - 1)
Selected = 0
FOR cb
= 1 TO TotalButtons
IF (mx
>= Buttons
(cb
).X
) AND (mx
<= Buttons
(cb
).X
+ Buttons
(cb
).W
) THEN DefaultButton = cb
IF nmx
= mx
AND nmy
= my
THEN DIALOGRESULT
= cb
'method adapted form http://stackoverflow.com/questions/4106363/converting-rgb-to-hsb-colors
H = map(__H, 0, 255, 0, 360)
S = map(__S, 0, 255, 0, 1)
B = map(__B, 0, 255, 0, 1)
hsb~&
= _RGBA32(B
* 255, B
* 255, B
* 255, A
)
fmx = B - (B * S) + S
fmn = B + (B * S) - S
fmx = B + (B * S)
fmn = B - (B * S)
H = H - 360
H = H / 60
H
= H
- (2 * INT(((iSextant
+ 1) MOD 6) / 2))
fmd = (H * (fmx - fmn)) + fmn
fmd = fmn - (H * (fmx - fmn))
FUNCTION map!
(value!
, minRange!
, maxRange!
, newMinRange!
, newMaxRange!
) map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
'$INCLUDE:'sxript.bm'
