/* Spheres.rexx
   zeichnet eine Reihe (beleuchteter) Kugeln
   unter Verwendung von DigiPaint

   (c) and written by Bob Malzan 1990
*/

  if ~Show(P,'DigiPaint') then do
    Say "Spheres.rexx (c) 1991 Bob Malzan"
    Say
    Say "DigiPaint muß zuerst gestartet werden!"
    options PROMPT "Ende mit <RETURN>"
    pull it
    exit
  end

  address 'DigiPaint'	/* DigiPaint Port adressieren */
  'Frbx'		/* Bildschirm nach vorne */

  Call KugelBrush	/* Brush mit Kugel erzeugen */
  Call Ground()
  Call Sky()

  'Aoff'	/* modi rücksetzen */
  'Drre'	/* Dither ein */
  'Floo'	/* Füllen ein */
  'Sizi'	/* TxMap-Modus */
  'Aaon'	/* Anti-Aliasing */
  'Rdit'	/* Zufallsmuster-Mischen ein */
  'Pot0' $8888 	/* Mitteneinblendung */
  'Pot1' $8888 	/* Randeinblendung */
  'Pot5' $ffff 	/* Verzerrung abschalten */

  /* ich möchte keine Brush-Wiederholungen, */
  /* also herunterzählen: */
  do for 9
    'Txdn'; 'Tydn'
  end

  /* Hauptschleife zeichnet 5x5x5 Kugeln */
  Size=40
  Step=-0.5
  /* Tiefe */
  do zn= 5 for 5 by Step
    /* Höhe */
    do y=-120 for 5 by 80
      /* Breite */
      do x=-120 for 5 by 80
        /* Kugel zeichnen */
        call PointRec((x+140)%zn,y%zn,Size%zn)
      end
    end
  end
exit			/* Programmende */

/*--------------------------------------------------------*/
PointRec:	Procedure
Arg u,v,Size

  'Pend' 160+u-Size 128-v-Size
  'Penu' 160+u+Size 128-v+Size
return

/*--------------------------------------------------------*/
Clear:		Procedure
Arg R,G,B

  'Aoff'		/* alle Modi aus */
  'Prgb' R G B		/* Löschfarbe festlegen */
  'Clrs'
  'Dotb'		/* Stift ist im Punktmodus */
  'Bsz1'		/* kleinster Stift */
return			/* Clear fertig */

/*--------------------------------------------------------*/
/*  Farbbereich festlegen: Es scheint keinen direkten Weg */
/*  zu geben, um die Bereichsfarben festzulegen, deshalb  */
/*  mache ich einen Umweg über die Farbregister e und f   */
/*--------------------------------------------------------*/
SetCRange:		procedure
arg Rs,Gs,Bs,Re,Ge,Be

  'Pale'		/* Farbpalette zeigen */
  do for 200;end	/* (Verzögerung) */

  'Prgb' Rs Gs Bs	/* Bereichsanfangsfarbe */
  do for 200;end	/* (Verzögerung) */
  'Ccto' 		/* kopiere Farbe nach... */
  'Cbxg'		/* Bereichsanfang definieren */
  'Cbxi'
  'Ugad'

  'Prgb' Re Ge Be	/* Bereichsendefarbe */
  do for 200;end	/* (Verzögerung) */
  'Ccto'
  'Cbxh'		/* Bereichsende definieren */
  'Cbxi'
  'Ugad'

return

/*--------------------------------------------------------
 Kugelbrush
	erzeugt eine Kugel und kopiert sie in den
	Pinselspeicher
--------------------------------------------------------*/
KugelBrush:		Procedure
  Call Clear(0,0,0)	/* Bildschirm löschen etc. */
  Call SetCRange(4,4,15, 0,0,6) /* Farbbereich festlegen */

  'Aoff'		/* alle Modi aus */
  'Flon'		/* Füllen ein */
  'Drci'		/* Kreismodus (falsch als 'Drei' dokumentiert!) */
  'Pmso'		/* Zeichenmodus RANGE */
  'Hvoff'; 'Hvar'	/* 2-Wege einblenden ein */
  'Maxc'		/* maximale Mitteneinblendung */
  'Maxe'		/* maximale Randeinblendung */
  'Poth' $4000		/* Lichtfleck etwas nach */
  'Potv' $4000		/* links oben */

/*                            Kugel erzeugen                            */
  'Pend' 160 100	/* etwa in die Mitte des Bildschirms zeichnen */
  'Penu' 240 100	/* Kreis aufziehen */

/*                       Lichtfleck auf der Kugel                       */
  'Maxc'		/* maximale Mitteneinblendung */
  'Pot1' $4000		/* stärkere Randeinblendung */
  'Poth' $8000		/* Lichtfleck in die */
  'Potv' $8000		/* Mitte */
  'Pmcl'		/* Zeichenmodus Normal */
  'Prgb' 15 15 15	/* weiß */
  'Pend' 130 70		/* Lichtfleck setzen */
  'Penu' 150 70		/* Kreis etwas aufziehen */

/*                          Kugel ausschneiden                          */
  'Cbx0'		/* Farbe 0 selektieren */
  'Ccto';'Trans';'Cbx0'	/* Farbe 0 transparent */
  'Cbxi'		/* Farbe 0 deselektieren */
  'Drre'		/* Rechteck-Modus */
  'Scis'		/* + Scheren-Modus */
  'Pend'  1  1
  'Penu' 319 255	/* ...ausschneiden */
  'Bcop'		/* Pinsel kopieren */

  Call Clear(0,0,0)	/* Bild wieder löschen */
return			/* KugelBrush fertig */

Ground:			Procedure

  /*               Farbbereich festlegen              */
  call SetCRange(5,15,10,3,10,8)

  /*                   Boden zeichnen                 */
  'Pmso'		/* Zeichenmodus RANGE */
  'Flon'		/* Füllen ein */
  'Hvoff'; 'Varr'	/* 1-Wege vert. einblenden ein */
  'Potv' $FFFF		/* nach unten */
  'Maxc'		/* maximale Mitteneinblendung */
  'Maxe'		/* maximale Randeinblendung */

  'Ugad'
  'Drre'		/* Rechteck-Modus */
  'Pend' 0 150
  'Penu' 319 255	/* Boden zeichnen */

return

Sky:			Procedure

  /*               Farbbereich festlegen              */
  call SetCRange(10,10,15,5,5,10)

  /*                   Boden zeichnen                 */
  'Pmso'		/* Zeichenmodus RANGE */
  'Flon'		/* Füllen ein */
  'Hvoff'; 'Varr'	/* 1-Wege vert. einblenden ein */
  'Potv' $FFFF		/* nach unten */
  'Maxc'		/* maximale Mitteneinblendung */
  'Maxe'		/* maximale Randeinblendung */

  'Ugad'
  'Drre'		/* Rechteck-Modus */
  'Pend' 0 0
  'Penu' 319 149	/* Himmel zeichnen */

  'Pmcl'		/* Zeichenmodus NORMAL */
  'Drar'		/* Ellipsen-Modus */
  'Midc'		/* mittlere Mitteneinbl. */
  'Mine'		/* minimale Randeinbl. */
  'Prgb' 15 15 15	/* Wolkenfarbe weiß */

  /* Wolken zufällig zeichnen */
  do X=10 to 300 by 3
     Mx = Random(0,30)
     My = Random(10,110)
    'Pend' X+Mx My
    'Penu' X++Mx+Random(10,30) My+Random(2,10)
  end

return