home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0051_Create Chars in Graphics.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-21  |  9.8 KB  |  303 lines
  1.  
  2.   { This program allows you to create characters using the GRAPHICS unit
  3.     supplied otherwise with the SWAG routines. If you have any questions
  4.     on these routines, please let me know.
  5.  
  6.     MICHAEL HOENIE - Intelec Pascal Moderator.  }
  7.  
  8.   program charedit;
  9.  
  10.   uses dos, crt;
  11.  
  12.   const numnewchars=1;
  13.  
  14.   type
  15.     string80=string[80];
  16.  
  17.   var { all variables inside of the game }
  18.     char_map:array[1..16] of string[8];
  19.     xpos,ypos,x,y,z:integer;
  20.     out,incom:string[255];
  21.     charout:char;
  22.     outfile:text;
  23.     char:array[1..16] of byte;
  24.  
  25.     procedure loadchar;
  26.     type
  27.       bytearray=array[0..15] of byte;
  28.       chararray=record
  29.         charnum:byte;
  30.         chardata:bytearray;
  31.       end;
  32.     var
  33.       regs:registers;
  34.       newchars:chararray;
  35.     begin
  36.       with regs do
  37.         begin
  38.           ah:=$11;   { video sub-Function $11 }
  39.           al:=$0;    { Load Chars to table $0 }
  40.           bh:=$10;   { number of Bytes per Char $10 }
  41.           bl:=$0;    { Character table to edit }
  42.           cx:=$1;    { number of Chars we're definig $1}
  43.           dx:=176;
  44.           for x:=0 to 15 do newchars.chardata[x]:=char[x+1];
  45.           es:=seg(newchars.chardata);
  46.           bp:=ofs(newchars.chardata);
  47.           intr($10,regs);
  48.         end;
  49.     end;
  50.  
  51.   Procedure FastWrite(Col,Row,Attrib:Byte; Str:string80);
  52.   begin
  53.     inline
  54.       ($1E/$1E/$8A/$86/row/$B3/$50/$F6/$E3/$2B/$DB/$8A/$9E/col/
  55.       $03/$C3/$03/$C0/$8B/$F8/$be/$00/$00/$8A/$BE/attrib/
  56.       $8a/$8e/str/$22/$c9/$74/$3e/$2b/$c0/$8E/$D8/$A0/$49/$04/
  57.       $1F/$2C/$07/$74/$22/$BA/$00/$B8/$8E/$DA/$BA/$DA/$03/$46/
  58.       $8a/$9A/str/$EC/$A8/$01/$75/$FB/$FA/$EC/$A8/$01/$74/$FB/
  59.       $89/$1D/$47/$47/$E2/$Ea/$2A/$C0/$74/$10/$BA/$00/$B0/
  60.       $8E/$DA/$46/$8a/$9A/str/$89/$1D/$47/$47/$E2/$F5/$1F);
  61.   end;
  62.  
  63.   procedure initalize;
  64.  
  65.   begin
  66.     for x:=1 to 16 do char[x]:=0;
  67.     xpos:=1;
  68.     ypos:=1;
  69.     for x:=1 to 16 do char_map[x]:='        '; { clear it out }
  70.   end;
  71.  
  72.   procedure display_screen;
  73.   begin
  74.     loadchar;
  75.      fastwrite(1,1,$1F,'         CHAREDIT - By Michael S. Hoenie         ');
  76.      fastwrite(1,2,$7,'      12345678   ┌─────Data');
  77.      fastwrite(1,3,$7,'     ▄▄▄▄▄▄▄▄▄▄  │');
  78.      fastwrite(1,4,$7,'   1 █        █ 000');
  79.      fastwrite(1,5,$7,'   2 █        █ 000 Single:  ░');
  80.      fastwrite(1,6,$7,'   3 █        █ 000');
  81.      fastwrite(1,7,$7,'   4 █        █ 000 Multiple:');
  82.      fastwrite(1,8,$7,'   5 █        █ 000');
  83.      fastwrite(1,9,$7,'   6 █        █ 000     ░░░░░░');
  84.     fastwrite(1,10,$7,'   7 █        █ 000     ░░░░░░');
  85.     fastwrite(1,11,$7,'   8 █        █ 000     ░░░░░░');
  86.     fastwrite(1,12,$7,'   9 █        █ 000                    U            ');
  87.     fastwrite(1,13,$7,'  10 █        █ 000 f1=paint spot      │    MOVEMENT');
  88.     fastwrite(1,14,$7,'  11 █        █ 000 f2=erase spot   L──┼──R         ');
  89.     fastwrite(1,15,$7,'  12 █        █ 000  S=save char       │            ');
  90.     fastwrite(1,16,$7,'  13 █        █ 000  Q=quit editor     D');
  91.     fastwrite(1,17,$7,'  14 █        █ 000  C=reset char    r=scroll-right');
  92.     fastwrite(1,18,$7,'  15 █        █ 000  l=scroll-left');
  93.     fastwrite(1,19,$7,'  16 █        █ 000  r=scroll-right');
  94.     fastwrite(1,20,$7,'     ▀▀▀▀▀▀▀▀▀▀      u=scroll-up');
  95.   end;
  96.  
  97.   procedure calculate_char;
  98.   begin
  99.     for x:=1 to 16 do char[x]:=0;
  100.     for x:=1 to 16 do
  101.       begin
  102.         fastwrite(7,x+3,$4F,char_map[x]);
  103.         incom:=char_map[x];
  104.         y:=0;
  105.         if copy(incom,1,1)='█' then y:=y+1;
  106.         if copy(incom,2,1)='█' then y:=y+2;
  107.         if copy(incom,3,1)='█' then y:=y+4;
  108.         if copy(incom,4,1)='█' then y:=y+8;
  109.         if copy(incom,5,1)='█' then y:=y+16;
  110.         if copy(incom,6,1)='█' then y:=y+32;
  111.         if copy(incom,7,1)='█' then y:=y+64;
  112.         if copy(incom,8,1)='█' then y:=y+128;
  113.         char[x]:=y;
  114.       end;
  115.     for x:=1 to 16 do
  116.       begin
  117.         str(char[x],incom);
  118.         while length(incom)<3 do insert(' ',incom,1);
  119.         fastwrite(17,x+3,$4E,incom);
  120.       end;
  121.     loadchar;
  122.   end;
  123.  
  124.   procedure do_online;
  125.   var
  126.     done:boolean;
  127.     int1,int2,int3:integer;
  128.   begin
  129.  
  130.  
  131.     done:=false;
  132.     int1:=0;
  133.     int2:=0;
  134.     int3:=0;
  135.     while not done do
  136.       begin
  137.         incom:=copy(char_map[ypos],xpos,1);
  138.         int1:=int1+1;
  139.         if int1>150 then int2:=int2+1;
  140.         if int2>4 then
  141.           begin
  142.             int1:=0;
  143.             int3:=int3+1;
  144.             if int3>2 then int3:=1;
  145.             case int3 of
  146.               1:fastwrite(xpos+6,ypos+3,$F,incom);
  147.               2:fastwrite(xpos+6,ypos+3,$F,'');
  148.             end;
  149.           end;
  150.  
  151. { this section moved over to be transferred across the network. }
  152.  
  153. if keypressed then
  154.   begin
  155.     charout:=readkey;
  156.     out:=charout;
  157.     if ord(out[1])=0 then
  158.       begin
  159.         charout:=readkey;
  160.         out:=charout;
  161.         fastwrite(60,2,$2F,out);
  162.         case out[1] of
  163.           ';':begin { F1 }
  164.                 delete(char_map[ypos],xpos,1);
  165.                 insert('█',char_map[ypos],xpos);
  166.                 calculate_char;
  167.               end;
  168.           '<':begin { F2 }
  169.                 delete(char_map[ypos],xpos,1);
  170.                 insert(' ',char_map[ypos],xpos);
  171.                 calculate_char;
  172.               end;
  173.           'H':begin { up }
  174.                 ypos:=ypos-1;
  175.                 if ypos<1 then ypos:=16;
  176.                 calculate_char;
  177.               end;
  178.           'P':begin { down }
  179.                 ypos:=ypos+1;
  180.                 if ypos>16 then ypos:=1;
  181.                 calculate_char;
  182.               end;
  183.           'K':begin { left }
  184.                 xpos:=xpos-1;
  185.                 if xpos<1 then xpos:=8;
  186.                 calculate_char;
  187.               end;
  188.           'M':begin { right }
  189.                 xpos:=xpos+1;
  190.                 if xpos>8 then xpos:=1;
  191.                 calculate_char;
  192.               end;
  193.         end;
  194.       end else
  195.  
  196.  
  197.         begin { regular keys }
  198.           case out[1] of
  199.             'Q','q':begin { done }
  200.                       clrscr;
  201.                       write('Are you SURE you want to quit? (Y/n) ? ');
  202.                       readln(incom);
  203.                       case incom[1] of
  204.                         'Y','y':done:=true;
  205.                       end;
  206.                       clrscr;
  207.                       display_screen;
  208.                       calculate_char;
  209.                     end;
  210.             'S','s':begin { save }
  211.                       assign(outfile,'chardata.txt');
  212.                       {$i-} reset(outfile) {$i+};
  213.                       if (ioresult)>=1 then rewrite(outfile);
  214.                       append(outfile);
  215.                       writeln(outfile,'Character Char:');
  216.                       writeln(outfile,'');
  217.                       writeln(outfile,'       12345678');
  218.                       for x:=1 to 16 do
  219.                         begin
  220.                           str(x,out);
  221.                           while length(out)<6 do insert(' ',out,1);
  222.                           writeln(outfile,out+char_map[x]);
  223.                         end;
  224.                       writeln(outfile,'');
  225.                       write(outfile,'Chardata:');
  226.                       for x:=1 to 15 do
  227.                         begin
  228.                           str(char[x],incom);
  229.                           write(outfile,incom+',');
  230.                         end;
  231.                       str(char[16],incom);
  232.                       writeln(outfile,incom);
  233.                       writeln(outfile,'-----------------------------');
  234.                       close(outfile);
  235.                       clrscr;
  236.                       writeln('File was saved under CHARDATA.TXT.');
  237.                       writeln;
  238.                       write('Press ENTER to continue ? ');
  239.                       readln(incom);
  240.                       clrscr;
  241.                       display_screen;
  242.                       calculate_char;
  243.                     end;
  244.             'U','u':begin { move entire char up }
  245.                      incom:=char_map[1];
  246.                      for x:=2 to 16 do char_map[x-1]:=char_map[x];
  247.                      char_map[16]:=incom;
  248.                      calculate_char;
  249.                     end;
  250.             'R','r':begin { move entire char to the right }
  251.                       for x:=1 to 16 do
  252.                         begin
  253.                           out:=copy(char_map[x],8,1);
  254.                           incom:=copy(char_map[x],1,7);
  255.                           char_map[x]:=out+incom;
  256.                         end;
  257.                       calculate_char;
  258.                     end;
  259.             'L','l':begin { move entire char to the left }
  260.                       for x:=1 to 16 do
  261.  
  262.  
  263.                         begin
  264.                           out:=copy(char_map[x],1,1);
  265.                           incom:=copy(char_map[x],2,7);
  266.                           char_map[x]:=incom+out;
  267.                         end;
  268.                       calculate_char;
  269.                     end;
  270.             'D','d':begin { move entire char down }
  271.                       incom:=char_map[16];
  272.                       for x:=16 downto 2 do char_map[x]:=char_map[x-1];
  273.                       char_map[1]:=incom;
  274.                       calculate_char;
  275.                     end;
  276.             'C','c':begin { reset }
  277.                       clrscr;
  278.                       write('Are you SURE you want to clear it? (Y/n) ? ');
  279.                       readln(incom);
  280.                       case incom[1] of
  281.                         'Y','y':initalize;
  282.                       end;
  283.                       clrscr;
  284.                       display_screen;
  285.                       calculate_char;
  286.                     end;
  287.           end;
  288.         end;
  289.   end;
  290.       end;
  291.   end;
  292.  
  293.   begin
  294.     textmode(c80);
  295.     initalize;
  296.     display_screen;
  297.     calculate_char;
  298.     do_online;
  299.     clrscr;
  300.     writeln('Thanks for using CHAREDIT!');
  301.   end.
  302.  
  303.