8bitfiles.net/archives/archives.tar/archives/genie-commodore-file-library/C128CPM/GRC128.ZIP/BIGWINI.SRC

Text File | 1991-06-15 | 14.5 KB | 466 lines

    type
         tsrec = record
           xs:integer;
           ys: integer;
           xe:integer;
           ye:integer;
           car:array[1..8] of char;
           linv:byte;
           lover:byte
         end;


         nstr=record
           xw:integer;
           yw:integer;
           xq:integer;
           yq:integer;
           wt:integer;
           sinv:byte;
           sover:byte
          end;

         feld=array [1..4096] of byte;

         ttextrec = record
            inv:integer;
            offs:integer;
            zeile:integer;
            spalte:integer;
            addr:integer
          end;

        xrec = record
           kx:integer;
           ky:integer
        end;

        xyz = array [1..8] of char;

var  ndd:nstr;
     speicher:feld;
     lrec:xrec;
     textrec:ttextrec;
     s,e:integer;
     srec,erec:tsrec;
     x,y:integer;
     mytext:string [11];
     ch:char;
     dummy : integer;

external function @bdos(func:integer;parm:word):integer;

procedure GrFOn;
   begin
   dummy:= @bdos(153, wrd(0))
   end;

procedure GrSOn;
   begin
   dummy:= @bdos(154, wrd(0))
   end;

procedure GrFOff;
   begin
   dummy:= @bdos(155, wrd(0))
   end;


procedure SetPix(xp,yp:integer);
   begin
   lrec.kx:=xp;lrec.ky:=yp;
   dummy:= @bdos(156, wrd(addr(lrec)))
   end;

procedure EraPix (xp,yp:integer);
    begin
    lrec.kx:=xp;lrec.ky:=yp;
    dummy:= @bdos(157, wrd(addr(lrec)))
    end;


procedure ClrGr;
    begin
    dummy:= @bdos(158, wrd(0))
    end;

procedure SaveWi(x1,y1,x2,y2:integer);
    begin
    ndd.xw:=x1;
    ndd.yw:=y1;
    ndd.xq:=x2;
    ndd.yq:=y2;
    ndd.wt:=addr(speicher);
    dummy:= @bdos(159, wrd(addr(ndd)))
    end;


procedure LoadWi(x1,y1,x2,y2:integer;inv:byte;over:byte);
    begin
    ndd.xw:=x1;
    ndd.yw:=y1;
    ndd.xq:=x2;
    ndd.yq:=y2;
    ndd.wt:=addr(speicher);
    ndd.sinv:=inv;
    ndd.sover:=over;
    dummy:= @bdos(160, wrd(addr(ndd)))
    end;

procedure SaveFW (x1,y1,x2,y2:integer;xk:xyz);
    begin
    srec.xs:=x1;
    srec.ys:=y1;
    srec.xe:=x2;
    srec.ye:=y2;
    srec.car[1]:=xk[1];srec.car[2]:=xk[2];
    srec.car[3]:=xk[3];srec.car[4]:=xk[4];
    srec.car[5]:=xk[5];srec.car[6]:=xk[6];
    srec.car[7]:=xk[7];srec.car[8]:=xk[8];
    dummy:= @bdos(161, wrd(addr(srec)))
    end;

procedure LoadFW (x1,y1,x2,y2:integer;xk:xyz;inv:byte;over:byte);
    begin
    srec.xs:=x1;
    srec.ys:=y1;
    srec.xe:=x2;
    srec.ye:=y2;
    srec.car[1]:=xk[1];srec.car[2]:=xk[2];
    srec.car[3]:=xk[3];srec.car[4]:=xk[4];
    srec.car[5]:=xk[5];srec.car[6]:=xk[6];
    srec.car[7]:=xk[7];srec.car[8]:=xk[8];
    srec.linv:=inv;srec.lover:=over;
    dummy:= @bdos(162, wrd(addr(srec)))
    end;

procedure GFtext (i,o,z,s,a :integer);
    begin
    textrec.inv:=i;
    textrec.offs:=o;
    textrec.spalte:=s;
    textrec.zeile:=z;
    textrec.addr:=a;
    dummy:= @bdos(163, wrd(addr(textrec)))
   end;

procedure scrdump (i:integer);
   begin
   dummy:= @bdos(164, wrd(i))
   end;

procedure SaveBX (x1,y1,x2,y2:integer;xk:xyz);
    var filename:xyz;
        xdiff,ydiff,xanz,yanz,zaehler:integer;
        xstart,ystart,zhl1,zhl2,start:integer;
        wert:byte;
        xeven,yeven:integer;

              begin (* beide zu gross *)
              filename:=xk;
              xdiff:=x2-x1;
              ydiff:=y2-y1;
              xanz:=xdiff div 96;
              yanz:=ydiff div 50;
              xeven:=xdiff div 96;
              yeven:=ydiff div 50;
              ystart:=y1;
              for zhl2:= 1 to yanz do
                  begin
                  xstart:=x1;
                  for zhl1:= 1 to xanz do
                      begin
                      SaveFW(xstart,ystart,xstart+96,ystart+50,filename);
                      xstart:=xstart+96;
                      wert:=ord(filename[8])-ord('0');
                      if wert <> 9 then
                         begin
                         wert:=wert+1;
                         filename[8]:=chr(ord('0')+wert)
                         end
                      else
                         begin
                         filename[8]:='0';
                         wert:=ord(filename[7])-ord('0');
                         wert:=wert+1;
                         filename[7]:=chr(ord('0')+wert)
                         end;

                      if ((zhl1 = xanz) and (xeven <> 0)) then
                          begin
                          SaveFW(xstart,ystart,xstart+xeven,ystart,filename);
                          wert:=ord(filename[8])-ord('0');
                          if wert <> 9 then
                            begin
                            wert:=wert+1;
                            filename[8]:=chr(ord('0')+wert)
                            end
                          else
                            begin
                            filename[8]:='0';
                            wert:=ord(filename[7])-ord('0');
                            wert:=wert+1;
                            filename[7]:=chr(ord('0')+wert)
                            end
                          end
                      end;
                  ystart:=ystart+50
                  end;
              if (yeven <> 0) then
                   begin
                   xanz:=xdiff div 96;
                   xeven:=xdiff mod 96;
                   start:=x1;
                   for zaehler:=1 to xanz do
                       begin
                       SaveFW(start,ystart,start+96,ystart+yeven,filename);
                       start:=start+96;
                       wert:=ord(filename[8])-ord('0');    (* klklk *)
                      if wert <> 9 then
                         begin
                         wert:=wert+1;
                         filename[8]:=chr(ord('0')+wert)
                         end
                      else
                         begin
                         filename[8]:='0';
                         wert:=ord(filename[7])-ord('0');
                         wert:=wert+1;
                         filename[7]:=chr(ord('0')+wert)
                         end;
                     if (zaehler=xanz) and (xeven <> 0) then
                     SaveFW(start,ystart,start+xeven,ystart+yeven,filename)
                 end
              end
            end;

procedure SaveBW (x1,y1,x2,y2:integer;xk:xyz);
    var filename:xyz;
        xdiff,ydiff,xanz,yanz,zaehler:integer;
        xstart,ystart,zhl1,zhl2,start:integer;
        wert:byte;
        xeven,yeven:integer;
    begin
    filename:=xk;
    filename[7]:='0';filename[8]:='0';
    xdiff:=x2-x1;
    ydiff:=y2-y1;
    if ((xdiff<=96) and (ydiff<=50)) then
       SaveFW(x1,y1,x2,y2,filename)
    else
       if ((xdiff>96) and (ydiff<=50)) then
          begin
          xanz:=xdiff div 96;
          xeven:=xdiff mod 96;
          start:=x1;
          for zaehler:=1 to xanz do
              begin
              SaveFW(start,y1,start+96,y2,filename);
              start:=start+96;
              wert:=ord(filename[8])-ord('0');    (* klklk *)
              if wert <> 9 then
                 begin
                 wert:=wert+1;
                 filename[8]:=chr(ord('0')+wert)
                 end
              else
                 begin
                 filename[8]:='0';
                 wert:=ord(filename[7])-ord('0');
                 wert:=wert+1;
                 filename[7]:=chr(ord('0')+wert)
                 end;
                 if (zaehler=xanz) and (xeven <> 0) then
                     SaveFW(start,y1,start+xeven,y2,filename)
              end
          end

       else
          if ((xdiff<=96) and (ydiff > 50)) then
              begin
              yanz:=ydiff div 50;
              yeven:=ydiff mod 50;
              start:=y1;
              for zaehler:=1 to yanz do
                  begin
                  SaveFW(x1,start,x2,start+50,filename);
                  start:=start+50;
                  wert:=ord(filename[8])-ord('0');
                  if wert <> 9 then
                     begin
                     wert:=wert+1;
                     filename[8]:=chr(ord('0')+wert)
                     end
                  else
                     begin
                     filename[8]:='0';
                     wert:=ord(filename[7])-ord('0');
                     wert:=wert+1;
                     filename[7]:=chr(ord('0')+wert)
                     end;
                  if ((zaehler = yanz) and (yeven <> 0)) then
                      SaveFW(x1,start,x2,start+yeven,filename);
                  end
              end
           else
               SaveBX(x1,y1,x2,y2,filename);
          end;

procedure LoadBX (x1,y1,x2,y2:integer;xk:xyz;inv:byte;over:byte);
    var filename:xyz;
        xdiff,ydiff,xanz,yanz,zaehler:integer;
        xstart,ystart,zhl1,zhl2,start:integer;
        wert:byte;
        xeven,yeven:integer;

              begin (* beide zu gross *)
              filename:=xk;
              xdiff:=x2-x1;
              ydiff:=y2-y1;
              xanz:=xdiff div 96;
              yanz:=ydiff div 50;
              xeven:=xdiff mod 96;
              yeven:=xdiff mod 50;
              ystart:=y1;
              for zhl2:= 1 to yanz do
                  begin
                  xstart:=x1;
                  for zhl1:= 1 to xanz do
                      begin
                      LoadFW(xstart,ystart,xstart+96,ystart+50,filename,inv,over);
                      xstart:=xstart+96;
                      wert:=ord(filename[8])-ord('0');
                      if wert <> 9 then
                         begin
                         wert:=wert+1;
                         filename[8]:=chr(ord('0')+wert)
                         end
                      else
                         begin
                         filename[8]:='0';
                         wert:=ord(filename[7])-ord('0');
                         wert:=wert+1;
                         filename[7]:=chr(ord('0')+wert)
                         end;

                      if ((zhl1 = xanz) and (xeven <> 0)) then
                         begin
                         LoadFW(xstart,ystart,xstart+xeven,ystart+50,filename,inv,over);
                         wert:=ord(filename[8])-ord('0');
                         if wert <> 9 then
                            begin
                            wert:=wert+1;
                            filename[8]:=chr(ord('0')+wert)
                            end
                          else
                            begin
                            filename[8]:='0';
                            wert:=ord(filename[7])-ord('0');
                            wert:=wert+1;
                            filename[7]:=chr(ord('0')+wert)
                            end
                         end
                      end;
                  ystart:=ystart+50
                  end;
              if (yeven <> 0) then
                   begin
                   xanz:=xdiff div 96;
                   xeven:=xdiff mod 96;
                   start:=x1;
                   for zaehler:=1 to xanz do
                       begin
                       LoadFW(start,ystart,start+96,ystart+yeven,filename,inv,over);
                       start:=start+96;
                       wert:=ord(filename[8])-ord('0');    (* klklk *)
                      if wert <> 9 then
                         begin
                         wert:=wert+1;
                         filename[8]:=chr(ord('0')+wert)
                         end
                      else
                         begin
                         filename[8]:='0';
                         wert:=ord(filename[7])-ord('0');
                         wert:=wert+1;
                         filename[7]:=chr(ord('0')+wert)
                         end;
                     if (zaehler=xanz) and (xeven <> 0) then
                     LoadFW(start,ystart,start+xeven,ystart+yeven,filename,inv,over)
                     end
                  end
               end;


procedure LoadBW (x1,y1,x2,y2:integer;xk:xyz;inv:byte;over:byte);
    var filename:xyz;
        xdiff,ydiff,xanz,yanz,zaehler:integer;
        xstart,ystart,zhl1,zhl2,start:integer;
        wert:byte;
        xeven,yeven:integer;

    begin
    filename:=xk;
    filename[7]:='0';filename[8]:='0';
    xdiff:=x2-x1;
    ydiff:=y2-y1;
    if ((xdiff<=96) and (ydiff<=50)) then
       LoadFW(x1,y1,x2,y2,filename,inv,over)
    else
       if ((xdiff>96) and (ydiff<=50)) then
          begin
          xanz:=xdiff div 96;
          xeven:=xdiff mod 96;
          start:=x1;
          for zaehler:=1 to xanz do
              begin
              LoadFW(start,y1,start+96,y2,filename,inv,over);
              start:=start+96;
              wert:=ord(filename[8])-ord('0');    (* klklk *)
              if wert <> 9 then
                 begin
                 wert:=wert+1;
                 filename[8]:=chr(ord('0')+wert)
                 end
              else
                 begin
                 filename[8]:='0';
                 wert:=ord(filename[7])-ord('0');
                 wert:=wert+1;
                 filename[7]:=chr(ord('0')+wert)
                 end;
              if ((zaehler = xanz) and (xeven <> 0)) then
                 LoadFW(start,y1,start+xeven,y2,filename,inv,over)
              end
          end
       else
          if ((xdiff<=96) and (ydiff > 50)) then
              begin
              yanz:=ydiff div 50;
              start:=y1;
              for zaehler:=1 to yanz do
                  begin
                  LoadFW(x1,start,x2,start+50,filename,inv,over);
                  start:=start+50;
                  wert:=ord(filename[8])-ord('0');
                  if wert <> 9 then
                     begin
                     wert:=wert+1;
                     filename[8]:=chr(ord('0')+wert)
                     end
                  else
                     begin
                     filename[8]:='0';
                     wert:=ord(filename[7])-ord('0');
                     wert:=wert+1;
                     filename[7]:=chr(ord('0')+wert)
                     end;
                  if ((zaehler = yanz) and (yeven <> 0)) then
                     LoadFW(x1,start,x2,start+yeven,filename,inv,over)
                  end
              end
          else
               LoadBX(x1,y1,x2,y2,filename,inv,over)
           end;