Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

BER Approach

Projektzusammenfassung
Projekt-Maintainer:Mitgliedgrindstone Projektseite angelegt:28.11.2016
Lizenzierung:FBPSL Letzte Bearbeitung:28.11.2016
Projektkategorie:Spiele      [Zurück zur Übersicht]

Dies ist eine erste spielbare Testversion mit nur einem Level, der sich solange spielen lässt, bis der Spieler einen gravierenden Fehler macht. Gravierende Fehler sind:
1) Crash (Kollision oder hinausschießen über die Landebahn)
2) Falscher Ausflug (Bad Exit)
3) Mehr als 1 Minute Konflikt

Bedienung

Alle Anweisungen an die Piloten werden mit der Maus erteilt.
Flugrichtung: Flugzeugsymbol anklicken. Rechte Maustaste: Drehung nach rechts, linke Maustaste: Drehung nach links. An jedem Gitterpunkt dreht das Flugzeug um 45°, maximal sind 360° in einem Durchgang möglich. Mit jeder neuen Anweisung wird die vorherige Anweisung widerrufen. Um die letzte Anweisung zu widerrufen, so daß das Flugzeug die derzeitige Richtung beibehält, Mauscursor auf das Flugzeug bewegen und beide Maustasten gleichzeitig drücken.
Flughöhe: Es gibt 5 Flugebenen von 1000 bis 5000 Fuß und eine Anweisung zum Landen. Zum Ändern der Flughöhe auf die Höhenangabe im Tag (dem Textfeld, das jedem Flugzeug folgt) klicken. Linke Maustaste: 1000 Fuß höher, rechte Maustaste: 1000 Fuß niedriger. Nach der Anweisung zum Landen läuft die Landesequenz automatisch ab, sobald das Flugzeug auf die Landebahn eingeschwenkt ist.
Geschwindigkeit: Analog zur Flughöhe kann die Fluggeschwindigkeit in Schritten von 10 Knoten geändert werden. Linke Maustaste / Mausrad nach vorne: schneller, rechte Maustaste / Mausrad nach hinten: langsamer. Jedes Flugzeug hat eine Mindest- und eine Höchstgeschwindigkeit (derzeit bei allen 120/450 Knoten)

Rechts neben dem Radarschirm befindet sich die Liste aller Flüge mit Flugnummer und Flugziel. Das Flugziel ist entweder eine der Landebahnen oder einer der Slots am Rand des Radarschirms. Die Slots müssen in einer Höhe von 5000 Fuß und im rechten Winkel angeflogen werden. Die Einflughöhe der ankommenden Flugzeuge beträgt 4000 Fuß. Die gelb gefärbten Einträge in der Liste sind die Flüge, die auf ihre Startfreigabe warten, die durch einem Linksklick auf den entsprechenden Eintrag erteilt wird.

Der Tag kann bei Bedarf durch Anklicken des Flugzeugicons mit der mittleren Maustaste verschoben werden.

Eine compilierte Version des Programms zum Ausprobieren kann Externer Link!hier heruntergeladen werden.

#Include "vbcompat.bi"

Const pi As Double = Acos(0)*2
Const NMft As Integer = 6076 '1 NM = 6076 ft

Dim Shared As ULong black = RGB(0,0,0), _
                    white = RGB(255,255,255), _
                 darkgrey = RGB(100,100,100), _
                  midgrey = RGB(128,128,128), _
                   ltgrey = RGB(200,200,200), _
                      red = RGB(255,0,0), _
                     tran = RGB(255,0,255), _
                  ltgreen = RGB(100,255,100), _
                    green = RGB(0,255,0), _
                darkgreen = RGB(0,128,0), _
                   yellow = RGB(255,255,100)

Dim Shared As Integer pauseflag, grid, NMperGrid 'grid / NMperGrid = pixel/NM
Dim Shared As Double scale 'feet/pixel
                             '1 ft = 0.3048m
                             '1 NM = 1852m = 6076 ft
                             '1 kt = 6076 ft/h = 1.69 ft/s

Enum
    _N 'standard (ltgreen)
    _NE
    _E
    _SE
    _S
    _SW
    _W
    _NW

    _Nf 'filled (ltgreen)
    _NEf
    _Ef
    _SEf
    _Sf
    _SWf
    _Wf
    _NWf

    _Nr 'highlight (red)
    _NEr
    _Er
    _SEr
    _Sr
    _SWr
    _Wr
    _NWr

    _Nfr 'highlight filled (red)
    _NEfr
    _Efr
    _SEfr
    _Sfr
    _SWfr
    _Wfr
    _NWfr

End Enum
Dim Shared As Any Ptr buffer(_NWfr) 'array of image buffer pointers


Type tPosition
    x As Double
    y As Double
End Type

Dim Shared As tPosition go(_N To _NW)

'define basic arithmetic operations for tPosition
Operator + (p1 As tPosition, p2 As tPosition) As tPosition
    Return Type<tPosition>(p1.x + p2.x, p1.y + p2.y)
End Operator

Operator - (p1 As tPosition, p2 As tPosition) As tPosition
    Return Type<tPosition>(p1.x - p2.x, p1.y - p2.y)
End Operator

Operator * (p1 As tPosition, f As Double) As tPosition
    Return Type<tPosition>(p1.x * f, p1.y * f)
End Operator

Operator / (p1 As tPosition, f As Double) As tPosition
    Return Type<tPosition>(p1.x / f, p1.y / f)
End Operator

Operator = (p1 As tPosition, p2 As tPosition) As Integer
    If (p1.x = p2.x) AndAlso (p1.y = p2.y) Then
        Return TRUE
    Else
        Return FALSE
    EndIf
End Operator

Operator <> (p1 As tPosition, p2 As tPosition) As Integer
    Return IIf(p1 = p2, FALSE, TRUE)
End Operator

Declare Function zoomText(text As String, foreground As ULong = RGB(255,255,255), background As ULong = RGB(255,0,255)) As Any Ptr
Declare Function turnImg(img As Any Ptr, d As String = "r") As Any Ptr
Declare Function fix2grid(ByRef p As tPosition) As tPosition

Type tPolar
    r As Double
    phi As Double
End Type

Enum 'runway / slot types
    _bidir = 1
    _unidir
    _slot
End Enum

Type tRunway
    runwayType As Integer
    sign As String
    Union
        beginRunway As tPosition
        slotPosition As tPosition
    End Union
    Union
        endRunway As tPosition
        exitHeading As UByte
    End Union
    timerem As Double
    Union
        bea As Integer
        signImg  As Any Ptr
    End Union

    Static As Double north
    Static As Double east
    Static As Double south
    Static As Double west

    Declare Property direction() As Double

    Declare Sub drawRunway

End Type

Static As Double tRunway.north = ATan2(-1,0)
Static As Double tRunway.east  = ATan2(0,1)
Static As Double tRunway.south = ATan2(1,0)
Static As Double tRunway.west  = ATan2(0,-1)

Property tRunway.direction() As Double
    Dim As tPosition p
    Dim As Integer sc_width, sc_height

    ScreenInfo sc_width, sc_height
    Select Case runwayType
        Case _unidir, _bidir
            p = endRunway - beginRunway
            Return ATan2(p.y, p.x)
        Case _slot
            If slotPosition.x < 10 Then 'left
                exitHeading = _W
                Return west
            ElseIf slotPosition.x > sc_height - 10 Then 'right
                exitHeading = _E
                Return east
            ElseIf slotPosition.y < 10 Then 'top
                exitHeading = _N
                Return north
            ElseIf slotPosition.y > sc_height - 10 Then 'bottom
                exitHeading = _S
                Return south
            EndIf
    End Select

End Property

Sub tRunway.drawRunway
    Dim As Integer dx, dy, w, h, f, sc_width, sc_height
    Dim As Any Ptr tmpImg

    Select Case runwayType
        Case _bidir
            w = 5
            Select Case direction
                Case north, south
                    Line (beginRunway.x - w, beginRunway.y) - (endRunway.x + w, endRunway.y), black, bf
                    Line (beginRunway.x - w, beginRunway.y) - (endRunway.x + w, endRunway.y), midgrey, b
                Case east, west
                    Line (beginRunway.x, beginRunway.y - w) - (endRunway.x, endRunway.y + w), black, bf
                    Line (beginRunway.x, beginRunway.y - w) - (endRunway.x, endRunway.y + w), midgrey, b
            End Select
            Line (beginRunway.x, beginRunway.y) - (endRunway.x, endRunway.y), midgrey, , &b0000000011111111

        Case _unidir
            w = 5
            Select Case direction
                Case north, south
                    Line (beginRunway.x - w, beginRunway.y) - (endRunway.x + w, endRunway.y), black, bf
                    Line (beginRunway.x - w, beginRunway.y) - (endRunway.x + w, endRunway.y), midgrey, b
                    Draw String (beginRunway.x + w + 3, beginRunway.y - 8), sign, midgrey
                Case east, west
                    Line (beginRunway.x, beginRunway.y - w) - (endRunway.x, endRunway.y + w), black, bf
                    Line (beginRunway.x, beginRunway.y - w) - (endRunway.x, endRunway.y + w), midgrey, b
                    Draw String (beginRunway.x, beginRunway.y + 10), sign, midgrey
            End Select
            Line (beginRunway.x, beginRunway.y) - (endRunway.x, endRunway.y), midgrey, , &b0000000011111111

            'beaconing
            If Timer > timerem Then
                timerem = Timer + .1
                bea -= 5
                If bea < 0 Then
                    bea = 60
                EndIf
            EndIf
            For x As Integer = 5 To 40 Step 5
                Dim As Integer b, bc = IIf(x = bea, yellow, midgrey)
                Select Case direction
                    Case north
                        b = beginRunway.y + x
                        PSet (beginRunway.x - 4, b), bc
                        PSet (beginRunway.x, b), bc
                        PSet (beginRunway.x + 4, b), bc
                    Case east
                        b = beginRunway.x - x
                        PSet (b, beginRunway.y - 4), bc
                        PSet (b, beginRunway.y), bc
                        PSet (b, beginRunway.y + 4), bc
                    Case south
                        b = beginRunway.y - x
                        PSet (beginRunway.x - 4, b), bc
                        PSet (beginRunway.x, b), bc
                        PSet (beginRunway.x + 4, b), bc
                    Case west
                        b = beginRunway.x + x
                        PSet (b, beginRunway.y - 4), bc
                        PSet (b, beginRunway.y), bc
                        PSet (b, beginRunway.y + 4), bc
                End Select
            Next

        Case _slot
            ScreenInfo sc_width, sc_height
            Select Case runwayType
                Case _slot
                    If signImg = 0 Then
                        signImg = zoomText(sign, ltgrey, tran)

                        If slotPosition.x < 10 Then 'left border
                            tmpImg = turnImg(signImg, "l")
                            ImageDestroy signImg
                            signImg = tmpImg
                            tmpImg = 0
                        ElseIf slotPosition.x > (sc_height - 10) Then 'right border
                            tmpImg = turnImg(signImg, "r")
                            ImageDestroy signImg
                            signImg = tmpImg
                            tmpImg = 0
                        EndIf
                    EndIf

                    ImageInfo signImg, w, h
                    If slotPosition.x < 10 Then
                        Put (slotPosition.x + 1, slotPosition.y - h / 2), signImg, Trans
                        exitHeading = _W
                    ElseIf slotPosition.x > sc_height - 10 Then
                        Put (slotPosition.x - w + 1, slotPosition.y - h / 2), signImg, Trans
                        exitHeading = _E
                    ElseIf slotPosition.y < 10 Then
                        Put (slotPosition.x - w / 2, slotPosition.y + 1), signImg, Trans
                        exitHeading = _N
                    ElseIf slotPosition.y > sc_height - 10 Then
                        Put (slotPosition.x - w / 2, slotPosition.y - h + 2), signImg, Trans
                        exitHeading = _S
                    EndIf
            End Select
    End Select
End Sub

'##########

Type tPlane
    callsign As String
    destination As String
    position As tPosition
    target As tPosition

    xdisp As Integer
    ydisp As Integer
    tagDispx As Integer
    tagDispy As Integer
    tagDispBasex As Integer = 10
    tagDispBasey As Integer = -24

    altitude As Double 'ft
    targetAltitude As Integer 'ft
    climbrate As Integer = 30 'ft/min
    descendrate As Integer = 30 'ft/min
    tagAltitude As String

    direction As Double 'as angle
    heading As Byte
    headingdisp As Byte
    turnflag As Byte
    turn As String

    speed As Double 'kt
    targetSpeed As Integer 'kt
    maxSpeed As Integer = 450 'kt  (450kt = 833 km/h)
    minspeed As Integer = 120 'kt (120kt = 222 km/h)
    approachspeed As Integer = 150 'kt (150kt = 278 km/h)
    acceleration As Integer = 5 'kt/s
    deceleration As Integer = 5 'kt/s
    tagSpeed As String

    timerem As Double
    scheduledDepartureTime As Double
    fuel As Double 'as time
    conflict As Byte
    highlight As Byte
    full As Byte
    mark As Byte
    landing As Byte
    tagMove As Byte
    runway_ As Byte
    wheelrem As Integer
    listcolor As ULong

    Static As Integer tagTop
    Static As Integer tagBottom
    Static As Integer tagLeft
    Static As Integer tagRight
    Static As Double headingAngle()
    Static As tPlane plane() 'planes array

    Declare Static Sub create(runway() As tRunway, origin As Integer = 0)
    Declare Sub operate(runway() As tRunway, mode As Integer)
    Declare Sub shiftTag()
    Declare Function checkApproach(runway As tRunway) As Integer
    Declare Static Function pol2cart(pk As tPolar) As tPosition
    Declare Static Function cart2pol(pof As tPosition = Type(0,0), pto As tPosition = Type(0,0)) As tPolar
    Declare Function mouseMenu(text As String, _
                               separator As String = "", _
                               xPos As Integer = 0, _
                               yPos As Integer = 0, _
                               foreground As ULong, _
                               background As ULong, _
                               mode As UByte = 0, _
                               buffer As Any Ptr = 0) As Integer

End Type

'dim static variables
Static As Integer tPlane.tagTop = -24
Static As Integer tPlane.tagBottom = 24
Static As Integer tPlane.tagLeft = -30
Static As Integer tPlane.tagRight = 10

ReDim As tPlane tPlane.plane(0)
ReDim As Double tPlane.headingAngle(_NW)

Function tPlane.pol2cart(pk As tPolar) As tPosition

  Return Type<tPosition>(pk.r * Cos(pk.phi), pk.r * Sin(pk.phi))

End Function

Function tPlane.cart2pol(pof As tPosition = Type(0,0), pto As tPosition = Type(0,0)) As tPolar
    Dim As tPosition p = pto - pof

    Return Type<tPolar>(Sqr(p.x * p.x + p.y * p.y), ATan2(p.y, p.x))

End Function

#Macro PrintMenuItem()

    bufferForegroundColor = foreground
    bufferBackgroundColor = background
    PrintMenuItemMain()

#EndMacro

#Macro PrintMenuItemInv()

    bufferForegroundColor = background
    bufferBackgroundColor = foreground
    PrintMenuItemMain()

#EndMacro

#Macro PrintMenuItemMain()

    Line buffer, (xPos,yPos - 1)-(xPos + Len(text) * 8, yPos + 8),bufferBackgroundColor, bf
    Draw String buffer, (xPos, yPos), text, bufferForegroundColor

    If (mode And 2) Then 'draw frame around text
        Line buffer, (xPos - 1, yPos - 2)-(xPos + 1 + Len(text) * 8, yPos + 9),bufferForegroundColor, b
    EndIf

#EndMacro

Function tPlane.mouseMenu(text As String, _
                            separator As String = "", _
                            xPos As Integer = 0, _
                            yPos As Integer = 0, _
                            foreground As ULong, _
                            background As ULong, _
                            mode As UByte = 0, _
                            buffer As Any Ptr = 0) As Integer
  'mode 0 -> highlight at touch with cursor (default)
  'mode 1 -> highlight at click
  'mode 2 -> draw a frame around the text

  Dim As Integer mx, my, wheel, buttons, separatorpos, returnValue = 0
  Dim As ULongInt bufferForegroundColor, bufferBackgroundColor
  Static As Integer xrem, yrem

  If yPos = 0 Then
    yPos = yrem
  ElseIf yPos < 0 Then
    yPos = yrem - yPos
    yPos = IIf(yPos < 0, 0, yPos)
  EndIf

  If xPos = 0 Then
    xPos = xrem
  ElseIf xPos < 0 Then
    xPos = xrem - xPos
    xPos = IIf(xPos < 0, 0, xPos)
  EndIf

  'adjust text position
  If separator = "" Then
    separatorpos = Len(text) * 8
  Else
    separatorpos = (InStr(text,separator) - 1) * 8
    xPos = xPos - separatorpos + 8 'position text at separator
  EndIf

  xrem = xPos
  yrem = yPos

    GetMouse (mx,my,wheel,buttons)

  Select Case (mode And 1)
    Case 0 'highlight at touch
        If (mx >= xpos) AndAlso (mx <= xpos + Len(text) * 8) AndAlso _
             (my >= yPos) AndAlso (my <= ypos + 8) Then 'mouse cursor touches the text
            returnValue Or= 8
            PrintMenuItemInv() 'highlight menu item
            If buttons Then 'mouse button pressed
                returnValue Or= buttons
                Do 'wait for release of the mouse button
                    GetMouse (mx,my,wheel,buttons)
                    Sleep 1
                Loop While buttons
            EndIf
            Return returnValue
        EndIf
    Case 1 'highlight at click
        If buttons Then 'mouse button pressed
            returnValue Or= buttons
            If (mx >= xpos) AndAlso (mx <= xpos + Len(text) * 8) AndAlso _
             (my >= yPos) AndAlso (my <= ypos + 8) Then 'mouse cursor touches the text
                returnValue Or= 8
                PrintMenuItemInv() 'highlight menu item
                Do 'wait for release of the mouse button
                    GetMouse (mx,my,wheel,buttons)
                    Sleep 1
                Loop While buttons
                Return returnValue
            EndIf
        EndIf
  End Select

  PrintMenuItem()

End Function

Sub tPlane.create(runway() As tRunway, origin As Integer = 0)
    Dim As Integer x, rwmax, pl, rw, dst, w, h
    Dim As String cs(0 To ...) = {"DA","LH","GW","AF","AA"}

    pl = UBound(plane) + 1
    ReDim Preserve plane(pl)
    rwmax = UBound(runway)

    If origin Then
        rw = origin
    Else
        rw = Int(Rnd * rwmax) + 1
    EndIf

    With plane(pl)
        Do
            .callsign = cs(Int(Rnd * UBound(cs))) + Str(Int(Rnd * 899) + 100)
            For x = 1 To UBound(plane)
                If x = pl Then
                    Continue For
                Else
                    If plane(x).callsign = .callsign Then
                        Continue Do
                    EndIf
                EndIf
            Next
            Exit Do
        Loop

        .timerem = Timer
        Select Case runway(rw).runwayType
            Case _unidir, _bidir
                .position = runway(rw).beginRunway
                .xdisp = .position.x
                .ydisp = .position.y
                .target = fix2grid(.position + .pol2cart(Type<tPolar>(grid, runway(rw).direction)))
                .speed = 0
                .targetspeed = 0
                .targetaltitude = 0
                .altitude = 0
                .landing = -1

            Case _slot
                .position = runway(rw).slotPosition
                .xdisp = .position.x
                .ydisp = .position.y
                .target = fix2grid(.position + .pol2cart(Type<tPolar>(grid, runway(rw).direction + pi)))
                .speed = 450
                .targetspeed = 450
                .targetaltitude = 4000
                .altitude = 4000
                .landing = 0
                .tagDispx = .tagDispBasex + .xdisp
                .tagDispy = .tagDispBasey + .ydisp

        End Select

        .scheduledDepartureTime = DateAdd("n",2,Now)

        Do
            dst = Int(Rnd * rwmax) + 1
        Loop While dst = rw
        .destination = runway(dst).sign

    End With

End Sub


Sub tPlane.operate(runway() As tRunway, mode As Integer)
    Dim As Integer w, h, selBuffer, mx, my, wheel, buttons, x, index, chk, chk2, _
                   rw, chkApp, sc_width, sc_height
    Dim As ULong tagColor
    Dim As String chk3
    Dim As Double timediff, angle, runwayDirection, distance
    Dim As tPolar pol
    Dim As tPosition p

    timediff = Timer - timerem
    timerem = Timer

    If pauseflag Then
        Return
    EndIf

    index =  (Cast(UInteger,@This) - Cast(UInteger,@tPlane.plane(0))) / SizeOf(tPlane) 'calculate the own index into the plane array
    '                         |                        |_pointer to the beginning of the plane array
    '                         |__________________________pointer to the actual plane

    ScreenInfo sc_width, sc_height

    '1 ft = 0,3048m
    '1 NM = 1852m = 6076 ft
    '1 kt = 6076 ft/h = 1,69 ft/s
    'scale = 6076 / grid 'ft/px
    'diff distance[ft] = speed[kt] * 1,69 ft/sec * timediff[s]
    'diff distance[px] = (speed[kt] * 1,69 ft/sec * timediff[s]) / scale[ft/px]

    pol = cart2pol(position, target) 'get the angle
    pol.r = (speed * 1.69 * timediff) / scale
    position += pol2cart(pol) 'new position of the plane
    direction = pol.phi

    Select Case direction 'set heading
        Case headingAngle(_N) - pi/8 To headingAngle(_N) + pi/8
            heading = _N
        Case headingAngle(_NE) - pi/8 To headingAngle(_NE) + pi/8
            heading = _NE
        Case headingAngle(_E) - pi/8 To headingAngle(_E) + pi/8
            heading = _E
        Case headingAngle(_SE) - pi/8 To headingAngle(_SE) + pi/8
            heading = _SE
        Case headingAngle(_S) - pi/8 To headingAngle(_S) + pi/8
            heading = _S
        Case headingAngle(_SW) - pi/8 To headingAngle(_SW) + pi/8
            heading = _SW
        Case headingAngle(_W) - pi/8 To headingAngle(_W) + pi/8
            heading = _W
        Case headingAngle(_NW) - pi/8 To headingAngle(_NW) + pi/8
            heading = _NW
    End Select

    'chkApp * scale / NMft --> distance in NM
    'chkApp * scale        --> distance in ft

    chkApp = checkApproach(runway(runway_))

    If (landing = -1) Then 'scheduled but not launched, not visible
        ImageInfo buffer(heading), w, h
        xdisp = position.x - w / 2
        ydisp = position.y - h / 2
        headingdisp = heading
        Exit Sub

    'takeoff procedure
    ElseIf (landing = -2) Then 'cleared for takeoff
        targetspeed = 250
        landing = -3 'accelerating, still on the ground
    ElseIf (landing = -3) And (speed >= approachspeed) Then 'takeoff
        targetaltitude = 1000
        landing = 0 'flying

    'landing procedure
    ElseIf (landing = 6) AndAlso (altitude = 0) AndAlso (speed < 15) Then
        If runway(runway_).sign = destination Then
            landing = 7 'phase 6 --> remove
        Else 'wrong landing --> replace to schedule
            position = runway(runway_).beginRunway
            target = fix2grid(position + pol2cart(Type<tPolar>(grid, runway(runway_).direction)))
            landing = 8
        EndIf
    ElseIf (landing = 5) AndAlso (altitude = 0) Then
        targetspeed = 0
        landing = 6 'phase 5 --> touchdown
    ElseIf (landing = 4) AndAlso _
             (chkApp = -2) AndAlso _
             (speed <= approachspeed) AndAlso _
             (altitude <= 100) Then
        targetaltitude = 0
        landing = 5 'phase 4 --> crossing runway threshold
    ElseIf (landing = 3) AndAlso (chkApp > 0) AndAlso ((chkApp * scale / NMft) < 1.5) Then
        targetspeed = IIf(targetspeed > approachspeed, approachspeed, targetspeed)
        landing = 4 'phase 3 --> closer than 1.5 NM
    ElseIf (landing = 2) AndAlso (chkApp > 0) AndAlso ((chkApp * scale / NMft) < 5) Then
        targetspeed = IIf(targetspeed > 250, 250, targetspeed)
        landing = 3 'phase 2 --> closer than 5 NM
    ElseIf landing = 1 Then 'cleared for landing --> get runway heading to
        For rw = 1 To UBound(runway)
            chkApp = checkApproach(runway(rw))
            If (chkApp > 0) AndAlso (turn = "") Then 'heading to runway
                landing = 2 'phase 1 --> heading to the runway
                runway_ = rw 'store runway
                Exit For
            EndIf
        Next
    ElseIf landing = 0 Then
        runway_ = 0
    EndIf

    Select Case landing
        Case 3, 4 'glide slope
            If (chkApp > 0) And (targetaltitude > (chkApp * scale / 20)) Then
                targetaltitude = (chkApp * scale / 20)
                targetaltitude = IIf(targetaltitude < 100, 100, targetaltitude)
            EndIf
    End Select

    'calculate altitude
    If Abs(altitude - targetaltitude) < 1 Then
        altitude = targetaltitude
    ElseIf (altitude < targetaltitude) And (speed >= approachspeed) Then
        altitude += timediff * climbrate
    ElseIf altitude > targetaltitude Then
        altitude -= timediff * IIf(landing < 5, descendrate, 5)
    EndIf

    'calculate speed
    If Abs(speed - targetspeed) < 1 Then
        speed = targetspeed
    ElseIf speed < targetspeed Then
        speed += timediff * acceleration
    ElseIf speed > targetspeed Then
        speed -= timediff * deceleration
    EndIf

    'check for conflict
    conflict = BitReset(conflict, 0)
    For x = 1 To UBound(plane)
        If (x = index) OrElse (plane(x).landing = -1) Then
            Continue For 'skip if own index or plane on schedule
        EndIf
        distance = cart2pol(plane(x).position, plane(index).position).r
        If distance < 2 * (grid  / NMperGrid) And _ 'less than 2 NM
             Abs(plane(x).altitude - plane(index).altitude) < 1000 Then
            conflict = BitSet(conflict, 0)
            If distance < (150 / scale) AndAlso Abs(plane(x).altitude - plane(index).altitude) < 50 Then
                conflict = BitSet(conflict, 1) 'crash
                plane(x).conflict = BitSet(plane(x).conflict, 1)
            EndIf
        EndIf
    Next
    chk3 = Str(landing) + " " + Str(chkApp)
    If (landing > 4) And (chkApp = -1) Then
        conflict = BitSet(conflict, 0)
        If (landing > 5) Then
            conflict = BitSet(conflict, 1) 'crash
        EndIf
    EndIf

    'arriving target position
    If cart2pol(target, position).r < .5 Then
        position = target 'correct misalignment
        Select Case Left(turn, 1)
            Case "r" 'turn right
                heading += 1
                If heading > _NW Then
                    heading = _N
                EndIf
                turn = Mid(turn, 2)
            Case "l" 'turn left
                heading -= 1
                If heading < _N Then
                    heading = _NW
                EndIf
                turn = Mid(turn, 2)
        End Select

        target += go(heading) 'set next grid point in heading direction as new target
    EndIf

    'bad exit warning
    If ((target.x = 0) And (heading = _W)) OrElse _
       ((target.x = Int(sc_height / grid  + .5) * grid) And (heading = _E)) OrElse _
         ((target.y = 0) And (heading = _N)) OrElse _
         ((target.y = Int(sc_height / grid  + .5) * grid) And (heading = _S)) Then
        conflict = BitSet(conflict, 0)
        For x As Integer = 1 To UBound(runway)
            If runway(x).runwayType <> _slot Then
                Continue For
            EndIf
            If (target = runway(x).slotPosition) And (runway(x).sign = destination) Then
                conflict = BitReset(conflict, 0)
                Exit For
            EndIf
        Next

        If (altitude <> 5000) Then
            conflict = BitSet(conflict, 0)
        EndIf
    EndIf

    'check for exit
    Do
        If (target.x < 0) OrElse (target.x > sc_height) OrElse _
             (target.y < 0) OrElse (target.y > sc_height) Then 'new target is outside the screen
            landing = 17 ' bad exit
            'If altitude <> 5000 Then 'bad exit
            '   Exit Do
            'EndIf
            For x = 1 To UBound(runway)
                With runway(x)
                    If (.runwayType = _slot) AndAlso _
                         (position = .slotPosition) AndAlso _
                       (heading = .exitHeading) AndAlso _
                         (destination = .sign) AndAlso _
                         (altitude = 5000) Then
                        landing = 16  'correct exit
                        Exit Do
                    EndIf
                End With
            Next
        EndIf
    Loop Until -1

    ImageInfo buffer(heading), w, h

    If mode And (Bit(turnflag, 0) = 0) Then 'update radar display
        xdisp = position.x - w / 2
        ydisp = position.y - h / 2
        'keep tag inside the radar display area
        If xdisp < 40 Then 'left border
            tagDispBasex = tagRight
        ElseIf xdisp > sc_height - 70 Then 'right border
            tagDispBasex = tagLeft
        EndIf
        If ydisp < 30 Then 'top border
            tagDispBasey = tagBottom
        ElseIf ydisp > sc_height - 50 Then 'bottom border
            tagDispBasey = tagTop
        EndIf
        headingdisp = heading
    EndIf

    selbuffer = headingdisp 'choose the correct plane icon

    GetMouse (mx,my,wheel,buttons)

    If (Abs(position.x - mx) < 10) AndAlso _
         (Abs(position.y - my) < 10) Then 'mouse cursor is touching the plane icon
        selbuffer Or= 8 'filled
    EndIf

    If highlight Then
        selbuffer Or= 8 'filled
    EndIf

    If mark Or conflict Then
        selbuffer Or= 16 'red
    EndIf

    If conflict And (Frac(Timer) > .5) Then 'flashing icon
        selbuffer Or= 8 'filled
    EndIf

    'draw plane icon
    If turnflag Then
        If Left(turn,1) = "l" Then
            Put (xdisp, ydisp), buffer(((heading - Len(turn)) And 7) + 8 + IIf(mark, 16, 0)), Trans
        ElseIf Left(turn,1) = "r" Then '"r"
            Put (xdisp, ydisp), buffer(((heading + Len(turn)) And 7) + 8 + IIf(mark, 16, 0)), Trans
        Else
            Put (xdisp, ydisp), buffer(selbuffer), Trans
        EndIf
    Else
        Put (xdisp, ydisp), buffer(selbuffer), Trans
    EndIf

    'draw tag
    listcolor = ltgreen
    If tagMove = 0 Then
        tagDispx = tagDispBasex + xdisp
        tagDispy = tagDispBasey + ydisp
    Else
        listcolor = white
    EndIf

    If Bit(selbuffer, 3) Then 'cursor touching plane icon
        listcolor = white
    EndIf

    If conflict And (Frac(Timer) > .5) Then 'flashing tag / list
        listcolor = red
        tagColor = red
    Else
        tagColor = ltgreen 'no conflict
    EndIf

    Select Case mouseMenu(callsign,, tagDispx, tagDispy, tagColor, black)
        Case 9
            mark = IIf(mark, 0, 1)
    End Select

    'altitude
    Select Case mouseMenu(tagAltitude,, 0, -8, tagColor, black)
        Case 0 'display actual altitude
            tagAltitude = Str(Int(altitude)) + " ft"
            tagMove And= (255 - 1)
        Case 8 'mousecursor touches item --> display target altitude
            If landing Then
                tagAltitude = "LANDIG "
            Else
                tagAltitude = Str(targetaltitude) + " ft"
            EndIf
            tagMove Or= 1
        Case 9 'left button --> increase target altitude
            If targetaltitude < 5000 Then
                targetaltitude += 1000
            EndIf
            landing = 0
            tagMove Or= 1
        Case 10 'right button --> decrease target altitude
            If targetaltitude > 1000 Then
                targetaltitude -= 1000
            Else
                landing = 1
            EndIf
            tagMove Or= 1
    End Select

    'speed
    Select Case mouseMenu(tagSpeed + " kt",, 0, -8, tagColor, black)
        Case 0
            tagSpeed = Str(Int(speed))
            wheelrem = wheel
            tagMove And= (255 - 2)
        Case 8
            tagSpeed = Str(targetspeed)
            If wheel > wheelrem Then 'change target speed by mousewheel
                If targetspeed < maxspeed Then
                    targetspeed += 10
                EndIf
                wheelrem = wheel
            ElseIf wheel < wheelrem Then
                If targetspeed > minspeed Then
                    targetspeed -= 10
                EndIf
                wheelrem = wheel
            EndIf
            tagMove Or= 2
        Case 9
            If targetspeed < maxspeed Then
                targetspeed += 10
            EndIf
            tagMove Or= 2
        Case 10
            If targetspeed > minspeed Then
                targetspeed -= 10
            EndIf
            tagMove Or= 2
    End Select

    GetMouse (mx,my,wheel,buttons)

    'turning
    If (Abs(xdisp - mx + w/2) < 10) AndAlso (Abs(ydisp - my + h/2) < 10) Then 'mousecursor touches the plane
        'turnflag Or= 2 'commented out --> new direction isn't displayed when cursor touches icon
        If buttons Then
            If (Bit(turnflag, 0) = 0) And (Bit(buttons, 2) = 0) Then 'no mid button
                turn = ""
            EndIf
            turnflag Or= 1
            If (buttons = 1) And (InStr(turn, "r") = 0) And (Len(turn) <= 7) Then 'left button
                turn += "l"
                Do
                    GetMouse (mx,my,wheel,buttons)
                    If buttons = 3 Then
                        turn = ""
                        Do
                            GetMouse (mx,my,wheel,buttons)
                            If buttons = 0 Then
                                Exit Do
                            EndIf
                            Sleep 1
                        Loop
                    EndIf
                    Sleep 1
                Loop While buttons
            ElseIf buttons = 2 And (InStr(turn, "l") = 0) And (Len(turn) <= 7) Then 'right button
                turn += "r"
                Do
                    GetMouse (mx,my,wheel,buttons)
                    If buttons = 3 Then
                        turn = ""
                        Do
                            GetMouse (mx,my,wheel,buttons)
                            If buttons = 0 Then
                                Exit Do
                            EndIf
                            Sleep 1
                        Loop
                    EndIf
                    Sleep 1
                Loop While buttons
            ElseIf buttons = 4 Then 'mid mutton --> move tag
                If (tagDispBasex = tagRight) And (tagDispBasey = tagTop) Then 'top right
                    tagDispBasey = tagBottom
                ElseIf (tagDispBasex = tagRight) And (tagDispBasey = tagBottom) Then 'bottom right
                    tagDispBasex = tagLeft
                ElseIf (tagDispBasex = tagLeft) And (tagDispBasey = tagBottom) Then 'bottom left
                    tagDispBasey = tagTop
                Else 'set to top right
                    tagDispBasex = tagRight
                    tagDispBasey = tagTop
                EndIf
                Do
                    GetMouse (mx,my,wheel,buttons)
                Loop While buttons
            EndIf
        EndIf
    Else
        turnflag = 0
    EndIf

End Sub

Function tPlane.checkApproach(runway As tRunway) As Integer
    Dim As tPosition p2
    Dim As Double oppdirection

    With runway
        Select Case .runwayType
            Case _bidir
                p2 = .beginRunway - .endRunway
                oppdirection = ATan2(p2.y, p2.x)
                If (Abs(.direction - direction) < .001) AndAlso _
                   (Abs(cart2pol(position, .beginRunway).phi - direction) < .001) Then
                    Return cart2pol(position, runway.beginRunway).r 'distance to runway threshold
                ElseIf (Abs(oppdirection - direction) < .001) AndAlso _
                       (Abs(cart2pol(position, .endRunway).phi - direction) < .001) Then
                    Return cart2pol(position, runway.endRunway).r 'distance to runway threshold
                Else
                    If (Abs(cart2pol(.beginRunway, position).phi - .direction) < .001) And _
                         (Abs(cart2pol(position, .endRunway).phi - .direction) < .001) Then
                        Return -2 'plane above the runway
                    Else
                        Return -1 'no approach
                    EndIf
                EndIf
            Case _unidir
                If (Abs(.direction - direction) < .001) AndAlso _
                   (Abs(cart2pol(position, .beginRunway).phi - direction) < .001) Then
                    Return cart2pol(position, runway.beginRunway).r 'distance to runway threshold
                Else
                    If (Abs(cart2pol(.beginRunway, position).phi - .direction) < .001) And _
                         (Abs(cart2pol(position, .endRunway).phi - .direction) < .001) And _
                         (Abs(direction - .direction) < .001) Then
                        Return -2 'plane correct above the runway
                    Else
                        Return -1 'no approach
                    EndIf
                EndIf
        End Select
    End With

End Function


'####################################################################

Dim As Integer sc_width, sc_height, x, y, z, p, w, h, w2, h2, bpp, crashes, badExits, _
               globalConflict, update, flightsDone
Dim As Integer mx, my, buttons, wheel
Dim As String g
Dim As Double startTime, conflictTime, timenew, timepause, timeupd, timerem = Timer
Dim As tPosition scalePos

ReDim As tRunway runway(0)

Randomize Timer

grid = 50 'pixels
ScreenRes Int(900 / grid) * grid + 100, Int(900 / grid) * grid + 1, 32, 2
ScreenSet 1,0
ScreenInfo sc_width, sc_height

'calculate grid routes
go(_N) = Type<tPosition>(0,-grid)
go(_NE) = Type<tPosition>(grid,-grid)
go(_E) = Type<tPosition>(grid,0)
go(_SE) = Type<tPosition>(grid,grid)
go(_S) = Type<tPosition>(0,grid)
go(_SW) = Type<tPosition>(-grid,grid)
go(_W) = Type<tPosition>(-grid,0)
go(_NW) = Type<tPosition>(-grid,-grid)

'calculate target heading angles
tPlane.headingAngle(_N)  = tPlane.cart2pol(,Type<tPosition>(0,-1)).phi
tPlane.headingAngle(_NE) = tPlane.cart2pol(,Type<tPosition>(1,-1)).phi
tPlane.headingAngle(_E)  = tPlane.cart2pol(,Type<tPosition>(1,0)).phi
tPlane.headingAngle(_SE) = tPlane.cart2pol(,Type<tPosition>(1,1)).phi
tPlane.headingAngle(_S)  = tPlane.cart2pol(,Type<tPosition>(0,1)).phi
tPlane.headingAngle(_SW) = tPlane.cart2pol(,Type<tPosition>(-1,1)).phi
tPlane.headingAngle(_W)  = tPlane.cart2pol(,Type<tPosition>(-1,0)).phi
tPlane.headingAngle(_NW) = tPlane.cart2pol(,Type<tPosition>(-1,-1)).phi

'create plane icon images
w = 20
h = 20

'outline straight
buffer(_N) = ImageCreate(w, h, tran)
buffer(_Nr) = ImageCreate(w, h, tran)
Restore p1 'outline straight
For y = 0 To h - 1
    Read g
    For x = 0 To Len(g) - 1
        If g[x] = Asc("x") Then
            PSet buffer(_N), (x, y), ltgreen
            PSet buffer(_Nr), (x, y), red
        EndIf
    Next
Next
buffer(_E) = turnImg(buffer(_N))
buffer(_S) = turnImg(buffer(_E))
buffer(_W) = turnImg(buffer(_S))
buffer(_Er) = turnImg(buffer(_Nr))
buffer(_Sr) = turnImg(buffer(_Er))
buffer(_Wr) = turnImg(buffer(_Sr))

'outline diagonal
buffer(_NE) = ImageCreate(w, h, tran)
buffer(_NEr) = ImageCreate(w, h, tran)
Restore p2 'outline diagonal
For y = 0 To h - 1
    Read g
    For x = 0 To Len(g) - 1
        If g[x] = Asc("x") Then
            PSet buffer(_NE), (x, y), ltgreen
            PSet buffer(_NEr), (x, y), red
        EndIf
    Next
Next
buffer(_SE) = turnImg(buffer(_NE))
buffer(_SW) = turnImg(buffer(_SE))
buffer(_NW) = turnImg(buffer(_SW))
buffer(_SEr) = turnImg(buffer(_NEr))
buffer(_SWr) = turnImg(buffer(_SEr))
buffer(_NWr) = turnImg(buffer(_SWr))

'filled straight
buffer(_Nf) = ImageCreate(w, h, tran)
buffer(_Nfr) = ImageCreate(w, h, tran)
Restore p1f 'filled straight
For y = 0 To h - 1
    Read g
    For x = 0 To Len(g) - 1
        If g[x] = Asc("x") Then
            PSet buffer(_Nf), (x, y), ltgreen
            PSet buffer(_Nfr), (x, y), red
        EndIf
    Next
Next
buffer(_Ef) = turnImg(buffer(_Nf))
buffer(_Sf) = turnImg(buffer(_Ef))
buffer(_Wf) = turnImg(buffer(_Sf))
buffer(_Efr) = turnImg(buffer(_Nfr))
buffer(_Sfr) = turnImg(buffer(_Efr))
buffer(_Wfr) = turnImg(buffer(_Sfr))

'filled diagonal
buffer(_NEf) = ImageCreate(w, h, tran)
buffer(_NEfr) = ImageCreate(w, h, tran)
Restore p2f 'filled diagonal
For y = 0 To h - 1
    Read g
    For x = 0 To Len(g) - 1
        If g[x] = Asc("x") Then
            PSet buffer(_NEf), (x, y), ltgreen
            PSet buffer(_NEfr), (x, y), red
        EndIf
    Next
Next
buffer(_SEf) = turnImg(buffer(_NEf))
buffer(_SWf) = turnImg(buffer(_SEf))
buffer(_NWf) = turnImg(buffer(_SWf))
buffer(_SEfr) = turnImg(buffer(_NEfr))
buffer(_SWfr) = turnImg(buffer(_SEfr))
buffer(_NWfr) = turnImg(buffer(_SWfr))

'##### LEVEL SETUP #####

NMperGrid = 3 'NM per grid point
scale = NMperGrid * NMft / grid 'ft/px

'set runway(s) and slots
ReDim runway(6)
With runway(1)
    .runwayType = _unidir
    .beginRunway = fix2grid(Type<tPosition>(300,400))
    .endRunway = .beginRunway + tPlane.pol2cart(Type<tPolar>(3 * (grid / NMperGrid), tPlane.headingAngle(_N)))
    '                                                        |____runway length in NM
    .sign = "BER"
End With

With runway(2)
    .runwayType = _unidir
    .beginRunway = fix2grid(Type<tPosition>(500,300))
    .endRunway = .beginRunway + tPlane.pol2cart(Type<tPolar>(3 * (grid / NMperGrid), tPlane.headingAngle(_E)))
    .sign = "TXL"
End With

With runway(3)
    .runwayType = _slot
    .slotPosition = Type<tPosition>(0, grid * 4)
    .sign = "FRA"
End With

With runway(4)
    .runwayType = _slot
    .slotPosition = Type<tPosition>(grid * 8, 0)
    .sign = "HAM"
End With

With runway(5)
    .runwayType = _slot
    .slotPosition = fix2grid(Type<tPosition>(sc_height, grid * 8))
    .sign = "WAW"
End With

With runway(6)
    .runwayType = _slot
    .slotPosition = fix2grid(Type<tPosition>(grid*5, sc_height))
    .sign = "MUC"
End With

'set planes
ReDim Preserve tPlane.plane(0)
For x = 1 To 3
    tPlane.create(runway(),1)
    tPlane.create(runway(),2)
Next


'##### MAIN LOOP #####

scalePos = fix2grid(Type<tPosition>(grid, sc_height))
scalePos = Type<tPosition>(scalePos.x - 10, scalePos.y)
startTime = Now

Do
    If pauseflag Then
        timenew = Timer + timepause
    EndIf

    If Timer > timenew Then 'new plane
        tPlane.create(runway())
        timenew = Timer + 60
    EndIf

    Line (0, 0) - (sc_width - 1, sc_height - 1), black, bf 'clear screen

    Line (sc_height - 1, 0) - (sc_height + 4, sc_height - 1), midgrey, bf 'right radar screen border

    'draw grid
    For x = 0 To sc_height - 1 Step grid
        For y = 0 To sc_height - 1 Step grid
            PSet (x, y), white
        Next
    Next

    'draw scale
    Line (scalePos.x - 1, scalePos.y - grid) - (scalePos.x + 1, scalePos.y - 2*grid), ltgrey, bf
    Line (scalePos.x - 4, scalePos.y - grid) - (scalePos.x + 4, scalePos.y - grid - 1), ltgrey, bf
    Line (scalePos.x - 4, scalePos.y - 2*grid) - (scalePos.x + 4, scalePos.y - 2*grid + 1), ltgrey, bf
    Draw String (scalePos.x + 5, scalePos.y - 1.5 * grid - 4), Str(NMperGrid) + " NM", ltgrey

    'draw runway(s) and slots
    For x = 1 To UBound(runway)
        runway(x).drawRunway
    Next

    If Timer > timeupd Then
        update = 1
        timeupd = Timer + 2
    Else
        update = 0
    EndIf

    'draw schedule / list
    tPlane.plane(0).mouseMenu("CALL  DST",,sc_height + 15, 10, white, black, 1)
    tPlane.plane(0).mouseMenu("",,0, -10, white, black, 1)
    For p = 1 To UBound(tPlane.plane)
        With tPlane.plane(p)
            If .landing = -1 Then
                Select Case .mouseMenu(.callsign + " " + .destination,, 0, -10, yellow, black)
                    Case 8
                        Circle (.position.x, .position.y), 5, ltgreen,,,,f
                    Case 9
                        .landing = -2
                End Select
            EndIf
        End With
    Next

    tPlane.plane(0).mouseMenu("---------",,0, -10, white, black, 1)
    For p = 1 To UBound(tPlane.plane)
        With tPlane.plane(p)
            If .landing <> -1 Then
                .mouseMenu(.callsign + " " + .destination,, 0, -10, .listcolor, black, 1)
            EndIf
        End With
    Next

    If tPlane.plane(0).mouseMenu("PAUSE",,sc_height + 30, sc_height - 20, white, black) = 9 Then
        pauseflag = IIf(pauseflag, 0, 1)
        timepause = timenew - Timer
    EndIf

    For p = 1 To UBound(tPlane.plane)
        With tPlane.plane(p)
            .operate(runway(), update)
        End With
    Next

    'conflict
    For p = 1 To UBound(tPlane.plane)
        With tPlane.plane(p)
            If Bit(.conflict, 0) Then
                conflictTime += (Timer - timerem)
                If conflictTime > 60 Then
                    Put (300,300),zoomText(Str(Int(conflictTime)) + " SECONDS OF CONFLICT"), Trans
                    Exit Do
                EndIf
                Exit For
            EndIf
        End With
    Next
    timerem = Timer

    'delete exited/landed/crashed planes
    x = UBound(tPlane.plane)
    For p = 1 To x
        With tPlane.plane(p)
            If Bit(.conflict, 1) Then 'plane crashed
                Put (300,300),zoomText("YOU CAUSED A CRASH"), Trans
                Exit Do
                crashes += 1
                .landing  = 7 'to delete plane
            EndIf

            If (.landing = 16) Then 'correct exit
                .landing  = 7
            ElseIf (.landing = 17) Then 'bad exit
                Put (300,300),zoomText(.callsign + " BAD EXIT"), Trans
                Exit Do
                badExits += 1
                .landing  = 7
            EndIf

            If (.landing  = 7) Then 'remove plane from array
                For y = p To x - 1
                    Swap tPlane.plane(y), tPlane.plane(y + 1)
                Next
                ReDim Preserve tPlane.plane(x - 1)
                flightsDone += 1
                Exit For
            ElseIf (.landing  = 8) Then '--> replace to schedule
                .landing = -1
            EndIf
        End With
    Next

    Locate 1,1
    ? Format(Now - startTime, "hh:mm:ss")
    ? "    done ";flightsDone
    ? "conflict ";Int(conflictTime)
    ScreenCopy
    Sleep 1
Loop While InKey = ""

If crashes Or badExits Then
    Put (300,360),zoomText("YOU'VE BEEN FIRED!"), Trans
Else
    Put (300,300),zoomText("YOU COMPLETED " + Str(flightsDone) + " FLIGHTS"), Trans
    Put (300,330),zoomText("IN " + Format(Now - startTime, "hh:mm:ss")), Trans
EndIf
ScreenCopy

Sleep
End


p1:
Data ".........xx........."'1
Data "........x..x........"'2
Data "........x..x........"'3
Data "........x..x........"'4
Data "........x..x........"'5
Data ".......x....x......."'6
Data ".......x....x......."'7
Data ".....xx......xx....."'8
Data "....x..........x...."'9
Data "..xx....x..x....xx.."'10
Data ".x.....x....x.....x."'11
Data "x...x.x.x..x.x.x...x"'12
Data "xx.x....x..x....x.xx"'13
Data "........x..x........"'14
Data "........x..x........"'15
Data "........x..x........"'16
Data ".......x....x......."'17
Data "......x......x......"'18
Data ".....x...xx...x....."'19
Data ".....x.x....x.x....."'20

p1f:
Data ".........xx........."'1
Data "........xxxx........"'2
Data "........xxxx........"'3
Data "........xxxx........"'4
Data "........xxxx........"'5
Data ".......xxxxxx......."'6
Data ".......xxxxxx......."'7
Data ".....xxxxxxxxxx....."'8
Data "....xxxxxxxxxxxx...."'9
Data "..xxxxxxxxxxxxxxxx.."'10
Data ".xxxxxxxxxxxxxxxxxx."'11
Data "xxxxxxx.xxxx.xxxxxxx"'12
Data "xxxx....xxxx....xxxx"'13
Data "........xxxx........"'14
Data "........xxxx........"'15
Data "........xxxx........"'16
Data ".......xxxxxx......."'17
Data "......xxxxxxxx......"'18
Data ".....xxxxxxxxxx....."'19
Data ".....x.x....x.x....."'20


p2:
Data ".................../"'1*
Data "................xxx."'2*
Data "...............x./x."'3*
Data "..xxxxxxxxxxxxx./.x."'4*
Data ".x............./.x.."'5*
Data "..xxxx......../.x..."'6
Data "......xxxxx../..x..."'7
Data ".........x../...x..."'8
Data "........x../....x..."'9
Data ".......x../..x..x..."'10
Data "........./..xx..x..."'11
Data "..x...x./..x.x..x..."'12
Data ".x.xxx./..x..x..x..."'13
Data ".x..../.x....x..x..."'14
Data "..xx./.x......x.x..."'15
Data "....x..x......x.x..."'16
Data ".../.x.x......x.x..."'17
Data "../..x..x.....x.x..."'18
Data "./....xx.......x...."'19
Data "/..................."'20

p2f:
Data ".................../"'1*
Data "................xxx."'2*
Data "...............xxxx."'3*
Data "..xxxxxxxxxxxxxxxxx."'4*
Data ".xxxxxxxxxxxxxxxxx.."'5*
Data "..xxxxxxxxxxxxxxx..."'6
Data "......xxxxxxxxxxx..."'7
Data ".........xxxxxxxx..."'8
Data "........xxxxxxxxx..."'9
Data ".......xxxxxxxxxx..."'10
Data ".......xxxxxxxxxx..."'11
Data "..x...xxxxxx.xxxx..."'12
Data ".xxxxxxxxxx..xxxx..."'13
Data ".xxxxxxxx....xxxx..."'14
Data "..xxxxxx......xxx..."'15
Data "....xxxx......xxx..."'16
Data ".../.xxx......xxx..."'17
Data "../..xxxx.....xxx..."'18
Data "./....xx.......x...."'19
Data "/..................."'20


Function zoomText(text As String, foreground As ULong = RGB(255,255,255), background As ULong = RGB(255,0,255)) As Any Ptr
    Dim As Any Ptr img, imgz
    Dim As Integer w, h
    Dim As ULong pnt

    img = ImageCreate(Len(text) * 8, 8, background, 32)
    ImageInfo img, w, h
    imgz = ImageCreate(w * 2, h * 2, background, 32)
    Draw String img, (0,0), text, foreground
    For x As Integer = 0 To w - 1
        For y As Integer = 0 To h - 1
            pnt = Point(x, y, img)
            PSet imgz, (x * 2, y * 2), pnt
            PSet imgz, (x * 2 + 1, y * 2), pnt
            PSet imgz, (x * 2, y * 2 + 1), pnt
            PSet imgz, (x * 2 + 1, y * 2 + 1), pnt
        Next
    Next
    ImageDestroy img
    Return imgz

End Function

Function turnImg(img As Any Ptr, d As String = "r") As Any Ptr
    Dim As Integer w, h, bpp, x, y
    Dim As Any Ptr ret

    ImageInfo img, w, h, bpp
    ret = ImageCreate(h, w, RGB(0,0,0), bpp/8)

    For x = 0 To w - 1
        For y = 0 To h - 1
            Select Case d
                Case "l"
                    PSet ret, (y, x), Point(w - 1 - x, y, img) 'turn left
                Case "r"
                    PSet ret, (y, x), Point(x, h - 1 - y, img) 'turn right
                Case Else
                    ImageDestroy ret
                    Return 0
            End Select
        Next
    Next

    Return ret

End Function

Function fix2grid(ByRef p As tPosition) As tPosition

    p.x = Int(p.x / grid  + .5) * grid
    p.y = Int(p.y / grid  + .5) * grid

    Return p

End Function
Dateimanager
Es wurden bisher keine Sources abgelegt.