Publish your showcase on spiderbasic.com

Created a nice software using SpiderBasic ? Post you link here !
Fred
Site Admin
Posts: 1506
Joined: Mon Feb 24, 2014 10:51 am

Publish your showcase on spiderbasic.com

Post by Fred »

Hi there,

We are working on the new SpiderBasic website, and it does look good. We want to add a new "showcase" section, so we can embed SpiderBasic apps or examples, so it can be tested directly from the website. If you want to help with this section, just send us your example (including source code and data) ready to go to the server and we will put it in this section with your name and a link to your products.

Thanks for your help !

The v1.0 is near :)

Fred
User avatar
eddy
Posts: 124
Joined: Thu Mar 27, 2014 8:34 am

Re: Publish your showcase on spiderbasic.com

Post by eddy »

  • how many lines ?
  • with or without server php code ?
:roll:
Fred
Site Admin
Posts: 1506
Joined: Mon Feb 24, 2014 10:51 am

Re: Publish your showcase on spiderbasic.com

Post by Fred »

The code can be any size. You can put the php code as well, but it would be better if it's a client only showcase..
User avatar
MrTAToad
Posts: 291
Joined: Sun Apr 20, 2014 11:43 am
Location: Chichester, England
Contact:

Re: Publish your showcase on spiderbasic.com

Post by MrTAToad »

Where do we send the code ?
Fred
Site Admin
Posts: 1506
Joined: Mon Feb 24, 2014 10:51 am

Re: Publish your showcase on spiderbasic.com

Post by Fred »

You can publish it in this thread as it is meant to made public anyway (if it has data or is too big, just use a .zip).
User avatar
MrTAToad
Posts: 291
Joined: Sun Apr 20, 2014 11:43 am
Location: Chichester, England
Contact:

Re: Publish your showcase on spiderbasic.com

Post by MrTAToad »

Okay!

Here is my pseudo 3D road code. It was converted from my GLBasic code, which in turn was converted from the Javascript code by CodeIncomplete :

Code: Select all

#PLAYER_STRAIGHT                      =       0
#PLAYER_LEFT                          =       1
#PLAYER_RIGHT                         =       2
#PLAYER_UPHILL_STRAIGHT								=       3
#PLAYER_UPHILL_LEFT            				=       4
#PLAYER_UPHILL_RIGHT           				=       5

#ROAD_LENGTH_NONE                     =       0
#ROAD_LENGTH_SHORT                    =       25
#ROAD_LENGTH_MEDIUM                   =       50
#ROAD_LENGTH_LONG                     =       100

#ROAD_HILL_NONE                       =       0
#ROAD_HILL_LOW                        =       20
#ROAD_HILL_MEDIUM                     =       40
#ROAD_HILL_HIGH                       =       60

#ROAD_CURVE_NONE                      =       0
#ROAD_CURVE_EASY                      =       2
#ROAD_CURVE_MEDIUM                    =       4
#ROAD_CURVE_HARD                      =       6

#FRAMERATE		=	75
#SCREENWIDTH	=	800
#SCREENHEIGHT	=	600

Structure Point
  x.f
  y.f
  angle.f
  colour.l
EndStructure

Structure tAppTime
	AppTime_UPS.f
	AppTime_Iterator.f
	AppTime_CurrentTime.f
	AppTime_PauseStart.b
	AppTime_Speed.f
	AppTime_DesiredLoopTime.f
	AppTime_LastUpdateTime.f
	AppTime_LastUPSTime.f
	AppTime_DesiredFrequency.b
EndStructure

Declare TAppTime_Initialise(*appTime.tAppTime,frameRate.b=75)
Declare TAppTime_Update(*appTime.tAppTime)

Structure tGraphic
	id.l
	index.l
	orgXSize.l
	orgYSize.l
	currentXSize.l
	currentYSize.l
	xOffset.f
	yOffset.f
	zOffset.f
	speed.f
	percent.f
	moveSpeed.f
EndStructure
	
Structure tScreen
	scale.f
	x.f
	y.f
	w.f
EndStructure

Structure tCamera
	x.f
	y.f
	z.f
EndStructure

Structure tWorld
	x.f
	y.f
	z.f
EndStructure

Structure tColour
	rumble.l
	road.l
	grass.l
	lane.l
EndStructure

Structure tPart
	world.tWorld
	camera.tCamera
	screen.tScreen
	rumbleWidth.f
EndStructure

Structure tSegment
	index.l
	colour.tColour
	p1.tPart
	p2.tPart
	curve.f
	rumbleWidth.f
	clip.f
	
	List staticGraphics.tGraphic()
	List moveGraphics.tGraphic()
EndStructure

Declare RenderFrame()
Declare render()
Declare resetRoad()
Declare addSegment(curve.f,y.f)
Declare segment(width.l,lanes.l,fog.f,*segment.tSegment)
Declare update(dt.f)
Declare.f increase(start.f,increment.f,maxV.f)
Declare.f accelerate(v.f,accel.f,dt.f)
Declare Min(a,b)
Declare Max(a,b)
Declare.f limit(value.f,minV.f,maxV.f)
Declare addRoad(enter.l,hold.l,leave.l,curve.f,y.f)
Declare addStraight(num.l=25)
Declare addCurve(num.l,curve.f)
Declare addHill(num.l, height.l) 
Declare easeIn(a.f,b.f,percent.f)
Declare easeOut(a.f,b.f,percent.f)
Declare easeInOut(a.f,b.f,percent.f)
Declare.f percentRemaining(n.l,total.l)
Declare.f interpolate(a.f,b.f,percent.f)
Declare addStaticGraphic(roadIndex.l,xSize.l,ySize.l,xOffset.f,yOffset.f=0.0)
Declare renderStaticGraphic(screenWidth.l,screenHeight.l,xSize.l,ySize.l,resolution.l,roadWidth.l,scale.f,destX.f,destY.f,offsetX.f,offsetY.f,clipY.f)

Global Dim segments.tSegment(0)
Global trackLength.l
Global segmentLength.l	=	200
Global rumbleLength.l = 3
Global width.l	= #SCREENWIDTH
Global height.l	=	#SCREENHEIGHT
Global position.f	=	0.0
Global drawDistance.l	 =	300
Global cameraDepth.f	   =	0.0
Global cameraHeight.f	 =	1500.0
Global roadWidth.f		   =	2000.0
Global playerX.f			   =	0.0
Global fieldOfView.f    = 45.0
Global speed.f          = 0.0
Global playerX.f          = 0.0
Global lanes.l          = 3
Global playerZ.f        = 0.0
Global DARK_ROAD.tColour
Global LIGHT_ROAD.tColour
Global Terrain.l
Global _screen.l
Global SPRITES_SCALE.F

Define appTime.TAppTime
Define now.f,last.f,gdt.f,stp.f

; InitSprite()
; InitKeyboard()

DARK_ROAD\road=6908265
DARK_ROAD\grass=39424
DARK_ROAD\rumble=12303291
DARK_ROAD\lane=0

LIGHT_ROAD\road=7039851
LIGHT_ROAD\grass=1092112
LIGHT_ROAD\rumble=5592405
LIGHT_ROAD\lane=13421772

cameraDepth=1.0 / Tan(Radian(fieldOfView/2.0)) 
playerZ=cameraHeight * cameraDepth

now=0.0
last=0.0
gdt=0.0
stp=0.025

	Procedure RenderFrame()  	
		If StartDrawing(SpriteOutput(_screen))
			Box(0,0,width-1,height-1,0)
			
			render()
			
			StopDrawing()
			
			DisplaySprite(_screen,0,0)
			
			
			FlipBuffers()
			
			update(TAppTime_Update(appTime))
			
		EndIf
  EndProcedure
  
Procedure resetRoad()
  Dim segments.tSegment(0)
  
  addStraight(50)
	addCurve(25,#ROAD_CURVE_MEDIUM)
  addHill(25,#ROAD_HILL_HIGH)
  addCurve(25,#ROAD_CURVE_EASY)
  addStraight(50)
  addHill(25,-#ROAD_HILL_LOW)
  addHill(25,#ROAD_HILL_MEDIUM)
;  addHill(25,-#ROAD_HILL_HIGH)
;  addCurve(25,-#ROAD_CURVE_MEDIUM)
;  addCurve(25,#ROAD_CURVE_HARD)
;  addHill(25,#ROAD_HILL_HIGH)
;  addHill(25,#ROAD_HILL_HIGH)
;  addHill(25,-#ROAD_HILL_HIGH)
;  addStraight(10)
;  addHill(25,-#ROAD_HILL_HIGH)
;  addStraight(100)
;  addCurve(25,#ROAD_CURVE_HARD)
;  addCurve(25,#ROAD_CURVE_HARD)
;  addCurve(25,#ROAD_CURVE_HARD)
;  addHill(100,-#ROAD_HILL_HIGH)
;  addHill(200,#ROAD_HILL_HIGH)
;  addHill(10,#ROAD_HILL_HIGH)
;  addHill(15,#ROAD_HILL_HIGH)
;  addHill(30,-#ROAD_HILL_HIGH)
;  addStraight(100)

	addStaticGraphic(20,32,32,-1.0,0.0)
	addStaticGraphic(40,32,32,-1.0,0.0)
	addStaticGraphic(60,32,32,-1.0,0.0)
	addStaticGraphic(80,32,32,-1.0,0.0)
	addStaticGraphic(100,32,32,-1.0,0.0)
	addStaticGraphic(120,32,32,-1.0,0.0)
	addStaticGraphic(140,32,32,-1.0,0.0)
	addStaticGraphic(160,32,32,-1.0,0.0)
	
	addStaticGraphic(180,32,32,-1.0,0.0)
	addStaticGraphic(200,32,32,-1.0,0.0)
	addStaticGraphic(220,32,32,-1.0,0.0)
	addStaticGraphic(240,32,32,-1.0,0.0)
	addStaticGraphic(260,32,32,-1.0,0.0)
	addStaticGraphic(300,32,32,-1.0,0.0)
	addStaticGraphic(400,32,32,-1.0,0.0)
	addStaticGraphic(500,32,32,-1.0,0.0)
		
  trackLength=ArraySize(segments())*segmentLength  
EndProcedure

Procedure addStaticGraphic(roadIndex.l,xSize.l,ySize.l,xOffset.f,yOffset.f=0.0)
	Define *graphic.tGraphic
	
	*graphic=AddElement(segments(roadIndex)\staticGraphics())
	If *graphic<>#NUL
		*graphic\id=-1
		*graphic\orgXSize=xSize
		*graphic\orgYSize=ySize
		*graphic\currentXSize=*graphic\orgXSize
		*graphic\currentYSize=*graphic\orgYSize
		*graphic\xOffset=xOffset
		*graphic\yOffset=yOffset
		*graphic\zOffset=roadIndex*segmentLength
		*graphic\percent=0.0
		*graphic\index=0
		*graphic\moveSpeed=0.0
		Debug "Added"
	EndIf
EndProcedure
		
Procedure.f lastY()
  Define index.l
  
  index=ArraySize(segments()) 
  If index<=0
    ProcedureReturn 0.0
  Else    
    ProcedureReturn segments(index-1)\p2\world\y
  EndIf
EndProcedure

Procedure addSegment(curve.f,y.f)
	Define n.l
	Define prevY.f
	
	prevY=lastY()
	n=ArraySize(segments())
	ReDim segments.tSegment(n+1)
	
	Debug "Array count : "+n
	
	NewList segments(n)\staticGraphics()
	NewList segments(n)\moveGraphics()
	
  segments(n)\curve=curve
	segments(n)\index=n
	segments(n)\p1\world\x=0.0
	segments(n)\p1\world\y=prevY
	segments(n)\p1\world\z=n*segmentLength		
	segments(n)\p1\camera\x=0.0
	segments(n)\p1\camera\y=0.0
	segments(n)\p1\camera\z=0.0
	
	segments(n)\p2\world\x=0.0
	segments(n)\p2\world\y=y
	segments(n)\p2\world\z=(n+1)*segmentLength
	segments(n)\p2\camera\x=0.0
	segments(n)\p2\camera\y=0.0
	segments(n)\p2\camera\z=0.0
	
	segments(n)\rumbleWidth=2
	
	If n % 2
		segments(n)\colour=LIGHT_ROAD
	Else
		segments(n)\colour=DARK_ROAD
	EndIf
	
	segments(n)\colour\lane=RGB(255,255,255)	
EndProcedure

Procedure findSegment(z.f,*store.tSegment)
  Define index.l
  
  ; Debug "Z:"+StrF(z,4)+" "+Str(segmentLength)+" "+StrF(z/segmentLength,4)
  index=Round(z/segmentLength,#PB_Round_Down)
  CopyStructure(segments(index),*store,tSegment)
EndProcedure
	
Procedure project(*p.tPart,cameraX.f,cameraY.f,cameraZ.f,cameraDepth.f,width.l,height.l,roadWidth.l,rumbleWidth.l)
		*p\camera\x=*p\world\x-cameraX
		*p\camera\y=*p\world\y-cameraY
		*p\camera\z=*p\world\z-cameraZ
		
		If *p\camera\z<>0.0
			*p\screen\scale=cameraDepth/*p\camera\z
		Else
			*p\screen\scale=0.0
		EndIf
		
		*p\screen\x=(width/2.0)+((*p\screen\scale* *p\camera\x*width)/2.0)
		*p\screen\y=(height/2.0)-((*p\screen\scale* *p\camera\y*height)/2.0)
		*p\screen\w=*p\screen\scale*roadWidth*width/2.0
		*p\rumbleWidth=*p\screen\w/rumbleWidth
;		Debug "Screen X : "+*p\screen\x
;		Debug "Screen Y : "+*p\screen\y
	EndProcedure
	
	Procedure render()
	  Define baseSegment.tSegment
	  Define playerSegment.tSegment
	  Define basePercent.f
		Define maxy.l,n.l,which.l,index.l
		Define segment.tSegment
		Define x.f,dx.f
		Define playerY.f
		Define playerPercent.f
		Define graphicScale.f,graphicX.f,graphicY.f
		      
      maxy=height
      findSegment(Int(position),@baseSegment)
		  basePercent=percentRemaining(position, segmentLength)
		  findSegment(position+playerZ,@playerSegment)
		  playerPercent=percentRemaining(position+playerZ,segmentLength)
		  playerY=interpolate(playerSegment\p1\world\y,playerSegment\p2\world\y,playerPercent)
		  
	;	  Debug "Player Y : "
		;  Debug playerY
		 ; Debug "Player % : "
		  ;Debug playerPercent
		  ;Debug "P2 : "
		  ;Debug playerSegment\p1\world\y
		  ;Debug playerSegment\p2\world\y
		  ;Debug playerSegment\index 
		  Debug "P1 Y : "+StrF(playerSegment\p1\world\y,4)+" P2 Y : "+StrF(playerSegment\p2\world\y,4)
		  Debug "Player Percent : "+StrF(playerPercent,4)+" Y : "+StrF(playerY,4)+" Index : "+Str(playerSegment\index)
		  
			x=0.0
			dx=-baseSegment\curve*basePercent
			
			For n=0 To drawDistance-1
				index=(baseSegment\index+n) % ArraySize(segments())
				segment=segments(index)
				;Debug "Current index : "+*segment\index				
				
				segment\clip=maxy
				
				project(@segment\p1,(playerX*roadWidth)-x,playerY+cameraHeight,position,cameraDepth,width,height,roadWidth,segment\rumbleWidth)
				project(@segment\p2,(playerX*roadWidth)-x-dx,playerY+cameraHeight,position,cameraDepth,width,height,roadWidth,segment\rumbleWidth)
				
				segments(index)\clip=maxy
				segments(index)\p1\screen=segment\p1\screen
				
				x+dx
				dx+segment\curve
				
				If segment\p1\camera\z<=cameraDepth Or segment\p2\screen\y>=segment\p1\screen\y Or segment\p2\screen\y>=maxy
					Continue
				Else
					segment(width,lanes,1.0,segment)
				EndIf
				
				maxy=segment\p1\screen\y
			Next
			
			; Display objects
			; Static (roadside) ones
			
			For n=drawDistance-1 To 0 Step -1
				segment=segments((baseSegment\index+n) % ArraySize(segments()))
				
				ForEach segment\staticGraphics()
					graphicScale=segment\p1\screen\scale
					graphicX=segment\p1\screen\x+(graphicScale * segment\staticGraphics()\xOffset * roadWidth * width / 2.0)
					graphicY=segment\p1\screen\y+(graphicScale * segment\staticGraphics()\yOffset * roadWidth / 2.0)
					
					renderStaticGraphic(width,height,segment\staticGraphics()\orgXSize,segment\staticGraphics()\orgYSize,1,roadWidth,graphicScale,graphicX,graphicY,-0.5,-1.0,segment\clip)
				Next
			Next
			
				
	EndProcedure
	
	Procedure renderStaticGraphic(screenWidth.l,screenHeight.l,xSize.l,ySize.l,resolution.l,roadWidth.l,scale.f,destX.f,destY.f,offsetX.f,offsetY.f,clipY.f)
		Define destW.f,destH.f,clipH.f
				
		destW=(xSize*scale*screenWidth/2.0)*(SPRITES_SCALE*roadWidth)
		destH=(ySize*scale*screenWidth/2.0)*(SPRITES_SCALE*roadWidth)
		
		destX+(destW*offsetX)
		destY+(destH*offsetY)
		
		If clipY<>0.0
			clipH=Max(0,destY-destH-clipY)
		Else
			clipH=0.0
		EndIf
		
		destH-clipH

		If destW>0.0 And destH>0
			Box(destX,destY,destW,destH,RGB(0,255,0))
		EndIf
	EndProcedure
	
	Procedure.f rumbleWidth(projectedRoadWidth.l,lanes.l)
		ProcedureReturn projectedRoadWidth/MAX(6,2*lanes)
	EndProcedure
	
	Procedure.f laneMarkerWidth(projectedRoadWidth.l,lanes.l)
		ProcedureReturn projectedRoadWidth/MAX(32,8*lanes)
	EndProcedure
	
	Procedure.f percentRemaining(n.l,total.l)
	  ProcedureReturn Mod(n,total)/total
	EndProcedure
	
	Procedure.f interpolate(a.f,b.f,percent.f)
	  ProcedureReturn a+(b-a)*percent
	EndProcedure
	  
	Procedure addRoad(enter.l,hold.l,leave.l,curve.f,y.f)
	  Define n.l
	  Define startY.f,endY.f
	  Define total.l
	  
	  startY=lastY()
	  endY=startY+(Int(y)*segmentLength)
	  total=enter+hold+leave
      
	  For n=0 To enter-1
	    addSegment(easeIn(0,curve,n/enter),easeInOut(startY,endY,n/total))
	  Next
	  
	  For n=0 To hold-1
	    addSegment(curve,easeInOut(startY,endY,(enter+n)/total))
	  Next
	  
	  For n=0 To leave-1
	    addSegment(easeInOut(curve,0,n/leave),easeInOut(startY,endY,(enter+hold+n)/total))
	  Next
	EndProcedure
	
	Procedure easeIn(a.f,b.f,percent.f)
	  ProcedureReturn a+(b-a)*Pow(percent,2)
	EndProcedure
	
	Procedure easeOut(a.f,b.f,percent.f)
	  ProcedureReturn a+(b-a)*(1.0-Pow(1.0-percent,2))
	EndProcedure
	
	Procedure easeInOut(a.f,b.f,percent.f)
	  ProcedureReturn a+(b-a)*((-Cos(percent*#PI)/2)+0.5)
	EndProcedure
  
	Procedure addStraight(num.l=25)
	  addRoad(num,num,num,0.0,0.0)
	EndProcedure
	  
	Procedure addCurve(num.l,curve.f)
	  addRoad(num,num,num,curve,0.0)
	EndProcedure
	
	Procedure addHill(num.l, height.l) 
	  addRoad(num,num,num,0,height)
	EndProcedure
      
	Procedure polygon(x1.f,y1.f,x2.f,y2.f,x3.f,y3.f,x4.f,y4.f,colour.l,type.l)		
;	  If type = 1
    ;TransformSprite(Terrain, x4, y4, 1, x3, y3, 1, x2, y2, 1, x1, y1, 1)
  ;   ElseIf type = 2
   ;    TransformSprite(Terrain, x3, y3, 1, x4, y4, 1, x1, y1, 1, x2, y2, 1)
    ; EndIf
    ;DisplayTransparentSprite(Terrain, 0, 0, 255, colour)
		LineXY(x1,y1,x2,y2,colour)
		LineXY(x2,y2,x3,y3,colour)
		LineXY(x3,y3,x4,y4,colour)
		LineXY(x4,y4,x1,y2,colour)
    ; DisplaySprite(Terrain,x1,y1)
	EndProcedure
	
	Procedure segment(width.l,lanes.l,fog.f,*segment.tSegment) 
	  
    polygon(*segment\p1\screen\x-*segment\p1\screen\w-*segment\p1\rumbleWidth, *segment\p1\screen\y, *segment\p1\screen\x-*segment\p1\screen\w, *segment\p1\screen\y, *segment\p2\screen\x-*segment\p2\screen\w, *segment\p2\screen\y, *segment\p2\screen\x-*segment\p2\screen\w-*segment\p2\rumbleWidth, *segment\p2\screen\y, *segment\colour\rumble, 1)
    polygon(*segment\p1\screen\x+*segment\p1\screen\w+*segment\p1\rumbleWidth, *segment\p1\screen\y, *segment\p1\screen\x+*segment\p1\screen\w, *segment\p1\screen\y, *segment\p2\screen\x+*segment\p2\screen\w, *segment\p2\screen\y, *segment\p2\screen\x+*segment\p2\screen\w+*segment\p2\rumbleWidth, *segment\p2\screen\y, *segment\colour\rumble, 2)
    polygon(*segment\p1\screen\x-*segment\p1\screen\w, *segment\p1\screen\y, *segment\p1\screen\x+*segment\p1\screen\w, *segment\p1\screen\y, *segment\p2\screen\x+*segment\p2\screen\w, *segment\p2\screen\y, *segment\p2\screen\x-*segment\p2\screen\w, *segment\p2\screen\y, *segment\colour\road, 1)
;    Box(0,*segment\p2\screen\y,width,*segment\p1\screen\y-*segment\p2\screen\y,*segment\colour\grass)
  EndProcedure
  
  Procedure update(dt.f)
    position=increase(position,speed,trackLength)
    
    speed+accelerate(speed,45.0,dt)
    speed=limit(speed,0.0,100.0)
  EndProcedure
  
  Procedure Min(a,b)
    If a<b
      ProcedureReturn a
    Else
      ProcedureReturn b
    EndIf
  EndProcedure
  
  Procedure Max(a,b)
    If a>b
      ProcedureReturn a
    Else
      ProcedureReturn b
    EndIf
  EndProcedure
  
  Procedure.f increase(start.f,increment.f,maxV.f)
    Define result.f
    
    result=start+increment
    While result>=maxV
      result-maxV
    Wend
    
    While result<0
      result+maxV
    Wend
    
    ProcedureReturn result
  EndProcedure
  
  Procedure.f accelerate(v.f,accel.f,dt.f)
    ProcedureReturn v+(accel*dt)
  EndProcedure
  
  Procedure.f limit(value.f,minV.f,maxV.f)
    ProcedureReturn Max(minV,Min(value,maxV))
  EndProcedure  
  
  Procedure TAppTime_Initialise(*appTime.tAppTime,frameRate.b=75)
	Debug "Initialising frame rate to "+frameRate
	*appTime\AppTime_UPS=0.0
	*appTime\AppTime_Iterator=0.0
	*appTime\AppTime_CurrentTime=0.0
	*appTime\AppTime_PauseStart=0.0
	*appTime\AppTime_Speed=1.0
	*appTime\AppTime_LastUpdateTime=0.0
	*appTime\AppTime_LastUPSTime=0.0
	*appTime\AppTime_DesiredFrequency=frameRate
	*appTime\AppTime_DesiredLoopTime=1000.0/(*appTime\AppTime_DesiredFrequency*1.0)	
EndProcedure

Procedure TAppTime_Update(*appTime.tAppTime)
	Define elapsed.f
	Define time.f
	
	If *appTime\AppTime_PauseStart=#True 
			ProcedureReturn 0.0
	EndIf

	time=ElapsedMilliseconds()

	If *appTime\AppTime_LastUpdateTime=0.0
			*appTime\AppTime_Speed=1.0
			*appTime\AppTime_LastUPSTime=time
	Else
			elapsed=time-*appTime\AppTime_LastUpdateTime
			If elapsed=0.0
				elapsed=1.0
				; Delay(1)
				time=time+1.0
			EndIf

			*appTime\AppTime_Speed=elapsed/*appTime\AppTime_DesiredLoopTime
	EndIf
		
	*appTime\AppTime_LastUpdateTime=time
	*appTime\AppTime_CurrentTime=time

	*appTime\AppTime_Iterator=*appTime\AppTime_Iterator+1.0 

	If *appTime\AppTime_CurrentTime-*appTime\AppTime_LastUPSTime>=1000.0
			*appTime\AppTime_UPS=*appTime\AppTime_Iterator/((*appTime\AppTime_CurrentTime-*appTime\AppTime_LastUPSTime)/1000)
			*appTime\AppTime_LastUPSTime=*appTime\AppTime_CurrentTime
			*appTime\AppTime_Iterator=0
	EndIf

	ProcedureReturn *appTime\AppTime_Speed	
EndProcedure

Debug "Initialising"

TAppTime_Initialise(appTime,#FRAMERATE)

SPRITES_SCALE = 0.3 * (1/80)

SetFrameRate(#FRAMERATE)

If OpenScreen(width,height,32,"Pseudo 3D Test 1")
	Terrain = CreateSprite(#PB_Any, 16, 16)
  StartDrawing(SpriteOutput(Terrain))
  Box(0, 0, 15, 15,RGB(255,0,0))
  StopDrawing()
  
  
  
  _screen=CreateSprite(#PB_Any,width,height)
		Debug "Setting up"
		resetRoad()
		Debug "Finished setting up"
					
		Debug "Binding"
		BindEvent(#PB_Event_RenderFrame,@RenderFrame())
		
		FlipBuffers()
		Debug "Flipping 1"
		Debug "Flipping 2"

Else
	Debug "OpenScreen failed"
EndIf
Adjust the drawDistance variable value to change how far everything is drawn, and thus the overall speed - 300 is rather too much at the moment - it should be around 100
User avatar
eddy
Posts: 124
Joined: Thu Mar 27, 2014 8:34 am

Re: Publish your showcase on spiderbasic.com

Post by eddy »

I tried to make a fancy demo with HTML5/CSS3 features
You can change the video Id if you have a better video without annotations. :geek:

Code: Select all

; ******************************
; Plugins
; ******************************

Macro InitPlugins(IsInitialized=#True) ; internal functions
  CompilerIf IsInitialized
    !"undefined"==typeof window.SpiderPlugins&&(window.SpiderPlugins={extensions:{},paths:{},names:[]})
  CompilerElse 
    !window.SpiderPlugins={extensions:{},paths:{},names:[]};
  CompilerEndIf   
EndMacro

Procedure DeclareHeaderCSS(css.s)
  !$('head').append( $('<link rel="stylesheet" type="text/css" />').attr('href', v_css) );
EndProcedure

Procedure DeclarePlugin(Plugin.s, Path.s, IsUsed=#True)
  InitPlugins()
  !,window.SpiderPlugins.paths[v_plugin]=v_path
  !,v_isused && window.SpiderPlugins.names.push(v_plugin);
EndProcedure

Procedure UsePlugins(*FunctionUsingPlugins, EnforceDefine=#False)  
  !var cfg=$.extend({ enforceDefine: v_enforcedefine, paths: window.SpiderPlugins.paths }, window.SpiderPlugins.extensions);
  !requirejs.config(cfg);
  !require(window.SpiderPlugins.names, p_functionusingplugins);  
  InitPlugins(#False)
EndProcedure

; ********************
; JSON Shorthand
; ********************
  
Macro Json_OpenObject
  !{
  :
EndMacro
Macro Json_CloseObject
  !},  
EndMacro

Macro Json_OpenArray
  ![
  :
EndMacro
Macro Json_CloseArray
  !],  
EndMacro

Macro Json_Member(member)
  !member:
  : 
EndMacro
Macro Json_Value(value)
  !value,
  : 
EndMacro
Macro Json_Member_Value(member, value)
  Json_Member(member)
  Json_Value(value)
EndMacro
Macro Json_Member_OpenObject(member)
  Json_Member(member)
  Json_OpenObject
EndMacro
Macro Json_Member_OpenArray(member)
  Json_Member(member)
  Json_OpenArray
EndMacro

Macro Json_OpenVariable(v)
  !v={
  :
EndMacro
Macro Json_CloseVariable
  !};
  :
EndMacro

CompilerIf #PB_Compiler_IsMainFile  
  ; *************************************
  ; EXAMPLE - Background Youtube video
  ; *************************************
  
  Procedure CreateBackgroundVideo(YoutubeVideoId.s, IsLooping=#True, IsMute=#True)
    !$('<div class="container" />').appendTo('body').tubular({videoId: v_youtubevideoid, repeat:v_islooping, mute:v_ismute});
    !setTimeout(function(){ 
    ;!   $('#tubular-container iframe').attr('src',$('#tubular-container iframe').attr('src')+'&iv_load_policy=3'); // remove annotation(s)
    !   $('#tubular-container,.container').addClass('fadeIn')
    !}, 200);
  EndProcedure
  
  Procedure GenerateWebsiteCSS(Absurd)
    Protected dark_color.s = "rgba(0,0,0,.3)";
    !var css = v_absurd.add({
    Json_Member_OpenObject("a:link, a:visited") Json_Member_Value("color","orange") Json_CloseObject
    Json_Member_OpenObject("a:hover") Json_Member_Value("color","yellow") Json_Member_Value("transition","1s color") Json_CloseObject
    Json_Member_OpenObject("body")
      Json_Member_Value("bg","white")
      Json_Member_Value("fz","20px")
      Json_Member_Value("lh","24px")
      Json_Member_Value("fontFamily","Helvetica, Arial, sans-serif")
      Json_Member_Value("color","white")
      Json_Member_OpenObject("#tubular-container,.container")
        Json_Member_Value("opacity",0)
        Json_Member_OpenObject("&.fadeIn")
          Json_Member_Value("opacity",1)
          Json_Member_Value("transition","1s opacity") 
          Json_Member_Value("transitionDelay","1s") 
        Json_CloseObject
      Json_CloseObject 
      Json_Member_OpenObject(".container")
        Json_Member_Value("paddingTop","30px")
        Json_Member_Value("marginLeft","auto")
        Json_Member_Value("marginRight","auto")
        Json_Member_Value("width","800px")
        Json_Member_OpenObject("header")
          Json_Member_Value("position","relative")
          Json_Member_OpenObject("nav.player")    
            Json_Member_Value("gradient","rgba(0,0,0,.5)/rgba(0,0,0,.5) 10%/rgba(255,255,255,.2) 70%/rgba(255,255,255,.2)")
            Json_Member_Value("size","80px/30px")
            Json_Member_Value("margin","3px")
            Json_Member_Value("border-radius","6px")
            Json_Member_Value("position","absolute")
            Json_Member_Value("right",0)
            Json_Member_Value("bottom",0)
            Json_Member_Value("display","flex")
            Json_Member_Value("alignItems","center")
            Json_Member_Value("justifyContent","space-around")
            ;player button animation
            Json_Member_OpenObject("a")    
              Json_Member_Value("color","gray")
              Json_Member_Value("textShadow","1px 1px 2px #000000")              
              Json_Member_OpenObject("&:hover")
                Json_Member_Value("color","white")
                Json_Member_Value("transition","0.2s color")
              Json_CloseObject
              Json_Member_OpenObject("&:active")
                Json_Member_Value("color","red")
                Json_Member_Value("position","relative")
                Json_Member_Value("left","2px")
                Json_Member_Value("top","2px")
              Json_CloseObject
            Json_CloseObject                  
          Json_CloseObject                        
        Json_CloseObject
        Json_Member_OpenObject("section")
          Json_Member_Value("marginTop","15px")
          Json_Member_Value("marginBottom","15px")
          Json_Member_Value("display","flex")
          Json_Member_Value("flexFlow","row nowrap")
          Json_Member_OpenObject("aside")
            Json_Member_Value("flex","0 1 200px")
            Json_Member_Value("marginRight","15px")
            Json_Member_OpenObject("nav")
              Json_Member_Value("display","flex")
              Json_Member_Value("flexFlow","column nowrap")
              Json_Member_Value("justifyContent","space-between")
              ;menu button animation
              Json_Member_OpenObject("a")
                Json_Member_Value("color","white")
                Json_Member_Value("marginBottom","5px")
                Json_Member_Value("textDecoration","none")
                Json_Member_Value("borderLeft","0px solid black")
                Json_Member_Value("transition","0.2s border-left")
                Json_Member_OpenObject("&:hover")
                  Json_Member_Value("borderLeft","10px solid red")
                  Json_Member_Value("transition","0.2s border-left")
                Json_CloseObject
              Json_CloseObject
            Json_CloseObject
          Json_CloseObject
          Json_Member_OpenObject("article")
            Json_Member_Value("flex","1 0 auto")
          Json_CloseObject
        Json_CloseObject
      Json_CloseObject
      Json_Member_OpenObject(".blackbox")
        Json_Member_Value("bg", v_dark_color)
        Json_Member_Value("pad", "10px")
      Json_CloseObject
      Json_Member_OpenObject(".shadow")
        Json_Member_Value("textShadow","5px 5px 6px #000000")
      Json_CloseObject
    Json_CloseObject
    !}).compile();
    !$('<style />').html(css).appendTo('head');
  EndProcedure
  
  Procedure GenerateWebsiteHTML(Absurd)
    !var html = v_absurd.morph('html').add({
    Json_Member_OpenObject("header.blackbox")
      Json_Member_Value("h1.shadow","Fullscreen Background Video")
      Json_Member_OpenObject("nav.player")
        Json_Member_Value("a[href='#Play' class='tubular-play' title='Play']","<i class='fa fa-play'></i>")
        Json_Member_Value("a[href='#Pause' class='tubular-pause' title='Pause']","<i class='fa fa-pause'></i>")
      Json_CloseObject      
    Json_CloseObject
    Json_Member_OpenObject("section")
      Json_Member_OpenObject("aside")
        Json_Member_OpenArray("nav")
          Json_OpenObject Json_Member_Value("a.blackbox[href='#Home']","<i class='fa fa-home'></i> Home") Json_CloseObject
          Json_OpenObject Json_Member_Value("a.blackbox[href='#Projects']","<i class='fa fa-git'></i> Projects") Json_CloseObject
          Json_OpenObject Json_Member_Value("a.blackbox[href='#Downloads']","<i class='fa fa-download'></i> Downloads") Json_CloseObject
          Json_OpenObject Json_Member_Value("a.blackbox[href='#About']","<i class='fa fa-info-circle'></i> About") Json_CloseObject
        Json_CloseArray
      Json_CloseObject
      Json_Member_OpenObject("article.blackbox")
        Json_Member_Value("h3","Technical Details")
        Json_Member_OpenArray("ul")
          Json_OpenObject Json_Member_Value("li","Video Source: <a href='https://youtu.be/X-dMOvEOQiM'>https://youtu.be/X-dMOvEOQiM</a>") Json_CloseObject
          Json_OpenObject Json_Member_Value("li","Plugin: <a href='http://absurdjs.com/'>http://absurdjs.com/</a>") Json_CloseObject
          Json_OpenObject
            Json_Member_OpenArray("li") 
              Json_Value("Plugin: ") 
              Json_OpenObject Json_Member_Value("a[href='http://www.seanmccambridge.com/tubular/' ]","http://www.seanmccambridge.com/tubular/") Json_CloseObject
              Json_Value(" <i class='fa fa-thumbs-o-up'></i>")
            Json_CloseArray
          Json_CloseObject
          Json_OpenObject Json_Member_Value("li","HTML5 semantic tags: aside, nav, section, article, header, footer") Json_CloseObject
          Json_OpenObject Json_Member_Value("li","CSS3: flex display mode, transition") Json_CloseObject
        Json_CloseArray
      Json_CloseObject
    Json_CloseObject
    Json_Member_OpenObject("footer.blackbox")
      Json_Member_Value("p.shadow","Demo powered by SpiderBasic")
    Json_CloseObject
    !}).compile();
    !$('.container').append($(html));
  EndProcedure
  
  Procedure CreateWebsite(JqueryTubular,Organic,Absurd)    
    ;your video background
    CreateBackgroundVideo("X-dMOvEOQiM"); // 9hyHnSKE8os
    
    ;preprocessor to generate CSS
    !v_absurd = Absurd();    
    GenerateWebsiteCSS(Absurd)
    
    ;preprocessor to generate HTML
    GenerateWebsiteHTML(Absurd)
  EndProcedure
  
  DeclareHeaderCSS("http://maxcdn.bootstrapcdn.com/font-awesome/4.3.0/css/font-awesome.min.css")         ;Awesome Image-Font Plugin
  DeclarePlugin("JqueryTubular","//rawgit.com/jarc100/jquery-tubular/master/js/jquery.tubular.1.0")      ;Tubular Plugin
  DeclarePlugin("Organic","//cdnjs.cloudflare.com/ajax/libs/absurd/0.3.4/absurd.organic")                ;Absurd Extension  
  DeclarePlugin("Absurd","//cdnjs.cloudflare.com/ajax/libs/absurd/0.3.4/absurd")                         ;Absurd Plugin   
  UsePlugins(@CreateWebsite())
CompilerEndIf
CatSquad
Posts: 1
Joined: Wed Jul 14, 2021 3:39 am

Re: Publish your showcase on spiderbasic.com

Post by CatSquad »

Code: Select all

; program fully operational at https://www.dionysus.biz/Spider/Trajectory77.html
; program inputs cannon initial firing conditions, and outputs trajectory path considering gravity and air friction. Graphic plotting of path + table.
; I am new to SpiderBasic. This is my first. Program looks nice; but if it does not meet your programming standards, I will not be upset.
;You are Number 1! Keep up the good work and thank you.  Fred is the best. CatSquad
Enumeration
  #WinInputs
  #WinCannon
  #WinDragFac
  #WinResults
  #WinControl
  #WinPath
  #WinMap
  #WinKruppGun
  #ProbDescr
  #BoreTxtIn
  #BoreIn
  #VelTxtIn
  #VelIn
  #WtTxtIn
  #WtIn
  #AngTxtIn
  #AngIn
  #HighTxtIn
  #HighIn
  #DragTxtIn
  #DragIn
  #FireButton
  #GunImg
  #GunImgGadget
  #ProbInputRptTitle
  #BoreTxtOut
  #VelTxtOut
  #WtTxtOut
  #AngTxtOut
  #HighTxtOut
  #DragTxtOut
  #ButtonRunAgain
  #ButtonExit
  #ButtonToNavalResearch
  #ButtonToDionysus
  #DragTableImg
  #DragTableImgGadget
  #MapSknyGadget
  #MapSknyImg
  #OslyabyaTrans
  #FreighterBow
  #Shell
  #Splash2
  #Mortar
  #ArrowUp
  #Smoke
  #ButtonToNotes
  #KruppLogoImg
  #KruppImgGadget
  EndEnumeration

Global descript.s="Gun, Year, Country, Model" ;                gadget  1
Global d.f=12.0 ; diameter of shell - inches                   gadget  2
Global vInit.f=2500.0; initial velocity of projectile ft/sec   gadget  4
Global w.f=850.0; projectile weight lbs                        gadget  6
Global thetaInit.f=20.0 ; Angle of cannon barrel in degrees    gadget  8
Global yInit.f=20.0 ; Elevation of tip of gun barrel in feet   gadget 10
Global DF.f=10.0    ;Drag Factor is .7-1.6 entered as 7-16     gadget 12
                    ; note The Fire button is                  gadget 13
Global muzzle.f=20.0
Global flashH.f=18.0
Global xOffset.f=0.0
Global fireTheta.f=0.0
; environmental variables
;Global wide; to describe screen max width
Global tallEff
; plotting variables
Global xScale.f=0.0
Global yScale.f=0.0
Global Scale.f=0.0
; computation global variables
Global Tdelta.f=0.2 ; time step in seconds
Global v.f=vInit
; bashforth procedure globals
Global Dim bash.f(3)
; global return variables
Global xFinal.f=0.0
Global vFinal.f=0.0
Global angFinal.f=0.0
Global timeFinal.f=0.0 
Global DI.f=0.0
Global maxIndex=0
Global wide.f
Global maxRange

;Dim timeRecord.f(1000)
Global Dim xRecord.f(1000)
Global Dim yRecord.f(1000)

Procedure RunProgram(Filename.s, Parameter.s)
  ! if (v_parameter !=""){
  !   var win = window.open(v_filename,v_parameter);
  ! win.focus();
  ! } else {
  ! window.open(v_filename);
  !      }
EndProcedure

Procedure HyperLinkGadgetEvent()
  If EventGadget()=#ButtonRunAgain ;Run analysis again
    RunProgram("https://dionysus.biz/Spider/Trajectory77.html","_blank")
  ElseIf EventGadget()=#ButtonToNavalResearch
    RunProgram("https://dionysus.biz/Battleships&Subs.html","_blank")
  ElseIf EventGadget()=#ButtonToDionysus
    RunProgram("https://dionysus.biz/index.html","_blank")
  ElseIf EventGadget()=#ButtonToNotes 
    RunProgram("https://dionysus.biz/CannonNotes.html","_blank")
  Else
    MessageRequester("Error in HyperLinkGadgetEvent at line 89")
  EndIf  
  EndProcedure

Procedure Loaded(Type,File$,ObjectId); this supports graphic of cannon input dimensions
  If File$="GunInitCondit250T.jpg"
    OpenWindow(#WinCannon,290,435,300,250,"Firing Variables",#PB_Window_SystemMenu)
    ImageGadget(#GunImgGadget,0,0,ImageWidth(ObjectId),ImageHeight(ObjectId),ImageID(#GunImg))
  ElseIf File$="DFTable.png"
    ;OpenWindow(#WinDragFac,600,0,809,623,"Drag Coefficients",#PB_Window_SystemMenu)
    OpenWindow(#WinDragFac,600,0,607,685,"Drag Coefficients",#PB_Window_SystemMenu)
    ImageGadget(#DragTableImgGadget,0,0,ImageWidth(ObjectId),ImageHeight(ObjectId),ImageID(#DragTableImg))
  ElseIf File$="COASTALMAP2.PNG"
    x=xOffse+Scale*maxRange
    y=400.0
    OpenWindow(#WinMap,240,0,wide,560,"Concept Map", #PB_Window_SystemMenu)
    ResizeImage(#MapSknyImg,wide,560) ; set to math line 406
    StartDrawing(ImageOutput(#MapSknyImg))
    Line(50,525,x-50,y-525,RGB(200,0,0))
    DrawingMode(#PB_2DDrawing_Outlined)
    p=Sqr(Pow(x-50,2)+Pow(y-525,2))
    Circle(50,525,p,RGB(200,0,0)); range arc
    For I=12 To 4 Step -2
      Circle(x,y,I,RGB(10*I+50,0,0))
    Next I
    StopDrawing()
    ;ResizeImage(#MapSknyImg,wide,560) ; set to math line 406
    ImageGadget(#MapSknyGadget,0,0,wide,ImageHeight(ObjectId),ImageID(#MapSknyImg))
  ElseIf File$="SKINNYSEA.PNG"
    x=xOffse+Scale*maxRange
    y=400.0
    OpenWindow(#WinMap,240,0,wide,560,"Concept Map", #PB_Window_SystemMenu)  
    ResizeImage(#MapSknyImg,wide,560)
    StartDrawing(ImageOutput(#MapSknyImg))
    Line(85,425,x-85,y-425,RGB(200,0,0))
    DrawingMode(#PB_2DDrawing_Outlined)
    p=Sqr(Pow(x-85,2)+Pow(y-425,2))
    Circle(85,425,p,RGB(200,0,0)); range arc
    For I=12 To 4 Step -2
      Circle(x,y,I,RGB(10*I+50,0,0))
    Next I
    StopDrawing()    
    ImageGadget(#MapSknyGadget,0,0,wide,ImageHeight(ObjectId),ImageID(#MapSknyImg))
  ElseIf File$="KRUPPGUN1897PD.JPG"
    OpenWindow(#WinKruppGun,0,0,588,394,"Krupp 16 Gun (Public Domain from 1897 Popular Science)", #PB_Window_SystemMenu)
    ImageGadget(#KruppImgGadget,0,0,ImageWidth(ObjectID),ImageHeight(ObjectID),ImageID(#KruppLogoImg))
  Else
    ;Debug "Program Issue at Line 87"
  EndIf
  EndProcedure

Procedure Loading(Type, Filename$)
    FlipBuffers() ; start the rendering
  EndProcedure
  
  Procedure Bashforth(v,d,w,theta,y)
  ; establish friction coefficient as function of gross speed. Should not be broken into x & y components
  If v<1061.999
    k.f=18120.39461*Pow(v,-0.8082372052) ;Bashforth Friction Coefficient k below 1062 ft/sec
  Else
    k.f=2.9e-8*Pow(v,3)-1.5924e-4*Pow(v,2)+0.213533*v+52.75734 ;Bashforth Friction Coefficient k above 1062 ft/sec 
  EndIf
  densityFactor.f=1.0098095*Pow(2.718281828,-0.00003206*y); Atmospheric density as funct of y has been curve fit
  k=DF*densityFactor*k ; overall friction factor k is product of drag factor, air density and k
  Ax.f=k*Pow(d,2)*Pow(v,3)*Cos(theta/57.3)/(1e9*w); x component of acceleration  
  Ay.f=k*Pow(d,2)*Pow(v,3)*Sin(theta/57.3)/(1e9*w); y component of acceleration
  bash(0)=k ; an array for return value
  bash(1)=Ax
  bash(2)=Ay
EndProcedure

Procedure Trajectory() 
  ; establish initial x & y velocities
  X1.f=0
  Y1.f=yInit
  Vx1.f=vInit*Cos(thetaInit/57.3)
  Vy1.f=vInit*Sin(thetaInit/57.3)
  V1.f=vInit
  theta1.f=thetaInit ; this is in degrees
  time.f=0.0
  Vx2.f=0.0
  Vy2.f=0.0
  X2.f=0.0
  Y2.f=0.0
  theta2.f=0.0
  xFinal.f=0
  vFinal.f=0
  angFinal.f=0
  
  ; loop to step through time at TBD sec intervals
  For i=0 To 1000
    bashforth(V1,d,w,theta1,Y1)
    k.f=bash(0)
    ;MessageRequester("Bashforth Constant = " + k)
    Ax.f=bash(1)
    Ay.f=bash(2)
    Vx2.f=Vx1-Ax*Tdelta
    Vy2.f=Vy1-Ay*Tdelta-32.0*Tdelta
    X2=X1+Vx2*Tdelta
    Y2=Y1+Vy2*Tdelta
    V2=Sqr(Pow(Vx2,2)+Pow(Vy2,2))

    theta2.f=57.3*ATan((Y2-Y1)/(X2-X1)); in degrees
  
    ; set old values to new
    time=time+Tdelta
    X1=X2
    Y1=Y2
    Vx1=Vx2
    Vy1=Vy2
    V1=V2
    theta1=theta2
    
    xRecord(i)=X2
    yRecord(i)=Y2
    
    If Y1<0
     Break
    EndIf
  Next i
  
  For i = 1 To 1000
    If yRecord(i)=0
      Break
    EndIf
  Next i
  
  ; final variables (all globals)
  xFinal=X2
  vFinal=V2
  angFinal=-1*theta2
  timeFinal=time  
  DI.f=30/Tan(angFinal/57.3)
 EndProcedure
 
 Procedure RenderFrame2()
  SetActiveWindow(#WinPath)
  ClearScreen(RGB(255, 255, 255))
  Static x, y, q
    y=tallEff-(Scale*yInit)-24.0; Position of the cannon base. Base is 24 pix below img top
    DisplaySprite(#GunImg,0,y) ; Cannon
    ;DisplaySprite(#ArrowUp,784,284) ; Green Arrow
    ;DisplaySprite(#FreighterBow,860,205) ; Shi
    DisplaySprite(#FreighterBow, 0.75*Scale*maxRange,230) ; was 235
    ZoomSprite(#FreighterBow,40,40) ; make freighter smaller
    
    xPlot=xOffset+Scale*xFinal-13
    ZoomSprite(#Splash2,30,70)
    ;DisplaySprite(#ArrowUp,xPlot+2,266)
    ;DisplaySprite(#Splash2,xPlot,188) ; the splash
    DisplaySprite(#Splash2,xPlot,190) ; the splash was 198
    ;DisplaySprite(#ArrowUp,xPlot+2,261) ;the Up Arrow
    DisplaySprite(#ArrowUp,xPlot+2,262) ; was 270
    ;Debug xPlot
    RotateSprite(#Smoke,fireTheta,#PB_Absolute) ; this is smoke
    y=tallEff-(Scale*yInit)-24-flashH
    DisplaySprite(#Smoke,xOffset,y) ; smoke
    
    ; diplay trajectory
    For i = 1 To maxIndex
      x=xOffset+Scale*xRecord(i)
      y=tallEff-(Scale*yInit)-(Scale*yRecord(i))-muzzle; plotted y coord for shell
      DisplaySprite(#Shell,x,y) ; this is the projectile
    Next i
    q=q+1
EndProcedure

Procedure AppControl()
  If EventGadget()=#ButtonRunAgain ;Run analysis again
    HyperLinkGadgetEvent()
    CloseWindow(#WinResults)
    CloseWindow(#WinPath)
    CloseWindow(#WinControl)
  ElseIf EventGadget()=#ButtonToNavalResearch
    HyperLinkGadgetEvent()
    CloseWindow(#WinResults)
    CloseWindow(#WinPath)
    CloseWindow(#WinControl)
  ElseIf EventGadget()=#ButtonToDionysus
    HyperLinkGadgetEvent()
    CloseWindow(#WinResults)
    CloseWindow(#WinPath)
    CloseWindow(#WinControl)
  ElseIf EventGadget()=#ButtonToNotes
    HyperLinkGadgetEvent()
    CloseWindow(#WinResults)
    CloseWindow(#WinPath)
    CloseWindow(#WinControl)  
  Else
    MessageRequester("Error at Line 252. Error in App Control Pnl")
  EndIf
  EndProcedure

  Procedure Gadget0()
    descript.s=GetGadgetText(#ProbDescr)
    d=GetGadgetState(#BoreIn)
    vInit=ValF(GetGadgetText(#VelIn))
    v=vInit
    w=ValF(GetGadgetText(#WtIn))
    thetaInit=GetGadgetState(#AngIn)
    yInit=GetGadgetState(#HighIn)
    DF=GetGadgetState(#DragIn) ; issue here. DF needs to be divided by 10 before proceeding.
    DF=DF/10.0 ;convert Drag Factor to unity based
    
    If w=0
      w=0.5*Pow(d,3.0)
    EndIf
    If vInit>3000.0
      vInit=3000.0
    EndIf
    If vInit<100.0
      vInit=100.0
    EndIf
    If d>21.0
      d=21.0
    EndIf
    If d<3.0
      d=3.0
    EndIf
    If thetaInit<0.2
      thetaInit=1.0
    EndIf
    If thetaInit>70.0
      thetaInit=70.0
    EndIf
    If yInit>500.0
      yInit=500.0
    EndIf
    If yInit<-50.0
      yInit=20.0
    EndIf
    If DF<0.3
      DF=1.0
    EndIf
    If DF>3.0
      DF=3.0
    EndIf
    
    If EventGadget()=#FireButton
      CloseWindow(#WinInputs)
      CloseWindow(#WinCannon)
      CloseWindow(#WinDragFac)
      CloseWindow(#WinKruppGun)
      OpenWindow(#WinResults,5, 0, 225, 380, "Air Resistance Trajectory Results", #PB_Window_SystemMenu)
      SetActiveWindow(#WinResults)
      TextGadget(#ProbInputRptTitle,5,0,150,20,descript+":")
      TextGadget(#BoretxtOut,5,30,150,20,"Gun Bore (inches) = "+StrF(d))
      TextGadget(#VelTxtOut,5,60,150,20,"Muzzle Vel (ft/sec) = "+StrF(vInit))
      TextGadget(#WtTxtOut,5,90,150,20,"Shell Weight (lbs) = "+StrF(w))
      TextGadget(#AngTxtOut,5,120,150,20,"Elevation Angle (deg) = "+StrF(thetaInit))
      TextGadget(#HighTxtOut,5,150,170,20,"Firing Platform Height (ft) = "+ StrF(yInit))
      TextGadget(#DragTxtOut,5,180,150,20,"Drag Factor in Tenths = "+StrF(10.0*DF))

      Trajectory()
      ; find the limits of range and altitude
      maxAlt=0.0
      maxRange=0.0
      maxIndex=0
      ; find maximum index describing flight
      For j = 1 To 999
        If yRecord(j)>0
          maxIndex=j
        EndIf
      Next j
          
      ; find maxAlt and maxRange values
      For j=1 To maxIndex
        If yRecord(j)>maxAlt
          maxAlt=yRecord(j)
        EndIf
        If xRecord(j)>maxRange
          maxRange=xRecord(j)
        EndIf
      Next j  
      
      temp=ExamineDesktops()
      
        wide.f=DesktopWidth(0)-240
        tall.f=DesktopHeight(0)
        tallEff=0.30*tall

        yScale=(tallEff-25)/(maxAlt+250.0) 
        xScale.f=(wide-75.0)/maxRange
       If xScale<yScale
         Scale=xScale
       Else
         Scale=yScale
       EndIf
       
      TextGadget(8,5,210,150,20,"............Results............")
      TextGadget(9,5,240,250,20,"Range (ft)="+StrF(Round(xFinal,#PB_Round_Nearest)))
      TextGadget(10,5,270,250,20,"Impact Velocity (ft/sec)="+StrF(vFinal)); verify this is correct
      TextGadget(11,5,300,250,20,"Horizontal Impact Angle (deg)="+StrF(Round(100*angFinal,#PB_Round_Nearest)/100))
      TextGadget(12,5,330,250,20,"Flight Time (sec)="+StrF(Round(10*timeFinal,#PB_Round_Nearest)/10))
      TextGadget(13,5,360,250,20,"Danger Interval (ft)="+StrF(Round(10*DI,#PB_Round_Nearest)/10))     
 
      OpenWindow(#WinPath,240,600,wide,tallEff,"Trajectory Path with Air Resistance",  #PB_Window_SystemMenu) ; was 600 tall
      OpenWindowedScreen(WindowID(#WinPath),0,0,wide,tallEff)
      
      SetActiveWindow(#WinPath)
      BindEvent(#PB_Event_RenderFrame, @RenderFrame2()) ; if I comment this, then the green background command works.
      BindEvent(#PB_Event_Loading, @Loading()) ; NECESSARY
        
        If thetaInit>39.0
          LoadSprite(#GunImg,"Mortar4.png")
          xOffset=20.0
          muzzle=21.0
          flashH=21.0
          fireTheta=0.0
        ElseIf thetaInit>28.0
          LoadSprite(#GunImg,"Mortar3.png")
          xOffset=21.0
          muzzle=19.0
          flashH=17.0
          fireTheta=16
        ElseIf thetaInit>17.0
          LoadSprite(#GunImg,"Mortar2.png")
          xOffset=23.0
          muzzle=19.0
          flashH=12.0
          fireTheta=22.0
        ElseIf thetaInit>10.0
          LoadSprite(#GunImg,"Mortar1.png")
          xOffset=24.0
          muzzle=17.0
          flashH=9.0
          fireTheta=33.0
        Else
          LoadSprite(#GunImg,"Mortar0.png")
          xOffset=24.0
          muzzle=12.0
          flashH=2.0
          fireTheta=44.0
        EndIf
        
        ;LoadSprite(0, "CoastMortar.png")
        LoadSprite(#ArrowUp, "ArrowUp.png")
        ;LoadSprite(2, "Oslyabya1.png")
        ;LoadSprite(2, "Tsar100.png")
        ;LoadSprite(2, "USCA1.png")
        ;LoadSprite(2, "Freighter125x73.png")
        LoadSprite(#FreighterBow, "FreighterBow.png")
        LoadSprite(#Smoke, "Fire4.png")
        LoadSprite(#Shell,"Shell.png")
        LoadSprite(#Splash2,"Splash2.jpg")
        ;LoadSprite(#OslyabyaTrans,"OslyabyaTrans.jpg") ; elimination of this enabled display of Freighter Bow
        
        OpenWindow(#WinMap,240,0,wide,560,"Concept Map",#PB_Window_SystemMenu)
        ;Debug wide
      If wide<1477
        LoadImage(#MapSknyImg,"SKINNYSEA.PNG")
      Else
        LoadImage(#MapSknyImg,"COASTALMAP2.PNG")
      EndIf
      
      OpenWindow(#WinControl,5,418,225,105,"Program Control:", #PB_Window_SystemMenu)
      SetActiveWindow(#WinControl)
      ButtonGadget(#ButtonRunAgain,20,5,175,20,"Run Trajectory Analysis")
      ButtonGadget(#ButtonToNavalResearch,20,30,175,20,"Goto Naval Research")
      ButtonGadget(#ButtonToDionysus,20,55,175,20,"Goto Dionysus Home Page")
      ButtonGadget(#ButtonToNotes,20,80,175,20,"Goto Instructions & Credits")
      
      UnbindEvent(#PB_Event_Gadget,@Gadget0())
      BindEvent(#PB_Event_Gadget,@AppControl())
      EndIf ; End of the fire button press  
  EndProcedure

 temp=ExamineDesktops()
  wide=DesktopWidth(0)
  tall=DesktopHeight(0)
  
 OpenWindow(#WinInputs, 0, 435, 280, 250, "Enter Firing Conditions", #PB_Window_SystemMenu, #PB_Window_ScreenCentered)
    StringGadget(#ProbDescr,8,10,140,20,"Enter Gun Description", #PB_String_LowerCase) ; input problem description
  
    TextGadget(#BoreTxtIn,10,40,200,20,"Gun Bore (max 21 in)"); input gun bore in inches
    SpinGadget(#BoreIn,200,37,70,20,3,21)
    SetGadgetState(#BoreIn,12) ; initial setting is 12 inches
    
    TextGadget(#VelTxtIn,10,68,250,20,"Muzzle Velocity (max 3000 ft/sec)")
    StringGadget(#VelIn,200,64,40,20,"2400",#PB_String_Numeric)
    
    TextGadget(#WtTxtIn,10,95,250,20,"Shell weight (lbs)")
    StringGadget(#WtIn,200,90,40,20,"850",#PB_String_Numeric)
    
    TextGadget(#AngTxtIn,10,120,200,20,"Elevation Angle (max 70 deg)")
    SpinGadget(#AngIn,200,120,70,20,1,70)
    SetGadgetState(#AngIn,20)
    
    TextGadget(#HighTxtIn,10,150,200,20,"Gun Platform Height (max 500 ft)")
    SpinGadget(#HighIn,200,150,70,20,0,501)
    SetGadgetState(#HighIn,20)
    
    TextGadget(#DragTxtIn,10,180,150,20,"Drag Factor 7 to 16 (tenths)")
    SpinGadget(#DragIn,200,180,70,20,3,25)
    SetGadgetState(#DragIn,10.0)
    
     ButtonGadget(#FireButton,55,210,100,20,"Fire", #PB_Button_Toggle)
   
     BindEvent(#PB_Event_Loading,@Loaded())
     LoadImage(#GunImg,"GunInitCondit250T.jpg")
     LoadImage(#DragTableImg,"DFTable.png")
     LoadImage(#KruppLogoImg,"KRUPPGUN1897PD.JPG")
     
     BindEvent(#PB_Event_Gadget,@Gadget0())
images:
https://www.dionysus.biz/Spider/SKINNYSEA.PNG
https://www.dionysus.biz/Spider/COASTALMAP2.PNG
https://www.dionysus.biz/Spider/DFTable.png
https://www.dionysus.biz/Spider/ArrowUp.png
https://www.dionysus.biz/Spider/Fire4.png
https://www.dionysus.biz/Spider/KRUPPGUN1897PD.JPG
https://www.dionysus.biz/Spider/Mortar0.png
https://www.dionysus.biz/Spider/Mortar1.png
https://www.dionysus.biz/Spider/Mortar2.png
https://www.dionysus.biz/Spider/Mortar3.png
https://www.dionysus.biz/Spider/Mortar4.png
https://www.dionysus.biz/Spider/Oslyabya1.png
https://www.dionysus.biz/Spider/Shell.png
https://www.dionysus.biz/Spider/Splash2.jpg
https://www.dionysus.biz/Spider/GunInitCondit250T.jpg
https://www.dionysus.biz/Spider/FreighterBow.png
Post Reply