(* 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;



You are viewing proxied material from sdf.org. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.