(*********************************************************************
 
    :Program.  	 Plot2Am.mod
    :Author.   	 Joel Swank
    :Author.     Übersetzung C -> MODULA2, Gary Struhlik
    :Version.  	 1.0
    :Date.     	 10.09.1989 (Übersetzung)
    :Date.       April 1988 (Original C Quellcode)
    :Copyright.  Public Domain (Original C code auf Fred Fisk Disk Nr. 165)
    :Copyright.  Public Domain  (auch diese MODULA2-Übersetzung)
    :Language. 	 Modula-II
    :Translator. M2Amiga 3.2d
    :Imports.	 -
    :Contents.   Plottet UNIX Plot-Files auf einem Amiga HIRES Screen
    :Remark.	 Für den Amiga Modula-2 Klub / Stuttgart
    :Remark.     Das MODULA2-Prg. unterscheidet sich leicht vom C-Original
    :Remark.     wie folgt: um doprint ergänzt, PAL-Auflösung (640x512),
    :Remark.                einige voreingestellte Parameter  verändert
    :Remark.     Die im Original verwendete isqrt Routine habe ich  bei 
    :Remark.     einer 1:1 Übersetzung nicht zum Laufen bringen können.
    :Remark.     Deshalb habe ich die Routine Sqrt aus dem  Modul Math-
    :Remark.     Trans des Betriebssystems verwendet.  Nachteil:  Real-
    :Remark.     zahloperation ist im  Gegensatz  zur  Integeroperation 
    :Remark.     langsamer (nur bei Verwendung von 'arc')  
    :History.    V 1.0, 10.9.89
                                               
***************************************************************)

MODULE Plot2Am;

FROM Arts IMPORT Error;
FROM Graphics IMPORT TextAttr,FontStyles,FontStyleSet,FontFlags,FontFlagSet,
                     ViewModes,ViewModeSet,TextFontPtr,RastPortPtr,ViewPortPtr,
                     SetFont,LoadRGB4,Move,Draw,WritePixel,DrawEllipse,RectFill,
                     Text,SetAPen,CloseFont;
FROM Intuition IMPORT topazEighty,NewScreen,ScreenFlags,ScreenFlagSet,
                      customScreen,NewWindow,IDCMPFlags,IDCMPFlagSet,
                      WindowFlags,WindowFlagSet,WindowPtr,ScreenPtr,
                      IntuiMessagePtr,OpenScreen,OpenWindow,CloseWindow,
                      CloseScreen;
FROM SYSTEM IMPORT ADR,LONGSET,SHIFT,CAST,FFP;
FROM FileSystem IMPORT File,Lookup,Response,ReadChar,Close;
FROM Printer IMPORT Special,SpecialSet,IODRPReqPtr,dumpRPort;
FROM Exec IMPORT OpenDevice,CloseDevice,MsgPortPtr,DoIO,ReplyMsg,GetMsg,
                 WaitPort;
FROM ExecSupport IMPORT CreateExtIO,DeleteExtIO,CreatePort,DeletePort;
FROM Arguments IMPORT GetArg,NumArgs;
FROM Terminal IMPORT WriteString,WriteLn;
FROM DiskFont IMPORT OpenDiskFont;
FROM Conversions IMPORT StrToVal;
FROM Strings IMPORT Length,Compare;
FROM GfxMacros IMPORT SetDrPt;
FROM MathTrans IMPORT Sqrt;

TYPE
      CHARArray = ARRAY[0..200] OF CHAR;
      CHARPtr = POINTER TO CHAR;
      StringPtr = POINTER TO CHARArray;
CONST
      PaletteColorCount = 2;
      Plot2AmErr = "Plot2Am Error";
VAR
      XSIZE, YSIZE : LONGINT;
      TOPAZ80 : TextAttr;
      NewScreenStructure : NewScreen;
      Palette : ARRAY[0..1] OF CARDINAL;
      NewWindowStructure : NewWindow;
      myattr : TextAttr;
      myFont : TextFontPtr;
      Wind : WindowPtr;
      myScreen : ScreenPtr;
      rp : RastPortPtr;
      input : File;
      xscale,yscale,xmult,ymult,xoff,yoff : LONGINT;
      lmodestr : ARRAY[0..4] OF ARRAY[0..10] OF CHAR;
      lmode : ARRAY[0..4] OF CARDINAL;
      msg : IntuiMessagePtr;
      j,argindex,argcount,len : INTEGER;
      sign,err,plotflag : BOOLEAN;
      x,y,r,r1,r2,x1,y1,x2,y2,i : LONGINT;
      textbuf : CHARArray;
      p : CHARPtr;
      strPtr : StringPtr;
      Argument : CHARArray;
      cmd : CHAR;
      cl : IDCMPFlagSet;

(**********************************************
         Parameter Eingabe UPs
 **********************************************)

(* Eingabe: 16 bit INTEGER und Ausgabe als LONGINT *)
      
PROCEDURE getint( VAR num : LONGINT);
VAR
      hi,lo : LONGINT;
      cmd : CHAR;
      i : INTEGER;
BEGIN
      ReadChar(input,cmd);
      lo:=LONGINT(cmd);
      ReadChar(input,cmd);
      i:=INTEGER(cmd);
      hi:=LONGINT(SHIFT(i,8));
      num:=lo+hi
END getint;

(* Eingabe: zwei 16 bit INTEGER, Skalierung *)
(* und Ausgabe als LONGINTs                 *)

PROCEDURE getxy( VAR x,y : LONGINT);
BEGIN
      getint(x);
      x:=(x-xoff)*xmult/xscale;
      getint(y);
      y:=(YSIZE-1)-(y-yoff)*ymult/yscale;      
END getxy;

(* Eingabe: Textstring abgeschlossen mit newline, *)
(* Ausgabe: Buffer abgeschlossen mit CHR(0)       *)

PROCEDURE gettxt(VAR str : ARRAY OF CHAR);
VAR
      cmd : CHAR;
      index : INTEGER;
BEGIN
      index:=0;
      ReadChar(input,cmd);
      WHILE (cmd<>CHR(10)) DO
         str[index]:=cmd;
         INC(index);
         ReadChar(input,cmd);
      END;
      str[index]:=CHR(0)
END gettxt;

(* Done - alles schließen  *)

PROCEDURE Done;
BEGIN
      IF (Wind<>NIL) THEN CloseWindow(Wind) END;
      IF (myScreen<>NIL) THEN CloseScreen(myScreen) END;
      IF (myFont<>NIL) THEN CloseFont(myFont) END
END Done;      

(*
 * arc and integer sqrt routines.
 * lifted from sunplot program by:

Sjoerd Mullender
Dept. of Mathematics and Computer Science
Free University
Amsterdam
Netherlands

Email: sjoerd@cs.vu.nl
If this doesn't work, try ...!seismo!mcvax!cs.vu.nl!sjoerd or
...!seismo!mcvax!vu44!sjoerd or sjoerd%cs.vu.nl@seismo.css.gov.

Das ist der original Text aus dem C-Sourcecode. isqrt wurde durch Sqrt aus
MathTrans ersetzt.

 * 
 *)

PROCEDURE isqrt( n : LONGINT) : LONGINT;
VAR
      a,b,c : LONGINT;
BEGIN
 a:=LONGINT(Sqrt(FFP(n)));
 RETURN(a)      
END isqrt;                   

PROCEDURE setcir(x,y,a1,b1,c1,a2,b2,c2 : LONGINT);
VAR
      i : INTEGER;
BEGIN
      IF ( ((a1*y-b1*x) >= c1) AND ((a2*y-b2*x) <= c2) ) THEN
         i:=WritePixel(rp,INTEGER(x),INTEGER(y))
      END   
END setcir;         

PROCEDURE arc( x,y,x1,y1,x2,y2 : LONGINT);
VAR
      a1,b1,a2,b2,c1,c2,r2,i,sqrt : LONGINT;
BEGIN
      a1:=x1-x; b1:=y1-y; a2:=x2-x; b2:=y2-y;
      c1:=a1*y-b1*x; c2:=a2*y-b2*x;
      r2:=a1*a1+b1*b1;
      
      i:=isqrt( SHIFT(r2,-1));
      WHILE (i>=0) DO
        sqrt:=isqrt(r2-i*i);
        setcir( x+i, y+sqrt, a1, b1, c1, a2, b2, c2); 
        setcir( x+i, y-sqrt, a1, b1, c1, a2, b2, c2);      
        setcir( x-i, y+sqrt, a1, b1, c1, a2, b2, c2); 
        setcir( x-i, y-sqrt, a1, b1, c1, a2, b2, c2); 
        setcir( x+sqrt, y+i, a1, b1, c1, a2, b2, c2); 
        setcir( x+sqrt, y-i, a1, b1, c1, a2, b2, c2); 
        setcir( x-sqrt, y+i, a1, b1, c1, a2, b2, c2); 
        setcir( x-sqrt, y-i, a1, b1, c1, a2, b2, c2);
        i:=i-1
      END
END arc;                 

(* doprint : Hardcopy auf WB 1.3 Drucker *)

PROCEDURE doprint;
VAR
  request : IODRPReqPtr;
  printerPort : MsgPortPtr;
  vp : ViewPortPtr;
  sc : ScreenPtr;
BEGIN
	printerPort := CreatePort( ADR("myprport"),0);
	request := CreateExtIO(printerPort, SIZE(request^) );
	OpenDevice(ADR("printer.device"),0,request,LONGSET{});
	request^.command := dumpRPort;
	request^.rastPort := Wind^.rPort;
	sc := Wind^.wScreen;
	vp := ADR(sc^.viewPort);
	request^.colorMap := vp^.colorMap;
	request^.modes := vp^.modes;
	request^.srcX := 0;
	request^.srcY := 0;
	request^.srcWidth := 640;
	request^.srcHeight := 512;
	request^.destCols := 0;
	request^.destRows := 0;
	request^.special := SpecialSet{ density4 };
	DoIO(request);
	CloseDevice(request);
	DeleteExtIO(request);
	DeletePort(printerPort)
END doprint;

BEGIN
 XSIZE:=640; YSIZE:=512;
 WITH TOPAZ80 DO
     name:=ADR("topaz.font");
     ySize:=topazEighty;
     style:=FontStyleSet{};
     flags:=FontFlagSet{}
 END;
 WITH NewScreenStructure DO
     leftEdge:=0;
     topEdge:=0;
     width:=640;
     height:=512;
     depth:=1;
     detailPen:=0;
     blockPen:=1;
     viewModes:=ViewModeSet{lace,hires};
     type:=customScreen;
     font:=ADR(TOPAZ80);
     defaultTitle:=NIL;
     gadgets:=NIL;
     customBitMap:=NIL
 END;
 Palette[0]:=0; Palette[1]:=0FFFH;
 WITH NewWindowStructure DO
     leftEdge:=0;
     topEdge:=0;
     width:=640;
     height:=512;
     detailPen:=-1;
     blockPen:=-1;
     idcmpFlags:=IDCMPFlagSet{closeWindow};
     flags:=WindowFlagSet{windowClose,borderless};
     firstGadget:=NIL;
     checkMark:=NIL;
     title:=NIL;
     screen:=NIL; (* Wird nach startup belegt *)
     bitMap:=NIL;
     minWidth:=0;
     minHeight:=0;
     maxWidth:=0;
     maxHeight:=0;
     type:=customScreen
 END;
 WITH myattr DO
     name:=ADR("puny.font");
     ySize:=7;
     style:=FontStyleSet{};
     flags:=FontFlagSet{diskFont}
 END;
 Wind:=NIL; myScreen:=NIL;
 
 (* Linemode Konstanten *)
 lmodestr[0]:="dotted"; lmodestr[1]:="solid"; lmodestr[2]:="longdashed";
 lmodestr[3]:="shortdashed"; lmodestr[4]:="dotdashed";
 lmode[0]:=0AAAAH; lmode[1]:=0FFFFH; lmode[2]:=0FF00H; lmode[3]:=0F0F0H;
 lmode[4]:=0F2F2H;

 (* plotflag = TRUE -> nur Druckerausgabe *) 
 plotflag:=FALSE;
 
 (* Skalierungsfaktoren; Voreinstellungen *)
 xscale:=10000; yscale:=10000; (* Breite, Höhe des output devices *)
 xmult:=640; ymult:=512; (* Breite,Höhe auf dem Amiga screen *)
 xoff:=0; yoff:=0;  (* offset linke untere Ecke *)
 argcount:=NumArgs();
 
 (* Kommandozeile lesen *)
 
 IF (argcount=0) THEN
  WriteLn;
  WriteString("Plot2Am (conversion from C to MODULA2) V 1.0 (10-SEP-89)");
  WriteLn;
  WriteString("This program plots UNIX plot files on an AMIGA HIRES screen");
  WriteLn;
  WriteString("It can directly plot a UNIX plot file on a WB 1.3 printer"); 
  WriteLn;
  WriteString(
  "Usage:plot2am [-xnnnnn] [-ynnnnn] [-p] plotfile"); WriteLn;
  WriteLn;
  WriteString("      -x nnnnn x-resolution on AMIGA screen (xmult)"); WriteLn;
  WriteString("      -y nnnnn y-resolution on AMIGA screen (ymult)"); WriteLn;
  WriteString("      -p plot on printer only"); WriteLn; WriteLn;
  WriteString("default: xscale = yscale = 10000"); WriteLn;
  WriteString("         xmult = 640, ymult = 512"); WriteLn;
  WriteLn; 
  Error(ADR(Plot2AmErr),ADR("No arguments specified"))
 END;
 argindex:=1;
 GetArg(argindex,Argument,len);
 WHILE (Argument[0]='-') DO
    p:=ADR(Argument[0]);
    INC(p);
    CASE (p^) OF
      
     'x': INC(p); strPtr:=CAST(StringPtr,p);       (* x Größe *)
          StrToVal(strPtr^,xmult,sign,10,err) |
     
     'y': INC(p); strPtr:=CAST(StringPtr,p);
          StrToVal(strPtr^,ymult,sign,10,err) |    (* y Größe *)
     
     'p': plotflag:=TRUE;  (* nur Druckerausgabe *)
          WITH NewScreenStructure DO 
            type:=ScreenFlagSet{wbenchScreen..sf3,screenBehind}
          END
     ELSE
          WriteString("plot2am: invalid option "); WriteString(Argument);
          WriteLn; Error(ADR(Plot2AmErr),ADR("Invalid option"))
     END;
     DEC(argcount); INC(argindex);
     GetArg(argindex,Argument,len)
  END;       
  IF ((argcount=0) OR (argcount>1)) THEN
   WriteString("plot2am: exactly one filename required");
   WriteLn; Error(ADR(Plot2AmErr),ADR("Exactly one filename required")) 
  END;  
  
  GetArg(argindex,Argument,len);
  Lookup(input,Argument,20000,FALSE);
  IF (input.res<>done) THEN
    WriteString("plot2am: "); WriteString(Argument); 
    WriteString(" : open failed"); WriteLn;
    Error(ADR(Plot2AmErr),ADR("Can't open file"))
  END; 
  
  (*****************************************
    Alles öffnen
   *****************************************)
  
  myScreen:=OpenScreen(NewScreenStructure);
  IF (myScreen=NIL) THEN
     Done; Error(ADR(Plot2AmErr),ADR("Can't open screen"))
  END;   
  NewWindowStructure.screen:=myScreen;
  Wind:=OpenWindow(NewWindowStructure);
  IF (Wind=NIL) THEN
     Done; Error(ADR(Plot2AmErr),ADR("Can't open window"))
  END;
  rp:=Wind^.rPort;
  IF (plotflag) THEN
    WriteString("Plotting file "); WriteString(Argument); WriteString(" ...")
  END;
  myFont:=OpenDiskFont(ADR(myattr));
  IF (myFont=NIL) THEN
    WriteString("plot2am : cannot find puny font - using default"); WriteLn
  ELSE
    SetFont(rp,myFont)
  END;
  LoadRGB4(ADR(myScreen^.viewPort),ADR(Palette),PaletteColorCount);

  (*************************************************
              MAIN Hauptprogramm
   *************************************************)
   
  WHILE (NOT(input.eof)) DO
    ReadChar(input,cmd);
    
    CASE cmd OF
     
     'm': getxy(x,y); Move(rp,INTEGER(x),INTEGER(y)) |  (* move x,y *)
     
     'n': getxy(x,y); Draw(rp,INTEGER(x),INTEGER(y)) |  (* draw x,y *)
     
     'p': getxy(x,y); j:=WritePixel(rp,INTEGER(x),INTEGER(y)) | (* point x,y *)
     
     'l': getxy(x,y); Move(rp,INTEGER(x),INTEGER(y));  (* line xs,ys, xe,ye *)
          getxy(x,y); Draw(rp,INTEGER(x),INTEGER(y)) |
     
     'a': getxy(x,y); getxy(x2,y2); getxy(x1,y1); (* arc xc,yc,xs,ys,xe,ye *)
          arc(x,y,x1,y1,x2,y2); (* zeichne im Uhrzeigersinn *)
          Move(rp,INTEGER(x1),INTEGER(y1)) |
     
     't': gettxt(textbuf);  (* Textstring *)
          IF (rp^.y<>0) THEN 
            Text(rp,ADR(textbuf),Length(textbuf))
          END |
          
     'c': getxy(x,y); getint(r); (* circle xc,yc,r *)
          r1:=r*xmult/xscale;
          r2:=r*ymult/yscale;
          DrawEllipse(rp,INTEGER(x),INTEGER(y),INTEGER(r1),INTEGER(r2)) |
          
     'f': gettxt(textbuf); (* linemode string *)
          FOR i:=0 TO 4 DO
            IF (Compare(lmodestr[i],0,Length(lmodestr[i]),textbuf,TRUE)=0) THEN
                SetDrPt(rp,lmode[i])
            END 
          END |
          
     's': getint(xoff); getint(yoff);  (* space xlo,ylo,xhi,yhi *)
          getint(xscale); getint(yscale);
          xscale:=xscale-xoff;
          yscale:=yscale-yoff |
          
     'e': SetAPen(rp,0); (* erase *)
          RectFill(rp,0,0,INTEGER(XSIZE-1),INTEGER(YSIZE-1));
          SetAPen(rp,1) 
     ELSE
          
     END
  END;  

     (* Fenster auf dem Drucker ausgeben *)   
     IF (plotflag) THEN doprint; WriteString(" done"); WriteLn END;
     
     (**************************************
            auf Close Gadget warten
      **************************************) 
     
     IF (NOT(plotflag)) THEN
        LOOP
          WaitPort(Wind^.userPort);
          msg:=GetMsg(Wind^.userPort);
          cl:=msg^.class;
          ReplyMsg(msg);
          IF cl=IDCMPFlagSet{closeWindow} THEN
            EXIT
          END
        END;
        Done
     ELSE
        Done
     END                             
  
END Plot2Am.