home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format 82 / af082sub.adf / FINALWRITER / FINAL.lzx / FinalWriter / FinalMacros / Macros / FinalWaver.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1978-01-01  |  8.5 KB  |  331 lines
  1. /* $VER: FinalWaver 1.02 (10.02.95) by NDY's */
  2.  
  3. /* Main [1.0] */
  4. OPTIONS RESULTS
  5. SIGNAL ON ERROR
  6. SIGNAL ON SYNTAX
  7. CALL init
  8. CALL locale
  9. CALL chosenobjs
  10. CALL options
  11. CALL point
  12. IF txt>0 THEN
  13.   CALL textblock
  14. ELSE
  15.   CALL bodytext
  16. CALL wave
  17. CALL group
  18. CALL bye
  19.  
  20. PROC init: /* Initialization [1.02] */
  21.   /* Vars needed by "bye" / "ERROR" */
  22.   errtext='"%t" "(#%n) in line %l" "" "Ok" "" ""'
  23.   objs=0
  24.   deci=""
  25.   et=""
  26.   /* Open library */
  27.   library="rexxmathlib.library"
  28.   lib=Show("l",library)
  29.   IF ~lib THEN lib=AddLib(library,0,-30,0)
  30.   IF ~lib | test=1 THEN
  31.     DO
  32.       ShowMessage 1 1 replacepat(nolib,"%y",library)
  33.       CALL bye(14)
  34.     END
  35.   clip="FWaver.def"
  36.   default=GetClip(clip)
  37.   spc=0.2 /* Space factor */
  38. RETURN
  39. PROC locale: /* Language specific strings [1.01] */
  40.   test=0  /* test 1/2/3/6/10/20/100/200 with new languages, 0 = no test */
  41.   lang=getlanguage()
  42.   info='FinalWaver 1.01 by NDY''s'
  43.   /* IF default='' THEN default='(put your defaults here and uncomment this line)' */
  44.   IF lang="deutsch" THEN /* German */
  45.     DO
  46.       errtext='"FinalWaver-Fehler:" "%t" "in Zeile %l (Fehlernummer %n)" "Ok" "" ""'
  47.       input='"%i" "Wellen und Höhe eingeben (? für Hilfe)" "%d"'
  48.       help.0='"Syntax (Argumente optional): [Wn] [A±n|An] [?]" "W: Anzahl Sinuswellen. Voreinstellung: 1" "A: Amplidude, - spiegelt die Welle. Voreinst.: 1"'
  49.       helpbutton='"Letzte Seite" "Zurück" "Nächste Seite"'
  50.       helppages=1
  51.       fwerrtext.10='Befehl gescheitert'
  52.       fwerrtext.20='Ungültige Argumente'
  53.       fwerrtext.100='Befehl unbekannt'
  54.       fwerrtext.200='Kann fwarexx.library nicht öffnen'
  55.       nolib='"FinalWaver-Fehler:" "Konnte ''%y'' nicht öffnen!" "" "Ok" "" ""'
  56.     END
  57.   ELSE /* Default: English */
  58.     DO
  59.       errtext='"FinalWaver failed:" "%t" "in line %l (errornumber %n)" "Ok" "" ""'
  60.       input='"%i" "Enter waves and height (? for help)" "%d"'
  61.       help.0='"Syntax (arguments optional): [Wn] [A±n|An] [?]" "W: Number of sinewaves. Default: 1" "A: Amplitude, - flips the wave. Default: 1"'
  62.       helpbutton='"Previous" "Back" "Next"'
  63.       helppages=1
  64.       fwerrtext.10='Instruction failed'
  65.       fwerrtext.20='Invalid arguments'
  66.       fwerrtext.100='Unknown instruction'
  67.       fwerrtext.200='Couldn''t open fwarexx.library'
  68.       nolib='"FinalWaver failed:" "Couldn''t open ''%y''" "" "Ok" "" ""'
  69.     END
  70.   input=replacepat(input,"%i",info)
  71.   IF test>5 THEN
  72.     DO
  73.       RC=test
  74.       IF test=6 THEN SIGNAL SYNTAX
  75.       SIGNAL ERROR
  76.     END
  77. RETURN
  78. PROC chosenobjs: /* Selected objects [1.0] */
  79.   /* Selected objects */
  80.   txt=0
  81.   oval=0
  82.   len=0
  83.   FirstObject "SELECTED"
  84.   o=RESULT
  85.   IF o~=0 THEN
  86.     DO
  87.       cnt=0
  88.       DO UNTIL o=0
  89.         obj.cnt=o
  90.         NextObject o "SELECTED"
  91.         o=RESULT
  92.         cnt=cnt+1
  93.       END
  94.       /* Search textblock */
  95.       DO i=0 TO cnt-1 WHILE txt=0
  96.         GetObjectType obj.i
  97.         IF RESULT=7 THEN txt=obj.i
  98.       END
  99.     END
  100.   /* Selected text */
  101.   IF txt=0 THEN
  102.     DO
  103.       Status "PARAPOS"
  104.       pos=RESULT
  105.       IF Words(pos)=4 THEN
  106.         DO
  107.           Extract
  108.           text=RESULT
  109.           MoveToPara Word(pos,1) Word(pos,2)
  110.           len=Length(text)
  111.         END
  112.       ELSE
  113.         DO
  114.           MoveToPara Word(pos,1) 0
  115.           Status "PARACHARS"
  116.           len=RESULT
  117.           text=""
  118.         END
  119.     END
  120.   IF len=0 & txt=0 THEN CALL bye(0)
  121. RETURN
  122. PROC options: /* Input [1.0] */
  123.   about=0
  124.   DO UNTIL about=-1 & test~=3
  125.     RequestText replacepat(input,"%d",default)
  126.     /* Help */
  127.     IF Pos("?",RESULT)>0 | test=3 THEN
  128.       DO
  129.         default=replacepat(RESULT,"?","")
  130.         about=0
  131.         DO UNTIL RESULT=2
  132.           ShowMessage 2 0 help.about helpbutton
  133.           about=(about+RESULT-2+helppages)//helppages
  134.         END
  135.       END
  136.     ELSE
  137.       about=-1
  138.   END
  139.   RESULT=replacepat(RESULT,",",".")
  140.   PARSE UPPER VAR RESULT "W" waves " ","A" amp " "
  141.   CALL SetClip(clip,Upper(RESULT))
  142.   /* Verify and set defaults (x||"0": ± -> ±0) */
  143.   IF ~Datatype(waves,"N") | waves="" THEN waves=1
  144.   waves=Max(waves,1)
  145.   IF amp="-" THEN amp=-1
  146.   IF ~Datatype(amp,"N") | amp="" THEN amp=1
  147. RETURN
  148. PROC point: /* Decimal point [1.0] */
  149.   /* Use decimal point */
  150.   GetDocItemPrefs "DECIMAL"
  151.   deci=RESULT
  152.   DocItemPrefs "DECIMAL PERIOD"
  153. RETURN
  154. PROC textblock: /* Process textblock [1.02] */
  155.   spcs=0
  156.   /* Examine textblock */
  157.   GetTextBlockText txt
  158.   text=RESULT
  159.   text=rembad(text)
  160.   len=Length(text)
  161.   GetObjectTypeSpecs txt "SIZE LEADING WIDTH OBLIQUE POSITION CASE STYLE COLOR FONT"
  162.   PARSE VAR RESULT size lead wid obl pos case st col font
  163.   TextBlockTypePrefs "SIZE" size "LEADING" lead "WIDTH" wid "OBLIQUE" obl "POSITION" pos "CASE" case "STYLE" st "COLOR" col "FONT" font
  164.   GetObjectCoords txt
  165.   PARSE VAR RESULT page xx yy txtw h
  166. RETURN
  167. PROC bodytext: /* Process selected text [1.02] */
  168.   /* Get page size */
  169.   GetPageSetup "WIDTH HEIGHT"
  170.   PARSE VAR RESULT w h
  171.   Status 'PAGE "INSERT"'
  172.   page=RESULT
  173.   xx=w/2
  174.   yy=h/2
  175.   txtw=0
  176.   /* Remove CR at the end */
  177.   IF C2X(Right(text,1))="0A" THEN
  178.     DO
  179.       len=len-1
  180.       text=Left(text,len)
  181.     END
  182.   text=rembad(text)
  183.   /* Create textobjects */
  184.   DO i=1 TO len
  185.     IF text>"" THEN
  186.       x=SubStr(text,i,1)
  187.     ELSE
  188.       DO
  189.         Extract
  190.         x=RESULT
  191.       END
  192.     Cursor "RIGHT"
  193.     specs=gettexttypespecs()
  194.     TextBlockTypePrefs specs
  195.     IF Verify(x,'";= ',"M")  THEN x='"'||x||'"'
  196.     objs=objs+1
  197.     DrawTextBlock page xx yy x
  198.     obj.objs=RESULT
  199.     Redraw
  200.     /* Save size & number */
  201.     GetObjectCoords obj.objs
  202.     PARSE VAR RESULT x x x objw.objs objh.objs
  203.     txtw=txtw+objw.objs
  204.   END
  205. RETURN
  206. PROC wave: /* Wave it! [1.02] */
  207.   PI=3.141593
  208.   angstep=waves*2*PI/txtw
  209.   wspc=txtw/len*spc
  210.   txtw=txtw+wspc*(len-1)
  211.   wdone=0
  212.   f=0
  213.   o=0
  214.   nr=0
  215.   DO n=1 TO len
  216.     char=SubStr(text,n,1)
  217.     IF txt>0 THEN
  218.       DO
  219.         /* Draw and get size */
  220.         IF Verify(char,'";= ',"M")  THEN char='"'||char||'"'
  221.         objs=objs+1
  222.         DrawTextBlock page xx yy char
  223.         obj.objs=RESULT
  224.         Redraw
  225.         GetObjectCoords obj.objs
  226.         cw=Word(RESULT,4)
  227.         ch=h
  228.       END
  229.     ELSE
  230.       DO
  231.         /* Number and size saved before */
  232.         nr=nr+1
  233.         cw=objw.nr
  234.         ch=objh.nr
  235.         o=obj.nr
  236.       END
  237.     wdone=wdone+cw+wspc
  238.     f=angstep*wdone
  239.     x=xx+wdone-cw/2
  240.     y=yy+amp*Sin(f)-ch/2
  241.     /* Centre char on the oval */
  242.     SetObjectCoords o page x y cw ch
  243.     SetObjectRotation o Trunc(Atan(Cos(f))/PI*180+360)//360
  244.   END
  245. RETURN
  246. PROC group: /* Group objects [1.0] */
  247.   /* Group chars */
  248.   SelectObject
  249.   DO n=1 TO objs
  250.     SelectObject obj.n "MULTIPLE"
  251.   END
  252.   Group
  253.   objs=0
  254.   Redraw
  255. RETURN
  256. PROC bye: /* CALL bye(returnvalue)  You MUST use this instead of EXIT! [1.0] */
  257.   PARSE ARG errnr
  258.   /* Restore decimal delimitter */
  259.   IF deci~="" THEN DocItemPrefs "DECIMAL" deci
  260.   IF lib=1 THEN CALL RemLib(library)
  261.   IF objs~=0 THEN
  262.     DO n=1 TO objs
  263.       DeleteObject obj.n
  264.     END
  265.   EXIT errnr
  266. RETURN
  267. PROC SYNTAX: /* SYNTAX & ERROR handling [1.0] */
  268.   et=ErrorText(RC)
  269. ERROR:
  270.   line=SIGL
  271.   nr=RC
  272.   IF et="" THEN et=fwerrtext.nr
  273.   IF nr>5 THEN ShowMessage 1 1 replacepat(replacepat(replacepat(errtext,"%n",nr),"%l",line),"%t",et)
  274.   CALL bye(nr)
  275. RETURN
  276. PROC rembad: PROCEDURE /* newstr=rembad(str) [1.0] */
  277.   /* Replace unprintable characters by spaces */
  278.   PARSE ARG t
  279.   bad=XRange("00"x,"1F"x)||XRange("7F"x,"9F"x)
  280.   i=Verify(t,bad,"m")
  281.   l=Length(t)
  282.   DO WHILE i>0
  283.     t=Left(t,i-1) Right(t,l-i)
  284.     i=Verify(t,bad,"m")
  285.   END
  286. RETURN t
  287. PROC replacepat: PROCEDURE /* newstr=replacepat(str,pat,replc) [1.0] */
  288.   /* Replace all occurences of a pattern in a string by another one */
  289.   PARSE ARG str,pat,replc
  290.   p=Pos(pat,str)
  291.   DO WHILE p>0
  292.     str=Left(str,p-1)||replc||SubStr(str,p+Length(pat))
  293.     p=Pos(pat,str)
  294.   END
  295. RETURN str
  296. PROC getlanguage: PROCEDURE /* language=getlanguage() [1.01] */
  297.   /* Get preferred language */
  298.   ok=Open(prefs,"ENV:Language","R")
  299.   IF ok THEN
  300.     DO
  301.       language=ReadLn(prefs)
  302.       CALL Close(prefs)
  303.     END
  304. RETURN language
  305. PROC gettexttypespecs: PROCEDURE /*  specs=gettexttypespecs() [1.0] */
  306.   Status "FONTSIZE"
  307.   p="SIZE" RESULT
  308.   Status "FONTLEADING"
  309.   p=p "LEADING" RESULT
  310.   Status "FONTWIDTH"
  311.   p=p "WIDTH" RESULT
  312.   Status "FONTOBLIQUE"
  313.   p=p "OBLIQUE" RESULT
  314.   Status "FONTPOSITION"
  315.   p=p "POSITION" RESULT
  316.   Status "FONTCASE"
  317.   p=p "CASE" RESULT
  318.   Status "FONTSTYLE"
  319.   p=p "STYLE" RESULT
  320.   Status "FONTCOLOR"
  321.   p=p "COLOR" RESULT
  322.   Status "FONTNAME"
  323.   p=p "FONT" RESULT
  324. RETURN p
  325. PROC dump: PROCEDURE /* CALL dump(var[,infostr]) [1.0] */
  326.   /* Dump a variable, %v in infostring determines it's place (debug-only) */
  327.   PARSE ARG v,info
  328.   IF info="" THEN info="%v"
  329.   ShowMessage 1 1 '"'||replacepat(info,"%v",v)||'" "" "" "Ok" "" ""'
  330. RETURN
  331.