home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a040 / 2.ddi / SHRWARE4.ARC / GENBOX.INC < prev    next >
Encoding:
Text File  |  1988-02-11  |  2.0 KB  |  85 lines
  1. <<* GENBOX.INC *>>
  2. <<#pragma
  3.  
  4. procedure GenBox
  5. logical IsDoubleBox,IsSingleBox
  6. integer cp,boxlen
  7. string  box,boxtmp
  8.  
  9.  
  10. procedure GenSimpleBox( box : string )
  11. integer row
  12. string boxtmp
  13. begin
  14.   if (fldwid = 0) and (flddec = 0)  <<*Empty Box*>>
  15.     GenSay( fldrow,fldcol,'■' )
  16.   elsif (flddec = 0)   <<*HOR line*>>
  17.     GenSay( fldrow,fldcol,replicate( box[2],fldwid+1 ) )
  18.   elsif (fldwid = 0)   <<*VER line*>>
  19.     for row := fldrow to fldrow + flddec
  20.       GenSay( row,fldcol,box[4] )
  21.     end
  22.   elsif (box = space(8))  <<*Inverse Box*>>
  23.     for row := fldrow to fldrow + flddec
  24.       GenSay( row,fldcol,space(fldwid+1) )
  25.     end
  26.   else  <<*BOX*>>
  27.     boxtmp := box[1] + replicate( box[2],fldwid-1 ) + box[3]
  28.     GenSay( fldrow,fldcol,boxtmp )
  29.     for row := (fldrow + 1) to (fldrow + flddec - 1)
  30.       GenSay( row,fldcol,box[4] )
  31.       GenSay( row,fldcol+fldwid,box[5] )
  32.     end
  33.     boxtmp := box[6] + replicate( box[7],fldwid-1 ) + box[8]
  34.     GenSay( fldrow+flddec,fldcol,boxtmp )
  35.   end
  36. end <<*GenSimpleBox*>>
  37.  
  38.  
  39. procedure GenSingleDouble
  40. begin
  41.   gen( '@ ',str(fldrow),',',str(fldcol) )
  42.   gen( ' TO ',str(fldrow+flddec),',',str(fldcol+fldwid) )
  43.   if IsDoubleBox
  44.     gen( ' DOUBLE' )
  45.   endif
  46.   genln
  47. end <<*GenSingleDouble*>>
  48.  
  49.  
  50. procedure GenCharsBox
  51. begin
  52.   gen( '@ ',str(fldrow),',',str(fldcol),',' )
  53.   gen( str(fldrow+flddec),',',str(fldcol+fldwid) )
  54.   gen( ' BOX "' )
  55.   <<*Swap Chars*>>
  56.   boxtmp := substr(box,1,3)+box[5]+box[8]+box[7]+box[6]+box[4]
  57.   if isctrl( boxtmp )
  58.     cp := 1
  59.     boxlen := len( boxtmp )
  60.     cp := GenCtrlSeq( boxtmp,cp,boxlen )
  61.   else
  62.     gen( boxtmp )
  63.   endif
  64.   genln( '"' )
  65. end <<*GenCharsBox*>>
  66.  
  67.  
  68. begin <<*GenBox*>>
  69.   box := fldlab   <<*8 bytes*>>
  70.   if (box = space(8))  <<*Inverse Box*>>
  71.     GenSimpleBox( box )
  72.   else <<*BIG CASE*>>
  73.     IsDoubleBox := (box = '╔═╗║║╚═╝')
  74.     IsSingleBox := (box = '┌─┐││└─┘')
  75.     if (IsSingleBox or IsDoubleBox) 
  76.       GenSingleDouble
  77.     else
  78.       GenCharsBox
  79.     endif
  80.   end
  81. end <<*GenBox*>>
  82.  
  83. <<* EOF: GENBOX.INC *>>
  84. #>>
  85.