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 / KAYPRO / ARTIST.LBR / ARTIST.PQS / ARTIST.PAS
Pascal/Delphi Source File  |  2000-06-30  |  14KB  |  341 lines
  1. program Artist;
  2.  
  3. {****************************************************************************}
  4. {*  Artist is used with the Kaypro 2-84 and Epson RX80-F/T printer to allow *}
  5. {*  the user to draw on the screen with the Kaypro's graphics and then      *}
  6. {*  dump the graphics to the Epson printer.  The graphic pictures can also  *}
  7. {*  be saved and loaded from a disk file.  The pixels are positioned on     *}
  8. {*  the screen using the numeric key pad.                                   *}
  9. {****************************************************************************}
  10.  
  11. type
  12.     FileName = string[12]; { file name size }
  13.  
  14. var
  15.    X,Y     : integer; { graphic coordinate variables }
  16.    KeyIn   : char; { used for inputing commands and utilities }
  17.    Quit    : boolean; { determines if the program is finished }
  18.    Status  : boolean; { determines if the graphics is on or off }
  19.    Draw    : boolean; { determines if graphics are to be drawn }
  20.    BitMap  : array [1..160,1..100] of boolean; { holds the graphic table }
  21.    FilName : FileName; { file name }
  22.    FilVar  : file of boolean; { file type }
  23.  
  24. procedure LineSpaceGraphic;
  25. {* sets line spacing for graphic characters *}
  26. begin { procedure LineSpaceGraphic }
  27.      write(lst,chr(27),'A',chr(6))
  28. end; { procedure LineSpaceGraphic }
  29.  
  30. procedure GraphicLine;
  31. {* command for printing one line ( 80 ) graphic characters *}
  32. begin { procedure GraphicLine }
  33.      write(lst,chr(27),'K',chr(224),chr(1))
  34. end; { procedure GraphicLine }
  35.  
  36. procedure MasterReset;
  37. {* resets the printer for ASCII characters *}
  38. begin { procedure MasterReset }
  39.      write(lst,chr(27),'@')
  40. end; { procedure MasterReset }
  41.  
  42. procedure PixelOn(X,Y:integer);
  43. {* turns a screen pixel on *}
  44. begin { procedure PixelOn }
  45.      write(chr(27),'*',chr(Y+31),chr(X+31));
  46. end; { procedure PixelOn }
  47.  
  48. procedure PixelOff(X,Y:integer);
  49. {* turns a screen pixel off *}
  50. begin { procedure PixelOff }
  51.      write(chr(27),' ',chr(Y+31),chr(X+31))
  52. end; { procedure PixelOff }
  53.  
  54. procedure CursorOn;
  55. {* turns the screen cursor on *}
  56. begin { procedure CursorOn }
  57.      write(chr(27),'B',4)
  58. end; { procedure CursorOn }
  59.  
  60. procedure CursorOff;
  61. {* turns the screen cursor off *}
  62. begin { procedure CursorOff }
  63.      write(chr(27),'C',4)
  64. end; { procedure CursorOff }
  65.  
  66. procedure Plot(X,Y:integer;Status,Draw:boolean);
  67. {* plots a graphic pixel on the screen and in the BitMap *}
  68. begin { procedure Plot }
  69.      if Draw
  70.      then
  71.         if Status=true
  72.         then
  73.         begin
  74.              PixelOn(X,Y);
  75.              BitMap[X,Y]:=true
  76.         end
  77.         else
  78.         begin
  79.              PixelOff(X,Y);
  80.              BitMap[X,Y]:=false
  81.         end
  82.      else
  83.          if BitMap[X,Y]=true
  84.          then
  85.              PixelOn(X,Y)
  86.          else
  87.              PixelOff(X,Y);
  88. end; { procedure Plot }
  89.  
  90. procedure NewLine;
  91. {* resets line 24 for help menu *}
  92. begin { procedure NewLine }
  93.      GotoXY(1,24);
  94.      DelLine;
  95.      GotoXY(20,24)
  96. end; { procedure NewLine }
  97.  
  98. procedure Menu;
  99. {* contains the help menu and file utilities *}
  100. var
  101.    Xidx,Yidx,Y1,Y2 : integer; { used for BitMap }
  102.    Index               : integer; { used for printing pixels }
  103.    Pixels              : integer; { used for printer graphic handling }
  104.    Ok                  : boolean; { used for file I/O error checking }
  105.    DisplayGraphic      : boolean; { used for returning to graphic screen }
  106.    Data                : boolean; { used for file handling }
  107. begin { procedure Menu }
  108.      DisplayGraphic:=false; { set display boolean }
  109.      CursorOn; { turn on cursor }
  110.      ClrScr; { clears the screen }
  111.      gotoXY(35,2);
  112.      writeln('HELP MENU');
  113.      gotoXY(30,5);
  114.      write('* DRAWING COMMANDS *');
  115.      gotoXY(10,7);
  116.      write('D - begin drawing');
  117.      gotoXY(45,7);
  118.      write('E - begin erasing');
  119.      gotoXY(10,8);
  120.      write('M - move cursor');
  121.      gotoXY(45,8);
  122.      write('B - blank screen');
  123.      gotoXY(10,9);
  124.      write('H - help menu');
  125.      gotoXY(17,11);
  126.      write('Numeric Key Pad controls the pixel positioning');
  127.      gotoXY(30,14);
  128.      write('* UTILITY COMMANDS *');
  129.      gotoXY(10,16);
  130.      write('P - print graphic screen');
  131.      gotoXY(45,16);
  132.      write('R - return to graphic screen');
  133.      gotoXY(10,17);
  134.      write('S - save graphic screen in file');
  135.      gotoXY(45,17);
  136.      write('L - load graphic screen from file');
  137.      gotoXY(10,18);
  138.      write('Q - quit program');
  139.      repeat
  140.            NewLine; { erase command line }
  141.            write('Enter Command : ');
  142.            while not KeyPressed do; { wait until a key is pressed }
  143.            read(KBD,KeyIn); { read input into KeyIn }
  144.            case UpCase(KeyIn) of { make input selection }
  145.                 'P' : begin { print graphic screen }
  146.                            NewLine;
  147.                            LineSpaceGraphic; { set printer line spacing }
  148.                            for Yidx:=1 to 50 do
  149.                            begin
  150.                                 GraphicLine; { set one printer graphic line }
  151.                                 Y2:=2*Yidx; { set even BitMap Y }
  152.                                 Y1:=Y2-1; { set odd BitMap Y }
  153.                                 for Xidx:=1 to 160 do
  154.                                 begin
  155.                                      if BitMap[Xidx,Y1]=false
  156.                                      then
  157.                                          if BitMap[Xidx,Y2]=false
  158.                                          then
  159.                                              Pixels:=0
  160.                                          else
  161.                                              Pixels:=7
  162.                                      else
  163.                                          if BitMap[Xidx,Y2]=false
  164.                                          then
  165.                                              Pixels:=56
  166.                                          else
  167.                                              Pixels:=63;
  168.                                      for Index:=1 to 3 do { print pixels }
  169.                                          write(lst,chr(Pixels))
  170.                                 end
  171.                            end;
  172.                            MasterReset
  173.                       end;
  174.                 'R' : begin { return to graphic screen }
  175.                            CursorOff; { turn cursor off }
  176.                            ClrScr; { clear screen }
  177.                            Draw:=true; { enable graphic draw }
  178.                            for Yidx:=1 to 100 do
  179.                                for Xidx:=1 to 160 do
  180.                                    Plot(Xidx,Yidx,BitMap[Xidx,Yidx],Draw);
  181.                            Status:=false; { set pixel off }
  182.                            Draw:=false; { disable graphic draw }
  183.                            X:=1;
  184.                            Y:=1;
  185.                            DisplayGraphic:=true { set display boolean }
  186.                      end;
  187.                 'S' : begin { save graphic screen in a file }
  188.                            NewLine;
  189.                            write('Enter file name : ');
  190.                            read(FilName);
  191.                            assign(FilVar,FilName);
  192.                            {$I-} reset(FilVar) {$I+};
  193.                            OK:=(IOresult=0); { check for I/O error }
  194.                            if (not OK)
  195.                            then
  196.                            begin
  197.                                 NewLine;
  198.                                 write('New file : ',FilName);
  199.                                 delay(2500);
  200.                                 rewrite(FilVar)
  201.                            end;
  202.                            NewLine;
  203.                            for Yidx:=1 to 100 do
  204.                                for Xidx:=1 to 160 do
  205.                                begin
  206.                                     Data:=BitMap[Xidx,Yidx];
  207.                                     write(FilVar,Data)
  208.                                end;
  209.                            Close(FilVar)
  210.                       end;
  211.                 'L' : begin { load graphic screen from a file }
  212.                            NewLine;
  213.                            write('Enter file name : ');
  214.                            read(FilName);
  215.                            assign(FilVar,FilName);
  216.                            {$I-} reset(FilVar) {$I+};
  217.                            OK:=(IOresult=0); { check for I/O error }
  218.                            if (not OK)
  219.                            then
  220.                            begin
  221.                                 NewLine;
  222.                                 write('Cannot locate file : ',FilName);
  223.                                 delay(2500)
  224.                            end
  225.                            else
  226.                            begin
  227.                                 NewLine;
  228.                                 for Yidx:=1 to 100 do
  229.                                     for Xidx:=1 to 160 do
  230.                                     begin
  231.                                          read(FilVar,Data);
  232.                                          BitMap[Xidx,Yidx]:=Data
  233.                                     end;
  234.                                 Close(FilVar)
  235.                            end
  236.                       end;
  237.                 'Q' : begin { quit program }
  238.                            Quit:=true
  239.                       end;
  240.            end; { case UpCase(KeyIn) of }
  241.      until (DisplayGraphic) or (Quit)
  242. end; { procedure Menu }
  243.  
  244. procedure BlankGraphics;
  245. {* clears the graphic screen and BitMap *}
  246. var
  247.    Xidx,Yidx : integer; { BitMap indexes }
  248. begin { procedure BlankGraphics }
  249.      ClrScr;
  250.      for Yidx:=1 to 100 do
  251.          for Xidx:=1 to 160 do
  252.              BitMap[Xidx,Yidx]:=false;
  253.      X:=1;
  254.      Y:=1
  255. end; { procedure BlankGraphics }
  256.  
  257. begin { program Artist }
  258.      Quit:=false; { set program end boolean to false }
  259.      CursorOff; { turn cursor off }
  260.      BlankGraphics; { clear graphic screen }
  261.      gotoXY(23,10);
  262.      write('******** THE KAYPRO ARTIST ********');
  263.      gotoXY(32,12);
  264.      write('by Scott Reinhart');
  265.      gotoXY(27,15);
  266.      write('-- type H for help menu --');
  267.      gotoXY(30,17);
  268.      write('-- type D to draw --');
  269.      repeat { wait for valid input }
  270.            while not KeyPressed do; { wait for input }
  271.            read(KBD,KeyIn)
  272.      until (UpCase(KeyIn)='H') or (UpCase(KeyIn)='D') ;
  273.      if UpCase(KeyIn)='H'
  274.      then
  275.          Menu { display help menu }
  276.      else
  277.          ClrScr; { clear screen }
  278.      while not Quit do
  279.            begin
  280.                 while not KeyPressed do { flash  pixel until a key is pressed }
  281.                       begin
  282.                            PixelOn(X,Y);
  283.                            delay(50);
  284.                            PixelOff(X,Y);
  285.                            delay(50);
  286.                       end;
  287.                 Plot(X,Y,Status,Draw); { plot current pixel position }
  288.                 read(KBD,KeyIn); { read input into KeyIn }
  289.                 case UpCase(KeyIn) of { make input selection }
  290.                      'H' : begin { display help menu }
  291.                                 Menu
  292.                            end;
  293.                      'B' : begin { clear screen and BitMap }
  294.                                 BlankGraphics
  295.                            end;
  296.                      'M' : begin { move cursor }
  297.                                 Draw:=false;
  298.                                 Status:=false
  299.                            end;
  300.                      'D' : begin { turn pixels on }
  301.                                 Draw:=true;
  302.                                 Status:=true
  303.                            end;
  304.                      'E' : begin { turn pixels off }
  305.                                 Draw:=true;
  306.                                 Status:=false
  307.                            end;
  308.                      '1' :begin { move pixel SW direction }
  309.                                if X>1 then X:=X-1;
  310.                                if Y<100 then Y:=Y+1;
  311.                           end;
  312.                      '2' : begin { move pixel S direction }
  313.                                 if Y<100 then Y:=Y+1;
  314.                            end;
  315.                      '3' : begin { move pixel SE direction }
  316.                                 if X<160 then X:=X+1;
  317.                                 if Y<100 then Y:=Y+1;
  318.                            end;
  319.                      '4' : begin { move pixel W direction }
  320.                                 if X>1 then X:=X-1;
  321.                            end;
  322.                      '6' : begin { move pixel E direction }
  323.                                 if X<160 then X:=X+1;
  324.                            end;
  325.                      '7' : begin { move pixel NW direction }
  326.                                 if X>1 then X:=X-1;
  327.                                 if Y>1 then Y:=Y-1;
  328.                            end;
  329.                      '8' : begin { move pixel N direction }
  330.                                 if Y>1 then Y:=Y-1;
  331.                            end;
  332.                      '9' : begin { move pixel NE direction }
  333.                                 if X<160 then X:=X+1;
  334.                                 if Y>1 then Y:=Y-1;
  335.                            end;
  336.                 end; { case UpCase(KeyIn) of }
  337.            end; { while not Quit do }
  338.      ClrScr; { clear screen }
  339.      CursorOn { turn cursor on }
  340. end. { program Artist }
  341.