home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 05 / grdlagen / spiral.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-08-15  |  2.5 KB  |  82 lines
  1. (* ====================================================== *)
  2. (*                     SPIRAL.PAS                         *)
  3. (*                  Das EGA/VGA-BIOS:                     *)
  4. (*        Demo #1: Animierte Farbspirale (EGA/VGA)        *)
  5. (*           (c) 1990 Matthias Uphoff & TOOLBOX           *)
  6. (* ====================================================== *)
  7.  
  8. USES Dos, Crt, Bios2;
  9.  
  10. PROCEDURE SetVideoMode(ModeNr: Byte);
  11.   (* Intialisiert den Videomodus mit der Nummer ModeNr *)
  12.   VAR R: Registers;
  13. BEGIN
  14.   R.AH := 0;            (* Funktionsnummer nach AH *)
  15.   R.AL := ModeNr;       (* Modusnummer ins AL-Register *)
  16.   Intr($10,R);          (* BIOS-Call über Interrupt $10 *)
  17. END;
  18.  
  19. PROCEDURE Box(x1,y1,x2,y2: Word; c: Byte);
  20.    (* Zeichnet ein mit der Farbe c gefülltes Rechteck    *)
  21.    (* x1,y1 = Ecke links oben, x2,y2 = Ecke rechts unten *)
  22.    VAR x,y: Word;
  23.        R: Registers;
  24. BEGIN
  25.   FOR y := y1 TO y2 DO
  26.     FOR x := x1 TO x2 DO BEGIN
  27.       R.AH := $C;        (* Funktionsnummer *)
  28.       R.AL := c;         (* Farbe nach AL *)
  29.       R.BH := 0;         (* Bildschirmseite 0 *)
  30.       R.CX := x;
  31.       R.DX := y;
  32.       Intr($10,R);       (* BIOS-Call Punkt setzen *)
  33.     END;
  34. END;
  35.  
  36. PROCEDURE Spirale;
  37.    (* Produziert eine aus Rechtecken bestehende Spirale *)
  38.    VAR i,x,y: Word;
  39.        c:     Byte;
  40.        r:     REAL;
  41. BEGIN
  42.   c := 0;
  43.   FOR i := 0 TO 700 DO BEGIN
  44.     c := (c + 1) MOD 16;
  45.     IF c = 0 THEN c := 1;
  46.     r := i/10;
  47.     x := TRUNC(r * Cos(r) * 3) + 320;
  48.     y := TRUNC(r * Sin(r) * 2.5) + 175;
  49.     Box(x,y,x+8,y+6,c);
  50.   END;
  51. END;
  52.  
  53. PROCEDURE ColorCycling;
  54.    (* vertauscht die Palettenfarben 1..15 zyklisch *)
  55.    VAR Pal: PaletteType;
  56.        tmp: Byte;
  57.        i: Word;
  58. BEGIN
  59.       (* Tabelle Pal mit Defaultwerten füllen: *)
  60.   Pal := DefaultPal;
  61.       (* Palettenfarben zyklisch vertauschen: *)
  62.   REPEAT
  63.     tmp := Pal[15];
  64.     FOR i := 15 DOWNTO 2 DO
  65.       Pal[i] := Pal[i-1];
  66.     Pal[1] := tmp;
  67.       (* 20 ms Verzögerung - eventuell anpassen: *)
  68.     Delay(20);
  69.       (* Alle Palettenreg. mit den Werten in Pal laden: *)
  70.     SetAllPal(Pal);
  71.   UNTIL KeyPressed;
  72. END;
  73.  
  74. BEGIN  (* Hauptprogramm *)
  75.   SetVideoMode($10);   (* EGA-Grafik 640 x 350 *)
  76.   Spirale;             (* Spirale zeichnen... *)
  77.   ColorCycling;        (* ...und in Drehung versetzen *)
  78.   SetVideoMode($3)     (* zurück in den Textmodus *)
  79. END.
  80.  
  81. (* ====================================================== *)
  82. (*                   Ende SPIRAL.PAS                      *)