home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 12 / joycplot.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-09-29  |  4.5 KB  |  92 lines
  1. (* --------------------------------------------------------------------- *)
  2. (*                              JOYCPLOT.PAS                             *)
  3. (*    Zugriff auf das Joyce Screen-Environment mittels Turbo Pascal:     *)
  4. (* Plot(x,y,color), GetDotColor(x,y), ScrPoke(adr,val); ScrPeek(adr,val) *)
  5. (* --------------------------------------------------------------------- *)
  6.  
  7. TYPE
  8.   ScrCode = ARRAY[0..105] OF BYTE;
  9.  
  10. CONST                 (* Der Maschinencode JOPLOT.ASM nuetzt an dieser   *)
  11.   ScrConst: ScrCode = (* Stelle nichts und wird daher durch 'InitCode'.. *)
  12.                ($DD,$7E,$64,$DD,$4E,$66,$DD,$46,
  13.                 $67,$FE,$02,$38,$0C,$20,$05,$DD,
  14.                 $7E,$65,$02,$C9,$0A,$DD,$77,$65,
  15.                 $C9,$DD,$7E,$68,$E6,$F8,$6F,$26,
  16.                 $5B,$29,$5E,$23,$56,$EB,$29,$DD,
  17.                 $7E,$68,$E6,$07,$5F,$16,$00,$19,
  18.                 $79,$E6,$F8,$5F,$50,$19,$79,$E6,
  19.                 $07,$47,$3E,$80,$0F,$10,$FD,$4F,
  20.                 $DD,$7E,$64,$B7,$20,$0F,$DD,$46,
  21.                 $65,$CB,$18,$9F,$CB,$18,$38,$01,
  22.                 $AE,$A1,$AE,$77,$C9,$7E,$A1,$C6,
  23.                 $FF,$78,$17,$DD,$77,$65,$C9,$00,
  24.                 $00,$00,$00,$00,$00,$00,$00,$00,
  25.                 $00,$00);
  26.  
  27. VAR                (* ..in dieses globales Array kopiert, was als erste  *)
  28.   ScrRun: ScrCode; (* globale Variable vereinbart werden muss! Dadurch   *)
  29.                    (* wird es an der groesst moeglichen Adresse plat-    *)
  30.                    (* ziert - also im Common-Bereich von CP/M 3.0.       *)
  31. (* --------------------------------------------------------------------- *)
  32. (* Verschiebt den Maschinencode aus 'ScrConst' in das globale Array      *)
  33. (* 'ScrRun' und ueberprueft, ob der Code im CP/M-Common-Bereich liegt.   *)
  34. (* Diese Prozedur  m u s s  vor der Benutzung der folg. Funktionen ein-  *)
  35. (* malig aufgerufen werden !!!                                           *)
  36. PROCEDURE InitGraphic;
  37. BEGIN
  38.   IF Addr(ScrRun) < $C000 THEN BEGIN
  39.      WriteLn('Der Code liegt nicht im Common-Bereich !');
  40.      Halt;               (* hat keinen Zweck, ganzes Programm abbrechen! *)
  41.   END;
  42.   ScrRun := ScrConst; (* Maschinen-Code verschieben... *)
  43. END;
  44. (* --------------------------------------------------------------------- *)
  45. (* schaltet ueber das XBIOS das Screen-Environment ein und fuehrt die    *)
  46. (*                        Routine in 'ScrRun' aus:                       *)
  47. PROCEDURE DoScrCall;
  48. BEGIN  INLINE($01/ScrRun/$C5/$DD/$E1/$CD/$5A/$FC/$E9/$00)  END;
  49. (* --------------------------------------------------------------------- *)
  50. (* Setzt einen Punkt in der Farbe 'color' an die Position x,y. Der Ur-   *)
  51. (* sprung 0,0 liegt oben links. 'color'=0: dunkler Punkt (Hintergrund),  *)
  52. (* =1: heller Punkt, =2: ohne Wirkung, =3: Punkt invertieren.            *)
  53. PROCEDURE Plot (x,y: INTEGER; color: BYTE);
  54. BEGIN
  55.   ScrRun[100] := 0;                           (* Funktionsnummer f. Plot *)
  56.   ScrRun[101] := color;
  57.   ScrRun[102] := Lo(x);  ScrRun[103] := Hi(x);
  58.   ScrRun[104] := Lo(y);        (* := not lo(y) fuer Ursprung unten links *)
  59.   DoScrCall;
  60. END;
  61. (* --------------------------------------------------------------------- *)
  62. (* Gibt die Farbnummer des Punktes x,y: 1 -> gesetzt, 0 -> nicht gesetzt *)
  63. FUNCTION GetDotColor (x,y: INTEGER): BYTE;
  64. BEGIN
  65.   ScrRun[100] := 1;                       (* Funktionsnummer f. GetColor *)
  66.   ScrRun[102] := Lo(x);  ScrRun[103] := Hi(x);
  67.   ScrRun[104] := Lo(y);        (* := not lo(y) fuer Ursprung unten links *)
  68.   DoScrCall;
  69.   GetDotColor := ScrRun[101];
  70. END;
  71. (* --------------------------------------------------------------------- *)
  72. (* Schreibt ein Byte an die Adresse adr in das Screen-Environment (mit   *)
  73. (*                      Vorsicht zu geniessen!):                         *)
  74. PROCEDURE ScrPoke (adr: INTEGER; scrbyte: BYTE);
  75. BEGIN
  76.   ScrRun[100] := 2;                           (* Funktionsnummer f. Poke *)
  77.   ScrRun[101] := scrbyte;
  78.   ScrRun[102] := Lo(adr);  ScrRun[103] := Hi(adr);
  79.   DoScrCall;
  80. END;
  81. (* --------------------------------------------------------------------- *)
  82. (*     Holt ein Byte von der Adresse adr aus dem Screen-Environment:     *)
  83. FUNCTION ScrPeek (adr: INTEGER): BYTE;
  84. BEGIN
  85.   ScrRun[100] := 3;                           (* Funktionsnummer f. Peek *)
  86.   ScrRun[102] := Lo(adr);  ScrRun[103] := Hi(adr);
  87.   DoScrCall;
  88.   ScrPeek := ScrRun[101];
  89. END;
  90. (* --------------------------------------------------------------------- *)
  91. (*                              JOYCPLOT.PAS                             *)
  92.