NB. base opengl class
NB. built from project: ~Source\classes\graphics\opengl\opengl
NB. gl init

script_z_ '~system\packages\color\colortab.ijs'
script_z_ '~system\main\gl2.ijs'
script_z_ '~system\main\gl3.ijs'
script_z_ '~system\main\trig.ijs'

coclass 'jzopengl'


coextend 'jgl2'
coextend 'jgl3'
COCLASSPATH copath coname''
startlist=: glNewList @ (, & GL_COMPILE)
startnewlist=: ([ glNewList @ (, & GL_COMPILE)) @ (genlist bind 1)
endlist=: glEndList
vtxlist=: 2 : 0
:
glBegin n.
x. u. y.
glEnd ''
)
genlist=: 3 : 0
bgn=. >:>./LISTS,0
if. 2 = 3!:0 y. do.
  nms=. ;: y.
  r=. bgn + i.#nms
  (nms)=: r
else.
  r=. bgn + i.y.
end.
LISTS=: LISTS,r
r
)
genxlist=: 3 : 0
r=. 5001 while. glIsList r do. r=. >:r end.
)
gentexture=: 3 : 0
if. 1=#$y. do. gentexture1D y. else. gentexture2D y. end.
)
gentexture2D=: 3 : 0
b=. <. -: (#y.) - 2 ^ <. 2 ^. #y.
if. 4=3!:0 y. do. y=. 2 (3!:4) ,y. else. y=. y. end.
glEnable GL_TEXTURE_2D
glPixelStore GL_UNPACK_ALIGNMENT, 1
glTexImage2D (GL_TEXTURE_2D, 0 4, ($y.), b, GL_RGBA, GL_UNSIGNED_BYTE) ; y
glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, TEXWRAP
glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, TEXWRAP
glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, TEXFILTER
glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, TEXFILTER
)
gentexture1D=: 3 : 0
b=. <. -: (#y.) - 2 ^ <. 2 ^. #y.
glEnable GL_TEXTURE_1D
glPixelStore GL_UNPACK_ALIGNMENT, 1
glTexImage1D (GL_TEXTURE_1D, 0 4, ($y.), b, GL_RGBA, GL_UNSIGNED_BYTE) ; y.
glTexParameter GL_TEXTURE_1D, GL_TEXTURE_WRAP_S, TEXWRAP
glTexParameter GL_TEXTURE_1D, GL_TEXTURE_MAG_FILTER, TEXFILTER
glTexParameter GL_TEXTURE_1D, GL_TEXTURE_MIN_FILTER, TEXFILTER
)
glenable=: 3 : 0
'f v'=. 2{.y.,1
if. v do. glEnable f else. glDisable f end.
)
glgeterror=: 3 : 0
if. #j=. glGetError'' do. wdinfo 'OpenGL';gluErrorString j end.
)
glnewlist=: 3 : 0
if. 2=3!:0 y. do. y=. ". y. else. y=. y. end.
glNewList y,GL_COMPILE
)
glprintbmp=: 3 : 0
f=. jpath '~temp\gltemp.bmp'
f glwritebmp y.
printbmp f
)
glreset=: 3 : 0
gldefault''
gldefverbs''
)
glwritebmp=: ''&$: : (4 : 0)
wd 'pc print;cc g isigraph ws_clipchildren ws_clipsiblings;'
glaRC 1,BITMAPSIZE=: y.
glEnable GL_DEPTH_TEST
glclearcolor CLEARCOLOR
glcolor COLOR
gldraw''
opengl_g_size''
opengl_g_paint''
glFinish''
glaSaveBMP x.
wd'pclose'
BITMAPSIZE=: ''
)

glstate=: 3 : 0

if. 1{.y. do.
  nms=. <;._2 glSTATE
else.
  j=. 'ROTNDX ROTXYZ SPEED TRNXYZ UNITROT UNITSTEP UNITSCALE'
  nms=. ;:j,' VIEWUP VIEWXYZ INIXYZ'
end.

j=. GLU_FILL,GLU_OUTLINE_PATCH,GLU_OUTLINE_POLYGON
k=. 'FILL';'OUTLINE_PATCH';'OUTLINE_POLYGON';DISPLAYMODE
DISPLAYMODE=. (j i. DISPLAYMODE) pick k

j=. GL_NEAREST, GL_LINEAR
k=. 'NEAREST';'LINEAR';TEXFILTER
TEXFILTER=. (j i. TEXFILTER) pick k

j=. GL_DECAL,GL_BLEND,GL_MODULATE
k=. 'DECAL';'BLEND';'MODULATE';TEXMODE
TEXMODE=. (j i. TEXMODE) pick k

j=. GL_CLAMP,GL_REPEAT
k=. 'CLAMP';'REPEAT';TEXWRAP
TEXWRAP=. (j i. TEXWRAP) pick k
if. 2 ~: {:ROTNDX do.
  f=. 'flipd',1.0":2,{:ROTNDX
  INIXYZ=. f~ ROTXYZ
else.
  INIXYZ=. ROTXYZ
end.
INIXYZ=. 360 | rndint INIXYZ
ROTXYZ=. 360 | rndint ROTXYZ
VIEWUP=. 0.01 round VIEWUP
VIEWXYZ=. 0.01 round VIEWXYZ

rnd=. <.@:+&0.5&.(%&0.0001)
cat=. ,&,.&.|:
x=. (2 + >./# &> nms) {. each nms
f=. ]`rnd @. (e.&8 @ (3!:0))
y=. ":@f@". each nms
r=. x cat each y
> ,&.>/ r
)
makelist=: 2 : 0
glnewlist n.
u. y.
glEndList''
:
glnewlist n.
x. u. y.
glEndList''
)
makelist=: 2 : 0
glnewlist n.
u. y.
glEndList''
:
glnewlist n.
x. u. y.
glEndList''
)
makenewlist=: 1 : 0
glNewList (genlist 1),GL_COMPILE
u. y.
glEndList''
:
glNewList (genlist 1),GL_COMPILE
x. u. y.
glEndList''
)
maketube=: 3 : 0
x=. 0 1{"1 y.
y=. 2 3{"1 y.
h=. {:"1 y.
xy=. -: x+y
r=. (x,.0) , (xy,.h) , (y,.0) ,: xy,.-h
r=. r , 2{.r
0 2 1{"1 [ 1 0 2 |: r
)
makexyz=: 3 : 0
error=. 'error in makexyz' & (13!:8) bind 12
t=. y.
if. 0 = L. t do.
  t=. (i. each $t),<t
end.
'x y z'=. t
shp=. $ each t
if2=. 2 = # &> shp
mat=. +/if2
if. 1=mat do.
  rxy=. ;(-.if2)#shp
  rmat=. ;if2#shp
  if. rxy -: |.rmat do.
    nm=. if2#'xyz'
    ".nm,'=:|:',nm
  elseif. -. rxy -: rmat do.
    error''
  end.
elseif. 2=mat do.
  rz=. ;(-.if2)#shp
  rs=. if2#shp
  rxy=. 0 pick rs
  if. (-:/rs) *: (rz e. rxy) do.
    error''
  end.
elseif. 3=mat do.
  if. -. shp -: 3${.shp do.
    error''
  end.
  rxy=. 0 pick shp
elseif. 1 do.
  error''
  
end.
'r c'=. rxy
if. 2>rank x do.
  x=. c#"1,.x
end.
if. 2>rank y do.
  y=. rxy$y
end.
if. 2>rank z do.
  z=. rxy$z
end.
x ,"0 1 y ,"0 z
)
pushpopmatrix=: 1 : 0
glPushMatrix ''
u. y.
glPopMatrix ''
)

arctanr=: {.@+.@(_3&o.)
assert=: 0 0"_ $ 13!:8^:((0: e. ])`(12"_))
assign=: 4 : '".x.,''=:y.'''
bind=: 2 : 'x.@(y."_)'
boxopen=: <^:(L.=0:)

byrow=: "1
checkers=: ]{.[$~]+2&|@>:@]
chgsign=: * _1&^
cile=: $@] $ ((* <.@:% #@]) /:@/:@,)
cleanz=: * | >: 1e_10"_
cross=: +/ .* (3 3 3$0 0 0 0 0 _1 0 1 0 0 0 1 0 0 0 _1 0 0 0 _1 0 1 0 0 0 0 0)&(+/ .*)
cut=: ' '&$: :([: -.&a: <;._2@,~)
cutxyz=: <"2@(0 1&|:)
deal=: (? #) { ]
dealone=: (?@#) { ]
deb=: #~ (+. 1: |. (> </\))@(' '&~:)
det=: -/ .*
dist=: +/&.(*:"_)
dlb=: }.~ =&' ' i. 0:
drange=: {:-{.
each=: &.>
fetch=: {::
first=: >@{.
fitin=: {.@[ + ({: - {.)@[ * ((- <./@,) % (>./ - <./)@,)@]
fit01=: (- <./@,) % (>./ - <./)@,
fit11=: (- <./@,) <:@% ([: -: >./ - <./)@,
fix=: _1&".
fmt=: ":@:<.@(0.5&+)
getfontsize=: 13 : '{.1{._1 -.~ _1 ". y.'
has=: [: +./ (e.~ boxopen f.)
idmat=: =@i.
index=: [ ((#@[ = ]) { ] , _1:) i.
int01=: i.@>: % ]
int012=: int01@{. ,."0 1 |.@int01@{:
linsert=: [: +/\ {.@] , [ # (}. - }:)@] % [
lsfit=: {:@] %. {.@] ^/ i.@>:@[
matsize=: _2: {. 1 1"_ , $
mid11=: - ([: -: >./ + <./)@,
mp=: +/ . *
out=: 1!:2 & 2
pfmt=: tominus@":
pick=: >@{
pm=: +/ . * ~
tomatrix=: (_2: {. 1 1"_ , $) $ ,
nthword=: +/\@(> 0: , }:)@(~:&' ')@] i. >:@[
partition=: 1: , [: -. }: -:"_1 }.
ranges=: (<./,>./) @ ,
rand01=: ?@$ 0:
rank=: #@$
rank01=: 2: > [: # $
rfd=: *&1r180p1
rndint=: <.@(0.5&+)
rnd=: [ * [: <. 0.5"_ + %~
rnddn=: [ * [: <. %~
rndup=: [ * [: >. %~
signal=: 13!:8&12
sort=: $:~ : /:
split=: {. ; }.
tonum=: 0&". ;. _2
tominus=: '-'&(I. @(e.&'_')@]})
unitnormal=: (% +/&.(*:"_))@(+/)@(_3&(]\))"1
unitvec=: % dist f.
wraptext=: EAV&,@(,&EAV) L:0
col3=: 3 : 0
y=. y.
if. 1=#$y do. y=. _3 [\ y end.
if. 3 < {:$y do. y=. ,/"3 [ _3 [\"1 y end.
3 {."1 y
)
hue=: 4 : 0
y=. y.*<:#x.
b=. x. {~ <.y
t=. x. {~ >.y
k=. y-<.y
(t*k)+b*-.k
)
mfv=: 4 : 0
if. 2 <: #$y. do. y.
else. ];._2 y.,x. #~ x. ~: _1{.x.,y.
end.
)
ncile=: 4 : 0
min=. <./,y.
max=. >./,y.
step=. }: min+(max-min)*(i.>:x.)%x.
<: +/ step <:/ y.
)
normalize=: 3 : 0
v=. (-"1 +/ % #) y.
cleanz v % >./ dist"1 v
)
pack=: [: /:~ [: (, ,&< ".) &> ;:^:(L. = 0:)
pdef=: 3 : 0
if. 0 e. $y. do. empty'' return. end.
names=. {."1 y.
if. #names do. (names)=: {:"1 y. end.
names
:
names=. {."1 y.
nl=. ;:^:(L. = 0:) x.
pdef (names e. nl)#y.
)
printbmp=: 0&$: : (4 : 0)
if. 0=#y. do. return. end.
wd'pc p closeok;cc g isigraph'
if. IFWIN32 do.
  glmap MM_TWIPS
  bmpwh=. _2 (3!:4) 1!:11 y.;18 8
  box=. 2000 4000 8000, 8000%%/bmpwh
  glbmpxywh box
  glbmp y.
else.
  glmap MM_RAW
  p=. readbmp_z_ y.
  xywh=. 0 0,|.$p
  glpixels xywh,,p
end.
glbrushnull''
if. x. do. glrect box end.
glshow''
if. IFWIN32 do.
  glzcreate''
  glzstartdoc 'abc'
  glzstartpage''
  glzprint''
  glzendpage''
  glzenddoc''
else.
  glzstartprint''
  glzprintpage''
end.
wd'pclose'
)
readbmp=: 3 : 0

try. dat=. fread y.
catch. 'file read error' return. end.

if. -. 'BM'-:2{.dat do. 'not a bitmap file' return. end.

toi=. 256&#.@(a.&i.)@(|."1)
bits=. toi 28 29 {dat

if. toi 30 31 32 33{dat do.
  'compressed format not supported' return.
end.

'off shdr cls rws'=. toi (10+i.4 4){dat

pal=. 256 #. a. i. _4 }: \ (shdr+14) }. off{.dat
dat=. off}.dat

if. bits=4 do.
  dat=. a. {~ ,16 16#:a.i.dat
end.

if. bits=1 do.
  |. (rws,cls) $ , #: a.i.dat
  
elseif. bits e. 4 8 do.
  pal {~ a.i. |. (rws,cls){.(rws,cls+4|-cls)$dat
  
elseif. bits=24 do.
  |. (rws,cls) $ 256 #. a. i. _3 [ \ dat
  
elseif. 1 do.
  'only 4,8 and 24-bit bitmaps supported, this is ',(":bits),'-bit'
end.
)
RGBA=: 3 : 0
0 RGBA y.
:
if. x. do.
  y=. (2^32) | y.
  255 %~ |."1[ 256 256 256 256 #: y
else.
  y=. color4 y.
  y=. ,_2(3!:4)"1 a.{~ >. 255 * y
  <. y - (y >: 2^31) * 2^32
end.
)
setfontsize=: 4 : 0
b=. ~: /\ y.='"'
nam=. b#y.
txt=. ;:(-.b)#y.
ndx=. 1 i.~ ([: *./ e.&'0123456789.') &> txt
nam, ; ,&' ' &.> (<fmt x.) ndx } txt
)
shownouns=: 3 : 0
rnd=. <.@:+&0.5&.(%&0.0001)
cat=. ,&,.&.|:
x=. (>:>./# &> y.) {. each y.
f=. ]`rnd @. (e.&8 @ (3!:0))
y=. ":@f@". each y.
r=. x cat each y
> ,&.>/ r
)
sphere2rect=: 3 : 0
'r t p'=. y.
r * (1 1 2 o. t) * (2 1 o. p), 1
)
steps=: {. + (1&{ - {.) * (i.@>: % ])@{:
surfacerev=: 10&$: : (4 : 0)
'r z'=. |: y.
ix=. i. x.+2
'x y'=. 0 1 |: r */ +. r. ix * 2p1%x.
x,"0 1 y,"0 z
)
c=. (}: ,:"1 }.)"2
d=. (}. ,:"1 }:)"2
tiles=: (c@}: ,"2 d@}.) f.


c=. toupper COLORTABLE
val=. ". c

k=. +/"1 val
msk=. (255<:k) *. k<:255*2

STDCLR=: 255 %~ msk#val

color01=: ]`(%&255) @. (1: e. 1: < ,)
color4=: ((3: $ color01) , [: {. (3: }. ]) , 1:) "1
alpha4=: ((3: $ ]) , [: {. (3: }. ]) , 1:) "1

glcolor=: glColor @ color4
glclearcolor=: glClearColor @ color4

ID3=: idmat 3
ID4=: idmat 4

LISTS=: NURBS=: QUADS=: ''
glSTATE0=: glSTATE1=: ''

GCAPTION=: 'OpenGL'
GForm=: 'opengl'
GFormhwnd=: 0
GFormPos=: ''
gldefault=: 3 : 0
AMBIENT=: 0.15 0.15 0.15 1
AXISCOLOR=: WHITE
BITMAPSIZE=: ''
CLEARCOLOR=: BLACK
COLOR=: RED
COLORMATERIAL=: 1
DIFFUSE=: 0.7 0.7 0.7 1
DISPLAYMODE=: GLU_FILL
IFMAXIMIZE=: 0
MATSPECULAR=: 1 1 1 1
ORTHO=: 6 $ 10 * _1 1
PERSPECTIVE=: 30 1 1 15
POSITION=: ''
ROTNDX=: 0 1 2
ROTXYZ=: 0 0 0
SHININESS=: 100 0 0 1
SHOWAXES=: 0
SHOWPOINTS=: 0
SPECULAR=: 0.7 0.7 0.7 1
SPEED=: 1
SPEEDS=: (%16 8 4 2),1 2 4 8 16
SPOTXYZ=: 0 0 _1
SPOTEXPONENT=: 0
SPOTCUTOFF=: 180
TEXCOLOR=: WHITE
TEXFILTER=: GL_NEAREST
TEXMODE=: GL_MODULATE
TEXWRAP=: GL_CLAMP
TRNXYZ=: 0 0 0
UNITROT=: 5
UNITSTEP=: 0.025
UNITSCALE=: 0.02
VIEWUP=: 0 1 0
VIEWXYZ=: 0 0 6
UORDER=: 4
VORDER=: 4
empty''
)
glSTATE=: 0 : 0
AMBIENT
AXISCOLOR
BITMAPSIZE
CLEARCOLOR
COLOR
COLORMATERIAL
DIFFUSE
DISPLAYMODE
IFMAXIMIZE
MATSPECULAR
ORTHO
PERSPECTIVE
POSITION
ROTNDX
ROTXYZ
SHININESS
SHOWAXES
SHOWPOINTS
SPECULAR
SPEED
SPEEDS
SPOTXYZ
SPOTEXPONENT
SPOTCUTOFF
TEXCOLOR
TEXFILTER
TEXMODE
TEXWRAP
TRNXYZ
UNITROT
UNITSTEP
UNITSCALE
VIEWUP
VIEWXYZ
UORDER
VORDER
)
gldefault''

drawaxes=: 1&$: : (4 : 0)
dat=. _1 0 0, 1 0 0, 0 _1 0, 0 1 0, 0 0 _1, 0 0 1
dat=. dat * ($dat)$x.
drawlines dat;'';y.
)
drawpaxes=: 1&$: : (4 : 0)
dat=. 0 0 0, 0 0 1, 0 0 0, 0 1 0, 0 0 0, 1 0 0
dat=. dat * ($dat)$x.
drawlines dat;'';y.
)
drawlines=: 3 : 0
'v s c'=. y.
v=. col3 v
if. #s do. glLineWidth s end.
if. #c do. glcolor c end.
glBegin GL_LINES
glVertex v
glEnd''
)
drawlinestrip=: 3 : 0
'v s c'=. y.
v=. col3 v
if. #s do. glLineWidth s end.
if. #c do. glcolor c end.
glBegin GL_LINE_STRIP
glVertex v
glEnd''
)
drawpoints=: 3 : 0
'v s c'=. y.
v=. col3 v
if. #s do. glPointSize s end.
if. #c do. glcolor c end.
glBegin GL_POINTS
glVertex v
glEnd''
)
drawpolygon=: 3 : 0 "2
'v n c'=. y.
v=. col3 v
if. #n do. glNormal n end.
if. #c do. glcolor c end.
glBegin GL_POLYGON
glVertex v
glEnd''
)
drawsolid=: 3 : 0
'v n c'=. y.
ndx=. #n
if. 0 e. #c do. c=. ndx deal STDCLR end.
c=. ndx $ tomatrix c
while. ndx do.
  ndx=. <:ndx
  glcolor ndx{c
  glBegin GL_POLYGON
  glNormal ndx{n
  glVertex _3 [\ ndx{v
  glEnd''
end.
)
drawsphere=: 3 : 0
obj=. {:QUADS
gluQuadricDrawStyle obj,GLU_FILL
gluQuadricNormals obj,GLU_SMOOTH
gluQuadricTexture obj,1
gluSphere obj,y.
)
drawtubes=: 3 : 0
'v s c'=. y.
v=. col3 v
s=. 2$s,(0=#s)#0.03
if. 0=#QUADS do. QUADS=: gluNewQuadric'' end.
if. #c do. glcolor c end.
s drawtube1 _2 <\ v
)

drawtubestrip=: 3 : 0
'v s c'=. y.
v=. col3 v
v=. ,}: v ,. 1|.v
drawtubes v;s;c
)
drawtube1=: 4 : 0 "1 0
glPushMatrix''
v=. -/ 'f t'=. >y.
len=. dist v
glTranslate f
'x y z'=. 1 1 _1 * v % len
angle=. dfr arccos 1 <. z
axis=. y,-x,0
glRotate angle,axis
gluCylinder ({:QUADS),x.,len,10 1
glPopMatrix''
)
drawviewbox=: 1&$: : (4 : 0)
dat=. _3[\ ,(%{.@,) 1 pick cube''
dat=. x. *"1 dat
glPushAttrib GL_LIGHTING_BIT
glDisable GL_LIGHTING
drawlines dat;'';y.
glEnable GL_LIGHTING
glPopAttrib''
)

selparent=: 1: @ wd @ ('psel '&, @ ":) :: 0:
glclose=: 3 : 0
try.
  wd 'psel ',GForm
  wd 'pclose'
catch. end.
)
glopen=: 3 : 0
if. selparent GFormhwnd do.
  wd 'psel ',GForm,';pshow'
  wd 'pactive'
else.
  wd 'pc ',GForm
  ". GForm,'_close=: glclose'
  wd 'pn *',GCAPTION
  if. 0=#GFormPos do.
    IfVGA=: 640>:{.0".wd 'qm'
    pos=. IfVGA{2 2$200 160 170 140
  else.
    pos=. 2}.GFormPos
  end.
  wd 'xywh 0 0 ',":pos
  wd 'cc g isigraph ws_clipsiblings ws_clipchildren rightmove bottommove'
  glaRC''
  wd 'pas 0 0'
  if. 0=#GFormPos do.
    move=. (IfVGA{190 120), 5
  else.
    move=. 2{.GFormPos
  end.
  if. 0=wpset_j_ GForm do. wdmove _1 0 end.
  GFormhwnd=: wd 'qhwndp'
  wd 'pshow ',IFMAXIMIZE#'sw_showmaximized'
end.
wd 'setfocus g'
)

knotdefault=: 3 : 0
stdknotu=: stdknotv=: defknots
UORDER=: 3
)
makefknot=: 1 : 0
't p r w'=. 4{. y.,<0
rn=. (0.3*r)*knotring p
dat=. u. makefloop t;rn;w
dat=. dat ,"2 [ 0 |. 1 2 {"2 dat
)
knotring=: 3 : 0
cleanz (sin ,. -@cos) (,1 2&{) 2p1 * int01 y.
)
makefloop=: 1 : 0
't p w l'=. y.,(#y.)}.0;0;0;1 1 1
m=. cleanz u."0 t
n=. cleanz unitvec"1 u."0 D. 1 t
x=. l rotateloop n
y=. n cross"1 x
a=. (o. +: w) + arccos 1 <. mp/ 0 _1 { x
f=. ((cos,sin),:-@sin,cos)"0
s=. f a * int01 <:#t
q=. s mp"2 x ,:"1 y
q=. 0 2 |: q
0.5 * m +"2 p mp q
)
rotateloop=: 4 : 0
g=. unitvec x.
r=. i.0 0
y=. y.
while. #y do.
  g=. unitvec g - (g mp {.y) * {.y
  r=. r,g
  y=. }.y
end.
r
)

cube=: 1&$: : (4 : 0)
v=. normalize _1 ^ #: i.8
n=. _2 [\ 0 1 0 2 0 4 1 3 1 5 2 3 2 6 3 7 4 5 4 6 5 7 6 7
e=. ,"2 n { v
n=. 4 6 7 5, 2 3 7 6, 0 2 6 4, 0 4 5 1, 0 1 3 2,: 1 5 7 3
f=. ,"2 n { v
x. *each v;e;f
)
dodecahedron=: 1&$: : (4 : 0)
x=. 2 o. 1r5p1
y=. % <: +: x
a=. |: 2 1 o./ o. (+:i.5)%5
b=. |: 2 1 o./ o. (>:+:i.5)%5
v=. normalize (a,.0),((+:a*x),.1),((+:b*x),.y),b,.>:y
n=. 0 1 0 4 0 5 1 2 1 6 2 3 2 7 3 4 3 8 4 9 5 10 5 14 6 10 6 11
n=. n, 7 11 7 12 8 12 8 13 9 13 9 14 10 15 11 16 12 17 13 18
n=. _2 [\ n,14 19 15 16 15 19 16 17 17 18 18 19
e=. ,"2 n { v
n=. 0 4 3 2 1, 0 1 6 10 5, 1 2 7 11 6, 2 3 8 12 7, 3 4 9 13 8
n=. n, 4 0 5 14 9, 5 10 15 19 14, 6 11 16 15 10, 7 12 17 16 11
n=. _5 [\ n, 8 13 18 17 12, 9 14 19 18 13, 15 16 17 18 19
f=. ,"2 n { v
x. *each v;e;f
)
icosahedron=: 1&$: : (4 : 0)
's c'=. 1 2 o. 1r5p1
x=. %: -. % 4 * *: s
y=. %: (1++:c) % 2++:c
a=. |: (2 1 o./ o. (+:i.5)%5) % +:s
b=. - 3 |. a
v=. normalize 0,(a,.x),(b,.x+y),0 0,y++:x
n=. 0 1 0 2 0 3 0 4 0 5 1 2 1 5 1 6 1 10 2 3 2 6 2
n=. n, 7 3 4 3 7 3 8 4 5 4 8 4 9 5 9 5 10 6 7 6 10 6 11
n=. _2 [\ n, 7 8 7 11 8 9 8 11 9 10 9 11 10 11
e=. ,"2 n { v
n=. 0 2 1, 0 3 2, 0 4 3, 0 5 4, 0 1 5, 1 2 6, 2 3 7, 3 4 8
n=. n, 4 5 9, 5 1 10, 1 6 10, 2 7 6, 3 8 7, 4 9 8, 5 10 9
n=. _3[\n, 11 6 7, 11 7 8, 11 8 9, 11 9 10, 11 10 6
f=. ,"2 n { v
x. *each v;e;f
)

octahedron=: 1&$: : (4 : 0)
v=. normalize 0 0 1, 1 0 0, 0 1 0, _1 0 0, 0 _1 0 ,: 0 0 _1
n=. _2 [\ 0 1 0 2 0 3 0 4 1 2 1 4 1 5 2 3 2 5 3 4 3 5 4 5
e=. ,"2 n { v
n=. 0 1 2, 0 2 3, 0 3 4, 0 4 1, 5 2 1, 5 3 2, 5 4 3,: 5 1 4
f=. ,"2 n { v
x. *each v;e;f
)
tetrahedron=: 1&$: : (4 : 0)
r3=. -%%:3
r2=. %:2
r23=. %:2r3
v=. normalize (0,0,%:3), (0, (+:r23),r3), ((-r2),(-r23),r3),: r2,(-r23),r3
n=. _2 [\ 0 1 0 2 0 3 1 2 1 3 2 3
e=. ,"2 n { v
n=. 0 1 2, 0 2 3, 0 3 1,: 1 3 2
f=. ,"2 n { v
x. *each v;e;f
)

cubeface=: [: > 2: { cube
dodecahedronface=: [: > 2: { dodecahedron
icosahedronface=: [: > 2: { icosahedron
octahedronface=: [: > 2: { octahedron
tetrahedronface=: [: > 2: { tetrahedron
d=. 1 : 'drawsolid @ ((;unitnormal)@x. , <@])'
drawcube=: cubeface d
drawdodecahedron=: dodecahedronface d
drawicosahedron=: icosahedronface d
drawoctahedron=: octahedronface d
drawtetrahedron=: tetrahedronface d

gldefverbs=: 3 : 0
stdaxes=: defaxes f.
stdblend=: defblend f.
stdidentity=: defidentity f.
stdlight=: deflight f.
stdlist=: deflist f.
stdlistlight=: deflistlight f.
stdpaint=: defpaint f.
stdpaintx=: defpaintx f.
stdreset=: gldefault f.
stdrotate=: defrotate f.
stdsize=: defsize f.
stdsizeaspect=: defsizeaspect f.
stdsizeortho=: defsizeortho f.
stdtranslate=: deftranslate f.
stdview=: defview f.
stdknotu=: defknot f.
stdknotv=: defknot f.
empty''
)
defaxes=: 0 0 0&$: : (4 : 0)
'fx tx fy ty fz tz'=: y.
lines=. fx,0 0,tx,0 0 0,fy,0 0,ty,0 0 0,fz,0 0,tz
drawlines lines;x.
)
defblend=: 3 : 0
glEnable GL_BLEND
glBlendFunc GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA
)
defidentity=: 3 : 0
glClear GL_COLOR_BUFFER_BIT + GL_DEPTH_BUFFER_BIT
glEnable GL_DEPTH_TEST
glMatrixMode GL_MODELVIEW
glLoadIdentity''
)
defknot=: 3 : 0
if. y. <: 7 do.
  0 1 #~ (<.,>.) -: y.
else.
  0 0 0, (, 3: # {:) i. y.-6
end.
)

defknots=: i.
deflight=: 0&$: : (4 : 0)
id=. ". 'GL_LIGHT',":x.
glLight id, GL_AMBIENT, color4 AMBIENT
glLight id, GL_DIFFUSE, color4 DIFFUSE
glLight id, GL_SPECULAR, color4 SPECULAR
glEnable GL_LIGHTING
glEnable id
glenable GL_COLOR_MATERIAL,COLORMATERIAL
glColorMaterial GL_FRONT_AND_BACK,GL_AMBIENT_AND_DIFFUSE
glMaterial GL_FRONT_AND_BACK,GL_SPECULAR, alpha4 MATSPECULAR
glMaterial GL_FRONT_AND_BACK,GL_SHININESS, alpha4 SHININESS
if. #POSITION do. glLight id,GL_POSITION, alpha4 POSITION end.
)
deflist=: 3 : 0
genlist 'LIdentity LView LTranslate LRotate'
stdidentity makelist LIdentity ''
stdview makelist LView ''
stdtranslate makelist LTranslate ''
stdrotate makelist LRotate ''
)
deflistlight=: 3 : 0
genlist 'LIdentity LView LTranslate LRotate LLight'
stdidentity makelist LIdentity ''
stdview makelist LView ''
stdtranslate makelist LTranslate ''
stdrotate makelist LRotate ''
stdlight makelist LLight ''
)
defpaint=: 3 : 'glaSwapBuffers glCallLists LISTS'
defpaintx=: glpaintx @ defpaint f.
defreset=: defglobals
defrotate=: 3 : 'glRotate ROTNDX { ROTXYZ ,. ID3'
defsize=: 3 : 0
if. #BITMAPSIZE do. wh=. BITMAPSIZE else. wh=. glqwh'' end.
glViewport 0 0,wh
glMatrixMode GL_PROJECTION
glLoadIdentity''
gluPerspective PERSPECTIVE
glMatrixMode GL_MODELVIEW
glLoadIdentity''
)
defsizeaspect=: 3 : 0
if. #BITMAPSIZE do. wh=. BITMAPSIZE else. wh=. glqwh'' end.
glViewport 0 0,wh
glMatrixMode GL_PROJECTION
glLoadIdentity''
gluPerspective (%/wh) 1 } PERSPECTIVE
glMatrixMode GL_MODELVIEW
glLoadIdentity''
)
defsizeortho=: 3 : 0
if. #BITMAPSIZE do. wh=. BITMAPSIZE else. wh=. glqwh'' end.
glViewport 0 0,wh
glMatrixMode GL_PROJECTION
glLoadIdentity''
glOrtho ORTHO
glMatrixMode GL_MODELVIEW
glLoadIdentity''
)
deftranslate=: 3 : 'glTranslate TRNXYZ'
defview=: 3 : 'gluLookAt VIEWXYZ,0 0 0,VIEWUP'
gldefverbs''

drawsurface=: 3 : 0
1 drawsurface y.
:
'dat clr txt'=. 3 {. boxopen y.

if. 0=#NURBS do. NURBS=: gluNewNurbsRenderer '' end.
nurb=. {:NURBS
gluNurbsProperty nurb, GLU_DISPLAY_MODE, DISPLAYMODE
glEnable ,.GL_AUTO_NORMAL,GL_NORMALIZE
if. 2=x. do. glLightModel GL_LIGHT_MODEL_TWO_SIDE, 1 end.
clr=. drawsurfcolor clr
txt=. drawsurftexture txt
glcolor COLOR
glclearcolor CLEARCOLOR
'ru rv j'=. $dat
du=. ru+UORDER
dv=. rv+VORDER
ku=. stdknotu du
kv=. stdknotv dv
gluBeginSurface nurb
if. 1<#$clr do.
  gluNurbsSurface nurb,du,ku,dv,kv,(rv*4),4,UORDER,VORDER,GL_MAP2_COLOR_4,,clr
end.
if. 1<#$txt do.
  gluNurbsSurface nurb,du,ku,dv,kv,(rv*2),2,UORDER,VORDER,GL_MAP2_TEXTURE_COORD_2,,txt
end.
gluNurbsSurface nurb,du,ku,dv,kv,(rv*3),3,UORDER,VORDER,GL_MAP2_VERTEX_3,,dat
gluEndSurface nurb
if. SHOWPOINTS do. drawpoints (,dat);3;0 0 0 end.
if. SHOWAXES do. stdaxes 6$_1 1 end.
)
drawsurfcolor=: 3 : 0
clr=. y.
if. 0 ~: #clr do.
  if. 3 = {:$clr do.
    ifblend=. 0
    clr=. clr ,"1 [ 1
  else.
    ifblend=. 1 +./ . ~: ,3{"1 clr
  end.
else.
  clr=. 4{.COLOR,1
  ifblend=. 1 ~: 3{clr
end.
if. ifblend do.
  glEnable GL_BLEND
  glBlendFunc GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA
end.
clr
)
drawsurftexture=: 3 : 0
txt=. y.
if. 0 e. $txt do. return. end.
if. 1=#$txt do.
  glEnable GL_TEXTURE_1D
else.
  glEnable GL_TEXTURE_2D
end.
glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, TEXMODE
glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_COLOR, color4 TEXCOLOR
txt
)

rotx=: 3 : 0
's c'=. 1 2 o. y.
3 3$1 0 0 0,c,(-s),0,s,c,0 0
)
roty=: 3 : 0
's c'=: 1 2 o. y.
3 3$c,0,s,0 1 0,(-s),0,c
)
rotz=: 3 : 0
's c'=. 1 2 o. y.
3 3$c,(-s),0,s,c,0 0 0 1
)
rotxyz=: 4 : 0
'x y z'=. a=. unitvec y.
s=. 3 3$0 _1 1 1 0 _1 _1 1 0 * 0,z,y,z,0,x,y,x,0
b=. (,.a) mp ,:a
cleanz b + ((cos x.)*ID3-b) + s * sin x.
)
flipxz=: 3 : 0
if. 1 < +/ y. = 0 do. y. return. end.
'sx sy sz cx cy cz'=. , 1 2 o./ y.
CX=. cos X=. arctanr ((sx*cz) - cx*sy*sz) % cx*cy
CY=. cos Y=. arctanr ((cx*sy*cz) + sx*sz) * CX % cx*cy
CY=. cos Y=. Y + o. 0 > */ * cx,cy,CX,CY
CZ=. cos Z=. arctanr ((cx*sz) - sx*sy*cz) % cy*cz
Z=. Z + o. 0 > */ * cy,cz,CY,CZ
cleanz X,Y,Z
)
flipzx=: 3 : 0
if. 1 < +/ y. = 0 do. y. return. end.
'sx sy sz cx cy cz'=. , 1 2 o./ y.
CZ=. cos Z=. arctanr ((cx*sz) + sx*sy*cz) % cy*cz
CY=. cos Y=. arctanr ((cx*sy*cz) - sx*sz) * CZ % cy*cz
CY=. cos Y=. Y + o. 0 > */ * cy,cz,CY,CZ
CX=. cos X=. arctanr ((sx*cz) + cx*sy*sz) % cx*cy
X=. X + o. 0 > */ * cx,cy,CX,CY
cleanz X,Y,Z
)
flipxy=: 3 : 0
if. 1 < +/ y. = 0 do. y. return. end.
'sx sy sz cx cy cz'=. , 1 2 o./ y.
CY=. cos Y=. arctanr ((cx*sy*cz) + sx*sz) % cy*cz
CZ=. cos Z=. arctanr ((cx*sz) - sx*sy*cz) * CY % cy*cz
CZ=. cos Z=. Z + o. 0 > */ * cy,cz,CY,CZ
CX=. cos X=. arctanr (sx*cy) % j=. (cx*cz) + sx*sy*sz
X=. X + o. 0 > */ * CX,CZ,j
cleanz X,Y,Z
)
flipyx=: 3 : 0
if. 1 < +/ y. = 0 do. y. return. end.
'sx sy sz cx cy cz'=. , 1 2 o./ y.
CZ=. cos Z=. arctanr ((cx*cy*sz) + sx*sy) % cy*cz
CY=. cos Y=. arctanr ((cx*sy) - sx*cy*sz) * CZ % cy*cz
CY=. cos Y=. Y + o. 0 > */ * cy,cz,CY,CZ
CX=. cos X=. arctanr (sx*cz) % j=. (cx*cy) + sx*sy*sz
X=. X + o. 0 > */ * CX,CY,j
cleanz X,Y,Z
)

flipyz=: flipxz @ flipyx
flipzy=: flipxy @ flipzx
rfdmin=: cleanz @ rfd @ (180&|&.(90&+))
rfdmin=: cleanz @ rfd @ (+ 0.0001"_*0:=90&|)
flipd10=: dfr @ flipxy @ rfdmin
flipd01=: dfr @ flipyx @ rfdmin
flipd20=: dfr @ flipxz @ rfdmin
flipd02=: dfr @ flipzx @ rfdmin
flipd21=: dfr @ flipyz @ rfdmin
flipd12=: dfr @ flipzy @ rfdmin

glinit=: 3 : 0
glsnap 0
opengl_g_paint=: stdpaint
if. y. do. opengl_g_size=: stdsizeaspect
else. opengl_g_size=: stdsize end.
glopen''
if. #LISTS do. try. glDeleteLists (<./LISTS),#LISTS catch. end. end.
if. #NURBS do. try. gluDeleteNurbsRenderer each NURBS catch. end. end.
if. #QUADS do. try. gluDeleteQuadric each QUADS catch. end. end.
LISTS=: NURBS=: QUADS=: ''
glEnable GL_DEPTH_TEST
glclearcolor CLEARCOLOR
glcolor COLOR
)
glsnap=: 3 : 0
j=. 'ROTNDX ROTXYZ SPEED TRNXYZ VIEWUP VIEWXYZ'
j=. pack j,' UNITROT UNITSTEP UNITSCALE'
glSTATE1=: j
if. y.=0 do. glSTATE0=: j end.
empty''
)
glflip=: 3 : 0
f=. 'flipd',1.0":y.,{:ROTNDX
ROTXYZ=: f~ ROTXYZ
ROTNDX=: y. pick 2 1 0;0 2 1;0 1 2
)
glrotate=: 3 : 0
ROTXYZ=: 360 | ROTXYZ + y.
:
if. x. ~: {:ROTNDX do. glflip x. end.
glrotate y.
)
glfly=: 4 : 0
rot=. (rfd x.) rotxyz y.
VIEWXYZ=: rot mp VIEWXYZ
VIEWUP=: rot mp VIEWUP
)
gltranslate=: 3 : 'TRNXYZ=: TRNXYZ + y.'
glzoom=: 3 : 'VIEWXYZ=: VIEWXYZ * y.'
glview=: 3 : 0
startlist LView
stdview''
endlist''
startlist LTranslate
stdtranslate''
endlist''
startlist LRotate
stdrotate''
endlist''
if. IFJAVA do. glpaintx'' else. opengl_g_paint'' end.
)
opengl_g_char=: 3 : 0
key=. (161 162 165 166 167 168 { a.), '123456789iojklxyz'
dat=. tolower sysdata
s=. '1' = {.sysmodifiers
while. key e.~ sel=. {.dat do.
  s handle_key a.i.sel
  glview''
  dat=. }. dat
end.
)
handle_key=: 4 : 0 " 0
k=. y.[s=. x.
select. k
case. 161;162 do.
  ((s { 1 5) * SPEED*UNITROT chgsign k=162) glfly VIEWXYZ
case. 165;167 do.
  ((s { 1 5) * SPEED*UNITROT chgsign k=165) glfly VIEWUP
case. 166;168 do.
  ((s { 1 5) * SPEED*UNITROT chgsign k=168) glfly VIEWXYZ cross VIEWUP
case. 120;121;122 do.
  b=. k=120 121 122
  (b i. 1) glrotate SPEED*UNITROT * b chgsign s
case. 105;111 do. glzoom (>:SPEED*UNITSCALE) ^ {. (s { 1 5) chgsign k=105
case. 106;107;108 do.
  gltranslate SPEED*UNITSTEP * (k=106 107 108) chgsign s
case. <@>49+i.10 do.
  SPEED=: SPEEDS {~ k-49
end.
)
glrotone=: glview @ glrotate

opengl_f3_fkey=: glsnap bind 1
opengl_f4_fkey=: 3 : 'glview pdef glSTATE1'
opengl_f4shift_fkey=: 3 : 'glview pdef glSTATE0'

opengl_f5_fkey=: 0&glrotone bind 45 0 0
opengl_f6_fkey=: 1&glrotone bind 0 45 0
opengl_f7_fkey=: 2&glrotone bind 0 0 45

opengl_f5shift_fkey=: 0&glrotone bind _45 0 0
opengl_f6shift_fkey=: 1&glrotone bind 0 _45 0
opengl_f7shift_fkey=: 2&glrotone bind 0 0 _45

opengl_f5ctrl_fkey=: 0&glrotone bind 180 0 0
opengl_f6ctrl_fkey=: 1&glrotone bind 0 180 0
opengl_f7ctrl_fkey=: 2&glrotone bind 0 0 180