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 / MBUG025.ARC / DRAW.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  6KB  |  183 lines
  1. PROGRAM DRAW;
  2.  
  3. { Written by Lang Stuiver }
  4.  
  5. {$U+ : allow for the user to stop the program (^C), but should only be done }
  6. {      if necessary, as when ^C'd it will return to Turbo with lores        }
  7. {      characters instead of inverse, and 9 scan line high chars.           }
  8.  
  9. var
  10. ch:        char;
  11. I,J,K:     integer;
  12. pcg:       array[1..2048] of byte absolute $F800;
  13. screen:    array[0..23,0..79] of byte absolute $F000;
  14. x,y:       integer;
  15. a:         byte;
  16. pen:       boolean;     { true = draw, false = erase }
  17. point:     boolean;     { when true, dot call says if point specified IS ON }
  18. lit:       boolean;     {or not in the variable lit (true = on, false = off)}
  19.  
  20. (***************************************************************************)
  21.  
  22. Procedure     dot(x1,y1:integer);
  23. var
  24. x2,y2:     real;
  25. x3,y3:     integer;
  26. b:         byte;
  27.  
  28. begin
  29. { y1:=71-y1; }
  30. { Delete the curly brackets on the above line to make (0,0) at the bottom of }
  31. { the screen, add them again to make (0,0) at the top of the screen          }
  32.  
  33. x2:=x1/2; y2:=y1/3;
  34. x3:=(x1 mod 2); y3:=(y1 mod 3);
  35. x1:=trunc(x2); y1:=trunc(y2);
  36. a:=screen[y1,x1];
  37. if (a<128) or (a>128+63) then a:=128; { if character is a non graphics char }
  38.                                       { than make it one                    }
  39. case y3 of
  40.  0:b:=x3+1;
  41.  1:b:=4*(x3+1);
  42.  2:b:=16*(x3+1);
  43. end; {of case}
  44.  
  45. if not point then begin
  46. if pen then a:=(a or b) else a:=(a and (255-b));
  47. screen[y1,x1]:=a;
  48. end {Not point}
  49.                else {If point}
  50. if (a and b) = 0 then lit:=false else lit:=true;
  51. end;
  52.  
  53. (***************************************************************************)
  54.  
  55. Procedure     normal;
  56. {$U- : Disable the ^C/^S keys whilst programming the 6545}
  57. begin
  58. clrscr;
  59. port[$C]:=9;       { Puts 10 in reg. 9 of the 6545 screen chip }
  60. port[$D]:=10;      { This gives 11 scan lines, the normal amount for CPM }
  61.  
  62. inline($CD/$E02A); { Machine code for: CALL  E02A  (which actually means  }
  63.                    { call the routine in the boot rom which loads the PCG }
  64.                    { with inverse characters (to wipe over the lores)     }
  65. end;
  66.  
  67. (***************************************************************************)
  68.  
  69. Procedure     lores;
  70. var
  71. L:      byte;
  72. {$U-}
  73. begin
  74. clrscr;
  75. port[$C]:=9; { Output 9 to the 6545 address port }
  76. port[$D]:=8; { Output 8 to the 6545 data port }
  77. { The above two lines put the number 8 in register 9 of the 6545. }
  78. { Register 9 is the amount of scan lines per character -1, this   }
  79. { gives us characters with nine scan lines (normally 11, or 16 in }
  80. { BASIC)                                                          }
  81.  
  82. (** THIS SETS UP pcg for 'lores' (160 x 72) **)
  83.  
  84. for i:=0 to 63 do
  85.   for k:=1 to 9 do
  86.    begin
  87.     j:=i*16+k;
  88.     pcg[j]:=0;
  89.     case k of
  90.      1,2,3: begin
  91.              if (i and 1)=1 then pcg[j]:=240;
  92.              if (i and 2)=2 then pcg[j]:=15;
  93.              if (i and 3)=3 then pcg[j]:=255;
  94.             end;
  95.      4,5,6: begin
  96.              if (i and 4)=4 then pcg[j]:=240;
  97.              if (i and 8)=8 then pcg[j]:=15;
  98.              if (i and 12)=12 then pcg[j]:=255;
  99.             end;
  100.      7,8,9: begin
  101.               if (i and 16)=16 then pcg[j]:=240;
  102.               if (i and 32)=32 then pcg[j]:=15;
  103.               if (i and 48)=48 then pcg[j]:=255;
  104.              end;
  105.    end { case }
  106.   end { for }
  107. end;
  108.  
  109. (***************************************************************************)
  110.  
  111. Procedure     plot(xfrom,yfrom,xto,yto:integer);
  112. var
  113. a,b:     integer;
  114.  
  115. begin
  116. a:=xfrom-xto; b:=yfrom-yto;
  117.  
  118. if abs(a) > abs(b) then begin
  119.   if xfrom<xto
  120.   then
  121.    for x:=xfrom to xto do dot(x,yfrom + round((x-xfrom)/a * b))
  122.   else
  123.    for x:=xfrom downto xto do dot(x,yfrom + round((x-xfrom)/a * b));
  124. end
  125.  
  126. else
  127.  
  128. begin
  129. if yfrom<yto
  130.  then
  131.   for y:=yfrom to yto do dot(xfrom + round((y-yfrom)/b * a),y)
  132.  else
  133.   for y:=yfrom downto yto do dot(xfrom + round((y-yfrom)/b * a),y);
  134. end;
  135.  
  136. end;
  137. (***************************************************************************)
  138. Procedure     invert(xi,yi:integer);
  139. var
  140. temp,temp1:   boolean;
  141.  
  142. begin
  143. temp:=point; temp1:=pen;
  144. point:=true; dot(xi,yi);
  145. point:=false;
  146. if lit then pen:=false else pen:=true;
  147. dot(xi,yi);
  148. point:=temp; pen:=temp1;
  149. end;
  150. (***************************************************************************)
  151.  
  152. begin
  153. lores;
  154. pen:=false; point:=false;
  155. dot(1,2); { Wipe wipe out cursor } pen:=true;
  156.  
  157. { Data for Aus, crude but it draws! }
  158. plot(108,55,115,35); plot(115,35,88,2); plot(88,2,82,12);
  159. plot(82,12,75,8);    plot(75,8,78,4);   plot(78,4,60,4);   plot(60,4,58,11);
  160. plot(58,11,48,8);    plot(48,8,22,28);  plot(22,28,25,50); dot(24,51);
  161. plot(25,52,60,45);   plot(60,45,90,57); plot(90,57,95,54);
  162. plot(95,54,100,57);  plot(100,57,108,55);
  163.  
  164. { not to forget Tassie }
  165. plot(95,62,101,62);  plot(101,62,98,69); plot(98,69,95,62);
  166.  
  167. gotoxy(20,9);
  168. pen:=false; dot(1,2); { Wipe over wiped over cursor ! }
  169. write('A MAP THAT ALMOST LOOKS RIGHT!');
  170. gotoxy(46,17); write('Melbourne');
  171. gotoxy(30,1); write('AUSTRALIA');
  172. gotoxy(30,23); write('HIT ANY KEY');
  173. read(kbd,ch);
  174. lores;
  175. gotoxy(33,3);
  176. pen:=true; plot(0,0,159,71); plot(159,0,0,71); plot(0,0,159,0);
  177. plot(159,0,159,71); plot(159,71,0,71); plot(0,71,0,0);
  178. write('HIT ANY KEY');
  179. read(kbd,ch);
  180. normal;
  181. end.
  182. (***************************************************************************)
  183.