graph.pp 89 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by Florian Klaempfl
  5. This file implements the go32v2 support for the graph unit
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. unit Graph;
  13. interface
  14. {$i graphh.inc}
  15. {$i vesah.inc}
  16. CONST
  17. m640x200x16 = VGALo;
  18. m640x400x16 = VGAMed;
  19. m640x480x16 = VGAHi;
  20. { VESA Specific video modes. }
  21. m320x200x32k = $10D;
  22. m320x200x64k = $10E;
  23. m640x400x256 = $100;
  24. m640x480x256 = $101;
  25. m640x480x32k = $110;
  26. m640x480x64k = $111;
  27. m800x600x16 = $102;
  28. m800x600x256 = $103;
  29. m800x600x32k = $113;
  30. m800x600x64k = $114;
  31. m1024x768x16 = $104;
  32. m1024x768x256 = $105;
  33. m1024x768x32k = $116;
  34. m1024x768x64k = $117;
  35. m1280x1024x16 = $106;
  36. m1280x1024x256 = $107;
  37. m1280x1024x32k = $119;
  38. m1280x1024x64k = $11A;
  39. const
  40. UseLFB : boolean = false;
  41. UseNoSelector : boolean = false;
  42. LFBPointer : pointer = nil;
  43. implementation
  44. uses
  45. go32,ports;
  46. const
  47. InternalDriverName = 'DOSGX';
  48. {$i graph.inc}
  49. Type
  50. TDPMIRegisters = go32.registers;
  51. {$asmmode intel}
  52. { How to access real mode memory }
  53. { using 32-bit DPMI memory }
  54. { 1. Allocate a descriptor }
  55. { 2. Set segment limit }
  56. { 3. Set base linear address }
  57. const
  58. {$ifdef fpc}
  59. VideoOfs : longint = 0; { Segment to draw to }
  60. {$else fpc}
  61. VideoOfs : word = 0; { Segment to draw to }
  62. {$endif fpc}
  63. FirstPlane = $0102; (* 02 = Index to Color plane Select, *)
  64. (* 01 = Enable color plane 1 *)
  65. { ; ===== VGA Register Values ===== }
  66. SCREEN_WIDTH = 80 ; { MODE-X 320 SCREEN WIDTH }
  67. { CHANGE THE VALUE IF OTHER MODES }
  68. { OTHER THEN 320 ARE USED. }
  69. ATTRIB_Ctrl = $03C0 ; { VGA Attribute Controller }
  70. GC_Index = $03CE ; { VGA Graphics Controller }
  71. SC_Index = $03C4 ; { VGA Sequencer Controller }
  72. SC_Data = $03C5 ; { VGA Sequencer Data Port }
  73. CRTC_Index = $03D4 ; { VGA CRT Controller }
  74. CRTC_Data = $03D5 ; { VGA CRT Controller Data }
  75. MISC_OUTPUT = $03C2 ; { VGA Misc Register }
  76. INPUT_1 = $03DA ; { Input Status #1 Register }
  77. DAC_WRITE_ADDR = $03C8 ; { VGA DAC Write Addr Register }
  78. DAC_READ_ADDR = $03C7 ; { VGA DAC Read Addr Register }
  79. PEL_DATA_REG = $03C9 ; { VGA DAC/PEL data Register R/W }
  80. PIXEL_PAN_REG = $033 ; { Attrib Index: Pixel Pan Reg }
  81. MAP_MASK = $002 ; { S= $Index: Write Map Mask reg }
  82. READ_MAP = $004 ; { GC Index: Read Map Register }
  83. START_DISP_HI = $00C ; { CRTC Index: Display Start Hi }
  84. START_DISP_LO = $00D ; { CRTC Index: Display Start Lo }
  85. MAP_MASK_PLANE1 = $00102 ; { Map Register + Plane 1 }
  86. MAP_MASK_PLANE2 = $01102 ; { Map Register + Plane 1 }
  87. ALL_PLANES_ON = $00F02 ; { Map Register + All Bit Planes }
  88. CHAIN4_OFF = $00604 ; { Chain 4 mode Off }
  89. ASYNC_RESET = $00100 ; { (A)synchronous Reset }
  90. SEQU_RESTART = $00300 ; { Sequencer Restart }
  91. LATCHES_ON = $00008 ; { Bit Mask + Data from Latches }
  92. LATCHES_OFF = $0FF08 ; { Bit Mask + Data from CPU }
  93. VERT_RETRACE = $08 ; { INPUT_1: Vertical Retrace Bit }
  94. PLANE_BITS = $03 ; { Bits 0-1 of Xpos = Plane # }
  95. ALL_PLANES = $0F ; { All Bit Planes Selected }
  96. CHAR_BITS = $0F ; { Bits 0-3 of Character Data }
  97. GET_CHAR_PTR = $01130 ; { VGA BIOS Func: Get Char Set }
  98. ROM_8x8_Lo = $03 ; { ROM 8x8 Char Set Lo Pointer }
  99. ROM_8x8_Hi = $04 ; { ROM 8x8 Char Set Hi Pointer }
  100. { Constants Specific for these routines }
  101. NUM_MODES = $8 ; { # of Mode X Variations }
  102. { in 16 color modes, the actual colors used are not 0..15, but: }
  103. ToRealCols16: Array[0..15] of word =
  104. (0,1,2,3,4,5,20,7,56,57,58,59,60,61,62,63);
  105. var
  106. ScrWidth : word absolute $40:$4a;
  107. inWindows: boolean;
  108. {$ifndef tp}
  109. procedure seg_bytemove(sseg : word;source : longint;dseg : word;dest : longint;count : longint);
  110. begin
  111. asm
  112. push edi
  113. push esi
  114. push es
  115. push ds
  116. cld
  117. mov ecx,count
  118. mov esi,source
  119. mov edi,dest
  120. mov ax,dseg
  121. mov es,ax
  122. mov ax,sseg
  123. mov ds,ax
  124. rep movsb
  125. pop ds
  126. pop es
  127. pop esi
  128. pop edi
  129. end ['ESI','EDI','ECX','EAX']
  130. end;
  131. {$endif tp}
  132. {************************************************************************}
  133. {* 4-bit planar VGA mode routines *}
  134. {************************************************************************}
  135. Procedure Init640x200x16; {$ifndef fpc}far;{$endif fpc} assembler;
  136. { must also clear the screen...}
  137. asm
  138. mov ax,000Eh
  139. {$ifdef fpc}
  140. push ebp
  141. {$endif fpc}
  142. int 10h
  143. {$ifdef fpc}
  144. pop ebp
  145. {$endif fpc}
  146. end;
  147. Procedure Init640x350x16; {$ifndef fpc}far;{$endif fpc} assembler;
  148. { must also clear the screen...}
  149. asm
  150. mov ax,0010h
  151. {$ifdef fpc}
  152. push ebp
  153. {$endif fpc}
  154. int 10h
  155. {$ifdef fpc}
  156. pop ebp
  157. {$endif fpc}
  158. end;
  159. procedure Init640x480x16; {$ifndef fpc}far;{$endif fpc} assembler;
  160. { must also clear the screen...}
  161. asm
  162. mov ax,0012h
  163. {$ifdef fpc}
  164. push ebp
  165. {$endif fpc}
  166. int 10h
  167. {$ifdef fpc}
  168. pop ebp
  169. {$endif fpc}
  170. end;
  171. Procedure PutPixel16(X,Y : Integer; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
  172. {$ifndef asmgraph}
  173. var offset: word;
  174. dummy: byte;
  175. {$endif asmgraph}
  176. Begin
  177. X:= X + StartXViewPort;
  178. Y:= Y + StartYViewPort;
  179. { convert to absolute coordinates and then verify clipping...}
  180. if ClipPixels then
  181. Begin
  182. if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
  183. exit;
  184. if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
  185. exit;
  186. end;
  187. {$ifndef asmgraph}
  188. offset := y * 80 + (x shr 3) + VideoOfs;
  189. PortW[$3ce] := $0f01; { Index 01 : Enable ops on all 4 planes }
  190. PortW[$3ce] := (Pixel and $ff) shl 8; { Index 00 : Enable correct plane and write color }
  191. Port[$3ce] := 8;
  192. Port[$3cf] := $80 shr (x and $7); { Select correct bits to modify }
  193. dummy := Mem[SegA000: offset]; { Latch the data into host space. }
  194. Mem[Sega000: offset] := dummy; { Write the data into video memory }
  195. PortW[$3ce] := $ff08; { Enable all bit planes. }
  196. PortW[$3ce] := $0001; { Index 01 : Disable ops on all four planes. }
  197. {$else asmgraph}
  198. asm
  199. push ebx
  200. push edi
  201. {$ifndef fpc}
  202. mov es, [SegA000]
  203. {$endif fpc}
  204. { enable the set / reset function and load the color }
  205. mov dx, 3ceh
  206. mov ax, 0f01h
  207. out dx, ax
  208. { setup set/reset register }
  209. mov ax, [Pixel]
  210. shl ax, 8
  211. out dx, ax
  212. { setup the bit mask register }
  213. mov al, 8
  214. out dx, al
  215. inc dx
  216. { load the bitmask register }
  217. mov cx, [X]
  218. and cx, 0007h
  219. mov al, 80h
  220. shr al, cl
  221. out dx, ax
  222. {$ifndef fpc}
  223. { get the x index and divide by 8 for 16-color }
  224. mov ax,[X]
  225. shr ax,3
  226. push ax
  227. { determine the address }
  228. mov ax,80
  229. mov bx,[Y]
  230. mul bx
  231. pop cx
  232. add ax,cx
  233. mov di,ax
  234. add di, [VideoOfs]
  235. { send the data through the display memory through set/reset }
  236. mov bl,es:[di]
  237. mov es:[di],bl
  238. { reset for formal vga operation }
  239. mov dx,3ceh
  240. mov ax,0ff08h
  241. out dx,ax
  242. { restore enable set/reset register }
  243. mov ax,0001h
  244. out dx,ax
  245. {$else fpc}
  246. { get the x index and divide by 8 for 16-color }
  247. movzx eax,[X]
  248. shr eax,3
  249. push eax
  250. { determine the address }
  251. mov eax,80
  252. mov bx,[Y]
  253. mul bx
  254. pop ecx
  255. add eax,ecx
  256. mov edi,eax
  257. add edi, [VideoOfs]
  258. { send the data through the display memory through set/reset }
  259. mov bl,fs:[edi+$a0000]
  260. mov fs:[edi+$a0000],bl
  261. { reset for formal vga operation }
  262. mov dx,3ceh
  263. mov ax,0ff08h
  264. out dx,ax
  265. { restore enable set/reset register }
  266. mov ax,0001h
  267. out dx,ax
  268. pop edi
  269. pop ebx
  270. {$endif fpc}
  271. end;
  272. {$endif asmgraph}
  273. end;
  274. Function GetPixel16(X,Y: Integer):word; {$ifndef fpc}far;{$endif fpc}
  275. {$ifndef asmgraph}
  276. Var dummy, offset: Word;
  277. shift: byte;
  278. {$endif asmgraph}
  279. Begin
  280. X:= X + StartXViewPort;
  281. Y:= Y + StartYViewPort;
  282. {$ifndef asmgraph}
  283. offset := Y * 80 + (x shr 3) + VideoOfs;
  284. Port[$3ce] := 4;
  285. shift := 7 - (X and 7);
  286. Port[$3cf] := 0;
  287. dummy := (Mem[Sega000:offset] shr shift) and 1;
  288. Port[$3cf] := 1;
  289. dummy := dummy or (((Mem[Sega000:offset] shr shift) and 1) shl 1);
  290. Port[$3cf] := 2;
  291. dummy := dummy or (((Mem[Sega000:offset] shr shift) and 1) shl 2);
  292. Port[$3cf] := 3;
  293. dummy := dummy or (((Mem[Sega000:offset] shr shift) and 1) shl 3);
  294. GetPixel16 := dummy;
  295. {$else asmgraph}
  296. asm
  297. {$ifndef fpc}
  298. push esi
  299. push edi
  300. push ebx
  301. mov ax, [X] { Get X address }
  302. push ax
  303. shr ax, 3
  304. push ax
  305. mov ax,80
  306. mov bx,[Y]
  307. mul bx
  308. pop cx
  309. add ax,cx
  310. mov si,ax { SI = correct offset into video segment }
  311. mov es,[SegA000]
  312. add si,[VideoOfs] { Point to correct page offset... }
  313. mov dx,03ceh
  314. mov ax,4
  315. out dx,al
  316. inc dx
  317. pop ax
  318. and ax,0007h
  319. mov cl,07
  320. sub cl,al
  321. mov bl,cl
  322. { read plane 0 }
  323. mov al,0 { Select plane to read }
  324. out dx,al
  325. mov al,es:[si] { read display memory }
  326. shr al,cl
  327. and al,01h
  328. mov ah,al { save bit in AH }
  329. { read plane 1 }
  330. mov al,1 { Select plane to read }
  331. out dx,al
  332. mov al,es:[si]
  333. shr al,cl
  334. and al,01h
  335. shl al,1
  336. or ah,al { save bit in AH }
  337. { read plane 2 }
  338. mov al,2 { Select plane to read }
  339. out dx,al
  340. mov al,es:[si]
  341. shr al,cl
  342. and al,01h
  343. shl al,2
  344. or ah,al { save bit in AH }
  345. { read plane 3 }
  346. mov al,3 { Select plane to read }
  347. out dx,al
  348. mov al,es:[si]
  349. shr al,cl
  350. and al,01h
  351. shl al,3
  352. or ah,al { save bit in AH }
  353. mov al,ah { 16-bit pixel in AX }
  354. xor ah,ah
  355. mov @Result, ax
  356. {$else fpc}
  357. movzx eax, [X] { Get X address }
  358. push eax
  359. shr eax, 3
  360. push eax
  361. mov eax,80
  362. mov bx,[Y]
  363. mul bx
  364. pop ecx
  365. add eax,ecx
  366. mov esi,eax { SI = correct offset into video segment }
  367. add esi,[VideoOfs] { Point to correct page offset... }
  368. mov dx,03ceh
  369. mov ax,4
  370. out dx,al
  371. inc dx
  372. pop eax
  373. and eax,0007h
  374. mov cl,07
  375. sub cl,al
  376. mov bl,cl
  377. { read plane 0 }
  378. mov al,0 { Select plane to read }
  379. out dx,al
  380. mov al,fs:[esi+$a0000] { read display memory }
  381. shr al,cl
  382. and al,01h
  383. mov ah,al { save bit in AH }
  384. { read plane 1 }
  385. mov al,1 { Select plane to read }
  386. out dx,al
  387. mov al,fs:[esi+$a0000]
  388. shr al,cl
  389. and al,01h
  390. shl al,1
  391. or ah,al { save bit in AH }
  392. { read plane 2 }
  393. mov al,2 { Select plane to read }
  394. out dx,al
  395. mov al,fs:[esi+$a0000]
  396. shr al,cl
  397. and al,01h
  398. shl al,2
  399. or ah,al { save bit in AH }
  400. { read plane 3 }
  401. mov al,3 { Select plane to read }
  402. out dx,al
  403. mov al,fs:[esi+$a0000]
  404. shr al,cl
  405. and al,01h
  406. shl al,3
  407. or ah,al { save bit in AH }
  408. mov al,ah { 16-bit pixel in AX }
  409. xor ah,ah
  410. mov @Result, ax
  411. pop ebx
  412. pop edi
  413. pop esi
  414. {$endif fpc}
  415. end;
  416. {$endif asmgraph}
  417. end;
  418. Procedure GetScanLine16(x1, x2, y: integer; var data);
  419. var dummylong: longint;
  420. Offset, count, count2, amount, index: word;
  421. plane: byte;
  422. Begin
  423. inc(x1,StartXViewPort);
  424. inc(x2,StartXViewPort);
  425. {$ifdef logging}
  426. LogLn('GetScanLine16 start, length to get: '+strf(x2-x1+1)+' at y = '+strf(y));
  427. {$Endif logging}
  428. offset := (Y + StartYViewPort) * 80 + (x1 shr 3) + VideoOfs;
  429. {$ifdef logging}
  430. LogLn('Offset: '+HexStr(offset,4)+' - ' + strf(offset));
  431. {$Endif logging}
  432. { first get enough pixels so offset is 32bit aligned }
  433. amount := 0;
  434. index := 0;
  435. If ((x1 and 31) <> 0) Or
  436. ((x2-x1+1) < 32) Then
  437. Begin
  438. If ((x2-x1+1) >= 32+32-(x1 and 31)) Then
  439. amount := 32-(x1 and 31)
  440. Else amount := x2-x1+1;
  441. {$ifdef logging}
  442. LogLn('amount to align to 32bits or to get all: ' + strf(amount));
  443. {$Endif logging}
  444. For count := 0 to amount-1 do
  445. WordArray(Data)[Count] := getpixel16(x1-StartXViewPort+Count,y);
  446. index := amount;
  447. Inc(Offset,(amount+7) shr 3);
  448. {$ifdef logging}
  449. LogLn('offset now: '+HexStr(offset,4)+' - ' + strf(offset));
  450. LogLn('index now: '+strf(index));
  451. {$Endif logging}
  452. End;
  453. amount := x2-x1+1 - amount;
  454. {$ifdef logging}
  455. LogLn('amount left: ' + strf(amount));
  456. {$Endif logging}
  457. If amount = 0 Then Exit;
  458. Port[$3ce] := 4;
  459. { first get everything from plane 3 (4th plane) }
  460. Port[$3cf] := 3;
  461. Count := 0;
  462. For Count := 1 to (amount shr 5) Do
  463. Begin
  464. dummylong := MemL[SegA000:offset+(Count-1)*4];
  465. dummylong :=
  466. ((dummylong and $ff) shl 24) or
  467. ((dummylong and $ff00) shl 8) or
  468. ((dummylong and $ff0000) shr 8) or
  469. ((dummylong and $ff000000) shr 24);
  470. For Count2 := 31 downto 0 Do
  471. Begin
  472. WordArray(Data)[index+Count2] := DummyLong and 1;
  473. DummyLong := DummyLong shr 1;
  474. End;
  475. Inc(Index, 32);
  476. End;
  477. { Now get the data from the 3 other planes }
  478. plane := 3;
  479. Repeat
  480. Dec(Index,Count*32);
  481. Dec(plane);
  482. Port[$3cf] := plane;
  483. Count := 0;
  484. For Count := 1 to (amount shr 5) Do
  485. Begin
  486. dummylong := MemL[SegA000:offset+(Count-1)*4];
  487. dummylong :=
  488. ((dummylong and $ff) shl 24) or
  489. ((dummylong and $ff00) shl 8) or
  490. ((dummylong and $ff0000) shr 8) or
  491. ((dummylong and $ff000000) shr 24);
  492. For Count2 := 31 downto 0 Do
  493. Begin
  494. WordArray(Data)[index+Count2] :=
  495. (WordArray(Data)[index+Count2] shl 1) or (DummyLong and 1);
  496. DummyLong := DummyLong shr 1;
  497. End;
  498. Inc(Index, 32);
  499. End;
  500. Until plane = 0;
  501. amount := amount and 31;
  502. Dec(index);
  503. {$ifdef Logging}
  504. LogLn('Last array index written to: '+strf(index));
  505. LogLn('amount left: '+strf(amount)+' starting at x = '+strf(index+1));
  506. {$Endif logging}
  507. dec(x1,startXViewPort);
  508. For Count := 1 to amount Do
  509. WordArray(Data)[index+Count] := getpixel16(x1+index+Count,y);
  510. {$ifdef logging}
  511. inc(x1,startXViewPort);
  512. LogLn('First 32 bytes gotten with getscanline16: ');
  513. If x2-x1+1 >= 32 Then
  514. Count2 := 32
  515. Else Count2 := x2-x1+1;
  516. For Count := 0 to Count2-1 Do
  517. Log(strf(WordArray(Data)[Count])+' ');
  518. LogLn('');
  519. If x2-x1+1 >= 32 Then
  520. Begin
  521. LogLn('Last 32 bytes gotten with getscanline16: ');
  522. For Count := 31 downto 0 Do
  523. Log(strf(WordArray(Data)[x2-x1-Count])+' ');
  524. End;
  525. LogLn('');
  526. GetScanLineDefault(x1-StartXViewPort,x2-StartXViewPort,y,Data);
  527. LogLn('First 32 bytes gotten with getscanlinedef: ');
  528. If x2-x1+1 >= 32 Then
  529. Count2 := 32
  530. Else Count2 := x2-x1+1;
  531. For Count := 0 to Count2-1 Do
  532. Log(strf(WordArray(Data)[Count])+' ');
  533. LogLn('');
  534. If x2-x1+1 >= 32 Then
  535. Begin
  536. LogLn('Last 32 bytes gotten with getscanlinedef: ');
  537. For Count := 31 downto 0 Do
  538. Log(strf(WordArray(Data)[x2-x1-Count])+' ');
  539. End;
  540. LogLn('');
  541. LogLn('GetScanLine16 end');
  542. {$Endif logging}
  543. End;
  544. Procedure DirectPutPixel16(X,Y : Integer); {$ifndef fpc}far;{$endif fpc}
  545. { x,y -> must be in global coordinates. No clipping. }
  546. var
  547. color: word;
  548. {$ifndef asmgraph}
  549. offset: word;
  550. dummy: byte;
  551. {$endif asmgraph}
  552. begin
  553. case CurrentWriteMode of
  554. XORPut:
  555. begin
  556. { getpixel wants local/relative coordinates }
  557. Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
  558. Color := CurrentColor Xor Color;
  559. end;
  560. OrPut:
  561. begin
  562. { getpixel wants local/relative coordinates }
  563. Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
  564. Color := CurrentColor Or Color;
  565. end;
  566. AndPut:
  567. begin
  568. { getpixel wants local/relative coordinates }
  569. Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
  570. Color := CurrentColor And Color;
  571. end;
  572. NotPut:
  573. begin
  574. Color := Not Color;
  575. end
  576. else
  577. Color := CurrentColor;
  578. end;
  579. {$ifndef asmgraph}
  580. offset := Y * 80 + (X shr 3) + VideoOfs;
  581. PortW[$3ce] := $f01;
  582. PortW[$3ce] := Color shl 8;
  583. Port[$3ce] := 8;
  584. Port[$3cf] := $80 shr (X and 7);
  585. dummy := Mem[SegA000: offset];
  586. Mem[Sega000: offset] := dummy;
  587. PortW[$3ce] := $ff08;
  588. PortW[$3ce] := $0001;
  589. {$else asmgraph}
  590. { note: still needs xor/or/and/notput support !!!!! (JM) }
  591. asm
  592. push esi
  593. push edi
  594. push ebx
  595. {$ifndef fpc}
  596. mov es, [SegA000]
  597. { enable the set / reset function and load the color }
  598. mov dx, 3ceh
  599. mov ax, 0f01h
  600. out dx, ax
  601. { setup set/reset register }
  602. mov ax, [Color]
  603. shl ax, 8
  604. out dx, ax
  605. { setup the bit mask register }
  606. mov al, 8
  607. out dx, al
  608. inc dx
  609. { load the bitmask register }
  610. mov cx, [X]
  611. and cx, 0007h
  612. mov al, 80h
  613. shr al, cl
  614. out dx, ax
  615. { get the x index and divide by 8 for 16-color }
  616. mov ax,[X]
  617. shr ax,3
  618. push ax
  619. { determine the address }
  620. mov ax,80
  621. mov bx,[Y]
  622. mul bx
  623. pop cx
  624. add ax,cx
  625. mov di,ax
  626. { send the data through the display memory through set/reset }
  627. add di,[VideoOfs] { add correct page }
  628. mov bl,es:[di]
  629. mov es:[di],bl
  630. { reset for formal vga operation }
  631. mov dx,3ceh
  632. mov ax,0ff08h
  633. out dx,ax
  634. { restore enable set/reset register }
  635. mov ax,0001h
  636. out dx,ax
  637. {$else fpc}
  638. { enable the set / reset function and load the color }
  639. mov dx, 3ceh
  640. mov ax, 0f01h
  641. out dx, ax
  642. { setup set/reset register }
  643. mov ax, [Color]
  644. shl ax, 8
  645. out dx, ax
  646. { setup the bit mask register }
  647. mov al, 8
  648. out dx, al
  649. inc dx
  650. { load the bitmask register }
  651. mov cx, [X]
  652. and cx, 0007h
  653. mov al, 80h
  654. shr al, cl
  655. out dx, ax
  656. { get the x index and divide by 8 for 16-color }
  657. movzx eax,[X]
  658. shr eax,3
  659. push eax
  660. { determine the address }
  661. mov eax,80
  662. mov bx,[Y]
  663. mul bx
  664. pop ecx
  665. add eax,ecx
  666. mov edi,eax
  667. { send the data through the display memory through set/reset }
  668. add edi,[VideoOfs] { add correct page }
  669. mov bl,fs:[edi+$a0000]
  670. mov fs:[edi+$a0000],bl
  671. { reset for formal vga operation }
  672. mov dx,3ceh
  673. mov ax,0ff08h
  674. out dx,ax
  675. { restore enable set/reset register }
  676. mov ax,0001h
  677. out dx,ax
  678. pop ebx
  679. pop edi
  680. pop esi
  681. {$endif fpc}
  682. end;
  683. {$endif asmgraph}
  684. end;
  685. procedure HLine16(x,x2,y: integer); {$ifndef fpc}far;{$endif fpc}
  686. var
  687. xtmp: integer;
  688. ScrOfs,HLength : word;
  689. LMask,RMask : byte;
  690. Begin
  691. { must we swap the values? }
  692. if x > x2 then
  693. Begin
  694. xtmp := x2;
  695. x2 := x;
  696. x:= xtmp;
  697. end;
  698. { First convert to global coordinates }
  699. X := X + StartXViewPort;
  700. X2 := X2 + StartXViewPort;
  701. Y := Y + StartYViewPort;
  702. if ClipPixels then
  703. Begin
  704. if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
  705. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  706. exit;
  707. end;
  708. ScrOfs:=y*ScrWidth+x div 8;
  709. HLength:=x2 div 8-x div 8;
  710. LMask:=$ff shr (x and 7);
  711. {$ifopt r+}
  712. {$define rangeOn}
  713. {$r-}
  714. {$endif}
  715. {$ifopt q+}
  716. {$define overflowOn}
  717. {$q-}
  718. {$endif}
  719. RMask:=$ff shl (7-(x2 and 7));
  720. {$ifdef rangeOn}
  721. {$undef rangeOn}
  722. {$r+}
  723. {$endif}
  724. {$ifdef overflowOn}
  725. {$undef overflowOn}
  726. {$q+}
  727. {$endif}
  728. if HLength=0 then
  729. LMask:=LMask and RMask;
  730. Port[$3ce]:=0;
  731. If CurrentWriteMode <> NotPut Then
  732. Port[$3cf]:= CurrentColor
  733. else Port[$3cf]:= not CurrentColor;
  734. Port[$3ce]:=1;
  735. Port[$3cf]:=$f;
  736. Port[$3ce]:=3;
  737. case CurrentWriteMode of
  738. XORPut:
  739. Port[$3cf]:=3 shl 3;
  740. ANDPut:
  741. Port[$3cf]:=1 shl 3;
  742. ORPut:
  743. Port[$3cf]:=2 shl 3;
  744. NormalPut, NotPut:
  745. Port[$3cf]:=0
  746. else
  747. Port[$3cf]:=0
  748. end;
  749. Port[$3ce]:=8;
  750. Port[$3cf]:=LMask;
  751. {$ifopt r+}
  752. {$define rangeOn}
  753. {$r-}
  754. {$endif}
  755. {$ifopt q+}
  756. {$define overflowOn}
  757. {$q-}
  758. {$endif}
  759. Mem[SegA000:ScrOfs]:=Mem[SegA000:ScrOfs]+1;
  760. {$ifdef rangeOn}
  761. {$undef rangeOn}
  762. {$r+}
  763. {$endif}
  764. {$ifdef overflowOn}
  765. {$undef overflowOn}
  766. {$q+}
  767. {$endif}
  768. Port[$3ce]:=8;
  769. if HLength>0 then
  770. begin
  771. dec(HLength);
  772. inc(ScrOfs);
  773. if HLength>0 then
  774. begin
  775. Port[$3cf]:=$ff;
  776. {$ifndef tp}
  777. seg_bytemove(dosmemselector,$a0000+ScrOfs,dosmemselector,$a0000+ScrOfs,HLength);
  778. {$else}
  779. move(Ptr(SegA000,ScrOfs)^, Ptr(SegA000,ScrOfs)^, HLength);
  780. {$endif}
  781. ScrOfs:=ScrOfs+HLength;
  782. end;
  783. Port[$3cf]:=RMask;
  784. {$ifopt r+}
  785. {$define rangeOn}
  786. {$r-}
  787. {$endif}
  788. {$ifopt q+}
  789. {$define overflowOn}
  790. {$q-}
  791. {$endif}
  792. Mem[Sega000:ScrOfs]:=Mem[SegA000:ScrOfs]+1;
  793. {$ifdef rangeOn}
  794. {$undef rangeOn}
  795. {$r+}
  796. {$endif}
  797. {$ifdef overflowOn}
  798. {$undef overflowOn}
  799. {$q+}
  800. {$endif}
  801. end;
  802. { clean up }
  803. Port[$3cf]:=0;
  804. Port[$3ce]:=8;
  805. Port[$3cf]:=$ff;
  806. Port[$3ce]:=1;
  807. Port[$3cf]:=0;
  808. Port[$3ce]:=3;
  809. Port[$3cf]:=0;
  810. end;
  811. procedure VLine16(x,y,y2: integer); {$ifndef fpc}far;{$endif fpc}
  812. var
  813. ytmp: integer;
  814. ScrOfs,i : longint;
  815. BitMask : byte;
  816. Begin
  817. { must we swap the values? }
  818. if y > y2 then
  819. Begin
  820. ytmp := y2;
  821. y2 := y;
  822. y:= ytmp;
  823. end;
  824. { First convert to global coordinates }
  825. X := X + StartXViewPort;
  826. Y2 := Y2 + StartYViewPort;
  827. Y := Y + StartYViewPort;
  828. if ClipPixels then
  829. Begin
  830. if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
  831. StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
  832. exit;
  833. end;
  834. ScrOfs:=y*ScrWidth+x div 8;
  835. BitMask:=$80 shr (x and 7);
  836. Port[$3ce]:=0;
  837. If CurrentWriteMode <> NotPut Then
  838. Port[$3cf]:= CurrentColor
  839. else Port[$3cf]:= not CurrentColor;
  840. Port[$3ce]:=1;
  841. Port[$3cf]:=$f;
  842. Port[$3ce]:=8;
  843. Port[$3cf]:=BitMask;
  844. Port[$3ce]:=3;
  845. case CurrentWriteMode of
  846. XORPut:
  847. Port[$3cf]:=3 shl 3;
  848. ANDPut:
  849. Port[$3cf]:=1 shl 3;
  850. ORPut:
  851. Port[$3cf]:=2 shl 3;
  852. NormalPut, NotPut:
  853. Port[$3cf]:=0
  854. else
  855. Port[$3cf]:=0
  856. end;
  857. for i:=y to y2 do
  858. begin
  859. {$ifopt r+}
  860. {$define rangeOn}
  861. {$r-}
  862. {$endif}
  863. {$ifopt q+}
  864. {$define overflowOn}
  865. {$q-}
  866. {$endif}
  867. Mem[SegA000:ScrOfs]:=Mem[Sega000:ScrOfs]+1;
  868. {$ifdef rangeOn}
  869. {$undef rangeOn}
  870. {$r+}
  871. {$endif}
  872. {$ifdef overflowOn}
  873. {$undef overflowOn}
  874. {$q+}
  875. {$endif}
  876. ScrOfs:=ScrOfs+ScrWidth;
  877. end;
  878. { clean up }
  879. Port[$3cf]:=0;
  880. Port[$3ce]:=8;
  881. Port[$3cf]:=$ff;
  882. Port[$3ce]:=1;
  883. Port[$3cf]:=0;
  884. Port[$3ce]:=3;
  885. Port[$3cf]:=0;
  886. End;
  887. procedure SetVisual480(page: word); {$ifndef fpc}far;{$endif fpc}
  888. { no page flipping supPort in 640x480 mode }
  889. begin
  890. VideoOfs := 0;
  891. end;
  892. procedure SetActive480(page: word); {$ifndef fpc}far;{$endif fpc}
  893. { no page flipping supPort in 640x480 mode }
  894. begin
  895. VideoOfs := 0;
  896. end;
  897. procedure SetVisual200(page: word); {$ifndef fpc}far;{$endif fpc}
  898. { two page supPort... }
  899. begin
  900. if page > HardwarePages then exit;
  901. asm
  902. mov ax,[page] { only lower byte is supPorted. }
  903. mov ah,05h
  904. {$ifdef fpc}
  905. push ebp
  906. {$endif fpc}
  907. int 10h
  908. {$ifdef fpc}
  909. pop ebp
  910. {$endif fpc}
  911. { read start address }
  912. mov dx,3d4h
  913. mov al,0ch
  914. out dx,al
  915. inc dx
  916. in al,dx
  917. mov ah,al
  918. dec dx
  919. mov al,0dh
  920. out dx,al
  921. in al,dx
  922. end;
  923. end;
  924. procedure SetActive200(page: word); {$ifndef fpc}far;{$endif fpc}
  925. { two page supPort... }
  926. begin
  927. case page of
  928. 0 : VideoOfs := 0;
  929. 1 : VideoOfs := 16384;
  930. 2 : VideoOfs := 32768;
  931. else
  932. VideoOfs := 0;
  933. end;
  934. end;
  935. procedure SetVisual350(page: word); {$ifndef fpc}far;{$endif fpc}
  936. { one page supPort... }
  937. begin
  938. if page > HardwarePages then exit;
  939. asm
  940. mov ax,[page] { only lower byte is supPorted. }
  941. mov ah,05h
  942. {$ifdef fpc}
  943. push ebp
  944. {$endif fpc}
  945. int 10h
  946. {$ifdef fpc}
  947. pop ebp
  948. {$endif fpc}
  949. end;
  950. end;
  951. procedure SetActive350(page: word); {$ifndef fpc}far;{$endif fpc}
  952. { one page supPort... }
  953. begin
  954. case page of
  955. 0 : VideoOfs := 0;
  956. 1 : VideoOfs := 32768;
  957. else
  958. VideoOfs := 0;
  959. end;
  960. end;
  961. {************************************************************************}
  962. {* 320x200x256c Routines *}
  963. {************************************************************************}
  964. Procedure Init320; {$ifndef fpc}far;{$endif fpc} assembler;
  965. asm
  966. mov ax,0013h
  967. {$ifdef fpc}
  968. push ebp
  969. {$endif fpc}
  970. int 10h
  971. {$ifdef fpc}
  972. pop ebp
  973. {$endif fpc}
  974. end;
  975. Procedure PutPixel320(X,Y : Integer; Pixel: Word); {$ifndef fpc}far;{$endif fpc}
  976. { x,y -> must be in local coordinates. Clipping if required. }
  977. {$ifndef fpc}
  978. Begin
  979. X:= X + StartXViewPort;
  980. Y:= Y + StartYViewPort;
  981. { convert to absolute coordinates and then verify clipping...}
  982. if ClipPixels then
  983. Begin
  984. if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
  985. exit;
  986. if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
  987. exit;
  988. end;
  989. asm
  990. mov es, [SegA000]
  991. mov ax, [Y]
  992. mov di, [X]
  993. xchg ah, al { The value of Y must be in AH }
  994. add di, ax
  995. shr ax, 2
  996. add di, ax
  997. add di, [VideoOfs] { point to correct page.. }
  998. mov ax, [Pixel]
  999. mov es:[di], al
  1000. end;
  1001. {$else fpc}
  1002. assembler;
  1003. asm
  1004. push edi
  1005. push ebx
  1006. {$IFDEF REGCALL}
  1007. movsx edi, ax
  1008. movsx ebx, dx
  1009. mov al, cl
  1010. {$ELSE REGCALL}
  1011. movsx edi, x
  1012. movsx ebx, y
  1013. {$ENDIF REGCALL}
  1014. cmp clippixels, 0
  1015. je @putpix320noclip
  1016. test edi, edi
  1017. jl @putpix320done
  1018. test ebx, ebx
  1019. jl @putpix320done
  1020. cmp di, ViewWidth
  1021. jg @putpix320done
  1022. cmp bx, ViewHeight
  1023. jg @putpix320done
  1024. @putpix320noclip:
  1025. movsx ecx, StartYViewPort
  1026. movsx edx, StartXViewPort
  1027. add ebx, ecx
  1028. add edi, edx
  1029. { add edi, [VideoOfs] no multiple pages in 320*200*256 }
  1030. {$IFNDEF REGCALL}
  1031. mov ax, [pixel]
  1032. {$ENDIF REGCALL}
  1033. shl ebx, 6
  1034. add edi, ebx
  1035. mov fs:[edi+ebx*4+$a0000], al
  1036. @putpix320done:
  1037. pop ebx
  1038. pop edi
  1039. {$endif fpc}
  1040. end;
  1041. Function GetPixel320(X,Y: Integer):word; {$ifndef fpc}far;{$endif fpc}
  1042. {$ifndef fpc}
  1043. Begin
  1044. X:= X + StartXViewPort;
  1045. Y:= Y + StartYViewPort;
  1046. asm
  1047. mov es, [SegA000]
  1048. mov ax, [Y]
  1049. mov di, [X]
  1050. xchg ah, al { The value of Y must be in AH }
  1051. add di, ax
  1052. shr ax, 2
  1053. add di, ax
  1054. xor ax, ax
  1055. add di, [VideoOfs] { point to correct gfx page ... }
  1056. mov al,es:[di]
  1057. mov @Result,ax
  1058. end;
  1059. {$else fpc}
  1060. assembler;
  1061. asm
  1062. push edi
  1063. push ebx
  1064. {$IFDEF REGCALL}
  1065. movsx edi, ax
  1066. movsx ebx, dx
  1067. {$ELSE REGCALL}
  1068. movsx edi, x
  1069. movsx ebx, y
  1070. {$ENDIF REGCALL}
  1071. movsx ecx, StartYViewPort
  1072. movsx edx, StartXViewPort
  1073. add ebx, ecx
  1074. add edi, edx
  1075. { add edi, [VideoOfs] no multiple pages in 320*200*256 }
  1076. shl ebx, 6
  1077. add edi, ebx
  1078. movzx ax, byte ptr fs:[edi+ebx*4+$a0000]
  1079. pop ebx
  1080. pop edi
  1081. {$endif fpc}
  1082. end;
  1083. Procedure DirectPutPixel320(X,Y : Integer); {$ifndef fpc}far;{$endif fpc}
  1084. { x,y -> must be in global coordinates. No clipping. }
  1085. {$ifndef asmgraph}
  1086. var offset: word;
  1087. dummy: Byte;
  1088. begin
  1089. dummy := CurrentColor;
  1090. offset := y * 320 + x + VideoOfs;
  1091. case CurrentWriteMode of
  1092. XorPut: dummy := dummy xor Mem[Sega000:offset];
  1093. OrPut: dummy := dummy or Mem[Sega000:offset];
  1094. AndPut: dummy := dummy and Mem[SegA000:offset];
  1095. NotPut: dummy := Not dummy;
  1096. end;
  1097. Mem[SegA000:offset] := dummy;
  1098. end;
  1099. {$else asmgraph}
  1100. { note: still needs or/and/notput support !!!!! (JM) }
  1101. assembler;
  1102. asm
  1103. {$ifndef fpc}
  1104. mov es, [SegA000]
  1105. mov ax, [Y]
  1106. mov di, [X]
  1107. xchg ah, al { The value of Y must be in AH }
  1108. add di, ax
  1109. shr ax, 2
  1110. add di, ax
  1111. { add di, [VideoOfs] no multiple pages support in 320*200*256 }
  1112. mov ax, [CurrentColor]
  1113. cmp [CurrentWriteMode],XORPut { check write mode }
  1114. jne @MOVMode
  1115. mov ah,es:[di] { read the byte... }
  1116. xor al,ah { xor it and return value into AL }
  1117. @MovMode:
  1118. mov es:[di], al
  1119. {$else fpc}
  1120. push edi
  1121. push ebx
  1122. {$IFDEF REGCALL}
  1123. movzx edi, ax
  1124. movzx ebx, dx
  1125. {$ELSE REGCALL}
  1126. movzx edi, x
  1127. movzx ebx, y
  1128. {$ENDIF REGCALL}
  1129. { add edi, [VideoOfs] no multiple pages in 320*200*256 }
  1130. shl ebx, 6
  1131. add edi, ebx
  1132. mov ax, [CurrentColor]
  1133. cmp [CurrentWriteMode],XORPut { check write mode }
  1134. jne @MOVMode
  1135. xor al, fs:[edi+ebx*4+$a0000]
  1136. @MovMode:
  1137. mov fs:[edi+ebx*4+$a0000], al
  1138. pop ebx
  1139. pop edi
  1140. {$endif fpc}
  1141. end;
  1142. {$endif asmgraph}
  1143. procedure SetVisual320(page: word); {$ifndef fpc}far;{$endif fpc}
  1144. { no page supPort... }
  1145. begin
  1146. VideoOfs := 0;
  1147. end;
  1148. procedure SetActive320(page: word); {$ifndef fpc}far;{$endif fpc}
  1149. { no page supPort... }
  1150. begin
  1151. VideoOfs := 0;
  1152. end;
  1153. {************************************************************************}
  1154. {* Mode-X related routines *}
  1155. {************************************************************************}
  1156. const CrtAddress: word = 0;
  1157. procedure InitModeX; {$ifndef fpc}far;{$endif fpc}
  1158. begin
  1159. asm
  1160. {see if we are using color-/monochorme display}
  1161. MOV DX,3CCh {use output register: }
  1162. IN AL,DX
  1163. TEST AL,1 {is it a color display? }
  1164. MOV DX,3D4h
  1165. JNZ @L1 {yes }
  1166. MOV DX,3B4h {no }
  1167. @L1: {DX = 3B4h / 3D4h = CRTAddress-register for monochrome/color}
  1168. MOV CRTAddress,DX
  1169. MOV AX, 0013h
  1170. {$ifdef fpc}
  1171. push ebp
  1172. {$EndIf fpc}
  1173. INT 10h
  1174. {$ifdef fpc}
  1175. pop ebp
  1176. {$EndIf fpc}
  1177. MOV DX,03C4h {select memory-mode-register at sequencer Port }
  1178. MOV AL,04
  1179. OUT DX,AL
  1180. INC DX {read in data via the according data register }
  1181. IN AL,DX
  1182. AND AL,0F7h {bit 3 := 0: don't chain the 4 planes}
  1183. OR AL,04 {bit 2 := 1: no odd/even mechanism }
  1184. OUT DX,AL {activate new settings }
  1185. MOV DX,03C4h {s.a.: address sequencer reg. 2 (=map-mask),... }
  1186. MOV AL,02
  1187. OUT DX,AL
  1188. INC DX
  1189. MOV AL,0Fh {...and allow access to all 4 bit maps }
  1190. OUT DX,AL
  1191. {$ifndef fpc}
  1192. MOV AX,[SegA000] {starting with segment A000h, set 8000h logical }
  1193. MOV ES,AX {words = 4*8000h physical words (because of 4 }
  1194. XOR DI,DI {bitplanes) to 0 }
  1195. XOR AX,AX
  1196. MOV CX,8000h
  1197. CLD
  1198. REP STOSW
  1199. {$else fpc}
  1200. push edi
  1201. push es
  1202. push fs
  1203. mov edi, $a0000
  1204. pop es
  1205. xor eax, eax
  1206. mov ecx, 4000h
  1207. cld
  1208. rep stosd
  1209. pop es
  1210. pop edi
  1211. {$EndIf fpc}
  1212. MOV DX,CRTAddress {address the underline-location-register at }
  1213. MOV AL,14h {the CRT-controller Port, read out the according }
  1214. OUT DX,AL {data register: }
  1215. INC DX
  1216. IN AL,DX
  1217. AND AL,0BFh {bit 6:=0: no double word addressing scheme in}
  1218. OUT DX,AL {video RAM }
  1219. DEC DX
  1220. MOV AL,17h {select mode control register }
  1221. OUT DX,AL
  1222. INC DX
  1223. IN AL,DX
  1224. OR AL,40h {bit 6 := 1: memory access scheme=linear bit array }
  1225. OUT DX,AL
  1226. end;
  1227. end;
  1228. Function GetPixelX(X,Y: Integer): word; {$ifndef fpc}far;{$endif fpc}
  1229. {$ifndef asmgraph}
  1230. var offset: word;
  1231. {$endif asmgraph}
  1232. begin
  1233. X:= X + StartXViewPort;
  1234. Y:= Y + StartYViewPort;
  1235. {$ifndef asmgraph}
  1236. offset := y * 80 + x shr 2 + VideoOfs;
  1237. PortW[$3ce] := ((x and 3) shl 8) + 4;
  1238. GetPixelX := Mem[SegA000:offset];
  1239. {$else asmgraph}
  1240. asm
  1241. {$ifndef fpc}
  1242. mov di,[Y] ; (* DI = Y coordinate *)
  1243. (* Multiply by 80 start *)
  1244. mov bx, di
  1245. shl di, 6 ; (* Faster on 286/386/486 machines *)
  1246. shl bx, 4
  1247. add di, bx ; (* Multiply Value by 80 *)
  1248. (* End multiply by 80 *)
  1249. mov cx, [X]
  1250. mov ax, cx
  1251. {DI = Y * LINESIZE, BX = X, coordinates admissible}
  1252. shr ax, 1 ; (* Faster on 286/86 machines *)
  1253. shr ax, 1
  1254. add di, ax ; {DI = Y * LINESIZE + (X SHR 2) }
  1255. add di, [VideoOfs] ; (* Pointing at start of Active page *)
  1256. (* Select plane to use *)
  1257. mov dx, 03c4h
  1258. mov ax, FirstPlane ; (* Map Mask & Plane Select Register *)
  1259. and cl, 03h ; (* Get Plane Bits *)
  1260. shl ah, cl ; (* Get Plane Select Value *)
  1261. out dx, ax
  1262. (* End selection of plane *)
  1263. mov es,[SegA000]
  1264. mov al, ES:[DI]
  1265. xor ah, ah
  1266. mov @Result, ax
  1267. {$else fpc}
  1268. push edi
  1269. push ebx
  1270. movzx edi,[Y] ; (* DI = Y coordinate *)
  1271. (* Multiply by 80 start *)
  1272. mov ebx, edi
  1273. shl edi, 6 ; (* Faster on 286/386/486 machines *)
  1274. shl ebx, 4
  1275. add edi, ebx ; (* Multiply Value by 80 *)
  1276. (* End multiply by 80 *)
  1277. movzx ecx, [X]
  1278. movzx eax, [Y]
  1279. {DI = Y * LINESIZE, BX = X, coordinates admissible}
  1280. shr eax, 2
  1281. add edi, eax ; {DI = Y * LINESIZE + (X SHR 2) }
  1282. add edi, [VideoOfs] ; (* Pointing at start of Active page *)
  1283. (* Select plane to use *)
  1284. mov dx, 03c4h
  1285. mov ax, FirstPlane ; (* Map Mask & Plane Select Register *)
  1286. and cl, 03h ; (* Get Plane Bits *)
  1287. shl ah, cl ; (* Get Plane Select Value *)
  1288. out dx, ax
  1289. (* End selection of plane *)
  1290. mov ax, fs:[edi+$a0000]
  1291. mov @Result, ax
  1292. pop ebx
  1293. pop edi
  1294. {$endif fpc}
  1295. end;
  1296. {$endif asmgraph}
  1297. end;
  1298. procedure SetVisualX(page: word); {$ifndef fpc}far;{$endif fpc}
  1299. { 4 page supPort... }
  1300. Procedure SetVisibleStart(AOffset: word); Assembler;
  1301. (* Select where the left corner of the screen will be *)
  1302. { By Matt Pritchard }
  1303. asm
  1304. {$IFDEF REGCALL}
  1305. mov cx, ax
  1306. {$ENDIF REGCALL}
  1307. { Wait if we are currently in a Vertical Retrace }
  1308. MOV DX, INPUT_1 { Input Status #1 Register }
  1309. @DP_WAIT0:
  1310. IN AL, DX { Get VGA status }
  1311. AND AL, VERT_RETRACE { In Display mode yet? }
  1312. JNZ @DP_WAIT0 { If Not, wait for it }
  1313. { Set the Start Display Address to the new page }
  1314. MOV DX, CRTC_Index { We Change the VGA Sequencer }
  1315. MOV AL, START_DISP_LO { Display Start Low Register }
  1316. {$ifndef fpc}
  1317. MOV AH, BYTE PTR [AOffset] { Low 8 Bits of Start Addr }
  1318. OUT DX, AX { Set Display Addr Low }
  1319. MOV AL, START_DISP_HI { Display Start High Register }
  1320. MOV AH, BYTE PTR [AOffset+1] { High 8 Bits of Start Addr }
  1321. {$else fpc}
  1322. {$IFDEF REGCALL}
  1323. mov ah, cl
  1324. {$ELSE REGCALL}
  1325. mov ah, byte [AOffset]
  1326. {$ENDIF REGCALL}
  1327. out dx, ax
  1328. mov AL, START_DISP_HI
  1329. {$IFDEF REGCALL}
  1330. mov ah, ch
  1331. {$ELSE REGCALL}
  1332. mov ah, byte [AOffset+1]
  1333. {$ENDIF REGCALL}
  1334. {$endif fpc}
  1335. OUT DX, AX { Set Display Addr High }
  1336. { Wait for a Vertical Retrace to smooth out things }
  1337. MOV DX, INPUT_1 { Input Status #1 Register }
  1338. @DP_WAIT1:
  1339. IN AL, DX { Get VGA status }
  1340. AND AL, VERT_RETRACE { Vertical Retrace Start? }
  1341. JZ @DP_WAIT1 { If Not, wait for it }
  1342. { Now Set Display Starting Address }
  1343. end;
  1344. {$ifdef fpc}
  1345. {$undef asmgraph}
  1346. {$endif fpc}
  1347. begin
  1348. Case page of
  1349. 0: SetVisibleStart(0);
  1350. 1: SetVisibleStart(16000);
  1351. 2: SetVisibleStart(32000);
  1352. 3: SetVisibleStart(48000);
  1353. else
  1354. SetVisibleStart(0);
  1355. end;
  1356. end;
  1357. procedure SetActiveX(page: word); {$ifndef fpc}far;{$endif fpc}
  1358. { 4 page supPort... }
  1359. begin
  1360. case page of
  1361. 0: VideoOfs := 0;
  1362. 1: VideoOfs := 16000;
  1363. 2: VideoOfs := 32000;
  1364. 3: VideoOfs := 48000;
  1365. else
  1366. VideoOfs:=0;
  1367. end;
  1368. end;
  1369. Procedure PutPixelX(X,Y: Integer; color:word); {$ifndef fpc}far;{$endif fpc}
  1370. {$ifndef asmgraph}
  1371. var offset: word;
  1372. {$endif asmgraph}
  1373. begin
  1374. X:= X + StartXViewPort;
  1375. Y:= Y + StartYViewPort;
  1376. { convert to absolute coordinates and then verify clipping...}
  1377. if ClipPixels then
  1378. Begin
  1379. if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
  1380. exit;
  1381. if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
  1382. exit;
  1383. end;
  1384. {$ifndef asmgraph}
  1385. offset := y * 80 + x shr 2 + VideoOfs;
  1386. PortW[$3c4] := (hi(word(FirstPlane)) shl 8) shl (x and 3)+ lo(word(FirstPlane));
  1387. Mem[SegA000:offset] := color;
  1388. {$else asmgraph}
  1389. asm
  1390. mov di,[Y] ; (* DI = Y coordinate *)
  1391. (* Multiply by 80 start *)
  1392. mov bx, di
  1393. shl di, 6 ; (* Faster on 286/386/486 machines *)
  1394. shl bx, 4
  1395. add di, bx ; (* Multiply Value by 80 *)
  1396. (* End multiply by 80 *)
  1397. mov cx, [X]
  1398. mov ax, cx
  1399. {DI = Y * LINESIZE, BX = X, coordinates admissible}
  1400. shr ax, 2
  1401. add di, ax ; {DI = Y * LINESIZE + (X SHR 2) }
  1402. add di, [VideoOfs] ; (* Pointing at start of Active page *)
  1403. (* Select plane to use *)
  1404. mov dx, 03c4h
  1405. mov ax, FirstPlane ; (* Map Mask & Plane Select Register *)
  1406. and cl, 03h ; (* Get Plane Bits *)
  1407. shl ah, cl ; (* Get Plane Select Value *)
  1408. out dx, ax
  1409. (* End selection of plane *)
  1410. mov es,[SegA000]
  1411. mov ax,[Color] ; { only lower byte is used. }
  1412. cmp [CurrentWriteMode],XORPut { check write mode }
  1413. jne @MOVMode
  1414. mov ah,es:[di] { read the byte... }
  1415. xor al,ah { xor it and return value into AL }
  1416. @MovMode:
  1417. mov es:[di], al
  1418. end;
  1419. {$endif asmgraph}
  1420. end;
  1421. Procedure DirectPutPixelX(X,Y: Integer); {$ifndef fpc}far;{$endif fpc}
  1422. { x,y -> must be in global coordinates. No clipping. }
  1423. {$ifndef asmgraph}
  1424. Var offset: Word;
  1425. dummy: Byte;
  1426. begin
  1427. offset := y * 80 + x shr 2 + VideoOfs;
  1428. case CurrentWriteMode of
  1429. XorPut:
  1430. begin
  1431. PortW[$3ce] := ((x and 3) shl 8) + 4;
  1432. dummy := CurrentColor xor Mem[Sega000: offset];
  1433. end;
  1434. OrPut:
  1435. begin
  1436. PortW[$3ce] := ((x and 3) shl 8) + 4;
  1437. dummy := CurrentColor or Mem[Sega000: offset];
  1438. end;
  1439. AndPut:
  1440. begin
  1441. PortW[$3ce] := ((x and 3) shl 8) + 4;
  1442. dummy := CurrentColor and Mem[Sega000: offset];
  1443. end;
  1444. NotPut: dummy := Not CurrentColor;
  1445. else dummy := CurrentColor;
  1446. end;
  1447. PortW[$3c4] := (hi(word(FirstPlane)) shl 8) shl (x and 3)+ lo(word(FirstPlane));
  1448. Mem[Sega000: offset] := Dummy;
  1449. end;
  1450. {$else asmgraph}
  1451. { note: still needs or/and/notput support !!!!! (JM) }
  1452. Assembler;
  1453. asm
  1454. {$IFDEF REGCALL}
  1455. mov cl, al
  1456. mov di, dx
  1457. {$ELSE REGCALL}
  1458. mov cx, [X]
  1459. mov ax, cx
  1460. mov di, [Y] ; (* DI = Y coordinate *)
  1461. {$ENDIF REGCALL}
  1462. (* Multiply by 80 start *)
  1463. mov bx, di
  1464. shl di, 6 ; (* Faster on 286/386/486 machines *)
  1465. shl bx, 4
  1466. add di, bx ; (* Multiply Value by 80 *)
  1467. (* End multiply by 80 *)
  1468. {DI = Y * LINESIZE, BX = X, coordinates admissible}
  1469. shr ax, 2
  1470. add di, ax ; {DI = Y * LINESIZE + (X SHR 2) }
  1471. add di, [VideoOfs] ; (* Pointing at start of Active page *)
  1472. (* Select plane to use *)
  1473. mov dx, 03c4h
  1474. mov ax, FirstPlane ; (* Map Mask & Plane Select Register *)
  1475. and cl, 03h ; (* Get Plane Bits *)
  1476. shl ah, cl ; (* Get Plane Select Value *)
  1477. out dx, ax
  1478. (* End selection of plane *)
  1479. mov es,[SegA000]
  1480. mov ax,[CurrentColor] ; { only lower byte is used. }
  1481. cmp [CurrentWriteMode],XORPut { check write mode }
  1482. jne @MOVMode
  1483. mov ah,es:[di] { read the byte... }
  1484. xor al,ah { xor it and return value into AL }
  1485. @MovMode:
  1486. mov es:[di], al
  1487. end;
  1488. {$endif asmgraph}
  1489. {************************************************************************}
  1490. {* General routines *}
  1491. {************************************************************************}
  1492. var
  1493. SavePtr : pointer; { pointer to video state }
  1494. { CrtSavePtr: pointer;} { pointer to video state when CrtMode gets called }
  1495. StateSize: word; { size in 64 byte blocks for video state }
  1496. VideoMode: byte; { old video mode before graph mode }
  1497. SaveSupPorted : Boolean; { Save/Restore video state supPorted? }
  1498. {**************************************************************}
  1499. {* DPMI Routines *}
  1500. {**************************************************************}
  1501. {$IFDEF DPMI}
  1502. RealStateSeg: word; { Real segment of saved video state }
  1503. Procedure SaveStateVGA; {$ifndef fpc}far;{$endif fpc}
  1504. var
  1505. PtrLong: longint;
  1506. regs: TDPMIRegisters;
  1507. begin
  1508. SaveSupPorted := FALSE;
  1509. SavePtr := nil;
  1510. { Get the video mode }
  1511. asm
  1512. mov ah,0fh
  1513. {$ifdef fpc}
  1514. push ebp
  1515. {$endif fpc}
  1516. int 10h
  1517. {$ifdef fpc}
  1518. pop ebp
  1519. {$endif fpc}
  1520. mov [VideoMode], al
  1521. end;
  1522. { saving/restoring video state screws up Windows (JM) }
  1523. if inWindows then
  1524. exit;
  1525. { Prepare to save video state...}
  1526. asm
  1527. mov ax, 1C00h { get buffer size to save state }
  1528. mov cx, 00000111b { Save DAC / Data areas / Hardware states }
  1529. {$ifdef fpc}
  1530. push ebp
  1531. {$endif fpc}
  1532. int 10h
  1533. {$ifdef fpc}
  1534. pop ebp
  1535. {$endif fpc}
  1536. mov [StateSize], bx
  1537. cmp al,01ch
  1538. jnz @notok
  1539. mov [SaveSupPorted],TRUE
  1540. @notok:
  1541. end;
  1542. if SaveSupPorted then
  1543. begin
  1544. {$ifndef fpc}
  1545. PtrLong:=GlobalDosAlloc(64*StateSize); { values returned in 64-byte blocks }
  1546. {$else fpc}
  1547. PtrLong:=Global_Dos_Alloc(64*StateSize); { values returned in 64-byte blocks }
  1548. {$endif fpc}
  1549. if PtrLong = 0 then
  1550. RunError(203);
  1551. SavePtr := pointer(longint(PtrLong and $0000ffff) shl 16);
  1552. {$ifndef fpc}
  1553. { In FPC mode, we can't do anything with this (no far pointers) }
  1554. { However, we still need to keep it to be able to free the }
  1555. { memory afterwards. Since this data is not accessed in PM code, }
  1556. { there's no need to save it in a seperate buffer (JM) }
  1557. if not assigned(SavePtr) then
  1558. RunError(203);
  1559. {$endif fpc}
  1560. RealStateSeg := word(PtrLong shr 16);
  1561. FillChar(regs, sizeof(regs), #0);
  1562. { call the real mode interrupt ... }
  1563. regs.eax := $1C01; { save the state buffer }
  1564. regs.ecx := $07; { Save DAC / Data areas / Hardware states }
  1565. regs.es := RealStateSeg;
  1566. regs.ebx := 0;
  1567. RealIntr($10,regs);
  1568. FillChar(regs, sizeof(regs), #0);
  1569. { restore state, according to Ralph Brown Interrupt list }
  1570. { some BIOS corrupt the hardware after a save... }
  1571. regs.eax := $1C02; { restore the state buffer }
  1572. regs.ecx := $07; { rest DAC / Data areas / Hardware states }
  1573. regs.es := RealStateSeg;
  1574. regs.ebx := 0;
  1575. RealIntr($10,regs);
  1576. end;
  1577. end;
  1578. procedure RestoreStateVGA; {$ifndef fpc}far;{$endif fpc}
  1579. var
  1580. regs:TDPMIRegisters;
  1581. begin
  1582. { go back to the old video mode...}
  1583. asm
  1584. mov ah,00
  1585. mov al,[VideoMode]
  1586. {$ifdef fpc}
  1587. push ebp
  1588. {$endif fpc}
  1589. int 10h
  1590. {$ifdef fpc}
  1591. pop ebp
  1592. {$endif fpc}
  1593. end;
  1594. { then restore all state information }
  1595. {$ifndef fpc}
  1596. if assigned(SavePtr) and (SaveSupPorted=TRUE) then
  1597. {$else fpc}
  1598. { No far pointer supPort, so it's possible that that assigned(SavePtr) }
  1599. { would return false under FPC. Just check if it's different from nil. }
  1600. if (SavePtr <> nil) and (SaveSupPorted=TRUE) then
  1601. {$endif fpc}
  1602. begin
  1603. FillChar(regs, sizeof(regs), #0);
  1604. { restore state, according to Ralph Brown Interrupt list }
  1605. { some BIOS corrupt the hardware after a save... }
  1606. regs.eax := $1C02; { restore the state buffer }
  1607. regs.ecx := $07; { rest DAC / Data areas / Hardware states }
  1608. regs.es := RealStateSeg;
  1609. regs.ebx := 0;
  1610. RealIntr($10,regs);
  1611. (*
  1612. {$ifndef fpc}
  1613. if GlobalDosFree(longint(SavePtr) shr 16)<>0 then
  1614. {$else fpc}
  1615. if Not Global_Dos_Free(longint(SavePtr) shr 16) then
  1616. {$endif fpc}
  1617. RunError(216);
  1618. SavePtr := nil;
  1619. *)
  1620. end;
  1621. end;
  1622. {$ELSE}
  1623. {**************************************************************}
  1624. {* Real mode routines *}
  1625. {**************************************************************}
  1626. Procedure SaveStateVGA; far;
  1627. begin
  1628. SavePtr := nil;
  1629. SaveSupPorted := FALSE;
  1630. { Get the video mode }
  1631. asm
  1632. mov ah,0fh
  1633. int 10h
  1634. mov [VideoMode], al
  1635. end;
  1636. { Prepare to save video state...}
  1637. asm
  1638. mov ax, 1C00h { get buffer size to save state }
  1639. mov cx, 00000111b { Save DAC / Data areas / Hardware states }
  1640. int 10h
  1641. mov [StateSize], bx
  1642. cmp al,01ch
  1643. jnz @notok
  1644. mov [SaveSupPorted],TRUE
  1645. @notok:
  1646. end;
  1647. if SaveSupPorted then
  1648. Begin
  1649. GetMem(SavePtr, 64*StateSize); { values returned in 64-byte blocks }
  1650. if not assigned(SavePtr) then
  1651. RunError(203);
  1652. asm
  1653. mov ax, 1C01h { save the state buffer }
  1654. mov cx, 00000111b { Save DAC / Data areas / Hardware states }
  1655. mov es, WORD PTR [SavePtr+2]
  1656. mov bx, WORD PTR [SavePtr]
  1657. int 10h
  1658. end;
  1659. { restore state, according to Ralph Brown Interrupt list }
  1660. { some BIOS corrupt the hardware after a save... }
  1661. asm
  1662. mov ax, 1C02h { save the state buffer }
  1663. mov cx, 00000111b { Save DAC / Data areas / Hardware states }
  1664. mov es, WORD PTR [SavePtr+2]
  1665. mov bx, WORD PTR [SavePtr]
  1666. int 10h
  1667. end;
  1668. end;
  1669. end;
  1670. procedure RestoreStateVGA; far;
  1671. begin
  1672. { go back to the old video mode...}
  1673. asm
  1674. mov ah,00
  1675. mov al,[VideoMode]
  1676. int 10h
  1677. end;
  1678. { then restore all state information }
  1679. if assigned(SavePtr) and (SaveSupPorted=TRUE) then
  1680. begin
  1681. { restore state, according to Ralph Brown Interrupt list }
  1682. asm
  1683. mov ax, 1C02h { save the state buffer }
  1684. mov cx, 00000111b { Save DAC / Data areas / Hardware states }
  1685. mov es, WORD PTR [SavePtr+2]
  1686. mov bx, WORD PTR [SavePtr]
  1687. int 10h
  1688. end;
  1689. { done in exitproc (JM)
  1690. FreeMem(SavePtr, 64*StateSize);}
  1691. SavePtr := nil;
  1692. end;
  1693. end;
  1694. {$ENDIF DPMI}
  1695. Procedure SetVGARGBAllPalette(const Palette:PaletteType); {$ifndef fpc}far;{$endif fpc}
  1696. var
  1697. c: byte;
  1698. begin
  1699. { wait for vertical retrace start/end}
  1700. while (port[$3da] and $8) <> 0 do;
  1701. while (port[$3da] and $8) = 0 do;
  1702. If MaxColor = 16 Then
  1703. begin
  1704. for c := 0 to 15 do
  1705. begin
  1706. { translate the color number for 16 color mode }
  1707. portb[$3c8] := toRealCols16[c];
  1708. portb[$3c9] := palette.colors[c].red shr 2;
  1709. portb[$3c9] := palette.colors[c].green shr 2;
  1710. portb[$3c9] := palette.colors[c].blue shr 2;
  1711. end
  1712. end
  1713. else
  1714. begin
  1715. portb[$3c8] := 0;
  1716. for c := 0 to 255 do
  1717. begin
  1718. { no need to set port[$3c8] every time if you set the entries }
  1719. { for successive colornumbers (JM) }
  1720. portb[$3c9] := palette.colors[c].red shr 2;
  1721. portb[$3c9] := palette.colors[c].green shr 2;
  1722. portb[$3c9] := palette.colors[c].blue shr 2;
  1723. end
  1724. end;
  1725. End;
  1726. { VGA is never a direct color mode, so no need to check ... }
  1727. Procedure SetVGARGBPalette(ColorNum, RedValue, GreenValue,
  1728. BlueValue : Integer); {$ifndef fpc}far;{$endif fpc}
  1729. begin
  1730. { translate the color number for 16 color mode }
  1731. If MaxColor = 16 Then
  1732. ColorNum := ToRealCols16[ColorNum];
  1733. asm
  1734. { on some hardware - there is a snow like effect }
  1735. { when changing the palette register directly }
  1736. { so we wait for a vertical retrace start period. }
  1737. mov dx, $03da
  1738. @1:
  1739. in al, dx { Get input status register }
  1740. test al, $08 { check if in vertical retrace }
  1741. jnz @1 { yes, complete it }
  1742. { we have to wait for the next }
  1743. { retrace to assure ourselves }
  1744. { that we have time to complete }
  1745. { the DAC operation within }
  1746. { the vertical retrace period }
  1747. @2:
  1748. in al, dx
  1749. test al, $08
  1750. jz @2 { repeat until vertical retrace start }
  1751. mov dx, $03c8 { Set color register address to use }
  1752. mov ax, [ColorNum]
  1753. out dx, al
  1754. inc dx { Point to DAC registers }
  1755. mov ax, [RedValue] { Get RedValue }
  1756. shr ax, 2
  1757. out dx, al
  1758. mov ax, [GreenValue]{ Get RedValue }
  1759. shr ax, 2
  1760. out dx, al
  1761. mov ax, [BlueValue] { Get RedValue }
  1762. shr ax, 2
  1763. out dx, al
  1764. end
  1765. End;
  1766. { VGA is never a direct color mode, so no need to check ... }
  1767. Procedure GetVGARGBPalette(ColorNum: integer; Var
  1768. RedValue, GreenValue, BlueValue : integer); {$ifndef fpc}far;{$endif fpc}
  1769. begin
  1770. If MaxColor = 16 Then
  1771. ColorNum := ToRealCols16[ColorNum];
  1772. Port[$03C7] := ColorNum;
  1773. { we must convert to lsb values... because the vga uses the 6 msb bits }
  1774. { which is not compatible with anything. }
  1775. RedValue := Integer(Port[$3C9]) shl 2;
  1776. GreenValue := Integer(Port[$3C9]) shl 2;
  1777. BlueValue := Integer(Port[$3C9]) shl 2;
  1778. end;
  1779. {************************************************************************}
  1780. {* VESA related routines *}
  1781. {************************************************************************}
  1782. {$I vesa.inc}
  1783. {************************************************************************}
  1784. {* General routines *}
  1785. {************************************************************************}
  1786. procedure CloseGraph;
  1787. Begin
  1788. If not isgraphmode then
  1789. begin
  1790. _graphresult := grnoinitgraph;
  1791. exit
  1792. end;
  1793. if not assigned(RestoreVideoState) then
  1794. RunError(216);
  1795. RestoreVideoState;
  1796. isgraphmode := false;
  1797. end;
  1798. (*
  1799. procedure LoadFont8x8;
  1800. var
  1801. r : registers;
  1802. x,y,c : longint;
  1803. data : array[0..127,0..7] of byte;
  1804. begin
  1805. r.ah:=$11;
  1806. r.al:=$30;
  1807. r.bh:=1;
  1808. RealIntr($10,r);
  1809. dosmemget(r.es,r.bp,data,sizeof(data));
  1810. for c:=0 to 127 do
  1811. for y:=0 to 7 do
  1812. for x:=0 to 7 do
  1813. if (data[c,y] and ($80 shr x))<>0 then
  1814. DefaultFontData[chr(c),y,x]:=1
  1815. else
  1816. DefaultFontData[chr(c),y,x]:=0;
  1817. { second part }
  1818. r.ah:=$11;
  1819. r.al:=$30;
  1820. r.bh:=0;
  1821. RealIntr($10,r);
  1822. dosmemget(r.es,r.bp,data,sizeof(data));
  1823. for c:=0 to 127 do
  1824. for y:=0 to 7 do
  1825. for x:=0 to 7 do
  1826. if (data[c,y] and ($80 shr x))<>0 then
  1827. DefaultFontData[chr(c+128),y,x]:=1
  1828. else
  1829. DefaultFontData[chr(c+128),y,x]:=0;
  1830. end;
  1831. *)
  1832. function QueryAdapterInfo:PModeInfo;
  1833. { This routine returns the head pointer to the list }
  1834. { of supPorted graphics modes. }
  1835. { Returns nil if no graphics mode supported. }
  1836. { This list is READ ONLY! }
  1837. var
  1838. EGADetected : Boolean;
  1839. VGADetected : Boolean;
  1840. mode: TModeInfo;
  1841. begin
  1842. QueryAdapterInfo := ModeList;
  1843. { If the mode listing already exists... }
  1844. { simply return it, without changing }
  1845. { anything... }
  1846. if assigned(ModeList) then
  1847. exit;
  1848. EGADetected := FALSE;
  1849. VGADetected := FALSE;
  1850. { check if Hercules adapter supPorted ... }
  1851. { check if EGA adapter supPorted... }
  1852. asm
  1853. mov ah,12h
  1854. mov bx,0FF10h
  1855. {$ifdef fpc}
  1856. push ebp
  1857. {$endif fpc}
  1858. int 10h { get EGA information }
  1859. {$ifdef fpc}
  1860. pop ebp
  1861. {$endif fpc}
  1862. cmp bh,0ffh
  1863. jz @noega
  1864. mov [EGADetected],TRUE
  1865. @noega:
  1866. end;
  1867. {$ifdef logging}
  1868. LogLn('EGA detected: '+strf(Longint(EGADetected)));
  1869. {$endif logging}
  1870. { check if VGA adapter supPorted... }
  1871. if EGADetected then
  1872. begin
  1873. asm
  1874. mov ax,1a00h
  1875. {$ifdef fpc}
  1876. push ebp
  1877. {$endif fpc}
  1878. int 10h { get display combination code...}
  1879. {$ifdef fpc}
  1880. pop ebp
  1881. {$endif fpc}
  1882. cmp al,1ah { check if supPorted... }
  1883. jne @novga
  1884. { now check if this is the ATI EGA }
  1885. mov ax,1c00h { get state size for save... }
  1886. { ... all imPortant data }
  1887. mov cx,07h
  1888. {$ifdef fpc}
  1889. push ebp
  1890. {$endif fpc}
  1891. int 10h
  1892. {$ifdef fpc}
  1893. pop ebp
  1894. {$endif fpc}
  1895. cmp al,1ch { success? }
  1896. jne @novga
  1897. mov [VGADetected],TRUE
  1898. @novga:
  1899. end;
  1900. end;
  1901. {$ifdef logging}
  1902. LogLn('VGA detected: '+strf(Longint(VGADetected)));
  1903. {$endif logging}
  1904. if VGADetected then
  1905. begin
  1906. SaveVideoState := @SaveStateVGA;
  1907. {$ifdef logging}
  1908. LogLn('Setting VGA SaveVideoState to '+strf(longint(SaveVideoState)));
  1909. {$endif logging}
  1910. RestoreVideoState := @RestoreStateVGA;
  1911. {$ifdef logging}
  1912. LogLn('Setting VGA RestoreVideoState to '+strf(longint(RestoreVideoState)));
  1913. {$endif logging}
  1914. InitMode(mode);
  1915. { now add all standard VGA modes... }
  1916. mode.DriverNumber:= LowRes;
  1917. mode.HardwarePages:= 0;
  1918. mode.ModeNumber:=0;
  1919. mode.ModeName:='320 x 200 VGA';
  1920. mode.MaxColor := 256;
  1921. mode.PaletteSize := mode.MaxColor;
  1922. mode.DirectColor := FALSE;
  1923. mode.MaxX := 319;
  1924. mode.MaxY := 199;
  1925. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel320;
  1926. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel320;
  1927. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel320;
  1928. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
  1929. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
  1930. mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
  1931. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual320;
  1932. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320;
  1933. mode.InitMode := {$ifdef fpc}@{$endif}Init320;
  1934. mode.XAspect := 10000;
  1935. mode.YAspect := 10000;
  1936. AddMode(mode);
  1937. { now add all standard VGA modes... }
  1938. InitMode(mode);
  1939. mode.DriverNumber:= LowRes;
  1940. mode.ModeNumber:=1;
  1941. mode.HardwarePages := 3; { 0..3 }
  1942. mode.ModeName:='320 x 200 ModeX';
  1943. mode.MaxColor := 256;
  1944. mode.DirectColor := FALSE;
  1945. mode.PaletteSize := mode.MaxColor;
  1946. mode.MaxX := 319;
  1947. mode.MaxY := 199;
  1948. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixelX;
  1949. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixelX;
  1950. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixelX;
  1951. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
  1952. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
  1953. mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
  1954. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualX;
  1955. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveX;
  1956. mode.InitMode := {$ifdef fpc}@{$endif}InitModeX;
  1957. mode.XAspect := 10000;
  1958. mode.YAspect := 10000;
  1959. AddMode(mode);
  1960. InitMode(mode);
  1961. mode.ModeNumber:=VGALo;
  1962. mode.DriverNumber := VGA;
  1963. mode.ModeName:='640 x 200 VGA';
  1964. mode.MaxColor := 16;
  1965. mode.HardwarePages := 2;
  1966. mode.DirectColor := FALSE;
  1967. mode.PaletteSize := mode.MaxColor;
  1968. mode.MaxX := 639;
  1969. mode.MaxY := 199;
  1970. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16;
  1971. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16;
  1972. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16;
  1973. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
  1974. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
  1975. mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
  1976. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual200;
  1977. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive200;
  1978. mode.InitMode := {$ifdef fpc}@{$endif}Init640x200x16;
  1979. mode.HLine := {$ifdef fpc}@{$endif}HLine16;
  1980. mode.VLine := {$ifdef fpc}@{$endif}VLine16;
  1981. mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLine16;
  1982. mode.XAspect := 10000;
  1983. mode.YAspect := 10000;
  1984. AddMode(mode);
  1985. InitMode(mode);
  1986. mode.ModeNumber:=VGAMed;
  1987. mode.DriverNumber := VGA;
  1988. mode.ModeName:='640 x 350 VGA';
  1989. mode.HardwarePages := 1;
  1990. mode.MaxColor := 16;
  1991. mode.DirectColor := FALSE;
  1992. mode.PaletteSize := mode.MaxColor;
  1993. mode.MaxX := 639;
  1994. mode.MaxY := 349;
  1995. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16;
  1996. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16;
  1997. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16;
  1998. mode.InitMode := {$ifdef fpc}@{$endif}Init640x350x16;
  1999. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
  2000. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
  2001. mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
  2002. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual350;
  2003. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive350;
  2004. mode.HLine := {$ifdef fpc}@{$endif}HLine16;
  2005. mode.VLine := {$ifdef fpc}@{$endif}VLine16;
  2006. mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLine16;
  2007. mode.XAspect := 10000;
  2008. mode.YAspect := 10000;
  2009. AddMode(mode);
  2010. InitMode(mode);
  2011. mode.ModeNumber:=VGAHi;
  2012. mode.DriverNumber := VGA;
  2013. mode.HardwarePages := 0;
  2014. mode.ModeName:='640 x 480 VGA';
  2015. mode.MaxColor := 16;
  2016. mode.DirectColor := FALSE;
  2017. mode.PaletteSize := mode.MaxColor;
  2018. mode.MaxX := 639;
  2019. mode.MaxY := 479;
  2020. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16;
  2021. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16;
  2022. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16;
  2023. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
  2024. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
  2025. mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
  2026. mode.InitMode := {$ifdef fpc}@{$endif}Init640x480x16;
  2027. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual480;
  2028. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive480;
  2029. mode.HLine := {$ifdef fpc}@{$endif}HLine16;
  2030. mode.VLine := {$ifdef fpc}@{$endif}VLine16;
  2031. mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLine16;
  2032. mode.XAspect := 10000;
  2033. mode.YAspect := 10000;
  2034. AddMode(mode);
  2035. end;
  2036. { check if VESA adapter supPorted... }
  2037. {$ifndef noSupPortVESA}
  2038. hasVesa := getVesaInfo(VESAInfo);
  2039. { VBE Version v1.00 is unstable, therefore }
  2040. { only VBE v1.1 and later are supported. }
  2041. if (hasVESA=TRUE) and (VESAInfo.Version <= $0100) then
  2042. hasVESA := False;
  2043. {$else noSupPortVESA}
  2044. hasVESA := false;
  2045. {$endif noSupPortVESA}
  2046. if hasVesa then
  2047. begin
  2048. { We have to set and restore the entire VESA state }
  2049. { otherwise, if we use the VGA BIOS only function }
  2050. { there might be a crash under DPMI, such as in the}
  2051. { ATI Mach64 }
  2052. SaveVideoState := @SaveStateVESA;
  2053. {$ifdef logging}
  2054. LogLn('Setting SaveVideoState to '+strf(longint(SaveVideoState)));
  2055. {$endif logging}
  2056. RestoreVideoState := @RestoreStateVESA;
  2057. {$ifdef logging}
  2058. LogLn('Setting RestoreVideoState to '+strf(longint(RestoreVideoState)));
  2059. {$endif logging}
  2060. { now check all supported modes...}
  2061. if SearchVESAModes(m320x200x32k) then
  2062. begin
  2063. InitMode(mode);
  2064. mode.ModeNumber:=m320x200x32k;
  2065. mode.DriverNumber := VESA;
  2066. mode.ModeName:='320 x 200 VESA';
  2067. mode.MaxColor := 32768;
  2068. { the ModeInfo is automatically set if the mode is supPorted }
  2069. { by the call to SearchVESAMode. }
  2070. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2071. mode.PaletteSize := mode.MaxColor;
  2072. mode.DirectColor := TRUE;
  2073. mode.MaxX := 319;
  2074. mode.MaxY := 199;
  2075. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
  2076. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
  2077. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
  2078. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2079. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2080. mode.InitMode := {$ifdef fpc}@{$endif}Init320x200x32k;
  2081. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2082. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2083. mode.XAspect := 10000;
  2084. mode.YAspect := 10000;
  2085. AddMode(mode);
  2086. end;
  2087. if SearchVESAModes(m320x200x64k) then
  2088. begin
  2089. InitMode(mode);
  2090. mode.ModeNumber:=m320x200x64k;
  2091. mode.DriverNumber := VESA;
  2092. mode.ModeName:='320 x 200 VESA';
  2093. mode.MaxColor := 65536;
  2094. { the ModeInfo is automatically set if the mode is supPorted }
  2095. { by the call to SearchVESAMode. }
  2096. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2097. mode.PaletteSize := mode.MaxColor;
  2098. mode.DirectColor := TRUE;
  2099. mode.MaxX := 319;
  2100. mode.MaxY := 199;
  2101. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
  2102. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
  2103. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
  2104. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2105. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2106. mode.InitMode := {$ifdef fpc}@{$endif}Init320x200x64k;
  2107. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2108. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2109. mode.XAspect := 10000;
  2110. mode.YAspect := 10000;
  2111. AddMode(mode);
  2112. end;
  2113. if SearchVESAModes(m640x400x256) then
  2114. begin
  2115. InitMode(mode);
  2116. mode.ModeNumber:=m640x400x256;
  2117. mode.DriverNumber := VESA;
  2118. mode.ModeName:='640 x 400 VESA';
  2119. mode.MaxColor := 256;
  2120. { the ModeInfo is automatically set if the mode is supPorted }
  2121. { by the call to SearchVESAMode. }
  2122. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2123. mode.PaletteSize := mode.MaxColor;
  2124. mode.DirectColor := FALSE;
  2125. mode.MaxX := 639;
  2126. mode.MaxY := 399;
  2127. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA256;
  2128. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA256;
  2129. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
  2130. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2131. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2132. {$ifdef fpc}
  2133. mode.SetAllPalette := @SetVESARGBAllPalette;
  2134. {$endif fpc}
  2135. mode.InitMode := {$ifdef fpc}@{$endif}Init640x400x256;
  2136. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2137. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2138. mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
  2139. mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
  2140. mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
  2141. mode.XAspect := 10000;
  2142. mode.YAspect := 10000;
  2143. AddMode(mode);
  2144. end;
  2145. if SearchVESAModes(m640x480x256) then
  2146. begin
  2147. InitMode(mode);
  2148. mode.ModeNumber:=m640x480x256;
  2149. mode.DriverNumber := VESA;
  2150. mode.ModeName:='640 x 480 VESA';
  2151. mode.MaxColor := 256;
  2152. { the ModeInfo is automatically set if the mode is supPorted }
  2153. { by the call to SearchVESAMode. }
  2154. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2155. mode.PaletteSize := mode.MaxColor;
  2156. mode.MaxX := 639;
  2157. mode.MaxY := 479;
  2158. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA256;
  2159. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA256;
  2160. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
  2161. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2162. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2163. {$ifdef fpc}
  2164. mode.SetAllPalette := @SetVESARGBAllPalette;
  2165. {$endif fpc}
  2166. mode.InitMode := {$ifdef fpc}@{$endif}Init640x480x256;
  2167. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2168. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2169. mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
  2170. mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
  2171. mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
  2172. mode.PatternLine := {$ifdef fpc}@{$endif}PatternLineVESA256;
  2173. mode.XAspect := 10000;
  2174. mode.YAspect := 10000;
  2175. AddMode(mode);
  2176. end;
  2177. if SearchVESAModes(m640x480x32k) then
  2178. begin
  2179. InitMode(mode);
  2180. mode.ModeNumber:=m640x480x32k;
  2181. mode.DriverNumber := VESA;
  2182. mode.ModeName:='640 x 480 VESA';
  2183. mode.MaxColor := 32768;
  2184. { the ModeInfo is automatically set if the mode is supPorted }
  2185. { by the call to SearchVESAMode. }
  2186. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2187. mode.PaletteSize := mode.MaxColor;
  2188. mode.DirectColor := TRUE;
  2189. mode.MaxX := 639;
  2190. mode.MaxY := 479;
  2191. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
  2192. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
  2193. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
  2194. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2195. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2196. mode.InitMode := {$ifdef fpc}@{$endif}Init640x480x32k;
  2197. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2198. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2199. mode.XAspect := 10000;
  2200. mode.YAspect := 10000;
  2201. AddMode(mode);
  2202. end;
  2203. if SearchVESAModes(m640x480x64k) then
  2204. begin
  2205. InitMode(mode);
  2206. mode.ModeNumber:=m640x480x64k;
  2207. mode.DriverNumber := VESA;
  2208. mode.ModeName:='640 x 480 VESA';
  2209. mode.MaxColor := 65536;
  2210. { the ModeInfo is automatically set if the mode is supPorted }
  2211. { by the call to SearchVESAMode. }
  2212. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2213. mode.PaletteSize := mode.MaxColor;
  2214. mode.DirectColor := TRUE;
  2215. mode.MaxX := 639;
  2216. mode.MaxY := 479;
  2217. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
  2218. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
  2219. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
  2220. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2221. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2222. mode.InitMode := {$ifdef fpc}@{$endif}Init640x480x64k;
  2223. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2224. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2225. mode.XAspect := 10000;
  2226. mode.YAspect := 10000;
  2227. AddMode(mode);
  2228. end;
  2229. if SearchVESAModes(m800x600x16) then
  2230. begin
  2231. InitMode(mode);
  2232. mode.ModeNumber:=m800x600x16;
  2233. mode.DriverNumber := VESA;
  2234. mode.ModeName:='800 x 600 VESA';
  2235. mode.MaxColor := 16;
  2236. { the ModeInfo is automatically set if the mode is supPorted }
  2237. { by the call to SearchVESAMode. }
  2238. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2239. mode.DirectColor := FALSE;
  2240. mode.PaletteSize := mode.MaxColor;
  2241. mode.MaxX := 799;
  2242. mode.MaxY := 599;
  2243. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA16;
  2244. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2245. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2246. {$ifdef fpc}
  2247. mode.SetAllPalette := @SetVESARGBAllPalette;
  2248. {$endif fpc}
  2249. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA16;
  2250. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA16;
  2251. mode.InitMode := {$ifdef fpc}@{$endif}Init800x600x16;
  2252. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2253. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2254. mode.XAspect := 10000;
  2255. mode.YAspect := 10000;
  2256. AddMode(mode);
  2257. end;
  2258. if SearchVESAModes(m800x600x256) then
  2259. begin
  2260. InitMode(mode);
  2261. mode.ModeNumber:=m800x600x256;
  2262. mode.DriverNumber := VESA;
  2263. mode.ModeName:='800 x 600 VESA';
  2264. mode.MaxColor := 256;
  2265. { the ModeInfo is automatically set if the mode is supPorted }
  2266. { by the call to SearchVESAMode. }
  2267. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2268. mode.PaletteSize := mode.MaxColor;
  2269. mode.DirectColor := FALSE;
  2270. mode.MaxX := 799;
  2271. mode.MaxY := 599;
  2272. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA256;
  2273. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA256;
  2274. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
  2275. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2276. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2277. {$ifdef fpc}
  2278. mode.SetAllPalette := @SetVESARGBAllPalette;
  2279. {$endif fpc}
  2280. mode.InitMode := {$ifdef fpc}@{$endif}Init800x600x256;
  2281. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2282. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2283. mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
  2284. mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
  2285. mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
  2286. mode.PatternLine := {$ifdef fpc}@{$endif}PatternLineVESA256;
  2287. mode.XAspect := 10000;
  2288. mode.YAspect := 10000;
  2289. AddMode(mode);
  2290. end;
  2291. if SearchVESAModes(m800x600x32k) then
  2292. begin
  2293. InitMode(mode);
  2294. mode.ModeNumber:=m800x600x32k;
  2295. mode.DriverNumber := VESA;
  2296. mode.ModeName:='800 x 600 VESA';
  2297. mode.MaxColor := 32768;
  2298. { the ModeInfo is automatically set if the mode is supPorted }
  2299. { by the call to SearchVESAMode. }
  2300. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2301. mode.PaletteSize := mode.MaxColor;
  2302. mode.DirectColor := TRUE;
  2303. mode.MaxX := 799;
  2304. mode.MaxY := 599;
  2305. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
  2306. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
  2307. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
  2308. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2309. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2310. mode.InitMode := {$ifdef fpc}@{$endif}Init800x600x32k;
  2311. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2312. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2313. mode.XAspect := 10000;
  2314. mode.YAspect := 10000;
  2315. AddMode(mode);
  2316. end;
  2317. if SearchVESAModes(m800x600x64k) then
  2318. begin
  2319. InitMode(mode);
  2320. mode.ModeNumber:=m800x600x64k;
  2321. mode.DriverNumber := VESA;
  2322. mode.ModeName:='800 x 600 VESA';
  2323. mode.MaxColor := 65536;
  2324. { the ModeInfo is automatically set if the mode is supPorted }
  2325. { by the call to SearchVESAMode. }
  2326. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2327. mode.PaletteSize := mode.MaxColor;
  2328. mode.DirectColor := TRUE;
  2329. mode.MaxX := 799;
  2330. mode.MaxY := 599;
  2331. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
  2332. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
  2333. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
  2334. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2335. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2336. mode.InitMode := {$ifdef fpc}@{$endif}Init800x600x64k;
  2337. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2338. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2339. mode.XAspect := 10000;
  2340. mode.YAspect := 10000;
  2341. AddMode(mode);
  2342. end;
  2343. if SearchVESAModes(m1024x768x16) then
  2344. begin
  2345. InitMode(mode);
  2346. mode.ModeNumber:=m1024x768x16;
  2347. mode.DriverNumber := VESA;
  2348. mode.ModeName:='1024 x 768 VESA';
  2349. mode.MaxColor := 16;
  2350. { the ModeInfo is automatically set if the mode is supPorted }
  2351. { by the call to SearchVESAMode. }
  2352. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2353. mode.PaletteSize := mode.MaxColor;
  2354. mode.DirectColor := FALSE;
  2355. mode.MaxX := 1023;
  2356. mode.MaxY := 767;
  2357. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA16;
  2358. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA16;
  2359. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2360. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2361. {$ifdef fpc}
  2362. mode.SetAllPalette := @SetVESARGBAllPalette;
  2363. {$endif fpc}
  2364. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA16;
  2365. mode.InitMode := {$ifdef fpc}@{$endif}Init1024x768x16;
  2366. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2367. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2368. mode.XAspect := 10000;
  2369. mode.YAspect := 10000;
  2370. AddMode(mode);
  2371. end;
  2372. if SearchVESAModes(m1024x768x256) then
  2373. begin
  2374. InitMode(mode);
  2375. mode.ModeNumber:=m1024x768x256;
  2376. mode.DriverNumber := VESA;
  2377. mode.ModeName:='1024 x 768 VESA';
  2378. mode.MaxColor := 256;
  2379. { the ModeInfo is automatically set if the mode is supPorted }
  2380. { by the call to SearchVESAMode. }
  2381. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2382. mode.PaletteSize := mode.MaxColor;
  2383. mode.DirectColor := FALSE;
  2384. mode.MaxX := 1023;
  2385. mode.MaxY := 767;
  2386. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA256;
  2387. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA256;
  2388. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
  2389. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2390. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2391. {$ifdef fpc}
  2392. mode.SetAllPalette := @SetVESARGBAllPalette;
  2393. {$endif fpc}
  2394. mode.InitMode := {$ifdef fpc}@{$endif}Init1024x768x256;
  2395. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2396. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2397. mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
  2398. mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
  2399. mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
  2400. mode.PatternLine := {$ifdef fpc}@{$endif}PatternLineVESA256;
  2401. mode.XAspect := 10000;
  2402. mode.YAspect := 10000;
  2403. AddMode(mode);
  2404. end;
  2405. if SearchVESAModes(m1024x768x32k) then
  2406. begin
  2407. InitMode(mode);
  2408. mode.ModeNumber:=m1024x768x32k;
  2409. mode.DriverNumber := VESA;
  2410. mode.ModeName:='1024 x 768 VESA';
  2411. mode.MaxColor := 32768;
  2412. { the ModeInfo is automatically set if the mode is supPorted }
  2413. { by the call to SearchVESAMode. }
  2414. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2415. mode.PaletteSize := mode.MaxColor;
  2416. mode.DirectColor := TRUE;
  2417. mode.MaxX := 1023;
  2418. mode.MaxY := 767;
  2419. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
  2420. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
  2421. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
  2422. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2423. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2424. mode.InitMode := {$ifdef fpc}@{$endif}Init640x480x32k;
  2425. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2426. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2427. mode.XAspect := 10000;
  2428. mode.YAspect := 10000;
  2429. AddMode(mode);
  2430. end;
  2431. if SearchVESAModes(m1024x768x64k) then
  2432. begin
  2433. InitMode(mode);
  2434. mode.ModeNumber:=m1024x768x64k;
  2435. mode.DriverNumber := VESA;
  2436. mode.ModeName:='1024 x 768 VESA';
  2437. mode.MaxColor := 65536;
  2438. mode.DirectColor := TRUE;
  2439. { the ModeInfo is automatically set if the mode is supPorted }
  2440. { by the call to SearchVESAMode. }
  2441. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2442. mode.PaletteSize := mode.MaxColor;
  2443. mode.MaxX := 1023;
  2444. mode.MaxY := 767;
  2445. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
  2446. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
  2447. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
  2448. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2449. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2450. mode.InitMode := {$ifdef fpc}@{$endif}Init1024x768x64k;
  2451. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2452. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2453. mode.XAspect := 10000;
  2454. mode.YAspect := 10000;
  2455. AddMode(mode);
  2456. end;
  2457. if SearchVESAModes(m1280x1024x16) then
  2458. begin
  2459. InitMode(mode);
  2460. mode.ModeNumber:=m1280x1024x16;
  2461. mode.DriverNumber := VESA;
  2462. mode.ModeName:='1280 x 1024 VESA';
  2463. mode.MaxColor := 16;
  2464. { the ModeInfo is automatically set if the mode is supPorted }
  2465. { by the call to SearchVESAMode. }
  2466. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2467. mode.DirectColor := FALSE;
  2468. mode.PaletteSize := mode.MaxColor;
  2469. mode.MaxX := 1279;
  2470. mode.MaxY := 1023;
  2471. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA16;
  2472. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2473. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2474. {$ifdef fpc}
  2475. mode.SetAllPalette := @SetVESARGBAllPalette;
  2476. {$endif fpc}
  2477. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA16;
  2478. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA16;
  2479. mode.InitMode := {$ifdef fpc}@{$endif}Init1280x1024x16;
  2480. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2481. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2482. mode.XAspect := 10000;
  2483. mode.YAspect := 10000;
  2484. AddMode(mode);
  2485. end;
  2486. if SearchVESAModes(m1280x1024x256) then
  2487. begin
  2488. InitMode(mode);
  2489. mode.ModeNumber:=m1280x1024x256;
  2490. mode.DriverNumber := VESA;
  2491. mode.ModeName:='1280 x 1024 VESA';
  2492. mode.MaxColor := 256;
  2493. { the ModeInfo is automatically set if the mode is supPorted }
  2494. { by the call to SearchVESAMode. }
  2495. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2496. mode.DirectColor := FALSE;
  2497. mode.PaletteSize := mode.MaxColor;
  2498. mode.MaxX := 1279;
  2499. mode.MaxY := 1023;
  2500. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA256;
  2501. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA256;
  2502. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
  2503. mode.InitMode := {$ifdef fpc}@{$endif}Init1280x1024x256;
  2504. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2505. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2506. {$ifdef fpc}
  2507. mode.SetAllPalette := @SetVESARGBAllPalette;
  2508. {$endif fpc}
  2509. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2510. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2511. mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
  2512. mode.hline := {$ifdef fpc}@{$endif}HLineVESA256;
  2513. mode.GetScanLine := {$ifdef fpc}@{$endif}GetScanLineVESA256;
  2514. mode.PatternLine := {$ifdef fpc}@{$endif}PatternLineVESA256;
  2515. mode.XAspect := 10000;
  2516. mode.YAspect := 10000;
  2517. AddMode(mode);
  2518. end;
  2519. if SearchVESAModes(m1280x1024x32k) then
  2520. begin
  2521. InitMode(mode);
  2522. mode.ModeNumber:=m1280x1024x32k;
  2523. mode.DriverNumber := VESA;
  2524. mode.ModeName:='1280 x 1024 VESA';
  2525. mode.MaxColor := 32768;
  2526. { the ModeInfo is automatically set if the mode is supPorted }
  2527. { by the call to SearchVESAMode. }
  2528. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2529. mode.DirectColor := TRUE;
  2530. mode.PaletteSize := mode.MaxColor;
  2531. mode.MaxX := 1279;
  2532. mode.MaxY := 1023;
  2533. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
  2534. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
  2535. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
  2536. mode.InitMode := {$ifdef fpc}@{$endif}Init1280x1024x32k;
  2537. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2538. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2539. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2540. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2541. mode.XAspect := 10000;
  2542. mode.YAspect := 10000;
  2543. AddMode(mode);
  2544. end;
  2545. if SearchVESAModes(m1280x1024x64k) then
  2546. begin
  2547. InitMode(mode);
  2548. mode.ModeNumber:=m1280x1024x64k;
  2549. mode.DriverNumber := VESA;
  2550. mode.ModeName:='1280 x 1024 VESA';
  2551. mode.MaxColor := 65536;
  2552. { the ModeInfo is automatically set if the mode is supPorted }
  2553. { by the call to SearchVESAMode. }
  2554. mode.HardwarePages := VESAModeInfo.NumberOfPages;
  2555. mode.DirectColor := TRUE;
  2556. mode.PaletteSize := mode.MaxColor;
  2557. mode.MaxX := 1279;
  2558. mode.MaxY := 1023;
  2559. mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA32kOr64k;
  2560. mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA32kOr64k;
  2561. mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA32kOr64k;
  2562. mode.InitMode := {$ifdef fpc}@{$endif}Init1280x1024x64k;
  2563. mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
  2564. mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
  2565. mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
  2566. mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
  2567. mode.XAspect := 10000;
  2568. mode.YAspect := 10000;
  2569. AddMode(mode);
  2570. end;
  2571. end;
  2572. end;
  2573. var
  2574. go32exitsave: pointer;
  2575. procedure freeSaveStateBuffer; {$ifndef fpc}far; {$endif}
  2576. begin
  2577. if savePtr <> nil then
  2578. begin
  2579. {$ifdef dpmi}
  2580. {$ifndef fpc}
  2581. if GlobalDosFree(longint(SavePtr) shr 16)<>0 then;
  2582. {$else fpc}
  2583. if Not Global_Dos_Free(longint(SavePtr) shr 16) then;
  2584. {$endif fpc}
  2585. {$else dpmi}
  2586. FreeMem(SavePtr, 64*StateSize);
  2587. {$endif dpmi}
  2588. SavePtr := nil;
  2589. end;
  2590. exitproc := go32exitsave;
  2591. end;
  2592. begin
  2593. { must be done *before* initialize graph is called, because the save }
  2594. { buffer can be used in the normal exit_proc (which is hooked in }
  2595. { initializegraph and as such executed first) (JM) }
  2596. go32exitsave := exitproc;
  2597. exitproc := @freeSaveStateBuffer;
  2598. { windows screws up the display if the savestate/restore state }
  2599. { stuff is used (or uses an abnormal amount of cpu time after }
  2600. { such a problem has exited), so detect its presense and do not }
  2601. { use those functions if it's running. I'm really tired of }
  2602. { working around Windows bugs :( (JM) }
  2603. asm
  2604. mov ax,$160a
  2605. {$ifdef fpc}
  2606. push ebp
  2607. {$endif fpc}
  2608. int $2f
  2609. {$ifdef fpc}
  2610. pop ebp
  2611. {$endif fpc}
  2612. test ax,ax
  2613. sete al
  2614. mov inWindows,al
  2615. end;
  2616. InitializeGraph;
  2617. end.
  2618. {
  2619. $Log$
  2620. Revision 1.12 2004-03-06 23:18:02 hajny
  2621. * proper regcall fixes
  2622. Revision 1.11 2003/12/04 21:42:07 peter
  2623. * register calling updates
  2624. Revision 1.10 2003/10/03 21:46:25 peter
  2625. * stdcall fixes
  2626. Revision 1.9 2002/09/07 16:01:18 peter
  2627. * old logs removed and tabs fixed
  2628. }