rem 3D Space Scaffolding (ASM Version) ........... Rev 6.0
      rem A J Tooth // July 2006
      on error if (err=17) then quit
      himem=lomem + 20000000
      
      rem Setup
      proc_setup
      
      repeat
        cnt%=0
        rem Change parameters
        if frst&=0 then proc_change(frst&) : cls
        
        repeat
          rem Update position
          proc_update(cnt%)
          
          rem Rotation Matrix Update
          proc_rotmat(2,2,2,2)
          
          rem Rotate the line segment
          sys "GetCurrentProcess" to hprocess%
          sys "SetPriorityClass", hprocess%, &100
          
          call rotat%
          
          rem Display each segment
          cls : proc_BMP_DispB(xscreen%,yscreen%,pic%)
          
          call pream%
          
          sys "GetCurrentProcess" to hprocess%
          sys "SetPriorityClass", hprocess%, &20
          
          *REFRESH
          a$=inkey$(0)
        until (a$<>""or cnt%=400)
        
        frst&=0
      until a$<>""
      *REFRESH ON
      
      quit
      end
      rem End of Program ==========================================
      rem =========================================================
      
      rem Setup
      def proc_setup
      
      *FLOAT 64
      
      rem Go to fullscreen
      proc_fullscreen
      
      rem Various parameters
      dim rgb% 3, drw% 1000, itmp% 3, ftmp% 7, rotat% 1000, ref% 3, pream% 1000
      A=-45.0 : fla&=3 : a$="" : fa=0.0 : fabr=1.0 : ii&=0 : jj&=0 : cnt%=0 : pt%=0
      Mm%=1
      dim pstn(400,8), pic% 600000
      rei=0.0 : gei=0.0 : bei=0.0
      
      frst&=1 : rem Indicates first pass when = 1
      
      rem Setup other parameters
      proc_change(frst&)
      
      rem Dual-pass assembly, in case of labels
      for pass&=0 to 2 step 2
        proc_drw(pass&)
        proc_rotat(pass&)
        proc_pream(pass&)
      next pass&
      
      origin xscreen%,yscreen%
      gcol 3
      
      rem Backdrop picture
      Pic$=@dir$+"Sombrero.bmp "
      command$=" LOAD "+ chr$(34)+Pic$+chr$(34) + str$~pic%
      oscli command$
      proc_BMP_DispB(xscreen%,yscreen%,pic%)
      
      *REFRESH OFF
      
      rem Start position
      proc_start
      
      endproc
      rem =========================================================
      
      rem Set up use of Full Screen
      def proc_fullscreen
      
      sys "GetSystemMetrics", 0 to xscreen%
      sys "GetSystemMetrics", 1 to yscreen%
      sys "SetWindowLong",@hwnd%,-16,&16000000
      sys "SetWindowPos",@hwnd%,-1,0,0,xscreen%,yscreen%,0
      vdu 23,22,xscreen%;yscreen%;8,16,16,1 : rem Set fullscreen mode
      mouse off : off : rem Turns off the Mouse Pointer and the Cursor
      endproc
      rem -------------------------------------------------------------
      
      rem Change parameters
      def proc_change(Ctr&)
      
      rem Dual colours
      rb%=150+rnd(105) : gb%=150+rnd(105) : bb%=150+rnd(105)
      rd%=50+rnd(100)  : gd%=50+rnd(100)  : bd%=50+rnd(100)
      
      rem Rotation Matrix Setup
      proc_rotmat(Ctr&,rnd(45),rnd(45),rnd(45))
      
      Dis=(3+rnd(5))*1000.0  : rem Distance
      Lmt&=5+rnd(10)         : rem How often direction to change
      dT=10+rnd(10)*1.3      : rem Length of sub-segments
      Ml%=rnd(3)             : rem Max line width
      
      endproc
      rem -------------------------------------------------------------
      
      rem Set up start
      def proc_start
      local i&,n
      
      rem Position vector
      pstn(0,0)=50.0
      pstn(0,1)=50.0
      pstn(0,2)=50.0
      
      rem Unit vector for direction
      proc_dirch(0)
      
      endproc
      rem ===================================================================
      
      rem Update position
      def proc_update(return cnt%)
      local i&
      
      cnt%+=1 : rem Keep count of number of line segments
      
      rem Transfer old direction
      for i&=0 to 2
        pstn(cnt%,6+i&)=pstn(cnt%-1,6+i&)
      next i&
      
      if ((cnt% mod Lmt&)=0 and fla&=3) then
        rem Unit vector for direction
        proc_dirch(cnt%)
      endif
      
      rem Update
      for i&=0 to 2
        pstn(cnt%,i&)=pstn(cnt%-1,i&) + dT*pstn(cnt%,6+i&)
      next i&
      
      rem Change direction
      for i&=0 to 2
        if (abs(pstn(cnt%,i&))>100 and fla&=3) then pstn(cnt%,i&+6)=-pstn(cnt%,i&+6) : fl&=1 : fla&=0
      next i&
      
      rem Only allow further direction change
      rem within designated region
      for i&=0 to 2
        if abs(pstn(cnt%,i&))<100 then fla&+=1
      next i&
      if fla&>3 then fla&=3
      
      endproc
      rem ===================================================================
      
      rem Unit vector for direction
      def proc_dirch(Cnt%)
      local n,j&
      
      pstn(Cnt%,6)=0 : pstn(Cnt%,7)=0 : pstn(Cnt%,8)=0
      j&=rnd(3) : pstn(Cnt%,5+j&)=2*(rnd(2)-1) - 1
      
      n=sqr(pstn(Cnt%,6)^2 + pstn(Cnt%,7)^2 + pstn(Cnt%,8)^2)
      
      pstn(Cnt%,6)/=n
      pstn(Cnt%,7)/=n
      pstn(Cnt%,8)/=n
      endproc
      rem ===================================================================
      
      rem Rotation Matrix Update
      def proc_rotmat(ctr&,Thet,Phii,Psii)
      private Th,Ph,Ps
      
      if ctr&=1 then dim mat(2,2)
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &100
      case ctr& of
        when 0,1 : Th=rad(Thet) : Ph=rad(Phii) : Ps=rad(Psii)
        when 2 : Th+=rad(Thet) : Ph+=rad(Phii) : Ps+=rad(Psii)
          if Th>2*pi then Th=0.0
          if Ph>2*pi then Ph=0.0
          if Ps>2*pi then Ps=0.0
      endcase
      
      mat(0,0)= cos(Ps)*cos(Ph)*cos(Th) - sin(Ps)*sin(Th)
      mat(0,1)=-sin(Ps)*cos(Ph)*cos(Th) - cos(Ps)*sin(Th)
      mat(0,2)=-sin(Ph)*cos(Th)
      mat(1,0)= cos(Ps)*cos(Ph)*sin(Th) + sin(Ps)*cos(Th)
      mat(1,1)=-sin(Ps)*cos(Ph)*sin(Th) + cos(Ps)*cos(Th)
      mat(1,2)=-sin(Ph)*sin(Th)
      mat(2,0)= cos(Ps)*sin(Ph)
      mat(2,1)=-sin(Ph)*sin(Ps)
      mat(2,2)= cos(Ph)
      
      mat()=1.0*mat() : rem Force all elements to be FP
      
      sys "GetCurrentProcess" to hprocess%
      sys "SetPriorityClass", hprocess%, &20
      endproc
      rem ===================================================================
      
      rem Drawing Routine
      def proc_drw(opt&)
      P%=drw%
      
      [opt opt&
      
      mov edx,[^Mm%]
      mov [^k%],edx
      
      finit
      
      fild dword [^Mm%]           ;fa=Mm%/11
      fild dword [i11%]
      fdivp st1,st0
      fld st0                     ;fa left at st1
      fld1
      fsubrp st1,st0              ;(1-fa) left at st0
      
      fild dword [^rd%]           ;Red
      fmul st0,st1
      fild dword [^rb%]
      fmul st0,st3
      faddp st1,st0
      fstp qword [^rei]           ;Red
      
      fild dword [^gd%]           ;Green
      fmul st0,st1
      fild dword [^gb%]
      fmul st0,st3
      faddp st1,st0
      fstp qword [^gei]           ;Green
      
      fild dword [^bd%]           ;Blue
      fmulp st1,st0
      fild dword [^bb%]
      fmulp st2,st0
      faddp st1,st0
      fstp qword [^bei]           ;Blue
      
      .kloop
      fild dword [^k%]            ;ff=(1 - k%/Mm%)
      fild dword [^Mm%]
      fdivp st1,st0
      fld1
      fsubrp st1,st0              ;ff left 0n stack
      
      fld qword [^rei]            ;Red
      fmul st0,st1
      fistp dword [^re%]          ;Red
      
      fld qword [^gei]            ;Green
      fmul st0,st1
      fistp dword [^ge%]          ;Green
      
      fld qword [^bei]            ;Blue
      fmulp st1,st0
      fistp dword [^be%]          ;Blue
      
      mov al,19                   ;Changes the rgb vlue f0r colr 10
      call "oswrch"
      mov al,10
      call "oswrch"
      mov al,16
      call "oswrch"
      mov al,[^re%]
      call "oswrch"
      mov al,[^ge%]
      call "oswrch"
      mov al,[^be%]
      call "oswrch"
      
      mov al,18                 ;Calls gc0l routine
      call "oswrch"
      mov al,0
      call "oswrch"
      mov al,10
      call "oswrch"
      
      mov eax,[^k%]             ;@vdu%!248=Ml%*k%
      imul dword [^Ml%]
      mov ebx,248
      mov @vdu%[ebx],eax
      
      mov al,25                 ;Calls Move routine For xo%,yo%
      call "oswrch"
      mov al,4
      call "oswrch"
      mov bx,[^xo%]
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"
      mov bx,[^yo%]
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"
      
      mov al,25                 ;Calls Draw routine For x%,y%
      call "oswrch"
      mov al,5
      call "oswrch"
      mov bx,[^x%]
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"
      mov bx,[^y%]
      mov al,bl
      call "oswrch"
      mov al,bh
      call "oswrch"
      
      dec dword [^k%]
      mov edx,[^k%]
      cmp edx,0
      jge near kloop
      
      jmp cross
      .i11% dd 11
      .cross ret
      ]
      endproc
      rem ===================================================================
      
      rem Coded in ASM above
      def proc_dump1
      
      if I&<>0 then
        fa=1.0*(M&/11)
        rei=rd&*(1-fa) + rb&*fa : rem Done
        gei=gd&*(1-fa) + gb&*fa : rem Done
        bei=bd&*(1-fa) + bb&*fa : rem Done
        
        for k&=M& to 0 step -1
          ff=1.0*(1 - k&/M&)
          
          re&=int(rei*ff) : rem Done
          ge&=int(gei*ff) : rem Done
          be&=int(bei*ff) : rem Done
          colour 10,re&,ge&,be& : gcol 10  : rem Done
          @vdu%!248=Ml&*k&  : rem Done
          move xo%,yo% : draw x%,y%  : rem Done
        next k&
      else
        rem Do nothing
      endif
      endproc
      rem ===================================================================
      
      rem Rotation Routine
      def proc_rotat(opt&)
      P%=rotat%
      
      [opt opt&
      
      mov edx,0
      mov [^pt%],edx
      
      .ptloop
      finit
      mov dl,0
      mov [^ii&],dl
      
      .iloop
      mov ebx,0
      mov eax,[^pt%]
      imul eax,72
      mov bl,[^ii&]
      add bl,3
      shl ebx,3
      add eax,ebx
      fldz
      fstp qword (^pstn(0,0))[eax]
      mov [ref%],eax
      
      mov dl,0
      mov [^jj&],dl
      
      .jloop
      mov eax,0
      mov ebx,0
      mov al,[^ii&]
      imul eax,24
      mov bl,[^jj&]
      shl ebx,3
      add eax,ebx
      fld qword (^mat(0,0))[eax]
      mov ebx,0
      mov eax,[^pt%]
      imul eax,72
      mov bl,[^jj&]
      shl ebx,3
      add eax,ebx
      fld qword (^pstn(0,0))[eax]
      fmulp st1,st0
      
      mov eax,[ref%]
      fld qword (^pstn(0,0))[eax]
      faddp st1,st0
      fstp qword (^pstn(0,0))[eax]
      
      inc byte [^jj&]
      mov dl,[^jj&]
      cmp dl,2
      jle near jloop
      
      inc byte [^ii&]
      mov dl,[^ii&]
      cmp dl,2
      jle near iloop
      
      inc dword [^pt%]
      mov edx,[^pt%]
      cmp edx,[^cnt%]
      jle near ptloop
      
      ret
      ]
      endproc
      rem ===================================================================
      
      rem Coded in ASM above
      def proc_dump2
      
      for pt%=0 to cnt%
        for i&=0 to 2
          pstn(pt%,3+i&)=0.0
          for j&=0 to 2
            pstn(pt%,3+i&)+= mat(i&,j&)*pstn(pt%,j&) : rem Done
          next j&
        next i&
      next pt%
      endproc
      rem ===================================================================
      
      rem Display Routine
      def proc_pream(opt&)
      P%=pream%
      
      [opt opt&
      
      mov edx,0
      mov [^pt%],edx
      
      .ploop
      mov ebx,[^pt%]
      cmp ebx,3
      jle blow
      mov al,1
      jmp ahead
      .blow
      mov al,0
      .ahead
      cmp al,0
      je near rover
      
      finit
      
      mov eax,[^pt%]                          ;Transfer pstn array members To variables For convenience
      imul eax,72
      add eax,24
      fld qword (^pstn(0,0))[eax]
      fstp qword [^X]
      add eax,8
      fld qword (^pstn(0,0))[eax]
      fstp qword [^Z]
      add eax,8
      fld qword (^pstn(0,0))[eax]
      fstp qword [^Y]
      
      mov eax,[^pt%]
      cmp eax,0
      je zero
      dec eax
      imul eax,72
      add eax,24
      fld qword (^pstn(0,0))[eax]
      fstp qword [^Xo]
      add eax,8
      fld qword (^pstn(0,0))[eax]
      fstp qword [^Zo]
      add eax,8
      fld qword (^pstn(0,0))[eax]
      fstp qword [^Yo]
      jmp frwd
      .zero
      fld qword [^X]
      fstp qword [^Xo]
      fld qword [^Z]
      fstp qword [^Zo]
      fld qword [^Y]
      fstp qword [^Yo]                      ;Transfer pstn array members To variables For convenience
      
      .frwd
      fld qword [^Z]                        ;Calculate reduction factor, Fac
      fld qword [^Dis]
      faddp st1,st0
      fld qword [^A]
      fsub st1,st0
      fld1
      fsubrp st1,st0
      fdivrp st1,st0                       ;Fac 0n stack
      
      fld qword [^X]                       ;Calculate screen co-0rds
      fmul st0,st1
      fild dword [^xscreen%]
      fmulp st1,st0
      fistp dword [^x%]
      
      fld qword [^Xo]
      fmul st0,st1
      fild dword [^xscreen%]
      fmulp st1,st0
      fistp dword [^xo%]
      
      fld qword [^Y]
      fmul st0,st1
      fild dword [^yscreen%]
      fmulp st1,st0
      fistp dword [^y%]
      
      fld qword [^Yo]                     ;Fac Removed here
      fmulp st1,st0
      fild dword [^yscreen%]
      fmulp st1,st0
      fistp dword [^yo%]                  ;Calculate screen co-0rds
      
      fld qword [^Z]                      ;Calculate Mm%
      fild dword [i100%]
      faddp st1,st0
      fild dword [i20%]
      fdivp st1,st0
      fistp dword [itmp%]
      mov ebx,[itmp%]
      cmp ebx,1
      jge ok1
      mov ebx,1
      mov [^Mm%],ebx
      jmp done
      .ok1
      cmp ebx,255
      jle done
      mov ebx,255
      mov [^Mm%],ebx
      .done
      mov [^Mm%],ebx                        ;Calculate Mm%
      
      call drw%
      
      .rover
      inc dword [^pt%]
      mov edx,[^pt%]
      cmp edx,[^cnt%]
      jle near ploop
      
      jmp over
      .i20%  dd 20
      .i100% dd 100
      .over ret
      ]
      endproc
      rem ===================================================================
      
      rem Coded in ASM above
      def proc_dump3
      
      if pt%<3 then I&=0 else I&=1 : rem Done
      
      rem Done
      X=pstn(pt%,3) : Z=pstn(pt%,4) : Y=pstn(pt%,5)
      
      rem Done
      if pt%>0 then
        Xo=pstn(pt%-1,3) : Zo=pstn(pt%-1,4) : Yo=pstn(pt%-1,5)
      else
        X0=X : Zo=Z : Yo=Y
      endif
      
      rem Done
      Fac=(1-A)/((Z+Dis)-A) : rem Reduction or scale factor for perspective
      
      rem Scale to screen size
      x%=int(xscreen%*X*Fac) : y%=int(yscreen%*Y*Fac)       : rem Done
      xo%=int(xscreen%*Xo*Fac) : yo%=int(yscreen%*Yo*Fac)   : rem Done
      
      rem Below DONE
      rem Width of lines dependant on Z
      M=int((100+Z)/20)
      if M<1 then M=1
      if M>255 then M=255
      M&=int(M)
      
      endproc
      rem ===================================================================
      
      rem Display BMP
      def proc_BMP_DispB(wdth%,hght%,pic%)
      
      sys "SetStretchBltMode", @memhdc%, 3
      command$="MDISPLAY "+str$~pic%+" " + str$(-wdth%) + "," + str$(-hght%) + "," + str$(2*wdth%) + "," + str$(2*hght%)
      oscli command$
      endproc
      rem ===============================================================