1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512 |
- {
- $Id$
- }
- { How this works: }
- { QueryAdapter - Va chercher tout les modes videos et drivers }
- { disponibles sur cette carte, et les mets dans une linked list }
- { en ordre de driver number, et a l'interieur de cela, dans un }
- { ordre croissant de mode number. }
- { DetectGraph - Verifie si la liste chainee de drivers existe, sinon }
- { apelle QueryAdapter }
- { InitGraph - Appelle DetectGraph, et verifie que le mode demande existe}
- { bel et bien et est disponible sur ce PC }
- {$ifndef fpc}
- {$ifndef noasmgraph}
- {$define asmgraph}
- {$endif noasmgraph}
- {$i dpmi.inc}
- {$else fpc}
- {$asmmode intel}
- {$endif fpc}
- CONST
- { VESA Specific video modes. }
- m320x200x32k = $10D;
- m320x200x64k = $10E;
- m640x400x256 = $100;
- m640x480x256 = $101;
- m640x480x32k = $110;
- m640x480x64k = $111;
- m800x600x16 = $102;
- m800x600x256 = $103;
- m800x600x32k = $113;
- m800x600x64k = $114;
- m1024x768x16 = $104;
- m1024x768x256 = $105;
- m1024x768x32k = $116;
- m1024x768x64k = $117;
- m1280x1024x16 = $106;
- m1280x1024x256 = $107;
- m1280x1024x32k = $119;
- m1280x1024x64k = $11A;
- { How to access real mode memory }
- { using 32-bit DPMI memory }
- { 1. Allocate a descriptor }
- { 2. Set segment limit }
- { 3. Set base linear address }
- const
- InternalDriverName = 'DOSGX';
- {$ifdef fpc}
- {$ifdef asmgraph}
- VideoOfs : DWord = 0; { Segment to draw to }
- {$else asmgraph}
- VideoOfs : word = 0; { Segment to draw to }
- {$endif asmgraph}
- {$else fpc}
- VideoOfs : word = 0; { Segment to draw to }
- {$endif fpc}
- FirstPlane = $0102; (* 02 = Index to Color plane Select, *)
- (* 01 = Enable color plane 1 *)
- { ; ===== VGA Register Values ===== }
- SCREEN_WIDTH = 80 ; { MODE-X 320 SCREEN WIDTH }
- { CHANGE THE VALUE IF OTHER MODES }
- { OTHER THEN 320 ARE USED. }
- ATTRIB_Ctrl = $03C0 ; { VGA Attribute Controller }
- GC_Index = $03CE ; { VGA Graphics Controller }
- SC_Index = $03C4 ; { VGA Sequencer Controller }
- SC_Data = $03C5 ; { VGA Sequencer Data Port }
- CRTC_Index = $03D4 ; { VGA CRT Controller }
- CRTC_Data = $03D5 ; { VGA CRT Controller Data }
- MISC_OUTPUT = $03C2 ; { VGA Misc Register }
- INPUT_1 = $03DA ; { Input Status #1 Register }
- DAC_WRITE_ADDR = $03C8 ; { VGA DAC Write Addr Register }
- DAC_READ_ADDR = $03C7 ; { VGA DAC Read Addr Register }
- PEL_DATA_REG = $03C9 ; { VGA DAC/PEL data Register R/W }
- PIXEL_PAN_REG = $033 ; { Attrib Index: Pixel Pan Reg }
- MAP_MASK = $002 ; { S= $Index: Write Map Mask reg }
- READ_MAP = $004 ; { GC Index: Read Map Register }
- START_DISP_HI = $00C ; { CRTC Index: Display Start Hi }
- START_DISP_LO = $00D ; { CRTC Index: Display Start Lo }
- MAP_MASK_PLANE1 = $00102 ; { Map Register + Plane 1 }
- MAP_MASK_PLANE2 = $01102 ; { Map Register + Plane 1 }
- ALL_PLANES_ON = $00F02 ; { Map Register + All Bit Planes }
- CHAIN4_OFF = $00604 ; { Chain 4 mode Off }
- ASYNC_RESET = $00100 ; { (A)synchronous Reset }
- SEQU_RESTART = $00300 ; { Sequencer Restart }
- LATCHES_ON = $00008 ; { Bit Mask + Data from Latches }
- LATCHES_OFF = $0FF08 ; { Bit Mask + Data from CPU }
- VERT_RETRACE = $08 ; { INPUT_1: Vertical Retrace Bit }
- PLANE_BITS = $03 ; { Bits 0-1 of Xpos = Plane # }
- ALL_PLANES = $0F ; { All Bit Planes Selected }
- CHAR_BITS = $0F ; { Bits 0-3 of Character Data }
- GET_CHAR_PTR = $01130 ; { VGA BIOS Func: Get Char Set }
- ROM_8x8_Lo = $03 ; { ROM 8x8 Char Set Lo Pointer }
- ROM_8x8_Hi = $04 ; { ROM 8x8 Char Set Hi Pointer }
- { Constants Specific for these routines }
- NUM_MODES = $8 ; { # of Mode X Variations }
- var
- ScrWidth : word absolute $40:$4a;
- procedure seg_bytemove(sseg : word;source : longint;dseg : word;dest : longint;count : longint);
- begin
- asm
- push es
- push ds
- cld
- mov ecx,count
- mov esi,source
- mov edi,dest
- mov ax,dseg
- mov es,ax
- mov ax,sseg
- mov ds,ax
- rep movsb
- pop ds
- pop es
- end ['ESI','EDI','ECX','EAX']
- end;
- {************************************************************************}
- {* 4-bit planar VGA mode routines *}
- {************************************************************************}
- Procedure Init640x200x16; far; assembler;
- { must also clear the screen...}
- asm
- mov ax,000Eh
- {$ifdef fpc}
- push ebp
- {$endif fpc}
- int 10h
- {$ifdef fpc}
- pop ebp
- {$endif fpc}
- end;
- Procedure Init640x350x16; far; assembler;
- { must also clear the screen...}
- asm
- mov ax,0010h
- {$ifdef fpc}
- push ebp
- {$endif fpc}
- int 10h
- {$ifdef fpc}
- pop ebp
- {$endif fpc}
- end;
- procedure Init640x480x16; far; assembler;
- { must also clear the screen...}
- asm
- mov ax,0012h
- {$ifdef fpc}
- push ebp
- {$endif fpc}
- int 10h
- {$ifdef fpc}
- pop ebp
- {$endif fpc}
- end;
- Procedure PutPixel16(X,Y : Integer; Pixel: Word); far;
- {$ifndef asmgraph}
- var offset: word;
- dummy: byte;
- {$endif asmgraph}
- Begin
- X:= X + StartXViewPort;
- Y:= Y + StartYViewPort;
- { convert to absolute coordinates and then verify clipping...}
- if ClipPixels then
- Begin
- if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
- exit;
- if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
- exit;
- end;
- {$ifndef asmgraph}
- offset := y * 80 + (x shr 3) + VideoOfs;
- PortW[$3ce] := $f01;
- PortW[$3ce] := Pixel shl 8;
- PortB[$3ce] := 8;
- PortW[$3cf] := $80 shr (x and $7) + (Pixel shl 8);
- dummy := Mem[$a000: offset];
- Mem[$a000: offset] := dummy;
- PortW[$3ce] := $ff08;
- PortB[$3ce] := 1;
- {$else asmgraph}
- asm
- {$ifndef fpc}
- mov es, [SegA000]
- {$endif fpc}
- { enable the set / reset function and load the color }
- mov dx, 3ceh
- mov ax, 0f01h
- out dx, ax
- { setup set/reset register }
- mov ax, [Pixel]
- shl ax, 8
- out dx, ax
- { setup the bit mask register }
- mov al, 8
- out dx, al
- inc dx
- { load the bitmask register }
- mov cx, [X]
- and cx, 0007h
- mov al, 80h
- shr al, cl
- out dx, ax
- {$ifndef fpc}
- { get the x index and divide by 8 for 16-color }
- mov ax,[X]
- shr ax,3
- push ax
- { determine the address }
- mov ax,80
- mov bx,[Y]
- mul bx
- pop cx
- add ax,cx
- mov di,ax
- add di, [VideoOfs]
- { send the data through the display memory through set/reset }
- mov bl,es:[di]
- mov es:[di],bl
- { reset for formal vga operation }
- mov dx,3ceh
- mov ax,0ff08h
- out dx,ax
- { restore enable set/reset register }
- mov ax,0001h
- out dx,ax
- {$else fpc}
- { get the x index and divide by 8 for 16-color }
- movzx eax,[X]
- shr eax,3
- push eax
- { determine the address }
- mov eax,80
- mov bx,[Y]
- mul bx
- pop ecx
- add eax,ecx
- mov edi,eax
- add edi, [VideoOfs]
- { send the data through the display memory through set/reset }
- mov bl,fs:[edi+$a0000]
- mov fs:[edi+$a0000],bl
- { reset for formal vga operation }
- mov dx,3ceh
- mov ax,0ff08h
- out dx,ax
- { restore enable set/reset register }
- mov ax,0001h
- out dx,ax
- {$endif fpc}
- end;
- {$endif asmgraph}
- end;
- Function GetPixel16(X,Y: Integer):word; far;
- {$ifndef asmgraph}
- Var dummy, offset: Word;
- shift: byte;
- {$endif asmgraph}
- Begin
- X:= X + StartXViewPort;
- Y:= Y + StartYViewPort;
- {$ifndef asmgraph}
- offset := Y * 80 + (x shr 3) + VideoOfs;
- PortB[$3ce] := 4;
- shift := 7 - (X and 7);
- PortB[$3cf] := 0;
- dummy := (Mem[$a000:offset] shr shift) and 1;
- PortB[$3cf] := 1;
- dummy := dummy or (((Mem[$a000:offset] shr shift) and 1) shl 1);
- PortB[$3cf] := 2;
- dummy := dummy or (((Mem[$a000:offset] shr shift) and 1) shl 2);
- PortB[$3cf] := 3;
- dummy := dummy or (((Mem[$a000:offset] shr shift) and 1) shl 3);
- GetPixel16 := dummy;
- {$else asmgraph}
- asm
- {$ifndef fpc}
- mov ax, [X] { Get X address }
- push ax
- shr ax, 3
- push ax
- mov ax,80
- mov bx,[Y]
- mul bx
- pop cx
- add ax,cx
- mov si,ax { SI = correct offset into video segment }
- mov es,[SegA000]
- add si,[VideoOfs] { Point to correct page offset... }
- mov dx,03ceh
- mov ax,4
- out dx,al
- inc dx
- pop ax
- and ax,0007h
- mov cl,07
- sub cl,al
- mov bl,cl
- { read plane 0 }
- mov al,0 { Select plane to read }
- out dx,al
- mov al,es:[si] { read display memory }
- shr al,cl
- and al,01h
- mov ah,al { save bit in AH }
- { read plane 1 }
- mov al,1 { Select plane to read }
- out dx,al
- mov al,es:[si]
- shr al,cl
- and al,01h
- shl al,1
- or ah,al { save bit in AH }
- { read plane 2 }
- mov al,2 { Select plane to read }
- out dx,al
- mov al,es:[si]
- shr al,cl
- and al,01h
- shl al,2
- or ah,al { save bit in AH }
- { read plane 3 }
- mov al,3 { Select plane to read }
- out dx,al
- mov al,es:[si]
- shr al,cl
- and al,01h
- shl al,3
- or ah,al { save bit in AH }
- mov al,ah { 16-bit pixel in AX }
- xor ah,ah
- mov @Result, ax
- {$else fpc}
- movzx eax, [X] { Get X address }
- push eax
- shr eax, 3
- push eax
- mov eax,80
- mov bx,[Y]
- mul bx
- pop ecx
- add eax,ecx
- mov esi,eax { SI = correct offset into video segment }
- add esi,[VideoOfs] { Point to correct page offset... }
- mov dx,03ceh
- mov ax,4
- out dx,al
- inc dx
- pop eax
- and eax,0007h
- mov cl,07
- sub cl,al
- mov bl,cl
- { read plane 0 }
- mov al,0 { Select plane to read }
- out dx,al
- mov al,fs:[esi+$a0000] { read display memory }
- shr al,cl
- and al,01h
- mov ah,al { save bit in AH }
- { read plane 1 }
- mov al,1 { Select plane to read }
- out dx,al
- mov al,fs:[esi+$a0000]
- shr al,cl
- and al,01h
- shl al,1
- or ah,al { save bit in AH }
- { read plane 2 }
- mov al,2 { Select plane to read }
- out dx,al
- mov al,fs:[esi+$a0000]
- shr al,cl
- and al,01h
- shl al,2
- or ah,al { save bit in AH }
- { read plane 3 }
- mov al,3 { Select plane to read }
- out dx,al
- mov al,fs:[esi+$a0000]
- shr al,cl
- and al,01h
- shl al,3
- or ah,al { save bit in AH }
- mov al,ah { 16-bit pixel in AX }
- xor ah,ah
- mov @Result, ax
- {$endif fpc}
- end;
- {$endif asmgraph}
- end;
- Procedure DirectPutPixel16(X,Y : Integer); far;
- { x,y -> must be in global coordinates. No clipping. }
- var
- color: word;
- {$ifndef asmgraph}
- offset: word;
- dummy: byte;
- {$endif asmgraph}
- begin
- if CurrentWriteMode = XORPut then
- begin
- { getpixel wants local/relative coordinates }
- Color := GetPixel(x-StartXViewPort,y-StartYViewPort);
- Color := CurrentColor XOR Color;
- end
- else
- Color := CurrentColor;
- {$ifndef asmgraph}
- offset := Y * 80 + (X shr 3) + VideoOfs;
- PortW[$3ce] := $f01;
- PortW[$3ce] := Color shl 8;
- PortB[$3ce] := 8;
- PortW[$3cf] := $80 shr (X and 7) + (Color shl 8);
- dummy := Mem[$a000: offset];
- Mem[$a000: offset] := dummy;
- PortW[$3ce] := $ff08;
- PortB[$3ce] := 1;
- {$else asmgraph}
- asm
- {$ifndef fpc}
- mov es, [SegA000]
- { enable the set / reset function and load the color }
- mov dx, 3ceh
- mov ax, 0f01h
- out dx, ax
- { setup set/reset register }
- mov ax, [Color]
- shl ax, 8
- out dx, ax
- { setup the bit mask register }
- mov al, 8
- out dx, al
- inc dx
- { load the bitmask register }
- mov cx, [X]
- and cx, 0007h
- mov al, 80h
- shr al, cl
- out dx, ax
- { get the x index and divide by 8 for 16-color }
- mov ax,[X]
- shr ax,3
- push ax
- { determine the address }
- mov ax,80
- mov bx,[Y]
- mul bx
- pop cx
- add ax,cx
- mov di,ax
- { send the data through the display memory through set/reset }
- add di,[VideoOfs] { add correct page }
- mov bl,es:[di]
- mov es:[di],bl
- { reset for formal vga operation }
- mov dx,3ceh
- mov ax,0ff08h
- out dx,ax
- { restore enable set/reset register }
- mov ax,0001h
- out dx,ax
- {$else fpc}
- { enable the set / reset function and load the color }
- mov dx, 3ceh
- mov ax, 0f01h
- out dx, ax
- { setup set/reset register }
- mov ax, [Color]
- shl ax, 8
- out dx, ax
- { setup the bit mask register }
- mov al, 8
- out dx, al
- inc dx
- { load the bitmask register }
- mov cx, [X]
- and cx, 0007h
- mov al, 80h
- shr al, cl
- out dx, ax
- { get the x index and divide by 8 for 16-color }
- movzx eax,[X]
- shr eax,3
- push eax
- { determine the address }
- mov eax,80
- mov bx,[Y]
- mul bx
- pop ecx
- add eax,ecx
- mov edi,eax
- { send the data through the display memory through set/reset }
- add edi,[VideoOfs] { add correct page }
- mov bl,fs:[edi+$a0000]
- mov fs:[edi+$a0000],bl
- { reset for formal vga operation }
- mov dx,3ceh
- mov ax,0ff08h
- out dx,ax
- { restore enable set/reset register }
- mov ax,0001h
- out dx,ax
- {$endif fpc}
- end;
- {$endif asmgraph}
- end;
- procedure HLine16(x,x2,y: integer); far;
- var
- xtmp: integer;
- ScrOfs,HLength : word;
- LMask,RMask : byte;
- Begin
- { must we swap the values? }
- if x > x2 then
- Begin
- xtmp := x2;
- x2 := x;
- x:= xtmp;
- end;
- { First convert to global coordinates }
- X := X + StartXViewPort;
- X2 := X2 + StartXViewPort;
- Y := Y + StartYViewPort;
- if ClipPixels then
- Begin
- if LineClipped(x,y,x2,y,StartXViewPort,StartYViewPort,
- StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
- exit;
- end;
- ScrOfs:=y*ScrWidth+x div 8;
- HLength:=x2 div 8-x div 8;
- LMask:=$ff shr (x and 7);
- RMask:=$ff shl (7-(x2 and 7));
- if HLength=0 then
- LMask:=LMask and RMask;
- port[$3ce]:=0;
- port[$3cf]:=CurrentColor;
- port[$3ce]:=1;
- port[$3cf]:=$f;
- port[$3ce]:=3;
- case CurrentWriteMode of
- XORPut:
- port[$3cf]:=3 shl 3;
- ANDPut:
- port[$3cf]:=1 shl 3;
- ORPut:
- port[$3cf]:=2 shl 3;
- NormalPut:
- port[$3cf]:=0
- else
- port[$3cf]:=0
- end;
- port[$3ce]:=8;
- port[$3cf]:=LMask;
- Mem[$a000:ScrOfs]:=Mem[$a000:ScrOfs]+1;
- port[$3ce]:=8;
- if HLength>0 then
- begin
- dec(HLength);
- inc(ScrOfs);
- if HLength>0 then
- begin
- port[$3cf]:=$ff;
- seg_bytemove(dosmemselector,$a0000+ScrOfs,dosmemselector,$a0000+ScrOfs,HLength);
- ScrOfs:=ScrOfs+HLength;
- end;
- port[$3cf]:=RMask;
- Mem[$a000:ScrOfs]:=Mem[$a000:ScrOfs]+1;
- end;
- // clean up
- port[$3cf]:=0;
- port[$3ce]:=8;
- port[$3cf]:=$ff;
- port[$3ce]:=1;
- port[$3cf]:=0;
- port[$3ce]:=3;
- port[$3cf]:=0;
- end;
- procedure VLine16(x,y,y2: integer); far;
- var
- ytmp: integer;
- ScrOfs,i : longint;
- BitMask : byte;
- Begin
- { must we swap the values? }
- if y > y2 then
- Begin
- ytmp := y2;
- y2 := y;
- y:= ytmp;
- end;
- { First convert to global coordinates }
- X := X + StartXViewPort;
- Y2 := Y2 + StartYViewPort;
- Y := Y + StartYViewPort;
- if ClipPixels then
- Begin
- if LineClipped(x,y,x,y2,StartXViewPort,StartYViewPort,
- StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
- exit;
- end;
- ScrOfs:=y*ScrWidth+x div 8;
- BitMask:=$80 shr (x and 7);
- port[$3ce]:=0;
- port[$3cf]:=CurrentColor;
- port[$3ce]:=1;
- port[$3cf]:=$f;
- port[$3ce]:=8;
- port[$3cf]:=BitMask;
- port[$3ce]:=3;
- case CurrentWriteMode of
- XORPut:
- port[$3cf]:=3 shl 3;
- ANDPut:
- port[$3cf]:=1 shl 3;
- ORPut:
- port[$3cf]:=2 shl 3;
- NormalPut:
- port[$3cf]:=0
- else
- port[$3cf]:=0
- end;
- for i:=y to y2 do
- begin
- Mem[$a000:ScrOfs]:=Mem[$a000:ScrOfs]+1;
- ScrOfs:=ScrOfs+ScrWidth;
- end;
- // clean up
- port[$3cf]:=0;
- port[$3ce]:=8;
- port[$3cf]:=$ff;
- port[$3ce]:=1;
- port[$3cf]:=0;
- port[$3ce]:=3;
- port[$3cf]:=0;
- End;
- procedure SetVisual480(page: word); far;
- { no page flipping support in 640x480 mode }
- begin
- VideoOfs := 0;
- end;
- procedure SetActive480(page: word); far;
- { no page flipping support in 640x480 mode }
- begin
- VideoOfs := 0;
- end;
- procedure SetVisual200(page: word); far;
- { two page support... }
- begin
- if page > HardwarePages then exit;
- asm
- mov ax,[page] { only lower byte is supported. }
- mov ah,05h
- {$ifdef fpc}
- push ebp
- {$endif fpc}
- int 10h
- {$ifdef fpc}
- pop ebp
- {$endif fpc}
- { read start address }
- mov dx,3d4h
- mov al,0ch
- out dx,al
- inc dx
- in al,dx
- mov ah,al
- dec dx
- mov al,0dh
- out dx,al
- in al,dx
- end;
- end;
- procedure SetActive200(page: word); far;
- { two page support... }
- begin
- case page of
- 0 : VideoOfs := 0;
- 1 : VideoOfs := 16384;
- 2 : VideoOfs := 32768;
- else
- VideoOfs := 0;
- end;
- end;
- procedure SetVisual350(page: word); far;
- { one page support... }
- begin
- if page > HardwarePages then exit;
- asm
- mov ax,[page] { only lower byte is supported. }
- mov ah,05h
- {$ifdef fpc}
- push ebp
- {$endif fpc}
- int 10h
- {$ifdef fpc}
- pop ebp
- {$endif fpc}
- end;
- end;
- procedure SetActive350(page: word); far;
- { one page support... }
- begin
- case page of
- 0 : VideoOfs := 0;
- 1 : VideoOfs := 32768;
- else
- VideoOfs := 0;
- end;
- end;
- {************************************************************************}
- {* 320x200x256c Routines *}
- {************************************************************************}
- Procedure Init320; far; assembler;
- asm
- mov ax,0013h
- {$ifdef fpc}
- push ebp
- {$endif fpc}
- int 10h
- {$ifdef fpc}
- pop ebp
- {$endif fpc}
- end;
- Procedure PutPixel320(X,Y : Integer; Pixel: Word); far;
- { x,y -> must be in local coordinates. Clipping if required. }
- Begin
- X:= X + StartXViewPort;
- Y:= Y + StartYViewPort;
- { convert to absolute coordinates and then verify clipping...}
- if ClipPixels then
- Begin
- if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
- exit;
- if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
- exit;
- end;
- {$ifndef asmgraph}
- Mem[$a000: y * 320 + x + VideoOfs] := Lo(Pixel);
- {$else asmgraph}
- asm
- {$ifndef fpc}
- mov es, [SegA000]
- mov ax, [Y]
- mov di, [X]
- xchg ah, al { The value of Y must be in AH }
- add di, ax
- shr ax, 2
- add di, ax
- add di, [VideoOfs] { point to correct page.. }
- mov ax, [Pixel]
- mov es:[di], al
- {$else fpc}
- movzx edi, x
- movzx ebx, y
- add edi, [VideoOfs]
- shl ebx, 6
- add edi, ebx
- mov ax, pixel
- mov fs:[edi+ebx*4+$a0000], al
- {$endif fpc}
- end;
- {$endif asmgraph}
- end;
- Function GetPixel320(X,Y: Integer):word; far;
- Begin
- X:= X + StartXViewPort;
- Y:= Y + StartYViewPort;
- {$ifndef asmgraph}
- GetPixel320 := Mem[$a000:y * 320 + x + VideoOfs];
- {$else asmgraph}
- asm
- {$ifndef fpc}
- mov es, [SegA000]
- mov ax, [Y]
- mov di, [X]
- xchg ah, al { The value of Y must be in AH }
- add di, ax
- shr ax, 2
- add di, ax
- xor ax, ax
- add di, [VideoOfs] { point to correct gfx page ... }
- mov al,es:[di]
- mov @Result,ax
- {$else fpc}
- movzx edi, x
- movzx ebx, y
- add edi, [VideoOfs]
- shl ebx, 6
- add edi, ebx
- mov al, fs:[edi+ebx*4+$a0000]
- mov @Result, al
- {$endif fpc}
- end;
- {$endif asmgraph}
- end;
- Procedure DirectPutPixel320(X,Y : Integer); far;
- { x,y -> must be in global coordinates. No clipping. }
- {$ifndef asmgraph}
- var offset: word;
- dummy: Byte;
- begin
- dummy := CurrentColor;
- offset := y * 320 + x + VideoOfs;
- If CurrentWriteMode = XorPut Then
- dummy := dummy xor Mem[$a000:offset];
- Mem[$a000:offset] := dummy;
- end;
- {$else asmgraph}
- assembler;
- asm
- {$ifndef fpc}
- mov es, [SegA000]
- mov ax, [Y]
- mov di, [X]
- xchg ah, al { The value of Y must be in AH }
- add di, ax
- shr ax, 2
- add di, ax
- add di, [VideoOfs]
- mov ax, [CurrentColor]
- cmp [CurrentWriteMode],XORPut { check write mode }
- jne @MOVMode
- mov ah,es:[di] { read the byte... }
- xor al,ah { xor it and return value into AL }
- @MovMode:
- mov es:[di], al
- {$else fpc}
- movzx edi, y
- shl edi, 6
- mov ebx, edx
- add edi, [VideoOfs]
- mov ax, [CurrentColor]
- cmp [CurrentWriteMode],XORPut { check write mode }
- jne @MOVMode
- mov bl, fs:[edi+ebx*4+$a0000]
- xor al, bl
- @MovMode:
- mov fs:[edi+ebx*4+$a0000], al
- {$endif fpc}
- end;
- {$endif asmgraph}
- procedure SetVisual320(page: word); far;
- { no page support... }
- begin
- end;
- procedure SetActive320(page: word); far;
- { no page support... }
- begin
- VideoOfs := 0;
- end;
- {************************************************************************}
- {* Mode-X related routines *}
- {************************************************************************}
- const CrtAddress: word = 0;
- procedure InitModeX; far;
- begin
- asm
- {see if we are using color-/monochorme display}
- MOV DX,3CCh {use output register: }
- IN AL,DX
- TEST AL,1 {is it a color display? }
- MOV DX,3D4h
- JNZ @L1 {yes }
- MOV DX,3B4h {no }
- @L1: {DX = 3B4h / 3D4h = CRTAddress-register for monochrome/color}
- MOV CRTAddress,DX
- MOV AX, 0013h
- {$ifdef fpc}
- push ebp
- {$EndIf fpc}
- INT 10h
- {$ifdef fpc}
- pop ebp
- {$EndIf fpc}
- MOV DX,03C4h {select memory-mode-register at sequencer port }
- MOV AL,04
- OUT DX,AL
- INC DX {read in data via the according data register }
- IN AL,DX
- AND AL,0F7h {bit 3 := 0: don't chain the 4 planes}
- OR AL,04 {bit 2 := 1: no odd/even mechanism }
- OUT DX,AL {activate new settings }
- MOV DX,03C4h {s.a.: address sequencer reg. 2 (=map-mask),... }
- MOV AL,02
- OUT DX,AL
- INC DX
- MOV AL,0Fh {...and allow access to all 4 bit maps }
- OUT DX,AL
- {$ifndef fpc}
- MOV AX,[SegA000] {starting with segment A000h, set 8000h logical }
- MOV ES,AX {words = 4*8000h physical words (because of 4 }
- XOR DI,DI {bitplanes) to 0 }
- XOR AX,AX
- MOV CX,8000h
- CLD
- REP STOSW
- {$else fpc}
- push es
- push fs
- mov edi, $a0000
- pop es
- xor eax, eax
- mov ecx, 4000h
- cld
- rep stosd
- pop es
- {$EndIf fpc}
- MOV DX,CRTAddress {address the underline-location-register at }
- MOV AL,14h {the CRT-controller port, read out the according }
- OUT DX,AL {data register: }
- INC DX
- IN AL,DX
- AND AL,0BFh {bit 6:=0: no double word addressing scheme in}
- OUT DX,AL {video RAM }
- DEC DX
- MOV AL,17h {select mode control register }
- OUT DX,AL
- INC DX
- IN AL,DX
- OR AL,40h {bit 6 := 1: memory access scheme=linear bit array }
- OUT DX,AL
- end;
- end;
- Function GetPixelX(X,Y: Integer): word; far;
- {$ifndef asmgraph}
- var offset: word;
- {$endif asmgraph}
- begin
- X:= X + StartXViewPort;
- Y:= Y + StartYViewPort;
- {$ifndef asmgraph}
- offset := y * 80 + x shr 2 + VideoOfs;
- PortW[$3c4] := FirstPlane shl (x and 3);
- GetPixelX := Mem[$a000:offset];
- {$else asmgraph}
- asm
- {$ifndef fpc}
- mov di,[Y] ; (* DI = Y coordinate *)
- (* Multiply by 80 start *)
- mov bx, di
- shl di, 6 ; (* Faster on 286/386/486 machines *)
- shl bx, 4
- add di, bx ; (* Multiply Value by 80 *)
- (* End multiply by 80 *)
- mov cx, [X]
- mov ax, cx
- {DI = Y * LINESIZE, BX = X, coordinates admissible}
- shr ax, 1 ; (* Faster on 286/86 machines *)
- shr ax, 1
- add di, ax ; {DI = Y * LINESIZE + (X SHR 2) }
- add di, [VideoOfs] ; (* Pointing at start of Active page *)
- (* Select plane to use *)
- mov dx, 03c4h
- mov ax, FirstPlane ; (* Map Mask & Plane Select Register *)
- and cl, 03h ; (* Get Plane Bits *)
- shl ah, cl ; (* Get Plane Select Value *)
- out dx, ax
- (* End selection of plane *)
- mov es,[SegA000]
- mov al, ES:[DI]
- xor ah, ah
- mov @Result, ax
- {$else fpc}
- movzx edi,[Y] ; (* DI = Y coordinate *)
- (* Multiply by 80 start *)
- mov ebx, edi
- shl edi, 6 ; (* Faster on 286/386/486 machines *)
- shl ebx, 4
- add edi, ebx ; (* Multiply Value by 80 *)
- (* End multiply by 80 *)
- movzx ecx, [X]
- movzx eax, [Y]
- {DI = Y * LINESIZE, BX = X, coordinates admissible}
- shr eax, 2
- add edi, eax ; {DI = Y * LINESIZE + (X SHR 2) }
- add edi, [VideoOfs] ; (* Pointing at start of Active page *)
- (* Select plane to use *)
- mov dx, 03c4h
- mov ax, FirstPlane ; (* Map Mask & Plane Select Register *)
- and cl, 03h ; (* Get Plane Bits *)
- shl ah, cl ; (* Get Plane Select Value *)
- out dx, ax
- (* End selection of plane *)
- mov ax, fs:[edi+$a0000]
- mov @Result, ax
- {$endif fpc}
- end;
- {$endif asmgraph}
- end;
- procedure SetVisualX(page: word); far;
- { 4 page support... }
- Procedure SetVisibleStart(AOffset: word); Assembler;
- (* Select where the left corner of the screen will be *)
- { By Matt Pritchard }
- asm
- { Wait if we are currently in a Vertical Retrace }
- MOV DX, INPUT_1 { Input Status #1 Register }
- @DP_WAIT0:
- IN AL, DX { Get VGA status }
- AND AL, VERT_RETRACE { In Display mode yet? }
- JNZ @DP_WAIT0 { If Not, wait for it }
- { Set the Start Display Address to the new page }
- MOV DX, CRTC_Index { We Change the VGA Sequencer }
- MOV AL, START_DISP_LO { Display Start Low Register }
- {$ifndef fpc}
- MOV AH, BYTE PTR [AOffset] { Low 8 Bits of Start Addr }
- OUT DX, AX { Set Display Addr Low }
- MOV AL, START_DISP_HI { Display Start High Register }
- MOV AH, BYTE PTR [AOffset+1] { High 8 Bits of Start Addr }
- {$else fpc}
- mov ah, byte [AOffset]
- out dx, ax
- mov AL, START_DISP_HI
- mov ah, byte [AOffset+1]
- {$endif fpc}
- OUT DX, AX { Set Display Addr High }
- { Wait for a Vertical Retrace to smooth out things }
- MOV DX, INPUT_1 { Input Status #1 Register }
- @DP_WAIT1:
- IN AL, DX { Get VGA status }
- AND AL, VERT_RETRACE { Vertical Retrace Start? }
- JZ @DP_WAIT1 { If Not, wait for it }
- { Now Set Display Starting Address }
- end;
- {$ifdef fpc}
- {$undef asmgraph}
- {$endif fpc}
- begin
- Case page of
- 0: SetVisibleStart(0);
- 1: SetVisibleStart(16000);
- 2: SetVisibleStart(32000);
- 3: SetVisibleStart(48000);
- else
- SetVisibleStart(0);
- end;
- end;
- procedure SetActiveX(page: word); far;
- { 4 page support... }
- begin
- case page of
- 0: VideoOfs := 0;
- 1: VideoOfs := 16000;
- 2: VideoOfs := 32000;
- 3: VideoOfs := 48000;
- else
- VideoOfs:=0;
- end;
- end;
- Procedure PutPixelX(X,Y: Integer; color:word); far;
- {$ifndef asmgraph}
- var offset: word;
- dummy: byte;
- {$endif asmgraph}
- begin
- X:= X + StartXViewPort;
- Y:= Y + StartYViewPort;
- { convert to absolute coordinates and then verify clipping...}
- if ClipPixels then
- Begin
- if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
- exit;
- if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
- exit;
- end;
- {$ifndef asmgraph}
- Dummy := color;
- offset := y * 80 + x shr 2 + VideoOfs;
- PortW[$3c4] := FirstPlane shl (x and 3);
- If CurrentWriteMode = XorPut Then
- Dummy := Dummy Xor Mem[$a000:offset];
- Mem[$a000:offset] := Dummy;
- {$else asmgraph}
- asm
- mov di,[Y] ; (* DI = Y coordinate *)
- (* Multiply by 80 start *)
- mov bx, di
- shl di, 6 ; (* Faster on 286/386/486 machines *)
- shl bx, 4
- add di, bx ; (* Multiply Value by 80 *)
- (* End multiply by 80 *)
- mov cx, [X]
- mov ax, cx
- {DI = Y * LINESIZE, BX = X, coordinates admissible}
- shr ax, 2
- add di, ax ; {DI = Y * LINESIZE + (X SHR 2) }
- add di, [VideoOfs] ; (* Pointing at start of Active page *)
- (* Select plane to use *)
- mov dx, 03c4h
- mov ax, FirstPlane ; (* Map Mask & Plane Select Register *)
- and cl, 03h ; (* Get Plane Bits *)
- shl ah, cl ; (* Get Plane Select Value *)
- out dx, ax
- (* End selection of plane *)
- mov es,[SegA000]
- mov ax,[Color] ; { only lower byte is used. }
- cmp [CurrentWriteMode],XORPut { check write mode }
- jne @MOVMode
- mov ah,es:[di] { read the byte... }
- xor al,ah { xor it and return value into AL }
- @MovMode:
- mov es:[di], al
- end;
- {$endif asmgraph}
- end;
- Procedure DirectPutPixelX(X,Y: Integer); far;
- { x,y -> must be in global coordinates. No clipping. }
- {$ifndef asmgraph}
- Var offset: Word;
- dummy: Byte;
- begin
- dummy := CurrentColor;
- offset := y * 80 + x shr 2 + VideoOfs;
- PortW[$3c4] := FirstPlane shl (x and 3);
- If CurrentWriteMode = XorPut Then
- dummy := dummy xor Mem[$a000: offset];
- Mem[$a000: offset] := Dummy;
- end;
- {$else asmgraph}
- Assembler;
- asm
- mov di,[Y] ; (* DI = Y coordinate *)
- (* Multiply by 80 start *)
- mov bx, di
- shl di, 6 ; (* Faster on 286/386/486 machines *)
- shl bx, 4
- add di, bx ; (* Multiply Value by 80 *)
- (* End multiply by 80 *)
- mov cx, [X]
- mov ax, cx
- {DI = Y * LINESIZE, BX = X, coordinates admissible}
- shr ax, 2
- add di, ax ; {DI = Y * LINESIZE + (X SHR 2) }
- add di, [VideoOfs] ; (* Pointing at start of Active page *)
- (* Select plane to use *)
- mov dx, 03c4h
- mov ax, FirstPlane ; (* Map Mask & Plane Select Register *)
- and cl, 03h ; (* Get Plane Bits *)
- shl ah, cl ; (* Get Plane Select Value *)
- out dx, ax
- (* End selection of plane *)
- mov es,[SegA000]
- mov ax,[CurrentColor] ; { only lower byte is used. }
- cmp [CurrentWriteMode],XORPut { check write mode }
- jne @MOVMode
- mov ah,es:[di] { read the byte... }
- xor al,ah { xor it and return value into AL }
- @MovMode:
- mov es:[di], al
- end;
- {$endif asmgraph}
- {************************************************************************}
- {* General routines *}
- {************************************************************************}
- var
- SavePtr : pointer; { pointer to video state }
- StateSize: word; { size in 64 byte blocks for video state }
- VideoMode: byte; { old video mode before graph mode }
- SaveSupported : Boolean; { Save/Restore video state supported? }
- {**************************************************************}
- {* DPMI Routines *}
- {**************************************************************}
- {$IFDEF DPMI}
- RealStateSeg: word; { Real segment of saved video state }
- Procedure SaveStateVGA;
- var
- PtrLong: longint;
- regs: TDPMIRegisters;
- begin
- SaveSupported := FALSE;
- SavePtr := nil;
- { Get the video mode }
- asm
- mov ah,0fh
- int 10h
- mov [VideoMode], al
- end;
- { Prepare to save video state...}
- asm
- mov ax, 1C00h { get buffer size to save state }
- mov cx, 00000111b { Save DAC / Data areas / Hardware states }
- {$ifdef fpc}
- push ebp
- {$endif fpc}
- int 10h
- {$ifdef fpc}
- pop ebp
- {$endif fpc}
- mov [StateSize], bx
- cmp al,01ch
- jnz @notok
- mov [SaveSupported],TRUE
- @notok:
- end;
- if SaveSupported then
- begin
- {$ifndef fpc}
- PtrLong:=GlobalDosAlloc(64*StateSize); { values returned in 64-byte blocks }
- {$else fpc}
- PtrLong:=Global_Dos_Alloc(64*StateSize); { values returned in 64-byte blocks }
- {$endif fpc}
- if PtrLong = 0 then
- RunError(203);
- SavePtr := pointer(longint(PtrLong and $0000ffff) shl 16);
- {$ifndef fpc}
- { In FPC mode, we can't do anything with this (no far pointers) }
- { However, we still need to keep it to be able to free the }
- { memory afterwards. Since this data is not accessed in PM code, }
- { there's no need to save it in a seperate buffer (JM) }
- if not assigned(SavePtr) then
- RunError(203);
- {$endif fpc}
- RealStateSeg := word(PtrLong shr 16);
- FillChar(regs, sizeof(regs), #0);
- { call the real mode interrupt ... }
- regs.eax := $1C01; { save the state buffer }
- regs.ecx := $07; { Save DAC / Data areas / Hardware states }
- regs.es := RealStateSeg;
- regs.ebx := 0;
- RealIntr($10,regs);
- FillChar(regs, sizeof(regs), #0);
- { restore state, according to Ralph Brown Interrupt list }
- { some BIOS corrupt the hardware after a save... }
- regs.eax := $1C02; { restore the state buffer }
- regs.ecx := $07; { rest DAC / Data areas / Hardware states }
- regs.es := RealStateSeg;
- regs.ebx := 0;
- RealIntr($10,regs);
- end;
- end;
- procedure RestoreStateVGA;
- var
- regs:TDPMIRegisters;
- begin
- { go back to the old video mode...}
- asm
- mov ah,00
- mov al,[VideoMode]
- {$ifdef fpc}
- push ebp
- {$endif fpc}
- int 10h
- {$ifdef fpc}
- pop ebp
- {$endif fpc}
- end;
- { then restore all state information }
- {$ifndef fpc}
- if assigned(SavePtr) and (SaveSupported=TRUE) then
- {$else fpc}
- { No far pointer support, so it's possible that that assigned(SavePtr) }
- { would return false under FPC. Just check if it's different from nil. }
- if (SavePtr <> nil) and (SaveSupported=TRUE) then
- {$endif fpc}
- begin
- FillChar(regs, sizeof(regs), #0);
- { restore state, according to Ralph Brown Interrupt list }
- { some BIOS corrupt the hardware after a save... }
- regs.eax := $1C02; { restore the state buffer }
- regs.ecx := $07; { rest DAC / Data areas / Hardware states }
- regs.es := RealStateSeg;
- regs.ebx := 0;
- RealIntr($10,regs);
- {$ifndef fpc}
- if GlobalDosFree(longint(SavePtr) shr 16)<>0 then
- {$else fpc}
- if Not Global_Dos_Free(longint(SavePtr) shr 16) then
- {$endif fpc}
- RunError(216);
- SavePtr := nil;
- end;
- end;
- {$ELSE}
- {**************************************************************}
- {* Real mode routines *}
- {**************************************************************}
- Procedure SaveStateVGA; far;
- begin
- SavePtr := nil;
- SaveSupported := FALSE;
- { Get the video mode }
- asm
- mov ah,0fh
- int 10h
- mov [VideoMode], al
- end;
- { Prepare to save video state...}
- asm
- mov ax, 1C00h { get buffer size to save state }
- mov cx, 00000111b { Save DAC / Data areas / Hardware states }
- int 10h
- mov [StateSize], bx
- cmp al,01ch
- jnz @notok
- mov [SaveSupported],TRUE
- @notok:
- end;
- if SaveSupported then
- Begin
- GetMem(SavePtr, 64*StateSize); { values returned in 64-byte blocks }
- if not assigned(SavePtr) then
- RunError(203);
- asm
- mov ax, 1C01h { save the state buffer }
- mov cx, 00000111b { Save DAC / Data areas / Hardware states }
- mov es, WORD PTR [SavePtr+2]
- mov bx, WORD PTR [SavePtr]
- int 10h
- end;
- { restore state, according to Ralph Brown Interrupt list }
- { some BIOS corrupt the hardware after a save... }
- asm
- mov ax, 1C02h { save the state buffer }
- mov cx, 00000111b { Save DAC / Data areas / Hardware states }
- mov es, WORD PTR [SavePtr+2]
- mov bx, WORD PTR [SavePtr]
- int 10h
- end;
- end;
- end;
- procedure RestoreStateVGA; far;
- begin
- { go back to the old video mode...}
- asm
- mov ah,00
- mov al,[VideoMode]
- int 10h
- end;
- { then restore all state information }
- if assigned(SavePtr) and (SaveSupported=TRUE) then
- begin
- { restore state, according to Ralph Brown Interrupt list }
- asm
- mov ax, 1C02h { save the state buffer }
- mov cx, 00000111b { Save DAC / Data areas / Hardware states }
- mov es, WORD PTR [SavePtr+2]
- mov bx, WORD PTR [SavePtr]
- int 10h
- end;
- FreeMem(SavePtr, 64*StateSize);
- SavePtr := nil;
- end;
- end;
- {$ENDIF DPMI}
- { VGA is never a direct color mode, so no need to check ... }
- Procedure SetVGARGBPalette(ColorNum, RedValue, GreenValue,
- BlueValue : Integer); far; assembler;
- asm
- { on some hardware - there is a snow like effect }
- { when changing the palette register directly }
- { so we wait for a vertical retrace start period. }
- mov dx, $03da
- @1:
- in al, dx { Get input status register }
- test al, $08 { check if in vertical retrace }
- jnz @1 { yes, complete it }
- { we have to wait for the next }
- { retrace to assure ourselves }
- { that we have time to complete }
- { the DAC operation within }
- { the vertical retrace period }
- @2:
- in al, dx
- test al, $08
- jz @2 { repeat until vertical retrace start }
- mov dx, $03c8 { Set color register address to use }
- mov ax, [ColorNum]
- out dx, al
- inc dx { Point to DAC registers }
- mov ax, [RedValue] { Get RedValue }
- { and ax, $ff } { mask out all upper bits }
- shr al, 2 { convert to LSB RGB format }
- out dx, al
- mov ax, [GreenValue]{ Get RedValue }
- { and ax, $ff } { mask out all upper bits }
- shr al, 2 { convert to LSB RGB format }
- out dx, al
- mov ax, [BlueValue] { Get RedValue }
- { and ax, $ff } { mask out all upper bits }
- shr al, 2 { convert to LSB RGB format }
- out dx, al
- end;
- { VGA is never a direct color mode, so no need to check ... }
- Procedure GetVGARGBPalette(ColorNum: integer; Var
- RedValue, GreenValue, BlueValue : integer); far;
- begin
- Port[$03C7] := ColorNum;
- { we must convert to lsb values... because the vga uses the 6 msb bits }
- { which is not compatible with anything. }
- RedValue := Integer(Port[$3C9] shl 2);
- GreenValue := Integer(Port[$3C9] shl 2);
- BlueValue := Integer(Port[$3C9] shl 2);
- end;
- {************************************************************************}
- {* VESA related routines *}
- {************************************************************************}
- {$I vesa.inc}
- {************************************************************************}
- {* General routines *}
- {************************************************************************}
- procedure CloseGraph;
- Begin
- if not assigned(RestoreVideoState) then
- RunError(216);
- RestoreVideoState;
- {$IFDEF DPMI}
- { We had copied the buffer of mode information }
- { and allocated it dynamically... now free it }
- { Warning: if GetVESAInfo returned false, this buffer is not allocated!
- (JM)}
- If hasVesa then
- Dispose(VESAInfo.ModeList);
- {$ENDIF}
- end;
- function QueryAdapterInfo:PModeInfo;
- { This routine returns the head pointer to the list }
- { of supported graphics modes. }
- { Returns nil if no graphics mode supported. }
- { This list is READ ONLY! }
- var
- EGADetected : Boolean;
- VGADetected : Boolean;
- mode: TModeInfo;
- begin
- QueryAdapterInfo := ModeList;
- { If the mode listing already exists... }
- { simply return it, without changing }
- { anything... }
- if assigned(ModeList) then
- exit;
- EGADetected := FALSE;
- VGADetected := FALSE;
- { check if Hercules adapter supported ... }
- { check if EGA adapter supported... }
- asm
- mov ah,12h
- mov bx,0FF10h
- {$ifdef fpc}
- push ebp
- {$endif fpc}
- int 10h { get EGA information }
- {$ifdef fpc}
- pop ebp
- {$endif fpc}
- cmp bh,0ffh
- jz @noega
- mov [EGADetected],TRUE
- @noega:
- end;
- { check if VGA adapter supported... }
- if EGADetected then
- begin
- asm
- mov ax,1a00h
- {$ifdef fpc}
- push ebp
- {$endif fpc}
- int 10h { get display combination code...}
- {$ifdef fpc}
- pop ebp
- {$endif fpc}
- cmp al,1ah { check if supported... }
- jne @novga
- { now check if this is the ATI EGA }
- mov ax,1c00h { get state size for save... }
- { ... all important data }
- mov cx,07h
- {$ifdef fpc}
- push ebp
- {$endif fpc}
- int 10h
- {$ifdef fpc}
- pop ebp
- {$endif fpc}
- cmp al,1ch { success? }
- jne @novga
- mov [VGADetected],TRUE
- @novga:
- end;
- end;
- if VGADetected then
- begin
- SaveVideoState := SaveStateVGA;
- RestoreVideoState := RestoreStateVGA;
- InitMode(mode);
- { now add all standard VGA modes... }
- mode.DriverNumber:= LowRes;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=0;
- mode.ModeName:='320 x 200 VGA';
- mode.MaxColor := 256;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 319;
- mode.MaxY := 199;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixel320;
- mode.PutPixel:=PutPixel320;
- mode.GetPixel:=GetPixel320;
- mode.SetRGBPalette := SetVGARGBPalette;
- mode.GetRGBPalette := GetVGARGBPalette;
- mode.SetVisualPage := SetVisual320;
- mode.SetActivePage := SetActive320;
- mode.InitMode := Init320;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixel320;
- mode.PutPixel:=@PutPixel320;
- mode.GetPixel:=@GetPixel320;
- mode.SetRGBPalette := @SetVGARGBPalette;
- mode.GetRGBPalette := @GetVGARGBPalette;
- mode.SetVisualPage := @SetVisual320;
- mode.SetActivePage := @SetActive320;
- mode.InitMode := @Init320;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- { now add all standard VGA modes... }
- InitMode(mode);
- mode.DriverNumber:= LowRes;
- mode.ModeNumber:=1;
- mode.HardwarePages := 3; { 0..3 }
- mode.ModeName:='320 x 200 ModeX';
- mode.MaxColor := 256;
- mode.DirectColor := FALSE;
- mode.PaletteSize := mode.MaxColor;
- mode.MaxX := 319;
- mode.MaxY := 199;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixelX;
- mode.PutPixel:=PutPixelX;
- mode.GetPixel:=GetPixelX;
- mode.SetRGBPalette := SetVGARGBPalette;
- mode.GetRGBPalette := GetVGARGBPalette;
- mode.SetVisualPage := SetVisualX;
- mode.SetActivePage := SetActiveX;
- mode.InitMode := InitModeX;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixelX;
- mode.PutPixel:=@PutPixelX;
- mode.GetPixel:=@GetPixelX;
- mode.SetRGBPalette := @SetVGARGBPalette;
- mode.GetRGBPalette := @GetVGARGBPalette;
- mode.SetVisualPage := @SetVisualX;
- mode.SetActivePage := @SetActiveX;
- mode.InitMode := @InitModeX;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.ModeNumber:=VGALo;
- mode.DriverNumber := VGA;
- mode.ModeName:='640 x 200 VGA';
- mode.MaxColor := 16;
- mode.HardwarePages := 2;
- mode.DirectColor := FALSE;
- mode.PaletteSize := mode.MaxColor;
- mode.MaxX := 639;
- mode.MaxY := 199;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixel16;
- mode.PutPixel:=PutPixel16;
- mode.GetPixel:=GetPixel16;
- mode.SetRGBPalette := SetVGARGBPalette;
- mode.GetRGBPalette := GetVGARGBPalette;
- mode.SetVisualPage := SetVisual200;
- mode.SetActivePage := SetActive200;
- mode.InitMode := Init640x200x16;
- mode.HLine := HLine16;
- mode.VLine := VLine16;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixel16;
- mode.PutPixel:=@PutPixel16;
- mode.GetPixel:=@GetPixel16;
- mode.SetRGBPalette := @SetVGARGBPalette;
- mode.GetRGBPalette := @GetVGARGBPalette;
- mode.SetVisualPage := @SetVisual200;
- mode.SetActivePage := @SetActive200;
- mode.InitMode := @Init640x200x16;
- mode.HLine := @HLine16;
- mode.VLine := @VLine16;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.ModeNumber:=VGAMed;
- mode.DriverNumber := VGA;
- mode.ModeName:='640 x 350 VGA';
- mode.HardwarePages := 1;
- mode.MaxColor := 16;
- mode.DirectColor := FALSE;
- mode.PaletteSize := mode.MaxColor;
- mode.MaxX := 639;
- mode.MaxY := 349;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixel16;
- mode.PutPixel:=PutPixel16;
- mode.GetPixel:=GetPixel16;
- mode.InitMode := Init640x350x16;
- mode.SetRGBPalette := SetVGARGBPalette;
- mode.GetRGBPalette := GetVGARGBPalette;
- mode.SetVisualPage := SetVisual350;
- mode.SetActivePage := SetActive350;
- mode.HLine := HLine16;
- mode.VLine := VLine16;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixel16;
- mode.PutPixel:=@PutPixel16;
- mode.GetPixel:=@GetPixel16;
- mode.InitMode := @Init640x350x16;
- mode.SetRGBPalette := @SetVGARGBPalette;
- mode.GetRGBPalette := @GetVGARGBPalette;
- mode.SetVisualPage := @SetVisual350;
- mode.SetActivePage := @SetActive350;
- mode.HLine := @HLine16;
- mode.VLine := @VLine16;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.ModeNumber:=VGAHi;
- mode.DriverNumber := VGA;
- mode.HardwarePages := 0;
- mode.ModeName:='640 x 480 VGA';
- mode.MaxColor := 16;
- mode.DirectColor := FALSE;
- mode.PaletteSize := mode.MaxColor;
- mode.MaxX := 639;
- mode.MaxY := 479;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixel16;
- mode.PutPixel:=PutPixel16;
- mode.GetPixel:=GetPixel16;
- mode.SetRGBPalette := SetVGARGBPalette;
- mode.GetRGBPalette := GetVGARGBPalette;
- mode.InitMode := Init640x480x16;
- mode.SetVisualPage := SetVisual480;
- mode.SetActivePage := SetActive480;
- mode.HLine := HLine16;
- mode.VLine := VLine16;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixel16;
- mode.PutPixel:=@PutPixel16;
- mode.GetPixel:=@GetPixel16;
- mode.SetRGBPalette := @SetVGARGBPalette;
- mode.GetRGBPalette := @GetVGARGBPalette;
- mode.InitMode := @Init640x480x16;
- mode.SetVisualPage := @SetVisual480;
- mode.SetActivePage := @SetActive480;
- mode.HLine := @HLine16;
- mode.VLine := @VLine16;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- { check if VESA adapter supported... }
- {$ifdef supportVESA}
- hasVesa := getVesaInfo(VESAInfo);
- {$else supportVESA}
- hasVESA := false;
- {$endif supportVESA}
- if hasVesa then
- begin
- { We have to set and restore the entire VESA state }
- { otherwise, if we use the VGA BIOS only function }
- { there might be a crash under DPMI, such as in the}
- { ATI Mach64 }
- SaveVideoState := SaveStateVESA;
- RestoreVideoState := RestoreStateVESA;
- { now check all supported modes...}
- if SearchVESAModes(m320x200x32k) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m320x200x32k;
- mode.DriverNumber := VESA;
- mode.ModeName:='320 x 200 VESA';
- mode.MaxColor := 32768;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := TRUE;
- mode.MaxX := 319;
- mode.MaxY := 199;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA32k;
- mode.PutPixel:=PutPixVESA32k;
- mode.GetPixel:=GetPixVESA32k;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- mode.InitMode := Init320x200x32k;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA32k;
- mode.PutPixel:=@PutPixVESA32k;
- mode.GetPixel:=@GetPixVESA32k;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- mode.InitMode := @Init320x200x32k;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if SearchVESAModes(m320x200x64k) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m320x200x64k;
- mode.DriverNumber := VESA;
- mode.ModeName:='320 x 200 VESA';
- mode.MaxColor := 65536;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := TRUE;
- mode.MaxX := 319;
- mode.MaxY := 199;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA64k;
- mode.PutPixel:=PutPixVESA64k;
- mode.GetPixel:=GetPixVESA64k;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- mode.InitMode := Init320x200x64k;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA64k;
- mode.PutPixel:=@PutPixVESA64k;
- mode.GetPixel:=@GetPixVESA64k;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- mode.InitMode := @Init320x200x64k;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if SearchVESAModes(m640x400x256) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m640x400x256;
- mode.DriverNumber := VESA;
- mode.ModeName:='640 x 400 VESA';
- mode.MaxColor := 256;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 639;
- mode.MaxY := 399;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA256;
- mode.PutPixel:=PutPixVESA256;
- mode.GetPixel:=GetPixVESA256;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- mode.InitMode := Init640x400x256;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA256;
- mode.PutPixel:=@PutPixVESA256;
- mode.GetPixel:=@GetPixVESA256;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- mode.InitMode := @Init640x400x256;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if SearchVESAModes(m640x480x256) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m640x480x256;
- mode.DriverNumber := VESA;
- mode.ModeName:='640 x 480 VESA';
- mode.MaxColor := 256;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.PaletteSize := mode.MaxColor;
- mode.MaxX := 639;
- mode.MaxY := 479;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA256;
- mode.PutPixel:=PutPixVESA256;
- mode.GetPixel:=GetPixVESA256;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- mode.InitMode := Init640x480x256;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA256;
- mode.PutPixel:=@PutPixVESA256;
- mode.GetPixel:=@GetPixVESA256;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- mode.InitMode := @Init640x480x256;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if SearchVESAModes(m640x480x32k) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m640x480x32k;
- mode.DriverNumber := VESA;
- mode.ModeName:='640 x 400 VESA';
- mode.MaxColor := 32768;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := TRUE;
- mode.MaxX := 639;
- mode.MaxY := 399;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA32k;
- mode.PutPixel:=PutPixVESA32k;
- mode.GetPixel:=GetPixVESA32k;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- mode.InitMode := Init640x480x32k;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA32k;
- mode.PutPixel:=@PutPixVESA32k;
- mode.GetPixel:=@GetPixVESA32k;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- mode.InitMode := @Init640x480x32k;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if SearchVESAModes(m640x480x64k) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m640x480x64k;
- mode.DriverNumber := VESA;
- mode.ModeName:='640 x 480 VESA';
- mode.MaxColor := 65536;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := TRUE;
- mode.MaxX := 639;
- mode.MaxY := 479;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA64k;
- mode.PutPixel:=PutPixVESA64k;
- mode.GetPixel:=GetPixVESA64k;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- mode.InitMode := Init640x480x64k;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA64k;
- mode.PutPixel:=@PutPixVESA64k;
- mode.GetPixel:=@GetPixVESA64k;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- mode.InitMode := @Init640x480x64k;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if SearchVESAModes(m800x600x16) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m800x600x16;
- mode.DriverNumber := VESA;
- mode.ModeName:='800 x 600 VESA';
- mode.MaxColor := 16;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.DirectColor := FALSE;
- mode.PaletteSize := mode.MaxColor;
- mode.MaxX := 799;
- mode.MaxY := 599;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA16;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- mode.PutPixel:=PutPixVESA16;
- { mode.GetPixel:=GetPixVESA16;}
- mode.InitMode := Init800x600x16;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA16;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- mode.PutPixel:=@PutPixVESA16;
- { mode.GetPixel:=@GetPixVESA16;}
- mode.InitMode := @Init800x600x16;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if SearchVESAModes(m800x600x256) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m800x600x256;
- mode.DriverNumber := VESA;
- mode.ModeName:='800 x 600 VESA';
- mode.MaxColor := 256;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 799;
- mode.MaxY := 599;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA256;
- mode.PutPixel:=PutPixVESA256;
- mode.GetPixel:=GetPixVESA256;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- mode.InitMode := Init800x600x256;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA256;
- mode.PutPixel:=@PutPixVESA256;
- mode.GetPixel:=@GetPixVESA256;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- mode.InitMode := @Init800x600x256;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if SearchVESAModes(m800x600x32k) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m800x600x32k;
- mode.DriverNumber := VESA;
- mode.ModeName:='800 x 600 VESA';
- mode.MaxColor := 32768;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := TRUE;
- mode.MaxX := 799;
- mode.MaxY := 599;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA32k;
- mode.PutPixel:=PutPixVESA32k;
- mode.GetPixel:=GetPixVESA32k;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- mode.InitMode := Init800x600x32k;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA32k;
- mode.PutPixel:=@PutPixVESA32k;
- mode.GetPixel:=@GetPixVESA32k;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- mode.InitMode := @Init800x600x32k;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if SearchVESAModes(m800x600x64k) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m800x600x16;
- mode.DriverNumber := VESA;
- mode.ModeName:='800 x 600 VESA';
- mode.MaxColor := 65536;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := TRUE;
- mode.MaxX := 799;
- mode.MaxY := 599;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA64k;
- mode.PutPixel:=PutPixVESA64k;
- mode.GetPixel:=GetPixVESA64k;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- mode.InitMode := Init800x600x64k;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA64k;
- mode.PutPixel:=@PutPixVESA64k;
- mode.GetPixel:=@GetPixVESA64k;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- mode.InitMode := @Init800x600x64k;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if SearchVESAModes(m1024x768x16) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m1024x768x16;
- mode.DriverNumber := VESA;
- mode.ModeName:='1024 x 768 VESA';
- mode.MaxColor := 16;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 1023;
- mode.MaxY := 767;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA16;
- mode.PutPixel:=PutPixVESA16;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- { mode.GetPixel:=GetPixVESA16;}
- mode.InitMode := Init1024x768x16;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA16;
- mode.PutPixel:=@PutPixVESA16;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- { mode.GetPixel:=@GetPixVESA16;}
- mode.InitMode := @Init1024x768x16;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if SearchVESAModes(m1024x768x256) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m1024x768x256;
- mode.DriverNumber := VESA;
- mode.ModeName:='1024 x 768 VESA';
- mode.MaxColor := 256;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 1023;
- mode.MaxY := 767;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA256;
- mode.PutPixel:=PutPixVESA256;
- mode.GetPixel:=GetPixVESA256;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- mode.InitMode := Init1024x768x256;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA256;
- mode.PutPixel:=@PutPixVESA256;
- mode.GetPixel:=@GetPixVESA256;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- mode.InitMode := @Init1024x768x256;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if SearchVESAModes(m1024x768x32k) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m1024x768x32k;
- mode.DriverNumber := VESA;
- mode.ModeName:='1024 x 768 VESA';
- mode.MaxColor := 32768;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := TRUE;
- mode.MaxX := 1023;
- mode.MaxY := 767;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA32k;
- mode.PutPixel:=PutPixVESA32k;
- mode.GetPixel:=GetPixVESA32k;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- mode.InitMode := Init640x480x32k;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA32k;
- mode.PutPixel:=@PutPixVESA32k;
- mode.GetPixel:=@GetPixVESA32k;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- mode.InitMode := @Init640x480x32k;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if SearchVESAModes(m1024x768x64k) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m1024x768x64k;
- mode.DriverNumber := VESA;
- mode.ModeName:='1024 x 768 VESA';
- mode.MaxColor := 65536;
- mode.DirectColor := TRUE;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.PaletteSize := mode.MaxColor;
- mode.MaxX := 1023;
- mode.MaxY := 767;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA64k;
- mode.PutPixel:=PutPixVESA64k;
- mode.GetPixel:=GetPixVESA64k;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- mode.InitMode := Init1024x768x64k;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA64k;
- mode.PutPixel:=@PutPixVESA64k;
- mode.GetPixel:=@GetPixVESA64k;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- mode.InitMode := @Init1024x768x64k;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if SearchVESAModes(m1280x1024x16) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m1280x1024x16;
- mode.DriverNumber := VESA;
- mode.ModeName:='1280 x 1024 VESA';
- mode.MaxColor := 16;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.DirectColor := FALSE;
- mode.PaletteSize := mode.MaxColor;
- mode.MaxX := 1279;
- mode.MaxY := 1023;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA16;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- mode.PutPixel:=PutPixVESA16;
- { mode.GetPixel:=GetPixVESA16;}
- mode.InitMode := Init1280x1024x16;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA16;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- mode.PutPixel:=@PutPixVESA16;
- { mode.GetPixel:=@GetPixVESA16;}
- mode.InitMode := @Init1280x1024x16;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if SearchVESAModes(m1280x1024x256) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m1280x1024x256;
- mode.DriverNumber := VESA;
- mode.ModeName:='1280 x 1024 VESA';
- mode.MaxColor := 256;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.DirectColor := FALSE;
- mode.PaletteSize := mode.MaxColor;
- mode.MaxX := 1279;
- mode.MaxY := 1023;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA256;
- mode.PutPixel:=PutPixVESA256;
- mode.GetPixel:=GetPixVESA256;
- mode.InitMode := Init1280x1024x256;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA256;
- mode.PutPixel:=@PutPixVESA256;
- mode.GetPixel:=@GetPixVESA256;
- mode.InitMode := @Init1280x1024x256;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if SearchVESAModes(m1280x1024x32k) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m1280x1024x32k;
- mode.DriverNumber := VESA;
- mode.ModeName:='1280 x 1024 VESA';
- mode.MaxColor := 32768;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.DirectColor := TRUE;
- mode.PaletteSize := mode.MaxColor;
- mode.MaxX := 1279;
- mode.MaxY := 1023;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA32k;
- mode.PutPixel:=PutPixVESA32k;
- mode.GetPixel:=GetPixVESA32k;
- mode.InitMode := Init1280x1024x32k;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA32k;
- mode.PutPixel:=@PutPixVESA32k;
- mode.GetPixel:=@GetPixVESA32k;
- mode.InitMode := @Init1280x1024x32k;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if SearchVESAModes(m1280x1024x64k) then
- begin
- InitMode(mode);
- mode.ModeNumber:=m1280x1024x64k;
- mode.DriverNumber := VESA;
- mode.ModeName:='1280 x 1024 VESA';
- mode.MaxColor := 65536;
- { the ModeInfo is automatically set if the mode is supported }
- { by the call to SearchVESAMode. }
- mode.HardwarePages := ModeInfo.NumberOfPages;
- mode.DirectColor := TRUE;
- mode.PaletteSize := mode.MaxColor;
- mode.MaxX := 1279;
- mode.MaxY := 1023;
- {$ifndef fpc}
- mode.DirectPutPixel:=DirectPutPixVESA64k;
- mode.PutPixel:=PutPixVESA64k;
- mode.GetPixel:=GetPixVESA64k;
- mode.InitMode := Init1280x1024x64k;
- mode.SetRGBPalette := SetVESARGBPalette;
- mode.GetRGBPalette := GetVESARGBPalette;
- mode.SetVisualPage := SetVisualVESA;
- mode.SetActivePage := SetActiveVESA;
- {$else fpc}
- mode.DirectPutPixel:=@DirectPutPixVESA64k;
- mode.PutPixel:=@PutPixVESA64k;
- mode.GetPixel:=@GetPixVESA64k;
- mode.InitMode := @Init1280x1024x64k;
- mode.SetRGBPalette := @SetVESARGBPalette;
- mode.GetRGBPalette := @GetVESARGBPalette;
- mode.SetVisualPage := @SetVisualVESA;
- mode.SetActivePage := @SetActiveVESA;
- {$endif fpc}
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- end;
- end;
- {
- $Log$
- Revision 1.6 1999-07-14 18:16:23 florian
- * HLine16 and VLine16 implemented
- Revision 1.5 1999/07/14 14:32:12 florian
- * small VGA detection problem solved
- Revision 1.4 1999/07/12 13:27:08 jonas
- + added Log and Id tags
- * added first FPC support, only VGA works to some extend for now
- * use -dasmgraph to use assembler routines, otherwise Pascal
- equivalents are used
- * use -dsupportVESA to support VESA (crashes under FPC for now)
- * only dispose vesainfo at closegrph if a vesa card was detected
- * changed int32 to longint (int32 is not declared under FPC)
- * changed the declaration of almost every procedure in graph.inc to
- "far;" becquse otherwise you can't assign them to procvars under TP
- real mode (but unexplainable "data segnment too large" errors prevent
- it from working under real mode anyway)
- }
|