(***********************************************************)
(*                                                         *)
(*                       Graphix.BIC                       *)
(*                      fuer BIC 5105                      *)
(*                (MKD/K-Grafik/EPSON-Drucker)             *)
(*                     Stand: 12.2.89                      *)
(*                                                         *)
(***********************************************************)

var   XMaxGlb,XScreenMaxGlb:integer;

const YMaxGlb=199;
      AspectFactor=0.90;

procedure Screen(aktmod, aktpag, vismod, vispag : byte);
begin
INLINE(
$DD/$2A/$3E/$00         {          LD IX,(SPGR)                        }
/$DD/$6E/$1A            {          LD L,(IX+26) ;SLCTRL-Address        }
/$DD/$66/$1B            {          LD H,(IX+27)                        }
/$7E                    {          LD A,(HL)                           }
/$32/*+$0017            {          LD (ANSL),A                         }
/$3A/AKTMOD             {          LD A,(AKTMOD)                       }
/$47                    {          LD B,A ;aktiv mode                  }
/$3A/AKTPAG             {          LD A,(AKTPAG)                       }
/$4F                    {          LD C,A ;aktiv page                  }
/$3A/VISMOD             {          LD A,(VISMOD)                       }
/$57                    {          LD D,A ;visuell mode                }
/$3A/VISPAG             {          LD A,(VISPAG)                       }
/$5F                    {          LD E,A ;visuell page                }
/$CD/*+$0007            {          CALL JPIX                           }
/$5F/$00                { ANADR    DEFW SELSCR                         }
/$00                    { ANSL     DEFB 0                              }
/$18/$02                {          JR ENDSCR                           }
/$DD/$E9                { JPIX     JP (IX)                             }
)
end;

procedure ClearScreen;
begin
INLINE(
$DD/$2A/$3E/$00         {          LD IX,(SPGR)                        }
/$DD/$6E/$1A            {          LD L,(IX+26) ;SLCTRL-Address        }
/$DD/$66/$1B            {          LD H,(IX+27)                        }
/$7E                    {          LD A,(HL)                           }
/$32/*+$0008            {          LD (ANSL),A                         }
/$AF                    {          XOR A                               }
/$CD/*+$0007            {          CALL JPIX                           }
/$C3/$00                {          DEFW ZCLS                           }
/$00                    { ANSL     DEFB 0                              }
/$18/$02                {          JR ENDCLS                           }
/$DD/$E9                { JPIX     JP (IX)                             }
)
end;

procedure GetCursor;

begin
INLINE(
                        (* STATUS   EQU 98H                             *)
                        (* COMND    EQU 99H                             *)
                        (* RDPORT   EQU COMND                           *)
                        (* CURD     EQU 0E0H                            *)
                        (* CURSOR   EXT                                 *)
$DB/$98                 (* GETCURS  IN A,(STATUS)                       *)
/$E6/$04                (*          AND 4 ;FIFO empty ?                 *)
/$28/$FA                (*          JR Z,GETCURS                        *)
/$3E/$E0                (*          LD A,CURD                           *)
/$0E/$99                (*          LD C,RDPORT                         *)
/$D3/$99                (*          OUT (COMND),A                       *)
/$DB/$98                (* GETC1    IN A,(STATUS)                       *)
/$1F                    (*          RRA                                 *)
/$30/$FB                (*          JR NC,GETC1                         *)
/$ED/$68                (*          IN L,(C)                            *)
/$DB/$98                (* GETC2    IN A,(STATUS)                       *)
/$1F                    (*          RRA                                 *)
/$30/$FB                (*          JR NC,GETC2                         *)
/$ED/$60                (*          IN H,(C)                            *)
/$06/$03                (*          LD B,3                              *)
/$DB/$98                (* GETC3    IN A,(STATUS)                       *)
/$1F                    (*          RRA                                 *)
/$30/$FB                (*          JR NC,GETC3                         *)
/$ED/$78                (*          IN A,(C)                            *)
/$10/$F7                (*          DJNZ GETC3                          *)
/$22/CURSOR             (*          LD (CURSOR),HL                      *)
)
end;

procedure SetCursor;

begin
INLINE(
                        (* STATUS   EQU 98H                             *)
                        (* COMND    EQU 99H                             *)
                        (* RDPORT   EQU COMND                           *)
                        (* PARAM    EQU STATUS                          *)
                        (* CURS     EQU 49H                             *)
                        (* CURSOR   EXT                                 *)
$DB/$98                 (* SETCURS  IN A,(STATUS)                       *)
/$E6/$04                (*          AND 4 ;FIFO empty ?                 *)
/$28/$FA                (*          JR Z,SETCURS                        *)
/$3E/$49                (*          LD A,CURS                           *)
/$0E/$98                (*          LD C,PARAM                          *)
/$2A/CURSOR             (*          LD HL,(CURSOR)                      *)
/$D3/$99                (*          OUT (COMND),A                       *)
/$ED/$69                (*          OUT (C),L                           *)
/$ED/$61                (*          OUT (C),H                           *)
)
end;

procedure dp(x, y : integer);
  label ende;
begin
  y := 199-y; if y <0 then goto ende;
INLINE(
$DD/$2A/$3E/$00         {          LD IX,(SPGR)                        }
/$DD/$6E/$1A            {          LD L,(IX+26) ;SLCTRL-Address        }
/$DD/$66/$1B            {          LD H,(IX+27)                        }
/$7E                    {          LD A,(HL)                           }
/$32/*+$001C            {          LD (ANSL0),A                        }
/$32/*+$0021            {          LD (ANSL1),A                        }
/$32/*+$0027            {          LD (ANSL2),A                        }
/$32/*+$002A            {          LD (ANSL3),A                        }
/$21/X                  {          LD HL,X                             }
/$4E                    {          LD C,(HL)                           }
/$23                    {          INC HL                              }
/$46                    {          LD B,(HL) ;x-Koordinate             }
/$21/Y                  {          LD HL,Y                             }
/$5E                    {          LD E,(HL)                           }
/$23                    {          INC HL                              }
/$56                    {          LD D,(HL) ;y-Koordinate             }
/$CD/*+$001E            {          CALL JPIX                           }
/$0E/$01                {          DEFW TPPOS                          }
/$00                    { ANSL0    DEFB 0                              }
/$30/$19                {          JR NC,ENDPGR                        }
/$CD/*+$0016            {          CALL JPIX                           }
/$11/$01                {          DEFW MKPMA                          }
/$00                    { ANSL1    DEFB 0                              }
/$3A/COLORGLB           {          LD A,(COLORGLB)                     }
/$CD/*+$000D            {          CALL JPIX                           }
/$1A/$01                {          DEFW STAINK                         }
/$00                    { ANSL2    DEFB 0                              }
/$CD/*+$0007            {          CALL JPIX                           }
/$20/$01                {          DEFW SPOINT                         }
/$00                    { ANSL3    DEFB 0                              }
/$18/$02                {          JR ENDPGR                           }
/$DD/$E9                { JPIX     JP (IX)                             }
);
ende:end;

procedure Graphic_mc;
begin
  Screen(5,0,5,0);
  XMaxGlb:=40;
  XScreenMaxGlb:=319;
end;

procedure Graphic_hr;
begin
  Screen(3,1,3,1);
  XMaxGlb:=80;
  XScreenMaxGlb:=639;
end;

procedure Alpha_scr;
begin
  Screen(1,0,1,0);
end;

procedure init;
begin
  Screen(5,0,1,0);
  ClearScreen;
  Screen(3,1,1,0);
  ClearScreen;
  Graphic_hr;
end;

procedure LeaveGraphic;
begin
  Alpha_scr;
  ClearScreen;
end;

procedure hardcopy; { EPSON }
begin
INLINE(
$DD/$2A/$3E/$00         {          LD IX,(SPGR)                        }
/$DD/$6E/$1A            {          LD L,(IX+26) ;SLCTRL-Address        }
/$DD/$66/$1B            {          LD H,(IX+27)                        }
/$7E                    {          LD A,(HL)                           }
/$32/*+$0008            {          LD (ANSL),A                         }
/$AF                    {          XOR A                               }
/$CD/*+$0007            {          CALL JPIX                           }
/$AC/$76                {          DEFW BICOP                          }
/$00                    { ANSL     DEFB 0                              }
/$18/$02                {          JR ENDCOP                           }
/$DD/$E9                { JPIX     JP (IX)                             }
)
end;


procedure error (ErrProc,ErrCode:integer);
var     datei: file of string [30];
        satz : string [30];
begin
  LeaveGraphic;
  writeln ('TURBO Graphics Fehler');
{$I-}
assign (datei,'TURBO.ERR');
reset  (datei);
{$I+}
  if ioresult <> 0
     then begin
            ErrProc := 28;
            ErrCode := 13;
          end;

write ('      Procedure: ');
if (ErrProc >= 0) and (ErrProc <= 27)
   then begin
          seek (datei, ErrProc);
          read (datei, satz);
          writeln (satz);
        end
   else writeln (ErrProc:3);

write ('      Code:      ');
if (ErrCode >= 1) and (ErrCode <= 12)
   then begin
          seek (datei, ErrCode+27);
          read (datei, satz);
          writeln (satz);
        end
   else writeln (ErrCode:3);

halt;
close (datei);
end;