home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / arexx / ole1v10a.lha / OLE_System / modules / fw3 / FontTable.fw < prev   
Encoding:
Text File  |  1995-02-10  |  6.6 KB  |  365 lines
  1. /*
  2.  * FontTable.fw
  3.  *
  4.  * USAGE: FontTable.fw
  5.  *
  6.  * Print a table containing each character for the current font. First
  7.  * release for FinalWriter.
  8.  *
  9.  * HISTORY:
  10.  *    v1.05    bug fixed to use under Release 3 of FinalWriter
  11.  *
  12.  * $(C): (1994, Rocco Coluccelli, Bologna)
  13.  * $VER: FontTable.fw 1.05 (03.Feb.1995)
  14.  */
  15.  
  16. OPTIONS RESULTS
  17.  
  18. PARSE ARG oleclip
  19. PARSE VALUE GETCLIP(oleclip) WITH jobID modID box.left box.top char.w char.h olewin oleport olehost . userport . locale config .
  20.  
  21.     rowgap = 30; colgap = 50
  22.     font.lsize = 10; font.tsize = 12
  23.  
  24. IF ~SHOW('C',config) THEN DO
  25.     font.label = 'SoftSans'
  26.     font.table = ''
  27.     END
  28.  
  29. ELSE PARSE VALUE GETCLIP(config) WITH font.label','font.table','
  30.  
  31.  
  32. ADDRESS VALUE userport
  33.  
  34. SetMeasure 'MICROPOINTS'
  35. View 50
  36.  
  37. Status 'FontPath'
  38. fontpath = LEFT(result,LASTPOS('/',result))
  39.  
  40. CALL GetSelectedFont(font.label)
  41. CALL GetSelectedFont(font.table)
  42.  
  43.  
  44. ADDRESS VALUE oleport
  45.  
  46. IF OPENPORT(olehost) == NULL() THEN DO
  47.     ERROR jobID modID 1 olehost
  48.     SETJOB jobID 'end'
  49.     EXIT 10
  50.     END
  51.  
  52. elab = 1
  53. st = GUIGads()
  54. DO UNTIL st = 'end'
  55.  
  56.     CALL WAITPKT(olehost)
  57.     pkt = GETPKT(olehost)
  58.  
  59.     IF pkt == NULL() THEN ITERATE
  60.  
  61.     PARSE VALUE GETARG(pkt) WITH cmd argv .
  62.  
  63.     SELECT
  64.  
  65.         WHEN cmd = 'FONT' THEN DO
  66.             PARSE VALUE GETARG(pkt,1) WITH n0 .
  67.             str = GETARG(pkt,2)
  68.  
  69.             IF str = '' THEN str = GetSelectedFont()
  70.  
  71.             font.argv = str
  72.             g_str.n0 = str
  73.             CALL Gadgets(2,n0)
  74.             CALL SETCLIP(config,font.label','font.table',')
  75.         END
  76.  
  77.         WHEN cmd = 'UNICONIFY' THEN
  78.             CALL Gadgets(8,1,g_gads)
  79.  
  80.         WHEN cmd = 'HELP' THEN
  81.             ABOUT jobID modID 'HELP' || st
  82.  
  83.         WHEN cmd = 'START' | cmd = 'QUIT' THEN
  84.             st = 'end'
  85.  
  86.         OTHERWISE NOP
  87.  
  88.     END
  89.  
  90.     CALL REPLY(pkt,0)
  91. END
  92.  
  93. CALL CLOSEPORT(olehost)
  94.  
  95. IF cmd = 'QUIT' THEN EXIT 0
  96.  
  97. COMPLETE jobID modID 1
  98.  
  99. title = GetLocale(1) font.table GetLocale(2) font.tsize
  100.  
  101. /*
  102.  * redirect commands to FinalWriter
  103.  */
  104. ADDRESS VALUE userport
  105.  
  106. /*
  107.  * Get the max dimension for the table
  108.  */
  109. GetPageSetup 'Width' 'Height'
  110. PARSE VAR result maxwidth maxheight .
  111.  
  112. /*
  113.  * Get the actual page number
  114.  */
  115. Status 'Page'
  116. page = result
  117.  
  118. /*
  119.  *    Get labels and blanks width
  120.  */
  121. TextBlockTypePrefs "Size" font.lsize "Font" fontpath || font.label
  122.  
  123. DrawTextBlock page 100 100 "000"
  124. tabletitle = result
  125.  
  126. /***********************************************\
  127. *
  128. *    THIS FIX THE BUG IN FINALWRITER RELEASE 3
  129. *
  130. \***********************************************/
  131. Redraw
  132.  
  133. GetObjectCoords tabletitle
  134. PARSE VAR result . . . labelwidth .
  135.  
  136. SetTextBlockText tabletitle title
  137.  
  138.  
  139. fonth = font.tsize * 10
  140. DO i = 0 TO 31
  141.     y.i = i * (fonth + rowgap)
  142. END
  143.  
  144. x = 0
  145. DO j = 0 TO 7
  146.  
  147.     TextBlockTypePrefs "Size" font.lsize "Font" fontpath || font.label
  148.     x = x + labelwidth + colgap
  149.     DO i = 0 TO 31
  150.         c.i = j + i * 8
  151.         DrawTextBlock page x y.i c.i
  152.         label.i.j = result
  153.         c.i = '"'D2C(c.i)'"'
  154.     END
  155.  
  156.     IF j = 0 THEN
  157.         c.0 = '01'x
  158.     ELSE IF j = 2 THEN DO
  159.         c.1 = '01'x
  160.         c.5 = '2a'x
  161.         END
  162.  
  163.     TextBlockTypePrefs "Size" font.tsize "Font" fontpath || font.table
  164.     x = x + labelwidth + colgap
  165.     DO i = 0 TO 31
  166.         DrawTextBlock page x y.i c.i
  167.         table.i.j = result
  168.     END
  169.  
  170.     CALL Complete(5 + 5 * j)
  171. END
  172.  
  173. tablewidth  = x + labelwidth + colgap
  174. tableheight = 32 * (fonth + rowgap)
  175.  
  176. /*
  177.  * Group all objects
  178.  */
  179. SelectObject 0
  180. DO j = 0 TO 7
  181.  
  182.     DO i = 0 TO 31
  183.         SelectObject label.i.j 'MULTIPLE'
  184.         SelectObject table.i.j 'MULTIPLE'
  185.     END
  186.  
  187.     CALL Complete(50 + 5 * j)
  188. END
  189.  
  190. x = (maxwidth - tablewidth) % 2
  191. y = (maxheight - tableheight) % 2
  192. Group
  193. CurrentObject
  194. SetObjectCoords result page x y tablewidth tableheight
  195.  
  196. y = y - fonth - 2 * rowgap
  197. GetObjectCoords tabletitle
  198. PARSE VAR result . . . wid .
  199. SetObjectCoords tabletitle page x y wid fonth
  200.  
  201. Redraw
  202.  
  203. ADDRESS VALUE oleport
  204. COMPLETE jobID modID 100
  205. SETJOB jobID 'end'
  206.  
  207. EXIT 0
  208.  
  209.  
  210. GetSelectedFont:
  211. PARSE ARG str
  212.  
  213.     ADDRESS VALUE userport
  214.     IF str ~= '' THEN Font fontpath || str
  215.     Type '  '
  216.     Cursor 'LEFT'
  217.     Status 'FontName'
  218.     str = result
  219.     Delete
  220.     BackSpace
  221.     ADDRESS
  222.  
  223. RETURN str
  224.  
  225.  
  226. GetLocale: PROCEDURE EXPOSE locale
  227. ARG strID
  228.  
  229.     strID = 'þ'strID'þ'; PARSE VALUE GETCLIP(locale) WITH (strID)text'Þ'
  230.  
  231. RETURN text
  232.  
  233.  
  234. Complete:
  235.  
  236.     ADDRESS VALUE oleport
  237.     COMPLETE jobID modID ARG(1)
  238.     ADDRESS
  239.  
  240. RETURN
  241.  
  242.  
  243. GUIGads:
  244.  
  245.     g_offx. = 2;    g_offx.1 = 0;            g_offx.3 = 2
  246.     g_offy. = 2;    g_offy.1 = char.h + 1;    g_offy.3 = 3
  247.     g_wid. = 8;                g_wid.1 = 0;            g_wid.3 = 12
  248.     g_hei. = char.h + 4;    g_hei.1 = char.h + 1;    g_hei.3 = char.h + 6
  249.     g_sx = char.w % 2;    g_sy = char.h % 4
  250.     g_onoff. = 0
  251.  
  252.     box.left = box.left + g_sx; box.top = box.top + 2 * g_sy
  253.     box.w = 36 * char.w
  254.  
  255.     n = 1
  256.     nmain = 1
  257.  
  258.     x = box.left; y = box.top
  259.     CALL IniGad(2,1,0,'FONT LABEL%1' n + 1,GetLocale(3))
  260.     CALL IniGad(3,0,1,'FONT LABEL%1' n '%2%g',font.label)
  261.     y = y + g_hei.3 + 2 * g_sy
  262.     CALL IniGad(2,1,0,'FONT TABLE%1' n + 1,GetLocale(4))
  263.     CALL IniGad(3,0,1,'FONT TABLE%1' n '%2%g',font.table)
  264.  
  265.     y = y + g_hei.3 + 2 * g_sy
  266.     CALL IniGad(2,1,0,'START',GetLocale(5))
  267.     g_gads = IniGad(2,3,0,'HELP',GetLocale(6))
  268.  
  269.     box.h = y + g_hei.2 + 2 * g_sy - box.top
  270.  
  271.     WINDOW jobID modID (box.w + 2 * g_sx) (box.h + 2 * g_sy) 1 1
  272.     CALL Gadgets(4,1,g_gads)
  273.  
  274. RETURN nmain
  275.  
  276.  
  277. Gadgets:
  278.  
  279.     IF ARG(1) < 4 THEN
  280.         DO i = 2 TO ARG(); n = ARG(i)
  281.             IF ARG(1) ~= 1 THEN CALL DelGad(n,g_type.n)
  282.             IF ARG(1) ~= 3 THEN CALL NewGad(n,g_type.n)
  283.         END
  284.  
  285.     ELSE IF ARG(1) < 7 THEN
  286.         DO n = ARG(2) TO ARG(3)
  287.             IF ARG(1) ~= 4 THEN CALL DelGad(n,g_type.n)
  288.             IF ARG(1) ~= 6 THEN CALL NewGad(n,g_type.n)
  289.         END
  290.  
  291.     ELSE IF ARG(1) = 8 THEN
  292.         DO n = ARG(2) TO ARG(3)
  293.             IF g_onoff.n THEN CALL NewGad(n,g_type.n)
  294.         END
  295.  
  296.     ELSE DO
  297.         DO n = ARG(2) TO ARG(3)
  298.             g_onoff.n = 0
  299.             IF g_type.n ~= 1 THEN CALL RemoveGadget(olewin,GAD.n)
  300.         END
  301.         CALL SetAPen(olewin,0)
  302.         CALL RectFill(olewin,box.left,box.top,box.left + box.w,box.top + box.h)
  303.         CALL RefreshGadgets(olewin)
  304.         END
  305. RETURN
  306.  
  307.  
  308. DelGad:
  309. PARSE ARG n,t
  310.  
  311.     g_onoff.n = 0
  312.  
  313.     IF t ~= 1 THEN CALL RemoveGadget(olewin,GAD.n)
  314.  
  315.     x = g_xpos.n - g_offx.t; y = g_ypos.n - g_offy.t
  316.     CALL SetAPen(olewin,0)
  317.     CALL RectFill(olewin,x,y,x + g_len.n,y + g_hei.t)
  318.  
  319. RETURN
  320.  
  321.  
  322. NewGad:
  323. PARSE ARG n,t
  324.  
  325.     g_onoff.n = 1
  326.  
  327.     IF t = 2 THEN
  328.         CALL AddGadGet(olewin,g_xpos.n,g_ypos.n,GAD.n,g_str.n,g_msg.n)
  329.  
  330.     ELSE IF t = 3 THEN
  331.         CALL AddGadGet(olewin,g_xpos.n,g_ypos.n,GAD.n,g_str.n,g_msg.n,g_len.n - 4,"RIDGEBORDER")
  332.  
  333.     ELSE IF t = 4 THEN
  334.         CALL AddGadGet(olewin,g_xpos.n,g_ypos.n,GAD.n,D2C(32 + g_str.n * 183),g_msg.n)
  335.  
  336.     ELSE DO
  337.         CALL SetAPen(olewin,1)
  338.         CALL Move(olewin,g_xpos.n,g_ypos.n)
  339.         CALL Text(olewin,g_str.n)
  340.         END
  341. RETURN
  342.  
  343.  
  344. IniGad:
  345. PARSE ARG t,na,nx,g_msg.n,g_str.n,var
  346.  
  347.     x = x + nx * g_sx
  348.  
  349.     IF t = 3 & var > 0 THEN
  350.         g_len.n = var * char.w + g_wid.t
  351.     ELSE IF t = 3 THEN
  352.         g_len.n = box.left + box.w - x
  353.     ELSE
  354.         g_len.n = LENGTH(g_str.n) * char.w + g_wid.t
  355.  
  356.     IF na > 0 THEN x = box.left + (na - 1) * (box.w - g_len.n) % 2 + nx * g_sx
  357.  
  358.     g_xpos.n = x + g_offx.t; g_ypos.n = y + g_offy.t; g_type.n = t
  359.     x = x + g_len.n
  360.     n = n + 1
  361.  
  362.     IF t = 4 THEN CALL IniGad(1,0,1,,var)
  363.  
  364. RETURN n - 1
  365.