path$=CHR$(GEMDOS(25)+65)+":"+DIR$(0)+"\"
img_path$=path$
@start
@load_usual
@load_cste
@load_pref
@main
EDIT
DEFFN x(float)=MAX(MIN(float*scalex+offset_x,crstack(0)),-1)
DEFFN y(float)=MAX(MIN(-float*scaley+offset_y,crstack(1)),-1)
DEFFN tst_z(q)=INT(q)=q
DEFFN tst_zm(q)=FRAC(q)==1 AND INT(q)==q-1
> PROCEDURE start
  DIM rstack(200)
  DIM istack(200)
RETURN
> PROCEDURE main
  HIDEM
  CLS
  PRINT "v		Mathari v 1.00á for ATARI Computers ."
  PRINT "			A Removers production"
  PRINT "		      Coded by : Stabylo & Seb."
  PRINT
  SELECT RANDOM(4)
  CASE 0
    PRINT "Axiome 1 : Faites en sorte de ne jamais avoir de regrets ."
  CASE 1
    PRINT "Axiome 2 : Votre salut passe par la connaissance du cours ."
  CASE 2
    PRINT "Axiome 3 : Tout germe d'id‚e m‚rite une r‚compense ."
  CASE 3
    PRINT "Axiome 4 : Le sup est rieur mais le sp‚ chiale ."
  ENDSELECT
  PRINT
  @help
  @direct
  SHOWM
RETURN
> PROCEDURE load_usual
  LOCAL n&
  LOCAL n$
  RESTORE usual_fnc
  nb_fnc&=0
  nb_user&=26
  nb_used&=0
  DO
    READ n$
    EXIT IF n$="*FIN"
    INC nb_fnc&
  LOOP
  IF DIM?(fnc_name$())
    ERASE fnc_name$()
  ENDIF
  DIM fnc_name$(nb_fnc&+nb_user&-1)
  DIM fnc_expr$(nb_user&-1)
  DIM fnc_rpn$(nb_user&-1)
  RESTORE usual_fnc
  FOR n&=1 TO nb_fnc&
    READ fnc_name$(n&-1)
    fnc_name$(n&-1)=UPPER$(fnc_name$(n&-1))
  NEXT n&
usual_fnc:
  DATA sqrt
  DATA abs
  DATA exp,ln
  DATA sin,cos,tan,sh,ch,th
  DATA Arcsin,Arccos,Arctan,Argsh,Argch,Argth
  DATA E
  DATA â
  DATA inv
  DATA Re,Im,Arg,Conj
  DATA Rand,Random
  DATA A,C
  DATA *FIN
RETURN
> PROCEDURE load_cste
  LOCAL n&
  LOCAL n$
  RESTORE int_cste
  nb_cste&=0
  nb_cuser&=26
  nb_cused&=0
  DO
    READ n$
    EXIT IF n$="*FIN"
    INC nb_cste&
  LOOP
  IF DIM?(cste_name$())
    ERASE cste_name$()
  ENDIF
  DIM cste_name$(nb_cste&+nb_cuser&-1)
  DIM crstack(nb_cste&+nb_cuser&-1)
  DIM cistack(nb_cste&+nb_cuser&-1)
  RESTORE int_cste
  FOR n&=1 TO nb_cste&
    READ cste_name$(n&-1)
    cste_name$(n&-1)=UPPER$(cste_name$(n&-1))
  NEXT n&
  @init_cste
int_cste:
  DATA xdim,ydim
  DATA Xmin,Xmax,Sclx
  DATA Ymin,Ymax,Scly
  DATA tmin,tmax
  DATA point,connect,oscillo
  DATA *FIN
RETURN
> PROCEDURE init_cste
  LOCAL n&
  LOCAL n$
  LOCAL r,i
  RESTORE default
  DO
    READ n$
    EXIT IF n$="*FIN"
    READ r
    READ i
    n&=@search_cste(n$)
    IF n&<>-1
      crstack(n&)=r
      cistack(n&)=i
    ENDIF
  LOOP
default:
  DATA xdim,640,0
  DATA ydim,480,0
  DATA xmin,-10,0
  DATA xmax,10,0
  DATA sclx,1,0
  DATA ymin,-10,0
  DATA ymax,10,0
  DATA scly,1,0
  DATA tmin,-10,0
  DATA tmax,10,0
  DATA point,640,0
  DATA connect,1,0
  DATA oscillo,0,0
  DATA *FIN
RETURN
> PROCEDURE load_pref
  LOCAL xmin$,xmax$,sclx$
  LOCAL ymin$,ymax$,scly$
  LOCAL tmin$,tmax$
  LOCAL count&
  hx2!=FALSE
  IF EXIST(path$+"MATHARI.INF")
    OPEN "i",#1,path$+"MATHARI.INF"
    crstack(@search_cste("xdim"))=CVI(INPUT$(2,#1))
    crstack(@search_cste("ydim"))=CVI(INPUT$(2,#1))
    crstack(@search_cste("oscillo"))=CVI(INPUT$(2,#1))
    crstack(@search_cste("connect"))=CVI(INPUT$(2,#1))
    nb_used&=CVI(INPUT$(2,#1))
    nb_cused&=CVI(INPUT$(2,#1))
    hx2!=CVI(INPUT$(2,#1))
    crstack(@search_cste("point"))=CVI(INPUT$(2,#1))
    RELSEEK #1,2
    LINE INPUT #1,xmin$
    LINE INPUT #1,xmax$
    LINE INPUT #1,ymin$
    LINE INPUT #1,ymax$
    LINE INPUT #1,sclx$
    LINE INPUT #1,scly$
    LINE INPUT #1,tmin$
    LINE INPUT #1,tmax$
    FOR count&=0 TO nb_used&-1
      LINE INPUT #1,fnc_name$(nb_fnc&+count&)
      LINE INPUT #1,fnc_expr$(count&)
    NEXT count&
    FOR count&=0 TO nb_cused&-1
      LINE INPUT #1,cste_name$(nb_cste&+count&)
      crstack(nb_cste&+count&)=CVD(INPUT$(8,#1))
      cistack(nb_cste&+count&)=CVD(INPUT$(8,#1))
      RELSEEK #1,2
    NEXT count&
    CLOSE #1
    @evaluate(xmin$,0)
    crstack(@search_cste("xmin"))=rstack(0)
    @evaluate(xmax$,0)
    crstack(@search_cste("xmax"))=rstack(0)
    @evaluate(ymin$,0)
    crstack(@search_cste("ymin"))=rstack(0)
    @evaluate(ymax$,0)
    crstack(@search_cste("ymax"))=rstack(0)
    @evaluate(sclx$,0)
    crstack(@search_cste("sclx"))=ABS(rstack(0))
    @evaluate(scly$,0)
    crstack(@search_cste("scly"))=ABS(rstack(0))
    @evaluate(tmin$,0)
    crstack(@search_cste("tmin"))=rstack(0)
    @evaluate(tmax$,0)
    crstack(@search_cste("tmax"))=rstack(0)
  ENDIF
  @convert_all_fnc
RETURN
> PROCEDURE save_pref
  LOCAL count&
  OPEN "o",#1,path$+"MATHARI.INF"
  PRINT #1,MKI$(crstack(@search_cste("xdim")));
  PRINT #1,MKI$(crstack(@search_cste("ydim")));
  PRINT #1,MKI$(crstack(@search_cste("oscillo")));
  PRINT #1,MKI$(crstack(@search_cste("connect")));
  PRINT #1,MKI$(nb_used&);
  PRINT #1,MKI$(nb_cused&);
  PRINT #1,MKI$(kx2!);
  PRINT #1,MKI$(crstack(@search_cste("point")))
  PRINT #1,@qpisqrt$(crstack(@search_cste("xmin")))
  PRINT #1,@qpisqrt$(crstack(@search_cste("xmax")))
  PRINT #1,@qpisqrt$(crstack(@search_cste("ymin")))
  PRINT #1,@qpisqrt$(crstack(@search_cste("ymax")))
  PRINT #1,@qpisqrt$(crstack(@search_cste("sclx")))
  PRINT #1,@qpisqrt$(crstack(@search_cste("scly")))
  PRINT #1,@qpisqrt$(crstack(@search_cste("tmin")))
  PRINT #1,@qpisqrt$(crstack(@search_cste("tmax")))
  FOR count&=0 TO nb_used&-1
    PRINT #1,fnc_name$(nb_fnc&+count&)
    PRINT #1,fnc_expr$(count&)
  NEXT count&
  FOR count&=0 TO nb_cused&-1
    PRINT #1,cste_name$(nb_cste&+count&)
    PRINT #1,MKD$(crstack(nb_cste&+count&));
    PRINT #1,MKD$(cistack(nb_cste&+count&))
  NEXT count&
  CLOSE #1
RETURN
> PROCEDURE snapshot_mono
  LOCAL nom_img$,pos&,w&,h&,adr%
  IF WORK_OUT(13)=2 AND crstack(0)=640 AND crstack(1)=400
    SHOWM
    FILESELECT img_path$+"*.PIC","",nom_img$
    IF nom_img$<>""
      pos&=RINSTR(nom_img$,"\")
      img_path$=LEFT$(nom_img$,pos&)
      w&=(WORK_OUT(0)+1)/8
      adr%=LPEEK(&H44E)
      IF NOT hx2!
        GRAPHMODE 3
        DEFTEXT 1,,,6
        TEXT 500,394,"Made with Mathari"
        GRAPHMODE 1
      ENDIF
      OPEN "o",#1,nom_img$
      FOR h&=0 TO 399
        BPUT #1,adr%+h&*w&,80
      NEXT h&
      CLOSE #1
      IF NOT hx2!
        GRAPHMODE 3
        DEFTEXT 1,,,6
        TEXT 500,394,"Made with Mathari"
        GRAPHMODE 1
      ENDIF
    ENDIF
    HIDEM
  ENDIF
RETURN
> PROCEDURE evaluate(string$,niveau&)
  LOCAL erreur!
  @eval_rpn(@convert_to_rpn$(string$,niveau&,""),erreur!)
RETURN
> FUNCTION qpisqrt$(float)
LOCAL result$
LOCAL n,d,q
LOCAL e,p,boolean!
result$=STR$(float)
IF float<>0 AND INT(float)<>float
  q=float^2
  IF @tst_z(q) OR @tst_zm(q) OR (@tst_z(1/q) OR @tst_zm(1/q) AND q>0.001)
    IF @tst_z(1/q) OR @tst_zm(1/q)
      boolean!=TRUE
      IF @tst_zm(1/q)
        q=INT(1/q)+1
      ELSE
        q=INT(1/q)
      ENDIF
    ENDIF
    IF @tst_zm(q)
      q=INT(q)+1
    ELSE
      q=INT(q)
    ENDIF
    e=INT(SQR(q))
    n=1
    WHILE e>1
      p=e^2
      d=q/p
      IF INT(d)=d
        q=d
        n=n*e
        e=INT(SQR(INT(SQR(q))))
      ENDIF
      DEC e
    WEND
    IF boolean!
      result$=STR$(SGN(float)*1)+"/"
      IF n<>1
        result$=result$+STR$(n)
        IF q<>1
          result$=result$+"*"
        ENDIF
      ELSE
        IF q=1
          result$=result$+"1"
        ENDIF
      ENDIF
    ELSE
      result$=""
      IF n<>1
        result$=STR$(SGN(float)*n)
        IF q<>1
          result$=result$+"*"
        ENDIF
      ELSE
        IF q=1
          result$=result$+"1"
        ELSE
          IF SGN(float)=-1
            result$="-"
          ENDIF
        ENDIF
      ENDIF
    ENDIF
    IF q<>1
      result$=result$+"û"+STR$(q)
    ENDIF
  ELSE
    q=ABS(float/PI)
    IF @tst_z(q) OR @tst_zm(q)
      IF @tst_zm(q)
        q=INT(q)+1
      ELSE
        q=INT(q)
      ENDIF
      result$=""
      IF q<>1
        result$=STR$(SGN(float)*q)+"*"
      ELSE
        IF SGN(float)=-1
          result$="-"
        ENDIF
      ENDIF
      result$=result$+"ã"
    ENDIF
  ENDIF
ENDIF
RETURN result$
ENDFUNC
> FUNCTION search_usual(string$)
LOCAL n&,num&
num&=-1
string$=UPPER$(string$)
FOR n&=0 TO nb_fnc&-1+nb_used&
IF string$=fnc_name$(n&)
  num&=n&
ENDIF
EXIT IF num&<>-1
NEXT n&
RETURN num&
ENDFUNC
> FUNCTION search_cste(string$)
LOCAL n&,num&
num&=-1
string$=UPPER$(string$)
FOR n&=0 TO nb_cste&-1+nb_cused&
IF string$=cste_name$(n&)
num&=n&
ENDIF
EXIT IF num&<>-1
NEXT n&
RETURN num&
ENDFUNC
> FUNCTION convert_to_rpn$(string$,niveau&,what$)
LOCAL level&,length&,count&,max_level&
LOCAL signe|,signe$,sgn$
LOCAL char$
LOCAL val
LOCAL logic!
LOCAL num&
LOCAL rpn$,r1$,r2$,r3$
LOCAL fmin&,fmax&,fstep&
level&=level&+niveau&
IF what$=""
what$="!"   ! variable par d‚faut
ENDIF
string$=TRIM$(string$)
length&=LEN(string$)
IF length&=0
RETURN CHR$(0)
ENDIF
signe$="$:ª|&=<>óò+-*/ûýþ^@"
FOR signe|=1 TO LEN(signe$)
SELECT MID$(signe$,signe|,1)
CASE "û","@","ª","ý","þ",":","$"
fmin&=1
fmax&=length&
fstep&=1
DEFAULT
fmin&=length&
fmax&=1
fstep&=-1
ENDSELECT
FOR count&=fmin& TO fmax& STEP fstep&
char$=MID$(string$,count&,1)
max_level&=MAX(max_level&,level&)
IF char$=CHR$(40-(fstep&=-1))       ! ( ou ) suivant le sens du For Next
INC level&
ELSE IF char$=CHR$(40-(fstep&=1))   ! ) ou ( idem
DEC level&
ELSE IF char$=MID$(signe$,signe|,1)
IF level&<=niveau&
  SELECT char$
  CASE "+","-","*","/","^","=","<",">","ó","ò","&","|",":","$"
    r1$=@convert_to_rpn$(LEFT$(string$,count&-1),level&+1,what$)
    r2$=@convert_to_rpn$(MID$(string$,count&+1,length&-count&+1),level&+1,what$)
  CASE "û","@","ª"
    r2$=@convert_to_rpn$(MID$(string$,count&+1,length&-count&+1),level&+1,what$)
  CASE "ý","þ"
    r1$=@convert_to_rpn$(LEFT$(string$,count&-1),level&+1,what$)
  ENDSELECT
  SELECT char$
  CASE "+"
    ' +
    rpn$=r1$+r2$+"
"
  CASE "-"
    ' -
    rpn$=r1$+r2$+""
  CASE "*"
    ' *
    rpn$=r1$+r2$+""
  CASE "/"
    ' /
    rpn$=r1$+r2$+""
  CASE "û"
    ' û
    rpn$=r2$+""
  CASE "^"
    ' ^
    rpn$=r1$+r2$+""
  CASE "@"
    ' @
    num&=@search_usual(LEFT$(string$,count&-1))
    IF num&=-1
      rpn$=@convert_to_rpn$(LEFT$(string$,count&-1),0,r2$)
    ELSE
      rpn$=r2$+CHR$(100+num&)
    ENDIF
  CASE "="
    ' =
    rpn$=r1$+r2$+""
  CASE "<"
    ' <
    rpn$=r1$+r2$+""
  CASE ">"
    ' >
    rpn$=r1$+r2$+"	"
  CASE "ó"
    ' ó
    rpn$=r1$+r2$+""
  CASE "ò"
    ' ò
    rpn$=r1$+r2$+""
  CASE "&"
    ' AND
    rpn$=r1$+r2$+""
  CASE "|"
    ' OR
    rpn$=r1$+r2$+""
  CASE "ª"
    ' NOT
    rpn$=r2$+""
  CASE "ý"
    ' ý
    rpn$=r1$+""
  CASE "þ"
    ' þ
    rpn$=r1$+""
  CASE ":"
    ' :
    rpn$=r2$+""+r1$
  CASE "$"
    ' $
    rpn$=r1$+""+"("+r2$+")"
  ENDSELECT
  logic!=TRUE
ENDIF
ENDIF
EXIT IF logic!
NEXT count&
EXIT IF logic!
NEXT signe|
IF logic!=FALSE
IF niveau&<max_level&
count&=INSTR(string$,"(")
r1$=@convert_to_rpn$(MID$(string$,count&+1,length&-count&-1),niveau&+1,what$)
IF count&>1
num&=@search_usual(LEFT$(string$,count&-1))
rpn$=r1$+CHR$(100+num&)
ELSE
rpn$=r1$
ENDIF
ELSE
IF UPPER$(string$)="T"
' la variable
rpn$=what$
ELSE
val=VAL(string$)
IF val<>0
  rpn$="'"+STR$(val)+"'"
ELSE
  IF LEFT$(string$,1)="0"
    rpn$="'0'"
  ENDIF
ENDIF
IF UPPER$(string$)="PI" OR string$="ã"
  ' Pi
  rpn$="#"
ELSE IF string$="e"
  ' e
  rpn$="$"
ELSE IF string$="i"
  ' i
  rpn$="%"
ELSE IF string$="«"
  ' «
  rpn$="("
ELSE IF string$="¬"
  ' ¬
  rpn$=")"
ELSE
  num&=@search_cste(string$)
  IF num&<>-1
    rpn$=CHR$(200+num&)
  ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
RETURN rpn$
ENDFUNC
> PROCEDURE eval_rpn(rpn$,VAR error!)
LOCAL length&,count&
LOCAL code|
LOCAL pos&,nb&,count2&
LOCAL for&,to&
LOCAL string$
LOCAL r1,r2
LOCAL i1,i2
LOCAL x,y,m,a,a1,a2
LOCAL r,i
r=rstack(0)
i=istack(0)
DELETE rstack(0)
DELETE istack(0)
error!=FALSE
length&=LEN(rpn$)
FOR count&=1 TO length&
code|=ASC(MID$(rpn$,count&,1))
SELECT code|
CASE 0
INSERT rstack(0)=0
INSERT istack(0)=0
CASE 1      ! 

' +
rstack(0)=rstack(1)+rstack(0)
istack(0)=istack(1)+istack(0)
DELETE rstack(1)
DELETE istack(1)
CASE 2      ! 
' -
rstack(0)=rstack(1)-rstack(0)
istack(0)=istack(1)-istack(0)
DELETE rstack(1)
DELETE istack(1)
CASE 3      ! 
' *
x=rstack(0)
y=istack(0)
rstack(0)=x*rstack(1)-y*istack(1)
istack(0)=x*istack(1)+rstack(1)*y
DELETE rstack(1)
DELETE istack(1)
CASE 4      ! 
' /
x=rstack(0)
y=istack(0)
IF x<>0 OR y<>0
m=x^2+y^2
rstack(0)=(rstack(1)*x+istack(1)*y)/m
istack(0)=(istack(1)*x-rstack(1)*y)/m
DELETE rstack(1)
DELETE istack(1)
ELSE
error!=TRUE
ENDIF
CASE 5      ! 
' û
x=rstack(0)
y=istack(0)
IF x>0 OR y<>0
m=SQR(x^2+y^2)
rstack(0)=SQR((x+m)/2)
istack(0)=y/SQR(2*(x+m))
ELSE
rstack(0)=0
istack(0)=SQR(-x)
ENDIF
CASE 6      ! 
' ^
x=rstack(1)
y=istack(1)
IF x<>0 OR y<>0
m=SQR(x^2+y^2)
a1=ACOS(MIN(MAX(x/m,-1),1))
a2=ASIN(MIN(MAX(y/m,-1),1))
IF SGN(a1*a2)=-1
  IF a1==-a2
    a=a2
  ELSE IF a1==PI+a2
    a=-a1
  ENDIF
ELSE
  IF a1==a2
    a=a1
  ELSE IF a1==PI-a2
    a=a1
  ENDIF
ENDIF
r1=rstack(0)
i1=istack(0)
r2=LOG(m)
i2=a
x=r1*r2-i1*i2
y=i1*r2+r1*i2
rstack(0)=EXP(x)*COS(y)
istack(0)=EXP(x)*SIN(y)
DELETE rstack(1)
DELETE istack(1)
ELSE
r1=rstack(0)
i1=istack(0)
IF r1>=0 AND i1=0
  IF r1=0
    rstack(0)=1
    istack(0)=0
  ELSE
    rstack(0)=0
    istack(0)=0
  ENDIF
  DELETE rstack(1)
  DELETE istack(1)
ELSE
  error!=TRUE
ENDIF
ENDIF
CASE 7      ! 
' =
IF rstack(0)==rstack(1) AND istack(0)==istack(1)
rstack(0)=1
istack(0)=0
ELSE
rstack(0)=0
istack(0)=0
ENDIF
DELETE rstack(1)
DELETE istack(1)
CASE 8      ! 
' <
r2=rstack(0)
i2=istack(0)
r1=rstack(1)
i1=istack(1)
IF r1<r2
rstack(0)=1
istack(0)=0
ELSE
IF r1==r2 AND i1<i2
  rstack(0)=1
  istack(0)=0
ELSE
  rstack(0)=0
  istack(0)=0
ENDIF
ENDIF
DELETE rstack(1)
DELETE istack(1)
CASE 9      ! 	
' >
r2=rstack(0)
i2=istack(0)
r1=rstack(1)
i1=istack(1)
IF r1>r2
rstack(0)=1
istack(0)=0
ELSE
IF r1==r2 AND i1>i2
  rstack(0)=1
  istack(0)=0
ELSE
  rstack(0)=0
  istack(0)=0
ENDIF
ENDIF
DELETE rstack(1)
DELETE istack(1)
CASE 11     ! 
' ó
r2=rstack(0)
i2=istack(0)
r1=rstack(1)
i1=istack(1)
IF r1=<r2
rstack(0)=1
istack(0)=0
ELSE
IF r1==r2 AND i1=<i2
  rstack(0)=1
  istack(0)=0
ELSE
  rstack(0)=0
  istack(0)=0
ENDIF
ENDIF
DELETE rstack(1)
DELETE istack(1)
CASE 12     ! 
' ò
r2=rstack(0)
i2=istack(0)
r1=rstack(1)
i1=istack(1)
IF r1>=r2
rstack(0)=1
istack(0)=0
ELSE
IF r1==r2 AND i1>=i2
  rstack(0)=1
  istack(0)=0
ELSE
  rstack(0)=0
  istack(0)=0
ENDIF
ENDIF
DELETE rstack(1)
DELETE istack(1)
CASE 14     ! 
' & ( AND )
IF (rstack(0)=1 AND rstack(1)=1) AND (istack(0)=0 AND istack(1)=0)
rstack(0)=1
istack(0)=0
ELSE
rstack(0)=0
istack(0)=0
ENDIF
DELETE rstack(1)
DELETE istack(1)
CASE 15     ! 
' | ( OR )
IF (rstack(0)=1 OR rstack(1)=1) AND (istack(0)=0 AND istack(1)=0)
rstack(0)=1
istack(0)=0
ELSE
rstack(0)=0
istack(0)=0
ENDIF
DELETE rstack(1)
DELETE istack(1)
CASE 16     ! 
' ª ( NOT )
IF (rstack(0)=0 OR rstack(0)=1) AND istack(0)=0
rstack(0)=1-rstack(0)
istack(0)=0
ELSE
rstack(0)=0
istack(0)=0
ENDIF
CASE 17     ! 
' ý
x=rstack(0)
y=istack(0)
rstack(0)=x^2-y^2
istack(0)=2*x*y
CASE 18     ! 
' þ
x=rstack(0)
y=istack(0)
rstack(0)=x^3-3*x*y^2
istack(0)=3*x^2*y-y^3
CASE 19     ! 
code|=ASC(MID$(rpn$,count&+1,1))
IF code|>=200 AND code|<=200+nb_cste&+nb_cuser&-1
SUB code|,200
crstack(code|)=rstack(0)
cistack(code|)=istack(0)
INC count&
ENDIF
CASE 20     ! 
ADD count&,2
count2&=count&
nb&=1
WHILE nb&>0
SELECT MID$(rpn$,count2&,1)
CASE "("
  INC nb&
CASE ")"
  DEC nb&
ENDSELECT
INC count2&
WEND
DEC count2&
nb&=count2&-count&
string$=MID$(rpn$,count&,nb&)
to&=MAX(INT(ABS(rstack(0))),1)
FOR for&=1 TO to&
rstack(0)=r
istack(0)=i
@eval_rpn(string$,error!)
NEXT for&
count&=count2&
CASE 33     ! !
' la variable ( complexe )
INSERT rstack(0)=r
INSERT istack(0)=i
CASE 35     ! #
' ã
INSERT rstack(0)=PI
INSERT istack(0)=0
CASE 36     ! $
' e
INSERT rstack(0)=EXP(1)
INSERT istack(0)=0
CASE 37     ! %
' i
INSERT rstack(0)=0
INSERT istack(0)=1
CASE 39     ! '
' un r‚el
pos&=INSTR(rpn$,"'",count&+1)
IF pos&>0
INSERT rstack(0)=VAL(MID$(rpn$,count&+1,pos&-count&-1))
INSERT istack(0)=0
count&=pos&
ENDIF
CASE 40     ! (
' (
INSERT rstack(0)=1/2
INSERT istack(0)=0
CASE 41     ! )
' )
INSERT rstack(0)=1/4
INSERT istack(0)=0
CASE 99
' fonction inconnue
error!=TRUE
CASE 100
' sqrt
x=rstack(0)
y=istack(0)
IF x>0 OR y<>0
m=SQR(x^2+y^2)
rstack(0)=SQR((x+m)/2)
istack(0)=y/SQR(2*(x+m))
ELSE
rstack(0)=0
istack(0)=SQR(-x)
ENDIF
CASE 101
' abs ( module )
rstack(0)=SQR(rstack(0)^2+istack(0)^2)
istack(0)=0
CASE 102
' exp
x=rstack(0)
y=istack(0)
rstack(0)=EXP(x)*COS(y)
istack(0)=EXP(x)*SIN(y)
CASE 103
' ln
x=rstack(0)
y=istack(0)
IF x<>0 OR y<>0
m=SQR(x^2+y^2)
a1=ACOS(MIN(MAX(x/m,-1),1))
a2=ASIN(MIN(MAX(y/m,-1),1))
IF SGN(a1*a2)=-1
  IF a1==-a2
    a=a2
  ELSE IF a1==PI+a2
    a=-a1
  ENDIF
ELSE
  IF a1==a2
    a=a1
  ELSE IF a1==PI-a2
    a=a1
  ENDIF
ENDIF
rstack(0)=LOG(m)
istack(0)=a
ELSE
error!=TRUE
ENDIF
CASE 104
' sin
x=-istack(0)
y=rstack(0)
rstack(0)=SIN(y)*(EXP(x)+EXP(-x))/2
istack(0)=-COS(y)*(EXP(x)-EXP(-x))/2
CASE 105
' cos
x=-istack(0)
y=rstack(0)
rstack(0)=COS(y)*(EXP(x)+EXP(-x))/2
istack(0)=SIN(y)*(EXP(x)-EXP(-x))/2
CASE 106
' tan
x=-istack(0)
y=rstack(0)
IF COS(y)<>0
r1=SIN(y)*(EXP(x)+EXP(-x))/2
i1=-COS(y)*(EXP(x)-EXP(-x))/2
r2=COS(y)*(EXP(x)+EXP(-x))/2
i2=SIN(y)*(EXP(x)-EXP(-x))/2
m=r2^2+i2^2
rstack(0)=(r1*r2+i1*i2)/m
istack(0)=(i1*r2-r1*i2)/m
ELSE
error!=TRUE
ENDIF
CASE 107
' sh
x=rstack(0)
y=istack(0)
rstack(0)=COS(y)*(EXP(x)-EXP(-x))/2
istack(0)=SIN(y)*(EXP(x)+EXP(-x))/2
CASE 108
' ch
x=rstack(0)
y=istack(0)
rstack(0)=COS(y)*(EXP(x)+EXP(-x))/2
istack(0)=SIN(y)*(EXP(x)-EXP(-x))/2
CASE 109
' th
x=rstack(0)
y=istack(0)
IF COS(y)<>0
r1=COS(y)*(EXP(x)-EXP(-x))/2
i1=SIN(y)*(EXP(x)+EXP(-x))/2
r2=COS(y)*(EXP(x)+EXP(-x))/2
i2=SIN(y)*(EXP(x)-EXP(-x))/2
m=r2^2+i2^2
rstack(0)=(r1*r2+i1*i2)/m
istack(0)=(i1*r2-r1*i2)/m
ELSE
error!=TRUE
ENDIF
CASE 110
' Arcsin
r1=rstack(0)
i1=istack(0)
r2=1-r1^2+i1^2
i2=-2*r1*i1
IF r2>0 OR i2<>0
m=SQR(r2^2+i2^2)
x=SQR((r2+m)/2)
y=i2/SQR(2*(r2+m))
ELSE
x=0
y=SQR(-r2)
ENDIF
x=x-i1
y=y+r1
m=SQR(x^2+y^2)
a1=ACOS(MIN(MAX(x/m,-1),1))
a2=ASIN(MIN(MAX(y/m,-1),1))
IF SGN(a1*a2)=-1
IF a1==-a2
  a=a2
ELSE IF a1==PI+a2
  a=-a1
ENDIF
ELSE
IF a1==a2
  a=a1
ELSE IF a1==PI-a2
  a=a1
ENDIF
ENDIF
rstack(0)=a
istack(0)=-LOG(m)
CASE 111
' Arccos
r1=rstack(0)
i1=istack(0)
r2=r1^2-i1^2-1
i2=2*r1*i1
IF r2>0 OR i2<>0
m=SQR(r2^2+i2^2)
x=SQR((r2+m)/2)
y=i2/SQR(2*(r2+m))
ELSE
x=0
y=SQR(-r2)
ENDIF
x=x+r1
y=y+i1
m=SQR(x^2+y^2)
a1=ACOS(MIN(MAX(x/m,-1),1))
a2=ASIN(MIN(MAX(y/m,-1),1))
IF SGN(a1*a2)=-1
IF a1==-a2
  a=a2
ELSE IF a1==PI+a2
  a=-a1
ENDIF
ELSE
IF a1==a2
  a=a1
ELSE IF a1==PI-a2
  a=a1
ENDIF
ENDIF
rstack(0)=a
istack(0)=-LOG(m)
CASE 112
' Arctan
r1=rstack(0)
i1=istack(0)
IF (i1<>1 OR r1<>0) AND (i1<>-1 OR r1<>0)
r2=1+i1
i2=-r1
r1=1-i1
i1=-i2
m=r2^2+i2^2
x=(r1*r2+i1*i2)/m
y=(i1*r2-r1*i2)/m
m=SQR(x^2+y^2)
a1=ACOS(MIN(MAX(x/m,-1),1))
a2=ASIN(MIN(MAX(y/m,-1),1))
IF SGN(a1*a2)=-1
  IF a1==-a2
    a=a2
  ELSE IF a1==PI+a2
    a=-a1
  ENDIF
ELSE
  IF a1==a2
    a=a1
  ELSE IF a1==PI-a2
    a=a1
  ENDIF
ENDIF
rstack(0)=a/2
istack(0)=-LOG(m)/2
ELSE
error!=TRUE
ENDIF
CASE 113
' Argsh
r1=rstack(0)
i1=istack(0)
r2=r1^2-i1^2+1
i2=2*r1*i1
IF r2>0 OR i2<>0
m=SQR(r2^2+i2^2)
x=SQR((r2+m)/2)
y=i2/SQR(2*(r2+m))
ELSE
x=0
y=SQR(-r2)
ENDIF
x=x+r1
y=y+i1
m=SQR(x^2+y^2)
a1=ACOS(MIN(MAX(x/m,-1),1))
a2=ASIN(MIN(MAX(y/m,-1),1))
IF SGN(a1*a2)=-1
IF a1==-a2
  a=a2
ELSE IF a1==PI+a2
  a=-a1
ENDIF
ELSE
IF a1==a2
  a=a1
ELSE IF a1==PI-a2
  a=a1
ENDIF
ENDIF
rstack(0)=LOG(m)
istack(0)=a
CASE 114
' Argch
r1=rstack(0)
i1=istack(0)
r2=r1^2-i1^2-1
i2=2*r1*i1
IF r2>0 OR i2<>0
m=SQR(r2^2+i2^2)
x=SQR((r2+m)/2)
y=i2/SQR(2*(r2+m))
ELSE
x=0
y=SQR(-r2)
ENDIF
x=x+r1
y=y+i1
m=SQR(x^2+y^2)
a1=ACOS(MIN(MAX(x/m,-1),1))
a2=ASIN(MIN(MAX(y/m,-1),1))
IF SGN(a1*a2)=-1
IF a1==-a2
  a=a2
ELSE IF a1==PI+a2
  a=-a1
ENDIF
ELSE
IF a1==a2
  a=a1
ELSE IF a1==PI-a2
  a=a1
ENDIF
ENDIF
rstack(0)=LOG(m)
istack(0)=a
CASE 115
' Argth
r1=rstack(0)
i1=istack(0)
IF (r1<>1 OR i1<>0) AND (r1<>-1 OR i1<>0)
r2=1-r1
i2=-i1
r1=1+r1
m=r2^2+i2^2
x=(r1*r2+i1*i2)/m
y=(i1*r2-r1*i2)/m
m=SQR(x^2+y^2)
a1=ACOS(MIN(MAX(x/m,-1),1))
a2=ASIN(MIN(MAX(y/m,-1),1))
IF SGN(a1*a2)=-1
  IF a1==-a2
    a=a2
  ELSE IF a1==PI+a2
    a=-a1
  ENDIF
ELSE
  IF a1==a2
    a=a1
  ELSE IF a1==PI-a2
    a=a1
  ENDIF
ENDIF
rstack(0)=LOG(m)/2
istack(0)=a/2
ELSE
error!=TRUE
ENDIF
CASE 116
' Partie entiŠre ( de Re )
rstack(0)=INT(rstack(0))
istack(0)=0
CASE 117
x=rstack(0)
IF INT(x)=x AND x>=0 AND x<400
rstack(0)=FACT(x)
istack(0)=0
ELSE
IF x>-1
  r1=0
  i1=FRAC(x)+1
  r2=MAX(ABS(r3),0.1)
  FOR i2=1.0E-06 TO r2*200+1.0E-06 STEP r2
    r1=r1+r2*i2^i1*EXP(-i2)
  NEXT i2
  r1=r1/i1
  i1=i1-1
  WHILE i1<x
    i1=i1+1
    r1=r1*i1
  WEND
  rstack(0)=r1
  istack(0)=0
ELSE
  IF INT(x)<>x
    r1=0
    i1=FRAC(x)+1
    r2=MAX(ABS(r3),0.1)
    FOR i2=1.0E-06 TO r2*200+1.0E-06 STEP r2
      r1=r1+r2*i2^i1*EXP(-i2)
    NEXT i2
    WHILE i1>x
      r1=r1/i1
      i1=i1-1
    WEND
    rstack(0)=r1
    istack(0)=0
  ELSE
    error!=TRUE
  ENDIF
ENDIF
ENDIF
CASE 118
' Inv
x=rstack(0)
y=istack(0)
IF x<>0 OR y<>0
m=x^2+y^2
rstack(0)=x/m
istack(0)=-y/m
ELSE
error!=TRUE
ENDIF
CASE 119
' Re
istack(0)=0
CASE 120
' Im
rstack(0)=istack(0)
istack(0)=0
CASE 121
' Arg
x=rstack(0)
y=istack(0)
IF x<>0 OR y<>0
m=SQR(x^2+y^2)
a1=ACOS(MIN(MAX(x/m,-1),1))
a2=ASIN(MIN(MAX(y/m,-1),1))
IF SGN(a1*a2)=-1
  IF a1==-a2
    a=a2
  ELSE IF a1==PI+a2
    a=-a1
  ENDIF
ELSE
  IF a1==a2
    a=a1
  ELSE IF a1==PI-a2
    a=a1
  ENDIF
ENDIF
rstack(0)=a
istack(0)=0
ELSE
error!=TRUE
ENDIF
CASE 122
' Conjugu‚
istack(0)=-istack(0)
CASE 123
' Rand
rstack(0)=RAND(rstack(0))
istack(0)=RAND(istack(0))
CASE 124
' Random
rstack(0)=RANDOM(rstack(0))
istack(0)=RANDOM(istack(0))
CASE 125
' A
r1=INT(ABS(rstack(0)))
i1=INT(ABS(istack(0)))
IF i1<=r1
rstack(0)=FACT(r1)/FACT(r1-i1)
istack(0)=0
ELSE
rstack(0)=0
istack(0)=0
ENDIF
CASE 126
' C
r1=INT(ABS(rstack(0)))
i1=INT(ABS(istack(0)))
IF i1<=r1
rstack(0)=FACT(r1)/(FACT(r1-i1)*FACT(i1))
istack(0)=0
ELSE
rstack(0)=0
istack(0)=0
ENDIF
DEFAULT
IF code|>=100 AND code|<=100+nb_fnc&+nb_user&-1
SUB code|,100+nb_fnc&
@eval_rpn(fnc_rpn$(code|),error!)
ELSE IF code|>=200 AND code|<=200+nb_cste&+nb_cuser&-1
SUB code|,200
INSERT rstack(0)=crstack(code|)
INSERT istack(0)=cistack(code|)
ENDIF
ENDSELECT
EXIT IF error!
NEXT count&
RETURN
> PROCEDURE convert_all_fnc
LOCAL count&
FOR count&=0 TO nb_used&-1
fnc_rpn$(count&)=@convert_to_rpn$(fnc_expr$(count&),0,"")
NEXT count&
RETURN
> PROCEDURE draw_axes
LOCAL d,xg,yg
LOCAL multiple,debut,fin
LOCAL xmin,xmax
LOCAL ymin,ymax
LOCAL xgrad,ygrad
LOCAL xdim&,ydim&
LOCAL oscillo!
xmin=crstack(@search_cste("xmin"))
xmax=crstack(@search_cste("xmax"))
ymin=crstack(@search_cste("ymin"))
ymax=crstack(@search_cste("ymax"))
xdim&=crstack(@search_cste("xdim"))
ydim&=crstack(@search_cste("ydim"))
xgrad=crstack(@search_cste("sclx"))
ygrad=crstack(@search_cste("scly"))
oscillo!=crstack(@search_cste("oscillo"))=1
CLS
d=ABS(xmax-xmin)
IF d<>0
scalex=xdim&/d
ELSE
scalex=1
ENDIF
d=ABS(ymax-ymin)
IF d<>0
scaley=ydim&/d
ELSE
scaley=1
ENDIF
offset_x=-xmin*scalex
offset_y=ydim&+ymin*scaley
IF xgrad>0
multiple=xgrad
WHILE multiple*scalex<1
MUL multiple,10
WEND
debut=INT(xmin/multiple)*multiple
fin=(INT(xmax/multiple)+1)*multiple
FOR xg=debut TO fin STEP multiple
IF oscillo!
DEFLINE 3
LINE @x(xg),0,@x(xg),ydim&
DEFLINE 0
ELSE
LINE @x(xg),-1+offset_y,@x(xg),1+offset_y
ENDIF
NEXT xg
ENDIF
IF ygrad>0
multiple=ygrad
WHILE multiple*scaley<1
MUL multiple,10
WEND
debut=INT(ymin/multiple)*multiple
fin=(INT(ymax/multiple)+1)*multiple
FOR yg=debut TO fin STEP multiple
IF oscillo!
DEFLINE 3
LINE 0,@y(yg),xdim&,@y(yg)
DEFLINE 0
ELSE
LINE -1+offset_x,@y(yg),1+offset_x,@y(yg)
ENDIF
NEXT yg
ENDIF
IF offset_x<=xdim&
LINE offset_x,0,offset_x,ydim&
ENDIF
IF offset_y<=ydim&
LINE 0,offset_y,xdim&,offset_y
ENDIF
RETURN
> PROCEDURE graphe(expression$)
LOCAL t
LOCAL tempo$
LOCAL nondef!,oldnondef!
LOCAL connect!
LOCAL nbpoint%
LOCAL tmin,tmax
tmin=crstack(@search_cste("tmin"))
tmax=crstack(@search_cste("tmax"))
connect!=crstack(@search_cste("connect"))=1
nbpoint%=crstack(@search_cste("point"))
IF tmin>tmax
SWAP tmin,tmax
ENDIF
tempo$=@convert_to_rpn$(expression$,0,"")
rstack(0)=tmin
istack(0)=0
@eval_rpn(tempo$,nondef!)
IF NOT nondef!
PLOT @x(rstack(0)),@y(istack(0))
ENDIF
oldnondef!=nondef!
IF tmin<>tmax
FOR t=tmin TO tmax STEP (tmax-tmin)/nbpoint%
rstack(0)=t
istack(0)=0
@eval_rpn(tempo$,nondef!)
IF NOT nondef!
IF oldnondef!
  PLOT @x(rstack(0)),@y(istack(0))
ELSE
  IF connect!
    DRAW  TO @x(rstack(0)),@y(istack(0))
  ELSE
    PLOT @x(rstack(0)),@y(istack(0))
  ENDIF
ENDIF
ENDIF
oldnondef!=nondef!
NEXT t
ENDIF
RETURN
> PROCEDURE suite(expression$,terme1)
LOCAL nondef!,end!
LOCAL terme,oldterme,oldterme2
LOCAL key$,tempo$
@graphe("t+i*t")
@graphe(expression$)
tempo$=@convert_to_rpn$(expression$,0,"")
WHILE INP?(2)
~INP(2)
WEND
rstack(0)=terme1
istack(0)=0
@eval_rpn(tempo$,nondef!)
oldterme=rstack(0)
terme=istack(0)
LINE @x(oldterme),@y(0),@x(oldterme),@y(terme)
oldterme2=oldterme
oldterme=terme
REPEAT
key$=INKEY$
IF UPPER$(key$)="E"
end!=TRUE
ELSE IF UPPER$(key$)="S"
@snapshot_mono
ELSE
IF key$<>""
rstack(0)=istack(0)
istack(0)=0
@eval_rpn(tempo$,nondef!)
oldterme=rstack(0)
terme=istack(0)
LINE @x(oldterme2),@y(oldterme),@x(oldterme),@y(oldterme)
' Rajouter cette ligne pour tracer jusqu'aux axes
' LINE @x(oldterme),@y(oldterme),@x(oldterme),@y(0)
LINE @x(oldterme),@y(oldterme),@x(oldterme),@y(terme)
oldterme2=oldterme
oldterme=terme
ENDIF
ENDIF
UNTIL end!
RETURN
> PROCEDURE info_mathari
PRINT "		pMathari v 1.00á for ATARI Computersq"
PRINT "			A Removers production"
PRINT "		      Coded by : Stabylo & Seb"
PRINT "		    Une pale imitation de Mapomme"
PRINT
PRINT "Ce programme est avant tout un grapheur de fonctions ."
PRINT "Mais pourquoi faire puisque ma calculatrice peut le faire ?"
PRINT "Tout simplement pour voir les fonctions en plus grand et puis"
PRINT "aussi pour pouvoir les sauver grace … un snapshot quelconque "
PRINT "pour ensuite ‚toffer vos documents d'un zoli graphe de fonction ."
PRINT
PRINT "Si vous ˆtes prof de maths ou mˆme de sciences physiques cela pourra"
PRINT "vous ˆtre trŠs utile pour ‚clairer vos ‚lŠves ."
PRINT
PRINT "Si vous ˆtes ‚tudiant ( comme nous ) alors vous pourrez taper des r‚sum‚s"
PRINT "de votre cours de maths ou physique et pourrez les ‚toffer de graphes ."
PRINT "TrŠs pratique pour r‚viser les colles ..."
PRINT
PRINT "Attention : un graphe n'est en aucun cas une justification ."
PRINT "De plus, Mathari n'est pas … l'abri d'une erreur donc prudence ..."
RETURN
> PROCEDURE show_user
LOCAL nb&
PRINT "Fonctions reconnues par Mathari"
PRINT "pFonctions usuellesq"
FOR nb&=0 TO nb_fnc&-1+nb_used&
IF nb&<nb_fnc&
PRINT fnc_name$(nb&),
ELSE
IF nb&=nb_fnc&
PRINT
PRINT "pFonctions utilisateurq"
ENDIF
IF fnc_name$(nb&)<>""
PRINT fnc_name$(nb&);"(t)=";fnc_expr$(nb&-nb_fnc&)
ENDIF
ENDIF
NEXT nb&
PRINT "jPress a keyk";
~INP(2)
PRINT "Constantes connues de Mathari"
PRINT "pConstantes internesq"
FOR nb&=0 TO nb_cste&-1+nb_cused&
IF nb&<nb_cste&
PRINT cste_name$(nb&),
ELSE
IF nb&=nb_cste&
PRINT
PRINT "pConstantes utilisateurq"
ENDIF
IF cste_name$(nb&)<>""
PRINT cste_name$(nb&),
ELSE
PRINT ,
ENDIF
ENDIF
NEXT nb&
PRINT
RETURN
> PROCEDURE direct
LOCAL exit!,exact!
LOCAL value,ivalue
LOCAL fonction$,cmd$
LOCAL nom$,expr$,rpn$
LOCAL num&,pos&,flag!
value=0
ivalue=0
exact!=FALSE
REPEAT
INPUT "? ",fonction$
fonction$=TRIM$(fonction$)
cmd$=UPPER$(fonction$)
IF cmd$="EXIT"
exit!=TRUE
ELSE IF cmd$="INFO"
@info_mathari
ELSE IF cmd$="PREF"
@show_pref
ELSE IF cmd$="SAVE"
@save_pref
PRINT "Pr‚f‚rences sauv‚es ."
ELSE IF cmd$="LIST"
@show_user
ELSE IF cmd$="PLOT"
@draw_function
ELSE IF cmd$="SUITE"
@draw_suite
ELSE IF cmd$="HELP"
@help
ELSE IF cmd$="CLS"
CLS
ELSE IF cmd$="#"
PRINT value;"+";ivalue;"*i"
ELSE IF cmd$="$"
PRINT @qpisqrt$(value);"+";@qpisqrt$(ivalue);"*i"
ELSE IF cmd$="*"
exact!=NOT exact!
IF exact!
PRINT @qpisqrt$(value);"+";@qpisqrt$(ivalue);"*i"
ELSE
PRINT value;"+";ivalue;"*i"
ENDIF
ELSE IF INSTR(cmd$,":=")<>0
flag!=TRUE
pos&=INSTR(cmd$,":=")
nom$=UPPER$(LEFT$(cmd$,pos&-1))
expr$=RIGHT$(fonction$,LEN(fonction$)-pos&-1)
IF UPPER$(TRIM$(expr$))="NULL"
flag!=FALSE
IF nom$<>""
  num&=@search_usual(nom$)
  IF num&=-1
    num&=@search_cste(nom$)
    IF num&=-1
      PRINT "Suppression impossible !!"
    ELSE
      IF num&<nb_cste&
        PRINT "Une constante interne ne peut ˆtre supprim‚e !!"
      ELSE
        IF nb_cused&>0
          PRINT "Suppression de ";cste_name$(num&)
          DELETE cste_name$(num&)
          DELETE crstack(num&)
          DELETE cistack(num&)
          DEC nb_cused&
        ENDIF
      ENDIF
    ENDIF
  ELSE
    IF num&<nb_fnc&
      PRINT "Une fonction usuelle ne peut ˆtre supprim‚e !!"
    ELSE
      IF nb_used&>0
        PRINT "Suppression de ";fnc_name$(num&)
        DELETE fnc_name$(num&)
        DELETE fnc_expr$(num&-nb_fnc&)
        DELETE fnc_rpn$(num&-nb_fnc&)
        DEC nb_used&
      ENDIF
    ENDIF
  ENDIF
ENDIF
ELSE IF UPPER$(TRIM$(expr$))="NEW"
flag!=FALSE
IF @search_usual(nom$)=-1 AND @search_cste(nom$)=-1
  IF nb_cused&<nb_cuser&
    INC nb_cused&
    cste_name$(nb_cste&+nb_cused&-1)=nom$
    crstack(nb_cste&+nb_cused&-1)=0
    cistack(nb_cste&+nb_cused&-1)=0
    PRINT "Cr‚ation de : ";nom$
  ENDIF
ENDIF
ELSE
rpn$=@convert_to_rpn$(expr$,0,"")
IF nom$<>""
  num&=@search_usual(nom$)
  IF num&=-1
    IF nb_used&<nb_user&
      INC nb_used&
      num&=nb_fnc&+nb_used&-1
      fnc_name$(num&)=nom$
      fnc_expr$(num&-nb_fnc&)=expr$
      fnc_rpn$(num&-nb_fnc&)=rpn$
    ELSE
      PRINT "Suppression automatique de la plus ancienne fonction"
      PRINT fnc_name$(nb_fnc&)'"supprim‚e"
      num&=nb_fnc&+nb_user&-1
      DELETE fnc_name$(nb_fnc&)
      DELETE fnc_expr$(0)
      DELETE fnc_rpn$(0)
      fnc_name$(num&)=nom$
      fnc_expr$(num&-nb_fnc&)=expr$
      fnc_rpn$(num&-nb_fnc&)=rpn$
    ENDIF
  ELSE
    IF num&<nb_fnc&
      PRINT "Une fonction usuelle ne peut ˆtre red‚finie !!"
      flag!=FALSE
    ELSE
      fnc_name$(num&)=nom$
      fnc_expr$(num&-nb_fnc&)=expr$
      fnc_rpn$(num&-nb_fnc&)=rpn$
    ENDIF
  ENDIF
ENDIF
ENDIF
@convert_all_fnc
IF flag!
PRINT "La fonction utilisateur '";fnc_name$(num&);"' a dor‚navant pour expression"
PRINT fnc_name$(num&);"(t)=";fnc_expr$(num&-nb_fnc&)
ENDIF
ELSE
rstack(0)=value
istack(0)=ivalue
@evaluate(fonction$,0)
value=rstack(0)
ivalue=istack(0)
IF exact!
PRINT @qpisqrt$(value);"+";@qpisqrt$(ivalue);"*i"
ELSE
PRINT value;"+";ivalue;"*i"
ENDIF
ENDIF
UNTIL exit!=TRUE
RETURN
> PROCEDURE draw_function
LOCAL all$,fonction$,key$
LOCAL pos&
CLS
PRINT "Tracer une fonction :"
PRINT "Entrez l'expression complexe de la fonction ( variable en 't' )"
PRINT "Abscisse : Partie r‚elle"
PRINT "Ordonn‚e : Partie Imaginaire"
PRINT "(si plusieurs … tracer, s‚parez les par des ';') :"
INPUT "? ",all$
@draw_axes
WHILE LEN(all$)>0
pos&=INSTR(all$,";")
IF pos&=0
fonction$=all$
all$=""
ELSE
fonction$=LEFT$(all$,pos&-1)
all$=RIGHT$(all$,LEN(all$)-pos&)
ENDIF
@graphe(fonction$)
WEND
REPEAT
key$=INKEY$
IF UPPER$(key$)="S"
@snapshot_mono
key$=""
ENDIF
UNTIL key$<>""
CLS
RETURN
> PROCEDURE draw_suite
LOCAL first$,fonction$
CLS
PRINT "Tapez 'E' pour sortir du trac‚"
PRINT "Tracer une suite r‚currente :"
PRINT "Entrez l'expression complexe de la fonction associ‚e ( variable en 't' ) : "
INPUT "? ",fonction$
PRINT "Entrez le premier terme : "
INPUT "? ",first$
@draw_axes
rstack(0)=0
istack(0)=0
@evaluate(first$,0)
@suite(fonction$,rstack(0))
CLS
RETURN
> PROCEDURE hx2
IF hx2!
CLS
PRINT "v		Mathari v 1.00á for ATARI Computers ."
PRINT "			A Removers production"
PRINT "		      Coded by : Stabylo & Seb."
PRINT
PRINT "			     pHidden Screenq"
PRINT
PRINT "Bravo, vous avez enfin trouv‚ l'‚cran cach‚ de Mathari d‚di‚ … la HX2 ..."
PRINT "En fait, … la HX2-200 et suivantes ( en passant bien entendu par la HX2-204 )"
PRINT
PRINT "Si vous avez trouv‚ cet ‚cran, il y plusieurs solutions :"
PRINT "	- soit vous ˆtes Stabylo et ‚videmment Seb dans son infinie bont‚"
PRINT "	vous avait parl‚ de cet ‚cran cach‚ : bonjour Stabylo !!"
PRINT "	- soit vous avez d‚sassembl‚ ce programme afin de virer le message"
PRINT "	s'affichant lors du snapshot : bravo, vous avez r‚ussi !!"
PRINT "	- soit vous avez eu une chance inou‹e en faisant la bonne combinaison"
PRINT "	de touches : pourquoi ne joueriez-vous pas au Loto ??"
PRINT "	- soit vous ˆtes un ancien ( ou mˆme un actuel ) de la HX2 dont il est"
PRINT "	question, voire carr‚ment un IU, et vous vous ˆtes dit que le nombre"
PRINT "	premier f‚tiche de la HX2 ne pouvait pas ne pas ˆtre pr‚sent dans"
PRINT "	Mathari et vous avez eu raison !!! Bien le bonjour aussi ..."
PRINT
PRINT "Math Sup 2 : le bonheur si je veux !!"
PRINT "Millet : la C‚r‚ale de l'esprit"
PRINT "Axiome 1 : Faites en sorte de ne jamais avoir de regrets ."
PRINT "Axiome 2 : Votre salut passe par la connaissance du cours ."
PRINT "Axiome 3 : Tout germe d'id‚e m‚rite une r‚compense ."
PRINT "Axiome 4 : Le sup est rieur mais le sp‚ chiale ."
ENDIF
RETURN
> PROCEDURE help
PRINT "Aide"
PRINT "Instructions :"
PRINT " - Info   -> informations"
PRINT " - Pref   -> affiche les pr‚f‚rences"
PRINT " - Save   -> sauve les pr‚f‚rences"
PRINT " - Exit   -> quitter Mathari"
PRINT " - List   -> liste des fonctions et constantes"
PRINT " - Plot   -> grapheur"
PRINT " - Suite  -> trac‚ de suites r‚currentes u=f(u)"
PRINT " - Help   -> aide"
PRINT " - Cls    -> efface ‚cran"
PRINT " - <cste>:=NEW   -> cr‚e une constante"
PRINT " - <cste>:=NULL  -> efface une constante"
PRINT " - <fonction>:=<expression en 't'>   -> cr‚e une fonction"
PRINT " - <fonction>:=NULL  -> efface une fonction"
RETURN
> PROCEDURE show_pref
PRINT "				pPr‚f‚rencesq"
PRINT "pEcran physique :q"
PRINT "Xdim :"'crstack(@search_cste("xdim"))
PRINT "Ydim :"'crstack(@search_cste("ydim"))
PRINT
PRINT "pSurface visible :q"
PRINT "Xmin :"'@qpisqrt$(crstack(@search_cste("xmin"))),,
PRINT "Sclx :"'@qpisqrt$(crstack(@search_cste("sclx")))
PRINT "Xmax :"'@qpisqrt$(crstack(@search_cste("xmax")))
PRINT "Ymin :"'@qpisqrt$(crstack(@search_cste("ymin"))),,
PRINT "Scly :"'@qpisqrt$(crstack(@search_cste("scly")))
PRINT "Ymax :"'@qpisqrt$(crstack(@search_cste("ymax")))
PRINT
PRINT "pTrac‚ :q"
PRINT "Point(s) :"'crstack(@search_cste("point"))
PRINT "Oscillo   :"'MID$("NonOui",(crstack(@search_cste("oscillo"))=1)*-3+1,3)
PRINT "Connect   :"'MID$("NonOui",(crstack(@search_cste("connect"))=1)*-3+1,3)
PRINT
PRINT "pParamŠtres :q"
PRINT "tmin :"'@qpisqrt$(crstack(@search_cste("tmin"))),,
PRINT "tmax :"'@qpisqrt$(crstack(@search_cste("tmax")))
RETURN