graph.inc 83 KB

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