home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG013.ARC / PLOT80.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  9KB  |  222 lines
  1. program PLOT80;
  2.  
  3. {     Demonstration program by Bob Burt
  4.  
  5.    Program to set up  PCG on the MicroBee for
  6.    LORES graphics and  PLOT between any  pair
  7.    of x,y coordinates, assuming a screen with
  8.              80 x 24 format
  9.  
  10.        x coordinate range: 0 to 159
  11.        y coordinate range: 0 to 71
  12.        0,0 at top left of screen               }
  13.  
  14. const
  15.   title = '*** Plotting with LORES Graphics ***';
  16.   space18 = '                  ';
  17. var
  18.   x1,y1,x2,y2 : real;
  19.  
  20. procedure normal; external $E02A;
  21. {This procedure calls copy_inv in the Micro-
  22.  Bee disk ROM and fills the PCG with inverse
  23.  characters of the current font type.    All
  24.  registers are preserved                       }
  25.  
  26. procedure lores;
  27. {This procedure fills the PCG with the
  28.  LORES graphics set and also fills the
  29.  screen with  chr(128) in  preparation
  30.  for the PLOT routine                          }
  31.  
  32. begin
  33.   inline ($F5/$C5/$D5/$E5/
  34.           $3E/8/$21/0/$F8/$0E/$80/$59/
  35.           $16/4/$AF/$CB/$43/$28/2/$F6/$F0/$CB/$4B/$28/
  36.           2/$F6/$0F/6/4/$77/$23/$10/$FC/$CB/$0B/$CB/$0B/
  37.           $15/$20/$E6/$0C/$20/$E0/
  38.           $21/0/$F0/1/$80/7/$16/$80/$72/$23/$0B/$78/$B1/$20/$F9/
  39.           $E1/$D1/$C1/$F1/$C9);
  40. end; {procedure lores}
  41.  
  42. procedure draw; {   Derived from the LINE routine on page 209
  43.                   of "More TRS-80 Assembly Language Programming"
  44.                         by Bill Borden (Radio Shack)             }
  45.  
  46. begin
  47.   inline ($F5/$C5/$D5/$E5/  {         Save Registers     }
  48.          $DD/$E5/
  49.          $18/$0B/           { JUMP:   JR     LINE        }
  50.          0/0/0/0/0/         { BLOCK:  DEFS   11          }
  51.          0/0/0/0/0/0/
  52.          $3A/*-3/           { LINE:   LD     A,(BLOCK+9) }
  53.          $B7/               {         OR     A           }
  54.          $28/$0D/           {         JR     Z,LINE10    }
  55.          $21/0/0/           {         LD     HL,0        }
  56.          $ED/$5B/*-18/      {         LD     DE,(BLOCK+4)}
  57.          $B7/               {         OR     A           }
  58.          $ED/$52/           {         SBC    HL,DE       }
  59.          $22/*-24/          {         LD     (BLOCK+4),HL}
  60.  
  61.          $3A/*-21/          { LINE10: LD     A,(BLOCK+10)}
  62.          $B7/               {         OR     A           }
  63.          $28/$0D/           {         JR     Z,LINE20    }
  64.          $21/0/0/           {         LD     HL,0        }
  65.          $ED/$5B/*-35/      {         LD     DE.(BLOCK+6)}
  66.          $B7/               {         OR     A           }
  67.          $ED/$52/           {         SBC    HL,DE       }
  68.          $22/*-41/          {         LD     (BLOCK+6),HL}
  69.  
  70.          $DD/$21/*-51/      { LINE20: LD     IX,BLOCK    }
  71.          $DD/$66/1/         {         LD     H,(IX+1)    }
  72.          $DD/$6E/3/         {         LD     L,(IX+3)    }
  73.          $AF/               {         XOR    A           }
  74.          $CD/*+40/          {         CALL   SETRST      }
  75.          $2A/*-64/          {         LD     HL,(BLOCK)  }
  76.          $ED/$5B/*-64/      {         LD     DE,(BLOCK+4)}
  77.          $19/               {         ADD    HL,DE       }
  78.          $22/*-72/          {         LD     (BLOCK),HL  }
  79.          $2A/*-73/          {         LD     HL,(BLOCK+2)}
  80.          $ED/$5B/*-73/      {         LD     DE,(BLOCK+6)}
  81.          $19/               {         ADD    HL,DE       }
  82.          $22/*-81/          {         LD     (BLOCK+2),HL}
  83.          $3A/*-78/          {         LD     A,(BLOCK+8) }
  84.          $3D/               {         DEC    A           }
  85.          $32/*-82/          {         LD     (BLOCK+8),A }
  86.          $20/$D3/           {         JR     NZ,LINE20   }
  87.          $DD/$E1/           {         Restore Registers  }
  88.          $E1/$D1/$C1/$F1/
  89.          $C9/               {         RET                }
  90.  
  91.          $F5/               { SETRST: PUSH   AF          }
  92.          $5C/               {         LD     E,H         }
  93.          $7D/               {         LD     A,L         }
  94.          $CB/$3B/           {         SRL    E           }
  95.          $16/0/             {         LD     D,0         }
  96.          $30/1/             {         JR     NC,SET10    }
  97.          $14/               {         INC    D           }
  98.  
  99.          6/$FF/             { SET10:  LD     B,0FFH      }
  100.          4/                 { SET20:  INC    B           }
  101.          $D6/3/             {         SUB    3           }
  102.          $F2/*-4/           {         JP     P,SET20     }
  103.          $C6/3/             {         ADD    A,3         }
  104.          7/                 {         RLCA               }
  105.          $82/               {         ADD    A,D         }
  106.          $4F/               {         LD     C,A         }
  107.          $68/               {         LD     L,B         }
  108.          $26/0/             {         LD     H,0         }
  109.          $D5/               {         PUSH   DE          }
  110.          6/4/               {         LD     B,4         }
  111.  
  112.          $29/               { SET30:  ADD    HL,HL       }
  113.          $10/$FD/           {         DJNZ   SET30       }
  114.          $54/               {         LD     D,H         }
  115.          $5D/               {         LD     E,L         }
  116.          $29/               {         ADD    HL,HL       }
  117.          $29/               {         ADD    HL,HL       }
  118.          $19/               {         ADD    HL,DE       }
  119.          $D1/               {         POP    DE          }
  120.          $16/0/             {         LD     D,0         }
  121.          $19/               {         ADD    HL,DE       }
  122.          $11/0/$F0/         {         LD     DE,0F000H   }
  123.          $19/               {         ADD    HL,DE       }
  124.          6/0/               {         LD     B,0         }
  125.          $F1/               {         POP    AF          }
  126.          $B7/               {         OR     A           }
  127.          $20/$0C/           {         JR     NZ,RESET    }
  128.          $DD/$21/*+22/      {         LD     IX,MASK     }
  129.          $DD/9/             {         ADD    IX,BC       }
  130.          $7E/               {         LD     A,(HL)      }
  131.          $DD/$B6/0/         {         OR     (IX)        }
  132.  
  133.          $77/               { SET36:  LD     (HL),A      }
  134.          $C9/               {         RET                }
  135.  
  136.          $DD/$21/*+16/      { RESET:  LD     IX,MASK1    }
  137.          $DD/9/             {         ADD    IX,BC       }
  138.          $7E/               {         LD     A,(HL)      }
  139.          $DD/$A6/0/         {         AND    (IX)        }
  140.          $18/$F2/           {         JR     SET36       }
  141.  
  142.          $81/               { MASK:   DEFB   81H         }
  143.          $82/               {         DEFB   82H         }
  144.          $84/               {         DEFB   84H         }
  145.          $88/               {         DEFB   88H         }
  146.          $90/               {         DEFB   90H         }
  147.          $A0/               {         DEFB   0A0H        }
  148.  
  149.          $BE/               { MASK1:  DEFB   0BEH        }
  150.          $BD/               {         DEFB   0BDH        }
  151.          $BB/               {         DEFB   0BBH        }
  152.          $B7/               {         DEFB   0B7H        }
  153.          $AF/               {         DEFB   0AFH        }
  154.          $9F);              {         DEFB   09FH        }
  155. end; {procedure draw}
  156.  
  157. procedure plot(x1,y1,x2,y2 : real);
  158. label 99;
  159. var
  160.   dx,dy,x,y,xi,yi : real;
  161.   count : integer;
  162. begin
  163.   dx := x2 - x1;
  164.   dy := y2 - y1;
  165.   if (dx = 0) and (dy = 0) then
  166.     begin
  167.       xi := 0; yi := 0; count := 1; goto 99
  168.     end; {if}
  169.   if abs(dx) > abs(dy) then
  170.     begin
  171.       xi := 256; count := trunc(abs(dx) + 1); yi := abs(dy*256/dx)
  172.     end; {if}
  173.   if abs(dx) <= abs(dy) then
  174.     begin
  175.       yi := 256; count := trunc(abs(dy) + 1); xi := abs(dx*256/dy)
  176.     end; {if}
  177.   if abs(dx) <> (count - 1)*xi/256 then xi := xi + 1;
  178.   if abs(dy) <> (count - 1)*yi/256 then yi := yi + 1;
  179.   99 :
  180.   if dx < 0 then mem[addr(draw)+17] := 1            {negate x inc     }
  181.             else mem[addr(draw)+17] := 0;
  182.   if dy < 0 then mem[addr(draw)+18] := 1            {negate y inc     }
  183.             else mem[addr(draw)+18] := 0;
  184.   x := x1*256; y := y1*256;
  185.   mem[addr(draw)+8]  := trunc(x - int(x/256)*256);  {scaled x value   }
  186.   mem[addr(draw)+9]  := trunc(x/256);
  187.   mem[addr(draw)+10] := trunc(y - int(y/256)*256);  {scaled y value   }
  188.   mem[addr(draw)+11] := trunc(y/256);
  189.   mem[addr(draw)+12] := trunc(xi - int(xi/256)*256);{abs x inc, scaled}
  190.   mem[addr(draw)+13] := trunc(xi/256);
  191.   mem[addr(draw)+14] := trunc(yi - int(yi/256)*256);{abs y inc, scaled}
  192.   mem[addr(draw)+15] := trunc(yi/256);
  193.   mem[addr(draw)+16] := count;                      {count            }
  194.   draw
  195. end; {procedure plot}
  196.  
  197. begin {main}
  198.   clrscr;
  199.   write(space18);
  200.   writeln(title);
  201.   gotoxy(22,8);
  202.   writeln('Address of "draw" is : ',addr(draw));
  203.   gotoxy(20,10);
  204.   writeln;
  205.   writeln('x coordinate range : 0 to 159');
  206.   writeln('y coordinate range : 0 to  71');
  207.   writeln('Coordinates 0,0 are at the top left of the screen');
  208.   writeln;
  209.   writeln('Note - enter plot values separated by spaces, NOT commas!');
  210.   writeln;
  211.   write('Enter plot values (x1 y1 x2 y2) : ');
  212.   readln(x1,y1,x2,y2);
  213.   lores;
  214.   plot(x1,y1,x2,y2);
  215.   repeat until keypressed;
  216.   clrscr;  {replace chr(128) with chr(32)}
  217.   normal;
  218.   writeln(^G)
  219. end {main}.
  220.  
  221.  
  222.