GOTO main:
intro:
PRINT "                R O T               "
PRINT "                                       "
PRINT "---------------------------------------"
PRINT "                                       "
PRINT "    Note: le routine in  AmigaBasic"
PRINT "    sono molto lente la prima volta"
PRINT "    che vengono lette."
PRINT "    Siate pazienti se ROT vi sembra" 
PRINT "    troppo stressante."
RETURN

main:
  IF FRE(0)<100000& THEN CLEAR,150000&
  GOSUB init
  quit=0
  WHILE NOT(quit)
    b=MOUSE(0)
    x=MOUSE(1)
    y=MOUSE(2)
    IF b<>0 THEN
      IF objscr THEN GOSUB edobj
      IF actscr THEN GOSUB edact
    END IF
    m=MENU(0)
    i=MENU(1)
    IF m<>0 THEN GOSUB menuchk
    z$=INKEY$
    IF z$<>"" THEN GOSUB keychk
  WEND
  GOSUB cleanup
END

menuchk:
  ON m GOSUB rotmenu, objmenu, actmenu
RETURN
rotmenu:
  IF i=1 THEN GOSUB listfiles
  IF i=3 THEN quit=(-1)
  RETURN
  
objmenu:
  IF i=1 AND objscr=0 THEN
    objscr=(-1)
    actscr=0
    MENU 2,1,2
    MENU 2,2,1
    MENU 2,3,1
    MENU 2,4,1
    MENU 3,1,1
    MENU 3,2,0
    MENU 3,3,0
    MENU 3,4,0
    MENU 3,6,0
    MENU 3,7,0
    MENU 3,8,0
    GOSUB drw.objscr
  END IF
  IF i=2 THEN GOSUB loadobj
  IF i=3 THEN GOSUB saveobj
  IF i=4 THEN GOSUB newobj
RETURN

actmenu:
  IF i=1 AND actscr=0 THEN
    actscr=(-1)
    objscr=0
    MENU 3,1,2
    MENU 3,2,1
    MENU 3,3,1
    MENU 3,4,1
    MENU 3,6,1+ABS(actrpt)
    MENU 3,7,1+ABS(actrev)
    MENU 3,8,1
    MENU 2,1,1
    MENU 2,2,0
    MENU 2,3,0
    MENU 2,4,0
    FOR n=1 TO 12
      frmchg(n)=1
    NEXT
    GOSUB drw.actscr
  END IF
  IF i=2 THEN GOSUB loadact
  IF i=3 THEN GOSUB saveact
  IF i=4 THEN GOSUB newact
  IF i=6 THEN
    actrpt=NOT(actrpt)
    MENU 3,6,1+ABS(actrpt)
  END IF
  IF i=7 THEN
    actrev=NOT(actrev)
    MENU 3,7,1+ABS(actrev)
  END IF
  IF i=8 THEN GOSUB calctween
RETURN

listfiles:
  s$="File in:"
  GOSUB drw.filereq
  s$="DF0:"
  GOSUB getstring2
  IF s$<>"c" AND s$<>"C" AND s$<>"" THEN
    CLS
    FILES s$
    PRINT
    GOSUB click.continue
    IF objscr<>0 THEN
      GOSUB drw.objscr       
    ELSE
      GOSUB drw.actscr
    END IF
    GOSUB nobut
  END IF
RETURN

loadobj:
  s$="Load:"                                     
  GOSUB drw.filereq
  GOSUB getstring
  IF s$<>"c" AND s$<>"C" AND s$<>"" THEN
    s$=s$+".ROTOBJ"
    OPEN s$ FOR INPUT AS #1
    FOR n=0 TO 95
      FOR n2=0 TO 3
        INPUT#1,pt(n,n2)
      NEXT
    NEXT                    
    FOR n=0 TO 95
      FOR n2=0 TO 6
        INPUT#1,poly(n,n2)
      NEXT
    NEXT
    FOR n=0 TO 95
      INPUT#1,polyclr(n)
    NEXT
    FOR n=0 TO 95
      INPUT#1,vrt(n)
    NEXT
    CLOSE #1
    pt=1
    poly=1
  END IF
  GOSUB drw.objscr
RETURN

saveobj:
  s$="Save:"
  GOSUB drw.filereq
  GOSUB getstring
  IF s$<>"c" AND s$<>"C" AND s$<>"" THEN
    s$=s$+".ROTOBJ"
    OPEN s$ FOR OUTPUT AS #1
    FOR n=0 TO 95
      FOR n2=0 TO 3
        PRINT#1,pt(n,n2);
      NEXT
    NEXT
    FOR n=0 TO maxpoly
      FOR n2=0 TO 6
        PRINT#1,poly(n,n2);
      NEXT
    NEXT
    FOR n=0 TO maxpoly
      PRINT#1,polyclr(n);
    NEXT
    FOR n=0 TO maxpoly
      PRINT#1,vrt(n);
    NEXT
    CLOSE #1
  END IF
  GOSUB drw.objscr
RETURN

newobj:
  s$="   Cancello l'oggetto?"
  GOSUB you.sure
  IF sure THEN
    FOR n=0 TO maxpt
      FOR n2=0 TO 2
        pt(n,n2)=0
      NEXT
    NEXT
    FOR n=0 TO maxpoly
      FOR n2=0 TO 6
        poly(n,n2)=0
      NEXT
      polyclr(n)=0
      vrt(n)=0
    NEXT
    pt=1
    poly=1
  END IF
  GOSUB drw.objscr
RETURN
                               
loadact:
  s$="Load:"
  GOSUB drw.filereq
  GOSUB getstring
  IF s$<>"c" AND s$<>"C" AND s$<>"" THEN
    s$=s$+".ROTACT"
    OPEN s$ FOR INPUT AS #1
    FOR n=1 TO 12
      INPUT#1,xrot(n),yrot(n),zrot(n)
      INPUT#1,xtran(n),ytran(n),ztran(n)
    NEXT
    INPUT#1,spd,actrpt,actrev
    CLOSE#1
    frm=1
    FOR n=1 TO 12
      frmchg(n)=1
    NEXT
    GOSUB drw.frmnum
    GOSUB drw.spdnum
    GOSUB drw.factors
    GOSUB drw.update
    MENU 3,6,1+ABS(actrpt)
    MENU 3,7,1+ABS(actrev)
  END IF
  LINE (0,0)-(311,131),0,bf
  GOSUB putfrm
RETURN

saveact:
  s$="Save:"
  GOSUB drw.filereq
  GOSUB getstring
  IF s$<>"c" AND s$<>"C" AND s$<>"" THEN
    s$=s$+".ROTACT"
    OPEN s$ FOR OUTPUT AS #1
    FOR n=1 TO 12
      PRINT#1,xrot(n);yrot(n);zrot(n);
      PRINT#1,xtran(n);ytran(n);ztran(n);
    NEXT
    PRINT#1,spd;actrpt;actrev;
    CLOSE #1
  END IF
  LINE(0,0)-(311,131),0,bf
  GOSUB putfrm
RETURN

newact:
  s$="   Cancello l'azione?"
  GOSUB you.sure
  IF sure THEN
    FOR n=0 TO 12
      xrot(n)=0:yrot(n)=0:zrot(n)=0
      xtran(n)=0:ytran(n)=0:ztran(n)=0
    NEXT
    spd=20
    actrpt=0
    actrev=0
    MENU 3,6,1
    MENU 3,7,1
    frm=1
  END IF
  GOSUB drw.actscr
RETURN

calctween:
  GOSUB gettween
  IF stfrm>endfrm THEN SWAP stfrm,endfrm
  stp=endfrm-stfrm
  LINE(0,0)-(311,131),0,bf
  IF stp>1 THEN
    xrot=xrot(endfrm)-xrot(stfrm)
    IF xrot>180 THEN xrot=(360-xrot)*(-1)
    IF xrot<-180 THEN xrot=xrot+360
    stpxrot=xrot/stp
    yrot=yrot(endfrm)-yrot(stfrm)
    IF yrot>180 THEN yrot=(360-yrot)*(-1)
    IF yrot<-180 THEN yrot=yrot+360
    stpyrot=yrot/stp
    zrot=zrot(endfrm)-zrot(stfrm)
    IF zrot>180 THEN zrot=(360-zrot)*(-1)
    IF zrot<-180 THEN zrot=zrot+360
    stpzrot=zrot/stp
    xtran=xtran(endfrm)-xtran(stfrm)
    stpxtran=xtran/stp
    ytran=ytran(endfrm)-ytran(stfrm)
    stpytran=ytran/stp
    ztran=ztran(endfrm)-ztran(stfrm)
    stpztran=ztran/stp
    FOR frm=stfrm+1 TO endfrm-1
      n=frm-stfrm
      xrot(frm)=xrot(stfrm)+INT(stpxrot*n)
      IF xrot(frm)>359 THEN xrot(frm)=xrot(frm)-360
      IF xrot(frm)<0 THEN xrot(frm)=xrot(frm)+360
      yrot(frm)=yrot(stfrm)+INT(stpyrot*n)
      IF yrot(frm)>359 THEN yrot(frm)=yrot(frm)-360
      IF yrot(frm)<0 THEN yrot(frm)=yrot(frm)+360
      zrot(frm)=zrot(stfrm)+INT(stpzrot*n)
      IF zrot(frm)>359 THEN zrot(frm)=zrot(frm)-360
      IF zrot(frm)<0 THEN zrot(frm)=zrot(frm)+360
      xtran(frm)=xtran(stfrm)+INT(stpxtran*n)
      ytran(frm)=ytran(stfrm)+INT(stpytran*n)
      ztran(frm)=ztran(stfrm)+INT(stpztran*n)
      GOSUB drw.frmnum
      GOSUB drw.factors
      GOSUB high.redraw
      GOSUB drw.frame
      GOSUB getfrm
      frmchg(frm)=0
      GOSUB drw.update
      GOSUB unhigh.redraw
    NEXT
    frm=stfrm
    GOSUB drw.frmnum
    GOSUB drw.factors
  END IF
  LINE(0,0)-(311,131),0,bf
  GOSUB putfrm
RETURN

gettween:
  GOSUB drw.tweenreq
  maxchar=2
  xt=188:yt=74
  GOSUB getstring
  stfrm=VAL(s$)
  IF stfrm<1 THEN stfrm=1
  IF stfrm>12 THEN stfrm=12
  yt=82
  GOSUB getstring
  endfrm=VAL(s$)
  IF endfrm<1 THEN endfrm=1
  IF endfrm>12 THEN endfrm=12
RETURN

drw.tweenreq:
  LINE(58,48)-(254,92),0,bf
  LINE(60,50)-(252,90),3,bf
  LINE(61,51)-(251,89),2,bf
  CALL move&(rp&,76,66)
  PRINT "Calcolo intermedio"
  CALL move&(rp&,92,74)
  PRINT " Dal Frame:"
  CALL move&(rp&,108,82)
  PRINT "Al Frame:"
RETURN

drw.filereq:
  LINE(50,48)-(262,92),0,bf
  LINE(52,50)-(260,90),3,bf
  LINE(53,51)-(259,89),2,bf
  CALL move&(rp&,60,66)
  PRINT "     File Requestor"
    IF s$<>"File in:" THEN
      CALL move&(rp&,92,74)
      PRINT "('C' per uscire)"
    END IF
  CALL move&(rp&,60,82)
  PRINT s$
  xt=68+LEN(s$)*8
  yt=82
  maxchar=23-LEN(s$)
RETURN

you.sure:
  GOSUB drw.surereq
  GOSUB nobut
  answer=0
  WHILE NOT(answer)
    b=MOUSE(0)
    x=MOUSE(1)
    y=MOUSE(2)
    IF b<>0 THEN
      IF y>80 AND y<92 THEN
        IF x>75 AND x<127 THEN
          sure=(-1)
          answer=(-1)
        END IF
        IF x>187 AND x<239 THEN
          sure=0
          answer=(-1)
        END IF
      END IF
      GOSUB nobut
    END IF
  WEND
RETURN

drw.surereq:
  LINE(43,48)-(270,100),0,bf
  LINE(45,50)-(268,98),3,bf
  LINE(46,51)-(267,97),2,bf
  CALL move&(rp&,53,66)
  PRINT "     Siete sicuri!!!"
  CALL move&(rp&,53,74)
  PRINT LEFT$(s$,24)
  LINE(75,80)-(127,92),1,b
  LINE(187,80)-(239,92),1,b
  CALL move&(rp&,93,89)
  PRINT "SI"
  CALL move&(rp&,190,89)
  PRINT "  NO"
RETURN

keychk:
  RETURN

edobj:
  IF x>189 AND x<306 THEN
    IF y>24 AND y<32 THEN GOSUB ptslider
    IF y>82 AND y<90 THEN GOSUB polyslider
    IF y>36 AND y<48 THEN GOSUB zeropt
    IF y>94 AND y<106 THEN GOSUB addpt
    IF y>110 AND y<122 THEN GOSUB undopt
    IF y>126 AND y<138 THEN GOSUB delpoly
    IF y>142 AND y<171 THEN GOSUB selclr
  END IF
  IF x>3 AND x<82 AND y>3 AND y<82 THEN
    pt(pt,2)=(x-vx1)*(-1)
    pt(pt,0)=(y-vy1)*(-1)
    GOSUB drw.views
    GOSUB nobut
  END IF
  IF x>3 AND x<82 AND y>96 AND y<175 THEN
    pt(pt,2)=(x-vx2)*(-1)
    pt(pt,1)=(y-vy2)*(-1)
    GOSUB drw.views
    GOSUB nobut
  END IF
  IF x>97 AND x<176 AND y>96 AND y<175 THEN
    pt(pt,0)=x-vx3
    pt(pt,1)=(y-vy3)*(-1)
    GOSUB drw.views
    GOSUB nobut
  END IF
RETURN

zeropt:
  p=pt
  GOSUB unhigh.pt
  GOSUB erase.pt
  pt(pt,0)=0
  pt(pt,1)=0
  pt(pt,2)=0
  GOSUB drw.pt
  GOSUB high.pt
RETURN

addpt:
  IF vrt(poly)>5 THEN BEEP:RETURN
  IF pt(pt,0)=0 AND pt(pt,1)=0 AND pt(pt,2)=0 THEN RETURN
  vrt(poly)=vrt(poly)+1
  poly(poly,vrt(poly))=pt
  GOSUB drw.views
  GOSUB nobut
RETURN

undopt:
  IF vrt(poly)>0 THEN
    poly(poly,vrt(poly))=0
    vrt(poly)=vrt(poly)-1
  END IF
  GOSUB drw.views
  GOSUB nobut
RETURN

delpoly:
  IF vrt(poly)>0 THEN
    c=polyclr(poly)
    GOSUB unhigh.clr
    FOR n=0 TO vrt(poly)
      poly(poly,n)=0
    NEXT
    vrt(poly)=0
    polyclr(poly)=0
    c=polyclr(poly)
    GOSUB high.clr
  END IF
  GOSUB drw.views
  GOSUB nobut
RETURN

selclr:
  IF x>191 AND x<304 THEN
    c=INT((x-192)/14)+INT((y-143)/7)*8
    IF c<>polyclr(poly) THEN
      GOSUB high.clr
      SWAP c,polyclr(poly)
      GOSUB unhigh.clr
    END IF
  END IF
RETURN

drw.views:
  GOSUB erase.views
  p=pt
  GOSUB high.pt
  FOR p=1 TO maxpt
    GOSUB drw.pt
  NEXT
  p=pt
  t=poly
  FOR poly=1 TO maxpoly
    GOSUB drw.poly
  NEXT
  poly=t
  GOSUB high.poly
RETURN

erase.views:
  LINE(2,2)-(83,83),0,bf
  LINE(2,95)-(83,176),0,bf
  LINE(96,95)-(177,176),0,bf
RETURN

drw.pt:
  IF pt(p,0)<>0 OR pt(p,1)<>0 OR pt(p,2)<>0 THEN
    PSET(vx1-pt(p,2),vy1-pt(p,0))
    PSET(vx2-pt(p,2),vy2-pt(p,1))
    PSET(vx3+pt(p,0),vy3-pt(p,1))
  END IF
RETURN

erase.pt:
  COLOR 0
  GOSUB drw.pt
  COLOR 1
RETURN

high.pt:
  CIRCLE(vx1-pt(p,2),vy1-pt(p,0)),2,2
  CIRCLE(vx2-pt(p,2),vy2-pt(p,1)),2,2
  CIRCLE(vx3+pt(p,0),vy3-pt(p,1)),2,2
RETURN

unhigh.pt:
  CIRCLE(vx1-pt(p,2),vy1-pt(p,0)),2,0
  CIRCLE(vx2-pt(p,2),vy2-pt(p,1)),2,0
  CIRCLE(vx3+pt(p,0),vy3-pt(p,1)),2,0
RETURN

drw.poly:
 
 IF vrt(poly)>0 THEN
    PSET(vx1-pt(poly(poly,1),2),vy1-pt(poly(poly,1),0))
    PSET(vx2-pt(poly(poly,1),2),vy2-pt(poly(poly,1),1))
    PSET(vx3+pt(poly(poly,1),0),vy3-pt(poly(poly,1),1))
    IF vrt(poly)>1 THEN
      FOR n=2 TO vrt(poly)
        LINE(vx1-pt(poly(poly,n-1),2),vy1-pt(poly(poly,n-1),0)) -(vx1-pt(poly(poly,n),2),vy1-pt(poly(poly,n),0))
        LINE(vx2-pt(poly(poly,n-1),2),vy2-pt(poly(poly,n-1),1)) -(vx2-pt(poly(poly,n),2),vy2-pt(poly(poly,n),1))
        LINE(vx3+pt(poly(poly,n-1),0),vy3-pt(poly(poly,n-1),1)) -(vx3+pt(poly(poly,n),0),vy3-pt(poly(poly,n),1))
      NEXT
      LINE(vx1-pt(poly(poly,n-1),2),vy1-pt(poly(poly,n-1),0)) -(vx1-pt(poly(poly,1),2),vy1-pt(poly(poly,1),0))
      LINE(vx2-pt(poly(poly,n-1),2),vy2-pt(poly(poly,n-1),1)) -(vx2-pt(poly(poly,1),2),vy2-pt(poly(poly,1),1))
      LINE(vx3+pt(poly(poly,n-1),0),vy3-pt(poly(poly,n-1),1)) -(vx3+pt(poly(poly,1),0),vy3-pt(poly(poly,1),1))
    END IF
  END IF
RETURN

erase.poly:
  COLOR 3
  GOSUB drw.poly
  COLOR 1
RETURN

high.poly:
  COLOR 3
  GOSUB drw.poly
  RETURN
  
unhigh.poly:
  GOSUB drw.poly
RETURN

high.clr:
  y2=INT(c/8)
  x2=c-y2*8
  LINE(192+x2*14,143+y2*7)-(205+x2*14,149+y2*7),3,b
RETURN

unhigh.clr:                                  
  y2=INT(c/8)
  x2=c-y2*8
  LINE(192+x2*14,143+y2*7)-(205+x2*14,149+y2*7),0,b
RETURN

ptslider:
  IF x<197 THEN
    p=pt
    GOSUB unhigh.pt
    pt=pt-1
    IF pt<1 THEN pt=1
    p=pt
    GOSUB drw.ptnum
    GOSUB high.pt
    GOSUB nobut
  ELSEIF x>298 THEN
    p=pt
    GOSUB unhigh.pt
    pt=pt+1
    IF pt>maxpt THEN pt=maxpt
    p=pt
    GOSUB drw.ptnum
    GOSUB high.pt
    GOSUB nobut
  ELSEIF x>199 AND x<295 THEN
    p=pt
    GOSUB unhigh.pt
    pt=x-199
    p=pt
    GOSUB drw.ptnum
    GOSUB high.pt
    GOSUB nobut
  END IF
RETURN

polyslider:
  IF x<197 THEN
    c=polyclr(poly)
    GOSUB unhigh.clr
    GOSUB unhigh.poly
    poly=poly-1
    IF poly<1 THEN poly=1
    GOSUB drw.polynum
    GOSUB high.poly
    c=polyclr(poly)
    GOSUB high.clr
    GOSUB nobut
  ELSEIF x>298 THEN
    c=polyclr(poly)
    GOSUB unhigh.clr
    GOSUB unhigh.poly
    poly=poly+1
    IF poly>maxpoly THEN poly=maxpoly
    GOSUB drw.polynum
    GOSUB high.poly
    c=polyclr(poly)
    GOSUB high.clr
    GOSUB nobut
  ELSEIF x>199 AND x<295 THEN
    c=polyclr(poly)
    GOSUB unhigh.clr
    GOSUB unhigh.poly
    poly=x-199
    GOSUB drw.polynum
    GOSUB high.poly
    c=polyclr(poly)
    GOSUB high.clr
    GOSUB nobut
  END IF
RETURN

edact:
  IF x>4 AND x<122 AND y>150 AND y<158 THEN GOSUB frmslider:RETURN
  IF x>40 AND x<250 AND y>136 AND y<148 THEN GOSUB drw.frm:RETURN
  IF x>140 AND x<250 AND y>152 AND y<164 THEN GOSUB drw.allfrm:RETURN
  IF x>260 AND x<306 AND y>136 AND y<148 THEN GOSUB playbut:RETURN
  IF x>260 AND x<306 AND y>152 AND y<164 THEN GOSUB stopbut:RETURN
  IF x>263 AND x<303 AND y>178 AND y<183 THEN GOSUB spdslider:RETURN
  IF y>168 AND y<176 THEN
    IF x>92 AND x<140 THEN GOSUB mod.xrot:RETURN
    IF x>147 AND x<196 THEN GOSUB mod.yrot:RETURN
    IF x>203 AND x<252 THEN GOSUB mod.zrot:RETURN
  END IF
  IF y>177 AND y<185 THEN
    IF x>92 AND x<140 THEN GOSUB mod.xtran:RETURN
    IF x>147 AND x<196 THEN GOSUB mod.ytran:RETURN
    IF x>203 AND x<252 THEN GOSUB mod.ztran:RETURN
  END IF
RETURN

frmslider:
  IF x<12 THEN
    frm=frm-1
    IF frm<1 THEN frm=1
    GOSUB drw.frmnum
    GOSUB drw.update
    GOSUB drw.factors
    GOSUB putfrm
    GOSUB nobut
  ELSEIF x>114 THEN
    frm=frm+1
    IF frm>12 THEN frm=12
    GOSUB drw.frmnum
    GOSUB drw.update
    GOSUB drw.factors
    GOSUB putfrm
    GOSUB nobut
  ELSEIF x>16 AND x<110 THEN
    frm=INT((x-16)/8)+1
    GOSUB drw.frmnum
    GOSUB drw.update
    LINE(0,0)-(311,131),0,bf
    GOSUB drw.factors
    GOSUB putfrm
    GOSUB nobut
  END IF
RETURN

drw.frm:
  GOSUB high.redraw
  GOSUB drw.frame
  GOSUB getfrm
  frmchg(frm)=0
  GOSUB drw.update
  GOSUB unhigh.redraw
  GOSUB nobut
RETURN

drw.allfrm:
  GOSUB high.redraw2
  tfrm=frm
  FOR frm=1 TO 12
    GOSUB drw.frmnum
    GOSUB drw.factors
    GOSUB drw.frame
    GOSUB getfrm
    frmchg(frm)=0
    GOSUB drw.update
  NEXT
  frm=tfrm
  GOSUB drw.frmnum
  GOSUB drw.factors
  GOSUB putfrm
  GOSUB unhigh.redraw2
  GOSUB nobut
RETURN

playbut:
  GOSUB high.play
  GOSUB unhigh.stop
  GOSUB freeze.menu
  frminc=1
  clickstop=0
  WHILE NOT(clickstop)
    frm=frm+frminc
    IF frm>12 THEN
      IF actrev THEN
        frm=11
        frminc=(-1)
      ELSEIF actrpt THEN
        frm=1
      ELSE
        frm=1
        clickstop=(-1)
      END IF
    END IF
    IF frm<1 THEN
      IF actrpt THEN
        frm=2
        frminc=1
      ELSE
        frm=1
        clickstop=(-1)
      END IF
    END IF
    GOSUB putfrm
    GOSUB drw.frmnum
    FOR n=0 TO 39-spd
      b=MOUSE(0)
      x=MOUSE(1)
      y=MOUSE(2)
      IF b<>0 THEN
        IF x>260 AND x<306 AND y>152 AND y<164 THEN 
          clickstop=(-1)
          n=39-spd
        END IF       
        IF x>263 AND x<303 AND y>178 AND y<183 THEN 
          spd=x-263
          GOSUB drw.spdnum
        END IF
      END IF
    NEXT 
  WEND  
  GOSUB drw.factors
  GOSUB drw.update
  GOSUB unhigh.play
  GOSUB high.stop
  GOSUB unfreeze.menu
  GOSUB nobut
RETURN

stopbut:
RETURN

spdslider:
  spd=x-263
  GOSUB drw.spdnum
RETURN

mod.xrot:
  s$=STR$(xrot(frm))
  xt=108:yt=175
  maxchar=4
  numonly=1
  GOSUB getstring2
  xrot(frm)=VAL(s$)
  xrot(frm)=xrot(frm) MOD 360
  IF xrot(frm)<0 THEN xrot(frm)=xrot(frm)+360
  GOSUB drw.factors
  frmchg(frm)=1
  GOSUB drw.update
  GOSUB nobut
RETURN

mod.yrot:
  s$=STR$(yrot(frm))
  xt=164:yt=175
  maxchar=4
  numonly=1
  GOSUB getstring2
  yrot(frm)=VAL(s$)
  yrot(frm)=yrot(frm) MOD 360
  IF yrot(frm)<0 THEN yrot(frm)=yrot(frm)+360
  GOSUB drw.factors
  frmchg(frm)=1
  GOSUB drw.update
  GOSUB nobut
RETURN

mod.zrot:
  s$=STR$(zrot(frm))
  xt=220:yt=175
  maxchar=4
  numonly=1
  GOSUB getstring2
  zrot(frm)=VAL(s$)
  zrot(frm)=zrot(frm) MOD 360
  IF zrot(frm)<0 THEN zrot(frm)=zrot(frm)+360
  GOSUB drw.factors
  frmchg(frm)=1
  GOSUB drw.update
  GOSUB nobut
RETURN

mod.xtran:
  s$=STR$(xtran(frm))
  xt=108:yt=184
  maxchar=4
  numonly=1
  GOSUB getstring2
  xtran(frm)=VAL(s$)
  IF xtran(frm)<-90 THEN xtran(frm)=(-90)
  IF xtran(frm)>90 THEN xtran(frm)=90
  GOSUB drw.factors
  frmchg(frm)=1
  GOSUB drw.update
  GOSUB nobut
RETURN

mod.ytran:
  s$=STR$(ytran(frm))
  xt=164:yt=184
  maxchar=3
  numonly=1
  GOSUB getstring2
  ytran(frm)=VAL(s$)
  IF ytran(frm)<-8 THEN ytran(frm)=(-8)
  IF ytran(frm)>8 THEN ytran(frm)=8
  GOSUB drw.factors
  frmchg(frm)=1
  GOSUB drw.update
  GOSUB nobut
RETURN

mod.ztran:
  s$=STR$(ztran(frm))
  xt=220:yt=184
  maxchar=4
  numonly=1
  GOSUB getstring2
  ztran(frm)=VAL(s$)
  IF ztran(frm)<0 THEN ztran(frm)=0
  IF ztran(frm)>999 THEN ztran(frm)=999
  GOSUB drw.factors
  frmchg(frm)=1
  GOSUB drw.update
  GOSUB nobut
RETURN

drw.frame:
  GOSUB unit.matrix
  IF xrot(frm)>0 THEN GOSUB apply.xrot
  IF yrot(frm)>0 THEN GOSUB apply.yrot
  IF zrot(frm)>0 THEN GOSUB apply.zrot
  IF ztran(frm)>0 THEN GOSUB apply.ztran
  GOSUB transform.pts
  GOSUB convert2scr
  GOSUB sort.poly
  LINE(0,0)-(311,131),0,bf
  GOSUB drw.object
RETURN

matprep:
  FOR row=0 TO 3
    FOR col=0 TO 3
      tr1(row,col)=tran(row,col)
      tr2(row,col)=0
    NEXT
  NEXT
RETURN

unit.matrix:
  FOR row=0 TO 3
    FOR col=0 TO 3
      tran(row,col)=0
      IF row=col THEN tran(row,col)=1
    NEXT
  NEXT
RETURN

matmult:
  FOR row=0 TO 3
    FOR col=0 TO 3
      t=0
      FOR e1=0 TO 3
        t=t+tr1(row,e1)*tr2(e1,col)
        NEXT
      tran(row,col)=t
    NEXT
  NEXT
RETURN

apply.xrot:     'ruota l'oggetto intorno all'asse X
  GOSUB matprep
  rad=xrot(frm)*3.1416/180
  tr2(0,0)=1:tr2(3,3)=1
  tr2(1,1)=COS(rad):tr2(1,2)=SIN(rad)*(-1)
  tr2(2,1)=SIN(rad):tr2(2,2)=COS(rad)
  GOSUB matmult
RETURN

apply.yrot:     'ruota l'oggetto intorno all'asse Y
  GOSUB matprep
  rad=yrot(frm)*3.1416/180
  tr2(1,1)=1:tr2(3,3)=1
  tr2(0,0)=COS(rad):tr2(0,2)=SIN(rad)
  tr2(2,0)=SIN(rad)*(-1):tr2(2,2)=COS(rad)
  GOSUB matmult
RETURN

apply.zrot:     'ruota l'oggetto intorno all'asse Z
  GOSUB matprep
  rad=zrot(frm)*3.1416/180
  tr2(2,2)=1:tr2(3,3)=1
  tr2(0,0)=COS(rad):tr2(0,1)=SIN(rad)*(-1)
  tr2(1,0)=SIN(rad):tr2(1,1)=COS(rad)
  GOSUB matmult
RETURN

apply.ztran:     'trasporta l'oggetto lungo l'asse Z
  GOSUB matprep
  tr2(0,0)=1:tr2(1,1)=1
  tr2(2,2)=1:tr2(3,3)=1
  tr2(3,2)=ztran(frm)
  GOSUB matmult
RETURN

transform.pts:
  COLOR 1,0
  FOR p=1 TO 95
    LOCATE 1,5
    PRINT "Calcola il Punto";p
    IF pt(p,0)<>0 OR pt(p,1)<>0 OR pt(p,2)<>0 THEN
      FOR col=0 TO 3
        t=0
        FOR e1=0 TO 3
          t=t+pt(p,e1)*tran(e1,col)
        NEXT
        tpt(p,col)=t      
      NEXT      
    END IF
  NEXT
RETURN

convert2scr:     ' converte i punti sulle coordinate dello schermo
  FOR p=1 TO 95
    r=zeye/(tpt(p,2)+zeye)
    tpt(p,0)=INT(tpt(p,0)*r)+hoff
    tpt(p,1)=(INT(tpt(p,1)*r))*(-1)+voff
  NEXT
RETURN

reset.polyorder:
  FOR n=1 TO maxpoly
    polyord(n,0)=0
    polyord(n,1)=0
  NEXT
RETURN

sort.poly:
  GOSUB reset.polyorder
  FOR n=1 TO maxpoly
    LOCATE 1,16
    PRINT "Poligono"n
    IF vrt(n)>0 THEN
      t=0
      FOR n2=1 TO vrt(n)
        t=t+tpt(poly(n,n2),2)
      NEXT
      polyord(n,0)=INT(t/vrt(n))
    END IF
  NEXT
  FOR n=1 TO maxpoly
    LOCATE 1,24
    PRINT n;"di nuovo."
    IF vrt(n)>0 THEN
      t=(-100)
      p=(-1)
      FOR n2=1 TO maxpoly
        IF vrt(n2)>0 THEN
          IF polyord(n2,0)>t THEN t=polyord(n2,0):p=n2
        END IF
      NEXT
      polyord(n,1)=p
      polyord(p,0)=(-100)
    END IF
  NEXT
  COLOR 1,2
RETURN

drw.object:
  FOR n=1 TO maxpoly
    IF vrt(n)>2 THEN
      FOR n2=1 TO vrt(polyord(n,1))
        AREA(tpt(poly(polyord(n,1),n2),0)+xtran(frm),tpt(poly(polyord (n,1),n2),1)+ ytran(frm))
      NEXT
      COLOR polyclr(polyord(n,1))
      AREAFILL
    END IF
  NEXT
  COLOR 1,2
RETURN

getfrm:
  GET(hoff-64+xtran(frm),voff-58+ytran(frm))-(hoff+63+xtran(frm), voff+57+ytran(frm)),frame&((frm-1)*frmsize)
RETURN

putfrm:
  PUT(hoff-64+xtran(frm),voff-58+ytran(frm)),frame&((frm-1)*frmsize) ,PSET
RETURN

getstring:
  s$=""

getstring2:
  GOSUB freeze.menu
  GOSUB nokey
  numchar=LEN(s$)
  CALL move&(rp&,xt,yt)
  PRINT s$;
  z$=""

getstring3:
    LINE(xt+numchar*8+1,yt-7)-(xt+numchar*8+4,yt+2),3,bf
    z$=INPUT$(1)
    LINE(xt+numchar*8+1,yt-7)-(xt+numchar*8+4,yt+2),2,bf
    IF z$=CHR$(8) OR z$=CHR$(31) OR z$=CHR$(127) THEN
      IF numchar>0 THEN
        PRINT CHR$(8);" ";CHR$(8);
        numchar=numchar-1
        s$=LEFT$(s$,numchar)
      END IF
    END IF
    IF ASC(z$)>31 AND numchar<maxchar AND numonly=0 THEN
        s$=s$+z$
        PRINT z$;
        numchar=numchar+1
    END IF
    IF ASC(z$)>31 AND numchar<maxchar THEN
      IF numonly=1 THEN
        IF (z$>="0" AND z$<="9") OR z$="-" THEN
          s$=s$+z$
          PRINT z$;
          numchar=numchar+1
        END IF
      END IF
    END IF
  IF z$<>CHR$(13) THEN getstring3
  numonly=0
  GOSUB unfreeze.menu
RETURN

click.continue:
  LOCATE 22,14
  PRINT "Per continuare     "
  PRINT "  premere il tasto sinistro del mouse";
  GOSUB nobut
  b=MOUSE(0)
  WHILE b=0
    b=MOUSE(0)
  WEND
RETURN

nobut:
  b=MOUSE(0)
  WHILE b<>0
    b=MOUSE(0)
  WEND
RETURN

nokey:
  z$=INKEY$
  WHILE z$<>""
    z$=INKEY$
  WEND
RETURN

init:
  DEFINT a-p,u-z
  DECLARE FUNCTION setdrmd LIBRARY
  DECLARE FUNCTION move LIBRARY
  LIBRARY "graphics.library"
  SCREEN 1,320,200,5,1
  WINDOW 2,"Rot",(0,0)-(311,186),0,1
  WINDOW OUTPUT 2
  rp&=WINDOW(8) 'puntatore alla porta raster
  PALETTE 0,0,0,0
  PALETTE 2,0,.5,0
  PALETTE 31,0,.25,0
  PALETTE 30,.7,.7,0
  LOCATE 3,1
  GOSUB intro
  DIM pt(95,3),poly(95,6),polyclr(95),vrt(95)
  DIM xrot(12),yrot(12),zrot(12)
  DIM xtran(12),ytran(12),ztran(12),frmchg(12)
  DIM tran(3,3),tr1(3,3),tr2(3,3),tpt(95,3),polyord(95,1)
  DIM frame&(27876)
  pt=1:poly=1
  objscr=-1:actscr=0
  vx1=43:vx2=43:vx3=136
  vy1=43:vy2=135:vy3=135
  maxpt=95:maxpoly=95
  frm=1:spd=20
  frmsize=2323
  hoff=156:voff=66:zeye=440
  actrpt=0:actrev=0
  FOR n=1 TO maxpt
    pt(n,3)=1
  NEXT
  GOSUB init.menu
  COLOR 1,0
  GOSUB click.continue
  COLOR 1,2
  GOSUB drw.objscr
RETURN

init.menu:
  MENU 1,0,1,"ROT"
  MENU 1,1,1," Files "
  MENU 1,2,0,"------"
  MENU 1,3,1," Esci "
  MENU 2,0,1,"Oggetto"
  MENU 2,1,2,"  Editor Oggetto "
  MENU 2,2,1,"  Carica Oggetto "
  MENU 2,3,1,"  Salva  Oggetto "
  MENU 2,4,1,"  Nuovo  Oggetto "
  MENU 3,0,1,"Azione"
  MENU 3,1,1,"  Editor Azione "
  MENU 3,2,0,"  Carica Azione "
  MENU 3,3,0,"  Salva  Azione "
  MENU 3,4,0,"  Nuova  Azione "
  MENU 3,5,0,"----------------"
  MENU 3,6,0,"  Ripete ciclo "
  MENU 3,7,0,"  Ripete ciclo inverso"
  MENU 3,8,0,"  Calcola tra...   "
  MENU 4,0,0," "
  MENU 4,1,0," "
RETURN
           
freeze.menu:
  MENU 1,0,0
  MENU 2,0,0
  MENU 3,0,0
RETURN

unfreeze.menu:
   MENU 1,0,1
  MENU 2,0,1
  MENU 3,0,1
RETURN

cleanup:
  WINDOW CLOSE 2
  SCREEN CLOSE 1
  LIBRARY CLOSE
  PALETTE 0,0,.25,.55
  PALETTE 2,0,0,0
  MENU RESET
RETURN

drw.objscr:
  LINE(0,0)-(320,200),2,bf
  LINE(2,2)-(83,83),0,bf
  LINE(2,95)-(83,176),0,bf
  LINE(96,95)-(177,176),0,bf
  LINE(186,2)-(310,53),1,b
  LINE(186,60)-(310,176),1,b
  LINE(191,142)-(304,171),0,bf
  FOR y=0 TO 3
    FOR x=0 TO 7
      LINE(193+x*14,144+y*7)-(204+x*14,148+y*7),y*8+x,bf
    NEXT
  NEXT
  x=189:y=126:GOSUB drw.button
  y=110:GOSUB drw.button
  y=94:GOSUB drw.button
  y=36:GOSUB drw.button
  y=24:GOSUB drw.scroll
  y=82:GOSUB drw.scroll
  CALL move&(rp&,228,12):PRINT "PUNTO"
  CALL move&(rp&,236,21):PRINT "#"
  CALL move&(rp&,208,45):PRINT "Punto Zero"
  CALL move&(rp&,220,70):PRINT "POLIGONO"
  CALL move&(rp&,236,79):PRINT "#"
  CALL move&(rp&,200,103):PRINT "+ il Pt prec."
  CALL move&(rp&,200,119):PRINT "Clr ultimo Pt"
  CALL move&(rp&,192,135):PRINT " Clr Poligono"
  CALL move&(rp&,10,92):PRINT "Vertice Z"
  CALL move&(rp&,10,185):PRINT "Lato Z";
  CALL move&(rp&,96,185):PRINT "Frontale X";
  CALL move&(rp&,86,16):PRINT "X"
  CALL move&(rp&,86,109):PRINT "Y"
  x=2:y=89:GOSUB drw.leftarrow
  y=182:GOSUB drw.leftarrow
  x=89:y=2:GOSUB drw.uparrow
  y=95:GOSUB drw.uparrow
  x=166:y=182:GOSUB drw.rightarrow
  GOSUB drw.ptnum
  GOSUB drw.polynum
  GOSUB drw.views
  c=polyclr(poly)
  GOSUB high.clr
  GOSUB nobut
RETURN

drw.button:
  LINE(x,y)-(x+116,y+12),1,b
  LINE(x+2,y+13)-(x+117,y+13),0
  LINE -(x+117,y+1),0
RETURN

drw.scroll:
  LINE(x,y)-(x+116,y+8),1,b
  LINE(x+8,y)-(x+109,y+8),1,b
  LINE -(x+117,y+1),0
  COLOR 0
  AREA(x+3,y+4):AREA(x+5,y+2):AREA(x+5,y+6)
  AREAFILL
  AREA(x+112,y+2):AREA(x+112,y+6):AREA(x+114,y+4)
  AREAFILL
RETURN

drw.leftarrow:
  AREA(x,y):AREA(x+3,y-3):AREA(x+3,y+3):AREAFILL
  LINE(x,y)-(x+6,y)
RETURN

drw.rightarrow:
  AREA(x,y):AREA(x-3,y-3):AREA(x-3,y+3):AREAFILL
  LINE(x,y)-(x-6,y)
RETURN

drw.uparrow:
  AREA(x,y):AREA(x-3,y+3):AREA(x+3,y+3):AREAFILL
  LINE(x,y)-(x,y+6)
RETURN

drw.ptnum:
  LINE(199,26)-(296,30),0,bf
  LINE(198+pt,26)-(201+pt,30),3,bf
  CALL move&(rp&,244,21)
  PRINT RIGHT$("00"+STR$(pt),2)
RETURN

drw.polynum:
  LINE(199,84)-(296,88),0,bf
  LINE(198+poly,84)-(201+poly,88),3,bf
  CALL move&(rp&,244,79)
  PRINT RIGHT$("00"+STR$(poly),2)
RETURN

drw.actscr:
  LINE(0,0)-(311,131),0,bf
  LINE(0,132)-(311,186),2,bf
  x=140:y=136:GOSUB drw.button2
  y=152:GOSUB drw.button2
  x=260:y=136:GOSUB drw.button3
  y=152:GOSUB drw.button3
  LINE(260,178)-(306,183),1,b
  LINE(262,184)-(307,184),0
  LINE -(307,179),0
  LINE(4,150)-(122,158),1,b
  LINE(12,150)-(114,158),1,b
  LINE(6,159)-(123,159),0
  LINE -(123,151),0
  COLOR 0
  AREA(7,154):AREA(9,152):AREA(9,156):AREAFILL
  AREA(117,152):AREA(119,154):AREA(117,156):AREAFILL
  COLOR 1,2
  CALL move&(rp&,28,145):PRINT "FRAME #"
  CALL move&(rp&,4,175):PRINT "Rotazioni: X=     Y=     Z="
  CALL move&(rp&,4,184):PRINT "Incremento:X=     Y=     Z=";
  GOSUB unhigh.redraw
  GOSUB unhigh.redraw2
  GOSUB unhigh.play
  GOSUB high.stop
  CALL move&(rp&,264,175):PRINT "Tempo"
  GOSUB drw.frmnum
  GOSUB drw.spdnum
  GOSUB drw.update
  GOSUB drw.factors
  GOSUB putfrm
RETURN

drw.frmnum:
  LINE(15,152)-(111,156),0,bf
  LINE(7+frm*8,152)-(15+frm*8,156),3,bf
  CALL move&(rp&,84,145)
  PRINT RIGHT$("00"+STR$(frm),2)
RETURN

drw.spdnum:
  LINE(262,180)-(304,181),0,b
  LINE(261+spd,180)-(265+spd,181),3,b
RETURN

drw.update:
  LINE(115,138)-(131,146),2,bf
  IF frmchg(frm)<>0 THEN
    LINE(115,142)-(131,142),3
    LINE -(127,138),3
    LINE(131,142)-(127,146),3
  END IF
RETURN

drw.factors:
  CALL move&(rp&,108,175)
  PRINT LEFT$(STR$(xrot(frm))+"   ",4)
  CALL move&(rp&,164,175)
  PRINT LEFT$(STR$(yrot(frm))+"   ",4)
  CALL move&(rp&,220,175)
  PRINT LEFT$(STR$(zrot(frm))+"    ",4)
  CALL move&(rp&,108,184)
  PRINT LEFT$(STR$(xtran(frm))+"    ",4);
  CALL move&(rp&,164,184)
  PRINT LEFT$(STR$(ytran(frm))+"    ",4);
  CALL move&(rp&,220,184)
  PRINT LEFT$(STR$(ztran(frm))+"    ",4);
RETURN

unhigh.redraw:
  LINE(141,137)-(249,147),2,bf
  CALL move&(rp&,148,145)
  PRINT " Rifa' Frame"
RETURN

high.redraw:
  LINE(141,137)-(249,147),3,bf
  COLOR 1,3
  CALL move&(rp&,148,145)
  PRINT " Rifa' Frame"
  COLOR 1,2
RETURN

unhigh.redraw2:
  LINE(141,153)-(249,163),2,bf
  CALL move&(rp&,156,161)
  PRINT "Rifa' tutto"
RETURN

high.redraw2:
  LINE(141,153)-(249,163),3,bf
  COLOR 1,3
  CALL move&(rp&,156,161)
  PRINT "Rifa' tutto"
  COLOR 1,2
RETURN

unhigh.play:
  LINE(261,137)-(305,147),2,bf
  CALL move&(rp&,268,145)
  PRINT "Play"
RETURN

high.play:
  LINE(261,137)-(305,147),3,bf
  COLOR 1,3
  CALL move&(rp&,268,145)
  PRINT "Play"
  COLOR 1,2
RETURN

unhigh.stop:
  LINE(261,153)-(305,163),2,bf
  CALL move&(rp&,268,161)
  PRINT "Stop"
RETURN

high.stop:
  LINE(261,153)-(305,163),3,bf
  COLOR 1,3
  CALL move&(rp&,268,161)
  PRINT "Stop"
  COLOR 1,2
RETURN

drw.button2:
  LINE(x,y)-(x+110,y+12),1,b
  LINE(x+2,y+13)-(x+111,y+13),0
  LINE -(x+111,y+1),0
RETURN

drw.button3:
  LINE(x,y)-(x+46,y+12),1,b
  LINE(x+2,y+13)-(x+47,y+13),0
  LINE -(x+47,y+1),0
RETURN