PureBoard

Code: Alles auswählen

;{/ Zum Programm
; Autor: Folker Linstedt / FL-Studios
; Nick: Xaby
; Web: h-data.de
; Erstellt am: 01.12.2005 bzw. Original am 10.12.2003
; Dieses Programm ist eine Uebersetzung meines frueheren TurboPascal Programms

; Vielleicht stellt ja jemand fest, dass die ein oder andere Methode wie
; LineTo, Rectangle oder die Festlegung der 16 Grundfarben mit festen Namen wie Yellow, White ...
; So wie z.B. die ganzen Internetfarben(Lime, Indigi, Kornflowerblue ...)
; keine so schlechte Idee sei. Ihr koennt ruhig mal mit den Variablen in Weihnachten() rumspielen
; Viel Spasz mit dem Programm und Frohes Fest.
;}/

Global MaxX.l
Global MaxY.l

Procedure MachGraph()
  OpenWindow(0,0,0,MaxX+1,MaxY+1,#PB_Window_ScreenCentered,". . . FLSchnee . . . . . . . (c) Folker Linstedt 2005, . . . . . . . . . . . . . . . . . . .  [ALT]+[F4] zum Beenden . . . . .")
  
  
EndProcedure


Global MovedX.l
Global MovedY.l

Procedure MoveTo(x.l,y.l)
  MovedX=x
  MovedY=y
EndProcedure

Procedure LineTo(x.l,y.l)
  LineXY(MovedX,MovedY,x,y)
  MoveTo(x,y) 
EndProcedure

Procedure Rectangle(x1.l,y1.l,xx.l,yy.l)
  MoveTo(x1,y1)
  LineTo(xx,y1)
  LineTo(xx,yy)
  LineTo(x1,yy)
  LineTo(x1,y1)
  
EndProcedure


; Die folgende Farbpalette erfuellt ihren Zweck, ist aber nicht ganz richtig
; Im Original sind die Farben bis auf FarbeNr. 8, der Helligkeit nach geordnet
; So kann man auf einem SW-Monitor sicher sein, dass 12 heller ist als 10 oder 3
; Die dunkleren Farben sind also von 0 bis  7 (lightgray muss hier als darkwhite  gesehen werden)
; Die helleren  Farben sind      von 8 bis 15 ( darkgray muss hier als lightblack gesehen werden)

Dim Farbe.l(16)
Farbe( 0)=RGB(0,0,0) ; Black
Farbe( 1)=RGB(0,0,128); Blue, darker
Farbe( 2)=RGB(0,128,0); Green, darker
Farbe( 3)=RGB(0,128,128); Cyan, darker
Farbe( 4)=RGB(128,0,0); Red, darker
Farbe( 5)=RGB(128,0,128); Magenta, darker
Farbe( 6)=RGB(150,100,0); Brown / Yellow, darker
Farbe( 7)=RGB(192,192,192); lightGray / White, darker
Farbe( 8)=RGB(128,128,128); darkGray / Black, lighter
Farbe( 9)=RGB(0,0,255); Blue, lighter
Farbe(10)=RGB(0,255,0); Lime / Green, lighter
Farbe(11)=RGB(0,255,255); Cyan, lighter
Farbe(12)=RGB(255,0,0); Red, lighter
Farbe(13)=RGB(255,0,255); Magenta, lighter
Farbe(14)=RGB(255,255,0); Yellow / Brown, lighter
Farbe(15)=RGB(255,255,255); White



Procedure SetColor(f.l)
  
  FrontColor(Red(Farbe(f)),Green(Farbe(f)),Blue(Farbe(f)));
  
EndProcedure



Procedure MachStadt();
  i.l;
  CreateImage(0,MaxX+1,MaxY+1); 
  StartDrawing(ImageOutput())
  ;Box(0,0,640,480,RGB(0,0,255))
  For i=0 To 14 
    SetColor(4)
    LineXY     (0,MaxY-i,MaxX,MaxY-i);
    Rectangle(150+i,MaxY-79+i,250-i,MaxY-24-i);
    SetColor(6)
    LineXY     (340+i,MaxY-15,340+i,MaxY-49);
  Next i;
  SetColor(4); Red (darker) / Rot (dunkler)
      ; Das mit der Farbe kann auch direkt mit den RGB-Werten erledigt werden, ist nur wegen der
      ; Enheitlichkeit mit der Prozedur Weihnachten und der Methode PutPixel und der Funktion GetPixel
  
    Circle   (500+1,MaxY-34+1, 19+1); Radien sind alle plus einen, ???
    Circle   (500+1,MaxY-34+1,5-1+1,RGB(0,0,0)); Nicht ganz richtig, aber so geht's am einfachsten
    
    SetColor(15)
    Locate(350-300,MaxY-9-6)
    
    DrawingMode(1)
    DrawText("Folker Linstedt (c) 2003, 10.12.2003");
    Locate(MaxX-200,MaxY-9-6)
    DrawText("Portierung: 01.12.2005");
    
    SetColor(2); Green (darker) / Gruen (dunkler)
    ;SetFillStyle(1,2);
    For i=0 To 2 
      
      MoveTo(300+10*i,MaxY-39-30*i);
      LineTo(390-10*i,MaxY-39-30*i);
      LineTo(345,MaxY-79-30*i);
      LineTo(300+10*i,MaxY-39-30*i);
      FillArea(345,MaxY-74-30*i,Farbe(2));
    Next i;
      ;SetFillStyle(1,4);
     ; FillArea(510,445, RGB(128,0,0));
    StopDrawing()
    EndProcedure;
 
    
    
    Procedure PutPixel(x.l,y.l,f.l)
      Plot(x,y,Farbe(f)) 
    EndProcedure
    
    Procedure.l GetPixel(x.l,y.l)
      f.l  ; GetPixel geht nicht!!! Deshalb steht der Schnee oben fest.
      Color.l
      Color=Point(x,y)
      
    For e=0 To 15
      
      If Farbe(e)=Color
          f=e
        EndIf
      Next e
      
     ProcedureReturn = f
    
    EndProcedure
    
    
    
    Procedure Weihnachten()
      Q.l;
      J.l;
      Dim Schnee.l(1000,1); J: LongInt; F,S:Byte;
      ;                   { 1000 und eine Flocke }
      ;RandomSeed(100); { Zufallsgenerator eingeschaltet }
      For Q=0 To 1000 ;  { Schnee[Q,0] ist x-Position der Flocke mit Nr.Q }
        ;               { Schnee(Q,1) ist y-Position der Flocke mit Nr.Q }
        Schnee(Q,0)=Random(640); { Random erzeugt Zufallszahl }
        Schnee(Q,1)=-400+Random(400);
      Next Q;
        J=0;
        
      Repeat
        
        Delay(5); Stimmung, 15 ist ganz ruhig, 1 ist eher Schneesturm
        ; Schnee faellt nur schnell genug, wenn Fenster aktiv ist oder Delay() ausgeklammert ist
        
        UseImage(0)
        StartDrawing(ImageOutput())
        
            For Q=0 To 1000 
              
              J+1100; Von 1000 auf 1100, damit Schnee schneller dreht. 1000 ist jedoch ideal
              ;{ J ist LongInt, ist J>2147483647 wird J negativ }
              PutPixel(Schnee(Q,0),Schnee(Q,1),0);
              If J > 0 ; { ist J nicht negativ ist Windrichtung Plus }
                Schnee(Q,0)+Random(2)
                Else ; { Windrichtung +/- }
                Schnee(Q,0)-Random(2);     { Windstaerke  2   }
              EndIf
              If Schnee(Q,0)>MaxX: Schnee(Q,0)=Schnee(Q,0)-MaxX: EndIf
              If Schnee(Q,0)<0: Schnee(Q,0)=Schnee(Q,0)+MaxX: EndIf
              
                s=Random(3);  { Naechste Zeile: Ohne +S ist Schnee agressiv }
                ;f=GetPixel(Schnee(Q,0),Schnee(Q,1)+s);{ mit +S normaler Schnee }
                f=Point(Schnee(Q,0),Schnee(Q,1)+s);{ mit +S normaler Schnee }
                ;{ GetPixel ermittelt Farbe auf dem Bildschirm }
                ; Vielleicht bekommt ja jemand heraus, weshalb mein GetPixel nicht so richtig funktioniert
                ;If ( ((f=7) Or (f=0) Or (f=15) ) And (Schnee(Q,1)<=465) )
                If ((f=RGB(Red(Farbe(7)),Green(Farbe(7)),Blue(Farbe(7))) Or f=RGB(Red(Farbe(15)),Green(Farbe(15)),Blue(Farbe(15))) Or f=RGB(Red(Farbe(0)),Green(Farbe(0)),Blue(Farbe(0))))) And ( Schnee(Q,1)<=464)
                  
                  Schnee(Q,1)+s
                Else
                  
                ;  { Flocke auf Stadt }
                ;  { Von der Struktur der Flocke ist das Wachstum des Schnees    }
                ;  { auf der Stadt abhaengig. Mehr Farbe 11, schnellere Wachstum }
                ;  { Z.b.:  SetColor(11); Circle(Schnee(Q,0),Schnee(Q,1),2);     }
                ;  { oder   PutPixel(Schnee(Q,0)-1+Random(3),Schnee(Q,1)  ,11);  }
                  
                  Circle(Schnee(Q,0)            ,Schnee(Q,1)-1,1,Farbe(15)); Steinschlag! soll Tuermchen verhindern
                  ;Circle(Schnee(Q,0)            ,Schnee(Q,1)-1,2,Farbe( 0)); Steinschlag! soll Tuermchen verhindern
                  PutPixel(Schnee(Q,0)-1+Random(3),Schnee(Q,1)  ,11-4*Random(2));
                  PutPixel(Schnee(Q,0)            ,Schnee(Q,1)-1,15);
                  PutPixel(Schnee(Q,0)-1+Random(3),Schnee(Q,1)  ,11+4*Random(2));
                  
                  
                  Schnee(Q,0)=Random(MaxX+1);
                  Schnee(Q,1)=-300+Random(400);
                EndIf;
                  PutPixel(Schnee(Q,0),Schnee(Q,1),7+8*(Q % 2));
                Next ;       

                StopDrawing()
                
        StartDrawing(WindowOutput())
        DrawImage(UseImage(0),0,0) ; Loest Problem mit den Flocken am Rand, aber versetzt das Weihnachtsbild
                
        StopDrawing()
  
        EventID = WindowEvent()
        
      Until EventID = #PB_Event_CloseWindow
      
    EndProcedure
    

 ;- HauptProgramm
    
    ;MaxX=1100-1 ; Banner
    ;MaxY=200-1
    
    MaxX=640-1
    MaxY=480-1
    
    ; Schnee faellt nur schnell genug, wenn Fenster aktiv ist
    
    ; Die ersten drei SchneeBoehen sehen etwas komisch aus. Das haengt mit der ,,Schnee-Engine,, zusammen
    ; Danach ist der Schnee gleichmaeszig ueber dem Bildschirm verteilt
    
     MachGraph()
     MachStadt()
     Weihnachten()