'
'program Pwarp;

'{Based on Warp by Tony Mattis}

'{Changes:}
'{€ different colors on the stars}
'{€ scaled sizes}
'{€ works even without CQD}
''===========================================================================
'Translated from Pascal into FutureBasic by Derek Smith
'(This particular file uses FutureBasic dependent commands)
'Some improvements on speed and reliability were made.
'
'As far as I can tell, this should work on any Macintosh with any color depth
'Tested on Mac Plus/SE/Peforma 636, LC 575, PowerMac 6100-No Crash
'
'Testing indicates that PLOT is faster than SETCPIXEL, slower than
'assembly drawing.  Don't know about CIRCLE FILL.
'============================================================================
COMPILE 0,_caseinsensitive
WINDOW OFF
_kNumOfStars = 30                      '	{was 70}
_kProjDistance = 150                   ' {was 450} 'Size of projection
_kLargeStar = 0
_kSmallStar = 1
_kVelocity = 6                         'speed of stars
_kStarScale = 150                      'size of 3D stars
_kViewBase = 5                         'how far viewer is from projection

DIM RECORD Star
  DIM		sx&, sy&, sz&                   '{3D location}
  DIM StarSize%                        '{How big?}
  DIM starColor.RGBColor               '{Draw in this COLOR}
  DIM location.4                       '{Screen location}
DIM END RECORD.StarRec

DIM gStarField.StarRec(_kNumOfStars)
DIM gOrigin.4
DIM gWindow&
DIM gColorFlag
DIM gScreenRect.8
DIM RECORD desk
  DIM mbHeight
  DIM saveDeskRgn&
DIM END RECORD .desk

DIM gDesktop.desk
DIM gWarpSpd
END GLOBALS


LOCAL FN HideMenuBar
  DIM rect.8
  LONG IF {_mBarHeight} > 0            'is menubar visible?
    crntDesktopRgn& = [_grayRgn]       'get handle to gray rgn
    gDesktop.mbHeight% = {_mBarHeight}'save current height of menubar
    gDesktop.saveDeskRgn& = FN NEWRGN 'save current desktop rgn
    CALL COPYRGN (crntDesktopRgn&, gDesktop.saveDeskRgn&)'save current desktop rgn
    mBarRgn& = FN NEWRGN               'create rgn for menubar
    rect;8 = [_currentA5] + _screenBits.bounds'get screen rect
    CALL SETRECTRGN (mBarRgn&, rect.left%, rect.top%, rect.right%, rect.top% + gDesktop.mbHeight%)
    % _mBarHeight, 0                   'set new height of menubar
    CALL UNIONRGN (crntDesktopRgn&, mBarRgn&, crntDesktopRgn&)'add menubar + desktop rgns
    CALL PAINTBEHIND (FN FRONTWINDOW, mBarRgn&)'force redraw of screen area
    CALL CALCVISBEHIND (FN FRONTWINDOW, mBarRgn&)'covered by menubar
    CALL DISPOSERGN (mBarRgn&)         'do some cleanup
  END IF
END FN



LOCAL FN RestoreMenuBar
  LONG IF {_mBarHeight} = 0            'was menubar hidden earlier?
    crntDesktopRgn& = [_grayRgn]       'get handle to gray rgn
    % _mBarHeight, gDesktop.mbHeight%  'set new height of menubar
    CALL COPYRGN (gDesktop.saveDeskRgn&, crntDesktopRgn&)'restore the original desktop region
    CALL DISPOSERGN(gDesktop.saveDeskRgn&)'dispose of the old rgn handle
    gDesktop.saveDeskRgn& = 0          'set rgn handle to zero
    CALL DRAWMENUBAR                   'restore the menu bar
  END IF
END FN

'======================================================================
'======================================================================

LOCAL FN CreateStar (loop)
  gStarField.sx&(loop) = RND(gOrigin.h) - (gOrigin.h / 2)
  gStarField.sy&(loop) = RND(gOrigin.v) - (gOrigin.v / 2)
  gStarField.sz&(loop) = RND(150) + 125
  
  gStarField.StarSize%(loop) = RND(2)-1
  
  LONG IF gColorFlag
    gStarField.starColor.red%(loop) = RND (256)*256
    gStarField.starColor.green%(loop) = RND (256)*256
    gStarField.starColor.blue%(loop) = RND (256)*256
    
    '{Set one component to max so all stars are bright}
    SELECT CASE RND(3) 
      CASE 1:gStarField.starColor.red%(loop) = -1
      CASE 2:gStarField.starColor.green%(loop) = -1
      CASE 3:gStarField.starColor.blue%(loop) = -1
    END SELECT                         ' {CASE}
  END IF
	END FN                                ' {CreateStar}
'=============================================================================
LOCAL FN WarpColor (loop)
  LONG IF gColorFlag 
    CALL RGBFORECOLOR(#@gStarField.starColor(loop)) 
  XELSE
    CALL FORECOLOR(_whiteColor)
  END IF
END FN
'============================================================================
LOCAL FN InitStarField
  		gOrigin.h = (gScreenRect.right) / 2
  		gOrigin.v = (gScreenRect.bottom ) / 2
  FOR loop = 0 TO _kNumOfStars - 1
    FN CreateStar(loop)
  NEXT 
END FN
'============================================================================
LOCAL FN DrawLargeStar (loop)
  DIM starRect.8
  DIM StarSize
  StarSize = 1 + _kStarScale / (gStarField.sz&(loop) + _kViewBase)
  CIRCLE FILL gStarField.location.h%(loop),gStarField.location.v%(loop),StarSize
END FN                                 ' {DrawLargeStar}
'============================================================================
'{Make a projection from 3D space to the screen}
LOCAL FN ProjectH (loop)
  DIM starRect.4
  starRect.h=gStarField.sx&(loop)*_kProjDistance/gStarField.sz&(loop)+gOrigin.h
END FN  =starRect.h                    '{Project}
'==============================================================================
LOCAL FN ProjectV (loop)
  DIM starRect.4
  starRect.v=gStarField.sy&(loop)*_kProjDistance/gStarField.sz&(loop)+gOrigin.v
END FN  =starRect.v                    '{Project}
'==========================================================================
'{Move a star, reset it if necessary}
LOCAL FN AnimateStar (loop)
  gStarField.sz&(loop) = gStarField.sz&(loop) - _kVelocity
  IF gStarField.sz&(loop) <= 0 THEN  FN CreateStar(loop)
  gStarField.location.h%(loop) = FN ProjectH(loop)
  gStarField.location.v%(loop) = FN ProjectV(loop)
  SELECT
    CASE gStarField.location.h%(loop) < 0 
      FN CreateStar(loop)
    CASE gStarField.location.h%(loop) > gScreenRect.right
      FN CreateStar(loop)
    CASE gStarField.location.v%(loop) > gScreenRect.bottom
      FN CreateStar(loop)
    CASE gStarField.location.v%(loop) < 0
      FN CreateStar(loop)
  END SELECT
END FN                                 '{AnimateStar}
'===========================================================================
LOCAL FN AnimateStarField
  FOR loop = 0 TO _kNumOfStars - 1 
    LONG IF gWarpSpd =_false
      CALL FORECOLOR(_blackColor)
      LONG IF gStarField.StarSize(loop) = _kLargeStar 
        FN DrawLargeStar(loop)
      XELSE
        	PLOT gStarField.location.h%(loop), gStarField.location.v%(loop)
      END IF
    END IF
    FN AnimateStar(loop)
    FN WarpColor(loop)
    LONG IF gStarField.StarSize%(loop) = _kLargeStar
      FN DrawLargeStar(loop)
    XELSE
      PLOT gStarField.location.h%(loop), gStarField.location.v%(loop)
    END IF
  NEXT
END FN                                 ' {AnimateStarField}
'============================================
RANDOMIZE FN TICKCOUNT
CALL SETRECT (gScreenRect,-1,-1,SYSTEM (_ScrnWidth)+1,SYSTEM (_ScrnHeight)+1)
LONG IF SYSTEM (_CrntDepth)=1
  gColorFlag = _False
XELSE
  gColorFlag = _true
END IF
FN HideMenubar
WINDOW 1,"FBPWarp",@gScreenRect,_dialogPlain
CALL PAINTRECT(gScreenRect)
FN InitStarField
CALL HIDECURSOR
WHILE 1
  startTime& = FN TICKCOUNT
  FN AnimateStarField
  WHILE FN TICKCOUNT <startTime&+1
  WEND
  LONG IF FN BUTTON OR LEN (INKEY$)
    FN RestoreMenuBar                  'bring back the menubar before quiting
    WINDOW CLOSE 1                     'or the system gets messed up
    END
  END IF
WEND