home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / list / hb15-pt1.ark / PCHAR.PAS < prev    next >
Pascal/Delphi Source File  |  1986-10-21  |  2KB  |  81 lines
  1. { Copyright (C) 1986 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  2.  
  3. procedure PlotChar ( var lm, rm : integer ) ;
  4.  
  5. var
  6.      i              : integer ;
  7.      nStrokes       : byte ;
  8.      nSegs          : byte ;
  9.  
  10.      x0, y0         : integer ;
  11.      x1, y1         : integer ;
  12.  
  13. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  14.  
  15. function GetData : integer ;
  16.      { read Hershey data file byte by byte }
  17. var
  18.      b              : byte ;
  19. begin
  20.    b := bData[bOffset] ;
  21.    if b < 128 then
  22.       GetData := b
  23.    else
  24.       GetData := b - 256 ;
  25.    bOffset := bOffset + 1 ;
  26.    if bOffset = 128 then begin
  27.       BlockRead (bdID, bData, 1) ;
  28.       if IOResult <> 0 then begin
  29.          writeln ('Error: Unable to Read Hershey Data File.') ;
  30.          BIOS(0)
  31.       end
  32.       else
  33.          bOffset := 0
  34.    end
  35. end ;
  36.  
  37. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  38.  
  39. begin
  40.                                 { clear pad }
  41.    for i := 0 to nPad do
  42.       Pad[i] := 0 ;
  43.                                 { get left and right margins }
  44.    lm := GetData ;
  45.    rm := GetData ;
  46.                                 { get stroke count }
  47.    nStrokes := GetData ;
  48.    while nStrokes > 0 do begin
  49.       nStrokes := nStrokes - 1 ;
  50.                                 { get segment count }
  51.       nSegs := GetData ;
  52.       if nSegs > 0 then begin
  53.          if Rotate then begin
  54.             y0 := yScale * GetData ;
  55.             x0 := xScale * GetData
  56.          end
  57.          else begin
  58.             x0 := xScale * GetData ;
  59.             y0 := - yScale * GetData
  60.          end ;
  61.                                 { initialize stroke sequence }
  62.          Move (x0,y0) ;
  63.          while nSegs > 1 do begin
  64.             nSegs := nSegs - 1 ;
  65.             if Rotate then begin
  66.                y1 := yScale * GetData ;
  67.                x1 := xScale * GetData
  68.             end
  69.             else begin
  70.                x1 := xScale * GetData ;
  71.                y1 := - yScale * GetData
  72.             end ;
  73.                                 { draw segment }
  74.             Draw (x1,y1) ;
  75.          end
  76.       end
  77.    end
  78. end ;
  79.  
  80. { Copyright (C) 1986 Adam Fritz, 133 Main St., Afton, N.Y. 13730 }
  81.