Rahmen_X = 50 :Rahmen_Y = 30
Frage$ = "Gib eine Zahl ein:?":max_Lang = 9

Graphics 800 ,600,16,1
SetBuffer BackBuffer ()
Font1 = LoadFont ("Comic Sans MS",35,0,0,0)
Font2 = LoadFont ("Comic Sans MS",20,0,0,0)

While Not KeyHit (1)
    Cls
    SetFont Font2
    Color 0 ,255,0
    Text 500 ,60,"Diagramm und Input Routine",1,1
    Text 500 ,100,"aus dem",1,1
    Text 500 ,140,"Code Archiv BB-Forum",1,1
    SetFont Font1
    If timer < MilliSecs () Then
        ;##################################
        ;Inputroutine
        Rahmenbreite = StringWidth (Frage$ + "XYZ") ;+ FontWidth ()*2)
        Rahmenhoehe = (FontHeight () * 4)
        Color 255 ,0,0 ; umrandung malen 2pix breit
        Rect Rahmen_X, Rahmen_Y,Rahmenbreite,Rahmenhoehe ,1
        Color 0 ,0,255; innenfeld
        Rect Rahmen_X + 2 ,Rahmen_Y + 2, Rahmenbreite - 4 , Rahmenhoehe - 4 ,1
        Color 0 ,0,0 ; Frage einzeichnen >> Schatten
        Text Rahmen_X + Rahmenbreite / 2 + 2, Rahmen_Y + Rahmenhoehe / 4 + 2 , Frage$,1,1
        Color 255 ,255,0 ; Frage einzeichnen
        Text Rahmen_X + Rahmenbreite / 2, Rahmen_Y + Rahmenhoehe / 4 , Frage$,1,1
        a = GetKeynew () ; Zeichen holen wenn gedrückt
        ; wenn gescheites zeichen, dann hinzufügen
        If Len (antwort$) < max_Lang Then
            If a >= 48 And a <= 57  Then antwort$ = antwort$ + Chr (a)
            If Len (antwort$) And Left (antwort,1) = "0" Then antwort = Mid (antwort,2)
            If a = 44 Or a= 46 And Instr(antwort,".")= 0 Then antwort$ = antwort$ + Chr (46)
            End If
        ;wenn Rücktaste dann Zeichen löschen... und Pause sonst ist der Text zu schnell gelöscht
        If KeyDown (14) And Len (antwort$) > 0 And MilliSecs () - WarteZeit > 125 Then
            antwort$ = Left (antwort$, (Len (antwort$) - 1) )
            WarteZeit = MilliSecs ()
        End If
        ; bei enter ist die Eingabe erledigt und gibt die 1 zurück
        If (KeyDown (28) Or KeyDown (156) ) Then Abfrage = 1 ; für beenden der Input routine
        Antwortbreite = max_Lang * StringWidth ("Ra") / 2;FontWidth() ; die maximale breite der Antwort ermitteln
        Startpos_der_Antwort = Rahmen_X + (Rahmenbreite / 2) - (Antwortbreite / 2)
        Color 0 ,0,0
        Text Startpos_der_Antwort,Rahmen_Y + Rahmenhoehe / 4 * 2.2 , Antwort$
        ; Cursor blinken
        If MilliSecs () - CursorZeit > 500 Then
            CursorStatus = CursorStatus Xor 1 ;ein - ausschalten
            CursorZeit = MilliSecs ()
        End If
        ;Cursor malen
        If CursorStatus = 1 Then
            StartCursorX = Startpos_der_Antwort + StringWidth (antwort$) + 1
            texthoehe = StringHeight (antwort$)
            Color 255 ,255,0
            Rect StartCursorX , Rahmen_Y + Rahmenhoehe / 4 * 2.2 + texthoehe * .2 , StringWidth ("l") , texthoehe * .6
        End If
;-<BM> 60
        If Abfrage = 1 Then
            bank$ = Antwort$ + "!" + teile (Antwort$)
            Antwort = ""
            Abfrage = 0
            Startdia=1
            Animation = 0
            timer = MilliSecs () + 1000
            FlushKeys
        End If
    End If

   
    If Startdia > 0 Then
        If animation < 760 Animation = Animation + 3
        Diagramm ( 0 ,bank$, 20 , 180 ,animation, 400)
    End If
    Flip
Wend

End

Function GetKeyNew ()
    XX = GetKey ()
    If XX = 0 Then
        If KeyHit (82) Then xx = 48 ;0
        If KeyHit (83) Then xx = 44 ;,
        If KeyHit (79) Then xx = 49 ;1
        If KeyHit (80) Then xx = 50 ;2
        If KeyHit (81) Then xx = 51 ;3
        If KeyHit (75) Then xx = 52 ;4
        If KeyHit (76) Then xx = 53 ;5
        If KeyHit (77) Then xx = 54 ;6
        If KeyHit (71) Then xx = 55 ;7
        If KeyHit (72) Then xx = 56 ;8
        If KeyHit (73) Then xx = 57 ;9
    End If
    Return XX
End Function


Function Diagramm ( ArrayVon,bank$, WinStartX, WinStartY, BreiteX#, HoeheY#)



    For i = 1 To Len (bank$)
        If Mid (bank$,i,1) = "!" Then size = size + 1
    Next
    Local Wert#[10]
   
    ArrayBis = size -1
   
    While Instr (bank$,"!")
    dummy#=Left (bank$,Instr (bank$,"!") - 1)
        Wert[x] = dummy#
        x = x + 1
        bank = Mid (bank,Instr (bank$,"!") + 1)
    Wend

    IndexMenge = ArrayBis - ArrayVon + 1
   
    For t = ArrayVon To ArrayBis
        If MaxWert# < Wert [t] Then MaxWert = Wert [t]
    Next
   
    SeedRnd (1)
    Color 0 ,0,0
   
        BalkenY = HoeheY / IndexMenge
        Rect WinStartX - 1 , WinStartY - 1 , BreiteX + 2 , BalkenY * IndexMenge + 2 , 1
        Factor# = BreiteX / MaxWert
       
        While IndexMenge > Zeiger
            Rx1 = WinStartX
            Ry1 = WinStartY + Zeiger * BalkenY
            Rx2 = Wert [ Zeiger + ArrayVon ] * Factor
            Ry2 = BalkenY - 1
            Color Rand ($FF) ,Rand ($FF) ,Rand ($FF)
            Rect Rx1 ,Ry1 , Rx2 , Ry2 , 1
            Color 0 ,0,0
            Text Rx1 + 1 , Ry1 + BalkenY / 2 + 1, Wert [Zeiger + ArrayVon] ,0,1
            Color $FF , $FF , $FF
            Text Rx1 , Ry1 + BalkenY / 2, Wert [Zeiger + ArrayVon] ,0,1
            Zeiger = Zeiger + 1
        Wend
   
End Function


Function teile$ (a#,bank$ = "",tiefe = 0)
    tiefe = tiefe + 1
    a# = a# / 2
    If a <= 2 Or tiefe = 10 Then Return bank
    Bank$ = Bank$ + a# + "!" + teile$ (a#,bank$,tiefe)
    Return Bank$
End Function

; Übungsaufgabe Nr. 4

Graphics 640 , 480 , 16 , 2
SetBuffer BackBuffer ()
SeedRnd MilliSecs ()

zahl# = Input ("Bitte geben Sie eine Zahl ein:")

teilen (zahl#)

WaitKey ()
End

Function teilen (zahl#)
   
    If zahl# <= 3.99 Then
        Text 0, 20 , zahl#
        WaitKey ()
        End
    EndIf
   
    azahl# = zahl#
   
    For x = 1 To 10
        azahl# = azahl / 2
        If azahl# <= 2 Then Exit
    Next
   
    x = x - 1
   
    For y = 1 To x
        farbeR = Rand (0, 255)
        farbeG = Rand (0, 255)
        farbeB = Rand (0, 255)
        Color farbeR, farbeG, farbeB
        yachse = yachse + 20
        zahl# = zahl# / 2
        Rect zahl#, 300 , zahl# + 50 , 50 , 1
        Text 0, yachse, y + ": " + zahl#
    Next
   
    Flip
End Function

zahl#=Input()
teile (zahl#,0)
WaitKey()






Function teile (zahl#, durchlauf)
zahl#=zahl#/2
If zahl#<=2 Or durchlauf=10 Then Return(durchlauf)
Print zahl#
durchlauf=durchlauf+1
teile (zahl#,durchlauf)
Return(durchlauf)
End Function

Graphics(800,600,32,2)

;================================================================;

Function Rekursion(Zahl#, abstand_y#, Draw=1, Durchlauf=0)
   Durchlauf=Durchlauf+1
   Zahl=Zahl/2
   If Zahl>2
      Print(Durchlauf+": "+Zahl)
      If Draw : DrawCross(200 + 40 * Durchlauf, 550 - (Zahl * abstand_y), Durchlauf) : EndIf
      If Durchlauf<10
         Zahl=Rekursion(Zahl, abstand_y, Draw, Durchlauf)
      EndIf
   EndIf
   Return(Zahl)
End Function

;================================================================;

Function DrawCross(x, y, nr, width=2, height=2)
   Line(x-width, y, x+width, y)
   Line(x, y-height, x, y+height)
   Text(x+2, y-StringHeight(nr)-2, nr)
End Function

;================================================================;

Function DrawKoordSystem(StartZahl#, skala_x)
   Line(200, 550, 600, 550)
   Line(200, 550, 200, 038)

   For a=1 To 10
      Line(200+40*a, 550, 200+40*a, 555)
      Text(200+(40*a)-StringWidth(a)/2, 550+StringHeight(a), a)
   Next
   
   abstand#=512/skala_x
   konst#=StartZahl/(2.0*skala_x)
   For a=1 To skala_x
      zahl#=konst*a
      Line(200, 550-abstand*a, 195, 550-abstand*a)
      Text(190-StringWidth(zahl), 550-StringHeight(zahl)/2-abstand*a, zahl)
   Next
End Function

;====================================================================;
; Die folgenden 2 Werte können nach belieben verändert werden, wobei ;
; Skala_x immer ein Vielfaches von 2 sein sollte ( 2,4,8,...)        ;
; Skala_x stellt die Anzahl der horizontalen Skalastriche im         ;
; Koordinatensystem dar, welches mit Draw=1 gezeichnet werden kann   ;
;====================================================================;

Draw=1          ; ( 0=nicht zeichen | 1=zeichen )
Skala_x=16      ; ( 2,4,8,16, ... )

;================================================================;

Startzahl=Input("Startzahl: ")
If Draw
   Color(150,150,150)
   DrawKoordSystem(Startzahl, Skala_x)
EndIf
Color(255,255,255)
Print() : Print()
Rekursion(Startzahl,  1024.0/Startzahl, Draw)

WaitKey()
End

Graphics 640,240,0,2

printline = 1 ; Line im Graph zeichnen?

font = LoadFont("Arial",16)
font2 = LoadFont("Arial",20,1)
SetFont font
dim schritte#(10)

schritte(0) = input (" Zahl: ")
print ""
ergebnis# = teilen#(schritte(0),0)
print ""
setfont font2
print " Ergebnis: " + ergebnis#
SetFont font

DrawGraph(ergebnis#,printline)

Waitkey()


Function teilen#(zahl#,tiefe = 0)
  zahl# = zahl# / 2.0   
  If zahl# >= 2 and tiefe < 10 Then
    schritte(tiefe+1) = zahl# ;Abspeichern der Zwischenergebnisse
      
    tiefe = tiefe + 1
   
    print " " + tiefe + ": " + zahl#
    zahl# = teilen#(zahl#,tiefe)
  Else
    zahl# = zahl# * 2
    return zahl#
  Endif
  return zahl#
End Function

Function DrawGraph(ergebnis#,printline)
  color 0,0,255
  ;Line 300,9,300,201,0
  Line 300,9,300,210
  Line 300,210,600,210
  maxy# = schritte(1)
  steps# = maxy# / 8.0
      
  For i = 0 to 8
    x = 300
    y = 9+(i*(200.0/8.0))
    color 255,255,255
    text x-5-(stringwidth(maxy#   - (steps# * i))),y-8,str(maxy#   - (steps# * i))   
    if i <> 8 then
      color 44,44,44
      line x+1,y-1,x+300,y-1
    Endif
  Next
  color 255,255,255

  for i = 1 to 10
    if schritte#(i) = ergebnis# then maxx = i      
  next

  for i = 1 to maxx
    x = 302+(i*(300.0/float(maxx)))-(float((300.0/float(maxx)))/2)
    y = 209-(schritte(i)*(200.0/schritte(1)))
    color 255,255,255
    text 300+(i*(300.0/float(maxx)))-(float((300.0/float(maxx)))/2),214,i
       
    color 44,44,44
    line x,209,x,9

    if i <> 1 and printline = 1
      color 0,55,0
      line x,y,302+((i-1)*(300.0/float(maxx)))-(float((300.0/float(maxx)))/2),208-(schritte(i-1)*(200/schritte(1)))
    endif
       
    color 255,0,0
    line x-2,y,x+2,y
    line x,y-2,x,y+2
            
    ;color 166,166,166 : text x,y-15,schritte(i)
  next
End Function

Graphics 800, 600, 32, 2

Main()

WaitKey
End

Function Main()
   Locate 0, 10
   val# = Input( "Geben Sie eine Zahl ein: " )
   
   If ( val# <= 2 )
      Print "Zahl gleiner oder gleich zwei"
      Return
   End If
   
   Print ""
   
   numPass = GetStepCnt( val# )

   erg# = DivRecursive( val#, -1, 500, 550, val#, numPass )
   
   Print ""
   Print "Das Ergebniss lautet: " + erg#
   
   Display( 290, 10, 500, 560, 8, val, numPass  )
End Function

Function Display( x, y, width, height, steps, val#, numPass )
   Rect( x, y, width, height, 0 )
   
   For i# = steps To 0 Step -1
      Text x - 50, ( i# * ( ( height - y ) / steps ) ) + y, ( ( steps - i# ) * val# ) / 8
   Next
   
   If ( numPass = 0 )
      Text x, y + height, "0.0"
   Else
      For i# = 0 To numPass
         Text ( i# * ( ( width - StringWidth( i ) ) / numPass ) ) + x, y + height, i
      Next
   End If
End Function

Function DivRecursive#( val#, cnt%, diagWidth, diagHeight, max#, numPass )
   cnt = cnt + 1
   
   If ( cnt > 10 Or ( val# / 2 ) <= 2 )
      Return val#
   End If
   
   val# = val# / 2
   
   Print "Durchgang " + cnt% + ": " + val#
   
   If ( numPass = 0 )
      xPos = 290
   Else
      xPos = ( Float( cnt% ) * ( ( diagWidth - StringWidth( Float( cnt% ) ) ) / numPass ) ) + 290
   End If
   
   yPos = ( ( val# * Float( diagHeight ) ) / max# ) + 5
   yPos = yPos + ( 2 * ( Int( ( ( ( max# / 2 ) * Float( diagHeight ) ) / max# ) + 5 ) - yPos ) )

   Text xPos, yPos, "*"
   
   Return DivRecursive( val#, cnt%, diagWidth, diagHeight, max#, numPass )
End Function

Function GetStepCnt( val# )   
   numPass = 0
   tmp# = val#
   
   Repeat
      tmp# = tmp# / 2   
      numPass = numPass + 1
   Until ( numPass > 10 Or ( tmp# / 2 ) <= 2 )
   
   Return numPass - 1
End Function