PureBasic Forum

; Squares 2.0
; Draws fading squares. When the mouse is over the square, it appears.
; Press ESC to end the program
; Translated from the Anonymus programming language
; www.codeproject.com/Articles/192825/Anonymus-the-optimal-language

EnableExplicit

;- Constants
#SquareSize = 32
#Width = 24
#Height = 20
#winMain = 0
;}

;- Globals
Global Dim Arry.d(#Width, #Height)
;}

Procedure.d Decrease(Val.d)
If Val<0.02: ProcedureReturn 0.0: Else: ProcedureReturn Val-0.02: EndIf
EndProcedure

Procedure.b InArea(x, y, w, h)
Protected mx, my
mx = WindowMouseX(#winMain): my = WindowMouseY(#winMain)
If x<=mx And mx<x+w And y<=my And my<y+h: ProcedureReturn #True: Else: ProcedureReturn #False: EndIf
EndProcedure

Procedure Update()
; Updates the squares and draws them
; If the mouse is on the square, it draws a white square and
; sets the fading rate to 1 which means it's fully visible,
; otherwise it draws with a color based on square's position
Protected x, y, Value.d, XPos, YPos
Protected Colour, Red, Green, Blue
For x = 0 To #Width
  For y = 0 To #Height
    Value = Arry(x, y)
    XPos = x*#SquareSize
    YPos = y*#SquareSize
    If InArea(XPos, YPos, #SquareSize, #SquareSize)
      Value = 1.0
      Colour = #White
      StartDrawing(ScreenOutput())
        Box(XPos, Ypos, #SquareSize, #SquareSize, Colour)
      StopDrawing()
    ElseIf Value>0.0
      Colour = 255*Value
      Red = (x*1.0/#Width)*Colour
      Green = (1-(y*1.0/#Height))*Colour
      Blue = (y*1.0/#Height)*Colour
      Colour = RGB(Red, Green, Blue)
      StartDrawing(ScreenOutput())
        Box(XPos, Ypos, #SquareSize, #SquareSize, Colour)
      StopDrawing()
    EndIf
    Arry(x,y) = Decrease(Value)
  Next y
Next x
EndProcedure

Procedure Reset()
; Zeroise the array
Protected x, y
For x = 0 To #Width
  For y = 0 To #Height
    Arry(x,y) = 0.0
  Next y
Next x
EndProcedure

; Main program
Reset() ; Unnecessary in PureBasic
; The next 3 lines translate 'Graphics SquareSize * Width, SquareSize * Height' from the Anonymus version
InitSprite()
OpenWindow(#winMain, 0, 0, #SquareSize*#Width, #SquareSize*#Height, "SQUARES", #PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(#winMain), 0, 0, #SquareSize*#Width, #SquareSize*#Height, 0,0,0)
While Not(GetAsyncKeyState_(#VK_ESCAPE) & $8000) ; Until ESC is pressed
  ClearScreen(#Black) ; Unnecessary in PureBasic
  Update()
  FlipBuffers()
  While WindowEvent(): Wend ; Mainly to ignore mouse clicks
Wend