REM Fern 3D (v3)
      REM Requires GLib to run

      *ESC OFF
      *FLOAT 64

      INSTALL @lib$ + "GLIB" : REM remove this line if GLib library is appended to end of this program

      PROCFWS : MODE 8 : OFF

      PROCInitGLIB( g{} )

      ON ERROR PROCCleanup : REPORT : END
      ON CLOSE PROCCleanup : QUIT

      P% = PlotPixel
      Q% = PlotPoint
      R% = ReadPixel
      G% = g{}

      REM Create colour-graduated background bitmap:
      WinW% = @vdu%!208
      WinH% = @vdu%!212
      bg% = FN`ga(4*WinW%*WinH%, 1)
      FOR Y% = 0 TO WinH%-1
        A% = 4*Y%*WinW%
        f = 1 - Y%/(WinH%-1)
        C% = INT(255*0.5*f) + &100*INT(255*0.15*f) + &10000*INT(255*0.075*f)
        FOR I% = bg%+A% TO bg%+A%+4*WinW%-1 STEP 4
          !I% = C%
        NEXT I%
      NEXT Y%

      nPts% = FNgetFernPoints( 12345678, FALSE )
      DIM p(nPts%-1,2), q(nPts%-1,2), m(2,2)
      dummy% = FNgetFernPoints( 12345678, TRUE )

      minX = 10000000
      maxX = -minX
      minY = 10000000
      maxY = -minY

      FOR I% = 0 TO nPts%-1
        IF p(I%,0) < minX THEN minX = p(I%,0)
        IF p(I%,0) > maxX THEN maxX = p(I%,0)
        IF p(I%,1) < minY THEN minY = p(I%,1)
        IF p(I%,1) > maxY THEN maxY = p(I%,1)
      NEXT I%

      dx_max = maxX - minX
      dy_max = maxY - minY
      cx = dx_max/2
      cy = dy_max/2
      d_max = SQR(cx^2 + cy^2)

      FOR I% = 0 TO nPts%-1
        x = p(I%,0)
        y = p(I%,1)
        p(I%,2) = 50 + 150*SQR((x-cx)^2 + (y-cy)^2)/d_max
        p(I%,0) -= cx
        p(I%,1) -= cy
      NEXT I%

      k = 1/700
      DIM C%( 700 )
      FOR I% = 0 TO 700
        C%(I%) = &100*INT(255*k*I%) + INT(64*k*I%)
      NEXT I%

      *REFRESH OFF

      REPEAT
        T% = TIME
        A = T%/122
        B = T%/176
        C = T%/312
        D = 2*PI*SIN(T%/520)
        E = 3*PI*COS(T%/720)
        sA = SIN(A)
        cA = COS(A)
        sB = SIN(B)
        cB = COS(B)
        sC = SIN(C)
        cC = COS(C)
        m() = cB*cC, -cB*sC, sB,  cA*sC+sA*sB*cC, cA*cC-sA*sB*sC, -sA*cB, sA*sC-cA*sB*cC, sA*cC+cA*sB*sC, cA*cB
        q() = p().m()
        SYS BPlot, G%, bg%, WinW%, WinH%, 0, 0
        FOR I% = 0 TO nPts%-1
          SYS Q%, G%, &140+q(I%,0), &100+q(I%,1), C%(&15E+q(I%,2))
        NEXT
        PROCDisplay(TRUE)
      UNTIL FALSE
      END

      DEF FNgetFernPoints( rndseed%, store_coords% )
      LOCAL A%, C%, I%, S%, r, x, y, newx, newy
      S% = RND(-ABS(rndseed%))
      C% = 0
      x = 0
      y = 0
      SYS Clr, g{}, 0
      FOR I% = 1 TO 80000
        r = RND(1)
        CASE TRUE OF
          WHEN r<=0.1 A=0: B=0: C=0: D=0.16: E=0: F=0
          WHEN r>0.1 AND r<=0.86 A=.85: B=.04: C=-.04: D=.85: E=0: F=1.6
          WHEN r>0.86 AND r<=0.93 A=.2: B=-.26: C=.23: D=.22: E=0: F=1.6
          WHEN r>0.93 A=-.15: B =.28: C=.26: D=.24: E=0: F=.44
        ENDCASE
        newx=A*x+B*y+E
        newy=C*x+D*y+F
        x=newx
        y=newy
        SYS R%, G%, 300+48*x, 16+48*y TO A%
        IF A% = 0 THEN
          IF store_coords% THEN
            SYS P%, G%, 300+48*x, 16+48*y, &E020
            p(C%,0) = 48*x
            p(C%,1) = 48*y
            p(C%,2) = 0
          ELSE
            SYS P%, G%, 300+48*x, 16+48*y, &E020
          ENDIF
          C% += 1
        ENDIF
      NEXT
      = C%
 

      *ESC OFF

      NumSprTypes% = 20
      MaxObjs% = 2000

      M% = 3
      HIMEM = LOMEM + M%*&100000
      HIMEM = (HIMEM + 3) AND -4

      BB4W% = (INKEY(-256) == &57)

      IF BB4W% THEN
        GetTicks$ = "GetTickCount"
        SetWindowText$ = "SetWindowText"
      ELSE
        GetTicks$ = "SDL_GetTicks"
        SetWindowText$ = "SDL_SetWindowTitle"
      ENDIF

      ScrW% = 640
      ScrH% = 480
      VDU 23,22,ScrW%;ScrH%;8,16,16,0 : OFF

      TmpBMPBuf% = FNmalloc(4*128*128)

      REM Create a 640x480 32bpp 'surface' bitmap:
      DIM bmp{a%,w%,h%}
      bmp.w%=ScrW%
      bmp.h%=ScrH%
      bmp.a%=FNcreateBMP32(bmp.w%,bmp.h%)

      PROCInitGLIB(g{},bmp.w%,bmp.h%)
      g.a%=bmp.a%+54

      DIM spr{(NumSprTypes%-1) a%, sz%}
      DIM obj{(MaxObjs%-1) type%, x, y, dx, dy}

      *REFRESH OFF

      GCOL 15
      FOR I%=0 TO NumSprTypes%-1
        spr{(I%)}.sz% = 4*(8+RND(10))
        CLS
        col1% = RND(64)+&100*RND(64)+&10000*RND(64)
        col2% = (32+RND(255-32))+&100*(32+RND(255-32))+&10000*(32+RND(255-32))
        FOR r%=spr{(I%)}.sz%/2-1 TO 1 STEP -1
          f=1-r%/(spr{(I%)}.sz%/2-1)
          PROClerpRGB(col1%,col2%,f,R%,G%,B%)
          COLOUR 15,R%,G%,B%
          CIRCLE FILL spr{(I%)}.sz%, spr{(I%)}.sz%, 2*r%
        NEXT r%
        file$ =  @tmp$ + "spr" + STR$I%
        OSCLI "GSAVE """+file$+""" "+STR$0+","+STR$0+","+STR$(2*spr{(I%)}.sz%)+","+STR$(2*spr{(I%)}.sz%)
      NEXT I%

      CLS : OSCLI "REFRESH" : OSCLI "REFRESH ON"

      FOR I%=0 TO NumSprTypes%-1
        PRINT I%
        file$ =  @tmp$ + "spr" + STR$I% + ".BMP"
        spr{(I%)}.a% = FNLoadBMP(file$,TmpBMPBuf%,4*128*128)
      NEXT I%

      FOR I%=0 TO MaxObjs%-1
        obj{(I%)}.type% = RND(NumSprTypes%)-1
        obj{(I%)}.x = 32+RND(ScrW%-64)
        obj{(I%)}.y = 32+RND(ScrH%-64)
        obj{(I%)}.dx = 0.05 * SGN(RND(1)-0.5) * (0.25 + 3.75*RND(1))
        obj{(I%)}.dy = 0.05 * SGN(RND(1)-0.5) * (0.25 + 3.75*RND(1))
      NEXT I%

      G% = g{}

      NumObjs% = 1

      flushKbBuf% = 0
      frames% = 0
      frameRate% = 0
      SYS GetTicks$ TO time0%

      REPEAT
  
        SYS GetTicks$ TO t1%
  
        SYS Clr,g{},&A0D0
  
        P% = PlotShadow
        FOR I%=0 TO NumObjs%-1
          t%=obj{(I%)}.type%
          a%=spr{(t%)}.a%
          sz%=spr{(t%)}.sz%
          SYS P%,G%,a%,sz%,sz%,obj{(I%)}.x-16,obj{(I%)}.y-16
        NEXT
  
        P% = Plot
        FOR I%=0 TO NumObjs%-1
          t%=obj{(I%)}.type%
          a%=spr{(t%)}.a%
          sz%=spr{(t%)}.sz%
          SYS P%,G%,a%,sz%,sz%,obj{(I%)}.x,obj{(I%)}.y
        NEXT
  
        OSCLI "MDISPLAY "+STR$~bmp.a%
        WAIT 1
  
        SYS GetTicks$ TO t2%
  
        dt%=t2%-t1%
  
        FOR I%=0 TO NumObjs%-1
          obj{(I%)}.x+=dt%*obj{(I%)}.dx
          obj{(I%)}.y+=dt%*obj{(I%)}.dy
          IF obj{(I%)}.x<-32 THEN
            obj{(I%)}.dx*=-1
            obj{(I%)}.x+=obj{(I%)}.dx
          ENDIF
          IF obj{(I%)}.x>ScrW%-32 THEN
            obj{(I%)}.dx*=-1
            obj{(I%)}.x+=obj{(I%)}.dx
          ENDIF
          IF obj{(I%)}.y<-32 THEN
            obj{(I%)}.dy*=-1
            obj{(I%)}.y+=obj{(I%)}.dy
          ENDIF
          IF obj{(I%)}.y>ScrH%-32 THEN
            obj{(I%)}.dy*=-1
            obj{(I%)}.y+=obj{(I%)}.dy
          ENDIF
        NEXT
  
        IF INKEY-58 THEN
          NumObjs%+=1
          IF NumObjs%=MaxObjs% NumObjs%=MaxObjs%
        ENDIF
  
        IF INKEY-42 THEN
          NumObjs%-=1
          IF NumObjs%<1 NumObjs%=1
        ENDIF
  
        frames% += 1
        SYS GetTicks$ TO time1%
        IF time1%-time0% >= 1000 THEN
          frameRate% = frames%
          frames% = 0
          SYS SetWindowText$, @hwnd%, STR$frameRate% + " fps | "+STR$NumObjs%+" objects"
          SYS GetTicks$ TO time0%
        ENDIF
  
        IF flushKbBuf% > 0 THEN
          flushKbBuf% -= 1
        ELSE
          *FX 21, 0
          flushKbBuf% = 250
        ENDIF
  
      UNTIL FALSE
      END

      DEF PROClerpRGB( rgb1%, rgb2%, f, RETURN r%, RETURN g%, RETURN b% )
      LOCAL r1%, g1%, b1%, r2%, g2%, b2%
      r1% = (rgb1% AND &FF0000) >> 16
      g1% = (rgb1% AND &FF00) >> 8
      b1% = rgb1% AND &FF
      r2% = (rgb2% AND &FF0000) >> 16
      g2% = (rgb2% AND &FF00) >> 8
      b2% = rgb2% AND &FF
      r% = r1% + f*(r2%-r1%)
      g% = g1% + f*(g2%-g1%)
      b% = b1% + f*(b2%-b1%)
      ENDPROC

      DEF FNcreateBMP32( W%, H% )
      LOCAL A%, S%
      S% = 54 + 4*W%*H% + 6
      DIM A% S%-1
      A% = ((A% + 3) AND -4) + 2
      A%?0 = ASC"B"
      A%?1 = ASC"M"
      A%!2 = 54 + 4*W%*H%
      A%!6 = 0
      A%!10 = 54
      A%!14 = 40
      A%!18 = W%
      A%!22 = H%
      A%?26 = 1
      A%?28 = 32
      A%!30 = 0
      A%!34 = 4*W%*H%
      A%!38 = 0
      A%!42 = 0
      A%!46 = 0
      A%!50 = 0
      = A%

      DEF FNLoadBMP( file$, buf%, bufSz% )
      LOCAL A%, B%, F%, W%, H%, I%, S%
      F% = OPENIN( file$ )
      IF F% = 0 THEN ERROR 0, "Can't find file " + file$
      S% = EXT#F%
      CLOSE#F%
      OSCLI "LOAD """ + file$ + """ " + STR$~buf%
      IF buf%?0<>ASC"B" OR buf%?1<>ASC"M" THEN
        ERROR 0, file$ + " isn't a BMP file"
      ENDIF
      IF buf%?28 <> 24 AND buf%?28 <> 32 THEN
        ERROR 0, "BMP file has invalid colour depth (must be 24 or 32)"
      ENDIF
      W% = buf%!18
      IF (W% AND 3) <> 0 THEN ERROR 0, "BMP image width must be a multiple of 4"
      H% = buf%!22
      REM if H% is negative then sprite is "upside down" !
      S% = 4 * W%*ABS(H%)
      DIM B% S%+7
      B% = (B% + 7) AND -8
      A% = buf% + buf%!10

      IF SGN(H%) = 1 THEN
        IF buf%?28 = 24 THEN
          FOR I% = B% TO B%+S%-1 STEP 4
            !I% = ?A% OR &100*A%?1 OR &10000*A%?2
            A% += 3
          NEXT
        ENDIF
      ENDIF

      IF SGN(H%)=-1 THEN
        H%=ABS(H%)
        IF buf%?28=24 THEN
          A%+=3*W%*(H%-1)
          FOR Y%=0 TO H%-1
            Z%=A%
            FOR I%=B%+4*W%*Y% TO B%+4*(W%*Y% +(W%-1))-1 STEP 4
              !I%=?Z% OR &100*Z%?1 OR &10000*Z%?2
              Z%+=3
            NEXT
            A%-=3*W%
          NEXT
        ENDIF
      ENDIF
      = B%

      REM ============================================================================
      DEFPROCInitGLIB(RETURN v{},W%,H%):LOCALS%,Z%:DIMv{a%,w%,h%}
      v.w%=W%
      v.h%=H%
      Z%=FNmalloc(4096)
      S%=FNmalloc(2048)
      $S%="608B5C2424C703FFFFFFFF8B7C24383B7C24280F8DC70000008B74243C3B74242C0F8DB9"
      $S%+="0000008B4C24308B54243483F9007D03F7D99083FA007D03F7DA90F7D93BF90F8E970000"
      $S%+="00F7DA3BF20F8E8D000000F7D9F7DAC70300000000C7430400000000C7430800000000C7"
      $S%+="430C00000000894B10895314897B1889731C8BEF03E93B6C24287E0E2B6C2428296B10C7"
      $S%+="4304FFFFFFFF83FF007D14297B0C017B10C7431800000000C74304FFFFFFFF8BEE03EA3B"
      $S%+="6C242C7E0E2B6C242C296B14C74304FFFFFFFF83FE007D14297308017314C7431C000000"
      $S%+="00C74304FFFFFFFF61C21C0060":gClip=FN`m(S%,0)
      $S%="608B6C24248B4424288B7D008B4D040FAF4D08FCF3AB61C2080000":Clr=FN`m(S%,0)
      $S%="608BEC81EC800000008B75248BC4FF7538FF7534FF7530FF752CFF7608FF760450E8F6FE"
      $S%+="FFFFF70424FFFFFFFF0F855A0000008B552C89542434C1642434020FAF5424080354240C"
      $S%+="C1E2020355288B7E04897C2438C1642438020FAF7C241C037C2418C1E702033E8B5C2410"
      $S%+="33C98B048A85C0740389048F83C1013BCB7CEF03542434037C2438FF4C241475DF81C480"
      $S%+="00000061C2180060":Plot=FN`m(S%,33)
      $S%="608BEC81EC800000008B75248BC4FF7538FF7534FF7530FF752CFF7608FF760450E85FFE"
      $S%+="FFFFF70424FFFFFFFF0F85610000008B552C89542434C1642434020FAF5424080354240C"
      $S%+="C1E2020355288B7E04897C2438C1642438020FAF7C241C037C2418C1E702033E8B5C2410"
      $S%+="33C98B048A85C0740AD12C8F81248F7F7F7F7F83C1013BCB7CE803542434037C2438FF4C"
      $S%+="241475D881C48000000061C2180060":PlotShadow=FN`m(S%,33)
      Z%=FNmalloc(4096)
      ENDPROC
      DEFFN`m(S%,O%)
      LOCALA%,I%:A%=FNmalloc(LEN$S%):FORI%=0TOLEN$S%DIV2-1
        A%?I%=EVAL("&"+MID$($S%,2*I%+1,2)):NEXT
      IFO%>0PROC`d(A%,O%,gClip)
      =A%
      DEFPROC`d(B%,O%,C%):LOCALD%,P%:D%=C%-B%-O%-5:P%=B%+O%+1:!P%=D%:ENDPROC
      DEFFNmalloc(N%):LOCALA%:DIM A% N%+7:A%=(A%+7) AND -8:=A%
      REM ============================================================================