{ ************************************** }
{  TPGRAFICA.p                           }
{                                        }
{  Unit di supporto per la grafica tipo  }
{  Turbo Pascal v.4.0/5.0 Ms-Dos         }
{                                        }
{  MODIFICHE PER IL NUMERO DEL MESE DI   }
{  SETTEMBRE di COMPUTER CLUB            }
{                                        }
{  by Filippo Bosi (v1.0) 30-Giugno-1991 }
{ ************************************** }


{ ************************************** }
{ * MODIFICHE ALL'INTERFACCIAMENTO CON * }
{ * LE LIBRERIE DI SISTEMA AMIGA:      * }
{ * cancellare le due direttive        * }
{ *                                    * }
{ * {$include graphics}                * }
{ * {$include intuition}               * }
{ *                                    * }
{ * inserire la seguente istruzione,   * }
{ * all'interno della sezione          * }
{ * Interface                          * }
{ *                                    * }
{ *  Uses Graphics,Intuition;          * }
{ *                                    * } 
{ ************************************** }


{ ************************************** }
{ *  MODIFICHE ALLA SEZIONE INTERFACE  * }
{ ************************************** }

{ aggiunta di nuove costanti di errore   }
{ grafico ritornate da GraphResult       }
{ (sostituire alle vecchie)              }
{ -------------------------------------- }
{ CREATE: Luglio 91                      }
{ MODIF.: Settembre 91                   }
{ -------------------------------------- }

const
 GrOk                   = 0;  { Tutto OK }
 GrError                = -11;  { Errore }
                              { Generico }
 GrNoInitGraph          = -1;
 GrNotDetected          = -2;
 GrFileNotFound         = -3;
 GrInvalidDriver        = -4;
 GrNoLoadMem            = -5;
 GrNoScanMem            = -6;
 GrNoFloodMem           = -7;
 GrFontNotFound         = -8;
 GrNoFontMem            = -9;
 GrInvalidMode          = -10;
 GrIOError              = -12;
 GrInvalidFont          = -13;
 GrInvalidFontNum       = -14;

{ ----- Costanti per SetWriteMode ------ }
{ - si noti come NormalPut e CopyPut     }
{   siano sinonimi.                      }
{ -------------------------------------- }
{ CREATE: Settembre 1991                 }
{ -------------------------------------- }

 NormalPut      = 0;
 CopyPut        = 0;
 XORPut         = 1;
 OrPut          = 2;
 AndPut         = 3;
 NotPut         = 4;

{ ************************************** }
{ *     nuove procedure e funzioni     * }
{ ************************************** }
{ - aggiungere dopo le altre all'interno }
{   della sezione interface              }
{ -------------------------------------- }
{ CREATE: Settembre 91                   }
{ -------------------------------------- }

Procedure Arc(x,y:integer; angoloPart,
              angoloFine,r:word);
Procedure Circle(x,y:integer; r:word);
Function  GetMaxColor:word;
Function  GetPixel(x,y:integer):word;
Function  GetX:integer;
Function  GetY:integer;
Function  GraphErrorMsg(ErrorCode:integer)
                        :string;
Procedure LineRel(Dx,Dy:integer);
Procedure LineTo(x,y:integer);
Procedure MoveRel(Dx,Dy:integer);
Procedure MoveTo(x,y:integer);
Procedure PutPixel(x,y:integer;
                   pixel:word);
Procedure Rectangle(x1,y1,x2,y2:integer);
Procedure SetWriteMode(WriteMode:integer);

{ ************************************** }
{ MODIFICHE ALLA SEZIONE IMPLEMENTATION  }
{ ************************************** }

{ ************************************** }
{ *   aggiunte alla sezione variabili  * }
{ ************************************** }

{ * coordinate x e y cursore grafico * }
{ ------------------------------------ }
{ * Create: SETTEMBRE 91             * }
{ ------------------------------------ }
CPx,CPy:integer;

{ * numero di piani di bit utilizzati * }
{ * dallo schermo grafico aperto      * }
{ * attualmente: e' settato dalla     * }
{ * routine InitGraph e viene         * }
{ * utilizzato dalla routine          * }
{ * GetMaxColor.                      * }
{ ------------------------------------- }
{ * Creato: SETTEMBRE 91              * }
{ ------------------------------------- }
NumPiani:word; 



{ ************************************** }
{ * MODIFICHE/AGGIUNTE alle procedure  * }
{ ************************************** }

Procedure InitGraph;
{ * apre lo schermo grafico           * }
{ ------------------------------------- }
{ * Creata: LUGLIO 91                 * }
{ * Modif.: SETTEMBRE 91              * }
{ ------------------------------------- }
 
var
 risx,risy : integer;
 maxplanes : integer;
 scrmode   : word;
 { * dimensioni finestra * }
 fin_largh,fin_alt : integer;

const
 { * altezza in pixel del titolo * }
 { * dello schermo grafico       * }
 SCREENBAR = 10;

begin
scrmode:=GENLOCK_VIDEO;

if (modo and GR_LORES)<>0 then
 begin
 maxplanes:=6;
 risx:=320;

  { * se si richiedono 6 bitplanes * }
  { * in bassa risoluzione, allora * }
  { * vai in modo 64 colori (EHB)  * }
 if npiani=6 then
  scrmode:=scrmode+EXTRA_HALFBRITE;

 end

   else begin
 maxplanes:=4;
 risx:=640;
 scrmode:=scrmode+HIRES;
        end;

{ * controlla se si è scelto il modo * }
{ * interlacciato                    * }
if (modo and GR_LACE)<>0
       then begin
            risy:=512;
            scrmode:=scrmode+LACE;
            end
       else risy:=256;

{ * controlla che il numero dei piani * }
{ * di bit non sia superiore al max.  * }
{ * consentito                        * }
if npiani>maxplanes then
 begin
  GrResult:=GrError;
 exit;
 end;

Scr:=Open_Screen(0,0,risx,risy,
                 npiani,3,1,
                 scrmode,
                 ^TitoloSchermo);

{ * controlla che lo schermo sia * }
{ * stato aperto correttamente   * }
if Scr=NIL then
 begin
 GrResult:=GrError;
 exit;
 end;

fin_largh:=risx;
fin_alt:=risy-SCREENBAR;

Win:=Open_Window(0,SCREENBAR,fin_largh,
                 fin_alt,1,0,BORDERLESS+
                 GIMMEZEROZERO+
                 ACTIVEWINDOW,
                 Nil,Scr,fin_largh,
                 fin_alt,fin_largh,
                 fin_alt);

{ * controlla che la finestra sia * }
{ * stata aperta correttamente    * }
if Win=NIL then
 begin
 GrResult:=GrError;
 exit;
 end;

rp:=Win^.Rport;

{ * sistema i contenuti delle        * }
{ * variabili globali per dimensioni * }
{ * schermo grafico                  * }
MaxX:=fin_largh-1;
MaxY:=fin_alt-1;

{ * sistema il colore della penna * }
{ * corrente                      * }
SetColor(1);

{ * sistema la variabile globale * }
{ * NumPiani = n.piani di bit    * }
{ * dello schermo grafico aperto * }
{ -------------------------------- }
{ * AGGIUNTA: SETTEMBRE 91       * }
{ -------------------------------- }
NumPiani:=npiani;

end;

Procedure SetWriteMode;
{ -- Seleziona il modo corrente di   -- }
{ -- scrittura su pagina grafica     -- }
{ ------------------------------------- }
{ - NOTA: attualmente i modi di       - }
{   scrittura che emulano AndPut e      }
{   e OrPut non sono identici a         }
{   quelli del TURBO PASCAL             }
{ ------------------------------------- }
{ Creata: SETTEMBRE 1991                }
{ ------------------------------------- }

begin
 Case WriteMode of
    NormalPut,CopyPut: SetDrMd(rp,JAM1);
    XORPut    : SetDrMd(rp,COMPLEMENT);
    NotPut    : SetDrMd(rp,INVERSVID);
    AndPut,OrPut: SetDrMd(rp,JAM2);
    end;
end;

Procedure Arc;
{ - Traccia un arco di circonferenza  - }
{ - NOTA: la routine potrebbe essere  - }
{         ottimizzata in molti modi   - }
{         ma cio' esula dallo scopo   - }
{         di questi articoli.         - }
{ ------------------------------------- }
{ Creata: SETTEMBRE 1991                }
{ ------------------------------------- }
var i:word;
    rd,temp:real;

begin
rd:=angoloPart/180*pi;
Move(rp,x+trunc(r*cos(rd)),
        y+trunc(r*sin(rd)));

rd:=180/pi;

for i:=angoloPart+1 to angoloFine do
     begin
     temp:=i/rd;
     Draw(rp,x+trunc(r*cos(temp)),
             y+trunc(r*sin(temp)));
     end;
end;

Procedure Circle;
{ - Disegna una circonferenza         - }
{ ------------------------------------- }
{ Creata: SETTEMBRE 1991                }
{ ------------------------------------- }

begin
{ - nelle librerie grafiche di Amiga   - }
{ - non esiste una routine che tracci  - }
{ - una circonferenza, allora facciamo - }
{ - disegnare una ellisse con i due    - }
{ - raggi uguali...                    - }
DrawEllipse(rp,x,y,r,r);
end;

Function  GetMaxColor;
{ * ritorna il num.massimo di colore  * }
{ * possibile per lo schermo corrente * }
{ ------------------------------------- }
{ Creata: SETTEMBRE 1991                }
{ ------------------------------------- }
begin
GetMaxColor:=
      Round(Exp(NumPiani*Ln(2)))-1;
{ - N.B. Exp(2*Log(NumPiani)) equivale }
{        ad elevare 2 alla NumPiani    }
end;

Function  GetPixel;
{ -- ritorna il contenuto del pixel   -- }
{ -- alle coordinate x,y              -- }
{ -------------------------------------- }
{ Creata: SETTEMBRE 1991                 }
{ -------------------------------------- }

begin
GetPixel:=ReadPixel(rp,x,y);
end;

Function  GetX;
{ -- ritorna la coordinata x corrente -- }
{ -- del cursore grafico              -- }
{ -------------------------------------- }
{ Creata: SETTEMBRE 1991                 }
{ -------------------------------------- }

begin
GetX:=CPx;
end;

Function  GetY;
{ -- ritorna la coordinata y corrente -- }
{ -- del cursore grafico.             -- }
{ -------------------------------------- }
{ Creata: SETTEMBRE 1991                 }
{ -------------------------------------- }

begin
GetY:=CPy;
end;

Function  GraphErrorMsg;
{ - Ritorna una stringa messaggio a    - }
{ - seconda di ErrCode, ritornato da   - }
{ - GraphResult                        - }
{ - NOTA: vengono ritornati solo due   - }
{ -  messaggi: "Tutto Ok", "Errore"    - }
{ -  a differenza dei messaggi TP,     - }
{ -  specifici per ogni errore.        - } 
{ -------------------------------------- }
{ Creata: SETTEMBRE 1991                 }
{ -------------------------------------- }

begin
if ErrorCode=GrOk then
    GraphErrorMsg:="TpGrafica: Tutto Ok."
  else
    GraphErrorMsg:="TpGrafica: Errore !";
end;

Procedure LineRel;
{ - Traccia una linea a partire dalla  - }
{ - posizione corrente del cursore     - }
{ - grafico fino al punto distante     - }
{ - dx sull'asse x e dy sull'asse y    - }
{ -------------------------------------- }
{ Creata: SETTEMBRE 1991                 }
{ -------------------------------------- }

begin
{ * inizia la riga dalla posizione * }
{ * corrente del cursore grafico   * }
Move(rp,CPx,CPy);

{ * poi spostalo al termine della * }
{ * riga                          * }
CPx:=CPx+Dx;
CPy:=CPy+Dy;
Draw(rp,CPx,CPy);
end;

Procedure LineTo;
{ - Traccia una linea a partire dalla  - }
{ - posizione corrente del cursore     - }
{ - grafico fino al punto di           - }
{ - coordinate x,y                     - }
{ -------------------------------------- }
{ Creata: SETTEMBRE 1991                 }
{ -------------------------------------- }

begin
Move(rp,CPx,CPy);
Draw(rp,x,y);
CPx:=x; CPy:=y;
end;

Procedure MoveRel;
{ -- sposta il cursore grafico di dx  -- }
{ -- sull'asse x e dy sull'asse y.    -- }
{ -------------------------------------- }
{ Creata: SETTEMBRE 1991                 }
{ -------------------------------------- }

begin
CPx:=CPx+Dx;
CPy:=CPy+Dy;
end;

Procedure MoveTo;
{ -- muove il cursore grafico a (x,y) -- }
{ -------------------------------------- }
{ Creata: SETTEMBRE 1991                 }
{ -------------------------------------- }

begin
CPx:=x; CPy:=y;
end;

Procedure PutPixel;
{ -- scrive un pixel alle coordinate  -- }
{ -- x,y con il colore pixel, senza   -- }
{ -- alterare il colore corrente      -- }
{ -- scelto mediante la funzione      -- }
{ -- SetColor.                        -- }
{ -------------------------------------- }
{ Creata: SETTEMBRE 1991                 }
{ -------------------------------------- }

begin
{ - imposta la penna corrente con - }
{ - il numero di colore contenuto - }
{ - in pixel                      - }
SetAPen(rp,pixel);

{ - scrive il pixel - }
WritePixel(rp,x,y);

{ - ritorna al colore corrente di - }
{ - default, scelto con SetColor  - }
SetAPen(rp,ColoreCorrente);

end;

Procedure Rectangle;
{ - Traccia un rettangolo che ha per   - }
{ - diagonale la congiungente (x1,y1)  - }
{ - con (x2,y2)                        - }
{ -------------------------------------- }
{ Creata: SETTEMBRE 1991                 }
{ -------------------------------------- }

begin
Move(rp,x1,y1);
Draw(rp,x1,y2);
Draw(rp,x2,y2);
Draw(rp,x2,y1);
Draw(rp,x1,y1);
end;

{ ************************************** }
{ * CODICE DI STARTUP DELLA UNIT       * }
{ ************************************** }
{ -------------------------------------- }
{ Creato: LUGLIO 1991                    }
{ Modif.: SETTEMBRE 1991                 }
{ -------------------------------------- }

begin
Scr:=NIL;
Win:=NIL;
TitoloSchermo:='UnitGrafica v1.0 - by FB';

{ ** AGGIUNTO: SETTEMBRE 1991   ** }
{ -- muove il cursore grafico   -- }
{ -- alla posizione 0,0         -- }
MoveTo(0,0);
end;