Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Pascalated ZX BASIC Demo #21 - Fxy Graph
#1
To run online, click here: RUN ONLINE

Try these: 
2*(x*x+y*y<1.5)
(x*x+y*y<1.5)*(2-x*x-y*y)


Code:
' PROGRAM ViewFxy
' (c) ZarSoft 2022 Pascalated BASIC
' (c) ZarSoft 2023 Pascalated Boriel ZX BASIC
' Written by Ze Oliveira
' Pascalated Sinclair BASIC (c) 1987 by ZarSoft
' Pascalated BASIC Converter (c) 2021 by Zarsoft
' Pascalated Boriel (c) 2023 by ZarSoft
' ZX BASIC Compiler (c) 2008 by Boriel

#include <input.bas>  ' number = VAL INPUT(12)
#include <screen.bas> ' SCREEN$ function
#include <attr.bas>   ' ATTR function

'--- Pascalated Boriel ---
#define PROGRAM   REM
#define BEGIN    REM
'#define CONST     CONST
#define VAR       DIM
#define INTEGER   LONG
#define REAL      FLOAT
#define CHAR      STRING
'#define STRING    STRING
#define BOOLEAN   UBYTE
#define TYPE      AS
'#define WHILE    WHILE
#define REPEAT    DO
#define UNTIL     LOOP UNTIL
#define PROCEDURE  SUB
CONST   TRUE      TYPE BOOLEAN = 1
CONST   FALSE     TYPE BOOLEAN = 0

PROGRAM ViewFxy

' CONSTant declarations
REM CONSTant declarations
CONST black = 0
CONST blue = 1
CONST red = 2
CONST magenta = 3
CONST green = 4
CONST cyan = 5
CONST yellow = 6
CONST white = 7
CONST res TYPE INTEGER = 20 ' resolution
CONST zoom TYPE REAL = 10 ' resize

' VAR - Global variables
VAR nfunc TYPE INTEGER = 1 ' active function number
REM Fxy = VAL ("F"+STR$ nfunc)
VAR F$ TYPE STRING = "0.5*COS(ABS(x*y*12))"
VAR G$ TYPE STRING ' USER function (only X and Y accepted)
VAR X,Y TYPE REAL ' x,y of the PROCEDURE
VAR Z TYPE REAL ' z = f(x,y)
VAR Horizon(255) TYPE INTEGER ' horizon
VAR x1,y1, x2,y2 TYPE REAL ' view domain
VAR TheEnd TYPE BOOLEAN

PROCEDURE TRON (m TYPE STRING)
  PRINT AT 23,0;m;
  PAUSE 0
END PROCEDURE

FUNCTION VARaz (V$ TYPE STRING) TYPE REAL
VAR R TYPE REAL
IF V$ = "Z"
  R = Z
ELSE IF V$ = "Y" OR V$ = "y"
  R = Y
ELSE IF V$ = "X" OR V$ = "x"
  R = X
ENDIF 
RETURN R
END FUNCTION

FUNCTION VALx$ (S$ TYPE STRING) TYPE STRING
VAR R$ TYPE STRING
R$ = ""
FOR i = 0 TO LEN S$ -1
  IF S$(i) >= "A"
    LET R$ = R$ + STR$ VARaz( S$(i) )
  ELSE
    LET R$ = R$ + S$(i)
  ENDIF 
NEXT i
RETURN R$
END FUNCTION

PROCEDURE DrawLineYY (sx0 TYPE INTEGER,sy0 TYPE INTEGER,sx TYPE INTEGER,sy TYPE INTEGER)
VAR swap TYPE BOOLEAN
VAR x,y TYPE INTEGER
VAR xi,yi TYPE REAL
VAR xs,ys TYPE INTEGER
VAR aux TYPE INTEGER
VAR dx TYPE REAL
LET swap = FALSE
IF sy0>sy THEN LET swap = TRUE: LET aux = sy0: LET sy0 = sy: LET sy = aux: LET aux = sx0: LET sx0 = sx: LET sx = aux
LET xi = sx0
LET yi = sy0
LET dx = (0.1+sx-sx0-0.1)/(0.1+sy-sy0-0.1)
FOR y = sy0 TO sy
  ' xi = xi
  yi = y
  xs = INT (xi+0.5)
  ys = y
  IF  Horizon(xs) < ys THEN LET Horizon(xs) = ys
  IF  Horizon(xs) > ys THEN LET ys = Horizon(xs)
  PLOT xs, ys
  LET xi = xi+dx
  ' LET yi = yi+1
NEXT y
IF swap THEN LET aux = sy0: LET sy0 = sy: LET sy = aux: LET aux = sx0: LET sx0 = sx: LET sx = aux
END PROCEDURE

PROCEDURE DrawLineXX (sx0 TYPE INTEGER,sy0 TYPE INTEGER,sx TYPE INTEGER,sy TYPE INTEGER)
VAR x,y TYPE INTEGER
VAR xi,yi TYPE REAL
VAR xs,ys TYPE INTEGER
VAR dy TYPE REAL
LET xi = sx0
LET yi = sy0
LET dy = (0.1+sy-sy0-0.1)/(sx-sx0)
FOR x = sx0 TO sx
  xi = x
  xs = x
  ys = INT (yi+0.5)
  IF Horizon(xs) < ys THEN LET Horizon(xs) = ys
  IF Horizon(xs) > ys THEN LET ys = Horizon(xs)
  PLOT xs,ys
  LET yi = yi+dy
  ' LET xi = xi+1
NEXT x
END PROCEDURE

PROCEDURE DrawLine (sx0 TYPE INTEGER,sy0 TYPE INTEGER,sx TYPE INTEGER,sy TYPE INTEGER)
IF sx-sx0 >= ABS(sy-sy0) THEN DrawLineXX(sx0,sy0,sx,sy)
IF sx-sx0 < ABS(sy-sy0) THEN DrawLineYY(sx0,sy0,sx,sy)
END PROCEDURE

FUNCTION F0 TYPE REAL
F$ = VALx$( G$ )
RETURN VAL( F$ )
END FUNCTION

FUNCTION F1 TYPE REAL
RETURN 9/(1+8*X*X+8*Y*Y)
END FUNCTION

FUNCTION F2 TYPE REAL
RETURN 9/(1+X*X*8+Y*Y*8)+0.25*COS(X*8+Y*8)
END FUNCTION

FUNCTION F3 TYPE REAL
RETURN -9/(1+8*X*X+8*Y*Y)
END FUNCTION

FUNCTION F4 TYPE REAL
RETURN 1*SIN(X*Y*6)/(X*Y*6+1.3E-5)
END FUNCTION

FUNCTION F5 TYPE REAL
RETURN 1.2*INT(3*(SIN(X*3)*SIN(X*3))*SIN(X*3)*(SIN(Y*3)*SIN(Y*3))*SIN(Y*3))
END FUNCTION

FUNCTION F6 TYPE REAL
RETURN SIN(X*3)*SIN(Y*3)
END FUNCTION

FUNCTION F7 TYPE REAL
RETURN INT(9/(1+8*X*X+8*Y*Y))
END FUNCTION

FUNCTION F8 TYPE REAL
RETURN 15*(X+Y)*EXP((-X*X*3-Y*Y*3))
END FUNCTION

FUNCTION F9 TYPE REAL
RETURN 7*COS(SQR(X*X*64+Y*Y*64))/(1+X*X*16+Y*Y*16)
END FUNCTION

FUNCTION Fxy TYPE REAL
VAR r TYPE REAL
IF nfunc = 0
  r = F0
ELSEIF nfunc = 1
  r = F1
ELSEIF nfunc = 2
  r = F2
ELSEIF nfunc = 3
  r = F3
ELSEIF nfunc = 4
  r = F4
ELSEIF nfunc = 5
  r = F5
ELSEIF nfunc = 6
  r = F6
ELSEIF nfunc = 7
  r = F7
ELSEIF nfunc = 8
  r = F8
ELSEIF nfunc = 9
  r = F9
ENDIF 
RETURN r
END FUNCTION

PROCEDURE ShowGraph
VAR sx,sy TYPE INTEGER ' ortogonal screen coordinates
VAR sx0,sy0 TYPE REAL ' previous screen coordinates
VAR u,v TYPE INTEGER ' iterations 1 to res
VAR x0,y0 TYPE REAL ' previous x,y
VAR dx,dy TYPE REAL ' increment
VAR i TYPE INTEGER
BORDER 0 : PAPER 1 : INK 7 : CLS
PRINT "Function ";nfunc
IF nfunc = 0 THEN PRINT "F(x,y)= ";G$
REM DIM Horizon(255) : REM reset horizon
FOR i = 0 TO 255
  Horizon(i) = 0
NEXT i 
LET y0 = y1
LET dy = (y2-y1)/res
LET Y = y0
FOR v = 1 TO res
  LET u = 0
  LET x0 = x1
  LET dx = (x2-x1)/res
  LET X = x0
  Z = Fxy ' LET z = F1(x,y)
  LET sx0 = 52 + 10*u - INT(2.5*v)
  LET sy0 = 0 + INT(2.5*v) + INT(2.5*u) + INT(zoom*Z)
 
  LET Y = Y+dy
 
  FOR u = 1 TO res
    LET X = X+dx
   
    Z = Fxy ' LET z = F(x,y)
   
    LET sx = 52 + 10*u - INT(2.5*v)
    LET sy = 0 + INT(2.5*v) + INT(2.5*u) + INT(zoom*Z)
    ' PLOT sx,sy ' OK
    ' PLOT sx0,sy0: DRAW sx-sx0,sy-sy0 ' OK
    ' DrawLine(sx0,sy0,sx,sy)
    DrawLine( INT (0.5+sx0), INT (0.5+sy0), INT (0.5+sx), INT (0.5+sy) )
   
    LET sx0 = sx
    LET sy0 = sy
    IF INKEY$ <> "" THEN u = res
  NEXT u : REM for x
 
  IF INKEY$ <> "" THEN v = res
NEXT v : REM for y
END PROCEDURE

PROCEDURE WaitKey
PRINT AT 0,0;"Press any key to continue"
PAUSE(0)
END PROCEDURE

PROCEDURE ShowMenu
CLS
PRINT "MENU"
PRINT
PRINT "0 - Input function"
PRINT "1 - 9/(1+8*x*x+8*y*y)"
PRINT "2 - 9/(1+x*x*8+y*y*8)+0.25*COS(x*8+y*8)"
PRINT "3 - -9/(1+8*x*x+8*y*y)"
PRINT "4 - 1*SIN(x*y*6)/(x*y*6+1.3E-5)"
PRINT "5 - 1.2*INT(3*(SIN(x*3)*SIN(x*3))*SIN(x*3)*(SIN(y*3)*SIN(y*3))*SIN(y*3))"
PRINT "6 - SIN(x*3)*SIN(y*3)"
PRINT "7 - INT(9/(1+8*x*x+8*y*y))"
PRINT "8 - 15*(x+y)*EXP((-x*x*3-y*y*3))"
PRINT "9 - 7*COS(SQR(x*x*64+y*y*64))/(1+x*x*16+y*y*16)"
PRINT "Q - Quit"
PRINT
PRINT "Your command: "
END PROCEDURE

PROCEDURE ReadOption
LET TheEnd = FALSE
REPEAT
  REPEAT
    PAUSE(50)
    LET k$ = INKEY$
  UNTIL k$ <> ""
UNTIL (k$ >= "0" AND k$ <= "9") OR (k$ = "q")
IF k$ = "q" THEN LET TheEnd = TRUE
IF k$ <> "q" THEN LET nfunc = VAL(k$) ' : LET Fxy = VAL ("F"+STR$ nfunc)
IF nfunc = 0 THEN PRINT ,,"Only X and Y accepted.","You cannot use functions.","F(x,y)= "; : G$ = INPUT(80)
END PROCEDURE

PROCEDURE DefineFirstGraph
LET nfunc = 1
' LET Fxy = VAL ("F"+STR$ nfunc)
LET x1 = -PI/2: LET y1 = -PI/2
LET x2 = PI/2: LET y2 = PI/2
END PROCEDURE

PROGRAM ViewFxy
PRINT AT 23,0;"Pascalated Boriel ZX BASIC demo";
PAUSE 1*50
DefineFirstGraph
REPEAT
  ShowGraph
  WaitKey
  ShowMenu
  ReadOption
UNTIL TheEnd
PRINT AT 21,10;INK 2;"The End"
END PROGRAM
Reply


Forum Jump:


Users browsing this thread: 2 Guest(s)