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 / BEEHIVE / UTILITYS / PUDD.ARC / PUDD.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-11  |  8KB  |  197 lines
  1. {..a drawing program for the televideo.
  2.    see Pudd.doc for full info           }
  3.  
  4.  
  5. program   pudd(input,output);
  6.  
  7. type  pointlist = array[1..126] of integer;
  8.       {..........an array of max 63 (x,y) pairs for the polyline function }
  9.       screenline = string[80];
  10.       {............a string passed to chargraph for writing on the screen }
  11.       DefTypes   = string[13];
  12.       ScanLine   = array[1..80] of byte; {....this is for GetLine }
  13.       filename =   string[8]   ;       {--------------------------}
  14.       filetype =   string[3]   ;        { these are for file io   }
  15.       fullname =   string[14]  ;       {--------------------------}
  16.       Blist    =   string[8]   ;       {.....used in *byte procedures  }
  17.       HexString=   string[4]   ;       {....used in drawrow            }
  18.       typicalstring = string[15];
  19.       textfile   = text;
  20.  
  21. var xpoz,ypoz,counter :integer; {.....xPoz,yPoz are crosshair position   }
  22.     speed             :integer; {.... of crosshair movement              }
  23.     size              :integer; {..... of crosshair                      }
  24.     direction         :integer; {..... of crosshair movement             }
  25.     title             :screenline; {....enter text on the graphic screen }
  26.     message           :screenline; {....as above                         }
  27.     response          :char;     {..........generally useful             }
  28.     x1,y1,x2,y2       :integer;  {....x1,y1 are graphic curser position  }
  29.     vLineStyle,vLineColor :DefTypes;  {----------------------------------}
  30.     vFillStyle            :DefTypes;    { watch out, most of these are   }
  31.     vFillIndex            :integer;     { used in a global fashion       }
  32.     vFillColor,vWriteMode :DefTypes;  {----------------------------------}
  33.     i,j,k                 :integer;   {........generally useful          }
  34.     name                  :filename    ;       {-------------------------}
  35.     ftype                 :filetype    ;       { for file io   /        -}
  36.     UseFile               :fullname    ;       {              /         -}
  37.     drive                 :char        ;       {             /          -}
  38.     X,Y                   :integer     ;       {            /           -}
  39.     DiskFile              :file        ;       {           /            -}
  40.     ByteList              :scanline    ;       {          /             -}
  41.     TransBuff             :array[1..640] of byte;  {_____/              -}
  42.  
  43. {$I tools1.pas}       { ...basic graphic tools: }
  44.                       {     charcolor
  45.                             CharGraph
  46.                             initgraph
  47.                             cleargraph
  48.                             setline
  49.                             linecolor
  50.                             writemode}
  51.  
  52. {$I tools2.pas}       {....basic graphic tools: }
  53.                       {     moveto
  54.                             drawto
  55.                             alphamode
  56.                             polyline
  57.                             getline}
  58. {$I tools3.pas}       {....curser movement tools }
  59.                       {    xhair
  60.                            movXhair
  61.                            initXhair
  62.                            reInitXhair
  63.                            offXhair}
  64. {$I tools4.pas}       {....fill & bar tools }
  65.                       {     fillbar
  66.                             filltypes}
  67.  
  68. {$I GenTools.pas}     {....general bit and byte manipulations }
  69.                       {     clrbitB
  70.                             setbitB
  71.                             ReadByte
  72.                             Fliplist}
  73. {$I filetool.pas}     {....file handling tools }
  74.                       {     Exist
  75.                             CurrDrive
  76.                             NewDrive
  77.                             GetDrive
  78.                             Checkstring
  79.                             UpCaseString
  80.                             GetType
  81.                             FetchName
  82.                             BackFile
  83.                             NewFileName
  84.                             OldFileName}
  85. {$I Pudd-01.pas}      {....drawing procedures and global initalization }
  86.                       {     PointSet
  87.                             MoveCross
  88.                             DrawNext
  89.                             LineNext
  90.                             InitDefault
  91.                             SetTypes}
  92. {$I Pudd-02.pas}      {....arrows, text, menus etc }
  93.                       {     HeadLine
  94.                             SpeedSet
  95.                             ClrSomeScr
  96.                             Extensive
  97.                             Set1, Set2, .... SetN
  98.                             Status
  99.                             CleanUp
  100.                             text
  101.                             Arrow}
  102. {$I Pudd-03.pas}      {....disk to screen io }
  103.                       {     DrawRow
  104.                             Save
  105.                             Load
  106.                             Files}
  107. {$I Pudd-04.pas}      {....screen to printer io and help }
  108.                       {     Print
  109.                             Display
  110.                             Help}
  111. {$I Pudd-05.pas}      {....fills an area, creates or erases a rectangle }
  112.                       {     RightMost
  113.                             LeftMost
  114.                             fillone
  115.                             fillArea
  116.                             MoveBox
  117.                             Block}
  118. {$I Pudd-06.pas}       {.....write stuff }
  119. {$I Pudd-07.pas}       {.....InBounds    }
  120.                             {vectorPoint
  121.                              angle
  122.                              arc}
  123. {*****************************************************************************
  124. **   Graphics is a pretty central procedure.  It is called by the main      **
  125. **  and it calls all the drawing procedures.  Most of the drawing           **
  126. **  procedures are in PUDD-nn.PAS.  These drawing procedures, in turn       **
  127. **  will call drawing primitives from TOOLSn.PAS.                           **
  128. *****************************************************************************}
  129. procedure Graphics;
  130. begin
  131.  Initgraph;
  132.  while not((response = 'R') or (response = #$1B)) do
  133.   begin
  134.    read(kbd,response);
  135.    response := UpCase(response);
  136.    case response of
  137.     'P':PointSet(size,x1,y1,Xpoz,Ypoz);
  138.     'W':CleanUp;
  139.     'U':Arc(xPoz,yPoz);
  140.     'X':Extensive(size,x1,y1,xPoz,yPoz);
  141.     'D':DrawNext(size,x1,y1,xPoz,yPoz);
  142.     'L':LineNext(size,x1,y1,xPoz,yPoz);
  143.     'A':Arrow(size,x1,y1,xPoz,yPoz);
  144.     'T':Text(xPoz,yPoz);
  145.     'F':FillArea;
  146.     'B':Block(false);
  147.     'E':Block(true);
  148.     'C':begin
  149.          Status;
  150.          HeadLine;
  151.          initgraph;
  152.         end;
  153.     'S':SetSpeed(speed);
  154.     '5':SetSpeed(speed);
  155.     '1'..'9':begin
  156.               reInitXhair(size,xpoz,ypoz);
  157.               MoveCross(size,speed,response,xPoz,yPoz);
  158.              end;
  159.    end;   {......case }
  160.   end;    {.....while }
  161.   alphamode;
  162.   HeadLine;
  163. end;  {................Graphics }
  164.  
  165. begin   {*****************************************   M A I N   *************}
  166. InitDefault;
  167. SetTypes;
  168. initXhair(size,xpoz,ypoz);
  169. HeadLine;
  170. response := '?';
  171. while not(response = 'Q') do
  172.  begin
  173.   if KeyPressed then   {.....clear misc kbd stuff }
  174.    read(kbd,response);
  175.   read(kbd,response);
  176.   response := UpCase(response);
  177.   case response of
  178.    'G': graphics;
  179.    'P': print;
  180.    'F': files;
  181.    'W': begin
  182.           writeletter;
  183.           Headline;
  184.         end;
  185.    'H': begin
  186.          help;
  187.          Headline;
  188.         end;
  189.    'C': begin
  190.          status;
  191.          HeadLine;
  192.         end;
  193.   end;  {.........case }
  194.  end;   {.........while }
  195. offXhair(size,xPoz,yPoz);
  196. end.
  197.