home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 02 / appl_grf / igrafik.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-12-04  |  7.2 KB  |  221 lines
  1. (*------------------------------------------------------------------*)
  2. (*                         IGRAFIK.PAS                              *)
  3. (* Grafikprimitive f. Turbo Pascal, CP/M 80 auf Apple II/IIe mit    *)
  4. (* 80-Zeichenkarte.                                                 *)
  5. (*        (C) Prof Dr. Rudolf Borges & PASCAL INTERNATIONAL         *)
  6. (*                                                                  *)
  7. (* "SystemSicherstellen" muss vor  der ersten  Grafikanweisung auf- *)
  8. (* gerufen werden, "SystemZurueckholen" nach der letzten Grafikan-  *)
  9. (* weisung aufgerufen werden.                                       *)
  10. (* Als weitere Include-Files bei der Compilierung werden benötigt:  *)
  11. (* - im "Memory": -- IMEMMEM.PAS  fuer kurze Programme oder         *)
  12. (*                -- IMEMDISK.PAS fuer lange Programme              *)
  13. (* - als "COM-File": ICOMFILE.PAS                                   *)
  14. (* Im letzten Fall verwende man fuer die Reservierung der Apple     *)
  15. (* Grafikseite 2 entweder                                           *)
  16. (*   -- die "Start address" 5000 oder                               *)
  17. (*   -- die voreingestellte "Start address" und beginne das Pro-    *)
  18. (*      gramm mit mit "HeapzeigerSetzen".                           *)
  19. (*------------------------------------------------------------------*)
  20.  
  21. CONST ScreenXmin_Sys =   0;
  22.       ScreenXmax_Sys = 279;
  23.       ScreenYmin_Sys =   0;
  24.       ScreenYmax_Sys = 191;
  25.       First_Color_Value = 0;
  26.       Last_Color_Value  = 7;
  27.       schwarz = 0; (* gruen    = 1; violett = 2;*)
  28.       weiss   = 3; (* schwarz2 = 4; orange  = 5; blau = 6; *)
  29.       weiss2  = 7;
  30.       ScreenXmax = 279;
  31.       ScreenYmax = 191;
  32.       Grafik: BOOLEAN = FALSE;
  33.  
  34. TYPE Sys_Colors = First_Color_Value..Last_Color_Value;
  35.      (* Folgende Typen muessen im aufrufenden Programm stehen: *)
  36.      (* x_Koord_Sys = Integer;                                 *)
  37.      (* y_Koord_Sys = Integer;                                 *)
  38.  
  39. VAR (* Adresse der Zeile des zuletzt angesprochenen Punktes *)
  40.     ZeilenAdr  : INTEGER ABSOLUTE $F026;
  41.     (* Maske fuer Setzen bzw. Loeschen eines Punktes *)
  42.     Maske      : BYTE ABSOLUTE $F030;
  43.     RegA       : BYTE ABSOLUTE $F045;
  44.     RegAX      : INTEGER ABSOLUTE $F045;
  45.     RegX       : BYTE ABSOLUTE $F046;
  46.     RegXY      : INTEGER ABSOLUTE $F046;
  47.     RegY       : BYTE ABSOLUTE $F047;
  48.     (* Alte x- und y-Koordinaten des "Grafikcursors" *)
  49.     (* Dient auch als Anfangspunkt von PlotLine.     *)
  50.     (* Benennung "Pen_X_Pos" bzw. "Pen_Y_Pos" wuerde *)
  51.     (* bei Screenbit zu Fehlern fuehren.             *)
  52.     AltesX     : INTEGER ABSOLUTE $F0E0;
  53.     AltesX     : BYTE ABSOLUTE $F0E2;
  54.     (* Spalten-Nr., des zuletzt angesprochene Bit einer HGR-Seite *)
  55.     SpaltenAdr : BYTE ABSOLUTE $F0E5;
  56.  
  57.  
  58. PROCEDURE call6502(address: INTEGER);
  59.  
  60. VAR Adr6502: INTEGER ABSOLUTE $F3D0;
  61.     Z80CARD: INTEGER ABSOLUTE $F3DE;
  62.  
  63. BEGIN
  64.   Adr6502 := address;
  65.   Mem(.Z80CARD.) := 0
  66. END;
  67.  
  68.  
  69. PROCEDURE Set_Pen_Color(Color: Sys_Colors);
  70. BEGIN
  71.   RegX := Color;
  72.   call6502($F6F0);
  73.   (* Gegebenenfalls einfuegen: Pen_Color := Color; *)
  74. END;
  75.  
  76.  
  77. PROCEDURE GrafikLoeschen;
  78. BEGIN
  79.   Mem(.$F0E6.) := $40;           (* Parameter der Grafikseite 2 *)
  80.   call6502($F3F2);
  81.   AltesX := 300; AltesX := 200;   (* willkuerliche Anfangswerte *)
  82.   Set_Pen_Color(weiss);
  83. END;
  84.  
  85.  
  86. PROCEDURE GrafikEin;  (* ohne die letzte Grafik zu loeschen *)
  87. (* Vor erstem Aufruf einer Grafikroutine beim Kompilieren *)
  88. (* - im "Memory":  "EditorSicherstellen" !                *)
  89. (* - als COM-file: "GrafikLoeschen"                       *)
  90. BEGIN
  91.   Mem(.$E00C.) := $00; (* 80 Zeichen aus      *)
  92.   Mem(.$E000.) := $00; (* Apple I/O ein       *)
  93.   Mem(.$E050.) := $00; (* Grafik ein          *)
  94.   Mem(.$E052.) := $00; (* Vollgrafik ein      *)
  95.   Mem(.$E055.) := $00; (* Grafikseite 2 ein   *)
  96.   Mem(.$E057.) := $00; (* Hohe Aufloesung ein *)
  97.   Grafik       := TRUE;
  98. END;
  99.  
  100.  
  101. PROCEDURE Enter_Graphic;
  102. BEGIN
  103.  GrafikLoeschen;
  104.  (* Gegebenenfalls einfuegen; Pen_XPos := 0; Pen_YPos := 0; *)
  105.  GrafikEin;
  106. END;
  107.  
  108.  
  109. PROCEDURE Exit_Graphic;  (* ohne die Grafik zu loeschen *)
  110. (* Nach dem letzten Aufruf einer Grafikroutine beim  *)
  111. (* Kompilieren im "Memory":   "EditorZurueckholen" ! *)
  112. BEGIN
  113.   Mem(.$E056.) := $00; (* Hohe Aufloesung aus *)
  114.   Mem(.$E054.) := $00; (* Seite 2 aus         *)
  115.   Mem(.$E053.) := $00; (* Vollgrafik aus      *)
  116.   Mem(.$E051.) := $00; (* Text Modus          *)
  117.   Mem(.$E001.) := $00; (* Apple I/O aus       *)
  118.   Mem(.$E00D.) := $00; (* 80 Zeichen ein      *)
  119.   Grafik       := FALSE;
  120. END;
  121.  
  122.  
  123. FUNCTION Koordinatentest(x, y: REAL): BOOLEAN;
  124. BEGIN
  125.  Koordinatentest := (x>=ScreenXmin_Sys) AND (x<=ScreenXmax_Sys)
  126.                     AND (y<=ScreenYmax_Sys) AND (y>=ScreenYmin_Sys);
  127. END;
  128.  
  129.  
  130. PROCEDURE Position(x: x_Koord_Sys; y: y_Koord_Sys);
  131. (* setzt den Grafikcursor unsichtbar an der Stelle (x,y) *)
  132. BEGIN
  133.   IF (AltesX <> x) OR (Altesy <> y) THEN
  134.     IF Koordinatentest(x,y) THEN BEGIN
  135.       RegXY := x;
  136.       RegA := y;
  137.       call6502($F411)
  138.     END
  139. END;
  140.  
  141.  
  142. PROCEDURE Point_System(x: x_Koord_Sys; y: y_Koord_Sys);
  143. (* Punkt setzen (x,y) *)
  144. BEGIN
  145.   IF Koordinatentest(x,y) THEN BEGIN
  146.     RegXY := x;
  147.     RegA := y;
  148.     call6502($F457)
  149.   END
  150. END;
  151.  
  152.  
  153. PROCEDURE Plotline(x: x_Koord_Sys; y: y_Koord_Sys);
  154. (* Zeichnet eine Gerade von (Altesx, Altesy) nach (x,y) *)
  155. BEGIN
  156.   IF Koordinatentest(x,y) THEN BEGIN
  157.     RegAX := x;
  158.     RegY := y; call6502($F53A)
  159.   END
  160. END;
  161.  
  162.  
  163. FUNCTION ScreenBit(x: x_Koord_Sys; y: y_Koord_Sys): BOOLEAN;
  164. (* Fuer Get_Pixel_System *)
  165. BEGIN
  166.   Position(x, y);
  167.   ScreenBit :=
  168.     ((Maske AND Mem(.ZeilenAdr + SpaltenAdr - $1000.) AND $7F) > 0);
  169. END;
  170.  
  171.  
  172. PROCEDURE HeapzeigerSetzen;
  173. (* Nur fuer die Kompilierung als COM-file mit voreingestellter *)
  174. (* Startadresse als erste Anweisung notwendig.                 *)
  175. BEGIN
  176.   IF HeapPtr > 0 THEN
  177.     IF HeapPtr < $3000 THEN
  178.       HeapPtr := $5000
  179.     ELSE
  180.       IF HeapPtr < $5000 THEN BEGIN
  181.         WriteLn('Die Grafikseite ueberschneidet sich mit dem Code!');
  182.         Halt
  183.       END
  184. END;
  185.  
  186. (*------------------------------------------------------------------*)
  187. (*                   Laufzeit-Fehlerbehandlung                      *)
  188. (* Die vordefinierte Integer-Variable ErrorPtr gibt es erst ab      *)
  189. (* Version 3.0. Bei Verwendung aelterer Versionen klammere die fol- *)
  190. (* genden Programmzeilen aus, aendere entsprechend die Include-Da-  *)
  191. (* teien IMemMem.Pas usw.                                           *)
  192. (* Benutze bei der Programmentwicklung wiederholt die Anweisungs-   *)
  193. (* folge: "GrafikEin; Delay(3000); Exit_Graphic;", um im Hinter-    *)
  194. (* grund zu zeichnen und gegebenenfalls im Vordergrund Laufzeitfeh- *)
  195. (* lermeldungen entgegenzunehmen und dann mit einem Warmstart usw.  *)
  196. (* das System neu laden zu können.                                  *)
  197. (*------------------------------------------------------------------*)
  198.  
  199. VAR SaveErrorPtr: INTEGER;
  200.  
  201. PROCEDURE OldErrorCheck;
  202. BEGIN
  203.   ErrorPtr := SaveErrorPtr
  204. END;
  205.  
  206.  
  207. PROCEDURE SystemZurueckbringen; FORWARD;
  208.  
  209.  
  210. PROCEDURE ErrorCheck(Code, PC: INTEGER);
  211. BEGIN
  212.   SystemZurueckbringen
  213. END;
  214.  
  215.  
  216. PROCEDURE InitErrorCheck;
  217. BEGIN
  218.   SaveErrorPtr := ErrorPtr;
  219.   ErrorPtr     := Addr(ErrorCheck);
  220. END;
  221.