graph.inc 85 KB

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