graph.inc 88 KB

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