(***************************************************************************)
(*                                                                         *)
(*  MODULE: Golbe                               Karlsruhe,     22.02.1989  *) 
(*                                                      by  Olaf Pfeiffer  *)
(*  Modified by Paul Lukowicz 1989                                         *)
(*                                                                         *)
(***************************************************************************)



MODULE Globe;

(* $F-, $N-, $R-, $V-, $S- *)

FROM MathTrans     IMPORT Sin, Cos, Sincos;

FROM MathLibFFP   IMPORT pi;

FROM Graphics     IMPORT SetAPen, WritePixel;

FROM Intuition    IMPORT WindowPtr, ScreenPtr;

FROM WindowLib    IMPORT ScrWin, CloseWin, GetWinScr, ClearWin, GetWinRast;

FROM WinIOLib     IMPORT ReportClose, InspClose, sleep;

FROM ScreenLib    IMPORT SetColReg;

FROM SYSTEM       IMPORT  FFP, ADDRESS;

FROM WindowInOut  IMPORT WWriteString, WWriteLn, InitForIO, FinishIO; 

FROM WinIOControl IMPORT WTextColors, WCursorInvisible;


CONST wx = pi / 5.0;  (* Drehung um die x-Achse                 *)
      wz = pi / 8.0;  (* Drehung um die z-Achse                 *)
      wy = 0.0;       (* Drehung um die y-Achse (uninteressant) *)
      Radius = 90.0;  (* Kugelradius in Pixeln (10 - 100)       *)
      Laengen = 48.0; (* Anzahl der Längengerade (2 - 32)       *) 
      Breiten = 44.0; (* Anzahl der Breitengerade (1 - 31)      *)


TYPE MATRIX = ARRAY[1..3],[1..3] OF FFP;

                         
VAR s     : FFP;
    ch    : CHAR;
    M     : MATRIX;
    ptrW  : WindowPtr;
    ptrS  : ScreenPtr;
    close : BOOLEAN; 
    rp    : ADDRESS;
    
PROCEDURE FarbenSetzen;
(* Setzt die Farben für den neuen Screen. *)

BEGIN
  ptrS := GetWinScr(ptrW);
  SetColReg(ptrS,0 ,0 ,0 ,0 );  SetColReg(ptrS,1 ,0 ,13,4 );
  SetColReg(ptrS,2 ,0 ,0 ,2 );  SetColReg(ptrS,3 ,1 ,0 ,3 );
  SetColReg(ptrS,4 ,1 ,1 ,4 );  SetColReg(ptrS,5 ,2 ,1 ,5 );
  SetColReg(ptrS,6 ,2 ,1 ,6 );  SetColReg(ptrS,7 ,3 ,1 ,7 );
  SetColReg(ptrS,8 ,3 ,2 ,7 );  SetColReg(ptrS,9 ,3 ,2 ,8 );
  SetColReg(ptrS,10,4 ,2 ,8 );  SetColReg(ptrS,11,4 ,2 ,9 );
  SetColReg(ptrS,12,5 ,2 ,9 );  SetColReg(ptrS,13,5 ,3 ,10);
  SetColReg(ptrS,14,6 ,3 ,10);  SetColReg(ptrS,15,6 ,3 ,11);
  SetColReg(ptrS,16,7 ,3 ,11);  SetColReg(ptrS,17,7 ,3 ,12);
  SetColReg(ptrS,18,8 ,3 ,12);  SetColReg(ptrS,19,8 ,4 ,12);
  SetColReg(ptrS,20,9 ,5 ,13);  SetColReg(ptrS,21,9 ,6 ,13);
  SetColReg(ptrS,22,10,6 ,13);  SetColReg(ptrS,23,10,7 ,13);
  SetColReg(ptrS,24,11,8 ,14);  SetColReg(ptrS,25,11,9 ,14);
  SetColReg(ptrS,26,12,10,14);  SetColReg(ptrS,27,12,11,14);
  SetColReg(ptrS,28,13,12,15);  SetColReg(ptrS,29,14,13,15);
  SetColReg(ptrS,30,14,14,15);  SetColReg(ptrS,31,15,15,15);

END FarbenSetzen;       



PROCEDURE Matrix;

VAR cx, cy, cz, sx, sy, sz : FFP;

BEGIN 
   sz := Sincos(wz,cz); 
   sx := Sincos(wx,cx); 
   sy := Sincos(wy,cy);
    
   M[1,1] := cz * cy;
   M[2,1] :=-cz  * sy ;
   M[3,1] := sz ;
   M[1,2] := cx  * sy  + sx  * cy  * sz ;
   M[2,2] := cx  * cy  - sx  * sy  * sz ;
   M[3,2] :=-sx  * cz ;
   M[1,3] := sx  * sy  - cx  * cy  * sz ;
   M[2,3] := sx  * cy  + cx  * sy  * sz ;
   M[3,3] := cx  * cz ;
END Matrix;
 
 

PROCEDURE Drawxyz(p,q : FFP);

VAR x,y,z,x1,y1,z1,sp,cp,sq,cq : FFP;
    Posx,Posy,c    : INTEGER;

BEGIN
   
   sp := Sincos(p,cp);
   sq := Sincos(q,cq);
   x := cq*cp;
   y := cq * sp;
   z := sq;
   x1 := M[1,1] * x + M[2,1] * y + M[3,1] * z;
   y1 := M[1,2] * x + M[2,2] * y + M[3,2] * z;
   z1 := M[1,3] * x + M[2,3] * y + M[3,3] * z;
  IF y1 >= 0.0 THEN
     Posx := 160 + TRUNC(Radius * x1);
     Posy := 150 + TRUNC(Radius * z1);
     c := TRUNC(y1 * 30.0) + 2;
     SetAPen(rp,c);
     c := WritePixel(rp,Posx,Posy)
  END; 
END Drawxyz;

        

PROCEDURE LaengenKreise (step : FFP);

VAR p,q : FFP;

BEGIN
   p := 0.0;
  REPEAT
     q := 0.0;
    REPEAT
       Drawxyz(p,q);
       q := q + s;
    UNTIL q >= 2.0 * pi;
     p := p + pi / step;
  UNTIL p >= pi;
END LaengenKreise;



PROCEDURE BreitenKreise (step : FFP);

VAR p,q : FFP;

BEGIN
   step := step + 1.0;
   q := -(pi / 2.0) + pi / step;
  REPEAT
     p := 0.0;
    REPEAT
       Drawxyz(p,q);
       p := p + s;
    UNTIL p >= 2.0 * pi;
     q := q + pi / step;
  UNTIL q > pi / 2.0 - pi / step;
END BreitenKreise;

      
BEGIN
   (*  Fenster auf einem Screen der Tiefe 5 öffnen  *)
   ptrW := ScrWin("Kugel",0,10,320,240,1,5,7);  
   rp := GetWinRast(ptrW);
   FarbenSetzen;
   InitForIO(ptrW);                          (*  Für Ein/Ausgabe bereitmachen *)
   WTextColors(25,0);                        (*  Farben für Textausgabe       *)
   ReportClose(ptrW,TRUE);                   (*  Closegadget melden           *)
   WWriteLn;
   WWriteString("  >>> Erstellung einer Gitterkugel <<<");
   WWriteLn;
   WWriteString("  ====================================");
   WWriteLn;
   WWriteString("  von Olaf Pfeiffer         22.02.1989");
   WWriteLn; WCursorInvisible();
   s := 1.0 / Radius;
   Matrix; 
   LaengenKreise(Laengen);
   BreitenKreise(Breiten);
   WWriteString("                Fertig !!             ");
   close := InspClose(ptrW,sleep);            (*  Auf Close-Gadget warten  *)
   FinishIO(ptrW);
   CloseWin(ptrW);
END Globe.