Program draw beziers curve uses assembler
Delphi & Pascal (česká wiki)
Category: KMP (Club of young programmers)
Author: Ján Benkovič
web: www.tbteacher.host.sk
Program: Bezier.pas
File exe: Bezier.exe
Author: Ján Benkovičweb: www.tbteacher.host.sk
Program: Bezier.pas
File exe: Bezier.exe
Program draw beziers curve uses assembler. Very pretty.
{ BEZIER.PAS } { Program na zobrazenie bezierovych kriviek. } { } { Datum:02.07.1994 http://www.trsek.com } uses crt; { Define Test} { Define Lines} const step=0.01; krokt= 1/10; p = 0.5*0.35; {malo by p> 0.5*0.25} f=14; sirkaw = 200; vyskaw = 200; BerierSt = 4; MaxX2 = 376 div 2; MaxY2 = 282 div 2; stx = 0; sty = 17; const sirka=MaxX2*2; var X1st,X2st,X3st,X4st,Y1st,Y2st,Y3st,Y4st,XSst,YSst:integer; c:char; Xd,Yd,PX1,PX2,PX3,PY1,PY2,PY3:integer; PSeg:word; a:real; tria:byte; PROCEDURE DLine(x1,y1,x2,y2:word; colorka:byte); Assembler; asm {$I-} {$R-} push ds mov ax,PSeg mov ds,ax mov bx,x1 mov ax,y1 mov dx,x2 mov cx,y2 cmp bx,dx {v bx musi byt mensie z x1,x2} jl @Mensie @Vacsie: {ak tam nie je, treba to opravit} xchg bx,dx {treba vymenit bx a dx (x1,x2)} xchg ax,cx {treba vymenit ax a cx (y1,y2)} @Mensie: {Ak je vsechno OK, alebo bolo = x1<x2; y1<y2?} push dx push dx {dx bude pouzite na deltax } push ax mov dx,sirka/4 {ajtak ho to znuluje} mul dx {ax = ax*320 = y1*320} mov dx,bx shr dx,1 shr dx,1 add ax,dx mov di,ax {di := y1*320+x1} @Dal: pop ax {ax = y1} pop dx {dx = x2} sub dx,bx {** dx = deltax := x_koncove(=dx) - x(=bx)} cmp ax,cx {do ax dame abs(ax-cx) preto treba vediet co je vacsie} pushf jg @Vacsie2 @Mensie2: {ax je mensie; y1<y2 => abs(y1-y2) = y2-y1} xchg ax,cx {sub cx,ax; mov ax,cx} @Vacsie2: {y1>y2 => abs(y1-y2) = y1-y2} sub ax,cx cmp dx,ax jl @PodmePoY {** if deltax < deltay then jump } { else Ok } {************************************************************************} { mov si,offset @IncDec+2} popf jg @Vacsie22 @Mensie22: mov word ptr [cs:@IncDec+2], Sirka / 4 {treba prestavit na dec(Y)} jmp @Dalej @Vacsie22: mov word ptr [cs:@IncDec+2], -Sirka / 4 {treba prestavit na dec(Y)} @Dalej: {** v ax je hodnota ax = deltay = abs(y1-y2)} {** v dx je hodnota dx = deltax = abs(x1-x2)} shl ax,1 {** v ax je deltay = zbytocne, preto dame ax=konst1=2*deltay} mov word ptr [cs:@Konst1+2],ax {Ok} sub ax,dx {ax=predikce na chvilu=2*deltay-deltax; pre mna aj zaporne(?)} mov cx,ax {cx=predikce na dlhodlbo=ax} sub ax,dx {ax=konst2, lebo=2*deltay-deltax-deltax=2*(deltay-deltax)} mov word ptr [cs:@Konst2+2],ax {Ok} {opakovanie: V ax = konst2 = zbytocne = uvolnene pre plain(?), ktory pixel} { x1 bx = x1 = mensie x = zvacsovanie} { pr cx = predikce zvacsovanie} { V dx = deltax = treba uvolnit pre porty} { ! di = kam bachnut pixel} mov ah,00010001b mov dx,cx mov cx,bx and cx,00000011b shl ah,cl mov cx,dx pop si { x2 si = x2 = vacsie x} mov al,02h mov dx,03c4h out dx,ax mov al,colorka mov byte ptr [ds:di],al push bp {hlavny cyklus} @Hlavny: cmp bx,si je @DostBolo shl ah,1 jnc @Rotuj mov ah,00010001b inc di {incni di ak prerotoval plainsy} @Rotuj: inc bx test cx,1000000000000000b {if predikce<0 } jz @Vacsie3 {if not je = preco by jedla = 0 = nie je = je tam 0} @Konst1: add cx,1234h {predikce:=predikce+konst1 => konst1 sa meni-modifikuje} jmp @Pixelaz @Vacsie3: @IncDec: db 81h,0C7h {add di,...} dw Sirka/4 {modifikovany 320 ak od 0 na vacsie=4 a 8 qvdr.; -320 ak z vacsieho mensie 0,0 je vlavo hore} @Konst2: add cx,1234h {predikce:=predikce+konst2 => konst2 sa meni-modifikuje} @Pixelaz: mov bp,ax mov al,02h out dx,ax mov ax,bp mov byte ptr [ds:di],al jmp @Hlavny @DostBolo: pop bp pop ds jmp @ShitPascalRet {**************************************************************************} @PodmePoY: popf jle @JeMensi @JeVacsi: {ide zdola hore do ax, ktore je vacsie} add ax,cx {ax = y1-y2 +y2 = y1} xchg ax,cx {vymen y1,y2} push dx push ax {treba zmenit aj di, huraaa v bx je x2} add bx,dx {v dx je roziel => x1+(x2-x1)=x2} mov si,bx {x1} mov dx,Sirka/4 {ajtak ho to znuluje} mul dx {ax = ax*320 = y1*320} mov dx,bx shr dx,1 shr dx,1 add ax,dx mov di,ax {di := y1*320+x1} pop ax pop dx mov word ptr [cs:@ShiftY],0ECD0h {treba prestavit na shr ah,1} mov byte ptr [cs:@MaskaY+1],10001000b {treba prestavit na shr di,1} mov byte ptr [cs:@IncDecY],4Fh {treba prestavit inc di} jmp @Dalejsi @JeMensi: {ciara ide zhora dole od 0, +320 preto ide doprava, hore sort} add ax,cx {ax = y1-y2 +y2 = y1} xchg ax,cx mov si,bx mov word ptr [cs:@ShiftY],0E4D0h {treba prestavit na shr ah,1} mov byte ptr [cs:@MaskaY+1],00010001b {treba prestavit na shr di,1} mov byte ptr [cs:@IncDecY],47h {treba prestavit inc di} @Dalejsi: pop bx {treba popnut x2 ..., (bx je nedolezite bolo tam x1)} push cx {a dat tam y2 => pojde do si, do vacsieho } mov bx,ax {bx - od neho sa pojde, +320 ... az do <-\- push cx do cx=y2} {povodna rutinka:} sub ax,cx {do ax treba dat cx-ax = -(ax-cx)} neg ax {** v ax je hodnota ax = deltay = abs(y1-y2)} {** v dx je hodnota dx = deltax = abs(x1-x2)} shl dx,1 {** v dx je deltax = zbytocne, preto dame dx=konst1=2*deltax} mov word ptr [cs:@Konst1Y+2],dx {Ok} sub dx,ax {dx=predikce na chvilu=2*deltax-deltay; pre mna aj zaporne(?)} mov cx,dx {cx=predikce na dlhodlbo=dx} sub dx,ax {dx=konst2, lebo=2*deltax-deltay -deltay=2*(deltax-deltay)} mov word ptr [cs:@Konst2Y+2],dx {Ok} {opakovanie: V ax = deltax = zbytocne = uvolnene pre plain(?), ktory pixel} { x1 bx = y1 = mensie y = zvacsovanie} { pr cx = predikce zvacsovanie} { V dx = konst2 = zbytocne = treba uvolnit pre porty} { ! di = kam bachnut pixel} mov ah,00010001b mov dx,cx mov cx,si and cx,00000011b shl ah,cl {zisti masku plainsy} mov cx,dx pop si { y2 si = y2 = vacsie y} mov dx,03c4h mov al,02h out dx,ax mov al,colorka mov [ds:di],al push bp {hlavny cyklus} @HlavnyY: cmp bx,si je @DostBoloY inc bx add di,Sirka /4 test cx,1000000000000000b {if predikce<0 } jz @Vacsie3Y {if not je = preco by jedla = 0 = nie je = je tam 0} @Konst1Y: add cx,1234h {predikce:=predikce+konst1 => konst1 sa meni-modifikuje} jmp @PixelazY @Vacsie3Y: @ShiftY: shl ah,1 jnc @Konst2Y @MaskaY: mov ah,00010001b @IncDecY: inc di {add di,1234h modifikovany 1 ak od 0 na vacsie; -1 ak z vacsieho mensie 0,0 je vlavo hore} @Konst2Y: add cx,1234h {predikce:=predikce+konst2 => konst2 sa meni-modifikuje} @PixelazY: mov bp,ax mov al,02h out dx,ax mov ax,bp mov byte ptr [ds:di],al jmp @HlavnyY @DostBoloY: pop bp pop ds @ShitPascalRet: {$I+} {$R+} end; PROCEDURE XMode; Assembler; asm push bp push ds mov dx, 0a000h mov es, dx xor di, di xor ax, ax mov cx, 8000h rep stosw mov ax,cs mov ds,ax mov ax,13h int 10h mov dx,3c4h mov ax,2101h out dx,ax mov dx,03c4h mov ax,0604h out dx,ax { disable chain4 mode } mov ax,0100h out dx,ax { synchronous reset while setting Misc } { Output for safety, even though clock } { unchanged } mov si,offset @X376Y282 lodsb mov dx,03c2h out dx,al { select the dot clock and Horiz } { scanning rate } mov dx,03c4h mov ax,0300h out dx,ax { undo reset (restart sequencer) } mov dx,03d4h { reprogram the CRT Controller } mov al,11h { VSync End reg contains register write } out dx,al { protect bit } inc dx { CRT Controller Data register } in al,dx { get current VSync End register setting} and al,07fh { remove write protect on various } out dx,al { CRTC registers } dec dx { CRT Controller Index } cld xor ch,ch lodsb mov cl,al @@SetCRTParmsLoop: lodsw { get the next CRT Index/Data pair } out dx,ax { set the next CRT Index/Data pair } loop @@SetCRTParmsLoop { clear all of display memory } mov dx,03c4h mov ax,0f02h out dx,ax { enable writes to all four planes } mov ax,0a000h { now clear all display memory, 8 pixels} mov es,ax { at a time } xor di,di { point ES:DI to display memory } xor ax,ax { clear to zero-value pixels } mov cx,8000h { # of words in display memory } rep stosw mov dx,3c4h mov ax,0101h out dx,ax pop ds pop bp ret @X376Y282: db 0e7h db 18 dw 06e00h { horz total } dw 05d01h { horz displayed } dw 05e02h { start horz blanking } dw 09103h { end horz blanking } dw 06204h { start h sync } dw 08f05h { {nd h sync } dw 06206h { vertical total } dw 0f007h { overflow } dw 06109h { cell height } dw 0310fh { } dw 03710h { v sync start } dw 08911h { v sync end and protect cr0-cr7} dw 03312h { vertical displayed } dw 02f13h { offset } dw 00014h { turn off dword mode } dw 03c15h { v blank start } dw 05c16h { v blank end } dw 0e317h { turn on byte mode } @X360Y480: DB 0e7h DB 17 DW 06b00h { horz total } DW 05901h { horz displayed } DW 05a02h { start horz blanking } DW 08e03h { end horz blanking } DW 05e04h { start h sync } DW 08a05h { end h sync } DW 00d06h { vertical total } DW 03e07h { overflow } DW 04009h { cell height } DW 0ea10h { v sync start } DW 0ac11h { v sync end and protect cr0-cr7} DW 0df12h { vertical displayed } DW 02d13h { offset } DW 00014h { turn off DWord mode } DW 0e715h { v blank start } DW 00616h { v blank end } DW 0e317h { turn on byte mode } end; PROCEDURE XMode2; assembler; asm mov ax, 2101h mov dx, 3c4h out dx, ax mov ax, 13h int 10h mov dx, 3c4h mov ax, 604h {spristupnenie nad 64k image memory} out dx, ax mov ax, 0f02h {zapis do 00001111 = vsetkych bit plains} out dx, ax mov dx, 0a000h mov es, dx xor di, di xor ax, ax mov cx, 8000h rep stosw {vynulovanie pamate 4 plainsy} mov dx, 3d4h mov ax, 14h {0014h } out dx, ax mov ax, 0e317h out dx, ax { potialto} mov ax, 2813h out dx, ax mov ax, 0109h out dx, ax end; PROCEDURE PutPixel(x,y,color:integer); assembler; asm mov ax,PSeg mov es,ax mov dx,03c4h mov cx,x and cx,00000011b mov ah,1 shl ah,cl mov al,02 out dx,ax mov ax,y mov cx,Sirka/4 mul cx mov di,ax mov ax,x shr ax,1 shr ax,1 add di,ax mov ax,color stosb end; PROCEDURE Berier(X1,Y1,X2,Y2,X3,Y3:integer;st:integer); begin if st=0 then begin {$IfDef Lines} DLine(X1 shr 1+(X1 and 1),Y1 shr 1+(Y1 and 1),X3 shr 1+(X3 and 1),Y3 shr 1+(Y3 and 1),f); {$Else} PutPixel(X1 shr 1+(X1 and 1),Y1 shr 1+(Y1 and 1),f); PutPixel(X3 shr 1+(X3 and 1),Y3 shr 1+(Y3 and 1),f); {$EndIf} exit; end; PX1:=((((X1+X3) shr 1)+X2) shr 1); PX1:=PX1 shr 1+(PX1 and 1); PY1:=((((Y1+Y3) shr 1)+Y2) shr 1); PY1:=PY1 shr 1+(PY1 and 1); PutPixel(PX1,PY1,f); PX1:=X1; PY1:=Y1; PX2:=(X1+X2) shr 1; PY2:=(Y1+Y2) shr 1; PX3:=((((X1+X3) shr 1)+X2) shr 1); PY3:=((((Y1+Y3) shr 1)+Y2) shr 1); Berier(PX1,PY1,PX2,PY2,PX3,PY3,st-1); PX1:=((((X1+X3) shr 1)+X2) shr 1); PY1:=((((Y1+Y3) shr 1)+Y2) shr 1); PX2:=(X2+X3) shr 1; PY2:=(Y2+Y3) shr 1; PX3:=X3; PY3:=Y3; Berier(PX1,PY1,PX2,PY2,PX3,PY3,st-1); end; PROCEDURE Bezier(X1,Y1,X2,Y2,X3,Y3:integer); var t:real; X,Y:integer; begin t:=0; repeat X:=round(X1+t*(2*X2-2*X1)+t*t*(X1+X3-2*X2)); Y:=round(Y1+t*(2*Y2-2*Y1)+t*t*(Y1+Y3-2*Y2)); PutPixel(X,Y,15); t:=t+step; until t>=1; end; PROCEDURE Triangel(X1z,Y1z,X2z,Y2z,X3z,Y3z:integer); var XN,YN,X1,X2,X3,Y1,Y2,Y3,Xd1,Yd1,Xd2,Yd2:integer; X1p,X2p,X3p,Y1p,Y2p,Y3p:integer; X1p2,X2p2,X3p2,Y1p2,Y2p2,Y3p2:integer; X,Y:integer; c:char; t2:real; begin X1:=X1z; X2:=X2z; X3:=X3z; Y1:=Y1z; Y2:=Y2z; Y3:=Y3z; Xd1:=X2; Yd1:=Y2; Xd2:=(X1+X3) div 2; Yd2:=(Y1+Y3) div 2; {$IfDef AllLines} Line(X1,Y1,round(Xd2+(Xd1-Xd2)*1),round(Yd2+(Yd1-Yd2)*1)); Line(round(Xd2+(Xd1-Xd2)*1),round(Yd2+(Yd1-Yd2)*1),X3,Y3); Line(Xd1,Yd1,Xd2,Yd2); {$EndIf} DLine(X1,Y1,X3,Y3,15); X1p:=X1; X3p:=X3; Y1p:=Y1; Y3p:=Y3; t2:=krokt; { X2p:=round(Xd2+(Xd1-Xd2)*t2); Y2p:=round(Yd2+(Yd1-Yd2)*t2); } X2p:=round( (X1p+X3p)/2 + 2*((Xd1-Xd2)*t2-((X1p+X3p)/2-Xd2))); Y2p:=round( (Y1p+Y3p)/2 + 2*((Yd1-Yd2)*t2-((Y1p+Y3p)/2-Yd2))); while t2-krokt<=1 do begin {$IfDef Test} if tria=1 then asm mov dx,03c0h mov al,11h+32 out dx,al mov al,12 out dx,al End; {$EndIf} Berier(X1p shl 1,Y1p shl 1,X2p shl 1,Y2p shl 1,X3p shl 1,Y3p shl 1,BerierSt); {Bezier(X1p,Y1p,X2p,Y2p,X3p,Y3p);} {$IfDef Test} if tria=1 then asm mov dx,03c0h mov al,11h+32 out dx,al mov al,15 out dx,al End; {$EndIf} t2:=t2+krokt; X1p2:=round(X1p+p*(2*X2p-2*X1p)+p*p*(X1p+X3p-2*X2p)); Y1p2:=round(Y1p+p*(2*Y2p-2*Y1p)+p*p*(Y1p+Y3p-2*Y2p)); X3p2:=round(X1p+(1-p)*(2*X2p-2*X1p)+(1-p)*(1-p)*(X1p+X3p-2*X2p)); Y3p2:=round(Y1p+(1-p)*(2*Y2p-2*Y1p)+(1-p)*(1-p)*(Y1p+Y3p-2*Y2p)); X2p2:=round( (X1p2+X3p2)/2 + 2*((Xd1-Xd2)*t2-((X1p2+X3p2)/2-Xd2))); Y2p2:=round( (Y1p2+Y3p2)/2 + 2*((Yd1-Yd2)*t2-((Y1p2+Y3p2)/2-Yd2))); X1p:=X1p2; X2p:=X2p2; X3p:=X3p2; Y1p:=Y1p2; Y2p:=Y2p2; Y3p:=Y3p2; end; end; { 4 --- 3 | | | | 1 --- 2 } begin XMode; randomize; X1st:=Maxx2-sirkaw div 2; X2st:=X1st+sirkaw; X3st:=X2st; X4st:=X1st; Y3st:=Maxy2-vyskaw div 2; Y4st:=Y3st; Y1st:=Y3st+vyskaw; Y2st:=Y1st; XSSt:=X1st+random(round((X2st-X1st)*0.3))+round((X2st-X1st)*((1-0.3)/2)); YSSt:=Y4st+random(round((Y1st-Y3st)*0.3))+round((Y1st-Y3st)*((1-0.3)/2)); PSeg:=$0a000; Yd:=round((X2st-X1st)*0.25); Xd:=+stx; {Yd:=+sty;} a:=0; repeat asm mov cx,PSeg and cx,$0fff shl cx,1 shl cx,1 shl cx,1 shl cx,1 mov dx,3d4h mov al,0ch mov ah,ch out dx,ax mov al,0dh mov ah,cl out dx,ax mov dx,03dah @Retrace: in al,dx test al,08h jnz @Retrace @NoRetrace: in al,dx test al,08h jz @NoRetrace end; PSeg:=PSeg xor $800; asm mov dx,03c4h mov ax,0f02h out dx,ax { enable writes to all four planes } mov ax,PSeg { now clear all display memory, 8 pixels} mov es,ax { at a time } xor di,di { point ES:DI to display memory } xor ax,ax { clear to zero-value pixels } mov cx,3500h { # of words in display memory } rep stosw end; XSSt:=(X1st+X2st) shr 1 + round(cos(a)*Yd); YSSt:=(Y1st+Y3st) shr 1 + round(sin(a)*Yd); Yd:=Yd+Xd; If Yd>=(X2st-X1st)*0.25 then Xd:=-stx; if Yd<=Xd then Xd:=stx; a:=a+2*pi/30; { XSSt:=XSSt+Xd; YSSt:=YSSt+Yd; If XSSt<=X1st+round((X2st-X1st)*((1-0.5)/2)) then Xd:=stx; If YSSt<=Y4st+round((Y1st-Y3st)*((1-0.5)/2)) then Yd:=sty; If XSSt>=X1st+round((X2st-X1st)*0.5)+round((X2st-X1st)*((1-0.5)/2)) then Xd:=-stx; If YSSt>=Y4st+round((Y1st-Y3st)*0.5)+round((Y1st-Y3st)*((1-0.5)/2)) then Yd:=-sty; } tria:=1; {$IfDef Test} asm mov dx,03dah @Retrace: in al,dx test al,08h jz @Retrace @NoRetrace: in al,dx test al,08h jnz @NoRetrace mov dx,03c0h mov al,11h+32 out dx,al mov al,15 out dx,al End; {$EndIf} Triangel(X1st,Y1st,XSst,YSst,X2st,Y2st); {$IfDef Test} asm mov dx,03c0h mov al,11h+32 out dx,al mov al,0 out dx,al End; tria:=0; {$EndIf} Triangel(X2st,Y2st,XSst,YSst,X3st,Y3st); Triangel(X3st,Y3st,XSst,YSst,X4st,Y4st); Triangel(X4st,Y4st,XSst,YSst,X1st,Y1st); until keypressed; c:=readkey; end.