Author Topic: 3D Graph Plotter  (Read 7481 times)

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
3D Graph Plotter
« on: March 13, 2020, 07:02:50 am »
Hi everyone!
This program input the expression for Z =  something and plot the graph in 3D "something" consist of terms having X and Z variables or constant. For example X+Y or X+Y*5 + 10, etc. It even support trigonometric functions.

Thanks to @STxAxTIC and @FellippeHeitor

Controls : Click & Drag on screen with mouse for rotation.

Note : You need to download additional sxript.bi & sxript.bm from attachment.

EDIT: Code updated. Now, it accept expression for Z = ... which is generally accepted.
Code: QB64: [Select]
  1. '##############################################################################################
  2. '3D Grapher By Ashish Kushwaha
  3. '----------------------------------------------------------------------------------------------
  4. '* Thanks to STxAxTIC. Without his sxript, coding this would be harder.
  5. '* Thanks to FellipeHeitor. His INPUTBOX() come handy when I need QB64 Input & OpenGL together.
  6. '----------------------------------------------------------------------------------------------
  7. 'Description: Give an expression for z = ... containing terms of x, y (any power) & constants
  8. 'With the power of sxript, it also support *trigonometric functions* in the expression.
  9. 'Click on Ok. Then the Graph is plotted in 3D Space & shown in 2D screen.
  10. 'Drag on screen with mouse for rotation.
  11. '----------------------------------------------------------------------------------------------
  12. 'Friday the 13th, 2020
  13.  
  14. '$INCLUDE:'sxript.bi'
  15.  
  16.     SUB gluLookAt (BYVAL eyeX#, BYVAL eyeY#, BYVAL eyeZ#, BYVAL centerX#, BYVAL centerY#, BYVAL centerZ#, BYVAL upX#, BYVAL upY#, BYVAL upZ#)
  17.  
  18.  
  19. _TITLE "3D Grapher"
  20. SCREEN _NEWIMAGE(600, 600, 32)
  21.  
  22. dummy = INPUTBOX("Enter the expression for Z = ", "Enter the expression for Z = (ex. X*Y)", "X+Y-1", e$, -1)
  23. IF dummy = 2 THEN SYSTEM
  24. PRINT "Generating... Just a moment"
  25. TYPE rgb
  26.     r AS SINGLE
  27.     g AS SINGLE
  28.     b AS SINGLE
  29. DIM SHARED vert(100, 100), glAllow, xRot, yRot, colArr(100, 100) AS rgb
  30.  
  31. FOR x = -50 TO 50
  32.     FOR z = -50 TO 50
  33.         expression$ = ""
  34.         FOR i = 1 TO LEN(e$)
  35.             ca$ = MID$(e$, i, 1)
  36.             IF LCASE$(ca$) = "x" THEN ca$ = _TRIM$(STR$(x / 10))
  37.             IF LCASE$(ca$) = "y" THEN ca$ = _TRIM$(STR$(z / 10))
  38.             expression$ = expression$ + ca$
  39.         NEXT
  40.         vert(x + 50, z + 50) = VAL(SxriptEval(expression$))
  41.         'PRINT expression$, VAL(SxriptEval(expression$))
  42.         'SLEEP
  43.         c~& = hsb(map(z, -50, 50, 0, 255), 255, 128, 255)
  44.         colArr(x + 50, z + 50).r = _RED(c~&) / 255
  45.         colArr(x + 50, z + 50).g = _GREEN(c~&) / 255
  46.         colArr(x + 50, z + 50).b = _BLUE(c~&) / 255
  47.     NEXT
  48. glAllow = 1
  49. 'SLEEP
  50.         x = _MOUSEX: y = _MOUSEY
  51.         WHILE _MOUSEBUTTON(1)
  52.             WHILE _MOUSEINPUT: WEND
  53.             yRot = yRot + (_MOUSEX - x)
  54.             xRot = xRot + (_MOUSEY - y)
  55.             x = _MOUSEX: y = _MOUSEY
  56.         WEND
  57.     END IF
  58.     _LIMIT 60
  59.  
  60. SUB _GL () STATIC
  61.     IF glAllow = 0 THEN EXIT SUB
  62.  
  63.     _glClear _GL_COLOR_BUFFER_BIT OR _GL_DEPTH_BUFFER_BIT
  64.     _glEnable _GL_DEPTH_TEST
  65.     _glEnable _GL_BLEND
  66.  
  67.  
  68.     _glMatrixMode _GL_PROJECTION
  69.     _gluPerspective 50, 1, 0.1, 40
  70.  
  71.     _glMatrixMode _GL_MODELVIEW
  72.  
  73.     gluLookAt 0, 7, 15, 0, 0, 0, 0, 1, 0
  74.     _glRotatef xRot, 1, 0, 0
  75.     _glRotatef yRot, 0, 1, 0
  76.     _glLineWidth 2.0
  77.     'draw axis
  78.     _glBegin _GL_LINES
  79.     'x-axis
  80.     _glColor3f 1, 0, 0
  81.     _glVertex3f -5, 0, 0
  82.     _glVertex3f 5, 0, 0
  83.     'z-axis
  84.     _glColor3f 0, 1, 0
  85.     _glVertex3f 0, -5, 0
  86.     _glVertex3f 0, 5, 0
  87.     'y-axis
  88.     _glColor3f 0, 0, 1
  89.     _glVertex3f 0, 0, -5
  90.     _glVertex3f 0, 0, 5
  91.  
  92.     _glEnd
  93.     _glColor3f 1, 1, 1
  94.     _glLineWidth 1.0
  95.     FOR z = -50 TO 49
  96.         _glBegin _GL_TRIANGLE_STRIP
  97.         FOR x = -50 TO 50
  98.             _glColor4f colArr(x + 50, z + 50).r, colArr(x + 50, z + 50).g, colArr(x + 50, z + 50).b, 0.7
  99.             _glVertex3f map(x, -50, 50, -5, 5), vert(x + 50, z + 50), map(z, -50, 50, 5, -5)
  100.             _glVertex3f map(x, -50, 50, -5, 5), vert(x + 50, z + 51), map(z + 1, -50, 50, 5, -5)
  101.         NEXT
  102.         _glEnd
  103.     NEXT
  104.  
  105.  
  106.  
  107. 'By Fellipe Heitor
  108. FUNCTION INPUTBOX (tTitle$, tMessage$, InitialValue AS STRING, NewValue AS STRING, Selected)
  109.     'INPUTBOX ---------------------------------------------------------------------
  110.     'Show a dialog and allow user input. Returns 1 = OK or 2 = Cancel.            '
  111.     '                                                                             '
  112.     '- tTitle$ is the desired dialog title. If not provided, it'll be "Input"     '
  113.     '                                                                             '
  114.     '- tMessage$ is the prompt that'll be shown to the user. You can show         '
  115.     '   a multiline message by adding line breaks with CHR$(10).                  '
  116.     '                                                                             '
  117.     ' - InitialValue can be passed both as a string literal or as a variable.     '
  118.     '                                                                             '
  119.     '- Actual user input is returned by altering NewValue, so it must be          '
  120.     '   passed as a variable.                                                     '
  121.     '                                                                             '
  122.     '- Selected indicates wheter the initial value will be preselected when the   '
  123.     '   dialog is first shown. -1 preselects the whole text; positive values      '
  124.     '   select only part of the initial value (from the character position passed '
  125.     '   to the end of the initial value).                                         '
  126.     '                                                                             '
  127.     'Intended for use with 32-bit screen modes.                                   '
  128.     '------------------------------------------------------------------------------
  129.  
  130.     'Variable declaration:
  131.     DIM Message$, Title$, CharW AS INTEGER, MaxLen AS INTEGER
  132.     DIM lineBreak AS INTEGER, totalLines AS INTEGER, prevlinebreak AS INTEGER
  133.     DIM Cursor AS INTEGER, Selection.Start AS INTEGER, InputViewStart AS INTEGER
  134.     DIM FieldArea AS INTEGER, DialogH AS INTEGER, DialogW AS INTEGER
  135.     DIM DialogX AS INTEGER, DialogY AS INTEGER, InputField.X AS INTEGER
  136.     DIM TotalButtons AS INTEGER, B AS INTEGER, ButtonLine$
  137.     DIM cb AS INTEGER, DIALOGRESULT AS INTEGER, i AS INTEGER
  138.     DIM message.X AS INTEGER, SetCursor#, cursorBlink%
  139.     DIM DefaultButton AS INTEGER, k AS LONG
  140.     DIM shiftDown AS _BYTE, ctrlDown AS _BYTE, Clip$
  141.     DIM FindLF%, s1 AS INTEGER, s2 AS INTEGER
  142.     DIM Selection.Value$
  143.     DIM prevCursor AS INTEGER, ss1 AS INTEGER, ss2 AS INTEGER, mb AS _BYTE
  144.     DIM mx AS INTEGER, my AS INTEGER, nmx AS INTEGER, nmy AS INTEGER
  145.     DIM FGColor AS LONG, BGColor AS LONG
  146.  
  147.     'Data type used for the dialog buttons:
  148.     TYPE BUTTONSTYPE
  149.         ID AS LONG
  150.         CAPTION AS STRING * 120
  151.         X AS INTEGER
  152.         Y AS INTEGER
  153.         W AS INTEGER
  154.     END TYPE
  155.  
  156.     'Color constants. You can customize colors by changing these:
  157.     CONST TitleBarColor = _RGB32(0, 178, 179)
  158.     CONST DialogBGColor = _RGB32(255, 255, 255)
  159.     CONST TitleBarTextColor = _RGB32(0, 0, 0)
  160.     CONST DialogTextColor = _RGB32(0, 0, 0)
  161.     CONST InputFieldColor = _RGB32(200, 200, 200)
  162.     CONST InputFieldTextColor = _RGB32(0, 0, 0)
  163.     CONST SelectionColor = _RGBA32(127, 127, 127, 100)
  164.  
  165.     'Initial variable setup:
  166.     Message$ = tMessage$
  167.     Title$ = RTRIM$(LTRIM$(tTitle$))
  168.     IF Title$ = "" THEN Title$ = "Input"
  169.     NewValue = RTRIM$(LTRIM$(InitialValue))
  170.     DefaultButton = 1
  171.  
  172.     'Save the current drawing page so it can be restored later:
  173.     FGColor = _DEFAULTCOLOR
  174.     BGColor = _BACKGROUNDCOLOR
  175.     PCOPY 0, 1
  176.  
  177.     'Figure out the print width of a single character (in case user has a custom font applied)
  178.     CharW = _PRINTWIDTH("_")
  179.  
  180.     'Place a color overlay over the old screen image so the focus is on the dialog:
  181.     LINE (0, 0)-STEP(_WIDTH - 1, _HEIGHT - 1), _RGBA32(170, 170, 170, 170), BF
  182.  
  183.     'Message breakdown, in case CHR$(10) was used as line break:
  184.     REDIM MessageLines(1) AS STRING
  185.     MaxLen = 1
  186.     DO
  187.         lineBreak = INSTR(lineBreak + 1, Message$, CHR$(10))
  188.         IF lineBreak = 0 AND totalLines = 0 THEN
  189.             totalLines = 1
  190.             MessageLines(1) = Message$
  191.             MaxLen = LEN(Message$)
  192.             EXIT DO
  193.         ELSEIF lineBreak = 0 AND totalLines > 0 THEN
  194.             totalLines = totalLines + 1
  195.             REDIM _PRESERVE MessageLines(1 TO totalLines) AS STRING
  196.             MessageLines(totalLines) = RIGHT$(Message$, LEN(Message$) - prevlinebreak + 1)
  197.             IF LEN(MessageLines(totalLines)) > MaxLen THEN MaxLen = LEN(MessageLines(totalLines))
  198.             EXIT DO
  199.         END IF
  200.         IF totalLines = 0 THEN prevlinebreak = 1
  201.         totalLines = totalLines + 1
  202.         REDIM _PRESERVE MessageLines(1 TO totalLines) AS STRING
  203.         MessageLines(totalLines) = MID$(Message$, prevlinebreak, lineBreak - prevlinebreak)
  204.         IF LEN(MessageLines(totalLines)) > MaxLen THEN MaxLen = LEN(MessageLines(totalLines))
  205.         prevlinebreak = lineBreak + 1
  206.     LOOP
  207.  
  208.     Cursor = LEN(NewValue)
  209.     Selection.Start = 0
  210.     InputViewStart = 1
  211.     FieldArea = _WIDTH \ CharW - 4
  212.     IF FieldArea > 62 THEN FieldArea = 62
  213.     IF Selected > 0 THEN Selection.Start = Selected: Selected = -1
  214.  
  215.     'Calculate dialog dimensions and print coordinates:
  216.     DialogH = _FONTHEIGHT * (6 + totalLines) + 10
  217.     DialogW = (CharW * FieldArea) + 10
  218.     IF DialogW < MaxLen * CharW + 10 THEN DialogW = MaxLen * CharW + 10
  219.  
  220.     DialogX = _WIDTH / 2 - DialogW / 2
  221.     DialogY = _HEIGHT / 2 - DialogH / 2
  222.     InputField.X = (DialogX + (DialogW / 2)) - (((FieldArea * CharW) - 10) / 2) - 4
  223.  
  224.     'Calculate button's print coordinates:
  225.     TotalButtons = 2
  226.     DIM Buttons(1 TO TotalButtons) AS BUTTONSTYPE
  227.     B = 1
  228.     Buttons(B).ID = 1: Buttons(B).CAPTION = "< OK >": B = B + 1
  229.     Buttons(B).ID = 2: Buttons(B).CAPTION = "< Cancel >": B = B + 1
  230.     ButtonLine$ = " "
  231.     FOR cb = 1 TO TotalButtons
  232.         ButtonLine$ = ButtonLine$ + RTRIM$(LTRIM$(Buttons(cb).CAPTION)) + " "
  233.         Buttons(cb).Y = DialogY + 5 + _FONTHEIGHT * (5 + totalLines)
  234.         Buttons(cb).W = _PRINTWIDTH(RTRIM$(LTRIM$(Buttons(cb).CAPTION)))
  235.     NEXT cb
  236.     Buttons(1).X = _WIDTH / 2 - _PRINTWIDTH(ButtonLine$) / 2
  237.     FOR cb = 2 TO TotalButtons
  238.         Buttons(cb).X = Buttons(1).X + _PRINTWIDTH(SPACE$(INSTR(ButtonLine$, RTRIM$(LTRIM$(Buttons(cb).CAPTION)))))
  239.     NEXT cb
  240.  
  241.     'Main loop:
  242.     DIALOGRESULT = 0
  243.     _KEYCLEAR
  244.     DO: _LIMIT 500
  245.         'Draw the dialog.
  246.         LINE (DialogX, DialogY)-STEP(DialogW - 1, DialogH - 1), DialogBGColor, BF
  247.         LINE (DialogX, DialogY)-STEP(DialogW - 1, _FONTHEIGHT + 1), TitleBarColor, BF
  248.         COLOR TitleBarTextColor
  249.         _PRINTSTRING (_WIDTH / 2 - _PRINTWIDTH(Title$) / 2, DialogY + 1), Title$
  250.  
  251.         COLOR DialogTextColor, _RGBA32(0, 0, 0, 0)
  252.         FOR i = 1 TO totalLines
  253.             message.X = _WIDTH / 2 - _PRINTWIDTH(MessageLines(i)) / 2
  254.             _PRINTSTRING (message.X, DialogY + 5 + _FONTHEIGHT * (i + 1)), MessageLines(i)
  255.         NEXT i
  256.  
  257.         'Draw the input field
  258.         LINE (InputField.X - 2, DialogY + 3 + _FONTHEIGHT * (3 + totalLines))-STEP(FieldArea * CharW, _FONTHEIGHT + 4), InputFieldColor, BF
  259.         COLOR InputFieldTextColor
  260.         _PRINTSTRING (InputField.X, DialogY + 5 + _FONTHEIGHT * (3 + totalLines)), MID$(NewValue, InputViewStart, FieldArea)
  261.  
  262.         'Selection highlight:
  263.         GOSUB SelectionHighlight
  264.  
  265.         'Cursor blink:
  266.         IF TIMER - SetCursor# > .4 THEN
  267.             SetCursor# = TIMER
  268.             IF cursorBlink% = 1 THEN cursorBlink% = 0 ELSE cursorBlink% = 1
  269.         END IF
  270.         IF cursorBlink% = 1 THEN
  271.             LINE (InputField.X + (Cursor - (InputViewStart - 1)) * CharW, DialogY + 5 + _FONTHEIGHT * (3 + totalLines))-STEP(0, _FONTHEIGHT), _RGB32(0, 0, 0)
  272.         END IF
  273.  
  274.         'Check if buttons have been clicked or are being hovered:
  275.         GOSUB CheckButtons
  276.  
  277.         'Draw buttons:
  278.         FOR cb = 1 TO TotalButtons
  279.             _PRINTSTRING (Buttons(cb).X, Buttons(cb).Y), RTRIM$(LTRIM$(Buttons(cb).CAPTION))
  280.             IF cb = DefaultButton THEN
  281.                 COLOR _RGB32(255, 255, 0)
  282.                 _PRINTSTRING (Buttons(cb).X, Buttons(cb).Y), "<" + SPACE$(LEN(RTRIM$(LTRIM$(Buttons(cb).CAPTION))) - 2) + ">"
  283.                 COLOR _RGB32(0, 178, 179)
  284.                 _PRINTSTRING (Buttons(cb).X - 1, Buttons(cb).Y - 1), "<" + SPACE$(LEN(RTRIM$(LTRIM$(Buttons(cb).CAPTION))) - 2) + ">"
  285.                 COLOR _RGB32(0, 0, 0)
  286.             END IF
  287.         NEXT cb
  288.  
  289.         _DISPLAY
  290.  
  291.         'Process input:
  292.         k = _KEYHIT
  293.         IF k = 100303 OR k = 100304 THEN shiftDown = -1
  294.         IF k = -100303 OR k = -100304 THEN shiftDown = 0
  295.         IF k = 100305 OR k = 100306 THEN ctrlDown = -1
  296.         IF k = -100305 OR k = -100306 THEN ctrlDown = 0
  297.  
  298.         SELECT CASE k
  299.             CASE 13: DIALOGRESULT = 1
  300.             CASE 27: DIALOGRESULT = 2
  301.             CASE 32 TO 126 'Printable ASCII characters
  302.                 IF k = ASC("v") OR k = ASC("V") THEN 'Paste from clipboard (Ctrl+V)
  303.                     IF ctrlDown THEN
  304.                         Clip$ = _CLIPBOARD$
  305.                         FindLF% = INSTR(Clip$, CHR$(13))
  306.                         IF FindLF% > 0 THEN Clip$ = LEFT$(Clip$, FindLF% - 1)
  307.                         FindLF% = INSTR(Clip$, CHR$(10))
  308.                         IF FindLF% > 0 THEN Clip$ = LEFT$(Clip$, FindLF% - 1)
  309.                         IF LEN(RTRIM$(LTRIM$(Clip$))) > 0 THEN
  310.                             IF NOT Selected THEN
  311.                                 IF Cursor = LEN(NewValue) THEN
  312.                                     NewValue = NewValue + Clip$
  313.                                     Cursor = LEN(NewValue)
  314.                                 ELSE
  315.                                     NewValue = LEFT$(NewValue, Cursor) + Clip$ + MID$(NewValue, Cursor + 1)
  316.                                     Cursor = Cursor + LEN(Clip$)
  317.                                 END IF
  318.                             ELSE
  319.                                 s1 = Selection.Start
  320.                                 s2 = Cursor
  321.                                 IF s1 > s2 THEN SWAP s1, s2
  322.                                 NewValue = LEFT$(NewValue, s1) + Clip$ + MID$(NewValue, s2 + 1)
  323.                                 Cursor = s1 + LEN(Clip$)
  324.                                 Selected = 0
  325.                             END IF
  326.                         END IF
  327.                         k = 0
  328.                     END IF
  329.                 ELSEIF k = ASC("c") OR k = ASC("C") THEN 'Copy selection to clipboard (Ctrl+C)
  330.                     IF ctrlDown THEN
  331.                         _CLIPBOARD$ = Selection.Value$
  332.                         k = 0
  333.                     END IF
  334.                 ELSEIF k = ASC("x") OR k = ASC("X") THEN 'Cut selection to clipboard (Ctrl+X)
  335.                     IF ctrlDown THEN
  336.                         _CLIPBOARD$ = Selection.Value$
  337.                         GOSUB DeleteSelection
  338.                         k = 0
  339.                     END IF
  340.                 ELSEIF k = ASC("a") OR k = ASC("A") THEN 'Select all text (Ctrl+A)
  341.                     IF ctrlDown THEN
  342.                         Cursor = LEN(NewValue)
  343.                         Selection.Start = 0
  344.                         Selected = -1
  345.                         k = 0
  346.                     END IF
  347.                 END IF
  348.  
  349.                 IF k > 0 THEN
  350.                     IF NOT Selected THEN
  351.                         IF Cursor = LEN(NewValue) THEN
  352.                             NewValue = NewValue + CHR$(k)
  353.                             Cursor = Cursor + 1
  354.                         ELSE
  355.                             NewValue = LEFT$(NewValue, Cursor) + CHR$(k) + MID$(NewValue, Cursor + 1)
  356.                             Cursor = Cursor + 1
  357.                         END IF
  358.                         IF Cursor > FieldArea THEN InputViewStart = (Cursor - FieldArea) + 2
  359.                     ELSE
  360.                         s1 = Selection.Start
  361.                         s2 = Cursor
  362.                         IF s1 > s2 THEN SWAP s1, s2
  363.                         NewValue = LEFT$(NewValue, s1) + CHR$(k) + MID$(NewValue, s2 + 1)
  364.                         Selected = 0
  365.                         Cursor = s1 + 1
  366.                     END IF
  367.                 END IF
  368.             CASE 8 'Backspace
  369.                 IF LEN(NewValue) > 0 THEN
  370.                     IF NOT Selected THEN
  371.                         IF Cursor = LEN(NewValue) THEN
  372.                             NewValue = LEFT$(NewValue, LEN(NewValue) - 1)
  373.                             Cursor = Cursor - 1
  374.                         ELSEIF Cursor > 1 THEN
  375.                             NewValue = LEFT$(NewValue, Cursor - 1) + MID$(NewValue, Cursor + 1)
  376.                             Cursor = Cursor - 1
  377.                         ELSEIF Cursor = 1 THEN
  378.                             NewValue = RIGHT$(NewValue, LEN(NewValue) - 1)
  379.                             Cursor = Cursor - 1
  380.                         END IF
  381.                     ELSE
  382.                         GOSUB DeleteSelection
  383.                     END IF
  384.                 END IF
  385.             CASE 21248 'Delete
  386.                 IF NOT Selected THEN
  387.                     IF LEN(NewValue) > 0 THEN
  388.                         IF Cursor = 0 THEN
  389.                             NewValue = RIGHT$(NewValue, LEN(NewValue) - 1)
  390.                         ELSEIF Cursor > 0 AND Cursor <= LEN(NewValue) - 1 THEN
  391.                             NewValue = LEFT$(NewValue, Cursor) + MID$(NewValue, Cursor + 2)
  392.                         END IF
  393.                     END IF
  394.                 ELSE
  395.                     GOSUB DeleteSelection
  396.                 END IF
  397.             CASE 19200 'Left arrow key
  398.                 GOSUB CheckSelection
  399.                 IF Cursor > 0 THEN Cursor = Cursor - 1
  400.             CASE 19712 'Right arrow key
  401.                 GOSUB CheckSelection
  402.                 IF Cursor < LEN(NewValue) THEN Cursor = Cursor + 1
  403.             CASE 18176 'Home
  404.                 GOSUB CheckSelection
  405.                 Cursor = 0
  406.             CASE 20224 'End
  407.                 GOSUB CheckSelection
  408.                 Cursor = LEN(NewValue)
  409.         END SELECT
  410.  
  411.         'Cursor adjustments:
  412.         GOSUB CursorAdjustments
  413.     LOOP UNTIL DIALOGRESULT > 0
  414.  
  415.     _KEYCLEAR
  416.     INPUTBOX = DIALOGRESULT
  417.  
  418.     'Restore previous display:
  419.     PCOPY 1, 0
  420.     COLOR FGColor, BGColor
  421.     EXIT SUB
  422.  
  423.     CursorAdjustments:
  424.     IF Cursor > prevCursor THEN
  425.         IF Cursor - InputViewStart + 2 > FieldArea THEN InputViewStart = (Cursor - FieldArea) + 2
  426.     ELSEIF Cursor < prevCursor THEN
  427.         IF Cursor < InputViewStart - 1 THEN InputViewStart = Cursor
  428.     END IF
  429.     prevCursor = Cursor
  430.     IF InputViewStart < 1 THEN InputViewStart = 1
  431.     RETURN
  432.  
  433.     CheckSelection:
  434.     IF shiftDown = -1 THEN
  435.         IF Selected = 0 THEN
  436.             Selected = -1
  437.             Selection.Start = Cursor
  438.         END IF
  439.     ELSEIF shiftDown = 0 THEN
  440.         Selected = 0
  441.     END IF
  442.     RETURN
  443.  
  444.     DeleteSelection:
  445.     NewValue = LEFT$(NewValue, s1) + MID$(NewValue, s2 + 1)
  446.     Selected = 0
  447.     Cursor = s1
  448.     RETURN
  449.  
  450.     SelectionHighlight:
  451.     IF Selected THEN
  452.         s1 = Selection.Start
  453.         s2 = Cursor
  454.         IF s1 > s2 THEN
  455.             SWAP s1, s2
  456.             IF InputViewStart > 1 THEN
  457.                 ss1 = s1 - InputViewStart + 1
  458.             ELSE
  459.                 ss1 = s1
  460.             END IF
  461.             ss2 = s2 - s1
  462.             IF ss1 + ss2 > FieldArea THEN ss2 = FieldArea - ss1
  463.         ELSE
  464.             ss1 = s1
  465.             ss2 = s2 - s1
  466.             IF ss1 < InputViewStart THEN ss1 = 0: ss2 = s2 - InputViewStart + 1
  467.             IF ss1 > InputViewStart THEN ss1 = ss1 - InputViewStart + 1: ss2 = s2 - s1
  468.         END IF
  469.         Selection.Value$ = MID$(NewValue, s1 + 1, s2 - s1)
  470.  
  471.         LINE (InputField.X + ss1 * CharW, DialogY + 5 + _FONTHEIGHT * (3 + totalLines))-STEP(ss2 * CharW, _FONTHEIGHT), _RGBA32(255, 255, 255, 150), BF
  472.     END IF
  473.     RETURN
  474.  
  475.     CheckButtons:
  476.     'Hover highlight:
  477.     mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
  478.     FOR cb = 1 TO TotalButtons
  479.         IF (mx >= Buttons(cb).X) AND (mx <= Buttons(cb).X + Buttons(cb).W) THEN
  480.             IF (my >= Buttons(cb).Y) AND (my < Buttons(cb).Y + _FONTHEIGHT) THEN
  481.                 LINE (Buttons(cb).X, Buttons(cb).Y)-STEP(Buttons(cb).W, _FONTHEIGHT - 1), _RGBA32(230, 230, 230, 235), BF
  482.             END IF
  483.         END IF
  484.     NEXT cb
  485.  
  486.     IF mb THEN
  487.         IF mx >= InputField.X AND my >= DialogY + 3 + _FONTHEIGHT * (3 + totalLines) AND mx <= InputField.X + (FieldArea * CharW - 10) AND my <= DialogY + 3 + _FONTHEIGHT * (3 + totalLines) + _FONTHEIGHT + 4 THEN
  488.             'Clicking inside the text field positions the cursor
  489.             WHILE _MOUSEBUTTON(1)
  490.                 _LIMIT 500
  491.                 mb = _MOUSEINPUT
  492.             WEND
  493.             Cursor = ((mx - InputField.X) / CharW) + (InputViewStart - 1)
  494.             IF Cursor > LEN(NewValue) THEN Cursor = LEN(NewValue)
  495.             Selected = 0
  496.             RETURN
  497.         END IF
  498.  
  499.         FOR cb = 1 TO TotalButtons
  500.             IF (mx >= Buttons(cb).X) AND (mx <= Buttons(cb).X + Buttons(cb).W) THEN
  501.                 IF (my >= Buttons(cb).Y) AND (my < Buttons(cb).Y + _FONTHEIGHT) THEN
  502.                     DefaultButton = cb
  503.                     WHILE _MOUSEBUTTON(1): _LIMIT 500: mb = _MOUSEINPUT: WEND
  504.                     mb = 0: nmx = _MOUSEX: nmy = _MOUSEY
  505.                     IF nmx = mx AND nmy = my THEN DIALOGRESULT = cb
  506.                     RETURN
  507.                 END IF
  508.             END IF
  509.         NEXT cb
  510.     END IF
  511.     RETURN
  512.  
  513.  
  514. 'method adapted form http://stackoverflow.com/questions/4106363/converting-rgb-to-hsb-colors
  515. FUNCTION hsb~& (__H AS _FLOAT, __S AS _FLOAT, __B AS _FLOAT, A AS _FLOAT)
  516.     DIM H AS _FLOAT, S AS _FLOAT, B AS _FLOAT
  517.  
  518.     H = map(__H, 0, 255, 0, 360)
  519.     S = map(__S, 0, 255, 0, 1)
  520.     B = map(__B, 0, 255, 0, 1)
  521.  
  522.     IF S = 0 THEN
  523.         hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
  524.         EXIT FUNCTION
  525.     END IF
  526.  
  527.     DIM fmx AS _FLOAT, fmn AS _FLOAT
  528.     DIM fmd AS _FLOAT, iSextant AS INTEGER
  529.     DIM imx AS INTEGER, imd AS INTEGER, imn AS INTEGER
  530.  
  531.     IF B > .5 THEN
  532.         fmx = B - (B * S) + S
  533.         fmn = B + (B * S) - S
  534.     ELSE
  535.         fmx = B + (B * S)
  536.         fmn = B - (B * S)
  537.     END IF
  538.  
  539.     iSextant = INT(H / 60)
  540.  
  541.     IF H >= 300 THEN
  542.         H = H - 360
  543.     END IF
  544.  
  545.     H = H / 60
  546.     H = H - (2 * INT(((iSextant + 1) MOD 6) / 2))
  547.  
  548.     IF iSextant MOD 2 = 0 THEN
  549.         fmd = (H * (fmx - fmn)) + fmn
  550.     ELSE
  551.         fmd = fmn - (H * (fmx - fmn))
  552.     END IF
  553.  
  554.     imx = _ROUND(fmx * 255)
  555.     imd = _ROUND(fmd * 255)
  556.     imn = _ROUND(fmn * 255)
  557.  
  558.     SELECT CASE INT(iSextant)
  559.         CASE 1
  560.             hsb~& = _RGBA32(imd, imx, imn, A)
  561.         CASE 2
  562.             hsb~& = _RGBA32(imn, imx, imd, A)
  563.         CASE 3
  564.             hsb~& = _RGBA32(imn, imd, imx, A)
  565.         CASE 4
  566.             hsb~& = _RGBA32(imd, imn, imx, A)
  567.         CASE 5
  568.             hsb~& = _RGBA32(imx, imn, imd, A)
  569.         CASE ELSE
  570.             hsb~& = _RGBA32(imx, imd, imn, A)
  571.     END SELECT
  572.  
  573.  
  574.  
  575. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
  576.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
  577.  
  578.  
  579. '$INCLUDE:'sxript.bm'
  580.  
  581.  


Graph for Z = X+Y-2
 
Screenshot_1.png

Graph for Z = sin(X)+cos(Y)
 
Screenshot_2.png

* sxript.bi (Filesize: 8.97 KB, Downloads: 302)
* sxript.bm (Filesize: 101.28 KB, Downloads: 279)
« Last Edit: March 15, 2020, 11:50:00 am by Ashish »
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: 3D Graph Plotter
« Reply #1 on: March 13, 2020, 11:01:12 am »
I just downloaded so haven't tried code but love the colored plane in screenshot.

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: 3D Graph Plotter
« Reply #2 on: March 13, 2020, 11:05:10 am »
LOL... There was a typo. I just fixed it. You need to give expression for Z = ... not for Y = ...
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

FellippeHeitor

  • Guest
Re: 3D Graph Plotter
« Reply #3 on: March 15, 2020, 11:13:43 am »
You don't cease to amaze, kid. Great job on this one.

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: 3D Graph Plotter
« Reply #4 on: March 16, 2020, 07:21:12 am »
Thanks @FellippeHeitor
Here's a new update :-
  • You can zoom in or zoom out with help of mousewheel.
  • You can plot new graph without restarting the whole program. Just right click anywhere on the screen.
  • It now support abs() absolute value and sgn() signum functions.

And yes, you need sxript.bi and sxript.bm . If don't have it, you can download it from my first post in this topic from the attachment.
Code: QB64: [Select]
  1. '##############################################################################################
  2. '3D Grapher By Ashish Kushwaha
  3. '----------------------------------------------------------------------------------------------
  4. '* Thanks to STxAxTIC. Without his sxript, coding this would be harder.
  5. '* Thanks to FellipeHeitor. His INPUTBOX() come handy when I need QB64 Input & OpenGL together.
  6. '----------------------------------------------------------------------------------------------
  7. 'Description: Give an expression for z = ... containing terms of x, y (any power) & constants
  8. 'With the power of sxript, it also support *trigonometric functions* in the expression.
  9. 'Click on Ok. Then the Graph is plotted in 3D Space & shown in 2D screen.
  10. '-----------------------------------------------------------------------------------------------
  11. 'Controls:
  12. '* Drag on screen with mouse for rotation.
  13. '* Mousewheel for zooming in or zooming out.
  14. '* Right click to plot new graph.
  15. '----------------------------------------------------------------------------------------------
  16. 'Friday the 13th March, 2020
  17. '----------------------------------------------------------------------------------------------
  18. 'UPDATED : 16 March, 2020
  19. 'added sgn() signum and abs() absolute value function
  20. 'also added zooming feature and ability to plot new graph without running the app again.
  21.  
  22. '$INCLUDE:'sxript.bi'
  23.  
  24.     SUB gluLookAt (BYVAL eyeX#, BYVAL eyeY#, BYVAL eyeZ#, BYVAL centerX#, BYVAL centerY#, BYVAL centerZ#, BYVAL upX#, BYVAL upY#, BYVAL upZ#)
  25.  
  26. TYPE rgb
  27.     r AS SINGLE
  28.     g AS SINGLE
  29.     b AS SINGLE
  30. DIM SHARED vert(100, 100), glAllow, xRot, yRot, colArr(100, 100) AS rgb, init
  31. DIM SHARED scaleFactor
  32. scaleFactor = 1.0
  33.  
  34. _TITLE "3D Grapher"
  35. SCREEN _NEWIMAGE(600, 600, 32)
  36. a$ = SxriptEval("func(abs,{unquote(quote([x])/`-')})") 'hack for abs() function by STxAxTIC
  37. a$ = SxriptEval("func(sgn,{sub({let(a,[x]*1):print_iff([a]=0,{0},{iff(greater([a],0),{1},{-1})})})})") 'signum function by STxAxTIC
  38. start:
  39. dummy = INPUTBOX("Enter the expression for Z = ", "Enter the expression for Z = (ex. X*Y)", "X+Y-1", e$, -1)
  40. IF dummy = 2 THEN SYSTEM
  41. ' for i = 1 to len(e$)
  42. ' ca$ = mid$(e$,i,1)
  43. ' if lcase$(ca$) = "x" then ca$= "[x]"
  44. ' if lcase$(ca$) = "y" then ca$= "[y]"
  45. ' ex$ = ex$+ca$
  46. ' next
  47. ' a$ = SxriptEval("func(plot,{"+ex$+"})")
  48. PRINT "Generating... Just a moment"
  49.  
  50. FOR x = -50 TO 50
  51.     FOR z = -50 TO 50
  52.         expression$ = ""
  53.         FOR i = 1 TO LEN(e$)
  54.             ca$ = MID$(e$, i, 1)
  55.             IF LCASE$(ca$) = "x" THEN ca$ = _TRIM$(STR$(x / 10))
  56.             IF LCASE$(ca$) = "y" THEN ca$ = _TRIM$(STR$(z / 10))
  57.             expression$ = expression$ + ca$
  58.         NEXT
  59.         vert(x + 50, z + 50) = VAL(SxriptEval(expression$)) 'replace x & y with actual numeric value & then evaluate with sxript.
  60.         'PRINT expression$, VAL(SxriptEval(expression$))
  61.         'SLEEP
  62.         IF init = 0 THEN 'storage of color per vertex need not done again & again.
  63.             c~& = hsb(map(z, -50, 50, 0, 255), 255, 128, 255)
  64.             colArr(x + 50, z + 50).r = _RED(c~&) / 255
  65.             colArr(x + 50, z + 50).g = _GREEN(c~&) / 255
  66.             colArr(x + 50, z + 50).b = _BLUE(c~&) / 255
  67.         END IF
  68.     NEXT
  69.  
  70. CLS , 1 'display the equation.
  71. COLOR , 1
  72. PRINT "Z = " + e$
  73. glAllow = 1
  74. init = 1
  75. 'SLEEP
  76.         IF scaleFactor > 0.1 THEN 'to prevent negative value
  77.             scaleFactor = scaleFactor + _MOUSEWHEEL * 0.05
  78.         ELSE
  79.             scaleFactor = 0.11 'so it's value can still be change.
  80.         END IF
  81.     WEND
  82.         x = _MOUSEX: y = _MOUSEY
  83.         WHILE _MOUSEBUTTON(1)
  84.             WHILE _MOUSEINPUT: WEND
  85.             yRot = yRot + (_MOUSEX - x) 'rotate by change
  86.             xRot = xRot + (_MOUSEY - y)
  87.             x = _MOUSEX: y = _MOUSEY
  88.         WEND
  89.     END IF
  90.         glAllow = 0 'disbale GL rendering & clear screen.
  91.         CLS
  92.         GOTO start 'to take new input
  93.     END IF
  94.     _LIMIT 60
  95.  
  96. SUB _GL () STATIC
  97.     IF glAllow = 0 THEN EXIT SUB
  98.  
  99.     _glClear _GL_COLOR_BUFFER_BIT OR _GL_DEPTH_BUFFER_BIT
  100.     _glEnable _GL_DEPTH_TEST
  101.     _glEnable _GL_BLEND
  102.  
  103.  
  104.     _glMatrixMode _GL_PROJECTION
  105.     _gluPerspective 50, 1, 0.1, 40
  106.  
  107.     _glMatrixMode _GL_MODELVIEW
  108.  
  109.     gluLookAt 0, 7, 15, 0, 0, 0, 0, 1, 0
  110.     _glRotatef xRot, 1, 0, 0
  111.     _glRotatef yRot, 0, 1, 0
  112.    
  113.     _glScalef scaleFactor, scaleFactor, scaleFactor 'for zooming with mousewheel
  114.    
  115.     _glLineWidth 2.0
  116.     'draw axis
  117.     _glBegin _GL_LINES
  118.     'x-axis
  119.     _glColor3f 1, 0, 0
  120.     _glVertex3f -5, 0, 0
  121.     _glVertex3f 5, 0, 0
  122.     'z-axis
  123.     _glColor3f 0, 1, 0
  124.     _glVertex3f 0, -5, 0
  125.     _glVertex3f 0, 5, 0
  126.     'y-axis
  127.     _glColor3f 0, 0, 1
  128.     _glVertex3f 0, 0, -5
  129.     _glVertex3f 0, 0, 5
  130.  
  131.     _glEnd
  132.     _glColor3f 1, 1, 1
  133.     _glLineWidth 1.0
  134.     'draw the surface according to stored height map evaluated before.
  135.     FOR z = -50 TO 49
  136.         _glBegin _GL_TRIANGLE_STRIP
  137.         FOR x = -50 TO 50
  138.             _glColor4f colArr(x + 50, z + 50).r, colArr(x + 50, z + 50).g, colArr(x + 50, z + 50).b, 0.7
  139.             _glVertex3f map(x, -50, 50, -5, 5), vert(x + 50, z + 50), map(z, -50, 50, 5, -5)
  140.             _glVertex3f map(x, -50, 50, -5, 5), vert(x + 50, z + 51), map(z + 1, -50, 50, 5, -5)
  141.         NEXT
  142.         _glEnd
  143.     NEXT
  144.  
  145.  
  146.  
  147. 'By Fellipe Heitor
  148. FUNCTION INPUTBOX (tTitle$, tMessage$, InitialValue AS STRING, NewValue AS STRING, Selected)
  149.     'INPUTBOX ---------------------------------------------------------------------
  150.     'Show a dialog and allow user input. Returns 1 = OK or 2 = Cancel.            '
  151.     '                                                                             '
  152.     '- tTitle$ is the desired dialog title. If not provided, it'll be "Input"     '
  153.     '                                                                             '
  154.     '- tMessage$ is the prompt that'll be shown to the user. You can show         '
  155.     '   a multiline message by adding line breaks with CHR$(10).                  '
  156.     '                                                                             '
  157.     ' - InitialValue can be passed both as a string literal or as a variable.     '
  158.     '                                                                             '
  159.     '- Actual user input is returned by altering NewValue, so it must be          '
  160.     '   passed as a variable.                                                     '
  161.     '                                                                             '
  162.     '- Selected indicates wheter the initial value will be preselected when the   '
  163.     '   dialog is first shown. -1 preselects the whole text; positive values      '
  164.     '   select only part of the initial value (from the character position passed '
  165.     '   to the end of the initial value).                                         '
  166.     '                                                                             '
  167.     'Intended for use with 32-bit screen modes.                                   '
  168.     '------------------------------------------------------------------------------
  169.  
  170.     'Variable declaration:
  171.     DIM Message$, Title$, CharW AS INTEGER, MaxLen AS INTEGER
  172.     DIM lineBreak AS INTEGER, totalLines AS INTEGER, prevlinebreak AS INTEGER
  173.     DIM Cursor AS INTEGER, Selection.Start AS INTEGER, InputViewStart AS INTEGER
  174.     DIM FieldArea AS INTEGER, DialogH AS INTEGER, DialogW AS INTEGER
  175.     DIM DialogX AS INTEGER, DialogY AS INTEGER, InputField.X AS INTEGER
  176.     DIM TotalButtons AS INTEGER, B AS INTEGER, ButtonLine$
  177.     DIM cb AS INTEGER, DIALOGRESULT AS INTEGER, i AS INTEGER
  178.     DIM message.X AS INTEGER, SetCursor#, cursorBlink%
  179.     DIM DefaultButton AS INTEGER, k AS LONG
  180.     DIM shiftDown AS _BYTE, ctrlDown AS _BYTE, Clip$
  181.     DIM FindLF%, s1 AS INTEGER, s2 AS INTEGER
  182.     DIM Selection.Value$
  183.     DIM prevCursor AS INTEGER, ss1 AS INTEGER, ss2 AS INTEGER, mb AS _BYTE
  184.     DIM mx AS INTEGER, my AS INTEGER, nmx AS INTEGER, nmy AS INTEGER
  185.     DIM FGColor AS LONG, BGColor AS LONG
  186.  
  187.     'Data type used for the dialog buttons:
  188.     TYPE BUTTONSTYPE
  189.         ID AS LONG
  190.         CAPTION AS STRING * 120
  191.         X AS INTEGER
  192.         Y AS INTEGER
  193.         W AS INTEGER
  194.     END TYPE
  195.  
  196.     'Color constants. You can customize colors by changing these:
  197.     CONST TitleBarColor = _RGB32(0, 178, 179)
  198.     CONST DialogBGColor = _RGB32(255, 255, 255)
  199.     CONST TitleBarTextColor = _RGB32(0, 0, 0)
  200.     CONST DialogTextColor = _RGB32(0, 0, 0)
  201.     CONST InputFieldColor = _RGB32(200, 200, 200)
  202.     CONST InputFieldTextColor = _RGB32(0, 0, 0)
  203.     CONST SelectionColor = _RGBA32(127, 127, 127, 100)
  204.  
  205.     'Initial variable setup:
  206.     Message$ = tMessage$
  207.     Title$ = RTRIM$(LTRIM$(tTitle$))
  208.     IF Title$ = "" THEN Title$ = "Input"
  209.     NewValue = RTRIM$(LTRIM$(InitialValue))
  210.     DefaultButton = 1
  211.  
  212.     'Save the current drawing page so it can be restored later:
  213.     FGColor = _DEFAULTCOLOR
  214.     BGColor = _BACKGROUNDCOLOR
  215.     PCOPY 0, 1
  216.  
  217.     'Figure out the print width of a single character (in case user has a custom font applied)
  218.     CharW = _PRINTWIDTH("_")
  219.  
  220.     'Place a color overlay over the old screen image so the focus is on the dialog:
  221.     LINE (0, 0)-STEP(_WIDTH - 1, _HEIGHT - 1), _RGBA32(170, 170, 170, 170), BF
  222.  
  223.     'Message breakdown, in case CHR$(10) was used as line break:
  224.     REDIM MessageLines(1) AS STRING
  225.     MaxLen = 1
  226.     DO
  227.         lineBreak = INSTR(lineBreak + 1, Message$, CHR$(10))
  228.         IF lineBreak = 0 AND totalLines = 0 THEN
  229.             totalLines = 1
  230.             MessageLines(1) = Message$
  231.             MaxLen = LEN(Message$)
  232.             EXIT DO
  233.         ELSEIF lineBreak = 0 AND totalLines > 0 THEN
  234.             totalLines = totalLines + 1
  235.             REDIM _PRESERVE MessageLines(1 TO totalLines) AS STRING
  236.             MessageLines(totalLines) = RIGHT$(Message$, LEN(Message$) - prevlinebreak + 1)
  237.             IF LEN(MessageLines(totalLines)) > MaxLen THEN MaxLen = LEN(MessageLines(totalLines))
  238.             EXIT DO
  239.         END IF
  240.         IF totalLines = 0 THEN prevlinebreak = 1
  241.         totalLines = totalLines + 1
  242.         REDIM _PRESERVE MessageLines(1 TO totalLines) AS STRING
  243.         MessageLines(totalLines) = MID$(Message$, prevlinebreak, lineBreak - prevlinebreak)
  244.         IF LEN(MessageLines(totalLines)) > MaxLen THEN MaxLen = LEN(MessageLines(totalLines))
  245.         prevlinebreak = lineBreak + 1
  246.     LOOP
  247.  
  248.     Cursor = LEN(NewValue)
  249.     Selection.Start = 0
  250.     InputViewStart = 1
  251.     FieldArea = _WIDTH \ CharW - 4
  252.     IF FieldArea > 62 THEN FieldArea = 62
  253.     IF Selected > 0 THEN Selection.Start = Selected: Selected = -1
  254.  
  255.     'Calculate dialog dimensions and print coordinates:
  256.     DialogH = _FONTHEIGHT * (6 + totalLines) + 10
  257.     DialogW = (CharW * FieldArea) + 10
  258.     IF DialogW < MaxLen * CharW + 10 THEN DialogW = MaxLen * CharW + 10
  259.  
  260.     DialogX = _WIDTH / 2 - DialogW / 2
  261.     DialogY = _HEIGHT / 2 - DialogH / 2
  262.     InputField.X = (DialogX + (DialogW / 2)) - (((FieldArea * CharW) - 10) / 2) - 4
  263.  
  264.     'Calculate button's print coordinates:
  265.     TotalButtons = 2
  266.     DIM Buttons(1 TO TotalButtons) AS BUTTONSTYPE
  267.     B = 1
  268.     Buttons(B).ID = 1: Buttons(B).CAPTION = "< OK >": B = B + 1
  269.     Buttons(B).ID = 2: Buttons(B).CAPTION = "< Cancel >": B = B + 1
  270.     ButtonLine$ = " "
  271.     FOR cb = 1 TO TotalButtons
  272.         ButtonLine$ = ButtonLine$ + RTRIM$(LTRIM$(Buttons(cb).CAPTION)) + " "
  273.         Buttons(cb).Y = DialogY + 5 + _FONTHEIGHT * (5 + totalLines)
  274.         Buttons(cb).W = _PRINTWIDTH(RTRIM$(LTRIM$(Buttons(cb).CAPTION)))
  275.     NEXT cb
  276.     Buttons(1).X = _WIDTH / 2 - _PRINTWIDTH(ButtonLine$) / 2
  277.     FOR cb = 2 TO TotalButtons
  278.         Buttons(cb).X = Buttons(1).X + _PRINTWIDTH(SPACE$(INSTR(ButtonLine$, RTRIM$(LTRIM$(Buttons(cb).CAPTION)))))
  279.     NEXT cb
  280.  
  281.     'Main loop:
  282.     DIALOGRESULT = 0
  283.     _KEYCLEAR
  284.     DO: _LIMIT 500
  285.         'Draw the dialog.
  286.         LINE (DialogX, DialogY)-STEP(DialogW - 1, DialogH - 1), DialogBGColor, BF
  287.         LINE (DialogX, DialogY)-STEP(DialogW - 1, _FONTHEIGHT + 1), TitleBarColor, BF
  288.         COLOR TitleBarTextColor
  289.         _PRINTSTRING (_WIDTH / 2 - _PRINTWIDTH(Title$) / 2, DialogY + 1), Title$
  290.  
  291.         COLOR DialogTextColor, _RGBA32(0, 0, 0, 0)
  292.         FOR i = 1 TO totalLines
  293.             message.X = _WIDTH / 2 - _PRINTWIDTH(MessageLines(i)) / 2
  294.             _PRINTSTRING (message.X, DialogY + 5 + _FONTHEIGHT * (i + 1)), MessageLines(i)
  295.         NEXT i
  296.  
  297.         'Draw the input field
  298.         LINE (InputField.X - 2, DialogY + 3 + _FONTHEIGHT * (3 + totalLines))-STEP(FieldArea * CharW, _FONTHEIGHT + 4), InputFieldColor, BF
  299.         COLOR InputFieldTextColor
  300.         _PRINTSTRING (InputField.X, DialogY + 5 + _FONTHEIGHT * (3 + totalLines)), MID$(NewValue, InputViewStart, FieldArea)
  301.  
  302.         'Selection highlight:
  303.         GOSUB SelectionHighlight
  304.  
  305.         'Cursor blink:
  306.         IF TIMER - SetCursor# > .4 THEN
  307.             SetCursor# = TIMER
  308.             IF cursorBlink% = 1 THEN cursorBlink% = 0 ELSE cursorBlink% = 1
  309.         END IF
  310.         IF cursorBlink% = 1 THEN
  311.             LINE (InputField.X + (Cursor - (InputViewStart - 1)) * CharW, DialogY + 5 + _FONTHEIGHT * (3 + totalLines))-STEP(0, _FONTHEIGHT), _RGB32(0, 0, 0)
  312.         END IF
  313.  
  314.         'Check if buttons have been clicked or are being hovered:
  315.         GOSUB CheckButtons
  316.  
  317.         'Draw buttons:
  318.         FOR cb = 1 TO TotalButtons
  319.             _PRINTSTRING (Buttons(cb).X, Buttons(cb).Y), RTRIM$(LTRIM$(Buttons(cb).CAPTION))
  320.             IF cb = DefaultButton THEN
  321.                 COLOR _RGB32(255, 255, 0)
  322.                 _PRINTSTRING (Buttons(cb).X, Buttons(cb).Y), "<" + SPACE$(LEN(RTRIM$(LTRIM$(Buttons(cb).CAPTION))) - 2) + ">"
  323.                 COLOR _RGB32(0, 178, 179)
  324.                 _PRINTSTRING (Buttons(cb).X - 1, Buttons(cb).Y - 1), "<" + SPACE$(LEN(RTRIM$(LTRIM$(Buttons(cb).CAPTION))) - 2) + ">"
  325.                 COLOR _RGB32(0, 0, 0)
  326.             END IF
  327.         NEXT cb
  328.  
  329.         _DISPLAY
  330.  
  331.         'Process input:
  332.         k = _KEYHIT
  333.         IF k = 100303 OR k = 100304 THEN shiftDown = -1
  334.         IF k = -100303 OR k = -100304 THEN shiftDown = 0
  335.         IF k = 100305 OR k = 100306 THEN ctrlDown = -1
  336.         IF k = -100305 OR k = -100306 THEN ctrlDown = 0
  337.  
  338.         SELECT CASE k
  339.             CASE 13: DIALOGRESULT = 1
  340.             CASE 27: DIALOGRESULT = 2
  341.             CASE 32 TO 126 'Printable ASCII characters
  342.                 IF k = ASC("v") OR k = ASC("V") THEN 'Paste from clipboard (Ctrl+V)
  343.                     IF ctrlDown THEN
  344.                         Clip$ = _CLIPBOARD$
  345.                         FindLF% = INSTR(Clip$, CHR$(13))
  346.                         IF FindLF% > 0 THEN Clip$ = LEFT$(Clip$, FindLF% - 1)
  347.                         FindLF% = INSTR(Clip$, CHR$(10))
  348.                         IF FindLF% > 0 THEN Clip$ = LEFT$(Clip$, FindLF% - 1)
  349.                         IF LEN(RTRIM$(LTRIM$(Clip$))) > 0 THEN
  350.                             IF NOT Selected THEN
  351.                                 IF Cursor = LEN(NewValue) THEN
  352.                                     NewValue = NewValue + Clip$
  353.                                     Cursor = LEN(NewValue)
  354.                                 ELSE
  355.                                     NewValue = LEFT$(NewValue, Cursor) + Clip$ + MID$(NewValue, Cursor + 1)
  356.                                     Cursor = Cursor + LEN(Clip$)
  357.                                 END IF
  358.                             ELSE
  359.                                 s1 = Selection.Start
  360.                                 s2 = Cursor
  361.                                 IF s1 > s2 THEN SWAP s1, s2
  362.                                 NewValue = LEFT$(NewValue, s1) + Clip$ + MID$(NewValue, s2 + 1)
  363.                                 Cursor = s1 + LEN(Clip$)
  364.                                 Selected = 0
  365.                             END IF
  366.                         END IF
  367.                         k = 0
  368.                     END IF
  369.                 ELSEIF k = ASC("c") OR k = ASC("C") THEN 'Copy selection to clipboard (Ctrl+C)
  370.                     IF ctrlDown THEN
  371.                         _CLIPBOARD$ = Selection.Value$
  372.                         k = 0
  373.                     END IF
  374.                 ELSEIF k = ASC("x") OR k = ASC("X") THEN 'Cut selection to clipboard (Ctrl+X)
  375.                     IF ctrlDown THEN
  376.                         _CLIPBOARD$ = Selection.Value$
  377.                         GOSUB DeleteSelection
  378.                         k = 0
  379.                     END IF
  380.                 ELSEIF k = ASC("a") OR k = ASC("A") THEN 'Select all text (Ctrl+A)
  381.                     IF ctrlDown THEN
  382.                         Cursor = LEN(NewValue)
  383.                         Selection.Start = 0
  384.                         Selected = -1
  385.                         k = 0
  386.                     END IF
  387.                 END IF
  388.  
  389.                 IF k > 0 THEN
  390.                     IF NOT Selected THEN
  391.                         IF Cursor = LEN(NewValue) THEN
  392.                             NewValue = NewValue + CHR$(k)
  393.                             Cursor = Cursor + 1
  394.                         ELSE
  395.                             NewValue = LEFT$(NewValue, Cursor) + CHR$(k) + MID$(NewValue, Cursor + 1)
  396.                             Cursor = Cursor + 1
  397.                         END IF
  398.                         IF Cursor > FieldArea THEN InputViewStart = (Cursor - FieldArea) + 2
  399.                     ELSE
  400.                         s1 = Selection.Start
  401.                         s2 = Cursor
  402.                         IF s1 > s2 THEN SWAP s1, s2
  403.                         NewValue = LEFT$(NewValue, s1) + CHR$(k) + MID$(NewValue, s2 + 1)
  404.                         Selected = 0
  405.                         Cursor = s1 + 1
  406.                     END IF
  407.                 END IF
  408.             CASE 8 'Backspace
  409.                 IF LEN(NewValue) > 0 THEN
  410.                     IF NOT Selected THEN
  411.                         IF Cursor = LEN(NewValue) THEN
  412.                             NewValue = LEFT$(NewValue, LEN(NewValue) - 1)
  413.                             Cursor = Cursor - 1
  414.                         ELSEIF Cursor > 1 THEN
  415.                             NewValue = LEFT$(NewValue, Cursor - 1) + MID$(NewValue, Cursor + 1)
  416.                             Cursor = Cursor - 1
  417.                         ELSEIF Cursor = 1 THEN
  418.                             NewValue = RIGHT$(NewValue, LEN(NewValue) - 1)
  419.                             Cursor = Cursor - 1
  420.                         END IF
  421.                     ELSE
  422.                         GOSUB DeleteSelection
  423.                     END IF
  424.                 END IF
  425.             CASE 21248 'Delete
  426.                 IF NOT Selected THEN
  427.                     IF LEN(NewValue) > 0 THEN
  428.                         IF Cursor = 0 THEN
  429.                             NewValue = RIGHT$(NewValue, LEN(NewValue) - 1)
  430.                         ELSEIF Cursor > 0 AND Cursor <= LEN(NewValue) - 1 THEN
  431.                             NewValue = LEFT$(NewValue, Cursor) + MID$(NewValue, Cursor + 2)
  432.                         END IF
  433.                     END IF
  434.                 ELSE
  435.                     GOSUB DeleteSelection
  436.                 END IF
  437.             CASE 19200 'Left arrow key
  438.                 GOSUB CheckSelection
  439.                 IF Cursor > 0 THEN Cursor = Cursor - 1
  440.             CASE 19712 'Right arrow key
  441.                 GOSUB CheckSelection
  442.                 IF Cursor < LEN(NewValue) THEN Cursor = Cursor + 1
  443.             CASE 18176 'Home
  444.                 GOSUB CheckSelection
  445.                 Cursor = 0
  446.             CASE 20224 'End
  447.                 GOSUB CheckSelection
  448.                 Cursor = LEN(NewValue)
  449.         END SELECT
  450.  
  451.         'Cursor adjustments:
  452.         GOSUB CursorAdjustments
  453.     LOOP UNTIL DIALOGRESULT > 0
  454.  
  455.     _KEYCLEAR
  456.     INPUTBOX = DIALOGRESULT
  457.  
  458.     'Restore previous display:
  459.     PCOPY 1, 0
  460.     COLOR FGColor, BGColor
  461.     EXIT SUB
  462.  
  463.     CursorAdjustments:
  464.     IF Cursor > prevCursor THEN
  465.         IF Cursor - InputViewStart + 2 > FieldArea THEN InputViewStart = (Cursor - FieldArea) + 2
  466.     ELSEIF Cursor < prevCursor THEN
  467.         IF Cursor < InputViewStart - 1 THEN InputViewStart = Cursor
  468.     END IF
  469.     prevCursor = Cursor
  470.     IF InputViewStart < 1 THEN InputViewStart = 1
  471.     RETURN
  472.  
  473.     CheckSelection:
  474.     IF shiftDown = -1 THEN
  475.         IF Selected = 0 THEN
  476.             Selected = -1
  477.             Selection.Start = Cursor
  478.         END IF
  479.     ELSEIF shiftDown = 0 THEN
  480.         Selected = 0
  481.     END IF
  482.     RETURN
  483.  
  484.     DeleteSelection:
  485.     NewValue = LEFT$(NewValue, s1) + MID$(NewValue, s2 + 1)
  486.     Selected = 0
  487.     Cursor = s1
  488.     RETURN
  489.  
  490.     SelectionHighlight:
  491.     IF Selected THEN
  492.         s1 = Selection.Start
  493.         s2 = Cursor
  494.         IF s1 > s2 THEN
  495.             SWAP s1, s2
  496.             IF InputViewStart > 1 THEN
  497.                 ss1 = s1 - InputViewStart + 1
  498.             ELSE
  499.                 ss1 = s1
  500.             END IF
  501.             ss2 = s2 - s1
  502.             IF ss1 + ss2 > FieldArea THEN ss2 = FieldArea - ss1
  503.         ELSE
  504.             ss1 = s1
  505.             ss2 = s2 - s1
  506.             IF ss1 < InputViewStart THEN ss1 = 0: ss2 = s2 - InputViewStart + 1
  507.             IF ss1 > InputViewStart THEN ss1 = ss1 - InputViewStart + 1: ss2 = s2 - s1
  508.         END IF
  509.         Selection.Value$ = MID$(NewValue, s1 + 1, s2 - s1)
  510.  
  511.         LINE (InputField.X + ss1 * CharW, DialogY + 5 + _FONTHEIGHT * (3 + totalLines))-STEP(ss2 * CharW, _FONTHEIGHT), _RGBA32(255, 255, 255, 150), BF
  512.     END IF
  513.     RETURN
  514.  
  515.     CheckButtons:
  516.     'Hover highlight:
  517.     mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
  518.     FOR cb = 1 TO TotalButtons
  519.         IF (mx >= Buttons(cb).X) AND (mx <= Buttons(cb).X + Buttons(cb).W) THEN
  520.             IF (my >= Buttons(cb).Y) AND (my < Buttons(cb).Y + _FONTHEIGHT) THEN
  521.                 LINE (Buttons(cb).X, Buttons(cb).Y)-STEP(Buttons(cb).W, _FONTHEIGHT - 1), _RGBA32(230, 230, 230, 235), BF
  522.             END IF
  523.         END IF
  524.     NEXT cb
  525.  
  526.     IF mb THEN
  527.         IF mx >= InputField.X AND my >= DialogY + 3 + _FONTHEIGHT * (3 + totalLines) AND mx <= InputField.X + (FieldArea * CharW - 10) AND my <= DialogY + 3 + _FONTHEIGHT * (3 + totalLines) + _FONTHEIGHT + 4 THEN
  528.             'Clicking inside the text field positions the cursor
  529.             WHILE _MOUSEBUTTON(1)
  530.                 _LIMIT 500
  531.                 mb = _MOUSEINPUT
  532.             WEND
  533.             Cursor = ((mx - InputField.X) / CharW) + (InputViewStart - 1)
  534.             IF Cursor > LEN(NewValue) THEN Cursor = LEN(NewValue)
  535.             Selected = 0
  536.             RETURN
  537.         END IF
  538.  
  539.         FOR cb = 1 TO TotalButtons
  540.             IF (mx >= Buttons(cb).X) AND (mx <= Buttons(cb).X + Buttons(cb).W) THEN
  541.                 IF (my >= Buttons(cb).Y) AND (my < Buttons(cb).Y + _FONTHEIGHT) THEN
  542.                     DefaultButton = cb
  543.                     WHILE _MOUSEBUTTON(1): _LIMIT 500: mb = _MOUSEINPUT: WEND
  544.                     mb = 0: nmx = _MOUSEX: nmy = _MOUSEY
  545.                     IF nmx = mx AND nmy = my THEN DIALOGRESULT = cb
  546.                     RETURN
  547.                 END IF
  548.             END IF
  549.         NEXT cb
  550.     END IF
  551.     RETURN
  552.  
  553.  
  554. 'method adapted form http://stackoverflow.com/questions/4106363/converting-rgb-to-hsb-colors
  555. FUNCTION hsb~& (__H AS _FLOAT, __S AS _FLOAT, __B AS _FLOAT, A AS _FLOAT)
  556.     DIM H AS _FLOAT, S AS _FLOAT, B AS _FLOAT
  557.  
  558.     H = map(__H, 0, 255, 0, 360)
  559.     S = map(__S, 0, 255, 0, 1)
  560.     B = map(__B, 0, 255, 0, 1)
  561.  
  562.     IF S = 0 THEN
  563.         hsb~& = _RGBA32(B * 255, B * 255, B * 255, A)
  564.         EXIT FUNCTION
  565.     END IF
  566.  
  567.     DIM fmx AS _FLOAT, fmn AS _FLOAT
  568.     DIM fmd AS _FLOAT, iSextant AS INTEGER
  569.     DIM imx AS INTEGER, imd AS INTEGER, imn AS INTEGER
  570.  
  571.     IF B > .5 THEN
  572.         fmx = B - (B * S) + S
  573.         fmn = B + (B * S) - S
  574.     ELSE
  575.         fmx = B + (B * S)
  576.         fmn = B - (B * S)
  577.     END IF
  578.  
  579.     iSextant = INT(H / 60)
  580.  
  581.     IF H >= 300 THEN
  582.         H = H - 360
  583.     END IF
  584.  
  585.     H = H / 60
  586.     H = H - (2 * INT(((iSextant + 1) MOD 6) / 2))
  587.  
  588.     IF iSextant MOD 2 = 0 THEN
  589.         fmd = (H * (fmx - fmn)) + fmn
  590.     ELSE
  591.         fmd = fmn - (H * (fmx - fmn))
  592.     END IF
  593.  
  594.     imx = _ROUND(fmx * 255)
  595.     imd = _ROUND(fmd * 255)
  596.     imn = _ROUND(fmn * 255)
  597.  
  598.     SELECT CASE INT(iSextant)
  599.         CASE 1
  600.             hsb~& = _RGBA32(imd, imx, imn, A)
  601.         CASE 2
  602.             hsb~& = _RGBA32(imn, imx, imd, A)
  603.         CASE 3
  604.             hsb~& = _RGBA32(imn, imd, imx, A)
  605.         CASE 4
  606.             hsb~& = _RGBA32(imd, imn, imx, A)
  607.         CASE 5
  608.             hsb~& = _RGBA32(imx, imn, imd, A)
  609.         CASE ELSE
  610.             hsb~& = _RGBA32(imx, imd, imn, A)
  611.     END SELECT
  612.  
  613.  
  614.  
  615. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
  616.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
  617.  
  618. '$INCLUDE:'sxript.bm'
  619.  
« Last Edit: March 16, 2020, 07:22:17 am by Ashish »
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: 3D Graph Plotter
« Reply #5 on: March 18, 2020, 08:23:59 pm »
I can say  Cool!

 
3D grapher Ashish.jpg

what is the formula  used for Z to get this output? ;-)
Programming isn't difficult, only it's  consuming time and coffee

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: 3D Graph Plotter
« Reply #6 on: March 19, 2020, 08:54:03 am »
Thanks @TempodiBasic
About the calculation for Z, it created an array of 100 by 100. It acts a XY plane. And I evaluate the expression given by the user of Z in that with the help of sxript. The answer I get is how much it is above/below the XY plane. Now, I have all the data. So, I use OpenGL to render the surface.

PS: How are you doing now? I saw shocking news about Italy yesterday, around 400 died in a day!
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: 3D Graph Plotter
« Reply #7 on: March 19, 2020, 10:41:04 am »
Yeah
but the best news is that here in  Campania  are ready for the peak the next week!  At Noth hey have already done!
Programming isn't difficult, only it's  consuming time and coffee

Marked as best answer by Ashish on January 29, 2021, 05:15:24 am

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: 3D Graph Plotter
« Reply #8 on: January 29, 2021, 06:53:52 am »
Apologies for bumping a topic greater than 120 days old.

I had a good look at this program, and gave it a complete overhaul to comply with OPTION _EXPLICIT, make everything into functions, get rid of the goto, etc. etc. I also updated the Sxript core, added drag+drop as a substitute for typing the first equation, plus a few other small things. Plenty of opportunity remains to embellish this.

All of the updated files are below.

Clerical note: I didn't see the original code on your github Ashish, didn't know if you wanted the honors and then I would just fork it from you...

 
ss.png
* sxript.bi (Filesize: 7.99 KB, Downloads: 165)
* sxript.bm (Filesize: 98.05 KB, Downloads: 187)
* sxmath.bi (Filesize: 1.72 KB, Downloads: 173)
* sxmath.bm (Filesize: 25.21 KB, Downloads: 172)
* 3D Grapher 2.bas (Filesize: 25.9 KB, Downloads: 173)
« Last Edit: January 29, 2021, 02:20:35 pm by STxAxTIC »
You're not done when it works, you're done when it's right.

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: 3D Graph Plotter
« Reply #9 on: January 29, 2021, 10:14:37 am »
@STxAxTIC GREAT! I like it!
You also made the code very clean and beautiful! :)
and yes, I created the repo - https://github.com/AshishKingdom/3D-Grapher
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline Dav

  • Forum Resident
  • Posts: 792
    • View Profile
Re: 3D Graph Plotter
« Reply #10 on: January 29, 2021, 01:30:00 pm »
Im glad this topic got bumped up - i had missed it before. What great code. Both examples.

- Dav

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: 3D Graph Plotter
« Reply #11 on: January 29, 2021, 02:56:34 pm »
Yeah bump Ashish stuff all you want!  ;-))

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: 3D Graph Plotter
« Reply #12 on: January 29, 2021, 11:39:45 pm »
looks nice ashishh, good work

I too have made a 3d plotter that takes algebraic expression, parses, then plots a surface, see screenshot, I also added support for variable 't' for time which allows you to animate the surface.  I'd like to eventually write a 4d domain colouring plotter for complex functions
2013-06-29-143535_1024x768_scrot.png
* 2013-06-29-143535_1024x768_scrot.png (Filesize: 132.1 KB, Dimensions: 1024x768, Views: 169)

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: 3D Graph Plotter
« Reply #13 on: January 30, 2021, 04:44:07 pm »
Hey vince that's pretty swell! I would like to see complex plotting one day. I have not gotten around to that yet...(!)
You're not done when it works, you're done when it's right.

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: 3D Graph Plotter
« Reply #14 on: January 31, 2021, 07:30:11 pm »
I have this thread https://www.qb64.org/forum/index.php?topic=2923.0 and would like to parse expressions such as "w = sin(z)" one day