{Copyright (c) 1985 by Kenneth Nist}
{Permission to copy without fee all or part of this material is granted }
{provided that copies are not made or distributed for direct commercial}
{advantage, the copyright notice given above appears, and notice is given that}
{copying is by permission of the copyright owners. To copy otherwise }
{requires a specific license.}
{Address: Kenneth Nist, 257 Stow Road, Harvard MA 01451}
{ Arpa: in care of Pauline Nist}
type BitMap=array[0..23,0..239] of integer;
{ typical bit maps: 0..23 for med-res, 0..49 for hi-res }
type LongString=string[255];
Cmap=array[0..31] of byte;
Smap=array[0..255] of byte; var
HighResolution,VectorMode,drawing,PreBlanking,CursorEnabled,
DualMonitor,CurSave: boolean;
Gmode,Yfix,GDCpat,GDCmult,GDCfg,GDCbg,GDCalu,GDCps: byte;
CharHPitch,CharVPitch,TopMargin,BottomMargin,LeftMargin,RightMargin: byte;
Gtemp,cursorX,cursorY,maxX,FillStylePattern,FillStyleVrot: integer;
CharVectorTable: array[0..134] of integer;
CscaleX,CscaleY: array[0..14] of integer;
Gsine: array[0..64] of real;
const maxY: integer=239;
{const font: array[0..844] of byte = (}
const font: array[0..1271] of byte = (
$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
$FF,$42,$43,$FE,$45,$48,$FF, { ! }
$36,$38,$FE,$56,$58,$FF, { " }
$32,$38,$FE,$52,$58,$FE,$26,$66,$FE,$24,$64,$FF, { # }
$41,$49,$FE,$23,$32,$52,$63,$64,$55,$35,$26,$27,$38,$58,$67,$FF, { $ }
$23,$67,$FE,$26,$27,$37,$36,$26,$FE,$53,$63,$64,$54,$53,$FF, { % }
$62,$26,$27,$38,$48,$57,$56,$23,$22,$42,$64,$FF, { & }
$46,$48,$FF, { ' }
$60,$33,$36,$69,$FF, { ( }
$20,$53,$56,$29,$FF, { ) }
$24,$74,$FE,$32,$66,$FE,$62,$36,$FF, { * }
$43,$47,$FE,$25,$65,$FF, { + }
$32,$22,$23,$33,$31,$20,$FF, { , }
$25,$65,$FF, { - }
$22,$23,$33,$32,$22,$FF, { . }
$12,$78,$FF, { / }
$32,$24,$26,$FE,$38,$26,$FE,$32,$52,$64,$66,$FE,$38,$58,$66,$FE,$44,$46,$FF,
$26,$48,$42,$FE,$22,$62,$FF, { 1 }
$27,$38,$58,$67,$66,$22,$62,$63,$FF, { 2 }
$27,$38,$58,$67,$66,$55,$64,$63,$52,$32,$23,$FE,$35,$55,$FF, { 3 }
{ $28,$25,$65,$FE,$52,$58,$FF, } { 4 }
$64,$24,$58,$52,$FF,
$23,$32,$52,$63,$64,$55,$25,$28,$68,$FF, { 5 }
$24,$35,$55,$64,$63,$52,$32,$23,$27,$38,$58,$67,$FF, { 6 }
$28,$68,$67,$23,$22,$FF, { 7 }
$23,$24,$35,$26,$27,$38,$58,$67,$66,$55,$64,$63,$52,$32,$23,$FE,$35,$55,$FF,
$23,$32,$52,$63,$67,$58,$38,$27,$26,$35,$55,$66,$FF, { 9 }
$37,$47,$46,$36,$37,$FE,$34,$44,$43,$33,$34,$FF, { : }
$37,$47,$46,$36,$37,$FE,$43,$33,$34,$44,$42,$31,$FF, { ; }
$52,$25,$58,$FF, { < }
$24,$64,$FE,$26,$66,$FF, { = }
$32,$65,$38,$FF, { > }
$28,$39,$59,$68,$67,$56,$46,$44,$FE,$42,$41,$FF, { ? }
$62,$32,$23,$28,$39,$69,$78,$75,$64,$54,$45,$46,$57,$67,$76,$FF, { @ }
$22,$26,$48,$66,$62,$FE,$25,$65,$FF, { A }
$22,$28,$58,$67,$66,$55,$64,$63,$52,$22,$FE,$25,$55,$FF, { B }
$67,$58,$38,$27,$23,$32,$52,$63,$FF, { C }
$22,$28,$58,$67,$63,$52,$22,$FF, { D }
$62,$22,$28,$68,$FE,$25,$45,$FF, { E }
$22,$28,$68,$FE,$25,$45,$FF, { F }
$67,$58,$38,$27,$23,$32,$52,$63,$65,$45,$FF, { G }
$22,$28,$FE,$25,$65,$FE,$62,$68,$FF, { H }
$32,$52,$FE,$42,$48,$FE,$38,$58,$FF, { I }
$23,$32,$52,$63,$68,$FF, { J }
$22,$28,$FE,$24,$68,$FE,$35,$62,$FF, { K }
$62,$22,$28,$FF, { L }
$22,$28,$46,$68,$62,$FF, { M }
$22,$28,$62,$68,$FF, { N }
$32,$23,$27,$FE,$38,$27,$FE,$32,$52,$63,$67,$FE,$38,$58,$67,$FF, { O }
$22,$28,$58,$67,$66,$55,$25,$FF, { P }
$44,$62,$FE,$52,$32,$23,$27,$38,$58,$67,$63,$52,$FF, { Q }
$22,$28,$58,$67,$66,$55,$25,$FE,$35,$62,$FF, { R }
$23,$32,$52,$63,$64,$55,$35,$26,$27,$38,$58,$67,$FF, { S }
$28,$68,$FE,$42,$48,$FF, { T }
$28,$23,$32,$52,$63,$68,$FF, { U }
$28,$24,$42,$64,$68,$FF, { V }
$28,$22,$44,$62,$68,$FF, { W }
$22,$23,$67,$68,$FE,$62,$63,$27,$28,$FF, { X }
$28,$46,$42,$FE,$46,$68,$FF, { Y }
$28,$68,$67,$23,$22,$62,$FF, { Z }
$59,$39,$31,$51,$FF, { [ }
$18,$72,$FF, { \ }
$39,$59,$51,$41,$FF, { ] }
$26,$48,$66,$FF, { ^ }
$21,$91,$FF, { _ }
$76,$58,$FF, { }
$62,$66,$FE,$64,$56,$36,$25,$23,$32,$52,$64,$FF, { a }
$28,$23,$32,$52,$63,$65,$56,$36,$25,$FF, { b }
$63,$52,$32,$23,$25,$36,$56,$65,$FF, { c }
$68,$62,$FE,$63,$52,$32,$23,$25,$36,$56,$65,$FF, { d }
$52,$32,$23,$25,$36,$56,$65,$64,$24,$FF, { e }
$42,$47,$58,$68,$77,$FE,$25,$65,$FF, { f }
$64,$53,$33,$24,$25,$36,$56,$65,$61,$50,$30,$21,$FF, { g }
$22,$28,$FE,$25,$36,$56,$65,$62,$FF, { h }
$42,$45,$FE,$47,$48,$FF, { i }
$68,$67,$FE,$65,$61,$50,$30,$21,$FF, { j }
$22,$28,$FE,$23,$56,$FE,$34,$52,$FF, { k }
$42,$48,$FF, { l }
$22,$26,$FE,$25,$36,$45,$56,$65,$62,$FE,$42,$45,$FF, { m }
$22,$26,$FE,$25,$36,$56,$65,$62,$FF, { n }
$23,$25,$36,$56,$65,$63,$52,$32,$23,$FF, { o }
$26,$20,$FE,$23,$32,$52,$63,$65,$56,$36,$25,$FF, { p }
$63,$52,$32,$23,$25,$36,$56,$65,$FE,$66,$60,$FF, { q }
$22,$26,$FE,$25,$46,$66,$65,$FF, { r }
$22,$52,$63,$54,$34,$25,$36,$66,$FF, { s }
$26,$66,$FE,$48,$43,$52,$63,$FF, { t }
$26,$23,$32,$52,$63,$FE,$66,$62,$FF, { u }
$26,$24,$42,$64,$66,$FF, { v }
$26,$22,$44,$62,$66,$FF, { w }
$22,$66,$FE,$26,$62,$FF, { x }
$26,$23,$32,$52,$63,$FE,$66,$61,$50,$20,$FF, { y }
$26,$66,$22,$62,$FF, { z }
$61,$42,$44,$25,$FE,$69,$48,$46,$25,$FF, {Lbr}
$41,$44,$FE,$46,$49,$FF, { | }
$21,$42,$44,$65,$FE,$29,$48,$46,$65,$FF, {Rbr}
$27,$49,$67,$89,$FF, { ~ }
$29,$FF, {del}
$72,$D8,$C9,$63,$54,$BA,$AB,$45,$36,$9C,$8D,$27,$18,$7E,$FF, {diamond}
$72,$FE,$63,$83,$FE,$54,$94,$FE,$35,$B5,$FE,$26,$C6,$FE,$17,$D7,
$FE,$08,$E8,$FE,$09,$79,$FE,$79,$E9,$FE,$0A,$6A,$FE,$8A,$EA,$FE,
$1B,$5B,$FE,$9B,$DB,$FE,$2C,$5C,$FE,$9C,$CC,$FE,$3D,$4D,$FE,$AD,
$BD,$FF, {heart}
$51,$91,$FE,$62,$82,$FE,$63,$83,$FE,$74,$FE,$33,$FE,$24,$44,
$FE,$15,$55,$FE,$06,$66,$FE,$17,$57,$FE,$28,$48,$FE,$39,$FE,
$BE,$FE,$A4,$C4,$FE,$95,$D5,$FE,$86,$E6,$FE,$97,$D7,$FE,$A8,
$C8,$FE,$B9,$FE,$78,$FE,$69,$89,$FE,$5A,$9A,$FE,$4B,$AB,$FE,
$5C,$9C,$FE,$6D,$8D,$FE,$7E,$FF, {club}
$61,$81,$FE,$72,$74,$FE,$B2,$FE,$32,$FE,$23,$43,$FE,$A3,$C3,
$FE,$14,$D4,$FE,$05,$E5,$FE,$16,$D6,$FE,$17,$D7,$FE,$28,$C8,
$FE,$29,$C9,$FE,$3A,$BA,$FE,$4B,$AB,$FE,$5C,$9C,$FE,$6D,$8D,
$7E,$FF, {spade}
$3B,$2A,$23,$32,$42,$FE,$52,$41,$FE,$62,$51,$FE,$72,$50,$FE,
$82,$71,$FE,$81,$A3,$AA,$FE,$23,$13,$14,$FE,$A3,$B3,$B4,$FE,
$44,$84,$85,$45,$FE,$68,$46,$66,$FE,$38,$48,$FE,$88,$98,$FE,
$3B,$2A,$FE,$4B,$3A,$FE,$5B,$4A,$FE,$5A,$6B,$7A,$FE,$8B,$9A,
$FE,$9B,$AA,$FE,$4B,$3C,$2B,$AB,$9C,$8B,$FE,$6B,$6E,$FE,$5D,
$7D,$FE,$C1,$CB,$DD,$EB,$E1,$FE,$D3,$DA,$FE,$7B,$8A,$FF, {jack}
$13,$12,$22,$2A,$3B,$34,$61,$81,$B4,$BB,$CA,$C2,$D2,$D3,$FE,
$06,$05,$15,
$19,$2A,$F3,$CA,$D9,$D5,$E5,$E6,$FE,$64,$84,$FE,$78,$66,$76,
$FE,$3B,$4C,$FE,$BB,$AC,$FE,$48,
$47,$57,$58,$FE,$98,$97,$A7,$A8,$FE,$49,$59,$FE,$99,$A9,$FE,
$5C,$5A,$4A,$4B,$FE,$7C,$7A,$6A,$6B,$FE,$9C,$9A,$8A,$8B,$FE,
$3D,$5C,$9C,$BD,$FE,$6C,$5D,$FE,$8C,$9D,$FE,$7C,$7E,$FE,$6D,
$8D,$FF, {queen}
$70,$72,$FE,$81,$82,$FE,$61,$62,$FE,$52,$22,$2A,$FE,$92,$B2,
$BA,$FE,$54,$94,$FE,$55,$56,$FE,$65,$66,$FE,$75,$76,$FE,$85,
$86,$FE,$79,$57,$77,$FE,$98,$A8,$FE,$38,$48,$FE,$B3,$D3,$D4,
$FE,$23,$03,$04,$FE,$0A,$DA,$DC,$0C,$0A,$FE,$7B,$7E,$FE,$6D,
$8D,$FE,$0C,$2E,$4C,$FE,$DC,$BE,$9C,$FF); {king}
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 WaitForNotBusy; begin
inline($B8/$22/$04/$E6/$57/$E4/$56/$84/$E0/$74/$FA) end;
procedure VectorPrep; begin
WaitForGDCNotBusy;
if not VectorMode then begin
Gmode:=Gmode or 2; { port[$53]:=$BF, port[$51]:=Gmode }
inline($B0/$BF/$E6/$53/$A0/Gmode/$E6/$51);
VectorMode:=true end end;
procedure WordPrep; begin
WaitForGDCNotBusy;
if VectorMode then begin
Gmode:=Gmode and $FD; { port[$53]:=$BF, port[$51]:=Gmode }
inline($B0/$BF/$E6/$53/$A0/Gmode/$E6/$51);
VectorMode:=false end 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;
WaitForGDCIdle;
Gtemp:=(GDCfg shl 4)+(GDCbg and 15);
inline($B0/$F7/$E6/$53/$A0/Gtemp/$E6/$51) end;
procedure BackgroundColor (BG:integer); begin
GDCbg:=BG;
WaitForGDCIdle;
Gtemp:=(GDCfg shl 4)+(GDCbg and 15);
inline($B0/$F7/$E6/$53/$A0/Gtemp/$E6/$51) end;
procedure Operation (ALU,PlaneSelect: integer); begin
if CursorEnabled then RevCursor;
GDCalu:=ALU;
GDCps:=PlaneSelect;
WaitForGDCIdle;
port[$53]:=$EF;
port[$51]:=(GDCalu shl 4)+(GDCps and 15 xor 15);
if CursorEnabled then RevCursor end;
procedure Ginitialize; var PP,QQ: integer; begin
CursorEnabled:=false;
DualMonitor:=false;
ErrorPtr:=ofs(GraphicsOff); { <--- This will disable graphics on a run }
VectorMode:=false; { error on Turbo 3.0 only. Discard }
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);
CharScale(5,7,6,10);
CharCursor(maxX,maxY);
CharNewLine;
GPort('400500');
PP:=-1;
for QQ:=0 to 134 do begin { Build the character index table }
CharVectorTable[QQ]:=PP+1;
repeat PP:=PP+1 until font[PP]=$FF end;
WaitForGDCNotBusy;
GPort('3FE100');
for QQ:=0 to 15 do port[$52]:=$FF;
WaitForGDCNotBusy;
GPort('3FE10074960060074A6FF6FF74C6026FF63F7226FF6FF70D');
WaitForGDCIdle;
end;
procedure GDCcursor(x,y:integer); begin
Gtemp:=(x shr 4)+(y shl Yfix); {port[$57]:=$49;port[$56]:=lo;port[$56]:=hi}
inline($B0/$49/$E6/$57/$A1/Gtemp/$E6/$56/$8A/$C4/$E6/$56);
if VectorMode then begin
Gtemp:=(x and 15) shl 4;
inline($A0/Gtemp/$E6/$56) end end;
procedure GDCfigs(octant:integer); begin {port[$57]:=$4C; port[$56]:=octant }
inline($B0/$4C/$E6/$57/$8A/$86/octant/$E6/$56) end;
procedure WriteRectangle(loX,hiX,loY,hiY: integer; var area: BitMap);
var PP,QQ,RR,SS,TT,mask: integer; begin
WordPrep;
WaitForGDCNotBusy;
for PP:=(loX shr 4) to (hiX shr 4) do begin
mask:=$FFFF;
TT:=PP shl 4;
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;
WaitForGDCNotBusy;
inline($B0/$FE/$E6/$53/$E6/$51); { port[$53]:=$FE; port[$51]:=$FE }
for QQ:=RR to SS-1 do begin
{$R-} Gtemp:=area[PP,QQ]; { port[$52]:=lo; port[$52]:=hi }
{$R+} inline($A1/Gtemp/$34/$FF/$E6/$52/$8A/$C4/$34/$FF/$E6/$52) end;
GDCcursor(TT,RR);
Gtemp:=mask xor $FFFF; { port[$54]:=lo; port[$55]:=hi }
inline($A1/Gtemp/$E6/$54/$8A/$C4/$E6/$55);
GDCfigs(0); {0=down,2=right,4=up,6=left}
Gw56(SS-RR-1); { port[$57]:=$22; port[$56]:=FF; port[$56]:=$FF }
inline($B0/$22/$E6/$57/$B0/$FF/$E6/$56/$E6/$56);
end end end;
procedure ReadPrep; begin
WordPrep; { port[$53]:=$EF; port[$51]:=$0F }
inline($B0/$EF/$E6/$53/$B0/$0F/$E6/$51) end; { disable all writes }
function ReadWord (x,y,plane: integer): integer; begin
Gtemp:=(Gmode and $E1) or (plane and 3 shl 2); { set mode reg }
inline($B0/$BF/$E6/$53/$A0/Gtemp/$E6/$51);
Gtemp:=x+(y shl Yfix); { set cursor }
inline($B0/$49/$E6/$57/$A1/Gtemp/$E6/$56/$8A/$C4/$E6/$56/
$B0/$4C/$E6/$57/$B0/$00/$E6/$56/ { figs, octant 0 }
$B0/$01/$E6/$56/$B0/$00/$E6/$56/ { count = 1 }
$B0/$A0/$E6/$57/ { issue read }
$E4/$56/$A8/$01/$74/$FA/$E4/$57/$8A/$D8/ { read 1st byte }
$E4/$56/$A8/$01/$74/$FA/$E4/$57/$8A/$E0/ { read 2nd byte }
$8A/$C3/$A3/Gtemp/$B0/$0D/$E6/$57);
ReadWord:=Gtemp end;
procedure DrawLine (x1,y1,x2,y2:integer);
const newP1: array[0..7] of byte = (9,14,10,13,8,15,11,12);
var P1,deltaX,deltaY,ind,dep: integer; begin
VectorPrep;
if (x1=x2) and (y1=y2) then DrawPoint(x1,y1) else begin
GDCcursor(x1,y1);
deltaX:=x2-x1;
deltaY:=y2-y1;
if deltaX>0 then P1:=0 else begin P1:=1; deltaX:=-deltaX end;
if deltaY<0 then begin P1:=P1+2; deltaY:=-deltaY end;
if deltaY>deltaX then begin
P1:=P1+4;
ind:=deltaY; dep:=deltaX end
else begin
ind:=deltaX; dep:=deltaY end;
GDCfigs(newP1[P1]);
Gw56(ind and $3fff);
Gw56((dep+dep-ind) and $3fff);
Gw56(((dep-ind) shl 1) and $3fff);
Gw56((dep+dep-1) and $3fff);
inline($B0/$6C/$E6/$57); { port[$57]:=$6C; }
drawing:=true;
end;
end;
procedure DrawBar (loX,hiX,loY,hiY: integer);
var PP,QQ,deltaY,mask,OLDbg: integer; begin
WordPrep;
OLDbg:=GDCbg;
BackgroundColor(GDCfg);
for PP:=(loX shr 4) to (hiX shr 4) do begin
mask:=$FFFF;
QQ:=PP shl 4;
if QQ+15>hiX then mask:=mask shl (QQ+15-hiX);
if QQ<loX then begin
mask:=mask and ($FFFF shr (loX-QQ));
QQ:=loX end;
WaitForGDCNotBusy;
Gtemp:=mask xor $FFFF;
{ port[$54]:=lo; port[$55]:=hi }
inline($A1/Gtemp/$E6/$54/$8A/$C4/$E6/$55);
GDCcursor(QQ,loY);
inline($B0/$00/$E6/$56); { port[$56]:=0; }
deltaY:=hiY-loY;
GDCfigs(8);
Gw56(deltaY);
Gw56((-deltaY) and $3fff);
Gw56(((-deltaY) shl 1) and $3fff);
Gw56(0);
inline($B0/$6C/$E6/$57) end; { port[$57]:=$6C; }
drawing:=true;
BackgroundColor(OLDbg);
end;
procedure GCNewLine; begin
cursorX:=LeftMargin;
cursorY:=cursorY+CharVPitch;
if cursorY>maxY-BottomMargin then cursorY:=TopMargin+CharVPitch end;
procedure CharNewLine; begin
if CursorEnabled then RevCursor;
GCNewLine;
if CursorEnabled then RevCursor end;
procedure DrawString (st: LongString); label stloop1,stloop2,stend;
var QQ,newX,newY,oldX,oldY: integer; PP,C,point,OLDfg: byte;
function min(x,y:integer):integer;
begin
if x<y then min:=x else min:=y
end;
begin
if CursorEnabled then RevCursor;
VectorPrep;
if length(st)>0 then for PP:=1 to length(st) do begin
if PreBlanking then begin
OLDfg:=GDCfg;
Color(GDCbg);
QQ:=cursorY-CscaleY[0];
DrawBar(cursorX,cursorX+CharHPitch-1,
QQ-CharVPitch+3,QQ+2);
Color(OLDfg);
VectorPrep end;
C:=ord(st[PP]);
if C<=134 then begin
QQ:=CharVectorTable[C];
stloop1: point:=font[QQ];
QQ:=QQ+1;
if point=$FF then goto stend;
oldX:=cursorX-2+CscaleX[(point shr 4)];
oldY:=cursorY+2-CscaleY[(point and 15)];
stloop2: point:=font[QQ];
QQ:=QQ+1;
if point<$F0 then begin
newY:=cursorY+2-CscaleY[(point and 15)];
newX:=cursorX-2+CscaleX[(point shr 4)];
DrawLine(oldX,min(oldY,239),newX,min(newY,239));
oldX:=newX;
oldY:=newY;
goto stloop2 end;
if point<$FF then goto stloop1;
stend: end;
cursorX:=cursorX+CharHPitch;
if cursorX>maxX-RightMargin-CharHPitch then GCNewLine;
end;
if CursorEnabled then RevCursor;
end;
procedure CharCursor; begin
if CursorEnabled then RevCursor;
cursorX:=x;
cursorY:=y;
if CursorEnabled then RevCursor end;
procedure CharScale;
var PP: integer; x4,y6: real; begin
if CursorEnabled then RevCursor;
CharHPitch:=HPitch;
CharVPitch:=VPitch;
x4:=(x-1)/4; y6:=(y-1)/6;
for PP:=0 to 14 do begin
CscaleX[PP]:=2+round(x4*(PP-2));
CscaleY[PP]:=2+round(y6*(PP-2)) end;
if CursorEnabled then RevCursor end;
procedure ClearAllPlanes; var fg,QQ: integer; begin
fg:=GDCfg;
Color(0);
GPort('3EF100');
if HighResolution then QQ:=1023 else QQ:=511;
DrawBar(0,QQ,0,255);
Color(fg);
Operation(GDCalu,GDCps); end;
procedure FillStyle (pat,vrot: integer); begin
FillStylePattern:=pat;
FillStyleVrot:=vrot end;
procedure RevCursor; var PP,QQ: integer; begin
WaitForGDCIdle;
port[$53]:=$EF; { Operation(1,GDCps) }
port[$51]:=16+(GDCps and 15 xor 15);
QQ:=cursorY-CscaleY[0];
for PP:=cursorX to cursorX+CharHPitch-1 do
DrawLine(PP,QQ-CharVPitch+3,PP,QQ+2);
WaitForGDCNotBusy;
port[$53]:=$EF; { Operation(OLDalu,GDCps) }
port[$51]:=(GDCalu shl 4)+(GDCps and 15 xor 15) end;
procedure CursorOn; begin
if not CursorEnabled then RevCursor;
CursorEnabled:=true end;
procedure CursorOff; begin
if CursorEnabled then RevCursor;
CursorEnabled:=false end;
procedure BackUpCursor; var CPL,LPP: integer; begin
cursorX:=cursorX-CharHPitch;
if cursorX<LeftMargin then begin
CPL:=(maxX+1-LeftMargin-RightMargin) div CharHPitch;
cursorX:=LeftMargin+(CPL-1)*CharHPitch;
cursorY:=cursorY-CharVPitch;
if cursorY<TopMargin then begin
LPP:=(maxY+1-TopMargin-BottomMargin) div CharVPitch;
cursorY:=TopMargin+(LPP-1)*CharVPitch end end end;
procedure ConRead (var st:LongString; count: integer);
label ex,ok; var C,PP: integer; ch: char; CurSave: boolean; begin
st:=' ';
PreBlanking:=true;
PP:=1; while PP<count+1 do begin
while not KeyPressed do;
read(kbd,ch);
C:=ord(ch);
if C=$0D then goto ex;
if (C=$7F) or (C=$08) then begin
if PP>1 then begin
CurSave:=CursorEnabled;
if CursorEnabled then CursorOff;
BackUpCursor;
PP:=PP-1;
st[PP]:=' ';
DrawString(' ');
BackUpCursor;
if CurSave then CursorOn end;
end
else if C=$12 then begin
if (Gmode and $80)=0 then GraphicsOn else GraphicsOff end
else begin
ok: DrawString(ch);
st[PP]:=ch;
PP:=PP+1 end;
end;
ex: st[0]:=chr(PP-1) end;
{ Revision History: }
{ }
{ 1. The original code, by Ken Nist, was debugged on a Rainbow 100B with }
{ a VR241 color CRT and 320K of RAM running Turbo Pascal 2.0 on }
{ MS-DOS 2.11. }
{ }
{ 1.1 Debugged for Turbo 3.0 and Turbo-87 3.0. Monochrome operation }
{ checked out with VR201. Added automatic "GraphicsOff" when a }
{ run-time error occurs. Added visible cursor and controls to }
{ DrawString. Program structure revised to permit easier }
{ interfacing. (The graphics package has been made an Include }
{ file called by the user program.) }
{ }
{ 1.2 Dual CRT operation checked out OK. "Color" procedure redefined }
{ as "Color" and "BackgroundColor". }
{ }
