vesa.inc 106 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2000 by Carl Eric Codere
  4. This include implements VESA basic access.
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. type
  12. palrec = packed record { record used for set/get DAC palette }
  13. blue, green, red, align: byte;
  14. end;
  15. const
  16. { VESA attributes }
  17. attrSwitchDAC = $01; { DAC is switchable (1.2) }
  18. attrNotVGACompatible = $02; { Video is NOT VGA compatible (2.0) }
  19. attrSnowCheck = $04; { Video must use snow checking(2.0) }
  20. { mode attribute bits }
  21. modeAvail = $01; { Hardware supports this mode (1.0) }
  22. modeExtendInfo = $02; { Extended information (1.0) }
  23. modeBIOSSupport = $04; { TTY BIOS Support (1.0) }
  24. modeColor = $08; { This is a color mode (1.0) }
  25. modeGraphics = $10; { This is a graphics mode (1.0) }
  26. modeNotVGACompatible = $20; { this mode is NOT I/O VGA compatible (2.0)}
  27. modeNoWindowed = $40; { This mode does not support Windows (2.0) }
  28. modeLinearBuffer = $80; { This mode supports linear buffers (2.0) }
  29. { window attributes }
  30. winSupported = $01;
  31. winReadable = $02;
  32. winWritable = $04;
  33. { memory model }
  34. modelText = $00;
  35. modelCGA = $01;
  36. modelHerc = $02;
  37. model4plane = $03;
  38. modelPacked = $04;
  39. modelModeX = $05;
  40. modelRGB = $06;
  41. modelYUV = $07;
  42. {$ifndef dpmi}
  43. {$i vesah.inc}
  44. { otherwise it's already included in graph.pp }
  45. {$endif dpmi}
  46. var
  47. BytesPerLine: word; { Number of bytes per scanline }
  48. YOffset : word; { Pixel offset for VESA page flipping }
  49. { window management }
  50. ReadWindow : byte; { Window number for reading. }
  51. WriteWindow: byte; { Window number for writing. }
  52. winReadSeg : word; { Address of segment for read }
  53. winWriteSeg: word; { Address of segment for writes}
  54. CurrentReadBank : smallint; { active read bank }
  55. CurrentWriteBank: smallint; { active write bank }
  56. BankShift : word; { address to shift by when switching banks. }
  57. { linear mode specific stuff }
  58. InLinear : boolean; { true if in linear mode }
  59. LinearPageOfs : longint; { offset used to set active page }
  60. FrameBufferLinearAddress : dword;
  61. ScanLines: word; { maximum number of scan lines for mode }
  62. {$IFDEF DPMI}
  63. function getVESAInfo(var VESAInfo: TVESAInfo) : boolean;
  64. var
  65. ptrlong : longint;
  66. VESAPtr : ^TVESAInfo;
  67. st : string[4];
  68. regs : TDPMIRegisters;
  69. { added... }
  70. modelist: PmodeList;
  71. i: longint;
  72. RealSeg : word;
  73. begin
  74. { Allocate real mode buffer }
  75. Ptrlong:=Global_Dos_Alloc(sizeof(TVESAInfo));
  76. New(VESAPtr);
  77. { Get segment value }
  78. RealSeg := word(Ptrlong shr 16);
  79. if not assigned(VESAPtr) then
  80. RunError(203);
  81. FillChar(regs, sizeof(regs), #0);
  82. { Get VESA Mode information ... }
  83. regs.eax := $4f00;
  84. regs.es := RealSeg;
  85. regs.edi := $00;
  86. RealIntr($10, regs);
  87. { no far pointer support in FPC yet, so move the vesa info into a memory }
  88. { block in the DS slector space (JM) }
  89. dosmemget(RealSeg,0,VesaPtr^,SizeOf(TVESAInfo));
  90. St:=Vesaptr^.signature;
  91. if st<>'VESA' then
  92. begin
  93. {$ifdef logging}
  94. LogLn('No VESA detected.');
  95. {$endif logging}
  96. getVesaInfo := FALSE;
  97. If not Global_Dos_Free(word(PtrLong and $ffff)) then
  98. RunError(216);
  99. { also free the extra allocated buffer }
  100. Dispose(VESAPtr);
  101. exit;
  102. end
  103. else
  104. getVesaInfo := TRUE;
  105. { No far pointer support, so the Ptr(ModeSel, 0) doesn't work. }
  106. { Immediately copy everything to a buffer in the DS selector space }
  107. New(ModeList);
  108. { The following may copy data from outside the VESA buffer, but it }
  109. { shouldn't get past the 1MB limit, since that would mean the buffer }
  110. { has been allocated in the BIOS or high memory region, which seems }
  111. { impossible to me (JM)}
  112. DosMemGet(word(longint(VESAPtr^.ModeList) shr 16),
  113. word(longint(VESAPtr^.ModeList) and $ffff), ModeList^,256*sizeof(word));
  114. { copy VESA mode information to a protected mode buffer and }
  115. { then free the real mode buffer... }
  116. Move(VESAPtr^, VESAInfo, sizeof(VESAInfo));
  117. If not Global_Dos_Free(word(PtrLong and $ffff)) then
  118. RunError(216);
  119. Dispose(VESAPtr);
  120. i:=0;
  121. new(VESAInfo.ModeList);
  122. while ModeList^[i]<> $ffff do
  123. begin
  124. {$ifdef logging}
  125. LogLn('Found mode $'+hexstr(ModeList^[i],4));
  126. {$endif loggin}
  127. VESAInfo.ModeList^[i] := ModeList^[i];
  128. Inc(i);
  129. end;
  130. VESAInfo.ModeList^[i]:=$ffff;
  131. { Free the temporary selector used to get mode information }
  132. {$ifdef logging}
  133. LogLn(strf(i) + ' modes found.');
  134. {$endif logging}
  135. Dispose(ModeList);
  136. end;
  137. function getVESAModeInfo(var ModeInfo: TVESAModeInfo;mode:word):boolean;
  138. var
  139. Ptr: longint;
  140. regs : TDPMIRegisters;
  141. RealSeg: word;
  142. begin
  143. { Alllocate real mode buffer }
  144. Ptr:=Global_Dos_Alloc(sizeof(TVESAModeInfo));
  145. { get the segment value }
  146. RealSeg := word(Ptr shr 16);
  147. { we have to init everything to zero, since VBE < 1.1 }
  148. { may not setup fields correctly. }
  149. DosMemFillChar(RealSeg, 0, sizeof(ModeInfo), #0);
  150. { setup interrupt registers }
  151. FillChar(regs, sizeof(regs), #0);
  152. { call VESA mode information...}
  153. regs.eax := $4f01;
  154. regs.es := RealSeg;
  155. regs.edi := $00;
  156. regs.ecx := mode;
  157. RealIntr($10, regs);
  158. if word(regs.eax) <> $4f then
  159. getVESAModeInfo := FALSE
  160. else
  161. getVESAModeInfo := TRUE;
  162. { copy to protected mode buffer ... }
  163. DosMemGet(RealSeg,0,ModeInfo,sizeof(ModeInfo));
  164. { free real mode memory }
  165. If not Global_Dos_Free(Word(Ptr and $ffff)) then
  166. RunError(216);
  167. end;
  168. {$ELSE}
  169. function getVESAInfo(var VESAInfo: TVESAInfo) : boolean; assembler;
  170. asm
  171. mov ax,4F00h
  172. les di,VESAInfo
  173. int 10h
  174. sub ax,004Fh {make sure we got 004Fh back}
  175. cmp ax,1
  176. sbb al,al
  177. cmp word ptr es:[di],'V'or('E'shl 8) {signature should be 'VESA'}
  178. jne @@ERR
  179. cmp word ptr es:[di+2],'S'or('A'shl 8)
  180. je @@X
  181. @@ERR:
  182. mov al,0
  183. @@X:
  184. end;
  185. function getVESAModeInfo(var ModeInfo: TVESAModeInfo;mode:word):boolean;assembler;
  186. asm
  187. mov ax,4F01h
  188. mov cx,mode
  189. les di,ModeInfo
  190. int 10h
  191. sub ax,004Fh {make sure it's 004Fh}
  192. cmp ax,1
  193. sbb al,al
  194. end;
  195. {$ENDIF}
  196. function SearchVESAModes(mode: Word): boolean;
  197. {********************************************************}
  198. { Searches for a specific DEFINED vesa mode. If the mode }
  199. { is not available for some reason, then returns FALSE }
  200. { otherwise returns TRUE. }
  201. {********************************************************}
  202. var
  203. i: word;
  204. ModeSupported : Boolean;
  205. begin
  206. i:=0;
  207. { let's assume it's not available ... }
  208. ModeSupported := FALSE;
  209. { This is a STUB VESA implementation }
  210. if VESAInfo.ModeList^[0] = $FFFF then exit;
  211. repeat
  212. if VESAInfo.ModeList^[i] = mode then
  213. begin
  214. { we found it, the card supports this mode... }
  215. ModeSupported := TRUE;
  216. break;
  217. end;
  218. Inc(i);
  219. until VESAInfo.ModeList^[i] = $ffff;
  220. { now check if the hardware supports it... }
  221. If ModeSupported then
  222. begin
  223. { we have to init everything to zero, since VBE < 1.1 }
  224. { may not setup fields correctly. }
  225. { bugfix: for DPMI this is now done in GetVESAModeInfo }
  226. {$IFNDEF DPMI}
  227. FillChar(VESAModeInfo, sizeof(VESAModeInfo), #0);
  228. {$ENDIF}
  229. If GetVESAModeInfo(VESAModeInfo, Mode) And
  230. ((VESAModeInfo.attr and modeAvail) <> 0) then
  231. ModeSupported := TRUE
  232. else
  233. ModeSupported := FALSE;
  234. end;
  235. SearchVESAModes := ModeSupported;
  236. end;
  237. procedure SetBankIndex(win: byte; BankNr: smallint);
  238. {I don't know why but the previous assembler version changed by some mechanism
  239. unknown to me some places in memory what lead to changing some variables not
  240. belonging to this procedure (Laaca)}
  241. var r:TDPMIregisters;
  242. begin
  243. r.ax:=$4f05;
  244. r.bx:=win;
  245. r.dx:=BankNr;
  246. RealIntr($10,r);
  247. end;
  248. {********************************************************}
  249. { There are two routines for setting banks. This may in }
  250. { in some cases optimize a bit some operations, if the }
  251. { hardware supports it, because one window is used for }
  252. { reading and one window is used for writing. }
  253. {********************************************************}
  254. procedure SetReadBank(BankNr: smallint);
  255. begin
  256. { check if this is the current bank... if so do nothing. }
  257. if BankNr = CurrentReadBank then exit;
  258. {$ifdef logging}
  259. { LogLn('Setting read bank to '+strf(BankNr));}
  260. {$endif logging}
  261. CurrentReadBank := BankNr; { save current bank number }
  262. BankNr := BankNr shl BankShift; { adjust to window granularity }
  263. { we set both banks, since one may read only }
  264. SetBankIndex(ReadWindow, BankNr);
  265. { if the hardware supports only one window }
  266. { then there is only one single bank, so }
  267. { update both bank numbers. }
  268. if ReadWindow = WriteWindow then
  269. CurrentWriteBank := CurrentReadBank;
  270. end;
  271. procedure SetWriteBank(BankNr: smallint);
  272. begin
  273. { check if this is the current bank... if so do nothing. }
  274. if BankNr = CurrentWriteBank then exit;
  275. {$ifdef logging}
  276. { LogLn('Setting write bank to '+strf(BankNr));}
  277. {$endif logging}
  278. CurrentWriteBank := BankNr; { save current bank number }
  279. BankNr := BankNr shl BankShift; { adjust to window granularity }
  280. { we set both banks, since one may read only }
  281. SetBankIndex(WriteWindow, BankNr);
  282. { if the hardware supports only one window }
  283. { then there is only one single bank, so }
  284. { update both bank numbers. }
  285. if ReadWindow = WriteWindow then
  286. CurrentReadBank := CurrentWriteBank;
  287. end;
  288. {************************************************************************}
  289. {* 8-bit pixels VESA mode routines *}
  290. {************************************************************************}
  291. procedure PutPixVESA256(x, y : smallint; color : word);
  292. var
  293. offs : longint;
  294. begin
  295. X:= X + StartXViewPort;
  296. Y:= Y + StartYViewPort;
  297. { convert to absolute coordinates and then verify clipping...}
  298. if ClipPixels then
  299. Begin
  300. if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
  301. exit;
  302. if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
  303. exit;
  304. end;
  305. Y := Y + YOffset; { adjust pixel for correct virtual page }
  306. offs := longint(y) * BytesPerLine + x;
  307. begin
  308. SetWriteBank(smallint(offs shr 16));
  309. mem[WinWriteSeg : word(offs)] := byte(color);
  310. end;
  311. end;
  312. procedure DirectPutPixVESA256(x, y : smallint);
  313. var
  314. offs : longint;
  315. col : byte;
  316. begin
  317. offs := (longint(y) + YOffset) * BytesPerLine + x;
  318. Case CurrentWriteMode of
  319. XorPut:
  320. Begin
  321. SetReadBank(smallint(offs shr 16));
  322. col := mem[WinReadSeg : word(offs)] xor byte(CurrentColor);
  323. End;
  324. AndPut:
  325. Begin
  326. SetReadBank(smallint(offs shr 16));
  327. col := mem[WinReadSeg : word(offs)] And byte(CurrentColor);
  328. End;
  329. OrPut:
  330. Begin
  331. SetReadBank(smallint(offs shr 16));
  332. col := mem[WinReadSeg : word(offs)] or byte(currentcolor);
  333. End
  334. else
  335. Begin
  336. If CurrentWriteMode <> NotPut then
  337. col := Byte(CurrentColor)
  338. else col := Not(Byte(CurrentColor));
  339. End
  340. End;
  341. SetWriteBank(smallint(offs shr 16));
  342. mem[WinWriteSeg : word(offs)] := Col;
  343. end;
  344. function GetPixVESA256(x, y : smallint): word;
  345. var
  346. offs : longint;
  347. begin
  348. X:= X + StartXViewPort;
  349. Y:= Y + StartYViewPort + YOffset;
  350. offs := longint(y) * BytesPerLine + x;
  351. SetReadBank(smallint(offs shr 16));
  352. GetPixVESA256:=mem[WinReadSeg : word(offs)];
  353. end;
  354. Procedure GetScanLineVESA256(x1, x2, y: smallint; var data);
  355. var offs: Longint;
  356. l, amount, bankrest, index, pixels: longint;
  357. curbank: smallint;
  358. begin
  359. inc(x1,StartXViewPort);
  360. inc(x2,StartXViewPort);
  361. {$ifdef logging}
  362. LogLn('getscanline256 '+strf(x1)+' - '+strf(x2)+' at '+strf(y+StartYViewPort));
  363. {$endif logging}
  364. index := 0;
  365. amount := x2-x1+1;
  366. Offs:=(Longint(y)+StartYViewPort+YOffset)*bytesperline+x1;
  367. Repeat
  368. curbank := smallint(offs shr 16);
  369. SetReadBank(curbank);
  370. {$ifdef logging}
  371. LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
  372. {$endif logging}
  373. If ((amount >= 4) and
  374. ((offs and 3) = 0)) or
  375. (amount >= 4+4-(offs and 3)) Then
  376. { align target }
  377. Begin
  378. If (offs and 3) <> 0 then
  379. { this cannot go past a window boundary bacause the }
  380. { size of a window is always a multiple of 4 }
  381. Begin
  382. {$ifdef logging}
  383. LogLn('Aligning by reading '+strf(4-(offs and 3))+' pixels');
  384. {$endif logging}
  385. for l := 1 to 4-(offs and 3) do
  386. WordArray(Data)[index+l-1] :=
  387. Mem[WinReadSeg:word(offs)+l-1];
  388. inc(index, l);
  389. inc(offs, l);
  390. dec(amount, l);
  391. End;
  392. {$ifdef logging}
  393. LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount));
  394. {$endif logging}
  395. { offs is now 4-bytes aligned }
  396. If amount <= ($10000-(Offs and $ffff)) Then
  397. bankrest := amount
  398. else {the rest won't fit anymore in the current window }
  399. bankrest := $10000 - (Offs and $ffff);
  400. { it is possible that by aligning, we ended up in a new }
  401. { bank, so set the correct bank again to make sure }
  402. setreadbank(offs shr 16);
  403. {$ifdef logging}
  404. LogLn('Rest to be read from this window: '+strf(bankrest));
  405. {$endif logging}
  406. For l := 0 to (Bankrest div 4)-1 Do
  407. begin
  408. pixels := MemL[WinReadSeg:word(offs)+l*4];
  409. WordArray(Data)[index+l*4] := pixels and $ff;
  410. pixels := pixels shr 8;
  411. WordArray(Data)[index+l*4+1] := pixels and $ff;
  412. pixels := pixels shr 8;
  413. WordArray(Data)[index+l*4+2] := pixels and $ff;
  414. pixels := pixels shr 8;
  415. WordArray(Data)[index+l*4+3] := pixels{ and $ff};
  416. end;
  417. inc(index,l*4+4);
  418. inc(offs,l*4+4);
  419. dec(amount,l*4+4);
  420. {$ifdef logging}
  421. LogLn('Offset is now '+hexstr(offs,8)+', amount left: '+strf(amount));
  422. {$endif logging}
  423. End
  424. Else
  425. Begin
  426. {$ifdef logging}
  427. LogLn('Leftover: '+strf(amount)+' at offset '+hexstr(offs,8));
  428. {$endif logging}
  429. For l := 0 to amount - 1 do
  430. begin
  431. { this may cross a bank at any time, so adjust }
  432. { because this loop alwys runs for very little pixels, }
  433. { there's little gained by splitting it up }
  434. setreadbank(offs shr 16);
  435. WordArray(Data)[index+l] := mem[WinReadSeg:word(offs)];
  436. inc(offs);
  437. end;
  438. amount := 0
  439. End
  440. Until amount = 0;
  441. end;
  442. procedure HLineVESA256(x,x2,y: smallint);
  443. var Offs: Longint;
  444. mask, l, bankrest: longint;
  445. curbank, hlength: smallint;
  446. Begin
  447. { must we swap the values? }
  448. if x > x2 then
  449. Begin
  450. x := x xor x2;
  451. x2 := x xor x2;
  452. x:= x xor x2;
  453. end;
  454. { First convert to global coordinates }
  455. X := X + StartXViewPort;
  456. X2 := X2 + StartXViewPort;
  457. Y := Y + StartYViewPort;
  458. if ClipPixels then
  459. Begin
  460. if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
  461. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  462. exit;
  463. end;
  464. {$ifdef logging2}
  465. LogLn('hline '+strf(x)+' - '+strf(x2)+' on '+strf(y)+' in mode '+strf(currentwritemode));
  466. {$endif logging2}
  467. HLength := x2 - x + 1;
  468. {$ifdef logging2}
  469. LogLn('length: '+strf(hlength));
  470. {$endif logging2}
  471. if HLength>0 then
  472. begin
  473. Offs:=(Longint(y)+YOffset)*bytesperline+x;
  474. {$ifdef logging2}
  475. LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
  476. {$endif logging2}
  477. Mask := byte(CurrentColor)+byte(CurrentColor) shl 8;
  478. Mask := Mask + Mask shl 16;
  479. Case CurrentWriteMode of
  480. AndPut:
  481. Begin
  482. Repeat
  483. curbank := smallint(offs shr 16);
  484. SetWriteBank(curbank);
  485. SetReadBank(curbank);
  486. {$ifdef logging2}
  487. LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
  488. {$endif logging2}
  489. If ((HLength >= 4) and
  490. ((offs and 3) = 0)) or
  491. (HLength >= 4+4-(offs and 3)) Then
  492. { align target }
  493. Begin
  494. If (offs and 3) <> 0 then
  495. { this cannot go past a window boundary bacause the }
  496. { size of a window is always a multiple of 4 }
  497. Begin
  498. {$ifdef logging2}
  499. LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
  500. {$endif logging2}
  501. for l := 1 to 4-(offs and 3) do
  502. Mem[WinWriteSeg:word(offs)+l-1] :=
  503. Mem[WinReadSeg:word(offs)+l-1] And Byte(CurrentColor);
  504. Dec(HLength, l);
  505. inc(offs, l);
  506. End;
  507. {$ifdef logging2}
  508. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
  509. {$endif logging}
  510. { offs is now 4-bytes aligned }
  511. If HLength <= ($10000-(Offs and $ffff)) Then
  512. bankrest := HLength
  513. else {the rest won't fit anymore in the current window }
  514. bankrest := $10000 - (Offs and $ffff);
  515. { it is possible that by aligningm we ended up in a new }
  516. { bank, so set the correct bank again to make sure }
  517. setwritebank(offs shr 16);
  518. setreadbank(offs shr 16);
  519. {$ifdef logging2}
  520. LogLn('Rest to be drawn in this window: '+strf(bankrest));
  521. {$endif logging}
  522. For l := 0 to (Bankrest div 4)-1 Do
  523. MemL[WinWriteSeg:word(offs)+l*4] :=
  524. MemL[WinReadSeg:word(offs)+l*4] And Mask;
  525. inc(offs,l*4+4);
  526. dec(hlength,l*4+4);
  527. {$ifdef logging2}
  528. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
  529. {$endif logging}
  530. End
  531. Else
  532. Begin
  533. {$ifdef logging2}
  534. LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
  535. {$endif logging}
  536. For l := 0 to HLength - 1 do
  537. begin
  538. { this may cross a bank at any time, so adjust }
  539. { becauese this loop alwys runs for very little pixels, }
  540. { there's little gained by splitting it up }
  541. setreadbank(offs shr 16);
  542. setwritebank(offs shr 16);
  543. Mem[WinWriteSeg:word(offs)] :=
  544. Mem[WinReadSeg:word(offs)] And byte(currentColor);
  545. inc(offs);
  546. end;
  547. HLength := 0
  548. End
  549. Until HLength = 0;
  550. End;
  551. XorPut:
  552. Begin
  553. Repeat
  554. curbank := smallint(offs shr 16);
  555. SetWriteBank(curbank);
  556. SetReadBank(curbank);
  557. {$ifdef logging2}
  558. LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
  559. {$endif logging}
  560. If ((HLength >= 4) and
  561. ((offs and 3) = 0)) or
  562. (HLength >= 4+4-(offs and 3)) Then
  563. { align target }
  564. Begin
  565. If (offs and 3) <> 0 then
  566. { this cannot go past a window boundary bacause the }
  567. { size of a window is always a multiple of 4 }
  568. Begin
  569. {$ifdef logging2}
  570. LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
  571. {$endif logging}
  572. for l := 1 to 4-(offs and 3) do
  573. Mem[WinWriteSeg:word(offs)+l-1] :=
  574. Mem[WinReadSeg:word(offs)+l-1] Xor Byte(CurrentColor);
  575. Dec(HLength, l);
  576. inc(offs, l);
  577. End;
  578. {$ifdef logging2}
  579. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
  580. {$endif logging}
  581. { offs is now 4-bytes aligned }
  582. If HLength <= ($10000-(Offs and $ffff)) Then
  583. bankrest := HLength
  584. else {the rest won't fit anymore in the current window }
  585. bankrest := $10000 - (Offs and $ffff);
  586. { it is possible that by aligningm we ended up in a new }
  587. { bank, so set the correct bank again to make sure }
  588. setwritebank(offs shr 16);
  589. setreadbank(offs shr 16);
  590. {$ifdef logging2}
  591. LogLn('Rest to be drawn in this window: '+strf(bankrest));
  592. {$endif logging}
  593. For l := 0 to (Bankrest div 4)-1 Do
  594. MemL[WinWriteSeg:word(offs)+l*4] :=
  595. MemL[WinReadSeg:word(offs)+l*4] Xor Mask;
  596. inc(offs,l*4+4);
  597. dec(hlength,l*4+4);
  598. {$ifdef logging2}
  599. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
  600. {$endif logging}
  601. End
  602. Else
  603. Begin
  604. {$ifdef logging2}
  605. LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
  606. {$endif logging}
  607. For l := 0 to HLength - 1 do
  608. begin
  609. { this may cross a bank at any time, so adjust }
  610. { because this loop alwys runs for very little pixels, }
  611. { there's little gained by splitting it up }
  612. setreadbank(offs shr 16);
  613. setwritebank(offs shr 16);
  614. Mem[WinWriteSeg:word(offs)] :=
  615. Mem[WinReadSeg:word(offs)] xor byte(currentColor);
  616. inc(offs);
  617. end;
  618. HLength := 0
  619. End
  620. Until HLength = 0;
  621. End;
  622. OrPut:
  623. Begin
  624. Repeat
  625. curbank := smallint(offs shr 16);
  626. SetWriteBank(curbank);
  627. SetReadBank(curbank);
  628. {$ifdef logging2}
  629. LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
  630. {$endif logging}
  631. If ((HLength >= 4) and
  632. ((offs and 3) = 0)) or
  633. (HLength >= 4+4-(offs and 3)) Then
  634. { align target }
  635. Begin
  636. If (offs and 3) <> 0 then
  637. { this cannot go past a window boundary bacause the }
  638. { size of a window is always a multiple of 4 }
  639. Begin
  640. {$ifdef logging2}
  641. LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
  642. {$endif logging}
  643. for l := 1 to 4-(offs and 3) do
  644. Mem[WinWriteSeg:word(offs)+l-1] :=
  645. Mem[WinReadSeg:word(offs)+l-1] Or Byte(CurrentColor);
  646. Dec(HLength, l);
  647. inc(offs, l);
  648. End;
  649. { it is possible that by aligningm we ended up in a new }
  650. { bank, so set the correct bank again to make sure }
  651. setwritebank(offs shr 16);
  652. setreadbank(offs shr 16);
  653. {$ifdef logging2}
  654. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
  655. {$endif logging}
  656. { offs is now 4-bytes aligned }
  657. If HLength <= ($10000-(Offs and $ffff)) Then
  658. bankrest := HLength
  659. else {the rest won't fit anymore in the current window }
  660. bankrest := $10000 - (Offs and $ffff);
  661. {$ifdef logging2}
  662. LogLn('Rest to be drawn in this window: '+strf(bankrest));
  663. {$endif logging}
  664. For l := 0 to (Bankrest div 4)-1 Do
  665. MemL[WinWriteSeg:offs+l*4] :=
  666. MemL[WinReadSeg:word(offs)+l*4] Or Mask;
  667. inc(offs,l*4+4);
  668. dec(hlength,l*4+4);
  669. {$ifdef logging2}
  670. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
  671. {$endif logging}
  672. End
  673. Else
  674. Begin
  675. {$ifdef logging2}
  676. LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
  677. {$endif logging}
  678. For l := 0 to HLength - 1 do
  679. begin
  680. { this may cross a bank at any time, so adjust }
  681. { because this loop alwys runs for very little pixels, }
  682. { there's little gained by splitting it up }
  683. setreadbank(offs shr 16);
  684. setwritebank(offs shr 16);
  685. Mem[WinWriteSeg:word(offs)] :=
  686. Mem[WinReadSeg:word(offs)] Or byte(currentColor);
  687. inc(offs);
  688. end;
  689. HLength := 0
  690. End
  691. Until HLength = 0;
  692. End
  693. Else
  694. Begin
  695. If CurrentWriteMode = NotPut Then
  696. Mask := Not(Mask);
  697. Repeat
  698. curbank := smallint(offs shr 16);
  699. SetWriteBank(curbank);
  700. {$ifdef logging2}
  701. LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8)+' -- '+strf(offs));
  702. {$endif logging}
  703. If ((HLength >= 4) and
  704. ((offs and 3) = 0)) or
  705. (HLength >= 4+4-(offs and 3)) Then
  706. { align target }
  707. Begin
  708. If (offs and 3) <> 0 then
  709. { this cannot go past a window boundary bacause the }
  710. { size of a window is always a multiple of 4 }
  711. Begin
  712. {$ifdef logging2}
  713. LogLn('Aligning by drawing '+strf(4-(offs and 3))+' pixels');
  714. {$endif logging}
  715. for l := 1 to 4-(offs and 3) do
  716. Mem[WinWriteSeg:word(offs)+l-1] := Byte(Mask);
  717. Dec(HLength, l);
  718. inc(offs, l);
  719. End;
  720. {$ifdef logging2}
  721. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
  722. {$endif logging}
  723. { offs is now 4-bytes aligned }
  724. If HLength <= ($10000-(Offs and $ffff)) Then
  725. bankrest := HLength
  726. else {the rest won't fit anymore in the current window }
  727. bankrest := $10000 - (Offs and $ffff);
  728. { it is possible that by aligningm we ended up in a new }
  729. { bank, so set the correct bank again to make sure }
  730. setwritebank(offs shr 16);
  731. {$ifdef logging2}
  732. LogLn('Rest to be drawn in this window: '+strf(bankrest)+' -- '+hexstr(bankrest,8));
  733. {$endif logging}
  734. For l := 0 to (Bankrest div 4)-1 Do
  735. MemL[WinWriteSeg:word(offs)+l*4] := Mask;
  736. inc(offs,l*4+4);
  737. dec(hlength,l*4+4);
  738. {$ifdef logging2}
  739. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
  740. {$endif logging}
  741. End
  742. Else
  743. Begin
  744. {$ifdef logging2}
  745. LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
  746. {$endif logging}
  747. For l := 0 to HLength - 1 do
  748. begin
  749. { this may cross a bank at any time, so adjust }
  750. { because this loop alwys runs for very little pixels, }
  751. { there's little gained by splitting it up }
  752. setwritebank(offs shr 16);
  753. Mem[WinWriteSeg:word(offs)] := byte(mask);
  754. inc(offs);
  755. end;
  756. HLength := 0
  757. End
  758. Until HLength = 0;
  759. End;
  760. End;
  761. end;
  762. end;
  763. procedure VLineVESA256(x,y,y2: smallint);
  764. var Offs: Longint;
  765. l, bankrest: longint;
  766. curbank, vlength: smallint;
  767. col: byte;
  768. Begin
  769. { must we swap the values? }
  770. if y > y2 then
  771. Begin
  772. y := y xor y2;
  773. y2 := y xor y2;
  774. y:= y xor y2;
  775. end;
  776. { First convert to global coordinates }
  777. X := X + StartXViewPort;
  778. Y := Y + StartYViewPort;
  779. Y2 := Y2 + StartYViewPort;
  780. if ClipPixels then
  781. Begin
  782. if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
  783. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  784. exit;
  785. end;
  786. Col := Byte(CurrentColor);
  787. {$ifdef logging2}
  788. LogLn('vline '+strf(y)+' - '+strf(y2)+' on '+strf(x)+' in mode '+strf(currentwritemode));
  789. {$endif logging}
  790. VLength := y2 - y + 1;
  791. {$ifdef logging2}
  792. LogLn('length: '+strf(vlength));
  793. {$endif logging}
  794. if VLength>0 then
  795. begin
  796. Offs:=(Longint(y)+YOffset)*bytesperline+x;
  797. {$ifdef logging2}
  798. LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
  799. {$endif logging}
  800. Case CurrentWriteMode of
  801. AndPut:
  802. Begin
  803. Repeat
  804. curbank := smallint(offs shr 16);
  805. SetWriteBank(curbank);
  806. SetReadBank(curbank);
  807. {$ifdef logging2}
  808. LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
  809. {$endif logging}
  810. If (VLength-1)*bytesperline <= ($ffff-(Offs and $ffff)) Then
  811. bankrest := VLength
  812. else {the rest won't fit anymore in the current window }
  813. bankrest := (($ffff - (Offs and $ffff)) div bytesperline)+1;
  814. {$ifdef logging2}
  815. LogLn('Rest to be drawn in this window: '+strf(bankrest));
  816. {$endif logging}
  817. For l := 0 to Bankrest-1 Do
  818. begin
  819. Mem[WinWriteSeg:word(offs)] :=
  820. Mem[WinReadSeg:word(offs)] And Col;
  821. inc(offs,bytesperline);
  822. end;
  823. dec(VLength,l+1);
  824. {$ifdef logging2}
  825. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
  826. {$endif logging}
  827. Until VLength = 0;
  828. End;
  829. XorPut:
  830. Begin
  831. Repeat
  832. curbank := smallint(offs shr 16);
  833. SetWriteBank(curbank);
  834. SetReadBank(curbank);
  835. {$ifdef logging2}
  836. LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
  837. {$endif logging}
  838. If (VLength-1)*bytesperline <= ($ffff-(Offs and $ffff)) Then
  839. bankrest := VLength
  840. else {the rest won't fit anymore in the current window }
  841. bankrest := (($ffff - (Offs and $ffff)) div bytesperline)+1;
  842. {$ifdef logging2}
  843. LogLn('Rest to be drawn in this window: '+strf(bankrest));
  844. {$endif logging}
  845. For l := 0 to Bankrest-1 Do
  846. begin
  847. Mem[WinWriteSeg:word(offs)] :=
  848. Mem[WinReadSeg:word(offs)] Xor Col;
  849. inc(offs,bytesperline);
  850. end;
  851. dec(VLength,l+1);
  852. {$ifdef logging2}
  853. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
  854. {$endif logging}
  855. Until VLength = 0;
  856. End;
  857. OrPut:
  858. Begin
  859. Repeat
  860. curbank := smallint(offs shr 16);
  861. SetWriteBank(curbank);
  862. SetReadBank(curbank);
  863. {$ifdef logging2}
  864. LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
  865. {$endif logging}
  866. If (VLength-1)*bytesperline <= ($ffff-(Offs and $ffff)) Then
  867. bankrest := VLength
  868. else {the rest won't fit anymore in the current window }
  869. bankrest := (($ffff - (Offs and $ffff)) div bytesperline)+1;
  870. {$ifdef logging2}
  871. LogLn('Rest to be drawn in this window: '+strf(bankrest));
  872. {$endif logging}
  873. For l := 0 to Bankrest-1 Do
  874. begin
  875. Mem[WinWriteSeg:word(offs)] :=
  876. Mem[WinReadSeg:word(offs)] Or Col;
  877. inc(offs,bytesperline);
  878. end;
  879. dec(VLength,l+1);
  880. {$ifdef logging2}
  881. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
  882. {$endif logging}
  883. Until VLength = 0;
  884. End;
  885. Else
  886. Begin
  887. If CurrentWriteMode = NotPut Then
  888. Col := Not(Col);
  889. Repeat
  890. curbank := smallint(offs shr 16);
  891. SetWriteBank(curbank);
  892. {$ifdef logging2}
  893. LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
  894. {$endif logging}
  895. If (VLength-1)*bytesperline <= ($ffff-(Offs and $ffff)) Then
  896. bankrest := VLength
  897. else {the rest won't fit anymore in the current window }
  898. bankrest := (($ffff - (Offs and $ffff)) div bytesperline)+1;
  899. {$ifdef logging2}
  900. LogLn('Rest to be drawn in this window: '+strf(bankrest));
  901. {$endif logging}
  902. For l := 0 to Bankrest-1 Do
  903. begin
  904. Mem[WinWriteSeg:word(offs)] := Col;
  905. inc(offs,bytesperline);
  906. end;
  907. dec(VLength,l+1);
  908. {$ifdef logging2}
  909. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(vlength));
  910. {$endif logging}
  911. Until VLength = 0;
  912. End;
  913. End;
  914. end;
  915. end;
  916. procedure PatternLineVESA256(x1,x2,y: smallint);
  917. {********************************************************}
  918. { Draws a horizontal patterned line according to the }
  919. { current Fill Settings. }
  920. {********************************************************}
  921. { Important notes: }
  922. { - CurrentColor must be set correctly before entering }
  923. { this routine. }
  924. {********************************************************}
  925. type
  926. TVESA256Fill = Record
  927. case byte of
  928. 0: (data1, data2: longint);
  929. 1: (pat: array[0..7] of byte);
  930. end;
  931. var
  932. fill: TVESA256Fill;
  933. bankrest, l : longint;
  934. offs, amount: longint;
  935. i : smallint;
  936. j : smallint;
  937. OldWriteMode : word;
  938. TmpFillPattern, patternPos : byte;
  939. begin
  940. { convert to global coordinates ... }
  941. x1 := x1 + StartXViewPort;
  942. x2 := x2 + StartXViewPort;
  943. y := y + StartYViewPort;
  944. { if line was fully clipped then exit...}
  945. if LineClipped(x1,y,x2,y,StartXViewPort,StartYViewPort,
  946. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  947. exit;
  948. OldWriteMode := CurrentWriteMode;
  949. CurrentWriteMode := NormalPut;
  950. { Get the current pattern }
  951. TmpFillPattern := FillPatternTable
  952. [FillSettings.Pattern][((y + startYViewPort) and $7)+1];
  953. {$ifdef logging2}
  954. LogLn('patternline '+strf(x1)+' - '+strf(x2)+' on '+strf(y));
  955. {$endif logging2}
  956. { how long is the line }
  957. amount := x2 - x1 + 1;
  958. { offset to start at }
  959. offs := (longint(y)+yoffset)*bytesperline+x1;
  960. { convert the pattern data into the actual color sequence }
  961. j := 1;
  962. FillChar(fill,sizeOf(fill),byte(currentBkColor));
  963. for i := 0 to 7 do
  964. begin
  965. if TmpFillPattern and j <> 0 then
  966. fill.pat[7-i] := currentColor;
  967. {$push}
  968. {$q-}
  969. j := j shl 1;
  970. {$pop}
  971. end;
  972. Repeat
  973. SetWriteBank(smallint(offs shr 16));
  974. If (amount > 7) and
  975. (((offs and 7) = 0) or
  976. (amount > 7+8-(offs and 7))) Then
  977. Begin
  978. { align target }
  979. If (offs and 7) <> 0 then
  980. { this cannot go past a window boundary bacause the }
  981. { size of a window is always a multiple of 8 }
  982. Begin
  983. { position in the pattern where to start }
  984. patternPos := offs and 7;
  985. {$ifdef logging2}
  986. LogLn('Aligning by drawing '+strf(8-(offs and 7))+' pixels');
  987. {$endif logging2}
  988. for l := 1 to 8-(offs and 7) do
  989. begin
  990. Mem[WinWriteSeg:word(offs)+l-1] := fill.pat[patternPos and 7];
  991. inc(patternPos)
  992. end;
  993. Dec(amount, l);
  994. inc(offs, l);
  995. End;
  996. {$ifdef logging2}
  997. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(amount));
  998. {$endif logging2}
  999. { offs is now 8-bytes aligned }
  1000. If amount <= ($10000-(Offs and $ffff)) Then
  1001. bankrest := amount
  1002. else {the rest won't fit anymore in the current window }
  1003. bankrest := $10000 - (Offs and $ffff);
  1004. { it is possible that by aligningm we ended up in a new }
  1005. { bank, so set the correct bank again to make sure }
  1006. setwritebank(offs shr 16);
  1007. {$ifdef logging2}
  1008. LogLn('Rest to be drawn in this window: '+strf(bankrest));
  1009. {$endif logging2}
  1010. for l := 0 to (bankrest div 8)-1 Do
  1011. begin
  1012. MemL[WinWriteSeg:word(offs)+l*8] := fill.data1;
  1013. MemL[WinWriteSeg:word(offs)+l*8+4] := fill.data2;
  1014. end;
  1015. inc(offs,l*8+8);
  1016. dec(amount,l*8+8);
  1017. {$ifdef logging2}
  1018. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(amount));
  1019. {$endif logging2}
  1020. End
  1021. Else
  1022. Begin
  1023. {$ifdef logging2}
  1024. LogLn('Drawing leftover: '+strf(amount)+' at offset '+hexstr(offs,8));
  1025. {$endif logging2}
  1026. patternPos := offs and 7;
  1027. For l := 0 to amount - 1 do
  1028. begin
  1029. { this may cross a bank at any time, so adjust }
  1030. { because this loop alwys runs for very little pixels, }
  1031. { there's little gained by splitting it up }
  1032. setwritebank(offs shr 16);
  1033. Mem[WinWriteSeg:word(offs)] := fill.pat[patternPos and 7];
  1034. inc(offs);
  1035. inc(patternPos);
  1036. end;
  1037. amount := 0;
  1038. End
  1039. Until amount = 0;
  1040. currentWriteMode := oldWriteMode;
  1041. end;
  1042. {************************************************************************}
  1043. {* 256 colors VESA mode routines Linear mode *}
  1044. {************************************************************************}
  1045. type
  1046. pbyte = ^byte;
  1047. pword = ^word;
  1048. procedure DirectPutPixVESA256Linear(x, y : smallint);
  1049. var
  1050. offs : longint;
  1051. col : byte;
  1052. begin
  1053. offs := longint(y) * BytesPerLine + x;
  1054. Case CurrentWriteMode of
  1055. XorPut:
  1056. Begin
  1057. if UseNoSelector then
  1058. col:=pbyte(LFBPointer+offs+LinearPageOfs)^
  1059. else
  1060. seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
  1061. col := col xor byte(CurrentColor);
  1062. End;
  1063. AndPut:
  1064. Begin
  1065. if UseNoSelector then
  1066. col:=pbyte(LFBPointer+offs+LinearPageOfs)^
  1067. else
  1068. seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
  1069. col := col and byte(CurrentColor);
  1070. End;
  1071. OrPut:
  1072. Begin
  1073. if UseNoSelector then
  1074. col:=pbyte(LFBPointer+offs+LinearPageOfs)^
  1075. else
  1076. seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
  1077. col := col or byte(CurrentColor);
  1078. End
  1079. else
  1080. Begin
  1081. If CurrentWriteMode <> NotPut then
  1082. col := Byte(CurrentColor)
  1083. else col := Not(Byte(CurrentColor));
  1084. End
  1085. End;
  1086. if UseNoSelector then
  1087. pbyte(LFBPointer+offs+LinearPageOfs)^:=col
  1088. else
  1089. seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,1);
  1090. end;
  1091. procedure PutPixVESA256Linear(x, y : smallint; color : word);
  1092. var
  1093. offs : longint;
  1094. begin
  1095. X:= X + StartXViewPort;
  1096. Y:= Y + StartYViewPort;
  1097. { convert to absolute coordinates and then verify clipping...}
  1098. if ClipPixels then
  1099. Begin
  1100. if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
  1101. exit;
  1102. if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
  1103. exit;
  1104. end;
  1105. offs := longint(y) * BytesPerLine + x;
  1106. {$ifdef logging}
  1107. logln('putpix offset: '+hexstr(offs,8)+', color: '+strf(color)+', lpo: $'+
  1108. hexstr(LinearPageOfs,8));
  1109. {$endif logging}
  1110. if UseNoSelector then
  1111. pbyte(LFBPointer+offs+LinearPageOfs)^:=byte(color)
  1112. else
  1113. seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,1);
  1114. end;
  1115. function GetPixVESA256Linear(x, y : smallint): word;
  1116. var
  1117. offs : longint;
  1118. col : byte;
  1119. begin
  1120. X:= X + StartXViewPort;
  1121. Y:= Y + StartYViewPort;
  1122. offs := longint(y) * BytesPerLine + x;
  1123. {$ifdef logging}
  1124. logln('getpix offset: '+hexstr(offs,8)+', lpo: $'+
  1125. hexstr(LinearPageOfs,8));
  1126. {$endif logging}
  1127. if UseNoSelector then
  1128. col:=pbyte(LFBPointer+offs+LinearPageOfs)^
  1129. else
  1130. seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),1);
  1131. GetPixVESA256Linear:=col;
  1132. end;
  1133. (*
  1134. function SetVESADisplayStart(PageNum : word;x,y : smallint):Boolean;
  1135. var
  1136. dregs : registers;
  1137. begin
  1138. if PageNum>VesaModeInfo.NumberOfPages then
  1139. PageNum:=0;
  1140. {$ifdef DEBUG}
  1141. if PageNum>0 then
  1142. writeln(stderr,'Setting Display Page ',PageNum);
  1143. {$endif DEBUG}
  1144. dregs.RealEBX:=0{ $80 for Wait for retrace };
  1145. dregs.RealECX:=x;
  1146. dregs.RealEDX:=y+PageNum*maxy;
  1147. dregs.RealSP:=0;
  1148. dregs.RealSS:=0;
  1149. dregs.RealEAX:=$4F07; RealIntr($10,dregs);
  1150. { idem as above !!! }
  1151. if (dregs.RealEAX and $1FF) <> $4F then
  1152. begin
  1153. {$ifdef DEBUG}
  1154. writeln(stderr,'Set Display start error');
  1155. {$endif DEBUG}
  1156. SetVESADisplayStart:=false;
  1157. end
  1158. else
  1159. SetVESADisplayStart:=true;
  1160. end;
  1161. *)
  1162. {************************************************************************}
  1163. {* 15/16bit pixels VESA mode routines *}
  1164. {************************************************************************}
  1165. procedure PutPixVESA32kOr64k(x, y : smallint; color : word);
  1166. var
  1167. offs : longint;
  1168. place: word;
  1169. bank : shortint;
  1170. begin
  1171. {$ifdef logging}
  1172. logln('putpixvesa32kor64k('+strf(x)+','+strf(y)+')');
  1173. {$endif logging}
  1174. X:= X + StartXViewPort;
  1175. Y:= Y + StartYViewPort;
  1176. { convert to absolute coordinates and then verify clipping...}
  1177. if ClipPixels then
  1178. Begin
  1179. if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
  1180. exit;
  1181. if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
  1182. exit;
  1183. end;
  1184. Y := Y + YOffset; { adjust pixel for correct virtual page }
  1185. offs := longint(y) * BytesPerLine + 2*x;
  1186. bank := offs div 65536;
  1187. place:= offs mod 65536;
  1188. SetWriteBank(bank);
  1189. {$ifdef logging}
  1190. logln('putpixvesa32kor64k offset: '+strf(word(offs)));
  1191. {$endif logging}
  1192. memW[WinWriteSeg : place] := color;
  1193. end;
  1194. function GetPixVESA32kOr64k(x, y : smallint): word;
  1195. var
  1196. offs : longint;
  1197. begin
  1198. X:= X + StartXViewPort;
  1199. Y:= Y + StartYViewPort + YOffset;
  1200. offs := longint(y) * BytesPerLine + 2*x;
  1201. SetReadBank(smallint(offs shr 16));
  1202. GetPixVESA32kOr64k:=memW[WinReadSeg : word(offs)];
  1203. end;
  1204. procedure DirectPutPixVESA32kOr64k(x, y : smallint);
  1205. var
  1206. offs : longint;
  1207. bank : smallint;
  1208. place,col : word;
  1209. begin
  1210. {$ifdef logging}
  1211. logln('directputpixvesa32kor64k('+strf(x)+','+strf(y)+')');
  1212. {$endif logging}
  1213. y:= Y + YOffset;
  1214. offs := longint(y) * BytesPerLine + 2*x;
  1215. bank:=offs div 65536;
  1216. place:=offs mod 65536;
  1217. SetWriteBank(bank and $FF); // unknown why this and $FF is here.
  1218. Case CurrentWriteMode of
  1219. XorPut:
  1220. Begin
  1221. SetReadBank(bank);
  1222. memW[WinWriteSeg : place] := memW[WinReadSeg : place] xor currentcolor;
  1223. End;
  1224. AndPut:
  1225. Begin
  1226. SetReadBank(bank);
  1227. memW[WinWriteSeg : place] := memW[WinReadSeg : place] And currentcolor;
  1228. End;
  1229. OrPut:
  1230. Begin
  1231. SetReadBank(bank);
  1232. memW[WinWriteSeg : place] := memW[WinReadSeg : place] or currentcolor;
  1233. End
  1234. else
  1235. Begin
  1236. If CurrentWriteMode <> NotPut Then
  1237. col := CurrentColor
  1238. Else col := Not(CurrentColor);
  1239. {$ifdef logging}
  1240. logln('directputpixvesa32kor64k offset: '+strf(word(offs)));
  1241. {$endif logging}
  1242. memW[WinWriteSeg : place] := Col;
  1243. End
  1244. End;
  1245. end;
  1246. procedure HLineVESA32kOr64k(x,x2,y: smallint);
  1247. var Offs: Longint;
  1248. mask, l, bankrest: longint;
  1249. curbank, hlength: smallint;
  1250. Begin
  1251. { must we swap the values? }
  1252. if x > x2 then
  1253. Begin
  1254. x := x xor x2;
  1255. x2 := x xor x2;
  1256. x:= x xor x2;
  1257. end;
  1258. { First convert to global coordinates }
  1259. X := X + StartXViewPort;
  1260. X2 := X2 + StartXViewPort;
  1261. Y := Y + StartYViewPort;
  1262. if ClipPixels then
  1263. Begin
  1264. if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
  1265. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  1266. exit;
  1267. end;
  1268. {$ifdef logging2}
  1269. LogLn('hline '+strf(x)+' - '+strf(x2)+' on '+strf(y)+' in mode '+strf(currentwritemode));
  1270. {$endif logging2}
  1271. HLength := x2 - x + 1;
  1272. {$ifdef logging2}
  1273. LogLn('length: '+strf(hlength));
  1274. {$endif logging2}
  1275. if HLength>0 then
  1276. begin
  1277. Offs:=(Longint(y)+YOffset)*bytesperline+2*x;
  1278. {$ifdef logging2}
  1279. LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
  1280. {$endif logging2}
  1281. Mask := longint(word(CurrentColor)+word(CurrentColor) shl 16);
  1282. Case CurrentWriteMode of
  1283. AndPut:
  1284. Begin
  1285. Repeat
  1286. curbank := smallint(offs shr 16);
  1287. SetWriteBank(curbank);
  1288. SetReadBank(curbank);
  1289. {$ifdef logging2}
  1290. LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
  1291. {$endif logging2}
  1292. If ((HLength >= 2) and
  1293. ((offs and 3) = 0)) or
  1294. (HLength >= 3) Then
  1295. { align target }
  1296. Begin
  1297. If (offs and 3) <> 0 then
  1298. { this cannot go past a window boundary because the }
  1299. { size of a window is always a multiple of 4 }
  1300. Begin
  1301. {$ifdef logging2}
  1302. LogLn('Aligning by drawing 1 pixel');
  1303. {$endif logging2}
  1304. MemW[WinWriteSeg:word(offs)] :=
  1305. MemW[WinReadSeg:word(offs)] And Word(CurrentColor);
  1306. Dec(HLength);
  1307. inc(offs, 2);
  1308. End;
  1309. {$ifdef logging2}
  1310. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
  1311. {$endif logging}
  1312. { offs is now 4-bytes aligned }
  1313. If HLength <= (($10000-(Offs and $ffff)) shr 1) Then
  1314. bankrest := HLength
  1315. else {the rest won't fit anymore in the current window }
  1316. bankrest := ($10000 - (Offs and $ffff)) shr 1;
  1317. { it is possible that by aligningm we ended up in a new }
  1318. { bank, so set the correct bank again to make sure }
  1319. setwritebank(offs shr 16);
  1320. setreadbank(offs shr 16);
  1321. {$ifdef logging2}
  1322. LogLn('Rest to be drawn in this window: '+strf(bankrest));
  1323. {$endif logging}
  1324. For l := 0 to (Bankrest div 2)-1 Do
  1325. MemL[WinWriteSeg:word(offs)+l*4] :=
  1326. MemL[WinReadSeg:word(offs)+l*4] And Mask;
  1327. inc(offs,l*4+4);
  1328. dec(hlength,l*2+2);
  1329. {$ifdef logging2}
  1330. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
  1331. {$endif logging}
  1332. End
  1333. Else
  1334. Begin
  1335. {$ifdef logging2}
  1336. LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
  1337. {$endif logging}
  1338. if HLength > 0 then
  1339. begin
  1340. { this may cross a bank at any time, so adjust }
  1341. { because this loop always runs for very little pixels, }
  1342. { there's little gained by splitting it up }
  1343. setreadbank(offs shr 16);
  1344. setwritebank(offs shr 16);
  1345. MemW[WinWriteSeg:word(offs)] :=
  1346. MemW[WinReadSeg:word(offs)] And Word(currentColor);
  1347. HLength := 0
  1348. end;
  1349. End
  1350. Until HLength = 0;
  1351. End;
  1352. XorPut:
  1353. Begin
  1354. Repeat
  1355. curbank := smallint(offs shr 16);
  1356. SetWriteBank(curbank);
  1357. SetReadBank(curbank);
  1358. {$ifdef logging2}
  1359. LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
  1360. {$endif logging2}
  1361. If ((HLength >= 2) and
  1362. ((offs and 3) = 0)) or
  1363. (HLength >= 3) Then
  1364. { align target }
  1365. Begin
  1366. If (offs and 3) <> 0 then
  1367. { this cannot go past a window boundary because the }
  1368. { size of a window is always a multiple of 4 }
  1369. Begin
  1370. {$ifdef logging2}
  1371. LogLn('Aligning by drawing 1 pixel');
  1372. {$endif logging2}
  1373. MemW[WinWriteSeg:word(offs)] :=
  1374. MemW[WinReadSeg:word(offs)] Xor Word(CurrentColor);
  1375. Dec(HLength);
  1376. inc(offs, 2);
  1377. End;
  1378. {$ifdef logging2}
  1379. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
  1380. {$endif logging}
  1381. { offs is now 4-bytes aligned }
  1382. If HLength <= (($10000-(Offs and $ffff)) shr 1) Then
  1383. bankrest := HLength
  1384. else {the rest won't fit anymore in the current window }
  1385. bankrest := ($10000 - (Offs and $ffff)) shr 1;
  1386. { it is possible that by aligningm we ended up in a new }
  1387. { bank, so set the correct bank again to make sure }
  1388. setwritebank(offs shr 16);
  1389. setreadbank(offs shr 16);
  1390. {$ifdef logging2}
  1391. LogLn('Rest to be drawn in this window: '+strf(bankrest));
  1392. {$endif logging}
  1393. For l := 0 to (Bankrest div 2)-1 Do
  1394. MemL[WinWriteSeg:word(offs)+l*4] :=
  1395. MemL[WinReadSeg:word(offs)+l*4] Xor Mask;
  1396. inc(offs,l*4+4);
  1397. dec(hlength,l*2+2);
  1398. {$ifdef logging2}
  1399. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
  1400. {$endif logging}
  1401. End
  1402. Else
  1403. Begin
  1404. {$ifdef logging2}
  1405. LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
  1406. {$endif logging}
  1407. if HLength > 0 then
  1408. begin
  1409. { this may cross a bank at any time, so adjust }
  1410. { because this loop always runs for very little pixels, }
  1411. { there's little gained by splitting it up }
  1412. setreadbank(offs shr 16);
  1413. setwritebank(offs shr 16);
  1414. MemW[WinWriteSeg:word(offs)] :=
  1415. MemW[WinReadSeg:word(offs)] Xor Word(currentColor);
  1416. HLength := 0
  1417. end;
  1418. End
  1419. Until HLength = 0;
  1420. End;
  1421. OrPut:
  1422. Begin
  1423. Repeat
  1424. curbank := smallint(offs shr 16);
  1425. SetWriteBank(curbank);
  1426. SetReadBank(curbank);
  1427. {$ifdef logging2}
  1428. LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
  1429. {$endif logging2}
  1430. If ((HLength >= 2) and
  1431. ((offs and 3) = 0)) or
  1432. (HLength >= 3) Then
  1433. { align target }
  1434. Begin
  1435. If (offs and 3) <> 0 then
  1436. { this cannot go past a window boundary because the }
  1437. { size of a window is always a multiple of 4 }
  1438. Begin
  1439. {$ifdef logging2}
  1440. LogLn('Aligning by drawing 1 pixel');
  1441. {$endif logging2}
  1442. MemW[WinWriteSeg:word(offs)] :=
  1443. MemW[WinReadSeg:word(offs)] Or Word(CurrentColor);
  1444. Dec(HLength);
  1445. inc(offs, 2);
  1446. End;
  1447. {$ifdef logging2}
  1448. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
  1449. {$endif logging}
  1450. { offs is now 4-bytes aligned }
  1451. If HLength <= (($10000-(Offs and $ffff)) shr 1) Then
  1452. bankrest := HLength
  1453. else {the rest won't fit anymore in the current window }
  1454. bankrest := ($10000 - (Offs and $ffff)) shr 1;
  1455. { it is possible that by aligningm we ended up in a new }
  1456. { bank, so set the correct bank again to make sure }
  1457. setwritebank(offs shr 16);
  1458. setreadbank(offs shr 16);
  1459. {$ifdef logging2}
  1460. LogLn('Rest to be drawn in this window: '+strf(bankrest));
  1461. {$endif logging}
  1462. For l := 0 to (Bankrest div 2)-1 Do
  1463. MemL[WinWriteSeg:word(offs)+l*4] :=
  1464. MemL[WinReadSeg:word(offs)+l*4] Or Mask;
  1465. inc(offs,l*4+4);
  1466. dec(hlength,l*2+2);
  1467. {$ifdef logging2}
  1468. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
  1469. {$endif logging}
  1470. End
  1471. Else
  1472. Begin
  1473. {$ifdef logging2}
  1474. LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
  1475. {$endif logging}
  1476. if HLength > 0 then
  1477. begin
  1478. { this may cross a bank at any time, so adjust }
  1479. { because this loop always runs for very little pixels, }
  1480. { there's little gained by splitting it up }
  1481. setreadbank(offs shr 16);
  1482. setwritebank(offs shr 16);
  1483. MemW[WinWriteSeg:word(offs)] :=
  1484. MemW[WinReadSeg:word(offs)] Or Word(currentColor);
  1485. HLength := 0
  1486. end;
  1487. End
  1488. Until HLength = 0;
  1489. End
  1490. Else
  1491. Begin
  1492. If CurrentWriteMode = NotPut Then
  1493. Mask := Not(Mask);
  1494. Repeat
  1495. curbank := smallint(offs shr 16);
  1496. SetWriteBank(curbank);
  1497. SetReadBank(curbank);
  1498. {$ifdef logging2}
  1499. LogLn('set bank '+strf(curbank)+' for offset '+hexstr(offs,8));
  1500. {$endif logging2}
  1501. If ((HLength >= 2) and
  1502. ((offs and 3) = 0)) or
  1503. (HLength >= 3) Then
  1504. { align target }
  1505. Begin
  1506. If (offs and 3) <> 0 then
  1507. { this cannot go past a window boundary because the }
  1508. { size of a window is always a multiple of 4 }
  1509. Begin
  1510. {$ifdef logging2}
  1511. LogLn('Aligning by drawing 1 pixel');
  1512. {$endif logging2}
  1513. MemW[WinWriteSeg:word(offs)] := Word(Mask);
  1514. Dec(HLength);
  1515. inc(offs, 2);
  1516. End;
  1517. {$ifdef logging2}
  1518. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
  1519. {$endif logging}
  1520. { offs is now 4-bytes aligned }
  1521. If HLength <= (($10000-(Offs and $ffff)) shr 1) Then
  1522. bankrest := HLength
  1523. else {the rest won't fit anymore in the current window }
  1524. bankrest := ($10000 - (Offs and $ffff)) shr 1;
  1525. { it is possible that by aligningm we ended up in a new }
  1526. { bank, so set the correct bank again to make sure }
  1527. setwritebank(offs shr 16);
  1528. setreadbank(offs shr 16);
  1529. {$ifdef logging2}
  1530. LogLn('Rest to be drawn in this window: '+strf(bankrest));
  1531. {$endif logging}
  1532. For l := 0 to (Bankrest div 2)-1 Do
  1533. MemL[WinWriteSeg:word(offs)+l*4] := Mask;
  1534. inc(offs,l*4+4);
  1535. dec(hlength,l*2+2);
  1536. {$ifdef logging2}
  1537. LogLn('Offset is now '+hexstr(offs,8)+', length left: '+strf(hlength));
  1538. {$endif logging}
  1539. End
  1540. Else
  1541. Begin
  1542. {$ifdef logging2}
  1543. LogLn('Drawing leftover: '+strf(HLength)+' at offset '+hexstr(offs,8));
  1544. {$endif logging}
  1545. if HLength > 0 then
  1546. begin
  1547. { this may cross a bank at any time, so adjust }
  1548. { because this loop always runs for very little pixels, }
  1549. { there's little gained by splitting it up }
  1550. setreadbank(offs shr 16);
  1551. setwritebank(offs shr 16);
  1552. MemW[WinWriteSeg:word(offs)] := Word(Mask);
  1553. HLength := 0
  1554. end;
  1555. End
  1556. Until HLength = 0;
  1557. End;
  1558. End;
  1559. end;
  1560. end;
  1561. {************************************************************************}
  1562. {* 15/16bit pixels VESA mode routines Linear mode *}
  1563. {************************************************************************}
  1564. procedure PutPixVESA32kor64kLinear(x, y : smallint; color : word);
  1565. var
  1566. offs : longint;
  1567. begin
  1568. X:= X + StartXViewPort;
  1569. Y:= Y + StartYViewPort;
  1570. { convert to absolute coordinates and then verify clipping...}
  1571. if ClipPixels then
  1572. Begin
  1573. if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
  1574. exit;
  1575. if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
  1576. exit;
  1577. end;
  1578. offs := longint(y) * BytesPerLine + 2*x;
  1579. if UseNoSelector then
  1580. pword(LFBPointer+offs+LinearPageOfs)^:=color
  1581. else
  1582. seg_move(get_ds,longint(@color),WinWriteSeg,offs+LinearPageOfs,2);
  1583. end;
  1584. function GetPixVESA32kor64kLinear(x, y : smallint): word;
  1585. var
  1586. offs : longint;
  1587. color : word;
  1588. begin
  1589. X:= X + StartXViewPort;
  1590. Y:= Y + StartYViewPort;
  1591. offs := longint(y) * BytesPerLine + 2*x;
  1592. if UseNoSelector then
  1593. color:=pword(LFBPointer+offs+LinearPageOfs)^
  1594. else
  1595. seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@color),2);
  1596. GetPixVESA32kor64kLinear:=color;
  1597. end;
  1598. procedure DirectPutPixVESA32kor64kLinear(x, y : smallint);
  1599. var
  1600. offs : longint;
  1601. col : word;
  1602. begin
  1603. offs := longint(y) * BytesPerLine + 2*x;
  1604. Case CurrentWriteMode of
  1605. XorPut:
  1606. Begin
  1607. if UseNoSelector then
  1608. col:=pword(LFBPointer+offs+LinearPageOfs)^
  1609. else
  1610. seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),2);
  1611. col := col xor currentcolor;
  1612. End;
  1613. AndPut:
  1614. Begin
  1615. if UseNoSelector then
  1616. col:=pword(LFBPointer+offs+LinearPageOfs)^
  1617. else
  1618. seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),2);
  1619. col := col and currentcolor;
  1620. End;
  1621. OrPut:
  1622. Begin
  1623. if UseNoSelector then
  1624. col:=pword(LFBPointer+offs+LinearPageOfs)^
  1625. else
  1626. seg_move(WinWriteSeg,offs+LinearPageOfs,get_ds,longint(@col),2);
  1627. col := col or currentcolor;
  1628. End
  1629. else
  1630. Begin
  1631. If CurrentWriteMode <> NotPut Then
  1632. col := CurrentColor
  1633. Else col := Not(CurrentColor);
  1634. End
  1635. End;
  1636. if UseNoSelector then
  1637. pword(LFBPointer+offs+LinearPageOfs)^:=col
  1638. else
  1639. seg_move(get_ds,longint(@col),WinWriteSeg,offs+LinearPageOfs,2);
  1640. end;
  1641. procedure HLineVESA32kOr64kLinear(x,x2,y: smallint);
  1642. var
  1643. Offs: Longint;
  1644. hlength: smallint;
  1645. begin
  1646. { must we swap the values? }
  1647. if x > x2 then
  1648. begin
  1649. x := x xor x2;
  1650. x2 := x xor x2;
  1651. x:= x xor x2;
  1652. end;
  1653. { First convert to global coordinates }
  1654. X := X + StartXViewPort;
  1655. X2 := X2 + StartXViewPort;
  1656. Y := Y + StartYViewPort;
  1657. if ClipPixels and
  1658. LineClipped(x,y,x2,y,
  1659. StartXViewPort,StartYViewPort,
  1660. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  1661. exit;
  1662. {$ifdef logging2}
  1663. LogLn('hline '+strf(x)+' - '+strf(x2)+' on '+strf(y)+' in mode '+strf(currentwritemode));
  1664. {$endif logging2}
  1665. HLength := x2 - x + 1;
  1666. {$ifdef logging2}
  1667. LogLn('length: '+strf(hlength));
  1668. {$endif logging2}
  1669. Offs:=Longint(y)*BytesPerLine+2*x;
  1670. {$ifdef logging2}
  1671. LogLn('Offs: '+strf(offs)+' -- '+hexstr(offs,8));
  1672. {$endif logging2}
  1673. case CurrentWriteMode of
  1674. XorPut:
  1675. begin
  1676. if UseNoSelector then
  1677. seg_xorword(get_ds,PtrUInt(LFBPointer)+PtrUInt(offs)+PtrUInt(LinearPageOfs),HLength,Word(CurrentColor))
  1678. else
  1679. seg_xorword(WinWriteSeg,offs+LinearPageOfs,HLength,Word(CurrentColor));
  1680. end;
  1681. OrPut:
  1682. begin
  1683. if UseNoSelector then
  1684. seg_orword(get_ds,PtrUInt(LFBPointer)+PtrUInt(offs)+PtrUInt(LinearPageOfs),HLength,Word(CurrentColor))
  1685. else
  1686. seg_orword(WinWriteSeg,offs+LinearPageOfs,HLength,Word(CurrentColor));
  1687. end;
  1688. AndPut:
  1689. begin
  1690. if UseNoSelector then
  1691. seg_andword(get_ds,PtrUInt(LFBPointer)+PtrUInt(offs)+PtrUInt(LinearPageOfs),HLength,Word(CurrentColor))
  1692. else
  1693. seg_andword(WinWriteSeg,offs+LinearPageOfs,HLength,Word(CurrentColor));
  1694. end;
  1695. NormalPut:
  1696. begin
  1697. if UseNoSelector then
  1698. FillWord(Pointer(LFBPointer+offs+LinearPageOfs)^,HLength,Word(CurrentColor))
  1699. else
  1700. seg_fillword(WinWriteSeg,offs+LinearPageOfs,HLength,Word(CurrentColor));
  1701. end;
  1702. NotPut:
  1703. begin
  1704. if UseNoSelector then
  1705. FillWord(Pointer(LFBPointer+offs+LinearPageOfs)^,HLength,Word(not Word(CurrentColor)))
  1706. else
  1707. seg_fillword(WinWriteSeg,offs+LinearPageOfs,HLength,Word(not Word(CurrentColor)));
  1708. end;
  1709. end;
  1710. end;
  1711. {************************************************************************}
  1712. {* 4-bit pixels VESA mode routines *}
  1713. {************************************************************************}
  1714. procedure PutPixVESA16(x, y : smallint; color : word);
  1715. var
  1716. offs : longint;
  1717. dummy : byte;
  1718. begin
  1719. X:= X + StartXViewPort;
  1720. Y:= Y + StartYViewPort;
  1721. { convert to absolute coordinates and then verify clipping...}
  1722. if ClipPixels then
  1723. Begin
  1724. if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
  1725. exit;
  1726. if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
  1727. exit;
  1728. end;
  1729. Y := Y + YOffset; { adjust pixel for correct virtual page }
  1730. { }
  1731. offs := longint(y) * BytesPerLine + (x div 8);
  1732. SetReadBank(smallint(offs shr 16));
  1733. SetWriteBank(smallint(offs shr 16));
  1734. PortW[$3ce] := $0f01; { Index 01 : Enable ops on all 4 planes }
  1735. PortW[$3ce] := color shl 8; { Index 00 : Enable correct plane and write color }
  1736. { Index 08 : Bitmask register. }
  1737. PortW[$3ce] := ($8000 shr (x and $7)) or 8; { Select correct bits to modify }
  1738. dummy := Mem[WinReadSeg: word(offs)]; { Latch the data into host space. }
  1739. Mem[WinWriteSeg: word(offs)] := dummy; { Write the data into video memory }
  1740. PortW[$3ce] := $ff08; { Enable all bit planes. }
  1741. PortW[$3ce] := $0001; { Index 01 : Disable ops on all four planes. }
  1742. { }
  1743. end;
  1744. Function GetPixVESA16(X,Y: smallint):word;
  1745. Var dummy: Word;
  1746. offset: longint;
  1747. shift: byte;
  1748. Begin
  1749. X:= X + StartXViewPort;
  1750. Y:= Y + StartYViewPort + YOffset;
  1751. offset := longint(Y) * BytesPerLine + (x div 8);
  1752. SetReadBank(smallint(offset shr 16));
  1753. PortW[$3ce] := $0004;
  1754. shift := 7 - (X and 7);
  1755. dummy := (Mem[WinReadSeg:word(offset)] shr shift) and 1;
  1756. Port[$3cf] := 1;
  1757. dummy := dummy or (((Mem[WinReadSeg:word(offset)] shr shift) and 1) shl 1);
  1758. Port[$3cf] := 2;
  1759. dummy := dummy or (((Mem[WinReadSeg:word(offset)] shr shift) and 1) shl 2);
  1760. Port[$3cf] := 3;
  1761. dummy := dummy or (((Mem[WinReadSeg:word(offset)] shr shift) and 1) shl 3);
  1762. GetPixVESA16 := dummy;
  1763. end;
  1764. procedure DirectPutPixVESA16(x, y : smallint);
  1765. var
  1766. offs : longint;
  1767. dummy : byte;
  1768. Color : word;
  1769. begin
  1770. If CurrentWriteMode <> NotPut Then
  1771. Color := CurrentColor
  1772. else Color := not CurrentColor;
  1773. case CurrentWriteMode of
  1774. XORPut:
  1775. PortW[$3ce]:=((3 shl 3) shl 8) or 3;
  1776. ANDPut:
  1777. PortW[$3ce]:=((1 shl 3) shl 8) or 3;
  1778. ORPut:
  1779. PortW[$3ce]:=((2 shl 3) shl 8) or 3;
  1780. {not needed, this is the default state (e.g. PutPixel16 requires it)}
  1781. {NormalPut, NotPut:
  1782. PortW[$3ce]:=$0003
  1783. else
  1784. PortW[$3ce]:=$0003}
  1785. end;
  1786. Y := Y + YOffset;
  1787. offs := longint(y) * BytesPerLine + (x div 8);
  1788. SetReadBank(smallint(offs shr 16));
  1789. SetWriteBank(smallint(offs shr 16));
  1790. PortW[$3ce] := $0f01; { Index 01 : Enable ops on all 4 planes }
  1791. PortW[$3ce] := color shl 8; { Index 00 : Enable correct plane and write color }
  1792. { Index 08 : Bitmask register. }
  1793. PortW[$3ce] := ($8000 shr (x and $7)) or 8; { Select correct bits to modify }
  1794. dummy := Mem[WinReadSeg: word(offs)]; { Latch the data into host space. }
  1795. Mem[WinWriteSeg: word(offs)] := dummy; { Write the data into video memory }
  1796. PortW[$3ce] := $ff08; { Enable all bit planes. }
  1797. PortW[$3ce] := $0001; { Index 01 : Disable ops on all four planes. }
  1798. if (CurrentWriteMode = XORPut) or
  1799. (CurrentWriteMode = ANDPut) or
  1800. (CurrentWriteMode = ORPut) then
  1801. PortW[$3ce] := $0003;
  1802. end;
  1803. procedure HLineVESA16(x,x2,y: smallint);
  1804. var
  1805. xtmp: smallint;
  1806. ScrOfs, BankRest: longint;
  1807. HLength : word;
  1808. LMask,RMask : byte;
  1809. begin
  1810. { must we swap the values? }
  1811. if x > x2 then
  1812. Begin
  1813. xtmp := x2;
  1814. x2 := x;
  1815. x:= xtmp;
  1816. end;
  1817. { First convert to global coordinates }
  1818. X := X + StartXViewPort;
  1819. X2 := X2 + StartXViewPort;
  1820. Y := Y + StartYViewPort;
  1821. if ClipPixels then
  1822. Begin
  1823. if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
  1824. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  1825. exit;
  1826. end;
  1827. Y := Y + YOffset;
  1828. ScrOfs := longint(y) * BytesPerLine + (x div 8);
  1829. SetReadBank(smallint(ScrOfs shr 16));
  1830. SetWriteBank(smallint(ScrOfs shr 16));
  1831. HLength:=x2 div 8-x div 8;
  1832. LMask:=$ff shr (x and 7);
  1833. {$push}
  1834. {$r-}
  1835. {$q-}
  1836. RMask:=$ff shl (7-(x2 and 7));
  1837. {$pop}
  1838. if HLength=0 then
  1839. LMask:=LMask and RMask;
  1840. If CurrentWriteMode <> NotPut Then
  1841. PortW[$3ce]:= CurrentColor shl 8
  1842. else PortW[$3ce]:= (not CurrentColor) shl 8;
  1843. PortW[$3ce]:=$0f01;
  1844. case CurrentWriteMode of
  1845. XORPut:
  1846. PortW[$3ce]:=((3 shl 3) shl 8) or 3;
  1847. ANDPut:
  1848. PortW[$3ce]:=((1 shl 3) shl 8) or 3;
  1849. ORPut:
  1850. PortW[$3ce]:=((2 shl 3) shl 8) or 3;
  1851. NormalPut, NotPut:
  1852. PortW[$3ce]:=$0003
  1853. else
  1854. PortW[$3ce]:=$0003
  1855. end;
  1856. PortW[$3ce]:=(LMask shl 8) or 8;
  1857. {$push}
  1858. {$r-}
  1859. {$q-}
  1860. Mem[WinWriteSeg:word(ScrOfs)]:=Mem[WinReadSeg:word(ScrOfs)]+1;
  1861. {$pop}
  1862. {Port[$3ce]:=8;}{not needed, the register is already selected}
  1863. if HLength>0 then
  1864. begin
  1865. dec(HLength);
  1866. inc(ScrOfs);
  1867. while (HLength>0) do
  1868. begin
  1869. SetReadBank(smallint(ScrOfs shr 16));
  1870. SetWriteBank(smallint(ScrOfs shr 16));
  1871. Port[$3cf]:=$ff;
  1872. if HLength <= ($10000-(ScrOfs and $ffff)) Then
  1873. BankRest := HLength
  1874. else {the rest won't fit anymore in the current window }
  1875. BankRest := $10000 - (ScrOfs and $ffff);
  1876. {$ifndef tp}
  1877. seg_bytemove(dosmemselector,(WinReadSeg shl 4)+word(ScrOfs),dosmemselector,(WinWriteSeg shl 4)+word(ScrOfs),BankRest);
  1878. {$else}
  1879. move(Ptr(WinReadSeg,word(ScrOfs))^, Ptr(WinWriteSeg,word(ScrOfs))^, BankRest);
  1880. {$endif}
  1881. ScrOfs := ScrOfs + BankRest;
  1882. HLength := HLength - BankRest;
  1883. end;
  1884. SetReadBank(smallint(ScrOfs shr 16));
  1885. SetWriteBank(smallint(ScrOfs shr 16));
  1886. Port[$3cf]:=RMask;
  1887. {$push}
  1888. {$r-}
  1889. {$q-}
  1890. Mem[WinWriteSeg:word(ScrOfs)]:=Mem[WinReadSeg:word(ScrOfs)]+1;
  1891. {$pop}
  1892. end;
  1893. { clean up }
  1894. {Port[$3cf]:=0;}{not needed, the register is reset by the next operation:}
  1895. PortW[$3ce]:=$ff08;
  1896. PortW[$3ce]:=$0001;
  1897. PortW[$3ce]:=$0003;
  1898. end;
  1899. {************************************************************************}
  1900. {* VESA Palette entries *}
  1901. {************************************************************************}
  1902. {$IFDEF DPMI}
  1903. Procedure SetVESARGBAllPalette(const Palette:PaletteType);
  1904. var
  1905. pal: array[0..255] of palrec;
  1906. regs: TDPMIRegisters;
  1907. c, Ptr: longint;
  1908. RealSeg: word;
  1909. FunctionNr : byte; { use blankbit or normal RAMDAC programming? }
  1910. begin
  1911. if DirectColor then
  1912. Begin
  1913. _GraphResult := grError;
  1914. exit;
  1915. end;
  1916. { use the set/get palette function }
  1917. if VESAInfo.Version >= $0200 then
  1918. Begin
  1919. { check if blanking bit must be set when programming }
  1920. { the RAMDAC. }
  1921. if (VESAInfo.caps and attrSnowCheck) <> 0 then
  1922. FunctionNr := $80
  1923. else
  1924. FunctionNr := $00;
  1925. fillChar(pal,sizeof(pal),0);
  1926. { Convert to vesa format }
  1927. for c := 0 to 255 do
  1928. begin
  1929. pal[c].red := byte(palette.colors[c].red);
  1930. pal[c].green := byte(palette.colors[c].green);
  1931. pal[c].blue := byte(palette.colors[c].blue);
  1932. end;
  1933. { Alllocate real mode buffer }
  1934. Ptr:=Global_Dos_Alloc(sizeof(pal));
  1935. {get the segment value}
  1936. RealSeg := word(Ptr shr 16);
  1937. { setup interrupt registers }
  1938. FillChar(regs, sizeof(regs), #0);
  1939. { copy palette values to real mode buffer }
  1940. DosMemPut(RealSeg,0,pal,sizeof(pal));
  1941. regs.eax := $4F09;
  1942. regs.ebx := FunctionNr;
  1943. regs.ecx := 256;
  1944. regs.edx := 0;
  1945. regs.es := RealSeg;
  1946. regs.edi := 0; { offset is always zero }
  1947. RealIntr($10, regs);
  1948. { free real mode memory }
  1949. If not Global_Dos_Free(word(Ptr and $ffff)) then
  1950. RunError(216);
  1951. if word(regs.eax) <> $004F then
  1952. begin
  1953. _GraphResult := grError;
  1954. exit;
  1955. end;
  1956. end
  1957. else
  1958. { assume it's fully VGA compatible palette-wise. }
  1959. Begin
  1960. SetVGARGBAllPalette(palette);
  1961. end;
  1962. setallpalettedefault(palette);
  1963. end;
  1964. Procedure SetVESARGBPalette(ColorNum, RedValue, GreenValue,
  1965. BlueValue : smallint);
  1966. var
  1967. pal: palrec;
  1968. regs: TDPMIRegisters;
  1969. Ptr: longint;
  1970. RealSeg: word;
  1971. FunctionNr : byte; { use blankbit or normal RAMDAC programming? }
  1972. begin
  1973. if DirectColor then
  1974. Begin
  1975. {$ifdef logging}
  1976. logln('setvesargbpalette called with directcolor = true');
  1977. {$endif logging}
  1978. _GraphResult := grError;
  1979. exit;
  1980. end;
  1981. pal.align := 0;
  1982. pal.red := byte(RedValue) shr 2;
  1983. pal.green := byte(GreenValue) shr 2;
  1984. pal.blue := byte(BlueValue) shr 2;
  1985. { use the set/get palette function }
  1986. if VESAInfo.Version >= $0200 then
  1987. Begin
  1988. { check if blanking bit must be set when programming }
  1989. { the RAMDAC. }
  1990. if (VESAInfo.caps and attrSnowCheck) <> 0 then
  1991. FunctionNr := $80
  1992. else
  1993. FunctionNr := $00;
  1994. { Alllocate real mode buffer }
  1995. Ptr:=Global_Dos_Alloc(sizeof(palrec));
  1996. {get the segment value}
  1997. RealSeg := word(Ptr shr 16);
  1998. { setup interrupt registers }
  1999. FillChar(regs, sizeof(regs), #0);
  2000. { copy palette values to real mode buffer }
  2001. DosMemPut(RealSeg,0,pal,sizeof(pal));
  2002. regs.eax := $4F09;
  2003. regs.ebx := FunctionNr;
  2004. regs.ecx := $01;
  2005. regs.edx := ColorNum;
  2006. regs.es := RealSeg;
  2007. regs.edi := 0; { offset is always zero }
  2008. RealIntr($10, regs);
  2009. { free real mode memory }
  2010. If not Global_Dos_Free(word(Ptr and $ffff)) then
  2011. RunError(216);
  2012. if word(regs.eax) <> $004F then
  2013. begin
  2014. {$ifdef logging}
  2015. logln('setvesargbpalette failed while directcolor = false!');
  2016. {$endif logging}
  2017. _GraphResult := grError;
  2018. exit;
  2019. end;
  2020. end
  2021. else
  2022. { assume it's fully VGA compatible palette-wise. }
  2023. Begin
  2024. SetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
  2025. end;
  2026. end;
  2027. Procedure GetVESARGBPalette(ColorNum: smallint; Var
  2028. RedValue, GreenValue, BlueValue : smallint);
  2029. var
  2030. pal: PalRec;
  2031. regs : TDPMIRegisters;
  2032. RealSeg: word;
  2033. ptr: longint;
  2034. begin
  2035. if DirectColor then
  2036. Begin
  2037. {$ifdef logging}
  2038. logln('getvesargbpalette called with directcolor = true');
  2039. {$endif logging}
  2040. _GraphResult := grError;
  2041. exit;
  2042. end;
  2043. { use the set/get palette function }
  2044. if VESAInfo.Version >= $0200 then
  2045. Begin
  2046. { Alllocate real mode buffer }
  2047. Ptr:=Global_Dos_Alloc(sizeof(palrec));
  2048. { get the segment value }
  2049. RealSeg := word(Ptr shr 16);
  2050. { setup interrupt registers }
  2051. FillChar(regs, sizeof(regs), #0);
  2052. regs.eax := $4F09;
  2053. regs.ebx := $01; { get palette data }
  2054. regs.ecx := $01;
  2055. regs.edx := ColorNum;
  2056. regs.es := RealSeg;
  2057. regs.edi := 0; { offset is always zero }
  2058. RealIntr($10, regs);
  2059. { copy to protected mode buffer ... }
  2060. DosMemGet(RealSeg,0,Pal,sizeof(pal));
  2061. { free real mode memory }
  2062. If not Global_Dos_Free(word(Ptr and $ffff)) then
  2063. RunError(216);
  2064. if word(regs.eax) <> $004F then
  2065. begin
  2066. {$ifdef logging}
  2067. logln('getvesargbpalette failed while directcolor = false!');
  2068. {$endif logging}
  2069. _GraphResult := grError;
  2070. exit;
  2071. end
  2072. else
  2073. begin
  2074. RedValue := smallint(pal.Red);
  2075. GreenValue := smallint(pal.Green);
  2076. BlueValue := smallint(pal.Blue);
  2077. end;
  2078. end
  2079. else
  2080. GetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
  2081. end;
  2082. {$ELSE}
  2083. Procedure SetVESARGBPalette(ColorNum, RedValue, GreenValue,
  2084. BlueValue : smallint); far;
  2085. var
  2086. FunctionNr : byte; { use blankbit or normal RAMDAC programming? }
  2087. pal: ^palrec;
  2088. Error : boolean; { VBE call error }
  2089. begin
  2090. if DirectColor then
  2091. Begin
  2092. _GraphResult := grError;
  2093. exit;
  2094. end;
  2095. Error := FALSE;
  2096. new(pal);
  2097. if not assigned(pal) then RunError(203);
  2098. pal^.align := 0;
  2099. pal^.red := byte(RedValue);
  2100. pal^.green := byte(GreenValue);
  2101. pal^.blue := byte(BlueValue);
  2102. { use the set/get palette function }
  2103. if VESAInfo.Version >= $0200 then
  2104. Begin
  2105. { check if blanking bit must be set when programming }
  2106. { the RAMDAC. }
  2107. if (VESAInfo.caps and attrSnowCheck) <> 0 then
  2108. FunctionNr := $80
  2109. else
  2110. FunctionNr := $00;
  2111. asm
  2112. mov ax, 4F09h { Set/Get Palette data }
  2113. mov bl, [FunctionNr] { Set palette data }
  2114. mov cx, 01h { update one palette reg. }
  2115. mov dx, [ColorNum] { register number to update }
  2116. les di, [pal] { get palette address }
  2117. int 10h
  2118. cmp ax, 004Fh { check if success }
  2119. jz @noerror
  2120. mov [Error], TRUE
  2121. @noerror:
  2122. end;
  2123. if not Error then
  2124. Dispose(pal)
  2125. else
  2126. begin
  2127. _GraphResult := grError;
  2128. exit;
  2129. end;
  2130. end
  2131. else
  2132. { assume it's fully VGA compatible palette-wise. }
  2133. Begin
  2134. SetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
  2135. end;
  2136. end;
  2137. Procedure GetVESARGBPalette(ColorNum: smallint; Var RedValue, GreenValue,
  2138. BlueValue : smallint); far;
  2139. var
  2140. Error: boolean;
  2141. pal: ^palrec;
  2142. begin
  2143. if DirectColor then
  2144. Begin
  2145. _GraphResult := grError;
  2146. exit;
  2147. end;
  2148. Error := FALSE;
  2149. new(pal);
  2150. if not assigned(pal) then RunError(203);
  2151. FillChar(pal^, sizeof(palrec), #0);
  2152. { use the set/get palette function }
  2153. if VESAInfo.Version >= $0200 then
  2154. Begin
  2155. asm
  2156. mov ax, 4F09h { Set/Get Palette data }
  2157. mov bl, 01h { Set palette data }
  2158. mov cx, 01h { update one palette reg. }
  2159. mov dx, [ColorNum] { register number to update }
  2160. les di, [pal] { get palette address }
  2161. int 10h
  2162. cmp ax, 004Fh { check if success }
  2163. jz @noerror
  2164. mov [Error], TRUE
  2165. @noerror:
  2166. end;
  2167. if not Error then
  2168. begin
  2169. RedValue := smallint(pal^.Red);
  2170. GreenValue := smallint(pal^.Green);
  2171. BlueValue := smallint(pal^.Blue);
  2172. Dispose(pal);
  2173. end
  2174. else
  2175. begin
  2176. _GraphResult := grError;
  2177. exit;
  2178. end;
  2179. end
  2180. else
  2181. GetVGARGBPalette(ColorNum, RedValue, GreenValue, BlueValue);
  2182. end;
  2183. {$ENDIF}
  2184. (*
  2185. type
  2186. heaperrorproc=function(size:longint):smallint;
  2187. Const
  2188. HeapErrorIsHooked : boolean = false;
  2189. OldHeapError : HeapErrorProc = nil;
  2190. DsLimit : dword = 0;
  2191. function NewHeapError(size : longint) : smallint;
  2192. begin
  2193. set_segment_limit(get_ds,DsLimit);
  2194. NewHeapError:=OldHeapError(size);
  2195. DsLimit:=get_segment_limit(get_ds);
  2196. { The base of ds can be changed
  2197. we need to compute the address again PM }
  2198. LFBPointer:=pointer(FrameBufferLinearAddress-get_segment_base_address(get_ds));
  2199. if dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1 > DsLimit then
  2200. set_segment_limit(get_ds,dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1);
  2201. end;
  2202. procedure HookHeapError;
  2203. begin
  2204. if HeapErrorIsHooked then
  2205. exit;
  2206. DsLimit:=get_segment_limit(get_ds);
  2207. OldHeapError:=HeapErrorProc(HeapError);
  2208. HeapError:=@NewHeapError;
  2209. HeapErrorIsHooked:=true;
  2210. end;
  2211. procedure UnHookHeapError;
  2212. begin
  2213. if not HeapErrorIsHooked then
  2214. exit;
  2215. LFBPointer:=nil;
  2216. set_segment_limit(get_ds,DsLimit);
  2217. HeapError:=OldHeapError;
  2218. HeapErrorIsHooked:=false;
  2219. end;
  2220. *)
  2221. function SetupLinear(var ModeInfo: TVESAModeInfo;mode : word) : boolean;
  2222. begin
  2223. SetUpLinear:=false;
  2224. if VESAInfo.Version >= $0300 then
  2225. BytesPerLine := VESAModeInfo.LinBytesPerScanLine
  2226. else
  2227. BytesPerLine := VESAModeInfo.BytesPerScanLine;
  2228. case mode of
  2229. m320x200x32k,
  2230. m320x200x64k,
  2231. m640x480x32k,
  2232. m640x480x64k,
  2233. m800x600x32k,
  2234. m800x600x64k,
  2235. m1024x768x32k,
  2236. m1024x768x64k,
  2237. m1280x1024x32k,
  2238. m1280x1024x64k :
  2239. begin
  2240. DirectPutPixel:=@DirectPutPixVESA32kor64kLinear;
  2241. PutPixel:=@PutPixVESA32kor64kLinear;
  2242. GetPixel:=@GetPixVESA32kor64kLinear;
  2243. HLine:=@HLineVESA32kOr64kLinear;
  2244. { linear mode for lines not yet implemented PM }
  2245. VLine:=@VLineDefault;
  2246. GetScanLine := @GetScanLineDefault;
  2247. PatternLine := @PatternLineDefault;
  2248. end;
  2249. m640x400x256,
  2250. m640x480x256,
  2251. m800x600x256,
  2252. m1024x768x256,
  2253. m1280x1024x256:
  2254. begin
  2255. DirectPutPixel:=@DirectPutPixVESA256Linear;
  2256. PutPixel:=@PutPixVESA256Linear;
  2257. GetPixel:=@GetPixVESA256Linear;
  2258. { linear mode for lines not yet implemented PM }
  2259. HLine:=@HLineDefault;
  2260. VLine:=@VLineDefault;
  2261. GetScanLine := @GetScanLineDefault;
  2262. PatternLine := @PatternLineDefault;
  2263. end;
  2264. else
  2265. exit;
  2266. end;
  2267. FrameBufferLinearAddress:=Get_linear_addr(VESAModeInfo.PhysAddress and $FFFF0000,
  2268. VESAInfo.TotalMem shl 16);
  2269. {$ifdef logging}
  2270. logln('framebuffer linear address: '+hexstr(FrameBufferLinearAddress div (1024*1024),8));
  2271. logln('total mem shl 16: '+strf(vesainfo.totalmem shl 16));
  2272. {$endif logging}
  2273. if int31error<>0 then
  2274. begin
  2275. {$ifdef logging}
  2276. logln('Unable to get linear address for '+hexstr(VESAModeInfo.PhysAddress,8));
  2277. {$endif logging}
  2278. writeln(stderr,'Unable to get linear address for ',hexstr(VESAModeInfo.PhysAddress,8));
  2279. exit;
  2280. end;
  2281. if UseNoSelector then
  2282. begin
  2283. { HookHeapError; }
  2284. LFBPointer:=pointer(FrameBufferLinearAddress-get_segment_base_address(get_ds));
  2285. if dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1 > dword(get_segment_limit(get_ds)) then
  2286. set_segment_limit(get_ds,dword(LFBPointer)+dword(VESAInfo.TotalMem shl 16)-1);
  2287. end
  2288. else
  2289. begin
  2290. WinWriteSeg:=allocate_ldt_descriptors(1);
  2291. {$ifdef logging}
  2292. logln('writeseg1: '+hexstr(winwriteseg,8));
  2293. {$endif logging}
  2294. set_segment_base_address(WinWriteSeg,FrameBufferLinearAddress);
  2295. set_segment_limit(WinWriteSeg,(VESAInfo.TotalMem shl 16)-1);
  2296. lock_linear_region(FrameBufferLinearAddress,(VESAInfo.TotalMem shl 16));
  2297. if int31error<>0 then
  2298. begin
  2299. {$ifdef logging}
  2300. logln('Error in linear memory selectors creation');
  2301. {$endif logging}
  2302. writeln(stderr,'Error in linear memory selectors creation');
  2303. exit;
  2304. end;
  2305. end;
  2306. LinearPageOfs := 0;
  2307. InLinear:=true;
  2308. SetUpLinear:=true;
  2309. { WinSize:=(VGAInfo.TotalMem shl 16);
  2310. WinLoMask:=(VGAInfo.TotalMem shl 16)-1;
  2311. WinShift:=15;
  2312. Temp:=VGAInfo.TotalMem;
  2313. while Temp>0 do
  2314. begin
  2315. inc(WinShift);
  2316. Temp:=Temp shr 1;
  2317. end; }
  2318. end;
  2319. procedure SetupWindows(var ModeInfo: TVESAModeInfo);
  2320. begin
  2321. InLinear:=false;
  2322. BytesPerLine := VESAModeInfo.BytesPerScanLine;
  2323. { now we check the windowing scheme ...}
  2324. if (ModeInfo.WinAAttr and WinSupported) <> 0 then
  2325. { is this window supported ... }
  2326. begin
  2327. { now check if the window is R/W }
  2328. if (ModeInfo.WinAAttr and WinReadable) <> 0 then
  2329. begin
  2330. ReadWindow := 0;
  2331. WinReadSeg := ModeInfo.WinASeg;
  2332. end;
  2333. if (ModeInfo.WinAAttr and WinWritable) <> 0 then
  2334. begin
  2335. WriteWindow := 0;
  2336. WinWriteSeg := ModeInfo.WinASeg;
  2337. end;
  2338. end;
  2339. if (ModeInfo.WinBAttr and WinSupported) <> 0 then
  2340. { is this window supported ... }
  2341. begin
  2342. { OPTIMIZATION ... }
  2343. { if window A supports both read/write, then we try to optimize }
  2344. { everything, by using a different window for Read and/or write.}
  2345. if (WinReadSeg <> 0) and (WinWriteSeg <> 0) then
  2346. begin
  2347. { check if winB supports read }
  2348. if (ModeInfo.WinBAttr and winReadable) <> 0 then
  2349. begin
  2350. WinReadSeg := ModeInfo.WinBSeg;
  2351. ReadWindow := 1;
  2352. end
  2353. else
  2354. { check if WinB supports write }
  2355. if (ModeInfo.WinBAttr and WinWritable) <> 0 then
  2356. begin
  2357. WinWriteSeg := ModeInfo.WinBSeg;
  2358. WriteWindow := 1;
  2359. end;
  2360. end
  2361. else
  2362. { Window A only supported Read OR Write, no we have to make }
  2363. { sure that window B supports the other mode. }
  2364. if (WinReadSeg = 0) and (WinWriteSeg<>0) then
  2365. begin
  2366. if (ModeInfo.WinBAttr and WinReadable <> 0) then
  2367. begin
  2368. ReadWindow := 1;
  2369. WinReadSeg := ModeInfo.WinBSeg;
  2370. end
  2371. else
  2372. { impossible, this VESA mode is WRITE only! }
  2373. begin
  2374. WriteLn('Invalid VESA Window attribute.');
  2375. Halt(255);
  2376. end;
  2377. end
  2378. else
  2379. if (winWriteSeg = 0) and (WinReadSeg<>0) then
  2380. begin
  2381. if (ModeInfo.WinBAttr and WinWritable) <> 0 then
  2382. begin
  2383. WriteWindow := 1;
  2384. WinWriteSeg := ModeInfo.WinBSeg;
  2385. end
  2386. else
  2387. { impossible, this VESA mode is READ only! }
  2388. begin
  2389. WriteLn('Invalid VESA Window attribute.');
  2390. Halt(255);
  2391. end;
  2392. end
  2393. else
  2394. if (winReadSeg = 0) and (winWriteSeg = 0) then
  2395. { no read/write in this mode! }
  2396. begin
  2397. WriteLn('Invalid VESA Window attribute.');
  2398. Halt(255);
  2399. end;
  2400. YOffset := 0;
  2401. end;
  2402. { if both windows are not supported, then we can assume }
  2403. { that there is ONE single NON relocatable window. }
  2404. if (WinWriteSeg = 0) and (WinReadSeg = 0) then
  2405. begin
  2406. WinWriteSeg := ModeInfo.WinASeg;
  2407. WinReadSeg := ModeInfo.WinASeg;
  2408. end;
  2409. { 16-bit Protected mode checking code... }
  2410. { change segment values to protected mode }
  2411. { selectors. }
  2412. if WinReadSeg = $A000 then
  2413. WinReadSeg := SegA000
  2414. else
  2415. if WinReadSeg = $B000 then
  2416. WinReadSeg := SegB000
  2417. else
  2418. if WinReadSeg = $B800 then
  2419. WinReadSeg := SegB800
  2420. else
  2421. begin
  2422. WriteLn('Invalid segment address.');
  2423. Halt(255);
  2424. end;
  2425. if WinWriteSeg = $A000 then
  2426. WinWriteSeg := SegA000
  2427. else
  2428. if WinWriteSeg = $B000 then
  2429. WinWriteSeg := SegB000
  2430. else
  2431. if WinWriteSeg = $B800 then
  2432. WinWriteSeg := SegB800
  2433. else
  2434. begin
  2435. WriteLn('Invalid segment address.');
  2436. Halt(255);
  2437. end;
  2438. end;
  2439. function setVESAMode(mode:word):boolean;
  2440. var i:word;
  2441. res: boolean;
  2442. begin
  2443. { Init mode information, for compatibility with VBE < 1.1 }
  2444. FillChar(VESAModeInfo, sizeof(TVESAModeInfo), #0);
  2445. { get the video mode information }
  2446. if getVESAModeInfo(VESAmodeinfo, mode) then
  2447. begin
  2448. { checks if the hardware supports the video mode. }
  2449. if (VESAModeInfo.attr and modeAvail) = 0 then
  2450. begin
  2451. SetVESAmode := FALSE;
  2452. {$ifdef logging}
  2453. logln(' vesa mode '+strf(mode)+' not supported!!!');
  2454. {$endif logging}
  2455. _GraphResult := grError;
  2456. exit;
  2457. end;
  2458. SetVESAMode := TRUE;
  2459. BankShift := 0;
  2460. while (64 shr BankShift) <> VESAModeInfo.WinGranularity do
  2461. Inc(BankShift);
  2462. CurrentWriteBank := -1;
  2463. CurrentReadBank := -1;
  2464. { nickysn: setting BytesPerLine moved to SetupLinear and SetupWindowed
  2465. BytesPerLine := VESAModeInfo.BytesPerScanLine;}
  2466. { These are the window adresses ... }
  2467. WinWriteSeg := 0; { This is the segment to use for writes }
  2468. WinReadSeg := 0; { This is the segment to use for reads }
  2469. ReadWindow := 0;
  2470. WriteWindow := 0;
  2471. { VBE 2.0 and higher supports >= non VGA linear buffer types...}
  2472. { this is backward compatible. }
  2473. if (((VESAModeInfo.Attr and ModeNoWindowed) <> 0) or UseLFB) and
  2474. ((VESAModeInfo.Attr and ModeLinearBuffer) <> 0) then
  2475. begin
  2476. if not SetupLinear(VESAModeInfo,mode) then
  2477. SetUpWindows(VESAModeInfo);
  2478. end
  2479. else
  2480. { if linear and windowed is supported, then use windowed }
  2481. { method. }
  2482. SetUpWindows(VESAModeInfo);
  2483. {$ifdef logging}
  2484. LogLn('Entering vesa mode '+strf(mode));
  2485. LogLn('Read segment: $'+hexstr(winreadseg,4));
  2486. LogLn('Write segment: $'+hexstr(winwriteseg,4));
  2487. LogLn('Window granularity: '+strf(VESAModeInfo.WinGranularity)+'kb');
  2488. LogLn('Window size: '+strf(VESAModeInfo.winSize)+'kb');
  2489. LogLn('Bytes per line: '+strf(bytesperline));
  2490. {$endif logging}
  2491. { Select the correct mode number if we're going to use linear access! }
  2492. if InLinear then
  2493. inc(mode,$4000);
  2494. asm
  2495. mov ax,4F02h
  2496. mov bx,mode
  2497. push ebp
  2498. push esi
  2499. push edi
  2500. push ebx
  2501. int 10h
  2502. pop ebx
  2503. pop edi
  2504. pop esi
  2505. pop ebp
  2506. sub ax,004Fh
  2507. cmp ax,1
  2508. sbb al,al
  2509. mov res,al
  2510. end ['EBX','EAX'];
  2511. if not res then
  2512. _GraphResult := GrNotDetected
  2513. else _GraphResult := grOk;
  2514. end;
  2515. end;
  2516. (*
  2517. function getVESAMode:word;assembler;
  2518. asm {return -1 if error}
  2519. mov ax,4F03h
  2520. {$ifdef fpc}
  2521. push ebx
  2522. push ebp
  2523. push esi
  2524. push edi
  2525. {$endif fpc}
  2526. int 10h
  2527. {$ifdef fpc}
  2528. pop edi
  2529. pop esi
  2530. pop ebp
  2531. {$endif fpc}
  2532. cmp ax,004Fh
  2533. je @@OK
  2534. mov ax,-1
  2535. jmp @@X
  2536. @@OK:
  2537. mov ax,bx
  2538. @@X:
  2539. {$ifdef fpc}
  2540. pop ebx
  2541. {$endif fpc}
  2542. end ['EAX'];
  2543. *)
  2544. {************************************************************************}
  2545. {* VESA Modes inits *}
  2546. {************************************************************************}
  2547. {$IFDEF DPMI}
  2548. {******************************************************** }
  2549. { Function GetMaxScanLines() }
  2550. {-------------------------------------------------------- }
  2551. { This routine returns the maximum number of scan lines }
  2552. { possible for this mode. This is done using the Get }
  2553. { Scan Line length VBE function. }
  2554. {******************************************************** }
  2555. function GetMaxScanLines: word;
  2556. var
  2557. regs : TDPMIRegisters;
  2558. begin
  2559. FillChar(regs, sizeof(regs), #0);
  2560. { play it safe, call the real mode int, the 32-bit entry point }
  2561. { may not be defined as stated in VBE v3.0 }
  2562. regs.eax := $4f06; {_ setup function }
  2563. regs.ebx := $0001; { get scan line length }
  2564. RealIntr($10, regs);
  2565. GetMaxScanLines := (regs.edx and $0000ffff);
  2566. end;
  2567. {$ELSE}
  2568. function GetMaxScanLines: word; assembler;
  2569. asm
  2570. mov ax, 4f06h
  2571. mov bx, 0001h
  2572. int 10h
  2573. mov ax, dx
  2574. end;
  2575. {$ENDIF}
  2576. procedure Init1280x1024x64k;
  2577. begin
  2578. SetVesaMode(m1280x1024x64k);
  2579. { Get maximum number of scanlines for page flipping }
  2580. ScanLines := GetMaxScanLines;
  2581. end;
  2582. procedure Init1280x1024x32k;
  2583. begin
  2584. SetVESAMode(m1280x1024x32k);
  2585. { Get maximum number of scanlines for page flipping }
  2586. ScanLines := GetMaxScanLines;
  2587. end;
  2588. procedure Init1280x1024x256;
  2589. begin
  2590. SetVESAMode(m1280x1024x256);
  2591. { Get maximum number of scanlines for page flipping }
  2592. ScanLines := GetMaxScanLines;
  2593. end;
  2594. procedure Init1280x1024x16;
  2595. begin
  2596. SetVESAMode(m1280x1024x16);
  2597. { Get maximum number of scanlines for page flipping }
  2598. ScanLines := GetMaxScanLines;
  2599. end;
  2600. procedure Init1024x768x64k;
  2601. begin
  2602. SetVESAMode(m1024x768x64k);
  2603. { Get maximum number of scanlines for page flipping }
  2604. ScanLines := GetMaxScanLines;
  2605. end;
  2606. procedure Init1024x768x32k;
  2607. begin
  2608. SetVESAMode(m1024x768x32k);
  2609. { Get maximum number of scanlines for page flipping }
  2610. ScanLines := GetMaxScanLines;
  2611. end;
  2612. procedure Init1024x768x256;
  2613. begin
  2614. SetVESAMode(m1024x768x256);
  2615. { Get maximum number of scanlines for page flipping }
  2616. ScanLines := GetMaxScanLines;
  2617. end;
  2618. procedure Init1024x768x16;
  2619. begin
  2620. SetVESAMode(m1024x768x16);
  2621. { Get maximum number of scanlines for page flipping }
  2622. ScanLines := GetMaxScanLines;
  2623. end;
  2624. procedure Init800x600x64k;
  2625. begin
  2626. SetVESAMode(m800x600x64k);
  2627. { Get maximum number of scanlines for page flipping }
  2628. ScanLines := GetMaxScanLines;
  2629. end;
  2630. procedure Init800x600x32k;
  2631. begin
  2632. SetVESAMode(m800x600x32k);
  2633. { Get maximum number of scanlines for page flipping }
  2634. ScanLines := GetMaxScanLines;
  2635. end;
  2636. procedure Init800x600x256;
  2637. begin
  2638. SetVESAMode(m800x600x256);
  2639. { Get maximum number of scanlines for page flipping }
  2640. ScanLines := GetMaxScanLines;
  2641. end;
  2642. procedure Init800x600x16;
  2643. begin
  2644. SetVesaMode(m800x600x16);
  2645. { Get maximum number of scanlines for page flipping }
  2646. ScanLines := GetMaxScanLines;
  2647. end;
  2648. procedure Init640x480x64k;
  2649. begin
  2650. SetVESAMode(m640x480x64k);
  2651. { Get maximum number of scanlines for page flipping }
  2652. ScanLines := GetMaxScanLines;
  2653. end;
  2654. procedure Init640x480x32k;
  2655. begin
  2656. SetVESAMode(m640x480x32k);
  2657. { Get maximum number of scanlines for page flipping }
  2658. ScanLines := GetMaxScanLines;
  2659. end;
  2660. procedure Init640x480x256;
  2661. begin
  2662. SetVESAMode(m640x480x256);
  2663. { Get maximum number of scanlines for page flipping }
  2664. ScanLines := GetMaxScanLines;
  2665. end;
  2666. procedure Init640x400x256;
  2667. begin
  2668. SetVESAMode(m640x400x256);
  2669. { Get maximum number of scanlines for page flipping }
  2670. ScanLines := GetMaxScanLines;
  2671. end;
  2672. procedure Init320x200x64k;
  2673. begin
  2674. SetVESAMode(m320x200x64k);
  2675. { Get maximum number of scanlines for page flipping }
  2676. ScanLines := GetMaxScanLines;
  2677. end;
  2678. procedure Init320x200x32k;
  2679. begin
  2680. SetVESAMode(m320x200x32k);
  2681. { Get maximum number of scanlines for page flipping }
  2682. ScanLines := GetMaxScanLines;
  2683. end;
  2684. {$IFDEF DPMI}
  2685. Procedure SaveStateVESA;
  2686. var
  2687. PtrLong: longint;
  2688. regs: TDPMIRegisters;
  2689. begin
  2690. SaveSupported := FALSE;
  2691. SavePtr := nil;
  2692. {$ifdef logging}
  2693. LogLn('Get the video mode...');
  2694. {$endif logging}
  2695. { Get the video mode }
  2696. asm
  2697. mov ah,0fh
  2698. push ebp
  2699. push esi
  2700. push edi
  2701. push ebx
  2702. int 10h
  2703. pop ebx
  2704. pop edi
  2705. pop esi
  2706. pop ebp
  2707. mov [VideoMode], al
  2708. end ['EAX'];
  2709. { saving/restoring video state screws up Windows (JM) }
  2710. if inWindows then
  2711. exit;
  2712. {$ifdef logging}
  2713. LogLn('Prepare to save VESA video state');
  2714. {$endif logging}
  2715. { Prepare to save video state...}
  2716. regs.eax := $4F04; { get buffer size to save state }
  2717. regs.edx := $0000;
  2718. regs.ecx := $000F; { Save DAC / Data areas / Hardware states }
  2719. RealIntr($10, regs);
  2720. StateSize := word(regs.ebx);
  2721. if byte(regs.eax) = $4f then
  2722. SaveSupported := TRUE;
  2723. if SaveSupported then
  2724. begin
  2725. {$ifdef logging}
  2726. LogLn('allocating VESA save buffer of '+strf(64*StateSize));
  2727. {$endif logging}
  2728. PtrLong:=Global_Dos_Alloc(64*StateSize); { values returned in 64-byte blocks }
  2729. if PtrLong = 0 then
  2730. RunError(203);
  2731. SavePtr := pointer(longint(PtrLong and $0000ffff) shl 16);
  2732. RealStateSeg := word(PtrLong shr 16);
  2733. FillChar(regs, sizeof(regs), #0);
  2734. { call the real mode interrupt ... }
  2735. regs.eax := $4F04; { save the state buffer }
  2736. regs.ecx := $0F; { Save DAC / Data areas / Hardware states }
  2737. regs.edx := $01; { save state }
  2738. regs.es := RealStateSeg;
  2739. regs.ebx := 0;
  2740. RealIntr($10,regs);
  2741. FillChar(regs, sizeof(regs), #0);
  2742. { restore state, according to Ralph Brown Interrupt list }
  2743. { some BIOS corrupt the hardware after a save... }
  2744. regs.eax := $4F04; { restore the state buffer }
  2745. regs.ecx := $0F; { rest DAC / Data areas / Hardware states }
  2746. regs.edx := $02;
  2747. regs.es := RealStateSeg;
  2748. regs.ebx := 0;
  2749. RealIntr($10,regs);
  2750. end;
  2751. end;
  2752. procedure RestoreStateVESA;
  2753. var
  2754. regs:TDPMIRegisters;
  2755. begin
  2756. { go back to the old video mode...}
  2757. asm
  2758. mov ah,00
  2759. mov al,[VideoMode]
  2760. push ebp
  2761. push esi
  2762. push edi
  2763. push ebx
  2764. int 10h
  2765. pop ebx
  2766. pop edi
  2767. pop esi
  2768. pop ebp
  2769. end ['EAX'];
  2770. { then restore all state information }
  2771. { No far pointer support, so it's possible that that assigned(SavePtr) }
  2772. { would return false under FPC. Just check if it's different from nil. }
  2773. if (SavePtr <> nil) and (SaveSupported=TRUE) then
  2774. begin
  2775. FillChar(regs, sizeof(regs), #0);
  2776. { restore state, according to Ralph Brown Interrupt list }
  2777. { some BIOS corrupt the hardware after a save... }
  2778. regs.eax := $4F04; { restore the state buffer }
  2779. regs.ecx := $0F; { rest DAC / Data areas / Hardware states }
  2780. regs.edx := $02; { restore state }
  2781. regs.es := RealStateSeg;
  2782. regs.ebx := 0;
  2783. RealIntr($10,regs);
  2784. if Not(Global_Dos_Free(longint(SavePtr) shr 16)) then
  2785. RunError(216);
  2786. SavePtr := nil;
  2787. end;
  2788. end;
  2789. {$ELSE}
  2790. {**************************************************************}
  2791. {* Real mode routines *}
  2792. {**************************************************************}
  2793. Procedure SaveStateVESA; far;
  2794. begin
  2795. SavePtr := nil;
  2796. SaveSupported := FALSE;
  2797. { Get the video mode }
  2798. asm
  2799. mov ah,0fh
  2800. int 10h
  2801. mov [VideoMode], al
  2802. end;
  2803. { Prepare to save video state...}
  2804. asm
  2805. mov ax, 4f04h { get buffer size to save state }
  2806. mov cx, 00001111b { Save DAC / Data areas / Hardware states }
  2807. mov dx, 00h
  2808. int 10h
  2809. mov [StateSize], bx
  2810. cmp al,04fh
  2811. jnz @notok
  2812. mov [SaveSupported],TRUE
  2813. @notok:
  2814. end;
  2815. if SaveSupported then
  2816. Begin
  2817. GetMem(SavePtr, 64*StateSize); { values returned in 64-byte blocks }
  2818. if not assigned(SavePtr) then
  2819. RunError(203);
  2820. asm
  2821. mov ax, 4F04h { save the state buffer }
  2822. mov cx, 00001111b { Save DAC / Data areas / Hardware states }
  2823. mov dx, 01h
  2824. mov es, WORD PTR [SavePtr+2]
  2825. mov bx, WORD PTR [SavePtr]
  2826. int 10h
  2827. end;
  2828. { restore state, according to Ralph Brown Interrupt list }
  2829. { some BIOS corrupt the hardware after a save... }
  2830. asm
  2831. mov ax, 4F04h { save the state buffer }
  2832. mov cx, 00001111b { Save DAC / Data areas / Hardware states }
  2833. mov dx, 02h
  2834. mov es, WORD PTR [SavePtr+2]
  2835. mov bx, WORD PTR [SavePtr]
  2836. int 10h
  2837. end;
  2838. end;
  2839. end;
  2840. procedure RestoreStateVESA; far;
  2841. begin
  2842. { go back to the old video mode...}
  2843. asm
  2844. mov ah,00
  2845. mov al,[VideoMode]
  2846. int 10h
  2847. end;
  2848. { then restore all state information }
  2849. if assigned(SavePtr) and (SaveSupported=TRUE) then
  2850. begin
  2851. { restore state, according to Ralph Brown Interrupt list }
  2852. asm
  2853. mov ax, 4F04h { save the state buffer }
  2854. mov cx, 00001111b { Save DAC / Data areas / Hardware states }
  2855. mov dx, 02h { restore state }
  2856. mov es, WORD PTR [SavePtr+2]
  2857. mov bx, WORD PTR [SavePtr]
  2858. int 10h
  2859. end;
  2860. FreeMem(SavePtr, 64*StateSize);
  2861. SavePtr := nil;
  2862. end;
  2863. end;
  2864. {$ENDIF DPMI}
  2865. {************************************************************************}
  2866. {* VESA Page flipping routines *}
  2867. {************************************************************************}
  2868. { Note: These routines, according to the VBE3 specification, will NOT }
  2869. { work with the 24 bpp modes, because of the alignment. }
  2870. {************************************************************************}
  2871. {******************************************************** }
  2872. { Procedure SetVisualVESA() }
  2873. {-------------------------------------------------------- }
  2874. { This routine changes the page which will be displayed }
  2875. { on the screen, since the method has changed somewhat }
  2876. { between VBE versions , we will use the old method where }
  2877. { the new pixel offset is used to display different pages }
  2878. {******************************************************** }
  2879. procedure SetVisualVESA(page: word);
  2880. var
  2881. newStartVisible : word;
  2882. begin
  2883. if page > HardwarePages then
  2884. begin
  2885. _graphresult := grError;
  2886. exit;
  2887. end;
  2888. newStartVisible := (MaxY+1)*page;
  2889. if newStartVisible > ScanLines then
  2890. begin
  2891. _graphresult := grError;
  2892. exit;
  2893. end;
  2894. asm
  2895. mov ax, 4f07h
  2896. mov bx, 0000h { set display start }
  2897. mov cx, 0000h { pixel zero ! }
  2898. mov dx, [NewStartVisible] { new scanline }
  2899. push ebp
  2900. push esi
  2901. push edi
  2902. push ebx
  2903. int 10h
  2904. pop ebx
  2905. pop edi
  2906. pop esi
  2907. pop ebp
  2908. end ['EDX','ECX','EBX','EAX'];
  2909. end;
  2910. procedure SetActiveVESA(page: word);
  2911. begin
  2912. { video offset is in pixels under VESA VBE! }
  2913. { This value is reset after a mode set to page ZERO = YOffset = 0 ) }
  2914. if page > HardwarePages then
  2915. begin
  2916. _graphresult := grError;
  2917. exit;
  2918. end;
  2919. YOffset := (MaxY+1)*page;
  2920. LinearPageOfs := YOffset*(MaxX+1);
  2921. end;