home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / genie-commodore-file-library / C128CPM / GRC128.ZIP / DEMO.SRC < prev    next >
Encoding:
Text File  |  1991-06-15  |  4.6 KB  |  237 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.      dummy : integer;
  51.  
  52.  
  53. external function @bdos(func:integer;parm:word):integer;
  54.  
  55. procedure GrFOn;
  56.    begin
  57.    dummy:= @bdos(153, wrd(0))
  58.    end;
  59.  
  60. procedure GrSOn;
  61.    begin
  62.    dummy:= @bdos(154, wrd(0))
  63.    end;
  64.  
  65. procedure GrFOff;
  66.    begin
  67.    dummy:= @bdos(155, wrd(0))
  68.    end;
  69.  
  70.  
  71. procedure SetPix(xp,yp:integer);
  72.    begin
  73.    lrec.kx:=xp;lrec.ky:=yp;
  74.    dummy:= @bdos(156, wrd(addr(lrec)))
  75.    end;
  76.  
  77. procedure EraPix (xp,yp:integer);
  78.     begin
  79.     lrec.kx:=xp;lrec.ky:=yp;
  80.     dummy:= @bdos(157, wrd(addr(lrec)))
  81.     end;
  82.  
  83.  
  84. procedure ClrGr;
  85.     begin
  86.     dummy:= @bdos(158, wrd(0))
  87.     end;
  88.  
  89. procedure SaveWi(x1,y1,x2,y2:integer);
  90.     begin
  91.     ndd.xw:=x1;
  92.     ndd.yw:=y1;
  93.     ndd.xq:=x2;
  94.     ndd.yq:=y2;
  95.     ndd.wt:=addr(speicher);
  96.     dummy:= @bdos(159, wrd(addr(ndd)))
  97.     end;
  98.  
  99.  
  100. procedure LoadWi(x1,y1,x2,y2:integer;inv:byte;over:byte);
  101.     begin
  102.     ndd.xw:=x1;
  103.     ndd.yw:=y1;
  104.     ndd.xq:=x2;
  105.     ndd.yq:=y2;
  106.     ndd.wt:=addr(speicher);
  107.     ndd.sinv:=inv;
  108.     ndd.sover:=over;
  109.     dummy:= @bdos(160, wrd(addr(ndd)))
  110.     end;
  111.  
  112. procedure SaveFW (x1,y1,x2,y2:integer;xk:xyz);
  113.     begin
  114.     srec.xs:=x1;
  115.     srec.ys:=y1;
  116.     srec.xe:=x2;
  117.     srec.ye:=y2;
  118.     srec.car[1]:=xk[1];srec.car[2]:=xk[2];
  119.     srec.car[3]:=xk[3];srec.car[4]:=xk[4];
  120.     srec.car[5]:=xk[5];srec.car[6]:=xk[6];
  121.     srec.car[7]:=xk[7];srec.car[8]:=xk[8];
  122.     dummy:= @bdos(161, wrd(addr(srec)))
  123.     end;
  124.  
  125. procedure LoadFW (x1,y1,x2,y2:integer;xk:xyz;inv:byte;over:byte);
  126.     begin
  127.     srec.xs:=x1;
  128.     srec.ys:=y1;
  129.     srec.xe:=x2;
  130.     srec.ye:=y2;
  131.     srec.car[1]:=xk[1];srec.car[2]:=xk[2];
  132.     srec.car[3]:=xk[3];srec.car[4]:=xk[4];
  133.     srec.car[5]:=xk[5];srec.car[6]:=xk[6];
  134.     srec.car[7]:=xk[7];srec.car[8]:=xk[8];
  135.     srec.linv:=inv;srec.lover:=over;
  136.     dummy:= @bdos(162, wrd(addr(srec)))
  137.     end;
  138.  
  139. procedure GFtext (i,o,z,s,a :integer);
  140.     begin
  141.     textrec.inv:=i;
  142.     textrec.offs:=o;
  143.     textrec.spalte:=s;
  144.     textrec.zeile:=z;
  145.     textrec.addr:=a;
  146.     dummy:= @bdos(163, wrd(addr(textrec)))
  147.    end;
  148.  
  149. procedure scrdump (i:integer);
  150.    begin
  151.    dummy:= @bdos(164, wrd(i))
  152.    end;
  153.  
  154. begin
  155. GrSOn;
  156. mytext[1]:=CHR(10);
  157. mytext[2]:='s';
  158. mytext[3]:='m';
  159. mytext[4]:='a';
  160. mytext[5]:='l';
  161. mytext[6]:='l';
  162. mytext[7]:=' ';
  163. mytext[8]:='d';
  164. mytext[9]:='e';
  165. mytext[10]:='m';
  166. mytext[11]:='o';
  167.  
  168. GFtext(0,0,0,0,addr(mytext));
  169. GFtext(1,0,0,15,addr(mytext));
  170. GFtext(0,1,2,0,addr(mytext));
  171. GFtext(0,0,2,15,addr(mytext));
  172. GFtext(1,0,4,0,addr(mytext));
  173. GFtext(0,1,4,15,addr(mytext));
  174. GFtext(0,0,6,0,addr(mytext));
  175. GFtext(1,0,6,15,addr(mytext));
  176. GFtext(0,1,8,0,addr(mytext));
  177. GFtext(0,0,8,15,addr(mytext));
  178. Gftext(1,0,10,0,addr(mytext));
  179. GFtext(0,1,10,15,addr(mytext));
  180. GFtext(0,0,12,0,addr(mytext));
  181. Gftext(1,0,12,15,addr(mytext));
  182. GFtext(0,1,14,0,addr(mytext));
  183. GFtext(0,0,14,15,addr(mytext));
  184. (*
  185. scrdump(0);
  186. scrdump(1);
  187. èscrdump(2);
  188. scrdump(3);
  189. scrdump(4);
  190. scrdump(5);
  191. scrdump(6);
  192. scrdump(7);
  193. *)
  194. y:=1;
  195. while (y<=150) do
  196.      begin
  197.      for x:=1 to 500 do
  198.           SetPix(x,y);
  199.      y:=y+10
  200.      end;
  201. SaveWi(0,0,100,50);
  202. ClrGr;
  203. LoadWi(0,0,100,50,1,1);
  204. SaveFW(0,0,100,50,'NEWFILE ');
  205. ClrGr;
  206. LoadFW(50,100,150,150,'NEWFILE ',0,0);
  207. LoadFW(70,120,170,170,'NEWFILE ',1,1);
  208. LoadFW(90,140,190,190,'NEWFILE ',0,0);
  209. LoadFW(300,149,400,199,'NEWFILE ',1,1);
  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. y:=1;
  222. while (y<=150) do
  223.      begin
  224.      x:=1;
  225.      while (x<=500) do
  226.         begin
  227.         EraPix(x,y);
  228.         x:=x+2
  229.         end;
  230.      y:=y+10
  231.      end;
  232. GrFOff;
  233. end.
  234.  
  235.  
  236.  
  237.  
  238.