home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / genie-commodore-file-library / C128CPM / GRC128.ZIP / DEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-06-15  |  4.4 KB  |  242 lines
  1. program demo;
  2.  
  3.     type
  4.          tsrec = record
  5.            xs:integer;
  6.            ys: integer;
  7.            xe:integer;
  8.            ye:integer;
  9.            car:array[1..8] of char;
  10.            linv:byte;
  11.            lover:byte
  12.          end;
  13.  
  14.  
  15.          nstr=record
  16.            xw:integer;
  17.            yw:integer;
  18.            xq:integer;
  19.            yq:integer;
  20.            wt:integer;
  21.            sinv:byte;
  22.            sover:byte
  23.           end;
  24.  
  25.          feld=array [1..4096] of byte;
  26.  
  27.          ttextrec = record
  28.             inv:integer;
  29.             offs:integer;
  30.             zeile:integer;
  31.             spalte:integer;
  32.             addr:integer
  33.           end;
  34.  
  35.         xrec = record
  36.            kx:integer;
  37.            ky:integer
  38.         end;
  39.  
  40.         xyz = array [1..8] of char;
  41.  
  42. var  ndd:nstr;
  43.      speicher:feld;
  44.      lrec:xrec;
  45.      textrec:ttextrec;
  46.      s,e:integer;
  47.      srec,erec:tsrec;
  48.      x,y:integer;
  49.      mytext:array [1..11] of char;
  50.  
  51. procedure GrFOn;
  52.    begin
  53.    bdos (153);
  54.    end;
  55.  
  56. procedure GrSOn;
  57.    begin
  58.    bdos (154);
  59.    end;
  60.  
  61. procedure GrFOff;
  62.    begin
  63.    bdos (155);
  64.    end;
  65.  
  66. procedure SetPix(xp,yp:integer);
  67.    begin
  68.    lrec.kx:=xp;lrec.ky:=yp;
  69.    bdos(156,addr(lrec))
  70.    end;
  71.  
  72. procedure EraPix (xp,yp:integer);
  73.     begin
  74.     lrec.kx:=xp;lrec.ky:=yp;
  75.     bdos(157,addr(lrec))
  76.     end;
  77.  
  78.  
  79. procedure ClrGr;
  80.     begin
  81.     bdos (158)
  82.     end;
  83.  
  84. procedure SaveWi(x1,y1,x2,y2:integer);
  85.     begin
  86.     ndd.xw:=x1;
  87.     ndd.yw:=y1;
  88.     ndd.xq:=x2;
  89.     ndd.yq:=y2;
  90.     ndd.wt:=addr(speicher);
  91.     bdos(159,addr(ndd))
  92.     end;
  93.  
  94.  
  95. procedure LoadWi(x1,y1,x2,y2:integer;inv:byte;over:byte);
  96.     begin
  97.     ndd.xw:=x1;
  98.     ndd.yw:=y1;
  99.     ndd.xq:=x2;
  100.     ndd.yq:=y2;
  101.     ndd.wt:=addr(speicher);
  102.     ndd.sinv:=inv;
  103.     ndd.sover:=over;
  104.     bdos(160,addr(ndd))
  105.     end;
  106.  
  107. procedure SaveFW (x1,y1,x2,y2:integer;xk:xyz);
  108.     begin
  109.     srec.xs:=x1;
  110.     srec.ys:=y1;
  111.     srec.xe:=x2;
  112.     srec.ye:=y2;
  113.     srec.car[1]:=xk[1];srec.car[2]:=xk[2];
  114.     srec.car[3]:=xk[3];srec.car[4]:=xk[4];
  115.     srec.car[5]:=xk[5];srec.car[6]:=xk[6];
  116.     srec.car[7]:=xk[7];srec.car[8]:=xk[8];
  117.     bdos(161,addr(srec))
  118.     end;
  119.  
  120. procedure LoadFW (x1,y1,x2,y2:integer;xk:xyz;inv:byte;over:byte);
  121.     begin
  122.     srec.xs:=x1;
  123.     srec.ys:=y1;
  124.     srec.xe:=x2;
  125.     srec.ye:=y2;
  126.     srec.car[1]:=xk[1];srec.car[2]:=xk[2];
  127.     srec.car[3]:=xk[3];srec.car[4]:=xk[4];
  128.     srec.car[5]:=xk[5];srec.car[6]:=xk[6];
  129.     srec.car[7]:=xk[7];srec.car[8]:=xk[8];
  130.     srec.linv:=inv;srec.lover:=over;
  131.     bdos(162,addr(srec))
  132.     end;
  133.  
  134. procedure GFtext (i,o,z,s,a :integer);
  135.     begin
  136.     textrec.inv:=i;
  137.     textrec.offs:=o;
  138.     textrec.spalte:=s;
  139.     textrec.zeile:=z;
  140.     textrec.addr:=a;
  141.     bdos(163,addr(textrec))
  142.    end;
  143.  
  144. procedure scrdump (i:integer);
  145.    begin
  146.    bdos (164,i)
  147.    end;
  148.  
  149. begin
  150.  
  151. GrSOn;
  152.  
  153. mytext[1]:=CHR(10);
  154. mytext[2]:='s';
  155. mytext[3]:='m';
  156. mytext[4]:='a';
  157. mytext[5]:='l';
  158. mytext[6]:='l';
  159. mytext[7]:=' ';
  160. mytext[8]:='d';
  161. mytext[9]:='e';
  162. mytext[10]:='m';
  163. mytext[11]:='o';
  164.  
  165. GFtext(0,0,0,0,addr(mytext));
  166. GFtext(1,0,0,15,addr(mytext));
  167. GFtext(0,1,2,0,addr(mytext));
  168. GFtext(0,0,2,15,addr(mytext));
  169. GFtext(1,0,4,0,addr(mytext));
  170. GFtext(0,1,4,15,addr(mytext));
  171. GFtext(0,0,6,0,addr(mytext));
  172. GFtext(1,0,6,15,addr(mytext));
  173. GFtext(0,1,8,0,addr(mytext));
  174. GFtext(0,0,8,15,addr(mytext));
  175. Gftext(1,0,10,0,addr(mytext));
  176. GFtext(0,1,10,15,addr(mytext));
  177. GFtext(0,0,12,0,addr(mytext));
  178. Gftext(1,0,12,15,addr(mytext));
  179. GFtext(0,1,14,0,addr(mytext));
  180. GFtext(0,0,14,15,addr(mytext));
  181. (*
  182. scrdump(0);
  183. scrdump(1);
  184. scrdump(2);
  185. scrdump(3);
  186. scrdump(4);
  187. scrdump(5);
  188. scrdump(6);
  189. scrdump(7);
  190. *)
  191. y:=1;
  192. while (y<=150) do
  193.      begin
  194.      for x:=1 to 500 do
  195.           SetPix(x,y);
  196.      y:=y+10
  197.      end;
  198.  
  199.  
  200. SaveWi(0,0,100,50);
  201. ClrGr;
  202. LoadWi(0,0,100,50,1,1);
  203. SaveFW(0,0,100,50,'NEWFILE ');
  204. ClrGr;
  205. LoadFW(50,100,150,150,'NEWFILE ',0,0);
  206. LoadFW(70,120,170,170,'NEWFILE ',1,1);
  207. LoadFW(90,140,190,190,'NEWFILE ',0,0);
  208. LoadFW(300,149,400,199,'NEWFILE ',1,1);
  209.  
  210. y:=1;
  211. while (y<=150) do
  212.      begin
  213.      x:=1;
  214.      while (x<=500) do
  215.         begin
  216.         SetPix(x,y);
  217.         x:=x+2
  218.         end;
  219.      y:=y+10
  220.      end;
  221.  
  222.  
  223. y:=1;
  224. while (y<=150) do
  225.      begin
  226.      x:=1;
  227.      while (x<=500) do
  228.         begin
  229.         EraPix(x,y);
  230.         x:=x+2
  231.         end;
  232.      y:=y+10
  233.      end;
  234.  
  235.  
  236. GrFOff
  237. end.
  238.  
  239.  
  240.  
  241.  
  242.