| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101 |
- Listing:
- 1 (* Release 3.10 *)
- 2 (*-------------------------------------------------------------------------*
- 3 * *
- 4 * GRAPH.MOD - Graphics functions *
- 5 * *
- 6 * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. *
- 7 * All Rights Reserved *
- 8 * *
- 9 *--------------------------------------------------------------------------*)
- 10
- 11 (*# call(o_a_copy => off) *)
- 12 (*%T _fcall *)
- 13 (*# call(seg_name => GRAPHICS) *)
- 14 (*%E *)
- 15 (*# module(implementation=>off) *)
- 16 (*%F _fdata *)
- 17 (*# data(seg_name => null) *)
- 18 (*%E *)
- 19 (*# check(stack=>off,
- 20 index=>off,
- 21 range=>off,
- 22 overflow=>off,
- 23 nil_ptr=>off) *)
- 24
- 25
- 26 IMPLEMENTATION MODULE Graph;
- 27
- 28 IMPORT Str,Lib,SYSTEM,Storage;
- 29 (*%T _XTD *)
- 30 IMPORT IO,TSXLIB;
- 31 FROM TSXLIB IMPORT SEL_A000H,SEL_B000H,SEL_B800H;
- ***** ^ duplicate identifier
- 32 CONST _XTDDOS = TRUE;
- 33 (*%E*)
- 34 (*%F _XTD *)
- 35 (*%F _OS2 *)
- 36 IMPORT IO;
- 37 CONST _XTDDOS = TRUE;
- 38 (*%E *)
- 39 (*%T _OS2 *)
- 40 (*%F _fcall *)
- 41 IMPORT IO;
- 42 (*%E *)
- 43 IMPORT Dos,Vio,GraphI,CoreGraph,CoreSig;
- 44 FROM Storage IMPORT ALLOCATE,DEALLOCATE;
- 45 CONST _XTDDOS = FALSE;
- 46 (*%E _OS2 *)
- 47 (*%E _XTD *)
- 48
- 49 (*%T _XTDDOS *)
- 50
- 51 (*%F _XTD *)
- 52 CONST
- 53 SEL_A000H = 0A000H;
- 54 SEL_B000H = 0B000H;
- 55 SEL_B800H = 0B800H;
- 56 (*%E*)
- 57
- 58 (*****************************************************************************)
- 59 (* Constant Definitions. *)
- 60 (*****************************************************************************)
- 61
- 62 CONST
- 63 HEADER_SIZE = 4;
- 64 FILL_MASK_SIZE = 8;
- 65 GRAPHICS = 1;
- 66 TEXT = 0;
- 67 LEFT = -1;
- 68 RIGHT = 1;
- 69 UP = -1;
- 70 DOWN = 1;
- 71 MAXMODE = _MRES256COLOR;
- ***** ^ undeclared identifier
- 72 CGA320Width = 320;
- 73 CGA640Width = 640;
- 74 EGA640Width = 640;
- 75 EGA320Width = 320;
- 76 EGA200Depth = 200;
- 77 EGA350Depth = 350;
- 78 EGA480Depth = 480;
- 79
- 80 TYPE
- 81 ArcQuadrant = ARRAY [0..3] OF SHORTCARD;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 82
- 83 CONST
- 84 _Q_CLEAR = 5;
- 85 _Q_1SEG = 4; (* one section in quadrant *)
- 86 _Q_2SEG = 3; (* two sections in quadrant *)
- 87 _Q_STEST = 2; (* start vector in quadrant *)
- 88 _Q_ETEST = 1; (* end vector in quadrant *)
- 89 _Q_NULL = 0;
- 90
- 91 (*****************************************************************************)
- 92 (* type and function definitions. *)
- 93 (*****************************************************************************)
- 94 TYPE
- 95 InterSect = RECORD
- 96 x,y : INTEGER;
- 97 END; (*InterSect*)
- ***** ^ not supported yet
- 98
- 99 FloodStart = RECORD
- 100 best_quad : INTEGER;
- 101 quad_type : INTEGER;
- 102 flag : INTEGER;
- 103 END; (*FloodStart*)
- ***** ^ not supported yet
- 104 tinyint = [0..7];
- 105 bs = SET OF tinyint;
- ***** ^ not supported yet
- 106 bp = POINTER TO bs;
- ***** ^ not supported yet
- 107 (*# save,data(near_ptr=>off) *)
- 108 HercMapType = ARRAY[0..(HercDepth DIV 4)-1] OF ARRAY[0..(HercWidth DIV 8)-1] OF bs;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 109 CGAPointer = POINTER TO SHORTCARD;
- ***** ^ not supported yet
- 110 VGAPointer = POINTER TO SHORTCARD;
- ***** ^ not supported yet
- 111 (*# restore *)
- 112
- 113 VAR
- 114 (*# save,data(near_ptr=>off) *)
- 115 HercBitMap : ARRAY [0..1] OF ARRAY [0..3] OF POINTER TO HercMapType;
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 116 (*# restore *)
- 117 StaticMode : CARDINAL;
- 118 (*****************************************************************************)
- 119 (* Data Definitions and Declarations. *)
- 120 (*****************************************************************************)
- 121
- 122 TYPE
- 123 ColTableType = ARRAY [0..15] OF LONGCARD;
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- 124 EGATableType = ARRAY [0..15] OF CARDINAL;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 125 CONST
- 126 ColTable = ColTableType( _BLACK, _BLUE, _GREEN, _CYAN, _RED, _MAGENTA, _BROWN,
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 127 _WHITE, _GRAY, _LIGHTBLUE, _LIGHTGREEN, _LIGHTCYAN,
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 128 _LIGHTRED, _LIGHTMAGENTA, _LIGHTYELLOW, _BRIGHTWHITE);
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 129
- 130
- 131 VAR
- 132 EGATable: EGATableType;
- ***** ^ not supported yet
- 133 ModeChanged: BOOLEAN;
- 134 (*****************************************************************************)
- 135 (* Function definitions - low level plotting and drawing. *)
- 136 (*****************************************************************************)
- 137
- 138 (*# save *)
- 139 (*# call(near_call=>on) *)
- 140
- 141
- 142 PROCEDURE EllipsePlot(x, y: INTEGER);
- 143
- 144 BEGIN
- 145 IF ((x <= CoreGraph._clip_br.xcoord) AND (x >= CoreGraph._clip_tl.xcoord)
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 146 AND (y <= CoreGraph._clip_br.ycoord) AND (y >= CoreGraph._clip_tl.ycoord)) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 147 CoreGraph._plot(x, y, CoreGraph._fgcolor);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 148 END;
- 149 RETURN;
- 150 END EllipsePlot;
- ***** ^ not supported yet
- 151
- 152 PROCEDURE GetFillStart(VAR x, y: INTEGER; ox, oy, startx, starty,
- 153 endx, endy: INTEGER): BOOLEAN;
- 154
- 155 VAR
- 156 fx, fy: INTEGER;
- 157 BEGIN
- 158 IF CoreGraph._fstart.flag = 0 THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 159 RETURN FALSE;
- 160 END;
- 161 IF((startx = endx) AND (starty = endy)) THEN
- 162 RETURN FALSE;
- 163 END;
- 164 IF CoreGraph._fstart.quad_type = _Q_CLEAR THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 165 CASE CoreGraph._fstart.best_quad OF
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 166 | 0:
- 167 fx:=ox+1;
- 168 fy:=oy+1;
- 169 | 1:
- 170 fx:=ox+1;
- 171 fy:=oy-1;
- 172 | 2:
- 173 fx:=ox-1;
- 174 fy:=oy-1;
- 175 | 3:
- 176 fx:=ox-1;
- 177 fy:=oy+1;
- 178 END;
- 179 ELSIF (CoreGraph._fstart.quad_type = _Q_STEST) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 180 CASE CoreGraph._fstart.best_quad OF
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 181 | 0:
- 182 fx:=ox+(((startx-ox+1)>>1)+1);
- 183 fy:=oy+(((starty-oy)>>1)-1);
- 184 | 1:
- 185 fx:=ox+(((startx-ox)>>1)-1);
- 186 fy:=starty+(((oy-starty)>>1)-1);
- 187 | 2:
- 188 fx:=startx+(((ox-startx)>>1)-1);
- 189 fy:=starty+(((oy-starty+1)>>1)+1);
- 190 | 3:
- 191 fx:=startx+(((ox-startx+1)>>1)+1);
- 192 fy:=oy+(((starty-oy+1)>>1)+1);
- 193 END;
- 194 ELSE (* _Q_1SEG *)
- 195 CASE CoreGraph._fstart.best_quad OF
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 196 | 0:
- 197 fx:=startx+((endx-startx)>>1)-1;
- 198 fy:=endy+((starty-endy)>>1)-1;
- 199 | 1:
- 200 fx:=endx+((startx-endx)>>1)-1;
- 201 fy:=endy+((starty-endy)>>1)+1;
- 202 | 2:
- 203 fx:=endx+((startx-endx)>>1)+1;
- 204 fy:=starty+((endy-starty)>>1)+1;
- 205 | 3:
- 206 fx:=startx+((endx-startx)>>1)+1;
- 207 fy:=starty+((endy-starty)>>1)-1;
- 208 END;
- 209 END;
- 210 x:=fx;
- 211 y:=fy;
- 212 RETURN TRUE;
- 213 END GetFillStart;
- ***** ^ not supported yet
- 214
- 215 PROCEDURE SetFillStart(quadrant: ArcQuadrant);
- 216
- 217 VAR
- 218 q: INTEGER;
- 219
- 220 BEGIN
- 221 q:=0;
- 222 CoreGraph._fstart.flag:=1;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 223 WHILE q < 4 DO
- 224 CASE quadrant[q] OF
- ***** ^ not supported yet
- ***** ^ not supported yet
- 225 | _Q_CLEAR:
- ***** ^ not supported yet
- 226 CoreGraph._fstart.best_quad:=q;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 227 CoreGraph._fstart.quad_type:=_Q_CLEAR;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 228 RETURN;
- 229 | _Q_1SEG:
- ***** ^ not supported yet
- 230 CoreGraph._fstart.best_quad:=q;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 231 CoreGraph._fstart.quad_type:=_Q_1SEG;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 232 RETURN;
- 233 | _Q_STEST:
- ***** ^ not supported yet
- 234 CoreGraph._fstart.best_quad:=q;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 235 CoreGraph._fstart.quad_type:=_Q_STEST;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 236
- 237 END;
- 238 INC(q);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 239 END;
- 240 RETURN;
- 241 END SetFillStart;
- ***** ^ not supported yet
- 242
- 243
- 244 PROCEDURE ArcPlot(quadrant: INTEGER; flag: SHORTCARD; noclip: BOOLEAN; xp, yp, startx, endx, starty, endy: INTEGER);
- 245
- 246 VAR
- 247 ok_to_plot: BOOLEAN;
- 248 BEGIN
- 249 IF flag = SHORTCARD(_Q_NULL) THEN
- ***** ^ not supported yet
- 250 RETURN ;
- 251 END;
- 252 ok_to_plot:=FALSE;
- 253 IF((noclip) OR (((xp <= CoreGraph._clip_br.xcoord) AND (xp >= CoreGraph._clip_tl.xcoord))
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 254 AND((yp <= CoreGraph._clip_br.ycoord) AND (yp >= CoreGraph._clip_tl.ycoord)))) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 255 IF flag = SHORTCARD(_Q_CLEAR) THEN
- ***** ^ not supported yet
- 256 ok_to_plot:=TRUE;
- 257 ELSE
- 258 CASE quadrant OF
- 259 | 0:
- 260 CASE flag OF
- 261 | _Q_1SEG:
- ***** ^ not supported yet
- 262 IF((xp >= startx) AND (xp <= endx)
- 263 AND (yp <= starty) AND (yp >= endy)) THEN
- 264 ok_to_plot:=TRUE;
- 265 END;
- 266 | _Q_2SEG:
- ***** ^ not supported yet
- 267 IF(((xp >= startx) AND (yp <= starty))
- 268 OR ((xp <= endx) AND (yp >= endy))) THEN
- 269 ok_to_plot:=TRUE;
- 270 END;
- 271 | _Q_ETEST:
- ***** ^ not supported yet
- 272 IF((xp <= endx) AND (yp >= endy)) THEN
- 273 ok_to_plot:=TRUE;
- 274 END;
- 275 ELSE
- 276 IF((xp >= startx) AND (yp <= starty)) THEN
- 277 ok_to_plot:=TRUE;
- 278 END;
- 279 END;
- 280 | 3:
- 281 CASE flag OF
- 282 | _Q_1SEG:
- ***** ^ not supported yet
- 283 IF((xp >= startx) AND (xp <= endx)
- 284 AND (yp >= starty) AND (yp <= endy)) THEN
- 285 ok_to_plot:=TRUE;
- 286 END;
- 287 | _Q_2SEG:
- ***** ^ not supported yet
- 288 IF(((xp >= startx) AND (yp >= starty))
- 289 OR ((xp <= endx) AND (yp <= endy))) THEN
- 290 ok_to_plot:=TRUE;
- 291 END;
- 292 | _Q_ETEST:
- ***** ^ not supported yet
- 293 IF((xp <= endx) AND (yp <= endy)) THEN
- 294 ok_to_plot:=TRUE;
- 295 END;
- 296 ELSE
- 297 IF((xp >= startx) AND (yp >= starty)) THEN
- 298 ok_to_plot:=TRUE;
- 299 END;
- 300 END;
- 301 | 2:
- 302 CASE flag OF
- 303 | _Q_1SEG:
- ***** ^ not supported yet
- 304 IF((xp <= startx) AND (xp >= endx)
- 305 AND (yp >= starty) AND (yp <= endy)) THEN
- 306 ok_to_plot:=TRUE;
- 307 END;
- 308 | _Q_2SEG:
- ***** ^ not supported yet
- 309 IF(((xp <= startx) AND (yp >= starty))
- 310 OR ((xp >= endx) AND (yp <= endy))) THEN
- 311 ok_to_plot:=TRUE;
- 312 END;
- 313 | _Q_ETEST:
- ***** ^ not supported yet
- 314 IF((xp >= endx) AND (yp <= endy)) THEN
- 315 ok_to_plot:=TRUE;
- 316 END;
- 317 ELSE
- 318 IF((xp <= startx) AND (yp >= starty)) THEN
- 319 ok_to_plot:=TRUE;
- 320 END;
- 321 END;
- 322 ELSE (* quadrant := 1 *)
- 323 CASE flag OF
- 324 | _Q_1SEG:
- ***** ^ not supported yet
- 325 IF((xp <= startx) AND (xp >= endx)
- 326 AND (yp <= starty) AND (yp >= endy)) THEN
- 327 ok_to_plot:=TRUE;
- 328 END;
- 329 | _Q_2SEG:
- ***** ^ not supported yet
- 330 IF(((xp <= startx) AND (yp <= starty))
- 331 OR ((xp >= endx) AND (yp >= endy))) THEN
- 332 ok_to_plot:=TRUE;
- 333 END;
- 334 | _Q_ETEST:
- ***** ^ not supported yet
- 335 IF((xp >= endx) AND (yp >= endy)) THEN
- 336 ok_to_plot:=TRUE;
- 337 END;
- 338 ELSE
- 339 IF((xp <= startx) AND (yp <= starty)) THEN
- 340 ok_to_plot:=TRUE;
- 341 END;
- 342 END;
- 343 END;
- 344 END;
- 345 IF ok_to_plot THEN
- 346 CoreGraph._plot(xp, yp, CoreGraph._fgcolor);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 347 END;
- 348 END;
- 349 RETURN ;
- 350 END ArcPlot;
- ***** ^ not supported yet
- 351
- 352 PROCEDURE GetInRange(VAR a0, b0: INTEGER);
- 353
- 354 BEGIN
- 355 IF a0 > b0 THEN
- 356 IF a0 > 1023 THEN
- 357 b0 := INTEGER((LONGINT(b0)*1023) DIV LONGINT(a0));
- ***** ^ not supported yet
- ***** ^ not supported yet
- 358 a0 := 1023;
- 359 END;
- 360 ELSE
- 361 IF b0 > 1023 THEN
- 362 a0 := INTEGER((LONGINT(a0)*1023) DIV LONGINT(b0));
- ***** ^ not supported yet
- ***** ^ not supported yet
- 363 b0 := 1023;
- 364 END;
- 365 END;
- 366 END GetInRange;
- ***** ^ not supported yet
- 367
- 368 PROCEDURE DrawEllipse(x0, y0, a0, b0: INTEGER; Fill: BOOLEAN);
- 369
- 370 VAR
- 371 x, y, line, oldline: INTEGER;
- 372 a, b: LONGINT;
- 373 asq, asq2, bsq, bsq2: LONGINT;
- 374 d, dx, dy: LONGINT;
- 375 plotx, plotx2, ploty: INTEGER;
- 376 no_clip: BOOLEAN;
- 377 mask: CARDINAL;
- 378
- 379 BEGIN
- 380 GetInRange(a0, b0);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 381 no_clip:=FALSE;
- 382 x := 0 ;
- 383 y := b0 ;
- 384 a := LONGINT(a0);
- ***** ^ not supported yet
- 385 b := LONGINT(b0);
- ***** ^ not supported yet
- 386 asq := a*a ;
- 387 asq2 := asq*2 ;
- 388 bsq := b*b ;
- 389 bsq2 := bsq*2 ;
- 390 d := bsq-(asq*b)+(asq>>2) ;
- 391 dx := 0 ;
- 392 dy := asq2*b ;
- 393 oldline := -(y0+y+1);
- 394 IF ((x0+a0 <= CoreGraph._clip_br.xcoord) AND (x0-a0 >= CoreGraph._clip_tl.xcoord))
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 395 AND ((y0+b0 <= CoreGraph._clip_br.ycoord) AND (y0-b0 >= CoreGraph._clip_tl.ycoord)) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 396 no_clip:=TRUE;
- 397 END;
- 398 WHILE dx < dy DO
- 399 plotx:=x0+x;
- 400 ploty:=y0+y;
- 401 IF no_clip THEN
- 402 CoreGraph._plot(plotx, ploty, CoreGraph._fgcolor);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 403 ELSE
- 404 EllipsePlot(plotx, ploty);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 405 END;
- 406 plotx:=x0-x;
- 407 ploty:=y0+y;
- 408 IF no_clip THEN
- 409 CoreGraph._plot(plotx, ploty, CoreGraph._fgcolor);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 410 ELSE
- 411 EllipsePlot(plotx, ploty);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 412 END;
- 413 plotx:=x0+x;
- 414 ploty:=y0-y;
- 415 IF no_clip THEN
- 416 CoreGraph._plot(plotx, ploty, CoreGraph._fgcolor);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 417 ELSE
- 418 EllipsePlot(plotx, ploty);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 419 END;
- 420 plotx:=x0-x;
- 421 ploty:=y0-y;
- 422 IF no_clip THEN
- 423 CoreGraph._plot(plotx, ploty, CoreGraph._fgcolor);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 424 ELSE
- 425 EllipsePlot(plotx, ploty);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 426 END;
- 427 IF Fill = _GFILLINTERIOR THEN
- ***** ^ undeclared identifier
- 428 plotx:=x0-x+1;
- 429 plotx2:=x0+x-1;
- 430 IF plotx2 > plotx THEN
- 431 line:=y0+y;
- 432 IF line # oldline THEN
- 433 oldline := line;
- 434 mask:=CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(line) * BITSET(7))])
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 435 +CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(line) * BITSET(7))])*100H;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 436 IF mask = MAX(CARDINAL) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 437 CoreGraph._hline(plotx, line, plotx2, CoreGraph._fgcolor);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 438 ELSE
- 439 CoreGraph._line(plotx, line, plotx2, line, mask);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 440 END;
- 441 line:=y0-y;
- 442 mask:=CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(line) * BITSET(7))])
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 443 +CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(line) * BITSET(7))])*100H;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 444 IF mask = MAX(CARDINAL) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 445 CoreGraph._hline(plotx, line, plotx2, CoreGraph._fgcolor);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 446 ELSE
- 447 CoreGraph._line(plotx, line, plotx2, line, mask);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 448 END;
- 449 END;
- 450 END;
- 451 END;
- 452 IF d > 0 THEN
- 453 DEC(y);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 454 DEC(dy, asq2);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 455 DEC(d, dy);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 456 END;
- 457 INC(x);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 458 INC(dx, bsq2);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 459 INC(d, bsq+dx);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 460 END;
- 461 INC(d, (3*((asq-bsq)>>1)-((dx+dy)>>1)));
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 462 WHILE y >= 0 DO
- 463 plotx:=x0+x;
- 464 ploty:=y0+y;
- 465 IF no_clip THEN
- 466 CoreGraph._plot(plotx, ploty, CoreGraph._fgcolor);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 467 ELSE
- 468 EllipsePlot(plotx, ploty);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 469 END;
- 470 plotx:=x0-x;
- 471 ploty:=y0+y;
- 472 IF no_clip THEN
- 473 CoreGraph._plot(plotx, ploty, CoreGraph._fgcolor);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 474 ELSE
- 475 EllipsePlot(plotx, ploty);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 476 END;
- 477 plotx:=x0+x;
- 478 ploty:=y0-y;
- 479 IF no_clip THEN
- 480 CoreGraph._plot(plotx, ploty, CoreGraph._fgcolor);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 481 ELSE
- 482 EllipsePlot(plotx, ploty);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 483 END;
- 484 plotx:=x0-x;
- 485 ploty:=y0-y;
- 486 IF no_clip THEN
- 487 CoreGraph._plot(plotx, ploty, CoreGraph._fgcolor);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 488 ELSE
- 489 EllipsePlot(plotx, ploty);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 490 END;
- 491 IF Fill = _GFILLINTERIOR THEN
- ***** ^ undeclared identifier
- 492 plotx:=x0-x+1;
- 493 plotx2:=x0+x-1;
- 494 IF plotx2 > plotx THEN
- 495 line:=y0+y;
- 496 IF line # oldline THEN
- 497 oldline := line;
- 498 mask:=CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(line) * BITSET(7))])
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 499 +CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(line) * BITSET(7))])*100H;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 500 IF mask = MAX(CARDINAL) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 501 CoreGraph._hline(plotx, line, plotx2, CoreGraph._fgcolor);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 502 ELSE
- 503 CoreGraph._line(plotx, line, plotx2, line, mask);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 504 END;
- 505 line:=y0-y;
- 506 mask:=CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(line) * BITSET(7))])
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 507 +CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(line) * BITSET(7))])*100H;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 508 IF mask = MAX(CARDINAL) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 509 CoreGraph._hline(plotx, line, plotx2, CoreGraph._fgcolor);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 510 ELSE
- 511 CoreGraph._line(plotx, line, plotx2, line, mask);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 512 END;
- 513 END;
- 514 END;
- 515 END;
- 516 IF d < 0 THEN
- 517 INC(x);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 518 INC(dx, bsq2);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 519 INC(d, dx);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 520 END;
- 521 DEC(y);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 522 DEC(dy, asq2);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 523 INC(d, asq-dy);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 524 END;
- 525 RETURN;
- 526 END DrawEllipse;
- ***** ^ not supported yet
- 527
- 528 PROCEDURE GetArc(VAR quadrant: ArcQuadrant; x, y, sx, sy, ex, ey: INTEGER): BOOLEAN;
- 529
- 530 BEGIN
- 531 IF ((sx = ex) AND (sy = ey)) THEN
- 532 RETURN TRUE;
- 533 END;
- 534 DEC(sx, x);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 535 DEC(ex, x);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 536 DEC(sy, y);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 537 DEC(ey, y);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 538 IF((sx > 0) AND (sy > 0)) THEN (* start in quad 0 *)
- 539 quadrant[0]:=SHORTCARD(_Q_STEST);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 540 IF((ey <= 0) AND (ex > 0)) THEN
- 541 quadrant[1]:=SHORTCARD(_Q_ETEST);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 542 quadrant[2]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 543 quadrant[3]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 544 ELSIF((ey <= 0) AND (ex <= 0)) THEN
- 545 quadrant[1]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 546 quadrant[2]:=SHORTCARD(_Q_ETEST);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 547 quadrant[3]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 548 ELSIF((ey > 0) AND (ex <= 0)) THEN
- 549 quadrant[1]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 550 quadrant[2]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 551 quadrant[3]:=SHORTCARD(_Q_ETEST);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 552 ELSIF((ey > 0) AND (ex > 0)) THEN
- 553 IF(sx < ex) THEN
- 554 quadrant[0]:=SHORTCARD(_Q_1SEG);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 555 quadrant[1]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 556 quadrant[2]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 557 quadrant[3]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 558 ELSE
- 559 quadrant[0]:=SHORTCARD(_Q_2SEG);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 560 quadrant[1]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 561 quadrant[2]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 562 quadrant[3]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 563 END;
- 564 ELSE
- 565 RETURN FALSE;
- 566 END;
- 567 ELSIF((sx > 0) AND (sy <= 0)) THEN (* start in quad 1 *)
- 568 quadrant[1]:=_Q_STEST;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 569 IF((ey <= 0) AND (ex <= 0)) THEN
- 570 quadrant[2]:=SHORTCARD(_Q_ETEST);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 571 quadrant[3]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 572 quadrant[0]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 573 ELSIF((ey > 0) AND (ex <= 0)) THEN
- 574 quadrant[2]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 575 quadrant[3]:=SHORTCARD(_Q_ETEST);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 576 quadrant[0]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 577 ELSIF((ey > 0) AND (ex > 0)) THEN
- 578 quadrant[2]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 579 quadrant[3]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 580 quadrant[0]:=SHORTCARD(_Q_ETEST);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 581 ELSIF((ey <= 0) AND (ex > 0)) THEN
- 582 IF(sx >= ex) THEN
- 583 quadrant[1]:=SHORTCARD(_Q_1SEG);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 584 quadrant[2]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 585 quadrant[3]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 586 quadrant[0]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 587 ELSE
- 588 quadrant[1]:=SHORTCARD(_Q_2SEG);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 589 quadrant[2]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 590 quadrant[3]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 591 quadrant[0]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 592 END;
- 593 ELSE
- 594 RETURN FALSE;
- 595 END;
- 596 ELSIF((sx <= 0) AND (sy <= 0)) THEN (* start in quad 2 *)
- 597 quadrant[2]:=SHORTCARD(_Q_STEST);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 598 IF((ey > 0) AND (ex <= 0)) THEN
- 599 quadrant[3]:=SHORTCARD(_Q_ETEST);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 600 quadrant[0]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 601 quadrant[1]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 602 ELSIF((ey > 0) AND (ex > 0)) THEN
- 603 quadrant[3]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 604 quadrant[0]:=SHORTCARD(_Q_ETEST);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 605 quadrant[1]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 606 ELSIF((ey <= 0) AND (ex > 0)) THEN
- 607 quadrant[3]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 608 quadrant[0]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 609 quadrant[1]:=SHORTCARD(_Q_ETEST);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 610 ELSIF((ey <= 0) AND (ex <= 0)) THEN
- 611 IF(sx >= ex) THEN
- 612 quadrant[2]:=SHORTCARD(_Q_1SEG);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 613 quadrant[3]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 614 quadrant[0]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 615 quadrant[1]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 616 ELSE
- 617 quadrant[2]:=SHORTCARD(_Q_2SEG);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 618 quadrant[3]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 619 quadrant[0]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 620 quadrant[1]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 621 END;
- 622 ELSE
- 623 RETURN FALSE;
- 624 END;
- 625 ELSIF((sx <= 0) AND (sy > 0)) THEN (* start in quad 3 *)
- 626 quadrant[3]:=SHORTCARD(_Q_STEST);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 627 IF((ey > 0) AND (ex > 0)) THEN
- 628 quadrant[0]:=SHORTCARD(_Q_ETEST);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 629 quadrant[1]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 630 quadrant[2]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 631 ELSIF((ey <= 0) AND (ex > 0)) THEN
- 632 quadrant[0]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 633 quadrant[1]:=SHORTCARD(_Q_ETEST);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 634 quadrant[2]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 635 ELSIF((ey <= 0) AND (ex <= 0)) THEN
- 636 quadrant[0]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 637 quadrant[1]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 638 quadrant[2]:=SHORTCARD(_Q_ETEST);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 639 ELSIF((ey > 0) AND (ex <= 0)) THEN
- 640 IF(sx < ex) THEN
- 641 quadrant[3]:=SHORTCARD(_Q_1SEG);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 642 quadrant[0]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 643 quadrant[1]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 644 quadrant[2]:=SHORTCARD(_Q_NULL);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 645 ELSE
- 646 quadrant[3]:=SHORTCARD(_Q_2SEG);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 647 quadrant[0]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 648 quadrant[1]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 649 quadrant[2]:=SHORTCARD(_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 650 END;
- 651 ELSE
- 652 RETURN FALSE;
- 653 END;
- 654 ELSE
- 655 RETURN FALSE;
- 656 END;
- 657 RETURN TRUE;
- 658 END GetArc;
- ***** ^ not supported yet
- 659
- 660
- 661 PROCEDURE DrawArc(x0, y0, a0, b0, startx, starty, endx, endy: INTEGER): BOOLEAN;
- 662
- 663 VAR
- 664 x, y: INTEGER;
- 665 xp, yp: INTEGER;
- 666 a, b: LONGINT;
- 667 asq, asq2, bsq, bsq2: LONGINT;
- 668 d, dx, dy: LONGINT;
- 669 quadrant: ArcQuadrant;
- ***** ^ not supported yet
- 670 no_clip: BOOLEAN;
- 671 BEGIN
- 672 GetInRange(a0, b0);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 673 no_clip:=FALSE;
- 674 quadrant:=ArcQuadrant(_Q_CLEAR,_Q_CLEAR,_Q_CLEAR,_Q_CLEAR);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 675 CoreGraph._fstart.flag:=0;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 676 x := 0 ;
- 677 y := b0 ;
- 678 a := LONGINT(a0);
- ***** ^ not supported yet
- 679 b := LONGINT(b0);
- ***** ^ not supported yet
- 680 asq := a*a ;
- 681 asq2 := asq*2 ;
- 682 bsq := b*b ;
- 683 bsq2 := bsq*2 ;
- 684 d := bsq-(asq*b)+(asq>>2) ;
- 685 dx := 0 ;
- 686 dy := asq2*b ;
- 687 IF ~GetArc(quadrant, x0, y0, startx, starty, endx, endy) THEN
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 688 RETURN FALSE;
- 689 END;
- 690 SetFillStart(quadrant);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 691 IF(((x0+a0 <= CoreGraph._clip_br.xcoord) AND (x0-a0 >= CoreGraph._clip_tl.xcoord))
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 692 AND((y0+b0 <= CoreGraph._clip_br.ycoord) AND (y0-b0 >= CoreGraph._clip_tl.ycoord))) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 693 no_clip:=TRUE;
- 694 END;
- 695 WHILE dx < dy DO
- 696 xp:=x0+x;
- 697 yp:=y0+y;
- 698 ArcPlot(0, quadrant[0], no_clip, xp, yp, startx, endx, starty, endy);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 699 xp:=x0-x;
- 700 yp:=y0+y;
- 701 ArcPlot(3, quadrant[3], no_clip, xp, yp, startx, endx, starty, endy);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 702 xp:=x0+x;
- 703 yp:=y0-y;
- 704 ArcPlot(1, quadrant[1], no_clip, xp, yp, startx, endx, starty, endy);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 705 xp:=x0-x;
- 706 yp:=y0-y;
- 707 ArcPlot(2, quadrant[2], no_clip, xp, yp, startx, endx, starty, endy);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 708 IF d > 0 THEN
- 709 DEC(y);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 710 DEC(dy, asq2);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 711 DEC(d, dy);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 712 END;
- 713 INC(x);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 714 INC(dx, bsq2);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 715 INC(d, bsq+dx);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 716 END;
- 717 INC(d, (3*((asq-bsq)>>1)-((dx+dy)>>1)));
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 718 WHILE y >= 0 DO
- 719 xp:=x0+x;
- 720 yp:=y0+y;
- 721 ArcPlot(0, quadrant[0], no_clip, xp, yp, startx, endx, starty, endy);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 722 xp:=x0-x;
- 723 yp:=y0+y;
- 724 ArcPlot(3, quadrant[3], no_clip, xp, yp, startx, endx, starty, endy);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 725 xp:=x0+x;
- 726 yp:=y0-y;
- 727 ArcPlot(1, quadrant[1], no_clip, xp, yp, startx, endx, starty, endy);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 728 xp:=x0-x;
- 729 yp:=y0-y;
- 730 ArcPlot(2, quadrant[2], no_clip, xp, yp, startx, endx, starty, endy);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 731 IF d<0 THEN
- 732 INC(x);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 733 INC(dx, bsq2);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 734 INC(d, dx);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 735 END;
- 736 DEC(y);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 737 DEC(dy, asq2);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 738 INC(d, asq-dy);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 739 END;
- 740 RETURN TRUE;
- 741 END DrawArc;
- ***** ^ not supported yet
- 742
- 743
- 744 PROCEDURE GetVec(x0, y0, a0, b0, vx, vy: INTEGER): InterSect;
- 745
- 746 VAR
- 747 x, y: INTEGER;
- 748 a, b: LONGINT;
- 749 asq, asq2, bsq, bsq2: LONGINT;
- 750 d, dx, dy: LONGINT;
- 751 px, py, qx, qy: INTEGER;
- 752 Ret: InterSect;
- ***** ^ not supported yet
- 753 flag: INTEGER;
- 754 last_difference: LONGCARD;
- ***** ^ undeclared identifier
- 755 res: LONGINT;
- 756
- 757 BEGIN
- 758 Ret:=InterSect(0,0);
- ***** ^ not supported yet
- ***** ^ not supported yet
- 759 x := 0 ;
- 760 y := b0 ;
- 761 a := LONGINT(a0);
- ***** ^ not supported yet
- 762 b := LONGINT(b0);
- ***** ^ not supported yet
- 763 qx:=vx-x0;
- 764 qy:=vy-y0;
- 765 asq := a*a ;
- 766 asq2 := asq*2 ;
- 767 bsq := b*b ;
- 768 bsq2 := bsq*2 ;
- 769 d := bsq-(asq*b)+(asq>>2) ;
- 770 dx := 0 ;
- 771 dy := asq2*b ;
- 772 last_difference:=MAX(LONGCARD);
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 773 WHILE dx < dy DO
- 774 IF((qx >= 0) AND (qy >= 0)) THEN
- 775 px:=x0+x;
- 776 py:=y0+y;
- 777 flag:=0;
- 778 ELSIF((qx < 0) AND (qy >= 0)) THEN
- 779 px:=x0-x;
- 780 py:=y0+y;
- 781 flag:=1;
- 782 ELSIF((qx >= 0) AND (qy < 0)) THEN
- 783 px:=x0+x;
- 784 py:=y0-y;
- 785 flag:=2;
- 786 ELSIF((qx < 0) AND (qy < 0)) THEN
- 787 px:=x0-x;
- 788 py:=y0-y;
- 789 flag:=3;
- 790 END;
- 791 res:=(LONGINT(px-x0)*LONGINT(qy)) - (LONGINT(py-y0)*LONGINT(qx));
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 792 IF res < 0 THEN
- 793 res:=-res;
- 794 END;
- 795 IF LONGCARD(res) > last_difference THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 796 RETURN Ret;
- ***** ^ not supported yet
- 797 END;
- 798 last_difference:=res;
- ***** ^ not supported yet
- 799 Ret.x:=px;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 800 Ret.y:=py;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 801 IF d > 0 THEN
- 802 DEC(y);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 803 DEC(dy, asq2);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 804 DEC(d, dy);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 805 END;
- 806 INC(x);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 807 INC(dx, bsq2);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 808 INC(d, bsq+dx);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 809 END;
- 810 INC(d, (3*((asq-bsq)>>1)-((dx+dy)>>1)));
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 811 last_difference:=MAX(LONGCARD);
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ undeclared identifier
- 812 WHILE y >0 DO
- 813 IF flag = 0 THEN
- 814 px:=x0+x;
- 815 py:=y0+y;
- 816 ELSIF flag = 1 THEN
- 817 px:=x0-x;
- 818 py:=y0+y;
- 819 ELSIF flag = 2 THEN
- 820 px:=x0+x;
- 821 py:=y0-y;
- 822 ELSIF flag = 3 THEN
- 823 px:=x0-x;
- 824 py:=y0-y;
- 825 END;
- 826 res:=LONGINT(px-x0)*LONGINT(qy) - LONGINT(py-y0)*LONGINT(qx);
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- ***** ^ not supported yet
- 827 IF res < 0 THEN
- 828 res:=-res;
- 829 END;
- 830 IF LONGCARD(res) > last_difference THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 831 RETURN Ret;
- ***** ^ not supported yet
- 832 END;
- 833 last_difference:=res;
- ***** ^ not supported yet
- 834 Ret.x:=px;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 835 Ret.y:=py;
- ***** ^ not supported yet
- ***** ^ not supported yet
- 836 IF d < 0 THEN
- 837 INC(x);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 838 INC(dx, bsq2);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 839 INC(d, dx);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 840 END;
- 841 DEC(y);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 842 DEC(dy, asq2);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 843 INC(d, asq-dy);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 844 END;
- 845 RETURN Ret;
- ***** ^ not supported yet
- 846 END GetVec;
- ***** ^ not supported yet
- 847
- 848
- 849 PROCEDURE HscanLine(VAR xlp, xrp: INTEGER; y, border: INTEGER);
- 850
- 851 VAR
- 852 mask: CARDINAL;
- 853 BEGIN
- 854 CoreGraph._hscan(xlp, xrp, y, border);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 855 mask:=CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(y)*BITSET(7))])
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 856 +CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(y)*BITSET(7))])*100H;
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 857 IF mask = MAX(CARDINAL) THEN
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 858 CoreGraph._hline(xlp, y, xrp, CoreGraph._fgcolor);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- 859 ELSE
- 860 CoreGraph._line(xlp, y, xrp, y, mask);
- ***** ^ undeclared identifier
- ***** ^ not supported yet
- ***** ^ not supported yet
- 861 END;
- 862 END HscanLine;
- ***** ^ not supported yet
- 863
- 864
- 865 PROCEDURE LagFill(xl, xr, y, direction, llim, rlim, border: INTEGER);
- 866
- 867 LABEL
- 868 ReStart;
- ***** ^ not supported yet
- 869 VAR
- 870 x, xsl, v: INTEGER;
- 871 mask: CARDINAL;
- 872 BEGIN
- 873 ReStart:
- ***** ^ undeclared identifier
- 874 DEC(y, direction);
- 875 IF (CoreGraph._clip_tl.ycoord <= y) AND (y <= CoreGraph._clip_br.ycoord) THEN
- 876 mask:=CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(y)*BITSET(7))]);
- 877 x:=xl;
- 878 WHILE x <= llim-1 DO
- 879 IF (BITSET(1<<(CARDINAL(BITSET(x)*BITSET(7)))) * BITSET(mask) # {}) THEN
- 880 v:=CoreGraph._point(x, y);
- 881 IF((v # border) AND (v # CoreGraph._fgcolor)) THEN
- 882 xsl := x;
- 883 HscanLine (xsl, x, y, border);
- 884 LagFill(xsl, x, y, -direction, xl, xr, border);
- 885 END;
- 886 END;
- 887 INC(x);
- 888 END;
- 889 x:=rlim+1;
- 890 WHILE x <= xr DO
- 891 IF (BITSET(1<<(CARDINAL(BITSET(x)*BITSET(7)))) * BITSET(mask) # {}) THEN
- 892 v:=CoreGraph._point(x, y);
- 893 IF((v # border) AND (v # CoreGraph._fgcolor)) THEN
- 894 xsl := x;
- 895 HscanLine(xsl, x, y, border);
- 896 LagFill(xsl, x, y, -direction, xl, xr, border);
- 897 END;
- 898 END;
- 899 INC(x);
- 900 END;
- 901 END;
- 902 INC(y, direction + direction);
- 903 IF ( y >= CoreGraph._clip_tl.ycoord) AND (y <= CoreGraph._clip_br.ycoord ) THEN
- 904 mask:=CARDINAL(CoreGraph._fill_mask[CARDINAL(BITSET(y)*BITSET(7))]);
- 905 x:=xl;
- 906 WHILE x <= xr DO
- 907 IF (BITSET(1<<(CARDINAL(BITSET(x)*BITSET(7)))) * BITSET(mask) # {}) THEN
- 908 v:=CoreGraph._point(x, y);
- 909 IF((v # CoreGraph._fgcolor) AND (v # border)) THEN
- 910 xsl := x;
- 911 HscanLine (xsl, x, y, border);
- 912 IF(x > xr-1) THEN
- 913 (* Do last one iteratively... *)
- 914 llim := xl;
- 915 rlim := xr;
- 916 xl := xsl;
- 917 xr := x;
- 918 GOTO ReStart;
- 919 ELSE
- 920 LagFill(xsl, x, y, direction, xl, xr, border);
- 921 END;
- 922 END;
- 923 END;
- 924 INC(x);
- 925 END;
- 926 END;
- 927 RETURN;
- 928 END LagFill;
- 929 (*# restore *)
- 930 (*****************************************************************************)
- 931 (* Function definitions - CGA specIFic *)
- 932 (*****************************************************************************)
- 933
- 934 (*# save *)
- 935 (*# call(reg_param => (ax,bx,cx,dx,st0,st6,st5,st4,st3), reg_saved=>(ds, di, si,st1,st2), c_conv=>off) *)
- 936
- 937
- 938 PROCEDURE _CGA320Plot(x, y, c: INTEGER);
- 939
- 940 VAR
- 941 ptr: CGAPointer;
- 942 ofs: CARDINAL;
- 943 BEGIN
- 944 ofs:=(CARDINAL(x)>>2)+((2000H-40)* CARDINAL( BITSET(y)*BITSET(1) ) )+ (40*CARDINAL(y));
- 945 ptr := [SEL_B800H:ofs];
- 946 x := 3 - INTEGER(BITSET(x)*BITSET(3));
- 947 x := x << 1;
- 948 ptr^ := SHORTCARD((BITSET(ptr^) - BITSET(3<<x)) + BITSET(c<<x));
- 949 RETURN;
- 950 END _CGA320Plot;
- 951
- 952 PROCEDURE _CGA640Plot(x, y, c: INTEGER);
- 953
- 954 VAR
- 955 ptr: CGAPointer;
- 956 ofs: CARDINAL;
- 957 mask: CARDINAL;
- 958 BEGIN
- 959 ofs:=(CARDINAL(x)>>3)+((2000H-40)* CARDINAL( BITSET(y)*BITSET(1) ) )+ (40*CARDINAL(y));
- 960 ptr := [SEL_B800H:ofs];
- 961 x:= INTEGER(BITSET(x) * BITSET(7));
- 962 mask:=80H>>x;
- 963 IF(c # 0) THEN
- 964 c:=mask;
- 965 END;
- 966 ptr^ := SHORTCARD((BITSET(ptr^) - BITSET(mask)) + BITSET(c));
- 967 RETURN;
- 968 END _CGA640Plot;
- 969
- 970 PROCEDURE _CGA320Point(x, y: INTEGER): INTEGER;
- 971
- 972 VAR
- 973 ptr: CGAPointer;
- 974 ofs: CARDINAL;
- 975 BEGIN
- 976 ofs:=(CARDINAL(x)>>2)+((2000H-40)* CARDINAL( BITSET(y)*BITSET(1) ) )+ (40*CARDINAL(y));
- 977 ptr := [SEL_B800H:ofs];
- 978 x := 3 - INTEGER(BITSET(x)*BITSET(3));
- 979 x := (x<<1);
- 980 RETURN( CARDINAL(BITSET(ptr^) * BITSET(3<<x)) >> CARDINAL(x));
- 981 END _CGA320Point;
- 982
- 983 PROCEDURE _CGA640Point(x, y: INTEGER): INTEGER;
- 984
- 985 VAR
- 986 c: SHORTCARD;
- 987 ptr: CGAPointer;
- 988 ofs: CARDINAL;
- 989 BEGIN
- 990 ofs:=(CARDINAL(x)>>3)+((2000H-40)* CARDINAL( BITSET(y)*BITSET(1) ) )+ (40*CARDINAL(y));
- 991 ptr := [SEL_B800H:ofs];
- 992 x:=INTEGER(BITSET(x) * BITSET(7));
- 993 c:=SHORTCARD(80H>>x);
- 994 IF(BITSET(ptr^)* BITSET(c) # {}) THEN
- 995 RETURN 1;
- 996 END;
- 997 RETURN 0;
- 998 END _CGA640Point;
- 999
- 1000 PROCEDURE _CGA320HScan(VAR xl, xr: INTEGER; y, border: INTEGER);
- 1001
- 1002 VAR
- 1003 row, left, right: INTEGER;
- 1004 BEGIN
- 1005 left:=xl;
- 1006 right:=xr;
- 1007 row:=((2000H-40)*INTEGER(BITSET(y) * BITSET(1)))+(40*y);
- 1008 xl:=CoreGraph._CGA320leftscan((left>>2)+row, border, CoreGraph._clip_tl.xcoord, left);
- 1009 xr:=CoreGraph._CGA320rightscan((right>>2)+row, border, CoreGraph._clip_br.xcoord, right);
- 1010 END _CGA320HScan;
- 1011
- 1012 PROCEDURE _CGA640HScan(VAR xl, xr: INTEGER; y, border: INTEGER);
- 1013
- 1014 VAR
- 1015 row, left, right: INTEGER;
- 1016 BEGIN
- 1017 left:=xl;
- 1018 right:=xr;
- 1019 IF border # 0 THEN
- 1020 border:=1;
- 1021 END;
- 1022 row:=((2000H-40)*INTEGER(BITSET(y)*BITSET(1)))+(40*y);
- 1023 xl:=CoreGraph._CGA640leftscan((left>>3)+row, border, CoreGraph._clip_tl.xcoord, left);
- 1024 xr:=CoreGraph._CGA640rightscan((right>>3)+row, border, CoreGraph._clip_br.xcoord, right);
- 1025 END _CGA640HScan;
- 1026
- 1027 (*****************************************************************************)
- 1028 (* Function definitions - VGA 256 color specIFic. *)
- 1029 (*****************************************************************************)
- 1030
- 1031
- 1032 PROCEDURE _VGAPlot(x, y, c: INTEGER);
- 1033
- 1034 VAR
- 1035 ptr: VGAPointer;
- 1036 BEGIN
- 1037 ptr := [SEL_A000H:y*(VGA256Width)+x];
- 1038 ptr^:= SHORTCARD(c);
- 1039 END _VGAPlot;
- 1040
- 1041 PROCEDURE _VGAHScan(VAR xl, xr: INTEGER; y, border: INTEGER);
- 1042
- 1043 VAR
- 1044 left, right: INTEGER;
- 1045 ptr: CARDINAL;
- 1046 BEGIN
- 1047 left:=xl;
- 1048 right:=xr;
- 1049 y:=y*(VGA256Width);
- 1050 ptr:=y+left;
- 1051 xl:=CoreGraph._VGAleftscan(ptr, border, CoreGraph._clip_tl.xcoord, left);
- 1052 ptr:=y+right;
- 1053 xr:=CoreGraph._VGArightscan(ptr, border, CoreGraph._clip_br.xcoord, right);
- 1054 RETURN;
- 1055 END _VGAHScan;
- 1056
- 1057 (*****************************************************************************)
- 1058 (* Function definitions - VGA and EGA native mode specIFic. *)
- 1059 (*****************************************************************************)
- 1060
- 1061 PROCEDURE EGAHScan(VAR xl, xr: INTEGER; y, border: INTEGER);
- 1062 VAR
- 1063 left,right : INTEGER;
- 1064 p,pp : CARDINAL;
- 1065 ptr : FarADDRESS;
- 1066 BEGIN
- 1067 IF CoreGraph._EGAtranslate # 0 THEN
- 1068 border:=CoreGraph._EGAxlat(border);
- 1069 END; (*IF*)
- 1070 left := xl;
- 1071 right := xr;
- 1072 pp := (CARDINAL(y) * CoreGraph._width) + (CoreGraph._active_page*CoreGraph._page_size) << 4;
- 1073 p := CARDINAL(left>>3) + pp;
- 1074 ptr := [SEL_A000H:p];
- 1075 xl := CoreGraph._EGAleftscan(ptr, border, CoreGraph._clip_tl.xcoord, left);
- 1076 p := CARDINAL(right>>3) + pp;
- 1077 ptr := [SEL_A000H:p];
- 1078 xr := CoreGraph._EGArightscan(ptr, border, CoreGraph._clip_br.xcoord, right);
- 1079 END EGAHScan;
- 1080
- 1081 PROCEDURE GenericHScan(VAR xl, xr: INTEGER; y, border: INTEGER);
- 1082
- 1083 VAR
- 1084 v, left, right: INTEGER;
- 1085 BEGIN
- 1086 left:=xl;
- 1087 right:=xr;
- 1088 REPEAT
- 1089 DEC(left);
- 1090 v:=CoreGraph._point(left, y);
- 1091 UNTIL (v = border) OR (v = CoreGraph._fgcolor) OR (left < CoreGraph._clip_tl.xcoord);
- 1092 INC(left);
- 1093 REPEAT
- 1094 INC(right);
- 1095 v:=CoreGraph._point(right, y);
- 1096 UNTIL (v = border) OR (v = CoreGraph._fgcolor) OR (right > CoreGraph._clip_br.xcoord);
- 1097 DEC(right);
- 1098 xl:=left;
- 1099 xr:=right;
- 1100 END GenericHScan;
- 1101
- 1102 (*****************************************************************************)
- 1103 (* Function definitions - Hercules specIFic. *)
- 1104 (*****************************************************************************)
- 1105
- 1106 PROCEDURE HercPlot(x,y,c: INTEGER);
- 1107
- 1108 VAR
- 1109 Byte: bs;
- 1110 BEGIN
- 1111 IF (x > HercWidth) OR (y > HercDepth) THEN
- 1112 RETURN;
- 1113 END;
- 1114 Byte:=HercBitMap[CoreGraph._active_page][y MOD 4]^[y >> 2][x >> 3];
- 1115 IF c = 0 THEN
- 1116 Byte:=Byte - bs{(7-(CARDINAL(x) MOD 8))};
- 1117 ELSE
- 1118 Byte:=Byte + bs{(7-(CARDINAL(x) MOD 8))};
- 1119 END;
- 1120 HercBitMap[CoreGraph._active_page][y MOD 4]^[y >> 2][x >> 3]:=Byte;
- 1121 END HercPlot;
- 1122
- 1123 PROCEDURE HercPoint(x,y: INTEGER) : INTEGER;
- 1124 BEGIN
- 1125 IF (x > HercWidth) OR (y > HercDepth) THEN RETURN MAX(CARDINAL); END;
- 1126 IF bs{7-(CARDINAL(x) MOD 8)} * HercBitMap[CoreGraph._active_page][y MOD 4]^[y >> 2][x >> 3] # bs(0) THEN
- 1127 RETURN 1;
- 1128 ELSE
- 1129 RETURN 0;
- 1130 END;
- 1131 END HercPoint;
- 1132
- 1133 (*# restore *)
- 1134
- 1135 PROCEDURE HercGraphMode;
- 1136 TYPE
- 1137 DataType = ARRAY[0..11] OF SHORTCARD ;
- 1138 CONST
- 1139 Data = DataType(35H,2DH,2EH,07H,5BH,02H,57H,57H,02H,03H,00H,00H);
- 1140 VAR
- 1141 I: CARDINAL;
- 1142 BEGIN
- 1143 SYSTEM.Out(3BFH,03H); (* Remove this if do NOT want to override
- 1144 the hercules text mode lock *)
- 1145 Lib.Delay(10);
- 1146 SYSTEM.Out(3B8H,02H);
- 1147 FOR I:= 0 TO 11 DO
- 1148 SYSTEM.Out(3B4H,SHORTCARD(I));
- 1149 SYSTEM.Out(3B5H,Data[I])
- 1150 END;
- 1151 Lib.FarWordFill([SEL_B000H:0],4000H,0);
- 1152 Lib.Delay(500);
- 1153 SYSTEM.Out(3B8H,0AH)
- 1154 END HercGraphMode;
- 1155
- 1156 PROCEDURE HercTextMode;
- 1157 TYPE
- 1158 DataType = ARRAY[0..11] OF SHORTCARD ;
- 1159 CONST
- 1160 Data = DataType(61H,50H,52H,0FH,19H,06H,19H,19H,02H,0DH,0BH,0CH);
- 1161 VAR
- 1162 I: CARDINAL;
- 1163 BEGIN
- 1164 SYSTEM.Out(3B8H,20H);
- 1165 FOR I:= 0 TO 11 DO
- 1166 SYSTEM.Out(3B4H,SHORTCARD(I));
- 1167 SYSTEM.Out(3B5H,Data[I])
- 1168 END;
- 1169 Lib.FarWordFill([SEL_B000H:0],2000,720H);
- 1170 Lib.Delay(500);
- 1171 SYSTEM.Out(3B8H,28H)
- 1172 END HercTextMode;
- 1173
- 1174
- 1175 PROCEDURE InternalInitCGA(mode: CARDINAL);
- 1176
- 1177 BEGIN
- 1178 IF((mode = 4) OR (mode = 5)) THEN
- 1179 CoreGraph._plot := _CGA320Plot;
- 1180 CoreGraph._point := _CGA320Point;
- 1181 CoreGraph._hline := CoreGraph._CGA320HLine;
- 1182 CoreGraph._line := CoreGraph._CGA320Line;
- 1183 CoreGraph._hscan := _CGA320HScan;
- 1184 CoreGraph._put := CoreGraph._CGA320Put;
- 1185 CoreGraph._get := CoreGraph._CGA320Get;
- 1186 CoreGraph._width := CGA320Width-1;
- 1187 ELSE
- 1188 CoreGraph._plot := _CGA640Plot ;
- 1189 CoreGraph._point := _CGA640Point ;
- 1190 CoreGraph._line := CoreGraph._CGA640Line ;
- 1191 CoreGraph._hline := CoreGraph._CGA640HLine ;
- 1192 CoreGraph._hscan := _CGA640HScan;
- 1193 CoreGraph._put := CoreGraph._CGA640Put;
- 1194 CoreGraph._get := CoreGraph._CGA640Get;
- 1195 CoreGraph._width := CGA640Width-1;
- 1196 END;
- 1197 CoreGraph._depth:=CGADepth-1;
- 1198 END InternalInitCGA;
- 1199
- 1200 PROCEDURE InternalInitEGA(mode: CARDINAL);
- 1201
- 1202 BEGIN
- 1203 IF mode = 13 THEN
- 1204 CoreGraph._width := 40;
- 1205 CoreGraph._depth := EGA200Depth-1;
- 1206 ELSIF mode = 14 THEN
- 1207 CoreGraph._width := 80;
- 1208 CoreGraph._depth := EGA200Depth-1;
- 1209 ELSIF mode <= 16 THEN
- 1210 CoreGraph._width := 80;
- 1211 CoreGraph._depth := EGA350Depth-1;
- 1212 ELSIF mode <= 18 THEN
- 1213 CoreGraph._width := 80;
- 1214 CoreGraph._depth := EGA480Depth-1;
- 1215 END;
- 1216 CoreGraph._EGAtranslate:=0;
- 1217 IF mode = 15 THEN
- 1218 CoreGraph._EGAStartPlane:=2;
- 1219 CoreGraph._EGAPlaneShift:=2;
- 1220 CoreGraph._EGAtranslate:=1;
- 1221 ELSIF mode = 17 THEN
- 1222 CoreGraph._EGAStartPlane:=0;
- 1223 CoreGraph._EGAPlaneShift:=1;
- 1224 ELSE
- 1225 CoreGraph._EGAStartPlane:=3;
- 1226 CoreGraph._EGAPlaneShift:=1;
- 1227 END;
- 1228 IF((CoreGraph._EGA64K = TRUE) AND ((mode = _ERESCOLOR) OR (mode = _ERESNOCOLOR))) THEN
- 1229 CoreGraph._EGAStartPlane:=2;
- 1230 CoreGraph._EGAPlaneShift:=2;
- 1231 CoreGraph._EGAtranslate:=1;
- 1232 CoreGraph._hscan:= GenericHScan;
- 1233 ELSE
- 1234 CoreGraph._hscan:= EGAHScan;
- 1235 END;
- 1236 CoreGraph._put := CoreGraph._EGAPut;
- 1237 CoreGraph._get := CoreGraph._EGAGet;
- 1238 IF mode = _VRES2COLOR THEN
- 1239 CoreGraph._line := CoreGraph._EGA2Line;
- 1240 CoreGraph._plot := CoreGraph._EGA2Plot;
- 1241 CoreGraph._point := CoreGraph._EGA2Point;
- 1242 CoreGraph._hline := CoreGraph._EGA2HLine;
- 1243 ELSE
- 1244 CoreGraph._line := CoreGraph._EGALine;
- 1245 CoreGraph._plot := CoreGraph._EGAPlot;
- 1246 CoreGraph._point := CoreGraph._EGAPoint;
- 1247 CoreGraph._hline := CoreGraph._EGAHLine;
- 1248 END;
- 1249 (* _resetEGA();*)
- 1250 END InternalInitEGA;
- 1251
- 1252 PROCEDURE InternalInitVGA256();
- 1253
- 1254 BEGIN
- 1255 CoreGraph._width := VGA256Width;
- 1256 CoreGraph._depth := VGA256Depth-1;
- 1257 CoreGraph._plot := _VGAPlot;
- 1258 CoreGraph._point := CoreGraph._VGAPoint;
- 1259 CoreGraph._line := CoreGraph._VGALine;
- 1260 CoreGraph._hline := CoreGraph._VGAHLine;
- 1261 CoreGraph._hscan := _VGAHScan;
- 1262 CoreGraph._put := CoreGraph._VGAPut;
- 1263 CoreGraph._get := CoreGraph._VGAGet;
- 1264 END InternalInitVGA256;
- 1265
- 1266 PROCEDURE InternalInitHerc();
- 1267
- 1268 BEGIN
- 1269 CoreGraph._depth := HercDepth-1;
- 1270 CoreGraph._width := HercWidth-1;
- 1271 CoreGraph._plot := HercPlot ;
- 1272 CoreGraph._point := HercPoint ;
- 1273 CoreGraph._line := CoreGraph._HercLine ;
- 1274 CoreGraph._hline := CoreGraph._HercHLine ;
- 1275 CoreGraph._hscan := GenericHScan ;
- 1276 CoreGraph._put := CoreGraph._HercPut;
- 1277 CoreGraph._get := CoreGraph._HercGet;
- 1278 HercBitMap[0][0]:= [SEL_B000H:0]; (* Initialise BitMap pointers *)
- 1279 HercBitMap[0][1]:= [SEL_B000H:02000H];
- 1280 HercBitMap[0][2]:= [SEL_B000H:04000H];
- 1281 HercBitMap[0][3]:= [SEL_B000H:06000H];
- 1282 HercBitMap[1][0]:= [SEL_B800H:0]; (* 2nd Page *)
- 1283 HercBitMap[1][1]:= [SEL_B800H:02000H];
- 1284 HercBitMap[1][2]:= [SEL_B800H:04000H];
- 1285 HercBitMap[1][3]:= [SEL_B800H:06000H];
- 1286 END InternalInitHerc;
- 1287
- 1288 (*****************************************************************************)
- 1289 (* Function definitions - Misc low level and initialisation. *)
- 1290 (*****************************************************************************)
- 1291
- 1292 CONST
- 1293 MDA = 1;
- 1294 CGA = 2;
- 1295 EGA = 3;
- 1296 MCGA = 4;
- 1297 VGA = 5;
- 1298 HGC = 80H;
- 1299 HGCPlus= 81H;
- 1300 InColor= 82H;
- 1301
- 1302 MDADisplay = 1;
- 1303 CGADisplay = 2;
- 1304 EGAColorDisplay = 3;
- 1305 PS2MonoDisplay = 4;
- 1306 PS2ColorDisplay = 5;
- 1307
- 1308 (*# save *)
- 1309 (*# call(near_call=>on) *)
- 1310 PROCEDURE SetLimits(VAR v: CoreGraph.VideoConfig);
- 1311
- 1312 BEGIN
- 1313 CASE v.mode OF
- 1314 | 0:
- 1315 v.numxpixels := 0;
- 1316 v.numypixels := 0;
- 1317 v.numtextcols := 40;
- 1318 v.numtextrows := 25;
- 1319 v.numcolors := 32;
- 1320 v.bitsperpixel := 0;
- 1321 v.numvideopages := 8;
- 1322 CoreGraph._txcolor := 15;
- 1323 CoreGraph._scr_attr := 7;
- 1324 | 1:
- 1325 v.numxpixels := 0;
- 1326 v.numypixels := 0;
- 1327 v.numtextcols := 40;
- 1328 v.numtextrows := 25;
- 1329 v.numcolors := 32;
- 1330 v.bitsperpixel := 0;
- 1331 v.numvideopages := 8;
- 1332 CoreGraph._txcolor := 15;
- 1333 CoreGraph._scr_attr := 7;
- 1334 | 2:
- 1335 v.numxpixels := 0;
- 1336 v.numypixels := 0;
- 1337 v.numtextcols := 80;
- 1338 v.numtextrows := 25;
- 1339 v.numcolors := 32;
- 1340 v.bitsperpixel := 0;
- 1341 v.numvideopages := 4;
- 1342 CoreGraph._txcolor := 15;
- 1343 CoreGraph._scr_attr := 7;
- 1344 | 3:
- 1345 v.numxpixels := 0;
- 1346 v.numypixels := 0;
- 1347 v.numtextcols := 80;
- 1348 v.numtextrows := 25;
- 1349 v.numcolors := 32;
- 1350 v.bitsperpixel := 0;
- 1351 v.numvideopages := 4;
- 1352 CoreGraph._txcolor := 15;
- 1353 CoreGraph._scr_attr := 7;
- 1354 | 4:
- 1355 v.numxpixels := 320;
- 1356 v.numypixels := 200;
- 1357 v.numtextcols := 40;
- 1358 v.numtextrows := 25;
- 1359 v.numcolors := 4;
- 1360 v.bitsperpixel := 2;
- 1361 v.numvideopages := 1;
- 1362 CoreGraph._fgcolor := 3;
- 1363 CoreGraph._scr_attr := 0;
- 1364 | 5:
- 1365 v.numxpixels := 320;
- 1366 v.numypixels := 200;
- 1367 v.numtextcols := 40;
- 1368 v.numtextrows := 25;
- 1369 v.numcolors := 4;
- 1370 v.bitsperpixel := 2;
- 1371 v.numvideopages := 1;
- 1372 CoreGraph._page_size:= 0;
- 1373 CoreGraph._scr_attr := 0;
- 1374 CoreGraph._fgcolor := 3;
- 1375 | 6:
- 1376 v.numxpixels := 640;
- 1377 v.numypixels := 200;
- 1378 v.numtextcols := 80;
- 1379 v.numtextrows := 25;
- 1380 v.numcolors := 2;
- 1381 v.bitsperpixel := 1;
- 1382 v.numvideopages := 1;
- 1383 CoreGraph._page_size:= 0;
- 1384 CoreGraph._scr_attr := 0;
- 1385 CoreGraph._fgcolor := 1;
- 1386 | 7:
- 1387 v.numxpixels := 0;
- 1388 v.numypixels := 0;
- 1389 v.numtextcols := 80;
- 1390 v.numtextrows := 25;
- 1391 v.numcolors := 2;
- 1392 v.bitsperpixel := 0;
- 1393 v.numvideopages := 4;
- 1394 CoreGraph._txcolor := 1;
- 1395 CoreGraph._scr_attr := 7;
- 1396 | 8:
- 1397 v.numxpixels := 720;
- 1398 v.numypixels := 348;
- 1399 v.numtextcols := 80;
- 1400 v.numtextrows := 25;
- 1401 v.numcolors := 2;
- 1402 v.bitsperpixel := 1;
- 1403 v.numvideopages := 2;
- 1404 CoreGraph._page_size:= 800H;
- 1405 CoreGraph._fgcolor := 1;
- 1406 CoreGraph._scr_attr := 0;
- 1407 | 13:
- 1408 v.numxpixels := 320;
- 1409 v.numypixels := 200;
- 1410 v.numtextcols := 40;
- 1411 v.numtextrows := 25;
- 1412 v.numcolors := 16;
- 1413 v.bitsperpixel := 4;
- 1414 v.numvideopages := CoreGraph._current_video.memory DIV 32;
- 1415 CoreGraph._page_size:= 200H;
- 1416 CoreGraph._fgcolor := 15;
- 1417 CoreGraph._scr_attr := 0;
- 1418 | 14:
- 1419 v.numxpixels := 640;
- 1420 v.numypixels := 200;
- 1421 v.numtextcols := 80;
- 1422 v.numtextrows := 25;
- 1423 v.numcolors := 16;
- 1424 v.bitsperpixel := 4;
- 1425 v.numvideopages := CoreGraph._current_video.memory DIV 64;
- 1426 CoreGraph._page_size:= 400H;
- 1427 CoreGraph._fgcolor := 15;
- 1428 CoreGraph._scr_attr := 0;
- 1429 | 15:
- 1430 v.numxpixels := 640;
- 1431 v.numypixels := 350;
- 1432 v.numtextcols := 80;
- 1433 v.numtextrows := 25;
- 1434 v.numcolors := 4;
- 1435 v.bitsperpixel := 2;
- 1436 v.numvideopages := 2;
- 1437 CoreGraph._page_size:= 800H;
- 1438 CoreGraph._fgcolor := 3;
- 1439 CoreGraph._scr_attr := 0;
- 1440 | 16:
- 1441 v.numxpixels := 640;
- 1442 v.numypixels := 350;
- 1443 v.numtextcols := 80;
- 1444 v.numtextrows := 25;
- 1445 v.numcolors := 16;
- 1446 v.bitsperpixel := 4;
- 1447 v.numvideopages := 2;
- 1448 CoreGraph._page_size:= 800H;
- 1449 CoreGraph._fgcolor := 15;
- 1450 CoreGraph._scr_attr := 0;
- 1451 | 17:
- 1452 v.numxpixels := 640;
- 1453 v.numypixels := 480;
- 1454 v.numtextcols := 80;
- 1455 v.numtextrows := 30;
- 1456 v.numcolors := 2;
- 1457 v.bitsperpixel := 1;
- 1458 v.numvideopages := 1;
- 1459 CoreGraph._page_size:= 0;
- 1460 CoreGraph._fgcolor := 1;
- 1461 CoreGraph._scr_attr := 0;
- 1462 | 18:
- 1463 v.numxpixels := 640;
- 1464 v.numypixels := 480;
- 1465 v.numtextcols := 80;
- 1466 v.numtextrows := 30;
- 1467 v.numcolors := 16;
- 1468 v.bitsperpixel := 4;
- 1469 v.numvideopages := 1;
- 1470 CoreGraph._fgcolor := 15;
- 1471 CoreGraph._page_size:= 0;
- 1472 CoreGraph._scr_attr := 0;
- 1473 | 19:
- 1474 v.numxpixels := 320;
- 1475 v.numypixels := 200;
- 1476 v.numtextcols := 40;
- 1477 v.numtextrows := 25;
- 1478 v.numcolors := 256;
- 1479 v.bitsperpixel := 8;
- 1480 v.numvideopages := 1;
- 1481 CoreGraph._fgcolor := 255;
- 1482 CoreGraph._page_size:= 0;
- 1483 CoreGraph._scr_attr := 0;
- 1484 END;
- 1485 CoreGraph._clip_tl.xcoord :=0;
- 1486 CoreGraph._clip_tl.ycoord :=0;
- 1487 CoreGraph._clip_br.xcoord :=v.numxpixels-1;
- 1488 CoreGraph._clip_br.ycoord :=v.numypixels-1;
- 1489 CoreGraph._text_tl.row :=0;
- 1490 CoreGraph._text_tl.col :=0;
- 1491 CoreGraph._text_br.row :=v.numtextrows-1;
- 1492 CoreGraph._text_br.col :=v.numtextcols-1;
- 1493 END SetLimits;
- 1494
- 1495 PROCEDURE GEnter();
- 1496
- 1497 BEGIN
- 1498 IF CoreGraph._cursor_state = _GCURSORON THEN
- 1499 CoreGraph._gcur(0, CoreGraph._current_text.row, CoreGraph._current_text.col, CoreGraph._visual_page);
- 1500 INC(CoreGraph._cursor_lock);
- 1501 END;
- 1502 END GEnter;
- 1503
- 1504 PROCEDURE GExit();
- 1505
- 1506 BEGIN
- 1507 IF(CoreGraph._cursor_state = _GCURSORON) THEN
- 1508 DEC(CoreGraph._cursor_lock);
- 1509 IF (CoreGraph._cursor_lock = 0) THEN
- 1510 CoreGraph._gcur(CoreGraph._txcolor, CoreGraph._current_text.row, CoreGraph._current_text.col, CoreGraph._visual_page);
- 1511 END;
- 1512 END;
- 1513 END GExit;
- 1514
- 1515 PROCEDURE EGAcolXlat(Color: LONGCARD): INTEGER;
- 1516
- 1517 TYPE
- 1518 LongSet = SET OF [0..31];
- 1519 VAR
- 1520 ncol, blue, green, red: CARDINAL;
- 1521 BEGIN
- 1522 blue:= CARDINAL(LONGCARD(LongSet(Color)*LongSet(0FF0000H))>>16);
- 1523 green:= CARDINAL(LONGCARD(LongSet(Color)*LongSet(0FF00H))>>8);
- 1524 red:= CARDINAL(LongSet(Color)*LongSet(0FFH));
- 1525
- 1526 IF red = 0 THEN
- 1527 ncol:=0;
- 1528 ELSIF red <= 015H THEN
- 1529 ncol:=32;
- 1530 ELSIF red <= 02AH THEN
- 1531 ncol:=4;
- 1532 ELSE
- 1533 ncol:=36;
- 1534 END;
- 1535 IF green # 0 THEN
- 1536 IF green <= 015H THEN
- 1537 INC(ncol, 16);
- 1538 ELSIF green <= 02AH THEN
- 1539 INC(ncol, 2);
- 1540 ELSE
- 1541 INC(ncol, 18);
- 1542 END;
- 1543 END;
- 1544 IF blue # 0 THEN
- 1545 IF blue <= 015H THEN
- 1546 INC(ncol, 8);
- 1547 ELSIF blue <= 02AH THEN
- 1548 INC(ncol, 1);
- 1549 ELSE
- 1550 INC(ncol, 9);
- 1551 END;
- 1552 END;
- 1553 RETURN ncol;
- 1554 END EGAcolXlat;
- 1555
- 1556 PROCEDURE ColXlat(Color: LONGCARD): INTEGER;
- 1557
- 1558 VAR
- 1559 n: INTEGER;
- 1560 BEGIN
- 1561 n:=0;
- 1562 LOOP
- 1563 IF n = 16 THEN EXIT END;
- 1564 IF ColTable[n] = Color THEN EXIT END;
- 1565 INC(n);
- 1566 END;
- 1567 RETURN n;
- 1568 END ColXlat;
- 1569
- 1570 PROCEDURE Scroll();
- 1571
- 1572 VAR
- 1573 r: SYSTEM.Registers;
- 1574 BEGIN
- 1575 r.AX:=0601H;
- 1576 r.BH:=SHORTCARD(CoreGraph._scr_attr);
- 1577 r.CH:=SHORTCARD(CoreGraph._text_tl.row);
- 1578 r.CL:=SHORTCARD(CoreGraph._text_tl.col);
- 1579 r.DH:=SHORTCARD(CoreGraph._text_br.row);
- 1580 r.DL:=SHORTCARD(CoreGraph._text_br.col);
- 1581 Lib.Intr(r, 10H);
- 1582 END Scroll;
- 1583
- 1584 (*# restore *)
- 1585
- 1586 (*****************************************************************************)
- 1587 (* Public Function definitions. *)
- 1588 (*****************************************************************************)
- 1589
- 1590 PROCEDURE GetVideoConfig(VAR V: VideoConfig);
- 1591
- 1592 BEGIN
- 1593 IF CoreGraph._defaultmode = 0 THEN RETURN END;
- 1594 Lib.FastMove(ADR(CoreGraph._current_video), ADR(V), SIZE(VideoConfig));
- 1595 END GetVideoConfig;
- 1596
- 1597 PROCEDURE SetClipRgn(x1, y1, x2, y2: CARDINAL);
- 1598
- 1599 PROCEDURE Max(A, B: CARDINAL): CARDINAL;
- 1600
- 1601 BEGIN
- 1602 IF A > B THEN
- 1603 RETURN A;
- 1604 ELSE
- 1605 RETURN B;
- 1606 END;
- 1607 END Max;
- 1608
- 1609 PROCEDURE Min(A, B: CARDINAL): CARDINAL;
- 1610
- 1611 BEGIN
- 1612 IF A < B THEN
- 1613 RETURN A;
- 1614 ELSE
- 1615 RETURN B;
- 1616 END;
- 1617 END Min;
- 1618
- 1619 BEGIN
- 1620 CoreGraph._clip_tl.xcoord:=Max(x1, 0);
- 1621 CoreGraph._clip_tl.ycoord:=Max(y1, 0);
- 1622 CoreGraph._clip_br.xcoord:=Min(x2, CoreGraph._current_video.numxpixels-1);
- 1623 CoreGraph._clip_br.ycoord:=Min(y2, CoreGraph._current_video.numypixels-1);
- 1624 END SetClipRgn;
- 1625
- 1626 PROCEDURE GetBkColor(): LONGCARD;
- 1627
- 1628 BEGIN
- 1629 RETURN CoreGraph._bkcolor;
- 1630 END GetBkColor;
- 1631
- 1632 PROCEDURE GetFillMask(VAR Mask: FillMaskType);
- 1633
- 1634 BEGIN
- 1635 Lib.FastMove(ADR(CoreGraph._fill_mask), ADR(Mask), SIZE(CoreGraph.FillMaskType));
- 1636 END GetFillMask;
- 1637
- 1638
- 1639
- 1640 PROCEDURE GetLinestyle(): CARDINAL;
- 1641
- 1642 BEGIN
- 1643 RETURN CoreGraph._current_linestyle;
- 1644 END GetLinestyle;
- 1645
- 1646 PROCEDURE SetBkColor(Color: LONGCARD): LONGCARD;
- 1647
- 1648 VAR
- 1649 Ret: LONGCARD;
- 1650 r: SYSTEM.Registers;
- 1651
- 1652 BEGIN
- 1653 Ret:=CoreGraph._bkcolor;
- 1654 IF Ret = Color THEN
- 1655 RETURN Ret;
- 1656 END;
- 1657 IF (CoreGraph._current_video.mode = _MRES4COLOR) OR (CoreGraph._current_video.mode = _MRESNOCOLOR) THEN
- 1658 r.AH:= 0BH;
- 1659 r.BH:= 0;
- 1660 r.BL:= SHORTCARD(ColXlat(Color));
- 1661 Lib.Intr(r, 10H);
- 1662 ELSIF CoreGraph._current_video.mode > _MRES16COLOR THEN
- 1663 SYSTEM.Eval(RemapPalette(0, Color));
- 1664 END;
- 1665 CoreGraph._bkcolor:= Color;
- 1666 RETURN Ret;
- 1667 END SetBkColor;
- 1668
- 1669 PROCEDURE SetFillMask(Mask: CoreGraph.FillMaskType);
- 1670
- 1671 BEGIN
- 1672 CoreGraph._current_mask:= CoreGraph.FillMaskPtr(ADR(Mask));
- 1673 Lib.FastMove(ADR(Mask), ADR(CoreGraph._fill_mask), SIZE(CoreGraph.FillMaskType));
- 1674 END SetFillMask;
- 1675
- 1676 PROCEDURE SetLinestyle(Mask: CARDINAL);
- 1677
- 1678 BEGIN
- 1679 CoreGraph._current_linestyle:=Mask;
- 1680 END SetLinestyle;
- 1681
- 1682 PROCEDURE DisplayCursor(Toggle: BOOLEAN): BOOLEAN;
- 1683
- 1684 VAR
- 1685 Ret: BOOLEAN;
- 1686 BEGIN
- 1687 Ret:=CoreGraph._cursor_state;
- 1688 CoreGraph._cursor_state:=Toggle;
- 1689 RETURN Ret;
- 1690 END DisplayCursor;
- 1691
- 1692
- 1693
- 1694 PROCEDURE GetTextColor(): CARDINAL;
- 1695
- 1696 BEGIN
- 1697 RETURN CoreGraph._txcolor;
- 1698 END GetTextColor;
- 1699
- 1700 PROCEDURE GetTextPosition(): TextCoords;
- 1701
- 1702 VAR
- 1703 Ret: TextCoords;
- 1704 BEGIN
- 1705 Ret.row:=CoreGraph._current_text.row-CoreGraph._text_tl.row+1;
- 1706 Ret.col:=CoreGraph._current_text.col-CoreGraph._text_tl.col+1;
- 1707 RETURN Ret;
- 1708 END GetTextPosition;
- 1709
- 1710
- 1711 PROCEDURE SetTextColor(Color: CARDINAL): CARDINAL;
- 1712
- 1713 VAR
- 1714 Ret: CARDINAL;
- 1715 BEGIN
- 1716 Ret:=CoreGraph._txcolor;
- 1717 CoreGraph._txcolor:=Color;
- 1718 RETURN Ret;
- 1719 END SetTextColor;
- 1720
- 1721 PROCEDURE SetTextPosition(row, col: CARDINAL): TextCoords;
- 1722
- 1723 VAR
- 1724 Ret: TextCoords;
- 1725 BEGIN
- 1726 Ret:=CoreGraph._current_text;
- 1727 GEnter();
- 1728 CoreGraph._current_text.row:=INTEGER(row)+CoreGraph._text_tl.row-1;
- 1729 CoreGraph._current_text.col:=INTEGER(col)+CoreGraph._text_tl.col-1;
- 1730 CoreGraph._setcur(CoreGraph._current_text.row, CoreGraph._current_text.col, CoreGraph._active_page);
- 1731 GExit();
- 1732 RETURN Ret;
- 1733 END SetTextPosition;
- 1734
- 1735 PROCEDURE SetTextWindow(r1, c1, r2, c2: CARDINAL);
- 1736
- 1737 BEGIN
- 1738 CoreGraph._text_tl.row:=r1-1;
- 1739 CoreGraph._text_tl.col:=c1-1;
- 1740 CoreGraph._text_br.row:=r2-1;
- 1741 CoreGraph._text_br.col:=c2-1;
- 1742 SYSTEM.Eval(SetTextPosition(1, 1));
- 1743 END SetTextWindow;
- 1744
- 1745 PROCEDURE Wrapon(Opt: BOOLEAN): BOOLEAN;
- 1746
- 1747 VAR
- 1748 Ret: BOOLEAN;
- 1749
- 1750 BEGIN
- 1751 Ret:=CoreGraph._wrap_state;
- 1752
- 1753 CoreGraph._wrap_state:=Opt;
- 1754 RETURN Ret;
- 1755 END Wrapon;
- 1756
- 1757
- 1758 PROCEDURE OutText(Text: ARRAY OF CHAR);
- 1759
- 1760 VAR
- 1761 c: CHAR;
- 1762 n, h: CARDINAL;
- 1763 BEGIN
- 1764 n:=0;
- 1765 h:=HIGH(Text);
- 1766 GEnter();
- 1767 LOOP
- 1768 IF n > h THEN EXIT END;
- 1769 c:= Text[n];
- 1770 INC(n);
- 1771 IF c = CHAR(0) THEN EXIT END;
- 1772 CoreGraph._setcur(CoreGraph._current_text.row, CoreGraph._current_text.col, CoreGraph._active_page);
- 1773 IF c = CHAR(0AH) THEN
- 1774 IF CoreGraph._current_text.row < CoreGraph._text_br.row THEN
- 1775 INC(CoreGraph._current_text.row);
- 1776 ELSE
- 1777 Scroll();
- 1778 END;
- 1779 CoreGraph._current_text.col:=CoreGraph._text_tl.col;
- 1780 ELSIF c = CHAR(0DH) THEN
- 1781 CoreGraph._current_text.col:=CoreGraph._text_tl.col;
- 1782 ELSE
- 1783 CoreGraph._txt_out(INTEGER(c));
- 1784 IF CoreGraph._current_text.col = CoreGraph._text_br.col THEN
- 1785 CoreGraph._current_text.col:=CoreGraph._text_tl.col;
- 1786 IF CoreGraph._current_text.row < CoreGraph._text_br.row THEN
- 1787 INC(CoreGraph._current_text.row);
- 1788 ELSE
- 1789 Scroll();
- 1790 END;
- 1791 IF CoreGraph._wrap_state = _GWRAPOFF THEN EXIT END;
- 1792 ELSE
- 1793 INC(CoreGraph._current_text.col);
- 1794 END;
- 1795 END;
- 1796 END;
- 1797 CoreGraph._setcur(CoreGraph._current_text.row, CoreGraph._current_text.col, CoreGraph._active_page);
- 1798 GExit();
- 1799 END OutText;
- 1800
- 1801 PROCEDURE g_charoutput(c: CARDINAL);
- 1802
- 1803 BEGIN
- 1804 GEnter();
- 1805 CoreGraph._setcur(CoreGraph._current_text.row, CoreGraph._current_text.col, CoreGraph._active_page);
- 1806 IF c = 0AH THEN
- 1807 IF CoreGraph._current_text.row < CoreGraph._text_br.row THEN
- 1808 INC(CoreGraph._current_text.row);
- 1809 ELSE
- 1810 Scroll();
- 1811 END;
- 1812 CoreGraph._current_text.col:=CoreGraph._text_tl.col;
- 1813 ELSIF c = 0DH THEN
- 1814 CoreGraph._current_text.col:=CoreGraph._text_tl.col;
- 1815 ELSIF c = 8 THEN
- 1816 IF CoreGraph._current_text.col = CoreGraph._text_tl.col THEN
- 1817 IF CoreGraph._current_text.row > CoreGraph._text_tl.row THEN
- 1818 DEC(CoreGraph._current_text.row);
- 1819 CoreGraph._current_text.col:=CoreGraph._text_br.col;
- 1820 END;
- 1821 ELSE
- 1822 DEC(CoreGraph._current_text.col);
- 1823 END;
- 1824 CoreGraph._setcur(CoreGraph._current_text.row, CoreGraph._current_text.col, CoreGraph._active_page);
- 1825 CoreGraph._txt_out(INTEGER('\ '));
- 1826 ELSE
- 1827 CoreGraph._txt_out(INTEGER(c));
- 1828 IF CoreGraph._current_text.col = CoreGraph._text_br.col THEN
- 1829 CoreGraph._current_text.col:=CoreGraph._text_tl.col;
- 1830 IF CoreGraph._current_text.row < CoreGraph._text_br.row THEN
- 1831 INC(CoreGraph._current_text.row);
- 1832 ELSE
- 1833 Scroll();
- 1834 END;
- 1835 ELSE
- 1836 INC(CoreGraph._current_text.col);
- 1837 END;
- 1838 END;
- 1839 CoreGraph._setcur(CoreGraph._current_text.row, CoreGraph._current_text.col, CoreGraph._active_page);
- 1840 GExit();
- 1841 END g_charoutput;
- 1842
- 1843 PROCEDURE g_strinput(String: ARRAY OF CHAR);
- 1844
- 1845 VAR
- 1846 c: CHAR;
- 1847 p, n: CARDINAL;
- 1848 BEGIN
- 1849 p:=2;
- 1850 n:=0;
- 1851 LOOP
- 1852 IF n = HIGH(String) THEN EXIT END;
- 1853 c:= IO.RdChar();
- 1854 IF (c = CHAR(8)) OR (c = CHAR(127)) THEN
- 1855 IF n > 0 THEN
- 1856 DEC(p);
- 1857 DEC(n);
- 1858 g_charoutput(8);
- 1859 END;
- 1860 ELSIF ( c > CHAR(' ')) THEN
- 1861 g_charoutput(CARDINAL(c));
- 1862 String[p]:=c;
- 1863 INC(p);
- 1864 INC(n);
- 1865 ELSIF c = CHAR(13) THEN
- 1866 g_charoutput(CARDINAL(0AH));
- 1867 EXIT;
- 1868 END;
- 1869 END;
- 1870 String[p]:=CHAR(0);
- 1871 END g_strinput;
- 1872
- 1873 PROCEDURE SetVideoMode(Mode: CARDINAL): BOOLEAN;
- 1874
- 1875 TYPE
- 1876 PalRegType = ARRAY [0..16] OF SHORTCARD;
- 1877 PalColType = ARRAY [0..15] OF LONGCARD;
- 1878 CONST
- 1879 PalRegs = PalRegType(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 0);
- 1880 PalCols = PalColType(_BLACK, _BLUE, _GREEN, _CYAN, _RED, _MAGENTA, _BROWN,
- 1881 _WHITE, _GRAY, _LIGHTBLUE, _LIGHTGREEN, _LIGHTCYAN,
- 1882 _LIGHTRED, _LIGHTMAGENTA, _LIGHTYELLOW, _BRIGHTWHITE);
- 1883 VAR
- 1884 R: SYSTEM.Registers;
- 1885 n: CARDINAL;
- 1886
- 1887 PROCEDURE CheckMode(): BOOLEAN;
- 1888
- 1889 VAR
- 1890 Ret: BOOLEAN;
- 1891 BEGIN
- 1892 Ret:=TRUE;
- 1893
- 1894 IF Mode = _DEFAULTMODE THEN
- 1895 RETURN Ret;
- 1896 END;
- 1897 IF CoreGraph._current_video.adapter = _MDPA THEN
- 1898 IF Mode # _TEXTMONO THEN
- 1899 Ret:=FALSE;
- 1900 END;
- 1901 ELSIF CoreGraph._current_video.adapter = _HGC THEN
- 1902 IF (Mode # _TEXTMONO) AND (Mode # _HERCMONO) THEN
- 1903 Ret:=FALSE;
- 1904 END;
- 1905 ELSE
- 1906 CASE Mode OF
- 1907 | _TEXTBW40, _TEXTC40, _TEXTBW80, _TEXTC80,
- 1908 _MRES4COLOR, _MRESNOCOLOR, _HRESBW:
- 1909 Ret:=TRUE;
- 1910 | _TEXTMONO, _MRES16COLOR, _HRES16COLOR,
- 1911 _ERESNOCOLOR, _ERESCOLOR:
- 1912 IF (CoreGraph._current_video.adapter # _VGA) AND (CoreGraph._current_video.adapter # _EGA) THEN
- 1913 Ret:=FALSE;
- 1914 END;
- 1915 | _VRES2COLOR:
- 1916 IF (CoreGraph._current_video.adapter # _VGA) AND (CoreGraph._current_video.adapter # _MCGA) THEN
- 1917 Ret:=FALSE;
- 1918 END;
- 1919 | _VRES16COLOR, _HERCMONO:
- 1920 IF CoreGraph._current_video.adapter # _VGA THEN (* HGC already checked *)
- 1921 Ret:=FALSE;
- 1922 END;
- 1923 | _MRES256COLOR:
- 1924 IF (CoreGraph._current_video.adapter # _VGA) AND (CoreGraph._current_video.adapter # _MCGA) THEN
- 1925 Ret:=FALSE;
- 1926 END;
- 1927 ELSE
- 1928 Ret:=FALSE;
- 1929 END;
- 1930 END;
- 1931 RETURN Ret;
- 1932 END CheckMode;
- 1933
- 1934 BEGIN
- 1935 IF ~CheckMode() THEN
- 1936 RETURN FALSE;
- 1937 END; (*IF*)
- 1938 IF Mode = _DEFAULTMODE THEN
- 1939 Mode := CoreGraph._defaultmode;
- 1940 END; (*IF*)
- 1941 CoreGraph._display_state := ~(((Mode >= 0) & (Mode <= 3)) OR (Mode = 7));
- 1942 IF (Mode >= 4) & (Mode <= 6) THEN
- 1943 InternalInitCGA(Mode);
- 1944 ELSIF Mode = 8 THEN
- 1945 InternalInitHerc;
- 1946 ELSIF (Mode >= 13) & (Mode < 19) THEN
- 1947 InternalInitEGA(Mode);
- 1948 ELSIF Mode = 19 THEN
- 1949 InternalInitVGA256;
- 1950 END; (*IF*)
- 1951 IF CoreGraph._lastmode = 8 THEN
- 1952 HercTextMode;
- 1953 END; (*IF*)
- 1954 IF Mode = 8 THEN
- 1955 HercGraphMode;
- 1956 ELSE
- 1957 CoreGraph._setbiosmode(Mode);
- 1958 IF (Mode >= 13) AND (Mode < 19) THEN
- 1959 R.AX := 1002H;
- 1960 R.ES := Seg(PalRegs);
- 1961 R.DX := Ofs(PalRegs);
- 1962 Lib.Intr(R,10H);
- 1963 FOR n := 0 TO 15 DO
- 1964 R.AX := 1010H;
- 1965 R.BH := SHORTCARD(n); (* Trial Fix 12/02/91 *)
- 1966 R.BL := SHORTCARD(n);
- 1967 R.DH := SHORTCARD(PalCols[n]);
- 1968 R.CH := SHORTCARD(PalCols[n] >> 8);
- 1969 R.CL := SHORTCARD(PalCols[n] >> 16);
- 1970 Lib.Intr(R,10H);
- 1971 END; (*FOR*)
- 1972 END; (*IF*)
- 1973 END; (*IF*)
- 1974 CoreGraph._current_video.mode := Mode;
- 1975 SetLimits(CoreGraph._current_video);
- 1976 CoreGraph._lastmode := Mode;
- 1977 ModeChanged := TRUE;
- 1978 RETURN TRUE;
- 1979 END SetVideoMode;
- 1980
- 1981 PROCEDURE SetActivePage(Page: CARDINAL): CARDINAL;
- 1982
- 1983
- 1984 VAR
- 1985 Ret: CARDINAL;
- 1986 BEGIN
- 1987 Ret:=CoreGraph._active_page;
- 1988 IF (Page < 0) OR (Page > CoreGraph._current_video.numvideopages-1) THEN
- 1989 RETURN MAX(CARDINAL);
- 1990 END;
- 1991 CoreGraph._active_page:=Page;
- 1992 RETURN Ret;
- 1993 END SetActivePage;
- 1994
- 1995 PROCEDURE SetVisualPage(Page:CARDINAL):CARDINAL;
- 1996 VAR
- 1997 r : SYSTEM.Registers;
- 1998 Ret : CARDINAL;
- 1999 BEGIN
- 2000 Ret := CoreGraph._visual_page;
- 2001 IF (Page < 0) OR (Page > CoreGraph._current_video.numvideopages-1) THEN
- 2002 RETURN MAX(CARDINAL);
- 2003 END; (*IF*)
- 2004 CoreGraph._visual_page := Page;
- 2005 IF CoreGraph._current_video.mode # _HERCMONO THEN
- 2006 r.AH:=5;
- 2007 r.AL:=SHORTCARD(Page);
- 2008 Lib.Intr(r,10H);
- 2009 ELSIF Page = 0 THEN
- 2010 SYSTEM.Out(3B8H,0AH);
- 2011 ELSE
- 2012 SYSTEM.Out(3B8H,08AH);
- 2013 END; (*IF*)
- 2014 RETURN Ret;
- 2015 END SetVisualPage;
- 2016
- 2017 PROCEDURE ClearScreen(Area: CARDINAL);
- 2018
- 2019 VAR
- 2020 r: SYSTEM.Registers;
- 2021 LineNum: INTEGER;
- 2022 BEGIN
- 2023 GEnter();
- 2024 IF Area = _GWINDOW THEN
- 2025 r.AX:=0600H;
- 2026 IF CoreGraph._display_state = FALSE THEN
- 2027 r.BH:=SHORTCARD(7+(CoreGraph._bkcolor<<4));
- 2028 ELSE
- 2029 r.BH:=0;
- 2030 END;
- 2031 r.CH:=SHORTCARD(CoreGraph._text_tl.row);
- 2032 r.CL:=SHORTCARD(CoreGraph._text_tl.col);
- 2033 r.DH:=SHORTCARD(CoreGraph._text_br.row);
- 2034 r.DL:=SHORTCARD(CoreGraph._text_br.col);
- 2035 Lib.Intr(r, 10H);
- 2036 SYSTEM.Eval(SetTextPosition(1, 1));
- 2037 ELSIF Area = _GVIEWPORT THEN
- 2038 IF CoreGraph._display_state = TRUE THEN
- 2039 LineNum:=CoreGraph._clip_tl.ycoord;
- 2040 WHILE LineNum <= CoreGraph._clip_br.ycoord DO
- 2041 CoreGraph._hline(CoreGraph._clip_tl.xcoord, LineNum, CoreGraph._clip_br.xcoord, 0);
- 2042 INC(LineNum);
- 2043 END;
- 2044 END;
- 2045 ELSIF CoreGraph._current_video.mode = _HERCMONO THEN
- 2046 CoreGraph._clear_Herc();
- 2047 SYSTEM.Eval(SetTextPosition(1, 1));
- 2048 ELSE
- 2049 r.AX:=0600H;
- 2050 IF CoreGraph._display_state = FALSE THEN
- 2051 r.BH:=SHORTCARD(7+(CoreGraph._bkcolor<<4));
- 2052 ELSE
- 2053 r.BH:=SHORTCARD(CoreGraph._bkcolor);
- 2054 END;
- 2055 r.CX:=0000H;
- 2056 r.DH:=SHORTCARD(CoreGraph._current_video.numtextrows-1);
- 2057 r.DL:=SHORTCARD(CoreGraph._current_video.numtextcols-1);
- 2058 Lib.Intr(r, 10H);
- 2059 SYSTEM.Eval(SetTextPosition(1, 1));
- 2060 END;
- 2061 GExit();
- 2062 END ClearScreen;
- 2063
- 2064 PROCEDURE Line(x1, y1, x2, y2: CARDINAL; Color: CARDINAL);
- 2065
- 2066 BEGIN
- 2067 GEnter();
- 2068 CoreGraph._fgcolor:=Color;
- 2069 IF (y1 = y2) AND (CoreGraph._current_linestyle = MAX(CARDINAL)) THEN
- 2070 CoreGraph._hline(x1, y1, x2, Color);
- 2071 ELSE
- 2072 CoreGraph._line(x1, y1, x2, y2, CoreGraph._current_linestyle);
- 2073 END;
- 2074 GExit();
- 2075 END Line;
- 2076
- 2077 PROCEDURE HLine(x1, y1, x2: CARDINAL; Color: CARDINAL);
- 2078
- 2079 BEGIN
- 2080 GEnter();
- 2081 CoreGraph._hline(x1, y1, x2, Color);
- 2082 GExit();
- 2083 END HLine;
- 2084
- 2085 PROCEDURE Rectangle(x1, y1, x2, y2: CARDINAL; Color: CARDINAL;Fill: BOOLEAN);
- 2086
- 2087 VAR
- 2088 Mask: CARDINAL;
- 2089 BEGIN
- 2090 GEnter();
- 2091 CoreGraph._fgcolor:=Color;
- 2092 IF CoreGraph._current_linestyle = MAX(CARDINAL) THEN
- 2093 CoreGraph._hline(x1, y1, x2, Color);
- 2094 CoreGraph._line(x2, y1, x2, y2, CoreGraph._current_linestyle);
- 2095 CoreGraph._hline(x2, y2, x1, Color);
- 2096 CoreGraph._line(x1, y2, x1, y1, CoreGraph._current_linestyle);
- 2097 ELSE
- 2098 CoreGraph._line(x1, y1, x2, y1, CoreGraph._current_linestyle);
- 2099 CoreGraph._line(x2, y1, x2, y2, CoreGraph._current_linestyle);
- 2100 CoreGraph._line(x2, y2, x1, y2, CoreGraph._current_linestyle);
- 2101 CoreGraph._line(x1, y2, x1, y1, CoreGraph._current_linestyle);
- 2102 END;
- 2103 IF Fill = _GFILLINTERIOR THEN
- 2104 INC(x1);
- 2105 INC(y1);
- 2106 DEC(x2);
- 2107 DEC(y2);
- 2108 IF x1 = x2 THEN
- 2109 GExit();
- 2110 RETURN;
- 2111 END;
- 2112 WHILE y1 <= y2 DO
- 2113 Mask:=CARDINAL(CoreGraph._fill_mask[y1 MOD 8])
- 2114 +CARDINAL(CoreGraph._fill_mask[y1 MOD 8])*100H;
- 2115 IF Mask = MAX(CARDINAL) THEN
- 2116 CoreGraph._hline(x1, y1, x2, Color);
- 2117 ELSE
- 2118 CoreGraph._line(x1, y1, x2, y1, Mask);
- 2119 END;
- 2120 INC(y1);
- 2121 END;
- 2122 END;
- 2123 GExit();
- 2124 END Rectangle;
- 2125
- 2126 PROCEDURE Ellipse(x0, y0, a0, b0: CARDINAL; Color: CARDINAL; Fill: BOOLEAN);
- 2127
- 2128 BEGIN
- 2129 GEnter();
- 2130 CoreGraph._fgcolor:= Color;
- 2131 DrawEllipse(x0, y0, a0, b0, Fill);
- 2132 GExit();
- 2133 END Ellipse;
- 2134
- 2135 PROCEDURE Disc(x0, y0, r: CARDINAL; Color: CARDINAL);
- 2136
- 2137 BEGIN
- 2138 Ellipse(x0, y0, r, r, Color, TRUE);
- 2139 END Disc;
- 2140
- 2141 PROCEDURE Circle(x0, y0, r: CARDINAL; Color: CARDINAL);
- 2142
- 2143 BEGIN
- 2144 Ellipse(x0, y0, r, r, Color, FALSE);
- 2145 END Circle;
- 2146
- 2147 PROCEDURE Arc(x1, y1, a, b, x3, y3, x4, y4: CARDINAL; Color: CARDINAL);
- 2148
- 2149 VAR
- 2150 start, end: InterSect;
- 2151 BEGIN
- 2152 GEnter();
- 2153 CoreGraph._fgcolor:=Color;
- 2154 start:=GetVec(x1, y1, a, b, x3, y3);
- 2155 end:=GetVec(x1, y1, a, b, x4, y4);
- 2156 SYSTEM.Eval(DrawArc(x1, y1, a, b, start.x, start.y, end.x, end.y));
- 2157 GExit();
- 2158 END Arc;
- 2159
- 2160 PROCEDURE Pie(x1, y1, a, b, x3, y3, x4, y4: CARDINAL; Color: CARDINAL; Fill: BOOLEAN);
- 2161
- 2162 VAR
- 2163 Ret: BOOLEAN;
- 2164 fx, fy: INTEGER;
- 2165 start, end: InterSect;
- 2166 BEGIN
- 2167 GEnter();
- 2168 CoreGraph._fgcolor:=Color;
- 2169 start:=GetVec(x1, y1, a, b, x3, y3);
- 2170 end:=GetVec(x1, y1, a, b, x4, y4);
- 2171 Ret:=DrawArc(x1, y1, a, b, start.x, start.y, end.x, end.y);
- 2172 IF Ret = FALSE THEN
- 2173 RETURN ;
- 2174 END;
- 2175 CoreGraph._line(x1, y1, start.x, start.y, CoreGraph._current_linestyle);
- 2176 CoreGraph._line(x1, y1, end.x, end.y, CoreGraph._current_linestyle);
- 2177 IF (Fill = _GFILLINTERIOR) AND (GetFillStart(fx, fy, x1, y1, start.x, start.y,
- 2178 end.x, end.y)) THEN
- 2179 FloodFill(fx, fy, CoreGraph._fgcolor, CoreGraph._fgcolor);
- 2180 END;
- 2181 GExit();
- 2182 END Pie;
- 2183
- 2184 PROCEDURE Plot(x, y: CARDINAL; Color: CARDINAL);
- 2185
- 2186 BEGIN
- 2187 GEnter();
- 2188 IF (INTEGER(x) > CoreGraph._clip_br.xcoord) OR (INTEGER(x) < CoreGraph._clip_tl.xcoord)
- 2189 OR (INTEGER(y) > CoreGraph._clip_br.ycoord) OR (INTEGER(y) < CoreGraph._clip_tl.ycoord) THEN
- 2190 RETURN;
- 2191 END;
- 2192 CoreGraph._plot(x, y, Color);
- 2193 GExit();
- 2194 END Plot;
- 2195
- 2196 PROCEDURE Point(x, y: CARDINAL): CARDINAL;
- 2197
- 2198 BEGIN
- 2199 IF (INTEGER(x) > CoreGraph._clip_br.xcoord) OR (INTEGER(x) < CoreGraph._clip_tl.xcoord)
- 2200 OR (INTEGER(y) > CoreGraph._clip_br.ycoord) OR (INTEGER(y) < CoreGraph._clip_tl.ycoord) THEN
- 2201 RETURN MAX(CARDINAL);
- 2202 END;
- 2203 RETURN CoreGraph._point(x, y);
- 2204 END Point;
- 2205
- 2206 PROCEDURE FloodFill(x, y: CARDINAL; Color: CARDINAL; Boundary: CARDINAL);
- 2207
- 2208 VAR
- 2209 xl, xr, v, i, nx, ny: INTEGER;
- 2210 BEGIN
- 2211 CoreGraph._fgcolor:=Color;
- 2212 i:=0;
- 2213 WHILE ( i < FILL_MASK_SIZE) DO
- 2214 IF CoreGraph._fill_mask[i] = 0 THEN
- 2215 StackFill(x, y, Color, Boundary);
- 2216 RETURN;
- 2217 END;
- 2218 INC(i);
- 2219 END;
- 2220 GEnter();
- 2221 nx := INTEGER(x);
- 2222 ny := INTEGER(y);
- 2223 IF Boundary >= CoreGraph._current_video.numcolors THEN
- 2224 Boundary:=CoreGraph._current_video.numcolors-1;
- 2225 END;
- 2226 IF (nx > CoreGraph._clip_br.xcoord) OR (nx < CoreGraph._clip_tl.xcoord) THEN
- 2227 RETURN;
- 2228 END;
- 2229 IF (ny > CoreGraph._clip_br.ycoord) OR (ny < CoreGraph._clip_tl.ycoord) THEN
- 2230 RETURN;
- 2231 END;
- 2232 v:=CoreGraph._point(x, y);
- 2233 IF v = INTEGER(Boundary) THEN
- 2234 RETURN;
- 2235 END;
- 2236 xr := x;
- 2237 xl := xr;
- 2238 HscanLine (xl, xr, y, Boundary);
- 2239 LagFill(xl, xr, y, UP, xl, xl-1, Boundary);
- 2240 GExit();
- 2241 END FloodFill;
- 2242
- 2243 PROCEDURE StackFill(x, y: CARDINAL; Color: CARDINAL; Boundary: CARDINAL);
- 2244
- 2245 VAR
- 2246 xl, xr, xp, yp, nx, ny, direction: INTEGER;
- 2247 BEGIN
- 2248 nx := INTEGER(x);
- 2249 ny := INTEGER(y);
- 2250 GEnter();
- 2251 CoreGraph._fgcolor:=Color;
- 2252 IF Boundary >= CoreGraph._current_video.numcolors THEN
- 2253 Boundary:=CoreGraph._current_video.numcolors-1;
- 2254 END;
- 2255 IF (nx > CoreGraph._clip_br.xcoord) OR (nx < CoreGraph._clip_tl.xcoord) THEN
- 2256 RETURN;
- 2257 END;
- 2258 IF (ny > CoreGraph._clip_br.ycoord) OR (ny < CoreGraph._clip_tl.ycoord) THEN
- 2259 RETURN;
- 2260 END;
- 2261 IF CoreGraph._point(x, y) = INTEGER(Boundary) THEN
- 2262 RETURN;
- 2263 END;
- 2264 xr := x;
- 2265 xl := xr;
- 2266 xp:=x;
- 2267 yp:=y;
- 2268 HscanLine ( xl, xr, y, Boundary );
- 2269
- 2270 direction := +1;
- 2271 LOOP
- 2272 ny := yp;
- 2273 nx := xl;
- 2274 xp := xr;
- 2275 LOOP
- 2276 INC(ny, direction);
- 2277 IF (ny < CoreGraph._clip_tl.ycoord) OR (CoreGraph._clip_br.ycoord < ny) THEN
- 2278 EXIT;
- 2279 END;
- 2280 WHILE (nx <= xp) AND (CoreGraph._point ( nx, ny ) = INTEGER(Boundary)) DO
- 2281 INC(nx);
- 2282 END;
- 2283 IF nx > xp THEN
- 2284 EXIT;
- 2285 END;
- 2286 xp := nx;
- 2287 HscanLine (nx, xp, ny, INTEGER(Boundary));
- 2288 END;
- 2289 IF direction < 0 THEN
- 2290 EXIT;
- 2291 END;
- 2292 direction := -1;
- 2293 END;
- 2294 GExit();
- 2295 END StackFill;
- 2296
- 2297 PROCEDURE RemapPalette(Pixel: CARDINAL; Color: LONGCARD): LONGCARD;
- 2298
- 2299 TYPE
- 2300 LongSet = SET OF [0..31];
- 2301 VAR
- 2302 r: SYSTEM.Registers;
- 2303 OldColor: LONGCARD;
- 2304 n: CARDINAL;
- 2305 ColSet: LongSet;
- 2306 BEGIN
- 2307 GEnter();
- 2308 IF (CoreGraph._current_video.adapter = _VGA) OR (CoreGraph._current_video.adapter = _MCGA) THEN
- 2309 ColSet:=LongSet(Color);
- 2310 r.AX:=01015H;
- 2311 r.BX:=Pixel;
- 2312 Lib.Intr(r, 10H);
- 2313 OldColor:= LONGCARD(r.DH);
- 2314 OldColor:= OldColor+LONGCARD(r.CH)<<8;
- 2315 OldColor:= OldColor+LONGCARD(r.CL)<<16;
- 2316 r.AX:=01010H;
- 2317 r.BX:=Pixel;
- 2318 r.DH:=SHORTCARD(LONGCARD(ColSet));
- 2319 r.CH:=SHORTCARD(LONGCARD(ColSet*LongSet(0FF00H))>>8);
- 2320 r.CL:=SHORTCARD(LONGCARD(ColSet*LongSet(0FF0000H))>>16);
- 2321 Lib.Intr(r, 10H);
- 2322 ELSIF (CoreGraph._current_video.adapter = _EGA) THEN
- 2323 n:=EGAcolXlat(Color);
- 2324 r.AX:=01000H;
- 2325 r.BL:=SHORTCARD(Pixel);
- 2326 r.BH:=SHORTCARD(n);
- 2327 Lib.Intr(r, 10H);
- 2328 OldColor:=ColTable[EGATable[Pixel]];
- 2329 EGATable[Pixel]:=n;
- 2330 ELSE
- 2331 OldColor := MAX(LONGCARD);
- 2332 END;
- 2333 GExit();
- 2334 RETURN OldColor;
- 2335 END RemapPalette;
- 2336
- 2337 PROCEDURE RemapAllPalette(Colarray: ARRAY OF LONGCARD): CARDINAL;
- 2338
- 2339 VAR
- 2340 num, Count: CARDINAL;
- 2341 Colors: ARRAY [0..256] OF ARRAY [0..2] OF SHORTCARD;
- 2342 ColRegs: ARRAY [0..16] OF CHAR;
- 2343 r: SYSTEM.Registers;
- 2344
- 2345 BEGIN
- 2346 num:=CoreGraph._current_video.numcolors;
- 2347 Count:=0;
- 2348 GEnter();
- 2349
- 2350 IF (CoreGraph._current_video.adapter = _VGA) OR (CoreGraph._current_video.adapter = _MCGA) THEN
- 2351 WHILE Count < num DO
- 2352 Lib.Move(ADR(Colarray[Count]), ADR(Colors[Count]), 3);
- 2353 INC(Count);
- 2354 END;
- 2355 r.AX:=01012H;
- 2356 r.BX:=0;
- 2357 r.CX:=num;
- 2358
- 2359 r.DX:=Ofs(Colors);
- 2360 r.ES:=Seg(Colors);
- 2361 Lib.Intr(r, 10H);
- 2362 ELSIF (CoreGraph._current_video.adapter = _EGA) THEN
- 2363 Count:=0;
- 2364 WHILE Count < num DO
- 2365 ColRegs[Count]:=CHAR(EGAcolXlat(Colarray[Count]));
- 2366 INC(Count);
- 2367 END;
- 2368 ColRegs[16]:=CHAR(0);
- 2369 r.AX:=1002H;
- 2370 r.DX:=Ofs(ColRegs);
- 2371 r.ES:=Seg(ColRegs);
- 2372 Lib.Intr(r, 10H);
- 2373 Lib.Move(ADR(ColRegs), ADR(EGATable), 17);
- 2374 END;
- 2375 GExit();
- 2376 RETURN Count;
- 2377 END RemapAllPalette;
- 2378
- 2379 VAR
- 2380 OldPalette: CARDINAL;
- 2381
- 2382 PROCEDURE SelectPalette(Palnum: CARDINAL): CARDINAL;
- 2383
- 2384 VAR
- 2385 r: SYSTEM.Registers;
- 2386 Ret: CARDINAL;
- 2387 BEGIN
- 2388 Ret:=OldPalette;
- 2389 IF (CoreGraph._current_video.mode # _MRES4COLOR) AND (CoreGraph._current_video.mode # _MRESNOCOLOR) THEN
- 2390 RETURN MAX(CARDINAL);
- 2391 END;
- 2392 GEnter();
- 2393 OldPalette:=Palnum;
- 2394 r.AH:=0BH;
- 2395 r.BH:=1;
- 2396 r.BL:=SHORTCARD(Palnum);
- 2397 Lib.Intr(r, 10H);
- 2398 GExit();
- 2399 RETURN Ret;
- 2400 END SelectPalette;
- 2401
- 2402 PROCEDURE GetImage(x1, y1, x2, y2: CARDINAL; Buffer: ADDRESS);
- 2403
- 2404 BEGIN
- 2405 GEnter();
- 2406 CoreGraph._get(FarADR(Buffer^), x1, y1, x2, y2);
- 2407 GExit();
- 2408 END GetImage;
- 2409
- 2410 PROCEDURE PutImage(x, y: CARDINAL; Buffer: ADDRESS; Action: CARDINAL);
- 2411
- 2412 BEGIN
- 2413 GEnter();
- 2414 CoreGraph._put(x, y, FarADR(Buffer^), Action);
- 2415 GExit();
- 2416 END PutImage;
- 2417
- 2418 PROCEDURE ImageSize(x1, y1, x2, y2: CARDINAL): LONGCARD;
- 2419
- 2420 VAR
- 2421 Size: LONGCARD;
- 2422 ywidth, xwidth: LONGCARD;
- 2423 BEGIN
- 2424 xwidth:=LONGCARD(ABS(INTEGER(x1)-INTEGER(x2))+1);
- 2425 ywidth:=LONGCARD(ABS(INTEGER(y1)-INTEGER(y2))+1);
- 2426 Size:=((xwidth DIV 8)+1) * ywidth * LONGCARD(CoreGraph._current_video.bitsperpixel);
- 2427 RETURN Size+HEADER_SIZE;
- 2428 END ImageSize;
- 2429
- 2430 PROCEDURE Cube(top: BOOLEAN; x1, y1, x2, y2, depth: CARDINAL; Color: CARDINAL; Fill: BOOLEAN);
- 2431
- 2432 VAR
- 2433 px, py: ARRAY [0..3] OF CARDINAL;
- 2434 height: CARDINAL;
- 2435 FillVal: BOOLEAN;
- 2436 BEGIN
- 2437 GEnter();
- 2438 FillVal:=FillState;
- 2439 FillState:=Fill;
- 2440 CoreGraph._fgcolor:=Color;
- 2441 height:=y2-y1;
- 2442 px[0]:=x2;
- 2443 py[0]:=y2;
- 2444 px[1]:=x2+depth;
- 2445 py[1]:=y2-(depth>>1);
- 2446 px[2]:=px[1];
- 2447 py[2]:=py[1]-height;
- 2448 px[3]:=px[0];
- 2449 py[3]:=py[0]-height;
- 2450 Polygon(4, px, py, Color);
- 2451 IF top THEN
- 2452 px[0]:=x1;
- 2453 py[0]:=y1;
- 2454 px[1]:=x1+depth;
- 2455 py[1]:=y1-(depth>>1);
- 2456 DEC(px[2]);
- 2457 DEC(px[3]);
- 2458 Polygon(4, px, py, Color);
- 2459 END;
- 2460 Rectangle(x1, y1, x2, y2, Color, Fill);
- 2461 FillState:=FillVal;
- 2462 GExit();
- 2463 END Cube;
- 2464
- 2465 CONST
- 2466 MaxPts = 20;
- 2467 VAR
- 2468 xord: ARRAY [0..MaxPts] OF CARDINAL;
- 2469 x: ARRAY [0..MaxPts] OF CARDINAL;
- 2470
- 2471 PROCEDURE QuickSort(l,r: INTEGER);
- 2472 VAR
- 2473 i,j,temp : INTEGER;
- 2474 key : CARDINAL;
- 2475 BEGIN
- 2476 WHILE ( l < r ) DO
- 2477 i := l; j := r; key := x[xord[j]];
- 2478 REPEAT
- 2479 WHILE ( i < j ) AND ( x[xord[i]] <= key ) DO i := i + 1 END;
- 2480 WHILE ( i < j ) AND ( key <= x[xord[j]] ) DO j := j - 1 END;
- 2481 IF i < j THEN
- 2482 temp := xord[i]; xord[i] := xord[j]; xord[j] := temp;
- 2483 END;
- 2484 UNTIL ( i >= j );
- 2485 temp := xord[i]; xord[i] := xord[r]; xord[r] := temp;
- 2486 IF (i-l < r-i) THEN
- 2487 QuickSort( l, i-1 ); l := i+1;
- 2488 ELSE
- 2489 QuickSort( i+1, r ); r := i-1;
- 2490 END;
- 2491 END;
- 2492 END QuickSort;
- 2493
- 2494 PROCEDURE Polygon(n: CARDINAL; px, py: ARRAY OF CARDINAL; Color: CARDINAL);
- 2495
- 2496 VAR
- 2497 y, miny, maxy, x0, y0, x1, y1: INTEGER;
- 2498 temp, i, edge, next_edge, active: INTEGER;
- 2499 e: ARRAY [0..MaxPts] OF INTEGER;
- 2500 plotl, plotr: INTEGER;
- 2501 Mask: CARDINAL;
- 2502 BEGIN
- 2503 IF n > MaxPts THEN RETURN END;
- 2504 GEnter();
- 2505 CoreGraph._fgcolor:=Color;
- 2506 i:=0;
- 2507 WHILE i < INTEGER(n) DO
- 2508 IF i < INTEGER(n-1) THEN
- 2509 CoreGraph._line(px[i], py[i], px[i+1], py[i+1], CoreGraph._current_linestyle);
- 2510 ELSE
- 2511 CoreGraph._line(px[i], py[i], px[0], py[0], CoreGraph._current_linestyle);
- 2512 END;
- 2513 INC(i);
- 2514 END;
- 2515 IF FillState = _GBORDER THEN
- 2516 GExit();
- 2517 RETURN;
- 2518 END;
- 2519 miny:=py[0]; (* find extremal y points *)
- 2520 maxy:=miny;
- 2521 i:=0;
- 2522 WHILE i < INTEGER(n) DO
- 2523 IF INTEGER(py[i]) < miny THEN
- 2524 miny:=py[i];
- 2525 END;
- 2526 IF INTEGER(py[i]) > maxy THEN
- 2527 maxy:=py[i];
- 2528 END;
- 2529 INC(i);
- 2530 END;
- 2531 y:=miny;
- 2532 WHILE y <= maxy DO
- 2533 active:=-1;
- 2534 edge:= 0;
- 2535 WHILE edge < INTEGER(n) DO
- 2536 IF edge = INTEGER(n-1) THEN
- 2537 next_edge:=0;
- 2538 ELSE
- 2539 next_edge:=edge+1;
- 2540 END;
- 2541 x0:=px[edge];
- 2542 y0:=py[edge];
- 2543 x1:=px[next_edge];
- 2544 y1:=py[next_edge];
- 2545 IF y0 > y1 THEN
- 2546 temp:=x0;
- 2547 x0:=x1;
- 2548 x1:=temp;
- 2549 temp:=y0;
- 2550 y0:=y1;
- 2551 y1:=temp;
- 2552 END;
- 2553 IF y = y0 THEN
- 2554 e[edge]:=0;
- 2555 x[edge]:=x0;
- 2556 ELSIF (y0 <= y) AND (y <= y1) THEN
- 2557 IF x1 >= x0 THEN (* x increases with y *)
- 2558 INC(e[edge], (2*(x1-x0)));
- 2559 WHILE e[edge] > (y1-y0) DO
- 2560 DEC(e[edge], (2*(y1-y0)));
- 2561 INC(x[edge]);
- 2562 END;
- 2563 ELSE (* x decreases with y *)
- 2564 INC(e[edge], (2*(x0-x1)));
- 2565 WHILE e[edge] > (y1-y0) DO
- 2566 DEC(e[edge], (2*(y1-y0)));
- 2567 DEC(x[edge]);
- 2568 END;
- 2569 END;
- 2570 INC(active);
- 2571 xord[active]:=edge;
- 2572 END;
- 2573 INC(edge);
- 2574 END;
- 2575 QuickSort(0, active);
- 2576 i:=0;
- 2577 WHILE i < active DO
- 2578 plotl:=x[xord[i]]+1;
- 2579 plotr:=x[xord[i+1]]-1;
- 2580 IF plotr >= plotl THEN
- 2581 CoreGraph._fgcolor:=Color;
- 2582 Mask:=CARDINAL(CoreGraph._fill_mask[y MOD 8])
- 2583 +CARDINAL(CoreGraph._fill_mask[y MOD 8])*100H;
- 2584 IF Mask = MAX(CARDINAL) THEN
- 2585 CoreGraph._hline(plotl, y, plotr, Color);
- 2586 ELSE
- 2587 CoreGraph._line(plotl, y, plotr, y, Mask);
- 2588 END;
- 2589 END;
- 2590 INC(i, 2);
- 2591 END;
- 2592 INC(y);
- 2593 END; (* for y = .. *)
- 2594 GExit();
- 2595 END Polygon;
- 2596
- 2597
- 2598 PROCEDURE GraphMode();
- 2599
- 2600 BEGIN
- 2601 (*%T AutoDetect *)
- 2602 CASE CoreGraph._current_video.adapter OF
- 2603 | _HGC :
- 2604 Width:=HercWidth;
- 2605 Depth:=HercDepth;
- 2606 NumColor:=HercNumColor;
- 2607 IF SetVideoMode(_HERCMONO) THEN END;
- 2608 | _CGA, _MCGA:
- 2609 Width:=CGAWidth;
- 2610 Depth:=CGADepth;
- 2611 NumColor:=CGANumColor;
- 2612 IF SetVideoMode(_MRES4COLOR) THEN END;
- 2613 | _EGA, _VGA :
- 2614 Width:=EGAWidth;
- 2615 Depth:=EGADepth;
- 2616 NumColor:=EGANumColor;
- 2617 IF SetVideoMode(_ERESCOLOR) THEN END;
- 2618 ELSE
- 2619 RETURN;
- 2620 END;
- 2621 (*%E *)
- 2622 (*%F AutoDetect *)
- 2623 CoreGraph._display_state:=TRUE;
- 2624 IF StaticMode = _HERCMONO THEN
- 2625 HercGraphMode();
- 2626 ELSE
- 2627 CoreGraph._setbiosmode(StaticMode);
- 2628 END;
- 2629 CoreGraph._current_video.mode:= StaticMode;
- 2630 SetLimits(CoreGraph._current_video);
- 2631 CoreGraph._lastmode:=StaticMode;
- 2632 (*%E *)
- 2633 END GraphMode;
- 2634
- 2635 PROCEDURE TextMode();
- 2636
- 2637 BEGIN
- 2638 (*%T AutoDetect *)
- 2639 IF SetVideoMode(_DEFAULTMODE) THEN END;
- 2640 (*%E *)
- 2641 (*%F AutoDetect *)
- 2642 CoreGraph._display_state:=FALSE;
- 2643 IF StaticMode = _HERCMONO THEN
- 2644 HercTextMode();
- 2645 ELSE
- 2646 CoreGraph._setbiosmode(CoreGraph._defaultmode);
- 2647 END;
- 2648 CoreGraph._current_video.mode:= CoreGraph._defaultmode;
- 2649 SetLimits(CoreGraph._current_video);
- 2650 CoreGraph._lastmode:=CoreGraph._defaultmode;
- 2651 (*%E *)
- 2652 END TextMode;
- 2653
- 2654 PROCEDURE InitCGA();
- 2655
- 2656 BEGIN
- 2657 InternalInitCGA(_MRES4COLOR);
- 2658 CoreGraph._current_video.adapter := _CGA;
- 2659 StaticMode:=_MRES4COLOR;
- 2660 Width:=CGAWidth;
- 2661 Depth:=CGADepth;
- 2662 NumColor:=CGANumColor;
- 2663 END InitCGA;
- 2664
- 2665 PROCEDURE InitEGA();
- 2666
- 2667 BEGIN
- 2668 InternalInitEGA(_ERESCOLOR);
- 2669 CoreGraph._current_video.adapter := _EGA;
- 2670 StaticMode:=_ERESCOLOR;
- 2671 Width:=EGAWidth;
- 2672 Depth:=EGADepth;
- 2673 NumColor:=EGANumColor;
- 2674 END InitEGA;
- 2675
- 2676 PROCEDURE InitVGA();
- 2677
- 2678 BEGIN
- 2679 InternalInitVGA256();
- 2680 CoreGraph._current_video.adapter := _VGA;
- 2681 StaticMode:=_MRES256COLOR;
- 2682 Width:=VGA256Width;
- 2683 Depth:=VGA256Depth;
- 2684 NumColor:=VGANumColor;
- 2685 END InitVGA;
- 2686
- 2687 PROCEDURE InitHerc();
- 2688
- 2689 BEGIN
- 2690 InternalInitHerc();
- 2691 CoreGraph._current_video.adapter := _HGC;
- 2692 StaticMode:=_HERCMONO;
- 2693 Width:=HercWidth;
- 2694 Depth:=HercDepth;
- 2695 NumColor:=HercNumColor;
- 2696 END InitHerc;
- 2697
- 2698
- 2699 PROCEDURE InitGraph();
- 2700 VAR
- 2701 display : CoreGraph.VideoType;
- 2702 Disp : CARDINAL;
- 2703 BEGIN
- 2704 CoreGraph._defaultmode := CoreGraph._getvideomode();
- 2705 CoreGraph._lastmode := CoreGraph._defaultmode;
- 2706 CoreGraph._current_video.mode := CoreGraph._defaultmode;
- 2707 SetLimits(CoreGraph._current_video);
- 2708 CoreGraph._getsystem(display);
- 2709 Disp := SetActivePage(0);
- 2710 Disp := SetVisualPage(0);
- 2711 CASE display.sys0 OF
- 2712 MDA : CoreGraph._current_video.adapter:=_MDPA; |
- 2713 CGA : CoreGraph._current_video.adapter:=_CGA;
- 2714 Width:=CGAWidth;
- 2715 Depth:=CGADepth;
- 2716 NumColor:=CGANumColor; |
- 2717 EGA : CoreGraph._current_video.adapter:=_EGA;
- 2718 CoreGraph._current_video.memory:=CoreGraph._getmemory();
- 2719 IF (CoreGraph._current_video.memory = 64 )THEN
- 2720 CoreGraph._EGA64K:=TRUE;
- 2721 END; (*IF*)
- 2722 Width:=EGAWidth;
- 2723 Depth:=EGADepth;
- 2724 NumColor:=EGANumColor; |
- 2725 MCGA : CoreGraph._current_video.adapter:=_MCGA;
- 2726 CoreGraph._current_video.memory:=CoreGraph._getmemory();
- 2727 Width:=CGAWidth;
- 2728 Depth:=CGADepth;
- 2729 NumColor:=CGANumColor; |
- 2730 VGA : CoreGraph._current_video.adapter:=_VGA;
- 2731 CoreGraph._current_video.memory:=CoreGraph._getmemory();
- 2732 Width := VGAWidth;
- 2733 Depth := VGADepth;
- 2734 NumColor:=EGANumColor; |
- 2735 HGC : CoreGraph._current_video.adapter:=_HGC;
- 2736 CoreGraph._current_video.memory:=64;
- 2737 Width:=HercWidth;
- 2738 Depth:=HercDepth;
- 2739 NumColor:=HercNumColor; |
- 2740 HGCPlus,
- 2741 InColor : CoreGraph._current_video.adapter:=-1; |
- 2742 END; (*CASE*)
- 2743 CASE display.dis0 OF
- 2744 | MDADisplay:
- 2745 CoreGraph._current_video.monitor:=_MONO;
- 2746 | CGADisplay:
- 2747 CoreGraph._current_video.monitor:=_COLOR;
- 2748 | EGAColorDisplay:
- 2749 CoreGraph._current_video.monitor:=_ENHCOLOR;
- 2750 | PS2MonoDisplay:
- 2751 CoreGraph._current_video.monitor:=_MONO;
- 2752 | PS2ColorDisplay:
- 2753 CoreGraph._current_video.monitor:=_ANALOG;
- 2754 END;
- 2755 END InitGraph;
- 2756
- 2757 PROCEDURE TrueDisc(x0,y0,r: CARDINAL; c: CARDINAL);
- 2758 VAR b:CARDINAL;
- 2759 BEGIN
- 2760 IF CoreGraph._width=CGAWidth-1 THEN b := (r*5)DIV 6;
- 2761 ELSIF CoreGraph._depth=EGADepth-1 THEN b := (r*73)DIV 100;
- 2762 ELSE b := r;
- 2763 END;
- 2764 Ellipse (x0,y0,r,b,c,TRUE) ;
- 2765 END TrueDisc;
- 2766
- 2767 PROCEDURE TrueCircle(x0,y0,r: CARDINAL; c: CARDINAL);
- 2768 VAR b:CARDINAL;
- 2769 BEGIN
- 2770 IF CoreGraph._width=CGAWidth-1 THEN b := (r*5)DIV 6;
- 2771 ELSIF CoreGraph._depth=EGADepth-1 THEN b := (r*73)DIV 100;
- 2772 ELSE b := r;
- 2773 END;
- 2774 Ellipse (x0,y0,r,b,c,FALSE) ;
- 2775 END TrueCircle;
- 2776
- 2777 VAR
- 2778 C: PROC;
- 2779
- 2780 PROCEDURE GraphTerminate();
- 2781
- 2782 BEGIN
- 2783 IF (CoreGraph._display_state = TRUE) AND (ModeChanged = TRUE) THEN
- 2784 IF SetVideoMode(_DEFAULTMODE) THEN END;
- 2785 END;
- 2786 C;
- 2787 END GraphTerminate;
- 2788
- 2789 (*%E _XTDDOS *)
- 2790
- 2791 (*%F _XTDDOS *)
- 2792 PROCEDURE GenericGraphMode;
- 2793 VAR r : CARDINAL;
- 2794 BitMap : CARDINAL;
- 2795 BEGIN
- 2796 WHILE GraphI.Virtual DO Lib.Delay(100) END;
- 2797 GraphI.CurMode.b := SIZE(GraphI.CurMode);
- 2798 GraphI.CurMode.col := 80;
- 2799 GraphI.CurMode.row := 25;
- 2800 GraphI.CurMode.hres := Width;
- 2801 GraphI.CurMode.vres := Depth;
- 2802 IF Width<EGAWidth THEN GraphI.CurMode.col := 40 ELSE GraphI.CurMode.col := 80 END;
- 2803 IF Depth<VGADepth THEN GraphI.CurMode.row := 25 ELSE GraphI.CurMode.row := 30 END;
- 2804 IF NumColor=0 THEN GraphI.CurMode.color := 0
- 2805 ELSIF NumColor<=2 THEN GraphI.CurMode.color := 1
- 2806 ELSIF NumColor<=4 THEN GraphI.CurMode.color := 2
- 2807 ELSIF NumColor<=16 THEN GraphI.CurMode.color := 4
- 2808 ELSE GraphI.CurMode.color := 8
- 2809 END;
- 2810 GraphI.CurMode.type := 3;
- 2811 r := Vio.SetMode(GraphI.CurMode,0);
- 2812 Lib.OSFatalError('Vio.SetMode ',r);
- 2813 IF GraphI.IsCGA THEN
- 2814 Lib.FarWordFill(GraphI.Buffer[0],2000H,0);
- 2815 ELSE
- 2816 FOR BitMap := 0 TO GraphI.MaxBitMap DO
- 2817 Lib.FarWordFill(GraphI.Buffer[BitMap],SIZE(GraphI.Buffer[BitMap]^) DIV 2,0);
- 2818 END;
- 2819 END;
- 2820 GraphI.RestoreScreen;
- 2821 GraphI.GraphM := TRUE ;
- 2822 END GenericGraphMode;
- 2823
- 2824 PROCEDURE CGAPlot(x,y:CARDINAL;c:CARDINAL);
- 2825 BEGIN
- 2826 GraphI.CGAPlot(x,y,c);
- 2827 END CGAPlot;
- 2828
- 2829 PROCEDURE CGAPoint(x,y:CARDINAL) : CARDINAL;
- 2830 BEGIN
- 2831 RETURN GraphI.CGAPoint(x,y);
- 2832 END CGAPoint;
- 2833
- 2834 PROCEDURE CGAHLine ( x,y,x2 : CARDINAL; c:CARDINAL );
- 2835 BEGIN
- 2836 GraphI.CGAHLine(x,y,x2,c);
- 2837 END CGAHLine;
- 2838
- 2839 (* == EGA/VGA specific routines == *)
- 2840
- 2841 PROCEDURE EGAPlot( x,y,c : CARDINAL); (* Also VGA *)
- 2842 VAR
- 2843 t:GraphI.BS;
- 2844 p,b,s:CARDINAL;
- 2845 BEGIN
- 2846 GraphI.EGAPlot(x,y,c);
- 2847 END EGAPlot;
- 2848
- 2849 PROCEDURE EGAPoint(x,y:CARDINAL) : CARDINAL; (* Also VGA *)
- 2850 BEGIN
- 2851 RETURN GraphI.EGAPoint(x,y);
- 2852 END EGAPoint;
- 2853
- 2854 PROCEDURE EGAHLine ( x,y,x2 : CARDINAL; c:CARDINAL ); (* Also VGA *)
- 2855 BEGIN
- 2856 GraphI.EGAHLine(x,y,x2,c);
- 2857 END EGAHLine;
- 2858
- 2859 PROCEDURE CGAGraphMode;
- 2860 BEGIN
- 2861 GenericGraphMode;
- 2862 END CGAGraphMode;
- 2863
- 2864 PROCEDURE CGATextMode; (* General Text Mode *)
- 2865 VAR r : CARDINAL;
- 2866 BEGIN
- 2867 WHILE GraphI.Virtual DO Lib.Delay(100) END;
- 2868 GraphI.CurMode.b := VSIZE(Vio.MODEINFO.type);
- 2869 GraphI.CurMode.type := 1;
- 2870 r := Vio.SetMode(GraphI.CurMode,0);
- 2871 GraphI.GraphM := FALSE;
- 2872 END CGATextMode;
- 2873
- 2874 PROCEDURE EGAGraphMode; (* Also VGA *)
- 2875 BEGIN
- 2876 GenericGraphMode;
- 2877 END EGAGraphMode;
- 2878
- 2879 PROCEDURE InitVGA ;
- 2880 BEGIN
- 2881 InitEGA ;
- 2882 Depth := VGADepth ; (* Width same as EGA *)
- 2883 END InitVGA ;
- 2884
- 2885 PROCEDURE Line(x1,y1,x2,y2: CARDINAL; c: CARDINAL);
- 2886 BEGIN
- 2887 GraphI.Line(x1,y1,x2,y2,c);
- 2888 END Line;
- 2889
- 2890 PROCEDURE Disc(x0,y0,r: CARDINAL; c: CARDINAL);
- 2891 BEGIN
- 2892 GraphI.Disc(x0,y0,r,c);
- 2893 END Disc;
- 2894
- 2895 PROCEDURE Circle(x0,y0,r: CARDINAL; c: CARDINAL);
- 2896 BEGIN
- 2897 GraphI.Circle(x0,y0,r,c);
- 2898 END Circle;
- 2899
- 2900 PROCEDURE TrueCircle(x0,y0,r: CARDINAL; c: CARDINAL);
- 2901 VAR b:CARDINAL;
- 2902 BEGIN
- 2903 IF Width=CGAWidth THEN b := (r*5)DIV 6;
- 2904 ELSIF Depth=EGADepth THEN b := (r*73)DIV 100;
- 2905 ELSE b := r;
- 2906 END;
- 2907 Ellipse (x0,y0,r,b,c,FALSE) ;
- 2908 END TrueCircle;
- 2909
- 2910 PROCEDURE TrueDisc(x0,y0,r: CARDINAL; c: CARDINAL);
- 2911 VAR b:CARDINAL;
- 2912 BEGIN
- 2913 IF Width=CGAWidth THEN b := (r*5)DIV 6;
- 2914 ELSIF Depth=EGADepth THEN b := (r*73)DIV 100;
- 2915 ELSE b := r;
- 2916 END;
- 2917 Ellipse (x0,y0,r,b,c,TRUE) ;
- 2918 END TrueDisc;
- 2919
- 2920 PROCEDURE Ellipse ( x0,y0 : CARDINAL ; (* center *)
- 2921 a0,b0 : CARDINAL ; (* semi-axes *)
- 2922 c : CARDINAL ; (* color *)
- 2923 fill : BOOLEAN ) ; (* wether filled *)
- 2924 VAR
- 2925 x,y : CARDINAL ;
- 2926 a,b : LONGINT ;
- 2927 asq,asq2,bsq,bsq2 : LONGINT ;
- 2928 d,dx,dy : LONGINT ;
- 2929 BEGIN
- 2930 x := 0 ;
- 2931 y := b0 ;
- 2932 a := LONGINT(a0) ;
- 2933 b := LONGINT(b0) ;
- 2934 asq := a*a ;
- 2935 asq2 := asq*2 ;
- 2936 bsq := b*b ;
- 2937 bsq2 := bsq*2 ;
- 2938 d := bsq-(asq*b)+(asq DIV 4) ;
- 2939 dx := 0 ;
- 2940 dy := asq2*b ;
- 2941 WHILE dx<dy DO
- 2942 IF fill THEN
- 2943 HLine(x0-x,y0+y,x0+x,c);
- 2944 HLine(x0-x,y0-y,x0+x,c);
- 2945 ELSE
- 2946 Plot(x0+x,y0+y,c) ;
- 2947 Plot(x0-x,y0+y,c) ;
- 2948 Plot(x0+x,y0-y,c) ;
- 2949 Plot(x0-x,y0-y,c) ;
- 2950 END ;
- 2951 IF d>0 THEN
- 2952 DEC(y) ;
- 2953 DEC(dy,asq2) ;
- 2954 DEC(d,dy) ;
- 2955 END ;
- 2956 INC(x) ;
- 2957 INC(dx,bsq2) ;
- 2958 INC(d,bsq+dx) ;
- 2959 END ;
- 2960 INC(d,(3*(asq-bsq)DIV 2-(dx+dy))DIV 2) ;
- 2961 WHILE INTEGER(y)>=0 DO
- 2962 IF fill THEN
- 2963 HLine(x0-x,y0+y,x0+x,c);
- 2964 HLine(x0-x,y0-y,x0+x,c);
- 2965 ELSE
- 2966 Plot(x0+x,y0+y,c) ;
- 2967 Plot(x0-x,y0+y,c) ;
- 2968 Plot(x0+x,y0-y,c) ;
- 2969 Plot(x0-x,y0-y,c) ;
- 2970 END ;
- 2971 IF d<0 THEN
- 2972 INC(x) ;
- 2973 INC(dx,bsq2) ;
- 2974 INC(d,dx) ;
- 2975 END ;
- 2976 DEC(y) ;
- 2977 DEC(dy,asq2) ;
- 2978 INC(d,asq-dy) ;
- 2979 END ;
- 2980 END Ellipse ;
- 2981
- 2982 PROCEDURE Polygon(n: CARDINAL; px,py: ARRAY OF CARDINAL; c: CARDINAL);
- 2983 BEGIN
- 2984 GraphI.Polygon(n,px,py,c);
- 2985 END Polygon;
- 2986
- 2987
- 2988 VAR
- 2989 SwapStack : ARRAY [0..1023] OF BYTE;
- 2990 SwapThread : CARDINAL;
- 2991
- 2992 PROCEDURE SwapProcess;
- 2993 VAR r,action,svs : CARDINAL;
- 2994 BEGIN
- 2995 GraphI.Virtual := FALSE;
- 2996 Lib.OSFatalError('Dos.SetPrty',
- 2997 Dos.SetPrty(2,3,0,SwapThread));
- 2998 LOOP
- 2999 Lib.OSFatalError('Vio.SavRedrawWait',
- 3000 Vio.SavRedrawWait(0,action,0));
- 3001 IF GraphI.GraphM THEN
- 3002 IF (action=1)AND GraphI.Virtual THEN (* restore *)
- 3003 Dos.EnterCritSec;
- 3004 GraphI.VideoSel := svs;
- 3005 GraphI.Virtual := FALSE;
- 3006 GraphI.RestoreScreen;
- 3007 Dos.ExitCritSec;
- 3008 r := Vio.SetMode(GraphI.CurMode,0);
- 3009 ELSIF (action=0)AND NOT GraphI.Virtual THEN (* save *)
- 3010 Dos.EnterCritSec;
- 3011 svs := GraphI.VideoSel;
- 3012 GraphI.SaveScreen;
- 3013 GraphI.VideoSel := SYSTEM.Seg(GraphI.Buffer[0]^);
- 3014 GraphI.Virtual := TRUE;
- 3015 Dos.ExitCritSec;
- 3016 Lib.Delay(100); (* wait for pending operations to finish *)
- 3017 END;
- 3018 END;
- 3019 END;
- 3020 END SwapProcess;
- 3021
- 3022
- 3023 PROCEDURE GraphMode;
- 3024
- 3025 BEGIN
- 3026 GraphI.G_GraphMode;
- 3027 END GraphMode;
- 3028
- 3029 PROCEDURE TextMode;
- 3030 BEGIN
- 3031 GraphI.G_TextMode;
- 3032 END TextMode;
- 3033
- 3034
- 3035 PROCEDURE InitCGA ;
- 3036 VAR
- 3037 r : CARDINAL;
- 3038 sl : Vio.PHYSBUF;
- 3039 BEGIN
- 3040 sl.bufaddr := 0B8000H;
- 3041 sl.buflen := 004000H;
- 3042 r := Vio.GetPhysBuf(sl,0);
- 3043 GraphI.VideoSel := sl.sel[0];
- 3044 Width := CGAWidth ;
- 3045 Depth := CGADepth ;
- 3046 NumColor := 4 ;
- 3047 GraphI.G_TextMode := CGATextMode ;
- 3048 GraphI.G_GraphMode := CGAGraphMode ;
- 3049 GraphI.G_Plot := CGAPlot ;
- 3050 GraphI.G_Point := CGAPoint ;
- 3051 GraphI.G_HLine := CGAHLine ;
- 3052 IF GraphI.Buffer[0]=FarNIL THEN
- 3053 Storage.FarAllocate(GraphI.Buffer[0], GraphI.BitMapSize);
- 3054 END;
- 3055 GraphI.IsCGA := TRUE;
- 3056 END InitCGA ;
- 3057
- 3058
- 3059 PROCEDURE InitEGA ;
- 3060 VAR
- 3061 BitMap : CARDINAL;
- 3062 r : CARDINAL;
- 3063 sl : Vio.PHYSBUF;
- 3064 BEGIN
- 3065 FOR BitMap := 0 TO GraphI.MaxBitMap DO
- 3066 IF GraphI.Buffer[BitMap]=FarNIL THEN
- 3067 Storage.FarAllocate(GraphI.Buffer[BitMap], GraphI.BitMapSize);
- 3068 END;
- 3069 END;
- 3070 sl.bufaddr := 0A0000H;
- 3071 sl.buflen := 010000H;
- 3072 r := Vio.GetPhysBuf(sl,0);
- 3073 GraphI.VideoSel := sl.sel[0];
- 3074 Width := EGAWidth ;
- 3075 Depth := EGADepth ;
- 3076 Depth := EGADepth;
- 3077 NumColor := 16 ;
- 3078 GraphI.G_TextMode := CGATextMode ;
- 3079 GraphI.G_GraphMode := EGAGraphMode ;
- 3080 GraphI.G_Plot := EGAPlot ;
- 3081 GraphI.G_Point := EGAPoint ;
- 3082 GraphI.G_HLine := EGAHLine ;
- 3083 GraphI.IsCGA := FALSE;
- 3084 END InitEGA ;
- 3085
- 3086
- 3087 PROCEDURE Plot(x,y: CARDINAL; Color: CARDINAL);
- 3088
- 3089 BEGIN
- 3090 GraphI.G_Plot(x, y, Color);
- 3091 END Plot;
- 3092
- 3093
- 3094 PROCEDURE Point(x,y: CARDINAL) : CARDINAL;
- 3095
- 3096 BEGIN
- 3097 RETURN GraphI.G_Point(x, y);
- 3098 END Point;
- 3099
- 3100
- 3101 PROCEDURE HLine(x,y,x2: CARDINAL; FillColor: CARDINAL);
- 3102
- 3103 BEGIN
- 3104 GraphI.G_HLine(x, y, x2, FillColor);
- 3105 END HLine;
- 3106
- 3107
- 3108 PROCEDURE NotSupported(Func: ARRAY OF CHAR);
- 3109
- 3110 VAR
- 3111 Msg: ARRAY [0..79] OF CHAR;
- 3112 BEGIN
- 3113 Str.Concat(Msg, Func, ': Not Supported Under OS2.');
- 3114 Lib.RunTimeError(CoreSig._FatalErrorPos(), 0D1H, Msg);
- 3115 END NotSupported;
- 3116
- 3117 PROCEDURE GetVideoConfig(VAR V: VideoConfig);
- 3118
- 3119 BEGIN
- 3120 NotSupported('GetVideoConfig');
- 3121 END GetVideoConfig;
- 3122
- 3123 PROCEDURE SetClipRgn(x1, y1, x2, y2: CARDINAL);
- 3124
- 3125 BEGIN
- 3126 NotSupported('SetClipRgn');
- 3127 END SetClipRgn;
- 3128
- 3129 PROCEDURE GetBkColor(): LONGCARD;
- 3130
- 3131 BEGIN
- 3132 NotSupported('GetBkColor');
- 3133 RETURN 0;
- 3134 END GetBkColor;
- 3135
- 3136 PROCEDURE GetFillMask(VAR Mask: FillMaskType);
- 3137
- 3138 BEGIN
- 3139 NotSupported('GetFillMask');
- 3140 END GetFillMask;
- 3141
- 3142 PROCEDURE GetLinestyle(): CARDINAL;
- 3143
- 3144 BEGIN
- 3145 NotSupported( 'GetLineStyle');
- 3146 RETURN 0;
- 3147 END GetLinestyle;
- 3148
- 3149 PROCEDURE SetBkColor(Color: LONGCARD): LONGCARD;
- 3150
- 3151 BEGIN
- 3152 NotSupported( 'SetBkColor');
- 3153 RETURN 0;
- 3154 END SetBkColor;
- 3155
- 3156 PROCEDURE SetFillMask(Mask: FillMaskType);
- 3157
- 3158 BEGIN
- 3159 NotSupported( 'SetFillMask');
- 3160 END SetFillMask;
- 3161
- 3162 PROCEDURE SetLinestyle(Mask: CARDINAL);
- 3163
- 3164 BEGIN
- 3165 NotSupported( 'SetLinestyle');
- 3166 END SetLinestyle;
- 3167
- 3168 PROCEDURE GetTextColor(): CARDINAL;
- 3169
- 3170 BEGIN
- 3171 NotSupported( 'GetTextColor');
- 3172 RETURN 0;
- 3173 END GetTextColor;
- 3174
- 3175 PROCEDURE GetTextPosition(): TextCoords;
- 3176
- 3177 BEGIN
- 3178 NotSupported( 'GetTextPosition');
- 3179 RETURN TextCoords(0,0);
- 3180 END GetTextPosition;
- 3181
- 3182 PROCEDURE DisplayCursor(Mode: BOOLEAN): BOOLEAN;
- 3183
- 3184 BEGIN
- 3185 NotSupported( 'DisplayCursor');
- 3186 RETURN FALSE;
- 3187 END DisplayCursor;
- 3188
- 3189 PROCEDURE SetTextPosition(row, col: CARDINAL): TextCoords;
- 3190
- 3191 BEGIN
- 3192 NotSupported( 'SetTextPosition');
- 3193 RETURN TextCoords(0,0);
- 3194 END SetTextPosition;
- 3195
- 3196 PROCEDURE SetTextWindow(r1, c1, r2, c2: CARDINAL);
- 3197
- 3198 BEGIN
- 3199 NotSupported( 'SetTextWindow');
- 3200 END SetTextWindow;
- 3201
- 3202 PROCEDURE Wrapon(Opt: BOOLEAN): BOOLEAN;
- 3203
- 3204 BEGIN
- 3205 NotSupported( 'Wrapon');
- 3206 RETURN FALSE;
- 3207 END Wrapon;
- 3208
- 3209 PROCEDURE OutText(Text: ARRAY OF CHAR);
- 3210
- 3211 BEGIN
- 3212 NotSupported( 'OutText');
- 3213 END OutText;
- 3214
- 3215 PROCEDURE SetVideoMode(Mode: CARDINAL): BOOLEAN;
- 3216
- 3217 BEGIN
- 3218 NotSupported( 'SetVideoMode');
- 3219 RETURN FALSE;
- 3220 END SetVideoMode;
- 3221
- 3222 PROCEDURE SetActivePage(Page: CARDINAL): CARDINAL;
- 3223
- 3224 BEGIN
- 3225 NotSupported('SetActivePage');
- 3226 RETURN 0;
- 3227 END SetActivePage;
- 3228
- 3229 PROCEDURE SetVisualPage(Page: CARDINAL): CARDINAL;
- 3230
- 3231 BEGIN
- 3232 NotSupported( 'SetVisualPage');
- 3233 RETURN 0;
- 3234 END SetVisualPage;
- 3235
- 3236 PROCEDURE ClearScreen(Area: CARDINAL);
- 3237
- 3238 BEGIN
- 3239 NotSupported( 'ClearScreen');
- 3240 END ClearScreen;
- 3241
- 3242 PROCEDURE Rectangle(x1, y1, x2, y2: CARDINAL; Color: CARDINAL;Fill: BOOLEAN);
- 3243
- 3244 BEGIN
- 3245 NotSupported( 'Rectangle');
- 3246 END Rectangle;
- 3247
- 3248 PROCEDURE Arc(x1, y1, x2, y2, x3, y3, x4, y4: CARDINAL; Color: CARDINAL);
- 3249
- 3250 BEGIN
- 3251 NotSupported( 'Arc');
- 3252 END Arc;
- 3253
- 3254 PROCEDURE Pie(x1, y1, x2, y2, x3, y3, x4, y4: CARDINAL; Colr: CARDINAL; Fill: BOOLEAN);
- 3255
- 3256 BEGIN
- 3257 NotSupported( 'Pie');
- 3258 END Pie;
- 3259
- 3260 PROCEDURE FloodFill(x, y: CARDINAL; Color: CARDINAL; Boundary: CARDINAL);
- 3261
- 3262 BEGIN
- 3263 NotSupported( 'FloodFill');
- 3264 END FloodFill;
- 3265
- 3266 PROCEDURE StackFill(x, y: CARDINAL; Color: CARDINAL; Boundary: CARDINAL);
- 3267
- 3268 BEGIN
- 3269 NotSupported( 'StackFill');
- 3270 END StackFill;
- 3271
- 3272 PROCEDURE RemapPalette(Pixel: CARDINAL; Color: LONGCARD): LONGCARD;
- 3273
- 3274 BEGIN
- 3275 NotSupported( 'RemapPalette');
- 3276 RETURN 0;
- 3277 END RemapPalette;
- 3278
- 3279 PROCEDURE RemapAllPalette(Colarray: ARRAY OF LONGCARD): CARDINAL;
- 3280
- 3281 BEGIN
- 3282 NotSupported( 'RemapAllPalette');
- 3283 RETURN 0;
- 3284 END RemapAllPalette;
- 3285
- 3286 PROCEDURE SelectPalette(Palnum: CARDINAL): CARDINAL;
- 3287
- 3288 BEGIN
- 3289 NotSupported( 'SelectPalette');
- 3290 RETURN 0;
- 3291 END SelectPalette;
- 3292
- 3293 PROCEDURE GetImage(x1, y1, x2, y2: CARDINAL; Buffer: ADDRESS);
- 3294
- 3295 BEGIN
- 3296 NotSupported( 'GetImage');
- 3297 END GetImage;
- 3298
- 3299 PROCEDURE PutImage(x, y: CARDINAL; Buffer: ADDRESS; Action: CARDINAL);
- 3300
- 3301 BEGIN
- 3302 NotSupported( 'PutImage');
- 3303 END PutImage;
- 3304
- 3305 PROCEDURE ImageSize(x1, y1, x2, y2: CARDINAL): LONGCARD;
- 3306
- 3307 BEGIN
- 3308 NotSupported( 'ImageSize');
- 3309 RETURN 0;
- 3310 END ImageSize;
- 3311
- 3312 PROCEDURE Cube(top: BOOLEAN; x1, y1, x2, y2, depth: CARDINAL; Color: CARDINAL; Fill: BOOLEAN);
- 3313
- 3314 BEGIN
- 3315 NotSupported( 'Cube');
- 3316 END Cube;
- 3317
- 3318 PROCEDURE InitHerc();
- 3319
- 3320 BEGIN
- 3321 NotSupported( 'InitHerc');
- 3322 END InitHerc;
- 3323
- 3324 PROCEDURE InitGraph();
- 3325
- 3326 BEGIN
- 3327 NotSupported( 'InitGraph');
- 3328 END InitGraph;
- 3329
- 3330 PROCEDURE SetTextColor(Col: CARDINAL): CARDINAL;
- 3331
- 3332 BEGIN
- 3333 NotSupported( 'SetTextColor');
- 3334 RETURN 0;
- 3335 END SetTextColor;
- 3336
- 3337 PROCEDURE Init;
- 3338 VAR
- 3339 i,r : CARDINAL;
- 3340 BEGIN
- 3341 GraphI.GraphM := FALSE;
- 3342 r := Dos.CreateThread(Dos.THREAD(SwapProcess),SwapThread,FarADR(SwapStack[HIGH(SwapStack)]));
- 3343 FOR i := 0 TO 4 DO
- 3344 GraphI.Buffer[i] := FarNIL;
- 3345 END;
- 3346 InitCGA;
- 3347 END Init;
- 3348
- 3349 (*%E _XTDDOS *)
- 3350
- 3351 BEGIN (*Initialization*)
- 3352 (*%T _XTDDOS *)
- 3353 (*%T _XTD *)
- 3354 TSXLIB.InitInt10;
- 3355 (*%E *)
- 3356 (*%T AutoDetect *)
- 3357 InitGraph();
- 3358 (*%E *)
- 3359 (*%F AutoDetect *)
- 3360 InitCGA;
- 3361 (*%E *)
- 3362 Lib.Terminate(GraphTerminate, C);
- 3363 FillState:=_GFILLINTERIOR;
- 3364 ModeChanged := FALSE;
- 3365 EGATable := EGATableType( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15);
- 3366 (*%E *)
- 3367 (*%F _XTDDOS *)
- 3368 (*%F _fcall *)
- 3369 IO.WrStr('OS/2 Graphics Not Supported In This Model.');
- 3370 IO.WrLn;
- 3371 HALT;
- 3372 (*%E *)
- 3373 Init;
- 3374 (*%E _XTDDOS *)
- 3375 END Graph.
- 720 errors
|
