(****************************************************************************
:Program.       FunktionenTest.mod
:Contents.      TestModule for Funktionen [gvm]
:Author.        Richard Günther [gvm]
:Address.       HeilbronnerStr.267, 7410 Reutlingen
:Phone.         07121/66432
:Copyright.     Public Domain
:Language.      Oberon
:Translator.    AmigaOberon v2.14d
:History.       V1.0 [gvm] 15-May-92  first implementation
:Imports.       Funktionen [gvm], FunktionenPost [gvm], GadToolsSupport [gvm]
:Bugs.          OS2.0 required
****************************************************************************)

MODULE FunktionenTest ;

IMPORT  S : SYSTEM,
        GT: GadTools,
        GS: GadToolsSupport,
        E : Exec,
        I : Intuition,
        G : Graphics,
        U : Utility,
        L : ExecLists,
        F : Funktionen,
        FP: FunktionenPost,
        ST: Strings,
        FS: FileSystem,
        FR: FileReq,
        NoGuruRq ;


CONST cyLabArray = GS.labels2(S.ADR(""),S.ADR(""),NIL) ;  (* dummy-cyGadget *)

TYPE  FunktionPtr = POINTER TO Funktion ;
      Funktion  = RECORD (L.Node)
                    string    : ARRAY 128 OF CHAR ;
                    func      : F.FuncX ;
                  END ;

VAR w         : I.WindowPtr ;
    s         : I.ScreenPtr ;
    win       : GS.WinPtr ;
    vInfo     : GT.VisualInfo ;
    g,sg      : I.GadgetPtr ;
    iMsg      : I.IntuiMessagePtr ;
    quit      : BOOLEAN ;
    funcList  : L.List ;
    actFunc   : L.NodePtr ;
    post      : ARRAY 1024 OF CHAR ;  (* global for speedup and stackspace *)


PROCEDURE Refresh ;
VAR x,y : INTEGER ;
BEGIN
  G.EraseRect(w.rPort,10,32,630,224) ;
  GS.DrawBevelBox(win,10,32,620,192,GT.visualInfo,vInfo,
                                    GT.bbRecessed,-1,U.done) ;
  G.SetAPen(w.rPort,1) ;
  G.Move(w.rPort,20,128) ; G.Draw(w.rPort,618,128) ;
    G.Draw(w.rPort,608,126) ; G.Draw(w.rPort,608,130) ; G.Draw(w.rPort,618,128) ;
  G.Move(w.rPort,320,219) ; G.Draw(w.rPort,320,37) ;
    G.Draw(w.rPort,316,42) ; G.Draw(w.rPort,324,42) ; G.Draw(w.rPort,320,37) ;
  x:=-14 ;
  REPEAT
    G.Move(w.rPort,320+x*20,126) ; G.Draw(w.rPort,320+x*20,130) ;
    INC(x) ;
  UNTIL x=15 ;
  y:=-8 ;
  REPEAT
    G.Move(w.rPort,316,128-y*10) ; G.Draw(w.rPort,324,128-y*10) ;
    INC(y) ;
  UNTIL y=9 ;
END Refresh ;

PROCEDURE Func*(f : L.NodePtr) ;
VAR err     : INTEGER ;
    x,y     : REAL ;
    draw    : BOOLEAN ;
BEGIN
  WITH f : Funktion DO
  IF f.func=NIL THEN
    IF ~F.Compile(f.string,"x",F.ffp,f.func,err) THEN
      I.DisplayBeep(s) ; RETURN
    END ;
  END ;
  x:=-15.0 ; draw:=FALSE ;
  WHILE x<15.0 DO     (* -15<=x<=15  -9<=y<=9 *)
    y:=f.func(x) ;
    IF (y<=9.0) AND (y>=-9.0) THEN
      IF draw THEN G.Draw(w.rPort,320+SHORT(ENTIER(x*20)),
                                  128-SHORT(ENTIER(y*10+0.5))) ;
              ELSE G.Move(w.rPort,320+SHORT(ENTIER(x*20)),
                                  128-SHORT(ENTIER(y*10+0.5)))
      END ;
      draw:=TRUE ;
    ELSE draw:=FALSE
    END ;
    x:=x+0.05 ;   (* every Pixel (0.05*20=1) *)
  END ;
  END ;
END Func ;

PROCEDURE DisposeFunc*(f  : L.NodePtr) ;
BEGIN
  WITH f : Funktion DO
    L.Remove(f) ;
    IF f.func#NIL THEN F.Dispose(f.func) END ;
    DISPOSE(f) ;
  END ;
END DisposeFunc ;

PROCEDURE CreateFunc ;
VAR f : FunktionPtr ;
BEGIN
  NEW(f) ; L.AddTail(funcList,f) ; actFunc:=f ;
  GS.SetGadgetAttrs(win,sg,GT.stString,S.ADR(actFunc(Funktion).string),U.done) ;
END CreateFunc ;

PROCEDURE Delete ;
VAR f : L.NodePtr ;
BEGIN
  f:=actFunc ; L.Succ(actFunc) ;
  IF actFunc=NIL THEN actFunc:=L.GetPred(f) END ;
  IF actFunc=NIL THEN actFunc:=f ; actFunc(Funktion).string:=""
                 ELSE DisposeFunc(f)
  END ;
  GS.SetGadgetAttrs(win,sg,GT.stString,S.ADR(actFunc(Funktion).string),U.done) ;
END Delete ;

PROCEDURE SaveAsPost ;
CONST display1="\
/drawfunc{/einheit exch def /step exch def\n\
          /ymax exch def /ymin exch def /xmax exch def /xmin exch def\n\
          /y0 exch def /x0 exch def\n\
          /func exch def\n\
          gsave\n\
            x0 y0 translate\n\
            newpath\n\
              xmin einheit mul ymin einheit mul moveto\n\
              xmax einheit mul ymin einheit mul lineto" ;
      display2="\
              xmax einheit mul ymax einheit mul lineto\n\
              xmin einheit mul ymax einheit mul lineto\n\
            closepath clip\n\
            newpath\n\
              xmin einheit mul xmin func einheit mul moveto\n\
              xmin step xmax {dup einheit mul exch func einheit mul lineto} for\n\
            stroke\n\
          grestore} def\n" ;
      cross1="\
/cross{/einheit exch def\n\
       /ymax exch def /ymin exch def /xmax exch def /xmin exch def\n\
       /y0 exch def /x0 exch def\n\
       gsave\n\
         x0 y0 translate 0 setlinejoin\n\
         newpath\n\
           xmin einheit mul 0 moveto xmax einheit mul 0 lineto\n\
           0 ymin einheit mul moveto 0 ymax einheit mul lineto\n\
         stroke\n\
         newpath\n\
           xmax einheit mul 14 sub dup -4 moveto 4 lineto\n\
           xmax einheit mul 0 lineto" ;
      cross2="\
         closepath fill\n\
         newpath\n\
           ymax einheit mul 14 sub dup -4 exch moveto 4 exch lineto\n\
           0 ymax einheit mul lineto\n\
         closepath fill\n\
         newpath\n\
           xmin 1 add 1 xmax 1 sub {einheit mul dup -3 moveto 3 lineto} for\n\
         stroke\n\
         newpath\n\
           ymin 1 add 1 ymax 1 sub {einheit mul dup -3 exch moveto 3 exch lineto} for\n\
         stroke\n\
       grestore} def\n" ;

VAR f         : FS.File ;
    func      : L.NodePtr ;
    funcname  : ARRAY 8 OF CHAR ;
    fname     : ARRAY 128 OF CHAR ;
    err,i     : INTEGER ;
BEGIN
  IF ~FR.FileReqWinSave("Filename...",fname,w) THEN RETURN END ;
  IF FS.Open(f,fname,TRUE) THEN
    IF ~FS.WriteString(f,cross1) OR ~FS.WriteString(f,cross2) OR
       ~FS.WriteString(f,display1) OR ~FS.WriteString(f,display2) OR
       ~FS.WriteString(f,"1 setlinewidth") OR
       ~FS.WriteString(f,"280 580 -16 16 -10 10 14.173 cross") OR
       ~FS.WriteString(f,"0.25 setlinewidth") THEN
      I.DisplayBeep(s) ; IF ~FS.Close(f) THEN END ; RETURN
    END ;
    func:=L.Head(funcList) ; i:=65 ;
    REPEAT
      WITH func : Funktion DO
        funcname:="func" ; ST.AppendChar(funcname,CHR(i)) ;
        IF FP.Compile(func.string,"x",funcname,post,err) THEN
          ST.AppendChar(funcname,"}") ; ST.InsertChar(funcname,0,"{") ;
          IF ~FS.WriteString(f,post) OR
             ~FS.WriteString(f,funcname) OR   (* für 180 dpi, Einheit 0.5cm *)
             ~FS.WriteString(f,"280 580 -15 15 -9 9 0.03 14.173 drawfunc") THEN
            I.DisplayBeep(s) ; IF ~FS.Close(f) THEN END ; RETURN
          END ;
          INC(i) ;
        END ;
      END ;
      L.Succ(func) ;
    UNTIL func=NIL ;
    IF ~FS.WriteString(f,"showpage") THEN I.DisplayBeep(s) ; RETURN END ;
    IF ~FS.Close(f) THEN END ;
  END ;
END SaveAsPost ;

BEGIN
  w:=I.OpenWindowTagsA(NIL,I.waLeft,0,I.waTop,0,I.waWidth,640,I.waHeight,256,
                           I.waDragBar,-1,I.waDepthGadget,-1,I.waCloseGadget,-1,
                           I.waIDCMP,S.VAL(LONGINT,GT.buttonIDCMP+LONGSET{I.closeWindow,I.newSize}),
                           I.waTitle,S.ADR("Ein simpler Funktionsplotter"),
                           U.done) ;
  IF (w=NIL) OR NOT GS.Init(win,s,w) THEN HALT(20) END ;
  vInfo:=GS.VInfo(win) ;
  GS.WaitForDo(win) ;
    GS.NewGadget(win,10,15,40,12,"ADD",GS.center,7) ;
    g:=GS.CreateGadget(win,GT.buttonKind,U.done) ;
    GS.NewGadget(win,124,15,20,12,"",GS.center,6) ;
    g:=GS.CreateGadget(win,GT.cycleKind,GT.cyLabels,S.ADR(cyLabArray),U.done) ;
    GS.NewGadget(win,144,15,440,12,"Funktion  ",GS.left,1) ;
    sg:=GS.CreateGadget(win,GT.stringKind,GT.stMaxChars,127,U.done) ;
    GS.NewGadget(win,589,15,40,12,"DEL",GS.center,8) ;
    g:=GS.CreateGadget(win,GT.buttonKind,U.done) ;
    GS.NewGadget(win,330,234,100,12,"QUIT",GS.center,2) ;
    g:=GS.CreateGadget(win,GT.buttonKind,U.done) ;
    GS.NewGadget(win,210,234,100,12,"CLEAR",GS.center,3) ;
    g:=GS.CreateGadget(win,GT.buttonKind,U.done) ;
    GS.NewGadget(win,10,234,100,12,"POSTSCRIPT",GS.center,4) ;
    g:=GS.CreateGadget(win,GT.buttonKind,U.done) ;
    GS.NewGadget(win,530,234,100,12,"REDRAW",GS.center,5) ;
    g:=GS.CreateGadget(win,GT.buttonKind,U.done) ;
  GS.Do(win) ;
  L.Init(funcList) ; CreateFunc ;
  Refresh ;

  quit:=FALSE ;
  REPEAT
    E.WaitPort(w.userPort) ;
    iMsg:=GT.GetIMsg(w.userPort) ;
    WHILE iMsg#NIL DO
      IF I.closeWindow IN iMsg.class THEN quit:=TRUE ;
      ELSIF I.gadgetUp IN iMsg.class THEN
        g:=iMsg.iAddress ;
        CASE g.gadgetID OF
          1 : GS.GetString(sg,actFunc(Funktion).string) ;
              IF actFunc(Funktion).func#NIL THEN
                F.Dispose(actFunc(Funktion).func) ;
              END ;
              Func(actFunc) ;
        | 2 : quit:=TRUE ;
        | 3 : Refresh ; L.DoForward(funcList,DisposeFunc) ; CreateFunc ;
        | 4 : SaveAsPost ;
        | 5 : Refresh ; L.DoForward(funcList,Func) ;
        | 6 : L.Succ(actFunc) ;
              IF actFunc=NIL THEN actFunc:=L.Head(funcList) END ;
              GS.SetGadgetAttrs(win,sg,GT.stString,S.ADR(actFunc(Funktion).string),U.done) ;
        | 7 : CreateFunc ;
        | 8 : Delete ;
        END ;
      END ;
      GT.ReplyIMsg(iMsg) ;
      iMsg:=GT.GetIMsg(w.userPort) ;
    END ;
  UNTIL quit ;

CLOSE
  IF w#NIL THEN I.CloseWindow(w) END ;
  IF win#NIL THEN GS.Dispose(win) END ;
  L.DoForward(funcList,DisposeFunc) ;
END FunktionenTest.