home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 04 / extra / monitor.joy < prev    next >
Encoding:
Text File  |  1989-01-25  |  3.4 KB  |  134 lines
  1. {************************************************}
  2. {*                 MONITOR.JOY                  *}
  3. {*     Monitortreiber für das Grafiksystem für  *}
  4. {*           Schneider Joyce/Armstrad PCW       *}
  5. {*          (C) 1989 S.Szkaradnik & TOOLBOX     *}
  6. {************************************************}
  7.  
  8.  
  9. (* Overlay *) (* Bei Speichermangel in Turbo 3.0*)
  10.               (* als Overlay deklarieren !      *)
  11. PROCEDURE MonitorDriver ( VAR Par : Parameters ) ;
  12.  
  13. TYPE
  14.   Code = ARRAY [ 0..1 ] OF BYTE ;
  15.  
  16. CONST
  17.   PeekCode : Code =    (
  18.    $7E,                 {    ld       a,(hl)   }
  19.    $C9                  {    ret               });
  20.   PokeCode : Code =    (
  21.    $77,                 {    ld       (hl),a   }
  22.    $C9                  {    ret               });
  23.  
  24. VAR
  25.   AsmPeek, AsmPoke : Code ;
  26.  
  27. CONST
  28.   { Disable text cursor and status line }
  29.   MonInit = #27#102#27#48 ;
  30.   { Enable text cursor and status line }
  31.   MonExit = #27#101#27#49 ;
  32.  
  33. FUNCTION Open : BOOLEAN ;
  34. BEGIN
  35.    IF ( Addr ( AsmPeek ) >= $C000 )
  36.      AND ( Addr ( AsmPoke ) >= $C000 )
  37.     THEN BEGIN
  38.         Device := Monitor ;
  39.         AsmPeek := PeekCode ;
  40.         AsmPoke := PokeCode ;
  41.         Xmin := 0 ; Xmax := 719 ;
  42.         Ymin := 0 ; Ymax := 255 ;
  43.         Write ( MonInit ) ;
  44.         Open := TRUE ;
  45.       END
  46.     ELSE
  47.       Open := FALSE ;
  48. END ;
  49.  
  50. PROCEDURE ScrPoke ( Adr : Pointer ;
  51.                     ScrByte : BYTE );
  52. BEGIN
  53.   INLINE (
  54.     $21/ScrByte/   {    ld       hl,scrbyte  }
  55.     $7E/           {    ld       a,(hl)      }
  56.     $2A/Adr/       {    ld       hl,(adr)    }
  57.     $01/AsmPoke/   {    ld       bc,asmpoke  }
  58.     $CD/$5A/$FC/   {    call     xbios       }
  59.     $E9/$00        {    dw       00E9H       } )
  60. END ;
  61.  
  62. FUNCTION ScrPeek ( Adr : Pointer ) : BYTE ;
  63. VAR Result : BYTE ;
  64. BEGIN
  65.   INLINE (
  66.     $2A/Adr/       {    ld       hl,(adr)    }
  67.     $01/AsmPeek/   {    ld       bc,asmpeek  }
  68.     $CD/$5A/$FC/   {    call     xbios       }
  69.     $E9/$00/       {    dw       00E9H       }
  70.     $21/Result/    {    ld       hl,result   }
  71.     $77            {    ld       (hl),a      } ) ;
  72.   ScrPeek := Result
  73. END ;
  74.  
  75. FUNCTION Roller ( Y : BYTE ) : Pointer ;
  76. CONST Roll = $B600 ;
  77. VAR Adr : Pointer ;
  78. BEGIN
  79.   Adr := Ptr ( Roll + Y SHL 1 ) ;
  80.   Roller := Ptr ( ScrPeek ( Adr )
  81.             + ScrPeek(Ptr(Succ(Ord(Adr)))) SHL 8)
  82. END ;
  83.  
  84. FUNCTION Adr ( X, Y : INTEGER ) : Pointer ;
  85. CONST Mask = $FFF8 ;
  86. VAR Rol : Pointer ;
  87. BEGIN
  88.   Y := 255 - Y ;
  89.   Rol := Roller ( Y ) ;
  90.   Adr :=Ptr((Ord(Rol) AND Mask SHL 1 + X) AND Mask
  91.          + Ord (Rol) AND 7);
  92. END ;
  93.  
  94. FUNCTION Point ( X, Y : INTEGER ) : BOOLEAN ;
  95. BEGIN
  96.   IF ( X >= Xmin ) AND ( X <= Xmax )
  97.      AND ( Y >= Ymin ) AND ( Y <= Ymax )
  98.     THEN BEGIN
  99.         IF ScrPeek ( Adr ( X, Y ) )
  100.            AND Pat [ X AND 7 ] = 0
  101.           THEN Point := FALSE
  102.           ELSE Point := TRUE ;
  103.       END
  104.     ELSE Fence ;
  105. END ;
  106.  
  107. PROCEDURE Dot ( X, Y : INTEGER ) ;
  108. VAR Ad : Pointer ;
  109. BEGIN
  110.   Control ( X, Y ) ;
  111.   Ad := Adr ( X, Y ) ;
  112.   IF Tool = Pen THEN
  113.     ScrPoke ( Ad, ScrPeek ( Ad )
  114.     OR Pat [ X AND 7 ] ) ;
  115. END ;
  116.  
  117. PROCEDURE Plot ( X, Y : INTEGER ) ;
  118. BEGIN
  119.   Control ( X, Y ) ;
  120.   Position.X := X ; Position.Y := Y ;
  121. END ;
  122.  
  123. BEGIN
  124.   WITH Par DO
  125.     CASE Command OF
  126.       OpenF  : Result := Open ;
  127.       PointF : Result := Point ( X, Y ) ;
  128.       PlotF  : Plot ( X, Y ) ;
  129.       DotF   : Dot ( X, Y ) ;
  130.       ClearF : ClrScr ;
  131.       CloseF : Write ( MonExit )
  132.     END ;
  133. END ;
  134.