LnSOS BOOT 1.1 SOS.KERNEL SOS KRNLI/O ERRORFILE 'SOS.KERNEL' NOT FOUND%INVALID KERNEL FILE: xةw,@  ȱlmi8#)!) vb'Z;K<[f GRAFOUT GRAFOUT MODELGRAMODELGRATEXTGRAFTEXTGRAFGRAFIN GRAFIN EX : !  VIEW.TRANS.LIB:\&!\&-PLOTDEMO.TEXT ; ! /SIMPLEDEMO.CODE9 ! 1SIMPLEDEMO.LIB:\ !\ /SIMPLEDEMO.TEXT 9 !  /SPLINEDEMO.CODE ; ! 8SPLINEDEMO.LIB:\!\/SPLINEDEMO.TEXT)8 !++GRAFIN.TEXT8 ! /GRAFOUT.ID.TEXT7 ! ,GRAFOUT.TEXTh7l7 !2 -MODELGRAF.LIB`6 !7 -PLOTDEMO.CODE ; ! PLOTDEMO.LIB:\!\III.GRX.06CS.06u' .CURVEDEMO.CODE : ! CURVEDEMO.LIB:: ! .CURVEDEMO.TEXT9 ! /GRAFIN.ASM.TEXT 8 !4.GRAFIN.ID.TEXT8 !~GRAFIN.LINK >dLԡm#i㰼m#iЕOLԡȱfg hi !dLԡ憦  Ljmkm l y`2 Lԡ8(Je稽)ʈ@L*+78()$%3 Third Wave Graphics ToolKit Version 1.0 15-Apr-85  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdef procedure D_Escape ( var Buffer : byteStream; Transfer_Len : integer );  {-------Drawing Primitives--------------}  procedure D_MoveTo ( X, Y : real ); procedure D_LineTo ( X, Y : real ); procedure D_Marker ( X, Y : real ); procedr;   {-------Device Control------------------}  procedure InstallDevice ( DeviceName : string );  procedure D_SetDevice ( DeviceName : string );  procedure D_Open;  procedure D_Reset; procedure D_Close; (end; (   {-------Global Variables----------------}  var $OutDevice : interactive; $Cur_DState, Head_DState : dStatePntr; $ErrorReporting : boolean; $NumDevices : integeracter Lfont in device coordinates } ,CRot : real; { Character rotation angle } ,BaseLine : real; { Baseline value of current hardware Lcharacter font. } ,DCP : rVector2; { Device current pen position } ( ,FillType : integer; { Index of current fill type } ,MarkerType : integer; { Index of current marker type } ,FontIndex : integer; { Index to device character fonts } ,CSize : rVector2; { Current size of device char; { Index of current pen color } ,PenSize : integer; { Index of current pen size } ,LineType : integer; { Index of current line type } ,FillCol : integer; { Index of current fill color } er; { Number of different marker types } ,Fonts : integer; { Number of different device fonts } , ,VPortBounds : rRect; { ViewPort } ,GrafPage : integer; { Grafix Page of device ( if any ) } ,PenCol : intege { Number of different colors } ,LineTyps : integer; { Number of different line types } ,PenSizes : integer; { Number of different pen sizes } ,FillTyps : integer; { Number of different fill types } ,MarkTypes : integ,AspectRatio : real; { Aspect ratio of device : i.e. Lthe ratio : Metric.y / Metric.x } ,DevFactor : rVector2; { NDC to Device Conversion Factors } ,Pages : integer; { Number of grafix pages } ,Colors : integer; Origin : rVector2; { Logical origin of device } ,Metric : rVector2; { Width and height of the display Lsurface in centimeters } :'')ter to next active device Ldescriptor record ( if any ) } ,DeviceNum : integer; { Device Number } ,DeviceName : string; { Device Name } ,Width,Height :real; { Width and Height of Display Lsurface in device coordinates } ,] of real ); 8end; ( (rRect= record :BotLeft : rVector2; :TopRight : rVector2; 8end; ( (dStatePntr = ^DeviceState; ( (deviceState = record @{ Device State Descriptor Record Definition } * ,Link : dStatePntr; { Poin ({$C GrafOut Copyright (C) 1983, 1984 Third Wave Graphics }  uses {$u *lib/RasterCore.lib } (MemoryManager, (RasterCore;   type rVector2 = record case boolean of :true: : ( x : real; y : real ); :false: =( xy : array [0..1ure D_RMoveTo ( dX, dY : real ); procedure D_RLineTo ( dX, dY : real ); procedure D_RMarker ( dX, dY : real );  procedure D_FillRect ( rct : rRect ); procedure D_Polygon ( NumPnts : integer; var CPoints : wordStream );  procedure D_Curve ( NumPnts : integer; Closed : boolean; :CurveType : integer; var CPoints : wordStream );   {-------Drawing Attributes--------------}  procedure D_GrafixOn; procedure D_TextOn; procedure D_ViewPort ( Left, Right, Bottom, Top : real );  pr&Dá>+צpd;pr +- +,+- +; /+)ܢ\ݼݢ.á &< ب/+)áB 8888&) &\/+ܢ/- +,+ܢ1- +צ;pu;sm; \ /+)ܢ\ݼݢ.á &Dá>+צpu;pr +- +,+- +; /+)ܢ\ݼݢ.á +)áxܣRá &b& ܢT?ܢV?&ܣR+&"O&*&@& & áܣRP+sm.;R+sm+;B+smO;2+sm*;"+sm@; XJ<. +pu;paá & OáI+pu;pa+ܢ/- +,+ܢ1- +;~/.+)á &OáI+pd;pa+ܢ/- +,+ܢ1- +;~ /.á,á&++.RS232"ˡ)/+)(T/+)á&/)+)á +צpu;</+)á+/+)á$ȡ+:/.+)f)(ɡg)/,`+++++(á,+(+(++ˡ+++,+,,,PBW280ׯCP280ׯצBW560COL140ׯ,,%tV تP/+&/++)h)T,/+)ȡ(پپ 0 @+ɡ(ھ ھٿ3F,F F>-+)\ܢ .تP/צ implementation P E -----}  procedure Init_DState ( DeviceName : string ); procedure Get_DState ( DeviceName : string; var Pointer : dStatePntr );  procedure Save_DState ( var State : deviceState ); procedure Load_DState ( State : deviceState ); {-------Error Handling------------------}  procedure UserError ( Unit_Num, Proc_Num, Err_Num, Severity : mByte);   {-------Version Control-----------------}  function GrafOut_Version : real;  evice Descriptor Records-------}  procedure Init_DState ( DeviceName : string ); procedure Get_DState ( DeviceName : string; var Pointer : dStatePntr );  procedure Save_DState ( var State : deviceState ); string; var Width,Height : real );   {-------Graphics Data Segments----------}  procedure Open_GrafSeg ( GrafId : integer ); procedure Close_GrafSeg ( GrafId : integer );  procedure Show_GrafSeg ( Device : string; GrafId : integer );   {-------D ( Index : integer );  procedure D_ChrSize ( Width, Height : real ); procedure D_ChrRot ( Angle : real );  {-------Inquiries-----------------------} procedure Get_DCP ( var XPen, YPen : real );  procedure D_TextExtent ( TextString : procedure D_FillType ( Index : integer );  procedure D_MarkerType ( Index : integer );  {-------Text Primitives and Attributes--}  procedure D_TextString ( TextString : string ); procedure D_LineFeed ( Rows : real );   procedure D_Font ocedure D_GrafixPage ( Index : integer );  procedure D_PenColor ( Index : integer );  procedure D_PenSize ( Index : integer ); procedure D_LineType ( Index : integer ); procedure D_FillColor ( Index : integer ); ġ+)á&Ǘ),/ +)á&& & /#)%)/+) DáC 8888&) & áy+צiw +/ +,+1 +,+/ +,+1 +; ./+)٣=J٢Lؚá=&á+)+ +)+ǿ٢;٢+٢7٢J٢+)  uses RealModes, Transcend, ({$u *lib/RasterCore.Lib } (MemoryManager, (RasterCore, ({$u *lib/ModelGraf.Lib } (GrafOut;  const Deg2Rad= 0.0174532925; (Pi= 3.1415927;   type cSystem = ( World, NDC, Device ); (t; to continue...á)/?*)/+)+*+(++צBW280צCP280צBW560צCOL140HP+,2+1/+,+1+/+0///+/ǀɍ /&///&Lf8LZh  2  N B  * \ rzx^*/צUser Error! Unit= +- צ Proc= +-  ErrorNum= +. צ- Press to Exit; to continue...á)/?*)/+)+*+(++צBW280צCP280צBW560צCOL140HP+,2+1/+,+1+/+0///+/ǀɍ /&/צRet_Dynamic, Ret_Segs= +/  +0 /&צUser Error! Unit= +- צ Proc= +-  ErrorNum= +. צ- Press to Exi,+1/ +,+3- +;/BFJHLNOPQSRTUVXZ<(+-ۻ+-ڻ+.ٻ+.ػ+-/+*+-ç+.Ä&Open_Memory Failureá&h)&Rb&/+)٢\٢^ ؝+)` 'ب`/á_BW280ׯb8צCP280b%BW560ׯbצCOL140bb&/(h)}áx+צin;+ip +1 +,+3 +,Z,D----,--,+,7,5,3,7!,9,-,;,+,7,9,-,7,;,+++)á+(%h)X%٪P/+,+)ˡ+) ؝+)*&؝+(/,S,X,T,V,Z,á,-',+ ,/zC,1C,3A,5A,=,>,?,@,A,B,C,L,M,P,N,O,Q,R,S,X,T,-P,V,T?+&/+,,á,BW280ׯ,CP280ׯ ,-,צBW560 ,-/,צCOL140 ,-Nj,+ǿ,/,1,3A,5,=,>,?,@,A,B,C,L,M,P,N,O,Q,R#; אT@?T+si ++,++;  /+)XڪP/+)áٝ'$؝'%ٝ+)T؝+)VRJ!"#٪PR$تP/\X+)/á&/+)٣C,٢Sؚá+צCS +٣S +;)N/1)2)/+)T+)V+)á+) Z?T#; א?V)٣>٢Pؚá& )4/+)٣A٢Qؚ)*/+)٣B٢Rؚ)(/+)ݢ\ݢ^" تP/+)//á&4/á--+ +צlb++-+j/+)٣>7٢Mؚá&á +צsp+ +;)Z/+)٣@٢Nؚ)(/+)٣?>٢Oؚá1á+lt;+צlt + +;)`/+projType = ( Perspective, OrthoGraphic, :Plan_Oblique, Elevation_Oblique ); (vOrient = ( V_Right, V_Up, V_Preferred ); ( (rVector3= record case boolean of :true: =( x: real; y: real; z: real ); :false: =( xyz: array [0..2] of real ); 9end; ( (rVector4= record case boolean of :true: : ( x: real; y: real; z: real; w: real ); :false: =( xyzw: array [0..3] of real ); 8end; ( (matrix= record case boolean of :true: =( i: rvector4; j: rvector4; = k: rvecto procedure RMarker_3D ( dX,dY,dZ : real ); ( ({-------Complex Primitives--------------} (  procedure PolyLine ( Dimension,NumPnts: integer; var CPoints: wordStream );  procedure PolyMarker ( Dimension,NumPnts: integer; var CPoints: wordStrveTo_3D ( X,Y,Z : real );  procedure LineTo_3D ( X,Y,Z : real );  procedure Marker_3D ( X,Y,Z : real );  procedure RMoveTo_3D ( dX,dY,dZ : real );  procedure RLineTo_3D ( dX,dY,dZ : real ); To_2D ( X,Y : real );  procedure LineTo_2D ( X,Y : real );  procedure Marker_2D ( X,Y : real );  procedure RMoveTo_2D ( dX,dY : real );  procedure RLineTo_2D ( dX,dY : real );  procedure RMarker_2D ( dX,dY : real );  procedure Mow_State;  ( ({-------Device Control------------------} (  procedure SetDevice ( DeviceName : string );  procedure GetNDC2 ( DeviceName : string; var Width, Height : real );  ({-------Simple Primitives---------------} (  procedure Move*YonClipping : boolean; { Perform Yon Clipping? } ( Clipping : boolean; { Perform 2D Clipping } (end;  {-------Public Global Variables--------}   var IdentMatrix : matrix; (Cur_MState : model_State; (Cur_VState : viepe : H{ Right, Up, or Preferred } *ForeShort : real; { Foreshortening ratio } *RecedAng : real; { Angle of receding lines in degrees } *HitherClipping : boolean; { Perform Hither Clipping? } t } *FrontDistance : real; { Hither plane distance Jfrom EyePoint } *BackDistance: real; { Yon Plane distance from EyePoint } *ViewOrient : rVector3; { View Orientation vector } *OrientType : vOrient; { Orientation ty real; { Angle of rotation about V-axis } *NormFocal : real; { Normalized Focal Length } *LensOn : boolean; { True if normalized focal length Jis used } *ViewDistance: real; { View distance from EyePoin*EyePoint : rVector3; { Center of Projection } *ViewNormal : rVector3; { Viewplane Normal } *RollAng : real; { Angle of rotation about ViewNorm } *PitchAng : real; { Angle of rotation about U-axis } *YawAng :ctor2; { ViewPort center in NDC coordinates } *ViewHalf : rVector2; { ViewPort half sizes } *Projection : projType; { Viewing Projection type } *ViewingMatrix : matrix; { Viewing Transformation } } *SplineParts : integer; { Number of parts in a spline } (end; 1  (viewState = record *WindowCenter: rVector2; { U-V coordinates of Window Center } *WindowHalf : rVector2; { U and V Window HalfSizes } *ViewCenter : rVeric Transformation } *GeoPostMult : boolean; { Pre/ Post Multiplication for Jgeometric transformation } *CombinMatrix: matrix; { Current Combined Transformation } *CurveParts : integer; { Number of parts in a circle Jor ellipse@{ Modelling State Descriptor record Definition } *CP : rvector4; { Current Pen Position } *RightHand : boolean; { True if world coordinate system is Jright-handed; False if left-handed } *GeoMatrix : matrix; { Geometr4; l: rvector4 ); 8 false: ( mn: array [0..3] of rvector4 ); 8end; ( (modelState = record :'')PBBINTEGER x SREAL eam );  procedure PolyGon ( Dimension,NumPnts: integer; var CPoints: wordStream ); procedure Arc ( XCenter, YCenter : real; ArcAngle : real); procedure Frame ( Width, Height : real );  procedure Circle ( Radius : real ); procedure Ellipse ( MajorAxis,MinorAxis : real );  procedure Spline ( NumPnts : integer; Closed, Hull : boolean; :var CPoints : wordStream ); ({-------Drawing Attributes--------------} (  procedure RightHand ( Switch : boolean ); proce*)7IتP*/*/hI*/I-+?-?++-+,?-?+(-+)ZڪP/-*&/A-7?ٳ?-7ٳ?-7س?h*)ٳ ( A,B : rvector4 ) : real; procedure CrossProduct ( var C : rVector3; A,B : rVector3 );  procedure TForm ( var Dst : rVector4; Src : rVector4; Mat : matrix );  procedure MatMult ( var C : Matrix; A,B : Matrix );  ({-------Version Control-----------------}   function ModGraf_Version : real;   implementation P E ve_VState ( var State : viewState ); procedure Load_VState ( State : viewState );   {-------Math Utilities------------------} ( function DotProd4 ( A,B : rvector4 ) : real; procedure CrossProduct ( var C : rVector3; A,B : rVector3 );  procedure TForm ( var Dst : rVector4; Src : rVector4; Mat : matrix );  procedure MatMult ( var C : Matrix; A,B : Matrix );  ({-------Version Conprocedure Load_MState ( State : modelState );   procedure Initial_VState; procedure Save_VState ( var State : viewState ); procedure Load_VState ( State : viewState );   {-------Math Utilities------------------} ( function DotProd4 nce : real; Switch : boolean ); ({-------Viewing Utilities---------------}   procedure NewView; ({-------State Records-------------------}  procedure Initial_MState; procedure Save_MState ( var State : modelState ); Distance : real );  procedure ForeShortRatio ( Ratio : real );  procedure RecedLineAng ( Angle : real );   procedure Clipping ( Switch : boolean );  procedure HitherPlane ( Distance : real; Switch : boolean ); procedure YonPlane ( Dista procedure RollView ( Angle : real);  procedure PitchView ( Angle : real ); procedure YawView ( Angle : real );   procedure LensSize ( NormLength : real );  procedure LensOn ( Switch : boolean );  procedure ViewDistance ( {-------Viewing Attributes--------------} (  procedure Projection ( PType : projType );  procedure EyePoint ( X,Y,Z : real );  procedure ViewNormal ( X,Y,Z : real );  procedure ViewOrient ( X,Y,Z : real; Orientation: vOrient); ure Window ( Left, Right, Bottom, Top : real );  procedure ViewCenter ( XCenter, YCenter : real );  procedure ViewSize ( Width, Height : real );  procedure ViewPort ( Left, Right, Bottom, Top : real ); SrcX,SrcY,SrcZ : real; Src : cSystem; :var DstX,DstY,DstZ : real; Dst : cSystem );   {-------Window / ViewPort Routines------}  procedure WindowCenter ( UCenter, VCenter : real );  procedure WindowSize ( Width, Height : real );  proced SkewX ( SkewAngle : real );  procedure SaveMatrix ( var SaveArea : matrix ); procedure LoadMatrix ( SaveArea : matrix );  procedure MatConcat ( A : matrix );  procedure PostMult ( Switch : boolean );  procedure Transform ( procedure ScaleAll ( ScaleFactor : real );  procedure Translate ( TransX, TransY, TransZ : real ); procedure XRot ( RotateAng : real ); procedure YRot ( RotateAng : real ); procedure ZRot ( RotateAng : real ); proceduredure CurveParts ( Parts : integer );  procedure SplineParts ( Parts : integer );  ({-------Geometric Transformations-------} (  procedure Identity;  procedure Scale ( ScaleX, ScaleY, ScaleZ : real ); سTzآآ"Jآآآ*K8%8'8KL$8'8KL " 8%8'8KL$8'8KL " 8%8'8KL$8'8KL " 8KL&8KL $ 8KL&8KL $&á& &<5  !  #   ???%&'%'ȡH!#818ؕ T*)7U/ȡǗUdšǞUQR̃7ʃ7ȡ SڡTfD/78!8#96; 8k&ʧ88ٕ818ٕ  S8ȡӶ81ؤӶ8ؤ88ؕ818ؕ81ؤ8ؤ88ؕ888818R8ȡؤ81٤8٤88ٕ818ٕؤ81٤8٤kRkӶk(c JQ8188881881ӶӶӶӶ́ʁġQ٤ƀ٤ؤ٤٤ƀ٤ؤ٤TkӶؤ٤ƀ?́ʁȡƀ٤?ƀؤ@٤ؤ@k٤ƀ٤٤ؤ@٤ƀ٤??ƀٶ?  ?ƀٶ ?  ́ʁġx٤ƀ٤Ӷ ٤ؤ٤٤ƀ٤ ٤@٤ ٤ ƀ٤ ٤ ٤  ٤ ??ƀٶ?   Ӷ?ƀٶӶ ӶӶƀ?  ? ́ʁȡ ٤?@ ؤƀ٤ƀؤ ٤٤@k٤ ٤٤ ȡٝ881٤*>??*>8٤?*? ́ʁȡ5kk88'88á8 88%8LȡMۏ8ۏ8áۏ8 88%L8L` *)7P/ȡǛP<šǜP8l88*)7N/ɍǖNɡǗNá788'ȡMۏ8ۏ8áۏ8 88%LT*)7O/ɍǖOɡǗOá78KL& 8KL $*)7M/ɍǖMɡǗMá788'ȡPۏ8ۏ8áۏ8 88%LW%%!#??B *)7V/1V2V??/ ǝ*)7 C8k<5  8!@ ?  ?  E6E  8K8K8K\8Z8?8S88[88c88) 8c8c$R[888)8}á[7\9 Ǡ*)7\8á8 9 Ǡ*)7[  E  8K8K8Kب /8J 8*8*G 8*8*G8#@4%888 88 8ͧ8 88 8M8 8-8 8m8 8-8 8 8 88 8m8 8M8 zZ888 J8)  "G?8K?8 K?8K?8KX8*8 8#/ا8* #ب /8* 8#@$/8J&ڢ(08@ڢ*2:Bڢ$,4 <"ڢ&.6 >"ڢ(08 @"ڢ*2: B ,4<ڢ & .6>ڢ ( 08@ڢ* 2:Bڢ$,4<ڢ&.6>ڢ$&(*PF$٨ ب $,4< ڢ&.6> ڢ(08@ ڢ*2:B ڢ$ p" ۨڨ    >D ٨ب ڢ ڢ  XE$٨ب $&(* ڢ$ &(*88%n /<588 88888%n!/<588  9 88%8/88 8888% 8/<588 88888%n/<588 888? ? "H /8)8$88/š8k Ǜ*) /88 8888% 8/88 8888%5     8! ?? ?? ?8k((ȡM ??8k$$ȡH       ??uD d*)7W/ǘWǙW  C8k<88\88Y 8<5  8- 8/8587 88Z 8<5  8 888! 88Z 8<5  87 898?8A 88}ˡ8Y8888m88o8?8q8?8s88888ġ 8 88"8š18?8 88:DL8u8y+)98u8y+)98w8{+);8w8{+);*|Y)*)7)a/1a2a8q?8s?88$Z)8 8!88!8#8$ 8K8*8~G8#8$D=8K8*8~G8),8O8O8W8W8_8_8g8g8$88KF8}á-88cD8 8 `B 8 á 8 ^8ơ `8^8^ á8!88 8^Z8888 88 88  88_8ӧ8Ǩ 88ߨ88#. L`/ á8!858!8!88#8#88%8%b88߄_S88ߍH8Ӽ8Ӽ8Ǽ888 88 8888 _8888 88 888ᄡ_S88፡H8׼8׼8˼88"b88_S88H8ռ8ռ8ɼ88Ž?88䄡_S88䍡H8ݼ8ݼ8Ѽ888ㄡ_S88㍡H8ۼ8ۼ8ϼ888℡_S88⍡H8ټ8ټ8ͼ8ߧ8Ѽ88ϼ88ͼ88˼8-8_8_8_8_8"8_8ŝ8߄_8ӧ8Ǩ 88ߨ888^ á,8!8 98 98 97L^8ӧ8Ǩ 88ߨ88 á,8!8 98 98 97L^_8ѧ888ϧ888ͧ888˧888"8ɧ88ɼ88š&8ǧ888Ǽ*'٨   `B ?. 8%8) 8'8+6  8%8)  8'8+  * N   *;$  * ( á#8 8 8 @\='ǚ*)7']ám ?8K Láۧ8 ڧ8 ٧8-ۧ8 +)9ڧ8 +);٧8Zá)á] +)9+);,á'á] +)9+);8~8~8mG8~8~8G8~8~8-G8~8~8 G8~8~8-G8~8~8G8~8~8G8}á88 = 8¼<58Q8 8Y8 8~8M8G8~8~8G8~8~8-G8~8~8 G8~8~8-G8~8~8MG8~8~8G8?8888~8M8G8~8~8G8~8~8-G8~8~8 G8~8~8-G8~8~8G8~8~8mG8}á8 ^ B8¼<5  8m8o 8u 8w8 888~8M8G8ó8?8q8?8s8?888888?8888" 88"!8 88"8š38888 88 8?  8?8 8888}áK8~8M8G8~8~8G8~8~8-G8~8~8 G8~8~8-G8~8~8G8}á888!'8@88q8s98}88m88o88/8m8o88$((**)7*b#b%b)??(\*/8u8w8)8u+)98+8w+);8$8YR+,*)7,c/1c2c8y?8{?8%8y+)98'8{+);8$8Y,-*)7-d/#d%d,??( CharJust: rVector2; { String justification } ( Rotation: real; { Z-axis rotation } ( CharBreakOut: boolean; { True if a keypress will terminate Jtextual output } ( SoftOpen: fontId; { Software font infoSize: rVector2; { Character size } *CharPath: direction; { Lettering direction } *CharSpace: real; { Extra spacing between characters } :'') { Character cell size } *BaseLine: real; { Normalized BaseLine Value } *LineSpace: integer; { Line spacing } (end; 0  textState = Record ( CharPrecision: precision; { Character drawing precision } *Charight, T_Down, T_Up ); (precision= ( Device_Font, Preview_Font, Stroke_Font ); ( (fontId= packed record *FileId: integer; { File identifier } *FontHandle: handle; { Pointer to font buffer } *CellSize: point; ({$C TextGraf Copyright (C) 1983, 1984 Third Wave Graphics }   Uses RealModes, Transcend, ({$u *lib/RasterCore.Lib } (MemoryManager, (RasterCore, ({$u *lib/ModelGraf.Lib } (GrafOut, (ModelGraf; (  type direction= ( T_Left, T_Rh b  (J ###h$$%X%p4%%+%'()t5z6077@888899 8t889j998::7j,?2A3C4E5JY;LZ8A<BzRR *n & )X+r+f,Z- .456X7 T99:!&""*\d:f FlrA888Ƨ8mC^AبZ/@@)@@,?2A3C4E5JY;LZبL/ $+&8!LM*@/ا8!L?/+)8u?8w?8y8ui/8}ái888$67/88!88$ 5ǟ*)>5/8ء 8587&6/88$8 8ǣ*):8/888$ 1Ǡ*) J1;ǡ*)7;g/88g8؝8Ą 888$B;<Ǣ*)7<h/؝8Ą8h8ŝ8š 888$B</8ƭ:7Ǥ*)77f?988888$ 0/888$ 2/888$ 3/888$ 4/J8e88+`-/8}á8!8$8888 88./88888$ 4/E  8e0Ǡ*)70f/ J 8ermation } (end; & {-------Public Variables--------}  var Cur_TState: textState; (  {-------Text Primitives---------}  procedure TextChar ( Ch: Char );  procedure TextString ( Txt_String: string );  procedure LineFeed ( Rows: real );   {-------Text Attributes---------}  procedure CharPrecision ( Precis: precision );  procedure CharSize ( Width, Height: real );  procedure CharPath ( Path: direction );  procedure CharSpace ( Space: real );  procedure CharJ 7)7) <5)D )?#< ׉  7- )  7*)(%ܪP/)Ý)Äǹ%ȡǴ%ȡǵ%), .))7,,+#$"تP/)+) !" >/)ˡ)  ) O)1 )?#< ׉ 7_~#) 97$137("0$)á ǹ*)("18!) 597#1357) 7!1357 8!,+ ,ȡ})$,#)'),*ȡ_,*)'),), /))7,,+*) 97$137T !á(# ȡXǀǀÄ6 ڧ)٧)ݡ 7,ȡ-,,,-/+))á ))/)7-) /) 7 4  P18!) 597#1357) 7!1357 ,+*, PؿR2+)-/*!8!8#7-) /) * *H)C)-/))á-7)ˡ)))))س#< ׉,+8!8#)8% 7'  :o* )))$ڪP-/./2.2ȡ-.-..-)/))=^ Z/)Ý)Ä ǹ*)ƽ) ))))))))~ب/    ˡ ,D/ا)/8!8#8% 7'8!)8#8% 7'  :o ڳڳp(@ڳ@@ڳ ڳڳ@/))< ׽)<½))) )  :var Width, Height: real);   {-------State Records-----------}   procedure Initial_TState; procedure Save_TState ( var State: textState );  procedure Load_TState ( State: textState ); " {-------Version Control---------}  function TxtGraf_Version: real;  implementation P E t_StrokeFont ( var FontInfo: fontId );  procedure Close_StrokeFont ( var FontInfo: fontId );   {-------Inquiries---------------}  procedure TextExtent ( Txt_String: string; Start, Count: integer; :var Width, Height: real);   {-------State Records-----------}   procedure Initial_TState; procedure Save_TState ( var State: textState );  procedure Load_TState ( State: textState ); " {-------Version Control---------}  function TxtGrafBvar FontInfo: fontId );  procedure Select_StrokeFont ( var FontInfo: fontId );  procedure Close_StrokeFont ( var FontInfo: fontId );   {-------Inquiries---------------}  procedure TextExtent ( Txt_String: string; Start, Count: integer;ust ( Horiz, Vert: real ); procedure CharRot ( Angle: real ); procedure CharBreakOut ( Switch: boolean );   {-------Stroke Fonts------------}  procedure Open_StrokeFont ( FileName: string; BlockSize: integer; /ٳس)1)ˡ ٧))/ا)9)ˡ)00٧)ا))0#< ׉/V /) *)( & *)'ڪP8ɡǶ&4/.C.0آ//_(.DI::ˡ:/ 77.آ/-:-:ȡ6--8 &/2/ 244á58  Ǻ*)22/ 524áǷ'4'87!/ n  *)(// HH`srokjihgfb^]\[ZYXTOK @)hhhhhhhhHL2z{|HHH`#/,(%"P) n`*2lPz"x&< fR\" j   #d]Wb)hhhhhhhh!8Ɂ)Li ee8ȱ8ȥ Ɂ) L[ ȑ8 i  `Ά`_KE0,('  |ia^]\[ZYXW1' V)& L Lȱ     Ɂ) L  BLLȑHH`mmȱi`ȱ L&`ȱ#z{|L L     BL *mmɁ)Lȑ8L  ^)hhhhhh}wm}}xm~~}~Ɂ)Lgd yHH`~`taZ*zvupokjedc`] )hhhhhh                 LȭHH`}zg_^\[ZYXWRQ<3.ponm   L^ mm   Ɂ) L mmL "ȱ&diL  `|_X(   ojc,952/  )hhhhhhhhȑ E    Ɂ) L Lȩ LLdi      L       L LȭdHH`` hhhhhhhhhh}} ~   Ɂ) L[ m}}m~~}~   Ɂ) L   m}}m~~}~Ɂ)  /) * /) /?7H*& צ6TextGraf version not compatible with ModelGraf versionצ%Please hit carriage return to exit...) 2))))ˡ )) )))h/))Ý)˄ )ع= >? 0? ?? 6G./)/) )/táA ݚ)) )))ب%áǷ(áǸ((Ǹ( // // )د )آ Ǹ*)B*)()/1)( \P\ ()ARKGREJSGREY1 :&;SMEDIUMB:SLIGHTBLSBROWN SORANGE ;FG SGREY2 D_ SPINK o SGREEN  SYELLOW ~b; SAQUA $`SWHITE b<SC ({$C Graf_In Copyright (C) 1983, 1984 Third Wave Graphics } (  uses {$u *lib/RasterCore.lib } (MemoryManager, (RasterCore, ({$u *lib/ModelGraf.lib } (GrafOut;  {-------Logical Input Devices-----------}  procedure Locator ( DevNumbe1 2 TAB B E A E9FFO2O^ ) ) ))))))))~ب/    ˡ ,D/ا)/8!8#8% 7'8!)8#8% 7' = 6ȑ`;`P%4rHn:f"xH$@@ڳ ڳڳ@/))< ׽)<½)))`+('$! d%hhhhhhhHhIhhhEhHH ?ȑK숭J`D`<:2,"b%hhhhhhhhhhHH<= 6ȑ`;`P%hhhhhhhhhhHH`%$#áJ/á3%ˡ*)%/ *)^/ / /  / / / *)$(// %/ צ.tablet%ˡpp,, צ.tablet%ˡ%ˡ/ō  ڳڳp(@ڳ@@ڳ ڳڳ@*)$( Dd%Number: integer; Low, High: real );  procedure Close_Valuator( DevNumber: integer );   procedure Open_Char ( DevNumber: integer );  procedure Close_Char ( DevNumber: integer ); :'') implementation P E er: integer; XLow, XHigh, YLow, YHigh: real ); procedure Close_Locator ( DevNumber: integer );   procedure Open_Choice ( DevNumber: integer ); procedure Close_Choice ( DevNumber: integer );   procedure Open_Valuator ( DevNumber: integer; Low, High: real );  procedure Close_Valuator( DevNumber: integer );   procedure Open_Char ( DevNumber: integer );  procedure Close_Char ( DevNumber: integer ); :'')re Open_Locator ( DevNumber: integer; XLow, XHigh, YLow, YHigh: real ); procedure Close_Locator ( DevNumber: integer );   procedure Open_Choice ( DevNumber: integer ); procedure Close_Choice ( DevNumber: integer );   procedure Open_Valuator ( Devr: integer; var XLoc, YLoc: real; :var Status: Char ); function Choice ( DevNumber: integer ): integer;  function Valuator ( DevNumber: integer ): real;  procedure Char_String ( DevNumber: integer; var InString: string );    procedugijklmnopqrstuvwxyz{|}~(end; (   {-------Global Variables----------------}  var $OutDevice : interactive; $Cur_DState, Head_DState : dStatePntr; $ErrorReporting : boolean; $NumDevices : integeracter Lfont in device coordinates } ,CRot : real; { Character rotation angle } ,BaseLine : real; { Baseline value of current hardware Lcharacter font. } ,DCP : rVector2; { Device current pen position } ( ,FillType : integer; { Index of current fill type } ,MarkerType : integer; { Index of current marker type } ,FontIndex : integer; { Index to device character fonts } ,CSize : rVector2; { Current size of device char; { Index of current pen color } ,PenSize : integer; { Index of current pen size } ,LineType : integer; { Index of current line type } ,FillCol : integer; { Index of current fill color } er; { Number of different marker types } ,Fonts : integer; { Number of different device fonts } , ,VPortBounds : rRect; { ViewPort } ,GrafPage : integer; { Grafix Page of device ( if any ) } ,PenCol : intege { Number of different colors } ,LineTyps : integer; { Number of different line types } ,PenSizes : integer; { Number of different pen sizes } ,FillTyps : integer; { Number of different fill types } ,MarkTypes : integ,AspectRatio : real; { Aspect ratio of device : i.e. Lthe ratio : Metric.y / Metric.x } ,DevFactor : rVector2; { NDC to Device Conversion Factors } ,Pages : integer; { Number of grafix pages } ,Colors : integer; eight of Display Lsurface in device coordinates } ,Origin : rVector2; { Logical origin of device } ,Metric : rVector2; { Width and height of the display Lsurface in centimeters } inition } * ,Link : dStatePntr; { Pointer to next active device Ldescriptor record ( if any ) } ,DeviceNum : integer; { Device Number } ,DeviceName : string; { Device Name } ,Width,Height :real; { Width and H( x : real; y : real ); :false: =( xy : array [0..1] of real ); 8end; ( (rRect= record :BotLeft : rVector2; :TopRight : rVector2; 8end; ( (dStatePntr = ^DeviceState; ( (deviceState = record @{ Device State Descriptor Record DefUnit GrafOut; Intrinsic Code 42 Data 43;  interface ({$C GrafOut Copyright (C) 1983, 1984 Third Wave Graphics }  uses {$u *lib/RasterCore.lib } (MemoryManager, (RasterCore;   type rVector2 = record case boolean of :true: : r;   {-------Device Control------------------}  procedure InstallDevice ( DeviceName : string );  procedure D_SetDevice ( DeviceName : string );  procedure D_Open;  procedure D_Reset; procedure D_Close;  procedure D_Escape ( var Buffer : byteStream; Transfer_Len : integer );  {-------Drawing Primitives--------------}  procedure D_MoveTo ( X, Y : real ); procedure D_LineTo ( X, Y : real ); procedure D_Marker ( X, Y : real ); proced67.0 then limit:= -32767 )else limit:= trunc ( arg );  end;  procedure Set_DCP ( xPen,yPen: real ); begin $with Cur_DState^.DCP do begin $ x:= xPen; (y:= yPen; $end; end;  $  {-------Device Control----------}   procedure Install_Device ', '_'] ) then begin ,j:= j+ 1; ,CharString[j]:=CharString[i]; (end; $end; { while } $CharString[0]:= chr ( j );  end; { of Remove_Blanks }   function limit ( arg: real) : integer; begin $if arg > 32767.0 then limit:= 32767 $else if arg < -327{ --- }   var i,j: integer;  len: integer;   begin { Remove_Blanks } $i:= 0; $j:= 0; $len:= length ( CharString ); $while i< len do begin (i:= i+ 1; (if not ( CharString[i] in ['rString[i] in ['a'..'z'] then ,CharString[i]:= chr ( ord (CharString[i]) - 32 ); $end;  end;   procedure Remove_Blanks ( var CharString: string );  { Delete all blanks and underscores from CharString } Dynamic: integer; (Ret_Segs: integer; (Segments: integer; ' (  {------ Utilities-----------------------}   procedure UpperCase ( var CharString: string ); var i: integer;  begin $for i:=1 to length (CharString) do begin (if Cha implementation  {$iocheck- }  {$rangecheck- }  const Graf_Out_Id= 4;  ({$i *toolkit/toolkit.err. } ({$i GrafOut.Id.Text } (  {$i GrafOut.const. } ( (  var Dynamic: integer; (Err: error_Rec; (Ret_procedure Load_DState ( State : deviceState ); {-------Error Handling------------------}  procedure UserError ( Unit_Num, Proc_Num, Err_Num, Severity : mByte);   {-------Version Control-----------------}  function GrafOut_Version : real;  evice Descriptor Records-------}  procedure Init_DState ( DeviceName : string ); procedure Get_DState ( DeviceName : string; var Pointer : dStatePntr );  procedure Save_DState ( var State : deviceState ); string; var Width,Height : real );   {-------Graphics Data Segments----------}  procedure Open_GrafSeg ( GrafId : integer ); procedure Close_GrafSeg ( GrafId : integer );  procedure Show_GrafSeg ( Device : string; GrafId : integer );   {-------D ( Index : integer );  procedure D_ChrSize ( Width, Height : real ); procedure D_ChrRot ( Angle : real );  {-------Inquiries-----------------------} procedure Get_DCP ( var XPen, YPen : real );  procedure D_TextExtent ( TextString : procedure D_FillType ( Index : integer );  procedure D_MarkerType ( Index : integer );  {-------Text Primitives and Attributes--}  procedure D_TextString ( TextString : string ); procedure D_LineFeed ( Rows : real );   procedure D_Font ocedure D_GrafixPage ( Index : integer );  procedure D_PenColor ( Index : integer );  procedure D_PenSize ( Index : integer ); procedure D_LineType ( Index : integer ); procedure D_FillColor ( Index : integer ); ve ( NumPnts : integer; Closed : boolean; :CurveType : integer; var CPoints : wordStream );   {-------Drawing Attributes--------------}  procedure D_GrafixOn; procedure D_TextOn; procedure D_ViewPort ( Left, Right, Bottom, Top : real );  prure D_RMoveTo ( dX, dY : real ); procedure D_RLineTo ( dX, dY : real ); procedure D_RMarker ( dX, dY : real );  procedure D_FillRect ( rct : rRect ); procedure D_Polygon ( NumPnts : integer; var CPoints : wordStream );  procedure D_Cur { DeviceName: string };   var P, Pointer: dStatePntr;   begin $ClearError; $if DeviceName='' then $ UserError ( Graf_Out_id, Id_Install_Device, ErrNullDevice, Fatal ); & $if MemAvail < ( Sizeof ( DeviceState ) ) div 2 then (UserError ( Graf_Out_id, Id_Install_Device, ErrDHeap, Fatal ); $ $if not ErrorFlag then begin $ (New(P); { Create a new DeviceState on the heap } ( (NumDevices:=NumDevices+1; ( (if Head_DState=Nil then Head_DState:=P (else begin ,{ Find the las x,y ); ,end; (end (else begin ,if DeviceNum=Plotter then begin 0case MarkerType of 41: write(OutDevice,'sm.;'); 42: write(OutDevice,'sm+;'); 43: write(OutDevice,'smO;'); 44: write(OutDevice,'sm*;'); 45: write(OutDevice,'sm@;'); 0viceNum=Screen then begin ,if MarkerType=1 then Dot_At ( x, y ) ,else begin 0MoveTo ( x,y ); 0RMoveTo ( -CSize.x * 0.5, -CSize.y * 0.5 ); 0case MarkerType of 42: RChar ('+'); 43: RChar ('O'); 44: RChar ('*'); 45: RChar ('@'); 0end; 0MoveTo (,if DeviceNum=Plotter then -write(OutDevice,'pd;pa',limit(x+Origin.x),',', Elimit(y+Origin.y),';'); $end; { of with Cur_DState^ }  end;  procedure D_Marker { x,y: real };  begin $ClearError; $Set_DCP ( x,y ); $with Cur_DState^ do begin (if Den.x+x), T',',limit(Origin.y+y),';'); $end; { of with Cur_DState^ }  end;  procedure D_LineTo { x,y: real }; begin $ClearError; $Set_DCP ( x,y ); $with Cur_DState^ do begin (if DeviceNum=Screen then begin ,Line_To ( x, y ) (end (else -Drawing Primitives--------------}   procedure D_MoveTo { x,y: real }; begin $ClearError; $Set_DCP ( x,y ); $with Cur_DState^ do begin (if DeviceNum=Screen then MoveTo ( x, y ) (else ,if DeviceNum=Plotter then write(OutDevice,'pu;pa',limit(Origiream; Transfer_Len: integer }; var ch: char; (i: integer; begin $ClearError; $if Cur_DState^.DeviceNum=Plotter then (for i:= 0 to Transfer_Len-1 do begin ,moveleft ( Buffer[i], ch, 1 ); ,write ( OutDevice, ch ); (end;  end;  {------%{ Raise the pen } % %write ( outDevice, 'pu;');  end; "  end; { of D_Reset }   procedure D_Close; begin $ClearError; $if Cur_DState^.DeviceNum=Plotter then close ( OutDevice );  end; { of D_Close }  procedure D_Escape { var Buffer: ByteStce }  begin " $ClearError; $if Cur_DState^.DeviceNum=Screen then begin (Fill_VPort; (if ErrorFlag then UserError( Graf_Out_id, Id_D_Reset, ErrAccess, Fatal); $end; " "if Cur_DState^.DeviceNum=Plotter then begin * , Id_D_Open, ErrAccess, Fatal ); ,end; { of plotter devices } (end; { non-screen devices } ( (if not ErrorFlag then Load_DState ( Cur_DState^ ); . #end; { of with Cur_DState^ } $ end; { of D_Open }  procedure D_Reset; { Reset current deviviceNum=Screen then begin (end { of DeviceNum=Screen } ( (else begin { non-screen devices } ,if DeviceNum=Plotter then begin { plotter devices } 0close ( OutDevice ); 0rewrite ( OutDevice, '.RS232'); 0if IoResult <> 0 then 4UserError ( Graf_Out_Id$Get_DState ( DeviceName, Pointer ); $if not ErrorFlag then Cur_DState:=Pointer $else UserError ( Graf_Out_id, Id_D_SetDevice, ErrNoDevice, Fatal );  end;  procedure D_Open;  begin { D_Open } " $ClearError; $with Cur_DState^ do begin ( (if De ,P^.DeviceNum:= Screen - (else P^.DeviceNum:= Plotter; ( (Init_DState ( DeviceName ); $ $end; { of if } $  end; { of InstallDevice }  procedure D_SetDevice { DeviceName: string };  var Pointer: dStatePntr;  begin $ClearError; (P^.DeviceName:=DeviceName; ( ,{ DeviceNum = Screen => Screen mode 0DeviceNum = Plotter => Plotter output } 0 (if ( ( DeviceName='BW280') or ( DeviceName='CP280') or -( DeviceName='BW560') or ( DeviceName='COL140') ) then ,t DeviceState created } + ,Pointer:=Head_DState; ,while Pointer^.Link <> Nil do 0Pointer:=Pointer^.Link; ,{ Point to the new DeviceState } ,Pointer^.Link:= P; (end; ( (UpperCase ( DeviceName ); (Remove_Blanks ( DeviceName ); ( (P^.Link:=Nil; end; 0write(OutDevice,'pu;pa',limit(Origin.x+x), D',',limit(Origin.y+y),';pu;sm;'); ,end; (end; $end; { of with Cur_DState^ } $  end;  procedure D_RMoveTo { dx,dy: real }; begin $ClearError; $with Cur_DState^ do begin (with DCP do Set_DCP ( x+dx,y+dy ); (if DeviceNum=Screen then R_MoveTo ( dx, dy ) (else if DeviceNum=Plotter then ,write(OutDevice,'pu;pr ',limit(dx),',',limit(dy),';'); $end; { of with Cur_DState^ }  end; procedure D_RLineTo { dx,dy: real }; begir ( Graf_Out_id, Id_D_PenColor, ErrArgument, Fatal ); $end; { of with Cur_DState^ } end;   procedure D_PenSize { Index: integer }; begin $ClearError; $with Cur_DState^ do begin (if Index in [1..PenSizes] then begin ,PenSize:= Index; $ end (elearError; $with Cur_DState^ do begin (if Index in [0..Colors-1] then begin ,PenCol:= Index; ,if DeviceNum=Screen then begin 0PenColor ( Index ); ,end; ,if DeviceNum=Plotter then write (OutDevice,'sp',Index div 8 + 1,';'); $ end (else UserErro0DevFactor.Y:= Height / AspectRatio; 0VPortBounds.TopRight.y:= Height; ,end; $ end $ else UserError ( Graf_Out_id, Id_D_GrafPage, ErrArgument, Fatal ); $end; { of with Cur_DState^ }  end;  procedure D_PenColor { Index: integer };  begin $Ceger };  begin $ClearError; $with Cur_DState^ do begin (if Index in [1..Pages] then begin ,GrafPage:= Index; ,if DeviceNum=Screen then begin 0GrafixPage ( Index ); 0if Index=3 then Cur_DState^.Height:=383 0else Cur_DState^.Height:=191; ect ) (end (else if DeviceNum=Plotter then ,write(OutDevice,'iw ', 0trunc(Left+Origin.x),',',trunc(Bottom+Origin.y),',', 0trunc(Right+Origin.x),',',trunc(Top+Origin.y),';'); $end; { of with Cur_DState^ }  end;  procedure D_GrafixPage { Index: inttLeft.y:= Bottom; ,TopRight.x:= Right; TopRight.y:= Top; (end; (if DeviceNum=Screen then begin ,SetBounds_Rect ( temp_rect, round ( Left + 0.0001 ), Hround ( Right + 0.0001 ), Hround ( Bottom + 0.0001 ), Hround ( Top + 0.0001 ) ); ,VPort ( temp_r(UserError ( Graf_Out_id, Id_D_ViewPort, ErrBigLeft, Fatal ); $if Bottom >= Top then (UserError ( Graf_Out_id, Id_D_ViewPort, ErrBigBottom, Fatal ); $ $if not ErrorFlag then with Cur_DState^ do begin (with VPort_Bounds do begin ,BotLeft.x:= Left; Boear error code in this procedure } $TextOn;  end;  procedure D_ViewPort { Left, Right, Bottom, Top: real };  var temp_rect: rect;   begin " $ClearError; $if Left >= Right then ing Attributes--------------}  procedure D_GrafixOn; begin ${ don't clear error code in this procedure } $if Cur_DState^.DeviceNum=Screen then Grafix_On $else ScreenOff; { turn the screen off for speed }  end; procedure D_TextOn; begin ${ don't clts, CPoints ); $end $else UserError ( Graf_Out_id, Id_D_Polygon, ErrNegCPoints, Fatal );  end;  procedure D_Curve { NumPnts: integer; Closed: boolean; :CurveType : integer; var CPoints: wordStream };  begin $ClearError; end;  {-------DrawKround ( TopRight.y + 0.0001 )); +FillRect ( temp_rect ); (end;  end;  procedure D_Polygon { NumPnts: integer; var CPoints: WordStream };  begin $ClearError; $if NumPnts >=0 then with Cur_DState^ do begin (if DeviceNum=Screen then ,PGon ( NumPn : rRect }; var temp_rect: rect;  begin $ClearError; (if Cur_DState^.DeviceNum=Screen then begin +with rct do /SetBounds_Rect ( temp_rect, round ( BotLeft.x + 0.0001 ), Kround ( TopRight.x + 0.0001 ), Kround ( BotLeft.y + 0.0001 ), ate^ } end;  procedure D_RMarker { dx,dy: real }; begin $ClearError; $with Cur_DState^ do begin (with DCP do Set_DCP ( x+dx,y+dy ); (if DeviceNum=Screen then R_DotAt ( dx, dy ); $end; { of with Cur_DState^ } end;   procedure D_FillRect { rctn $ClearError; $with Cur_DState^ do begin (with DCP do Set_DCP ( x+dx,y+dy ); (if DeviceNum=Screen then begin ,R_LineTo ( dx, dy ) (end (else if DeviceNum=Plotter then ,write(OutDevice,'pd;pr ',limit(dx),',',limit(dy),';'); $end; { of with Cur_DStlse UserError ( Graf_Out_id, Id_D_PenSize, ErrArgument, Fatal ); $end; { of with Cur_DState^ } end;  procedure D_LineType { Index: integer };  begin $ClearError; $with Cur_DState^ do begin (if Index in [0..LineTyps-1] then begin ,LineType:=Index; ,if DeviceNum=Plotter then begin 0if Index=0 then write ( OutDevice,'lt;') 0else write (OutDevice,'lt ',Index,';'); ,end; (end (else UserError ( Graf_Out_Id, Id_D_LinType, ErrArgument, Fatal ); $end; { of with Cur_DState^ }  end;  procedure D_Fiteger };  begin end;  procedure Init_DState { DeviceName: string };   var Pointer: dStatePntr; $  begin " $ClearError; $Get_DState ( DeviceName, Pointer ); $if not ErrorFlag then with Pointer^ do begin & (if DeviceNum= Screen theur_DState^.CSize.y; $end; end;  {-------Graphics Data Segments----------}   procedure Open_GrafSeg { GrafId: integer }; begin end;  procedure Close_GrafSeg { GrafId: integer };  begin end;  procedure Show_GrafSeg { Device: string; GrafId: in begin $ClearError; $if Cur_DState^.DeviceNum= Screen then (with Cur_RState do begin ,Width:= C_CharSize.h * Length ( TextString ); ,Height:= C_CharSize.v; (end $else begin $ Width:= Cur_DState^.CSize.x * Length ( TextString ); $ Height:= C( OutDevice, 'si ',Temp.x:8:3,',',Temp.y:8:3,';'); ,end; (end;  end;  end; procedure D_ChrRot { Angle: real };  begin $ClearError; $Cur_DState^.CRot:= Angle;  end;  procedure D_TextExtent { TextString: string; var Width,Height: real }; r_DState^.CSize.x:=Width; (Cur_DState^.CSize.y:=Height; ( (if Cur_DState^.DeviceNum=Plotter then begin ,with Cur_DState^ do begin 0BaseLine:= 0; 0Temp.x:= 0.5 * CSize.x * 0.0025; 0Temp.y:= 0.5 * CSize.y * 0.0025; 0CSize.x:= 0.75 * CSize.x; 0write Temp: RVector2;   begin " $ClearError; $if Width <=0 then (UserError ( Graf_Out_id, Id_D_ChrSize, ErrNegWidth, Fatal ); $if Height <=0 then (UserError ( Graf_Out_id, Id_D_ChrSize, ErrNegHeight, Fatal ); " $if not ErrorFlag then begin $ (Cu,FontIndex:=Index; ,if DeviceNum=Plotter then write ( OutDevice, 'CS ',FontIndex,';'); $ end (else UserError ( Graf_Out_id, Id_D_Font, ErrArgument, Fatal ) $end; { of with Cur_DState^ }  end;  procedure D_ChrSize { Width, Height : real }; var ws: real };  begin $with Cur_DState^ do begin (ClearError; (if DeviceNum=Screen then R_LF ( Rows ); $end;  end;  procedure D_Font { Index: integer };  begin $ClearError; $with Cur_DState^ do begin (if Index in [0..Fonts-1] then begin Num=Screen then R_String ( TextString ) (else if DeviceNum=Plotter then begin ,Get_DCP ( xtemp, ytemp ); ,write ( OutDevice, 'lb',TextString,Chr(3)); ,D_MoveTo ( xtemp, ytemp ); (end; $end; { of with Cur_DState^ } $  end; procedure D_LineFeed { Ro(yPen:= DCP.y; $end; { of with Cur_DState^ }  end;   {-------Text Primitives and Attributes--}   procedure D_TextString { TextString: string };  var xtemp, (ytemp : real; (  begin " $ClearError; $with Cur_DState^ do begin (if Device(else UserError ( Graf_Out_id, Id_D_MarkType, ErrArgument, Fatal ); $end; { of with Cur_DState^ } end;  procedure Get_DCP { var XPen,YPen: real }; var delim: char; (pen: point;  begin $ClearError; $with Cur_DState^ do begin (XPen:= DCP.x; , Id_D_FillType, ErrArgument, Fatal ); $end; { of with Cur_DState^ }  end;  procedure D_MarkerType { Index: integer };  begin $ClearError; $with Cur_DState^ do begin (if Index in [1..MarkTypes] then begin ,MarkerType:= Index; $ end ErrArgument, Fatal ); $end; { of with Cur_DState^ }  end;  procedure D_FillType { Index: integer };  begin $ClearError; $with Cur_DState^ do begin (if Index in [0..FillTyps-1] then begin ,FillType:= Index; $ end (else UserError ( Graf_Out_IdllColor { Index: integer };  begin $ClearError; $with Cur_DState^ do begin (if Index in [0..Colors-1] then begin ,FillCol:= Index; ,if DeviceNum=Screen then begin 0FillColor ( Index ); ,end; $ end (else UserError ( Graf_Out_Id, Id_D_FillColor,n begin * ,if ((DeviceName='BW280') or (DeviceName='CP280')) then Width:=279; ,if DeviceName='BW560' then Width:= 559; ,if DeviceName='COL140' then Width:= 139; ,Height:=191; , ,Origin.x:=0.0; Origin.Y:=0.0; ,Metric.X:=21.5; Metric.Y:=15; , ,Pages:=3; ,Colors:=16; ,LineTyps:=1; ,PenSizes:=1; ,FillTyps:=1; ,MarkTypes:=5; ,Fonts:=1; , ,GrafPage:=1; ,PenCol:=S_White; ,FillCol:=S_Black; ,PenSize:=1; ,LineType:=0; ,FillType:=0; ,MarkerTypBaseLine= ',baseLine ); $ writeln (' DCP= ',dCP.x,' ',dCP.y ); $end;  readln;  end;  }   procedure Load_DState { State: deviceState }; var GrMode: gMode; velocity: integer; $  begin " $ClearError; $ $with Statln (' FillCol= ',fillCol ); $ writeln (' FillType= ',fillType ); $ writeln (' MarkerType= ',markerType ); $ writeln (' FontIndex= ',fontIndex ); $ writeln (' CSize= ',cSize.x,' ',cSize.y ); $ writeln (' CRot= ',cRot ); $ writeln (' ,writeln (' vPortBounds= ',botleft.x,' ',botleft.y,' ', CtopRight.x,' ',topRight.y); $ writeln (' GrafPage= ',grafPage ); $ writeln (' PenCol= ',penCol ); $ writeln (' PenSize= ',penSize ); $ writeln (' LineType= ',lineType ); $ write(' LineTyps= ',lineTyps ); $ writeln (' PenSizes= ',penSizes ); $ writeln (' FillTyps= ',fillTyps ); $ writeln (' MarkTypes= ',markTypes ); $ writeln (' Fonts= ',fonts ); $ readln; (with vPortBounds do n.y ); $ writeln (' Metric= ', metric.x,' ',metric.y ); $ writeln (' AspectRatio= ',aspectRatio ); $ writeln (' DevFactor= ',devFactor.x,' ',devFactor.y ); $ writeln (' Pages = ',pages ); $ writeln (' Colors = ',colors ); $ writeln procedure Show ( State: deviceState ); begin $with State do begin $ writeln (' DeviceNum= ',deviceNum ); $ writeln (' DeviceName= ', deviceName ); $ writeln (' Width,Height= ',width,' ',height ); $ writeln (' Origin= ', origin.x,' ',origi,UserError( Graf_Out_id, Id_Get_DState, ErrNoDevice, Fatal ); $end; { while }  end; { of Get_DState } procedure Save_DState { var State: deviceState }; begin $ClearError; $with Cur_DState^ do Get_DCP ( DCP.x, DCP.y ); $State:= Cur_DState^; end; { me then begin ,Pointer:=Cur_DState; ( exit(Get_DState); (end; $end; $Pointer:=HeadDState; $while ((not ErrorFlag) and (Pointer^.DeviceName<> DeviceName)) do begin (Pointer:= Pointer^.Link; (if Pointer=Nil then , Fatal ); end; { of Init_DState } procedure Get_DState { DeviceName: string; var Pointer: dStatePntr }; begin $ClearError; $UpperCase ( DeviceName ); $Remove_Blanks ( DeviceName ); $if Cur_DState <> Nil then begin (if Cur_DState^.DeviceName=DeviceNath * AspectRatio; ,DevFactor.Y:= Height; (end; $ (if Pointer=Cur_DState then Load_DState ( Pointer^ ); ( ({********* END OF FIXED CODE ********} & $end { of with Pointer^ } $else UserError ( Graf_Out_id, Id_Init_DState, ErrNoDevice,BotLeft.x:= 0.0; BotLeft.y:=0.0; ,TopRight.x:= Width; TopRight.y:= Height; (end; (AspectRatio:= Metric.y / Metric.x; ( (if AspectRatio < 1 then begin ,DevFactor.X:= Width; ,DevFactor.Y:= Height / AspectRatio; (end (else begin ,DevFactor.X:= Wid:=0.0; 0 0CSize.x:= Width / 80; 0CSize.y:= CSize.x * 1.5; 0BaseLine:=0; 0 ,end; { of plotter device } (end; { of non-screen devices } & ({********* DO NOT CHANGE THE CODE BELOW ********} ( (with VPortBounds do begin etric.y:= 18.0; 0Pages:=1; 0Colors:=16; 0LineTyps:= 6; 0PenSizes:=2; 0FillTyps:=0; 0MarkTypes:=5; 0Fonts:=1; 0 0GrafPage:=1; 0PenCol:=S_Black; 0FillCol:=S_Black; 0PenSize:=1; 0LineType:=0; 0FillType:=0; 0MarkerType:=1; 0FontIndex:=0; 0CRote:=1; ,FontIndex:=0; ,CRot:=0.0; , ,CSize.x:=7; CSize.y:=8; ,BaseLine:=1; (end & (else begin { non-screen devices } ,if DeviceNum = Plotter then begin 0 0Width:=10000; Height:= 7200; 0Origin.x:=250.0; Origin.y:=279.0; 0Metric.x:= 25.0; Me do begin ( ({ Do any special device actions first } ( (if DeviceNum= Screen then begin ,if DeviceName='BW280' then GrMode:=Bw280 ,else if DeviceName='CP280' then GrMode:=Cp280 1else if DeviceName='BW560' then GrMode:=Bw560 6else if DeviceName='COL140' then GrMode:=Col140; ,Grafix_Mode ( GrMode ); ,if ErrorFlag then 0UserError ( Graf_Out_Id, Id_Load_DState, ErrNoDevice, Fatal ); end { of deviceNum= Screen } (else begin { non-Screen devices } ,if DeviceNum= Plott1 2 TAB B E A O^if ErrorFlag and (Fatal_Error or (Ret_Dynamic < 128)) then (GetOut ( ErrNoMemory ); & $Open_RCore ( Bw560, 2 ); $if ErrorFlag and (Fatal_Error ) then GetOut ( ErrNoGraphics );   end. e ( 'BW280' ); $Install_Device ( 'CP280' ); $Install_Device ( 'BW560' ); $Install_Device ( 'COL140' ); $Install_Device ( 'HP' ); $ $Dynamic:=200; $Segments:=50; $ $ClearError; $Open_Memory ( True, Dynamic, Segments, Ret_Dynamic, Ret_Segs ); $ $ procedure GetOut ( Error: integer ); begin $UserError ( Graf_Out_id, Id_GrafOut, Error, Fatal ); $exit ( Program );  end; begin { GrafOut init } $Cur_DState:= Nil; $ErrorReporting:=True; $Head_DState:= Nil; $NumDevices:=0; % $ $Install_Devic,write (' Press to Exit; to continue...'); ,read(ch); ,if ord(ch)= Escape then exit ( Program ); (end; $end; { of ErrorReporting }  end;  function GrafOut_Version{: real }; begin $ClearError; $GrafOut_Version:=1.0;  end; Ret_Dynamic,' ',Ret_Segs); ,readln; ,exit ( program ); (end (else if FatalError then begin ,TextOn; ,gotoxy ( 0,21 ); ,write(chr(30)); ,with Err do writeln ( 'User Error! Unit= ',Unit_Number, B' Proc= ',Proc_Number, B' ErrorNum= ', Err_Number); _Error ( Err ); " $if ErrorReporting then begin (if (Err.Proc_Number=Id_GrafOut) and (Err.Severity=Fatal) then begin ,TextOn; ,gotoxy ( 0,21 ); ,write(chr(30)); ,writeln('Open_Memory Failure'); ,write(chr(30)); ,writeln ('Ret_Dynamic, Ret_Segs= ', procedure UserError { Unit_Num, Proc_Num, Err_Num, Severity: mByte }; const Escape=27;  var ch: char;  begin $with Err do begin (Unit_Number:= Unit_Num; (Proc_Number:=Proc_Num; (Err_Number:= Err_Num; $end; $Err.Severity:= Severity; $SetillType ); ,D_FillColor ( FillCol ); ,D_MarkerType ( MarkerType ); ,D_Font ( FontIndex ); ,D_ChrSize ( CSize.x, CSize.y ); ,D_ChrRot ( CRot ); $ end; $ $end; { of with State }   end; ; ,end; (end; ( (if not ErrorFlag then begin ,with VPortBounds do 0D_ViewPort ( BotLeft.x, TopRight.x, BotLeft.y, TopRight.y ); ,D_GrafixPage ( GrafPage ); ,D_PenColor ( PenCol ); ,D_PenSize ( PenSize ); ,D_LineType ( LineType ); ,D_FillType ( Fer then begin 0write ( OutDevice, 'in;'); { initialize } 0{ Set up scaling points P1 and P2; pen velocity in cm/sec } 1 0write ( outDevice, 'ip ',trunc(Origin.x),',', Itrunc(Origin.y),',', Itrunc(Origin.x + Width),',', Itrunc(Origin.y + Height),';')umber: integer; var InString: string );    procedure Open_Locator ( DevNumber: integer; XLow, XHigh, YLow, YHigh: real ); procedure Close_Locator ( DevNumber: integer );   procedure Open_Choice ( DevNumber: integer ); procedure Close_Choice ( Dvices-----------}  procedure Locator ( DevNumber: integer; var XLoc, YLoc: real; :var Status: Char ); function Choice ( DevNumber: integer ): integer;  function Valuator ( DevNumber: integer ): real;  procedure Char_String ( DevNUnit Graf_In; Intrinsic Code 36 Data 37; interface ({$C Graf_In Copyright (C) 1983, 1984 Third Wave Graphics } (  uses {$u *lib/RasterCore.lib } (MemoryManager, (RasterCore, ({$u *lib/ModelGraf.lib } (GrafOut;  {-------Logical Input De1 B E 3 O^ 35;  IdShow_GrafSeg= 36;  IdInit_DState= 37; IdGet_DState= 38;  IdSave_DState= 39; IdLoad_DState= 40;  IdUserError= 41; IdGrOutVersion= 42;  llColor= 24; IdD_FillType= 25;  IdD_MarkType= 26;  IdD_TextString= 27; IdD_LineFeed= 28;  IdD_Font= 29;  IdD_ChrSize= 30;  IdD_ChrRot= 31; IdGet_DCP= 32;  IdD_TextExtent= 33;  IdOpen_GrafSeg= 34; IdClose_GrafSeg= IdD_RMarker= 13;  IdD_FillRect= 14; IdD_Polygon= 15;  IdD_Curve= 16;  IdD_GrafixOn= 17; IdD_TextOn= 18; IdD_ViewPort= 19;  IdD_GrafPage= 20;  IdD_PenColor= 21;  IdD_PenSize= 22; IdD_LinType= 23; IdD_Fi IdGrafOut= 1;  IdInstallDevice= 2;  IdD_SetDevice= 3;  IdD_Open= 4;  IdD_Reset= 5; IdD_Close= 6;  IdD_Escape= 7;  IdD_MoveTo= 8; IdD_LineTo= 9; IdD_Marker= 10; IdD_RMoveTo= 11; IdD_RLineTo= 12;evNumber: integer );   procedure Open_Valuator ( DevNumber: integer; Low, High: real );  procedure Close_Valuator( DevNumber: integer );   procedure Open_Char ( DevNumber: integer );  procedure Close_Char ( DevNumber: integer );  implementation  const GrafInId=7;  Locators=1; (Choices=0; (Valuatrs=0; (Strings=0;  ({$i *toolkit/toolkit.err. } ({$i GrafIn.Id.Text }  var TabDevNum, (TabFileNum: integer; (SOS_OpenBuf, (TabHandle: lse UserError ( GrafInId, Id_Close_Locator, ErrArgument, Fatal );  end;  procedure Open_Choice { DevNumber: integer }; begin "ClearError; end; procedure Close_Choice { DevNumber: integer }; begin "ClearError; end;  procedure Open_Valuator { DevNumb var Ret_Code: integer;  begin "ClearError; "if DevNumber=1 then begin $SOS_Close ( TabFileName, Ret_Code ); $if Ret_Code<>0 then (UserError ( GrafInId, Id_Close_Locator, ErrClass ( RetCode ), Fatal ); $Release_Seg ( Tab_Handle );  end "e$if (DevNumber < 0) or (DevNumber > Locators) then GetOut( ErrArgument ); $if XLow > XHigh then Swap ( xLow, xHigh ); $if YLow > YHigh then Swap ( yLow, yHigh ); " if DevNumber = 1 then TabOpen; "end; procedure Close_Locator { DevNumber: integer }; m('.tablet',TabDevNum,RetCode); &if RetCode<>0 then GetOut ( ErrClass ( RetCode ) ); &SOS_DControl(TabDevNum,3,TabSet,RetCode); &if RetCode<>0 then GetOut ( ErrClass ( RetCode ) ); $end; " "begin $ClearError; tCode); &if RetCode<>0 then GetOut ( ErrClass ( RetCode ) ); &with TabSet do (begin *XScale := trunc (6000/(XHigh-XLow)); *YScale := trunc (6000/(YHigh-YLow)); *XOffset:= trunc (300-XLow); *YOffset:= trunc (300-YLow); *Bias := 0; (end; &SOS_DevNu,YOffset :integer; ,Bias :byte; ,junk :byte; *end; $ $begin &AllocSeg ( 1024.0, 100, RetLen, SOS_OpenBuf ); &if ErrorFlag then GetOut ( ErrNoMemory ); &HandleXAddr(SOS_OpenBuf,SOS_OpenAddr); &SOS_Open ( '.tablet',SOS_OpenAddr,TabFileNum,Re"(* There are TABLET-SPECIFIC values in this section *) # #type Byte = 0..255; # #var RetCode :integer; 'RetLen :real; 'SOS_OpenAddr :XAddr; 'TabSet : packed record ,XScale :integer; ,YScale :integer; ,XOffset :integer; "begin $UserError ( GrafInId, Id_Open_Locator, Error, Fatal ); $exit ( Open_Locator ); "end;  " "procedure Swap ( a,b: real ); "var temp: real; "begin " temp:=a; &a:=b; &b:=temp; "end; " "procedure TabOpen; en 7ErrClass:= ErrSystem 5else 7ErrClass:= ErrOtherIO; #end; { of ErrClass }   { Logical Input Devices } procedure Open_Locator { DevNumber: integer; 8XLow, XHigh, YLow, YHigh: real }; $ "procedure GetOut ( Error: integer ); 80, 88] then /ErrClass:= ErrAccess ,else /if SOS_Error in [65, 66, 72, 73, 85] then 2ErrClass:= ErrOutOfRoom /else 2if SOS_Error in [39, 43, 48..63, 74, 76, 83, 90] then 5ErrClass:= ErrOtherIO 2else 4if SOS_Error in [32,33,34,67,75,77,79,86,89] thfunction ErrClass (SOS_Error: integer): integer; #begin { ErrClass } &if SOS_Error= 64 then )ErrClass:= ErrPathname &else )if SOS_Error in [16, 17, 35, 37, 46, 68, 69, 70, 81, 82, 87] then ,ErrClass:= ErrNoFile )else ,if SOS_Error in [38, 71, 78, r RetCode:integer); #external; ( procedure SOS_DControl(DevNum, ControlCode:integer; var ControlList; 7var RetCode:integer); #external; & procedure SOS_DevNum(DeviceName: string; var DevNum, RetCode: integer); #external;  ( teCount: integer; 8var RetCode, BytesRead: integer );  external;  procedure SOS_LWrite ( RefNum: integer; var BufAdr; ByteCount: integer; 9var RetCode: integer ); #external; & procedure SOS_DStatus(DevNum, StatusCode:integer; var StatusList; 7vahandle;   procedure SOS_Open ( Pathname: string; var SOSBufAddr: XAddr; 8var RefNum, RetCode: integer ); #external; # procedure SOS_Close ( RefNum: integer; var RetCode: integer ); #external; # procedure SOS_LRead ( RefNum: integer; var BufAdr; Byer: integer ; Low, High: real }; begin "ClearError; end;  procedure Close_Valuator { DevNumber: integer }; begin "ClearError; end;  procedure Open_Char { DevNumber: integer }; begin "ClearError; end;  procedure Close_Char { DevNumber: integer }; begin "ClearError; end;  procedure Locator { DevNumber: integer; Var XLoc, YLoc: real; 4Var Status: Char }; var RetCode,BytesRead:integer; %TabInfo : packed record *XPos:integer; *YPos:integer; *Status:char; *junk:char; (end; ( "procedure GetO1 { O^Zose_Valuator= 11;  id_Opn_Char= 12; { Naming convention conflicts }  id_Clos_Char= 13; id_Locator= 2; id_Choice= 3;  id_Valuator= 4;  id_Char_String= 5; id_Open_Locator= 6; id_Close_Locator= 7; id_Open_Choice= 8; id_Close_Choice= 9;  id_Open_Valuator= 10;  id_ClO^ ): integer}; begin "ClearError; end;  function Valuator { DevNumber: integer ): real}; begin "ClearError; end;  procedure Char_String { DevNumber: integer; Var InString: string }; begin "ClearError; end;  Begin End.  f BytesRead <> 5 then GetOut ( ErrOtherIO ); &XLoc:=TabInfo.XPos; &YLoc:=TabInfo.YPos; &Status:=TabInfo.Status; "end; " "begin $ClearError; $if DevNumber = 1 then TabRead $else GetOut ( ErrArgument ); "end;  function Choice { DevNumber: integerut ( Error: integer ); "begin $UserError ( GrafInId, Id_Locator, Error, Fatal ); $Exit ( Locator ); "end; " "procedure TabRead; "begin &SOS_LRead ( TabFileNum,TabInfo,5,RetCode,BytesRead ); &if RetCode <> 0 then GetOut ( ErrClass ( RetCode )); &ibuffer ;-----* *.proc SOS_Close,2 *;procedure SOS_Close(RefNum: integer; var RetCode: integer); *  RefNum .equ 0ec  RetCode .equ 0ea * *pullret *pop16 RetCode *pop16 RefNum *pushret * *ldy #0 *lda RefNum *sta CloseRef ; RefNum OptionList .word OpList ; Option List ptr ListLength .byte 4 ; Option List length 0 OpList .byte 0 ; access is default +.byte 4 ; 4-page file buffer +.word ZPSOS_BufAddr; pointer to file *sta @RefNum,y ; clear high-order byte * *rts   ;-----*  Open brk ( .byte 0C8 *.word OpenPrm *rts * OpenPrm .byte 4 ; 4 parameters PathPtr .word ; Pathname ptr OpenRef .byte jsr Open *sta @RetCode,y ; set low-order byte of Return code *tya *iny *sta @RetCode,y ; clear high-order byte *ldy #0 *lda OpenRef ; set low-order byte of RefNum *sta @RefNum,y *tya *iny *ldy #0 *lda @SOS_BufAddr,y *sta ZPSOS_BufAddr *iny *lda @SOS_BufAddr,y *sta ZPSOS_BufAddr+1 *iny *lda @SOS_BufAddr,y *sta ZPSOS_BufAddr+1601 * *ldy #0 *lda #Pathname *sta PathPtr ; supply pathname ptr *sty PathPtr+1 *  , RetCode: integer); * Pathname .equ 0ec  SOS_BufAddr .equ 0ea  RefNum .equ 0e8  RetCode .equ 0e6 ZPSOS_BufAddr .equ 00  *pullret * *pop16 RetCode *pop16 RefNum *pop16 SOS_BufAddr *pop16 Pathname * *pushret *  ;-----*  GetDevNum brk *.byte 84 *.word GetDevPrm *rts * GetDevPrm .byte 2 DevNamPtr .word 0 DevNumber .byte  ;-----*  .proc SOS_Open,4 *;procedure SOS_Open(Pathname: string; var SOS_BufAddr: XAddr; *; var RefNumde *tya *iny *sta @RetCode,y ; clear high-order byte *ldy #0 *lda DevNumber ; set low-order byte of DevNum *sta @DevNum,y *tya ; clear high-order byte *iny *sta @DevNum,y * *rts  *pop16 RetCode *pop16 DevNum *pop16 DeviceName *pushret * *ldy #0 *lda #DeviceName *sta DevNamPtr *sty DevNamPtr+1 ; supply Device name ptr   jsr GetDevNum *sta @RetCode,y ; set low-order byte of Return coa &pha &.endm &  ;-----   .proc SOS_DevNum,3 *;procedure SOS_DevNum(DeviceName: string; *; var DevNum, RetCode: integer); * DeviceName .equ 0ec DevNum .equ 0ea RetCode .equ 0e8 * *pullret &.macro pop16 &pla &sta %1 &pla &sta %1+1 &.endm & &.macro pop8 &pla &sta %1 &pla &.endm & &.macro set16a &lda %1 &sta %2 &lda %1+1 &sta %2+1 &.endm & &.macro pullret &pla &tax &pla &tay &.endm & &.macro pushret &tya &pha &tx ; supply RefNum *  jsr Close *sta @RetCode,y ; set low-order byte of Return code *tya *iny *sta @RetCode,y ; clear high-order byte *rts   ;-----*  Close brk ( .byte 0CC *.word ClosePrm *rts * ClosePrm .byte 1 ; 4 parameters CloseRef .byte ; RefNum 0  ;-----*  .proc SOS_LWrite,4 *;procedure SOS_LWrite(RefNum: integer; var BufAdr; ByteCount: integer; *; Code ;place ControlCode in parmlist 0sta CCode 0 0jsr DControl ;go for it 0 0ldy #0 0sta @RetCode,y 0tya 0iny 0sta @RetCode,y ;clear high byte 0 0rts 0  ;-----* DControl brk 0.byte 83 0.word C .equ 0e8 RetCode .equ 0e6 0pullret 0pop16 RetCode 0pop16 CListAddr 0pop16 ControlCode 0pop16 DevNum 0pushret ( 0lda DevNum ;place DevNum in parmlist (l.o. only) 0sta DevNumber 0 0lda Control0.word SListAddr  ;-----*  .proc SOS_DControl,4 (;procedure SOS_DControl(DevNum, ControlCode:integer; (; var ControlList; var RetCode:integer); ( DevNum .equ 0ec ControlCode .equ 0ea CListAddr y 0tya 0iny 0sta @RetCode,y ;clear high byte 0 0rts 0  ;-----* DStatus brk 0.byte 82 0.word SParms 0rts 0 SParms .byte 3 DevNumber .byte SCode .byte tusCode 0pop16 DevNum 0pushret ( 0lda DevNum ;place DevNum in parmlist (l.o. only) 0sta DevNumber 0 0lda StatusCode ;place StatusCode in parmlist 0sta SCode 0 0 0jsr DStatus ;go for it 0ldy #0 0sta @RetCode,(; var StatusList; var RetCode:integer); ( DevNum .equ 0ec StatusCode .equ 0ea SListAddr .equ 0e8 RetCode .equ 0e6 0pullret 0pop16 RetCode 0pop16 SListAddr 0pop16 StaReadAdr .word ReadBuffer ; Buffer ptr ReadSize .word 0 ; Number of bytes  ReadRet .word ; Bytes read ( returned ) *   ;-----*  .proc SOS_DStatus,4 (;procedure SOS_DStatus(DevNum, StatusCode:integer; lda ReadRet (sta @BytesRead,y ( ( (rts (  Read brk ;Sos Read ( .byte 0CA *.word ReadPrm *rts * ReadPrm .byte 4 ; 4 parameters ReadNum .byte ; SOS Reference number ;Address of return code (pop16 ReadSize (pop16 ReadBuffer (pop8 ReadNum ( (pushret ( (jsr Read ( (ldy #0 (sta @RetCode,y ( (lda #0 (iny (sta @RetCode,y ( (lda ReadRet+1 (sta @BytesRead,y (dey ( var RetCode, BytesRead: integer ); * BytesRead .equ 0ec RetCode .equ 0ea ReadBuffer .equ 0e8   pullret ( (pop16 BytesRead ;Address of bytes read (pop16 Retcode WriteNum .byte ; SOS Reference number WriteBuf .word ; Buffer ptr WriteSize .word 0 ; Number of bytes + (.proc SOS_LRead,5  ; ; procedure SOS_LRead ( RefNum: integer; var BufAdr; ByteCount: integer; ;de,y ; set low-order byte of Return code *tya *iny *sta @RetCode,y ; clear high-order byte *rts   ;-----*  Write brk ( .byte 0CB *.word WritePrm *rts * WritePrm .byte 3 ; 3 parameters riteNum ; supply device number value * *lda #BufAdr *sta WriteBuf  sty WriteBuf+1 ; supply buffer ptr   set16a ByteCount,WriteSize ; supply byte count value   jsr Write *sta @RetCo var RetCode: integer); * RefNum .equ 0ec BufAdr .equ 0ea ByteCount .equ 0e8  RetCode .equ 0e6 * *pullret * *pop16 RetCode *pop16 ByteCount *pop16 BufAdr *pop16 RefNum * *pushret * *ldy #0 *lda RefNum *sta WParms 0rts 0 CParms .byte 3 DevNumber .byte CCode .byte 0.word CListAddr   ;-----* *.end %lgrafin grafin.asm GrafIn.U.code %%%% etNDC2 ( Cur_DState^.deviceName, maxSize.x, maxSize.y ); $ $D_Reset; $D_GrafixOn; $ $WindowSize ( xWindowSize, yWindowSize ); $WindowCenter (0.0, 0.0); " $vSize.x:= maxSize.y; $vSize.y:= maxSize.y; $vCenter.x:= vSize.x * 0.5; $vCenter.y:= vSize. char; begin " $write('Output to the Screen? ');read(ch); $if (ch in ['y','Y']) then begin (SetDevice ('Bw560'); (writeln; write ('Interlace mode? ');read (ch); (if ch in ['y','Y'] then D_GrafixPage ( 3 ); $end $else SetDevice ('HP'); $G,D_LineTo ( topRight.x, topRight.y ); ,D_LineTo ( botLeft.x, topRight.y ); ,D_LineTo ( botLeft.x, botLeft.y ); (end; $end;  begin  D_Frame; $ViewSize ( vSize.x - inset.x, vSize.y - inset.y ); $D_Frame;  end;  procedure SetUp; var ch: riteln; $write('Press to continue...'); $readln; $write ( chr(28) ); end;  procedure FrameView;  $procedure D_Frame; $begin (with Cur_DState^.VPortBounds do begin ,D_MoveTo ( botLeft.x, botLeft.y ); ,D_LineTo ( topRight.x, botLeft.y ); rld coordinate'); $writeln('primitives in a 2D environment.'); $writeln; $writeln('You may direct output to either the screen or a plotter.'); $writeln; $writeln('When the program ''beeps'''); $writeln('you must press to exit the program.'); $wst. } (  var inset: rVector2; (maxSize: rVector2; (vCenter: rVector2; (vSize: rVector2; ( procedure Intro; begin $write ( chr(28) ); { Clear screen first } $writeln('This demo program illustrates using simple wo program SimpleDemo; uses RealModes, (Transcend, ({$u *lib/RasterCore.Lib } (MemoryManager, (RasterCore, ({$u *lib/ModelGraf.Lib } (GrafOut, (ModelGraf; % const xWindowSize= 20.0; (yWindowSize= 20.0; (  {$include grafout.con1 z O^֤بy * 0.5; $inset.x:= vSize.x * 0.025; $inset.y:= vSize.y * 0.025; $ $ViewCenter ( vCenter.y, vCenter.y ); $ViewSize ( vSize.x, vSize.y ); end;  procedure Pattern; const masterDelta= 0.5;  var delta: rVector2; (point1: rVector2; (point2: rVector2; (stop: rVector2; (  procedure Sweep; begin "repeat $MoveTo_2D ( point1.x, point1.y ); $LineTo_2D ( point2.x, point2.y );  point1.y:= point1.y + delta.y; $point2.x:= point2.x + de7,"Output to the Screen? سVצBw5607צInterlace mode? س*צHP7+) 7**AA7)7(   eeps'(you must press to exit the program.Press to continue...+)Dؼآ*آآ* آآ* ؼآ* ؼآ* L;This demo program illustrates using simple world coordinateצprimitives in a 2D environment.8You may direct output to either the screen or a plotter.When the program 'b^Lcc88gKKIGrafOut Copyright (C) 1983SIMPLEDE dln; " $D_Close; $CloseMemory; "  end. & WindowSize ( xWindowSize * vSize.x, yWindowSize * vSize.y ); $ViewPort ( maxSize.y, maxSize.x, 0.0, maxSize.y ); $FrameView; $ $CubicTriangles; $ $write ( chr(7) ); $if Cur_DState^.DeviceNum=Plotter then D_Reset { lift pen for plotter } $else rea ( position.x, position.y ); (smallSquared:= squared / 3.0; (IsoTriangle ( smallSquared, smallSquared ); $end;  end;  begin { SimpleDemo } " $Intro; $SetUp; $FrameView; $ $Pattern; $ $vSize.x:= maxSize.x - maxSize.y; $vSize.y:= maxSize.y; $ squared: real;  smallSquared: real;   begin $D_MarkerType ( M_Star ); $for i:= -24 to 24 do begin $ position.x:= i / 8; $ squared:= sqr ( position.x ); (position.y:= position.x * ( squared - 4.0 ); $ Marker_2D -halfSize.y );  R_LineTo_2D ( base, 0.0 ); $R_LineTo_2D ( -halfSize.x, height ); $R_LineTo_2D ( -halfSize.x, -height ); end;  procedure CubicTriangles; var i: integer;  position: rVector2; Sweep; $delta.x:= -delta.x; $Sweep; $delta.y:= -delta.y; $Sweep; $  end; procedure IsoTriangle ( base, height: real ); var halfSize: rVector2;  begin $halfSize.x:= base * 0.5; $halfSize.y:= height * 0.5;  R_MoveTo_2D ( -halfSize.x,lta.x; "until ((point1=stop) or (point2=stop) );  end;  begin; $point1.x:= 0.0; $point1.y:= 0.0; $point2.x:= 10.0; $point2.y:= 0.0;  stop:= point1; $delta.x:= -masterDelta; $delta.y:= masterDelta;  $Sweep; $delta.y:= -delta.y; $? ?<̐<̐  7+7,D7  7     R Z  A  ?? p??7777Z* ȡR@7@@Yl +,D_LineTo ( topRight.x, botLeft.y ); ,D_LineTo ( topRight.x, topRight.y ); ,D_LineTo ( botLeft.x, topRight.y ); ,D_LineTo ( botLeft.x, botLeft.y ); (end; $end;  begin  D_Frame; $ViewSize ( vSize.x - inset.x, vSize.y - inset.y ); $D_Frame;  press to exit the program.'); $writeln; $write('Press to continue...'); $readln; $write ( chr(28) ); end;  procedure FrameView;  $procedure D_Frame; $begin (with Cur_DState^.VPortBounds do begin ,D_MoveTo ( botLeft.x, botLeft.y ); nstrates the Circle, Arc, Ellipse,'); $writeln('and Spline drawing primitives in a 2D environment.'); $writeln; $writeln('You may direct output to either the screen or a plotter.'); $writeln; $writeln('When the program ''beeps'''); $writeln('you must} (  var aspect: real; (inset: rVector2; (maxSize: rVector2; (vCenter: rVector2; (vSize: rVector2; procedure Intro; begin $write ( chr(28) ); { Clear screen first } $writeln('This demo program demo program CurveDemo; uses RealModes, %Transcend, %{$u *lib/RasterCore.lib } %MemoryManager, %RasterCore, %{$u *lib/ModelGraf.lib } %GrafOut, %ModelGraf; % const xWindowSize= 20.0; (yWindowSize= 20.0; (  {$include grafout.const. 1 O^֤بLIBRARY FILES: *lib/RasterCore.lib *lib/ModelGraf.lib $$ +'9/&*7  AA7)  7- +)á**/+78*+&'/9 9/'&+*87$ Q`4Z end;  procedure SetUp; var ch: char; begin " $write('Output to the Screen? ');read(ch); $if (ch in ['y','Y']) then begin $ SetDevice ('Bw560'); (writeln; write ('Interlace Mode? ');read (ch); (if ch in ['y','Y'] then D_GrafixPage ( 3 ); $end $else SetDevice ('HP'); $GetNDC2 ( Cur_DState^.deviceName, maxSize.x, maxSize.y ); $ $D_Reset; $D_GrafixOn; $ $WindowSize ( xWindowSize, yWindowSize ); $WindowCenter (0.0, 0.0); " $vSize.x:= maxSize.y; $vSize.y:= maxSize.y; $ $vC$write ( chr(7) ); $if Cur_DState^.DeviceNum=Plotter then (D_Reset { lift pen for plotter } $else readln; $ $D_Close; $CloseMemory;  end. & ; $Arcs; $ $vSize.x:= maxSize.x - maxSize.y; $vSize.y:= maxSize.y; $aspect:= vSize.y / vSize.x; $ $WindowSize ( xWindowSize / aspect, yWindowSize ); $ViewPort ( maxSize.y, maxSize.x, 0.0, maxSize.y ); $FrameView; $ $ShowParts; $ parts:= 6; ,2: parts:= 18; ,3: parts:= 36; ,4: parts:= 60; (end; (CurveParts ( parts ); (Circle ( 1.5 ); (i:= i+1; $ t:= i * tDelta; $until t > stop;  end;  begin { CurveDemo } " $Intro; $SetUp; $ $FrameView; $ $Circles; $Ellipses stop= 1.0;  tDelta= 0.25;  var i: integer; (parts: integer; (t: real;  begin $i:=0; $t:= 0; $repeat $ Marker_2D ( 0.0 , t * 14.0 - 7.0 ); $ case i of ,0: parts:= 4; ,1:  begin { Arcs } " InitArcs; $CurveParts ( 60 ); $for i:= 1 to nArcs do begin (MoveTo_2D ( arcData[i].start.x, arcData[i].start.y ); (Arc ( arcData[i].center.x, arcData[i].center.y, arcData[i].angle );  end;  end;  procedure ShowParts; const arcData[i].start.x := xCenter + r * cos ( theta ); ,arcData[i].start.y := yCenter + r * sin ( theta ); ,arcData[i].center.x := xCenter; ,arcData[i].center.y := yCenter; ,arcData[i].angle := (2.0*t + 1.0 ) * 30.0; ,t:= i * tDelta; (end; $end; = 0.05; ,xCenter= 5.0; ,yCenter= -5.0; $var r: real; ,t: real; ,theta: real; $begin (t:=0; (for i:= 1 to nArcs do begin ,theta:= t * periods * 360.0 * Deg2Rad; ,r:= (t+ 0.25) * 4.0; ,e arcRecord= record ,start: rVector2; ,center: rVector2; ( angle: real; (end;  var arcData: array [1..nArcs] of arcRecord;  i: integer;  $procedure InitArcs; $const periods= 5; ,tDelta(Marker_2D ( center.x, center.y ); (Ellipse ( 6.0 - 5.0 * t, 1.0 + 5.0 * t ); (cPoints [i]:= center; (t:= t + tDelta; $ i:= i+1; $until t >= stop;  Spline ( i, False, False, cPoints );  end; procedure Arcs; const nArcs= 20;  typrVector2; (i: integer; (t: real;  theta: real;  begin $t:=0; $i:=0; $repeat $ theta:= ( -90.0 + t * 180.0 ) * Deg2Rad; $ center.x:= -7.0 + 14.0 * t; (center.y:= 7.0 * sin ( theta ); ajorRadius * sin ( theta ) ); $ Circle ( radius ); (i:= i + 1; (t:= i * tDelta; $until t >= stop;  end; procedure Ellipses; const stop= 1.0; (tDelta= 0.1;  var center: rVector2; (cPoints: array [0..20] of a: real;  begin " i:=0; $t:=0; $smallRadius:= majorRadius * 0.1; $repeat $ theta:= t * 360.0 * Deg2Rad; (radius:= t * ( majorRadius * 0.5 - smallRadius ) + smallRadius; (Marker_2D ( xCenter + majorRadius * cos ( theta ), 4yCenter + m  procedure Circles; const majorRadius= 3; (stop= 1.0; (tDelta= 0.1; (xCenter= -5.0; (yCenter= 5.0;  var i: integer; (radius: real; (smallRadius: real; (t: real; (thetenter.x:= vSize.x * 0.5; $vCenter.y:= vSize.y * 0.5; $ $inset.x:= vSize.x * 0.025; $inset.y:= vSize.y * 0.025; $aspect:= vSize.y / vSize.x; $ $ViewCenter ( vCenter.y, vCenter.y ); $ViewSize ( vSize.x, vSize.y ); $ $D_MarkerType ( M_Star ); end; '&+*87$$Q8 8 ʀ 7ʀ ʀ ʀ 7ʀ̀ɹj `A@7ع&!$< !7?7س>?{ ++'9/&*7   AA7)   7- +)á**/+78*+&'/9 9/ɹ   <7̀̀ʀʀȡ^ʀ ʀ 7ʀ ʀ ʀ 7ʀ̀ɹj `A@7ع&!$< !7?7ȡC<5>@ @  @  @?AɳL=̉=̉?ZY\BZ4C<5@`AZ@\7@@Z?@Z7YZZ=̃YYZ?Y7   ??<̐<̐7+7,*T=̉C<5?@77س7,"Output to the Screen? سVצBw5607צInterlace Mode? س*צHP7+) 7**AA7)7( n the program 'beeps'(you must press to exit the program.Press to continue...+)Dؼآ*آآ* آآ* ؼآ* ؼآ* L8This demo program demonstrates the Circle, Arc, Ellipse,2and Spline drawing primitives in a 2D environment.8You may direct output to either the screen or a plotter.Whe^Lcc88gKKIGrafOut Copyright (C) 1983<CURVEDEM س>?{ ++'9/&*7   AA7)   7- +)á**/+78*+&'/9 9/LIBRARY FILES: *lib/RasterCore.lib *lib/ModelGraf.lib $$ .y ); ,D_LineTo ( topRight.x, botLeft.y ); ,D_LineTo ( topRight.x, topRight.y ); ,D_LineTo ( botLeft.x, topRight.y ); ,D_LineTo ( botLeft.x, botLeft.y ); (end; $end;  begin  D_Reset; $D_Frame; $ViewSize ( vSize.x - inset.x, vSize.y - inset.y:= 2.0; "cPoints[3].y:= 4.0; "cPoints[4].x:= 8.0; "cPoints[4].y:= -2.0; "cPoints[5].x:= 6.0; "cPoints[5].y:= -8.0; end;  procedure FrameView;  $procedure D_Frame; $begin (with Cur_DState^.VPortBounds do begin ,D_MoveTo ( botLeft.x, botLeft$write('Press to continue...'); $readln; $write ( chr(28) ); end;  procedure GetPoints; begin "cPoints[0].x:= -6.0; "cPoints[0].y:= -8.0; "cPoints[1].x:= -8.0; "cPoints[1].y:= 0.0; "cPoints[2].x:= -4.0; "cPoints[2].y:= 5.0; "cPoints[3].xthe'); $writeln('SplineParts attribute: (2,4,10, and 30 parts).'); $writeln(''); $writeln('You may direct output to either the screen or a plotter.'); $writeln; $writeln('When the program ''beeps'' you must press to continue.'); $writeln; ite ( chr(28) ); { Clear screen first } $writeln('This demo program shows in the first four display panels'); $writeln('how the same control points can generate four different spline'); $writeln('curves. The next four panels show increasing values of (xWindowSize= 20.0; (yWindowSize= 20.0; (  var cPoints: array [ 0..maxKnots ] of rVector2; (inset: rVector2; (maxSize: rVector2; (vCenter: rVector2; (vSize: rVector2; ( ( procedure Intro; begin $wr program SplineDemo; uses {$u *system.library} %AppleStuff, %RealModes, %Transcend, %{$u *lib/RasterCore.Lib } %MemoryManager, %RasterCore, %{$u *lib/ModelGraf.Lib } %GrafOut, %ModelGraf; % const {$i grafout.const. } ( (maxKnots= 5; 1 FO^֤ب ); $D_Frame;  end;  procedure SetUp; var ch: char; begin " $write('Output to the Screen? ');read(ch); $if (ch in ['y','Y']) then begin $ SetDevice ('Bw560'); (writeln; write ('Interlace mode? ');read (ch); (if ch in ['y','Y'] then D_GrafixPage ( 3 ); $end $else SetDevice ('HP'); $ $GetNDC2 ( Cur_DState^.deviceName, maxSize.x, maxSize.y ); $ $vSize.x:= maxSize.y * 0.5; $vSize.y:= vSize.x; $vCenter.x:= maxSize.x * 0.5; $vCenter.y:= maxSize.y * 0.5; @n^Lcc88gKKIGrafOut Copyright (C) 1983SPLINEDE eset "else readln;  end;  begin " "Intro; "SetUp; "GetPoints; " "FourCases; "ShowParts; " "D_Close; "CloseMemory;   end. & ); "ViewPort ( vCenter.x, vCenter.x + vSize.x, vCenter.y - vSize.y, vCenter.y ); "FrameView; "D_MarkerType ( 5 ); "PolyMarker ( 2, 6, cPoints ); "Spline ( 6, True, False, cPoints ); " "write ( chr(7) );  if Cur_DState^.DeviceNum=Plotter then D_R" "SplineParts ( 10 ); "ViewPort ( vCenter.x - vSize.x, vCenter.x, vCenter.y - vSize.y, vCenter.y ); "FrameView; "D_MarkerType ( 4 ); "PolyMarker ( 2, 6, cPoints ); "Spline ( 6, True, False, cPoints ); " "{ SplineParts = 30 } " "SplineParts ( 30SplineParts = 4 } " "SplineParts ( 4 ); "ViewPort ( vCenter.x, vCenter.x + vSize.x, vCenter.y, vCenter.y + vSize.y ); "FrameView; "D_MarkerType ( 3 ); "PolyMarker ( 2, 6, cPoints ); "Spline ( 6, True, False, cPoints ); " "{ SplineParts = 10 } howParts; begin " "{ SplineParts = 2 } " "SplineParts ( 2 ); "ViewPort ( vCenter.x - vSize.x, vCenter.x, vCenter.y, vCenter.y + vSize.y ); "FrameView; "D_MarkerType ( 2 ); "PolyMarker ( 2, 6, cPoints ); "Spline ( 6, True, False, cPoints ); " "{ ; $ $write( chr(7) ); $if Cur_DState^.DeviceNum=Plotter then begin 'D_Reset; { lift pen for plotter } 'D_TextOn; 'writeln('Please put in a new sheet of paper and then hit '); 'readln; 'D_GrafixOn; $end " else readln; " end;  procedure S$PolyLine ( 2, 6, cPoints ); $Spline ( 6, False, True, cPoints ); $ ${ Closed, hull spline } $ $ViewPort ( vCenter.x, vCenter.x + vSize.x, vCenter.y - vSize.y, vCenter.y ); $FrameView; $PolyGon ( 2, 6, cPoints ); $Spline ( 6, True, True, cPoints )x + vSize.x, vCenter.y, vCenter.y + vSize.y ); $FrameView; $PolyGon ( 2, 6, cPoints ); $Spline ( 6, True, False, cPoints ); $ ${ Open, hull spline } $ $ViewPort ( vCenter.x - vSize.x, vCenter.x, vCenter.y - vSize.y, vCenter.y ); $FrameView; Open, non-hull spline } $ $ViewPort ( vCenter.x - vSize.x, vCenter.x, vCenter.y, vCenter.y + vSize.y ); $FrameView; $PolyLine ( 2, 6, cPoints ); $Spline ( 6, False, False, cPoints ); $ ${ Closed, non-hull spline } $ $ViewPort ( vCenter.x, vCenter.$ $inset.x:= vSize.x * 0.025; $inset.y:= inset.x; $ $D_Reset; $D_PenColor ( S_Black ); $D_FillColor ( S_White ); $ $D_GrafixOn; $ $WindowSize ( xWindowSize, yWindowSize ); $WindowCenter (0.0, 0.0); "  end;  procedure FourCases; begin $ ${ 8This demo program shows in the first four display panels>how the same control points can generate four different spline;curves. The next four panels show increasing values of theצ.Spl 1 O^6بLIBRARY FILES: *lib/RasterCore.lib *lib/ModelGraf.lib $$ Z++'9/&*7*/+78*+&'/9#9/'&+*87PV6pput in a new sheet of paper and then hit *67#'#%%)7-*777##'%%)7-*77 7#'#%)%7-*777##'%)%7-*77+)á*#'%%)7-77#'#%)%7-77##'%)%7-77+)á[**צ4Please put in a new sheet of paper and then hit *e? س*צHP7+)!7'!?)'#?%!?'<̐****AA7)7(6#'#%%)7-77#A+)Dؼآ*آآ* آآ* ؼآ* ؼآ* L*')7,$Output to the Screen? سVצBw5607צInterlace mod to continue...6@AA@@@@A@@ineParts attribute: (2,4,10, and 30 parts).צצ8You may direct output to either the screen or a plotter.צ9When the program 'beeps' you must press to continue.Press Program PlotDemo; uses RealModes, (Transcend, ({$u *lib/RasterCore.lib } (MemoryManager, (RasterCore, ({$u *lib/ModelGraf.lib } (GrafOut, (ModelGraf, (TextGraf; ( const circleNodes= 72; (numCircles= 40; (periods= 4;   ; $end; $for i:= 1 to circleNodes do begin $ with circles[1,i] do MoveTo3D ( x, y, circleF[1] ); (for j:= 2 to numCircles do begin ,with circles[j,i] do LineTo3D ( x,y, circleF [j] ); (end; $end;  end; begin $Intro; $rMax:= 2.0 * pi * periodcircles[j,i].x:= x * r; 0circles[j,i].y:= y * r; ,end; (end; (with circles[j,1] do MoveTo3D ( x, y, f ); $ for i:= 2 to circleNodes do begin ,with circles[j,i] do LineTo2D ( x, y ); (end; (with circles[j,1] do LineTo2D ( x, y ); (r:= r + rDelta$rDelta:= rMax * ( 1.0 / numCircles ); $r:= rDelta; $for j:= 1 to numCircles do begin $ rSqr:= sqr ( r * rScale ); $ f:= fScale * sin ( rSqr ) / rSqr; $ circleF[j]:= f; (for i:= 1 to circleNodes do begin ( with circleData[i] do begin 0:= t + tDelta; $ write ('.'); $end;  writeln;  end;  procedure PlotCircles; const fScale= 15.0;  rScale= 0.2;  var f: real; (i,j: integer; (r: real;  rDelta: real; (rSqr: real;  begin $j:=1; l; (  begin $write('Please wait a few moments'); $tDelta:= 1.0 / circleNodes; $t:=0; $i:=1; $for i:= 1 to circleNodes do begin  theta:= 2.0 * pi * t; (with circleData[i] do begin ( x:= cos ( theta ); ,y:= sin ( theta ); (end; $ tojection ( Perspective ); $EyePoint ( 0.0, 0.0, 1.5 * rMax ); $LensSize ( 0.5 ); $Identity; $XRot ( -70.0 ); $Clipping ( True ); $ $D_GrafixOn;  end;  procedure ComputeCircle; var i: integer; (t: real; (tDelta: real; (theta: rea$vSize.y:= outSize.y - outSize.x * 0.025; $vCenter.x:= maxSize.x * 0.5; $vCenter.y:= maxSize.y * 0.5; $ $WindowSize ( vSize.x, vSize.y ); $WindowCenter (0.0, 0.0); " $ViewCenter ( vCenter.x, vCenter.y ); $ViewSize ( outSize.x, outSize.y ); $ $Prin ['y','Y']) then D_GrafixPage ( 3 ); $end $else SetDevice ('HP'); $D_Reset; $ $GetNDC2 ( CurDState^.deviceName, maxSize.x, maxSize.y ); $outSize.x:= maxSize.x; $outSize.y:= maxSize.y; $vSize.x:= outSize.x - outSize.x * 0.025; ( vSize.x, vSize.y ); $D_Frame;  end;  procedure SetUp; var ch: char;  begin " $write('Output to the Screen? ');read(ch); $if (ch in ['y','Y']) then begin $ SetDevice ( 'Bw560' ); $ writeln; write('Interlace mode? ');read(ch); (if (ch opRight.x, botLeft.y ); (D_LineTo ( topRight.x, topRight.y ); (D_LineTo ( botLeft.x, topRight.y ); (D_LineTo ( botLeft.x, botLeft.y ); $end; end;   procedure FrameView; begin $ViewSize ( outSize.x, outSize.y );  D_Reset; $D_Frame; $ViewSize $writeln('you must press to exit the program.'); $writeln; $write('Press to continue...'); $readln; $write ( chr(28) ); end; procedure D_Frame; begin $with CurDState^.VPortBounds do begin (D_MoveTo ( botLeft.x, botLeft.y ); (D_LineTo ( tnal function in perspective.'); $writeln(''); $writeln('It takes about 10 minutes to complete the plot.'); $writeln; $writeln('You may direct output to either the screen or a plotter.'); $writeln; $writeln('When the program ''beeps'''); (maxSize: rVector2; (outSize: rVector2; (rMax: real; (vCenter: rVector2; (vSize: rVector2; (  procedure Intro; begin $write ( chr(28) ); { Clear screen first } $writeln('This demo program plots a 3 dimensio {$include grafout.const. } (  type circlePoints= array [1..circleNodes] of rVector2;   var circleF: array [1..numCircles] of real;  circleData: circlePoints; (circles: array [1..numCircles] of circlePoints; s; $ $ComputeCircle; $SetUp; $FrameView; ( $PlotCircles; ( $write ( chr(7) ); $if CurDState^.DeviceNum=Plotter then D_Reset $else readln; $  D_Close; $CloseMemory;   end.  VPLOTDEMO LIBRARY FILES: *lib/RasterCore.lib *lib/ModelGraf.lib $$ LIBRARY FILES: *lib/RasterCore.lib *lib/ModelGraf.lib $$ /9&9/'&+*87)(+]^n <s( H 7 H ȡ(s( H 7s( H 7H ȡss( H (7 ( ȡ4s( H (7 zDo++'9/&*7({@I@+)á**/+()78*+&'ȡSSH s( Hs( Hs( H 7 H ȡ(s( H 7s( H 7H ȡss( H?HHȡ[@I@SH .j{?(( ȡ L>̐pA  (H ۥyuww<̐yw<̐}s?u?7)7(}7+wy7,7.?{7/?757B77:*Please wait a few moments* Lwy7,*7,*Output to the Screen? سVצBw5607צInterlace mode? س*צHP7*+)su7wsצWhen the program 'beeps'צ(you must press to exit the program.צPress to continue...+)Dؼآ*آآ* آآ* ؼآ* ؼض@This demo program plots a 3 dimensional function in perspective./It takes about 10 minutes to complete the plot.צ8You may direct output to either the screen or a plotter.^Lccee88gKKITextGraf Copyright (C) 1983