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