Scaling Bitmaps ีอออออออออออออออออออออออออออออออธ ณ W E L C O M E ณ ณ To the VGA Trainer Program ณ ณ ณ By ณ ณ ณ DENTHOR of ASPHYXIA ณ ณ ณ ิอออออออออออออออออออออออออออออออพ ณ ณ ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤู ณ ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤู --==[ PART 16 ]==-- =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= � Introduction Hi there. This trainer is on the scaling of an arbitrary sized bitmap to screen in two dimensions. The sample program seems to work quite quickly, and the code is document. The scaling procedure is however totally in assembler ... hopefully this won't cause to many problems. EzE has released a trainer! It is on the speeding up of 3D for normal 3D and for virtual worlds. Check it out, it is quite good (even though I get a bit of ribbing in his quote ;-)) It will be in PCGPE ][, to be released shortly. I have set up a mailserver (that doesn't seem to work all the time, but the ones that miss I post manually). It works like this : Send mail to denthor@beastie.cs.und.ac.za with the subject line : request-list ... it will automatically mail you back with a list of subject lines with which you can grab certain files. You will then mail me with the subject line of a specific file and it will send you a uuencoded version of that file automatically. Cool, huh? Remember, no more mail to smith9@batis.bis.und.ac.za, send it all to denthor@beastie.cs.und.ac.za ! Thanks. If you would like to contact me, or the team, there are many ways you can do it : 1) Write a message to Grant Smith/Denthor/Asphyxia in private mail on the ASPHYXIA BBS. 2) Write to : Grant Smith P.O.Box 270 Kloof 3640 Natal South Africa 3) Call me (Grant Smith) at (031) 73 2129 (leave a message if you call during varsity). Call +27-31-73-2129 if you call from outside South Africa. (It's YOUR phone bill ;-)) 4) Write to denthor@beastie.cs.und.ac.za in E-Mail. 5) Write to asphyxia@beastie.cs.und.ac.za to get to all of us at once. NB : If you are a representative of a company or BBS, and want ASPHYXIA to do you a demo, leave mail to me; we can discuss it. NNB : If you have done/attempted a demo, SEND IT TO ME! We are feeling quite lonely and want to meet/help out/exchange code with other demo groups. What do you have to lose? Leave a message here and we can work out how to transfer it. We really want to hear from you! =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= � What is scaling? I think that most of you know this one already, but here goes. Let us say you have a picture (10x10 pixels) and you want to draw it to a different size (say 5x7 pixel), the process of altering the picture to fit into the new size is called scaling. Scaling only works on rectangular areas. With scaling to can easily strech and shrink your bitmaps. =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= � Okay, so how do we code it? Right. The way I am going to do scaling is as follows : For the horizontal area, I am going to calculate a certain step value. I will then trace along the bitmap, adding this step to my position, and placing the nearest pixel on to the screen. Let me explain this simpler ... Let us say I have a 10 pixel wide bitmap. I want to squish it into 5 pixels. Along the bitmap, I would draw every second pixel to screen. In ascii : 1234567890 13579 +--------+ +---+ | | | | | bitmap | | |dest | | | | +--------+ +---+ As you can see, by stepping through every second pixel, I have shrunk the bitmap to a width of 5 pixels. The equation is as follows : step = origionalwidth / wantedwidth; Let us say we have a 100 pixel wide bitmap, which we want to get to 20 pixels. step = 100 / 20 step = 5 If we draw every fifth pixel from the origional bitmap, we have scaled it down correctly! This also works for all values, if step is of type real. We also find the step for the height in the same way. Our horizontal loop is as follows : For loop1:=1 to wantedwidth do BEGIN putpixel (loop1,height,bitmap[round (curpos)],vga); curpos:=curpos+xstep; END; And the vertical loop is much the same. Easy huh? So east in fact, I wrote the procedure in pure assembler for you ;-) ... don't worry, it's commented. In the sample program, instead of using reals I have used fixed point math. Refer to tut 14 if you have any hassles with fixed point, it is fairly straightforward. I also use psuedo 3-d perspective transforms to get the positions smooth... after Tut8, this should be a breeze. There are no new commands in the assembler for you, so you should get by with what you learned in tut7/8 ... whew! A lot of back referencing there ;) We really are building on our knowledge :) =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= � In closing Well, that is about it. As you can see the concept is easy, and in fact fairly obvious, but that didn't stop me from having to sit down with a pencil and a piece of paper a few months ago and puzzle it out ;-) I have a lot of work ahead of me for a while, so this may be the last trainer for a few months ... unless I can find some free time available. So please be patient! [ "Sir! My computer has just gone haywire!" "What?" shouts the CO. "That is a multimilliondollar machine! find out what's wrong! This is a critical time lieutenant!" "Yes sir" The young lieutenant furiously types away at the keyboard, but the machine totally ignores her. "What is going on, soldier?" "I don't know sir! It is just doing totally arbitrary things after it's assigned tasks are completed. In the computer world this is known as Denthorisms." The computer starts to make random beeps, and prints out a payroll program. "Get it working NOW soldier" The lieutenant ignores him, and contines typing. She gets partial control of the system, she can run programs, but the computer is continually running arb tasks in the background. One of the techhies who have gathered behing her suddenly cries "Hey! It's accessing the missile codes! It wants to launch them!" The typing gathers speed, but to no avail. Another techhie says "I could disconnect the computer from the link, but that would take hours! And this thing will have the codes in under five minutes at the speed it's going!" A smile forms on the lieutanants face, and she leans back in her chair. "What the hell are you doing?" yells the CO. "Why have you stopped?" Again ignoring him, the lieutenant instead turns to the techhie. "Go disconnect the machine, I know how to get you the time you need." "How on earth will you do that? The machines going at top speed!" She smiles again, leans forward, types in three letters and hits the carriage return. The computer grinds to a halt. The smile breaks into a grin. "Maybe it _does_ have it's uses after all." ] - Grant Smith 15:30 23-9-94 Byeeeee..... The following are official ASPHYXIA distribution sites : ษออออออออออออออออออออออออออหออออออออออออออออหอออออป บBBS Name บTelephone No. บOpen บ ฬออออออออออออออออออออออออออฮออออออออออออออออฮอออออน บASPHYXIA BBS #1 บ+27-31-765-5312 บALL บ บASPHYXIA BBS #2 บ+27-31-765-6293 บALL บ บC-Spam BBS บ410-531-5886 บALL บ บPOP! บ+27-12-661-1257 บALL บ บSoul Asylum บ+358-0-5055041 บALL บ บWasted Image บ407-838-4525 บALL บ บReckless Life บ351-01-716 67 58บALL บ ศออออออออออออออออออออออออออสออออออออออออออออสอออออผ Leave me mail if you want to become an official Asphyxia BBS distribution site. {$X+} USES crt,gfx2; Type Pallette = Array [0..255,1..3] of byte; VAR virscr2:virtptr; vaddr2:word; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure LoadCELPal (FileName : String; Var Palette : Pallette); { This loads in the pallette of the .CEL file into the variable Palette } Var Fil : file; Begin Assign (Fil, FileName); Reset (Fil, 1); Seek(Fil,32); BlockRead (Fil, Palette, 768); Close (Fil); End; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure Init; VAR loop1,loop2:integer; tpal:pallette; BEGIN getmem (virscr2,sizeof(virscr2^)); vaddr2:=seg(virscr2^); cls (vaddr2,0); cls (vaddr,0); loadcelpal ('to.cel',tpal); for loop1:=0 to 255 do pal (loop1,tpal[loop1,1],tpal[loop1,2],tpal[loop1,3]); loadcel ('to.cel',virscr); for loop1:=0 to 319 do for loop2:=0 to 199 do if getpixel (loop1,loop2,vaddr)=0 then putpixel (loop1,loop2,(loop1+loop2) mod 256,vaddr); END; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure Scale (x,y,w,h,origw,origh,source,dest:word); assembler; { This scales the picture to the size of w and h, and places the result at x , y. Origw and origh are the origional width and height of the bitmap. The bitmap must start at the beginning of a segment, with source being the segment value. The image is placed in screen at dest} VAR jx,jy,depth,temp:word; asm push ds mov ax,source mov ds,ax mov ax,dest mov es,ax mov depth,0 dec h xor dx,dx mov ax,origw shl ax,6 mov bx,w div bx shl ax,2 mov jx,ax { jx:=origw*256/w } xor dx,dx mov ax,origh shl ax,6 mov bx,h div bx shl ax,2 mov jy,ax { jy:=origh*256/h } xor cx,cx @Loop2 : { vertical loop } push cx mov ax,depth add ax,jy mov depth,ax xor dx,dx mov ax,depth shr ax,8 mov bx,origw mul bx mov temp,ax { temp:=depth shr 8*origw;} mov di,y add di,cx mov bx,di shl di,8 shl bx,6 add di,bx add di,x { es:di = dest ... di=(loop1+y)*320+x } mov cx,w xor bx,bx mov dx,jx mov ax,temp @Loop1 : { horizontal loop } mov si,bx shr si,8 add si,ax { ax = temp = start of line } movsb { si=temp+(si shr 8) } add bx,dx dec cx jnz @loop1 { horizontal loop } pop cx inc cx cmp cx,h jl @loop2 { vertical loop } pop ds end; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure Play; VAR x,y,z,loop1:integer; BEGIN z:=114; while keypressed do readkey; Repeat for loop1:=1 to 50 do BEGIN dec (z,2); x:=16 shl 8 div z; y:=10 shl 8 div z; { Perspective transforms ... makes the zoom smoother } cls (vaddr2,0); scale (160-(x shr 1),100-(y shr 1),x,y,320,200,vaddr,vaddr2); flip (vaddr2,vga); END; { Scale towards you } for loop1:=1 to 50 do BEGIN inc (z,2); x:=16 shl 8 div z; y:=10 shl 8 div z; { Perspective transforms ... makes the zoom smoother } cls (vaddr2,0); scale (160-(x shr 1),100-(y shr 1),x,y,320,200,vaddr,vaddr2); flip (vaddr2,vga); END; { Scale away from you } Until keypressed; while keypressed do readkey; END; BEGIN clrscr; writeln ('Hokay! Here is the sixteenth tutorial! This one is on nice fast 2d'); writeln ('scaling, for any size bitmap. Just hit any key and it will scale a'); writeln ('picture up and down. Clipping is NOT performed, so the destination'); writeln ('pic MUST fit in the screen boundaries. In one zoom towards and away'); writeln ('from you there is 100 frames.'); writeln; Writeln ('You can make many nice effects with scaling, this "bouncing" is just'); writeln ('one of them ... go on, amaze everyone with your ingenuity ;-) Also,'); writeln ('why not test your coding mettle, so to speak, by implementing clipping?'); Writeln; writeln ('The routine could greatly be speeded up with 386 extended registers, but'); writeln ('for the sake of compatability I have kept it to 286 code. Also, this'); writeln ('routine isn''t fully optimised .. you may be able to get some speedups'); writeln ('out of it... (probably by moving the finding of DI out of the loop and'); writeln ('just adding a constant for each line ... hint hint) ;)'); writeln; writeln ('The pic was drawn by me for Tut11, I am reusing it because I am at varsity..'); writeln ('without a mouse. :('); writeln; writeln; writeln ('Hit any key to continue ... '); readkey; setupvirtual; setmcga; init; play; settext; shutdown; freemem (virscr2,sizeof(virscr2^)); Writeln ('All done. This concludes the sixteenth sample program in the ASPHYXIA'); Writeln ('Training series. You may reach DENTHOR under the names of GRANT'); Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS.I also occasinally'); Writeln ('RSAProg, comp.lang.pascal and comp.sys.ibm.pc.demos. E-mail me at :'); Writeln (' denthor@beastie.cs.und.ac.za'); Writeln ('The numbers are available in the main text. You may also write to me at:'); Writeln (' Grant Smith'); Writeln (' P.O. Box 270'); Writeln (' Kloof'); Writeln (' 3640'); Writeln (' Natal'); Writeln (' South Africa'); Writeln ('I hope to hear from you soon!'); Writeln; Writeln; Write ('Hit any key to exit ...'); readkey; END. Unit GFX2; INTERFACE USES crt; CONST VGA = $A000; TYPE Virtual = Array [1..64000] of byte; { The size of our Virtual Screen } VirtPtr = ^Virtual; { Pointer to the virtual screen } VAR Virscr : VirtPtr; { Our first Virtual screen } Vaddr : word; { The segment of our virtual screen} Procedure SetMCGA; { This procedure gets you into 320x200x256 mode. } Procedure SetText; { This procedure returns you to text mode. } Procedure Cls (Where:word;Col : Byte); { This clears the screen to the specified color } Procedure SetUpVirtual; { This sets up the memory needed for the virtual screen } Procedure ShutDown; { This frees the memory used by the virtual screen } procedure flip(source,dest:Word); { This copies the entire screen at "source" to destination } Procedure Pal(Col,R,G,B : Byte); { This sets the Red, Green and Blue values of a certain color } Procedure GetPal(Col : Byte; Var R,G,B : Byte); { This gets the Red, Green and Blue values of a certain color } procedure WaitRetrace; { This waits for a vertical retrace to reduce snow on the screen } Procedure Hline (x1,x2,y:word;col:byte;where:word); { This draws a horizontal line from x1 to x2 on line y in color col } Procedure Line(a,b,c,d:integer;col:byte;where:word); { This draws a solid line from a,b to c,d in colour col } Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word); { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4 in color col } Function rad (theta : real) : real; { This calculates the degrees of an angle } Procedure Putpixel (X,Y : Integer; Col : Byte; where:word); { This puts a pixel on the screen by writing directly to memory. } Function Getpixel (X,Y : Integer; where:word) :Byte; { This gets the pixel on the screen by reading directly to memory. } Procedure LoadCEL (FileName : string; ScrPtr : pointer); { This loads the cel 'filename' into the pointer scrptr } IMPLEMENTATION {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure SetMCGA; { This procedure gets you into 320x200x256 mode. } BEGIN asm mov ax,0013h int 10h end; END; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure SetText; { This procedure returns you to text mode. } BEGIN asm mov ax,0003h int 10h end; END; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure Cls (Where:word;Col : Byte); assembler; { This clears the screen to the specified color } asm push es mov cx, 32000; mov es,[where] xor di,di mov al,[col] mov ah,al rep stosw pop es End; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure SetUpVirtual; { This sets up the memory needed for the virtual screen } BEGIN GetMem (VirScr,64000); vaddr := seg (virscr^); END; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure ShutDown; { This frees the memory used by the virtual screen } BEGIN FreeMem (VirScr,64000); END; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} procedure flip(source,dest:Word); assembler; { This copies the entire screen at "source" to destination } 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 Pal(Col,R,G,B : Byte); assembler; { This sets the Red, Green and Blue values of a certain color } 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(Col : Byte; Var R,G,B : Byte); { This gets the Red, Green and Blue values of a certain color } Var rr,gg,bb : Byte; Begin asm mov dx,3c7h mov al,col out dx,al add dx,2 in al,dx mov [rr],al in al,dx mov [gg],al in al,dx mov [bb],al end; r := rr; g := gg; b := bb; end; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} procedure WaitRetrace; assembler; { This waits for a vertical retrace to reduce snow on the screen } 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 Hline (x1,x2,y:word;col:byte;where:word); assembler; { This draws a horizontal line from x1 to x2 on line y in color col } asm mov ax,where mov es,ax mov ax,y mov di,ax shl ax,8 shl di,6 add di,ax add di,x1 mov al,col mov ah,al mov cx,x2 sub cx,x1 shr cx,1 jnc @start stosb @Start : rep stosw end; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure Line(a,b,c,d:integer;col:byte;where:word); { This draws a solid line from a,b to c,d in colour col } function sgn(a:real):integer; begin if a>0 then sgn:=+1; if a<0 then sgn:=-1; if a=0 then 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); d2x:= SGN(u); d2y:= 0; m:= ABS(u); n := ABS(v); IF NOT (M>N) then BEGIN d2x := 0 ; d2y := SGN(v); m := ABS(v); n := ABS(u); END; s := m shr 1; FOR i := 0 TO m DO BEGIN putpixel(a,b,col,where); s := s + n; IF not (smxy then mxy:=y2; if y3mxy then mxy:=y3; { Choose the min y mny and max y mxy } if y4mxy then mxy:=y4; if mny<0 then mny:=0; if mxy>199 then mxy:=199; if mny>199 then exit; if mxy<0 then exit; { Verticle range checking } mul1:=x1-x4; div1:=y1-y4; mul2:=x2-x1; div2:=y2-y1; mul3:=x3-x2; div3:=y3-y2; mul4:=x4-x3; div4:=y4-y3; { Constansts needed for intersection calc } for yc:=mny to mxy do begin mnx:=320; mxx:=-1; if (y4>=yc) or (y1>=yc) then if (y4<=yc) or (y1<=yc) then { Check that yc is between y1 and y4 } if not(y4=y1) then begin x:=(yc-y4)*mul1 div div1+x4; { Point of intersection on x axis } if xmxx then mxx:=x; { Set point as start or end of horiz line } end; if (y1>=yc) or (y2>=yc) then if (y1<=yc) or (y2<=yc) then { Check that yc is between y1 and y2 } if not(y1=y2) then begin x:=(yc-y1)*mul2 div div2+x1; { Point of intersection on x axis } if xmxx then mxx:=x; { Set point as start or end of horiz line } end; if (y2>=yc) or (y3>=yc) then if (y2<=yc) or (y3<=yc) then { Check that yc is between y2 and y3 } if not(y2=y3) then begin x:=(yc-y2)*mul3 div div3+x2; { Point of intersection on x axis } if xmxx then mxx:=x; { Set point as start or end of horiz line } end; if (y3>=yc) or (y4>=yc) then if (y3<=yc) or (y4<=yc) then { Check that yc is between y3 and y4 } if not(y3=y4) then begin x:=(yc-y3)*mul4 div div4+x3; { Point of intersection on x axis } if xmxx then mxx:=x; { Set point as start or end of horiz line } end; if mnx<0 then mnx:=0; if mxx>319 then mxx:=319; { Range checking on horizontal line } if mnx<=mxx then hline (mnx,mxx,yc,color,where); { Draw the horizontal line } end; end; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Function rad (theta : real) : real; { This calculates the degrees of an angle } BEGIN rad := theta * pi / 180 END; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure Putpixel (X,Y : Integer; Col : Byte; where:word); assembler; { This puts a pixel on the screen by writing directly to memory. } Asm mov ax,[where] mov es,ax mov bx,[X] mov dx,[Y] mov di,bx mov bx, dx {; bx = dx} shl dx, 8 shl bx, 6 add dx, bx {; dx = dx + bx (ie y*320)} add di, dx {; finalise location} mov al, [Col] stosb End; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Function Getpixel (X,Y : Integer; where:word):byte; assembler; { This puts a pixel on the screen by writing directly to memory. } Asm mov ax,[where] mov es,ax mov bx,[X] mov dx,[Y] mov di,bx mov bx, dx {; bx = dx} shl dx, 8 shl bx, 6 add dx, bx {; dx = dx + bx (ie y*320)} add di, dx {; finalise location} mov al, es:[di] End; {ฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤ} Procedure LoadCEL (FileName : string; ScrPtr : pointer); { This loads the cel 'filename' into the pointer scrptr } var Fil : file; Buf : array [1..1024] of byte; BlocksRead, Count : word; begin assign (Fil, FileName); reset (Fil, 1); BlockRead (Fil, Buf, 800); { Read and ignore the 800 byte header } Count := 0; BlocksRead := $FFFF; while (not eof (Fil)) and (BlocksRead <> 0) do begin BlockRead (Fil, mem [seg (ScrPtr^): ofs (ScrPtr^) + Count], 1024, BlocksRead); Count := Count + 1024; end; close (Fil); end; BEGIN END.