{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 RevCursor; forward; procedure CharNewLine; forward; procedure CharCursor (x,y: integer); forward; procedure CharScale (x,y:real;HPitch,VPitch:byte); forward; 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 PP15 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 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; 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 TThiY 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 WritePrep; begin WordPrep; inline($B0/$4C/$E6/$57/$B0/$00/$E6/$56/ { figs, octant 0 } $E6/$56/$E6/$56) end; { count = 1 } procedure WriteWord(x,y,data: integer); begin Gtemp:=x+(y shl Yfix); inline($B0/$FE/$E6/$53/$E6/$51/ { init write buffer } $8B/$86/data/$34/$FF/$E6/$52/$8A/$C4/$34/$FF/$E6/$52/{ fill buffer } $B0/$FE/$E6/$53/$E6/$51/ { init write buffer } $B0/$49/$E6/$57/$A1/Gtemp/$E6/$56/$8A/$C4/$E6/$56/ { set cursor } $B0/$22/$E6/$57/$B0/$FF/$E6/$56/$E6/$56); { write } end; procedure WriteMask (mask: integer); begin Gtemp:=mask xor $FFFF; { port[$54]:=lo; port[$55]:=hi } inline($A1/Gtemp/$E6/$54/$8A/$C4/$E6/$55) end; procedure ReadWriteEnd; begin WaitForGDCNotBusy; GPort('3EF1004FF5FF74C600600600722'); { re-enable pixel writes } Operation(GDCalu,GDCps) end; { restore users Op reg } procedure DrawPoint(x,y: integer); begin VectorPrep; GDCcursor(x,y); { port[$57]:=$4C; port[$56]:=2; port[$57]:=$6C } inline($B0/$4C/$E6/$57/$B0/$02/$E6/$56/$B0/$6C/$E6/$57) 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 QQmaxY-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 x0 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 cursorX1 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". } { }