home *** CD-ROM | disk | FTP | other *** search
- /* CMD: ProCalc Chart
- * ProCalc.lwm -- Work with Spreadsheet data from Gold Disk's
- * "Professional Calc" in Modeler
- * By Arnie Cachelin Copyright © 1992, 1993 NewTek, Inc.
- * Sun May 30 1993 */
-
- call addlib "LWModelerARexx.port", 0
- signal on error
- signal on syntax
- options results
-
- if ~show('P',"PCALC") then do
- notify(1,"!Can't find ProCalc...","Is it running?")
- exit
- end
- ADDRESS "PCALC"
-
- cellcmd.1="call MakeBlock "cell","||x||","||y||","||z
- cellcmd.3="call MakePlane "cell","||x||","||yold||","||z||","||y
- cellcmd.2="call MakePlaneBlock "col||row","||x||","||yold||","||z||","||y
- /* Use above for flat plane chart type */
-
- /* To Do:
- 1) make a big flat base poly for bar charts, possibly with Grid texture
- 2) scale bar chart base to match max height (?)
- 3) add other chart types:
- a) Area plot
- b) Pie chart
-
- */
-
- call req_begin 'ProCalc Chart'
-
- /* id_nsx = req_addcontrol("X Segments", 'n') */
- /* id_nsy = req_addcontrol("Y Segments", 'n') */
- id_reg = req_addcontrol("Cells: ", 'CH',"Selected All")
- id_typ = req_addcontrol("Chart Type: ","CH","Bar Line Pie Area")
-
- /* call req_setval id_nsx, nsx, 20 */
- /* call req_setval id_nsy, nsy, 20 */
- call req_setval id_reg, 1
- call req_setval id_typ, 1
-
- if (~req_post()) then do
- call req_end
- exit
- end
-
- /* NSX = req_getval(id_nsx) % 1 */
- /* NSY = req_getval(id_nsx) % 1 */
- typ = req_getval(id_typ)
- reg = req_getval(id_reg)
-
- call req_end
-
- BlockMarg=.2
- BlockWidth=1-BlockMarg
-
- DrawMessage "This is a message from ARexx."
- Current
- crange=result
- parse var crange firstcell':'lastcell
- if lastcell="" then do
- call notify(1,"!Select a range first")
- DrawMessage "Select a range first"
- exit
- end
-
- if typ=3 then do
- call Pie()
- selectrange crange
- exit
- end
-
- if reg=1 then do
- if typ<3 then say ProcessRange(cellcmd.typ)
- else say AreaRange()
- end
- else
- if typ<3 then say ProcessAll(cellcmd.typ)
- else say AreaAll()
- selectrange crange
- exit
-
- syntax:
- error:
- call end_all
- t=Notify(1,'!Rexx Script Error','@'ErrorText(rc),'Line 'SIGL)
- exit
-
- MakeBlock: PROCEDURE EXPOSE BlockMarg BlockWidth
- arg cell,x,y,z
- call Surface(cell)
- call Makebox(x+BlockMarg 0 z+BlockMarg,x+BlockWidth y z+BlockWidth)
- return(1)
-
-
- MakePlane: PROCEDURE EXPOSE BlockMarg BlockWidth
- arg cell,x,y,z,y2
- say x y z cell blockmarg BlockWidth
- call Surface(cell)
- call add_begin
- call add_point x y z
- call add_point x+BlockWidth+BlockMarg y z
- call add_point x+BlockWidth+BlockMarg y2 z+BlockWidth+BlockMarg
- call add_point x y2 z+BlockWidth+BlockMarg
- call add_polygon 4 3 2 1
- call add_end
- return(1)
-
- MakePlaneBlock: PROCEDURE EXPOSE BlockMarg BlockWidth
- arg cell,x,y,z,y2
- say x y z cell blockmarg BlockWidth
- call Surface(cell)
- call add_begin
- call add_point x y z
- call add_point x+BlockWidth+BlockMarg y z
- call add_point x+BlockWidth+BlockMarg y2 z+BlockWidth+BlockMarg
- call add_point x y2 z+BlockWidth+BlockMarg
- call add_point x 0 z
- call add_point x+BlockWidth+BlockMarg 0 z
- call add_point x+BlockWidth+BlockMarg 0 z+BlockWidth+BlockMarg
- call add_point x 0 z+BlockWidth+BlockMarg
- call add_polygon 4 3 2 1
- call add_polygon 5 6 7 8
- call add_polygon 1 5 8 4
- call add_polygon 4 8 7 3
- call add_polygon 2 3 7 6
- call add_polygon 1 2 6 5
- call add_end
- return(1)
-
- /* Execute cmd on each cell in current range */
- ProcessRange: PROCEDURE EXPOSE BlockMarg BlockWidth
- arg cmd
- Current
- crange=result
- parse var crange firstcell':'lastcell
- if lastcell="" then return(0)
- say crange", "firstcell", "lastcell
- c=verify(firstcell,"0123456789","M") /* Position of first numeric digit */
- firstrow=substr(firstcell,c)
- firstcol=left(firstcell,c-1)
- c=verify(lastcell,"0123456789","M") /* Position of first numeric digit */
- lastrow=substr(lastcell,c)
- lastcol=left(lastcell,c-1)
- i=0
- xmax=c2d(lastcol)-c2d(firstcol)
- zmax=lastrow-firstrow
- say "Rows "firstrow" to "lastrow" Span: "zmax
- say "Cols "firstcol" to "lastcol" Span: "xmax
- do col_num=c2d(firstcol) to c2d(lastcol)
- col=d2c(col_num)
- x=col_num-c2d(firstcol)
- do row=firstrow to lastrow
- z=row-firstrow
- cell=col||row
- SelectCell cell
- GetValue
- yold=y
- y=Result
- if yold="Y" then yold=y
- say cmd
- if y~="" then interpret cmd
- i=i+1
- end
- end
- return i
-
- AreaRange: PROCEDURE
- Current
- crange=result
- parse var crange firstcell':'lastcell
- if lastcell="" then return(0)
- say crange", "firstcell", "lastcell
- c=verify(firstcell,"0123456789","M") /* Position of first numeric digit */
- firstrow=substr(firstcell,c)
- firstcol=left(firstcell,c-1)
- c=verify(lastcell,"0123456789","M") /* Position of first numeric digit */
- lastrow=substr(lastcell,c)
- lastcol=left(lastcell,c-1)
- i=0
- xmax=c2d(lastcol)-c2d(firstcol)
- zmax=lastrow-firstrow
- say "Rows "firstrow" to "lastrow" Span: "zmax
- say "Cols "firstcol" to "lastcol" Span: "xmax
- call add_begin
- do col_num=c2d(firstcol) to c2d(lastcol)
- col=d2c(col_num)
- x=col_num-c2d(firstcol)
- do row=firstrow to lastrow
- z=row-firstrow
- cell=col||row
- SelectCell cell
- GetValue
- y=Result
- if y~="" then do
- vec = x y z
- call add_point(vec)
- i=i+1
- end
- end
- end
- i=1
- do col_num=c2d(firstcol) to c2d(lastcol)-1
- col=d2c(col_num)
- x=col_num-c2d(firstcol)
- do row=firstrow to lastrow
- z=row-firstrow
- cell=col||row
- SelectCell cell
- call Surface(cell)
- GetValue
- y=Result
- if y~="" then do
- if i//(zmax+1)>0 then do
- call add_quad i i+zmax+1 i+zmax+2 i+1
- end
- i=i+1
- end
- end
- end
- call add_end
- return i
-
- Pie: PROCEDURE
- Current
- crange=result
- parse var crange firstcell':'lastcell
- if lastcell="" then return(0)
- say crange", "firstcell", "lastcell
- c=verify(firstcell,"0123456789","M") /* Position of first numeric digit */
- firstrow=substr(firstcell,c)
- firstcol=left(firstcell,c-1)
- c=verify(lastcell,"0123456789","M") /* Position of first numeric digit */
- lastrow=substr(lastcell,c)
- lastcol=left(lastcell,c-1)
- do row=firstrow to lastrow
- total.row=0
- do col_num=c2d(firstcol) to c2d(lastcol)
- col=d2c(col_num)
- cell=col||row
- SelectCell cell
- GetValue
- y=Result
- if y~="" then total.row=total.row + y
- end
- end
- do row=firstrow to lastrow
- do col_num=c2d(firstcol) to c2d(lastcol)
- col=d2c(col_num)
- cell=col||row
- SelectCell cell
- call Surface(cell)
- GetValue
- y=Result
- if y~="" then call AddWedge(360*y/total.row)
- end
- if row~=lastrow then call move(0 1 0)
- end
- return i
-
-
- ProcessAll: PROCEDURE EXPOSE BlockMarg BlockWidth
- arg cmd
- firstrow='A'
- firstcol='1'
- GetLastRow
- lastrow=result
- GetLastCol
- lastcol=result
- i=0
- xmax=c2d(lastcol)-c2d(firstcol)
- zmax=lastrow-firstrow
- say "Rows "firstrow" to "lastrow" Span: "zmax
- say "Cols "firstcol" to "lastcol" Span: "xmax
- do col_num=c2d(firstcol) to c2d(lastcol)
- col=d2c(col_num)
- x=col_num-c2d(firstcol)
- do row=firstrow to lastrow
- z=row-firstrow
- cell=col||row
- SelectCell cell
- GetValue
- yold=y
- y=Result
- if yold="Y" then yold=y
- if y~="" then interpret cmd
- i=i+1
- end
- end
- return i
-
- AreaAll: PROCEDURE EXPOSE BlockMarg BlockWidth
- firstrow='A'
- firstcol='1'
- GetLastRow
- lastrow=result
- GetLastCol
- lastcol=result
- i=0
- xmax=c2d(lastcol)-c2d(firstcol)
- zmax=lastrow-firstrow
- say "Rows "firstrow" to "lastrow" Span: "zmax
- say "Cols "firstcol" to "lastcol" Span: "xmax
- call add_begin
- do col_num=c2d(firstcol) to c2d(lastcol)
- col=d2c(col_num)
- x=col_num-c2d(firstcol)
- do row=firstrow to lastrow
- z=row-firstrow
- cell=col||row
- SelectCell cell
- GetValue
- y=Result
- if y~="" then do
- vec = x y z
- call add_point(vec)
- i=i+1
- end
- end
- end
- i=1
- do col_num=c2d(firstcol) to c2d(lastcol)-1
- col=d2c(col_num)
- x=col_num-c2d(firstcol)
- do row=firstrow to lastrow
- z=row-firstrow
- cell=col||row
- SelectCell cell
- call Surface(cell)
- GetValue
- y=Result
- if y~="" then do
- if i//(zmax+1)>0 then do
- call add_quad i i+zmax+1 i+zmax+2 i+1
- end
- i=i+1
- end
- end
- end
- call add_end
- return i
-
- MakeWedge: PROCEDURE /* It should be easy to make a more efficient curve wedge */
- arg ang,rad
- call makebox(0,rad rad/2 0 )
- call lathe('Y',(ang%5)+1,0,ang,0) /* Make segs constant to morph slices */
- return ang
-
- AddWedge: PROCEDURE
- arg ang
- call rotate(ang,'Y')
- call Cut()
- call makewedge(ang,1)
- call paste()
- return ang