Retro style 3D graphics

Game development specific discussions.
Post Reply
BasicCoder2
Posts: 3904
Joined: Jan 01, 2009 7:03
Location: Australia

Retro style 3D graphics

Post by BasicCoder2 »

This is a 3d scene of a desert with a cluster of bushes.
You can move about with the arrow keys.
You might like to try key [A] or key[D] to see the effect of changing one of the variables.
Note: It requires multiput.bi which I just keep in the inc file of the freebasic compiler.
The two bitmaps required are generated by the program from data statements.

multiput.bi

Code: Select all

#ifndef __MULTIPUT_BI__
#define __MULTIPUT_BI__

' Multiput by D.J.Peters (Joshy)
' MultiPut [destination],[xmidpos],[ymidpos], source,[xScale],[yScale],[Trans]

type FP16 ' fixed point 16:16
  union
  type
    as ushort l
    as  short h
  end type
  as integer v
  end union
end type

#define _ADD_ 0 ' increment a value
#define _CMP_ 1 ' compare values
#define _SET_ 2 ' set a value

#define _XScreen_  0
#define _YScreen_  1
#define _UTexture_ 2
#define _VTexture_ 3

#define _LeftIndex_    0
#define _RightIndex_   1

#define _CurrentIndex_ 0
#define _NextIndex_    1

#define _EdgeXStart_ 0
#define _EdgeUStart_ 1
#define _EdgeVStart_ 2
#define _EdgeXStep_  3
#define _EdgeUStep_  4
#define _EdgeVStep_  5

'#define UseRad 'if not then Rotate are in degrees

Sub MultiPut(Byval pTarget As Any Ptr= 0, _
             Byval xMidPos As Integer= 0, _
             Byval yMidPos As Integer= 0, _
             Byval pSource As Any Ptr   , _
             Byval xScale  As Single = 1, _
             Byval yScale  As Single = 1, _
             Byval Rotate  As Single = 0, _
             Byval Transparent As boolean = false)
  Dim As Integer SourceWidth=any,SourceHeight=any,SourceBytes=any,SourcePitch=any
  Dim as Integer TargetWidth=any,TargetHeight=any,TargetBytes=any,TargetPitch=any
  Dim As Integer i=any,yStart=any,yEnd=any,xStart=any,xEnd=any
  Dim As Integer CNS(1,1)=any 'Counters
  Dim As Integer ACS(1,2)=any '_ADD_ compare and _SET_
  Dim As Single fPoints(3,3)=any,fEdges(2,6)=any,fLength=any,fUSlope=any,fVSlope=any
  Dim As FP16 U=any,V=any,US=any,VS=any
  Dim As boolean MustRotate = iif(Rotate<>0,true,false)

  If (ScreenPtr()=0) Or (pSource=0) Then Exit Sub

  If xScale < 0.001 Then xScale=0.001
  If yScale < 0.001 Then yScale=0.001
 
  If pTarget=0 Then
    ScreenInfo     _
    TargetWidth  , _
    TargetHeight,, _
    TargetBytes  , _
    TargetPitch
    pTarget=ScreenPtr()
  Else
    ImageInfo     _
    pTarget     , _
    TargetWidth , _
    TargetHeight, _
    TargetBytes , _
    TargetPitch , _
    pTarget
  End If
  If (TargetWidth<4) Or (TargetHeight<4) Then Exit Sub

  ImageInfo     _
  pSource     , _
  SourceWidth , _
  SourceHeight, _
  SourceBytes , _
  SourcePitch , _
  pSource

  Select Case as const TargetBytes
  case 1    ' TargetPitch shr=0 : SourcePitch shr=0
  case 2    : TargetPitch shr=1 : SourcePitch shr=1
  case 4    : TargetPitch shr=2 : SourcePitch shr=2
  case else : exit sub
  end select

  fPoints(0,_XScreen_)=-SourceWidth/2 * xScale
  fPoints(1,_XScreen_)= SourceWidth/2 * xScale
  fPoints(2,_XScreen_)= fPoints(1,_XScreen_)
  fPoints(3,_XScreen_)= fPoints(0,_XScreen_)

  fPoints(0,_YScreen_)=-SourceHeight/2 * yScale
  fPoints(1,_YScreen_)= fPoints(0,_YScreen_)
  fPoints(2,_YScreen_)= SourceHeight/2 * yScale
  fPoints(3,_YScreen_)= fPoints(2,_YScreen_)

  fPoints(0,_UTexture_)=0
  fPoints(1,_UTexture_)= SourceWidth
  fPoints(2,_UTexture_)= fPoints(1,_UTexture_)
  fPoints(3,_UTexture_)=0
 
  fPoints(0,_VTexture_)=0
  fPoints(1,_VTexture_)=0
  fPoints(2,_VTexture_)= SourceHeight
  fPoints(3,_VTexture_)= fPoints(2,_VTexture_)

  If MustRotate=true Then
    #ifndef UseRad
    Rotate*=0.017453292 'deg 2 rad
    #endif
    var co = cos(rotate)
    var si = sin(rotate)
    For i=0 To 3
      var x = fPoints(i,_XScreen_)*co - fPoints(i,_YScreen_)*si
      var y = fPoints(i,_XScreen_)*si + fPoints(i,_YScreen_)*co
      fPoints(i,_XScreen_) = x
      fPoints(i,_YScreen_) = y
    Next
  End If
  yStart=30^2:yEnd=-yStart:xStart=yStart:xEnd=yEnd
 
  ' get min max
  For i=0 To 3
    fPoints(i,_XScreen_)=Int(fPoints(i,_XScreen_)+xMidPos)
    fPoints(i,_YScreen_)=Int(fPoints(i,_YScreen_)+yMidPos)
    If fPoints(i,_YScreen_)<yStart Then yStart=fPoints(i,_YScreen_):CNS(_LeftIndex_,_CurrentIndex_)=i
    If fPoints(i,_YScreen_)>yEnd   Then yEnd  =fPoints(i,_YScreen_)
    If fPoints(i,_XScreen_)<xStart Then xStart=fPoints(i,_XScreen_)
    If fPoints(i,_XScreen_)>xEnd   Then xEnd  =fPoints(i,_XScreen_)
  Next

  If yStart = yEnd        Then Exit Sub
  If xStart = xEnd        Then Exit Sub
  If yEnd   < 0           Then Exit Sub
  If xEnd   < 0           Then Exit Sub
  If yStart>=TargetHeight Then Exit Sub
  If xStart>=TargetWidth  Then Exit Sub
 
 
  ACS(_LeftIndex_ ,_ADD_)=-1:ACS(_LeftIndex_ ,_CMP_)=-1:ACS(_LeftIndex_ ,_SET_)=3
  ACS(_RightIndex_,_ADD_)= 1:ACS(_RightIndex_,_CMP_)= 4:ACS(_RightIndex_,_SET_)=0

  ' share the same highest point
  CNS(_RightIndex_,_CurrentIndex_)=CNS(_LeftIndex_,_CurrentIndex_)
 
  ' loop from Top to Bottom
  While yStart<yEnd
    'Scan Left and Right edges together
    For i=_LeftIndex_ To _RightIndex_
      ' bad to read but fast and short ;-)
      If yStart=fPoints(CNS(i,_CurrentIndex_),_YScreen_) Then
        CNS(i,_NextIndex_)=CNS(i,_CurrentIndex_)+ACS(i,_ADD_)
        If CNS(i,_NextIndex_)=ACS(i,_CMP_) Then CNS(i,_NextIndex_)=ACS(i,_SET_)
        While fPoints(CNS(i,_CurrentIndex_),_YScreen_) = fPoints(CNS(i,_NextIndex_),_YScreen_)
          CNS(i,_CurrentIndex_)=CNS(i,_NextIndex_)
          CNS(i,_NextIndex_   )=CNS(i,_CurrentIndex_)+ACS(i,_ADD_)
          If CNS(i,_NextIndex_)=ACS(i,_CMP_) Then CNS(i,_NextIndex_)=ACS(i,_SET_)
        Wend
        fEdges(i,_EdgeXStart_) = fPoints(CNS(i,_CurrentIndex_),_XScreen_)
        fEdges(i,_EdgeUStart_) = fPoints(CNS(i,_CurrentIndex_),_UTexture_)
        fEdges(i,_EdgeVStart_) = fPoints(CNS(i,_CurrentIndex_),_VTexture_)
        fLength  = fPoints(CNS(i,_NextIndex_),_YScreen_) - fPoints(CNS(i,_CurrentIndex_),_YScreen_)
        If fLength <> 0.0 Then
          fLength=1/fLength
          fEdges(i,_EdgeXStep_) = fPoints(CNS(i,_NextIndex_),_XScreen_ )-fEdges(i,_EdgeXStart_):fEdges(i,_EdgeXStep_)*=fLength
          fEdges(i,_EdgeUStep_) = fPoints(CNS(i,_NextIndex_),_UTexture_)-fEdges(i,_EdgeUStart_):fEdges(i,_EdgeUStep_)*=fLength
          fEdges(i,_EdgeVStep_) = fPoints(CNS(i,_NextIndex_),_VTexture_)-fEdges(i,_EdgeVStart_):fEdges(i,_EdgeVStep_)*=fLength
        End If
        CNS(i,_CurrentIndex_)=CNS(i,_NextIndex_)
      End If
    Next

    If (yStart<0)                                                   Then Goto NextScanLine
    xStart=fEdges(_LeftIndex_ ,_EdgeXStart_):If xStart>=TargetWidth Then Goto NextScanLine
    xEnd  =fEdges(_RightIndex_,_EdgeXStart_):If xEnd  < 0           Then Goto NextScanLine
    If (xStart=xEnd)                                                Then Goto NextScanLine
    if xEnd  <xStart                                                Then goto NextScanLine

    fLength=1/(xEnd-xStart)
    fUSlope=fEdges(_RightIndex_,_EdgeUStart_)-fEdges(_LeftIndex_,_EdgeUStart_):fUSlope*=fLength
    fVSlope=fEdges(_RightIndex_,_EdgeVStart_)-fEdges(_LeftIndex_,_EdgeVStart_):fVSlope*=fLength
    If xStart<0 Then
      fLength=-xStart
      U.v=(fEdges(_LeftIndex_,_EdgeUStart_)+fUSlope*fLength)*&HFFFF
      V.v=(fEdges(_LeftIndex_,_EdgeVStart_)+fVSlope*fLength)*&HFFFF
      xStart = 0
    Else
      U.v=fEdges(_LeftIndex_,_EdgeUStart_)*&HFFFF
      V.v=fEdges(_LeftIndex_,_EdgeVStart_)*&HFFFF
    End If
    If u.v<0 Then u.v=0
    If v.v<0 Then v.v=0
    US.v=fUSlope*&HFFFF
    VS.v=fVSlope*&HFFFF

    If xEnd>=TargetWidth Then xEnd=TargetWidth-1

    Select Case as const TargetBytes
    Case 1
      var s=cptr(ubyte ptr,pSource)
      var t=cptr(ubyte ptr,pTarget)+yStart*TargetPitch+xStart
      var e=t+(xEnd-xStart)
      If Transparent=false Then
        While t<e
          *t=*(s+V.h*SourcePitch+U.h)
          V.v+=VS.v : U.v+=US.v : t+=1
        Wend
      Else
        While t<e
          dim as ubyte c=*(s+V.h*SourcePitch+U.h)
          If c Then *t=c
          V.v+=VS.v : U.v+=US.v : t+=1
        Wend
      End If
    Case 2
      var s=cptr(ushort ptr,pSource)
      var t=cptr(ushort ptr,pTarget)+yStart*TargetPitch+xStart
      var e=t+(xEnd-xStart)
      If Transparent=false Then
        While t<e
          *t=*(s+V.h*SourcePitch+U.h)
          V.v+=VS.v : U.v+=US.v : t+=1
        Wend
      Else
        While t<e
          dim as ushort c=*(s+V.h*SourcePitch+U.h)
          If c<>&HF81F Then *t=c
          V.v+=VS.v : U.v+=US.v : t+=1
        Wend
      End If
    Case 4
      var s=cptr(ulong ptr,pSource)
      var t=cptr(ulong ptr,pTarget)+yStart*TargetPitch+xStart
      var e=t+(xEnd-xStart)
      If Transparent=false Then
        While t<e
          *t=*(s+V.h*SourcePitch+U.h)
          V.v+=VS.v : U.v+=US.v : t+=1
        Wend
      Else
        While t<e
          dim as ulong c=*(s+V.h*SourcePitch+U.h)
          If c<>&HFFFF00FF Then *t=c
          V.v+=VS.v : U.v+=US.v : t+=1
        Wend
      End If
    End Select

  NextScanLine:
    yStart+=1 : If yStart=TargetHeight Then exit while
    fEdges(_LeftIndex_ ,_EdgeXStart_)+=fEdges(_LeftIndex_ ,_EdgeXStep_)
    fEdges(_LeftIndex_ ,_EdgeUStart_)+=fEdges(_LeftIndex_ ,_EdgeUStep_)
    fEdges(_LeftIndex_ ,_EdgeVStart_)+=fEdges(_LeftIndex_ ,_EdgeVStep_)
    fEdges(_RightIndex_,_EdgeXStart_)+=fEdges(_RightIndex_,_EdgeXStep_)
    fEdges(_RightIndex_,_EdgeUStart_)+=fEdges(_RightIndex_,_EdgeUStep_)
    fEdges(_RightIndex_,_EdgeVStart_)+=fEdges(_RightIndex_,_EdgeVStep_)
  Wend
End Sub
#endif ' __MULTIPUT_BI__
Demo

Code: Select all

#include "multiput.bi"

'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As single TwoPi = 8 * Atn(1)
Dim Shared As single RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As single DtoR = Pi / 180   ' degrees * DtoR = radians

'=================================================
Screenres 640,480,32
dim shared as any ptr canvas1   '3D view
canvas1 = imagecreate(640,480,rgb(255,0,255))
'=================================================

dim shared as any ptr bush
bush = imagecreate(57,57)
'bload "bush.bmp",bush
dim as ulong colors( 5)
colors(0)=RGB(255,0,255)
colors(1)=RGB(19,102,44)
colors(2)=RGB(69,220,115)
colors(3)=RGB(32,172,74)
colors(4)=RGB(26,140,60)
dim as single n
for j as integer = 0 to  56
    for i as integer = 0 to  56
        read n
        pset bush,(i,j),colors(n)
    next i
next j

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

dim shared as any ptr sky2
sky2 = imagecreate(2160,240,rgb(153,217,234))
'bload "sky.bmp",sky
dim as single x1,y1,x2,y2

read x1,y1
for i as integer = 0 to 49
    read x2,y2
    line sky2,(x1,y1)-(x2,y2),rgb(0,0,0)
    x1 = x2
    y1 = y2
next i


put sky2,(1441,0),sky2,(0,0)-(768,240),pset

circle sky2,(52,122),27,rgb(0,0,0)
paint  sky2,(52,122),rgb(255,242,0),rgb(0,0,0)
circle sky2,(1493,122),27,rgb(0,0,0)
paint  sky2,(1493,122),rgb(255,242,0),rgb(0,0,0)

paint  sky2,(7,231),rgb(201,135,201),rgb(0,0,0) 'mountains
paint  sky2,(2,2),rgb(153,217,234),rgb(0,0,0) 'sky

'bsave "sky2.bmp",sky2
'======================================================================

dim shared as single kk
kk = 4000

Dim Shared As single distance
Dim Shared As single rAngle
Dim Shared As single dx,dy
Dim Shared As single oAngle    'observer angle
Dim shared As single ox,oy,mv  'observer position and velocity
Dim shared As single pointX,pointY  '3d position of points
Dim Shared As single range
Dim Shared As single w

type POINT2D
    as single px
    as single py
    as single dd
end type


dim shared as integer bushCount
bushCount = 299

dim shared as POINT2D pts(0 to bushCount)
dim shared as single distances(0 to bushCount)

dim as integer ii
for j as single = 0 to 14
    for i as single = 0 to 19
        pts(ii).px = int(Rnd(1)*480)
        pts(ii).py = int(Rnd(1)*480)
        ii = ii + 1
    next i
next j

'==================
'initialize observer
'==================
ox = 320
oy = 240
mv = 0
oAngle = 0 * DtoR  'angle in radians


'==========   MAIN LOOP =====================
Do


    '=========   USER INPUT =========================
    'Check arrow keys and update position accordingly
    Dim As single velocity
    mv = 0 'set velocity to zero
    If MULTIKEY(&h4B) Then oAngle = oAngle - 1 * DtoR  'angles in radians
    If MULTIKEY(&h4D) Then oAngle = oAngle + 1 * DtoR
    If oAngle > TwoPi Then oAngle = oAngle - TwoPi
    If oAngle < 0 Then oAngle = oAngle + TwoPi
    If MULTIKEY(&h48) Then mv =  1  'move forward
    If MULTIKEY(&h50) Then mv = -1  'move back
    dx = Cos(oAngle) * mv
    dy = Sin(oAngle) * mv

    ox = ox + dx
    oy = oy + dy

    '=======================================
    if multikey(&H1E) then kk = kk + 100
    if multikey(&H20) then kk = kk - 100
    '=======================================

    'draw background
    line canvas1,(0,240)-(639,479),rgb(238,187,145),bf 'desert sand
   
    range = 320   'fits 640 width -320 to +320
   
    '==============================================
    'compute distance form viewer and adjust result
    '==============================================
    dim as single angle,distance1
    distance1 = Sqr( Abs(180-ox)^2 + Abs(100-oy)^2) 'actual distance from observer
    angle = atan2(100-oy, 180-ox) 
    If angle < 0 Then angle = angle + TwoPi
    distance = distance1 * Cos(angle-oAngle)  'adjusted distance for 3D display
   
    '=============================================
    ' GET DISTANCES
    '==============================================
    for i as integer = 0 to bushCount
        pts(i).dd = Sqr( Abs(pts(i).px - ox)^2 + Abs(pts(i).py - oy)^2)
    next i
   
    '==============================================
    ' SORT POINTS
    '==============================================
   
      'sort post's properties lists according to distance
    for j as integer = 0 to bushCount
        for i as integer = 0 to bushCount-1
            if pts(i).dd < pts(i+1).dd then
                swap pts(i),pts(i+1)
            end if
        next i
    next j

    '==============================================
    ' DRAW OBJECTS AT POINT COORDINATES
    '==============================================
    locate 1,1

    dim as single pointX1,pointY1,sx,sy
   
    for i as integer = 0 to bushCount
       
        '----------------------------------------------------------------------
        sx = pts(i).px
        sy = pts(i).py
           
        distance = Sqr( Abs(sx-ox)^2 + Abs(sy-oy)^2) 'actual distance from observer
        rAngle = atan2(sy-oy, sx-ox)
        If rAngle > TwoPi Then rAngle = rAngle - TwoPi
        If rAngle < 0 Then rAngle = rAngle + TwoPi

        distance = distance * Cos(rAngle-oAngle)  'adjusted distance for 3D display
        w = range * tan(rAngle - oAngle)
           
        pointX1 = w+range            '480 is width of 3D display
        pointY1 = 240+kk/distance  '240 is half of 480
        '----------------------------------------------------------------------
       
       
        dim as single H,W,rad

        if (pointX1>0 and pointX1<640 and pointY1>240)  then

                H = (pointY1-240)*2
                W = H/9
                H = H/9
                put canvas1,(0,0),sky2,(oAngle*RtoD*4,0)-(oAngle*RtoD*4+640,240),trans
                multiput canvas1,pointX1-W,pointY1,bush,H/11,H/11,0,1

        end if

           
    next i
   
    screenlock()
   
    put (0,0),canvas1,pset    '3D view
   
    'put (0,0),sky2,(oAngle*RtoD*4,0)-(oAngle*RtoD*4+640,240),trans

    screenunlock()
   
    sleep 2
Loop While Not MULTIKEY(&h1)

End

DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,2,2,2,2,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,2,2,1,0,0,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,3,2,2,2,2,2,2,2,1,1,1,2,2,2,2,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,3,3,2,2,2,2,2,2,2,2,3,2,2,2,1,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,3,3,2,3,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,3,3,3,3,2,3,2,2,2,2,2,4,1,1,1,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,3,2,3,3,2,3,2,2,2,2,2,2,1,1,2,2,2,2,1,1,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,3,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,4,4,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,3,3,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,4,4,2,2,2,1,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,2,3,2,4,2,2,2,4,2,2,3,2,2,2,2,2,1,2,3,3,2,2,2,1,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,4,4,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,4,4,2,4,4,1,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,4,4,4,4,4,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,4,4,3,2,2,1,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,1,4,4,4,4,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,2,2,2,3,2,4,4,4,2,1,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,3,2,2,2,2,2,4,2,2,2,4,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,4,2,1,2,2,2,2,2,2,2,2,2,3,2,2,2,2,2,2,2,2,4,4,4,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,1,1,2,2,4,4,4,2,1,2,2,2,2,4,2,2,2,2,2,2,2,2,2,2,4,2,2,2,4,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,1,2,2,4,4,4,4,2,4,2,2,2,2,4,2,2,2,2,2,1,2,2,2,4,4,2,2,2,2,2,2,2,2,2,2,3,2,2,1,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,1,2,2,2,2,4,4,4,4,4,4,4,4,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,1,2,2,2,2,4,4,2,2,2,3,2,2,2,2,2,2,2,2,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,2,1,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,1,2,2,2,4,2,2,1,1,2,2,2,2,2,2,2,2,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,3,2,1,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,4,4,2,2,2,1,1,3,2,3,2,3,2,2,2,2,2,2,2,2,2,1,1,2,2,2,3,2,2,2,3,2,2,2,2,2,3,2,3,2,2,2,1,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,4,4,4,2,1,2,2,3,2,2,2,3,3,3,2,2,2,2,2,2,1,2,2,2,2,2,3,2,2,3,3,2,2,2,2,3,3,2,2,3,4,4,1,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,1,4,4,4,2,2,3,2,3,3,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,3,4,2,1,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,1,2,1,2,2,2,2,2,2,2,3,2,2,2,2,2,1,2,1,2,2,3,2,2,2,2,3,3,2,2,2,2,2,2,3,2,3,3,4,4,2,1,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,1,1,2,2,2,2,2,3,2,2,2,2,1,2,2,2,1,1,2,2,2,2,2,2,2,2,3,2,1,2,2,2,2,3,2,2,4,4,4,4,1,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,1,1,2,2,2,2,2,2,2,2,2,2,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,3,3,2,4,2,4,4,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,1,1,1,2,2,2,2,2,2,2,2,2,1,1,1,1,3,1,3,1,2,2,2,2,2,2,2,2,1,2,2,4,4,2,4,2,2,4,4,4,4,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,2,2,2,2,1,1,1,1,1,1,1,1,1,1,2,2,2,2,1,1,1,1,2,4,4,4,4,4,4,4,4,1,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,1,1,1,1,1,1,3,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,4,4,2,2,4,2,1,1,1,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,3,1,1,1,1,1,1,1,1,1,3,1,1,1,1,1,1,1,3,1,1,1,1,2,2,2,4,1,1,1,1,1,1,1,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,3,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

data 0,209,  65,209, 89,197, 109,197, 123,187, 141,198, 182,198, 197,212, 212,213, 248,184, 313,139, 325,130, 338,132
data 345,127, 355,128, 357,145, 392,159, 417,179, 443,178, 461,200, 483,200, 505,211, 524,198, 567,198, 595,195, 609,195
data 636,207, 654,208, 706,170, 718,142, 740,131, 764,113, 787,113, 809,123, 845,123, 870,143, 885,161, 921,156, 962,187
data 1006,205, 1069,217, 1085,192, 1116,176, 1165,200, 1220,200, 1244,211, 1328,211, 1346,225, 1358,216, 1391,207, 1440,209

Last edited by BasicCoder2 on Oct 24, 2019 6:52, edited 3 times in total.
Lachie Dazdarian
Posts: 2338
Joined: May 31, 2005 9:59
Location: Croatia
Contact:

Re: Retro style 3D graphics

Post by Lachie Dazdarian »

Where can I find multiput.bi?
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Retro style 3D graphics

Post by badidea »

Lachie Dazdarian wrote:Where can I find multiput.bi?
https://freebasic.net/forum/viewtopic.php?f=7&t=24479
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Retro style 3D graphics

Post by D.J.Peters »

@BasicCoder2 for simple image/sprite scaling (without rotation) I posted other faster codes also.

Joshy

viewtopic.php?f=7&t=15819[code]NewImage = ImageScale(SourceImage, Scale)[/code]Scale and Put:
Image to Screen
Screen to Image
Image to Image

part of Image [scaled] to Screen
part of Screen [scaled] to Image

part of Screen [scaled] to part of [scaled] Image
part of Image [scaled] to part of [scaled] image

viewtopic.php?f=7&t=26672[code]sub PutResize overload(byval dst as any ptr, byval src as any ptr, _
byval transparent as boolean=false, byval autoLock as boolean=false)

sub PutResize overload(byval dst as any ptr, byval src as any ptr, _
byval dstX as integer, byval dstY as integer, byval dstW as uinteger, byval dstH as uinteger, _
byval transparent as boolean=false, byval autoLock as boolean=false)

sub PutResize overload (byval dst as any ptr, _
byval dstX as integer, byval dstY as integer, byval dstW as uinteger, byval dstH as uinteger, _
byval src as any ptr, _
byval srcX as integer, byval srcY as integer, byval srcW as uinteger, byval srcH as uinteger, _
byval transparent as boolean=false, byval autoLock as boolean=false)[/code]
BasicCoder2
Posts: 3904
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Retro style 3D graphics

Post by BasicCoder2 »

D.J.Peters wrote:@BasicCoder2 for simple image/sprite scaling (without rotation) I posted other faster codes also. Joshy
Thanks for this other option Joshy I have tested it below. Now all I need to do is figure out how to stop the bushes having the shakes.

Code: Select all

'#include "multiput.bi"
#include "fbgfx.bi"
Function ImageScale(s As fb.Image Ptr, Scale as single=1.0) As fb.Image Ptr
  static As fb.Image Ptr t=0
  If s        =0 Then Return 0
  If s->width <1 Then Return 0
  If s->height<1 Then Return 0
  scale=abs(scale)
  dim as integer w = s->width *Scale
  dim as integer h = s->height*Scale
  If w<4 Then w=4
  If h<4 Then h=4
  if t then ImageDestroy(t) : t=0
  t=ImageCreate(w,h)
  Dim As Integer xs=(s->width /t->Width ) * (1024*64)
  Dim As Integer ys=(s->height/t->height) * (1024*64)
  Dim As Integer x,y,sy
  Select Case As Const s->bpp
    Case 4
      Dim As Ulong Ptr ps=cptr(Ulong Ptr,s)+8
      Dim As Uinteger     sp=(s->pitch Shr 2)
      Dim As Ulong Ptr pt=cptr(Ulong Ptr,t)+8
      Dim As Uinteger     tp=(t->pitch Shr 2)-t->width
      For ty As Integer = 0 To t->height-1
        Dim As Ulong Ptr src=ps+(sy Shr 16)*sp
        For tx As Integer = 0 To t->width-1
          *pt=src[x Shr 16]:pt+=1:x+=xs
        Next
        pt+=tp:sy+=ys:x=0
      Next
    Case 2
      Dim As Ushort Ptr ps=cptr(Ushort Ptr,s)+16
      Dim As Uinteger   sp=(s->pitch Shr 1)
      Dim As Ushort Ptr pt=cptr(Ushort Ptr,t)+16
      Dim As Uinteger   tp=(t->pitch Shr 1)-t->width
      For ty As Integer = 0 To t->height-1
        Dim As Ushort Ptr src=ps+(sy Shr 16)*sp
        For tx As Integer = 0 To t->width-1
          *pt=src[x Shr 16]:pt+=1:x+=xs
        Next
        pt+=tp:sy+=ys:x=0
      Next
    Case 1
      Dim As Ubyte Ptr ps=cptr(Ubyte Ptr,s)+32
      Dim As Uinteger   sp=s->pitch
      Dim As Ubyte Ptr pt=cptr(Ubyte Ptr,t)+32
      Dim As Uinteger   tp=t->pitch-t->width
      For ty As Integer = 0 To t->height-1
        Dim As Ubyte Ptr src=ps+(sy Shr 16)*sp
        For tx As Integer = 0 To t->width-1
          *pt=src[x Shr 16]:pt+=1:x+=xs
        Next
        pt+=tp:sy+=ys:x=0
      Next
  End Select
  Return t
End Function

'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As single TwoPi = 8 * Atn(1)
Dim Shared As single RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As single DtoR = Pi / 180   ' degrees * DtoR = radians

'=================================================
Screenres 640,480,32
dim shared as any ptr canvas1   '3D view
canvas1 = imagecreate(640,480,rgb(255,0,255))
'=================================================

dim shared as any ptr bush
bush = imagecreate(57,57)
'bload "bush.bmp",bush
dim as ulong colors( 5)
colors(0)=RGB(255,0,255)
colors(1)=RGB(19,102,44)
colors(2)=RGB(69,220,115)
colors(3)=RGB(32,172,74)
colors(4)=RGB(26,140,60)
dim as integer n
for j as integer = 0 to  56
    for i as integer = 0 to  56
        read n
        pset bush,(i,j),colors(n)
    next i
next j

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

dim shared as any ptr sky2
sky2 = imagecreate(2160,240,rgb(153,217,234))
'bload "sky.bmp",sky
dim as single x1,y1,x2,y2

read x1,y1
for i as integer = 0 to 49
    read x2,y2
    line sky2,(x1,y1)-(x2,y2),rgb(0,0,0)
    x1 = x2
    y1 = y2
next i


put sky2,(1441,0),sky2,(0,0)-(768,240),pset

circle sky2,(52,122),27,rgb(0,0,0)
paint  sky2,(52,122),rgb(255,242,0),rgb(0,0,0)
circle sky2,(1493,122),27,rgb(0,0,0)
paint  sky2,(1493,122),rgb(255,242,0),rgb(0,0,0)

paint  sky2,(7,231),rgb(201,135,201),rgb(0,0,0) 'mountains
paint  sky2,(2,2),rgb(153,217,234),rgb(0,0,0) 'sky

'bsave "sky2.bmp",sky2
'======================================================================

dim shared as single kk
kk = 4000

Dim Shared As single distance
Dim Shared As single rAngle
Dim Shared As single dx,dy
Dim Shared As single oAngle    'observer angle
Dim shared As single ox,oy,mv  'observer position and velocity
Dim shared As single pointX,pointY  '3d position of points
Dim Shared As single range
Dim Shared As single w

type POINT2D
    as single px
    as single py
    as single dd
end type


dim shared as integer bushCount
bushCount = 299

dim shared as POINT2D pts(0 to bushCount)
dim shared as single distances(0 to bushCount)

dim as integer ii
for j as single = 0 to 14
    for i as single = 0 to 19
        pts(ii).px = int(Rnd(1)*480)
        pts(ii).py = int(Rnd(1)*480)
        ii = ii + 1
    next i
next j

'==================
'initialize observer
'==================
ox = 320
oy = 240
mv = 0
oAngle = 0 * DtoR  'angle in radians


'==========   MAIN LOOP =====================
Do


    '=========   USER INPUT =========================
    'Check arrow keys and update position accordingly
    Dim As single velocity
    mv = 0 'set velocity to zero
    If MULTIKEY(&h4B) Then oAngle = oAngle - 1 * DtoR  'angles in radians
    If MULTIKEY(&h4D) Then oAngle = oAngle + 1 * DtoR
    If oAngle > TwoPi Then oAngle = oAngle - TwoPi
    If oAngle < 0 Then oAngle = oAngle + TwoPi
    If MULTIKEY(&h48) Then mv =  1  'move forward
    If MULTIKEY(&h50) Then mv = -1  'move back
    dx = Cos(oAngle) * mv
    dy = Sin(oAngle) * mv

    ox = ox + dx
    oy = oy + dy

    '=======================================
    if multikey(&H1E) then kk = kk + 100
    if multikey(&H20) then kk = kk - 100
    '=======================================

    'draw background
    line canvas1,(0,240)-(639,479),rgb(238,187,145),bf 'desert sand
    
    range = 320   'fits 640 width -320 to +320
    
    '==============================================
    'compute distance form viewer and adjust result
    '==============================================
    dim as single angle,distance1
    distance1 = Sqr( Abs(180-ox)^2 + Abs(100-oy)^2) 'actual distance from observer
    angle = atan2(100-oy, 180-ox)  
    If angle < 0 Then angle = angle + TwoPi
    distance = distance1 * Cos(angle-oAngle)  'adjusted distance for 3D display
    
    '=============================================
    ' GET DISTANCES
    '==============================================
    for i as integer = 0 to bushCount
        pts(i).dd = Sqr( Abs(pts(i).px - ox)^2 + Abs(pts(i).py - oy)^2)
    next i
    
    '==============================================
    ' SORT POINTS
    '==============================================
    
      'sort post's properties lists according to distance
    for j as integer = 0 to bushCount
        for i as integer = 0 to bushCount-1
            if pts(i).dd < pts(i+1).dd then
                swap pts(i),pts(i+1)
            end if
        next i
    next j

    '==============================================
    ' DRAW OBJECTS AT POINT COORDINATES
    '==============================================
    locate 1,1

    dim as single pointX1,pointY1,sx,sy
    
    for i as integer = 0 to bushCount
        
        '----------------------------------------------------------------------
        sx = pts(i).px
        sy = pts(i).py
            
        distance = Sqr( Abs(sx-ox)^2 + Abs(sy-oy)^2) 'actual distance from observer
        rAngle = atan2(sy-oy, sx-ox)
        If rAngle > TwoPi Then rAngle = rAngle - TwoPi
        If rAngle < 0 Then rAngle = rAngle + TwoPi

        distance = distance * Cos(rAngle-oAngle)  'adjusted distance for 3D display
        w = range * tan(rAngle - oAngle)
            
        pointX1 = w+range            '480 is width of 3D display
        pointY1 = 240+kk/distance  '240 is half of 480
        '----------------------------------------------------------------------
        
        
        dim as single H,W,rad

        if (pointX1>0 and pointX1<640 and pointY1>240)  then

                H = (pointY1-240)*2
                W = H/9
                H = H/9
                put canvas1,(0,0),sky2,(oAngle*RtoD*4,0)-(oAngle*RtoD*4+640,240),trans
                put canvas1,(pointX1,pointY1),ImageScale(bush,H/11),trans
                
                'multiput canvas1,pointX1-W,pointY1,bush,H/11,H/11,0,1

        end if

            
    next i
    
    screenlock()
    
    put (0,0),canvas1,pset    '3D view
    
    'put (0,0),sky2,(oAngle*RtoD*4,0)-(oAngle*RtoD*4+640,240),trans

    screenunlock()
    
    sleep 2
Loop While Not MULTIKEY(&h1)

End

DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,2,2,2,2,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,2,2,1,0,0,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,3,2,2,2,2,2,2,2,1,1,1,2,2,2,2,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,3,3,2,2,2,2,2,2,2,2,3,2,2,2,1,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,3,3,2,3,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,3,3,3,3,2,3,2,2,2,2,2,4,1,1,1,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,3,2,3,3,2,3,2,2,2,2,2,2,1,1,2,2,2,2,1,1,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,3,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,4,4,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,3,3,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,4,4,2,2,2,1,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,2,2,2,2,2,2,2,2,2,3,2,4,2,2,2,4,2,2,3,2,2,2,2,2,1,2,3,3,2,2,2,1,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,4,4,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,4,4,2,4,4,1,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,4,4,4,4,4,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,4,4,3,2,2,1,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,1,4,4,4,4,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,2,2,2,3,2,4,4,4,2,1,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,3,2,2,2,2,2,4,2,2,2,4,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,1,2,2,2,4,2,1,2,2,2,2,2,2,2,2,2,3,2,2,2,2,2,2,2,2,4,4,4,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,1,1,2,2,4,4,4,2,1,2,2,2,2,4,2,2,2,2,2,2,2,2,2,2,4,2,2,2,4,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,1,2,2,4,4,4,4,2,4,2,2,2,2,4,2,2,2,2,2,1,2,2,2,4,4,2,2,2,2,2,2,2,2,2,2,3,2,2,1,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,1,2,2,2,2,4,4,4,4,4,4,4,4,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,1,2,2,2,2,4,4,2,2,2,3,2,2,2,2,2,2,2,2,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,2,1,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,1,2,2,2,4,2,2,1,1,2,2,2,2,2,2,2,2,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,3,2,1,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,4,4,2,2,2,1,1,3,2,3,2,3,2,2,2,2,2,2,2,2,2,1,1,2,2,2,3,2,2,2,3,2,2,2,2,2,3,2,3,2,2,2,1,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,4,4,4,2,1,2,2,3,2,2,2,3,3,3,2,2,2,2,2,2,1,2,2,2,2,2,3,2,2,3,3,2,2,2,2,3,3,2,2,3,4,4,1,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,1,4,4,4,2,2,3,2,3,3,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,3,4,2,1,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,1,2,1,2,2,2,2,2,2,2,3,2,2,2,2,2,1,2,1,2,2,3,2,2,2,2,3,3,2,2,2,2,2,2,3,2,3,3,4,4,2,1,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,1,1,2,2,2,2,2,3,2,2,2,2,1,2,2,2,1,1,2,2,2,2,2,2,2,2,3,2,1,2,2,2,2,3,2,2,4,4,4,4,1,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,1,1,2,2,2,2,2,2,2,2,2,2,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,3,3,2,4,2,4,4,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,1,1,1,2,2,2,2,2,2,2,2,2,1,1,1,1,3,1,3,1,2,2,2,2,2,2,2,2,1,2,2,4,4,2,4,2,2,4,4,4,4,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,2,2,2,2,1,1,1,1,1,1,1,1,1,1,2,2,2,2,1,1,1,1,2,4,4,4,4,4,4,4,4,1,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,1,1,1,1,1,1,1,1,2,2,2,2,1,1,1,1,1,1,3,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,4,4,2,2,4,2,1,1,1,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,3,1,1,1,1,1,1,1,1,1,3,1,1,1,1,1,1,1,3,1,1,1,1,2,2,2,4,1,1,1,1,1,1,1,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,3,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

data 0,209,  65,209, 89,197, 109,197, 123,187, 141,198, 182,198, 197,212, 212,213, 248,184, 313,139, 325,130, 338,132
data 345,127, 355,128, 357,145, 392,159, 417,179, 443,178, 461,200, 483,200, 505,211, 524,198, 567,198, 595,195, 609,195
data 636,207, 654,208, 706,170, 718,142, 740,131, 764,113, 787,113, 809,123, 845,123, 870,143, 885,161, 921,156, 962,187
data 1006,205, 1069,217, 1085,192, 1116,176, 1165,200, 1220,200, 1244,211, 1328,211, 1346,225, 1358,216, 1391,207, 1440,209

Last edited by BasicCoder2 on Oct 15, 2018 21:01, edited 1 time in total.
dodicat
Posts: 7967
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Retro style 3D graphics

Post by dodicat »

You have W,H as single, but you integer divide
Should be
H = (pointY1-240)*2
W = H/9
H = H/9
I reckon.
BasicCoder2
Posts: 3904
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Retro style 3D graphics

Post by BasicCoder2 »

Thanks Joshy that seemed to help.
RayR
Posts: 2
Joined: May 01, 2015 17:44

Re: Retro style 3D graphics

Post by RayR »

Hey BasicCoder2 thanks for posting. I always go to your code for good examples on game programming. Please keep up the good work!
BasicCoder2
Posts: 3904
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Retro style 3D graphics

Post by BasicCoder2 »

Really? Thanks for the encouragement although at the moment I am programming hardware projects in my spare time.
I always wanted to make a complete retro game but the graphics and animations consume 90% of the time.
I had hoped to become proficient at using SDL2 so I could easily translate to C++ versions of a graphics program but it was all too hard.
I also just noticed I thanked Joshy when I should have thanked dodicat with regards the integer divide.
Thanks dodicate :)
Also forgot to add the change to the first post!!
Although there is occasionally a few posters that seem still interested in using FreeBASIC to write games there isn't really much discussion anymore.
RayR
Posts: 2
Joined: May 01, 2015 17:44

Re: Retro style 3D graphics

Post by RayR »

I hear you. I'm using Freebasic as more of a stop gap until I can learn C and C++. But learning C isn't nearly as easy as learning Freebasic. With Freebasic and the example here and around the web I can at least make some progress.
Post Reply