graph.pp 87 KB

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