(* GRAPHIC ROUTINES by Ken Nist *)

type

BitMap=array[0..5759] of integer;  
LongString=string[255];
Cmap=array[0..31] of byte;
Smap=array[0..255] of byte;

var

HighResolution,VectorMode,drawing,DualMonitor: boolean;
Gmode,Yfix,GDCpat,GDCmult,GDCfg,GDCbg,GDCalu,GDCps: byte;
CharHPitch,CharVPitch,TopMargin,BottomMargin,LeftMargin,RightMargin: byte;
Temp1,Temp2,Temp3,Gtemp,maxX: integer;

const 

maxY: integer=239;

procedure GraphicsOn; begin
    Gmode:=Gmode or $80;
    port[$53]:=$BF;               { enable G.O. }
    port[$51]:=Gmode;
    if not DualMonitor then begin
        port[$57]:=$0D;
        port[$0A]:=$87 end end;   { disable VT102 }

procedure GraphicsOff; begin
    Gmode:=Gmode and $7F;         { disable G.O. }
    port[$53]:=$BF;
    port[$51]:=Gmode;
    port[$0A]:=$83 end;           { enable VT102 }

procedure GPort (parm:LongString); var PP,QQ,RR,SS: integer; begin
    QQ:=length(parm);
    PP:=1; while PP<QQ do begin
        RR:=ord(parm[PP+1])-48; if RR>15 then RR:=RR-7;
        SS:=ord(parm[PP+2])-48; if SS>15 then SS:=SS-7;
        port[ord(parm[PP])+32]:=(RR shl 4)+SS;
        PP:=PP+3 end end;

procedure Gw56(word:integer); { port[$56]:=lo(word); port[$56]:=hi(word) }
    begin inline($8B/$86/word/$E6/$56/$8A/$C4/$E6/$56) end;

procedure WaitForGDCNotBusy; begin
    inline($E4/$56/$A8/$02/$74/$0B/$B9/$00/$80/$E4/$56/$A8/$02/$74/$02/$E2/
           $F8/$B0/$0D/$E6/$57/$E4/$56/$A8/$02/$74/$0B/$B9/$00/$80/$E4/$56/
           $A8/$02/$75/$02/$E2/$F8/$B8/$0D/$04/$E6/$57/$B9/$00/$80/$E4/$56/
           $84/$E0/$75/$02/$E2/$F8);
{   for QQ:=0 to $8000 do if (port[$56] and $02)=0 then goto G1;
G1: port[$57]:=$4A;
    for QQ:=0 to $8000 do if (port[$56] and $02)=0 then goto G2;
G2: for QQ:=0 to $8000 do if (port[$56] and $04)=4 then goto G3;
G3:}end;

procedure WaitForGDCIdle; label G4; var QQ: integer; begin
    WaitForGDCNotBusy;
    if not drawing then goto G4;
    for QQ:=0 to $8000 do if (port[$56] and $0F)=4 then goto G4;
G4: end;

procedure Pattern (pat,mult:integer); begin
    GDCpat:=pat;
    GDCmult:=mult;
    WaitForGDCIdle;
    port[$53]:=$FD;  port[$51]:=16-GDCmult;
    port[$53]:=$FB;  port[$51]:=GDCpat end;

procedure LoadColorMap (var map: Cmap); begin
    WaitForGDCIdle;
    while (port[$56] and $20)<>0 do;{ wait for beginning of vertical retrace }
    inline($FA);
    while (port[$56] and $20)=0 do;
    inline($8B/$B6/map/$B0/$DF/$E6/$53/$B9/$20/
           $00/$AC/$F6/$D0/$E6/$51/$E2/$F9/$FB) end;

procedure LoadScrollMap (var map: Smap); begin
    WaitForGDCIdle;            { This routine is extremely timing sensitive.}
    Gtemp:=Gmode and $DF;      { It must start and end in the same vertical }
    inline($FA);               { retrace period, and barely does so.        }
    while (port[$56] and $20)<>0 do;
    inline($B9/$40/$1F/$E4/$56/$A8/$20/$75/$02/$E2/$F8/
           $B0/$BF/$E6/$53/$A0/Gtemp/$E6/$51/
           $B0/$7F/$E6/$53/$B2/$51/$32/$F6/
           $8B/$B6/map/$B9/$10/$00/
           $AD/$EE/$8A/$C4/$EE/$AD/$EE/$8A/$C4/$EE/
           $AD/$EE/$8A/$C4/$EE/$AD/$EE/$8A/$C4/$EE/
           $AD/$EE/$8A/$C4/$EE/$AD/$EE/$8A/$C4/$EE/
           $AD/$EE/$8A/$C4/$EE/$AD/$EE/$8A/$C4/$EE/
           $E2/$D6/$B0/$BF/$E6/$53/$A0/Gmode/$E6/$51/$FB) end;

procedure Color (FG:integer); begin
    GDCfg:=FG;
    Gtemp:=(GDCfg shl 4)+(GDCbg and 15);
    inline($B0/$F7/$E6/$53/$A0/Gtemp/$E6/$51) end;

procedure BackgroundColor (BG:integer); begin
    GDCbg:=BG;
    Gtemp:=(GDCfg shl 4)+(GDCbg and 15);
    inline($B0/$F7/$E6/$53/$A0/Gtemp/$E6/$51) end;

procedure Operation (ALU,PlaneSelect: integer); begin
    GDCalu:=ALU;
    GDCps:=PlaneSelect;
    WaitForGDCIdle;
    port[$53]:=$EF;
    port[$51]:=(GDCalu shl 4)+(GDCps and 15 xor 15);
end;

procedure Ginitialize; var PP,QQ: integer; begin
    DualMonitor:=false;
    ErrorPtr:=ofs(GraphicsOff);  { <--- This will disable graphics on a run  }
    if HighResolution then begin {      statement if it gets a compile error.}
        Gmode:=$31;
        maxX:=799;  Yfix:=6;
        GPort('7003BF1316126306646086036036F0640747640') end
      else begin
        Gmode:=$30;
        maxX:=383;  Yfix:=5;
        GPort('7003BF1306126166616046026036F0640747620') end;
    WaitForGDCNotBusy;
    GPort('76B7466007227706006006FF60F7786FF6FF74B60060060076F06F');
    Pattern(255,1);
    Color(15);
    BackgroundColor(0);
    Operation(0,15);
    GPort('400500');
    WaitForGDCNotBusy;
    GPort('3FE100');
    for QQ:=0 to 15 do port[$52]:=$FF;
    WaitForGDCNotBusy;
    GPort('3FE10074960060074A6FF6FF74C6026FF63F7226FF6FF70D');
    WaitForGDCIdle;
    end;

procedure WriteRectangle(loX,hiX,loY,hiY: integer; var area: BitMap);
var PP,QQ,RR,SS,TT,ZZ,ZZ1,ZZ2,mask: integer; 
begin
    for PP:=(loX shr 4) to (hiX shr 4) do begin
        TT:=PP shl 4;
        ZZ := swap(PP) - TT;
        mask:=$FFFF;
        if TT+15>hiX then mask:=mask shl (TT+15-hiX);
        if TT<loX then mask:=mask and ($FFFF shr (loX-TT));
        SS:=loY;
        while SS<=hiY do begin
            RR:=SS;
            SS:=SS+8;
            if SS > hiY
            then SS := hiY+1;
            ZZ1 := ZZ+RR;
            ZZ2 := ZZ+SS-1;
            inline($E4/$56/$A8/$02/$74/$0B/$B9/$00/$80/$E4/$56/$A8/$02/$74/
                   $02/$E2/$F8/$B0/$0D/$E6/$57/$E4/$56/$A8/$02/$74/$0B/$B9/
                   $00/$80/$E4/$56/$A8/$02/$75/$02/$E2/$F8/$B8/$0D/$04/$E6/
                   $57/$B9/$00/$80/$E4/$56/$84/$E0/$75/$02/$E2/$F8);
            for QQ:=ZZ1 to ZZ2 do begin
{$R-}           Gtemp:= not area[QQ];
{$R+}           inline($A1/Gtemp/$E6/$52/$8A/$C4/$E6/$52);
            end;
            if SS = hiY+1 then
            for QQ:=hiy+1 to rr+7 do
                inline($B0/$00/$E6/$52/$E6/$52);
            Temp1:=PP+(RR shl Yfix); 
            Temp2 := not mask;
            Temp3 := SS-RR-1;
            inline($B0/$49/$E6/$57/$A1/Temp1/$E6/$56/$8A/$C4/$E6/$56/$A1/
                   Temp2/$E6/$54/$8A/$C4/$E6/$55/$B0/$4C/$E6/$57/$B0/$00/
                   $E6/$56/$A1/Temp3/$E6/$56/$8A/$C4/$E6/$56/$B0/$22/$E6/
                   $57/$B0/$FF/$E6/$56/$E6/$56);
        end;
    end;
end;

procedure WriteRectangleOneByte (loX,loY,hiY: integer; 
                                var area: BitMap; 
                                mask,zz: integer);
var QQ,RR,SS,ZZ1,ZZ2: integer; 
begin
    SS:=loY;
    while SS<=hiY do 
    begin
        RR:=SS;
        SS:=SS+8;
        if SS > hiY
        then SS := hiY+1;
        ZZ1 := ZZ+RR;
        ZZ2 := ZZ+SS-1;
        inline($E4/$56/$A8/$02/$74/$0B/$B9/$00/$80/$E4/$56/$A8/$02/$74/
            $02/$E2/$F8/$B0/$0D/$E6/$57/$E4/$56/$A8/$02/$74/$0B/$B9/
            $00/$80/$E4/$56/$A8/$02/$75/$02/$E2/$F8/$B8/$0D/$04/$E6/
            $57/$B9/$00/$80/$E4/$56/$84/$E0/$75/$02/$E2/$F8);
        for QQ:=ZZ1 to ZZ2 do 
        begin
{$R-}       Gtemp:= not area[QQ];
{$R+}       inline($A1/Gtemp/$E6/$52/$8A/$C4/$E6/$52);
        end;
        if SS = hiY+1 then
        for QQ:=hiy+1 to rr+7 do
            inline($B0/$00/$E6/$52/$E6/$52);
        Temp1:=(loX shr 4)+(RR shl Yfix); 
        Temp2 := mask;
        Temp3 := SS-RR-1;
        inline($B0/$49/$E6/$57/$A1/Temp1/$E6/$56/$8A/$C4/$E6/$56/$A1/
            Temp2/$E6/$54/$8A/$C4/$E6/$55/$B0/$4C/$E6/$57/$B0/$00/
            $E6/$56/$A1/Temp3/$E6/$56/$8A/$C4/$E6/$56/$B0/$22/$E6/
            $57/$B0/$FF/$E6/$56/$E6/$56);
    end;
end;

procedure WriteRectangleTwoBytes (loX,loY,hiY: integer; 
                                var area: BitMap; 
                                mask1,mask2,zz: integer);
var QQ,RR,SS,ZZ1,ZZ2: integer; 
begin
    SS:=loY;
    while SS<=hiY do 
    begin
        RR:=SS;
        SS:=SS+8;
        if SS > hiY
        then SS := hiY+1;
        ZZ1 := ZZ+RR;
        ZZ2 := ZZ+SS-1;
        inline($E4/$56/$A8/$02/$74/$0B/$B9/$00/$80/$E4/$56/$A8/$02/$74/
            $02/$E2/$F8/$B0/$0D/$E6/$57/$E4/$56/$A8/$02/$74/$0B/$B9/
            $00/$80/$E4/$56/$A8/$02/$75/$02/$E2/$F8/$B8/$0D/$04/$E6/
            $57/$B9/$00/$80/$E4/$56/$84/$E0/$75/$02/$E2/$F8);
        for QQ:=ZZ1 to ZZ2 do 
        begin
{$R-}       Gtemp:= not area[QQ];
{$R+}       inline($A1/Gtemp/$E6/$52/$8A/$C4/$E6/$52);
        end;
        if SS = hiY+1 then
        for QQ:=hiy+1 to rr+7 do
            inline($B0/$00/$E6/$52/$E6/$52);
        Temp1:=(loX shr 4)+(RR shl Yfix); 
        Temp2 := mask1;
        Temp3 := SS-RR-1;
        inline($B0/$49/$E6/$57/$A1/Temp1/$E6/$56/$8A/$C4/$E6/$56/$A1/
            Temp2/$E6/$54/$8A/$C4/$E6/$55/$B0/$4C/$E6/$57/$B0/$00/
            $E6/$56/$A1/Temp3/$E6/$56/$8A/$C4/$E6/$56/$B0/$22/$E6/
            $57/$B0/$FF/$E6/$56/$E6/$56);
    end;
    SS:=loY;
    while SS<=hiY do 
    begin
        RR:=SS;
        SS:=SS+8;
        if SS > hiY
        then SS := hiY+1;
        ZZ1 := ZZ+RR+240;
        ZZ2 := ZZ+SS+239;
        inline($E4/$56/$A8/$02/$74/$0B/$B9/$00/$80/$E4/$56/$A8/$02/$74/
            $02/$E2/$F8/$B0/$0D/$E6/$57/$E4/$56/$A8/$02/$74/$0B/$B9/
            $00/$80/$E4/$56/$A8/$02/$75/$02/$E2/$F8/$B8/$0D/$04/$E6/
            $57/$B9/$00/$80/$E4/$56/$84/$E0/$75/$02/$E2/$F8);
        for QQ:=ZZ1 to ZZ2 do 
        begin
{$R-}       Gtemp:= area[QQ];
{$R+}       inline($A1/Gtemp/$34/$FF/$E6/$52/$8A/$C4/$34/$FF/$E6/$52);
        end;
        if SS = hiY+1 then
        for QQ:=hiy+1 to rr+7 do
            inline($B0/$00/$E6/$52/$E6/$52);
        Temp1:=(loX shr 4)+(RR shl Yfix)+1; 
        Temp2 := mask2;
        Temp3 := SS-RR-1;
        inline($B0/$49/$E6/$57/$A1/Temp1/$E6/$56/$8A/$C4/$E6/$56/$A1/
            Temp2/$E6/$54/$8A/$C4/$E6/$55/$B0/$4C/$E6/$57/$B0/$00/
            $E6/$56/$A1/Temp3/$E6/$56/$8A/$C4/$E6/$56/$B0/$22/$E6/
            $57/$B0/$FF/$E6/$56/$E6/$56);
    end;
end;