{ GRAPHX.PAS Copyright (c) Ales Kucik } { Unit pro praci s grafickym rezimem v Pascalu. } { } { Datum:29.11.2002 http://www.trsek.com } unit GraphX; {$G+} interface const VGA=$a000; type tVirtual = array [1..64000] of byte; tpal=array [0..255,0..2] of byte; bod3D=record x,y,z:integer; end; bod2D=record x,y:integer; end; procedure SetVGA; procedure SetText; procedure Cls (col:byte; where:word); procedure PutPixel (x,y :integer; col:byte; where:word); procedure Flip (source,dest:word); procedure SetPal(col,r,g,b:byte); procedure GetPal(col:byte;var r,g,b:byte); procedure getVGApal(var pal:tpal); procedure setVGApal(pal: tpal); function BIOSFont:pointer; procedure XYText(const font: pointer;const x,y:word; const col:byte;const s:string; where:word); procedure XYTextB(font:pointer; x,y:word; color:byte; s:string; where:word); procedure WaitRetrace; procedure LineH(x,y,d:integer; col:byte; where:word); procedure LineV(x,y,d:integer; col:byte; where:word); procedure Line(a,b,c,d:integer; col:byte; where:word); procedure Pixel3D(var a,b:integer; x,y,z:integer); implementation procedure SetVGA; assembler; asm mov ax,0013h int 10h end; procedure SetText; assembler; asm mov ax,0003h int 10h end; procedure Cls; assembler; asm push es mov cx, 32000; mov es,[where]; xor di,di mov al,[col] mov ah,al rep stosw pop es end; procedure PutPixel; assembler; asm mov ax,[where] mov es,ax mov bx,[x] mov dx,[y] mov di,bx mov bx,dx shl bx,8 shl dx,6 add dx,bx add di,dx mov al,[col] stosb end; procedure Flip; assembler; asm push ds mov ax, [Dest] mov es, ax mov ax, [Source] mov ds, ax xor si, si xor di, di mov cx, 32000 rep movsw pop ds end; procedure SetPal; assembler; asm mov dx,3c8h mov al,[col] out dx,al inc dx mov al,[r] out dx,al mov al,[g] out dx,al mov al,[b] out dx,al end; procedure GetPal; begin port[$3c7]:= col; r:= port[$3c9]; g:= port[$3c9]; b:= port[$3c9]; end; procedure getVGApal; var loop:byte; begin for loop:=0 to 255 do getpal(loop,pal[loop,0],pal[loop,1],pal[loop,2]); end; procedure setVGApal; var loop:byte; begin for loop:=0 to 255 do setpal(loop,pal[loop,0],pal[loop,1],pal[loop,2]); end; function BIOSFont; var font:pointer; begin asm push bp mov ax, 1130h mov bx, 0100h int 10h mov ax, bp pop bp mov word ptr[font], ax mov word ptr[font+2], es end; BIOSFont:=font; end; procedure XYText; assembler; var FirstChar, CharHeight :Byte; CharNr, ScreenPTR :Word; asm push ds mov ax,where { Setup ES:[BX] = X,Y to plot at } mov es,ax mov bx,x mov ax,y xchg ah,al add bx,ax shr ax,2 add bx,ax lds di,font mov dl,[di] { height of font goes into dh } mov CharHeight,dl inc di mov dl,[di] mov FirstChar,dl mov CharNr,0 { Ugh! Character counter, not a very } { good method, but I'm all out of registers :-( } @nextchar: inc CharNr { also skips lengthbyte! } push ds { This I don't like, pushing and popping. } lds si,[S] { But unfortunately I can't seem to find } add si,CharNr { any spare registers? Intel, can you help? } lodsb { load asciivalue into al } pop ds cmp al,0 { check for null-termination } je @exit { exit if end of string } mov ScreenPTR,BX { save bx } mov dh,CharHeight xor ah,ah mov cl,firstchar { firstchar } sub al,cl { al = currentchar - firstchar } mov si,ax { di = scrap register } mul dh { ax * fontheight } add ax,si { ax + characters to skip } lds di,font { This can be omptimized I think (preserve DI) } add di,3 { skip header } add di,ax { Point into structure } mov cl,[di] { get character width } @nextline: mov ch,cl { ch is the height counter. cl is the original. } inc di { .. now points to bitmap } mov dl,[di] { get bitmap byte } @nextpixel: rol dl,1 { rotate bitmap and prepare for next pixel } mov al,dl { mov bitmap into al for manipulation } and al,1 { mask out the correct bit } jz @masked { jump if transperent } mov al,col mov byte ptr es:[bx],al { Set the pixel on the screen } @masked: inc bx { increment X-offset } dec ch { are we done? last byte in character? } jnz @nextpixel { nope, out with another pixel } add bx,320 { Go to next line on the screen } sub bx,cx { X-alignment fixup } dec dh { are we done with the character? } jnz @nextline mov bx,ScreenPTR { restore screen offset and prepare for next character } add bx,cx inc bx { A little gap between the letters, thank you... } jmp @nextchar @exit: pop ds end; procedure XYTextB; assembler; var firstChar: byte; charNr, screenPTR: word; asm push ds mov ax, where {vypocet pocatecni pozice} mov es, ax {es obsahuje segment obrazovky/pameti} mov bx, x mov ax, y xchg ah, al add bx, ax shr ax, 2 add bx, ax {pozice je ulozena v bx} lds di, font mov charNr, 0 mov cl, color {v cl je cislo barvy} @nextchar: inc charNr push ds lds si, [s] add si, charNr lodsb pop ds cmp al, 0 je @exit mov screenPTR, bx {ulozime si bx} mov dh, 8 xor ah, ah mul dh mov si, di add si, ax @nextline: lodsb mov ch, 8 mov dl, al @nextpixel: rol dl, 1 mov al, dl and al, 1 jz @masked mov byte ptr es:[bx], cl @masked: inc bx dec ch jnz @nextpixel add bx, 320 sub bx, 8 dec dh jnz @nextline mov bx, screenPTR add bx, 8 inc bx jmp @nextChar @exit: pop ds end; procedure WaitRetrace; assembler; label l1,l2; asm mov dx,3DAh l1: in al,dx and al,08h jnz l1 l2: in al,dx and al,08h jz l2 end; procedure LineH; var loop:word; begin for loop:=x to d+x do putpixel(loop,y,col,where); end; procedure LineV; var loop:word; begin for loop:=y to y+d do putpixel(x,loop,col,where); end; procedure Line; function sgn(a:real):integer; begin if a>0 then sgn:=1 else if a<0 then sgn:=-1 else sgn:=0; end; var i,s,d1x,d1y,d2x,d2y,u,v,m,n:integer; begin u:= c-a; v:= d-b; d1x:= sgn(u); d1y:= sgn(v); m:= abs(u); n:= abs(v); if not(m>n) then begin d2x:= 0; d2y:= d1y; i:=m; m:=n; n:=i; end else begin d2x:= d1x; d2y:= 0; end; s:= m shr 1; for i:=0 to m do begin putpixel(a,b,col,where); s:= s+n; if not(s