16/PCGPE10/TUT3.TXT

   1                    ÕÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¸\r
   2                    ³         W E L C O M E         ³\r
   3                    ³  To the VGA Trainer Program   ³ ³\r
   4                    ³              By               ³ ³\r
   5                    ³      DENTHOR of ASPHYXIA      ³ ³ ³\r
   6                    ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¾ ³ ³\r
   7                      ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³\r
   8                        ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ\r
   9 \r
  10                            --==[ PART 3 ]==--\r
  11 \r
  12 \r
  13 \r
  14 þ Introduction\r
  15 \r
  16 \r
  17 \r
  18 Greetings! This is the third part of the VGA Trainer series! Sorry it \r
  19 took so long to get out, but I had a running battle with the traffic\r
  20 department for three days to get my car registered, and then the MailBox\r
  21 went down. Ahh, well, life stinks. Anyway, today will do some things\r
  22 vital to most programs : Lines and circles.\r
  23 \r
  24 Watch out for next week's part : Virtual screens. The easy way to\r
  25 eliminate flicker, "doubled sprites", and subjecting the user to watch\r
  26 you building your screen. Almost every ASPHYXIA demo has used a virtual\r
  27 screen (with the exception of the SilkyDemo), so this is one to watch out\r
  28 for. I will also show you how to put all of these loose procedures into\r
  29 units.\r
  30 \r
  31 If you would like to contact me, or the team, there are many ways you \r
  32 can do it : 1) Write a message to Grant Smith in private mail here on\r
  33                   the Mailbox BBS.\r
  34             2) Write a message here in the Programming conference here\r
  35                   on the Mailbox (Preferred if you have a general\r
  36                   programming query or problem others would benefit from)\r
  37             3) Write to ASPHYXIA on the ASPHYXIA BBS.\r
  38             4) Write to Denthor, Eze or Livewire on Connectix.\r
  39             5) Write to :  Grant Smith\r
  40                            P.O.Box 270 Kloof\r
  41                            3640\r
  42             6) Call me (Grant Smith) at 73 2129 (leave a message if you \r
  43                   call during varsity)\r
  44                   \r
  45 NB : If you are a representative of a company or BBS, and want ASPHYXIA \r
  46        to do you a demo, leave mail to me; we can discuss it.\r
  47 NNB : If you have done/attempted a demo, SEND IT TO ME! We are feeling\r
  48         quite lonely and want to meet/help out/exchange code with other demo\r
  49         groups. What do you have to lose? Leave a message here and we can work\r
  50         out how to transfer it. We really want to hear from you!\r
  51 \r
  52 \r
  53 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=\r
  54 þ  Circle Algorithim\r
  55 \r
  56 You all know what a circle looks like. But how do you draw one on the\r
  57 computer?\r
  58 \r
  59 You probably know circles drawn with the degrees at these points :\r
  60 \r
  61                                 0\r
  62                               ÜÛ|ÛÜ\r
  63                              ÛÛÛ|ÛÛÛ\r
  64                         270 ----+---- 90\r
  65                              ÛÛÛ|ÛÛÛ\r
  66                               ßÛ|Ûß\r
  67                                180\r
  68 \r
  69 Sorry about my ASCI ;-) ... anyway, Pascal doesn't work that way ... it\r
  70 works with radians instead of degrees. (You can convert radians to degrees,\r
  71 but I'm not going to go into that now. Note though that in pascal, the\r
  72 circle goes like this :\r
  73 \r
  74                                270\r
  75                               ÜÛ|ÛÜ\r
  76                              ÛÛÛ|ÛÛÛ\r
  77                         180 ----+---- 0\r
  78                              ÛÛÛ|ÛÛÛ\r
  79                               ßÛ|Ûß\r
  80                                 90\r
  81 \r
  82 \r
  83 Even so, we can still use the famous equations to draw our circle ...\r
  84 (You derive the following by using the theorem of our good friend\r
  85 Pythagoras)\r
  86                      Sin (deg) = Y/R\r
  87                      Cos (deg) = X/R\r
  88 (This is standard 8(?) maths ... if you haven't reached that level yet,\r
  89 take this to your dad, or if you get stuck leave me a message and I'll\r
  90 do a bit of basic Trig with you. I aim to please ;-))\r
  91 \r
  92 Where Y = your Y-coord\r
  93       X = your X-coord\r
  94       R = your radius (the size of your circle)\r
  95       deg = the degree\r
  96 \r
  97 To simplify matters, we rewrite the equation to get our X and Y values :\r
  98 \r
  99                      Y = R*Sin(deg)\r
 100                      X = R*Cos(deg)\r
 101 \r
 102 This obviousy is perfect for us, because it gives us our X and Y co-ords\r
 103 to put into our putpixel routine (see Part 1). Because the Sin and Cos\r
 104 functions return a Real value, we use a round function to transform it\r
 105 into an Integer.\r
 106 \r
 107      Procedure Circle (oX,oY,rad:integer;Col:Byte);\r
 108      VAR deg:real;\r
 109          X,Y:integer;\r
 110      BEGIN\r
 111        deg:=0;\r
 112        repeat\r
 113          X:=round(rad*COS (deg));\r
 114          Y:=round(rad*sin (deg));\r
 115          putpixel (x+ox,y+oy,Col);\r
 116          deg:=deg+0.005;\r
 117        until (deg>6.4);\r
 118      END;\r
 119 \r
 120 In the above example, the smaller the amount that deg is increased by,\r
 121 the closer the pixels in the circle will be, but the slower the procedure.\r
 122 0.005 seem to be best for the 320x200 screen. NOTE : ASPHYXIA does not use\r
 123 this particular circle algorithm, ours is in assembly language, but this\r
 124 one should be fast enough for most. If it isn't, give us the stuff you are\r
 125 using it for and we'll give you ours.\r
 126 \r
 127 \r
 128 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=\r
 129 þ  Line algorithms\r
 130 \r
 131 There are many ways to draw a line on the computer. I will describe one\r
 132 and give you two. (The second one you can figure out for yourselves; it\r
 133 is based on the first one but is faster)\r
 134 \r
 135 The first thing you need to do is pass what you want the line to look\r
 136 like to your line procedure. What I have done is said that x1,y1 is the\r
 137 first point on the screen, and x2,y2 is the second point. We also pass the\r
 138 color to the procedure. (Remember the screens top left hand corner is (0,0);\r
 139 see Part 1)\r
 140 \r
 141 Ie.            o  (X1,Y1)\r
 142                 ooooooooo\r
 143                          ooooooooo\r
 144                                   oooooooo  (X2,Y2)\r
 145 \r
 146 Again, sorry about my drawings ;-)\r
 147 \r
 148 To find the length of the line, we say the following :\r
 149 \r
 150            XLength = ABS (x1-x2)\r
 151            YLength = ABS (y1-y2)\r
 152 \r
 153 The ABS function means that whatever the result, it will give you an\r
 154 absolute, or posotive, answer. At this stage I set a variable stating\r
 155 wheter the difference between the two x's are negative, zero or posotive.\r
 156 (I do the same for the y's) If the difference is zero, I just use a loop\r
 157 keeping the two with the zero difference posotive, then exit.\r
 158 \r
 159 If neither the x's or y's have a zero difference, I calculate the X and Y\r
 160 slopes, using the following two equations :\r
 161 \r
 162            Xslope = Xlength / Ylength\r
 163            Yslope = Ylength / Xlength\r
 164 \r
 165 As you can see, the slopes are real numbers.\r
 166 NOTE : XSlope = 1 / YSlope\r
 167 \r
 168 Now, there are two ways of drawing the lines :\r
 169 \r
 170            X = XSlope * Y\r
 171            Y = YSlope * X\r
 172 \r
 173 The question is, which one to use? if you use the wrong one, your line\r
 174 will look like this :\r
 175 \r
 176         o\r
 177            o\r
 178               o\r
 179 \r
 180 Instead of this :\r
 181 \r
 182         ooo\r
 183            ooo\r
 184               ooo\r
 185 \r
 186 Well, the solution is as follows :\r
 187 \r
 188                            *\``|``/*\r
 189                            ***\|/***\r
 190                            ----+----\r
 191                            ***/|\***\r
 192                            */``|``\*\r
 193 \r
 194 If the slope angle is in the area of the stars (*) then use the first\r
 195 equation, if it is in the other section (`) then use the second one.\r
 196 What you do is you calculate the variable on the left hand side by\r
 197 putting the variable on the right hand side in a loop and solving. Below\r
 198 is our finished line routine :\r
 199 \r
 200 Procedure Line (x1,y1,x2,y2:integer;col:byte);\r
 201 VAR x,y,xlength,ylength,dx,dy:integer;\r
 202     xslope,yslope:real;\r
 203 BEGIN\r
 204   xlength:=abs (x1-x2);\r
 205   if (x1-x2)<0 then dx:=-1;\r
 206   if (x1-x2)=0 then dx:=0;\r
 207   if (x1-x2)>0 then dx:=+1;\r
 208   ylength:=abs (y1-y2);\r
 209   if (y1-y2)<0 then dy:=-1;\r
 210   if (y1-y2)=0 then dy:=0;\r
 211   if (y1-y2)>0 then dy:=+1;\r
 212   if (dy=0) then BEGIN\r
 213     if dx<0 then for x:=x1 to x2 do\r
 214       putpixel (x,y1,col);\r
 215     if dx>0 then for x:=x2 to x1 do\r
 216       putpixel (x,y1,col);\r
 217     exit;\r
 218   END;\r
 219   if (dx=0) then BEGIN\r
 220     if dy<0 then for y:=y1 to y2 do\r
 221       putpixel (x1,y,col);\r
 222     if dy>0 then for y:=y2 to y1 do\r
 223       putpixel (x1,y,col);\r
 224     exit;\r
 225   END;\r
 226   xslope:=xlength/ylength;\r
 227   yslope:=ylength/xlength;\r
 228   if (yslope/xslope<1) and (yslope/xslope>-1) then BEGIN\r
 229     if dx<0 then for x:=x1 to x2 do BEGIN\r
 230                    y:= round (yslope*x);\r
 231                    putpixel (x,y,col);\r
 232                  END;\r
 233     if dx>0 then for x:=x2 to x1 do BEGIN\r
 234                    y:= round (yslope*x);\r
 235                    putpixel (x,y,col);\r
 236                  END;\r
 237   END\r
 238   ELSE\r
 239   BEGIN\r
 240     if dy<0 then for y:=y1 to y2 do BEGIN\r
 241                    x:= round (xslope*y);\r
 242                    putpixel (x,y,col);\r
 243                  END;\r
 244     if dy>0 then for y:=y2 to y1 do BEGIN\r
 245                    x:= round (xslope*y);\r
 246                    putpixel (x,y,col);\r
 247                  END;\r
 248   END;\r
 249 END;\r
 250 \r
 251 Quite big, isn't it? Here is a much shorter way of doing much the same\r
 252 thing :\r
 253 \r
 254 function sgn(a:real):integer;\r
 255 begin\r
 256      if a>0 then sgn:=+1;\r
 257      if a<0 then sgn:=-1;\r
 258      if a=0 then sgn:=0;\r
 259 end;\r
 260 \r
 261 procedure line(a,b,c,d,col:integer);\r
 262 var u,s,v,d1x,d1y,d2x,d2y,m,n:real;\r
 263     i:integer;\r
 264 begin\r
 265      u:= c - a;\r
 266      v:= d - b;\r
 267      d1x:= SGN(u);\r
 268      d1y:= SGN(v);\r
 269      d2x:= SGN(u);\r
 270      d2y:= 0;\r
 271      m:= ABS(u);\r
 272      n := ABS(v);\r
 273      IF NOT (M>N) then\r
 274      BEGIN\r
 275           d2x := 0 ;\r
 276           d2y := SGN(v);\r
 277           m := ABS(v);\r
 278           n := ABS(u);\r
 279      END;\r
 280      s := INT(m / 2);\r
 281      FOR i := 0 TO round(m) DO\r
 282      BEGIN\r
 283           putpixel(a,b,col);\r
 284           s := s + n;\r
 285           IF not (s<m) THEN\r
 286           BEGIN\r
 287                s := s - m;\r
 288                a:= a +round(d1x);\r
 289                b := b + round(d1y);\r
 290           END\r
 291           ELSE\r
 292           BEGIN\r
 293                a := a + round(d2x);\r
 294                b := b + round(d2y);\r
 295           END;\r
 296      end;\r
 297 END;\r
 298 \r
 299 This routine is very fast, and should meet almost all of your requirements\r
 300 (ASPHYXIA used it for quite a while before we made our new one.)\r
 301 In the end program, both the new line routine and the circle routine are\r
 302 tested. A few of the procedures of the first parts are also used.\r
 303 \r
 304 Line and circle routines may seem like fairly trivial things, but they are\r
 305 a vital component of many programs, and you may like to look up other\r
 306 methods of drawing them in books in the library (I know that here at the\r
 307 varsity they have books for doing this kind of stuff all over the place)\r
 308 A good line routine to look out for is the Bressenhams line routine ...\r
 309 there is a Bressenhams circle routine too ... I have documentaiton for them\r
 310 if anybody is interested, they are by far some of the fastest routines\r
 311 you will use.\r
 312 \r
 313 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=\r
 314 þ  In closing\r
 315 \r
 316 Varsity has started again, so I am (shock) going to bed before three in\r
 317 the morning, so my quote this week wasn't written in the same wasted way\r
 318 my last weeks one was (For last week's one, I had gotten 8 hours sleep in\r
 319 3 days, and thought up and wrote the quote at 2:23 am before I fell asleep.)\r
 320 \r
 321         [  "What does it do?" she asks.\r
 322            "It's a computer," he replies.\r
 323            "Yes, dear, but what does it do?"\r
 324            "It ..er.. computes! It's a computer."\r
 325            "What does it compute?"\r
 326            "What? Er? Um. Numbers! Yes, numbers!" He smiles\r
 327               worriedly.\r
 328            "Why?"\r
 329            "Why? Well ..um.. why?" He starts to sweat.\r
 330            "I mean, is it just something to dust around, or does\r
 331               it actually do something useful?"\r
 332            "Um...you can call other computers with it!" Hope lights\r
 333               up his eyes. "So you can get programs from other computers!"\r
 334            "I see. Tell me, what do these programs do?"\r
 335            "Do? I don't think I fol..."\r
 336            "I see. They compute. Numbers. For no particular reason." He\r
 337               withers under her gaze.\r
 338            "Yes, but..."\r
 339            She smiles, and he trails off, defeated. She takes another look\r
 340                at the thing. "Although," she says, with a strange look in\r
 341                her eyes. He looks up, an insane look of hope on his\r
 342                face. "Does it come in pink?" she asks.\r
 343                                                                            ]\r
 344                                                      - Grant Smith\r
 345                                                         Tue 27 July, 1993\r
 346                                                          9:35 pm.\r
 347 \r
 348 See you next time,\r
 349     - Denthor\r
 350 \r
 351 \r
 352 ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ\r
 353 ³ TUTPROG3.PAS ³\r
 354 ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ\r
 355 \r
 356 {$X+}\r
 357 USES crt;\r
 358 \r
 359 CONST VGA = $a000;\r
 360 \r
 361 VAR loop1:integer;\r
 362     Pall : Array [1..199,1..3] of byte;\r
 363       { This is our temporary pallette. We ony use colors 1 to 199, so we\r
 364         only have variables for those ones. }\r
 365 \r
 366 {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}\r
 367 Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }\r
 368 BEGIN\r
 369   asm\r
 370      mov        ax,0013h\r
 371      int        10h\r
 372   end;\r
 373 END;\r
 374 \r
 375 \r
 376 {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}\r
 377 Procedure SetText;  { This procedure returns you to text mode.  }\r
 378 BEGIN\r
 379   asm\r
 380      mov        ax,0003h\r
 381      int        10h\r
 382   end;\r
 383 END;\r
 384 \r
 385 \r
 386 {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}\r
 387 Procedure Putpixel (X,Y : Integer; Col : Byte);\r
 388   { This puts a pixel on the screen by writing directly to memory. }\r
 389 BEGIN\r
 390   Mem [VGA:X+(Y*320)]:=Col;\r
 391 END;\r
 392 \r
 393 \r
 394 {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}\r
 395 procedure WaitRetrace; assembler;\r
 396 label\r
 397   l1, l2;\r
 398 asm\r
 399     mov dx,3DAh\r
 400 l1:\r
 401     in al,dx\r
 402     and al,08h\r
 403     jnz l1\r
 404 l2:\r
 405     in al,dx\r
 406     and al,08h\r
 407     jz  l2\r
 408 end;\r
 409 \r
 410 \r
 411 {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}\r
 412 Procedure Pal(ColorNo : Byte; R,G,B : Byte);\r
 413   { This sets the Red, Green and Blue values of a certain color }\r
 414 Begin\r
 415    Port[$3c8] := ColorNo;\r
 416    Port[$3c9] := R;\r
 417    Port[$3c9] := G;\r
 418    Port[$3c9] := B;\r
 419 End;\r
 420 \r
 421 \r
 422 {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}\r
 423 Procedure Circle (X,Y,rad:integer;Col:Byte);\r
 424   { This draws a circle with centre X,Y, with Rad as it's radius }\r
 425 VAR deg:real;\r
 426 BEGIN\r
 427   deg:=0;\r
 428   repeat\r
 429     X:=round(rad*COS (deg));\r
 430     Y:=round(rad*sin (deg));\r
 431     putpixel (x+160,y+100,col);\r
 432     deg:=deg+0.005;\r
 433   until (deg>6.4);\r
 434 END;\r
 435 \r
 436 \r
 437 {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}\r
 438 Procedure Line2 (x1,y1,x2,y2:integer;col:byte);\r
 439   { This draws a line from x1,y1 to x2,y2 using the first method }\r
 440 VAR x,y,xlength,ylength,dx,dy:integer;\r
 441     xslope,yslope:real;\r
 442 BEGIN\r
 443   xlength:=abs (x1-x2);\r
 444   if (x1-x2)<0 then dx:=-1;\r
 445   if (x1-x2)=0 then dx:=0;\r
 446   if (x1-x2)>0 then dx:=+1;\r
 447   ylength:=abs (y1-y2);\r
 448   if (y1-y2)<0 then dy:=-1;\r
 449   if (y1-y2)=0 then dy:=0;\r
 450   if (y1-y2)>0 then dy:=+1;\r
 451   if (dy=0) then BEGIN\r
 452     if dx<0 then for x:=x1 to x2 do\r
 453       putpixel (x,y1,col);\r
 454     if dx>0 then for x:=x2 to x1 do\r
 455       putpixel (x,y1,col);\r
 456     exit;\r
 457   END;\r
 458   if (dx=0) then BEGIN\r
 459     if dy<0 then for y:=y1 to y2 do\r
 460       putpixel (x1,y,col);\r
 461     if dy>0 then for y:=y2 to y1 do\r
 462       putpixel (x1,y,col);\r
 463     exit;\r
 464   END;\r
 465   xslope:=xlength/ylength;\r
 466   yslope:=ylength/xlength;\r
 467   if (yslope/xslope<1) and (yslope/xslope>-1) then BEGIN\r
 468     if dx<0 then for x:=x1 to x2 do BEGIN\r
 469                    y:= round (yslope*x);\r
 470                    putpixel (x,y,col);\r
 471                  END;\r
 472     if dx>0 then for x:=x2 to x1 do BEGIN\r
 473                    y:= round (yslope*x);\r
 474                    putpixel (x,y,col);\r
 475                  END;\r
 476   END\r
 477   ELSE\r
 478   BEGIN\r
 479     if dy<0 then for y:=y1 to y2 do BEGIN\r
 480                    x:= round (xslope*y);\r
 481                    putpixel (x,y,col);\r
 482                  END;\r
 483     if dy>0 then for y:=y2 to y1 do BEGIN\r
 484                    x:= round (xslope*y);\r
 485                    putpixel (x,y,col);\r
 486                  END;\r
 487   END;\r
 488 END;\r
 489 \r
 490 \r
 491 {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}\r
 492 procedure line(a,b,c,d,col:integer);\r
 493   { This draws a line from x1,y1 to x2,y2 using the first method }\r
 494 \r
 495     function sgn(a:real):integer;\r
 496     begin\r
 497          if a>0 then sgn:=+1;\r
 498          if a<0 then sgn:=-1;\r
 499          if a=0 then sgn:=0;\r
 500     end;\r
 501 \r
 502 var u,s,v,d1x,d1y,d2x,d2y,m,n:real;\r
 503     i:integer;\r
 504 begin\r
 505      u:= c - a;\r
 506      v:= d - b;\r
 507      d1x:= SGN(u);\r
 508      d1y:= SGN(v);\r
 509      d2x:= SGN(u);\r
 510      d2y:= 0;\r
 511      m:= ABS(u);\r
 512      n := ABS(v);\r
 513      IF NOT (M>N) then\r
 514      BEGIN\r
 515           d2x := 0 ;\r
 516           d2y := SGN(v);\r
 517           m := ABS(v);\r
 518           n := ABS(u);\r
 519      END;\r
 520      s := INT(m / 2);\r
 521      FOR i := 0 TO round(m) DO\r
 522      BEGIN\r
 523           putpixel(a,b,col);\r
 524           s := s + n;\r
 525           IF not (s<m) THEN\r
 526           BEGIN\r
 527                s := s - m;\r
 528                a:= a +round(d1x);\r
 529                b := b + round(d1y);\r
 530           END\r
 531           ELSE\r
 532           BEGIN\r
 533                a := a + round(d2x);\r
 534                b := b + round(d2y);\r
 535           END;\r
 536      end;\r
 537 END;\r
 538 \r
 539 \r
 540 {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}\r
 541 Procedure PalPlay;\r
 542   { This procedure mucks about with our "virtual pallette", then shoves it\r
 543     to screen. }\r
 544 Var Tmp : Array[1..3] of Byte;\r
 545   { This is used as a "temporary color" in our pallette }\r
 546     loop1 : Integer;\r
 547 BEGIN\r
 548    Move(Pall[199],Tmp,3);\r
 549      { This copies color 199 from our virtual pallette to the Tmp variable }\r
 550    Move(Pall[1],Pall[2],198*3);\r
 551      { This moves the entire virtual pallette up one color }\r
 552    Move(Tmp,Pall[1],3);\r
 553      { This copies the Tmp variable to the bottom of the virtual pallette }\r
 554    WaitRetrace;\r
 555    For loop1:=1 to 199 do\r
 556      pal (loop1,pall[loop1,1],pall[loop1,2],pall[loop1,3]);\r
 557 END;\r
 558 \r
 559 \r
 560 BEGIN\r
 561   ClrScr;\r
 562   Writeln ('This sample program will test out our line and circle algorithms.');\r
 563   Writeln ('In the first part, many circles will be draw creating (hopefully)');\r
 564   Writeln ('a "tunnel" effect. I will the rotate the pallete to make it look');\r
 565   Writeln ('nice. I will then draw some lines and rotate the pallette on them');\r
 566   Writeln ('too. Note : I am using the slower (first) line algorithm (in');\r
 567   Writeln ('procedure line2). Change it to Procedure Line and it will be using');\r
 568   Writeln ('the second line routine. NB : For descriptions on how pallette works');\r
 569   Writeln ('have a look at part two of this series; I won''t re-explain it here.');\r
 570   Writeln;\r
 571   Writeln ('Remember to send me any work you have done, I am most eager to help.');\r
 572   Writeln; Writeln;\r
 573   Writeln ('Hit any key to continue ...');\r
 574   Readkey;\r
 575   setmcga;\r
 576 \r
 577   For Loop1 := 1 to 199 do BEGIN\r
 578     Pall[Loop1,1] := Loop1 mod 30+33;\r
 579     Pall[Loop1,2] := 0;\r
 580     Pall[Loop1,3] := 0;\r
 581   END;\r
 582        { This sets colors 1 to 199 to values between 33 to 63. The MOD\r
 583          function gives you the remainder of a division, ie. 105 mod 10 = 5 }\r
 584 \r
 585    WaitRetrace;\r
 586    For loop1:=1 to 199 do\r
 587      pal (loop1,pall[loop1,1],pall[loop1,2],pall[loop1,3]);\r
 588         { This sets the true pallette to variable Pall }\r
 589 \r
 590   for loop1:=1 to 90 do\r
 591     circle (160,100,loop1,loop1);\r
 592        { This draws 90 circles all with centres at 160,100; with increasing\r
 593          radii and colors. }\r
 594 \r
 595   Repeat\r
 596     PalPlay;\r
 597   Until keypressed;\r
 598   Readkey;\r
 599 \r
 600   for loop1:=1 to 199 do\r
 601     line2 (0,1,319,loop1,loop1);   { *** Replace Line2 with Line to use the\r
 602                                          second line algorithm *** }\r
 603        { This draws 199 lines, all starting at 0,1 }\r
 604 \r
 605   Repeat\r
 606     PalPlay;\r
 607   Until keypressed;\r
 608 \r
 609   readkey;\r
 610   SetText;\r
 611   Writeln ('All done. Okay, so maybe it wasn''t a tunnel effect, but you get the');\r
 612   Writeln ('general idea ;-) This concludes the third sample program in the ASPHYXIA');\r
 613   Writeln ('Training series. You may reach DENTHOR under the name of GRANT SMITH');\r
 614   Writeln ('on the MailBox BBS, or leave a message to ASPHYXIA on the ASPHYXIA BBS.');\r
 615   Writeln ('Get the numbers from Roblist, or write to :');\r
 616   Writeln ('             Grant Smith');\r
 617   Writeln ('             P.O. Box 270');\r
 618   Writeln ('             Kloof');\r
 619   Writeln ('             3640');\r
 620   Writeln ('I hope to hear from you soon!');\r
 621   Writeln; Writeln;\r
 622   Write   ('Hit any key to exit ...');\r
 623   Readkey;\r
 624 END.\r