home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / arexx / ole1v10a.lha / OLE_System / modules / fw2 / DrawTable.fw < prev    next >
Encoding:
Text File  |  1995-02-10  |  11.5 KB  |  604 lines
  1. /*
  2.  * DrawTable.fw
  3.  *
  4.  * USAGE: DrawTable.fw(ArgObject)
  5.  *
  6.  * The second module of my OLE system. This take the description of a
  7.  * table placed in the ClipList and draw a table into FinalWriter. The
  8.  * second important function implemented is to write all those information
  9.  * necessary to update the imported table later.
  10.  *
  11.  * TODO: columns at the same size
  12.  *
  13.  * HISTORY:
  14.  * v1.01    Drop the PIPE: before quit
  15.  *
  16.  * v1.02    added the progress indicator
  17.  *
  18.  * v1.03    added ActivateGadget()
  19.  *
  20.  * v1.04    aligned with the new server design v1.10
  21.  *
  22.  * $(C): (1994, Rocco Coluccelli, Bologna)
  23.  * $VER: DrawTable.fw 1.04 (30.Nov.1994)
  24.  */
  25.  
  26. OPTIONS RESULTS
  27.  
  28. /*
  29.  *    Read the startup clip
  30.  *    start point for gadgets, font dimension, commands ports, ...
  31.  */
  32. PARSE ARG oleclip
  33. PARSE VALUE GETCLIP(oleclip) WITH jobID modID box.left box.top char.w char.h olewin oleport olehost . userport olepipe locale config .
  34.  
  35.     fwobold.    = 100
  36.     fwoitalic.  = 0
  37.  
  38. IF ~SHOW('C',config) THEN DO
  39.     rowgap = 15; colgap = 35; measure = 2
  40.     fwobold.1   = 130
  41.     fwoitalic.1 = 2
  42.     pref.box  = 1; pref.line = 1; pref.link = 0
  43.     END
  44.  
  45. ELSE PARSE VALUE GETCLIP(config) WITH rowgap','colgap','measure','fwobold.1','fwoitalic.1','pref.box','pref.line','pref.link','
  46.  
  47.     ms.1 = 1;            ms.type.1 = GetLocale(1)
  48.     ms.2 = 0.035278;    ms.type.2 = GetLocale(2)
  49.     ms.3 = 0.001389;    ms.type.3 = GetLocale(3)
  50.  
  51. ADDRESS VALUE oleport
  52.  
  53. IF OPENPORT(olehost) == NULL() THEN DO
  54.     ERROR jobID modID 1 olehost
  55.     SETJOB jobID 'end'
  56.     EXIT 10
  57.     END
  58.  
  59. st = GUIGads()
  60. DO UNTIL st = 'end'
  61.  
  62.     CALL WAITPKT(olehost)
  63.     pkt = GETPKT(olehost)
  64.  
  65.     IF pkt == NULL() THEN ITERATE
  66.  
  67.     PARSE VALUE GETARG(pkt) WITH cmd argv
  68.     PARSE VALUE GETARG(pkt,1) WITH n0 nn .
  69.  
  70.     SELECT
  71.  
  72.         WHEN cmd = 'GAP' THEN DO
  73.             gap = GETARG(pkt,2)
  74.  
  75.             IF gap < 0 THEN gap = 0
  76.             gap = gap % ms.measure
  77.  
  78.             IF argv = 'COLS' THEN
  79.                 colgap = gap
  80.             ELSE
  81.                 rowgap = gap
  82.  
  83.             g_str.n0 = gap * ms.measure
  84.         END
  85.  
  86.         WHEN cmd = 'PREFS' THEN DO
  87.             PARSE VAR argv cmd .
  88.  
  89.             pref.cmd = ~pref.cmd
  90.             g_str.n0 = pref.cmd
  91.         END
  92.  
  93.         WHEN cmd = 'MEASURE' THEN DO
  94.             PARSE VALUE GETARG(pkt,2) WITH n1 n2 .
  95.  
  96.             measure = measure + 1; IF measure > 3 THEN measure = 1
  97.  
  98.             g_str.n0 = ms.type.measure
  99.             g_str.n1 = colgap * ms.measure; g_str.n2 = rowgap * ms.measure
  100.             CALL Gadgets(2,n1,n2)
  101.         END
  102.  
  103.         WHEN cmd = 'UNICONIFY' THEN
  104.             CALL Gadgets(8,1,g_gads)
  105.  
  106.         WHEN cmd = 'HELP' THEN
  107.             ABOUT jobID modID 'HELP' || st
  108.  
  109.         WHEN cmd = 'START' | cmd = 'QUIT' THEN
  110.             st = 'end'
  111.  
  112.         OTHERWISE NOP
  113.  
  114.     END
  115.  
  116.     IF n0 ~= '' THEN DO
  117.         CALL Gadgets(2,n0)
  118.         IF nn ~= '' THEN CALL ActivateGadget(olewin,GAD.nn)
  119.         CALL SETCLIP(config,rowgap','colgap','measure','fwobold.1','fwoitalic.1','pref.box','pref.line','pref.link',')
  120.         END
  121.  
  122.     CALL REPLY(pkt,0)
  123.  
  124. END
  125.  
  126. CALL CLOSEPORT(olehost)
  127.  
  128. IF ~OPEN(pip,'PIPE:' || olepipe,'R') THEN DO
  129.     SETJOB jobID 'end'
  130.     EXIT 0
  131.     END
  132.  
  133. /*
  134.  *    Drop the PIPE: if we are going to quit
  135.  */
  136. IF cmd = 'QUIT' THEN DO
  137.     DO UNTIL EOF(pip)
  138.         CALL READCH(pip,20000)
  139.     END
  140.     EXIT 0
  141.     END
  142.  
  143. COMPLETE jobID modID 1
  144.  
  145. /*
  146.  * redirect commands to FinalWriter
  147.  */
  148. ADDRESS VALUE userport
  149.  
  150. SetMeasure 'MICROPOINTS'
  151. View 50
  152.  
  153. /*
  154.  * Get the actual page number and the font path
  155.  */
  156. Status 'Page'
  157. page = result
  158. Status 'FontPath'
  159. fontpath = LEFT(result,LASTPOS('/',result))
  160.  
  161. /*
  162.  * Get the max dimension for the table
  163.  */
  164. GetPageSetup 'Width' 'Height' 'Top' 'Bottom' 'Left' 'Right'
  165. PARSE VAR result maxwidth maxheight top bottom left right .
  166.  
  167. maxwidth  = (maxwidth - left - right)
  168. maxheight = (maxheight - top - bottom)
  169.  
  170. /*
  171.  * Get the user preferences over lines and boxes
  172.  * Draw a box around the table
  173.  */
  174. IF pref.line THEN LinePrefs 'PROMPT'
  175. IF pref.box  THEN BoxPrefs  'PROMPT'
  176.  
  177. DrawBox page left top maxwidth maxheight
  178. line.0 = result
  179.  
  180. /*
  181.  * get spreadname and ranges
  182.  *
  183.  * TODO: write these information into the linkfile
  184.  */
  185. spreadname = READLN(pip)
  186. ranges = READLN(pip)
  187.  
  188. /*
  189.  * Table of font equivalents
  190.  */
  191. fwofont.        = fontpath || 'SoftSans'
  192. fwofont.SYMBOL  = fontpath || 'Symbol'
  193. fwofont.COURIER = fontpath || 'Courier'
  194. fwofont.TIMES   = fontpath || 'SoftSerif'
  195.  
  196. bold.    = ''
  197. bold.1   = 'Bold'
  198. italic.  = ''
  199. italic.1 = 'Italic'
  200.  
  201. palette. = 'Black'
  202.  
  203. colborder. = 0
  204. rowborder. = 0
  205. height.    = 0
  206. width.    = 0
  207. cell. = 0
  208.  
  209. PARSE VALUE READLN(pip) WITH rows cols .
  210.  
  211. /*
  212.  * Read data from the clip, draw all cell excluding empty cells.
  213.  * Find the dimension of each row and column and calculate how
  214.  * large will be the table to fit page.
  215.  *
  216.  * HEADER:
  217.  * spreadfile
  218.  * ranges
  219.  * rows cols
  220.  *
  221.  * DATAS:
  222.  * row col align bold italic underline color len 'þ'text'Þ' 'þ'font'Þ' size lleft lright lup ldown
  223.  *
  224.  * (row col) of the cell, (len) length in chars of (text)
  225.  * (align) aligned with (bold italic underline) style
  226.  * typed in (color) with (font) of (size)
  227.  * with borders (lineleft lineright lineup linedown)
  228.  */
  229. CALL Complete(5)
  230. DO FOREVER
  231.  
  232.     PARSE VALUE READLN(pip) WITH i j align.i.j bo it under.i.j . . 'þ'text'Þ' 'þ'font'Þ' size lleft lright lup ldown .
  233.  
  234.     IF i = '' THEN LEAVE
  235.  
  236.     fwofont = fwofont.font
  237.     font = fwofont || '_' || bold.bo || italic.it
  238.  
  239.     IF EXISTS(font) THEN
  240.         TextBlockTypePrefs "Size" size "Color" palette.0 "Font" font
  241.     ELSE
  242.         TextBlockTypePrefs "Size" size "Width" fwobold.bo "Oblique" fwoitalic.it "Color" palette.0 "Font" fwofont
  243.  
  244.     DrawTextBlock page left top '"'text'"'
  245.     cell.i.j = result
  246.  
  247.     GetObjectCoords result
  248.     PARSE VAR result . . . width.i.j height.i.j .
  249.  
  250.     height.i = MAX(height.i,height.i.j)
  251.     width.j  = MAX(width.j,width.i.j)
  252.  
  253.     IF lleft THEN colborder.i.j = 1
  254.     IF lup THEN rowborder.i.j = 1
  255.     IF lright THEN INTERPRET 'colborder.'i'.'j + 1' = 1'
  256.     IF ldown THEN INTERPRET 'rowborder.'i + 1'.'j' = 1'
  257. END
  258.  
  259. CALL CLOSE(pip)
  260. CALL Complete(20)
  261.  
  262.  
  263. /*
  264.  * calculate the position of rows and columns
  265.  * centering the table in the current page
  266.  */
  267. col.1 = left
  268. DO j = 2 TO cols + 1
  269.     i = j - 1
  270.     col.j = col.i + width.i + 2 * colgap
  271. END
  272.  
  273. row.1 = top
  274. DO i = 2 TO rows + 1
  275.     j = i - 1
  276.     row.i = row.j + height.j + 2 * rowgap
  277. END
  278.  
  279.  
  280. /*
  281.  * move each cell to its correct position
  282.  *
  283.  * fix vertical and horizontal alignement
  284.  * draw the "underline"
  285.  */
  286. n = 0
  287. DO j = 1 TO cols
  288.     DO i = 1 TO rows
  289.  
  290.         IF cell.i.j ~= 0 THEN DO
  291.  
  292.             top = row.i + height.i - height.i.j
  293.  
  294.             SELECT
  295.                 WHEN align.i.j = '010' THEN
  296.                     left = col.j + width.j - width.i.j
  297.                 WHEN align.i.j = '001' THEN
  298.                     left = col.j + (width.j - width.i.j) % 2
  299.                 OTHERWISE
  300.                     left = col.j
  301.             END
  302.  
  303.             SetObjectCoords cell.i.j page left top width.i.j height.i.j
  304.  
  305.             IF under.i.j THEN DO
  306.                 n = n + 1
  307.                 top = top + 5 * height.i.j % 6
  308.                 DrawLine page left top (left + width.i.j) top
  309.                 line.n = result
  310.                 END
  311.         END
  312.  
  313.     END
  314. END
  315. CALL Complete(50)
  316.  
  317. Redraw
  318.  
  319.  
  320. /*
  321.  * calculate table's dimension to redraw the box
  322.  */
  323. boxwidth = col.j - col.1
  324. boxheight = row.i - row.1
  325.  
  326. top = row.1 - rowgap
  327. bottom = row.i - rowgap
  328. left = col.1 - colgap
  329. right  = col.j - colgap
  330.  
  331. SetObjectCoords line.0 page left top boxwidth boxheight
  332.  
  333. /*
  334.  * draw borders around cells
  335.  */
  336. DO j = 1 TO cols + 1
  337.  
  338.     left = col.j - colgap
  339.     DO i = 1 TO rows + 1
  340.  
  341.         DO WHILE ~colborder.i.j
  342.             IF i > rows THEN ITERATE j
  343.             i = i + 1
  344.             END
  345.  
  346.         top = row.i - rowgap
  347.         DO WHILE colborder.i.j & i <= rows
  348.             i = i + 1
  349.             END
  350.  
  351.         n = n + 1
  352.         DrawLine page left top left (row.i - rowgap)
  353.         line.n = result
  354.     END
  355.  
  356. END
  357. CALL Complete(65)
  358.  
  359. DO i = 1 TO rows + 1
  360.  
  361.     top = row.i - rowgap
  362.     DO j = 1 TO cols + 1
  363.  
  364.         DO WHILE ~rowborder.i.j
  365.             IF j > cols THEN ITERATE i
  366.             j = j + 1
  367.             END
  368.  
  369.         left = col.j - colgap
  370.         DO WHILE rowborder.i.j & j <= cols
  371.             j = j + 1
  372.             END
  373.  
  374.         n = n + 1
  375.         DrawLine page left top (col.j - colgap) top
  376.         line.n = result
  377.     END
  378.  
  379. END
  380. CALL Complete(80)
  381.  
  382. lines = n
  383.  
  384. Redraw
  385.  
  386. /*
  387.  * Group all lines
  388.  */
  389. SelectObject 0
  390. DO n = 1 TO lines
  391.     SelectObject line.n 'MULTIPLE'
  392. END
  393.  
  394. Group
  395. CurrentObject
  396. lines = result
  397.  
  398. /*
  399.  * Group all cells
  400.  */
  401. SelectObject 0
  402. DO j = 1 TO cols
  403.     DO i = 1 TO rows
  404.         IF cell.i.j ~= 0 THEN SelectObject cell.i.j 'MULTIPLE'
  405.     END
  406. END
  407. CALL Complete(90)
  408.  
  409. Group
  410. CurrentObject
  411. cells = result
  412.  
  413. /*
  414.  * Group all object with box
  415.  */
  416. SelectObject line.0
  417. SelectObject cells 'MULTIPLE'
  418.  
  419. IF lines > 0 THEN SelectObject lines 'MULTIPLE'
  420.  
  421. Group
  422. CurrentObject
  423. table = result
  424.  
  425. /*
  426.  * check if table fit page
  427.  */
  428. n = boxwidth / boxheight
  429. IF boxwidth > maxwidth THEN DO
  430.     boxwidth = maxwidth
  431.     boxheight = maxwidth % n
  432.     END
  433.  
  434. IF boxheight > maxheight THEN DO
  435.     boxheight = maxheight
  436.     boxwidth = maxheight * n
  437.     END
  438.  
  439. left = col.1 + (maxwidth - boxwidth) % 2
  440. top = row.1 + (maxheight - boxheight) % 2
  441.  
  442. SetObjectCoords table page left top boxwidth boxheight
  443.  
  444. Redraw
  445.  
  446. ADDRESS VALUE oleport
  447. COMPLETE jobID modID 100
  448. SETJOB jobID modID + 1
  449.  
  450. EXIT 0
  451.  
  452.  
  453.  
  454. GetLocale: PROCEDURE EXPOSE locale
  455. ARG strID
  456.  
  457.     strID = 'þ'strID'þ'; PARSE VALUE GETCLIP(locale) WITH (strID)text'Þ'
  458.  
  459. RETURN text
  460.  
  461.  
  462. Complete:
  463.  
  464.     ADDRESS VALUE oleport
  465.     COMPLETE jobID modID ARG(1)
  466.     ADDRESS
  467.  
  468. RETURN
  469.  
  470.  
  471. GUIGads:
  472.  
  473.     g_offx. = 2;    g_offx.1 = 0;            g_offx.3 = 2
  474.     g_offy. = 2;    g_offy.1 = char.h + 1;    g_offy.3 = 3
  475.     g_wid. = 8;                g_wid.1 = 0;            g_wid.3 = 12
  476.     g_hei. = char.h + 4;    g_hei.1 = char.h + 1;    g_hei.3 = char.h + 6
  477.     g_sx = char.w % 2;    g_sy = char.h % 4
  478.     g_onoff. = 0
  479.  
  480.     box.left = box.left + g_sx; box.top = box.top + 2 * g_sy
  481.     box.w = 36 * char.w
  482.  
  483.     n = 1
  484.     nmain = 1
  485.  
  486.     n1.nmain = n
  487.     x = box.left; y = box.top
  488.     n1 = IniGad(3,1,0,'GAP COLS %1' n n + 2'%2%g',colgap * ms.measure,8)
  489.     CALL IniGad(1,0,1,,GetLocale(4))
  490.     y = y + g_hei.3 + 2 * g_sy
  491.     n2 = IniGad(3,1,0,'GAP ROWS %1' n '%2%g',rowgap * ms.measure,8)
  492.     CALL IniGad(1,0,1,,GetLocale(5))
  493.     y = y + g_hei.3 + 2 * g_sy
  494.     CALL IniGad(2,1,0,'MEASURE %1' n + 1 '%2' n1 n2,GetLocale(6))
  495.     CALL IniGad(1,0,1,,ms.type.measure)
  496.     y = y + g_hei.3 + 2 * g_sy
  497.     CALL IniGad(4,1,0,'PREFS BOX%1' n,pref.box,GetLocale(7))
  498.     x = box.left + box.w % 2
  499.     CALL IniGad(4,0,0,'PREFS LINE%1' n,pref.line,GetLocale(8))
  500.     y = y + g_hei.3 + g_sy
  501.     CALL IniGad(4,1,0,'PREFS LINK%1' n,pref.link,GetLocale(9))
  502.     n2.nmain = n - 1
  503.  
  504.     y = y + g_hei.3 + 2 * g_sy
  505.     CALL IniGad(2,1,0,'START',GetLocale(10))
  506.     g_gads = IniGad(2,3,0,'HELP',GetLocale(11))
  507.  
  508.     box.h = y + g_hei.2 + 2 * g_sy - box.top
  509.  
  510.     WINDOW jobID modID (box.w + 2 * g_sx) (box.h + 2 * g_sy) 1 1
  511.     CALL Gadgets(4,1,g_gads)
  512.  
  513. RETURN nmain
  514.  
  515.  
  516. Gadgets:
  517.  
  518.     IF ARG(1) < 4 THEN
  519.         DO i = 2 TO ARG(); n = ARG(i)
  520.             IF ARG(1) ~= 1 THEN CALL DelGad(n,g_type.n)
  521.             IF ARG(1) ~= 3 THEN CALL NewGad(n,g_type.n)
  522.         END
  523.  
  524.     ELSE IF ARG(1) < 7 THEN
  525.         DO n = ARG(2) TO ARG(3)
  526.             IF ARG(1) ~= 4 THEN CALL DelGad(n,g_type.n)
  527.             IF ARG(1) ~= 6 THEN CALL NewGad(n,g_type.n)
  528.         END
  529.  
  530.     ELSE IF ARG(1) = 8 THEN
  531.         DO n = ARG(2) TO ARG(3)
  532.             IF g_onoff.n THEN CALL NewGad(n,g_type.n)
  533.         END
  534.  
  535.     ELSE DO
  536.         DO n = ARG(2) TO ARG(3)
  537.             g_onoff.n = 0
  538.             IF g_type.n ~= 1 THEN CALL RemoveGadget(olewin,GAD.n)
  539.         END
  540.         CALL SetAPen(olewin,0)
  541.         CALL RectFill(olewin,box.left,box.top,box.left + box.w,box.top + box.h)
  542.         CALL RefreshGadgets(olewin)
  543.         END
  544. RETURN
  545.  
  546.  
  547. DelGad:
  548. PARSE ARG n,t
  549.  
  550.     g_onoff.n = 0
  551.  
  552.     IF t ~= 1 THEN CALL RemoveGadget(olewin,GAD.n)
  553.  
  554.     x = g_xpos.n - g_offx.t; y = g_ypos.n - g_offy.t
  555.     CALL SetAPen(olewin,0)
  556.     CALL RectFill(olewin,x,y,x + g_len.n,y + g_hei.t)
  557.  
  558. RETURN
  559.  
  560.  
  561. NewGad:
  562. PARSE ARG n,t
  563.  
  564.     g_onoff.n = 1
  565.  
  566.     IF t = 2 THEN
  567.         CALL AddGadGet(olewin,g_xpos.n,g_ypos.n,GAD.n,g_str.n,g_msg.n)
  568.  
  569.     ELSE IF t = 3 THEN
  570.         CALL AddGadGet(olewin,g_xpos.n,g_ypos.n,GAD.n,g_str.n,g_msg.n,g_len.n - 4,"RIDGEBORDER")
  571.  
  572.     ELSE IF t = 4 THEN
  573.         CALL AddGadGet(olewin,g_xpos.n,g_ypos.n,GAD.n,D2C(32 + g_str.n * 183),g_msg.n)
  574.  
  575.     ELSE DO
  576.         CALL SetAPen(olewin,1)
  577.         CALL Move(olewin,g_xpos.n,g_ypos.n)
  578.         CALL Text(olewin,g_str.n)
  579.         END
  580. RETURN
  581.  
  582.  
  583. IniGad:
  584. PARSE ARG t,na,nx,g_msg.n,g_str.n,var
  585.  
  586.     x = x + nx * g_sx
  587.  
  588.     IF t = 3 & var > 0 THEN
  589.         g_len.n = var * char.w + g_wid.t
  590.     ELSE IF t = 3 THEN
  591.         g_len.n = box.left + box.w - x
  592.     ELSE
  593.         g_len.n = LENGTH(g_str.n) * char.w + g_wid.t
  594.  
  595.     IF na > 0 THEN x = box.left + (na - 1) * (box.w - g_len.n) % 2 + nx * g_sx
  596.  
  597.     g_xpos.n = x + g_offx.t; g_ypos.n = y + g_offy.t; g_type.n = t
  598.     x = x + g_len.n
  599.     n = n + 1
  600.  
  601.     IF t = 4 THEN CALL IniGad(1,0,1,,var)
  602.  
  603. RETURN n - 1
  604.