The J script d:\wwifs\wwifs.ijs

NB. Script wwifs.ijs for creating fractal words using nonlinear transformations
NB. Written by Ben, Cliff, and Zach Reiter
NB. Last Update June 21, 1998
NB. This script requires J which may be obtained from http://www.jsoftware.com
NB. Save this script and run it from the J run menu
NB. Run word of words by typing in the J execution window:
NB. wwifs ''
NB. See further details in "about" below.

require 'files'

about=: 0 : 0
The fractal engine was written by Clifford A. Reiter (reiterc@lafayette.edu).
The transformations for the letters were written by Benjamin J. Reiter and Zachary X. Reiter.
The GUI interface was programmed by Zachary X. Reiter.
The help file was written by Benjamin J. Reiter.
All programming was done in J.
This program is freely available for noncommercial use.
Last update June 21, 1998.
)

help=: 0 : 0
WWIFS Help

Go! - Begin running the fractal word
New - Restores defaults
Save - Saves the fractal as a Bitmap
Exit - Terminates program

Note:
The word must be in CAPS for the program to run properly
WWIFS stands for Word of Words Iterated Functions System
)

NB. base form

WORD=: 0 : 0
pc word closeok nomax nosize;pn "Word of Words";
menupop "&File";
menu nw "&New" "" "New Image" "";
menu sa "&Save" "" "Save Image" "";
menu pr "&Print" "" "Print Image" "";
menusep ;
menu x "E&xit" "" "" "";
menupopz;
menupop "&Help";
menu hlp "&Help" "" "Help" "";
menusep ;
menu abt "&About..." "" "About" "";
menupopz;
xywh 5 5 77 18;cc txt edit ws_border es_autohscroll es_uppercase;
xywh 5 70 77 18;cc go button;cn "Go!";
xywh 85 4 117 18;cc s1 static;cn "Enter your word";
xywh 5 27 76 18;cc times edit ws_border es_autohscroll;
xywh 85 27 116 20;cc s2 static;cn "Enter the thousands of iterations";
xywh 5 49 76 18;cc size edit ws_border es_autohscroll;
xywh 85 50 117 18;cc s3 static;cn "Enter a Letter Size";
xywh 86 71 109 20;cc s4 static;cn "Hit Go! to begin iterating the word";
pas 5 5;pcenter;
rem form end;
)

word_run=: 3 : 0
require 'gl2'
wd WORD
NB. initialize form here
donow=:0
wd 'pshow;'
wd 'set size "150";'
wd 'set times "10";'
wd 'set txt "WORD";'
)

word_x_button=: 3 : 0
wd 'pclose;'
)

word_go_button=: 3 : 0
w=.txt
if. w-:'' do. w=.'WORD' end.
t=.times
t=.{.".t,' 10'
s=.size
s=.{.".s,' 150'
(t;s) wordofwords w
)

word_nw_button=: 3 : 0
wd 'set size "150";'
wd 'set times "10";'
wd 'set txt "WORD";'
)

word_sa_button=: 3 : 0
NB. file=.wd 'mbsave "Save" "\j304b\" "" "Bitmap (*.bmp)|*.bmp|Bitmap (*.dib)|*.dib|";'
file=.wd 'mbsave "Save" "" "" "Bitmap (*.bmp)|*.bmp|Bitmap (*.dib)|*.dib|";'
f=.fread 'temp_vra.bmp'
k=.f fwrite file
)

word_abt_button=: 3 : 0
wd 'mb "About Word of Words" "',about,'";'
)

word_hlp_button=: 3 : 0
wd 'mb "Help" "',help,'";'
)

word_enter_button=: 3 : 0
word_go_button ''
)

word_pr_button=: 3 : 0
print 'temp_vra.bmp'
)

bmpwh=: verb define
_2 (3!:4) 1!:11 y.;18 8
)

print=: verb define
wd'pc p closeok;cc g isigraph'
glmap MM_TWIPS
box=.2000 4000 8000, 8000*%%/bmpwh y. NB. bmp aspect ratio
glbmpxywh box
glbmp y.
glbrushnull''
glrect box
glshow''
glzcreate''
glzstartdoc 'abc'
glzstartpage''
glzprint''
glzendpage''
glzenddoc''
wd'pclose'
)

sq=:#:>:+:i.4

x=: +/ . * NB. matrix product
sin=: 1&o. NB. sine
cos=: 2&o. NB. cosine
pi=:1p1
satm=: 3 : '3 3$1j3 1j1 1 1 1#y.,1' NB. Scale And Translate matrix
rotm=: (cos , -@sin , 0:),(sin , cos , 0:),: 0: , 0: , 1: NB. clockwise rotation matrix
ratm=: 4 : '(satm (2{.x.),0 0)x (rotm y.)x satm 1 1,_2{.x.' NB. scale, Rotate And Translate matrix
sat=: 1 : 'x & (satm x.)' NB. transformation that applies the satm matrix
rat=: 2 : 'x & (x. ratm y.)' NB. transformation that applies the ratm matrix
pol=: 2 : '(({.x.)&-@((-/x.)&*)@(1&{) ,&1@+.@r. ({.y.)&-@((-/y.)&*)@(0&{))"1' NB. polar trans; left bounds on r; right, theta

A=:(1 1r8 7r16 15r16 rat 1.10715)`(1 1r8 1r8 1r32 rat _1.10715)`(3r8 1r8 5r16 13r32 sat)
B=:(1 1r8 0 1 rat 1r2p1)`(3r2 1r2 1r8 3r4 sat@(3r8 1r2 pol 1r2p1 0))`(3r2 1r2 1r8 3r4 sat@(3r8 1r2 pol _1r2p1 0))`(3r2 1r2 1r8 1r4 sat@(3r8 1r2 pol 1r2p1 0))`(3r2 1r2 1r8 1r4 sat@(3r8 1r2 pol _1r2p1 0))
C=:(1 1 1r2 1r2 sat@(3r8 1r2 pol _1p1 _1r2p1))`(1 1 1r2 1r2 sat@(3r8 1r2 pol 1p1 1r2p1))`(3r8 1r8 1r2 7r8 sat)`(3r8 1r8 1r2 0 sat)
D=:(1 1r8 0 1 rat 1r2p1)`(3r2 1 1r8 1r2 sat@(3r8 1r2 pol 1r2p1 0))`(3r2 1 1r8 1r2 sat@(3r8 1r2 pol _1r2p1 0))
E=:(7r8 1r8 1r8 0 sat)`(7r8 1r8 1r8 7r8 sat)`(6r8 1r8 1r8 7r16 sat)`(1 1r8 0 1 rat 1r2p1)
F=:(7r8 1r8 1r8 7r8 sat)`(6r8 1r8 1r8 7r16 sat)`(1 1r8 0 1 rat 1r2p1)
G=:(1 1 1r2 1r2 sat@(3r8 1r2 pol _1p1 _1r2p1))`(1 1 1r2 1r2 sat@(3r8 1r2 pol 1r2p1 1p1))`(3r8 1r8 1r2 7r8 sat)`(1 1 1r2 1r2 sat@(3r8 1r2 pol _1r2p1 0))`(1r2 1r8 1r2 4r8 sat)
H=:(1 1r8 0 1 rat 1r2p1)`(1 1r8 7r8 1 rat 1r2p1)`(6r8 1r8 1r8 7r16 sat)
I=:(7r8 1r8 1r8 0 sat)`(7r8 1r8 1r8 7r8 sat)`(6r8 1r8 7r16 7r8 rat 1r2p1)
J=:(2r3 1r8 7r8 1 rat 1r2p1)`(1 2r3 1r2 1r3 sat@(3r8 1r2 pol 0 _1r2p1))`(1 2r3 1r2 1r3 sat@(3r8 1r2 pol _1p1 _1r2p1))
K=:(3r2 1 1r8 0 sat@(3r8 1r2 pol 1r2p1 0))`(3r2 1 1r8 1 sat@(3r8 1r2 pol _1r2p1 0))`(1 1r8 0 1 rat 1r2p1)NB.`(3r8 1r8 1r8 3r8 sat)NB.`(1 1 1r8 1 sat@(3r8 1r2 pol _1r2p1 0))`(1 1 1r2 0 sat@(3r8 1r2 pol 0 1r2p1))
L=:(7r8 1r8 1r8 0 sat)`(1 1r8 0 1 rat 1r2p1)
M=:(7r8 1r8 1r32 15r16 rat 1.10715)`(7r8 1r8 4r8 5r32 rat _1.10715)`(1 1r8 0 1 rat 1r2p1)`(1 1r8 7r8 1 rat 1r2p1)
N=:(1 1r8 0 1 rat 1r2p1)`(1 1r8 7r8 1 rat 1r2p1)`(9r8 1r8 1r8 7r8 rat 49r180p1)
O=:(1 1 1r2 1r2 sat@(3r8 1r2 pol _1r2p1 0))`(1 1 1r2 1r2 sat@(3r8 1r2 pol _1r2p1 _1p1))`(1 1 1r2 1r2 sat@(3r8 1r2 pol 1r2p1 0))`(1 1 1r2 1r2 sat@(3r8 1r2 pol 1r2p1 1p1))
P=:(1 1r8 0 1 rat 1r2p1)`(3r2 1r2 1r8 3r4 sat@(3r8 1r2 pol 0 1r2p1))`(3r2 1r2 1r8 3r4 sat@(3r8 1r2 pol _1r2p1 0))
Q=:(1 1 1r2 1r2 sat@(3r8 1r2 pol _1r2p1 0))`(1 1 1r2 1r2 sat@(3r8 1r2 pol _1r2p1 _1p1))`(1 1 1r2 1r2 sat@(3r8 1r2 pol 1r2p1 0))`(1 1 1r2 1r2 sat@(3r8 1r2 pol 1r2p1 1p1))`(7r16 1r8 1r2 5r16 rat 45r180p1)
R=:(1 1r8 0 1 rat 1r2p1)`(3r2 1r2 1r8 3r4 sat@(3r8 1r2 pol 0 1r2p1))`(3r2 1r2 1r8 3r4 sat@(3r8 1r2 pol _1r2p1 0))`(3r2 1 1r8 0 sat@(3r8 1r2 pol 1r2p1 0))
S=:(3r2 1 1r2 23r32 sat@(5r32 9r32 pol 3r2p1 1r2p1))`(4r8 1r8 4r8 7r8 sat)`(3r2 1 1r2 9r32 sat@(5r32 9r32 pol 1r2p1 _1r2p1))`(4r8 1r8 0 0 sat)
T=:(7r8 1r8 1r8 7r8 sat)`(7r8 1r8 7r16 7r8 rat 1r2p1)
U=:(2r3 1r8 0 1 rat 1r2p1)`(2r3 1r8 7r8 1 rat 1r2p1)`(1 2r3 1r2 1r3 sat@(3r8 1r2 pol 0 _1r2p1))`(1 2r3 1r2 11r32 sat@(3r8 1r2 pol _1p1 _1r2p1))
V=:(1 1r8 0 15r16 rat 1.10715)`(1 1r8 5r8 1r32 rat _1.10715)
W=:(1 1r8 0 1 rat 1r2p1)`(1 1r8 7r8 1 rat 1r2p1)`(5r8 1r8 3r8 0.485 rat 45r180p1)`(1r2 1r8 3r8 1r2 rat 135r180p1)
X=:(5r8 1r8 3r8 0.485 rat 45r180p1)`(5r8 1r8 0 29r32 rat 45r180p1)`(1r2 1r8 3r8 1r2 rat 135r180p1)`(5r8 1r8 14r16 63r64 rat 135r180p1)
Y=:(1r2 1r8 7r16 1r2 rat 1r2p1)`(5r8 1r8 0 29r32 rat 45r180p1)`(5r8 1r8 14r16 63r64 rat 135r180p1)
Z=:(8r8 1r8 0 0 sat)`(8r8 1r8 0 7r8 sat)`(9r8 1r8 1r8 1r8 rat _35r180p1)
flip=:_1 _1 1 1 sat
a=:{.(1 1r8 7r16 1 rat 1r2p1)`+
b=:(1 1 0.32 0.6 sat@(4r16 6r16 pol 13r16p1 _3r8p1))`(1 1r8 0 0 sat)`(0.6 1r8 0.09 0 rat _3r16p1)
c=:(3r2 1r2 1r8 3r4 sat@(3r8 1r2 pol 1r2p1 0))`(3r2 1r2 1r8 3r4 sat@(3r8 1r2 pol _1r2p1 0))`(3r2 1r2 1r8 1r4 sat@(3r8 1r2 pol 1r2p1 0))`(3r2 1r2 1r8 1r4 sat@(3r8 1r2 pol _1r2p1 0))
d=:(7r8 1r8 0 9r16 sat)`(1 1r8 7r8 1 rat 1r2p1)`(5r16 1r8 0 1 rat 1r2p1)
e=:(1r2 1r8 0 1 rat 1r2p1)`(3r2 1r2 1r8 1r4 sat@(3r8 1r2 pol 1r2p1 0))`(3r2 1r2 1r8 1r4 sat@(3r8 1r2 pol _1r2p1 0))`(7r8 1r8 1r8 7r8 sat)
NB. f see below
g=:(8r8 1r8 0 7r8 sat)`(19r16 1r8 1r8 0r8 rat _45r180p1)
h=:(1 1r2 1r2 1r4 sat@(3r8 1r2 pol 1r2p1 _1r2p1))`(1 1r2 1r2 1r4 sat@(3r8 1r2 pol _1r2p1 _3r2p1))`(1 1r2 1r2 3r4 sat@(3r8 1r2 pol 1r2p1 _1r2p1))`(1 1r2 1r2 3r4 sat@(3r8 1r2 pol _1r2p1 _3r2p1))
i=:(3r2 1 1r2 23r32 sat@(5r32 9r32 pol 3r2p1 1r2p1))`(3r8 1r8 1r2 7r16 sat)`(1 1 1r2 1r2 sat@(3r8 1r2 pol _1r2p1 0))`(3r8 1r8 1r8 0 sat)`(1 1 1r2 1r2 sat@(3r8 1r2 pol 1r2p1 0))
f=:(flip@(3r2 1 1r2 23r32 sat)@((5r32 9r32 pol 3r2p1 1r2p1)))`(flip@(3r8 1r8 1r2 7r16 sat))`(flip@(1 1 1r2 1r2 sat@(3r8 1r2 pol _1r2p1 0)))`(flip@(3r8 1r8 1r8 0 sat))`(flip@(1 1 1r2 1r2 sat@(3r8 1r2 pol 1r2p1 0)))
j=:(1 1 1r2 1r2 sat@(3r8 1r2 pol _1r2p1 0))`(1 1 1r2 1r2 sat@(3r8 1r2 pol _1r2p1 _1p1))`(1 1 1r2 1r2 sat@(3r8 1r2 pol 1r2p1 0))`(1 1 1r2 1r2 sat@(3r8 1r2 pol 1r2p1 1p1))`(6r8 1r8 12r16 50r64 rat 135r180p1)
k=:(0 0r8 0 0 sat)`(0 0r8 0 7r8 sat)

alf1=:'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 abcdefghijklmnopqrstuvwxyz'
alf2=:'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijkABCDEFGHIJKLMNOPQRSTUVWXYZ' NB. Alphabets Used by Switch

switch=: 3 : '(alf1 i. y.){alf2' NB. Switch text to encoded word

rtiter=: 3 : 0
100 rtiter y.
:
k=.0
y=.,:rt^:100 y.
while. k<x. do.
y=. rt^:(i.1000) {:y
vspixel y
vrashow ''
k=.>:k
end.
)


NB. Sets normal coordinate pixels (Cartesian or homogeneous)
vspixel=: 3 : 0
1 vspixel y.
:
NB. yyy=:y.
d=.{:$y.
s=.$vra
$vra=:s$x.((<.y.*"1 d{.|.s) +/ . * d{.1,{:s)},vra
)

makevra=:3 : 0 NB. make a virtual raster array
500 500 makevra y.
:
vra=:x.$0
((255,:0 0 0);|.vra) writebmp8 'temp_vra.bmp'
tempvratxt=.'pc wordofwords closeok;pn "',y.,'";pcenter;xywh 4 4 ',":<.|.-:$vra
wd tempvratxt,';cc p isipicture rightmove bottommove;set p temp_vra.bmp;pas 4 4;pshow sw_showna;'
)

NB. Virtual Raster Array SHOW; palette is the argument
vrashow=: 3 : 0
if. 0=#y. do. pal=.255,:0 0 0 else. pal=.y. end.
(pal;|.vra) writebmp8 'temp_vra.bmp'
wd 'set p temp_vra.bmp;pshow;'
)

NB. gerund table builder
gertab=: (4 : '{.".''('',x.,'')`]''')"1 0

NB. the word

wordofwords=: 4 : 0
('t';'s')=.x.
word=.y. NB. The letters
word=.switch word NB. Fix the Word
nl=:#word NB. Number of letters
trns=:;<@"."0 word NB. All the transformations
shifts=:(# (% * i.)@#)#@"."0 word NB. where each letter belongs
strns=:'((0.95%nl),1,(y.{shifts),0) sat@((y.{trns)`:0)' gertab i.#shifts NB. shifted transformations
rt=:strns@.(?@((#shifts)"_))
(s*1,nl) makevra y.
t rtiter 0.1 0.1 1
)

NB. write 8-bit uncompressed *.bmp files
writebmp8=: 3 : 0
:
('spal';'sbmp')=.$@>"0 x.
xsbmp=.sbmp+(i.2)*4|-sbmp
h=.524289 0,(*/xsbmp),0 0,2#spal=.0{spal
h=.(54+(4*spal)+*/xsbmp),0,(54+4*spal),40,(|.sbmp),h
head=. 'BM',,a.{~,|."1 (4#256)#:h
pal=. ,(0,"1~|."1 >{.x.){a.
bmp=. ,|.(xsbmp{.>{:x.){a.
(head,pal,bmp) 1!:2 <y.
)

wwifs=:word_run

NB. Run Program with: wwifs ''